20170710_JSON_UROPA_queries.R

#================================
#
# Initialization
#
#================================

# Loading in libraries
library(shiny)
library(shinydashboard)
library(shinyBS)

# Defining the parameters
startpoint <- 1

# User-defined functions
# A print function to create the configuration file format
JU_resformat <- function (var1, var2, var3, var4, var5, var6, var7, var8, distance_up, distance_down) {
#  var3_read <- gsub("[[:space:]]", "", unlist(strsplit(var3, ";")))
  var3_read <- var3
  if (length (var3_read) <= 1) {
    concatline <- paste("{","\"feature\"",":\"", var1,"\", ",
                        "\"feature.anchor\"",":\"", var2,"\", ",
                        "\"show.attribute\":\"", var3,"\", ",
                        "\"internals\"",":\"", var4,"\", ",
                        "\"filter.attribute\"",":\"", var5,"\", ",
                        "\"attribute.value\"",":\"",var6,"\", ",
                        "\"strand\"",":\"", 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, strcol3_list, strcol9_list, label = "ui1UI") {
  
  ns <- NS(id)
  shinyUI(fluidRow(
          box(background = "light-blue",title= "query...",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)),
                   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)
                
            ),
            # bsTooltip("var3", "type attributes between quotation marks separated with comma",
            # "right", options = list(container = "body")),
              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"),"JSON_UROPA_queries")),
  dashboardSidebar(
    fluidRow(
         column(width=12, 
              radioButtons("gtf_files" ,"Select gtf file (tab-separated)",
                          c("human"="gencode.v22.genes.gtf","mouse"="gencode.vM5.genes.gtf","other"="other")),
              actionButton("gftfile_upload", "Upload file"),
              uiOutput("textORdate"),
              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 queries"),
             actionButton("printres", "Print"))
             
      )), dashboardBody(
        
        ##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"),
        ##################################
     
      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")
    }
    
################# #upload human and mouse gtf file automatically 
     #configFile <- reactive({
     # inFile <- input$gtf_files
     # if (is.null(inFile)) {return()}
     # return(source(inFile$"Z:/shiny/apps/UROPA/JSON_UROPA"))
   # })
  # if(input$gtf_files == "human"){
    #  read.table("gencode.v22.genes.gtf", sep = "\t")
   # }
    
 ################################################################   
          })
  
  # GTF file
  strcol3_list <- "test"
  strcol9_list <- "test"
  observeEvent(input$gftfile_upload, {
    dfgtffile <- read.table (input$gtf_files, sep = "\t")
    strcol3_list <<- as.character(unique(sort(dfgtffile[,3])))
    
    strcol9_list_TMP <- strsplit(as.character(dfgtffile[,9]),' ')
    for (i in 1:length(strcol9_list_TMP)) {
      strtemp <- unlist(strcol9_list_TMP[i])
      for (j in seq(1, length(strtemp), 2)) {
        if (i == 1 && j == 1) {
          strcol9_list_TEMP <<- strtemp[j]
        } else if (!is.element(strtemp[j], strcol9_list_TEMP)) {
          strcol9_list_TEMP <<- c(strcol9_list_TEMP, strtemp[j])
        }
      }
    }
    strcol9_list <<- strcol9_list_TEMP
  })
  
  # 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$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)