在使用shiny.flutter和shiny.router构建的R Shiny应用程序中的route_link之后更新导航栏中的所选项目

Question

我在使用

shiny.fluent

和

shiny.router

R 包构建的 R Shiny 应用程序中面临以下问题。

在“主页”上，我有一个指向“测试页面”的

href = route_link([...])

链接。该链接有效，它将我带到所需的“测试页面”。但左侧垂直导航栏并没有更新（仍然是“Home”，识别为具有不同背景颜色的所选项目）。

有人知道发生了什么事吗？

我花了几个小时尝试修复它，但到目前为止没有任何效果...我想用一些javascript可以轻松解决问题，但我对js的了解真的很差...

欢迎任何解决问题的建议（无论是否是js）！！！

以下最少代码：

library(dplyr)
library(glue)
library(shiny)
library(shiny.fluent)
library(shiny.router)

makeCard <- function(title, content, size = 12, style = "") {
  div(class = glue("card ms-depth-8 ms-sm{size} ms-xl{size}"),
      style = style,
      Stack(
        tokens = list(childrenGap = 5),
        Text(variant = "large", title, block = TRUE),
        content
      ))
}
makePage <- function (title, subtitle, contents) {
  tagList(div(
    class = "page-title",
    span(title, class = "ms-fontSize-32 ms-fontWeight-semibold", style =
           "color: #323130"),
    span(subtitle, class = "ms-fontSize-14 ms-fontWeight-regular", style =
           "color: #605E5C; margin: 14px;")
  ),
  contents)
}
navigation <- "navigation"

navigation <- Nav(
  groups = list(
    list(links = list(
      list(name = 'Home', url = '#!/', key = 'home', icon = 'Home'),
      list(name = 'Test', url = '#!/test', key = 'test', icon = 'AnalyticsReport')
      ))
  ),
  initialSelectedKey = 'home',
  styles = list(
    root = list(
      height = '100%',
      boxSizing = 'border-box',
      overflowY = 'auto'
    )
  )
)
layout <- function(mainUI){
  div(class = "grid-container",
      div(class = "sidenav", navigation),
      div(class = "main", mainUI)
  )
}

home_page <- makePage(
  "This is a Fluent UI app built in Shiny",
  "shiny.react + Fluent UI = shiny.fluent",
  uiOutput(paste0("changepage"))
)
test_page <- makePage(
  "This is a Fluent UI app built in Shiny",
  "shiny.react + Fluent UI = shiny.fluent",
  div(
    makeCard(
      "shiny.react makes it easy to use React libraries in Shiny apps.",
      div(
        Text("my test")
      ))
  )
)

router <- make_router(
  route("/", home_page),
  route("test", test_page))

# Add shiny.router dependencies manually: they are not picked up because they're added in a non-standard way.
shiny::addResourcePath("shiny.router", system.file("www", package = "shiny.router"))
shiny_router_js_src <- file.path("shiny.router", "shiny.router.js")
shiny_router_script_tag <- shiny::tags$script(type = "text/javascript", src = shiny_router_js_src)

ui <- fluentPage(
  layout(router$ui),
  tags$head(
    tags$link(href = "mystyle.css", rel = "stylesheet", type = "text/css"),
    shiny_router_script_tag
  ))

server <- function(input, output, session) {
  router$server(input, output, session)
  output$changepage <- renderUI({
    list(
      tags$ul(
### <<<< WHEN CLICKING ON THIS LINK, NAV BAR SELECTED ITEM IS NOT UPDATED <<<<<<<<<<<<<<<
        tags$li(a(href = route_link("test"), "Go to test page"))
      )
    )
  })
}

shinyApp(ui, server)

要正确显示，还需要www/mystyle.css

body {
  background-color: rgba(225, 223, 221, 0.2);
  min-height: 611px;
  margin: 0;
}
.page-title {
  padding: 52px 0px;
}
.card {
  background: #fff;
  padding: 28px;
  margin-bottom: 28px;
  border-radius: 2px;
  background-clip: padding-box;
}
.grid-container {
  display: grid;
  grid-template-columns: 320px 1fr;
  grid-template-rows: 54px 1fr 45px;
  grid-template-areas: "header header" "sidenav main" "footer footer";
  height: 100vh;
}
.main {
  grid-area: main;
  background-color: #faf9f8;
  padding-left: 40px;
  padding-right: 32px;
  max-width: calc(100vw - 400px);
  max-height: calc(100vh - 100px);
  overflow: auto;
}
.sidenav {
  grid-area: sidenav;
  background-color: #fff;
  padding: 25px;
}

Answer 1

嗨@mazu。

您描述的预期行为不是

shiny.router::route_link

函数的责任，它只会更改页面，UI中的任何副作用都需要您自己实现。

请参阅此讨论如何使用

shiny.router

和

shiny.fluent

的现有功能在服务器端实现。