I am pretty new to Shiny and dealing with the following problem, upon pressing an actionButton in shiny, I want it to do multiple calculations. I use the handler of observeEvent.
An example:
library(shiny)
ui <- fluidPage(
sidebarLayout(
sidebarPanel(`
actionButton("calc","calculate stuff")),
mainPanel(
textOutput("result")
)
)
)
server <- function(input,output){
observeEvent(input$calc, {output$result <- renderText({"only this is not enough"}) })
}
shinyApp(ui,server')`
Now what I would want is where the output$result is made in the server-observeEvent, I would like to perform additional tasks, say assign a variable a <- 12, calculate B4 <- input$ID1*inputID2 etc.
This can not be hard I imagine.. but I am just not getting there.
kind regards,
Pieter
You can use isolate, see this example:
library(shiny)
ui <- fluidPage(
sidebarLayout(
sidebarPanel(
numericInput(inputId = 'x', label = 'Select a value for x', value = 1),
actionButton( "calc", "calculate stuff" )
),
mainPanel(
textOutput("result")
)
)
)
server <- function(input, output) {
output$result <- renderText({
input$calc
isolate({
y<- input$x *2
paste("The result is:", y)
})
})
}
shinyApp(ui, server)
Related
I'm trying to create the scenario whereby using conditionalpanel, I am able to have an user input of checked boxes to display either 1 or 2 plots, one after another.
My reproducible code can be found below, however, I am unable to display the plots.
Could someone please share with me where did I make a mistake?
library(shiny)
ui = fluidPage(
titlePanel("Plot1 or Plot2?"),
sidebarLayout(
sidebarPanel(
checkboxGroupInput("my_choices", "Plot1 or Plot2",choices = c("Plot1", "Plot2"), selected = "Plot1"),width=2),
mainPanel(
conditionalPanel(
condition = "input.my_choices == 'Plot1'",
plotOutput("plot1")
),
conditionalPanel(
condition = "input.my_choices == 'Plot2'",
plotOutput("plot2")
),
conditionalPanel(
condition = "input.my_choices.includes('Plot1', 'Plot2')",
plotOutput("plot1"),
plotOutput("plot2")
)
)
)
)
server = function(input, output) {
output$plot1 <- renderPlot({plot(iris)})
output$plot2 <- renderPlot({plot(mtcars)})
}
shinyApp(ui, server)
Update:
I've got what I wanted but without using ConditionalPanel function. Here's the code below:
Would appreciate if someone can share with me the proper way of using ConditionalPanel Function! (:
library(shiny)
#data
df <- iris
#ui
ui <- fluidPage(
sidebarPanel(
checkboxGroupInput(inputId = "Question",
label = "Choose the plots",
choices = c("Plot1", "Plot2", "Plot3"),
selected = "")),
mainPanel(
uiOutput('ui_plot')
)
)
#server
server <- function(input, output)
{
# gen plot containers
output$ui_plot <- renderUI({
out <- list()
if (length(input$Question)==0){return(NULL)}
for (i in 1:length(input$Question)){
out[[i]] <- plotOutput(outputId = paste0("plot",i))
}
return(out)
})
# render plots
observe({
for (i in 1:3){
local({ #because expressions are evaluated at app init
ii <- i
output[[paste0('plot',ii)]] <- renderPlot({
if ( length(input$Question) > ii-1 ){
return(plot(runif(100)))
}
NULL
})
})
}
})
}
shinyApp(ui, server)
I would give you an alternative as you will need to create new plots with different id in order for that to work. The simplest one I can think of is using shinyjs package and its hide and show functions. You can also do this via renderUI but you shouldn't give unnecessary work to your server only if you're showing and hiding the elements
library(shiny)
library(shinyjs)
ui = fluidPage(
useShinyjs(),
titlePanel("Plot1 or Plot2?"),
sidebarLayout(
sidebarPanel(
checkboxGroupInput("my_choices", "Plot1 or Plot2",choices = c("Plot1", "Plot2"), selected = "Plot1"),width=2),
mainPanel(
plotOutput("plot1"),
plotOutput("plot2")
)
)
)
server = function(input, output,session) {
# hide plots on start
hide("plot1");hide("plot2")
output$plot1 <- renderPlot({plot(iris)})
output$plot2 <- renderPlot({plot(mtcars)})
observeEvent(input$my_choices,{
if(is.null(input$my_choices)){
hide("plot1"); hide("plot2")
}
else if(length(input$my_choices) == 1){
if(input$my_choices == "Plot1"){
show("plot1");hide("plot2")
}
if(input$my_choices == "Plot2"){
hide("plot1");show("plot2")
}
}
else{
if(all(c("Plot1","Plot2") %in% input$my_choices)){
show("plot1");show("plot2")
}
}
},ignoreNULL = F)
}
shinyApp(ui, server)
How can I pass additional arguments to a reactive context in Shiny? The purpose is to handover the arguments to the reactive context ("callback") when it is evaluated.
Think of the following Shiny server code. How can I make output$some print "some", output$different print "different" and so on?
for(i in c("some","different","values"){
output[[i]] <- renderText({
# i gets evaluated at some later point in time,
# and thus will always print "values"
i
})
}
The example below is intended to make the two render contexts reactive to the corresponding reactive value text1 and text2, but of course it only makes both depend on text2.
library(shiny)
ui <- fluidPage(
titlePanel("Test"),
sidebarLayout(
sidebarPanel(
),
mainPanel(
htmlOutput("text1"),
textOutput("text2"),
actionButton("test_btn1",label="test1"),
actionButton("test_btn2",label="test2")
)
)
)
server <- function(input, output) {
rv <- reactiveValues(
"text1"=NULL,
"text2"=NULL
)
bindings <- list(
list("var"="text1",
"function"=renderUI),
list("var"="text2",
"function"=renderText)
)
for(i in bindings){
output[[i[["var"]]]] <- i[["function"]]({
# i is always the second element unfortunately
rv[[i[["var"]]]]
})
}
observeEvent(input$test_btn1,{
rv$text1 <- tags$p("new value 1")
})
observeEvent(input$test_btn2,{
rv$text2 <- "new value 2"
})
}
shinyApp(ui = ui, server = server)
Try Map() instead of the for loop so the function gets called through each iteration:
library(shiny)
ui <- fluidPage(
titlePanel("Test"),
sidebarLayout(
sidebarPanel(
),
mainPanel(
htmlOutput("text1"),
textOutput("text2"),
actionButton("test_btn1",label="test1"),
actionButton("test_btn2",label="test2")
)
)
)
server <- function(input, output) {
rv <- reactiveValues(
"text1"=NULL,
"text2"=NULL
)
bindings <- list(
list("var"="text1",
"function"=renderUI),
list("var"="text2",
"function"=renderText)
)
Map(function(i){
output[[bindings[[i]][["var"]]]] <- bindings[[i]][["function"]]({
# i is always the second element unfortunately
rv[[bindings[[i]][["var"]]]]
})
}, 1:2)
observeEvent(input$test_btn1,{
rv$text1 <- "new value 1"
})
observeEvent(input$test_btn2,{
rv$text2 <- "new value 2"
})
}
shinyApp(ui = ui, server = server)
Can somebody check the code below for me and tell me what's wrong?
shinyUI(fluidPage(
sidebarLayout(
sidebarPanel(
sliderInput("Mean",
label="Drag to select the mean of the normal distribution",
min=0,max=5,value=0),
actionButton("show","Go")
),
mainPanel(
h3("The number is"),
textOutput('number')
)
)
))
shinyServer(function(input, output) {
#observeEvent(input$show, {
#output$number <- round(rnorm(as.numeric(input$mu)), 2)
#})
output$number <- eventReactive(input$show, {
round(rnorm(as.numeric(input$mu)), 2)
})
}
)
Just want to have a random number sampled from a normal distribution with a given mean each time I click 'Go'. Neither eventReactive nor observeEvent worked.
I'n not a big fan of having objects inside observeEvent so here is the solution with eventReactive
library(shiny)
ui <- shinyUI(fluidPage(
sidebarLayout(
sidebarPanel(
sliderInput("Mean",label="Drag to select the mean of the normal distribution",min=0,max=5,value=0),
actionButton("show","Go")
),
mainPanel(
h3("The number is"),
textOutput('number')
)
)
))
server <- shinyServer(function(input, output) {
data <- eventReactive(input$show, {
round(rnorm(as.numeric(input$Mean)), 2)
})
output$number <- renderText({
data()
})
}
)
shinyApp(ui, server)
The output of eventReactive is a reactive variable. You will need to use renderText and observeEvent. Also you have not defined input$mu in your ui, I think it should be input$Mean
After implementing the above modifications your server code should be something like this:
server <- shinyServer(function(input, output) {
observeEvent(input$show, {
output$number <- renderText(round(rnorm(as.numeric(input$Mean)), 2))
})
}
)
Hope it helps!
I want to create a vector by using observe() in R shiny. In the code blow, how can I create a vactor where all the input$n are concatenated. At the present time, I can only display a single value but could not concatenate and display all the inputs from the sliderInput.
ui.R
library(shiny)
fluidPage(
titlePanel("Observer demo"),
fluidRow(
column(4, wellPanel(
sliderInput("n", "N:",
min = 10, max = 1000, value = 200, step = 10)
)),
column(8,
tableOutput("text")
)
)
)
server.R
library(shiny)
function(input, output, session) {
observed=reactiveValues(
input=NULL
)
observe({
observed$input=input$n
# observed$input=c(observed$input,input$n) # tried this but not working
})
output$text <- renderTable({
observed$input
})
}
If you add print(observed$input) in your observer, you will see that when you use observed$input=c(observed$input,input$n) you run into an infinite loop as the observe is reactive to observe$input and will run again as soon as you modify it.
To prevent this, you can use isolate:
observed$input=c(isolate(observed$input),input$n)
As in #Pork Chop 's answer, you can also use observeEvent to only observe input$n.
Try this, you can use cbind or rbind depending on your needs
rm(list = ls())
library(shiny)
ui <- fluidPage(
titlePanel("Observer demo"),
fluidRow(
column(4, wellPanel(
sliderInput("n", "N:",
min = 10, max = 1000, value = 200, step = 10)
)),
column(8,
tableOutput("text")
)
)
)
server <- function(input, output, session) {
observed=reactiveValues(
input=NULL
)
observeEvent(input$n,{
observed$input <- cbind(observed$input,input$n)
})
output$text <- renderTable({
print(observed$input)
observed$input
})
}
shinyApp(ui <- ui, server <- server)
I am trying to gather user input given a data set. I want to insert a column where the user can determine whether they would want to own one of the cars in the mtdata set. This is completely subjective as opinions differ from person to person so I am not able to program this in. Is there a way to append an extra column that can be a checkbox or dropdown menu to identify cars that a user would "Want to own?
library(shiny)
shinyApp(ui = shinyUI(fluidPage(
titlePanel("Interesting Cars"),
sidebarLayout(
sidebarPanel(
helpText("This is a side bar")),
mainPanel(
tableOutput("view")
)
)
)),
server = function(input, output) {
output$view <- renderTable({
head(mtcars[, 1:4], n = 6)
})
})
How about this, you can use the DT library. By adding the filter option the user can define the different components one wants and see what cars come up.
library(shiny)
library(DT)
shinyApp(ui = shinyUI(fluidPage(
titlePanel("Interesting Cars"),
sidebarLayout(
sidebarPanel(
helpText("This is a side bar")),
mainPanel(
DT::dataTableOutput("view")
)
)
)),
server = function(input, output) {
output$view <- DT::renderDataTable({
datatable(mtcars,
filter = "top"
)
})
})
Edit
If it truly is so important to add another column indicating if it is 'interesting' there will be significantly more code to written if you intend to have users assign it on different conditions. Here is an example with just the mpg. The fundamental idea here is that you assign your data to the reactiveValues function. It can then be modified as you like. This can obviously be improved upon more (as it will continue to add columns) but it demonstrates the concept.
shinyApp(ui = shinyUI(fluidPage(
titlePanel("Interesting Cars"),
sidebarLayout(
sidebarPanel(
helpText("This is a side bar"),
uiOutput("mpg"),
actionButton("add_label", "Mark Interesting")
),
mainPanel(
DT::dataTableOutput("view")
)
)
)),
server = function(input, output) {
values <- reactiveValues(
mydata = mtcars
)
output$mpg <- renderUI({
numericInput("mpg_input", "MPG Cutoff?",
value = 15
)
})
output$view <- DT::renderDataTable({
datatable(values$mydata
)
})
observeEvent(input$add_label, {
validate(
need(!is.null(input$mpg_input), "need mpg value")
)
values$mydata <- data.frame(values$mydata,
Interesting_Flag =
ifelse(values$mydata$mpg > input$mpg_input,
"Interesting",
"Not Interesting"))
})
})