Skip to content

Commit

Permalink
Browse files Browse the repository at this point in the history
Add files via upload
  • Loading branch information
@fazelzadeh
fazelzadeh committed Jul 19, 2017
1 parent 3379275 commit ce19b84
Showing 1 changed file with 349 additions and 0 deletions.
349 changes: 349 additions & 0 deletions 20170719_JSON_UROPA_query.R
View file
@@ -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)

1 comment on commit ce19b84

@fazelzadeh
Copy link
Owner Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Now with Progress Bar , Still slow due to column 9(.gtf)

Please sign in to comment.