Related
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")
So this is an extension to my previous question.
Dynamic repeating conditionalPanel in R shiny dashboard
Here is the shiny code I am using right now.
library(shiny)
library(shinydashboard)
ui <- fluidPage(
br(),
selectInput("inpt", "Input Number", seq(1,50), selectize = FALSE),
br(),
uiOutput("selectors")
)
server <- function(input, output, session){
output[["selectors"]] <- renderUI({
n <- input[["inpt"]]
selectors <- lapply(1:n, function(i){
selectInput(paste0("id",i), "Select number", seq(1,24), selected = 1)
})
do.call(function(...){
box(..., width = 2, status = "primary")
}, selectors)
})
}
shinyApp(ui, server)
It will generate selection windows depending on 'inpt' number selection.
Now my issue is that I want to access the value of generated selection input.
Example: If I have selected 3, three inputs will be generated with id1, id2, id3.
How to access these ids? If I want to print them, how can I?
for (j in 1:inpt){
print(eval(parse(text = paste0("input$", paste0("id",j)))))
}
But output for this is:
NULL
NULL
NULL
I thought my eval and parse method is wrong so I tried with just inpt
for (j in 1:inpt){
print(eval(parse(text = paste0("input$", paste0("in","pt")))))
}
Output was (3 was selected in selection input)
3
3
3
So my eval, parse method was correct I guess.
So how to access id1, id2, ..., idn in above example?
Please check the following:
library(shiny)
library(shinydashboard)
ui <- fluidPage(
br(),
selectInput("inpt", "Input Number", seq(1,50), selectize = FALSE),
br(),
uiOutput("selectors"),
uiOutput("printMyDynamicInputs"),
uiOutput("printMyFirstDynamicInput")
)
server <- function(input, output, session){
output[["selectors"]] <- renderUI({
n <- input[["inpt"]]
selectors <- lapply(1:n, function(i){
selectInput(paste0("id",i), "Select number", seq(1,24), selected = 1)
})
do.call(function(...){
box(..., width = 2, status = "primary")
}, selectors)
})
myDynamicInputs <- reactive({
lapply(1:input$inpt, function(i){
input[[paste0("id",i)]]
})
})
output$printMyDynamicInput <- renderUI({
paste("You selected:", paste(myDynamicInputs(), collapse = ", "))
})
output$printMyFirstDynamicInputs <- renderUI({
paste("You selected:", input$id1)
})
}
shinyApp(ui, server)
I am building a shiny app that looks at our media sales.
My data is in a csv file
I want to be able to select any year and only have the row with the selected year be displayed.
As seen in the image.
Can someone help with the server out statement
media <- read.csv("media.csv",stringsAsFactors=FALSE)
State,Year,DVD,BluRay,Download
CT,2013,265,95,141
CT,2014,201,54,65
CT,2015,154,62,28
CT,2016,96,23,72
CT,2017,49,84,36
MA,2013,116,321,108
MA,2014,66,119,145
MA,2015,69,64,121
MA,2016,84,81,210
MA,2017,79,35,96
MD,2013,161,36,26
MD,2014,24,97,84
MD,2015,201,74,24
MD,2016,254,74,154
MD,2017,95,63,247
NJ,2013,78,60,168
NJ,2014,201,85,321
NJ,2015,209,75,245
NJ,2016,217,55,88
NJ,2017,65,46,71
PA,2013,94,95,68
PA,2014,232,91,94
PA,2015,154,73,203
PA,2016,87,101,119
PA,2017,200,98,149
Code:
library(shiny)
ui <- fluidPage(
titlePanel('DVD/BluRay/Download:'),
sidebarLayout(
sidebarPanel(
selectInput("State", label = h4("Which State are you in:"),choices =media$State),
checkboxGroupInput("Category", label = h4("Category"),
choices = list("DVD" , "BluRay" , "Download" ),
selected = list("DVD" , "BluRay" , "Download" )),
checkboxGroupInput("Year", label = h4("Which Year(s)"),choices = unique(media$Year))
),
mainPanel(
tableOutput("mediadata")
)
)
)
server <- function(input, output) {
output$mediadata <- renderTable({
statefilter <- subset(media, media$State == input$State)
statefilter[c('State', 'Year', input$Category)]
})
}
shinyApp(ui = ui, server = server)
This works now:
output$mediadata <- renderTable({
statefilter <- subset(media[media$State == input$State & media$Year %in% input$Year,])
statefilter[c('State', 'Year', input$Category)]
})
I am pretty new to shiny and I am trying to build a web application that downloads datasets from GEO or lets user upload his own. Be able to show the data to user in boxplot format and table format then let user decide whether data is to be normalized or log transformed. My issue is the actionButton in the later order in the code does not work. If I press the first actionButton and then press second actionButton both works oddly. But if I choose to press second actionButton directly it does nothing. Here is my code:
ui.R
library(shiny)
library(som)
shinyUI(pageWithSidebar(
# Application title
#
headerPanel("Dataset Selection"),
# Sidebar with controls to select a dataset and specify the number
# of observations to view
sidebarPanel(
actionButton("Gobutton", "Bring it up"),
fluidRow()
),
mainPanel(
tabsetPanel(
tabPanel("Dataset",
fluidRow(
column(8, uiOutput("dataTable"),
tags$style(type='text/css', '#view {background-color: rgba(11,56,49,0.2); color: black; font-family:verdana;}') ))
),
tabPanel("Boxplot",
fluidRow(
column(8,plotOutput("preprocessData"),
tags$style(type='text/css', '#view {background-color: rgba(11,56,49,0.2); color: black; font-family:verdana;}'))),
conditionalPanel(condition = "input.NormalizeButton <= 0",
actionButton("NormalizeButton","Normalize")),
conditionalPanel(condition = "input.LogTransformButton <= 0",
actionButton("LogTransformButton", "Log2 Transform"))
))
)
)
)
server.R
shinyServer(function(input, output) {
library(xtable)
# You can access the value of the widget with input$num, e.g.
GSEmRNA <- data.frame(from=c(100,200,150), to=c(1000,2000,150),last= c(50,50,250))
normalizeSom <- function(GSEmRNA){
colnamesSAVE <- colnames(GSEmRNA)
GSEmRNA <- som::normalize(GSEmRNA) # Normalize the dataset using som package of R
colnames(GSEmRNA) <- colnamesSAVE
boxplot(GSEmRNA)
print(colnames(GSEmRNA))
return(GSEmRNA)
}
todoLogTransformation <- function(GSEmRNA) {
GSEmRNA <- log(GSEmRNA,2)
boxplot(GSEmRNA)
return(GSEmRNA)
}
output$dataTable <- renderUI({
input$Gobutton
if (input$Gobutton== 0) {return()}
else{
GSEmRNAprinted <- print(xtable(head(GSEmRNA), align=rep("c", ncol(GSEmRNA)+1)),
floating=FALSE, tabular.environment="array", comment=FALSE, print.results=FALSE)
html <- paste0("$$", GSEmRNAprinted, "$$")
list(
withMathJax(HTML(html)))}
})
output$preprocessData <- renderPlot({
if (input$Gobutton== 0) {return()}
else{
boxplot(GSEmRNA)
input$LogTransformButton
if(input$LogTransformButton ==0){return()}
else if(input$LogTransformButton != 0 ){
GSEmRNA <<- todoLogTransformation(GSEmRNA)
}
input$NormalizeButton
if(input$NormalizeButton ==0){return()}
else if(input$NormalizeButton != 0){
GSEmRNA <<- normalizeSom(GSEmRNA)
}}
})
})
Also lastly, I want the table I described in the output$dataTable <- renderUI to be renewed each time user presses normalize or log transform. Any help is greatly appreciated. I have been working on this for quite some time
Try this :
1) Delete from your code all what not influence( css and panel-- for simplicity)
2) All function declare outside server -- think it will work better
3) use reactive values for data
UI
library(shiny)
library(som)
shinyUI(pageWithSidebar(
headerPanel("Dataset Selection"),
sidebarPanel(
actionButton("Gobutton", "Bring it up")
),
mainPanel(
wellPanel(
fluidRow(
column(8, uiOutput("dataTable")
))
),
wellPanel(
fluidRow(
column(8,plotOutput("preprocessData")
)),
conditionalPanel(condition = "input.NormalizeButton <= 0",
actionButton("NormalizeButton","Normalize")),
conditionalPanel(condition = "input.LogTransformButton <= 0",
actionButton("LogTransformButton", "Log2 Transform"))
)
)
)
)
server
normalizeSom <- function(GSEmRNA){
colnamesSAVE <- colnames(GSEmRNA)
GSEmRNA <- som::normalize(GSEmRNA) # Normalize the dataset using som package of R
colnames(GSEmRNA) <- colnamesSAVE
return(GSEmRNA)
}
todoLogTransformation <- function(GSEmRNA) {
GSEmRNA <- log(GSEmRNA,2)
return(GSEmRNA)
}
shinyServer(function(input, output) {
library(xtable)
# You can access the value of the widget with input$num, e.g.
GSEmRNA <- data.frame(from=c(100,200,150), to=c(1000,2000,150),last= c(50,50,250))
data_for_use=reactiveValues(d=GSEmRNA)
output$dataTable <- renderUI({
if (input$Gobutton== 0) {return()}
else{
GSEmRNAprinted <- print(xtable(head(data_for_use$d), align=rep("c", ncol(data_for_use$d)+1)),
floating=FALSE, tabular.environment="array", comment=FALSE, print.results=FALSE)
html <- paste0("$$", GSEmRNAprinted, "$$")
list(
withMathJax(HTML(html)))}
})
output$preprocessData <- renderPlot({
if (input$Gobutton== 0) {return()
}else{
boxplot(data_for_use$d)
}
})
observeEvent(input$NormalizeButton,{
data_for_use$d=normalizeSom(data_for_use$d)
})
observeEvent(input$LogTransformButton,{
data_for_use$d=todoLogTransformation(data_for_use$d)
})
})
I'm building a Shiny app and want to reactivity control which columns get displayed in a heatmap. I'd like for all of the columns to be displayed at first and then be able to subset it by deselecting columns from a checkboxGroupInput.
When I run the code, the heatmap doesn't appear. I tried troubleshooting by looking at the df_select dataframe but it only has the "mpg" column when it should have all of them (mpg:carb) initially. Including View(df_select) throws an error so it is commented out below.
Any help would be greatly appreciated.
app.R
library(ggplot2)
library(d3heatmap)
library(dplyr)
library(shiny)
## ui.R
ui <- fluidPage(
sidebarPanel(
h5(strong("Dendrogram:")),
checkboxInput("cluster_row", "Cluster Rows", value=FALSE),
checkboxInput("cluster_col", "Cluster Columns", value=FALSE),
checkboxGroupInput("col_list", "Select col to include:", names(mtcars), selected=names(mtcars)),
h5(strong("Sort:")),
checkboxInput("check_sort", "Sort (Yes/No)", value=FALSE),
selectInput("sort", "Sort:", names(mtcars), selected="mpg")
),
mainPanel(
h4("Heatmap"),
d3heatmapOutput("heatmap", width = "100%", height="600px")
)
)
## server.R
server <- function(input, output) {
df_select <- reactive({
all <- names(mtcars)
print(all) #debug
selection <- input$col_list
print(selection) #debug
if("All" %in% input$col_list || length(input$col_list) == 0){
selection <- all
}else{
selection <- input$col_list
}
df_select <- select_(mtcars, selection)
#View(df_select) #debug
})
df_sort <- reactive({
df_sort <- if(input$check_sort==FALSE) df_select() else arrange_(df_select(), input$sort)
})
output$heatmap <- renderD3heatmap({
d3heatmap(df_sort(),
colors = "Blues",
if (input$cluster_row) RowV = TRUE else FALSE,
if (input$cluster_col) ColV = TRUE else FALSE,
yaxis_font_size = "7px"
)
})
}
shinyApp(ui = ui, server = server)
It is a standard evaluation issue. Use select_(mtcars, .dots=selection) (line number 38).