Rプログラミング - 外部関数を反復する

Question

行列に式を渡すために行列の列と行を繰り返す必要がある数式を行列に埋め込むことを検討しています。

以下は、この問題の簡略化された代表例です。

id_1 <- c("mammal", "mammal", "mammal", "mammal", "fish", "fish") 
id_2 <- c("cat", "cat", "dog", "dog", "shark", "shark") 
id_3 <- c(1, 2, 2, 3, 3, 4) 
amt <- c(10, 15, 20, 25, 30, 35) 

sample_data <- data.frame(id_1, id_2, id_3, amt) 

sample_data_2 <- split(sample_data, sample_data$id_1) 

l <- length(sample_data_2) 

mat_list <- list() 
i <- 1 

for (i in 1:l) { 

    n <- nrow(sample_data_2[[i]]) 

    cor <- matrix(ncol = n, nrow = n) 

    col_2 <- head(sample_data_2[[i]][,2], n) 
    col_3 <- head(sample_data_2[[i]][,3], n) 

    cor <- diag(n) + 
     0.5 * (outer(col_2, col_2, "!=") & outer(col_3, col_3, "==")) + 
     0.25 * (outer(1:n, 1:n, "!=") & (outer(col_2, col_2, "==") + outer(col_3, col_3, "==")) != 1) + 
     sin(col_3-col_3) * (outer(col_2, col_2, "==") & outer(col_3, col_3, "!=")) 

    mat_list[[i]] <- cor  

} 

mat_list 

しかし、私は

sin(topn.3-topn.3) 

を繰り返すだろうとは思わないエラーを取得していない場合でも。私は本当にこれをやりたい

...

sin(col_3[j]-col_3[k]) 

私はループの入れ子の導入を試みたが、私はそれが

cor <- diag(n) + 
    0.5 * (outer(col_2, col_2, "!=") & outer(col_3, col_3, "==")) + 
    0.25 * (outer(1:n, 1:n, "!=") & (outer(col_2, col_2, "==") + outer(col_3, col_3, "==")) != 1) + 
    for(j in 1:length(col_3)) { 
     for (k in 1:length(col_3)) { 
      sin(col_3[j]-col_3[k]) 
     } 
    } * (outer(col_2, col_2, "==") & outer(col_3, col_3, "!=")) 

Error: dims [product 4] do not match the length of object [0] 

を動作させることはできません...そしてたとえ入れ子にされたforループが動くようになると、データが駄目になると思います。解決策はありますか？

編集：追加されました所望の出力...

mat_list 

[[1]] 
    [,1] [,2] 
[1,] 1 -0.84 
[2,] 0.84  1 

[[2]] 
    [,1] [,2] [,3] [,4] 
[1,] 1.00 -0.84 0.25 0.25 
[2,] 0.84 1.00 0.50 0.25 
[3,] 0.25 0.50 1.00 -0.84 
[4,] 0.25 0.25 0.84 1.00 

Answer 1

あなたはouter(col3,col3, function(x,y) sin(x,y))を使用することができます。ここでfor次のとおりです。

for (i in 1:l) { 

    n <- nrow(sample_data_2[[i]]) 

    cor <- matrix(ncol = n, nrow = n) 

    col_2 <- sample_data_2[[i]][,2] 
    col_3 <- sample_data_2[[i]][,3] 

    cor <- diag(n) + 
    0.5 * (outer(col_2, col_2, "!=") & outer(col_3, col_3, "==")) + 
    0.25 * (outer(1:n, 1:n, "!=") & (outer(col_2, col_2, "==") + outer(col_3, col_3, "==")) != 1) + 
    outer(col_3,col_3,function(x,y) sin(x-y)) * (outer(col_2, col_2, "==") & outer(col_3, col_3, "!=")) 

    mat_list[[i]] <- cor  

} 

mat_list 
#[[1]] 
#   [,1]  [,2] 
#[1,] 1.000000 -0.841471 
#[2,] 0.841471 1.000000 
# 
#[[2]] 
#   [,1]  [,2]  [,3]  [,4] 
#[1,] 1.000000 -0.841471 0.250000 0.250000 
#[2,] 0.841471 1.000000 0.500000 0.250000 
#[3,] 0.250000 0.500000 1.000000 -0.841471 
#[4,] 0.250000 0.250000 0.841471 1.000000 

Answer 2

は、残念ながら、私が使用する必要がある数式は、最大（）を使用し、私が紹介したとき、私はエラーを取得します。

私は最大の条件にそれが誤り

cor <- diag(n) + 
    0.5 * (outer(col_2, col_2, "!=") & outer(col_3, col_3, "==")) + 
    0.25 * (outer(1:n, 1:n, "!=") & (outer(col_2, col_2, "==") + outer(col_3, col_3, "==")) != 1) + 
    outer(col_3,col_3,function(x,y) max(sin(x-y)/min(x,y),0.5)) * (outer(col_2, col_2, "==") & outer(col_3, col_3, "!=")) 


Error in outer(col_3, col_3, function(x, y) max(sin(x - y)/min(x, y), : 
    dims [product 4] do not match the length of object [1] 

編集をスローし、エラーを導入しようとすると、これが

cor <- diag(n) + 
    0.5 * (outer(col_2, col_2, "!=") & outer(col_3, col_3, "==")) + 
    0.25 * (outer(1:n, 1:n, "!=") & (outer(col_2, col_2, "==") + outer(col_3, col_3, "==")) != 1) + 
    outer(col_3,col_3,function(x,y) (sin(x-y)/min(x,y))) * (outer(col_2, col_2, "==") & outer(col_3, col_3, "!=")) 

[[1]] 
     [,1]  [,2] 
[1,] 1.00000 -0.28049 
[2,] 0.28049 1.00000 

[[2]] 
     [,1]  [,2]  [,3]  [,4] 
[1,] 1.000000 -0.841471 0.250000 0.250000 
[2,] 0.841471 1.000000 0.500000 0.250000 
[3,] 0.250000 0.500000 1.000000 -0.841471 
[4,] 0.250000 0.250000 0.841471 1.000000 

に動作しますが、私は私がPMAXを使用し、それを動作させる方法を考え出しました。

cor <- diag(n) + 
     0.5 * (outer(col_2, col_2, "!=") & outer(col_3, col_3, "==")) + 
     0.25 * (outer(1:n, 1:n, "!=") & (outer(col_2, col_2, "==") + outer(col_3, col_3, "==")) != 1) + 
     outer(col_3,col_3,function(x,y) pmax(sin(x-y)/min(x,y),0.5)) * (outer(col_2, col_2, "==") & outer(col_3, col_3, "!=")) 

[[1]] 
    [,1] [,2] 
[1,] 1.0 0.5 
[2,] 0.5 1.0 

[[2]] 
     [,1] [,2]  [,3] [,4] 
[1,] 1.000000 0.50 0.250000 0.25 
[2,] 0.841471 1.00 0.500000 0.25 
[3,] 0.250000 0.50 1.000000 0.50 
[4,] 0.250000 0.25 0.841471 1.00