r - 根据对 Shiny 中上一个菜单的响应显示不同的选择菜单

问题描述

我正在尝试根据用户对上一个菜单的响应以闪亮的方式动态显示不同的选择菜单。例如，如果用户选择启动顺序的“竞选_id”，则应将下拉菜单带有适当的选项。但是，如果他们选择销售活动，他们应该获得折扣百分比的数字文本条目。我已经创建了所有合适的选择菜单，但现在我需要弄清楚如何动态显示它们。我尝试根据对上一个问题的响应使用 ifelse 逻辑，但它始终显示与所有错误响应关联的菜单。

我怀疑当逻辑评估先前的响应时，响应的格式不正确，或者其中有一些 html，因此逻辑总是评估为 false。我已经包含了一个我正在经历的简化示例。任何帮助是极大的赞赏。

library(shiny)
library(tidyverse)

# data referenced 1
cid <- tibble(
  name = c(
    'Free Content',
    'Launch Sequence',
    'Mega Sale',
    'Sale Email',
    'Sale Reminder',
    'VSL Push'
  ),
  abbr = c('FC',
           'LS',
           'MS',
           'SE',
           'SR',
           'VP')
)

# data referenced 2
csid <- tibble(
  name = c(
    'Free Content',
    'Launch Sequence',
    'Launch Sequence',
    'Launch Sequence',
    'Launch Sequence',
    'Launch Sequence',
    'Mega Sale',
    'Sale Email',
    'Sale Reminder',
    'VSL Push'
  ),
  subname = c(
    'topic text entry',
    'Launch Sequence1',
    'Launch Sequence2',
    'Launch Sequence3',
    'Launch Sequence4',
    'Launch Sequence5',
    'NA',
    'discount numeric entry',
    'NA',
    'url'
  ),
  abbr = c(
    'NA1',
    'LS1',
    'LS2',
    'LS3',
    'LS4',
    'LS5',
    'NA2',
    'NA3',
    'NA4',
    'NA5'
  )
)


ui <- fluidPage(
                titlePanel("Example Selection"),     
                
                sidebarLayout(
                  sidebarPanel(
                    selectInput(
                      inputId = 'campaign_id',
                      label = 'Campaign ID',
                      choices = c(cid$name)
                    ),
                    
                    uiOutput(ifelse(
                      # which selection menu to display based on campaign_id
                      'cid' == 'Launch Sequence',
                      'ls',
                      ifelse(
                        'cid' == 'Free Content',
                        'fc',
                        ifelse(
                          'cid' == 'Sale Email',
                          'se',
                          ifelse('cid' == 'VSL Push',
                                 'vp',
                                 'mssr')
                        )
                      )
                    )),
                    
                    
                    textInput(
                      inputId = 'date',
                      label = 'Launch Date',
                      placeholder = paste0('use date format "', Sys.Date(), '"')
                    )
                    
                    
                  ),
                  
                  ############### Main panel for displaying outputs ----
                  mainPanel(
                            textOutput(outputId = "campaign_name"))
                ))

############## server functions --------------------------------------
server <- function(input, output) {
  # build campaign sub-id list based on campaign selected ----
  cidselected <- reactive({
    input$campaign_id
  })
  
  output$cid <- renderText({
    cidselected()
  })
  
  output$ls = renderUI({
    selectInput(
      inputId = 'campaign_subid',
      label = 'Campaign Sub-ID',
      choices = c(
        'Launch Sequence1',
        'Launch Sequence2',
        'Launch Sequence3',
        'Launch Sequence4',
        'Launch Sequence5'
      )
    )
  })
  
  output$fc = renderUI({
    textInput(inputId = 'campaign_subid',
              label = 'Campaign Sub-ID',
              placeholder = '1-3 word description of main topic')
  })
  
  output$vp =  renderUI({
    textInput(inputId = 'campaign_subid',
              label = 'Campaign Sub-ID',
              placeholder = 'enter VSL url here')
  })
  
  output$mssr = renderUI({
    selectInput(inputId = 'campaign_subid',
                label = 'Campaign Sub-ID',
                choices = c('N/A'))
  })
  
  output$se = renderUI({
    numericInput(
      inputId = 'campaign_subid',
      label = 'Campaign Sub-ID (enter as whole number 40% = 40)',
      value = 0,
      min = 0,
      max = 100
    )
  })
  
  output$campaign_name <-
    renderText({
      # display combined name with abbreviations
      cid = cid$abbr[cid$name == input$campaign_id]
      csid = input$campaign_subid
      date = gsub('-', '', input$date, fixed = T)
      paste(cid,
            csid,
            date,
            sep = '-')
      
    })
  
  
}

shinyApp(ui = ui, server = server)

标签： rshiny

r - 根据对 Shiny 中上一个菜单的响应显示不同的选择菜单

问题描述

解决方案

推荐阅读