r - 有没有办法根据反应元素更新 url

Question

library(shinydashboard)
library(shiny)
library(dplyr)
# source("fun.R",local = TRUE)$value

ui <- navbarPage('TEST', id='page', collapsible =TRUE, inverse=FALSE,
                 # define a message handler that will receive the variables on the client side
                 # from the server and update the page accordingly.
                 tags$head(tags$script("
        Shiny.addCustomMessageHandler('updateSelections',
            function(data) {
                var nav_ref = '#page a:contains(\"' + data.nav + '\")';
                var tabpanel_id = data.nav == 'Alpha' ? '#alpha_tabs' : '#beta_tabs';
                var tab_ref = tabpanel_id + ' a:contains(\"' + data.tab + '\")';
                $(nav_ref).tab('show');
                $(tab_ref).tab('show');
            }
        )
    ")),
                 tabPanel('Alpha',
                          tabsetPanel(id='alph`a_tabs',
                                      tabPanel('Tab')
                          )
                 ),
                 tabPanel('Beta',
                          tabsetPanel(id='beta_tabs',
                                      tabPanel('Golf'),
                                      tabPanel('Hotel',
                                               selectInput("beverage", "Choose a beverage:", choices = c("Tea", "Coffee", "Cocoa")),
                                               # uiOutput("sd")
                                               selectInput("beverage1", "Choose a beverage:", choices = c("Tea1", "Coffee1", "Cocoa1"))
                                      )
                          )
                 )
)



server <- function(input, output, session) {
  
  # output$sd <- renderUI({
  #   selectInput("beverage1", "Choose a beverage:", choices = c("Tea1", "Coffee1", "Cocoa1"))
  # })

  observe({
    # print(df_fil())
    data <- parseQueryString(session$clientData$url_search)
    session$sendCustomMessage(type='updateSelections', data)
    updateSelectInput(session, 'beverage', selected=data$beverage)
    # update.default(session)
    updateSelectInput(session, 'beverage1', selected=data$beverage1)
  })
  
}

shinyApp(ui, server, enableBookmarking = "url")

如果你打开上面的应用程序并运行http://127.0.0.1:XXXX/?nav=Beta&tab=Hotel&beverage=Coffee&beverage1=Coffee1，你会得到正确的输出。我的意思是相应的选项卡和值...................................... …………

但是如果你在应用程序下面运行，它就不起作用

library(shinydashboard)
library(shiny)
library(dplyr)
# source("fun.R",local = TRUE)$value

ui <- navbarPage('TEST', id='page', collapsible =TRUE, inverse=FALSE,
                 # define a message handler that will receive the variables on the client side
                 # from the server and update the page accordingly.
                 tags$head(tags$script("
        Shiny.addCustomMessageHandler('updateSelections',
            function(data) {
                var nav_ref = '#page a:contains(\"' + data.nav + '\")';
                var tabpanel_id = data.nav == 'Alpha' ? '#alpha_tabs' : '#beta_tabs';
                var tab_ref = tabpanel_id + ' a:contains(\"' + data.tab + '\")';
                $(nav_ref).tab('show');
                $(tab_ref).tab('show');
            }
        )
    ")),
                 tabPanel('Alpha',
                          tabsetPanel(id='alph`a_tabs',
                                      tabPanel('Tab')
                          )
                 ),
                 tabPanel('Beta',
                          tabsetPanel(id='beta_tabs',
                                      tabPanel('Golf'),
                                      tabPanel('Hotel',
                                               selectInput("beverage", "Choose a beverage:", choices = c("Tea", "Coffee", "Cocoa")),
                                               uiOutput("sd")
                                               # selectInput("beverage1", "Choose a beverage:", choices = c("Tea1", "Coffee1", "Cocoa1"))
                                      )
                          )
                 )
)



server <- function(input, output, session) {
  
  output$sd <- renderUI({
    selectInput("beverage1", "Choose a beverage:", choices = c("Tea1", "Coffee1", "Cocoa1"))
  })

  observe({
    # print(df_fil())
    data <- parseQueryString(session$clientData$url_search)
    session$sendCustomMessage(type='updateSelections', data)
    updateSelectInput(session, 'beverage', selected=data$beverage)
    # update.default(session)
    updateSelectInput(session, 'beverage1', selected=data$beverage1)
  })
  
}

shinyApp(ui, server, enableBookmarking = "url")

现在打开上面的应用程序并运行http://127.0.0.1:XXXX/?nav=Beta&tab=Hotel&beverage=Coffee&beverage1=Coffee1. 它不会返回所需的状态...................................................... .....................

标签： rshiny