#' @title Generate a simulated sparse matrix
#'
#' @description
#' This function generates a sparse matrix with a specified number of rows and columns,
#' a given sparsity level, and a distribution function for the non-zero values.
#'
#' @md
#' @param nrow Number of rows in the matrix.
#' @param ncol Number of columns in the matrix.
#' @param sparsity Proportion of zero elements (sparsity level).
#' Default is `0.95`, meaning 95% of elements are zero (5% are non-zero).
#' @param distribution_fun Function to generate non-zero values.
#' @param decimal Controls the number of decimal places in the generated values.
#' If set to `0`, values will be integers.
#' When `decimal` > 0, random decimal parts are uniformly distributed across the full range.
#' Default is `0`.
#' @param seed Random seed for reproducibility.
#'
#' @return
#' A sparse matrix of class "dgCMatrix".
#'
#' @export
#'
#' @examples
#' simulate_sparse_matrix(1000, 500) |>
#'   check_sparsity()
#'
#' simulate_sparse_matrix(10, 10, decimal = 1)
#' simulate_sparse_matrix(10, 10, decimal = 5)
simulate_sparse_matrix <- function(
    nrow,
    ncol,
    sparsity = 0.95,
    distribution_fun = function(n) stats::rpois(n, lambda = 0.5) + 1,
    decimal = 0,
    seed = 1) {
  set.seed(seed)

  nnz <- round(nrow * ncol * (1 - sparsity))

  total_positions <- nrow * ncol
  if (nnz > total_positions) {
    nnz <- total_positions
  }

  positions <- sample(total_positions, nnz, replace = FALSE)

  i <- ((positions - 1) %% nrow) + 1
  j <- ((positions - 1) %/% nrow) + 1

  x <- distribution_fun(nnz)

  if (decimal > 0) {
    decimal_part <- stats::runif(nnz, min = 0, max = 1)
    x <- x + decimal_part
  }

  x <- round(x, decimal)

  Matrix::sparseMatrix(
    i = i,
    j = j,
    x = x,
    dims = c(nrow, ncol),
    dimnames = list(
      paste0("row_", 1:nrow),
      paste0("col_", 1:ncol)
    )
  )
}

#' @title Check sparsity of matrix
#'
#' @param x A matrix.
#'
#' @return
#' Sparsity of matrix.
#'
#' @export
check_sparsity <- function(x) {
  total_counts <- prod(dim(x))
  
  if (inherits(x, "sparseMatrix")) {
    non_zero_count <- Matrix::nnzero(x)
  } else {
    non_zero_count <- sum(x != 0)
  }

  sparsity_ratio <- non_zero_count / total_counts

  1 - sparsity_ratio
}

.rmse <- function(true, pred) {
  sqrt(mean((true - pred)^2))
}

.sse <- function(y_true, y_pred) {
  sum((y_true - y_pred)**2)
}

.rse <- function(y_true, y_pred) {
  .sse(y_true, y_pred) / .sse(y_true, mean(y_true))
}

#' @title Coefficient of determination (\eqn{R^2})
#'
#' @param y_true A numeric vector with ground truth values.
#' @param y_pred A numeric vector with predicted values.
#'
#' @return
#' The \eqn{R^2} value.
#'
#' @export
#'
#' @examples
#' y <- rnorm(100)
#' y_pred <- y + rnorm(100, sd = 0.5)
#' r_square(y, y_pred)
r_square <- function(y_true, y_pred) {
  1 - .rse(y_true, y_pred)
}

