From dda8eca488c5ea1c609c34d2d524c7bbd437cc3e Mon Sep 17 00:00:00 2001 From: fazelzadeh Date: Fri, 7 Jul 2017 14:03:10 +0200 Subject: [PATCH] Add files via upload --- JASON_UROPA_queries_V9.R | 210 +++++++++++++++++++++++++++++++++++++++ 1 file changed, 210 insertions(+) create mode 100644 JASON_UROPA_queries_V9.R diff --git a/JASON_UROPA_queries_V9.R b/JASON_UROPA_queries_V9.R new file mode 100644 index 0000000..ca7367e --- /dev/null +++ b/JASON_UROPA_queries_V9.R @@ -0,0 +1,210 @@ + + + +#================================ +# +# Initialization +# +#================================ + +# Loading in libraries +library(shiny) +library(shinydashboard) +#library(shinyBS) + +# Defining the parameters +startpoint <- 1 + +# User-defined functions + +JU_resformat <- function (var1, var2, var3, var4, var5, var6, var7, var8, distance_up, distance_down) { + var3_read <- gsub("[[:space:]]", "", unlist(strsplit(var3, ";"))) + if (length (var3_read) <= 1) { + concatline <- paste("{","\"feature\"",":\"", var1,"\", ", + "\"feature.anchor\"",":\"", var2,"\", ", + "\"show.attribute\":\"", var3,"\", ", + "\"internals\"",":\"", var4,"\", ", + "\"attribute.value\"",":\"", var5,"\", ", + "\"strand\"",":\"",var6,"\", ", + "\"attribute.value\"",":\"", var7,"\", ", + "\"direction\"",":\"", var8,"\", ", + "\"distance\"",":","[",distance_up,", ",distance_down,"]","}", sep = "" + ) + } else { + var3_conc <- paste ("[\"", var3_read[1], "\"", sep = "") + for (i in 2:length(var3_read)) { + var3_i <- var3_read[i] + var3_conc <- paste (var3_conc, paste (", \"", var3_i, "\"", sep = "")) + } + var3_conc <- paste (var3_conc, "]", sep = "") + concatline <- paste("{","\"feature\"",":\"", var1,"\", ", + "\"feature.anchor\"",":\"", var2,"\", ", + "\"show.attribute\":", var3_conc,", ", + "\"internals\"",":\"", var4,"\", ", + "\"filter.attribute\"",":\"", var5,"\", ", + "\"attribute.value\"",":\"", var6,"\", ", + "\"strand\"",":\"",var7,"\", ", + "\"direction\"",":\"", var8,"\", ", + "\"distance\"",":","[",distance_up,", ",distance_down,"]","}", sep = "" + ) + } + + + return (concatline) +} + +# Creating modules + +# First module +#-------------------------------- + +# A module to read the inputs +# UI-part +PrintTablesUI <- function(id, label = "ui1UI") { + + ns <- NS(id) + shinyUI(fluidRow( + box(background = "light-blue",title= "query...",width=2), + + box(background = "light-blue",title= "JASON_UROPA_queries", + + column(width = 6, + textInput(ns("var1"),"feature"), + textInput(ns("var6"),"attribute.value"), + textInput(ns("var5"),"filter.attribute"), + textInput(ns("var3"),"show.attribute"), + # bsTooltip("var3", "type attributes between quotation marks separated with comma", + # "right", options = list(container = "body")), + sliderInput(ns("distance_up"), "distance_uptream", min = -10000, max = 10000, value = c(500))) + , + + column(width = 6, + selectInput(ns("var7"),"strand",choices=c("+","-","both")), + selectInput(ns("var2"),"feature.anchor",choices=c("start","center","end")), + selectInput(ns("var4"),"internals",choices=c("none","center","any")), + selectInput(ns("var8"),"direction",choices=c("any_direction","upstream","downstream")), + sliderInput(ns("distance_down"), "distance_upstream",min = -10000, max = 10000, value = c(500) + ) ) + + ) + ) + ) +} + +# 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"),"JASON_UROPA_queries")), + dashboardSidebar( + fluidRow( + + column(width=12, + selectInput("species_GTF","select species",choices=c("mus musculus","homo sapiens")), + radioButtons("gtf_files" ,"Select gtf file", + c("gencode.v22.genes.gtf"="human","gencode.vM5.genes.gtf"="mouse","other"="other")), + uiOutput("textORdate"), + + #fileInput("gtf files","Upload gtf file (tab-separated)"), + fileInput("file1", "Upload bed File")), + + column(width=12, + + selectInput("priority"," prioritized query",choices=c("FALSE","TRUE"))), + + + column(width = 12, + numericInput("NrQuery","Enter number of queries", 2, min=1, max=NaN), + actionButton("addqueries", "Add Module"), + actionButton("printres", "Print")) + + )), dashboardBody( + + + div(id = "ui_zero"), + div(id = "ui_zero2") + ) + +) + + + +server <- (function(input, output, session) { + + output$textORdate <- renderUI({ + #validate( + # need(!is.null(input$gtffiles), "please select a input type") + # ) + if(input$gtf_files =="other"){ + fileInput("file2","Upload gtf file (tab-separated)") + }else{ + + } + }) + + + + # Print the tables (first module) + observeEvent(input$addqueries, { + + for (counter in startpoint:input$NrQuery) { + ID <- paste0("c", counter) + insertUI("#ui_zero", "beforeEnd", PrintTablesUI(ID)) + 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$file2$name, "\",\n", + "\"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) +