This is building on a question I had here, but I am simplifying the example so it is easier to read (and so it is easier for future searchers).
Reproducible example
Here is the data:
library(tidyverse)
library(shiny)
food_table <- structure(list(Food_category = c("Fruit", "Fruit", "Fruit", "Fruit",
"Vegetable", "Vegetable", "Fruit", "Fruit", "Fruit", "Vegetable"
), Food = c("Granny Smith apple", "McIntosh apple", "Avocado",
"Blueberries", "Broccoli, steamed", "Cucumber", "Banana", "Cherries",
"Nectarine", "Red onion"), Serving_Size = c(1, 1, 0.333333333333333,
1, 1, 1, 1, 1, 1, 1), Serving_Unit = c("apple", "apple", "avocado",
"cup", "cup", "cup", "banana", "cup", "nectarine", "cup"), Carbs_per_Serving = c(25,
25, 4, 21, 3.5, 4, 27, 25, 15, 11)), row.names = c(NA, -10L), class = c("tbl_df",
"tbl", "data.frame"))
(food_table)
Food_category Food Serving_Size Serving_Unit Carbs_per_Serving
<chr> <chr> <dbl> <chr> <dbl>
1 Fruit Granny Smith apple 1 apple 25
2 Fruit McIntosh apple 1 apple 25
3 Fruit Avocado 0.333 avocado 4
4 Fruit Blueberries 1 cup 21
5 Vegetable Broccoli, steamed 1 cup 3.5
6 Vegetable Cucumber 1 cup 4
7 Fruit Banana 1 banana 27
8 Fruit Cherries 1 cup 25
9 Fruit Nectarine 1 nectarine 15
10 Vegetable Red onion 1 cup 11
I have a shiny app that has multiple inputs. This works, other than when a new selection is made in the second Food Category box, the Food selection in the first row changes back to the first element. In other words, if I select "Fruit", then "Avocado" and "1" in the first row, then when I go to the second row and select "Vegetable", the selected Food Item changes from "Avocado" to "Granny Smith apple". I am trying to figure out how I prevent the rows from resetting once a selection is made.
Here is the streamlined shiny code:
# Table filters
categories <- sort(unique(food_table$Food_category))
foods <- sort(unique(food_table$Food))
unit <- sort(unique(food_table$Serving_Unit))
# Create Shiny app
# Define UI
ui <- fluidPage(headerPanel(strong("Carbohydrate Calculator")),
fluidRow(
column(
width = 3,
selectInput(
inputId = 'cat_1',
label = 'Food Category',
choices = c("None", categories)
)),
column(
width = 3,
selectInput(
inputId = 'food_1',
label = 'Food Item',
choices = foods
)),
column(
width = 3,
numericInput(
inputId = "actual_serving_1",
label = "How much?",
value = "",
min = 0,
max = 100
))
),
fluidRow(
column(
width = 3,
selectInput(
inputId = 'cat_2',
label = 'Food Category',
choices = c("None", categories)
)),
column(
width = 3,
selectInput(
inputId = 'food_2',
label = 'Food Item',
choices = foods
)),
column(
width = 3,
numericInput(
inputId = "actual_serving_2",
label = "How much?",
value = "",
min = 0,
max = 100
))
),
column(8,
tableOutput("my_table"),
span(textOutput("my_message"), style="color:red")
) # Column close
) # fluidPage close
# Define server logic required to draw a histogram
server <- function(input, output, session) {
food_table_1 <- reactive({
food_table %>%
filter(Food_category == input$cat_1) %>%
filter(Food == input$food_1) %>%
mutate(Actual_amount = input$actual_serving_1)
})
food_table_2 <- reactive({
food_table %>%
filter(Food_category == input$cat_2) %>%
filter(Food == input$food_2) %>%
mutate(Actual_amount = input$actual_serving_2)
})
# Combine selections into a single table
combined_tables <- reactive({
do.call("rbind", list(food_table_1(),
food_table_2()
)
) %>%
mutate(Total_Carbs_grams = Carbs_per_Serving * Actual_amount / Serving_Size) %>%
select(Food_category, Food, Serving_Size, Serving_Unit, Actual_amount, Carbs_per_Serving, Total_Carbs_grams, everything())
})
# Render Output table
output$my_table <- renderTable({
combined_tables()
})
# Create observe function which updates the second selectInput when the first selectInput is changed
observe({
updateSelectInput(
session,
inputId = "food_1",
choices = food_table %>% filter(Food_category == input$cat_1) %>% pull(Food)
)
updateSelectInput(
session,
inputId = "food_2",
choices = food_table %>% filter(Food_category == input$cat_2) %>% pull(Food)
)
}) # Observe close
} # Server close
# Run the application
shinyApp(ui = ui, server = server)
