In this post, we will show on a simple example the application of a recursive function. The problem that we want to solve is the following. We have a matrix of dimensions N x M. This can be, for example, a two-dimensional contingency table. Columns that have a mean value less than the set value must be added to the adjacent column. In the case where there are two adjacent columns the lower one is selected. This kind of problem can be resolved elegantly with the use of recursive functions.

In the example we will use the matrix 5 x 8. We will generate 40 integers in the interval from 1 to 9.

[code lang=”r” firstline=”1″]

# Define a seed for the random number generator

set.seed(155)

# Create a matrix 5 x 8

mat <- matrix(ceiling(runif(40, 0, 9)), 5, 8)

# Name columns and rows of a newly created matrix

colnames(mat) <- LETTERS[1:8]

rownames(mat) <- letters[1:5]

# Print the matrix

print(mat)

[/code]

A B C D E F G H a 8 3 9 8 6 5 5 3 b 4 7 2 5 5 1 4 6 c 7 6 2 5 3 2 7 8 d 7 5 5 8 2 5 8 8 e 5 5 2 2 2 8 3 5

We want to merge other columns with all columns with a mean value of less than 5. In this example, columns with mean values less than 5 are C, E and F. Column C must be added to column B (mean B < mean D) and column E must be added to column F (mean F < mean D). Since column F is added to column E, it is not necessary to merge it with other columns.

[code lang=”r” firstline=”13″]

# Calculating columns mean values

col_means <- round(colMeans(mat), 1)

# Print the columns mean values

print(t(as.matrix(col_means)))

[/code]

A B C D E F G H [1,] 6.2 5.2 4 5.6 3.6 4.2 5.4 6

First we will create an auxiliary [su_label]merge_columns[/su_label] function that merges two columns according to the above described algorithm. Implementation of the function is in the appendix at the end of the post.

The recursive function will call itself as long as there is a column with a mean value less than 5.

[code lang=”r” firstline=”18″]

collapsing_matrix <- function(mat, threshold) {

col_means <- colMeans(mat)

ind <- which(col_means < threshold)[1]

if (!is.na(ind)) {

mat <- merge_columns(mat, ind)

# the function calls itself if there is a column

# with a mean value less than threshold

collapsing_matrix(mat, threshold)

} else {

return(mat)

}

}

[/code]

By applying the function to the matrix defined above, we are getting the expected result.

[code lang=”r” firstline=”32″]

# Generating a matrix according to a specified condition

new_mat <- collapsing_matrix(mat, threshold = 5)

# Print the matrix

print(new_mat)

[/code]

A B,C D E,F G H a 8 12 8 11 5 3 b 4 9 5 6 4 6 c 7 8 5 5 7 8 d 7 10 8 7 8 8 e 5 7 2 10 3 5

The function can be applied to a matrix of any dimension. For instance, we have a matrix 5 x 20.

A B C D E F G H I J K L M N O P Q R S T a 8 3 9 8 6 5 5 3 8 3 9 8 6 5 5 3 8 3 9 8 b 4 7 2 5 5 1 4 6 4 7 2 5 5 1 4 6 4 7 2 5 c 7 6 2 5 3 2 7 8 7 6 2 5 3 2 7 8 7 6 2 5 d 7 5 5 8 2 5 8 8 7 5 5 8 2 5 8 8 7 5 5 8 e 5 5 2 2 2 8 3 5 5 5 2 2 2 8 3 5 5 5 2 2

The mean values of the columns of the matrix.

A B C D E F G H I J K L M N O P Q R S T [1,] 6.2 5.2 4 5.6 3.6 4.2 5.4 6 6.2 5.2 4 5.6 3.6 4.2 5.4 6 6.2 5.2 4 5.6

Result after calling the function [su_label]collapsing_matrix()[/su_label] for threshold value 5.

A B,C D E,F G H I J,K L M,N O P Q R,S T a 8 12 8 11 5 3 8 12 8 11 5 3 8 12 8 b 4 9 5 6 4 6 4 9 5 6 4 6 4 9 5 c 7 8 5 5 7 8 7 8 5 5 7 8 7 8 5 d 7 10 8 7 8 8 7 10 8 7 8 8 7 10 8 e 5 7 2 10 3 5 5 7 2 10 3 5 5 7 2

With fewer changes in the R code, the recursive function in the appendix can be written so that instead of the mean value, different criterion could be used, for example, the minimum value.

#### Appendix

[code lang=”r”]

merge_columns <- function(mat, ind) {

n_cols <- ncol(mat)

col_ind <- 1:n_cols

col_names <- colnames(mat)

col_means <- colMeans(mat)

if (ind == 1) {

start <- NULL

i <- 0

j <- 1

end <- setdiff(col_ind, c(1,2))

} else {

if (ind == ncol(mat)) {

start <- setdiff(col_ind, c(n_cols-1, n_cols))

i <- -1

j <- 0

end <- NULL

} else {

mean_before <- col_means[ind-1]

mean_after <- col_means[ind+1]

if (mean_before <= mean_after) {

start <- col_ind[col_ind < ind-1]

i <- -1

j <- 0

end <- col_ind[col_ind > ind]

} else {

start <- col_ind[col_ind < ind]

i <- 0

j <- 1

end <- col_ind[col_ind > ind+1]

}

}

}

mat <- cbind(mat[,start], c(mat[,ind+i] + mat[,ind+j]), mat[,end])

new_col_names <- c(col_names[start], paste(col_names[ind+i], col_names[ind+j], sep = ","), col_names[end])

colnames(mat) <- new_col_names

return(mat)

}

[/code]