In the below Example Code 1, a user input table hottable_1
is generated at the top of the UI window. A results table is generated beneath, alloc_tbl
, which shows the user input into hottable_1
in its first row and the product of that user input and 2 in the second row, with response deliberately slow for example purposes using the calc()
function. If the user inputs into hottable_1
and then immediately triggers the addSeries
action button, the tables start bouncing due to slow speed of calc()
. I'm trying to trigger calculations of calc()
through the use of the calculate
action button shown in Example Code 1. If the user inputs into hottable_1
and then immediately triggers addSeries
, then a new column should be added with default values of 1 and 2 in the first and second rows respectively (and no bouncing).
In Example Code 2 below I derive an extremely simple example of triggering calculations through an action button, but I am having trouble implementing that solution into Example Code 1. Any suggestions for how to do this?
Below is an illustration of the 2 examples:
Example Code 1:
library(rhandsontable)
library(shiny)
seriesGenTrm <- data.frame('Series_1' = c(1), row.names = c("Input_1"))
calc <- function(x) {
x <- max(x, 1)
Sys.sleep(x)
result <- x * 2
result <- data.frame(c(x,result))
result
}
ui <- fluidPage(
rHandsontableOutput('hottable_1'), br(),
actionButton("addSeries", "Add series"),
actionButton("calculate", "Calculate"),
tableOutput("alloc_tbl")
)
server <- function(input, output, session) {
seriesTbl_1 <- reactiveVal(seriesGenTrm)
observeEvent(input$hottable_1, {
seriesTbl_1(hot_to_r(input$hottable_1))
})
output$hottable_1 <- renderRHandsontable({
rhandsontable(
data.frame(seriesTbl_1(), check.names = FALSE),
rowHeaderWidth = 100
)
})
observeEvent(input$addSeries, {
newSeriesCol_1 <- data.frame(c(1))
names(newSeriesCol_1) <- paste0("Series_", ncol(hot_to_r(input$hottable_1)) + 1)
seriesTbl_1(cbind(seriesTbl_1(), newSeriesCol_1))
})
addCol <- function(allocData, columnName, seriesTbl_1) {
allocData[[columnName]] <-
calc(seriesTbl_1()[1, colnames(seriesTbl_1()) == columnName])
return(allocData)
}
allocData <- reactive({
allocDataTmp <- data.frame(Row = 1:2)
for (colName in colnames(seriesTbl_1())) {
allocDataTmp <- addCol(allocDataTmp, colName, seriesTbl_1)
}
return(allocDataTmp)
})
output$alloc_tbl <- renderTable({allocData()})
}
shinyApp(ui, server)
Example Code 2:
library(shiny)
ui <- fluidPage(
numericInput("input_value", "Enter a number:", value = 1),
actionButton("calculate", "Calculate"),
textOutput("result")
)
server <- function(input, output) {
inputValue <- reactiveVal()
observeEvent(input$calculate, {inputValue(input$input_value)})
calc <- reactive({
if (input$calculate > 0) {
Sys.sleep(3)
result <- inputValue() * 2
return(result)
} else {
return(NULL)
}
})
output$result <- renderText({
result <- calc()
if (!is.null(result)) {
return(paste("Result:", result))
} else {return(NULL)}
})
}
shinyApp(ui, server)
As I indicated in my comment, I believe this gives you what you want. Note that I've made some changes that remove your if
statments and do the same thing in a more "Shiny-like" manner.
library(shiny)
ui <- fluidPage(
numericInput("input_value", "Enter a number:", value = 1),
actionButton("calculate", "Calculate"),
textOutput("result")
)
server <- function(input, output) {
calc <- reactive({
input$calculate
isolate({
Sys.sleep(3)
input$input_value * 2
})
})
output$result <- renderText({
req(calc())
paste("Result:", calc())
})
}
shinyApp(ui, server)