Простая совпадающая матрица подобия для непрерывных недвоичных данных?
Учитывая матрицу
structure(list(X1 = c(1L, 2L, 3L, 4L, 2L, 5L), X2 = c(2L, 3L,
4L, 5L, 3L, 6L), X3 = c(3L, 4L, 4L, 5L, 3L, 2L), X4 = c(2L, 4L,
6L, 5L, 3L, 8L), X5 = c(1L, 3L, 2L, 4L, 6L, 4L)), .Names = c("X1",
"X2", "X3", "X4", "X5"), class = "data.frame", row.names = c(NA,
-6L))
Я хочу создать матрицу расстояний 5 x 5 с соотношением совпадений и общим количеством строк между всеми столбцами. Например, расстояние между X4 и X3 должно быть 0,5, учитывая, что оба столбца соответствуют 3 из 6 раз.
Я пытался использовать dist(test, method="simple matching") из пакета "прокси", но этот метод работает только для двоичных данных.
5 ответов
С помощью outer (снова:-)
my.dist <- function(x) {
n <- nrow(x)
d <- outer(seq.int(ncol(x)), seq.int(ncol(x)),
Vectorize(function(i,j)sum(x[[i]] == x[[j]]) / n))
rownames(d) <- names(x)
colnames(d) <- names(x)
return(d)
}
my.dist(x)
# X1 X2 X3 X4 X5
# X1 1.0000000 0.0000000 0.0 0.0 0.3333333
# X2 0.0000000 1.0000000 0.5 0.5 0.1666667
# X3 0.0000000 0.5000000 1.0 0.5 0.0000000
# X4 0.0000000 0.5000000 0.5 1.0 0.0000000
# X5 0.3333333 0.1666667 0.0 0.0 1.0000000
Вот выстрел в это (dt - ваша матрица):
library(reshape)
df = expand.grid(names(dt),names(dt))
df$val=apply(df,1,function(x) mean(dt[x[1]]==dt[x[2]]))
cast(df,Var2~Var1)
Вот решение, которое быстрее, чем два других, хотя и немного некрасиво. Я предполагаю, что лежачие полицейские происходят из-за неиспользования mean() как это может быть медленным по сравнению с sum(), а также только вычисление половины выходной матрицы и последующее заполнение нижнего треугольника вручную. Функция в настоящее время выходит NA по диагонали, но вы можете легко установить их на один, чтобы полностью соответствовать другим ответам с diag(out) <- 1
FUN <- function(m) {
#compute all the combinations of columns pairs
combos <- t(combn(ncol(m),2))
#compute the similarity index based on the criteria defined
sim <- apply(combos, 1, function(x) sum(m[, x[1]] - m[, x[2]] == 0) / nrow(m))
combos <- cbind(combos, sim)
#dimensions of output matrix
out <- matrix(NA, ncol = ncol(m), nrow = ncol(m))
for (i in 1:nrow(combos)){
#upper tri
out[combos[i, 1], combos[i, 2]] <- combos[i,3]
#lower tri
out[combos[i, 2], combos[i, 1]] <- combos[i,3]
}
return(out)
}
Я взял два других ответа, превратил их в функции и провел несколько сравнительных тестов:
library(rbenchmark)
benchmark(chase(m), flodel(m), blindJessie(m),
replications = 1000,
order = "elapsed",
columns = c("test", "elapsed", "relative"))
#-----
test elapsed relative
1 chase(m) 1.217 1.000000
2 flodel(m) 1.306 1.073131
3 blindJessie(m) 17.691 14.548520
Я получил ответ следующим образом: 1-й Я внес некоторые изменения в данные строки, как:
X1 = c(1L, 2L, 3L, 4L, 2L, 5L)
X2 = c(2L, 3L, 4L, 5L, 3L, 6L)
X3 = c(3L, 4L, 4L, 5L, 3L, 2L)
X4 = c(2L, 4L, 6L, 5L, 3L, 8L)
X5 = c(1L, 3L, 2L, 4L, 6L, 4L)
matrix_cor=rbind(x1,x2,x3,x4,x5)
matrix_cor
[,1] [,2] [,3] [,4] [,5] [,6]
X1 1 2 3 4 2 5
X2 2 3 4 5 3 6
X3 3 4 4 5 3 2
X4 2 4 6 5 3 8
X5 1 3 2 4 6 4
затем:
dist(matrix_cor)
X1 X2 X3 X4
X2 2.449490
X3 4.472136 4.242641
X4 5.000000 3.000000 6.403124
X5 4.358899 4.358899 4.795832 6.633250
Спасибо всем за ваши предложения. На основе ваших ответов я разработал трехстрочное решение ("test" - это название набора данных).
require(proxy)
ff <- function(x,y) sum(x == y) / NROW(x)
dist(t(test), ff, upper=TRUE)
Выход:
X1 X2 X3 X4 X5
X1 0.0000000 0.0000000 0.0000000 0.3333333
X2 0.0000000 0.5000000 0.5000000 0.1666667
X3 0.0000000 0.5000000 0.5000000 0.0000000
X4 0.0000000 0.5000000 0.5000000 0.0000000
X5 0.3333333 0.1666667 0.0000000 0.0000000