I'm writing a Shiny app with ShinyAce in order to display reactive code. I used the first example of https://trestletech.github.io/shinyAce/ as a base for my code but I have a problem concerning reactive checkboxInput.
I would like to reactively display some code : for example, if I tick a box, then some code appears and if I un-tick it, the code goes back to normal. This works with actionButton (cf example on the website) but I can't figure out why it does not with checkboxInput.
Here's a reproducible example :
library(shiny)
library(shinyAce)
init <- "first text"
ui <- shinyUI(
pageWithSidebar(
headerPanel(""),
sidebarPanel(
actionButton("reset", "Reset"),
checkboxInput("test", "Test", FALSE)
),
mainPanel(
aceEditor(
outputId = "ace",
selectionId = init
)
)
)
)
server <- shinyServer(function(input, output, session) {
observe({
cat(input$ace, "\n")
})
observeEvent(input$reset, {
updateAceEditor(session, "ace", value = init)
})
observeEvent(input$test, {
updateAceEditor(session, "ace", value = "Second text")
})
})
shinyApp(ui = ui, server = server)
This is a slightly modified version of your answer. I'm using the boolean result of the checkbox input to conditionally update the Ace editor.
init <- "first text"
ui <- shinyUI(
pageWithSidebar(
headerPanel(""),
sidebarPanel(
actionButton("reset", "Reset"),
checkboxInput("test", "Test", FALSE)
),
mainPanel(
aceEditor(
outputId = "ace",
value = init
)
)
)
)
server <- shinyServer(function(input, output, session) {
observe({
cat(input$ace, "\n")
print(input$test)
})
observe({
if(input$test){
updateAceEditor(session, "ace", value = "Second text")
} else {
updateAceEditor(session, "ace", value = init)
}})
observeEvent(input$reset, {
updateAceEditor(session, "ace", value = init)
})
})
shinyApp(ui = ui, server = server)
Related
I need to perform a calculation (parameters to define it are in the sidebar) and, once done, move to the plot to see final results (tab2) and not see tab1. So, I'd like that "Predict" (action) button follows the order and moves to second tab.
I tried something like that, but Shiny's world is very new for me:
ui <- bootstrapPage(
fluidPage(
sidebarLayout(sidebarPanel(
uiOutput('manySliders'),
actionButton('add', 'Predict'),
br(), br(),
helpText('Press Quit to exit the application'),
actionButton('quit', 'Quit')),
mainPanel(tabsetPanel(id = 'tabs',
tabPanel('tab1', uiOutput('markdown')),
tabPanel('tab2', plotOutput('plot'))
)
)
))
server <- function(input, output, session){
...
new.d <- reactive({
input$add
isolate(observeEvent(input$add, {updateTabsetPanel(session, "tab1", selected = 'tab2')}))
...
}
Please never nest observeEvent in reactive. You can use bindEvent or eventReactive. Furthermore updateTabsetPanel needs the inputId of the element to update (not the currently active tabname):
library(shiny)
ui <- bootstrapPage(
fluidPage(
sidebarLayout(sidebarPanel(
uiOutput('manySliders'),
actionButton('add', 'Predict'),
br(), br(),
helpText('Press Quit to exit the application'),
actionButton('quit', 'Quit')),
mainPanel(tabsetPanel(id = 'tabs',
tabPanel('tab1', uiOutput('markdown')),
tabPanel('tab2', plotOutput('plot'))
)
)
)
)
)
server <- function(input, output, session){
observeEvent(input$add, {
updateTabsetPanel(session, inputId = "tabs", selected = 'tab2')
})
result <- eventReactive(input$add, {
return(1:10)
})
output$plot <- renderPlot({
plot(result())
})
}
shinyApp(ui, server)
I have the following app which allows for text to be entered and it is then saved as VALUE and printed on a panel.
Although it looks like I can only do this with one text input at a time - even if I click add (so I don't believe this button is working). On top of that I would like for the user to be able to add multiple inputs (like I have below).
And then my VALUE function should be list with multiple inputs.
code below
library(shiny)
ui <- fluidPage(
headerPanel("R Package App"),
sidebarPanel(
# selectInput("options", "options", choices=c('abc','def')),
textInput("textbox", "Enter R Package Name", ""),
actionButton("add","Add")
),
mainPanel(
textOutput("caption")
)
)
server <- function(input, output, session) {
observe({
VALUE <- ''
if(input$add>0) {
isolate({
VALUE <- input$textbox
})
}
updateTextInput(session, inputId = "textbox", value = VALUE)
})
output$caption <- renderText({
input$textbox
})
}
shinyApp(ui = ui, server = server)
Have you considered using selectizeInput with it's create option?
library(shiny)
packagesDF <- as.data.frame(installed.packages())
ui <- fluidPage(
headerPanel("R Package App"),
sidebarPanel(
selectizeInput(
inputId = "selectedPackages",
label = "Enter R Package Name",
choices = packagesDF$Package,
selected = NULL,
multiple = TRUE,
width = "100%",
options = list(
'plugins' = list('remove_button'),
'create' = TRUE,
'persist' = TRUE
)
)
),
mainPanel(textOutput("caption"))
)
server <- function(input, output, session) {
output$caption <- renderText({
paste0(input$selectedPackages, collapse = ", ")
})
}
shinyApp(ui = ui, server = server)
If you run this app 'a' the default selected value does not appear until the UI tab is selected
and the UI element which populates 'input$select' is generated. How can I force this element to be created when the app is loaded without the need to click on the panel to initialize it in order to get access to its default value.
library(shiny)
library(shinydashboard)
ui <- fluidPage(
tabsetPanel(
tabPanel(
title = "landing",
"Stuff"
),
tabPanel(
title = "UI",
uiOutput("select")
)
),
textOutput("out")
)
server <- function(input, output, session) {
output$select <- renderUI(
selectInput(
"select", "Selector:", choices = c("a", "b"), selected = "a"
)
)
output$out <- renderText(input$select)
}
shinyApp(ui, server)
You can use the argument suspendWhenHidden = FALSE from outputOptions. I had to play a bit where to place outputOptions (it doesn't work at the beginning of the server function). However, it still needs a little bit of time to load, so maybe one could optimise it further.
library(shiny)
library(shinydashboard)
ui <- fluidPage(
tabsetPanel(
tabPanel(
title = "landing",
"Stuff"
),
tabPanel(
title = "UI",
uiOutput("select")
)
),
textOutput("out")
)
server <- function(input, output, session) {
output$select <- renderUI({
selectInput(
"select", "Selector:", choices = c("a", "b"), selected = "a"
)
})
output$out <- renderText(input$select)
outputOptions(output, "select", suspendWhenHidden = FALSE)
}
shinyApp(ui, server)
I am trying to implement something similar to this within the app and not at the browser level as described here.
After capturing the value of the new tab (tabPanel value) selected, could not display the confirmation message before switching to the newly selected tab to display its content.
library(shiny)
library(ggplot2)
library(shinyalert)
ui <- fluidPage(useShinyalert(),
tabsetPanel(id = "tabselected",
tabPanel("Tab1"),
tabPanel("Tab2",plotOutput("plot"))
)
)
server <- function(input, output) {
observeEvent(input$tabselected, {
if(input$tabselected == "Tab2")
{
shinyalert(title = "Save your work before changing tab", type = "warning", showConfirmButton = TRUE)
output$plot <- renderPlot({ ggplot(mtcars)+geom_abline() })
}
})
}
shinyApp(ui = ui, server = server)
You can simply redirect to Tab1 via updateTabsetPanel as long as your desired condition is met.
Here is an example requiring the user to type something in the textInput before it's allowed to switch the tab.
library(shiny)
library(ggplot2)
library(shinyalert)
ui <- fluidPage(useShinyalert(),
tabsetPanel(
id = "tabselected",
tabPanel("Tab1", p(), textInput("requiredText", "Required Text")),
tabPanel("Tab2", p(), plotOutput("plot"))
))
server <- function(input, output, session) {
observeEvent(input$tabselected, {
if (input$tabselected == "Tab2" && !isTruthy(input$requiredText)) {
updateTabsetPanel(session, inputId = "tabselected", selected = "Tab1")
shinyalert(title = "Save your work before changing tab",
type = "warning",
showConfirmButton = TRUE)
output$plot <- renderPlot({
ggplot(mtcars) + geom_abline() + ggtitle(req(input$requiredText))
})
}
})
}
shinyApp(ui = ui, server = server)
By the way an alternative approach wpuld be using showTab and hideTab to display the tabs only if all conditions are fulfilled.
In a Shiny app I create radioButtons dynamically on the server and use renderUI to pass this to the client. Now I have a problem of getting the response of the radioButtons (selected item) back for further processing. Below the stripped down version of my problem.
library(shiny)
ui <- shinyUI(pageWithSidebar(
headerPanel("test dynamic radio buttons"),
sidebarPanel(
),
mainPanel(
x <- uiOutput('radioTest'),
actionButton('submit', label = "Submit"),
br(),
print(paste("Radiobutton response is:", "reply()")),
textOutput('text')
)
))
server <- shinyServer(
function(input, output) {
output$radioTest <- renderUI({
options <- c("item 1", "item 2", "item 3")
# The options are dynamically generated on the server
radioButtons('reply', 'What item do you select ?', options, selected = character(0))
})
observe({
input$submit
isolate(
output$text <- renderText({
paste("Radiobutton response is:", "reply()" )
})
)
})
}
)
# Run the application
shinyApp(ui = ui, server = server)
Do you want something like the following?
library(shiny)
ui <- shinyUI(pageWithSidebar(
headerPanel("test dynamic radio buttons"),
sidebarPanel(
),
mainPanel(
x <- uiOutput('radioTest'),
actionButton('submit', label = "Submit"),
br(),
#print(paste("Radiobutton response is:", "reply")),
textOutput('text')
)
))
server <- shinyServer(
function(input, output) {
output$radioTest <- renderUI({
options <- c("item 1", "item 2", "item 3")
# The options are dynamically generated on the server
radioButtons('reply', 'What item do you select ?', options, selected = character(0))
})
observe({
input$submit
isolate(
output$text <- renderText({
paste("Radiobutton response is:", input$reply )
})
)
})
}
)
# Run the application
shinyApp(ui = ui, server = server)