How to call functions with different arguments, inside another function, to fill a correlation matrix?

[cissagatto]

Hi everyone!!!! I'm having some difficulty to automatized a piece of my code.

I had some functions with different arguments, for example:

ample.e <- function(a,b,c,d){
  return(abs((a*(c+d))/(c*(a+b))))
}

cityblock.e <- function(b,c){
  return(b+c)
}

inner.product.e <- function(a,d){
  return(a+d)
}

Those are similarities measures for categorical (or binary) data. The arguments a, b, c, d, and n are the elements of a contingency table and were previously calculated (each one is a matrix). I need to use those functions to fill a correlation matrix (N x N) that is in another function:

compute.measure <- function(labels, num.labels, a, b, c, d, n, FUN){
  
  retorno = list()
  
  m <- build.matrix.corr(num.labels, labels) 
  u = (num.labels*num.labels) 
  pb <- progress_bar$new(total = u) 
  
  for (i in 1:num.labels){
    for (j in 1:num.labels){
      x = as.numeric(a[i,j]) # get the value from the position (i,j) in matrix a
      y = as.numeric(b[i,j]) # get the value from the position (i,j) in matrix b
      w = as.numeric(c[i,j]) # get the value from the position (i,j) in matrix c
      z = as.numeric(d[i,j]) # get the value from the position (i,j) in matrix d
      k = as.numeric(n[i,j]) # get the value from the position (i,j) in matrix n
      m[i,j] = FUN # here is the problem!!!
      pb$tick()
      Sys.sleep(1/u)
      gc()
    } # end intern for
    gc()
  } # enf extern for  
  return(m)
  gc()
}

Then, I call the function:

# res1 is the result of another function that I call to fill the matrices a,b,d,c, and n.
ma = res1$ma # matrix a
mb = res1$mb # matrix b
mc = res1$mc # matrix c
md = res1$md # matrix d
mn = res2$mn # matrix n
res4 = compute.measure(labels, num.labels, ma, mb, mc, md, mn, cityblock.e)

Here is an example of a result that I will get with the function "compute.measure". For any similarity measure (with different arguments) that I pass as an argument to the function "compute.measure", I will get a correlation matrix N x N as result!

My problem is that I need to use specific arguments in the call of the function: m[i,j] = FUN(arguments). I research a lot yesterday in Google, but it seems that I'm lacking some deep knowledge about advanced R. Indeed, I really don't know everything about R. But, I want to construct a piece of code that I can pass a function with their specific arguments to use in that line to fill the matrix. Is that possible? I really don't want to write a lot of functions, or use a switch/case, because for me I think that is possible to do that in R - I'm wrong? I don't know if I explained my problem in a way that you really can understand, sorry about that.

Sorry for the huge text. But I'm going crazy with that issue! I'm very grateful for any suggestion.

[nirgrahamuk]

given your example where you want to run function cityblock.e and put its result into m[i,j] what arguments do you want to pass ? do you want to do something involving x,y,w,z,k ?

[cissagatto]

Hi!

I need to run the function in that line:

m[i,j] = FUN 

i.e.

m[i,j] = cityblock.e(b, c)

The results of the function must be stored in that matrix m. Then, each function has a different number of arguments, and is that why I'm struggling.

x, y, w, z, and k are my correspondent arguments a, b, c, d, and n, but each function uses only some of them, not all.

Does this help? Thanks =)

[nirgrahamuk]

My first idea is to try using do.call
in this example i pass the multiplication function which takes arguments named e1 and e2 and multiplies them together. I'm going to pass as a quoted parameter the variable internal to my calc_func_on_y function that I want to use as e1.

call_func_on_y <- function(fn ,args){
  a <- 1
  b <- 2 
  do.call(what = fn,
          args = args)
}

# 1 * 2
call_func_on_y(`*`,list(e1=quote(a),e2=2))
# 2 * 2
call_func_on_y(`*`,list(e1=quote(b),e2=2))
# 1 * 3
call_func_on_y(`*`,list(e1=quote(a),e2=3))
# 2* 3
call_func_on_y(`*`,list(e1=quote(b),e2=3))

[cissagatto]

Hi!

I will try and return later =)

Thanks for now

[FJCC]

If I understand you correctly, you want to do some element-by-element arithmetic with functions you define on matrices that must first be converted from characters to numbers. I suggest you use a ... argument in your main function to allow passing different sets of arguments.

Fun1 <- function(l) l$a + l$b
Fun2 <- function(l) l$c * l$d
Fun3 <- function(l) (l$a * (l$c+l$d))/(l$c * (l$a+l$b))

MainFun <- function(Fun, ...) {
  Args <- list(...)
  Args <- lapply(Args, function(M) apply(X = M, MARGIN = c(1,2), FUN = as.numeric)) #convert to numbers
  Fun(Args)
}

#invent data
ma <- matrix(as.character(1:9), nrow = 3)
ma
#>      [,1] [,2] [,3]
#> [1,] "1"  "4"  "7" 
#> [2,] "2"  "5"  "8" 
#> [3,] "3"  "6"  "9"
mb <- matrix(as.character(11:19), nrow = 3)
mc <- matrix(as.character(4:12), nrow = 3)
md <- matrix(as.character(12:20), nrow = 3)

