Merge pull request #986 from wadpac/issue983_axis_qcplot_editsVincent

Issue983 axis qcplot edits vincent

NEWS.md

@@ -12,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
@@ -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(4, 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,28 +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)
-  names(mnights) = rep("midnight", length(mnights))
-  names(noons) = rep("noon", length(noons))
+  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) {
     # axis 1: midnight, noon labels (including one extra day at the beginning and end)
-    extramnights = c(mnights[1] - max(diff(mnights)), mnights, max(mnights) + max(diff(mnights)))
-    extranoons = c(noons[1] - max(diff(noons)), noons, max(noons) + max(diff(noons)))
+    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 = sort(c(extramnights, extranoons))
-    tick_labels = rep("", length(ticks)) # no tick labels
+    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(noons) > 1) {
-      extramnights = c(mnights[1] - max(diff(mnights)), mnights, max(mnights) + max(diff(mnights)))
-      ticks2 = extramnights
-      tick2_labels = paste0("d", 1:length(noons))
+    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
@@ -176,50 +179,45 @@ g.plot = function(IMP, M, I, durplot) {
     }
     plot(timeline, Acceleration, type = "l", bty = "l",
          lwd = 0.1, axes = FALSE, cex.lab = 0.8,
-         xlab = "", ylab = ylabel,  xlim = c(0, durplot), 
+         xlab = "Recording day", ylab = ylabel,  xlim = c(0, durplot), 
          ylim = YLIM, )
     axis(side = 2, at = YTICKS, las = 1, cex.axis = 0.8)
-    axis(side = 1, at = ticks, labels = tick_labels, las = 3, cex.axis = 0.8)
-    abline(v = noons, lwd = 0.5, col = "grey", lty = 2)
-    abline(v = mnights, lwd = 0.5, lty = 3)
-    lines(timeline, Acceleration, lwd = 1)
     # axis 2 (day counting)
-    if (length(noons) > 1) { # only if more than 1 day
-      axis(side = 1, at = noons, labels = tick2_labels, 
-           cex.axis = 0.8, font = 2, line = -0.4, tick = FALSE)
-      axis(side = 1, at = ticks2, labels = NA, line = 0.5, tck = -0.02)
+    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.
       }
     }
   }