Проблема с построением диаграммы Ганта в блестящем с DiagrammeR - PullRequest
Новая
       22

Проблема с построением диаграммы Ганта в блестящем с DiagrammeR

0 голосов
/ 28 января 2019

У меня проблема с отображением графиков Ганта в Shiny с использованием функции построения русалок DiagrammeR.

Все выполняется так, как ожидалось, однако графики отображаются в средстве просмотра R studio, а не на блестящей странице (у которой есть tabPanel для отображения графика).Я видел, что это было задано / решено с помощью ggVis .. Однако решение в этом случае является специфическим для ggVis.Я хотел бы остаться с DiagrammeR / mermaid, потому что он создает такие хорошо выглядящие графики.

Прилагается минимальный исполняемый пример: -) 

library(shiny)
library(lubridate)
library(DiagrammeR)

  # --- Input datafile
         AllData <- data.frame(Project = c("Phoenix", "Phoenix", "Phoenix"),  
                          task = c("Establish plan", "Build management tool", "Get funding"),
                          status = c("done", "active", "crit, active"),
                          pos = c("first_1", "first_2", "import_1"),
                          start = c("2018-12-01", "2019-01-21", "2019-02-01"),
                          end = c("12w 6d", "4w", "8w 1d"),
                          stringsAsFactors = FALSE)

  # Define UI for application

ui <- fluidPage(

      titlePanel("XXX Project Management Tool"),

         sidebarLayout(
           sidebarPanel(                       # --- setup LHS data input frames ---


              selectInput("Proj", "Project",
                        c(unique(as.character(AllData$Project)))),


              selectInput("Stg", "Stage",
                         c("All", unique(as.character(AllData$name)))),

                  width = 3),

         mainPanel(

             tabsetPanel(type = "tabs",
                tabPanel("Gantt Chart", plotOutput("plot")),
                tabPanel("Data Table", tableOutput("table"))))

     )
   )

server <- function(input, output) {

  # --- filter the selected project into a reactive function (access later using () suffix) ---
  SelectedProject <- reactive({dplyr::filter(AllData, Project == input$Proj)})

  output$plot <- renderPlot({
    mermaid(
      paste0(
        "gantt", "\n", 
        "dateFormat  YYYY-MM-DD", "\n", 
        "title Gantt Chart - Project ", input$Proj, "\n",

        # --- unite the first two columns (task & status) and separate them with ":" ---
        # --- then, unite the other columns and separate them with "," ---
        paste(SelectedProject() %>%
                unite(i, task, status, sep = ":") %>%
                unite(j, i, pos, start, end, sep = ",") %>%
                .$j, 
              collapse = "\n"
        ), "\n"
      )
    )
  })

  output$table <- renderTable({SelectedProject()})   


}       


# --- run application ---
shinyApp(ui = ui, server = server)

График в конечном итоге отображается в программе просмотра -однако другая вкладка отображает табулированные данные, как и ожидалось.

1 Ответ

0 голосов
/ 29 января 2019

Вам нужно использовать DiagrammeROutput() вместо plotOutput() и renderDiagrammeR() вместо renderPlot(): 

library(shiny)
library(lubridate)
library(DiagrammeR)
library(tidyr)

# --- Input datafile
AllData <- data.frame(Project = c("Phoenix", "Phoenix", "Phoenix"),  
                      task = c("Establish plan", "Build management tool", "Get funding"),
                      status = c("done", "active", "crit, active"),
                      pos = c("first_1", "first_2", "import_1"),
                      start = c("2018-12-01", "2019-01-21", "2019-02-01"),
                      end = c("12w 6d", "4w", "8w 1d"),
                      stringsAsFactors = FALSE)

# Define UI for application

ui <- fluidPage(

  titlePanel("XXX Project Management Tool"),

  sidebarLayout(
    sidebarPanel(                       # --- setup LHS data input frames ---


      selectInput("Proj", "Project",
                  c(unique(as.character(AllData$Project)))),


      selectInput("Stg", "Stage",
                  c("All", unique(as.character(AllData$name)))),

      width = 3),

    mainPanel(

      tabsetPanel(type = "tabs",
                  tabPanel("Gantt Chart", DiagrammeROutput("plot")),
                  tabPanel("Data Table", tableOutput("table"))))

  )
)

server <- function(input, output) {

  # --- filter the selected project into a reactive function (access later using () suffix) ---
  SelectedProject <- reactive({dplyr::filter(AllData, Project == input$Proj)})

  output$plot <- renderDiagrammeR({
    mermaid(
      paste0(
        "gantt", "\n", 
        "dateFormat  YYYY-MM-DD", "\n", 
        "title Gantt Chart - Project ", input$Proj, "\n",

        # --- unite the first two columns (task & status) and separate them with ":" ---
        # --- then, unite the other columns and separate them with "," ---
        paste(SelectedProject() %>%
                unite(i, task, status, sep = ":") %>%
                unite(j, i, pos, start, end, sep = ",") %>%
                .$j, 
              collapse = "\n"
        ), "\n"
      )
    )
  })

  output$table <- renderTable({SelectedProject()})   


}       


# --- run application ---
shinyApp(ui = ui, server = server)
...