I want to take a user's input and store it as a variable that will be used in a plotting function. My code:
ui <- fluidPage(
mainPanel(
plotlyOutput("plot", width = '100%'),
br(),
textAreaInput("list", "Input List", ""),
actionButton("submit", "Submit", icon = icon("refresh"), style="float:right")
))
server <- function(input, output, session) {
my_text <<- renderText({
req(input$submit)
return(isolate(input$list))
my_text ->> subv
})
bindEvent(my_text,
output$plot <- renderPlotly({
#my very long plot code goes here which takes subv as input. This part has been tested outside of shiny and I know works.
}
I am trying to store the text in the subv variable as it will dictate what the renderPlotly will generate. When I hit submit nothing happens and the variable is only created after the session ends. The newly created subv variable in my environment does not show the text that was inputted but lists subv as an empty function i.e. subv function(...)
Below you can find a working prototype of what you would like to achieve with some information on what the issues were
First, we need to have a textOutput where our text will be shown. I understand this may not be necessary for the actual use case but it is important for this answer's demonstration purposes.
Next, we should not need to set variables to global via <<- or ->>. This is generally not good practice. Instead, we should store our result in a reactive. See also reactiveVals (but this is harder to follow when the app gets complex).
Since we need to only get the value when we click submit, we should use an event bind to only run when we click submit. This is essentially similar to eventReactive.
Finally, we can use bindCache to cache our result on the input list.
ui <- fluidPage(
mainPanel(
plotlyOutput("plot", width = '100%'),
br(),
textAreaInput("list", "Input List", ""),
actionButton("submit", "Submit", icon = icon("refresh"),
style="float:right"),
textOutput("hello_out")
))
server <- function(input, output, session) {
my_text <- reactive({
input$list
}) %>%
shiny::bindCache(input$list
) %>%
shiny::bindEvent(input$submit)
output$hello_out <- renderText({
my_text()
})
}
shinyApp(ui, server)
Related
I am trying to create a shiny app where it allows you to select an input of what operation calculate. if the user chooses "Addition" it will show the two numeric input boxes (so they can input two numbers), if the user chooses "square" it will show only one numeric input box to square.
With this, I use conditionalPanel and if the condition is satisfied, it fetches through uiOutput() the numericInputs that I want. and same thing for square.
Now when I run this app, the conditional panels do not appear. Where did I go wrong? Thanks for checking out my question.
ui <- fluidPage( theme = shinytheme("slate"),
titlePanel("Basic Calculator"),
sidebarPanel(
selectInput("ops","Select what Operation use",choices = c("ADDITION","SQUARE")),
helpText("Please input the appropriate number depending on the operations"),
conditionalPanel("input.ops=='ADDITION'", uiOutput("var2")),
conditionalPanel("input.ops=='SQUARE'", uiOutput("var1"))
),#sidebar panel
)#fluidpage
server <- function(input, output) {
output$basicmath <- renderText( ifelse(input$ops=="ADDITION",input$a+input$b,
ifelse(input$ops=="SUBTRACTION",input$a-input$b,
ifelse(input$ops=="SQUARE",input$a*input$a,
ifelse(input$ops=="SQUARE ROOT",sqrt(input$a),
ifelse(input$ops=="MULTIPLICATION",input$a*input$b,"not a valid operation"))))),
output$var2 <- renderUI({
helpText("this will show to input two numerics to be added")
}) ,
output$var1 <- renderUI({
helpText("this will show to input one numeric to square")
})
)}
shinyApp(ui = ui, server = server)
The key issue you were having is that you put the uiOutputs inside the calculation output that you anticipated. It is better to separate them, since the calculation output won't run until it has the necessary prerequisite values (your input values). In addition, because you hadn't specified an output location for basicmath, the app didn't know where to put anything inside that call to renderText(). Below is working code that gets the right UI elements to appear.
One other thing you were missing in your renderUI was the use of tagList(). This helps ensure that all of your elements are packaged together, not just the last one.
Note that the math part does not work, but it looks like that was just a placeholder. When you do start to use it, be sure to use unique ids for each input. You have several instances of input$a and input$b, which probably isn't a workable approach.
library(shiny)
library(shinythemes)
ui <- fluidPage( theme = shinytheme("slate"),
titlePanel("Basic Calculator"),
sidebarPanel(
selectInput("ops","Select what Operation use",choices = c("ADDITION","SQUARE")),
helpText("Please input the appropriate number depending on the operations"),
conditionalPanel("input.ops=='ADDITION'", uiOutput("var2")),
conditionalPanel("input.ops=='SQUARE'", uiOutput("var1"))
),
mainPanel(
textOutput("basicmath")
)
)#fluidpage
server <- function(input, output) {
output$var2 <- renderUI({
tagList(
helpText("this will show to input two numerics to be added"),
splitLayout(
numericInput("var2a", label = "Input one number", value = NULL),
numericInput("var2b", label = "Input another number", value = NULL)
)
)
})
output$var1 <- renderUI({
tagList(
helpText("this will show to input one numeric to square"),
numericInput("var1a", label = "Input a number", value = NULL)
)
})
output$basicmath <- renderText( {ifelse(input$ops=="ADDITION",input$a+input$b,
ifelse(input$ops=="SUBTRACTION",input$a-input$b,
ifelse(input$ops=="SQUARE",input$a*input$a,
ifelse(input$ops=="SQUARE ROOT",sqrt(input$a),
ifelse(input$ops=="MULTIPLICATION",input$a*input$b,"not a valid operation")))))
})
}
shinyApp(ui = ui, server = server)
I have a Shiny app where I have a dynamically created tabsetPanel where each tab contains a table. I do not know how many tabs/tables will be created in each session by users. I understand that it is bad practice to put render* functions inside observe or observeEvent calls but I can't think of any other way to do this. A minimal example of what I'm trying to do is shown below, which just picks a data set randomly to display on a given tab. Essentially, I'm trying to figure out how to call my table renderers without putting them inside an observe. More generally, although I have read it is bad practice to do this, I would also appreciate an explanation of exactly why it's not a good thing to do:
library(shiny)
ui <- fluidPage(
sidebarLayout(
sidebarPanel(
numericInput("tabs", "Number of tabs", value = 5),
),
mainPanel(
uiOutput("mytabset")
)
)
)
server <- function(input, output) {
output$mytabset <- renderUI({
mytabs <- lapply(seq_len(input$tabs), function(x) {
tabPanel(
paste("Tab", x),
tableOutput(paste0("tab", x))
)
})
do.call(tabsetPanel, mytabs)
})
observe({
set.seed(1)
lapply(seq_len(input$tabs), function(x) {
output[[paste0("tab", x)]] <- renderTable({
sample(list(mtcars, iris, trees, cars), 1)
})
})
})
}
shinyApp(ui = ui, server = server)
I haven't used them in a while, but I think if you use modules, you can call them from outside of a reactive context, and won't need an observe..? :)
I am trying to find out how to show and hide my outputs like graphics and tabels each time when the user change something in the widgets. For instance I have a sliderInput for my variable called "gender" with 2 choices : male and female. I also have a button which executes estimations when the user click on it. I want to hide the outputs each time when the user changes at least one choice between the different widgets. For instance after one estimation the user decides to change only the level of education and when the user click on the sliderInput box, I would like to hide the previous results.
I tried to use the R package shinyjs and the functions hide/show but they are not working for outputs.
Do you have any idea how to do it without using shinyjs package?
Here is a part of my code:
shinyUI(fluidPage(
sidebarLayout(
fluidRow(
column(4, wellPanel(
fluidRow(
column(5,selectInput("gender",
label = div("Sexe",style = "color:royalblue"),
choices = list("Male", "Female"),
selected = "Female")),
# other different widjets..
column(8, plotOutput('simulationChange')),
column(4, tableOutput('simulationChangeTable'),
tags$style("#simulationChangeTable table {font-size:9pt;background-color: #E5E4E2;font-weight:bold;margin-top: 121px; margin-left:-30px;overflow:hidden; white-space:nowrap;text-align:left;align:left;}",
media="screen",
type="text/css"),
fluidRow(
column(6, tableOutput('simulationChangeEsperance'),
tags$style("#simulationChangeEsperance table {font-size:9pt;background-color: #E5E4E2;font-weight:bold;margin-top: -10px; margin-left:-30px;overflow:hidden; white-space:wrap;word-break: break-word;width:173px;text-align:left;}"))
)
)
)
)
)
))
shinyServer(function(input, output, session) {
# part of my server.R code
observe({
if (input$gender|input$age|input$birthplace|input$education){
shinyjs::hide("simulationChange")
shinyjs::hide("simulationChangeTable")
shinyjs::hide("simulationChangeEsperance")
}
})
Thank you.
The reason your code didn't work is because you didn't make a call to useShinyjs() (if you read the documentation or look at any examples of using shinyjs, you'll see that you HAVE to call useShinyjs() in the UI).
I couldn't replicate your code because it had too many errors, but just to demonstrate that it does work with outputs, here's a small example you can run. In your project, just add shinyjs::useShinyjs() somewhere in the UI.
library(shiny)
library(shinyjs)
ui <- fluidPage(
useShinyjs(),
actionButton("hideshow", "Hide/show plot"),
plotOutput("plot")
)
server <- function(input, output, session) {
output$plot <- renderPlot({
plot(rnorm(100))
})
observeEvent(input$hideshow, {
# every time the button is pressed, alternate between hiding and showing the plot
toggle("plot")
})
}
shinyApp(ui = ui, server = server)
As mentioned by Dieter in the comments you need to use conditionalPanel. For example, in your ui.R, instead of
plotOutput('simulationChange')
use
conditionalPanel("output.show", plotOutput('simulationChange'))
And in your server.R add the following:
values <- reactiveValues()
values$show <- TRUE
observe({
input$gender
input$age
input$birthplace
input$education
values$show <- FALSE
})
output$show <- reactive({
return(values$show)
})
Also, don't forget to change values$show, when clicking on your button:
observeEvent(input$button, {
...
values$show <- TRUE
})
The other answers here don't seem to provide the right/complete answer. The solution is actually quite simple.
You need to use outputOptions(output, 'show', suspendWhenHidden = FALSE)
Below is a sample code that displays the text inside a conditionalPanel if the dropdown selection is 2 and hides if it is 1.
library(shiny)
ui <- fluidPage(
selectInput("num", "Choose a number", 1:2),
conditionalPanel(
condition = "output.show",
"The selected number is 2 so this text is displayed. Change it back to 1 to hide."
)
)
server <- function(input, output, session) {
output$show <- reactive({
input$num == 2 # Add whatever condition you want here. Must return TRUE or FALSE
})
outputOptions(output, 'show', suspendWhenHidden = FALSE)
}
shinyApp(ui = ui, server = server)
I am trying to find out how to show and hide my outputs like graphics and tabels each time when the user change something in the widgets. For instance I have a sliderInput for my variable called "gender" with 2 choices : male and female. I also have a button which executes estimations when the user click on it. I want to hide the outputs each time when the user changes at least one choice between the different widgets. For instance after one estimation the user decides to change only the level of education and when the user click on the sliderInput box, I would like to hide the previous results.
I tried to use the R package shinyjs and the functions hide/show but they are not working for outputs.
Do you have any idea how to do it without using shinyjs package?
Here is a part of my code:
shinyUI(fluidPage(
sidebarLayout(
fluidRow(
column(4, wellPanel(
fluidRow(
column(5,selectInput("gender",
label = div("Sexe",style = "color:royalblue"),
choices = list("Male", "Female"),
selected = "Female")),
# other different widjets..
column(8, plotOutput('simulationChange')),
column(4, tableOutput('simulationChangeTable'),
tags$style("#simulationChangeTable table {font-size:9pt;background-color: #E5E4E2;font-weight:bold;margin-top: 121px; margin-left:-30px;overflow:hidden; white-space:nowrap;text-align:left;align:left;}",
media="screen",
type="text/css"),
fluidRow(
column(6, tableOutput('simulationChangeEsperance'),
tags$style("#simulationChangeEsperance table {font-size:9pt;background-color: #E5E4E2;font-weight:bold;margin-top: -10px; margin-left:-30px;overflow:hidden; white-space:wrap;word-break: break-word;width:173px;text-align:left;}"))
)
)
)
)
)
))
shinyServer(function(input, output, session) {
# part of my server.R code
observe({
if (input$gender|input$age|input$birthplace|input$education){
shinyjs::hide("simulationChange")
shinyjs::hide("simulationChangeTable")
shinyjs::hide("simulationChangeEsperance")
}
})
Thank you.
The reason your code didn't work is because you didn't make a call to useShinyjs() (if you read the documentation or look at any examples of using shinyjs, you'll see that you HAVE to call useShinyjs() in the UI).
I couldn't replicate your code because it had too many errors, but just to demonstrate that it does work with outputs, here's a small example you can run. In your project, just add shinyjs::useShinyjs() somewhere in the UI.
library(shiny)
library(shinyjs)
ui <- fluidPage(
useShinyjs(),
actionButton("hideshow", "Hide/show plot"),
plotOutput("plot")
)
server <- function(input, output, session) {
output$plot <- renderPlot({
plot(rnorm(100))
})
observeEvent(input$hideshow, {
# every time the button is pressed, alternate between hiding and showing the plot
toggle("plot")
})
}
shinyApp(ui = ui, server = server)
As mentioned by Dieter in the comments you need to use conditionalPanel. For example, in your ui.R, instead of
plotOutput('simulationChange')
use
conditionalPanel("output.show", plotOutput('simulationChange'))
And in your server.R add the following:
values <- reactiveValues()
values$show <- TRUE
observe({
input$gender
input$age
input$birthplace
input$education
values$show <- FALSE
})
output$show <- reactive({
return(values$show)
})
Also, don't forget to change values$show, when clicking on your button:
observeEvent(input$button, {
...
values$show <- TRUE
})
The other answers here don't seem to provide the right/complete answer. The solution is actually quite simple.
You need to use outputOptions(output, 'show', suspendWhenHidden = FALSE)
Below is a sample code that displays the text inside a conditionalPanel if the dropdown selection is 2 and hides if it is 1.
library(shiny)
ui <- fluidPage(
selectInput("num", "Choose a number", 1:2),
conditionalPanel(
condition = "output.show",
"The selected number is 2 so this text is displayed. Change it back to 1 to hide."
)
)
server <- function(input, output, session) {
output$show <- reactive({
input$num == 2 # Add whatever condition you want here. Must return TRUE or FALSE
})
outputOptions(output, 'show', suspendWhenHidden = FALSE)
}
shinyApp(ui = ui, server = server)
I have a shiny application with many tabs and many widgets on each tab. It is a data-driven application so the data is tied to every tab.
I can save the application using image.save() and create a .RData file for later use.
The issue I am having how can I get the state restored for the widgets?
If the user has checked boxes, selected radio buttons and specified base line values in list boxes can I set those within a load() step?
I have found libraries such as shinyURL and shinystore but is there a direct way to set the environment back to when the write.image was done?
I am not sure where to even start so I can't post code.
edit: this is a cross-post from the Shiny Google Group where other solutions have been suggested
This is a bit hacky, but it works. It uses an "internal" function (session$sendInputMessage) which is not meant to be called explicitly, so there is no guarantee this will always work.
You want to save all the values of the input object. I'm getting all the widgets using reactiveValuesToList(input) (note that this will also save the state of buttons, which doesn't entirely make sense). An alternative approach would be to enumerate exactly which widgets to save, but that solution would be less generic and you'd have to update it every time you add/remove an input. In the code below I simply save the values to a list called values, you can save that to file however you'd like (RDS/text file/whatever). Then the load button looks at that list and updates every input based on the value in the list.
There is a similar idea in this thread
library(shiny)
shinyApp(
ui = fluidPage(
textInput("text", "text", ""),
selectInput("select", "select", 1:5),
uiOutput("ui"),
actionButton("save", "Save"),
actionButton("load", "Load")
),
server = function(input, output, session) {
output$ui <- renderUI({
tagList(
numericInput("num", "num", 7),
checkboxGroupInput("chk", "chk", 1:5, c(2,4))
)
})
observeEvent(input$save, {
values <<- lapply(reactiveValuesToList(input), unclass)
})
observeEvent(input$load, {
if (exists("values")) {
lapply(names(values),
function(x) session$sendInputMessage(x, list(value = values[[x]]))
)
}
})
}
)
Now with bookmarking is possible to save the state of your shinyapp. You have to put the bookmarkButton on your app and also the enableBookmarking.
The above example may not work if shiny UI involves date. Here is a minor change for date handling.
library(shiny)
shinyApp(
ui = fluidPage(
dateInput("date", "date", "2012-01-01"),
selectInput("select", "select", 1:5),
uiOutput("ui"),
actionButton("save", "Save"),
actionButton("load", "Load")
),
server = function(input, output, session) {
output$ui <- renderUI({
tagList(
numericInput("num", "num", 7),
checkboxGroupInput("chk", "chk", 1:5, c(2,4))
)
})
observeEvent(input$save, {
values <<- lapply(reactiveValuesToList(input), unclass)
})
observeEvent(input$load, {
if (exists("values")) {
lapply(names(values),
function(x) session$sendInputMessage(x, list(value = values[[x]]))
)
temp=as.character(as.Date(values$date, origin = "1970-01-01"))
updateDateInput(session, inputId="date", label ="date", value = temp)
}
})
}
)