问题
I am trying to build a shiny app with rhandsontable in it. This rhandsontable is based on the datframe I create inside the app.
In the app I initially display the first row of this dataframe with al 3 columns. When the value of the 1st column is modified by the list of its dropdown levels and press search then the other 2 columns are modified.
I would like to do the same with the second column as well. Also I would like initially to display only the first 2 columns and the third will be displayed when the search button is pressed and of course if this row exists.
I tried to replicate what I did for the 1st column (commented code) but it does not work. The first 2 columns should always display all of their levels in the dropdown but the third only the available ones after the every search.
DF = data.frame(agency_postcode = factor(rep(c(12345,45678,24124,32525,32325),2)),
car_group=factor(rep(c("Microcar","City car","Supermini","Compact","SUV"),2)),
transmission=factor(rep(c("automatic","manual"),5)))
write.csv(DF,"C:/Users/User/Documents/Test//cars.csv", row.names = FALSE)
ui.r
library(shiny)
library(rhandsontable)
ui <- fluidPage(
titlePanel("RHandsontable"),
sidebarLayout(
sidebarPanel(
fileInput("file1", "Choose CSV File",
accept = c(
"text/csv",
"text/comma-separated-values,text/plain",
".csv"),
actionButton("sr", "Search")
),
mainPanel(
rHandsontableOutput("test")
)
)
)
server.r
server <- function(input, output) {
# Assign value of 12345 as default to postcode for the default table rendering
values <- reactiveValues(postcode = "12345"
#car_group = "Microcar"
,tabledata = data.frame())
# An observer which will check the value assigned to postcode variable and create the sample dataframe
observeEvent(values$postcode,{
inFile <- input$file1
if (is.null(inFile))
return(NULL)
DF<- read.csv(inFile$datapath,stringsAsFactors = T)
for(i in 1:ncol(DF)){
DF[,i]<-as.factor(DF[,i])
}
DF
DF2 = data.frame(agency_postcode = factor(rep(c(12345,45678,24124,32525,32325),2)),
car_group=factor(rep(c("Microcar","City car","Supermini","Compact","SUV"),2)),
transmission=factor(rep(c("automatic","manual"),5)))
# Created dataframe is assigned to a reactive dataframe 'tabledata'
values$tabledata <- DF2[ which(DF2$agency_postcode ==values$postcode
#&DF2$car_group==values$car_group
), ]
for(i in 2:ncol(values$tabledata)){
values$tabledata[,i] <- factor(values$tabledata[,i])
}
})
# Capture changes made in the first column of table and assign the value to the postcode reactive variable. This would then trigger the previous observer
observeEvent(input$test$changes$changes,{
col <- input$test$changes$changes[[1]][[2]]
if(col==0){
values$postcode <- input$test$changes$changes[[1]][[4]]
#values$car_group<-input$test$changes$changes[[1]][[4]]
}
})
# Use the reactive df 'tabledata' to render.
output$test <- renderRHandsontable({input$sr
isolate(rhandsontable(values$tabledata[1,], rowHeaders = NULL, width = 550, height = 300)%>%
hot_col(colnames(values$tabledata)))
})
}
回答1:
In the code that you have added for retrieving the value selected in second column, we would need to update something.
if(col==0){
values$postcode <- input$test$changes$changes[[1]][[4]]
#values$car_group<-input$test$changes$changes[[1]][[4]]
}
Index of handsontable starts with 0. So, its 0 for first column and 1 for second column, meaning you cannot update the values to car_group reactive variable within the if condition for the first column
A solution to your current question based on the answer that I provided here. Update rhandsontable by changing one cell value
library(shiny)
library(rhandsontable)
ui <- fluidPage(
titlePanel("RHandsontable"),
sidebarLayout(
sidebarPanel(),
mainPanel(
rHandsontableOutput("test")
)
)
)
server <- function(input, output) {
# Assigning blank values to reactive variable as all the values need to be listed first
values <- reactiveValues(postcode = "",cargroup = "",tabledata = data.frame())
observeEvent(values$postcode,{
DF2 = data.frame(agency_postcode = factor(rep(c(12345,45678,24124,32525,32325),2)),
car_group=factor(rep(c("Microcar","City car","Supermini","Compact","SUV"),2)),
transmission=factor(rep(c("automatic","manual"),5)))
# When the user selects any value from the dropdown, filter the table and update the value of reactive df
if(values$postcode!=""){
values$tabledata <- DF2[ which(DF2$agency_postcode ==values$postcode), ]
}else{
# When the postcode value is blank, meaning the user hasn't selected any, the table
# will render without the third column
values$tabledata <- DF2[,-3]
}
})
observeEvent(values$cargroup,{
DF2 = data.frame(agency_postcode = factor(rep(c(12345,45678,24124,32525,32325),2)),
car_group=factor(rep(c("Microcar","City car","Supermini","Compact","SUV"),2)),
transmission=factor(rep(c("automatic","manual"),5)))
values$tabledata <- DF2
# When the user selects any value from the dropdown, filter the table and update the value of reactive df
if(values$cargroup!=""){
values$tabledata <- DF2[ which(DF2$car_group ==values$cargroup), ]
}else{
# When the cargroup value is blank, meaning the user hasn't selected any, the table
# will render without the third column
values$tabledata <- DF2[,-3]
}
})
# Observer for changes made to the hot
observeEvent(input$test$changes$changes,{
col <- input$test$changes$changes[[1]][[2]]
# Changes made in first column
if(col==0){
values$postcode <- input$test$changes$changes[[1]][[4]]
}
# Changes made in second column
if(col==1){
values$cargroup <- input$test$changes$changes[[1]][[4]]
}
})
# Render the hot object
output$test <- renderRHandsontable({
rhandsontable(values$tabledata[1,], rowHeaders = NULL, width = 550, height = 300)%>%
hot_col(colnames(values$tabledata))
})
}
shinyApp(ui = ui, server = server)
Check if this suits your needs. You can then update the observer part based on search button instead of being reactive to the changes made by user.
来源：https://stackoverflow.com/questions/57937662/change-cells-based-on-modifications-of-other-cells-in-rhandsontable-of-a-shiny-a