Mercurial > repos > ppericard > viscorvar
diff additional_functions_block_splsda.R @ 0:d0b77b926863 draft
"planemo upload for repository https://gitlab.com/bilille/galaxy-viscorvar commit 85dac6b13a9adce48b47b2b8cb28d2319ae9c1ca-dirty"
author | ppericard |
---|---|
date | Tue, 23 Jun 2020 19:57:35 -0400 |
parents | |
children | e93350dc99f1 |
line wrap: on
line diff
--- /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) +}