Prepare 1.1.14 (#109)

.Rbuildignore

@@ -16,3 +16,4 @@
 ^fgeo\.analyze\.Rproj$
 ^\.Rproj\.user$
 ^CRAN-RELEASE$
+^codecov\.yml$

DESCRIPTION

@@ -53,7 +53,7 @@ Description: To help you access, transform, analyze, and
     topography, demography, and biomass. It also includes a torus
     translation test to determine habitat associations of tree species as
     described by Zuleta et al. (2018) <doi:10.1007/s11104-018-3878-0>. To
-    learn more about ForestGEO visit <http://www.forestgeo.si.edu/>.
+    learn more about ForestGEO visit <https://forestgeo.si.edu/>.
 License: GPL-3
 URL: https://github.com/forestgeo/fgeo.analyze
 BugReports: https://github.com/forestgeo/fgeo.analyze/issues

NEWS.md

@@ -1,4 +1,4 @@
-# fgeo.analyze 1.1.13
+# fgeo.analyze (in development)
 
 * Maintenance release.
 

R/check_crucial_names.R

@@ -7,7 +7,7 @@
 #' @examples
 #' v <- c(x = 1)
 #' check_crucial_names(v, "x")
-#' 
+#'
 #' dfm <- data.frame(x = 1)
 #' check_crucial_names(dfm, "x")
 #' @family functions for developers

R/demography_ctfs.R

@@ -146,13 +146,13 @@ recruitment_ctfs <- function(census1,
   splitN <- list(prep$split1[alive1], prep$split2[alive1])
   splitN2 <- list(prep$split1[N2.inc], prep$split2[N2.inc])
 
-  fill_0    <- fill_with_classes(list(class1, class2), fill = 0)
-  fill_NA   <- fill_with_classes(list(class1, class2), fill = NA)
-  S         <- fill_0( apply_length(prep$census2$dbh[S.inc], splitS))
-  N2        <- fill_0( apply_length(prep$census2$dbh[N2.inc], splitN2))
-  timeint   <- fill_NA(apply_mean(prep$time[N2.inc], splitN2))
+  fill_0 <- fill_with_classes(list(class1, class2), fill = 0)
+  fill_NA <- fill_with_classes(list(class1, class2), fill = NA)
+  S <- fill_0(apply_length(prep$census2$dbh[S.inc], splitS))
+  N2 <- fill_0(apply_length(prep$census2$dbh[N2.inc], splitN2))
+  timeint <- fill_NA(apply_mean(prep$time[N2.inc], splitN2))
   startdate <- fill_NA(apply_mean(prep$census1$date[alive1], splitN))
-  enddate   <- fill_NA(apply_mean(prep$census2$date[N2.inc], splitN2))
+  enddate <- fill_NA(apply_mean(prep$census2$date[N2.inc], splitN2))
 
   if (equal(sum(N2), 0)) {
     nms <- c("N2", "R", "rate", "lower", "upper", "time", "date1", "date2")
@@ -170,12 +170,12 @@ recruitment_ctfs <- function(census1,
   upper.rate[lower.ci == 0] <- Inf
   rec.rate[N2 == 0] <- lower.rate[N2 == 0] <- upper.rate[N2 == 0] <- NA
   result <- list(
-    N2    = drp(N2),
-    R     = drp(N2 - S),
-    rate  = drp(rec.rate),
+    N2 = drp(N2),
+    R = drp(N2 - S),
+    rate = drp(rec.rate),
     lower = drp(lower.rate),
     upper = drp(upper.rate),
-    time  = drp(timeint),
+    time = drp(timeint),
     date1 = drp(startdate),
     date2 = drp(enddate)
   )
@@ -209,14 +209,14 @@ mortality_ctfs <- function(census1,
   splitN <- list(prep$split1[alive1], prep$split2[alive1])
   splitS <- list(prep$split1[alive1 & alive2], prep$split2[alive1 & alive2])
 
-  fill_0    <- fill_with_classes(list(class1, class2), fill = 0)
-  fill_NA   <- fill_with_classes(list(class1, class2), fill = NA)
-  N         <- fill_0(apply_length(prep$census1$dbh[alive1], splitN))
-  S         <- fill_0(apply_length(prep$census1$dbh[alive1 & alive2], splitS))
-  meantime  <- fill_NA(apply_mean(prep$time[alive1], splitN))
-  meandbh   <- fill_NA(apply_mean(prep$census1$dbh[alive1], splitN))
+  fill_0 <- fill_with_classes(list(class1, class2), fill = 0)
+  fill_NA <- fill_with_classes(list(class1, class2), fill = NA)
+  N <- fill_0(apply_length(prep$census1$dbh[alive1], splitN))
+  S <- fill_0(apply_length(prep$census1$dbh[alive1 & alive2], splitS))
+  meantime <- fill_NA(apply_mean(prep$time[alive1], splitN))
+  meandbh <- fill_NA(apply_mean(prep$census1$dbh[alive1], splitN))
   startdate <- fill_NA(apply_mean(prep$census1$date[alive1], splitN))
-  enddate   <- fill_NA(apply_mean(prep$census2$date[alive1], splitN))
+  enddate <- fill_NA(apply_mean(prep$census2$date[alive1], splitN))
 
   if (equal(sum(N), 0)) {
     message(
@@ -233,14 +233,14 @@ mortality_ctfs <- function(census1,
     N = as.matrix(N), S = as.matrix(S), meantime = as.matrix(meantime)
   )
   result <- list(
-    N       = drp(m$N),
-    D       = drp(m$D),
-    rate    = drp(m$rate),
-    lower   = drp(m$lowerCI),
-    upper   = drp(m$upperCI),
-    time    = drp(m$time),
-    date1   = drp(startdate),
-    date2   = drp(enddate),
+    N = drp(m$N),
+    D = drp(m$D),
+    rate = drp(m$rate),
+    lower = drp(m$lowerCI),
+    upper = drp(m$upperCI),
+    time = drp(m$time),
+    date1 = drp(startdate),
+    date2 = drp(enddate),
     dbhmean = drp(meandbh)
   )
   new_demography_ctfs(result, split2)
@@ -334,15 +334,15 @@ growth_ctfs <- function(census1,
   class2 <- sort(unique(prep$split2))
   splitgood <- list(prep$split1[good], prep$split2[good])
 
-  fill_0    <- fill_with_classes(list(class1, class2), fill = 0)
-  fill_NA   <- fill_with_classes(list(class1, class2), fill = NA)
-  N         <- fill_0( apply_length(growthrate[good], splitgood))
+  fill_0 <- fill_with_classes(list(class1, class2), fill = 0)
+  fill_NA <- fill_with_classes(list(class1, class2), fill = NA)
+  N <- fill_0(apply_length(growthrate[good], splitgood))
   mean.grow <- fill_NA(apply_mean(growthrate[good], splitgood))
-  sd.grow   <- fill_NA(apply_sd(growthrate[good], splitgood))
-  meandbh   <- fill_NA(apply_mean(prep$census1$dbh[good], splitgood))
-  interval  <- fill_NA(apply_mean(time[good], splitgood))
+  sd.grow <- fill_NA(apply_sd(growthrate[good], splitgood))
+  meandbh <- fill_NA(apply_mean(prep$census1$dbh[good], splitgood))
+  interval <- fill_NA(apply_mean(time[good], splitgood))
   startdate <- fill_NA(apply_mean(prep$census1$date[good], splitgood))
-  enddate   <- fill_NA(apply_mean(prep$census2$date[good], splitgood))
+  enddate <- fill_NA(apply_mean(prep$census2$date[good], splitgood))
 
   ci.grow <- sd.grow
   ci.grow[N == 0] <- NA
@@ -605,8 +605,8 @@ fill_with_classes <- function(classes, fill) {
   }
 }
 
-apply_mean   <- function(X, INDEX) tapply(X, INDEX, FUN = mean, na.rm = TRUE)
-apply_sd     <- function(X, INDEX) tapply(X, INDEX, FUN = sd,   na.rm = TRUE)
+apply_mean <- function(X, INDEX) tapply(X, INDEX, FUN = mean, na.rm = TRUE)
+apply_sd <- function(X, INDEX) tapply(X, INDEX, FUN = sd, na.rm = TRUE)
 apply_length <- function(X, INDEX) tapply(X, INDEX, FUN = length)
 
 #' @author Richard Condit, Suzanne Lao.

R/fgeo_topography.R

@@ -135,7 +135,8 @@ allquadratslopes <- function(elev, gridsize, plotdim, edgecorrect = TRUE) {
   elevmat <- matrix(elevdata$elev, nrow = rows, ncol = columns, byrow = F)
   meanelev <- convex <- slope <- numeric()
   corner <- numeric()
-  for (c in 1:(columns - 1)) for (r in 1:(rows - 1)) {
+  for (c in 1:(columns - 1)) {
+    for (r in 1:(rows - 1)) {
       quad_idx <- fgeo.tool::rowcol_to_index(
         r, c,
         gridsize = gridsize, plotdim = plotdim
@@ -150,6 +151,7 @@ allquadratslopes <- function(elev, gridsize, plotdim, edgecorrect = TRUE) {
         message("Finding elevation and slope of quadrat ", quad_idx, "\n")
       }
     }
+  }
 
   for (i in 1:totalquads) {
     neighbor.quads <- findborderquads(
@@ -169,7 +171,8 @@ allquadratslopes <- function(elev, gridsize, plotdim, edgecorrect = TRUE) {
   # to do.
 
   if (edgecorrect) {
-    for (c in 1:(columns - 1)) for (r in 1:(rows - 1)) {
+    for (c in 1:(columns - 1)) {
+      for (r in 1:(rows - 1)) {
         first_or_prevlast_col <- (c == 1) || (c == (columns - 1))
         first_or_prevlast_row <- (r == 1) || (r == (rows - 1))
         if (first_or_prevlast_col || first_or_prevlast_row) {
@@ -190,6 +193,7 @@ allquadratslopes <- function(elev, gridsize, plotdim, edgecorrect = TRUE) {
           convex[quad_idx] <- midelev - meanelev[quad_idx]
         }
       }
+    }
   }
 
   data.frame(meanelev = meanelev, convex = convex, slope = slope)
@@ -219,8 +223,10 @@ findborderquads <- function(index, dist, gridsize, plotdim) {
   maxrow <- plotdim[2] / gridsize
   maxcol <- plotdim[1] / gridsize
   layers <- floor(dist / gridsize)
-  for (i in (row - layers):(row + layers)) for (j in (col -
-      layers):(col + layers)) if (i != row | j != col) {
+  for (i in (row - layers):(row + layers)) {
+    for (j in (col -
+      layers):(col + layers)) {
+      if (i != row | j != col) {
         if (i >= 1 & i <= maxrow & j >= 1 & j <= maxcol) {
           no.boundaries <- no.boundaries + 1
           bound.index[no.boundaries] <- fgeo.tool::rowcol_to_index(
@@ -229,6 +235,8 @@ findborderquads <- function(index, dist, gridsize, plotdim) {
           )
         }
       }
+    }
+  }
   return(bound.index[bound.index > 0])
 }
 

R/summary.R

@@ -35,12 +35,12 @@ summary.tt_df <- function(object, ...) {
     object,
     # Short alias to fit in screen-width
     obs = .data$Obs.Quantile,
-    association =   dplyr::case_when(
-      (.data$obs - 1) ==  1 & (1 - (.data$obs)) <  0.05 ~ "aggregated",
-      (.data$obs - 1) ==  1 & (1 - (.data$obs)) >= 0.05 ~ "agg_nonsignificant",
-      (.data$obs - 1) == -1 &      (.data$obs)  <  0.05 ~ "repelled",
-      (.data$obs - 1) == -1 &      (.data$obs)  >= 0.05 ~ "rep_nonsignificant",
-      TRUE                                              ~ "neutral"
+    association = dplyr::case_when(
+      (.data$obs - 1) == 1 & (1 - (.data$obs)) < 0.05 ~ "aggregated",
+      (.data$obs - 1) == 1 & (1 - (.data$obs)) >= 0.05 ~ "agg_nonsignificant",
+      (.data$obs - 1) == -1 & (.data$obs) < 0.05 ~ "repelled",
+      (.data$obs - 1) == -1 & (.data$obs) >= 0.05 ~ "rep_nonsignificant",
+      TRUE ~ "neutral"
     )
   )
 

R/tt_test.R

@@ -381,9 +381,9 @@ rename_to_xy <- function(x) {
 
 check_tt_test <- function(census, habitat, sp, plotdim, gridsize) {
   tree_names <- c(
-  "treeID", "stemID", "tag", "StemTag", "sp", "quadrat", "gx", "gy",
-  "MeasureID", "CensusID", "dbh", "pom", "hom", "ExactDate", "DFstatus",
-  "codes", "nostems", "status", "date"
+    "treeID", "stemID", "tag", "StemTag", "sp", "quadrat", "gx", "gy",
+    "MeasureID", "CensusID", "dbh", "pom", "hom", "ExactDate", "DFstatus",
+    "codes", "nostems", "status", "date"
   )
   has_stem_names <- !all(names(census) %in% tree_names)
 

R/utils.R

@@ -18,7 +18,9 @@ round_any <- function(x, accuracy, f = round) {
 # * r-lib/rlang/blob/cd272fdea1d84c596ba63e05c8f79645bbf03767/R/cnd.R#L936
 warn_once_env <- new.env(parent = emptyenv())
 warn_once <- function(msg) {
-  if (exists(msg, warn_once_env)) return(invisible())
+  if (exists(msg, warn_once_env)) {
+    return(invisible())
+  }
   warning(
     paste0(msg, "\nThis warning is displayed once per session."),
     call. = FALSE
@@ -32,7 +34,9 @@ forget_warn_once <- function() {
 
 inform_once_env <- new.env(parent = emptyenv())
 inform_once <- function(msg) {
-  if (exists(msg, inform_once_env)) return(invisible())
+  if (exists(msg, inform_once_env)) {
+    return(invisible())
+  }
   message(paste0(msg, "\nThis message is displayed once per session."))
   inform_once_env[[msg]] <- TRUE
   invisible()

README.Rmd

@@ -17,12 +17,12 @@ options(fgeo.quiet = TRUE)
 
 <!-- badges: start -->
 [![lifecycle](https://img.shields.io/badge/lifecycle-maturing-blue.svg)](https://www.tidyverse.org/lifecycle/#maturing)
-[![Coverage status](https://coveralls.io/repos/github/forestgeo/fgeo.analyze/badge.svg)](https://coveralls.io/r/forestgeo/fgeo.analyze?branch=master)
 [![CRAN status](https://www.r-pkg.org/badges/version/fgeo.analyze)](https://cran.r-project.org/package=fgeo.analyze)
 [![R-CMD-check](https://github.com/forestgeo/fgeo.analyze/workflows/R-CMD-check/badge.svg)](https://github.com/forestgeo/fgeo.analyze/actions)
+[![Codecov test coverage](https://codecov.io/gh/forestgeo/fgeo.analyze/branch/master/graph/badge.svg)](https://codecov.io/gh/forestgeo/fgeo.analyze?branch=master)
 <!-- badges: end -->
 
-__fgeo.analyze__ provides functions to analyze [ForestGEO](http://www.forestgeo.si.edu/) data.
+__fgeo.analyze__ provides functions to analyze ForestGEO data.
 
 ## Installation
 
@@ -284,7 +284,7 @@ as_tibble(tt_test_result)
 summary(tt_test_result)
 ```
 
-[Get started with __fgeo__](https://forestgeo.github.io/fgeo)
+[Get started with __fgeo__](https://forestgeo.github.io/fgeo/)
 
 ## Information