I will give some context first. Suppose I have a client that works in a bar. That client wants to optimize the amount of coffe they buy per working day to maximize revenue. To do so, the client needs to provide some initial inputs, such as the size of the bar, the number of clients per week and the current amount of coffe they buy per working day. Once it has provided all the necessary information to the app, there is an "Optimize" button that triggers some calculations and returns 6 new optimized values. Once these six values are computed, they are rendered in some boxes, plots are also rendered and the savings between the initial bought amounts and the optimized ones are shown. However, the user needs to have the option to modify those proposed values, and if he does so, the graphics and the savings need to be recalculated and shown.
My app is divided into global.R, ui.R and server.R files and I will now provide a minimal reproducible example of them.
# global.R
library(shiny)
library(shinythemes)
library(shinydashboard)
library(shinyWidgets)
library(shinycssloaders)
library(hrbrthemes)
plot_height <- "250px"
options(spinner.color = "#2c3249", spinner.type = 7)
optimize_coffee <- function(d1, d2, d3, d4, d5, d6) {
return (list(d1 + 1, d2 + 2, d3 + 3, d4 + 4, d5 + 5, d6 + 6))
}
Please note that the provided optimize_coffe function is just an oversimplification. The real function takes into account different parameters and it does much more complex and slower calculations.
# ui.R
ui <- bootstrapPage(
shinyjs::useShinyjs(),
tags$head(tags$style(
HTML(".shiny-notification {position:fixed;top: 90%;left: 1%; width: 300px;}")
)),
navbarPage(
header = tagList(
useShinydashboard()
),
theme = shinytheme("flatly"),
collapsible = TRUE,
HTML('<a style="text-decoration:none;cursor:default;color:#FFFFFF;"class="active" href="#">Coffee optimization</a>'), # nolint
id = "nav",
windowTitle = "Coffee optimization",
tabPanel(
"Principal",
fluidRow(
column(
3,
fluidRow(
sidebarPanel(
h3("Coffee optimization"),
width = 12,
h4("Coffe bought per day:"),
fluidRow(
column(
4,
numericInput("d1_coffeebought", label = "D1", value = 0, min = 0)
),
column(
4,
numericInput("d2_coffeebought", label = "D2", value = 0, min = 0)
),
column(
4,
numericInput("d3_coffeebought", label = "D3", value = 0, min = 0)
)
),
fluidRow(
column(
4,
numericInput("d4_coffeebought", label = "D4", value = 0, min = 0)
),
column(
4,
numericInput("d5_coffeebought", label = "D5", value = 0, min = 0)
),
column(
4,
numericInput("d6_coffeebought", label = "D6", value = 0, min = 0)
)
),
actionButton("optimize", label = "Optimize", class = "btn-primary", width = "100%"),
)
)
),
mainPanel(
width = 9,
fluidRow(
column(
3,
tags$head(tags$style(".info-box {width: 15.5vw;height: 8.5em}
.info-box-icon {height: 2.85em;}")),
infoBoxOutput("savings_box", width = 12)
),
column(
9,
fluidRow(
style = "border: 2px solid #000080;",
tags$div(
HTML("<p style='font-size: 1.3em; font-weight: bold; text-align: center;'>Optimized coffees</p>")
),
column(
2,
numericInput(inputId = "optimized_cofeesd1", label = "D1", value = "-", min = 0, max = 10000, step = .1)
),
column(
2,
numericInput(inputId = "optimized_cofeesd2", label = "D2", value = "-", min = 0, max = 10000, step = .1)
),
column(
2,
numericInput(inputId = "optimized_cofeesd3", label = "D3", value = "-", min = 0, max = 10000, step = .1)
),
column(
2,
numericInput(inputId = "optimized_cofeesd4", label = "D4", value = "-", min = 0, max = 10000, step = .1)
),
column(
2,
numericInput(inputId = "optimized_cofeesd5", label = "D5", value = "-", min = 0, max = 10000, step = .1)
),
column(
2,
numericInput(inputId = "optimized_cofeesd6", label = "D6", value = "-", min = 0, max = 10000, step = .1)
)
)
)
),
fluidRow(
column(6, withSpinner(plotOutput("savings_graphicd1", height = plot_height))),
column(6, withSpinner(plotOutput("savings_graphicd2", height = plot_height)))
),
fluidRow(
column(6, withSpinner(plotOutput("savings_graphicd3", height = plot_height))),
column(6, withSpinner(plotOutput("savings_graphicd4", height = plot_height)))
),
fluidRow(
column(6, withSpinner(plotOutput("savings_graphicd5", height = plot_height))),
column(6, withSpinner(plotOutput("savings_graphicd6", height = plot_height)))
)
)
)
)
)
)
The real UI has more inputs but they do not affect to the problem I am presenting.
# server.R
server <- function(input, output, session) {
# A lot of other functionalities
output$savings_box <- renderInfoBox({
infoBox(
value = HTML("<p></p><p style= 'font-size:1vw;margin-bottom:0px'>No offer</p>"),
title = HTML("<p style='font-size:1vw;margin-bottom:0px'>Savings</p>"),
fill = FALSE,
color = "navy",
width = 12,
icon = icon("wallet", style = "position:relative;top:0.95vw")
)
})
output$savings_graphicd1 <- renderPlot(NULL)
output$savings_graphicd2 <- renderPlot(NULL)
output$savings_graphicd3 <- renderPlot(NULL)
output$savings_graphicd4 <- renderPlot(NULL)
output$savings_graphicd5 <- renderPlot(NULL)
output$savings_graphicd6 <- renderPlot(NULL)
# A lot of other functionalities
observeEvent(input$optimize,
{
optimized_coffees <- optimize_coffee(input$d1_coffeebought,
input$d2_coffeebought,
input$d3_coffeebought,
input$d4_coffeebought,
input$d5_coffeebought,
input$d6_coffeebought
)
user_optimized_coffees <- reactive({
if (is.na(input$optimized_cofeesd1)) {
optimized_coffees
} else {
c(
input$optimized_cofeesd1,
input$optimized_cofeesd2,
input$optimized_cofeesd3,
input$optimized_cofeesd4,
input$optimized_cofeesd5,
input$optimized_cofeesd6
)
}
})
updateNumericInput(session = session, inputId = "optimized_cofeesd1", value = round(optimized_coffees[[1]][1], 1))
updateNumericInput(session = session, inputId = "optimized_cofeesd2", value = round(optimized_coffees[[2]][1], 1))
updateNumericInput(session = session, inputId = "optimized_cofeesd3", value = round(optimized_coffees[[3]][1], 1))
updateNumericInput(session = session, inputId = "optimized_cofeesd4", value = round(optimized_coffees[[4]][1], 1))
updateNumericInput(session = session, inputId = "optimized_cofeesd5", value = round(optimized_coffees[[5]][1], 1))
updateNumericInput(session = session, inputId = "optimized_cofeesd6", value = round(optimized_coffees[[6]][1], 1))
computed_savings <- reactive({
# I need to add this if here because until all the graphics are rendered the
# user_optimized_coffees() are NULL
if (!is.null(user_optimized_coffees())) {
sum(user_optimized_coffees())
}
})
output$savings_box <- renderInfoBox({
infoBox(
value = computed_savings(),
title = HTML("<p style='font-size:1vw;margin-bottom:0px'>Savings</p>"),
fill = FALSE,
color = "navy",
width = 12,
icon = icon("wallet", style = "position:relative;top:0.95vw")
)
})
# Render the resultant plots
}
)
}
This is my current approach. I set the boxes to be numericInputs with empty initial values. After that I compute the optimized values for those boxes and I would ideally like the labels of the numericInput to inmediately update after these values have been computed.
However, as of today, 17 March 2023, the updateNumericInput just sends the message to client once all the objects have been rendered, what causes the computed_savings (and thus the savings_box) and the plots to be rendered twice in the first execution. This is quite annoying as the user sees the plots once but inmediately after this, they are deleted to be rendered once again, process that takes around 5 seconds.
Any help on this would be much appreciated. I do not really need the boxes to be numericInputs, I just need a box which values can be modifiable but I have not found anything better. Appart from that, I also cannot add a refresh button.
Thank you very much!