diff --git a/R/lasagna_plots.R b/R/lasagna_plots.R index 1d480c44..76be38a3 100644 --- a/R/lasagna_plots.R +++ b/R/lasagna_plots.R @@ -36,9 +36,9 @@ plot_lasagna_1subject <- function(data, lasagnatype = c('unsorted', 'timesorted' id = glucose = day = NULL rm(list = c("id", "glucose", "day")) - + static_or_gui = match.arg(static_or_gui) - + # Optionally convert data to log scale if (log){ data$gl = log10(data$gl) @@ -47,7 +47,7 @@ plot_lasagna_1subject <- function(data, lasagnatype = c('unsorted', 'timesorted' LLTR = log10(LLTR) ULTR = log10(ULTR) } - + # Select the color scheme color_scheme = match.arg(color_scheme, c("blue-red", "red-orange")) if (color_scheme == "blue-red"){ @@ -57,7 +57,7 @@ plot_lasagna_1subject <- function(data, lasagnatype = c('unsorted', 'timesorted' # Alternative red and orange as in commercial software colors = c("#8E1B1B", "#F92D00", "#48BA3C", "#F9F000", "#F9B500") } - + subject = unique(data$id) ns = length(subject) if (ns > 1){ @@ -65,7 +65,7 @@ plot_lasagna_1subject <- function(data, lasagnatype = c('unsorted', 'timesorted' warning(paste("The provided data have", ns, "subjects. The plot will only be created for subject", subject)) data = data %>% dplyr::filter(id == subject) } - + # Get measurements on uniform grid from day to day data_ip = CGMS2DayByDay(data, tz = tz, dt0 = dt0, inter_gap = inter_gap) gl_by_id_ip = data_ip[[1]] @@ -73,11 +73,11 @@ plot_lasagna_1subject <- function(data, lasagnatype = c('unsorted', 'timesorted' ndays = nrow(gl_by_id_ip) ntimes = ncol(gl_by_id_ip) time_grid_hours = cumsum(rep(dt0, 24 * 60 /dt0)) / 60 - + title = "" ytitle = "Day" xtitle = "Hour" - + lasagnatype = match.arg(lasagnatype, c('unsorted', 'timesorted', 'daysorted')) if (lasagnatype == 'timesorted'){ gl_by_id_ip = apply(gl_by_id_ip, 2, sort, decreasing = TRUE, na.last = TRUE) @@ -88,33 +88,65 @@ plot_lasagna_1subject <- function(data, lasagnatype = c('unsorted', 'timesorted' title = ", sorted within each day." xtitle = "Hour (sorted)" } - + # Melt the measurements for lasagna plot - data_l = data.frame(day = rep(data_ip$actual_dates, each = ntimes), hour = rep(time_grid_hours, ndays), glucose = as.vector(t(gl_by_id_ip))) - - # Make a plot - p = data_l %>% - ggplot(aes(x = hour, y = as.character(day), fill = glucose)) + scale_fill_gradientn(colors = colors, na.value = "grey50", values = scales::rescale(c(limits[1], LLTR, midpoint, ULTR, limits[2])), limits = limits) + geom_tile() + ylab(ytitle) + ggtitle(paste0(subject, title, "")) + xlab(xtitle) + xlim(c(0, 24)) - - if(log){ - p = p + ggplot2::labs(fill = 'log(glucose)') - } - - # Take out days if sorted within time since each subject changes - if (lasagnatype == 'timesorted'){ - p = p + theme(axis.text.y=element_blank()) + data_l = data.frame(day = rep(data_ip$actual_dates, each = ntimes), + hour = rep(time_grid_hours, ndays), + glucose = as.vector(t(gl_by_id_ip))) %>% + mutate(tooltip_text = paste0( + "Day: ", day, + "
Hour: ", round(hour, 2), + if (!log) { + paste0("
Glucose (mg/dL): ", round(glucose, 1)) + } else { + paste0("
Log10 Glucose: ", round(glucose, 2)) + } + )) + + # Base ggplot + p <- ggplot(data_l, aes( + x = hour, + y = as.character(day), + fill = glucose, + text = tooltip_text # <- Important for Plotly + )) + + geom_tile() + + scale_fill_gradientn( + colors = colors, + na.value = "grey50", + values = scales::rescale(c(limits[1], LLTR, midpoint, ULTR, limits[2])), + limits = limits, + name = if (!log) "Glucose (mg/dL)" else "log10(Glucose)" + ) + + xlab(xtitle) + + ylab(ytitle) + + scale_x_continuous(limits = c(0, 24) + c(0, 0.05), expand = c(0, 0)) + + scale_y_discrete(expand = c(0, 0)) + + ggtitle(paste0(subject, title)) + + theme_bw() + + theme( + panel.background = element_rect(fill = "grey50"), + panel.grid.major = element_line(linewidth = 0, linetype = 'solid', colour = "grey50"), + panel.grid.minor = element_line(linewidth = 0, linetype = 'solid', colour = "grey50") + ) + + # If sorted within time, no meaningful day order + if (lasagnatype == 'timesorted') { + p <- p + theme(axis.text.y = element_blank()) } - - p <- p + theme(panel.background = element_rect(fill = "grey50"), - panel.grid.major = element_line(linewidth=0, linetype = 'solid', colour = "grey50"), - panel.grid.minor = element_line(linewidth=0, linetype = 'solid', colour = "grey50") - ) - + + # Return either static ggplot or interactive plotly static_or_gui = match.arg(static_or_gui, c("plotly", "ggplot")) if (static_or_gui == "plotly") { - return(plotly::ggplotly(p)) + # Only show the text in the tooltip + return( + plotly::ggplotly( + p, + tooltip = "text" + ) + ) } - + return(p) } @@ -146,13 +178,13 @@ plot_lasagna <- function(data, datatype = c("all", "average"), lasagnatype = c(' maxd = 14, limits = c(50, 500), midpoint = 105, LLTR = 70, ULTR = 180, dt0 = NULL, inter_gap = 45, tz = "", color_scheme = c("blue-red", "red-orange"), log = F, static_or_gui = c('ggplot', 'plotly')){ - lasagnatype = match.arg(lasagnatype, c('unsorted', 'timesorted', 'subjectsorted')) + lasagnatype = match.arg(lasagnatype, c('unsorted', 'timesorted', 'subjectsorted')) datatype = match.arg(datatype, c("all", "average")) static_or_gui = match.arg(static_or_gui) - + id = glucose = day = NULL rm(list = c("id", "glucose", "day")) - + # Optionally convert data to log scale if (log){ data$gl = log10(data$gl) @@ -161,10 +193,10 @@ plot_lasagna <- function(data, datatype = c("all", "average"), lasagnatype = c(' LLTR = log10(LLTR) ULTR = log10(ULTR) } - + subject = unique(data$id) ns = length(subject) - + # Select the color scheme color_scheme = match.arg(color_scheme, c("blue-red", "red-orange")) if (color_scheme == "blue-red"){ @@ -174,7 +206,7 @@ plot_lasagna <- function(data, datatype = c("all", "average"), lasagnatype = c(' # Alternative red and orange as in commercial software colors = c("#8E1B1B", "#F92D00", "#48BA3C", "#F9F000", "#F9B500") } - + # Calculate uniform grid for all subjects gdall = list() for (i in 1:ns){ @@ -187,13 +219,13 @@ plot_lasagna <- function(data, datatype = c("all", "average"), lasagnatype = c(' gdall[[i]] <- out$gd2d } dt0 = out$dt0 - + if (datatype == "average"){ # Combine the list of averages into the matrix form average24 = t(sapply(gdall, colMeans, na.rm = TRUE)) # Time grid for 24 hour period time_grid_hours = cumsum(rep(dt0, 24 * 60 /dt0)) / 60 - + # Adjust the title and sort if needed title = "" ytitle = "Subject" @@ -207,27 +239,58 @@ plot_lasagna <- function(data, datatype = c("all", "average"), lasagnatype = c(' title = ", sorted within each subject." xtitle = "Hour (sorted)" } - - # Melt the measurements for lasanga plot - data_l = data.frame(subject = rep(subject, each = length(time_grid_hours)), hour = rep(time_grid_hours, ns), glucose = as.vector(t(average24))) - + + # Melt the measurements for lasagna plot + data_l = data.frame(subject = rep(subject, + each = length(time_grid_hours)), + hour = rep(time_grid_hours, ns), + glucose = as.vector(t(average24))) %>% + mutate(tooltip_text = paste0( + "
Hour: ", round(hour, 2), + if (!log) { + paste0("
Glucose (mg/dL): ", round(glucose, 1)) + } else { + paste0("
Log10 Glucose: ", round(glucose, 2)) + } + )) + + p = data_l%>% - ggplot(aes(x = hour, y = subject, fill = glucose)) + geom_tile() + ylab(ytitle) + ggtitle(paste0("Average glucose values for all subjects across days", title, "")) + xlab(xtitle) + xlim(c(0, 24)) + scale_fill_gradientn(colors = colors, na.value = "grey50", values = scales::rescale(c(limits[1], LLTR, midpoint, ULTR, limits[2])), limits = limits) - + ggplot(aes(x = hour, y = subject, fill = glucose, text = tooltip_text)) + + geom_tile() + + ylab(ytitle) + + ggtitle(paste0("Average glucose values for all subjects across days", title, "")) + + xlab(xtitle) + + scale_x_continuous(limits = c(0, 24) + c(0, 0.05), expand = c(0, 0)) + + scale_y_discrete(expand = c(0, 0)) + + scale_fill_gradientn(colors = colors, na.value = "grey50", values = scales::rescale(c(limits[1], LLTR, midpoint, ULTR, limits[2])), limits = limits) + ggtitle(paste0(subject, title)) + + theme_bw() + + theme( + panel.background = element_rect(fill = "grey50"), + panel.grid.major = element_line(linewidth = 0, linetype = 'solid', colour = "grey50"), + panel.grid.minor = element_line(linewidth = 0, linetype = 'solid', colour = "grey50")) + + if(log){ p = p + ggplot2::labs(fill = 'log(glucose)') } - + # Take out subject names if sorted within time since each subject changes if (lasagnatype == 'timesorted'){ p = p + theme(axis.text.y=element_blank()) } - + static_or_gui = match.arg(static_or_gui, c("plotly", "ggplot")) if (static_or_gui == "plotly") { - return(plotly::ggplotly(p)) + return( + plotly::ggplotly( + p, + tooltip = "text" + ) + ) } - + return(p) }else{ max_days = max(sapply(gdall, function(x) nrow(x))) @@ -244,9 +307,9 @@ plot_lasagna <- function(data, datatype = c("all", "average"), lasagnatype = c(' as.vector(t(x[1:max_days, ])) } } - + out = t(sapply(gdall, stretch_select)) - + # Adjust the title and sort if needed title = "" ytitle = "Subject" @@ -260,26 +323,56 @@ plot_lasagna <- function(data, datatype = c("all", "average"), lasagnatype = c(' title = ", sorted within each subject." xtitle = "Day (sorted)" } - - data_l = data.frame(subject = rep(subject, each = nt * max_days), day = rep(time_grid_days, ns), glucose = as.vector(t(out))) - + + data_l = data.frame(subject = rep(subject, each = nt * max_days), + day = rep(time_grid_days, ns), + glucose = as.vector(t(out))) %>% + mutate(tooltip_text = paste0( + "Day: ", round(day, 2), + if (!log) { + paste0("
Glucose (mg/dL): ", round(glucose, 1)) + } else { + paste0("
Log10 Glucose: ", round(glucose, 2)) + } + )) + p = data_l%>% - ggplot(aes(x = day + 1, y = subject, fill = glucose)) + geom_tile() + ylab(ytitle) + ggtitle(paste0("All subjects", title)) + xlab(xtitle) + geom_vline(xintercept = c(1:max_days)) + scale_x_continuous(breaks = seq(1, max_days, by = 2)) + scale_fill_gradientn(colors = colors, na.value = "grey50", values = scales::rescale(c(limits[1], LLTR, midpoint, ULTR, limits[2])), limits = limits) - + ggplot(aes(x = day + 1, y = subject, fill = glucose, text = tooltip_text)) + + geom_tile() + + ylab(ytitle) + + ggtitle(paste0("All subjects", title)) + + xlab(xtitle) + + geom_vline(xintercept = c(1:max_days)) + + scale_x_continuous(breaks = seq(1, max_days, by = 2), expand = c(0,0)) + + scale_y_discrete(expand = c(0,0)) + + scale_fill_gradientn(colors = colors, na.value = "grey50", values = scales::rescale(c(limits[1], LLTR, midpoint, ULTR, limits[2])), limits = limits) + + theme_bw() + + theme( + panel.background = element_rect(fill = "grey50"), + panel.grid.major = element_line(linewidth = 0, linetype = 'solid', colour = "grey50"), + panel.grid.minor = element_line(linewidth = 0, linetype = 'solid', colour = "grey50") + ) + + if(log){ p = p + ggplot2::labs(fill = 'log(glucose)') } - + # Take out subject names if sorted within time since each subject changes if (lasagnatype == 'timesorted'){ p = p + theme(axis.text.y=element_blank()) } - + static_or_gui = match.arg(static_or_gui, c("plotly", "ggplot")) if (static_or_gui == "plotly") { - return(plotly::ggplotly(p)) + return( + plotly::ggplotly( + p, + tooltip = "text" + ) + ) } - + return(p) } } diff --git a/R/plot_ranges.R b/R/plot_ranges.R index ce85f14a..62f44d07 100644 --- a/R/plot_ranges.R +++ b/R/plot_ranges.R @@ -8,14 +8,14 @@ #' #' @inheritParams CGMS2DayByDay #' -#' @return Single subject bar chart showing percent in different glucose ranges. +#' @return Single or multiple-subject bar chart showing percent in different glucose ranges. #' #' @export #' #' @author Elizabeth Chun #' #' @details -#' Only a single subject's data may be used. There are four ranges: very low (below 54 mg/dL), +#' There are four ranges: very low (below 54 mg/dL), #' low (54-69 mg/dL), target range (70-180 mg/dL), high (181-250 mg/dL), and very high (above 250 mg/dL). #' This plot is meant to be used as part of the Ambulatory Glucose Profile (AGP) #' @@ -38,28 +38,36 @@ plot_ranges <- function (data) { subject = unique(data$id) ns = length(subject) - if (ns > 1){ - subject = subject[1] - warning(paste("The provided data have", ns, "subjects. The plot will only be created for subject", subject)) - data = data %>% dplyr::filter(id == subject) - } + + ranges <- agp_metrics(data, shinyformat = FALSE) %>% + mutate(very_low = below_54, + low = below_70 - below_54, + target = in_range_70_180, + high = above_180 - above_250, + very_high = above_250) %>% + select(id, very_low:very_high) %>% + pivot_longer(c(very_low:very_high), + names_to = "range", + values_to = "percent") - ranges <- agp_metrics(data, shinyformat = FALSE) %>% - dplyr::select(-c("id", "active_percent", "mean", "GMI", "CV")) %>% - dplyr::reframe(range = c("very_low", 'low', 'target', 'high', 'very_high'), - percent = c(below_54, below_70 - below_54, in_range_70_180, - above_180 - above_250, above_250)) +colors <- c("#F9B500", "#F9F000", "#48BA3C", "#F92D00", "#8E1B1B") - ranges = ranges %>% - dplyr::mutate(range = factor(range, levels = c("very_high", 'high', 'target', 'low', 'very_low'))) +g <- ggplot(data = ranges, + mapping = aes(x = 1, fill = range, y = percent)) + + geom_bar(stat = "identity") + + scale_fill_manual(values = colors, + drop = FALSE, + labels = c("Very High (>250 mg/dL)", "High (181-250 mg/dL)", "Target Range (70-180 mg/dL)", "Low (54-69 mg/dL)", "Very Low (<54 mg/dL)")) + + scale_y_continuous(breaks = seq(0, 100, 10), expand = c(0,0)) + + scale_x_continuous(expand = c(0,0)) + + labs(y = "Percentage") + + theme(axis.ticks.x = element_blank(), + axis.text.x = element_blank(), + axis.title.x = element_blank(), + panel.background = element_blank()) - colors <- c("#F9B500", "#F9F000", "#48BA3C", "#F92D00", "#8E1B1B") - ggplot(data = ranges, mapping = aes(x = 1, fill = range, y = percent)) + - geom_bar(stat = "identity") + - scale_fill_manual(values = colors, drop = FALSE, labels = c("Very High (>250 mg/dL)", "High (181-250 mg/dL)", "Target Range (70-180 mg/dL)", "Low (54-69 mg/dL)", "Very Low (<54 mg/dL)")) + - scale_y_continuous(breaks = seq(0, 100, 10)) + - labs(y = "Percentage") + - theme(axis.ticks.x = element_blank(), axis.text.x = element_blank(), - axis.title.x = element_blank(), panel.background = element_blank()) +if(ns > 1) g <- g + facet_wrap(~id) + +return(g) }