Commit 82c5198d authored by Thomas Schwarzl's avatar Thomas Schwarzl

fixed downloadhandler bug #3

parent 2575207e
Pipeline #14650 passed with stage
in 1 minute and 44 seconds
## 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) %>%
......@@ -174,7 +107,7 @@ get_tooltip_for_ricbaseid <- function(x, ALLANNO) {
change_col_names <- function(x, ALLANNO) {
colnames(x) <- get_descriptive_for_ricbaseid(colnames(x, ALLANNO = ALLANNO))
colnames(x) <- get_descriptive_for_ricbaseid(colnames(x), ALLANNO = ALLANNO)
x
}
......@@ -184,7 +117,12 @@ getSplitIDs <- function(x) {
}
getDoubleHeader <- function(x, ALLANNO) {
change_col_names_double <- function(x, ALLANNO) {
colnames(x) <- get_double_header(x, ALLANNO = ALLANNO)
x
}
get_double_header <- function(x, ALLANNO) {
coln <- colnames(x)
desn <- get_descriptive_for_ricbaseid(colnames(x), ALLANNO)
ifelse(coln == desn, coln, paste0(desn, "\n", coln))
......
......@@ -625,7 +625,7 @@ server <- function(input, output, session) {
selection = "single",
extensions = "FixedColumns", #'Scroller',
rownames = FALSE,
colnames = getDoubleHeader(x, ALLANNO),
colnames = get_double_header(x, ALLANNO),
options = list(#deferRender = F,
#dom = 't',
#columnDefs = list(list(className = 'dt-center',
......@@ -685,10 +685,10 @@ server <- function(input, output, session) {
DownloadSelectedRBPTable <- reactive({
cat("test")
#cat("test")
SelectedRBPTable() %>%
dplyr::select(-Overview) %>%
change_col_names(ALLANNO = ALLANNO)
change_col_names_double(ALLANNO = ALLANNO)
})
......
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