delete verbatimtextOutput - r

ran into this weird issue when teaching a student about shiny programming.
What i wanted was to make code that deletes the verbatimtextOuput element, rather than print an empty value
This is the code he wrote, but it deletes all buttons, the whole UI basically. Can this be done? I know more complex options like conditional panels etc, but just trying to figure out why removeUI doesn't do what I expected here.
Thanks!
app:
library(shiny)
ui<-fluidPage( h5("Hello there"), #First text on the window
br(), #empty line
actionButton(inputId = "ClickonMe", label = "Make data"), # button 1
actionButton(inputId = "ClickonMe2", label = "Print data"), # button 2
actionButton(inputId = "ClickonMe3", label = "Transform data"),
verbatimTextOutput("Response_text") #reactive text output )
server <- function(input,output) {
values <- reactiveValues()
observeEvent(input$ClickonMe,
values$name <- TRUE )
observeEvent(input$ClickonMe3,
if (values$name == TRUE) { values$name <- FALSE}
else { values$name <- TRUE} )
observeEvent(input$ClickonMe2,
if (values$name == TRUE) { output$Response_text <- renderPrint( isolate({values$name}) ) }
else if (values$name == FALSE) { removeUI(
selector = "div:has(> #Response_text)"
)
}
) }
shinyApp(ui, server)
EDIT VERSION:
changed pork chops answer a little so that this version removes and remakes the verbatim element in the ui.
What i now try to fully understand is, is why the piece req(....) has such an impact. the print(values$name) proofs that the variable exist, and the observer sees it, yet if you # the req( ) line, suddenly the app stops recreating the verbatimtextouput after it has been removed the first time.
Hope I can learn why this is the case. Thank you!
library(shiny)
ui <- fluidPage(
h5("Hello there"), # First text on the window
br(), # empty line
actionButton(inputId = "ClickonMe", label = "Make data"), # button 1
actionButton(inputId = "ClickonMe2", label = "Print data"), # button 2
actionButton(inputId = "ClickonMe3", label = "Transform data"),
mainPanel(verbatimTextOutput("Response_text"))
)
server <- function(input,output,session) {
values <- reactiveValues()
values$name <- T
observeEvent(input$ClickonMe,{
values$name <- T
})
observeEvent(input$ClickonMe3,{
if (values$name){ values$name <- F}
else{ values$name <- T }
})
observeEvent(input$ClickonMe2,{
print(values$name)
output$Response_text <- renderPrint({ isolate({
req(values$name)
if(!values$name){
removeUI(
selector = "div:has(> #Response_text)"
)
}else {
as.character(values$name)}
})
})
})
}

1) First of all please have a look at the Google's R Style Guide when writing code and try to stick to it I think both you and your students will benefit from it.
2) Use curly braces too when using functions such as observeEvent and renderPrint
3) Familiarise yourself with req function which is very handy
Sample Code how to remove UI:
library(shiny)
ui <- fluidPage(
h5("Hello there"), # First text on the window
br(), # empty line
actionButton(inputId = "ClickonMe", label = "Make data"), # button 1
actionButton(inputId = "ClickonMe2", label = "Print data"), # button 2
actionButton(inputId = "ClickonMe3", label = "Transform data"),
mainPanel(verbatimTextOutput("Response_text"))
)
server <- function(input,output,session) {
values <- reactiveValues()
values$name <- NULL
observeEvent(input$ClickonMe,{
values$name <- T
})
observeEvent(input$ClickonMe3,{
if (values$name){
values$name <- F}
else{
values$name <- T
}
})
observeEvent(input$ClickonMe2,{
if (values$name){
values$name <- F
}
else{
values$name <- T
}
})
output$Response_text <- renderPrint({
req(values$name)
if(!values$name){
removeUI(
selector = "div:has(> #Response_text)"
)
}
as.character(values$name)})
}
shinyApp(ui, server)

Related

Why is removeUI leaving behind the UI label?

