在 HTML 中呈现分组列表

Question

我正在尝试按组（分组或嵌套）制作一个 HTML 详细元素。函数div_detail_each格式化一行并存储为shiny.tagclass。之后我按组嵌套，统一标签为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)

打印屏幕：

Answer 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)

在 HTML 中呈现分组列表

render grouped list in HTML

r

shiny

purrr

htmltools