tidy_svd.R

library(tidyverse)
tidy_svd = function(long_data, rows_from, columns_from, values_from, ndimensions=10) {
  # center the data
  long_data[[values_from]] = long_data[[values_from]] - mean(long_data[[values_from]], na.rm=TRUE)
  
  # pivot and cast to wide matrix
  m <- long_data |>
    select(all_of(c(rows_from, columns_from, values_from))) |>
    na.omit() |>
    pivot_wider(names_from=columns_from, values_from=values_from, values_fill = 0) |>
    column_to_rownames(rows_from) |>
    as.matrix()
  
  # Compute SVD
  udv <- svd(m, ndimensions, ndimensions)
  
  # Create nicer looking versions of u, d, and v
  dimnames <- str_c("V", 1:ndimensions)
  udv$d <- udv$d[1:ndimensions]
  udv$weights <- tibble(dimension=dimnames, weight=udv$d)

  colnames(udv$v) <- dimnames
  rownames(udv$v) <- colnames(m)
  udv$v_values = as_tibble(udv$v, rownames=columns_from) |> 
    pivot_longer(-columns_from, names_to="dimension", values_to="v_value")

  colnames(udv$u) <- dimnames
  rownames(udv$u) <- rownames(m)
  udv$u_values = as_tibble(udv$u, rownames=rows_from) |> 
    pivot_longer(-rows_from, names_to="dimension", values_to="u_value")
  
  # Add predictions
  p <- (udv$u %*% diag(udv$d, nrow=length(udv$d)) %*% t(udv$v)) 
  udv$predictions = as_tibble(p, rownames=rows_from) |>
    pivot_longer(-rows_from, names_to=columns_from, values_to="prediction")
  return(udv)
}