R/circdensity.R

In spatstat.explore: Exploratory Data Analysis for the 'spatstat' Family

#'
#'   circdensity.R
#'
#' Kernel smoothing for circular data
#'
#'   $Revision: 1.10 $ $Date: 2026/05/02 04:51:09 $

circdensity <- function(x, sigma="nrd0", ..., bw=NULL,
                        weights=NULL,
                        unit=c("degree", "radian", "hour", "minute", "other"),
                        fullcircle=NULL) {
  xname <- short.deparse(substitute(x))
  missu <- missing(unit)
  if(missing(sigma) && !is.null(bw))
    sigma <- bw
  unit <- match.arg(unit)
  unit <- resolve.angular.unit(x, unit, fullcircle=fullcircle, guess=missu)
  fullcircle <- resolve.rose.args(unit, fullcircle)$fullcircle
  if(is.character(sigma)) {
    sigma <- switch(sigma,
                     bcv  = bw.bcv,
                     nrd  = bw.nrd,
                     nrd0 = bw.nrd0,
                     SJ   = bw.SJ,
                     ucv  = bw.ucv,
                     get(paste0("bw.", sigma), mode="function"))
  }
  if(is.function(sigma)) {
    sigma <- sigma(x)
    if(!(is.numeric(sigma) && length(sigma) == 1L && sigma > 0))
      stop("Bandwidth selector should return a single positive number")
  }
  check.1.real(sigma)
  #' replicate data
  x <- x %% fullcircle
  xx <- c(x - fullcircle, x, x + fullcircle)
  #' replicate weights
  if(!is.null(weights)) {
    stopifnot(length(weights) == length(x))
    weights <- rep(weights, 3)/3
  }
  #' smooth
  z <- do.call.matched(density.default,
                       resolve.defaults(list(x=quote(xx),
                                             bw=sigma,
                                             weights=weights),
                                list(...),
                                list(from=0, to=fullcircle,
                                     warnWbw=FALSE, na.rm=TRUE)))
  z$y <- 3 * z$y
  z$data.name <- xname
  z$call <- match.call()
  attr(z, "circinfo") <- list(unit=unit, fullcircle=fullcircle)
  return(z)
}