如何解决呈现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)
版权声明:本文内容由互联网用户自发贡献,该文观点与技术仅代表作者本人。本站仅提供信息存储空间服务,不拥有所有权,不承担相关法律责任。如发现本站有涉嫌侵权/违法违规的内容, 请发送邮件至 dio@foxmail.com 举报,一经查实,本站将立刻删除。