Running ‘testsAtoD.R’ [28s/28s]
  Running ‘testsEtoF.R’ [22s/22s]
  Running ‘testsGtoK.R’ [59s/59s]
  Running ‘testsLtoM.R’ [129s/130s]
  Running ‘testsNtoP.R’ [29s/29s]
  Running ‘testsQtoR.R’ [23s/23s]
  Running ‘testsStoZ.R’ [23s/23s]
Running the tests in ‘tests/testsEtoF.R’ failed.
Complete output:
  > #  tests/emptymarks.R
  > #
  > # test cases where there are no (rows or columns of) marks
  > #
  > #  $Revision: 1.3 $ $Date: 2015/12/29 08:54:49 $
  > 
  > require(spatstat)
  Loading required package: spatstat
  Loading required package: spatstat.data
  Loading required package: nlme
  Loading required package: rpart
  
  spatstat 1.57-1       (nickname: 'Cartoon Physics') 
  For an introduction to spatstat, type 'beginner' 
  
  > local({
  +   n <- npoints(cells)
  +   df <- data.frame(x=1:n, y=factor(sample(letters, n, replace=TRUE)))
  +   nocolumns <- c(FALSE, FALSE)
  +   norows <- rep(FALSE, n)
  +   X <- cells
  +   marks(X) <- df
  +   marks(X) <- df[,1]
  +   marks(X) <- df[,nocolumns]
  +   Z <- Y <- X[integer(0)]
  +   marks(Y) <- df[norows,]
  +   stopifnot(is.marked(Y))
  +   marks(Z) <- df[norows,nocolumns]
  +   stopifnot(!is.marked(Z))
  + })
  > #
  > #  tests/envelopes.R
  > #
  > #  Test validity of envelope data
  > #
  > #  $Revision: 1.13 $  $Date: 2018/10/31 03:52:34 $
  > #
  > 
  > require(spatstat)
  > 
  > local({
  + checktheo <- function(fit) {
  +   fitname <- deparse(substitute(fit))
  +   en <- envelope(fit, nsim=4, verbose=FALSE, nrep=1e3)
  +   nama <- names(en)
  +   expecttheo <- is.poisson(fit) && is.stationary(fit)
  +   context <- paste("Envelope of", fitname)
  +   if(expecttheo) {
  +     if(!("theo" %in% nama))
  +       stop(paste(context, "did not contain", sQuote("theo")))
  +     if("mmean" %in% nama)
  +       stop(paste(context, "unexpectedly contained", sQuote("mmean")))
  +   } else {
  +     if("theo" %in% nama)
  +       stop(paste(context, "unexpectedly contained", sQuote("theo")))
  +     if(!("mmean" %in% nama))
  +       stop(paste(context, "did not contain", sQuote("mmean")))
  +   }
  +   cat(paste(context, "has correct format\n"))
  + }
  +   
  + checktheo(ppm(cells))
  + checktheo(ppm(cells ~x))
  + checktheo(ppm(cells ~1, Strauss(0.1)))
  + 
  + # check envelope calls from 'alltypes'
  + a <- alltypes(demopat, Kcross, nsim=4, envelope=TRUE)
  + b <- alltypes(demopat, Kcross, nsim=4, envelope=TRUE, global=TRUE)
  + 
  + # check 'transform' idioms
  + A <- envelope(cells, Kest, nsim=4, transform=expression(. - .x))
  + B <- envelope(cells, Kest, nsim=4, transform=expression(sqrt(./pi) - .x))
  + 
  + #' check savefuns/savepatterns with global 
  + fit <- ppm(cells~x)
  + Ef <- envelope(fit, Kest, nsim=4, savefuns=TRUE, global=TRUE)
  + Ep <- envelope(fit, Kest, nsim=4, savepatterns=TRUE, global=TRUE)
  + 
  + #' check handling of 'dangerous' cases
  + fut <- ppm(redwood ~ x)
  + Ek <- envelope(fut, Kinhom, update=FALSE, nsim=4)
  + 
  + # check conditional simulation
  + e1 <- envelope(cells, Kest, nsim=4, fix.n=TRUE)
  + e2 <- envelope(amacrine, Kest, nsim=4, fix.n=TRUE)
  + e3 <- envelope(amacrine, Kcross, nsim=4, fix.marks=TRUE)
  + e4 <- envelope(finpines, Kest, nsim=4, fix.n=TRUE) # multiple columns of marks
  + e5 <- envelope(finpines, Kest, nsim=4, fix.marks=TRUE)
  + fit <- ppm(japanesepines ~ 1, Strauss(0.04))
  + e6 <- envelope(fit, Kest, nsim=4, fix.n=TRUE)
  + fit2 <- ppm(amacrine ~ 1, Strauss(0.03))
  + e7 <- envelope(fit2, Gcross, nsim=4, fix.marks=TRUE)
  + 
  + # check pooling of envelopes in global case
  + E1 <- envelope(cells, Kest, nsim=5, savefuns=TRUE, global=TRUE)
  + E2 <- envelope(cells, Kest, nsim=12, savefuns=TRUE, global=TRUE)
  + p12 <- pool(E1, E2)
  + p12 <- pool(E1, E2, savefuns=TRUE)
  + F1 <- envelope(cells, Kest, nsim=5,
  +                savefuns=TRUE, savepatterns=TRUE, global=TRUE)
  + F2 <- envelope(cells, Kest, nsim=12,
  +                savefuns=TRUE, savepatterns=TRUE, global=TRUE)
  + p12 <- pool(F1, F2)
  + p12 <- pool(F1, F2, savefuns=TRUE, savepatterns=TRUE)
  + E1r <- envelope(cells, Kest, nsim=5, savefuns=TRUE, global=TRUE,
  +                 ginterval=c(0.05, 0.15))
  + E2r <- envelope(cells, Kest, nsim=12, savefuns=TRUE, global=TRUE,
  +                 ginterval=c(0.05, 0.15))
  + p12r <- pool(E1r, E2r)
  + })
  Envelope of ppm(cells) has correct format
  Envelope of ppm(cells ~ x) has correct format
  Envelope of ppm(cells ~ 1, Strauss(0.1)) has correct format
  Generating 4 simulations of CSR  ...
  1, 2, 3,  4.
  
  Done.
  Generating 4 simulations of CSR  ...
  1, 2, 3,  4.
  
  Done.
  Generating 8 simulated realisations of fitted Poisson model (4 to estimate the 
  mean and 4 to calculate envelopes) ...
  1, 2, 3, 4, 5, 6, 7,  8.
  
  Done.
  Generating 8 simulated realisations of fitted Poisson model (4 to estimate the 
  mean and 4 to calculate envelopes) ...
  1, 2, 3, 4, 5, 6, 7,  8.
  
  Done.
  Generating 4 simulated realisations of fitted Poisson model  ...
  1, 2, 3,  4.
  
  Done.
  Generating 4 simulations of CSR with fixed number of points  ...
  1, 2, 3,  4.
  
  Done.
  Generating 4 simulations of CSR with fixed number of points  ...
  1, 2, 3,  4.
  
  Done.
  Generating 4 simulations of CSR with fixed number of points of each type  ...
  1, 2, 3,  4.
  
  Done.
  Generating 4 simulations of CSR with fixed number of points  ...
  1, 2, 3,  4.
  
  Done.
  Generating 4 simulations of CSR with fixed number of points and fixed marks  
  ...
  1, 2, 3,  4.
  
  Done.
  Generating 4 simulated realisations of fitted Gibbs model with fixed number of 
  points  ...
  1, 2, 3,  4.
  
  Done.
  Generating 4 simulated realisations of fitted Gibbs model with fixed number of 
  points of each type  ...
  1, 2, 3,  4.
  
  Done.
  Generating 5 simulations of CSR  ...
  1, 2, 3, 4,  5.
  
  Done.
  Generating 12 simulations of CSR  ...
  1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11,  12.
  
  Done.
  Generating 5 simulations of CSR  ...
  1, 2, 3, 4,  5.
  
  Done.
  Generating 12 simulations of CSR  ...
  1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11,  12.
  
  Done.
  Generating 5 simulations of CSR  ...
  1, 2, 3, 4,  5.
  
  Done.
  Generating 12 simulations of CSR  ...
  1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11,  12.
  
  Done.
  > 
  > local({
  +   #' as.data.frame.envelope
  +   Nsim <- 5
  +   E <- envelope(cells, nsim=Nsim, savefuns=TRUE)
  +   A <- as.data.frame(E)
  +   B <- as.data.frame(E, simfuns=TRUE)
  +   stopifnot(ncol(B) - ncol(A) == Nsim)
  + })
  Generating 5 simulations of CSR  ...
  1, 2, 3, 4,  5.
  
  Done.
  > 
  > local({
  +   #' cases not covered elsewhere
  +   A <- envelope(cells, nsim=5, alternative="less",
  +                 do.pwrong=TRUE, use.theory=FALSE,
  +                 savepatterns=TRUE, savefuns=TRUE)
  +   print(A)
  +   B <- envelope(A, nsim=5, savefuns=TRUE)
  +   D <- envelope(cells, "Lest", nsim=5)
  +   fit <- ppm(cells ~ 1, Strauss(0.07))
  +   U <- envelope(fit, nsim=3, simulate=expression(runifpoint(20)))
  +   #'  envelopes based on sample variance
  +   E <- envelope(cells, nsim=8, VARIANCE=TRUE)
  +   G <- envelope(cells, nsim=8, VARIANCE=TRUE,
  +                 use.theory=FALSE, do.pwrong=TRUE)
  +   print(G)
  +   #' summary method
  +   summary(E)
  +   summary(envelope(cells, nsim=5, simulate=expression(runifpoint(42))))
  +   #' weights argument
  +   H1 <- envelope(cells, nsim=4, weights=npoints, savefuns=TRUE)
  +   H2 <- envelope(cells, nsim=4, weights=npoints, savefuns=TRUE)
  +   J <- envelope(cells, nsim=4, weights=npoints, VARIANCE=TRUE)
  +   #' pooling with weights
  +   H <- pool(H1, H2)
  +   #' pooling envelopes with non-identical attributes
  +   H0 <- envelope(cells, nsim=4, savefuns=TRUE)
  +   HH <- pool(H0, H1)
  +   #' undocumented/secret
  +   K <- envelope(cells, nsim=4, saveresultof=npoints, collectrubbish=TRUE)
  +   #' so secret I've even forgotten how to do it
  +   M <- envelope(cells, nsim=4, internal=list(eject="patterns"))
  + })
  Generating 5 simulations of CSR  ...
  1, 2, 3, 4,  5.
  
  Done.
  Pointwise critical envelopes for K(r)
  and observed value for 'cells'
  Edge correction: "iso"
  Obtained from 5 simulations of CSR
  (All simulated function values are stored)
  (All simulated point patterns are stored)
  Alternative: less
  Significance level of pointwise Monte Carlo test: 2/6 = 0.333
  	[Estimated significance level of pointwise excursions: pwrong=1]
  ......................................................................
        Math.label     Description                                      
  r     r              distance argument r                              
  obs   hat(K)[obs](r) observed value of K(r) for data pattern          
  mmean bar(K)(r)      sample mean of K(r) from simulations             
  lo    hat(K)[lo](r)  lower pointwise envelope of K(r) from simulations
  hi    infinity       infinite upper limit                             
  ......................................................................
  Default plot formula:  .~r
  where "." stands for 'obs', 'mmean', 'hi', 'lo'
  Columns 'lo' and 'hi' will be plotted as shading (by default)
  Recommended range of argument r: [0, 0.25]
  Available range of argument r: [0, 0.25]
  Generating 5 simulations of CSR  ...
  1, 2, 3, 4,  5.
  
  Done.
  Generating 3 simulations by evaluating expression  ...
  1, 2,  3.
  
  Done.
  Generating 8 simulations of CSR  ...
  1, 2, 3, 4, 5, 6, 7,  8.
  
  Done.
  Generating 8 simulations of CSR  ...
  1, 2, 3, 4, 5, 6, 7,  8.
  
  Done.
  Pointwise 2 sigma critical envelopes for K(r)
  and observed value for 'cells'
  Edge correction: "iso"
  Obtained from 8 simulations of CSR
  Alternative: two.sided
  	[Estimated significance level of pointwise excursions: pwrong=0.5]
  ................................................................................
         Math.label            
  r      r                     
  obs    hat(K)[obs](r)        
  mmean  bar(K)(r)             
  lo     hat(K)[lo](r)         
  hi     hat(K)[hi](r)         
  var    bold(var)~hat(K)(r)   
  res    bold(res)~hat(K)(r)   
  stdres bold(stdres)~hat(K)(r)
  loCI   K[loCI](r)            
  hiCI   K[hiCI](r)            
         Description                                              
  r      distance argument r                                      
  obs    observed value of K(r) for data pattern                  
  mmean  sample mean of K(r) from simulations                     
  lo     lower 2 sigma critical limit for K(r)                    
  hi     upper 2 sigma critical limit for K(r)                    
  var    sample variance of K(r) from simulations                 
  res    raw residual                                             
  stdres standardised residual                                    
  loCI   lower 2 sigma confidence bound for mean of simulated K(r)
  hiCI   upper 2 sigma confidence bound for mean of simulated K(r)
  ................................................................................
  Default plot formula:  .~r
  where "." stands for 'obs', 'mmean', 'hi', 'lo'
  Columns 'lo' and 'hi' will be plotted as shading (by default)
  Recommended range of argument r: [0, 0.25]
  Available range of argument r: [0, 0.25]
  Pointwise 2 sigma critical envelopes for K(r)
  and observed value for 'cells'
  Obtained from 8 simulations of CSR
  Alternative: two.sided
  Envelopes computed as sample mean plus/minus 2 sample standard deviations
  Data: cells
  Generating 5 simulations by evaluating expression  ...
  1, 2, 3, 4,  5.
  
  Done.
  Pointwise critical envelopes for K(r)
  and observed value for 'cells'
  Obtained from 5 evaluations of user-supplied expression
  Alternative: two.sided
  Upper envelope: pointwise maximum of simulated curves
  Lower envelope: pointwise minimum of simulated curves
  Significance level of Monte Carlo test: 2/6 = 0.333333333333333
  Data: cells
  Generating 4 simulations of CSR  ...
  1, 2, 3,  4.
  
  Done.
  Generating 4 simulations of CSR  ...
  1, 2, 3,  4.
  
  Done.
  Generating 4 simulations of CSR  ...
  1, 2, 3,  4.
  
  Done.
  Generating 4 simulations of CSR  ...
  1, 2, 3,  4.
  
  Done.
  Generating 4 simulations of CSR  ...
  1, 2, 3,  4.
  
  Done.
  Generating 4 simulations of CSR  ...
  1, 2, 3,  4.
  Done.
  Warning message:
  Weights were used in some, but not all, envelopes: they will be ignored 
  > 
  > local({
  +   #' envelope computations in other functions
  +   P <- lurking(cells, expression(x), envelope=TRUE, nsim=9)
  +   print(P)
  +   #' re-using envelope objects in other functions
  +   A <- envelope(cells, nsim=9, savepatterns=TRUE, savefuns=TRUE)
  +   S <- lurking(cells, expression(x), envelope=A, nsim=9)
  +   #' envelope.envelope
  +   B <- envelope(cells, nsim=5, savepatterns=TRUE, savefuns=FALSE)
  +   envelope(B)
  + })
  Generating 9 simulated patterns ...1, 2, 3, 4, 5, 6, 7, 8,  9.
  Processing.. 1, 2, 3, 4, 5, 6, 7, 8,  9.
  Done.
  Lurking variable plot (object of class 'lurk')
  Residual type:  exponential energy weights
  Covariate on horizontal axis:  x
  Range of covariate values:  [0, 1]
  Cumulative plot
  Includes standard deviation for confidence bands
  Variance calculation: new style
  Generating 9 simulations of CSR  ...
  1, 2, 3, 4, 5, 6, 7, 8,  9.
  
  Done.
  Processing.. 1, 2, 3, 4, 5, 6, 7, 8,  9.
  Done.
  Generating 5 simulations of CSR  ...
  1, 2, 3, 4,  5.
  
  Done.
  Extracting 5 point patterns from list  ...
  1, 2, 3, 4,  5.
  
  Done.
  Pointwise critical envelopes for K(r)
  and observed value for 'cells'
  Edge correction: "iso"
  Obtained from 5 simulations of CSR
  Alternative: two.sided
  Significance level of pointwise Monte Carlo test: 2/6 = 0.333
  .....................................................................
       Math.label     Description                                      
  r    r              distance argument r                              
  obs  hat(K)[obs](r) observed value of K(r) for data pattern          
  theo K[theo](r)     theoretical value of K(r) for CSR                
  lo   hat(K)[lo](r)  lower pointwise envelope of K(r) from simulations
  hi   hat(K)[hi](r)  upper pointwise envelope of K(r) from simulations
  .....................................................................
  Default plot formula:  .~r
  where "." stands for 'obs', 'theo', 'hi', 'lo'
  Columns 'lo' and 'hi' will be plotted as shading (by default)
  Recommended range of argument r: [0, 0.25]
  Available range of argument r: [0, 0.25]
  > 
  > local({
  +   X <- runiflpp(10, simplenet)
  +   Xr <- X %mark% runif(10)
  +   Xc <- X %mark% factor(letters[c(1:4,3,2,4:1)])
  +   X2 <- X %mark% data.frame(height=runif(10), width=runif(10))
  + 
  +   E  <- envelope(X,  linearK, nsim=9)
  +   Er <- envelope(Xr, linearK, nsim=9)
  +   Ec <- envelope(Xc, linearK, nsim=9)
  +   E2 <- envelope(X2, linearK, nsim=9)
  +   
  +   Erf <- envelope(Xr, linearK, nsim=9, fix.n=TRUE)
  +   E2f <- envelope(X2, linearK, nsim=9, fix.n=TRUE)
  + 
  +   Ecf <- envelope(Xc, linearK,      nsim=9, fix.n=TRUE)
  +   Ecm <- envelope(Xc, linearKcross, nsim=9, fix.n=TRUE, fix.marks=TRUE)
  + 
  +   fut <- lppm(Xc ~ marks)
  +   EEf <- envelope(fut, linearK,      fix.n=TRUE)
  +   EEm <- envelope(fut, linearKcross, fix.n=TRUE, fix.marks=TRUE)
  + })
  Generating 9 simulations of CSR  ...
  1, 2, 3, 4, 5, 6, 7, 8,  9.
  
  Done.
  Generating 9 simulations of CSR  ...
  1, 2, 3, 4, 5, 6, 7, 8,  9.
  
  Done.
  Generating 9 simulations of CSR  ...
  1, 2, 3, 4, 5, 6, 7, 8,  9.
  
  Done.
  Generating 9 simulations of CSR  ...
  1, 2, 3, 4, 5, 6, 7, 8,  9.
  
  Done.
  Generating 9 simulations of CSR  ...
  1, 2, 3, 4, 5, 6, 7, 8,  9.
  
  Done.
  Generating 9 simulations of CSR  ...
  1, 2, 3, 4, 5, 6, 7, 8,  9.
  
  Done.
  Generating 9 simulations of CSR  ...
  1, 2, 3, 4, 5, 6, 7, 8,  9.
  
  Done.
  Generating 9 simulations of CSR  ...
  1, 2, 3, 4, 5, 6, 7, 8,  9.
  
  Done.
  Generating 99 simulated patterns  ...
  1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 26, 27, 28, 29, 30, 31, 32, 33, 34, 35, 36, 37, 38, 39, 40,
  41, 42, 43, 44, 45, 46, 47, 48, 49, 50, 51, 52, 53, 54, 55, 56, 57, 58, 59, 60, 61, 62, 63, 64, 65, 66, 67, 68, 69, 70, 71, 72, 73, 74, 75, 76, 77, 78, 79, 80,
  81, 82, 83, 84, 85, 86, 87, 88, 89, 90, 91, 92, 93, 94, 95, 96, 97, 98,  99.
  
  Done.
  Generating 99 simulated patterns  ...
  1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 26, 27, 28, 29, 30, 31, 32, 33, 34, 35, 36, 37, 38, 39, 40,
  41, 42, 43, 44, 45, 46, 47, 48, 49, 50, 51, 52, 53, 54, 55, 56, 57, 58, 59, 60, 61, 62, 63, 64, 65, 66, 67, 68, 69, 70, 71, 72, 73, 74, 75, 76, 77, 78, 79, 80,
  81, 82, 83, 84, 85, 86, 87, 88, 89, 90, 91, 92, 93, 94, 95, 96, 97, 98,  99.
  
  Done.
  > 
  > local({
  +   #' Test robustness of envelope() sorting procedure when NA's are present
  +   #' Fails with spatstat.utils 1.12-0
  +   set.seed(42)
  +   EP <- envelope(longleaf, pcf, nsim=10, nrank=2)
  + })
  Generating 10 simulations of CSR  ...
  1, 2, 3, 4, 5, 6, 7, 8, 9,  10.
  
  Done.
  > #
  > #    tests/factorbugs.R
  > #
  > # check for various bugs related to factor conversions
  > #
  > #    $Revision: 1.3 $  $Date: 2015/12/29 08:54:49 $
  > #
  > require(spatstat)
  > local({
  +   # make a factor image
  +   m <- factor(rep(letters[1:4], 4))
  +   Z <- im(m, xcol=1:4, yrow=1:4)
  +   # make a point pattern
  +   set.seed(42)
  +   X <- runifpoint(20, win=as.owin(Z))
  +   # look up the image at the points of X
  +   # (a) internal
  +   ans1 <- lookup.im(Z, X$x, X$y)
  +   stopifnot(is.factor(ans1))
  +   # (b) user level
  +   ans2 <- Z[X]
  +   stopifnot(is.factor(ans2))
  +   # (c) turn the image into a tessellation
  +   #  and apply quadratcount
  +   V <- tess(image = Z)
  +   quadratcount(X, tess=V)
  +   # (d) pad image
  +   Y <- padimage(Z, factor("b", levels=levels(Z)))
  +   stopifnot(Y$type == "factor")
  +   U <- padimage(Z, "b")
  +   stopifnot(U$type == "factor")
  + })
  > 
  > 
  > #
  > #    tests/fastgeyer.R
  > #
  > # checks validity of fast C implementation of Geyer interaction
  > #
  > #    $Revision: 1.3 $  $Date: 2015/12/29 08:54:49 $
  > #
  > require(spatstat)
  > local({
  +   X <- redwood
  +   Q <- quadscheme(X)
  +   U <- union.quad(Q)
  +   EP <- equalpairs.quad(Q)
  +   G <- Geyer(0.11, 2)
  + # The value r=0.11 is chosen to avoid hardware numerical effects (gcc bug 323).
  + # It avoids being close any value of pairdist(redwood).
  + # The nearest such values are 0.1077.. and 0.1131..
  + # By contrast if r = 0.1 there are values differing from 0.1 by 3e-17
  +   a <- pairsat.family$eval(X,U,EP,G$pot,G$par,"border")
  +   b <-          G$fasteval(X,U,EP,G$pot,G$par,"border")
  +   if(!all(a==b))
  +     stop("Results of Geyer()$fasteval and pairsat.family$eval do not match")
  + # ...
  + # and again for a non-integer value of 'sat'
  + # (spotted by Thordis Linda Thorarinsdottir)  
  +   G <- Geyer(0.11, 2.5)
  +   a <- pairsat.family$eval(X,U,EP,G$pot,G$par,"border")
  +   b <-          G$fasteval(X,U,EP,G$pot,G$par,"border")
  +   if(!all(a==b))
  +     stop("Results of Geyer()$fasteval and pairsat.family$eval do not match when sat is not an integer")
  + # and again for sat < 1
  + # (spotted by Rolf)  
  +   G <- Geyer(0.11, 0.5)
  +   a <- pairsat.family$eval(X,U,EP,G$pot,G$par,"border")
  +   b <-          G$fasteval(X,U,EP,G$pot,G$par,"border")
  +   if(!all(a==b))
  +     stop("Results of Geyer()$fasteval and pairsat.family$eval do not match when sat < 1")
  + })
  > 
  > #
  > #  tests/fastK.R
  > #
  > # check fast and slow code for Kest
  > #       and options not tested elsewhere
  > #
  > #   $Revision: 1.4 $   $Date: 2018/04/13 04:01:25 $
  > #
  > require(spatstat)
  > local({
  +   ## fast code
  +   Kb <- Kest(cells, nlarge=0)
  +   Ku <- Kest(cells, correction="none")
  +   Kbu <- Kest(cells, correction=c("none", "border"))
  +   ## slow code, full set of corrections, sqrt transformation, ratios
  +   Ldd <- Lest(unmark(demopat), correction="all", var.approx=TRUE, ratio=TRUE)
  +   ## Lotwick-Silverman var approx (rectangular window)
  +   Loo <- Lest(cells, correction="all", var.approx=TRUE, ratio=TRUE)
  +   ## Code for large dataset
  +   nbig <- .Machine$integer.max
  +   if(!is.null(nbig)) {
  +     nn <- ceiling(sqrt(nbig))
  +     if(nn < 1e6) Kbig <- Kest(runifpoint(nn),
  +                               correction=c("border", "bord.modif", "none"),
  +                               ratio=TRUE)
  +   }
  +   
  +   ## Kinhom
  +   lam <- density(cells, at="points", leaveoneout=TRUE)
  +   ## fast code
  +   Kib <- Kinhom(cells, lam, nlarge=0)
  +   Kiu <- Kest(cells, lam, correction="none")
  +   Kibu <- Kest(cells, lam, correction=c("none", "border"))
  +   ## slow code
  +   Lidd <- Linhom(unmark(demopat), sigma=bw.scott)
  + })
  number of data points exceeds 0 - computing border correction estimate only
  number of data points exceeds 0 - computing border correction estimate only
  > 
  > 
  > #' tests/formuli.R
  > #'
  > #'  Test machinery for manipulating formulae
  > #' 
  > #' $Revision: 1.4 $  $Date: 2017/02/20 07:35:47 $
  > 
  > require(spatstat)
  > local({
  + 
  +   ff <- function(A, deletevar, B) {
  +     D <- reduceformula(A, deletevar)
  +     if(!spatstat.utils::identical.formulae(D, B)) {
  +       AD <- as.expression(substitute(reduceformula(A,d),
  +                                      list(A=A, d=deletevar)))
  +       stop(paste(AD, "\n\tyields ", spatstat.utils::pasteFormula(D),
  +                  " instead of ", spatstat.utils::pasteFormula(B)),
  +            call.=FALSE)
  +     }
  +     invisible(NULL)
  +   }
  + 
  +   ff(~ x + z, "x", ~z)
  + 
  +   ff(y ~ x + z, "x", y~z)
  + 
  +   ff(~ I(x^2) + z, "x",  ~z)
  + 
  +   ff(y ~ poly(x,2) + poly(z,3), "x", y ~poly(z,3))
  + 
  + })
  > 
  > 
  > 
  > #
  > #  tests/func.R
  > #
  > #   $Revision: 1.3 $   $Date: 2016/06/10 15:04:08 $
  > #
  > #  Tests of 'funxy' infrastructure etc
  > 
  > require(spatstat)
  > local({
  +   W <- square(1)
  +   f1a <- function(x, y) sqrt(x^2 + y^2)
  +   f1b <- function(x, y) { sqrt(x^2 + y^2) }
  +   f2a <- function(x, y) sin(x)
  +   f2b <- function(x, y) { sin(x) } 
  +   f3a <- function(x, y) sin(x) + cos(x) 
  +   f3b <- function(x, y) { sin(x) + cos(x) } 
  +   f4a <- function(x, y) { z <- x + y ; z }
  +   f4b <- function(x, y) { x + y } 
  +   F1a <- funxy(f1a, W)
  +   F1b <- funxy(f1b, W)
  +   F2a <- funxy(f2a, W)
  +   F2b <- funxy(f2b, W)
  +   F3a <- funxy(f3a, W)
  +   F3b <- funxy(f3b, W)
  +   F4a <- funxy(f4a, W)
  +   F4b <- funxy(f4b, W)
  +   stopifnot(identical(F1a(cells), F1b(cells)))
  +   stopifnot(identical(F2a(cells), F2b(cells)))
  +   stopifnot(identical(F3a(cells), F3b(cells)))
  +   stopifnot(identical(F4a(cells), F4b(cells)))
  + })
  > 
  > 
  > 
  > 
  > ##  
  > ##     tests/funnymarks.R
  > ##
  > ## tests involving strange mark values
  > ## $Revision: 1.5 $ $Date: 2018/06/14 01:50:19 $
  > 
  > require(spatstat)
  > local({
  +   ## ppm() where mark levels contain illegal characters
  +   hyphenated <- c("a", "not-a")
  +   spaced <- c("U", "non U")
  +   suffixed <- c("a+", "a*")
  +   charred <- c("+", "*")
  + 
  +   irad <- matrix(0.1, 2,2)
  +   hrad <- matrix(0.005, 2, 2)
  + 
  +   tryit <- function(types, X, irad, hrad) { 
  +     levels(marks(X)) <- types
  +     fit <- ppm(X ~marks + polynom(x,y,2),
  +                MultiStraussHard(types=types,iradii=irad,hradii=hrad))
  +     print(fit)
  +     print(coef(fit))
  +     val <- fitted(fit)
  +     pred <- predict(fit)
  +     return(invisible(NULL))
  +   }
  + 
  +   tryit(hyphenated, amacrine, irad, hrad)
  +   tryit(spaced, amacrine, irad, hrad)
  +   tryit(suffixed, amacrine, irad, hrad)
  +   tryit(charred, amacrine, irad, hrad)
  + 
  +   ## marks which are dates
  +   X <- cells
  +   n <- npoints(X)
  +   endoftime <- rep(ISOdate(2001,1,1), n)
  +   eotDate   <- rep(as.Date("2001-01-01"), n)
  +   markformat(endoftime)
  +   markformat(eotDate)
  +   marks(X) <- endoftime
  +   print(X)
  +   Y <- X %mark% data.frame(id=1:42, date=endoftime, dd=eotDate)
  +   print(Y)
  +   md <- markformat(endoftime)
  +   
  +   ## mark formats
  +   Z <- Y
  +   marks(Z) <- marks(Z)[1,,drop=FALSE]
  +   ms <- markformat(solist(cells, redwood))
  +   marks(Z) <- factor(1:npoints(Z))
  +   marks(Z)[12] <- NA
  +   mz <- is.multitype(Z)
  +   cZ <- coerce.marks.numeric(Z)
  +   stopifnot(is.multitype(cells %mark% data.frame(a=factor(1:npoints(cells)))))
  + 
  +   a <- numeric.columns(finpines)
  +   b1 <- numeric.columns(amacrine)
  +   b2 <- coerce.marks.numeric(amacrine)
  +   d <- numeric.columns(cells)
  +   f <- numeric.columns(longleaf)
  + })
  Nonstationary Multitype Strauss Hardcore process
  
  Possible marks: 'a' and 'not-a'
  
  Log trend:  ~marks + (x + y + I(x^2) + I(x * y) + I(y^2))
  
  Fitted trend coefficients:
  (Intercept)  marksnot-a           x           y      I(x^2)    I(x * y) 
    7.3741600   0.1223023   1.2302865   0.2403500  -0.7560707   0.3384324 
       I(y^2) 
   -0.5425654 
  
  2 types of points
  Possible types:
  [1] a     not-a
  Interaction radii:
          a not-a
  a     0.1   0.1
  not-a 0.1   0.1
  Hardcore radii:
            a not-a
  a     0.005 0.005
  not-a 0.005 0.005
  Fitted interaction parameters gamma_ij
                a     not-a
  a     0.2699920 0.8920719
  not-a 0.8920719 0.2694374
  
  Relevant coefficients:
          markaxa     markaxnot.a marknot.axnot.a 
       -1.3093629      -0.1142086      -1.3114192 
  
  For standard errors, type coef(summary(x))
      (Intercept)      marksnot-a               x               y          I(x^2) 
        7.3741600       0.1223023       1.2302865       0.2403500      -0.7560707 
         I(x * y)          I(y^2)         markaxa     markaxnot.a marknot.axnot.a 
        0.3384324      -0.5425654      -1.3093629      -0.1142086      -1.3114192 
  Nonstationary Multitype Strauss Hardcore process
  
  Possible marks: 'U' and 'non U'
  
  Log trend:  ~marks + (x + y + I(x^2) + I(x * y) + I(y^2))
  
  Fitted trend coefficients:
  (Intercept)  marksnon U           x           y      I(x^2)    I(x * y) 
    7.3741600   0.1223023   1.2302865   0.2403500  -0.7560707   0.3384324 
       I(y^2) 
   -0.5425654 
  
  2 types of points
  Possible types:
  [1] U     non U
  Interaction radii:
          U non U
  U     0.1   0.1
  non U 0.1   0.1
  Hardcore radii:
            U non U
  U     0.005 0.005
  non U 0.005 0.005
  Fitted interaction parameters gamma_ij
                U     non U
  U     0.2699920 0.8920719
  non U 0.8920719 0.2694374
  
  Relevant coefficients:
          markUxU     markUxnon.U marknon.Uxnon.U 
       -1.3093629      -0.1142086      -1.3114192 
  
  For standard errors, type coef(summary(x))
      (Intercept)      marksnon U               x               y          I(x^2) 
        7.3741600       0.1223023       1.2302865       0.2403500      -0.7560707 
         I(x * y)          I(y^2)         markUxU     markUxnon.U marknon.Uxnon.U 
        0.3384324      -0.5425654      -1.3093629      -0.1142086      -1.3114192 
  Nonstationary Multitype Strauss Hardcore process
  
  Possible marks: 'a+' and 'a*'
  
  Log trend:  ~marks + (x + y + I(x^2) + I(x * y) + I(y^2))
  
  Fitted trend coefficients:
  (Intercept)     marksa*           x           y      I(x^2)    I(x * y) 
    7.3741600   0.1223023   1.2302865   0.2403500  -0.7560707   0.3384324 
       I(y^2) 
   -0.5425654 
  
  2 types of points
  Possible types:
  [1] a+ a*
  Interaction radii:
      a+  a*
  a+ 0.1 0.1
  a* 0.1 0.1
  Hardcore radii:
        a+    a*
  a+ 0.005 0.005
  a* 0.005 0.005
  Fitted interaction parameters gamma_ij
            a+        a*
  a+ 0.2699920 0.8920719
  a* 0.8920719 0.2694374
  
  Relevant coefficients:
      marka.xa.   marka.xa..1 marka..1xa..1 
     -1.3093629    -0.1142086    -1.3114192 
  
  For standard errors, type coef(summary(x))
    (Intercept)       marksa*             x             y        I(x^2) 
      7.3741600     0.1223023     1.2302865     0.2403500    -0.7560707 
       I(x * y)        I(y^2)     marka.xa.   marka.xa..1 marka..1xa..1 
      0.3384324    -0.5425654    -1.3093629    -0.1142086    -1.3114192 
  Nonstationary Multitype Strauss Hardcore process
  
  Possible marks: '+' and '*'
  
  Log trend:  ~marks + (x + y + I(x^2) + I(x * y) + I(y^2))
  
  Fitted trend coefficients:
  (Intercept)      marks*           x           y      I(x^2)    I(x * y) 
    7.3741600   0.1223023   1.2302865   0.2403500  -0.7560707   0.3384324 
       I(y^2) 
   -0.5425654 
  
  2 types of points
  Possible types:
  [1] + *
  Interaction radii:
      +   *
  + 0.1 0.1
  * 0.1 0.1
  Hardcore radii:
        +     *
  + 0.005 0.005
  * 0.005 0.005
  Fitted interaction parameters gamma_ij
            +         *
  + 0.2699920 0.8920719
  * 0.8920719 0.2694374
  
  Relevant coefficients:
      markX.xX.   markX.xX..1 markX..1xX..1 
     -1.3093629    -0.1142086    -1.3114192 
  
  For standard errors, type coef(summary(x))
    (Intercept)        marks*             x             y        I(x^2) 
      7.3741600     0.1223023     1.2302865     0.2403500    -0.7560707 
       I(x * y)        I(y^2)     markX.xX.   markX.xX..1 markX..1xX..1 
      0.3384324    -0.5425654    -1.3093629    -0.1142086    -1.3114192 
  Marked planar point pattern: 42 points
  marks are dates, of class 'POSIXt'
  window: rectangle = [0, 1] x [0, 1] units
  Marked planar point pattern: 42 points
  Mark variables: id, date, dd 
  window: rectangle = [0, 1] x [0, 1] units
  Warning messages:
  1: In is.multitype.ppp(Z) : some mark values are NA in the point pattern Z
  2: Factor-valued marks were converted to integer codes 
  3: Factor-valued marks were converted to integer codes 
  > # 
  > #    tests/fvproblems.R
  > #
  > #    $Revision: 1.7 $  $Date: 2016/03/08 00:26:23 $
  > #
  > 
  > require(spatstat)
  > 
  > # This appears in the workshop notes
  > # Problem detected by Martin Bratschi
  > 
  > local({
  +   Jdif <- function(X, ..., i) {
  +     Jidot <- Jdot(X, ..., i=i)
  +     J <- Jest(X, ...)
  +     dif <- eval.fv(Jidot - J)
  +     return(dif)
  +   }
  +   Z <- Jdif(amacrine, i="on")
  + })
  Error in .approxfun(x, y, v, method, yleft, yright, f) : 
    object 'v' not found
  Calls: local ... harmonise.fv -> lapply -> FUN -> fi -> <Anonymous> -> .approxfun
  In addition: Warning message:
  In eval.fv(Jidot - J) :
     the functions 'Jidot' and 'J' were not compatible: enforcing compatibility
  Execution halted