r - 使用 DiagrammeR 以闪亮的方式绘制甘特图的问题
问题描述
我在使用 DiagrammeR 的美人鱼绘图功能在 Shiny 中显示甘特图时遇到问题。
一切都按预期执行,但是绘图显示在 R 工作室的查看器中,而不是闪亮的页面上(其中有一个用于显示绘图的 tabPanel)。我已经看到使用 ggVis 询问/解决了这个问题。但是该实例中的解决方案是特定于 ggVis 的。我想留在 DiagrammeR/美人鱼,因为它产生了如此好看的情节。
附上一个最小的可执行示例:-)
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)
该图最终显示在查看器中 - 但是另一个 tabPanel 按预期显示列表数据。
解决方案
您需要使用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)
推荐阅读
- javascript - 在 React 中迭代数据数组时呈现 JSX 元素的最有效方式
- ldap - Airflow 10 LDAP 授权错误 - LDAPInvalidPortError:端口必须是整数
- scala - scala中的日期转换问题
- angular - 使用 Id 在 ngFor 循环中显示单个 ngrx 实体
- javascript - 在反应 js 中创建新事件时更新日历
- c# - C#删除数据库中所有选中的复选框
- sql-server - SQL Server:还原备份导致“此备份集中的日志太新”
- c# - .NET C# 中的高性能 TCP 套接字编程
- javascript - Vue+element popover 不能改变当前页面
- javascript - 更新状态中的子节点中的值