#····································································
# npsp-rules.R (library(npsp))
#····································································
# rule
# rule.binning S3 methods
# rule.binning.default
#
#····································································
# npsp es un software libre y viene sin GARANTIA ALGUNA.
# Usted puede redistribuirlo bajo ciertas circunstancias.
# Escriba 'license()' para detalles de distribucion.
#
# (c) R. Fernandez-Casal
# Creation: Jul 2015
#
# NOTE: Press Ctrl + Shift + O to show document outline in RStudio
#····································································
#····································································
#' npsp Rules
#'
#' Compute the number of classes for a histogram,
#' the number of nodes of a binning grid, etc.
#' @param x data vector or object used to select a method.
#' @param d (spatial) dimension.
#' @param rule character; rule to be used.
#' @param ... further arguments passed to or from other methods.
#' @details
#' The Rice Rule, \eqn{m = \lceil 2 n^{1/3} \rceil,}
#' is a simple alternative to Sturges's rule (\code{\link{nclass.Sturges}}).
#' @seealso
#' \code{\link{hist}}, \code{\link{nclass.Sturges}}, \code{\link{nclass.scott}},
#' \code{\link{nclass.FD}},
# \code{\link{np.svariso}}, \code{\link{svar.bin}},
#' \code{\link{binning}}, \code{\link{np.den}}, \code{\link{bin.den}}.
#' @return
#' The rule values (vector or scalar).
#' @importFrom grDevices nclass.FD nclass.Sturges nclass.scott
#' @export
#····································································
rule <- function(x, d = 1, rule = c("Rice", "Sturges", "scott", "FD"), ...){
rule <- match.arg(rule)
res <- switch(rule,
Rice = .rice.rule(x, ...),
Sturges = nclass.Sturges(x),
scott = nclass.scott(x),
FD = nclass.FD(x) )
return(res ^(1/d))
}
#····································································
#' @rdname npsp-internals
#' @param a scale values.
#' @param b exponent values.
#' @keywords internal
# @export
#····································································
.rice.rule <- function(x, a = 2, b = 3, ...) {
ceiling(a * x ^ (1 / b))
}
# PENDENTE:
# ["https://en.wikipedia.org/wiki/Histogram#Mathematical_definition"]
# nb <- round(log(ny)/log(2) + 1) # ter en conta o num de dimensions?
# <- round(log(xxx)/log(2) + 1) # <- round((log(xxx)/log(1.1) + 1)^(1/2))^2
# Regla de Sturges k=1+log2(n)
# Regla de Scott K=(2n)^(1/3)
# (4*n)^(2/5)
#····································································
#' @rdname rule
# @param x object used to select a method.
# @param ... further arguments passed to or from other methods.
#' @return
#' \code{rule.binning} returns a vector with the suggested number of bins
#' on each dimension.
#' @export
#····································································
rule.binning <- function(x, ...) {
UseMethod("rule.binning")
}
#····································································
#' @rdname rule
#' @method rule.binning default
#' @param a scale values.
#' @param b exponent values.
#' @export
#' @return
#' \code{rule.binning.default} returns \code{rep(ceiling(a * nrow(x) ^ (1 / b)), d)}.
#····································································
rule.binning.default <- function(x, d = ncol(x), a = 2, b = d + 1, ...) {
x <- as.matrix(x)
ny <- nrow(x)
if (!missing(d)) d <- as.integer(d)
# return( rep( round(rule(ny, rule = "Rice", b = b)), d) )
return( rep( .rice.rule(ny, a = a, b = b), d) )
}
#····································································
#' @rdname rule
# @param x object used to select a method.
# @param ... further arguments passed to or from other methods.
#' @return
#' \code{rule.svar} returns the suggested number of bins
#' for variogram estimation.
#' @export
#····································································
rule.svar <- function(x, ...) {
UseMethod("rule.svar")
}
#····································································
#' @rdname rule
#' @method rule.svar default
#' @return
#' \code{rule.svar.default} returns \code{ceiling(a * (nrow(x)^2 / 4) ^ (1 / b))}.
#' @export
#····································································
rule.svar.default <- function(x, d = ncol(x), a = 2, b = d + 1, ...) {
x <- as.matrix(x)
ny <- nrow(x)
if (!missing(d)) d <- as.integer(d)
return( .rice.rule(ny^2/4, a = a, b = b))
}
#····································································
#' @rdname rule
#' @method rule.svar bin.den
#' @export
#····································································
rule.svar.bin.den <- function(x, ...) {
# nlags <- round(2 * mean(dim(x)))
# maxlag <- with(x$grid, 0.45*sqrt(sum(max - min)^2)) # 45% of largest lag
# h <- 2*maxlag/nlags
# return( list(nlags = nlags, maxlag = maxlag, h = h, dk = dk ))
return(round(2 * mean(dim(x))))
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.