Create sunburst plot in Shiny using HTML instead of sunburstOutput

Question

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

Answer 1

@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)

option 1 - htmlwidgets::onRender

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()
}
  '
)

option 2 - replace the sunburst_html function

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)

Answer 2

You can use Javascript to hide the legend. Add the following below menuItem (remember to add a , after the menuItem line

  tags$head(tags$script(HTML("
                         $(document).ready(function(e) {
                            $('.sunburst-sidebar').hide();
                         })
                         ")))

If you prefer, you can even completely remove it (change hide to remove).