R version 3.6.3 (2020-02-29) -- "Holding the Windsock" Copyright (C) 2020 The R Foundation for Statistical Computing Platform: x86_64-pc-linux-gnu (64-bit) R is free software and comes with ABSOLUTELY NO WARRANTY. You are welcome to redistribute it under certain conditions. Type 'license()' or 'licence()' for distribution details. R is a collaborative project with many contributors. Type 'contributors()' for more information and 'citation()' on how to cite R or R packages in publications. Type 'demo()' for some demos, 'help()' for on-line help, or 'help.start()' for an HTML browser interface to help. Type 'q()' to quit R. > > ## tests on apply C wrappers > > library(proxy) Attaching package: 'proxy' The following objects are masked from 'package:stats': as.dist, dist The following object is masked from 'package:base': as.matrix > > set.seed(20070630) > > ## matrix > > f <- function(x, y) sum(x*y) / sqrt(sum(x*x)) / sqrt(sum(y*y)) > > x <- matrix(runif(20), 5, 4) > x [,1] [,2] [,3] [,4] [1,] 0.4595829 0.246283120 0.6662151 0.2658000 [2,] 0.8390691 0.002929016 0.3449861 0.4751930 [3,] 0.0377036 0.300615279 0.1399626 0.5143060 [4,] 0.7621676 0.963274350 0.4358104 0.7934745 [5,] 0.1211588 0.452265898 0.8005272 0.3062947 > y <- matrix(runif(20), 5, 4) > y [,1] [,2] [,3] [,4] [1,] 0.3435311 0.45003283 0.1931588 0.22999466 [2,] 0.4417228 0.78191550 0.9028450 0.01728483 [3,] 0.3872093 0.45154308 0.7324979 0.52502253 [4,] 0.9119128 0.21720445 0.3986998 0.72623146 [5,] 0.9374529 0.04343485 0.8170873 0.69974714 > > .External(proxy:::R_apply_dist_matrix, x, NULL, FALSE, f) 1 2 3 4 2 0.8175510 3 0.5909955 0.5179092 4 0.8046383 0.7485219 0.8416675 5 0.9026897 0.5245741 0.6848730 0.7514756 > .External(proxy:::R_apply_dist_matrix, x, x, FALSE, f) [,1] [,2] [,3] [,4] [,5] [1,] 1.0000000 0.8175510 0.5909955 0.8046383 0.9026897 [2,] 0.8175510 1.0000000 0.5179092 0.7485219 0.5245741 [3,] 0.5909955 0.5179092 1.0000000 0.8416675 0.6848730 [4,] 0.8046383 0.7485219 0.8416675 1.0000000 0.7514756 [5,] 0.9026897 0.5245741 0.6848730 0.7514756 1.0000000 > .External(proxy:::R_apply_dist_matrix, x, y, FALSE, f) [,1] [,2] [,3] [,4] [,5] [1,] 0.8068091 0.8869376 0.9573450 0.8394141 0.9257044 [2,] 0.7091915 0.5310191 0.7490815 0.9743857 0.9583243 [3,] 0.7471004 0.4955903 0.7898068 0.6896626 0.5971429 [4,] 0.9837110 0.7703657 0.8896691 0.8665744 0.7655715 [5,] 0.7512326 0.9126553 0.9466108 0.6140860 0.7184058 > .External(proxy:::R_apply_dist_matrix, x, y, TRUE, f) [1] 0.8068091 0.5310191 0.7898068 0.8665744 0.7184058 > > # coerce > > z <- y * 100 > storage.mode(z) <- "integer" > .External(proxy:::R_apply_dist_matrix, x, z, FALSE, f) [,1] [,2] [,3] [,4] [,5] [1,] 0.8035753 0.8851147 0.9568709 0.8363210 0.9255173 [2,] 0.7027894 0.5281041 0.7457478 0.9754800 0.9584822 [3,] 0.7399077 0.4909526 0.7896421 0.6859131 0.5945390 [4,] 0.9811939 0.7674593 0.8884016 0.8638128 0.7638742 [5,] 0.7490644 0.9109332 0.9482222 0.6083438 0.7173810 > .External(proxy:::R_apply_dist_matrix, z, x, FALSE, f) [,1] [,2] [,3] [,4] [,5] [1,] 0.8035753 0.7027894 0.7399077 0.9811939 0.7490644 [2,] 0.8851147 0.5281041 0.4909526 0.7674593 0.9109332 [3,] 0.9568709 0.7457478 0.7896421 0.8884016 0.9482222 [4,] 0.8363210 0.9754800 0.6859131 0.8638128 0.6083438 [5,] 0.9255173 0.9584822 0.5945390 0.7638742 0.7173810 > .External(proxy:::R_apply_dist_matrix, z, z, FALSE, f) [,1] [,2] [,3] [,4] [,5] [1,] 1.0000000 0.8363694 0.8593771 0.8075186 0.7133480 [2,] 0.8363694 1.0000000 0.8668551 0.5849013 0.6553123 [3,] 0.8593771 0.8668551 1.0000000 0.8253313 0.8715788 [4,] 0.8075186 0.5849013 0.8253313 1.0000000 0.9495662 [5,] 0.7133480 0.6553123 0.8715788 0.9495662 1.0000000 > .External(proxy:::R_apply_dist_matrix, z, NULL, FALSE, f) 1 2 3 4 2 0.8363694 3 0.8593771 0.8668551 4 0.8075186 0.5849013 0.8253313 5 0.7133480 0.6553123 0.8715788 0.9495662 > > ## list > > x <- unlist(apply(x, 1, list), recursive = FALSE) > x [[1]] [1] 0.4595829 0.2462831 0.6662151 0.2658000 [[2]] [1] 0.839069104 0.002929016 0.344986119 0.475192965 [[3]] [1] 0.0377036 0.3006153 0.1399626 0.5143060 [[4]] [1] 0.7621676 0.9632744 0.4358104 0.7934745 [[5]] [1] 0.1211588 0.4522659 0.8005272 0.3062947 > y <- unlist(apply(y, 1, list), recursive = FALSE) > > .External(proxy:::R_apply_dist_list, x, NULL, FALSE, f) 1 2 3 4 2 0.8175510 3 0.5909955 0.5179092 4 0.8046383 0.7485219 0.8416675 5 0.9026897 0.5245741 0.6848730 0.7514756 > .External(proxy:::R_apply_dist_list, x, x, FALSE, f) [,1] [,2] [,3] [,4] [,5] [1,] 1.0000000 0.8175510 0.5909955 0.8046383 0.9026897 [2,] 0.8175510 1.0000000 0.5179092 0.7485219 0.5245741 [3,] 0.5909955 0.5179092 1.0000000 0.8416675 0.6848730 [4,] 0.8046383 0.7485219 0.8416675 1.0000000 0.7514756 [5,] 0.9026897 0.5245741 0.6848730 0.7514756 1.0000000 > .External(proxy:::R_apply_dist_list, x, y, FALSE, f) [,1] [,2] [,3] [,4] [,5] [1,] 0.8068091 0.8869376 0.9573450 0.8394141 0.9257044 [2,] 0.7091915 0.5310191 0.7490815 0.9743857 0.9583243 [3,] 0.7471004 0.4955903 0.7898068 0.6896626 0.5971429 [4,] 0.9837110 0.7703657 0.8896691 0.8665744 0.7655715 [5,] 0.7512326 0.9126553 0.9466108 0.6140860 0.7184058 > .External(proxy:::R_apply_dist_list, x, y, TRUE, f) [1] 0.8068091 0.5310191 0.7898068 0.8665744 0.7184058 > > ## logical matrix > > f <- function(a, b, c, d, n) + a / sqrt(a+b) / sqrt(a+c) > > x <- t(sapply(x, ">", 0.5)) > x [,1] [,2] [,3] [,4] [1,] FALSE FALSE TRUE FALSE [2,] TRUE FALSE FALSE FALSE [3,] FALSE FALSE FALSE TRUE [4,] TRUE TRUE FALSE TRUE [5,] FALSE FALSE TRUE FALSE > y <- t(sapply(y, ">", 0.5)) > > .External(proxy:::R_apply_dist_binary_matrix, x, NULL, FALSE, f) 1 2 3 4 2 0.0000000 3 0.0000000 0.0000000 4 0.0000000 0.5773503 0.5773503 5 1.0000000 0.0000000 0.0000000 0.0000000 > .External(proxy:::R_apply_dist_binary_matrix, x, x, FALSE, f) [,1] [,2] [,3] [,4] [,5] [1,] 1 0.0000000 0.0000000 0.0000000 1 [2,] 0 1.0000000 0.0000000 0.5773503 0 [3,] 0 0.0000000 1.0000000 0.5773503 0 [4,] 0 0.5773503 0.5773503 1.0000000 0 [5,] 1 0.0000000 0.0000000 0.0000000 1 > .External(proxy:::R_apply_dist_binary_matrix, x, y, FALSE, f) [,1] [,2] [,3] [,4] [,5] [1,] NaN 0.7071068 0.7071068 0.0000000 0.5773503 [2,] NaN 0.0000000 0.0000000 0.7071068 0.5773503 [3,] NaN 0.0000000 0.7071068 0.7071068 0.5773503 [4,] NaN 0.4082483 0.4082483 0.8164966 0.6666667 [5,] NaN 0.7071068 0.7071068 0.0000000 0.5773503 > .External(proxy:::R_apply_dist_binary_matrix, x, y, TRUE, f) [1] NaN 0.0000000 0.7071068 0.8164966 0.5773503 > > ## data.frame > > f <- function(x, y) sum(x*y) / sqrt(sum(x*x)) / sqrt(sum(y*y)) > > x <- data.frame(unlist(apply(x, 2, list), recursive = FALSE)) > names(x) <- letters[1:4] > x a b c d 1 FALSE FALSE TRUE FALSE 2 TRUE FALSE FALSE FALSE 3 FALSE FALSE FALSE TRUE 4 TRUE TRUE FALSE TRUE 5 FALSE FALSE TRUE FALSE > y <- data.frame(unlist(apply(y, 2, list), recursive = FALSE)) > names(y) <- letters[1:4] > > .External(proxy:::R_apply_dist_data_frame, x, NULL, FALSE, f) 1 2 3 4 2 0.0000000 3 0.0000000 0.0000000 4 0.0000000 0.5773503 0.5773503 5 1.0000000 0.0000000 0.0000000 0.0000000 > .External(proxy:::R_apply_dist_data_frame, x, x, FALSE, f) 1 2 3 4 5 1 1 0.0000000 0.0000000 0.0000000 1 2 0 1.0000000 0.0000000 0.5773503 0 3 0 0.0000000 1.0000000 0.5773503 0 4 0 0.5773503 0.5773503 1.0000000 0 5 1 0.0000000 0.0000000 0.0000000 1 > .External(proxy:::R_apply_dist_data_frame, x, y, FALSE, f) 1 2 3 4 5 1 NaN 0.7071068 0.7071068 0.0000000 0.5773503 2 NaN 0.0000000 0.0000000 0.7071068 0.5773503 3 NaN 0.0000000 0.7071068 0.7071068 0.5773503 4 NaN 0.4082483 0.4082483 0.8164966 0.6666667 5 NaN 0.7071068 0.7071068 0.0000000 0.5773503 > .External(proxy:::R_apply_dist_data_frame, x, y, TRUE, f) [1] NaN 0.0000000 0.7071068 0.8164966 0.5773503 > > # > > f <- function(x, y) { + if (rownames(x) == 1 && rownames(y) == 1) { + print(x) + str(x) + print(y) + } + sum(x == y) / length(x) + } > > x <- data.frame(1:5, LETTERS[1:5], stringsAsFactors = FALSE) > x X1.5 LETTERS.1.5. 1 1 A 2 2 B 3 3 C 4 4 D 5 5 E > > y <- data.frame(1:6, LETTERS[c(1,1:5)], + row.names = letters[1:6], + stringsAsFactors = FALSE) > y X1.6 LETTERS.c.1..1.5.. a 1 A b 2 A c 3 B d 4 C e 5 D f 6 E > > all.equal(x, y) [1] "Names: 2 string mismatches" [2] "Attributes: < Component \"row.names\": Modes: numeric, character >" [3] "Attributes: < Component \"row.names\": Lengths: 5, 6 >" [4] "Attributes: < Component \"row.names\": target is numeric, current is character >" [5] "Component 1: Numeric: lengths (5, 6) differ" [6] "Component 2: Lengths (5, 6) differ (string compare on first 5)" [7] "Component 2: 4 string mismatches" > identical(attributes(x[[1]]), attributes(y[[1]])) [1] TRUE > identical(attributes(x[[2]]), attributes(y[[2]])) [1] TRUE > > .External(proxy:::R_apply_dist_data_frame, x, NULL, FALSE, f) 1 2 3 4 2 0 3 0 0 4 0 0 0 5 0 0 0 0 > .External(proxy:::R_apply_dist_data_frame, x, x, FALSE, f) X1.5 LETTERS.1.5. 1 1 A 'data.frame': 1 obs. of 2 variables: $ X1.5 : int 1 $ LETTERS.1.5.: chr "A" X1.5 LETTERS.1.5. 1 1 A 1 2 3 4 5 1 1 0 0 0 0 2 0 1 0 0 0 3 0 0 1 0 0 4 0 0 0 1 0 5 0 0 0 0 1 > .External(proxy:::R_apply_dist_data_frame, x, y, FALSE, f) X1.5 LETTERS.1.5. 1 1 A 'data.frame': 1 obs. of 2 variables: $ X1.5 : int 1 $ LETTERS.1.5.: chr "A" X1.5 LETTERS.1.5. 1 1 A a b c d e f 1 1 0.5 0.0 0.0 0.0 0.0 2 0 0.5 0.5 0.0 0.0 0.0 3 0 0.0 0.5 0.5 0.0 0.0 4 0 0.0 0.0 0.5 0.5 0.0 5 0 0.0 0.0 0.0 0.5 0.5 > .External(proxy:::R_apply_dist_data_frame, x, y[-6,], TRUE, f) X1.5 LETTERS.1.5. 1 1 A 'data.frame': 1 obs. of 2 variables: $ X1.5 : int 1 $ LETTERS.1.5.: chr "A" X1.5 LETTERS.1.5. 1 1 A [1] 1.0 0.5 0.5 0.5 0.5 > > > # test parameters > > f <- function(x, y, p = 1) + sum(x == y) / length(x) * p > > .External(proxy:::R_apply_dist_data_frame, x, y[-6,], TRUE, f) [1] 1.0 0.5 0.5 0.5 0.5 > .External(proxy:::R_apply_dist_data_frame, x, y[-6,], TRUE, f, p = 2) [1] 2 1 1 1 1 > > ### > > proc.time() user system elapsed 0.310 0.019 0.317
Generated by dwww version 1.15 on Sun Jun 23 05:10:44 CEST 2024.