Skip to content

Commit

Permalink
refactoring
Browse files Browse the repository at this point in the history
  • Loading branch information
Nathaniel J. Fernandes committed Sep 17, 2023
1 parent 66e55ab commit c3e308d
Show file tree
Hide file tree
Showing 2 changed files with 68 additions and 70 deletions.
14 changes: 6 additions & 8 deletions R/mage.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -2,7 +2,7 @@
#'
#' @description The function calculates MAGE values and can optionally return a plot of the glucose trace.
#'
#' @param data Data Frame object with column names "id", "time", and "gl" OR numeric vector of glucose values (numeric vector allowed for version \code{'naive'} only).
#' @param data DataFrame object with column names "id", "time", and "gl" OR numeric vector of glucose values.
#'
#' @param version Either \code{'ma'} or \code{'naive'}. Chooses which version of the MAGE algorithm to use. \code{'ma'} algorithm is more accurate, and is the default. Earlier versions of iglu package (<=2.0.0) used \code{'naive'}.
#'
Expand All @@ -18,7 +18,7 @@
#' be returned with one plot per subject.
#' @export
#'
#' @details If version \code{'ma'} is selected, the function computationally emulates the manual method for calculating the mean amplitude of glycemic excursions (MAGE) first suggested in Mean Amplitude of Glycemic Excursions, a Measure of Diabetic Instability, (Service, 1970). For this version, glucose values will be interpolated over a uniform time grid prior to calculation.
#' @details If version \code{'ma'} is selected, the function computationally emulates the manual method for calculating the mean amplitude of glycemic excursions (MAGE) first suggested in "Mean Amplitude of Glycemic Excursions, a Measure of Diabetic Instability", (Service, 1970). For this version, glucose values will be interpolated over a uniform time grid prior to calculation.
#'
#' \code{'ma'} is a more accurate algorithm that uses the crosses of a short and long moving average to identify intervals where a peak/nadir might exist. Then, the height from one peak/nadir to the next nadir/peak is calculated from the *original* (not moving average) glucose values.
#'
Expand All @@ -33,8 +33,6 @@
#' data(example_data_5_subject)
#' mage(example_data_5_subject, version = 'ma')



