|
| 1 | +# this file is adopted from the original generate_HIPC_submissions.R |
| 2 | + |
| 3 | +library(R.utils) # for gzip |
| 4 | + |
| 5 | +save_standardized_curations <- function(df2, base_filename) { |
| 6 | + del_cols <- c( |
| 7 | + "submission_name", "submission_date", |
| 8 | + "template_name", "short_comment", "process_note" |
| 9 | + ) |
| 10 | + df2tmp <- df2[!colnames(df2) %in% del_cols] |
| 11 | + df2tmp <- df2tmp[-1] |
| 12 | + |
| 13 | + filename <- paste0( |
| 14 | + "../data/standardized_curations/", base_filename, |
| 15 | + "-standardized_denormalized.tsv" |
| 16 | + ) |
| 17 | + write.table(df2tmp, |
| 18 | + file = filename, sep = "\t", |
| 19 | + row.names = FALSE, col.names = TRUE |
| 20 | + ) |
| 21 | + gzip(filename, |
| 22 | + destname = paste0(filename, ".gz"), overwrite = TRUE, |
| 23 | + remove = TRUE |
| 24 | + ) |
| 25 | +} |
| 26 | + |
| 27 | +save_convenience_files <- function( |
| 28 | + df2, header_rows, base_filename, |
| 29 | + exposure_type, response_type) { |
| 30 | + if (exposure_type != "VACCINE" && exposure_type != "INFECTION") { |
| 31 | + stop("Incorrect exposure type encountered") |
| 32 | + } |
| 33 | + if (response_type != "GENE" && response_type != "CELLTYPE_FREQUENCY") { |
| 34 | + stop("Incorrect response type encountered") |
| 35 | + } |
| 36 | + |
| 37 | + if (response_type == "GENE") { |
| 38 | + response_behavior_type_var <- "gene expression" |
| 39 | + } else if (response_type == "CELLTYPE_FREQUENCY") { |
| 40 | + response_behavior_type_var <- "cell-type frequency" |
| 41 | + } |
| 42 | + |
| 43 | + convenience_files <- "../data/convenience_files/" |
| 44 | + |
| 45 | + uniq_sig_row_ids <- unique(df2$sig_row_id) |
| 46 | + resp_components_annotated <- vector("list", length(uniq_sig_row_ids)) |
| 47 | + recreated_template <- vector("list", length(uniq_sig_row_ids)) |
| 48 | + |
| 49 | + for (i in seq_along(uniq_sig_row_ids)) { |
| 50 | + df2tmp <- df2[df2$sig_row_id == uniq_sig_row_ids[i], ] |
| 51 | + # Recreate a full signature in one row |
| 52 | + base_row <- df2tmp[1, ] # get first row for this uniqID |
| 53 | + |
| 54 | + response_rowname <- paste(base_row$publication_reference_id, |
| 55 | + base_row$sig_subm_id, uniq_sig_row_ids[i], |
| 56 | + sep = "_" |
| 57 | + ) |
| 58 | + response_description <- paste("PMID", base_row$publication_reference_id, |
| 59 | + response_behavior_type_var, base_row$sig_subm_id, |
| 60 | + sep = " " |
| 61 | + ) |
| 62 | + |
| 63 | + # Use the full original set of response components |
| 64 | + # rather than just those for which a valid symbol was found. |
| 65 | + base_row$response_component_original <- paste( |
| 66 | + unique(df2tmp$response_component_original), |
| 67 | + collapse = "; " |
| 68 | + ) |
| 69 | + |
| 70 | + base_row$exposure_material_id <- paste( |
| 71 | + unique(df2tmp$exposure_material_id), |
| 72 | + collapse = "; " |
| 73 | + ) |
| 74 | + base_row$tissue_type_term_id <- paste( |
| 75 | + unique(df2tmp$tissue_type_term_id), |
| 76 | + collapse = "; " |
| 77 | + ) |
| 78 | + |
| 79 | + if (response_type == "GENE") { |
| 80 | + base_row$response_component <- paste( |
| 81 | + unique(df2tmp$response_component), |
| 82 | + collapse = "; " |
| 83 | + ) |
| 84 | + resp_components_annotated[[i]] <- c( |
| 85 | + response_rowname, |
| 86 | + response_description, unique(df2tmp$response_component) |
| 87 | + ) |
| 88 | + } else if (response_type == "CELLTYPE_FREQUENCY") { |
| 89 | + full_sig <- unique(df2tmp$fully_qualified_response_component) |
| 90 | + # FIXME - only response_component is getting put back together? |
| 91 | + base_row$response_component <- paste(full_sig, collapse = "; ") |
| 92 | + base_row$response_component_id <- paste( |
| 93 | + unique(df2tmp$response_component_id), |
| 94 | + collapse = "; " |
| 95 | + ) |
| 96 | + base_row$proterm_and_extra <- paste( |
| 97 | + unique(df2tmp$proterm_and_extra), |
| 98 | + collapse = "; " |
| 99 | + ) |
| 100 | + base_row$fully_qualified_response_component <- paste( |
| 101 | + unique(df2tmp$fully_qualified_response_component), |
| 102 | + collapse = "; " |
| 103 | + ) |
| 104 | + # The pro_ontology_id values are already separated by semicolons, |
| 105 | + # so change to commas |
| 106 | + # before potentially joining two lists of pro-terms. |
| 107 | + df2tmp$pro_ontology_id <- sapply( |
| 108 | + df2tmp$pro_ontology_id, |
| 109 | + function(x) { |
| 110 | + gsub(";", ",", x) |
| 111 | + } |
| 112 | + ) |
| 113 | + base_row$pro_ontology_id <- paste( |
| 114 | + unique(df2tmp$pro_ontology_id), |
| 115 | + collapse = "; " |
| 116 | + ) |
| 117 | + |
| 118 | + resp_components_annotated[[i]] <- c( |
| 119 | + response_rowname, response_description, full_sig |
| 120 | + ) |
| 121 | + } |
| 122 | + |
| 123 | + # Reconstitute target_pathogen and exposure_material_id |
| 124 | + if (exposure_type == "VACCINE") { |
| 125 | + base_row$target_pathogen_taxonid <- paste( |
| 126 | + unique(df2tmp$target_pathogen_taxonid), |
| 127 | + collapse = "; " |
| 128 | + ) |
| 129 | + } |
| 130 | + |
| 131 | + recreated_template[[i]] <- base_row |
| 132 | + } |
| 133 | + |
| 134 | + names(resp_components_annotated) <- uniq_sig_row_ids |
| 135 | + |
| 136 | + # consolidate to a single data.frame |
| 137 | + recreated_template_df <- as.data.frame(rbindlist(recreated_template)) |
| 138 | + if (any(colnames(header_rows) != colnames(recreated_template_df))) { |
| 139 | + stop("mismatch between header rows and recreated_template_df rows") |
| 140 | + } |
| 141 | + |
| 142 | + recreated_template_df <- rbind(header_rows, recreated_template_df) |
| 143 | + |
| 144 | + # First save a complete version for use in debugging/logging |
| 145 | + del_cols <- c("submission_name", "submission_date", "template_name") |
| 146 | + recreated_template_df <- recreated_template_df[ |
| 147 | + !colnames(recreated_template_df) %in% del_cols |
| 148 | + ] |
| 149 | + |
| 150 | + # Set that first column name back to blank |
| 151 | + colnames(recreated_template_df)[1] <- "" |
| 152 | + |
| 153 | + del_cols <- c("sig_subm_id", "sig_row_id") |
| 154 | + |
| 155 | + recreated_template_df <- recreated_template_df[ |
| 156 | + !colnames(recreated_template_df) %in% del_cols |
| 157 | + ] |
| 158 | + write.table(recreated_template_df, |
| 159 | + file = paste0( |
| 160 | + convenience_files, |
| 161 | + base_filename, "-standardized_curation_template.tsv" |
| 162 | + ), |
| 163 | + sep = "\t", row.names = FALSE |
| 164 | + ) |
| 165 | + |
| 166 | + gmt_file <- paste0( |
| 167 | + convenience_files, |
| 168 | + base_filename, "-response_components.gmt.txt" |
| 169 | + ) |
| 170 | + if (file.exists(gmt_file)) file.remove(gmt_file) |
| 171 | + lapply( |
| 172 | + resp_components_annotated, |
| 173 | + function(x) { |
| 174 | + write.table(paste(x, collapse = "\t"), |
| 175 | + file = gmt_file, row.names = FALSE, col.names = FALSE, |
| 176 | + quote = FALSE, append = TRUE |
| 177 | + ) |
| 178 | + } |
| 179 | + ) |
| 180 | + message("Finished creating convenience files") |
| 181 | +} |
0 commit comments