KeepNotes blog

Stay hungry, Stay Foolish.

0%

模块化shiny app

Posted on Edited on In
Symbols count in article: 3k Reading time ≈ 3 mins.

当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转载请注明出处

Related Posts