diff --git a/NEWS.md b/NEWS.md index 923803fcc..cf19e14db 100644 --- a/NEWS.md +++ b/NEWS.md @@ -19,6 +19,8 @@ this is consistent with functionality in the past. #1223 - Part 2: Add parameters nonwearFiltermaxHours and nonwearFilterWindow to give use the option to filter short lasting nighttime nonwear #1218. +- Part 5: Improved handling of partially available and non-available qwindow segments in the recording #1229 + # CHANGES IN GGIR VERSION 3.1-6 - Part 6: diff --git a/R/g.fragmentation.R b/R/g.fragmentation.R index 72d6ff4cd..f66680d19 100644 --- a/R/g.fragmentation.R +++ b/R/g.fragmentation.R @@ -108,6 +108,14 @@ g.fragmentation = function(frag.metrics = c("mean", "TP", "Gini", "power", } else { do.frag = FALSE } + # define expected output to standardize length and output names + if ("TP" %in% frag.metrics) { + output[["TP_IN2PA"]] = output[["TP_PA2IN"]] = output[["Nfrag_IN2PA"]] = output[["Nfrag_PA2IN"]] = NA + output[["TP_IN2LIPA"]] = output[["Nfrag_IN2LIPA"]] = NA + output[["TP_IN2MVPA"]] = output[["Nfrag_IN2MVPA"]] = NA + output[["Nfrag_LIPA"]] = output[["mean_dur_LIPA"]] = NA + output[["Nfrag_MVPA"]] = output[["mean_dur_MVPA"]] = NA + } if (Nepochs > 1 & mode == "day") { # metrics that require more than just binary #==================================================== # Convert LEVELS in three classes: Inactivity (1), Light = LIPA (2), and MVPA (3) @@ -144,7 +152,6 @@ g.fragmentation = function(frag.metrics = c("mean", "TP", "Gini", "power", } #==================================================== # Binary fragmentation for the metrics that do not depend on multiple classes - if (mode == "day") { x = rep(0,Nepochs) is.na(x[is.na(LEVELS)]) = TRUE @@ -155,7 +162,6 @@ g.fragmentation = function(frag.metrics = c("mean", "TP", "Gini", "power", out = TransProb(x, a = 1, b = 0) #IN <-> PA output[["Nfrag_PA"]] = out$Nba output[["Nfrag_IN"]] = out$Nab - # Define default values if ("mean" %in% frag.metrics) { output[["mean_dur_PA"]] = output[["mean_dur_IN"]] = 0 diff --git a/R/g.part5.R b/R/g.part5.R index fe05d9a5c..b06156d79 100644 --- a/R/g.part5.R +++ b/R/g.part5.R @@ -537,9 +537,10 @@ g.part5 = function(datadir = c(), metadatadir = c(), f0=c(), f1=c(), } if (timewindowi == "MM" & si > 1) { # because first segment is always full window if (("segment" %in% colnames(ts)) == FALSE) ts$segment = NA - ts$segment[segStart:segEnd] = si + if (!is.na(segStart) && !is.na(segEnd)) { + ts$segment[segStart:segEnd] = si + } } - # Already store basic information about the file # in the output matrix: dsummary[si,fi:(fi + 1)] = c(ID, fnames.ms3[i]) diff --git a/R/g.part5.definedays.R b/R/g.part5.definedays.R index 78ba4383b..a81705adb 100644 --- a/R/g.part5.definedays.R +++ b/R/g.part5.definedays.R @@ -55,6 +55,7 @@ g.part5.definedays = function(nightsi, wi, indjump, nightsi_bu, qqq_backup = qqq # in MM, also define segments of the day based on qwindow if (!is.na(qqq[1]) & !is.na(qqq[2])) { + segments_timing = NULL if (qqq[2] > Nts) qqq[2] = Nts fullQqq = qqq[1]:qqq[2] firstepoch = format(ts$time[qqq[1]], "%H:%M:%S") @@ -74,55 +75,34 @@ g.part5.definedays = function(nightsi, wi, indjump, nightsi_bu, if (qwindow[1] != 0) qwindow = c(0, qwindow) if (qwindow[length(qwindow)] != 24) qwindow = c(qwindow, 24) } + # define segments timing in H:M:S format breaks = qwindow2timestamp(qwindow, epochSize) - if (24 %in% qwindow) { - # 24:00:00: probably does not exist, replace by last timestamp in a day - # here, we consider N epochs per day plus 1 hour just in case we are deriving this in - # a 25-hour daylight saving time day - NepochPerDayPlusOneHr = ((25*3600) / epochSize) - latest_time_in_day = max(format(ts$time[1:pmin(Nts, NepochPerDayPlusOneHr)], format = "%H:%M:%S")) - breaks = gsub(pattern = "24:00:00", replacement = latest_time_in_day, x = breaks) - } - breaks_i = c() - for (bi in 1:length(breaks)) { - if (any(grepl(breaks[bi], ts$time[fullQqq]))) { - breaks_i[bi] = fullQqq[grep(breaks[bi], ts$time[fullQqq])][1] - } else { - breaks_i[bi] = qqq[1] - } - } - # build up segments - segments = list(qqq) - segments_timing = paste(firstepoch, lastepoch, sep = "-") - segments_names = "MM" - si = 2 - do.segments = TRUE - if (length(qwindow) == 2) { - if (all((qwindow) == c(0, 24))) { - do.segments = FALSE - } - } - if (do.segments == TRUE) { - for (bi in 1:(length(breaks) - 1)) { - minusOne = ifelse(breaks[bi + 1] == lastepoch, 0, 1) - if (minusOne == 1) { - segments[[si]] = c(breaks_i[bi], breaks_i[bi + 1] - 1) - endOfSegment = subtractEpochFromTimeName(breaks[bi + 1], epochSize) - } else { - segments[[si]] = c(breaks_i[bi], breaks_i[bi + 1]) - endOfSegment = breaks[bi + 1] - } - if (segments[[si]][2] < segments[[si]][1]) segments[[si]][2] = segments[[si]][1] - segments_timing[si] = paste(breaks[bi], endOfSegment, sep = "-") - if (is.null(qnames)) { - segments_names[si] = paste0("segment", bi) - } else { - segments_names[si] = paste(qnames[si - 1], qnames[si], sep = "-") - } - si = si + 1 - } + startOfSegments = breaks[-length(breaks)] + endOfSegments = subtractEpochFromTimeName(breaks[-1], epochSize) + if (length(startOfSegments) > 1) { # when qwindow segments are defined, add fullwindow at the beginning + startOfSegments = c(firstepoch, startOfSegments) + endOfSegments = c(lastepoch, endOfSegments) + } + segments_timing = paste(startOfSegments, endOfSegments, sep = "-") + # define segment names based on qnames or segmentX + if (is.null(qnames)) { + segments_names = paste0("segment", 0:(length(segments_timing) - 1)) + segments_names = gsub("segment0", "MM", segments_names) + } else { + segments_names = c("MM", paste(qnames[-length(qnames)], qnames[-1], sep = "-")) } + # Get indices in ts for segments start and end limits + hms = format(ts$time[fullQqq], format = "%H:%M:%S") + segments = vector("list", length = length(segments_timing)) names(segments) = segments_timing + for (si in 1:length(segments_timing)) { + s0s1 = unlist(strsplit(segments_timing[si], split = "[-]")) + s0s1 = format(s0s1, format = "%H:%M:%S") + # tryCatch is needed in the case that the segment is not available in ts, + # then a no non-missing values warning would be triggered by the which function + segments[[si]] = tryCatch(range(fullQqq[which(hms >= s0s1[1] & hms <= s0s1[2])]), #segStart and segEnd + warning = function(w) rep(NA, 2)) + } } } else if (timewindowi == "WW" || timewindowi == "OO") { windowEdge = ifelse(timewindowi == "WW", yes = -1, no = 1) diff --git a/R/g.part5_analyseSegment.R b/R/g.part5_analyseSegment.R index f985905b6..3c90299f3 100644 --- a/R/g.part5_analyseSegment.R +++ b/R/g.part5_analyseSegment.R @@ -46,9 +46,8 @@ g.part5_analyseSegment = function(indexlog, timeList, levelList, #========================== # The following is to avoid issue with merging sleep variables from part 4 - # This code extract them the time series (ts) object created in g.part5 - # Note that this means that for MM windows there can be multiple or no wake or onsets - date = as.Date(ts$time[segStart + 1], tz = params_general[["desiredtz"]]) + # Note that this means that for MM windows there can be multiple or no wake or onsets in window + date = as.Date(ts$time[qqq[1]], tz = params_general[["desiredtz"]]) # changed segStart for qqq[1] in case segment is not available in this day if (add_one_day_to_next_date == TRUE & timewindowi %in% c("WW", "OO")) { # see below for explanation date = date + 1 add_one_day_to_next_date = FALSE @@ -115,7 +114,10 @@ g.part5_analyseSegment = function(indexlog, timeList, levelList, sumSleep$acc_available[dayofinterest]) ds_names[fi:(fi + 5)] = c("night_number", "daysleeper", "cleaningcode", "guider", "sleeplog_used", "acc_available"); fi = fi + 6 - ts$guider[segStart:segEnd] = sumSleep$guider[dayofinterest] # add guider also to timeseries + if (!is.na(segStart) & !is.na(segEnd)) { + # segment available in time series + ts$guider[segStart:segEnd] = sumSleep$guider[dayofinterest] # add guider also to timeseries + } } else { dsummary[si,fi:(fi + 5)] = rep(NA, 6) ds_names[fi:(fi + 5)] = c("night_number", @@ -129,8 +131,8 @@ g.part5_analyseSegment = function(indexlog, timeList, levelList, # which differs between MM and WW # Also, it allows for the analysis of the first day for those studies # in which the accelerometer is started during the morning and the first day is of interest. - # qqq1 is the start of the day - # qqq2 is the end of the day + # qqq1 is the start of the day/segment + # qqq2 is the end of the day/segment qqq1 = segStart qqq2 = segEnd # keep track of threshold value @@ -138,8 +140,12 @@ g.part5_analyseSegment = function(indexlog, timeList, levelList, ds_names[fi:(fi + 2)] = c("TRLi", "TRMi", "TRVi") fi = fi + 3 wlih = ((qqq2 - qqq1) + 1)/((60/ws3new) * 60) - if (qqq1 > length(LEVELS)) qqq1 = length(LEVELS) - sse = qqq1:qqq2 + if (!is.na(qqq1)) { + if (qqq1 > length(LEVELS)) qqq1 = length(LEVELS) + sse = qqq1:qqq2 + } else { + sse = NULL + } doNext = FALSE if (length(sse) >= 1) { #next #============================================================ @@ -453,4 +459,4 @@ g.part5_analyseSegment = function(indexlog, timeList, levelList, doNext = doNext, add_one_day_to_next_date = add_one_day_to_next_date )) -} \ No newline at end of file +}