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

我尝试引入一个嵌套的 for 循环，但我无法让它工作

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

不幸的是，我需要使用的公式使用 max()，当我引入时出现错误。

这行得通

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

但是当我尝试引入一个最大条件时，它会抛出一个错误

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]

编辑：我想出了如何让它工作，我使用了 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