Как раскрасить временной код в R блестящий

Question

Я хочу раскрасить график вывода времени по столбцу Date_Bucket, любая помощь будет принята с благодарностью.

head(file)
Record_ID	Start	End	Date_Bucket
1	01-01-2017	31-12-2021	Greater than 2 Years
2	01-11-2013	31-10-2028	Greater than 2 Years
3	01-11-2017	31-10-2022	Greater than 2 Years
4	22-04-2014	30-09-2020	1-2 Years
5	15-12-2017	30-06-2019	0-6 Months
6	01-11-2017	31-10-2022	Greater than 2 Years
7	22-04-2014	30-09-2020	1-2 Years
8	11-01-2013	31-08-2019	6-12 Months
9	11-10-2013	31-08-2019	6-12 Months

file$Start <- as.Date(file$Start)
file$End <- as.Date(file$End)

if (interactive()) 
library(shiny)
shinyApp(
ui = fluidPage(
  timevisOutput("timeline"),
  actionButton("btn", "Fit all items")
),
server = function(input, output) {
  output$timeline <- renderTimevis(
    timevis(data.frame(
     id = file$Record_ID, start =  file$Start , end = file$End, content = 
 file$Date_Bucket
    ))
  )
  observeEvent(input$btn, {
    fitWindow("timeline", list(animation = TRUE))
  })
 }
 )
 }

Answer 1

Вот очень простой наивный способ добиться того, чего вы хотите.Основываясь на вашем сценарии использования и количестве различных значений (будь то статическое или динамическое число), вы можете захотеть сделать что-то более умное, но это должно быть хорошим началом.Вы также можете добавить больше CSS, чтобы контур каждого блока не был синим.По сути, все, что я здесь делаю, - это использование параметра className timevis для назначения разных классов каждому Date_Bucket и добавление CSS для каждого из этих классов.

library(shiny)
library(timevis)

file$Start <- as.Date(file$Start)
file$End <- as.Date(file$End)
cols <- c("redBg", "blueBg", "greenBg", "orangeBg")
file$className <- cols[file$Date_Bucket]

shinyApp(
  ui = fluidPage(
    tags$style(
      ".redBg { background: red; }
      .blueBg { background: blue; }
      .greenBg { background: green; }
      .orangeBg { background: orange; }"
    ),
    timevisOutput("timeline"),
    actionButton("btn", "Fit all items")
  ),
  server = function(input, output) {
    output$timeline <- renderTimevis(
      timevis(data.frame(
        id = file$Record_ID, start =  file$Start , end = file$End, content = 
          file$Date_Bucket, className = file$className
      ))
    )
    observeEvent(input$btn, {
      fitWindow("timeline", list(animation = TRUE))
    })
  }
)