Skip to content

Commit eb1c736

Browse files
pydemullpydemull
authored
Merge pull request #54 from pydemull/dev
Dev
2 parents b0abf5f + 35bbdae commit eb1c736

12 files changed

+707
-482
lines changed

‎NEWS.md

Lines changed: 2 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -1,5 +1,7 @@
11
# activAnalyzer (development version)
22

3+
* Added the possibility to see a threshold highlighting abnormal values for axis 1 in the nonwear/wear graph. In addition, abnormal values for Axis 1 and dependant metrics (e.g. VM) can now be replaced by NA.
4+
35
# activAnalyzer 2.1.2
46
* Removed an undesired comma from a req() function in app_server.R that caused an error with more recent versions of package dependencies (likely Shiny).
57
* Updated the figures for the comparisons with norms and recommendations (legend is now correctly placed at the top).

‎R/app_server.R

Lines changed: 77 additions & 31 deletions
Original file line numberDiff line numberDiff line change
@@ -258,6 +258,15 @@ app_server <- function(input, output, session) {
258258
shinyjs::hide("warning_epoch")
259259
}
260260
})
261+
262+
# Ehcv
263+
observeEvent(input$validate,
264+
shinyFeedback::feedbackWarning(
265+
"ehcv_val1",
266+
(is.numeric(input$ehcv_val1) == FALSE | input$ehcv_val1 < 0),
267+
"Please choose a number >= 0."
268+
)
269+
)
261270

262271
# Frame size
263272
observeEvent(input$validate,
@@ -353,9 +362,10 @@ app_server <- function(input, output, session) {
353362
})
354363

355364

