update_material_dropdown fails to update choices and values correctly with multiple = TRUE

[jameswcraig]

Hi,

I have 2 dropdowns in below example - attempting to update choices in dropdown 2 with values selected in dropdown 1, while also retaining previously selected choices in dropdown 2. You can reproduce error by: first selecting "a" in dropdown 2, then, selecting "a", "b", "c" in dropdown 1, then attempting to change selections in dropdown 2 with newly available choices from dropdown1 will disable further selections..

Note: Also tried using observereEvent(input$dropddown1{...}) for the update_material_dropdown observer but the issue where user cannot further select choices in dropdown2 still appears (although delayed).

library(shinymaterial)
library(shinyjs)

ui <- material_page(
  useShinyjs(),
  material_dropdown("dropdown1", label = "dropdown1", choices = c("a","b","c","d"), multiple = TRUE),
  material_dropdown("dropdown2", label = "dropdown2", choices = c("a","b","c","d"), multiple =TRUE)
)

server <- function(input, output, session){

  reactives <- reactiveValues( 
    val = list()
  )

  observe({
    reactives$val$choices <- input$dropdown1
    reactives$val$values <- input$dropdown2
  }, priority = 1)

  observe({
    update_material_dropdown(session, input_id = "dropdown2", choices = reactives$val$choices, value = reactives$val$values )
  })
}

shinyApp(ui, server)

Thanks again for your work on this package, this functionality seems to be quite important that it works correctly.

[jameswcraig]

@ericrayanderson After further testing, I expect value is not accounting for possible vector of input values multiple = TRUE as I was receiving error the condition has length > 1 and only the first element will be used for the below code execution in update_material_dropdown:

if(!(value %in% choices)) {
      message("ERROR: value '", value, "' not found in choices")
      return(NULL)
    }

Changing to:

 `%notin%` <- Negate(`%in%`)

    if(any(value %notin% choices)) {
      message("ERROR: value '", value, "' not found in choices")
      return(NULL)
    }

...introduced the following: ERROR: value 'ab' not found in choices

Hopefully that can help point you in a direction where to investigate. Sorry I can't be of more help, I'm still very much learning JS.

[ericrayanderson]

@jameswcraig

Can you try the latest dev version: remotes::install_github("ericrayanderson/shinymaterial")

Note - In this version, the function update_material_dropdown has a new required parameter: multiple.

[jameswcraig]

Thanks @ericrayanderson but it still does not appear to be working correctly.

