R Блестящая масштабируемая программа дендрограммы - PullRequest
Новая
       130

R Блестящая масштабируемая программа дендрограммы

0 голосов
/ 06 августа 2020

У меня есть огромная дендрограмма с сотнями имен на ней, которую я хотел бы сделать интерактивной, чтобы пользователи могли рисовать рамку и «увеличивать» имена и часть интересующего дерева. Исходный код для его создания позаимствован отсюда . Изображенный здесь:

enter image description here

I turned it into a shiny app and borrowed some код отсюда , чтобы сделать его масштабируемым. И это КИНДА работает. Он запускается, появляются два графика, и ничего не выдает ошибок. Но это работает не так, как задумано. (Я выложу код ниже). Я имею в виду, что если бы я просто визуализировал свой сюжет вне блестящего, все имена и все остальное были включены. Но когда он рендерится блестящим, я не могу нарисовать рамку над именами, только линии дендрограммы (надеюсь, что это имеет смысл), а «увеличенный» график поворачивается боком (что-то связанное с функцией corre_cartesian? Я использую вместо этого) и выглядит очень странно при "увеличении". Наконец, я не могу видеть оба графика одновременно, и мне приходится использовать полосу прокрутки, чтобы добраться до них, как показано на рисунке: введите описание изображения здесь

Помогите! Код ниже (это из документа уценки r, если это важно, извините, я не смог включить фактические данные, имеет настоящие имена. 

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)

1 Ответ

1 голос
/ 08 августа 2020

Я бы предложил использовать инструмент 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)

Изображение:

enter image description here

The image after zoom-in:

введите описание изображения здесь

Проблема в том, что текст явно не выровнен должным образом (это для ggplot2, но не для версии ggplotly). Это ошибка в plotly, о которой, вероятно, следует сообщать как в dendextend, так и в plotly репозиториях github.

...