https://github.com/cran/spatstat
Revision c75a36fce807d4a1105403c1f8628a196a3e54da authored by Adrian Baddeley on 24 October 2008, 14:28:47 UTC, committed by cran-robot on 24 October 2008, 14:28:47 UTC
1 parent 52ee60a
Raw File
Tip revision: c75a36fce807d4a1105403c1f8628a196a3e54da authored by Adrian Baddeley on 24 October 2008, 14:28:47 UTC
version 1.14-5
Tip revision: c75a36f
summary.quad.R
#
# summary.quad.R
#
#  summary() method for class "quad"
#
#  $Revision: 1.6 $ $Date: 2006/03/01 08:25:01 $
#
summary.quad <- function(object, ..., checkdup=FALSE) {
  verifyclass(object, "quad")
  s <- list(
       data  = summary.ppp(object$data, checkdup=checkdup),
       dummy = summary.ppp(object$dummy, checkdup=checkdup),
       param = object$param)
  doit <- function(ww) {
    if(length(ww) > 0) 
      return(list(range=range(ww), sum=sum(ww)))
    else
      return(NULL)
  }
  w <- object$w
  Z <- is.data(object)
  s$w <- list(all=doit(w), data=doit(w[Z]), dummy=doit(w[!Z]))
  class(s) <- "summary.quad"
  return(s)
}

print.summary.quad <- function(x, ..., dp=3) {
  cat("Quadrature scheme = data + dummy + weights\n")
  pa <- x$param
  if(is.null(pa))
    cat("created by an unknown function.\n")
  cat("Data pattern:\n")
  print(x$data, dp=dp)

  cat("\n\nDummy quadrature points:\n")
  # How they were computed
  if(!is.null(pa)) {
    dumpar <- pa$dummy
    if(is.null(dumpar))
      cat("(provided manually)\n")
    else if(!is.null(dumpar$nd)) 
      cat(paste("(", dumpar$nd[1], "x", dumpar$nd[2],
                "grid, plus 4 corner points)\n"))
    else
      cat("(rule for creating dummy points not understood)")
  }
  # Description of them
  print(x$dummy, dp=dp)

  cat("\n\nQuadrature weights:\n")
  # How they were computed
  if(!is.null(pa)) {
    wpar <- pa$weight
    if(is.null(wpar))
      cat("(values provided manually)\n")
    else if(!is.null(wpar$method)) {
      if(wpar$method=="grid") {
        cat(paste("(counting weights based on",
                  wpar$ntile[1], "x", wpar$ntile[2],
                  "array of rectangular tiles)\n"))
      } else if(wpar$method=="dirichlet") {
        cat(paste("(Dirichlet tile areas, computed",
                  if(wpar$exact) "exactly" else "by pixel approximation",
                  ")\n"))
      } else
      cat("(rule for creating dummy points not understood)\n")
    }
  }
  # Description of them
  doit <- function(ww, blah) {
    cat(paste(blah, ":\n\t", sep=""))
    if(is.null(ww)) {
      cat("(None)\n")
      return()
    }
    cat(paste("range: ",
              "[",
              paste(signif(ww$range, digits=dp), collapse=", "),
              "]\t",
              "total: ",
              signif(ww$sum, digits=dp),
              "\n", sep=""))
  }
  doit(x$w$all, "All weights")
  doit(x$w$data, "Weights on data points")
  doit(x$w$dummy, "Weights on dummy points")

  return(invisible(NULL))
}

    
print.quad <- function(x, ...) {
  cat("Quadrature scheme\n")
  cat(paste(x$data$n, "data points, ", x$dummy$n, "dummy points\n"))
  cat(paste("Total weight ", sum(x$w), "\n"))
  return(invisible(NULL))
}
back to top