view additional_functions_block_splsda.R @ 0:d0b77b926863 draft

"planemo upload for repository https://gitlab.com/bilille/galaxy-viscorvar commit 85dac6b13a9adce48b47b2b8cb28d2319ae9c1ca-dirty"

#' @title Check if a block contains missing values
#' @description Check if a block contains missing values
#' @param list_X type : list of matrix. This list is used to perform the data integration.
#' @details This function checks if a block contains missing values.
#' @return  type : boolean. If at least one block contains missing values, 
#' this function returns TRUE, otherwise this function returns FALSE.
#' @examples 
#' X1 = matrix(1:9, nrow = 3, ncol = 3)
#' X2 = matrix(10:18, nrow = 3, ncol = 3)
#' list_X = list()
#' list_X[[1]] = X1
#' list_X[[2]] = X2
#' names(list_X) = c("X1", "X2")
#' boolean_block_missing_values = blockMissingValues(list_X)
#' @export
blockMissingValues <-function(list_X)
{
  name_blocks = names(list_X)
  name_blocks_missing_values = c()
  boolean_block_missing_values = FALSE 
  
  for(i in 1:length(list_X))
  {
    X_i = list_X[[i]]
    name_block_i = name_blocks[i]
    
    vec = sapply(1:dim(X_i)[2], FUN = function(j){
      res = any(is.na(X_i[, j]))
      
      return(res)
    })
    
    if(any(vec))
    {
      name_blocks_missing_values = c(name_blocks_missing_values, name_block_i)
      
    }
    
  } # End for(i in 1:length(list_X)).
  
  if(length(name_blocks_missing_values) != 0)
  {
    stop(paste("The data integration can not be performed if a block contains missing values  : ", paste(name_blocks_missing_values, collapse = ", "), " contains missing values. "))
    boolean_block_missing_values = TRUE
    
  }
  
  return(boolean_block_missing_values)  
  
}


#' @title Determination of selected variables for all components
#' @description The function unionSelectBlockVariables determines, for each block, the selected block variables
#' for all components.
#' @param res_block_splsda type : sgccda. This parameter is the output of block.splsda function 
#' mixOmics.
#' @details For each block, the function unionSelectBlockVariables returns 1 if the block variable is selected for
#' at least one component. Otherwise, this function returns 0.
#' @return type : list of matrix. For each block, if the block variable is selected, the value 1 is associated with 
#' this block variable. Otherwise the value 0 is associated with this block variable. 
#' @examples 
#' data(res_data_integration)
#' list_union_selected_block_variables = unionSelectBlockVariables(res_data_integration)
#' @export
unionSelectBlockVariables <-function(res_block_splsda)
{
  ncomp = res_block_splsda$ncomp[1]
  
  names_blocks = names(res_block_splsda$loadings)
  index_Y = which(names_blocks == "Y")
  names_blocks = names_blocks[ - index_Y]
  list_select_block_variables = list()
  
  for(i in 1:length(names_blocks))
  {
    mat_loadings_i = res_block_splsda$loadings[[i]]
    index_i = c()
    
    for(j in 1:ncomp)
    {
      loadings_i_j = mat_loadings_i[, j]
      index_i_j = which(loadings_i_j != 0)
      
      index_i = c(index_i, index_i_j)
      
    } # End for(j 1:ncomp).
    
    index_i = unique(index_i)
    
    mat_select_block_variables = matrix(0,
                                        nrow = dim(mat_loadings_i)[1],
                                        ncol = 1)
    mat_select_block_variables[index_i, 1] = rep(1, length(index_i))
    rownames(mat_select_block_variables) = rownames(mat_loadings_i)
    
    list_select_block_variables[[i]] = mat_select_block_variables
    
  } # End for(i in 1:length(names_blocks)).
  
  names(list_select_block_variables) = names_blocks
  
  return(list_select_block_variables)
}