Dear members of the community,
I am using the R package sunburstR in order to create a sunburst plot into Shiny. The code below works perfect and I am able to create the plot, however, I would like to remove the legend completely. For this reason I know that using HTML5 I will be able to play more with the parameters of the plot.
rm(list = ls())
library(shiny)
library(shinydashboard)
library(sunburstR)
library(data.table)
ui <- dashboardPage(
dashboardHeader(),
dashboardSidebar(
sidebarMenu(
menuItem("Sunburst Plot", tabName = "sunbrstPlot")
)
),
dashboardBody( tabBox(id = "sunbrstPlot", width = "100%", height = "1000px",
sunburstOutput("sunburstPlot", height = "750", width = "100%")
)
)
)
server <- function(input, output) {
# Create Sunburst plot
output$sunburstPlot <- renderSunburst({
tempDat <- data.table(A=sample(rep(c("a","b","c","d","e"), 100)), B = sample(rep(c("a","b","c","d","e"), 100)), C = sample(rep(c("a","b","c","d","e"), 100)))
tempDat[,c("V1","V2"):= list(paste0(A,"-",B, "-", C),1)]
sunburst(tempDat[,.(V1,V2)])
})
}
shinyApp(ui, server)
The HTML5 code that is written for this chart is:
print(sunburstOutput("sunburstPlot", height = "750", width = "100%"))
<div class="sunburst html-widget html-widget-output" id="sunburstPlot" style="width:100%; height:750px; position:relative;">
<div>
<div class="sunburst-main">
<div class="sunburst-sequence"></div>
<div class="sunburst-chart">
<div class="sunburst-explanation" style="visibility:hidden;"></div>
</div>
</div>
<div class="sunburst-sidebar">
<input type="checkbox" class="sunburst-togglelegend">Legend</input>
<div class="sunburst-legend" style="visibility:hidden;"></div>
</div>
</div>
</div>
I was thinking that if could modify the HTML code and incorporate it into the dashboardBody I would be able to reproduce the chart and maybe get rid off the legend in the future:
rm(list = ls())
library(shiny)
library(shinydashboard)
library(sunburstR)
library(data.table)
ui <- dashboardPage(
dashboardHeader(),
dashboardSidebar(
sidebarMenu(
menuItem("Sunburst Plot", tabName = "sunbrstPlot")
)
),
dashboardBody( tabBox(id = "sunbrstPlot", width = "100%", height = "1000px",
#sunburstOutput("sunburstPlot", height = "750", width = "100%")
tags$div(class="sunburst html-widget html-widget-output", id="sunburstPlot", style="width:100%; height:750px; position:relative;",
tags$div(
tags$div(class = "sunburst-main",
tags$div(class="sunburst-sequence"),
tags$div(class="sunburst-chart",
tags$div(class="sunburst-explanation", style="visibility:hidden;")
)
), tags$div(class="sunburst-sidebar",
tags$input(type="checkbox", class="sunburst-togglelegend", "Legend"),
tags$div(class="sunburst-legend", style="visibility:hidden;")
)
)
)
)
)
)
server <- function(input, output) {
# Create Sunburst plot
output$sunburstPlot <- renderSunburst({
tempDat <- data.table(A=sample(rep(c("a","b","c","d","e"), 100)), B = sample(rep(c("a","b","c","d","e"), 100)), C = sample(rep(c("a","b","c","d","e"), 100)))
tempDat[,c("V1","V2"):= list(paste0(A,"-",B, "-", C),1)]
sunburst(tempDat[,.(V1,V2)])
})
}
shinyApp(ui, server)
Unfortunately following this approach I am not able to reproduce the chart. Could you provide assistance with this?
Thank you for your time on my question.
Cheers, Kostas
@warmoverflow answer should work ok, but the code below will show some possibly more robust methods for achieving your objective. I will comment inline in the code to try to describe the approaches.
library(sunburstR)
sequences <- read.csv(
system.file("examples/visit-sequences.csv",package="sunburstR")
,header = FALSE
,stringsAsFactors = FALSE
)
sunburst(sequences)
We can use htmlwidgets::onRender to remove the legend after the sunburst is drawn.
htmlwidgets::onRender(
sunburst(sequences),
'
function(el,x){
d3.select(el).select(".sunburst-sidebar").remove()
}
'
)
htmlwidgets allows the use of a custom html function to define the container for the htmlwidget. We can see the function for sunburstR with sunburstR:::sunburst_html. In this approach, we will replace sunburstR:::sunburst_html with a custom html function without the legend.
library(htmltools)
sunburst_html <- function(id, style, class, ...){
tagList(
tags$div(
id = id, class = class, style = style, style="position:relative;"
,tags$div(
tags$div(class = "sunburst-main"
, tags$div( class = "sunburst-sequence" )
, tags$div( class = "sunburst-chart"
,tags$div( class = "sunburst-explanation", style = "visibility:hidden;")
)
)
# comment this out so no legend
#,tags$div(class = "sunburst-sidebar"
# , tags$input( type = "checkbox", class = "sunburst-togglelegend", "Legend" )
# , tags$div( class = "sunburst-legend", style = "visibility:hidden;" )
)
)
)
}
# replace the package sunburst_html with our custom function
# defined above
assignInNamespace("sunburst_html", sunburst_html, "sunburstR")
sunburst(sequences)