【发布时间】：2020-06-22 04:00:26
【问题描述】：
我正在尝试开发一个闪亮的仪表板应用程序。当用户选择他们的数据集和变量时，我提供了选择顺序、颜色和形状的选项。但是，在 pickerInput 中，我还提供了另一个（第 4 个）项目，它是已为其分配了顺序、颜色和形状的所选变量的值。我需要第 4 项/变量进行进一步处理，例如子集数据。我想隐藏第 4 项或禁用应用程序用户选择的选项，因为它已经显示在左侧。如果我现在禁用它，它就不能用于进一步处理。示例代码如下：
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,
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)
I would appreciate any help to resolve this issue.
**UPDATE:** On running the code above I get
以下输出。 在 Group 下显示的最后一个项目是我希望用户没有机会选择的项目。
用户应该仍然能够为每个治疗元素选择顺序、颜色和形状。
【问题讨论】：
-
您的问题无法重现。在运行您的应用程序时，我会得到一个
pickerInput和两个选项：NONE和NA。默认选择NONE，UI 为空白。选择NA，我得到一个“未定义的列选择”错误。 -
我已更新以显示我得到的输出。也许上面列出的所有库都应该取消注释。我可能需要再列出几个库。
-
@Limey，抱歉我错过了两个库。我添加了
dplyr和magrittr。
标签： r shiny shinydashboard