I'm trying to reproduce a graph similar to those used for displaying ambulatory blood pressure monitoring (ABPM) data, with step lines and a filled area between them.
I’ve managed to build the step lines, but I’m having trouble filling the area above them correctly. The stat_difference() function doesn’t seem to work as expected in this case — it doesn’t fill the area properly when the lines are steps.
Here’s a minimal reproducible example of what I have so far:
data <- structure(list(Date = structure(c(1750165200, 1750166100, 1750167000,
1750167900, 1750168800, 1750169700, 1750170600, 1750171500, 1750172400,
1750173300, 1750174200, 1750175100, 1750176000, 1750176900, 1750177800,
1750178700, 1750179600, 1750180500, 1750181400, 1750182300, 1750183200,
1750184100, 1750185000, 1750185900, 1750186800, 1750187700, 1750188600,
1750189500, 1750190400, 1750191300, 1750192200, 1750193100, 1750194000,
1750194900, 1750195800, 1750196700, 1750197600, 1750198500, 1750199400,
1750200300, 1750201200, 1750202100, 1750203000, 1750203900, 1750204800,
1750205700, 1750206600, 1750207500, 1750208400, 1750209300, 1750210200,
1750211100, 1750212000, 1750213800, 1750215600, 1750217400, 1750219200,
1750221000, 1750222800, 1750224600, 1750226400, 1750228200, 1750230000,
1750231800, 1750233600, 1750235400, 1750237200, 1750238100, 1750239000,
1750239900, 1750240800, 1750241700, 1750242600, 1750243500, 1750244400,
1750245300, 1750246200, 1750247100, 1750248000, 1750248900, 1750249800,
1750250700), class = c("POSIXct", "POSIXt"), tzone = ""), SBP_Patient = c(154,
150, 130, 145, 136, 140, 145, 148, 152, 140, 160, 150, 150, 145,
139, 120, 125, 132, 145, 135, 150, 157, 154, 146, 145, 165, 170,
120, 115, 168, 150, 148, 162, 146, 154, 167, 170, 145, 152, 148,
152, 149, 145, 140, 152, 140, 164, 150, 145, 130, 120, 110, 112,
110, 124, 128, 100, 90, 98, 100, 110, 105, 95, 105, 115, 119,
130, 125, 130, 142, 140, 140, 142, 146, 145, 140, 145, 132, 145,
150, 152, 160), DBP_Patient = c(95, 90, 98, 89, 95, 90, 95, 86,
85, 90, 100, 85, 89, 82, 85, 80, 80, 87, 85, 83, 85, 90, 95,
95, 85, 95, 105, 90, 80, 95, 90, 92, 98, 85, 85, 95, 98, 90,
95, 95, 97, 89, 80, 82, 82, 80, 98, 95, 82, 80, 74, 70, 70, 60,
68, 80, 70, 65, 70, 75, 80, 70, 62, 75, 75, 80, 80, 75, 80, 80,
98, 89, 82, 84, 80, 85, 83, 80, 89, 90, 95, 95), SBP_Threshold = c(135,
135, 135, 135, 135, 135, 135, 135, 135, 135, 135, 135, 135, 135,
135, 135, 135, 135, 135, 135, 135, 135, 135, 135, 135, 135, 135,
135, 135, 135, 135, 135, 135, 135, 135, 135, 135, 135, 135, 135,
135, 135, 135, 135, 135, 135, 135, 135, 135, 135, 135, 135, 135,
135, 120, 120, 120, 120, 120, 120, 120, 120, 120, 120, 120, 120,
135, 135, 135, 135, 135, 135, 135, 135, 135, 135, 135, 135, 135,
135, 135, 135), DBP_Threshold = c(85, 85, 85, 85, 85, 85, 85,
85, 85, 85, 85, 85, 85, 85, 85, 85, 85, 85, 85, 85, 85, 85, 85,
85, 85, 85, 85, 85, 85, 85, 85, 85, 85, 85, 85, 85, 85, 85, 85,
85, 85, 85, 85, 85, 85, 85, 85, 85, 85, 85, 85, 85, 85, 85, 70,
70, 70, 70, 70, 70, 70, 70, 70, 70, 70, 70, 70, 85, 85, 85, 85,
85, 85, 85, 85, 85, 85, 85, 85, 85, 85, 85), Period = structure(c(1L,
1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L,
1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L,
1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L,
1L, 1L, 1L, 1L, 1L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L,
2L, 2L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L,
1L), levels = c("Wake", "Sleep"), class = "factor")), row.names = c(NA,
-82L), class = c("tbl_df", "tbl", "data.frame"))
ggplot(data, aes(x = Date)) +
ggh4x::stat_difference(aes(ymin = SBP_Threshold,
ymax = SBP_Patient), alpha = 0.5,
levels = c("SBP Above", "SBP Normal"),
show.legend = F) +
ggh4x::stat_difference(aes(ymin = DBP_Threshold,
ymax = DBP_Patient), alpha = 0.5,
levels = c("DBP Above", "DBP Normal"),
show.legend = F) +
geom_step(aes(y = SBP_Threshold, group = 1), color = "grey50") +
geom_step(aes(y = DBP_Threshold, group = 1), color = "grey50") +
geom_line(aes(y = SBP_Patient, group = 1, color = "Systolic")) +
geom_line(aes(y = DBP_Patient, group = 1, color = "Diastolic")) +
scale_color_manual(values = c("Systolic" = "red",
"Diastolic" = "blue3")) +
scale_fill_manual(values = c("SBP Above" = "red",
"SBP Normal" = "transparent",
"DBP Above" = "blue3",
"DBP Normal" = "transparent")) +
scale_x_datetime(date_breaks = "1 hour", date_labels = "%H") +
labs(y = "Arterial blood pressure (mmHg)", x = "Hour", color = NULL) +
theme_bw()
My question is: how can I correctly fill the area between two step lines, preserving the step structure of the lines?
Thanks in advance for any help!
This is happening due to lack of data in your problem areas.
You could interpolate new rows at the minute level. Fill could be linearly interpolated with zoo::na.approx()
, and steps could be maintained with tidyr::fill()
.
library(dplyr)
library(ggh4x)
library(tidyr)
library(zoo)
data <- structure(list(Date = structure(c(1750165200, 1750166100, 1750167000,
1750167900, 1750168800, 1750169700, 1750170600, 1750171500, 1750172400,
1750173300, 1750174200, 1750175100, 1750176000, 1750176900, 1750177800,
1750178700, 1750179600, 1750180500, 1750181400, 1750182300, 1750183200,
1750184100, 1750185000, 1750185900, 1750186800, 1750187700, 1750188600,
1750189500, 1750190400, 1750191300, 1750192200, 1750193100, 1750194000,
1750194900, 1750195800, 1750196700, 1750197600, 1750198500, 1750199400,
1750200300, 1750201200, 1750202100, 1750203000, 1750203900, 1750204800,
1750205700, 1750206600, 1750207500, 1750208400, 1750209300, 1750210200,
1750211100, 1750212000, 1750213800, 1750215600, 1750217400, 1750219200,
1750221000, 1750222800, 1750224600, 1750226400, 1750228200, 1750230000,
1750231800, 1750233600, 1750235400, 1750237200, 1750238100, 1750239000,
1750239900, 1750240800, 1750241700, 1750242600, 1750243500, 1750244400,
1750245300, 1750246200, 1750247100, 1750248000, 1750248900, 1750249800,
1750250700), class = c("POSIXct", "POSIXt"), tzone = ""), SBP_Patient = c(154,
150, 130, 145, 136, 140, 145, 148, 152, 140, 160, 150, 150, 145,
139, 120, 125, 132, 145, 135, 150, 157, 154, 146, 145, 165, 170,
120, 115, 168, 150, 148, 162, 146, 154, 167, 170, 145, 152, 148,
152, 149, 145, 140, 152, 140, 164, 150, 145, 130, 120, 110, 112,
110, 124, 128, 100, 90, 98, 100, 110, 105, 95, 105, 115, 119,
130, 125, 130, 142, 140, 140, 142, 146, 145, 140, 145, 132, 145,
150, 152, 160), DBP_Patient = c(95, 90, 98, 89, 95, 90, 95, 86,
85, 90, 100, 85, 89, 82, 85, 80, 80, 87, 85, 83, 85, 90, 95,
95, 85, 95, 105, 90, 80, 95, 90, 92, 98, 85, 85, 95, 98, 90,
95, 95, 97, 89, 80, 82, 82, 80, 98, 95, 82, 80, 74, 70, 70, 60,
68, 80, 70, 65, 70, 75, 80, 70, 62, 75, 75, 80, 80, 75, 80, 80,
98, 89, 82, 84, 80, 85, 83, 80, 89, 90, 95, 95), SBP_Threshold = c(135,
135, 135, 135, 135, 135, 135, 135, 135, 135, 135, 135, 135, 135,
135, 135, 135, 135, 135, 135, 135, 135, 135, 135, 135, 135, 135,
135, 135, 135, 135, 135, 135, 135, 135, 135, 135, 135, 135, 135,
135, 135, 135, 135, 135, 135, 135, 135, 135, 135, 135, 135, 135,
135, 120, 120, 120, 120, 120, 120, 120, 120, 120, 120, 120, 120,
135, 135, 135, 135, 135, 135, 135, 135, 135, 135, 135, 135, 135,
135, 135, 135), DBP_Threshold = c(85, 85, 85, 85, 85, 85, 85,
85, 85, 85, 85, 85, 85, 85, 85, 85, 85, 85, 85, 85, 85, 85, 85,
85, 85, 85, 85, 85, 85, 85, 85, 85, 85, 85, 85, 85, 85, 85, 85,
85, 85, 85, 85, 85, 85, 85, 85, 85, 85, 85, 85, 85, 85, 85, 70,
70, 70, 70, 70, 70, 70, 70, 70, 70, 70, 70, 70, 85, 85, 85, 85,
85, 85, 85, 85, 85, 85, 85, 85, 85, 85, 85), Period = structure(c(1L,
1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L,
1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L,
1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L,
1L, 1L, 1L, 1L, 1L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L,
2L, 2L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L,
1L), levels = c("Wake", "Sleep"), class = "factor")), row.names = c(NA,
-82L), class = c("tbl_df", "tbl", "data.frame"))
# start with left data of Dates from min to max by 60 seconds
tibble(Date = seq(min(data$Date), max(data$Date), 60)) |>
# left join to the original data
left_join(data, join_by(Date)) |>
# fill missing patient observations via linear interpolation
mutate(across(ends_with("Patient"), \(x) na.approx(x))) |>
# fill missing threshold observations via filling down
fill(ends_with("Threshold")) |>
ggplot(aes(x = Date)) +
stat_difference(aes(ymin = SBP_Threshold,
ymax = SBP_Patient), alpha = 0.5,
levels = c("SBP Above", "SBP Normal"),
show.legend = F) +
stat_difference(aes(ymin = DBP_Threshold,
ymax = DBP_Patient), alpha = 0.5,
levels = c("DBP Above", "DBP Normal"),
show.legend = F) +
geom_step(aes(y = SBP_Threshold, group = 1), color = "grey50") +
geom_step(aes(y = DBP_Threshold, group = 1), color = "grey50") +
geom_line(aes(y = SBP_Patient, group = 1, color = "Systolic")) +
geom_line(aes(y = DBP_Patient, group = 1, color = "Diastolic")) +
scale_color_manual(values = c("Systolic" = "red",
"Diastolic" = "blue3")) +
scale_fill_manual(values = c("SBP Above" = "red",
"SBP Normal" = "transparent",
"DBP Above" = "blue3",
"DBP Normal" = "transparent")) +
scale_x_datetime(date_breaks = "1 hour", date_labels = "%H") +
labs(y = "Arterial blood pressure (mmHg)", x = "Hour", color = NULL) +
theme_bw()
Reprex files hosted with on GitHub
If you love us? You can donate to us via Paypal or buy me a coffee so we can maintain and grow! Thank you!
Donate Us With