閃亮：將值保留在主面板中

Question

此應用程序顯示 3 個列表之間的單選按鈕選擇：低位、高位、數字項目

要對其進行測試，請將以下代碼保存在“閃亮”目錄和 app.R 文件中。 然后啟動 R 並鍵入：

library(shiny
runApp("shiny")

默認選擇是較低的列表。

選擇列表中出現“選擇或鍵入項目”這句話，感謝占位符選項。

如果我在此列表中選擇一個項目，如“a”，所選項目將出現在右側的主面板中。

如果我更改列表的類型，顯示數字，則會出現一個新的選擇列表，其中包含數字作為選擇。

但是第一個選擇“a”的項目從右側的主面板中消失了。

如果我選擇數字“2”，它會出現在右側的主面板中。

問題是即使我使用單選按鈕更改列表類型，我也想將所選項目保留在主面板中。

我不明白為什么這個選擇會消失，因為在單選按鈕的 oberveEvent 中，rval reactiveValues 沒有改變。

library(shinyjs)

ui <-fluidPage(
     useShinyjs(),
     id = "page",
    sidebarLayout(position = "left",
      sidebarPanel(
        radioButtons(
          "choice_btn", "Choose list:",
          c("Lower" = "lower", "Upper" = "upper", "Digit" = "digit"),
          selected="lower"
        ),
        selectizeInput(
          inputId="lower_choice",
          label="List of lower items",
          choices=NULL,
          selected=NULL,
          options = list(placeholder='select or type an item')
        ),
        selectizeInput(
          inputId="upper_choice",
          label="List of upper items",
          choices=NULL,
          selected=NULL,
          options = list(placeholder='select or type an item')
        ),
        selectizeInput(
          inputId="digit_choice",
          label="List of digit items",
          choices=NULL,
          selected=NULL,
          options = list(placeholder='select or type an item')
        )
      ),
      mainPanel(
        textOutput("item")  
      )
    )
  )    

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

  updateSelectizeInput(session, 'lower_choice', choices = c("a","b","c","d"), selected = character(0), server = TRUE)
  updateSelectizeInput(session, 'upper_choice', choices = c("A","B","C","D") , selected = character(0), server = TRUE)
  updateSelectizeInput(session, 'digit_choice', choices = c(1,2,3,4) , selected = character(0), server = TRUE)
  
  shinyjs::hide("upper_choice")
  shinyjs::hide("digit_choice")
  output$item <- renderText({ rval() })
  
  observeEvent(input$choice_btn, {
    choice  <- input$choice_btn
    choices <- c("lower", "upper", "digit")
    shinyjs::show(paste0(choice,"_choice"))
    updateSelectizeInput(session, 'lower_choice', choices = c("a","b","c","d"), selected = character(0), server = TRUE)
    updateSelectizeInput(session, 'upper_choice', choices = c("A","B","C","D"), selected = character(0), server = TRUE)
    updateSelectizeInput(session, 'digit_choice', choices = c(1,2,3,4), selected = character(0), server = TRUE)
    for (x in choices) {
      if ( x != choice ) {
        shinyjs::hide(paste0(x,"_choice"))
        }
    }
    
  })
 
  observeEvent(input$lower_choice, {
    rval(input$lower_choice)
  })
  
  observeEvent(input$upper_choice, {
    rval(input$upper_choice)
  })
  
  observeEvent(input$digit_choice, {
    rval(input$digit_choice)
  })
  
# end shinyServer   
}

shinyApp(ui, server)

感謝您的幫助

Answer 1

恕我直言，問題是當用戶切換列表類型時，您的所有selectizeInput更新。 因此，每個selectizeInput的選定值都設置為空字符串"" 。 因此，所選列表的observeEvent被觸發，並且reactiveVal被更新為一個空字符串，這就是textInput顯示的內容。

一種防止這種情況的選項是，只有在用戶做出選擇時，只有在選擇與空字符串不同時，才能向您的每個observeEvent添加if語句以更新reactiveVal值：

library(shinyjs)
library(shiny)

ui <- fluidPage(
  useShinyjs(),
  id = "page",
  sidebarLayout(
    position = "left",
    sidebarPanel(
      radioButtons(
        "choice_btn", "Choose list:",
        c("Lower" = "lower", "Upper" = "upper", "Digit" = "digit"),
        selected = "lower"
      ),
      selectizeInput(
        inputId = "lower_choice",
        label = "List of lower items",
        choices = NULL,
        selected = NULL,
        options = list(placeholder = "select or type an item")
      ),
      selectizeInput(
        inputId = "upper_choice",
        label = "List of upper items",
        choices = NULL,
        selected = NULL,
        options = list(placeholder = "select or type an item")
      ),
      selectizeInput(
        inputId = "digit_choice",
        label = "List of digit items",
        choices = NULL,
        selected = NULL,
        options = list(placeholder = "select or type an item")
      )
    ),
    mainPanel(
      textOutput("item")
    )
  )
)

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

  output$item <- renderText({
    rval()
  })

  observeEvent(input$choice_btn, {
    choice <- input$choice_btn
    choices <- c("lower", "upper", "digit")
    
    for (x in choices[!choices %in% choice]) {
      shinyjs::hide(paste0(x, "_choice"))
    }
    
    shinyjs::show(paste0(choice, "_choice"))
    
    updateSelectizeInput(session, 'lower_choice', choices = c("a","b","c","d"), selected = character(0), server = TRUE)
    updateSelectizeInput(session, 'upper_choice', choices = c("A","B","C","D"), selected = character(0), server = TRUE)
    updateSelectizeInput(session, 'digit_choice', choices = c(1,2,3,4), selected = character(0), server = TRUE)
  })

  observeEvent(input$lower_choice, {
    if (input$lower_choice != "") rval(input$lower_choice)
  })

  observeEvent(input$upper_choice, {
    if (input$upper_choice != "") rval(input$upper_choice)
  })

  observeEvent(input$digit_choice, {
    if (input$digit_choice != "") rval(input$digit_choice)
  })
}

shinyApp(ui, server)