R Shiny,可缩放的树状图程序

R Shiny, zoomable dendrogram program

我有一个巨大的树状图,上面有数百个名字,我想使其具有交互性,以便用户可以绘制一个框并“放大”感兴趣的名字和树的一部分。创建它的原始代码是borrowed from here。图为:

我把它变成了一个闪亮的应用程序并借用了一些 code from here 以使其可缩放。它有点管用。它运行,显示了两个图表,没有任何错误给我。但它没有按预期工作。 (我将在下面 post 编写代码)。 我的意思是,如果我只是简单地在 shiny 之外渲染我的情节,那么所有的名字和一切都包括在内。但是当它呈现闪亮时,我无法在名称上绘制我的方框,只能绘制树状图的线条(希望有意义),并且“缩放”图形转向侧面(与 coord_cartesian? 我会用什么代替)并且在“缩放”时看起来很奇怪。最后,我无法同时看到两个图表,必须使用滚动条才能找到它们,如图所示:

求助!下面的代码(如果重要的话,它来自 r markdown 文档,抱歉我不能包含实际数据,有真实姓名。

Data<-Data%>%select(-`BOARD DATE`)
Data<-t(Data)
Data<-as_tibble(Data)
names(Data) <- Data %>% slice(1) %>% unlist()
Data <- Data %>% slice(-1)

cluster_dtw_h2 <- dtwclust::tsclust(t(Data), 
                                type = "h", 
                                k = 2,  
                                distance = "dtw", 
                                control = hierarchical_control(method = "complete"),
                                preproc = NULL, 
                                args = tsclust_args(dist = list(window.size = 5L)))

hclus <- stats::cutree(cluster_dtw_h2, k = 2) %>% # hclus <- cluster::pam(dist_ts, k = 2)$clustering has a similar result
  as.data.frame(.) %>%
  dplyr::rename(.,cluster_group = .) %>%
  tibble::rownames_to_column("type_col")

hcdata <- ggdendro::dendro_data(cluster_dtw_h2)
names_order <- hcdata$labels$label
hcdata$labels$label <- ""

p1 <- hcdata %>%
ggdendro::ggdendrogram(., rotate=TRUE, leaf_labels=FALSE)


ui <- fluidPage(
fluidRow(

column(width = 12, class = "well",
  h4("Left plot controls right plot"),
  fluidRow(
    column(width = 12,
      plotOutput("plot2", height = 300,
        brush = brushOpts(
          id = "plot2_brush",
          resetOnNew = TRUE
        )
      )
    ),
    column(width = 12,
      plotOutput("plot3", height = 300)
    )
  )
  )

 )
)

server <- function(input, output) {

ranges2 <- reactiveValues(x = NULL, y = NULL)

 output$plot2 <- renderPlot({
  p1
 })

output$plot3 <- renderPlot({
 p1+
  coord_cartesian(xlim = ranges2$x, ylim = ranges2$y, expand = FALSE)
 })

  # When a double-click happens, check if there's a brush on the plot.
  # If so, zoom to the brush bounds; if not, reset the zoom.
  observe({
brush <- input$plot2_brush
if (!is.null(brush)) {
  ranges2$x <- c(brush$xmin, brush$xmax)
  ranges2$y <- c(brush$ymin, brush$ymax)

} else {
  ranges2$x <- NULL
  ranges2$y <- NULL
  }
 })

}


shinyApp(ui=ui, server=server)

我建议使用的工具是 dendextend+ggplot+plotly。

示例:

library(dendextend)
library(ggplot2)
library(plotly)


dend <- USArrests %>%
  dist() %>%
  hclust(method = "ave") %>%
  as.dendrogram()
dend2 <- color_branches(dend, 5)

p <- ggplot(dend2, horiz = T, offset_labels = -3)
ggplotly(p)

图片:

zoom-in之后的图片:

这里的一个问题是文本显然没有正确对齐(它适用于 ggplot2 但不是 ggplotly 版本)。这是 plotly 中的一个错误,可能应该在 dendextend 和 plotly github repos 中报告。