我有此数据:
dat
# A tibble: 4 x 7
# Groups: Product.Name [4]
Product.Name battery fast life new problem time
<chr> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
1 BLU Studio 5.0 0.325 0.131 0.139 0.0929 0.167 0.145
2 iphone 4s 0.311 0.0512 0.0504 0.278 0.146 0.163
3 Motorola Moto E 0.249 0.169 0.137 0.130 0.150 0.165
4 Samsung Galaxy II 0.226 0.112 0.0531 0.120 0.228 0.260
我想计算所有行对的Hellinger距离,例如带iPhone 4s的BLU Studio 5.0,带摩托罗拉Moto E的BLU Studio 5.0等。与dist
函数相反,Hellinger
包的statip
函数只能应用于成对的行。
对于前两个行对,它看起来像这样:
dist1 = hellinger(as.numeric(dat[1, -1]), as.numeric(dat[2, -1]))
但是,如果行变大,那将非常耗时。结果应该是在行和列中具有相同名称的矩阵。
是否可以将此功能应用于所有行组合?
xy <- structure(list(Product.Name = c("BLU Studio 5.0", "iphone 4s",
"Motorola Moto E", "Samsung Galaxy II"), battery = c(0.324865107913669,
0.311268715524035, 0.248677248677249, 0.226377952755905), fast = c(0.131294964028777,
0.0512214342001576, 0.169312169312169, 0.112204724409449), life = c(0.138714028776978,
0.0504334121355398, 0.136507936507936, 0.0531496062992126), new = c(0.0928507194244604,
0.278171788810087, 0.13015873015873, 0.12007874015748), problem = c(0.16726618705036,
0.145784081954295, 0.15026455026455, 0.228346456692913), time = c(0.145008992805755,
0.163120567375887, 0.165079365079365, 0.259842519685039)), class = c("grouped_df",
"tbl_df", "tbl", "data.frame"), row.names = c(NA, -4L), vars = "Product.Name", drop = TRUE, indices = list(
0L, 1L, 2L, 3L), group_sizes = c(1L, 1L, 1L, 1L), biggest_group_size = 1L, labels = structure(list(
Product.Name = c("BLU Studio 5.0", "iphone 4s", "Motorola Moto E",
"Samsung Galaxy II")), class = "data.frame", row.names = c(NA,
-4L), vars = "Product.Name", drop = TRUE))
答案 0 :(得分:1)
虽然您可以按照我的建议使用expand.grid
,但您可能不需要自我比较对。还有另一个计算连击的函数,名为combn
。用它生成对,然后将自定义函数应用于组合,如下所示:
library(statip)
xy <- structure(list(Product.Name = c("BLU Studio 5.0", "iphone 4s",
"Motorola Moto E", "Samsung Galaxy II"), battery = c(0.324865107913669,
0.311268715524035, 0.248677248677249, 0.226377952755905), fast = c(0.131294964028777,
0.0512214342001576, 0.169312169312169, 0.112204724409449), life = c(0.138714028776978,
0.0504334121355398, 0.136507936507936, 0.0531496062992126), new = c(0.0928507194244604,
0.278171788810087, 0.13015873015873, 0.12007874015748), problem = c(0.16726618705036,
0.145784081954295, 0.15026455026455, 0.228346456692913), time = c(0.145008992805755,
0.163120567375887, 0.165079365079365, 0.259842519685039)), class = c("grouped_df",
"tbl_df", "tbl", "data.frame"), row.names = c(NA, -4L), vars = "Product.Name", drop = TRUE, indices = list(
0L, 1L, 2L, 3L), group_sizes = c(1L, 1L, 1L, 1L), biggest_group_size = 1L, labels = structure(list(
Product.Name = c("BLU Studio 5.0", "iphone 4s", "Motorola Moto E",
"Samsung Galaxy II")), class = "data.frame", row.names = c(NA,
-4L), vars = "Product.Name", drop = TRUE))
my.combos <- combn(1:nrow(xy), 2)
out <- apply(my.combos, MARGIN = 2, FUN = function(x, d) {
# Subset two appripriate rows.
row1 <- d[x[1], -1]
row2 <- d[x[2], -1]
# Create a resulting data.frame which holds the name of the comparison
# and the hellinger distance.
data.frame(pair = paste(d[x[1], 1], "-", d[x[2], 1]),
hell = hellinger(as.numeric(row1), as.numeric(row2))
)
}, d = xy)
do.call(rbind, out)
pair hell
1 BLU Studio 5.0 - iphone 4s 0.3141352
2 BLU Studio 5.0 - Motorola Moto E 0.2279467
3 BLU Studio 5.0 - Samsung Galaxy II 0.3010341
4 iphone 4s - Motorola Moto E 0.3734612
5 iphone 4s - Samsung Galaxy II 0.0359991
6 Motorola Moto E - Samsung Galaxy II 0.2915914