How to hide or disable one item in pickerInput selection of multiple items

Question

I am trying to develop a shinydashboard application. As users select their dataset and variables, I provide the option to select the order, color and shape. However, in the pi

Answer 1

Try this:

library(shiny)
library(shinydashboard)
library(shinyWidgets)
library(dplyr)

js <- "
$(document).ready(function(){
  $('#shapetype').on('show.bs.select', 'select[id^=linevars]', function(){
    $('a[role=option]').on('click', function(e){
      var classes = $(this).parent().attr('class').split(/\\s+/);
      if(classes.length === 2){
        var group = classes[0];
        var $ul = $(this).parent().parent();
        var selections = $ul.find('.' + group + '.selected');
        if(selections.length === 1){
          e.stopImmediatePropagation();
        }
      }else if(classes.length === 1){
        var group = classes[0];
        var $ul = $(this).parent().parent();
        var groupname = $ul.find('li.dropdown-header.' + group + '>span').text();
        if(groupname === 'Group'){
          e.stopImmediatePropagation();
        }
      }
    });
  }).on('hide.bs.select', 'select[id^=linevars]', function(){
    $('a[role=option]').off('click');
  });
});"


ui <- dashboardPage(
  dashboardHeader(title = "PickerInput Query", titleWidth=450),
  dashboardSidebar( width = 300,
                    sidebarMenu(id = "tabs")
  ),
  dashboardBody(
    tags$head(
      tags$style(HTML("
                      .col-sm-10 {
                      width: 45% !important;
                      }
                      
                      .col-sm-2 {
                      width: 55% !important;
                      }
                      
                      ")),
      tags$script(HTML(js))
    ),
    uiOutput('groupvar'),
    uiOutput('shapetype')
      ))

server <- function(input, output, session) {
  sx <- c("M","F")
  #arm <- c(rep("DrugA",2),rep("DrugB",2),rep("Placebo_NotDrug",1))
  arm <- c(rep("Drug A",2),rep("Drug B",2),rep("Placebo NotDrug",1))
  d <- data.frame(
    subjectID = c(1:100),
    sex = c(rep("F",9),rep(sx,43),rep("M",5)),
    treatment = c(rep(arm,20)),
    race = c(rep("W",76),rep("B",15),rep("O",5),rep("H",1),rep("A",3)),
    baseline_result = c(rnorm(50, 4, 3), rnorm(50, 3, 3)),
    postbase_result = c(rnorm(50, 5, 3), rnorm(50, 4, 2)),
    stringsAsFactors = FALSE)
  
  dat <- reactive(d)
  myfun <- function(df, var1) {
    df %>% mutate(newvar = !!sym(var1))      # create newvar
  }
  
  output$groupvar<-renderUI({
    bc<-colnames(dat()[sapply(dat(),class)=="character"])
    tagList(
      pickerInput(inputId = 'group.var',
                  label = 'Select group by variable. Then select order, color and shape',
                  choices = c("NONE",bc[1:length(bc)]), selected="NONE",
                  width = "350px",
                  options = list(`style` = "btn-warning"))
    )
  })
  
  ###  pick order, color and shape
  observeEvent(input$group.var, {
    output$shapetype<-renderUI({
      req(input$group.var,dat())
      if(is.null(input$group.var)){
        return(NULL)
      }else if(sum(input$group.var=="NONE")==1){
        return(NULL)
      }else{
        
        mydf <- subset(dat(), dat()[input$group.var] != "")
        mydf2 <- myfun(mydf,input$group.var)   ## create a new variable named newvar
        mygrp <- as.character(unique(mydf2$newvar))
        ngrp <- length(mygrp)
        myorder <- (1:ngrp)
        mycolor <- c("red", "blue", "green", "brown", "orange", "maroon")
        myshape <- c("circle", "triangle", "plus", "cross", "diamond", "downtriangle")
        lapply(1:ngrp, function(i){
          pickerInput(paste0("linevars",i),
                      label = paste0(mygrp[i], ":" ),
                      choices = list(DisplayOrder = myorder,
                                     ShapeColor = mycolor,
                                     ShapeType = myshape,
                                     Group = mygrp),  ## how do we hide or disable this 4th item
                      selected = list( i, mycolor[i], myshape[i], mygrp[i] ),
                      multiple = T,
                      inline = TRUE,
                      width = "275px" , #mywidth,
                      options = list('max-options-group' = 1,
                                     `style` = "btn-primary"))
        })
        
      }
    })
  }, ignoreInit = TRUE)
  
}

shinyApp(ui, server)

Answer 2

I am not sure what you want to achieve. Just remove the last group of choices called Group for each pickerInput?

library(shiny)
library(shinydashboard)
library(shinyWidgets)
library(shinyjs)
library(magrittr)
library(dplyr)

ui <- dashboardPage(
  dashboardHeader(title = "PickerInput Query", titleWidth=450),
  dashboardSidebar( width = 300,
                    useShinyjs(),
                    sidebarMenu(id = "tabs")
  ),
  dashboardBody(
    tags$head(
      tags$style(HTML("
                  .col-sm-10 {
                  width: 45% !important;
                  }
                  
                  .col-sm-2 {
                  width: 55% !important;
                  }
                  
                  "))),
    uiOutput('groupvar'),
    uiOutput('shapetype')
  ))

server <- function(input, output, session) {
  sx <- c("M","F")
  #arm <- c(rep("DrugA",2),rep("DrugB",2),rep("Placebo_NotDrug",1))  ##  content issue if longer than 6 characters
  arm <- c(rep("Drug A",2),rep("Drug B",2),rep("Placebo NotDrug",1))  ##  space issue in pickerintput label
  d <- data.frame(
    subjectID = c(1:100),
    sex = c(rep("F",9),rep(sx,43),rep("M",5)),
    treatment = c(rep(arm,20)),
    race = c(rep("W",76),rep("B",15),rep("O",5),rep("H",1),rep("A",3)),
    baseline_result = c(rnorm(50, 4, 3), rnorm(50, 3, 3)),
    postbase_result = c(rnorm(50, 5, 3), rnorm(50, 4, 2)),
    stringsAsFactors = FALSE)
  
  dat <- reactive(d)
  myfn <- function(df, var1) {
    df %>% mutate(newvar = !!sym(var1))      # create newvar
  }
  
  output$groupvar<-renderUI({
    bc<-colnames(dat()[sapply(dat(),class)=="character"])
    tagList(
      pickerInput(inputId = 'group.var',
                  label = 'Select group by variable. Then select order, color and shape',
                  choices = c("NONE",bc[1:length(bc)]), selected="NONE",
                  width = "350px",
                  options = list(`style` = "btn-warning"))
      
    )
  })
  
  ###  pick order, color and shape
  observeEvent(input$group.var, {
    output$shapetype<-renderUI({
      req(input$group.var,dat())
      if(is.null(input$group.var)){
        return(NULL)
      }else if(sum(input$group.var=="NONE")==1){
        return(NULL)
      }else{
        
        mydf <- subset(dat(), dat()[input$group.var] != "")
        mydf2 <- myfn(mydf,input$group.var)   ## create a new variable named newvar
        mygrp <- as.character(unique(mydf2$newvar))
        ngrp <- length(mygrp)
        myorder <- (1:ngrp)
        mycolor <- c("red", "blue", "green", "brown", "orange", "maroon")
        myshape <- c("circle", "triangle", "plus", "cross", "diamond", "downtriangle")
        
        lapply(1:ngrp, function(i){
          pickerInput(paste0("line.vars.",i),
                      label = paste0(mygrp[i], ":" ),
                      choices = list(DisplayOrder = myorder,
                                     ShapeColor = mycolor,
                                     ShapeType = myshape),  ## how do we hide or disable this 4th item
                      selected = list( i, mycolor[i], myshape[i], mygrp[i] ),
                      multiple = T,
                      inline = TRUE,
                      width = "275px" , #mywidth,
                      options = list('max-options-group' = 1, `style` = "btn-primary"))
        })
        
      }
    })
  }, ignoreInit = TRUE)
  
}

shinyApp(ui, server)