2

I'm trying to collect the value of a column ('Type') in a rhandsontable based on the the selection of the adjacent logical column ('Tick'). I want to create a vector of all the Type's based on the which rows are ticked.

I will use the vector to subset the columns in the other rhandsontable 'Aims'

I'm getting the error

Warning: Error in match: 'match' requires vector arguments

library(rhandsontable)
library(shiny)

orgs <- c("Community leaders/representatives",
          "Members of local community/indigenous committees",
          "Landowners/customary area owners",
          "National government",
          "Sub-national or local government",
          "Managed area manager/personnel",
          "International NGO",
          "Local or national NGO",
          "Community based organizations - women’s groups",
          "Community based organizations - men’s groups",
          "Community based organizations - youth/school groups",
          "Community based organizations - religious groups",
          "Community based organizations - conservation groups",
          "Industry", 
          "Private sector",
          "Academic institute or research facility",
          "Other")

proj_aim3 <- data.frame(Category = c("Area", "Condition", "Diversity"))
proj_aim3 <- cbind(proj_aim3, setNames( lapply(orgs, function(x) x=NA), orgs) )

ui <- fluidPage(
  rHandsontableOutput('Intiated'),
  verbatimTextOutput('selected'),
  br(),
  rHandsontableOutput("Aims2")
)

server <- function(input, output, session) {
  
  cats <- c("Community leaders/representatives", "Members of local community/indigenous committees", "Landowners/customary area owners", "National government", "Sub-national or local government", "Managed area manager/personnel",
            "International NGO", "Local or national NGO", "Community based organizations - women’s groups", "Community based organizations - men’s groups",
            "Community based organizations - youth/school groups", "Community based organizations - religious groups",  "Industry", "Private sector", 
            "Academic institute or research facility", "Not recorded", "Other")
  
  DF <- data.frame(Tick = rep(FALSE, length(cats)), Type = cats, Name = rep("", length(cats)))
  
  output$Intiated <- renderRHandsontable(
    rhandsontable(DF, selectCallback = TRUE, readOnly = FALSE)
  )
  
  selected2 <- reactive({     
    dat <- hot_to_r(input$Intiated)     
    if (any(dat[[1]])) {       
      dat[which(dat[[1]]), 2]      
    }   
  })
  
  output$selected <- renderPrint({
    cat(paste(selected2(), collapse = "\n"))
  })
  
  
  Aims_DF_NEW <- proj_aim3
  imps2 <- c("Primary", "Secondary", "Tertiary")
  
  sel <- selected2
  
  output$Aims2 <- renderRHandsontable({
    
    Aims_DF_NEW <- Aims_DF_NEW[, which(names(Aims_DF_NEW) %in% sel)]

    rhandsontable(Aims_DF_NEW, rowHeaders = NULL, width = 1500, height = 600) %>%
      hot_col(col = "Category", readOnly = T) %>%
      hot_cols(cols = Aims_DF_NEW[,2:ncol(Aims_DF_NEW)], type = "autocomplete", source = imps2, strict = TRUE, colWidths = 200)})
  
}

shinyApp(ui = ui, server = server)
Thomas Worthington
  • 133
  • 5

2 Answers2

1

You could try the following approach. Use hot_to_r to get your data from the handsontable as an R object. Check the first column for any checked items (which would be TRUE boolean values). If there are, you can extract the second column of data, using the row indices based on the first column that are TRUE.

Note that the code in output$selected can be moved to a separate reactive expression, so that the selected results can be used elsewhere.

Also, you would need parentheses for selected2(). selected2() should return a character vector of the Type selected.

To select the appropriate columns from your second data.frame Aims_DF_NEW, you can try:

Aims_DF_NEW[, names(Aims_DF_NEW) %in% selected2(), drop = F]

This will only include columns in Aims_DF_NEW that are included in the selected2() result. drop = F is added so the result is not coerced to a vector if only 1 column selected (and remains a data.frame).

Here is a revised version to subset the second table based on the first table (second table simplified to demonstrate).

library(rhandsontable)
library(shiny)

orgs <- c("Community leaders/representatives",
          "Members of local community/indigenous committees",
          "Landowners/customary area owners",
          "National government",
          "Sub-national or local government",
          "Managed area manager/personnel",
          "International NGO",
          "Local or national NGO",
          "Community based organizations - women’s groups",
          "Community based organizations - men’s groups",
          "Community based organizations - youth/school groups",
          "Community based organizations - religious groups",
          "Community based organizations - conservation groups",
          "Industry", 
          "Private sector",
          "Academic institute or research facility",
          "Other")

proj_aim3 <- data.frame(Category = c("Area", "Condition", "Diversity"))
proj_aim3 <- cbind(proj_aim3, setNames( lapply(orgs, function(x) x=NA), orgs))
Aims_DF_NEW <- proj_aim3
imps2 <- c("Primary", "Secondary", "Tertiary")

ui <- fluidPage(
  rHandsontableOutput('Intiated'),
  verbatimTextOutput('selected'),
  br(),
  rHandsontableOutput("Aims2")
)

