How to insert reactive values into a table rendered using rhandsontable based on triggers in that ta-CodePudding

In running the code presented at the bottom of this post, a table ("hottable") is rendered on the bottom-right of the window using the rhandsontable package whereby row 2 of that table reflects the user input from the input$choices object in the selectInput() rendered immediately above it. Instead, I would like to change this whereby the "END" values from the dataframe "table1", rendered in the base Shiny table to the left, are reflected in that 2nd row of the rhandsontable “hottable” labeled "Floating reactive", as illustrated below, whereby the row from that dataframe to select "END" from is triggered by the value in row 1 of the rhandsontable labelled “Term A”. Please, any recommendations for how to do this?

Code:

library(rhandsontable)
library(shiny)
library(shinyjs)

mydata <- data.frame('Series 1' = c(1,1,0,1), check.names = FALSE)
rownames(mydata) <- c('Term A','Floating reactive','Term C','Term D') 

ui <- fluidPage(br(),
  column(6,
    sliderInput("periods","Nbr of months",min=1,max=20,value=10,step=1),
    sliderInput("beginAmt","Begin amount",min=100,max=500,value=250,step=50),
    sliderInput("npr","NPR",min=0.1,max=1,value=.3,step=0.1)
    ),
  column(6,
    sliderInput("mpr","MPR",min=0.1,max=1,value=.3,step=0.1),
    sliderInput("dft","DFT",min=0.1,max=1,value=.3,step=0.1),
    uiOutput("choices"),br(),
    ),
  br(),
  column(6,tableOutput("table1")),
  column(6,
         rHandsontableOutput('hottable'),
         fluidRow(column(1,br(),actionButton("addSeries", "Add",width = '70px')))
  )
)

server <- server <- function(input, output, session) {
  npr_vector <- reactive(rep(input$npr,input$periods))
  mpr_vector <- reactive(rep(input$mpr,input$periods))
  dft_vector <- reactive(rep(input$dft,input$periods))
  table2 <- reactiveVal(mydata)
  
  runOff <- reactive({
    f      <- function(x,y){x*(1 npr_vector()[y]-mpr_vector()[y]-dft_vector()[y]/12)}
    res    <- Reduce(f,seq(input$periods),init=input$beginAmt,accumulate=TRUE)
    b      <- head(res,-1)
    result <- data.frame(MO = seq(input$periods), 
                         NP = b*npr_vector(),  
                         MP = b*mpr_vector(), 
                         DFT = b*dft_vector()/12,   
                         END = res[-1]
                         )
  })
  
  output$table1 <- renderTable(runOff())
  
  observeEvent(input$hottable, {table2(hot_to_r(input$hottable))})
  
  output$hottable <- renderRHandsontable({rhandsontable(table2(),rowHeaderWidth=100,useTypes=TRUE)})
  
  observe({
    req(input$choices)
    tmpTable <- table2()
    tmpTable[2,] <- as.numeric(input$choices)
    table2(tmpTable)
  })
  
  output$choices <- 
    renderUI({
      selectInput(
        "choices", 
        label = "User selects value to reflect in row 2 of table below:",
        choices = c(1,2,3)
      )
    })
  
  observeEvent(input$addSeries, {
    newCol <- data.frame(c(1,1,0,1)) 
    newCol[2,] <- as.numeric(input$choices) 
    names(newCol) <- paste("Series", ncol(hot_to_r(input$hottable))   1)
    table2(cbind(table2(), newCol))
  })
}

shinyApp(ui, server)

CodePudding user response：

Please check the modified observe call:

library(rhandsontable)
library(shiny)
library(shinyjs)

mydata <- data.frame('Series 1' = c(1,1,0,1), check.names = FALSE)
rownames(mydata) <- c('Term A','Floating reactive','Term C','Term D') 

ui <- fluidPage(br(),
                column(6,
                       sliderInput("periods","Nbr of months",min=1,max=20,value=10,step=1),
                       sliderInput("beginAmt","Begin amount",min=100,max=500,value=250,step=50)
                ),
                column(6,
                       sliderInput("mpr","MPR",min=0.1,max=1,value=.3,step=0.1),
                       sliderInput("dft","DFT",min=0.1,max=1,value=.3,step=0.1)
                ),
                column(12, sliderInput("npr","NPR",min=0.1,max=1,value=.3,step=0.1)),
                br(),
                column(6,tableOutput("table1")),
                column(6,
                       rHandsontableOutput('hottable'),
                       fluidRow(column(1,br(),actionButton("addSeries", "Add",width = '70px')))
                )
)

server <- server <- function(input, output, session) {
  npr_vector <- reactive(rep(input$npr,input$periods))
  mpr_vector <- reactive(rep(input$mpr,input$periods))
  dft_vector <- reactive(rep(input$dft,input$periods))
  table2 <- reactiveVal(mydata)
  
  runOff <- reactive({
    f      <- function(x,y){x*(1 npr_vector()[y]-mpr_vector()[y]-dft_vector()[y]/12)}
    res    <- Reduce(f,seq(input$periods),init=input$beginAmt,accumulate=TRUE)
    b      <- head(res,-1)
    result <- data.frame(MO = seq(input$periods), 
                         NP = b*npr_vector(),  
                         MP = b*mpr_vector(), 
                         DFT = b*dft_vector()/12,   
                         END = res[-1]
    )
  })
  
  output$table1 <- renderTable(runOff())
  
  observeEvent(input$hottable, {table2(hot_to_r(input$hottable))})
  
  output$hottable <- renderRHandsontable({rhandsontable(table2(),rowHeaderWidth=100,useTypes=TRUE)})
  
  observe({
    req(runOff(), table2())
    tmpTable <- table2()
    tmpTable[2,] <- runOff()$END[unlist(table2()[1,])]
    table2(tmpTable)
  })

  observeEvent(input$addSeries, {
    newCol <- data.frame(c(1,1,0,1)) 
    names(newCol) <- paste("Series", ncol(hot_to_r(input$hottable))   1)
    table2(cbind(table2(), newCol))
  })
}

shinyApp(ui, server)