Merge pull request #1232 from wadpac/issue1229_duplicatedFragNames

Issue1229 duplicated frag names
wadpac · Nov 22, 2024 · 2cc32ce · 2cc32ce
2 parents 5c13e43 + b944c02
commit 2cc32ce
Show file tree

Hide file tree

Showing 5 changed files with 53 additions and 57 deletions.
diff --git a/NEWS.md b/NEWS.md
@@ -4,6 +4,8 @@
 
 - Part 2: Code revisions in preparation for expansion of functionality to better facilitate external function produced event data. #653 and #1228
 
+- 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
@@ -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
@@ -481,9 +481,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
@@ -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
@@ -47,7 +47,7 @@ g.part5_analyseSegment = function(indexlog, timeList, levelList,
   #==========================
   # The following is to avoid issue with merging sleep variables from part 4
   # Note that this means that for MM windows there can be multiple or no wake or onsets in window
-  date = as.Date(ts$time[segStart], tz = params_general[["desiredtz"]])
+  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
@@ -114,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",
@@ -128,17 +131,21 @@ 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
   dsummary[si, fi:(fi + 2)] = c(TRLi, TRMi, TRVi)
   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
     #============================================================
@@ -427,4 +434,4 @@ g.part5_analyseSegment = function(indexlog, timeList, levelList,
     doNext = doNext,
     add_one_day_to_next_date = add_one_day_to_next_date
   ))
-}
+}