diff additional_functions_block_splsda.R @ 0:d0b77b926863 draft

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

--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/additional_functions_block_splsda.R	Tue Jun 23 19:57:35 2020 -0400
@@ -0,0 +1,104 @@
+#' @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)
+}