server <- function(input, output, session) {
  
  cats <- c("Community leaders/representatives", "Members of local community/indigenous committees", "Landowners/customary area owners", "National government", "Sub-national or local government", "Managed area manager/personnel",
            "International NGO", "Local or national NGO", "Community based organizations - women’s groups", "Community based organizations - men’s groups",
            "Community based organizations - youth/school groups", "Community based organizations - religious groups",  "Industry", "Private sector", 
            "Academic institute or research facility", "Not recorded", "Other")
  
  DF <- data.frame(Tick = rep(FALSE, length(cats)), Type = cats, Name = rep("", length(cats)))
  
  output$Intiated <- renderRHandsontable(
    rhandsontable(DF, selectCallback = TRUE, readOnly = FALSE)
  )
  
  selected2 <- reactive({     
    dat <- hot_to_r(input$Intiated)     
    if (any(dat[[1]])) {       
      dat[which(dat[[1]]), 2]      
    }   
  })
  
  output$selected <- renderPrint({
    cat(paste(selected2(), collapse = "\n"))
  })
  
  output$Aims2 <- renderRHandsontable({
    rhandsontable(Aims_DF_NEW[, names(Aims_DF_NEW) %in% selected2(), drop = F], rowHeaders = NULL, width = 1500, height = 600) 
  })
  
}

shinyApp(ui = ui, server = server)
Ben
  • 28,684
  • 5
  • 23
  • 45
  • This works well although I'm struggling to access the values as a ``reactive`` expression. I have added a second term ``selected2 <- reactive({ dat <- hot_to_r(input$Intiated) if (any(dat[[1]])) { dat[which(dat[[1]]), 2] } })`` which is returning an error "Unsupported object type: character Can't extract column types" when i try to subset a the second rhandsontable – Thomas Worthington Aug 03 '21 at 09:54
  • @ThomasWorthington Please see edited example and let me know if this helps. Make sure to access the character vector as `selected2()` with parentheses. If this doesn't work, feel free to edit the question with more detail on how you're using `selected2` with a second rhandsontable. – Ben Aug 03 '21 at 10:44
  • @'Ben' I've edited the question to clarify what I'm aiming for – Thomas Worthington Aug 03 '21 at 12:37
  • `selected2` is a `reactive` expression, so to use this you need parentheses: `selected2()`. Some of the second `rhandsontable` is a bit confusing for me, but I was able to get this to work in a simplified form: `output$Aims2 <- renderRHandsontable({ rhandsontable(Aims_DF_NEW[, selected2(), drop = F], rowHeaders = NULL, width = 1500, height = 600) })`...here you can subset your `Aims_DF_NEW` data.frame using `selected2()`...`drop = F` is added so if you select one column it doesn't get coerced to a vector (stays a data frame)... – Ben Aug 03 '21 at 12:56
  • You can also try `Aims_DF_NEW[, names(Aims_DF_NEW) %in% selected2(), drop = F]` to make sure the columns are available from `Aims_DF_NEW` – Ben Aug 03 '21 at 13:09
1

Putting together the answers from @Ben. Here is a solution

library(rhandsontable)
library(shiny)

orgs <- c("Community leaders/representatives",
          "Members of local community/indigenous committees",
          "Landowners/customary area owners",
          "National government",
          "Sub-national or local government",
          "Managed area manager/personnel",
          "International NGO",
          "Local or national NGO",
          "Community based organizations - women’s groups",
          "Community based organizations - men’s groups",
          "Community based organizations - youth/school groups",
          "Community based organizations - religious groups",
          "Community based organizations - conservation groups",
          "Industry", 
          "Private sector",
          "Academic institute or research facility",
          "Other")

proj_aim3 <- data.frame(Category = c("Area", "Condition", "Diversity"))
proj_aim3 <- cbind(proj_aim3, setNames( lapply(orgs, function(x) x=NA), orgs) )

ui <- fluidPage(
  rHandsontableOutput('Intiated'),
  verbatimTextOutput('selected'),
  br(),
  rHandsontableOutput("Aims2")
)

server <- function(input, output, session) {
  
  cats <- c("Community leaders/representatives", "Members of local community/indigenous committees", "Landowners/customary area owners", "National government", "Sub-national or local government", "Managed area manager/personnel",
            "International NGO", "Local or national NGO", "Community based organizations - women’s groups", "Community based organizations - men’s groups",
            "Community based organizations - youth/school groups", "Community based organizations - religious groups",  "Industry", "Private sector", 
            "Academic institute or research facility", "Not recorded", "Other")
  
  DF <- data.frame(Tick = rep(FALSE, length(cats)), Type = cats, Name = rep("", length(cats)))
  
  output$Intiated <- renderRHandsontable(
    rhandsontable(DF, selectCallback = TRUE, readOnly = FALSE)
  )
  
  selected2 <- reactive({     
    dat <- hot_to_r(input$Intiated)     
    if (any(dat[[1]])) {       
      dat[which(dat[[1]]), 2]      
    }   
  })
  
  output$selected <- renderPrint({
    cat(paste(selected2(), collapse = "\n"))
  })
  
  
  Aims_DF_NEW <- proj_aim3
  imps2 <- c("Primary", "Secondary", "Tertiary")
  
  Cat <- data.frame(Aims_DF_NEW[, 1])
  colnames(Cat) <- c("Category")

  output$Aims2 <- renderRHandsontable({   rhandsontable(cbind(Cat, Aims_DF_NEW[, selected2(), drop = F]), rowHeaders = NULL, width = 1500, height = 600) %>%
      hot_col(col = "Category", readOnly = T) %>%
      hot_cols(cols = Aims_DF_NEW[,2:ncol(Aims_DF_NEW)], type = "autocomplete", source = imps2, strict = TRUE, colWidths = 200)})
  
}

shinyApp(ui = ui, server = server)
Thomas Worthington
  • 133
  • 5