r语言 - 在Shiny使用HTML而不是sunburstOutput创建sunburst plot

Question

亲爱的社区成员，

我正在使用R包sunburstR，以便在Shiny中创建一个日冕图。下面的代码工作完美，我能够创建情节，但是，我想完全删除传说。基于这个原因，我知道使用HTML5我将能够更有效地处理情节参数。

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)

为这个图表编写的HTML5代码是:

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>

我在想，如果可以修改HTML代码并将其合并到dashboardBody中，我将能够复制图表，也许将来可以摆脱图例:

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)

不幸的是，按照这种方法，我无法复制图表。你能提供帮助吗?

谢谢你花时间回答我的问题。

欢呼,考斯塔斯。

Answer 1

@warmoverflow答案应该可以正常工作，但是下面的代码将显示一些可能更健壮的方法来实现您的目标。我将在代码中进行内联注释，以尝试描述这些方法。

library(sunburstR)
sequences <- read.csv(
  system.file("examples/visit-sequences.csv",package="sunburstR")
  ,header = FALSE
  ,stringsAsFactors = FALSE
)
sunburst(sequences)

选项1 - htmlwidgets::onRender

我们可以使用htmlwidgets::onRender在太阳爆发绘制后删除图例。

htmlwidgets::onRender(
  sunburst(sequences),
  '
function(el,x){
  d3.select(el).select(".sunburst-sidebar").remove()
}
  '
)

选项2 -替换sunburst_html函数

htmlwidgets允许使用自定义html函数来定义htmlwidget的容器。我们可以通过sunburstR:::sunburst_html看到sunburstR的函数。在这种方法中，我们将用不带图例的自定义html函数替换sunburstR:::sunburst_html。

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

可以使用Javascript隐藏图例。在menuItem下面添加以下内容(记住在menuItem行

之后添加,)

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

如果你愿意，你甚至可以完全删除它(将hide更改为remove)