0%

模块化shiny app

当shiny app包含多个页面以及繁杂的代码,这时如果单纯的将所有代码写在一个app.R中可能难以维护以及管理,这时则需要考虑将其各个部分模块化;将一些重复代码封装到一个个模块中,方便多次调用

对于上述需求,shiny官方已有了很好的解决方案,如Modularizing Shiny app code 正好最近遇到这个需求,因此学习并整理下:

  • 可将模块化代码用于多个不同shiny app或者在一个shiny app里多次使用(比如复杂shiny程序中的重复代码)
  • 还可以将模块代码封装到R包中,被其他R包所调用
  • 可通过模块化代码拆解复杂的shiny app代码

模块代码是shiny程序中的一部分,其可代替ui/server中的任意一部分,除了有一些地方跟常规的shiny代码不太一样,其他部分几乎完全一样,因此上手比较简单,注意要点:

  • ui部分的代码需先有个ns <- NS(id)声明,相当于一个namespace函数,后续代码中的id需都调用ns函数
  • 如果一个模块代码中有多个插件或者布局函数,则需要将其封装在tagList中;如果只是一个插件,则不需要
  • 模块的server函数不能直接使用,需要通过callModule函数来调用;第一个参数是模块server函数,第二个参数是将模块ui函数的ID作为namespace,如果重复调用ui函数的话,只需要将其各个id保持不重复即可

模块函数还可以相互嵌套,比如第一个ui函数是innerUI,那么第2个ui函数需要调用第一个函数时,只需要也将id封装在ns函数中,如:innerUI(ns("inner1"));server函数相互调用时则需要封装在callModule函数中,官方例子如下:

innerUI <- function(id) {
  ns <- NS(id)
  "This is the inner UI"
}

outerUI <- function(id) {
  ns <- NS(id)
  wellPanel(
    innerUI(ns("inner1"))
  )
}

inner <- function(input, output, session) {
  # inner logic
}
outer <- function(input, output, session) {
  innerResult <- callModule(inner, "inner1")
  # outer logic
}

如果在sever函数中需要实时改变ui函数中的插件,这时的server函数中的ui对应的ID不能想常规的shiny代码那样跟ui函数中用一样的ID,而是需要新建一个namespace,官方例子如下:

columnChooserUI <- function(id) {
  ns <- NS(id)
  uiOutput(ns("controls"))
}

columnChooser <- function(input, output, session, data) {
  output$controls <- renderUI({
    ns <- session$ns
    selectInput(ns("col"), "Columns", names(data), multiple = TRUE)
  })

  return(reactive({
    validate(need(input$col, FALSE))
    data[,input$col]
  }))
}

那这些模块化代码一般写在哪里呢:

  • Inline code,即写在shiny app代码里,这样对于一些重复的ui/server函数,可以很好的减少重复工作量,使代码保持简洁
  • Standalone R file,即在shiny app代码外再一些R脚本专门存放模块代码,这种对于无需跨shiny app的模块代码来说,是个比较好的方案(个人也比较喜欢用这个,方便,简洁,可维护)
  • R package,即写到R包里,对于需要跨shiny app的模块代码来说,是个解决方案

官方还有个比较好的可模仿的例子:Communication between modules

我也将一个官方shiny程序将其改写成可模块化的样子

modules.R如下:

xx_mod_ui <- function(id){
  ns <- NS(id)

  tagList(
    sidebarPanel(
      selectInput(ns("xcol"), "X Variable", names(iris)),
      selectInput(ns("ycol"), "Y Variable", names(iris),
                  selected=names(iris)[[2]]),
      numericInput(ns("clusters"), "Cluster count", 3,
                   min = 1, max = 9)
    ),
    mainPanel(
      plotOutput(ns("plot1"))
    )
  )
}

xx_mod_server <- function(input, output, session){
  # Combine the selected variables into a new data frame
  selectedData <- reactive({
    iris[, c(input$xcol, input$ycol)]
  })

  clusters <- reactive({
    kmeans(selectedData(), input$clusters)
  })

  output$plot1 <- renderPlot({
    palette(c("#E41A1C", "#377EB8", "#4DAF4A", "#984EA3",
              "#FF7F00", "#FFFF33", "#A65628", "#F781BF", "#999999"))

    par(mar = c(5.1, 4.1, 0, 1))
    plot(selectedData(),
         col = clusters()$cluster,
         pch = 20, cex = 3)
    points(clusters()$centers, pch = 4, cex = 4, lwd = 4)
  })
}

app.R代码如下:

library(shiny)

data(iris)
# load separate module and function scripts
source("xx_modules.R")

ui <- fluidPage(
  headerPanel('Iris k-means clustering'),
  xx_mod_ui("input1")
)

server <- function(input, output, session) {
  res <- callModule(xx_mod_server, "input1")
}

shinyApp(ui, server)

本文出自于http://www.bioinfo-scrounger.com转载请注明出处