R 垂直合并 timevis 和分散图以完美对齐 x 轴（时间线）

Question

我想垂直组合 timevis 和分散图（timevis 顶部和分散图底部），以便 x 轴和标签完美对齐。我尝试了几个选项，但绘图上的子组标签扭曲了。这是一个工作代码，它创建两个图而不对齐它们。任何建议将不胜感激。

library(shiny)
library(timevis)

psa <- data.frame(
  date = as.POSIXct(c("2019-12-18", "2020-01-15", "2020-02-19", "2020-04-02", "2020-06-25", "2020-06-26", "2020-07-16", "2020-08-13", "2020-09-17", "2020-10-15")),
  psa = c(251.8, 65.5, 7.4, 9.4, 13.2, 13.20, 18.4, 15.3, 87.6, 90)
)

dataLog <- data.frame(
  content = c("Prostate Cancer", "Lymph nodes & Bone", "Bicalutamide", 
              "Leuprolide", "Abiraterone & Prednisone", "Zometa", "Enzalutamide", 
              "Prostate", "Docetaxel", "Blood", "Treatment"),
  start = as.POSIXct(c("2019-11-26", "2019-12-01", "2019-12-18", "2019-12-28", 
                       "2020-01-18", "2020-07-16", "2020-07-30", "2020-10-29", 
                       "2019-10-29", "2020-12-29", "2018-12-18")),
  end = as.POSIXct(c("2019-11-26", "2019-12-01", "2019-12-18", "2020-03-28", 
                     "2020-01-18", "2020-07-16", "2020-07-30", "2020-10-29", 
                     "2020-12-10", "2021-10-29", "2020-07-16")),
  group = c("Diagnosis", "Metastasis", "Hormone Therapy", "Leuprolide", 
            "Abiraterone & Prednisone", "Antiresorptive Med", "Hormone Therapy", 
            "Sample", "Chemotherapy", "Sample", "Treatment"),
  type = c("point", "point", "point", "range", "point", "point", 
           "point", "point", "range", "point", "range"),
  className = c("blue_style", "blue_style", "blue_style", "blue_style", 
                "blue_style", "blue_style", "blue_style", "mo_style", 
                "serg_style", "tso_style", "white_style")
)

# Define groups with nested structure
dataLogGroups <- data.frame(
  id = c("Diagnosis", "Metastasis", "Hormone Therapy", "Antiresorptive Med", "Sample", "Chemotherapy", "Treatment"),
  content = c("Diagnosis", "Metastasis", "Hormone Therapy", "Antiresorptive Med", "Sample", "Chemotherapy", "Treatment"),
  style = "font-weight: bold"
)

# Create groups and set nested structure
groups <- dataLogGroups
groups$nestedGroups <- I(list(
  NA, 
  NA,
  list("Leuprolide", "Enzalutamide", "Abiraterone & Prednisone", "bicalutamide"),  # Leuprolide as a subgroup of Hormone Therapy
  list("Zometa"),
  NA, 
  list("Docetaxel"),
  list("Hormone Therapy", "Chemotherapy", "Antiresorptive Med")  # Hormone Therapy as a subgroup of Treatment
))

# Add subgroup entries with specific styles
subgroup_entries <- list(
  data.frame(id = "Leuprolide", content = "Leuprolide", style = "font-weight: bold; border-width: 0px; text-align: right; background: #ffffff; font-style: italic;", nestedGroups = I(list(NA))),
  data.frame(id = "Enzalutamide", content = "Enzalutamide", style = "font-weight: bold;border-width: 0px; text-align: right; background: #ffffff; font-style: italic;", nestedGroups = I(list(NA))),
  data.frame(id = "Docetaxel", content = "Docetaxel", style = "font-weight: bold; border-width: 0px; text-align: right; background: #ffffff; font-style: italic;", nestedGroups = I(list(NA))),
  data.frame(id = "Zometa", content = "Zometa", style = "font-weight: bold; border-width: 0px; text-align: right; background: #ffffff; font-style: italic;", nestedGroups = I(list(NA))),
  data.frame(id = "bicalutamide", content = "  bicalutamide", style = "font-weight: bold; border-width: 0px; text-align: right; background: #ffffff; font-style: italic;", nestedGroups = I(list(NA))),
  data.frame(id = "Abiraterone & Prednisone", content = "Abiraterone & Prednisone", style = "font-weight: bold; border-width: 0px; text-align: right; background: #ffffff; font-style: italic;", nestedGroups = I(list(NA)))
)

