Reputation: 1
So I want to have a table of values in an rHOT that update whenever 1) the underlying data is updated via reactive input AND 2) whenever you update the values in the rHOT table.
The code below manages to refresh the real avgs/cums table when the input$ changes. Then I can type new values into the rHOT table' avgs and the cums will update.
But I want to refresh the rHOT table's values all over again when you change the input$ again, and still be receptive to changes in its own Avg row.
library(dplyr)
library(shiny)
library(shinydashboard)
library(rhandsontable)
accdntprd<-1:5
StatData<-as.data.frame(matrix(c(100, 150, 175, 180, 200, 110,
168, 192, 205, 210, 115, 169,
202, 200, 100, 125, 185, 100,
120, 130, 150, 180, 190, 200, 210),
nrow = 5, byrow = TRUE))
StatData<-as.data.frame(cbind(accdntprd,StatData[1:5,]))
ui <- dashboardPage(
dashboardHeader(title="Shiny"),
dashboardSidebar(
sidebarMenu(id="tabs", menuItem("Blocks", tabName = "Blocks"))),
dashboardBody(tabItems(
tabItem("Blocks",
fluidRow(box(width=12
,div(tableOutput("DFs"))
,div(rHandsontableOutput("rTable"))
)),
fluidRow(width=12,
box(radioButtons("SelAvgMeth", "averaging", choices= c("straight", "trim"), selected = "straight"))
)
)
))
)
server<-function(input, output) {
observeEvent(
input$SelAvgMeth, {
rTable_content <<- reactive({
t<-ifelse(input$SelAvgMeth=="trim",1, 0)
Avgs<-t(sapply((2:5),function(i){mean(StatData[, i+1]/StatData[, i], trim = t/4)}))
Avgs<-rev(Avgs)
Cums<-cumprod(Avgs)
DF<-t(as.data.frame(cbind(rev(Avgs), rev(Cums))))
DF<-data.frame(DF)
rownames(DF)<-c("Avgs", "Cums")
return(DF)
})
output$DFs<-renderTable({
rTable_content()
}, digits = 3, spacing = "xs", rownames = TRUE)
})
MyChanges <- reactive({
if(is.null(input$rTable)|(identical(rTable_content(),input$rTable))){
return(rTable_content())
} else {
selDF<- as.data.frame(hot_to_r(input$rTable))
selDF[2,]<-rev(cumprod(rev(as.numeric(selDF[1,]))))
rownames(selDF)<-c("Avgs", "Cums")
return(selDF)
}
})
output$rTable <- renderRHandsontable({
rhandsontable(MyChanges())%>% hot_cols(format = "0.000")
})
}
shinyApp(ui, server)
I know the observe event is not really necessary, but let's leave it there in case I want to control for other inputs.
Forgive me if I asked this wrong. The code is reproducible.
How it should work in pictures:
Upvotes: 0
Views: 1412
Reputation: 30539
Thanks for the additional details.
I might create separate reactiveValues
to store your tables and give you more flexibility.
The part I'm still unclear on is what should happen if the radio button is selected after the rHOT table has changed. Right now, it just sets both tables back based on original data.
See if this has the behavior you were looking for.
server<-function(input, output) {
rv <- reactiveValues(table1 = NULL,
table2 = NULL)
observeEvent(input$SelAvgMeth,{
t <- ifelse(input$SelAvgMeth == "trim", 1, 0)
Avgs<-t(sapply((2:5),function(i){mean(StatData[, i+1]/StatData[, i], trim = t/4)}))
Avgs<-rev(Avgs)
Cums<-cumprod(Avgs)
DF<-t(as.data.frame(cbind(rev(Avgs), rev(Cums))))
DF<-data.frame(DF)
rownames(DF)<-c("Avgs", "Cums")
rv$table1<-rv$table2<-DF
})
output$DFs<-renderTable({
rv$table1
}, digits = 3, spacing = "xs", rownames = TRUE)
observe({
if (!is.null(input$rTable)){
selDF<- as.data.frame(hot_to_r(input$rTable))
selDF[2,]<-rev(cumprod(rev(as.numeric(selDF[1,]))))
rownames(selDF)<-c("Avgs", "Cums")
rv$table2 <- selDF
}
})
output$rTable <- renderRHandsontable({
rhandsontable(rv$table2) %>%
hot_cols(format = "0.000")
})
}
Upvotes: 2