r - 在 HTML 中呈现分组列表

Question

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

我用mtcars. uiOutput不符合预期的 HTML ；print在插入 HTML 语句以检查它是否正确呈现之前，我做了一个控制台。

似乎列表元素与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)

打印画面：

标签： rshinypurrrhtmltools

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)