Question

我有一个闪亮的应用程序，我想在GUI中显示一些文档页面。以下应用程序适用于作为源包安装的软件包，即使用

install.packages(packagename, type = "source")

但是，对于二进制包，我无法从包目录中提取相同的html文件。由于.Rd，访问tools::Rd2HTML文件就足够了。任何帮助将不胜感激。

library(shiny)

# get a character vector containing all source packages or packages
# containing more than two files in pkgdir/html
pkgs <- rownames(installed.packages())
ndoc <- vapply(pkgs, function(pkg){
  length(list.files(system.file("html", package = pkg)))}, 0)
src_pkgs <- pkgs[ndoc > 2]

ui <- fluidPage(
  selectInput("package", "select package", src_pkgs),
  uiOutput("choose_topic"),
  wellPanel(uiOutput("documentation"))
)

server <- function(input, output, session){
  output$choose_topic <- renderUI({
    choices <- list.files(system.file("html", package = input$package))
    selectInput("topic", "select topic", choices)
  })

  output$documentation <- renderUI({
    includeHTML(
      system.file(paste0("html/", req(input$topic)), package = input$package)
    )
  })
}

shinyApp(ui, server)

修改

我想出了一种使用tools::startDynamicHelp显示手册页的替代方法。这适用于所有包，甚至可以启用到其他手册页的链接。但是，这个approch不能与shiny-server一起使用，因为它使用了环回接口（127.0.0.1）。

library(shiny)

pkgs <- rownames(installed.packages())

ui <- fluidPage(sidebarLayout(
  sidebarPanel(
    selectInput("package", "select package", pkgs),
    uiOutput("choose_topic")
  ),
  mainPanel(uiOutput("documentation"))
))

server <- function(input, output, session){
  port <-  tools::startDynamicHelp(NA)
  home <- paste0("http://127.0.0.1:", port)

  output$choose_topic <- renderUI({
    choices <- unique(readRDS(system.file("help/aliases.rds", package = input$package)))
    selectInput("topic", "select topic", choices)
  })

  output$documentation <- renderUI({
    url <- paste0(home, "/library/", input$package, "/html/", input$topic,".html")
    tags$iframe(src = url, width = "100%", height = "900px")
  })
}

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

Answer 1

我终于找到了一种方法来使用packagedir/help中的文件，感谢Rbloggers上的this post。

此版本获取Rd-database（RdDB）文件的内容，然后在HTML文件夹中构建文档文件的tmp版本。它会禁用所有链接，这实际上是我想要的。它也适用于shiny-server。

library(shiny)
library(tools)

ui <- fluidPage(sidebarLayout(
  sidebarPanel(
    selectInput("package", "select package", .packages(all.available = TRUE)),
    uiOutput("choose_topic")
  ),
  mainPanel(uiOutput("documentation"))
))

server <- function(input, output, session){
  tmp <- tempfile()
  onSessionEnded(function(){ unlink(tmp) })

  RdDatabase <- reactive({
    Rd_db(input$package)
  })

  output$choose_topic <- renderUI({
    selectInput("topic", "select topic", sub(".Rd", "", names(RdDatabase())))
  })

  output$documentation <- renderUI({
    rdfile <- paste0(input$topic, ".Rd")
    req(rdfile %in% names(RdDatabase()))
    Rd2HTML(RdDatabase()[[rdfile]], tmp, no_links = TRUE, package = input$package)
    includeHTML(tmp)
  })
}

shinyApp(ui, server)

在闪亮的应用中显示文档页面

修改

1 个答案: