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

前端 未结 2 1175
佛祖请我去吃肉
佛祖请我去吃肉 2021-01-23 09:28

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

2条回答
  •  深忆病人
    2021-01-23 10:09

    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)
    

提交回复
热议问题