rfunctiontabulate

Tabulate the columns of a matrix in R


I have this piece of code that calculates the vector "week1" (predefined in the exercise), based on the number of times a value is repeated in that column. I would need to create a function that does the same for the other 6 columns (from 2 to 7), using the function apply, but I struggle a bit with functions yet.

This is the piece of code:

    matrix <- matrix(1, 16, 7)

    week1 <- matrix[,1]
    times <- tabulate(week1, 4)
    vectorW1 <- c(1/times[1], 1-1/times[1], 1/times[2], 1-1/times[2],
        1/times[3], 1-1/times[3],1/times[4], 1-1/times[4])

Thank you all in advance for your help!


Solution

  • I've no idea what this code is trying to do, nor what the target function is attempting to do.

    First, let us make it into a function

    mat_to_weights <- function(data) {
      stopifnot(inherits(data, "matrix"))
      result <- matrix(NA, nrow = 8, ncol = ncol(data))
      for (col in seq_len(ncol(data))) {
        
        week <- data[, col]
        week
        times <- tabulate(week, 4)
        times
        vector <-
          c(
            1 / times[1],
            1 - 1 / times[1],
            1 / times[2],
            1 - 1 / times[2],
            1 / times[3],
            1 - 1 / times[3],
            1 / times[4],
            1 - 1 / times[4]
          )
        result[,col] <- vector
      }
      result
    }
    mat_to_weights(data = matrix)
    > mat_to_weights(data = matrix)
           [,1]   [,2]   [,3]   [,4]   [,5]   [,6]   [,7]
    [1,] 0.0625 0.0625 0.0625 0.0625 0.0625 0.0625 0.0625
    [2,] 0.9375 0.9375 0.9375 0.9375 0.9375 0.9375 0.9375
    [3,]    Inf    Inf    Inf    Inf    Inf    Inf    Inf
    [4,]   -Inf   -Inf   -Inf   -Inf   -Inf   -Inf   -Inf
    [5,]    Inf    Inf    Inf    Inf    Inf    Inf    Inf
    [6,]   -Inf   -Inf   -Inf   -Inf   -Inf   -Inf   -Inf
    [7,]    Inf    Inf    Inf    Inf    Inf    Inf    Inf
    [8,]   -Inf   -Inf   -Inf   -Inf   -Inf   -Inf   -Inf
    

    Next, instead of a matrix with 1s, let us try to use dummy matrix from pracma::magic(n).

    > mat_to_weights(data = pracma::magic(1))
         [,1]
    [1,]    1
    [2,]    0
    [3,]  Inf
    [4,] -Inf
    [5,]  Inf
    [6,] -Inf
    [7,]  Inf
    [8,] -Inf
    > mat_to_weights(data = pracma::magic(2))
         [,1] [,2]
    [1,]    1  Inf
    [2,]    0 -Inf
    [3,]  Inf    1
    [4,] -Inf    0
    [5,]  Inf    1
    [6,] -Inf    0
    [7,]    1  Inf
    [8,]    0 -Inf
    Warning message:
    In pracma::magic(2) : There is no magic square of order 2.
    > mat_to_weights(data = pracma::magic(3))
         [,1] [,2] [,3]
    [1,]  Inf    1  Inf
    [2,] -Inf    0 -Inf
    [3,]  Inf  Inf    1
    [4,] -Inf -Inf    0
    [5,]    1  Inf  Inf
    [6,]    0 -Inf -Inf
    [7,]    1  Inf  Inf
    [8,]    0 -Inf -Inf
    > mat_to_weights(data = pracma::magic(4))
         [,1] [,2] [,3] [,4]
    [1,]  Inf  Inf  Inf    1
    [2,] -Inf -Inf -Inf    0
    [3,]  Inf    1  Inf  Inf
    [4,] -Inf    0 -Inf -Inf
    [5,]  Inf  Inf    1  Inf
    [6,] -Inf -Inf    0 -Inf
    [7,]    1  Inf  Inf  Inf
    [8,]    0 -Inf -Inf -Inf
    > mat_to_weights(data = pracma::magic(5))
         [,1] [,2] [,3] [,4] [,5]
    [1,]  Inf  Inf    1  Inf  Inf
    [2,] -Inf -Inf    0 -Inf -Inf
    [3,]  Inf  Inf  Inf    1  Inf
    [4,] -Inf -Inf -Inf    0 -Inf
    [5,]  Inf  Inf  Inf  Inf    1
    [6,] -Inf -Inf -Inf -Inf    0
    [7,]    1  Inf  Inf  Inf  Inf
    [8,]    0 -Inf -Inf -Inf -Inf
    

    Again, not clear this is supposed to do, but the function works.

    Let us rewrite it with apply in mind.

    
    mat_to_weights <- function(data) {
      stopifnot(inherits(data, "matrix"))
      result <- matrix(NA, nrow = 8, ncol = ncol(data))
      apply(data, 2, function(week) {
        times <- tabulate(week, 4)
        vector <-
          c(
            1 / times[1],
            1 - 1 / times[1],
            1 / times[2],
            1 - 1 / times[2],
            1 / times[3],
            1 - 1 / times[3],
            1 / times[4],
            1 - 1 / times[4]
          )
        vector
      })
    }
    

    Other implementations to consider are of course sweep, but for now this works..