From fa3f05c0653759403de06f4ca5886939b591f834 Mon Sep 17 00:00:00 2001
From: Philippe Verley <philippe.verley@ird.fr>
Date: Thu, 7 Jul 2016 13:52:46 +0000
Subject: [PATCH] Imported ads latest version 1.5-2.2 into trunk
---
DESCRIPTION | 16 +
INDEX | 36 +
MD5 | 55 +
NAMESPACE | 8 +
R/fads.R | 1255 ++++++++
R/mimetic.R | 111 +
R/plot.fads.R | 645 ++++
R/plot.vads.R | 308 ++
R/print.fads.R | 40 +
R/print.vads.R | 72 +
R/spp.R | 266 ++
R/summary.vads.R | 53 +
R/swin.R | 231 ++
R/triangulate.R | 42 +
R/util.R | 337 ++
R/vads.R | 305 ++
data/Allogny.rda | Bin 0 -> 4415 bytes
data/BPoirier.rda | Bin 0 -> 3211 bytes
data/Couepia.rda | Bin 0 -> 2155 bytes
data/Paracou15.rda | Bin 0 -> 47601 bytes
data/demopat.rda | Bin 0 -> 1367 bytes
inst/CITATION | 20 +
man/Allogny.Rd | 27 +
man/BPoirier.Rd | 34 +
man/Couepia.Rd | 28 +
man/Paracou15.Rd | 29 +
man/area.swin.Rd | 45 +
man/demopat.Rd | 22 +
man/dval.Rd | 72 +
man/inside.swin.Rd | 42 +
man/internal.Rd | 67 +
man/k12fun.Rd | 126 +
man/k12val.Rd | 73 +
man/kdfun.Rd | 92 +
man/kfun.Rd | 100 +
man/kmfun.Rd | 89 +
man/kp.fun.Rd | 64 +
man/kpqfun.Rd | 66 +
man/krfun.Rd | 107 +
man/ksfun.Rd | 93 +
man/kval.Rd | 74 +
man/mimetic.Rd | 64 +
man/plot.fads.Rd | 66 +
man/plot.spp.Rd | 99 +
man/plot.vads.Rd | 73 +
man/spp.Rd | 113 +
man/swin.Rd | 109 +
man/triangulate.Rd | 61 +
src/Zlibs.c | 7619 ++++++++++++++++++++++++++++++++++++++++++++
src/Zlibs.h | 175 +
src/adssub.c | 349 ++
src/adssub.h | 33 +
src/spatstatsub.f | 47 +
src/triangulate.c | 2128 +++++++++++++
src/triangulate.h | 170 +
src/util.c | 80 +
56 files changed, 16236 insertions(+)
create mode 100755 DESCRIPTION
create mode 100755 INDEX
create mode 100644 MD5
create mode 100755 NAMESPACE
create mode 100755 R/fads.R
create mode 100755 R/mimetic.R
create mode 100755 R/plot.fads.R
create mode 100755 R/plot.vads.R
create mode 100755 R/print.fads.R
create mode 100755 R/print.vads.R
create mode 100755 R/spp.R
create mode 100755 R/summary.vads.R
create mode 100755 R/swin.R
create mode 100755 R/triangulate.R
create mode 100755 R/util.R
create mode 100755 R/vads.R
create mode 100755 data/Allogny.rda
create mode 100644 data/BPoirier.rda
create mode 100755 data/Couepia.rda
create mode 100755 data/Paracou15.rda
create mode 100644 data/demopat.rda
create mode 100644 inst/CITATION
create mode 100755 man/Allogny.Rd
create mode 100755 man/BPoirier.Rd
create mode 100755 man/Couepia.Rd
create mode 100755 man/Paracou15.Rd
create mode 100755 man/area.swin.Rd
create mode 100755 man/demopat.Rd
create mode 100755 man/dval.Rd
create mode 100755 man/inside.swin.Rd
create mode 100755 man/internal.Rd
create mode 100755 man/k12fun.Rd
create mode 100755 man/k12val.Rd
create mode 100755 man/kdfun.Rd
create mode 100755 man/kfun.Rd
create mode 100755 man/kmfun.Rd
create mode 100755 man/kp.fun.Rd
create mode 100755 man/kpqfun.Rd
create mode 100755 man/krfun.Rd
create mode 100755 man/ksfun.Rd
create mode 100755 man/kval.Rd
create mode 100755 man/mimetic.Rd
create mode 100755 man/plot.fads.Rd
create mode 100755 man/plot.spp.Rd
create mode 100755 man/plot.vads.Rd
create mode 100755 man/spp.Rd
create mode 100755 man/swin.Rd
create mode 100755 man/triangulate.Rd
create mode 100755 src/Zlibs.c
create mode 100755 src/Zlibs.h
create mode 100755 src/adssub.c
create mode 100755 src/adssub.h
create mode 100755 src/spatstatsub.f
create mode 100755 src/triangulate.c
create mode 100755 src/triangulate.h
create mode 100755 src/util.c
diff --git a/DESCRIPTION b/DESCRIPTION
new file mode 100755
index 0000000..cd85fe7
--- /dev/null
+++ b/DESCRIPTION
@@ -0,0 +1,16 @@
+Package: ads
+Type: Package
+Title: Spatial point patterns analysis
+Version: 1.5-2.2
+Date: 2015-01-13
+Author: R. Pelissier and F. Goreaud
+Maintainer: Raphael Pelissier <Raphael.Pelissier@ird.fr>
+Imports: ade4, spatstat
+Description: Perform first- and second-order multi-scale analyses derived from Ripley K-function, for univariate,
+ multivariate and marked mapped data in rectangular, circular or irregular shaped sampling windows, with tests of
+ statistical significance based on Monte Carlo simulations.
+License: GPL-2
+Packaged: 2015-01-13 12:09:18 UTC; root
+NeedsCompilation: yes
+Repository: CRAN
+Date/Publication: 2015-01-13 14:49:23
diff --git a/INDEX b/INDEX
new file mode 100755
index 0000000..18df450
--- /dev/null
+++ b/INDEX
@@ -0,0 +1,36 @@
+Allogny Spatial pattern of oaks suffering from frost shake in Allogny, France.
+BPoirier Tree spatial pattern in Beau Poirier plot, Haye forest, France.
+Couepia Spatial pattern of Couepia caryophylloides in Paracou, a canopy tree
+ species of French Guiana.
+demopat Artificial data point pattern from \code{spatstat} package.
+Paracou15 Spatial pattern of trees in plot 15 of Paracou experimental station,
+ French Guiana.
+area.swin Area of a sampling window.
+dval Multiscale local density of a spatial point pattern.
+inside.swin Test wether points are inside a sampling window.
+k12fun Multiscale second-order neigbourhood analysis of a bivariate spatial
+ point pattern.
+k12val Multiscale local second-order neighbour density of a bivariate spatial
+ point pattern.
+kdfun Multiscale second-order neigbourhood analysis of phylogentic/functional
+ spatial structure of a multivariate spatial point pattern.
+kfun Multiscale second-order neigbourhood analysis of an univariate spatial
+ point pattern.
+kmfun Multiscale second-order neigbourhood analysis of a marked spatial point
+ pattern.
+kp.fun (Formerly ki.fun) Multiscale second-order neigbourhood analysis of a
+ multivariate spatial point pattern.
+kpqfun (Formerly kijfun) Multiscale second-order neigbourhood analysis of a
+ multivariate spatial point pattern.
+krfun Multiscale second-order neigbourhood analysis of a multivariate spatial
+ point pattern using Rao quadratic entropy.
+ksfun Multiscale second-order neigbourhood analysis of a multivariate spatial
+ point pattern using Simpson diversity.
+kval Multiscale local second-order neighbour density of a spatial point pattern.
+mimetic Univariate point pattern replication by mimetic point process.
+plot.fads Plot second-order neigbourhood functions.
+plot.spp Plot a Spatial Point Pattern object.
+plot.vads Plot local density values.
+spp Creating a spatial point pattern.
+swin Creating a sampling window.
+triangulate Triangulate polygon.
diff --git a/MD5 b/MD5
new file mode 100644
index 0000000..a20da8f
--- /dev/null
+++ b/MD5
@@ -0,0 +1,55 @@
+2755553481e78a8f5b6ef00d43e983a5 *DESCRIPTION
+68a58538a504c7cfa73472d87053be45 *INDEX
+7478c6d745db573c9d03ebc59bdc969c *NAMESPACE
+f6aac0fb4ef187df6521cbb2d9ffc9cf *R/fads.R
+7a71372e86fd8aadfc770b261cd953ca *R/mimetic.R
+e87bd01e08a83a7b1c52b2a4a7e5df35 *R/plot.fads.R
+95d2bc01bd2779736c826a21c83b62f3 *R/plot.vads.R
+6317d29d7e9045d55b1a41906e867462 *R/print.fads.R
+d0f79442970e383cf8c3bd1677320b53 *R/print.vads.R
+c4b216a6fb57acb020f5e21682f7ed13 *R/spp.R
+96dada922fee237e190207f544de8ed3 *R/summary.vads.R
+c5d76ac2aa5f6fa68c0cfd08f197989e *R/swin.R
+34b15c6ed440f88d868d3ab3b93db3b8 *R/triangulate.R
+a322bba8d53aff07f9a8ce9a69c89aef *R/util.R
+f2c452832a53eb1ed6d168b59918d52a *R/vads.R
+31fa89b542936dac1031133b12ef530c *data/Allogny.rda
+5450b84c345240671b3410af7c70bc44 *data/BPoirier.rda
+24fea786746fc897f8918300f2f2c544 *data/Couepia.rda
+a014cac4bc9abd4f40123a762939c8ca *data/Paracou15.rda
+674867657e9a3df07b6eced02aa022a1 *data/demopat.rda
+c7cd00087730e79e06e8c0d937d0b1f7 *inst/CITATION
+94a8b147b3d2730b0c3869a7e1a2592f *man/Allogny.Rd
+1755cf31329228337e0b8039af2b6daf *man/BPoirier.Rd
+d912451f743e11a9fbe50c8a6ef13b15 *man/Couepia.Rd
+4f272a7a2e7528da43c0d2ef8685921b *man/Paracou15.Rd
+b3c89a3bcb5db0d5fc9e93d8305df8c8 *man/area.swin.Rd
+d7b568c5332aad81bf4fb9f2bd4efed7 *man/demopat.Rd
+9b09cc667ab5d522e4a3a77c8b711159 *man/dval.Rd
+cd9ec1a82e0ee4e372e7ebd9c11233e4 *man/inside.swin.Rd
+e85df8cba02e1d7ae44b447ef05f0e3f *man/internal.Rd
+18f7794bc004e9b9599486a725f7da5b *man/k12fun.Rd
+26a82fbf3be668f7c74dd4f1b9fd93e4 *man/k12val.Rd
+f4c594ec01933acd9d9cae7e797685fe *man/kdfun.Rd
+aa725a3e6b7183290f7dd758d594810c *man/kfun.Rd
+ea3edb1e20ecd5aa794f48c9fa5ee0e5 *man/kmfun.Rd
+0e606a71b6ec6f730bdd0d1498834dbc *man/kp.fun.Rd
+500b63ba993de0b1f8a7d7f92765403b *man/kpqfun.Rd
+d388b950333aad22313c76d82f51c749 *man/krfun.Rd
+9970f6e4573f2e241de12d62ab201e23 *man/ksfun.Rd
+d5d294338860db9a406208f219f05f5e *man/kval.Rd
+1037e7421f3a50f15fcb07e88dcc260c *man/mimetic.Rd
+5bff5bb53402d742900fe12ed542877b *man/plot.fads.Rd
+7e88d95ac70e452257a939a70f9a1a76 *man/plot.spp.Rd
+c30babaf1b550ec45fa0f1bd89f967e5 *man/plot.vads.Rd
+2c61afcc548ad6440240664252a645a5 *man/spp.Rd
+cfe40689a11ec983e9b9bb4b759aaa26 *man/swin.Rd
+c04839dd6cd8eb396d512260a23dc7fd *man/triangulate.Rd
+22fae7567dd07dddf2ea00cb023c2be5 *src/Zlibs.c
+109615f7005a5a6e02b98bcf1a904551 *src/Zlibs.h
+3d7a3f0a98ac75ad014cc91fbe2d0579 *src/adssub.c
+bd642dbad07c62b2f39fae4c5640f93a *src/adssub.h
+8a3dad68f1826270eef7ea08e098dfc5 *src/spatstatsub.f
+5aa9f5862ef5b0e8bbcc327021e1489a *src/triangulate.c
+e482b9d18794f53adaed3f2c98edd19a *src/triangulate.h
+fb07aec2cf6396cab654966e2757ab5c *src/util.c
diff --git a/NAMESPACE b/NAMESPACE
new file mode 100755
index 0000000..7f723b7
--- /dev/null
+++ b/NAMESPACE
@@ -0,0 +1,8 @@
+# Import external pkg names
+# import(ade4, spatstat)
+importFrom(ade4,"divc","is.euclid")
+importFrom(spatstat,"border","bounding.box.xy","area.owin")
+# Export all names (should be improved in the future)
+exportPattern(".")
+# load DLL
+useDynLib(ads)
diff --git a/R/fads.R b/R/fads.R
new file mode 100755
index 0000000..dd947c2
--- /dev/null
+++ b/R/fads.R
@@ -0,0 +1,1255 @@
+kfun<-function(p,upto,by,nsim=0,prec=0.01,alpha=0.01) {
+ # checking for input parameters
+ stopifnot(inherits(p,"spp"))
+ if(p$type!="univariate")
+ warning(paste(p$type,"point pattern has been considered to be univariate\n"))
+ stopifnot(is.numeric(upto))
+ stopifnot(upto>=1)
+ stopifnot(is.numeric(by))
+ stopifnot(by>0)
+ r<-seq(by,upto,by)
+ tmax<-length(r)
+ stopifnot(is.numeric(nsim))
+ stopifnot(nsim>=0)
+ nsim<-testInteger(nsim)
+ stopifnot(is.numeric(prec))
+ stopifnot(prec>=0)
+ stopifnot(is.numeric(alpha))
+ stopifnot(alpha>=0)
+ if(nsim>0) testIC(nsim,alpha)
+
+ if("rectangle"%in%p$window$type) {
+ cas<-1
+ xmin<-p$window$xmin
+ xmax<-p$window$xmax
+ ymin<-p$window$ymin
+ ymax<-p$window$ymax
+ stopifnot(upto<=(0.5*max((xmax-xmin),(ymax-ymin))))
+ if ("complex"%in%p$window$type) {
+ cas<-3
+ tri<-p$window$triangles
+ nbTri<-nrow(tri)
+ }
+ }
+ else if("circle"%in%p$window$type) {
+ cas<-2
+ x0<-p$window$x0
+ y0<-p$window$y0
+ r0<-p$window$r0
+ stopifnot(upto<=r0)
+ if ("complex"%in%p$window$type) {
+ cas<-4
+ tri<-p$window$triangles
+ nbTri<-nrow(tri)
+ }
+ }
+ else
+ stop("invalid window type")
+ intensity<-p$n/area.swin(p$window)
+
+ if(cas==1) { #rectangle
+ if(nsim==0) { #without CI
+ res<-.C("ripley_rect",
+ as.integer(p$n),as.double(p$x),as.double(p$y),
+ as.double(xmin),as.double(xmax),as.double(ymin),as.double(ymax),
+ as.integer(tmax),as.double(by),
+ g=double(tmax),k=double(tmax),
+ PACKAGE="ads")
+ }
+ else { #with CI
+ res<-.C("ripley_rect_ic",
+ as.integer(p$n),as.double(p$x),as.double(p$y),
+ as.double(xmin),as.double(xmax),as.double(ymin),as.double(ymax),as.double(intensity),
+ as.integer(tmax),as.double(by),
+ as.integer(nsim),as.double(prec),as.double(alpha),
+ g=double(tmax),k=double(tmax),
+ gic1=double(tmax),gic2=double(tmax),kic1=double(tmax),kic2=double(tmax),
+ gval=double(tmax),kval=double(tmax),lval=double(tmax),nval=double(tmax),
+ PACKAGE="ads")
+ }
+ }
+ else if(cas==2) { #circle
+ if(nsim==0) { #without CI
+ res<-.C("ripley_disq",
+ as.integer(p$n),as.double(p$x),as.double(p$y),
+ as.double(x0),as.double(y0),as.double(r0),
+ as.integer(tmax),as.double(by),
+ g=double(tmax),k=double(tmax),
+ PACKAGE="ads")
+ }
+ else { #with CI
+ res<-.C("ripley_disq_ic",
+ as.integer(p$n),as.double(p$x),as.double(p$y),
+ as.double(x0),as.double(y0),as.double(r0),as.double(intensity),
+ as.integer(tmax),as.double(by),
+ as.integer(nsim),as.double(prec),as.double(alpha),
+ g=double(tmax),k=double(tmax),
+ gic1=double(tmax),gic2=double(tmax),kic1=double(tmax),kic2=double(tmax),
+ gval=double(tmax),kval=double(tmax),lval=double(tmax),nval=double(tmax),
+ PACKAGE="ads")
+ }
+ }
+ else if(cas==3) { #complex within rectangle
+ if(nsim==0) { #without CI
+ res<-.C("ripley_tr_rect",
+ as.integer(p$n),as.double(p$x),as.double(p$y),
+ as.double(xmin),as.double(xmax),as.double(ymin),as.double(ymax),
+ as.integer(nbTri),as.double(tri$ax),as.double(tri$ay),as.double(tri$bx),as.double(tri$by),as.double(tri$cx),as.double(tri$cy),
+ as.integer(tmax),as.double(by),
+ g=double(tmax),k=double(tmax),
+ PACKAGE="ads")
+ }
+ else { #with CI
+ res<-.C("ripley_tr_rect_ic",
+ as.integer(p$n),as.double(p$x),as.double(p$y),
+ as.double(xmin),as.double(xmax),as.double(ymin),as.double(ymax),as.double(intensity),
+ as.integer(nbTri),as.double(tri$ax),as.double(tri$ay),as.double(tri$bx),as.double(tri$by),as.double(tri$cx),as.double(tri$cy),
+ as.integer(tmax),as.double(by),
+ as.integer(nsim),as.double(prec),as.double(alpha),
+ g=double(tmax),k=double(tmax),
+ gic1=double(tmax),gic2=double(tmax),kic1=double(tmax),kic2=double(tmax),
+ gval=double(tmax),kval=double(tmax),lval=double(tmax),nval=double(tmax),
+ PACKAGE="ads")
+ }
+ }
+ else if(cas==4) { #complex within circle
+ if(nsim==0) { #without CI
+ res<-.C("ripley_tr_disq",
+ as.integer(p$n),as.double(p$x),as.double(p$y),
+ as.double(x0),as.double(y0),as.double(r0),
+ as.integer(nbTri),as.double(tri$ax),as.double(tri$ay),as.double(tri$bx),as.double(tri$by),as.double(tri$cx),as.double(tri$cy),
+ as.integer(tmax),as.double(by),
+ g=double(tmax),k=double(tmax),
+ PACKAGE="ads")
+ }
+ else { #with CI
+ res<-.C("ripley_tr_disq_ic",
+ as.integer(p$n),as.double(p$x),as.double(p$y),
+ as.double(x0),as.double(y0),as.double(r0),as.double(intensity),
+ as.integer(nbTri),as.double(tri$ax),as.double(tri$ay),as.double(tri$bx),as.double(tri$by),as.double(tri$cx),as.double(tri$cy),
+ as.integer(tmax),as.double(by),
+ as.integer(nsim),as.double(prec),as.double(alpha),
+ g=double(tmax),k=double(tmax),
+ gic1=double(tmax),gic2=double(tmax),kic1=double(tmax),kic2=double(tmax),
+ gval=double(tmax),kval=double(tmax),lval=double(tmax),nval=double(tmax),
+ PACKAGE="ads")
+ }
+ }
+ # formatting results
+ ds<-c(pi,diff(pi*r^2))
+ g<-data.frame(obs=res$g/(intensity*ds),theo=rep(1,tmax))
+ n<-data.frame(obs=res$k/(pi*r^2),theo=rep(intensity,tmax))
+ k<-data.frame(obs=res$k/intensity,theo=pi*r^2)
+ l<-data.frame(obs=sqrt(res$k/(intensity*pi))-r,theo=rep(0,tmax))
+ if(nsim>0) {
+ g<-cbind(g,sup=res$gic1/(intensity*ds),inf=res$gic2/(intensity*ds),pval=res$gval/(nsim+1))
+ n<-cbind(n,sup=res$kic1/(pi*r^2),inf=res$kic2/(pi*r^2),pval=res$nval/(nsim+1))
+ k<-cbind(k,sup=res$kic1/intensity,inf=res$kic2/intensity,pval=res$kval/(nsim+1))
+ l<-cbind(l,sup=sqrt(res$kic1/(intensity*pi))-r,inf=sqrt(res$kic2/(intensity*pi))-r,pval=res$lval/(nsim+1))
+ }
+ call<-match.call()
+ res<-list(call=call,r=r,g=g,n=n,k=k,l=l)
+ class(res)<-c("fads","kfun")
+ return(res)
+}
+
+k12fun<-function(p,upto,by,nsim=0,H0=c("pitor","pimim","rl"),prec=0.01,nsimax=3000,conv=50,rep=10,alpha=0.01,marks) {
+ # checking for input parameters
+ options( CBoundsCheck = TRUE )
+ # regle les problemes pour 32-bit
+ stopifnot(inherits(p,"spp"))
+ stopifnot(p$type=="multivariate")
+ stopifnot(is.numeric(upto))
+ stopifnot(upto>=1)
+ stopifnot(is.numeric(by))
+ stopifnot(by>0)
+ r<-seq(by,upto,by)
+ tmax<-length(r)
+ stopifnot(is.numeric(nsim))
+ stopifnot(nsim>=0)
+ nsim<-testInteger(nsim)
+ H0<-H0[1]
+ stopifnot(H0=="pitor" || H0=="pimim" || H0=="rl")
+ if(H0=="rl") H0<-1
+ else if(H0=="pitor") H0<-2
+ else H0<-3
+ stopifnot(is.numeric(prec))
+ stopifnot(prec>=0)
+ stopifnot(is.numeric(alpha))
+ stopifnot(alpha>=0)
+ if(nsim>0) testIC(nsim,alpha)
+ if(missing(marks))
+ marks<-c(1,2)
+ stopifnot(length(marks)==2)
+ stopifnot(marks[1]!=marks[2])
+ mark1<-marks[1]
+ mark2<-marks[2]
+ if(is.numeric(mark1))
+ mark1<-levels(p$marks)[testInteger(mark1)]
+ else if(!mark1%in%p$marks) stop(paste("mark \'",mark1,"\' doesn\'t exist",sep=""))
+ if(is.numeric(mark2))
+ mark2<-levels(p$marks)[testInteger(mark2)]
+ else if(!mark2%in%p$marks) stop(paste("mark \'",mark2,"\' doesn\'t exist",sep=""))
+
+ if("rectangle"%in%p$window$type) {
+ cas<-1
+ xmin<-p$window$xmin
+ xmax<-p$window$xmax
+ ymin<-p$window$ymin
+ ymax<-p$window$ymax
+ stopifnot(upto<=(0.5*max((xmax-xmin),(ymax-ymin))))
+ if ("complex"%in%p$window$type) {
+ cas<-3
+ tri<-p$window$triangles
+ nbTri<-nrow(tri)
+ }
+ }
+ else if("circle"%in%p$window$type) {
+ cas<-2
+ x0<-p$window$x0
+ y0<-p$window$y0
+ r0<-p$window$r0
+ stopifnot(upto<=r0)
+ if ("complex"%in%p$window$type) {
+ cas<-4
+ tri<-p$window$triangles
+ nbTri<-nrow(tri)
+ }
+ }
+ else
+ stop("invalid window type")
+ surface<-area.swin(p$window)
+ x1<-p$x[p$marks==mark1]
+ y1<-p$y[p$marks==mark1]
+ x2<-p$x[p$marks==mark2]
+ y2<-p$y[p$marks==mark2]
+ nbPts1<-length(x1)
+ nbPts2<-length(x2)
+ intensity2<-nbPts2/surface
+# intensity<-(nbPts1+nbPts2)/surface
+
+ # computing intertype functions
+ if(cas==1) { #rectangle
+ if(nsim==0) { #without CI
+ res<-.C("intertype_rect",
+ as.integer(nbPts1),as.double(x1),as.double(y1),
+ as.integer(nbPts2),as.double(x2),as.double(y2),
+ as.double(xmin),as.double(xmax),as.double(ymin),as.double(ymax),
+ as.integer(tmax),as.double(by),
+ g=double(tmax),k=double(tmax),
+ PACKAGE="ads")
+ }
+ else { #with CI
+ res<-.C("intertype_rect_ic",
+ as.integer(nbPts1),as.double(x1),as.double(y1),
+ as.integer(nbPts2),as.double(x2),as.double(y2),
+ as.double(xmin),as.double(xmax),as.double(ymin),as.double(ymax),as.double(surface),
+ as.integer(tmax),as.double(by),
+ as.integer(nsim),as.integer(H0),as.double(prec),as.integer(nsimax),as.integer(conv),as.integer(rep),as.double(alpha),
+ g=double(tmax),k=double(tmax),
+ gic1=double(tmax),gic2=double(tmax),kic1=double(tmax),kic2=double(tmax),
+ gval=double(tmax),kval=double(tmax),lval=double(tmax),nval=double(tmax),
+ PACKAGE="ads")
+ }
+ }
+ else if(cas==2) { #circle
+ if(nsim==0) { #without CI
+ res<-.C("intertype_disq",
+ as.integer(nbPts1),as.double(x1),as.double(y1),
+ as.integer(nbPts2),as.double(x2),as.double(y2),
+ as.double(x0),as.double(y0),as.double(r0),
+ as.integer(tmax),as.double(by),
+ g=double(tmax),k=double(tmax),
+ PACKAGE="ads")
+ }
+ else { #with CI
+ res<-.C("intertype_disq_ic",
+ as.integer(nbPts1),as.double(x1),as.double(y1),
+ as.integer(nbPts2),as.double(x2),as.double(y2),
+ as.double(x0),as.double(y0),as.double(r0),as.double(surface),
+ as.integer(tmax),as.double(by),
+ as.integer(nsim),as.integer(H0),as.double(prec),as.integer(nsimax),as.integer(conv),as.integer(rep),as.double(alpha),
+ g=double(tmax),k=double(tmax),
+ gic1=double(tmax),gic2=double(tmax),kic1=double(tmax),kic2=double(tmax),
+ gval=double(tmax),kval=double(tmax),lval=double(tmax),nval=double(tmax),
+ PACKAGE="ads")
+ }
+ }
+ else if(cas==3) { #complex within rectangle
+ if(nsim==0) { #without CI
+ res<-.C("intertype_tr_rect",
+ as.integer(nbPts1),as.double(x1),as.double(y1),
+ as.integer(nbPts2),as.double(x2),as.double(y2),
+ as.double(xmin),as.double(xmax),as.double(ymin),as.double(ymax),
+ as.integer(nbTri),as.double(tri$ax),as.double(tri$ay),as.double(tri$bx),as.double(tri$by),as.double(tri$cx),as.double(tri$cy),
+ as.integer(tmax),as.double(by),
+ g=double(tmax),k=double(tmax),
+ PACKAGE="ads")
+ }
+ else { #with CI
+ res<-.C("intertype_tr_rect_ic",
+ as.integer(nbPts1),as.double(x1),as.double(y1),
+ as.integer(nbPts2),as.double(x2),as.double(y2),
+ as.double(xmin),as.double(xmax),as.double(ymin),as.double(ymax),as.double(surface),
+ as.integer(nbTri),as.double(tri$ax),as.double(tri$ay),as.double(tri$bx),as.double(tri$by),as.double(tri$cx),as.double(tri$cy),
+ as.integer(tmax),as.double(by),
+ as.integer(nsim),as.integer(H0),as.double(prec),as.integer(nsimax),as.integer(conv),as.integer(rep),as.double(alpha),
+ g=double(tmax),k=double(tmax),
+ gic1=double(tmax),gic2=double(tmax),kic1=double(tmax),kic2=double(tmax),
+ gval=double(tmax),kval=double(tmax),lval=double(tmax),nval=double(tmax),
+ PACKAGE="ads")
+ }
+ }
+ else if(cas==4) { #complex within circle
+ if(nsim==0) { #without CI
+ res<-.C("intertype_tr_disq",
+ as.integer(nbPts1),as.double(x1),as.double(y1),
+ as.integer(nbPts2),as.double(x2),as.double(y2),
+ as.double(x0),as.double(y0),as.double(r0),
+ as.integer(nbTri),as.double(tri$ax),as.double(tri$ay),as.double(tri$bx),as.double(tri$by),as.double(tri$cx),as.double(tri$cy),
+ as.integer(tmax),as.double(by),
+ g=double(tmax),k=double(tmax),
+ PACKAGE="ads")
+ }
+ else { #with CI
+ res<-.C("intertype_tr_disq_ic",
+ as.integer(nbPts1),as.double(x1),as.double(y1),
+ as.integer(nbPts2),as.double(x2),as.double(y2),
+ as.double(x0),as.double(y0),as.double(r0),as.double(surface),
+ as.integer(nbTri),as.double(tri$ax),as.double(tri$ay),as.double(tri$bx),as.double(tri$by),as.double(tri$cx),as.double(tri$cy),
+ as.integer(tmax),as.double(by),
+ as.integer(nsim),as.integer(H0),as.double(prec),as.integer(nsimax),as.integer(conv),as.integer(rep),as.double(alpha),
+ g=double(tmax),k=double(tmax),
+ gic1=double(tmax),gic2=double(tmax),kic1=double(tmax),kic2=double(tmax),
+ gval=double(tmax),kval=double(tmax),lval=double(tmax),nval=double(tmax),
+ PACKAGE="ads")
+ }
+ }
+ # formatting results
+ ds<-c(pi,diff(pi*r^2))
+ g<-res$g/(intensity2*ds)
+ n<-res$k/(pi*r^2)
+ k<-res$k/intensity2
+ l<-sqrt(res$k/(intensity2*pi))-r
+ if(H0==1) {
+ rip<-kfun(spp(c(x1,x2),c(y1,y2),p$window),upto,by)
+ theo<-list(g=rip$g$obs,n=intensity2*rip$k$obs/(pi*r^2),k=rip$k$obs,l=rip$l$obs)
+ }
+ else if (H0==2||H0==3)
+ theo<-list(g=rep(1,tmax),n=rep(intensity2,tmax),k=pi*r^2,l=rep(0,tmax))
+ g<-data.frame(obs=g,theo=theo$g)
+ n<-data.frame(obs=n,theo=theo$n)
+ k<-data.frame(obs=k,theo=theo$k)
+ l<-data.frame(obs=l,theo=theo$l)
+ if(nsim>0) {
+ g<-cbind(g,sup=res$gic1/(intensity2*ds),inf=res$gic2/(intensity2*ds),pval=res$gval/(nsim+1))
+ n<-cbind(n,sup=res$kic1/(pi*r^2),inf=res$kic2/(pi*r^2),pval=res$nval/(nsim+1))
+ k<-cbind(k,sup=res$kic1/intensity2,inf=res$kic2/intensity2,pval=res$kval/(nsim+1))
+ l<-cbind(l,sup=sqrt(res$kic1/(intensity2*pi))-r,inf=sqrt(res$kic2/(intensity2*pi))-r,pval=res$lval/(nsim+1))
+ }
+ call<-match.call()
+ res<-list(call=call,r=r,g12=g,n12=n,k12=k,l12=l,marks=c(mark1,mark2))
+ class(res)<-c("fads","k12fun")
+ return(res)
+}
+
+kijfun<-kpqfun<-function(p,upto,by) {
+# checking for input parameters
+ stopifnot(inherits(p,"spp"))
+ stopifnot(p$type=="multivariate")
+ stopifnot(is.numeric(upto))
+ stopifnot(upto>=1)
+ stopifnot(is.numeric(by))
+ stopifnot(by>0)
+ r<-seq(by,upto,by)
+ tmax<-length(r)
+
+ if("rectangle"%in%p$window$type) {
+ cas<-1
+ xmin<-p$window$xmin
+ xmax<-p$window$xmax
+ ymin<-p$window$ymin
+ ymax<-p$window$ymax
+ stopifnot(upto<=(0.5*max((xmax-xmin),(ymax-ymin))))
+ if ("complex"%in%p$window$type) {
+ cas<-3
+ tri<-p$window$triangles
+ nbTri<-nrow(tri)
+ }
+ }
+ else if("circle"%in%p$window$type) {
+ cas<-2
+ x0<-p$window$x0
+ y0<-p$window$y0
+ r0<-p$window$r0
+ stopifnot(upto<=r0)
+ if ("complex"%in%p$window$type) {
+ cas<-4
+ tri<-p$window$triangles
+ nbTri<-nrow(tri)
+ }
+ }
+ else
+ stop("invalid window type")
+ surface<-area.swin(p$window)
+
+ tabMarks<-levels(p$marks)
+ nbMarks<-length(tabMarks)
+ mpt_nb<-summary(p$marks)
+# computing RipleyClass
+ gij<-double(tmax*nbMarks^2)
+ kij<-double(tmax*nbMarks^2)
+ lij<-double(tmax*nbMarks^2)
+ nij<-double(tmax*nbMarks^2)
+ for(i in 1:nbMarks) {
+ x1<-p$x[p$marks==tabMarks[i]]
+ y1<-p$y[p$marks==tabMarks[i]]
+ if(cas==1) { #rectangle
+ res<-.C("ripley_rect",
+ as.integer(mpt_nb[i]),as.double(x1),as.double(y1),
+ as.double(xmin),as.double(xmax),as.double(ymin),as.double(ymax),
+ as.integer(tmax),as.double(by),
+ g=double(tmax),k=double(tmax),
+ PACKAGE="ads")
+ }
+ else if(cas==2) { #circle
+ res<-.C("ripley_disq",
+ as.integer(mpt_nb[i]),as.double(x1),as.double(y1),
+ as.double(x0),as.double(y0),as.double(r0),
+ as.integer(tmax),as.double(by),
+ g=double(tmax),k=double(tmax),
+ PACKAGE="ads")
+ }
+ else if(cas==3) { #complex within rectangle
+ res<-.C("ripley_tr_rect",
+ as.integer(mpt_nb[i]),as.double(x1),as.double(y1),
+ as.double(xmin),as.double(xmax),as.double(ymin),as.double(ymax),
+ as.integer(nbTri),as.double(tri$ax),as.double(tri$ay),as.double(tri$bx),as.double(tri$by),as.double(tri$cx),as.double(tri$cy),
+ as.integer(tmax),as.double(by),
+ g=double(tmax),k=double(tmax),
+ PACKAGE="ads")
+ }
+ else if(cas==4) { #complex within circle
+ res<-.C("ripley_tr_disq",
+ as.integer(mpt_nb[i]),as.double(x1),as.double(y1),
+ as.double(x0),as.double(y0),as.double(r0),
+ as.integer(nbTri),as.double(tri$ax),as.double(tri$ay),as.double(tri$bx),as.double(tri$by),as.double(tri$cx),as.double(tri$cy),
+ as.integer(tmax),as.double(by),
+ g=double(tmax),k=double(tmax),
+ PACKAGE="ads")
+ }
+ intensity1<-mpt_nb[i]/surface
+ matcol<-(i-1)*nbMarks+i-1
+ j<-(matcol*tmax+1):(matcol*tmax+tmax)
+ ds<-c(pi,diff(pi*r^2))
+ gij[j]<-res$g/(intensity1*ds)
+ nij[j]<-res$k/(pi*r^2)
+ kij[j]<-res$k/intensity1
+ lij[j]<-sqrt(res$k/(intensity1*pi))-r
+ if(i<nbMarks) {
+ for(j in (i+1):nbMarks) {
+ x2<-p$x[p$marks==tabMarks[j]]
+ y2<-p$y[p$marks==tabMarks[j]]
+ if(cas==1) { #rectangle
+ res<-.C("intertype_rect",
+ as.integer(mpt_nb[i]),as.double(x1),as.double(y1),
+ as.integer(mpt_nb[j]),as.double(x2),as.double(y2),
+ as.double(xmin),as.double(xmax),as.double(ymin),as.double(ymax),
+ as.integer(tmax),as.double(by),
+ g=double(tmax),k=double(tmax),
+ PACKAGE="ads")
+ }
+ else if(cas==2) { #circle
+ res<-.C("intertype_disq",
+ as.integer(mpt_nb[i]),as.double(x1),as.double(y1),
+ as.integer(mpt_nb[j]),as.double(x2),as.double(y2),
+ as.double(x0),as.double(y0),as.double(r0),
+ as.integer(tmax),as.double(by),
+ g=double(tmax),k=double(tmax),
+ PACKAGE="ads")
+ }
+ else if(cas==3) { #complex within rectangle
+ res<-.C("intertype_tr_rect",
+ as.integer(mpt_nb[i]),as.double(x1),as.double(y1),
+ as.integer(mpt_nb[j]),as.double(x2),as.double(y2),
+ as.double(xmin),as.double(xmax),as.double(ymin),as.double(ymax),
+ as.integer(nbTri),as.double(tri$ax),as.double(tri$ay),as.double(tri$bx),as.double(tri$by),as.double(tri$cx),as.double(tri$cy),
+ as.integer(tmax),as.double(by),
+ g=double(tmax),k=double(tmax),
+ PACKAGE="ads")
+ }
+ else if(cas==4) { #complex within circle
+ res<-.C("intertype_tr_disq",
+ as.integer(mpt_nb[i]),as.double(x1),as.double(y1),
+ as.integer(mpt_nb[j]),as.double(x2),as.double(y2),
+ as.double(x0),as.double(y0),as.double(r0),
+ as.integer(nbTri),as.double(tri$ax),as.double(tri$ay),as.double(tri$bx),as.double(tri$by),as.double(tri$cx),as.double(tri$cy),
+ as.integer(tmax),as.double(by),
+ g=double(tmax),k=double(tmax),
+ PACKAGE="ads")
+ }
+ intensity2<-mpt_nb[j]/surface
+ matcol<-(i-1)*nbMarks+j-1
+ k<-(matcol*tmax+1):(matcol*tmax+tmax)
+ gij[k]<-res$g/(intensity2*ds)
+ nij[k]<-res$k/(pi*r^2)
+ kij[k]<-res$k/intensity2
+ lij[k]<-sqrt(res$k/(intensity2*pi))-r
+ if(cas==1) { #rectangle
+ res<-.C("intertype_rect",
+ as.integer(mpt_nb[j]),as.double(x2),as.double(y2),
+ as.integer(mpt_nb[i]),as.double(x1),as.double(y1),
+ as.double(xmin),as.double(xmax),as.double(ymin),as.double(ymax),
+ as.integer(tmax),as.double(by),
+ g=double(tmax),k=double(tmax),
+ PACKAGE="ads")
+ }
+ else if(cas==2) { #circle
+ res<-.C("intertype_disq",
+ as.integer(mpt_nb[j]),as.double(x2),as.double(y2),
+ as.integer(mpt_nb[i]),as.double(x1),as.double(y1),
+ as.double(x0),as.double(y0),as.double(r0),
+ as.integer(tmax),as.double(by),
+ g=double(tmax),k=double(tmax),
+ PACKAGE="ads")
+ }
+ else if(cas==3) { #complex within rectangle
+ res<-.C("intertype_tr_rect",
+ as.integer(mpt_nb[j]),as.double(x2),as.double(y2),
+ as.integer(mpt_nb[i]),as.double(x1),as.double(y1),
+ as.double(xmin),as.double(xmax),as.double(ymin),as.double(ymax),
+ as.integer(nbTri),as.double(tri$ax),as.double(tri$ay),as.double(tri$bx),as.double(tri$by),as.double(tri$cx),as.double(tri$cy),
+ as.integer(tmax),as.double(by),
+ g=double(tmax),k=double(tmax),
+ PACKAGE="ads")
+ }
+ else if(cas==4) { #complex within circle
+ res<-.C("intertype_tr_disq",
+ as.integer(mpt_nb[j]),as.double(x2),as.double(y2),
+ as.integer(mpt_nb[i]),as.double(x1),as.double(y1),
+ as.double(x0),as.double(y0),as.double(r0),
+ as.integer(nbTri),as.double(tri$ax),as.double(tri$ay),as.double(tri$bx),as.double(tri$by),as.double(tri$cx),as.double(tri$cy),
+ as.integer(tmax),as.double(by),
+ g=double(tmax),k=double(tmax),
+ PACKAGE="ads")
+ }
+ matcol<-(j-1)*nbMarks+i-1
+ k<-(matcol*tmax+1):(matcol*tmax+tmax)
+ gij[k]<-res$g/(intensity1*ds)
+ nij[k]<-res$k/(pi*r^2)
+ kij[k]<-res$k/intensity1
+ lij[k]<-sqrt(res$k/(intensity1*pi))-r
+ }
+ }
+ }
+ labij<-paste(rep(tabMarks,each=nbMarks),rep(tabMarks,nbMarks),sep="-")
+ gij<-matrix(gij,nrow=tmax,ncol=nbMarks^2)
+ kij<-matrix(kij,nrow=tmax,ncol=nbMarks^2)
+ nij<-matrix(nij,nrow=tmax,ncol=nbMarks^2)
+ lij<-matrix(lij,nrow=tmax,ncol=nbMarks^2)
+ call<-match.call()
+ res<-list(call=call,r=r,labpq=labij,gij=gij,kpq=kij,lpq=lij,npq=nij,intensity=summary(p)$intensity)
+ class(res)<-c("fads","kpqfun")
+ return(res)
+}
+
+ki.fun<-kp.fun<-function(p,upto,by) {
+ # checking for input parameters
+ stopifnot(inherits(p,"spp"))
+ stopifnot(p$type=="multivariate")
+ stopifnot(is.numeric(upto))
+ stopifnot(upto>=1)
+ stopifnot(is.numeric(by))
+ stopifnot(by>0)
+ r<-seq(by,upto,by)
+ tmax<-length(r)
+
+ if("rectangle"%in%p$window$type) {
+ cas<-1
+ xmin<-p$window$xmin
+ xmax<-p$window$xmax
+ ymin<-p$window$ymin
+ ymax<-p$window$ymax
+ stopifnot(upto<=(0.5*max((xmax-xmin),(ymax-ymin))))
+ if ("complex"%in%p$window$type) {
+ cas<-3
+ tri<-p$window$triangles
+ nbTri<-nrow(tri)
+ }
+ }
+ else if("circle"%in%p$window$type) {
+ cas<-2
+ x0<-p$window$x0
+ y0<-p$window$y0
+ r0<-p$window$r0
+ stopifnot(upto<=r0)
+ if ("complex"%in%p$window$type) {
+ cas<-4
+ tri<-p$window$triangles
+ nbTri<-nrow(tri)
+ }
+ }
+ else
+ stop("invalid window type")
+ surface<-area.swin(p$window)
+
+ tabMarks<-levels(p$marks)
+ nbMarks<-length(tabMarks)
+ mpt_nb<-summary(p$marks)
+ #computing RipleyAll
+ gis<-double(tmax*nbMarks)
+ kis<-double(tmax*nbMarks)
+ lis<-double(tmax*nbMarks)
+ nis<-double(tmax*nbMarks)
+ for(i in 1:nbMarks) {
+ x1<-p$x[p$marks==tabMarks[i]]
+ y1<-p$y[p$marks==tabMarks[i]]
+ x2<-p$x[p$marks!=tabMarks[i]]
+ y2<-p$y[p$marks!=tabMarks[i]]
+ nbPts1<-mpt_nb[i]
+ nbPts2<-sum(mpt_nb)-nbPts1
+ if(cas==1) { #rectangle
+ res<-.C("intertype_rect",
+ as.integer(nbPts1),as.double(x1),as.double(y1),
+ as.integer(nbPts2),as.double(x2),as.double(y2),
+ as.double(xmin),as.double(xmax),as.double(ymin),as.double(ymax),
+ as.integer(tmax),as.double(by),
+ g=double(tmax),k=double(tmax),
+ PACKAGE="ads")
+ }
+ else if(cas==2) { #circle
+ res<-.C("intertype_disq",
+ as.integer(nbPts1),as.double(x1),as.double(y1),
+ as.integer(nbPts2),as.double(x2),as.double(y2),
+ as.double(x0),as.double(y0),as.double(r0),
+ as.integer(tmax),as.double(by),
+ g=double(tmax),k=double(tmax),
+ PACKAGE="ads")
+ }
+ else if(cas==3) { #complex within rectangle
+ res<-.C("intertype_tr_rect",
+ as.integer(nbPts1),as.double(x1),as.double(y1),
+ as.integer(nbPts2),as.double(x2),as.double(y2),
+ as.double(xmin),as.double(xmax),as.double(ymin),as.double(ymax),
+ as.integer(nbTri),as.double(tri$ax),as.double(tri$ay),as.double(tri$bx),as.double(tri$by),as.double(tri$cx),as.double(tri$cy),
+ as.integer(tmax),as.double(by),
+ g=double(tmax),k=double(tmax),
+ PACKAGE="ads")
+ }
+ else if(cas==4) { #complex within circle
+ res<-.C("intertype_tr_disq",
+ as.integer(nbPts1),as.double(x1),as.double(y1),
+ as.integer(nbPts2),as.double(x2),as.double(y2),
+ as.double(x0),as.double(y0),as.double(r0),
+ as.integer(nbTri),as.double(tri$ax),as.double(tri$ay),as.double(tri$bx),as.double(tri$by),as.double(tri$cx),as.double(tri$cy),
+ as.integer(tmax),as.double(by),
+ g=double(tmax),k=double(tmax),
+ PACKAGE="ads")
+ }
+ intensity2<-nbPts2/surface
+ j<-((i-1)*tmax+1):((i-1)*tmax+tmax)
+ ds<-c(pi,diff(pi*r^2))
+ gis[j]<-res$g/(intensity2*ds)
+ nis[j]<-res$k/(pi*r^2)
+ kis[j]<-res$k/intensity2
+ lis[j]<-sqrt(res$k/(intensity2*pi))-r
+ }
+ # formatting results
+ labi<-tabMarks
+ gis<-matrix(gis,nrow=tmax,ncol=nbMarks)
+ kis<-matrix(kis,nrow=tmax,ncol=nbMarks)
+ nis<-matrix(nis,nrow=tmax,ncol=nbMarks)
+ lis<-matrix(lis,nrow=tmax,ncol=nbMarks)
+ call<-match.call()
+ res<-list(call=call,r=r,labp=labi,gp.=gis,kp.=kis,lp.=lis,np.=nis,intensity=summary(p)$intensity)
+ class(res)<-c("fads","kp.fun")
+ return(res)
+}
+
+kmfun<-function(p,upto,by,nsim=0,alpha=0.01) {
+ # checking for input parameters
+ stopifnot(inherits(p,"spp"))
+ stopifnot(p$type=="marked")
+ stopifnot(is.numeric(upto))
+ stopifnot(upto>=1)
+ stopifnot(is.numeric(by))
+ stopifnot(by>0)
+ r<-seq(by,upto,by)
+ tmax<-length(r)
+ stopifnot(is.numeric(nsim))
+ stopifnot(nsim>=0)
+ nsim<-testInteger(nsim)
+ #cmoy<-mean(p$marks)
+ cvar<-var(p$marks)
+ stopifnot(is.numeric(alpha))
+ stopifnot(alpha>=0)
+ if(nsim>0) testIC(nsim,alpha)
+
+ if("rectangle"%in%p$window$type) {
+ cas<-1
+ xmin<-p$window$xmin
+ xmax<-p$window$xmax
+ ymin<-p$window$ymin
+ ymax<-p$window$ymax
+ stopifnot(upto<=(0.5*max((xmax-xmin),(ymax-ymin))))
+ if ("complex"%in%p$window$type) {
+ cas<-3
+ tri<-p$window$triangles
+ nbTri<-nrow(tri)
+ }
+ }
+ else if("circle"%in%p$window$type) {
+ cas<-2
+ x0<-p$window$x0
+ y0<-p$window$y0
+ r0<-p$window$r0
+ stopifnot(upto<=r0)
+ if ("complex"%in%p$window$type) {
+ cas<-4
+ tri<-p$window$triangles
+ nbTri<-nrow(tri)
+ }
+ }
+ else
+ stop("invalid window type")
+ intensity<-p$n/area.swin(p$window)
+
+ if(cas==1) { #rectangle
+ if(nsim==0) { #without CI
+ res<-.C("corr_rect",
+ as.integer(p$n),as.double(p$x),as.double(p$y),as.double(p$marks),
+ as.double(xmin),as.double(xmax),as.double(ymin),as.double(ymax),
+ as.integer(tmax),as.double(by),
+ gm=double(tmax),km=double(tmax),
+ PACKAGE="ads")
+ }
+ else { #with CI
+ res<-.C("corr_rect_ic",
+ as.integer(p$n),as.double(p$x),as.double(p$y),as.double(p$marks),
+ as.double(xmin),as.double(xmax),as.double(ymin),as.double(ymax),
+ as.integer(tmax),as.double(by),
+ as.integer(nsim),as.double(alpha),
+ gm=double(tmax),km=double(tmax),
+ gmic1=double(tmax),gmic2=double(tmax),kmic1=double(tmax),kmic2=double(tmax),
+ gmval=double(tmax),kmval=double(tmax),
+ PACKAGE="ads")
+ }
+ }
+ else if(cas==2) { #circle
+ if(nsim==0) { #without CI
+ res<-.C("corr_disq",
+ as.integer(p$n),as.double(p$x),as.double(p$y),as.double(p$marks),
+ as.double(x0),as.double(y0),as.double(r0),
+ as.integer(tmax),as.double(by),
+ gm=double(tmax),km=double(tmax),
+ PACKAGE="ads")
+ }
+ else { #with CI
+ res<-.C("corr_disq_ic",
+ as.integer(p$n),as.double(p$x),as.double(p$y),as.double(p$marks),
+ as.double(x0),as.double(y0),as.double(r0),
+ as.integer(tmax),as.double(by),
+ as.integer(nsim),as.double(alpha),
+ gm=double(tmax),km=double(tmax),
+ gmic1=double(tmax),gmic2=double(tmax),kmic1=double(tmax),kmic2=double(tmax),
+ gmval=double(tmax),kmval=double(tmax),
+ PACKAGE="ads")
+ }
+ }
+ else if(cas==3) { #complex within rectangle
+ if(nsim==0) { #without CI
+ res<-.C("corr_tr_rect",
+ as.integer(p$n),as.double(p$x),as.double(p$y),as.double(p$marks),
+ as.double(xmin),as.double(xmax),as.double(ymin),as.double(ymax),
+ as.integer(nbTri),as.double(tri$ax),as.double(tri$ay),as.double(tri$bx),as.double(tri$by),as.double(tri$cx),as.double(tri$cy),
+ as.integer(tmax),as.double(by),
+ gm=double(tmax),km=double(tmax),
+ PACKAGE="ads")
+ }
+ else { #with CI
+ res<-.C("corr_tr_rect_ic",
+ as.integer(p$n),as.double(p$x),as.double(p$y),as.double(p$marks),
+ as.double(xmin),as.double(xmax),as.double(ymin),as.double(ymax),
+ as.integer(nbTri),as.double(tri$ax),as.double(tri$ay),as.double(tri$bx),as.double(tri$by),as.double(tri$cx),as.double(tri$cy),
+ as.integer(tmax),as.double(by),
+ as.integer(nsim),as.double(alpha),
+ gm=double(tmax),km=double(tmax),
+ gmic1=double(tmax),gmic2=double(tmax),kmic1=double(tmax),kmic2=double(tmax),
+ gmval=double(tmax),kmval=double(tmax),
+ PACKAGE="ads")
+ }
+ }
+ else if(cas==4) { #complex within circle
+ if(nsim==0) { #without CI
+ res<-.C("corr_tr_disq",
+ as.integer(p$n),as.double(p$x),as.double(p$y),as.double(p$marks),
+ as.double(x0),as.double(y0),as.double(r0),
+ as.integer(nbTri),as.double(tri$ax),as.double(tri$ay),as.double(tri$bx),as.double(tri$by),as.double(tri$cx),as.double(tri$cy),
+ as.integer(tmax),as.double(by),
+ gm=double(tmax),km=double(tmax),
+ PACKAGE="ads")
+ }
+ else { #with CI
+ res<-.C("ripley_tr_disq_ic",
+ as.integer(p$n),as.double(p$x),as.double(p$y),as.double(p$marks),
+ as.double(x0),as.double(y0),as.double(r0),
+ as.integer(nbTri),as.double(tri$ax),as.double(tri$ay),as.double(tri$bx),as.double(tri$by),as.double(tri$cx),as.double(tri$cy),
+ as.integer(tmax),as.double(by),
+ as.integer(nsim),as.double(alpha),
+ gm=double(tmax),km=double(tmax),
+ gmic1=double(tmax),gmic2=double(tmax),kmic1=double(tmax),kmic2=double(tmax),
+ gmval=double(tmax),kmval=double(tmax),
+ PACKAGE="ads")
+ }
+ }
+ # formatting results
+ gm<-data.frame(obs=res$gm,theo=rep(0,tmax))
+ km<-data.frame(obs=res$km,theo=rep(0,tmax))
+ if(nsim>0) {
+ gm<-cbind(gm,sup=res$gmic1,inf=res$gmic2,pval=res$gmval/(nsim+1))
+ km<-cbind(km,sup=res$kmic1,inf=res$kmic2,pval=res$kmval/(nsim+1))
+ }
+ call<-match.call()
+ res<-list(call=call,r=r,gm=gm,km=km)
+ class(res)<-c("fads","kmfun")
+ return(res)
+}
+
+ksfun<-function(p,upto,by,nsim=0,alpha=0.01) {
+# checking for input parameters
+ #options( CBoundsCheck = TRUE )
+ stopifnot(inherits(p,"spp"))
+ stopifnot(p$type=="multivariate")
+ stopifnot(is.numeric(upto))
+ stopifnot(upto>=1)
+ stopifnot(is.numeric(by))
+ stopifnot(by>0)
+ r<-seq(by,upto,by)
+ tmax<-length(r)
+ stopifnot(is.numeric(nsim))
+ stopifnot(nsim>=0)
+ nsim<-testInteger(nsim)
+ stopifnot(is.numeric(alpha))
+ stopifnot(alpha>=0)
+ if(nsim>0) testIC(nsim,alpha)
+
+###faire test sur les marks
+
+ if("rectangle"%in%p$window$type) {
+ cas<-1
+ xmin<-p$window$xmin
+ xmax<-p$window$xmax
+ ymin<-p$window$ymin
+ ymax<-p$window$ymax
+ stopifnot(upto<=(0.5*max((xmax-xmin),(ymax-ymin))))
+ if ("complex"%in%p$window$type) {
+ cas<-3
+ tri<-p$window$triangles
+ nbTri<-nrow(tri)
+ }
+ }
+ else if("circle"%in%p$window$type) {
+ cas<-2
+ x0<-p$window$x0
+ y0<-p$window$y0
+ r0<-p$window$r0
+ stopifnot(upto<=r0)
+ if ("complex"%in%p$window$type) {
+ cas<-4
+ tri<-p$window$triangles
+ nbTri<-nrow(tri)
+ }
+ }
+ else
+ stop("invalid window type")
+ surface<-area.swin(p$window)
+ intensity<-p$n/surface
+ tabMarks<-levels(p$marks)
+ nbMarks<-nlevels(p$marks)
+#nbMarks<-length(tabMarks)
+ marks<-as.numeric(p$marks)
+ freq<-as.vector(table(p$marks))
+ D<-1-sum(freq*(freq-1))/(p$n*(p$n-1))
+
+# computing Shimatani
+ if(cas==1) { #rectangle
+ if(nsim==0) { #without CI
+ res<-.C("shimatani_rect",
+ as.integer(p$n),as.double(p$x),as.double(p$y),
+ as.double(xmin),as.double(xmax),as.double(ymin),as.double(ymax),
+ as.integer(tmax),as.double(by),
+ as.integer(nbMarks),as.integer(marks),as.double(surface),gg=double(tmax),kk=double(tmax),erreur=integer(tmax),
+ PACKAGE="ads")
+ }
+ else { #with CI
+ res<-.C("shimatani_rect_ic",
+ as.integer(p$n),as.double(p$x),as.double(p$y),as.double(xmin),as.double(xmax),as.double(ymin),as.double(ymax),
+ as.integer(tmax),as.double(by), as.integer(nsim), as.double(alpha),
+ as.integer(nbMarks),as.integer(marks),as.double(surface),as.double(D),
+ gg=double(tmax),kk=double(tmax),gic1=double(tmax),gic2=double(tmax),kic1=double(tmax),kic2=double(tmax),
+ gval=double(tmax),kval=double(tmax),erreur=integer(tmax),
+ PACKAGE="ads")
+ }
+ }
+ else if(cas==2) { #circle
+ if(nsim==0) { #without CI
+ res<-.C("shimatani_disq",
+ as.integer(p$n),as.double(p$x),as.double(p$y),
+ as.double(x0),as.double(y0),as.double(r0),
+ as.integer(tmax),as.double(by),
+ as.integer(nbMarks),as.integer(marks),as.double(surface),gg=double(tmax),kk=double(tmax),erreur=integer(tmax),
+ PACKAGE="ads")
+ }
+ else { #with CI
+ res<-.C("shimatani_disq_ic",
+ as.integer(p$n),as.double(p$x),as.double(p$y),as.double(x0),as.double(y0),as.double(r0),
+ as.integer(tmax),as.double(by), as.integer(nsim), as.double(alpha),
+ as.integer(nbMarks),as.integer(marks),as.double(surface),as.double(D),
+ gg=double(tmax),kk=double(tmax),gic1=double(tmax),gic2=double(tmax),kic1=double(tmax),kic2=double(tmax),
+ gval=double(tmax),kval=double(tmax),erreur=integer(tmax),
+ PACKAGE="ads")
+ }
+ }
+ else if(cas==3) { #complex within rectangle
+ if(nsim==0) { #without CI
+ res<-.C("shimatani_tr_rect",
+ as.integer(p$n),as.double(p$x),as.double(p$y),
+ as.double(xmin),as.double(xmax),as.double(ymin),as.double(ymax),
+ as.integer(nbTri),as.double(tri$ax),as.double(tri$ay),as.double(tri$bx),as.double(tri$by),as.double(tri$cx),as.double(tri$cy),
+ as.integer(tmax),as.double(by),
+ as.integer(nbMarks),as.integer(marks),as.double(surface),gg=double(tmax),kk=double(tmax),erreur=integer(tmax),
+ PACKAGE="ads")
+ }
+ else { #with CI
+ res<-.C("shimatani_tr_rect_ic",
+ as.integer(p$n),as.double(p$x),as.double(p$y),as.double(xmin),as.double(xmax),as.double(ymin),as.double(ymax),
+ as.integer(nbTri),as.double(tri$ax),as.double(tri$ay),as.double(tri$bx),as.double(tri$by),as.double(tri$cx),as.double(tri$cy),
+ as.integer(tmax),as.double(by), as.integer(nsim), as.double(alpha),
+ as.integer(nbMarks),as.integer(marks),as.double(surface),as.double(D),
+ gg=double(tmax),kk=double(tmax),gic1=double(tmax),gic2=double(tmax),kic1=double(tmax),kic2=double(tmax),
+ gval=double(tmax),kval=double(tmax),erreur=integer(tmax),
+ PACKAGE="ads")
+ }
+ }
+ else if(cas==4) { #complex within circle
+ if(nsim==0) { #without CI
+ res<-.C("shimatani_tr_disq",
+ as.integer(p$n),as.double(p$x),as.double(p$y),
+ as.double(x0),as.double(y0),as.double(r0),
+ as.integer(nbTri),as.double(tri$ax),as.double(tri$ay),as.double(tri$bx),as.double(tri$by),as.double(tri$cx),as.double(tri$cy),
+ as.integer(tmax),as.double(by),
+ as.integer(nbMarks),as.integer(marks),as.double(surface),gg=double(tmax),kk=double(tmax),erreur=integer(tmax),
+ PACKAGE="ads")
+ }
+ else { #with CI
+ res<-.C("shimatani_tr_disq_ic",
+ as.integer(p$n),as.double(p$x),as.double(p$y),as.double(x0),as.double(y0),as.double(r0),
+ as.integer(nbTri),as.double(tri$ax),as.double(tri$ay),as.double(tri$bx),as.double(tri$by),as.double(tri$cx),as.double(tri$cy),
+ as.integer(tmax),as.double(by), as.integer(nsim), as.double(alpha),
+ as.integer(nbMarks),as.integer(marks),as.double(surface),as.double(D),
+ gg=double(tmax),kk=double(tmax),gic1=double(tmax),gic2=double(tmax),kic1=double(tmax),kic2=double(tmax),
+ gval=double(tmax),kval=double(tmax),erreur=integer(tmax),
+ PACKAGE="ads")
+ }
+ }
+ if(sum(res$erreur>0)){
+ message("Error in ", appendLF=F)
+ print(match.call())
+ message("No neigbors within distance intervals:")
+ print(paste(by*(res$erreur[res$erreur>0]-1),"-",by*res$erreur[res$erreur>0]))
+ message("Increase argument 'by'")
+ return(res=NULL)
+ }
+ gs<-data.frame(obs=res$gg/D,theo=rep(1,tmax))
+ ks<-data.frame(obs=res$kk/D,theo=rep(1,tmax))
+ if(nsim>0) {
+ gs<-cbind(gs,sup=res$gic1/D,inf=res$gic2/D,pval=res$gval/(nsim+1))
+ ks<-cbind(ks,sup=res$kic1/D,inf=res$kic2/D,pval=res$kval/(nsim+1))
+ }
+ call<-match.call()
+ res<-list(call=call,r=r,gs=gs,ks=ks)
+ class(res)<-c("fads","ksfun")
+ return(res)
+}
+
+
+#################
+#V2 that calls K12fun
+##############
+krfun<-function(p,upto,by,nsim=0,dis=NULL,H0=c("rl","se"),alpha=0.01) {
+# checking for input parameters
+ stopifnot(inherits(p,"spp"))
+ stopifnot(p$type=="multivariate")
+ stopifnot(is.numeric(upto))
+ stopifnot(upto>=1)
+ stopifnot(is.numeric(by))
+ stopifnot(by>0)
+ r<-seq(by,upto,by)
+ tmax<-length(r)
+ H0<-H0[1]
+ stopifnot(H0=="se" || H0=="rl")
+ ifelse(H0=="se",H0<-2,H0<-1)
+ if(is.null(dis)) {
+ stopifnot(H0==1)
+ dis<-as.dist(matrix(1,nlevels(p$marks),nlevels(p$marks)))
+ attr(dis,"Labels")<-levels(p$marks)
+ }
+ stopifnot(inherits(dis,"dist"))
+ stopifnot(attr(dis,"Diag")==FALSE)
+ stopifnot(attr(dis,"Upper")==FALSE)
+ stopifnot(suppressWarnings(is.euclid(dis)))
+###revoir tests sur dis
+ if(length(levels(p$marks))!=length(labels(dis))) {
+ stopifnot(all(levels(p$marks)%in%labels(dis)))
+#dis<-subsetdist(dis,which(labels(dis)%in%levels(p$marks)))
+ dis<-subsetdist(dis,levels(p$marks))
+ warning("matrix 'dis' have been subsetted to match with levels(p$marks)")
+ }
+#else if(any(labels(dis)!=levels(p$marks))) {
+# attr(dis,"Labels")<-levels(p$marks)
+# warning("levels(p$marks) have been assigned to attr(dis, ''Labels'')")
+# }
+ stopifnot(is.numeric(nsim))
+ stopifnot(nsim>=0)
+ nsim<-testInteger(nsim)
+ stopifnot(is.numeric(alpha))
+ stopifnot(alpha>=0)
+ if(nsim>0) testIC(nsim,alpha)
+
+###faire test sur les marks
+
+ if("rectangle"%in%p$window$type) {
+ cas<-1
+ xmin<-p$window$xmin
+ xmax<-p$window$xmax
+ ymin<-p$window$ymin
+ ymax<-p$window$ymax
+ stopifnot(upto<=(0.5*max((xmax-xmin),(ymax-ymin))))
+ if ("complex"%in%p$window$type) {
+ cas<-3
+ tri<-p$window$triangles
+ nbTri<-nrow(tri)
+ }
+ }
+ else if("circle"%in%p$window$type) {
+ cas<-2
+ x0<-p$window$x0
+ y0<-p$window$y0
+ r0<-p$window$r0
+ stopifnot(upto<=r0)
+ if ("complex"%in%p$window$type) {
+ cas<-4
+ tri<-p$window$triangles
+ nbTri<-nrow(tri)
+ }
+ }
+ else
+ stop("invalid window type")
+ surface<-area.swin(p$window)
+ intensity<-p$n/surface
+ nbMarks<-nlevels(p$marks)
+ marks<-as.numeric(p$marks) # => position du label dans levels(p$marks)
+ dis<-as.dist(sortmat(dis,levels(p$marks)))
+ HD<-suppressWarnings(divc(as.data.frame(unclass(table(p$marks))),sqrt(2*dis),scale=F)[1,1])
+ HD<-HD*p$n/(p$n-1)
+ dis<-as.vector(dis)
+
+# computing Rao
+ if(cas==1) { #rectangle
+ if(nsim==0) { #without CI
+ res<-.C("rao_rect",
+ as.integer(p$n),as.double(p$x),as.double(p$y),
+ as.double(xmin),as.double(xmax),as.double(ymin),as.double(ymax),
+ as.integer(tmax),as.double(by),as.integer(H0),
+ as.integer(nbMarks),as.integer(marks),as.double(dis),as.double(surface),as.double(HD),
+ gg=double(tmax),kk=double(tmax),gs=double(tmax),ks=double(tmax),erreur=integer(tmax),
+ PACKAGE="ads")
+ }
+ else { #with CI
+ res<-.C("rao_rect_ic",
+ as.integer(p$n),as.double(p$x),as.double(p$y),as.double(xmin),as.double(xmax),as.double(ymin),as.double(ymax),
+ as.integer(tmax),as.double(by), as.integer(nsim),as.integer(H0),as.double(alpha),
+ as.integer(nbMarks),as.integer(marks),as.double(dis),as.double(surface),as.double(HD),
+ gg=double(tmax),kk=double(tmax),gs=double(tmax),ks=double(tmax),gic1=double(tmax),gic2=double(tmax),kic1=double(tmax),kic2=double(tmax),
+ gval=double(tmax),kval=double(tmax),erreur=integer(tmax),
+ PACKAGE="ads")
+ }
+ }
+ else if(cas==2) { #circle
+ if(nsim==0) { #without CI
+ res<-.C("rao_disq",
+ as.integer(p$n),as.double(p$x),as.double(p$y),
+ as.double(x0),as.double(y0),as.double(r0),
+ as.integer(tmax),as.double(by),as.integer(H0),
+ as.integer(nbMarks),as.integer(marks),as.double(dis),as.double(surface),as.double(HD),
+ gg=double(tmax),kk=double(tmax),gs=double(tmax),ks=double(tmax),erreur=integer(tmax),
+ PACKAGE="ads")
+ }
+ else { #with CI
+ res<-.C("rao_disq_ic",
+ as.integer(p$n),as.double(p$x),as.double(p$y),as.double(x0),as.double(y0),as.double(r0),
+ as.integer(tmax),as.double(by), as.integer(nsim),as.integer(H0),as.double(alpha),
+ as.integer(nbMarks),as.integer(marks),as.double(dis),as.double(surface),as.double(HD),
+ gg=double(tmax),kk=double(tmax),gs=double(tmax),ks=double(tmax),gic1=double(tmax),gic2=double(tmax),kic1=double(tmax),kic2=double(tmax),
+ gval=double(tmax),kval=double(tmax),erreur=integer(tmax),
+ PACKAGE="ads")
+ }
+ }
+ else if(cas==3) { #complex within rectangle
+ if(nsim==0) { #without CI
+ res<-.C("rao_tr_rect",
+ as.integer(p$n),as.double(p$x),as.double(p$y),
+ as.double(xmin),as.double(xmax),as.double(ymin),as.double(ymax),
+ as.integer(nbTri),as.double(tri$ax),as.double(tri$ay),as.double(tri$bx),as.double(tri$by),as.double(tri$cx),as.double(tri$cy),
+ as.integer(tmax),as.double(by),as.integer(H0),
+ as.integer(nbMarks),as.integer(marks),as.double(dis),as.double(surface),as.double(HD),
+ gg=double(tmax),kk=double(tmax),gs=double(tmax),ks=double(tmax),erreur=integer(tmax),
+ PACKAGE="ads")
+ }
+ else { #with CI
+ res<-.C("rao_tr_rect_ic",
+ as.integer(p$n),as.double(p$x),as.double(p$y),
+ as.double(xmin),as.double(xmax),as.double(ymin),as.double(ymax),
+ as.integer(nbTri),as.double(tri$ax),as.double(tri$ay),as.double(tri$bx),as.double(tri$by),as.double(tri$cx),as.double(tri$cy),
+ as.integer(tmax),as.double(by),as.integer(nsim), as.integer(H0),as.double(alpha),
+ as.integer(nbMarks),as.integer(marks),as.double(dis),as.double(surface),as.double(HD),
+ gg=double(tmax),kk=double(tmax),gs=double(tmax),ks=double(tmax),gic1=double(tmax),gic2=double(tmax),kic1=double(tmax),kic2=double(tmax),
+ gval=double(tmax),kval=double(tmax),erreur=integer(tmax),
+ PACKAGE="ads")
+ }
+ }
+ else if(cas==4) { #complex within circle
+ if(nsim==0) { #without CI
+ res<-.C("rao_tr_disq",
+ as.integer(p$n),as.double(p$x),as.double(p$y),
+ as.double(x0),as.double(y0),as.double(r0),
+ as.integer(nbTri),as.double(tri$ax),as.double(tri$ay),as.double(tri$bx),as.double(tri$by),as.double(tri$cx),as.double(tri$cy),
+ as.integer(tmax),as.double(by),as.integer(H0),
+ as.integer(nbMarks),as.integer(marks),as.double(dis),as.double(surface),as.double(HD),
+ gg=double(tmax),kk=double(tmax),gs=double(tmax),ks=double(tmax),erreur=integer(tmax),
+ PACKAGE="ads")
+ }
+ else { #with CI (not based on K12)
+ res<-.C("rao_tr_disq_ic",
+ as.integer(p$n),as.double(p$x),as.double(p$y),
+ as.double(x0),as.double(y0),as.double(r0),
+ as.integer(nbTri),as.double(tri$ax),as.double(tri$ay),as.double(tri$bx),as.double(tri$by),as.double(tri$cx),as.double(tri$cy),
+ as.integer(tmax),as.double(by),as.integer(nsim), as.integer(H0),as.double(alpha),
+ as.integer(nbMarks),as.integer(marks),as.double(dis),as.double(surface),as.double(HD),
+ gg=double(tmax),kk=double(tmax),gs=double(tmax),ks=double(tmax),gic1=double(tmax),gic2=double(tmax),kic1=double(tmax),kic2=double(tmax),
+ gval=double(tmax),kval=double(tmax),serreur=integer(tmax),
+ PACKAGE="ads")
+ }
+ }
+ if(sum(res$erreur>0)){
+ message("Error in ", appendLF=F)
+ print(match.call())
+ message("No neigbors within distance intervals:")
+ print(paste(by*(res$erreur[res$erreur>0]-1),"-",by*res$erreur[res$erreur>0]))
+ message("Increase argument 'by'")
+ return(res=NULL)
+ }
+ if(H0==1) {
+ theog<-rep(1,tmax)
+ theok<-rep(1,tmax)
+ }
+ if(H0==2) {
+ theog<-res$gs
+ theok<-res$ks
+ }
+ gr<-data.frame(obs=res$gg,theo=theog)
+ kr<-data.frame(obs=res$kk,theo=theok)
+ if(nsim>0) {
+ gr<-cbind(gr,sup=res$gic1,inf=res$gic2,pval=res$gval/(nsim+1))
+ kr<-cbind(kr,sup=res$kic1,inf=res$kic2,pval=res$kval/(nsim+1))
+ }
+ call<-match.call()
+ res<-list(call=call,r=r,gr=gr,kr=kr)
+ class(res)<-c("fads","krfun")
+ return(res)
+}
+
+kdfun<-function(p,upto,by,dis,nsim=0,alpha=0.01) {
+# checking for input parameters
+ stopifnot(inherits(p,"spp"))
+ stopifnot(p$type=="multivariate")
+ if(min(p$x)<0)
+ p$x<-p$x+abs(min(p$x))
+ if(min(p$y)<0)
+ p$y<-p$y+abs(min(p$y))
+ stopifnot(is.numeric(upto))
+ stopifnot(upto>=1)
+ stopifnot(is.numeric(by))
+ stopifnot(by>0)
+ r<-seq(by,upto,by)
+ tmax<-length(r)
+ stopifnot(inherits(dis,"dist"))
+ stopifnot(attr(dis,"Diag")==FALSE)
+ stopifnot(attr(dis,"Upper")==FALSE)
+ stopifnot(suppressWarnings(is.euclid(dis)))
+###revoir tests sur dis
+ if(length(levels(p$marks))!=length(labels(dis))) {
+ stopifnot(all(levels(p$marks)%in%labels(dis)))
+#dis<-subsetdist(dis,which(labels(dis)%in%levels(p$marks)))
+ dis<-subsetdist(dis,levels(p$marks))
+ warning("matrix 'dis' have been subsetted to match with levels(p$marks)")
+ }
+#else if(any(labels(dis)!=levels(p$marks))) {
+# attr(dis,"Labels")<-levels(p$marks)
+# warning("levels(p$marks) have been assigned to attr(dis, ''Labels'')")
+# }
+ stopifnot(is.numeric(nsim))
+ stopifnot(nsim>=0)
+ nsim<-testInteger(nsim)
+ stopifnot(is.numeric(alpha))
+ stopifnot(alpha>=0)
+ if(nsim>0) testIC(nsim,alpha)
+
+ surface<-area.swin(p$window)
+ intensity<-p$n/surface
+ nbMarks<-nlevels(p$marks)
+ marks<-as.numeric(p$marks) # => position du label dans levels(p$marks)
+ dis<-as.dist(sortmat(dis,levels(p$marks)))
+ HD<-suppressWarnings(divc(as.data.frame(unclass(table(p$marks))),sqrt(2*dis),scale=F)[1,1])
+ HD<-HD*p$n/(p$n-1)
+ dis<-as.vector(dis)
+
+###faire test sur les marks
+
+ if(nsim==0) { #without CI
+ res<-.C("shen",
+ as.integer(p$n),as.double(p$x),as.double(p$y),
+ as.integer(tmax),as.double(by),
+ as.integer(nbMarks),as.integer(marks),as.double(dis),as.double(surface),as.double(HD),
+ gd=double(tmax),kd=double(tmax),erreur=integer(tmax),
+ PACKAGE="ads")
+ }
+ else { #with CI
+ res<-.C("shen_ic",
+ as.integer(p$n),as.double(p$x),as.double(p$y),
+ as.integer(tmax),as.double(by), as.integer(nsim),as.double(alpha),
+ as.integer(nbMarks),as.integer(marks),as.double(dis),as.double(surface),as.double(HD),
+ gd=double(tmax),kd=double(tmax),gic1=double(tmax),gic2=double(tmax),kic1=double(tmax),kic2=double(tmax),
+ gval=double(tmax),kval=double(tmax),erreur=integer(tmax),
+ PACKAGE="ads")
+ }
+
+ if(sum(res$erreur>0)){
+ message("Error in ", appendLF=F)
+ print(match.call())
+ message("No neigbors within distance intervals:")
+ print(paste(by*(res$erreur[res$erreur>0]-1),"-",by*res$erreur[res$erreur>0]))
+ message("Increase argument 'by'")
+ return(res=NULL)
+ }
+ gd<-data.frame(obs=res$gd,theo=rep(1,tmax))
+ kd<-data.frame(obs=res$kd,theo=rep(1,tmax))
+ if(nsim>0) {
+ gd<-cbind(gd,sup=res$gic1,inf=res$gic2,pval=res$gval/(nsim+1))
+ kd<-cbind(kd,sup=res$kic1,inf=res$kic2,pval=res$kval/(nsim+1))
+ }
+ call<-match.call()
+ res<-list(call=call,r=r,gd=gd,kd=kd)
+ class(res)<-c("fads","kdfun")
+ return(res)
+}
diff --git a/R/mimetic.R b/R/mimetic.R
new file mode 100755
index 0000000..c428df8
--- /dev/null
+++ b/R/mimetic.R
@@ -0,0 +1,111 @@
+#mimetic point process as in Goreaud et al. 2004
+#RP 11/06/2013
+###################################################
+
+mimetic<-function(x,upto=NULL,by=NULL,prec=NULL,nsimax=3000,conv=50) {
+# checking for input parameters
+ stopifnot(inherits(x,"fads")||inherits(x,"spp"))
+ if(inherits(x,"fads")) {
+ call<-x$call
+ p<-eval(call[[2]])
+ upto<-call[[3]]
+ by<-call[[4]]
+ if(length(call)==6)
+ prec<-call[[6]]
+ else
+ prec<-0.01
+ lobs<-x$l$obs
+ r<-x$r
+ linit<-x
+ }
+ else if(inherits(x,"spp")) {
+ p<-x
+ if(is.null(prec))
+ prec<-0.01
+ else
+ prec<-prec
+ linit<-kfun(p=p,upto=upto,by=by,nsim=0,prec=prec)
+ lobs<-linit$l$obs
+ r<-linit$r
+ }
+ surface<-area.swin(p$window)
+ tmax<-length(r)
+#lobs<-lobs+r
+ if("rectangle"%in%p$window$type) {
+ xmin<-p$window$xmin
+ xmax<-p$window$xmax
+ ymin<-p$window$ymin
+ ymax<-p$window$ymax
+ stopifnot(upto<=(0.5*max((xmax-xmin),(ymax-ymin))))
+ if ("complex"%in%p$window$type) {
+ tri<-p$window$triangles
+ nbTri<-nrow(tri)
+ res<-.C("mimetic_tr_rect",
+ as.integer(p$n),as.double(p$x),as.double(p$y),as.double(surface),
+ as.double(xmin),as.double(xmax),as.double(ymin),as.double(ymax),
+ as.integer(nbTri),as.double(tri$ax),as.double(tri$ay),as.double(tri$bx),as.double(tri$by),as.double(tri$cx),as.double(tri$cy),
+ as.double(prec),as.integer(tmax),as.double(by),
+ as.double(lobs),as.integer(nsimax),as.integer(conv),cost=double(nsimax),
+ g=double(tmax),k=double(tmax),xx=double(p$n),yy=double(p$n),mess=as.integer(1),
+ PACKAGE="ads")
+ }
+ else {
+ res<-.C("mimetic_rect",
+ as.integer(p$n),as.double(p$x),as.double(p$y),as.double(surface),
+ as.double(xmin),as.double(xmax),as.double(ymin),as.double(ymax),
+ as.double(prec),as.integer(tmax),as.double(by),
+ as.double(lobs),as.integer(nsimax),as.integer(conv),cost=double(nsimax),
+ g=double(tmax),k=double(tmax),xx=double(p$n),yy=double(p$n),mess=as.integer(1),
+ PACKAGE="ads")
+ }
+ }
+ else if("circle"%in%p$window$type) {
+ x0<-p$window$x0
+ y0<-p$window$y0
+ r0<-p$window$r0
+ stopifnot(upto<=r0)
+ if ("complex"%in%p$window$type) {
+ tri<-p$window$triangles
+ nbTri<-nrow(tri)
+ res<-.C("mimetic_tr_disq",
+ as.integer(p$n),as.double(p$x),as.double(p$y),as.double(surface),
+ as.double(x0),as.double(y0),as.double(r0),
+ as.integer(nbTri),as.double(tri$ax),as.double(tri$ay),as.double(tri$bx),as.double(tri$by),as.double(tri$cx),as.double(tri$cy),
+ as.double(prec),as.integer(tmax),as.double(by),
+ as.double(lobs),as.integer(nsimax),as.integer(conv),cost=double(nsimax),
+ g=double(tmax),k=double(tmax),xx=double(p$n),yy=double(p$n),mess=as.integer(1),
+ PACKAGE="ads")
+ }
+ else {
+ res<-.C("mimetic_disq",
+ as.integer(p$n),as.double(p$x),as.double(p$y),as.double(surface),
+ as.double(x0),as.double(y0),as.double(r0),as.double(prec),as.integer(tmax),as.double(by),
+ as.double(lobs),as.integer(nsimax),as.integer(conv),cost=double(nsimax),
+ g=double(tmax),k=double(tmax),xx=double(p$n),yy=double(p$n),mess=as.integer(1),
+ PACKAGE="ads")
+ }
+ }
+ else
+ stop("invalid window type")
+ psim<-spp(res$x,res$y,window=p$window)
+ lsim<-kfun(psim,upto,by,nsim=0,prec)
+ cost<-res$cost
+ call<-match.call()
+ l<-data.frame(obs=linit$l$obs,sim=lsim$l$obs)
+ fads<-list(r=lsim$r,l=l)
+ class(fads)<-c("fads","mimetic")
+ res<-list(call=call,fads=fads,spp=psim,cost=cost[cost>0])
+ class(res)<-c("mimetic")
+ return(res)
+}
+
+plot.mimetic<-function (x,cols,lty,main,sub,legend=TRUE,csize=1,cex.main=1.5,pos="top",...) {
+ def.par <- par(no.readonly = TRUE)
+ on.exit(par(def.par))
+ mylayout<-layout(matrix(c(1,1,2,3,2,3),ncol=2,byrow=TRUE))
+ main<-deparse(x$call,width.cutoff=100)
+ plot.fads.mimetic(x$fads,main=main,cex.main=1.5*csize,pos=pos,...)
+ plot(x$spp,main="x$spp (simulated)",cex.main=csize,...)
+ barplot(x$cost,main=paste("x$cost (nsim=",length(x$cost),")",sep=""),cex.main=csize,...)
+
+}
\ No newline at end of file
diff --git a/R/plot.fads.R b/R/plot.fads.R
new file mode 100755
index 0000000..badaf43
--- /dev/null
+++ b/R/plot.fads.R
@@ -0,0 +1,645 @@
+plot.fads<-function (x,opt,cols,lty,main,sub,legend,csize,...) {
+ UseMethod("plot.fads")
+}
+
+plot.fads.kfun<-function (x,opt=c("all","L","K","n","g"),cols,lty,main,sub,legend=TRUE,csize=1,...) {
+ ifelse(!is.null(x$call$nsim)&&(x$call$nsim>0),ci<-TRUE,ci<-FALSE)
+ def.par <- par(no.readonly = TRUE)
+ on.exit(par(def.par))
+ #if(options()$device=="windows")
+ # csize<-0.75*csize
+ opt<-opt[1]
+ if(opt=="all")
+ mylayout<-layout(matrix(c(1,1,1,1,2,2,3,3,2,2,3,3,4,4,5,5,4,4,5,5),ncol=4,byrow=TRUE))
+ else if(opt%in%c("L","K","n","g"))
+ mylayout<-layout(matrix(c(1,1,1,1,rep(2,16)),ncol=4,byrow=TRUE))
+ else
+ stopifnot(opt%in%c("all","L","K","n","g"))
+ if(missing(cols))
+ cols=c(1,2,3)
+ else if(length(cols)!=3)
+ cols=c(cols,cols,cols)
+ if(missing(lty))
+ lty=c(1,3,2)
+ else if(length(lty)!=3)
+ lty=c(lty,lty,lty)
+ if(missing(main))
+ main<-deparse(x$call,width.cutoff=100)
+ if(missing(sub))
+ sub<-c("pair density function","second-order neighbour density function","Ripley's K-function","L-function : sqrt[K(r)/pi]-r")
+ if(ci) {
+ alpha<-x$call[["alpha"]]
+ p<-ifelse(!is.null(alpha),signif(100*(1-alpha),digits=6),99)
+ par(mar=c(0.1,0.1,0.1,0.1),cex=csize)
+ plot(x$r,x$g$obs/2,type="n",axes=FALSE,xlab="",ylab="")
+ if(legend)
+ legend("center",c("obs","theo (CSR)",paste(p,"% CI of CSR")),cex=1.5,lty=lty[1:3],bty="n",horiz=TRUE,title=main,col=cols[1:3],...)
+ else
+ legend("center","",cex=1.5,bty="n",horiz=TRUE,title=main,...)
+ par(mar=c(5,5,0.1,2),cex=ifelse(opt%in%c("all"),0.75*csize,csize))
+ if(opt%in%c("all","g")) { # g-function
+ lim<-range(x$g[,1:4])
+ plot(x$r,x$g$obs,ylim=c(lim[1],lim[2]+0.1*diff(lim)),main=paste("\n\n",sub[1]),type="n",xlab="distance (r)",ylab="g(r)",cex.lab=1.25,...)
+ lines(x$r,x$g$obs,lty=lty[1],col=cols[1],...)
+ lines(x$r,x$g$theo,lty=lty[2],col=cols[2],...)
+ lines(x$r,x$g$sup,lty=lty[3],col=cols[3],...)
+ lines(x$r,x$g$inf,lty=lty[3],col=cols[3],...)
+ }
+ if(opt%in%c("all","n")) {# n-function
+ lim<-range(x$n[,1:4])
+ plot(x$r,x$n$obs,ylim=c(lim[1],lim[2]+0.1*diff(lim)),main=paste("\n\n",sub[2]),type="n",xlab="distance (r)",ylab="n(r)",cex.lab=1.25,...)
+ lines(x$r,x$n$obs,lty=lty[1],col=cols[1],...)
+ lines(x$r,x$n$theo,lty=lty[2],col=cols[2],...)
+ lines(x$r,x$n$sup,lty=lty[3],col=cols[3],...)
+ lines(x$r,x$n$inf,lty=lty[3],col=cols[3],...)
+ }
+ if(opt%in%c("all","K")) { # K-function
+ plot(x$r,x$k$obs,ylim=range(x$k[,1:4]),main=paste("\n\n",sub[3]),type="n",xlab="distance (r)",ylab="K(r)",cex.lab=1.25,...)
+ lines(x$r,x$k$obs,lty=lty[1],col=cols[1],...)
+ lines(x$r,x$k$theo,lty=lty[2],col=cols[2],...)
+ lines(x$r,x$k$sup,lty=lty[3],col=cols[3],...)
+ lines(x$r,x$k$inf,lty=lty[3],col=cols[3],...)
+ }
+ if(opt%in%c("all","L")) { # L-function
+ lim<-range(x$l[,1:4])
+ plot(x$r,x$l$obs,ylim=c(lim[1],lim[2]+0.1*diff(lim)),main=paste("\n\n",sub[4]),type="n",xlab="distance (r)",ylab="L(r)",cex.lab=1.25,...)
+ lines(x$r,x$l$obs,lty=lty[1],col=cols[1],...)
+ lines(x$r,x$l$theo,lty=lty[2],col=cols[2],...)
+ lines(x$r,x$l$sup,lty=lty[3],col=cols[3],...)
+ lines(x$r,x$l$inf,lty=lty[3],col=cols[3],...)
+ }
+ }
+ else {
+ par(mar=c(0.1,0.1,0.1,0.1),cex=csize)
+ plot(x$r,x$g$obs/2,type="n",axes=FALSE,xlab="",ylab="")
+ if(legend)
+ legend("center",c("obs","theo (CSR)"),cex=1.5,lty=lty[1:2],bty="n",horiz=TRUE,title=main,col=cols[1:2],...)
+ else
+ legend("center","",cex=1.5,bty="n",horiz=TRUE,title=main,...)
+ par(mar=c(5,5,0.1,2),cex=ifelse(opt%in%c("all"),0.75*csize,csize))
+ if(opt%in%c("all","g")) { # g-function
+ lim<-range(x$g)
+ plot(x$r,x$g$obs,ylim=c(lim[1],lim[2]+0.1*diff(lim)),main=paste("\n\n",sub[1]),type="n",xlab="distance (r)",ylab="g(r)",cex.lab=1.25,...)
+ lines(x$r,x$g$obs,lty=lty[1],col=cols[1],...)
+ lines(x$r,x$g$theo,lty=lty[2],col=cols[2],...)
+ }
+ if(opt%in%c("all","n")) { # n-function
+ lim<-range(x$n)
+ plot(x$r,x$n$obs,ylim=c(lim[1],lim[2]+0.1*diff(lim)),main=paste("\n\n",sub[2]),type="n",xlab="distance (r)",ylab="n(r)",cex.lab=1.25,...)
+ lines(x$r,x$n$obs,lty=lty[1],col=cols[1],...)
+ lines(x$r,x$n$theo,lty=lty[2],col=cols[2],...)
+ }
+ if(opt%in%c("all","K")) { # k-function
+ plot(x$r,x$k$obs,ylim=range(x$k),main=paste("\n\n",sub[3]),type="n",xlab="distance (r)",ylab="K(r)",cex.lab=1.25,...)
+ lines(x$r,x$k$obs,lty=lty[1],col=cols[1],...)
+ lines(x$r,x$k$theo,lty=lty[2],col=cols[2],...)
+ }
+ if(opt%in%c("all","L")) { # L-function
+ lim<-range(x$l)
+ plot(x$r,x$l$obs,ylim=c(lim[1],lim[2]+0.1*diff(lim)),main=paste("\n\n",sub[4]),type="n",xlab="distance (r)",ylab="L(r)",cex.lab=1.25,...)
+ lines(x$r,x$l$obs,lty=lty[1],col=cols[1],...)
+ lines(x$r,x$l$theo,lty=lty[2],col=cols[2],...)
+ }
+ }
+}
+
+plot.fads.k12fun<-function(x,opt=c("all","L","K","n","g"),cols,lty,main,sub,legend=TRUE,csize=1,...) {
+ #ifelse(!is.null(x$call[["nsim"]]),ci<-TRUE,ci<-FALSE)
+ ifelse(!is.null(x$call$nsim)&&(x$call$nsim>0),ci<-TRUE,ci<-FALSE)
+ if(is.null(x$call[["H0"]])||(x$call[["H0"]]=="pitor")) h0<-"PI-tor"
+ else if(x$call[["H0"]]=="pimim") h0<-"PI-mim"
+ else h0<-"RL"
+ def.par <- par(no.readonly = TRUE)
+ on.exit(par(def.par))
+ #if(options()$device=="windows")
+ # csize<-0.75*csize
+ opt<-opt[1]
+ if(opt=="all")
+ mylayout<-layout(matrix(c(1,1,1,1,2,2,3,3,2,2,3,3,4,4,5,5,4,4,5,5),ncol=4,byrow=TRUE))
+ else if(opt%in%c("L","K","n","g"))
+ mylayout<-layout(matrix(c(1,1,1,1,rep(2,16)),ncol=4,byrow=TRUE))
+ else
+ stopifnot(opt%in%c("all","L","K","n","g"))
+ if(missing(cols))
+ cols=c(1,2,3)
+ else if(length(cols)!=3)
+ cols=c(cols,cols,cols)
+ if(missing(lty))
+ lty=c(1,3,2)
+ else if(length(lty)!=3)
+ lty=c(lty,lty,lty)
+ if(missing(main))
+ main<-deparse(x$call,width.cutoff=100)
+ if(missing(sub))
+ sub<-c("pair density function","second-order neighbour density function","intertype function","modified intertype function : sqrt[K12(r)/pi]-r")
+ if(ci) {
+ alpha<-x$call[["alpha"]]
+ p<-ifelse(!is.null(alpha),signif(100*(1-alpha),digits=6),99)
+ par(mar=c(0.1,0.1,0.1,0.1),cex=csize)
+ plot(x$r,x$g12$obs/2,type="n",axes=FALSE,xlab="",ylab="")
+ if(legend)
+ legend("center",c("obs",paste("theo (",h0,")",sep=""),paste(p,"% CI of",h0)),cex=1.5,lty=lty[1:3],bty="n",horiz=TRUE,title=main,col=cols[1:3],...)
+ else
+ legend("center","",cex=1.5,bty="n",horiz=TRUE,title=main,...)
+ par(mar=c(5,5,0.1,2),cex=ifelse(opt%in%c("all"),0.75*csize,csize))
+ if(opt%in%c("all","g")) { # g12-function
+ lim<-range(x$g12[,1:4])
+ plot(x$r,x$g12$obs,ylim=c(lim[1],lim[2]+0.1*diff(lim)),main=paste("\n\n",sub[1]),type="n",xlab="distance (r)",ylab="g12(r)",cex.lab=1.25)
+ lines(x$r,x$g12$obs,lty=lty[1],col=cols[1],...)
+ lines(x$r,x$g12$theo,lty=lty[2],col=cols[2],...)
+ lines(x$r,x$g12$sup,lty=lty[3],col=cols[3],...)
+ lines(x$r,x$g12$inf,lty=lty[3],col=cols[3],...)
+ }
+ if(opt%in%c("all","n")) { # n12-function
+ lim<-range(x$n12[,1:4])
+ plot(x$r,x$n12$obs,ylim=c(lim[1],lim[2]+0.1*diff(lim)),main=paste("\n\n",sub[2]),type="n",xlab="distance (r)",ylab="n12(r)",cex.lab=1.25)
+ lines(x$r,x$n12$obs,lty=lty[1],col=cols[1],...)
+ lines(x$r,x$n12$theo,lty=lty[2],col=cols[2],...)
+ lines(x$r,x$n12$sup,lty=lty[3],col=cols[3],...)
+ lines(x$r,x$n12$inf,lty=lty[3],col=cols[3],...)
+ }
+ if(opt%in%c("all","K")) { # K-function
+ plot(x$r,x$k12$obs,ylim=range(x$k12[,1:4]),main=paste("\n\n",sub[3]),type="n",xlab="distance (r)",ylab="K12(r)",cex.lab=1.25)
+ lines(x$r,x$k12$obs,lty=lty[1],col=cols[1],...)
+ lines(x$r,x$k12$theo,lty=lty[2],col=cols[2],...)
+ lines(x$r,x$k12$sup,lty=lty[3],col=cols[3],...)
+ lines(x$r,x$k12$inf,lty=lty[3],col=cols[3],...)
+ }
+ if(opt%in%c("all","L")) { # L-function
+ lim<-range(x$l12[,1:4])
+ plot(x$r,x$l12$obs,ylim=c(lim[1],lim[2]+0.1*diff(lim)),main=paste("\n\n",sub[4]),type="n",xlab="distance (r)",ylab="L12(r)",cex.lab=1.25)
+ lines(x$r,x$l12$obs,lty=lty[1],col=cols[1],...)
+ lines(x$r,x$l12$theo,lty=lty[2],col=cols[2],...)
+ lines(x$r,x$l12$sup,lty=lty[3],col=cols[3],...)
+ lines(x$r,x$l12$inf,lty=lty[3],col=cols[3],...)
+ }
+ }
+ else {
+ par(mar=c(0.1,0.1,0.1,0.1),cex=csize)
+ plot(x$r,x$g12$obs/2,type="n",axes=FALSE,xlab="",ylab="")
+ if(legend)
+ legend("center",c("obs",paste("theo (",h0,")",sep="")),cex=1.5,lty=lty[1:2],bty="n",horiz=TRUE,title=main,col=cols[1:2],...)
+ else
+ legend("center","",cex=1.5,bty="n",horiz=TRUE,title=main,...)
+ par(mar=c(5,5,0.1,2),cex=ifelse(opt%in%c("all"),0.75*csize,csize))
+ if(opt%in%c("all","g")) { # g-function
+ lim<-range(x$g12)
+ plot(x$r,x$g12$obs,ylim=c(lim[1],lim[2]+0.1*diff(lim)),main=paste("\n\n",sub[1]),type="n",xlab="distance step (r)",ylab="g12(r)",cex.lab=1.25,...)
+ lines(x$r,x$g12$obs,lty=lty[1],col=cols[1],...)
+ lines(x$r,x$g12$theo,lty=lty[2],col=cols[2],...)
+ }
+ if(opt%in%c("all","n")) { # n-function
+ lim<-range(x$n12)
+ plot(x$r,x$n12$obs,ylim=c(lim[1],lim[2]+0.1*diff(lim)),main=paste("\n\n",sub[2]),type="n",xlab="distance step (r)",ylab="n12(r)",cex.lab=1.25,...)
+ lines(x$r,x$n12$obs,lty=lty[1],col=cols[1],...)
+ lines(x$r,x$n12$theo,lty=lty[2],col=cols[2],...)
+ }
+ if(opt%in%c("all","K")) { # k-function
+ plot(x$r,x$k12$obs,ylim=range(x$k),main=paste("\n\n",sub[3]),type="n",xlab="distance step (r)",ylab="K12(r)",cex.lab=1.25,...)
+ lines(x$r,x$k12$obs,lty=lty[1],col=cols[1],...)
+ lines(x$r,x$k12$theo,lty=lty[2],col=cols[2],...)
+ }
+ if(opt%in%c("all","L")) { # L-function
+ lim<-range(x$l12)
+ plot(x$r,x$l12$obs,ylim=c(lim[1],lim[2]+0.1*diff(lim)),main=paste("\n\n",sub[4]),type="n",xlab="distance step (r)",ylab="L12(r)",cex.lab=1.25,...)
+ lines(x$r,x$l12$obs,lty=lty[1],col=cols[1],...)
+ lines(x$r,x$l12$theo,lty=lty[2],col=cols[2],...)
+ }
+ }
+}
+
+plot.fads.kpqfun<-function (x,opt=c("L","K","n","g"),cols,lty,main,sub,legend=TRUE,csize=1,...) {
+ na<-length(x$labpq)
+ nf<-ceiling(sqrt(na))
+ def.par <- par(no.readonly = TRUE)
+ on.exit(par(def.par))
+ #if(options()$device=="windows")
+ # csize<-0.75*csize
+ mylayout<-layout(matrix(c(rep(1,nf),seq(2,((nf*nf)+1),1)),(nf+1),nf,byrow=TRUE))
+ opt<-opt[1]
+ if(opt=="g") {
+ val<-x$gpq
+ theo<-matrix(rep(rep(1,na),each=length(x$r)),ncol=na)
+ ylab=paste("gpq(r)",sep="")
+ }
+ if(opt=="n") {
+ val<-x$npq
+ theo<-matrix(rep(rep(x$intensity,nf),each=length(x$r)),ncol=na)
+ ylab=paste("npq(r)",sep="")
+ }
+ if(opt=="K") {
+ val<-x$kpq
+ theo<-matrix(rep(pi*x$r^2,na),ncol=na)
+ ylab=paste("Kpq(r)",sep="")
+ }
+ if(opt=="L") {
+ val<-x$lpq
+ theo<-matrix(rep(rep(0,na),each=length(x$r)),ncol=na)
+ ylab=paste("Lpq(r)",sep="")
+ }
+ if(missing(cols))
+ cols=c(1,2)
+ else if(length(cols)!=2)
+ cols=c(cols,cols)
+ if(missing(lty))
+ lty=c(1,3)
+ else if(length(lty)!=2)
+ lty=c(lty,lty)
+ if(missing(main))
+ main<-deparse(x$call,width.cutoff=100)
+ if(missing(sub))
+ sub<-x$labpq
+ lim<-range(val)
+ par(mar=c(0.1,0.1,0.1,0.1),cex=csize)
+ plot.default(val[,1],val[,2]/2,type="n",axes=FALSE,xlab="",ylab="")
+ if(legend)
+ legend("center",c("obs","theo (CSR/PI)"),cex=1.5,lty=lty[1:2],bty="n",horiz=TRUE,title=main,col=cols[1:2],...)
+ else
+ legend("center","",cex=1.5,bty="n",horiz=TRUE,title=main,...)
+ par(mar=c(5,5,0.1,2),cex=0.66*csize)
+ for(i in 1:na) {
+ plot(x$r,val[,i],ylim=c(lim[1],lim[2]+0.1*diff(lim)),main=paste("\n\n",sub[i]),type="n",xlab="distance (r)",ylab=ylab,cex.lab=1.25,...)
+ lines(x$r,val[,i],lty=lty[1],col=cols[1],...)
+ lines(x$r,theo[,i],lty=lty[2],col=cols[2],...)
+ }
+}
+
+plot.fads.kp.fun<-function (x,opt=c("L","K","n","g"),cols,lty,main,sub,legend=TRUE,csize=1,...) {
+ na<-length(x$labp)
+ nf<-ceiling(sqrt(na))
+ def.par <- par(no.readonly = TRUE)
+ on.exit(par(def.par))
+ #if(options()$device=="windows")
+ # csize<-0.75*csize
+ mylayout<-layout(matrix(c(rep(1,nf),seq(2,((nf*nf)+1),1)),(nf+1),nf,byrow=TRUE))
+ opt<-opt[1]
+ if(opt=="g") {
+ val<-x$gp.
+ theo<-matrix(rep(rep(1,na),each=length(x$r)),ncol=na)
+ ylab=paste("gp.(r)",sep="")
+ }
+ if(opt=="n") {
+ val<-x$np.
+ intensity<-sum(x$intensity)-x$intensity
+ theo<-matrix(rep(intensity,each=length(x$r)),ncol=na)
+ ylab=paste("np.(r)",sep="")
+ }
+ if(opt=="K") {
+ val<-x$kp.
+ theo<-matrix(rep(pi*x$r^2,na),ncol=na)
+ ylab=paste("Kp.(r)",sep="")
+ }
+ if(opt=="L") {
+ val<-x$lp.
+ theo<-matrix(rep(rep(0,na),each=length(x$r)),ncol=na)
+ ylab=paste("Lp.(r)",sep="")
+ }
+ if(missing(cols))
+ cols=c(1,2)
+ else if(length(cols)!=2)
+ cols=c(cols,cols)
+ if(missing(lty))
+ lty=c(1,3)
+ else if(length(lty)!=2)
+ lty=c(lty,lty)
+ if(missing(main))
+ main<-deparse(x$call,width.cutoff=100)
+ if(missing(sub))
+ sub<-paste(x$labp,"-all others",sep="")
+ lim<-range(val)
+ par(mar=c(0.1,0.1,0.1,0.1),cex=csize)
+ plot.default(val[,1],val[,2]/2,type="n",axes=FALSE,xlab="",ylab="")
+ if(legend)
+ legend("center",c("obs","theo (PI)"),cex=1.5,lty=lty[1:2],bty="n",horiz=TRUE,title=main,col=cols[1:2],...)
+ else
+ legend("center","",cex=1.5,bty="n",horiz=TRUE,title=main,...)
+ par(mar=c(5,5,0.1,2),cex=0.66*csize)
+ for(i in 1:na) {
+ plot(x$r,val[,i],ylim=c(lim[1],lim[2]+0.1*diff(lim)),main=paste("\n\n",sub[i]),type="n",xlab="distance (r)",ylab=ylab,cex.lab=1.25,...)
+ lines(x$r,val[,i],lty=lty[1],col=cols[1],...)
+ lines(x$r,theo[,i],lty=lty[2],col=cols[2],...)
+ }
+}
+
+plot.fads.kmfun<-function (x,opt=c("all","K","g"),cols,lty,main,sub,legend=TRUE,csize=1,...) {
+ ifelse(!is.null(x$call$nsim)&&(x$call$nsim>0),ci<-TRUE,ci<-FALSE)
+ def.par <- par(no.readonly = TRUE)
+ on.exit(par(def.par))
+ #if(options()$device=="windows")
+ # csize<-0.75*csize
+ opt<-opt[1]
+ if(opt=="all")
+ mylayout<-layout(matrix(c(1,1,1,1,rep(2,8),rep(3,8)),ncol=4,byrow=TRUE))
+ else if(opt%in%c("K","g"))
+ mylayout<-layout(matrix(c(1,1,1,1,rep(2,16)),ncol=4,byrow=TRUE))
+ else
+ stopifnot(opt%in%c("all","K","g"))
+ if(missing(cols))
+ cols=c(1,2,3)
+ else if(length(cols)!=3)
+ cols=c(cols,cols,cols)
+ if(missing(lty))
+ lty=c(1,3,2)
+ else if(length(lty)!=3)
+ lty=c(lty,lty,lty)
+ if(missing(main))
+ main<-deparse(x$call,width.cutoff=100)
+ if(missing(sub))
+ sub<-c("pair correlation function","mark correlation function")
+ if(ci) {
+ alpha<-x$call[["alpha"]]
+ p<-ifelse(!is.null(alpha),signif(100*(1-alpha),digits=6),99)
+ par(mar=c(0.1,0.1,0.1,0.1),cex=csize)
+ plot(x$r,x$gm$obs/2,type="n",axes=FALSE,xlab="",ylab="")
+ if(legend)
+ legend("center",c("obs","theo (IM)",paste(p,"% CI of IM")),cex=1.5,lty=lty[1:3],bty="n",horiz=TRUE,title=main,col=cols[1:3],...)
+ else
+ legend("center","",cex=1.5,bty="n",horiz=TRUE,title=main,...)
+ par(mar=c(5,5,0.1,2),cex=ifelse(opt%in%c("all"),0.85*csize,csize))
+ if(opt%in%c("all","g")) { # gm-function
+ lim<-range(x$gm[,1:4])
+ plot(x$r,x$gm$obs,ylim=c(lim[1],lim[2]+0.1*diff(lim)),main=paste("\n\n",sub[1]),type="n",xlab="distance (r)",ylab="gm(r)",cex.lab=1.25,...)
+ lines(x$r,x$gm$obs,lty=lty[1],col=cols[1],...)
+ lines(x$r,x$gm$theo,lty=lty[2],col=cols[2],...)
+ lines(x$r,x$gm$sup,lty=lty[3],col=cols[3],...)
+ lines(x$r,x$gm$inf,lty=lty[3],col=cols[3],...)
+ }
+ if(opt%in%c("all","K")) { # K-function
+ plot(x$r,x$km$obs,ylim=range(x$km[,1:4]),main=paste("\n\n",sub[2]),type="n",xlab="distance (r)",ylab="Km(r)",cex.lab=1.25,...)
+ lines(x$r,x$km$obs,lty=lty[1],col=cols[1],...)
+ lines(x$r,x$km$theo,lty=lty[2],col=cols[2],...)
+ lines(x$r,x$km$sup,lty=lty[3],col=cols[3],...)
+ lines(x$r,x$km$inf,lty=lty[3],col=cols[3],...)
+ }
+ }
+ else {
+ par(mar=c(0.1,0.1,0.1,0.1),cex=csize)
+ plot(x$r,x$gm$obs/2,type="n",axes=FALSE,xlab="",ylab="")
+ if(legend)
+ legend("center",c("obs","theo (IM)"),cex=1.5,lty=lty[1:2],bty="n",horiz=TRUE,title=main,col=cols[1:2],...)
+ else
+ legend("center","",cex=1.5,bty="n",horiz=TRUE,title=main,...)
+ par(mar=c(5,5,0.1,2),cex=ifelse(opt%in%c("all"),0.85*csize,csize))
+ if(opt%in%c("all","g")) { # g-function
+ lim<-range(x$gm)
+ plot(x$r,x$gm$obs,ylim=c(lim[1],lim[2]+0.1*diff(lim)),main=paste("\n\n",sub[1]),type="n",xlab="distance (r)",ylab="gm(r)",cex.lab=1.25,...)
+ lines(x$r,x$gm$obs,lty=lty[1],col=cols[1],...)
+ lines(x$r,x$gm$theo,lty=lty[2],col=cols[2],...)
+ }
+ if(opt%in%c("all","K")) { # k-function
+ plot(x$r,x$km$obs,ylim=range(x$km),main=paste("\n\n",sub[2]),type="n",xlab="distance (r)",ylab="Km(r)",cex.lab=1.25,...)
+ lines(x$r,x$km$obs,lty=lty[1],col=cols[1],...)
+ lines(x$r,x$km$theo,lty=lty[2],col=cols[2],...)
+ }
+ }
+}
+
+plot.fads.ksfun<-function (x,opt=c("all","K","g"),cols,lty,main,sub,legend=TRUE,csize=1,...) {
+ ifelse(!is.null(x$call$nsim)&&(x$call$nsim>0),ci<-TRUE,ci<-FALSE)
+ def.par <- par(no.readonly = TRUE)
+ on.exit(par(def.par))
+#if(options()$device=="windows")
+# csize<-0.75*csize
+ opt<-opt[1]
+ if(opt=="all")
+ mylayout<-layout(matrix(c(1,1,1,1,rep(2,8),rep(3,8)),ncol=4,byrow=TRUE))
+ else if(opt%in%c("K","g"))
+ mylayout<-layout(matrix(c(1,1,1,1,rep(2,16)),ncol=4,byrow=TRUE))
+ else
+ stopifnot(opt%in%c("all","K","g"))
+
+# opt<-opt[1]
+# if(opt=="all")
+# mylayout<-layout(matrix(c(1,1,1,1,2,2,3,3,2,2,3,3,4,4,4,4,4,4,4,4),ncol=4,byrow=TRUE))
+# else if(opt%in%c("K","P","g"))
+# mylayout<-layout(matrix(c(1,1,1,1,rep(2,16)),ncol=4,byrow=TRUE))
+# else
+# stopifnot(opt%in%c("all","K","P","g"))
+ if(missing(cols))
+ cols=c(1,2,3)
+ else if(length(cols)!=3)
+ cols=c(cols,cols,cols)
+ if(missing(lty))
+ lty=c(1,3,2)
+ else if(length(lty)!=3)
+ lty=c(lty,lty,lty)
+ if(missing(main))
+ main<-deparse(x$call,width.cutoff=100)
+ if(missing(sub))
+ sub<-c("Standardized Shimatani non-cumulative (beta) function","Standardized Shimatani cumulative (alpha) function")
+ if(ci) {
+ alpha<-x$call[["alpha"]]
+ p<-ifelse(!is.null(alpha),signif(100*(1-alpha),digits=6),99)
+ par(mar=c(0.1,0.1,0.1,0.1),cex=csize)
+ plot(x$r,x$gs$obs/2,type="n",axes=FALSE,xlab="",ylab="")
+ if(legend)
+ legend("center",c("obs","theo (RL)",paste(p,"% CI of RL",sep="")),cex=1.3,lty=lty[1:3],bty="n",horiz=TRUE,title=main,col=cols[1:3],...)
+ else
+ legend("center","",cex=1.5,bty="n",horiz=TRUE,title=main,...)
+ par(mar=c(5,5,0.1,2),cex=ifelse(opt%in%c("all"),0.85*csize,csize))
+ if(opt%in%c("all","g")) { # gs-function
+ lim<-range(x$gs[,1:4])
+ plot(x$r,x$gs$obs,ylim=c(lim[1],lim[2]+0.1*diff(lim)),main=paste("\n\n",sub[1]),type="n",xlab="distance (r)",ylab="gs(r)",cex.lab=1.25,...)
+ lines(x$r,x$gs$obs,lty=lty[1],col=cols[1],...)
+ lines(x$r,x$gs$theo,lty=lty[2],col=cols[2],...)
+ lines(x$r,x$gs$sup,lty=lty[3],col=cols[3],...)
+ lines(x$r,x$gs$inf,lty=lty[3],col=cols[3],...)
+ }
+ if(opt%in%c("all","K")) { # Ks-function
+ plot(x$r,x$ks$obs,ylim=range(x$ks[,1:4]),main=paste("\n\n",sub[2]),type="n",xlab="distance (r)",ylab="Ks(r)",cex.lab=1.25,...)
+ lines(x$r,x$ks$obs,lty=lty[1],col=cols[1],...)
+ lines(x$r,x$ks$theo,lty=lty[2],col=cols[2],...)
+ lines(x$r,x$ks$sup,lty=lty[3],col=cols[3],...)
+ lines(x$r,x$ks$inf,lty=lty[3],col=cols[3],...)
+ }
+ }
+ else {
+ par(mar=c(0.1,0.1,0.1,0.1),cex=csize)
+ plot(x$r,x$gs$obs/2,type="n",axes=FALSE,xlab="",ylab="")
+ if(legend)
+ legend("center",c("obs","theo (RL)"),cex=1.3,lty=lty[1:2],bty="n",horiz=TRUE,title=main,col=cols[1:2],...)
+ else
+ legend("center","",cex=1.5,bty="n",horiz=TRUE,title=main,...)
+ par(mar=c(5,5,0.1,2),cex=ifelse(opt%in%c("all"),0.85*csize,csize))
+ if(opt%in%c("all","g")) { # gs-function
+ lim<-range(x$gs)
+ plot(x$r,x$gs$obs,ylim=c(lim[1],lim[2]+0.1*diff(lim)),main=paste("\n\n",sub[1]),type="n",xlab="distance (r)",ylab="gs(r)",cex.lab=1.25,...)
+ lines(x$r,x$gs$obs,lty=lty[1],col=cols[1],...)
+ lines(x$r,x$gs$theo,lty=lty[2],col=cols[2],...)
+ }
+ if(opt%in%c("all","K")) { # ks-function
+ plot(x$r,x$ks$obs,ylim=range(x$ks),main=paste("\n\n",sub[2]),type="n",xlab="distance (r)",ylab="Ks(r)",cex.lab=1.25,...)
+ lines(x$r,x$ks$obs,lty=lty[1],col=cols[1],...)
+ lines(x$r,x$ks$theo,lty=lty[2],col=cols[2],...)
+ }
+ }
+}
+
+plot.fads.krfun<-function (x,opt=c("all","K","g"),cols,lty,main,sub,legend=TRUE,csize=1,...) {
+ ifelse(!is.null(x$call$nsim)&&(x$call$nsim>0),ci<-TRUE,ci<-FALSE)
+ ifelse((is.null(x$call[["H0"]])||(x$call[["H0"]]=="rl")),h0<-"RL",h0<-"SE")
+ def.par <- par(no.readonly = TRUE)
+ on.exit(par(def.par))
+#if(options()$device=="windows")
+# csize<-0.75*csize
+ opt<-opt[1]
+ if(opt%in%c("all"))
+ mylayout<-layout(matrix(c(1,1,1,1,rep(2,8),rep(3,8)),ncol=4,byrow=TRUE))
+ else if(opt%in%c("K","g"))
+ mylayout<-layout(matrix(c(1,1,1,1,rep(2,16)),ncol=4,byrow=TRUE))
+ else
+ stopifnot(opt%in%c("all","K","g"))
+ if(missing(cols))
+ cols=c(1,2,3)
+ else if(length(cols)!=3)
+ cols=c(cols,cols,cols)
+ if(missing(lty))
+ lty=c(1,3,2)
+ else if(length(lty)!=3)
+ lty=c(lty,lty,lty)
+ if(missing(main))
+ main<-deparse(x$call,width.cutoff=100)
+ if(missing(sub))
+ sub<-c("Standardized Rao non-cumulative function","Standardized Rao cumulative function")
+ if(ci) {
+ alpha<-x$call[["alpha"]]
+ p<-ifelse(!is.null(alpha),signif(100*(1-alpha),digits=6),99)
+ par(mar=c(0.1,0.1,0.1,0.1),cex=csize)
+ plot(x$r,x$gr$obs/2,type="n",axes=FALSE,xlab="",ylab="")
+ if(legend)
+ legend("center",c("obs",paste("theo (",h0,")",sep=""),paste(p,"% CI of",h0)),cex=1.3,lty=lty[1:3],bty="n",horiz=TRUE,title=main,col=cols[1:3],...)
+ else
+ legend("center","",cex=1.5,bty="n",horiz=TRUE,title=main,...)
+ par(mar=c(5,5,0.1,2),cex=ifelse(opt%in%c("all"),0.85*csize,csize))
+ if(opt%in%c("all","g")) { # gr-function
+ lim<-range(x$gr[,1:4])
+ plot(x$r,x$gr$obs,ylim=c(lim[1],lim[2]+0.1*diff(lim)),main=paste("\n\n",sub[1]),type="n",xlab="distance (r)",ylab="gr(r)",cex.lab=1.25,...)
+ lines(x$r,x$gr$obs,lty=lty[1],col=cols[1],...)
+ lines(x$r,x$gr$theo,lty=lty[2],col=cols[2],...)
+ lines(x$r,x$gr$sup,lty=lty[3],col=cols[3],...)
+ lines(x$r,x$gr$inf,lty=lty[3],col=cols[3],...)
+ }
+ if(opt%in%c("all","K")) { # Kr-function
+ plot(x$r,x$kr$obs,ylim=range(x$kr[,1:4]),main=paste("\n\n",sub[2]),type="n",xlab="distance (r)",ylab="Kr(r)",cex.lab=1.25,...)
+ lines(x$r,x$kr$obs,lty=lty[1],col=cols[1],...)
+ lines(x$r,x$kr$theo,lty=lty[2],col=cols[2],...)
+ lines(x$r,x$kr$sup,lty=lty[3],col=cols[3],...)
+ lines(x$r,x$kr$inf,lty=lty[3],col=cols[3],...)
+ }
+ }
+ else {
+ par(mar=c(0.1,0.1,0.1,0.1),cex=csize)
+ plot(x$r,x$gr$obs/2,type="n",axes=FALSE,xlab="",ylab="")
+ if(legend)
+ legend("center",c("obs",paste("theo (",h0,")",sep="")),cex=1.3,lty=lty[1:3],bty="n",horiz=TRUE,title=main,col=cols[1:3],...)
+ else
+ legend("center","",cex=1.5,bty="n",horiz=TRUE,title=main,...)
+ par(mar=c(5,5,0.1,2),cex=ifelse(opt%in%c("all"),0.85*csize,csize))
+ if(opt%in%c("all","g")) { # gr-function
+ lim<-range(x$gr)
+ plot(x$r,x$gr$obs,ylim=c(lim[1],lim[2]+0.1*diff(lim)),main=paste("\n\n",sub[1]),type="n",xlab="distance (r)",ylab="gr(r)",cex.lab=1.25,...)
+ lines(x$r,x$gr$obs,lty=lty[1],col=cols[1],...)
+ lines(x$r,x$gr$theo,lty=lty[2],col=cols[2],...)
+ }
+ if(opt%in%c("all","K")) { # kr-function
+ plot(x$r,x$kr$obs,ylim=range(x$kr),main=paste("\n\n",sub[2]),type="n",xlab="distance (r)",ylab="Kr(r)",cex.lab=1.25,...)
+ lines(x$r,x$kr$obs,lty=lty[1],col=cols[1],...)
+ lines(x$r,x$kr$theo,lty=lty[2],col=cols[2],...)
+ }
+ }
+}
+
+plot.fads.kdfun<-function (x,opt=c("all","K","g"),cols,lty,main,sub,legend=TRUE,csize=1,...) {
+ ifelse(!is.null(x$call$nsim)&&(x$call$nsim>0),ci<-TRUE,ci<-FALSE)
+ def.par <- par(no.readonly = TRUE)
+ on.exit(par(def.par))
+#if(options()$device=="windows")
+# csize<-0.75*csize
+ opt<-opt[1]
+ if(opt%in%c("all"))
+ mylayout<-layout(matrix(c(1,1,1,1,rep(2,8),rep(3,8)),ncol=4,byrow=TRUE))
+ else if(opt%in%c("K","g"))
+ mylayout<-layout(matrix(c(1,1,1,1,rep(2,16)),ncol=4,byrow=TRUE))
+ else
+ stopifnot(opt%in%c("all","K","g"))
+ if(missing(cols))
+ cols=c(1,2,3)
+ else if(length(cols)!=3)
+ cols=c(cols,cols,cols)
+ if(missing(lty))
+ lty=c(1,3,2)
+ else if(length(lty)!=3)
+ lty=c(lty,lty,lty)
+ if(missing(main))
+ main<-deparse(x$call,width.cutoff=100)
+ if(missing(sub))
+ sub<-c("Standardized Shen non-cumulative function","Standardized Shen cumulative function")
+ if(ci) {
+ alpha<-x$call[["alpha"]]
+ p<-ifelse(!is.null(alpha),signif(100*(1-alpha),digits=6),99)
+ par(mar=c(0.1,0.1,0.1,0.1),cex=csize)
+ plot(x$r,x$gd$obs/2,type="n",axes=FALSE,xlab="",ylab="")
+ if(legend)
+ legend("center",c("obs","theo (SE)",paste(p,"% CI of SE")),cex=1.3,lty=lty[1:3],bty="n",horiz=TRUE,title=main,col=cols[1:3],...)
+ else
+ legend("center","",cex=1.5,bty="n",horiz=TRUE,title=main,...)
+ par(mar=c(5,5,0.1,2),cex=ifelse(opt%in%c("all"),0.85*csize,csize))
+ if(opt%in%c("all","g")) { # gd-function
+ lim<-range(x$gd[,1:4])
+ plot(x$r,x$gd$obs,ylim=c(lim[1],lim[2]+0.1*diff(lim)),main=paste("\n\n",sub[1]),type="n",xlab="distance (r)",ylab="gd(r)",cex.lab=1.25,...)
+ lines(x$r,x$gd$obs,lty=lty[1],col=cols[1],...)
+ lines(x$r,x$gd$theo,lty=lty[2],col=cols[2],...)
+ lines(x$r,x$gd$sup,lty=lty[3],col=cols[3],...)
+ lines(x$r,x$gd$inf,lty=lty[3],col=cols[3],...)
+ }
+ if(opt%in%c("all","K")) { # Kd-function
+ plot(x$r,x$kd$obs,ylim=range(x$kd[,1:4]),main=paste("\n\n",sub[2]),type="n",xlab="distance (r)",ylab="Kd(r)",cex.lab=1.25,...)
+ lines(x$r,x$kd$obs,lty=lty[1],col=cols[1],...)
+ lines(x$r,x$kd$theo,lty=lty[2],col=cols[2],...)
+ lines(x$r,x$kd$sup,lty=lty[3],col=cols[3],...)
+ lines(x$r,x$kd$inf,lty=lty[3],col=cols[3],...)
+ }
+ }
+ else {
+ par(mar=c(0.1,0.1,0.1,0.1),cex=csize)
+ plot(x$r,x$gd$obs/2,type="n",axes=FALSE,xlab="",ylab="")
+ if(legend)
+ legend("center",c("obs","theo (SE)"),cex=1.3,lty=lty[1:3],bty="n",horiz=TRUE,title=main,col=cols[1:3],...)
+ else
+ legend("center","",cex=1.5,bty="n",horiz=TRUE,title=main,...)
+ par(mar=c(5,5,0.1,2),cex=ifelse(opt%in%c("all"),0.85*csize,csize))
+ if(opt%in%c("all","g")) { # gd-function
+ lim<-range(x$gd)
+ plot(x$r,x$gd$obs,ylim=c(lim[1],lim[2]+0.1*diff(lim)),main=paste("\n\n",sub[1]),type="n",xlab="distance (r)",ylab="gd(r)",cex.lab=1.25,...)
+ lines(x$r,x$gd$obs,lty=lty[1],col=cols[1],...)
+ lines(x$r,x$gd$theo,lty=lty[2],col=cols[2],...)
+ }
+ if(opt%in%c("all","K")) { # Kd-function
+ plot(x$r,x$kd$obs,ylim=range(x$kd),main=paste("\n\n",sub[2]),type="n",xlab="distance (r)",ylab="Kd(r)",cex.lab=1.25,...)
+ lines(x$r,x$kd$obs,lty=lty[1],col=cols[1],...)
+ lines(x$r,x$kd$theo,lty=lty[2],col=cols[2],...)
+ }
+ }
+}
+
+plot.fads.mimetic<-function (x,opt=NULL,cols,lty,main,sub,legend=TRUE,csize=1,cex.main=1.5,pos,...) {
+ if(missing(cols))
+ cols=c(1,2)
+ else if(length(cols)!=2)
+ cols=c(cols,cols)
+ if(missing(lty))
+ lty=c(1,1)
+ else if(length(lty)!=2)
+ lty=c(lty,lty)
+ if(missing(main)) {
+ call<-match.call()
+ main<-deparse(eval(eval(expression(call))[[2]][[2]])$call,width.cutoff=100)
+ }
+ plot(x$r,x$l$obs,ylim=range(rbind(x$l$obs,x$l$sim)),main=main,type="n",xlab="distance (r)",ylab="L(r)",cex.lab=1.25,cex.main=cex.main,...)
+ lines(x$r,x$l$obs,lty=lty[1],col=cols[1],...)
+ lines(x$r,x$l$sim,lty=lty[2],col=cols[2],...)
+ if(legend)
+ legend(pos,c("obs","sim"),cex=1.5,lty=lty[1:2],bty="n",horiz=TRUE,col=cols[1:2],...)
+}
+
+
diff --git a/R/plot.vads.R b/R/plot.vads.R
new file mode 100755
index 0000000..9f80ffb
--- /dev/null
+++ b/R/plot.vads.R
@@ -0,0 +1,308 @@
+plot.vads<-function(x,main,opt,select,chars,cols,maxsize,char0,col0,legend,csize,...) {
+ UseMethod("plot.vads")
+}
+
+plot.vads.dval<-function (x,main,opt=c("dval","cval"),select,chars=c("circles","squares"),cols,maxsize,char0,col0,legend=TRUE,csize=1,...) {
+ if(!missing(select)) {
+ d<-c()
+ for(i in 1:length(select)) {
+ select.in.r<-c()
+ for(j in 1:length(x$r)) {
+ select.in.r<-c(select.in.r,ti<-isTRUE(all.equal(select[i],x$r[j])))
+ if(ti)
+ d<-c(d,j)
+ }
+ stopifnot(any(select.in.r==TRUE))
+ }
+ }
+ else
+ d<-rank(x$r)
+ nd<-length(d)
+ nf<-ceiling(sqrt(nd))
+ stopifnot(opt%in%c("dval","cval"))
+ opt<-opt[1]
+ stopifnot(chars%in%c("circles","squares"))
+ chars<-chars[1]
+ ifelse(opt=="dval",val<-x$dval[,d],val<-x$cval[,d])
+ v<-val
+ val<-data.frame(adjust.marks.size(val,x$window,if(!missing(maxsize)) maxsize))
+ def.par <- par(no.readonly = TRUE)
+ on.exit(par(def.par))
+ #if(options()$device=="windows")
+ # csize<-0.75*csize
+ if (missing(main))
+ main <- deparse(substitute(x))
+ mylayout<-layout(matrix(c(rep(1,nf),seq(2,((nf*nf)+1),1)),(nf+1),nf,byrow=TRUE))
+ s<-summary(x$window)
+ par(mar=c(0.1,0.1,1,0.1),cex=csize)
+ plot(s$xrange,s$yrange,type="n",axes=FALSE,asp=1/nf)
+ legend("center","",cex=1.5,bty="n",horiz=TRUE,title=main,...)
+ if(legend) {
+ mid<-(s$xrange[2]-s$xrange[1])/2
+ xl<-c(mid-0.5*mid,mid,mid+0.5*mid)
+ yl<-rep(s$xrange[2]*0.25,3)
+ lm<-range(v[v>0])
+ lm<-c(lm[1],mean(lm),lm[2])
+ lms<-range(val[val>0])
+ lms<-c(lms[1],mean(lms),lms[2])
+ if(missing(chars)||chars=="circles") {
+ symbols(xl,yl,circles=sqrt(lms),fg=ifelse(missing(cols),1,cols),bg=ifelse(missing(cols),1,cols),inches=FALSE,add=TRUE,...)
+ text(c(xl[1]+lms[1],xl[2]+lms[2],xl[3]+lms[3]),yl,labels=signif(lm,2),pos=4,cex=1.5)
+ }
+ else if(chars=="squares") {
+ symbols(xl,yl,squares=1.5*sqrt(lms),fg=ifelse(missing(cols),1,cols),bg=ifelse(missing(cols),1,cols),inches=FALSE,add=TRUE,...)
+ text(c(xl[1]+lms[1],xl[2]+lms[2],xl[3]+lms[3]),yl,labels=signif(lm,2),pos=4,cex=1.5)
+ }
+ }
+ #if(!is.null(main)) {
+ # mylayout<-layout(matrix(c(rep(1,nf),seq(2,((nf*nf)+1),1)),(nf+1),nf,byrow=TRUE))
+ # plot.default(x$xy$x,x$xy$y,type="n",axes=FALSE)
+ # text(mean(range(x$xy$x)),mean(range(x$xy$y)),pos=3,cex=2,labels=main)
+ #ajouter une lŽgende ???
+ #}
+ #else
+ # mylayout<-layout(matrix(seq(1,(nf*nf),1),nf,nf,byrow=TRUE))
+ ifelse(missing(cols),cols<-1,cols<-cols[1])
+ if(!missing(char0)||!missing(col0)) {
+ ifelse(missing(col0),col0<-cols,col0<-col0[1])
+ if(missing(char0))
+ char0<-3
+ }
+ for(i in 1:nd) {
+ plot.swin(x$window,main=paste("r =",x$r[d[i]]),scale=FALSE,csize=0.66*csize,...)
+ nort<-(val[,i]==0)
+ if(!missing(char0)&&any(nort))
+ points(x$xy$x[nort],x$xy$y[nort],pch=char0,col=col0,...)
+ if(any(!nort)) {
+ if(chars=="circles")
+ symbols(x$xy$x[!nort],x$xy$y[!nort],circles=nf*sqrt(val[!nort,i]),
+ fg=cols,bg=cols,inches=FALSE,add=TRUE,...)
+ else if(chars=="squares")
+ symbols(x$xy$x[!nort],x$xy$y[!nort],squares=1.5*nf*sqrt(val[!nort,i]),
+ fg=cols,bg=cols,inches=FALSE,add=TRUE,...)
+ }
+ }
+ ## mŽthode en courbes de niveaux ?
+}
+
+plot.vads.kval<-function (x,main,opt=c("lval","kval","nval","gval"),select,chars=c("circles","squares"),cols,maxsize,char0,col0,legend=TRUE,csize=1,...) {
+ if(!missing(select)) {
+ d<-c()
+ for(i in 1:length(select)) {
+ select.in.r<-c()
+ for(j in 1:length(x$r)) {
+ select.in.r<-c(select.in.r,ti<-isTRUE(all.equal(select[i],x$r[j])))
+ if(ti)
+ d<-c(d,j)
+ }
+ stopifnot(any(select.in.r==TRUE))
+ }
+ }
+ else
+ d<-rank(x$r)
+ nd<-length(d)
+ nf<-ceiling(sqrt(nd))
+ opt<-opt[1]
+ stopifnot(chars%in%c("circles","squares"))
+ chars<-chars[1]
+
+ if(opt=="lval")
+ val<-x$lval[,d]
+ else if(opt=="kval")
+ val<-x$kval[,d]
+ else if(opt=="nval")
+ val<-x$nval[,d]
+ else if(opt=="gval")
+ val<-x$gval[,d]
+ else
+ stopifnot(opt%in%c("lval","kval","nval","gval"))
+ v<-val
+ #val<-data.frame(adjust.marks.size(val,x$window,if(!missing(maxsize)) maxsize))
+ val<-data.frame(adjust.marks.size(val,x$window))
+ if(!missing(maxsize))
+ val<-val*maxsize
+ def.par <- par(no.readonly = TRUE)
+ on.exit(par(def.par))
+ #if(options()$device=="windows")
+ # csize<-0.75*csize
+ if (missing(main))
+ main <- deparse(substitute(x))
+ mylayout<-layout(matrix(c(rep(1,nf),seq(2,((nf*nf)+1),1)),(nf+1),nf,byrow=TRUE))
+ s<-summary(x$window)
+ par(mar=c(0.1,0.1,1,0.1),cex=csize)
+ plot.default(s$xrange,s$yrange,type="n",axes=FALSE,asp=1/nf)
+ legend("center","",cex=1.5,bty="n",horiz=TRUE,title=main,...)
+ if(legend) {
+ mid<-(s$xrange[2]-s$xrange[1])/2
+ xl<-c(mid-0.5*mid,mid,mid+0.5*mid)
+ yl<-rep(s$xrange[2]*0.25,3)
+ lm<-range(abs(v)[abs(v)>0])
+ lm<-c(lm[1],mean(lm),lm[2])
+ lms<-range(abs(val)[abs(val)>0])
+ lms<-c(lms[1],mean(lms),lms[2])
+ if(missing(chars)||chars=="circles") {
+ symbols(xl,yl,circles=sqrt(lms),fg=ifelse(missing(cols),1,cols),bg=ifelse(missing(cols),1,cols),inches=FALSE,add=TRUE,...)
+ text(c(xl[1]+lms[1]+1,xl[2]+lms[2]+1,xl[3]+lms[3]+1),yl,labels=signif(lm,2),pos=4,cex=1)
+ symbols(xl,yl*0.5,circles=sqrt(lms),fg=ifelse(missing(cols),1,cols),bg="white",inches=FALSE,add=TRUE,...)
+ text(c(xl[1]+lms[1],xl[2]+lms[2],xl[3]+lms[3]),yl*0.5,labels=signif(-lm,2),pos=4,cex=1)
+
+ }
+ else if(chars=="squares") {
+ symbols(xl,yl,squares=1.5*sqrt(lms),fg=ifelse(missing(cols),1,cols),bg=ifelse(missing(cols),1,cols),inches=FALSE,add=TRUE,...)
+ text(c(xl[1]+lms[1]+1,xl[2]+lms[2]+1,xl[3]+lms[3]+1),yl,labels=signif(lm,2),pos=4,cex=1)
+ symbols(xl,yl*0.5,squares=1.5*sqrt(lms),fg=ifelse(missing(cols),1,cols),bg="white",inches=FALSE,add=TRUE,...)
+ text(c(xl[1]+lms[1],xl[2]+lms[2],xl[3]+lms[3]),yl*0.5,labels=signif(-lm,2),pos=4,cex=1)
+
+ }
+ }
+ #if(!is.null(main)) {
+ # mylayout<-layout(matrix(c(rep(1,nf),seq(2,((nf*nf)+1),1)),(nf+1),nf,byrow=TRUE))
+ # plot.default(x$xy$x,x$xy$y,type="n",axes=FALSE)
+ # text(mean(range(x$xy$x)),mean(range(x$xy$y)),pos=3,cex=2,labels=main)
+ #ajouter une lŽgende ???
+ #}
+ #else
+ # mylayout<-layout(matrix(seq(1,(nf*nf),1),nf,nf,byrow=TRUE))
+ ifelse(missing(cols),cols<-1,cols<-cols[1])
+ if(!missing(char0)||!missing(col0)) {
+ ifelse(missing(col0),col0<-cols,col0<-col0[1])
+ if(missing(char0))
+ char0<-3
+ }
+ for(i in 1:nd) {
+ plot.swin(x$window,main=paste("r =",x$r[d[i]]),scale=FALSE,csize=0.66*csize,...)
+ nort<-(val[,i]==0)
+ neg<-(val[,i]<0)
+ if(!missing(char0)&&any(nort))
+ points(x$xy$x[nort],x$xy$y[nort],pch=char0,col=col0,...)
+ if(any(!nort)) {
+ if(chars=="circles") {
+ if(any(!neg))
+ symbols(x$xy$x[(!neg&!nort)],x$xy$y[(!neg&!nort)],circles=nf*sqrt(abs(val[(!neg&!nort),i])),
+ fg=cols,bg=cols,inches=FALSE,add=TRUE,...)
+ if(any(neg))
+ symbols(x$xy$x[(neg&!nort)],x$xy$y[(neg&!nort)],circles=nf*sqrt(abs(val[(neg&!nort),i])),
+ fg=cols,bg="white",inches=FALSE,add=TRUE,...)
+ }
+ else if(chars=="squares") {
+ if(any(!neg))
+ symbols(x$xy$x[(!neg&!nort)],x$xy$y[(!neg&!nort)],squares=1.5*nf*sqrt(abs(val[(!neg&!nort),i])),
+ fg=cols,bg=cols,inches=FALSE,add=TRUE,...)
+ if(any(neg))
+ symbols(x$xy$x[(neg&!nort)],x$xy$y[(neg&!nort)],squares=1.5*nf*sqrt(abs(val[(neg&!nort),i])),
+ fg=cols,bg="white",inches=FALSE,add=TRUE,...)
+ }
+ }
+ }
+ ## mŽthode en courbes de niveaux ?
+}
+
+plot.vads.k12val<-function (x,main,opt=c("lval","kval","nval","gval"),select,chars=c("circles","squares"),cols,maxsize,char0,col0,legend=TRUE,csize=1,...) {
+ if(!missing(select)) {
+ d<-c()
+ for(i in 1:length(select)) {
+ select.in.r<-c()
+ for(j in 1:length(x$r)) {
+ select.in.r<-c(select.in.r,ti<-isTRUE(all.equal(select[i],x$r[j])))
+ if(ti)
+ d<-c(d,j)
+ }
+ stopifnot(any(select.in.r==TRUE))
+ }
+ }
+ else
+ d<-rank(x$r)
+ nd<-length(d)
+ nf<-ceiling(sqrt(nd))
+ opt<-opt[1]
+ stopifnot(chars%in%c("circles","squares"))
+ chars<-chars[1]
+
+ if(opt=="lval")
+ val<-x$l12val[,d]
+ else if(opt=="kval")
+ val<-x$k12val[,d]
+ else if(opt=="nval")
+ val<-x$n12val[,d]
+ else if(opt=="gval")
+ val<-x$g12val[,d]
+ else
+ stopifnot(opt%in%c("lval","kval","nval","gval"))
+ v<-val
+ #val<-data.frame(adjust.marks.size(val,x$window,if(!missing(maxsize)) maxsize))
+ val<-data.frame(adjust.marks.size(val,x$window))
+ if(!missing(maxsize))
+ val<-val*maxsize
+ def.par <- par(no.readonly = TRUE)
+ on.exit(par(def.par))
+ #if(options()$device=="windows")
+ # csize<-0.75*csize
+ if (missing(main))
+ main <- deparse(substitute(x))
+ mylayout<-layout(matrix(c(rep(1,nf),seq(2,((nf*nf)+1),1)),(nf+1),nf,byrow=TRUE))
+ s<-summary(x$window)
+ par(mar=c(0.1,0.1,1,0.1),cex=csize)
+ plot.default(s$xrange,s$yrange,type="n",axes=FALSE,asp=1/nf)
+ legend("center","",cex=1.5,bty="n",horiz=TRUE,title=main,...)
+ if(legend) {
+ mid<-(s$xrange[2]-s$xrange[1])/2
+ xl<-c(mid-0.5*mid,mid,mid+0.5*mid)
+ yl<-rep(s$xrange[2]*0.25,3)
+ lm<-range(abs(v)[abs(v)>0])
+ lm<-c(lm[1],mean(lm),lm[2])
+ lms<-range(abs(val)[abs(val)>0])
+ lms<-c(lms[1],mean(lms),lms[2])
+ if(missing(chars)||chars=="circles") {
+ symbols(xl,yl,circles=sqrt(lms),fg=ifelse(missing(cols),1,cols),bg=ifelse(missing(cols),1,cols),inches=FALSE,add=TRUE,...)
+ text(c(xl[1]+lms[1]+1,xl[2]+lms[2]+1,xl[3]+lms[3]+1),yl,labels=signif(lm,2),pos=4,cex=1)
+ symbols(xl,yl*0.5,circles=sqrt(lms),fg=ifelse(missing(cols),1,cols),bg="white",inches=FALSE,add=TRUE,...)
+ text(c(xl[1]+lms[1],xl[2]+lms[2],xl[3]+lms[3]),yl*0.5,labels=signif(-lm,2),pos=4,cex=1)
+ }
+ else if(chars=="squares") {
+ symbols(xl,yl,squares=1.5*sqrt(lms),fg=ifelse(missing(cols),1,cols),bg=ifelse(missing(cols),1,cols),inches=FALSE,add=TRUE,...)
+ text(c(xl[1]+lms[1],xl[2]+lms[2],xl[3]+lms[3]),yl,labels=signif(lm,2),pos=4,cex=1)
+ symbols(xl,yl*0.5,squares=1.5*sqrt(lms),fg=ifelse(missing(cols),1,cols),bg="white",inches=FALSE,add=TRUE,...)
+ text(c(xl[1]+lms[1],xl[2]+lms[2],xl[3]+lms[3]),yl*0.5,labels=signif(-lm,2),pos=4,cex=1)
+ }
+ }
+ #if(!is.null(main)) {
+ # mylayout<-layout(matrix(c(rep(1,nf),seq(2,((nf*nf)+1),1)),(nf+1),nf,byrow=TRUE))
+ # plot.default(x$xy$x,x$xy$y,type="n",axes=FALSE)
+ # text(mean(range(x$xy$x)),mean(range(x$xy$y)),pos=3,cex=2,labels=main)
+ #ajouter une lŽgende ???
+ #}
+ #else
+ # mylayout<-layout(matrix(seq(1,(nf*nf),1),nf,nf,byrow=TRUE))
+ ifelse(missing(cols),cols<-1,cols<-cols[1])
+ if(!missing(char0)||!missing(col0)) {
+ ifelse(missing(col0),col0<-cols,col0<-col0[1])
+ if(missing(char0))
+ char0<-3
+ }
+ for(i in 1:nd) {
+ plot.swin(x$window,main=paste("r =",x$r[d[i]]),scale=FALSE,csize=0.66*csize,...)
+ nort<-(val[,i]==0)
+ neg<-(val[,i]<0)
+ if(!missing(char0)&&any(nort))
+ points(x$xy$x[nort],x$xy$y[nort],pch=char0,col=col0,...)
+ if(any(!nort)) {
+ if(chars=="circles") {
+ if(any(!neg))
+ symbols(x$xy$x[(!neg&!nort)],x$xy$y[(!neg&!nort)],circles=nf*sqrt(abs(val[(!neg&!nort),i])),
+ fg=cols,bg=cols,inches=FALSE,add=TRUE,...)
+ if(any(neg))
+ symbols(x$xy$x[(neg&!nort)],x$xy$y[(neg&!nort)],circles=nf*sqrt(abs(val[(neg&!nort),i])),
+ fg=cols,bg="white",inches=FALSE,add=TRUE,...)
+ }
+ else if(chars=="squares") {
+ if(any(!neg))
+ symbols(x$xy$x[(!neg&!nort)],x$xy$y[(!neg&!nort)],squares=1.5*nf*sqrt(abs(val[(!neg&!nort),i])),
+ fg=cols,bg=cols,inches=FALSE,add=TRUE,...)
+ if(any(neg))
+ symbols(x$xy$x[(neg&!nort)],x$xy$y[(neg&!nort)],squares=1.5*nf*sqrt(abs(val[(neg&!nort),i])),
+ fg=cols,bg="white",inches=FALSE,add=TRUE,...)
+ }
+ }
+ }
+ ## mŽthode en courbes de niveaux ?
+}
diff --git a/R/print.fads.R b/R/print.fads.R
new file mode 100755
index 0000000..59708fa
--- /dev/null
+++ b/R/print.fads.R
@@ -0,0 +1,40 @@
+print.fads<-function(x,...) {
+ UseMethod("print.fads")
+}
+
+print.fads.kfun<-function(x,...) {
+ cat("Univariate second-order neighbourhood functions:\n")
+ str(x)
+}
+
+print.fads.k12fun<-function(x,...) {
+ cat("Bivariate second-order neighbourhood functions:\n")
+ str(x)
+}
+
+print.fads.kpqfun<-function(x,...) {
+ cat("Multivariate second-order neighbourhood functions :\n")
+ cat("Interaction between each category p and each category q\n")
+ str(x)
+}
+
+print.fads.kp.fun<-function(x,...) {
+ cat("Multivariate second-order neighbourhood functions:\n")
+ cat("Interaction between each category p and all the remaining categories.\n")
+ str(x)
+}
+
+print.fads.kmfun<-function(x,...) {
+ cat("Mark correlation functions:\n")
+ str(x)
+}
+
+print.fads.ksfun<-function(x,...) {
+ cat("Shimatani multivariate functions:\n")
+ str(x)
+}
+
+print.fads.krfun<-function(x,...) {
+ cat("Rao multivariate functions:\n")
+ str(x)
+}
diff --git a/R/print.vads.R b/R/print.vads.R
new file mode 100755
index 0000000..b2587a3
--- /dev/null
+++ b/R/print.vads.R
@@ -0,0 +1,72 @@
+print.vads<-function(x,...) {
+ UseMethod("print.vads")
+}
+
+print.vads.dval<-function(x,...) {
+ cat("First-order local density values:\n")
+ str(x)
+ #cat("class: ",class(x),"\n")
+ #cat("call: ")
+ #print(x$call)
+ #cat("sampling window :",x$window$type,"\n")
+ #cat("\n")
+ #sumry <- array("", c(1, 4), list(1:1, c("vector", "length", "mode", "content")))
+ #sumry[1, ] <- c("$r", length(x$r), mode(x$r), "distance (r)")
+ #class(sumry) <- "table"
+ #print(sumry)
+ #cat("\n")
+ #sumry <- array("", c(3, 4), list(1:3, c("matrix", "nrow", "ncol", "content")))
+ #sumry[1, ] <- c("$grid", nrow(x$grid), ncol(x$grid), "(x,y) coordinates of the sampling points A")
+ #sumry[2, ] <- c("$count", nrow(x$count), ncol(x$count), "counting function NA(r)")
+ #sumry[3, ] <- c("$density", nrow(x$dens), ncol(x$dens), "local density function nA(r)")
+ #class(sumry) <- "table"
+ #print(sumry)
+}
+
+print.vads.kval<-function(x,...) {
+ cat("Univariate second-order local neighbourhood values:\n")
+ str(x)
+ #cat("class: ",class(x),"\n")
+ #cat("call: ")
+ #print(x$call)
+ #cat("\n")
+ #sumry <- array("", c(1, 4), list(1:1, c("vector", "length", "mode", "content")))
+ #sumry[1, ] <- c("$r", length(x$r), mode(x$r), "distance (r)")
+ #class(sumry) <- "table"
+ #print(sumry)
+ #cat("\n")
+ #sumry <- array("", c(5, 4), list(1:5, c("matrix", "nrow", "ncol", "content")))
+ #sumry[1, ] <- c("$coord", nrow(x$coord), ncol(x$coord), "(x,y) coordinates of points i")
+ #sumry[2, ] <- c("$gi", nrow(x$gi), ncol(x$gi), "individual pair density values gi(r)")
+ #sumry[3, ] <- c("$ni", nrow(x$ni), ncol(x$ni), "individual local neighbour density values ni(r)")
+ #sumry[4, ] <- c("$ki", nrow(x$ki), ncol(x$ki), "individual Ripley's values Ki(r)")
+ #sumry[5, ] <- c("$li", nrow(x$li), ncol(x$li), "modified individual Ripley's values Li(r)")
+ #class(sumry) <- "table"
+ #print(sumry)
+}
+
+print.vads.k12val<-function(x,...) {
+ #verifyclass(x,"k12ival")
+ cat("Bivariate second-order local neighbourhood values:\n")
+ str(x)
+ #cat("class: ",class(x),"\n")
+ #cat("call: ")
+ #print(x$call)
+ #cat("mark1: ",x$marks[1],"\n")
+ #cat("mark2: ",x$marks[2],"\n")
+ #cat("\n")
+ #sumry <- array("", c(1, 4), list(1:1, c("vector", "length", "mode", "content")))
+ #sumry[1, ] <- c("$r", length(x$r), mode(x$r), "distance (r)")
+ #class(sumry) <- "table"
+ #print(sumry)
+ #cat("\n")
+ #sumry <- array("", c(5, 4), list(1:5, c("matrix", "nrow", "ncol", "content")))
+ #sumry[1, ] <- c("$coord1", nrow(x$coord1), ncol(x$coord1), "(x,y) coordinates of points of mark 1")
+ #sumry[2, ] <- c("$g12i", nrow(x$g12i), ncol(x$g12i), "individual pair density values g12i(r)")
+ #sumry[3, ] <- c("$n12i", nrow(x$n12i), ncol(x$n12i), "individual local neighbour density values n12i(r)")
+ #sumry[4, ] <- c("$k12i", nrow(x$k12i), ncol(x$k12i), "individual intertype values K12i(r)")
+ #sumry[5, ] <- c("$l12i", nrow(x$l12i), ncol(x$l12i), "modified intrtype Ripley's values L12i(r)")
+ #class(sumry) <- "table"
+ #print(sumry)
+}
+
diff --git a/R/spp.R b/R/spp.R
new file mode 100755
index 0000000..24f2148
--- /dev/null
+++ b/R/spp.R
@@ -0,0 +1,266 @@
+spp<-function (x,y=NULL,window,triangles,marks,int2fac=TRUE) {
+ if(is.list(x)) {
+ stopifnot(length(x)==2)
+ y<-x[[2]]
+ x<-x[[1]]
+ }
+ else
+ stopifnot(!is.null(y))
+ stopifnot(is.numeric(x))
+ stopifnot(is.numeric(y))
+ stopifnot(length(x)==length(y))
+ if(any(duplicated(cbind(x,y))))
+ warning("duplicated (x,y) points")
+#stopifnot(!duplicated(cbind(x,y)))
+ if(!inherits(window,"swin")) {
+ if(missing(triangles))
+ w<-swin(window)
+ else
+ w<-swin(window,triangles)
+ }
+ else if("simple"%in%window$type&&!missing(triangles)) {
+ if("rectangle"%in%window$type)
+ w<-swin(c(window$xmin,window$ymin,window$xmax,window$ymax),triangles=triangles)
+ else if("circle"%in%window$type)
+ w<-swin(c(window$x0,window$y0,window$r0),triangles=triangles)
+ else
+ stop("invalid window type")
+ }
+ else
+ w<-window
+ stopifnot(any(ok<-inside.swin(x,y,w)!=FALSE))
+ xout<-x[!ok]
+ yout<-y[!ok]
+ x<-x[ok]
+ y<-y[ok]
+ n<-length(x)
+ nout<-length(xout)
+ spp<-list(type="univariate",window=w,n=n,x=x,y=y)
+ if(nout>0) spp<-c(spp,list(nout=nout,xout=xout,yout=yout))
+ if(!missing(marks)) {
+ stopifnot(length(marks)==(n+nout))
+ if(!is.factor(marks)) {
+ stopifnot(is.vector(marks))
+ if(is.integer(marks)&&int2fac==TRUE) {
+ marks<-as.factor(marks)
+ warning("integer marks have been coerced to factor",call.=FALSE)
+ }
+ else if(is.character(marks))
+ marks<-as.factor(marks)
+ else {
+ spp$type<-"marked"
+ spp$marks <- marks[ok]
+ if(nout>0)
+ spp$marksout<-marks[!ok]
+ }
+ }
+ if(is.factor(marks)) {
+ spp$type<-"multivariate"
+ names(marks)<-NULL
+ spp$marks <- factor(marks[ok],exclude=NULL)
+ if(nout>0)
+ spp$marksout<-factor(marks[!ok],exclude=NULL)
+ }
+ }
+ class(spp)<-"spp"
+ return(spp)
+}
+
+print.spp<-function (x,...) {
+ cat("Spatial point pattern:\n")
+ str(x)
+}
+
+summary.spp<-function (object,...) {
+ res<-list(type=object$type,window=summary(object$window))
+ area<-res$window$area
+ if(object$type=="multivariate")
+ res$intensity<-summary(object$marks)/area
+ else
+ res$intensity<-object$n/area
+ if(object$type=="marked")
+ res$marks<-summary(object$marks)
+ class(res)<-"summary.spp"
+ return(res)
+}
+
+print.summary.spp<-function (x,...) {
+ cat(paste("Spatial point pattern type:",x$type[1],"\n"))
+ print(x$window)
+ if(x$type=="multivariate") {
+ cat("intensity:")
+ print(array(x$intensity,dim=c(length(x$intensity),1),dimnames=list(paste(" .",names(x$intensity)),"")))
+ }
+ else
+ cat(paste("intensity:",signif(x$intensity),"\n"))
+ if(x$type=="marked") {
+ cat("marks:\n")
+ print(x$marks)
+ }
+}
+
+plot.spp<-function (x,main,out=FALSE,use.marks=TRUE,cols,chars,cols.out,chars.out,maxsize,scale=TRUE,add=FALSE,legend=TRUE,csize=1,...) {
+ stopifnot(x$n>0)
+ if (missing(main))
+ main <- deparse(substitute(x))
+ #def.par <- par(no.readonly = TRUE)
+ #on.exit(par(def.par))
+ #if(options()$device=="windows")
+ # csize<-0.75*csize
+ par(cex=csize)
+ #print(par("cex"))
+ if (!add) {
+ if(out) {
+ s<-summary(x$window)
+ e<-max(c(diff(c(min(x$xout),s$xrange[1])),diff(c(s$xrange[2],max(x$xout))),
+ diff(c(min(x$yout),s$yrange[1])),diff(c(s$yrange[2],max(x$yout)))))
+ plot.swin(x$window,main,e,scale,csize=csize,...)
+ }
+ else if(x$type!="univariate"&&legend==TRUE) {
+ s<-summary(x$window)
+ e<-0.2*(s$yrange[2]-s$yrange[1])
+ plot.swin(x$window,main,e,scale,csize=csize,...)
+ }
+ else
+ plot.swin(x$window,main,scale=scale,csize=csize,...)
+ }
+ if(x$type=="univariate"||!use.marks) {
+ if(!missing(cols))
+ stopifnot(length(cols)==1)
+ if(!missing(chars))
+ stopifnot(length(chars)==1)
+ points(x$x,x$y,pch=ifelse(missing(chars),1,chars),col=ifelse(missing(cols),"black",cols),cex=ifelse(missing(maxsize),1,maxsize),...)
+ if(out) {
+ if(!missing(cols.out))
+ stopifnot(length(cols.out)==1)
+ if(!missing(chars.out))
+ stopifnot(length(chars.out)==1)
+ points(x$xout,x$yout,pch=ifelse(missing(chars.out),2,chars.out),col=ifelse(missing(cols.out),"red",cols.out),
+ cex=ifelse(missing(maxsize),1,maxsize),...)
+ }
+ }
+ else if(x$type=="multivariate") {
+ if(!missing(cols))
+ stopifnot(length(cols)==nlevels(x$marks))
+ if(!missing(chars))
+ stopifnot(length(chars)==nlevels(x$marks))
+ for(i in 1:nlevels(x$marks)) {
+ rel<-(x$marks==levels(x$marks)[i])
+ points(x$x[rel],x$y[rel],pch=ifelse(missing(chars),i,chars[i]),col=ifelse(missing(cols),i,cols[i]),
+ cex=ifelse(missing(maxsize),1,maxsize),...)
+ }
+ if(out) {
+ if(!missing(cols.out))
+ stopifnot(length(cols.out)==nlevels(x$marksout))
+ if(!missing(chars.out))
+ stopifnot(length(chars.out)==nlevels(x$marksout))
+ for(i in 1:nlevels(x$marksout)) {
+ rel<-(x$marksout==levels(x$marksout)[i])
+ points(x$xout[rel],x$yout[rel],pch=ifelse(missing(chars.out),i,chars.out[i]),
+ col=ifelse(missing(cols.out),i,cols.out[i]),cex=ifelse(missing(maxsize),1,maxsize),...)
+ }
+ }
+ if(legend) {
+ xl<-c(s$xrange[1],s$xrange[2])
+ yl<-c(s$yrange[2]*1.15,s$yrange[2])
+ #xl<-c(p$window$xmin,p$window$xmax)
+ #yl<-c(p$window$ymax*1.1,p$window$ymax)
+ legend(x=xl,y=yl,levels(x$marks),cex=1,bty="n",pch=if(missing(chars)) c(1:nlevels(x$marks))
+ else chars,col=if(missing(cols)) c(1:nlevels(x$marks)) else cols,horiz=TRUE,xjust=0.5,...)
+ }
+ }
+ else if(x$type=="marked") {
+ if(!missing(cols))
+ stopifnot(length(cols)==1)
+ if(!missing(chars))
+ stopifnot(length(chars)==1)
+ if(out) {
+ #ms<-adjust.marks.size(c(x$marks,x$marksout),x$window,if(!missing(maxsize)) maxsize)
+ ms<-adjust.marks.size(c(x$marks,x$marksout),x$window)
+ if(!missing(maxsize))
+ ms<-ms*maxsize
+ msout<-ms[(x$n+1):(x$n+x$nout)]
+ ms<-ms[1:x$n]
+ }
+ else {
+ #ms<-adjust.marks.size(x$marks,x$window,if(!missing(maxsize)) maxsize)
+ ms<-adjust.marks.size(x$marks,x$window)
+ if(!missing(maxsize))
+ ms<-ms*maxsize
+ }
+ neg<-(x$marks<0)
+ if(missing(chars)||chars=="circles") {
+ if(any(neg))
+ symbols(x$x[neg],x$y[neg],circles=-ms[neg]/2,fg=ifelse(missing(cols),1,cols),inches=FALSE,add=TRUE,...)
+ if(any(!neg))
+ symbols(x$x[!neg],x$y[!neg],circles=ms[!neg]/2,fg=ifelse(missing(cols),1,cols),bg=ifelse(missing(cols),1,cols),inches=FALSE,add=TRUE,...)
+ }
+ else if(chars=="squares") {
+ if(any(neg))
+ symbols(x$x[neg],x$y[neg],squares=-ms[neg],fg=ifelse(missing(cols),1,cols),inches=FALSE,add=TRUE,...)
+ if(any(!neg))
+ symbols(x$x[!neg],x$y[!neg],squares=ms[!neg],fg=ifelse(missing(cols),1,cols),bg=ifelse(missing(cols),1,cols),inches=FALSE,add=TRUE,...)
+ }
+ else
+ stopifnot(chars%in%c("circles","squares"))
+ if(out) {
+ neg<-(x$marksout<0)
+ if(missing(chars.out)||chars.out=="circles") {
+ if(any(neg))
+ symbols(x$xout[neg],x$yout[neg],circles=-msout[neg]/2,fg=ifelse(missing(cols.out),2,cols.out),inches=FALSE,add=TRUE,...)
+ if(any(!neg))
+ symbols(x$xout[!neg],x$yout[!neg],circles=msout[!neg]/2,fg=ifelse(missing(cols.out),2,cols.out),
+ bg=ifelse(missing(cols.out),2,cols.out),inches=FALSE,add=TRUE,...)
+
+ }
+ else if(chars.out=="squares") {
+ if(any(neg))
+ symbols(x$xout[neg],x$yout[neg],squares=-msout[neg],fg=ifelse(missing(cols.out),2,cols.out),inches=FALSE,add=TRUE,...)
+ if(any(!neg))
+ symbols(x$xout[!neg],x$yout[!neg],squares=msout[!neg],fg=ifelse(missing(cols.out),2,cols.out),
+ bg=ifelse(missing(cols.out),2,cols.out),inches=FALSE,add=TRUE,...)
+
+ }
+ else
+ stopifnot(chars.out%in%c("circles","squares"))
+ }
+ if(legend) {
+ mid<-(s$xrange[2]-s$xrange[1])/2
+ xl<-c(mid-0.5*mid,mid,mid+0.5*mid)
+ yl<-rep((s$yrange[2]*1.15),3)
+ lm<-range(abs(x$marks))
+ lm<-c(lm[1],mean(lm),lm[2])
+ lms<-range(abs(ms))
+ lms<-c(lms[1],mean(lms),lms[2])
+ if(missing(chars)||chars=="circles") {
+ symbols(xl,yl,circles=lms/2,fg=ifelse(missing(cols),1,cols),bg=ifelse(missing(cols),1,cols),inches=FALSE,add=TRUE,...)
+ text(c(xl[1]+lms[1]+1,xl[2]+lms[2]+1,xl[3]+lms[3]+1),yl,labels=signif(lm,2),pos=4,cex=1)
+ if(any(neg)) {
+ symbols(xl,yl*0.93,circles=lms/2,fg=ifelse(missing(cols),1,cols),inches=FALSE,add=TRUE,...)
+ text(c(xl[1]+lms[1],xl[2]+lms[2],xl[3]+lms[3]),yl*0.93,labels=signif(-lm,2),pos=4,cex=1)
+ }
+ }
+ else if(chars=="squares") {
+ symbols(xl,yl,squares=lms,fg=ifelse(missing(cols),1,cols),bg=ifelse(missing(cols),1,cols),inches=FALSE,add=TRUE,...)
+ text(c(xl[1]+lms[1]+1,xl[2]+lms[2]+1,xl[3]+lms[3]+1),yl,labels=signif(lm,2),pos=4,cex=1)
+ if(any(neg)) {
+ symbols(xl,yl*0.93,squares=lms,fg=ifelse(missing(cols),1,cols),inches=FALSE,add=TRUE,...)
+ text(c(xl[1]+lms[1],xl[2]+lms[2],xl[3]+lms[3]),yl*0.93,labels=signif(-lm,2),pos=4,cex=1)
+ }
+ }
+ }
+
+ }
+ else
+ stop("invalid point pattern type")
+}
+
+ppp2spp<-function(p) {
+ stopifnot(inherits(p,"ppp"))
+ sw<-owin2swin(p$window)
+ if(is.null(p$marks))
+ sp<-spp(p$x,p$y,sw)
+ else
+ sp<-spp(p$x,p$y,window=sw,marks=p$marks)
+ return(sp)
+}
diff --git a/R/summary.vads.R b/R/summary.vads.R
new file mode 100755
index 0000000..e617af1
--- /dev/null
+++ b/R/summary.vads.R
@@ -0,0 +1,53 @@
+summary.vads<-function(object,...) {
+ UseMethod("summary.vads")
+}
+
+summary.vads.dval<-function (object,...) {
+ res<-list(spp=summary(eval(object$call$p)))
+ res$gsize<-c(diff(res$spp$window$xrange)/object$call$nx,diff(res$spp$window$yrange)/object$call$ny)
+ res$ldens<-data.frame(apply(object$dval,2,summary))
+ names(res$ldens)<-as.character(object$r)
+ class(res)<-"summary.dval"
+ return(res)
+}
+
+print.summary.dval<-function(x,...) {
+ cat(paste("Multiscale first-order local density:\n"))
+ print(x$spp)
+ cat(paste("grid size:",x$gsize[1],"X",x$gsize[2],"\n"))
+ cat("local density:\n")
+ print(t(x$ldens))
+}
+
+summary.vads.kval<-function (object,...) {
+ res<-list(spp=summary(eval(object$call$p)))
+ res$lneig<-data.frame(apply(object$nval,2,summary))
+ names(res$lneig)<-as.character(object$r)
+ class(res)<-"summary.kval"
+ return(res)
+}
+
+print.summary.kval<-function(x,...) {
+ cat(paste("Multiscale second-order local neighbour density:\n"))
+ print(x$spp)
+ cat("local neighbour density:\n")
+ print(t(x$lneig))
+}
+
+summary.vads.k12val<-function (object,...) {
+ res<-list(spp=summary(eval(object$call$p)))
+ res$marks<-object$marks
+ res$lneig<-data.frame(apply(object$n12val,2,summary))
+ names(res$lneig)<-as.character(object$r)
+ class(res)<-"summary.k12val"
+ return(res)
+}
+
+print.summary.k12val<-function(x,...) {
+ cat(paste("Multiscale bivariate second-order local neighbour density:\n"))
+ print(x$spp)
+ cat("mark 1:",x$marks[1],"\n")
+ cat("mark 2:",x$marks[2],"\n")
+ cat("bivariate local neighbour density:\n")
+ print(t(x$lneig))
+}
diff --git a/R/swin.R b/R/swin.R
new file mode 100755
index 0000000..fc17c57
--- /dev/null
+++ b/R/swin.R
@@ -0,0 +1,231 @@
+# rectangle: c(xmin,ymin,xmax,ymax)
+# circle: c(x0,y0,r0)
+# triangles: mat(x1,y1,x2,y2,x3,y3)
+swin<-function(window,triangles) {
+ if(inherits(window,"swin")) {
+ stopifnot("simple"%in%window$type)
+ if(missing(triangles))
+ return(window)
+ else if("rectangle"%in%window$type)
+ window<-c(window$xmin,window$ymin,window$xmax,window$ymax)
+ else if("circle"%in%window$type)
+ window<-c(window$x0,window$y0,window$r0)
+ else
+ stop("invalid window type")
+ }
+ stopifnot(is.numeric(window))
+ stopifnot(length(window)%in%c(3,4))
+ if(!missing(triangles)) {
+ if(is.vector(triangles))
+ triangles<-matrix(triangles,1,6)
+ else
+ triangles<-as.matrix(triangles)
+ stopifnot(is.numeric(triangles))
+ stopifnot(dim(triangles)[2]==6)
+ dimnames(triangles)[[2]]<-c("ax","ay","bx","by","cx","cy")
+ if(dim(triangles)[1]>1)
+ stopifnot(!overlapping.polygons(convert(triangles)))
+ triangles<-data.frame(triangles)
+ }
+ if(length(window)==4) {
+ stopifnot((window[3]-window[1])>0)
+ stopifnot((window[4]-window[2])>0)
+ xmin<-window[1]
+ ymin<-window[2]
+ xmax<-window[3]
+ ymax<-window[4]
+ sw<-list(type=c("simple","rectangle"),xmin=xmin,ymin=ymin,xmax=xmax,ymax=ymax)
+ if(!missing(triangles)) {
+ sw$type=c("complex","rectangle")
+ stopifnot(unlist(lapply(convert(triangles),function(x) in.rectangle(x$x,x$y,xmin,ymin,xmax,ymax))))
+ sw$triangles<-triangles
+ }
+ }
+ else if(length(window)==3) {
+ x0<-window[1]
+ y0<-window[2]
+ r0<-window[3]
+ sw<-list(type=c("simple","circle"),x0=x0,y0=y0,r0=r0)
+ if(!missing(triangles)) {
+ sw$type=c("complex","circle")
+ stopifnot(unlist(lapply(convert(triangles),function(x) in.circle(x$x,x$y,x0,y0,r0))))
+ sw$triangles<-triangles
+ }
+ }
+ else
+ stop("invalid input parameters")
+ class(sw) <- "swin"
+ return(sw)
+}
+
+print.swin<-function (x, ...) {
+ cat("Sampling window:\n")
+ str(x)
+}
+
+area.swin<-function (w) {
+ stopifnot(inherits(w,"swin"))
+ if("rectangle"%in%w$type)
+ area<-(w$xmax-w$xmin)*(w$ymax-w$ymin)
+ else if("circle"%in%w$type)
+ area<-pi*w$r0^2
+ else
+ stop("invalid window type")
+ if ("complex"%in%w$type) {
+ tri<-w$triangles
+ area.tri<-0
+ for(i in 1:nrow(tri))
+ area.tri<-area.tri+abs(area.poly(c(tri$ax[i],tri$bx[i],tri$cx[i]),c(tri$ay[i],tri$by[i],tri$cy[i])))
+ area<-area-area.tri
+ }
+ return(area)
+}
+
+summary.swin<-function (object, ...) {
+ res<-alist()
+ res$type<-object$type
+ if("rectangle"%in%object$type) {
+ res$xrange<-c(object$xmin,object$xmax)
+ res$yrange<-c(object$ymin,object$ymax)
+ }
+ else if("circle"%in%object$type) {
+ res$xrange<-c(object$x0-object$r0,object$x0+object$r0)
+ res$yrange<-c(object$y0-object$r0,object$y0+object$r0)
+ }
+ else
+ stop("invalid window type")
+ res$area<-area.swin(object)
+ if("complex"%in%object$type) {
+ res$nbtri<-nrow(object$triangles)
+ if("rectangle"%in%object$type)
+ res$area.init<-area.swin(swin(c(object$xmin,object$ymin,object$xmax,object$ymax)))
+ else if("circle"%in%object$type)
+ res$area.init<-area.swin(swin(c(object$x0,object$y0,object$r0)))
+ }
+ class(res) <- "summary.swin"
+ return(res)
+}
+
+print.summary.swin<-function (x,...) {
+ cat(paste("Sampling window type:",x$type[1],x$type[2],"\n"))
+ cat(paste("xrange: [",signif(x$xrange[1]),",",signif(x$xrange[2]),"]\n"))
+ cat(paste("yrange: [",signif(x$yrange[1]),",",signif(x$yrange[2]),"]\n"))
+ if("simple"%in%x$type)
+ cat(paste("area:",signif(x$area),"\n"))
+ else if("complex"%in%x$type) {
+ cat(paste("initial",x$type[2],"area:",signif(x$area.init),"\n"))
+ cat(paste("number of triangles removed:",x$nbtri,"\n"))
+ cat(paste("actual complex window area:",signif(x$area),"\n"))
+ }
+ else
+ stop("invalid window type")
+}
+
+plot.swin<-function (x,main,edge,scale=TRUE,add=FALSE,csize=1,...) {
+ if(missing(main))
+ main<-deparse(substitute(x))
+ if(missing(edge))
+ edge<-0
+ #if(options()$device=="windows"&&sys.nframe()<=2)
+ # csize<-0.75*csize
+ par(cex=csize)
+ if("rectangle"%in%x$type) {
+ rx<-c(x$xmin,x$xmax)
+ ry<-c(x$ymin,x$ymax)
+ if(edge>0) {
+ rx<-c(rx[1]-edge,rx[2]+edge)
+ ry<-c(ry[1]-edge,ry[2]+edge)
+ }
+ if(scale)
+ plot(rx,ry,asp=1,main=main,type="n",axes=TRUE,frame.plot=FALSE,xlab="",ylab="",...)
+ else
+ plot(rx,ry,asp=1,main=main,type="n",axes=FALSE,xlab="",ylab="",...)
+ polygon(c(x$xmin,x$xmin,x$xmax,x$xmax),c(x$ymin,x$ymax,x$ymax,x$ymin))
+ }
+ else if("circle"%in%x$type) {
+ rx<-c(x$x0-x$r0,x$x0+x$r0)
+ ry<-c(x$y0-x$r0,x$y0+x$r0)
+ if(edge>0) {
+ rx<-c(rx[1]-edge,rx[2]+edge)
+ ry<-c(ry[1]-edge,ry[2]+edge)
+ }
+ if(scale)
+ plot(rx,ry,asp=1,main=main,type="n",axes=TRUE,frame.plot=FALSE,xlab="",ylab="",...)
+ else
+ plot(rx,ry,asp=1,main=main,type="n",axes=FALSE,xlab="",ylab="",...)
+ symbols(x$x0,x$y0,circles=x$r0,inches=FALSE,add=TRUE)
+ }
+ else
+ stop("invalid window type")
+ if("complex"%in%x$type) {
+ tri<-x$triangles
+ for(i in 1:length(tri$ax)) {
+ xi<-c(tri$ax[i],tri$bx[i],tri$cx[i])
+ yi<-c(tri$ay[i],tri$by[i],tri$cy[i])
+ polygon(xi,yi,col="grey",...)
+ text(mean(xi),mean(yi),labels=as.character(i),cex=1)
+ }
+ }
+}
+
+inside.swin<-function(x,y,w,bdry=TRUE) {
+ stopifnot(inherits(w,"swin"))
+ stopifnot(length(x)==length(y))
+ if("rectangle"%in%w$type)
+ inside<-in.rectangle(x,y,w$xmin,w$ymin,w$xmax,w$ymax,bdry)
+ else if("circle"%in%w$type)
+ inside<-in.circle(x,y,w$x0,w$y0,w$r0,bdry)
+ else
+ stop("invalid window type")
+ if("complex"%in%w$type) {
+ tri<-w$triangles
+ for(i in 1:nrow(tri))
+ inside[in.triangle(x,y,tri$ax[i],tri$ay[i],tri$bx[i],tri$by[i],tri$cx[i],tri$cy[i])]<-FALSE
+ }
+ return(inside)
+}
+
+owin2swin<-function(w) {
+ stopifnot(inherits(w,"owin"))
+ if(identical(w$type,c("rectangle")))
+ sw<-swin(c(w$xrange[1],w$yrange[1],w$xrange[2],w$yrange[2]))
+ else if(identical(w$type,c("polygonal"))) {
+ if(length(w$bdry)==1) { #single polygon
+ stopifnot(w$bdry[[1]]$hole==FALSE)
+ wx<-border(w,0.1,outside=TRUE)
+ outer.poly<-data.frame(x=c(rep(wx$xrange[1],2),rep(wx$xrange[2],2)),y=c(wx$yrange,wx$yrange[2:1]))
+ tri<-triangulate(outer.poly,data.frame(w$bdry[[1]][1:2]))
+ sw<-swin(c(wx$xrange[1],wx$yrange[1],wx$xrange[2],wx$yrange[2]),triangles=tri)
+ }
+ else { #polygon with holes
+ stopifnot(w$bdry[[1]]$hole==FALSE)
+ bb<-bounding.box.xy(w$bdry[[1]][1:2])
+ if((bb$xrange==w$xrange)&&(bb$yrange==w$yrange)&&(area.owin(bb)==w$bdry[[1]]$area)) { #first poly is rectangular window frame
+ outer.poly<-data.frame(x=c(rep(w$xrange[1],2),rep(w$xrange[2],2)),y=c(w$yrange,w$yrange[2:1]))
+ for(i in 2:length(w$bdry)) {
+ stopifnot(w$bdry[[i]]$hole==TRUE)
+ if(i==2)
+ tri<-triangulate(w$bdry[[i]][1:2])
+ else
+ tri<-rbind(tri,triangulate(w$bdry[[i]][1:2]))
+ }
+ sw<-swin(c(w$xrange[1],w$yrange[1],w$xrange[2],w$yrange[2]),triangles=tri)
+ }
+ else { #first poly is a polygonal frame
+ wx<-border(w,0.1,outside=TRUE)
+ outer.poly<-data.frame(x=c(rep(wx$xrange[1],2),rep(wx$xrange[2],2)),y=c(wx$yrange,wx$yrange[2:1]))
+ tri<-triangulate(outer.poly,w$bdry[[1]][1:2])
+ for(i in 2:length(w$bdry)) {
+ stopifnot(w$bdry[[i]]$hole==TRUE)
+ tri<-rbind(tri,triangulate(w$bdry[[i]][1:2]))
+ }
+ sw<-swin(c(wx$xrange[1],wx$yrange[1],wx$xrange[2],wx$yrange[2]),triangles=tri)
+ }
+ }
+ }
+ else
+ stop("non convertible 'owin' object")
+ return(sw)
+}
+
+
diff --git a/R/triangulate.R b/R/triangulate.R
new file mode 100755
index 0000000..fb42576
--- /dev/null
+++ b/R/triangulate.R
@@ -0,0 +1,42 @@
+triangulate<-function(outer.poly,holes) {
+ if(is.vector(outer.poly)&&is.numeric(outer.poly)&&(length(outer.poly)==4)) {
+ stopifnot((outer.poly[3]-outer.poly[1])>0)
+ stopifnot((outer.poly[4]-outer.poly[2])>0)
+ outer.poly<-list(x=c(outer.poly[1],outer.poly[1],outer.poly[3],outer.poly[3]),
+ y=c(outer.poly[2],outer.poly[4],outer.poly[4],outer.poly[2]))
+ }
+ if(!missing(holes)) {
+ if(is.list(holes[[1]])) {
+ if(all(unlist(lapply(holes,is.poly))))
+ stopifnot(!overlapping.polygons(holes))
+ }
+ else if(is.poly(holes))
+ holes<-list(holes)
+ for(i in 1:length(holes))
+ stopifnot(in.poly(holes[[i]]$x,holes[[i]]$y,outer.poly))
+ nbpoly<-length(holes)+1
+ nbpts<-length(outer.poly$x)
+ vertX<-outer.poly$x
+ vertY<-outer.poly$y
+ for(i in 2:nbpoly) {
+ nbpts[i]<-length(holes[[i-1]]$x)
+ vertX<-c(vertX,holes[[i-1]]$x)
+ vertY<-c(vertY,holes[[i-1]]$y)
+ }
+ nbptot<-sum(nbpts)
+ nbtri<-(nbptot-2)+2*(nbpoly-1)
+ }
+ else {
+ nbpoly<-1
+ nbpts<-nbptot<-length(outer.poly$x)
+ vertX<-outer.poly$x
+ vertY<-outer.poly$y
+ nbtri<-(nbpts-2)
+ }
+ tri<-.C("triangulate",
+ as.integer(nbpoly),as.integer(nbpts),as.integer(nbptot),as.double(vertX),as.double(vertY),as.integer(nbtri),
+ X1=double(nbtri),Y1=double(nbtri),X2=double(nbtri),Y2=double(nbtri),X3=double(nbtri),Y3=double(nbtri),
+ PACKAGE="ads")
+ return(data.frame(ax=tri$X1,ay=tri$Y1,bx=tri$X2,by=tri$Y2,cx=tri$X3,cy=tri$Y3))
+}
+
diff --git a/R/util.R b/R/util.R
new file mode 100755
index 0000000..6290578
--- /dev/null
+++ b/R/util.R
@@ -0,0 +1,337 @@
+overlapping.polygons<-function(listpoly) {
+ stopifnot(unlist(lapply(listpoly,is.poly)))
+ nbpoly<-length(listpoly)
+ res<-rep(FALSE,(nbpoly-1))
+ for(i in 1:(nbpoly-1)) {
+ for(j in (i+1):nbpoly) {
+ if(abs(overlap.poly(listpoly[[i]],listpoly[[j]]))>.Machine$double.eps^0.5)
+ res[i]<-TRUE
+ }
+ }
+ return(res)
+}
+
+#from area.xypolygon{spatstat}
+#return area>0 when (xp,yp) vertices are ranked anticlockwise
+#or area<0 when (xp,yp) vertices are ranked clockwise
+area.poly<-function(xp,yp) {
+ nedges <- length(xp)
+ yp <- yp - min(yp)
+ nxt <- c(2:nedges, 1)
+ dx <- xp[nxt] - xp
+ ym <- (yp + yp[nxt])/2
+ -sum(dx * ym)
+}
+
+in.circle<-function(x,y,x0,y0,r0,bdry=TRUE) {
+ stopifnot(length(x)==length(y))
+ l<-length(x)
+ inside<-vector(mode="logical",length=l)
+ for(i in 1:l) {
+ if(bdry) {
+ if(((x[i]-x0)^2+(y[i]-y0)^2)<=(r0^2))
+ inside[i]<-TRUE
+ }
+ else {
+ if(((x[i]-x0)^2+(y[i]-y0)^2)<(r0^2))
+ inside[i]<-TRUE
+ }
+ }
+ return(inside)
+}
+
+in.rectangle<-function(x,y,xmin,ymin,xmax,ymax,bdry=TRUE) {
+ stopifnot(length(x)==length(y))
+ stopifnot((xmax-xmin)>0)
+ stopifnot((ymax-ymin)>0)
+ rect<-list(x=c(xmin,xmax,xmax,xmin),y=c(ymin,ymin,ymax,ymax))
+ return(in.poly(x,y,rect,bdry))
+}
+
+in.triangle<-function(x,y,ax,ay,bx,by,cx,cy,bdry=TRUE) {
+ stopifnot(length(x)==length(y))
+ tri<-list(x=c(ax,bx,cx),y=c(ay,by,cy))
+ return(in.poly(x,y,tri,bdry))
+}
+
+#modified from plot.ppp{spatstat}
+adjust.marks.size<-function(marks,window,maxsize=NULL) {
+ if(is.null(maxsize)) {
+ if("rectangle"%in%window$type)
+ diam<-sqrt((window$xmin-window$xmax)^2+(window$ymin-window$ymax)^2)
+ else if("circle"%in%window$type)
+ diam<-2*window$r0
+ maxsize<-min(1.4/sqrt(pi*length(marks)/area.swin(window)),diam*0.07)
+ }
+ mr<-range(c(0,marks))
+ maxabs<-max(abs(mr))
+ if(diff(mr)<4*.Machine$double.eps||maxabs<4*.Machine$double.eps) {
+ ms<-rep(0.5*maxsize,length(marks))
+ mp.value<-mr[1]
+ mp.plotted<-0.5*maxsize
+ }
+ else {
+ scal<-maxsize/maxabs
+ ms<-marks*scal
+ mp.value<-pretty(mr)
+ mp.plotted<-mp.value*scal
+ }
+ return(ms)
+}
+
+#modified from verify.xypolygon{spatstat}
+is.poly<-function (p) {
+ stopifnot(is.list(p))
+ stopifnot(length(p)==2,length(names(p))==2)
+ stopifnot(identical(sort(names(p)),c("x","y")))
+ stopifnot(!is.null(p$x),!is.null(p$y))
+ stopifnot(is.numeric(p$x),is.numeric(p$y))
+ stopifnot(length(p$x)==length(p$y))
+ return(TRUE)
+}
+
+testInteger<-function(i) {
+ if(as.integer(i)!=i) {
+ warning(paste(substitute(i),"=",i," has been converted to integer : ",as.integer(i),sep=""),call.=FALSE)
+ i<-as.integer(i)
+ }
+ return(i)
+}
+
+testIC<-function(nbSimu,lev) {
+ if(lev*(nbSimu+1)<5) {
+ warning(paste(
+ "Low validity test: a*(n+1) < 5\n Significance level: a = ",lev,
+ "\n Number of simulations: n = ",nbSimu,"\n",sep=""))
+ }
+}
+
+#from spatstat
+overlap.poly <- function(P, Q) {
+ # compute area of overlap of two simple closed polygons
+ # verify.xypolygon(P)
+ #verify.xypolygon(Q)
+
+ xp <- P$x
+ yp <- P$y
+ np <- length(xp)
+ nextp <- c(2:np, 1)
+
+ xq <- Q$x
+ yq <- Q$y
+ nq <- length(xq)
+ nextq <- c(2:nq, 1)
+
+ # adjust y coordinates so all are nonnegative
+ ylow <- min(c(yp,yq))
+ yp <- yp - ylow
+ yq <- yq - ylow
+
+ area <- 0
+ for(i in 1:np) {
+ ii <- c(i, nextp[i])
+ xpii <- xp[ii]
+ ypii <- yp[ii]
+ for(j in 1:nq) {
+ jj <- c(j, nextq[j])
+ area <- area +
+ overlap.trapez(xpii, ypii, xq[jj], yq[jj])
+ }
+ }
+ return(area)
+}
+
+#from spatstat
+overlap.trapez <- function(xa, ya, xb, yb, verb=FALSE) {
+ # compute area of overlap of two trapezia
+ # which have same baseline y = 0
+ #
+ # first trapezium has vertices
+ # (xa[1], 0), (xa[1], ya[1]), (xa[2], ya[2]), (xa[2], 0).
+ # Similarly for second trapezium
+
+ # Test for vertical edges
+ dxa <- diff(xa)
+ dxb <- diff(xb)
+ if(dxa == 0 || dxb == 0)
+ return(0)
+
+ # Order x coordinates, x0 < x1
+ if(dxa > 0) {
+ signa <- 1
+ lefta <- 1
+ righta <- 2
+ if(verb) cat("A is positive\n")
+ } else {
+ signa <- -1
+ lefta <- 2
+ righta <- 1
+ if(verb) cat("A is negative\n")
+ }
+ if(dxb > 0) {
+ signb <- 1
+ leftb <- 1
+ rightb <- 2
+ if(verb) cat("B is positive\n")
+ } else {
+ signb <- -1
+ leftb <- 2
+ rightb <- 1
+ if(verb) cat("B is negative\n")
+ }
+ signfactor <- signa * signb # actually (-signa) * (-signb)
+ if(verb) cat(paste("sign factor =", signfactor, "\n"))
+
+ # Intersect x ranges
+ x0 <- max(xa[lefta], xb[leftb])
+ x1 <- min(xa[righta], xb[rightb])
+ if(x0 >= x1)
+ return(0)
+ if(verb) {
+ cat(paste("Intersection of x ranges: [", x0, ",", x1, "]\n"))
+ abline(v=x0, lty=3)
+ abline(v=x1, lty=3)
+ }
+
+ # Compute associated y coordinates
+ slopea <- diff(ya)/diff(xa)
+ y0a <- ya[lefta] + slopea * (x0-xa[lefta])
+ y1a <- ya[lefta] + slopea * (x1-xa[lefta])
+ slopeb <- diff(yb)/diff(xb)
+ y0b <- yb[leftb] + slopeb * (x0-xb[leftb])
+ y1b <- yb[leftb] + slopeb * (x1-xb[leftb])
+
+ # Determine whether upper edges intersect
+ # if not, intersection is a single trapezium
+ # if so, intersection is a union of two trapezia
+
+ yd0 <- y0b - y0a
+ yd1 <- y1b - y1a
+ if(yd0 * yd1 >= 0) {
+ # edges do not intersect
+ areaT <- (x1 - x0) * (min(y1a,y1b) + min(y0a,y0b))/2
+ if(verb) cat(paste("Edges do not intersect\n"))
+ } else {
+ # edges do intersect
+ # find intersection
+ xint <- x0 + (x1-x0) * abs(yd0/(yd1 - yd0))
+ yint <- y0a + slopea * (xint - x0)
+ if(verb) {
+ cat(paste("Edges intersect at (", xint, ",", yint, ")\n"))
+ points(xint, yint, cex=2, pch="O")
+ }
+ # evaluate left trapezium
+ left <- (xint - x0) * (min(y0a, y0b) + yint)/2
+ # evaluate right trapezium
+ right <- (x1 - xint) * (min(y1a, y1b) + yint)/2
+ areaT <- left + right
+ if(verb)
+ cat(paste("Left area = ", left, ", right=", right, "\n"))
+ }
+
+ # return area of intersection multiplied by signs
+ return(signfactor * areaT)
+}
+
+#TRUE: les points sur la bordure sont = inside
+in.poly<-function(x,y,poly,bdry=TRUE) {
+ stopifnot(is.poly(poly))
+ xp <- poly$x
+ yp <- poly$y
+ npts <- length(x)
+ nedges <- length(xp) # sic
+
+ score <- rep(0, npts)
+ on.boundary <- rep(FALSE, npts)
+ temp <- .Fortran(
+ "inpoly",
+ x=as.double(x),
+ y=as.double(y),
+ xp=as.double(xp),
+ yp=as.double(yp),
+ npts=as.integer(npts),
+ nedges=as.integer(nedges),
+ score=as.double(score),
+ onbndry=as.logical(on.boundary),
+ PACKAGE="ads"
+ )
+ score <- temp$score
+ on.boundary <- temp$onbndry
+ score[on.boundary] <- 1
+ res<-rep(FALSE,npts)
+ res[score==(-1)]<-TRUE
+ if(bdry)
+ res[score==1]<-TRUE
+ return(res)
+}
+
+####################
+convert<-function(x) {
+r<-alist()
+x<-as.matrix(x)
+for(i in 1:dim(x)[1])
+ r[[i]]<-data.frame(x=c(x[i,1],x[i,5],x[i,3]),y=c(x[i,2],x[i,6],x[i,4]))
+return(r)
+}
+
+convert2<-function(x){ # liste de liste vers df 6 var
+x<-unlist(x)
+mat<-matrix(x,ncol=6,byrow=TRUE,dimnames=list(NULL,c("ax","bx","cx","ay","by","cy")))
+#mat<-cbind(tmp$ax,tmp$ay,tmp$bx,tmp$by,tmp$cx,tmp$cy)
+r<-data.frame(ax=mat[,1],ay=mat[,4],bx=mat[,2],by=mat[,5],cx=mat[,3],cy=mat[,6])
+return(r)
+}
+
+
+read.tri<-function(X) {
+ res<-NULL
+ tabtri<-read.table(X)
+
+ n<-length(tabtri[,1])
+
+ for(i in 1:n) {
+ tri<-list(x=c(tabtri[,1][i],tabtri[,3][i],tabtri[,5][i]),
+ y=c(tabtri[,2][i],tabtri[,4][i],tabtri[,6][i]))
+
+ #if(area.xypolygon(tri)>0){
+ if(area.poly(tri$x,tri$y)>0){
+ tri<-list(x=c(tabtri[,5][i],tabtri[,3][i],tabtri[,1][i]),
+ y=c(tabtri[,6][i],tabtri[,4][i],tabtri[,2][i]))
+ }
+
+ res<-c(res,list(tri))
+ }
+ if(length(res)==1) {
+ res<-unlist(res,recursive=FALSE)
+ }
+ return(res)
+}
+
+transpose<-function(x,y) {
+
+ nbTri<-length(x)/3
+
+ res<-.C("transpose",x=as.double(x),y=as.double(y),nbTri=as.integer(nbTri),
+ x1=double(nbTri),y1=double(nbTri),x2=double(nbTri),y2=double(nbTri),
+ x3=double(nbTri),y3=double(nbTri),PACKAGE="ads")
+
+ list(x1=res$x1,y1=res$y1,x2=res$x2,y2=res$y2,x3=res$x3,y3=res$y3)
+}
+##############
+#subsetting dist objects
+#sub is a logical vector of True/False
+subsetdist<-function(dis,sub) {
+ mat<-as.matrix(dis)
+ k<-dimnames(mat)[[1]]%in%sub
+ submat<-mat[k,k]
+ return(as.dist(submat))
+}
+
+#ordering dist objetcs on ind
+sortmat<-function(dis,ind) {
+ mat<-as.matrix(dis)[,ind]
+ mat<-mat[ind,]
+ return(as.dist(mat))
+}
+
+
diff --git a/R/vads.R b/R/vads.R
new file mode 100755
index 0000000..a26c740
--- /dev/null
+++ b/R/vads.R
@@ -0,0 +1,305 @@
+dval<-function(p,upto,by,nx,ny) {
+#si multivariŽ, choix du type de points ???
+ stopifnot(inherits(p,"spp"))
+ stopifnot(is.numeric(upto))
+ stopifnot(is.numeric(by))
+ stopifnot(by>0)
+ r<-seq(by,upto,by)
+ tmax<-length(r)
+ stopifnot(is.numeric(nx))
+ stopifnot(nx>=1)
+ nx<-testInteger(nx)
+ stopifnot(is.numeric(ny))
+ stopifnot(ny>=1)
+ ny<-testInteger(ny)
+ if("rectangle"%in%p$window$type) {
+ cas<-1
+ xmin<-p$window$xmin
+ xmax<-p$window$xmax
+ ymin<-p$window$ymin
+ ymax<-p$window$ymax
+ stopifnot(upto<=(0.5*max((xmax-xmin),(ymax-ymin))))
+ xsample<-rep(xmin+(seq(1,nx)-0.5)*(xmax-xmin)/nx,each=ny)
+ ysample<-rep(ymin+(seq(1,ny)-0.5)*(ymax-ymin)/ny,nx)
+ if ("complex"%in%p$window$type) {
+ cas<-3
+ tri<-p$window$triangles
+ nbTri<-nrow(tri)
+ }
+ }
+ else if("circle"%in%p$window$type) {
+ cas<-2
+ x0<-p$window$x0
+ y0<-p$window$y0
+ r0<-p$window$r0
+ stopifnot(upto<=r0)
+ xsample<-rep(x0-r0+(seq(1,nx)-0.5)*2*r0/nx,each=ny)
+ ysample<-rep(y0-r0+(seq(1,ny)-0.5)*2*r0/ny,nx)
+ if ("complex"%in%p$window$type) {
+ cas<-4
+ tri<-p$window$triangles
+ nbTri<-nrow(tri)
+ }
+ }
+ else
+ stop("invalid window type")
+
+ ok <- inside.swin(xsample, ysample, p$window)
+ xsample<-xsample[ok]
+ ysample<-ysample[ok]
+ stopifnot(length(xsample)==length(ysample))
+ nbSample<-length(xsample)
+
+ if(cas==1) { #rectangle
+ count<-.C("density_rect",
+ as.integer(p$n),as.double(p$x),as.double(p$y),
+ as.double(xmin),as.double(xmax),as.double(ymin),as.double(ymax),
+ as.integer(tmax),as.double(by),
+ as.double(xsample),as.double(ysample),as.integer(nbSample),
+ count=double(tmax*nbSample),
+ PACKAGE="ads")$count
+ }
+ else if(cas==2) { #circle
+ count<-.C("density_disq",
+ as.integer(p$n),as.double(p$x),as.double(p$y),
+ as.double(x0),as.double(y0),as.double(r0),
+ as.integer(tmax),as.double(by),
+ as.double(xsample),as.double(ysample),as.integer(nbSample),
+ count=double(tmax*nbSample),
+ PACKAGE="ads")$count
+ }
+ else if(cas==3) { #complex within rectangle
+ count<-.C("density_tr_rect",
+ as.integer(p$n),as.double(p$x),as.double(p$y),
+ as.double(xmin),as.double(xmax),as.double(ymin),as.double(ymax),
+ as.integer(nbTri),as.double(tri$ax),as.double(tri$ay),as.double(tri$bx),as.double(tri$by),as.double(tri$cx),as.double(tri$cy),
+ as.integer(tmax),as.double(by),
+ as.double(xsample),as.double(ysample),as.integer(nbSample),
+ count=double(tmax*nbSample),
+ PACKAGE="ads")$count
+ }
+ else if(cas==4) { #complex within circle
+ count<-.C("density_tr_disq",
+ as.integer(p$n),as.double(p$x),as.double(p$y),
+ as.double(x0),as.double(y0),as.double(r0),
+ as.integer(nbTri),as.double(tri$ax),as.double(tri$ay),as.double(tri$bx),as.double(tri$by),as.double(tri$cx),as.double(tri$cy),
+ as.integer(tmax),as.double(by),
+ as.double(xsample),as.double(ysample),as.integer(nbSample),
+ count=double(tmax*nbSample),
+ PACKAGE="ads")$count
+ }
+ ## rajouter un indice lorsque les disques ne sont pas indŽpendants
+ # formatting results
+ dens<-count/(pi*r^2)
+ #grid<-matrix(c(xsample,ysample),nrow=nbSample,ncol=2)
+ count<-matrix(count,nrow=nbSample,ncol=tmax,byrow=TRUE)
+ dens<-matrix(dens,nrow=nbSample,ncol=tmax,byrow=TRUE)
+ call<-match.call()
+ res<-list(call=call,window=p$window,r=r,xy=data.frame(x=xsample,y=ysample),cval=count,dval=dens)
+ class(res)<-c("vads","dval")
+ return(res)
+}
+
+kval<-function(p,upto,by) {
+ # checking for input parameters
+ stopifnot(inherits(p,"spp"))
+ if(p$type!="univariate")
+ warning(paste(p$type,"point pattern has been considered to be univariate\n"))
+ stopifnot(is.numeric(upto))
+ stopifnot(is.numeric(by))
+ stopifnot(by>0)
+ r<-seq(by,upto,by)
+ tmax<-length(r)
+
+ if("rectangle"%in%p$window$type) {
+ cas<-1
+ xmin<-p$window$xmin
+ xmax<-p$window$xmax
+ ymin<-p$window$ymin
+ ymax<-p$window$ymax
+ stopifnot(upto<=(0.5*max((xmax-xmin),(ymax-ymin))))
+ if ("complex"%in%p$window$type) {
+ cas<-3
+ tri<-p$window$triangles
+ nbTri<-nrow(tri)
+ }
+ }
+ else if("circle"%in%p$window$type) {
+ cas<-2
+ x0<-p$window$x0
+ y0<-p$window$y0
+ r0<-p$window$r0
+ stopifnot(upto<=r0)
+ if ("complex"%in%p$window$type) {
+ cas<-4
+ tri<-p$window$triangles
+ nbTri<-nrow(tri)
+ }
+ }
+ else
+ stop("invalid window type")
+ intensity<-p$n/area.swin(p$window)
+
+ #computing ripley local functions
+ if(cas==1) { #rectangle
+ res<-.C("ripleylocal_rect",
+ as.integer(p$n),as.double(p$x),as.double(p$y),
+ as.double(xmin),as.double(xmax),as.double(ymin),as.double(ymax),
+ as.integer(tmax),as.double(by),
+ gi=double(p$n*tmax),ki=double(p$n*tmax),
+ PACKAGE="ads")
+ }
+ else if(cas==2) { #circle
+ res<-.C("ripleylocal_disq",
+ as.integer(p$n),as.double(p$x),as.double(p$y),
+ as.double(x0),as.double(y0),as.double(r0),
+ as.integer(tmax),as.double(by),
+ gi=double(p$n*tmax),ki=double(p$n*tmax),
+ PACKAGE="ads")
+ }
+ else if(cas==3) { #complex within rectangle
+ res<-.C("ripleylocal_tr_rect",
+ as.integer(p$n),as.double(p$x),as.double(p$y),
+ as.double(xmin),as.double(xmax),as.double(ymin),as.double(ymax),
+ as.integer(nbTri),as.double(tri$ax),as.double(tri$ay),as.double(tri$bx),as.double(tri$by),as.double(tri$cx),as.double(tri$cy),
+ as.integer(tmax),as.double(by),
+ gi=double(p$n*tmax),ki=double(p$n*tmax),
+ PACKAGE="ads")
+ }
+ else if(cas==4) { #complex within circle
+ res<-.C("ripleylocal_tr_disq",
+ as.integer(p$n),as.double(p$x),as.double(p$y),
+ as.double(x0),as.double(y0),as.double(r0),
+ as.integer(nbTri),as.double(tri$ax),as.double(tri$ay),as.double(tri$bx),as.double(tri$by),as.double(tri$cx),as.double(tri$cy),
+ as.integer(tmax),as.double(by),
+ gi=double(p$n*tmax),ki=double(p$n*tmax),
+ PACKAGE="ads")
+ }
+ # formatting results
+ #coord<-matrix(c(X$x,X$y),nrow=nbPts,ncol=2)
+ #coord<-data.frame(x=p$x,y=p$y)
+ #r<-seq(dr,dr*tmax,dr)
+ #ds<-pi*r^2-pi*seq(0,dr*tmax-dr,dr)^2
+ ds<-c(pi,diff(pi*r^2))
+ gi<-matrix(res$gi/(intensity*ds),nrow=p$n,ncol=tmax,byrow=TRUE)
+ ni<-matrix(res$ki/(pi*r^2),nrow=p$n,ncol=tmax,byrow=TRUE)
+ ki<-matrix(res$ki/intensity,nrow=p$n,ncol=tmax,byrow=TRUE)
+ li<-matrix(sqrt(res$ki/(intensity*pi))-r,nrow=p$n,ncol=tmax,byrow=TRUE)
+ call<-match.call()
+ res<-list(call=call,window=p$window,r=r,xy=data.frame(x=p$x,y=p$y),gval=gi,kval=ki,nval=ni,lval=li)
+ class(res)<-c("vads","kval")
+ return(res)
+}
+
+k12val<-function(p,upto,by,marks) {
+ # checking for input parameters
+ stopifnot(inherits(p,"spp"))
+ stopifnot(p$type=="multivariate")
+ stopifnot(is.numeric(upto))
+ stopifnot(is.numeric(by))
+ stopifnot(by>0)
+ r<-seq(by,upto,by)
+ tmax<-length(r)
+ if(missing(marks))
+ marks<-c(1,2)
+ stopifnot(length(marks)==2)
+ stopifnot(marks[1]!=marks[2])
+ mark1<-marks[1]
+ mark2<-marks[2]
+ if(is.numeric(mark1))
+ mark1<-levels(p$marks)[testInteger(mark1)]
+ else if(!mark1%in%p$marks) stop(paste("mark \'",mark1,"\' doesn\'t exist",sep=""))
+ if(is.numeric(mark2))
+ mark2<-levels(p$marks)[testInteger(mark2)]
+ else if(!mark2%in%p$marks) stop(paste("mark \'",mark2,"\' doesn\'t exist",sep=""))
+ # initializing variables
+ if("rectangle"%in%p$window$type) {
+ cas<-1
+ xmin<-p$window$xmin
+ xmax<-p$window$xmax
+ ymin<-p$window$ymin
+ ymax<-p$window$ymax
+ stopifnot(upto<=(0.5*max((xmax-xmin),(ymax-ymin))))
+ if ("complex"%in%p$window$type) {
+ cas<-3
+ tri<-p$window$triangles
+ nbTri<-nrow(tri)
+ }
+ }
+ else if("circle"%in%p$window$type) {
+ cas<-2
+ x0<-p$window$x0
+ y0<-p$window$y0
+ r0<-p$window$r0
+ stopifnot(upto<=r0)
+ if ("complex"%in%p$window$type) {
+ cas<-4
+ tri<-p$window$triangles
+ nbTri<-nrow(tri)
+ }
+ }
+ else
+ stop("invalid window type")
+ surface<-area.swin(p$window)
+ x1<-p$x[p$marks==mark1]
+ y1<-p$y[p$marks==mark1]
+ x2<-p$x[p$marks==mark2]
+ y2<-p$y[p$marks==mark2]
+ nbPts1<-length(x1)
+ nbPts2<-length(x2)
+ intensity2<-nbPts2/surface
+ #computing intertype local functions
+ if(cas==1) { #rectangle
+ res<-.C("intertypelocal_rect",
+ as.integer(nbPts1),as.double(x1),as.double(y1),
+ as.integer(nbPts2),as.double(x2),as.double(y2),
+ as.double(xmin),as.double(xmax),as.double(ymin),as.double(ymax),
+ as.integer(tmax),as.double(by),
+ gi=double(nbPts1*tmax),ki=double(nbPts1*tmax),
+ PACKAGE="ads")
+ }
+ else if(cas==2) { #circle
+ res<-.C("intertypelocal_disq",
+ as.integer(nbPts1),as.double(x1),as.double(y1),
+ as.integer(nbPts2),as.double(x2),as.double(y2),
+ as.double(x0),as.double(y0),as.double(r0),
+ as.integer(tmax),as.double(by),
+ gi=double(nbPts1*tmax),ki=double(nbPts1*tmax),
+ PACKAGE="ads")
+ }
+ else if(cas==3) { #complex within rectangle
+ res<-.C("intertypelocal_tr_rect",
+ as.integer(nbPts1),as.double(x1),as.double(y1),
+ as.integer(nbPts2),as.double(x2),as.double(y2),
+ as.double(xmin),as.double(xmax),as.double(ymin),as.double(ymax),
+ as.integer(nbTri),as.double(tri$ax),as.double(tri$ay),as.double(tri$bx),as.double(tri$by),as.double(tri$cx),as.double(tri$cy),
+ as.integer(tmax),as.double(by),
+ gi=double(nbPts1*tmax),ki=double(nbPts1*tmax),
+ PACKAGE="ads")
+ }
+ else if(cas==4) { #complex within circle
+ res<-.C("intertypelocal_tr_disq",
+ as.integer(nbPts1),as.double(x1),as.double(y1),
+ as.integer(nbPts2),as.double(x2),as.double(y2),
+ as.double(x0),as.double(y0),as.double(r0),
+ as.integer(nbTri),as.double(tri$ax),as.double(tri$ay),as.double(tri$bx),as.double(tri$by),as.double(tri$cx),as.double(tri$cy),
+ as.integer(tmax),as.double(by),
+ gi=double(nbPts1*tmax),ki=double(nbPts1*tmax),
+ PACKAGE="ads")
+ }
+ # formatting results
+ #coord<-matrix(c(x1,y1),nrow=nbPts1,ncol=2)
+ #coord<-data.frame(x1=x1,y1=y1)
+ #r<-seq(dr,dr*tmax,dr)
+ #ds<-pi*r^2-pi*seq(0,dr*tmax-dr,dr)^2
+ ds<-c(pi,diff(pi*r^2))
+ gi<-matrix(res$gi/(intensity2*ds),nrow=nbPts1,ncol=tmax,byrow=TRUE)
+ ni<-matrix(res$ki/(pi*r^2),nrow=nbPts1,ncol=tmax,byrow=TRUE)
+ ki<-matrix(res$ki/intensity2,nrow=nbPts1,ncol=tmax,byrow=TRUE)
+ li<-matrix(sqrt(res$ki/(intensity2*pi))-r,nrow=nbPts1,ncol=tmax,byrow=TRUE)
+ call<-match.call()
+ res<-list(call=call,window=p$window,r=r,xy=data.frame(x=x1,y=y1),g12val=gi,k12val=ki,n12val=ni,l12val=li,marks=c(mark1,mark2))
+ class(res)<-c("vads","k12val")
+ return(res)
+}
+
diff --git a/data/Allogny.rda b/data/Allogny.rda
new file mode 100755
index 0000000000000000000000000000000000000000..5cf20e0e533bfc7606683c09c495ec3427bbfd2a
GIT binary patch
literal 4415
zcmW-jdpy&N|Hq3XBIc6&WywKKp<1=dE=AJi7pJdpM-mJ9N)B=zvkO_4$SUWABb&?V
zs6(XGXl$rZG*oAVZP>6H_F<dNuHSy&_h0Yl>+$~U{eHY&k2kp3Xv6<Xf2nG+nDf@T
z8|rv_2OHBk#y(zuvgvHunP=}j64w^LJdZ~Yb6FZZCq10_@3+SiYCt!x|GeYjwynEx
z=EnX#r0YMME6sNp8JHN<nhOJt>@Y&K85z`$|EGF5UP!?S!6T**un=bDI(Na3x6b;J
z`gbtrTvuXDOiWtL>PvmAGQ$*&<mI~vf^$VhyPOpPl&%k!qd54vi6<7IsjJIU-gC%*
zVirT{%8ah5g0Slt^<_H(5MLx69c59EEe)cRHS2M8X>-!=B;!{j38&gBd50|~It={@
zl7bDsw|mvSJiT8fT~fRqZx=D^4=vlaHuA9n#{H6GXG2X@JYHYxa~&<iOgGpFPX2Zm
z^4zA+m-j&(q|cRLsWBH-^?4~Sh>z1r+ju{z_wh{m<OgP&lZp%N7D_1BB->I<Tzf7>
z79#%2J6$roJ!EbvPwb>=>~`y3U5LIY@|JE!-A<nNEShqc-iyQD)*i+*xtJ~4ORrfT
zvO*dlSE~bj4=E$2tMgfVljhD8v;@*uPF9o$vJNPACMaGL(uApZ*DUeByg{;V+QPgA
zCt@28E1z_SIMQE^icSi490}9?9Yc+iRw1`eCrkvYpBW)RM?E((_N{JB@U1O(${O`;
zi_q(|2a@W>^h7&N2xk<$JgqVIKtdwVUEOsnDmXxFCapYz^q#PvNS_YbtBdXr=+DF&
z=PYM-J;$FKmxa&ItxS4k5$=jJC%l(P;QIj2WA$Y>@3Lm@itWg-z2d|rT4-~;jErpf
z6YX8%H>lo~5jOhC9e~=69nqbXKEFu;#g4@Z-bFJ#6gEAf{gh%LPF;~k(cU72)yj7$
z8Qq;fWK#-)9q_gzDi6$%-q>B_u-XlPm|{;70zr+_UYF48%{9z#Bw>CI1VECx>59nB
z>%-mgjZY)EZo(uR1XP9+CIOKMX-npOHHr7*+JioqOujwl@hh|Zpc;tbu4t0Ak^^R4
zZ}~rhzRE7FYS|C^I(w-sI;x~>x+=hhpJS;MeKYM^XjP>Os`V%ax<i*tkX``<1Kh59
zW+<@Il;%oW+5S!e%P5~ou|AK6J-rbX-?M=5*2RB@sI9r~lseM>OIGkGf4t=Sfz-@f
z>n|!tm_40avA_F}*2)xjQ#(%43!}ab?W`f65j@z)RQt>zmnXdhSC29`Fie14Cye8`
zdjZonZx+gBj|9w><;inLlFa+t`ojfPo~0eSrmqAgR4eW6r)zp}-x7cYPEZLF2n*Dm
zk+#0?G@V#3b_eXhA&}(z+D?%X{*zFbFl~&b6*(FR8ZB+5E&HWa5LUN*Uxw6o9fH_e
ziwX_ytE6?fgxM4Bt(;T9jj3-FXXxw4E$K;lv{m79`#uxOXAXTV-iGkb53GZfqVkeY
zYBq>swP)LN(dr9>K((k)5Ks9qOiTlnss^^0_v5Ji7n}is8jE!k)f{VX6w4h1wgs
zcjc;w+7x_yDfio(lS|xV;Q7J*(q`P0r%lZmk!q@Fy53?6+eqj;C)p**-<2Apuf30d
zH5uh=2Nj|USjI~!wdL-bYVGyZjdY)AUrC*$TTilgB%$jzvnR|(%c1>Ne+mZEr=G?_
zQKx!%9?Cu7R6;1#Uh&hV2HOf$?36?5F(y_I0lmEwn9GTytlKO0EH~-Fp-omHV|fOG
z;OoAF*^=JSSjGHI%aFWbCegG*7PR#5yyU_hFTtq*UV47cncp-2!<bq3S$3PwB+yR~
zjN$Odk$IGe#OX}x)tQt}z>9b7u|ts3_TWS;boeLNetyZ|26E4Wmm;DMQ8m)hE&oCC
zA@@^T1o#;qw6vD4ngmcCj7hWgeM*Ksql%i%Lgo2N8r;XMF`rPA1N0-EKA({NYCRFX
z_wa5rI{5OPuugXYB-w^em)*I+@{qv9v^$d$i9L|Z_}fuFJtn({OOd~N)J5jl@ivL=
z`F`qlmX+`=rf8u$Q1M6flraWMc;p}t51AJymZa2?_pa>+ovf3qdQjW6?aS<Ct~2Pv
z;GlxE;3|2&CF6pScE*Xut;6pekbU-}^DmU)hl{KitB;~6Au{nU%^6_doqo)bqO1!9
zB1n=bIk*lZKM2{wAmVnG$YE)g8t)#l!&3U{_oHqcBd?wE@6SY#JJ~lbj3ddBA|*0a
zun+Sx3R2IgMEwR{GQewgBu@QkR;fF%0upUy{{w^iK0>KGH|f}|P4(wV5~ul&8tvJN
zct*C1wo&oj?n7=IUx)F>aSwWQ6VR+l??&vvobt@|;lp{E^;>yl5otC^w>-(3tm*Ps
z8BEy9X!5M#mR3rnoD%vy6IYaPi@W2bIJ3_3X~|I~9DVLix-)(`7E2M^w(=koB-yh8
ztY)`9uW#nCXr)4Ap`mN%D`}6MzUi*nF@K1Z$BB$YN-zHBlzi=>`Exe|=H=+UEOpA}
zoT0D-cgM0Doke|Tg?%zJ#MtjE!??#A3GDoD!iPpkO8f;yt+J(H>>#c0;BcjvAe}lu
za8Y=FTvLw~vOKchzYeq3R!vyJIR#FE?6BkXZ9%tJB*0lirVJ%<<6}y5*j2Y<**b^5
zv(n`1gT*fMwc?z?gZB%YSN0m9zKWu`(G#2J-{Pe&dtt-2%V00XpoMP87o1NJ1<u1M
z5OxLBv^r24tKl79)5{o2w<!v>?LnHj412NBuoTfk(mb*kEqS$7;*?Td<)0ekd_JJm
znE%H>EbbH%SqwYZ2OXiSDp$DJVa#8$F}=0U4X986Y3MAfChs0jCobHTjGrbzxes;+
zPd6<0vm@Q`0^gD)E7SP~1?9Mz7<u5XL=PKI8w+_xt+8D*m5APd*zHq{xHXP*c*UNx
zI`UPJznqddAnsV+qu4Ee^14BWm3Z*Wb7C#A+$uX{WY8hGv+z9cWbJ~%BGWi(EPtIL
zyXo02f`2KVPDTFO9dsjgKakt(x2YPIx|iZ-7q*QdWLitB0>J4d&}9tbIU)fDY1tjz
z^2oQZ6&Z3(d=TvhAms_u<fOPZLwsL5p`^#R0&2$eCzo|kj+Oz4X^oTz;(<P9>1-Sf
z+lK3hpv&Ko<oX5i1~@qpIfJew*mbfqDVNou-^1rQH)X07A>SvVM03w7-30W753x#9
z4L1y7n8BgeB;i&A`y!YJ-(jA**t+7=EOV(bYA*mY{9{}2E-8YgeydC-PWzo!?aF{t
zLtd9J{GHzBCRN$NQeZ@e49w?m;eFuw0+Cmu>}y3X>Unf;c;AOQQaHf+sIy#M%#Tf-
zx5T3Kc<w-WIhwgUDuQ~;yrW5X+z7mRHcL;H%>eM}pvzr!GRF51*l7=&+7xoZlN!%e
zpTBs<l6>zCL1HI{*xJ#q;kNV=Zsm9h+rbZ$OOE#CF7HhND8BxJeY*2Mpop_alg01c
zj)4+@KWBED^0@lOPfq*n;i_4kxXp(dXn?}a9g34K9CG(pprR?6x2%<Ls6Df*JSu<K
zT5&!<MDlTq6ic#j<^N(&Go~)*HiE^4Y{*mtoLWI{?pbiawBol*@u|+R<wT3UDbDaF
zHx#kyd8VQjpM<{($LJ#tjD!)zH}ImIs`1y@H?QXY;*TT}g@frgG8v2dZ6H#r#a~~8
zkZjXu1GcUiZbZiVZ(`^(XphQ0>5>@&hCXJbaavt?+9)F#-SzdCR;hjj$^)W!@!2hv
z$c@BO`Sg7FdUAI;a|k{2q8qLCp6@BoY=&iYiM=lQitcc8x8C`r>d{+kGh5I+%1o2Y
z=w)>3Uixfx#k@3|QQb4D4SP@v*2%QBMv>xC7}cgW;tjcYAdE;6N1jrI5(mE0twd=S
zvqA3CtIluHQ5M@%Hg~)q|Gr(X0;vCDL|=29x_t}Bs5bOC18%O2Q#Y2V=OqloN7M1v
zi%am@Op!4b)ACCX^9kevifoQygaMl0Ge7;5z5N)=s0hSuIexSH2{Whk(X-^nfpdY)
z4r^_cX&i>wM0Jp2p*F7CbFrNBpeNB{2Tb!!5W7bt9L@dH=q}P<@S-`kD-raDl_`*N
zJ6X!dv15m^pXc<)^QcBM{b;;JovrxcY_6-6b0k?Tb`*wRfp-=m_pj7@DBOsp;@~DZ
z^e$~PTqIyuK9L_-Y4J#dJ_P;R6J(MTp`gn4iJo~2{+|%rkBKen<m{j!64@pT=!$Yw
zauaDQNYOopTM{3YB%La3miMyz-H7A^cy1rVS(tf;R)F(+(_)4ZcLy0_z6&*D(YVYJ
zf}sWtNZ{tV86!c48WZ|BQ?--_?TueILvemqoX8jrfu4@IiF=i@>2RciY|fxF3w^X-
z0+AfTC}@%62&|2Sf)KeuS6+vKaI)z}=pcGVPXn|XYAf*4$p9)`u^2sUv{KLg(9L7_
zjBtCKEqZk}_^un(v=RO<F<b6`B^(;zVQ!24)t5w`()wX<^(7NL4L>YLLR<(u<!^X(
znn{;@We_2%Av09tOfp3!>;N%w(g{?w6MjT2aXz%YvsaEfLOS@5&Q#OOThV|@bS6pa
zhajH5!lg!MbT>B7c@t=~&#WL}0sy-z!TTynP8KnwjcHo|$woXxVJ#st<2ua`ZK4`z
zNoc*9^qb6MH=PTc`oGW4E(9#@zRWS5@$2=`ylH_0q$BDpH+exPV8!N4hnR9#?fy5+
z!uNp}zv%1i1>k3lpz##q1B;jz3sD?Vcl$il!lQ2+-p*Bf(4T9O<=9$!90@LH5?id@
z0`%uK7M%lde~QKGuYAI!;>!X2%iE}=*mAhJU()M^ETFLiRNy?XS9x}JL)M{Vld8&;
zSzESYzvw!bju^s<3PL`vMNP=ntx^5*_`INeE-$>nkCn~yLIg3zH>eF77@tCFmOtR;
z_8)dy@|x`uqZ^)1CNM$@bWXhZZfI2hvr-q)zlP+D&zM$uKx=Xayo3raIH_2nOyv@I
z2A;K|+%f~e_o>;x6p6Ri8M-zGANLD!TCM{t@Sm0M_olslWvncgSt-^yti9^+kfKa;
z;bl89ed?S*#&Bgr?8GXB_#YhddHzL4gp8ALKXWO!EnCa90WR}QGiGzBnx9Ay81gk8
zL@<psM6IaJI8G9N&P5{*jL$#h$mj}^MdpdsFpw>Bi}cpwcdvidx$QWL^j}0BU(ROf
z_oYvL*cM{_iUBHK@R4pE4j+<p;!P2=>zi}BY^7?e;iJ<2bh9j3^`nJ9Hfb#C#GCM6
zRkPWw4K3o`IHZef_JucaUQiBM+%->uIWl4?L+urwkY;_JvtaoW%_k?CI3#|S{0eyP
zNe(RaSwCHlV-%w@zJNa@#xhR1{G*Q|<Gz1H6=V7+5F=M`6s}lq<w?g;wDX30s6<|c
z;r0bK&%Ph=Pdwq)y0cm~iY6+ehs5IzG1@{G<su2ESmcv%YUunK0YP8kw2d%SHsHC5
z@X-4WdDD3A0RELHIa*^j6MKT<_r}bPJ!(WK%E>ohkHH_o!}U^zOo)O8H@5D8a>^s5
zScS}azqW-B(2~?iRWd8rl`DS2_(f(2S9?mVdcBjTZ7p*SUR~)1srz3<5ODkVqymn9
zVZTRDXj61F-K1_ww?<GgHN5XAM-s~Z*NSyAnrI+LxC(rjnbRFk560rmyH>wBwrsgF
zl{)ug&==)w)(2|T40i1dhINkz)JN&QHMWFcaX)kH5$h?(oi0x#wSZJ%fvGat3@ZnE
bEp6_q_?u%`@8_Zxt^WCappc{!8#eqG-k)(Z
literal 0
HcmV?d00001
diff --git a/data/BPoirier.rda b/data/BPoirier.rda
new file mode 100644
index 0000000000000000000000000000000000000000..9ca6a5037c2c36d3cdba66abad474d0c020717e2
GIT binary patch
literal 3211
zcmZA1cT^MB0>^Q!R!~qX$P#G;)IcawKny!-1w=|BAfOD>vLi?sLRd+(ilZ!LNW%)q
zh=_nd0F@D2L6#U0YQjns!b$=(30Y)4tM8rD*ZbG+e9ryj`_H|AOyw<~&$iWKkLW-@
z&3;1re0xkLXzDTO4zc>7$MnRYq!d@sJHOuS*uFG8pX>Vw%6#NGJ{50x@Vj%z!?vlb
zPzyBGz52dt{@L62{CCuIy${vz>;~x_Up0L6(ChHT_irUKGRL9c<G@x;FSBfN_c|>N
zvs9Y4hDNTHEcTwYAzGd{-nY3+HVcDeJ8VWNGL-Aj6|pEknzb+8frQ3{bWSf^k3la@
zX(!of#$yYYnnGI=GE8OmGNlzPEKIJ4w5DNYV?%6qT?1a0G7y@`$*59DSJgbu!Y&=}
zQEYzf*biXTtRNwxGLnaa`}^7XPF>fQP0A%(-e048l5@K{rc*@?;g^c#ufxOf(ntWA
zS%ya`NPiWGt-R9+65;KkQ#BNMI$G?Uu}6Z%iw{Hmn?m`00O6*!yg#c%E}MA^UzpUF
zj^%RsLEbko?2+j!JeMHeQ#^nggy^B`VJAyE0ysXOBo`p=8d{jIq`ZgEKBJn=U>%>g
zWTIL0_IF{0Z>eooNvltS?9*%sqP5i#<nDD}jM{G0cF;}GX;3fd5U3io&&Rm#oR+=K
z&ou|vX_G1}?Xc@d_jD662()M>iSjIFHGgL41(L3L!(kb3Im2uO&Nu%d%vV~x&jCjc
zCHtpH!Wxsdhds9R!#yd)@uJ`gqPlQ6boHB|z_1p}08<}RTL6%}!E$H~fj}-II@l2y
z0&^CTE*Egd+0VluX{e*QZ0KcSkg2p^D~fb=R!F*70?P3H)$)fOp#uc-F((!ANy0gA
zRO<wZGt%qLtf)(EouIe634e^k|51nQoL3;{8X*g+j3cq5N4{4O^GNOjr$SY&c&vmb
zV<YCTZPo7@xkiKT2TZlLvU#czG9LMuIKpyDjlqY;3&Rj_o2w<5NZUcYG(H%25o@Nz
zQ^KXS+y2GYpR%%&kT1d2XC8FO(#mI2*HN;x_z5lX*6x*}8qa&e;0P1iLyqI<)@*u<
zb9Y!~>M#-62ac6qUZC1f&Z)+8mARGRBss<_MG)Ao49ICz_<UO>Kg`hBrMkLx-jJzg
z@SN|n3n!;{xuTUFx5`d2td@8Fc5w3W+7^EQ3Q83n#srS>4p2;Cq4O@fVEK(7YbRXS
zM;O~>{YS&+y*JJv-_!~YBpsStKH5^u*Q=q6?7L-s_x0zpA4Zg7!d~ND9$fC0nNlIX
zD-GmI?4lp8=Wa)<z-<HSkT(f-lN{T;JW)@z$OQ0uujD2F7=qGFtCi>ROMW1$#ubML
z?p~X@Jt<1rcv~59D{frWTwy18(}l}!3htPSie-u@y*XNP@FVaAs>*UyPsyM&lMfG-
zu>hehef%A%O!}}$MMU2;aS)k>=8K{NHL%4Z`nB;xM-!zN4${n|kuRh6(hC7$tHY$>
z#*Sg#CRyAO``(&t`P-)FIW*0U#&59vfIskW_oa@tZb#jf>$BHi<~zEJro)~5zP*uP
z(Al^<aVK`_T_&Adm0+7c{D#-UuIagzUe1YPjDX|~j`s$A8k;H=$9OF-<;?@>M5VD|
zhlb#FozngBIedpI{<R?Mh2INl;w!J(x(vw0X54JK*}^u?laSm^aKY`Y`tha=`H@u*
zw*P6SL6oQ1yqx_mnfr+U?J6UoEG1ff>Ff8fGQq9I+YT2Ea;JLTQd)nR9V*(BYR^Ci
zh;Nn+PZX_CUiXA89L9WSMRFgC;+}O_2|CrpojfFddQ;yY7{yotaRLq>t?y0IB>4`e
zEzE+F8coWV$I`*gC|sOAH`*lA@1*eKmQK<yw0WvnCr>gnptP*=yb-OiolE#tFg{>0
zckVQ@P~5b4$%LDHOGIQS@g@(_SsShBrw^u=h_Fa`P8h{VFlHXIuKkgP!D4*@;%_8Z
z>3Rf(jdX7^A(A2sDaX8k`820}r2r1nnbX~vD0+;s0=Kk-qP;@eLKf^^EfEo99V0K6
zjgcIyQ%;$*gRMvgU;=+a;m1*Y&k_A5*p<o?3f1Rp>tN^b2i0o#sV!c~!B`ErZ5+2=
zFNRCUWsjf-rrBh7uD7u0<a@m?BauW|05}QT5^;ey>`=IZ&jaqHn2PLQ+v$J$D7wCP
z#*PU0r5^d{5#K$OJiET&_k%=N0B%!!jL7F?GGO`7n9n!1%N?>Eg@)_Zj@2>~DOz1}
zc0;cZ<A~Doi74$k1{-r~kUG<=r<&bas0VU^!zqbjdZ(JYb|>UMS%1^4{_TrPAR(j4
zajB?HekZ?tTS;%*joI9HFrlL(`215;jsUa@Y{Te6a%XqHFIseC`OslG7CGny21ver
z$ZF&UbIR`y-8d!i;|nyrB8aXHeWh20FE1kK!i{3AepN|K!~E3KmOBVb!<=YZW0}35
zR!?~>nbE!nvsg3cD33MCB6Mt_2TZd};Vap<-&d^}`D3f7gv9!FHEsael_#o4KOdA+
zr5fUju6qDcQ~Eu~lp3sJX`j5H4HK#+dH<c4WHWB#%}4lcv<J(bmwJeW`e4rWgLHb^
z6|yIc&O9mbuZyh7E6m!v-{_c2WY(xorNya`o3E9#KSQXhJ!?5LYp<@6rAuhmfX;mj
z!;sUj?_}@QGdk`Poki7Ywg?XC{Q?#)!CAdJcP-Q*8J7Q>A=R(XWZ&O!WbJY}YeJ{a
z!s|159&;JfaSqv+{r}@|NI{mTrOTks|BvG?lR9A`1=*he7#FkTA9{D1@3^Get&?IQ
z2%hVk$aFS;(6vl_iMT%g72#{BN~xBOS*-tu&v1&60aYo}vNOBtzf2rORF3}*nWb8`
zX7T<E;sE0QxFNy$3ncloiBv@Mcrc+4npvi0Z}vCzBJPf>6AnY&OCQ*n#re;D1}{Pl
z)V(ZRavHm=tNG7}3+;0!P!`FyRG&Sl!m6N!WWN+`t22)KorN_F=YVNhrTNQIKiB0t
zz0^w?PAiq<Gs_=$eTn;5%a^!+wS0;DSId9n?93AVnZyZ1-T0Td2Y<sD!kM6nx)Phz
z&#t}SfE&nc*48ku?U4J{Vwc*c|71BjDbnR)HbjQUI`PL*^DuJL$PV-9^o03eFfp~1
zj@xgeqf61ap&)Z)3@Ir*MCP-qTf%B$w??Rz2SCyg37xTM(g%hgFuS$zN9N61-w$^5
zWNn+1I)qv14jYr-YDiEoW-0Z&$fYqKR<^wzej1Wqw#9n1KL0`)am6DzC@D_;X+^&A
zl(uc%_#lq9%sd^Vjtv*>Xk;bE-Fc;2ItUgYQMfb#ykq+j_y}p~+;zALkuqA($$ZY@
zQ5(ROsre5%<95Fr934@5G>-HILPV767~t~y;wCE;25b#P#^)K7LzS(`e}YqOx&5?)
zIoC4IP{~aWJVfgD>CPG8L~6*fCmLqb1`D`KtQp+ab4*XK8)uvl#3zhtzw-FN9JvWS
zpEze#nxFbgt|~A#FF?NP24a)u9)tT*s|+Ozuo9{LPB^eVcWGlK;*2xXLbh<5cJ;uY
zHjMxmJZ7+h!wn!sCl_NjzkU_l7zCs`Z?05-dXV$=f%y07220Nx^QWD;E+mn1R5$N2
z$Ibw93)9y&B>G0;KUGAeSD=2ubbt~KpJ@24+H>83Z#2%x@`AGxt%jc=sxjhom7jjF
z1ts2NS$L^nFZ(IjGZ24@{7m517zHmc2o1u&>k)>pV+demhzKYl0?tR`fBLo;7wQN@
zpo0m|1jFicw!2_F>sncn*jI6Js-9|lU7t%?%y>3T0*MV3uDVFhi6+dX!5ZamJ@hw1
z0`IYg|D>lgo^~xe5-`x`%38PaO6<O$(gHSD>4s<m9$$UxE)GP-!GAY*D@%`3+zafy
zx8izseSq}ANu9seIRqPA+{e<gKjb=~Q9WsDA9I948{VLwUR>?Q9ZN$Rj?mHr`CUdP
zY5dG>gFe!tH<O*fMg(-Id`FTyG_owr3nMGS6kmaibS14$xpwf=NS%olE!}Z~yrH6Y
zvQp>J=4NVS6z`9PpHO}NN3S5G1FPeg`WmuZml~!N?{GyZlT1saU3jS;Jj2*m#d^z@
F{{W$y%!dE~
literal 0
HcmV?d00001
diff --git a/data/Couepia.rda b/data/Couepia.rda
new file mode 100755
index 0000000000000000000000000000000000000000..401e81f0c356a4dc313b5c74abacf65e68a04ea0
GIT binary patch
literal 2155
zcmZwHdpHvcAHeZWZ#_w!bR$csi4uz@60(v;R_<91acIY+?2HtSOWuxLwh<WzV_0q_
z<Cx~!D)*Jk(ra#QG55>Hu$kT7a{f8*^Sr<3_s947{Q3Lir;SzGvN``+%!b_~!c{v?
zywN~CX8gM<@sFa%H(wNZ<nu4Qwkg?m_fV}dPbVxfw`UOW`w`3hgy{=fCk&kps!=zO
zs(NG&_FbP$zMet&kE)V0$gIkD%;D%WrSw~mpY4su@cG0R95RV_@xhBOMZUzG9?F}S
z=*0*PLfPf@ZsqQG4Na}rQ}8Ou2mGJJI=;|zRoSzulf}UMA&ZS?mdjh-ycZpNF!Q{b
zp!wPTuCz*Vb%WHU#;beCJi+%alP<waQ`XajQiGLgg+Lh8F*n+4O%pXrvr<uO*)*SA
zh=R3%2>d3qxlt<@zb_Lf*m0!=FU3}pjRkFbw6OB7kWkC_+F;ZEnufX$uW;pKcD3sR
zq8%jdG7pGwYL?e%Vn-E?@EZHk`8^L~x#N4kHYv0x$t#hn5S^D|dntLP%OX&+d#xyo
ze?ibUnPl?Ps40w(2(PA`5@SL0$L5dEf4<jfK0>i*lmxQa9~+ltb3=_!Tp!k~uDqW<
zG{he2PuPjFT+4Av39soWqe2wzt7EpWQYx{np5pQvg9_4@kCB}gnzYlN%SRbQk|BBO
zS2;oM#8LD=g4Jr~l~NSktk@VXpPm)jZ8vaP*lTay(Bo<}Z9j0e2Vc=Y(_k-&?3mP_
z2S=u)cpmC<TSyB#9};uCr#x+~6Hm-_@f-+TJ%X>qet|V<Kky#(v7p$o;(PnT#P1@<
ze#Q7Z|9MUGc1&eRMc;s{ox?5!tso4GpbY{rQs393k*l0MQsI~_LOK6nl>RnXrQ*F;
zk7e2b<8f8}ZU~2<uKsjN@kLl+CJ@wyaG<`}?F7gNTOq?4OBrMFWVhxzkHKd{&lqm3
zU27l6u-f;wKUavtmGRZ{?5?++FQ-==u|*?}2D+;^O7Cw#KAg4>wgj0}w%6fVd1fIe
zg;P#MN4`b(qGfa(2DuE!3>QWp4o<-s4BnuIvI0fulNj`Mi{|PCpLX=Sa+At9nQ=t4
zm*DdBH?KCi-orSlGS0}c(6Xh$Rs!ZaL<r37qSn1zD$j5<KEXBVpz-@$T5T#`p(Se=
zIm!J!bmk{U<Z1wMY9=<mPSEP|j<k>(Z|O*R-Vru_`!U^C23z+;MiDkFWQVQ3BGPwY
zYDHCwi_*c|of!UpQA8<CZx)W(0F0kceY#XqMY?EIkjj*Ai!pMI-I-S+6Pz#Yb%DTS
zhHGFncES^=FcqXn!+VOTS<AE(`r$>>d)cXbVj8F-brvByHX(9>ozj1OpgHwx0GswF
z9aP@IIl=5L^3mm?aTB=*bkRe-y5pXDJXL80I7Tzpv?suy5r`G)MNs?nWS%3ABa)e)
z)^w%|@ti5UyoY0tsx4bfSM(*xG0jI1mrl%zf)?_|<hiR^;(4w@t!X;RhldA_YD|Pa
zk-~*U_Hn+cz^j-Osa5PPgb_C8&L6x@Fb}E-C17q$1rg+?=3(QN&(Y7rb6Z(=ZhL;p
zs&LB<9WHrWbFK&ya!TY1$r|V8Lvnv>Sm+1cQW3C$x9dA3RJ3vBrBRK)RKA(ji*hD7
zK)IPHZ?q;zwbWpT<11Qr))D1^Us$u?QzGAdITrW*Z1HsttukQDgjjIJy@$nJpWPQg
zva%q;htQh!y<OxTPQpcyVD7`>H~M7-@1QKgF*se3SysW_Bb(v0@w9idV8js8J)Vk0
zHJ|NCBwwGitY{<#Tu?0KEKo|CoZbbpp#T<;Z?@8BqhVz?zy69zcZ`Nf_rssp<?cTu
zzHjV<zuMl<?(|1n5<+hsqbp13TT2-h?&@&8eA9N0uase(0}QScXnFjSH_`kn@(^Uz
zr#Ln{qTE<J#OX^S8R{i?drb7XTT^Op{V8=+JH5jqg3(O1iLLJ#7$bBA<VC@keTKAp
zVzbvL#V(ze-avUe)oG826d?V$q&x_(@)<7H7J_52s?q}#B6s`hVHu@})ybbU6!L!a
zDuPWI@RL>sw=V$Y6VaaIX%ZVYxzZ#!PL8F1lsu&x@l`tDjPudN@F{i0?ieGs)|<(C
zYb?o->$lM*S<0#k7=u8Yo6cQhp60vwwB%nRvD+Y{fQ1Kl6GNA`NUjc(is(%V_Oj5y
zP@QFK-8GzK>msk37y`*_muH92GutQ5k)&*^_r2Yi+2tMuhXT{rZ*hBC`uzjE1xF#*
z8B2sQgBJKx%5I-c*v3%G*mqLL8Crn52#5o3MQ*|=9d~FM&KXb$wn6^EP$KO60WWa&
zfHW`=Y0F5=*r%`Kx(U@_KV&N-k+9D|#{*h{y9xLK#~Jn+X(x4DphY-aKoWTW-{1m;
z0szQ68EO9vb?$7rzCp?BnOjVnpKn`Va+<2Yfu6@%#4sw5T#U~&``?IwuHdEs-6lB!
zXM0ikOe^vxXmp>;L7(NI-ZG=eV(1Ef>N_BOsqav6%&p|@&|Nq+b&&BU6f$kd@z7m(
zwZovZ2o$vs^#iUzu{bpV2#mNx?L?(9fq#Pr$P96hI*6)f`jOk9SiIT~@T0b(l9>C+
zx=<J{Qyp|>698l+F7phc9rceG@*e-c`!g?H<YTKhab;p%F(|X0TQZ%j>WJ-lw9vv&
z;3!`6`#5fnm8!XIrs5~bQd{$g8fWyE<eMrF82GhG|CE`o;tzh!Ua;m^tArTzwLbqM
m53h=kw<s)+)}Uq&!{Eef7bC;ab~nCkm$bkJU3hfMmj43iE}0$x
literal 0
HcmV?d00001
diff --git a/data/Paracou15.rda b/data/Paracou15.rda
new file mode 100755
index 0000000000000000000000000000000000000000..b0783a29fe6933739891790764d2eeedf223b8b1
GIT binary patch
literal 47601
zcmW)Hdmz*Q_kX!Gqs*;zW3JJKDSdL^ToO{I)LS=O>RnRr$SuPzuA$_fr7%KE7t>X4
z8`C>PCK7MA%`F?T&BpHAZ{OekdHwOaJ<mDM*W*0S<D7vXXl(fZKh@<nU|ERwBN*c0
z0TsPx2cBshNu8k%CQSaP(|y$tIQTmC7)vMXkD7|!DZiy|6OEnTYPz+LHmJU{*si<X
zZi{p1?zkHUaXO08>dwkay`wuWVOQCbDN#kRAW0HCjPZ|bl8IW&&P=|1KU^1-G^{HD
zUmTkoJy{mB)P%QG>`}a?Obx(pM_?McIuoCh<W4-pvbd=aEH7l^_WPrknGTkI^Gp)@
zFDLc#r1OPXFF#5J7Uuo_%xs>+jAahHRQTQ+>P5c~2Y&7-<<T6&xdXW8e?5M4tlj~a
zEoXZP>A;=wsb6gdKC6STd@qmrC2H9yy6#svRfR(&vTAX50IdK5W&3WE=py|Ef(x!O
zV`1|=SX1Uz+=Mv$qHcLUI7{!j=EO0^E;aIf>bTZF#0G<_qKC!UrF~_*D^L2%KI%=S
z43gk<@8S7!3v51<oXgl{4eMRIkaAJeK=cOoNGs8k?4Ubolnr^V<+izSHw4amgBl0Y
zmj<~5R`N3xPk{LJXZs%;<s+xab(><<bU~s~+o==$D)6X2%LsKAcFWROyb;%;S!R2u
zq`g$dzl{|exz+LHOiPY%GNsYsA<>IrTMQBsPc=8{!oDFRoi{_D4+(bYt<=O;j(c!7
zpRbtowPgSlk>(msDWvxfTRaGBAPuqQGvwmQp<z@?K9VJPKGc>WOviQrglT2FVJE3C
z0PXKxJh}nc1>esT$c!XE)Tef*!um_~RE#>gTzC`(@uTGV69Mw`s~Av#4>z()aEQBi
z+Rd`nYPBgAI<Vg#g%pwDkrx8yMxytieL+wUBo{x#GF43F`;*z@gs<-%ew1z@XB%@o
zAlL8#nW%16?7AsbFcZrF@Wn$?GvmZGqZ>{whcVralrLawly)&2utqeU5fG)4Q__v|
zv927l7nPll2Jk@yEDQ+V08OXFe~u-qhCIQ|d2N^4QFengoH`adjvDGncTYSG05#=<
zbkM1=;fqcW*(Mz^8wS&0egMo3kqNk`HqqlTbEf62Z6z@=jwQX&|HaDWTTFcoVSgxd
zRwpG!ovcN-RJf=c?-S97{Re6(;LYa(W?eowY$;u-vbE_lRRgKwj)JC}+Q<E+EwS5I
z(?DMVt~qQS5jJZs6ERB8H;#_;7k65s)6?_vIn#x5&Rsu{lVm75zER(zHB)&CppHx0
zxv#t;mb_ANm>f~FWQ9%AFq^!*6T&h2<>E@2^aYVk0n?|*1$jc3*94&<+8WMehZMut
zyrkC1{E^xr)6K4vsmR_fLQ^>08T`jjv<<bLqi<vbd8U;VDBoK?wy}q}J`kMYb6jXW
z&AZWq`y1zMG?TXt?E^YJT04EJvNJlR-oCQNMH6+jzFM9Bqb>XeJ%e5?8Jsp34+%@5
zLbbkbz$l@ggpy>@*JFiD<C&*Im-}<x34aT>L397Wi6iJ$nKdKR)c|_)j?ivZ6~;`1
zJyMn4ceN&6&B%+_s)+9uT+QfzOYJ(Cy0E>bQ-ILK522=Pq`S>y18wgESQhkyp6t<z
z*mI&?C%X0*^Lgoc@#bJE;}z_C=Bl~WXviOJLUI4ObX5l~I-}jKC6WxXa;sv$g+)Gr
za3sb+iVv0jh|kt_we~6QiqeDDL&{g&R%LDNL*@-9xb3jV{Q~2T_}$D@gbO!?jbYgd
zowTD5;=T~E0A#N4nDaERO=V$iyHK*X{7Yv<{)%I_B`a6`k6-T=aeGmfDt1RCa_1rB
z1#O|WlRBY<#KHW7djhdpfX<`|z2&n<>jnIpp}iJOzk#j@4w+J>O##KK(OaitTRjU5
zi(1%*t!#5=o_KJ2v+*}vYxf#-ZkGi#i!Bh;ifEiPv<7}ixSce(<hNkY@|6p;=xnyB
z{L&N9uvh6E+ng-PhS$Wa0W!N_d7T&wf<F(Ca1L4mj*b#l8Q*OC<JT27_vhpg0QtD9
z-7!dVJJo0WRJKo>7v_tj&hm{$Mu(&RnvQ%!^kszV?2(*mJ8e%%4%h6fDceLCAj%b8
z>~pw7(dFrCTs7Xzd)J<qP+^_{6<6(`SOzXXCuvTTrsE4hvTc3UX%T>ogT_8iRkCzs
z2io{|%E5q6)Q;Kk3agZ<Je{mnc7fDQkN!TD+N-8Xp7pMul~`|f&E=TEW^4IfTClF!
zBtWgcv)ghfuQpJ)$lBv7B$rUzT^<dZD>MrYr755p`cJDLBmDd{&Ue5+@P#4H{n%#X
z4hP&#=W;CDe-?ntUl3w7RrL^$h?zo_sg=X!Ihfc$=PFgVG81&gK>0mhMnBMO1eh90
zo+H3a0#|8B4;`V42BG_ZluXXF%j#O7GuqGz?hfT>HRlsgNFipUUOHS^YM7l3aZnxF
zJqbfQKYCRbKtvtw7d@~pXPjy&jJ3)_4-glDq0|1os_0n#zsc%sY3^bAagYwz%>uyG
zKE6F#19y|u7T$a_l1c*>Mx-#1Ca8e2eW7SJF_xjq=NgI9SF(-5(N@ly=5BMU1l4e7
zt+DI?Kt@3>$CRF(oJ*aLm8uMEb+ra`SEELra}St6&yXHyM8f9HUB7i*-U;I8tR9>;
zD=gyJFwI5cZ2GlAlGo)@;j-?iKX)>`bzeMu=XJhq><4tP?{==L1w6^wjrkI*16eK8
zXf_l0QAhmraD@!FI*gE$EmN_iXXjsJmRn30B_jt3hu!JHHA5-judmR>>UZ_A92>r2
z^Wih%UN!cGlx~1DCw>Qa(uZ{po1SD{K~bffbVSU6xJD{Q+=s$<?p4*|b4Nw#3jN?3
zk&5yBdnDt~ar)ISs-Ct3$YbbaI6i=M7bMPadCIYq*RdJ~0rHP}5mxdJ$lRZ5&IS+0
zMnxq=bZC8#(D1l8qfntrWdriD$<);Ns_wQ1a~p?2h}z^<HFbsGEg(q9w1SQe@nOla
zZ7SnK(NWHG$j{xCTCR+wJ3=X#X@brNNe}3cnzOc>;YwFkZI2ISlJi0H)qH0SGaQWj
zK1aCC=`5(dD_R%!66D@JjMpX{pu@L80}vk52tQCOmDb~_n2X3Z6ocKN1-!qj;-f(r
zfXurXd;SRtWQSqIuuyX&{L}^2e4<-9eBMi5w+Y!zKPe(U7i~1E^^e|*RDmNdW)PDj
z9BMOLWk&&`vAr-3$wZle!K+*Hr9yJf97O9MtJcbqqLPbTuK-5KQ5}{VgkL4vAQ_^Y
zlExs^$#D5ks5qMqo!P}@Xh}_6-B)|!>p|A|oJozgpv2AA((--M3Kb{7ARVrYzOdp;
zFABgdo&lz<n0*_8vwrFAwm^3yw`HN*zR=$tCOnBWF(OItYW*=G&q?Z16=w#FPIz%}
z`&LyU$~?#!Kgnt*np=zD-ih7nt+)J)IqI!OUmRvkK|QbL)v%^W7mN>Tk;8ff_F+9Q
zyu=8*eIeps)dY``+D-;il(u{Mn0S4fwO`GRV=k<U{FzkTRYzT@yEVi)+`U&?c2Brf
zC4)4SsJ^~~rKSj14VN3tB)LpqJcjDXG$(u8jtasbWZAC94+(M)PX<Y{!1#Ma?d?*J
z05rRb{RKaB{wS;6is@xraIsfim<)(k`ZXg7m>PiFNn<UmgzSuVy2e*^`gNM@VGf=%
zszEP@qjnMvorVK4*g?TMyH6|tVE0KE89zUuk9QR&CC`;et%*5qe9eEXT-{WXfSSg_
zgzl?j2WS4zmw0KIM!9{uoaMQ|k9MA9b^EYr`LSW$0{f#=_DAJI8TBO>os6K>cqZu)
z=TJ&tn2+)zUqB**QciBvS3_{x%pUr1Jt7z(#oB4$c~Cyr946c}WlV)V4j@SbETz{{
zR8=Ibq)2DNpg#Hn;b_DgTG|)DY>{-})l7&7y?4`>c+T)ibh7Q-Hs_b{IeXy-LfC!R
zu-7Luw`#(|?rQuYQQxa6&ZmMiYx)hOVaKJVL3@#aTD;IcDMy(>vf*>=Jx-ejh5g%$
z8`|GrdP2VEh2D6#hF90xtG2F(oIK|G;}qtQY$`VKSNuJ8%3)~t8(})~4X90-4Bzt$
zf9w+OAs5?nN%Nm`R)J)D!yT)4x3d753vkwh*06e=QMmL(EuU)m=a?*majNajBfe^Q
z^EoTmw=J4+6IS$Tm^*0c<YR{vqpQ$6DFa>T-JHu4_o8gYO<6va_03gz3GS~Ip~gnM
zLyX{&D2vy;^G0X0M1JK89oKUsgCg^88}!vnFPB#jrFeqmi1D}{lB{a0S>8a3tkTUL
zr!xOccCZ5g%jWJ8tDg(rfNPGhifzzNjXLrx`xJZta;8NO8VWjx|F!nB?rc`VnLht3
z&~pn*=@tD?J)qNYNh!mNc>@=~Y487mt?*+-_2<%XW;wE5xzuEmKaN&LpXC)f0vykp
z^k0kc5?Pne{0r5AD*P6lw}Sc~kssgN(Rxu2?Np0%!T>0hkZ1;Jvj%n?7~vJl#Q1+}
zwB*8k>7v~>1pI6a+Fotd$+?U$8<XjnnJM!!N;h0syRP%4$+>K4mY3|fpn;7F_)sqN
z!49Z{6A}8-fq1tO)*#vp+`oU7Y~e=u@2U2Zs1K29KoVQDIvPHR$wJo~pj!(Dy<jbR
zf9$B25SBCgtCzvMsW(Bz#-dZk=v>Db=zE8Upv0g=6;YWr#~u4=S9d1w6FOpBG^gp8
zgZ@N@$&3iSuivdCUHe-mE!eDYVQW~B>-y}pbOt)V?+e+T@q?GHvW6z6_ZA1R^o;&!
zeGz?iDvpShYfJB4YVSpF1btH#u1)M&Fw{u8jI9FA<2h!SdjU@06;QonP6tB*x)uTo
zD%PkAXF9C--O(ywe%*q92g%=SPL*CsT)0tySf!+ytOw0Zn5`FG@5ddAW!d#xUO`&+
zr!6M<GJKrfIVVw36}pm$wX$2dCy0AsY91SHTSOzNP`-g&^`;1wzx<zr<jHwVUej>=
zfIw9VmyhVtPbioTmN0&5^lVJ?eSp-=t!HCfT}4Ws@Cw-jzPtft2_DxPnvPD{Ev$G8
zLpKV|6F!z@gVt65!M_AB@TiaaHT#Ruvd&&0=9cIXE(avt0Gb}p6AncK{=hR+z>=OS
zD=7Uz%xA~0`)o(r{g@obg{MxDHaZKo1t7@}(WS`Wt@Z9@jsG@Xb3<MVAOehQ^H2<R
zqe77Iun}`j@9>OiUIqAWc#~-N|2XF0rLCez#@tMPH!1PCG*b^_0~o-^Cdx06c}<ty
ze8wEmuKl`9(cdYKhPh}*$ZKKJ5JzLbk<cd*pBwDTh_TxeRpCK9<qvi9+3dXhg@hjA
zQNCCWZiMuwy{Hgpf|i`FR*l;TqXKs7tS&Yop7n|Wh~k)I0V$cPp2mzQwQ=D378-=$
z(qE<zws4lQ*p9H53+3ZO`Lu-ne@=S2W!j+D(DBHfgy)&N3*l>O;%ih@CrK6(|D3k4
zb{3QxOyeGZOmmBQOdFpm+uXmr=rmzW_2Tngqg`qN2Cj+n7KjlE{V}Mu`vDJL%Fi8C
zGCIHl&3+*tpnS)xrG)FhLDDn`8WQ9TTypxe9(!(H7yS}9XO-BOH<O0$&(CBoCPXnd
zB4$SRf!!!JvBOvk<AsNG8~WO%w*%8L?TIUYac0Z72W18;Co`R3{g&p0iry8gb9=0%
z%mfyc>f+0?c)c*~9pFZXpqWjJ(K}yaP2lh+ut)x!C8rB1iMiVXIg3uBsl$XsTXLE9
zk`tB#6j{6$v;1dAc>GEly%auxZ&(CMO-`U+7z2jvg5;H;#59AIYJUDJ*cK-kK@dz%
z8suKc#jwz5Sju4h(UIEuPy7NW1xSA0xEqvsG?R9X=M?QmvK8I2y-14}YzF`0iPGV$
zM?+GkNPNhHv8-<`S}SuDE?UaniI9_U+C%(aOzG-J5CIyCFy?ms5S&Q-ZMYgEHNi9r
z|D4RMg3N27IBl7$DUsdd{%AZ9OjZRkKN72^;2RttKkr)qBG71%9ds)J@cB}w%DE99
zOYdvK9XHCu21ajLH6G;#qX&pKD(j_=yow^cG;yV@a!?%$^n#VfaN8^zYlb8{HYr&O
zUKu0aEJCHtVPmW{c*Q2LDLFEKPOml57%b)2%uh=|fwm0fd<3`xWJ6LGHYKoCpwXz;
zF|z#dT+$|?JU6Ez1t8S}zZ{V(PgZm4*45B%7C2>n_DgHLZSb0Cd?=8md{9rf6{^z8
z2FK7(Oa!S>&4RxY1VqX$D90~)y5*NWntif2Gs^fk(GFfMkZ0{?Ql4SvlWy6OQld(8
z92z2CEmiqu##!|7u9k0II=|hj7Y&xjx;-5c*{yUozn;RINUxTIWSjc(uE<YI(hBn=
zMI7Q7E#FS;z+_j;+!LOGfv)F#0LXKcC;N1GHQU){Ict!d>bDh>rhy|EQwQ!Vna;H8
z(%;U6J)!)(0qqV%tke|6pMX-0RC-l1a;I*YpzH+)H2TVTK8e#_G_E;iV3?=qRlBP%
z*G@fw%jf{iEm>uuzBYDO?nl3r-WrO&#x%vjYQYxW+<aAj7O2fCRb&X|S7hJy12i=Q
zVN_3_H4qkHJ>iotT7(bHN)G(gZii5F4EevFS51LTV%I9vdWZr;lLI25vD%kg;;pM~
z<*Nd{a_oHoxP3gL<|=e|M_sr$k>cTG^jB-;`z({LG`af)#J^hDqf`2c*&r<y2$Qel
zrmdO^ox27tDQHczaG2d+G-11CI3iygRZ56Rp*Ak6N>fOP<A7EMDUW%e+U~MTh6hcz
z{2B{IhI_GWo=KClAjGN?kZ{S8tg})bn->0Je$*yV_<kknoC*Cc1<v+npwdT9w=z0p
z28oLF^fg3!wDW7pes5zk(vuCzN43#H-)wBzdmwh(YZI(e>tSMa+`?Z-Q^4KoP)Qd2
z8A%-BFymo}N(s~b;nln`H66~z-you|%_QYBNtR8ewyTXn&0AB$Ztf&3-cDv{Qe7TV
zQ-gbN@8J3<<p--v0i_biw_>mk+GC~TgX;yvq>6V%Uz-+&CG3-Fc*5BZ`3+O><XGib
zdMi61-kCBJVi7pV!fe{T@*F)G{z7ovWOFmaFgk7O@)KHL+t$kW2W&{549g}*%DwSy
zV=hVX#6))gFm|}>LSbg*^Y^PMxbA<YX*6s~J6pp{X7&u^+;)^!JO4BKZ;d98#!Qpm
zEzUvN6$3vcTh$_eSEv^RvAx`#3sfa7Yh?AgT{;>ffO>SZw;CS!$7J*>=YNmp+~vyJ
zu?1hr!8e6nQTG_=jGy*m6Fi#h(i<~ZZH_O@COIB97FiM&F-jIbf7OO-|M=^xeBl5_
zScqhQzuc6aTcSFsYdlX1UVURC*EvScjZOS_#D_as80k)34o^&EYh3mbx2(3DU_3jF
zS>yQz2k_nqE;**8`mj&AyE5bTl_*YAuN+vA>^vk0cwNb-Ql`Ki(qxdRUXaG$J{@r%
zfEZ9kd=c!3&0^=Ywhx^|<F}yqXMxddtJXHPl*YW7-eZYYsJ(rHhc{3*Jzn&)c@M0S
zbWSw4ZQsjy&VJUZm79iC(qi=q9WLX2IWt;*?d%JIhHoO7=E=4>R}erH*uLIs9eW3)
zN}!BLHg8DMPysXTk=O2neR;Ja$wO&dIJA`fJguz#eTm7SF1F1<9eqGg8nnepvKIq)
zCQJ?4JsONBvaWNs=>3hA_(sfuO<dhr4O8Q9|3N_yZ?+clD}Xguu`PQylT9g{ss%yP
zP(Hh{+r7XchM>9%3~{4Cq%0Y*oBmW@k9rJBO_YOUtr6_Va|POAD?2tAF*d?fRV<DA
z6P9E;N}bej3z&r72%b@vqf0W4%Eqig)kE^T&mKr~sV5rK=F|zYFOjeg@-&azwq@tB
z#Dbu;5jfoxB3$(AdQ~y<Tr|Xcs7De2Pi$qX-JeLLC8I}@G;~V%rM&e@hsXCylQa|e
zDoa$h)u@LKzc)OAk9fE-wb$3U{ZPl<XT3rT<M~&Djqdez#k5*c-$aWEdI_`1$N+H^
zC3KnbhPKfzCl96|lAOz@ZXI+)pIh4?oeXa-O*(C1L@@lFwDSzS9Ry9GoZ$Kbpprqm
z7<OuRm0+_50_s3oSm>aerMPV}Vr<3US-G_Q+2tXewXUOP%-D)f)W+Fl0MynCl~930
zVb2=7bN=%ZDZy%WG9cE;jjCFVd)fZ3{hAqw^Ttv`>UK2v@^ATul-ICdPp4uwj8-Te
zdDbK`G13Rnlg+OLIdxFxMv~0MgY@Akr9stqH=?sL(Un?IF_5O2S_Tr9=pwpZ+(Xd-
z#d2zVKI4LDMJ+&?7bA_jOeTUdK4)&`ogS;ubnA=1jQ(NHYN*eOa``&z3@x-1Pi~LD
zI%R~up?C-R4w4#vT{uVinZ$2V*EH@UUd9|}KMg6#Rmx__uhJd-l%(neSuDAx)3vxB
zzVSG;FSwfU5S#KTEqT91c~Qe$S0dy$QW%nvV|3hg5kG}9lTriha@DX?>{Qu4M|uk8
zKNMaKWjFOjT-+~!zwvynzbY~L4A{5;6B=#p{&#uz3e8>S(K@C2?gUelV3iCO<*p@`
z38qLe8>{uI%P`Zq@BB_n@CtoUWZgrW{VTi6+2W7E!k4#-wu@9pLW<0Ll&vn~NnA%q
zTq&0_9>;%eHeKoYBFnm==z#scYGO6z(jn3*i>G@rD~&^qH!e-JvNuSY8YrbSb52s~
zC_X*LdNeF8$v`w^{`2CWs~v7jj<|c6<B1VoCj1P{wFX>{&or{i%BV4`tifk;!IB<D
z-$)s{FWG*Fq%L*(%3U;^cUkXZI=9q}VDuln)ZxWf=E+`<`sBvI9NBLfC$;hv^pS~5
zN$6XczT}^`6rdo2vD-vyBTS*J6xjWac^mO!?XLIMXRtikozcbzGC_kDCyi(32uoQV
z6xdq2_2*5u0{>_TjM@=VxyI`mvcDY_xw3<aAca|hzi=dOPYTC;yWvgA0qK>pY)J|q
zaj4?~cEeY}O*Yjq&u{>{kDw8M#`K%_*sCha-u{!fNz1oX46t#qqVBx)bb%2QyR!#`
zd$vR>gpY(|M23Xf=o>UQPwf+}O~q9ad2$&G)wje$x2z+Z)ot}h2>~P?rq}v_H0*a=
z2E3f8=UgherB3J%KCyMQD0d{`iMNU+;eW`YrpWg$vXHJ6y<br=pbVo7OXTk<NEK<e
zbZc=v!DP@MyG+wMO0kbYUL>`9v+n$s+fO^#M|hF9eu2y}Efds9xh<A${TDwFXYF}M
zJwa<BT{5MjBd;h06*u$~wKa>`H#0qbMr?GpiQ?Kknb&@u6f2ka*|W0d{jc8G$&(yj
zi+VF6lW*2o4^z=J!r(laEQy{T#eHT?reD=7i40&`TC;x0S@N?fyk3L6*epZ2J^Km}
zR*I?9`z5<NsY3iF*a(D}TXUQ9NIo;Bgn=Q<5l@ihFQHLhpEHFqFE|_sm1<|#CuxSP
z5d$jGBXK6vUHn&O;9sgDL}ZAet`iFSzZmd)Mi5TJnl(%ZB8frg7W_AktFJ!~{Yu)X
ziCGKNBVliy-$}_G$$*i;@L3m)R48Yymi3ap&3O#Ov=jla|8BH=y*zj!+b6NAnzyoi
z_Hh#%L0%FUaR}#wm$!|2&{N=ZKh}fDw_FZLLoX3g8!}*PkyOfxeF5s@t!e)eQ3hEI
zN%=(v^8Fi-K7u!XtxcfYH+No;cusd6lKhaUX}YZiuZGC-IpO37BXDUlCFSr>>=RC%
z`~^`n0j$d}OCWm94aB)l1D1EM$J}r;R0ez`xP}t8_<mq`E%jsg<EG$X;V-#LC8wy=
zaCaq&T0QMSb@<<wxTziJl5B<XaVzQHzk#NW1HBWotvQtgLvatc@<W8*nY%)J@J)Fk
zgLN?0*3W;f0tt&sTe03V!+A=*mDsrmKdQY<*Fug>X;k#Nn0s3B$XV{obpBaW3hdE;
z0&6rA`=jn`w<Ky!=G;*&`CwUIk)}g_%f3j<+@PsQtUt<GYI&MmNT8)K9pN)^<ZwHq
z{y#LfIaD$vU2@5w;@8KI1{f*)T31HY4VqBcz_k|N$}dY~zv*4`wX#Rrnp&7O#r~Ip
z%f|-a%l@9S2`9!<9oQ}1t@J@3x;p8X{<PJ5tWB()d_er+h!IV|4qG8c!oAk^r~1f>
zmB#Mc(wbHbZa5(Hwq4twf6M(c#l66VM^>A=*IEb{fHjV`RL#cwb<JY1BiVwFEOaVk
zNNkI~C1Jk|TvBMJrW&%3FUrxtu&Gi5EPr<v<9nHE0UBL@T%x|}79&5wxl;B_mU359
zpz$YQb{;kFPhN6q-o1&Ss`Tv-Y$m6Q=VgYkh}4mv!BO)ncImvpp5;^w_;Xd(+(x!4
z-S)wr?RWe!{p}FuohP#EB$c>wYpYb+|5Oa_z?Tv(cm#5mT8lVE2@Za%JeSkW0eh6+
zLBx6IiiPS8KalO%U45B<udDl>8_86nKptM$C)JsesO8NK$+HH|Qbtcozr`=(4(N?O
zmG=jB8KxB?I35Hk^zph&IubMT=2Au?t;N5K*K&6Zq>C=)#^trw@!Q;tNVD7gXzcA5
z7OZ{}fIsEZcd_Salbinv{f&M&FtpwZuT(z!h{?1!OL&43mf_yfxv=_y{w|BEV!v=P
z0}0K0z<$yAnD9MEUzc9+`vI*figNfp7)kELbr6=C@;&@Uo|ar(c>7!rGp)6J>UsIa
z;^z+%bLIEf>E7Bu&6i=m&`FSatSDsnPp?~uT|9`mzpiE^?wCkhL0vLu!Z#2~h&7!k
zJPq!_-VS47)e5}2dfTm}b#7~#7KuASu4auDy~ZapKTafSXd-NA+9?mz*0%@Fxq1i(
z#CwE?7MN;;b%I1=rlq?efi?mxj$MRXl=m0;V&6C<`&x<CCWESI?Bg%#%Sz=r7W}Se
zHlA~cJ@TefSf?Txq&Fd7OGeXk$!QtvROC_`hq!b%HF&{L$5_W&6i0@yE=eo>JNsHr
zRu18Ro4;r4uC8eoOUEjXJ5Rz62vPL<bwdk6J)E!mr`{7wIBXBLMpt6ITS{33E$D4_
zdc^P6M;szAE)~M-|1|Ku)!#<c7pKudlqF6Bc%0t}n5rVyh+unY6>({kC!RLWbK5*-
zd{_S;BD;O*W#D+vyLRX|D|83Fj$$B9tjD>VkU@Hie2^%;UJRS|U)#gtUut6n!FpJD
zrQNNFFY<ia#jqJ=!pYm#6iW^g4#tJ|;NSWbKw^wflX;HC0?M^1)-n;LTmjY(pWtA?
z+GIf<Po`Q?=yh^;PN_te0Skes8<0`Rrg|U2_CTfmFBrj!eJm92O+COIdwb_9Hl$pj
z<7B^N#|UCBw)p1<&n?8W_(_fJ+Now>Y2=>rfswc;DTn6-d*Y0NEKUd~+{GI8QT9jo
zvu|b10uSaaS2IZbC309>G9%<hZU6u^-74~?d9COv`&e7YnEsuCgVmHGr{Kwgdy78l
zw7zEGjASr$xe;iz1{d10hS`sRpNLhT0MrGvUzgzCW5G_p#5SuJnI=jqZaVWubnQ0M
zc`)>L@LxJdp#w|)UdyofqO$y5tD4X$_^W00RnY0ybo+UYQACC_X@sE7lOmrJ4n#AX
z#1TqR4HN%RRmp&rgP8ElIAdSt3!EW(5tME$NE)VSg_Of}otqWjs{ne;R&?u1NrEC!
zIJXwF6w=w}{FFnKVA3n<NpVC|lH%GFY^z9ArrsE|gJK&U)(-%}nju=DJ%myP!lL1y
z^p+v+B0U59d*TYnqldI^f{G*GQqQn-qg<_*#dq{B<b703Au^bP7YaPOx&DatogE$6
z6f@HL`}B(S@eJ59NuY1wyhs}dmMGn~3^)#58>!b!n0O<DcXY}yMpm!4I{KnED9LAA
zpDc_DzdnT+tOIW)9};kZh_x<Hxa>ns8g3-Y-N(6409bVG)_j)7N#^`_GLXZRDq9#6
zrFTjhW+|Sq7<PVppR*UtW7=!MV|?#~`5l{%j#$SS-0@O|re=IlE2HO+7psb02#cY7
zb>F$zoHjQi*-!#3mNEf1aVJ+VN^ZrLpX6LY=B-<0)K^@^+mRv{rPXt^*9v7k@l--T
z%`v4ADQn<tgneJC9E$+LS{44&m$$A;dYxDDrDNo^vsD#WZxPuKtSOu~%lLHr1>RBP
z+hGOuZZ;(HE?d?au&)(5+{HrlI)=Lw_P;Im3!V5{-nIU0a|APNMeAINyq=|``*CQM
zbK6EwW!%IULSyo>YG|)PBppZJ(2nXgU*Wf(jUQDCBKOrALQxg_-h<vFD+j)p?az;0
z#96eh`|Qw^^|>XO<%zw%2m(>(o!dUeV^l0D;?N%AGJarW&B%|mTrxK+dpAaYw6_gS
z`w+7^Si?YWFZj70__<9pZg*P4Ku=D*JEiP-mw<5nH*v$rUsd&2A?A+m(@Onn%Kxtb
zuiLmp4cljSgIWY<oFys&*_hj?WOrmpflt?dTO&f#g6~}S>!Q0FN|HI{!MxRmP};>q
zB&&wMz-j~vzwt>KxaF|fq$Fp=xRHAgN&YFXk})i@?ZE#Re}G%c`;r>mbyB8+Kb1HQ
zc|T<mNYBLcou{7c8#o1Ju*?(7uy!&xd#GM>b6%bKmXGD^t)pHIC+Nh}=Y))yl2UGN
zH9zfGV%4i<nx^J#3u8Dg@1u%3X(j0q-xdCRHlc&igs%%BYe7HwlqRjsC0%dZGL5*8
zzw`Ujy>6oH^mMSmMT>mG<!k_PLEf-Vuxy(mT8n-X;?9_o8aYsE-{<h;%PsE8)DH_+
z_fQ^a?yFCEXKc5`;cESRH@XbVfB!se+-F~1c5vmFJY9(|fjvaY^`s%uj{qL#yHzr*
zX338@5|!^B0XDGJQ^NcN-4qS{nQ%LWX?1<w>iBk^6$i5DV}X#6Qb9|ViKOBhFN}Lj
z3b(kTw^*vB2ID7lAzxo@cTfR+jT@ssiseKmV*QzSD96VC)h-AU{=BQoQe*cR{7&%Y
z2VHJ#h=)cdC+JUt%;*Va_Gecq)Y?u*z=L?*yC$QiI_&SWZE9uJ|GF4BA|LQRp?r3+
z`KyvniRJ`+ZdedwX*3l!Ebvku{%dd1LIoSJ(-&PH==Hb4{xc7xqUda2B|C|_Wu+7k
zFo%J&Zf32-8aB|+mBOxJ7iz#t1-@z|@<Pyawl6&(aBy~V7go`Y?gFCmL#rGYgg9Uq
zH5EyB(03guB7>~BD4(Nr^`qPANvxzi_YNXk<2ba{>IFOYxHA@cmVWRNs+FD^e>f^)
zw*bbNQr)6@+!-VIRohvn2n5bzE@E)!s3`n-I&X#8fTqJ|*4nOT)A2JRSy<~xs^Bp<
z*JbK_SIaU=pw1?<{Q~Jp?2}%tK_FPN;M#G6U-4m_5XNE6PLfGTW_zRVL<aS9{6_X{
zs~=;R`b<UMvic{jbV3@kSh7PH+5ccwHm?#D37n#LNSrPPIj4I71pAX=6G06w8C>I&
z_;i20d)Vume^VZ;?(-){<F>8@ZL^-nSeBFhZCRp_2;sHSS8KMdWTXv?KY25IL{Ku{
zLbjT4K|iK<&WkbWHJvWcIJ44<I&!=c`4>krD#%1@<)tmrI~QB-Ca1C3Vg#NsELcj1
zW5Z6+r}fZ_6m`&)e-KPL&O>T|ZCNXSg-CT%%K&4nw4^0NT=7a(x~R>4O`)NMWd_mT
z7qi7vb?w#jE{%W-xyn3c&t5qW{h)dSd>JA}yq_BqJki}I&BX6Ta5|^>MicT_*M*V0
z&+(OWUTy;dngnQu;8YoTU<SpOtO1y(Y$$%28!|Xsp78VP8=49i@yo-2Bs-KM@pHZ%
zX<@vqGq!^-VBiMo`wCDWU@_K4js8rZ=$7}H=#h0F6Y1<`cl^B}jS>r^m4*LK&P-?i
zsAm`*6oyCO?rzhd<lf!Hu6IfeQh$bVhwWYljv0pI4=sZ}dWi#ekC`$&D9Y(ORmu&>
zd9bzN3ha)kx_n^Weef3L61m!F;Et0~USf*4P8ORYj`-i@vy8r^;p9?zO^uIBB^#>s
zQ|?Ml<A-o=;*cDs<dY|amuo}zPsDbeqMH}<#r4(bF2`j0)1Lyv-tg^c+&jq0;PL$&
zi15vNPS+Oc)GIP=AHNARAV{Bgp+uG?5H3<n*Qu#g@EFFJUN_0F?UYuui4%agS_a^O
ztJAV$IW8^gxaX9iq5wda<eOc^2G?}Pr4HikW#Cm;bVGaEoXZN#tL-R^y&+Z76EBSV
zDS5~FcXm_zJ9l9w#&Qy>Hcau~J_|GsZqJ*Y>?t)khTASTlyAqr@iLJ*&BPmMQ2JzR
zBd4~{ZsgJzkwndOoHxaIS(O>unzF9CtSQ{L_I%b9F!O_wi5=*#!sR9Pe$%7C&r@Z3
zC2VV&%(9h`K8*9n=GcP@QKO)h@N`T##glvscFg3@w!1(W-G<8q*WuXyT}!SHYkV;2
z^e(q}=R6aUs5}Nkz}jsYX8U4WJ72O}w9deO`Goe6czZoF7tZSZr9d31WQ;^5GiKxO
zOw-nkLZ){K{<oSm<jfxOLi;&m02f!6gaEqwqH7+fmpx8}$4H*AXj<S>tgDwF2$zF(
z6svPyWzM$D1+|1*jqVRzt%KqDr3t3)enfezgAtAAQ7Ui!QjK^4#-lS2DO;2W2|aS-
zH7yzDC!D`9tvCh$0UL*}^4f|yJSOR?G%pJJRece*IZI^yH4{5$yg6xTnx*$k-jse2
zqBd&Dy<vqy0A+WD!y%hTZ3CrH@yMd`Ddp{NfK*Vm(c3ZLqGC2AY?)r|=BWS+2XZ;m
zZF3VDgIrfV8rUQ92K*q@v*lf*d$Hj+eHo^Lq9iZ4t<R7fliGy^3z?`XV_sFm#h>~{
z0Dp3XGWIzQ>!dMtGuh>>Gj9Ln41Jv3I~1Sd9BIPJJ9>_D73;C^RP7~Fzj=H7<K;p$
z&cP$cJ{D~nT23&;ewZw1Ae%#2u~@%BuFJwsNbDhYxj_FYnSA(X{GW~9*xQ*KItX*U
zukHE7`Cr_})pn~u#O+2)*w<anaufPNI*|uY_36qiL`b%(<W-?>&|)XtLyaR}lxrA$
z++VXl=$y&e-VaxA5~-lCyPW%(wG9L8lGqz0)b8BGtOQG=cwf1f<AH$-kzSaiiok_x
zi`UCRY)&X2_Ew%E-#cb0ELUZ^5b43x)__!QPQS~>Z}B;B1}M%gi269POKR}d<1w9z
zK5OM6yeLEpuNsfEQ>tY_)?5y6qJryc(769b<MY3&K6&Z=iUZ~p*^#HE5Tf+4Rl5*?
z`i$umsw{8$rYrl}rU98b2pcxl5qrTlE$jZ#TMD~D8lVL!#;k<nmSjk|?GWT%Sr)sX
zfiaX|Fb$9)mO=iBKaqXGENKe5OKSN0VijccJ5=vpTP3AtDMsbsR97o-%<Tg_UklB0
z&1GbQ?}2@A0e=E}0oYBvBTQna@kjbzo#o`5Bo0xCLQ-E@Z*D<rd5rF&#XKWd;xt-*
zBy3KZ*>H&WYv&3+Rz;wnl@KYk<QEN-{9L6wq`PVC%hKevu(fJ86-)V@d&?^7us^`%
z>`yL*xeH!D6a#V%GJZ%$w&ULs<(Qbv(2uxm$GE)n`fq?P1ZB@7rur-xCGBnFY)l%C
zJJLg(z0s2?3g+YU5exnq<dv58_#R~if7?(aQN@1gP8OcuEZ;+qlRd2b2GLmyTHB9i
zwSM5xB!~NC2W+>58jdLn&<*;SE{~Zw%x$|ZKj=S1JAFiIFtOJYaA;NatgzznnHEFz
zFZ8Q=nyIpvfV@t~<n+uYq8Bh`&DvHvYnQs_ZMRGt4$!IMNmIU&Xa`uDyB@C=t+;{A
z4u<Us?c25J7;^bJ(js;M^zC&o@Qbiqc0dqhhh0b*-8T?rKc*_ZCN@1MxIp*KW8Z+=
zRaETbJXHG;IW5|>lKDvOnL?%M$I3H>mCD|9d92YJv4;dAF*R1wf8m8eR%@Fwf+wz*
z*@R9x5SOBCw<MHpX<?V3ewrJ>wzKR-8^(uFcD5ZtOM7ww+ZpQf*<ni@-G|_wJtF&C
z?=R)*i~z@7^B@Nmb+eI5Kc6b4dLqY(SWT@n6o{xPq#fOG&$8{4Lvouz34bhLT4ItR
z84CUIU}B0D@6Oqhh4PV_9S9tU_|Xz)Wru%>D?ddpvrtBK|HMD`KcZS|hU7VOBV3vC
zu0hstg~jVx4E|m#J%4%IGW>eQ4(_#7x3gJMA6Lu`y4SYo%qC2NJp%=q8pe|fQ!ZzJ
zv$n-53+oAFcZK$ZElUEeQPWmGD$Yq9?N&ToQlo6fK(9$rF1$^tH^LA;`D409^ytL&
zxBVjl!h<x;tf(C%<P|qk(ID4(A3uE^1qQPBhgML0TtXk^tt=Hto9Sl;tIFcAf023U
zhwDBT(Dw)%?hWvOykYX0;-?Mk1BR*ZXx%{6jDuw<D~5BK=2NvpER;9r2Ik1j57MyA
zR4H`b^T&<IfYiKx`{R#g+t?3=?j9TDNv*#6IU8TG=A+8<7S2!S9i%@EM}9Mah)`~Y
zg3`;lXP<Tz+P<eB6?#Z2d3%&<YgVE0?4G{;EOg^s?+1!f35lgNE42s~Cj7<hX;J;s
zQ@!7Jy#;j|SR35`ZTBw^(9J7AYwiugq1pe-0g}K(;BlxCO{4F1q$b^&ViLGSayRPo
zg-!*(nB5`Dl|NqzGDPL;k|g)%U6k#PT}+=&MVR<MgWsZI?d&dBYxeA{$SlI@20e47
z@%=Bsrz*57?wjP#A&L7rZD4hIJ2r8W0H?<(HV*<Pp02W74KF(x^}k*KenDl>wq8bR
zu=RgnO!a8Xskzm<5Z2|$n7zi!Dq@f374~3g$ih;c=WT!mcuWhCnSvZyYg(VK`iQ(F
zYeZ+leqc;IeP}XY?6QylIhh?*cJ>APw6p3b{bJPeLd#+3WTY9_6;{h@S1Pn-U4o(b
z?2&{$*}-i+@yi7N)<tlGt2F+0qq=h321G5a7)h{~G&muIovr)X{@%Dvtf_0tcg!d3
zUc;}3EZnv*mf79Hef;GEtcHEZZq!){njrkb#I1%%YE^#Ff6KNpN3I|@D&Y|R$?CIy
z#*e(;vMshUB6cfk8i}k3APVzy1%9y_=}7OS4&FJ=(}AMJHxA_ygnh(y@{VlUpT;7o
zb?{{5URG?GB`eO@hw2LHmbfLjm5kg1S-z0GvV@WL-%wm&E}~yEhNDR7ape~WS*VMZ
z{SYn0iq$R3=M#Zsp4_E8xS*ke!Ya6fa|R3ae-M6(4E;z;>MHgUi~NAq7+A2Zo>RM|
zQfwPj4?y#4s#aQ7z!j0pY%i!^m!wZ5&FzoxiC>#-Q^|-lqI@8BIz!B36L3eLPa2?0
z<MxQ^c@RC4>~fW|u~1dL6xcmdajzBPBk5R`-BIoo@9T)SgjJ>Vs6L}?Kg@Q=^L-kS
za6x>G5;qbQ2NoT~!Oaz;PjeTrcdx_JtA)|dZDM;rd@24ei!JeW6)&ChNk)3(43;;G
z>&_XrV*$czQzPvXc|K@)tGMe1Zh%~=c(|TQqqmlrjDh+jl}HPjru5N9qUKRI518Sa
z_S$aYkBUm!Xz*%P>j23|v1`eIY1Ij-#@)O7SRhJ)^!ZmA0o;l~e>N_suDrTU@|>jX
zVdd#`FRU;?u{b>EmHe$zx0j!nd~6GE`hYwT`V%%9f1Z350h+aT!|jW%q{morRblFw
zXYxvU=M=(QhX+8z)#&4|1)>A5JSUQ}lfe8bi)ny>$iVJp0<d}#!Zbb*&KS82c@5(0
z+re|B1NLIt_OK4<DdZ1Ir|jJ4MomHSfqeF7uz}zT6LY}~wnA)oJ0Qjev~)vQcOY6*
z(^Sm6QCMn}x-^S#^#k^WuufsnE)%!2J8*Sv{?2{oT&UyETSD+eP-@c6L^aR~G1d5v
zLgSA+d+pqr3@Z)74ahWcOq~h}HPXYX&fd=1ZvqxipNl-E(3R<@PeVd+S{pJT6Fxaf
zrXr~4L~mvi_71LWYDC%4`i#?&srJF#p&x0{TdyFrXD{cZ4McVdH}m@Q@e4kIa!&6g
zURFt29%&g_2|=97Xn+-iS9Gc9l&SZya~Yo@C+PS;0SldO*HQ5s=N~3LkAi?#Jg73)
z&oq!gT8Z&Y+Mr0s9{Jjt58}OhjPq{Ekna)u=W8v2&MjDLrH533?{T%IhsSpGS%pq%
zuBpo2n5%=tOW*KlA4!%tQ?C1G!!k&?(QR~N|E@}8y3B?X!vx=;Y>)1a5BDj%h;v)`
zl@!i|1!ZEFn${-2dNtez%6U~c@8d1^9`QeIAyWQp>%WehQgQcxdv+Xgijp_+;xD55
zrS^Jx^1P}tucqgFsM71q#_P=ZlJ@<XSVL`D;m&g3f)AH^GqF7<f@jp9pBegSNoO00
zZFY#aocF#s!|ex)EzKVcdr`h;VwJb#ZIP8|%eM8hQ>y4YRPqcjkc`E$+e|?O5NVCJ
zY;DCd<A-$QjepIKAK3;ia*f|2!ye`*9bLU-LH|_9IpxVa4<r=5KrsbrRrJZ>$lEdL
zBNsE}xa97ZV_2l|eg9*B0KW3`&+w+DW9!?nNA$}tS+`n5Teivvi`0d-hE2KaGlhqI
zk2S%Jsp_sSStoh~5g^*?%awhuA=cs+50rd45dGhfeXLuJ<Wpmk>x!jF4^{u=Bo`%q
z%QTX@nWH}GS+52QM~@Hwv2;}&<BQo|l%$vFPnO0FLCgb>KKQ%Ii*$GYnNKo{e8%2l
z@%^SB%p2=-ocz!NI?X!aH*Vv+i4BD3X~ALJ5@`5Cii}rdD|mINsZcM;<@lhx15gU7
zimT_u#{Td2cuD<Vk$V3@EvE5)!i^non|IcavJL7Wd0Lp!@J3GI=<s@>z%$SG8+(5$
zTUmzT{U-Ah$3GE>jUg{ldgu3XlYsPb$B%WNN(%*{!LNM6dLUKybADrEm;ODrKek`*
z60&~U_r}M#ghZIv97`{8K?C;c9#%mQ9J}r2RDu%U0*l?O!~HADEht^-^hUq(v`Ng^
z*~O6YS4U}-t&e{$pH$EMc~)TCfobh_`L`1k!nO=ARDk{q9Z$UC!sZBfyyJZ`O}g!$
z2m>4Jz?n#w_c#{P@1Bmx`}_nceao=c0%ap7uUOMP5DEXBeHiKg4;L|gaS`FYo>ne?
zblmZW!o^}G@W(^=tt`qX2h_V%O8SCVde;Nj7Ey*&5#@(3{yv`yisHoIy7WB{#(1Qt
zGBZc9jK!GKgEm~0-*tEWi^u=@L$|<~@#0%st@G6A@>Ty>&dmasDxCM(_^mFVf1Z`X
zy<r!RPbp}_e-u$EVZi#DOGO2fTUI6S(d^gQ$fWN&(qR0jNY2p8quVM)&FISR$2H>!
zvQ6D$<xKFm)ukQc5LbTE%a<*mCTmaVwVa4hn>;OD*y*PzW+b!(Z|Z@(6`l0XY*0id
z((|`LV<8{}>n2v_3Bq32n7sAxSAC3Z;_ROfSJGUXpKP%Vry0sDqiwg939?8oh#5V3
z{Hy0A;eAW$#lnRL^@E7NW`ak)wb|_WUxaOxp@y`AF@7ml0x7%;>#&mP7W<9&BmUcM
z8;!4(ZJGjSQ9}MaI(z=x>V~TStPVTGe{AOZbF+hv9vNlrWGk3-lZb~umuj#UYkS|m
z|8gD4z6rG!DRS$7?Xg0)&3yn3tsfF8dg?F4%R|u8>u0C-$C(v`*1!4~39P6(^7^({
z!4_%9wi+b9`^PWa<`Ycq=2#b0GGjc5Iug7V{PrQqcjDiQKcuMtA!UgmV~C@2TFg)W
zT^S||Wz#*N(O-}vw+Iil>dk=D$)KqJ(LW#MxSg&I*-MhW5{)BPxO<?7-u`!gvVNOe
z)rnu9FMzL-ULwYw?_GYU*HXb0tzF5ym0pov<Xp47+H|^p*KwilkMW&*X-8LD($~eO
zD_pX3_IoR=VWW{|v!%nWxBbBXdwX$o-(sgn#R*FM@R4gJ=|zVX=5)$|Lsncs@cf&f
zy=xhb#7rzC%eX}A;SQ?eqcIYe&(HiT;dOTdUPv)|b#34i1#cW@09Cu27YRzB6QVyt
zXKxah6Ft2!zEp+J%jjTnFY?u5?P+5_*$v(utJ@KS@spFoVt1en-25bR_f6zJO!EHP
z1K^h>k+tkx@)=KwtbUB`dSX>}Y%qi=8@Q*$iKWn%p-%>~kDr23qA&Engvi;O%QvW3
z{m8KC!P{Pq1Gw(tMP0EYnU>JLWG??Y{51nt@WJOy+}NiS=H2>s#hs4_%@-}u-ZLYS
zI%N<3?b<_LV(xpLo+&0ha^@m>@HL9M;@gAwa6Rv{-@Otos9`(Lj&pb+-*J|Xko*r%
zo1Q#;Z9pmg(9?MQ{BlTVaQM)tS0(<npgkY<t?gxjC+2Ir*y_QzdJP}s7CG~f^}oA{
z=mPI}AOv>jf5_;Eb8Wpt;J=H>$Hrs1=d-ml#TmC>+=6S%V0(Fg`&<}2W_6cmz<qe+
zNVdxvsvmvMnt0^J+O?RD0%lCYqxzCttN!9V<&Kf~Nj(NDpub~ZU-Bcg*ANIFG9zFA
zidxI&JndP$J4i}6$FV#jQJ)4T`VQ`CAr$UlLykY?qfSB|ttw|QWL;k>a&=vN`Qyts
zua2b?^8AF~3laQFT))V*Z`#dpetyoI`t@%&Po5?EP2TdqUQOBKd@f`--1}G`%ys(a
z?Vx80ddmk|z~3&NL;kC~7Kc7A@0|}Uk^517uJj_~E&#@U8R9;j`@5;>n~!(NySWrB
z1A_n7Xn*MqxbRDr&0c>Y%=O}9O9fo$I2ul=(-RyMDbxq?P61N!r18n0Aa2wn_6@v6
zq<3Z|VIbk<h5qcEt^XBD{hkW;``IH`%Pm)NXPK5UVA9=>>m1!30E<s|-o6s$&blE2
ze=})x#?3YMlSRe&bH9plb@uN7S$(d9KC}@Z$=vnk4XbJ}6La*A6-HbGDdkHxwY`Hc
zet}YH3H5_`(&*#SE48+8-3kAj(P!>_bh_R7KbrW;MZcC&8&*;DSm!W$@7Rom^lnu_
z&cgGvw@vG+w>~}2T<;m3%Ux{zHt|=}apLK)M#HBE9@PI8%zM%H;Q_%<x)^dA(Gr~C
zD`r1xeH@c2Gq!Mc^PSPd6^z2KSY>8G2xjzy{mzIvOz{6AcZuh^k|-AN8CA-@cdh<R
z4E!4=<CXXn^YZ~po2xV%=8I-OsCVv4ehU=8&uku(UM##@^6LA%rL3T?{&z4~4`KJa
z)I1JWCEC$}$$RzCp;7RSvpIOzML72k)Z`Gtnq{{QlH^$Uwtd^_dtF)3$mp>>XHmY`
zc>jv;8F;mYj<ZG|E#(QNHFVnWBF%hw{ln?s&v^IWVBmlLdHd>n!kcYnKF7s1u8I{F
zZ@K;#_{--DV=wQMlIeSsoX-WF3@Viz|3`>aM?PElBG;oNbH6X^HJ-b}UcO1zmem}+
zhr8>Hc=MArC;9j6`TeZWSB8$aGxs0KJ@V`TI>I*k*#SiK;>AMY{VDv<ZyyGI#EBpK
z_QeDMfO6dD#R&s(6fiOmSW$E7x`yIbS^vp8Hoob@H$lxqammoz+UKQaWTR#JN88DM
zO2@D?xKO?+_!Y$8@__8^{S)IYPe6!}>QjC(DX)eb4b$n%A>W~aY~wp0#e(7-_7~)f
zyc2(I*Oy4a!B62K2V^g7_b$~;6dpADt*5uEz18lYwWyBxdyJILUA>CD=(;27akXYk
z5rqO%d_<)7HsR+Q_^K6}zK_M;hCzQH76Soi)_~(Lgx{(!-Oi2sf9$<?RMXiWFFJE{
z4k~J#aRiYPu`x=sBL>I_Dk3U6N)03mB1((Y03nHrh>8#_fQS$g5r-C92oREplprk>
z2~83yA%p+{(n!B?=A3)peed0~-g@i(`PSMC`0f2G>$iWqe9Cuk2tA(Wx3Ie8*P5Qw
zYJOp!6r#14GrtSAqhJ3N#$UQ2F7Ax*@cBj9T%hvtF2mrEv#yyTP9qz~uerPHAF@Ck
zfoN8~pN$`J_l`na+@b@+2utVQCP?C{M;gLm#`UAlF)poJVNpj&BwD}oTlzap{JUb&
zqXHlNV#+cYy1b{H-T@e8Li$vF+?9)iTEA?|DLa}W;59Dg+VprHWJvD@Y<}t9{ObG;
z4j>UM45RE*vJ&2P{$g#hc=L>5=~P`|k>qjCN68*kzUfc2KOQ|l5LSQ{ta=*u!MvnX
z1l;9sqPPiqHKnW+CJ=SwoJN=9q|`RgTiREVYq5?_GV{bj(y8w2hCB33L%jMg`<FcL
zIRV>NFRz#p+dENPo7i&YWXn-IULel^S?2|w@quRL8<Nimv)aPblK|*rPmOyARb>p7
z%`VY_TUPFC?1Y8SBlX?8YCZ{m&C@Kh)~$Wz;yg`y9wxrK!|@kPelcOviOh0~496A{
zD_62E7j%d0i4HI88M&}%GH&wD#`0H#m&BI%9x5nD07n)suAF%Klc4)EqPig2R=JDS
zEt&E(i#wT9d-3{ne)@sk*PFK5-D2T>u{B?s3%9~Xf9BSnq!m9h18A2uyGhD2U@aSa
zYj(|l`CN9Cmi|SVHQ{`~^0nfIThy~5^g&K($gJf_0M^~VSeRK0P_1?6@k)P&UL`ug
z;JiR<x8Oau0xY7Bn_T)6TXo&+>9;d;(*b2iB~OJdBer9WE+>*4oxS^VO+uV~oncQ|
zP$S^YCYD+Kg+79-{AT?H)SVvZ_8%f_{#ekAjcPR`8RI%&wC~s^NqMp8$aAzkvAC27
zo9T;~P;&x945q)PMicA?)0v1D{UqDC%SAD!vh#EE2IB&ns|VL=H}9U-<MS_kLMZ+z
zLzmw6=btQ`DO55B7$-HiCccooCy4Vkxbf3A{?BDcyPp#ZACGxYea;#Bl@W&F6bZDk
zPGFw>Qug5EkOfGo_7?rd*Pr0KF}|j{&eoa*rY@u_Q%<wu17!@{c}gQ<&$0<RrtUsw
zGEk5R3p)aq*^S?_TB~-uy~6IB4vc8YzS4gsQt0kJ-*4cR?t=QZq3ni!56l<w+51dk
zPyO%hrj3N0DTr5r>)!tR;F3on`zk|bzu;Zt*^Z|q&L?SOWsD0eyr;U4ZT#JXI1(LC
zdPePP8Hz!4es!wMjRS}zh%t{882LVUx(Fm(+k-zdLvDCKc{V$e(Bl-WFf_6#se23l
z2MhUN<$m+~=M<Gg83Vit6pG9#o{u`AhYveW%{%_lK=>Z2LKZI_2c$R8Ynt!bNBFa|
zr+s-&woP&WoEBPbhSGILB<+%<#H1u!)JH}Qf)G1z>QhR2%pX*7;~zQ8Qq+)At1Y-(
z;h!}+al0F%622|buzi_-4h{dfql#s80{F<xNm+a5Hh!t~CJ!XKbv#!Cp%H`wLTURi
ztogu@uh^V!AJ^-wmVU>3hsOQ10RTo|FB-VL(q~uvo*49eV1#sQ0PHu7w`oyB5{`hT
zO&DiJQ_*hE#PQ=%2zLQYQadtY(0UOK`@zock&EJ@uM1^<2g`Rau;hH>g<tAf_@ygL
zQ7;oHBLlP9ov16*ozG;u1$kRwS;9ihUhc?Am(L@jM`cHir1#xVCmox|ySMgh#j^P#
zpMA@_gAO?1md`l}%HL622WA1&f%OFjthvvtZ1;pKdtEsV2SP=1*WHC7-YsrN5l7_b
zCZ1QcG5Y|lQ`ap>kv>i{yXQZRp0d<>Xk+r2Y;-XMG1B9*3hq=-E>gbJa31>3x0<ya
zxlOxOKT5@?oU(<P&!Pi^GDCMhkE?JKK5wf_k9S$Vdfwvmp_xFxx1sKWtTXca)lc7M
zufu!nWVy7zHDjlLJ2Oj*ch_HKuv_{p4)d~Ej+)#BRH$xU;5nS4^<1h%{CW9${l)fw
z$ips5E(Sb<^>y!2N!DjVouTuA%GfVBGJEuEpm&QAR@Vpfb$~(aRV`>5?;Yxv+#a~g
z)TeFGd+I}PF^eK?_iT3%^phRN>FcO%&Iy&$r_1e9D^NJ)NN%j()VlN%B=dEprN{Qa
zGx~_P)PbCo=8f$|+8FMOFZ+3zAO0tK{mZJ7p+0eLi9K~<@(t*PQbkatvnJnmXnDtZ
zKRSRS_M}_4K2H55$Hb1Kju@~rYL9ID=jg_0f~_aT0v~xCcG-#gr&YJz@IdhDpo92l
zwdT8QW!lB3XfFYuUbzyT>3;%ugiYw~6RlxypgykoseT41Lor=>>lC*q^pA@ByypXX
z;ZCsp{sD2Yfd(*kyo1%a#SFtn3J-aQY}g^)jg&u&&3{MfiXt5740Os|$u-#(^0t^>
z`)b1;R_cfLKZa=)1#Pc|`m9~G$4{lwd_w4t!3#sI0v^0j(VbR#cB1CbSx?%pH%<3<
zfAR<@D;`dtyZZwx#5a43VemrWe9ux@4ROxL2orQ4YhF}YAYRxr|0#Ay)0VfRR&n9V
z)&W_JlQo6-{_+?;BOcWAJdgCsQKDC(GXjr1LUK^w%xlwvoSg=I3%I&7sU2>*R^9B%
zV{YlQa+1MR4P$}s0{PY;2fl-UzC7-#mS)J%rGAT~pDLi_W2&-dgll`7j4#l@k5Ie(
zQqIawYJ|PWx~bSR?d$z|Y2G2QHh_02G@-Di>;@H|DZK0*a{d~;5LMV7M_>3wq7iS@
z&%@POZCF)5vfy>$l@7u|Ea+Y4^{(1y;6~+c_iW;W6mt8(bpE(DXI*Hgl}YSoYQ3kc
zg-~ibDQ`Y~0G<-P&Q925K?s0J*cZaMQO?2?#+9f`!&bY+uD7(xQ+J@SkL`$Q%O^=y
z<YIz(cJjI8plSkmxwg2gYhBk_4Ci;Jh|FpZ(>uaHH2nP{hp6Q;aND=Ld?MfSS5i9R
zCpP?yOS<inb5X46vYaCP**#l}A3ab{NnF{tk`n5YG<rsFVV7(rp?F06{+{W$vEEKU
zit*i-gCwu%pD$v51aDt7wbwL^IX$~ZIwH+ka_JXq^+L;T(JDdjT8nDTO+m-9bL$lK
zR}`5!AUo)^Le?BUbclux!;{5kc~6A`_u7$dUc;tTptjnHd|_n5WepZD5oUdS2Se1l
zmmM5*9beM52P(VVwNv`NL!hG)K5O%<-)O7pH1C1d{TE0VgV`~kCHt_tE2-~{_Snhd
zoDynu0xW*X>LDJ#(r0qaZf8B^OzT*Hn}1QKfap|bJ04h*_M!`ri034ltPI>=*k>8C
z3}Ow)egm8tMLjAW`L_E4Z8kkF<DHYNS-lV_nCs!H%4#lrH3!eRI$f_D8j$ImdUvTP
zdr+)q-0u0fgY>Y{7hU}htfOHBR53V;Kpyz~bv}QB`U}};BHdFn3*+B(M<?e3q6w7g
zz@@@+Oo^e1D6}e&d6bIX6=Hu%f>saX+@0s*v@%CbKd^o=qU%8SQy)gJMlq+<@XUkW
zu*g)^lH@+W$~y$-PIU|@YTiu=0=Ngc-&M!l8pPfvNaZJik1WxQ0@}9Z;-&Ou=NM^0
z&+lL%ZWo{PuJftMEk}Gbw+=ePeN@zN`~szNBz4AatQlb7X^K6oSSn)>?|1F0SuuAP
z=zZJE#Z$WaMZIrvw#D&Wso^c!zK9B~`Vo)qy-j=@WSSlPl-(0UPTWB<{ynP(<x|Q6
zAf1Dca@}`_^dVm_JT2|{i3(YVd!$%ZHj){e5U<WD7Ws6C6VU$8&=1<mVd;{ZsV85S
zy`+UBa0TNG$fj#R!T#wP|5x{Hkb~_fqcqF2-k&-UK2gfSIxi&ZZgCEKd3ub{V6-@K
z=|<AyhP62~@A-yixTfcIJuPDto^Kyd_XPn+MYi_9#j20U_wG=qoTsX%-E#OsSJrNM
zR}a7uw@L7}l93<ux+jUh`8K7Qm`}dXQu>4dq`rWFw@H59rDHZt1stShB%x}}S~@s-
zq_Fr2;=n)8E;8AHsLMkEz7aEO;B;hz`_sv*?hyVlFOBFl>QjoVfu-Qutv{RFP<lgi
z7r3g605mKT_o5MXK|Z#1XE7$xh;=2s>Y$ca2H*X$x!JQ?VqK)Q$x*`Bf$76`mLY4p
zk42G2VumD*{O2pH3e3+_)P;-b?;5xLV{Z0xSq)-;Bk4;)cT4@C6D1-L#Xl=;_!bzQ
zJG4mm34x9F{&D)z`8@~e5d>9l{toy-brrQ(^ye?Jp_}w_iywrwzUkwCWV*lDu)O=&
zRgly0u9`?}Th<VR<lVI=&-4YG=M$m|u<Tts{eeWT#zoyCxv10+C74cK8w*8rjQ=CM
z3!iwJt!u2@vvr@@9{D_iV2{4om%DCb=MkToJ~^LphP8b!hqTLLTzTl8!%E=j>Bz9V
z#a#%4>A--D@k7t6wd!BFkTfH6Bn`>_GSB^I#C`Rp^N@-oEA}g6yIAD1=+Jd`mW`u4
z?o7NT{Z~DNvZRP~^a%(XeH?#f$<)6v!fcE5LbxktEo!$)Cum8oJvI#W+@)yBJ(_Nv
zA%2A>0G}x~W>&VK@2A{%oC9V`<!47u(j}zooG6l4c9qv{+e=mac1hLA(^JE(rd972
zWEAw{;x0X;|I52ckD=d)7*3$z*igr_X3Hpov~u3RA^ge_?^_X;zj|bZI|<2mi%U&x
zjisB>R9;{NbI}=`Ax6WWT0cb$2FCw1i1aB{o{3jQm5pF7ETc!c+v0ay&W1hH3JNPe
zrHiO9vb2ZXl~V8X2kX7$tHyRm*wWVIMDI-)eVyz7=TMV(p{V{DcuDzE_e@OPx%NGK
zN$zfN)7!NLSDX4>WZ#?$P5ylEW>&XNUfGiTen15&QWC4gEX}hD2UVbaF)NFp?k-Xy
zY7_{i@h^r<bz!X9GFHtOs#t6#re31fW2yt<)Ht@1l@D2-$*`&4jSc<$fBiGZXzT(u
zw9t{*pFhg&ofpnT$3=o{>;KNqbR>4<kFtB`muI45BS|*(K1O2}*wDYSL1X#<Ej8tX
z{!8l52mP1Skq`PWX*3`7zf1a&R%aBalYlR$wa%j7^aCQLce&`R4}dSZS~sLW;u3Dz
zY4yi%d@nUPC$N4w9kIWQqghwmc=+E1XYI6h;}V|HPkiRQnToi$Z2g<m;6?n#zq2pk
z68=lFz$N^b#ML|(weh{&;GD$z<wC^%G0xR`dSfIm;qQVQD+Zm5)-T5+_BU~^KA<<Q
z$0g|5X&s8+_^$$P#QuKH)%WzqbGU>oO#y1-4Vgiw(E8=y1sU{4GhBkFomQ3R3aLTo
zvh_=L#QqM>)xQgdH3gb0<OZE$>zDHp`$sufYv_%^xCBiB#l=i&S1~1Te#YPI{Qn>P
zzpaBgA<DOqzZrzW4RPho7g#3IGP{a?$)g;K%m4R92Fs6{SUI)hpQPH|wx-swMF0nS
zw51M*-oUr&md-=$<Ukb3=lTQimoQd@duRi(6|?wKAOTN&X*$IH0be_fz@TT!3$j+!
zDpfWmveT6~i<lzL9P&{a-OCd)5Q}Tumdt>Ylkp{1Q;zi>cBR4+&c)a}0ByW$r~!Pb
zgKLf|H{9MSZef{g^c&jpnAw`+<uFD<3vRbnrf!E`kfkxX0&NZ&k8#Gw&hNg0c2hQ7
z6WMYkUo%^1%U<G-qTW8o5?e^mC-~A92*tQ9+>3pUJN8L;Ux2B>M5dBj04#1WN3I)A
zFUZ`)a*J)9HJOsU(Rw!-ePFeDL&jHQsXf}JX6%NvR6H<2e+(FqG(^89Lhmn56ApC%
zIP(AxQAZ$N58jsgk{)0eJ1yj+=DZIDH{NxY!F^)KN36lt(|?{K#VhnuU;?qfgq~A*
zyL-?oUiK){4P)}q<Ro00!H;L=#9!OwVrDmOW!XS2Rea%WY}ietEHD4OPj^OdX}#Z4
z^E5WS3W_?cZIAz!&{6D~#;%#u5&eUmsS6LTKi$z-=`z#bXFBQ+t#1Ps<2J1yMv&uf
z{#u#yK;aFgSfkp2Nx~-fwe&;0VyH3?^<(gtT+4dt{Zb}^wndLb5atrcDn?E?Yn1q2
zv!Ot{i=hU<N-YaXLwuDXgzZ}Z7_XYDP~b&5{fSd+xxKRhj~H`B3Zp7LKplwh>vK5#
z1Z^^5-6{3s>_&(8H2{>TCeW6HsCOXA7C0$v6sNpI1q+3r2EElaq%Ava-y{N-I;}VX
zb|+}t9KVqYEVV5s$Axaz9_;IlJvJxiRz6p5cJB5-dC1msEi>$zfStG1B84OTkicr4
zL)^vzEC|86EfG;-O7;R)9Bn!_zojb<QhFLrmDnyykSbOSkTtVdd`@c5)-7_(FvyG3
zyaCs^MzdBfX{8>`#t+7;pJpFKn`h+u11dzVpJ<BxP*a~O;bpw-exrAj<*qniDPhjy
zz7?a)SNSwOceFGOM^L1sr*@15VjQA7q~^AqQho*d1rhqgC%R{RxjJRQ@q>EPGZ2HC
zDAdMui`GkJDqb2kL^N%6N&?f*A<BCHsbyQ==wCR!kOa9sU>S;%@WCVfhvV}U#ws4$
z@0%;fTiy2A(yFNqAX_nNr;QIO41gVyn+}YQn_bD3hF?Hs{#%P(-m`96f9U}8sL=YZ
zeO5KBhPYel${#Ehu29S-Q$&e@u8Xa-6h?_~e4fhYI7H4407p-d#n;ERmj-7V;Ly1I
z4UjI!d_kyaIw{9Pg=;dV-ihf@mBigC*L+;h<u4GRpRxr3BMJw#p^|dFZtY&&S9KnE
z;dWQy^sN;EUeTIh%Fu9B=3_t?C>O<*V@4`k_?=;^>7X69+b37y9y%UZZ5%3zb(}Um
zoV!VR+%euW&fi+|CG=CxU3!vy%2mfOgEa^PWdCXR>%wbXlXqYXs~Q()qbJXg0YAM7
zxL+6lw!@U)kiQ#ygum4p#|~mN>|D%yEd^<wkmIkVqiPVG%fMAmRnB$w<Y!>!Y~HxK
zm{CeZFHUm|hbh@d_-*LDCM-Ram+a3$qpg~ow1s;_nkn^Ep6sf{2O~Q>z+P!fJ90<O
zlZ|K&U^mS6!~Ctq?iMCN%%|K3BP~PGFO<&{3z@NwVrqq~e8NxZU4qf(S{>%!Z1l}N
zkgAT8{x+@0OK7q2qr~f&P3t)_9P)2BbRF_V{rNJW1k2Z)v=MWFe#{2#ocrh?{UJI(
zDs^4CC#Qsk9QqlnSOA1HYL?5OV`h-W-JXKjx{BigAvtQoGFEII#4{LQ4GKu1J~1*=
znbp-bcyxOpKO?(GDmU{KK{sC;?!#Y{dWx!!1=#MTdx8RHS}Kzsp}R+l)Hk(u=gjVA
z0290YA+i#|>!=6RG-z@JW9O*n9LlgFJi@vqw`$|?&lpQaPQRl3we?^Qp&`cbOCRr;
zC&G>5!0S#cKE>;9cRXX{RoJx%^gwjKa0!lW5#z3tKfMTOz=Irsik!im*s;KSWuSnm
zHI2SwvDeXl670F2D9$<MniazKu>)R+=+qTlFt6Jfw0?<HRtAE|ep?7IKsQh&pA3<l
z3#b+ky8Z;cIVfG922mV64v%U7ip(?+^uw~aCT$JZm~uUW_g0{=Q9+Dh_Ec}4ru79u
zk!#a&uHfX@CMRonZTA@crj&e|A8?Yid32+W<WTB4dS%i@YY59B`oXexZ%TT0$KGgW
zPo+z7&f@{gH%DCBlzlxm#@OPmEbgFT{2bMml+zl4iDR)4M)6<!tk-4H<2Y;mXh<`w
z?JG6HZQFD`r1s-O%hfA{MTl%oic1Q=`;xS^o4R;RS9(#kCX*uh=x8}I<D#cIEiKnU
zv})4X*(fM?e}<i4v?SJ^0mN`(KcyMoM!!gEDKt*XsPYG7j3o*;L8y9OqUMR>Q-b?N
znQ2V(c!rH}CI(9J;~n4~=rc0Iq^*Sr7Ah28qV4x}!xN|c<W<}Is=$-c9f9hX00uU_
z`<2O)0aISrE0gQ>6$1aiN1q4NYcCmn&r-ve^m#0M8DV;@ltSyV&03!zFWtG+JP{;h
zdQTTJm82AARhNX`x)8B(9vdn&==I<iPb1F@MqJ1}`+ye)=VaFkf~pP7<m;DMGvu~d
z(dK)`@-lZo%BP0tks0fU9ts`9Zg_e`)xt1EJv*r81|Z3QT+0^+54*Od`Yq9F67tzt
z`|^Q!Z-UTdP(AU~FnqAkl66d-wi6wbm4Sp(hEq$!EBcZaJ(oRHi0Xym8rdoxs5Yi*
zBxNX$HK+1g!+N~a$R~P|4TgJAJmPc|;%DbGfoQH3&qBAR_^sMK5x|Td34+!}YgMU;
z>mH1pNQJv8%lnRaZOlMDSOG{$n>sa9UvRY=!GWP|g9QEJ;Ck{8@RFRPBkJT9;3(6B
ztw`j$r^{If^RFo@46BQL)(wZ5p;vO^xG6`2j{tR47fHH2ScxK-c8(rM<;`nGzH3rg
z4?J2;e->0C$K3G<fL0FY2Q1h`JpZQ1C*TU1QP?4Vp7PE&oS^FU6W!(Q>fh$InsKcV
zdA2>fbxDU>A^$O;+grr5t!LuLpLcuI28!hy4@q)<hi51~gnrUco%P(|3Cn8M11X&Z
z+$1Bc+)#QclEl2`vP_Tg!$IKfqmTRn-at=a52P*kX{u<e2FMJ|Deq*k)^SlK;#CjC
z&R%R=H~Eha^Y^yUMdn{Z?~6rVQoqs0w0L8%(P(Iu!c88y6ws11D?d33*gBfp+}_3h
zl?2=$4UVm1CU?mf{E7!-OC?(c6SpFBB)L_Ez%Q5%_~Tf+dp1nHQi-!?XtKpbCT31r
zfW%BKe2wwzCj{nL37JcU(72_<Vz4THOn7Y&2d(CmWsgOj?Qi#QzzbR_o3q_R?+Yjn
z9jsv}+<H0FS-iEa8}?*S@<Kp?zaE5_zb^Nic_ebf8+6?>#R6l7t)R-29gD<STmPAX
zcAyu>zs{uNxaBM-CX3Ty8ZbkaG^}hBjVcyo9wI>rqB0o`t%rui64q6I%@~6c8;j~B
zxHwpU>j}4dH<93ti!(krGnV^6_B3|<B$tz@@XlA-4Eg*<K1G`ao_~Qh5_Uufac$wG
zrts-`_tfv-zjT(vHpF}U3-IXi(76M^@<p!|UTHv{=wXjdaPeTs;A`aEA<IxninTgw
z1&5I|3kq*3+IjVihT28TM(H2#v`e*CVa#xDG7l8wT5HE9*|(TvSSu}Ved(a5_-9#Y
zFP2Rj=GA26nyc)?52-VtrQsX6=G6<5I=DA^paNuTL{7yGLhac!){mYRrp!vMcM!_W
zNo;7?x3WeNWk?n>AnA#__<`vmUcE;3gE{g^sa3`pgA}T5vuK(@O&P;9vNy!f5gnra
zxj!v^>{ziE9X@G^XK4>irr|aa61<tlHW@(dfN3VAjp`BIrtpe>KA2i(bRgG*R7rt|
znr7kOKnhng+hUtK6j8W&6n%d#==B0E!r~%2PZ^WUnP0AQ9u@1ADr2&g8z%k1MtuI7
zd8=5-t&n-F?d|uomKkU>R@cH{3Q-x8hkDXu`RybNON;g$ZldU#k9;VVx2^|1<j6Kx
z225?XJsvQXkZVqPMFs+7<?ViN`7}T3wpm=#N(wuBes>}Ii=Dj)xIzmA8_gssVwlPp
z@6Zy*WU#5-6;`q`h8rFzMmHou5sg>`Djd;8m&|xbgdRPgl2$g^P4_?MD9kWx@QJi~
z#Qu|3*R3kXFRC_Cb<n0hXZRH?b6G{amG%Rn!7|V|)=b&b2jH4d@%`qF@#OpMmdyce
z7wpA`5SD<!-=x|EJA>g|!tip{uR!5gXEWr(QY#%han%#u@rHO#DJ^#1xEcPzu4P%j
zNXuBBoNl?=f$Jb!KVH!nR=3lj*qt$22&D`fvf_n(H!(Md&ojf@A(r+rJVMo`F^@Vw
zCFBfMRC75)v7Q>GDgmmZ2J;Vce})MsAEUi{v8J-H4DU$-kfwZJu|TW9`8TZLut_tt
z^QmZqOwtkTFQZro)mxy|0a@63!2(_WZ>V{61MD}ozq?AxgV-+FH^tb8-`*<a*Uq#f
zakUH9%D+LTG1+UyQQzKD0u66EN|j1C=SSPE621f^Q#~lYqDSGK+4Os&WqP!y<=BmM
z{ZTlSTrD%$y7HL^@MWi_?|cUgVnsf@K$iJ|zR3oDqin*Y<bppt!>g|qOK(Q1F=VNG
z2y(t^aIE~?wKHmCl4Ap#UK00Fbo@T+Ss_#A0Z014Nq5oSGpNc17PNvsfRnzkU%)Jr
z{Lj!>r3lb03im|1PE;sWa(hTZl0_&E(*?t&GW>#%X*N0wKcM-VP8@?4hm8#9GZ^pC
zJju|HQk3B|P*}3R5NnPfinVG8^84&ZcF}QyiRk>BR>%3RvTuBaon8lx9Xw84sh)a>
z!naK{^{pD!U`dZTIb=@lOXE~b-Wqq9H|8tu9qA5Gzslqf#d&{c2RziljHb7K!{!{V
zDcR4<LB{oW7V|S$*D<a0ZZkP&7^az<3#+C@wPTNS5LMHNmt_Tr_a@gAS?nwP2FMKR
z;Qs+s9ugMIDw!tQOWE#}9?3^(;x|wqgW`uaiL36m+)rhYByK9V9N0HyTArjzN)~(k
z)n4y)BLSd^rz~ZjdA?RM*g4d~GUE^f>MOy8Tkp5yjY-nf>(bpnC`x3va$x1+ONXkN
z1p%n$k*c3GO#?2L{?q|a6xz9QbZb@j=NkJ2H*;WX2-<G(ANkgf+&7sXnCsFl&I{kC
zj&4Pwu$`@Q97rhB+(~gepQC&6LIp?HKDs%6xnWyt4rAr{WNdD#;E*zoGhiR12Ph2C
z(08}G?+EH&9WAE-m!|UN9%?@Jv7PnXdam`9?tUW;mz*BZWKz3cxmO8)XcGh)gUS~n
z@m}HgXCI~8y-OOB8GZsz@MP&!s6go$8YpY<3MN-9dI|zd_zm&2*+MAtstu#z)&GvC
zb-!{?{tGI(SFM!K?SWgfOLgz$#UA-y`D;W#`*50!n1(KmJ(6tKG@)W@($Z}VUso;K
z89@ynfM!M3>Q>iM5izx8OjgjacE?lAMCQlW$}N#dELh7qbkcLn&Y^idD`D4&>P1VI
z5En0ek&mgMuZkLV3d6v|F#P&R44>VvKDq+OHJBa3W>_bkT(W_FQ+&lW$R1(ULJ`J?
zJ{JJ3<3A6`X_y+_HZ47>jX$DpO<M|=rR91Zf!|mP8YlL7{!M@#go08<$|nunoGee%
zytt<ss+Cm|d&n73A^v3_^`dR%)S7|Krl>O-HVe8BZq8&6Zp*PsF13o~ba}91rKtlh
zWbwxs%@xJ}9-_2A>+-NA!kb_R*;LG5=+f%%Dzo}ml?{O4Iui*>c!{08GAZqAh06RL
ztXTP*%&&>ZYIhgX9;-Zhfu=IQQ<#!<g9EA|aL!5!&E=S6P?Ir(JwgE2sCWA$fhnTt
z#)wyjKyO)LBc<>VD;srTbL2<&Gt^l6tq0xt9@1A|08KDv#H*}`9j$dgx4^l0SI*%}
zp=%OUyQ~YdtP#hd-M7N6AuEC!k~RHSkp@ct0LuEtIh?@p6NsCJs29FOyfRBVMJtC8
zcD^4hiFox!`(gN0OlxvXDDgD!^^G~HI|DLjeZDPV_<S(vxD)->aovxb`z(e2^CsFN
zYHhsNfclr??;AEZs0-qPFR7iE_>|98E(;ZGay~;nq0*VrRpJ?9YVB)th4}&|ONqKb
z7sG_qqBJG%<UFRr;Gc$^^-3@0of{(RJIZgU7dvNv9yAdLJSV7slA4h`X>wSvs;dwF
zLEXZR>bDw{^PX9S0vohmN!O0$2T9W#BxM|OfL$b@JRR?;EE|&Fb&##$+KQ1(c{Ajv
z?`p?nnoS<^m4nbBu9(R3U-~)7GH*GVY%=y3FpLOB(IHfa6^D3keb+Ih?l*?Hj<*D_
zy>Oso?f8Vxou^#32$>gWPz1|}ub77gE6tfdZOy_qMC-iO*Qf>Gc`ckYI)_y7$daSY
zw2#Hzb*iV&VWAJCOlUlSJ$XAAor+~6t2NB5H~S|){&_kwbhjJs9JM$6rqD=zns=(I
zJ!Res5A{M})hRAxqO8G%Xk_T$QbaL2j7P$#dySr_MxpneEcBGDSn+%wPZ+6t$Nfqc
zmN>{c2N^*6Q*+WnKXK$d4^&t+^(WD;RhG=BgmUq^4GY%}8EE&aCt`{Hc+koa1{n=X
z{K_gu*dB<6Zj~NWhF+%JmS`cMS&bcBhj3ybG+AmpQ)5E(C|73eK|2HUVuN|0cI~*w
zK81}6ljWVT-_}c4DB&BEga+G8t{IIyqj|Zk#u&?jVO?G>*HKFdsLT4{yNRrc{%5PC
znz_G{=7HRJqBz$ho)BpJR3l2PjBRs_kaF0dN~1|jqV0aWAlqIq9F{$(ne-dV0bl5w
z#x_mG-O;qXC$jY3Lp)k#P!QA14PRmvq`J>-Eh}!xxJ(v!<%v$tkUV*h=G5kBKc)Vs
z;G{Mn30Lf4Rf5O3mgwv79_-{E!IOX0{2q0v2puv&u33VV=%<>&DngIhu=2udC@zes
zCY|{N#Iltq-S|fLwIfJi{ER_BvbZs*ZVP9VU<vHhZCo_=lkiRSA9D#V1@2@IuDv4l
zIcibQ+U$77*s}HMj}r#IVH<ln$ZAQWqs;2EhN*lL*i+O5W)u%@IUFe+&qVhtjJ!;y
z<sr$)nc~I9(F@2f?ZJhsOoy-gw$@{_C;g<`ijgzs8p;T)M_8{G%$ls$Cnu@8sfswp
zbm9DPB=Se52Ph;`?P8`HLgGuqp<&JW9ia^h&ITTK{*5PpUo-PLZcz0NF<W3YqT!An
zD-QF}5=_N%mEj@VVr3Zu!{wyP6@wd(2fFmD@1d*sdBmx0`N)~2!IIcNA4o1Q*`+lo
zFPg%trVGr_=87(+3xUrE0qjD#uV+xkcV--SQjY*nvGOIbM4<u5G93YSHA77kodkdA
zDJ$Yr77FcSr*e{hx9c#npImGZ8{BiVtyl>hX!vy$@qD`AbP(8eOwQX%j~R8@GNPFZ
zU^l^AGOY-Z744B?0`75t3Io0GJ?N77a-PkrBbHl8@WXucK4&VU;Yu%Nn>FSk>#h25
zWp1+SaxZ3|%;l8&^CyT9_gK|`asjLy9LK1}Hq&wM$B%G~<ekZ*D8FtDMtvT3e7Xp7
z{`eVMyfJY5B5k(gES$SGP0HRs=^ulPEhdFhl^rKY*T@GnEj$BlFH0@}b|9**o}uet
zjO(&6&Um-F2f|jFe|?4$64&*8u$biEG0WTnA70fLM&7_RcEfnHO2hrPLMZDSfp7e=
z8U?g+R3o8W`&Jjh$5CShwCEf`3mbkLaAEWy5nZzUfa*&%tTc7De5gfzVtK{ILAWd<
zU$osQ9lnVC%r^YwCtdO&@30l>FI#399;9ZBO%eRc9G{pl%1Zbeg03*fU<(2?Qt>o=
zWJW<lteG{bQI^jZv;=&>{IIgfK%m4WRVu4`Y9y;jPC?DM6~AJ_eC^C^liKyuq^niE
zvzE#ko~{p4-H_AjgIOE5(j8)w8zn87BOAuboqMWI;kbuKV3l*MzMvB3CFu7TPQ$V9
z<qE`^W*A?tF&y)#!}JSqWyF=1Gg!3@IDz@tvpkundgh<m6QJ4iN0hl;SMV9VqlVhd
z4iQna)SIYzs#_9>n#H45&kZ~;qpk-1U{I?1qXctJ{V_gimXywV8$iI6n-nv@jKcnb
z$*@~Nn%Q=!_ZwvtGF86_5)fH>@TG<D*LIH)nUlh1#ZF2L!n#ze<2$3Mqz#3yYn&Kk
zPtO#_AnGa*nRR3Pm_A0s6f+xRjQ`RBPnOTd6x~qj!~+iAcJ?1txFfxcF^!;_%<>%z
zxo+$7C5o6n7*!e@HV)e}U#~w^CA=%F5Ftw#V;}$iobO$Ep$&FJB~eyTU8Oy1DI17b
zqHMsEe&i2h?W6=Yc(mFBp}nH{XyJ7!#3-vFY+|A2k`Gij&_6I+oay^qLRtDgh^m!}
zWms4jU!~}|=FBn6C3es)LPkwy3hn2EgQ+(^-@xY92|CXoUT<gCu-<R<gvPJ7`>31L
z2rR_>pShr}XI#xn)zl3eV-TS|MHIr-?U}$$nv<sqnHoWJzIj72-<ryynAz2A?l2OQ
zZ}y%J8MC^v^1IC-F3ol)Zl>3ICr}vtmw)q6*puXHl%WyOMB-$74SCfV72@JNRmek@
z2W40j%k4P7^NRW|>uf;d#W-hN#&;kqw2xzl``LOaJeTrhxr3<!M)D@6W)l3D6!OaI
z5n<<aRWI^-2|o`BU^JkHl@WzzW()2++9c<`){ctR;lpAa+}bBYuButSi~}uZoIBo}
zuUMW)IX_q;zj;jccF-HqVlj&8`SKqRCRm6ra2s=IiVplYgj|9|*4mVWhcZz1t1^YG
z`sGiAb^3&WHhQ#vQDMc3=Y@{cZ2!TOPi}&{;gc(Awzumz8WudXPuCQ+2Dcl_#yCh4
z29VTey9c+9;oogizViiN(zG$<$*?$I)z7dwle4_W%I9gQq`3n%ukFi+T)r46f0aMl
zHtG_|rnuxrEkA>6i9F{_+TAtWQ!2kc>T<o8cy&(R>GmI9Sl5Z{u88p!&?u(N8Tn+2
z{S2Gw96B^@1;+S(nJ)MpD=lA1W}CX<exo%=%{(mC!I`4I5VyJt<@A7a@tjsnsbtXH
zdb!=u)bR|M5p&>VAygx^-Bt$v3VTRB%^6$n(+|-&OxtoKAFR|xA$XLyUO!{+dM^07
z<RMX!<qD{UCM`m~8xgz^JTJtm7Unwl+z9%=4s|Vd-0=?6D`<sA0CR$=I{8M&zYSs?
zdGKn96ATRRZRtlGkLe}=XQhl#t=wB9e!=9d8Tq>kR<)=6ogVB%?t_^v@^>_e-7P!#
z#~3ey%Qg|>?fi2KW?|`rWXY{b*{T+K_0CD+iW##o#T3j4Sh5RQvYS66(;RoXTmCRO
zAh~4%0c(lB6rndR{s%A)&_4@<ey7fGs%vmf8hQzj0@G&QBjRe*Z*i9szjmMNL0>q%
zF(EbL0lHLN<Eb?G)AB5k{V=Xs^hh~;eV(J4h(Z}6^o0^kl~8|{<H4cXhYuiAbLg4#
z<l8i6-DTLd3ICy@h`D%+jpLW6nWU+gI92;O;Bgl#Xm<tX!z6`M_BDq8-9ETz@dO~d
zsuJY-VQrJv+#Fsj@cRxb?zdy9N!=9?&Mm!gRJHKuAi7Q`@&aj?GgK<yWFH4Cj+pbt
z*o&`nW2-f1$u{(AYcSQ1+)b%M$8NoF&+w!vZE4uF<vVu^VvnsJZ^$~@ocdkDsC(^8
zuYia@vmA?IhddWJjkX)*P${_35<S}&#=>Xaln8#O-r1}~8-4HMB}ku5I0@Q_;kSm`
z;$9^`^1V+_mcpKE^4hH2l-qc!{7trH8hIB`P<6Fxfm5+?DoBVnval+KmgFm6twn-e
z+L$F0s+r1Mbu3<zM@Ms;)K!^TU_KJs$qAt`qnBiGWoRTwXN0CR!Z{3O31(p!ZZ4n%
zkt;=eoe7<0#hG+fW)3N@xuNvn{8&$ZbYreSMs%Zc(k0}gp=Ey$&8;$g>~R$;%@&mv
zD<_o?2LOGIR1bC=Ke1)GV=0yeOdfE7Qgw@H#$f$fdbw@lq6gXr4zB2xG`xg$guW8x
z>hktp>1H4<3>HZmN|vwNxY=Suz-F?%h>&>o#W0tvTkK*+Z{amAv0*3jt=CTul7g^!
zGnii#t3O>G*O;RpoQXnMHe+U>C4WoX!rYJlhGtb<@jn_WG}3%5+e1+ydFILPloh#S
zg0;HpB?rYuO$}l#>SarE?}O6mrcZF`mTq@=UAYETb+cw{?|NgcS%b{lelQF34h0V+
zOIH8Gvg3%GWc7l&2Z*ShzAU&W2bH2S*E>wU9a8O}X`@UqjmnQ{$r4Xb`QBK}VN4+^
z;=5Ti0?r->SF<uZOllf@IeV`Iv-Y~=%kO&T-r#FJuv-D~wN4-J*l4EE!F7!Qf`_vU
z95Z&Vrj4S%#Yt?v<adWH+3al5EpFj}hW5y#9ioGz0cF4+sXFiU?>*67+OVLdF_f@l
zfbR+#WDfo9BIzaZ^)f^I<5E5F*mtirXkIIKyE5Y(DP){KB2M+wAdJUuBFI~%AyLqY
zdBd9UuD7xNT7pjAOON3b-)LM!2_!A_o&-{@NJcwvIXVRYtntn1tLKRy;&qs7`{18f
z3O_U8*VNa?_sYzhSkA9A!5VZaGxf%Ate^jEt`kfxc*H77(pbtUu(Cb@t0V>xBf5Kv
zcLRi`(j(s)#wKP+yY7POTes;UjX~rmH_fnd!~CR3oQVJzdn&hR7O8PmXWKM&5<6-#
zr9F&jGxD3aUR@gJyEIUwT9@hm{b4E%XD_9FfS1nVJ(Ow>bZOkCPp0B=?_GcMiv_%g
zC|T4gtC$;^#W&BUi*AVAUxo&g3?UaZSNzWEn#Gr^i7P20_%E%nJ(v&FaQU)YKDwJ4
zm+(M}o>U<()P;`A3p=Is^XeLv99*9CUOVwAa7kepd6(6vbv3x&t+7GUW~JTAw8SCE
zPdj#Ip!3;1Ge|8FGka`KvT>-)Po&r9kiRKL3mVle!oF54Z_jCnkC1IbFJ9}dV36U~
z`Rd^#5Idc7?s)Vzf{C_f@Sh+jFuuV>NUeAlMk57M@2vEYR=I(KP@KpNn^>M76r2<X
zPZWIWIkswlWN6!nWc^FY*PdlVVy)8o^2nhT>#_Ri&^7--e|A+3oCgc!(4-VT*E6Iq
z;P~_TuRUEL@)ty#ZdJG^=aCt5YiWc7&W>N-0)dL|d6uo`L!wwjz*u1VpM%cS<&V0W
zV1bY#t&ef^4W7|!QJ<K{sIC{>wuZB9ll*$emutE=98epht#hU9<t#JKgR5G1jBO^_
zUpEPYhR;`ZZ^)x~iuN=o6=2<R^zBKV?B*DcTn~`1onsL59p8B&uT(NZcxkovqc3xp
zlKj%@Q4^?_bG}6S)uY~6`Kw@0>D`tFrz75-*@qF#=6iWz&cT?}$uJh2iButczS^l@
zQD>3sx-T97{Tq?_<IMqEbv(c>$wX$W?or2(IN(T@;^sV-FqhI_rKF`oXrn5RBJ2s}
zcIF8DljOb27o^IMpHG}S8i{F0w2B69mO64CS_oQH!A};X?sg7w{^XVg>;^KXNqSA~
z_Lo978HEY{KJ#d!Jmu#f%P;k%(I4Ss<&|>I1<#@IdNblF-6hFuTjd)S1l@labrh-a
zA9MIYWiH+BP8L$*`n5C95A)4?WosKx^Br#u*!~hbU)>uPXNFGRn3?3--Bk~`{_U9x
z;ts8K`^z{C`H<T>5nv6k4<r-RGhV*4rBLfvKS8>*+EXSS#2?w+ta0F9UL2MkDn$Rv
zQyINy&B-sB)wRx|f6c{C#F)mP()=e|WuZj5{UtaWTHPz{KW!{T@ON7U3$k(G1A$88
z9zQ!Xm9O;i0H@0lSj98FL9s^IX&<e(Xi`iSjFyD^$-9a(-S8dFWx#1RC^{#tKWQ3g
zu5#ec4gdx@4KZf%#;V6rS>GFOedqrJxS}yKR?F8}kYYtO@^}?ELFgV|$Ir=}i<x*i
zSQv!@w`Gp1Sb16{M0khdbOrF;fn%QHghfieFZc{fcv}Ag1MOG=ydEq`h?mm9F#hX~
zz)0$JZXIodUFKdKNY@M&p;F>sR!x@{mW@PYbKZ9B#H+kEm_RU-6Fj`N;B~HfL_fUR
zV2?9qmAJF~lI`Jj0<qOaut0;yv{uSz?kga_`H*FMW%{LePhs-6ZTv33$n;+WMQd1f
zhBp)$HVlNbMb9HqMAriRNhadq|BZLa0yQHu^CXde^m)R%2O3yDIE#3g2TO)C_$M(*
zFXx*zj+LL?CIC5cPLJz>HCE`rD%kq>%nDtNVp)(4=~Y`cE(Hyv+Ke;|Z`NmyLf%Bp
zKsyNS`S_i7FS_q_#U%|bljdj|=dhD~V?ev(f;rfC_&gNU{oOGUj0~SdCDp#9-P{m7
zVDn%=y`k4~`an_nOWMQd`7dc(J((T~kp^OVboyOs%0Gf#s>6IOAA1k0HS=)sqe8-S
zl=*%{>C}-3TCkB{$+USb@c!c72)<8vrwhjaJwSwO?PzF8I=+BhXit%J&oq7mVD#d9
zv;;T=b4Lwp??vgg_)cuWV1u}CE>=58(VQmdXOLUItLv#9*|zX&U6_=?SnV>fF|u4}
z<0a7f>&?)BxZjW8_fz&VwGneUAkmf$bjbZ_*O#pC3@mZ_)F2^N`vvS_C{y$6@?1lr
zKh6#0+Ijh~R!v~;Jx;nWS6A?>t4HVM=FgWpFF!GZo2kAV)@IXti^h9j6_zVvsyKUp
z4=9=5yLFmOf6aHK%6kH+!g2MmX`IbABp!bX)4&X1QdNDnKo7o+K(&(gwUZj<V$*jZ
zXGngt6wQwz(ZALc6~*eK9CvLD%5x#?Y%%{39SK7OOAnSv>>@fW@?2C<e#8A1lUc_S
zblOH$%RWbnrELZ*m5x-$m7xEv2=p|p9=*H<%ccpsC5Pj1)_)C^3x@)16WfPn-CVCI
zT%Bv~6Iv0cV%{-~ddjc7mbF7k*8JEA52LoU$;M@`b+L(-&9DQ2-ffD~+@#+Yh+DJe
z=8r|mva7`mOJ7cDvM70c{JJN#cDe+toFemKe;{mAeW)v6O>Uql@Fs`1$}1J<1C?J-
zQH_CPpDWQ}$|ujQ6l^{0459;Tg;ahTNxIs20}uOEnRsldNM#>fr>jgHA0Ok8#Sloy
z5oEV+M#H%HuB0R@qNAY$Z#`d@L;H%Kp0}LR0Q3b9>yM65^%bG+=?v10<y1asMETRo
zsxr$v4*??GW8m4R1GuZ2Zj?c-occ%3Cg?}Ec|<wmNDOLMwQ6)uxt<}r{E+X)4=873
zS)=CA|8&Nmv%C+E1~<Kmz@nyG<|)0x?<ZBI<3w%Yo=X|F+YP6*=L5b)R><{Al)rrM
zN*$XNKYEF`Lf~ekQUrL_;@3I}9o8WABX!r28wPxcEEW5!tfF16jftHESlI||WrlHU
zG~tc9%?Yqpt6}k>+p$;%`kymaQ!q2ob+kF@a}doNyVa${$CFhmyC#LGj5HbmUDd_X
z45(QCrY|nR@=FcR?G75iCBC}+ckb81ETdl=w1BufJM@#O-($*>WA6vn*6Jc7nNF6>
zjx&O5nlS-=VhMVBi;nW%G3&>YgQqjBbTDMi2&c&itew$4TnM{^U}`p$jCb71T~S6(
z+D4gRBE*_q`4(wJrp+Pvk8yYMB-1}GF^_W`Y9|w%)rW^9)elav&eE@CWH;r-nl>Qe
zpPTqCRW`=59;?1XlpdS>7BDY?I!Q)4+gSu?Q(FpmYw=q8K%+iq0OgxCxbr*4A}r6r
z=3Tww+Fs*cALct?Sc?~`Y<xSgqR%4BH^7tt^bdKurali@|FZkuP44fw)_Y*iZT=xQ
zOu0r%*yQv3i=DJX(B}Uc&zPVwP-c=k9`$RS-t~XYtHxA+T8VB)=rORM>3@k4OxgnE
za$akHTg%mz-2-#tbY`{Y{tdVf$_R?zCQA8NU<a2yWpAP{3tDOfX-(@Ovd&?^e)g?u
z;K${|B;XIIMZ|*EcApY8umFAM7CghqGxZSz@L`bUsr(_7v%K6Ts}}apqJRHD-Z)%3
z0GyUxf`jiU^MBH_oY0@sI_9XLiC6iG+T)VvwLIbi;wspOKg)jX{mb0}ULCKRJANI(
zko;S3Cs}KaiKle5Ygh+I@b_R-j+Bcr97Lp@pi|@YU3;HgUO;<2Pu+_hP`R);yispa
zyIQ+10G&Ocs-mobi0bdY9!Df;(=F09Mm`~MHl4IiiIUUV10`Zy2iTHTA=)Y)EfTY4
zU1-Ze0|}d;D_Lpr!5E#tM09njtR=o2{gQuC4%FcP>|WKRWxl3bmoqLGk6>m<PV>}R
z<6RmT!{KEIP!paDl$OZH7zE_cc}e`Q(G#AT^tfY9?#zhQ5-72$RU#}o$~~0xIofjK
zKNwN6+e^IPOR~d)6_z|oJzOwm=KerZTF)O%3MI6EF<m?XxFcdF-yGg8T#KAkxLJE%
zYfG2pp3vYKVw6Rq6tL8>)M=SXzi#dL1L%kK<9e2o9pClO!#wE8FIL6O`zz(b-Xi4B
zc$>Llh{e#X>YVifqYM*9s=bIXP(Gw~-(Xb_s2WmRRT^zeY*A5<Y1A6E*Q#VCX5e;(
z8gDIEGelviCFY3;nuxKI!>0l*CuNUh%pZl;P!?zgCHZ1*^i|TQ0oHp`c*&BDeM>D!
zEorOBd<3scrY8+%$54H4QlbA2w|sfcnN=~5Bj8e`j*4TWc+TrQgcp7=GQ)7|%6U6l
zAl0ZH%wXxrMW?4THKZ)y?ZRNfcUDvhvz)~38AjVG*k!tRcrrBEN0&&aPUBqyCMx)>
zWB9>JK}<X}rD?OmCO6`N&yhcU@NygIjQ7w@0xyFc7WXdu8)xZ@(W`+nf%N^OI3r8(
z*O&gpya=ccb0|7Txl{3hZ8eNb8Hlx6)ax_lnb-Ibh26qkPry~L_drNSJl1+;5ygI9
z<`iJ&eMF8*>Z+S~#ZpT1nlf%sEQjZM4<T~v9@#rD3`t3DCwlH0tbqvXU*|4q>bn0e
zJ@U<WXo7D6(~{=Q-XVgF=<W2l|AdHZ;!;-i9RNN|VtN2Fl$AyfE9Mm64y)Ck7m97n
z$dDC#c5tG@-!h{!Jugm|XQ?^T=pvJ{8w2W#$F(2yL1fia`HJpK==ZvPrkUBUmS!M=
z;-SA)?EEn}dChoNP(a1}nUb&G7oN~Q=~wRLArDx<yKJpzbaf|}$Jt)AR(4iwMH+e&
z>`8}X&FCegOps$Fja%z2UC&JyG2Vv7-pIYvu@_GM;q|-8@PW)D7M88!O%nJ^_3O#o
zimZ6u$;E3l!y+rjs?T}c$6+gNsyADc3MWlgj@cZdx<6@hY|S3*-Xl9^u#~5mEErQ=
zq@n0ObxX`%cKrX0zMQ}7@A7m$x|;c8BVdxJlGI!dt(#?ru|grL1mjVB0iZ)wDqJt9
zaqbEwma14WA;h|WMGp{0zayMoxQKtEW`11xIaTEN0QPw-G)Zw#ps$IlCHB-_^$8-H
zgTLM+rG!5YA(Co*Rt5lYMcOULo4SwXQ~lgz`BW08s@BD>OyPlRK`m?2PHxq(eDHf|
zyi1LI%CR`-eY7Wg-v~FOre9B9u}G}VIVw+lZNz;XeLN>uIdw9m&~syQ_d>Rfe98#I
z%x;7ebk7GC<|y`}yapNk`|gt_w?L)Kp3zmQ#D0w%+XFApf!e?`aXuq8*uAuvEQwJ7
zZ=f+sH5@<)A@W#M{Oz}R_o^HZ@!~@N$OsVmt@C@xlIV~#|4dSRPySt&bpmdaVMngL
zfcckl6~YAZ<Bm+}7stY1L_n3>VINdUeV*l>yn#3HVe+Z(a+wt)zXi7iSj68P!bEEB
zt~(#@H-B(e>)UF0W=?Xodk1c(9h}q|w_X#I5*SV@`5p~*kJzz~<w59hqnez=^0Hmk
z4qUG>3&>>NKS$Z;>O4hnZ)Q5a2SG>JLz2uNq+_;IqY_Du7LXX3`oNim{Fbj9A~e}R
zqeR@`n$(bsBx98xvQBu_bcH8ILGDF#Tr|?bJuvX<&d|iQ1liI1{BGK%8&d&Wz6Yre
z{T-z0rwsKZ^M?-PE{Q|+rq+F?i33i&3&6ArhCWb@kp!msWMsZD)bl~;TzqKozrrkn
zUpQ)>;l~PiB7z$$r%}|`*U0>&Wn>=dy!6u;@N2C9p5V{@v(d-I%0Hm)`<MX3vFMkq
zN$n-q2H^1q^hMSl2*~U&v12H@mML-Yq`QGSqiwzB%SDs|f2+v?!_Z}Uo}MP+HM`2N
z6&49H7*#Pyuw*`fQ|{VrJ<58bLAS0zdm$tqSUa0QjgWUp*1CL=fAmbfL9i?h#rR21
zOow3f$p9NMRPDy+1P-9Sd4uie10ODI9n)GcSkkz$LHE9D8C5r(9%WUGXm+KMe{>K+
zemarF8CbG=EJ}SrPz7|+1@bHBa9od-tW*NCrwCC)iR<6k0R_vydQm4QCEkjmA46`S
z-zCNW%X}lqa?CC8J(R@1#6=J!!^bOHU$Y7&cqz*r>=p~*2PZP&Rl-kfqYiipx<oXX
z=F=j}|CfoOa3gC=KYOS@sT!A)GR8cl=5Y)V#2AxHG_<!-WEcF8_P#VK$-Irbo@%VI
zqMk}CQ^sk^%B`}=Oo7VEW~^+UCfC%|(n^!u1z9RnD^qGL&0MIgtZ^Y%Qdvq<Qb%w}
zaRX9RR73<sc6e`X?Af0W?}zu(d(QuG5IG0#n{)r~>-udMXbLaOu`F=dfIGto=mU{>
zinM@S&+=v(ewX5s!I12*W%VuGu=z|*Pari-_4!IZc_bk?=3@(NkpBYj1~dIA92gmH
zo`ZA(fUaHkAOIjM062tRNI*(y(XFo_UeW7Hx$bIP%z#-umBP)gp4ZIYgM3gLn#1~b
zb#T=s!V6xUDw7B(z~<{Wu4&)QOlu3ZJ<9i<A;1(b<0-1Vn)pb`_<JNidw`tL|E2|w
z(H@>e85Cw<KiI$!V|xqw<t+IZQv*SoOWxw-Qx!10bd2^p&UAlDm)AQ+G-;;s2qClg
z4JAMkT<)8e!M<4MDrvh|^EWs~Zv5_^)-f6v+l=>+UgJkCrEYN{OLukox}%cBDSOW&
zgm811v}zH&@wub=G10mPJNY2tM1fvQG0hb#YG76BGMX!O>g?cZaGX3d%eEPnbXMB#
zq;=QaJeSAqc9qJiIG6s7%z1m|A5e|uik?tM=^g`E^QE4!vWe<n{;Qh?e$nJ5JFIXE
z(>*1i1k)F?R9(Vft<DjJDXl4pwgQS~%u^jNF(FMPoT)k55u_&OLWN3rH2!ZgWz7qQ
zJKDw<=&bRrivT6Pdw9YO<7U(L#ga**1Ij>Q{I@+GulkG7r~W}MWzO`GR?t!@kTt0+
zyuWBpr#L49Is^z6zes?3^&ZA>Ks@4fHjzS0Kg~w2t_8Ha+Hq-J$rr`c!m8YLyx?R>
z1vGaMCHSa32<+JW?R2IAFF2_z{&skAP$`~ZN#}iHrW)`f274<8QS^^$;OQNS9iq2w
z5Os2+@3Bc&Jfo!HMg6|W!&(uuH0)KU%SweafP|i5V|o{ZlL9AdJOn|zRvP<&TuB$e
zEhb6fh|{Xu)F)&EZtH+zMEG=O&G0S{+SB?tRG7L9DpxH=;9NL<`lIg~eMNMa{p9ib
zpA83NvPqJ(`*Tt~Do@XyL~|q2coIl2mwrqaIBq*lciBb1%ca)ybL7nea7pp1(mayp
z&21=sNJ`jRkx{>|qctAj%$?F`ne^2ff3i(+w&y3G%ZTG$VS&4fH|6TSp*_58YpO<Q
z{Mlg_M3@QSbf83-kaY$^+Dd$JEG!z8YVM`MShPzt@)B7atrCZz-S3bolzZLCV%?4D
zOio}0t{yE96Rc~xRM<zmjR8YB@$8A2u)7WS=|`F}V#uXz)l?=ZVAE?<QZFqKw>bvm
z#Is?bMmjc--J{cp*`A%yy(%bb6sUsPVb7)P15ePA^j3JD;8_JIm?VrB%tPYmYHmgT
z;kFd(1A7$H|0n`nn2rsx|B>C0!VLk39L1+&JRzYWZBX}zj9Q~U&PFc!%?90C`_Sxd
zs&hRskJ#}mhP2E5`+ioP%h4Z&z~dgpWIvLy_Mkzp*PErD)j1;nus><RJ`wygb|Ka>
z7(}~FUOlrKX&CyT;r0fI7eA%G=F*rjZHQHV*SMkB)>AI7jIV!tH5NE`KD(?ou}$uT
z`K>eH*4~$T+|~E$Sb4H5>}i4-T;+CmQ4$T$<gDYq8xTBQujlHwYvu7i$5*hw0sr7-
zQ3(ay14HKQ4cplpZol^;+3YUGEKnHZkBSoHz^j*5Xa{rd4~V?P$ID}m7Rr(q&RY~?
zUTTgww41V#)U+{ERQ-=smBca0@<-Kb`O1%x*KyoTLO16A7N=3Ndl&aBGo8-dVF<ul
z?%=|td)oD$az{XU$60mWu1Nf5I&?sP4%KSr>O0Tw<TGn$)e@$ZBJo`SMYMgXW7nm|
z4#i+EI_~dup4i8!4Q@34jZqpGe0KeRsu)*{#fv;K`&?JjX#l2dK{B;3?M)!S<<o1d
zi?sBcXwJ7nt-DaSR_HZcr;nlA6J?}DjAn{qL-^1`BR@dmt~rn9T%NZTHiS~;1aPM6
zVZlt(bK;<-I|=?Uv0mlM?^3yf;AmzLV?Q5jBXXqzsU+8F<Di|!`qWNrK=oI7`x2EU
zf))l-DvvPPFnIp)?k1e@9&UJ^PxG0?01$;#XXkwkd+n@Gx=EG#&>Tiln(c~k2Vixv
z3`q+!z?;JrB7_q}$7ut=iL7QlKW9p}=o^XA4u-qNo%<5F*`;z1jb&O_=C3jd?$3@v
zZQ}cO!`!v4rAFq|BRKx*zOY$@!p>M;HvOIxFy=Ab7+Z)m>BH<~kp#Ulq4uJ}<{(JO
zIPWD3Q`u|{h6S}(1_L^f(q8)ll2d^<SNyF)a7r;~Ux)0gco?INis#NK<2}IF@Di`#
z^9hzvNu>(-?F1Vo;6d9@#R*Lj&nko8EP8jlz1UmQ7W3d`_EpiVir{V7Rsh13qRV@K
zZ1&jzA{rt3D*R2t0j((Av4Os3<e|}kJ`UaS2f+eu;pw7AKVvu^qJ|LD*^a~S-#kh>
zUI)CH^*HGd=b&<V$%N%6x`nP=;w;mCWJPsQc@txLQjXZD{<O8OFiFHtt?y!x!Z&9V
zwGtVFO;)!Gp>AGa%J4^DtDb<*S!-SzH}@3}NhKC$6YG)w<W6&^vd>LiJ)fBrHy($!
zN#Cn8^&r7jd&<5c+$BAF;)Xt*9f-#&xQ{9V9DM9AOp={b6=Q_m950fv&2CU%{s^2b
zY?ZZ=Za$=T%N}W=Kgl4ERj(}K9*wF@ejz-9POs_(UwThAob0xb88?5%TW8cSdo*DE
zoaxWue*6am7ANllUTw@%J_7U4?!_-EpZI2MK~|JimPj0v&E>}pUg2R!)3a>E9^&1Y
zWEbbuR>iSd^{NHD5WKAMQro4Os*q$I&=SFOngh{*-p&;!?Ontz0nBaE?diVFlZRph
z1a~?-T7PEnN-dF_7|N1%4_;{i0Be*1??KINj<Yl&LnC<z7WObG;DlKvYoYv4t$kP3
zMEA^PQh#28DoSq8*<34|I^G&rzB~NpxiDN8V2O~?erz^b&)CMvd-xihj=n32E6?7n
zHS2?T&RW~N`t#1LAjU#>+6eVfEFC+#$<mFLRnu=#U61-ag<2=M&i{mZ67h}ZC~uLY
zWM4WoS@BLeeq<@!$G%KGb&;VLeWhlq0L+$~cBB?YUpM8LiSb$5D;gR09PS*zP9Uw%
zkY!nWR6f7|2!}*<=Jq*cTu&K)`pZ(%BEo*2(&;1yagUy(pH8sTY2Aj>?Oj*Sv2GW7
z=$=v5XUZl$%qL%LG=?^e`|O}(Y=5r1=X(G(irGfTA#VzOwIT-7o>y83TdCO0ui0Wa
z`ax;;Db5^FTKYit3EwySxK|X|ogCWPzL1SnlK9jf^v^8r&j%Wel%XxB69Jj_AyAit
z%Q0Mu<WRavfU3mQ&T@ZCE~iWm8q*VXsZIFy0IoCVy<{|1xS<6ld2q(f0G_u6#!>p+
zd910TP`UPZUsp)QXqW?^_H$5+a5#rCs7}w7bjiBE*di46eZFL11Dtf%8MIqJIm1{F
z!sD_-cnQKk**=ILT|b`Fs$TFJT`;MddFoZPTly_(IUiyjl9QhRg{$d_W|N}BNtcMO
z4oRlWi+Drr1fEeNif}>09{Z*SVX9DDn-P9ctVykn4_)784znTc90!ELkwE1d+==j;
zRdexuu657kvBQ1|sWAYYQw3pdEryfR{pOtTH$8;piX{KDdrC2@U~JkEH<FA%?T!>&
zI9QXQiFmu-aD_D(I5@Yv$%73?La<WhK*>f!bTDTOqy~;wPxReg^x9bA3lG)g9a+t@
z-bK8-;u84|ws4~lOdWcfjamF;IEgl{DIQay&{+jO3hY6}(J@W&a&RGd#Qu|Zk4j_p
zvZk2ASpvB^L|0)lq)^X`9F{v3FC7+G0e<2PU1?}_i>H$%n{g*CfJDWg5ypiW0Pc)>
zXu>R)1x+~9=cAg4vb8w9z8yQE@<@l3jlZwfV$wTPPnJt_2Ql5i8fdC{3yzknOEkRO
zNSMXsk1IN5fgDh?>~-Q);`FXAS>23=*H5#Se`wr5DiI_dfh{&`)&@_20=r)Uh!#TT
z3tYS9){jjA=E+_2YMysq+|gNp_t!-Qe?D)_9AaUO#rn5EDc1X7wSZJ2s4<NQ9Rc_!
zHn!#JyvA&;C(p`}S0_#l@Ql)~4ZqnN1Kf&#VB7r+FXuf5EOGDP;?4<4{&DL{@NQS0
ziz6?hNNiFd$)Ck0-coj<KLFkM&Ij!F{4HP}Z0v4AK_FGQGtK81;cTcYd1;EF8DDX_
z8DxvpK454Pr`N<`4;D;vN+!!bqZgn+hh=a=H*cJQ+Hs3BSmq%U?gXcs+@n`BYHx5S
zw8p%@L|+;xn^}0k+O--G4yvwgtk7!+5G*=3C$tU6yld6il&GAqfv+;_1rmaS-;oKZ
z)8*d?IlF|igWbJ)3%-!CY-+$*&e%`uv4LO6SgAJ0T^Bg&CcPk7v~A{L%2})h<Wm*F
zqReIU2e%SJNUUaJ@34Lh_A2k8Ww1-bW#7#1q=@^GUSz^uX^6l)pvI&KeW8nD_9tMP
z7AQ22H#ro}>vv0}9@n;N@}!lU1JKZyZ*9Nxwcp*tpskgC1FYpiwut7}?CA5xWZQR*
zoSVMZ9)BVwF0CN4s=RWBX0p$wPHzyQ?ee4@*x#6s1ZK=Y3$E07>vAD6CeP|P0Ziv7
zpaO@jO5`#C5|RG(3nX%p{KG7}=V`qV-8^ZDGzF-y5)(^pq5Kruy34tJ_|t^+w`Z(v
zy(t5uS1|?Ig;(1`*9wldg&t=|$BTf0bSs6l<d}ttI0BLEPGc|G#$J{(fh!Ic)E|yB
zdoVU=9Lo2Ww5m9!>ud3bVhk|46CKz1vKd63&RQYy8>nDkAr5^sx2-La2XK6eO_|a&
z1a0@qjS$AUF9ufFyb@>p<)2dI42_^F142n=x!jRjyJ9K>UeXi+j6C<*{+2=@hvj1_
zx{nDf@EHTKpD$F2l~sW`zTZ}4A!w_+s{GAiz<~LgwmYE4GE`dwm^Jv$yG6UUoj@uM
zZb{bH`Onl@Ud)Ln%1h~W5+LLi)VjmAV3P&ZpHZLKu=-uuNPhqx5mp1=_D2B_PjMZ@
zd75<3+XH#fVQM$!ly2`~#yBx)Vn_6*)qps-<2UPQlkbG`<;oQb!{(Klfb>Y*yNkKG
zVNI}GS4;usniYQ$XMo@jR7}grNz-de^8$(b_3HN78<jJ^OZ`{2Ab3XoH__zK)XXNY
zlK~Lw9v^m2`NZibX;eGg$x03NY^8>0GtK;>i|ppUTy+@pj-=SIcR%ja@1ngp)#RUT
z^|Gcpr_5KGBdPJ-77ekObhW7VDDVDvu)d-f8TTmbOS99BZJUdY5{gC^0UlY?xX<B?
zX4}4!Gghw3RZzf94c)p2<SBFjbdK&Vn|E3CUPr|yN1u!B{yqA$4ZLqSAcz>XSo*i}
zMJex}8M_mEue;`yvFDL5J4yu|{T;sEIv*~z15mAvg9T@Jg-<hXBk9%b2-)2rQchXo
zSyP2Lw`@fGGNNl%${j_23`n`{f&nQv-6PN8aTI<34D>ch7~`&7LFOzxhT+&fTT>0b
zP(B%4I_Wz&eT-QlFs8A~+t#&VVzXJyUuEPy=^UQw);#^9dVEN>BVnSenz&r-5gVXd
z^A0?#XG&o+%XN;}{(;9XEjAq<7#Ls;Aa<)BTaazY2kZt27ckhu$>2M)u$d=@$`;i^
zf?Qy)bm^Qw6w}WjF|3K=)8V|JeZPz#{AmQl@X>uj`6H_Jm-_Koi%Wm_kafnyu6rzN
zTOS@mOs^Tr(etzOqqVN#&nYY1Okh)`a8k8amVfBY8Hqz{!9&;{MjcQZB1}FpM7ud)
zXQIdSofy&J&^C6x(L9wttJahTOGn_HHL-XscQud150c!FK9T^%c+M8aVT2)&_i<oa
zW*0KtY=6=TnhZ8aUpyPoxcbJI(tud<r8FR|_<L!9`w?CjJ~YfMty#r(uNjOqC~udL
zQjXxb9x&Ja!R)Pbo(XotU|nezY1TS-;ua`ZcB>O0(7xDKWG_22Fw-mGD!-Sxew3zf
zZG6>`N|U6K`od|`s{2+SfL`~O^>cWoFLCa((|v>fp^Q}TZ@!=LPgNv_^^7Je1e@m!
zGv|s(b#;9b0N^*j_Mx(6ANuIJR!dtw0nq~k`BIa>M=5-NbW|+mj<j<?db*Hcz%Qs1
zc^48=En*6oZk<A`IyV_?|D<Jz>ukiR9!@RNd2pyBl5?)4Exx0aMSKSviSd5Wx0HS4
zdc*u6yQ!R~QFQxA{9mX^p=~8ieRqiRK&WJ#wgb+`tOWWb<Zl@qcg<a*YVBK+W9;K7
z{0%7`!VCJl7@d`It`pES--CYUSfH=zy5meA`C6GZ1awNeRcjln!IXJ3)<Jux>SbE1
z3saC*lIH5@98y9eIX40s8PS}f9y3|Dn7tfB2X#M>**=S(Z+CLS-gV>B#=V=mWl#_J
zea+Q}j8Y>y7zv9kmDUAlvYz^Ox=m=KLt~OLF>OLCC5!JvRlSsPbgel$(TOzSDYS2x
zyff*n?j;=8hq09vc!2L=Ni#K$s$&6uB~;SJ&`7LZhF)#G7GOh2W4}wgw0Xg|UlWnT
z7Y$}T*}c9P(H7lVtqhFX)0<j^*3E4axg~60x-^U=v?j{8sUyQyzS^hvYka-klYx%e
zgn_#icoTla0R+!%9th9Bh~hV)En1z!z|H%^z{wGZ@w|c}Rq7p;yXS7-qTyXVlL6aD
z@{$#!{!k<<3zs{gI#7)2DFmNXGz-lppsP;G=B)}b{R(bY4Dz+`o^{}GnY<d_iRM5f
z3(f>qE#y>qVFyKeRM|^AH*%@2)yan##?k^*XijX`aG42xY9X2($69H`=_srA!!ECS
z<kH&6$5oLmv45zO<SP^bR`|w2oS)t`ZVT8;djm+J*$SuDiUBF0EBQ4O9Dz-c&h@_9
zB+(lOgl1Qgf^3=$dmi9$OYbl;8GMp48*_A_Z9q7ia}<59hnhg}fo&SJb)ADHR{hRN
z_c?^}Qa6kz34WLjx4F8F{KCbVvI<kc_K2+NFAN7{4ObKw$SB93$)n%*nkX0OL3
z*q(Rlipj+-8#CR*_&8QLZLnORS3bHYj?z5{>pEGe@b8KN;w+?V+Erhx<VM)%c?dJG
zwnP$Z02JB@Qw_cA^2^R`Lm$I`>D(ms2%eK2^#zY4g;WCa&g4}-TKbHk7cOA<GiuIw
z_zo_x*IcKPB#P?3_pS`skg;zBGJO$eLzlhon)(l#8CElhxq`*)l#tmNLVb`<=`2H?
zBTJr1<0E6h%83l98Wy*N2ewf73-$|9KNVsc`qYa6p$a256MGJjKwRolFZ!z0Rp@=e
z(Is@4JL;?NA<abOyf<$8kDQ=T{~6}O`zsXy3IsUU9T?YOWh7dkgX1VVXwYjIAc4NI
z0x*s5d`Hor=LkY0<(}cP3HCF?*5H@@g~-*HnOpe|@lp&jPqJJc8hH$6YJaDQaE<>_
zYolJLVsxcwf-*IU_1dzxv+d9VN8XEHOwz9Cdgc`>UQg>mb*>x+Z0h%jV(idRhTd2q
zg8#Z;rhlaBqS`#yN8y5Vpkm86eFor9L5Fr;<>|B&kbW&=!F{Y}8v%{F=sjm#rBGm$
z_p}3`x0D4lf~%81nvtY0KSLCF%?P2mFF>WpRQ}E@xQo2dc0qdxd2YWmTi$9msXXBO
zCi|4I=&A+j0(+R59nGW%gkp<k3eK7&_*$wjZx;WkuZxuwOzEZT4xv60!nN*ztDong
z-7(}Apu)9?3rgNh<=647)t9m{-(nx*CNHWwa0K;a&`1uM_g0$UTuoJ`Q)QT-e%0y6
z%qVe24C`mfeDxVYpAQl^4n^UH^4p@!BfKyCR_K+<kIyR)eKDNt277~hSN(7hoEK&O
zf-@9lZbiI1S8MvSE}yURB8RT~J;t2C_mm9QQXgq)H@cu!&OX5~Lu?R`sNjfPSU!{H
zuBsfD;{Ul48!;NY?!uHD1_5qL>84n~NZ^w+nnFao&SomK^ad@_B&zRUNcw{?Oa4CM
zujbyaFz45tfgND>@(?{MvC65`GK|p)z+f{9d5$Nk3Jb+T`R8`niW!J^f85EjFVYiH
zxX=y|oeac1-vZI@o_-uDtZH9!*e=|Gdqn*MS=LX2=Z=|@Qdx16XBW5}qdtveB!?k)
zodn;8SJsh~+Z)E}_o08V&$`HsOg8CTJ&|b23(y(;R`3g~ae8YOzI@u@XH5Gi_$?E0
z!puNYdquZPpxX5FJhk2_Fax#$<S+8Z`(vrLupW!po-H{w{S_?-M<DN(8+p@G>cMe%
zLKJ)|2dj`4wz%}2u0t1O#Bfk!@Cd%1+)=iMnQZ+$gCx80?-ezbe7<8i$yeFZKfD$w
z_+|;C6gFW+9I>n9Ahkyp>=mApp{k%Y@25*82Hp<n{CM73)l*>PTlBdrYD#f2w;xl#
zg5ewYX~_vMnjh+^_V_KIl2jWCGwc-GAlJ2s`$X%>-$$aXHMh+;UB(Q%BhCC3sm`2p
zK1wt1ZZa?qKyNLhEOIYotmWH4Ie8i@%Zc3t`~lQObl@}Pdt`H;XZ{E>Hx15P4n)db
zz7JlmEV#!RQ3rdE6Z~LH)uta~S94y0zb0Z0&%~Di)}lMo_(XOK^4yEB8uXuddPSJ5
z7hq@V)2MNO$OZY;lHA`?t-DU&kv_OT5%R1kf350DB8b=|T&KF?IWBtu<yp`4t;N9i
zQEAhG_|8gJF;<5e5N=JPHkbRBC=XIj!K@z?cWNA3;U!cX)xrd-QRZZ<DCP*&Dph!U
zoYx9#ehpSH(VTsyV_t^oDT`(z=5jJ9QxThi)H0Z1yV1E(R-+3(hBatOKpy0zEwW(e
z0Be&Kwh(L1&N)u=QvC{WuT3>+%`yFhGu9_AF&>;QVCO7vWc?oH-p{lDMW}&(wb$m}
zMha!qXbPp}3_(qOf<g#2BjS-LcYbczNL{te2({V4Q--l&-3}MpPO}Q5+~-J&IBJ#J
zQHJrFP7WLWurbL%a;2_Af2`sW+^C1XwRd0nK9{`?7C_R!fdQ{E(FI&f<0MPYhbhEt
zVbhqS+)Xps6{FMULADw@(^usTnv4O<A<{`@a;ckeL3Rto+I)pY3z^fCOS@?9SP_e9
zsgd4bLP8Ra5>mSI{>0Gf?7WsSOQ6i8OlYf48wA!q)q0Z!s=xOt{2s9-M?tbz)Y{32
z5An+W>%@!dzsCbiyONf8oE)XKdy&KU=vO`lJum{aCD)rF)|?O;5PtxCRSSd#?5`Vb
zKlKSqhc;UC<g0N}yAq2$GZtg$a8Ymq48i4v_5>xv?<%W*0PyAvZYGD|9o3J3nCn($
zCoO9;@7iKEQvJikrDuiCp8U}kpNx>1{hPb27fOor-T8Ol1-;N084V_lxyNqw4mxiq
z7B?%3V)cEGK~Dx9G=~suJg4{NN&{Y$b#0idXS+67LM>_<y-p(dOU_-)SuM}1pszP4
zo}rs+u4-HN2jpp&4PSW}cMJ?7Pu>6vl|z#+jZIOSWWWfBW>ODJjDe5(Fu1ITJe!dS
z+{AS&2P&Gj0PXzKX;XCKl>1mHR$(0qllSOc)x;|*W~Vt+mvj-}uO=PF;Vg-7MAGY^
zW^2#c_EM_MUj;@8EDqbcPM#v)>Vy~S-h4;Z8Q8mETRgDJ#yAf32MIYA2ZX52$ps~&
zojb>GOMSi{bd-!{>y#VJ;PPf0lQv<Dl{;lbt@2%6m=9#RR2?vz(R2lpY3>v8)-&&M
zi<1>E_gKul&u@O+BRRng)!e3m)$FWqVZX|s)`C)QfDfUwwqcfH$~rNxreF!W?P?dk
z#zpwjt>VhndZTZ3j+`(8G=s1uCJe9rICH8$pW{hA-Jg$dNLDs0*9&E15mlaI18v}W
z`)%qI1MtMUjvd&DF)z&Y#DnemF7DVhHS~uuK4f>^MvqDV9CI+M&4*X5A~7++1x103
zDy^59?py{o8~>g-IQCFC{ZXRQV^-Z;DSGA9wSWERVS6BeJ&DlM`#=u};dmGM2&}(1
zI7ffyP|^ZPuH#B+Kw)&xe&VJ<U$LE&ya;o^f?9&woD(HHG`p)$E?GKfnp&~|P3L?j
zFUXv?KF&B0jCn<drX++Q<QYr<TpNCZSAW$fm67bh8$HD1uQ%Y;x4+qET^X8VnDt6l
z;sJ1GCqJpWzjHfAA<0S}&PSh(phHwzisUmloxV%qNA{GFO@WKOWEXI;gN>T<Ja|7m
z0TLq+!T`X;h6L|)^-Tv4#2A^4+UK<i{XB)`iEKjoR0D;er@l5H=tBPhNGfri_IaOe
zp3ho+RLFF8X6{W<5TNx_e{?4kXwj?1o1f3N8syY&n14|m5EtV2d4oV>S)y8HLEcU6
z(&9+U4RAixEoPJG{t3EWIQ@dX;4LR3y2tWX5NQJLf#CVt?h7Tr9wGHYy0iulV55m&
zG|3gz`ck)sI`N0z)f7V+rjr&^lDZ}dODf{7m0>DI*aUwT5vp0M{T_gEPyziiQ8Z<>
z26K~dj9UPb2~|wrYThD#PDY$V_`DI#?W#lVY(1aibcmaOd%wx`v*{>q6!4m7bVs3R
z>0G5LYuku(pX0D{W5AwdtzRLX+b_>q;nL5&o%&LdH0VH=i$Qs46Fpwd)+WTJDI+l`
zC6{)P;+3i%{tfa?sjLpi)NDY=oQGJ{cj4@andx{XT#*7?EdLg%bs783^yOiYfN>6p
z)Y9JllS(4W9tjv9r=0kHDDc@=-sY2ttW7c!AY(l%gup+-$1)Xj;VB8q)g{pv(D)D;
zX`SZA!0=&}bPNPR)_x=LDG<38^@;<CCckWyViwdr^WBM>MR0OUCJnE`(1pq+_0^8E
zwgv<K%Fdl#EwP%r)TA!sd7w7{4JulcIQ5skDpJp4mf_f@7iFUp*q@jKI5-*c4VI>t
zp}q7*IJTS|C`exHePAMnI}4na^crrc;e0CHtffbq;xE`{!^*K0Y^^SqWw@;7u0ZFd
zI_aqTUg6#8?oP_<^#mUF&weQ_W$>0$1}j#<Xo-&TMmVi|^N8tXJ0iU!GwNzVK$0o1
zlb#vFw_EgzW;;lcY!EWN!-7pHOiV`GuZiHC6k&#^qObDUFsx_<C+IC#eGi~=3TP7$
z<p<%ASdZNtX1MlwLSptSDWY&P`6h<ehrW-(f6u+tiN4>Z$y7tqbI;^zvZ$BxBw&u|
zD}1*SsIyS>j{Xw_+7##rB=iI%5tEE`DB*{(mB|r%>k*kFpE!f0<NGQ5tWW!DD&!ZX
zWXRK~^9O>B(<J&I@V9NF(HrHCK%yn3O**ClE4eF~sLQ#T^v7ni5nrb#l;uxjIw(cc
z-hJ$_i4#WNs|%T3GEp_OCE9NQG-f-)HUYM@7TI%8!LP5>hXmI<*&_1qB?1dEdfrXC
zTq84y{;-*<ax`kUGu-BuXy7v&5R{D{w3$l?3S_we_QwxO1xaH%3q3xRLe2+m`_mQr
zrEipDm@(CCWty-kG*<Jm*9pL<D+et<^8bqXA|jIcYLqZd2*K?e>G@%mvWFNdvyL|#
z9<eXyWJz4oHEfiXe>oF(N7-|BADeHc4)>uXEA624OAWPy*@pvwZUbAu_^CgxaYdhc
zgy#YT4dEGQc0xZa!q<a%yoimafFl2?WP<^?gm=e+;;2|(c^PxDa54!tU(ZBDXNePP
zU~eT&-?6$?17Qqe6pR!GCP#e8kAgYKSGItDRAFKPd~h-;3CI|QEuQ6F;$RMaexn$<
zKl(zfdm-VuUkPP53Ox{c7x+ys6pnZ&%lZ@Z4O`8%4}3(qUK@pn;}|Oj{C!WASbt2a
zr#y+YtGMiYub%M_9kS+XFyw*6OJo2ICS3+L@of;vy5DfKH}Zx!1kE;^({3YKT`B<r
z1UjAgakoIIAQj+-C<(s`sNatjVir;>gwuLjF`XB$5xd)ccA~V#s7GktBzRl#k5%4f
z>bHOdkuwo3z{50sYkU!7J$dY6)_hGJSW_vkF8<NlO6^=H*hs{sR0f*@hiNq#6naAQ
z_#%&VN0pgGT!g_Q=cNUSU~~43dR50IcM=Rz%^wNSX!m@_B%C5GNmf2cJc9PL<#%*0
zve$ORci1N*^c^WUjtB-*4+;B{5y@Lyy!zh^7*^wzqriB@08)$BId*+}of#N1JnB0k
zIncJUb6IlqMb_n{JJCV0inrcYy*bZV8;V&aL)#`DO`zUkV6of*zTZ=3nslxW>|FN@
zRv9X#-9aDR%q7I2dB20e;YY@%z;|n;9l%M?Hug}pB_rG1$?FNKZ{OfP)SjL&U*EIR
zUwU^cwg6NQy%vcI;{>Cn3l&8o-?9c)4O~2t78imbq`{0qKamarTTkQu$wZW?$}!g4
zC`N+1o4{#@PrS9SH13u?J7QE3#aX|f${m6i(uLb*@4O0Q2x0T|gVYzqK{Z_trN*P`
z?G5U<JQ=hQ)q<qeB7Hyn46Y4o3}~Uba{%>3?mZKl(pW#SUU{g5@>v3D(rn`WC3d5L
zH>F}emA!ESDovbg5vV`16B(>)tN5Xp;00ug%@vysNc4j6lnP(!<<4|)jr3Ogqdr@z
z5htX3hiYYK^F4G~e_B1|&kRQS$fLd(vL<biA{bCuP4=01OqNu`<I2ws<R<|ocTi(l
zv1+VU1AU74V88(F(9Av<ce(6>?c2=~?S_36y@f-jG1r#3WX1`93&1D~5(Tzm?`zAk
zPsKZcbfF&1FBsEmgurlkZ7|il&q_U>WQ+M&o;Qhw+YhG~Ot$oAZ5X#Dj$+!DgBvu@
z==ZbpqNt;E;V5b(lY!cwmvN8$orA}uVZtm|MfUwvO$8=7;VQ_$epHWsySZ=0=O3y-
zhS;{5JJEj?ep5fAcT|z{WI5JUW1zWyU$w{*X?Co6dnIg@>g1^sZ~&{6aU06sXol&q
zb971IY|^UMD^6JE2dYj?oPH1$=!ETeX_fy}jXyZ7-?Olm-;GI37xr1qfZVvrn!3%+
z5YOnPA7`%1ca_3;e;Mw6rSX_KKNj<a$16Znu%$iVz9T-Wc*=5BMC#O9fp7|GsrHG`
z`1rx=_{IaZY|j9=sk$CH@Ns&*OERsBex&_NLT$E@XG}v(aL)Pp9NJ723FBXscD1_A
z)6B1W&H0?g*b|a~R>xzLBt9}7V+nID$8}z9gYG4w4@0{RI|gEhc(E(JW<Esszk+z6
zZcaBT?2Ne;Q|=r`)aSUeiS4eT1=)_u0rel)SH_`hQ<>;DZXB5W_6vN@m6x+|-W&Mn
zH{Be2SJk;>?cerO&ImRt^V5o`kx{hO;GUuE%`IWSt%JGB`U*)Bg3%@-6MO?x?jh^@
zY_h(!LY&lezoTLtW5lO?57bRJ0o%aJZ{xO4T=>C$+l*c6S^BlK^Z0;3d@vhbRj)1b
z*QM*oZ$a4e7-pwx%2KzdjbSfAgzCGH1s~5tglFM#*Jr-LeCy|&`i#7uBdEV9GfR%}
zxdiMzCPfiGrkLcYk^6kj;XaoX6p^YnB!blw*r0K22!twmMU7%$TZ}V>XLTE}uQnA<
zr~58@=(f}v%P0VuLtR7D&3|QBYIg6Du5uU3#VHby-C$BiOVxaU?QRLnQ*Yt&qL{1N
z#!~jes)oztyjL_pt5#uR8|UCUkq2BH2Ex2b!P`ceDpx0}im*}&dIGgaHB-clkZSdm
zGxd_P>?;>|LRR;#IXvYd_^58Vq(F`K7MQt|i^7h9>*IdqsvtX@>Cf0HLZsVW`=eSY
zyTN#Qa`?|37pfYNuxzp0UE#CQlur3dmFpo4qJF>)9InZt7_&?~G>cog8mKABRKr$?
z;;b+e*Y-wW=?_&CvAvE2*glzdQx~oRM(d^i3WxpW&D$Vsh^BjgHRdMuqUM9L;3yNf
zes3J-^Fu6K@CqlG`n5yd?k+SUT_WNI;$|A-QnjzY_KxJFVuXK)mjj*g&DZtWS98`+
z2f=zjKXI~sJMnA6AJ&8ODUN?kXJmu@X0y7cFQAElB799PILkU6+~758mx^CyF_Pfa
zz!}|#cqV1+qO2EcB#rG<0Ev%SZWauC`aTL`h7E)bOiFxIMMag5bDrYlr)u6Qm?Y_^
zGjXAkY>ZQPExeIhs49Rf;)FmXhhF5N*oE^R^KhH9)@Mc2O<3fRLKBa4tR^9A<{K$^
zJ8=j!mZG>+!QScxF&4=1p5)wU)jC@Ttl$^JNBm3kaNpsMvaXI;@8ULT`6)8LZ=gT;
zWGw$g72o?6=98BYXtXMueAjXB?D&9MO2ZKmS@S?Ye+kzQu`!3Z0ghZ>q%dzjStR;C
z9}vByIIcFa=DshPN&5<!28@_3Y|~wI)qVd7e-QaRS>SsWd9z5nWE#!8F&s>%>edA+
zfc6ClVOlcl5Da`6T*l`cj*$289wuGcGdXU4uB=%Qp?m9BbAo!c=T%1E`5NMjU+fy1
ztGtu7hc_g7YW|uFFQ2ZzT0XMItoQA5#p4PB;fyQ`*q`@u_V@^PrQ_QwiJ~r(GKV6z
zZl`NFE?Rf4e6$?d?=4jOU4$Jdp!4<?<Q6L>3;D)-hKp7(^N-42+?-;nthTfJD#RON
zfpPR?Q}LBhG*Pq)h^0SmweQl>P}kcLS0WUu8;X29bg}L9;9ejrinzwb12q|HmRo*R
zi^#`2d-T$${$d1<WoPQofPYpOKYa)LeLE9-X;gO_{r$4NTS>a@64=hgwy$@mt6xyy
zSErvHG0U+zbYlgN4jXvhVd(bLipDc3=$^qN9hY^Mo!UMR72Hig?FiQ8{Gt;6(Tff0
z)Y=<mgYJ(`X<;oYY@-UBFVk5Gbsc0K19+)JrLz#~Ojy4;5r^6=5s}XS{`6ml&iwN%
zntvWT^Dnb##!OiMV{I^D{g0Jt!ulV}!-VxeR*wnmzpf`W2M2BUtKaQ`of0p~!8~aO
z9hWV#QNKG5+u00~|Ch-#Uq{mX%g~vBo<$R>-1NVeVpHUQU;laX%-=`S{O8FtUq{mX
z=gBi)N7DS~$ul0n<e4ucY5slk%-4}LQ)vH2+3hVHvvd^RUHt$5_`f{||Ig;n0JCm*
z_gp@WrAl|QO0NIluFFm{$Trtud#ZTZH&DFXi1we7x4dZ^JYr_K??}9nmCvs^n}51j
RjaBOuXUwE~H!WT8e*o_E{W1Um
literal 0
HcmV?d00001
diff --git a/data/demopat.rda b/data/demopat.rda
new file mode 100644
index 0000000000000000000000000000000000000000..b2cbffb52d840a62b9b020f7be0db6c0c9ee9787
GIT binary patch
literal 1367
zcmV-d1*rNTiwFP!000001D%(9Oj}hP$4?)040U6{7_&r!{$Y$Ux-84)ADWdp7d2`Y
zHOkC1>qdFZOMBA?51rZ(7n~4fN`a9H1;(qq3beF^F=$H`v-pUAm>K;;d_+xL%ru&)
ze=u+Peh=Z+g2X15&;6bAJHOX?+{4rRi+AP~=LsQ<!lXS$llE#hYJUvEEH-Q0RAR4m
zsy2@hrUFg0kU83uze;Vh>QrjWoDQ3!30u<ktiE!Q{#h6LeF8tUpD0B8%;#(t1<U@0
zF-<e|3aw{9gr5IaP})1w48AuHe((esVE;MVZ~q;vqh3?FUhY@H3Cd$zz|bTZodIL#
z!0^XlWE70=WdDy~YKIT`9wzs&{Z+`ROTN|huqNquocRpUPtR3Z7t~>zdCct9#}{Hg
zVfqQz(T)Y|`w|Sk1a{M38~w<7%K4D8tW#i#q};0N$IJRRW!RDRmHtAvG0(@q$*YW)
z^_(6A<F7GKtP5FJ*1=G8`p$Q-5=45v8t|%Ht2qu^rQI#CGR<r>)X0}wzL;$;yG_2A
zI~BXerHtiw<I1$i<uQ4KKI|CFET?7Gpie_i$7l^W^ft)pSn;z`jy)Ny(^Kln=^tjf
zho``iZ`r@3i&vH}@yxsCMSb}UD4+5A|E<{aNnjHClVDS+*QGceWf{%6Y<A0l_Fj|m
z>4GpxeRqYU%&XX3lr5^_b!n#yq`XS6;;B%T3cD+F4IEQ!Zg+<B9IvCo<3`XrZ#gn4
zPpxW~o@!h+N7;&0yIL|IEpgRm7)={AUC;1nc2-w7;85JedaF!bwO-^Bj~0OwTpM%W
zaL$Lo1m`qX0FE61Q)b^X=NrL`w{s1g2QPF{k4I>*k847uo$d5j1rF?@{$<#UTOlXw
zAt!$Z2RqO{e+ry=mT{J#KfpXj=y$pr?EV|<Jk0Tr(C%j(ALn@XCkvS0_mF2VFs}&Z
zeCBhU`rLELB7Gb)Z-Bi`%=b4iL_5i^z<7}Dj3>1lb`n>>81)nTA%}S6Cq80ae%k9H
z0~|lbJhzh%qd)csczzMYFfBgTE%i9`Q=c&36ZH2f+6TKK_gw;`KhQ77&%Q#L>my1z
z&a+|u3hkXl|J--ff0BABaQr8>-weIxV&;32?FSiW81mQ==Jy=?!^}IEez!p$Z-hK@
zK-vcvxF3=o(3|I3m&k>j;66w^q#rl?7wa}by(s&;AcuH{CY}=fVIQ`#Uhx>~$TPp6
zXZGN3uz~%tuc==G4tqd9Imz|q=e~IJEil6M(S8l=Z3mk<uPqPKAIEnpjD!0#$n_aH
z2u|GrcJUKGdX({P<v4z#BQJuDh2WUX?@@64kUq}de6US0Uh2j8jqB$8PconPtzdw4
zoCq;K?)UKl@N5$pbujL`z<~v@;ZHF90R6F^%{<Shy=-4(J?^7E{Y39)e(dk!H!<`J
z<K4!%>cLjlqw{X?4Cnh4>o9EOc<z(P9LJ$B*7_ZwpYg?xfN{n-#d&P`g6(;<dk^E~
zm28UjYG(dX)+Kl^^WfDg_AB$a%y_oy>maXqBec`=I{n=OcJo{favcv@S-*X>8=ze`
z*v~8VY3~0P0Zu&6xTIZ<i`wb$1+dKr_VV0mWF8GoU<dY((0?;6RrX^Zr}jZNrN5Y}
zz*p1AXZ5?34XfG>S@hRyTg#p?%d-(b*~VnEwO;(|joXON_4Kmk`(OSxs*_F6ka01y
zDE2D5B5!6!dBrS}FZ<TGNm)v5SQY=eyji4%cGW6zR!c*UHLtOGl{VMQrA}9+_U|n3
ZaOsw{?r<hmRpC}F{R4T8F@h-%008>z#BBfo
literal 0
HcmV?d00001
diff --git a/inst/CITATION b/inst/CITATION
new file mode 100644
index 0000000..f644116
--- /dev/null
+++ b/inst/CITATION
@@ -0,0 +1,20 @@
+citHeader("To cite ads in publications use:")
+
+citEntry(entry = "Article",
+ title = "{ads} Package for {R}: A Fast Unbiased Implementation of the $K$-function Family for Studying Spatial Point Patterns in Irregular-Shaped Sampling Windows",
+ author = personList(as.person("Rapha{\\\"e}l P{\\'e}lissier"),
+ as.person("Fran\\c{c}ois Goreaud")),
+ journal = "Journal of Statistical Software",
+ year = "2015",
+ volume = "63",
+ number = "6",
+ pages = "1--18",
+ url = "http://www.jstatsoft.org/v63/i06/",
+
+ textVersion =
+ paste("Raphael Pelissier, Francois Goreaud (2015).",
+ "ads Package for R: A Fast Unbiased Implementation of the K-function Family for Studying Spatial Point Patterns in Irregular-Shaped Sampling Windows.",
+ "Journal of Statistical Software, 63(6), 1-18.",
+ "URL http://www.jstatsoft.org/v63/i06/.")
+)
+
diff --git a/man/Allogny.Rd b/man/Allogny.Rd
new file mode 100755
index 0000000..c6a82c9
--- /dev/null
+++ b/man/Allogny.Rd
@@ -0,0 +1,27 @@
+\name{Allogny}
+\encoding{latin1}
+\alias{Allogny}
+\docType{data}
+\title{Spatial pattern of oaks suffering from frost shake in Allogny, France.}
+\description{
+Spatial pattern of sound and splited oaks (\emph{Quercus petraea}) suffering from frost shake in a 2.35-ha plot in Allogny, France.
+}
+\usage{data(Allogny)}
+\format{
+A list with 4 components:\cr
+\code{$rect } is a vector of coordinates \eqn{(xmin,ymin,xmax,ymax)} of the origin and the opposite corner of a 125 by 188 m square plot.\cr
+\code{$trees } is a list of tree coordinates \eqn{(x,y)}.\cr
+\code{$status } is a factor with 2 levels \eqn{("splited","sound")}.\cr
+}
+\source{
+ Grandjean, G., Jabiol, B., Bruchiamacchie, M. and Roustan, F. 1990. \emph{Recherche de corrélations entre les paramètres édaphiques, et plus spécialement texture, hydromorphie et drainage interne, et la réponse individuelle des chenes sessiles et pédonculés à la gélivure.} Rapport de recherche ENITEF, Nogent sur Vernisson, France.
+}
+\references{
+Goreaud, F. & Pélissier, R. 2003. Avoiding misinterpretation of biotic interactions with the intertype \emph{K12}-function: population independence vs. random labelling hypotheses. \emph{Journal of Vegetation Science}, 14: 681-692.
+}
+\examples{
+data(Allogny)
+allo.spp <- spp(Allogny$trees, mark=Allogny$status, window=Allogny$rect)
+plot(allo.spp)
+}
+\keyword{datasets}
diff --git a/man/BPoirier.Rd b/man/BPoirier.Rd
new file mode 100755
index 0000000..d5a6622
--- /dev/null
+++ b/man/BPoirier.Rd
@@ -0,0 +1,34 @@
+\encoding{latin1}
+\name{BPoirier}
+\alias{BPoirier}
+\docType{data}
+\title{Tree spatial pattern in Beau Poirier plot, Haye forest, France}
+\description{
+Spatial pattern of 162 beeches, 72 oaks and 3 hornbeams in a 1-ha 140 yr-old temperate forest plot in Haye, France.
+}
+\usage{data(BPoirier)}
+\format{
+A list with 8 components:\cr
+\code{$rect } is a vector of coordinates \eqn{(xmin,ymin,xmax,ymax)} of the origin and the opposite corner of a 110 by 90 m rectangular plot.\cr
+\code{$tri1 } is a list of vertice coordinates \eqn{(ax,ay,bx,by,cx,cy)} of contiguous triangles covering the denser part of the plot.\cr
+\code{$tri2 } is a list of vertice coordinates \eqn{(ax,ay,bx,by,cx,cy)} of contiguous triangles covering the sparser part of the plot.\cr
+\code{$poly1 } is a list of vertice coordinates \eqn{(x,y)} of the polygon enclosing \code{BPoirier$tri1}.\cr
+\code{$poly2 } is a list of two polygons vertice coordinates \eqn{(x,y)} enclosing \code{BPoirier$tri2}.\cr
+\code{$trees } is a list of tree coordinates \eqn{(x,y)}.\cr
+\code{$species } is a factor with 3 levels \eqn{("beech","oak","hornbeam")} corresponding to species names of the trees.\cr
+\code{$dbh } is a vector of tree size (diameter at breast height in cm).
+}
+\source{
+Pardé, J. 1981. De 1882 à 1976/80 : les places d'expèrience de sylviculture du hetre en foret domainiale de Haye. \emph{Revue Forestière Française}, 33: 41-64.
+}
+
+\references{
+Goreaud, F. 2000. \emph{Apports de l'analyse de la structure spatiale en foret tempérée à l'étude et la modélisation des peuplements complexes}. Thèse de doctorat, ENGREF, Nancy, France.\cr\cr
+Pélissier, R. & Goreaud, F. 2001. A practical approach to the study of spatial structure in simple cases of heterogeneous vegetation. \emph{Journal of Vegetation Science}, 12: 99-108.
+}
+\examples{
+data(BPoirier)
+BP.spp <- spp(BPoirier$trees, mark=BPoirier$species, window=BPoirier$rect)
+plot(BP.spp)
+}
+\keyword{datasets}
diff --git a/man/Couepia.Rd b/man/Couepia.Rd
new file mode 100755
index 0000000..1657622
--- /dev/null
+++ b/man/Couepia.Rd
@@ -0,0 +1,28 @@
+\encoding{latin1}
+\name{Couepia}
+\alias{Couepia}
+\docType{data}
+\title{Spatial pattern of Couepia caryophylloides in Paracou, a canopy tree species of French Guiana.}
+\description{
+Spatial pattern of 34 mature individuals and 173 young individuals of the tree species \emph{Couepia caryophylloides} (Chrysobalanaceae) in a 25-ha forest plot in Paracou, French Guiana.
+}
+\usage{data(Couepia)}
+\format{
+A list with 4 components:\cr
+\code{$rect } is a vector of coordinates \eqn{(xmin,ymin,xmax,ymax)} of the origin and the opposite corner of a 500 by 500 m rectangular plot.\cr
+\code{$tri } is a list of vertice coordinates \eqn{(ax,ay,bx,by,cx,cy)} of contiguous triangles covering swampy parts of the plot.\cr
+\code{$trees } is a list of tree coordinates \eqn{(x,y)}.\cr
+\code{$stage } is a factor with 2 levels \eqn{("mature","young")}.\cr
+}
+\source{
+ Collinet, F. 1997. \emph{Essai de regroupement des principales espèces structurantes d'une foret dense humide d'après l'analyse de leur répartition spatiale (foret de Paracou - Guyane).} Thèse de doctorat, Université Claude Bernard, Lyon, France.
+}
+\references{
+Goreaud, F. & Pélissier, R. 2003. Avoiding misinterpretation of biotic interactions with the intertype \emph{K12}-function: population independence vs. random labelling hypotheses. \emph{Journal of Vegetation Science}, 14: 681-692.
+}
+\examples{
+data(Couepia)
+coca.spp <- spp(Couepia$trees, mark=Couepia$stage, window=Couepia$rect, triangles=Couepia$tri)
+plot(coca.spp)
+}
+\keyword{datasets}
diff --git a/man/Paracou15.Rd b/man/Paracou15.Rd
new file mode 100755
index 0000000..e3aee18
--- /dev/null
+++ b/man/Paracou15.Rd
@@ -0,0 +1,29 @@
+\encoding{latin1}
+\name{Paracou15}
+\alias{Paracou15}
+\docType{data}
+\title{Tree spatial pattern in control plot 15, Paracou experimental station, French Guiana}
+\description{
+Spatial pattern of 4128 trees of 332 diffrent species in a 250 m X 250 m control plot in Paracou experimental station, French Guiana.
+}
+\usage{data(Paracou15)}
+\format{
+A list with 5 components:\cr
+\code{$rect } is a vector of coordinates \eqn{(xmin,ymin,xmax,ymax)} of the origin and the opposite corner of a 250 by 250 m rectangular plot.\cr
+\code{$trees } is a list of tree coordinates \eqn{(x,y)}.\cr
+\code{$species } is a factor with 332 levels corresponding to species names of the trees.\cr
+\code{$spdist } is an object of class \code{"dist"} giving between-species distances based on functional traits (see Paine et al. 2011).\cr
+}
+\source{
+Gourlet-Fleury, S., Ferry, B., Molino, J.-F., Petronelli, P. & Schmitt, L. 2004. \emph{Exeprimental plots: key features.} Pp. 3-60 In Gourlet-Fleury, S., Guehl, J.-M. & Laroussinie, O. (Eds.), Ecology and Managament of a Neotropical rainforest - Lessons drawn from Paracou, a long-term experimental research site in French Guiana. Elsevier SAS, France.
+}
+
+\references{
+Paine, C. E. T., Baraloto, C., Chave, J. & Hérault, B. 2011. Functional traits of individual trees reveal ecological constraints on community assembly in tropical rain forests. \emph{Oikos}, 120: 720-727.\cr\cr
+}
+\examples{
+data(Paracou15)
+P15.spp <- spp(Paracou15$trees, mark = Paracou15$species, window = Paracou15$rect)
+plot(P15.spp, chars = rep("o", 332), cols = rainbow(332), legend = FALSE, maxsize = 0.5)
+}
+\keyword{dataset}
diff --git a/man/area.swin.Rd b/man/area.swin.Rd
new file mode 100755
index 0000000..d6042f2
--- /dev/null
+++ b/man/area.swin.Rd
@@ -0,0 +1,45 @@
+\encoding{latin1}
+\name{area.swin}
+\alias{area.swin}
+\title{Area of a sampling window}
+\description{
+ Function \code{area.swin} computes the area of a sampling window.
+}
+\usage{
+area.swin(w)
+}
+\arguments{
+ \item{w}{an object of class \code{"swin"} defining the sampling window.}
+}
+\details{
+For \code{"simple"} sampling windows, returns simply the area of the rectangle or circle delineating the study region.\cr
+For \code{"complex"} sampling windows, returns the area of the initial rectangle or circle, minus the total area of the
+triangles to remove (see \code{\link{swin}}).
+}
+\value{
+The area of the sampling window.
+}
+\author{
+ \email{Raphael.Pelissier@ird.fr}
+}
+\seealso{
+ \code{\link{swin}}.
+}
+\examples{
+ #rectangle of size [0,110] x [0,90]
+ wr<-swin(c(0,0,110,90))
+ area.swin(wr)
+
+ #circle with radius 50 centred on (55,45)
+ wc<-swin(c(55,45,50))
+ area.swin(wc)
+
+ # polygon (diamond shape)
+ t1 <- c(0,0,55,0,0,45)
+ t2 <- c(55,0,110,0,110,45)
+ t3 <- c(0,45,0,90,55,90)
+ t4 <- c(55,90,110,90,110,45)
+ wp <- swin(wr, rbind(t1,t2,t3,t4))
+ area.swin(wp)
+}
+\keyword{spatial}
diff --git a/man/demopat.Rd b/man/demopat.Rd
new file mode 100755
index 0000000..f6cb081
--- /dev/null
+++ b/man/demopat.Rd
@@ -0,0 +1,22 @@
+\name{demopat}
+\encoding{latin1}
+\alias{demopat}
+\docType{data}
+\title{Artificial Data Point Pattern from \code{spatstat} package.}
+\description{
+This is an artificial dataset, for use in testing and demonstrating compatibility between \code{spatstat} and \code{ads} objects. It is a multitype point pattern in an irregular polygonal window.
+ There are two types of points. The window contains a polygonal hole.
+}
+\usage{data(demopat)}
+\format{
+An object of class "ppp" representing a \code{spatstat} point pattern.
+}
+\source{
+ data(demopat) in \code{spatstat}
+}
+\examples{
+ data(demopat)
+ demo.spp<-ppp2spp(demopat)
+ plot(demo.spp)
+}
+\keyword{datasets}
diff --git a/man/dval.Rd b/man/dval.Rd
new file mode 100755
index 0000000..89e6050
--- /dev/null
+++ b/man/dval.Rd
@@ -0,0 +1,72 @@
+\encoding{latin1}
+\name{dval}
+\alias{dval}
+\alias{print.dval}
+\alias{summary.dval}
+\alias{print.summary.dval}
+\title{Multiscale local density of a spatial point pattern}
+\description{
+ Computes local density estimates of a spatial point pattern, i.e. the number of points per unit area,
+ within sample circles of regularly increasing radii \eqn{r}, centred at the nodes of
+ a grid covering a simple (rectangular or circular) or complex sampling window (see Details).
+}
+\usage{
+dval(p, upto, by, nx, ny)
+}
+\arguments{
+ \item{p }{a \code{"spp"} object defining a spatial point pattern in a given sampling window (see \code{\link{spp}}).}
+ \item{upto }{maximum radius of the sample circles (see Details).}
+ \item{by }{interval length between successive sample circles radii (see Details).}
+ \item{nx,ny }{number of sample circles regularly spaced out in \eqn{x} and \eqn{y} directions.}
+ }
+\details{
+ The local density is estimated for a regular sequence of sample circles radii given by \code{seq(by,upto,by)} (see \code{\link{seq}}).
+ The sample circles are centred at the nodes of a regular grid with size \eqn{nx} by \eqn{ny}. Ripley's edge effect correction is applied when
+ the sample circles overlap boundary of the sampling window (see Ripley (1977) or Goreaud & Pélissier (1999) for an extension to circular and complex
+ sampling windows). Due to edge effect correction, \code{upto}, the maximum radius of the sample circles, is half the longer side for a rectangle sampling
+ window (i.e. \eqn{0.5*max((xmax-xmin),(ymax-ymin))}) and the radius \eqn{r0} for a circular sampling window (see \code{\link{swin}}).
+}
+\value{
+ A list of class \code{c("vads","dval")} with essentially the following components:
+ \item{r }{a vector of regularly spaced out distances (\code{seq(by,upto,by)}).}
+ \item{xy }{a data frame of \eqn{(nx*ny)} observations giving \eqn{(x,y)} coordinates of the centers of the sample circles (the grid nodes).}
+ \item{cval }{a matrix of size \eqn{(nx*ny,length(r))} giving the estimated number of points of the pattern per sample circle with radius \eqn{r}.}
+ \item{dval }{a matrix of size \eqn{(nx*ny,length(r))} giving the estimated number of points of the pattern per unit area per sample circle with radius \eqn{r}.}
+ }
+\references{
+ Goreaud, F. and Pélissier, R. 1999. On explicit formula of edge effect correction for Ripley's \emph{K}-function. \emph{Journal of Vegetation Science}, 10:433-438.\cr\cr
+ Pélissier, R. and Goreaud, F. 2001. A practical approach to the study of spatial structure in simple cases of heterogeneous vegetation. \emph{Journal of Vegetation Science}, 12:99-108.\cr\cr
+ Ripley, B.D. 1977. Modelling spatial patterns. \emph{Journal of the Royal Statistical Society B}, 39:172-212.
+}
+\author{\email{Raphael.Pelissier@ird.fr}}
+\note{
+ There are printing, summary and plotting methods for \code{"vads"} objects.
+}
+ \section{Warning }{
+ In its current version, function \code{dval} ignores the marks of multivariate and marked point patterns (they are all considered to be univariate patterns).
+}
+\seealso{
+ \code{\link{plot.vads}},
+ \code{\link{spp}}.}
+\examples{
+ data(BPoirier)
+ BP <- BPoirier
+ # spatial point pattern in a rectangle sampling window of size [0,110] x [0,90]
+ swr <- spp(BP$trees, win=BP$rect)
+ dswr <- dval(swr,25,1,11,9)
+ summary(dswr)
+ plot(dswr)
+
+ # spatial point pattern in a circle with radius 50 centred on (55,45)
+ swc <- spp(BP$trees, win=c(55,45,45))
+ dswc <- dval(swc,25,1,9,9)
+ summary(dswc)
+ plot(dswc)
+
+ # spatial point pattern in a complex sampling window
+ swrt <- spp(BP$trees, win=BP$rect, tri=BP$tri1)
+ dswrt <- dval(swrt,25,1,11,9)
+ summary(dswrt)
+ plot(dswrt)
+}
+\keyword{spatial}
\ No newline at end of file
diff --git a/man/inside.swin.Rd b/man/inside.swin.Rd
new file mode 100755
index 0000000..d4fed90
--- /dev/null
+++ b/man/inside.swin.Rd
@@ -0,0 +1,42 @@
+\encoding{latin1}
+\name{inside.swin}
+\alias{inside.swin}
+\title{Test wether points are inside a sampling window}
+\description{
+ Function \code{inside.swin} tests whether points lie inside or outside a given sampling window.
+}
+\usage{
+inside.swin(x, y, w, bdry=TRUE)
+}
+\arguments{
+ \item{x}{a vector of \code{x} coordinates of points.}
+ \item{y}{a vector of \code{y} coordinates of points.}
+ \item{w}{an object of class \code{"swin"} (see \code{\link{swin}}) defining the sampling window.}
+ \item{bdry}{by default \code{bdry = TRUE}. If \code{FALSE}, points located
+ on the boundary of the sampling window are considered to be outside.}
+}
+\value{
+ A logical vector whose \code{ith} entry is \code{TRUE} if the corresponding point \eqn{(x[i],y[i])} is inside w, \code{FALSE} otherwise.
+}
+\note{
+ For \code{"complex"} sampling windows, points inside the triangles to remove or on their boundary, are considered outside.
+}
+\author{
+ \email{Raphael.Pelissier@ird.fr}
+}
+\seealso{
+ \code{\link{swin}}.
+}
+\examples{
+ data(BPoirier)
+ BP <- BPoirier
+ wr <- swin(BP$rect)
+ sum(inside.swin(BP$trees$x, BP$trees$y, wr))
+
+ wc <- swin(c(55,45,45))
+ sum(inside.swin(BP$trees$x, BP$trees$y, wc))
+
+ wrt <- swin(BP$rect, triangles=BP$tri1)
+ sum(inside.swin(BP$trees$x, BP$trees$y,wrt))
+}
+\keyword{spatial}
\ No newline at end of file
diff --git a/man/internal.Rd b/man/internal.Rd
new file mode 100755
index 0000000..6920a3f
--- /dev/null
+++ b/man/internal.Rd
@@ -0,0 +1,67 @@
+\encoding{latin1}
+\name{ads-internal}
+\alias{adjust.marks.size}
+\alias{area.poly}
+\alias{convert}
+\alias{convert2}
+\alias{in.circle}
+\alias{in.poly}
+\alias{in.rectangle}
+\alias{in.triangle}
+\alias{is.poly}
+\alias{overlap.poly}
+\alias{overlap.trapez}
+\alias{overlapping.polygons}
+\alias{print.fads}
+\alias{print.fads.k12fun}
+\alias{print.fads.kfun}
+\alias{print.fads.kp.fun}
+\alias{print.fads.kpqfun}
+\alias{print.fads.kmfun}
+\alias{print.fads.ksfun}
+\alias{print.fads.krfun}
+\alias{print.vads}
+\alias{print.vads.dval}
+\alias{print.vads.k12val}
+\alias{print.vads.kval}
+\alias{read.tri}
+\alias{sortmat}
+\alias{summary.vads}
+\alias{summary.vads.dval}
+\alias{summary.vads.k12val}
+\alias{summary.vads.kval}
+\alias{testIC}
+\alias{testInteger}
+\alias{transpose}
+\alias{subsetdist}
+\title{Internal ads functions}
+\description{
+ Internal \code{ads} functions.
+}
+\usage{
+adjust.marks.size(marks,window,maxsize=NULL)
+area.poly(xp, yp)
+convert(x)
+convert2(x)
+in.circle(x, y, x0, y0, r0, bdry=TRUE)
+in.poly(x, y, poly, bdry=TRUE)
+in.rectangle(x, y, xmin, ymin, xmax, ymax, bdry=TRUE)
+in.triangle(x, y, ax, ay, bx, by, cx, cy, bdry=TRUE)
+is.poly(p)
+overlap.poly(P, Q)
+overlap.trapez(xa, ya, xb, yb, verb=FALSE)
+overlapping.polygons(listpoly)
+\method{print}{fads}(x,\dots)
+\method{print}{vads}(x,\dots)
+read.tri(X)
+\method{summary}{vads}(object,\dots)
+sortmat(dis,ind)
+subsetdist(dis,sub)
+testIC(nbSimu, lev)
+testInteger(i)
+transpose(x, y)
+}
+\details{
+ These are usually not to be called by the user.
+}
+\keyword{internal}
\ No newline at end of file
diff --git a/man/k12fun.Rd b/man/k12fun.Rd
new file mode 100755
index 0000000..9b90394
--- /dev/null
+++ b/man/k12fun.Rd
@@ -0,0 +1,126 @@
+\encoding{latin1}
+\name{k12fun}
+\alias{k12fun}
+\title{Multiscale second-order neigbourhood analysis of a bivariate spatial point pattern}
+\description{
+ Computes estimates of the intertype \emph{K12}-function and associated neigbourhood functions from a bivariate spatial point pattern
+ in a simple (rectangular or circular) or complex sampling window. Computes optionally local confidence limits of the functions
+ under the null hypotheses of population independence or random labelling (see Details).
+}
+\usage{
+k12fun(p, upto, by, nsim=0, H0=c("pitor","pimim","rl"), prec=0.01, nsimax=3000, conv=50,
+ rep=10, alpha=0.01, marks)
+}
+\arguments{
+ \item{p}{a \code{"spp"} object defining a multivariate spatial point pattern in a given sampling window (see \code{\link{spp}}).}
+ \item{upto}{maximum radius of the sample circles (see Details).}
+ \item{by}{interval length between successive sample circles radii (see Details).}
+ \item{nsim}{number of Monte Carlo simulations to estimate local confidence limits of the selected null hypothesis (see Details).
+ By default \code{nsim=0}, so that no confidence limits are computed.}
+ \item{H0}{one of \code{c("pitor","pimim","rl")} to select either the null hypothesis of population independence using toroidal shift (\code{H0="pitor"}) or mimetic point process (\code{H0="pimim"}), or of random labelling (\code{H0="rl"}) (see Details).
+ By default, the null hypothesis is population independence using toroidal shift.}
+ \item{prec}{if \code{nsim>0} and \code{H0="pitor"} or \code{H0="pimim"}, precision of the random vector or point coordinates generated during simulations. By default \code{prec=0.01}.}
+ \item{nsimax}{if \code{nsim>0} and \code{H0="pimim"}, maximum number of simulations allowed (see \code{\link{mimetic}}. By default \code{nsimax=3000}.}
+ \item{conv}{if \code{nsim>0} and \code{H0="pimim"}, convergence criterion (see \code{\link{mimetic}}. By default \code{conv=50}.}
+ \item{rep}{if \code{nsim>0} and \code{H0="pimim"}, controls for convergence failure of the mimetic point process (see details). By default \code{rep=10} so that the function aborts after 10 consecutive failures in mimetic point process convergence.}
+ \item{alpha}{if \code{nsim>0}, significant level of the confidence limits. By default \eqn{\alpha=0.01}.}
+ \item{marks}{by default c(1,2), otherwise a vector of two numbers or character strings identifying the types (the \code{p$marks} levels)
+ of points of type 1 and 2, respectively.}
+}
+\details{
+ Function \code{k12fun} computes the intertype \eqn{K12(r)} function of second-order neigbourhood analysis and the associated functions \eqn{g12(r)},
+ \eqn{n12(r)} and \eqn{L12(r)}.\cr\cr
+ For a homogeneous isotropic bivariate point process of intensities \eqn{\lambda1} and \eqn{\lambda2},
+ the second-order property could be characterized by a function \eqn{K12(r)} (Lotwick & Silverman 1982), so that the expected
+ number of neighbours of type 2 within a distance \eqn{r} of an arbitrary point of type 1 is:
+ \eqn{N12(r) = \lambda2*K12(r)}.\cr\cr
+ \eqn{K12(r)} is an intensity standardization of \eqn{N12(r)}: \eqn{K12(r) = N12(r)/\lambda2}.\cr\cr
+ \eqn{n12(r)} is an area standardization of of \eqn{N12(r)}: \eqn{n12(r) = N12(r)/(\pi*r^2)}, where \eqn{\pi*r^2} is the area of the disc of radius \eqn{r}.\cr\cr
+ \eqn{L12(r)} is a linearized version of \eqn{K12(r)}, which has an expectation of 0 under population independence: \eqn{L12(r) = \sqrt(K12(r)/\pi)-r}. \eqn{L12(r)} becomes positive when the two population show attraction and negative when they show repulsion.
+ Under the null hypothesis of random labelling, the expectation of \eqn{L12(r)} is \eqn{L(r)}. It becomes greater than \eqn{L(r)} when the types tend to be positively correlated and lower when they tend to be negatively correlated.\cr\cr
+ \eqn{g12(r)} is the derivative of \eqn{K12(r)} or bivariate pair density function, so that the expected
+ number of points of type 2 at a distance \eqn{r} of an arbitrary point of type 1 (i.e. within an annuli between two successive circles with radii \eqn{r} and \eqn{r-by}) is:
+ \eqn{O12(r) = \lambda2*g12(r)} (Wiegand & Moloney 2004).\cr\cr
+
+ The program introduces an edge effect correction term according to the method proposed by Ripley (1977)
+ and extended to circular and complex sampling windows by Goreaud & Pélissier (1999).\cr\cr
+
+ Theoretical values under the null hypothesis of either population independence or random labelling as well as
+ local Monte Carlo confidence limits and p-values of departure from the null hypothesis (Besag & Diggle 1977) are estimated at each distance \eqn{r}.\cr
+
+ The population independence hypothesis assumes that the location of points of a given population is independent from the location
+ of points of the other. It is therefore tested conditionally to the intrinsic spatial pattern of each population. Two different procedures are available:
+ \code{H0="pitor"} just shifts the pattern of type 1 points around a torus following Lotwick & Silverman (1982); \code{H0="pimim"} uses a mimetic point process (Goreaud et al. 2004)
+ to mimic the pattern of type 1 points (see \code{\link{mimetic}}.\cr
+ The random labelling hypothesis \code{"rl"} assumes that the probability to bear a given mark is the same for all points of the pattern and
+ doesn't depends on neighbours. It is therefore tested conditionally to the whole spatial pattern, by randomizing the marks over the points'
+ locations kept unchanged (see Goreaud & Pélissier 2003 for further details).
+}
+\value{
+ A list of class \code{"fads"} with essentially the following components:
+ \item{r }{a vector of regularly spaced out distances (\code{seq(by,upto,by)}).}
+ \item{g12 }{a data frame containing values of the bivariate pair density function \eqn{g12(r)}.}
+ \item{n12 }{a data frame containing values of the bivariate local neighbour density function \eqn{n12(r)}.}
+ \item{k12 }{a data frame containing values of the intertype function \eqn{K12(r)}.}
+ \item{l12 }{a data frame containing values of the modified intertype function \eqn{L12(r)}.\cr\cr}
+ \item{ }{Each component except \code{r} is a data frame with the following variables:\cr\cr}
+ \item{obs }{a vector of estimated values for the observed point pattern.}
+ \item{theo }{a vector of theoretical values expected under the selected null hypothesis.}
+ \item{sup }{(optional) if \code{nsim>0} a vector of the upper local confidence limits of the selected null hypothesis at a significant level \eqn{\alpha}.}
+ \item{inf }{(optional) if \code{nsim>0} a vector of the lower local confidence limits of the selected null hypothesis at a significant level \eqn{\alpha}.}
+ \item{pval }{(optional) if \code{nsim>0} a vector of local p-values of departure from the selected null hypothesis.}
+}
+\references{
+ Besag J.E. & Diggle P.J. 1977. Simple Monte Carlo tests spatial patterns. \emph{Applied Statistics}, 26:327-333.\cr\cr
+ Goreaud F. & Pélissier R. 1999. On explicit formulas of edge effect correction for Ripley's K-function. \emph{Journal of Vegetation Science}, 10:433-438.\cr\cr
+ Goreaud, F. & Pélissier, R. 2003. Avoiding misinterpretation of biotic interactions with the intertype \emph{K12}-function: population independence vs. random labelling hypotheses. \emph{Journal of Vegetation Science}, 14: 681-692.\cr\cr
+ Lotwick, H.W. & Silverman, B.W. 1982. Methods for analysing spatial processes of several types of points. \emph{Journal of the Royal Statistical Society B}, 44:403-413.\cr\cr
+ Ripley B.D. 1977. Modelling spatial patterns. \emph{Journal of the Royal Statistical Society B}, 39:172-192.\cr\cr
+ Wiegand, T. & Moloney, K.A. 2004. Rings, circles, and null-models for point pattern analysis in ecology. \emph{Oikos}, 104:209-229.
+ Goreaud F., Loussier, B., Ngo Bieng, M.-A. & Allain R. 2004. Simulating realistic spatial structure for forest stands: a mimetic point process. In \emph{Proceedings of Interdisciplinary Spatial Statistics Workshop}, 2-3 December, 2004. Paris, France.
+}
+\author{\email{Raphael.Pelissier@ird.fr}}
+\note{
+ There are printing and plotting methods for \code{"fads"} objects.
+}
+\seealso{
+\code{\link{plot.fads}},
+ \code{\link{spp}},
+ \code{\link{k12val}},
+ \code{\link{kfun}},
+ \code{\link{kijfun}},
+ \code{\link{ki.fun}},
+ \code{\link{mimetic}},
+ \code{\link{kmfun}}.
+}
+\examples{
+ data(BPoirier)
+ BP <- BPoirier
+ # spatial point pattern in a rectangle sampling window of size [0,110] x [0,90]
+ swrm <- spp(BP$trees, win=BP$rect, marks=BP$species)
+ #testing population independence hypothesis
+ k12swrm.pi <- k12fun(swrm, 25, 1, 500, marks=c("beech","oak"))
+ plot(k12swrm.pi)
+ #testing random labelling hypothesis
+ k12swrm.rl <- k12fun(swrm, 25, 1, 500, H0="rl", marks=c("beech","oak"))
+ plot(k12swrm.rl)
+
+ # spatial point pattern in a circle with radius 50 centred on (55,45)
+ swc <- spp(BP$trees, win=c(55,45,45), marks=BP$species)
+ k12swc.pi <- k12fun(swc, 25, 1, 500, marks=c("beech","oak"))
+ plot(k12swc.pi)
+
+ # spatial point pattern in a complex sampling window
+ swrt.rl <- spp(BP$trees, win=BP$rect, tri=BP$tri2, marks=BP$species)
+ k12swrt.rl <- k12fun(swrt.rl, 25, 1, 500, H0="rl",marks=c("beech","oak"))
+ plot(k12swrt.rl)
+ #testing population independence hypothesis
+ #requires minimizing the outer polygon
+ xr<-range(BP$tri3$ax,BP$tri3$bx,BP$tri3$cx)
+ yr<-range(BP$tri3$ay,BP$tri3$by,BP$tri3$cy)
+ rect.min<-swin(c(xr[1], yr[1], xr[2], yr[2]))
+ swrt.pi <- spp(BP$trees, window = rect.min, triangles = BP$tri3, marks=BP$species)
+ k12swrt.pi <- k12fun(swrt.pi, 25, 1, nsim = 500, marks = c("beech", "oak"))
+ plot(k12swrt.pi)
+}
+\keyword{spatial}
\ No newline at end of file
diff --git a/man/k12val.Rd b/man/k12val.Rd
new file mode 100755
index 0000000..6c70d67
--- /dev/null
+++ b/man/k12val.Rd
@@ -0,0 +1,73 @@
+\encoding{latin1}
+\name{k12val}
+\alias{k12val}
+\alias{print.k12val}
+\alias{summary.k12val}
+\alias{print.summary.k12val}
+\title{Multiscale local second-order neighbour density of a bivariate spatial point pattern}
+\description{
+ Computes local second-order neighbour density estimates for a bivariate spatial point pattern, i.e. the number of neighbours of type 2 per unit area
+ within sample circles of regularly increasing radii \eqn{r}, centred at each type 1 point of the pattern (see Details).
+}
+\usage{
+ k12val(p, upto, by, marks)
+}
+\arguments{
+ \item{p}{a \code{"spp"} object defining a multivariate spatial point pattern in a given sampling window (see \code{\link{spp}}).}
+ \item{upto }{maximum radius of the sample circles (see Details).}
+ \item{by }{interval length between successive sample circles radii (see Details).}
+ \item{marks}{by default \code{c(1,2)}, otherwise a vector of two numbers or character strings identifying the types (the \code{p$marks} levels)
+ of points of type 1 and 2, respectively.}
+}
+\details{
+ Function \code{K12val} returns individual values of \emph{K12(r)} and associated functions (see \code{\link{k12fun}})
+ estimated at each type 1 point of the pattern. For a given distance \emph{r}, these values can be mapped within the sampling window, as in
+ Getis & Franklin 1987 or Pélissier & Goreaud 2001.
+}
+\value{
+ A list of class \code{c("vads","k12val")} with essentially the following components:
+ \item{r }{a vector of regularly spaced distances (\code{seq(by,upto,by)}).}
+ \item{xy }{a data frame with 2 components giving \eqn{(x,y)} coordinates of type 1 points of the pattern.}
+ \item{g12val }{a matrix of size \eqn{(length(xy),length(r))} giving individual values of the bivariate pair density function \eqn{g12(r)}.}
+ \item{n12val }{a matrix of size \eqn{(length(xy),length(r))} giving individual values of the bivariate neighbour density function \eqn{n12(r)}.}
+ \item{k12val }{a matrix of size \eqn{(length(xy),length(r))} giving individual values of the intertype function \eqn{K12(r)}.}
+ \item{l12val }{a matrix of size \eqn{(length(xy),length(r))} giving individual values the modified intertype function \eqn{L12(r)}.}
+}
+\references{
+ Getis, A. and Franklin, J. 1987. Second-order neighborhood analysis of mapped point patterns. \emph{Ecology}, 68:473-477.\cr\cr
+ Pélissier, R. and Goreaud, F. 2001. A practical approach to the study of spatial structure in simple cases of heterogeneous vegetation. \emph{Journal of Vegetation Science}, 12:99-108.
+}
+\author{
+ \email{Raphael.Pelissier@ird.fr}
+}
+\note{
+ There are printing, summary and plotting methods for \code{"vads"} objects.
+}
+\seealso{
+ \code{\link{plot.vads}},
+ \code{\link{k12fun}},
+ \code{\link{dval}},
+ \code{\link{kval}}.
+}
+\examples{
+ data(BPoirier)
+ BP <- BPoirier
+ # spatial point pattern in a rectangle sampling window of size [0,110] x [0,90]
+ swrm <- spp(BP$trees, win=BP$rect, marks=BP$species)
+ k12vswrm <- k12val(swrm, 25, 1, marks=c("beech","oak"))
+ summary(k12vswrm)
+ plot(k12vswrm)
+
+ # spatial point pattern in a circle with radius 50 centred on (55,45)
+ swc <- spp(BP$trees, win=c(55,45,45), marks=BP$species)
+ k12vswc <- k12val(swc, 25, 1, marks=c("beech","oak"))
+ summary(k12vswc)
+ plot(k12vswc)
+
+ # spatial point pattern in a complex sampling window
+ swrt <- spp(BP$trees, win=BP$rect, tri=BP$tri2, marks=BP$species)
+ k12vswrt <- k12val(swrt, 25, 1, marks=c("beech","oak"))
+ summary(k12vswrt)
+ plot(k12vswrt)
+}
+\keyword{spatial}
diff --git a/man/kdfun.Rd b/man/kdfun.Rd
new file mode 100755
index 0000000..735a436
--- /dev/null
+++ b/man/kdfun.Rd
@@ -0,0 +1,92 @@
+\encoding{latin1}
+\name{kdfun}
+\alias{kdfun}
+\title{Multiscale second-order neigbourhood analysis of a spatial phylogenetic or functional community pattern from fully mapped data}
+\description{
+ Computes distance-dependent estimates of Shen et al. (2014) phylogenetic or functional mark correlation functions from a multivariate spatial point pattern
+ in a simple (rectangular or circular) or complex sampling window. Computes optionally local confidence limits of the functions
+ under the null hypothesis of species equivalence (see Details).
+}
+\usage{
+kdfun(p, upto, by, dis, nsim=0, alpha = 0.01)
+}
+\arguments{
+ \item{p }{a \code{"spp"} object defining a spatial point pattern in a given sampling window (see \code{\link{spp}}).}
+ \item{upto }{maximum radius of the sample circles (see Details).}
+ \item{by }{interval length between successive sample circles radii (see Details).}
+ \item{dis }{a \code{"dist"} object defining Euclidean distances between species.}
+ \item{nsim }{number of Monte Carlo simulations to estimate local confidence limits of the null hypothesis of a random allocation of species distances (species equivalence; see Details).
+ By default \code{nsim = 0}, so that no confidence limits are computed.}
+ \item{alpha }{if \code{nsim>0}, significant level of the confidence limits. By default \eqn{\alpha = 0.01}.}
+}
+\details{
+ Function \code{kdfun} computes Shen et al. (2014) \eqn{Kd} and \emph{gd}-functions. For a multivariate point pattern consisting of \eqn{S} species with intensity \eqn{\lambda}p, such functions can be estimated from the bivariate \eqn{Kpq}-functions between each pair of different species \eqn{p} and \eqn{q}.
+ Function \code{kdfun} is thus a simple wrapper of \code{\link{k12fun}} (Pélissier & Goreaud 2014):
+
+ \eqn{Kd(r) = D * Kr(r) / HD * Ks(r) = D * sum(\lambda p * \lambda q * Kpq(r) * dpq) / HD * sum(\lambda p * \lambda q * Kpq(r))}.\cr
+ \eqn{gd(r) = D * g(r) / HD * gs(r) = D * sum(\lambda p * \lambda q * gpq(r) * dpq) / HD * sum(\lambda p * \lambda q * gpq(r))}.\cr\cr
+
+ where \eqn{Ks(r)} and \eqn{gs(r)} are distance-dependent versions of Simpson's diversity index, \eqn{D} (see \code{\link{ksfun}}), \eqn{Kr(r)} and \eqn{gr(r)} are distance-dependent versions of Rao's diversity coefficient (see \code{\link{krfun}});
+ \eqn{dpq} is the distance between species \eqn{p} and \eqn{q} defined by matrix \code{dis}, typically a taxonomic, phylogentic or functional distance. The advantage here is that as the edge effects vanish between \eqn{Kr(r)} and \eqn{Ks(r)},
+ implementation is fast for a sampling window of any shape. \eqn{Kd(r)} provides the expected phylogenetic or functional distance of two heterospecific individuals a distance less than \emph{r} apart (Shen et al. 2014), while \eqn{gd(r)}
+ provides the same within an annuli between two consecutive distances of \emph{r} and \emph{r-by}.
+
+ Theoretical values under the null hypothesis of species equivalence as well as local Monte Carlo confidence limits and p-values of departure from the null hypothesis (Besag & Diggle 1977) are estimated at each distance \eqn{r},
+ by randomizing the between-species distances, keeping the point locations and distribution of species labels unchanged. The theoretical expectations of \eqn{gd(r)} and \eqn{Kd(r)} are thus \eqn{1}.
+
+}
+\value{
+ A list of class \code{"fads"} with essentially the following components:
+ \item{r }{a vector of regularly spaced out distances (\code{seq(by,upto,by)}).}
+ \item{gd }{a data frame containing values of the function \eqn{gd(r)}.}
+ \item{kd }{a data frame containing values of the function \eqn{Kd(r)}.\cr\cr}
+ \item{}{Each component except \code{r} is a data frame with the following variables:\cr\cr}
+\item{obs }{a vector of estimated values for the observed point pattern.}
+ \item{theo }{a vector of theoretical values expected under the null hypothesis of species equivalence.}
+ \item{sup }{(optional) if \code{nsim>0} a vector of the upper local confidence limits of a random distribution of the null hypothesis at a significant level \eqn{\alpha}.}
+ \item{inf }{(optional) if \code{nsim>0} a vector of the lower local confidence limits of a random distribution of the null hypothesis at a significant level \eqn{\alpha}.}
+ \item{pval }{(optional) if \code{nsim>0} a vector of local p-values of departure from the null hypothesis.}
+}
+\references{
+ Shen, G., Wiegand, T., Mi, X. & He, F. (2014). Quantifying spatial phylogenetic structures of fully stem-mapped plant communities. \emph{Methods in Ecology and Evolution}, 4, 1132-1141.
+
+ Pélissier, R. & Goreaud, F. ads package for R: A fast unbiased implementation of the K-function family for studying spatial point patterns in irregular-shaped sampling windows. \emph{Journal of Statistical Software}, in press.
+
+}
+\author{\email{Raphael.Pelissier@ird.fr}}
+\note{
+ There are printing and plotting methods for \code{"fads"} objects.
+}
+\seealso{
+\code{\link{plot.fads}},
+ \code{\link{spp}},
+ \code{\link{ksfun}},
+ \code{\link{krfun}},
+ \code{\link{divc}}.
+}
+\examples{
+ data(Paracou15)
+ P15<-Paracou15
+ # spatial point pattern in a rectangle sampling window of size 125 x 125
+ swmr <- spp(P15$trees, win = c(175, 175, 250, 250), marks = P15$species)
+ # testing the species equivalence hypothesis
+ kdswmr <- kdfun(swmr, dis = P15$spdist, 50, 2, 100)
+ #running more simulations is slow
+ #kdswmr <- drfun(swmr, dis = P15$spdist, 50, 2, 500)
+ plot(kdswmr)
+
+ # spatial point pattern in a circle with radius 50 centred on (125,125)
+ swmc <- spp(P15$trees, win = c(125,125,50), marks = P15$species)
+ kdswmc <- kdfun(swmc, dis = P15$spdist, 50, 2, 100)
+ #running more simulations is slow
+ #kdswmc <- kdfun(swmc, dis = P15$spdist, 50, 2, 500)
+ plot(kdswmc)
+
+ # spatial point pattern in a complex sampling window
+ swrt <- spp(P15$trees, win = c(125,125,250,250), tri = P15$tri, marks = P15$species)
+ kdswrt <- kdfun(swrt, dis = P15$spdist, 50, 2, 100)
+ #running simulations is slow
+ #kdswrt <- kdfun(swrt, dis = P15$spdist, 50, 2, 500)
+ plot(kdswrt)
+}
+\keyword{spatial}
\ No newline at end of file
diff --git a/man/kfun.Rd b/man/kfun.Rd
new file mode 100755
index 0000000..43a1305
--- /dev/null
+++ b/man/kfun.Rd
@@ -0,0 +1,100 @@
+\encoding{latin1}
+\name{kfun}
+\alias{kfun}
+\title{Multiscale second-order neigbourhood analysis of an univariate spatial point pattern}
+\description{
+ Computes estimates of Ripley's \emph{K}-function and associated neigbourhood functions from an univariate spatial point pattern
+ in a simple (rectangular or circular) or complex sampling window. Computes optionally local confidence limits of the functions
+ under the null hypothesis of Complete Spatial Randomness (see Details).
+}
+\usage{
+kfun(p, upto, by, nsim=0, prec=0.01, alpha=0.01)
+}
+\arguments{
+ \item{p }{a \code{"spp"} object defining a spatial point pattern in a given sampling window (see \code{\link{spp}}).}
+ \item{upto }{maximum radius of the sample circles (see Details).}
+ \item{by }{interval length between successive sample circles radii (see Details).}
+ \item{nsim }{number of Monte Carlo simulations to estimate local confidence limits of the null hypothesis of complete spatial randomness (CSR) (see Details).
+ By default \code{nsim=0}, so that no confidence limits are computed.}
+ \item{prec }{if \code{nsim>0}, precision of points' coordinates generated during simulations. By default \code{prec=0.01}.}
+ \item{alpha }{if \code{nsim>0}, significant level of the confidence limits. By default \eqn{\alpha=0.01}.}
+}
+\details{
+ Function \code{kfun} computes Ripley's \eqn{K(r)} function of second-order neighbourhood analysis and the associated functions \eqn{g(r)}, \eqn{n(r)} and \eqn{L(r)}.\cr\cr
+ For a homogeneous isotropic point process of intensity \eqn{\lambda}, Ripley (1977) showed that
+ the second-order property could be characterized by a function \eqn{K(r)}, so that the expected
+ number of neighbours within a distance \eqn{r} of an arbitrary point of the pattern is:
+ \eqn{N(r) = \lambda*K(r)}.\cr\cr
+ \eqn{K(r)} is a intensity standardization of \eqn{N(r)}, which has an expectation of \eqn{\pi*r^2} under the null hypothesis of CSR: \eqn{K(r) = N(r)/\lambda}.\cr\cr
+ \eqn{n(r)} is an area standardization of \eqn{N(r)}, which has an expectation of \eqn{\lambda} under the null hypothesis of CSR: \eqn{n(r) = N(r)/(\pi*r^2)}, where \eqn{\pi*r^2} is the area of the disc of radius \eqn{r}.\cr\cr
+ \eqn{L(r)} is a linearized version of \eqn{K(r)} (Besag 1977), which has an expectation of 0 under the null hypothesis of CSR: \eqn{L(r) = \sqrt(K(r)/\pi)-r}. \emph{L(r)} becomes positive when the pattern tends to clustering and negative when it tends to regularity.\cr\cr
+ \eqn{g(r)} is the derivative of \eqn{K(r)} or pair density function (Stoyan et al. 1987), so that the expected
+ number of neighbours at a distance \eqn{r} of an arbitrary point of the pattern (i.e. within an annuli between two successive circles with radii \eqn{r} and \eqn{r-by}) is:
+ \eqn{O(r) = \lambda*g(r)}.\cr\cr
+
+ The program introduces an edge effect correction term according to the method proposed by Ripley (1977)
+ and extended to circular and complex sampling windows by Goreaud & Pélissier (1999).\cr\cr
+
+ Theoretical values under the null hypothesis of CSR as well as
+ local Monte Carlo confidence limits and p-values of departure from CSR (Besag & Diggle 1977) are estimated at each distance \eqn{r}.
+}
+\value{
+ A list of class \code{"fads"} with essentially the following components:
+ \item{r }{a vector of regularly spaced out distances (\code{seq(by,upto,by)}).}
+ \item{g }{a data frame containing values of the pair density function \eqn{g(r)}.}
+ \item{n }{a data frame containing values of the local neighbour density function \eqn{n(r)}.}
+ \item{k }{a data frame containing values of Ripley's function \eqn{K(r)}.}
+ \item{l }{a data frame containing values of the modified Ripley's function \eqn{L(r)}.\cr\cr}
+ \item{}{Each component except \code{r} is a data frame with the following variables:\cr\cr}
+\item{obs }{a vector of estimated values for the observed point pattern.}
+ \item{theo }{a vector of theoretical values expected for a Poisson pattern.}
+ \item{sup }{(optional) if \code{nsim>0} a vector of the upper local confidence limits of a Poisson pattern at a significant level \eqn{\alpha}.}
+ \item{inf }{(optional) if \code{nsim>0} a vector of the lower local confidence limits of a Poisson pattern at a significant level \eqn{\alpha}.}
+ \item{pval }{(optional) if \code{nsim>0} a vector of local p-values of departure from a Poisson pattern.}
+}
+\references{
+ Besag J.E. 1977. Discussion on Dr Ripley's paper. \emph{Journal of the Royal Statistical Society B}, 39:193-195.
+
+ Besag J.E. & Diggle P.J. 1977. Simple Monte Carlo tests spatial patterns. \emph{Applied Statistics}, 26:327-333.
+
+ Goreaud F. & Pélissier R. 1999. On explicit formulas of edge effect correction for Ripley's K-function. \emph{Journal of Vegetation Science}, 10:433-438.
+
+ Ripley B.D. 1977. Modelling spatial patterns. \emph{Journal of the Royal Statistical Society B}, 39:172-192.
+
+ Stoyan D., Kendall W.S. & Mecke J. 1987. \emph{Stochastic geometry and its applications}. Wiley, New-York.
+}
+\author{\email{Raphael.Pelissier@ird.fr}}
+\note{
+ There are printing and plotting methods for \code{"fads"} objects.
+}
+ \section{Warning }{
+ Function \code{kfun} ignores the marks of multivariate and marked point patterns, which are analysed as univariate patterns.
+}
+\seealso{
+\code{\link{plot.fads}},
+ \code{\link{spp}},
+ \code{\link{kval}},
+ \code{\link{k12fun}},
+ \code{\link{kijfun}},
+ \code{\link{ki.fun}},
+ \code{\link{kmfun}}.
+}
+\examples{
+ data(BPoirier)
+ BP <- BPoirier
+ # spatial point pattern in a rectangle sampling window of size [0,110] x [0,90]
+ swr <- spp(BP$trees, win=BP$rect)
+ kswr <- kfun(swr,25,1,500)
+ plot(kswr)
+
+ # spatial point pattern in a circle with radius 50 centred on (55,45)
+ swc <- spp(BP$trees, win=c(55,45,45))
+ kswc <- kfun(swc, 25, 1, 500)
+ plot(kswc)
+
+ # spatial point pattern in a complex sampling window
+ swrt <- spp(BP$trees, win=BP$rect, tri=BP$tri1)
+ kswrt <- kfun(swrt, 25, 1, 500)
+ plot(kswrt)
+}
+\keyword{spatial}
\ No newline at end of file
diff --git a/man/kmfun.Rd b/man/kmfun.Rd
new file mode 100755
index 0000000..bc39f5a
--- /dev/null
+++ b/man/kmfun.Rd
@@ -0,0 +1,89 @@
+\encoding{latin1}
+\name{kmfun}
+\alias{kmfun}
+\title{Multiscale second-order neigbourhood analysis of a marked spatial point pattern}
+\description{
+ Computes estimates of the mark correlation \emph{Km}-function and associated neigbourhood functions from a marked spatial point pattern
+ in a simple (rectangular or circular) or complex sampling window. Computes optionally local confidence limits of the functions
+ under the null hypothesis of no correlation between marks (see Details).
+}
+\usage{
+kmfun(p, upto, by, nsim=0, alpha=0.01)
+}
+\arguments{
+ \item{p}{a \code{"spp"} object defining a marked spatial point pattern in a given sampling window (see \code{\link{spp}}).}
+ \item{upto }{maximum radius of the sample circles (see Details).}
+ \item{by }{interval length between successive sample circles radii (see Details).}
+ \item{nsim }{number of Monte Carlo simulations to estimate local confidence limits of the null hypothesis of no correlation between marks (see Details).
+ By default \code{nsim=0}, so that no confidence limits are computed.}
+ \item{alpha }{if \code{nsim>0}, significant level of the confidence limits. By default \eqn{\alpha=0.01}.}
+}
+\details{
+ Function \code{kmfun} computes the mark correlation function \eqn{Km(r)} and the associated function \eqn{gm(r)}.\cr\cr
+ It is defined from a general definition of spatial autocorrelation (Goreaud 2000) as:\cr
+
+ \eqn{Km(r) = (COV(Xi,Xj)|d(i,j)<r) / VAR(X)}\cr
+
+ where \eqn{X} is a quantitative random variable attached to each point of the pattern.
+
+ \emph{Km(r)} has a very similar interpretation than more classical correlation functions, such as Moran's \emph{I}: it takes values between -1 and 1, with an expectation of 0 under the null hypothesis of no spatial correlation between the values of \emph{X}, becomes positive when values of \eqn{X} at distance \emph{r} are positively correlated and negative when values of \eqn{X} at distance \emph{r} are negatively correlated.
+
+ \eqn{gm(r)} is the derivative of \eqn{Km(r)} or pair mark correlation function, which gives the correlation of marks within an annuli between two successive circles with radii \eqn{r} and \eqn{r-by}).\cr\cr
+
+ The program introduces an edge effect correction term according to the method proposed by Ripley (1977) and extended to circular and complex sampling windows by Goreaud & Pélissier (1999).
+
+ Local Monte Carlo confidence limits and p-values of departure from the null hypothesis of no correlation are estimated at each distance \eqn{r}, after reallocating at random the values of \emph{X} over all points of the pattern, the location of trees being kept unchanged.
+}
+\value{
+ A list of class \code{"fads"} with essentially the following components:
+ \item{r }{a vector of regularly spaced out distances (\code{seq(by,upto,by)}).}
+ \item{gm }{a data frame containing values of the pair mark correlation function \eqn{gm(r)}.}
+ \item{km }{a data frame containing values of the mark correlation function \eqn{Km(r)}.\cr\cr}
+ \item{ }{Each component except \code{r} is a data frame with the following variables:\cr\cr}
+ \item{obs }{a vector of estimated values for the observed point pattern.}
+ \item{theo }{a vector of theoretical values expected for the null hypothesis of no correlation between marks.}
+ \item{sup }{(optional) if \code{nsim>0} a vector of the upper local confidence limits of the null hypothesis at a significant level \eqn{\alpha}.}
+ \item{inf }{(optional) if \code{nsim>0} a vector of the lower local confidence limits of the null hypothesis at a significant level \eqn{\alpha}.}
+ \item{pval }{(optional) if \code{nsim>0} a vector of local p-values of departure from the null hypothesis.}
+}
+\note{
+Applications of this function can be found in Oddou-Muratorio \emph{et al.} (2004) and Madelaine \emph{et al.} (submitted).
+}
+
+ \references{Goreaud, F. 2000. \emph{Apports de l'analyse de la structure spatiale en foret tempérée à l'étude et la modélisation des peuplements complexes}. Thèse de doctorat, ENGREF, Nancy, France.\cr\cr
+Goreaud F. & Pélissier R. 1999. On explicit formulas of edge effect correction for Ripley's K-function. \emph{Journal of Vegetation Science}, 10:433-438.\cr\cr
+Madelaine, C., Pélissier, R., Vincent, G., Molino, J.-F., Sabatier, D., Prévost, M.-F. & de Namur, C. 2007. Mortality and recruitment in a lowland tropical rainforest of French Guiana: effects of soil type and species guild. \emph{Journal of Tropical Ecology}, 23:277-287.
+
+Oddou-Muratorio, S., Demesure-Musch, B., Pélissier, R. & Gouyon, P.-H. 2004. Impacts of gene flow and logging history on the local genetic structure of a scattered tree species, Sorbus torminalis L. \emph{Molecular Ecology}, 13:3689-3702.
+
+Ripley B.D. 1977. Modelling spatial patterns. \emph{Journal of the Royal Statistical Society B}, 39:172-192.
+}
+\author{\email{Raphael.Pelissier@ird.fr}}
+\seealso{
+\code{\link{plot.fads}},
+ \code{\link{spp}},
+ \code{\link{kfun}},
+ \code{\link{k12fun}},
+ \code{\link{kijfun}},
+ \code{\link{ki.fun}}.
+ }
+\examples{
+ data(BPoirier)
+ BP <- BPoirier
+ # spatial point pattern in a rectangle sampling window of size [0,110] x [0,90]
+ swrm <- spp(BP$trees, win=BP$rect, marks=BP$dbh)
+ kmswrm <- kmfun(swrm, 25, 2, 500)
+ plot(kmswrm)
+
+ # spatial point pattern in a circle with radius 50 centred on (55,45)
+ swc <- spp(BP$trees, win=c(55,45,45), marks=BP$dbh)
+ kmswc <- kmfun(swc, 25, 2, 500)
+ plot(kmswc)
+
+ # spatial point pattern in a complex sampling window
+ swrt <- spp(BP$trees, win=BP$rect, tri=BP$tri2, marks=BP$dbh)
+ kmswrt <- kmfun(swrt, 25, 2, 500)
+ plot(kmswrt)
+
+}
+\keyword{spatial}
diff --git a/man/kp.fun.Rd b/man/kp.fun.Rd
new file mode 100755
index 0000000..c42e544
--- /dev/null
+++ b/man/kp.fun.Rd
@@ -0,0 +1,64 @@
+\encoding{latin1}
+\name{kp.fun}
+\alias{kp.fun}
+\alias{ki.fun}
+\title{ Multiscale second-order neigbourhood analysis of a multivariate spatial point pattern}
+\description{
+(Formerly \code{ki.fun}) Computes a set of \emph{K12}-functions between all possible marks \eqn{p} and the other marks in
+ a multivariate spatial point pattern defined in a simple (rectangular or circular)
+ or complex sampling window (see Details).
+}
+\usage{
+kp.fun(p, upto, by)
+}
+\arguments{
+ \item{p }{a \code{"spp"} object defining a multivariate spatial point pattern in a given sampling window (see \code{\link{spp}}).}
+ \item{upto }{maximum radius of the sample circles (see Details).}
+ \item{by }{interval length between successive sample circles radii (see Details).}
+}
+\details{
+ Function \code{kp.fun} is simply a wrapper to \code{\link{k12fun}}, which computes \emph{K12(r)} between each mark \eqn{p} of the pattern
+ and all other marks grouped together (the \eqn{j} points).
+}
+\value{
+ A list of class \code{"fads"} with essentially the following components:
+ \item{r }{a vector of regularly spaced distances (\code{seq(by,upto,by)}).}
+ \item{labp }{a vector containing the levels \eqn{i} of \code{p$marks}.}
+ \item{gp. }{a data frame containing values of the pair density function \eqn{g12(r)}.}
+ \item{np. }{a data frame containing values of the local neighbour density function \eqn{n12(r)}.}
+ \item{kp. }{a data frame containing values of the \eqn{K12(r)} function.}
+ \item{lp. }{a data frame containing values of the modified \eqn{L12(r)} function.\cr\cr}
+ \item{ }{Each component except \code{r} is a data frame with the following variables:\cr\cr}
+ \item{obs }{a vector of estimated values for the observed point pattern.}
+ \item{theo }{a vector of theoretical values expected under the null hypothesis of population independence (see \code{\link{k12fun}}).}
+}
+\author{\email{Raphael.Pelissier@ird.fr}}
+\note{
+ There are printing and plotting methods for \code{"fads"} objects.
+}
+\seealso{
+\code{\link{plot.fads}},
+ \code{\link{spp}},
+ \code{\link{kfun}},
+ \code{\link{k12fun}},
+ \code{\link{kpqfun}}.
+}
+\examples{
+ data(BPoirier)
+ BP <- BPoirier
+ # multivariate spatial point pattern in a rectangle sampling window
+ swrm <- spp(BP$trees, win=BP$rect, marks=BP$species)
+ kp.swrm <- kp.fun(swrm, 25, 1)
+ plot(kp.swrm)
+
+ # multivariate spatial point pattern in a circle with radius 50 centred on (55,45)
+ swcm <- spp(BP$trees, win=c(55,45,45), marks=BP$species)
+ kp.swcm <- kp.fun(swcm, 25, 1)
+ plot(kp.swcm)
+
+ # multivariate spatial point pattern in a complex sampling window
+ swrtm <- spp(BP$trees, win=BP$rect, tri=BP$tri2, marks=BP$species)
+ kp.swrtm <- kp.fun(swrtm, 25, 1)
+ plot(kp.swrtm)
+}
+\keyword{spatial}
diff --git a/man/kpqfun.Rd b/man/kpqfun.Rd
new file mode 100755
index 0000000..3fa67d1
--- /dev/null
+++ b/man/kpqfun.Rd
@@ -0,0 +1,66 @@
+\encoding{latin1}
+\name{kpqfun}
+\alias{kpqfun}
+\alias{kijfun}
+\title{Multiscale second-order neigbourhood analysis of a multivariate spatial point pattern}
+\description{
+ (Formerly \code{kijfun}) Computes a set of \emph{K}- and \emph{K12}-functions for all possible pairs of marks \eqn{(p,q)} in a multivariate spatial
+ point pattern defined in a simple (rectangular or circular)
+ or complex sampling window (see Details).
+}
+\usage{
+ kpqfun(p, upto, by)
+}
+\arguments{
+ \item{p }{a \code{"spp"} object defining a multivariate spatial point pattern in a given sampling window (see \code{\link{spp}}).}
+ \item{upto }{maximum radius of the sample circles (see Details).}
+ \item{by }{interval length between successive sample circles radii (see Details).}
+}
+\details{
+ Function \code{kpqfun} is simply a wrapper to \code{\link{kfun}} and \code{\link{k12fun}}, which computes either \emph{K(r)}
+ for points of mark \eqn{p} when \eqn{p=q} or \emph{K12(r)} between the marks \eqn{p} and \eqn{q} otherwise.
+}
+\value{
+A list of class \code{"fads"} with essentially the following components:
+ \item{r }{a vector of regularly spaced distances (\code{seq(by,upto,by)}).}
+ \item{labpq }{a vector containing the \eqn{(p,q)} paired levels of \code{p$marks}.}
+ \item{gpq }{a data frame containing values of the pair density functions \eqn{g(r)} and \eqn{g12(r)}.}
+ \item{npq }{a data frame containing values of the local neighbour density functions \eqn{n(r)} and \eqn{n12(r)}.}
+ \item{kpq }{a data frame containing values of the \eqn{K(r)} and \eqn{K12(r)} functions.}
+\item{lpq }{a data frame containing values of the modified \eqn{L(r)} and \eqn{L12(r)} functions.\cr\cr}
+ \item{ }{Each component except \code{r} is a data frame with the following variables:\cr}
+ \item{obs }{a vector of estimated values for the observed point pattern.}
+ \item{theo }{a vector of theoretical values expected under the null hypotheses of spatial randomness (see \code{\link{kfun}}) and
+ population independence (see \code{\link{k12fun}}).}
+}
+\author{\email{Raphael.Pelissier@ird.fr}}
+\note{
+ There are printing and plotting methods for \code{"fads"} objects.
+}
+\seealso{
+\code{\link{plot.fads}},
+ \code{\link{spp}},
+ \code{\link{kfun}},
+ \code{\link{k12fun}},
+ \code{\link{kp.fun}}.
+}
+\examples{
+ data(BPoirier)
+ BP <- BPoirier
+ # multivariate spatial point pattern in a rectangle sampling window
+ swrm <- spp(BP$trees, win=BP$rect, marks=BP$species)
+ kpqswrm <- kpqfun(swrm, 25, 1)
+ plot(kpqswrm)
+
+ # multivariate spatial point pattern in a circle with radius 50 centred on (55,45)
+ swcm <- spp(BP$trees, win=c(55,45,45), marks=BP$species)
+ kpqswcm <- kpqfun(swcm, 25, 1)
+ plot(kpqswcm)
+
+ # multivariate spatial point pattern in a complex sampling window
+ swrtm <- spp(BP$trees, win=BP$rect, tri=BP$tri2, marks=BP$species)
+ kpqswrtm <- kpqfun(swrtm, 25, 1)
+ plot(kpqswrtm)
+
+}
+\keyword{spatial}
diff --git a/man/krfun.Rd b/man/krfun.Rd
new file mode 100755
index 0000000..4232582
--- /dev/null
+++ b/man/krfun.Rd
@@ -0,0 +1,107 @@
+\encoding{latin1}
+\name{krfun}
+\alias{krfun}
+\title{Multiscale second-order neigbourhood analysis of a multivariate spatial point pattern using Rao quandratic entropy}
+\description{
+ Computes distance-dependent estimates of Rao's quadratic entropy from a multivariate spatial point pattern
+ in a simple (rectangular or circular) or complex sampling window. Computes optionally local confidence limits of the functions
+ under the null hypothesis of either a random labelling or a species equivalence (see Details).
+}
+\usage{
+krfun(p, upto, by, nsim=0, dis = NULL, H0 = c("rl", "se"), alpha = 0.01)
+}
+\arguments{
+ \item{p }{a \code{"spp"} object defining a spatial point pattern in a given sampling window (see \code{\link{spp}}).}
+ \item{upto }{maximum radius of the sample circles (see Details).}
+ \item{by }{interval length between successive sample circles radii (see Details).}
+ \item{nsim }{number of Monte Carlo simulations to estimate local confidence limits of the null hypothesis of a random allocation of species labels (see Details).
+ By default \code{nsim = 0}, so that no confidence limits are computed.}
+ \item{dis }{(optional) a \code{"dist"} object defining Euclidean distances between species. By default \eqn{dis = NULL} so that species are considered equidistant.}
+\item{H0}{one of c("rl","se") to select either the null hypothesis of random labelling (H0 = "rl") or species equivalence (H0 = "se") (see Details). By default, the null hypothesis is random labelling.}
+ \item{alpha }{if \code{nsim>0}, significant level of the confidence limits. By default \eqn{\alpha = 0.01}.}
+}
+\details{
+ Function \code{krfun} computes distance-dependent functions of Rao (1982) quadratic entropy (see \code{\link{divc}} in package \code{ade4}).\cr\cr
+ For a multivariate point pattern consisting of \eqn{S} species with intensity \eqn{\lambda}p, such functions can be estimated from the bivariate \eqn{Kpq}-functions between each pair of different species \eqn{p} and \eqn{q}.
+ Function \code{krfun} is thus a simple wrapper function of \code{\link{k12fun}} and \code{\link{kfun}}, standardized by Rao diversity coefficient (Pélissier & Goreaud 2014):
+
+ \eqn{Kr(r) = sum(\lambda p * \lambda q * Kpq(r)*dpq) / (\lambda * \lambda * K(r) * HD)}.\cr
+ \eqn{gr(r) = sum(\lambda p * \lambda q * gpq(r)*dpq) / (\lambda * \lambda * g(r) * HD)}.\cr\cr
+
+ where \eqn{dpq} is the distance between species \eqn{p} and \eqn{q} defined by matrix \code{dis}, typically a taxonomic, phylogentic or functional distance, and \eqn{HD=sum(Np*Nq*dpq/(N(N - 1)))} is the unbiased version of Rao diversity coefficient (see Shimatani 2001). When \code{dis = NULL}, species are considered each other equidistant and \code{krfun} returns the same results than \code{\link{ksfun}}.
+
+The program introduces an edge effect correction term according to the method proposed by Ripley (1977)
+ and extended to circular and complex sampling windows by Goreaud & Pélissier (1999).\cr\cr
+
+Theoretical values under the null hypothesis of either random labelling or species equivalence as well as local Monte Carlo confidence limits and p-values of departure from the null hypothesis (Besag & Diggle 1977) are estimated at each distance \eqn{r}.
+
+The random labelling hypothesis (H0 = "rl") is tested by reallocating species labels at random among all points of the pattern, keeping the point locations unchanged, so that expectations of \eqn{gr(r)} and \eqn{Kr(r)} are 1 for all \eqn{r}.
+The species equivalence hypothesis (H0 = "se") is tested by randomizing the between-species distances, keeping the point locations and distribution of species labels unchanged. The theoretical expectations of \eqn{gr(r)} and \eqn{Kr(r)} are thus \eqn{gs(r)} and \eqn{Ks(r)}, respectively (see \code{\link{ksfun}}).
+
+}
+\value{
+ A list of class \code{"fads"} with essentially the following components:
+ \item{r }{a vector of regularly spaced out distances (\code{seq(by,upto,by)}).}
+ \item{gr }{a data frame containing values of the function \eqn{gr(r)}.}
+ \item{kr }{a data frame containing values of the function \eqn{Kr(r)}.\cr\cr}
+ \item{}{Each component except \code{r} is a data frame with the following variables:\cr\cr}
+\item{obs }{a vector of estimated values for the observed point pattern.}
+ \item{theo }{a vector of theoretical values expected under the selected null hypothesis.}
+ \item{sup }{(optional) if \code{nsim>0} a vector of the upper local confidence limits of a random distribution of the selected null hypothesis at a significant level \eqn{\alpha}.}
+ \item{inf }{(optional) if \code{nsim>0} a vector of the lower local confidence limits of a random distribution of the selected null hypothesis at a significant level \eqn{\alpha}.}
+ \item{pval }{(optional) if \code{nsim>0} a vector of local p-values of departure from the selected null hypothesis.}
+}
+\references{
+ Rao, C.R. 1982. Diversity and dissimilarity coefficient: a unified approach. \emph{Theoretical Population Biology}, 21:24-43.
+
+ Shimatani, K. 2001. On the measurement of species diversity incorporating species differences. \emph{Oïkos}, 93, 135-147.
+
+ Goreaud F. & Pélissier R. 1999. On explicit formulas of edge effect correction for Ripley's K-function. \emph{Journal of Vegetation Science}, 10:433-438.
+
+ Ripley B.D. 1977. Modelling spatial patterns. \emph{Journal of the Royal Statistical Society B}, 39:172-192.
+
+ Pélissier, R. & Goreaud, F. 2014. ads package for R: A fast unbiased implementation of the k-function family for studying spatial point patterns in irregular-shaped sampling windows. \emph{Journal of Statistical Software}, in press.
+
+}
+\author{\email{Raphael.Pelissier@ird.fr}}
+\note{
+ There are printing and plotting methods for \code{"fads"} objects.
+}
+\seealso{
+\code{\link{plot.fads}},
+ \code{\link{spp}},
+ \code{\link{ksfun}},
+ \code{\link{kdfun}},
+ \code{\link{divc}}.
+}
+\examples{
+ data(Paracou15)
+ P15<-Paracou15
+ # spatial point pattern in a rectangle sampling window of size 125 x 125
+ swmr <- spp(P15$trees, win = c(175, 175, 250, 250), marks = P15$species)
+ # testing the random labeling hypothesis
+ krwmr.rl <- krfun(swmr, dis = P15$spdist, H0 = "rl", 25, 2, 50)
+ #running more simulations is slow
+ #krwmr.rl <- krfun(swmr, dis = P15$spdist, H0 = "rl", 25, 2, 500)
+ plot(krwmr.rl)
+ # testing the species equivalence hypothesis
+ krwmr.se <- krfun(swmr, dis = P15$spdist, H0 = "se", 25, 2, 50)
+ #running more simulations is slow
+ #krwmr.se <- krfun(swmr, dis = P15$spdist, H0 = "se", 25, 2, 500)
+ plot(krwmr.se)
+
+ # spatial point pattern in a circle with radius 50 centred on (125,125)
+ swmc <- spp(P15$trees, win = c(125,125,50), marks = P15$species)
+ krwmc <- krfun(swmc, dis = P15$spdist, H0 = "rl", 25, 2, 100)
+ #running more simulations is slow
+ #krwmc <- krfun(swmc, dis = P15$spdist, H0 = "rl, 25, 2, 500)
+ plot(krwmc)
+
+ # spatial point pattern in a complex sampling window
+ swrt <- spp(P15$trees, win = c(125,125,250,250), tri = P15$tri, marks = P15$species)
+ krwrt <- krfun(swrt, dis = P15$spdist, H0 = "rl", 25, 2)
+ #running simulations is slow
+ #krwrt <- krfun(swrt, dis = P15$spdist, H0 = "rl", 25, 2, 500)
+ plot(krwrt)
+}
+\keyword{spatial}
\ No newline at end of file
diff --git a/man/ksfun.Rd b/man/ksfun.Rd
new file mode 100755
index 0000000..55259a2
--- /dev/null
+++ b/man/ksfun.Rd
@@ -0,0 +1,93 @@
+\encoding{latin1}
+\name{ksfun}
+\alias{ksfun}
+\title{Multiscale second-order neigbourhood analysis of a multivariate spatial point pattern using Simpson diversity}
+\description{
+ Computes estimates of Shimatani \emph{alpha} and \emph{beta} functions of Simpson diversity from a multivariate spatial point pattern
+ in a simple (rectangular or circular) or complex sampling window. Computes optionally local confidence limits of the functions
+ under the null hypothesis of a random allocation of species labels (see Details).
+}
+\usage{
+ksfun(p, upto, by, nsim=0, alpha=0.01)
+}
+\arguments{
+ \item{p }{a \code{"spp"} object defining a spatial point pattern in a given sampling window (see \code{\link{spp}}).}
+ \item{upto }{maximum radius of the sample circles (see Details).}
+ \item{by }{interval length between successive sample circles radii (see Details).}
+ \item{nsim }{number of Monte Carlo simulations to estimate local confidence limits of the null hypothesis of a random allocation of species labels (see Details).
+ By default \code{nsim=0}, so that no confidence limits are computed.}
+ \item{alpha }{if \code{nsim>0}, significant level of the confidence limits. By default \eqn{\alpha=0.01}.}
+}
+\details{
+ Function \code{ksfun} computes Shimatani \eqn{\alpha(r)} and \eqn{\beta(r)} functions of Simpson diversity, called here \eqn{Ks(r)} and \eqn{gs(r)}, respectively.\cr\cr
+ For a multivariate point pattern consisting of \eqn{S} species with intensity \eqn{\lambda}p, Shimatani (2001) showed that
+ a distance-dependent measure of Simpson (1949) diversity can be estimated from Ripley (1977) \eqn{K}-function computed for each species separately and for all the points grouped toghether (see also Eckel et al. 2008).
+ Function \code{ksfun} is thus a simple wrapper function of \code{\link{kfun}}, standardized by Simpson diversity coefficient:
+
+
+ \eqn{Ks(r) = 1 - sum(\lambda p * \lambda p * Kp(r)) / (\lambda * \lambda * K(r) * D)} which is a standardized estimator of \eqn{\alpha(r)} in Shimatani (2001).\cr\cr
+ \eqn{gs(r) = 1 - sum(\lambda p * \lambda p * gp(r)) / (\lambda * \lambda * g(r) * D)} corresponding to a standardized version of \eqn{\beta(r)} in Shimatani (2001).\cr\cr
+
+ \eqn{Kp(r)} and \eqn{K(r)} (resp. \eqn{gp(r)} and \eqn{g(r)}) are univariate K-functions computed for species \eqn{p} and for all species toghether; \eqn{D = 1 - sum(Np * (Np - 1) / (N*(N - 1)))} is the unbiased version of Simpson diversity,
+ with \eqn{Np} the number of individuals of species \eqn{p} in the sample and \eqn{N = sum(Np)}.
+
+ The program introduces an edge effect correction term according to the method proposed by Ripley (1977)
+ and extended to circular and complex sampling windows by Goreaud & Pélissier (1999).\cr\cr
+
+ The theoretical values of \eqn{gr(r)} and \eqn{Kr(r)} under the null hypothesis of random labelling is 1 for all \eqn{r}.
+ Local Monte Carlo confidence limits and p-values of departure from this hypothesis are estimated at each distance \eqn{r} by reallocating at random the species labels among points of the pattern, keeping the point locations unchanged.
+}
+\value{
+ A list of class \code{"fads"} with essentially the following components:
+ \item{r }{a vector of regularly spaced out distances (\code{seq(by,upto,by)}).}
+ \item{gs }{a data frame containing values of the function \eqn{gs(r)}.}
+ \item{ks }{a data frame containing values of the function \eqn{Ks(r)}.\cr\cr}
+ \item{}{Each component except \code{r} is a data frame with the following variables:\cr\cr}
+\item{obs }{a vector of estimated values for the observed point pattern.}
+ \item{theo }{a vector of theoretical values expected under the null hypothesis of random labelling, i.e. 1 for all \eqn{r}.}
+ \item{sup }{(optional) if \code{nsim>0} a vector of the upper local confidence limits of a random distribution of species labels at a significant level \eqn{\alpha}.}
+ \item{inf }{(optional) if \code{nsim>0} a vector of the lower local confidence limits of a Prandom distribution of species labels at a significant level \eqn{\alpha}.}
+ \item{pval }{(optional) if \code{nsim>0} a vector of local p-values of departure from a random distribution of species labels.}
+}
+\references{
+ Shimatani K. 2001. Multivariate point processes and spatial variation in species diversity. \emph{Forest Ecology and Managaement}, 142:215-229.
+
+ Eckel, S., Fleisher, F., Grabarnik, P. and Schmidt V. 2008. An investigation of the spatial correlations for relative purchasing power in Baden-Württemberg. \emph{AstA - Advances in Statistical Analysis}, 92:135-152.
+
+ Simpson, E.H. 1949. Measurement of diversity. \emph{Nature}, 688:163.
+
+ Goreaud F. & Pélissier R. 1999. On explicit formulas of edge effect correction for Ripley's K-function. \emph{Journal of Vegetation Science}, 10:433-438.
+
+ Ripley B.D. 1977. Modelling spatial patterns. \emph{Journal of the Royal Statistical Society B}, 39:172-192.
+}
+\author{\email{Raphael.Pelissier@ird.fr}}
+\note{
+ There are printing and plotting methods for \code{"fads"} objects.
+}
+\seealso{
+\code{\link{plot.fads}},
+ \code{\link{spp}},
+ \code{\link{kfun}},
+ \code{\link{kpqfun}},
+ \code{\link{kp.fun}},
+ \code{\link{krfun}}.
+}
+\examples{
+ data(Paracou15)
+ P15<-Paracou15
+ # spatial point pattern in a rectangle sampling window of size 125 x 125
+ swmr <- spp(P15$trees, win = c(125, 125, 250, 250), marks = P15$species)
+ kswmr <- ksfun(swmr, 50, 5, 500)
+ plot(kswmr)
+
+ # spatial point pattern in a circle with radius 50 centred on (125,125)
+ swmc <- spp(P15$trees, win = c(125, 125, 50), marks = P15$species)
+ kswmc <- ksfun(swmc, 50, 5, 500)
+ plot(kswmc)
+
+ # spatial point pattern in a complex sampling window
+ swrt <- spp(P15$trees, win = c(125, 125, 250, 250), tri=P15$tri, marks=P15$species)
+ kswrt <- ksfun(swrt, 50, 5, 500)
+ plot(kswrt)
+}
+\keyword{spatial}
\ No newline at end of file
diff --git a/man/kval.Rd b/man/kval.Rd
new file mode 100755
index 0000000..ac9f740
--- /dev/null
+++ b/man/kval.Rd
@@ -0,0 +1,74 @@
+\encoding{latin1}
+\name{kval}
+\alias{kval}
+\alias{print.kval}
+\alias{summary.kval}
+\alias{print.summary.kval}
+\title{Multiscale local second-order neighbour density of a spatial point pattern}
+\description{
+ Computes local second-order neighbour density estimates for an univariate spatial point pattern, i.e. the number of neighbours per unit area
+ within sample circles of regularly increasing radii \eqn{r}, centred at each point of the pattern (see Details).
+}
+\usage{
+ kval(p, upto, by)
+}
+\arguments{
+ \item{p}{a \code{"spp"} object defining a spatial point pattern in a given sampling window (see \code{\link{spp}}).}
+ \item{upto }{maximum radius of the sample circles (see Details).}
+ \item{by }{interval length between successive sample circles radii (see Details).}
+}
+\details{
+ Function \code{kval} returns indivdiual values of \emph{K(r)} and associated functions (see \code{\link{kfun}})
+ estimated for each point of the pattern. For a given distance \emph{r}, these values can be mapped within the sampling window
+ (Getis & Franklin 1987, Pélissier & Goreaud 2001).
+}
+\value{
+A list of class \code{c("vads","kval")} with essentially the following components:
+ \item{r }{a vector of regularly spaced out distances (\code{seq(by,upto,by)}).}
+ \item{xy }{a data frame with 2 components giving \eqn{(x,y)} coordinates of points of the pattern.}
+ \item{gval }{a matrix of size \eqn{(length(xy),length(r))} giving individual values of the pair density function \eqn{g(r)}.}
+ \item{nval }{a matrix of size \eqn{(length(xy),length(r))} giving individual values of the neighbour density function \eqn{n(r)}.}
+ \item{kval }{a matrix of size \eqn{(length(xy),length(r))} giving individual values of Ripley's function \eqn{K(r)}.}
+ \item{lval }{a matrix of size \eqn{(length(xy),length(r))} giving individual values the modified Ripley's function \eqn{L(r)}.}
+ }
+\references{
+ Getis, A. and Franklin, J. 1987. Second-order neighborhood analysis of mapped point patterns. \emph{Ecology}, 68:473-477.\cr\cr
+ Pélissier, R. and Goreaud, F. 2001. A practical approach to the study of spatial structure in simple cases of heterogeneous vegetation. \emph{Journal of Vegetation Science}, 12:99-108.
+}
+\author{
+ \email{Raphael.Pelissier@ird.fr}
+}
+\note{
+ There are printing, summary and plotting methods for \code{"vads"} objects.
+}
+\section{Warning }{
+ Function \code{kval} ignores the marks of multivariate and marked point patterns (they are all considered to be univariate patterns).
+}
+\seealso{
+ \code{\link{plot.vads}},
+ \code{\link{kfun}},
+ \code{\link{dval}},
+ \code{\link{k12val}}.
+}
+\examples{
+ data(BPoirier)
+ BP <- BPoirier
+ # spatial point pattern in a rectangle sampling window of size [0,110] x [0,90]
+ swr <- spp(BP$trees, win=BP$rect)
+ kvswr <- kval(swr, 25, 1)
+ summary(kvswr)
+ plot(kvswr)
+
+ # spatial point pattern in a circle with radius 50 centred on (55,45)
+ swc <- spp(BP$trees, win=c(55,45,45))
+ kvswc <- kval(swc, 25, 1)
+ summary(kvswc)
+ plot(kvswc)
+
+ # spatial point pattern in a complex sampling window
+ swrt <- spp(BP$trees, win=BP$rect, tri=BP$tri1)
+ kvswrt <- kval(swrt, 25, 1)
+ summary(kvswrt)
+ plot(kvswrt)
+}
+\keyword{spatial}
\ No newline at end of file
diff --git a/man/mimetic.Rd b/man/mimetic.Rd
new file mode 100755
index 0000000..a7ea809
--- /dev/null
+++ b/man/mimetic.Rd
@@ -0,0 +1,64 @@
+\encoding{latin1}
+\name{mimetic}
+\alias{mimetic}
+\alias{plot.mimetic}
+\title{Univariate point pattern simulation by mimetic point process}
+\description{
+ Simulates replicates of an observed univariate point pattern by stochastic optimization of its L-function properties.
+}
+\usage{
+mimetic(x,upto=NULL,by=NULL,prec=NULL,nsimax=3000,conv=50)
+}
+\arguments{
+ \item{x }{either a \code{("fads", "kfun")} object or a \code{"spp"} object of type "univariate" defining a spatial point pattern in a given sampling window (see \code{\link{kfun}} or \code{\link{spp}}).}
+ \item{upto }{(optional) maximum radius of the sample circles when \code{x} is a \code{"spp"} object.}
+ \item{by }{(optional) interval length between successive sample circles radii when \code{x} is a \code{"spp"} object.}
+ \item{prec }{precision of point coordinates generated during simulations when \code{x} is a \code{"spp"} object. By default prec=0.01 or the value used in fonction \code{kfun} when \code{x} is a \code{("fads", "kfun")} object.}
+ \item{nsimax }{maximum number of simulations allowed. By default the process stops after \code{nsimax=3000} if convergence is not reached.}
+ \item{conv }{maximum number of simulations without optimization gain (convergence criterion).}
+}
+\details{
+ Function \code{mimetic} uses a stepwise depletion-replacement algorithm to generate a point pattern whose L-function is optimized with regards to an observed one, following the mimetic point process principle (Goreaud et al. 2004).
+ Four points are randomly deleted at each step of the process and replaced by new points that minimize the following cost function:||\eqn{Lobs(r) - Lsim (r)}||)^2. The simulation stops as soon as the cost fonction doesn't decrease
+ after \code{conv} simulations or after a maximum of \code{nsimax} simulations. The process apply to rectangular, circular or comlex sampling windows (see \code{\link{spp}}). There exist a \code{plot} method that displays diagnostic
+ plots, i.e. the observed and simulated L-function, the simulated point pattern and the successive values of the cost function.
+}
+\value{
+ A list of class \code{"mimetic"} with essentially the following components:
+ \item{call }{the function call.}
+ \item{fads }{an object of class \code{("fads", "mimetic")} with 2 components:\cr\cr}
+ \item{..r }{a vector of regularly spaced out distances corresponding to seq(by,upto,by).}
+ \item{..l }{a dataframe with 2 components:\cr\cr}
+ \item{.. ..obs}{a vector of values of the L-function estimated for the initial observed pattern}
+ \item{.. ..sim}{a vector of values of the L-function estimated for the simulated pattern}
+\item{spp }{a object of class \code{"spp"} corresponding to the simulated point pattern (see \code{\link{spp}}).}
+ \item{theo }{a vector of theoretical values, i.e. Simpson \eqn{D} for all the points.}
+ \item{cost }{a vector of the successive values of the cost function.}
+}
+\references{
+ Goreaud F., Loussier, B., Ngo Bieng, M.-A. & Allain R. 2004. Simulating realistic spatial structure for forest stands: a mimetic point process. In Proceedings of Interdisciplinary Spatial Statistics Workshop, 2-3 December, 2004. Paris, France.}
+\author{\email{Raphael.Pelissier@ird.fr}}
+\note{
+ There are printing and plotting methods for \code{"mimetic"} objects.
+}
+\seealso{
+ \code{\link{spp}},
+ \code{\link{kfun}},
+}
+\examples{
+ data(BPoirier)
+ BP<-BPoirier
+ # performing point pattern analysis in a rectangle sampling window
+ swr <- spp(BP$trees, win=BP$rect)
+ plot(swr)
+
+ # performing the mimetic point process from "spp" object
+ mimswr <- mimetic(swr, 20, 2)
+ plot(mimswr)
+
+ # performing the mimetic point process from "fads" object
+ mimkswr <- mimetic(kfun(swr, 20, 2))
+ plot(mimkswr)
+
+ }
+\keyword{spatial}
\ No newline at end of file
diff --git a/man/plot.fads.Rd b/man/plot.fads.Rd
new file mode 100755
index 0000000..409277b
--- /dev/null
+++ b/man/plot.fads.Rd
@@ -0,0 +1,66 @@
+\encoding{latin1}
+\name{plot.fads}
+\alias{plot.fads}
+\alias{plot.fads.kfun}
+\alias{plot.fads.k12fun}
+\alias{plot.fads.kpqfun}
+\alias{plot.fads.kp.fun}
+\alias{plot.fads.kmfun}
+\alias{plot.fads.ksfun}
+\alias{plot.fads.krfun}
+\alias{plot.fads.kdfun}
+\alias{plot.fads.mimetic}
+\title{Plot second-order neigbourhood functions}
+\description{
+ Plot second-order neigbourhood function estimates returned by functions \code{\link{kfun}, \link{k12fun}, \link{kmfun}}, \cr
+ \code{ \link{kijfun} or \link{ki.fun}}.
+}
+\usage{
+\method{plot}{fads}(x, opt, cols, lty, main, sub, legend, csize, \dots)
+}
+\arguments{
+ \item{x}{an object of class \code{"fads"} (see Details).}
+ \item{opt}{one of \code{c("all","L","K","n","g")} to dislay either all or one of the functions in a single window. By default \code{opt = "all"} for \code{fads}
+ objects of subclass \code{"kfun"}, \code{"k12fun"}, or \code{"kmfun"}; by default \code{opt = "L"} for \code{fads} objects of subclass \code{"kij"}, or \code{"ki."}.}
+ \item{cols}{(optional) coulours used for plotting functions.}
+ \item{lty}{(optional) line types used for plotting functions.}
+ \item{main}{by default, the value of argument x, otherwise a text to be displayed as a title of the plot. \code{main=NULL} displays no title.}
+ \item{sub}{by default, the name of the function displayed, otherwise a text to be displayed as function subtitle. \code{sub=NULL} displays no subtitle.}
+ \item{legend}{If \code{legend = TRUE} (the default) a legend for the plotting functions is displayed.}
+ \item{csize}{scaling factor for font size so that actual font size is \code{par("cex")*csize}. By default \code{csize = 1}.}
+ \item{\dots}{extra arguments that will be passed to the plotting functions \code{\link{plot.swin}}, \cr
+ \code{\link{plot.default}}, \code{\link{symbols}} and/or \code{\link{points}}.}
+}
+\details{
+ Function \code{plot.fads} displays second-order neighbourhood function estimates as a function of interpoint distance, with expected values
+ as well as confidence interval limits when computed. Argument \code{x} can be any \code{fads} object returned by functions \code{\link{kfun},
+ \link{k12fun}, \link{kmfun}, \link{kijfun} or \link{ki.fun}}.
+}
+\value{none.}
+\author{\email{Raphael.Pelissier@ird.fr}}
+\seealso{
+ \code{\link{kfun}},
+ \code{\link{k12fun}},
+ \code{\link{kmfun}},
+ \code{\link{kijfun}},
+ \code{\link{ki.fun}}.}
+\examples{
+ data(BPoirier)
+ BP <- BPoirier
+ # Ripley's function
+ swr <- spp(BP$trees, win=BP$rect)
+ k.swr <- kfun(swr, 25, 1, 500)
+ plot(k.swr)
+
+ # Intertype function
+ swrm <- spp(BP$trees, win=BP$rect, marks=BP$species)
+ k12.swrm <- k12fun(swrm, 25, 1, 500, marks=c("beech","oak"))
+ plot(k12.swrm, opt="L", cols=1)
+
+ # Mark correlation function
+ swrm <- spp(BP$trees, win=BP$rect, marks=BP$dbh)
+ km.swrm <- kmfun(swrm, 25, 1, 500)
+ plot(km.swrm, main="Example 1", sub=NULL, legend=FALSE)
+
+}
+\keyword{spatial}
diff --git a/man/plot.spp.Rd b/man/plot.spp.Rd
new file mode 100755
index 0000000..9f0503a
--- /dev/null
+++ b/man/plot.spp.Rd
@@ -0,0 +1,99 @@
+\encoding{latin1}
+\name{plot.spp}
+\alias{plot.spp}
+\title{Plot a Spatial Point Pattern object}
+\description{
+ Plot a Spatial Point Pattern object returned by function \code{\link{spp}}.
+}
+\usage{
+\method{plot}{spp}(x, main, out=FALSE, use.marks=TRUE, cols, chars, cols.out, chars.out,
+maxsize, scale=TRUE, add=FALSE, legend=TRUE, csize=1, ...)
+}
+\arguments{
+ \item{x}{an object of class \code{"spp"} (see \code{\link{spp}}).}
+ \item{main}{by default, the value of argument \code{x}, otherwise a text to be displayed as a title of the plot.\code{main=NULL} displays no title.}
+ \item{out}{by default \code{out = FALSE}. If \code{TRUE} points of the pattern located outside the sampling window are plotted.}
+ \item{use.marks}{by default \code{use.marks = TRUE}. If \code{FALSE} different symbols are not used for each mark of multivariate
+ or marked point patterns, so that they are plotted as univariate (see \code{\link{spp}}).}
+ \item{cols}{(optional) the coulour(s) used to plot points located inside the sampling window (see Details).}
+ \item{chars}{(optional) plotting character(s) used to plot points located inside the sampling window (see Details).}
+ \item{cols.out}{(optional) if \code{out = TRUE}, the coulour(s) used to plot points located outside the sampling window (see Details).}
+ \item{chars.out}{(optional) if \code{out = TRUE}, plotting character(s) used to plot points located outside the sampling window (see Details).}
+ \item{maxsize}{(optional) maximum size of plotting symbols. By default \code{maxsize} is automatically adjusted to plot size.}
+ \item{csize}{scaling factor for font size so that actual font size is \code{par("cex")*csize}. By default \code{csize = 1}.}
+ \item{scale}{If \code{scale = TRUE} (the default) graduations giving plot size are displayed.}
+ \item{legend}{If \code{legend = TRUE} (the default) a legend for plot symbols is displayed (multivariate and marked types only).}
+ \item{add}{by default \code{add = FALSE}. If \code{TRUE} a new window is not created and just the points are plotted over the existing plot.}
+ \item{\dots}{extra arguments that will be passed to the plotting functions \code{\link{plot.default}}, \code{\link{points}} and/or \code{\link{symbols}}.}
+}
+\details{
+The sampling window \code{x$window} is plotted first, through a call to function \code{\link{plot.swin}}.
+Then the points themselves are plotted, in a fashion that depends on the type of spatial point pattern (see \code{\link{spp}}).
+\itemize{
+ \item
+ \bold{univariate pattern:}
+ if \code{x$type = c("univariate")}, i.e. the point pattern does not have marks, or if \code{use.marks = FALSE}, then the locations of all
+ points is plotted using a single plot character.
+ \item
+ \bold{multivariate pattern:}
+ if \code{x$type = c("multivariate")}, i.e. the marks are levels of a factor, then each level is represented by a different plot character.
+ \item
+ \bold{marked pattern:}
+ if \code{x$type = c("marked")}, i.e. the marks are real numbers, then points are represented by circles (argument \code{chars = "circles"}, the default) or squares
+ (argument \code{chars = "squares"}) proportional to their marks' value (positive values are filled, while negative values are unfilled).
+ }
+
+ Arguments \code{cols} and \code{cols.out} (if \code{out = TRUE}) determine the colour(s) used to display the points located inside and outside the sampling window, respectively.
+ Colours may be specified as codes or colour names (see \code{\link[graphics]{par}("col")}). For univariate and marked point patterns, \code{cols} and \code{cols.out} are single character strings, while
+ for multivariate point patterns they are charcater vectors of same length as \code{levels(x$marks)} and \code{levels(x$marksout)}, respectively.
+
+ Arguments \code{chars} and \code{chars.out} (if \code{out = TRUE}) determine the symbol(s) used to display the points located inside and outside the sampling window, respectively.
+ Symbols may be specified as codes or character strings (see \code{\link[graphics]{par}("pch")}). For univariate point patterns, \code{chars} and \code{chars.out} are single character strings, while
+ for multivariate point patterns they are charcater vectors of same length as \code{levels(x$marks)} and \code{levels(x$marksout)}, respectively. For marked point patterns,
+ \code{chars} and \code{chars.out} can only take the value \code{"circles"} or \code{"squares"}.
+}
+\value{
+ none.
+}
+\author{
+ \email{Raphael.Pelissier@ird.fr}
+}
+\seealso{
+ \code{\link{spp}},
+ \code{\link{swin}},
+ \code{\link{plot.swin}}.
+}
+\examples{
+ data(BPoirier)
+ BP<-BPoirier
+
+ # a univariate point pattern in a rectangle sampling window
+ plot(spp(BP$trees, win=BP$rect))
+
+ # a univariate point pattern in a circular sampling window
+ #with all points and graduations displayed
+ plot(spp(BP$trees, win=c(55,45,45)), out=TRUE, scale=TRUE)
+
+ # a univariate point pattern in a complex sampling window
+ #with points outside the sampling window displayed (in red colour)
+ plot(spp(BP$trees, win=BP$rect, tri=BP$tri1), out=TRUE)
+
+ # a multivariate point pattern in a rectangle sampling window
+ plot(spp(BP$trees, win=BP$rect, marks=BP$species))
+
+ # a multivariate point pattern in a circular sampling window
+ #with all points inside the sampling window displayed in blue colour
+ #and all points outside displayed with the symbol "+" in red colour
+ plot(spp(BP$trees, win=c(55,45,45), marks=BP$species), out=TRUE, cols=c("blue","blue","blue"),
+ chars.out=c("+","+","+"), cols.out=c("red","red","red"))
+
+ # a marked point pattern in a rectangle sampling window
+ #with circles in green colour
+ plot(spp(BP$trees, win=BP$rect, marks=BP$dbh), cols="green")
+
+ # a marked point pattern in a circular sampling window
+ #with squares in red colour inside and circles in blue colour outside
+ plot(spp(BP$trees, win=c(55,45,45), marks=BP$dbh), out=TRUE, chars="squares",
+ cols="red", cols.out="blue")
+}
+\keyword{spatial}
diff --git a/man/plot.vads.Rd b/man/plot.vads.Rd
new file mode 100755
index 0000000..6deced8
--- /dev/null
+++ b/man/plot.vads.Rd
@@ -0,0 +1,73 @@
+\encoding{latin1}
+\name{plot.vads}
+\alias{plot.vads}
+\alias{plot.vads.dval}
+\alias{plot.vads.k12val}
+\alias{plot.vads.kval}
+\title{Plot local density values}
+\description{
+ Plot local density estimates returned by functions \code{\link{dval},
+ \link{kval} or \link{k12val}}.
+}
+\usage{
+\method{plot}{vads}(x, main, opt, select, chars, cols, maxsize, char0, col0, legend, csize, \dots)
+}
+\arguments{
+ \item{x}{an object of class \code{'vads'} (see Details).}
+ \item{main}{by default, the value of argument x, otherwise a text to be displayed as a title of the plot. \code{main=NULL} displays no title.}
+ \item{opt}{(optional) a character string to change the type of values to be plotted (see Details).}
+ \item{select}{(optional) a vector of selected distances in \code{x$r}. By default, a multiple window displays all distances.}
+ \item{chars}{one of \code{c("circles","squares")} plotting symbols with areas proportional to local density values. By default, circles are plotted.}
+ \item{cols}{(optional) the coulour used for the plotting symbols. Black colour is the default.}
+ \item{maxsize}{(optional) maximum size of the circles/squares plotted. By default, maxsize is automatically adjusted to plot size.}
+ \item{char0}{(optional) the plotting symbol used to represent null values. By default, null values are not plotted.}
+ \item{col0}{(optional) the coulour used for the null values plotting symbol. By default, the same as argument \code{cols}.}
+ \item{legend}{If \code{legend = TRUE} (the default) a legend for the plotting values is displayed.}
+ \item{csize}{scaling factor for font size so that actual font size is \code{par("cex")*csize}. By default \code{csize = 1}.}
+ \item{\dots}{extra arguments that will be passed to the plotting functions \code{\link{plot.swin}}, \cr
+ \code{\link{plot.default}}, \code{\link{symbols}} and/or \code{\link{points}}.}
+}
+\details{
+Function \code{plot.vads} displays a map of first-order local density or second-order local neighbour density values as symbols with areas proportional
+to the values estimated at the plotted points.
+Positive values are represented by coloured symbols, while negative values are represented by open symbols. The plotted function values depend upon the
+type of \code{'vads'} object:
+ \itemize{
+ \item
+ if \code{class(x)=c("vads","dval")}, the plotted values are first-order local densities and argument \code{opt="dval"} by default, but
+ is potentially one of \code{c("dval","cval")} returned by \code{\link{dval}}.\cr
+ \item
+ if \code{class(x)=c("vads","kval")} or \code{class(x)=c("vads","k12val")}, the plotted values are univariate or bivariate second-order
+ local neighbour densities. Argument \code{opt="lval"} by default, but is potentially one of \code{c("lval","kval","nval","gval")}
+ returned by \code{\link{kval}} and \code{\link{k12val}}.
+ }
+}
+\value{
+ none.
+}
+\author{\email{Raphael.Pelissier@ird.fr}}
+\seealso{
+ \code{\link{dval}},
+ \code{\link{kval}},
+ \code{\link{k12val}}.
+}
+\examples{
+ data(BPoirier)
+ BP <- BPoirier
+ # local density in a rectangle sampling window
+ dswr <- dval(spp(BP$trees, win=BP$rect), 25, 1, 11, 9)
+ plot(dswr)
+ # display only distance r from 5 to 10 with null symbols as red crosses
+ plot(dswr, select=c(5:10), char0=3, col0="red")
+
+ # local L(r) values in a circular sampling window
+ lvswc <- kval(spp(BP$trees, win=c(55,45,45)), 25, 0.5)
+ plot(lvswc)
+ # display square symbols in blue for selected values of r and remove title
+ plot(lvswc, chars="squares", cols="blue", select=c(5,7.5,10,12.5,15), main=NULL)
+
+ # local K12(r) values (1="beech", 2="oak") in a complex sampling window
+ k12swrt <- k12val(spp(BP$trees, win=BP$rect, tri=BP$tri1, marks=BP$species), 25, 1)
+ plot(k12swrt, opt="kval")
+}
+\keyword{spatial}
diff --git a/man/spp.Rd b/man/spp.Rd
new file mode 100755
index 0000000..93c86d9
--- /dev/null
+++ b/man/spp.Rd
@@ -0,0 +1,113 @@
+\encoding{latin1}
+\name{spp}
+\alias{spp}
+\alias{print.spp}
+\alias{summary.spp}
+\alias{print.summary.spp}
+\alias{ppp2spp}
+\title{Creating a spatial point pattern}
+\description{
+ Function \code{spp} creates an object of class \code{"spp"}, which represents a
+ spatial point pattern observed in a finite sampling window (or study region).
+ The \code{ads} library supports univariate, multivariate and marked point patterns
+ observed in simple (rectangular or circular) or complex sampling windows.
+}
+\usage{
+spp(x, y=NULL, window, triangles, marks, int2fac=TRUE)
+ppp2spp(p)
+}
+\arguments{
+ \item{x,y}{if \code{y=NULL}, \eqn{x} is a list of two vectors of point coordinates, else both \eqn{x} and \eqn{y} are atomic vectors of point coordinates.}
+ \item{window}{a \code{"swin"} object or a vector defining the limits of a simple sampling
+ window: \code{c(xmin,ymin,xmax,ymax)} for a rectangle ; \code{c(x0,y0,r0)} for a circle.}
+ \item{triangles}{(optional) a list of triangles removed from a simple initial window to define a
+ complex sampling window (see \code{\link{swin}}).}
+ \item{marks}{(optional) a vector of mark values, which may be factor levels or numerical values (see Details).}
+ \item{int2fac}{if TRUE, integer marks are automatically coerced into factor levels.}
+ \item{p}{a \code{"ppp"} object from package \code{spatstat}.}
+}
+\details{
+A spatial point pattern is assumed to have been observed within a specific
+ sampling window (a finite study region) defined by the \code{window} argument. If \code{window} is a simple \code{"swin"} object,
+ it may be coerced into a complex type by adding a \code{triangles} argument (see \code{\link{swin}}). A spatial point pattern may be of 3 different types.
+ \itemize{
+ \item
+ \bold{univariate pattern:}
+ by default when argument \code{marks} is not given.
+ \item
+ \bold{multivariate pattern:}
+ \code{marks} is a factor, which levels are interpreted as categorical marks (e.g. colours, species, etc.) attached to points of the pattern.
+ Integer marks may be automatically coerced into factor levels when argument \code{int2fac = TRUE}.
+ \item
+ \bold{marked pattern:}
+ \code{marks} is a vector of real numbers attached to points of the pattern. Integer values may also be considered as numerical values
+ if argument \code{int2fac = FALSE}.
+ }
+}
+\value{
+ An object of class \code{"spp"} describing a spatial point pattern observed in a given sampling window.
+ \item{\code{$type}}{a character string indicating if the spatial point pattern is \code{"univariate"}, \code{"multivariate"} or \code{"marked"}.}
+ \item{\code{$window}}{an \code{swin} object describing the sampling window (see \code{\link{swin}}).}
+ \item{\code{$n}}{an integer value giving the number of points of the pattern located inside the sampling window (points on the boundary are considered to be inside).}
+ \item{\code{$x}}{a vector of \eqn{x} coordinates of points located inside the sampling window.}
+ \item{\code{$y}}{a vector of \eqn{y} coordinates of points located inside the sampling window.}
+ \item{\code{$nout}}{(optional) an integer value giving the number of points of the pattern located outside the sampling window.}
+ \item{\code{$xout}}{(optional) a vector of \eqn{x} coordinates of points located outside the sampling window.}
+ \item{\code{$yout}}{(optional) a vector of \eqn{y} coordinates of points located outside the sampling window.}
+ \item{\code{$marks}}{(optional) a vector of the marks attached to points located inside the sampling window.}
+ \item{\code{$marksout}}{(optional) a vector of the marks attached to points located outside the sampling window.}
+}
+\references{
+ Goreaud, F. and Pélissier, R. 1999. On explicit formula of edge effect correction for Ripley's \emph{K}-function. \emph{Journal of Vegetation Science}, 10:433-438.
+}
+\note{
+There are printing, summary and plotting methods for \code{"spp"} objects.\cr
+Function \code{ppp2spp} converts an \code{\link[spatstat]{ppp.object}} from package \code{spatstat} into an \code{"spp"} object.
+}
+\seealso{
+ \code{\link{plot.spp}},
+ \code{\link{swin}}
+ }
+\author{
+ \email{Raphael.Pelissier@ird.fr}
+}
+\examples{
+ data(BPoirier)
+ BP <- BPoirier
+ # univariate pattern in a rectangle of size [0,110] x [0,90]
+ swr <- spp(BP$trees, win=BP$rect)
+ # an alternative using atomic vectors of point coordinates
+ #swr <- spp(BP$trees, win=BP$rect)
+ summary(swr)
+ plot(swr)
+
+ # univariate pattern in a circle with radius 50 centred on (55,45)
+ swc <- spp(BP$trees, win=c(55,45,50))
+ summary(swc)
+ plot(swc)
+ plot(swc, out=TRUE) # plot points outside the circle
+
+ # multivariate pattern in a rectangle of size [0,110] x [0,90]
+ swrm <- spp(BP$trees, win=BP$rect, marks=BP$species)
+ summary(swrm)
+ plot(swrm)
+ plot(swrm, chars=c("b","h","o")) # replace symbols by letters
+
+ # marked pattern in a rectangle of size [0,110] x [0,90]
+ swrn <- spp(BP$trees, win=BP$rect, marks=BP$dbh)
+ summary(swrn)
+ plot(swrn)
+
+ # multivariate pattern in a complex sampling window
+ swrt <- spp(BP$trees, win=BP$rect, tri=BP$tri1, marks=BP$species)
+ summary(swrt)
+ plot(swrt)
+ plot(swrt, out=TRUE) # plot points outside the sampling window
+
+
+ #converting a ppp object from spatstat
+ data(demopat)
+ demo.spp<-ppp2spp(demopat)
+ plot(demo.spp)
+}
+\keyword{spatial}
\ No newline at end of file
diff --git a/man/swin.Rd b/man/swin.Rd
new file mode 100755
index 0000000..8fcf150
--- /dev/null
+++ b/man/swin.Rd
@@ -0,0 +1,109 @@
+\encoding{latin1}
+\name{swin}
+\alias{swin}
+\alias{print.swin}
+\alias{summary.swin}
+\alias{print.summary.swin}
+\alias{plot.swin}
+\alias{owin2swin}
+\title{Creating a sampling window}
+\description{
+ Function \code{swin} creates an object of class \code{"swin"}, which represents
+ the sampling window (or study region) in which a spatial point pattern was
+ observed. The \code{ads} library supports simple (rectangular or circular) and complex
+ sampling windows.
+}
+\usage{
+ swin(window, triangles)
+ owin2swin(w)
+}
+\arguments{
+ \item{window}{a vector defining the limits of a simple sampling window: \code{c(xmin,ymin,xmax,ymax)}
+ for a rectangle ; \code{c(x0,y0,r0)} for a circle.}
+ \item{triangles}{(optional) a list of triangles removed from a simple initial window to define a complex
+ sampling window (see Details).}`
+ \item{w}{a \code{"owin"} object from package \code{spatstat}.}
+}
+\details{
+A sampling window may be of simple or complex type. A simple sampling window may be a rectangle or a circle.
+ A complex sampling window is defined by removing triangular surfaces from a simple (rectangular or circular)
+ initial sampling window.
+ \itemize{
+ \item
+ \bold{rectangular window:}
+ \code{window=c(ximn,ymin,xmax,ymax)} a vector of length 4 giving the coordinates \eqn{(ximn,ymin)} and \eqn{(xmax,ymax)}
+ of the origin and the opposite corner of a rectangle.
+ \item
+ \bold{circular window:}
+ \code{window=c(x0,y0,r0)} a vector of length 3 giving the coordinates \eqn{(x0,y0)}
+ of the centre and the radius \eqn{r0} of a circle.
+ \item
+ \bold{complex window:}
+ \code{triangles} is a list of 6 variables giving the vertices coordinates \cr
+ \eqn{(ax,ay,bx,by,cx,cy)} of the triangles to remove from a simple (rectangular or circular) initial window. The triangles may be removed
+ near the boundary of a rectangular window in order to design a polygonal sampling window, or within a rectangle
+ or a circle, to delineating holes in the initial sampling window (see Examples). The triangles do not overlap each other, nor overlap boundary
+ of the initial sampling window. Any polygon (possibly with holes) can be decomposed into contiguous triangles using \code{\link{triangulate}}.
+ }
+}
+\value{
+ An object of class \code{"swin"} describing the sampling window. It may be of four different types
+ with different arguments:
+ \item{\code{$type}}{a vector of two character strings defining the type of sampling window among \code{c("simple","rectangle")}, \code{c("simple","circle")}, \code{c("complex","rectangle")} or \code{c("complex","circle")}.}
+ \item{\code{$xmin,$ymin,$xmax,$ymax}}{(optional) coordinates of the origin and the opposite corner for a rectangular sampling window (see details).}
+ \item{\code{$x0,$y0,$r0}}{(optional) coordinates of the center and radius for a circular sampling window (see details).}
+ \item{\code{$triangles}}{(optional) vertices coordinates of triangles for a complex sampling window (see details).}
+}
+\references{
+ Goreaud, F. and Pélissier, R. 1999. On explicit formula of edge effect correction for Ripley's \emph{K}-function. \emph{Journal of Vegetation Science}, 10:433-438.
+}
+\note{
+There are printing, summary and plotting methods for \code{"swin"} objects.\cr
+Function \code{owin2swin} converts an \code{\link[spatstat]{owin.object}} from package \code{spatstat} into an \code{"swin"} object.
+}
+\seealso{
+ \code{\link{area.swin}},
+ \code{\link{inside.swin}},
+ \code{\link{spp}}
+ }
+\author{
+ \email{Raphael.Pelissier@ird.fr}
+}
+\examples{
+ #rectangle of size [0,110] x [0,90]
+ wr <- swin(c(0,0,110,90))
+ summary(wr)
+ plot(wr)
+
+ #circle with radius 50 centred on (55,45)
+ wc <- swin(c(55,45,50))
+ summary(wc)
+ plot(wc)
+
+ # polygon (diamond shape)
+ t1 <- c(0,0,55,0,0,45)
+ t2 <- c(55,0,110,0,110,45)
+ t3 <- c(0,45,0,90,55,90)
+ t4 <- c(55,90,110,90,110,45)
+ wp <- swin(wr, rbind(t1,t2,t3,t4))
+ summary(wp)
+ plot(wp)
+
+ #rectangle with a hole
+ h1 <- c(25,45,55,75,85,45)
+ h2 <- c(25,45,55,15,85,45)
+ wrh <- swin(wr, rbind(h1,h2))
+ summary(wrh)
+ plot(wrh)
+
+ #circle with a hole
+ wch <- swin(wc, rbind(h1,h2))
+ summary(wch)
+ plot(wch)
+
+ #converting an owin object from spatstat
+ data(demopat)
+ demo.swin<-owin2swin(demopat$window)
+ plot(demo.swin)
+}
+\keyword{spatial}
\ No newline at end of file
diff --git a/man/triangulate.Rd b/man/triangulate.Rd
new file mode 100755
index 0000000..e2a4579
--- /dev/null
+++ b/man/triangulate.Rd
@@ -0,0 +1,61 @@
+\encoding{latin1}
+\name{triangulate}
+\alias{triangulate}
+\title{Triangulate polygon}
+\description{
+ Function \code{triangulate} decomposes a simple polygon (optionally having holes) into contiguous triangles.
+}
+\usage{
+triangulate(outer.poly, holes)
+}
+\arguments{
+ \item{outer.poly}{a list with two component vectors \code{x} and \code{y} giving vertice coordinates of the polygon
+ or a vector \code{(xmin,ymin,xmax,ymax)} giving coordinates \eqn{(ximn,ymin)} and \eqn{(xmax,ymax)} of the origin and the
+ opposite corner of a rectangle sampling window (see \code{\link{swin}}). }
+ \item{holes}{(optional) a list (or a list of list) with two component vectors \code{x} and \code{y} giving vertices
+ coordinates of inner polygon(s) delineating hole(s) within the \code{outer.poly}.}
+}
+\details{
+ In argument \code{outer.poly}, the vertices must be listed following boundary of the polygon without any repetition (i.e. do not repeat the first vertex).
+ Argument \code{holes} may be a list of vertices coordinates of a single hole (i.e. with \eqn{x} and \eqn{y} component vectors) or a list of list for multiple holes,
+ where each \code{holes[[i]]} is a list with \eqn{x} and \eqn{y} component vectors. Holes' vertices must all be inside the \code{outer.poly} boundary (vertices on the boundary
+ are considered outside). Multiple holes do not overlap each others.
+ }
+\value{
+ A list of 6 variables, suitable for using in \code{\link{swin}} and \code{\link{spp}}, and giving the vertices coordinates \eqn{(ax,ay,bx,by,cx,cy)} of the triangles that
+ pave the polygon. For a polygon with \emph{t} holes totalling \eqn{n} vertices (outer contour + holes), the number of triangles produced
+is \eqn{(n-2)+2t}, with \eqn{n<200} in this version of the program.
+}
+\references{
+ Goreaud, F. and Pélissier, R. 1999. On explicit formula of edge effect correction for Ripley's \emph{K}-function. \emph{Journal of Vegetation Science}, 10:433-438.\cr\cr
+ Narkhede, A. & Manocha, D. 1995. Fast polygon triangulation based on Seidel's algoritm. Pp 394-397 In A.W. Paeth (Ed.)
+ \emph{Graphics Gems V}. Academic Press. \url{http://www.cs.unc.edu/~dm/CODE/GEM/chapter.html}.
+}
+\author{
+ \email{Raphael.Pelissier@ird.fr}
+}
+\seealso{
+ \code{\link{spp}},
+ \code{\link{swin}}
+}
+\examples{
+ data(BPoirier)
+ BP <- BPoirier
+ plot(BP$poly1$x, BP$poly1$y)
+
+ # a single polygon triangulation
+ tri1 <- triangulate(BP$poly1)
+ plot(swin(BP$rect, tri1))
+
+ # a single polygon with a hole
+ #tri2 <- triangulate(c(-10,-10,120,100), BP$poly1)
+ #plot(swin(c(-10,-10,120,100), tri2))
+
+ # the same with narrower outer polygon
+ #tri3 <- lapply(BP$poly2,triangulate)
+ #tri3<-do.call(rbind,tri3)
+ #xr<-range(tri3$ax,tri3$bx,tri3$cx)
+ #yr<-range(tri3$ay,tri3$by,tri3$cy)
+ #plot(swin(c(xr[1],yr[1],xr[2],yr[2]), tri3))
+ }
+\keyword{spatial}
diff --git a/src/Zlibs.c b/src/Zlibs.c
new file mode 100755
index 0000000..bbc86e3
--- /dev/null
+++ b/src/Zlibs.c
@@ -0,0 +1,7619 @@
+#include "adssub.h"
+#include "Zlibs.h"
+#include <math.h>
+#include <R.h>
+
+/************************************************************************/
+/*Fonctions de calcul geometriques pour la correction des effets de bord*/
+/************************************************************************/
+/* a exterieur ; b et c interieur*/
+double un_point( double ax, double ay, double bx, double by, double cx, double cy, double x, double y, double d)
+{ double alpha, beta, gamma, delta, ttt, ang;
+ double ex,ey,fx,fy;
+
+ /*premier point d'intersection*/
+ alpha=(bx-ax)*(bx-ax)+(by-ay)*(by-ay);
+ beta=(2*(ax-x)*(bx-ax)+2*(ay-y)*(by-ay));
+ gamma=((ax-x)*(ax-x)+(ay-y)*(ay-y)-d*d);
+ delta=beta*beta-4*alpha*gamma;
+ if (delta<=0)
+ Rprintf("erreur1\n");
+ ttt=(-beta-sqrt(delta))/(2*alpha);
+ if ((ttt<=0)||(ttt>=1))
+ Rprintf("erreur2\n");
+ ex=ax+ttt*(bx-ax);
+ ey=ay+ttt*(by-ay);
+
+ /* deuxieme point d'intersection*/
+ alpha=(cx-ax)*(cx-ax)+(cy-ay)*(cy-ay);
+ beta=(2*(ax-x)*(cx-ax)+2*(ay-y)*(cy-ay));
+ delta=beta*beta-4*alpha*gamma;
+ if (delta<=0)
+ Rprintf("erreur3\n");
+ ttt=(-beta-sqrt(delta))/(2*alpha);
+ if ((ttt<=0)||(ttt>=1))
+ Rprintf("erreur4\n");
+ fx=ax+ttt*(cx-ax);
+ fy=ay+ttt*(cy-ay);
+
+ /*calcul de l'angle*/
+ ang=bacos(((ex-x)*(fx-x)+(ey-y)*(fy-y))/(d*d));
+ return ang;
+}
+
+/* a interieur , b et c exterieur*/
+double deux_point(double ax, double ay, double bx, double by, double cx, double cy,double x, double y, double d)
+{ double alpha, beta, gamma, delta, ttt, ang;
+ double ex,ey,fx,fy,gx,gy,hx,hy;
+ int cas;
+
+ /* premier point d'intersection*/
+ alpha=((bx-ax)*(bx-ax)+(by-ay)*(by-ay));
+ beta=(2*(ax-x)*(bx-ax)+2*(ay-y)*(by-ay));
+ gamma=((ax-x)*(ax-x)+(ay-y)*(ay-y)-d*d);
+ delta=beta*beta-4*alpha*gamma;
+ if (delta<=0)
+ Rprintf("erreur6\n");
+ ttt=(-beta+sqrt(delta))/(2*alpha);
+ if ((ttt<=0)||(ttt>=1))
+ Rprintf("erreur7\n");
+ ex=ax+ttt*(bx-ax);
+ ey=ay+ttt*(by-ay);
+
+ /* deuxieme point d'intersection*/
+ alpha=((cx-ax)*(cx-ax)+(cy-ay)*(cy-ay));
+ beta=(2*(ax-x)*(cx-ax)+2*(ay-y)*(cy-ay));
+ delta=beta*beta-4*alpha*gamma;
+ if (delta<=0)
+ Rprintf("erreur8\n");
+ ttt=(-beta+sqrt(delta))/(2*alpha);
+ if ((ttt<=0)||(ttt>=1))
+ Rprintf("erreur9\n");
+ fx=ax+ttt*(cx-ax);
+ fy=ay+ttt*(cy-ay);
+
+ /* y a t il deux autres intersections?*/
+ cas=0;
+ alpha=((cx-bx)*(cx-bx)+(cy-by)*(cy-by));
+ beta=(2*(bx-x)*(cx-bx)+2*(by-y)*(cy-by));
+ gamma=((bx-x)*(bx-x)+(by-y)*(by-y)-d*d);
+ delta=beta*beta-4*alpha*gamma;
+ if (delta>0)
+ { ttt=(-beta-sqrt(delta))/(2*alpha);
+ if ((ttt>=0)&&(ttt<=1))
+ { gx=bx+ttt*(cx-bx);
+ gy=by+ttt*(cy-by);
+ ttt=(-beta+sqrt(delta))/(2*alpha);
+ if ((ttt>=0)&&(ttt<=1))
+ { cas=1;
+ hx=bx+ttt*(cx-bx);
+ hy=by+ttt*(cy-by);
+ }
+ else
+ Rprintf("erreur9bis\n");
+ }
+ }
+
+ /* calcul de l'angle*/
+ if (cas==0)
+ ang=bacos(((ex-x)*(fx-x)+(ey-y)*(fy-y))/(d*d));
+ else
+ { ang=bacos(((ex-x)*(gx-x)+(ey-y)*(gy-y))/(d*d));
+ ang+=bacos(((fx-x)*(hx-x)+(fy-y)*(hy-y))/(d*d));
+ }
+
+ return ang;
+}
+
+/* a exterieur, b interieur, c sur le bord*/
+double ununun_point(double ax, double ay, double bx, double by, double cx, double cy, double x, double y, double d)
+{ double alpha, beta, gamma, delta, ttt, ang;
+ double ex,ey,fx,fy;
+
+ /* premier point d'intersection sur ab*/
+ alpha=(bx-ax)*(bx-ax)+(by-ay)*(by-ay);
+ beta=(2*(ax-x)*(bx-ax)+2*(ay-y)*(by-ay));
+ gamma=((ax-x)*(ax-x)+(ay-y)*(ay-y)-d*d);
+ delta=beta*beta-4*alpha*gamma;
+ if (delta<=0)
+ Rprintf("erreur1b\n");
+ ttt=(-beta-sqrt(delta))/(2*alpha);
+ if ((ttt<=0)||(ttt>=1))
+ Rprintf("erreur2b\n");
+ ex=ax+ttt*(bx-ax);
+ ey=ay+ttt*(by-ay);
+
+ /* deuxieme point d'intersection ac*/
+ alpha=(cx-ax)*(cx-ax)+(cy-ay)*(cy-ay);
+ beta=(2*(ax-x)*(cx-ax)+2*(ay-y)*(cy-ay));
+ delta=beta*beta-4*alpha*gamma;
+ ttt=1;
+ if (delta>0)
+ { ttt=(-beta-sqrt(delta))/(2*alpha);
+ if ((ttt<=0)||(ttt>1))
+ ttt=1;
+ if (ttt<=0)
+ Rprintf("e3b\n");
+ }
+ fx=ax+ttt*(cx-ax);
+ fy=ay+ttt*(cy-ay);
+
+ /* calcul de l'angle*/
+ ang=bacos(((ex-x)*(fx-x)+(ey-y)*(fy-y))/(d*d));
+ return ang;
+}
+
+/* a,b et c exterieurs*/
+double trois_point(double ax, double ay, double bx, double by, double cx, double cy, double x, double y, double d)
+{ double alpha, beta, gamma, delta, te,tf,tg,th,ti,tj, ang;
+ double ex=0,ey=0,fx=0,fy=0,gx=0,gy=0,hx=0,hy=0,ix=0,iy=0,jx=0,jy=0;
+
+ /* premier segment ab*/
+ alpha=(bx-ax)*(bx-ax)+(by-ay)*(by-ay);
+ beta=2*(ax-x)*(bx-ax)+2*(ay-y)*(by-ay);
+ gamma=(ax-x)*(ax-x)+(ay-y)*(ay-y)-d*d;
+ delta=beta*beta-4*alpha*gamma;
+ if (delta<0)
+ { te=-1;
+ tf=-1;
+ }
+ else
+ { te=(-beta-sqrt(delta))/(2*alpha);
+ tf=(-beta+sqrt(delta))/(2*alpha);
+ if ((te<0)||(te>=1)||(tf==0))
+ { te=-1;
+ tf=-1;
+ }
+ else
+ { ex=ax+te*(bx-ax);
+ ey=ay+te*(by-ay);
+ fx=ax+tf*(bx-ax);
+ fy=ay+tf*(by-ay);
+ if ((tf<=0)||(tf>1))
+ Rprintf("pb te %f tf %f\n",te,tf);
+ }
+ }
+
+ /* deuxieme segment bc*/
+ alpha=(cx-bx)*(cx-bx)+(cy-by)*(cy-by);
+ beta=2*(bx-x)*(cx-bx)+2*(by-y)*(cy-by);
+ gamma=(bx-x)*(bx-x)+(by-y)*(by-y)-d*d;
+ delta=beta*beta-4*alpha*gamma;
+ if (delta<0)
+ { tg=-1;
+ th=-1;
+ }
+ else
+ { tg=(-beta-sqrt(delta))/(2*alpha);
+ th=(-beta+sqrt(delta))/(2*alpha);
+ if ((tg<0)||(tg>=1)||(th==0))
+ { tg=-1;
+ th=-1;
+ }
+ else
+ { gx=bx+tg*(cx-bx);
+ gy=by+tg*(cy-by);
+ hx=bx+th*(cx-bx);
+ hy=by+th*(cy-by);
+ if ((th<=0)||(th>1))
+ Rprintf("pb tg %f th %f\n",tg,th);
+ }
+ }
+
+ /* troisieme segment ca*/
+ alpha=(ax-cx)*(ax-cx)+(ay-cy)*(ay-cy);
+ beta=2*(cx-x)*(ax-cx)+2*(cy-y)*(ay-cy);
+ gamma=(cx-x)*(cx-x)+(cy-y)*(cy-y)-d*d;
+ delta=beta*beta-4*alpha*gamma;
+ if (delta<0)
+ { ti=-1;
+ tj=-1;
+ }
+ else
+ { ti=(-beta-sqrt(delta))/(2*alpha);
+ tj=(-beta+sqrt(delta))/(2*alpha);
+ if ((ti<0)||(ti>=1)||(tj==0))
+ { ti=-1;
+ tj=-1;
+ }
+ else
+ { ix=cx+ti*(ax-cx);
+ iy=cy+ti*(ay-cy);
+ jx=cx+tj*(ax-cx);
+ jy=cy+tj*(ay-cy);
+ if ((tj<=0)||(tj>1))
+ Rprintf("pb ti %f tj %f\n",ti,tj);
+ }
+ }
+
+ /* quelle configuration ?*/
+ if (te<0)
+ { if (tg<0)
+ { if (ti<0)
+ /* pas d'intersection... ouf!*/
+ ang=0;
+ else
+ /* un seul cote (ca) coupe le cercle en i,j*/
+ ang=bacos(((ix-x)*(jx-x)+(iy-y)*(jy-y))/(d*d));
+ }
+ else
+ { if (ti<0)
+ /* un seul cote (bc) coupe le cercle en g,h*/
+ ang=bacos(((gx-x)*(hx-x)+(gy-y)*(hy-y))/(d*d));
+ else
+ { /* deux cotes (bc et ca) coupent le cercle en g,h,i,j*/
+ ang=bacos(((gx-x)*(jx-x)+(gy-y)*(jy-y))/(d*d));
+ ang+=bacos(((hx-x)*(ix-x)+(hy-y)*(iy-y))/(d*d));
+ }
+ }
+ }
+ else
+ { if (tg<0)
+ { if (ti<0)
+ /* un seul cote (ab) coupe le cercle en e,f*/
+ ang=bacos(((ex-x)*(fx-x)+(ey-y)*(fy-y))/(d*d));
+ else
+ { /* deux cotes (ab et ca) coupent le cercle en e,f,i,j*/
+ ang=bacos(((ex-x)*(jx-x)+(ey-y)*(jy-y))/(d*d));
+ ang+=bacos(((fx-x)*(ix-x)+(fy-y)*(iy-y))/(d*d));
+ }
+ }
+ else
+ { if (ti<0)
+ { /* deux cotes (ab et bc) coupent le cercle en e,f,g,h*/
+ ang=bacos(((ex-x)*(hx-x)+(ey-y)*(hy-y))/(d*d));
+ ang+=bacos(((fx-x)*(gx-x)+(fy-y)*(gy-y))/(d*d));
+ }
+ else
+ { /* les trois cotes coupent le cercle*/
+ ang=bacos(((ex-x)*(jx-x)+(ey-y)*(jy-y))/(d*d));
+ ang+=bacos(((hx-x)*(ix-x)+(hy-y)*(iy-y))/(d*d));
+ ang+=bacos(((fx-x)*(gx-x)+(fy-y)*(gy-y))/(d*d));
+ }
+ }
+ }
+
+ /*if ((ang<0)||(ang>Pi()))*/
+ if ((ang<0)||(ang>3.141593))
+ Rprintf("erreur12 : ang=%11.10f, %d %d %d %d %d %d\n",ang,te,tf,tg,th,ti,tj);
+
+ return ang;
+}
+
+/* a est le point sur le bord , b et c exterieur*/
+double deuxun_point(double ax, double ay, double bx, double by, double cx, double cy,double x, double y, double d)
+{ double alpha, beta, gamma, delta, te,tf,tg,th, ang;
+ double ex,ey,fx,fy,gx,gy,hx,hy;
+ int cas;
+
+ /* premier point d'intersection*/
+ alpha=((bx-ax)*(bx-ax)+(by-ay)*(by-ay));
+ beta=(2*(ax-x)*(bx-ax)+2*(ay-y)*(by-ay));
+ gamma=((ax-x)*(ax-x)+(ay-y)*(ay-y)-d*d);
+ delta=beta*beta-4*alpha*gamma;
+ te=0;
+ if (delta>0)
+ { te=(-beta+sqrt(delta))/(2*alpha);
+ if ((te<0)||(te>=1))
+ te=0;
+ if (te>=1)
+ Rprintf("e15\n");
+ }
+ ex=ax+te*(bx-ax);
+ ey=ay+te*(by-ay);
+
+ /* deuxieme point d'intersection*/
+ alpha=((cx-ax)*(cx-ax)+(cy-ay)*(cy-ay));
+ beta=(2*(ax-x)*(cx-ax)+2*(ay-y)*(cy-ay));
+ delta=beta*beta-4*alpha*gamma;
+ tf=0;
+ if (delta>0)
+ { tf=(-beta+sqrt(delta))/(2*alpha);
+ if ((tf<0)||(tf>=1))
+ tf=0;
+ if (tf>=1)
+ Rprintf("e15\n");
+ }
+ fx=ax+tf*(cx-ax);
+ fy=ay+tf*(cy-ay);
+
+ /* y a t il deux autres intersections?*/
+ cas=0;
+ alpha=((cx-bx)*(cx-bx)+(cy-by)*(cy-by));
+ beta=(2*(bx-x)*(cx-bx)+2*(by-y)*(cy-by));
+ gamma=((bx-x)*(bx-x)+(by-y)*(by-y)-d*d);
+ delta=beta*beta-4*alpha*gamma;
+ if (delta>0)
+ { tg=(-beta-sqrt(delta))/(2*alpha);
+ if ((tg>=0)&&(tg<=1))
+ { gx=bx+tg*(cx-bx);
+ gy=by+tg*(cy-by);
+ th=(-beta+sqrt(delta))/(2*alpha);
+ if ((th>=0)&&(th<=1))
+ { cas=1;
+ hx=bx+th*(cx-bx);
+ hy=by+th*(cy-by);
+ }
+ else
+ Rprintf("erreur9ter\n");
+ }
+ }
+
+ /* calcul de l'angle*/
+ if (cas==0)
+ { if ((te==0)&&(tf==0))
+ ang=0;
+ else
+ ang=bacos(((ex-x)*(fx-x)+(ey-y)*(fy-y))/(d*d));
+ }
+ else
+ { ang=bacos(((ex-x)*(gx-x)+(ey-y)*(gy-y))/(d*d));
+ ang+=bacos(((fx-x)*(hx-x)+(fy-y)*(hy-y))/(d*d));
+ }
+ return ang;
+}
+
+/* a exterieur, b et c sur le bord*/
+double deuxbord_point(double ax, double ay, double bx, double by, double cx, double cy, double x, double y, double d)
+{ double alpha, beta, gamma, delta, te,tf, ang;
+ double ex,ey,fx,fy;
+
+ /* premier point d'intersection sur ab*/
+ alpha=(bx-ax)*(bx-ax)+(by-ay)*(by-ay);
+ beta=(2*(ax-x)*(bx-ax)+2*(ay-y)*(by-ay));
+ gamma=((ax-x)*(ax-x)+(ay-y)*(ay-y)-d*d);
+ delta=beta*beta-4*alpha*gamma;
+ te=1;
+ if (delta>0)
+ { te=(-beta-sqrt(delta))/(2*alpha);
+ if ((te<=0)||(te>=1))
+ te=1;
+ if (te<=0)
+ Rprintf("e1t\n");
+ }
+ ex=ax+te*(bx-ax);
+ ey=ay+te*(by-ay);
+
+ /* deuxieme point d'intersection ac*/
+ alpha=(cx-ax)*(cx-ax)+(cy-ay)*(cy-ay);
+ beta=(2*(ax-x)*(cx-ax)+2*(ay-y)*(cy-ay));
+ delta=beta*beta-4*alpha*gamma;
+ tf=1;
+ if (delta>0)
+ { tf=(-beta-sqrt(delta))/(2*alpha);
+ if ((tf<=0)||(tf>=1))
+ tf=1;
+ if (tf<=0)
+ Rprintf("e4t\n");
+ }
+ fx=ax+tf*(cx-ax);
+ fy=ay+tf*(cy-ay);
+
+ /* calcul de l'angle*/
+ ang=bacos(((ex-x)*(fx-x)+(ey-y)*(fy-y))/(d*d));
+ return ang;
+}
+
+/*retourne 1 si le point x,y est du meme cote de la droite (ab) que c (seg=0) ou sur la droite (seg=1)*/
+int in_droite(double x,double y,double ax,double ay,double bx,double by,double cx,double cy,int seg)
+{ double vabx,vaby,vacx,vacy,vamx,vamy,pv1,pv2;
+
+ vabx=bx-ax;
+ vaby=by-ay;
+ vacx=cx-ax;
+ vacy=cy-ay;
+ vamx=x-ax;
+ vamy=y-ay;
+ pv1=vabx*vacy-vaby*vacx;
+ pv2=vabx*vamy-vaby*vamx;
+
+ if(seg==0)
+ { if (((pv1>0)&&(pv2>0))||((pv1<0)&&(pv2<0))) /*pour overlap*/
+ return 1;
+ else
+ return 0;
+ }
+ if(seg==1)
+ { if (((pv1>0)&&(pv2>=0))||((pv1<0)&&(pv2<=0))) /*pour points*/
+ return 1;
+ else
+ return 0;
+ }
+ return -1;
+}
+
+/*retourne 1 si (x,y) est dans le triangle abc (seg=0) ou sur ses bords (seg=1)*/
+int in_triangle(double x,double y,double ax,double ay,double bx,double by,double cx,double cy,int seg)
+{ int res;
+
+ res=0;
+ if (in_droite(x,y,ax,ay,bx,by,cx,cy,seg)==1)
+ if (in_droite(x,y,bx,by,cx,cy,ax,ay,seg)==1)
+ if (in_droite(x,y,cx,cy,ax,ay,bx,by,seg)==1)
+ res=1;
+ return res;
+}
+
+/*Range les resultats pour l'ic*/
+void ic(int i,int i0,double **gic,double **kic,double *gic1,double *kic1,int nbInt) {
+ int j,cro;
+ double mer;
+
+ /*On stocke les 2i0+1 premieres valeurs en les triant au fur et a mesure*/
+ if (i<=2*i0+1) {
+
+ for(j=1;j<=nbInt;j++) {
+ gic[j][i]=gic1[j-1];
+ kic[j][i]=kic1[j-1];
+ }
+
+ /*De la deuxieme a la 2i0+1 eme valeur : on trie la nouvelle valeur en direct*/
+ if (i>1) {
+
+ /*Tri bulle de g vers le bas*/
+ for(j=1;j<=nbInt;j++) {
+ if (gic[j][i-1]>gic[j][i]) {
+ mer=gic[j][i];
+ cro=i-1;
+ while ((cro>0)&&(gic[j][cro]>mer)){
+ gic[j][cro+1]=gic[j][cro];
+ cro=cro-1;
+ }
+ gic[j][cro+1]=mer;
+ }
+ }
+
+ /*Tri bulle de k vers le bas*/
+ for(j=1;j<=nbInt;j++) {
+ if (kic[j][i-1]>kic[j][i]) {
+ mer=kic[j][i];
+ cro=i-1;
+ while ((cro>0)&&(kic[j][cro]>mer)){
+ kic[j][cro+1]=kic[j][cro];
+ cro=cro-1;
+ }
+ kic[j][cro+1]=mer;
+ }
+ }
+ }
+ }
+ else {
+ /*On a deja rempli et trie le tableau des 2i0+1 valeurs, on met la nouvelle valeur en i0*/
+ for(j=1;j<=nbInt;j++) {
+ gic[j][i0+1]=gic1[j-1];
+ kic[j][i0+1]=kic1[j-1];
+ }
+
+ /*On trie les nouvelles valeurs de k et g*/
+ for(j=1;j<=nbInt;j++) {
+
+ /* si g doit descendre*/
+ if (gic[j][i0+1]<gic[j][i0]) {
+ mer=gic[j][i0+1];
+ cro=i0;
+ while ((cro>0)&&(gic[j][cro]>mer))
+ { gic[j][cro+1]=gic[j][cro];
+ cro=cro-1;
+ }
+ gic[j][cro+1]=mer;
+ }
+ /* si g doit monter*/
+ else {
+ if (gic[j][i0+1]>gic[j][i0+2]) {
+ mer=gic[j][i0+1];
+ cro=i0+2;
+ while ((cro<2*i0+2)&&(gic[j][cro]<mer))
+ { gic[j][cro-1]=gic[j][cro];
+ cro=cro+1;
+ }
+ gic[j][cro-1]=mer;
+ }
+ }
+
+ /* si k doit descendre*/
+ if (kic[j][i0+1]<kic[j][i0]) {
+ mer=kic[j][i0+1];
+ cro=i0;
+ while ((cro>0)&&(kic[j][cro]>mer))
+ { kic[j][cro+1]=kic[j][cro];
+ cro=cro-1;
+ }
+ kic[j][cro+1]=mer;
+ }
+ /* si k doit monter*/
+ else {
+ if (kic[j][i0+1]>kic[j][i0+2]) {
+ mer=kic[j][i0+1];
+ cro=i0+2;
+ while ((cro<2*i0+2)&&(kic[j][cro]<mer))
+ { kic[j][cro-1]=kic[j][cro];
+ cro=cro+1;
+ }
+ kic[j][cro-1]=mer;
+ }
+ }
+ }
+ }
+}
+
+/******************************************************************************/
+/* Cette routine donne le perimetre/ddd du cercle centre en (xxx,yyy) et */
+/* de rayon ddd, qui est a l'interieur de la zone rectangulaire xmi xma ymiyma*/
+/* Elle traite les cas 1 bord, 2 bords d'angle (2), 2 bords opposes, 3 bords */
+/* Ce resultat correspond a la correction des effets de bord pour Ripley */
+/******************************************************************************/
+double perim_in_rect(double xxx, double yyy, double ddd, double xmi, double xma, double ymi, double yma)
+{ double d1,d2,d3,d4;
+
+ if ((xxx>=xmi+ddd)&&(yyy>=ymi+ddd)&&(xxx<=xma-ddd)&&(yyy<=yma-ddd))
+ { /*Rprintf("*");*/
+ return 2*Pi();
+ }
+ else
+ { d1=(xxx-xmi)/ddd;
+ d2=(yyy-ymi)/ddd;
+ d3=(xma-xxx)/ddd;
+ d4=(yma-yyy)/ddd;
+ if (d1>=1)
+ { if (d2>=1)
+ { if (d3>=1)
+ { if (d4>=1) /* cercle dans le rectangle */
+ { return 2*Pi();
+ }
+ else /* bord seul en d4 */
+ {
+ return (2*(Pi()-acos(d4)));
+ }
+ }
+ else
+ { if (d4>=1) /* bord seul en d3 */
+ {
+ return (2*(Pi()-acos(d3)));
+ }
+ else /* 2 bords d3 et d4 */
+ {
+ if (d3*d3+d4*d4<1)
+ {
+ return (1.5*Pi()-acos(d3)-acos(d4));
+ }
+ else
+ {
+ return (2*(Pi()-acos(d3)-acos(d4)));
+ }
+ }
+ }
+ }
+ else
+ { if (d3>=1)
+ { if (d4>=1) /* bord seul en d2 */
+ {
+ return (2*(Pi()-acos(d2)));
+ }
+ else /* 2 bords d2 et d4 */
+ {
+ return (2*(Pi()-acos(d2)-acos(d4)));
+ }
+ }
+ else
+ { if (d4>=1) /* 2 bords d2 et d3 */
+ { if (d2*d2+d3*d3<1)
+ {
+ return ((1.5*Pi()-acos(d2)-acos(d3)));
+ }
+ else
+ {
+ return (2*(Pi()-acos(d2)-acos(d3)));
+ }
+ }
+ else /* 3 bords d2,d3,d4 */
+ { if (d2*d2+d3*d3<1)
+ { if (d3*d3+d4*d4<1)
+ {
+ return((Pi()-acos(d2)-acos(d4)));
+ }
+ else
+ {
+ return((1.5*Pi()-acos(d2)-acos(d3)-2*acos(d4)));
+ }
+ }
+ else
+ { if (d3*d3+d4*d4<1)
+ {
+ return((1.5*Pi()-2*acos(d2)-acos(d3)-acos(d4)));
+ }
+ else
+ {
+ return(2*(Pi()-acos(d2)-acos(d3)-acos(d4)));
+ }
+ }
+ }
+ }
+ }
+ }
+ else
+ {
+ if (d2>=1)
+ {
+ if (d3>=1)
+ {
+ if (d4>=1) /* bord seul en d1 */
+ {
+ return (2*(Pi()-acos(d1)));
+ }
+ else /* 2 bords d1 et d4 */
+ {
+ if (d1*d1+d4*d4<1)
+ {
+ return ((1.5*Pi()-acos(d1)-acos(d4)));
+ }
+ else
+ {
+ return (2*(Pi()-acos(d1)-acos(d4)));
+ }
+ }
+ }
+ else
+ { if (d4>=1) /* 2 bords d1 et d3 */
+ {
+ return (2*(Pi()-acos(d1)-acos(d3)));
+ }
+ else /* 3 bords d1,d3,d4 */
+ {
+ if (d3*d3+d4*d4<1)
+ { if (d4*d4+d1*d1<1)
+ {
+ return ((Pi()-acos(d3)-acos(d1)));
+ }
+ else
+ {
+ return ((1.5*Pi()-acos(d3)-acos(d4)-2*acos(d1)));
+ }
+ }
+ else
+ {
+ if (d4*d4+d1*d1<1)
+ {
+ return ((1.5*Pi()-2*acos(d3)-acos(d4)-acos(d1)));
+ }
+ else
+ {
+ return (2*(Pi()-acos(d3)-acos(d4)-acos(d1)));
+ }
+ }
+ }
+ }
+ }
+ else
+ {
+ if (d3>=1)
+ {
+ if (d4>=1) /* 2 bords d1 et d2 */
+ {
+ if (d1*d1+d2*d2<1)
+ {
+ return ((1.5*Pi()-acos(d1)-acos(d2)));
+ }
+ else
+ {
+ return (2*(Pi()-acos(d1)-acos(d2)));
+ }
+ }
+ else /* 3 bords d1,d2,d4 */
+ {
+ if (d4*d4+d1*d1<1)
+ {
+ if (d1*d1+d2*d2<1)
+ {
+ return ((Pi()-acos(d4)-acos(d2)));
+ }
+ else
+ {
+ return ((1.5*Pi()-acos(d4)-acos(d1)-2*acos(d2)));
+ }
+ }
+ else
+ {
+ if (d1*d1+d2*d2<1)
+ {
+ return ((1.5*Pi()-2*acos(d4)-acos(d1)-acos(d2)));
+ }
+ else
+ {
+ return (2*(Pi()-acos(d4)-acos(d1)-acos(d2)));
+ }
+ }
+ }
+ }
+ else
+ { if (d4>=1) /* 3 bords d1,d2,d3 */
+ { if (d1*d1+d2*d2<1)
+ { if (d2*d2+d3*d3<1)
+ { return ((Pi()-acos(d1)-acos(d3)));
+ }
+ else
+ { return ((1.5*Pi()-acos(d1)-acos(d2)-2*acos(d3)));
+ }
+ }
+ else
+ { if (d2*d2+d3*d3<1)
+ { return ((1.5*Pi()-2*acos(d1)-acos(d2)-acos(d3)));
+ }
+ else
+ { return (2*(Pi()-acos(d1)-acos(d2)-acos(d3)));
+ }
+ }
+ }
+ else /* 4 bords : je ne peux pas faire */
+ { Rprintf("erreur : le nombre d'intervalles est trop grand\n");
+ return -1;
+ }
+ }
+ }
+ }
+ }
+}
+
+/*pour une zone circulaire definie par x0, y0, r0*/
+double perim_in_disq(double xxx, double yyy, double ddd,
+ double x0, double y0,double r0)
+{ double d1;
+
+ d1=sqrt((xxx-x0)*(xxx-x0)+(yyy-y0)*(yyy-y0));
+ if (d1+ddd<=r0)
+ return 2*Pi();
+ else
+ return 2*(Pi()-acos((r0*r0-d1*d1-ddd*ddd)/(2*d1*ddd)));
+}
+
+/* renvoie la somme des angles du perim a l'interieur des triangles*/
+double perim_triangle(double x,double y, double d, int triangle_nb, double *ax,double *ay, double *bx, double *by, double *cx, double *cy)
+{ double angle, epsilon;
+ double doa,dob,doc;
+ int h;
+ //int i;
+
+ epsilon=0.0001;
+ angle=0;
+
+
+ for(h=0;h<triangle_nb;h++)
+ { doa=sqrt((x-ax[h])*(x-ax[h])+(y-ay[h])*(y-ay[h]));
+ dob=sqrt((x-bx[h])*(x-bx[h])+(y-by[h])*(y-by[h]));
+ doc=sqrt((x-cx[h])*(x-cx[h])+(y-cy[h])*(y-cy[h]));
+
+ if (doa-d<-epsilon)
+ { if (dob-d<-epsilon)
+ { if (doc-d<-epsilon)
+ //i=1
+ ; /* le triangle est dans le cercle, TVB*/
+ else if (doc-d>epsilon)
+ angle+=un_point(cx[h],cy[h],ax[h],ay[h],bx[h],by[h],x,y,d);
+ else
+ //i=1
+ ; /* le triangle est dans le cercle, TVB*/
+ }
+ else if (dob-d>epsilon)
+ { if (doc-d<-epsilon)
+ angle+=un_point(bx[h],by[h],ax[h],ay[h],cx[h],cy[h],x,y,d);
+ else if (doc-d>epsilon)
+ angle+=deux_point(ax[h],ay[h],bx[h],by[h],cx[h],cy[h],x,y,d);
+ else
+ angle+=ununun_point(bx[h],by[h],ax[h],ay[h],cx[h],cy[h],x,y,d);
+ }
+ else /* b sur le bord*/
+ { if (doc-d<-epsilon)
+ //i=1
+ ; /* le triangle est dans le cercle, TVB*/
+ else if (doc-d>epsilon)
+ angle+=ununun_point(cx[h],cy[h],ax[h],ay[h],bx[h],by[h],x,y,d);
+ else
+ //i=1
+ ; /* le triangle est dans le cercle, TVB*/
+ }
+ }
+ else if (doa-d>epsilon)
+ { if (dob-d<-epsilon)
+ { if (doc-d<-epsilon)
+ angle+=un_point(ax[h],ay[h],bx[h],by[h],cx[h],cy[h],x,y,d);
+ else if (doc-d>epsilon)
+ angle+=deux_point(bx[h],by[h],ax[h],ay[h],cx[h],cy[h],x,y,d);
+ else
+ angle+=ununun_point(ax[h],ay[h],bx[h],by[h],cx[h],cy[h],x,y,d);
+ }
+ else if (dob-d>epsilon)
+ { if (doc-d<-epsilon)
+ angle+=deux_point(cx[h],cy[h],ax[h],ay[h],bx[h],by[h],x,y,d);
+ else if (doc-d>epsilon)
+ angle+=trois_point(ax[h],ay[h],bx[h],by[h],cx[h],cy[h],x,y,d);
+ else
+ angle+=deuxun_point(cx[h],cy[h],ax[h],ay[h],bx[h],by[h],x,y,d);
+ }
+ else /* b sur le bord*/
+ { if (doc-d<-epsilon)
+ angle+=ununun_point(ax[h],ay[h],cx[h],cy[h],bx[h],by[h],x,y,d);
+ else if (doc-d>epsilon)
+ angle+=deuxun_point(bx[h],by[h],ax[h],ay[h],cx[h],cy[h],x,y,d);
+ else
+ angle+=deuxbord_point(ax[h],ay[h],bx[h],by[h],cx[h],cy[h],x,y,d);
+ }
+ }
+ else /* a sur le bord*/
+ { if (dob-d<-epsilon)
+ { if (doc-d<-epsilon)
+ //i=1
+ ; /* le triangle est dans le cercle, TVB*/
+ else if (doc-d>epsilon)
+ angle+=ununun_point(cx[h],cy[h],bx[h],by[h],ax[h],ay[h],x,y,d);
+ else
+ //i=1
+ ; /* le triangle est dans le cercle, TVB*/
+ }
+ else if (dob-d>epsilon)
+ { if (doc-d<-epsilon)
+ angle+=ununun_point(bx[h],by[h],cx[h],cy[h],ax[h],ay[h],x,y,d);
+ else if (doc-d>epsilon)
+ angle+=deuxun_point(ax[h],ay[h],bx[h],by[h],cx[h],cy[h],x,y,d);
+ else
+ angle+=deuxbord_point(bx[h],by[h],ax[h],ay[h],cx[h],cy[h],x,y,d);
+ }
+ else /* b sur le bord*/
+ { if (doc-d<-epsilon)
+ //i=1
+ ; /* le triangle est dans le cercle, TVB*/
+ else if (doc-d>epsilon)
+ angle+=deuxbord_point(cx[h],cy[h],ax[h],ay[h],bx[h],by[h],x,y,d);
+ else
+ //i=1
+ ; /* le triangle est dans le cercle, TVB*/
+ }
+ }
+ }
+
+ return angle;
+}
+
+
+
+
+
+
+/******************************************************************************/
+/* Calcule la fonction de Ripley K(r) pour un semis (x,y) en parametres */
+/* dans une zone de forme rectangulaire de bornes xmi xma ymi yma */
+/* Les corrections des effets de bords sont fait par la methode de Ripley, */
+/* i.e. l'inverse de la proportion d'arc de cercle inclu dans la fenetre. */
+/* Les calculs sont faits pour les t2 premiers intervalles de largeur dt. */
+/* La routine calcule g, densite des couples de points; et la fonction K */
+/* Les resultats sont stockes dans des tableaux g et k donnes en parametres */
+/******************************************************************************/
+
+int ripley_rect(int *point_nb,double *x,double *y, double *xmi,double *xma,double *ymi,double *yma,
+int *t2,double *dt,double *g,double *k)
+{ int i,j,tt;
+ double d,cin;
+
+ /*Decalage pour n'avoir que des valeurs positives*/
+ decalRect(*point_nb,x,y,xmi,xma,ymi,yma);
+
+ /* On rangera dans g le nombre de couples de points par distance tt*/
+ for(tt=0;tt<*t2;tt++)
+ { g[tt]=0;
+ }
+
+ /*On regarde les couples (i,j) et (j,i) : donc pour i>j seulement*/
+ for(i=1;i<*point_nb;i++)
+ { for(j=0;j<i;j++)
+ { d=sqrt((x[i]-x[j])*(x[i]-x[j])+(y[i]-y[j])*(y[i]-y[j]));
+ if (d<*t2*(*dt)){
+ /* dans quelle classe de distance est ce couple ?*/
+ tt=d/(*dt);
+
+ /*pour [i,j] : correction des effets de bord*/
+ cin=perim_in_rect(x[i],y[i],d,*xmi,*xma,*ymi,*yma);
+ if (cin<0)
+ { Rprintf("cin<0 sur i AVANT\n");
+ return -1;
+ }
+ g[tt]+=2*Pi()/cin;
+
+ /* pour [j,i] : correction des effets de bord*/
+ cin=perim_in_rect(x[j],y[j],d,*xmi,*xma,*ymi,*yma);
+ if (cin<0)
+ { Rprintf("cin<0 sur j AVANT\n");
+ return -1;
+ }
+ g[tt]+=2*Pi()/cin;
+ }
+ }
+ }
+
+ /* on moyenne -> densite*/
+ for(tt=0;tt<*t2;tt++) {
+ g[tt]=g[tt]/(*point_nb);
+ }
+
+ /* on integre*/
+ k[0]=g[0];
+ for(tt=1;tt<*t2;tt++)
+ { k[tt]=k[tt-1]+g[tt];
+ }
+
+ return 0;
+}
+
+/*fonction de Ripley pour une zone circulaire*/
+int ripley_disq(int *point_nb, double *x, double *y, double *x0, double *y0, double *r0,
+int *t2, double *dt, double *g, double *k)
+{ int tt,i,j;
+ double d,cin;
+
+ /*Decalage pour n'avoir que des valeurs positives*/
+ decalCirc(*point_nb,x,y,x0,y0,*r0);
+
+ for(tt=0;tt<*t2;tt++) {
+ g[tt]=0;
+ }
+ for(i=1;i<*point_nb;i++) { /*On calcule le nombre de couples de points par distance g*/
+ for(j=0;j<i;j++)
+ { d=sqrt((x[i]-x[j])*(x[i]-x[j])+(y[i]-y[j])*(y[i]-y[j]));
+ if (d<*t2*(*dt))
+ { tt=d/(*dt);
+
+ /*pour [i,j] : correction des effets de bord*/
+ cin=perim_in_disq(x[i],y[i],d,*x0,*y0,*r0);
+ if (cin<0)
+ { Rprintf("cin<0 sur i AVANT\n");
+ return -1;
+ }
+ g[tt]+=2*Pi()/cin;
+
+ /*pour [j,i] : correction des effets de bord*/
+ cin=perim_in_disq(x[j],y[j],d,*x0,*y0,*r0);
+ if (cin<0)
+ { Rprintf("cin<0 sur j AVANT\n");
+ return -1;
+ }
+ g[tt]+=2*Pi()/cin;
+ }
+ }
+ }
+
+ /* on moyenne -> densite*/
+ for(tt=0;tt<*t2;tt++)
+ { g[tt]=g[tt]/(*point_nb);
+ }
+
+ /* on integre*/
+ k[0]=g[0];
+ for(tt=1;tt<*t2;tt++)
+ { k[tt]=k[tt-1]+g[tt];
+ }
+
+ return 0;
+}
+
+/*Ripley triangles dans rectangle*/
+int ripley_tr_rect(int *point_nb, double *x, double *y, double *xmi, double *xma, double *ymi, double *yma,
+int *triangle_nb, double *ax, double *ay, double *bx, double *by, double *cx, double *cy,
+int *t2, double *dt, double *g, double *k)
+{ int i,j,tt;
+ double d,cin;
+
+ /*Decalage pour n'avoir que des valeurs positives*/
+ decalRectTri(*point_nb,x,y,xmi,xma,ymi,yma,*triangle_nb,ax,ay,bx,by,cx,cy);
+
+ /* On calcule le nombre de couples de points par distance g*/
+ for(tt=0;tt<*t2;tt++)
+ { g[tt]=0;
+ }
+ for(i=1;i<*point_nb;i++)
+ for(j=0;j<i;j++)
+ { d=sqrt((x[i]-x[j])*(x[i]-x[j])+(y[i]-y[j])*(y[i]-y[j]));
+ if (d<*t2*(*dt))
+ { tt=d/(*dt);
+
+ /*pour [i,j] : correction des effets de bord*/
+ cin=perim_in_rect(x[i],y[i],d,*xmi,*xma,*ymi,*yma);
+ if (cin<0)
+ { Rprintf("cin<0 sur i AVANT\n");
+ return -1;
+ }
+ cin=cin-perim_triangle(x[i],y[i],d,*triangle_nb,ax,ay,bx,by,cx,cy);
+ if (cin<0)
+ { Rprintf("Overlapping triangles\n");
+ return -1;
+ }
+ g[tt]+=2*Pi()/cin;
+
+ /*pour [j,i] : correction des effets de bord*/
+ cin=perim_in_rect(x[j],y[j],d,*xmi,*xma,*ymi,*yma);
+ if (cin<0)
+ { Rprintf("cin<0 sur j AVANT\n");
+ return -1;
+ }
+ cin=cin-perim_triangle(x[j],y[j],d,*triangle_nb,ax,ay,bx,by,cx,cy);
+ if (cin<0)
+ { Rprintf("Overlapping triangles\n");
+ return -1;
+ }
+ g[tt]+=2*Pi()/cin;
+ }
+ }
+
+ /* on moyenne -> densite*/
+ for(tt=0;tt<*t2;tt++) {
+ g[tt]=g[tt]/(*point_nb);
+ }
+
+ /* on integre*/
+ k[0]=g[0];
+ for(tt=1;tt<*t2;tt++) {
+ k[tt]=k[tt-1]+g[tt];
+ }
+
+ return 0;
+}
+
+/*Ripley triangle dans disque*/
+int ripley_tr_disq(int *point_nb,double *x,double *y,double *x0,double *y0,double *r0,int *triangle_nb,
+double *ax,double *ay,double *bx,double *by,double *cx,double *cy,
+int *t2,double *dt,double *g,double *k)
+{ int i,j,tt;
+ double d,cin;
+
+ /*Decalage pour n'avoir que des valeurs positives*/
+ decalCircTri(*point_nb,x,y,x0,y0,*r0,*triangle_nb,ax,ay,bx,by,cx,cy);
+
+ /* On calcule le nombre de couples de points par distance g*/
+ for(tt=0;tt<*t2;tt++)
+ { g[tt]=0;
+ }
+ for(i=1;i<*point_nb;i++)
+ for(j=0;j<i;j++)
+ { d=sqrt((x[i]-x[j])*(x[i]-x[j])+(y[i]-y[j])*(y[i]-y[j]));
+ if (d<*t2*(*dt))
+ { tt=d/(*dt);
+
+ /* pour [i,j] : correction des effets de bord*/
+ cin=perim_in_disq(x[i],y[i],d,*x0,*y0,*r0);
+ if (cin<0)
+ { Rprintf("cin<0 sur i AVANT\n");
+ return -1;
+ }
+ cin=cin-perim_triangle(x[i],y[i],d,*triangle_nb,ax,ay,bx,by,cx,cy);
+ if (cin<0)
+ { Rprintf("Overlapping triangles\n");
+ return -1;
+ }
+ g[tt]+=2*Pi()/cin;
+
+ /* pour [j,i] : correction des effets de bord*/
+ cin=perim_in_disq(x[j],y[j],d,*x0,*y0,*r0);
+ if (cin<0)
+ { Rprintf("cin<0 sur j AVANT\n");
+ return -1;
+ }
+ cin=cin-perim_triangle(x[j],y[j],d,*triangle_nb,ax,ay,bx,by,cx,cy);
+ if (cin<0)
+ { Rprintf("Overlapping triangles\n");
+ return -1;
+ }
+ g[tt]+=2*Pi()/cin;
+ }
+ }
+
+ /* on moyenne -> densite*/
+ for(tt=0;tt<*t2;tt++)
+ { g[tt]=g[tt]/(*point_nb);
+ }
+
+ /* on integre*/
+ k[0]=g[0];
+ for(tt=1;tt<*t2;tt++)
+ { k[tt]=k[tt-1]+g[tt];
+ }
+
+ return 0;
+}
+
+/*fonction de Ripley avec intervalle de confiance pour une zone rectangulaire*/
+int ripley_rect_ic(int *point_nb,double *x,double *y, double *xmi,double *xma,double *ymi,double *yma,double *densite,
+int *t2,double *dt,int *nbSimu, double *prec, double *lev,double *g,double *k,
+double *gic1,double *gic2, double *kic1,double *kic2, double *gval, double *kval, double *lval, double *nval) {
+ int i,j,i0,i1,i2;
+ double **gic,**kic;
+ double *gg,*kk,*ll,*nn;
+ int erreur=0;
+
+ erreur=ripley_rect(point_nb,x,y,xmi,xma,ymi,yma,t2,dt,g,k);
+ if (erreur!=0)
+ { return -1;
+ }
+
+ /*Definition de i0 : indice ou sera stocke l'estimation des bornes de l'IC*/
+ i0=*lev/2*(*nbSimu+1);
+ if (i0<1) i0=1;
+
+ /*Initialisation des tableaux dans lesquels on va stocker les valeurs extremes lors de MC*/
+ taballoc(&gic,*t2+1,2*i0+10+1);
+ taballoc(&kic,*t2+1,2*i0+10+1);
+
+
+ /*Normalisation de g et k et calcul de l et n pour le calcul des p-values*/
+ vecalloc(&gg,*t2);
+ vecalloc(&kk,*t2);
+ vecalloc(&ll,*t2);
+ vecalloc(&nn,*t2);
+ for(i=0;i<*t2;i++)
+ { gg[i]=g[i]/(*densite*(Pi()*(i+1)*(i+1)*(*dt)*(*dt)-Pi()*i*i*(*dt)*(*dt)));
+ nn[i]=k[i]/(Pi()*(i+1)*(i+1)*(*dt)*(*dt));
+ kk[i]=k[i]/(*densite);
+ ll[i]=sqrt(kk[i]/Pi())-(i+1)*(*dt);
+ gval[i]=1;
+ kval[i]=1;
+ nval[i]=1;
+ lval[i]=1;
+ }
+
+ int lp=0;
+
+ /*boucle principale de MC*/
+ Rprintf("Monte Carlo simulation\n");
+ for(i=1;i<=*nbSimu;i++)
+ { s_alea_rect(*point_nb,x,y,*xmi,*xma,*ymi,*yma,*prec);
+ erreur=ripley_rect(point_nb,x,y,xmi,xma,ymi,yma,t2,dt,gic1,kic1);
+ /* si il y a une erreur on recommence une simulation*/
+ if (erreur!=0)
+ { i=i-1;
+ Rprintf("ERREUR Ripley\n");
+ }
+ else {
+ /*comptage du nombre de |¶obs|<=|¶simu| pour test local*/
+ double gictmp,kictmp,lictmp,nictmp;
+ for(j=0;j<*t2;j++)
+ { gictmp=gic1[j]/(*densite*(Pi()*(j+1)*(j+1)*(*dt)*(*dt)-Pi()*j*j*(*dt)*(*dt)));
+ nictmp=kic1[j]/(Pi()*(j+1)*(j+1)*(*dt)*(*dt));
+ kictmp=kic1[j]/(*densite);
+ lictmp=sqrt(kictmp/Pi())-(j+1)*(*dt);
+ if ((float)fabs(gg[j]-1)<=(float)fabs(gictmp-1)) {gval[j]+=1;}
+ if ((float)fabs(nn[j]-*densite)<=(float)fabs(nictmp-*densite)) {nval[j]+=1;}
+ if ((float)fabs(kk[j]-Pi()*(j+1)*(j+1)*(*dt)*(*dt))<=(float)fabs(kictmp-Pi()*(j+1)*(j+1)*(*dt)*(*dt))) {kval[j]+=1;}
+ if ((float)fabs(ll[j])<=(float)fabs(lictmp)) {lval[j]+=1;}
+ }
+
+ /*Traitement des resultats*/
+ ic(i,i0,gic,kic,gic1,kic1,*t2);
+ }
+ R_FlushConsole();
+ progress(i,&lp,*nbSimu);
+ }
+
+ i1=i0+2;
+ i2=i0;
+
+ /*Copies des valeurs dans les tableaux resultats*/
+ for(i=0;i<*t2;i++)
+ { gic1[i]=gic[i+1][i1];
+ gic2[i]=gic[i+1][i2];
+ kic1[i]=kic[i+1][i1];
+ kic2[i]=kic[i+1][i2];
+ }
+
+ freetab(gic);
+ freetab(kic);
+ freevec(gg);
+ freevec(kk);
+ freevec(ll);
+ freevec(nn);
+
+ return 0;
+}
+
+/*fonction de Ripley avec intervalle de confiance pour une zone circulaire*/
+int ripley_disq_ic(int *point_nb,double *x,double *y, double *x0,double *y0,double *r0,double *densite,
+int *t2,double *dt,int *nbSimu, double *prec, double *lev,double *g,double *k,
+double *gic1,double *gic2, double *kic1,double *kic2, double *gval, double *kval, double *lval, double *nval)
+{
+ int i,j,i0,i1,i2;
+ double **gic,**kic;
+ double *gg,*kk,*ll,*nn;
+ int erreur=0;
+
+ erreur=ripley_disq(point_nb,x,y,x0,y0,r0,t2,dt,g,k);
+ if (erreur!=0)
+ { return -1;
+ }
+
+ /*Definition de i0 : indice ou sera stocke l'estimation des bornes de l'IC*/
+ i0=*lev/2*(*nbSimu+1);
+ if (i0<1) i0=1;
+
+ /*Initialisation des tableaux dans lesquels on va stocker les valeurs extremes lors de MC*/
+ taballoc(&gic,*t2+1,2*i0+10+1);
+ taballoc(&kic,*t2+1,2*i0+10+1);
+
+ /*Normalisation de g et k et calcul de l et n pour le calcul des p-values*/
+ vecalloc(&gg,*t2);
+ vecalloc(&kk,*t2);
+ vecalloc(&ll,*t2);
+ vecalloc(&nn,*t2);
+ for(i=0;i<*t2;i++) {
+ gg[i]=g[i]/(*densite*(Pi()*(i+1)*(i+1)*(*dt)*(*dt)-Pi()*i*i*(*dt)*(*dt)));
+ nn[i]=k[i]/(Pi()*(i+1)*(i+1)*(*dt)*(*dt));
+ kk[i]=k[i]/(*densite);
+ ll[i]=sqrt(kk[i]/Pi())-(i+1)*(*dt);
+ gval[i]=1;
+ kval[i]=1;
+ nval[i]=1;
+ lval[i]=1;
+ }
+
+ int lp=0;
+
+ /* boucle principale de MC*/
+ Rprintf("Monte Carlo simulation\n");
+ for(i=1;i<=*nbSimu;i++) {
+ s_alea_disq(*point_nb,x,y,*x0,*y0,*r0,*prec);
+ erreur=ripley_disq(point_nb,x,y,x0,y0,r0,t2,dt,gic1,kic1);
+ /* si il y a une erreur on recommence une simulation*/
+ if (erreur!=0)
+ { i--;
+ Rprintf("ERREUR Ripley\n");
+ }
+ else
+ { /*comptage du nombre de |¶obs|<=|¶simu| pour test local*/
+ double gictmp,kictmp,lictmp,nictmp;
+ for(j=0;j<*t2;j++)
+ { gictmp=gic1[j]/(*densite*(Pi()*(j+1)*(j+1)*(*dt)*(*dt)-Pi()*j*j*(*dt)*(*dt)));
+ nictmp=kic1[j]/(Pi()*(j+1)*(j+1)*(*dt)*(*dt));
+ kictmp=kic1[j]/(*densite);
+ lictmp=sqrt(kictmp/Pi())-(j+1)*(*dt);
+ if ((float)fabs(gg[j]-1)<=(float)fabs(gictmp-1)) {gval[j]+=1;}
+ if ((float)fabs(nn[j]-*densite)<=(float)fabs(nictmp-*densite)) {nval[j]+=1;}
+ if ((float)fabs(kk[j]-Pi()*(j+1)*(j+1)*(*dt)*(*dt))<=(float)fabs(kictmp-Pi()*(j+1)*(j+1)*(*dt)*(*dt))) {kval[j]+=1;}
+ if ((float)fabs(ll[j])<=(float)fabs(lictmp)) {lval[j]+=1;}
+ }
+
+ /*Traitement des resultats*/
+ ic(i,i0,gic,kic,gic1,kic1,*t2);
+ }
+ R_FlushConsole();
+ progress(i,&lp,*nbSimu);
+ }
+
+ i1=i0+2;
+ i2=i0;
+
+ /*Copies des valeurs dans les tableaux resultats*/
+ for(i=0;i<*t2;i++) {
+ gic1[i]=gic[i+1][i1];
+ gic2[i]=gic[i+1][i2];
+ kic1[i]=kic[i+1][i1];
+ kic2[i]=kic[i+1][i2];
+ }
+
+ freetab(gic);
+ freetab(kic);
+ freevec(gg);
+ freevec(kk);
+ freevec(ll);
+ freevec(nn);
+
+ return 0;
+}
+
+/*fonction de Ripley avec intervalle de confiance pour une zone rectangulaire + triangles*/
+int ripley_tr_rect_ic(int *point_nb,double *x,double *y, double *xmi,double *xma,double *ymi,double *yma,double *densite,
+int *triangle_nb, double *ax, double *ay, double *bx, double *by, double *cx, double *cy,
+int *t2,double *dt,int *nbSimu, double *prec, double *lev,double *g,double *k,
+double *gic1,double *gic2, double *kic1,double *kic2, double *gval, double *kval, double *lval, double *nval) {
+ int i,j,i0,i1,i2;
+ double **gic,**kic;
+ double *gg,*kk,*ll,*nn;
+ int erreur=0;
+
+ erreur=ripley_tr_rect(point_nb,x,y,xmi,xma,ymi,yma,triangle_nb,ax,ay,bx,by,cx,cy,t2,dt,g,k);
+ if (erreur!=0) {
+ return -1;
+ }
+
+ /* definition de i0 : indice ou sera stocké l'estimation des bornes de l'IC*/
+ i0=*lev/2*(*nbSimu+1);
+ if (i0<1) i0=1;
+
+ /*Initialisation des tableaux dans lesquels on va stocker les valeurs extremes lors de MC*/
+ taballoc(&gic,*t2+1,2*i0+10+1);
+ taballoc(&kic,*t2+1,2*i0+10+1);
+
+ /*Normalisation de g et k et calcul de l et n pour le calcul des p-values*/
+ vecalloc(&gg,*t2);
+ vecalloc(&kk,*t2);
+ vecalloc(&ll,*t2);
+ vecalloc(&nn,*t2);
+ for(i=0;i<*t2;i++)
+ { gg[i]=g[i]/(*densite*(Pi()*(i+1)*(i+1)*(*dt)*(*dt)-Pi()*i*i*(*dt)*(*dt)));
+ nn[i]=k[i]/(Pi()*(i+1)*(i+1)*(*dt)*(*dt));
+ kk[i]=k[i]/(*densite);
+ ll[i]=sqrt(kk[i]/Pi())-(i+1)*(*dt);
+ gval[i]=1;
+ kval[i]=1;
+ nval[i]=1;
+ lval[i]=1;
+ }
+
+ int lp=0;
+
+ /* boucle principale de MC*/
+ Rprintf("Monte Carlo simulation\n");
+ for(i=1;i<=*nbSimu;i++)
+ { s_alea_tr_rect(*point_nb,x,y,*xmi,*xma,*ymi,*yma,*triangle_nb,ax,ay,bx,by,cx,cy,*prec);
+ erreur=ripley_tr_rect(point_nb,x,y,xmi,xma,ymi,yma,triangle_nb,ax,ay,bx,by,cx,cy,t2,dt,gic1,kic1);
+
+ /* si il y a une erreur on recommence une simulation*/
+ if (erreur!=0)
+ { i=i-1;
+ Rprintf("ERREUR Ripley\n");
+ }
+ else
+ { /*comptage du nombre de |¶obs|<=|¶simu| pour test local*/
+ double gictmp,kictmp,lictmp,nictmp;
+ for(j=0;j<*t2;j++)
+ { gictmp=gic1[j]/(*densite*(Pi()*(j+1)*(j+1)*(*dt)*(*dt)-Pi()*j*j*(*dt)*(*dt)));
+ nictmp=kic1[j]/(Pi()*(j+1)*(j+1)*(*dt)*(*dt));
+ kictmp=kic1[j]/(*densite);
+ lictmp=sqrt(kictmp/Pi())-(j+1)*(*dt);
+ if ((float)fabs(gg[j]-1)<=(float)fabs(gictmp-1)) {gval[j]+=1;}
+ if ((float)fabs(nn[j]-*densite)<=(float)fabs(nictmp-*densite)) {nval[j]+=1;}
+ if ((float)fabs(kk[j]-Pi()*(j+1)*(j+1)*(*dt)*(*dt))<=(float)fabs(kictmp-Pi()*(j+1)*(j+1)*(*dt)*(*dt))) {kval[j]+=1;}
+ if ((float)fabs(ll[j])<=(float)fabs(lictmp)) {lval[j]+=1;}
+ }
+
+ /*Traitement des resultats*/
+ ic(i,i0,gic,kic,gic1,kic1,*t2);
+ }
+ R_FlushConsole();
+ progress(i,&lp,*nbSimu);
+ }
+
+ i1=i0+2;
+ i2=i0;
+
+ /*Copies des valeurs dans les tableaux resultats*/
+ for(i=0;i<*t2;i++)
+ { gic1[i]=gic[i+1][i1];
+ gic2[i]=gic[i+1][i2];
+ kic1[i]=kic[i+1][i1];
+ kic2[i]=kic[i+1][i2];
+ }
+
+ freetab(gic);
+ freetab(kic);
+ freevec(gg);
+ freevec(kk);
+ freevec(ll);
+ freevec(nn);
+
+ return 0;
+}
+
+/*fonction de Ripley avec intervalle de confiance pour une zone circulaire + triangles*/
+int ripley_tr_disq_ic(int *point_nb,double *x,double *y, double *x0,double *y0,double *r0,double *densite,
+int *triangle_nb, double *ax, double *ay, double *bx, double *by, double *cx, double *cy,
+int *t2,double *dt,int *nbSimu, double *prec, double *lev,double *g,double *k,
+double *gic1,double *gic2, double *kic1,double *kic2, double *gval, double *kval, double *lval, double *nval)
+{ int i,j,i0,i1,i2;
+ double **gic,**kic;
+ double *gg,*kk,*ll,*nn;
+ int erreur=0;
+
+ erreur=ripley_tr_disq(point_nb,x,y,x0,y0,r0,triangle_nb,ax,ay,bx,by,cx,cy,t2,dt,g,k);
+ if (erreur!=0)
+ { return -1;
+ }
+
+ /* definition de i0 : indice ou sera stocke l'estimation des bornes de l'IC*/
+ i0=*lev/2*(*nbSimu+1);
+ if (i0<1) i0=1;
+
+ /*Initialisation des tableaux dans lesquels on va stocker les valeurs extremes lors de MC*/
+ taballoc(&gic,*t2+1,2*i0+10+1);
+ taballoc(&kic,*t2+1,2*i0+10+1);
+
+
+ /*Normalisation de g et k et calcul de l et n pour le calcul des p-values*/
+ vecalloc(&gg,*t2);
+ vecalloc(&kk,*t2);
+ vecalloc(&ll,*t2);
+ vecalloc(&nn,*t2);
+ for(i=0;i<*t2;i++)
+ { gg[i]=g[i]/(*densite*(Pi()*(i+1)*(i+1)*(*dt)*(*dt)-Pi()*i*i*(*dt)*(*dt)));
+ nn[i]=k[i]/(Pi()*(i+1)*(i+1)*(*dt)*(*dt));
+ kk[i]=k[i]/(*densite);
+ ll[i]=sqrt(kk[i]/Pi())-(i+1)*(*dt);
+ gval[i]=1;
+ kval[i]=1;
+ nval[i]=1;
+ lval[i]=1;
+ }
+
+ int lp=0;
+
+ /* boucle principale de MC*/
+ Rprintf("Monte Carlo simulation\n");
+ for(i=1;i<=*nbSimu;i++) {
+
+ s_alea_tr_disq(*point_nb,x,y,*x0,*y0,*r0,*triangle_nb,ax,ay,bx,by,cx,cy,*prec);
+ erreur=ripley_tr_disq(point_nb,x,y,x0,y0,r0,triangle_nb,ax,ay,bx,by,cx,cy,t2,dt,gic1,kic1);
+
+ /* si il y a une erreur on recommence une simulation*/
+ if (erreur!=0) {
+ i=i-1;
+ Rprintf("ERREUR Ripley\n");
+ }
+ else {
+ /*comptage du nombre de |¶obs|<=|¶simu| pour test local*/
+ double gictmp,kictmp,lictmp,nictmp;
+ for(j=0;j<*t2;j++)
+ { gictmp=gic1[j]/(*densite*(Pi()*(j+1)*(j+1)*(*dt)*(*dt)-Pi()*j*j*(*dt)*(*dt)));
+ nictmp=kic1[j]/(Pi()*(j+1)*(j+1)*(*dt)*(*dt));
+ kictmp=kic1[j]/(*densite);
+ lictmp=sqrt(kictmp/Pi())-(j+1)*(*dt);
+ if ((float)fabs(gg[j]-1)<=(float)fabs(gictmp-1)) {gval[j]+=1;}
+ if ((float)fabs(nn[j]-*densite)<=(float)fabs(nictmp-*densite)) {nval[j]+=1;}
+ if ((float)fabs(kk[j]-Pi()*(j+1)*(j+1)*(*dt)*(*dt))<=(float)fabs(kictmp-Pi()*(j+1)*(j+1)*(*dt)*(*dt))) {kval[j]+=1;}
+ if ((float)fabs(ll[j])<=(float)fabs(lictmp)) {lval[j]+=1;}
+ }
+
+ /*Traitement des résultats*/
+ ic(i,i0,gic,kic,gic1,kic1,*t2);
+ }
+ R_FlushConsole();
+ progress(i,&lp,*nbSimu);
+ }
+
+ i1=i0+2;
+ i2=i0;
+
+ /*Copies des valeurs dans les tableaux résultats*/
+ for(i=0;i<*t2;i++) {
+ gic1[i]=gic[i+1][i1];
+ gic2[i]=gic[i+1][i2];
+ kic1[i]=kic[i+1][i1];
+ kic2[i]=kic[i+1][i2];
+ }
+
+ freetab(gic);
+ freetab(kic);
+ freevec(gg);
+ freevec(kk);
+ freevec(ll);
+ freevec(nn);
+
+ return 0;
+}
+
+/*fonction de Ripley locale pour une zone rectangulaire*/
+int ripleylocal_rect(int *point_nb,double *x,double *y,double *xmi,double *xma,double *ymi,double *yma,
+int *t2,double *dt,double *gi,double *ki)
+{ int tt,i,j;
+ double d,cin;
+ double **g, **k;
+
+ /*Decalage pour n'avoir que des valeurs positives*/
+ decalRect(*point_nb,x,y,xmi,xma,ymi,yma);
+
+
+ taballoc(&g,*point_nb,*t2);
+ taballoc(&k,*point_nb,*t2);
+
+ for(i=0;i<*point_nb;i++)
+ for(tt=0;tt<*t2;tt++)
+ g[i][tt]=0;
+
+ for(i=1;i<*point_nb;i++) /* On calcule le nombre de couples de points par distance g */
+ for(j=0;j<i;j++)
+ { d=sqrt((x[i]-x[j])*(x[i]-x[j])+(y[i]-y[j])*(y[i]-y[j]));
+ if (d<*t2*(*dt)) {
+ tt=d/(*dt);
+
+ /* pour [i,j] : correction des effets de bord*/
+ cin=perim_in_rect(x[i],y[i],d,*xmi,*xma,*ymi,*yma);
+ if (cin<0) {
+ Rprintf("cin<0 sur i AVANT\n");
+ return -1;
+ }
+ g[i][tt]+=2*Pi()/cin;
+
+ /*pour [j,i] : correction des effets de bord*/
+ cin=perim_in_rect(x[j],y[j],d,*xmi,*xma,*ymi,*yma);
+ if (cin<0) {
+ Rprintf("cin<0 sur j AVANT\n");
+ return -1;
+ }
+ g[j][tt]+=2*Pi()/cin;
+ }
+ }
+
+ for(i=0;i<*point_nb;i++)
+ { k[i][0]=g[i][0];
+ for(tt=1;tt<*t2;tt++)
+ k[i][tt]=k[i][tt-1]+g[i][tt]; /* on integre */
+ }
+
+ /*Copies des valeurs dans les tableaux resultat*/
+ for(i=0;i<*point_nb;i++) {
+ for(tt=0;tt<*t2;tt++) {
+ gi[i*(*t2)+tt]=g[i][tt];
+ ki[i*(*t2)+tt]=k[i][tt];
+ }
+ }
+
+ freetab(g);
+ freetab(k);
+
+ return 0;
+}
+
+/*fonction de Ripley locale pour une zone circulaire*/
+int ripleylocal_disq(int *point_nb,double *x,double *y,double *x0,double *y0,double *r0,
+int *t2,double *dt,double *gi,double *ki)
+{ int tt,i,j;
+ double d,cin;
+ double **g, **k;
+
+ /*Decalage pour n'avoir que des valeurs positives*/
+ decalCirc(*point_nb,x,y,x0,y0,*r0);
+
+ taballoc(&g,*point_nb,*t2);
+ taballoc(&k,*point_nb,*t2);
+
+ for(i=0;i<*point_nb;i++)
+ for(tt=0;tt<*t2;tt++)
+ g[i][tt]=0;
+ for(i=1;i<*point_nb;i++) /* On calcule le nombre de couples de points par distance g */
+ for(j=0;j<i;j++)
+ { d=sqrt((x[i]-x[j])*(x[i]-x[j])+(y[i]-y[j])*(y[i]-y[j]));
+ if (d<*t2*(*dt))
+ { tt=d/(*dt);
+
+ /*pour [i,j] : correction des effets de bord*/
+ cin=perim_in_disq(x[i],y[i],d,*x0,*y0,*r0);
+ if (cin<0) {
+ Rprintf("cin<0 sur i AVANT\n");
+ return -1;
+ }
+ g[i][tt]+=2*Pi()/cin;
+
+ /*pour [j,i] : correction des effets de bord*/
+ cin=perim_in_disq(x[j],y[j],d,*x0,*y0,*r0);
+ if (cin<0) {
+ Rprintf("cin<0 sur j AVANT\n");
+ return -1;
+ }
+ g[j][tt]+=2*Pi()/cin;
+ }
+ }
+
+ for(i=0;i<*point_nb;i++)
+ { k[i][0]=g[i][0];
+ for(tt=1;tt<*t2;tt++)
+ k[i][tt]+=k[i][tt-1]+g[i][tt]; /* on integre */
+ }
+
+ /*Copies des valeurs dans les tableaux resultat*/
+ for(i=0;i<*point_nb;i++) {
+ for(tt=0;tt<*t2;tt++) {
+ gi[i*(*t2)+tt]=g[i][tt];
+ ki[i*(*t2)+tt]=k[i][tt];
+ }
+ }
+
+ freetab(g);
+ freetab(k);
+
+ return 0;
+}
+
+/*fonction de Ripley locale triangles dans rectangle*/
+int ripleylocal_tr_rect(int *point_nb,double *x,double *y,double *xmi,double *xma,double *ymi,double *yma,
+int *triangle_nb,double *ax,double *ay,double *bx,double *by,double *cx,double *cy,
+int *t2,double *dt,double *gi,double *ki)
+{ int tt,i,j;
+ double d,cin;
+ double **g, **k;
+
+ /*Decalage pour n'avoir que des valeurs positives*/
+ decalRectTri(*point_nb,x,y,xmi,xma,ymi,yma,*triangle_nb,ax,ay,bx,by,cx,cy);
+
+ taballoc(&g,*point_nb,*t2);
+ taballoc(&k,*point_nb,*t2);
+
+ for(i=0;i<*point_nb;i++)
+ for(tt=0;tt<*t2;tt++)
+ g[i][tt]=0;
+
+ for(i=1;i<*point_nb;i++) /* On calcule le nombre de couples de points par distance g */
+ for(j=0;j<i;j++)
+ { d=sqrt((x[i]-x[j])*(x[i]-x[j])+(y[i]-y[j])*(y[i]-y[j]));
+ if (d<*t2*(*dt))
+ { tt=d/(*dt);
+
+ /*pour [i,j] : correction des effets de bord*/
+ cin=perim_in_rect(x[i],y[i],d,*xmi,*xma,*ymi,*yma);
+ if (cin<0) {
+ Rprintf("cin<0 sur i AVANT\n");
+ return -1;
+ }
+ cin=cin-perim_triangle(x[i],y[i],d,*triangle_nb,ax,ay,bx,by,cx,cy);
+ if (cin<0) {
+ Rprintf("Overlapping triangles\n");
+ return -1;
+ }
+ g[i][tt]+=2*Pi()/cin;
+
+ /*pour [j,i] : correction des effets de bord*/
+ cin=perim_in_rect(x[j],y[j],d,*xmi,*xma,*ymi,*yma);
+ if (cin<0) {
+ Rprintf("cin<0 sur j AVANT\n");
+ return -1;
+ }
+ cin=cin-perim_triangle(x[j],y[j],d,*triangle_nb,ax,ay,bx,by,cx,cy);
+ if (cin<0) {
+ Rprintf("Overlapping triangles\n");
+ return -1;
+ }
+ g[j][tt]+=2*Pi()/cin;
+ }
+ }
+
+ for(i=0;i<*point_nb;i++)
+ { k[i][0]=g[i][0];
+ for(tt=1;tt<*t2;tt++)
+ k[i][tt]=k[i][tt-1]+g[i][tt]; /* on integre */
+ }
+
+ /*Copies des valeurs dans les tableaux resultat*/
+ for(i=0;i<*point_nb;i++) {
+ for(tt=0;tt<*t2;tt++) {
+ gi[i*(*t2)+tt]=g[i][tt];
+ ki[i*(*t2)+tt]=k[i][tt];
+ }
+ }
+
+ freetab(g);
+ freetab(k);
+
+ return 0;
+}
+
+/*fonction de Ripley locale triangles dans cercle*/
+int ripleylocal_tr_disq(int *point_nb,double *x,double *y,double *x0,double *y0,double *r0,
+int *triangle_nb,double *ax,double *ay,double *bx,double *by,double *cx,double *cy,
+int *t2,double *dt,double *gi,double *ki)
+{ int tt,i,j;
+ double d,cin;
+ double **g, **k;
+
+ /*Decalage pour n'avoir que des valeurs positives*/
+ decalCircTri(*point_nb,x,y,x0,y0,*r0,*triangle_nb,ax,ay,bx,by,cx,cy);
+ taballoc(&g,*point_nb,*t2);
+ taballoc(&k,*point_nb,*t2);
+
+ for(i=0;i<*point_nb;i++)
+ for(tt=0;tt<*t2;tt++)
+ g[i][tt]=0;
+ for(i=1;i<*point_nb;i++) /* On calcule le nombre de couples de points par distance g */
+ for(j=0;j<i;j++)
+ { d=sqrt((x[i]-x[j])*(x[i]-x[j])+(y[i]-y[j])*(y[i]-y[j]));
+ if (d<*t2*(*dt))
+ { tt=d/(*dt);
+
+ /* pour [i,j] : correction des effets de bord*/
+ cin=perim_in_disq(x[i],y[i],d,*x0,*y0,*r0);
+ if (cin<0) {
+ Rprintf("cin<0 sur i AVANT\n");
+ return -1;
+ }
+ cin=cin-perim_triangle(x[i],y[i],d,*triangle_nb,ax,ay,bx,by,cx,cy);
+ if (cin<0) {
+ Rprintf("Overlapping triangles\n");
+ return -1;
+ }
+ g[i][tt]+=2*Pi()/cin;
+
+ /*pour [j,i] : correction des effets de bord*/
+ cin=perim_in_disq(x[j],y[j],d,*x0,*y0,*r0);
+ if (cin<0) {
+ Rprintf("cin<0 sur j AVANT\n");
+ return -1;
+ }
+ cin=cin-perim_triangle(x[j],y[j],d,*triangle_nb,ax,ay,bx,by,cx,cy);
+ if (cin<0) {
+ Rprintf("Overlapping triangles\n");
+ return -1;
+ }
+ g[j][tt]+=2*Pi()/cin;
+ }
+ }
+
+ for(i=0;i<*point_nb;i++)
+ { k[i][0]=g[i][0];
+ for(tt=1;tt<*t2;tt++)
+ k[i][tt]+=k[i][tt-1]+g[i][tt]; /* on integre */
+ }
+
+ /*Copies des valeurs dans les tableaux resultat*/
+ for(i=0;i<*point_nb;i++) {
+ for(tt=0;tt<*t2;tt++) {
+ gi[i*(*t2)+tt]=g[i][tt];
+ ki[i*(*t2)+tt]=k[i][tt];
+ }
+ }
+
+ freetab(g);
+ freetab(k);
+
+ return 0;
+}
+
+/*Densite locale pour une zone rectangulaire*/
+int density_rect(int *point_nb,double *x,double *y,double *xmi,double *xma,double *ymi,
+double *yma, int *t2, double *dt, double *xx,double *yy,int *sample_nb,double *count)
+{ int tt,i,j;
+ double ddd,cin;
+ double **s;
+
+ /*Decalage pour n'avoir que des valeurs positives*/
+ decalSample(*sample_nb,xx,yy,*xmi,*ymi);
+ decalRect(*point_nb,x,y,xmi,xma,ymi,yma);
+ taballoc(&s,*sample_nb,*t2);
+
+ for(j=0;j<*sample_nb;j++)
+ { for(tt=0;tt<*t2;tt++)
+ s[j][tt]=0;
+ for(i=0;i<*point_nb;i++) /* On calcule le nombre de voisins dans chaque disque de rayon r*/
+ { ddd=sqrt((xx[j]-x[i])*(xx[j]-x[i])+(yy[j]-y[i])*(yy[j]-y[i]));
+ if (ddd<*t2*(*dt)) {
+ tt=ddd/(*dt);
+
+ /* correction des effets de bord*/
+ cin=perim_in_rect(xx[j],yy[j],ddd,*xmi,*xma,*ymi,*yma);
+ if (cin<0) {
+ Rprintf("cin<0 sur i AVANT\n");
+ return -1;
+ }
+ s[j][tt]+=2*Pi()/cin;
+ }
+ }
+ }
+ for(i=0;i<*sample_nb;i++)
+ for(tt=1;tt<*t2;tt++)
+ s[i][tt]+=s[i][tt-1]; /* on integre*/
+
+ /*Copies des valeurs dans le tableau resultat*/
+ for(i=0;i<*sample_nb;i++)
+ for(tt=0;tt<*t2;tt++)
+ count[i*(*t2)+tt]=s[i][tt];
+
+ freetab(s);
+
+ return 0;
+}
+
+/*Densite locale pour une zone circulaire*/
+int density_disq(int *point_nb,double *x,double *y,double *x0,double *y0,double *r0,
+ int *t2,double *dt,double *xx,double *yy,int *sample_nb,double *count)
+{ int tt,i,j;
+ double ddd,cin;
+ double **s;
+
+ /*Decalage pour n'avoir que des valeurs positives*/
+ decalSample(*sample_nb,xx,yy,*x0-*r0,*y0-*r0);
+ decalCirc(*point_nb,x,y,x0,y0,*r0);
+
+
+ taballoc(&s,*sample_nb,*t2);
+
+ for(j=0;j<*sample_nb;j++)
+ { for(tt=0;tt<*t2;tt++)
+ s[j][tt]=0;
+ for(i=0;i<*point_nb;i++) /* On calcule le nombre de voisins dans chaque disque de rayon r*/
+ { ddd=sqrt((xx[j]-x[i])*(xx[j]-x[i])+(yy[j]-y[i])*(yy[j]-y[i]));
+ if (ddd<*t2*(*dt))
+ { tt=ddd/(*dt);
+
+ /* correction des effets de bord*/
+ cin=perim_in_disq(xx[j],yy[j],ddd,*x0,*y0,*r0);
+ if (cin<0) {
+ Rprintf("cin<0 sur i AVANT\n");
+ return -1;
+ }
+ s[j][tt]+=2*Pi()/cin;
+ }
+ }
+ }
+ for(i=0;i<*sample_nb;i++)
+ for(tt=1;tt<*t2;tt++)
+ s[i][tt]+=s[i][tt-1]; /* on integre*/
+
+ /*Copies des valeurs dans le tableau resultat*/
+ for(i=0;i<*sample_nb;i++)
+ for(tt=0;tt<*t2;tt++)
+ count[i*(*t2)+tt]=s[i][tt];
+
+
+ freetab(s);
+
+ return 0;
+}
+
+/*Densite locale pour triangles dans rectangle*/
+int density_tr_rect(int *point_nb,double *x,double *y,double *xmi,double *xma,
+ double *ymi,double *yma,int *triangle_nb,double *ax,double *ay,double *bx,
+ double *by,double *cx,double *cy,int *t2,double *dt,double *xx,
+ double *yy,int *sample_nb,double *count)
+{ int tt,i,j;
+ double ddd,cin;
+ double **s;
+
+ /*Decalage pour n'avoir que des valeurs positives*/
+ decalSample(*sample_nb,xx,yy,*xmi,*ymi);
+ decalRectTri(*point_nb,x,y,xmi,xma,ymi,yma,*triangle_nb,ax,ay,bx,by,cx,cy);
+ taballoc(&s,*sample_nb,*t2);
+
+ for(j=0;j<*sample_nb;j++)
+ { for(tt=0;tt<*t2;tt++)
+ s[j][tt]=0;
+ for(i=0;i<*point_nb;i++) /* On calcule le nombre de voisins dans chaque disque de rayon r*/
+ { ddd=sqrt((xx[j]-x[i])*(xx[j]-x[i])+(yy[j]-y[i])*(yy[j]-y[i]));
+ if (ddd<*t2*(*dt))
+ { tt=ddd/(*dt);
+
+ /*correction des effets de bord*/
+ cin=perim_in_rect(xx[j],yy[j],ddd,*xmi,*xma,*ymi,*yma);
+ if (cin<0) {
+ Rprintf("cin<0 sur i AVANT\n");
+ return -1;
+ }
+ cin=cin-perim_triangle(xx[j],yy[j],ddd,*triangle_nb,ax,ay,bx,by,cx,cy);
+ if (cin<0) {
+ Rprintf("Overlapping triangles\n");
+ return -1;
+ }
+ s[j][tt]+=2*Pi()/cin;
+ }
+ }
+ }
+ for(i=0;i<*sample_nb;i++)
+ for(tt=1;tt<*t2;tt++)
+ s[i][tt]+=s[i][tt-1]; /* on integre */
+
+/* Copies des valeurs dans le tableau resultat*/
+ for(i=0;i<*sample_nb;i++)
+ for(tt=0;tt<*t2;tt++)
+ count[i*(*t2)+tt]=s[i][tt];
+
+ freetab(s);
+
+ return 0;
+}
+
+/*Densite locale pour triangles dans cercle*/
+int density_tr_disq(int *point_nb,double *x,double *y,double *x0,double *y0,double *r0,
+ int *triangle_nb,double *ax,double *ay,double *bx,double *by,
+ double *cx,double *cy,int *t2,double *dt,double *xx,double *yy,
+ int *sample_nb,double *count)
+{ int tt,i,j;
+ double ddd,cin;
+ double **s;
+
+ /*Decalage pour n'avoir que des valeurs positives*/
+ decalSample(*sample_nb,xx,yy,*x0-*r0,*y0-*r0);
+ decalCircTri(*point_nb,x,y,x0,y0,*r0,*triangle_nb,ax,ay,bx,by,cx,cy);
+ taballoc(&s,*sample_nb,*t2);
+
+ for(j=0;j<*sample_nb;j++)
+ { for(tt=0;tt<*t2;tt++)
+ s[j][tt]=0;
+ for(i=0;i<*point_nb;i++) /* On calcule le nombre de voisins dans chaque disque de rayon r*/
+ { ddd=sqrt((xx[j]-x[i])*(xx[j]-x[i])+(yy[j]-y[i])*(yy[j]-y[i]));
+ if (ddd<*t2*(*dt))
+ { tt=ddd/(*dt);
+
+ /*correction des effets de bord*/
+ cin=perim_in_disq(xx[j],yy[j],ddd,*x0,*y0,*r0);
+ if (cin<0) {
+ Rprintf("cin<0 sur i AVANT\n");
+ return -1;
+ }
+ cin=cin-perim_triangle(xx[j],yy[j],ddd,*triangle_nb,ax,ay,bx,by,cx,cy);
+ if (cin<0) {
+ Rprintf("Overlapping triangles\n");
+ return -1;
+ }
+ s[j][tt]+=2*Pi()/cin;
+ }
+ }
+ }
+ for(i=0;i<*sample_nb;i++)
+ for(tt=1;tt<*t2;tt++)
+ s[i][tt]+=s[i][tt-1]; /* on integre*/
+
+ /*Copies des valeurs dans le tableau resultat*/
+ for(i=0;i<*sample_nb;i++)
+ for(tt=0;tt<*t2;tt++)
+ count[i*(*t2)+tt]=s[i][tt];
+
+ freetab(s);
+
+ return 0;
+}
+
+/******************************************************************************/
+/* Calcule la fonction intertype pour les semis (x,y) et (x2,y2) en parametres*/
+/* dans une zone de forme rectangulaire de bornes xmi xma ymi yma */
+/* Les corrections des effets de bords sont fait par la methode de Ripley, */
+/* i.e. l'inverse de la proportion d'arc de cercle inclu dans la fenetre. */
+/* Les calculs sont faits pour les t2 premiers intervalles de largeur dt. */
+/* La routine calcule g12, densite des couples de points; et la fonction K12 */
+/* Les resultats sont stockes dans des tableaux g et k donnes en parametres */
+/******************************************************************************/
+
+int intertype_rect(int *point_nb1,double *x1,double *y1,int *point_nb2, double *x2, double *y2,
+double *xmi,double *xma,double *ymi,double *yma,int *t2,double *dt,double *g,double *k)
+{ int i,j,tt;
+ double d,cin;
+
+ /*Decalage pour n'avoir que des valeurs positives*/
+ decalRect2(*point_nb1,x1,y1,*point_nb2,x2,y2,xmi,xma,ymi,yma);
+
+ /*On rangera dans g le nombre de couples de points par distance tt*/
+ for(tt=0;tt<*t2;tt++)
+ { g[tt]=0;
+ }
+
+ /* On regarde tous les couples (i,j)*/
+ for(i=0;i<*point_nb1;i++)
+ { for(j=0;j<*point_nb2;j++)
+ { d=sqrt((x1[i]-x2[j])*(x1[i]-x2[j])+(y1[i]-y2[j])*(y1[i]-y2[j]));
+ if (d<*t2*(*dt))
+ { /* dans quelle classe de distance est ce couple ?*/
+ tt=d/(*dt);
+ /* correction des effets de bord*/
+ cin=perim_in_rect(x1[i],y1[i],d,*xmi,*xma,*ymi,*yma);
+ if (cin<0) {
+ Rprintf("\ncin<0 sur i AVANT");
+ return -1;
+ }
+ g[tt]+=2*Pi()/cin;
+ }
+ }
+ }
+
+ /* on moyenne -> densite*/
+ for(tt=0;tt<*t2;tt++)
+ { g[tt]=g[tt]/(*point_nb1);
+ }
+
+ /*on integre*/
+ k[0]=g[0];
+ for(tt=1;tt<*t2;tt++)
+ { k[tt]=k[tt-1]+g[tt];
+ }
+
+ return 0;
+}
+
+/*fonction intertype pour une zone circulaire*/
+int intertype_disq(int *point_nb1, double *x1, double *y1, int *point_nb2, double *x2,
+ double *y2, double *x0, double *y0, double *r0,int *t2, double *dt, double *g, double *k)
+{ int tt,i,j;
+ double d,cin;
+
+ /*Decalage pour n'avoir que des valeurs positives*/
+ decalCirc2(*point_nb1,x1,y1,*point_nb2,x2,y2,x0,y0,*r0);
+
+ for(tt=0;tt<*t2;tt++) {
+ g[tt]=0;
+ }
+ for(i=0;i<*point_nb1;i++) /* On calcule le nombre de couples de points par distance g*/
+ for(j=0;j<*point_nb2;j++)
+ { d=sqrt((x1[i]-x2[j])*(x1[i]-x2[j])+(y1[i]-y2[j])*(y1[i]-y2[j]));
+ if (d<*t2*(*dt))
+ { tt=d/(*dt);
+
+ /* correction des effets de bord*/
+ cin=perim_in_disq(x1[i],y1[i],d,*x0,*y0,*r0);
+ if (cin<0) {
+ Rprintf("\ncin<0 sur i AVANT");
+ return -1;
+ }
+ g[tt]+=2*Pi()/cin;
+ }
+ }
+
+ /* on moyenne -> densite*/
+ for(tt=0;tt<*t2;tt++) {
+ g[tt]=g[tt]/(*point_nb1);
+ }
+
+ /* on integre*/
+ k[0]=g[0];
+ for(tt=1;tt<*t2;tt++) {
+ k[tt]=k[tt-1]+g[tt];
+ }
+
+ return 0;
+}
+
+/*Intertype triangles dans rectangle*/
+int intertype_tr_rect(int *point_nb1,double *x1,double *y1,int *point_nb2,double *x2,double *y2,
+double *xmi,double *xma,double *ymi,double *yma,int *triangle_nb,double *ax,double *ay,double *bx,double *by,
+double *cx,double *cy,int *t2,double *dt,double *g,double *k)
+{ int i,j,tt;
+ double d,cin;
+
+ /*Decalage pour n'avoir que des valeurs positives*/
+ decalRectTri2(*point_nb1,x1,y1,*point_nb2,x2,y2,xmi,xma,ymi,yma,*triangle_nb,ax,ay,bx,by,cx,cy);
+
+ /* On calcule le nombre de couples de points par distance g*/
+ for(tt=0;tt<*t2;tt++){
+ g[tt]=0;
+ }
+ for(i=0;i<*point_nb1;i++)
+ for(j=0;j<*point_nb2;j++)
+ { d=sqrt((x1[i]-x2[j])*(x1[i]-x2[j])+(y1[i]-y2[j])*(y1[i]-y2[j]));
+ if (d<*t2*(*dt))
+ { tt=d/(*dt);
+ cin=perim_in_rect(x1[i],y1[i],d,*xmi,*xma,*ymi,*yma);
+ if (cin<0) {
+ Rprintf("\ncin<0 sur i AVANT");
+ return -1;
+ }
+ cin=cin-perim_triangle(x1[i],y1[i],d,*triangle_nb,ax,ay,bx,by,cx,cy);
+ if (cin<0) {
+ Rprintf("Overlapping triangles\n");
+ return -1;
+ }
+ g[tt]+=2*Pi()/cin;
+ }
+ }
+
+ /* on moyenne -> densite*/
+ for(tt=0;tt<*t2;tt++) {
+ g[tt]=g[tt]/(*point_nb1);
+ }
+
+ /* on integre*/
+ k[0]=g[0];
+ for(tt=1;tt<*t2;tt++){
+ k[tt]=k[tt-1]+g[tt];
+ }
+
+ return 0;
+}
+
+/*Intertype triangles dans cercle*/
+int intertype_tr_disq(int *point_nb1,double *x1,double *y1,int *point_nb2,double *x2,double *y2,
+double *x0,double *y0,double *r0,int *triangle_nb,double *ax,double *ay,double *bx,double *by,
+double *cx,double *cy,int *t2,double *dt,double *g,double *k)
+{ int i,j,tt;
+ double d,cin;
+
+ /*Decalage pour n'avoir que des valeurs positives*/
+ decalCircTri2(*point_nb1,x1,y1,*point_nb2,x2,y2,x0,y0,*r0,*triangle_nb,ax,ay,bx,by,cx,cy);
+
+ /* On calcule le nombre de couples de points par distance g*/
+ for(tt=0;tt<*t2;tt++){
+ g[tt]=0;
+ }
+ for(i=0;i<*point_nb1;i++)
+ for(j=0;j<*point_nb2;j++)
+ { d=sqrt((x1[i]-x2[j])*(x1[i]-x2[j])+(y1[i]-y2[j])*(y1[i]-y2[j]));
+ if (d<*t2*(*dt))
+ { tt=d/(*dt);
+ cin=perim_in_disq(x1[i],y1[i],d,*x0,*y0,*r0);
+ if (cin<0) {
+ Rprintf("\ncin<0 sur i AVANT");
+ return -1;
+ }
+ cin=cin-perim_triangle(x1[i],y1[i],d,*triangle_nb,ax,ay,bx,by,cx,cy);
+ if (cin<0) {
+ Rprintf("Overlapping triangles\n");
+ return -1;
+ }
+ g[tt]+=2*Pi()/cin;
+ }
+ }
+
+ /* on moyenne -> densite*/
+ for(tt=0;tt<*t2;tt++) {
+ g[tt]=g[tt]/(*point_nb1);
+ }
+
+ /* on integre*/
+ k[0]=g[0];
+ for(tt=1;tt<*t2;tt++){
+ k[tt]=k[tt-1]+g[tt];
+ }
+
+ return 0;
+}
+
+/*fonction intertype avec intervalle de confiance pour une zone rectangulaire*/
+int intertype_rect_ic(int *point_nb1,double *x1,double *y1,int *point_nb2, double *x2, double *y2,
+double *xmi,double *xma,double *ymi,double *yma,double *surface,
+ int *t2,double *dt,int *nbSimu,int *h0, double *prec, int *nsimax, int *conv, int *rep, double *lev,double *g,double *k,
+double *gic1,double *gic2, double *kic1,double *kic2, double *gval, double *kval, double *lval, double *nval) {
+ int i,j,i0,i1,i2,ptot,r;
+ double **gic,**kic;
+ double *gg,*kk,*ll,*nn;
+ double *gt,*kt,*lt,*nt;
+ int erreur=0,mess;
+ int *type;
+ //double *x,*y,*cost,surface,*xx,*yy;
+ double *x,*y,*cost,densite_1,densite_2,densite_tot;
+ int point_nb=0,point_nbtot;
+
+ densite_1=(*point_nb1)/(*surface);
+ densite_2=(*point_nb2)/(*surface);
+ point_nbtot=(*point_nb1)+(*point_nb2);
+ densite_tot=point_nbtot/(*surface);
+
+ erreur=intertype_rect(point_nb1,x1,y1,point_nb2,x2,y2,xmi,xma,ymi,yma,t2,dt,g,k);
+ if (erreur!=0) return -1;
+
+ //Definition de i0 : indice ou sera stocke l'estimation des bornes de l'IC
+ i0=*lev/2*(*nbSimu+1);
+ if (i0<1) i0=1;
+
+ //Initialisation des tableaux dans lesquels on va stocker les valeurs extremes lors de MC
+ taballoc(&gic,*t2+1,2*i0+10+1);
+ taballoc(&kic,*t2+1,2*i0+10+1);
+
+ //Normalisation de g et k et calcul de l et n pour le calcul des p-values
+ vecalloc(&gg,*t2);
+ vecalloc(&kk,*t2);
+ vecalloc(&ll,*t2);
+ vecalloc(&nn,*t2);
+ for(i=0;i<*t2;i++) {
+ gg[i]=g[i]/(densite_2*(Pi()*(i+1)*(i+1)*(*dt)*(*dt)-Pi()*i*i*(*dt)*(*dt)));
+ nn[i]=k[i]/(Pi()*(i+1)*(i+1)*(*dt)*(*dt));
+ kk[i]=k[i]/densite_2;
+ ll[i]=sqrt(kk[i]/Pi())-(i+1)*(*dt);
+ gval[i]=1;
+ kval[i]=1;
+ nval[i]=1;
+ lval[i]=1;
+ }
+
+ //Initialisations avant la boucle principale
+ if (*h0==1) { //Option 1 : substitutions : on stocke tous les points
+ vecalloc(&x,point_nbtot);
+ vecalloc(&y,point_nbtot);
+ vecintalloc(&type,point_nbtot);
+ for(i=0;i<*point_nb1;i++) {
+ x[i]=x1[i];
+ y[i]=y1[i];
+ }
+ for(i=0;i<*point_nb2;i++) {
+ x[*point_nb1+i]=x2[i];
+ y[*point_nb1+i]=y2[i];
+ }
+ //on lance Ripley sur tous les points + normalization pour le calcul des p-values
+ vecalloc(>,*t2);
+ vecalloc(&kt,*t2);
+ vecalloc(<,*t2);
+ vecalloc(&nt,*t2);
+ /*ptot=*point_nb1+*point_nb2;*/
+ erreur=ripley_rect(&point_nbtot,x,y,xmi,xma,ymi,yma,t2,dt,gt,kt);
+ if (erreur!=0) return -1;
+ for(j=0;j<*t2;j++) {
+ gt[j]=gt[j]/(densite_tot*(Pi()*(j+1)*(j+1)*(*dt)*(*dt)-Pi()*j*j*(*dt)*(*dt)));
+ nt[j]=kt[j]/(Pi()*(j+1)*(j+1)*(*dt)*(*dt));
+ kt[j]=kt[j]/(densite_tot);
+ lt[j]=sqrt(kt[j]/Pi())-(j+1)*(*dt);
+ }
+ }
+ if (*h0==2) { //Option 2 : initialisation coordonnŽes points dŽcalŽs
+ vecalloc(&x,*point_nb1);
+ vecalloc(&y,*point_nb1);
+ }
+
+ if (*h0==3) { //Option 3 : on lance Ripley sur les points de type 1
+ vecalloc(&x,*point_nb1);
+ vecalloc(&y,*point_nb1);
+ vecalloc(>,*t2);
+ vecalloc(&kt,*t2);
+ vecalloc(<,*t2);
+ vecalloc(&cost,*nsimax);
+ /*densite1=(*densite-*densite2);
+ surface=(*point_nb1)/densite1;*/
+ erreur=ripley_rect(point_nb1,x1,y1,xmi,xma,ymi,yma,t2,dt,gt,kt);
+ if (erreur!=0) return -1;
+ for(j=0;j<*t2;j++)
+ lt[j]=sqrt(kt[j]/(densite_1*Pi()))-(j+1)*(*dt);
+ }
+ int lp=0;
+
+ //boucle principale de MC
+ Rprintf("Monte Carlo simulation\n");
+ for(i=1;i<=*nbSimu;i++) {
+
+ //On simule les hypotheses nulles
+ if(*h0==1)
+ erreur=randlabelling(x,y,*point_nb1,x1,y1,*point_nb2,x2,y2,type);
+ if(*h0==2)
+ erreur=randshifting_rect(&point_nb,x,y,*point_nb1,x1,y1,*xmi,*xma,*ymi,*yma,*prec);
+ if(*h0==3) {
+ erreur=1;
+ r=0;
+ while(erreur!=0) {
+ erreur=mimetic_rect(point_nb1,x1,y1,surface,xmi,xma,ymi,yma,prec,t2,dt,lt,nsimax,conv,cost,gt,kt,x,y,0);
+ r=r+erreur;
+ if(r==*rep) {
+ Rprintf("\nStop: mimetic_rect failed to converge more than %d times\n", r);
+ Rprintf("Adjust arguments nsimax and/or conv\n", r);
+ return -1;
+ }
+ }
+ }
+
+ if (erreur==0) {
+ if (*h0==1)//etiquetage aleatoire
+ erreur=intertype_rect(point_nb1,x1,y1,point_nb2,x2,y2,xmi,xma,ymi,yma,t2,dt,gic1,kic1);
+ if (*h0==2) // décallage avec rectangle
+ erreur=intertype_rect(&point_nb,x,y,point_nb2,x2,y2,xmi,xma,ymi,yma,t2,dt,gic1,kic1);
+ if (*h0==3) // mimŽtique
+ erreur=intertype_rect(point_nb1,x,y,point_nb2,x2,y2,xmi,xma,ymi,yma,t2,dt,gic1,kic1);
+ }
+ // si il y a une erreur on recommence une simulation
+ if (erreur!=0) {
+ i=i-1;
+ Rprintf("ERREUR Intertype\n");
+ }
+ else {
+ //comptage du nombre de |¶obs|<=|¶simu| pour test local
+ double gictmp,kictmp,lictmp,nictmp;
+ for(j=0;j<*t2;j++) {
+ gictmp=gic1[j]/(densite_2*(Pi()*(j+1)*(j+1)*(*dt)*(*dt)-Pi()*j*j*(*dt)*(*dt)));
+ nictmp=kic1[j]/(Pi()*(j+1)*(j+1)*(*dt)*(*dt));
+ kictmp=kic1[j]/densite_2;
+ lictmp=sqrt(kictmp/Pi())-(j+1)*(*dt);
+ if(*h0==1) {
+ if ((float)fabs(gg[j]-gt[j])<=(float)fabs(gictmp-gt[j])) {gval[j]+=1;}
+ if ((float)fabs(nn[j]-(densite_2*kt[j]/(Pi()*(j+1)*(j+1)*(*dt)*(*dt))))<=(float)fabs(nictmp-(densite_2*kt[j]/(Pi()*(j+1)*(j+1)*(*dt)*(*dt))))) {nval[j]+=1;}
+ if ((float)fabs(kk[j]-kt[j])<=(float)(kictmp-kt[j])) {kval[j]+=1;}
+ if ((float)fabs(ll[j]-lt[j])<=(float)fabs(lictmp-lt[j])) {lval[j]+=1;}
+ }
+ else { //h0=2 ou 3
+ if ((float)fabs(gg[j]-1)<=(float)fabs(gictmp-1)) {gval[j]+=1;}
+ if ((float)fabs(nn[j]-densite_2)<=(float)fabs(nictmp-densite_2)) {nval[j]+=1;}
+ if ((float)fabs(kk[j]-Pi()*(j+1)*(j+1)*(*dt)*(*dt))<=(float)(kictmp-Pi()*(j+1)*(j+1)*(*dt)*(*dt))) {kval[j]+=1;}
+ if ((float)fabs(ll[j])<=(float)fabs(lictmp)) {lval[j]+=1;}
+ }
+ }
+
+ //Traitement des résultats
+ ic(i,i0,gic,kic,gic1,kic1,*t2);
+ }
+ R_FlushConsole();
+ progress(i,&lp,*nbSimu);
+ }
+
+ i1=i0+2;
+ i2=i0;
+
+ //Copies des valeurs dans les tableaux résultats
+ for(i=0;i<*t2;i++) {
+ gic1[i]=gic[i+1][i1];
+ gic2[i]=gic[i+1][i2];
+ kic1[i]=kic[i+1][i1];
+ kic2[i]=kic[i+1][i2];
+ }
+
+
+ freetab(gic);
+ freetab(kic);
+ freevec(gg);
+ freevec(kk);
+ freevec(ll);
+ freevec(nn);
+ if(*h0==1) {
+ freevec(gt);
+ freevec(kt);
+ freevec(lt);
+ freevec(nt);
+ freeintvec(type);
+ }
+ if(*h0==3) {
+ freevec(gt);
+ freevec(kt);
+ freevec(lt);
+ freevec(cost);
+ }
+ freevec(x);
+ freevec(y);
+ return 0;
+}
+
+/*fonction intertype avec intervalle de confiance pour une zone circulaire*/
+int intertype_disq_ic(int *point_nb1,double *x1,double *y1,int *point_nb2, double *x2, double *y2,
+double *x0,double *y0,double *r0,double *surface, int *t2,double *dt,int *nbSimu,int *h0, double *prec,
+int *nsimax, int *conv, int *rep, double *lev,double *g,double *k,double *gic1,double *gic2,
+ double *kic1,double *kic2, double *gval, double *kval, double *lval, double *nval) {
+ int i,j,i0,i1,i2,ptot,r;
+ double **gic,**kic;
+ double *gt,*kt,*lt,*nt;
+ double *gg,*kk,*ll,*nn;
+ int erreur=0,mess;
+ int *type;
+ double *x,*y,*cost,densite_1,densite_2,densite_tot;
+ int point_nb=0,point_nbtot;
+
+ densite_1=(*point_nb1)/(*surface);
+ densite_2=(*point_nb2)/(*surface);
+ point_nbtot=(*point_nb1)+(*point_nb2);
+ densite_tot=point_nbtot/(*surface);
+
+ erreur=intertype_disq(point_nb1,x1,y1,point_nb2,x2,y2,x0,y0,r0,t2,dt,g,k);
+ if (erreur!=0) return -1;
+
+ /*Définition de i0 : indice où sera stocké l'estimation des bornes de l'IC*/
+ i0=*lev/2*(*nbSimu+1);
+ if (i0<1) i0=1;
+
+ /*Initialisation des tableaux dans lesquels on va stocker les valeurs extremes lors de MC*/
+ taballoc(&gic,*t2+1,2*i0+10+1);
+ taballoc(&kic,*t2+1,2*i0+10+1);
+
+ /*Normalisation de g et k et calcul de l et n pour le calcul des p-values*/
+ vecalloc(&gg,*t2);
+ vecalloc(&kk,*t2);
+ vecalloc(&ll,*t2);
+ vecalloc(&nn,*t2);
+ for(i=0;i<*t2;i++) {
+ gg[i]=g[i]/(densite_2*(Pi()*(i+1)*(i+1)*(*dt)*(*dt)-Pi()*i*i*(*dt)*(*dt)));
+ nn[i]=k[i]/(Pi()*(i+1)*(i+1)*(*dt)*(*dt));
+ kk[i]=k[i]/(densite_2);
+ ll[i]=sqrt(kk[i]/Pi())-(i+1)*(*dt);
+ gval[i]=1;
+ kval[i]=1;
+ nval[i]=1;
+ lval[i]=1;
+ }
+
+ /*Initialisations avant la boucle principale*/
+
+ if (*h0==1) { /*Option 1 : substitutions : on stocke tous les points*/
+ vecalloc(&x,point_nbtot);
+ vecalloc(&y,point_nbtot);
+ vecintalloc(&type,point_nbtot);
+ for(i=0;i<*point_nb1;i++) {
+ x[i]=x1[i];
+ y[i]=y1[i];
+ }
+ for(i=0;i<*point_nb2;i++) {
+ x[*point_nb1+i]=x2[i];
+ y[*point_nb1+i]=y2[i];
+ }
+ /*on lance Ripley sur tous les points + normalization pour le calcul des p-values*/
+ vecalloc(>,*t2);
+ vecalloc(&kt,*t2);
+ vecalloc(<,*t2);
+ vecalloc(&nt,*t2);
+ erreur=ripley_disq(&point_nbtot,x,y,x0,y0,r0,t2,dt,gt,kt);
+ if (erreur!=0) return -1;
+ for(j=0;j<*t2;j++) {
+ gt[j]=gt[j]/(densite_tot*(Pi()*(j+1)*(j+1)*(*dt)*(*dt)-Pi()*j*j*(*dt)*(*dt)));
+ nt[j]=kt[j]/(Pi()*(j+1)*(j+1)*(*dt)*(*dt));
+ kt[j]=kt[j]/(densite_tot);
+ lt[j]=sqrt(kt[j]/Pi())-(j+1)*(*dt);
+ }
+ }
+ //Sinon option 2 : rien a initialiser*
+ if (*h0==2) {
+ vecalloc(&x,*point_nb1);
+ vecalloc(&y,*point_nb1);
+ }
+ if (*h0==3) { //Option 3 : on lance Ripley sur les points de type 1
+ vecalloc(&x,*point_nb1);
+ vecalloc(&y,*point_nb1);
+ vecalloc(>,*t2);
+ vecalloc(&kt,*t2);
+ vecalloc(<,*t2);
+ vecalloc(&cost,*nsimax);
+ erreur=ripley_disq(point_nb1,x1,y1,x0,y0,r0,t2,dt,gt,kt);
+ if (erreur!=0) return -1;
+ for(j=0;j<*t2;j++)
+ lt[j]=sqrt(kt[j]/(densite_1*Pi()))-(j+1)*(*dt);
+ }
+ int lp=0;
+
+ /* boucle principale de MC*/
+ Rprintf("Monte Carlo simulation\n");
+ for(i=1;i<=*nbSimu;i++) {
+
+ /*On simule les hypothèses nulles*/
+ if(*h0==1)
+ erreur=randlabelling(x,y,*point_nb1,x1,y1,*point_nb2,x2,y2,type);
+ if(*h0==2)
+ erreur=randshifting_disq(&point_nb,x,y,*point_nb1,x1,y1,*x0,*y0,*r0,*prec);
+ if(*h0==3) {
+ erreur=1;
+ r=0;
+ while(erreur!=0) {
+ erreur=mimetic_disq(point_nb1,x1,y1,surface,x0,y0,r0,prec,t2,dt,lt,nsimax,conv,cost,gt,kt,x,y,0);
+ r=r+erreur;
+ if(r==*rep) {
+ Rprintf("\nStop: mimetic_disq failed to converge more than %d times\n", r);
+ Rprintf("Adjust arguments nsimax and/or conv\n", r);
+ return -1;
+ }
+ }
+ }
+ if (erreur==0) {
+ if (*h0==1) {
+ erreur=intertype_disq(point_nb1,x1,y1,point_nb2,x2,y2,x0,y0,r0,t2,dt,gic1,kic1);
+ }
+ if (*h0==2) {
+ erreur=intertype_disq(&point_nb,x,y,point_nb2,x2,y2,x0,y0,r0,t2,dt,gic1,kic1);
+ }
+ if (*h0==3) {
+ // mimŽtique
+ erreur=intertype_disq(point_nb1,x,y,point_nb2,x2,y2,x0,y0,r0,t2,dt,gic1,kic1);
+ }
+ }
+ /* si il y a une erreur on recommence une simulation*/
+ if (erreur!=0) {
+ i=i-1;
+ Rprintf("ERREUR Intertype\n");
+ }
+ else {
+ /*comptage du nombre de |¶obs|<=|¶simu| pour test local*/
+ double gictmp,kictmp,lictmp,nictmp;
+ for(j=0;j<*t2;j++) {
+ gictmp=gic1[j]/(densite_2*(Pi()*(j+1)*(j+1)*(*dt)*(*dt)-Pi()*j*j*(*dt)*(*dt)));
+ nictmp=kic1[j]/(Pi()*(j+1)*(j+1)*(*dt)*(*dt));
+ kictmp=kic1[j]/densite_2;
+ lictmp=sqrt(kictmp/Pi())-(j+1)*(*dt);
+ if(*h0==1) {
+ if ((float)fabs(gg[j]-gt[j])<=(float)fabs(gictmp-gt[j])) {gval[j]+=1;}
+ if ((float)fabs(nn[j]-(densite_2*kt[j]/(Pi()*(j+1)*(j+1)*(*dt)*(*dt))))<=(float)fabs(nictmp-(densite_2*kt[j]/(Pi()*(j+1)*(j+1)*(*dt)*(*dt))))) {nval[j]+=1;}
+ if ((float)fabs(kk[j]-kt[j])<=(float)(kictmp-kt[j])) {kval[j]+=1;}
+ if ((float)fabs(ll[j]-lt[j])<=(float)fabs(lictmp-lt[j])) {lval[j]+=1;}
+ }
+ else {//h0=2 ou 3
+ if ((float)fabs(gg[j]-1)<=(float)fabs(gictmp-1)) {gval[j]+=1;}
+ if ((float)fabs(nn[j]-densite_2)<=(float)fabs(nictmp-densite_2)) {nval[j]+=1;}
+ if ((float)fabs(kk[j]-Pi()*(j+1)*(j+1)*(*dt)*(*dt))<=(float)(kictmp-Pi()*(j+1)*(j+1)*(*dt)*(*dt))) {kval[j]+=1;}
+ if ((float)fabs(ll[j])<=(float)fabs(lictmp)) {lval[j]+=1;}
+ }
+ }
+ /*Traitement des résultats*/
+ ic(i,i0,gic,kic,gic1,kic1,*t2);
+ }
+ R_FlushConsole();
+ progress(i,&lp,*nbSimu);
+ }
+ i1=i0+2;
+ i2=i0;
+ /*Copies des valeurs dans les tableaux résultats*/
+ for(i=0;i<*t2;i++) {
+ gic1[i]=gic[i+1][i1];
+ gic2[i]=gic[i+1][i2];
+ kic1[i]=kic[i+1][i1];
+ kic2[i]=kic[i+1][i2];
+ }
+ freetab(gic);
+ freetab(kic);
+ freevec(gg);
+ freevec(kk);
+ freevec(ll);
+ freevec(nn);
+ if(*h0==1) {
+ freevec(gt);
+ freevec(kt);
+ freevec(lt);
+ freevec(nt);
+ freeintvec(type);
+ }
+ if(*h0==3) {
+ freevec(gt);
+ freevec(kt);
+ freevec(lt);
+ freevec(cost);
+ }
+ freevec(x);
+ freevec(y);
+ return 0;
+}
+
+/*fonction intertype avec intervalle de confiance pour une zone rectangulaire + triangles*/
+int intertype_tr_rect_ic(int *point_nb1,double *x1,double *y1,int *point_nb2, double *x2, double *y2,
+double *xmi,double *xma,double *ymi,double *yma,double *surface,
+int *triangle_nb,double *ax,double *ay,double *bx,double *by,double *cx,double *cy,
+int *t2,double *dt,int *nbSimu,int *h0, double *prec, int *nsimax, int *conv, int *rep, double *lev,double *g,double *k,
+double *gic1,double *gic2, double *kic1,double *kic2, double *gval, double *kval, double *lval, double *nval) {
+ int i,j,i0,i1,i2,ptot,r;
+ double **gic,**kic;
+ double *gg,*kk,*ll,*nn;
+ double *gt,*kt,*lt,*nt;
+ int erreur=0,mess;
+ int *type;
+ double *x,*y,*cost,densite_1,densite_2,densite_tot;
+ int point_nb=0,point_nbtot;
+ double **tab;
+
+ densite_1=(*point_nb1)/(*surface);
+ densite_2=(*point_nb2)/(*surface);
+ point_nbtot=(*point_nb1)+(*point_nb2);
+ densite_tot=point_nbtot/(*surface);
+
+ erreur=intertype_tr_rect(point_nb1,x1,y1,point_nb2,x2,y2,xmi,xma,ymi,yma,triangle_nb,ax,ay,bx,by,cx,cy,t2,dt,g,k);
+ if (erreur!=0) return -1;
+
+ /*Définition de i0 : indice où sera stocké l'estimation des bornes de l'IC*/
+ i0=*lev/2*(*nbSimu+1);
+ if (i0<1) i0=1;
+
+ /*Initialisation des tableaux dans lesquels on va stocker les valeurs extremes lors de MC*/
+ taballoc(&gic,*t2+1,2*i0+10+1);
+ taballoc(&kic,*t2+1,2*i0+10+1);
+ taballoc(&tab,2,point_nbtot);
+
+ /*Normalisation de g et k et calcul de l et n pour le calcul des p-values*/
+ vecalloc(&gg,*t2);
+ vecalloc(&kk,*t2);
+ vecalloc(&ll,*t2);
+ vecalloc(&nn,*t2);
+ for(i=0;i<*t2;i++) {
+ gg[i]=g[i]/(densite_2*(Pi()*(i+1)*(i+1)*(*dt)*(*dt)-Pi()*i*i*(*dt)*(*dt)));
+ nn[i]=k[i]/(Pi()*(i+1)*(i+1)*(*dt)*(*dt));
+ kk[i]=k[i]/densite_2;
+ ll[i]=sqrt(kk[i]/Pi())-(i+1)*(*dt);
+ gval[i]=1;
+ kval[i]=1;
+ nval[i]=1;
+ lval[i]=1;
+ }
+
+ /*Initialisations avant la boucle principale*/
+
+ if (*h0==1) { /*Option 1 : substitutions : on stocke tous les points*/
+ vecalloc(&x,point_nbtot);
+ vecalloc(&y,point_nbtot);
+ vecintalloc(&type,point_nbtot);
+ for(i=0;i<*point_nb1;i++) {
+ x[i]=x1[i];
+ y[i]=y1[i];
+ }
+ for(i=0;i<*point_nb2;i++) {
+ x[*point_nb1+i]=x2[i];
+ y[*point_nb1+i]=y2[i];
+ }
+ /*on lance Ripley sur tous les points + normalization pour le calcul des p-values*/
+ vecalloc(>,*t2);
+ vecalloc(&kt,*t2);
+ vecalloc(<,*t2);
+ vecalloc(&nt,*t2);
+ erreur=ripley_tr_rect(&point_nbtot,x,y,xmi,xma,ymi,yma,triangle_nb,ax,ay,bx,by,cx,cy,t2,dt,gt,kt);
+ if (erreur!=0) return -1;
+ for(j=0;j<*t2;j++) {
+ gt[j]=gt[j]/(densite_tot*(Pi()*(j+1)*(j+1)*(*dt)*(*dt)-Pi()*j*j*(*dt)*(*dt)));
+ nt[j]=kt[j]/(Pi()*(j+1)*(j+1)*(*dt)*(*dt));
+ kt[j]=kt[j]/densite_tot;
+ lt[j]=sqrt(kt[j]/Pi())-(j+1)*(*dt);
+ }
+ }
+ /*Sinon option 2 : rien a initialiser*/
+ if (*h0==2) {
+ vecalloc(&x,*point_nb1);
+ vecalloc(&y,*point_nb1);
+ }
+
+ if (*h0==3) { //Option 3 : on lance Ripley sur les points de type 1
+ vecalloc(&x,*point_nb1);
+ vecalloc(&y,*point_nb1);
+ vecalloc(>,*t2);
+ vecalloc(&kt,*t2);
+ vecalloc(<,*t2);
+ vecalloc(&cost,*nsimax);
+ erreur=ripley_tr_rect(point_nb1,x1,y1,xmi,xma,ymi,yma,triangle_nb,ax,ay,bx,by,cx,cy,t2,dt,gt,kt);
+ if (erreur!=0) return -1;
+ for(j=0;j<*t2;j++) /*normalisation pour mimetic*/
+ lt[j]=sqrt(kt[j]/(densite_1*Pi()));
+ }
+
+ int lp=0;
+
+ /* boucle principale de MC*/
+ Rprintf("Monte Carlo simulation\n");
+ for(i=1;i<=*nbSimu;i++) {
+
+ /*On simule les hypothèses nulles*/
+ if(*h0==1)
+ erreur=randlabelling(x,y,*point_nb1,x1,y1,*point_nb2,x2,y2,type);
+ if(*h0==2)
+ erreur=randshifting_tr_rect(&point_nb,x,y,*point_nb1,x1,y1,*xmi,*xma,*ymi,*yma,*triangle_nb,ax,ay,bx,by,cx,cy,*prec);
+ if(*h0==3) {
+ erreur=1;
+ r=0;
+ while(erreur!=0) {
+ erreur=mimetic_tr_rect(point_nb1,x1,y1,surface,xmi,xma,ymi,yma,triangle_nb,ax,ay,bx,by,cx,cy,prec,t2,dt,lt,nsimax,conv,cost,gt,kt,x,y,0);
+ r=r+erreur;
+ if(r==*rep) {
+ Rprintf("\nStop: mimetic_tr_rect failed to converge more than %d times\n", r);
+ Rprintf("Adjust arguments nsimax and/or conv\n", r);
+ return -1;
+ }
+ }
+ }
+
+ if (erreur==0) {
+ if (*h0==1) //étiquetage aléatoire
+ erreur=intertype_tr_rect(point_nb1,x1,y1,point_nb2,x2,y2,xmi,xma,ymi,yma,triangle_nb,ax,ay,bx,by,cx,cy,t2,dt,gic1,kic1);
+ if (*h0==2) //décallage avec rectangle
+ erreur=intertype_tr_rect(&point_nb,x,y,point_nb2,x2,y2,xmi,xma,ymi,yma,triangle_nb,ax,ay,bx,by,cx,cy,t2,dt,gic1,kic1);
+ if (*h0==3) // mimŽtique
+ erreur=intertype_tr_rect(point_nb1,x,y,point_nb2,x2,y2,xmi,xma,ymi,yma,triangle_nb,ax,ay,bx,by,cx,cy,t2,dt,gic1,kic1);
+ }
+ /* si il y a une erreur on recommence une simulation*/
+ if (erreur!=0) {
+ i=i-1;
+ Rprintf("ERREUR Intertype\n");
+ }
+ else {
+ /*comptage du nombre de |¶obs|<=|¶simu| pour test local*/
+ double gictmp,kictmp,lictmp,nictmp;
+ for(j=0;j<*t2;j++) {
+ gictmp=gic1[j]/(densite_2*(Pi()*(j+1)*(j+1)*(*dt)*(*dt)-Pi()*j*j*(*dt)*(*dt)));
+ nictmp=kic1[j]/(Pi()*(j+1)*(j+1)*(*dt)*(*dt));
+ kictmp=kic1[j]/(densite_2);
+ lictmp=sqrt(kictmp/Pi())-(j+1)*(*dt);
+ if(*h0==1) {
+ if ((float)fabs(gg[j]-gt[j])<=(float)fabs(gictmp-gt[j])) {gval[j]+=1;}
+ if ((float)fabs(nn[j]-(densite_2*kt[j]/(Pi()*(j+1)*(j+1)*(*dt)*(*dt))))<=(float)fabs(nictmp-(densite_2*kt[j]/(Pi()*(j+1)*(j+1)*(*dt)*(*dt))))) {nval[j]+=1;}
+ if ((float)fabs(kk[j]-kt[j])<=(float)(kictmp-kt[j])) {kval[j]+=1;}
+ if ((float)fabs(ll[j]-lt[j])<=(float)fabs(lictmp-lt[j])) {lval[j]+=1;}
+ }
+ else { //h0=2 ou 3
+ if ((float)fabs(gg[j]-1)<=(float)fabs(gictmp-1)) {gval[j]+=1;}
+ if ((float)fabs(nn[j]-densite_2)<=(float)fabs(nictmp-densite_2)) {nval[j]+=1;}
+ if ((float)fabs(kk[j]-Pi()*(j+1)*(j+1)*(*dt)*(*dt))<=(float)(kictmp-Pi()*(j+1)*(j+1)*(*dt)*(*dt))) {kval[j]+=1;}
+ if ((float)fabs(ll[j])<=(float)fabs(lictmp)) {lval[j]+=1;}
+ }
+ }
+
+ /*Traitement des résultats*/
+ ic(i,i0,gic,kic,gic1,kic1,*t2);
+ }
+ R_FlushConsole();
+ progress(i,&lp,*nbSimu);
+ }
+
+ i1=i0+2;
+ i2=i0;
+
+ /*Copies des valeurs dans les tableaux résultats*/
+ for(i=0;i<*t2;i++) {
+ gic1[i]=gic[i+1][i1];
+ gic2[i]=gic[i+1][i2];
+ kic1[i]=kic[i+1][i1];
+ kic2[i]=kic[i+1][i2];
+ }
+ freetab(gic);
+ freetab(kic);
+ freevec(gg);
+ freevec(kk);
+ freevec(ll);
+ freevec(nn);
+ if(*h0==1) {
+ freevec(gt);
+ freevec(kt);
+ freevec(lt);
+ freevec(nt);
+ freeintvec(type);
+ }
+ if(*h0==3) {
+ freevec(gt);
+ freevec(kt);
+ freevec(lt);
+ freevec(cost);
+ }
+ freevec(x);
+ freevec(y);
+ return 0;
+}
+
+
+/*fonction intertype avec intervalle de confiance pour une zone circulaire + triangles*/
+int intertype_tr_disq_ic(int *point_nb1,double *x1,double *y1,int *point_nb2, double *x2, double *y2,
+double *x0,double *y0,double *r0,double *surface,
+int *triangle_nb,double *ax,double *ay,double *bx,double *by,double *cx,double *cy,
+int *t2,double *dt,int *nbSimu,int *h0, double *prec, int *nsimax, int *conv, int *rep, double *lev,double *g,double *k,
+double *gic1,double *gic2, double *kic1,double *kic2, double *gval, double *kval, double *lval, double *nval) {
+ int i,j,i0,i1,i2,ptot,r;
+ double **gic,**kic;
+ double *gg,*kk,*ll,*nn;
+ double *gt,*kt,*lt,*nt;
+ int erreur=0,mess;
+ int *type;
+ double *x,*y,*cost,densite_1,densite_2,densite_tot;
+ int point_nb=0,point_nbtot;
+
+ densite_1=(*point_nb1)/(*surface);
+ densite_2=(*point_nb2)/(*surface);
+ point_nbtot=(*point_nb1)+(*point_nb2);
+ densite_tot=point_nbtot/(*surface);
+
+ erreur=intertype_tr_disq(point_nb1,x1,y1,point_nb2,x2,y2,x0,y0,r0,triangle_nb,ax,ay,bx,by,cx,cy,t2,dt,g,k);
+ if (erreur!=0) return -1;
+
+ /*Définition de i0 : indice où sera stocké l'estimation des bornes de l'IC*/
+ i0=*lev/2*(*nbSimu+1);
+ if (i0<1) i0=1;
+
+ /*Initialisation des tableaux dans lesquels on va stocker les valeurs extremes lors de MC*/
+ taballoc(&gic,*t2+1,2*i0+10+1);
+ taballoc(&kic,*t2+1,2*i0+10+1);
+
+ /*Normalisation de g et k et calcul de l et n pour le calcul des p-values*/
+ vecalloc(&gg,*t2);
+ vecalloc(&kk,*t2);
+ vecalloc(&ll,*t2);
+ vecalloc(&nn,*t2);
+ for(i=0;i<*t2;i++) {
+ gg[i]=g[i]/(densite_2*(Pi()*(i+1)*(i+1)*(*dt)*(*dt)-Pi()*i*i*(*dt)*(*dt)));
+ nn[i]=k[i]/(Pi()*(i+1)*(i+1)*(*dt)*(*dt));
+ kk[i]=k[i]/densite_2;
+ ll[i]=sqrt(kk[i]/Pi())-(i+1)*(*dt);
+ gval[i]=1;
+ kval[i]=1;
+ nval[i]=1;
+ lval[i]=1;
+ }
+
+ /*Initialisations avant la boucle principale*/
+
+ if (*h0==1) { /*Option 1 : substitutions : on stocke tous les points*/
+ vecalloc(&x,point_nbtot);
+ vecalloc(&y,point_nbtot);
+ vecintalloc(&type,point_nbtot);
+ for(i=0;i<*point_nb1;i++) {
+ x[i]=x1[i];
+ y[i]=y1[i];
+ }
+ for(i=0;i<*point_nb2;i++) {
+ x[*point_nb1+i]=x2[i];
+ y[*point_nb1+i]=y2[i];
+ }
+ /*on lance Ripley sur tous les points + normalization pour le calcul des p-values*/
+ vecalloc(>,*t2);
+ vecalloc(&kt,*t2);
+ vecalloc(<,*t2);
+ vecalloc(&nt,*t2);
+ erreur=ripley_tr_disq(&point_nbtot,x,y,x0,y0,r0,triangle_nb,ax,ay,bx,by,cx,cy,t2,dt,gt,kt);
+ if (erreur!=0) return -1;
+ for(j=0;j<*t2;j++) {
+ gt[j]=gt[j]/(densite_tot*(Pi()*(j+1)*(j+1)*(*dt)*(*dt)-Pi()*j*j*(*dt)*(*dt)));
+ nt[j]=kt[j]/(Pi()*(j+1)*(j+1)*(*dt)*(*dt));
+ kt[j]=kt[j]/densite_tot;
+ lt[j]=sqrt(kt[j]/Pi())-(j+1)*(*dt);
+ }
+ }
+ /*Sinon option 2 : rien a initialiser*/
+ if (*h0==2) {
+ vecalloc(&x,*point_nb1);
+ vecalloc(&y,*point_nb1);
+ }
+ if (*h0==3) { //Option 3 : on lance Ripley sur les points de type 1
+ vecalloc(&x,*point_nb1);
+ vecalloc(&y,*point_nb1);
+ vecalloc(>,*t2);
+ vecalloc(&kt,*t2);
+ vecalloc(<,*t2);
+ vecalloc(&cost,*nsimax);
+ erreur=ripley_tr_disq(point_nb1,x1,y1,x0,y0,r0,triangle_nb,ax,ay,bx,by,cx,cy,t2,dt,gt,kt);
+ if (erreur!=0) return -1;
+ for(j=0;j<*t2;j++)
+ lt[j]=sqrt(kt[j]/(densite_1*Pi()))-(j+1)*(*dt);
+ }
+ int lp=0;
+
+ /* boucle principale de MC*/
+ Rprintf("Monte Carlo simulation\n");
+ for(i=1;i<=*nbSimu;i++) {
+
+ /*On simule les hypothèses nulles*/
+ if(*h0==1)
+ erreur=randlabelling(x,y,*point_nb1,x1,y1,*point_nb2,x2,y2,type);
+ if(*h0==2)
+ erreur=randshifting_tr_disq(&point_nb,x,y,*point_nb1,x1,y1,*x0,*y0,*r0,*triangle_nb,ax,ay,bx,by,cx,cy,*prec);
+ if(*h0==3) {
+ erreur=1;
+ r=0;
+ while(erreur!=0) {
+ erreur=mimetic_tr_disq(point_nb1,x1,y1,surface,x0,y0,r0,triangle_nb,ax,ay,bx,by,cx,cy,prec,t2,dt,lt,nsimax,conv,cost,gt,kt,x,y,0);
+ r=r+erreur;
+ if(r==*rep) {
+ Rprintf("\nStop: mimetic_tr_disq failed to converge more than %d times\n", r);
+ Rprintf("Adjust arguments nsimax and/or conv\n", r);
+ return -1;
+ }
+ }
+ }
+
+ if (erreur==0) {
+ if (*h0==1) //étiquetage aléatoire
+ erreur=intertype_tr_disq(point_nb1,x1,y1,point_nb2,x2,y2,x0,y0,r0,triangle_nb,ax,ay,bx,by,cx,cy,t2,dt,gic1,kic1);
+ if (*h0==2) //décallage avec rectangle
+ erreur=intertype_tr_disq(&point_nb,x,y,point_nb2,x2,y2,x0,y0,r0,triangle_nb,ax,ay,bx,by,cx,cy,t2,dt,gic1,kic1);
+ if (*h0==3) // mimŽtique
+ erreur=intertype_tr_disq(point_nb1,x,y,point_nb2,x2,y2,x0,y0,r0,triangle_nb,ax,ay,bx,by,cx,cy,t2,dt,gic1,kic1);
+ }
+ /* si il y a une erreur on recommence une simulation*/
+ if (erreur!=0) {
+ i=i-1;
+ Rprintf("ERREUR Intertype\n");
+ }
+ else {
+ /*comptage du nombre de |¶obs|<=|¶simu| pour test local*/
+ double gictmp,kictmp,lictmp,nictmp;
+ for(j=0;j<*t2;j++) {
+ gictmp=gic1[j]/(densite_2*(Pi()*(j+1)*(j+1)*(*dt)*(*dt)-Pi()*j*j*(*dt)*(*dt)));
+ nictmp=kic1[j]/(Pi()*(j+1)*(j+1)*(*dt)*(*dt));
+ kictmp=kic1[j]/densite_2;
+ lictmp=sqrt(kictmp/Pi())-(j+1)*(*dt);
+ if(*h0==1) {
+ if ((float)fabs(gg[j]-gt[j])<=(float)fabs(gictmp-gt[j])) {gval[j]+=1;}
+ if ((float)fabs(nn[j]-(densite_2*kt[j]/(Pi()*(j+1)*(j+1)*(*dt)*(*dt))))<=(float)fabs(nictmp-(densite_2*kt[j]/(Pi()*(j+1)*(j+1)*(*dt)*(*dt))))) {nval[j]+=1;}
+ if ((float)fabs(kk[j]-kt[j])<=(float)(kictmp-kt[j])) {kval[j]+=1;}
+ if ((float)fabs(ll[j]-lt[j])<=(float)fabs(lictmp-lt[j])) {lval[j]+=1;}
+ }
+ else {//h0=2 ou 3
+ if ((float)fabs(gg[j]-1)<=(float)fabs(gictmp-1)) {gval[j]+=1;}
+ if ((float)fabs(nn[j]-densite_2)<=(float)fabs(nictmp-densite_2)) {nval[j]+=1;}
+ if ((float)fabs(kk[j]-Pi()*(j+1)*(j+1)*(*dt)*(*dt))<=(float)(kictmp-Pi()*(j+1)*(j+1)*(*dt)*(*dt))) {kval[j]+=1;}
+ if ((float)fabs(ll[j])<=(float)fabs(lictmp)) {lval[j]+=1;}
+ }
+ }
+
+ /*Traitement des résultats*/
+ ic(i,i0,gic,kic,gic1,kic1,*t2);
+ }
+ R_FlushConsole();
+ progress(i,&lp,*nbSimu);
+ }
+
+ i1=i0+2;
+ i2=i0;
+
+ /*Copies des valeurs dans les tableaux résultats*/
+ for(i=0;i<*t2;i++) {
+ gic1[i]=gic[i+1][i1];
+ gic2[i]=gic[i+1][i2];
+ kic1[i]=kic[i+1][i1];
+ kic2[i]=kic[i+1][i2];
+ }
+ freetab(gic);
+ freetab(kic);
+ freevec(gg);
+ freevec(kk);
+ freevec(ll);
+ freevec(nn);
+ if(*h0==1) {
+ freevec(gt);
+ freevec(kt);
+ freevec(lt);
+ freevec(nt);
+ freeintvec(type);
+ }
+ if(*h0==3) {
+ freevec(gt);
+ freevec(kt);
+ freevec(lt);
+ freevec(cost);
+ }
+ freevec(x);
+ freevec(y);
+ return 0;
+}
+
+/*fonction intertype locale pour une zone rectangulaire*/
+int intertypelocal_rect(int *point_nb1,double *x1,double *y1,int *point_nb2,double *x2,double *y2,double *xmi,double *xma,
+ double *ymi,double *yma,int *t2,double *dt,double *gi,double *ki)
+{ int tt,i,j;
+ double d,cin;
+ double **g, **k;
+
+ /*Decalage pour n'avoir que des valeurs positives*/
+ decalRect2(*point_nb1,x1,y1,*point_nb2,x2,y2,xmi,xma,ymi,yma);
+ taballoc(&g,*point_nb1,*t2);
+ taballoc(&k,*point_nb1,*t2);
+
+ for(i=0;i<*point_nb1;i++)
+ for(tt=0;tt<*t2;tt++)
+ g[i][tt]=0;
+
+ for(i=0;i<*point_nb1;i++) /* On calcule le nombre de couples de points par distance g */
+ for(j=0;j<*point_nb2;j++)
+ { d=sqrt((x1[i]-x2[j])*(x1[i]-x2[j])+(y1[i]-y2[j])*(y1[i]-y2[j]));
+ if (d<*t2*(*dt)) {
+ tt=d/(*dt);
+
+ /* correction des effets de bord*/
+ cin=perim_in_rect(x1[i],y1[i],d,*xmi,*xma,*ymi,*yma);
+ if (cin<0) {
+ Rprintf("cin<0 sur i AVANT\n");
+ return -1;
+ }
+ g[i][tt]+=2*Pi()/cin;
+ }
+ }
+
+ for(i=0;i<*point_nb1;i++)
+ { k[i][0]=g[i][0];
+ for(tt=1;tt<*t2;tt++)
+ k[i][tt]=k[i][tt-1]+g[i][tt]; /* on integre */
+ }
+
+ /*Copies des valeurs dans les tableaux resultat*/
+ for(i=0;i<*point_nb1;i++) {
+ for(tt=0;tt<*t2;tt++) {
+ gi[i*(*t2)+tt]=g[i][tt];
+ ki[i*(*t2)+tt]=k[i][tt];
+ }
+ }
+
+ freetab(g);
+ freetab(k);
+
+ return 0;
+}
+
+/*fonction intertype locale pour une zone circulaire*/
+int intertypelocal_disq(int *point_nb1,double *x1,double *y1,int *point_nb2,double *x2,double *y2,double *x0,double *y0,
+ double *r0,int *t2,double *dt,double *gi,double *ki)
+{ int tt,i,j;
+ double d,cin;
+ double **g, **k;
+
+ /*Decalage pour n'avoir que des valeurs positives*/
+ decalCirc2(*point_nb1,x1,y1,*point_nb2,x2,y2,x0,y0,*r0);
+
+
+ taballoc(&g,*point_nb1,*t2);
+ taballoc(&k,*point_nb1,*t2);
+
+ for(i=0;i<*point_nb1;i++)
+ for(tt=0;tt<*t2;tt++)
+ g[i][tt]=0;
+
+ for(i=0;i<*point_nb1;i++) /* On calcule le nombre de couples de points par distance g */
+ for(j=0;j<*point_nb2;j++)
+ { d=sqrt((x1[i]-x2[j])*(x1[i]-x2[j])+(y1[i]-y2[j])*(y1[i]-y2[j]));
+ if (d<*t2*(*dt)) {
+ tt=d/(*dt);
+
+ /* correction des effets de bord*/
+ cin=perim_in_disq(x1[i],y1[i],d,*x0,*y0,*r0);
+ if (cin<0) {
+ Rprintf("cin<0 sur i AVANT\n");
+ return -1;
+ }
+ g[i][tt]+=2*Pi()/cin;
+ }
+ }
+
+ for(i=0;i<*point_nb1;i++)
+ { k[i][0]=g[i][0];
+ for(tt=1;tt<*t2;tt++)
+ k[i][tt]=k[i][tt-1]+g[i][tt]; /* on integre */
+ }
+
+ /*Copies des valeurs dans les tableaux resultat*/
+ for(i=0;i<*point_nb1;i++) {
+ for(tt=0;tt<*t2;tt++) {
+ gi[i*(*t2)+tt]=g[i][tt];
+ ki[i*(*t2)+tt]=k[i][tt];
+ }
+ }
+
+ freetab(g);
+ freetab(k);
+
+ return 0;
+}
+
+/*fonction intertype locale pour une zone rectangulaire + triangles*/
+int intertypelocal_tr_rect(int *point_nb1,double *x1,double *y1,int *point_nb2,double *x2,double *y2,double *xmi,double *xma,
+double *ymi,double *yma,int *triangle_nb,double *ax,double *ay,double *bx,double *by,double *cx,double *cy,
+int *t2,double *dt,double *gi,double *ki)
+{ int tt,i,j;
+ double d,cin;
+ double **g, **k;
+
+ /*Decalage pour n'avoir que des valeurs positives*/
+ decalRectTri2(*point_nb1,x1,y1,*point_nb2,x2,y2,xmi,xma,ymi,yma,*triangle_nb,ax,ay,bx,by,cx,cy);
+ taballoc(&g,*point_nb1,*t2);
+ taballoc(&k,*point_nb1,*t2);
+
+ for(i=0;i<*point_nb1;i++)
+ for(tt=0;tt<*t2;tt++)
+ g[i][tt]=0;
+
+ for(i=0;i<*point_nb1;i++) /* On calcule le nombre de couples de points par distance g */
+ for(j=0;j<*point_nb2;j++)
+ { d=sqrt((x1[i]-x2[j])*(x1[i]-x2[j])+(y1[i]-y2[j])*(y1[i]-y2[j]));
+ if (d<*t2*(*dt)) {
+ tt=d/(*dt);
+
+ /* correction des effets de bord*/
+ cin=perim_in_rect(x1[i],y1[i],d,*xmi,*xma,*ymi,*yma);
+ if (cin<0) {
+ Rprintf("cin<0 sur i AVANT\n");
+ return -1;
+ }
+ cin=cin-perim_triangle(x1[i],y1[i],d,*triangle_nb,ax,ay,bx,by,cx,cy);
+ if (cin<0) {
+ Rprintf("Overlapping triangles\n");
+ return -1;
+ }
+ g[i][tt]+=2*Pi()/cin;
+ }
+ }
+
+ for(i=0;i<*point_nb1;i++)
+ { k[i][0]=g[i][0];
+ for(tt=1;tt<*t2;tt++)
+ k[i][tt]=k[i][tt-1]+g[i][tt]; /* on integre */
+ }
+
+ /*Copies des valeurs dans les tableaux resultat*/
+ for(i=0;i<*point_nb1;i++) {
+ for(tt=0;tt<*t2;tt++) {
+ gi[i*(*t2)+tt]=g[i][tt];
+ ki[i*(*t2)+tt]=k[i][tt];
+ }
+ }
+
+ freetab(g);
+ freetab(k);
+
+ return 0;
+}
+
+/*fonction intertype locale pour une zone circulaire + triangles*/
+int intertypelocal_tr_disq(int *point_nb1,double *x1,double *y1,int *point_nb2,double *x2,double *y2,double *x0,double *y0,
+double *r0,int *triangle_nb,double *ax,double *ay,double *bx,double *by,double *cx,double *cy,
+int *t2,double *dt,double *gi,double *ki)
+{ int tt,i,j;
+ double d,cin;
+ double **g, **k;
+
+ /*Decalage pour n'avoir que des valeurs positives*/
+ decalCircTri2(*point_nb1,x1,y1,*point_nb2,x2,y2,x0,y0,*r0,*triangle_nb,ax,ay,bx,by,cx,cy);
+ taballoc(&g,*point_nb1,*t2);
+ taballoc(&k,*point_nb1,*t2);
+
+ for(i=0;i<*point_nb1;i++)
+ for(tt=0;tt<*t2;tt++)
+ g[i][tt]=0;
+
+ for(i=0;i<*point_nb1;i++) /* On calcule le nombre de couples de points par distance g */
+ for(j=0;j<*point_nb2;j++)
+ { d=sqrt((x1[i]-x2[j])*(x1[i]-x2[j])+(y1[i]-y2[j])*(y1[i]-y2[j]));
+ if (d<*t2*(*dt)) {
+ tt=d/(*dt);
+
+ /* correction des effets de bord*/
+ cin=perim_in_disq(x1[i],y1[i],d,*x0,*y0,*r0);
+ if (cin<0) {
+ Rprintf("cin<0 sur i AVANT\n");
+ return -1;
+ }
+ cin=cin-perim_triangle(x1[i],y1[i],d,*triangle_nb,ax,ay,bx,by,cx,cy);
+ if (cin<0) {
+ Rprintf("Overlapping triangles\n");
+ return -1;
+ }
+ g[i][tt]+=2*Pi()/cin;
+ }
+ }
+
+ for(i=0;i<*point_nb1;i++)
+ { k[i][0]=g[i][0];
+ for(tt=1;tt<*t2;tt++)
+ k[i][tt]=k[i][tt-1]+g[i][tt]; /* on integre */
+ }
+
+ /*Copies des valeurs dans les tableaux resultat*/
+ for(i=0;i<*point_nb1;i++) {
+ for(tt=0;tt<*t2;tt++) {
+ gi[i*(*t2)+tt]=g[i][tt];
+ ki[i*(*t2)+tt]=k[i][tt];
+ }
+ }
+
+ freetab(g);
+ freetab(k);
+
+ return 0;
+}
+
+/******************************************************************************/
+/* Cette routine cree un semis poissonnien a la precision p pour x et y, */
+/* dans une forme rectangulaire xmi xma ymi yma, a la precision p, */
+/* et le range dans les tableaux dont les pointeurs sont fournis en parametre */
+/******************************************************************************/
+void s_alea_rect(int point_nb,double x[], double y[],
+ double xmi,double xma, double ymi,double yma,double p)
+{ int i;
+ double xr,yr;
+ xr=xma-xmi;
+ yr=yma-ymi;
+ GetRNGstate();
+ for(i=0;i<point_nb;i++)
+ { x[i]=xmi+(unif_rand()*(xr/p))*p;
+ y[i]=ymi+(unif_rand()*(yr/p))*p;
+ }
+ PutRNGstate();
+}
+
+/*pour un zone circulaire*/
+void s_alea_disq(int point_nb, double *x, double *y, double x0, double y0, double r0, double p)
+{ int i;
+ double xx, yy, rr;
+ rr=2*r0;
+ GetRNGstate();
+ i=0;
+ while (i<point_nb)
+ { xx=x0-r0+(unif_rand()*(rr/p))*p;
+ yy=y0-r0+(unif_rand()*(rr/p))*p;
+ if ((xx-x0)*(xx-x0)+(yy-y0)*(yy-y0)<r0*r0)
+ { x[i]=xx;
+ y[i]=yy;
+ i++;
+ }
+ }
+ PutRNGstate();
+}
+
+/*pour une zone rectangulaire avec exclusion de triangles*/
+void s_alea_tr_rect(int point_nb,double *x, double *y,double xmi,double xma, double ymi,double yma,int triangle_nb,
+double *ax,double *ay,double *bx,double *by,double *cx,double *cy,double p)
+{ int i,j,erreur;
+ double xr,yr;
+ xr=xma-xmi;
+ yr=yma-ymi;
+ GetRNGstate();
+
+ i=0;
+ while (i<point_nb)
+ { /* on simule le ieme point dans le rectangle*/
+ x[i]=xmi+(unif_rand()*(xr/p))*p;
+ y[i]=ymi+(unif_rand()*(yr/p))*p;
+
+ /* si il n'est dans aucun triangle, on passe au suivant, sinon on recommence*/
+ erreur=0;
+ j=0;
+ while ((j<triangle_nb)&&(erreur==0))
+ { if (in_triangle(x[i],y[i],ax[j],ay[j],bx[j],by[j],cx[j],cy[j],1))
+ {
+ erreur=1;
+ }
+ j++;
+ }
+ if (erreur==0)
+ { i++;
+ }
+ }
+ PutRNGstate();
+}
+
+/*pour une zone circulaire avec exclusion de triangles*/
+void s_alea_tr_disq(int point_nb,double *x, double *y,double x0,double y0, double r0,int triangle_nb,
+double *ax,double *ay,double *bx,double *by,double *cx,double *cy,double p)
+{ int i,j,erreur;
+ double rr;
+ rr=2*r0;
+ GetRNGstate();
+
+ i=0;
+ while (i<point_nb) {
+ erreur=0;
+ /* on simule le ieme point dans le cercle*/
+ x[i]=x0-r0+(unif_rand()*(rr/p))*p;
+ y[i]=y0-r0+(unif_rand()*(rr/p))*p;
+ if ((x[i]-x0)*(x[i]-x0)+(y[i]-y0)*(y[i]-y0)>r0*r0) erreur=1;
+
+ /* si il n'est dans aucun triangle, on passe au suivant, sinon on recommence*/
+ j=0;
+ while ((j<triangle_nb)&&(erreur==0))
+ { if (in_triangle(x[i],y[i],ax[j],ay[j],bx[j],by[j],cx[j],cy[j],1))
+ {
+ erreur=1;
+ }
+ j++;
+ }
+ if (erreur==0)
+ { i++;
+ }
+ }
+ PutRNGstate();
+}
+
+/************************************/
+/*hypotheses nulles pour intertype :*/
+/************************************/
+
+/*1 : etiquetage aleatoire*/
+int randlabelling(double *x, double *y, int point_nb1, double *x1, double *y1,int point_nb2, double *x2, double *y2,int *type) {
+ int j,jj;
+ int erreur=0;
+
+ GetRNGstate();
+
+ for(j=0;j<point_nb1+point_nb2;j++) {
+ type[j]=2;
+ }
+ /* on tire point_nb type 1*/
+ j=0;
+ while (j<point_nb1) {
+ jj=unif_rand()*(point_nb1+point_nb2);
+ while (type[jj]!=2) {
+ jj=unif_rand()*(point_nb1+point_nb2);
+ }
+ type[jj]=1;
+ x1[j]=x[jj];
+ y1[j]=y[jj];
+ j++;
+ }
+ PutRNGstate();
+ /*Il reste point_nb2 type 2*/
+ jj=0;
+ for(j=0;j<point_nb1+point_nb2;j++) {
+ if (type[j]==2) {
+ x2[jj]=x[j];
+ y2[jj]=y[j];
+ jj=jj+1;
+ }
+ }
+ if (jj!=point_nb2) {
+ Rprintf("erreur substitution\n");
+ erreur=1;
+ }
+ else {
+ erreur=0;
+ }
+
+ return erreur;
+}
+
+/*2 : decallage*/
+int randshifting_rect(int *point_nb,double *x, double *y, int point_nb1, double *x1, double *y1,
+double xmi, double xma, double ymi, double yma, double prec) {
+ int j;
+ int dx,dy;
+
+ GetRNGstate();
+
+ /*On decalle type 1*/
+ *point_nb=point_nb1;
+
+ /*en x d'abord*/
+ dx=unif_rand()*((xma-xmi)/prec)*prec;
+ for(j=0;j<*point_nb;j++) {
+ x[j]=x1[j]+dx;
+ if (x[j]>xma) {
+ x[j]=x[j]-(xma-xmi);
+ }
+ }
+ /*en y ensuite*/
+ dy=unif_rand()*((yma-ymi)/prec)*prec;
+ for(j=0;j<*point_nb;j++) {
+ y[j]=y1[j]+dy;
+ if (y[j]>yma) {
+ y[j]=y[j]-(yma-ymi);
+ }
+ }
+
+ PutRNGstate();
+
+ return 0;
+}
+
+int randshifting_disq(int *point_nb,double *x, double *y, int point_nb1, double *x1, double *y1,
+double x0, double y0, double r0, double prec) {
+ int i;
+
+ randshifting_rect(point_nb,x,y,point_nb1,x1,y1,x0-r0,x0+r0,y0-r0,y0+r0,prec);
+
+ /*suppression des points hors cercle*/
+ i=0;
+ while (i<*point_nb)
+ { if((x[i]-x0)*(x[i]-x0)+(y[i]-y0)*(y[i]-y0)>r0*r0)
+ { x[i]=x[*point_nb];
+ y[i]=y[*point_nb];
+ i--;
+ *point_nb=*point_nb-1;
+ }
+ i++;
+ }
+
+ return 0;
+}
+
+int randshifting_tr_rect(int *point_nb,double *x, double *y, int point_nb1, double *x1, double *y1,
+double xmi, double xma, double ymi, double yma,int triangle_nb, double *ax, double *ay, double *bx, double *by,
+double *cx, double *cy,double prec) {
+ int i,j;
+ int erreur;
+
+ randshifting_rect(point_nb,x,y,point_nb1,x1,y1,xmi,xma,ymi,yma,prec);
+
+ /*suppression des points dans triangles*/
+ i=0;
+ erreur=0;
+ while (i<*point_nb)
+ { j=0;
+ while ((j<triangle_nb)&&(erreur==0))
+ { if (in_triangle(x[i],y[i],ax[j],ay[j],bx[j],by[j],cx[j],cy[j],1)) erreur=1;
+ j++;
+ }
+ if (erreur == 1)
+ { x[i]=x[*point_nb];
+ y[i]=y[*point_nb];
+ i--;
+ *point_nb=*point_nb-1;
+ }
+ i++;
+ erreur=0;
+ }
+
+ return 0;
+}
+
+int randshifting_tr_disq(int *point_nb,double *x, double *y, int point_nb1, double *x1, double *y1,
+double x0, double y0, double r0,int triangle_nb, double *ax, double *ay, double *bx, double *by,
+double *cx, double *cy,double prec) {
+ int i,j;
+ int erreur;
+
+ randshifting_disq(point_nb,x,y,point_nb1,x1,y1,x0,y0,r0,prec);
+
+ /*suppression des points dans triangles*/
+ i=0;
+ erreur=0;
+ while (i<*point_nb)
+ { j=0;
+ while ((j<triangle_nb)&&(erreur==0))
+ { if (in_triangle(x[i],y[i],ax[j],ay[j],bx[j],by[j],cx[j],cy[j],1)) erreur=1;
+ j++;
+ }
+ if (erreur == 1)
+ { x[i]=x[*point_nb];
+ y[i]=y[*point_nb];
+ i--;
+ *point_nb=*point_nb-1;
+ }
+ i++;
+ erreur=0;
+ }
+
+ return 0;
+}
+
+/******************************************************************************/
+/* Calcule la fonction de corrŽlation des marques Km(r) pour un semis (x,y) */
+/* affectŽ d'une marque quantitative c(x,y) en parametres */
+/* dans une zone de forme rectangulaire de bornes xmi xma ymi yma */
+/* Les corrections des effets de bords sont fait par la methode de Ripley, */
+/* i.e. l'inverse de la proportion d'arc de cercle inclu dans la fenetre. */
+/* Les calculs sont faits pour les t2 premiers intervalles de largeur dt. */
+/* La routine calcule g, densite des couples de points; et la fonction K */
+/* Les resultats sont stockes dans des tableaux g et k donnes en parametres */
+/******************************************************************************/
+int corr_rect(int *point_nb,double *x,double *y,double *c, double *xmi,double *xma,double *ymi,double *yma,
+int *t2,double *dt,double *gm,double *km)
+{ int i,j,tt;
+ double d,cin,cmoy,cvar;
+ double *g,*k;
+
+ /*Decalage pour n'avoir que des valeurs positives*/
+ decalRect(*point_nb,x,y,xmi,xma,ymi,yma);
+
+ /*On calcule la moyenne des marques*/
+ cmoy=0;
+ for(i=0;i<*point_nb;i++)
+ cmoy+=c[i];
+ cmoy=cmoy/(*point_nb);
+
+ /*On calcule la variance des marques*/
+ cvar=0;
+ for(i=0;i<*point_nb;i++)
+ cvar+=(c[i]-cmoy)*(c[i]-cmoy);
+ cvar=cvar/(*point_nb);
+
+ vecalloc(&g,*t2);
+ vecalloc(&k,*t2);
+
+ /* On rangera dans g le nombre de couples de points par distance tt
+ et dans gm la somme des covariances des marques */
+ for(tt=0;tt<*t2;tt++) {
+ g[tt]=0;
+ gm[tt]=0;
+ }
+
+ /*On regarde les couples (i,j) et (j,i) : donc pour i>j seulement*/
+ for(i=1;i<*point_nb;i++)
+ { for(j=0;j<i;j++)
+ { d=sqrt((x[i]-x[j])*(x[i]-x[j])+(y[i]-y[j])*(y[i]-y[j]));
+ if (d<*t2*(*dt)){
+ /* dans quelle classe de distance est ce couple ?*/
+ tt=d/(*dt);
+
+ /*pour [i,j] : correction des effets de bord*/
+ cin=perim_in_rect(x[i],y[i],d,*xmi,*xma,*ymi,*yma);
+ if (cin<0) {
+ Rprintf("cin<0 sur i AVANT\n");
+ return -1;
+ }
+ g[tt]+=2*Pi()/cin;
+ gm[tt]+=(c[i]-cmoy)*(c[j]-cmoy)*2*Pi()/cin;
+
+ /*pour [j,i] : correction des effets de bord*/
+ cin=perim_in_rect(x[j],y[j],d,*xmi,*xma,*ymi,*yma);
+ if (cin<0) {
+ Rprintf("cin<0 sur j AVANT\n");
+ return -1;
+ }
+ g[tt]+=2*Pi()/cin;
+ gm[tt]+=(c[i]-cmoy)*(c[j]-cmoy)*2*Pi()/cin;
+ }
+ }
+ }
+
+ /* on integre*/
+ k[0]=g[0];
+ km[0]=gm[0];
+ for(tt=1;tt<*t2;tt++) {
+ k[tt]=k[tt-1]+g[tt];
+ km[tt]=km[tt-1]+gm[tt];
+ }
+
+ /* on normalise*/
+ for(tt=0;tt<*t2;tt++) {
+ gm[tt]=gm[tt]/(g[tt]*cvar);
+ km[tt]=km[tt]/(k[tt]*cvar);
+ }
+
+ freevec(g);
+ freevec(k);
+ return 0;
+}
+
+/*function de corrŽlation dans forme circulaire*/
+int corr_disq(int *point_nb,double *x,double *y,double *c, double *x0,double *y0,double *r0,
+int *t2,double *dt,double *gm,double *km)
+{ int i,j,tt;
+ double d,cin,cmoy,cvar;
+ double *g,*k;
+
+ /*Decalage pour n'avoir que des valeurs positives*/
+ decalCirc(*point_nb,x,y,x0,y0,*r0);
+
+ /*On calcule la moyenne des marques*/
+ cmoy=0;
+ for(i=0;i<*point_nb;i++)
+ cmoy+=c[i];
+ cmoy=cmoy/(*point_nb);
+
+ /*On calcule la variance des marques*/
+ cvar=0;
+ for(i=0;i<*point_nb;i++)
+ cvar+=(c[i]-cmoy)*(c[i]-cmoy);
+ cvar=cvar/(*point_nb);
+
+ vecalloc(&g,*t2);
+ vecalloc(&k,*t2);
+
+ /*On rangera dans g le nombre de couples de points par distance tt
+ et dans gm la somme des covariances des marques */
+ for(tt=0;tt<*t2;tt++) {
+ g[tt]=0;
+ gm[tt]=0;
+ }
+
+ /*On regarde les couples (i,j) et (j,i) : donc pour i>j seulement*/
+ for(i=1;i<*point_nb;i++)
+ { for(j=0;j<i;j++)
+ { d=sqrt((x[i]-x[j])*(x[i]-x[j])+(y[i]-y[j])*(y[i]-y[j]));
+ if (d<*t2*(*dt)){
+ /* dans quelle classe de distance est ce couple ?*/
+ tt=d/(*dt);
+
+ /* pour [i,j] : correction des effets de bord*/
+ cin=perim_in_disq(x[i],y[i],d,*x0,*y0,*r0);
+ if (cin<0) {
+ Rprintf("cin<0 sur i AVANT\n");
+ return -1;
+ }
+ g[tt]+=2*Pi()/cin;
+ gm[tt]+=(c[i]-cmoy)*(c[j]-cmoy)*2*Pi()/cin;
+
+ /*pour [j,i] : correction des effets de bord*/
+ cin=perim_in_disq(x[j],y[j],d,*x0,*y0,*r0);
+ if (cin<0) {
+ Rprintf("cin<0 sur j AVANT\n");
+ return -1;
+ }
+ g[tt]+=2*Pi()/cin;
+ gm[tt]+=(c[i]-cmoy)*(c[j]-cmoy)*2*Pi()/cin;
+ }
+ }
+ }
+
+ /* on integre*/
+ k[0]=g[0];
+ km[0]=gm[0];
+ for(tt=1;tt<*t2;tt++) {
+ k[tt]=k[tt-1]+g[tt];
+ km[tt]=km[tt-1]+gm[tt];
+ }
+
+ /* on normalise*/
+ for(tt=0;tt<*t2;tt++) {
+ gm[tt]=gm[tt]/(g[tt]*cvar);
+ km[tt]=km[tt]/(k[tt]*cvar);
+ }
+
+ freevec(g);
+ freevec(k);
+ return 0;
+}
+
+/*Kcor triangles dans rectangle*/
+int corr_tr_rect(int *point_nb,double *x,double *y,double *c, double *xmi,double *xma,double *ymi,double *yma,
+int *triangle_nb, double *ax, double *ay, double *bx, double *by, double *cx, double *cy,
+int *t2,double *dt,double *gm,double *km)
+{ int i,j,tt;
+ double d,cin,cmoy,cvar;
+ double *g,*k;
+
+ /*Decalage pour n'avoir que des valeurs positives*/
+ decalRectTri(*point_nb,x,y,xmi,xma,ymi,yma,*triangle_nb,ax,ay,bx,by,cx,cy);
+
+ /*On calcule la moyenne des marques*/
+ cmoy=0;
+ for(i=0;i<*point_nb;i++)
+ cmoy+=c[i];
+ cmoy=cmoy/(*point_nb);
+
+ /*On calcule la variance des marques*/
+ cvar=0;
+ for(i=0;i<*point_nb;i++)
+ cvar+=(c[i]-cmoy)*(c[i]-cmoy);
+ cvar=cvar/(*point_nb);
+
+ vecalloc(&g,*t2);
+ vecalloc(&k,*t2);
+
+ /*On rangera dans g le nombre de couples de points par distance tt
+ et dans gm la somme des covariances des marques */
+ for(tt=0;tt<*t2;tt++) {
+ g[tt]=0;
+ gm[tt]=0;
+ }
+
+ /*On regarde les couples (i,j) et (j,i) : donc pour i>j seulement*/
+ for(i=1;i<*point_nb;i++)
+ { for(j=0;j<i;j++)
+ { d=sqrt((x[i]-x[j])*(x[i]-x[j])+(y[i]-y[j])*(y[i]-y[j]));
+ if (d<*t2*(*dt)){
+ /*dans quelle classe de distance est ce couple ?*/
+ tt=d/(*dt);
+
+ /*pour [i,j] : correction des effets de bord*/
+ cin=perim_in_rect(x[i],y[i],d,*xmi,*xma,*ymi,*yma);
+ if (cin<0) {
+ Rprintf("cin<0 sur i AVANT\n");
+ return -1;
+ }
+ cin=cin-perim_triangle(x[i],y[i],d,*triangle_nb,ax,ay,bx,by,cx,cy);
+ if (cin<0) {
+ Rprintf("Overlapping triangles\n");
+ return -1;
+ }
+ g[tt]+=2*Pi()/cin;
+ gm[tt]+=(c[i]-cmoy)*(c[j]-cmoy)*2*Pi()/cin;
+
+ /*pour [j,i] : correction des effets de bord*/
+ cin=perim_in_rect(x[j],y[j],d,*xmi,*xma,*ymi,*yma);
+ if (cin<0) {
+ Rprintf("cin<0 sur j AVANT\n");
+ return -1;
+ }
+ cin=cin-perim_triangle(x[j],y[j],d,*triangle_nb,ax,ay,bx,by,cx,cy);
+ if (cin<0) {
+ Rprintf("Overlapping triangles\n");
+ return -1;
+ }
+ g[tt]+=2*Pi()/cin;
+ gm[tt]+=(c[i]-cmoy)*(c[j]-cmoy)*2*Pi()/cin;
+ }
+ }
+ }
+
+
+ /*on integre*/
+ k[0]=g[0];
+ km[0]=gm[0];
+ for(tt=1;tt<*t2;tt++) {
+ k[tt]=k[tt-1]+g[tt];
+ km[tt]=km[tt-1]+gm[tt];
+ }
+
+ /* on normalise*/
+ for(tt=0;tt<*t2;tt++) {
+ gm[tt]=gm[tt]/(g[tt]*cvar);
+ km[tt]=km[tt]/(k[tt]*cvar);
+ }
+
+ freevec(g);
+ freevec(k);
+ return 0;
+}
+
+/*kcor triangles dans disque*/
+int corr_tr_disq(int *point_nb,double *x,double *y,double *c, double *x0,double *y0,double *r0,
+int *triangle_nb,double *ax,double *ay,double *bx,double *by,double *cx,double *cy,
+int *t2,double *dt,double *gm,double *km)
+{ int i,j,tt;
+ double d,cin,cmoy,cvar;
+ double *g,*k;
+
+ /*Decalage pour n'avoir que des valeurs positives*/
+ decalCircTri(*point_nb,x,y,x0,y0,*r0,*triangle_nb,ax,ay,bx,by,cx,cy);
+
+ /*On calcule la moyenne des marques*/
+ cmoy=0;
+ for(i=0;i<*point_nb;i++)
+ cmoy+=c[i];
+ cmoy=cmoy/(*point_nb);
+
+ /*On calcule la variance des marques*/
+ cvar=0;
+ for(i=0;i<*point_nb;i++)
+ cvar+=(c[i]-cmoy)*(c[i]-cmoy);
+ cvar=cvar/(*point_nb);
+
+ vecalloc(&g,*t2);
+ vecalloc(&k,*t2);
+
+ /* On rangera dans g le nombre de couples de points par distance tt
+ et dans gm la somme des covariances des marques */
+ for(tt=0;tt<*t2;tt++) {
+ g[tt]=0;
+ gm[tt]=0;
+ }
+
+ /*On regarde les couples (i,j) et (j,i) : donc pour i>j seulement*/
+ for(i=1;i<*point_nb;i++)
+ { for(j=0;j<i;j++)
+ { d=sqrt((x[i]-x[j])*(x[i]-x[j])+(y[i]-y[j])*(y[i]-y[j]));
+ if (d<*t2*(*dt)){
+ /* dans quelle classe de distance est ce couple ?*/
+ tt=d/(*dt);
+
+ /* pour [i,j] : correction des effets de bord*/
+ cin=perim_in_disq(x[i],y[i],d,*x0,*y0,*r0);
+ if (cin<0) {
+ Rprintf("cin<0 sur i AVANT\n");
+ return -1;
+ }
+ cin=cin-perim_triangle(x[i],y[i],d,*triangle_nb,ax,ay,bx,by,cx,cy);
+ if (cin<0) {
+ Rprintf("Overlapping triangles\n");
+ return -1;
+ }
+ g[tt]+=2*Pi()/cin;
+ gm[tt]+=(c[i]-cmoy)*(c[j]-cmoy)*2*Pi()/cin;
+
+ /*pour [j,i] : correction des effets de bord*/
+ cin=perim_in_disq(x[j],y[j],d,*x0,*y0,*r0);
+ if (cin<0) {
+ Rprintf("cin<0 sur j AVANT\n");
+ return -1;
+ }
+ cin=cin-perim_triangle(x[j],y[j],d,*triangle_nb,ax,ay,bx,by,cx,cy);
+ if (cin<0) {
+ Rprintf("Overlapping triangles\n");
+ return -1;
+ }
+ g[tt]+=2*Pi()/cin;
+ gm[tt]+=(c[i]-cmoy)*(c[j]-cmoy)*2*Pi()/cin;
+ }
+ }
+ }
+
+ /* on integre*/
+ k[0]=g[0];
+ km[0]=gm[0];
+ for(tt=1;tt<*t2;tt++) {
+ k[tt]=k[tt-1]+g[tt];
+ km[tt]=km[tt-1]+gm[tt];
+ }
+
+ /* on normalise*/
+ for(tt=0;tt<*t2;tt++) {
+ gm[tt]=gm[tt]/(g[tt]*cvar);
+ km[tt]=km[tt]/(k[tt]*cvar);
+ }
+
+ freevec(g);
+ freevec(k);
+ return 0;
+}
+
+/*Kcor dans rectangle + ic*/
+int corr_rect_ic(int *point_nb,double *x,double *y,double *c, double *xmi,double *xma,double *ymi,double *yma,
+int *t2,double *dt,int *nbSimu, double *lev,double *gm,double *km,
+double *gmic1,double *gmic2, double *kmic1,double *kmic2, double *gmval, double *kmval) {
+ int i,j,i0,i1,i2;
+ double *c2;
+ double **gmic,**kmic;
+ double *ggm,*kkm;
+
+ int erreur=0;
+
+ erreur=corr_rect(point_nb,x,y,c,xmi,xma,ymi,yma,t2,dt,gm,km);
+ if (erreur!=0) {
+ return -1;
+ }
+
+ /*Définition de i0 : indice où sera stocké l'estimation des bornes de l'IC*/
+ i0=*lev/2*(*nbSimu+1);
+ if (i0<1) i0=1;
+
+ /*Initialisation des tableaux dans lesquels on va stocker les valeurs extremes lors de MC*/
+ taballoc(&gmic,*t2+1,2*i0+10+1);
+ taballoc(&kmic,*t2+1,2*i0+10+1);
+
+ /*Normalisation de g et k et calcul de l et n pour le calcul des p-values*/
+ vecalloc(&ggm,*t2);
+ vecalloc(&kkm,*t2);
+ for(i=0;i<*t2;i++) {
+ ggm[i]=gm[i];
+ kkm[i]=km[i];
+
+ gmval[i]=1;
+ kmval[i]=1;
+ }
+
+ int lp=0;
+ vecalloc(&c2,*point_nb);
+ /* boucle principale de MC*/
+ Rprintf("Monte Carlo simulation\n");
+ for(i=1;i<=*nbSimu;i++) {
+ randmark(*point_nb,c,c2);
+ erreur=corr_rect(point_nb,x,y,c2,xmi,xma,ymi,yma,t2,dt,gmic1,kmic1);
+ /* si il y a une erreur on recommence une simulation*/
+ if (erreur!=0) {
+ i=i-1;
+ Rprintf("ERREUR mark correlation\n");
+ }
+ else {
+ /*comptage du nombre de |¶obs|<=|¶simu| pour test local*/
+ double gmictmp,kmictmp;
+ for(j=0;j<*t2;j++) {
+ gmictmp=gmic1[j];
+ kmictmp=kmic1[j];
+ if ((float)fabs(ggm[j]-1)<=(float)fabs(gmictmp-1)) {gmval[j]+=1;}
+ if ((float)fabs(kkm[j])<=(float)fabs(kmictmp)) {kmval[j]+=1;}
+ }
+
+ /*Traitement des résultats*/
+ ic(i,i0,gmic,kmic,gmic1,kmic1,*t2);
+ }
+ R_FlushConsole();
+ progress(i,&lp,*nbSimu);
+ }
+
+ i1=i0+2;
+ i2=i0;
+
+ /*Copies des valeurs dans les tableaux résultats*/
+ for(i=0;i<*t2;i++) {
+ gmic1[i]=gmic[i+1][i1];
+ gmic2[i]=gmic[i+1][i2];
+ kmic1[i]=kmic[i+1][i1];
+ kmic2[i]=kmic[i+1][i2];
+ }
+
+
+ freetab(gmic);
+ freetab(kmic);
+ freevec(ggm);
+ freevec(kkm);
+ freevec(c2);
+ return 0;
+}
+
+/*Kcor dans disque + ic*/
+int corr_disq_ic(int *point_nb,double *x,double *y,double *c, double *x0,double *y0,double *r0,
+int *t2,double *dt,int *nbSimu, double *lev,double *gm,double *km,
+double *gmic1,double *gmic2, double *kmic1,double *kmic2, double *gmval, double *kmval) {
+ int i,j,i0,i1,i2;
+ double *c2;
+ double **gmic,**kmic;
+ double *ggm,*kkm;
+
+ int erreur=0;
+
+ erreur=corr_disq(point_nb,x,y,c,x0,y0,r0,t2,dt,gm,km);
+ if (erreur!=0) {
+ return -1;
+ }
+
+ /*Définition de i0 : indice où sera stocké l'estimation des bornes de l'IC*/
+ i0=*lev/2*(*nbSimu+1);
+ if (i0<1) i0=1;
+
+ /*Initialisation des tableaux dans lesquels on va stocker les valeurs extremes lors de MC*/
+ taballoc(&gmic,*t2+1,2*i0+10+1);
+ taballoc(&kmic,*t2+1,2*i0+10+1);
+
+ /*Normalisation de g et k et calcul de l et n pour le calcul des p-values*/
+ vecalloc(&ggm,*t2);
+ vecalloc(&kkm,*t2);
+ for(i=0;i<*t2;i++) {
+ ggm[i]=gm[i];
+ kkm[i]=km[i];
+
+ gmval[i]=1;
+ kmval[i]=1;
+ }
+
+ int lp=0;
+ vecalloc(&c2,*point_nb);
+ /* boucle principale de MC*/
+ Rprintf("Monte Carlo simulation\n");
+ for(i=1;i<=*nbSimu;i++) {
+ randmark(*point_nb,c,c2);
+ erreur=corr_disq(point_nb,x,y,c2,x0,y0,r0,t2,dt,gmic1,kmic1);
+ /* si il y a une erreur on recommence une simulation*/
+ if (erreur!=0) {
+ i=i-1;
+ Rprintf("ERREUR mark correlation\n");
+ }
+ else {
+ /*comptage du nombre de |¶obs|<=|¶simu| pour test local*/
+ double gmictmp,kmictmp;
+ for(j=0;j<*t2;j++) {
+ gmictmp=gmic1[j];
+ kmictmp=kmic1[j];
+ if ((float)fabs(ggm[j]-1)<=(float)fabs(gmictmp-1)) {gmval[j]+=1;}
+ if ((float)fabs(kkm[j])<=(float)fabs(kmictmp)) {kmval[j]+=1;}
+ }
+
+ /*Traitement des résultats*/
+ ic(i,i0,gmic,kmic,gmic1,kmic1,*t2);
+ }
+ R_FlushConsole();
+ progress(i,&lp,*nbSimu);
+ }
+
+ i1=i0+2;
+ i2=i0;
+
+ /*Copies des valeurs dans les tableaux résultats*/
+ for(i=0;i<*t2;i++) {
+ gmic1[i]=gmic[i+1][i1];
+ gmic2[i]=gmic[i+1][i2];
+ kmic1[i]=kmic[i+1][i1];
+ kmic2[i]=kmic[i+1][i2];
+ }
+
+
+ freetab(gmic);
+ freetab(kmic);
+ freevec(ggm);
+ freevec(kkm);
+ freevec(c2);
+ return 0;
+}
+
+
+/*Kcor triangles dans rectangle + ic*/
+int corr_tr_rect_ic(int *point_nb,double *x,double *y,double *c, double *xmi,double *xma,double *ymi,double *yma,
+int *triangle_nb, double *ax, double *ay, double *bx, double *by, double *cx, double *cy,
+int *t2,double *dt,int *nbSimu, double *lev,double *gm,double *km,
+double *gmic1,double *gmic2, double *kmic1,double *kmic2, double *gmval, double *kmval) {
+ int i,j,i0,i1,i2;
+ double *c2;
+ double **gmic,**kmic;
+ double *ggm,*kkm;
+
+ int erreur=0;
+
+ erreur=corr_tr_rect(point_nb,x,y,c,xmi,xma,ymi,yma,triangle_nb,ax,ay,bx,by,cx,cy,t2,dt,gm,km);
+ if (erreur!=0) {
+ return -1;
+ }
+
+ /*Définition de i0 : indice où sera stocké l'estimation des bornes de l'IC*/
+ i0=*lev/2*(*nbSimu+1);
+ if (i0<1) i0=1;
+
+ /*Initialisation des tableaux dans lesquels on va stocker les valeurs extremes lors de MC*/
+ taballoc(&gmic,*t2+1,2*i0+10+1);
+ taballoc(&kmic,*t2+1,2*i0+10+1);
+
+ /*Normalisation de g et k et calcul de l et n pour le calcul des p-values*/
+ vecalloc(&ggm,*t2);
+ vecalloc(&kkm,*t2);
+ for(i=0;i<*t2;i++) {
+ ggm[i]=gm[i];
+ kkm[i]=km[i];
+
+ gmval[i]=1;
+ kmval[i]=1;
+ }
+
+ int lp=0;
+ vecalloc(&c2,*point_nb);
+ /* boucle principale de MC*/
+ Rprintf("Monte Carlo simulation\n");
+ for(i=1;i<=*nbSimu;i++) {
+ randmark(*point_nb,c,c2);
+ erreur=corr_tr_rect(point_nb,x,y,c2,xmi,xma,ymi,yma,triangle_nb,ax,ay,bx,by,cx,cy,t2,dt,gmic1,kmic1);
+ /* si il y a une erreur on recommence une simulation*/
+ if (erreur!=0) {
+ i=i-1;
+ Rprintf("ERREUR Intertype\n");
+ }
+ else {
+ /*comptage du nombre de |¶obs|<=|¶simu| pour test local*/
+ double gmictmp,kmictmp;
+ for(j=0;j<*t2;j++) {
+ gmictmp=gmic1[j];
+ kmictmp=kmic1[j];
+ if ((float)fabs(ggm[j]-1)<=(float)fabs(gmictmp-1)) {gmval[j]+=1;}
+ if ((float)fabs(kkm[j])<=(float)fabs(kmictmp)) {kmval[j]+=1;}
+ }
+
+ /*Traitement des résultats*/
+ ic(i,i0,gmic,kmic,gmic1,kmic1,*t2);
+ }
+ R_FlushConsole();
+ progress(i,&lp,*nbSimu);
+ }
+
+ i1=i0+2;
+ i2=i0;
+
+ /*Copies des valeurs dans les tableaux résultats*/
+ for(i=0;i<*t2;i++) {
+ gmic1[i]=gmic[i+1][i1];
+ gmic2[i]=gmic[i+1][i2];
+ kmic1[i]=kmic[i+1][i1];
+ kmic2[i]=kmic[i+1][i2];
+ }
+
+
+ freetab(gmic);
+ freetab(kmic);
+ freevec(ggm);
+ freevec(kkm);
+ freevec(c2);
+ return 0;
+}
+
+/*Kcor triangles dans disque + ic*/
+int corr_tr_disq_ic(int *point_nb,double *x,double *y,double *c, double *x0,double *y0,double *r0,
+int *triangle_nb, double *ax, double *ay, double *bx, double *by, double *cx, double *cy,
+int *t2,double *dt,int *nbSimu, double *lev,double *gm,double *km,
+double *gmic1,double *gmic2, double *kmic1,double *kmic2, double *gmval, double *kmval) {
+ int i,j,i0,i1,i2;
+ double *c2;
+ double **gmic,**kmic;
+ double *ggm,*kkm;
+
+ int erreur=0;
+
+ erreur=corr_tr_disq(point_nb,x,y,c,x0,y0,r0,triangle_nb,ax,ay,bx,by,cx,cy,t2,dt,gm,km);
+ if (erreur!=0) {
+ return -1;
+ }
+
+ /*Définition de i0 : indice où sera stocké l'estimation des bornes de l'IC*/
+ i0=*lev/2*(*nbSimu+1);
+ if (i0<1) i0=1;
+
+ /*Initialisation des tableaux dans lesquels on va stocker les valeurs extremes lors de MC*/
+ taballoc(&gmic,*t2+1,2*i0+10+1);
+ taballoc(&kmic,*t2+1,2*i0+10+1);
+
+ /*Calcul de gm et km pour le calcul des p-values*/
+ vecalloc(&ggm,*t2);
+ vecalloc(&kkm,*t2);
+ for(i=0;i<*t2;i++) {
+ ggm[i]=gm[i];
+ kkm[i]=km[i];
+
+ gmval[i]=1;
+ kmval[i]=1;
+ }
+
+ int lp=0;
+ vecalloc(&c2,*point_nb);
+ /* boucle principale de MC*/
+ Rprintf("Monte Carlo simulation\n");
+ for(i=1;i<=*nbSimu;i++) {
+ randmark(*point_nb,c,c2);
+ erreur=corr_tr_disq(point_nb,x,y,c2,x0,y0,r0,triangle_nb,ax,ay,bx,by,cx,cy,t2,dt,gmic1,kmic1);
+ /* si il y a une erreur on recommence une simulation*/
+ if (erreur!=0) {
+ i=i-1;
+ Rprintf("ERREUR Intertype\n");
+ }
+ else {
+ /*comptage du nombre de |¶obs|<=|¶simu| pour test local*/
+ double gmictmp,kmictmp;
+ for(j=0;j<*t2;j++) {
+ gmictmp=gmic1[j];
+ kmictmp=kmic1[j];
+ if ((float)fabs(ggm[j]-1)<=(float)fabs(gmictmp-1)) {gmval[j]+=1;}
+ if ((float)fabs(kkm[j])<=(float)fabs(kmictmp)) {kmval[j]+=1;}
+ }
+
+ /*Traitement des résultats*/
+ ic(i,i0,gmic,kmic,gmic1,kmic1,*t2);
+ }
+ R_FlushConsole();
+ progress(i,&lp,*nbSimu);
+ }
+
+ i1=i0+2;
+ i2=i0;
+
+ /*Copies des valeurs dans les tableaux résultats*/
+ for(i=0;i<*t2;i++) {
+ gmic1[i]=gmic[i+1][i1];
+ gmic2[i]=gmic[i+1][i2];
+ kmic1[i]=kmic[i+1][i1];
+ kmic2[i]=kmic[i+1][i2];
+ }
+
+
+ freetab(gmic);
+ freetab(kmic);
+ freevec(ggm);
+ freevec(kkm);
+ freevec(c2);
+ return 0;
+}
+
+/*mark permutations*/
+//old version
+/*void randmark2(int point_nb,double *c,double *c2)
+{ int j,jj;
+
+ for(j=0;j<point_nb;j++)
+ c2[j]=-1;
+ j=0;
+ GetRNGstate();
+ while (j<point_nb) {
+ jj=unif_rand()*(point_nb);
+ while (c2[jj]>-1) {
+ jj=unif_rand()*(point_nb);
+ }
+ c2[jj]=c[j];
+ j++;
+ }
+ PutRNGstate();
+}*/
+
+//new version D. Redondo 2013
+void randmark(int point_nb,double *c,double *c2)
+{
+ int j,jj,i;
+ double temp;
+ for(i=0;i<point_nb;i++)
+ {
+ c2[i]=c[i];
+ }
+ GetRNGstate();
+
+ for(j=0;j<point_nb;j++)
+ {
+ jj=unif_rand()*point_nb;
+ temp=c2[j];
+ c2[j]=c2[jj];
+ c2[jj]=temp;
+ }
+ PutRNGstate();
+}
+
+
+/*********************************************************************************************/
+/* Fonctions de Shimatani pour les semis de points multivariŽs + fonctions utilitaires */
+/********************************************************************************************/
+/// fonction de shimatani pour une zone rectangulaire
+int shimatani_rect(int *point_nb,double *x,double *y, double *xmi,double *xma,double *ymi,
+double *yma,int *t2,double *dt,int *nbtype,int *type,double *surface,double *gs, double *ks,int *error)
+{
+ int i,j,z=0;
+ int *l;// contient le nombre d'arbres par espèce
+ int compt[*nbtype+1];// tableau de compteurs pour xx et yy
+ vecintalloc(&l,*nbtype+1);
+ double *ds;
+
+ double *g;
+ double *k;
+ vecalloc(&g,*t2);
+ vecalloc(&k,*t2);
+
+ for(i=1;i<*nbtype+1;i++){
+ l[i]=0;
+ compt[i]=0;
+ for(j=0;j<*point_nb;j++){
+ if(type[j]==i)
+ { l[i]++;
+ }
+ }
+ }
+
+ double **xx;
+ double **yy;
+ xx=taballoca(*nbtype,l);
+ yy=taballoca(*nbtype,l);
+ vecalloc(&ds,*t2);
+
+ complete_tab(*point_nb,xx,yy,type,compt,l,x,y);
+
+ int erreur;
+ double intensity1;
+ double intensity=*point_nb/(*surface);
+ double *gii;
+ double *kii;
+ vecalloc(&gii,*t2);
+ vecalloc(&kii,*t2);
+ double *tabg;
+ double *tabk;
+ vecalloc(&tabg,*t2);
+ vecalloc(&tabk,*t2);
+
+ for(j=0;j<*t2;j++)
+ { gii[j]=0;
+ kii[j]=0;
+ ds[j]=(Pi()*(j+1)*(*dt)*(j+1)*(*dt))-(Pi()*j*j*(*dt)*(*dt));
+ }
+
+ erreur =ripley_rect(point_nb,x,y,xmi,xma,ymi,yma,t2,dt,g,k);
+ if (erreur!=0)
+ { Rprintf("ERREUR 0 Ripley\n");
+ }
+
+ for(j=0;j<*t2;j++)
+ { g[j]=((intensity*intensity)*(g[j])/intensity*ds[j]);
+ // g[j]=intensity*g[j]/ds[j];
+ k[j]=(intensity*(k[j]));
+ tabg[j]=g[j];
+ tabk[j]=k[j];
+ if(g[j]==0)
+ { error[j]=j;
+ z+=1;
+ }
+ }
+ if(z==0)
+ { for(i=0;i<*nbtype;i++)
+ { erreur=ripley_rect(&l[i+1],xx[i],yy[i],xmi,xma,ymi,yma,t2,dt,g,k);
+ if (erreur!=0)
+ { Rprintf("ERREUR 1 Ripley\n");
+ }
+ intensity1=l[i+1]/(*surface);
+ for(j=0;j<*t2;j++)
+ { gii[j]=gii[j]+((intensity1*intensity1)*(g[j])/intensity1*ds[j]);
+ // gii[j]+=intensity1*g[j]/ds[j];
+
+ kii[j]=kii[j]+(intensity1*(k[j]));
+ }
+
+ }
+
+ for(j=0;j<*t2;j++)
+ { gs[j]=1-gii[j]/tabg[j];
+ ks[j]=1-kii[j]/tabk[j];
+ }
+ }
+
+ for( i = 0; i < *nbtype; i++)
+ free(xx[i]);
+ free(xx);
+ for( i = 0; i < *nbtype; i++)
+ free(yy[i]);
+ free(yy);
+ free(g);
+ free(k);
+ free(l);
+
+ free(tabg);
+ free(tabk);
+
+ freevec(gii);
+ freevec(kii);
+ freevec(ds);
+
+ return 0;
+}
+
+int shimatani_disq(int *point_nb,double *x,double *y, double *x0,double *y0,double *r0,
+int *t2,double *dt,int *nbtype,int *type,double *surface,double *gs, double *ks,int *error)
+{
+ int i,j,z=0;
+ int *l;// contient le nombre d'arbres par espèce
+ int compt[*nbtype+1];// tableau de compteurs pour xx et yy
+ vecintalloc(&l,*nbtype+1);
+ double *ds;
+ double *g,*k;
+ vecalloc(&g,*t2);
+ vecalloc(&k,*t2);
+
+ for(i=1;i<*nbtype+1;i++){
+ l[i]=0;
+ compt[i]=0;
+ for(j=0;j<*point_nb;j++){
+ if(type[j]==i)
+ l[i]++;
+ }
+ }
+
+ double **xx;
+ double **yy;
+ xx=taballoca(*nbtype,l);
+ yy=taballoca(*nbtype,l);
+ vecalloc(&ds,*t2);
+ complete_tab(*point_nb,xx,yy,type,compt,l,x,y);
+
+ int erreur;
+ double intensity1;
+ double intensity=*point_nb/(*surface);
+ double *gii,*kii;
+ vecalloc(&gii,*t2);
+ vecalloc(&kii,*t2);
+ double *tabg,*tabk;
+ vecalloc(&tabg,*t2);
+ vecalloc(&tabk,*t2);
+
+ for(j=0;j<*t2;j++)
+ { gii[j]=0;
+ kii[j]=0;
+ ds[j]=(Pi()*(j+1)*(*dt)*(j+1)*(*dt))-(Pi()*j*j*(*dt)*(*dt));
+ }
+
+ erreur =ripley_disq(point_nb,x,y,x0,y0,r0,t2,dt,g,k);
+ if (erreur!=0)
+ Rprintf("ERREUR 0 Ripley\n");
+
+ for(j=0;j<*t2;j++)
+ { g[j]=intensity*intensity*g[j]/intensity*ds[j];
+ k[j]=intensity*k[j];
+ tabg[j]=g[j];
+ tabk[j]=k[j];
+ if(g[j]==0)
+ { error[j]=j;
+ z+=1;
+ }
+ }
+ if(z==0)
+ { for(i=0;i<*nbtype;i++)
+ { erreur=ripley_disq(&l[i+1],xx[i],yy[i],x0,y0,r0,t2,dt,g,k);
+ if (erreur!=0)
+ Rprintf("ERREUR 1 Ripley\n");
+ intensity1=l[i+1]/(*surface);
+ for(j=0;j<*t2;j++)
+ { gii[j]=gii[j]+intensity1*intensity1*g[j]/intensity1*ds[j];
+ kii[j]=kii[j]+intensity1*k[j];
+ }
+ }
+
+ for(j=0;j<*t2;j++)
+ { gs[j]=1-gii[j]/tabg[j];
+ ks[j]=1-kii[j]/tabk[j];
+ }
+ }
+
+ for( i = 0; i < *nbtype; i++)
+ free(xx[i]);
+ free(xx);
+ for( i = 0; i < *nbtype; i++)
+ free(yy[i]);
+ free(yy);
+ free(g);
+ free(k);
+ free(l);
+
+ free(tabg);
+ free(tabk);
+
+ freevec(gii);
+ freevec(kii);
+ freevec(ds);
+
+ return 0;
+}
+
+int shimatani_tr_rect(int *point_nb,double *x,double *y, double *xmi,double *xma,double *ymi,
+double *yma,int *triangle_nb, double *ax, double *ay, double *bx, double *by, double *cx, double *cy,
+int *t2,double *dt,int *nbtype,int *type,double *surface,double *gs, double *ks,int *error)
+{
+ int i,j,z=0;
+ int *l;// contient le nombre d'arbres par espèce
+ int compt[*nbtype+1];// tableau de compteurs pour xx et yy
+ vecintalloc(&l,*nbtype+1);
+ double *ds;
+
+ double *g;
+ double *k;
+ vecalloc(&g,*t2);
+ vecalloc(&k,*t2);
+
+ for(i=1;i<*nbtype+1;i++){
+ l[i]=0;
+ compt[i]=0;
+ for(j=0;j<*point_nb;j++){
+ if(type[j]==i)
+ { l[i]++;
+ }
+ }
+ }
+
+ double **xx;
+ double **yy;
+ xx=taballoca(*nbtype,l);
+ yy=taballoca(*nbtype,l);
+ vecalloc(&ds,*t2);
+
+ complete_tab(*point_nb,xx,yy,type,compt,l,x,y);
+
+ int erreur;
+ double intensity1;
+ double intensity=*point_nb/(*surface);
+ double *gii;
+ double *kii;
+ vecalloc(&gii,*t2);
+ vecalloc(&kii,*t2);
+ double *tabg;
+ double *tabk;
+ vecalloc(&tabg,*t2);
+ vecalloc(&tabk,*t2);
+
+ for(j=0;j<*t2;j++)
+ { gii[j]=0;
+ kii[j]=0;
+ ds[j]=(Pi()*(j+1)*(*dt)*(j+1)*(*dt))-(Pi()*j*j*(*dt)*(*dt));
+ }
+
+ erreur =ripley_tr_rect(point_nb,x,y,xmi,xma,ymi,yma,triangle_nb,ax,ay,bx,by,cx,cy,t2,dt,g,k);
+ if (erreur!=0)
+ { Rprintf("ERREUR 0 Ripley\n");
+ }
+
+ for(j=0;j<*t2;j++)
+ { g[j]=intensity*intensity*g[j]/intensity*ds[j];
+ k[j]=intensity*k[j];
+ tabg[j]=g[j];
+ tabk[j]=k[j];
+ if(g[j]==0)
+ { error[j]=j;
+ z+=1;
+ }
+ }
+ if(z==0)
+ { for(i=0;i<*nbtype;i++)
+ { erreur=ripley_tr_rect(&l[i+1],xx[i],yy[i],xmi,xma,ymi,yma,triangle_nb,ax,ay,bx,by,cx,cy,t2,dt,g,k);
+ if (erreur!=0)
+ { Rprintf("ERREUR 1 Ripley\n");
+ }
+ intensity1=l[i+1]/(*surface);
+ for(j=0;j<*t2;j++)
+ { gii[j]=gii[j]+intensity1*intensity1*g[j]/intensity1*ds[j];
+ kii[j]=kii[j]+intensity1*k[j];
+ }
+ }
+
+ for(j=0;j<*t2;j++)
+ { gs[j]=1-gii[j]/tabg[j];
+ ks[j]=1-kii[j]/tabk[j];
+ }
+ }
+
+ for( i = 0; i < *nbtype; i++)
+ free(xx[i]);
+ free(xx);
+ for( i = 0; i < *nbtype; i++)
+ free(yy[i]);
+ free(yy);
+ free(g);
+ free(k);
+ free(l);
+ free(tabg);
+ free(tabk);
+
+ freevec(gii);
+ freevec(kii);
+ freevec(ds);
+
+ return 0;
+}
+
+int shimatani_tr_disq(int *point_nb,double *x,double *y, double *x0,double *y0,double *r0,
+int *triangle_nb, double *ax, double *ay, double *bx, double *by, double *cx, double *cy,
+int *t2,double *dt,int *nbtype,int *type,double *surface,double *gs, double *ks,int *error)
+{
+ int i,j,z=0;
+ int *l;// contient le nombre d'arbres par espèce
+ int compt[*nbtype+1];// tableau de compteurs pour xx et yy
+ vecintalloc(&l,*nbtype+1);
+ double *ds;
+
+ double *g,*k;
+ vecalloc(&g,*t2);
+ vecalloc(&k,*t2);
+
+ for(i=1;i<*nbtype+1;i++){
+ l[i]=0;
+ compt[i]=0;
+ for(j=0;j<*point_nb;j++){
+ if(type[j]==i)
+ l[i]++;
+ }
+ }
+
+ double **xx,**yy;
+ xx=taballoca(*nbtype,l);
+ yy=taballoca(*nbtype,l);
+ vecalloc(&ds,*t2);
+ complete_tab(*point_nb,xx,yy,type,compt,l,x,y);
+
+ int erreur;
+ double intensity1;
+ double intensity=*point_nb/(*surface);
+ double *gii,*kii;
+ vecalloc(&gii,*t2);
+ vecalloc(&kii,*t2);
+ double *tabg,*tabk;
+ vecalloc(&tabg,*t2);
+ vecalloc(&tabk,*t2);
+
+ for(j=0;j<*t2;j++)
+ { gii[j]=0;
+ kii[j]=0;
+ ds[j]=(Pi()*(j+1)*(*dt)*(j+1)*(*dt))-(Pi()*j*j*(*dt)*(*dt));
+ }
+
+ erreur =ripley_tr_disq(point_nb,x,y,x0,y0,r0,triangle_nb,ax,ay,bx,by,cx,cy,t2,dt,g,k);
+ if (erreur!=0)
+ Rprintf("ERREUR 0 Ripley\n");
+
+ for(j=0;j<*t2;j++)
+ { g[j]=intensity*intensity*g[j]/intensity*ds[j];
+ k[j]=intensity*k[j];
+ tabg[j]=g[j];
+ tabk[j]=k[j];
+ if(g[j]==0)
+ { error[j]=j;
+ z+=1;
+ }
+ }
+ if(z==0)
+ { for(i=0;i<*nbtype;i++)
+ { erreur=ripley_tr_disq(&l[i+1],xx[i],yy[i],x0,y0,r0,triangle_nb,ax,ay,bx,by,cx,cy,t2,dt,g,k);
+ if (erreur!=0)
+ { Rprintf("ERREUR 1 Ripley\n");
+ }
+ intensity1=l[i+1]/(*surface);
+ for(j=0;j<*t2;j++)
+ { gii[j]=gii[j]+intensity1*intensity1*g[j]/intensity1*ds[j];
+ kii[j]=kii[j]+intensity1*k[j];
+ }
+ }
+
+ for(j=0;j<*t2;j++)
+ { gs[j]=1-gii[j]/tabg[j];
+ ks[j]=1-kii[j]/tabk[j];
+ }
+ }
+
+ for( i = 0; i < *nbtype; i++)
+ free(xx[i]);
+ free(xx);
+ for( i = 0; i < *nbtype; i++)
+ free(yy[i]);
+ free(yy);
+ free(g);
+ free(k);
+ free(l);
+ free(tabg);
+ free(tabk);
+
+ freevec(gii);
+ freevec(kii);
+ freevec(ds);
+
+ return 0;
+}
+
+int shimatani_rect_ic(int *point_nb,double *x,double *y, double *xmi,double *xma,double *ymi,double *yma,
+ int *t2,double *dt,int *nbSimu,double *lev,
+ int *nbtype,int *type,double *surface,double *D,
+ double *gs, double *ks,double *gic1,double *gic2,double *kic1,double *kic2,
+ double *gval,double *kval,int *error)
+{
+ int i,j,b,z=0;
+ int *l;// contient le nombre d'arbres par espèce
+ int compt[*nbtype+1];// tableau de compteurs pour xx et yy
+ vecintalloc(&l,*nbtype+1);
+ double *ds;
+ double *g,*k;
+ vecalloc(&g,*t2);
+ vecalloc(&k,*t2);
+
+ for(i=1;i<*nbtype+1;i++){
+ l[i]=0;
+ compt[i]=0;
+ for(j=0;j<*point_nb;j++){
+ if(type[j]==i)
+ l[i]++;
+ }
+ }
+
+ double **xx;
+ double **yy;
+ xx=taballoca(*nbtype,l);
+ yy=taballoca(*nbtype,l);
+ vecalloc(&ds,*t2);
+
+ complete_tab(*point_nb,xx,yy,type,compt,l,x,y);
+
+ int erreur;
+ double intensity1;
+ double intensity=*point_nb/(*surface);
+ double *gii,*kii;
+ vecalloc(&gii,*t2);
+ vecalloc(&kii,*t2);
+ double *tabg,*tabk;
+ vecalloc(&tabg,*t2);
+ vecalloc(&tabk,*t2);
+
+ for(j=0;j<*t2;j++)
+ { gii[j]=0;
+ kii[j]=0;
+ ds[j]=(Pi()*(j+1)*(*dt)*(j+1)*(*dt))-(Pi()*j*j*(*dt)*(*dt));
+ }
+
+ //pour tous les points
+ erreur =ripley_rect(point_nb,x,y,xmi,xma,ymi,yma,t2,dt,g,k);
+ if (erreur!=0)
+ { Rprintf("ERREUR 0 Ripley\n");
+ }
+
+ for(j=0;j<*t2;j++)
+ { g[j]=intensity*intensity*g[j]/intensity*ds[j];
+ k[j]=intensity*k[j];
+ tabg[j]=g[j];
+ tabk[j]=k[j];
+ if(g[j]==0)
+ { error[j]=j;
+ z+=1;
+ }
+ }
+ if(z==0)
+ { //boucle initiale
+ //pour chaque espce
+ for(i=0;i<*nbtype;i++)
+ { erreur=ripley_rect(&l[i+1],xx[i],yy[i],xmi,xma,ymi,yma,t2,dt,g,k);
+ if (erreur!=0)
+ { Rprintf("ERREUR 1 Ripley\n");
+ }
+ intensity1=l[i+1]/ *(surface);
+ for(j=0;j<*t2;j++)
+ { gii[j]=gii[j]+((intensity1*intensity1)*(g[j])/intensity1*ds[j]);
+ kii[j]=kii[j]+(intensity1*(k[j]));
+ }
+ }
+
+ for(j=0;j<*t2;j++)
+ { gs[j]=1-gii[j]/tabg[j];
+ ks[j]=1-kii[j]/tabk[j];
+ }
+
+ //simulations sur gii, kii
+ double **gic,**kic;
+ int i0,i1,i2;
+
+ //Definition de i0 : indice ou sera stocke l'estimation des bornes de l'IC
+ i0=*lev/2*(*nbSimu+1);
+ if (i0<1) i0=1;
+
+ //Initialisation des tableaux dans lesquels on va stocker les valeurs extremes lors de MC
+ taballoc(&gic,*t2+1,2*i0+10+1);
+ taballoc(&kic,*t2+1,2*i0+10+1);
+ double *gsic,*ksic;
+ vecalloc(&gsic,*t2);
+ vecalloc(&ksic,*t2);
+
+ for(i=0;i<*t2;i++)
+ { gval[i]=1;
+ kval[i]=1;
+ }
+
+ int lp=0;
+
+ //boucle principale de MC
+ Rprintf("Monte Carlo simulation\n");
+ for(b=1;b<=*nbSimu;b++)
+ { randomlab(x,y,*point_nb,type,*nbtype,xx,l,yy);
+ for(i=0;i<*t2;i++)
+ { gii[i]=0;
+ kii[i]=0;
+ }
+ for(i=0;i<*nbtype;i++)
+ { erreur=ripley_rect(&l[i+1],xx[i],yy[i],xmi,xma,ymi,yma,t2,dt,gic1,kic1);
+ if (erreur!=0)
+ Rprintf("ERREUR 2 Ripley\n");
+ intensity1=l[i+1]/(*surface);
+ for(j=0;j<*t2;j++)
+ { gii[j]=gii[j]+((intensity1*intensity1)*(gic1[j])/intensity1*ds[j]);
+ kii[j]=kii[j]+(intensity1*(kic1[j]));
+ }
+
+ }
+
+ for(j=0;j<*t2;j++)
+ { gii[j]=1-gii[j]/tabg[j];
+ kii[j]=1-kii[j]/tabk[j];
+ if ((float)fabs(gs[j]-*D)<=(float)fabs(gii[j]-*D)) {gval[j]+=1;}
+ if ((float)fabs(ks[j]-*D)<=(float)fabs(kii[j]-*D)) {kval[j]+=1;}
+ }
+
+ //Traitement des resultats
+ ic(b,i0,gic,kic,gii,kii,*t2);
+ R_FlushConsole();
+ progress(b,&lp,*nbSimu);
+ }
+
+ i1=i0+2;
+ i2=i0;
+
+ //Copies des valeurs dans les tableaux resultats
+ for(i=0;i<*t2;i++)
+ { gic1[i]=gic[i+1][i1];
+ gic2[i]=gic[i+1][i2];
+ kic1[i]=kic[i+1][i1];
+ kic2[i]=kic[i+1][i2];
+ }
+ free(gsic);
+ free(ksic);
+ free(gic);
+ free(kic);
+ }
+
+ for( i = 0; i < *nbtype; i++) {
+ free(xx[i]);
+ free(yy[i]);
+ }
+ free(xx);
+ free(yy);
+ free(g);
+ free(k);
+ free(l);
+
+ free(tabg);
+ free(tabk);
+
+ free(gii);
+ free(kii);
+ free(ds);
+
+ return 0;
+}
+
+int shimatani_disq_ic(int *point_nb,double *x,double *y, double *x0,double *y0,double *r0,
+ int *t2,double *dt,int *nbSimu,double *lev,
+ int *nbtype,int *type,double *surface,double *D,
+ double *gs, double *ks,
+ double *gic1,double *gic2,double *kic1,double *kic2,
+ double *gval,double *kval,int *error)
+{
+ int i,j,b,z=0;
+ int *l;// contient le nombre d'arbres par espèce
+ int compt[*nbtype+1];// tableau de compteurs pour xx et yy
+ vecintalloc(&l,*nbtype+1);
+ double *ds;
+ double *g,*k;
+ vecalloc(&g,*t2);
+ vecalloc(&k,*t2);
+
+ for(i=1;i<*nbtype+1;i++){
+ l[i]=0;
+ compt[i]=0;
+ for(j=0;j<*point_nb;j++){
+ if(type[j]==i)
+ l[i]++;
+ }
+ }
+
+ double **xx,**yy;
+ xx=taballoca(*nbtype,l);
+ yy=taballoca(*nbtype,l);
+ vecalloc(&ds,*t2);
+ complete_tab(*point_nb,xx,yy,type,compt,l,x,y);
+
+ int erreur;
+ double intensity1;
+ double intensity=*point_nb/(*surface);
+ double *gii,*kii;
+ vecalloc(&gii,*t2);
+ vecalloc(&kii,*t2);
+ double *tabg,*tabk;
+ vecalloc(&tabg,*t2);
+ vecalloc(&tabk,*t2);
+
+ for(j=0;j<*t2;j++)
+ { gii[j]=0;
+ kii[j]=0;
+ ds[j]=(Pi()*(j+1)*(*dt)*(j+1)*(*dt))-(Pi()*j*j*(*dt)*(*dt));
+ }
+
+ //pour tous les points
+ erreur =ripley_disq(point_nb,x,y,x0,y0,r0,t2,dt,g,k);
+ if (erreur!=0)
+ Rprintf("ERREUR 0 Ripley\n");
+
+ for(j=0;j<*t2;j++)
+ { g[j]=intensity*intensity*g[j]/intensity*ds[j];
+ k[j]=intensity*k[j];
+ tabg[j]=g[j];
+ tabk[j]=k[j];
+ if(g[j]==0)
+ { error[j]=j;
+ z+=1;
+ }
+ }
+
+ if(z==0)
+ { //boucle initiale
+ //pour chaque espce
+ for(i=0;i<*nbtype;i++)
+ { erreur=ripley_disq(&l[i+1],xx[i],yy[i],x0,y0,r0,t2,dt,g,k);
+ if (erreur!=0)
+ { i=i-1;
+ Rprintf("ERREUR 1 Ripley\n");
+ }
+ intensity1=l[i+1]/ *(surface);
+ for(j=0;j<*t2;j++)
+ { gii[j]=gii[j]+intensity1*intensity1*g[j]/intensity1*ds[j];
+ kii[j]=kii[j]+intensity1*k[j];
+ }
+
+ }
+
+ for(j=0;j<*t2;j++)
+ { gs[j]=1-gii[j]/tabg[j];
+ ks[j]=1-kii[j]/tabk[j];
+ }
+
+ //simulaitons sur gii, kii
+ double **gic,**kic;
+ int i0,i1,i2;
+
+ /*Definition de i0 : indice ou sera stocke l'estimation des bornes de l'IC*/
+ i0=*lev/2*(*nbSimu+1);
+ if (i0<1) i0=1;
+
+ /*Initialisation des tableaux dans lesquels on va stocker les valeurs extremes lors de MC*/
+ taballoc(&gic,*t2+1,2*i0+10+1);
+ taballoc(&kic,*t2+1,2*i0+10+1);
+
+ for(i=0;i<*t2;i++)
+ { gval[i]=1;
+ kval[i]=1;
+ }
+
+ int lp=0;
+
+ /*boucle principale de MC*/
+ Rprintf("Monte Carlo simulation\n");
+ for(b=1;b<=*nbSimu;b++)
+ { randomlab(x,y,*point_nb,type,*nbtype,xx,l,yy);
+ for(i=0;i<*t2;i++)
+ { gii[i]=0;
+ kii[i]=0;
+ }
+ for(i=0;i<*nbtype;i++)
+ { erreur=ripley_disq(&l[i+1],xx[i],yy[i],x0,y0,r0,t2,dt,gic1,kic1);
+ if (erreur!=0)
+ { Rprintf("ERREUR 2 Ripley\n");
+ }
+ intensity1=l[i+1]/(*surface);
+ for(j=0;j<*t2;j++)
+ { gii[j]=gii[j]+((intensity1*intensity1)*(gic1[j])/intensity1*ds[j]);
+ kii[j]=kii[j]+(intensity1*(kic1[j]));
+ }
+ }
+
+ for(j=0;j<*t2;j++)
+ { gii[j]=1-gii[j]/tabg[j];
+ kii[j]=1-kii[j]/tabk[j];
+ if ((float)fabs(gs[j]-*D)<=(float)fabs(gii[j]-*D)) gval[j]+=1;
+ if ((float)fabs(ks[j]-*D)<=(float)fabs(kii[j]-*D)) kval[j]+=1;
+ }
+
+ //Traitement des resultats
+ ic(b,i0,gic,kic,gii,kii,*t2);
+ R_FlushConsole();
+ progress(b,&lp,*nbSimu);
+ }
+
+ i1=i0+2;
+ i2=i0;
+
+ //Copies des valeurs dans les tableaux resultats
+ for(i=0;i<*t2;i++)
+ { gic1[i]=gic[i+1][i1];
+ gic2[i]=gic[i+1][i2];
+ kic1[i]=kic[i+1][i1];
+ kic2[i]=kic[i+1][i2];
+ }
+ free(gic);
+ free(kic);
+ }
+
+ for( i = 0; i < *nbtype; i++) {
+ free(xx[i]);
+ free(yy[i]);
+ }
+ free(xx);
+ free(yy);
+ free(g);
+ free(k);
+ free(l);
+ free(tabg);
+ free(tabk);
+ free(gii);
+ free(kii);
+ free(ds);
+
+ return 0;
+}
+
+int shimatani_tr_rect_ic(int *point_nb,double *x,double *y, double *xmi,double *xma,double *ymi,
+ double *yma,int *triangle_nb, double *ax, double *ay, double *bx, double *by, double *cx, double *cy,
+ int *t2,double *dt,int *nbSimu,double *lev,
+ int *nbtype,int *type,double *surface,double *D,
+ double *gs, double *ks,double *gic1,double *gic2,double *kic1,double *kic2,
+ double *gval,double *kval,int *error)
+{
+ int i,j,b,z=0;
+ int *l;// contient le nombre d'arbres par espèce
+ int compt[*nbtype+1];// tableau de compteurs pour xx et yy
+ vecintalloc(&l,*nbtype+1);
+ double *ds;
+
+ double *g;
+ double *k;
+ vecalloc(&g,*t2);
+ vecalloc(&k,*t2);
+
+ for(i=1;i<*nbtype+1;i++){
+ l[i]=0;
+ compt[i]=0;
+ for(j=0;j<*point_nb;j++){
+ if(type[j]==i)
+ { l[i]++;
+ }
+ }
+ }
+
+ double **xx;
+ double **yy;
+ xx=taballoca(*nbtype,l);
+ yy=taballoca(*nbtype,l);
+ vecalloc(&ds,*t2);
+
+ complete_tab(*point_nb,xx,yy,type,compt,l,x,y);
+
+ int erreur;
+ double intensity1;
+ double intensity=*point_nb/(*surface);
+ double *gii;
+ double *kii;
+ vecalloc(&gii,*t2);
+ vecalloc(&kii,*t2);
+ double *tabg;
+ double *tabk;
+ vecalloc(&tabg,*t2);
+ vecalloc(&tabk,*t2);
+
+ for(j=0;j<*t2;j++)
+ { gii[j]=0;
+ kii[j]=0;
+ ds[j]=(Pi()*(j+1)*(*dt)*(j+1)*(*dt))-(Pi()*j*j*(*dt)*(*dt));
+ }
+
+ //pour tous les points
+ erreur =ripley_tr_rect(point_nb,x,y,xmi,xma,ymi,yma,triangle_nb,ax,ay,bx,by,cx,cy,t2,dt,g,k);
+ if (erreur!=0)
+ { Rprintf("ERREUR 0 Ripley\n");
+ }
+
+ for(j=0;j<*t2;j++)
+ { g[j]=((intensity*intensity)*(g[j])/intensity*ds[j]);
+ k[j]=(intensity*(k[j]));
+ tabg[j]=g[j];
+ tabk[j]=k[j];
+ if(g[j]==0)
+ { error[j]=j;
+ z+=1;
+ }
+ }
+ if(z==0)
+ { //boucle initiale
+ //pour chaque espce
+ for(i=0;i<*nbtype;i++)
+ { erreur=ripley_tr_rect(&l[i+1],xx[i],yy[i],xmi,xma,ymi,yma,triangle_nb,ax,ay,bx,by,cx,cy,t2,dt,g,k);
+ if (erreur!=0)
+ { Rprintf("ERREUR 1 Ripley\n");
+ }
+ intensity1=l[i+1]/ *(surface);
+ for(j=0;j<*t2;j++)
+ { gii[j]=gii[j]+((intensity1*intensity1)*(g[j])/intensity1*ds[j]);
+ kii[j]=kii[j]+(intensity1*(k[j]));
+ }
+ }
+
+ for(j=0;j<*t2;j++)
+ { gs[j]=1-gii[j]/tabg[j];
+ ks[j]=1-kii[j]/tabk[j];
+ }
+
+ //simulaitons sur gii, kii
+ double **gic,**kic;
+ int i0,i1,i2;
+
+ /*Definition de i0 : indice ou sera stocke l'estimation des bornes de l'IC*/
+ i0=*lev/2*(*nbSimu+1);
+ if (i0<1) i0=1;
+
+ /*Initialisation des tableaux dans lesquels on va stocker les valeurs extremes lors de MC*/
+ taballoc(&gic,*t2+1,2*i0+10+1);
+ taballoc(&kic,*t2+1,2*i0+10+1);
+ double *gsic,*ksic;
+ vecalloc(&gsic,*t2);
+ vecalloc(&ksic,*t2);
+
+ for(i=0;i<*t2;i++)
+ { gval[i]=1;
+ kval[i]=1;
+ }
+
+ int lp=0;
+
+ /*boucle principale de MC*/
+ Rprintf("Monte Carlo simulation\n");
+ for(b=1;b<=*nbSimu;b++)
+ { randomlab(x,y,*point_nb,type,*nbtype,xx,l,yy);
+ for(i=0;i<*t2;i++)
+ { gii[i]=0;
+ kii[i]=0;
+ }
+ for(i=0;i<*nbtype;i++)
+ { erreur=ripley_tr_rect(&l[i+1],xx[i],yy[i],xmi,xma,ymi,yma,triangle_nb,ax,ay,bx,by,cx,cy,t2,dt,gic1,kic1);
+ if (erreur!=0)
+ { Rprintf("ERREUR 2 Ripley\n");
+ }
+ intensity1=l[i+1]/(*surface);
+ for(j=0;j<*t2;j++)
+ { gii[j]=gii[j]+((intensity1*intensity1)*(gic1[j])/intensity1*ds[j]);
+ kii[j]=kii[j]+(intensity1*(kic1[j]));
+ }
+
+ }
+
+ for(j=0;j<*t2;j++)
+ { gii[j]=1-gii[j]/tabg[j];
+ kii[j]=1-kii[j]/tabk[j];
+ if ((float)fabs(gs[j]-*D)<=(float)fabs(gii[j]-*D)) {gval[j]+=1;}
+ if ((float)fabs(ks[j]-*D)<=(float)fabs(kii[j]-*D)) {kval[j]+=1;}
+ }
+
+ //Traitement des resultats
+ ic(b,i0,gic,kic,gii,kii,*t2);
+ R_FlushConsole();
+ progress(b,&lp,*nbSimu);
+ }
+
+ i1=i0+2;
+ i2=i0;
+
+ //Copies des valeurs dans les tableaux resultats
+ for(i=0;i<*t2;i++)
+ { gic1[i]=gic[i+1][i1];
+ gic2[i]=gic[i+1][i2];
+ kic1[i]=kic[i+1][i1];
+ kic2[i]=kic[i+1][i2];
+ }
+
+ free(gsic);
+ free(ksic);
+ free(gic);
+ free(kic);
+ }
+
+ for( i = 0; i < *nbtype; i++) {
+ free(xx[i]);
+ free(yy[i]);
+ }
+ free(xx);
+ free(yy);
+ free(g);
+ free(k);
+ free(l);
+ free(tabg);
+ free(tabk);
+ free(gii);
+ free(kii);
+ free(ds);
+
+ return 0;
+}
+
+int shimatani_tr_disq_ic(int *point_nb,double *x,double *y, double *x0,double *y0,double *r0,
+ int *triangle_nb, double *ax, double *ay, double *bx, double *by, double *cx, double *cy,
+ int *t2,double *dt,int *nbSimu,double *lev,
+ int *nbtype,int *type,double *surface,double *D,
+ double *gs, double *ks,
+ double *gic1,double *gic2,double *kic1,double *kic2,
+ double *gval,double *kval,int *error)
+{
+ int i,j,b,z=0;
+ int *l;// contient le nombre d'arbres par espèce
+ int compt[*nbtype+1];// tableau de compteurs pour xx et yy
+ vecintalloc(&l,*nbtype+1);
+ double *ds;
+
+ double *g;
+ double *k;
+ vecalloc(&g,*t2);
+ vecalloc(&k,*t2);
+
+ for(i=1;i<*nbtype+1;i++){
+ l[i]=0;
+ compt[i]=0;
+ for(j=0;j<*point_nb;j++){
+ if(type[j]==i)
+ { l[i]++;
+ }
+ }
+ }
+
+ double **xx;
+ double **yy;
+ xx=taballoca(*nbtype,l);
+ yy=taballoca(*nbtype,l);
+ vecalloc(&ds,*t2);
+
+ complete_tab(*point_nb,xx,yy,type,compt,l,x,y);
+
+ int erreur;
+ double intensity1;
+ double intensity=*point_nb/(*surface);
+ double *gii;
+ double *kii;
+ vecalloc(&gii,*t2);
+ vecalloc(&kii,*t2);
+ double *tabg;
+ double *tabk;
+ vecalloc(&tabg,*t2);
+ vecalloc(&tabk,*t2);
+
+ for(j=0;j<*t2;j++)
+ { gii[j]=0;
+ kii[j]=0;
+ ds[j]=(Pi()*(j+1)*(*dt)*(j+1)*(*dt))-(Pi()*j*j*(*dt)*(*dt));
+ }
+
+ //pour tous les points
+ erreur =ripley_tr_disq(point_nb,x,y,x0,y0,r0,triangle_nb,ax,ay,bx,by,cx,cy,t2,dt,g,k);
+ if (erreur!=0)
+ { Rprintf("ERREUR 0 Ripley\n");
+ }
+
+ for(j=0;j<*t2;j++)
+ { g[j]=((intensity*intensity)*(g[j])/intensity*ds[j]);
+ k[j]=(intensity*(k[j]));
+ tabg[j]=g[j];
+ tabk[j]=k[j];
+ if(g[j]==0)
+ { error[j]=j;
+ z+=1;
+ }
+ }
+ if(z==0)
+ { //boucle initiale
+ //pour chaque espce
+ for(i=0;i<*nbtype;i++)
+ { erreur=ripley_tr_disq(&l[i+1],xx[i],yy[i],x0,y0,r0,triangle_nb,ax,ay,bx,by,cx,cy,t2,dt,g,k);
+ if (erreur!=0)
+ { Rprintf("ERREUR 1 Ripley\n");
+ }
+ intensity1=l[i+1]/ *(surface);
+ for(j=0;j<*t2;j++)
+ { gii[j]=gii[j]+((intensity1*intensity1)*(g[j])/intensity1*ds[j]);
+ kii[j]=kii[j]+(intensity1*(k[j]));
+ }
+ }
+
+ for(j=0;j<*t2;j++)
+ { gs[j]=1-gii[j]/tabg[j];
+ ks[j]=1-kii[j]/tabk[j];
+ }
+
+ //simulaitons sur gii, kii
+ double **gic,**kic;
+ int i0,i1,i2;
+
+ /*Definition de i0 : indice ou sera stocke l'estimation des bornes de l'IC*/
+ i0=*lev/2*(*nbSimu+1);
+ if (i0<1) i0=1;
+
+ /*Initialisation des tableaux dans lesquels on va stocker les valeurs extremes lors de MC*/
+ taballoc(&gic,*t2+1,2*i0+10+1);
+ taballoc(&kic,*t2+1,2*i0+10+1);
+ double *gsic,*ksic;
+ vecalloc(&gsic,*t2);
+ vecalloc(&ksic,*t2);
+
+ for(i=0;i<*t2;i++)
+ { gval[i]=1;
+ kval[i]=1;
+ }
+
+ int lp=0;
+
+ /*boucle principale de MC*/
+ Rprintf("Monte Carlo simulation\n");
+ for(b=1;b<=*nbSimu;b++)
+ { randomlab(x,y,*point_nb,type,*nbtype,xx,l,yy);
+ for(i=0;i<*t2;i++)
+ { gii[i]=0;
+ kii[i]=0;
+ }
+ for(i=0;i<*nbtype;i++)
+ { erreur=ripley_tr_disq(&l[i+1],xx[i],yy[i],x0,y0,r0,triangle_nb,ax,ay,bx,by,cx,cy,t2,dt,gic1,kic1);
+ if (erreur!=0)
+ { Rprintf("ERREUR 2 Ripley\n");
+ }
+ intensity1=l[i+1]/(*surface);
+ for(j=0;j<*t2;j++)
+ { gii[j]=gii[j]+((intensity1*intensity1)*(gic1[j])/intensity1*ds[j]);
+ kii[j]=kii[j]+(intensity1*(kic1[j]));
+ }
+
+ }
+
+ for(j=0;j<*t2;j++)
+ { gii[j]=1-gii[j]/tabg[j];
+ kii[j]=1-kii[j]/tabk[j];
+ if ((float)fabs(gs[j]-*D)<=(float)fabs(gii[j]-*D)) {gval[j]+=1;}
+ if ((float)fabs(ks[j]-*D)<=(float)fabs(kii[j]-*D)) {kval[j]+=1;}
+ }
+
+ //Traitement des resultats
+ ic(b,i0,gic,kic,gii,kii,*t2);
+ R_FlushConsole();
+ progress(b,&lp,*nbSimu);
+ }
+
+ i1=i0+2;
+ i2=i0;
+
+ //Copies des valeurs dans les tableaux resultats
+ for(i=0;i<*t2;i++)
+ { gic1[i]=gic[i+1][i1];
+ gic2[i]=gic[i+1][i2];
+ kic1[i]=kic[i+1][i1];
+ kic2[i]=kic[i+1][i2];
+ }
+
+ free(gsic);
+ free(ksic);
+ free(gic);
+ free(kic);
+ }
+
+ for( i = 0; i < *nbtype; i++) {
+ free(xx[i]);
+ free(yy[i]);
+ }
+ free(xx);
+ free(yy);
+ free(g);
+ free(k);
+ free(l);
+ free(tabg);
+ free(tabk);
+ free(gii);
+ free(kii);
+ free(ds);
+
+ return 0;
+}
+
+/*permutation of multivariate marks*/
+int randomlab(double *x,double *y,int total_nb,int *type,int nb_type, double **xx,int *taille_xy, double **yy) {
+ int j,jj;
+ int erreur=0;
+
+ GetRNGstate();
+
+ for(j=0;j<total_nb;j++) {
+ type[j]=nb_type;
+ }
+ j=0;
+ int i=0;
+
+ while(i<nb_type-1) {
+ //Rprintf("taille :%d\n",taille_xy[i+1]);
+ while (j<taille_xy[i+1]) {
+ jj=unif_rand()*(total_nb);
+ while (type[jj]!=nb_type) {
+ jj=unif_rand()*(total_nb);
+ }
+ type[jj]=i+1;
+ xx[i][j]=x[jj];
+ yy[i][j]=y[jj];
+ j++;
+ }
+ j=0;
+ i++;
+ }
+
+ PutRNGstate();
+
+ jj=0;
+ for(j=0;j<total_nb;j++) {
+ if (type[j]==nb_type) {
+ xx[nb_type-1][jj]=x[j];
+ yy[nb_type-1][jj]=y[j];
+ jj=jj+1;
+ }
+ }
+ if (jj!=taille_xy[nb_type]) {
+ //Rprintf("jj : %d ::: taille : %d\n",jj,taille_xy[nb_type]);
+ erreur=1;
+ }
+ else {
+ erreur=0;
+ }
+ return erreur;
+}
+
+/**********************************************************/
+/* Fonctions de Rao pour les semis de points multivariŽs */
+/**********************************************************/
+//V2 as wrapper of K12fun - 08/2013
+int rao_rect(int *point_nb,double *x,double *y, double *xmi,double *xma,double *ymi,double *yma,
+ int *t2,double *dt,int *h0,int *nbtype,int *type,double *mat,double *surface,double *HD,double *gr, double *kr,double *gs,double *ks,int *error)
+{
+ int i,j,p,z=0;
+ int *l;// contient le nombre d'arbres par espèce
+ int compt[*nbtype+1];// tableau de compteurs pour xx et yy
+ vecintalloc(&l,*nbtype+1);
+ double *ds,dis;
+
+ double *g,*k;
+ vecalloc(&g,*t2);
+ vecalloc(&k,*t2);
+
+ for(i=1;i<*nbtype+1;i++){
+ l[i]=0;
+ compt[i]=0;
+ for(j=0;j<*point_nb;j++){
+ if(type[j]==i)
+ l[i]++;
+ }
+ }
+
+ double **xx,**yy;
+ xx=taballoca(*nbtype,l);
+ yy=taballoca(*nbtype,l);
+ vecalloc(&ds,*t2);
+
+ complete_tab(*point_nb,xx,yy,type,compt,l,x,y);
+
+ int erreur;
+ double intensity1,point_nb2,point_nb1,intensity2;
+ double intensity=*point_nb/(*surface);
+ double *gii,*kii;
+ vecalloc(&gii,*t2);
+ vecalloc(&kii,*t2);
+ double *tabg,*tabk;
+ vecalloc(&tabg,*t2);
+ vecalloc(&tabk,*t2);
+
+ for(j=0;j<*t2;j++)
+ { gii[j]=0;
+ kii[j]=0;
+ ds[j]=(Pi()*(j+1)*(*dt)*(j+1)*(*dt))-(Pi()*j*j*(*dt)*(*dt));
+ }
+ //Ripley all points
+ erreur =ripley_rect(point_nb,x,y,xmi,xma,ymi,yma,t2,dt,g,k);
+ if (erreur!=0)
+ Rprintf("ERREUR 0 Ripley\n");
+
+ // Shimatani function for normalisation under H0=2
+ double D=0;
+ if(*h0==2)
+ { erreur=shimatani_rect(point_nb,x,y,xmi,xma,ymi,yma,t2,dt,nbtype,type,surface,gs,ks,error);
+ for(i=1;i<(*nbtype+1);i++)
+ D+=(float)l[i]*((float)l[i]-1);
+ D=1-D/((float)(*point_nb)*((float)(*point_nb)-1));
+ }
+
+ for(j=0;j<*t2;j++)
+ { g[j]=intensity*g[j]/ds[j];
+ k[j]=intensity*k[j];
+ tabg[j]=g[j];
+ tabk[j]=k[j];
+ if(g[j]==0)
+ { error[j]=j;
+ z+=1;
+ }
+ if(*h0==2) {
+ gs[j]=gs[j]/D;
+ ks[j]=ks[j]/D;
+ }
+ }
+ //Intertype for each pair of types
+ if(z==0)
+ { for(i=1;i<*nbtype;i++)
+ { for(p=0;p<i;p++)
+ { dis=mat[p*(*nbtype-2)-(p-1)*p/2+i-1];
+ erreur=intertype_rect(&l[i+1],xx[i],yy[i],&l[p+1],xx[p],yy[p],xmi,xma,ymi,yma,t2,dt,g,k);
+ if (erreur!=0)
+ Rprintf("ERREUR 1 Intertype\n");
+ intensity1=l[i+1]/(*surface);
+ for(j=0;j<*t2;j++)
+ { gii[j]=gii[j]+dis*intensity1*g[j]/ds[j];
+ kii[j]=kii[j]+dis*intensity1*k[j];
+ }
+ erreur=intertype_rect(&l[p+1],xx[p],yy[p],&l[i+1],xx[i],yy[i],xmi,xma,ymi,yma,t2,dt,g,k);
+ if (erreur!=0)
+ Rprintf("ERREUR 2 Intertype\n");
+ intensity2=l[p+1]/(*surface);
+ for(j=0;j<*t2;j++)
+ { gii[j]=gii[j]+dis*intensity2*g[j]/ds[j];
+ kii[j]=kii[j]+dis*intensity2*k[j];
+ }
+ }
+ }
+
+ for(j=0;j<*t2;j++)
+ { gr[j]=gii[j]/(tabg[j]*(*HD));
+ kr[j]=kii[j]/(tabk[j]*(*HD));
+ }
+ }
+
+ for(i=0;i<*nbtype;i++)
+ { free(xx[i]);
+ free(yy[i]);
+ }
+ free(xx);
+ free(yy);
+ free(g);
+ free(k);
+ free(l);
+
+ free(tabg);
+ free(tabk);
+
+ freevec(gii);
+ freevec(kii);
+ freevec(ds);
+
+ return 0;
+}
+
+int rao_rect_ic(int *point_nb,double *x,double *y, double *xmi,double *xma,double *ymi,double *yma,
+ int *t2,double *dt,int *nbSimu, int *h0, double *lev,
+ int *nbtype,int *type,double *mat,double *surface,double *HD,
+ double *gr, double *kr,double *gs,double *ks, double *gic1,double *gic2,double *kic1,double *kic2,
+ double *gval,double *kval,int *error)
+{
+ int i,j,p,b,z=0;
+ int *l;
+ int compt[*nbtype+1];
+ vecintalloc(&l,*nbtype+1);
+ double *ds,dis;
+ double *g,*k;
+ vecalloc(&g,*t2);
+ vecalloc(&k,*t2);
+
+ // l contient le nombre d'arbres par espce
+ for(i=1;i<*nbtype+1;i++){
+ l[i]=0;
+ compt[i]=0;
+ for(j=0;j<*point_nb;j++){
+ if(type[j]==i)
+ l[i]++;
+ }
+ }
+
+ // crŽation des tableaux xx et yy par espce
+ double **xx,**yy;
+ xx=taballoca(*nbtype,l);
+ yy=taballoca(*nbtype,l);
+ vecalloc(&ds,*t2);
+ complete_tab(*point_nb,xx,yy,type,compt,l,x,y);
+
+ //Ripley for all points
+ int erreur;
+ double intensity1,point_nb2,point_nb1,intensity2;
+ double intensity=*point_nb/(*surface);
+ double *gii,*kii;
+ vecalloc(&gii,*t2);
+ vecalloc(&kii,*t2);
+ double *tabg,*tabk;
+ vecalloc(&tabg,*t2);
+ vecalloc(&tabk,*t2);
+
+ for(j=0;j<*t2;j++)
+ { gii[j]=0;
+ kii[j]=0;
+ ds[j]=(Pi()*(j+1)*(*dt)*(j+1)*(*dt))-(Pi()*j*j*(*dt)*(*dt));
+ }
+
+ erreur =ripley_rect(point_nb,x,y,xmi,xma,ymi,yma,t2,dt,g,k);
+ if (erreur!=0)
+ Rprintf("ERREUR 0 Ripley\n");
+
+ // Shimatani function for normalisation under H0=2
+ double D=0;
+ if(*h0==2)
+ { erreur=shimatani_rect(point_nb,x,y,xmi,xma,ymi,yma,t2,dt,nbtype,type,surface,gs,ks,error);
+ for(i=1;i<(*nbtype+1);i++)
+ D+=(float)l[i]*((float)l[i]-1);
+ D=1-D/((float)(*point_nb)*((float)(*point_nb)-1));
+ }
+ //standardization de Ripley (et Shimatani si H0=2)
+ for(j=0;j<*t2;j++)
+ { g[j]=intensity*g[j]/ds[j];
+ k[j]=intensity*k[j];
+ tabg[j]=g[j];
+ tabk[j]=k[j];
+ if(g[j]==0)
+ { error[j]=j;
+ z+=1;
+ }
+ if(*h0==2) {
+ gs[j]=gs[j]/D;
+ ks[j]=ks[j]/D;
+ }
+ }
+
+ //Intertype for each pairs of types
+ if(z==0)
+ { for(i=1;i<*nbtype;i++)
+ { for(p=0;p<i;p++)
+ { dis=mat[p*(*nbtype-2)-(p-1)*p/2+i-1];
+ erreur=intertype_rect(&l[i+1],xx[i],yy[i],&l[p+1],xx[p],yy[p],xmi,xma,ymi,yma,t2,dt,g,k);
+ if (erreur!=0)
+ Rprintf("ERREUR 1 Intertype\n");
+ intensity1=l[i+1]/(*surface);
+ for(j=0;j<*t2;j++)
+ { gii[j]=gii[j]+dis*intensity1*g[j]/ds[j];
+ kii[j]=kii[j]+dis*intensity1*k[j];
+ }
+ erreur=intertype_rect(&l[p+1],xx[p],yy[p],&l[i+1],xx[i],yy[i],xmi,xma,ymi,yma,t2,dt,g,k);
+ if (erreur!=0)
+ Rprintf("ERREUR 2 Intertype\n");
+ intensity2=l[p+1]/(*surface);
+ for(j=0;j<*t2;j++)
+ { gii[j]=gii[j]+dis*intensity2*g[j]/ds[j];
+ kii[j]=kii[j]+dis*intensity2*k[j];
+ }
+ }
+ }
+
+ for(j=0;j<*t2;j++)
+ { gr[j]=gii[j]/(tabg[j]*(*HD));
+ kr[j]=kii[j]/(tabk[j]*(*HD));
+ }
+
+ //simulations sur gii, kii
+ double **gic,**kic;
+ int i0,i1,i2;
+
+ //Definition de i0 : indice ou sera stocke l'estimation des bornes de l'IC
+ i0=*lev/2*(*nbSimu+1);
+ if (i0<1) i0=1;
+
+ //Initialisation des tableaux dans lesquels on va stocker les valeurs extremes lors de MC
+ taballoc(&gic,*t2+1,2*i0+10+1);
+ taballoc(&kic,*t2+1,2*i0+10+1);
+
+ for(i=0;i<*t2;i++)
+ { gval[i]=1;
+ kval[i]=1;
+ }
+ //prŽparation des tableaux pour randomisation de dis (H0=2)
+ int lp=0;
+ double HDsim;
+ int *vec, mat_size;
+ vecintalloc(&vec,*nbtype);
+ double *matp;
+ mat_size=*nbtype*(*nbtype-1)/2;
+ vecalloc(&matp,mat_size);
+ if(*h0==2) {
+ for(i=0;i<*nbtype;i++)
+ vec[i]=i;
+ for(i=0;i<mat_size;i++)
+ matp[i]=0;
+ }
+
+ //boucle principale de MC
+ Rprintf("Monte Carlo simulation\n");
+ for(b=1;b<=*nbSimu;b++)
+ { if(*h0==1) //random labelling
+ randomlab(x,y,*point_nb,type,*nbtype,xx,l,yy);
+ if(*h0==2) //distance randomisation
+ randomdist(vec,*nbtype,mat,matp);
+ HDsim=0;
+ for(i=0;i<*t2;i++)
+ { gii[i]=0;
+ kii[i]=0;
+ }
+ for(i=1;i<*nbtype;i++)
+ { for(p=0;p<i;p++)
+ { if(*h0==1)
+ dis=mat[p*(*nbtype-2)-(p-1)*p/2+i-1];
+ if(*h0==2) {
+ dis=matp[p*(*nbtype-2)-(p-1)*p/2+i-1];
+ HDsim+=(float)l[i+1]/(float)(*point_nb)*(float)l[p+1]/(float)(*point_nb)*dis;
+ }
+ erreur=intertype_rect(&l[i+1],xx[i],yy[i],&l[p+1],xx[p],yy[p],xmi,xma,ymi,yma,t2,dt,gic1,kic1);
+ if (erreur!=0)
+ Rprintf("ERREUR 1 Intertype\n");
+ intensity1=l[i+1]/(*surface);
+ for(j=0;j<*t2;j++)
+ { gii[j]=gii[j]+dis*intensity1*gic1[j]/ds[j];
+ kii[j]=kii[j]+dis*intensity1*kic1[j];
+ }
+ erreur=intertype_rect(&l[p+1],xx[p],yy[p],&l[i+1],xx[i],yy[i],xmi,xma,ymi,yma,t2,dt,gic1,kic1);
+ if (erreur!=0)
+ Rprintf("ERREUR 2 Intertype\n");
+ intensity2=l[p+1]/(*surface);
+ for(j=0;j<*t2;j++)
+ { gii[j]=gii[j]+dis*intensity2*gic1[j]/ds[j];
+ kii[j]=kii[j]+dis*intensity2*kic1[j];
+ }
+ }
+ }
+
+ for(j=0;j<*t2;j++)
+ { if(*h0==1) {// standardisation by HD when species labels are randomized
+ gii[j]=gii[j]/(tabg[j]*(*HD));
+ kii[j]=kii[j]/(tabk[j]*(*HD));
+ //deviation from theo=1
+ if ((float)fabs(gr[j]-1)<=(float)fabs(gii[j]-1)) gval[j]+=1;
+ if ((float)fabs(kr[j]-1)<=(float)fabs(kii[j]-1)) kval[j]+=1;
+ }
+ if(*h0==2) {// standardisation by Hsim when distance matrix is randomized
+ gii[j]=gii[j]/(tabg[j]*2*HDsim);
+ kii[j]=kii[j]/(tabk[j]*2*HDsim);
+ //deviation from theo=shimatani
+ if ((float)fabs(gr[j]-gs[j])<=(float)fabs(gii[j]-gs[j])) gval[j]+=1;
+ if ((float)fabs(kr[j]-ks[j])<=(float)fabs(kii[j]-ks[j])) kval[j]+=1;
+ }
+ }
+
+ //Traitement des resultats
+ ic(b,i0,gic,kic,gii,kii,*t2);
+ R_FlushConsole();
+ progress(b,&lp,*nbSimu);
+ }
+
+ i1=i0+2;
+ i2=i0;
+
+ //Copies des valeurs dans les tableaux resultats
+ for(i=0;i<*t2;i++)
+ { gic1[i]=gic[i+1][i1];
+ gic2[i]=gic[i+1][i2];
+ kic1[i]=kic[i+1][i1];
+ kic2[i]=kic[i+1][i2];
+ }
+ free(gic);
+ free(kic);
+ freeintvec(vec);
+ freevec(matp);
+ }
+
+
+ for( i = 0; i < *nbtype; i++)
+ { free(xx[i]);
+ free(yy[i]);
+ }
+ free(xx);
+ free(yy);
+ free(g);
+ free(k);
+ free(l);
+
+
+ free(tabg);
+ free(tabk);
+
+ freevec(gii);
+ freevec(kii);
+ freevec(ds);
+ return 0;
+}
+
+int rao_disq(int *point_nb,double *x,double *y, double *x0,double *y0,double *r0,
+ int *t2,double *dt,int *h0,int *nbtype,int *type,double *mat,double *surface,double *HD,double *gr, double *kr,double *gs,double *ks,int *error)
+{
+ int i,j,p,z=0;
+ int *l;// contient le nombre d'arbres par espèce
+ int compt[*nbtype+1];// tableau de compteurs pour xx et yy
+ vecintalloc(&l,*nbtype+1);
+ double *ds,dis;
+
+ double *g;
+ double *k;
+ vecalloc(&g,*t2);
+ vecalloc(&k,*t2);
+
+ for(i=1;i<*nbtype+1;i++){
+ l[i]=0;
+ compt[i]=0;
+ for(j=0;j<*point_nb;j++){
+ if(type[j]==i)
+ l[i]++;
+ }
+ }
+
+ double **xx;
+ double **yy;
+ xx=taballoca(*nbtype,l);
+ yy=taballoca(*nbtype,l);
+ vecalloc(&ds,*t2);
+
+ complete_tab(*point_nb,xx,yy,type,compt,l,x,y);
+
+ int erreur;
+ double intensity1,point_nb1,point_nb2,intensity2;
+ double intensity=*point_nb/(*surface);
+ double *gii,*kii;
+ vecalloc(&gii,*t2);
+ vecalloc(&kii,*t2);
+ double *tabg,*tabk;
+ vecalloc(&tabg,*t2);
+ vecalloc(&tabk,*t2);
+
+ for(j=0;j<*t2;j++)
+ { gii[j]=0;
+ kii[j]=0;
+ ds[j]=(Pi()*(j+1)*(*dt)*(j+1)*(*dt))-(Pi()*j*j*(*dt)*(*dt));
+ }
+ //Ripley all points
+ erreur =ripley_disq(point_nb,x,y,x0,y0,r0,t2,dt,g,k);
+ if (erreur!=0)
+ Rprintf("ERREUR 0 Ripley\n");
+
+ // Shimatani function for normalisation under H0=2
+ double D=0;
+ if(*h0==2)
+ { erreur=shimatani_disq(point_nb,x,y,x0,y0,r0,t2,dt,nbtype,type,surface,gs,ks,error);
+ for(i=1;i<(*nbtype+1);i++)
+ D+=(float)l[i]*((float)l[i]-1);
+ D=1-D/((float)(*point_nb)*((float)(*point_nb)-1));
+ }
+
+ for(j=0;j<*t2;j++)
+ { g[j]=intensity*g[j]/ds[j];
+ k[j]=intensity*k[j];
+ tabg[j]=g[j];
+ tabk[j]=k[j];
+ if(g[j]==0)
+ { error[j]=j;
+ z+=1;
+ }
+ if(*h0==2) {
+ gs[j]=gs[j]/D;
+ ks[j]=ks[j]/D;
+ }
+ }
+ //Intertype for each pair of types
+ if(z==0)
+ { for(i=0;i<*nbtype;i++)
+ { for(p=0;p<i;p++)
+ { dis=mat[p*(*nbtype-2)-(p-1)*p/2+i-1];
+ erreur=intertype_disq(&l[i+1],xx[i],yy[i],&l[p+1],xx[p],yy[p],x0,y0,r0,t2,dt,g,k);
+ if (erreur!=0)
+ Rprintf("ERREUR 1 Intertype\n");
+ intensity1=l[i+1]/(*surface);
+ for(j=0;j<*t2;j++)
+ { gii[j]=gii[j]+dis*intensity1*g[j]/ds[j];
+ kii[j]=kii[j]+dis*intensity1*k[j];
+ }
+ erreur=intertype_disq(&l[p+1],xx[p],yy[p],&l[i+1],xx[i],yy[i],x0,y0,r0,t2,dt,g,k);
+ if (erreur!=0)
+ Rprintf("ERREUR 2 Intertype\n");
+ intensity2=l[p+1]/(*surface);
+ for(j=0;j<*t2;j++)
+ { gii[j]=gii[j]+dis*intensity2*g[j]/ds[j];
+ kii[j]=kii[j]+dis*intensity2*k[j];
+ }
+ }
+ }
+ for(j=0;j<*t2;j++)
+ { gr[j]=gii[j]/(tabg[j]*(*HD));
+ kr[j]=kii[j]/(tabk[j]*(*HD));
+ }
+ }
+
+ for(i=0;i<*nbtype;i++)
+ { free(xx[i]);
+ free(yy[i]);
+ }
+ free(xx);
+ free(yy);
+ free(g);
+ free(k);
+ free(l);
+
+ free(tabg);
+ free(tabk);
+
+ freevec(gii);
+ freevec(kii);
+ freevec(ds);
+
+ return 0;
+}
+
+int rao_disq_ic(int *point_nb,double *x,double *y, double *x0,double *y0,double *r0,
+ int *t2,double *dt,int *nbSimu,int *h0,double *lev,
+ int *nbtype,int *type,double *mat,double *surface,double *HD,
+ double *gr, double *kr,double *gs,double *ks,double *gic1,double *gic2,double *kic1,double *kic2,
+ double *gval,double *kval,int *error)
+{
+ int i,j,p,b,z=0;
+ int *l;// contient le nombre d'arbres par espèce
+ int compt[*nbtype+1];// tableau de compteurs pour xx et yy
+ vecintalloc(&l,*nbtype+1);
+ double *ds,dis;
+ double *g,*k;
+ vecalloc(&g,*t2);
+ vecalloc(&k,*t2);
+
+ for(i=1;i<*nbtype+1;i++){
+ l[i]=0;
+ compt[i]=0;
+ for(j=0;j<*point_nb;j++){
+ if(type[j]==i)
+ l[i]++;
+ }
+ }
+
+ double **xx;
+ double **yy;
+ xx=taballoca(*nbtype,l);
+ yy=taballoca(*nbtype,l);
+ vecalloc(&ds,*t2);
+ complete_tab(*point_nb,xx,yy,type,compt,l,x,y);
+
+ //Ripley for all points
+ int erreur,ind;
+ double intensity1,point_nb1,point_nb2,intensity2;
+ double intensity=*point_nb/(*surface);
+ double *gii,*kii;
+ vecalloc(&gii,*t2);
+ vecalloc(&kii,*t2);
+ double *tabg,*tabk;
+ vecalloc(&tabg,*t2);
+ vecalloc(&tabk,*t2);
+
+ for(j=0;j<*t2;j++)
+ { gii[j]=0;
+ kii[j]=0;
+ ds[j]=(Pi()*(j+1)*(*dt)*(j+1)*(*dt))-(Pi()*j*j*(*dt)*(*dt));
+ }
+
+ erreur =ripley_disq(point_nb,x,y,x0,y0,r0,t2,dt,g,k);
+ if (erreur!=0)
+ Rprintf("ERREUR 0 Ripley\n");
+
+ // Shimatani function for normalisation under H0=2
+ double D=0;
+ if(*h0==2)
+ { erreur=shimatani_disq(point_nb,x,y,x0,y0,r0,t2,dt,nbtype,type,surface,gs,ks,error);
+ for(i=1;i<(*nbtype+1);i++)
+ D+=(float)l[i]*((float)l[i]-1);
+ D=1-D/((float)(*point_nb)*((float)(*point_nb)-1));
+ }
+ //standardization de Ripley (et Shimatani si H0=2)
+ for(j=0;j<*t2;j++)
+ { g[j]=intensity*g[j]/ds[j];
+ k[j]=intensity*k[j];
+ tabg[j]=g[j];
+ tabk[j]=k[j];
+ if(g[j]==0)
+ { error[j]=j;
+ z+=1;
+ }
+ if(*h0==2) {
+ gs[j]=gs[j]/D;
+ ks[j]=ks[j]/D;
+ }
+ }
+ //Intertype for each pair of types
+ if(z==0)
+ { for(i=0;i<*nbtype;i++)
+ { for(p=0;p<i;p++)
+ { dis=mat[p*(*nbtype-2)-(p-1)*p/2+i-1];
+ erreur=intertype_disq(&l[i+1],xx[i],yy[i],&l[p+1],xx[p],yy[p],x0,y0,r0,t2,dt,g,k);
+ if (erreur!=0)
+ Rprintf("ERREUR 1 Intertype\n");
+ intensity1=l[i+1]/(*surface);
+ for(j=0;j<*t2;j++)
+ { gii[j]=gii[j]+dis*intensity1*g[j]/ds[j];
+ kii[j]=kii[j]+dis*intensity1*k[j];
+ }
+ erreur=intertype_disq(&l[p+1],xx[p],yy[p],&l[i+1],xx[i],yy[i],x0,y0,r0,t2,dt,g,k);
+ if (erreur!=0)
+ Rprintf("ERREUR 2 Intertype\n");
+ intensity2=l[p+1]/(*surface);
+ for(j=0;j<*t2;j++)
+ { gii[j]=gii[j]+dis*intensity2*g[j]/ds[j];
+ kii[j]=kii[j]+dis*intensity2*k[j];
+ }
+ }
+ }
+ for(j=0;j<*t2;j++)
+ { gr[j]=gii[j]/(tabg[j]*(*HD));
+ kr[j]=kii[j]/(tabk[j]*(*HD));
+ }
+
+ //simulaitons sur gii, kii
+ double **gic,**kic;
+ int i0,i1,i2;
+
+ /*Definition de i0 : indice ou sera stocke l'estimation des bornes de l'IC*/
+ i0=*lev/2*(*nbSimu+1);
+ if (i0<1) i0=1;
+
+ /*Initialisation des tableaux dans lesquels on va stocker les valeurs extremes lors de MC*/
+ taballoc(&gic,*t2+1,2*i0+10+1);
+ taballoc(&kic,*t2+1,2*i0+10+1);
+
+ for(i=0;i<*t2;i++)
+ { gval[i]=1;
+ kval[i]=1;
+ }
+
+ int lp=0;
+ double HDsim;
+ int *vec, mat_size;
+ vecintalloc(&vec,*nbtype);
+ double *matp;
+ mat_size=*nbtype*(*nbtype-1)/2;
+ vecalloc(&matp,mat_size);
+ if(*h0==2) {
+ for(i=0;i<*nbtype;i++)
+ vec[i]=i;
+ for(i=0;i<mat_size;i++)
+ matp[i]=0;
+ }
+
+ /*boucle principale de MC*/
+ Rprintf("Monte Carlo simulation\n");
+ for(b=1;b<=*nbSimu;b++)
+ { if(*h0==1) //random labelling
+ randomlab(x,y,*point_nb,type,*nbtype,xx,l,yy);
+ if(*h0==2) //distance randomisation
+ randomdist(vec,*nbtype,mat,matp);
+ HDsim=0;
+ for(i=0;i<*t2;i++)
+ { gii[i]=0;
+ kii[i]=0;
+ }
+ for(i=0;i<*nbtype;i++)
+ { for(p=0;p<i;p++)
+ { if(*h0==1)
+ dis=mat[p*(*nbtype-2)-(p-1)*p/2+i-1];
+ if(*h0==2) {
+ dis=matp[p*(*nbtype-2)-(p-1)*p/2+i-1];
+ HDsim+=(float)l[i+1]/(float)(*point_nb)*(float)l[p+1]/(float)(*point_nb)*dis;
+ }
+ erreur=intertype_disq(&l[i+1],xx[i],yy[i],&l[p+1],xx[p],yy[p],x0,y0,r0,t2,dt,g,k);
+ if (erreur!=0)
+ Rprintf("ERREUR 1 Intertype\n");
+ intensity1=l[i+1]/(*surface);
+ for(j=0;j<*t2;j++)
+ { gii[j]=gii[j]+dis*intensity1*g[j]/ds[j];
+ kii[j]=kii[j]+dis*intensity1*k[j];
+ }
+ erreur=intertype_disq(&l[p+1],xx[p],yy[p],&l[i+1],xx[i],yy[i],x0,y0,r0,t2,dt,g,k);
+ if (erreur!=0)
+ Rprintf("ERREUR 2 Intertype\n");
+ intensity2=l[p+1]/(*surface);
+ for(j=0;j<*t2;j++)
+ { gii[j]=gii[j]+dis*intensity2*g[j]/ds[j];
+ kii[j]=kii[j]+dis*intensity2*k[j];
+ }
+ }
+ }
+ for(j=0;j<*t2;j++)
+ { if(*h0==1) {// standardisation by HD when species labels are randomized
+ gii[j]=gii[j]/(tabg[j]*(*HD));
+ kii[j]=kii[j]/(tabk[j]*(*HD));
+ //deviation from theo=1
+ if ((float)fabs(gr[j]-1)<=(float)fabs(gii[j]-1)) gval[j]+=1;
+ if ((float)fabs(kr[j]-1)<=(float)fabs(kii[j]-1)) kval[j]+=1;
+ }
+ if(*h0==2) {// standardisation by Hsim when distance matrix is randomized
+ gii[j]=gii[j]/(tabg[j]*2*HDsim);
+ kii[j]=kii[j]/(tabk[j]*2*HDsim);
+ //deviation from theo=shimatani
+ if ((float)fabs(gr[j]-gs[j])<=(float)fabs(gii[j]-gs[j])) gval[j]+=1;
+ if ((float)fabs(kr[j]-ks[j])<=(float)fabs(kii[j]-ks[j])) kval[j]+=1;
+ }
+
+ }
+
+ //Traitement des resultats
+ ic(b,i0,gic,kic,gii,kii,*t2);
+ R_FlushConsole();
+ progress(b,&lp,*nbSimu);
+ }
+
+ i1=i0+2;
+ i2=i0;
+
+ //Copies des valeurs dans les tableaux resultats
+ for(i=0;i<*t2;i++)
+ { gic1[i]=gic[i+1][i1];
+ gic2[i]=gic[i+1][i2];
+ kic1[i]=kic[i+1][i1];
+ kic2[i]=kic[i+1][i2];
+ }
+ free(gic);
+ free(kic);
+ freeintvec(vec);
+ freevec(matp);
+ }
+
+ for( i = 0; i < *nbtype; i++)
+ { free(xx[i]);
+ free(yy[i]);
+ }
+ free(xx);
+ free(yy);
+ free(g);
+ free(k);
+ free(l);
+
+ free(tabg);
+ free(tabk);
+
+ freevec(gii);
+ freevec(kii);
+ freevec(ds);
+
+ return 0;
+}
+
+int rao_tr_rect(int *point_nb,double *x,double *y, double *xmi,double *xma,double *ymi,
+ double *yma,int *triangle_nb, double *ax, double *ay, double *bx, double *by, double *cx, double *cy,
+ int *t2,double *dt,int *h0,int *nbtype,int *type,double *mat,double *surface,double *HD,double *gr, double *kr,double *gs,double *ks,int *error)
+{
+ int i,j,p,z=0;
+ int *l;// contient le nombre d'arbres par espèce
+ int compt[*nbtype+1];// tableau de compteurs pour xx et yy
+ vecintalloc(&l,*nbtype+1);
+ double *ds,dis;
+
+ double *g,*k;
+ vecalloc(&g,*t2);
+ vecalloc(&k,*t2);
+
+ for(i=1;i<*nbtype+1;i++){
+ l[i]=0;
+ compt[i]=0;
+ for(j=0;j<*point_nb;j++){
+ if(type[j]==i)
+ l[i]++;
+ }
+ }
+
+ double **xx,**yy;
+ xx=taballoca(*nbtype,l);
+ yy=taballoca(*nbtype,l);
+ vecalloc(&ds,*t2);
+ complete_tab(*point_nb,xx,yy,type,compt,l,x,y);
+
+ int erreur;
+ double intensity1,point_nb2,point_nb1,intensity2;
+ double intensity=*point_nb/(*surface);
+ double *gii,*kii;
+ vecalloc(&gii,*t2);
+ vecalloc(&kii,*t2);
+ double *tabg,*tabk;
+ vecalloc(&tabg,*t2);
+ vecalloc(&tabk,*t2);
+
+ for(j=0;j<*t2;j++)
+ { gii[j]=0;
+ kii[j]=0;
+ ds[j]=(Pi()*(j+1)*(*dt)*(j+1)*(*dt))-(Pi()*j*j*(*dt)*(*dt));
+ }
+ //Ripley all points
+ erreur =ripley_tr_rect(point_nb,x,y,xmi,xma,ymi,yma,triangle_nb,ax,ay,bx,by,cx,cy,t2,dt,g,k);
+ if (erreur!=0)
+ Rprintf("ERREUR 0 Ripley\n");
+
+ // Shimatani function for normalisation under H0=2
+ double D=0;
+ if(*h0==2)
+ { erreur=shimatani_tr_rect(point_nb,x,y,xmi,xma,ymi,yma,triangle_nb,ax,ay,bx,by,cx,cy,t2,dt,nbtype,type,surface,gs,ks,error);
+ for(i=1;i<(*nbtype+1);i++)
+ D+=(float)l[i]*((float)l[i]-1);
+ D=1-D/((float)(*point_nb)*((float)(*point_nb)-1));
+ }
+
+ for(j=0;j<*t2;j++)
+ { g[j]=intensity*g[j]/ds[j];
+ k[j]=intensity*k[j];
+ tabg[j]=g[j];
+ tabk[j]=k[j];
+ if(g[j]==0)
+ { error[j]=j;
+ z+=1;
+ }
+ if(*h0==2) {
+ gs[j]=gs[j]/D;
+ ks[j]=ks[j]/D;
+ }
+ }
+ //Intertype for each pair of types
+ if(z==0)
+ { for(i=1;i<*nbtype;i++)
+ { for(p=0;p<i;p++)
+ { dis=mat[p*(*nbtype-2)-(p-1)*p/2+i-1];
+ erreur=intertype_tr_rect(&l[i+1],xx[i],yy[i],&l[p+1],xx[p],yy[p],xmi,xma,ymi,yma,triangle_nb,ax,ay,bx,by,cx,cy,t2,dt,g,k);
+ if (erreur!=0)
+ Rprintf("ERREUR 1 Intertype\n");
+ intensity1=l[i+1]/(*surface);
+ for(j=0;j<*t2;j++)
+ { gii[j]=gii[j]+dis*intensity1*g[j]/ds[j];
+ kii[j]=kii[j]+dis*intensity1*k[j];
+ }
+ erreur=intertype_tr_rect(&l[p+1],xx[p],yy[p],&l[i+1],xx[i],yy[i],xmi,xma,ymi,yma,triangle_nb,ax,ay,bx,by,cx,cy,t2,dt,g,k);
+ if (erreur!=0)
+ Rprintf("ERREUR 2 Intertype\n");
+ intensity2=l[p+1]/(*surface);
+ for(j=0;j<*t2;j++)
+ { gii[j]=gii[j]+dis*intensity2*g[j]/ds[j];
+ kii[j]=kii[j]+dis*intensity2*k[j];
+ }
+ }
+ }
+
+ for(j=0;j<*t2;j++)
+ { gr[j]=gii[j]/(tabg[j]*(*HD));
+ kr[j]=kii[j]/(tabk[j]*(*HD));
+ }
+ }
+
+ for( i = 0; i < *nbtype; i++)
+ { free(xx[i]);
+ free(yy[i]);
+ }
+ free(xx);
+ free(yy);
+ free(g);
+ free(k);
+ free(l);
+
+ free(tabg);
+ free(tabk);
+
+ freevec(gii);
+ freevec(kii);
+ freevec(ds);
+
+ return 0;
+}
+
+
+
+/***************/
+int rao_tr_disq(int *point_nb,double *x,double *y, double *x0,double *y0,
+ double *r0,int *triangle_nb, double *ax, double *ay, double *bx, double *by, double *cx, double *cy,
+ int *t2,double *dt,int *h0,int *nbtype,int *type,double *mat,double *surface,double *HD,double *gr, double *kr,double *gs,double *ks,int *error)
+{
+ int i,j,p,z=0;
+ int *l;// contient le nombre d'arbres par espèce
+ int compt[*nbtype+1];// tableau de compteurs pour xx et yy
+ vecintalloc(&l,*nbtype+1);
+ double *ds,dis;
+ double *g,*k;
+ vecalloc(&g,*t2);
+ vecalloc(&k,*t2);
+
+ for(i=1;i<*nbtype+1;i++){
+ l[i]=0;
+ compt[i]=0;
+ for(j=0;j<*point_nb;j++){
+ if(type[j]==i)
+ l[i]++;
+ }
+ }
+
+ double **xx,**yy;
+ xx=taballoca(*nbtype,l);
+ yy=taballoca(*nbtype,l);
+ vecalloc(&ds,*t2);
+ complete_tab(*point_nb,xx,yy,type,compt,l,x,y);
+
+ int erreur;
+ double intensity1,point_nb2,point_nb1,intensity2;
+ double intensity=*point_nb/(*surface);
+ double *gii,*kii;
+ vecalloc(&gii,*t2);
+ vecalloc(&kii,*t2);
+ double *tabg,*tabk;
+ vecalloc(&tabg,*t2);
+ vecalloc(&tabk,*t2);
+
+ for(j=0;j<*t2;j++)
+ { gii[j]=0;
+ kii[j]=0;
+ ds[j]=(Pi()*(j+1)*(*dt)*(j+1)*(*dt))-(Pi()*j*j*(*dt)*(*dt));
+ }
+ //Ripley all points
+ erreur =ripley_tr_disq(point_nb,x,y,x0,y0,r0,triangle_nb,ax,ay,bx,by,cx,cy,t2,dt,g,k);
+ if (erreur!=0)
+ Rprintf("ERREUR 0 Ripley\n");
+
+ // Shimatani function for normalisation under H0=2
+ double D=0;
+ if(*h0==2)
+ { erreur=shimatani_tr_disq(point_nb,x,y,x0,y0,r0,triangle_nb,ax,ay,bx,by,cx,cy,t2,dt,nbtype,type,surface,gs,ks,error);
+ for(i=1;i<(*nbtype+1);i++)
+ D+=(float)l[i]*((float)l[i]-1);
+ D=1-D/((float)(*point_nb)*((float)(*point_nb)-1));
+ }
+
+ for(j=0;j<*t2;j++)
+ { g[j]=intensity*g[j]/ds[j];
+ k[j]=intensity*k[j];
+ tabg[j]=g[j];
+ tabk[j]=k[j];
+ if(g[j]==0)
+ { error[j]=j;
+ z+=1;
+ }
+ if(*h0==2) {
+ gs[j]=gs[j]/D;
+ ks[j]=ks[j]/D;
+ }
+ }
+ //Intertype for each pair of types
+ if(z==0)
+ { for(i=1;i<*nbtype;i++)
+ { for(p=0;p<i;p++)
+ { dis=mat[p*(*nbtype-2)-(p-1)*p/2+i-1];
+ erreur=intertype_tr_disq(&l[i+1],xx[i],yy[i],&l[p+1],xx[p],yy[p],x0,y0,r0,triangle_nb,ax,ay,bx,by,cx,cy,t2,dt,g,k);
+ if (erreur!=0)
+ Rprintf("ERREUR 1 Intertype\n");
+ intensity1=l[i+1]/(*surface);
+ for(j=0;j<*t2;j++)
+ { gii[j]=gii[j]+dis*intensity1*g[j]/ds[j];
+ kii[j]=kii[j]+dis*intensity1*k[j];
+ }
+ erreur=intertype_tr_disq(&l[p+1],xx[p],yy[p],&l[i+1],xx[i],yy[i],x0,y0,r0,triangle_nb,ax,ay,bx,by,cx,cy,t2,dt,g,k);
+ if (erreur!=0)
+ Rprintf("ERREUR 2 Intertype\n");
+ intensity2=l[p+1]/(*surface);
+ for(j=0;j<*t2;j++)
+ { gii[j]=gii[j]+dis*intensity2*g[j]/ds[j];
+ kii[j]=kii[j]+dis*intensity2*k[j];
+ }
+ }
+ }
+ for(j=0;j<*t2;j++)
+ { gr[j]=gii[j]/(tabg[j]*(*HD));
+ kr[j]=kii[j]/(tabk[j]*(*HD));
+ }
+ }
+
+ for( i = 0; i < *nbtype; i++)
+ { free(xx[i]);
+ free(yy[i]);
+ }
+ free(xx);
+ free(yy);
+ free(g);
+ free(k);
+ free(l);
+
+ free(tabg);
+ free(tabk);
+
+ freevec(gii);
+ freevec(kii);
+ freevec(ds);
+
+ return 0;
+}
+
+int rao_tr_rect_ic(int *point_nb,double *x,double *y, double *xmi,double *xma,double *ymi,double *yma,
+ int *triangle_nb, double *ax, double *ay, double *bx, double *by, double *cx, double *cy,
+ int *t2,double *dt,int *nbSimu,int *h0, double *lev,int *nbtype,int *type,double *mat,double *surface,double *HD,
+ double *gr, double *kr,double *gs,double *ks,double *gic1,double *gic2,double *kic1,double *kic2,
+ double *gval,double *kval,int *error)
+{
+ int i,j,p,b,z=0;
+ int *l;// contient le nombre d'arbres par espèce
+ int compt[*nbtype+1];// tableau de compteurs pour xx et yy
+ vecintalloc(&l,*nbtype+1);
+ double *ds,dis;
+ double *g,*k;
+ vecalloc(&g,*t2);
+ vecalloc(&k,*t2);
+
+ for(i=1;i<*nbtype+1;i++){
+ l[i]=0;
+ compt[i]=0;
+ for(j=0;j<*point_nb;j++){
+ if(type[j]==i)
+ l[i]++;
+ }
+ }
+
+ double **xx,**yy;
+ xx=taballoca(*nbtype,l);
+ yy=taballoca(*nbtype,l);
+ vecalloc(&ds,*t2);
+ complete_tab(*point_nb,xx,yy,type,compt,l,x,y);
+
+ //Ripley for all points
+ int erreur;
+ double intensity1,point_nb2,point_nb1,intensity2;
+ double intensity=*point_nb/(*surface);
+ double *gii,*kii;
+ vecalloc(&gii,*t2);
+ vecalloc(&kii,*t2);
+ double *tabg,*tabk;
+ vecalloc(&tabg,*t2);
+ vecalloc(&tabk,*t2);
+
+ for(j=0;j<*t2;j++)
+ { gii[j]=0;
+ kii[j]=0;
+ ds[j]=(Pi()*(j+1)*(*dt)*(j+1)*(*dt))-(Pi()*j*j*(*dt)*(*dt));
+ }
+ //Ripley all points
+ erreur =ripley_tr_rect(point_nb,x,y,xmi,xma,ymi,yma,triangle_nb,ax,ay,bx,by,cx,cy,t2,dt,g,k);
+ if (erreur!=0)
+ Rprintf("ERREUR 0 Ripley\n");
+
+ // Shimatani function for normalisation under H0=2
+ double D=0;
+ if(*h0==2)
+ { erreur=shimatani_tr_rect(point_nb,x,y,xmi,xma,ymi,yma,triangle_nb,ax,ay,bx,by,cx,cy,t2,dt,nbtype,type,surface,gs,ks,error);
+ for(i=1;i<(*nbtype+1);i++)
+ D+=(float)l[i]*((float)l[i]-1);
+ D=1-D/((float)(*point_nb)*((float)(*point_nb)-1));
+ }
+
+ for(j=0;j<*t2;j++)
+ { g[j]=intensity*g[j]/ds[j];
+ k[j]=intensity*k[j];
+ tabg[j]=g[j];
+ tabk[j]=k[j];
+ if(g[j]==0)
+ { error[j]=j;
+ z+=1;
+ }
+ if(*h0==2) {
+ gs[j]=gs[j]/D;
+ ks[j]=ks[j]/D;
+ }
+ }
+ //Intertype for each pairs of types
+ if(z==0)
+ { for(i=1;i<*nbtype;i++)
+ { for(p=0;p<i;p++)
+ { dis=mat[p*(*nbtype-2)-(p-1)*p/2+i-1];
+ erreur=intertype_tr_rect(&l[i+1],xx[i],yy[i],&l[p+1],xx[p],yy[p],xmi,xma,ymi,yma,triangle_nb,ax,ay,bx,by,cx,cy,t2,dt,g,k);
+ if (erreur!=0)
+ Rprintf("ERREUR 1 Intertype\n");
+ intensity1=l[i+1]/(*surface);
+ for(j=0;j<*t2;j++)
+ { gii[j]=gii[j]+dis*intensity1*g[j]/ds[j];
+ kii[j]=kii[j]+dis*intensity1*k[j];
+ }
+ erreur=intertype_tr_rect(&l[p+1],xx[p],yy[p],&l[i+1],xx[i],yy[i],xmi,xma,ymi,yma,triangle_nb,ax,ay,bx,by,cx,cy,t2,dt,g,k);
+ if (erreur!=0)
+ Rprintf("ERREUR 2 Intertype\n");
+ intensity2=l[p+1]/(*surface);
+ for(j=0;j<*t2;j++)
+ { gii[j]=gii[j]+dis*intensity2*g[j]/ds[j];
+ kii[j]=kii[j]+dis*intensity2*k[j];
+ }
+ }
+ }
+
+ for(j=0;j<*t2;j++)
+ { gr[j]=gii[j]/(tabg[j]*(*HD));
+ kr[j]=kii[j]/(tabk[j]*(*HD));
+ }
+
+ //simulaitons sur gii, kii
+ double **gic,**kic;
+ int i0,i1,i2;
+
+ /*Definition de i0 : indice ou sera stocke l'estimation des bornes de l'IC*/
+ i0=*lev/2*(*nbSimu+1);
+ if (i0<1) i0=1;
+
+ /*Initialisation des tableaux dans lesquels on va stocker les valeurs extremes lors de MC*/
+ taballoc(&gic,*t2+1,2*i0+10+1);
+ taballoc(&kic,*t2+1,2*i0+10+1);
+
+ for(i=0;i<*t2;i++)
+ { gval[i]=1;
+ kval[i]=1;
+ }
+
+ int lp=0;
+ double HDsim;
+ int *vec, mat_size;
+ vecintalloc(&vec,*nbtype);
+ double *matp;
+ mat_size=*nbtype*(*nbtype-1)/2;
+ vecalloc(&matp,mat_size);
+ if(*h0==2) {
+ for(i=0;i<*nbtype;i++)
+ vec[i]=i;
+ for(i=0;i<mat_size;i++)
+ matp[i]=0;
+ }
+
+ /*boucle principale de MC*/
+ Rprintf("Monte Carlo simulation\n");
+ for(b=1;b<=*nbSimu;b++)
+ { if(*h0==1) //random labelling
+ randomlab(x,y,*point_nb,type,*nbtype,xx,l,yy);
+ if(*h0==2) //distance randomisation
+ randomdist(vec,*nbtype,mat,matp);
+ HDsim=0;
+
+ for(i=0;i<*t2;i++)
+ { gii[i]=0;
+ kii[i]=0;
+ }
+ for(i=1;i<*nbtype;i++)
+ { for(p=0;p<i;p++)
+ { if(*h0==1)
+ dis=mat[p*(*nbtype-2)-(p-1)*p/2+i-1];
+ if(*h0==2) {
+ dis=matp[p*(*nbtype-2)-(p-1)*p/2+i-1];
+ HDsim+=(float)l[i+1]/(float)(*point_nb)*(float)l[p+1]/(float)(*point_nb)*dis;
+ }
+ erreur=intertype_tr_rect(&l[i+1],xx[i],yy[i],&l[p+1],xx[p],yy[p],xmi,xma,ymi,yma,triangle_nb,ax,ay,bx,by,cx,cy,t2,dt,gic1,kic1);
+ if (erreur!=0)
+ Rprintf("ERREUR 1 Intertype\n");
+ intensity1=l[i+1]/(*surface);
+ for(j=0;j<*t2;j++)
+ { gii[j]=gii[j]+dis*intensity1*gic1[j]/ds[j];
+ kii[j]=kii[j]+dis*intensity1*kic1[j];
+ }
+ erreur=intertype_tr_rect(&l[p+1],xx[p],yy[p],&l[i+1],xx[i],yy[i],xmi,xma,ymi,yma,triangle_nb,ax,ay,bx,by,cx,cy,t2,dt,gic1,kic1);
+ if (erreur!=0)
+ Rprintf("ERREUR 2 Intertype\n");
+ intensity2=l[p+1]/(*surface);
+ for(j=0;j<*t2;j++)
+ { gii[j]=gii[j]+dis*intensity2*gic1[j]/ds[j];
+ kii[j]=kii[j]+dis*intensity2*kic1[j];
+ }
+ }
+ }
+
+ for(j=0;j<*t2;j++)
+ { if(*h0==1) {// standardisation by HD when species labels are randomized
+ gii[j]=gii[j]/(tabg[j]*(*HD));
+ kii[j]=kii[j]/(tabk[j]*(*HD));
+ //deviation from theo=1
+ if ((float)fabs(gr[j]-1)<=(float)fabs(gii[j]-1)) gval[j]+=1;
+ if ((float)fabs(kr[j]-1)<=(float)fabs(kii[j]-1)) kval[j]+=1;
+ }
+ if(*h0==2) {// standardisation by Hsim when distance matrix is randomized
+ gii[j]=gii[j]/(tabg[j]*2*HDsim);
+ kii[j]=kii[j]/(tabk[j]*2*HDsim);
+ //deviation from theo=shimatani
+ if ((float)fabs(gr[j]-gs[j])<=(float)fabs(gii[j]-gs[j])) gval[j]+=1;
+ if ((float)fabs(kr[j]-ks[j])<=(float)fabs(kii[j]-ks[j])) kval[j]+=1;
+ }
+ }
+
+ //Traitement des resultats
+ ic(b,i0,gic,kic,gii,kii,*t2);
+ R_FlushConsole();
+ progress(b,&lp,*nbSimu);
+ }
+
+ i1=i0+2;
+ i2=i0;
+
+ //Copies des valeurs dans les tableaux resultats
+ for(i=0;i<*t2;i++)
+ { gic1[i]=gic[i+1][i1];
+ gic2[i]=gic[i+1][i2];
+ kic1[i]=kic[i+1][i1];
+ kic2[i]=kic[i+1][i2];
+ }
+ free(gic);
+ free(kic);
+ freeintvec(vec);
+ freevec(matp);
+ }
+
+
+ for( i = 0; i < *nbtype; i++)
+ { free(xx[i]);
+ free(yy[i]);
+ }
+ free(xx);
+ free(yy);
+ free(g);
+ free(k);
+ free(l);
+
+ free(tabg);
+ free(tabk);
+
+ freevec(gii);
+ freevec(kii);
+ freevec(ds);
+
+ return 0;
+}
+
+int rao_tr_disq_ic(int *point_nb,double *x,double *y, double *x0,double *y0,double *r0,
+ int *triangle_nb, double *ax, double *ay, double *bx, double *by, double *cx, double *cy,
+ int *t2,double *dt,int *nbSimu,int *h0, double *lev,int *nbtype,int *type,double *mat,double *surface,double *HD,
+ double *gr, double *kr,double *gs,double *ks,double *gic1,double *gic2,double *kic1,double *kic2,
+ double *gval,double *kval,int *error)
+{
+ int i,j,p,b,z=0;
+ int *l;// contient le nombre d'arbres par espèce
+ int compt[*nbtype+1];// tableau de compteurs pour xx et yy
+ vecintalloc(&l,*nbtype+1);
+ double *ds,dis;
+ double *g,*k;
+ vecalloc(&g,*t2);
+ vecalloc(&k,*t2);
+
+ for(i=1;i<*nbtype+1;i++){
+ l[i]=0;
+ compt[i]=0;
+ for(j=0;j<*point_nb;j++){
+ if(type[j]==i)
+ l[i]++;
+ }
+ }
+
+ double **xx,**yy;
+ xx=taballoca(*nbtype,l);
+ yy=taballoca(*nbtype,l);
+ vecalloc(&ds,*t2);
+ complete_tab(*point_nb,xx,yy,type,compt,l,x,y);
+
+ //Ripley for all points
+ int erreur;
+ double intensity1,point_nb2,point_nb1,intensity2;
+ double intensity=*point_nb/(*surface);
+ double *gii,*kii;
+ vecalloc(&gii,*t2);
+ vecalloc(&kii,*t2);
+ double *tabg,*tabk;
+ vecalloc(&tabg,*t2);
+ vecalloc(&tabk,*t2);
+
+ for(j=0;j<*t2;j++)
+ { gii[j]=0;
+ kii[j]=0;
+ ds[j]=(Pi()*(j+1)*(*dt)*(j+1)*(*dt))-(Pi()*j*j*(*dt)*(*dt));
+ }
+ //Ripley all points
+ erreur =ripley_tr_disq(point_nb,x,y,x0,y0,r0,triangle_nb,ax,ay,bx,by,cx,cy,t2,dt,g,k);
+ if (erreur!=0)
+ Rprintf("ERREUR 0 Ripley\n");
+
+ // Shimatani function for normalisation under H0=2
+ double D=0;
+ if(*h0==2)
+ { erreur=shimatani_tr_disq(point_nb,x,y,x0,y0,r0,triangle_nb,ax,ay,bx,by,cx,cy,t2,dt,nbtype,type,surface,gs,ks,error);
+ for(i=1;i<(*nbtype+1);i++)
+ D+=(float)l[i]*((float)l[i]-1);
+ D=1-D/((float)(*point_nb)*((float)(*point_nb)-1));
+ }
+
+ for(j=0;j<*t2;j++)
+ { g[j]=intensity*g[j]/ds[j];
+ k[j]=intensity*k[j];
+ tabg[j]=g[j];
+ tabk[j]=k[j];
+ if(g[j]==0)
+ { error[j]=j;
+ z+=1;
+ }
+ if(*h0==2) {
+ gs[j]=gs[j]/D;
+ ks[j]=ks[j]/D;
+ }
+ }
+ //Intertype for each pairs of types
+ if(z==0)
+ { for(i=1;i<*nbtype;i++)
+ { for(p=0;p<i;p++)
+ { dis=mat[p*(*nbtype-2)-(p-1)*p/2+i-1];
+ erreur=intertype_tr_disq(&l[i+1],xx[i],yy[i],&l[p+1],xx[p],yy[p],x0,y0,r0,triangle_nb,ax,ay,bx,by,cx,cy,t2,dt,g,k);
+ if (erreur!=0)
+ Rprintf("ERREUR 1 Intertype\n");
+ intensity1=l[i+1]/(*surface);
+ for(j=0;j<*t2;j++)
+ { gii[j]=gii[j]+dis*intensity1*g[j]/ds[j];
+ kii[j]=kii[j]+dis*intensity1*k[j];
+ }
+ erreur=intertype_tr_disq(&l[p+1],xx[p],yy[p],&l[i+1],xx[i],yy[i],x0,y0,r0,triangle_nb,ax,ay,bx,by,cx,cy,t2,dt,g,k);
+ if (erreur!=0)
+ Rprintf("ERREUR 2 Intertype\n");
+ intensity2=l[p+1]/(*surface);
+ for(j=0;j<*t2;j++)
+ { gii[j]=gii[j]+dis*intensity2*g[j]/ds[j];
+ kii[j]=kii[j]+dis*intensity2*k[j];
+ }
+ }
+ }
+
+ for(j=0;j<*t2;j++)
+ { gr[j]=gii[j]/(tabg[j]*(*HD));
+ kr[j]=kii[j]/(tabk[j]*(*HD));
+ }
+
+ //simulaitons sur gii, kii
+ double **gic,**kic;
+ int i0,i1,i2;
+
+ /*Definition de i0 : indice ou sera stocke l'estimation des bornes de l'IC*/
+ i0=*lev/2*(*nbSimu+1);
+ if (i0<1) i0=1;
+
+ /*Initialisation des tableaux dans lesquels on va stocker les valeurs extremes lors de MC*/
+ taballoc(&gic,*t2+1,2*i0+10+1);
+ taballoc(&kic,*t2+1,2*i0+10+1);
+
+ for(i=0;i<*t2;i++)
+ { gval[i]=1;
+ kval[i]=1;
+ }
+
+ int lp=0;
+ double HDsim;
+ int *vec, mat_size;
+ vecintalloc(&vec,*nbtype);
+ double *matp;
+ mat_size=*nbtype*(*nbtype-1)/2;
+ vecalloc(&matp,mat_size);
+ if(*h0==2) {
+ for(i=0;i<*nbtype;i++)
+ vec[i]=i;
+ for(i=0;i<mat_size;i++)
+ matp[i]=0;
+ }
+
+ /*boucle principale de MC*/
+ Rprintf("Monte Carlo simulation\n");
+ for(b=1;b<=*nbSimu;b++)
+ { if(*h0==1) //random labelling
+ randomlab(x,y,*point_nb,type,*nbtype,xx,l,yy);
+ if(*h0==2) //distance randomisation
+ randomdist(vec,*nbtype,mat,matp);
+ HDsim=0;
+ for(i=0;i<*t2;i++)
+ { gii[i]=0;
+ kii[i]=0;
+ }
+ for(i=1;i<*nbtype;i++)
+ { for(p=0;p<i;p++)
+ { if(*h0==1)
+ dis=mat[p*(*nbtype-2)-(p-1)*p/2+i-1];
+ if(*h0==2) {
+ dis=matp[p*(*nbtype-2)-(p-1)*p/2+i-1];
+ HDsim+=(float)l[i+1]/(float)(*point_nb)*(float)l[p+1]/(float)(*point_nb)*dis;
+ }
+ erreur=intertype_tr_disq(&l[i+1],xx[i],yy[i],&l[p+1],xx[p],yy[p],x0,y0,r0,triangle_nb,ax,ay,bx,by,cx,cy,t2,dt,gic1,kic1);
+ if (erreur!=0)
+ Rprintf("ERREUR 1 Intertype\n");
+ intensity1=l[i+1]/(*surface);
+ for(j=0;j<*t2;j++)
+ { gii[j]=gii[j]+dis*intensity1*gic1[j]/ds[j];
+ kii[j]=kii[j]+dis*intensity1*kic1[j];
+ }
+ erreur=intertype_tr_disq(&l[p+1],xx[p],yy[p],&l[i+1],xx[i],yy[i],x0,y0,r0,triangle_nb,ax,ay,bx,by,cx,cy,t2,dt,gic1,kic1);
+ if (erreur!=0)
+ Rprintf("ERREUR 2 Intertype\n");
+ intensity2=l[p+1]/(*surface);
+ for(j=0;j<*t2;j++)
+ { gii[j]=gii[j]+dis*intensity2*gic1[j]/ds[j];
+ kii[j]=kii[j]+dis*intensity2*kic1[j];
+ }
+ }
+ }
+ for(j=0;j<*t2;j++)
+ { if(*h0==1) {// standardisation by HD when species labels are randomized
+ gii[j]=gii[j]/(tabg[j]*(*HD));
+ kii[j]=kii[j]/(tabk[j]*(*HD));
+ //deviation from theo=1
+ if ((float)fabs(gr[j]-1)<=(float)fabs(gii[j]-1)) gval[j]+=1;
+ if ((float)fabs(kr[j]-1)<=(float)fabs(kii[j]-1)) kval[j]+=1;
+ }
+ if(*h0==2) {// standardisation by Hsim when distance matrix is randomized
+ gii[j]=gii[j]/(tabg[j]*2*HDsim);
+ kii[j]=kii[j]/(tabk[j]*2*HDsim);
+ //deviation from theo=shimatani
+ if ((float)fabs(gr[j]-gs[j])<=(float)fabs(gii[j]-gs[j])) gval[j]+=1;
+ if ((float)fabs(kr[j]-ks[j])<=(float)fabs(kii[j]-ks[j])) kval[j]+=1;
+ }
+ }
+
+
+ //Traitement des resultats
+ ic(b,i0,gic,kic,gii,kii,*t2);
+ R_FlushConsole();
+ progress(b,&lp,*nbSimu);
+ }
+
+ i1=i0+2;
+ i2=i0;
+
+ //Copies des valeurs dans les tableaux resultats
+ for(i=0;i<*t2;i++)
+ { gic1[i]=gic[i+1][i1];
+ gic2[i]=gic[i+1][i2];
+ kic1[i]=kic[i+1][i1];
+ kic2[i]=kic[i+1][i2];
+ }
+ free(gic);
+ free(kic);
+ freeintvec(vec);
+ freevec(matp);
+ }
+
+
+ for( i = 0; i < *nbtype; i++)
+ { free(xx[i]);
+ free(yy[i]);
+ }
+ free(xx);
+ free(yy);
+ free(g);
+ free(k);
+ free(l);
+
+ free(tabg);
+ free(tabk);
+
+ freevec(gii);
+ freevec(kii);
+ freevec(ds);
+
+ return 0;
+}
+
+//permutation of species distance matrix
+int randomdist(int *vec,int nb_type,double *mat,double *matp) {
+ int i,j,a,jj;
+ int mat_size,rowvec,colvec,ind;
+ int erreur=0;
+
+ GetRNGstate();
+ i=nb_type-1;
+ while(i>0)
+ { jj=unif_rand()*(i);
+ a=vec[i];
+ vec[i]=vec[jj];
+ vec[jj]=a;
+ i=i-1;
+ }
+ PutRNGstate();
+ a=0;
+ for(i=1;i<nb_type;i++)
+ for(j=0;j<(nb_type-i);j++)
+ { rowvec=i+j;
+ colvec=i-1;
+ if(vec[rowvec]>vec[colvec])
+ ind=vec[colvec]*(nb_type-2)-(vec[colvec]-1)*vec[colvec]/2+vec[rowvec]-1;
+ else {
+ ind=vec[rowvec]*(nb_type-2)-(vec[rowvec]-1)*vec[rowvec]/2+vec[colvec]-1;
+ }
+ matp[a]=mat[ind];
+ a++;
+ }
+ return erreur;
+}
+
+/******************************************************/
+/*Mimetic point process as in Goreaud et al. 2004 */
+/******************************************************/
+int mimetic_rect(int *point_nb,double *x,double *y, double *surface,double *xmi,double *xma,double *ymi,double *yma,
+ double *prec, int *t2, double *dt, double *lobs, int *nsimax, int *conv, double *cost,
+ double *g, double *k,double *xx,double *yy,int *mess)
+{
+ int i,compteur_c=0,r=0,erreur=0;
+ int compteur=0;
+ double *l;
+ double cout,cout_c;
+ double intensity=(*point_nb)/(*surface);
+ vecalloc(&l,*t2);
+
+ //creation of a initial point pattern and cost
+ s_alea_rect(*point_nb,x,y,*xmi,*xma,*ymi,*yma,*prec);
+ erreur=ripley_rect(point_nb,x,y,xmi,xma,ymi,yma,t2,dt,g,k);
+ if (erreur!=0) return -1;
+ cout=0;
+ for(i=0;i<*t2;i++)
+ { //l[i]=sqrt(k[i]/(intensity*Pi()));
+ l[i]=sqrt(k[i]/(intensity*Pi()))-(i+1)*(*dt);
+ cout+=(lobs[i]-l[i])*(lobs[i]-l[i]);
+ }
+ cost[0]=cout;
+ int lp=0;
+ if(mess!=0)
+ Rprintf("Simulated annealing\n");
+ cout_c=0;
+ while(compteur<*nsimax)
+ { cout_c=echange_point_rect(*point_nb,x,y,*xmi,*xma,*ymi,*yma,intensity,*prec,cout,lobs,t2,dt,g,k);
+ if(cout==cout_c)
+ compteur_c++;
+ else
+ compteur_c=0;
+ cout=cout_c;
+ //Rprintf(" coût calculé : %f\n", cout);
+ compteur++;
+ cost[compteur]=cout;
+ if(compteur_c==*conv)
+ break;
+ if(mess!=0) {
+ R_FlushConsole();
+ progress(compteur,&lp,*nsimax);
+ }
+ }
+ if(compteur==*nsimax) {
+ if(mess!=0)
+ Rprintf("Warning: failed to converge after nsimax=%d simulations",*nsimax);
+ r=1;
+ }
+ for(i=0;i<(*point_nb);i++)
+ { xx[i]=x[i];
+ yy[i]=y[i];
+ }
+ free(l);
+ return r;
+}
+
+double echange_point_rect(int point_nb,double *x,double *y,double xmi,double xma,double ymi,double yma,double intensity,double p,double cout,double * lobs,int *t2,double *dt,double *g,double *k)
+{
+ double xr, yr, xcent[4], ycent[4], n_cout[4],*l,xprec,yprec;
+ int erreur,max,i,j,num;
+ vecalloc(&l,*t2);
+ GetRNGstate();
+ num=unif_rand()* (point_nb);// numero de l'arbre que l'on retire
+ xprec=x[num];
+ yprec=y[num];
+ xr=xma-xmi;
+ yr=yma-ymi;
+
+ for(i=0;i<*t2;i++)
+ { g[i]=0;
+ k[i]=0;
+ }
+
+
+ for(j=0;j<4;j++)
+ {
+ xcent[j]=xmi+(unif_rand()*(xr/p))*p;// coordonnées (x,y) du point tiré
+ ycent[j]=ymi+(unif_rand()*(yr/p))*p;
+ x[num]=xcent[j];
+ y[num]=ycent[j];
+ erreur=ripley_rect(&point_nb,x,y,&xmi,&xma,&ymi,&yma,t2,dt,g,k);
+ if (erreur!=0) return -1;
+ for(i=0;i<*t2;i++)
+ { l[i]=sqrt(k[i]/(intensity*Pi()))-(i+1)*(*dt);
+ //l[i]=sqrt(k[i]/(intensity*Pi()));
+ }
+ n_cout[j]=0;
+ for(i=0;i<*t2;i++)
+ { n_cout[j]+=(lobs[i]-l[i])*(lobs[i]-l[i]);
+ //n_cout[j]+=(lobs[i]-l[i])*(lobs[i]-l[i])/(lobs[i]*lobs[i]);
+ }
+ }
+ PutRNGstate();
+ max=0;
+ for(i=1;i<4;i++)
+ {
+ if(n_cout[i]<n_cout[max])
+ max=i;
+ }
+ if(n_cout[max]<cout) // on prend le nouveau point qui minimise le coût
+ {
+ x[num]=xcent[max];
+ y[num]=ycent[max];
+ cout=n_cout[max];
+ }
+ else // on reprend l'ancien point
+ {
+ x[num]=xprec;
+ y[num]=yprec;
+ }
+
+ free(l);
+
+ return cout;
+
+
+}
+
+int mimetic_disq(int *point_nb,double *x,double *y, double *surface,double *x0,double *y0,double *r0,
+ double *prec, int *t2, double *dt, double *lobs, int *nsimax, int *conv, double *cost,
+ double *g, double *k,double *xx,double *yy,int *mess)
+{
+ int i,compteur_c=0,r=0,erreur=0;
+ int compteur=0;
+ double *l;
+ double cout,cout_c;
+ double intensity=(*point_nb)/(*surface);
+ vecalloc(&l,*t2);
+
+ //creation of a initial point pattern and cost
+ //r=s_RegularProcess_disq(*point_nb,3,x,y,*x0,*y0,*r0,*prec);
+ //r=s_NeymanScott_disq(5,*point_nb,3,x,y,*x0,*y0,*r0,*prec);
+ s_alea_disq(*point_nb,x,y,*x0,*y0,*r0,*prec);
+ erreur=ripley_disq(point_nb,x,y,x0,y0,r0,t2,dt,g,k);
+ if (erreur!=0)
+ {
+ return -1;
+ }
+ cout=0;
+ for(i=0;i<*t2;i++)
+ { l[i]=sqrt(k[i]/(intensity*Pi()))-(i+1)*(*dt);
+ cout+=(lobs[i]-l[i])*(lobs[i]-l[i]);
+ }
+ cost[0]=cout;
+
+ int lp=0;
+ if(mess!=0)
+ Rprintf("Simulated annealing\n");
+ while(compteur<*nsimax)
+ { cout_c=echange_point_disq(*point_nb,x,y,*x0,*y0,*r0,intensity,*prec,cout,lobs,t2,dt,g,k);
+ if(cout==cout_c)
+ {
+ compteur_c++;
+ }
+ else compteur_c=0;
+ cout=cout_c;
+ //Rprintf(" coût calculé : %f\n", cout);
+ compteur++;
+ cost[compteur]=cout;
+ if(compteur_c==*conv)
+ break;
+ if(mess!=0) {
+ R_FlushConsole();
+ progress(compteur,&lp,*nsimax);
+ }
+ }
+ if(compteur==(*nsimax)) {
+ if(mess!=0)
+ Rprintf("Warning: failed to converge after nsimax=%d simulations",*nsimax);
+ r=1;
+ }
+ for(i=0;i<(*point_nb);i++)
+ { xx[i]=x[i];
+ yy[i]=y[i];
+ }
+ free(l);
+ return r;
+}
+
+double echange_point_disq(int point_nb,double *x,double *y,double x0,double y0,double r0,double intensity,double p,double cout,double * lobs,int *t2,double *dt,double *g,double *k)
+{
+ double rr, xcent[4], ycent[4], n_cout[4],*l,xprec,yprec;
+ int erreur,max,i,j,num;
+ vecalloc(&l,*t2);
+ GetRNGstate();
+ num=unif_rand()* (point_nb);// numero de l'arbre que l'on retire
+ xprec=x[num];
+ yprec=y[num];
+ rr=2*r0;
+ for(j=0;j<4;j++)
+ {
+ xcent[j]=x0-r0+(unif_rand()*(rr/p))*p;// coordonnées (x,y) du point tiré
+ ycent[j]=y0-r0+(unif_rand()*(rr/p))*p;
+ while ((xcent[j]-x0)*(xcent[j]-x0)+(ycent[j]-y0)*(ycent[j]-y0)>=r0*r0)
+ {
+ xcent[j]=x0-r0+(unif_rand()*(rr/p))*p;// coordonnées (x,y) du point tiré
+ ycent[j]=y0-r0+(unif_rand()*(rr/p))*p;
+ }
+ x[num]=xcent[j];
+ y[num]=ycent[j];
+ erreur=ripley_disq(&point_nb,x,y,&x0,&y0,&r0,t2,dt,g,k);
+ if (erreur!=0)
+ {
+ return -1;
+ }
+ for(i=0;i<*t2;i++)
+ {
+ l[i]=sqrt(k[i]/(intensity*Pi()))-(i+1)*(*dt);
+ }
+
+ n_cout[j]=0;
+ for(i=0;i<*t2;i++)
+ {
+ n_cout[j]+=(lobs[i]-l[i])*(lobs[i]-l[i]);
+ }
+
+
+ }
+ PutRNGstate();
+ max=0;
+ for(i=1;i<4;i++)
+ {
+ if(n_cout[i]<n_cout[max])
+ max=i;
+ }
+ if(n_cout[max]<cout) // on prend le nouveau point qui minimise le coût
+ {
+ x[num]=xcent[max];
+ y[num]=ycent[max];
+ cout=n_cout[max];
+ }
+ else // on reprend l'ancien point
+ {
+ x[num]=xprec;
+ y[num]=yprec;
+ }
+
+ free(l);
+
+ return cout;
+
+
+}
+
+int mimetic_tr_rect(int *point_nb,double *x,double *y, double *surface,double *xmi,double *xma,double *ymi,double *yma,
+ int *triangle_nb, double *ax, double *ay, double *bx, double *by, double *cx, double *cy,
+ double *prec, int *t2, double *dt, double *lobs, int *nsimax, int *conv, double *cost,
+ double *g, double *k,double *xx,double *yy,int *mess)
+{
+ int i,compteur_c=0,r=0,erreur=0;
+ int compteur=0;
+ double *l;
+ double cout,cout_c;
+ double intensity=(*point_nb)/(*surface);
+ vecalloc(&l,*t2);
+
+ //creation of a initial point pattern and cost
+ s_alea_tr_rect(*point_nb,x,y,*xmi,*xma,*ymi,*yma,*triangle_nb,ax,ay,bx,by,cx,cy,*prec);
+ erreur=ripley_tr_rect(point_nb,x,y,xmi,xma,ymi,yma,triangle_nb,ax,ay,bx,by,cx,cy,t2,dt,g,k);
+ if (erreur!=0)
+ {
+ return -1;
+ }
+ cout=0;
+ for(i=0;i<*t2;i++)
+ { l[i]=sqrt(k[i]/(intensity*Pi()))-(i+1)*(*dt);
+ cout+=(lobs[i]-l[i])*(lobs[i]-l[i]);
+ }
+ cost[0]=cout;
+
+ int lp=0;
+ if(mess!=0)
+ Rprintf("Simulated annealing\n");
+ while(compteur<*nsimax)
+ { cout_c=echange_point_tr_rect(*point_nb,x,y,*xmi,*xma,*ymi,*yma,triangle_nb,ax,ay,bx,by,cx,cy,intensity,*prec,cout,lobs,t2,dt,g,k);
+ if(cout==cout_c)
+ compteur_c++;
+ else compteur_c=0;
+ cout=cout_c;
+ //Rprintf(" coût calculé : %f\n", cout);
+ compteur++;
+ cost[compteur]=cout;
+ if(compteur_c==*conv)
+ break;
+ if(mess!=0) {
+ R_FlushConsole();
+ progress(compteur,&lp,*nsimax);
+ }
+ }
+ if(compteur==(*nsimax)) {
+ if(mess!=0)
+ Rprintf("Warning: failed to converge after nsimax=%d simulations",*nsimax);
+ r=1;
+ }
+ for(i=0;i<(*point_nb);i++)
+ { xx[i]=x[i];
+ yy[i]=y[i];
+ }
+ free(l);
+ return r;
+}
+
+double echange_point_tr_rect(int point_nb,double *x,double *y,double xmi,double xma,double ymi,double yma,
+ int *triangle_nb, double *ax, double *ay, double *bx, double *by, double *cx, double *cy,
+ double intensity,double p,double cout,double * lobs,int *t2,double *dt,double *g,double *k)
+{
+ double xr, yr, xcent[4], ycent[4], n_cout[4],*l,xprec,yprec;
+ int erreur,max,i,j,num,erreur_tr,s;
+ vecalloc(&l,*t2);
+ GetRNGstate();
+ num=unif_rand()* (point_nb);// numero de l'arbre que l'on retire
+ xprec=x[num];
+ yprec=y[num];
+ xr=xma-xmi;
+ yr=yma-ymi;
+ for(j=0;j<4;j++)
+ {
+ do
+ { erreur_tr=0;
+ xcent[j]=xmi+(unif_rand()*(xr/p))*p;// coordonnées (x,y) du point tiré
+ ycent[j]=ymi+(unif_rand()*(yr/p))*p;
+ x[num]=xcent[j];
+ y[num]=ycent[j];
+ for(s=0;s<*triangle_nb;s++)
+ if (in_triangle(x[num],y[num],ax[s],ay[s],bx[s],by[s],cx[s],cy[s],1))
+ erreur_tr=1;
+ }
+ while(erreur_tr==1);
+ //Rprintf("point pris\n");
+
+ erreur=ripley_tr_rect(&point_nb,x,y,&xmi,&xma,&ymi,&yma,triangle_nb,ax,ay,bx,by,cx,cy,t2,dt,g,k);
+ if (erreur!=0) return -1;
+ for(i=0;i<*t2;i++)
+ l[i]=sqrt(k[i]/(intensity*Pi()))-(i+1)*(*dt);
+ n_cout[j]=0;
+ for(i=0;i<*t2;i++)
+ n_cout[j]+=(lobs[i]-l[i])*(lobs[i]-l[i]);
+ }
+ PutRNGstate();
+ max=0;
+ for(i=1;i<4;i++)
+ {
+ if(n_cout[i]<n_cout[max])
+ max=i;
+ }
+ if(n_cout[max]<cout) // on prend le nouveau point qui minimise le coût
+ {
+ x[num]=xcent[max];
+ y[num]=ycent[max];
+ cout=n_cout[max];
+ }
+ else // on reprend l'ancien point
+ {
+ x[num]=xprec;
+ y[num]=yprec;
+ }
+
+ free(l);
+
+ return cout;
+
+
+}
+
+int mimetic_tr_disq(int *point_nb,double *x,double *y, double *surface,double *x0,double *y0,double *r0,
+ int *triangle_nb, double *ax, double *ay, double *bx, double *by, double *cx, double *cy,
+ double *prec, int *t2, double *dt, double *lobs, int *nsimax, int *conv, double *cost,
+ double *g, double *k,double *xx,double *yy,int *mess)
+{
+ int i,compteur_c=0,r=0,erreur=0;
+ int compteur=0;
+ double *l;
+ double cout,cout_c;
+ double intensity=(*point_nb)/(*surface);
+ vecalloc(&l,*t2);
+
+ //creation of a initial point pattern and cost
+ //r=s_RegularProcess_tr_disq(*point_nb,3,x,y,*x0,*y0,*r0,triangle_nb,ax,ay,bx,by,cx,cy,*prec);
+ //r=s_NeymanScott_tr_disq(4,*point_nb,2,x,y,*x0,*y0,*r0,triangle_nb,ax,ay,bx,by,cx,cy,*prec);
+ s_alea_tr_disq(*point_nb,x,y,*x0,*y0,*r0,*triangle_nb,ax,ay,bx,by,cx,cy,*prec);
+ erreur=ripley_tr_disq(point_nb,x,y,x0,y0,r0,triangle_nb,ax,ay,bx,by,cx,cy,t2,dt,g,k);
+ if (erreur!=0)
+ {
+ return -1;
+ }
+ cout=0;
+ for(i=0;i<*t2;i++)
+ { l[i]=sqrt(k[i]/(intensity*Pi()))-(i+1)*(*dt);
+ cout+=(lobs[i]-l[i])*(lobs[i]-l[i]);
+ }
+ cost[0]=cout;
+
+ int lp=0;
+ if(mess!=0)
+ Rprintf("Simulated annealing\n");
+ while(compteur<*nsimax)
+ { cout_c=echange_point_tr_disq(*point_nb,x,y,*x0,*y0,*r0,triangle_nb,ax,ay,bx,by,cx,cy,intensity,*prec,cout,lobs,t2,dt,g,k);
+ if(cout==cout_c)
+ {
+ compteur_c++;
+ }
+ else compteur_c=0;
+ cout=cout_c;
+ //Rprintf(" coût calculé : %f\n", cout);
+ compteur++;
+ cost[compteur]=cout;
+ if(compteur_c==*conv)
+ break;
+ if(mess!=0) {
+ R_FlushConsole();
+ progress(compteur,&lp,*nsimax);
+ }
+ }
+ if(compteur==(*nsimax)) {
+ if(mess!=0)
+ Rprintf("Warning: failed to converge after nsimax=%d simulations",*nsimax);
+ r=1;
+ }
+ for(i=0;i<(*point_nb);i++)
+ { xx[i]=x[i];
+ yy[i]=y[i];
+ }
+ free(l);
+ return r;
+}
+
+double echange_point_tr_disq(int point_nb,double *x,double *y,double x0,double y0,double r0,
+ int *triangle_nb, double *ax, double *ay, double *bx, double *by, double *cx, double *cy,
+ double intensity,double p,double cout,double * lobs,int *t2,double *dt,double *g,double *k)
+{
+ double rr, xcent[4], ycent[4], n_cout[4],*l,xprec,yprec;
+ int erreur,max,i,j,num,erreur_tr,s;
+ vecalloc(&l,*t2);
+ GetRNGstate();
+ num=unif_rand()* (point_nb);// numero de l'arbre que l'on retire
+ xprec=x[num];
+ yprec=y[num];
+ rr=2*r0;
+ for(j=0;j<4;j++)
+ {
+ do
+ {
+ erreur_tr=0;
+ xcent[j]=x0-r0+(unif_rand()*(rr/p))*p;// coordonnées (x,y) du point tiré
+ ycent[j]=y0-r0+(unif_rand()*(rr/p))*p;
+ while ((xcent[j]-x0)*(xcent[j]-x0)+(ycent[j]-y0)*(ycent[j]-y0)>=r0*r0)
+ {
+ xcent[j]=x0-r0+(unif_rand()*(rr/p))*p;// coordonnées (x,y) du point tiré
+ ycent[j]=y0-r0+(unif_rand()*(rr/p))*p;
+ }
+ x[num]=xcent[j];
+ y[num]=ycent[j];
+ for(s=0;s<*triangle_nb;s++)
+ {
+ if (in_triangle(x[num],y[num],ax[s],ay[s],bx[s],by[s],cx[s],cy[s],1))
+ {
+ erreur_tr=1;
+ //Rprintf("erreur_tr\n");
+ }
+ }
+
+ }
+ while(erreur_tr==1);
+ //Rprintf("point pris\n");
+
+ erreur=ripley_tr_disq(&point_nb,x,y,&x0,&y0,&r0,triangle_nb,ax,ay,bx,by,cx,cy,t2,dt,g,k);
+ if (erreur!=0)
+ {
+ return -1;
+ }
+ for(i=0;i<*t2;i++)
+ {
+ l[i]=sqrt(k[i]/(intensity*Pi()))-(i+1)*(*dt);
+ }
+
+ n_cout[j]=0;
+ for(i=0;i<*t2;i++)
+ {
+ n_cout[j]+=(lobs[i]-l[i])*(lobs[i]-l[i]);
+ }
+
+
+ }
+ PutRNGstate();
+ max=0;
+ for(i=1;i<4;i++)
+ {
+ if(n_cout[i]<n_cout[max])
+ max=i;
+ }
+ if(n_cout[max]<cout) // on prend le nouveau point qui minimise le coût
+ {
+ x[num]=xcent[max];
+ y[num]=ycent[max];
+ cout=n_cout[max];
+ }
+ else // on reprend l'ancien point
+ {
+ x[num]=xprec;
+ y[num]=yprec;
+ }
+
+ free(l);
+
+ return cout;
+
+}
+
+
+int shen(int *point_nb,double *x,double *y,
+ int *t2,double *dt,
+ int *nbtype,int *type,double *mat,double *surface,double *HD,
+ double *gd, double *kd, int *error)
+{
+ int i,j,p;
+ int *l;
+ int compt[*nbtype+1];
+ double *g,*k;
+ double *ds,dis;
+
+ vecintalloc(&l,*nbtype+1);
+ vecalloc(&g,*t2);
+ vecalloc(&k,*t2);
+
+ // l contient le nombre d'arbres par espce
+ for(i=1;i<*nbtype+1;i++){
+ l[i]=0;
+ compt[i]=0;
+ for(j=0;j<*point_nb;j++){
+ if(type[j]==i)
+ l[i]++;
+ }
+ }
+
+ // crŽation des tableaux xx et yy par espce
+ double **xx,**yy;
+ xx=taballoca(*nbtype,l);
+ yy=taballoca(*nbtype,l);
+ vecalloc(&ds,*t2);
+ complete_tab(*point_nb,xx,yy,type,compt,l,x,y);
+
+ int erreur;
+ double intensity1,point_nb2,point_nb1,intensity2;
+ double intensity=*point_nb/(*surface);
+ double *gsii,*ksii,*grii,*krii;
+ vecalloc(&gsii,*t2);
+ vecalloc(&ksii,*t2);
+ vecalloc(&grii,*t2);
+ vecalloc(&krii,*t2);
+
+ for(j=0;j<*t2;j++)
+ { gsii[j]=0;
+ ksii[j]=0;
+ grii[j]=0;
+ krii[j]=0;
+ ds[j]=(Pi()*(j+1)*(*dt)*(j+1)*(*dt))-(Pi()*j*j*(*dt)*(*dt));
+ }
+
+ double D=(float)l[1]*((float)l[1]-1);
+
+ //Intertype for each pairs of types
+ for(i=1;i<*nbtype;i++)
+ { D+=(float)l[i+1]*((float)l[i+1]-1);
+ for(p=0;p<i;p++)
+ { dis=mat[p*(*nbtype-2)-(p-1)*p/2+i-1];
+ //D+=(float)l[i+1]*((float)l[p+1]);
+ //H+=dis*(float)l[i]*((float)l[p]);
+ erreur=intertype(&l[i+1],xx[i],yy[i],&l[p+1],xx[p],yy[p],t2,dt,g,k);
+ if (erreur!=0)
+ Rprintf("ERREUR 1 Intertype\n");
+ intensity1=l[i+1]/(*surface);
+ for(j=0;j<*t2;j++)
+ { gsii[j]+=intensity1*g[j]/ds[j];
+ ksii[j]+=intensity1*k[j];
+ grii[j]+=dis*intensity1*g[j]/ds[j];
+ krii[j]+=dis*intensity1*k[j];
+ }
+ erreur=intertype(&l[p+1],xx[p],yy[p],&l[i+1],xx[i],yy[i],t2,dt,g,k);
+ if (erreur!=0)
+ Rprintf("ERREUR 2 Intertype\n");
+ intensity2=l[p+1]/(*surface);
+ for(j=0;j<*t2;j++)
+ { gsii[j]+=intensity2*g[j]/ds[j];
+ ksii[j]+=intensity2*k[j];
+ grii[j]+=dis*intensity2*g[j]/ds[j];
+ krii[j]+=dis*intensity2*k[j];
+ }
+ }
+ }
+
+ D=1-D/((float)(*point_nb)*((float)(*point_nb)-1));
+
+ for(j=0;j<*t2;j++)
+ { gd[j]=(D*grii[j])/((*HD)*gsii[j]);
+ kd[j]=(D*krii[j])/((*HD)*ksii[j]);
+ }
+ /*D=D/((float)(*point_nb)*((float)(*point_nb)-1));
+ H=H/((float)(*point_nb)*((float)(*point_nb)-1));
+
+ for(j=0;j<*t2;j++)
+ { gd[j]=(grii[j]/H)/(gsii[j]/D);
+ kd[j]=(krii[j]/H)/(ksii[j]/D);
+ }*/
+
+ for( i = 0; i < *nbtype; i++)
+ { free(xx[i]);
+ free(yy[i]);
+ }
+ free(xx);
+ free(yy);
+ free(g);
+ free(k);
+ free(l);
+ freevec(gsii);
+ freevec(ksii);
+ freevec(grii);
+ freevec(krii);
+ freevec(ds);
+ return 0;
+}
+
+int shen_ic(int *point_nb,double *x,double *y,
+ int *t2,double *dt,int *nbSimu,double *lev,
+ int *nbtype,int *type,double *mat,double *surface,double *HD,
+ double *gd, double *kd, double *gic1,double *gic2,double *kic1,double *kic2,
+ double *gval,double *kval,int *error)
+{
+ int i,j,p;
+ int *l;
+ int compt[*nbtype+1];
+ double *g,*k;
+ double *ds,dis;
+
+ vecintalloc(&l,*nbtype+1);
+ vecalloc(&g,*t2);
+ vecalloc(&k,*t2);
+
+ // l contient le nombre d'arbres par espce
+ for(i=1;i<*nbtype+1;i++){
+ l[i]=0;
+ compt[i]=0;
+ for(j=0;j<*point_nb;j++){
+ if(type[j]==i)
+ l[i]++;
+ }
+ }
+
+ // crŽation des tableaux xx et yy par espce
+ double **xx,**yy;
+ xx=taballoca(*nbtype,l);
+ yy=taballoca(*nbtype,l);
+ vecalloc(&ds,*t2);
+ complete_tab(*point_nb,xx,yy,type,compt,l,x,y);
+
+ int erreur;
+ double intensity1,point_nb2,point_nb1,intensity2;
+ double intensity=*point_nb/(*surface);
+ double *gsii,*ksii,*grii,*krii;
+ vecalloc(&gsii,*t2);
+ vecalloc(&ksii,*t2);
+ vecalloc(&grii,*t2);
+ vecalloc(&krii,*t2);
+
+ for(j=0;j<*t2;j++)
+ { gsii[j]=0;
+ ksii[j]=0;
+ grii[j]=0;
+ krii[j]=0;
+ ds[j]=(Pi()*(j+1)*(*dt)*(j+1)*(*dt))-(Pi()*j*j*(*dt)*(*dt));
+ }
+
+ double D=(float)l[1]*((float)l[1]-1);
+
+ //Intertype for each pairs of types
+ for(i=1;i<*nbtype;i++)
+ { D+=(float)l[i+1]*((float)l[i+1]-1);
+ for(p=0;p<i;p++)
+ { dis=mat[p*(*nbtype-2)-(p-1)*p/2+i-1];
+ //D+=(float)l[i+1]*((float)l[p+1]);
+ //H+=dis*(float)l[i]*((float)l[p]);
+ erreur=intertype(&l[i+1],xx[i],yy[i],&l[p+1],xx[p],yy[p],t2,dt,g,k);
+ if (erreur!=0)
+ Rprintf("ERREUR 1 Intertype\n");
+ intensity1=l[i+1]/(*surface);
+ for(j=0;j<*t2;j++)
+ { gsii[j]+=intensity1*g[j]/ds[j];
+ ksii[j]+=intensity1*k[j];
+ grii[j]+=dis*intensity1*g[j]/ds[j];
+ krii[j]+=dis*intensity1*k[j];
+ }
+ erreur=intertype(&l[p+1],xx[p],yy[p],&l[i+1],xx[i],yy[i],t2,dt,g,k);
+ if (erreur!=0)
+ Rprintf("ERREUR 2 Intertype\n");
+ intensity2=l[p+1]/(*surface);
+ for(j=0;j<*t2;j++)
+ { gsii[j]+=intensity2*g[j]/ds[j];
+ ksii[j]+=intensity2*k[j];
+ grii[j]+=dis*intensity2*g[j]/ds[j];
+ krii[j]+=dis*intensity2*k[j];
+ }
+ }
+ }
+
+ D=1-D/((float)(*point_nb)*((float)(*point_nb)-1));
+
+ for(j=0;j<*t2;j++)
+ { gd[j]=(D*grii[j])/((*HD)*gsii[j]);
+ kd[j]=(D*krii[j])/((*HD)*ksii[j]);
+ }
+
+ //////////////
+ //simulations sur gii, kii
+ double **gic,**kic;
+ int i0,i1,i2;
+
+ //Definition de i0 : indice ou sera stocke l'estimation des bornes de l'IC
+ i0=*lev/2*(*nbSimu+1);
+ if (i0<1) i0=1;
+
+ //Initialisation des tableaux dans lesquels on va stocker les valeurs extremes lors de MC
+ taballoc(&gic,*t2+1,2*i0+10+1);
+ taballoc(&kic,*t2+1,2*i0+10+1);
+
+ for(i=0;i<*t2;i++)
+ { gval[i]=1;
+ kval[i]=1;
+ }
+ //prŽparation des tableaux pour randomisation de dis (H0=2)
+ int b,lp=0;
+ double HDsim;
+ int *vec, mat_size;
+ vecintalloc(&vec,*nbtype);
+ double *matp;
+ mat_size=*nbtype*(*nbtype-1)/2;
+ vecalloc(&matp,mat_size);
+ for(i=0;i<*nbtype;i++)
+ vec[i]=i;
+ for(i=0;i<mat_size;i++)
+ matp[i]=0;
+
+ //boucle principale de MC
+ Rprintf("Monte Carlo simulation\n");
+ for(b=1;b<=*nbSimu;b++)
+ { randomdist(vec,*nbtype,mat,matp);
+ HDsim=0;
+ for(i=0;i<*t2;i++)
+ { grii[i]=0;
+ krii[i]=0;
+ }
+ for(i=1;i<*nbtype;i++)
+ { for(p=0;p<i;p++)
+ { dis=matp[p*(*nbtype-2)-(p-1)*p/2+i-1];
+ HDsim+=(float)l[i+1]/(float)(*point_nb)*(float)l[p+1]/(float)(*point_nb)*dis;
+ erreur=intertype(&l[i+1],xx[i],yy[i],&l[p+1],xx[p],yy[p],t2,dt,gic1,kic1);
+ if (erreur!=0)
+ Rprintf("ERREUR 1 Intertype\n");
+ intensity1=l[i+1]/(*surface);
+ for(j=0;j<*t2;j++)
+ { grii[j]+=dis*intensity1*gic1[j]/ds[j];
+ krii[j]+=dis*intensity1*kic1[j];
+ }
+ erreur=intertype(&l[p+1],xx[p],yy[p],&l[i+1],xx[i],yy[i],t2,dt,gic1,kic1);
+ if (erreur!=0)
+ Rprintf("ERREUR 2 Intertype\n");
+ intensity2=l[p+1]/(*surface);
+ for(j=0;j<*t2;j++)
+ { grii[j]+=dis*intensity2*gic1[j]/ds[j];
+ krii[j]+=dis*intensity2*kic1[j];
+ }
+ }
+ }
+
+ for(j=0;j<*t2;j++)
+ { grii[j]=(D*grii[j])/((2*HDsim)*gsii[j]);
+ krii[j]=(D*krii[j])/((2*HDsim)*ksii[j]);
+ //deviation from theo=1
+ if ((float)fabs(gd[j]-1)<=(float)fabs(grii[j]-1)) gval[j]+=1;
+ if ((float)fabs(kd[j]-1)<=(float)fabs(krii[j]-1)) kval[j]+=1;
+ }
+
+ //Traitement des resultats
+ ic(b,i0,gic,kic,grii,krii,*t2);
+ R_FlushConsole();
+ progress(b,&lp,*nbSimu);
+ }
+
+ i1=i0+2;
+ i2=i0;
+
+ //Copies des valeurs dans les tableaux resultats
+ for(i=0;i<*t2;i++)
+ { gic1[i]=gic[i+1][i1];
+ gic2[i]=gic[i+1][i2];
+ kic1[i]=kic[i+1][i1];
+ kic2[i]=kic[i+1][i2];
+ }
+ free(gic);
+ free(kic);
+ freeintvec(vec);
+ freevec(matp);
+
+ for( i = 0; i < *nbtype; i++)
+ { free(xx[i]);
+ free(yy[i]);
+ }
+ free(xx);
+ free(yy);
+ free(g);
+ free(k);
+ free(l);
+ freevec(gsii);
+ freevec(ksii);
+ freevec(grii);
+ freevec(krii);
+ freevec(ds);
+ return 0;
+}
+
+int intertype(int *point_nb1,double *x1,double *y1,int *point_nb2, double *x2, double *y2,int *t2,double *dt,double *g,double *k)
+{ int i,j,tt;
+ double d;
+
+ /*On rangera dans g le nombre de couples de points par distance tt*/
+ for(tt=0;tt<*t2;tt++)
+ g[tt]=0;
+
+ /* On regarde tous les couples (i,j)*/
+ for(i=0;i<*point_nb1;i++)
+ { for(j=0;j<*point_nb2;j++)
+ { d=sqrt((x1[i]-x2[j])*(x1[i]-x2[j])+(y1[i]-y2[j])*(y1[i]-y2[j]));
+ if (d<*t2*(*dt))
+ { /* dans quelle classe de distance est ce couple ?*/
+ tt=d/(*dt);
+ /* pas de correction des effets de bord*/
+ g[tt]+=1;
+ }
+ }
+ }
+
+ /* on moyenne -> densite*/
+ for(tt=0;tt<*t2;tt++)
+ g[tt]=g[tt]/(*point_nb1);
+
+ /*on integre*/
+ k[0]=g[0];
+ for(tt=1;tt<*t2;tt++)
+ k[tt]=k[tt-1]+g[tt];
+
+ return 0;
+}
diff --git a/src/Zlibs.h b/src/Zlibs.h
new file mode 100755
index 0000000..9130b52
--- /dev/null
+++ b/src/Zlibs.h
@@ -0,0 +1,175 @@
+double un_point(double,double,double,double,double,double,double,double,double);
+double deux_point(double,double,double,double,double,double,double,double,double);
+double ununun_point(double,double,double,double,double,double,double,double,double);
+double trois_point(double,double,double,double,double,double,double,double,double);
+double deuxun_point(double,double,double,double,double,double,double,double,double);
+double deuxbord_point(double,double,double,double,double,double,double,double,double);
+
+int in_droite(double,double,double,double,double,double,double,double,int);
+int in_triangle(double,double,double,double,double,double,double,double,int);
+
+void ic(int,int,double **,double **,double *,double *,int);
+
+double perim_in_rect(double, double, double, double, double, double, double);
+double perim_in_disq(double,double,double,double,double,double);
+double perim_triangle(double,double,double,int,double *,double *,double *,double *,double *,double *);
+
+int ripley_rect(int*,double*,double*,double*,double*,double*,double*,int*,double*,double*,double*);
+int ripley_disq(int *,double *,double *,double *,double *,double *,int *,double *,double *,double *);
+int ripley_tr_rect(int *,double *,double *,double *,double *,double *,double *,int *,double *,double *,
+ double *,double *,double *,double *,int *,double *,double *,double *);
+int ripley_tr_disq(int *,double *,double *,double *,double *,double *,int *,double *,double *,double *,double *,
+ double *,double *,int *,double *,double *,double *);
+
+int ripley_rect_ic(int *,double *,double *,double *,double *,double *,double *,double *,int *,double *,int *,
+ double *,double *,double *,double *,double *,double *,double *,double *,double *,double *,double *,double *);
+int ripley_disq_ic(int *,double *,double *,double *,double *,double *,double *,int *,double *,int *,double *,
+ double *,double *,double *,double *,double *,double *,double *,double *,double *,double *,double *);
+int ripley_tr_rect_ic(int *,double *,double *,double *,double *,double *,double *,double *,int *, double *,
+ double *,double *,double *,double *,double *,int *,double *,int *,double *,double *,double *,double *,
+ double *,double *,double *,double *,double *,double *,double *,double *);
+int ripley_tr_disq_ic(int *,double *,double *,double *,double *,double *,double *,int *, double *, double *,
+ double *,double *,double *,double *,int *,double *,int *,double *,double *,double *,double *,double *,
+ double *,double *,double *,double *,double *,double *,double *);
+
+int ripleylocal_rect(int*,double *,double *,double*,double*,double*,double*,int*,double*,double *,double *);
+int ripleylocal_disq(int *,double *,double *,double *,double *,double *,int *,double *,double *,double *);
+int ripleylocal_tr_rect(int *,double *,double *,double *,double *,double *,double *,int *,
+ double *,double *,double *,double *,double *,double *,int *,double *,double *,double *);
+int ripleylocal_tr_disq(int *,double *,double *,double *,double *,double *,int *,
+ double *,double *,double *,double *,double *,double *,int *,double *,double *,double *);
+
+int density_rect(int*,double*,double*,double*,double*,double*,double*,int*,double*,double*,double*,int*,double*);
+int density_disq(int*,double *,double *,double*,double*,double*,int*,double*,double *,double *,int*,double *);
+int density_tr_rect(int*,double *,double *,double*,double*,double*,double*,int*,double *,double *,double *,
+ double *,double *,double *,int*,double*,double *,double *,int*,double *);
+int density_tr_disq(int*,double *,double *,double*,double*,double*,int*,double *,double *,double *,double *,
+ double *,double *,int*,double*,double *,double *,int*,double *);
+
+int intertype_rect(int *,double *,double *,int *,double *,double *,double *,double *,double *,double *,
+ int *,double *,double *,double *);
+int intertype_disq(int *,double *,double *,int *,double *,double *,double *,double *,double *,int *,
+ double *,double *,double *);
+int intertype_tr_rect(int *,double *,double *,int *,double *,double *,double *,double *,double *,double *,int *,
+ double *,double *,double *,double *,double *,double *,int *,double *,double *,double *);
+int intertype_tr_disq(int *,double *,double *,int *,double *,double *,double *,double *,double *,int *,
+ double *,double *,double *,double *,double *,double *,int *,double *,double *,double *);
+
+int intertype_rect_ic(int *,double *,double *,int *,double *,double *,double *,double *,double *,double *,
+ double *,int *,double *,int *,int *,double *,int *, int *, int *, double *,double *,double *,double *,double *,double *,double *,
+ double *,double *,double *,double *);
+int intertype_disq_ic(int *,double *,double *,int *,double *,double *,double *,double *,double *,double *,int *,
+ double *,int *,int *,double *,int *,int *,int *,double *,double *,double *,double *,double *,double *,double *,double *,
+ double *,double *,double *);
+int intertype_tr_rect_ic(int *,double *,double *,int *,double *,double *,double *,double *,double *,double *,
+ double *,int *,double *,double *,double *,double *,double *,double *,int *,double *,int *,int *,double *,int *,int *,int *,double *,
+ double *,double *,double *,double *,double *,double *,double *,double *,double *,double *);
+int intertype_tr_disq_ic(int *,double *,double *,int *, double *, double *,double *,double *,double *,double *,
+ int *,double *,double *,double *,double *,double *,double *,int *,double *,int *,int *,double *,int *,int *,int*,double *,double *,
+ double *,double *,double *,double *,double *,double *,double *,double *,double *);
+
+int intertypelocal_rect(int*,double *,double *,int*,double *,double *,double*,double*,double*,double*,
+ int*,double*,double *,double *);
+int intertypelocal_disq(int *,double *,double *,int *,double *,double *,double *,double *, double *,int *,
+ double *,double *,double *);
+int intertypelocal_tr_rect(int *,double *,double *,int *,double *,double *,double *,double *,double *,double *,
+ int *,double *,double *,double *,double *,double *,double *,int *,double *,double *,double *);
+int intertypelocal_tr_disq(int *,double *,double *,int *,double *,double *,double *,double *,double *,int *,
+ double *,double *,double *,double *,double *,double *,int *,double *,double *,double *);
+
+void s_alea_rect(int,double[],double[],double,double,double,double,double);
+void s_alea_disq(int,double *,double *,double,double,double,double);
+void s_alea_tr_rect(int,double *,double *,double,double,double,double,int,double *,double *,double *,double *,
+ double *,double *,double);
+void s_alea_tr_disq(int ,double *,double *,double,double,double,int,double *,double *,double *,double *,
+ double *,double *,double);
+
+int randlabelling(double *, double *, int, double *, double *,int, double *, double *,int *);
+int randshifting_rect(int *,double *,double *,int,double *,double *,double,double,double,double,double);
+int randshifting_disq(int *,double *,double *,int,double *,double *,double,double,double,double);
+int randshifting_tr_rect(int *,double *,double *,int,double *,double *,double,double,double,double,int,
+ double *,double *,double *,double *,double *,double *,double);
+int randshifting_tr_disq(int *,double *,double *,int,double *,double *,double,double,double,int,
+ double *,double *,double *,double *,double *,double *,double);
+int randomlab(double *,double *,int,int *,int,double **,int *,double **);
+void randmark(int ,double *,double *);
+int randomdist(int *,int,double *,double *);
+
+int corr_rect(int *,double *,double *,double *, double *,double *,double *,double *,
+int *,double *,double *,double *);
+int corr_disq(int *,double *,double *,double *, double *,double *,double *,
+int *,double *,double *,double *);
+int corr_tr_rect(int *,double *,double *,double *, double *,double *,double *,double *,
+int *, double *, double *, double *, double *, double *, double *,
+int *,double *,double *,double *);
+int corr_tr_disq(int *,double *,double *,double *, double *,double *,double *,
+int *,double *,double *,double *,double *,double *,double *,
+int *,double *,double *,double *);
+
+int corr_rect_ic(int *,double *,double *,double *, double *,double *,double *,double *,
+int *,double *,int *, double *,double *,double *,
+double *,double *, double *,double *, double *, double *);
+int corr_disq_ic(int *,double *,double *,double *, double *,double *,double *,
+int *,double *,int *, double *,double *,double *,
+double *,double *, double *,double *, double *, double *);
+int corr_tr_rect_ic(int *,double *,double *,double *, double *,double *,double *,double *,
+int *, double *, double *, double *, double *, double *, double *,
+int *,double *,int *, double *,double *,double *,
+double *,double *, double *,double *, double *, double *);
+int corr_tr_disq_ic(int *,double *x,double *,double *, double *,double *,double *,
+int *, double *, double *, double *, double *, double *, double *,
+int *,double *,int *, double *,double *,double *,
+double *,double *, double *,double *, double *, double *);
+
+int shimatani_rect(int *,double *,double *,double *,double *,double *,double *,int *,double *,int *,int *,double *,double *, double *,int *);
+int shimatani_disq(int *,double *,double *, double *,double *,double *,int *,double *,int *,int *,double *,double *, double *,int *);
+int shimatani_tr_rect(int *,double *,double *, double *,double *,double *,double *,int *, double *, double *, double *, double *, double *, double *,
+ int *,double *,int *,int *,double *,double *, double *,int *);
+int shimatani_tr_disq(int *,double *,double *, double *,double *,double *,int *, double *, double *, double *, double *, double *, double *,
+ int *,double *,int *,int *,double *,double *, double *,int *);
+int shimatani_rect_ic(int *,double *,double *, double *,double *,double *,double *,int *,double *,int *,double *,int *,int *,double *,double *,
+ double *, double *,double *,double *,double *,double *,double *,double *,int *);
+int shimatani_disq_ic(int *,double *,double *, double *,double *,double *,int *,double *,int *,double *,int *,int *,double *,double *,
+ double *, double *,double *,double *,double *,double *,double *,double *,int *);
+int shimatani_tr_rect_ic(int *,double *,double *, double *,double *,double *,double *,int *, double *, double *, double *, double *, double *, double *,
+ int *,double *,int *,double *,int *,int *,double *,double *,double *, double *,double *,double *,double *,double *,double *,double *,int *);
+int shimatani_tr_disq_ic(int *,double *,double *, double *,double *,double *,int *, double *, double *, double *, double *, double *, double *,
+ int *,double *,int *,double *,int *,int *,double *,double *,double *, double *,double *,double *,double *,double *,double *,double *,int *);
+
+int rao_rect(int *,double *,double *,double *,double *,double *,double *,int *,double *,int *,int *,int *,double *,double *,double *,double *,
+ double *,double *,double *,int *);
+int rao_rect_ic(int *,double *,double *,double *,double *,double *,double *,int *,double *,int *,int *,double *,int *,int *,double *,double *,
+ double *,double *,double *,double *,double *,double *,double *,double *,double *,double *,double *,int *);
+int rao_disq(int *,double *,double *,double *,double *,double *,int *,double *,int *,int *,int *,double *,double *,double *,double *,
+ double *,double *,double *,int *);
+int rao_disq_ic(int *,double *,double *,double *,double *,double *,int *,double *,int *,int *,double *,int *,int *,double *,double *,
+ double *,double *,double *,double *,double *,double *,double *,double *,double *,double *,double *,int *);
+int rao_tr_rect(int *,double *,double *,double *,double *,double *,double *,int *,double *,double *,double *,double *,double *,double *,
+ int *,double *,int *,int *,int *,double *,double *,double *,double *,double *,double *,double *,int *);
+
+int rao_tr_rect_ic(int *,double *,double *,double *,double *,double *,double *,int *,double *,double *,double *,double *,double *,double *,
+ int *,double *,int *,int *,double *,int *,int *,double *,double *,double *,double *,double *,double *,double *,double *,
+ double *,double *,double *,double *,double *,int *);
+int rao_tr_disq(int *,double *,double *,double *,double *,double *,int *,double *,double *,double *,double *,double *,double *,int *,double *,int *,int *,int *,
+ double *,double *,double *,double *,double *,double *,double *,int *);
+int rao_tr_disq_ic(int *,double *,double *,double *,double *,double *,int *,double *,double *,double *,double *,double *,double *,int *,double *,int *,int *,double *,
+ int *,int *,double *,double *,double *,double *,double *,double *,double *,double *,double *,double *,double *,double *,double *,int *);
+
+int mimetic_rect(int *,double *,double *, double *,double *,double *,double *,double *,double *, int *,double *,double *,int *,int *,double *,double *,double *,double *,double *,int *);
+int mimetic_disq(int *,double *,double *,double *,double *,double *,double *,double *, int *, double *, double *, int *, int *, double *,double *,double *,double *,double *,int *);
+int mimetic_tr_rect(int *,double *,double *, double *,double *,double *,double *,double *,int *, double *, double *, double *, double *, double *, double *,
+ double *, int *, double *, double *, int *, int *, double *,double *, double *,double *,double *,int *);
+int mimetic_tr_disq(int *,double *,double *, double *,double *,double *,double *,int *, double *,double *,double *,double *,double *,double *cy,
+ double *, int *, double *, double *, int *, int *, double *,double *,double *,double *,double *,int *);
+double echange_point_rect(int,double *,double *,double,double,double,double,double,double,double,double *,int *,double *,double *,double *);
+double echange_point_disq(int,double *,double *,double,double,double,double,double,double,double *,int *,double *,double *,double *);
+double echange_point_tr_rect(int,double *,double *,double,double,double,double,int *,double *,double *,double *,double *,double *,double *,
+ double,double,double,double *,int *,double *,double *,double *);
+double echange_point_tr_disq(int,double *,double *,double,double,double,int *,double *,double *,double *,double *,double *,double *,
+ double,double,double,double *,int *,double *,double *,double *);
+
+int shen(int *,double *,double *,int *,double *,int *,int *,double *,double *,double *,double *, double *, int *);
+
+int shen_ic(int *,double *,double *,int *,double *,int *,double *,int *,int *,double *,double *,double *,
+ double *, double *, double *,double *,double *,double *,double *,double *,int *);
+int intertype(int *,double *,double *,int *, double *, double *,int *,double *,double *,double *);
diff --git a/src/adssub.c b/src/adssub.c
new file mode 100755
index 0000000..2ed04ba
--- /dev/null
+++ b/src/adssub.c
@@ -0,0 +1,349 @@
+#include "adssub.h"
+#include <math.h>
+
+double Pi() {
+ return 2*acos(0);
+}
+
+void progress(int i,int *l, int max) {
+ int nb=20;
+ int p=i*(nb+1)/max;
+ int j;
+
+ if(p>*l){
+ for(j=*l;j<p;j++) {
+ if(j==nb) {
+ Rprintf("ok\n");
+ }
+ else {
+ Rprintf(".");
+ }
+ }
+ *l=p;
+ }
+}
+
+/*double alea () {
+ double w;
+ w = ((double) rand())/ (double)RAND_MAX;
+ return (w);
+}*/
+
+/***********************************************************************/
+/*--------------------------------------------------
+* liberation de memoire pour un vecteur
+--------------------------------------------------*/
+void freeintvec (int *vec) {
+ free((char *) vec);
+
+}
+
+/*--------------------------------------------------
+* Allocation de memoire dynamique pour un tableau (l1, c1)
+--------------------------------------------------*/
+void freetab (double **tab) {
+ int i, n;
+ n = *(*(tab));
+ for (i=0;i<=n;i++) {
+ free((char *) *(tab+i) );
+ }
+ free((char *) tab);
+}
+
+/*--------------------------------------------------
+* liberation de memoire pour un vecteur
+--------------------------------------------------*/
+void freevec (double *vec) {
+ free((char *) vec);
+}
+
+/*--------------------------------------------------
+* Allocation de memoire dynamique pour un tableau (l1, c1)
+--------------------------------------------------*/
+void taballoc (double ***tab, int l1, int c1) {
+ int i, j;
+ if ( (*tab = (double **) calloc(l1+1, sizeof(double *))) != 0) {
+ for (i=0;i<=l1;i++) {
+ if ( (*(*tab+i)=(double *) calloc(c1+1, sizeof(double))) == 0 ) {
+ return;
+ for (j=0;j<i;j++) {
+ free(*(*tab+j));
+ }
+ }
+ }
+ }
+ **(*tab) = l1;
+ **(*tab+1) = c1;
+}
+
+/*--------------------------------------------------
+* Allocation de memoire dynamique pour un tableau
+* d'entiers (l1, c1)
+--------------------------------------------------*/
+void tabintalloc (int ***tab, int l1, int c1) {
+ int i, j;
+ *tab = (int **) calloc(l1+1, sizeof(int *));
+ if ( *tab != NULL) {
+ for (i=0;i<=l1;i++) {
+ *(*tab+i)=(int *) calloc(c1+1, sizeof(int));
+ if ( *(*tab+i) == NULL ) {
+ for (j=0;j<i;j++) {
+ free(*(*tab+j));
+ }
+ return;
+ }
+ }
+ } else return;
+ **(*tab) = l1;
+ **(*tab+1) = c1;
+ for (i=1;i<=l1;i++) {
+ for (j=1;j<=c1;j++) {
+ (*tab)[i][j] = 0;
+ }
+ }
+}
+
+/*--------------------------------------------------
+* Allocation de memoire dynamique pour un tableau
+--------------------------------------------------*/
+void freeinttab (int **tab) {
+ int i, n;
+ n = *(*(tab));
+ for (i=0;i<=n;i++) {
+ free((char *) *(tab+i) );
+ }
+ free((char *) tab);
+}
+
+/*--------------------------------------------------
+* Allocation de memoire pour un vecteur de longueur n
+--------------------------------------------------*/
+void vecalloc (double **vec, int n) {
+ if ( (*vec = (double *) calloc(n+1, sizeof(double))) != 0) {
+ **vec = n;
+ return;
+ } else {
+ return;
+ }
+}
+
+/*--------------------------------------------------
+* Allocation de memoire pour un vecteur d'entiers de longueur n
+--------------------------------------------------*/
+void vecintalloc (int **vec, int n) {
+ if ( (*vec = (int *) calloc(n+1, sizeof(int))) != NULL) {
+ **vec = n;
+ return;
+ } else {
+ return;
+ }
+}
+
+/*pour les triangles a exclure*/
+double bacos(double a) {
+ double b;
+ if (a>=1)
+ b=0;
+ else if (a<=-1)
+ b=Pi();
+ else
+ b=acos(a);
+ return b;
+}
+
+/*Decale les valeurs de v de la valeur val*/
+void decalVal(double *v, int n, double val) {
+ int i;
+ for(i=0;i<n;i++) {
+ v[i]=v[i]+val;
+ }
+}
+
+/*Decale les points et la fenetre rectangulaire*/
+void decalRect(int point_nb,double *x, double *y,double *xmin, double *xmax, double *ymin, double *ymax) {
+ if(*xmin<0) {
+ decalVal(x,point_nb,-*xmin);
+ *xmax=*xmax-*xmin;
+ *xmin=0;
+ }
+ if(*ymin<0) {
+ decalVal(y,point_nb,-*ymin);
+ *ymax=*ymax-*ymin;
+ *ymin=0;
+ }
+}
+
+/*Decale les points et la fenetre circulaire*/
+void decalCirc(int point_nb,double *x, double *y,double *x0, double *y0, double r0) {
+ int xmin=*x0-r0;
+ int ymin=*y0-r0;
+ if(xmin<0) {
+ decalVal(x,point_nb,-xmin);
+ *x0=*x0-xmin;
+ }
+ if(ymin<0) {
+ decalVal(y,point_nb,-ymin);
+ *y0=*y0-ymin;
+ }
+}
+
+/*Decale les points et la fenetre rectangulaire + triangles*/
+void decalRectTri(int point_nb,double *x, double *y,double *xmin, double *xmax, double *ymin, double *ymax,
+int tri_nb,double *ax, double *ay, double *bx, double *by, double *cx, double *cy) {
+ if(*xmin<0) {
+ decalVal(x,point_nb,-*xmin);
+ decalVal(ax,tri_nb,-*xmin);
+ decalVal(bx,tri_nb,-*xmin);
+ decalVal(cx,tri_nb,-*xmin);
+ *xmax=*xmax-*xmin;
+ *xmin=0;
+ }
+ if(*ymin<0) {
+ decalVal(y,point_nb,-*ymin);
+ decalVal(ay,tri_nb,-*ymin);
+ decalVal(by,tri_nb,-*ymin);
+ decalVal(cy,tri_nb,-*ymin);
+ *ymax=*ymax-*ymin;
+ *ymin=0;
+ }
+}
+
+/*Decale les points et la fenetre circulaire + triangles*/
+void decalCircTri(int point_nb,double *x, double *y,double *x0, double *y0, double r0,
+int tri_nb,double *ax, double *ay, double *bx, double *by, double *cx, double *cy) {
+ int xmin=*x0-r0;
+ int ymin=*y0-r0;
+ if(xmin<0) {
+ decalVal(x,point_nb,-xmin);
+ decalVal(ax,tri_nb,-xmin);
+ decalVal(bx,tri_nb,-xmin);
+ decalVal(cx,tri_nb,-xmin);
+ *x0=*x0-xmin;
+ }
+ if(ymin<0) {
+ decalVal(y,point_nb,-ymin);
+ decalVal(ay,tri_nb,-ymin);
+ decalVal(by,tri_nb,-ymin);
+ decalVal(cy,tri_nb,-ymin);
+ *y0=*y0-ymin;
+ }
+}
+
+/*Decale les points et la fenetre rectangulaire (semis bivarie)*/
+void decalRect2(int point_nb1,double *x1, double *y1,int point_nb2,double *x2, double *y2,
+double *xmin, double *xmax, double *ymin, double *ymax) {
+ if(*xmin<0) {
+ decalVal(x1,point_nb1,-*xmin);
+ decalVal(x2,point_nb2,-*xmin);
+ *xmax=*xmax-*xmin;
+ *xmin=0;
+ }
+ if(*ymin<0) {
+ decalVal(y1,point_nb1,-*ymin);
+ decalVal(y2,point_nb2,-*ymin);
+ *ymax=*ymax-*ymin;
+ *ymin=0;
+ }
+}
+
+/*Decale les points et la fenetre circulaire (semis bivarie)*/
+void decalCirc2(int point_nb1,double *x1, double *y1,int point_nb2,double *x2, double *y2,
+double *x0, double *y0, double r0) {
+ int xmin=*x0-r0;
+ int ymin=*y0-r0;
+ if(xmin<0) {
+ decalVal(x1,point_nb1,-xmin);
+ decalVal(x2,point_nb2,-xmin);
+ *x0=*x0-xmin;
+ }
+ if(ymin<0) {
+ decalVal(y1,point_nb1,-ymin);
+ decalVal(y2,point_nb2,-ymin);
+ *y0=*y0-ymin;
+ }
+}
+
+/*Decale les points et la fenetre rectangulaire + triangles (semis bivarie)*/
+void decalRectTri2(int point_nb1,double *x1, double *y1,int point_nb2,double *x2, double *y2,
+double *xmin, double *xmax, double *ymin, double *ymax,
+int tri_nb,double *ax, double *ay, double *bx, double *by, double *cx, double *cy) {
+ if(*xmin<0) {
+ decalVal(x1,point_nb1,-*xmin);
+ decalVal(x2,point_nb2,-*xmin);
+ decalVal(ax,tri_nb,-*xmin);
+ decalVal(bx,tri_nb,-*xmin);
+ decalVal(cx,tri_nb,-*xmin);
+ *xmax=*xmax-*xmin;
+ *xmin=0;
+ }
+ if(*ymin<0) {
+ decalVal(y1,point_nb1,-*ymin);
+ decalVal(y2,point_nb2,-*ymin);
+ decalVal(ay,tri_nb,-*ymin);
+ decalVal(by,tri_nb,-*ymin);
+ decalVal(cy,tri_nb,-*ymin);
+ *ymax=*ymax-*ymin;
+ *ymin=0;
+ }
+}
+
+/*Decale les points et la fenetre circulaire + triangles (semis bivarie)*/
+void decalCircTri2(int point_nb1,double *x1, double *y1,int point_nb2,double *x2, double *y2,
+double *x0, double *y0, double r0,
+int tri_nb,double *ax, double *ay, double *bx, double *by, double *cx, double *cy) {
+ int xmin=*x0-r0;
+ int ymin=*y0-r0;
+ if(xmin<0) {
+ decalVal(x1,point_nb1,-xmin);
+ decalVal(x2,point_nb2,-xmin);
+ decalVal(ax,tri_nb,-xmin);
+ decalVal(bx,tri_nb,-xmin);
+ decalVal(cx,tri_nb,-xmin);
+ *x0=*x0-xmin;
+ }
+ if(ymin<0) {
+ decalVal(y1,point_nb1,-ymin);
+ decalVal(y2,point_nb2,-ymin);
+ decalVal(ay,tri_nb,-ymin);
+ decalVal(by,tri_nb,-ymin);
+ decalVal(cy,tri_nb,-ymin);
+ *y0=*y0-ymin;
+ }
+}
+
+/*Decale les points d'echantillonnages (pour density)*/
+void decalSample(int sample_nb,double *x, double *y, double xmin, double ymin) {
+ if(xmin<0) {
+ decalVal(x,sample_nb,-xmin);
+ }
+ if(ymin<0) {
+ decalVal(y,sample_nb,-ymin);
+ }
+}
+
+/*memory allocation for a table with variable row length*/
+double** taballoca(int a,int *b)
+{
+ double **t;
+ int i;
+ t = (double ** ) malloc (a * sizeof (double*));
+ for (i=0;i<a;i++)
+ {
+ t[i]=(double *)malloc(b[i+1] * a * sizeof(double));
+ }
+ return t;
+}
+
+/*create a table with variable row length*/
+void complete_tab(int point_nb,double **xx,double **yy,int *type,int *compt,int *l, double *x,double *y){
+ int i;
+ for(i=0;i<point_nb;i++)
+ {
+ xx[type[i]-1][compt[type[i]]]=x[i];
+ yy[type[i]-1][compt[type[i]]]=y[i];
+ //Rprintf("%d,%d ::: %f, %f\n",type[i]-1,compt[type[i]],x[i],y[i]);
+ compt[type[i]]++;
+ }
+ return ;
+}
+
diff --git a/src/adssub.h b/src/adssub.h
new file mode 100755
index 0000000..baf0554
--- /dev/null
+++ b/src/adssub.h
@@ -0,0 +1,33 @@
+#include <time.h>
+#include <stdlib.h>
+#include <limits.h>
+#include <R_ext/PrtUtil.h>
+
+double Pi();
+void progress(int,int*, int);
+/*double alea ();*/
+void freeintvec (int *);
+void freetab (double **);
+void freevec (double *);
+void taballoc (double ***,int,int);
+void tabintalloc (int ***,int,int);
+void freeinttab (int **);
+void vecalloc (double **vec, int n);
+void vecintalloc (int **vec, int n);
+double bacos(double a);
+void decalVal(double *,int,double);
+void decalRect(int,double *,double *,double *,double *,double *,double *);
+void decalCirc(int,double *,double *,double *,double *,double);
+void decalRectTri(int,double *,double *,double *,double *,double *,double *,
+ int,double *,double *,double *,double *,double *,double *);
+void decalCircTri(int,double *,double *,double *,double *,double,
+ int,double *,double *,double *,double *,double *,double *);
+void decalRect2(int,double *,double *,int,double *,double *,double *,double *,double *,double *);
+void decalCirc2(int,double *,double *,int,double *,double *,double *,double *,double);
+void decalRectTri2(int,double *,double *,int,double *,double *,double *,double *,double *,double *,
+ int,double *,double *,double *,double *,double *,double *);
+void decalCircTri2(int,double *,double *,int,double *,double *,double *,double *,double,int,
+ double *,double *,double *,double *,double *,double *);
+void decalSample(int,double *,double *,double,double);
+double** taballoca(int,int *);
+void complete_tab(int,double **,double **,int *,int *,int *,double *,double *);
diff --git a/src/spatstatsub.f b/src/spatstatsub.f
new file mode 100755
index 0000000..f186cb8
--- /dev/null
+++ b/src/spatstatsub.f
@@ -0,0 +1,47 @@
+C Output from Public domain Ratfor, version 1.0
+ subroutine inpoly(x,y,xp,yp,npts,nedges,score,onbndry)
+ implicit double precision(a-h,o-z)
+ dimension x(npts), y(npts), xp(nedges), yp(nedges), score(npts)
+ logical onbndry(npts)
+ zero = 0.d0
+ half = 0.5d0
+ one = 1.d0
+ do23000 i = 1,nedges
+ x0 = xp(i)
+ y0 = yp(i)
+ if(i .eq. nedges)then
+ x1 = xp(1)
+ y1 = yp(1)
+ else
+ x1 = xp(i+1)
+ y1 = yp(i+1)
+ endif
+ dx = x1 - x0
+ dy = y1 - y0
+ do23004 j = 1,npts
+ xcrit = (x(j) - x0)*(x(j) - x1)
+ if(xcrit .le. zero)then
+ if(xcrit .eq. zero)then
+ contrib = half
+ else
+ contrib = one
+ endif
+ ycrit = y(j)*dx - x(j)*dy + x0*dy - y0*dx
+ if((dx .lt. 0 .and. ycrit .ge. zero) .or. (dx .gt. zero .and. ycri
+ *t .lt. zero))then
+ score(j) = score(j) - sign(one,dx)*contrib
+ onbndry(j) = onbndry(j) .or. (ycrit .eq. zero)
+ else
+ if(dx .eq. zero)then
+ if(x(j) .eq. x0)then
+ ycrit = (y(j) - y0)*(y(j) - y1)
+ onbndry(j) = onbndry(j) .or. (ycrit .le. zero)
+ endif
+ endif
+ endif
+ endif
+23004 continue
+23000 continue
+ return
+ end
+
diff --git a/src/triangulate.c b/src/triangulate.c
new file mode 100755
index 0000000..3a58f2d
--- /dev/null
+++ b/src/triangulate.c
@@ -0,0 +1,2128 @@
+#include "triangulate.h"
+#include "adssub.h"
+#include <sys/time.h>
+#include <string.h>
+#include <math.h>
+#include <R.h>
+#define CROSS_SINE(v0, v1) ((v0).x * (v1).y - (v1).x * (v0).y)
+#define LENGTH(v0) (sqrt((v0).x * (v0).x + (v0).y * (v0).y))
+#ifdef __STDC__
+extern double log2(double);
+#else
+extern double log2();
+#endif
+
+node_t qs[QSIZE]; /* Query structure */
+trap_t tr[TRSIZE]; /* Trapezoid structure */
+segment_t seg[SEGSIZE]; /* Segment table */
+
+static int q_idx;
+static int tr_idx;
+
+static int choose_idx;
+static int permute[SEGSIZE];
+
+static monchain_t mchain[TRSIZE]; /* Table to hold all the monotone */
+ /* polygons . Each monotone polygon */
+ /* is a circularly linked list */
+
+static vertexchain_t vert[SEGSIZE]; /* chain init. information. This */
+ /* is used to decide which */
+ /* monotone polygon to split if */
+ /* there are several other */
+ /* polygons touching at the same */
+ /* vertex */
+
+static int mon[SEGSIZE]; /* contains position of any vertex in */
+ /* the monotone chain for the polygon */
+static int visited[TRSIZE];
+static int chain_idx, op_idx, mon_idx;
+
+
+static int triangulate_single_polygon(int, int, int, int**);
+static int traverse_polygon(int, int, int, int);
+
+/* Function returns TRUE if the trapezoid lies inside the polygon */
+static int inside_polygon(t)
+ trap_t *t;
+{
+ int rseg = t->rseg;
+
+ if (t->state == ST_INVALID)
+ return 0;
+
+ if ((t->lseg <= 0) || (t->rseg <= 0))
+ return 0;
+
+ if (((t->u0 <= 0) && (t->u1 <= 0)) ||
+ ((t->d0 <= 0) && (t->d1 <= 0))) /* triangle */
+ return (_greater_than(&seg[rseg].v1, &seg[rseg].v0));
+
+ return 0;
+}
+
+
+/* return a new mon structure from the table */
+static int newmon()
+{
+ return ++mon_idx;
+}
+
+
+/* return a new chain element from the table */
+static int new_chain_element()
+{
+ return ++chain_idx;
+}
+
+
+static double get_angle(vp0, vpnext, vp1)
+ point_t *vp0;
+ point_t *vpnext;
+ point_t *vp1;
+{
+ point_t v0, v1;
+
+ v0.x = vpnext->x - vp0->x;
+ v0.y = vpnext->y - vp0->y;
+
+ v1.x = vp1->x - vp0->x;
+ v1.y = vp1->y - vp0->y;
+
+ if (CROSS_SINE(v0, v1) >= 0) /* sine is positive */
+ return DOT(v0, v1)/LENGTH(v0)/LENGTH(v1);
+ else
+ return (-1.0 * DOT(v0, v1)/LENGTH(v0)/LENGTH(v1) - 2);
+}
+
+
+/* (v0, v1) is the new diagonal to be added to the polygon. Find which */
+/* chain to use and return the positions of v0 and v1 in p and q */
+static int get_vertex_positions(v0, v1, ip, iq)
+ int v0;
+ int v1;
+ int *ip;
+ int *iq;
+{
+ vertexchain_t *vp0, *vp1;
+ register int i;
+ double angle, temp;
+ int tp=0, tq=0;
+
+ vp0 = &vert[v0];
+ vp1 = &vert[v1];
+
+ /* p is identified as follows. Scan from (v0, v1) rightwards till */
+ /* you hit the first segment starting from v0. That chain is the */
+ /* chain of our interest */
+
+ angle = -4.0;
+ for (i = 0; i < 4; i++)
+ {
+ if (vp0->vnext[i] <= 0)
+ continue;
+ if ((temp = get_angle(&vp0->pt, &(vert[vp0->vnext[i]].pt),
+ &vp1->pt)) > angle)
+ {
+ angle = temp;
+ tp = i;
+ }
+ }
+
+ *ip = tp;
+
+ /* Do similar actions for q */
+
+ angle = -4.0;
+ for (i = 0; i < 4; i++)
+ {
+ if (vp1->vnext[i] <= 0)
+ continue;
+ if ((temp = get_angle(&vp1->pt, &(vert[vp1->vnext[i]].pt),
+ &vp0->pt)) > angle)
+ {
+ angle = temp;
+ tq = i;
+ }
+ }
+
+ *iq = tq;
+
+ return 0;
+}
+
+
+/* v0 and v1 are specified in anti-clockwise order with respect to
+ * the current monotone polygon mcur. Split the current polygon into
+ * two polygons using the diagonal (v0, v1)
+ */
+static int make_new_monotone_poly(mcur, v0, v1)
+ int mcur;
+ int v0;
+ int v1;
+{
+ int p, q, ip, iq;
+ int mnew = newmon();
+ int i, j, nf0, nf1;
+ vertexchain_t *vp0, *vp1;
+
+ vp0 = &vert[v0];
+ vp1 = &vert[v1];
+
+ get_vertex_positions(v0, v1, &ip, &iq);
+
+ p = vp0->vpos[ip];
+ q = vp1->vpos[iq];
+
+ /* At this stage, we have got the positions of v0 and v1 in the */
+ /* desired chain. Now modify the linked lists */
+
+ i = new_chain_element(); /* for the new list */
+ j = new_chain_element();
+
+ mchain[i].vnum = v0;
+ mchain[j].vnum = v1;
+
+ mchain[i].next = mchain[p].next;
+ mchain[mchain[p].next].prev = i;
+ mchain[i].prev = j;
+ mchain[j].next = i;
+ mchain[j].prev = mchain[q].prev;
+ mchain[mchain[q].prev].next = j;
+
+ mchain[p].next = q;
+ mchain[q].prev = p;
+
+ nf0 = vp0->nextfree;
+ nf1 = vp1->nextfree;
+
+ vp0->vnext[ip] = v1;
+
+ vp0->vpos[nf0] = i;
+ vp0->vnext[nf0] = mchain[mchain[i].next].vnum;
+ vp1->vpos[nf1] = j;
+ vp1->vnext[nf1] = v0;
+
+ vp0->nextfree++;
+ vp1->nextfree++;
+
+#ifdef DEBUG
+ Rprintf("make_poly: mcur = %d, (v0, v1) = (%d, %d)\n",
+ mcur, v0, v1);
+ Rprintf("next posns = (p, q) = (%d, %d)\n", p, q);
+#endif
+
+ mon[mcur] = p;
+ mon[mnew] = i;
+ return mnew;
+}
+
+/* Main routine to get monotone polygons from the trapezoidation of
+ * the polygon.
+ */
+
+int monotonate_trapezoids(n)
+ int n;
+{
+ register int i;
+ int tr_start;
+
+ memset((void *)vert, 0, sizeof(vert));
+ memset((void *)visited, 0, sizeof(visited));
+ memset((void *)mchain, 0, sizeof(mchain));
+ memset((void *)mon, 0, sizeof(mon));
+
+ /* First locate a trapezoid which lies inside the polygon */
+ /* and which is triangular */
+ for (i = 0; i < TRSIZE; i++)
+ if (inside_polygon(&tr[i]))
+ break;
+ tr_start = i;
+
+ /* Initialise the mon data-structure and start spanning all the */
+ /* trapezoids within the polygon */
+
+#if 0
+ for (i = 1; i <= n; i++)
+ {
+ mchain[i].prev = i - 1;
+ mchain[i].next = i + 1;
+ mchain[i].vnum = i;
+ vert[i].pt = seg[i].v0;
+ vert[i].vnext[0] = i + 1; /* next vertex */
+ vert[i].vpos[0] = i; /* locn. of next vertex */
+ vert[i].nextfree = 1;
+ }
+ mchain[1].prev = n;
+ mchain[n].next = 1;
+ vert[n].vnext[0] = 1;
+ vert[n].vpos[0] = n;
+ chain_idx = n;
+ mon_idx = 0;
+ mon[0] = 1; /* position of any vertex in the first */
+ /* chain */
+
+#else
+
+ for (i = 1; i <= n; i++)
+ {
+ mchain[i].prev = seg[i].prev;
+ mchain[i].next = seg[i].next;
+ mchain[i].vnum = i;
+ vert[i].pt = seg[i].v0;
+ vert[i].vnext[0] = seg[i].next; /* next vertex */
+ vert[i].vpos[0] = i; /* locn. of next vertex */
+ vert[i].nextfree = 1;
+ }
+
+ chain_idx = n;
+ mon_idx = 0;
+ mon[0] = 1; /* position of any vertex in the first */
+ /* chain */
+
+#endif
+
+ /* traverse the polygon */
+ if (tr[tr_start].u0 > 0)
+ traverse_polygon(0, tr_start, tr[tr_start].u0, TR_FROM_UP);
+ else if (tr[tr_start].d0 > 0)
+ traverse_polygon(0, tr_start, tr[tr_start].d0, TR_FROM_DN);
+
+ /* return the number of polygons created */
+ return newmon();
+}
+
+
+/* recursively visit all the trapezoids */
+static int traverse_polygon(mcur, trnum, from, dir)
+ int mcur;
+ int trnum;
+ int from;
+ int dir;
+{
+ if ((trnum <= 0) || visited[trnum]) return 0;
+ trap_t *t = &tr[trnum];
+ int mnew;
+ int v0, v1;
+ int retval=0;
+ int do_switch = FALSE;
+
+ //if ((trnum <= 0) || visited[trnum]) return 0;
+
+ visited[trnum] = TRUE;
+
+ /* We have much more information available here. */
+ /* rseg: goes upwards */
+ /* lseg: goes downwards */
+
+ /* Initially assume that dir = TR_FROM_DN (from the left) */
+ /* Switch v0 and v1 if necessary afterwards */
+
+
+ /* special cases for triangles with cusps at the opposite ends. */
+ /* take care of this first */
+ if ((t->u0 <= 0) && (t->u1 <= 0))
+ {
+ if ((t->d0 > 0) && (t->d1 > 0)) /* downward opening triangle */
+ {
+ v0 = tr[t->d1].lseg;
+ v1 = t->lseg;
+ if (from == t->d1)
+ {
+ do_switch = TRUE;
+ mnew = make_new_monotone_poly(mcur, v1, v0);
+ traverse_polygon(mcur, t->d1, trnum, TR_FROM_UP);
+ traverse_polygon(mnew, t->d0, trnum, TR_FROM_UP);
+ }
+ else
+ {
+ mnew = make_new_monotone_poly(mcur, v0, v1);
+ traverse_polygon(mcur, t->d0, trnum, TR_FROM_UP);
+ traverse_polygon(mnew, t->d1, trnum, TR_FROM_UP);
+ }
+ }
+ else
+ {
+ retval = SP_NOSPLIT; /* Just traverse all neighbours */
+ traverse_polygon(mcur, t->u0, trnum, TR_FROM_DN);
+ traverse_polygon(mcur, t->u1, trnum, TR_FROM_DN);
+ traverse_polygon(mcur, t->d0, trnum, TR_FROM_UP);
+ traverse_polygon(mcur, t->d1, trnum, TR_FROM_UP);
+ }
+ }
+
+ else if ((t->d0 <= 0) && (t->d1 <= 0))
+ {
+ if ((t->u0 > 0) && (t->u1 > 0)) /* upward opening triangle */
+ {
+ v0 = t->rseg;
+ v1 = tr[t->u0].rseg;
+ if (from == t->u1)
+ {
+ do_switch = TRUE;
+ mnew = make_new_monotone_poly(mcur, v1, v0);
+ traverse_polygon(mcur, t->u1, trnum, TR_FROM_DN);
+ traverse_polygon(mnew, t->u0, trnum, TR_FROM_DN);
+ }
+ else
+ {
+ mnew = make_new_monotone_poly(mcur, v0, v1);
+ traverse_polygon(mcur, t->u0, trnum, TR_FROM_DN);
+ traverse_polygon(mnew, t->u1, trnum, TR_FROM_DN);
+ }
+ }
+ else
+ {
+ retval = SP_NOSPLIT; /* Just traverse all neighbours */
+ traverse_polygon(mcur, t->u0, trnum, TR_FROM_DN);
+ traverse_polygon(mcur, t->u1, trnum, TR_FROM_DN);
+ traverse_polygon(mcur, t->d0, trnum, TR_FROM_UP);
+ traverse_polygon(mcur, t->d1, trnum, TR_FROM_UP);
+ }
+ }
+
+ else if ((t->u0 > 0) && (t->u1 > 0))
+ {
+ if ((t->d0 > 0) && (t->d1 > 0)) /* downward + upward cusps */
+ {
+ v0 = tr[t->d1].lseg;
+ v1 = tr[t->u0].rseg;
+ retval = SP_2UP_2DN;
+ if (((dir == TR_FROM_DN) && (t->d1 == from)) ||
+ ((dir == TR_FROM_UP) && (t->u1 == from)))
+ {
+ do_switch = TRUE;
+ mnew = make_new_monotone_poly(mcur, v1, v0);
+ traverse_polygon(mcur, t->u1, trnum, TR_FROM_DN);
+ traverse_polygon(mcur, t->d1, trnum, TR_FROM_UP);
+ traverse_polygon(mnew, t->u0, trnum, TR_FROM_DN);
+ traverse_polygon(mnew, t->d0, trnum, TR_FROM_UP);
+ }
+ else
+ {
+ mnew = make_new_monotone_poly(mcur, v0, v1);
+ traverse_polygon(mcur, t->u0, trnum, TR_FROM_DN);
+ traverse_polygon(mcur, t->d0, trnum, TR_FROM_UP);
+ traverse_polygon(mnew, t->u1, trnum, TR_FROM_DN);
+ traverse_polygon(mnew, t->d1, trnum, TR_FROM_UP);
+ }
+ }
+ else /* only downward cusp */
+ {
+ if (_equal_to(&t->lo, &seg[t->lseg].v1))
+ {
+ v0 = tr[t->u0].rseg;
+ v1 = seg[t->lseg].next;
+
+ retval = SP_2UP_LEFT;
+ if ((dir == TR_FROM_UP) && (t->u0 == from))
+ {
+ do_switch = TRUE;
+ mnew = make_new_monotone_poly(mcur, v1, v0);
+ traverse_polygon(mcur, t->u0, trnum, TR_FROM_DN);
+ traverse_polygon(mnew, t->d0, trnum, TR_FROM_UP);
+ traverse_polygon(mnew, t->u1, trnum, TR_FROM_DN);
+ traverse_polygon(mnew, t->d1, trnum, TR_FROM_UP);
+ }
+ else
+ {
+ mnew = make_new_monotone_poly(mcur, v0, v1);
+ traverse_polygon(mcur, t->u1, trnum, TR_FROM_DN);
+ traverse_polygon(mcur, t->d0, trnum, TR_FROM_UP);
+ traverse_polygon(mcur, t->d1, trnum, TR_FROM_UP);
+ traverse_polygon(mnew, t->u0, trnum, TR_FROM_DN);
+ }
+ }
+ else
+ {
+ v0 = t->rseg;
+ v1 = tr[t->u0].rseg;
+ retval = SP_2UP_RIGHT;
+ if ((dir == TR_FROM_UP) && (t->u1 == from))
+ {
+ do_switch = TRUE;
+ mnew = make_new_monotone_poly(mcur, v1, v0);
+ traverse_polygon(mcur, t->u1, trnum, TR_FROM_DN);
+ traverse_polygon(mnew, t->d1, trnum, TR_FROM_UP);
+ traverse_polygon(mnew, t->d0, trnum, TR_FROM_UP);
+ traverse_polygon(mnew, t->u0, trnum, TR_FROM_DN);
+ }
+ else
+ {
+ mnew = make_new_monotone_poly(mcur, v0, v1);
+ traverse_polygon(mcur, t->u0, trnum, TR_FROM_DN);
+ traverse_polygon(mcur, t->d0, trnum, TR_FROM_UP);
+ traverse_polygon(mcur, t->d1, trnum, TR_FROM_UP);
+ traverse_polygon(mnew, t->u1, trnum, TR_FROM_DN);
+ }
+ }
+ }
+ }
+ else if ((t->u0 > 0) || (t->u1 > 0)) /* no downward cusp */
+ {
+ if ((t->d0 > 0) && (t->d1 > 0)) /* only upward cusp */
+ {
+ if (_equal_to(&t->hi, &seg[t->lseg].v0))
+ {
+ v0 = tr[t->d1].lseg;
+ v1 = t->lseg;
+ retval = SP_2DN_LEFT;
+ if (!((dir == TR_FROM_DN) && (t->d0 == from)))
+ {
+ do_switch = TRUE;
+ mnew = make_new_monotone_poly(mcur, v1, v0);
+ traverse_polygon(mcur, t->u1, trnum, TR_FROM_DN);
+ traverse_polygon(mcur, t->d1, trnum, TR_FROM_UP);
+ traverse_polygon(mcur, t->u0, trnum, TR_FROM_DN);
+ traverse_polygon(mnew, t->d0, trnum, TR_FROM_UP);
+ }
+ else
+ {
+ mnew = make_new_monotone_poly(mcur, v0, v1);
+ traverse_polygon(mcur, t->d0, trnum, TR_FROM_UP);
+ traverse_polygon(mnew, t->u0, trnum, TR_FROM_DN);
+ traverse_polygon(mnew, t->u1, trnum, TR_FROM_DN);
+ traverse_polygon(mnew, t->d1, trnum, TR_FROM_UP);
+ }
+ }
+ else
+ {
+ v0 = tr[t->d1].lseg;
+ v1 = seg[t->rseg].next;
+
+ retval = SP_2DN_RIGHT;
+ if ((dir == TR_FROM_DN) && (t->d1 == from))
+ {
+ do_switch = TRUE;
+ mnew = make_new_monotone_poly(mcur, v1, v0);
+ traverse_polygon(mcur, t->d1, trnum, TR_FROM_UP);
+ traverse_polygon(mnew, t->u1, trnum, TR_FROM_DN);
+ traverse_polygon(mnew, t->u0, trnum, TR_FROM_DN);
+ traverse_polygon(mnew, t->d0, trnum, TR_FROM_UP);
+ }
+ else
+ {
+ mnew = make_new_monotone_poly(mcur, v0, v1);
+ traverse_polygon(mcur, t->u0, trnum, TR_FROM_DN);
+ traverse_polygon(mcur, t->d0, trnum, TR_FROM_UP);
+ traverse_polygon(mcur, t->u1, trnum, TR_FROM_DN);
+ traverse_polygon(mnew, t->d1, trnum, TR_FROM_UP);
+ }
+ }
+ }
+ else /* no cusp */
+ {
+ if (_equal_to(&t->hi, &seg[t->lseg].v0) &&
+ _equal_to(&t->lo, &seg[t->rseg].v0))
+ {
+ v0 = t->rseg;
+ v1 = t->lseg;
+ retval = SP_SIMPLE_LRDN;
+ if (dir == TR_FROM_UP)
+ {
+ do_switch = TRUE;
+ mnew = make_new_monotone_poly(mcur, v1, v0);
+ traverse_polygon(mcur, t->u0, trnum, TR_FROM_DN);
+ traverse_polygon(mcur, t->u1, trnum, TR_FROM_DN);
+ traverse_polygon(mnew, t->d1, trnum, TR_FROM_UP);
+ traverse_polygon(mnew, t->d0, trnum, TR_FROM_UP);
+ }
+ else
+ {
+ mnew = make_new_monotone_poly(mcur, v0, v1);
+ traverse_polygon(mcur, t->d1, trnum, TR_FROM_UP);
+ traverse_polygon(mcur, t->d0, trnum, TR_FROM_UP);
+ traverse_polygon(mnew, t->u0, trnum, TR_FROM_DN);
+ traverse_polygon(mnew, t->u1, trnum, TR_FROM_DN);
+ }
+ }
+ else if (_equal_to(&t->hi, &seg[t->rseg].v1) &&
+ _equal_to(&t->lo, &seg[t->lseg].v1))
+ {
+ v0 = seg[t->rseg].next;
+ v1 = seg[t->lseg].next;
+
+ retval = SP_SIMPLE_LRUP;
+ if (dir == TR_FROM_UP)
+ {
+ do_switch = TRUE;
+ mnew = make_new_monotone_poly(mcur, v1, v0);
+ traverse_polygon(mcur, t->u0, trnum, TR_FROM_DN);
+ traverse_polygon(mcur, t->u1, trnum, TR_FROM_DN);
+ traverse_polygon(mnew, t->d1, trnum, TR_FROM_UP);
+ traverse_polygon(mnew, t->d0, trnum, TR_FROM_UP);
+ }
+ else
+ {
+ mnew = make_new_monotone_poly(mcur, v0, v1);
+ traverse_polygon(mcur, t->d1, trnum, TR_FROM_UP);
+ traverse_polygon(mcur, t->d0, trnum, TR_FROM_UP);
+ traverse_polygon(mnew, t->u0, trnum, TR_FROM_DN);
+ traverse_polygon(mnew, t->u1, trnum, TR_FROM_DN);
+ }
+ }
+ else /* no split possible */
+ {
+ retval = SP_NOSPLIT;
+ traverse_polygon(mcur, t->u0, trnum, TR_FROM_DN);
+ traverse_polygon(mcur, t->d0, trnum, TR_FROM_UP);
+ traverse_polygon(mcur, t->u1, trnum, TR_FROM_DN);
+ traverse_polygon(mcur, t->d1, trnum, TR_FROM_UP);
+ }
+ }
+ }
+
+ return retval;
+}
+
+
+/* For each monotone polygon, find the ymax and ymin (to determine the */
+/* two y-monotone chains) and pass on this monotone polygon for greedy */
+/* triangulation. */
+/* Take care not to triangulate duplicate monotone polygons */
+
+int triangulate_monotone_polygons(nvert, nmonpoly, op)
+ int nvert;
+ int nmonpoly;
+ int **op;
+{
+ register int i;
+ point_t ymax, ymin;
+ int p, vfirst, posmax, posmin, v;
+ int vcount, processed;
+
+#ifdef DEBUG
+ for (i = 0; i < nmonpoly; i++)
+ {
+ Rprintf("\n\nPolygon %d: ", i);
+ vfirst = mchain[mon[i]].vnum;
+ p = mchain[mon[i]].next;
+ Rprintf ("%d ", mchain[mon[i]].vnum);
+ while (mchain[p].vnum != vfirst)
+ {
+ Rprintf("%d ", mchain[p].vnum);
+ p = mchain[p].next;
+ }
+ }
+ Rprintf("\n");
+#endif
+
+ op_idx = 0;
+ for (i = 0; i < nmonpoly; i++)
+ {
+ vcount = 1;
+ processed = FALSE;
+ vfirst = mchain[mon[i]].vnum;
+ ymax = ymin = vert[vfirst].pt;
+ posmax = posmin = mon[i];
+ mchain[mon[i]].marked = TRUE;
+ p = mchain[mon[i]].next;
+ while ((v = mchain[p].vnum) != vfirst)
+ {
+ if (mchain[p].marked)
+ {
+ processed = TRUE;
+ break; /* break from while */
+ }
+ else
+ mchain[p].marked = TRUE;
+
+ if (_greater_than(&vert[v].pt, &ymax))
+ {
+ ymax = vert[v].pt;
+ posmax = p;
+ }
+ if (_less_than(&vert[v].pt, &ymin))
+ {
+ ymin = vert[v].pt;
+ posmin = p;
+ }
+ p = mchain[p].next;
+ vcount++;
+ }
+
+ if (processed) /* Go to next polygon */
+ continue;
+
+ if (vcount == 3) /* already a triangle */
+ {
+ op[op_idx][0] = mchain[p].vnum;
+ op[op_idx][1] = mchain[mchain[p].next].vnum;
+ op[op_idx][2] = mchain[mchain[p].prev].vnum;
+ op_idx++;
+ }
+ else /* triangulate the polygon */
+ {
+ v = mchain[mchain[posmax].next].vnum;
+ if (_equal_to(&vert[v].pt, &ymin))
+ { /* LHS is a single line */
+ triangulate_single_polygon(nvert, posmax, TRI_LHS, op);
+ }
+ else
+ triangulate_single_polygon(nvert, posmax, TRI_RHS, op);
+ }
+ }
+
+#ifdef DEBUG
+ for (i = 0; i < op_idx; i++)
+ Rprintf("tri #%d: (%d, %d, %d)\n", i, op[i][0], op[i][1],
+ op[i][2]);
+#endif
+ return op_idx;
+}
+
+
+/* A greedy corner-cutting algorithm to triangulate a y-monotone
+ * polygon in O(n) time.
+ * Joseph O-Rourke, Computational Geometry in C.
+ */
+static int triangulate_single_polygon(nvert, posmax, side, op)
+ int nvert;
+ int posmax;
+ int side;
+ int **op;
+{
+ register int v;
+ int rc[SEGSIZE], ri = 0; /* reflex chain */
+ int endv, tmp, vpos;
+
+ if (side == TRI_RHS) /* RHS segment is a single segment */
+ {
+ rc[0] = mchain[posmax].vnum;
+ tmp = mchain[posmax].next;
+ rc[1] = mchain[tmp].vnum;
+ ri = 1;
+
+ vpos = mchain[tmp].next;
+ v = mchain[vpos].vnum;
+
+ if ((endv = mchain[mchain[posmax].prev].vnum) == 0)
+ endv = nvert;
+ }
+ else /* LHS is a single segment */
+ {
+ tmp = mchain[posmax].next;
+ rc[0] = mchain[tmp].vnum;
+ tmp = mchain[tmp].next;
+ rc[1] = mchain[tmp].vnum;
+ ri = 1;
+
+ vpos = mchain[tmp].next;
+ v = mchain[vpos].vnum;
+
+ endv = mchain[posmax].vnum;
+ }
+
+ while ((v != endv) || (ri > 1))
+ {
+ if (ri > 0) /* reflex chain is non-empty */
+ {
+ if (CROSS(vert[v].pt, vert[rc[ri - 1]].pt,
+ vert[rc[ri]].pt) > 0)
+ { /* convex corner: cut if off */
+ op[op_idx][0] = rc[ri - 1];
+ op[op_idx][1] = rc[ri];
+ op[op_idx][2] = v;
+ op_idx++;
+ ri--;
+ }
+ else /* non-convex */
+ { /* add v to the chain */
+ ri++;
+ rc[ri] = v;
+ vpos = mchain[vpos].next;
+ v = mchain[vpos].vnum;
+ }
+ }
+ else /* reflex-chain empty: add v to the */
+ { /* reflex chain and advance it */
+ rc[++ri] = v;
+ vpos = mchain[vpos].next;
+ v = mchain[vpos].vnum;
+ }
+ } /* end-while */
+
+ /* reached the bottom vertex. Add in the triangle formed */
+ op[op_idx][0] = rc[ri - 1];
+ op[op_idx][1] = rc[ri];
+ op[op_idx][2] = v;
+ op_idx++;
+ ri--;
+
+ return 0;
+}
+
+
+/*teste le sens du polygone*/
+int testclock(double *x,double *y,int last) {
+ double ymi;
+ int i,rang;
+ double d,ang1,ang2;
+
+ ymi=y[1];
+ rang=1;
+ for(i=1;i<=last;i++)
+ { if(y[i]<ymi)
+ { ymi=y[i];
+ rang=i;
+ }
+ }
+
+ if(rang==1)
+ { d=sqrt((x[1]-x[last])*(x[1]-x[last])+(y[1]-y[last])*(y[1]-y[last]));
+ ang1=bacos((x[1]-x[last])/d);
+
+ d=sqrt((x[1]-x[2])*(x[1]-x[2])+(y[1]-y[2])*(y[1]-y[2]));
+ ang2=bacos((x[1]-x[2])/d);
+ }
+ else if(rang==last)
+ { d=sqrt((x[last]-x[last-1])*(x[last]-x[last-1])+(y[last]-y[last-1])*(y[last]-y[last-1]));
+ ang1=bacos((x[last]-x[last-1])/d);
+
+ d=sqrt((x[last]-x[1])*(x[last]-x[1])+(y[last]-y[1])*(y[last]-y[1]));
+ ang2=bacos((x[last]-x[1])/d);
+ }
+ else
+ { d=sqrt((x[rang]-x[rang-1])*(x[rang]-x[rang-1])+(y[rang]-y[rang-1])*(y[rang]-y[rang-1]));
+ ang1=bacos((x[rang]-x[rang-1])/d);
+
+ d=sqrt((x[rang]-x[rang+1])*(x[rang]-x[rang+1])+(y[rang]-y[rang+1])*(y[rang]-y[rang+1]));
+ ang2=bacos((x[rang]-x[rang+1])/d);
+ }
+
+ if (ang1>ang2) return 1; /*clockwise order*/
+ else return 0; /*anti-clockwise order*/
+}
+
+
+/* Generate a random permutation of the segments 1..n */
+/*int generate_random_ordering(int n) {
+ int lig, i,j, k;
+ double z;
+ choose_idx = 1;
+ for (i = 1; i <= n; i++)
+ permute[i]=i;
+ lig = permute[0];
+ for (i=1; i<=lig-1; i++)
+ { j=lig-i+1;
+ k = (int) (j*alea()+1);
+ if (k>j) k=j;
+ z = permute[j];
+ permute[j]=permute[k];
+ permute[k] = z;
+ }
+ return 0;
+}*/
+int generate_random_ordering(int n) {
+ int lig, i,j, k;
+ double z;
+ GetRNGstate();
+ choose_idx = 1;
+ for (i = 1; i <= n; i++)
+ permute[i]=i;
+ lig = permute[0];
+ for (i=1; i<=lig-1; i++)
+ { j=lig-i+1;
+ k = (int) (j*unif_rand()+1);
+ if (k>j) k=j;
+ z = permute[j];
+ permute[j]=permute[k];
+ permute[k] = z;
+ }
+ PutRNGstate();
+ return 0;
+}
+
+/* Return the next segment in the generated random ordering of all the */
+/* segments in S */
+int choose_segment() {
+#ifdef DEBUG
+ Rprintf("choose_segment: %d\n", permute[choose_idx]);
+#endif
+ return permute[choose_idx++];
+}
+
+#ifdef STANDALONE
+/* Read in the list of vertices from infile */
+int read_segments(filename, genus)
+ char *filename;
+ int *genus;
+{
+ FILE *infile;
+ int ccount;
+ register int i;
+ int ncontours, npoints, first, last;
+
+ if ((infile = fopen(filename, "r")) == NULL)
+ {
+ perror(filename);
+ return -1;
+ }
+
+ fscanf(infile, "%d", &ncontours);
+ if (ncontours <= 0)
+ return -1;
+
+ /* For every contour, read in all the points for the contour. The */
+ /* outer-most contour is read in first (points specified in */
+ /* anti-clockwise order). Next, the inner contours are input in */
+ /* clockwise order */
+
+ ccount = 0;
+ i = 1;
+
+ while (ccount < ncontours)
+ {
+ int j;
+
+ fscanf(infile, "%d", &npoints);
+ first = i;
+ last = first + npoints - 1;
+ for (j = 0; j < npoints; j++, i++)
+ {
+ fscanf(infile, "%lf%lf", &seg[i].v0.x, &seg[i].v0.y);
+ if (i == last)
+ {
+ seg[i].next = first;
+ seg[i].prev = i-1;
+ seg[i-1].v1 = seg[i].v0;
+ }
+ else if (i == first)
+ {
+ seg[i].next = i+1;
+ seg[i].prev = last;
+ seg[last].v1 = seg[i].v0;
+ }
+ else
+ {
+ seg[i].prev = i-1;
+ seg[i].next = i+1;
+ seg[i-1].v1 = seg[i].v0;
+ }
+
+ seg[i].is_inserted = FALSE;
+ }
+
+ ccount++;
+ }
+
+ *genus = ncontours - 1;
+ return i-1;
+}
+
+#endif
+
+
+/* Get log*n for given n */
+int math_logstar_n(n)
+ int n;
+{
+ register int i;
+ double v;
+
+ for (i = 0, v = (double) n; v >= 1; i++)
+ v = log2(v);
+
+ return (i - 1);
+}
+
+
+int math_N(n, h)
+ int n;
+ int h;
+{
+ register int i;
+ double v;
+
+ for (i = 0, v = (int) n; i < h; i++)
+ v = log2(v);
+
+ return (int) ceil((double) 1.0*n/v);
+}
+
+
+/* Return a new node to be added into the query tree */
+static int newnode()
+{
+ if (q_idx < QSIZE)
+ return q_idx++;
+ else
+ {
+ Rprintf("newnode: Query-table overflow\n");
+ return -1;
+ }
+}
+
+/* Return a free trapezoid */
+static int newtrap()
+{
+ if (tr_idx < TRSIZE)
+ {
+ tr[tr_idx].lseg = -1;
+ tr[tr_idx].rseg = -1;
+ tr[tr_idx].state = ST_VALID;
+ return tr_idx++;
+ }
+ else
+ {
+ Rprintf("newtrap: Trapezoid-table overflow\n");
+ return -1;
+ }
+}
+
+
+/* Return the maximum of the two points into the yval structure */
+static int _max(yval, v0, v1)
+ point_t *yval;
+ point_t *v0;
+ point_t *v1;
+{
+ if (v0->y > v1->y + C_EPS)
+ *yval = *v0;
+ else if (FP_EQUAL(v0->y, v1->y))
+ {
+ if (v0->x > v1->x + C_EPS)
+ *yval = *v0;
+ else
+ *yval = *v1;
+ }
+ else
+ *yval = *v1;
+
+ return 0;
+}
+
+
+/* Return the minimum of the two points into the yval structure */
+static int _min(yval, v0, v1)
+ point_t *yval;
+ point_t *v0;
+ point_t *v1;
+{
+ if (v0->y < v1->y - C_EPS)
+ *yval = *v0;
+ else if (FP_EQUAL(v0->y, v1->y))
+ {
+ if (v0->x < v1->x)
+ *yval = *v0;
+ else
+ *yval = *v1;
+ }
+ else
+ *yval = *v1;
+
+ return 0;
+}
+
+
+int _greater_than(v0, v1)
+ point_t *v0;
+ point_t *v1;
+{
+ if (v0->y > v1->y + C_EPS)
+ return TRUE;
+ else if (v0->y < v1->y - C_EPS)
+ return FALSE;
+ else
+ return (v0->x > v1->x);
+}
+
+
+int _equal_to(v0, v1)
+ point_t *v0;
+ point_t *v1;
+{
+ return (FP_EQUAL(v0->y, v1->y) && FP_EQUAL(v0->x, v1->x));
+}
+
+int _greater_than_equal_to(v0, v1)
+ point_t *v0;
+ point_t *v1;
+{
+ if (v0->y > v1->y + C_EPS)
+ return TRUE;
+ else if (v0->y < v1->y - C_EPS)
+ return FALSE;
+ else
+ return (v0->x >= v1->x);
+}
+
+int _less_than(v0, v1)
+ point_t *v0;
+ point_t *v1;
+{
+ if (v0->y < v1->y - C_EPS)
+ return TRUE;
+ else if (v0->y > v1->y + C_EPS)
+ return FALSE;
+ else
+ return (v0->x < v1->x);
+}
+
+
+/* Initilialise the query structure (Q) and the trapezoid table (T)
+ * when the first segment is added to start the trapezoidation. The
+ * query-tree starts out with 4 trapezoids, one S-node and 2 Y-nodes
+ *
+ * 4
+ * -----------------------------------
+ * \
+ * 1 \ 2
+ * \
+ * -----------------------------------
+ * 3
+ */
+
+static int init_query_structure(segnum)
+ int segnum;
+{
+ int i1, i2, i3, i4, i5, i6, i7, root;
+ int t1, t2, t3, t4;
+ segment_t *s = &seg[segnum];
+
+ q_idx = tr_idx = 1;
+ memset((void *)tr, 0, sizeof(tr));
+ memset((void *)qs, 0, sizeof(qs));
+
+ i1 = newnode();
+ qs[i1].nodetype = T_Y;
+ _max(&qs[i1].yval, &s->v0, &s->v1); /* root */
+ root = i1;
+
+ qs[i1].right = i2 = newnode();
+ qs[i2].nodetype = T_SINK;
+ qs[i2].parent = i1;
+
+ qs[i1].left = i3 = newnode();
+ qs[i3].nodetype = T_Y;
+ _min(&qs[i3].yval, &s->v0, &s->v1); /* root */
+ qs[i3].parent = i1;
+
+ qs[i3].left = i4 = newnode();
+ qs[i4].nodetype = T_SINK;
+ qs[i4].parent = i3;
+
+ qs[i3].right = i5 = newnode();
+ qs[i5].nodetype = T_X;
+ qs[i5].segnum = segnum;
+ qs[i5].parent = i3;
+
+ qs[i5].left = i6 = newnode();
+ qs[i6].nodetype = T_SINK;
+ qs[i6].parent = i5;
+
+ qs[i5].right = i7 = newnode();
+ qs[i7].nodetype = T_SINK;
+ qs[i7].parent = i5;
+
+ t1 = newtrap(); /* middle left */
+ t2 = newtrap(); /* middle right */
+ t3 = newtrap(); /* bottom-most */
+ t4 = newtrap(); /* topmost */
+
+ tr[t1].hi = tr[t2].hi = tr[t4].lo = qs[i1].yval;
+ tr[t1].lo = tr[t2].lo = tr[t3].hi = qs[i3].yval;
+ tr[t4].hi.y = (double) (INFINITY);
+ tr[t4].hi.x = (double) (INFINITY);
+ tr[t3].lo.y = (double) -1* (INFINITY);
+ tr[t3].lo.x = (double) -1* (INFINITY);
+ tr[t1].rseg = tr[t2].lseg = segnum;
+ tr[t1].u0 = tr[t2].u0 = t4;
+ tr[t1].d0 = tr[t2].d0 = t3;
+ tr[t4].d0 = tr[t3].u0 = t1;
+ tr[t4].d1 = tr[t3].u1 = t2;
+
+ tr[t1].sink = i6;
+ tr[t2].sink = i7;
+ tr[t3].sink = i4;
+ tr[t4].sink = i2;
+
+ tr[t1].state = tr[t2].state = ST_VALID;
+ tr[t3].state = tr[t4].state = ST_VALID;
+
+ qs[i2].trnum = t4;
+ qs[i4].trnum = t3;
+ qs[i6].trnum = t1;
+ qs[i7].trnum = t2;
+
+ s->is_inserted = TRUE;
+ return root;
+}
+
+
+/* Retun TRUE if the vertex v is to the left of line segment no.
+ * segnum. Takes care of the degenerate cases when both the vertices
+ * have the same y--cood, etc.
+ */
+
+static int is_left_of(segnum, v)
+ int segnum;
+ point_t *v;
+{
+ segment_t *s = &seg[segnum];
+ double area;
+
+ if (_greater_than(&s->v1, &s->v0)) /* seg. going upwards */
+ {
+ if (FP_EQUAL(s->v1.y, v->y))
+ {
+ if (v->x < s->v1.x)
+ area = 1.0;
+ else
+ area = -1.0;
+ }
+ else if (FP_EQUAL(s->v0.y, v->y))
+ {
+ if (v->x < s->v0.x)
+ area = 1.0;
+ else
+ area = -1.0;
+ }
+ else
+ area = CROSS(s->v0, s->v1, (*v));
+ }
+ else /* v0 > v1 */
+ {
+ if (FP_EQUAL(s->v1.y, v->y))
+ {
+ if (v->x < s->v1.x)
+ area = 1.0;
+ else
+ area = -1.0;
+ }
+ else if (FP_EQUAL(s->v0.y, v->y))
+ {
+ if (v->x < s->v0.x)
+ area = 1.0;
+ else
+ area = -1.0;
+ }
+ else
+ area = CROSS(s->v1, s->v0, (*v));
+ }
+
+ if (area > 0.0)
+ return TRUE;
+ else
+ return FALSE;
+}
+
+
+
+/* Returns true if the corresponding endpoint of the given segment is */
+/* already inserted into the segment tree. Use the simple test of */
+/* whether the segment which shares this endpoint is already inserted */
+
+static int inserted(segnum, whichpt)
+ int segnum;
+ int whichpt;
+{
+ if (whichpt == FIRSTPT)
+ return seg[seg[segnum].prev].is_inserted;
+ else
+ return seg[seg[segnum].next].is_inserted;
+}
+
+/* This is query routine which determines which trapezoid does the
+ * point v lie in. The return value is the trapezoid number.
+ */
+
+int locate_endpoint(v, vo, r)
+ point_t *v;
+ point_t *vo;
+ int r;
+{
+ node_t *rptr = &qs[r];
+
+ switch (rptr->nodetype)
+ {
+ case T_SINK:
+ return rptr->trnum;
+
+ case T_Y:
+ if (_greater_than(v, &rptr->yval)) /* above */
+ return locate_endpoint(v, vo, rptr->right);
+ else if (_equal_to(v, &rptr->yval)) /* the point is already */
+ { /* inserted. */
+ if (_greater_than(vo, &rptr->yval)) /* above */
+ return locate_endpoint(v, vo, rptr->right);
+ else
+ return locate_endpoint(v, vo, rptr->left); /* below */
+ }
+ else
+ return locate_endpoint(v, vo, rptr->left); /* below */
+
+ case T_X:
+ if (_equal_to(v, &seg[rptr->segnum].v0) ||
+ _equal_to(v, &seg[rptr->segnum].v1))
+ {
+ if (FP_EQUAL(v->y, vo->y)) /* horizontal segment */
+ {
+ if (vo->x < v->x)
+ return locate_endpoint(v, vo, rptr->left); /* left */
+ else
+ return locate_endpoint(v, vo, rptr->right); /* right */
+ }
+
+ else if (is_left_of(rptr->segnum, vo))
+ return locate_endpoint(v, vo, rptr->left); /* left */
+ else
+ return locate_endpoint(v, vo, rptr->right); /* right */
+ }
+ else if (is_left_of(rptr->segnum, v))
+ return locate_endpoint(v, vo, rptr->left); /* left */
+ else
+ return locate_endpoint(v, vo, rptr->right); /* right */
+
+ default:
+ Rprintf("Haggu !!!!!\n");
+ break;
+ }
+ return 0;
+}
+
+
+/* Thread in the segment into the existing trapezoidation. The
+ * limiting trapezoids are given by tfirst and tlast (which are the
+ * trapezoids containing the two endpoints of the segment. Merges all
+ * possible trapezoids which flank this segment and have been recently
+ * divided because of its insertion
+ */
+
+static int merge_trapezoids(segnum, tfirst, tlast, side)
+ int segnum;
+ int tfirst;
+ int tlast;
+ int side;
+{
+ int t, tnext, cond;
+ int ptnext;
+
+ /* First merge polys on the LHS */
+ t = tfirst;
+ while ((t > 0) && _greater_than_equal_to(&tr[t].lo, &tr[tlast].lo))
+ {
+ if (side == S_LEFT)
+ cond = ((((tnext = tr[t].d0) > 0) && (tr[tnext].rseg == segnum)) ||
+ (((tnext = tr[t].d1) > 0) && (tr[tnext].rseg == segnum)));
+ else
+ cond = ((((tnext = tr[t].d0) > 0) && (tr[tnext].lseg == segnum)) ||
+ (((tnext = tr[t].d1) > 0) && (tr[tnext].lseg == segnum)));
+
+ if (cond)
+ {
+ if ((tr[t].lseg == tr[tnext].lseg) &&
+ (tr[t].rseg == tr[tnext].rseg)) /* good neighbours */
+ { /* merge them */
+ /* Use the upper node as the new node i.e. t */
+
+ ptnext = qs[tr[tnext].sink].parent;
+
+ if (qs[ptnext].left == tr[tnext].sink)
+ qs[ptnext].left = tr[t].sink;
+ else
+ qs[ptnext].right = tr[t].sink; /* redirect parent */
+
+
+ /* Change the upper neighbours of the lower trapezoids */
+
+ if ((tr[t].d0 = tr[tnext].d0) > 0) {
+ if (tr[tr[t].d0].u0 == tnext) {
+ tr[tr[t].d0].u0 = t;
+ }
+ else {
+ if (tr[tr[t].d0].u1 == tnext) {
+ tr[tr[t].d0].u1 = t;
+ }
+ }
+ }
+
+ if ((tr[t].d1 = tr[tnext].d1) > 0) {
+ if (tr[tr[t].d1].u0 == tnext) {
+ tr[tr[t].d1].u0 = t;
+ }
+ else {
+ if (tr[tr[t].d1].u1 == tnext) {
+ tr[tr[t].d1].u1 = t;
+ }
+ }
+ }
+
+ tr[t].lo = tr[tnext].lo;
+ tr[tnext].state = ST_INVALID; /* invalidate the lower */
+ /* trapezium */
+ }
+ else /* not good neighbours */
+ t = tnext;
+ }
+ else /* do not satisfy the outer if */
+ t = tnext;
+
+ } /* end-while */
+
+ return 0;
+}
+
+
+/* Add in the new segment into the trapezoidation and update Q and T
+ * structures. First locate the two endpoints of the segment in the
+ * Q-structure. Then start from the topmost trapezoid and go down to
+ * the lower trapezoid dividing all the trapezoids in between .
+ */
+
+static int add_segment(segnum)
+ int segnum;
+{
+ segment_t s;
+ int tu, tl, sk, tfirst, tlast, tnext;
+ int tfirstr=0, tlastr=0, tfirstl, tlastl;
+ int i1, i2, t, tn;
+ point_t tpt;
+ int tritop = 0, tribot = 0, is_swapped = 0;
+ int tmptriseg,tmpseg=0;
+
+ s = seg[segnum];
+ if (_greater_than(&s.v1, &s.v0)) /* Get higher vertex in v0 */
+ {
+ int tmp;
+ tpt = s.v0;
+ s.v0 = s.v1;
+ s.v1 = tpt;
+ tmp = s.root0;
+ s.root0 = s.root1;
+ s.root1 = tmp;
+ is_swapped = TRUE;
+ }
+
+ if ((is_swapped) ? !inserted(segnum, LASTPT) :
+ !inserted(segnum, FIRSTPT)) /* insert v0 in the tree */
+ {
+ int tmp_d;
+
+ tu = locate_endpoint(&s.v0, &s.v1, s.root0);
+ tl = newtrap(); /* tl is the new lower trapezoid */
+ tr[tl].state = ST_VALID;
+ tr[tl] = tr[tu];
+ tr[tu].lo.y = tr[tl].hi.y = s.v0.y;
+ tr[tu].lo.x = tr[tl].hi.x = s.v0.x;
+ tr[tu].d0 = tl;
+ tr[tu].d1 = 0;
+ tr[tl].u0 = tu;
+ tr[tl].u1 = 0;
+
+ if (((tmp_d = tr[tl].d0) > 0) && (tr[tmp_d].u0 == tu))
+ tr[tmp_d].u0 = tl;
+ if (((tmp_d = tr[tl].d0) > 0) && (tr[tmp_d].u1 == tu))
+ tr[tmp_d].u1 = tl;
+
+ if (((tmp_d = tr[tl].d1) > 0) && (tr[tmp_d].u0 == tu))
+ tr[tmp_d].u0 = tl;
+ if (((tmp_d = tr[tl].d1) > 0) && (tr[tmp_d].u1 == tu))
+ tr[tmp_d].u1 = tl;
+
+ /* Now update the query structure and obtain the sinks for the */
+ /* two trapezoids */
+
+ i1 = newnode(); /* Upper trapezoid sink */
+ i2 = newnode(); /* Lower trapezoid sink */
+ sk = tr[tu].sink;
+
+ qs[sk].nodetype = T_Y;
+ qs[sk].yval = s.v0;
+ qs[sk].segnum = segnum; /* not really reqd ... maybe later */
+ qs[sk].left = i2;
+ qs[sk].right = i1;
+
+ qs[i1].nodetype = T_SINK;
+ qs[i1].trnum = tu;
+ qs[i1].parent = sk;
+
+ qs[i2].nodetype = T_SINK;
+ qs[i2].trnum = tl;
+ qs[i2].parent = sk;
+
+ tr[tu].sink = i1;
+ tr[tl].sink = i2;
+ tfirst = tl;
+ }
+ else /* v0 already present */
+ { /* Get the topmost intersecting trapezoid */
+ tfirst = locate_endpoint(&s.v0, &s.v1, s.root0);
+ tritop = 1;
+ }
+
+
+ if ((is_swapped) ? !inserted(segnum, FIRSTPT) :
+ !inserted(segnum, LASTPT)) /* insert v1 in the tree */
+ {
+ int tmp_d;
+
+ tu = locate_endpoint(&s.v1, &s.v0, s.root1);
+
+ tl = newtrap(); /* tl is the new lower trapezoid */
+ tr[tl].state = ST_VALID;
+ tr[tl] = tr[tu];
+ tr[tu].lo.y = tr[tl].hi.y = s.v1.y;
+ tr[tu].lo.x = tr[tl].hi.x = s.v1.x;
+ tr[tu].d0 = tl;
+ tr[tu].d1 = 0;
+ tr[tl].u0 = tu;
+ tr[tl].u1 = 0;
+
+ if (((tmp_d = tr[tl].d0) > 0) && (tr[tmp_d].u0 == tu))
+ tr[tmp_d].u0 = tl;
+ if (((tmp_d = tr[tl].d0) > 0) && (tr[tmp_d].u1 == tu))
+ tr[tmp_d].u1 = tl;
+
+ if (((tmp_d = tr[tl].d1) > 0) && (tr[tmp_d].u0 == tu))
+ tr[tmp_d].u0 = tl;
+ if (((tmp_d = tr[tl].d1) > 0) && (tr[tmp_d].u1 == tu))
+ tr[tmp_d].u1 = tl;
+
+ /* Now update the query structure and obtain the sinks for the */
+ /* two trapezoids */
+
+ i1 = newnode(); /* Upper trapezoid sink */
+ i2 = newnode(); /* Lower trapezoid sink */
+ sk = tr[tu].sink;
+
+ qs[sk].nodetype = T_Y;
+ qs[sk].yval = s.v1;
+ qs[sk].segnum = segnum; /* not really reqd ... maybe later */
+ qs[sk].left = i2;
+ qs[sk].right = i1;
+
+ qs[i1].nodetype = T_SINK;
+ qs[i1].trnum = tu;
+ qs[i1].parent = sk;
+
+ qs[i2].nodetype = T_SINK;
+ qs[i2].trnum = tl;
+ qs[i2].parent = sk;
+
+ tr[tu].sink = i1;
+ tr[tl].sink = i2;
+ tlast = tu;
+ }
+ else /* v1 already present */
+ { /* Get the lowermost intersecting trapezoid */
+ tlast = locate_endpoint(&s.v1, &s.v0, s.root1);
+ tribot = 1;
+ }
+
+ /* Thread the segment into the query tree creating a new X-node */
+ /* First, split all the trapezoids which are intersected by s into */
+ /* two */
+
+ t = tfirst; /* topmost trapezoid */
+
+ while ((t > 0) &&
+ _greater_than_equal_to(&tr[t].lo, &tr[tlast].lo))
+ /* traverse from top to bot */
+ {
+ int t_sav, tn_sav;
+ sk = tr[t].sink;
+ i1 = newnode(); /* left trapezoid sink */
+ i2 = newnode(); /* right trapezoid sink */
+
+ qs[sk].nodetype = T_X;
+ qs[sk].segnum = segnum;
+ qs[sk].left = i1;
+ qs[sk].right = i2;
+
+ qs[i1].nodetype = T_SINK; /* left trapezoid (use existing one) */
+ qs[i1].trnum = t;
+ qs[i1].parent = sk;
+
+ qs[i2].nodetype = T_SINK; /* right trapezoid (allocate new) */
+ qs[i2].trnum = tn = newtrap();
+ tr[tn].state = ST_VALID;
+ qs[i2].parent = sk;
+
+ if (t == tfirst)
+ tfirstr = tn;
+ if (_equal_to(&tr[t].lo, &tr[tlast].lo))
+ tlastr = tn;
+
+ tr[tn] = tr[t];
+ tr[t].sink = i1;
+ tr[tn].sink = i2;
+ t_sav = t;
+ tn_sav = tn;
+
+ /* error */
+
+ if ((tr[t].d0 <= 0) && (tr[t].d1 <= 0)) /* case cannot arise */
+ {
+ Rprintf("add_segment: error\n");
+ break;
+ }
+
+ /* only one trapezoid below. partition t into two and make the */
+ /* two resulting trapezoids t and tn as the upper neighbours of */
+ /* the sole lower trapezoid */
+
+ else if ((tr[t].d0 > 0) && (tr[t].d1 <= 0))
+ { /* Only one trapezoid below */
+ if ((tr[t].u0 > 0) && (tr[t].u1 > 0))
+ { /* continuation of a chain from abv. */
+ if (tr[t].usave > 0) /* three upper neighbours */
+ {
+ if (tr[t].uside == S_LEFT)
+ {
+ tr[tn].u0 = tr[t].u1;
+ tr[t].u1 = -1;
+ tr[tn].u1 = tr[t].usave;
+
+ tr[tr[t].u0].d0 = t;
+ tr[tr[tn].u0].d0 = tn;
+ tr[tr[tn].u1].d0 = tn;
+ }
+ else /* intersects in the right */
+ {
+ tr[tn].u1 = -1;
+ tr[tn].u0 = tr[t].u1;
+ tr[t].u1 = tr[t].u0;
+ tr[t].u0 = tr[t].usave;
+
+ tr[tr[t].u0].d0 = t;
+ tr[tr[t].u1].d0 = t;
+ tr[tr[tn].u0].d0 = tn;
+ }
+
+ tr[t].usave = tr[tn].usave = 0;
+ }
+ else /* No usave.... simple case */
+ {
+ tr[tn].u0 = tr[t].u1;
+ tr[t].u1 = tr[tn].u1 = -1;
+ tr[tr[tn].u0].d0 = tn;
+ }
+ }
+ else
+ { /* fresh seg. or upward cusp */
+ int tmp_u = tr[t].u0;
+ int td0, td1;
+ if (((td0 = tr[tmp_u].d0) > 0) &&
+ ((td1 = tr[tmp_u].d1) > 0))
+ { /* upward cusp */
+ if ((tr[td0].rseg > 0) &&
+ !is_left_of(tr[td0].rseg, &s.v1))
+ {
+ tr[t].u0 = tr[t].u1 = tr[tn].u1 = -1;
+ tr[tr[tn].u0].d1 = tn;
+ }
+ else /* cusp going leftwards */
+ {
+ tr[tn].u0 = tr[tn].u1 = tr[t].u1 = -1;
+ tr[tr[t].u0].d0 = t;
+ }
+ }
+ else /* fresh segment */
+ {
+ tr[tr[t].u0].d0 = t;
+ tr[tr[t].u0].d1 = tn;
+ }
+ }
+
+ if (FP_EQUAL(tr[t].lo.y, tr[tlast].lo.y) &&
+ FP_EQUAL(tr[t].lo.x, tr[tlast].lo.x) && tribot)
+ { /* bottom forms a triangle */
+
+ if (is_swapped)
+ tmptriseg = seg[segnum].prev;
+ else
+ tmptriseg = seg[segnum].next;
+
+ if ((tmptriseg > 0) && is_left_of(tmptriseg, &s.v0))
+ {
+ /* L-R downward cusp */
+ tr[tr[t].d0].u0 = t;
+ tr[tn].d0 = tr[tn].d1 = -1;
+ }
+ else
+ {
+ /* R-L downward cusp */
+ tr[tr[tn].d0].u1 = tn;
+ tr[t].d0 = tr[t].d1 = -1;
+ }
+ }
+ else
+ {
+ if ((tr[tr[t].d0].u0 > 0) && (tr[tr[t].d0].u1 > 0))
+ {
+ if (tr[tr[t].d0].u0 == t) /* passes thru LHS */
+ {
+ tr[tr[t].d0].usave = tr[tr[t].d0].u1;
+ tr[tr[t].d0].uside = S_LEFT;
+ }
+ else
+ {
+ tr[tr[t].d0].usave = tr[tr[t].d0].u0;
+ tr[tr[t].d0].uside = S_RIGHT;
+ }
+ }
+ tr[tr[t].d0].u0 = t;
+ tr[tr[t].d0].u1 = tn;
+ }
+
+ t = tr[t].d0;
+ }
+
+
+ else if ((tr[t].d0 <= 0) && (tr[t].d1 > 0))
+ { /* Only one trapezoid below */
+ if ((tr[t].u0 > 0) && (tr[t].u1 > 0))
+ { /* continuation of a chain from abv. */
+ if (tr[t].usave > 0) /* three upper neighbours */
+ {
+ if (tr[t].uside == S_LEFT)
+ {
+ tr[tn].u0 = tr[t].u1;
+ tr[t].u1 = -1;
+ tr[tn].u1 = tr[t].usave;
+
+ tr[tr[t].u0].d0 = t;
+ tr[tr[tn].u0].d0 = tn;
+ tr[tr[tn].u1].d0 = tn;
+ }
+ else /* intersects in the right */
+ {
+ tr[tn].u1 = -1;
+ tr[tn].u0 = tr[t].u1;
+ tr[t].u1 = tr[t].u0;
+ tr[t].u0 = tr[t].usave;
+
+ tr[tr[t].u0].d0 = t;
+ tr[tr[t].u1].d0 = t;
+ tr[tr[tn].u0].d0 = tn;
+ }
+
+ tr[t].usave = tr[tn].usave = 0;
+ }
+ else /* No usave.... simple case */
+ {
+ tr[tn].u0 = tr[t].u1;
+ tr[t].u1 = tr[tn].u1 = -1;
+ tr[tr[tn].u0].d0 = tn;
+ }
+ }
+ else
+ { /* fresh seg. or upward cusp */
+ int tmp_u = tr[t].u0;
+ int td0, td1;
+ if (((td0 = tr[tmp_u].d0) > 0) &&
+ ((td1 = tr[tmp_u].d1) > 0))
+ { /* upward cusp */
+ if ((tr[td0].rseg > 0) &&
+ !is_left_of(tr[td0].rseg, &s.v1))
+ {
+ tr[t].u0 = tr[t].u1 = tr[tn].u1 = -1;
+ tr[tr[tn].u0].d1 = tn;
+ }
+ else
+ {
+ tr[tn].u0 = tr[tn].u1 = tr[t].u1 = -1;
+ tr[tr[t].u0].d0 = t;
+ }
+ }
+ else /* fresh segment */
+ {
+ tr[tr[t].u0].d0 = t;
+ tr[tr[t].u0].d1 = tn;
+ }
+ }
+
+ if (FP_EQUAL(tr[t].lo.y, tr[tlast].lo.y) &&
+ FP_EQUAL(tr[t].lo.x, tr[tlast].lo.x) && tribot)
+ { /* bottom forms a triangle */
+ if (is_swapped)
+ tmptriseg = seg[segnum].prev;
+ else
+ tmptriseg = seg[segnum].next;
+
+ if ((tmpseg > 0) && is_left_of(tmpseg, &s.v0))
+ {
+ /* L-R downward cusp */
+ tr[tr[t].d1].u0 = t;
+ tr[tn].d0 = tr[tn].d1 = -1;
+ }
+ else
+ {
+ /* R-L downward cusp */
+ tr[tr[tn].d1].u1 = tn;
+ tr[t].d0 = tr[t].d1 = -1;
+ }
+ }
+ else
+ {
+ if ((tr[tr[t].d1].u0 > 0) && (tr[tr[t].d1].u1 > 0))
+ {
+ if (tr[tr[t].d1].u0 == t) /* passes thru LHS */
+ {
+ tr[tr[t].d1].usave = tr[tr[t].d1].u1;
+ tr[tr[t].d1].uside = S_LEFT;
+ }
+ else
+ {
+ tr[tr[t].d1].usave = tr[tr[t].d1].u0;
+ tr[tr[t].d1].uside = S_RIGHT;
+ }
+ }
+ tr[tr[t].d1].u0 = t;
+ tr[tr[t].d1].u1 = tn;
+ }
+
+ t = tr[t].d1;
+ }
+
+ /* two trapezoids below. Find out which one is intersected by */
+ /* this segment and proceed down that one */
+
+ else
+ {
+ tmpseg = tr[tr[t].d0].rseg;
+ double y0, yt;
+ point_t tmppt;
+ int i_d0, i_d1;
+
+ i_d0 = i_d1 = FALSE;
+ if (FP_EQUAL(tr[t].lo.y, s.v0.y))
+ {
+ if (tr[t].lo.x > s.v0.x)
+ i_d0 = TRUE;
+ else
+ i_d1 = TRUE;
+ }
+ else
+ {
+ tmppt.y = y0 = tr[t].lo.y;
+ yt = (y0 - s.v0.y)/(s.v1.y - s.v0.y);
+ tmppt.x = s.v0.x + yt * (s.v1.x - s.v0.x);
+
+ if (_less_than(&tmppt, &tr[t].lo))
+ i_d0 = TRUE;
+ else
+ i_d1 = TRUE;
+ }
+
+ /* check continuity from the top so that the lower-neighbour */
+ /* values are properly filled for the upper trapezoid */
+
+ if ((tr[t].u0 > 0) && (tr[t].u1 > 0))
+ { /* continuation of a chain from abv. */
+ if (tr[t].usave > 0) /* three upper neighbours */
+ {
+ if (tr[t].uside == S_LEFT)
+ {
+ tr[tn].u0 = tr[t].u1;
+ tr[t].u1 = -1;
+ tr[tn].u1 = tr[t].usave;
+
+ tr[tr[t].u0].d0 = t;
+ tr[tr[tn].u0].d0 = tn;
+ tr[tr[tn].u1].d0 = tn;
+ }
+ else /* intersects in the right */
+ {
+ tr[tn].u1 = -1;
+ tr[tn].u0 = tr[t].u1;
+ tr[t].u1 = tr[t].u0;
+ tr[t].u0 = tr[t].usave;
+
+ tr[tr[t].u0].d0 = t;
+ tr[tr[t].u1].d0 = t;
+ tr[tr[tn].u0].d0 = tn;
+ }
+
+ tr[t].usave = tr[tn].usave = 0;
+ }
+ else /* No usave.... simple case */
+ {
+ tr[tn].u0 = tr[t].u1;
+ tr[tn].u1 = -1;
+ tr[t].u1 = -1;
+ tr[tr[tn].u0].d0 = tn;
+ }
+ }
+ else
+ { /* fresh seg. or upward cusp */
+ int tmp_u = tr[t].u0;
+ int td0, td1;
+ if (((td0 = tr[tmp_u].d0) > 0) &&
+ ((td1 = tr[tmp_u].d1) > 0))
+ { /* upward cusp */
+ if ((tr[td0].rseg > 0) &&
+ !is_left_of(tr[td0].rseg, &s.v1))
+ {
+ tr[t].u0 = tr[t].u1 = tr[tn].u1 = -1;
+ tr[tr[tn].u0].d1 = tn;
+ }
+ else
+ {
+ tr[tn].u0 = tr[tn].u1 = tr[t].u1 = -1;
+ tr[tr[t].u0].d0 = t;
+ }
+ }
+ else /* fresh segment */
+ {
+ tr[tr[t].u0].d0 = t;
+ tr[tr[t].u0].d1 = tn;
+ }
+ }
+
+ if (FP_EQUAL(tr[t].lo.y, tr[tlast].lo.y) &&
+ FP_EQUAL(tr[t].lo.x, tr[tlast].lo.x) && tribot)
+ {
+ /* this case arises only at the lowest trapezoid.. i.e.
+ tlast, if the lower endpoint of the segment is
+ already inserted in the structure */
+
+ tr[tr[t].d0].u0 = t;
+ tr[tr[t].d0].u1 = -1;
+ tr[tr[t].d1].u0 = tn;
+ tr[tr[t].d1].u1 = -1;
+
+ tr[tn].d0 = tr[t].d1;
+ tr[t].d1 = tr[tn].d1 = -1;
+
+ tnext = tr[t].d1;
+ }
+ else if (i_d0)
+ /* intersecting d0 */
+ {
+ tr[tr[t].d0].u0 = t;
+ tr[tr[t].d0].u1 = tn;
+ tr[tr[t].d1].u0 = tn;
+ tr[tr[t].d1].u1 = -1;
+
+ /* new code to determine the bottom neighbours of the */
+ /* newly partitioned trapezoid */
+
+ tr[t].d1 = -1;
+
+ tnext = tr[t].d0;
+ }
+ else /* intersecting d1 */
+ {
+ tr[tr[t].d0].u0 = t;
+ tr[tr[t].d0].u1 = -1;
+ tr[tr[t].d1].u0 = t;
+ tr[tr[t].d1].u1 = tn;
+
+ /* new code to determine the bottom neighbours of the */
+ /* newly partitioned trapezoid */
+
+ tr[tn].d0 = tr[t].d1;
+ tr[tn].d1 = -1;
+
+ tnext = tr[t].d1;
+ }
+
+ t = tnext;
+ }
+
+ tr[t_sav].rseg = tr[tn_sav].lseg = segnum;
+ } /* end-while */
+
+ /* Now combine those trapezoids which share common segments. We can */
+ /* use the pointers to the parent to connect these together. This */
+ /* works only because all these new trapezoids have been formed */
+ /* due to splitting by the segment, and hence have only one parent */
+
+ tfirstl = tfirst;
+ tlastl = tlast;
+ merge_trapezoids(segnum, tfirstl, tlastl, S_LEFT);
+ merge_trapezoids(segnum, tfirstr, tlastr, S_RIGHT);
+
+ seg[segnum].is_inserted = TRUE;
+ return 0;
+}
+
+
+/* Update the roots stored for each of the endpoints of the segment.
+ * This is done to speed up the location-query for the endpoint when
+ * the segment is inserted into the trapezoidation subsequently
+ */
+static int find_new_roots(segnum)
+ int segnum;
+{
+ segment_t *s = &seg[segnum];
+
+ if (s->is_inserted)
+ return 0;
+
+ s->root0 = locate_endpoint(&s->v0, &s->v1, s->root0);
+ s->root0 = tr[s->root0].sink;
+
+ s->root1 = locate_endpoint(&s->v1, &s->v0, s->root1);
+ s->root1 = tr[s->root1].sink;
+ return 0;
+}
+
+
+/* Main routine to perform trapezoidation */
+int construct_trapezoids(nseg)
+ int nseg;
+{
+ register int i;
+ int root, h;
+
+ /* Add the first segment and get the query structure and trapezoid */
+ /* list initialised */
+
+ root = init_query_structure(choose_segment());
+
+ for (i = 1; i <= nseg; i++)
+ seg[i].root0 = seg[i].root1 = root;
+
+ for (h = 1; h <= math_logstar_n(nseg); h++)
+ {
+ for (i = math_N(nseg, h -1) + 1; i <= math_N(nseg, h); i++)
+ add_segment(choose_segment());
+
+ /* Find a new root for each of the segment endpoints */
+ for (i = 1; i <= nseg; i++)
+ find_new_roots(i);
+ }
+
+ for (i = math_N(nseg, math_logstar_n(nseg)) + 1; i <= nseg; i++)
+ add_segment(choose_segment());
+
+ return 0;
+}
+
+
+
+
+static int initialise(n)
+ int n;
+{
+ register int i;
+
+ for (i = 1; i <= n; i++)
+ seg[i].is_inserted = FALSE;
+
+ generate_random_ordering(n);
+
+ return 0;
+}
+
+
+/* Input specified as contours.
+ * Outer contour must be anti-clockwise.
+ * All inner contours must be clockwise.
+ *
+ * Every contour is specified by giving all its points in order. No
+ * point shoud be repeated. i.e. if the outer contour is a square,
+ * only the four distinct endpoints shopudl be specified in order.
+ *
+ * ncontours: #contours
+ * cntr: An array describing the number of points in each
+ * contour. Thus, cntr[i] = #points in the i'th contour.
+ * vertices: Input array of vertices. Vertices for each contour
+ * immediately follow those for previous one. Array location
+ * vertices[0] must NOT be used (i.e. i/p starts from
+ * vertices[1] instead. The output triangles are
+ * specified w.r.t. the indices of these vertices.
+ * triangles: Output array to hold triangles.
+ *
+ * Enough space must be allocated for all the arrays before calling
+ * this routine
+ */
+
+
+int triangulate_polygon(ncontours, cntr, vertices, triangles)
+ int ncontours;
+ int cntr[];
+ double **vertices;
+ int **triangles;
+{
+ register int i;
+ int nmonpoly, ccount, npoints, genus;
+ int n;
+
+ memset((void *)seg, 0, sizeof(seg));
+ ccount = 0;
+ i = 1;
+
+ while (ccount < ncontours)
+ {
+ int j;
+ int first, last;
+
+ npoints = cntr[ccount];
+ first = i;
+ last = first + npoints - 1;
+ for (j = 0; j < npoints; j++, i++)
+ {
+ seg[i].v0.x = vertices[i][0];
+ seg[i].v0.y = vertices[i][1];
+
+ if (i == last)
+ {
+ seg[i].next = first;
+ seg[i].prev = i-1;
+ seg[i-1].v1 = seg[i].v0;
+ }
+ else if (i == first)
+ {
+ seg[i].next = i+1;
+ seg[i].prev = last;
+ seg[last].v1 = seg[i].v0;
+ }
+ else
+ {
+ seg[i].prev = i-1;
+ seg[i].next = i+1;
+ seg[i-1].v1 = seg[i].v0;
+ }
+
+ seg[i].is_inserted = FALSE;
+ }
+
+ ccount++;
+ }
+
+ genus = ncontours - 1;
+ n = i-1;
+
+ initialise(n);
+ construct_trapezoids(n);
+ nmonpoly = monotonate_trapezoids(n);
+ triangulate_monotone_polygons(n, nmonpoly, triangles);
+
+ return 0;
+}
+
+
+/* This function returns TRUE or FALSE depending upon whether the
+ * vertex is inside the polygon or not. The polygon must already have
+ * been triangulated before this routine is called.
+ * This routine will always detect all the points belonging to the
+ * set (polygon-area - polygon-boundary). The return value for points
+ * on the boundary is not consistent!!!
+ */
+
+int is_point_inside_polygon(vertex)
+ double vertex[2];
+{
+ point_t v;
+ int trnum, rseg;
+ trap_t *t;
+
+ v.x = vertex[0];
+ v.y = vertex[1];
+
+ trnum = locate_endpoint(&v, &v, 1);
+ t = &tr[trnum];
+
+ if (t->state == ST_INVALID)
+ return FALSE;
+
+ if ((t->lseg <= 0) || (t->rseg <= 0))
+ return FALSE;
+ rseg = t->rseg;
+ return _greater_than_equal_to(&seg[rseg].v1, &seg[rseg].v0);
+}
+
diff --git a/src/triangulate.h b/src/triangulate.h
new file mode 100755
index 0000000..baa3568
--- /dev/null
+++ b/src/triangulate.h
@@ -0,0 +1,170 @@
+#ifndef _triangulate_h
+#define _triangulate_h
+
+#include <sys/types.h>
+#include <stdlib.h>
+#include <stdio.h>
+
+
+typedef struct {
+ double x, y;
+} point_t, vector_t;
+
+
+/* Segment attributes */
+
+typedef struct {
+ point_t v0, v1; /* two endpoints */
+ int is_inserted; /* inserted in trapezoidation yet ? */
+ int root0, root1; /* root nodes in Q */
+ int next; /* Next logical segment */
+ int prev; /* Previous segment */
+} segment_t;
+
+
+/* Trapezoid attributes */
+
+typedef struct {
+ int lseg, rseg; /* two adjoining segments */
+ point_t hi, lo; /* max/min y-values */
+ int u0, u1;
+ int d0, d1;
+ int sink; /* pointer to corresponding in Q */
+ int usave, uside; /* I forgot what this means */
+ int state;
+} trap_t;
+
+
+/* Node attributes for every node in the query structure */
+
+typedef struct {
+ int nodetype; /* Y-node or S-node */
+ int segnum;
+ point_t yval;
+ int trnum;
+ int parent; /* doubly linked DAG */
+ int left, right; /* children */
+} node_t;
+
+
+typedef struct {
+ int vnum;
+ int next; /* Circularly linked list */
+ int prev; /* describing the monotone */
+ int marked; /* polygon */
+} monchain_t;
+
+
+typedef struct {
+ point_t pt;
+ int vnext[4]; /* next vertices for the 4 chains */
+ int vpos[4]; /* position of v in the 4 chains */
+ int nextfree;
+} vertexchain_t;
+
+
+/* Node types */
+
+#define T_X 1
+#define T_Y 2
+#define T_SINK 3
+
+
+#define SEGSIZE 200 /* max# of segments. Determines how */
+ /* many points can be specified as */
+ /* input. If your datasets have large */
+ /* number of points, increase this */
+ /* value accordingly. */
+
+#define QSIZE 8*SEGSIZE /* maximum table sizes */
+#define TRSIZE 4*SEGSIZE /* max# trapezoids */
+
+
+#define TRUE 1
+#define FALSE 0
+
+
+#define FIRSTPT 1 /* checking whether pt. is inserted */
+#define LASTPT 2
+
+
+#define INFINITY 1<<30
+#define C_EPS 1.0e-7 /* tolerance value: Used for making */
+ /* all decisions about collinearity or */
+ /* left/right of segment. Decrease */
+ /* this value if the input points are */
+ /* spaced very close together */
+
+
+#define S_LEFT 1 /* for merge-direction */
+#define S_RIGHT 2
+
+
+#define ST_VALID 1 /* for trapezium state */
+#define ST_INVALID 2
+
+
+#define SP_SIMPLE_LRUP 1 /* for splitting trapezoids */
+#define SP_SIMPLE_LRDN 2
+#define SP_2UP_2DN 3
+#define SP_2UP_LEFT 4
+#define SP_2UP_RIGHT 5
+#define SP_2DN_LEFT 6
+#define SP_2DN_RIGHT 7
+#define SP_NOSPLIT -1
+
+#define TR_FROM_UP 1 /* for traverse-direction */
+#define TR_FROM_DN 2
+
+#define TRI_LHS 1
+#define TRI_RHS 2
+
+
+#define MAX(a, b) (((a) > (b)) ? (a) : (b))
+#define MIN(a, b) (((a) < (b)) ? (a) : (b))
+
+#define CROSS(v0, v1, v2) (((v1).x - (v0).x)*((v2).y - (v0).y) - \
+ ((v1).y - (v0).y)*((v2).x - (v0).x))
+
+#define DOT(v0, v1) ((v0).x * (v1).x + (v0).y * (v1).y)
+
+#define FP_EQUAL(s, t) (fabs(s - t) <= C_EPS)
+
+#define TRUE 1
+#define FALSE 0
+
+
+/* Global variables */
+
+extern node_t qs[QSIZE]; /* Query structure */
+extern trap_t tr[TRSIZE]; /* Trapezoid structure */
+extern segment_t seg[SEGSIZE]; /* Segment table */
+
+
+/* Functions */
+
+extern int triangulate_polygon(int, int *, double**,int**);
+extern int is_point_inside_polygon(double *);
+
+int triangulate_polygon(int, int [], double**, int**);
+
+int testclock(double *,double *,int);
+
+extern int monotonate_trapezoids(int);
+extern int triangulate_monotone_polygons(int, int, int**);
+
+extern int _greater_than(point_t *, point_t *);
+extern int _equal_to(point_t *, point_t *);
+extern int _greater_than_equal_to(point_t *, point_t *);
+extern int _less_than(point_t *, point_t *);
+extern int locate_endpoint(point_t *, point_t *, int);
+extern int construct_trapezoids(int);
+
+extern int generate_random_ordering(int);
+extern int choose_segment(void);
+extern int read_segments(char *, int *);
+extern int math_logstar_n(int);
+extern int math_N(int, int);
+
+#endif /* triangulate_h */
+
diff --git a/src/util.c b/src/util.c
new file mode 100755
index 0000000..c6e6a23
--- /dev/null
+++ b/src/util.c
@@ -0,0 +1,80 @@
+#include "adssub.h"
+#include "triangulate.h"
+
+int triangulate(int *npoly, int *tabpt, int *nptTot,double *vertX, double *vertY, int *ntri,
+double *X1, double *Y1,double *X2, double *Y2,double *X3, double *Y3) {
+ int i,j,k,l;
+ int **triangles;
+ double **vertices;
+ double *x,*y;
+ tabintalloc(&triangles,*ntri,3);
+ taballoc(&vertices,*nptTot+1,2);
+ l=0;
+ for(i=0;i<*npoly;i++) {
+ int npt=tabpt[i];
+ vecalloc(&x,npt+1);
+ vecalloc(&y,npt+1);
+ for(j=1;j<=npt;j++) {
+ k=j+l-1;
+ x[j]=vertX[k];
+ y[j]=vertY[k];
+ }
+ if(i==0) {
+ if(testclock(x,y,npt)) { /*clockwise order*/
+ k=npt;
+ for(j=1;j<=npt;j++) {
+ vertices[j+l][0]=x[k];
+ vertices[j+l][1]=y[k];
+ k--;
+ }
+ }
+ else { /*anti-clockwise order*/
+ for(j=1;j<=npt;j++) {
+ vertices[j+l][0]=x[j];
+ vertices[j+l][1]=y[j];
+ }
+ }
+ }
+ else {
+ if(!testclock(x,y,npt)) { /*anti-clockwise order*/
+ k=npt;
+ for(j=1;j<=npt;j++) {
+ vertices[j+l][0]=x[k];
+ vertices[j+l][1]=y[k];
+ k--;
+ }
+ }
+ else { /*clockwise order*/
+ for(j=1;j<=npt;j++) {
+ vertices[j+l][0]=x[j];
+ vertices[j+l][1]=y[j];
+ }
+ }
+ }
+ l+=npt;
+ freevec(x);
+ freevec(y);
+ }
+
+ /*Test de l'unicite des points*/
+ for(i=2;i<=*nptTot;i++) {
+ for(j=1;j<i;j++) {
+ if((vertices[i][0]==vertices[j][0])&&(vertices[i][1]==vertices[j][1])) {
+ Rprintf("Error : Duplicate input vertices\n");
+ return -1;
+ }
+ }
+ }
+ triangulate_polygon(*npoly,tabpt,vertices,triangles);
+ for(i=0;i<*ntri;i++) {
+ X1[i]=vertices[triangles[i][2]][0];
+ Y1[i]=vertices[triangles[i][2]][1];
+ X2[i]=vertices[triangles[i][1]][0];
+ Y2[i]=vertices[triangles[i][1]][1];
+ X3[i]=vertices[triangles[i][0]][0];
+ Y3[i]=vertices[triangles[i][0]][1];
+ }
+ freeinttab(triangles);
+ freetab(vertices);
+ return 0;
+}
--
GitLab