mixomics_blocksplsda: Integration_block_splsda

comparison Integration_block_splsda_fonc.R @ 3:0a3c83f2197a draft

planemo upload for repository https://github.com/bilille/galaxy-mixomics-blocksplsda commit 24b8259494ac7ab10cbd1f9ee991f455a7507590-dirty

author	ppericard
date	Fri, 25 Oct 2019 07:10:59 -0400
parents
children

comparison

equal deleted inserted replaced

-:655d1fbcd3e6
+:0a3c83f2197a
+# La fonction meanSpotRepl remplace les valeurs des spots répliqués par la
+# moyenne de leurs intensités.
+meanSpotRepl <-function(mat)
+{
+ProbeName = colnames(mat)
+isDup = duplicated(ProbeName)
+dupNames = ProbeName[isDup]
+for (dups in unique(dupNames))
+{
+mat[dups,] = apply(mat[which(colnames(mat) == dups), ], 2, mean)
+}
+res = mat[, -which(isDup)] # On retire de la matrice mat toutes les spots qui sont répliqués.
+return(res)
+}
+# La fonction supprimerVaConst supprime de la matrice mat les variables constantes.
+supprimerVaConst <-function(mat)
+{
+name_mat = deparse(substitute(mat))
+cat(paste0("Pour ", name_mat, ", avant suppression des variables constantes, il y a ", dim(mat)[2], " variables."), "\n")
+indiceVaConst = sapply(1:dim(mat)[2], FUN = function(i){
+col_mat_i = mat[, i]
+res = all(col_mat_i == col_mat_i[1])
+return(res)
+})
+if(length(which(indiceVaConst == FALSE)) != 0)
+{
+res = mat[, which(indiceVaConst == FALSE)]
+}else{
+res = mat
+}
+cat(paste0("Pour ", name_mat, ", après suppression des variables constantes, il reste ", dim(res)[2], " variables."), "\n")
+return(res)
+}
+# La fonction supprimerVaNaInd supprime les variables contenant des NA
+# (si on garde les NA dans ces variables, les composantes du bloc ne
+# sont plus orthogonales).
+supprimerVaNaInd <-function(mat)
+{
+indiceVaNaInd = sapply(1:dim(mat)[2], FUN = function(i){
+col_mat_i = mat[, i]
+indNA = length(which(is.na(col_mat_i) == TRUE))
+if(indNA >= 1)
+{
+res = FALSE
+}else{
+res = TRUE
+}
+return(res)
+})
+mat2 = mat[, which(indiceVaNaInd == TRUE)]
+name_mat = deparse(substitute(mat))
+cat(paste0("Pour ", name_mat, ", après suppression des variables contenant des NA, il reste ", dim(mat2)[2], " variables."), "\n")
+return(mat2)
+}
+# La fonction varAnnotation permet de fournir des informations sur les variables
+# sélectionnées pour un design.
+varAnnotation <-function(variablesSelect,
+data_transcripto_col,
+annot_metageno_caecum)
+{
+res_variablesSelect = variablesSelect
+noms_blocks = sapply(1:length(variablesSelect), FUN = function(i){
+ch = strsplit(names(variablesSelect)[i], split = "_")[[1]]
+if(ch[1] == "resBio")
+{
+res = "resBio"
+}else{
+res = paste(ch[1:2], collapse = "_")
+}
+return(res)
+})
+ind_transcripto_col = which(noms_blocks == "transcripto_col")
+if(length(variablesSelect[[ind_transcripto_col]]) != 0)
+{
+varSelect_transcripto_colTemp = variablesSelect[[ind_transcripto_col]]
+varSelect_transcripto_col = sapply(1:length(varSelect_transcripto_colTemp), FUN = function(i){
+ch = strsplit(varSelect_transcripto_colTemp[i], split = "_")[[1]]
+res = paste(ch[2:length(ch)], collapse = "_")
+return(res)
+})
+dataframe_varSelect_transcripto_col  = data.frame(ProbeName = varSelect_transcripto_col)
+dataframe_annot_transcripto_col = data.frame(ProbeName = data_transcripto_col$genes$ProbeName,
+GeneName = data_transcripto_col$genes$GeneName,
+Description = data_transcripto_col$genes$Description,
+SystematicName = data_transcripto_col$genes$SystematicName)
+tab_transcripto_col = join(x = dataframe_varSelect_transcripto_col, y = dataframe_annot_transcripto_col,
+type = "inner",
+by = "ProbeName")
+res_variablesSelect[[ind_transcripto_col]] = tab_transcripto_col
+}
+ind_metageno_caecum = which(noms_blocks == "metageno_caecum")
+if(length(variablesSelect[[ind_metageno_caecum]]) != 0)
+{
+varSelect_metageno_caecum_Temp1 = variablesSelect[[ind_metageno_caecum]]
+varSelect_metageno_caecum_Temp2 = sapply(1:length(varSelect_metageno_caecum_Temp1), FUN = function(i){
+ch = strsplit(varSelect_metageno_caecum_Temp1[i], split = "")[[1]]
+if(ch[1] == "X")
+{
+res = paste(ch[2:length(ch)], collapse = "")
+}else{
+res = varSelect_metageno_caecum_Temp1[i]
+}
+return(res)
+})
+dataframe_varSelect_metageno_caecum = data.frame(taxon = varSelect_metageno_caecum_Temp2)
+dataframe_annot_metageno_caecum = data.frame(annot_metageno_caecum)
+colnames(dataframe_annot_metageno_caecum)[1] = "taxon"
+tab_metageno_caecum  = join(x = dataframe_varSelect_metageno_caecum, y = dataframe_annot_metageno_caecum,
+type = "inner",
+by = "taxon")
+res_variablesSelect[[ind_metageno_caecum]] = tab_metageno_caecum
+}
+ind_metabo_S1 = which(noms_blocks == "metabo_S1")
+if(length(variablesSelect[[ind_metabo_S1]]) != 0)
+{
+res_variablesSelect[[ind_metabo_S1]] = data.frame(variable = variablesSelect[[ind_metabo_S1]])
+}
+ind_resBio = which(noms_blocks == "resBio")
+if(length(variablesSelect[[ind_resBio]]) != 0)
+{
+res_variablesSelect[[ind_resBio]] = data.frame(variable = variablesSelect[[ind_resBio]])
+}
+return(res_variablesSelect)
+}
+# La fonction varAnnotation_gene_6blocks permet de fournir des informations sur les variables
+# sélectionnées pour un design.
+varAnnotation_gene_6blocks <-function(variablesSelect,
+data_transcripto_col,
+data_transcripto_tae,
+annot_metageno_caecum,
+metavar_metaboLC_S1,
+metavar_resBio,
+metavar_cyto)
+{
+res_variablesSelect = variablesSelect
+noms_blocks = names(variablesSelect)
+ind_transcripto_col = which(noms_blocks == "transcripto_col")
+if(length(ind_transcripto_col) != 0)
+{
+varSelect_transcripto_colTemp = variablesSelect[[ind_transcripto_col]]
+if(length(varSelect_transcripto_colTemp) != 0)
+{
+varSelect_transcripto_col = sapply(1:length(varSelect_transcripto_colTemp), FUN = function(i){
+variable_i = varSelect_transcripto_colTemp[i]
+res = gsub("Colon_", "", variable_i, fixed = TRUE)
+return(res)
+})
+dataframe_varSelect_transcripto_col  = data.frame(GeneName = varSelect_transcripto_col)
+dataframe_annot_transcripto_col = data.frame(ProbeName = data_transcripto_col$genes$ProbeName,
+GeneName = data_transcripto_col$genes$GeneName,
+Description = data_transcripto_col$genes$Description,
+SystematicName = data_transcripto_col$genes$SystematicName)
+tab_transcripto_col = join(x = dataframe_varSelect_transcripto_col, y = dataframe_annot_transcripto_col,
+type = "inner",
+by = "GeneName")
+res_variablesSelect[[ind_transcripto_col]] = tab_transcripto_col
+}else{
+res_variablesSelect[[ind_transcripto_col]] = ""
+}
+}
+ind_transcripto_tae = which(noms_blocks == "transcripto_tae")
+if(length(ind_transcripto_tae) != 0)
+{
+varSelect_transcripto_taeTemp = variablesSelect[[ind_transcripto_tae]]
+if(length(varSelect_transcripto_taeTemp) != 0)
+{
+varSelect_transcripto_tae = sapply(1:length(varSelect_transcripto_taeTemp), FUN = function(i){
+variable_i = varSelect_transcripto_taeTemp[i]
+res = gsub("TAE_", "", variable_i, fixed = TRUE)
+return(res)
+})
+dataframe_varSelect_transcripto_tae  = data.frame(GeneName = varSelect_transcripto_tae)
+dataframe_annot_transcripto_tae = data.frame(ProbeName = data_transcripto_tae$genes$ProbeName,
+GeneName = data_transcripto_tae$genes$GeneName,
+Description = data_transcripto_tae$genes$Description,
+SystematicName = data_transcripto_tae$genes$SystematicName)
+tab_transcripto_tae = join(x = dataframe_varSelect_transcripto_tae, y = dataframe_annot_transcripto_tae,
+type = "inner",
+by = "GeneName")
+res_variablesSelect[[ind_transcripto_tae]] = tab_transcripto_tae
+}else{
+res_variablesSelect[[ind_transcripto_tae]] = ""
+}
+}
+ind_metageno_caecum = which(noms_blocks == "metageno_caecum")
+if(length(ind_metageno_caecum) != 0)
+{
+varSelect_metageno_caecum_Temp1 = variablesSelect[[ind_metageno_caecum]]
+if(length(varSelect_metageno_caecum_Temp1) != 0)
+{
+varSelect_metageno_caecum_Temp2 = sapply(1:length(varSelect_metageno_caecum_Temp1), FUN = function(i){
+ch = strsplit(varSelect_metageno_caecum_Temp1[i], split = "")[[1]]
+if(ch[1] == "X")
+{
+res = paste(ch[2:length(ch)], collapse = "")
+}else{
+res = varSelect_metageno_caecum_Temp1[i]
+}
+return(res)
+})
+dataframe_varSelect_metageno_caecum = data.frame(taxon = varSelect_metageno_caecum_Temp2)
+dataframe_annot_metageno_caecum = data.frame(annot_metageno_caecum)
+colnames(dataframe_annot_metageno_caecum)[1] = "taxon"
+tab_metageno_caecum  = join(x = dataframe_varSelect_metageno_caecum, y = dataframe_annot_metageno_caecum,
+type = "inner",
+by = "taxon")
+res_variablesSelect[[ind_metageno_caecum]] = tab_metageno_caecum
+}else{
+res_variablesSelect[[ind_metageno_caecum]] = ""
+}
+}
+ind_metaboLC_S1 = which(noms_blocks == "metaboLC_S1")
+if(length(ind_metaboLC_S1) != 0)
+{
+if(length(variablesSelect[[ind_metaboLC_S1]]) != 0)
+{
+res_variablesSelect[[ind_metaboLC_S1]] = data.frame(variable = variablesSelect[[ind_metaboLC_S1]])
+}else{
+res_variablesSelect[[ind_metaboLC_S1]] = ""
+}
+}
+ind_resBio = which(noms_blocks == "resBio")
+if(length(ind_resBio) != 0)
+{
+if(length(variablesSelect[[ind_resBio]]) != 0)
+{
+res_variablesSelect[[ind_resBio]] = data.frame(variable = variablesSelect[[ind_resBio]])
+}else{
+res_variablesSelect[[ind_resBio]] = ""
+}
+}
+ind_cyto = which(noms_blocks == "cyto")
+if(length(ind_cyto) != 0)
+{
+if(length(variablesSelect[[ind_cyto]]) != 0)
+{
+res_variablesSelect[[ind_cyto]] = data.frame(variable = variablesSelect[[ind_cyto]])
+}else{
+res_variablesSelect[[ind_cyto]] = ""
+}
+}
+return(res_variablesSelect)
+}
+# La fonction varAnnotation_gene_6blocks permet de fournir des informations sur les variables
+# sélectionnées pour un design.
+varAnnotation_gene_6blocks <-function(variablesSelect,
+data_transcripto_col,
+data_transcripto_tae,
+annot_metageno_caecum,
+metavar_metaboLC_S1,
+metavar_resBio,
+metavar_cyto)
+{
+res_variablesSelect = variablesSelect
+noms_blocks = names(variablesSelect)
+ind_transcripto_col = which(noms_blocks == "transcripto_col")
+if(length(ind_transcripto_col) != 0)
+{
+varSelect_transcripto_colTemp = variablesSelect[[ind_transcripto_col]]
+if(length(varSelect_transcripto_colTemp) != 0)
+{
+varSelect_transcripto_col = sapply(1:length(varSelect_transcripto_colTemp), FUN = function(i){
+variable_i = varSelect_transcripto_colTemp[i]
+res = gsub("Colon_", "", variable_i, fixed = TRUE)
+return(res)
+})
+dataframe_varSelect_transcripto_col  = data.frame(GeneName = varSelect_transcripto_col)
+dataframe_annot_transcripto_col = data.frame(ProbeName = data_transcripto_col$genes$ProbeName,
+GeneName = data_transcripto_col$genes$GeneName,
+Description = data_transcripto_col$genes$Description,
+SystematicName = data_transcripto_col$genes$SystematicName)
+tab_transcripto_col = join(x = dataframe_varSelect_transcripto_col, y = dataframe_annot_transcripto_col,
+type = "inner",
+by = "GeneName")
+res_variablesSelect[[ind_transcripto_col]] = tab_transcripto_col
+}else{
+res_variablesSelect[[ind_transcripto_col]] = ""
+}
+}
+ind_transcripto_tae = which(noms_blocks == "transcripto_tae")
+if(length(ind_transcripto_tae) != 0)
+{
+varSelect_transcripto_taeTemp = variablesSelect[[ind_transcripto_tae]]
+if(length(varSelect_transcripto_taeTemp) != 0)
+{
+varSelect_transcripto_tae = sapply(1:length(varSelect_transcripto_taeTemp), FUN = function(i){
+variable_i = varSelect_transcripto_taeTemp[i]
+res = gsub("TAE_", "", variable_i, fixed = TRUE)
+return(res)
+})
+dataframe_varSelect_transcripto_tae  = data.frame(GeneName = varSelect_transcripto_tae)
+dataframe_annot_transcripto_tae = data.frame(ProbeName = data_transcripto_tae$genes$ProbeName,
+GeneName = data_transcripto_tae$genes$GeneName,
+Description = data_transcripto_tae$genes$Description,
+SystematicName = data_transcripto_tae$genes$SystematicName)
+tab_transcripto_tae = join(x = dataframe_varSelect_transcripto_tae, y = dataframe_annot_transcripto_tae,
+type = "inner",
+by = "GeneName")
+res_variablesSelect[[ind_transcripto_tae]] = tab_transcripto_tae
+}else{
+res_variablesSelect[[ind_transcripto_tae]] = ""
+}
+}
+ind_metageno_caecum = which(noms_blocks == "metageno_caecum")
+if(length(ind_metageno_caecum) != 0)
+{
+varSelect_metageno_caecum_Temp1 = variablesSelect[[ind_metageno_caecum]]
+if(length(varSelect_metageno_caecum_Temp1) != 0)
+{
+varSelect_metageno_caecum_Temp2 = sapply(1:length(varSelect_metageno_caecum_Temp1), FUN = function(i){
+ch = strsplit(varSelect_metageno_caecum_Temp1[i], split = "")[[1]]
+if(ch[1] == "X")
+{
+res = paste(ch[2:length(ch)], collapse = "")
+}else{
+res = varSelect_metageno_caecum_Temp1[i]
+}
+return(res)
+})
+dataframe_varSelect_metageno_caecum = data.frame(taxon = varSelect_metageno_caecum_Temp2)
+dataframe_annot_metageno_caecum = data.frame(annot_metageno_caecum)
+colnames(dataframe_annot_metageno_caecum)[1] = "taxon"
+tab_metageno_caecum  = join(x = dataframe_varSelect_metageno_caecum, y = dataframe_annot_metageno_caecum,
+type = "inner",
+by = "taxon")
+res_variablesSelect[[ind_metageno_caecum]] = tab_metageno_caecum
+}else{
+res_variablesSelect[[ind_metageno_caecum]] = ""
+}
+}
+ind_metaboLC_S1 = which(noms_blocks == "metaboLC_S1")
+if(length(ind_metaboLC_S1) != 0)
+{
+if(length(variablesSelect[[ind_metaboLC_S1]]) != 0)
+{
+dataframe_varSelect_metaboLC_S1 = data.frame(Variable = variablesSelect[[ind_metaboLC_S1]])
+dataframe_metavar_metaboLC_S1 = data.frame(metavar_metaboLC_S1)
+dataframe_metavar_varSelect_metaboLC_S1 = join(x = dataframe_varSelect_metaboLC_S1, y = dataframe_metavar_metaboLC_S1,
+type = "inner",
+by = "Variable")
+res_variablesSelect[[ind_metaboLC_S1]] = dataframe_metavar_varSelect_metaboLC_S1
+}else{
+res_variablesSelect[[ind_metaboLC_S1]] = ""
+}
+}
+ind_resBio = which(noms_blocks == "resBio")
+if(length(ind_resBio) != 0)
+{
+if(length(variablesSelect[[ind_resBio]]) != 0)
+{
+dataframe_varSelect_resBio = data.frame(Variable = variablesSelect[[ind_resBio]])
+dataframe_metavar_resBio = data.frame(metavar_resBio)
+dataframe_metavar_varSelect_resBio = join(x = dataframe_varSelect_resBio, y = dataframe_metavar_resBio,
+type = "inner",
+by = "Variable")
+res_variablesSelect[[ind_resBio]] = dataframe_metavar_varSelect_resBio
+}else{
+res_variablesSelect[[ind_resBio]] = ""
+}
+}
+ind_cyto = which(noms_blocks == "cyto")
+if(length(ind_cyto) != 0)
+{
+if(length(variablesSelect[[ind_cyto]]) != 0)
+{
+dataframe_varSelect_cyto = data.frame(Variable = variablesSelect[[ind_cyto]])
+dataframe_metavar_cyto = data.frame(metavar_cyto)
+dataframe_metavar_varSelect_cyto = join(x = dataframe_varSelect_cyto, y = dataframe_metavar_cyto,
+type = "inner",
+by = "Variable")
+res_variablesSelect[[ind_cyto]] = dataframe_metavar_varSelect_cyto
+}else{
+res_variablesSelect[[ind_cyto]] = ""
+}
+}
+return(res_variablesSelect)
+}
+# La fonction varAnnotation_gene_7blocks permet de fournir des informations sur les variables
+# sélectionnées pour un design.
+varAnnotation_gene_7blocks <-function(variablesSelect,
+data_transcripto_col,
+data_transcripto_tae,
+annot_metageno_caecum,
+metavar_metaboLC_S1,
+metavar_resBio,
+metavar_cyto)
+{
+res_variablesSelect = variablesSelect
+noms_blocks = names(variablesSelect)
+ind_transcripto_col = which(noms_blocks == "transcripto_col")
+if(length(ind_transcripto_col) != 0)
+{
+varSelect_transcripto_colTemp = variablesSelect[[ind_transcripto_col]]
+if(length(varSelect_transcripto_colTemp) != 0)
+{
+varSelect_transcripto_col = sapply(1:length(varSelect_transcripto_colTemp), FUN = function(i){
+variable_i = varSelect_transcripto_colTemp[i]
+res = gsub("Colon_", "", variable_i, fixed = TRUE)
+return(res)
+})
+dataframe_varSelect_transcripto_col  = data.frame(GeneName = varSelect_transcripto_col)
+dataframe_annot_transcripto_col = data.frame(ProbeName = data_transcripto_col$genes$ProbeName,
+GeneName = data_transcripto_col$genes$GeneName,
+Description = data_transcripto_col$genes$Description,
+SystematicName = data_transcripto_col$genes$SystematicName)
+tab_transcripto_col = join(x = dataframe_varSelect_transcripto_col, y = dataframe_annot_transcripto_col,
+type = "inner",
+by = "GeneName")
+res_variablesSelect[[ind_transcripto_col]] = tab_transcripto_col
+}else{
+res_variablesSelect[[ind_transcripto_col]] = ""
+}
+}
+ind_transcripto_tae = which(noms_blocks == "transcripto_tae")
+if(length(ind_transcripto_tae) != 0)
+{
+varSelect_transcripto_taeTemp = variablesSelect[[ind_transcripto_tae]]
+if(length(varSelect_transcripto_taeTemp) != 0)
+{
+varSelect_transcripto_tae = sapply(1:length(varSelect_transcripto_taeTemp), FUN = function(i){
+variable_i = varSelect_transcripto_taeTemp[i]
+res = gsub("TAE_", "", variable_i, fixed = TRUE)
+return(res)
+})
+dataframe_varSelect_transcripto_tae  = data.frame(GeneName = varSelect_transcripto_tae)
+dataframe_annot_transcripto_tae = data.frame(ProbeName = data_transcripto_tae$genes$ProbeName,
+GeneName = data_transcripto_tae$genes$GeneName,
+Description = data_transcripto_tae$genes$Description,
+SystematicName = data_transcripto_tae$genes$SystematicName)
+tab_transcripto_tae = join(x = dataframe_varSelect_transcripto_tae, y = dataframe_annot_transcripto_tae,
+type = "inner",
+by = "GeneName")
+res_variablesSelect[[ind_transcripto_tae]] = tab_transcripto_tae
+}else{
+res_variablesSelect[[ind_transcripto_tae]] = ""
+}
+}
+ind_metageno_caecum = which(noms_blocks == "metageno_caecum")
+if(length(ind_metageno_caecum) != 0)
+{
+varSelect_metageno_caecum_Temp1 = variablesSelect[[ind_metageno_caecum]]
+if(length(varSelect_metageno_caecum_Temp1) != 0)
+{
+varSelect_metageno_caecum_Temp2 = sapply(1:length(varSelect_metageno_caecum_Temp1), FUN = function(i){
+ch = strsplit(varSelect_metageno_caecum_Temp1[i], split = "")[[1]]
+if(ch[1] == "X")
+{
+res = paste(ch[2:length(ch)], collapse = "")
+}else{
+res = varSelect_metageno_caecum_Temp1[i]
+}
+return(res)
+})
+dataframe_varSelect_metageno_caecum = data.frame(taxon = varSelect_metageno_caecum_Temp2)
+dataframe_annot_metageno_caecum = data.frame(annot_metageno_caecum)
+colnames(dataframe_annot_metageno_caecum)[1] = "taxon"
+tab_metageno_caecum  = join(x = dataframe_varSelect_metageno_caecum, y = dataframe_annot_metageno_caecum,
+type = "inner",
+by = "taxon")
+res_variablesSelect[[ind_metageno_caecum]] = tab_metageno_caecum
+}else{
+res_variablesSelect[[ind_metageno_caecum]] = ""
+}
+}
+ind_metaboLC_S1 = which(noms_blocks == "metaboLC_S1")
+if(length(ind_metaboLC_S1) != 0)
+{
+if(length(variablesSelect[[ind_metaboLC_S1]]) != 0)
+{
+dataframe_varSelect_metaboLC_S1 = data.frame(Variable = variablesSelect[[ind_metaboLC_S1]])
+dataframe_metavar_metaboLC_S1 = data.frame(metavar_metaboLC_S1)
+dataframe_metavar_varSelect_metaboLC_S1 = join(x = dataframe_varSelect_metaboLC_S1, y = dataframe_metavar_metaboLC_S1,
+type = "inner",
+by = "Variable")
+res_variablesSelect[[ind_metaboLC_S1]] = dataframe_metavar_varSelect_metaboLC_S1
+}else{
+res_variablesSelect[[ind_metaboLC_S1]] = ""
+}
+}
+ind_metaboGC_S1 = which(noms_blocks == "metaboGC_S1")
+if(length(ind_metaboGC_S1) != 0)
+{
+if(length(variablesSelect[[ind_metaboGC_S1]]) != 0)
+{
+res_variablesSelect[[ind_metaboGC_S1]] = data.frame(Variable = variablesSelect[[ind_metaboGC_S1]])
+}else{
+res_variablesSelect[[ind_metaboGC_S1]] = ""
+}
+}
+ind_resBio = which(noms_blocks == "resBio")
+if(length(ind_resBio) != 0)
+{
+if(length(variablesSelect[[ind_resBio]]) != 0)
+{
+dataframe_varSelect_resBio = data.frame(Variable = variablesSelect[[ind_resBio]])
+dataframe_metavar_resBio = data.frame(metavar_resBio)
+dataframe_metavar_varSelect_resBio = join(x = dataframe_varSelect_resBio, y = dataframe_metavar_resBio,
+type = "inner",
+by = "Variable")
+res_variablesSelect[[ind_resBio]] = dataframe_metavar_varSelect_resBio
+}else{
+res_variablesSelect[[ind_resBio]] = ""
+}
+}
+ind_cyto = which(noms_blocks == "cyto")
+if(length(ind_cyto) != 0)
+{
+if(length(variablesSelect[[ind_cyto]]) != 0)
+{
+dataframe_varSelect_cyto = data.frame(Variable = variablesSelect[[ind_cyto]])
+dataframe_metavar_cyto = data.frame(metavar_cyto)
+dataframe_metavar_varSelect_cyto = join(x = dataframe_varSelect_cyto, y = dataframe_metavar_cyto,
+type = "inner",
+by = "Variable")
+res_variablesSelect[[ind_cyto]] = dataframe_metavar_varSelect_cyto
+}else{
+res_variablesSelect[[ind_cyto]] = ""
+}
+}
+return(res_variablesSelect)
+}
+# Integration 6 blocs norm sonde ------------------------------------------
+# La fonction plotVarZoom permet de zoomer sur le cercle de corrélation et de récupérer les variables
+# contenues dans ce rectangle.
+plotVarZoom <-function(res_block_splsda,
+comp = 1:2,
+blocks,
+block_Y = NULL,
+vec_col,
+cutoff,
+rad.in = 0.5,
+min.X = -1,
+max.X = 1,
+min.Y = -1,
+max.Y = 1,
+cex = 0.7,
+cex_legend = 0.8,
+pos = c(1.2, 0),
+pch = 20,
+inset = c(-0.25, 0))
+{
+if(class(res_block_splsda)[1] == "block.splsda")
+{
+circle = list()
+circle[[1]] = ellipse(0, levels = 1, t = 1)
+circle[[2]] = ellipse(0, levels = 1, t = rad.in)
+circle = data.frame(do.call("rbind", circle), "Circle" = c(rep("Main circle", 100), rep("Inner circle", 100)))
+MainCircle = circle[grep("Main circle", circle[, 3]), ]
+InnerCircle = circle[grep("Inner circle", circle[, 3]), ]
+if(length(blocks) > 1)
+{
+noms_bloc = names(res_block_splsda$variates)
+mat_comp1 = sapply(blocks, FUN = function(i){
+res = res_block_splsda$variates[[i]][, 1]
+return(res)
+})
+colnames(mat_comp1) = noms_bloc[blocks]
+mat_cor_comp1 = cor(mat_comp1)
+mat_comp2 = sapply(blocks, FUN = function(i){
+res = res_block_splsda$variates[[i]][, 2]
+return(res)
+})
+colnames(mat_comp2) = noms_bloc[blocks]
+mat_cor_comp2 = cor(mat_comp2)
+} # Fin if(length(blocks) > 1).
+# Pour chaque bloc, calcul des corrélations entre la première
+# composante et les variables sélectionnées et les corrélations entre
+# la deuxième composante et les variables sélectionnées. Pour la réponse,
+# calcul de la corrélation entre les variables de la réponse et la première composante
+# du premier bloc sélectionné et de la corrélation entre les variables de
+# la réponse et la deuxième composante du premier bloc sélectionné.
+liste_matCor_comp_var = list()
+varSelect_comp1 = selectVar(res_block_splsda,
+comp = comp[1])
+varSelect_comp2 = selectVar(res_block_splsda,
+comp = comp[2])
+vec_nom_blockEtReponse = c()
+blocksEtReponse = c(blocks, which(res_block_splsda$names$blocks == "Y"))
+for(i in 1:length(blocksEtReponse))
+{
+indice_block_i = blocksEtReponse[i]
+nom_blockEtReponse_i = res_block_splsda$names$blocks[indice_block_i]
+if(nom_blockEtReponse_i == "Y")
+{
+if(!is.null(block_Y))
+{
+block_i = block_Y
+comp1 = res_block_splsda$variates[[blocks[1]]][, comp[1]]
+comp2 = res_block_splsda$variates[[blocks[1]]][, comp[2]]
+vecCor_comp1_var = sapply(1:dim(block_i)[2], FUN = function(j){
+cor(comp1, block_i[, j], use = "complete.obs")
+})
+vecCor_comp2_var = sapply(1:dim(block_i)[2], FUN = function(j){
+cor(comp2, block_i[, j], use = "complete.obs")
+})
+}else{
+cat("La réponse n'est pas saisie comme paramètre d'entrée", "\n")
+}
+}else{
+comp1 = res_block_splsda$variates[[indice_block_i]][, comp[1]]
+comp2 = res_block_splsda$variates[[indice_block_i]][, comp[2]]
+varSelect_comp1_i = varSelect_comp1[[indice_block_i]][[1]]
+varSelect_comp2_i = varSelect_comp2[[indice_block_i]][[1]]
+varSelect_i = unique(c(varSelect_comp1_i, varSelect_comp2_i))
+block_i = res_block_splsda$X[[indice_block_i]][, varSelect_i]
+if(i == 1)
+{
+vecCor_comp1_var = sapply(1:dim(block_i)[2], FUN = function(j){
+cor(comp1, block_i[, j], use = "complete.obs")
+})
+vecCor_comp2_var = sapply(1:dim(block_i)[2], FUN = function(j){
+cor(comp2, block_i[, j], use = "complete.obs")
+})
+}else{
+signeCor_comp1 = sign(mat_cor_comp1[1, indice_block_i])
+vecCor_comp1_var = sapply(1:dim(block_i)[2], FUN = function(j){
+res = signeCor_comp1*cor(comp1, block_i[, j], use = "complete.obs")
+return(res)
+})
+signeCor_comp2 = sign(mat_cor_comp2[1, indice_block_i])
+vecCor_comp2_var = sapply(1:dim(block_i)[2], FUN = function(j){
+res = signeCor_comp2*cor(comp2, block_i[, j], use = "complete.obs")
+return(res)
+})
+}
+}
+matCor_comp_var = rbind(vecCor_comp1_var,
+vecCor_comp2_var)
+colnames(matCor_comp_var) = colnames(block_i)
+liste_matCor_comp_var[[i]] = matCor_comp_var
+vec_nom_blockEtReponse_i = rep(nom_blockEtReponse_i, dim(block_i)[2])
+vec_nom_blockEtReponse = c(vec_nom_blockEtReponse, vec_nom_blockEtReponse_i)
+} # Fin for(i in 1:length(blocks)).
+matCor_Allcomp_Allvar = t(Reduce(cbind, liste_matCor_comp_var))
+# indice permet de récupérer les variables de chaque bloc fortement corrélées avec soit
+# la première composante ou la deuxième composante dans une partie du cercle de corrélation
+# et de récupérer la variable réponse dans une partie du cercle de corrélation.
+indice = sapply(1:dim(matCor_Allcomp_Allvar)[1], FUN = function(k){
+cor1 = matCor_Allcomp_Allvar[k, 1]
+cor2 = matCor_Allcomp_Allvar[k, 2]
+blockEtReponse_k = vec_nom_blockEtReponse[k]
+if(blockEtReponse_k == "Y")
+{
+cond2 = cor1 > min.X & cor1 < max.X & cor2 > min.Y & cor2 < max.Y
+}else{
+cond1 = abs(cor1) > cutoff | abs(cor2) > cutoff
+cond2 = cor1 > min.X & cor1 < max.X & cor2 > min.Y & cor2 < max.Y & cond1
+}
+return(cond2)
+})
+matCor_Allcomp_AllvarSelect = matCor_Allcomp_Allvar[indice, , drop = FALSE]
+varSelect = rownames(matCor_Allcomp_AllvarSelect)
+dataframe_Cor_Allcomp_Allvar = data.frame(cbind(rownames(matCor_Allcomp_Allvar),
+vec_nom_blockEtReponse,
+matCor_Allcomp_Allvar))
+colnames(dataframe_Cor_Allcomp_Allvar) = c("variable",
+"bloc",
+"cor_comp1_var",
+"cor_comp2_var")
+dataframe_Cor_Allcomp_Allvar[, 1:2] = apply(dataframe_Cor_Allcomp_Allvar[, 1:2], 2, as.character)
+dataframe_Cor_Allcomp_AllvarSelect = dataframe_Cor_Allcomp_Allvar[indice, ]
+# Tracé de la superposition des cerles de corrélation.
+plot(MainCircle[, 1], MainCircle[, 2],
+type = "l",
+xlab = paste0("composante ", comp[1]),
+ylab = paste0("composante ", comp[2]))
+points(InnerCircle[, 1], InnerCircle[, 2],
+type = "l")
+if(dim(matCor_Allcomp_AllvarSelect)[1] != 0)
+{
+nom_blockEtReponseSelect = unique(dataframe_Cor_Allcomp_AllvarSelect[, 2])
+indice_blockEtReponseSelect = sapply(1:length(nom_blockEtReponseSelect), FUN = function(i){
+ind = which(res_block_splsda$names$blocks == nom_blockEtReponseSelect[i])
+if(length(ind) != 0)
+{
+res = ind
+}else{
+res = which(res_block_splsda$names$blocks == "Y")
+}
+return(res)
+})
+vec_colSelect = vec_col[indice_blockEtReponseSelect]
+if(length(blocksEtReponse) == 1)
+{
+points(matCor_Allcomp_AllvarSelect[, 1], matCor_Allcomp_AllvarSelect[, 2],
+col  = NULL)
+text(matCor_Allcomp_AllvarSelect[, 1], matCor_Allcomp_AllvarSelect[, 2],
+labels = rownames(matCor_Allcomp_AllvarSelect),
+cex = cex,
+col = vec_colSelect[1])
+}else{
+nbVarSelect_bloc = cumsum(sapply(1:length(nom_blockEtReponseSelect), FUN = function(j){
+res = length(which(dataframe_Cor_Allcomp_AllvarSelect[, 2] == nom_blockEtReponseSelect[j]))
+return(res)
+}))
+for(i in 1:length(nbVarSelect_bloc))
+{
+if(i == 1)
+{
+indice1 = 1:nbVarSelect_bloc[1]
+if(length(indice1) != 0)
+{
+matCor_Allcomp_AllvarSelect2 = matCor_Allcomp_AllvarSelect[indice1, , drop = FALSE]
+points(matCor_Allcomp_AllvarSelect2[, 1], matCor_Allcomp_AllvarSelect2[, 2],
+col  = NULL)
+text(matCor_Allcomp_AllvarSelect2[, 1], matCor_Allcomp_AllvarSelect2[, 2],
+labels = rownames(matCor_Allcomp_AllvarSelect2),
+cex = cex,
+col = rep(vec_colSelect[i], dim(matCor_Allcomp_AllvarSelect2)[1]))
+}else{
+cat(paste0("Il n'y a de variables dans cette zone du cercle de corrélation pour le bloc ", nom_blockEtReponseSelect[i]), "\n")
+}
+}else{
+indice2 = (nbVarSelect_bloc[i - 1] + 1):nbVarSelect_bloc[i]
+if(length(indice2) != 0)
+{
+matCor_Allcomp_AllvarSelect2 = matCor_Allcomp_AllvarSelect[indice2, , drop = FALSE]
+points(matCor_Allcomp_AllvarSelect2[, 1], matCor_Allcomp_AllvarSelect2[, 2],
+col  = NULL)
+text(matCor_Allcomp_AllvarSelect2[, 1], matCor_Allcomp_AllvarSelect2[, 2],
+labels = rownames(matCor_Allcomp_AllvarSelect2),
+cex = cex,
+col = rep(vec_colSelect[i], dim(matCor_Allcomp_AllvarSelect2)[1]))
+}else{
+cat(paste0("Il n'y a de variables dans cette zone du cercle de corrélation pour le bloc ", nom_blockEtReponseSelect[i]), "\n")
+}
+}
+}
+}
+par(xpd = TRUE)
+legend(x = pos[1], y = pos[2],
+legend = nom_blockEtReponseSelect,
+pch = pch,
+col = vec_colSelect,
+cex = cex_legend,
+inset = inset)
+}else{
+cat("Il n'y a de variables dans cette zone du cercle de corrélation", "\n")
+}
+# Suppression de dataframe_Cor_Allcomp_Allvar, dataframe_Cor_Allcomp_AllvarSelect et varSelect de la variable
+# réponse.
+if(!is.null(block_Y))
+{
+for(i in 1:dim(block_Y)[2])
+{
+variableReponse = colnames(block_Y)[i]
+# dataframe_Cor_Allcomp_Allvar
+if(dim(dataframe_Cor_Allcomp_Allvar)[1] != 0)
+{
+ind_Allvar = which(dataframe_Cor_Allcomp_Allvar$variable == variableReponse)
+if(length(ind_Allvar) != 0)
+{
+dataframe_Cor_Allcomp_Allvar = dataframe_Cor_Allcomp_Allvar[- ind_Allvar, ]
+}
+}
+# dataframe_Cor_Allcomp_AllvarSelect
+if(dim(dataframe_Cor_Allcomp_AllvarSelect)[1] != 0)
+{
+ind_AllvarSelect = which(dataframe_Cor_Allcomp_AllvarSelect$variable == variableReponse)
+if(length(ind_AllvarSelect) != 0)
+{
+dataframe_Cor_Allcomp_AllvarSelect = dataframe_Cor_Allcomp_AllvarSelect[- ind_AllvarSelect, ]
+}
+}
+# varSelect
+if(length(varSelect) != 0)
+{
+ind_varSelect = which(varSelect == variableReponse)
+if(length(ind_varSelect) != 0)
+{
+varSelect = varSelect[- ind_varSelect]
+}
+}
+} # Fin for(i in 1:dim(block_Y)[2]).
+}
+res = list(dataframe_Cor_Allcomp_Allvar = dataframe_Cor_Allcomp_Allvar,
+dataframe_Cor_Allcomp_AllvarSelect = dataframe_Cor_Allcomp_AllvarSelect,
+varSelect = varSelect)
+return(res)
+}else{
+cat("Erreur : il ne s'agit pas de la sortie de la fonction block.splsda", "\n")
+}
+}
+# La fonction networkVarSelect permet de tracer un réseau pour les variables de
+# certains blocs.
+networkVarSelect <-function(object,
+mat_Y,
+comp = 1:2,
+listeVar,
+blocks,
+cutoff = 0
+)
+{
+if(class(object)[1] == "block.splsda")
+{
+nomBlocs = names(listeVar)
+liste_XSelect = lapply(1:length(listeVar), FUN = function(i){
+nomBloc_i = names(listeVar)[i]
+ind1 = which(object$names$blocks == nomBloc_i)
+ind2 = colnames(object$X[[ind1]])%in%listeVar[[i]]
+res = object$X[[ind1]][, ind2, drop = FALSE]
+return(res)
+})
+names(liste_XSelect) = nomBlocs
+liste_matSelect = liste_XSelect
+if(!is.null(mat_Y))
+{
+liste_matSelect = c(liste_matSelect, list(mat_Y))
+names(liste_matSelect)[length(liste_matSelect)] = "Y"
+}
+# compute the similarity between var1 of block1 and var2 of block2.
+coord = list()
+for(k in 1:length(blocks))
+{
+nomBloc_k = names(liste_matSelect)[k]
+mat_k = liste_matSelect[[k]][, ,drop = FALSE]
+if(nomBloc_k == "Y")
+{
+coord[[k]] = cor(mat_k, object$variates[[blocks[1]]][, comp])
+}else{
+coord[[k]] = cor(mat_k, object$variates[[blocks[k]]][, comp])
+}
+if(dim(mat_k)[2] == 1)
+{
+coord[[k]] = as.matrix(coord[[k]],
+nrow = 1)
+rownames(coord[[k]]) = colnames(mat_k)
+}
+} # Fin for(k in 1:length(blocks)).
+l = 1
+M_block = list()
+node.X1 = node.X2 = w = NULL
+for(j in 1:(length(blocks) - 1))
+{
+for(k in (j + 1):length(blocks))
+{
+M_block[[l]] = coord[[j]][, comp, drop = FALSE] %*% t(coord[[k]][, comp, drop = FALSE])
+X1 = rownames(coord[[j]])
+X2 = rownames(coord[[k]])
+rep.X1 = rep(X1, each = length(X2))
+rep.X2 = rep(X2, length(X1))
+node.X1= c(node.X1, rep.X1)
+node.X2 = c(node.X2, rep.X2)
+w = c(w, as.vector(t(M_block[[l]])))
+l = l + 1
+} # Fin for(k in (j + 1):length(blocks)).
+} # Fin for(j in 1:(length(blocks) - 1)).
+# nodes
+group = NULL
+temp = lapply(liste_matSelect, function(x) colnames(x))
+for (i in 1:length(temp))
+{
+group = c(group, rep(names(temp)[i], length(temp[[i]])))
+} # Fin for (i in 1:length(temp)).
+# nodes
+nodes = data.frame(name = unlist(temp),
+group = group)
+# gR
+relations = data.frame(from = node.X1,
+to = node.X2,
+weight = w)
+idx = (abs(w) >= cutoff)
+relations = relations[idx, , drop = FALSE]
+gR = graph.data.frame(relations,
+directed = FALSE,
+vertices = nodes)
+block.var.names = sapply(1:length(liste_matSelect), FUN = function(i){
+res = colnames(liste_matSelect[[i]])
+return(res)
+})
+V(gR)$label = unlist(block.var.names)
+gR = delete.vertices(gR, which(degree(gR) == 0))
+res = list(gR = gR)
+l = 1
+for (i in 1:(length(blocks)-1))
+{
+for (j in (i + 1):length(blocks))
+{
+res[paste("M", names(liste_matSelect)[i], names(liste_matSelect)[j], sep="_")] = list(M_block[[l]])
+l = l + 1
+} # Fin for (j in (i + 1):length(blocks)).
+} # Fin for (i in 1:(length(blocks)-1).
+res$cutoff = cutoff
+return(res)
+} # Fin if(class(object)[1] == "block.splsda").
+}
+# La fonction varAnnotation_6blocks permet de fournir des informations sur les variables
+# sélectionnées pour un design.
+varAnnotation_6blocks <-function(variablesSelect,
+data_transcripto_col,
+data_transcripto_tae,
+annot_metageno_caecum)
+{
+res_variablesSelect = variablesSelect
+noms_blocks = names(variablesSelect)
+ind_transcripto_col = which(noms_blocks == "transcripto_col")
+if(length(variablesSelect[[ind_transcripto_col]]) != 0)
+{
+varSelect_transcripto_colTemp = variablesSelect[[ind_transcripto_col]]
+varSelect_transcripto_col = sapply(1:length(varSelect_transcripto_colTemp), FUN = function(i){
+ch = strsplit(varSelect_transcripto_colTemp[i], split = "_")[[1]]
+res = paste(ch[2:length(ch)], collapse = "_")
+return(res)
+})
+dataframe_varSelect_transcripto_col  = data.frame(ProbeName = varSelect_transcripto_col)
+dataframe_annot_transcripto_col = data.frame(ProbeName = data_transcripto_col$genes$ProbeName,
+GeneName = data_transcripto_col$genes$GeneName,
+Description = data_transcripto_col$genes$Description,
+SystematicName = data_transcripto_col$genes$SystematicName)
+tab_transcripto_col = join(x = dataframe_varSelect_transcripto_col, y = dataframe_annot_transcripto_col,
+type = "inner",
+by = "ProbeName")
+res_variablesSelect[[ind_transcripto_col]] = tab_transcripto_col
+}
+ind_transcripto_tae = which(noms_blocks == "transcripto_tae")
+if(length(variablesSelect[[ind_transcripto_tae]]) != 0)
+{
+varSelect_transcripto_taeTemp = variablesSelect[[ind_transcripto_tae]]
+varSelect_transcripto_tae = sapply(1:length(varSelect_transcripto_taeTemp), FUN = function(i){
+ch = strsplit(varSelect_transcripto_taeTemp[i], split = "_")[[1]]
+res = paste(ch[2:length(ch)], collapse = "_")
+return(res)
+})
+dataframe_varSelect_transcripto_tae  = data.frame(ProbeName = varSelect_transcripto_tae)
+dataframe_annot_transcripto_tae = data.frame(ProbeName = data_transcripto_tae$genes$ProbeName,
+GeneName = data_transcripto_tae$genes$GeneName,
+Description = data_transcripto_tae$genes$Description,
+SystematicName = data_transcripto_tae$genes$SystematicName)
+tab_transcripto_tae = join(x = dataframe_varSelect_transcripto_tae, y = dataframe_annot_transcripto_tae,
+type = "inner",
+by = "ProbeName")
+res_variablesSelect[[ind_transcripto_tae]] = tab_transcripto_tae
+}
+ind_metageno_caecum = which(noms_blocks == "metageno_caecum")
+if(length(variablesSelect[[ind_metageno_caecum]]) != 0)
+{
+varSelect_metageno_caecum_Temp1 = variablesSelect[[ind_metageno_caecum]]
+varSelect_metageno_caecum_Temp2 = sapply(1:length(varSelect_metageno_caecum_Temp1), FUN = function(i){
+ch = strsplit(varSelect_metageno_caecum_Temp1[i], split = "")[[1]]
+if(ch[1] == "X")
+{
+res = paste(ch[2:length(ch)], collapse = "")
+}else{
+res = varSelect_metageno_caecum_Temp1[i]
+}
+return(res)
+})
+dataframe_varSelect_metageno_caecum = data.frame(taxon = varSelect_metageno_caecum_Temp2)
+dataframe_annot_metageno_caecum = data.frame(annot_metageno_caecum)
+colnames(dataframe_annot_metageno_caecum)[1] = "taxon"
+tab_metageno_caecum  = join(x = dataframe_varSelect_metageno_caecum, y = dataframe_annot_metageno_caecum,
+type = "inner",
+by = "taxon")
+res_variablesSelect[[ind_metageno_caecum]] = tab_metageno_caecum
+}
+ind_metaboLC_S1 = which(noms_blocks == "metaboLC_S1")
+if(length(variablesSelect[[ind_metaboLC_S1]]) != 0)
+{
+res_variablesSelect[[ind_metaboLC_S1]] = data.frame(variable = variablesSelect[[ind_metaboLC_S1]])
+}
+ind_resBio = which(noms_blocks == "resBio")
+if(length(variablesSelect[[ind_resBio]]) != 0)
+{
+res_variablesSelect[[ind_resBio]] = data.frame(variable = variablesSelect[[ind_resBio]])
+}
+ind_cyto = which(noms_blocks == "cyto")
+if(length(variablesSelect[[ind_cyto]]) != 0)
+{
+res_variablesSelect[[ind_cyto]] = data.frame(variable = variablesSelect[[ind_cyto]])
+}
+return(res_variablesSelect)
+}
+# Integration 6 blocs norm gene -------------------------------------------
+# La fonction matriceCorrelation_comp calcule la matrice de corrélation entre les comp[1]
+# composantes de chaque bloc et la matrice de corrélation entre les comp[2] composantes de
+# chaque bloc.
+matriceCorrelation_comp <-function(res_block_splsda,
+comp = 1:2)
+{
+vec_blocksTemp = res_block_splsda$names$blocks
+ind_Y = which(vec_blocksTemp == "Y")
+vec_blocks = vec_blocksTemp[- ind_Y]
+vec_indice_blocks = sapply(1:length(vec_blocks), FUN = function(i){
+res = which(res_block_splsda$names$blocks == vec_blocks[i])
+return(res)
+})
+# Calcul de la matrice de corrélations entre les comp[1] composantes de chaque bloc
+# et de la matrice de corrélation entre les comp[2] composantes de chaque bloc.
+mat_comp1 = sapply(1:length(vec_indice_blocks), FUN = function(i){
+res = res_block_splsda$variates[[vec_indice_blocks[i]]][, comp[1]]
+return(res)
+})
+colnames(mat_comp1) = vec_blocks
+mat_cor_comp1 = cor(mat_comp1)
+mat_comp2 = sapply(1:length(vec_indice_blocks), FUN = function(i){
+res = res_block_splsda$variates[[vec_indice_blocks[i]]][, comp[2]]
+return(res)
+})
+colnames(mat_comp2) = vec_blocks
+mat_cor_comp2 = cor(mat_comp2)
+return(list(mat_cor_comp1 = mat_cor_comp1,
+mat_cor_comp2 = mat_cor_comp2))
+}
+# La fonction matCor détermine toutes les combinaisons possibles des blocs
+# dont nous pouvons superposer les cercles de corrélation. Cette fonction calcule,
+# pour chaque variable (variable d'un bloc ou une variable réponse), la corrélation de
+# cette variable avec la première composante et la corrélation de cette variable avec la
+# deuxième composante.
+matCor <-function(res_block_splsda,
+mat_cor_comp1,
+mat_cor_comp2,
+block_Y,
+comp = 1:2,
+cutoff_comp)
+{
+noms_blocTemp = res_block_splsda$names$blocks
+ind_Y = which(noms_blocTemp == "Y")
+noms_bloc = noms_blocTemp[- ind_Y]
+# Détermination de toutes les combinaisons possibles de blocs dont nous pouvons superposer
+# les cercles de corrélation.
+blockSelect = unique(lapply(1:dim(mat_cor_comp1)[1], FUN = function(i){
+col_mat_cor_comp1_i = mat_cor_comp1[, i]
+col_mat_cor_comp2_i = mat_cor_comp2[, i]
+resultat = c()
+for(j in 1:length(col_mat_cor_comp1_i))
+{
+cond =   abs(col_mat_cor_comp1_i[j]) > cutoff_comp & abs(col_mat_cor_comp2_i[j]) > cutoff_comp
+if(cond)
+{
+resultat = c(resultat, j)
+}
+}
+return(resultat)
+}))
+liste_noms_blocks = list()
+for(i in 1:length(blockSelect))
+{
+blockSelect_i = blockSelect[[i]]
+for(k in 1:length(blockSelect_i))
+{
+matComb = combn(blockSelect_i, m = k)
+res = lapply(1:dim(matComb)[2], FUN = function(i){
+comb_i = matComb[, i]
+resultat = noms_bloc[comb_i]
+return(resultat)
+})
+for(j in 1:length(res))
+{
+liste_noms_blocks = c(liste_noms_blocks, list(res[[j]]))
+} # Fin for(j in 1:length(liste_noms_blocks)).
+} # Fin for(k in 1:length(blockSelect_i)).
+} # Fin for(i in 1:length(blockSelect)).
+liste_noms_blocks = unique(liste_noms_blocks)
+# Pour chaque bloc, calcul des corrélations entre la première
+# composante et les variables sélectionnées et les corrélations entre
+# la deuxième composante et les variables sélectionnées. Pour la réponse,
+# calcul de la corrélation entre les variables de la réponse et la première composante
+# du premier bloc sélectionné et de la corrélation entre les variables de
+# la réponse et la deuxième composante du premier bloc sélectionné.
+liste_matCor_comp_var_all = list()
+varSelect_comp1 = selectVar(res_block_splsda,
+comp = comp[1])
+varSelect_comp2 = selectVar(res_block_splsda,
+comp = comp[2])
+blockSelectEtReponse = list()
+for(i in 1:length(blockSelect))
+{
+blockSelectEtReponse[[i]] = c(blockSelect[[i]], which(res_block_splsda$names$blocks == "Y"))
+} # Fin for(i in 1:length(blockSelect)).
+for(i in 1:length(blockSelectEtReponse))
+{
+blockSelectEtReponse_i = blockSelectEtReponse[[i]]
+vec_nom_blockEtReponse = c()
+liste_matCor_comp_var = list()
+for(j in 1:length(blockSelectEtReponse_i))
+{
+indice_block_i_j = blockSelectEtReponse_i[j]
+nom_blockEtReponse_i_j = res_block_splsda$names$blocks[indice_block_i_j]
+if(nom_blockEtReponse_i_j == "Y")
+{
+if(!is.null(block_Y))
+{
+block_i_j = block_Y
+comp1 = res_block_splsda$variates[[blockSelectEtReponse_i[1]]][, comp[1]]
+comp2 = res_block_splsda$variates[[blockSelectEtReponse_i[1]]][, comp[2]]
+vecCor_comp1_var = sapply(1:dim(block_Y)[2], FUN = function(j){
+cor(comp1, block_Y[, j], use = "complete.obs")
+})
+vecCor_comp2_var = sapply(1:dim(block_Y)[2], FUN = function(j){
+cor(comp2, block_Y[, j], use = "complete.obs")
+})
+}else{
+cat("La réponse n'est pas saisie comme paramètre d'entrée", "\n")
+}
+}else{
+comp1 = res_block_splsda$variates[[indice_block_i_j]][, comp[1]]
+comp2 = res_block_splsda$variates[[indice_block_i_j]][, comp[2]]
+varSelect_comp1_i_j = varSelect_comp1[[indice_block_i_j]][[1]]
+varSelect_comp2_i_j = varSelect_comp2[[indice_block_i_j]][[1]]
+varSelect_i_j = unique(c(varSelect_comp1_i_j, varSelect_comp2_i_j))
+block_i_j = res_block_splsda$X[[indice_block_i_j]][, varSelect_i_j]
+if(i == 1)
+{
+vecCor_comp1_var = sapply(1:dim(block_i_j)[2], FUN = function(j){
+cor(comp1, block_i_j[, j], use = "complete.obs")
+})
+vecCor_comp2_var = sapply(1:dim(block_i_j)[2], FUN = function(j){
+cor(comp2, block_i_j[, j], use = "complete.obs")
+})
+}else{
+signeCor_comp1 = sign(mat_cor_comp1[1, indice_block_i_j])
+vecCor_comp1_var = sapply(1:dim(block_i_j)[2], FUN = function(j){
+res = signeCor_comp1*cor(comp1, block_i_j[, j], use = "complete.obs")
+return(res)
+})
+signeCor_comp2 = sign(mat_cor_comp2[1, indice_block_i_j])
+vecCor_comp2_var = sapply(1:dim(block_i_j)[2], FUN = function(j){
+res = signeCor_comp2*cor(comp2, block_i_j[, j], use = "complete.obs")
+return(res)
+})
+}
+}
+matCor_comp_var = rbind(vecCor_comp1_var,
+vecCor_comp2_var)
+colnames(matCor_comp_var) = colnames(block_i_j)
+liste_matCor_comp_var[[j]] = matCor_comp_var
+vec_nom_blockEtReponse_i_j = rep(nom_blockEtReponse_i_j, dim(block_i_j)[2])
+vec_nom_blockEtReponse = c(vec_nom_blockEtReponse, vec_nom_blockEtReponse_i_j)
+} # Fin for(j in 1:length(blockSelectEtReponse_i)).
+matCor_Allcomp_Allvar = t(Reduce(cbind, liste_matCor_comp_var))
+dataframe_Cor_Allcomp_Allvar = data.frame(cbind(rownames(matCor_Allcomp_Allvar),
+vec_nom_blockEtReponse,
+matCor_Allcomp_Allvar))
+colnames(dataframe_Cor_Allcomp_Allvar) = c("variable",
+"bloc",
+"cor_comp1_var",
+"cor_comp2_var")
+liste_matCor_comp_var_all[[i]] = dataframe_Cor_Allcomp_Allvar
+} # Fin for(i in 1:length(blocks)).
+names(liste_matCor_comp_var_all) = sapply(1:length(blockSelectEtReponse), FUN = function(i){
+blockSelectEtReponse_i = blockSelectEtReponse[[i]]
+blocks_i = blockSelectEtReponse_i[blockSelectEtReponse_i != ind_Y]
+nomsBlocks = paste(res_block_splsda$names$blocks[blocks_i], collapse = "_")
+return(nomsBlocks)
+})
+return(list(liste_matCor_comp_var_all = liste_matCor_comp_var_all,
+liste_noms_blocks = liste_noms_blocks))
+}
+# La fonction circleCorZoom permet superposer des cercles de corrélations et de zoomer un rectangle du cercle de corrélations.
+# Cette fonction permet de récupérer les variables contenues dans ce rectangle.
+circleCorZoom <-function(dataframe_Cor_Allcomp_Allvar,
+mat_cor_comp1,
+mat_cor_comp2,
+nomsBlock,
+comp = 1:2,
+cutoff = 0.85,
+cutoff_comp = 0.8,
+min.X = -1,
+max.X = 1,
+min.Y = -1,
+max.Y = 1,
+vec_col = colorRampPalette(brewer.pal(9, "Spectral"))(length(unique(dataframe_Cor_Allcomp_Allvar$bloc))),
+rad.in = 0.5,
+cex = 0.7,
+cex_legend = 0.8,
+pos = c(1.2, 0),
+pch = 20,
+inset = c(-0.25, 0))
+{
+# Nous vérifions que nous pouvons superposer les cercles de corrélation.
+blockSelect = unique(lapply(1:dim(mat_cor_comp1)[1], FUN = function(i){
+col_mat_cor_comp1_i = mat_cor_comp1[, i]
+col_mat_cor_comp2_i = mat_cor_comp2[, i]
+resultat = c()
+for(j in 1:length(col_mat_cor_comp1_i))
+{
+cond =   abs(col_mat_cor_comp1_i[j]) > cutoff_comp & abs(col_mat_cor_comp2_i[j]) > cutoff_comp
+if(cond)
+{
+resultat = c(resultat, j)
+}
+}
+return(resultat)
+}))
+indice_block_nomsBlock = sapply(1:length(nomsBlock), FUN = function(i){
+res =  which(colnames(mat_cor_comp1) == nomsBlock[i])
+return(res)
+})
+boolean = FALSE
+i = 1
+while(i <=length(blockSelect) & !boolean)
+{
+blockSelect_i = blockSelect[[i]]
+cond = length(which(blockSelect_i%in%indice_block_nomsBlock == TRUE)) == length(nomsBlock)
+if(cond)
+{
+boolean = TRUE
+}
+i = i + 1
+} # Fin while(i <=length(blockSelect) & !boolean).
+varSelect = NULL
+if(!boolean)
+{
+cat(paste0("Erreur : les blocs : ", paste(nomsBlock, collapse = ", "), " ne peuvent pas être superposés.", "\n"))
+}else{
+nomsBlockEtReponse = c(nomsBlock, "Y")
+indice1 = dataframe_Cor_Allcomp_Allvar$bloc%in%nomsBlockEtReponse
+dataframe_Cor_Allcomp_Allvar2 = dataframe_Cor_Allcomp_Allvar[indice1, ]
+matCor_Allcomp_Allvar = apply(dataframe_Cor_Allcomp_Allvar2[, 3:4], 2, as.numeric)
+rownames(matCor_Allcomp_Allvar) = dataframe_Cor_Allcomp_Allvar2$variable
+# indice permet de récupérer les variables de chaque bloc fortement corrélées avec soit
+# la première composante ou la deuxième composante dans une partie du cercle de corrélation
+# et de récupérer la variable réponse.
+indice = sapply(1:dim(dataframe_Cor_Allcomp_Allvar2)[1], FUN = function(k){
+cor1 = matCor_Allcomp_Allvar[k, 1]
+cor2 = matCor_Allcomp_Allvar[k, 2]
+blockEtReponse_k = dataframe_Cor_Allcomp_Allvar2[k, 2]
+if(blockEtReponse_k == "Y")
+{
+cond2 = TRUE
+}else{
+cond1 = abs(cor1) > cutoff | abs(cor2) > cutoff
+cond2 = cor1 > min.X & cor1 < max.X & cor2 > min.Y & cor2 < max.Y & cond1
+}
+return(cond2)
+})
+dataframe_Cor_Allcomp_Allvar2[, 1:2] = apply(dataframe_Cor_Allcomp_Allvar2[, 1:2], 2, as.character)
+dataframe_Cor_Allcomp_Allvar2Select = dataframe_Cor_Allcomp_Allvar2[indice, ]
+varSelectTemp = dataframe_Cor_Allcomp_Allvar2Select$variable
+ind_Y = which(dataframe_Cor_Allcomp_Allvar2Select$bloc == "Y")
+if(length(ind_Y) != 0)
+{
+varSelect = varSelectTemp[- ind_Y]
+}else{
+varSelect = varSelectTemp
+}
+matCor_Allcomp_AllvarSelect = matCor_Allcomp_Allvar[indice, , drop = FALSE]
+# Tracé de la superposition des cerles de corrélation.
+circle = list()
+circle[[1]] = ellipse(0, levels = 1, t = 1)
+circle[[2]] = ellipse(0, levels = 1, t = rad.in)
+circle = data.frame(do.call("rbind", circle), "Circle" = c(rep("Main circle", 100), rep("Inner circle", 100)))
+MainCircle = circle[grep("Main circle", circle[, 3]), ]
+InnerCircle = circle[grep("Inner circle", circle[, 3]), ]
+plot(MainCircle[, 1], MainCircle[, 2],
+type = "l",
+xlab = paste0("composante ", comp[1]),
+ylab = paste0("composante ", comp[2]))
+points(InnerCircle[, 1], InnerCircle[, 2],
+type = "l")
+if(dim(matCor_Allcomp_AllvarSelect)[1] != 0)
+{
+nom_blockEtReponseSelect = unique(dataframe_Cor_Allcomp_Allvar2Select$bloc)
+indice_blockEtReponseSelect = sapply(1:length(nom_blockEtReponseSelect), FUN = function(i){
+ind = which(colnames(mat_cor_comp1) == nom_blockEtReponseSelect[i])
+if(length(ind) != 0)
+{
+res = ind
+}else{
+res = dim(mat_cor_comp1)[1] + 1
+}
+return(res)
+})
+vec_colSelect = vec_col[indice_blockEtReponseSelect]
+if(length(nom_blockEtReponseSelect) == 1)
+{
+points(matCor_Allcomp_AllvarSelect[, 1], matCor_Allcomp_AllvarSelect[, 2],
+col  = NULL)
+text(matCor_Allcomp_AllvarSelect[, 1], matCor_Allcomp_AllvarSelect[, 2],
+labels = rownames(matCor_Allcomp_AllvarSelect),
+cex = cex,
+col = vec_colSelect[1])
+}else{
+nbVarSelect_bloc = cumsum(sapply(1:length(nom_blockEtReponseSelect), FUN = function(j){
+res = length(which(dataframe_Cor_Allcomp_Allvar2Select$bloc == nom_blockEtReponseSelect[j]))
+return(res)
+}))
+for(i in 1:length(nbVarSelect_bloc))
+{
+if(i == 1)
+{
+indice1 = 1:nbVarSelect_bloc[1]
+if(length(indice1) != 0)
+{
+matCor_Allcomp_AllvarSelect2 = matCor_Allcomp_AllvarSelect[indice1, , drop = FALSE]
+points(matCor_Allcomp_AllvarSelect2[, 1], matCor_Allcomp_AllvarSelect2[, 2],
+col  = NULL)
+text(matCor_Allcomp_AllvarSelect2[, 1], matCor_Allcomp_AllvarSelect2[, 2],
+labels = rownames(matCor_Allcomp_AllvarSelect2),
+cex = cex,
+col = rep(vec_colSelect[i], dim(matCor_Allcomp_AllvarSelect2)[1]))
+}else{
+cat(paste0("Il n'y a de variables dans cette zone du cercle de corrélation pour le bloc ", nom_blockEtReponseSelect[i]), "\n")
+}
+}else{
+indice2 = (nbVarSelect_bloc[i - 1] + 1):nbVarSelect_bloc[i]
+if(length(indice2) != 0)
+{
+matCor_Allcomp_AllvarSelect2 = matCor_Allcomp_AllvarSelect[indice2, , drop = FALSE]
+points(matCor_Allcomp_AllvarSelect2[, 1], matCor_Allcomp_AllvarSelect2[, 2],
+col  = NULL)
+text(matCor_Allcomp_AllvarSelect2[, 1], matCor_Allcomp_AllvarSelect2[, 2],
+labels = rownames(matCor_Allcomp_AllvarSelect2),
+cex = cex,
+col = rep(vec_colSelect[i], dim(matCor_Allcomp_AllvarSelect2)[1]))
+}else{
+cat(paste0("Il n'y a de variables dans cette zone du cercle de corrélation pour le bloc ", nom_blockEtReponseSelect[i]), "\n")
+}
+}
+}
+}
+par(xpd = TRUE)
+legend(x = pos[1], y = pos[2],
+legend = nom_blockEtReponseSelect,
+pch = pch,
+col = vec_colSelect,
+cex = cex_legend,
+inset = inset)
+}else{
+cat("Il n'y a de variables dans cette zone du cercle de corrélation", "\n")
+}
+}
+return(varSelect)
+}
+# La fonction networkVariable permet de tracer un réseau pour les variables de
+# certains blocs et une variable réponse.
+networkVariable <-function(dataframe_Cor_Allcomp_Allvar,
+vec_Var,
+nomVar_block_Y,
+comp = 1:2,
+cutoff = 0
+)
+{
+# Pour chaque variable de vec_Var et la variable réponse, nous récupérons les noms des blocs,
+# les corrélations entre la variable et chaque composante.
+ind = which(dataframe_Cor_Allcomp_Allvar$variable%in%vec_Var == TRUE)
+ind_Var_block_Y = which(dataframe_Cor_Allcomp_Allvar$variable == nomVar_block_Y)
+dataframe_Cor_Allcomp_AllvarSelect = dataframe_Cor_Allcomp_Allvar[c(ind, ind_Var_block_Y), ]
+nomBlocs = unique(dataframe_Cor_Allcomp_AllvarSelect$bloc)
+if((length(ind) == length(vec_Var)) & length(ind_Var_block_Y) == 1)
+{
+if(length(nomBlocs) == 1)
+{
+cat("Erreur : il n'y a des variables d'un seul bloc dans listeVar", "\n")
+}else{
+liste_Cor_Allcomp_Allvar_bloc = lapply(1:length(nomBlocs), FUN = function(i){
+nomBloc_i = nomBlocs[i]
+indice = which(dataframe_Cor_Allcomp_AllvarSelect$bloc == nomBloc_i)
+resTemp = dataframe_Cor_Allcomp_AllvarSelect[indice, ]
+if(length(indice) == 1)
+{
+res = resTemp
+}else{
+res = resTemp
+}
+rownames(res) = resTemp$variable
+return(res)
+})
+names(liste_Cor_Allcomp_Allvar_bloc) = nomBlocs
+coord  = lapply(1:length(liste_Cor_Allcomp_Allvar_bloc), FUN = function(i){
+resTemp = liste_Cor_Allcomp_Allvar_bloc[[i]]
+res = apply(resTemp[, comp + 2, drop = FALSE], 2, as.numeric)
+if(dim(resTemp)[1] == 1)
+{
+res = matrix(res, nrow = 1)
+}
+rownames(res) = resTemp$variable
+return(res)
+})
+l = 1
+M_block = list()
+node.X1 = node.X2 = w = NULL
+# Calcul de la similarité.
+for(j in 1:(length(nomBlocs) - 1))
+{
+for(k in (j + 1):length(nomBlocs))
+{
+M_block[[l]] = coord[[j]][, drop = FALSE] %*% t(coord[[k]][, drop = FALSE])
+X1 = rownames(coord[[j]])
+X2 = rownames(coord[[k]])
+rep.X1 = rep(X1, each = length(X2))
+rep.X2 = rep(X2, length(X1))
+node.X1= c(node.X1, rep.X1)
+node.X2 = c(node.X2, rep.X2)
+w = c(w, as.vector(t(M_block[[l]])))
+l = l + 1
+} # Fin for(k in (j + 1):length(blocks)).
+} # Fin for(j in 1:(length(blocks) - 1)).
+# nodes
+group = NULL
+temp = lapply(1:length(liste_Cor_Allcomp_Allvar_bloc), function(i){
+res = liste_Cor_Allcomp_Allvar_bloc[[i]]$variable
+return(res)
+})
+names(temp) = names(liste_Cor_Allcomp_Allvar_bloc)
+for (i in 1:length(temp))
+{
+group = c(group, rep(names(temp)[i], length(temp[[i]])))
+} # Fin for (i in 1:length(temp)).
+nodes = data.frame(name = unlist(temp),
+group = group)
+# gR
+relations = data.frame(from = node.X1,
+to = node.X2,
+weight = w)
+idx = (abs(w) >= cutoff)
+relations = relations[idx, , drop = FALSE]
+gR = graph.data.frame(relations,
+directed = FALSE,
+vertices = nodes)
+gR = delete.vertices(gR, which(degree(gR) == 0))
+res = list(gR = gR)
+l = 1
+for (i in 1:(length(nomBlocs)-1))
+{
+for (j in (i + 1):length(nomBlocs))
+{
+res[paste("M", names(liste_Cor_Allcomp_Allvar_bloc)[i], names(liste_Cor_Allcomp_Allvar_bloc)[j], sep="_")] = list(M_block[[l]])
+l = l + 1
+} # Fin for (j in (i + 1):length(blocks)).
+} # Fin for (i in 1:(length(blocks)-1).
+res$cutoff = cutoff
+return(res)
+}
+# Fin if((length(which(ind))= length(listeVar)) & length(ind_Var_block_Y) == 1).
+}else{
+if(length(ind) != length(vec_Var))
+{
+cat("Erreur  : les variables de vec_Var ne sont pas contenues dans dataframe_Cor_Allcomp_Allvar$variable.", "\n")
+}
+if(length(ind_Var_block_Y) == 1)
+{
+cat(paste0("Erreur  : la variable réponse ", nomVar_block_Y," n'est pas contenue dans dataframe_Cor_Allcomp_Allvar$variable."), "\n")
+}
+}
+}
+# Integration 7 blocs norm gene -------------------------------------------
+# La fonction compute_cor_comp_var calcule, pour chaque variable d'un bloc, les corrélations
+# entre la variable et les composantes sélectionnées par comp.
+compute_cor_comp_var <-function(res_block_splsda,
+comp = c(1:2))
+{
+vec_blocksTemp = res_block_splsda$names$blocks
+ind_Y = which(vec_blocksTemp == "Y")
+vec_blocks1 = vec_blocksTemp[- ind_Y]
+vec_indice_blocks = sapply(1:length(vec_blocks1), FUN = function(i){
+res = which(res_block_splsda$names$blocks == vec_blocks1[i])
+return(res)
+})
+# Calcul, pour chaque variable d'un bloc, des corrélations de cette variable avec
+# les composantes dont les indices sont indiqués dans le vecteur comp.
+vec_blocks2 = c()
+liste_cor_comp_var_global = list()
+for(i in 1:length(vec_indice_blocks))
+{
+indice_blocks_i = vec_indice_blocks[i]
+block_i = res_block_splsda$names$blocks[indice_blocks_i]
+vec_varSelect_i = c()
+liste_comp_i = list()
+for(j in 1:length(comp))
+{
+indice_comp_j = comp[j]
+liste_comp_i[[j]] = res_block_splsda$variates[[indice_blocks_i]][, indice_comp_j]
+vec_varSelect_comp_j = selectVar(res_block_splsda,
+comp = indice_comp_j)[[indice_blocks_i]][[1]]
+vec_varSelect_i = c(vec_varSelect_i, vec_varSelect_comp_j)
+} # Fin for(j in 1:length(comp)).
+vec_varSelect_i = unique(vec_varSelect_i)
+mat_block_i = res_block_splsda$X[[indice_blocks_i]][, vec_varSelect_i]
+liste_cor_comp_var = list()
+for(j in 1:length(liste_comp_i))
+{
+liste_cor_comp_var[[j]] = sapply(1:dim(mat_block_i)[2], FUN = function(k){
+cor(liste_comp_i[[j]], mat_block_i[, k])
+})
+} # Fin for(j in 1:length(liste_comp_i)).
+mat_cor_Allcomp_Allvar = Reduce(cbind, liste_cor_comp_var)
+rownames(mat_cor_Allcomp_Allvar) = colnames(mat_block_i)
+vec_blocks_i = rep(block_i, dim(mat_block_i)[2])
+vec_blocks2 = c(vec_blocks2, vec_blocks_i)
+liste_cor_comp_var_global[[i]] = mat_cor_Allcomp_Allvar
+} # Fin for(i in 1:length(blocks)).
+mat_cor_comp_var_global = Reduce(rbind, liste_cor_comp_var_global)
+dataframe_cor_comp_var_global = data.frame(cbind(rownames(mat_cor_comp_var_global),
+vec_blocks2,
+mat_cor_comp_var_global))
+colnames(dataframe_cor_comp_var_global) = c("variable",
+"bloc",
+paste0("cor_var_comp", comp))
+dataframe_cor_comp_var_global[, 1:2] = apply(dataframe_cor_comp_var_global[, 1:2], 2, as.character)
+dataframe_cor_comp_var_global[, 3:dim(dataframe_cor_comp_var_global)[2]] = apply(dataframe_cor_comp_var_global[, 3:dim(dataframe_cor_comp_var_global)[2]], 2, as.numeric)
+return(dataframe_cor_comp_var_global)
+}
+# La fonction composanteColin renvoie une liste. Le ième élément de cette liste
+# contient les indices des blocs tels que, pour chaque paire de ces blocs, la
+# première composante du bloc 1 est fortement corrélée à la première composante
+# du bloc2 en valeur absolue et la deuxième composante du bloc 1 est fortement
+# corrélée à la deuxième composante du bloc2 en valeur absolue.
+composanteColin <-function(mat_cor_comp1,
+mat_cor_comp2,
+cutoff_comp)
+{
+res = list()
+index = 1:dim(mat_cor_comp1)[1]
+i = 1
+compt = 1
+while(length(index) != 0 & compt <= dim(mat_cor_comp1)[1])
+{
+index_i = index[i]
+res[[compt]] = c(index_i)
+index2 = index[-i]
+if(length(index2) != 1)
+{
+for(j in index2)
+{
+if(length(res[[compt]]) == 1)
+{
+if(abs(mat_cor_comp1[j, index_i]) > cutoff_comp & abs(mat_cor_comp2[j, index_i]) > cutoff_comp)
+{
+res[[compt]] = c(res[[compt]], j)
+index = index[- c(which(index == j))]
+}
+}else{
+indice = sapply(1:length(res[[compt]]), FUN = function(k){
+index_k = res[[compt]][k]
+cond = abs(mat_cor_comp1[index_k, j]) > cutoff_comp & abs(mat_cor_comp2[index_k, j]) > cutoff_comp
+return(cond)
+})
+if(all(indice))
+{
+res[[compt]] = c(res[[compt]], j)
+index = index[- c(which(index == j))]
+}
+}
+}
+}else{
+res[[compt]] = index_i
+}
+index = index[- c(which(index == index_i))]
+compt = compt + 1
+} # Fin for(i in 1:dim(mat_cor_comp1)[2]).
+if(length(index) != 0)
+{
+for(i in 1:length(index))
+{
+res = c(res, list(index[i]))
+}
+}
+return(res)
+}
+# La fonction compute_blockSelect permet de déterminer toutes les combinaisons
+# possibles des blocs qui peuvent être superposés dans le cercle de corrélations
+# et dont les variables peuvent être présentes dans le réseau.
+compute_blockSelect <-function(mat_cor_comp1,
+mat_cor_comp2,
+cutoff_comp)
+{
+liste_vec_indice_blockSelect = composanteColin(mat_cor_comp1,
+mat_cor_comp2,
+cutoff_comp)
+vec_blocks = colnames(mat_cor_comp1)
+liste_vec_blocks = list()
+# liste_blocks est une liste contenant toutes les combinaisons possibles de blocs dont
+# on peut superposer les cercles de corrélations et dont les variables peuvent être
+# présentes dans le réseau.
+for(i in 1:length(liste_vec_indice_blockSelect))
+{
+vec_indice_blockSelect_i = liste_vec_indice_blockSelect[[i]]
+for(k in 1:length(vec_indice_blockSelect_i))
+{
+matComb = combn(vec_indice_blockSelect_i, m = k)
+liste_vec_blocks_i = lapply(1:dim(matComb)[2], FUN = function(i){
+comb_i = matComb[, i]
+resultat = vec_blocks[comb_i]
+return(resultat)
+})
+for(j in 1:length(liste_vec_blocks_i))
+{
+liste_vec_blocks = c(liste_vec_blocks, list(liste_vec_blocks_i[[j]]))
+} # Fin for(j in 1:length(liste_noms_blocks)).
+} # Fin for(k in 1:length(blockSelect_i)).
+} # Fin for(i in 1:length(blockSelect)).
+liste_vec_blocks = unique(liste_vec_blocks)
+return(list(liste_vec_indice_blockSelect = liste_vec_indice_blockSelect,
+liste_vec_blocks = liste_vec_blocks))
+}
+# La fonction matCorEtBlockSelect permet de calculer la matrice de
+# corrélation entre les comp[1] composantes de chaque bloc et la
+# matrice de corrélation entre les comp[2] composantes de chaque
+# bloc. Elle permet aussi de calculer, pour chaque variable d'un bloc,
+# les corrélations entre les composantes comp[1] et comp[2] et cette variable
+# et de calculer toutes les combinaisons possibles des blocs pour lesquels nous
+# pouvons superposer les cercles de corrélations.
+matCorEtBlockSelect <-function(res_block_splsda,
+cutoff_comp,
+comp)
+{
+liste_mat_cor_comp = matriceCorrelation_comp(res_block_splsda = res_block_splsda,
+comp = comp)
+mat_cor_comp1 = liste_mat_cor_comp$mat_cor_comp1
+mat_cor_comp2 = liste_mat_cor_comp$mat_cor_comp2
+dataframe_cor_comp_var_global = compute_cor_comp_var(res_block_splsda = res_block_splsda,
+comp = comp)
+liste_blockSelect = compute_blockSelect(mat_cor_comp1 = mat_cor_comp1,
+mat_cor_comp2 = mat_cor_comp2,
+cutoff_comp = cutoff_comp)
+liste_vec_indice_blockSelect = liste_blockSelect$liste_vec_indice_blockSelect
+liste_vec_blocks = liste_blockSelect$liste_vec_blocks
+return(list(mat_cor_comp1 = mat_cor_comp1,
+mat_cor_comp2 = mat_cor_comp2,
+dataframe_cor_comp_var_global = dataframe_cor_comp_var_global,
+liste_vec_indice_blockSelect = liste_vec_indice_blockSelect,
+liste_vec_blocks = liste_vec_blocks))
+}
+# La fonction addVariablesReponses permet de calculer, pour chaque
+# variable réponse, la corrélation entre cette variable et la
+# comp[1] composante et la corrélation entre cette variable et la comp[2]
+# composante pour chaque groupe de blocs.
+addVariablesReponses <-function(res_block_splsda,
+dataframe_cor_comp_var_global,
+liste_vec_indice_blockSelect,
+mat_block_Y)
+{
+# On récupère les indices des composantes utilisées pour calculer les
+# corrélations entre les variables des blocs et les composantes.
+comp = as.numeric(sapply(3:4, FUN = function(i){
+col_i = colnames(dataframe_cor_comp_var_global)[i]
+ch = strsplit(col_i, split = "_")[[1]]
+resTemp = ch[length(ch)]
+res = substring(resTemp, nchar(resTemp), nchar(resTemp))
+return(res)
+}))
+# On calcule, pour chaque variable réponse, pour chaque composante du premier
+# bloc du groupe de blocs, la corrélation entre cette variable réponse et la composante.
+liste_dataframe_cor_allcomp_varReponses = list()
+vec_groupe_blocks = c()
+for(i in 1:length(liste_vec_indice_blockSelect))
+{
+vec_indice_blockSelect_i = liste_vec_indice_blockSelect[[i]]
+indice_first_block_i = vec_indice_blockSelect_i[1]
+liste_comp_i = list()
+liste_cor_comp_var = list()
+for(j in 1:length(comp))
+{
+indice_comp_j = comp[j]
+comp_j = res_block_splsda$variates[[indice_first_block_i]][, indice_comp_j]
+liste_cor_comp_var[[j]] = sapply(1:dim(mat_block_Y)[2], FUN = function(k){
+cor(comp_j, mat_block_Y[, k])
+})
+} # Fin for(j in 1:length(liste_comp_i)).
+mat_cor_allcomp_varReponses = Reduce(cbind, liste_cor_comp_var)
+rownames(mat_cor_allcomp_varReponses) = colnames(mat_block_Y)
+dataframe_allcomp_varReponses = data.frame(colnames(mat_block_Y),
+rep("Y", dim(mat_block_Y)[2]),
+mat_cor_allcomp_varReponses)
+colnames(dataframe_allcomp_varReponses) = c("variable",
+"bloc",
+paste0("cor_var_comp", comp))
+liste_dataframe_cor_allcomp_varReponses[[i]] = dataframe_allcomp_varReponses
+groupe_blocks_i = res_block_splsda$names$blocks[vec_indice_blockSelect_i]
+vec_groupe_blocks = c(vec_groupe_blocks, paste(groupe_blocks_i, collapse = "-"))
+} # Fin for(in in 1:length(blockSelect)).
+names(liste_dataframe_cor_allcomp_varReponses) = vec_groupe_blocks
+liste_dataframe_cor_comp_var_global = list()
+for(i in 1:length(liste_vec_indice_blockSelect))
+{
+vec_indice_blockSelect_i = liste_vec_indice_blockSelect[[i]]
+groupe_blocks_i = res_block_splsda$names$blocks[vec_indice_blockSelect_i]
+indice_i = which(dataframe_cor_comp_var_global$bloc%in%groupe_blocks_i == TRUE)
+dataframe_cor_comp_var_global_indice_i = dataframe_cor_comp_var_global[indice_i, ]
+dataframe_cor_comp_varBlockEtVarRep_global = rbind(dataframe_cor_comp_var_global_indice_i,
+liste_dataframe_cor_allcomp_varReponses[[i]])
+dataframe_cor_comp_varBlockEtVarRep_global[, 1:2] = apply(dataframe_cor_comp_varBlockEtVarRep_global[, 1:2], 2, as.character)
+dataframe_cor_comp_varBlockEtVarRep_global[, 3:dim(dataframe_cor_comp_varBlockEtVarRep_global)[2]] = apply(dataframe_cor_comp_varBlockEtVarRep_global[, 3:dim(dataframe_cor_comp_varBlockEtVarRep_global)[2]], 2, as.numeric)
+liste_dataframe_cor_comp_var_global[[i]] = dataframe_cor_comp_varBlockEtVarRep_global
+} # Fin for(i in 1:length(indice_blockSelect)).
+names(liste_dataframe_cor_comp_var_global) = vec_groupe_blocks
+return(liste_dataframe_cor_comp_var_global)
+}
+# La fonction addVariablesReponsesModified permet de calculer, pour chaque
+# variable réponse, la corrélation entre cette variable et la
+# comp[1] composante et la corrélation entre cette variable et la comp[2]
+# composante pour chaque groupe de blocs.
+addVariablesReponsesModified <-function(res_block_splsda,
+dataframe_cor_comp_var_global,
+liste_vec_indice_blockSelect,
+mat_block_Y)
+{
+# On récupère les indices des composantes utilisées pour calculer les
+# corrélations entre les variables des blocs et les composantes.
+comp = as.numeric(sapply(3:4, FUN = function(i){
+col_i = colnames(dataframe_cor_comp_var_global)[i]
+ch = strsplit(col_i, split = "_")[[1]]
+resTemp = ch[length(ch)]
+res = substring(resTemp, nchar(resTemp), nchar(resTemp))
+return(res)
+}))
+# On calcule, pour chaque variable réponse, pour chaque composante du premier
+# bloc du groupe de blocs, la corrélation entre cette variable réponse et la composante.
+liste_dataframe_cor_allcomp_varReponses = list()
+vec_groupe_blocks = c()
+for(i in 1:length(liste_vec_indice_blockSelect))
+{
+vec_indice_blockSelect_i = liste_vec_indice_blockSelect[[i]]
+indice_first_block_i = vec_indice_blockSelect_i[1]
+liste_comp_i = list()
+liste_cor_comp_var = list()
+for(j in 1:length(comp))
+{
+indice_comp_j = comp[j]
+comp_j = res_block_splsda$variates[[indice_first_block_i]][, indice_comp_j]
+liste_cor_comp_var[[j]] = sapply(1:dim(mat_block_Y)[2], FUN = function(k){
+resTemp = comp_j%*%mat_block_Y[, k]
+res = resTemp/(norm(comp_j - mean(comp_j), "2")*norm(mat_block_Y[, k], "2"))
+})
+} # Fin for(j in 1:length(liste_comp_i)).
+mat_cor_allcomp_varReponses = Reduce(cbind, liste_cor_comp_var)
+rownames(mat_cor_allcomp_varReponses) = colnames(mat_block_Y)
+dataframe_allcomp_varReponses = data.frame(colnames(mat_block_Y),
+rep("Y", dim(mat_block_Y)[2]),
+mat_cor_allcomp_varReponses)
+colnames(dataframe_allcomp_varReponses) = c("variable",
+"bloc",
+paste0("cor_var_comp", comp))
+liste_dataframe_cor_allcomp_varReponses[[i]] = dataframe_allcomp_varReponses
+groupe_blocks_i = res_block_splsda$names$blocks[vec_indice_blockSelect_i]
+vec_groupe_blocks = c(vec_groupe_blocks, paste(groupe_blocks_i, collapse = "-"))
+} # Fin for(in in 1:length(blockSelect)).
+names(liste_dataframe_cor_allcomp_varReponses) = vec_groupe_blocks
+liste_dataframe_cor_comp_var_global = list()
+for(i in 1:length(liste_vec_indice_blockSelect))
+{
+vec_indice_blockSelect_i = liste_vec_indice_blockSelect[[i]]
+groupe_blocks_i = res_block_splsda$names$blocks[vec_indice_blockSelect_i]
+indice_i = which(dataframe_cor_comp_var_global$bloc%in%groupe_blocks_i == TRUE)
+dataframe_cor_comp_var_global_indice_i = dataframe_cor_comp_var_global[indice_i, ]
+dataframe_cor_comp_varBlockEtVarRep_global = rbind(dataframe_cor_comp_var_global_indice_i,
+liste_dataframe_cor_allcomp_varReponses[[i]])
+dataframe_cor_comp_varBlockEtVarRep_global[, 1:2] = apply(dataframe_cor_comp_varBlockEtVarRep_global[, 1:2], 2, as.character)
+dataframe_cor_comp_varBlockEtVarRep_global[, 3:dim(dataframe_cor_comp_varBlockEtVarRep_global)[2]] = apply(dataframe_cor_comp_varBlockEtVarRep_global[, 3:dim(dataframe_cor_comp_varBlockEtVarRep_global)[2]], 2, as.numeric)
+liste_dataframe_cor_comp_var_global[[i]] = dataframe_cor_comp_varBlockEtVarRep_global
+} # Fin for(i in 1:length(indice_blockSelect)).
+names(liste_dataframe_cor_comp_var_global) = vec_groupe_blocks
+return(liste_dataframe_cor_comp_var_global)
+}
+# La fonction circleCor permet de zoomer sur un rectangle du cercle de corrélations
+# et de récupérer les variables des blocs dans cette partie zoomée du cercle de
+# corrélations.
+circleCor <-function(liste_dataframe_cor_comp_var_global,
+liste_vec_indice_blockSelect,
+mat_cor_comp1,
+mat_cor_comp2,
+vec_blocks,
+nomsVarReponses,
+cutoff = 0.85,
+min.X = -1,
+max.X = 1,
+min.Y = -1,
+max.Y = 1,
+vec_col = colorRampPalette(brewer.pal(9, "Spectral"))(dim(mat_cor_comp1)[1] + 1),
+rad.in = 0.5,
+cex = 0.7,
+cex_legend = 0.8,
+pos = c(1.2, 0),
+pch = 20,
+inset = c(-0.25, 0))
+{
+# On vérifie que nous pouvons superposer les cercles de corrélation.
+vec_indice_blocks = sapply(1:length(vec_blocks), FUN = function(i){
+res =  which(colnames(mat_cor_comp1) == vec_blocks[i])
+return(res)
+})
+boolean = FALSE
+i = 1
+while(i <= length(liste_vec_indice_blockSelect) & !boolean)
+{
+vec_indice_blockSelect_i = liste_vec_indice_blockSelect[[i]]
+cond = length(which(vec_indice_blockSelect_i%in%vec_indice_blocks == TRUE)) == length(vec_blocks)
+if(cond)
+{
+boolean = TRUE
+}
+i = i + 1
+} # Fin  while(i <= length(liste_vec_indice_blockSelect) & !boolean).
+varSelect = NULL
+if(!boolean)
+{
+stop(paste0("The blocks : ", paste(vec_blocks, collapse = ", "), " can not be superimposed."))
+}else{
+# On récupère le groupe de blocs auxquels appartient vec_blocks.
+indice_nomsBlock = sapply(1:length(liste_dataframe_cor_comp_var_global), FUN = function(i){
+name_iTemp = names(liste_dataframe_cor_comp_var_global)[i]
+name_i = strsplit(name_iTemp, split = "-")[[1]]
+res = all(vec_blocks%in%name_i)
+return(res)
+})
+dataframe_cor_comp_var_global = liste_dataframe_cor_comp_var_global[[which(indice_nomsBlock == TRUE)]]
+dataframe_cor_comp_var_globalTemp1 = dataframe_cor_comp_var_global
+indice_nomsVarReponses = all(nomsVarReponses%in%dataframe_cor_comp_var_globalTemp1$variable)
+if(!indice_nomsVarReponses)
+{
+stop("All the correlations between the response variables and the first component and the correlations
+between the responses variables and the second component have not been computed.")
+}else{
+comp = as.numeric(sapply(3:4, FUN = function(i){
+col_i = colnames(dataframe_cor_comp_var_globalTemp1)[i]
+ch = strsplit(col_i, split = "_")[[1]]
+resTemp = ch[length(ch)]
+res = substring(resTemp, nchar(resTemp), nchar(resTemp))
+return(res)
+}))
+mat_cor_comp_var_globalTemp1 = t(sapply(1:dim(dataframe_cor_comp_var_globalTemp1)[1], FUN = function(i){
+dataframe_cor_comp_var_globalTemp1_i = dataframe_cor_comp_var_globalTemp1[i, ]
+block_i = dataframe_cor_comp_var_globalTemp1_i$bloc
+cor1  = dataframe_cor_comp_var_globalTemp1_i[paste0("cor_var_comp", comp[1])]
+cor2  = dataframe_cor_comp_var_globalTemp1_i[paste0("cor_var_comp", comp[2])]
+if(block_i == "Y")
+{
+cor1_sign = cor1
+cor2_sign = cor2
+}else{
+indice_block_comp1_i =  which(colnames(mat_cor_comp1) == block_i)
+indice_block_comp2_i =  which(colnames(mat_cor_comp2) == block_i)
+cor1_sign = sign(mat_cor_comp1[vec_indice_blocks[1], indice_block_comp1_i])*cor1
+cor2_sign = sign(mat_cor_comp2[vec_indice_blocks[1], indice_block_comp2_i])*cor2
+}
+res = c(dataframe_cor_comp_var_globalTemp1_i[1:2], cor1_sign, cor2_sign)
+return(res)
+}))
+dataframe_cor_comp_var_globalTemp2 = as.data.frame(mat_cor_comp_var_globalTemp1)
+dataframe_cor_comp_var_globalTemp2[, 1:2] = apply(dataframe_cor_comp_var_globalTemp2[, 1:2], 2, as.character)
+colnames(dataframe_cor_comp_var_globalTemp2) = colnames(dataframe_cor_comp_var_global)
+# Pour les variables de vec_blocks et les variables réponses nomsVarReponses, on récupère les corrélations
+# entre ces variables et les composantes.
+indice1 = sapply(1:dim(dataframe_cor_comp_var_globalTemp2)[1], FUN = function(i){
+block_i = dataframe_cor_comp_var_globalTemp2$bloc[i]
+if(block_i == "Y")
+{
+res = dataframe_cor_comp_var_globalTemp2$variable[i]%in%nomsVarReponses
+}else{
+res = block_i%in%vec_blocks
+}
+return(res)
+})
+dataframe_cor_comp_var_global2 = dataframe_cor_comp_var_globalTemp2[indice1, ]
+mat_cor_comp_var_global2 = apply(dataframe_cor_comp_var_global2[ , 3:4], 2, as.numeric)
+rownames(mat_cor_comp_var_global2) = dataframe_cor_comp_var_global2$variable
+# indice permet de récupérer les variables de chaque bloc fortement corrélées avec soit
+# la première composante ou la deuxième composante dans un rectangle du cercle de corrélations
+# et de récupérer les variables réponses.
+indice2 = sapply(1:dim(dataframe_cor_comp_var_global2)[1], FUN = function(k){
+cor1 = mat_cor_comp_var_global2[k, 1]
+cor2 = mat_cor_comp_var_global2[k, 2]
+blockEtReponse_k = dataframe_cor_comp_var_global2[k, 2]
+if(blockEtReponse_k == "Y")
+{
+cond2 = TRUE
+}else{
+cond1 = abs(cor1) > cutoff | abs(cor2) > cutoff
+cond2 = cor1 > min.X & cor1 < max.X & cor2 > min.Y & cor2 < max.Y & cond1
+}
+return(cond2)
+})
+dataframe_cor_comp_var_global2Select = dataframe_cor_comp_var_global2[indice2, ]
+varSelectTemp = dataframe_cor_comp_var_global2Select$variable
+ind_Y = which(dataframe_cor_comp_var_global2Select$bloc == "Y")
+if(length(ind_Y) != 0)
+{
+varSelect = varSelectTemp[- ind_Y]
+}else{
+varSelect = varSelectTemp
+}
+mat_cor_comp_var_global2Select = mat_cor_comp_var_global2[indice2, , drop = FALSE]
+# Tracé de la superposition des cerles de corrélation.
+circle = list()
+circle[[1]] = ellipse(0, levels = 1, t = 1)
+circle[[2]] = ellipse(0, levels = 1, t = rad.in)
+circle = data.frame(do.call("rbind", circle), "Circle" = c(rep("Main circle", 100), rep("Inner circle", 100)))
+MainCircle = circle[grep("Main circle", circle[, 3]), ]
+InnerCircle = circle[grep("Inner circle", circle[, 3]), ]
+plot(MainCircle[, 1], MainCircle[, 2],
+type = "l",
+xlab = paste0("composante ", comp[1]),
+ylab = paste0("composante ", comp[2]))
+points(InnerCircle[, 1], InnerCircle[, 2],
+type = "l")
+if(dim(mat_cor_comp_var_global2Select)[1] != 0)
+{
+vec_blockEtReponseSelect = unique(dataframe_cor_comp_var_global2Select$bloc)
+indice_blockEtReponseSelect = sapply(1:length(vec_blockEtReponseSelect), FUN = function(i){
+ind = which(colnames(mat_cor_comp1) == vec_blockEtReponseSelect[i])
+if(length(ind) != 0)
+{
+res = ind
+}else{
+res = dim(mat_cor_comp1)[1] + 1
+}
+return(res)
+})
+vec_colSelect = vec_col[indice_blockEtReponseSelect]
+if(length(vec_blockEtReponseSelect) == 1)
+{
+points(mat_cor_comp_var_global2Select[, 1], mat_cor_comp_var_global2Select[, 2],
+col  = NULL)
+text(mat_cor_comp_var_global2Select[, 1], mat_cor_comp_var_global2Select[, 2],
+labels = rownames(mat_cor_comp_var_global2Select),
+cex = cex,
+col = vec_colSelect[1])
+}else{
+nbVarSelect_bloc = cumsum(sapply(1:length(vec_blockEtReponseSelect), FUN = function(j){
+res = length(which(dataframe_cor_comp_var_global2Select$bloc == vec_blockEtReponseSelect[j]))
+return(res)
+}))
+for(i in 1:length(nbVarSelect_bloc))
+{
+if(i == 1)
+{
+indice_nbVar1 = 1:nbVarSelect_bloc[1]
+mat_cor_comp_var_global2Select2 = mat_cor_comp_var_global2Select[indice_nbVar1, , drop = FALSE]
+points(mat_cor_comp_var_global2Select2[, 1], mat_cor_comp_var_global2Select2[, 2],
+col  = NULL)
+text(mat_cor_comp_var_global2Select2[, 1], mat_cor_comp_var_global2Select2[, 2],
+labels = rownames(mat_cor_comp_var_global2Select2),
+cex = cex,
+col = rep(vec_colSelect[i], dim(mat_cor_comp_var_global2Select2)[1]))
+}else{
+indice_nbVar2 = (nbVarSelect_bloc[i - 1] + 1):nbVarSelect_bloc[i]
+mat_cor_comp_var_global2Select2 = mat_cor_comp_var_global2Select[indice_nbVar2, , drop = FALSE]
+points(mat_cor_comp_var_global2Select2[, 1], mat_cor_comp_var_global2Select2[, 2],
+col  = NULL)
+text(mat_cor_comp_var_global2Select2[, 1], mat_cor_comp_var_global2Select2[, 2],
+labels = rownames(mat_cor_comp_var_global2Select2),
+cex = cex,
+col = rep(vec_colSelect[i], dim(mat_cor_comp_var_global2Select2)[1]))
+}
+}
+}
+par(xpd = TRUE)
+legend(x = pos[1], y = pos[2],
+legend = vec_blockEtReponseSelect,
+pch = pch,
+col = vec_colSelect,
+cex = cex_legend,
+inset = inset)
+}else{
+warning("There is no variables in this rectangle of the correlation circle.")
+}
+}
+}
+return(varSelect)
+}
+tabVarSelect <-function(varSelect)
+{
+}
+# La fonction compute_matSimilarity calcule, pour chaque groupe de blocs, les
+# similarités entre le bloc1 et le bloc2 et entre les blocs et la réponse.
+compute_matSimilarity <-function(liste_dataframe_cor_comp_var_global)
+{
+comp = as.numeric(sapply(3:4, FUN = function(i){
+col_i = colnames(liste_dataframe_cor_comp_var_global[[1]])[i]
+ch = strsplit(col_i, split = "_")[[1]]
+resTemp = ch[length(ch)]
+res = substring(resTemp, nchar(resTemp), nchar(resTemp))
+return(res)
+}))
+liste_matSimilarity_group = list()
+# On calcule, pour chaque groupe de blocs, les matrices de similarités entre
+# chaque paire de blocs.
+for(i in 1:length(liste_dataframe_cor_comp_var_global))
+{
+dataframe_cor_comp_var_global_i = liste_dataframe_cor_comp_var_global[[i]]
+blocks_i = unique(dataframe_cor_comp_var_global_i$bloc)
+coord = lapply(1:length(blocks_i), FUN = function(j){
+ind_j = which(dataframe_cor_comp_var_global_i$bloc == blocks_i[j])
+dataframe_cor_comp_var_global_i_j = dataframe_cor_comp_var_global_i[ind_j, paste0("cor_var_comp", comp)]
+res = as.matrix(dataframe_cor_comp_var_global_i_j, drop = FALSE)
+rownames(res) = rownames(dataframe_cor_comp_var_global_i_j)
+return(res)
+})
+M_block = list()
+l = 1
+vec_blocks_i = c()
+for(j in 1:(length(blocks_i) - 1))
+{
+blocks_i_j = blocks_i[j]
+for(k in (j + 1):length(blocks_i))
+{
+blocks_i_k = blocks_i[k]
+M_block[[l]] = coord[[j]][, drop = FALSE] %*% t(coord[[k]][, drop = FALSE])
+rownames(M_block[[l]]) = rownames(coord[[j]])
+colnames(M_block[[l]]) = rownames(coord[[k]])
+blocks_j_k = paste(c(blocks_i_j, blocks_i_k), collapse = "-")
+vec_blocks_i = c(vec_blocks_i, blocks_j_k)
+l = l + 1
+} # Fin for(k in (j + 1):length(blocks)).
+} # Fin for(j in 1:(length(blocks) - 1)).
+names(M_block) = vec_blocks_i
+liste_matSimilarity_group[[i]] = M_block
+} # Fin for(i in 1:length(liste_dataframe_Cor_comp_var_global)).
+names(liste_matSimilarity_group) = names(liste_dataframe_cor_comp_var_global)
+return(list(liste_matSimilarity_group = liste_matSimilarity_group,
+comp = comp))
+}
+# La fonction networkVariableSelect permet de tracer un réseau pour les variables de
+# certains blocs et des variables réponses.
+networkVariableSelect <-function(liste_matSimilarity_group,
+comp,
+res_block_splsda,
+cutoff_comp = 0.8,
+vec_varBlock,
+vec_varRep,
+cutoff = 0
+)
+{
+vec_varBlockEtReponse = c(vec_varBlock, vec_varRep)
+# Nous vérifions que nous pouvons créer un réseau pour les variables des
+# blocs vec_Var_blockEtReponse.
+# Nous recherchons le groupe de blocs associé à vec_varBlock.
+indice_group_vecVar = sapply(1:length(liste_matSimilarity_group), FUN = function(i){
+liste_matSimilarity_group_i = liste_matSimilarity_group[[i]]
+boolean = FALSE
+j = 1
+while((j <= length(liste_matSimilarity_group_i))&!boolean)
+{
+matSimilarity_group_i_j = liste_matSimilarity_group_i[[j]]
+vec_var_block1 = rownames(matSimilarity_group_i_j)
+vec_var_block2 = colnames(matSimilarity_group_i_j)
+vec_var_block = c(vec_var_block1, vec_var_block2)
+if(any(vec_var_block%in%vec_varBlock))
+{
+boolean = TRUE
+}
+j = j + 1
+} # Fin while((j <= length(liste_matSimilarity_group_i))&!boolean).
+res = boolean
+return(res)
+})
+res = NULL
+if(length(which(indice_group_vecVar == TRUE)) >= 2)
+{
+cat("Erreur : les variables de vec_varBlock. doivent appartenir à un seul élément de la liste
+liste_res_matSimilarity_group$liste_matSimilarity_group.", "\n")
+}else{
+liste_matSimilarity = liste_matSimilarity_group[[which(indice_group_vecVar == TRUE)]]
+blocks_liste_matSimilarityTemp1 = sapply(1:length(liste_matSimilarity), FUN = function(i){
+noms_block1_block2_i = names(liste_matSimilarity)[i]
+ch = strsplit(noms_block1_block2_i, split = "-")[[1]]
+block1 = ch[1]
+block2 = ch[2]
+res = c(block1, block2)
+return(res)
+})
+blocks_liste_matSimilarity = unique(as.vector(blocks_liste_matSimilarityTemp1))
+indice_blocks_liste_matSimilarityTemp = sapply(1:length(blocks_liste_matSimilarity), FUN = function(i){
+res = which(res_block_splsda$names$blocks == blocks_liste_matSimilarity[i])
+return(res)
+})
+ind_Y = which(res_block_splsda$names$blocks == "Y")
+indice_blocks_liste_matSimilarity = indice_blocks_liste_matSimilarityTemp[indice_blocks_liste_matSimilarityTemp != ind_Y]
+boolean_pos_cor = TRUE
+# Nous vérifions que les ièmes composantes de chaque bloc sont fortement corrélées positivement.
+if(length(indice_blocks_liste_matSimilarity) == 1)
+{
+}else{
+for(i in 1:length(comp))
+{
+comp_i = comp[i]
+for(j in 1:(length(indice_blocks_liste_matSimilarity) - 1))
+{
+indice_blocks_liste_matSimilarity_j = indice_blocks_liste_matSimilarity[j]
+comp_indice_blocks_liste_matSimilarity_j = res_block_splsda$variates[[indice_blocks_liste_matSimilarity_j]][, comp_i]
+for(k in (j + 1):length(indice_blocks_liste_matSimilarity))
+{
+indice_blocks_liste_matSimilarity_k = indice_blocks_liste_matSimilarity[k]
+comp_indice_blocks_liste_matSimilarity_k = res_block_splsda$variates[[indice_blocks_liste_matSimilarity_k]][, comp_i]
+cor = cor(comp_indice_blocks_liste_matSimilarity_j, comp_indice_blocks_liste_matSimilarity_k)
+boolean_pos_cor = boolean_pos_cor & all(cor > cutoff_comp)
+} # Fin for(k in (j + 1):length(indice_blocks_liste_matSimilarity)).
+} # Fin for(j in 1:(length(indice_blocks_liste_matSimilarity) - 1)).
+} # Fin for(i in 1:length(comp)).
+}
+if(!boolean_pos_cor)
+{
+cat("Erreur : pour chaque paire de bloc, la ième composante de chaque bloc doivent être corrélées positivement afin de pouvoir créer
+un réseau.", "\n")
+}else{
+# Nous récupérons les matrices de similarités associés aux variables de vec_varBlockEtReponse .
+liste_matSimilaritySelectTemp = lapply(1:length(liste_matSimilarity), FUN = function(j){
+matSimilarity_j = liste_matSimilarity[[j]]
+indice_row_matSimilarity_j  = which(rownames(matSimilarity_j)%in%vec_varBlockEtReponse == TRUE)
+indice_col_matSimilarity_j  = which(colnames(matSimilarity_j)%in%vec_varBlockEtReponse == TRUE)
+if((length(indice_row_matSimilarity_j) != 0) &(length(indice_col_matSimilarity_j) != 0))
+{
+res = matSimilarity_j[indice_row_matSimilarity_j, indice_col_matSimilarity_j, drop = FALSE]
+}else{
+res = NA
+}
+return(res)
+})
+names(liste_matSimilaritySelectTemp) = names(liste_matSimilarity)
+indice_NA_liste_matSimilaritySelectTemp = sapply(1:length(liste_matSimilaritySelectTemp), FUN = function(i){
+liste_matSimilaritySelectTemp_i = liste_matSimilaritySelectTemp[[i]]
+if(is.matrix(liste_matSimilaritySelectTemp_i))
+{
+res = FALSE
+}else{
+if(is.na(liste_matSimilaritySelectTemp_i))
+{
+res = TRUE
+}else{
+res = FALSE
+}
+}
+return(res)
+})
+liste_matSimilaritySelect = liste_matSimilaritySelectTemp[!indice_NA_liste_matSimilaritySelectTemp]
+# Nous créons le réseau.
+w = c()
+node.X1 = c()
+node.X2 = c()
+vec_group = c()
+vec_nomsVar = c()
+for(i in 1:length(liste_matSimilaritySelect))
+{
+noms_bloc1_bloc2 = names(liste_matSimilaritySelect)[i]
+matSimilaritySelect_i = liste_matSimilaritySelect[[i]]
+X1 = rownames(matSimilaritySelect_i)
+X2 = colnames(matSimilaritySelect_i)
+rep.X1 = rep(X1, each = length(X2))
+rep.X2 = rep(X2, length(X1))
+node.X1= c(node.X1, rep.X1)
+node.X2 = c(node.X2, rep.X2)
+ch = strsplit(noms_bloc1_bloc2, split = "-")[[1]]
+nom_bloc1 = ch[1]
+nom_bloc2 = ch[2]
+vec_group = c(vec_group, c(rep(nom_bloc1, length(X1)), rep(nom_bloc2, length(X2))))
+vec_nomsVar = c(vec_nomsVar, c(X1, X2))
+w = c(w, as.vector(t(matSimilaritySelect_i)))
+} # Fin for(i in 1:length(liste_matSimilaritySelect)).
+dup = duplicated(vec_nomsVar)
+vec_nomsVar = vec_nomsVar[!dup]
+vec_group = vec_group[!dup]
+nodes = data.frame(name = vec_nomsVar,
+group = vec_group)
+# gR
+relations = data.frame(from = node.X1,
+to = node.X2,
+weight = w)
+idx = (abs(w) >= cutoff)
+relations = relations[idx, , drop = FALSE]
+gR = graph.data.frame(relations,
+directed = FALSE,
+vertices = nodes)
+# On supprime les noeuds qui n'ont pas d'arêtes.
+gR = delete.vertices(gR, which(degree(gR) == 0))
+res = list(gR = gR)
+res$cutoff = cutoff
+}
+}
+return(res)
+}
+# La fonction networkVar permet de tracer un réseau pour certaines variables des
+# blocs et des variables réponses.
+networkVar <-function(liste_matSimilarity_group = liste_matSimilarity_group,
+comp = comp,
+res_block_splsda,
+cutoff_comp = 0.8,
+vec_varBlock,
+vec_varRep,
+vec_varBlockInteret = NULL,
+cutoff = 0
+)
+{
+# Nous vérifions que nous pouvons créer un réseau pour les variables des
+# blocs vec_VarBlock.
+# Nous recherchons le groupe de blocs associé à vec_Var.
+indice_group_vecVar = sapply(1:length(liste_matSimilarity_group), FUN = function(i){
+liste_matSimilarity_group_i = liste_matSimilarity_group[[i]]
+boolean = FALSE
+j = 1
+while((j <= length(liste_matSimilarity_group_i))&!boolean)
+{
+matSimilarity_group_i_j = liste_matSimilarity_group_i[[j]]
+vec_var_block1 = rownames(matSimilarity_group_i_j)
+vec_var_block2 = colnames(matSimilarity_group_i_j)
+vec_var_block1_block2 = c(vec_var_block1, vec_var_block2)
+if(any(vec_var_block1_block2%in%vec_varBlock))
+{
+boolean = TRUE
+}
+j = j + 1
+} # Fin while((j <= length(liste_matSimilarity_group_i))&!boolean).
+res = boolean
+return(res)
+})
+if(length(which(indice_group_vecVar == TRUE)) >= 2)
+{
+stop("The variables of vec_var have to belong to only one element of
+liste_res_matSimilarity_group$liste_matSimilarity_group.")
+}else{
+liste_matSimilarity = liste_matSimilarity_group[[which(indice_group_vecVar == TRUE)]]
+if(!is.null(vec_varBlockInteret))
+{
+AllVariables_vec = sapply(1:length(liste_matSimilarity), FUN = function(i){
+matSimilarity_i  = liste_matSimilarity[[i]]
+res = c(rownames(matSimilarity_i), colnames(matSimilarity_i))
+return(res)
+})
+AllVariables_vec = unique(unlist(AllVariables_vec))
+index_variableInterestNotInAllVariables_vec = vec_varBlockInteret%in%AllVariables_vec
+if(length(which(index_variableInterestNotInAllVariables_vec == FALSE)) != 0)
+{
+InterestVariableNotIn = vec_varBlockInteret[which(index_variableInterestNotInAllVariables_vec == FALSE)]
+warning(paste0("The variables of interest ", paste(InterestVariableNotIn, collapse = ","), " do not belong
+to the variables of the blocks for which the network can be created. These variables will
+be not in the network."))
+}
+vec_varBlockInteret2 = vec_varBlockInteret[which(index_variableInterestNotInAllVariables_vec == TRUE)]
+}else{
+vec_varBlockInteret2 = vec_varBlockInteret
+}
+if(!is.null(vec_varBlock) & !is.null(vec_varBlockInteret2))
+{
+varCom = intersect(vec_varBlock, vec_varBlockInteret2)
+if(length(varCom) != 0)
+{
+index_varCom = sapply(1:length(varCom), FUN = function(i){
+res = which(vec_varBlock == varCom[i])
+return(res)
+})
+vec_varBlock2 = vec_varBlock[- index_varCom]
+}else{
+vec_varBlock2 = vec_varBlock
+}
+vec_varBlock3 = c(vec_varBlock2, vec_varBlockInteret2)
+}else if(!is.null(vec_varBlock) & is.null(vec_varBlockInteret2))
+{
+vec_varBlock3 = vec_varBlock
+}else if(is.null(vec_varBlock) & !is.null(vec_varBlockInteret2))
+{
+vec_varBlock3 = vec_varBlockInteret2
+}
+vec_var = c(vec_varBlock3, vec_varRep)
+blocks_liste_matSimilarityTemp1 = sapply(1:length(liste_matSimilarity), FUN = function(i){
+noms_block1_block2_i = names(liste_matSimilarity)[i]
+ch = strsplit(noms_block1_block2_i, split = "-")[[1]]
+block1 = ch[1]
+block2 = ch[2]
+res = c(block1, block2)
+return(res)
+})
+blocks_liste_matSimilarity = unique(as.vector(blocks_liste_matSimilarityTemp1))
+indice_blocks_liste_matSimilarityTemp = sapply(1:length(blocks_liste_matSimilarity), FUN = function(i){
+res = which(res_block_splsda$names$blocks == blocks_liste_matSimilarity[i])
+return(res)
+})
+ind_Y = which(res_block_splsda$names$blocks == "Y")
+indice_blocks_liste_matSimilarity = indice_blocks_liste_matSimilarityTemp[indice_blocks_liste_matSimilarityTemp != ind_Y]
+boolean_pos_cor = TRUE
+if(length(indice_blocks_liste_matSimilarity) == 1)
+{
+}else{
+for(i in 1:length(comp))
+{
+comp_i = comp[i]
+for(j in 1:(length(indice_blocks_liste_matSimilarity) - 1))
+{
+indice_blocks_liste_matSimilarity_j = indice_blocks_liste_matSimilarity[j]
+comp_indice_blocks_liste_matSimilarity_j = res_block_splsda$variates[[indice_blocks_liste_matSimilarity_j]][, comp_i]
+for(k in (j + 1):length(indice_blocks_liste_matSimilarity))
+{
+indice_blocks_liste_matSimilarity_k = indice_blocks_liste_matSimilarity[k]
+comp_indice_blocks_liste_matSimilarity_k = res_block_splsda$variates[[indice_blocks_liste_matSimilarity_k]][, comp_i]
+cor = cor(comp_indice_blocks_liste_matSimilarity_j, comp_indice_blocks_liste_matSimilarity_k)
+boolean_pos_cor = boolean_pos_cor & cor > cutoff_comp
+} # Fin for(k in (j + 1):length(indice_blocks_vec_VarBlock)).
+} # Fin for(j in 1:(length(indice_blocks_vec_VarBlock)) - 1).
+} # Fin for(i in 1:length(comp)).
+}
+if(!boolean_pos_cor)
+{
+stop("For each pair of blocks, the ith component of the first block
+and the ith component of the second block have to be positively correlated in order
+to create a network.")
+}else{
+liste_matSimilaritySelectTemp = lapply(1:length(liste_matSimilarity), FUN = function(j){
+matSimilarity_j = liste_matSimilarity[[j]]
+indice_row_matSimilarity_j  = which(rownames(matSimilarity_j)%in%vec_var == TRUE)
+indice_col_matSimilarity_j  = which(colnames(matSimilarity_j)%in%vec_var == TRUE)
+if((length(indice_row_matSimilarity_j) != 0) &(length(indice_col_matSimilarity_j) != 0))
+{
+res = matSimilarity_j[indice_row_matSimilarity_j, indice_col_matSimilarity_j, drop = FALSE]
+}else{
+res = NA
+}
+return(res)
+})
+names(liste_matSimilaritySelectTemp) = names(liste_matSimilarity)
+indice_NA_liste_matSimilaritySelectTemp = sapply(1:length(liste_matSimilaritySelectTemp), FUN = function(i){
+liste_matSimilaritySelectTemp_i = liste_matSimilaritySelectTemp[[i]]
+if(is.matrix(liste_matSimilaritySelectTemp_i))
+{
+res = FALSE
+}else{
+if(is.na(liste_matSimilaritySelectTemp_i))
+{
+res = TRUE
+}else{
+res = FALSE
+}
+}
+return(res)
+})
+liste_matSimilaritySelect = liste_matSimilaritySelectTemp[!indice_NA_liste_matSimilaritySelectTemp]
+w = c()
+node.X1 = c()
+node.X2 = c()
+vec_group = c()
+vec_nomsVar = c()
+for(i in 1:length(liste_matSimilaritySelect))
+{
+noms_block1_block2 = names(liste_matSimilaritySelect)[i]
+matSimilaritySelect_i = liste_matSimilaritySelect[[i]]
+X1 = rownames(matSimilaritySelect_i)
+X2 = colnames(matSimilaritySelect_i)
+rep.X1 = rep(X1, each = length(X2))
+rep.X2 = rep(X2, length(X1))
+node.X1 = c(node.X1, rep.X1)
+node.X2 = c(node.X2, rep.X2)
+ch = strsplit(noms_block1_block2, split = "-")[[1]]
+nom_block1 = ch[1]
+nom_block2 = ch[2]
+vec_group = c(vec_group, c(rep(nom_block1, length(X1)), rep(nom_block2, length(X2))))
+vec_nomsVar = c(vec_nomsVar, c(X1, X2))
+w = c(w, as.vector(t(matSimilaritySelect_i)))
+} # Fin for(i in 1:length(liste_matSimilaritySelect)).
+dup = duplicated(vec_nomsVar)
+vec_nomsVar = vec_nomsVar[!dup]
+vec_group = vec_group[!dup]
+nodes = data.frame(name = vec_nomsVar,
+group = vec_group)
+# gR
+relations = data.frame(from = node.X1,
+to = node.X2,
+weight = w)
+# idx
+if(!is.null(vec_varBlock) & !is.null(vec_varBlockInteret2) & !is.null(vec_varRep))
+{
+idx = sapply(1:dim(relations)[1], FUN = function(i){
+node.X1_i = relations$from[i]
+node.X2_i = relations$to[i]
+if(node.X1_i%in%vec_varBlockInteret2 | node.X2_i%in%vec_varBlockInteret2)
+{
+res = TRUE
+}else if(node.X1_i%in%vec_varRep | node.X2_i%in%vec_varRep){
+res = TRUE
+}else{
+res = abs(w)[i] >= cutoff
+}
+return(res)
+})
+}else if(!is.null(vec_varBlock) & is.null(vec_varBlockInteret2) & !is.null(vec_varRep))
+{
+idx = sapply(1:dim(relations)[1], FUN = function(i){
+node.X1_i = relations$from[i]
+node.X2_i = relations$to[i]
+if(node.X1_i%in%vec_varRep | node.X2_i%in%vec_varRep){
+res = TRUE
+}else{
+res = abs(w)[i] >= cutoff
+}
+return(res)
+})
+}else if(is.null(vec_varBlockEtReponse) & !is.null(vec_varBlockInteret2) & !is.null(vec_varRep))
+{
+idx = rep(TRUE, dim(relations)[1])
+}
+relations = relations[idx, , drop = FALSE]
+gR = graph.data.frame(relations,
+directed = FALSE,
+vertices = nodes)
+# On supprime les noeuds qui n'ont pas d'arêtes.
+gR = delete.vertices(gR, which(degree(gR) == 0))
+res = list(gR = gR)
+res$cutoff = cutoff
+return(res)
+}
+}
+}

Mercurial > repos > ppericard > mixomics_blocksplsda

comparison Integration_block_splsda_fonc.R @ 3:0a3c83f2197a draft