SCM

SCM Repository

[tm] Annotation of /trunk/tm/R/distmeasure.R
ViewVC logotype

Annotation of /trunk/tm/R/distmeasure.R

Parent Directory Parent Directory | Revision Log Revision Log


Revision 52 - (view) (download)
Original Path: trunk/R/textmin/R/distmeasure.R

1 : feinerer 52 # Author: Ingo Feinerer
2 :    
3 :     dist.tdm <- function(x, diag = FALSE, upper = FALSE, method = "cosine") {
4 :     type <- match.arg(method, c("cosine","pearson","extjacc"))
5 :    
6 :     m <- matrix(0, nrow = nrow(x), ncol = nrow(x))
7 :     for (i in 1:nrow(m)) {
8 :     for (j in 1:ncol(m)) {
9 :     # Do not compute symmetric values
10 :     if (0 == m[j,i])
11 :     switch(type,
12 :     "cosine" = {
13 :     m[i,j] <- cosinus(x[i,],x[j,])
14 :     },
15 :     "pearson" = {
16 :     m[i,j] <- pearson(x[i,],x[j,])
17 :     },
18 :     "extjacc" = {
19 :     m[i,j] <- extjacc(x[i,],x[j,])
20 :     }
21 :     )
22 :     else
23 :     m[i,j] <- m[j,i]
24 :     }
25 :     }
26 :     d.vec <- as.vector(m)
27 :     d <- numeric(0)
28 :     a <- k <- 1
29 :     while (k <= length(d.vec)) {
30 :     if (k %% nrow(x) == 1) {
31 :     k <- k + a
32 :     a <- a + 1
33 :     }
34 :     if (k <= length(d.vec))
35 :     d <- c(d, d.vec[k])
36 :     k <- k + 1
37 :     }
38 :     attr(d, "Size") <- nrow(x)
39 :     attr(d, "Labels") <- dimnames(x)[[1]]
40 :     attr(d, "Diag") <- diag
41 :     attr(d, "Upper") <- upper
42 :     switch(type,
43 :     "cosine" = {
44 :     attr(d, "method") <- "cosine"
45 :     },
46 :     "pearson" = {
47 :     attr(d, "method") <- "pearson"
48 :     },
49 :     "extjacc" = {
50 :     attr(d, "method") <- "extjacc"
51 :     }
52 :     )
53 :     class(d) <- "dist"
54 :    
55 :     d
56 :     }
57 :    
58 :     cosinus <- function(x, y) {
59 :     if (!(is.vector(x) && is.vector(y)))
60 :     stop("Invalid input")
61 :     crossprod(x, y) / sqrt(crossprod(x) * crossprod(y))
62 :     }
63 :    
64 :     pearson <- function(x, y) {
65 :     if (!(is.vector(x) && is.vector(y)))
66 :     stop("Invalid input")
67 :    
68 :     xa <- (x - mean(x))
69 :     xb <- (y - mean(y))
70 :    
71 :     1/2 * ((crossprod(xa, xb) / sqrt(crossprod(xa) * crossprod(xb))) + 1)
72 :     }
73 :    
74 :     extjacc <- function(x, y) {
75 :     if (!(is.vector(x) && is.vector(y)))
76 :     stop("Invalid input")
77 :     crossprod(x, y) / (crossprod(x) + crossprod(y) - crossprod(x, y))
78 :     }

root@r-forge.r-project.org
ViewVC Help
Powered by ViewVC 1.0.0  
Thanks to:
Vienna University of Economics and Business Powered By FusionForge