-
Notifications
You must be signed in to change notification settings - Fork 23
/
epicalc_profile.R
186 lines (155 loc) · 8.52 KB
/
epicalc_profile.R
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
#' Display Episode Calculation statistics for selected subject
#' @name epicalc_profile
#'
#' @inheritParams episode_calculation
#' @param subject String corresponding to subject id
#'
#' @return A plot displaying (1) the statistics for the episodes and (2) the episodes colored by level.
#'
#' @export
#'
#' @author Johnathan Shih, Jung Hoon Seo, Elizabeth Chun
#'
#' @seealso episode_calculation()
#'
#' @examples
#' epicalc_profile(example_data_1_subject)
#'
epicalc_profile <- function(data,lv1_hypo=70,lv2_hypo=54,lv1_hyper=180,lv2_hyper=250,
dur_length = 15, end_length = 15, subject = NULL,
dt0 = NULL, inter_gap = 45, tz = ""){
#Clean up Global environment
id = num_levels = NULL
rm(list = c("id", "num_levels"))
if (!is.null(subject)){
data = data[data$id == subject, ]
}
#Checking for more than 1 subject
ns = length(unique(data$id))
if (ns > 1){
subject = unique(data$id)[1]
warning(paste("The provided data have", ns, "subjects. The plot will only be created for subject", subject))
data = data[data$id == subject, ]
}
#Calling episode_calculation for data
episodes = episode_calculation(data, lv1_hypo = lv1_hypo, lv2_hypo = lv2_hypo,
lv1_hyper = lv1_hyper, lv2_hyper = lv2_hyper,
return_data = TRUE, dur_length = dur_length,
end_length = end_length, dt0 = dt0, inter_gap = inter_gap, tz = tz)
ep_summary = episodes[[1]]
ep_data = episodes[[2]]
#Creating table 1(t1) -------------------------------------
tableStat = data.frame("Hypoglycemia/Hyperglycemia episode metrics")
tableStat[1, 1] = ""
tableStat[1, 2] = "Hypoglycemia"
tableStat[1, 3] = "Hypoglycemia"
tableStat[1, 4] = "Hypoglycemia"
tableStat[1, 5] = "Hyperglycemia"
tableStat[1, 6] = "Hyperglycemia"
tableStat[1, 7] = "Hypoglycemia"
tableStat[1, 8] = "Hyperglycemia"
tableStat[2, 1] = ""
tableStat[2, 2] = "Level 1"
tableStat[2, 3] = "Level 2"
tableStat[2, 4] = "Extended"
tableStat[2, 5] = "Level 1"
tableStat[2, 6] = "Level 2"
tableStat[2, 7] = "Level 1 excl"
tableStat[2, 8] = "Level 1 excl"
tableStat[3, 1] = "Thresholds"
tableStat[3, 2] = paste0("<", as.character(lv1_hypo), " mg/dL")
tableStat[3, 3] = paste0("<", as.character(lv2_hypo), " mg/dL")
tableStat[3, 4] = paste0("<", as.character(lv1_hypo), " mg/dL")
tableStat[3, 5] = paste0(">", as.character(lv1_hyper), " mg/dL")
tableStat[3, 6] = paste0(">", as.character(lv2_hyper), " mg/dL")
tableStat[3, 7] = paste0(as.character(lv1_hypo), "-", as.character(lv2_hypo), " mg/dL")
tableStat[3, 8] = paste0(as.character(lv1_hyper), "-", as.character(lv2_hyper), " mg/dL")
tableStat[4, 1] = "Avg Episodes/Day"
tableStat[4, 2] = as.character(format(round(ep_summary$avg_ep_per_day[1], 2), nsmall = 2))
tableStat[4, 3] = as.character(format(round(ep_summary$avg_ep_per_day[2], 2), nsmall = 2))
tableStat[4, 4] = as.character(format(round(ep_summary$avg_ep_per_day[3], 2), nsmall = 2))
tableStat[4, 5] = as.character(format(round(ep_summary$avg_ep_per_day[4], 2), nsmall = 2))
tableStat[4, 6] = as.character(format(round(ep_summary$avg_ep_per_day[5], 2), nsmall = 2))
tableStat[4, 7] = as.character(format(round(ep_summary$avg_ep_per_day[6], 2), nsmall = 2))
tableStat[4, 8] = as.character(format(round(ep_summary$avg_ep_per_day[7], 2), nsmall = 2))
tableStat[5, 1] = "Mean duration"
tableStat[5, 2] = paste0(as.character(format(round(ep_summary$avg_ep_duration[1], 2), nsmall = 2)), " min")
tableStat[5, 3] = paste0(as.character(format(round(ep_summary$avg_ep_duration[2], 2), nsmall = 2)), " min")
tableStat[5, 4] = paste0(as.character(format(round(ep_summary$avg_ep_duration[3], 2), nsmall = 2)), " min")
tableStat[5, 5] = paste0(as.character(format(round(ep_summary$avg_ep_duration[4], 2), nsmall = 2)), " min")
tableStat[5, 6] = paste0(as.character(format(round(ep_summary$avg_ep_duration[5], 2), nsmall = 2)), " min")
tableStat[5, 7] = paste0(as.character(format(round(ep_summary$avg_ep_duration[6], 2), nsmall = 2)), " min")
tableStat[5, 8] = paste0(as.character(format(round(ep_summary$avg_ep_duration[7], 2), nsmall = 2)), " min")
tableStat[6, 1] = "Mean glucose"
tableStat[6, 2] = paste0(as.character(format(round(ep_summary$avg_ep_gl[1], 2), nsmall = 2)), " mg/dl")
tableStat[6, 3] = paste0(as.character(format(round(ep_summary$avg_ep_gl[2], 2), nsmall = 2)), " mg/dl")
tableStat[6, 4] = paste0(as.character(format(round(ep_summary$avg_ep_gl[3], 2), nsmall = 2)), " mg/dl")
tableStat[6, 5] = paste0(as.character(format(round(ep_summary$avg_ep_gl[4], 2), nsmall = 2)), " mg/dl")
tableStat[6, 6] = paste0(as.character(format(round(ep_summary$avg_ep_gl[5], 2), nsmall = 2)), " mg/dl")
tableStat[6, 7] = paste0(as.character(format(round(ep_summary$avg_ep_gl[6], 2), nsmall = 2)), " mg/dl")
tableStat[6, 8] = paste0(as.character(format(round(ep_summary$avg_ep_gl[7], 2), nsmall = 2)), " mg/dl")
tableStat[7, 1] = "Total episodes"
tableStat[7, 2] = paste0(as.character(format(round(ep_summary$total_episodes[1], 2), nsmall = 2)))
tableStat[7, 3] = paste0(as.character(format(round(ep_summary$total_episodes[2], 2), nsmall = 2)))
tableStat[7, 4] = paste0(as.character(format(round(ep_summary$total_episodes[3], 2), nsmall = 2)))
tableStat[7, 5] = paste0(as.character(format(round(ep_summary$total_episodes[4], 2), nsmall = 2)))
tableStat[7, 6] = paste0(as.character(format(round(ep_summary$total_episodes[5], 2), nsmall = 2)))
tableStat[7, 7] = paste0(as.character(format(round(ep_summary$total_episodes[6], 2), nsmall = 2)))
tableStat[7, 8] = paste0(as.character(format(round(ep_summary$total_episodes[7], 2), nsmall = 2)))
#Styling the table
mytheme <- gridExtra::ttheme_minimal(base_size = 10, padding = unit(c(4,2),"mm"))
t1 <- gridExtra::tableGrob(tableStat, rows = NULL, cols = NULL, theme = mytheme )
#Adding border(t1)
t1 <- gtable::gtable_add_grob(t1,
grobs = grid::rectGrob(gp = grid::gpar(fill = NA, lwd = 5)),
t = 1, b = 7, l = 1, r = 8)
#Adding dotted separator(t1)
separators <- replicate(ncol(t1) - 2,
grid::segmentsGrob(x1 = unit(0, "npc"), gp=grid::gpar(lty=2)),
simplify=FALSE)
t1 <- gtable::gtable_add_grob(t1, grobs = separators,
t = 2, b = nrow(t1), l = seq_len(ncol(t1)-2)+2)
padding <- unit(0.5,"line")
#Adding title and footnote(t1)
title <- grid::textGrob(paste0("Episode Metrics - ", data$id[1]),gp=grid::gpar(fontsize=18), x=0, hjust=0)
footnote <- grid::textGrob(paste0("An episode is >= ", dur_length, " continuous minutes"), x=1, hjust=1,
gp=grid::gpar( fontface="italic", fontsize = 8))
padding <- unit(0.5,"line")
t1 <- gtable::gtable_add_rows(t1,
heights = grid::grobHeight(title) + padding,
pos = 0)
t1 <- gtable::gtable_add_rows(t1,
heights = grid::grobHeight(footnote)+ padding)
t1 <- gtable::gtable_add_grob(t1, list(title, footnote),
t=c(1, nrow(t1)), l=c(1,2),
r=ncol(t1))
# Creating overall plot(p1) ---------------------------------
# recode since lv2 is a subset of lv1
labels = c("lv1_hypo", "lv2_hypo", "lv1_hyper", "lv2_hyper")
plot_data = ep_data %>%
dplyr::rowwise() %>%
dplyr::mutate(
num_levels = sum(c(lv1_hypo != 0, lv2_hypo != 0, lv1_hyper != 0, lv2_hyper != 0)),
class = ifelse(
# either no types - normal, one type - keep nonzero, subset - choose lv2
num_levels == 0, "Normal",
ifelse(num_levels == 1,
labels[which(c(lv1_hypo != 0, lv2_hypo != 0, lv1_hyper != 0, lv2_hyper != 0))],
c("lv2_hypo", "lv2_hyper")[which(c(lv2_hypo != 0, lv2_hyper != 0))])
),
class = factor(class, levels = c("lv2_hypo", "lv1_hypo", "Normal", "lv1_hyper", "lv2_hyper"))
)
# match plot ranges colors (AGP)
colors <- c("#8E1B1B", "#F92D00", "#48BA3C", "#F9F000", "#F9B500")
p1 = ggplot(plot_data) +
geom_point(aes(time, gl, color = class)) +
scale_color_manual(values = colors, drop = FALSE,
labels = c("lv2_hypo", "lv1_hypo", "Normal", "lv1_hyper", "lv2_hyper")) +
ggplot2::scale_x_datetime(name = 'Date') +
ggplot2::scale_y_continuous(name = 'Blood Glucose')
#adding all figures together ---------------------------
pFinal = (
wrap_elements(t1) + plot_layout()) / p1
pFinal
# }#end Function
}