ggraph выберите root узел для размещения дерева с приложением Shiny - PullRequest
Новая
       47

ggraph выберите root узел для размещения дерева с приложением Shiny

0 голосов
/ 17 апреля 2020

У меня большая двунаправленная неиерархическая сеть.

Я хотел бы выбрать узел root и максимальную степень в раскрывающихся меню, а затем динамически отображать древовидную сеть для всех ссылок. «х или меньше» градусов от root. В таблице ниже приведены данные об узлах для всех узлов в отрисованной древовидной сети.

Это представление с набором данных "старшая школа" работает, когда выбранный узел root равен "1".

Но при выборе других узлы вызывают различные проблемы:

  1. При выборе узлов 2-31 выбранный узел root не является root, показанным в верхней части древовидной диаграммы. На самом деле вершина - это n-ая строка в таблице, где n - это root ID.
  2. Данные об узлах пропускают узел 25. При выборе выше номера 25 выборки выходят из строя при перемещении вниз 1.
  3. При выборе узлов 33-71 я получаю «ошибку: при компоновке . c: 1124: недопустимый идентификатор вершины, недопустимый идентификатор вершины ".

Я новичок в реактивных программах Shiny и пакете ggraph. Кто-нибудь может помочь отладить? Или есть другие подходы, которые мне не хватает? 

library(shiny)
library(igraph)
library(ggraph)
library(tidygraph)

# Define UI for application
ui <- fluidPage(

    # Application title
    titlePanel("HS Tree Data"),

    # Sidebar with input
    sidebarLayout(
        sidebarPanel(
                   selectizeInput(inputId = "trace_lookup", "Choose Root Node by Name",
                                  choice = "",  selected = ""),
                   selectInput(inputId = "degreeTraced", "Degrees Separation",
                               choice = seq(2,7), selected = 3)
        ),

        # Show a plot
        mainPanel(
           textOutput("trace_text"),    
           plotOutput("hsTree"),
           tableOutput("hsTable")
        )
    )
)

# Define server logic
server <- function(input, output, session) {

###note: final data will be loaded externally, so I cannot predefine my root node options.

graph2 <- tidygraph::as_tbl_graph(highschool) %>% 
    activate(nodes) %>% 
    arrange(-desc(as.integer(name)))


        observe({

            x <- graph2 %>% 
                activate(nodes) %>% 
                as_tibble()

            x <-as.list(x)


            # Set the label and select items
            updateSelectizeInput(session, "trace_lookup",
                                 choices = x)

        })


    #reactive obj for row ID
    trace<-reactive({

        trace_id <- graph2 %>% 
            activate(nodes) %>% 
            as_tibble() %>% 
            rowid_to_column("row") %>%
            filter(name==input$trace_lookup)

        return(trace_id$row)

            })

    #test the trace ID
    output$trace_text<-renderText( paste0("Selected Name is : ", trace() ) )

    #define graph obj
    graph3 <- reactive({

        if( !is.na(trace()) ){

            graph2 %>% 
                activate(nodes) %>%
                mutate(degree_from_root = bfs_dist(root = trace() )) %>%
                filter(degree_from_root >= 0) %>%
                filter(degree_from_root <= input$degreeTraced) %>% 
                arrange(-desc(degree_from_root), -desc(as.integer(name))) %>% 
                activate(edges)
        }


    })

#plot graph
output$hsTree <- renderPlot({

    if( !is.na(trace()) ){

        ggraph(graph3(), layout='tree', root= trace() ) +
            geom_edge_link0(aes(color = as.factor(year)), alpha = 0.5) +
            geom_node_label(aes(label=name), size =5)
    }

    })

#show graph table
output$hsTable <- renderTable(
    graph3() %>% 
        activate(nodes) %>% 
        as_tibble()
)

}

# Run the application 
shinyApp(ui = ui, server = server)
...