mage <- function(data, version = c('ma', 'naive'), sd_multiplier = 1,
short_ma = 5, long_ma = 32, type = c('auto', 'plus', 'minus'),
plot = FALSE, dt0 = NULL, inter_gap = 45, tz = "",
Expand All @@ -60,7 +58,7 @@ mage_ma <- function(data, short_ma = 5, long_ma = 32, type = c('auto', 'plus', '
rm(list = c("id", ".", "MAGE"))

data = check_data_columns(data)
is_vector = attr(data, "is_vector") # TODO: is this check really necessary?
is_vector = attr(data, "is_vector") # TODO: is this check really necessary? when does this return true?

out <- data %>%
dplyr::filter(!is.na(gl)) %>%
Expand Down Expand Up @@ -90,18 +88,18 @@ mage_sd <- function(data, sd_multiplier = 1){
abs_diff_mean = gl = id = NULL
rm(list = c("gl", "id", "abs_diff_mean"))
data = check_data_columns(data)
is_vector = attr(data, "is_vector") # TODO: if remove below, then remove here
is_vector = attr(data, "is_vector")

out = data %>%
dplyr::filter(!is.na(gl)) %>%
dplyr::group_by(id) %>%
dplyr::mutate(abs_diff_mean = abs(gl - mean(gl, na.rm = TRUE))) %>%
dplyr::summarise(
dplyr::summarise( # TODO: this has been deprecated - use reframe instead
MAGE = mean(
abs_diff_mean[abs_diff_mean > (sd_multiplier * sd(gl, na.rm = TRUE))],
na.rm = TRUE)
)
if (is_vector) { # TODO: can remove - will just output 2 columns instead of 1
if (is_vector) {
out$id = NULL
}
return(out)
Expand Down
124 changes: 62 additions & 62 deletions R/mage_ma_single.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -210,71 +210,71 @@ mage_ma_single <- function(data, short_ma = 5, long_ma = 32, type = c('auto', 'p

# Computation:
# 1. collect all tp ids
# tp_indexes <- sapply(2:nrow(crosses), function(i) {
# # ASSUMES alternating MIN, MAX, MIN, ... (data should be in that arrangement based on slection of indices)
# if (crosses$type[i] == types$REL_MAX) { return }
# })
tp_indexes <- sapply(2:nrow(crosses), function(i) {
# ASSUMES alternating MIN, MAX, MIN, ... (data should be in that arrangement based on selection of indices)
if (crosses$type[i] == types$REL_MAX) { return }
})

# 2. Filter the excursions maybe get ids:

# tp_indexes <- numeric()
# # currently, if the first is below, it moves on to next point (potentially want to accumulate)
# # can we do this in vector form?
# while(n < length(minmax)) {
# height1 <- minmax[n+1] - minmax[n]
# # Redefined variable type, not great
# type <- crosses[n+1, "type"] ## crosses has 1 more element (from line 163-164) so add 1
#
# # Check if excursion is above SD. If smaller - go to next excursion.
# if(abs(height1) > standardD) {
# # Check if it was specified whether MAGE+ or MAGE- should be computed.
# # If not specified (-1), determine based on value of height1
# # height1 > 0 means it's nadir to peak
# if(nadir2peak == -1) { # Assigns nadir2peak
# nadir2peak <- ifelse(height1 > 0, 1, 0)
# }
#
# # Once plus or minus is specified, only look at those excursions that match the type
# if(nadir2peak == type) {
# if(n+1 == length(minmax)) { # covers case where one before last
# height2 <- minmax[n+1]-minmax[n]
#
# if(abs(height2) >= standardD) { # append height2 to height
# tp_indexes <- append(tp_indexes, indexes[n]) # TODO: combine into one?
# tp_indexes <- append(tp_indexes, indexes[n+1])
# heights <- append(heights, abs(height2))
# }
# }
# else {
# x <- 1
# height2 <- 0
# while(!(abs(height2) >= standardD) && n+x+1 <= length(minmax)) { # checks bounds
# height2 <- minmax[n+x+1]-minmax[n+x]
#
# if(abs(height2) >= standardD || n+x+1 == length(minmax)-1 || n+x+1 == length(minmax)) {
# # appends height2 to height
# tp_indexes <- append(tp_indexes, indexes[n])
# if(nadir2peak == 1) {
# heights <- append(heights, abs(minmax[n] - max(minmax[n:(n+x+1)])))
# tp_indexes <- append(tp_indexes, indexes[n + which.max(minmax[n:(n+x+1)])-1])
# } else {
# heights <- append(heights, abs(minmax[n]- min(minmax[n:(n+x+1)])))
# tp_indexes <- append(tp_indexes, indexes[n + which.min(minmax[n:(n+x+1)])-1])
# }
# n <- n+x
# }
# else {
# # this implicitly assumes you hvae min/max/min/max always alternating - does not work w/ GAPS
# x <- x + 2
# }
# }
# }
# }
# }
#
# # increment loop variable
# n <- n + 1
# }
tp_indexes <- numeric()
# currently, if the first is below, it moves on to next point (potentially want to accumulate)
# can we do this in vector form?
while(n < length(minmax)) {
height1 <- minmax[n+1] - minmax[n]
# Redefined variable type, not great
type <- crosses[n+1, "type"] ## crosses has 1 more element (from line 163-164) so add 1

# Check if excursion is above SD. If smaller - go to next excursion.
if(abs(height1) > standardD) {
# Check if it was specified whether MAGE+ or MAGE- should be computed.
# If not specified (-1), determine based on value of height1
# height1 > 0 means it's nadir to peak
if(nadir2peak == -1) { # Assigns nadir2peak
nadir2peak <- ifelse(height1 > 0, 1, 0)
}

# Once plus or minus is specified, only look at those excursions that match the type
if(nadir2peak == type) {
if(n+1 == length(minmax)) { # covers case where one before last
height2 <- minmax[n+1]-minmax[n]

if(abs(height2) >= standardD) { # append height2 to height
tp_indexes <- append(tp_indexes, indexes[n]) # TODO: combine into one?
tp_indexes <- append(tp_indexes, indexes[n+1])
heights <- append(heights, abs(height2))
}
}
else {
x <- 1
height2 <- 0
while(!(abs(height2) >= standardD) && n+x+1 <= length(minmax)) { # checks bounds
height2 <- minmax[n+x+1]-minmax[n+x]

if(abs(height2) >= standardD || n+x+1 == length(minmax)-1 || n+x+1 == length(minmax)) {
# appends height2 to height
tp_indexes <- append(tp_indexes, indexes[n])
if(nadir2peak == 1) {
heights <- append(heights, abs(minmax[n] - max(minmax[n:(n+x+1)])))
tp_indexes <- append(tp_indexes, indexes[n + which.max(minmax[n:(n+x+1)])-1])
} else {
heights <- append(heights, abs(minmax[n]- min(minmax[n:(n+x+1)])))
tp_indexes <- append(tp_indexes, indexes[n + which.min(minmax[n:(n+x+1)])-1])
}
n <- n+x
}
else {
# this implicitly assumes you have min/max/min/max always alternating - does not work w/ GAPS
x <- x + 2
}
}
}
}
}

# increment loop variable
n <- n + 1
}

## 4. Generate Plot of Data (if specified)
if(plot) {
Expand Down

0 comments on commit c3e308d

Please sign in to comment.