在DyagrammeR>mermaid>甘特图中更改字体和时间轴标签

Question

在DyagrammeR>mermaid>甘特图中更改字体和时间轴标签

gantt-chartdiagrammermermaid

4

我使用 diagrammer::mermaid 在 R 中制作了这个甘特图(下面是可重复的代码):

虽然很漂亮, 但我想要:

增加字体大小(我认为这会使每一行变宽，使得当前非常长的矩形略微更加“正方形”。我可以接受这个)
使时间轴标签更加标准化。对于有些人来说，周数，对于其他人来说，月份似乎非常奇怪。我希望能够简洁地区分月份和年份)

我如何实现这些改变?

我是一个只会 R 的用户，对 node.js、css 等一无所知。我设法在网上找到了创建这个的代码片段，但不理解 style_widget 或如何更改它。

devtools::install_github('rich-iannone/DiagrammeR')
library(DiagrammeR)
library(tidyverse) #just for the pipe operator

style_widget <- function(hw=NULL, style="", addl_selector="") {
  stopifnot(!is.null(hw), inherits(hw, "htmlwidget"))

  # use current id of htmlwidget if already specified
  elementId <- hw$elementId
  if(is.null(elementId)) {
    # borrow htmlwidgets unique id creator
    elementId <- sprintf(
      'htmlwidget-%s',
      htmlwidgets:::createWidgetId()
    )
    hw$elementId <- elementId
  }

  htmlwidgets::prependContent(
    hw,
    htmltools::tags$style(
      sprintf(
        "#%s %s {%s}",
        elementId,
        addl_selector,
        style
      )
    )
  )
} 


flx_BmP  <- mermaid("
                    gantt
                    dateFormat  YYYY-MM-DD

                    section Common
                    Application (1230 plants) :done, first_1,  2018-05-15, 2018-07-30
                    Elegible (1003)           :done, first_1,  2018-06-15, 45d
                    Plants accept (576)       :done, first_1,  2018-08-01, 2d
                    Q0 - Baseline (576)       :done, first_1,  2018-08-02, 15d
                    Lottery (576)            :done, first_1,  2018-09-10, 2d

                    section ITT (288)
                    Treated (223 77%)        :done, first_2,  2018-09-20, 2018-12-15
                    Q1                       :done, first_3,  2018-12-16, 2019-01-05
                    Q2                       :      first_3,  2019-06-01, 2019-06-15

                    section Control (288)
                    Q1                       :done, first_3,  2018-12-16, 2019-01-05
                    Q2                       :      first_3,  2019-06-01, 2019-06-15
                    Treated (263)            :      first_3,  2019-06-16, 2019-09-15
                    ") %>% 
  style_widget("display:none", "line.today")

flx_BmP

- LucasMation

2个回答

0

这是Github Issue票据closed

我在Rstudio 4.2.2中尝试了最新的DiagrammeR包，但没有成功（我改变了每年的周数，但它似乎还有点失调）。因此，我在同一问题票据中添加了评论，以查看是否已经有更简单的方法。

2023年5月2日更新-代码在R.3.6和DiagrammeR（2.0.9）中运行良好

这是我的代码（基于@ismirsehregal在另一个ticket中的答案）：

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({
    m1 <- 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"
      )
    )

   # make a copy so we can compare in a tag list later
   m2 <- m1

   m2$x$config = list(ganttConfig = list(
                                      # a little tricky setup in what is already a hack
                                      #  treat this like a filter function with filter as second component in array
                                      #  and the time formatter in the first
                                      #  more than likely you will want to know your scale
                                      axisFormatter = list(list(
                                        "%b %d, %Y" # date format to return; see d3 time formatting
                                        ,htmlwidgets::JS(
                                          'function(d){ return d.getDay() == 1 }' # filter for Mondays or day of week = 1
                                        )
                                      ))
                                    ))
    m2
  })

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


}       


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

这是我的结果：

2023年5月更新：

我发现我的脚本可以很好地与DiagrammeR（2.0.9）和R（3.6）一起使用。

- Corina Roca

网页内容由stack overflow 提供, 点击上面的

可以查看英文原文，
原文链接

- Algo · Accepted Answer

对于轴格式（问题1），您可以尝试搜索以下内容：

axisFormat %d/%m

文档: https://mermaidjs.github.io/gantt.html

示例:

gantt
    title Gantt
    dateFormat  DD-MM-YYYY
    axisFormat %d/%m

    section One
    Task One            : 07-05-2019, 7d
    Task Two            : 09-05-2019, 7d

我不确定字体大小。

链接到包含您代码演示的网站：