R перенаправляющий маршрутизатор на URL, содержащий параметры - PullRequest
0 голосов
/ 28 января 2020

Я хочу выполнить перенаправление на URL с параметрами, такими как https://www.google.com.tw/webhp?newwindow=1, что хорошо работает в базовом c блестящем приложении, как показано ниже:

library(shiny)
jscode <- "Shiny.addCustomMessageHandler('mymessage', function(message) {window.location = 'https://www.google.com.tw/webhp?newwindow=1';});"

ui <- fluidPage(
  tags$head(tags$script(jscode)),     
  checkboxInput("Redirect","Redirect",value = T)
)

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

  observeEvent(input$Redirect,{
    if(!input$Redirect){
      session$sendCustomMessage("mymessage", "mymessage")
    }
  })
}

shinyApp(ui,server)

Тем не менее, он не работает, если он находится в области действия iny.router , для получения более подробной информации см. Код ниже. Моя последняя цель - только перенаправление на страницу side , содержащую параметры. Заранее спасибо.

library(shiny)
library(shiny.router)

jscode <- "Shiny.addCustomMessageHandler('mymessage', function(message) {window.location = 'https://www.google.com.tw/webhp?newwindow=1';});"

# This generates menu in user interface with links.
menu <- (
  tags$ul(
    tags$li(a(class = "item", href = route_link("home"), "Home page")),
    tags$li(a(class = "item", href = route_link("side"), "Side page"))
  )
)

# This creates UI for each page.
page <- function(title, content) {
  div(
    menu,
    titlePanel(title),
    p(content),
    actionButton("switch_page", "Click to switch page!")
  )
}

# Both sample pages.
home_page <- page("Home page", uiOutput("current_page"))
side_page <- page("Side page", uiOutput("current_page"))

# Creates router. We provide routing path, a UI as
# well as a server-side callback for each page.
router <- make_router(
  route("home", home_page, NA),
  route("side", side_page, NA)
)

# Create output for our router in main UI of Shiny app.
ui <- shinyUI(fluidPage(
  router_ui()
))

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

  output$current_page <- renderText({
    page <- get_page(session)
    sprintf("Welcome on %s page!", page)
  })

  observeEvent(input$switch_page, {
    if (is_page("home")) {
      #change_page("side")
      session$sendCustomMessage("mymessage", "mymessage")
    } else if (is_page("side")) {
      change_page("home")
    }
  })
})

shinyApp(ui, server)

1 Ответ

0 голосов
/ 11 февраля 2020

Ответ таков:

library(shiny)
library(shiny.router)

jscode <- "Shiny.addCustomMessageHandler('mymessage', function(message) {window.location = 'https://www.google.com.tw/webhp?newwindow=1';});"

# This generates menu in user interface with links.
menu <- (
  tags$ul(
    tags$li(a(class = "item", href = route_link("home"), "Home page")),
    tags$li(a(class = "item", href = route_link("side"), "Side page"))
  )
)

# This creates UI for each page.
page <- function(title, content) {
  div(
    menu,
    titlePanel(title),
    p(content),
    actionButton("switch_page", "Click to switch page!")
  )
}

# Both sample pages.
home_page <- page("Home page", uiOutput("current_page"))
side_page <- page("Side page", uiOutput("current_page"))

# Creates router. We provide routing path, a UI as
# well as a server-side callback for each page.
router <- make_router(
  route("home", home_page, NA),
  route("side", side_page, NA)
)

# Create output for our router in main UI of Shiny app.
ui <- shinyUI(fluidPage(
  tags$head(tags$script(jscode)),
  router_ui()
))

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

  output$current_page <- renderText({
    page <- get_page(session)
    sprintf("Welcome on %s page!", page)
  })

  observeEvent(input$switch_page, {
    if (is_page("home")) {
      #change_page("side")
      session$sendCustomMessage("mymessage", "mymessage")
    } else if (is_page("side")) {
      change_page("home")
    }
  })
})

shinyApp(ui, server)
...