I have a small Shiny app that generates some data whenever the New data button is pressed. The Show plot button shows a hidden plot. I would like the plot to be hidden again automatically whenever the New data button is pressed to make a new data set. A bonus would be for the plot to be hidden also as soon as the slider is changed. I am not looking for a toggle action.
I tried adapting this example that uses conditional panel but I could not successfully figure out how to correctly change the values$show between TRUE and FALSE.
library(shiny)
ui <- fluidPage(
sidebarLayout(
sidebarPanel(
sliderInput(inputId = "number",
label = "Pick a number",
min = 6,
max = 12,
value = 8),
actionButton("new_data",
"New data"),
actionButton("show_plot",
"Show plot")
),
mainPanel(
tableOutput("char_table"),
plotOutput(outputId = "car_plot")
)
)
)
server <- function(input, output) {
t <- eventReactive(input$new_data, {
r <- input$number
c <- r - 1
mat <- matrix(sample(0:1,r*c, replace=TRUE),r,c)
})
output$char_table <- renderTable({
t()
})
p <- eventReactive(input$show_plot, {
plot(cars)
})
output$car_plot <- renderPlot({
p()
})
}
shinyApp(ui = ui, server = server)
You can use a reactive value and a if to control the plot.
library(shiny)
ui <- fluidPage(
sidebarLayout(
sidebarPanel(
sliderInput(inputId = "number",
label = "Pick a number",
min = 6,
max = 12,
value = 8),
actionButton("new_data",
"New data"),
actionButton("show_plot",
"Show plot")
),
mainPanel(
tableOutput("char_table"),
plotOutput(outputId = "car_plot")
)
)
)
server <- function(input, output) {
showPlot <- reactiveVal(FALSE)
t <- eventReactive(input$new_data, {
showPlot(FALSE)
r <- input$number
c <- r - 1
mat <- matrix(sample(0:1,r*c, replace=TRUE),r,c)
})
output$char_table <- renderTable({
t()
})
observeEvent(input$number, {
showPlot(FALSE)
})
observeEvent(input$show_plot, {
showPlot(TRUE)
})
output$car_plot <- renderPlot({
if (showPlot())
plot(cars)
})
}
shinyApp(ui = ui, server = server)
Alternate solution using shinyjs which is handy in these situations.
library(shiny)
library(shinyjs)
ui <- fluidPage( shinyjs::useShinyjs(),
sidebarLayout(
sidebarPanel(
sliderInput(inputId = "number",
label = "Pick a number",
min = 6,
max = 12,
value = 8),
actionButton("new_data",
"New data"),
actionButton("show_plot",
"Show plot")
),
mainPanel(
tableOutput("char_table"),
plotOutput(outputId = "car_plot")
)
)
)
server <- function(input, output) {
t <- eventReactive(input$new_data, {
hide("car_plot")
r <- input$number
c <- r - 1
mat <- matrix(sample(0:1,r*c, replace=TRUE),r,c)
})
output$char_table <- renderTable({
t()
})
observeEvent(input$show_plot, {
show("car_plot")
})
output$car_plot <- renderPlot({
plot(cars)
})
}
shinyApp(ui = ui, server = server)
Related
I am trying to build a form with R Shiny which will be used to populate a table once the action button at the end of the form is clicked. What I have not been able to figure out is how to pick up the data in the form and add it to a new row in the table. Right now, it just keeps updating the first row with whatever is in the form. I have reproduced a simple version of the code here:
#ui.r
library(shiny)
shinyUI(fluidPage(
# Application title
titlePanel("Test App"),
sidebarPanel(
numericInput("x", "Enter Value of X", 1),
numericInput("y", "Enter Value of Y", 1),
actionButton("add_data", "Add Data", width="100%")
),
mainPanel(
tableOutput("xy_Table")
)
)
)
#server.R
library(shiny)
library(tidyverse)
shinyServer(function(input, output) {
x <- vector("numeric")
y <- vector("numeric")
xyTable <- tibble(x, y)
e <- reactive(input$x)
f <- reactive(input$y)
eventReactive(input$add_data, {
xyTable %>% add_row(x=e(), y=f())
})
output$xy_Table <- renderTable({
xyTable
})
})
Thanks a lot for any help.
You need to use a reactive xyTable in order for the output to update. Also,
append the rows inside an observer rather than a reactive expression, and make sure to save the updated reactive value:
library(shiny)
library(tidyverse)
ui <- fluidPage(
sidebarPanel(
numericInput("x", "Enter Value of X", 1),
numericInput("y", "Enter Value of Y", 1),
actionButton("add_data", "Add Data", width = "100%")
),
mainPanel(
tableOutput("xy_Table")
)
)
server <- function(input, output, session) {
xyTable <- reactiveVal(
tibble(x = numeric(), y = numeric())
)
observeEvent(input$add_data, {
xyTable() %>%
add_row(
x = input$x,
y = input$y,
) %>%
xyTable()
})
output$xy_Table <- renderTable(xyTable())
}
shinyApp(ui, server)
Try this:
library(shiny)
library(tidyverse)
#ui.r
ui <- fluidPage(
# Application title
titlePanel("Test App"),
sidebarPanel(
numericInput("x", "Enter Value of X", 1),
numericInput("y", "Enter Value of Y", 1),
actionButton("add_data", "Add Data", width = "100%")
),
mainPanel(
tableOutput("xy_Table")
)
)
#server.R
server <- function(input, output) {
xyTable <- reactiveValues(
table1 = tibble(x = numeric(), y = numeric())
)
# what happens when `add_data` is clicked?
observeEvent(input$add_data, {
xyTable$table1 <- xyTable$table1 |>
add_row(x = input$x, y = input$y)
})
output$xy_Table <- renderTable({
xyTable$table1
})
}
shinyApp(ui, server)
#ui.r
library(shiny)
ui <- shinyUI(fluidPage(
# Application title
titlePanel("Test App"),
sidebarPanel(
numericInput("x", "Enter Value of X", 1),
numericInput("y", "Enter Value of Y", 1),
actionButton("add_data", "Add Data", width="100%")
),
mainPanel(
tableOutput("xy_Table")
)
)
)
#server.R
library(shiny)
library(tidyverse)
server <- shinyServer(function(input, output) {
x <- vector("numeric")
y <- vector("numeric")
xyTable <- reactiveValues()
xyTable$df <- tibble(x, y)
e <- reactive(input$x)
f <- reactive(input$y)
observeEvent(input$add_data, {
xyTable$df <- xyTable$df %>% add_row(x=e(), y=f())
})
output$xy_Table <- renderTable({
xyTable$df
})
})
shinyApp(ui,server)
I want to update output data on update button every time.
Here is my code which show the output on update button for the first time I run the code but in runtime if the input is changed, the output is updated automatically.
library(shiny)
ui <- fluidPage(
titlePanel("My Shop App"),
sidebarLayout(
sidebarPanel(
helpText("Controls for my app"),
selectInput("item",
label = "Choose an item",
choices = list("Keyboard",
"Mouse",
"USB",
sliderInput("price",
label = "Set Price:",
min=0, max = 100, value=10),
actionButton ("update","Update Price")
),
mainPanel(
helpText("Selected Item:"),
verbatimTextOutput("item"),
helpText("Price"),
verbatimTextOutput("price")
)
)
)
server <- function(input, output) {
SelectInput <- eventReactive (input$update , {
output$item = renderText(input$item)
output$price = renderText(input$price)
})
output$item <- renderText(SelectInput())
output$price <- renderText(SelectInput())
}
shinyApp(ui = ui, server = server)
Either create a dependency and put them into the reactive and return it:
server <- function(input, output) {
SelectInput <- eventReactive(input$update,{
list(item = input$item, price = input$price)
})
output$item <- renderText(SelectInput()$item)
output$price <- renderText(SelectInput()$price)
}
Or you can isolate, but then you have to add the button reaction to each listener
server <- function(input, output) {
output$item <- renderText({
req(input$update)
input$update
isolate(input$item)
})
output$price <- renderText({
req(input$update)
input$update
isolate(input$price)
})
}
I would like this app to add whatever number is selected (above zero) in the numeric input to a 1d vector every time that the button is pressed. It should then present that vector as a list of numbers in a box.
library(shiny)
options(shiny.autoreload = TRUE)
ui <- dashboardPage(
dashboardHeader(title = "minrep"),
dashboardSidebar(
numericInput("number",
label = "Enter a number",
value = 0,
min = 1,
max = 100000),
actionButton(
"add.number",
label = "add a number"
),
box(
title = "List of numbers",
span(
textOutput("numbers"),
style = "color:black"
)
)
),
dashboardBody()
)
server <- function(input, output, session) {
list_numbers <- c()
new_number <-
eventReactive(input$add.number, {
input$number
})
observeEvent(input$add.number,{
list_numbers <- append(list_numbers, new_number())
})
output$numbers <- renderText(
list_numbers
)
}
shinyApp(ui, server)
Sure, the trick will be to store our vector as a reactiveValue, so we can access it and change it from wherever we want.
library(shiny)
ui <- fluidPage(
numericInput("number", label = "Enter a number", value = 1, min = 1, max = 100000),
actionButton("add.number", label = "add a number"),
textOutput("numbers")
)
server <- function(input, output, session) {
#Reactive value to store our vector
reactives <- reactiveValues(
list_numbers = c()
)
#Button is pressed
observeEvent(input$add.number, {
reactives$list_numbers <- append(reactives$list_numbers, input$number)
})
#Textbox Output
output$numbers <- renderText(
reactives$list_numbers
)
}
shinyApp(ui, server)
In this code:
library(shiny)
library(shinyMatrix)
if (interactive()) {
# UI
ui <- fluidPage(
selectInput('NumGrig',label = 'Matrix size', choices = c(2:10),selected = 5),
actionButton("add", "Add Martix"),
conditionalPanel(condition = "input.add > 0",
uiOutput("grid"))
)
# Server
server <- function(input, output, session) {
# adding Matrix
observe({
if (!is.null(input$add)) {
m = reactive({matrix('',ncol = input$NumGrig ,nrow = input$NumGrig)})
output$grid <- renderUI({
div(
matrixInput(inputId = "newGrid", value = m()),
actionButton("start", "Convert")
)
})
}
})
}
shinyApp(ui, server)
}
I want to create an editable matrix with prespecified dimension, but I get Error that says:
Error in matrix: non-numeric matrix extent
Why matrixInput is not receiving the input$NumGrig value that was selected in selectInput?
selectInput returns characters : you just have to convert is to numeric with as.numeric.
This works :
library(shiny)
library(shinyMatrix)
if (interactive()) {
# UI
ui <- fluidPage(
selectInput('NumGrig',label = 'Matrix size', choices = c(2:10),selected = 5),
actionButton("add", "Add Matrix"),
conditionalPanel(condition = "input.add > 0",
uiOutput("grid"))
)
# Server
server <- function(input, output, session) {
# adding Matrix
observe({
if (!is.null(input$add)) {
m = reactive({matrix('',ncol = as.numeric(input$NumGrig) ,nrow = as.numeric(input$NumGrig))})
output$grid <- renderUI({
div(
matrixInput(inputId = "newGrid", value = m()),
actionButton("start", "Convert")
)
})
}
})
}
shinyApp(ui, server)
}
I want an event to be triggered for the first time only by clicking a button. After that I want it to be reactive to the slider input.
I tried the following:
ui <- fluidPage(
actionButton("go", "Go"),
sliderInput("n", label = "Sample size", min = 1, max = 100, value = 10),
plotOutput('samples')
)
server <- function(input, output, session){
activate = reactive({FALSE})
activate = eventReactive(input$go, {
isolate(TRUE)
})
samples = eventReactive(activate(), {
rnorm(input$n)
})
output$samples <- renderPlot({ hist(samples()) })
}
shinyApp(ui = ui, server = server)
I hoped it would make it reactive to input$n after input$go has been clicked once. But it isn't and still needs input$go to be clicked every time.
There are several ways to achieve that.
One way would be to store the value in a reactiveValues() or just use req(), see below.
The problem with using eventReactive(activate(), ... is that it only triggers the code inside if activate() is executed, which only happens if you click input$go.
Reproducible example with req():
ui <- fluidPage(
actionButton("go", "Go"),
sliderInput("n", label = "Sample size", min = 1, max = 100, value = 10),
plotOutput('samples')
)
server <- function(input, output, session){
output$samples <- renderPlot({
req(input$go > 0)
hist(rnorm(input$n))
})
}
shinyApp(ui = ui, server = server)
Reproducible example with reactiveValues():
ui <- fluidPage(
actionButton("go", "Go"),
sliderInput("n", label = "Sample size", min = 1, max = 100, value = 10),
plotOutput('samples')
)
server <- function(input, output, session){
global <- reactiveValues(showPlot = FALSE)
observeEvent(input$go, {
global$showPlot <- TRUE
})
samples = reactive({
rnorm(input$n)
})
output$samples <- renderPlot({
req(global$showPlot)
hist(samples())
})
}
shinyApp(ui = ui, server = server)