Merge pull request #152 from brews/master

close #146, close #150, close #149, fix citations

DESCRIPTION

@@ -2,9 +2,9 @@ Package: burnr
 Title: Fire-History Analysis in R
 Version: 0.4.0.9000
 Authors@R: c(
-  person("Steven", "Malevich", email = "malevich@email.arizona.edu", role = c("aut", "cre")),
-  person("Christopher", "Guiterman", role = c("ctb")),
-  person("Ellis", "Margolis", role = c("ctb")))
+  person("Steven", "Malevich", email = "sbmalev@gmail.com", role = c("aut", "cre"), comment = c(ORCID = "0000-0002-4752-8190")),
+  person("Christopher", "Guiterman", role = c("ctb"), comment = c(ORCID = "0000-0002-9706-9332")),
+  person("Ellis", "Margolis", role = c("ctb"), comment = c(ORCID = "0000-0002-0595-9005")))
 Description: Basic tools to analyze forest fire history data (e.g. FHX) in R.
 URL: https://github.com/ltrr-arizona-edu/burnr/
 BugReports: https://github.com/ltrr-arizona-edu/burnr/issues

NAMESPACE

@@ -14,6 +14,7 @@ S3method(quantile,intervals)
 S3method(sort,fhx)
 S3method(summary,fhx)
 export(as.fhx)
+export(as_fhx)
 export(composite)
 export(count_event_position)
 export(count_injury)
@@ -31,6 +32,9 @@ export(intervals)
 export(is.fhx)
 export(is.intervals)
 export(is.sea)
+export(is_fhx)
+export(is_intervals)
+export(is_sea)
 export(last_year)
 export(make_rec_type)
 export(outer_type)

NEWS.md

@@ -2,21 +2,25 @@
 
 Changes in this release:
 
