Merge branch 'master' into issue983_xaxisQCplot

wadpac · Dec 6, 2023 · 5777400 · 5777400
2 parents db8668f + ededec3
commit 5777400
Show file tree

Hide file tree

Showing 4 changed files with 21 additions and 18 deletions.
diff --git a/.github/workflows/r.yml b/.github/workflows/r.yml
@@ -32,12 +32,6 @@ jobs:
       - uses: actions/checkout@v3
       - uses: r-lib/actions/setup-tinytex@v2
       - uses: r-lib/actions/setup-pandoc@v2
-      - uses: szenius/[email protected]
-        with:
-          timezoneLinux: "Europe/Amsterdam"
-          timezoneMacos: "Pacific/Auckland"
-          timezoneWindows: "America/New_York"
-
       - uses: r-lib/actions/setup-r@v2
         with:
           r-version: ${{ matrix.config.r }}

diff --git a/NEWS.md b/NEWS.md
@@ -8,6 +8,8 @@
 
 - Part 1: Now also able to handle some more variations in Actigraph csv count file format #978, and automatically aggregates to lower resolution if short epoch size is longer than observed epoch size in actigraph count csv.
 
+- Part 5: Fix bug in recently added fucntionality for studying overlap between sibs and self-reported beahviours #989.
+
 # CHANGES IN GGIR VERSION 3.0-1
 
 - Part 2: Added option to provide a csv file with start and end dates when accelerometer is expected to be worn #943

diff --git a/R/g.part5.analyseRest.R b/R/g.part5.analyseRest.R
@@ -6,6 +6,9 @@ g.part5.analyseRest = function(sibreport = NULL, dsummary = NULL,
   if (is.ISO8601(as.character(time[1]))) {
     time = iso8601chartime2POSIX(time, tz = tz)
   }
+  sibreport$end = as.POSIXct(sibreport$end, tz = tz)
+  sibreport$start = as.POSIXct(sibreport$start, tz = tz)
+
   # Only consider sib episodes with minimum duration
   if (length(grep(pattern = "mean_acc_1min", x = colnames(sibreport))) > 0) {
     sibreport$acc_edge = pmax(sibreport$mean_acc_1min_before, sibreport$mean_acc_1min_after)
@@ -39,8 +42,8 @@ g.part5.analyseRest = function(sibreport = NULL, dsummary = NULL,
       srep_tmp$SIBoverlapNap = 0
       srep_tmp$NonwearOverlapSIB = 0
       srep_tmp$NapOverlapSIB = 0
-      srep_tmp$start = as.POSIXlt(srep_tmp$start, tz = tz)
-      srep_tmp$end = as.POSIXlt(srep_tmp$end, tz = tz)
+      srep_tmp$start = as.POSIXct(srep_tmp$start, tz = tz)
+      srep_tmp$end = as.POSIXct(srep_tmp$end, tz = tz)
       # # for qc purposes:
       # dsummary[di,fi] = nrow(srep_tmp)
       # ds_names[fi] = "n_sibs_sibreport"
@@ -135,10 +138,12 @@ g.part5.analyseRest = function(sibreport = NULL, dsummary = NULL,
       }
       ds_names[fi:(fi + 1)] = c("frag_mean_dur_srnonw_day", "dur_day_srnonw_min")
       fi = fi + 2
-      # Overlap sib with srnap
+
       calcOverlapPercentage = function(overlap, duration) {
         return(sum(overlap * duration) / sum(duration))
       }
+
+      # Overlap sib with srnap
       if (length(SIBoverlapNap_indices) > 0) {
         overlap_perc = calcOverlapPercentage(overlap = srep_tmp$SIBoverlapNap[SIBoverlapNap_indices],
                                              duration = srep_tmp$duration[SIBoverlapNap_indices])
@@ -151,9 +156,6 @@ g.part5.analyseRest = function(sibreport = NULL, dsummary = NULL,
       ds_names[fi:(fi + 2)] = c("mdur_sib_overl_srnap", "tdur_sib_overl_srnap", "perc_sib_overl_srnap")
       fi = fi + 3
       # Overlap srnap with sib
-      calcOverlapPercentage = function(overlap, duration) {
-        return(sum(overlap * duration) / sum(duration))
-      }
       if (length(SIBoverlapNap_indices) > 0) {
         overlap_perc = calcOverlapPercentage(overlap = srep_tmp$NapOverlapSIB[NapOverlapSIB_indices],
                                              duration = srep_tmp$duration[NapOverlapSIB_indices])

diff --git a/tests/testthat/test_part5_analyseRest.R b/tests/testthat/test_part5_analyseRest.R
@@ -1,20 +1,20 @@
 library(GGIR)
 context("g.part5.analyseRest")
-tz = "Europe/Amsterdam"
+
+tz = "Pacific/Auckland"
 ds_names = rep("", 40)
 dsummary = matrix("", 1, 40)
-startday = as.POSIXlt(x = "2022-06-02 08:00:00", tz = tz)
+startday = as.POSIXct(x = "2022-06-02 08:00:00", tz = tz)
 time = seq(startday, startday + (16 * 3600), by = 60)
 
-
-
 test_that("Overlap 1 nap and 1 sib", {
   fi = 1
   di = 1
   sibreport = data.frame(ID = rep("test123", 2), type = c("nap", "sib"),
                          start = c("2022-06-02 14:00:00", "2022-06-02 14:05:00"),
                          end = c("2022-06-02 14:20:00", "2022-06-02 14:20:00"))
-  sibreport$duration = as.numeric(difftime(time1 = sibreport$end, time2 = sibreport$start, units = "mins", tz = tz))
+  sibreport$duration = as.numeric(difftime(time1 = sibreport$end,
+                                           time2 = sibreport$start, units = "mins", tz = tz))
   restAnalyses = g.part5.analyseRest(sibreport = sibreport, dsummary = dsummary,
                                      ds_names = ds_names, fi = fi, di = di,
                                      time = time,
@@ -81,12 +81,16 @@ test_that("No overlap 1 nonwear, 1 nap, and 1 sib", {
   fi = restAnalyses$fi
   di = restAnalyses$di
   dsummary = restAnalyses$dsummary
+  expect_equal(sum(as.numeric(restAnalyses$dsummary), na.rm = TRUE), 129)
+
   ds_names = restAnalyses$ds_names
   dsummary = as.numeric(dsummary[, which(ds_names != "")])
   ds_names = ds_names[ds_names != ""]
   names(dsummary) = ds_names
   dsummary = as.data.frame(t(dsummary))
 
+  expect_equal(ncol(dsummary), 27)
+  expect_equal(nrow(dsummary), 1)
   expect_equal(dsummary$nbouts_day_sib, 1)
   expect_equal(dsummary$nbouts_day_srnap, 1)
   expect_equal(dsummary$nbouts_day_srnonw, 1)
@@ -96,5 +100,6 @@ test_that("No overlap 1 nonwear, 1 nap, and 1 sib", {
   expect_equal(dsummary$perc_sib_overl_srnap, 0)
   expect_equal(dsummary$perc_sib_overl_srnonw, 0)
   expect_equal(dsummary$perc_srnonw_overl_sib, 0)
-  expect_equal(sum(dsummary), 129)
+  expect_equal(sum(dsummary, na.rm = TRUE), 129)
+
 })