#' @title Normalize numeric vector
#'
#' @md
#' @param x Input numeric vector.
#' @param method Method used for normalization.
#' @param na_rm Whether to remove `NA` values,
#' and if setting `TRUE`, using `0` instead.
#' Default is `TRUE`.
#' @param ... Parameters for other methods.
#'
#' @return
#' Normalized numeric vector.
#'
#' @export
#'
#' @examples
#' x <- c(runif(2), NA, -runif(2))
#' x
#' normalization(x, method = "max_min")
#' normalization(x, method = "maximum")
#' normalization(x, method = "sum")
#' normalization(x, method = "softmax")
#' normalization(x, method = "z_score")
#' normalization(x, method = "mad")
#' normalization(x, method = "unit_vector")
#' normalization(x, method = "unit_vector", na_rm = FALSE)
normalization <- function(
    x,
    method = "max_min",
    na_rm = TRUE,
    ...) {
  method <- match.arg(
    method,
    c(
      "max_min",
      "maximum",
      "sum",
      "softmax",
      "z_score",
      "mad",
      "unit_vector",
      "robust_scale"
    )
  )
  na_index <- which(is.na(x))
  x_calc <- x
  x_calc[na_index] <- NA
  safe_fill <- function(value = 0) {
    out <- rep_len(value, length(x_calc))
    out[na_index] <- NA_real_
    out
  }
  x <- switch(
    EXPR = method,
    "max_min" = {
      min_x <- min(x_calc, na.rm = TRUE)
      max_x <- max(x_calc, na.rm = TRUE)
      range_x <- max_x - min_x
      if (!is.finite(range_x) || range_x == 0) {
        safe_fill(0)
      } else {
        (x_calc - min_x) / range_x
      }
    },
    "maximum" = {
      max_abs_x <- max(abs(x_calc), na.rm = TRUE)
      if (!is.finite(max_abs_x) || max_abs_x == 0) {
        safe_fill(0)
      } else {
        x_calc / max_abs_x
      }
    },
    "sum" = {
      abs_sum <- sum(abs(x_calc), na.rm = TRUE)
      if (!is.finite(abs_sum) || abs_sum == 0) {
        safe_fill(0)
      } else {
        x_calc / abs_sum
      }
    },
    "softmax" = {
      x_mean <- mean(x_calc, na.rm = TRUE)
      x_sd <- stats::sd(x_calc, na.rm = TRUE)
      if (!is.finite(x_sd) || x_sd == 0) {
        valid_count <- sum(!is.na(x_calc))
        if (valid_count == 0) {
          safe_fill(0)
        } else {
          out <- safe_fill(0)
          out[!is.na(x_calc)] <- 1 / valid_count
          out
        }
      } else {
        temp <- (x_calc - x_mean) / x_sd
        exp_temp <- exp(temp)
        exp_temp / sum(exp_temp, na.rm = TRUE)
      }
    },
    "z_score" = {
      x_sd <- stats::sd(x_calc, na.rm = TRUE)
      if (!is.finite(x_sd) || x_sd == 0) {
        safe_fill(0)
      } else {
        (x_calc - mean(x_calc, na.rm = TRUE)) / x_sd
      }
    },
    "mad" = {
      x_mad <- stats::mad(x_calc, na.rm = TRUE)
      if (!is.finite(x_mad) || x_mad == 0) {
        safe_fill(0)
      } else {
        (x_calc - stats::median(x_calc, na.rm = TRUE)) / x_mad
      }
    },
    "unit_vector" = {
      norm_x <- sqrt(sum(x_calc^2, na.rm = TRUE))
      if (!is.finite(norm_x) || norm_x == 0) {
        safe_fill(0)
      } else {
        x_calc / norm_x
      }
    },
    "robust_scale" = {
      q1 <- stats::quantile(x_calc, 0.25, na.rm = TRUE)
      q3 <- stats::quantile(x_calc, 0.75, na.rm = TRUE)
      iqr <- q3 - q1
      med <- stats::median(x_calc, na.rm = TRUE)
      if (!is.finite(iqr) || iqr == 0) {
        safe_fill(0)
      } else {
        (x_calc - med) / iqr
      }
    }
  )

  if (na_rm) {
    x[na_index] <- 0
  }

  x
}

fc_matrix <- function(matrix) {
  row_means <- if (inherits(matrix, "sparseMatrix")) {
    Matrix::rowMeans(matrix)
  } else {
    rowMeans(matrix)
  }
  matrix / row_means
}

zscore_matrix <- function(matrix, ...) {
  Matrix::t(scale(Matrix::t(matrix), ...))
}

log2fc_matrix <- function(matrix) {
  row_means <- if (inherits(matrix, "sparseMatrix")) {
    Matrix::rowMeans(matrix)
  } else {
    rowMeans(matrix)
  }
  log2(matrix / row_means)
}

#' @title Process matrix
#'
#' @param matrix A matrix.
#' @param method Method to use for processing the matrix.
#' @param ... Other arguments passed to the method.
#'
#' @return A processed matrix.
#'
#' @export
#'
#' @examples
#' m <- simulate_sparse_matrix(10, 10)
#' matrix_process(m, method = "raw")
#' matrix_process(m, method = "zscore")
#' matrix_process(m, method = "fc")
#' matrix_process(m, method = "log2fc")
#' matrix_process(m, method = "log1p")
#' m <- as_matrix(m)
#' matrix_process(m, method = function(x) x / rowMeans(x))
matrix_process <- function(
    matrix,
    method = c("raw", "zscore", "fc", "log2fc", "log1p"),
    ...) {
  if (is.function(method)) {
    matrix_processed <- method(matrix, ...)
  } else {
    method <- match.arg(method)
    matrix_processed <- switch(
      EXPR = method,
      "raw" = {
        matrix
      },
      "fc" = {
        fc_matrix(matrix, ...)
      },
      "zscore" = {
        zscore_matrix(matrix, ...)
      },
      "log2fc" = {
        log2fc_matrix(matrix)
      },
      "log1p" = {
        log1p(matrix)
      }
    )
  }

  if (!identical(dim(matrix_processed), dim(matrix))) {
    log_message(
      "The dimensions of the matrix are changed after processing",
      message_type = "error"
    )
  }
  return(matrix_processed)
}
