呈现HTML中的分组列表

问题描述

我正在尝试按组（分组或嵌套）制作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)

打印屏幕：

解决方法

我发现改变此行的方法有些混乱

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,function(x) HTML(as.character(x[[1]])))
             #value = lapply(df[i,as.character)
             #value = as.character(df[i,2][[1]])
          )
        )
      })
    })
  })  
}

shinyApp(ui,server)