Merge pull request #985 from wadpac/issue983_xaxisQCplot

Issue983 xaxis q cplot

NEWS.md

@@ -2,6 +2,8 @@
 
 - Part 2: Fix bug that caused part 2 to struggle with corrupt ActiGraph .gt3x files #972
 
+- Part 2: Redefine horizontal axis of plots_to_check_data_quality #983
+
 - Documentation: Expanded documentation on desiredtz, configtz, and time stamp format in part 5 time series #966
 
 - 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.
@@ -10,7 +12,7 @@
 
 - Argument documentation: Fixing series of typos (thanks to Pieter-Jan Marent for pointing them out)
 
-- Part 5: Fix bug in recently added fucntionality for studying overlap between sibs and self-reported beahviours #989.
+- Part 5: Fix bug in recently added functionality for studying overlap between sibs and self-reported behaviours #989.
 
 # CHANGES IN GGIR VERSION 3.0-1
 

R/g.plot.R

@@ -1,5 +1,6 @@
 g.plot = function(IMP, M, I, durplot) {
-  # Extracting filename and monitor type 
+
+    # Extracting filename and monitor type 
   fname = I$filename
   mon = I$monc
   monn = I$monn
@@ -35,7 +36,7 @@ g.plot = function(IMP, M, I, durplot) {
       x0 = c()
       x1 = c()
     }
-    invisible(list(x0=x0,x1=x1))
+    invisible(list(x0 = x0, x1 = x1))
   }
 
   #create coordinates for rectangles non-wear
