Change cells based on modifications of other cells

2020-04-20 06:39发布

问题:

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.