356-
# Returning to default values for the wear time detection algorithm
365+
# Returning to default values for the wear time detection algorithm and ehcv
357366
observeEvent(input$reset_nonwear, {
358367
updateNumericInput(inputId = "to_epoch", value = 60)
368+
updateNumericInput(inputId = "ehcv_val1", value = 15000)
359369
updateSelectInput(inputId = "axis_weartime", selected = "vector magnitude")
360370
updateNumericInput(inputId = "frame_size", value = 90)
361371
updateNumericInput(inputId = "allowanceFrame_size", value = 2)
@@ -407,35 +417,52 @@ app_server <- function(input, output, session) {
407417
"End time should be superior to start time."
408418
)
409419
)
410-
411-
output$graph <- renderPlot({
412420

413-
# Waiting for correct inputs
414-
req(zoom_param$zoom_from_weartime < zoom_param$zoom_to_weartime)
421+
observeEvent(input$update_graphic,
422+
shinyFeedback::feedbackWarning(
423+
"ehcv_val1",
424+
(is.numeric(input$ehcv_val1) == FALSE | input$ehcv_val1 < 0),
425+
"Please choose a number >= 0."
426+
)
427+
)
428+
415429

416-
# Making the plot
430+
ehcv_val1 <- eventReactive(input$validate, input$ehcv_val1)
417431

418-
if (as.numeric(df()$time[2] - df()$time[1]) < 10) {
419-
ggplot2::ggplot() + ggplot2::geom_text(
420-
ggplot2::aes(
421-
x = 1,
422-
y = 1,
423-
label = "Sorry, below 10-s epochs, we prefer \nnot to build the plot to save your time..."),
424-
size = 10
432+
graph <- eventReactive(input$validate | input$update_graphic, {
433+
434+
# Waiting for correct inputs
435+
req(zoom_param$zoom_from_weartime < zoom_param$zoom_to_weartime & is.numeric(input$ehcv_val1) & input$ehcv_val1 >= 0)
436+
437+
# Making the plot
438+
if (as.numeric(df()$time[2] - df()$time[1]) < 10) {
439+
ggplot2::ggplot() + ggplot2::geom_text(
440+
ggplot2::aes(
441+
x = 1,
442+
y = 1,
443+
label = "Sorry, below 10-s epochs, we prefer \nnot to build the plot to save your time..."),
444+
size = 10
425445
) +
426-
ggplot2::theme(
427-
axis.title = ggplot2::element_blank(),
428-
axis.text = ggplot2::element_blank(),
429-
axis.ticks = ggplot2::element_blank()
446+
ggplot2::theme(
447+
axis.title = ggplot2::element_blank(),
448+
axis.text = ggplot2::element_blank(),
449+
axis.ticks = ggplot2::element_blank()
450+
)
451+
} else {
452+
plot_data(
453+
data = df(),
454+
metric = zoom_param$metric,
455+
ehcv = ehcv_val1(),
456+
zoom_from = zoom_param$zoom_from_weartime,
457+
zoom_to = zoom_param$zoom_to_weartime
430458
)
431-
} else {
432-
plot_data(
433-
data = df(),
434-
metric = zoom_param$metric,
435-
zoom_from = zoom_param$zoom_from_weartime,
436-
zoom_to = zoom_param$zoom_to_weartime
437-
)
438-
}
459+
}
460+
461+
})
462+
463+
output$graph <- renderPlot({
464+
465+
graph()
439466
},
440467
width = "auto",
441468
height = function(){
@@ -824,6 +851,14 @@ app_server <- function(input, output, session) {
824851
)
825852
)
826853

854+
# Threshold for data removal
855+
observeEvent(input$Run,
856+
shinyFeedback::feedbackWarning(
857+
"ehcv_val2",
858+
((is.numeric(input$ehcv_val2) == FALSE | input$ehcv_val2 < 0)),
859+
"Please provide a value >=0."
860+
)
861+
)
827862

828863
# Intensity bins parameters
829864
observeEvent(input$Run,
@@ -1375,6 +1410,14 @@ app_server <- function(input, output, session) {
13751410
return(list)
13761411

13771412
})
1413+
1414+
# Setting ehcv for dealing with the removal of abnormal epochs
1415+
ehcv_val2 <- eventReactive(input$Run, {
1416+
1417+
if (!(input$ehcv_check)) {ehcv <- "none"}
1418+
if (input$ehcv_check) {ehcv <- input$ehcv_val2}
1419+
ehcv
1420+
})
13781421

13791422
# Building the list
13801423
results_list <- eventReactive(input$Run, {
@@ -1517,11 +1560,13 @@ app_server <- function(input, output, session) {
15171560
period_info_12$corr_mets() >= 0,
15181561
period_info_13$corr_mets() >= 0,
15191562
period_info_14$corr_mets() >= 0,
1520-
period_info_15$corr_mets() >= 0
1521-
)
1522-
1523-
1524-
1563+
period_info_15$corr_mets() >= 0,
1564+
1565+
# Settings for abnormal epoch removal
1566+
is.numeric(input$ehcv_val2) & input$ehcv_val2 >= 0
1567+
)
1568+
1569+
15251570
# Building the dataframe with intensity marks
15261571
df_with_computed_metrics <-
15271572
df() %>%
@@ -1534,7 +1579,8 @@ app_server <- function(input, output, session) {
15341579
age = input$age,
15351580
weight = input$weight,
15361581
sex = input$sex,
1537-
dates = input$selected_days
1582+
dates = input$selected_days,
1583+
ehcv = ehcv_val2()
15381584
)
15391585

15401586
shiny::setProgress(0.5) # set progress to 50%

‎R/app_ui.R

Lines changed: 23 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -224,6 +224,11 @@ app_ui <- function(request) {
224224
selectInput("to_epoch", "Length of the epoch to use for analysis (s)", choices = c(60, 15, 10, 5, 1))
225225
),
226226
),
227+
fluidRow(
228+
column(12,
229+
numericInput("ehcv_val1", "Threshold to highlight abnormal values for Axis 1 (counts/min)", value = 15000, min = 0)
230+
),
231+
),
227232
fluidRow(
228233
column(12,
229234
shinydashboardPlus::box(id = "box-epoch",
@@ -399,6 +404,24 @@ app_ui <- function(request) {
399404
),
400405
),
401406

407+
#*************************
408+
# Removing abnormal values
409+
#*************************
410+
411+
fluidRow(
412+
column(12,
413+
h3("Tick the box and adjust the threshold to detect epochs corresponding to abnormal counts in Axis 1 (not mandatory)."),
414+
),
415+
),
416+
417+
fluidRow(
418+
column(6,
419+
hr(),
420+
checkboxInput("ehcv_check", "Use threshold to remove abnormal epochs (Detected epochs will be considered as nonwear epochs with NAs)."),
421+
numericInput("ehcv_val2", "Threshold related to Axis 1 (counts/min)", value = 15000, min = 0))
422+
),
423+
424+
402425
#*************************************
403426
# Choosing intensity bins
404427
#*************************************

‎R/mark_intensity.R

Lines changed: 28 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -37,6 +37,9 @@
3737
#' @param weight A numeric value in kg.
3838
#' @param sex A character value.
3939
#' @param dates A character vector containing the dates to be retained for analysis. The dates must be with the "YYYY-MM-DD" format.
40+
#' @param ehcv A numeric value to set the threshold above which Axis 1 data should be considered as extremely high (abnormal).
41+
#' The value should be in counts/min. Default is "none". If a value is set, all Axis 1/2/3 data, VM data and related metrics corresponding to the epochs for which the counts
42+
#' in Axis 1 are equal or higher to the threshold will be replaced by NA.
4043

4144
#' @return A dataframe.
4245
#' @export
@@ -63,6 +66,7 @@
6366
#' age = 32,
6467
#' weight = 67,
6568
#' sex = "male",
69+
#' ehcv = 15000
6670
#' )
6771
#' head(mydata_with_intensity_marks)
6872
#'
@@ -81,7 +85,9 @@ mark_intensity <- function(data,
8185
age = 40,
8286
weight = 70,
8387
sex = c("male", "female", "intersex", "undefined", "prefer not to say"),
84-
dates = NULL) {
88+
dates = NULL,
89+
ehcv = "none"
90+
) {
8591

8692

8793
if (is.null(dates)) {selected_dates <- attributes(as.factor(data$date))$levels}
@@ -144,7 +150,28 @@ mark_intensity <- function(data,
144150
df$bout <- cumsum(c(1, as.numeric(diff(df$intensity_category_num))!= 0))
145151

146152

153+
# Setting count-based data and related data to NA for abnormal metric if required
154+
155+
if (ehcv != "none" & is.numeric(ehcv) & ehcv >= 0) {
156+
157+
ehcv <- ehcv / cor_factor
147158

159+
df$axis1 <- dplyr::if_else(df$axis1 >= ehcv, NA, df$axis1)
160+
df$axis2 <- dplyr::if_else(df$axis1 >= ehcv, NA, df$axis2)
161+
df$axis3 <- dplyr::if_else(df$axis1 >= ehcv, NA, df$axis3)
162+
df$vm <- dplyr::if_else(df$axis1 >= ehcv, NA, df$vm)
163+
df$steps <- dplyr::if_else(df$axis1 >= ehcv, NA, df$steps)
164+
df$wearing <- dplyr::if_else(df$axis1 >= ehcv, "nw", df$wearing)
165+
df$non_wearing_count <- dplyr::if_else(df$axis1 >= ehcv, 1, df$non_wearing_count)
166+
df$wearing_count <- dplyr::if_else(df$axis1 >= ehcv, 0, df$wearing_count)
167+
df$SED <- dplyr::if_else(df$axis1 >= ehcv, NA, df$SED)
168+
df$LPA <- dplyr::if_else(df$axis1 >= ehcv, NA, df$LPA)
169+
df$MPA <- dplyr::if_else(df$axis1 >= ehcv, NA, df$MPA)
170+
df$VPA <- dplyr::if_else(df$axis1 >= ehcv, NA, df$VPA)
171+
df$METS <- dplyr::if_else(df$axis1 >= ehcv, NA, df$METS)
172+
df$kcal <- dplyr::if_else(df$axis1 >= ehcv, NA, df$kcal)
173+
df$mets_hours_mvpa <- dplyr::if_else(df$axis1 >= ehcv, NA, df$mets_hours_mvpa)
174+
}
148175

149176
# Providing information about the parameters used for computing results
150177
message(paste0("You have computed intensity metrics with the mark_intensity() function using the following inputs:

‎R/plot_data.R

Lines changed: 21 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -8,6 +8,8 @@
88
#' @param col_time A character value to indicate the name of the variable to plot time data.
99
#' @param col_nonwear A character value to indicate the name of the variable used to count nonwear time.
1010
#' @param col_wear A character value to indicate the name of the variable used to count wear time.
11+
#' @param ehcv A numeric value to set the threshold above which Axis 1 data should be considered as extremely high (abnormal).
12+
#' The value should be in counts/min.
1113
#' @param zoom_from A character value with the HH:MM:SS format to set the start of the daily period to visualize.
1214
#' @param zoom_to A character value with the HH:MM:SS format to set the end of the daily period to visualize.
1315
#'
@@ -34,6 +36,7 @@
3436
#' col_time = "time",
3537
#' col_nonwear = "non_wearing_count",
3638
#' col_wear = "wearing_count",
39+
#' ehcv = 15000,
3740
#' zoom_from = "02:00:00",
3841
#' zoom_to = "23:58:00"
3942
#' )
@@ -43,6 +46,7 @@ plot_data <- function(
4346
metric = "axis1",
4447
col_time = "time",
4548
col_nonwear = "non_wearing_count",
49+
ehcv = 15000,
4650
col_wear = "wearing_count",
4751
zoom_from = "00:00:00",
4852
zoom_to = "23:59:59"
@@ -68,6 +72,12 @@ plot_data <- function(
6872

6973
# Getting epoch length
7074
epoch <- as.numeric(data[[col_time]][2] - data[[col_time]][1])
75+
76+
# Getting correction factor for epoch duration different from 60s
77+
cor_factor = 60 / epoch
78+
79+
# Adjusting ehcv for the considered epoch
80+
ehcv <- ehcv / cor_factor
7181

7282
# Creating the plot
7383
p <-
@@ -128,6 +138,17 @@ plot_data <- function(
128138
geom_vline(aes(xintercept = 3600*22), linetype = "dotted", color = "grey50") +
129139
geom_vline(aes(xintercept = 3600*23), linetype = "dotted", color = "grey50")
130140

141+
142+
# Add line for highlighting abnormal values if any
143+
max_axis1 <- max(data$axis1)
144+
145+
if (metric == "axis1" && ehcv <= max_axis1) {
146+
p <- p +
147+
geom_hline(aes(yintercept = ehcv, linetype = "Threshold for \nabnormal values"), color = "red", linewidth = 0.7) +
148+
scale_linetype_manual(values = 1) +
149+
labs(linetype = NULL)
150+
}
151+
131152
suppressWarnings(print(p))
132153
}
133154

‎R/recap_by_day.R

Lines changed: 31 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -68,7 +68,11 @@
6868
#' @param start_first_bin A numeric value to set the lower bound of the first bin of the intensity band (in counts/epoch duration).
6969
#' @param start_last_bin A numeric value to set the lower bound of the last bin of the intensity band (in counts/epoch duration).
7070
#' @param bin_width A numeric value to set the width of the bins of the intensity band (in counts/epoch duration).
71-
#'
71+
#' @param ehcv A numeric value to set the threshold above which Axis 1 data should be considered as extremely high (abnormal).
72+
#' The value should be in counts/min. Default is "none". If a value is set, step-based metrics corresponding to the epochs for which the counts
73+
#' in Axis 1 are equal or higher to the threshold will be replaced by NA. The correction of the other metrics should be done when marking the dataset
74+
#' with the different categories of intensity.
75+
#'
7276
#' @return A list of objects: `df_all_metrics`, `p_band`, and `p_log`.
7377
#' `df_all_metrics` is a dataframe containing all the metrics for each day.
7478
#' `p_band` is a figure that shows the distribution of time spent in the configured bins of intensity for each day of the dataset.
@@ -130,7 +134,8 @@ recap_by_day <- function(
130134
sex = c("male", "female", "intersex", "undefined", "prefer not to say"),
131135
start_first_bin = 0,
132136
start_last_bin = 10000,
133-
bin_width = 500
137+
bin_width = 500,
138+
ehcv = "none"
134139
) {
135140

136141
sex <- match.arg(sex)
@@ -191,11 +196,22 @@ recap_by_day <- function(
191196

192197
if (as.numeric(data[[col_time]][2] - data[[col_time]][1]) == 60) {
193198

199+
## Prepare dataset
194200
df_step_metrics <-
195201
data %>%
196202
dplyr::mutate(timestamp = format(timestamp, "%Y-%m-%d %H:%M:%S")) %>%
197203
tidyr::separate("timestamp", c("date", "time"), sep = " ") %>%
198-
dplyr::mutate(date = as.Date(date), time = hms::as_hms(time)) %>%
204+
dplyr::mutate(date = as.Date(date), time = hms::as_hms(time))
205+
206+
## Remove epochs with abnormal counts
207+
if (ehcv != "none" & is.numeric(ehcv) & ehcv >= 0) {
208+
ehcv <- ehcv / cor_factor
209+
df_step_metrics$steps <- dplyr::if_else(df_step_metrics$axis1 >= ehcv, NA, df_step_metrics$steps)
210+
}
211+
212+
## Compute step-based metrics
213+
df_step_metrics <-
214+
df_step_metrics %>%
199215
dplyr::select(
200216
date,
201217
time,
@@ -221,6 +237,7 @@ recap_by_day <- function(
221237
)
222238
} else {
223239

240+
## Prepare dataset
224241
df_step_metrics <-
225242
PhysicalActivity::dataCollapser(
226243
dataset = data,
@@ -229,7 +246,17 @@ recap_by_day <- function(
229246
) %>%
230247
dplyr::mutate(timestamp = format(timestamp, "%Y-%m-%d %H:%M:%S")) %>%
231248
tidyr::separate("timestamp", c("date", "time"), sep = " ") %>%
232-
dplyr::mutate(date = as.Date(date), time = hms::as_hms(time)) %>%
249+
dplyr::mutate(date = as.Date(date), time = hms::as_hms(time))
250+
251+
## Remove epochs with abnormal counts
252+
if (ehcv != "none" & is.numeric(ehcv) & ehcv >= 0) {
253+
ehcv <- ehcv / cor_factor
254+
df_step_metrics$steps <- dplyr::if_else(df_step_metrics$axis1 >= ehcv, NA, df_step_metrics$steps)
255+
}
256+
257+
## Compute step-based metrics
258+
df_step_metrics <-
259+
df_step_metrics %>%
233260
dplyr::select(
234261
date,
235262
time,

0 commit comments

Comments
 (0)