@@ -51,14 +52,13 @@ g.plot = function(IMP, M, I, durplot) {
 
   # start plot with empty canvas
   plot.new()	
-  par(fig = c(0, 1, 0, 1), new = T, mar = c(5, 4, 3, 0))
+  par(fig = c(0, 1, 0, 1), new = T, mar = c(5, 4, 3, 0.5))
   plot(seq(0, durplot), seq(0, durplot), col = "white", type = "l", axes = F, 
        xlab = "", ylab = "", main = paste0("device brand: ", monn, " | filename: ", fname), cex.main = 0.6)#dummy plot
-  # lim = par("usr")
   # draw coloured rectangles
   Y0 = -50
-  Y1 = c(durplot) # + n_ws2_perday)
-  legend_names = c("non-wear", "signal clipping", "more non-wear", "study protocol")
+  Y1 = durplot * 0.98 # leave space around legend
+  legend_names = c("not worn", "signal clipping", "also not worn", "study protocol masked")
   legend_lty = c(NA, NA, NA, NA)
   legend_density = c(100, 100, 100, dens)
   x.intersp = rep(0.5, 4)
@@ -67,31 +67,31 @@ g.plot = function(IMP, M, I, durplot) {
   if (length(s0) > 0) { #non-wear
     CL = colors()[148]
     for (ri in 1:length(s0)) {
-      rect(s0[ri], Y0, s1[ri], Y1, border = colors()[148], col = CL) #red 404
+      rect(s0[ri], Y0, s1[ri], Y1, border = colors()[148], col = CL, lwd = 0.6)
     }
     legend_index = 1
     legend_colors = CL
   }
   if (length(b0) > 0) { #clip
     CL = colors()[464]
     for (ri in 1:length(b0)) {
-      rect(b0[ri], Y0, b1[ri], Y1, border = colors()[464], col = CL)
+      rect(b0[ri], Y0, b1[ri], Y1, border = colors()[464], col = CL, lwd = 0.6)
     }
     legend_index = c(legend_index, 2)
     legend_colors = c(legend_colors, CL)
   }
   if (length(g0) > 0) {
     CL = colors()[150]
     for (ri in 1:length(g0)) { #additional non-wear
-      rect(g0[ri], Y0, g1[ri], Y1, border = colors()[150], col = CL)
+      rect(g0[ri], Y0, g1[ri], Y1, border = colors()[150], col = CL, lwd = 0.6)
     }
     legend_index = c(legend_index, 3)
     legend_colors = c(legend_colors, CL)
   }
   if (length(w0) > 0) {
     CL = colors()[24]
     for (ri in 1:length(w0)) { #protocol
-      rect(w0[ri], Y0, w1[ri], Y1, border = colors()[24], col = CL, density = dens)
+      rect(w0[ri], Y0, w1[ri], Y1, border = colors()[24], col = CL, density = dens, lwd = 0.6)
     }
     legend_index = c(legend_index, 4)
     legend_colors = c(legend_colors, CL)
@@ -103,10 +103,7 @@ g.plot = function(IMP, M, I, durplot) {
   legend_density = legend_density[legend_index]
   x.intersp = x.intersp[legend_index]
 
-  if (length(legend_index) > 0) {
-    legend("top", legend = legend_names, col = legend_colors, density = legend_density, #lty = legend_lty,  lty = legend_lty, 
-           fill = legend_colors, border = legend_colors, x.intersp = x.intersp, ncol = 4, cex = 0.7, bty = 'n')
-  }
+
 
   abline(v = timeline[length(timeline)], col = "blue", lwd = 1)	
 
@@ -129,19 +126,34 @@ g.plot = function(IMP, M, I, durplot) {
   MEND = length(timeline)
   mnights = grep("00:00:00", M$metalong$timestamp)
   noons = grep("12:00:00", M$metalong$timestamp)
+  abline(v = noons, lwd = 0.5, col = "grey", lty = 2)
+  abline(v = mnights, lwd = 0.5, lty = 3)
+  if (length(legend_index) > 0) {
+    legend("top", legend = legend_names, col = legend_colors, density = legend_density, #lty = legend_lty,  lty = legend_lty, 
+           fill = legend_colors, border = legend_colors,
+           x.intersp = x.intersp, ncol = 4, cex = 0.6, lwd = 0.6,
+           bg = "white", box.col = "black")
+  }
   if (length(mnights) > 0 & length(noons) > 0) {
-    ticks = sort(c(mnights, noons))
-    if (mnights[1] < noons[1]) {
-      tick_labels = rep(c("00", "12"), length.out = length(ticks))
-    } else if (noons[1] < mnights[1]) {
-      tick_labels = rep(c("12", "00"), length.out = length(ticks))
+    # axis 1: midnight, noon labels (including one extra day at the beginning and end)
+    extramnights = c(mnights[1] - n_ws2_perday, mnights, max(mnights) + n_ws2_perday)
+    extranoons = c(noons[1] - n_ws2_perday, noons, max(noons) + n_ws2_perday)
+    if (extranoons[1] < extramnights[1]) extranoons = extranoons[-1]
+    if (max(extranoons) > max(extramnights)) extranoons = extranoons[-length(extranoons)]
+    ticks_12hours = sort(c(extramnights, extranoons))
+    x_labels_12hours = rep("", length(ticks_12hours)) # no tick labels
+    # axis 2: day counting (including one extra day at the beginning and end)
+    if (length(extranoons) > 1) {
+      extramnights = c(mnights[1] - n_ws2_perday, mnights, max(mnights) + n_ws2_perday)
+      ticks_dayborders = extramnights
+      x_labels_days = ceiling((extranoons / n_ws2_perday) - 0.5) + 1
     }
   } else {
-    ticks = seq(0, nrow(M$metalong) + n_ws2_perday, by = n_ws2_perday)
-    tick_labels = 1:length(ticks)
+    ticks_12hours = seq(0, nrow(M$metalong) + n_ws2_perday, by = n_ws2_perday)
+    x_labels_12hours = 1:length(ticks_12hours)
   }
   # creating plot functions to avoid duplicated code
-  plot_acc = function(timeline, Acceleration, durplot, ticks, metricName, tick_labels) {
+  plot_acc = function(timeline, Acceleration, durplot, ticks_12hours, metricName, x_labels_12hours) {
     if (metricName %in% c("ZCX", "ZCY", "ZCX") == TRUE | 
         length(grep(pattern = "count", x = metricName, ignore.case = TRUE)) > 0) {
       # Metric is not on a G scale
@@ -161,47 +173,51 @@ g.plot = function(IMP, M, I, durplot) {
       YTICKS = round(c(0, YLIM[2] * 0.3, YLIM[2] * 0.65, YLIM[2] * 0.95))
       YTICKS = unique(round(YTICKS/10) * 10) # round to nearest ten and remove possible duplicates
     } else {
-      ylabel = expression(paste("Acceleration (", italic("g"), ")"))
+      ylabel = expression(paste("Acceleration (m", italic("g"), ")"))
       YLIM = c(0, 0.6)
       YTICKS = c(0, 0.2, 0.4, 0.6)
     }
-    plot(timeline, Acceleration, type = "l", xlab = "Time (Hours)",
-         ylab = ylabel,
-         bty = "l", lwd = 0.1, xlim = c(0, durplot), ylim = YLIM, axes = FALSE, cex.lab = 0.8)
-    axis(side = 2, at = YTICKS)
-    axis(side = 1, at = ticks, labels = tick_labels)
+    plot(timeline, Acceleration, type = "l", bty = "l",
+         lwd = 0.1, axes = FALSE, cex.lab = 0.8,
+         xlab = "Recording day", ylab = ylabel,  xlim = c(0, durplot), 
+         ylim = YLIM, )
+    axis(side = 2, at = YTICKS, las = 1, cex.axis = 0.8)
+    # axis 2 (day counting)
+    if (length(extranoons) > 1) { # only if more than 1 day
+      axis(side = 1, at = extranoons, labels = x_labels_days, 
+           cex.axis = ifelse(test = length(extranoons) > 10, yes = 0.6, no = 0.8),
+           font = 1, tick = FALSE, lwd = 0.8, mgp = c(3,1,0)) #line = -0.4
+      axis(side = 1, at = ticks_dayborders, labels = NA, tck = -0.05, mgp = c(3,1,0))# line = 0.5, 
+    }
   }
-
-  plot_nonwear = function(timeline, M, durplot, ticks) {
+  plot_nonwear = function(timeline, M, durplot, ticks_12hours) {
     plot(timeline, M$metalong$nonwearscore, type = "s",
          xlab = "", ylab = "Non-wear score", axes = F,
          lwd = 0.1, xlim = c(0,durplot), ylim = c(0, 3), cex.lab = 0.8)
-    axis(side = 2,at = c(0, 1, 2, 3))
-    # axis(side = 1,at = ticks, labels = 1:length(ticks))
+    axis(side = 2,at = c(0, 1, 2, 3), cex.axis = 0.8, las = 1)
   }
   # plot data
   if (mon == MONITOR$GENEACTIV || (mon == MONITOR$AXIVITY && dformat == FORMAT$CWA)) {
     # Recordings with temperature
-    par(fig = c(0,1,0,0.65), new = T)
-    plot_acc(timeline, Acceleration, durplot, ticks, metricName, tick_labels)
+    par(fig = c(0,1, 0, 0.65), new = T)
+    plot_acc(timeline, Acceleration, durplot, ticks_12hours, metricName, x_labels_12hours)
 
     par(fig = c(0, 1, 0.45, 0.80), new = T)
-    plot_nonwear(timeline, M, durplot, ticks)
+    plot_nonwear(timeline, M, durplot, ticks_12hours)
 
     par(fig = c(0, 1, 0.60, 0.95), new = T)
     plot(timeline, M$metalong$temperaturemean[1:MEND], type = "l",
          xlab = "", ylab = "Temp. (C)", axes = F, lwd = 0.1,
          xlim = c(0, durplot), ylim = c(20,35), cex.lab = 0.8)
     abline(h = 20, col = "black", lwd = 1, lty = 2)
     abline(h = 35, col = "black", lwd = 1, lty = 2)
-    axis(side = 2,at = c(20,35))
-    # axis(side = 1,at = ticks, labels = 1:length(ticks))
+    axis(side = 2,at = c(20,35), cex.axis = 0.8, las = 1)
   } else {
     # Recordings without temperature
     par(fig = c(0, 1, 0, 0.80), new = T)
-    plot_acc(timeline, Acceleration, durplot, ticks, metricName, tick_labels)
+    plot_acc(timeline, Acceleration, durplot, ticks_12hours, metricName, x_labels_12hours)
 
     par(fig = c(0, 1, 0.60, 0.95), new = T)
-    plot_nonwear(timeline, M, durplot, ticks)
+    plot_nonwear(timeline, M, durplot, ticks_12hours)
   }
 }

man/GGIR.Rd

@@ -1166,7 +1166,8 @@ GGIR(mode = 1:5,
         
       \item{possible_nap_edge_acc}{
         Numeric (default = Inf).
-        Minimum acceleration before or after the SIB for the nap to be considered.
+        Maximum acceleration before or after the SIB for the nap to be considered.
+        By default this will allow all possible naps.
       }
     }
   }