library(spatstat)
# Strauss process.
mod01 <- list(cif="strauss",par=c(beta=2,gamma=0.2,r=0.7),
w=c(0,10,0,10))
X1.strauss <- rmh(model=mod01,start=list(n.start=80),
control=list(nrep=1e5,nverb=5000))
# Strauss process, conditioning on n = 80:
X2.strauss <- rmh(model=mod01,start=list(n.start=80),
control=list(p=1,nrep=1e5,nverb=5000))
x <- c(0.55,0.68,0.75,0.58,0.39,0.37,0.19,0.26,0.42)
y <- c(0.20,0.27,0.68,0.99,0.80,0.61,0.45,0.28,0.33)
mod02 <- list(cif="strauss",par=c(beta=2000,gamma=0.6,r=0.7),
w=owin(poly=list(x=x,y=y)))
X3.strauss <- rmh(model=mod02,start=list(n.start=90),
control=list(nrep=1e5,nverb=5000))
# Strauss process equal to pure hardcore:
mod03 <- list(cif="strauss",par=c(beta=2,gamma=0,r=0.7),w=c(0,10,0,10))
X4.strauss <- rmh(model=mod03,start=list(n.start=60),
control=list(nrep=1e5,nverb=5000,iseed=c(42,17,69)))
# Another Strauss process, starting off from X3.strauss (but
# with a rectangular window):
xxx <- X3.strauss
xxx$w <- as.owin(c(0,1,0,1))
X3.strauss <- rmh(model=mod02,start=list(x.start=xxx),
control=list(nrep=1e5,nverb=5000))
# Strauss with hardcore:
mod04 <- list(cif="straush",par=c(beta=2,gamma=0.2,r=0.7,hc=0.3),
w=c(0,10,0,10))
X1.straush <- rmh(model=mod04,start=list(n.start=70),
control=list(nrep=1e5,nverb=5000))
# Another Strauss with hardcore (with a perhaps surprizing
# result):
mod05 <- list(cif="straush",par=c(beta=80,gamma=0.36,r=45,hc=2.5),
w=c(0,250,0,250))
X2.straush <- rmh(model=mod05,start=list(n.start=250),
control=list(nrep=1e5,nverb=5000))
# Pure hardcore (identical to X3.strauss).
mod06 <- list(cif="straush",par=c(beta=2,gamma=1,r=1,hc=0.7),
w=c(0,10,0,10))
X3.straush <- rmh(model=mod06,start=list(n.start=60),
control=list(nrep=1e5,nverb=5000,iseed=c(42,17,69)))
# Soft core:
par3 <- c(0.8,0.1,0.5)
w <- c(0,10,0,10)
mod07 <- list(cif="sftcr",par=c(beta=0.8,sigma=0.1,kappa=0.5),
w=c(0,10,0,10))
X.sftcr <- rmh(model=mod07,start=list(n.start=70),
control=list(nrep=1e5,nverb=5000))
# Multitype Strauss:
beta <- c(0.027,0.008)
gmma <- matrix(c(0.43,0.98,0.98,0.36),2,2)
r <- matrix(c(45,45,45,45),2,2)
mod08 <- list(cif="straussm",par=list(beta=beta,gamma=gmma,radii=r),
w=c(0,250,0,250))
X1.straussm <- rmh(model=mod08,start=list(n.start=80),
control=list(ptypes=c(0.75,0.25),nrep=1e5,nverb=5000))
# Multitype Strauss conditioning upon the total number
# of points being 80:
X2.straussm <- rmh(model=mod08,start=list(n.start=80),
control=list(p=1,ptypes=c(0.75,0.25),nrep=1e5,
nverb=5000))
# Conditioning upon the number of points of type 1 being 60
# and the number of points of type 2 being 20:
X3.straussm <- rmh(model=mod08,start=list(n.start=c(60,20)),
control=list(fixall=TRUE,p=1,ptypes=c(0.75,0.25),
nrep=1e5,nverb=5000))
# Multitype Strauss hardcore:
rhc <- matrix(c(9.1,5.0,5.0,2.5),2,2)
mod09 <- list(cif="straushm",par=list(beta=beta,gamma=gmma,
iradii=r,hradii=rhc),w=c(0,250,0,250))
X.straushm <- rmh(model=mod09,start=list(n.start=80),
control=list(ptypes=c(0.75,0.25),nrep=1e5,nverb=5000))
# Multitype Strauss hardcore with trends for each type:
beta <- c(0.0027,0.08)
tpar1 <- c(0.02,0.004,-0.0004,0.004,-0.0004) # Coefs. for log quadratic
tpar2 <- c(-0.06,0.05) # and log linear trends.
mod10 <- list(cif="straushm",par=list(beta=beta,gamma=gmma,
iradii=r,hradii=rhc),w=c(0,250,0,250),
tpar=list(tpar1,tpar2))
X1.straushm.trend <- rmh(model=mod10,start=list(n.start=350),
control=list(ptypes=c(0.75,0.25),
nrep=1e5,nverb=5000))
# Diggle, Gates, and Stibbard:
mod11 <- list(cif="dgs",par=c(beta=3600,rho=0.08),w=c(0,1,0,1))
X.dgs <- rmh(model=mod11,start=list(n.start=300),
control=list(nrep=1e5,nverb=5000))
# Diggle-Gratton:
mod12 <- list(cif="diggra",
par=c(beta=1800,kappa=3,delta=0.02,rho=0.04),
w=square(1))
X.diggra <- rmh(model=mod12,start=list(n.start=300),
control=list(nrep=1e5,nverb=5000))
# Geyer:
mod13 <- list(cif="geyer",par=c(beta=1.25,gamma=1.6,r=0.2,sat=4.5),
w=c(0,10,0,10))
X1.geyer <- rmh(model=mod13,start=list(n.start=200),
control=list(nrep=1e5,nverb=5000))
# Geyer; same as a Strauss process with parameters
# (beta=2.25,gamma=0.16,r=0.7):
mod14 <- list(cif="geyer",par=c(beta=2.25,gamma=0.4,r=0.7,sat=10000),
w=c(0,10,0,10))
X2.geyer <- rmh(model=mod14,start=list(n.start=200),
control=list(nrep=1e5,nverb=5000))
mod15 <- list(cif="geyer",par=c(beta=8.1,gamma=2.2,r=0.08,sat=3))
data(redwood)
X3.geyer <- rmh(model=mod15,start=list(x.start=redwood),
control=list(periodic=TRUE,nrep=1e5,nverb=5000))
# Geyer, starting from the redwood data set, simulating
# on a torus, and conditioning on n:
X4.geyer <- rmh(model=mod15,start=list(x.start=redwood),
control=list(p=1,periodic=TRUE,nrep=1e5,nverb=5000))
<testonly># Strauss process.
mod01 <- list(cif="strauss",par=c(beta=2,gamma=0.2,r=0.7),
w=c(0,10,0,10))
X1.strauss <- rmh(model=mod01,start=list(n.start=80),
control=list(nrep=100,nverb=50))
# Strauss process, conditioning on n = 80:
X2.strauss <- rmh(model=mod01,start=list(n.start=80),
control=list(p=1,nrep=10,nverb=5))
x <- c(0.55,0.68,0.75,0.58,0.39,0.37,0.19,0.26,0.42)
y <- c(0.20,0.27,0.68,0.99,0.80,0.61,0.45,0.28,0.33)
mod02 <- list(cif="strauss",par=c(beta=2000,gamma=0.6,r=0.7),
w=owin(poly=list(x=x,y=y)))
X3.strauss <- rmh(model=mod02,start=list(n.start=90),
control=list(nrep=10,nverb=5))
# Strauss process == pure hardcore:
mod03 <- list(cif="strauss",par=c(beta=2,gamma=0,r=0.7),w=c(0,10,0,10))
X4.strauss <- rmh(model=mod03,start=list(n.start=60),
control=list(nrep=10,nverb=5,iseed=c(42,17,69)))
# Another Strauss process, starting off from X3.strauss (but
# with a rectangular window):
xxx <- X3.strauss
xxx$w <- as.owin(c(0,1,0,1))
X3.strauss <- rmh(model=mod02,start=list(x.start=xxx),
control=list(nrep=10,nverb=5))
# Strauss with hardcore:
mod04 <- list(cif="straush",par=c(beta=2,gamma=0.2,r=0.7,hc=0.3),
w=c(0,10,0,10))
X1.straush <- rmh(model=mod04,start=list(n.start=70),
control=list(nrep=10,nverb=5))
# Another Strauss with hardcore (with a perhaps surprizing
# result):
mod05 <- list(cif="straush",par=c(beta=80,gamma=0.36,r=45,hc=2.5),
w=c(0,250,0,250))
X2.straush <- rmh(model=mod05,start=list(n.start=250),
control=list(nrep=10,nverb=5))
# Pure hardcore (identical to X3.strauss).
mod06 <- list(cif="straush",par=c(beta=2,gamma=1,r=1,hc=0.7),
w=c(0,10,0,10))
X3.straush <- rmh(model=mod06,start=list(n.start=60),
control=list(nrep=10,nverb=5,iseed=c(42,17,69)))
# Soft core:
par3 <- c(0.8,0.1,0.5)
w <- c(0,10,0,10)
mod07 <- list(cif="sftcr",par=c(beta=0.8,sigma=0.1,kappa=0.5),
w=c(0,10,0,10))
X.sftcr <- rmh(model=mod07,start=list(n.start=70),
control=list(nrep=10,nverb=5))
# Multitype Strauss:
beta <- c(0.027,0.008)
gmma <- matrix(c(0.43,0.98,0.98,0.36),2,2)
r <- matrix(c(45,45,45,45),2,2)
mod08 <- list(cif="straussm",par=list(beta=beta,gamma=gmma,radii=r),
w=c(0,250,0,250))
X1.straussm <- rmh(model=mod08,start=list(n.start=80),
control=list(ptypes=c(0.75,0.25),nrep=10,nverb=5))
# Multitype Strauss conditioning upon the total number
# of points being 80:
X2.straussm <- rmh(model=mod08,start=list(n.start=80),
control=list(p=1,ptypes=c(0.75,0.25),
nrep=10,nverb=5))
# Conditioning upon the number of points of type 1 being 60
# and the number of points of type 2 being 20:
X3.straussm <- rmh(model=mod08,start=list(n.start=c(60,20)),
control=list(fixall=TRUE,p=1,ptypes=c(0.75,0.25),
nrep=10,nverb=5))
# Multitype Strauss hardcore:
rhc <- matrix(c(9.1,5.0,5.0,2.5),2,2)
mod09 <- list(cif="straushm",par=list(beta=beta,gamma=gmma,
iradii=r,hradii=rhc),w=c(0,250,0,250))
X.straushm <- rmh(model=mod09,start=list(n.start=80),
control=list(ptypes=c(0.75,0.25),nrep=10,nverb=5))
# Multitype Strauss hardcore with trends for each type:
beta <- c(0.0027,0.08)
tpar1 <- c(0.02,0.004,-0.0004,0.004,-0.0004) # Coefs. for log quadratic
tpar2 <- c(-0.06,0.05) # and log linear trends.
mod10 <- list(cif="straushm",par=list(beta=beta,gamma=gmma,
iradii=r,hradii=rhc),w=c(0,250,0,250),
tpar=list(tpar1,tpar2))
X1.straushm.trend <- rmh(model=mod10,start=list(n.start=350),
control=list(ptypes=c(0.75,0.25),
nrep=10,nverb=5))
# Diggle, Gates, and Stibbard:
mod11 <- list(cif="dgs",par=c(beta=3600,rho=0.08),w=c(0,1,0,1))
X.dgs <- rmh(model=mod11,start=list(n.start=300),
control=list(nrep=10,nverb=5))
# Diggle-Gratton:
mod12 <- list(cif="diggra",
par=c(beta=1800,kappa=3,delta=0.02,rho=0.04),
w=square(1))
X.diggra <- rmh(model=mod12,start=list(n.start=300),
control=list(nrep=10,nverb=5))
# Geyer:
mod13 <- list(cif="geyer",par=c(beta=1.25,gamma=1.6,r=0.2,sat=4.5),
w=c(0,10,0,10))
X1.geyer <- rmh(model=mod13,start=list(n.start=200),
control=list(nrep=10,nverb=5))
# Geyer; same as a Strauss process with parameters
# (beta=2.25,gamma=0.16,r=0.7):
mod14 <- list(cif="geyer",par=c(beta=2.25,gamma=0.4,r=0.7,sat=10000),
w=c(0,10,0,10))
X2.geyer <- rmh(model=mod14,start=list(n.start=200),
control=list(nrep=10,nverb=5))
mod15 <- list(cif="geyer",par=c(beta=8.1,gamma=2.2,r=0.08,sat=3))
data(redwood)
X3.geyer <- rmh(model=mod15,start=list(x.start=redwood),
control=list(periodic=TRUE,nrep=10,nverb=5))
# Geyer, starting from the redwood data set, simulating
# on a torus, and conditioning on n:
X4.geyer <- rmh(model=mod15,start=list(x.start=redwood),
control=list(p=1,periodic=TRUE,nrep=10,nverb=5))</testonly>
Run the code above in your browser using DataCamp Workspace