diff --git a/20170719_JSON_UROPA_query.R b/20170719_JSON_UROPA_query.R new file mode 100644 index 0000000..e225705 --- /dev/null +++ b/20170719_JSON_UROPA_query.R @@ -0,0 +1,349 @@ +#================================ +# +# Initialization +# +#================================ + +# Loading in libraries +library(shiny) +library(shinydashboard) +library(shinyBS) +library(data.table) +library(readr) + +##### define popover for radiobuttons in the sidebar +radioTooltip <- function(id, choice, title, placement = "bottom", trigger = "hover", options = NULL){ + + options = shinyBS:::buildTooltipOrPopoverOptionsList(title, placement, trigger, options) + options = paste0("{'", paste(names(options), options, sep = "': '", collapse = "', '"), "'}") + bsTag <- shiny::tags$script(shiny::HTML(paste0(" + $(document).ready(function() { + setTimeout(function() { + $('input', $('#", id, "')).each(function(){ + if(this.getAttribute('value') == '", choice, "') { + opts = $.extend(", options, ", {html: true}); + $(this.parentElement).tooltip('destroy'); + $(this.parentElement).tooltip(opts); + } + }) + }, 500) + }); + "))) + htmltools::attachDependencies(bsTag, shinyBS:::shinyBSDep) +} +########### end of define popover for radiobuttons in the sidebar + +# Defining the parameters +startpoint <- 1 + +# User-defined functions +fileInput2 <- function(inputId, label = NULL, labelIcon = NULL, multiple = FALSE, + accept = NULL, width = NULL, progress = TRUE, ...) { + # add class fileinput_2 defined in UI to hide the inputTag + inputTag <- tags$input(id = inputId, name = inputId, type = "file", + class = "fileinput_2") + if (multiple) + inputTag$attribs$multiple <- "multiple" + if (length(accept) > 0) + inputTag$attribs$accept <- paste(accept, collapse = ",") + + div(..., style = if (!is.null(width)) paste0("width: ", validateCssUnit(width), ";"), + inputTag, + # label customized with an action button + tags$label(`for` = inputId, div(icon(labelIcon), label, + class = "btn btn-default action-button")), + # optionally display a progress bar + if(progress) + tags$div(id = paste(inputId, "_progress", sep = ""), + class = "progress shiny-file-input-progress", + tags$div(class = "progress-bar") + ) + ) +} + + + +# A print function to create the configuration file format +JU_resformat <- function (var1, var2, var3, var4, var5, var6, var7, var8, distance_up, distance_down) { + + strprintline <- "{" + # var1 + if (!is.null(var1)) { + if (length(var1) == 1) { + strprintline <- paste (strprintline, "\"feature\"",":\"", var1,"\", ", sep = "") + } else { + var1_conc <- paste ("[\"", var1[1], "\"", sep = "") + for (i in 2:length(var1)) { + var1_i <- var1[i] + var1_conc <- paste (var1_conc, paste (", \"", var1_i, "\"", sep = "")) + } + var1_conc <- paste (var1_conc, "]", sep = "") + strprintline <- paste (strprintline, "\"feature\"",":\"", var1_conc,"\", ", sep = "") + } + } + strprintline <- paste (strprintline, "\"feature.anchor\"",":\"", var2,"\", ", sep = "") + + # var3 + if (!is.null(var3)) { + if (length(var3) == 1) { + strprintline <- paste (strprintline, "\"show.attribute\":\"", var3, "\", ", sep = "") + } else { + var3_conc <- paste ("[\"", var3[1], "\"", sep = "") + for (i in 2:length(var3)) { + var3_i <- var3[i] + var3_conc <- paste (var3_conc, paste (", \"", var3_i, "\"", sep = "")) + } + var3_conc <- paste (var3_conc, "]", sep = "") + strprintline <- paste (strprintline, "\"feature\"",":\"", var3_conc,"\", ", sep = "") + } + } + strprintline <- paste (strprintline, "\"internals\"",":\"", var4,"\", ", sep = "") + + # var5 + if (!is.null(var5)) { + if (length(var5) == 1) { + strprintline <- paste(strprintline, "\"filter.attribute\"",":\"", var5,"\", ", sep = "") + } else { + var5_conc <- paste ("[\"", var5[1], "\"", sep = "") + for (i in 2:length(var5)) { + var5_i <- var1[i] + var5_conc <- paste (var5_conc, paste (", \"", var5_i, "\"", sep = "")) + } + var5_conc <- paste (var5_conc, "]", sep = "") + strprintline <- paste (strprintline, "\"feature\"",":\"", var5_conc,"\", ", sep = "") + } + } + + # var6 + if (!is.null(var6)) { + if (length(var6) == 1) { + strprintline <- strprintline <- paste(strprintline, "\"attribute.value\"",":\"", var6, "\", ", sep = "") + } else { + var6_conc <- paste ("[\"", var6[1], "\"", sep = "") + for (i in 2:length(var6)) { + var6_i <- var6[i] + var6_conc <- paste (var6_conc, paste (", \"", var6_i, "\"", sep = "")) + } + var6_conc <- paste (var6_conc, "]", sep = "") + strprintline <- paste (strprintline, "\"feature\"",":\"", var6_conc,"\", ", sep = "") + } + } + strprintline <- paste (strprintline, "\"strand\"",":\"", var7,"\", ", sep = "") + strprintline <- paste (strprintline, "\"direction\"",":\"", var8,"\", ", sep = "") + strprintline <- paste (strprintline, "\"distance\"",":","[",distance_up,", ",distance_down,"]", sep = "") + + strprintline <- paste (strprintline, "}", sep = "") + + return (strprintline) +} + +# Creating modules + +# First module +#-------------------------------- + +# A module to read the inputs +# UI-part +PrintTablesUI <- function(id, strcol3_list, strcol9_list, label = "ui1UI") { + + ns <- NS(id) + shinyUI(fluidRow( + + box(background = "light-blue", div(img(src="logo_MPIE_gr.png")),title= paste ("query ", gsub("c", "", id), sep = ""),width=2), + box(background = "light-blue",title= "JSON_UROPA_queries", + + column(width = 6, + + sliderInput(ns("distance_up"), "distance_uptream", min = -100000, max = 100000,step=100, value = c(500)), + bsTooltip(ns("distance_up"), "TEST IS THIS WORK?", "right", trigger = "hover"), + #bsTooltip("distance_up", title = "use keyboard arrows",placement = "left", trigger = "hover"), + selectInput(ns("var8"),"direction",choices=c("any_direction","upstream","downstream")), + selectInput(ns("var4"),"internals",choices=c("none","center","any")), + selectInput(ns("var1"), "feature",as.list(strcol3_list),multiple = T), + selectInput(ns("var6"), "attribute.value",as.list(strcol9_list),multiple = T) + + ), + + column(width = 6, + + sliderInput(ns("distance_down"), "distance_downstream",min = -100000, max = 100000,step=100,value = c(500)), + selectInput(ns("var7"),"strand",choices=c("+","-","both")), + selectInput(ns("var2"),"feature.anchor",choices=c("start","center","end")), + selectInput(ns("var3"), "show.attribute",as.list(strcol9_list),multiple = T), + selectInput(ns("var5"), "filter.attribute",as.list(strcol9_list),multiple = T) + ) + ) + )) +} + +# Server-part +PrintTables <- function(input, output, session) { + + strinputvars <- list( + var1_ret <- reactive({input$var1}), + var2_ret <- reactive({input$var2}), + var2_ret <- reactive({input$var3}), + var2_ret <- reactive({input$var4}), + var2_ret <- reactive({input$var5}), + var2_ret <- reactive({input$var6}), + var2_ret <- reactive({input$var7}), + var2_ret <- reactive({input$var8}), + distanceUp_ret <- reactive({input$distance_up}), + distanceDown_ret <- reactive({input$distance_down}) + ) + return(strinputvars) +} + +#================================ +# +# Program code +# +#================================ + +# We'll save it in a variable `ui` so that we can preview it in the console +ui <- dashboardPage( + + dashboardHeader(title=div(img(src="site.logo.jpg"))), + dashboardSidebar( + + fluidRow( + column(width=12, + radioButtons("gtf_files" ,"Select tab-separated gtf file",choices= + c("human_gencode.v22.gene"="gencode.v24.annotation.gtf", + "mouse_gencode.vM5.genes"="gencode.vM5.genes.gtf", + "other"="user_defined.gtf")), + + actionButton("gftfile_upload", "Upload file"), + fileInput("file1", "Upload bed File")), + radioTooltip(id = "gtf_files", choice = "user_defined.gtf", + title = "Please rename your gtf file as: user_defined.gtf", trigger = "hover"), + column(width=12, + selectInput("priority"," prioritized query",choices=c("FALSE","TRUE"))), + column(width = 12, + numericInput("NrQuery","Enter number of queries", 1, min=1, max=NaN), + actionButton("addqueries", "Add queries")) + ) + #title=div(img(src="logo_MPIE_gr.png")) + ), + + dashboardBody( + # div(img(src="logo_MPIE_gr.png")), + ##define slider color + tags$style(HTML(".irs-bar {width: 100%; height: 10px; background: black; border-top: 1px solid black; border-bottom: 1px solid black;}")), + tags$style(HTML(".irs-bar-edge {background: black; border: 1px solid black; height:10px; border-radius: 10px 10px 10px 10px;}")), + tags$style(HTML(".irs-line {border: 1px solid black; height: 10px;}")), + tags$style(HTML(".irs-grid-text {font-family: 'arial'; color: black}")), + tags$style(HTML(".irs-max {font-family: 'arial'; color: black;}")), + tags$style(HTML(".irs-min {font-family: 'arial'; color: black;}")), + tags$style(HTML(".irs-single {color:black; background:#6666ff;}")), + + uiOutput("testSlider"), + #### end of define slider color + + div(id = "ui_zero"), + div(id = "ui_zero2"), + actionButton("printres", "Save JSON format file",icon("paper-plane"), + style="color: #fff; background-color: #337ab7; border-color: #2e6da4") + ) + +) +server <- (function(input, output, session) { + options(shiny.maxRequestSize=30*1024*1024^2) + output$textORdate <- renderUI({ + }) + +# read GTF file + strcol3_list <- "test" + strcol9_list <- "test" + observeEvent(input$gftfile_upload, { + #fread [,3][,9] library(data.table)fother + dfgtffile <- as.data.frame(fread(input$gtf_files, sep = "\t", select = c(3, 9))) + + strcol3_list <<- as.character(unique(sort(dfgtffile[,1]))) + write.table (length(unique(dfgtffile[,2])), "test_0.txt", quote = F) + #dfgtffile <- read.table("user_defined_SMALL.gtf", sep = "\t") + + df_V3 <- gsub(pattern="; ",replacement="\t", unique(dfgtffile[,2]), fixed=TRUE) + df_V3 <- gsub(pattern=" ",replacement="\t", df_V3, fixed=TRUE) + + n <- length(df_V3) + limit <- 10000 + lowerlimit <- 1 + keys <- "testval" + withProgress(message = 'Creating lists...', value = 0, { + for (upperlimit in seq(limit, n, limit)) { + df_V3_temp <- do.call(rbind.data.frame,strsplit(df_V3[lowerlimit:upperlimit],split="\t")) + dfgtffile_ss1 <- df_V3_temp[,seq(1, ncol(df_V3_temp), 2)] + keys <- unique(c(keys, as.vector(as.matrix(dfgtffile_ss1)))) + lowerlimit <- lowerlimit + upperlimit + + incProgress(limit/n, detail = paste(upperlimit, " lines read.")) + } + }) + + +# write.table (dim(dfgtffile), "test_1.txt", quote = F) +# df_V3 <- do.call(rbind.data.frame,strsplit(df_V3,split="\t")) +# output <- cbind(df[,c(1:2)], df_V3, df[,c(4:ncol(df))]) +# write.table (dim(dfgtffile), "test_2.txt", quote = F) +# dfgtffile <- read.table(textConnection(gsub(";", "\t", readLines(input$gtf_files))), fill = T) + +# dfgtffile_ss1 <- dfgtffile[,seq(9, ncol(dfgtffile), 2)] +# dfgtffile_ss2 <- dfgtffile[,seq(10, ncol(dfgtffile), 2)] +# strcol9_list_B <- unique(as.vector(as.matrix(dfgtffile_ss2))) +# write.table (dim(dfgtffile), "test_2.txt", quote = F) +# strcol9_list <<- unique(as.vector(as.matrix(dfgtffile_ss1))) + + write.table (dim(dfgtffile), "test_3.txt", quote = F) + dfgtffile_ss1 <- df_V3[,seq(1, ncol(dfgtffile), 2)] +# strcol9_list <<- unique(as.vector(as.matrix(dfgtffile_ss1))) + strcol9_list <<- keys + + +# + strcol9_list <<- strcol9_list_A + write.table (dim(dfgtffile), "test_3.txt", quote = F) + }) + + # Print the tables (first module) + observeEvent(input$addqueries, { + for (counter in startpoint:input$NrQuery) { + ID <- paste0("c", counter) + insertUI("#ui_zero", "beforeEnd", PrintTablesUI(ID, strcol3_list, strcol9_list)) + module_iterres <- callModule(PrintTables, ID) + assign (paste("var_", ID, sep = ""), value = module_iterres, pos = 1) + observeEvent(input$printres, { + outputID <- "example" + insertUI("#ui_zero2", "beforeEnd", uiOutput(outputID)) + uiOutput(outputID) + resline <- paste("{","\"", "queries", "\"", ":[", sep = "") + output$example <- renderUI({ + for (counter in startpoint:input$NrQuery) { + ID <- paste0("c", counter) + fieldname <- eval(parse(text = paste("var_", ID, sep = ""))) + if (counter == startpoint) { + resline <- paste (resline, JU_resformat(fieldname[[1]](), fieldname[[2]](), fieldname[[3]](), fieldname[[4]](), fieldname[[5]](), fieldname[[6]](), fieldname[[7]](), fieldname[[8]](), fieldname[[9]](), fieldname[[10]]()), sep = "") + } else { + resline <- paste (resline, ",\n", JU_resformat(fieldname[[1]](), fieldname[[2]](), fieldname[[3]](), fieldname[[4]](), fieldname[[5]](), fieldname[[6]](), fieldname[[7]](), fieldname[[8]](), fieldname[[9]](), fieldname[[10]]()), sep = "") + } + } + resline <- paste (resline, "]", + ",\n\"priority\": \"", input$priority, "\",\n", + "\"gtf\": \"", input$gtf_files, "\",\n", + # toprint the path + "\"bed\": \"", paste(input$file1$datapath, "\\", input$file1$name, sep = ""), "\"", sep = "", + #to print the file name only + # "\"bed\": \"", input$file1$name, "\"", sep = "", + "}") + + write.table (resline, "configuration_file.txt", quote = F, col.names = F, row.names = F) + }) + }) + } + }) +}) + + +# Running the program +shinyApp(ui = ui, server = server) +