Skip to content

Commit 17918ed

Browse files
BodoKirschBodoKirsch
authored
Merge pull request #30 from Bayer-Group/main
Update api to version 4.2.7
2 parents 00036b2 + bb13b71 commit 17918ed

28 files changed

+767
-138
lines changed

‎DESCRIPTION‎

Lines changed: 13 additions & 14 deletions
Original file line numberDiff line numberDiff line change
@@ -1,21 +1,20 @@
11
Package: adepro
22
Type: Package
33
Title: A 'shiny' Application for the (Audio-)Visualization of Adverse Event Profiles
4-
Version: 4.1.2
5-
Maintainer: Bodo Kirsch <bodo.kirsch@bayer.com>
4+
Version: 4.2.7
65
Authors@R: c(person(given = "Nicole",
7-
family = "Rethemeier",
8-
role = "aut"),
9-
person(given = "Christoph",
10-
family = "Tasto",
11-
role = "aut"),
12-
person(given = "Steffen",
13-
family = "Jeske",
14-
role = "aut"),
15-
person(given = "Bodo",
16-
family = "Kirsch",
17-
role = "cre",
18-
email = "bodo.kirsch@bayer.com"))
6+
family = "Rethemeier",
7+
role = "cre",
8+
email = "nicole.rethemeier@bayer.com"),
9+
person(given = "Christoph",
10+
family = "Tasto",
11+
role = "aut"),
12+
person(given = "Steffen",
13+
family = "Jeske",
14+
role = "aut"),
15+
person(given = "Bodo",
16+
family = "Kirsch",
17+
role = "aut"))
1918
Description: Contains a 'shiny' application called AdEPro (Animation of Adverse Event Profiles) which (audio-)visualizes adverse events occurring in clinical trials. As this data is usually considered sensitive, this tool is provided as a stand-alone application that can be launched from any local machine on which the data is stored.
2019
Depends: R (>= 3.5.0), shinyBS, seriation (>= 1.2.9)
2120
License: GPL-3

‎NAMESPACE‎

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -35,6 +35,7 @@ importFrom(shinyBS,bsCollapsePanel)
3535
importFrom(shinyBS,updateCollapse)
3636
importFrom(shinyWidgets,circleButton)
3737
importFrom(shinyWidgets,knobInput)
38+
importFrom(shinyWidgets,materialSwitch)
3839
importFrom(shinyWidgets,pickerInput)
3940
importFrom(shinyWidgets,radioGroupButtons)
4041
importFrom(shinyjs,click)

‎R/adepro_slice_plot.R‎