# Combine all subgroup entries
for (entry in subgroup_entries) {
  groups <- rbind(groups, entry)
}

ui <- fluidPage(
  title = "Testing styles",
  tags$head(
    tags$style(HTML("
      .vis-foreground .vis-group {border: none;}
      .vis-label.vis-nested-group {border-color: #000; text-align: left;}
      .vis-timeline { border: 2px solid black; font-size: 10pt; background: #ffffff;}
      .vis-item.vis-line {border-width: 3px;}
      .vis-item.vis-dot {border-width: 6px;border-radius: 6px;}
      .vis-background .vis-minor.vis-odd {background: #ffffff;}
      .vis-time-axis .vis-grid.vis-minor {border-width: 0px;border-color: #ffffff;}
      .vis-time-axis .vis-text {color: black;padding-top: 10px;padding-left: 10px;}
      .vis-time-axis .vis-grid.vis-major {border-width: 0px;border-color: #ffffff;}
      .mo_style  { border-color: #301934; font-size: 10pt; color: black;  }
      .ab_style { border-color: #FFAA33; font-size: 10pt; color: black;   }
      .serg_style { border-color: #B9D9EB; font-size: 10pt; color: black;   }
      .status_style { border-color: #008B8B; font-size: 10pt; color: black;   }
      .white_style { border-color: white; background:#ffffff; color: white;   }
      .blue_style { border-color: #17B169; font-size: 5px; Background: #17B169; color: #17B169; }
      .nestedGroup { border-color: black; background:#ffffff; }
    "))),
  timevisOutput("timelineCustom"),
  plotOutput("psaPlot")
)

server <- function(input, output, session) {
  output$timelineCustom <- renderTimevis({
    timevis(dataLog, groups = groups, options = list(orientation = 'top', editable = FALSE))
  })
  
  output$psaPlot <- renderPlot({
    plot(psa$date, psa$psa, type = "p", col = "blue", pch = 19,
         xlab = "Date", ylab = "PSA Level", main = "PSA Levels Over Time",
         xaxt = "n")
    axis.POSIXct(1, at = psa$date, format = "%Y-%m-%d")
    grid()
  })
}

shinyApp(ui = ui, server = server)

Answer 1

这是找到答案的途径（但需要一些调整）。

来源、解释的更改

地块宽度

• 图 1 宽度

  • widthLabel <- 400

    ：左侧plot1标签的宽度。还可以遮挡plot1的标签的宽度。

  • widthPlot <- 1200

    ：plot1 的宽度。
  • 用于：

    • tags$style(HTML(paste0(".vis-labelset {width: ",widthLabel,"px;}"))),

    • timevisOutput("timelineCustom",width=HTML(paste0(widthLabel+widthPlot,"px"))),

    • timevis(dataLog,...,width=HTML(paste0(widthLabel+widthPlot,"px")),

• Plot2 宽度

  • widthLabel <- 400

    ：左侧plot1标签的宽度。

  • widthPlot <- 1200

    ：plot1 的宽度。

  • widthLabel-widthYLabelPlot2

    ：plot2之前左

    div

    的宽度。

  • widthYLabelPlot2 <- 60

    ：左侧plot2标签insideplot2的宽度。
  • 用于：

    • tags$style(HTML(paste0(".vis-labelset-pseudo {width: ",widthLabel-widthYLabelPlot2,"px;}"))),

用户界面

            timevisOutput("timelineCustom",width=HTML(paste0(widthLabel+widthPlot,"px"))),
            div(
              div(class='vis-labelset-pseudo',style='display: inline-block;'),
              div(
                plotOutput("psaPlot"),
                style=HTML(paste0("display: inline-block; width:",
                                  widthYLabelPlot2+widthPlot,"px;'"))
              )
            )  

也许有些东西可以通过

plot()

中的设置进行替换或优化：请参阅

graphics::par()

的帮助以设置为

base::plot()

绘制比例和数据

• 图1
  • 获得 Plot1 和 Plot2 的最小值和最大值

    timevis(dataLog,..., options=..

    • start=min(dataLog$start,psa$date)

    • end=max(dataLog$end,psa$date)

 timevis(dataLog, 
            ...
            options = 
              list(
                ...
                start=min(dataLog$start,psa$date),
                end=max(dataLog$end,psa$date)
              )
    )

• 情节2
  • 获得 Plot1 和 Plot2 的最小值和最大值

     plot(psa$date, psa$psa,..., xlim=..

    • plot()

      中的数据：

      xlim=c(min(dataLog$start,psa$date),max(dataLog$end,psa$date))
    在
    • axis.POSIXct

       中缩放：

      at = unique(sort(c(dataLog$start,psa$date,dataLog$end)))

              plot(psa$date, ...,
                xlim=c(
                     ...
                     min(dataLog$start,psa$date),
                     max(dataLog$end,psa$date)
                     )
              )
              axis.POSIXct(1, 
                at = unique(sort(c(dataLog$start,psa$date,dataLog$end))),
             ...)

服务器

            output$psaPlot <- renderPlot({
              plot(psa$date, psa$psa, type = "p", col = "blue", pch = 19,
                   xlab = "Date", ylab = "PSA Level", main = "PSA Levels Over Time",
                   xaxt = "n",
                   xlim=c(min(dataLog$start,psa$date),max(dataLog$end,psa$date))
              )
              axis.POSIXct(1, at = unique(sort(c(dataLog$start,psa$date,dataLog$end))), format = "%Y-%m-%d")
              grid()
            } )

更新来源

library(shiny)
library(timevis)

widthLabel <- 400
widthPlot <- 1200
widthYLabelPlot2 <- 60

psa <- data.frame(
  date = as.POSIXct(c("2019-12-18", "2020-01-15", "2020-02-19", "2020-04-02", "2020-06-25", "2020-06-26", "2020-07-16", "2020-08-13", "2020-09-17", "2020-10-15")),
  psa = c(251.8, 65.5, 7.4, 9.4, 13.2, 13.20, 18.4, 15.3, 87.6, 90)
)

dataLog <- data.frame(
  content = c("Prostate Cancer", "Lymph nodes & Bone", "Bicalutamide", 
              "Leuprolide", "Abiraterone & Prednisone", "Zometa", "Enzalutamide", 
              "Prostate", "Docetaxel", "Blood", "Treatment"),
  start = as.POSIXct(c("2019-11-26", "2019-12-01", "2019-12-18", "2019-12-28", 
                       "2020-01-18", "2020-07-16", "2020-07-30", "2020-10-29", 
                       "2019-10-29", "2020-12-29", "2018-12-18")),
  end = as.POSIXct(c("2019-11-26", "2019-12-01", "2019-12-18", "2020-03-28", 
                     "2020-01-18", "2020-07-16", "2020-07-30", "2020-10-29", 
                     "2020-12-10", "2021-10-29", "2020-07-16")),
  group = c("Diagnosis", "Metastasis", "Hormone Therapy", "Leuprolide", 
            "Abiraterone & Prednisone", "Antiresorptive Med", "Hormone Therapy", 
            "Sample", "Chemotherapy", "Sample", "Treatment"),
  type = c("point", "point", "point", "range", "point", "point", 
           "point", "point", "range", "point", "range"),
  className = c("blue_style", "blue_style", "blue_style", "blue_style", 
                "blue_style", "blue_style", "blue_style", "mo_style", 
                "serg_style", "tso_style", "white_style")
)

# Define groups with nested structure
dataLogGroups <- data.frame(
  id = c("Diagnosis", "Metastasis", "Hormone Therapy", "Antiresorptive Med", "Sample", "Chemotherapy", "Treatment"),
  content = c("Diagnosis", "Metastasis", "Hormone Therapy", "Antiresorptive Med", "Sample", "Chemotherapy", "Treatment"),
  style = "font-weight: bold"
)

# Create groups and set nested structure
groups <- dataLogGroups
groups$nestedGroups <- I(list(
  NA, 
  NA,
  list("Leuprolide", "Enzalutamide", "Abiraterone & Prednisone", "bicalutamide"),  # Leuprolide as a subgroup of Hormone Therapy
  list("Zometa"),
  NA, 
  list("Docetaxel"),
  list("Hormone Therapy", "Chemotherapy", "Antiresorptive Med")  # Hormone Therapy as a subgroup of Treatment
))

# Add subgroup entries with specific styles
subgroup_entries <- list(
  data.frame(id = "Leuprolide", content = "Leuprolide", style = "font-weight: bold; border-width: 0px; text-align: right; background: #ffffff; font-style: italic;", nestedGroups = I(list(NA))),
  data.frame(id = "Enzalutamide", content = "Enzalutamide", style = "font-weight: bold;border-width: 0px; text-align: right; background: #ffffff; font-style: italic;", nestedGroups = I(list(NA))),
  data.frame(id = "Docetaxel", content = "Docetaxel", style = "font-weight: bold; border-width: 0px; text-align: right; background: #ffffff; font-style: italic;", nestedGroups = I(list(NA))),
  data.frame(id = "Zometa", content = "Zometa", style = "font-weight: bold; border-width: 0px; text-align: right; background: #ffffff; font-style: italic;", nestedGroups = I(list(NA))),
  data.frame(id = "bicalutamide", content = "  bicalutamide", style = "font-weight: bold; border-width: 0px; text-align: right; background: #ffffff; font-style: italic;", nestedGroups = I(list(NA))),
  data.frame(id = "Abiraterone & Prednisone", content = "Abiraterone & Prednisone", style = "font-weight: bold; border-width: 0px; text-align: right; background: #ffffff; font-style: italic;", nestedGroups = I(list(NA)))
)

# Combine all subgroup entries
for (entry in subgroup_entries) {
  groups <- rbind(groups, entry)
}

ui <- fluidPage(
  title = "Testing styles",
  tags$head(
    tags$style(HTML(paste0(".vis-labelset {width: ",widthLabel,"px;}"))),
    tags$style(HTML(paste0(".vis-labelset-pseudo {width: ",widthLabel-widthYLabelPlot2,"px;}"))),
    tags$style(HTML("
      .vis-foreground .vis-group {border: none;}
      .vis-label.vis-nested-group {border-color: #000; text-align: left;}
      .vis-timeline { border: 2px solid black; font-size: 10pt; background: #ffffff;}
      .vis-item.vis-line {border-width: 3px;}
      .vis-item.vis-dot {border-width: 6px;border-radius: 6px;}
      .vis-background .vis-minor.vis-odd {background: #ffffff;}
      .vis-time-axis .vis-grid.vis-minor {border-width: 0px;border-color: #ffffff;}
      .vis-time-axis .vis-text {color: black;padding-top: 10px;padding-left: 10px;}
      .vis-time-axis .vis-grid.vis-major {border-width: 0px;border-color: #ffffff;}
      .mo_style  { border-color: #301934; font-size: 10pt; color: black;  }
      .ab_style { border-color: #FFAA33; font-size: 10pt; color: black;   }
      .serg_style { border-color: #B9D9EB; font-size: 10pt; color: black;   }
      .status_style { border-color: #008B8B; font-size: 10pt; color: black;   }
      .white_style { border-color: white; background:#ffffff; color: white;   }
      .blue_style { border-color: #17B169; font-size: 5px; Background: #17B169; color: #17B169; }
      .nestedGroup { border-color: black; background:#ffffff; }
    "))),
  timevisOutput("timelineCustom",width=HTML(paste0(widthLabel+widthPlot,"px"))),
  div(
    div(class='vis-labelset-pseudo',style='display: inline-block;'),
    div(
      plotOutput("psaPlot"),
      style=HTML(paste0("display: inline-block; width:",
                        widthYLabelPlot2+widthPlot,"px;'"))
    )
  )  
)

server <- function(input, output, session) {
  output$timelineCustom <- renderTimevis({
    timevis(dataLog, 
            groups = groups,
            width=HTML(paste0(widthLabel+widthPlot,"px")),
            options = 
              list(
                orientation = 'top',
                editable = FALSE, 
                start=min(dataLog$start,psa$date),
                end=max(dataLog$end,psa$date)
              )
    )
    
  })
  
  output$psaPlot <- renderPlot({
    plot(psa$date, psa$psa, type = "p", col = "blue", pch = 19,
         xlab = "Date", ylab = "PSA Level", main = "PSA Levels Over Time",
         xaxt = "n",
         xlim=c(min(dataLog$start,psa$date),max(dataLog$end,psa$date))
    )
    axis.POSIXct(1, at = unique(sort(c(dataLog$start,psa$date,dataLog$end))), format = "%Y-%m-%d")
    grid()
  } )
}

shinyApp(ui = ui, server = server)