diff --git a/DESCRIPTION b/DESCRIPTION index 14f5293..5fabbab 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,6 +1,6 @@ Package: actel Title: Acoustic Telemetry Data Analysis -Version: 1.3.0.9016 +Version: 1.3.0.9017 Authors@R: c( person("Hugo", "Flávio", role = c("aut", "cre"), email = "hflavio@dal.ca", comment = c(ORCID = "0000-0002-5174-1197")), diff --git a/NEWS.md b/NEWS.md index a4d45a4..3c33f13 100644 --- a/NEWS.md +++ b/NEWS.md @@ -14,6 +14,7 @@ Fixes: * Fix silent bug causing `time.ratios` (residency analysis) to occasionally calculate exceedingly long times when using `timestep = hours` (issue [#89](https://github.com/hugomflavio/actel/issues/89)). * Fixed `loadDistances()` issue where R objects were causing errors but .csv files were non-issue (issue [#134](https://github.com/hugomflavio/actel/issues/134)). * Fixed inactiveness check crash if distances matrix contains NAs (issue [#148](https://github.com/hugomflavio/actel/issues/148)). + * Fixed circular plot warnings issued when no tags passed by an array (issue [#151](https://github.com/hugomflavio/actel/issues/151)). Enhancements: * Improve timestamp handling when importing data through `preload()` (issue [#94](https://github.com/hugomflavio/actel/issues/94)). diff --git a/R/print.R b/R/print.R index 5066cf8..1d62ea7 100644 --- a/R/print.R +++ b/R/print.R @@ -798,7 +798,6 @@ printCircular <- function(times, bio, suffix = NULL){ text(x = 0.5, y = 0.5, "Could not save SVG graphic.\nPlease verify that the SVG engines are working.") grDevices::dev.off() } - if (length(unique(bio$Group)) < 8) colours <- paste0(cbPalette[c(1:length(unique(bio$Group)))], 80) else @@ -812,89 +811,107 @@ printCircular <- function(times, bio, suffix = NULL){ legend.pos <- "corner" for (i in 1:length(times)) { - if (length(unique(bio$Group)) > 1) { - link <- match(names(times[[i]]), bio$Transmitter) - groups <- factor(bio$Group[link], levels = sort(unique(bio$Group))) - trim.times <- split(times[[i]], groups) - trim.times <- trim.times[!unlist(lapply(trim.times, function(x) all(is.na(x))))] - ylegend <- -0.97 + (0.1 * (length(unique(groups)) - 2)) - } else { - trim.times <- times[i] - names(trim.times) <- unique(bio$Group) - ylegend <- -0.97 - } + plot_file <- paste0(work.path, "circular_svg_print_failure_bounce_back.png") + new_plot_file <- paste0(work.path, + "times_", names(times)[i], suffix, ".svg") + if (all(is.na(times[[i]]))) { + # nothing to plot, use no tags placeholder. + { + grDevices::png(new_plot_file, height = 500, width = 500) + par(mar = c(1, 1, 1, 1), cex = 1.5) + plot(NA, xlim = 0:1, ylim = 0:1, + xaxt = "n", yaxt = "n", bty="n", + ann = FALSE, main = names(times)[i]) + text(x = 0.5, y = 0.55, names(times)[i], font = 2) + text(x = 0.5, y = 0.45, paste0("No tags detected")) + grDevices::dev.off() + } - colours.to.use <- colours[names(trim.times)] - - if (legend.pos == "bottom") { - ylegend <- -1.15 - xlegend <- 0 - xjust <- 0.5 - number.of.columns <- 1 - if (length(colours.to.use) > 2) - number.of.columns <- 2 - if (length(colours.to.use) > 6) - number.of.columns <- 3 - if (length(colours.to.use) > 9 & !any(nchar(names(colours.to.use)) > 9)) - number.of.columns <- 4 } else { - ylegend <- -0.97 + (0.08 * (length(colours.to.use) - 2)) - xlegend <- -1.3 - xjust <- 0 - number.of.columns <- 1 - } + if (length(unique(bio$Group)) > 1) { + link <- match(names(times[[i]]), bio$Transmitter) + groups <- factor(bio$Group[link], levels = sort(unique(bio$Group))) + trim.times <- split(times[[i]], groups) + trim.times <- trim.times[!unlist(lapply(trim.times, function(x) all(is.na(x))))] + ylegend <- -0.97 + (0.1 * (length(unique(groups)) - 2)) + } else { + trim.times <- times[i] + names(trim.times) <- unique(bio$Group) + ylegend <- -0.97 + } + + colours.to.use <- colours[names(trim.times)] + + if (legend.pos == "bottom") { + ylegend <- -1.15 + xlegend <- 0 + xjust <- 0.5 + number.of.columns <- 1 + if (length(colours.to.use) > 2) + number.of.columns <- 2 + if (length(colours.to.use) > 6) + number.of.columns <- 3 + if (length(colours.to.use) > 9 & !any(nchar(names(colours.to.use)) > 9)) + number.of.columns <- 4 + } else { + ylegend <- -0.97 + (0.08 * (length(colours.to.use) - 2)) + xlegend <- -1.3 + xjust <- 0 + number.of.columns <- 1 + } - prop <- floor(1 / max(unlist(lapply(trim.times, function(x) table(ceiling(x)) / sum(!is.na(x)))))) + prop <- floor(1 / max(unlist(lapply(trim.times, function(x) table(ceiling(x)) / sum(!is.na(x)))))) - if (legend.pos == "corner") - b <- 1 - else - b <- (ceiling(length(colours.to.use) / number.of.columns)) + if (legend.pos == "corner") + b <- 1 + else + b <- (ceiling(length(colours.to.use) / number.of.columns)) - vertical.mar <- b + 2 + vertical.mar <- b + 2 + # The try call prevents the report from crashing down in the presence of unknown errors. + try( + {grDevices::svg(new_plot_file, height = 5, width = 5, + bg = "transparent") - # The try call prevents the report from crashing down in the presence of unknown errors. - try( - {grDevices::svg(paste0(work.path, "times_", names(times)[i], suffix, ".svg"), - height = 5, width = 5, bg = "transparent") + par(mar = c(b, (b + 2) / 2, 2, (b + 2) / 2), xpd = TRUE) # bottom, left, top, right - par(mar = c(b, (b + 2) / 2, 2, (b + 2) / 2), xpd = TRUE) # bottom, left, top, right + copyOfCirclePlotRad(main = names(times)[i], shrink = 1.05, xlab = "", ylab = "") - copyOfCirclePlotRad(main = names(times)[i], shrink = 1.05, xlab = "", ylab = "") + params <- myRoseDiag(trim.times, bins = 24, radii.scale = radii.scale, + prop = prop, tcl.text = -0.1, tol = 0.05, col = colours.to.use, border = "black") - params <- myRoseDiag(trim.times, bins = 24, radii.scale = radii.scale, - prop = prop, tcl.text = -0.1, tol = 0.05, col = colours.to.use, border = "black") + roseMean(trim.times, col = scales::alpha(params$col, 1), mean.length = c(0.07, -0.07), mean.lwd = 6, + box.range = "std.error", fill = "white", horizontal.border = "black", + vertical.border = scales::alpha(sapply(params$col, darken), 1), box.size = c(1.015, 0.985), + edge.length = c(0.025, -0.025), edge.lwd = 2) - roseMean(trim.times, col = scales::alpha(params$col, 1), mean.length = c(0.07, -0.07), mean.lwd = 6, - box.range = "std.error", fill = "white", horizontal.border = "black", - vertical.border = scales::alpha(sapply(params$col, darken), 1), box.size = c(1.015, 0.985), - edge.length = c(0.025, -0.025), edge.lwd = 2) + ringsRel(plot.params = params, border = "black", ring.text = TRUE, + ring.text.pos = 0.07, rings.lty = "f5", ring.text.cex = 0.8) - ringsRel(plot.params = params, border = "black", ring.text = TRUE, - ring.text.pos = 0.07, rings.lty = "f5", ring.text.cex = 0.8) + legend(x = xlegend, y = ylegend, xjust = xjust, ncol = number.of.columns, + legend = paste(names(trim.times), " (", unlist(lapply(trim.times, function(x) sum(!is.na(x)))), ")", sep =""), + fill = params$col, bty = "n", x.intersp = 0.3, cex = 0.8) - legend(x = xlegend, y = ylegend, xjust = xjust, ncol = number.of.columns, - legend = paste(names(trim.times), " (", unlist(lapply(trim.times, function(x) sum(!is.na(x)))), ")", sep =""), - fill = params$col, bty = "n", x.intersp = 0.3, cex = 0.8) + grDevices::dev.off()}, + silent = TRUE) + } + # plot_file is a failsafe placeholder by default. + # replace if the real plot file exists. + if (file.exists(new_plot_file)) { + plot_file <- new_plot_file + } - grDevices::dev.off()}, - silent = TRUE) + circular.plots <- paste0(circular.plots, + "![](", plot_file, "){ width=50% }") if (i %% 2 == 0) { - if (file.exists(paste0(work.path, "times_", names(times)[i], suffix, ".svg"))) - circular.plots <- paste0(circular.plots, "![](", work.path, "times_", names(times)[i], suffix, ".svg){ width=50% }\n") - else - circular.plots <- paste0(circular.plots, "![](", work.path, "circular_svg_print_failure_bounce_back.png){ width=50% }\n") - } else { - if (file.exists(paste0(work.path, "times_", names(times)[i], suffix, ".svg"))) - circular.plots <- paste0(circular.plots, "![", work.path, "circular_svg_print_failure_bounce_back.png](times_", names(times)[i], suffix, ".svg){ width=50% }") - else - circular.plots <- paste0(circular.plots, "![](", work.path, "circular_svg_print_failure_bounce_back.png){ width=50% }") + circular.plots <- paste0(circular.plots, "\n") } } return(circular.plots) } + #' Draw a section on the outside of the circle #' #' @param from value where the section should start