I am trying to increase and decrease the number of UI elements based on user input. This MRE code kind of works but it is leaving behind the UI label when I use removeUI, which I did not expect. Any ideas on how to make the label go away along with the input box?
## Only run this example in interactive R sessions
if (interactive()) {
# Define UI
ui <- fluidPage(
numericInput(inputId = "assessors",label = "Number of Assessors",value = 1,min = 1,step = 1),
textInput(inputId = "assessor1",label = "Assessor 1 Columns")
)
# Server logic
server <- function(input, output, session) {
tot_app<-0
observeEvent(input$assessors, {
num<-input$assessors
if(num>tot_app){#add
adds<-seq(tot_app+1,num)
for(i in adds){
here<-paste0("#assessor",i-1)
insertUI(
selector = here,
where = "afterEnd",
ui = textInput(paste0("assessor", i),
paste0("Assessor ",i," columns"))
)
}
tot_app<<-num
} else if(num<tot_app){#subtract
subs<-seq(num+1,tot_app)
for(i in subs){
removeUI(selector = paste0("#assessor",i))
}
tot_app<<-num
}
})
}
# Complete app with UI and server components
shinyApp(ui, server)
}
As in the help example, it works if you use use this syntax:
removeUI(selector = paste0("div:has(> #assessor",i,")"))

How to add a spinner before a selectizeInput has loaded all the choices? [Shiny]

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")

How to hide multiple shiny ui by condition, and how to use session$userData?

