在 HTML 中呈现分组列表答案

【问题标题】：render grouped list in HTML在 HTML 中呈现分组列表
【发布时间】：2020-11-09 21:19:32
【问题描述】：

我正在尝试按组（分组或嵌套）制作 HTML 详细元素。函数div_detail_each 格式化一行并存储为 shiny.tag 类。之后我按组嵌套，用unify_divs统一标签。

我用mtcars 做了一个小例子。 uiOutput 没有达到预期的 HTML；在插入 HTML 语句以检查它是否正确呈现之前，我在控制台中创建了 print。

似乎列表元素与htmltools 发生了一些冲突。

希望有人可以帮助我。

library(shiny)
library(broom)

df <- mtcars %>%
  mutate(
    DETAIL = pmap(
      .l = list(mpg, hp),
      .f = ~ div_detail_each(..1, ..2)
    )
  ) %>%
  group_by(
    cyl
  ) %>%
  nest() %>% 
  mutate(
    detail = map(
      .x = data,
      .f = ~ unify_divs(.x$DETAIL)
    )
  ) %>%
  select(
    cyl, detail
  )


div_detail_each <- function(mpg, hp, ...){
  mydiv <- div(
    class = "child", id = "child", 
    strong("detailed info: "),
    paste0(
      "mpg:", mpg, ", hp:", hp
    )
  ) 
  
  if(hp < 90) {
    mydiv <- tagAppendAttributes(
      mydiv,
      style = 'color:red'
    )
  }
  return(mydiv)
}  

unify_divs <- function(children_list){
  mydiv <- div(class = "parent", id = "container")
  mydiv <- tagSetChildren(mydiv, children_list)
  mydiv 
}

ui <- fluidPage(
  fluidRow(
    actionButton("do", "Do")
  ),
  fluidRow(
    uiOutput("detail")
  )
)    

server <- function(input, output, session){
  observeEvent(input$do, {
    output$detail <- renderUI({
      map(seq_len(nrow(df)), function(i) {
        print(df[i, 2][[1]])
        fluidRow(
          valueBox(
            value = as.character(df[i, 2][[1]]),
            subtitle = "Details",
            width = 12
          )
        )
      })
    })
  })  
}

shinyApp(ui, server)

打印屏幕：

【问题讨论】：

你能检查seq_len(nrow(df))而不是seq_along(nrow(df))

标签： r shiny purrr htmltools

【解决方案1】：

我发现了一个有点混乱的解决方案，改变这条线

lapply(df[i, 2], function(x) HTML(as.character(x[[1]])))

但是在地图中放一个 lapply 似乎是无稽之谈

library(shiny)
library(broom)

df <- mtcars %>%
  mutate(
    DETAIL = pmap(
      .l = list(mpg, hp),
      .f = ~ div_detail_each(..1, ..2)
    )
  ) %>%
  group_by(
    cyl
  ) %>%
  nest() %>% 
  mutate(
    detail = map(
      .x = data,
      .f = ~ unify_divs(.x$DETAIL)
    )
  ) %>%
  select(
    cyl, detail
  )


div_detail_each <- function(mpg, hp, ...){
  mydiv <- div(
    class = "child", id = "child", 
    strong("detailed info: "),
    paste0(
      "mpg:", mpg, ", hp:", hp
    )
  ) 
  
  if(hp < 90) {
    mydiv <- tagAppendAttributes(
      mydiv,
      style = 'color:red'
    )
  }
  return(mydiv)
}  

unify_divs <- function(children_list){
  mydiv <- div(class = "parent", id = "container")
  mydiv <- tagSetChildren(mydiv, children_list)
  mydiv 
}

ui <- fluidPage(
  fluidRow(
    actionButton("do", "Do")
  ),
  fluidRow(
    uiOutput("detail")
  )
)    

server <- function(input, output, session){
  observeEvent(input$do, {
    output$detail <- renderUI({
      map(seq_len(nrow(df)), function(i) {
        print(df[i, 2][[1]])
        fluidRow(
          column(2 ,paste0("group ", i)),
          column(10,
             lapply(df[i, 2][[1]], function(x) HTML(as.character(x)))     
             #lapply(df[i, 2], function(x) HTML(as.character(x[[1]])))
             #value = lapply(df[i, 2][[1]], as.character)
             #value = as.character(df[i, 2][[1]])
          )
        )
      })
    })
  })  
}

shinyApp(ui, server)

【讨论】：