Skip to content
Permalink
master
Switch branches/tags

Name already in use

A tag already exists with the provided branch name. Many Git commands accept both tag and branch names, so creating this branch may cause unexpected behavior. Are you sure you want to create this branch?

JSON_UROPA/20170721_JSON_UROPA_query.R

Go to file
 
 
Cannot retrieve contributors at this time
333 lines (286 sloc) 15.4 KB
Raw Blame
Open in GitHub Desktop
#================================
#
# 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"
write.table (length(unique(dfgtffile[,2])), "test_1.txt", quote = F)
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 + limit
incProgress(limit/n, detail = paste(upperlimit, " lines read."))
rm(df_V3_temp)
rm (dfgtffile_ss1)
}
})
write.table (length(unique(dfgtffile[,2])), "test_2.txt", quote = F)
strcol9_list <<- keys
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)