I want to make an app with 2 actionButtons: 1) to submit the changes before loading a selectizeInput and 2) to draw the plot.
I know how to add a spinner after clicking a actionButton but the majority of the cases is added when you want to show the plot.
However, is it possible to add a spinner without showing any plot?
In this particular case, I want to show a spinner after clicking "Submit" until the selectizeInput from the 'Selection tab' is loaded. As you can see the example that I attach, it takes a bit to load all the choices (since the file has 25000 rows).
I already have one spinner after clicking the second actionButton (Show the plot) but I need one more.
I have created an example, but for some reason the plot is not shown in the shiny app and it appears in the window from R (I don't know why but I added the plot just to show you how I put the second spinner. I want a similar one but with the first actionButton.).
library(shiny)
library(shinycssloaders)
ui <- fluidPage(
titlePanel("My app"),
sidebarLayout(
sidebarPanel(
tabsetPanel(
tabPanel("Submit",
checkboxInput("log2", "Log2 transformation", value = FALSE),
actionButton("submit", "Submit")
),
tabPanel("Selection",
br(),
selectizeInput(inputId = "numbers", label = "Choose one number:", choices=character(0)),
actionButton("show_plot", "Show the plot")
))
),
mainPanel(
conditionalPanel(
condition = "input.show_plot > 0",
style = "display: none;",
withSpinner( plotOutput("hist"),
type = 5, color = "#0dc5c1", size = 1))
)
)
)
server <- function(input, output, session) {
data <- reactive({
data = read.csv("https://people.sc.fsu.edu/~jburkardt/data/csv/hw_25000.csv")
data[,1] <- as.character(data[,1])
if(input$log2 == TRUE){
cols <- sapply(data, is.numeric)
data[cols] <- lapply(data[cols], function(x) log2(x+1))
}
return(data)
})
mylist <- reactive({
req(data())
data <- data()
data <- data[,1]
return(data)
})
# This is to generate the choices (gene list) depending on the user's input.
observeEvent(input$submit, {
updateSelectizeInput(
session = session,
inputId = "numbers",
choices = mylist(), options=list(maxOptions = length(mylist()))
)
})
v <- reactiveValues()
observeEvent(input$show_plot, {
data <- data()
v$plot <- plot(x=data[,1], y=data[,2])
})
# If the user didn't choose to see the plot, it won't appear.
output$hist <- renderPlot({
req(data())
if (is.null(v$plot)) return()
if(input$show_plot > 0){
v$plot
}
})
}
Does anyone know how to help me, please?
Thanks very much
It's a little tricky.
First of all I'd update the selectizeInput on the server side as the warning suggests:
Warning: The select input "numbers" contains a large number of
options; consider using server-side selectize for massively improved
performance. See the Details section of the ?selectizeInput help
topic.
Furthermore I switched to ggplot2 regarding the plotOutput - Please see this related post.
To show the spinner while the selectizeInput is updating choices we'll need to know how long the update takes. This information can be gathered via shiny's JS events - please also see this article.
Finally, we can show the spinner for a non-existent output, so we are able to control for how long the spinner is shown (see uiOutput("dummyid")):
library(shiny)
library(shinycssloaders)
library(ggplot2)
ui <- fluidPage(
titlePanel("My app"),
tags$script(HTML(
"
$(document).on('shiny:inputchanged', function(event) {
if (event.target.id === 'numbers') {
Shiny.setInputValue('selectizeupdate', true, {priority: 'event'});
}
});
$(document).on('shiny:updateinput', function(event) {
if (event.target.id === 'numbers') {
Shiny.setInputValue('selectizeupdate', false, {priority: 'event'});
}
});
"
)),
sidebarLayout(
sidebarPanel(
tabsetPanel(
tabPanel("Submit",
checkboxInput("log2", "Log2 transformation", value = FALSE),
actionButton("submit", "Submit")
),
tabPanel("Selection",
br(),
selectizeInput(inputId = "numbers", label = "Choose one number:", choices=NULL),
actionButton("show_plot", "Show the plot")
))
),
mainPanel(
uiOutput("plotProxy")
)
)
)
server <- function(input, output, session) {
previousEvent <- reactiveVal(FALSE)
choicesReady <- reactiveVal(FALSE)
submittingData <- reactiveVal(FALSE)
observeEvent(input$selectizeupdate, {
if(previousEvent() && input$selectizeupdate){
choicesReady(TRUE)
submittingData(FALSE)
} else {
choicesReady(FALSE)
}
previousEvent(input$selectizeupdate)
})
data <- reactive({
data = read.csv("https://people.sc.fsu.edu/~jburkardt/data/csv/hw_25000.csv")
if(input$log2 == TRUE){
cols <- sapply(data, is.numeric)
data[cols] <- lapply(data[cols], function(x) log2(x+1))
}
return(data)
})
mylist <- reactive({
req(data()[,1])
})
observeEvent(input$submit, {
submittingData(TRUE)
reactivePlotObject(NULL) # reset
updateSelectizeInput(
session = session,
inputId = "numbers",
choices = mylist(), options=list(maxOptions = length(mylist())),
server = TRUE
)
})
reactivePlotObject <- reactiveVal(NULL)
observeEvent(input$show_plot, {
reactivePlotObject(ggplot(data(), aes_string(x = names(data())[1], y = names(data())[2])) + geom_point())
})
output$hist <- renderPlot({
reactivePlotObject()
})
output$plotProxy <- renderUI({
if(submittingData() && !choicesReady()){
withSpinner(uiOutput("dummyid"), type = 5, color = "#0dc5c1", size = 1)
} else {
conditionalPanel(condition = "input.show_plot > 0", withSpinner(plotOutput("hist"), type = 5, color = "#0dc5c1", size = 1), style = "display: none;")
}
})
}
shinyApp(ui, server)
First 100 rows of your example data (dput(head(data, 100)) - your link might be offline some day):
structure(list(Index = 1:100, Height.Inches. = c(65.78331, 71.51521,
69.39874, 68.2166, 67.78781, 68.69784, 69.80204, 70.01472, 67.90265,
66.78236, 66.48769, 67.62333, 68.30248, 67.11656, 68.27967, 71.0916,
66.461, 68.64927, 71.23033, 67.13118, 67.83379, 68.87881, 63.48115,
68.42187, 67.62804, 67.20864, 70.84235, 67.49434, 66.53401, 65.44098,
69.5233, 65.8132, 67.8163, 70.59505, 71.80484, 69.20613, 66.80368,
67.65893, 67.80701, 64.04535, 68.57463, 65.18357, 69.65814, 67.96731,
65.98088, 68.67249, 66.88088, 67.69868, 69.82117, 69.08817, 69.91479,
67.33182, 70.26939, 69.10344, 65.38356, 70.18447, 70.40617, 66.54376,
66.36418, 67.537, 66.50418, 68.99958, 68.30355, 67.01255, 70.80592,
68.21951, 69.05914, 67.73103, 67.21568, 67.36763, 65.27033, 70.84278,
69.92442, 64.28508, 68.2452, 66.35708, 68.36275, 65.4769, 69.71947,
67.72554, 68.63941, 66.78405, 70.05147, 66.27848, 69.20198, 69.13481,
67.36436, 70.09297, 70.1766, 68.22556, 68.12932, 70.24256, 71.48752,
69.20477, 70.06306, 70.55703, 66.28644, 63.42577, 66.76711, 68.88741
), Weight.Pounds. = c(112.9925, 136.4873, 153.0269, 142.3354,
144.2971, 123.3024, 141.4947, 136.4623, 112.3723, 120.6672, 127.4516,
114.143, 125.6107, 122.4618, 116.0866, 139.9975, 129.5023, 142.9733,
137.9025, 124.0449, 141.2807, 143.5392, 97.90191, 129.5027, 141.8501,
129.7244, 142.4235, 131.5502, 108.3324, 113.8922, 103.3016, 120.7536,
125.7886, 136.2225, 140.1015, 128.7487, 141.7994, 121.2319, 131.3478,
106.7115, 124.3598, 124.8591, 139.6711, 137.3696, 106.4499, 128.7639,
145.6837, 116.819, 143.6215, 134.9325, 147.0219, 126.3285, 125.4839,
115.7084, 123.4892, 147.8926, 155.8987, 128.0742, 119.3701, 133.8148,
128.7325, 137.5453, 129.7604, 128.824, 135.3165, 109.6113, 142.4684,
132.749, 103.5275, 124.7299, 129.3137, 134.0175, 140.3969, 102.8351,
128.5214, 120.2991, 138.6036, 132.9574, 115.6233, 122.524, 134.6254,
121.8986, 155.3767, 128.9418, 129.1013, 139.4733, 140.8901, 131.5916,
121.1232, 131.5127, 136.5479, 141.4896, 140.6104, 112.1413, 133.457,
131.8001, 120.0285, 123.0972, 128.1432, 115.4759)), row.names = c(NA,
100L), class = "data.frame")
I have read in a FCS file and I have got the parameters in a radio button, I am able to read the table data but I dont know how to plot the data.
there are 6 channels here as shown below.I have printed the data in a tabular format.enter image description here
My ui.r script is
rm(list = ls())
library(shiny)
library(flowCore)
shinyUI(fluidPage(
titlePanel("CD4/CD8 count GUI DEMO"),
fluidRow(
column(3,
fileInput('fcsFiles', strong('Choose fcs file:'),
accept = c('text/fcs', '.fcs')),
actionButton("goButton", "Submit!"),
hr(),
## sample limits: 50
uiOutput("sample_select"),
lapply(1:50, function(i) {
uiOutput(paste0('timeSlider', i))
}),
hr(),
uiOutput(outputId= "marker_select"),
uiOutput(outputId= "marker_select121"),
hr()
),
sidebarPanel(
numericInput("num1", label = h6("WBC COUNT"), value = 1,min = 0, max = NA, step = NA),
hr(),
fluidRow(column(3, verbatimTextOutput("wbc"))),
numericInput("num2", label = h6("lymphocyte percentage"), value = 1,min = 0, max = NA, step = NA),
hr(),
fluidRow(column(3, verbatimTextOutput("lymphocyte"))),
textOutput("ablymph"),
uiOutput(outputId= "xaxis"),
hr(),
uiOutput(outputId= "yaxis"),
hr(),
actionButton("goButton", "Submit!")
),
mainPanel(
tableOutput("filetable"),
plotOutput("fowardside"),
plotOutput("cd3plot"),
plotOutput("cd4plot"),
plotOutput("meplot"),
plotOutput("cd8plot")
)
)
))
and my Server.R script is
rm(list = ls())
library(flowCore)
library(shiny)
library(flowViz)
library(flowStats)
shinyServer(function(input, output,session) {
output$ablymph <- renderText({
W <- input$num1
L <- input$num2
x <- W*(L/100)
paste("Absolute Lymphocytes Count is =", x)
})
set <- reactive({
if (input$goButton == 0)
return()
isolate({fcsFiles<- input$fcsFiles
if (is.null(fcsFiles))
return (NULL)
set <- read.flowSet(fcsFiles$datapath)
sampleNames(set)<- fcsFiles$name})
return(set)
print(set)
})
output$sample_select <- renderUI({
if(is.null(set())){
return(NULL)
}else{
checkboxGroupInput('samples', strong('Select samples:'),
sampleNames(set()), selected = sampleNames(set()))
}
})
markerNames <- reactive({
if(is.null(set()))
return(NULL)
pd <- set()[[1]]#parameters#data
markers <- paste("<", pd$name, ">:", pd$desc, sep = "")
return(markers)
})
output$marker_select <- renderUI({
if(is.null(markerNames())){
return(NULL)
}else{
radioButtons(inputId = 'paras', label = ('Select markers for X-AXIS:'),
choices = markerNames(), selected = )
}
})
output$marker_select121 <- renderUI({
if(is.null(markerNames())){
return(NULL)
}else{
radioButtons(inputId = 'paras1', label = ('Select markers for Y-AXIS:'),
choices = markerNames(), selected = NULL)
}
})
output$filetable <- renderTable({
data1<- set()[[1]]#parameters#data
return(data1)
})
output$cd3plot<-renderPlot({
plot(set()[[1]]#parameters#data1[paras],set()[[1]]#parameters#data1[paras1])
})
})
can anyone help me with this please
thanks
I am trying to create a shiny-app that load data-set, present the variable list and their classes and allow the user to modify the class of a selected variable. All the functions in the following code are working except to the last function in the server- observeEvent which not working when trying to modify the variable class. Any suggestions?
Thank you in advance,
Rami
`
rm(list = ls())
library(shiny)
library(shinydashboard)
library(DT)
ui <- dashboardPage(
dashboardHeader(title = "Shiny Example"),
#--------------------------------------------------------------------
dashboardSidebar(
sidebarMenu(
menuItem("Data", tabName = "data", icon = icon("th"))
)
),
#--------------------------------------------------------------------
dashboardBody(
#--------------------------------------------------------------------
tabItem(tabName = "data",
fluidPage(
fluidRow(
box(
selectInput('dataset', 'Select Dataset', list(GermanCredit = "GermanCredit",
cars = "cars",
iris = "iris")),
title = "Datasets",width = 4, status = "primary",
checkboxInput("select_all", "Select All Variable", value = TRUE),
conditionalPanel(condition = "input.select_all == false",
uiOutput("show.var"))
),
box(
title = "Variable Summary", width = 4, status = "primary",
DT::dataTableOutput('summary.data')
),
box(
title = "Modify the Variable Class", width = 4, status = "primary",
radioButtons("choose_class", label = "Modify the Variable Class",
choices = list(Numeric = "numeric", Factor = "factor",
Character = "character"),
selected = "numeric"),
actionButton("var_modify", "Modify")
)
)
)
)
)
)
#--------------------------------------------------------------------
# Server Function
#--------------------------------------------------------------------
server <- function(input, output,session) {
#--------------------------------------------------------------------
# loading the data
get.df <- reactive({
if(input$dataset == "GermanCredit"){
data("GermanCredit")
GermanCredit
}else if(input$dataset == "cars"){
data(cars)
cars
}else if(input$dataset == "iris"){
data("iris")
iris
}
})
# Getting the list of variable from the loaded dataset
var_list <- reactive(names(get.df()))
# Choosing the variable - checkbox option
output$show.var <- renderUI({
checkboxGroupInput('show_var', 'Select Variables', var_list(), selected = var_list())
})
# Setting the data frame based on the variable selction
df <- reactive({
if(input$select_all){
df <- get.df()
} else if(!input$select_all){
df <- get.df()[, input$show_var, drop = FALSE]
}
return(df)
})
# create list of variables
col.name <- reactive({
d <- data.frame(names(df()), sapply(df(),class))
names(d) <- c("Name", "Class")
return(d)
})
# render the variable list into table
output$summary.data <- DT::renderDataTable(col.name(), server = FALSE, rownames = FALSE,
selection = list(selected = 1, mode = 'single'),
options = list(lengthMenu = c(5, 10, 15, 20), pageLength = 20, dom = 'p'))
# storing the selected variable from the variables list table
table.sel <- reactive({
df()[,which(colnames(df()) == col.name()[input$summary.data_rows_selected,1])]
})
# Trying to modify the variable class
observeEvent(input$var_modify,{
modify.row <- which(colnames(df()) == col.name()[input$summary.data_rows_selected,1])
if( input$choose_class == "numeric"){
df()[, modify.row] <- as.numeric(df()[, modify.row])
} else if( input$choose_class == "factor"){
df()[, modify.row] <- as.factor(df()[, modify.row])
} else if( input$choose_class == "character"){
df()[, modify.row] <- as.character(df()[, modify.row])
}
})
}
shinyApp(ui = ui, server = server)
`
I would use reactiveValues() instead.
library(shiny)
# Define UI for application that draws a histogram
ui <- shinyUI(fluidPage(
sidebarLayout(
sidebarPanel(
selectInput("classType", "Class Type:", c("as.numeric", "as.character"))
),
mainPanel(
textOutput("class")
)
)
))
server <- shinyServer(function(input, output) {
global <- reactiveValues(sample = 1:9)
observe({
global$sample <- get(input$classType)(global$sample)
})
output$class <- renderText({
print(class(global$sample))
})
})
shinyApp(ui = ui, server = server)
In case you are interested:
Concerning your attempt: reactive() is a function and you called the output of the function by df()[, modify.row]. So in your code you try to change the output of the function, but that does not change the output of futures calls of that function.
Maybe it is easier to see in a simplified version:
mean(1:3) <- 1
The code can not change the mean function to output 1 in future. So thats what reactiveValues() help with :). Hope that helps!
I am trying to dynamically render multiple text output from multiple text input. I tried to use this very helpfull example and this one too.
This conversation is also helpfull.
But when I try to adapt this examples on the following script, I have a problem of output update. Apparently, only the last element was read and updated. It's probably a reactivity problem but it seems to be difficult to associate reactive{()} and renderUI{()}functions.
rm(list = ls())
library(shiny)
creatDataElem <- function(ne, input) {
x1 <- lapply(1:ne, function(i) {
textInput(paste0("elemName", i),
label = h4(strong("Name of dataset element")),
value = "")
})
return(x1)
}
ui = (fluidPage(
sidebarLayout(
sidebarPanel(
sliderInput("elemNb",
"Number of elements", value = 1, min = 1,
max = 3)
,
conditionalPanel(
condition = "input.elemNb == 1",
creatDataElem(1)
),
conditionalPanel(
condition = "input.elemNb == 2",
creatDataElem(2)
),
conditionalPanel(
condition = "input.elemNb == 3",
creatDataElem(3)
)
),
mainPanel(
uiOutput("nameElem")
)
)
)
)
server = function(input, output, session) {
max_elem <- 3
# Name
output$nameElem <-renderUI({
nameElem_output_list <- lapply(1:input$elemNb, function(i) {
elemName <- paste0("elemName", i)
tags$div(class = "group-output",
verbatimTextOutput(elemName)
)
})
do.call(tagList, nameElem_output_list)
})
for (i in 1:max_elem) {
local({
force(i)
my_i <- i
elemName <- paste0("elemName", my_i)
output[[elemName]] <- renderPrint(input[[elemName]])
})
}
}
runApp(list(ui = ui, server = server))
The idea with a reactive({}) function is to add an independant object (a function in this case) like:
nameElem <- reactive({
if (input$goElem == 0) {
return()
} else {
isolate({
if (is.null(input$elemName)) {
return()
} else if (test(input$elemName)) {
return("TEST RESULT")
} else {
return(input$elemName)
}
})
}
})
and to use renderUI on this object (with an ActionButton).
So, if someone knows why the output does not return the good object...
I think one of your problems is that your creatDataElem function is such that when it is called with argument ne=3, the first and second textInput elements are created again (and their value "lost").
Anyway, I think one solution would be to create those textInput elements as an "uiOutput".
You'll find a possible solution below which (I think) does what you want.
Lise
rm(list = ls())
library(shiny)
ui = (fluidPage(
sidebarLayout(
sidebarPanel(
sliderInput("elemNb",
"Number of elements", value = 1, min = 1,
max = 3),
uiOutput("myUI")
),
mainPanel(
uiOutput("nameElem")
)
)
)
)
server = function(input, output, session) {
output$myUI=renderUI({
w=""
for (i in 1:input$elemNb){
w=paste0(w,
textInput(paste0("elemName",i),label='Name of dataset element'))
}
HTML(w)
})
output$nameElem <-renderUI({
elems=c("<div>")
for(i in 1:input$elemNb){
elems=paste(elems,"</div><div>",input[[paste0("elemName",i)]])
}
elems=paste0(elems,"</div>")
HTML(elems)
})
}
runApp(list(ui = ui, server = server))
Found a solution:
library(readr)
library(dplyr)
library(shiny)
df <- data.frame(symbol = 1:10)
uiOutput("myUI")
createUI <- function(dfID, symbol) {
div(class="flex-box",paste0(symbol, " - 10"))
}
output$myUI <- renderUI({
w <- lapply(seq_len(nrow(df)), function(i) {
createUI(i, df[i,"symbol"])
})
do.call(fluidPage,w)
})
I learned to use dynamic select input in my shiny application from the Rstudio shiny examples (http://shiny.rstudio.com/gallery/update-input-demo.html). Everything seemed to be OK, but an error occurred. I tested a lot and found the error was due to the dynamic select input used (the observe function in the server.R). But I can't figure out how to fix it. Any help would be highly appreciated. Thanks!
To save space, some of the code was not shown.
server.R
load("./data/genomicVar.RData")
load("./data/geneInfo.RData")
fetchInfoByMsu <- function(locus="") {...}
fetchSnpByMsu <- function(locus="") {...}
fetchIndelByMsu <- function(locus="") {...}
fetchSvByMsu <- function(locus="") {...}
fetchExpByMsu <- function(locus="") {...}
fetchInfoByBin <- function(binNumber="") {...}
fetchGeneByBin <- function(binNumber="") {...}
shinyServer(function(input, output, session) {
output$mytable1 = renderDataTable({...})
output$mytable2 = renderDataTable({...})
output$mytable3 = renderDataTable({...})
output$mytable4 = renderDataTable({...})
output$mytable5 = renderDataTable({...})
output$mytable6 = renderDataTable({...})
output$mytable7 = renderDataTable({...})
observe({
c_bin <- input$bin
c_gene <- fetchGeneByBin(input$bin)
c_gene <- c_gene$locus
# Select input
s_options <- list()
for (i in c_gene) {
s_options[[i]] <- i
}
# Change values for input$inSelect
updateSelectInput(session, "inSelect",
choices = s_options,
selected = c_gene[1]
)
})
output$mytable8 = renderDataTable({...})
output$mytable9 = renderDataTable({...})
output$mytable10 = renderDataTable({...})
output$mytable11 = renderDataTable({...})
output$mytable12 = renderDataTable({...})
})
UI.R
shinyUI(fluidPage(
fluidRow(
absolutePanel(
textInput("msu", label = h4("MSU genomic locus:"),
value = "LOC_Os07g15770"),
tabsetPanel(
tabPanel(strong('Information'), dataTableOutput("mytable1")),
tabPanel(strong('SNP'), dataTableOutput("mytable2")),
tabPanel(strong('Indels'), dataTableOutput("mytable3")),
tabPanel(strong('SVs'), dataTableOutput("mytable4")),
tabPanel(strong('Expression'), dataTableOutput("mytable5"))
),
br(),
p(HTML("<b><div style='background-color:#FADDF2;border:1px solid
blue;'></div></b>")),
textInput("bin", label = h4("Bin ID:"), value = "Bin1078"),
tabsetPanel(
tabPanel(strong('Information'), dataTableOutput("mytable6")),
tabPanel(strong('Gene'), dataTableOutput("mytable7"))
),
wellPanel(
selectInput("inSelect", strong("Select gene:"),
c("gene 1" = "option1",
"gene 2" = "option2"))
),
tabsetPanel(
tabPanel(strong('Information'), dataTableOutput("mytable8")),
tabPanel(strong('SNP'), dataTableOutput("mytable9")),
tabPanel(strong('Indels'), dataTableOutput("mytable10")),
tabPanel(strong('SVs'), dataTableOutput("mytable11")),
tabPanel(strong('Expression'), dataTableOutput("mytable12"))
),
br(),
p(HTML("<b><div style='background-color:#FADDF2;border:1px solid
blue;'></div></b>")),
right=5, left=10
)
)
))
I prefer using uiOutput for dynamic inputs, see this minimal example:
ui.R
shinyUI(fluidPage(
fluidRow(
absolutePanel(
#select bin
textInput("bin", label = h4("Bin ID:"), value = 1),
#dynamic options based on selected bin
uiOutput("inSelect")
)
)
)
)
server.R
shinyServer(function(input, output, session){
#genes dataframe
df <- data.frame(bin=c(1,1,1,2,2,2),
gene=c(12,13,14,21,23,24))
#dynamic select
output$inSelect <- renderUI({
selectInput("inSelect", strong("Select gene:"),
choices = df[ df$bin==input$bin,"gene"])
})
})