R中遍历列表调用自定义fluidrow函数生成连续HTML的方法

现有代码与场景 #

有一个基于fluidRow()生成HTML代码的自定义函数，已构造好待传入的列表对象，相关函数定义如下：

rawname = function(name){
  x = paste0(name, "_raw_ww_plot")
return(x)
}

w10 = function(name){
  x = paste0(name, "_10ws_plot")
  return(x)
}

w20 = function(name){
  x = paste0(name, "_20ws_plot")
  return(x)
}

listname = function(name){
  x = list(c(map_chr(name, w10), "Previous 10 Weeks"),
           c(map_chr(name, w20), "Previous 20 Weeks"),
           c(map_chr(name, rawname), "All Time"))
  return(x)
}

make.fluidrow = function(html, list, bar = hr(), col = 12, 
                         box.num = 2){
  htmlvar = sapply(html, function(x) {
    paste0("<div style='text-align:center'><h3>", 
           x,
           "</h3></div><br>")})
  
  if (box.num == 1){
    row = fluidRow(
      column(col,
             box(HTML(htmlvar[1]),
                 do.call(tabsetPanel, 
                         lapply(list, function(y){tabPanel(y[2], 
                                                           plotlyOutput(y[1], 
                                                                        height = "100%"),                                                            width = 6)}))),
             bar))
  } else if (box.num == 2)
    row = fluidRow(
      column(col,
             box(HTML(htmlvar[1]),
                 do.call(tabsetPanel, 
                         lapply(list, function(y){tabPanel(y[3], 
                                                           plotlyOutput(y[1], 
                                                                        height = "100%"), 
                                                           width = 6)}))),
             box(HTML(htmlvar[2]),
                 do.call(tabsetPanel, 
                         lapply(list, function(y){tabPanel(y[3], 
                                                           plotlyOutput(y[2], 
                                                                        height = "100%"), 
                                                           width = 6)}))),
             bar))
  return(row)  
}

本次使用的测试列表构造代码如下：

a1 = list(c("San Francisco Public Utilities Commission (SFPUC) Oceanside",
               "San Francisco Public Utilities Commission (SFPUC) Southeast"),
             listname(c("SFOcean", "SFPUC_SE")))

a2 = list(c("East Bay Municpal Utility District (EBMUD)",
                "Central Contra Costa Sanitation District (CCCSD)"),
              listname(c("EBMUD", "CCCSD")))
a3 = list(c("Silicon Valley Clean Water",
                "Palo Alto Regional Water Quality Control Plant"),
              listname(c("SVCW", "PA")))
alist = list(a1, a2, a3)

目标是遍历alist列表，生成和以下手动逐行调用输出完全一致的连续可渲染HTML代码：

make.fluidrow(html = a1[[1]], list = a1[[2]][3], bar = br()),
make.fluidrow(html = a2[[1]], list = a2[[2]][3], bar = br()),
make.fluidrow(html = a3[[1]], list = a3[[2]][3], bar = br()))

遇到的报错 #

• 用purrr包map()函数遍历调用时，返回的是HTML代码列表，而非连续可直接渲染的HTML，代码如下：

map(alist,  ~make.fluidrow(html = .[[1]], list = .[[2]][3], bar = br()))

• 尝试用do.call()拼接代码时报错Error in do.call(make.fluidrow, c(alist, list(html = .[[1]], list = .[[2]][3], : object '.' not found，错误代码如下：

do.call(make.fluidrow, c(alist, list(html = .[[1]], list = .[[2]][3], bar = br())))

解决方案 #

1. 遍历生成连续HTML的实现方法 #

Shiny的HTML标签对象本质是S3类的列表结构，手动在UI中用逗号分隔多个组件时，Shiny内部会自动将其转为tagList结构处理。map()返回的是多个独立fluidRow对象组成的列表，只需要用tagList()包裹一层，就能得到和手动逐行写完全等价的连续可渲染HTML：

library(shiny)
library(purrr)

final_html <- tagList(
  map(alist,  ~make.fluidrow(html = .[[1]], list = .[[2]][3], bar = br()))
)

该方法生成的结果和手动逐行调用的输出完全一致，可以直接放到Shiny UI中渲染。

2. do.call的传参逻辑说明 #

do.call()支持传入列表元素作为函数参数，但它本身没有purrr lambda语法里的.占位符——.是purrr包自定义的匿名函数简写规则，只能在purrr的lambda公式（即~xxx写法）里使用，直接在do.call参数里写.[[1]]会因为找不到.对象报错。
另外注意：单次调用do.call(make.fluidrow, args)只会生成一个fluidRow，要生成多行需要先对每个子列表构造对应的参数集，批量调用后再拼接。用do.call实现同样效果的代码如下：

# 为alist中每个元素构造make.fluidrow对应的命名参数列表
arg_set <- lapply(alist, function(item) {
  list(
    html = item[[1]],
    list = item[[2]][3],
    bar = br()
  )
})
# 批量调用make.fluidrow生成所有行
row_list <- lapply(arg_set, function(args) {
  do.call(make.fluidrow, args)
})
# 拼接为连续可渲染HTML
final_html <- do.call(tagList, row_list)

内容的提问来源于stack exchange，提问作者kelvinfrog