Merge 54c71fa into 177c7a9

NAMESPACE

@@ -44,7 +44,6 @@ export(sea)
 export(series_mean_interval)
 export(series_names)
 export(series_stats)
-export(site_stats)
 export(write_fhx)
 export(year_range)
 export(yearly_recording)

NEWS.md

@@ -6,7 +6,9 @@ Changes in this release:
 
 * Removed deprecated `run_sea()`. Be sure to use `sea()` now.
 
-* Removed deprecated `get_ggplot()`, please use `plot_demograph()` 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. 
 
 * `composite()` now returns an empty fhx object if no composite-worthy events are found (Issue #131). Much better than throwing an obtuse error.
 

R/intervals.R

@@ -68,7 +68,7 @@ mean.intervals <- function(x, ...) {
 #' Interval median.
 #'
 #' @param x An intervals object.
-#' @param ... Additional arguments passed to \code{median}.
+#' @param ... Additional arguments passed to \code{stats::median}.
 #'
 #' @return Numeric or NA.
 #'
@@ -78,7 +78,6 @@ median.intervals <- function(x, ...) {
   median(x$intervals, ...)
 }
 
-
 #' Minimum interval.
 #'
 #' @param x An intervals object.

R/stats.R

@@ -186,81 +186,6 @@ summary.fhx <- function(object, ...) {
   out
 }
 
-#' Generate site-level summary statistics
-#'
-#' @param x An fhx object
-#' @param site_name Three character site code, defaults to "XXX"
-#' @param year_range Delimits the analysis period. For example, \code{c(1600, 1900)}.
-#' @param filter_prop An optional argument if the user chooses to include a composite rug in their plot. This is passed to \code{composite}. See this function for details.
-#' @param filter_min_rec An optional argument if the user chooses to include a composite rug in their plot. This is passed to \code{composite}. See this function for details.
-#' @param filter_min_events An optional argument if the user chooses to include a composite rug in their plot. This is passed to \code{composite}. See this function for details.
-#' @param injury_event Boolean indicating whether injuries should be considered recorders. This is passed to \code{composite}. See this function for details.
-#'
-#' @details This function produces a summary table for any fhx object. The statistics it includes are shared by other popular fire history software such as FHX2 and FHAES.
-#' @return A data.frame of summary statistics
-#' @export
-
-site_stats <- function(x, site_name = 'XXX', year_range = NULL, filter_prop = 0.25, filter_min_rec = 2,
-                        filter_min_events = 1, injury_event = FALSE) {
-
-  stopifnot(is.fhx(x))
-  sumNames <- c('number_series', 'first_year', 'last_year', 'first_event', 'last_event',
-                'number_intervals', 'mean_interval', 'median_interval',
-                'standard_dev', 'coef_var', 'min_interval', 'max_interval',
-                'weibull_shape', 'weibull_scale', 'weibull_mean',
-                'weibull_median', 'weibull_mode', 'KS_d', 'pval', 'lower_exceedance',
-                'upper_exceedance')
-  site.stats <- data.frame(variable = sumNames, site = NA)
-  names(site.stats)[2] <- site_name
-  # Perform site composite for interval stats
-  if (!is.null(year_range)) {
-    x <- x[x$year >= min(year_range) & x$year <= max(year_range), ]
-  }
-  x.comp <- composite(x, filter_prop = filter_prop, filter_min_rec = filter_min_rec,
-                          filter_min_events = filter_min_events, injury_event = injury_event)
-  intervals <- diff(get_event_years(x.comp)[[1]])
-  if(length(intervals) < 2)
-    stop("Too few fire intervals to compute a summary")
-  # Weibull fit
-  ft.r <- MASS::fitdistr(intervals, "weibull")
-  shape <- as.numeric(ft.r$estimate[1])
-  scale <- as.numeric(ft.r$estimate[2])
-  weib.quants <- stats::qweibull(c(.125, .5, .875), shape=shape, scale=scale)
-  # gf <- suppressWarnings( stats::ks.test(intervals, y=stats::pweibull, shape=shape, scale=scale, alternative='less'))
-  gf <- stats::ks.test(intervals, y=stats::pweibull, shape=shape, scale=scale, alternative='less')
-  # Fill out summary table
-  site.stats['number_trees', ] <- length(levels(x$series))
-  site.stats['first_year', ] <- first_year(x)
-  site.stats['last_year', ] <- last_year(x)
-  if (injury_event == FALSE) {
-    site.stats['first_event', ] <- min(x[grep('fs', x$rec_type), ]$year)
-    site.stats['last_event', ] <- max(x[grep('fs', x$rec_type), ]$year)
-  }
-  else {
-    site.stats['first_event', ] <- min(min(x[grep('fs', x$rec_type), ]$year),
-                                       min(x[grep('fi', x$rec_type), ]$year))
-    site.stats['last_event', ] <- max(max(x[grep('fs', x$rec_type), ]$year),
-                                      max(x[grep('fi', x$rec_type), ]$year))
-  }
-  site.stats['number_intervals', ] <- length(intervals)
-  site.stats['mean_interval', ] <- round(mean(intervals), 1)
-  site.stats['median_interval', ] <- round(stats::median(intervals), 1)
-  site.stats['standard_dev', ] <- round(stats::sd(intervals), 2)
-  site.stats['coef_var', ] <- round(stats::sd(intervals)/mean(intervals), 2)
-  site.stats['min_interval', ] <- min(intervals)
-  site.stats['max_interval', ] <- max(intervals)
-  site.stats['weibull_shape', ] <- round(shape, 2)
-  site.stats['weibull_scale', ] <- round(scale, 2)
-  site.stats['weibull_mean', ] <- round(scale * gamma(1 + 1/shape), 2)
-  site.stats['weibull_median', ] <- round(weib.quants[2], 2)
-  site.stats['weibull_mode', ] <- round(scale * ((shape-1)/shape)^(1/shape), 2)
-  site.stats['KS_d', ] <- round(gf$statistic, 2)
-  site.stats['pval', ] <- round(gf$p.value, 2)
-  site.stats['lower_exceedance', ] <- round(weib.quants[1], 2)
-  site.stats['upper_exceedance', ] <- round(weib.quants[3], 2)
-  return(site.stats)
-}
-
 #' Percent scarred time series
 #'
 #' @param x An fhx object.