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

不幸的是我需要使用公式使用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