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