-* Added `as.fhx()`. This takes data frames, tibbles, and lists as input. It assumes they have "year", "series", and "rec_type" elements/columns. It returns an `fhx` object. This makes life easier for people who work with the tidyverse. It helps make life easier for users who want to work with thier own non-FHX fire-history file formats. (Issue #120)
+* Added `as_fhx()`. This takes data frames, tibbles, and lists as input. It assumes they have "year", "series", and "rec_type" elements/columns. It returns an `fhx` object. This makes life easier for people who work with the tidyverse. It helps make life easier for users who want to work with thier own non-FHX fire-history file formats (Issue #120). The `fhx()` constructor now also uses type casting for input so that should make life easier (Issue #150).
 
 * Extensive improvement to documentation (e.g. Issue #145). This includes new "See Also" sections so users can find cool functions, fixes for spelling errors, and clarifications to dyslexic prose.
 
+* `write_fhx()` will now throw a warning if users try to write an `fhx` object that has records types that violate the FHX2 file standard (Issue #149). I strongly recommend using `write.csv(...)` on `fhx` objects and `as.fhx(read.csv(...))` for IO with experimental `fhx` data.
+
 * Removed deprecated `run_sea()`. Be sure to use `sea()` now.
 
 * Removed deprecated `get_ggplot()`. Please use `plot_demograph()` now.
 
-* Removed broken `site_stats()` function (Issue #138). Please use `intervals()` and `print()` to get the same statistics. 
+* Removed broken `site_stats()` function (Issue #138). Please use `intervals()` and `print()` to get the same statistics.
 
 * `composite()` now returns an empty fhx object if no composite-worthy events are found (Issue #131). Much better than throwing an obtuse error.
 
+* Updated in-package citation information (`citation("burnr")`). Please cite burnr if you use it in your work!
+
 * Added unit tests for basic plotting function options.
 
-* Minor internal code cleanup (Issue #130, Issue #88, Issue #133, Issue #136, Issue #88) and code linting.
+* Minor internal code cleanup (Issue #130, Issue #88, Issue #133, Issue #136, Issue #88, Issue #146) and code linting.
 
 
 # burnr v0.4.0

R/intervals.R

@@ -44,7 +44,7 @@
 #'
 #' @export
 intervals <- function(comp, densfun = "weibull") {
-  stopifnot(is.fhx(comp))
+  stopifnot(is_fhx(comp))
   stopifnot(densfun %in% c("weibull", "lognormal"))
   if (length(series_names(comp)) > 1) {
     stop("Found multiple series in `comp`. There can only be one.")
@@ -79,7 +79,15 @@ intervals <- function(comp, densfun = "weibull") {
 #'
 #' @seealso [intervals()] creates an `intervals` object.
 #' @export
-is.intervals <- function(x) inherits(x, "intervals")
+is_intervals <- function(x) inherits(x, "intervals")
+
+
+#' Alias to [is_intervals()]
+#'
+#' @inherit is_intervals
+#'
+#' @export
+is.intervals <- function(x) is_intervals(x)
 
 
 #' Fire `intervals` arithmetic mean

R/io.R

@@ -11,7 +11,7 @@
 #' @seealso
 #'   * [write_fhx()] write an `fhx` object to a file.
 #'   * [fhx()] create an `fhx` object.
-#'   * [as.fhx()] cast data frame or similar object to an `fhx` object.
+#'   * [as_fhx()] cast data frame or similar object to an `fhx` object.
 #'
 #' @examples
 #' \dontrun{
@@ -147,7 +147,7 @@ read_fhx <- function(fname, encoding, text) {
 #'
 #' @noRd
 list_filestrings <- function(x) {
-  stopifnot(is.fhx(x))
+  stopifnot(is_fhx(x))
   out <- x
   out$rec_type <- vapply(out$rec_type, rec_type2abrv, "") # nolint
   year_range <- seq(min(out$year), max(out$year))
@@ -204,6 +204,12 @@ write_fhx <- function(x, fname = "") {
     stop("Please specify a character string naming a file or connection open
           for writing.")
   }
+  if (violates_canon(x)) {
+    warning(
+      "`write_fhx()` run on `fhx` object with rec_types that violate FHX2", 
+      " canon - other software may not be able to read the output FHX file"
+    )
+  }
   d <- list_filestrings(x)
   fl <- file(fname, open = "wt")
   cat(paste(d[["head_line"]], "\n", d[["subhead_line"]], "\n", sep = ""),

R/plotting.R

@@ -97,7 +97,7 @@ plot_demograph <- function(x, color_group, color_id, facet_group, facet_id,
   # TODO: Merge ends and events into a single df. with a factor to handle the
   #       different event types... this will allow us to put these "fire events"
   #       and "pith/bark" into a legend.
-  stopifnot(is.fhx(x))
+  stopifnot(is_fhx(x))
   if (composite_rug & !missing("facet_group")) {
     stop("Cannot have composite rug and facet in same plot")
   }

R/sea.R

@@ -94,7 +94,7 @@
 #' @export
 sea <- function(x, event, nbefore = 6, nafter = 4, event_range = TRUE,
                 n_iter = 1000) {
-  if (is.fhx(event)) {
+  if (is_fhx(event)) {
     if (length(unique(event$series)) > 1) {
       stop("event must have a single series")
     } else {
@@ -287,7 +287,15 @@ sea <- function(x, event, nbefore = 6, nafter = 4, event_range = TRUE,
 #' @seealso [sea()] creates a `sea` object.
 #'
 #' @export
-is.sea <- function(x) inherits(x, "sea")
+is_sea <- function(x) inherits(x, "sea")
+
+
+#' Alias to [is_sea()]
+#'
+#' @inherit is_sea
+#'
+#' @export
+is.sea <- function(x) is_sea(x)
 
 
 #' Plot a `sea` object

R/stats.R

@@ -9,7 +9,7 @@
 #'
 #' @seealso
 #'   * [fhx()] creates an `fhx` object.
-#'   * [as.fhx()] casts data frame into an `fhx` object.
+#'   * [as_fhx()] casts data frame into an `fhx` object.
 #'   * [first_year()] gets earliest year in an `fhx` object.
 #'   * [last_year()] gets latest year in an `fhx` object.
 #'   * [count_year_span()] counts the year span of an `fhx` object.
@@ -48,7 +48,7 @@ series_stats <- function(x, func_list = list(
                            recording_years = count_recording,
                            mean_interval = series_mean_interval
                          )) {
-  stopifnot(is.fhx(x))
+  stopifnot(is_fhx(x))
   plyr::ddply(x, c("series"),
     function(df) data.frame(lapply(func_list, function(f) f(df)))
   )
@@ -233,7 +233,7 @@ series_mean_interval <- function(x, injury_event = FALSE) {
 #'
 #' @export
 sample_depth <- function(x) {
-  if (!is.fhx(x)) stop("x must be an fhx object")
+  if (!is_fhx(x)) stop("x must be an fhx object")
   x_stats <- series_stats(x)
   n_trees <- nrow(x_stats)
   out <- data.frame(year = min(x_stats$first):max(x_stats$last))