library('shiny')
library('shinydsc')
library('plotly')
shinyServer(function(input, output, session) {
observe({
if (input$learnmore != 0L) {
updateTabsetPanel(session, 'mainnavbar', selected = 'Help')
}
})
load_dsc_rds = reactive({
if (input$data_type == 'upload' & (!is.null(input$dsc_output_upload))) {
dsc_raw = readRDS(file = input$dsc_output_upload$datapath)
} else if (input$data_type == 'example') {
# defensive programming on file name
if (input$dsc_example %in% c('one_sample_location',
'second_sample',
'yet_another_example')) {
dsc_raw = readRDS(file = paste0('data/', input$dsc_example, '.rds'))
} else {
dsc_raw = NULL
}
} else {
dsc_raw = NULL
}
return(dsc_raw)
})
observe({
dsc_raw = load_dsc_rds()
if (!is.null(dsc_raw)) {
dsc_ace = dsc2ace(dsc_raw)
updateAceEditor(session, 'ace_upload', value = dsc_ace)
}
})
observe({
dsc_raw = load_dsc_rds()
if (!is.null(dsc_raw)) {
dsc_ace = dsc2ace(dsc_raw)
updateAceEditor(session, 'ace_filter', value = dsc_ace)
}
})
output$dsc_blocks_ui = renderUI({
dsc_raw = load_dsc_rds()
dsc_blocks = get_blocks(dsc_raw)
dsc_execs = get_execs(dsc_raw)
n_blocks = length(dsc_blocks)
blocks_ui_list = vector('list', n_blocks)
for (i in 1L:n_blocks) {
blocks_ui_list[[i]] =
selectizeInput(inputId = paste0('execs_', dsc_blocks[i]),
label = dsc_blocks[i],
choices = c("NULL", dsc_execs[[dsc_blocks[i]]]),
multiple = TRUE)
}
# this is a list of render UI
blocks_ui_list
})
output$dsc_params_ui = renderUI({
dsc_raw = load_dsc_rds()
dsc_blocks = get_blocks(dsc_raw)
dsc_execs = get_execs(dsc_raw)
dsc_params = get_params(dsc_raw)
params_ui_list = NULL
params_ui_list = list(params = dsc_params)
"params_ui_list"
})
############### testing to get the table out
# just test what in the uiblock
output$input_type_text <- renderText({
dsc_raw = load_dsc_rds()
dsc_blocks = get_blocks(dsc_raw)
dsc_execs = get_execs(dsc_raw)
n_blocks = length(dsc_blocks)
AA = (unlist(reactiveValuesToList(input)[paste0('execs_', dsc_blocks[1:n_blocks])]))
# paste("you choose", AA)
length(AA)
})
# just to test the output of the table
output$filtered_master_table = renderDataTable({
dsc_raw = load_dsc_rds()
dsc_blocks = get_blocks(dsc_raw)
dsc_execs = get_execs(dsc_raw)
n_blocks = length(dsc_blocks)
# AA = (unlist(reactiveValuesToList(input)[paste0('execs_', dsc_blocks[1:n_blocks])]))
current_result = dsc_raw$master_mse
# filter_result = dplyr::filter(current_result, simulate_name == "rnorm.R")
})
####################### the following are for the output the tables and this part is just for dsc Omega
rv = reactiveValues()
open_proj_message <- eventReactive(input$open_proj, {
crt_path = getwd()
data_path = paste0(crt_path,"/data")
open_path = paste0(data_path,"/",input$project_name)
dir.create(open_path)
# restore this path
# the further action should be inside of this current path.
rv$crt_path = open_path
# paste("You have open a dsc project",input$project_name,"in",open_path)
"please complete your annotation step by step."
})
output$open_proj_note <- renderText({
# open a project and indicate the directory
open_proj_message()
})
#### tag add system
inserted <- c()
observeEvent(input$insertBtn, {
btn <- input$insertBtn
id <- paste0('tag_', btn)
insertUI(
selector = '#placeholder',
## wrap element in a div with id for ease of removal
ui = tags$div(
fluidRow(
column(width = 5,
selectizeInput(inputId = paste0("tag_",id),
label = "select tags",
choices = rv$dsc_meta$groups,
multiple = TRUE)
),
column(width = 5,
textInput(paste0("alias_",id), label = "Alias for this tag",
value = "")
)
),
id = id
)
)
inserted <<- c(id, inserted)
})
observeEvent(input$removeBtn, {
removeUI(
## pass in appropriate div id
selector = paste0('#', inserted[length(inserted)])
)
inserted <<- inserted[-length(inserted)]
})
# test the output the alias
output$text_alias <- renderText({
meta_var = c()
meta_var_list = names(input)[which(names(input) %in% rv$block_names)]
for(i in 1:length(meta_var_list)) meta_var = c(meta_var, input[[meta_var_list[i]]])
meta_part = ""
for(i in 1:length(meta_var)) meta_part = paste(meta_part,meta_var[[i]])
meta_part
})
# this is to read the dsc from the user's computer
volumes <- c(Root = '~' )
shinyDirChoose(input, 'dsc_directory', roots=volumes, session=session, restrictions=system.file(package='base'))
read_meta_file = eventReactive(input$dsc_directory,{
dsc_dir = parseDirPath(volumes, input$dsc_directory)
meta_folder = paste0(dsc_dir,"/.sos/.dsc")
tag_file = list.files(meta_folder)[sapply(list.files(meta_folder),function(x){grepl("shinymeta",x) })]
tag_file_name = as.vector(sapply(tag_file,function(x){(unlist(strsplit(x,'[.]')))[length(unlist(strsplit(x,'[.]')))-2]}))
radioButtons(inputId = "meta_file",
label = paste('please choose a meta file'),
choices = tag_file_name,
selected = NULL
# choices = tag_file,
)
})
# this is to choose the different type of meta file
output$meta_file <- renderUI({
read_meta_file()
})
read_meta_output = eventReactive(input$meta_file,{
dsc_dir = parseDirPath(volumes, input$dsc_directory)
meta_folder = paste0(dsc_dir,"/.sos/.dsc")
tag_file_name = input$meta_file
tag_file = list.files(meta_folder)[sapply(list.files(meta_folder),function(x){grepl("shinymeta",x) })]
tag_file = tag_file[sapply(tag_file,function(x){grepl(tag_file_name,x) })]
dsc_meta = readRDS(paste0(meta_folder,"/",tag_file))
rv$dsc_meta = dsc_meta
block_names = unique(sapply(dsc_meta$variables,function(x){(unlist(strsplit(x,'[:]')))[1]}))
rv$block_names = as.vector(block_names)
block_list = list()
for(i in 1:length(block_names)){
block_list[[i]] = checkboxGroupInput(inputId = block_names[i],
label = paste(block_names[i]),
choices = rv$dsc_meta$variables[sapply(rv$dsc_meta$variables,function(x){grepl(block_names[i],x) })],
# choices = tag_file,
width = 3
)
}
#selectizeInput(inputId = "meta_var",
# label = paste('select quantaties :'),
# choices = rv$dsc_meta$variables,
# multiple = TRUE)
block_list
})
# add the meta
output$meta_output <- renderUI({
read_meta_output()
})
# this is to hide the dsc load
shinyjs::onclick("step_1",
shinyjs::toggle(id = "step_1_load", anim = TRUE))
shinyjs::onclick("step_2",
shinyjs::toggle(id = "step_2_load", anim = TRUE))
shinyjs::onclick("step_3",
shinyjs::toggle(id = "step_3_load", anim = TRUE))
shinyjs::onclick("step_4",
shinyjs::toggle(id = "step_4_load", anim = TRUE))
# this is just for test
output$tagged_dsc_note <- renderText({
tagged_command()
"Completed"
})
# try to read the annotation from the list
tagged_command = eventReactive(input$apply_annotation,{
rv$app_dir = getwd()
dsc_dir = parseDirPath(volumes, input$dsc_directory)
tag_list = names(input)[sapply(names(input),function(x){grepl("tag_tag_",x) })]
tag_index = which(sapply(names(input),function(x){grepl("tag_tag_",x) }))
# to restore the index of tag in the input
rv$tag_index = tag_index
### TODO think about when the index in empty
tag_list
tag_content = list()
for(i in 1:length(tag_list)){
tag_content[[i]] = c(input[[tag_list[i]]])
}
# to get the alias into the tag part
alias_list = names(input)[sapply(names(input),function(x){grepl("alias_tag_",x) })]
alias_index = which(sapply(names(input),function(x){grepl("alias_tag_",x) }))
# to restore the index of tag in the input
rv$alias_index = alias_index
### TODO think about when the index in empty
alias_content = list()
for(i in 1:length(alias_list)){
alias_content[[i]] = c(input[[alias_list[i]]])
}
# compose tag part
tag_part = ""
for (i in 1:length(tag_content)) tag_part = paste0(tag_part, ' ', "'", paste(alias_content[[i]],paste(tag_content[[i]], collapse='&&'),sep = '='), "'")
# read the meta content
meta_var = c()
meta_var_list = names(input)[which(names(input) %in% rv$block_names)]
for(i in 1:length(meta_var_list)) meta_var = c(meta_var, input[[meta_var_list[i]]])
meta_part = ""
for(i in 1:length(meta_var)) meta_part = paste(meta_part,meta_var[[i]])
# name part
meta_folder = paste0(dsc_dir,"/.sos/.dsc")
# meta_file_name = list.files(meta_folder)[sapply(list.files(meta_folder),function(x){grepl("shinymeta",x) })]
meta_file_name = input$meta_file
#name_part_vec = unlist(strsplit(meta_file_name,'[.]'))
#name_part = name_part_vec[length(name_part_vec)-2]
name_part = meta_file_name
system_command = paste("dsc -e",meta_part,"--target",name_part,"--tags",tag_part, "-v 0","-o", paste0(rv$crt_path,"/",name_part,".rds"))
setwd(dsc_dir)
try({
system(system_command)
crt_data = readRDS(paste0(rv$crt_path,"/",name_part,".rds"))
rv$crt_data = crt_data
})
setwd(rv$app_dir)
system_command
})
######## here are for the visualization
output$result_folder <- renderUI({
# read_tag()
data_dir = paste0(getwd(),"/data")
res_file = list.files(data_dir)# [sapply(list.files(data_dir),function(x){grepl("rds",x) })]
selectizeInput(inputId = "meta_folder_out",
label = paste('View Folder:'),
choices = res_file,
multiple = TRUE)
})
result_file = eventReactive(input$meta_folder_out,{
result_folder = paste0(getwd(),"/data/",input$meta_folder_out)
tag_file = list.files(result_folder)[sapply(list.files(result_folder),function(x){grepl("rds",x) })]
selectizeInput(inputId = "meta_file_out",
label = paste('meta file:'),
choices = tag_file,
multiple = TRUE)
})
output$meta_file_out <- renderUI({
result_file()
})
read_result = eventReactive(input$meta_file_out,{
result_folder = paste0(getwd(),"/data/",input$meta_folder_out,"/",input$meta_file_out)
RDS_file = readRDS(result_folder)
})
output$meta_quantaty_out <- renderUI({
result_list = read_result()
res_file = names(result_list)
contents = sapply(res_file,function(x){strsplit(x,"_")})
new_contents = list()
for (i in 1:length(contents)) {
key = paste0(contents[[i]][(length(contents[[i]]) - 1) :length(contents[[i]])], collapse = '_')
if (key %in% names(new_contents)) {
new_contents[[key]] = append(new_contents[[key]], paste0(contents[[i]][1:(length(contents[[i]])-2)], collapse = '_'))
} else {
new_contents[[key]] = paste0(contents[[i]][1:(length(contents[[i]])-2)], collapse = '_')
}
}
# new_contents example
# > new_contents
# $scores_score
# [1] "dia" "DSC_TIMER_dia" "huge" "DSC_TIMER_huge"
})
# this is for the box plot
output$box_content <- renderUI({
result_list = read_result()
res_file = names(result_list)
box_file = res_file[-which(grepl("DSC_",res_file))]
selectizeInput(inputId = "box_content",
label = paste('choose the component:'),
choices = box_file,
multiple = TRUE)
})
output$violin_content <- renderUI({
result_list = read_result()
res_file = names(result_list)
violin_file = res_file[-which(grepl("DSC_",res_file))]
selectizeInput(inputId = "violin_content",
label = paste('choose the component:'),
choices = violin_file,
multiple = TRUE)
})
output$timer_content <- renderUI({
result_list = read_result()
res_file = names(result_list)
timer_file = result_list[[res_file[which(grepl("TIMER",res_file))]]]
timer_names = names(timer_file)
selectizeInput(inputId = "timer_content",
label = paste('choose the component:'),
choices = timer_names,
multiple = TRUE)
})
box_data = eventReactive(input$box_content,{
result_list = read_result()
n_col = length(input$box_content)
scores = c()
score_type = c()
for(i in 1:n_col){
scores = c(scores,unlist(result_list[(input$box_content)[i]]))
score_type = c(score_type, rep((input$box_content)[i],length( unlist(result_list[(input$box_content)[i]]))))
}
data_mat = cbind(scores,score_type)
colnames(data_mat) = c("values","Type")
data_df = data.frame(data_mat)
data_df$values = as.numeric(as.character(data_df$values))
data_df
})
violin_data = eventReactive(input$violin_content,{
result_list = read_result()
n_col = length(input$violin_content)
scores = c()
score_type = c()
for(i in 1:n_col){
scores = c(scores,unlist(result_list[(input$violin_content)[i]]))
score_type = c(score_type, rep((input$violin_content)[i],length( unlist(result_list[(input$violin_content)[i]]))))
}
data_mat = cbind(scores,score_type)
colnames(data_mat) = c("values","Type")
data_df = data.frame(data_mat)
data_df$values = as.numeric(as.character(data_df$values))
data_df
})
timer_data = eventReactive(input$timer_content,{
result_list = read_result()
result_list = result_list$DSC_TIMER
n_col = length(input$timer_content)
scores = c()
score_type = c()
for(i in 1:n_col){
scores = c(scores,unlist(result_list[(input$timer_content)[i]]))
score_type = c(score_type, rep((input$timer_content)[i],length( unlist(result_list[(input$timer_content)[i]]))))
}
data_mat = cbind(scores,score_type)
colnames(data_mat) = c("values","Type")
data_df = data.frame(data_mat)
data_df$values = as.numeric(as.character(data_df$values))
data_df
})
output$pi_0_plot_1 = renderPlot({
dat = violin_data()
library(ggplot2)
p <- ggplot(dat, aes(x=Type, y=values)) +
geom_violin() +
geom_dotplot(binaxis='y', stackdir='center', dotsize = .5, binwidth = 1/100)
p
})
output$pi_0_plot_2 = renderPlotly({
dat = box_data()
library(plotly)
p <- plot_ly(dat, y = ~ values, x = ~ Type, type = "box",color = ~Type)
p
})
output$pi_0_plot_3 = renderPlotly({
dat = timer_data()
library(plotly)
p <- plot_ly(dat, y = ~ values, x = ~ Type, type = "box",color = ~Type)
p
})
############################ this is a test
output$crt_data_size = renderText({
res_file = read_scatter_data()
paste(dim(res_file),sep = ",")
})
output$crt_box_content <- renderUI({
res_file = rv$crt_data
box_file = names(res_file)[-which(grepl("DSC_",names(res_file)))]
selectizeInput(inputId = "crt_box_content",
label = paste('choose the component:'),
choices = box_file,
multiple = TRUE)
})
crt_data = eventReactive(input$crt_box_content,{
result_list = rv$crt_data
n_col = length(input$crt_box_content)
scores = c()
score_type = c()
for(i in 1:n_col){
scores = c(scores,unlist(result_list[(input$crt_box_content)[i]]))
score_type = c(score_type, rep((input$crt_box_content)[i],length( unlist(result_list[(input$crt_box_content)[i]]))))
}
data_mat = cbind(scores,score_type)
colnames(data_mat) = c("values","Type")
data_df = data.frame(data_mat)
data_df$values = as.numeric(as.character(data_df$values))
data_df
})
output$pi_0_plot_4 = renderPlotly({
dat = crt_data()
library(plotly)
p <- plot_ly(dat, y = ~ values, x = ~ Type, type = "box",color = ~Type)
p
})
# the following is for the scatter plot
# I will just use the data frame from the boxplot
output$scatter_content_x <- renderUI({
result_list = read_result()
res_file = names(result_list)
scatter_file = res_file[-which(grepl("DSC_",res_file))]
radioButtons(inputId = "scatter_x",
label = paste('quantaty on x axis'),
choices = scatter_file,
selected = NULL
)
})
output$scatter_content_y <- renderUI({
result_list = read_result()
res_file = names(result_list)
scatter_file = res_file[-which(grepl("DSC_",res_file))]
radioButtons(inputId = "scatter_y",
label = paste('quantaty on y axis'),
choices = scatter_file,
selected = NULL
)
})
output$scatter_index <- renderUI({
result_list = read_result()
res_file = names(result_list)
scatter_file = res_file[-which(grepl("DSC_",res_file))]
N_length = length(result_list[[2]])
numericInput("scatter_index", "index of replicate",1, min = 1, max = N_length)
})
read_scatter_data = eventReactive({input$scatter_x
input$scatter_y
input$scatter_index},{
result_list = read_result()
x_content = result_list[input$scatter_x]
y_content = result_list[input$scatter_y]
if(length((x_content[[1]])[[1]])>2){
x_value = as.vector(data.frame(x_content)[input$scatter_index])
y_value = as.vector(data.frame(y_content)[input$scatter_index])
}else{
x_value = unlist(x_content)
y_value = unlist(y_content)
}
data_mat = cbind(x_value,y_value)
colnames(data_mat) = c("x","y" )
data_df = data.frame(data_mat)
data_df
})
output$pi_0_plot_5 = renderPlotly({
dat = read_scatter_data()
library(plotly)
p <- plot_ly(dat,x = ~x, y = ~y )
p
})
})
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.