1
2### ceeboo 2007
3
4## todo: special values NaN, NA, and Inf
5
6library("proxy")
7
8set.seed(20070630)
9
10##
11
12x <- matrix(runif(20),5,4)
13inherits(x, "matrix")
14rownames(x) <- LETTERS[1:5]
15y <- x
16y[2,] <- x[1,] <- 0
17
18x
19y
20
21## user interfaces
22
23r <- .Call("R_minkowski_dist", x, NULL, FALSE, 1, PACKAGE = "proxy")
24all.equal(c(r), c(stats::dist(x, method = "minkowski", p = 1)))
25r
26.Call("R_minkowski_dist", x, x, FALSE, 1, PACKAGE = "proxy")
27.Call("R_minkowski_dist", x, y, FALSE, 1, PACKAGE = "proxy")
28.Call("R_minkowski_dist", x, y, TRUE,  1, PACKAGE = "proxy")
29
30dfun <- paste("R",c("euclidean", "maximum", "manhattan", "canberra", "binary", "matching", "fuzzy", "mutual"),"dist", sep = "_")
31
32for (f in dfun) {
33    cat("\nTesting ",f,"\n\n",sep="")
34    r <- try(do.call(".Call", list(f, x, NULL, FALSE, PACKAGE = "proxy")))
35    if ( inherits(r, "try-error"))
36	next
37    s <- try(stats::dist(x, method = gsub("R_|_dist", "", f)))
38    if (!inherits(s, "try-error"))
39        print(all.equal(c(r), c(s)))
40    print(r)
41    print(do.call(".Call", list(f, x, x, FALSE, PACKAGE = "proxy")))
42    print(do.call(".Call", list(f, x, y, FALSE, PACKAGE = "proxy")))
43    print(do.call(".Call", list(f, x, y, TRUE,  PACKAGE = "proxy")))
44}
45
46## no longer optimized
47
48.Call("R_ejaccard", x, NULL, FALSE, PACKAGE = "proxy")
49.Call("R_ejaccard", x, x, FALSE, PACKAGE = "proxy")
50.Call("R_ejaccard", x, y, FALSE, PACKAGE = "proxy")
51.Call("R_ejaccard", x, y, TRUE, PACKAGE = "proxy")
52
53.Call("R_cosine", x, NULL, FALSE, PACKAGE = "proxy")
54.Call("R_cosine", x, x, FALSE, PACKAGE = "proxy")
55.Call("R_cosine", x, y, FALSE, PACKAGE = "proxy")
56.Call("R_cosine", x, y, TRUE, PACKAGE = "proxy")
57
58x <- matrix(x > 0.5, 5,4)
59y <- matrix(y > 0.5, 5,4)
60
61.Call("R_bjaccard", x, NULL, FALSE, PACKAGE = "proxy")
62.Call("R_bjaccard", x, x, FALSE, PACKAGE = "proxy")
63.Call("R_bjaccard", x, y, FALSE, PACKAGE = "proxy")
64.Call("R_bjaccard", x, y, TRUE, PACKAGE = "proxy")
65
66###
67