R Programming - Iterating through an Outer Function

Question

I am looking to populate the a matrix with a formula that requires iteration through the matrix cols and rows to pass into a formula.

Below is a simplified representative example of the problem.

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

But even if I didn't get the error I don't think the

sin(topn.3-topn.3)

will iterate.

What I really want to do this...

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

I tried introducing a nested for loop but I can't get it to work

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]

...and even if the nested for loop gets working I think it will bog down on the data. Is there a solution?

Edit: Added desired output...

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

Unfortunately the formula I need to use uses a max() and when I introduce I get an error.

This works

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

but when I try introduce a max condition an error it throws an error

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]

Edit: I figured out how to make it work, I used 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

Answer 2

You can use outer(col3,col3, function(x,y) sin(x,y)). Here is the 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