MainFun(Fun = Fun1, a = ma, b = mb)
#>      [,1] [,2] [,3]
#> [1,]   12   18   24
#> [2,]   14   20   26
#> [3,]   16   22   28
MainFun(Fun2, c = mc, d = md)
#>      [,1] [,2] [,3]
#> [1,]   48  105  180
#> [2,]   65  128  209
#> [3,]   84  153  240
MainFun(Fun3, a = ma, b = mb, c = mc, d = md)
#>           [,1]      [,2]      [,3]
#> [1,] 0.3333333 0.6984127 0.8166667
#> [2,] 0.5142857 0.7500000 0.8391608
#> [3,] 0.6250000 0.7878788 0.8571429

^{Created on 2021-10-19 by the reprex package (v2.0.1)}

[cissagatto]

Hi FJCC!!

Exactly that's!! The only difference is that I'm using only binary data! Your example works perfectly for me! I'm very grateful to you, really!!!! And your solution is much more elegant. I really appreciate it. I'm relieved now.

Functions for similarities measures:

ample.e <- function(l) abs((a*(c+d))/(c*(a+b)))
baroni.urbani.buser.1.e <- function(l) (sqrt((a*d)) + a)/((sqrt((a*d))) + a + b + c)
bray.curtis.e <- function(l) (b+c)/((2*a)+b+c)

Main Function:

compute.measure <- function(Fun, ...) {
  Args <- list(...)
  Args <- lapply(Args, function(M) apply(X = M, MARGIN = c(1,2), FUN = as.numeric)) #convert to numbers
  Fun(Args)
}

Calling:

compute.measure(Fun = jaccard.e, a = a, b = b, c = c)

[FJCC]

I think there is a bug in your code. You define ample.e as

ample.e <- function(l) abs((a*(c+d))/(c*(a+b)))

The function's argument is l but inside of the function your refer to the variables a, b, c, and d. In my code those were l$a, l$b, l$c, l$d. The logic of the main function is that all of the arguments besides the function get passed to ... and ... gets changed into a named list. That list gets passed to whatever function you have assigned to the Fun argument. By using bare names like a and b, you are not using the named list at all. R will look elsewhere for variables a and b and it happens to find them in your global environment. If you name your original matrices ma, mb, and mc and you run

compute.measure(Fun = jaccard.e, a = ma, b = mb, c = mc)

I think your code will fail. You have to change the functions like ample.e to work with the components of the list named l.

[cissagatto]

Understood!!!

Thanks again =)

[cissagatto]

Hi FJCC

I understand!! Here is the correct code:

Before:

ample.e.2 <- function(a,b,c,d,n){
  return(abs((a*(c+d))/(c*(a+b))))
} 

canberra.e.2 <- function(a,b,c,d,n){
  return((b+c)^(2/2))
}

cityblock.e.2 <- function(a,b,c,d,n){
  return(b+c)
}

jaccard.e.2 <- function(a,b,c,d,n){
  return(a/(a+b+c))
}

After:

ample.e <- function(l) abs((l$a*(l$c+l$d))/(l$c*(l$a+l$b)))
canberra.e <- function(l) ((l$b+l$c)^(2/2))
cityblock.e <- function(l) (l$b+l$c)
jaccard.e <- function(l) (l$a/(l$a+l$b+l$c))

My categorical data (console output)

> head(labels)
  Label1 Label2 Label3 Label4
1      1      0      0      0
2      1      0      0      0
3      1      0      0      0
4      1      0      0      0
5      1      0      0      0
6      1      0      0      0

Compute contingency table (console output)

> res1 = compute.cont.table(labels, num.labels)                                                                                                     
> res1
$ma
       Label1 Label2 Label3 Label4
Label1    139      1      0      1
Label2      1     15      0      0
Label3      0      0    167      2
Label4      1      0      2     98

$mb
       Label1 Label2 Label3 Label4
Label1      0     14    167     97
Label2    138      0    167     98
Label3    139     15      0     96
Label4    138     15    165      0

$mc
       Label1 Label2 Label3 Label4
Label1      0    138    139    138
Label2     14      0     15     15
Label3    167    167      0    165
Label4     97     98     96      0

$md
       Label1 Label2 Label3 Label4
Label1    276    262    109    179
Label2    262    400    233    302
Label3    109    233    248    152
Label4    179    302    152    317

Then compute the similarities measures:

# results from res1
m.a = res1$ma
m.b = res1$mb
m.c = res1$mc
m.d = res1$md
compute.measure(Fun = jaccard.e, a = m.a, b = m.b, c = m.c)

Output:

> compute.measure(Fun = jaccard.e, a = m.a, b = m.b, c = m.c)
            Label1      Label2      Label3      Label4
Label1 1.000000000 0.006535948 0.000000000 0.004237288
Label2 0.006535948 1.000000000 0.000000000 0.000000000
Label3 0.000000000 0.000000000 1.000000000 0.007604563
Label4 0.004237288 0.000000000 0.007604563 1.000000000

Thanks again!!!
Best regards
=)