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,")"))
Related
I have asked this question in the RStudio community and didn't get help, so I try it here:
I am trying to add the following functionality to my app: When the user inserts a plot, a remove button should appear that specifically removes the plot that was inserted at the same time. The app is based on insertUI and removeUI.
This would be the example app.
library(shiny)
library(shinydashboard)
# Example data
a<-(letters)
b<-rnorm(length(letters), 4,2)
c<-rnorm(length(letters), 10,15)
d<-c(1:10,20:30,45:49)
data<-data.frame(a,b,c,d)
names(data)<-c("name","v1","v2","v3")
# UI
ui <- dashboardPage(
dashboardHeader(),
dashboardSidebar(
actionButton("add", "Add"),
radioButtons("add_elements","", c("Element1", "Element2"))
),
dashboardBody(
fluidRow( tags$div(id="placeholder")
)
))
# Server Logic
server <- function(input, output, session) {
# Initialize empty vector
inserted<- c()
# Observer
observeEvent(input$add, {
id_add <- paste0(input$add, input$add_elements)
insertUI(selector = '#placeholder', where = "afterEnd",
ui= switch(input$add_elements,
'Element1'= plotOutput(id_add),
'Element2' = plotOutput(id_add))
)
output[[id_add]] <-
if (input$add_elements == "Element1")
renderPlot({
plot(data[,1],data[,2])
}) else if (input$add_elements == "Element2")
renderPlot({
plot(data[,1],data[,4])
})
inserted <<- c(id_add,inserted)
insertUI(
selector = "#placeholder",
where = "afterEnd",
ui = tags$div(actionButton("remove_button", "Remove"))
)})
## Remove Elements ###
observeEvent(input$remove_button, {
removeUI(
selector = paste0('#', inserted[length(inserted)])
)
inserted <<- inserted[-length(inserted)]
})
}
shinyApp(ui = ui, server = server)
When a plot is inserted, it gets an ID, such as 1Element1 or 2Element2. I am now wondering how could a remove button only refer to a plot with this exact ID?
So far, I have worked with a single remove button that removes the last inserted plot by defining a vector that stores the IDs.
selector = paste0('#', inserted[length(inserted)])
This is not very useful when a user needs to compare many plots. I have a limited understanding in using these selectors and absolutely no idea how could incorporate a remove button for every plot that only removes the respective plot. Any help would be highly appreciated.
Also, this link may help since it shows a similar functionality (that I was obviously not able to implement).
In this kind of situation I always use 'list' with 'reactiveValues' like below:
library(shiny)
library(shinydashboard)
# Example data
a<-(letters)
b<-rnorm(length(letters), 4,2)
c<-rnorm(length(letters), 10,15)
d<-c(1:10,20:30,45:49)
data<-data.frame(a,b,c,d)
names(data)<-c("name","v1","v2","v3")
# UI
ui <- dashboardPage(
dashboardHeader(),
dashboardSidebar(
actionButton("add", "Add"),
radioButtons("add_elements","", c("Element1", "Element2"))
),
dashboardBody(
uiOutput("myUI")
))
# Server Logic
server <- function(input, output, session) {
alld <- reactiveValues()
alld$ui <- list()
output$myUI <- renderUI({
alld$ui
})
# Observer
observeEvent(input$add, {
id_add <- length(alld$ui)+1
alld$ui[[id_add]] <- list(
plotOutput(paste0("plt",id_add)),
actionButton(paste0("remove_button", id_add), "Remove")
)
if (input$add_elements == "Element1"){
output[[paste0("plt",id_add)]] <- renderPlot(plot(data[,1],data[,2]))
} else {
output[[paste0("plt",id_add)]] <- renderPlot(plot(data[,1],data[,4]))
}
})
## Remove Elements (for all plots) ###
observe({
lapply(seq_len(length(alld$ui)), function(i){
id_add <- i
observeEvent(input[[paste0("remove_button", id_add)]], {
alld$ui[[id_add]][1] <- NULL
})
})
})
}
shinyApp(ui = ui, server = server)
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})
}
})
}
)
I've been trying to generate a Shiny page where elements can be added or removed by the user - based on this snippet. I tried to adapt it for UI elements rather than buttons, but I've clearly done something wrong.
I've only included the add-button part here - each time the "add" button is clicked, the correct number of UI elements are added, but they seem to all be the same element rather just appending a new one to the existing list (the number in the label is the same, whereas it should be different for each one) and the initial text values are erased (or, potentially, are just the "default" from the final element repeated however many times).
How can I just add a new UI element and keep any text input that the user has entered in the already-existing elements?
Code:
library(shiny)
# function to render UI element
renderUiElement <- function(id, nameDef) {
renderUI(box(
actionButton(paste0("rmBtn", id), label = "", icon = icon("times")),
# text initial value supplied as a variable
textInput(paste0("nameText", id), label = paste("Item", id), value = nameDef)
))
}
server <- function(input, output, session) {
rv <- reactiveValues(uiComponents = list(), uiIds = list(),
nameVals = list(), lastId = 0)
# on "Add" button click:
observe({
if(is.null(input$addBtn) || input$addBtn == 0) return()
isolate({
# store current text inputs and append new default text
rv$nameVals <- lapply(rv$uiIds, function(x) input[[paste0("nameText", x)]])
rv$nameVals <- append(rv$nameVals, "New Text")
# create (and store) new id number and add it to the list of ids in use
rv$lastId <- rv$lastId + 1 # get the new code to use for these UI elements
rv$uiIds <- append(rv$uiIds, rv$lastId)
# for each id, render the UI element using the appropriate default text
for(i in seq_along(rv$uiIds)) {
thisId <- rv$uiIds[[i]]
output[[paste0("uiEl", thisId)]] <- renderUiElement(
id = thisId, nameDef = rv$nameVals[[i]]
)
}
# add the new UI element into the reactiveValues list
rv$uiComponents <- append(
rv$uiComponents,
list(
list(
uiOutput(paste0("uiEl", rv$lastId)),
br(),br()
)
)
)
})
})
# render all the UI elements inside the container
output$container <- renderUI({
rv$uiComponents
})
}
ui <- fluidPage(
titlePanel("Dynamically Add/Remove UI Elements"),
hr(),
actionButton("addBtn", "Add"),
br(),br(),
uiOutput("container")
)
shinyApp(ui, server)
Hi to dynamicly add objects shiny has the function insertUI.
Your code would look like something similar to this
library(shiny)
library(shinydashboard)
# function to render UI element
renderUiElement <- function(id, nameDef) {
box(
actionButton(paste0("rmBtn", id), label = "", icon = icon("times")),
# text initial value supplied as a variable
textInput(paste0("nameText", id), label = paste("Item", id), value = nameDef)
)
}
server <- function(input, output, session) {
# on "Add" button click:
counter <- 0
observeEvent(
input$addBtn,
{
counter <<- counter +1
insertUI(
selector = '#container',
where = "beforeEnd",
ui = renderUiElement(
id = paste0("ui",counter),
nameDef = "New Text"
),
session = session
)
},
ignoreNULL = TRUE,
ignoreInit = TRUE
)
output$container <- renderUI({
div()
})
}
ui <- fluidPage(
titlePanel("Dynamically Add/Remove UI Elements"),
hr(),
actionButton("addBtn", "Add"),
br(),br(),
uiOutput("container")
)
shinyApp(ui, server)
Hope it helps.
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)
I know that similar question was already answered, however the solution creates a new actionButton with different label upon string-input. What I need is to keep the button(the counter of the button), because when I change the label and create a new button it has a counter of 0(not clicked).
So basically I need something like an update function to just change the label of the actionButton, when it is pressed. You press it once and the label changes.
input$Button <- renderUI({
if(input$Button >= 1) label <- "new label"
else label <- "old label"
actionButton("Button", label = label)
})
Something like this, but without reseting the value of the button(by creating a whole new one).
Thanks!
reactiveValues() can help. Check http://shiny.rstudio.com/articles/reactivity-overview.html for details.
In the following example, I renamed your input$Button to input$click to avoid double usage of the "Button" name.
Since we wrap the label in a renderUI(), input$click initially fires once it is created?!?, that's why I put the label
condition as: if(vars$counter >= 2)
An alternative solution could be to remove the read-only attribute (found here: https://github.com/rstudio/shiny/issues/167)
attr(input, "readonly") <- FALSE
input$click <- 1
For an example
paste the following in your R console:
ui <- bootstrapPage(
uiOutput('Button')
)
server <- function(input, output) {
# store the counter outside your input/button
vars = reactiveValues(counter = 0)
output$Button <- renderUI({
actionButton("click", label = label())
})
# increase the counter
observe({
if(!is.null(input$click)){
input$click
isolate({
vars$counter <- vars$counter + 1
})
}
})
label <- reactive({
if(!is.null(input$click)){
if(vars$counter >= 2) label <- "new label"
else label <- "old label"
}
})
}
# run the app
shinyApp(ui = ui, server = server)
You can use updateActionButton from native shiny package:
ui <- fluidPage(
actionButton('someButton', ""),
h3("Button value:"),
verbatimTextOutput("buttonValue"),
textInput("newLabel", "new Button Label:", value = "some label")
)
server <- function(input, output, session) {
output$buttonValue <- renderPrint({
input$someButton
})
observeEvent(input$newLabel, {
updateActionButton(session, "someButton", label = input$newLabel)
})
}
shinyApp(ui, server)
A few years later some small addition: If you want to switch between button icons, e.g. play / pause button (and switching between labels would be similar) you could do something like this (based on shosaco's answer).
library(shiny)
ui <- fluidPage(
fluidRow(
actionButton("PlayPause", NULL, icon = icon("play"))
)
)
server <- function(input, output, session) {
# whenever the ActionButton is clicked, 1 is added to input$PlayPause
# check if input$PlayPause is even or odd with modulo 2
# (returns the remainder of division by 2)
observeEvent(input$PlayPause, {
if (input$PlayPause %% 2 != 0) {
updateActionButton(session, "PlayPause", NULL, icon = icon("pause"))
} else {
updateActionButton(session, "PlayPause", NULL, icon = icon("play"))
}
})
}
shinyApp(ui = ui, server = server)