Mercurial > repos > workflow4metabolomics > w4mconcatenate
view concatenation.R @ 0:c577f13705f2 draft default tip
planemo upload for repository https://github.com/workflow4metabolomics/tools-metabolomics commit eba1150dad55ad9eca5e93358d9f75e6b6dba2ec
author | workflow4metabolomics |
---|---|
date | Wed, 10 Jul 2024 15:20:11 +0000 |
parents | |
children |
line wrap: on
line source
if (FALSE) { rm(list = ls()) DM1 <- data.frame(data = c("5d_-kkcùf", "npèt", "5PY4(*3"), `j 785` = c(0.356426723610756, 0.801750949101246, 0.875199970420953), `y54j 68y4j6` = c(0.380152310071702, 0.535593104115636, 0.0825428101366147), `5-6 4` = c(0.0306944207412024, 0.258351312473067, 0.253659010703906), hrrrrh = c(0.334137638848017, 0.599475573145688, 0.507762246807195), `5h -` = c(0.298147485608469, 0.0763319665667417, 0.856444177031262)) DM2 <- data.frame(data = c("5d_-kkcùf", "npèt", "5PY4(*3"), `j 785` = c(0.356426723610756, 0.801750949101246, 0.875199970420953), `y54j 68y4j6` = c(0.380152310071702, 0.535593104115636, 0.0825428101366147), `5-6 4` = c(0.0306944207412024, 0.258351312473067, 0.253659010703906), hrrrrh = c(0.334137638848017, 0.599475573145688, 0.507762246807195), `5h -` = c(0.298147485608469, 0.0763319665667417, 0.856444177031262)) M1 <- data.frame(samplename = c("j 785", "y54j 68y4j6", "5-6 4", "hrrrrh", "5h -"), ABD = c(19, 24, 2, 3, "y"), E = c(9, "p0", 45, 24, 29), AAA = c("r", "bg", "il", "d", "b"), fp = c("pj", "z", "e", "r", "t"), uv = c("s", "d", "f", "s", "d")) M2 <- data.frame(samplename = c("j 785", "y54j 68y4j6", "5-6 4", "hrrrrh", "5h -"), ABD = c(19, 24, 2, 3, "y"), E = c(9, "ici", 45, 24, 29), AAA = c("r", "bg", "il", "d", "b"), fp = c("pj", "z", "e", "r", "t"), uv = c("s", "d", "f", "s", "d")) type <- "sample" concatenation <- "unique" tab1 <- "tab1" tab2 <- "tab2" choice_keep <- "oui" keep <- 0 concat(DM1, M1, DM2, M2, type, tab1, tab2, concatenation, choice_keep, keep) } ################################################################################################################# concat <- function(DM1, M1, DM2, M2, type, tab1, tab2, concatenation, choice_keep, keep) { #DM1/DM2 = data.frame containing data Matrix #M1/M2 = data.frame containing sample Metadata or variable Metadata #type = "sample" or "variable" depending on Metadata content #tab1/tab2 = Suffix for Metadata 1/2 #concatenation = type of concatenation #choice_keep = choice of keeping columns with the same no or keeping just one #keep = keep the column in M1 or M2 #returns the concatenated metadata and the two Data Matrix identifiers_1 <- colnames(M1)[1] identifiers_2 <- colnames(M2)[1] err.stock <- NULL #Concatenation------------------------------------------------------------------ #If Metadatas is Sample_Metadata we transpose if (type == "sample") { rownames(DM1) <- DM1[, 1] corner_DM1 <- colnames(DM1)[1] DM1 <- DM1[, -1, drop = FALSE] DM1 <- t(DM1) DM1 <- data.frame(sample = row.names(DM1), DM1, check.names = FALSE) rownames(DM1) <- NULL rownames(DM2) <- DM2[, 1] corner_DM2 <- colnames(DM2)[1] DM2 <- DM2[, -1, drop = FALSE] DM2 <- t(DM2) DM2 <- data.frame(sample = row.names(DM2), DM2, check.names = FALSE) rownames(DM2) <- NULL } #Add order of sample and Sort by order M1$order1 <- seq(1, nrow(M1)) M2$order2 <- seq(nrow(M1) + 1, nrow(M2) + nrow(M1)) M1_bf <- M1[order(M1[, 1]), ] M2_bf <- M2[order(M2[, 1]), ] #Check the variables in common and extract them. same <- check_features(M1_bf, M2_bf) same <- same[- which(same == identifiers_1)] #Check that shared variables have the same values. #If not, they are renamed or deleted according to the parameters chosen by the user. result2 <- compare_same_columns(M1_bf, M2_bf, same, choice_keep, keep, tab1, tab2) M1 <- result2$M1 M2 <- result2$M2 #Unique-------------------------------------------------------------------------- if (concatenation == "unique") { #Table match check #We verify that the individuals are all the same err.stock <- match2_bis(M1, M2, type) check_err(err.stock) M_merge <- merge(M1, M2, by = 1) } #Intersection-------------------------------------------------------------------- if (concatenation == "intersection") { #select individuals in common sample_common <- intersect(M1[, 1], M2[, 1]) #if the list of individuals in common is null, an error message is sent if (length(sample_common) == 0) { err.stock <- c(err.stock, "\nThere are no individuals in common \n") check_err(err.stock) } #if the list of individuals in common is less than 5, then a Warning message is sent if (length(sample_common) < 5) { cat("\nWarning: Less than 5 individuals in common\n") } M_merge <- merge(M1, M2, by = 1) } #Union -------------------------------------------------------------------------- if (concatenation == "union") { #select common ids id_common <- intersect(M1[, 1], M2[, 1]) if (is.null(id_common)) { cat("\nT Warning : there are no individuals in common\n") } M2_common <- M2[M2[, 1] %in% id_common, ] #Store rows with individuals belonging only to M2 M2_specifique <- M2[! M2[, 1] %in% id_common, ] #Merge the two tables only with the samples not in common M_merge <- bind_rows(M1, M2_specifique) col_names <- colnames(M2_common) col_names <- col_names[- which(col_names == identifiers_2)] feature_common <- check_features(M_merge, M2_bf) #Check if M_merge and M2_bf have columns in common. If so, complete the table with the values not taken. if (!is.null(feature_common)) { identifiers_3 <- M2_specifique[, 1] #We select the value in M2_bf, the M2 table before undergoing any changes, then insert it in the M_merge table. for (feature in feature_common) { for (id in identifiers_3) { index_row <- which(M2_bf[, 1] == id) index_col <- which(colnames(M2_bf) == feature) new_value <- M2_bf[index_row, index_col] index_row <- which(M_merge[, 1] == id) index_col <- which(colnames(M_merge) == feature) M_merge[index_row, index_col] <- new_value } } } #Fill in the table with common values for (col in col_names) { for (id in id_common) { index_row <- which(M2_common[, 1] == id) index_col <- which(colnames(M2_common) == col) new_value <- M2_common[index_row, index_col] index_row <- which(M_merge[, 1] == id) index_col <- which(colnames(M_merge) == col) M_merge[index_row, index_col] <- new_value } } } M_merge_sort <- M_merge[order(M_merge$order1, M_merge$order2), ] M_merge_sort <- M_merge_sort[, - which(colnames(M_merge_sort) == "order1")] M_merge_sort <- M_merge_sort[, - which(colnames(M_merge_sort) == "order2")] #DataMatrix --------------------------------------------------------------------- colnames_1 <- colnames(DM1) colnames_2 <- colnames(DM2) #Unique ------------------------------------------------------------------------- if (concatenation == "unique") { if (type == "sample") { rownames(DM1) <- DM1[, 1] DM1 <- DM1[, -1] DM1 <- t(DM1) DM1 <- data.frame(sample = row.names(DM1), DM1, check.names = FALSE) colnames(DM1)[1] <- corner_DM1 rownames(DM1) <- NULL rownames(DM2) <- DM2[, 1] DM2 <- DM2[, -1, drop = FALSE] DM2 <- t(DM2) DM2 <- data.frame(sample = row.names(DM2), DM2, check.names = FALSE) colnames(DM2)[1] <- corner_DM2 rownames(DM2) <- NULL } result <- list(M_merge_sort = M_merge_sort, DM1 = DM1, DM2 = DM2) return(result) } #Intersection-------------------------------------------------------------------- if (concatenation == "intersection") { id_in_common <- intersect(DM1[, 1], DM2[, 1]) DM1_filter <- subset(DM1, DM1[, 1] %in% id_in_common) DM2_filter <- subset(DM2, DM2[, 1] %in% id_in_common) if (type == "sample") { rownames(DM1_filter) <- DM1_filter[, 1] DM1_filter <- DM1_filter[, -1] DM1_filter <- t(DM1_filter) DM1_filter <- data.frame(sample = row.names(DM1_filter), DM1_filter, check.names = FALSE) colnames(DM1_filter)[1] <- corner_DM1 rownames(DM1_filter) <- NULL rownames(DM2_filter) <- DM2_filter[, 1] DM2_filter <- DM2_filter[, -1, drop = FALSE] DM2_filter <- t(DM2_filter) DM2_filter <- data.frame(sample = row.names(DM2_filter), DM2_filter, check.names = FALSE) colnames(DM2_filter)[1] <- corner_DM2 rownames(DM2_filter) <- NULL } result <- list(M_merge_sort = M_merge_sort, DM1 = DM1_filter, DM2 = DM2_filter) return(result) } #Union -------------------------------------------------------------------------- if (concatenation == "union") { common_individuals <- intersect(DM1[, 1], DM2[, 1]) common_columns <- intersect(colnames_1, colnames_2) #check whether there are individuals or variables in common if (is.null(common_individuals) || is.null(common_columns)) { comparison_result <- FALSE #If the individuals in common take the same values for all variables, then comparison_result=TRUE } else { DM1_common <- subset(DM1, DM1[, 1] %in% common_individuals) DM2_common <- subset(DM2, DM2[, 1] %in% common_individuals) DM1_common <- DM1_common[, common_columns, drop = FALSE] DM2_common <- DM2_common[, common_columns, drop = FALSE] for (col in common_columns) { comparison_result <- identical(DM1_common$col, DM2_common$col) } } if (comparison_result) { DM1$order1 <- seq(1, nrow(DM1)) DM2$order2 <- seq(nrow(DM1) + 1, nrow(DM2) + nrow(DM1)) DM1_sort <- DM1[order(DM1[, 1]), ] DM2_sort <- DM2[order(DM2[, 1]), ] id_in_common <- intersect(DM1[, 1], DM2[, 1]) DM1_filter <- subset(DM1, DM1[, 1] %in% id_in_common) DM2_filter <- subset(DM2, DM2[, 1] %in% id_in_common) different_DM2 <- colnames_2[! colnames_2 %in% colnames_1] DM2_specifique <- DM2[! DM2[, 1] %in% id_in_common, ] #Merge the two tables only with the samples not in common DM1_merge <- bind_rows(DM1, DM2_specifique) #Deletion of columns present only in DM2 DM1_merge <- DM1_merge[, ! names(DM1_merge) %in% different_DM2] different_DM1 <- colnames_1[! colnames_1 %in% colnames_2] DM1_specifique <- DM1[! DM1[, 1] %in% id_in_common, ] #Merge the two tables only with the samples not in common DM2_merge <- bind_rows(DM2, DM1_specifique) #Deletion of columns present only in DM2 DM2_merge <- DM2_merge[, ! names(DM2_merge) %in% different_DM1] #DM2_merge DM1_merge_sort <- DM1_merge[order(DM1_merge$order1, DM1_merge$order2), ] DM1_merge_sort <- DM1_merge_sort[, - which(colnames(DM1_merge_sort) == "order1")] DM1_merge_sort <- DM1_merge_sort[, - which(colnames(DM1_merge_sort) == "order2")] DM2_merge_sort <- DM2_merge[order(DM2_merge$order1, DM2_merge$order2), ] DM2_merge_sort <- DM2_merge_sort[, - which(colnames(DM2_merge_sort) == "order1")] DM2_merge_sort <- DM2_merge_sort[, - which(colnames(DM2_merge_sort) == "order2")] if (type == "sample") { rownames(DM1_merge_sort) <- DM1_merge_sort[, 1] DM1_merge_sort <- DM1_merge_sort[, -1] DM1_merge_sort <- t(DM1_merge_sort) DM1_merge_sort <- data.frame(sample = row.names(DM1_merge_sort), DM1_merge_sort, check.names = FALSE) colnames(DM1_merge_sort)[1] <- corner_DM1 rownames(DM1_merge_sort) <- NULL rownames(DM2_merge_sort) <- DM2_merge_sort[, 1] DM2_merge_sort <- DM2_merge_sort[, -1, drop = FALSE] DM2_merge_sort <- t(DM2_merge_sort) DM2_merge_sort <- data.frame(sample = row.names(DM2_merge_sort), DM2_merge_sort, check.names = FALSE) colnames(DM2_merge_sort)[1] <- corner_DM2 rownames(DM2_merge_sort) <- NULL } result <- list(M_merge_sort = M_merge_sort, DM1 = DM1_merge_sort, DM2 = DM2_merge_sort) return(result) } else { #selects line ids that are in DM2 and not in DM1 id_diff_1 <- setdiff(DM2[, 1], DM1[, 1]) #we store them in a dataframe row_add_1 <- data.frame(id = id_diff_1) #renames columns with their names in DM1 colnames(row_add_1)[1] <- colnames(DM1)[1] #Merge DM1_add <- bind_rows(DM1, row_add_1) id_diff_2 <- setdiff(DM1[, 1], DM2[, 1]) row_add_2 <- data.frame(id = id_diff_2) colnames(row_add_2)[1] <- colnames(DM2)[1] DM2_add <- bind_rows(DM2, row_add_2) if (type == "sample") { rownames(DM1_add) <- DM1_add[, 1] DM1_add <- DM1_add[, -1] DM1_add <- t(DM1_add) DM1_add <- data.frame(sample = row.names(DM1_add), DM1_add, check.names = FALSE) colnames(DM1_add)[1] <- corner_DM1 rownames(DM1_add) <- NULL rownames(DM2_add) <- DM2_add[, 1] DM2_add <- DM2_add[, -1, drop = FALSE] DM2_add <- t(DM2_add) DM2_add <- data.frame(sample = row.names(DM2_add), DM2_add, check.names = FALSE) colnames(DM2_add)[1] <- corner_DM2 rownames(DM2_add) <- NULL } result <- list(M_merge_sort = M_merge_sort, DM1 = DM1_add, DM2 = DM2_add) return(result) } } }