U ovom postu, pokazaćemo na jednostavnom primeru primenu rekurzivne funkcije. Problem koji želimo da rešimo je sledeći. Imamo matricu dimenzija N x M. To može na primer biti dvodimenzionalna tabela kontingencije. Kolone koje imaju srednju vrednost manju od zadate vrednosti potrebno je sabrati sa susednom kolonom. U slučaju kada postoje dve susedne kolone bira se ona koja ima manju srednju vrednost. Ovakva vrsta problema se može elegantno rešiti primenom rekurzivnih funkcija.
U primeru ćemo koristiti matricu 5 x 8. Generisaćemo 40 celih brojeva u intervalu od 1 do 9.

# Definišemo početnu vrednost generatora slučajnih brojeva
set.seed(155)

# Kreiramo matricu 5 x 8
mat <- matrix(ceiling(runif(40, 0, 9)), 5, 8)

# Imenujemo kolone i redove novokreirane matrice
colnames(mat) <- LETTERS[1:8]
rownames(mat) <- letters[1:5] 

# Štampanje kreirane matrice 
knitr::kable(mat) %>% kable_styling(full_width = F)

Želimo da pripojimo drugim kolonama sve kolone koje imaju srednju vrednost manju od 5. U ovom primeru, kolone sa srednjim vrednostima manjim od 5 su C, E i F. Kolonu C je potrebno pripojiti koloni B (srednja vrednost B < srednja vrednost D), a kolonu E je potrebno sabrati sa kolonom F (srednja vrednost F < srednja vrednost D). Kako je kolona F pripojena koloni E, nju nije potrebno spajati sa drugim kolonama.

# Računanje srednjih vrednosti kolona matrice 
col_means <- round(colMeans(mat), 1) 

# Štampanje srednjih vrednosti kolona matrice 
knitr::kable(t(as.matrix(col_mens))) %>% kable_styling(full_width = F)

Prvo ćemo kreirati pomoćnu funkciju merge_columns() koja spaja dve kolone po gore opisanom algoritmu. Implementacija funkcije se nalazi u dodatku na kraju posta.
Rekurzivna funkcija će pozivati samu sebe dok god postoji kolona sa srednjom vrednošću manjom od 5.

collapsing_matrix <- function(mat, threshold) {
  col_means <- colMeans(mat)
  ind <- which(col_means < threshold)[1]
  
  if (!is.na(ind)) {
    mat <- merge_columns(mat, ind)
    
    # funkcija poziva samu sebe ako postoji kolona 
    # sa srednjom vrednoscu manjom od zadatog praga
    collapsing_matrix(mat, threshold)
  } else {
    return(mat)
  }
}

Primenom funkcije na gore definisanu matricu, dobijamo očekivani rezultat.

# Generisanje matrice prema zadatom kriterijumu
new_mat <- collapsing_matrix(mat, threshold = 5) 

# Štampanje kreirane matrice 
knitr::kable(new_mat) %>% kable_styling(full_width = F)

Funkcija se može primeniti na matricu bilo kojih dimenzija.

Srednje vrednosti kolona matrice.

Rezultat posle poziva funkcije collapsing_matrix() za vrednost praga 5.

Uz manje izmene u R kodu može se rekurzivna funkcija iz dodatka napisati tako da se umesto srednje vrednosti može koristiti neki drugi kriterijum, na primer, minimalna vrednost.

Dodatak

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)
}