I am a beginer of shiny, and I am building a shiny app using win10 system, rstudio, and shiny version 1.7.1. I would like to make it more user oriented. It means that other parts of the application will be hid unless user uploads correct data. After many attempts, I decided to use session$userData and shinyjs::toggle to develop this app. But I am confused by session$userData. In the beginning, by reading the official documentation, I think it just like the global environment of r. But obviously not. So I just want to know how to use it correctly, or how to realize the features I want. There are three examples I had tried, they are for your reference.
Please note that the third example is almost what I want, but I don't think it's elegant since the continue button is somewhat redundant.
Examples 1:
I would like to check whether there is data input or whether the input data is a csv format, if true, show the data, and if not, the rest part of the app will be hid. In this case you can see, although you data have passed the check, the tablepanel b will still show nothing, unless before input data you have clicked tablepanel b, or unless after data checking you clicked button go again.
##### 1. packages #####
library(shiny)
library(shinyjs)
##### 2. ui #####
ui <- fluidPage(
useShinyjs(),
tabsetPanel(
tabPanel("a",
sidebarLayout(
sidebarPanel(uiOutput("ui_p1_sidebar1"), uiOutput("ui_p1_sidebar2")),
mainPanel(uiOutput("ui_p1_main"))
)),
tabPanel("b",
sidebarLayout(
sidebarPanel(uiOutput("ui_p2_sidebar")),
mainPanel(uiOutput("ui_p2_main"))
))
)
)
##### 3. server #####
server <- function(input, output, session) {
output$ui_p1_sidebar1 <- renderUI({
fileInput(inputId = "p1s_inputdata",
label = "Input data",
multiple = FALSE,
accept = ".csv")
})
output$ui_p1_sidebar2 <- renderUI({
shiny::actionButton(inputId = "p1s_go",
label = "go",
icon = icon("play"))
})
observeEvent(input$p1s_go,{
isolate({
data <- input$p1s_inputdata
})
output$ui_p1_main <- renderUI({
tagList(
h3("Data check: "),
verbatimTextOutput(outputId = "p1m_datacheck", placeholder = T),
h3("Data show: "),
verbatimTextOutput(outputId = "p1m_datashow", placeholder = T),
)
})
output$p1m_datacheck <- renderPrint({
# data check part, the result of checking is stored by session$userData$sig
if(is.null(data)){
cat("There is no data input! \n")
session$userData$sig <- F
} else{
dataExt <- tools::file_ext(data$name)
if(dataExt != "csv"){
cat("Please input csv data! \n")
session$userData$sig <- F
} else{
cat("Data have passed the check!")
session$userData$data <- read.csv(data$datapath)
session$userData$sig <- T
}
}
})
output$p1m_datashow <- renderPrint({
if(session$userData$sig){
print(session$userData$data)
} else{
cat("Please check the data!")
}
})
output$ui_p2_sidebar <- renderUI({
radioButtons("aaa", "aaa", choices = c("a", "b", "c"))
})
output$ui_p2_main <- renderUI({
verbatimTextOutput(outputId = "p2m_print", placeholder = T)
})
output$p2m_print <- renderPrint({print(letters[1:10])})
observe({
toggle(id = "ui_p2_sidebar", condition = session$userData$sig)
toggle(id = "ui_p2_main", condition = session$userData$sig)
})
})
}
##### 4. app #####
shinyApp(ui = ui, server = server)
Example 2:
In this small case you can see, in a samle module, session$userData$... changed timely, but in another module, it will not change unless you click the button again. It that means session$userData$... could have different values at the same time?
##### 1. packages #####
library(shiny)
##### 2. ui #####
ui <- fluidPage(
sidebarLayout(
sidebarPanel(uiOutput("ui_sidebar")),
mainPanel(uiOutput("ui_main1"), uiOutput("ui_main2"))
)
)
##### 3. server #####
server <- function(input, output, session) {
output$ui_sidebar <- renderUI({
tagList(
radioButtons("s_letter", "letters", choices = c("a", "b", "c")),
shiny::actionButton(inputId = "go1",
label = "GO1",
icon = icon("play"))
)
})
observeEvent(input$go1, {
output$ui_main1 <- renderUI({
tagList(
h3("module 1: shared value changes timely."),
verbatimTextOutput(outputId = "m1", placeholder = T),
h3("module 2: shared value changes by button."),
verbatimTextOutput(outputId = "m2", placeholder = T)
)
})
output$m1 <- renderPrint({
out <- switch (input$s_letter,
"a" = "choose a",
"b" = "choose b",
"c" = "choose c")
session$userData$sharedout <- out
cat("out: \n")
print(out)
cat("sharedout: \n")
print(session$userData$sharedout)
})
output$m2 <- renderPrint({
cat("sharedout: \n")
print(session$userData$sharedout)
})
})
}
##### 4. app #####
shinyApp(ui = ui, server = server)
Example 3: I also tried other solutions. There is a modification of example 1, I have added a continue button to realize my thought. It works well, but I hope the hidden action is based on conditions rather than events. So how to remove the button and let the rest part displayed automatically if data passed checking?
##### 1. packages #####
library(shiny)
##### 2. ui #####
ui <- fluidPage(
tabsetPanel(
tabPanel("a",
sidebarLayout(
sidebarPanel(uiOutput("ui_p1_sidebar1"), uiOutput("ui_p1_sidebar2")),
mainPanel(uiOutput("ui_p1_main"))
)),
tabPanel("b",
sidebarLayout(
sidebarPanel(uiOutput("ui_p2_sidebar")),
mainPanel(uiOutput("ui_p2_main"))
))
)
)
##### 3. server #####
server <- function(input, output, session) {
output$ui_p1_sidebar1 <- renderUI({
fileInput(inputId = "p1s_inputdata",
label = "Input data",
multiple = FALSE,
accept = ".csv")
})
output$ui_p1_sidebar2 <- renderUI({
shiny::actionButton(inputId = "p1s_go",
label = "go",
icon = icon("play"))
})
observeEvent(input$p1s_go,{
isolate({
data <- input$p1s_inputdata
})
output$ui_p1_main <- renderUI({
tagList(
h3("Data check: "),
verbatimTextOutput(outputId = "p1m_datacheck", placeholder = T),
uiOutput("ispass"),
h3("Data show: "),
verbatimTextOutput(outputId = "p1m_datashow", placeholder = T)
)
})
output$p1m_datacheck <- renderPrint({
if(is.null(data)){
cat("There is no data input! \n")
session$userData$sig <- F
} else{
dataExt <- tools::file_ext(data$name)
if(dataExt != "csv"){
cat("Please input csv data! \n")
session$userData$sig <- F
} else{
cat("Data have passed the check!")
session$userData$data <- read.csv(data$datapath)
session$userData$sig <- T
}
}
})
output$ispass <- renderUI({
if(isFALSE(session$userData$sig)){
return()
} else{
shiny::actionButton(inputId = "ispass",
label = "continue",
icon = icon("play"))
}
})
})
observeEvent(input$ispass,{
output$p1m_datashow <- renderPrint({
if(session$userData$sig){
print(session$userData$data)
} else{
cat("Please check the data!")
}
})
output$ui_p2_sidebar <- renderUI({
radioButtons("aaa", "aaa", choices = c("a", "b", "c"))
})
output$ui_p2_main <- renderUI({
verbatimTextOutput(outputId = "p2m_print", placeholder = T)
})
output$p2m_print <- renderPrint({print(letters[1:10])})
})
}
##### 4. app #####
shinyApp(ui = ui, server = server)
I hope the following refactoring will help and does what you want.
An essential tool for hiding,showing and updating UI elements can be the renderUI, but often this is overkill because of rerenderings.
But I would suggest using the shinyjs-package which gives you functions like shinyjs::show and shinyjs::hide for showing and hiding. For updating UI-elements, there are functions like shiny::updateActionButton,shiny::updateCheckboxInput, shiny::updateRadioButtons, ....
It is (always) useful to give your UI-elements IDs, like the tabsetPanel.
Moreover, a nice tool too is shiny::conditionalPanel, but you will dive into all this stuff when programming more apps. :)
##### 1. packages #####
library(shiny)
myapp <- function() {
##### 2. ui #####
ui <- fluidPage(
tabsetPanel(
tabPanel("a",
sidebarLayout(
sidebarPanel(
fileInput(inputId = "p1s_inputdata", label = "Input data", multiple = FALSE, accept = ".csv")
),
mainPanel(uiOutput("ui_p1_main"))
)),
tabPanel("b",
sidebarLayout(
sidebarPanel(radioButtons("aaa", "aaa", choices = c("some", "placeholder", "stuff"))),
mainPanel(verbatimTextOutput(outputId = "p2m_print", placeholder = T))
)),
id = "TABSETPANEL"
)
)
##### 3. server #####
server <- function(input, output, session) {
shiny::hideTab(inputId = "TABSETPANEL", target = "b", session = session)
observeEvent(input$p1s_inputdata, {
data <- input$p1s_inputdata
dataCheckText <- NULL
if(is.null(data)){
dataCheckText <- "There is no data input!"
session$userData$sig <- F
} else{
dataExt <- tools::file_ext(data$name)
if(dataExt != "csv"){
dataCheckText <- "Please input csv data!"
session$userData$sig <- F
} else{
dataCheckText <- "Data have passed the check!"
session$userData$data <- read.csv(data$datapath)
session$userData$sig <- T
}
}
output$p1m_datacheck <- renderPrint(dataCheckText)
if(session$userData$sig) shiny::showTab(inputId = "TABSETPANEL", target = "b", session = session)
else shiny::hideTab(inputId = "TABSETPANEL", target = "b", session = session)
main1Taglist <- tagList(
h3("Data check: "),
verbatimTextOutput(outputId = "p1m_datacheck", placeholder = T)
)
if(session$userData$sig) {
shiny::showTab(inputId = "TABSETPANEL", target = "b", session = session)
output$p1m_datashow <- renderPrint({
print(session$userData$data)
})
main1Taglist <- c(main1Taglist, tagList(
h3("Data show: "),
verbatimTextOutput(outputId = "p1m_datashow", placeholder = T)
))
#Update stuff in panel b according to the new data
updateRadioButtons(session = session, inputId = "aaa", choices = names(session$userData$data))
output$p2m_print <- renderPrint({print(letters[1:10])})
}
output$ui_p1_main <- renderUI(main1Taglist)
})
}
##### 4. app #####
shinyApp(ui = ui, server = server)
}
myapp()
You're somewhat on the right track. Try something like this:
observeEvent(input$go1, {
# Perform data validation here.
# This would look similar to what you have inside output$p1m_datacheck <- renderPrint({})
# If data file is no good, do nothing, exit this function: return()
# Else, data file is good, continue
# Do your output$* <- render*() functions here
})
You don't need to isolate() inside the handlerExpr of observeEvent(). It will already be executed in an isolate() scope.

