JASON_UROPA_queries_V8.R

#================================
#
# 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", "Save query"))
             
      )), 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.txt", quote = F, col.names = F, row.names = F)
        })
      })
    }
  })
})


# Running the program
shinyApp(ui = ui, server = server)