Commit 2575207e authored by Thomas Schwarzl's avatar Thomas Schwarzl

file cleanup

parent 2afaa630
......@@ -174,7 +174,7 @@ get_tooltip_for_ricbaseid <- function(x, ALLANNO) {
change_col_names <- function(x, ALLANNO) {
colnames(x) <- get_descriptive_for_ricbaseid(colnames(x))
colnames(x) <- get_descriptive_for_ricbaseid(colnames(x, ALLANNO = ALLANNO))
x
}
......
......@@ -24,7 +24,6 @@ load("www/data/ANNO_STUDIES.Rda")
load("www/data/RIC_STUDIES.Rda")
load("www/data/COMPILED_TABLE.Rda")
source("annotationFunctions.R")
source("server_download.R")
source("server_studies_table.R")
source("server_anno_table.R")
source("server_plots.R")
......@@ -718,7 +717,18 @@ server <- function(input, output, session) {
)
# downloader
output$downloadFilterTSV <- downloadHandler_FilterTSV
output$downloadFilterTSV <- downloadHandler(
filename = function() {
paste("RICbase-filter-", Sys.Date(), ".tsv", sep="")
},
content = function(file) {
if(!is.null(filter$table) && nrow(filter$table) > 0) {
write.table(filter$table, file, quote = "", row.names = F, sep = "\t")
}
}
)
observeEvent(input$btnSelectAll, {
......
downloadHandler_RBPTableTSV <- downloadHandler(
filename = function() {
paste("RICbase-", Sys.Date(), ".tsv", sep="")
},
content = function(file) {
write.table(SelectedRBPTable(), file, row.names = F, sep = "\t")
}
)
downloadHandler_FilterTSV <- downloadHandler(
filename = function() {
paste("RICbase-filter-", Sys.Date(), ".tsv", sep="")
},
content = function(file) {
if(!is.null(filter$table) && nrow(filter$table) > 0) {
write.table(filter$table, file, quote = "", row.names = F, sep = "\t")
}
}
)
downloadHandler_RBPTableCSV <- downloadHandler(
filename = function() {
paste("RICbase-", Sys.Date(), ".csv", sep="")
},
content = function(file) {
write.csv(SelectedRBPTable(), file, row.names = F)
}
)
## Functions for transformation
# Character string transformation for visualisation
# Known RBP or known RIC
knownTransform <- function(knownRBP, anyRIC) {
unlist(
lapply((as.numeric(knownRBP) * 10 + as.numeric(anyRIC)),
function(x) {
if(x == 11) {
return("known & RIC")
} else if (x == 10) {
return("known")
} else if (x == 1) {
return("RIC")
} else {
return("unknown")
}
})
) %>% factor(levels=c("known & RIC", "known", "RIC", "unknown"))
}
## Enzymes
enzymeTransform <- function(Enzyme, Metabolic.Enzyme) {
unlist(
lapply((as.numeric(Enzyme) * 10 + as.numeric(Metabolic.Enzyme)),
function(x) {
if(x == 11) {
return("metabolic enzyme")
} else if (x == 10) {
return("enzyme")
} else if (x == 1) {
return("metabolic enzyme")
} else {
return("other")
}
})
) %>% factor(levels=c("other", "enzyme", "metabolic enzyme"))
}
# gets setting for one singular organism
getSetting <- function(CONFIG, input_organism, input_parameter) {
if(!is.character(input_organism) || length(input_organism) > 1) {
stop("input_organism has to be a single value")
}
selectedParameter <- CONFIG %>% filter(organism == input_organism) %>% filter(parameter %in% input_parameter) %>% .[["value"]]
if( length(selectedParameter) > 0 && length(selectedParameter) <= length(input_parameter)) {
return(all(selectedParameter))
} else if ( length(selectedParameter) == 0) {
return(F)
} else {
stop(paste0("Parameter '", parameter, "' has more than one entry in CONFIG for organism '", input_organism, "'"))
}
}
nonempty <- function(x) {
x <- x[!is.na(x)]
x <- x[x != ""]
x
}
filterStudies <- function(RIC_STUDIES, selected_organism) {
RIC_STUDIES %>%
filter(Organism %in% selected_organism) %>%
filter(Integrated & Active) %>%
.[["RICBASEID"]] %>%
sort %>% unique
}
filterStudiesForSupersets <- function(RIC_STUDIES, selected_organism, selected_RIC) {
RIC_STUDIES %>%
filter(Organism %in% selected_organism) %>%
filter(!RICBASEID %in% selected_RIC) %>%
filter(Superset) %>%
.[["RICBASEID"]] %>%
sort %>% unique
}
getAllOrganismsForSuperset <- function(RIC_STUDIES) {
RIC_STUDIES %>% filter(Active & Integrated & Superset) %>% .[["Organism"]] %>% sort %>% unique
}
# Create a list for the selection menu
# where Human (Hs) is the first entry
getOrganismSelectionList <- function(RIC_STUDIES, first_entry = "Hs") {
x <- getAllOrganismsForSuperset(RIC_STUDIES)
x <- c(first_entry, x[-which(x == first_entry)])
x
}
addAnyColumns <- function(RICTABLE, selected_organism, RIC_STUDIES, selected_RIC = c()) {
all_foreign_sets <- c()
for(i in getAllOrganismsForSuperset(RIC_STUDIES)) {
any_column_name = paste0("any_", i)
columns_for_this_organism = filterStudiesForSupersets(RIC_STUDIES, i, selected_RIC)
# exclude non existing in table
columns_for_this_organism <- columns_for_this_organism[ columns_for_this_organism %in% colnames(RICTABLE)]
RICTABLE <- RICTABLE %>%
mutate(!!any_column_name := ( RICTABLE %>% dplyr::select(!!columns_for_this_organism) %>% apply(1, function(x) any(x, na.rm = T)) ) )
#!!rlang::sym())
all_foreign_sets <- c(all_foreign_sets, any_column_name)
}
RICTABLE <- RICTABLE %>%
mutate(any_allOrganisms = ( RICTABLE %>% dplyr::select(!!all_foreign_sets) %>% apply(1, function(x) any(x, na.rm = T)) ) )
}
addSumColumns <- function(RICTABLE, selected_organism, RIC_STUDIES, selected_RIC = c()) {
all_foreign_sets <- c()
for(i in getAllOrganismsForSuperset(RIC_STUDIES)) {
sum_column_name = paste0("sum_", i)
columns_for_this_organism = filterStudiesForSupersets(RIC_STUDIES, i, selected_RIC)
# exclude non existing in table
columns_for_this_organism <- columns_for_this_organism[ columns_for_this_organism %in% colnames(RICTABLE)]
RICTABLE <- RICTABLE %>%
mutate(!!sum_column_name := ( RICTABLE %>% dplyr::select(!!columns_for_this_organism) %>% apply(1, function(x) sum(x, na.rm = T)) ) )
#!!rlang::sym())
all_foreign_sets <- c(all_foreign_sets, sum_column_name)
}
RICTABLE <- RICTABLE %>%
mutate(sum_allOrganisms = ( RICTABLE %>% dplyr::select(!!all_foreign_sets) %>% apply(1, function(x) sum(x, na.rm = T)) ) )
}
getDescriptiveTable <- function(x) {
x <- x %>% mutate_all(list(
~if(is.logical(.)) {
ifelse(., "YES", "no")
} else {
.
}
))
x <- change_col_names(x)
x
}
get_descriptive_for_ricbaseid <- function(x, ALLANNO) {
data.frame(base = x, stringsAsFactors = F) %>%
left_join(y = ALLANNO, by = c("base" = "RICBASEID")) %>%
mutate(DescriptiveID = ifelse(is.na(DescriptiveID), base, DescriptiveID)) %>%
.[["DescriptiveID"]]
}
get_tooltip_for_ricbaseid <- function(x, ALLANNO) {
data.frame(base = x, stringsAsFactors = F) %>%
left_join(y = ALLANNO, by = c("base" = "RICBASEID")) %>%
mutate(tooltip = ifelse(is.na(Reference), Description, Reference)) %>%
mutate(tooltip = ifelse(!is.na(tooltip), tooltip, "")) %>%
.[["tooltip"]]
}
change_col_names <- function(x, ALLANNO) {
colnames(x) <- get_descriptive_for_ricbaseid(x = colnames(x), ALLANNO = ALLANNO)
x
}
getSplitIDs <- function(x) {
x %>% strsplit(split = "\\|") %>% unlist %>% sort %>% unique
}
getDoubleHeader <- function(x, ALLANNO) {
coln <- colnames(x)
desn <- get_descriptive_for_ricbaseid(colnames(x), ALLANNO)
ifelse(coln == desn, coln, paste0(desn, "\n", coln))
}
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment