flat_full.Rmd

---
title: "flat_full.Rmd for working package"
output: html_document
editor_options: 
chunk_output_type: console
---

<!-- Run this 'development' chunk -->
<!-- Store every call to library() that you need to explore your functions -->

```{r development, include=FALSE}
library(testthat)
```

<!--
 You need to run the 'description' chunk in the '0-dev_history.Rmd' file before continuing your code there.

If it is the first time you use {fusen}, after 'description', you can directly run the last chunk of the present file with inflate() inside.
--> 

```{r development-load}
# Load already included functions if relevant
pkgload::load_all(export_all = FALSE)
```


```{r function-utils, filename = "utils"}
#' Join two data frames using data.table
#'
#' @param d1 Data frame 1
#' @param d2 Data frame 2
#' @param k1 Key columns for data frame 1
#' @param k2 Key columns for data frame 2
#' @importFrom data.table data.table
#' @return Joined data frame
#' @export
#'
#' @examples
#'
#' # Example usage:
#' df1 <- data.frame(id = 1:5, value = letters[1:5])
#' df2 <- data.frame(id = 1:5, category = LETTERS[1:5])
#' join_dtf(df1, df2, "id", "id")
join_dtf <- function(d1, d2, k1, k2) {
  d1.dt_table <- data.table::data.table(d1, key = k1)
  d2.dt_table <- data.table::data.table(d2, key = k2)
  dt_joined <- d1.dt_table[d2.dt_table, allow.cartesian = TRUE]
  return(dt_joined %>% as.data.frame())
}

#' Finds the index of the first non-null element in a list.
#'
#' This function searches a list and returns the index of the first non-null element.
#'
#' @param lst The list to search.
#' @return The index of the first non-null element, or NULL if no non-null element is found.
#' @export
#' 
#' @examples
#' my_list <- list(NULL, NULL, 3, 5, NULL)
#' first_non_null_index(my_list)  # Returns 3
first_non_null_index <- function(lst) {
  for (i in seq_along(lst)) {
    if (!is.null(lst[[i]])) {
      return(i)
    }
  }
  return(NULL)
}



#' Detect rows in a matrix with all values below a given threshold
#'
#' This function detects rows in a matrix where all values are below a specified threshold.
#'
#' @param matrix The input matrix
#' @param threshold The threshold value
#' @return A logical vector indicating rows below the threshold
#' @export
detect_row_matx_bellow_threshold <- function(matrix, threshold) {
    apply(matrix, 1, function(row) all(row < threshold))
}


#' Clean Variable Name
#'
#' This function removes digits, spaces, and special characters from a variable name.
#' If any of these are present, they will be replaced with an underscore '_'.
#'
#' @param name The input variable name to be cleaned.
#' @return The cleaned variable name without digits, spaces, or special characters.
#'
#' @details
#' This function will check the input variable name for the presence of digits,
#' spaces, and special characters. If any of these are found, they will be removed
#' from the variable name and replaced with an underscore '_'. Additionally, it will
#' check if the cleaned name is not one of the reserved names "interactions" or
#' "correlations" which are not allowed as variable names.
#' @export
#' @examples
#' clean_variable_name("my_var_12349309spe ")
clean_variable_name <- function(name){
      message("Variable name should not contain digits, spaces, or special characters.\nIf any of these are present, they will be removed from the variable name.")
      # avoid space in variable name
      name <- gsub(" ", "_", name, fixed = TRUE)
      # avoid digit in variable name
      name <-  gsub("[0-9]", "", name)
      # avoid special character in variable name
      name <-  gsub("[[:punct:]]", "", name)
  
      forbidden_names <- c("interactions", "correlations")
      if (name %in% forbidden_names) {
        forbidden_str <- paste(forbidden_names, collapse = " and ")
        stop(forbidden_str, "cannot be used as variable name")
      }
      return(name)
    
}

#' Convert specified columns to factor
#'
#' @param data The input data frame
#' @param columns The column names to be converted to factors
#' @return The modified data frame with specified columns converted to factors
#' @export
#' @examples
#' data <- data.frame( Category1 = c("A", "B", "A", "B"),
#'                      Category2 = c("X", "Y", "X", "Z"),
#'                      Value = 1:4,
#'                      stringsAsFactors = FALSE )
#' ## -- Convert columns to factors
#' convert2Factor(data, columns = c("Category1", "Category2"))
convert2Factor <- function(data, columns) {
  if (is.character(columns)) {
    columns <- match(columns, colnames(data))
  }

  if (length(columns) > 1) data[, columns] <- lapply(data[, columns], as.factor )
  else data[, columns] <- as.factor(data[, columns])
  return(data)
}

#' Get Setting Table
#'
#' Create a table of experimental settings.
#'
#' This function takes various experimental parameters and returns a data frame
#' that represents the experimental settings.
#'
#' @param n_genes Number of genes in the experiment.
#' @param max_replicates Maximum number of replicates for each gene.
#' @param min_replicates Minimum number of replicates for each gene.
#' @param lib_size  total number of reads
#'
#' @return A data frame containing the experimental settings with their corresponding values.
#' @export
getSettingsTable <- function(n_genes, max_replicates, min_replicates, lib_size ){
  
  settings_df <- data.frame(parameters = c("# genes", "Max # replicates", "Min # replicates", "Library size" ),
                            values = c(n_genes, max_replicates, min_replicates, lib_size))
  rownames(settings_df) <- NULL
  
  return(settings_df)
}


#' Check if a matrix is positive definite
#' This function checks whether a given matrix is positive definite, i.e., all of its eigenvalues are positive.
#' @param mat The matrix to be checked.
#' @return A logical value indicating whether the matrix is positive definite.
#' @export
#' @examples
#' # Create a positive definite matrix
#' mat1 <- matrix(c(4, 2, 2, 3), nrow = 2)
#' is_positive_definite(mat1)
#' # Expected output: TRUE
#'
#' # Create a non-positive definite matrix
#' mat2 <- matrix(c(4, 2, 2, -3), nrow = 2)
#' is_positive_definite(mat2)
#' # Expected output: FALSE
#'
#' # Check an empty matrix
#' mat3 <- matrix(nrow = 0, ncol = 0)
#' is_positive_definite(mat3)
#' # Expected output: TRUE
#'
is_positive_definite <- function(mat) {
  if (nrow(mat) == 0 && ncol(mat) == 0) return(TRUE)
  eigenvalues <- eigen(mat)$values
  all(eigenvalues > 0)
}




#' Get the list of variable names
#'
#' @param list_var R list, e.g., output of init_variable