1

与えられた行列

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))

一致の比率とすべての列間の行の総数を使用して、5x5の距離行列を作成したいと思います。たとえば、両方の列が6回のうち3回一致する場合、X4とX3の間の距離は0.5である必要があります。

dist(test, method="simple matching")パッケージ「プロキシ」から使用してみましたが、この方法はバイナリデータに対してのみ機能します。

4

5 に答える 5

6

使用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
于 2012-05-24T04:16:42.237 に答える
2

これがそのショットです（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)
于 2012-05-24T04:11:12.223 に答える
2

これは、少し醜いですが、他の2つよりも高速なソリューションです。スピードバンプは、にmean()比べて遅い可能性があるため、使用しないことsum()と、出力マトリックスの半分のみを計算してから下の三角形を手動で埋めることに起因すると思います。関数は現在NA対角線上にありますが、他の回答と完全に一致するようにそれらを1つに簡単に設定できます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)
}

私は他の2つの答えを取り、それらを関数にし、いくつかのベンチマークを行いました。

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
于 2012-05-24T04:35:54.020 に答える
1

ご提案ありがとうございます。あなたの回答に基づいて、私は3行のソリューションを作成しました（「テスト」はデータセットの名前です）。

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
于 2012-05-25T02:49:35.270 に答える
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
于 2017-02-18T14:38:16.260 に答える