I am trying to make an HTML detailed elements by group (grouped or nested).
The function div_detail_each
format one row and stored as shiny.tag class.
After that, I nest by group and unify the tags with unify_divs
.
I make a tiny example with mtcars
. The uiOutput
does not the HTML as expected; I made a print
in console before inserting the HTML statement to check it was rendered correctly.
It seems list elements has done some conflict with htmltools
.
Hope someone could help me.
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)
I found a somewhat messy solution varying this line
lapply(df[i, 2], function(x) HTML(as.character(x[[1]])))
But putting a lapply inside a map seems nonsense
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)