R/convert_comp_to_log.R

In autoFC: Automatic Toolkit for Construction, Optimization, Scoring and Simulation of Forced-Choice Tests

#' Convert Compositional Points Data to Log-Ratios
#'
#' @description Converts raw "proportion-of-total" or points-allocation data
#' (where respondents distribute a fixed sum of points within blocks) into
#' continuous log-ratios suitable for continuous Thurstonian factor modeling.
#' Implements Aitchison's geometry and handles zero-responses securely.
#'
#' Note that because both \code{n_blocks} and \code{block_size} are required,
#' only the first \code{n_blocks * block_size} columns in \code{data} will be
#' extracted. Make sure the input data does not contain additional irrelevant columns!
#'
#' @param data A compositional data frame or matrix where rows are respondents and columns are items
#'        ordered by block (e.g., Block 1 Item 1, Block 1 Item 2, etc.).
#' @param n_blocks Integer. Number of blocks in the questionnaire.
#' @param block_size Integer. Number of items per block.
#' @param delta Numeric. The value used to impute zero responses. Must be smaller than
#'        the smallest possible positive score (e.g., if users can allocate integers
#'        starting at 1, the default \code{0.5} is optimal).
#'
#' @return A data frame of continuous log-ratios. Column names will be formatted
#'         as "y1y3", "y2y3" representing the log-ratio of Item 1 to the referent Item 3.
#' @export
convert_comp_to_log <- function(data, n_blocks, block_size, delta = 0.5) {

  data <- as.data.frame(data)
  n_items <- n_blocks * block_size
  N <- nrow(data)

  if (ncol(data) < n_items) {
    stop("The dataset has fewer columns than n_blocks * block_size.")
  }

  data <- data[, 1:n_items]

  # Calculate the number of output log-ratio columns: n_blocks * (block_size - 1)
  n_out_cols <- n_blocks * (block_size - 1)
  log_ratios <- data.frame(matrix(NA, nrow = N, ncol = n_out_cols))

  out_col_idx <- 1

  # Process block by block
  for (b in 1:n_blocks) {
    block_cols <- ((b - 1) * block_size + 1):(b * block_size)
    block_data <- as.matrix(data[, block_cols, drop = FALSE])

    # Calculate the sum of points allocated in this block (C)
    C <- rowSums(block_data, na.rm = TRUE)

    # Identify complete skips (entire block is NA or 0)
    skipped_blocks <- is.na(C) | C == 0

    # Identify zeros within this block
    is_zero <- block_data == 0
    is_zero[is.na(is_zero)] <- FALSE
    n_zeros <- rowSums(is_zero)

    # --- EQUATION 5: ZERO IMPUTATION & SCALING ---
    # Multiplier for non-zero elements: 1 - (n_zeros * delta) / C
    multiplier <- 1 - (n_zeros * delta) / C

    # Build the imputed block
    imputed_block <- block_data
    imputed_block[is_zero] <- delta

    # Apply the multiplicative adjustment to the non-zero columns
    for (col_idx in 1:block_size) {
      non_zero_mask <- !is_zero[, col_idx] & !is.na(block_data[, col_idx])
      imputed_block[non_zero_mask, col_idx] <- imputed_block[non_zero_mask, col_idx] * multiplier[non_zero_mask]
    }

    # If the block was skipped entirely, set all values to NA
    imputed_block[skipped_blocks, ] <- NA_real_

    # --- LOG-RATIO TRANSFORMATION ---
    # The last item in the block is the referent (denominator)
    ref_col <- imputed_block[, block_size]
    log_ref <- log(ref_col)

    for (i in 1:(block_size - 1)) {
      item_global_idx <- (b - 1) * block_size + i
      ref_global_idx <- b * block_size

      col_name <- paste0("y", item_global_idx, "y", ref_global_idx)

      # y_ik = ln(item_i) - ln(item_ref)
      log_ratios[, out_col_idx] <- log(imputed_block[, i]) - log_ref
      colnames(log_ratios)[out_col_idx] <- col_name
      out_col_idx <- out_col_idx + 1
    }
  }

  return(log_ratios)
}