I've added the multiple = TRUE argument to update_material_dropdown in the original reprex but I'm still having issues. Selecting "a" and "b" in dropdown1 to limit choices in dropdown2 to "a" and "b" only works after making a choice in dropdown2 (which I suppose makes sense because I specified value = reactives$val$values in update_material_dropdown and reactives$val$values is NULL until selections are made in dropdown2. However, after subsequently making selections "a" and "b" in dropdown2, I receive ERROR: value 'NA' not found in choices and the selections made in dropdown2 disappear.

[ericrayanderson]

@jameswcraig

Just to rule this out - does this exact example work using the standard shiny versions? (selectInput and updateSelectInput)?

[jameswcraig]

@ericrayanderson yes it does, see reprex:

ui <- fluidPage(
  selectInput("dropdown1", label = "dropdown1", choices = c("a","b","c","d"), multiple = TRUE),
  selectInput("dropdown2", label = "dropdown2", choices = c("a","b","c","d"), multiple =TRUE)
)

server <- function(input, output, session){

  reactives <- reactiveValues( 
    val = list()
  )

  observe({
    reactives$val$choices <- input$dropdown1
    reactives$val$values <- input$dropdown2
  }, priority = 1)

  observe({
    updateSelectInput(session, inputId = "dropdown2", choices = reactives$val$choices, selected = reactives$val$values )
  })
}

shinyApp(ui, server)

[ericrayanderson]

@jameswcraig

Thank you, I think I found the difference between mine and the shiny version. I updated again, please install with:

remotes::install_github("ericrayanderson/shinymaterial")

Thanks for finding this issue.

[jameswcraig]

Thanks @ericrayanderson but there still appears to be an issue. Selecting a,b,c in dropdown1 does immediately limit choices in dropdown2 to a,b,c however, when I make selections in dropdown2 i.e. a,b,c there is an error ERROR: value 'abc' not found in choices

It appears the selections are being returned as a single string instead of a character vector?

Also, when I go back to dropdown1 and only select a,b the choices in dropdown2 are still a,b,c when they should be only a,b

[ericrayanderson]

@jameswcraig

Still working on this - materialize css does not provide a method to programmatically (javascript) select multiple items.

This may be a tricky issue to solve.

[rodrigoestrellac]

Hello a few years too late ! @jameswcraig you can try this modified version of the function:

update_material_dropdown <- function(session, input_id, value = NULL, choices = NULL){
  if(is.null(value)) {
    message("ERROR: Must include 'value' with update_material_dropdown")
    return(NULL)
  }

  if(!is.null(choices)){

    if ( is.null(names(choices)) ){
      names(choices) <- choices
    }

    if(!(value %in% choices)) {
      message("ERROR: value '", value, "' not found in choices")
      return(NULL)
    }

    choices_value_js_code <- paste0("$('#", input_id, "').empty(); $('#", input_id, "')")

    for(i in 1:length(choices)){

      choices_value_js_code <- paste0(
        choices_value_js_code,
        ".append('<option value=DOUBLEQUOTE",
        gsub(pattern = " ", replacement = "_shinymaterialdropdownspace_", x = choices[i], fixed = TRUE),
        "DOUBLEQUOTE>&nbsp;", names(choices)[i], "</option>')"
      )

    }

    choices_value_js_code <- gsub(pattern = "DOUBLEQUOTE", replacement = '"', x = choices_value_js_code)

    session$sendCustomMessage(
      type = "shinymaterialJS",
      choices_value_js_code
    )

    choices_label_js_code <- paste0("$('#shiny-material-dropdown-", input_id, "').find('ul').empty(); $('#shiny-material-dropdown-", input_id, "').find('ul')")

    for(i in 1:length(choices)){

      choices_label_js_code <- paste0(
        choices_label_js_code,
        ".append('<li><span>&nbsp;", names(choices)[i], "</span></li>')"
      )

    }

    session$sendCustomMessage(
      type = "shinymaterialJS",
      choices_label_js_code
    )

  }

  # Prepare the selected values, replacing spaces if necessary
  valueShow <- sapply(value, function(v) gsub(" ", "_shinymaterialdropdownspace_", v, fixed = TRUE))

  # Join the values into a JavaScript array format if multiple values exist
  if (length(value) > 1) {
    valueShow_js <- paste0('["', paste(valueShow, collapse = '","'), '"]')
  } else {
    valueShow_js <- paste0('"', valueShow, '"')
  }

  value_js_code <- paste0(
    # // Clear previous selections
    "$(", paste0("'#", input_id, "'"), ").val([]);",

    # // Loop through and set new selected values
    if (length(value) > 1) {
      paste0(
        "$.each(", valueShow_js, ", function(index, val) {",
        "$(", paste0("'#", input_id, "'"), ").find('option[value=\"' + val + '\"]').prop('selected', true);",
        "});"
      )
    } else {
      paste0(
        "$(", paste0("'#", input_id, "'"), ").find('option[value=", valueShow_js, "]').prop('selected', true);"
      )
    },

    # // Reinitialize the dropdown UI and notify Shiny about the selected values
    "setTimeout(function() { $(", paste0("'#", input_id, "'"), ").formSelect(); Shiny.onInputChange('", input_id, "', ", valueShow_js, "); }, 100);"
  )

  value_js_code <- gsub(pattern = "DOUBLEQUOTE", replacement = '"', x = value_js_code)

  session$sendCustomMessage(
    type = "shinymaterialJS",
    value_js_code
  )
}