Lines changed: 130 additions & 27 deletions
Original file line numberDiff line numberDiff line change
@@ -1,3 +1,5 @@
1+
utils::globalVariables(c("ae","day_start","ps", "X", "Y","patient","r", "day_end", "replace_ae_start", "replace_ae_end"))
2+
13
#' adepro_slice_plot - function to create pie chart graph
24
#'
35
#' @description
@@ -17,6 +19,8 @@
1719
#' @param slider day
1820
#' @param subjidn subjidn variable
1921
#' @param adepro_colors colors used in adepro (max 12)
22+
#' @param arrow_data data.frame with information which start/end date are imputed
23+
#' @param show_arrows logical value if arrows should be displayed for imputed data
2024
#'
2125
#' @importFrom stats end
2226
#' @keywords internal
@@ -39,9 +43,12 @@ adepro_slice_plot <- function(
3943
"#e43157", "#377eb8", "#4daf4a", "#984ea3",
4044
"#ff7f00", "#ffff33", "#a65628", "#f781bf",
4145
"#21d4de", "#91d95b", "#b8805f", "#cbbeeb"
42-
)
46+
),
47+
info = NULL,
48+
legend_ae = NULL,
49+
arrow_data = NULL,
50+
show_arrows = FALSE
4351
) {
44-
ae <- day_start <- ps <- X <- Y <- patient <- r <- NULL
4552

4653
on_ex <- par("oma","mar","plt")
4754
on.exit(par(on_ex))
@@ -62,7 +69,6 @@ adepro_slice_plot <- function(
6269
)
6370

6471
for (i in 1:index) {
65-
6672
if (!is.null(subgroup)) {
6773
patients_tmp <- patients %>%
6874
dplyr::filter(!!rlang::sym(subgroup) == names[i])
@@ -88,6 +94,7 @@ adepro_slice_plot <- function(
8894
type = "n"
8995
)
9096

97+
9198
cont <- ifelse(slider > patients_tmp$end, "#424242", "#383838")
9299
cont <- ifelse(slider >= patients_tmp$death, "black", cont)
93100
cont_bg <- ifelse(slider >= patients_tmp$death, "black","#383838")
@@ -129,40 +136,55 @@ adepro_slice_plot <- function(
129136
)
130137
}
131138

132-
if(!is.null(subgroup)) {
139+
if (!is.null(subgroup)) {
133140
tmp_start <- data[data$patient %in% filtered_subjects,]
134141
} else {
135142
tmp_start <- data
136143
}
137144

138-
if(length(ae_list) > 0) {
139-
tmp <- tmp_start %>% dplyr::filter(ae %in% ae_list) %>%
145+
146+
if (length(ae_list) > 0) {
147+
tmp <- tmp_start %>%
148+
#insert arrow data
149+
left_join(arrow_data %>%
150+
dplyr::select(patient,ae,day_start,day_end,replace_ae_start,replace_ae_end),
151+
by = c("patient","ae","day_start","day_end")) %>%
152+
dplyr::filter(ae %in% ae_list) %>%
140153
dplyr::filter(day_start <= slider) %>%
141154
dplyr::left_join(
142-
patients_tmp %>%
143-
dplyr::select(ps,X,Y,cont,cont_bg) %>%
144-
dplyr::rename(patient = ps),
145-
by = "patient"
146-
) %>% dplyr::left_join(
147-
data.frame(ae = ae_list, col = adepro_colors[1:length(ae_list)], num = 1:length(ae_list)),
148-
by = "ae"
149-
) %>% dplyr::mutate(bg =
150-
case_when(
151-
slider > day_end ~ cont,
152-
slider <= day_end ~ col
153-
)
154-
) %>% arrange(patient,desc(r))
155+
patients_tmp %>%
156+
dplyr::select(ps,X,Y,cont,cont_bg) %>%
157+
dplyr::rename(patient = ps),
158+
by = "patient"
159+
) %>% dplyr::left_join(
160+
data.frame(ae = ae_list, col = adepro_colors[1:length(ae_list)], num = 1:length(ae_list)),
161+
by = "ae"
162+
) %>% dplyr::mutate(
163+
bg = dplyr::case_when(
164+
slider > day_end ~ cont,
165+
slider <= day_end ~ col
166+
)
167+
) %>% dplyr::arrange(patient,desc(r))
155168

156-
if(dim(tmp)[1] > 0) {
169+
170+
if (dim(tmp)[1] > 0) {
157171
poly_t <- function(num, rad = 1, fg = par('fg'), bg = par('fg'),num_aes = length(ae_list),...) {
158172
x_tmp <- c(0, 0 + rad * 0.9 * cos(seq(pi / 2 - 2 * pi / num_aes * (num - 1), pi / 2 - 2 * pi / num_aes * num, length = 25)))
159173
y_tmp <- c(0, 0 + rad * 0.9 * sin(seq(pi / 2 - 2 * pi / num_aes * (num - 1), pi / 2 - 2 * pi / num_aes * num, length = 25)))
160174
polygon(c(x_tmp, x_tmp[1]), c(y_tmp, y_tmp[1]), col = bg, border = fg, ...)
161175
NULL
162176
}
177+
poly_t2 <- function(num, rad = 1, fg = par('fg'), bg = par('fg'),num_aes = length(ae_list),...) {
178+
x_tmp <- c(0, 0 + rad * 0.9 * cos(seq(pi / 2 - 2 * pi / num_aes * (num - 1), pi / 2 - 2 * pi / num_aes * num, length = 2)))
179+
y_tmp <- c(0, 0 + rad * 0.9 * sin(seq(pi / 2 - 2 * pi / num_aes * (num - 1), pi / 2 - 2 * pi / num_aes * num, length = 2)))
180+
return(c(mean(x_tmp, x_tmp[1]), mean(y_tmp, y_tmp[1])))
181+
}
163182

183+
#filter for imputed data
184+
arrow_tmp <- tmp %>%
185+
dplyr::filter(replace_ae_start + replace_ae_end != 0 )
164186

165-
if(length(ae_list) > 1) {
187+
if (length(ae_list) > 1) {
166188
my.symbols(
167189
x = tmp$X,
168190
y = tmp$Y,
@@ -174,17 +196,98 @@ adepro_slice_plot <- function(
174196
xsize = 2,
175197
add = TRUE
176198
)
199+
if (show_arrows) {
200+
if(!is.null(arrow_tmp)) {
201+
if(!dim(arrow_tmp)[1] == 0) {
202+
for(i in 1:dim(arrow_tmp)[1]) {
203+
coord <- poly_t2(arrow_tmp[i,]$num,1,num_aes = length(ae_list))
204+
if(arrow_tmp[i,]$replace_ae_start == 1 & arrow_tmp[i,]$replace_ae_end == 0){
205+
text(arrow_tmp[i,]$X+coord[1], arrow_tmp[i,]$Y+coord[2],expression(symbol("\334")),col ="black",cex=1.55)
206+
text(arrow_tmp[i,]$X+coord[1], arrow_tmp[i,]$Y+coord[2],expression(symbol("\334")),col ="#bababa",cex=1.5)
207+
}
208+
if(arrow_tmp[i,]$replace_ae_start == 0 & arrow_tmp[i,]$replace_ae_end == 1){
209+
text(arrow_tmp[i,]$X+coord[1], arrow_tmp[i,]$Y+coord[2],expression(symbol("\336")),col ="black",cex=1.55)
210+
text(arrow_tmp[i,]$X+coord[1], arrow_tmp[i,]$Y+coord[2],expression(symbol("\336")),col ="#bababa",cex =1.5)
211+
}
212+
if(arrow_tmp[i,]$replace_ae_start == 1 & arrow_tmp[i,]$replace_ae_end == 1){
213+
text(arrow_tmp[i,]$X+coord[1], arrow_tmp[i,]$Y+coord[2],expression(symbol("\333")),col ="black",cex=1.55)
214+
text(arrow_tmp[i,]$X+coord[1], arrow_tmp[i,]$Y+coord[2],expression(symbol("\333")),col ="#bababa",cex=1.5)
215+
}
216+
}
217+
}
218+
}
219+
}
177220
} else if (length(ae_list) == 1) {
221+
graphics::symbols(
222+
tmp$X,
223+
tmp$Y,
224+
circles = 0.85 * tmp$r,
225+
inches = FALSE,
226+
add = TRUE,
227+
fg = tmp$col,
228+
bg = tmp$bg,
229+
lwd = 1
230+
)
231+
if (show_arrows){
232+
if (!is.null(arrow_tmp)){
233+
if (!dim(arrow_tmp)[1] == 0) {
234+
for(i in 1:dim(arrow_tmp)[1]){
235+
if(arrow_tmp[i,]$replace_ae_start == 1 & arrow_tmp[i,]$replace_ae_end == 0){
236+
text(arrow_tmp[i,]$X, arrow_tmp[i,]$Y,expression(symbol("\334")),col ="black",cex=1.55)
237+
text(arrow_tmp[i,]$X, arrow_tmp[i,]$Y,expression(symbol("\334")),col ="#bababa",cex=1.5)
238+
}
239+
if(arrow_tmp[i,]$replace_ae_start == 0 & arrow_tmp[i,]$replace_ae_end == 1){
240+
text(arrow_tmp[i,]$X, arrow_tmp[i,]$Y,expression(symbol("\336")),col ="black",cex=1.55)
241+
text(arrow_tmp[i,]$X, arrow_tmp[i,]$Y,expression(symbol("\336")),col ="#bababa",cex=1.5)
242+
}
243+
if(arrow_tmp[i,]$replace_ae_start == 1 & arrow_tmp[i,]$replace_ae_end == 1){
244+
text(arrow_tmp[i,]$X, arrow_tmp[i,]$Y,expression(symbol("\333")),col ="black",cex=1.55)
245+
text(arrow_tmp[i,]$X, arrow_tmp[i,]$Y,expression(symbol("\333")),col ="#bababa",cex=1.5)
246+
}
247+
}
248+
}
249+
}
250+
}
251+
}
252+
}
253+
}
254+
#draw arrows
255+
# highlight selected subject/adverse event(s)
256+
if (!is.null(info)) {
257+
if (dim(info)[1] == 1) {
178258
graphics::symbols(
179-
tmp$X,
180-
tmp$Y,
181-
circles = 0.85*tmp$r,
259+
info$X,
260+
info$Y,
261+
circles = cbind(rep(1, length(info$Y))),
182262
inches = FALSE,
183263
add = TRUE,
184-
fg = tmp$col,
185-
bg = tmp$bg,
186-
lwd = 1
264+
fg = "#ffffff10",
265+
bg = "#ffffff10",
266+
lwd = 3,
267+
xlab = "",
268+
ylab = "",
269+
main = "",
187270
)
271+
}
272+
}
273+
if (!is.null(legend_ae)) {
274+
if (length(legend_ae) != 0) {
275+
tmp_clicked <- tmp %>%
276+
dplyr::filter(ae == legend_ae)
277+
if (dim(tmp_clicked)[1] > 0) {
278+
graphics::symbols(
279+
tmp_clicked$X,
280+
tmp_clicked$Y,
281+
circles = cbind(rep(1, length(tmp_clicked$Y))),
282+
inches = FALSE,
283+
add = TRUE,
284+
fg = "#ffffff10",
285+
bg = "#ffffff10",
286+
lwd = 3,
287+
xlab = "",
288+
ylab = "",
289+
main = "",
290+
)
188291
}
189292
}
190293
}

‎R/bar_chart.R‎

Lines changed: 2 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -1,3 +1,5 @@
1+
utils::globalVariables(c("ae", "day_slider", "vars", "day_mx", "count_mx", "ps", "treat", "summarise", "n", ".", "N"))
2+
13
#' bar_chart - creates barchart of AEs for all patient
24
#' @description
35
#' Creates bar charts daily and total for all patients separately according to treatment (R Package required: 'dplyr')
@@ -23,7 +25,6 @@ bar_chart <- function(
2325
cex.n = 2
2426
){
2527

26-
ae <- day_slider <- vars <- day_mx <- count_mx <- ps <- treat <- summarise <- n <- . <- N <- NULL
2728
#app colors
2829
colors <- c(
2930
"#e43157", "#377eb8", "#4daf4a", "#984ea3",

‎R/check_data.R‎

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -15,7 +15,7 @@ check_data <- function(ae_data, patients) {
1515
if(!all(is.element(unique(ae_data$patient), unique(patients$ps)))) {stop("Patient IDs do not match!")}
1616
if (any(colnames(ae_data)[1:5] != c("day_start", "day_end", "patient", "ae", "sev"))) stop("columns in ae_data are not named correctly")
1717
if (any(!(colnames(ae_data)[-c(1:5)] %in%
18-
c("trtem", "ser", "nonser", "studrel", "studrelser", "relprot", "resdisc", "studrelresdisc")))) stop("columns in ae_data are not named correctly")
18+
c("trtem", "ser", "nonser", "studrel", "studrelser", "relprot", "resdisc", "studrelresdisc","replace_ae_start","replace_ae_end")))) stop("columns in ae_data are not named correctly")
1919
if (any(colnames(patients)[1:4] != c("ps", "treat", "end", "death"))) stop("columns in patients are not named correctly")
2020
if (!is.factor(ae_data[,4])) stop("ae_data$ae has to be of type of factor")
2121
if (!all(c(apply(ae_data[, -4], 2, is.numeric), apply(patients[,c(1, 3, 4)], 2, is.numeric)))) stop("all variables expect 'ae', 'treat' and sorting variables have to be of type numeric")

‎R/circle_legend2.R‎

Lines changed: 86 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,86 @@
1+
#' circle_legend2 - Creates Legend for Subject elements in AdEPro (version 2)
2+
#'
3+
#' @description
4+
#' Drawing legends for symbols in app
5+
#'
6+
#' @param aes list of selected adverse events
7+
#' @param colors color vector for adverse events
8+
#'
9+
#' @keywords internal
10+
11+
circle_legend2 <- function(
12+
aes,
13+
colors = c(
14+
"#e43157", "#377eb8", "#4daf4a", "#984ea3",
15+
"#ff7f00", "#ffff33", "#a65628", "#f781bf",
16+
"#21d4de", "#91d95b", "#b8805f", "#cbbeeb"
17+
)
18+
) {
19+
on_ex <- par("oma", "mar", "font")
20+
on.exit(par(on_ex))
21+
par(oma = c(0, 0, 0, 0), mar = c(0, 0, 0, 0), font = 1)
22+
23+
tmp <- data.frame(
24+
"day_start"=rep(1, 12),
25+
"day_end" = rep(3, 12),
26+
"patient" = 1:12,
27+
"ae" = c(rep(NA,4),rep(aes[1],3),NA,aes[1],rep(NA,3)),
28+
"sev" = c(rep(NA,4),1:3,NA,3,rep(NA,3)),
29+
"r" = c(rep(NA,4),c(0.5,0.75,1),NA,1,rep(NA,3)),
30+
"d" = rep(NA, 12),
31+
"Y" = rev(seq(1, 12 * 3, by = 3)),
32+
"X" = rep(1, 12),
33+
"cont" = c(c("#383838", "#383838", "#000000"),NA,rep("#383838",8)),
34+
"cont_bg" = c(c("#383838", "#424242", "#000000"),NA,rep("#383838",8)),
35+
"col" = rep(colors[1],12),
36+
"num" = c(rep(NA,4),rep(1,3),NA,1,rep(NA,3)),
37+
"bg" = c(rep(colors[1],8),"#383838",rep(colors[1],3))
38+
)
39+
40+
41+
poly_t <- function(num, rad = 1, fg = par('fg'), bg = par('fg'),num_aes = length(aes),...) {
42+
x_tmp <- c(0, 0 + rad * 0.9 * cos(seq(pi / 2 - 2 * pi / num_aes * (num - 1), pi / 2 - 2 * pi / num_aes * num, length = 25)))
43+
y_tmp <- c(0, 0 + rad * 0.9 * sin(seq(pi / 2 - 2 * pi / num_aes * (num - 1), pi / 2 - 2 * pi / num_aes * num, length = 25)))
44+
polygon(c(x_tmp, x_tmp[1]), c(y_tmp, y_tmp[1]), col = bg, border = fg, ...)
45+
NULL
46+
}
47+
48+
MASS::eqscplot(
49+
x =NA,
50+
y = NA,
51+
xlim = c(0.9, 1.1),
52+
ylim = c(0, (12 * 3) + 1),
53+
col.lab = "white",
54+
axes = FALSE,
55+
)
56+
57+
graphics::rect(-100, -100, 100, 100, col = "#383838", border = "#383838")
58+
59+
for(i in c(1,2,3,5,6,7,9)) {
60+
rect(tmp$X[i]-1,tmp$Y[i]-1, tmp$X[i]+1, tmp$Y[i]+1, col = "#424242")
61+
text(x=tmp$X[i] , y=tmp$Y[i]+1.5, c("Ongoing","Drop-out","Death","","Mild","Moderate","Severe","","Resolved")[i], col = "white")
62+
}
63+
64+
graphics::symbols(
65+
tmp$X,
66+
tmp$Y,
67+
circles = cbind(rep(0.9, length(tmp$Y))),
68+
inches = FALSE,
69+
add = TRUE,
70+
fg = tmp$cont,
71+
bg = tmp$cont_bg
72+
)
73+
74+
my.symbols(
75+
x = tmp$X[c(5,6,7,9)],
76+
y = tmp$Y[c(5,6,7,9)],
77+
symb = poly_t,
78+
num = tmp$num[c(5,6,7,9)],
79+
rad = tmp$r[c(5,6,7,9)],
80+
bg = tmp$bg[c(5,6,7,9)],
81+
fg = tmp$col[c(5,6,7,9)],
82+
xsize = 2,
83+
add = TRUE
84+
)
85+
}
86+

‎R/count_event.R‎

Lines changed: 2 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -1,3 +1,5 @@
1+
utils::globalVariables(c("day_start", "ae", "treat", "tot", "day_end", "flag"))
2+
13
#' count_event Count the event number for every AE at specified timepoint
24
#'
35
#' @description Count the event number for every AE at specified timepoint
@@ -9,7 +11,6 @@
911

1012

1113
count_event <- function(total = tot, day = 1){
12-
day_start <- ae <- treat <- tot <- day_end <- flag <- NULL
1314

1415
tmp <- total %>%
1516
tidyr::drop_na() %>%

0 commit comments

Comments
 (0)