从服务器传递闪亮的小部件初始值

Question

要启用应用程序特定状态的共享，我想根据提供的 URL 哈希设置小部件初始 selected 值。我只是不知道如何在初始化阶段传递哈希值。这说明：

library(shiny); library(shinyjs)

urlCode = "shinyjs.pageURL = function(params){ if(params[0] != ''){location.href = location.origin + '/#' + params[0];}}"

server = function(input, output, session) {
  observeEvent(session$clientData$url_hash, {
    hash = substr(session$clientData$url_hash, 2,10)
    # I need to pass hash to selectInput selected value
    # and pass `toupper(hash)` to tabsetPanel selected value
  })

  observeEvent(input$txt, {
    js$pageURL(input$txt) # appends tab choice to URL as hash
  })
}

ui = fluidPage(
  useShinyjs(),
  extendShinyjs(text = urlCode),
  selectInput("txt", "tab choice:", c("one", "two", "three"), selected = 'two'), # to be initialised as hash value

  # tab menu
  tabsetPanel(id = 'tab_menu', selected = 'TWO',  # to be initialised as hash value
              tabPanel("ONE",   textInput('txt_one', 'one text', '')),
              tabPanel("TWO",   textInput('txt_two', 'two text', '')),
              tabPanel("THREE", textInput('txt_three', 'three text', ''))
  )
)

shinyApp(ui = ui, server = server, options = list(launch.browser=T))

值当前初始化为“二”（selectInput）和“二”（tabsetPanel），但在 URL 调用为例如http://domain/#three（相对于根 http://domain/）。感谢任何指点。

Answer 1

您必须删除"#" 并使用update* 函数，如下所示：

library(shiny)

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

  observe({
    hash <- gsub(pattern = "#", replacement = "", x = session$clientData$url_hash)
    updateTabsetPanel(session = session, inputId = "tab_menu", selected = toupper(hash))
    updateSelectInput(session = session, inputId = "txt", selected = hash)
  })
}

ui <- fluidPage(

  selectInput("txt", "tab choice:", c("one", "two", "three"), selected = 'two'), # to be initialised as hash value

  # tab menu
  tabsetPanel(
    id = 'tab_menu', selected = 'TWO',  # to be initialised as hash value
    tabPanel("ONE",   textInput('txt_one', 'one text', '')),
    tabPanel("TWO",   textInput('txt_two', 'two text', '')),
    tabPanel("THREE", textInput('txt_three', 'three text', ''))
  )
)

shinyApp(ui = ui, server = server)