observeenvent with two conditions

I have tried to nest some "observe events" in Shiny to create a conditional rule.
It should go like this :
if one box is clicked display the corresponding single output when the button is clicked.
if both boxes are clicked display both outputs when the button is clicked.
but it always displays both outputs.
Any suggestion?
shinyApp(
ui = basicPage(
checkboxInput("box1", label = "Checkbox1", value = FALSE),
checkboxInput("box2", label = "Checkbox2", value = FALSE),
actionButton('buttn', 'Validate'),
verbatimTextOutput("out1"),
verbatimTextOutput("out2")
),
server = function(input, output) {
observeEvent(input$buttn, {
observeEvent(input$box1, {
output$out1 <- renderText({"Foo"})});
observeEvent(input$box2, {
output$out2 <- renderText({"bar"})})
})
}
)
Please note that it is bad practice to put observeEvents or reactives inside other observeEvents. See this slide and the two after it from a presentation by Joe Cheng.
One possible solution is to simply show or hide elements with the shinyjs package. A working example is given below.
Another solution is to use reactiveVal to hold the text to be displayed, and update that from your observer.
Hope this helps!
Solution 1
library(shiny)
library(shinyjs)
ui <- basicPage(
checkboxInput("box1", label = "Checkbox1", value = FALSE),
checkboxInput("box2", label = "Checkbox2", value = FALSE),
actionButton('buttn', 'Validate'),
shinyjs::hidden(div(id='div1', verbatimTextOutput("out1"))),
shinyjs::hidden(div(id='div2', verbatimTextOutput("out2"))),
useShinyjs()
)
server <- function(input, output) {
observeEvent(input$buttn, {
if(input$box1)
shinyjs::show('div1')
else
shinyjs::hide('div1')
if(input$box2)
shinyjs::show('div2')
else
shinyjs::hide('div2')
})
output$out1 <- renderText({"Foo"})
output$out2 <- renderText({"bar"})
}
shinyApp(ui,server)
Solution 2
library(shiny)
library(shinyjs)
ui <- basicPage(
checkboxInput("box1", label = "Checkbox1", value = FALSE),
checkboxInput("box2", label = "Checkbox2", value = FALSE),
actionButton('buttn', 'Validate'),
verbatimTextOutput("out1"),
verbatimTextOutput("out2")
)
server <- function(input, output) {
text1 <- reactiveVal(NULL)
text2 <- reactiveVal(NULL)
observeEvent(input$buttn, {
ifelse(input$box1,text1('Foo'),text1(NULL))
ifelse(input$box2,text2('Bar'),text2(NULL))
})
output$out1 <- renderText({text1()})
output$out2 <- renderText({text2()})
}
shinyApp(ui,server)
You don't need the extra event observers. Just observe the button click and use standard R conditional logic to adjust the output based on the checkboxes.
shinyApp(
ui = basicPage(
checkboxInput("box1", label = "Checkbox1", value = FALSE),
checkboxInput("box2", label = "Checkbox2", value = FALSE),
actionButton('buttn', 'Validate'),
verbatimTextOutput("out1"),
verbatimTextOutput("out2")
),
server = function(input, output) {
observeEvent(input$buttn, {
if (input$box1) {
output$out1 <- renderText({"Foo"})
}
if (!input$box1) {
output$out1 <- renderText({NULL})
}
if (input$box2) {
output$out2 <- renderText({"Bar"})
}
if (!input$box2) {
output$out2 <- renderText({NULL})
}
})
}
)

shiny - actionButton #1 works exact same actionButton #2 doesnt

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)
})
})

Resources