Skip to content
Snippets Groups Projects
Commit 2f2ebbb7 authored by philippe.verley_ird.fr's avatar philippe.verley_ird.fr
Browse files

In src/*.h cosmetic changes to declare the same way all functions. In fads.R... 

In src/*.h cosmetic changes to declare the same way all functions. In fads.R there was a wrong call to ripley_tr_disq_ic instead of coor_tr_disq_ic. Deleted comments en plot.vads.R that were problematic according to devtools:check() function. Updated DESCRIPTION, NAMESPACE and MD5 files
parent b573bf2b
No related branches found
No related tags found
No related merge requests found
Hide whitespace changes
Inline Side-by-side
DESCRIPTION
+ 5
− 3
View file @ 2f2ebbb7
...@@ -2,10 +2,11 @@ Package: ads ...@@ -2,10 +2,11 @@ Package: ads
Type: Package Type: Package
Title: Spatial point patterns analysis Title: Spatial point patterns analysis
Version: 1.5-3 Version: 1.5-3
Date: 2018-03-28 Date: 2018-03-29
Authors@R: c(person("Raphael", "Pelissier", role=c("aut", "cre"), email="raphael.pelissier@ird.fr"), Authors@R: c(person("Raphael", "Pelissier", role=c("aut"), email="raphael.pelissier@ird.fr"),
person("Francois", "Goreau", role="aut"), person("Francois", "Goreau", role="aut"),
person("Philippe", "Verley", role="ctb")) person("Philippe", "Verley", role=c("ctb", "cre"), email="philippe.verley@ird.fr"))
Author: Raphael Pelissier [aut], Francois Goreau [aut], Philippe Verley [ctb, cre]
Maintainer: Raphael Pelissier <raphael.pelissier@ird.fr> Maintainer: Raphael Pelissier <raphael.pelissier@ird.fr>
Imports: ade4, spatstat Imports: ade4, spatstat
Description: Perform first- and second-order multi-scale analyses derived from Ripley K-function, for univariate, Description: Perform first- and second-order multi-scale analyses derived from Ripley K-function, for univariate,
...@@ -16,3 +17,4 @@ Packaged: 2015-01-13 12:09:18 UTC; root ...@@ -16,3 +17,4 @@ Packaged: 2015-01-13 12:09:18 UTC; root
NeedsCompilation: yes NeedsCompilation: yes
Repository: CRAN Repository: CRAN
Date/Publication: 2015-01-13 14:49:23 Date/Publication: 2015-01-13 14:49:23
RoxygenNote: 6.0.1
MD5
+ 67
− 55
View file @ 2f2ebbb7
2755553481e78a8f5b6ef00d43e983a5 *DESCRIPTION f6aac0fb4ef187df6521cbb2d9ffc9cf R/fads.R
68a58538a504c7cfa73472d87053be45 *INDEX 7a71372e86fd8aadfc770b261cd953ca R/mimetic.R
7478c6d745db573c9d03ebc59bdc969c *NAMESPACE 7603ca1f27dbbaf85b7b2ec19e059d7d R/plot.fads.R
f6aac0fb4ef187df6521cbb2d9ffc9cf *R/fads.R 154b26509aa63d97c2e0cc646e6681a8 R/plot.vads.R
7a71372e86fd8aadfc770b261cd953ca *R/mimetic.R b85a2aa0125801e94f5b4ce8b0f22a12 R/print.fads.R
e87bd01e08a83a7b1c52b2a4a7e5df35 *R/plot.fads.R 1a420e10243f4c0df000ac22e0bab60e R/print.vads.R
95d2bc01bd2779736c826a21c83b62f3 *R/plot.vads.R c4b216a6fb57acb020f5e21682f7ed13 R/spp.R
6317d29d7e9045d55b1a41906e867462 *R/print.fads.R bbb6ddd2e55fabe14c9e9dfcdfc495e7 R/summary.vads.R
d0f79442970e383cf8c3bd1677320b53 *R/print.vads.R c5d76ac2aa5f6fa68c0cfd08f197989e R/swin.R
c4b216a6fb57acb020f5e21682f7ed13 *R/spp.R 318472a4c160e2ac070b5fb390add04e R/triangulate.R
96dada922fee237e190207f544de8ed3 *R/summary.vads.R a322bba8d53aff07f9a8ce9a69c89aef R/util.R
c5d76ac2aa5f6fa68c0cfd08f197989e *R/swin.R 9f002a8b5ed00aaf26b4d7dc2f914f40 R/vads.R
34b15c6ed440f88d868d3ab3b93db3b8 *R/triangulate.R 31fa89b542936dac1031133b12ef530c data/Allogny.rda
a322bba8d53aff07f9a8ce9a69c89aef *R/util.R 5450b84c345240671b3410af7c70bc44 data/BPoirier.rda
f2c452832a53eb1ed6d168b59918d52a *R/vads.R 24fea786746fc897f8918300f2f2c544 data/Couepia.rda
31fa89b542936dac1031133b12ef530c *data/Allogny.rda 674867657e9a3df07b6eced02aa022a1 data/demopat.rda
5450b84c345240671b3410af7c70bc44 *data/BPoirier.rda a014cac4bc9abd4f40123a762939c8ca data/Paracou15.rda
24fea786746fc897f8918300f2f2c544 *data/Couepia.rda 94a8b147b3d2730b0c3869a7e1a2592f man/Allogny.Rd
a014cac4bc9abd4f40123a762939c8ca *data/Paracou15.rda b3c89a3bcb5db0d5fc9e93d8305df8c8 man/area.swin.Rd
674867657e9a3df07b6eced02aa022a1 *data/demopat.rda 1755cf31329228337e0b8039af2b6daf man/BPoirier.Rd
c7cd00087730e79e06e8c0d937d0b1f7 *inst/CITATION d912451f743e11a9fbe50c8a6ef13b15 man/Couepia.Rd
94a8b147b3d2730b0c3869a7e1a2592f *man/Allogny.Rd d7b568c5332aad81bf4fb9f2bd4efed7 man/demopat.Rd
1755cf31329228337e0b8039af2b6daf *man/BPoirier.Rd 9b09cc667ab5d522e4a3a77c8b711159 man/dval.Rd
d912451f743e11a9fbe50c8a6ef13b15 *man/Couepia.Rd cd9ec1a82e0ee4e372e7ebd9c11233e4 man/inside.swin.Rd
4f272a7a2e7528da43c0d2ef8685921b *man/Paracou15.Rd e85df8cba02e1d7ae44b447ef05f0e3f man/internal.Rd
b3c89a3bcb5db0d5fc9e93d8305df8c8 *man/area.swin.Rd 18f7794bc004e9b9599486a725f7da5b man/k12fun.Rd
d7b568c5332aad81bf4fb9f2bd4efed7 *man/demopat.Rd 26a82fbf3be668f7c74dd4f1b9fd93e4 man/k12val.Rd
9b09cc667ab5d522e4a3a77c8b711159 *man/dval.Rd f4c594ec01933acd9d9cae7e797685fe man/kdfun.Rd
cd9ec1a82e0ee4e372e7ebd9c11233e4 *man/inside.swin.Rd aa725a3e6b7183290f7dd758d594810c man/kfun.Rd
e85df8cba02e1d7ae44b447ef05f0e3f *man/internal.Rd ea3edb1e20ecd5aa794f48c9fa5ee0e5 man/kmfun.Rd
18f7794bc004e9b9599486a725f7da5b *man/k12fun.Rd 0e606a71b6ec6f730bdd0d1498834dbc man/kp.fun.Rd
26a82fbf3be668f7c74dd4f1b9fd93e4 *man/k12val.Rd b45ac5f58b213884c5b1d9c79d5d1599 man/kpfun.Rd
f4c594ec01933acd9d9cae7e797685fe *man/kdfun.Rd 500b63ba993de0b1f8a7d7f92765403b man/kpqfun.Rd
aa725a3e6b7183290f7dd758d594810c *man/kfun.Rd d388b950333aad22313c76d82f51c749 man/krfun.Rd
ea3edb1e20ecd5aa794f48c9fa5ee0e5 *man/kmfun.Rd 9970f6e4573f2e241de12d62ab201e23 man/ksfun.Rd
0e606a71b6ec6f730bdd0d1498834dbc *man/kp.fun.Rd d5d294338860db9a406208f219f05f5e man/kval.Rd
500b63ba993de0b1f8a7d7f92765403b *man/kpqfun.Rd 1037e7421f3a50f15fcb07e88dcc260c man/mimetic.Rd
d388b950333aad22313c76d82f51c749 *man/krfun.Rd 4f272a7a2e7528da43c0d2ef8685921b man/Paracou15.Rd
9970f6e4573f2e241de12d62ab201e23 *man/ksfun.Rd 5bff5bb53402d742900fe12ed542877b man/plot.fads.Rd
d5d294338860db9a406208f219f05f5e *man/kval.Rd 7e88d95ac70e452257a939a70f9a1a76 man/plot.spp.Rd
1037e7421f3a50f15fcb07e88dcc260c *man/mimetic.Rd c30babaf1b550ec45fa0f1bd89f967e5 man/plot.vads.Rd
5bff5bb53402d742900fe12ed542877b *man/plot.fads.Rd 2c61afcc548ad6440240664252a645a5 man/spp.Rd
7e88d95ac70e452257a939a70f9a1a76 *man/plot.spp.Rd cfe40689a11ec983e9b9bb4b759aaa26 man/swin.Rd
c30babaf1b550ec45fa0f1bd89f967e5 *man/plot.vads.Rd c04839dd6cd8eb396d512260a23dc7fd man/triangulate.Rd
2c61afcc548ad6440240664252a645a5 *man/spp.Rd f6aac0fb4ef187df6521cbb2d9ffc9cf R/fads.R
cfe40689a11ec983e9b9bb4b759aaa26 *man/swin.Rd 7a71372e86fd8aadfc770b261cd953ca R/mimetic.R
c04839dd6cd8eb396d512260a23dc7fd *man/triangulate.Rd 7603ca1f27dbbaf85b7b2ec19e059d7d R/plot.fads.R
22fae7567dd07dddf2ea00cb023c2be5 *src/Zlibs.c 154b26509aa63d97c2e0cc646e6681a8 R/plot.vads.R
109615f7005a5a6e02b98bcf1a904551 *src/Zlibs.h b85a2aa0125801e94f5b4ce8b0f22a12 R/print.fads.R
3d7a3f0a98ac75ad014cc91fbe2d0579 *src/adssub.c 1a420e10243f4c0df000ac22e0bab60e R/print.vads.R
bd642dbad07c62b2f39fae4c5640f93a *src/adssub.h c4b216a6fb57acb020f5e21682f7ed13 R/spp.R
8a3dad68f1826270eef7ea08e098dfc5 *src/spatstatsub.f bbb6ddd2e55fabe14c9e9dfcdfc495e7 R/summary.vads.R
5aa9f5862ef5b0e8bbcc327021e1489a *src/triangulate.c c5d76ac2aa5f6fa68c0cfd08f197989e R/swin.R
e482b9d18794f53adaed3f2c98edd19a *src/triangulate.h 318472a4c160e2ac070b5fb390add04e R/triangulate.R
fb07aec2cf6396cab654966e2757ab5c *src/util.c a322bba8d53aff07f9a8ce9a69c89aef R/util.R
9f002a8b5ed00aaf26b4d7dc2f914f40 R/vads.R
3d7a3f0a98ac75ad014cc91fbe2d0579 src/adssub.c
bd642dbad07c62b2f39fae4c5640f93a src/adssub.h
8a3dad68f1826270eef7ea08e098dfc5 src/spatstatsub.f
5aa9f5862ef5b0e8bbcc327021e1489a src/triangulate.c
e482b9d18794f53adaed3f2c98edd19a src/triangulate.h
fb07aec2cf6396cab654966e2757ab5c src/util.c
f44e3b71761cdf40a551c450517d20cd src/Zlibs.c
109615f7005a5a6e02b98bcf1a904551 src/Zlibs.h
d9ae8cc82c07551b180991f6d508aedf NAMESPACE
a32d955da46938603fc72e218ce86101 DESCRIPTION
68a58538a504c7cfa73472d87053be45 INDEX
NAMESPACE
+ 2
− 2
View file @ 2f2ebbb7
...@@ -4,8 +4,8 @@ importFrom(spatstat,"border","bounding.box.xy","area.owin") ...@@ -4,8 +4,8 @@ importFrom(spatstat,"border","bounding.box.xy","area.owin")
importFrom("graphics", "abline", "barplot", "layout", "lines", "par", importFrom("graphics", "abline", "barplot", "layout", "lines", "par",
"plot", "plot.default", "points", "polygon", "symbols", "plot", "plot.default", "points", "polygon", "symbols",
"text") "text")
importFrom("stats", "as.dist", "var") importFrom("stats", "as.dist", "var")
importFrom("utils", "read.table", "str") importFrom("utils", "read.table", "str")
# Export all names (should be improved in the future) # Export all names (should be improved in the future)
export( export(
......
R/fads.R
+ 1255
− 1255
View file @ 2f2ebbb7
kfun<-function(p,upto,by,nsim=0,prec=0.01,alpha=0.01) { kfun<-function(p,upto,by,nsim=0,prec=0.01,alpha=0.01) {
# checking for input parameters # checking for input parameters
stopifnot(inherits(p,"spp")) stopifnot(inherits(p,"spp"))
if(p$type!="univariate") if(p$type!="univariate")
warning(paste(p$type,"point pattern has been considered to be univariate\n")) warning(paste(p$type,"point pattern has been considered to be univariate\n"))
stopifnot(is.numeric(upto)) stopifnot(is.numeric(upto))
stopifnot(upto>=1) stopifnot(upto>=1)
stopifnot(is.numeric(by)) stopifnot(is.numeric(by))
stopifnot(by>0) stopifnot(by>0)
r<-seq(by,upto,by) r<-seq(by,upto,by)
tmax<-length(r) tmax<-length(r)
stopifnot(is.numeric(nsim)) stopifnot(is.numeric(nsim))
stopifnot(nsim>=0) stopifnot(nsim>=0)
nsim<-testInteger(nsim) nsim<-testInteger(nsim)
stopifnot(is.numeric(prec)) stopifnot(is.numeric(prec))
stopifnot(prec>=0) stopifnot(prec>=0)
stopifnot(is.numeric(alpha)) stopifnot(is.numeric(alpha))
stopifnot(alpha>=0) stopifnot(alpha>=0)
if(nsim>0) testIC(nsim,alpha) if(nsim>0) testIC(nsim,alpha)
if("rectangle"%in%p$window$type) { if("rectangle"%in%p$window$type) {
cas<-1 cas<-1
xmin<-p$window$xmin xmin<-p$window$xmin
xmax<-p$window$xmax xmax<-p$window$xmax
ymin<-p$window$ymin ymin<-p$window$ymin
ymax<-p$window$ymax ymax<-p$window$ymax
stopifnot(upto<=(0.5*max((xmax-xmin),(ymax-ymin)))) stopifnot(upto<=(0.5*max((xmax-xmin),(ymax-ymin))))
if ("complex"%in%p$window$type) { if ("complex"%in%p$window$type) {
cas<-3 cas<-3
tri<-p$window$triangles tri<-p$window$triangles
nbTri<-nrow(tri) nbTri<-nrow(tri)
} }
} }
else if("circle"%in%p$window$type) { else if("circle"%in%p$window$type) {
cas<-2 cas<-2
x0<-p$window$x0 x0<-p$window$x0
y0<-p$window$y0 y0<-p$window$y0
r0<-p$window$r0 r0<-p$window$r0
stopifnot(upto<=r0) stopifnot(upto<=r0)
if ("complex"%in%p$window$type) { if ("complex"%in%p$window$type) {
cas<-4 cas<-4
tri<-p$window$triangles tri<-p$window$triangles
nbTri<-nrow(tri) nbTri<-nrow(tri)
} }
} }
else else
stop("invalid window type") stop("invalid window type")
intensity<-p$n/area.swin(p$window) intensity<-p$n/area.swin(p$window)
if(cas==1) { #rectangle if(cas==1) { #rectangle
if(nsim==0) { #without CI if(nsim==0) { #without CI
res<-.C("ripley_rect", res<-.C("ripley_rect",
as.integer(p$n),as.double(p$x),as.double(p$y), 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(xmin),as.double(xmax),as.double(ymin),as.double(ymax),
as.integer(tmax),as.double(by), as.integer(tmax),as.double(by),
g=double(tmax),k=double(tmax), g=double(tmax),k=double(tmax),
PACKAGE="ads") PACKAGE="ads")
} }
else { #with CI else { #with CI
res<-.C("ripley_rect_ic", res<-.C("ripley_rect_ic",
as.integer(p$n),as.double(p$x),as.double(p$y), 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.double(xmin),as.double(xmax),as.double(ymin),as.double(ymax),as.double(intensity),
as.integer(tmax),as.double(by), as.integer(tmax),as.double(by),
as.integer(nsim),as.double(prec),as.double(alpha), as.integer(nsim),as.double(prec),as.double(alpha),
g=double(tmax),k=double(tmax), g=double(tmax),k=double(tmax),
gic1=double(tmax),gic2=double(tmax),kic1=double(tmax),kic2=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), gval=double(tmax),kval=double(tmax),lval=double(tmax),nval=double(tmax),
PACKAGE="ads") PACKAGE="ads")
} }
} }
else if(cas==2) { #circle else if(cas==2) { #circle
if(nsim==0) { #without CI if(nsim==0) { #without CI
res<-.C("ripley_disq", res<-.C("ripley_disq",
as.integer(p$n),as.double(p$x),as.double(p$y), as.integer(p$n),as.double(p$x),as.double(p$y),
as.double(x0),as.double(y0),as.double(r0), as.double(x0),as.double(y0),as.double(r0),
as.integer(tmax),as.double(by), as.integer(tmax),as.double(by),
g=double(tmax),k=double(tmax), g=double(tmax),k=double(tmax),
PACKAGE="ads") PACKAGE="ads")
} }
else { #with CI else { #with CI
res<-.C("ripley_disq_ic", res<-.C("ripley_disq_ic",
as.integer(p$n),as.double(p$x),as.double(p$y), 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.double(x0),as.double(y0),as.double(r0),as.double(intensity),
as.integer(tmax),as.double(by), as.integer(tmax),as.double(by),
as.integer(nsim),as.double(prec),as.double(alpha), as.integer(nsim),as.double(prec),as.double(alpha),
g=double(tmax),k=double(tmax), g=double(tmax),k=double(tmax),
gic1=double(tmax),gic2=double(tmax),kic1=double(tmax),kic2=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), gval=double(tmax),kval=double(tmax),lval=double(tmax),nval=double(tmax),
PACKAGE="ads") PACKAGE="ads")
} }
} }
else if(cas==3) { #complex within rectangle else if(cas==3) { #complex within rectangle
if(nsim==0) { #without CI if(nsim==0) { #without CI
res<-.C("ripley_tr_rect", res<-.C("ripley_tr_rect",
as.integer(p$n),as.double(p$x),as.double(p$y), 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(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(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(tmax),as.double(by),
g=double(tmax),k=double(tmax), g=double(tmax),k=double(tmax),
PACKAGE="ads") PACKAGE="ads")
} }
else { #with CI else { #with CI
res<-.C("ripley_tr_rect_ic", res<-.C("ripley_tr_rect_ic",
as.integer(p$n),as.double(p$x),as.double(p$y), 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.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(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(tmax),as.double(by),
as.integer(nsim),as.double(prec),as.double(alpha), as.integer(nsim),as.double(prec),as.double(alpha),
g=double(tmax),k=double(tmax), g=double(tmax),k=double(tmax),
gic1=double(tmax),gic2=double(tmax),kic1=double(tmax),kic2=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), gval=double(tmax),kval=double(tmax),lval=double(tmax),nval=double(tmax),
PACKAGE="ads") PACKAGE="ads")
} }
} }
else if(cas==4) { #complex within circle else if(cas==4) { #complex within circle
if(nsim==0) { #without CI if(nsim==0) { #without CI
res<-.C("ripley_tr_disq", res<-.C("ripley_tr_disq",
as.integer(p$n),as.double(p$x),as.double(p$y), as.integer(p$n),as.double(p$x),as.double(p$y),
as.double(x0),as.double(y0),as.double(r0), 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(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(tmax),as.double(by),
g=double(tmax),k=double(tmax), g=double(tmax),k=double(tmax),
PACKAGE="ads") PACKAGE="ads")
} }
else { #with CI else { #with CI
res<-.C("ripley_tr_disq_ic", res<-.C("ripley_tr_disq_ic",
as.integer(p$n),as.double(p$x),as.double(p$y), 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.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(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(tmax),as.double(by),
as.integer(nsim),as.double(prec),as.double(alpha), as.integer(nsim),as.double(prec),as.double(alpha),
g=double(tmax),k=double(tmax), g=double(tmax),k=double(tmax),
gic1=double(tmax),gic2=double(tmax),kic1=double(tmax),kic2=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), gval=double(tmax),kval=double(tmax),lval=double(tmax),nval=double(tmax),
PACKAGE="ads") PACKAGE="ads")
} }
} }
# formatting results # formatting results
ds<-c(pi,diff(pi*r^2)) ds<-c(pi,diff(pi*r^2))
g<-data.frame(obs=res$g/(intensity*ds),theo=rep(1,tmax)) 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)) n<-data.frame(obs=res$k/(pi*r^2),theo=rep(intensity,tmax))
k<-data.frame(obs=res$k/intensity,theo=pi*r^2) 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)) l<-data.frame(obs=sqrt(res$k/(intensity*pi))-r,theo=rep(0,tmax))
if(nsim>0) { if(nsim>0) {
g<-cbind(g,sup=res$gic1/(intensity*ds),inf=res$gic2/(intensity*ds),pval=res$gval/(nsim+1)) 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)) 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)) 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)) 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() call<-match.call()
res<-list(call=call,r=r,g=g,n=n,k=k,l=l) res<-list(call=call,r=r,g=g,n=n,k=k,l=l)
class(res)<-c("fads","kfun") class(res)<-c("fads","kfun")
return(res) 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) { 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 # checking for input parameters
options( CBoundsCheck = TRUE ) options( CBoundsCheck = TRUE )
# regle les problemes pour 32-bit # regle les problemes pour 32-bit
stopifnot(inherits(p,"spp")) stopifnot(inherits(p,"spp"))
stopifnot(p$type=="multivariate") stopifnot(p$type=="multivariate")
stopifnot(is.numeric(upto)) stopifnot(is.numeric(upto))
stopifnot(upto>=1) stopifnot(upto>=1)
stopifnot(is.numeric(by)) stopifnot(is.numeric(by))
stopifnot(by>0) stopifnot(by>0)
r<-seq(by,upto,by) r<-seq(by,upto,by)
tmax<-length(r) tmax<-length(r)
stopifnot(is.numeric(nsim)) stopifnot(is.numeric(nsim))
stopifnot(nsim>=0) stopifnot(nsim>=0)
nsim<-testInteger(nsim) nsim<-testInteger(nsim)
H0<-H0[1] H0<-H0[1]
stopifnot(H0=="pitor" || H0=="pimim" || H0=="rl") stopifnot(H0=="pitor" || H0=="pimim" || H0=="rl")
if(H0=="rl") H0<-1 if(H0=="rl") H0<-1
else if(H0=="pitor") H0<-2 else if(H0=="pitor") H0<-2
else H0<-3 else H0<-3
stopifnot(is.numeric(prec)) stopifnot(is.numeric(prec))
stopifnot(prec>=0) stopifnot(prec>=0)
stopifnot(is.numeric(alpha)) stopifnot(is.numeric(alpha))
stopifnot(alpha>=0) stopifnot(alpha>=0)
if(nsim>0) testIC(nsim,alpha) if(nsim>0) testIC(nsim,alpha)
if(missing(marks)) if(missing(marks))
marks<-c(1,2) marks<-c(1,2)
stopifnot(length(marks)==2) stopifnot(length(marks)==2)
stopifnot(marks[1]!=marks[2]) stopifnot(marks[1]!=marks[2])
mark1<-marks[1] mark1<-marks[1]
mark2<-marks[2] mark2<-marks[2]
if(is.numeric(mark1)) if(is.numeric(mark1))
mark1<-levels(p$marks)[testInteger(mark1)] mark1<-levels(p$marks)[testInteger(mark1)]
else if(!mark1%in%p$marks) stop(paste("mark \'",mark1,"\' doesn\'t exist",sep="")) else if(!mark1%in%p$marks) stop(paste("mark \'",mark1,"\' doesn\'t exist",sep=""))
if(is.numeric(mark2)) if(is.numeric(mark2))
mark2<-levels(p$marks)[testInteger(mark2)] mark2<-levels(p$marks)[testInteger(mark2)]
else if(!mark2%in%p$marks) stop(paste("mark \'",mark2,"\' doesn\'t exist",sep="")) else if(!mark2%in%p$marks) stop(paste("mark \'",mark2,"\' doesn\'t exist",sep=""))
if("rectangle"%in%p$window$type) { if("rectangle"%in%p$window$type) {
cas<-1 cas<-1
xmin<-p$window$xmin xmin<-p$window$xmin
xmax<-p$window$xmax xmax<-p$window$xmax
ymin<-p$window$ymin ymin<-p$window$ymin
ymax<-p$window$ymax ymax<-p$window$ymax
stopifnot(upto<=(0.5*max((xmax-xmin),(ymax-ymin)))) stopifnot(upto<=(0.5*max((xmax-xmin),(ymax-ymin))))
if ("complex"%in%p$window$type) { if ("complex"%in%p$window$type) {
cas<-3 cas<-3
tri<-p$window$triangles tri<-p$window$triangles
nbTri<-nrow(tri) nbTri<-nrow(tri)
} }
} }
else if("circle"%in%p$window$type) { else if("circle"%in%p$window$type) {
cas<-2 cas<-2
x0<-p$window$x0 x0<-p$window$x0
y0<-p$window$y0 y0<-p$window$y0
r0<-p$window$r0 r0<-p$window$r0
stopifnot(upto<=r0) stopifnot(upto<=r0)
if ("complex"%in%p$window$type) { if ("complex"%in%p$window$type) {
cas<-4 cas<-4
tri<-p$window$triangles tri<-p$window$triangles
nbTri<-nrow(tri) nbTri<-nrow(tri)
} }
} }
else else
stop("invalid window type") stop("invalid window type")
surface<-area.swin(p$window) surface<-area.swin(p$window)
x1<-p$x[p$marks==mark1] x1<-p$x[p$marks==mark1]
y1<-p$y[p$marks==mark1] y1<-p$y[p$marks==mark1]
x2<-p$x[p$marks==mark2] x2<-p$x[p$marks==mark2]
y2<-p$y[p$marks==mark2] y2<-p$y[p$marks==mark2]
nbPts1<-length(x1) nbPts1<-length(x1)
nbPts2<-length(x2) nbPts2<-length(x2)
intensity2<-nbPts2/surface intensity2<-nbPts2/surface
# intensity<-(nbPts1+nbPts2)/surface # intensity<-(nbPts1+nbPts2)/surface
# computing intertype functions # computing intertype functions
if(cas==1) { #rectangle if(cas==1) { #rectangle
if(nsim==0) { #without CI if(nsim==0) { #without CI
res<-.C("intertype_rect", res<-.C("intertype_rect",
as.integer(nbPts1),as.double(x1),as.double(y1), as.integer(nbPts1),as.double(x1),as.double(y1),
as.integer(nbPts2),as.double(x2),as.double(y2), as.integer(nbPts2),as.double(x2),as.double(y2),
as.double(xmin),as.double(xmax),as.double(ymin),as.double(ymax), as.double(xmin),as.double(xmax),as.double(ymin),as.double(ymax),
as.integer(tmax),as.double(by), as.integer(tmax),as.double(by),
g=double(tmax),k=double(tmax), g=double(tmax),k=double(tmax),
PACKAGE="ads") PACKAGE="ads")
} }
else { #with CI else { #with CI
res<-.C("intertype_rect_ic", res<-.C("intertype_rect_ic",
as.integer(nbPts1),as.double(x1),as.double(y1), as.integer(nbPts1),as.double(x1),as.double(y1),
as.integer(nbPts2),as.double(x2),as.double(y2), 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.double(xmin),as.double(xmax),as.double(ymin),as.double(ymax),as.double(surface),
as.integer(tmax),as.double(by), 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), 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), g=double(tmax),k=double(tmax),
gic1=double(tmax),gic2=double(tmax),kic1=double(tmax),kic2=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), gval=double(tmax),kval=double(tmax),lval=double(tmax),nval=double(tmax),
PACKAGE="ads") PACKAGE="ads")
} }
} }
else if(cas==2) { #circle else if(cas==2) { #circle
if(nsim==0) { #without CI if(nsim==0) { #without CI
res<-.C("intertype_disq", res<-.C("intertype_disq",
as.integer(nbPts1),as.double(x1),as.double(y1), as.integer(nbPts1),as.double(x1),as.double(y1),
as.integer(nbPts2),as.double(x2),as.double(y2), as.integer(nbPts2),as.double(x2),as.double(y2),
as.double(x0),as.double(y0),as.double(r0), as.double(x0),as.double(y0),as.double(r0),
as.integer(tmax),as.double(by), as.integer(tmax),as.double(by),
g=double(tmax),k=double(tmax), g=double(tmax),k=double(tmax),
PACKAGE="ads") PACKAGE="ads")
} }
else { #with CI else { #with CI
res<-.C("intertype_disq_ic", res<-.C("intertype_disq_ic",
as.integer(nbPts1),as.double(x1),as.double(y1), as.integer(nbPts1),as.double(x1),as.double(y1),
as.integer(nbPts2),as.double(x2),as.double(y2), as.integer(nbPts2),as.double(x2),as.double(y2),
as.double(x0),as.double(y0),as.double(r0),as.double(surface), as.double(x0),as.double(y0),as.double(r0),as.double(surface),
as.integer(tmax),as.double(by), 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), 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), g=double(tmax),k=double(tmax),
gic1=double(tmax),gic2=double(tmax),kic1=double(tmax),kic2=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), gval=double(tmax),kval=double(tmax),lval=double(tmax),nval=double(tmax),
PACKAGE="ads") PACKAGE="ads")
} }
} }
else if(cas==3) { #complex within rectangle else if(cas==3) { #complex within rectangle
if(nsim==0) { #without CI if(nsim==0) { #without CI
res<-.C("intertype_tr_rect", res<-.C("intertype_tr_rect",
as.integer(nbPts1),as.double(x1),as.double(y1), as.integer(nbPts1),as.double(x1),as.double(y1),
as.integer(nbPts2),as.double(x2),as.double(y2), as.integer(nbPts2),as.double(x2),as.double(y2),
as.double(xmin),as.double(xmax),as.double(ymin),as.double(ymax), 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(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(tmax),as.double(by),
g=double(tmax),k=double(tmax), g=double(tmax),k=double(tmax),
PACKAGE="ads") PACKAGE="ads")
} }
else { #with CI else { #with CI
res<-.C("intertype_tr_rect_ic", res<-.C("intertype_tr_rect_ic",
as.integer(nbPts1),as.double(x1),as.double(y1), as.integer(nbPts1),as.double(x1),as.double(y1),
as.integer(nbPts2),as.double(x2),as.double(y2), 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.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(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(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), 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), g=double(tmax),k=double(tmax),
gic1=double(tmax),gic2=double(tmax),kic1=double(tmax),kic2=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), gval=double(tmax),kval=double(tmax),lval=double(tmax),nval=double(tmax),
PACKAGE="ads") PACKAGE="ads")
} }
} }
else if(cas==4) { #complex within circle else if(cas==4) { #complex within circle
if(nsim==0) { #without CI if(nsim==0) { #without CI
res<-.C("intertype_tr_disq", res<-.C("intertype_tr_disq",
as.integer(nbPts1),as.double(x1),as.double(y1), as.integer(nbPts1),as.double(x1),as.double(y1),
as.integer(nbPts2),as.double(x2),as.double(y2), as.integer(nbPts2),as.double(x2),as.double(y2),
as.double(x0),as.double(y0),as.double(r0), 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(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(tmax),as.double(by),
g=double(tmax),k=double(tmax), g=double(tmax),k=double(tmax),
PACKAGE="ads") PACKAGE="ads")
} }
else { #with CI else { #with CI
res<-.C("intertype_tr_disq_ic", res<-.C("intertype_tr_disq_ic",
as.integer(nbPts1),as.double(x1),as.double(y1), as.integer(nbPts1),as.double(x1),as.double(y1),
as.integer(nbPts2),as.double(x2),as.double(y2), as.integer(nbPts2),as.double(x2),as.double(y2),
as.double(x0),as.double(y0),as.double(r0),as.double(surface), 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(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(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), 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), g=double(tmax),k=double(tmax),
gic1=double(tmax),gic2=double(tmax),kic1=double(tmax),kic2=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), gval=double(tmax),kval=double(tmax),lval=double(tmax),nval=double(tmax),
PACKAGE="ads") PACKAGE="ads")
} }
} }
# formatting results # formatting results
ds<-c(pi,diff(pi*r^2)) ds<-c(pi,diff(pi*r^2))
g<-res$g/(intensity2*ds) g<-res$g/(intensity2*ds)
n<-res$k/(pi*r^2) n<-res$k/(pi*r^2)
k<-res$k/intensity2 k<-res$k/intensity2
l<-sqrt(res$k/(intensity2*pi))-r l<-sqrt(res$k/(intensity2*pi))-r
if(H0==1) { if(H0==1) {
rip<-kfun(spp(c(x1,x2),c(y1,y2),p$window),upto,by) 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) 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) else if (H0==2||H0==3)
theo<-list(g=rep(1,tmax),n=rep(intensity2,tmax),k=pi*r^2,l=rep(0,tmax)) 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) g<-data.frame(obs=g,theo=theo$g)
n<-data.frame(obs=n,theo=theo$n) n<-data.frame(obs=n,theo=theo$n)
k<-data.frame(obs=k,theo=theo$k) k<-data.frame(obs=k,theo=theo$k)
l<-data.frame(obs=l,theo=theo$l) l<-data.frame(obs=l,theo=theo$l)
if(nsim>0) { if(nsim>0) {
g<-cbind(g,sup=res$gic1/(intensity2*ds),inf=res$gic2/(intensity2*ds),pval=res$gval/(nsim+1)) 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)) 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)) 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)) 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() call<-match.call()
res<-list(call=call,r=r,g12=g,n12=n,k12=k,l12=l,marks=c(mark1,mark2)) res<-list(call=call,r=r,g12=g,n12=n,k12=k,l12=l,marks=c(mark1,mark2))
class(res)<-c("fads","k12fun") class(res)<-c("fads","k12fun")
return(res) return(res)
} }
kijfun<-kpqfun<-function(p,upto,by) { kijfun<-kpqfun<-function(p,upto,by) {
# checking for input parameters # checking for input parameters
stopifnot(inherits(p,"spp")) stopifnot(inherits(p,"spp"))
stopifnot(p$type=="multivariate") stopifnot(p$type=="multivariate")
stopifnot(is.numeric(upto)) stopifnot(is.numeric(upto))
stopifnot(upto>=1) stopifnot(upto>=1)
stopifnot(is.numeric(by)) stopifnot(is.numeric(by))
stopifnot(by>0) stopifnot(by>0)
r<-seq(by,upto,by) r<-seq(by,upto,by)
tmax<-length(r) tmax<-length(r)
if("rectangle"%in%p$window$type) { if("rectangle"%in%p$window$type) {
cas<-1 cas<-1
xmin<-p$window$xmin xmin<-p$window$xmin
xmax<-p$window$xmax xmax<-p$window$xmax
ymin<-p$window$ymin ymin<-p$window$ymin
ymax<-p$window$ymax ymax<-p$window$ymax
stopifnot(upto<=(0.5*max((xmax-xmin),(ymax-ymin)))) stopifnot(upto<=(0.5*max((xmax-xmin),(ymax-ymin))))
if ("complex"%in%p$window$type) { if ("complex"%in%p$window$type) {
cas<-3 cas<-3
tri<-p$window$triangles tri<-p$window$triangles
nbTri<-nrow(tri) nbTri<-nrow(tri)
} }
} }
else if("circle"%in%p$window$type) { else if("circle"%in%p$window$type) {
cas<-2 cas<-2
x0<-p$window$x0 x0<-p$window$x0
y0<-p$window$y0 y0<-p$window$y0
r0<-p$window$r0 r0<-p$window$r0
stopifnot(upto<=r0) stopifnot(upto<=r0)
if ("complex"%in%p$window$type) { if ("complex"%in%p$window$type) {
cas<-4 cas<-4
tri<-p$window$triangles tri<-p$window$triangles
nbTri<-nrow(tri) nbTri<-nrow(tri)
} }
} }
else else
stop("invalid window type") stop("invalid window type")
surface<-area.swin(p$window) surface<-area.swin(p$window)
tabMarks<-levels(p$marks) tabMarks<-levels(p$marks)
nbMarks<-length(tabMarks) nbMarks<-length(tabMarks)
mpt_nb<-summary(p$marks) mpt_nb<-summary(p$marks)
# computing RipleyClass # computing RipleyClass
gij<-double(tmax*nbMarks^2) gij<-double(tmax*nbMarks^2)
kij<-double(tmax*nbMarks^2) kij<-double(tmax*nbMarks^2)
lij<-double(tmax*nbMarks^2) lij<-double(tmax*nbMarks^2)
nij<-double(tmax*nbMarks^2) nij<-double(tmax*nbMarks^2)
for(i in 1:nbMarks) { for(i in 1:nbMarks) {
x1<-p$x[p$marks==tabMarks[i]] x1<-p$x[p$marks==tabMarks[i]]
y1<-p$y[p$marks==tabMarks[i]] y1<-p$y[p$marks==tabMarks[i]]
if(cas==1) { #rectangle if(cas==1) { #rectangle
res<-.C("ripley_rect", res<-.C("ripley_rect",
as.integer(mpt_nb[i]),as.double(x1),as.double(y1), as.integer(mpt_nb[i]),as.double(x1),as.double(y1),
as.double(xmin),as.double(xmax),as.double(ymin),as.double(ymax), as.double(xmin),as.double(xmax),as.double(ymin),as.double(ymax),
as.integer(tmax),as.double(by), as.integer(tmax),as.double(by),
g=double(tmax),k=double(tmax), g=double(tmax),k=double(tmax),
PACKAGE="ads") PACKAGE="ads")
} }
else if(cas==2) { #circle else if(cas==2) { #circle
res<-.C("ripley_disq", res<-.C("ripley_disq",
as.integer(mpt_nb[i]),as.double(x1),as.double(y1), as.integer(mpt_nb[i]),as.double(x1),as.double(y1),
as.double(x0),as.double(y0),as.double(r0), as.double(x0),as.double(y0),as.double(r0),
as.integer(tmax),as.double(by), as.integer(tmax),as.double(by),
g=double(tmax),k=double(tmax), g=double(tmax),k=double(tmax),
PACKAGE="ads") PACKAGE="ads")
} }
else if(cas==3) { #complex within rectangle else if(cas==3) { #complex within rectangle
res<-.C("ripley_tr_rect", res<-.C("ripley_tr_rect",
as.integer(mpt_nb[i]),as.double(x1),as.double(y1), as.integer(mpt_nb[i]),as.double(x1),as.double(y1),
as.double(xmin),as.double(xmax),as.double(ymin),as.double(ymax), 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(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(tmax),as.double(by),
g=double(tmax),k=double(tmax), g=double(tmax),k=double(tmax),
PACKAGE="ads") PACKAGE="ads")
} }
else if(cas==4) { #complex within circle else if(cas==4) { #complex within circle
res<-.C("ripley_tr_disq", res<-.C("ripley_tr_disq",
as.integer(mpt_nb[i]),as.double(x1),as.double(y1), as.integer(mpt_nb[i]),as.double(x1),as.double(y1),
as.double(x0),as.double(y0),as.double(r0), 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(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(tmax),as.double(by),
g=double(tmax),k=double(tmax), g=double(tmax),k=double(tmax),
PACKAGE="ads") PACKAGE="ads")
} }
intensity1<-mpt_nb[i]/surface intensity1<-mpt_nb[i]/surface
matcol<-(i-1)*nbMarks+i-1 matcol<-(i-1)*nbMarks+i-1
j<-(matcol*tmax+1):(matcol*tmax+tmax) j<-(matcol*tmax+1):(matcol*tmax+tmax)
ds<-c(pi,diff(pi*r^2)) ds<-c(pi,diff(pi*r^2))
gij[j]<-res$g/(intensity1*ds) gij[j]<-res$g/(intensity1*ds)
nij[j]<-res$k/(pi*r^2) nij[j]<-res$k/(pi*r^2)
kij[j]<-res$k/intensity1 kij[j]<-res$k/intensity1
lij[j]<-sqrt(res$k/(intensity1*pi))-r lij[j]<-sqrt(res$k/(intensity1*pi))-r
if(i<nbMarks) { if(i<nbMarks) {
for(j in (i+1):nbMarks) { for(j in (i+1):nbMarks) {
x2<-p$x[p$marks==tabMarks[j]] x2<-p$x[p$marks==tabMarks[j]]
y2<-p$y[p$marks==tabMarks[j]] y2<-p$y[p$marks==tabMarks[j]]
if(cas==1) { #rectangle if(cas==1) { #rectangle
res<-.C("intertype_rect", res<-.C("intertype_rect",
as.integer(mpt_nb[i]),as.double(x1),as.double(y1), as.integer(mpt_nb[i]),as.double(x1),as.double(y1),
as.integer(mpt_nb[j]),as.double(x2),as.double(y2), as.integer(mpt_nb[j]),as.double(x2),as.double(y2),
as.double(xmin),as.double(xmax),as.double(ymin),as.double(ymax), as.double(xmin),as.double(xmax),as.double(ymin),as.double(ymax),
as.integer(tmax),as.double(by), as.integer(tmax),as.double(by),
g=double(tmax),k=double(tmax), g=double(tmax),k=double(tmax),
PACKAGE="ads") PACKAGE="ads")
} }
else if(cas==2) { #circle else if(cas==2) { #circle
res<-.C("intertype_disq", res<-.C("intertype_disq",
as.integer(mpt_nb[i]),as.double(x1),as.double(y1), as.integer(mpt_nb[i]),as.double(x1),as.double(y1),
as.integer(mpt_nb[j]),as.double(x2),as.double(y2), as.integer(mpt_nb[j]),as.double(x2),as.double(y2),
as.double(x0),as.double(y0),as.double(r0), as.double(x0),as.double(y0),as.double(r0),
as.integer(tmax),as.double(by), as.integer(tmax),as.double(by),
g=double(tmax),k=double(tmax), g=double(tmax),k=double(tmax),
PACKAGE="ads") PACKAGE="ads")
} }
else if(cas==3) { #complex within rectangle else if(cas==3) { #complex within rectangle
res<-.C("intertype_tr_rect", res<-.C("intertype_tr_rect",
as.integer(mpt_nb[i]),as.double(x1),as.double(y1), as.integer(mpt_nb[i]),as.double(x1),as.double(y1),
as.integer(mpt_nb[j]),as.double(x2),as.double(y2), as.integer(mpt_nb[j]),as.double(x2),as.double(y2),
as.double(xmin),as.double(xmax),as.double(ymin),as.double(ymax), 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(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(tmax),as.double(by),
g=double(tmax),k=double(tmax), g=double(tmax),k=double(tmax),
PACKAGE="ads") PACKAGE="ads")
} }
else if(cas==4) { #complex within circle else if(cas==4) { #complex within circle
res<-.C("intertype_tr_disq", res<-.C("intertype_tr_disq",
as.integer(mpt_nb[i]),as.double(x1),as.double(y1), as.integer(mpt_nb[i]),as.double(x1),as.double(y1),
as.integer(mpt_nb[j]),as.double(x2),as.double(y2), as.integer(mpt_nb[j]),as.double(x2),as.double(y2),
as.double(x0),as.double(y0),as.double(r0), 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(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(tmax),as.double(by),
g=double(tmax),k=double(tmax), g=double(tmax),k=double(tmax),
PACKAGE="ads") PACKAGE="ads")
} }
intensity2<-mpt_nb[j]/surface intensity2<-mpt_nb[j]/surface
matcol<-(i-1)*nbMarks+j-1 matcol<-(i-1)*nbMarks+j-1
k<-(matcol*tmax+1):(matcol*tmax+tmax) k<-(matcol*tmax+1):(matcol*tmax+tmax)
gij[k]<-res$g/(intensity2*ds) gij[k]<-res$g/(intensity2*ds)
nij[k]<-res$k/(pi*r^2) nij[k]<-res$k/(pi*r^2)
kij[k]<-res$k/intensity2 kij[k]<-res$k/intensity2
lij[k]<-sqrt(res$k/(intensity2*pi))-r lij[k]<-sqrt(res$k/(intensity2*pi))-r
if(cas==1) { #rectangle if(cas==1) { #rectangle
res<-.C("intertype_rect", res<-.C("intertype_rect",
as.integer(mpt_nb[j]),as.double(x2),as.double(y2), as.integer(mpt_nb[j]),as.double(x2),as.double(y2),
as.integer(mpt_nb[i]),as.double(x1),as.double(y1), as.integer(mpt_nb[i]),as.double(x1),as.double(y1),
as.double(xmin),as.double(xmax),as.double(ymin),as.double(ymax), as.double(xmin),as.double(xmax),as.double(ymin),as.double(ymax),
as.integer(tmax),as.double(by), as.integer(tmax),as.double(by),
g=double(tmax),k=double(tmax), g=double(tmax),k=double(tmax),
PACKAGE="ads") PACKAGE="ads")
} }
else if(cas==2) { #circle else if(cas==2) { #circle
res<-.C("intertype_disq", res<-.C("intertype_disq",
as.integer(mpt_nb[j]),as.double(x2),as.double(y2), as.integer(mpt_nb[j]),as.double(x2),as.double(y2),
as.integer(mpt_nb[i]),as.double(x1),as.double(y1), as.integer(mpt_nb[i]),as.double(x1),as.double(y1),
as.double(x0),as.double(y0),as.double(r0), as.double(x0),as.double(y0),as.double(r0),
as.integer(tmax),as.double(by), as.integer(tmax),as.double(by),
g=double(tmax),k=double(tmax), g=double(tmax),k=double(tmax),
PACKAGE="ads") PACKAGE="ads")
} }
else if(cas==3) { #complex within rectangle else if(cas==3) { #complex within rectangle
res<-.C("intertype_tr_rect", res<-.C("intertype_tr_rect",
as.integer(mpt_nb[j]),as.double(x2),as.double(y2), as.integer(mpt_nb[j]),as.double(x2),as.double(y2),
as.integer(mpt_nb[i]),as.double(x1),as.double(y1), as.integer(mpt_nb[i]),as.double(x1),as.double(y1),
as.double(xmin),as.double(xmax),as.double(ymin),as.double(ymax), 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(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(tmax),as.double(by),
g=double(tmax),k=double(tmax), g=double(tmax),k=double(tmax),
PACKAGE="ads") PACKAGE="ads")
} }
else if(cas==4) { #complex within circle else if(cas==4) { #complex within circle
res<-.C("intertype_tr_disq", res<-.C("intertype_tr_disq",
as.integer(mpt_nb[j]),as.double(x2),as.double(y2), as.integer(mpt_nb[j]),as.double(x2),as.double(y2),
as.integer(mpt_nb[i]),as.double(x1),as.double(y1), as.integer(mpt_nb[i]),as.double(x1),as.double(y1),
as.double(x0),as.double(y0),as.double(r0), 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(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(tmax),as.double(by),
g=double(tmax),k=double(tmax), g=double(tmax),k=double(tmax),
PACKAGE="ads") PACKAGE="ads")
} }
matcol<-(j-1)*nbMarks+i-1 matcol<-(j-1)*nbMarks+i-1
k<-(matcol*tmax+1):(matcol*tmax+tmax) k<-(matcol*tmax+1):(matcol*tmax+tmax)
gij[k]<-res$g/(intensity1*ds) gij[k]<-res$g/(intensity1*ds)
nij[k]<-res$k/(pi*r^2) nij[k]<-res$k/(pi*r^2)
kij[k]<-res$k/intensity1 kij[k]<-res$k/intensity1
lij[k]<-sqrt(res$k/(intensity1*pi))-r lij[k]<-sqrt(res$k/(intensity1*pi))-r
} }
} }
} }
labij<-paste(rep(tabMarks,each=nbMarks),rep(tabMarks,nbMarks),sep="-") labij<-paste(rep(tabMarks,each=nbMarks),rep(tabMarks,nbMarks),sep="-")
gij<-matrix(gij,nrow=tmax,ncol=nbMarks^2) gij<-matrix(gij,nrow=tmax,ncol=nbMarks^2)
kij<-matrix(kij,nrow=tmax,ncol=nbMarks^2) kij<-matrix(kij,nrow=tmax,ncol=nbMarks^2)
nij<-matrix(nij,nrow=tmax,ncol=nbMarks^2) nij<-matrix(nij,nrow=tmax,ncol=nbMarks^2)
lij<-matrix(lij,nrow=tmax,ncol=nbMarks^2) lij<-matrix(lij,nrow=tmax,ncol=nbMarks^2)
call<-match.call() call<-match.call()
res<-list(call=call,r=r,labpq=labij,gij=gij,kpq=kij,lpq=lij,npq=nij,intensity=summary(p)$intensity) 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") class(res)<-c("fads","kpqfun")
return(res) return(res)
} }
ki.fun<-kp.fun<-function(p,upto,by) { ki.fun<-kp.fun<-function(p,upto,by) {
# checking for input parameters # checking for input parameters
stopifnot(inherits(p,"spp")) stopifnot(inherits(p,"spp"))
stopifnot(p$type=="multivariate") stopifnot(p$type=="multivariate")
stopifnot(is.numeric(upto)) stopifnot(is.numeric(upto))
stopifnot(upto>=1) stopifnot(upto>=1)
stopifnot(is.numeric(by)) stopifnot(is.numeric(by))
stopifnot(by>0) stopifnot(by>0)
r<-seq(by,upto,by) r<-seq(by,upto,by)
tmax<-length(r) tmax<-length(r)
if("rectangle"%in%p$window$type) { if("rectangle"%in%p$window$type) {
cas<-1 cas<-1
xmin<-p$window$xmin xmin<-p$window$xmin
xmax<-p$window$xmax xmax<-p$window$xmax
ymin<-p$window$ymin ymin<-p$window$ymin
ymax<-p$window$ymax ymax<-p$window$ymax
stopifnot(upto<=(0.5*max((xmax-xmin),(ymax-ymin)))) stopifnot(upto<=(0.5*max((xmax-xmin),(ymax-ymin))))
if ("complex"%in%p$window$type) { if ("complex"%in%p$window$type) {
cas<-3 cas<-3
tri<-p$window$triangles tri<-p$window$triangles
nbTri<-nrow(tri) nbTri<-nrow(tri)
} }
} }
else if("circle"%in%p$window$type) { else if("circle"%in%p$window$type) {
cas<-2 cas<-2
x0<-p$window$x0 x0<-p$window$x0
y0<-p$window$y0 y0<-p$window$y0
r0<-p$window$r0 r0<-p$window$r0
stopifnot(upto<=r0) stopifnot(upto<=r0)
if ("complex"%in%p$window$type) { if ("complex"%in%p$window$type) {
cas<-4 cas<-4
tri<-p$window$triangles tri<-p$window$triangles
nbTri<-nrow(tri) nbTri<-nrow(tri)
} }
} }
else else
stop("invalid window type") stop("invalid window type")
surface<-area.swin(p$window) surface<-area.swin(p$window)
tabMarks<-levels(p$marks) tabMarks<-levels(p$marks)
nbMarks<-length(tabMarks) nbMarks<-length(tabMarks)
mpt_nb<-summary(p$marks) mpt_nb<-summary(p$marks)
#computing RipleyAll #computing RipleyAll
gis<-double(tmax*nbMarks) gis<-double(tmax*nbMarks)
kis<-double(tmax*nbMarks) kis<-double(tmax*nbMarks)
lis<-double(tmax*nbMarks) lis<-double(tmax*nbMarks)
nis<-double(tmax*nbMarks) nis<-double(tmax*nbMarks)
for(i in 1:nbMarks) { for(i in 1:nbMarks) {
x1<-p$x[p$marks==tabMarks[i]] x1<-p$x[p$marks==tabMarks[i]]
y1<-p$y[p$marks==tabMarks[i]] y1<-p$y[p$marks==tabMarks[i]]
x2<-p$x[p$marks!=tabMarks[i]] x2<-p$x[p$marks!=tabMarks[i]]
y2<-p$y[p$marks!=tabMarks[i]] y2<-p$y[p$marks!=tabMarks[i]]
nbPts1<-mpt_nb[i] nbPts1<-mpt_nb[i]
nbPts2<-sum(mpt_nb)-nbPts1 nbPts2<-sum(mpt_nb)-nbPts1
if(cas==1) { #rectangle if(cas==1) { #rectangle
res<-.C("intertype_rect", res<-.C("intertype_rect",
as.integer(nbPts1),as.double(x1),as.double(y1), as.integer(nbPts1),as.double(x1),as.double(y1),
as.integer(nbPts2),as.double(x2),as.double(y2), as.integer(nbPts2),as.double(x2),as.double(y2),
as.double(xmin),as.double(xmax),as.double(ymin),as.double(ymax), as.double(xmin),as.double(xmax),as.double(ymin),as.double(ymax),
as.integer(tmax),as.double(by), as.integer(tmax),as.double(by),
g=double(tmax),k=double(tmax), g=double(tmax),k=double(tmax),
PACKAGE="ads") PACKAGE="ads")
} }
else if(cas==2) { #circle else if(cas==2) { #circle
res<-.C("intertype_disq", res<-.C("intertype_disq",
as.integer(nbPts1),as.double(x1),as.double(y1), as.integer(nbPts1),as.double(x1),as.double(y1),
as.integer(nbPts2),as.double(x2),as.double(y2), as.integer(nbPts2),as.double(x2),as.double(y2),
as.double(x0),as.double(y0),as.double(r0), as.double(x0),as.double(y0),as.double(r0),
as.integer(tmax),as.double(by), as.integer(tmax),as.double(by),
g=double(tmax),k=double(tmax), g=double(tmax),k=double(tmax),
PACKAGE="ads") PACKAGE="ads")
} }
else if(cas==3) { #complex within rectangle else if(cas==3) { #complex within rectangle
res<-.C("intertype_tr_rect", res<-.C("intertype_tr_rect",
as.integer(nbPts1),as.double(x1),as.double(y1), as.integer(nbPts1),as.double(x1),as.double(y1),
as.integer(nbPts2),as.double(x2),as.double(y2), as.integer(nbPts2),as.double(x2),as.double(y2),
as.double(xmin),as.double(xmax),as.double(ymin),as.double(ymax), 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(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(tmax),as.double(by),
g=double(tmax),k=double(tmax), g=double(tmax),k=double(tmax),
PACKAGE="ads") PACKAGE="ads")
} }
else if(cas==4) { #complex within circle else if(cas==4) { #complex within circle
res<-.C("intertype_tr_disq", res<-.C("intertype_tr_disq",
as.integer(nbPts1),as.double(x1),as.double(y1), as.integer(nbPts1),as.double(x1),as.double(y1),
as.integer(nbPts2),as.double(x2),as.double(y2), as.integer(nbPts2),as.double(x2),as.double(y2),
as.double(x0),as.double(y0),as.double(r0), 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(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(tmax),as.double(by),
g=double(tmax),k=double(tmax), g=double(tmax),k=double(tmax),
PACKAGE="ads") PACKAGE="ads")
} }
intensity2<-nbPts2/surface intensity2<-nbPts2/surface
j<-((i-1)*tmax+1):((i-1)*tmax+tmax) j<-((i-1)*tmax+1):((i-1)*tmax+tmax)
ds<-c(pi,diff(pi*r^2)) ds<-c(pi,diff(pi*r^2))
gis[j]<-res$g/(intensity2*ds) gis[j]<-res$g/(intensity2*ds)
nis[j]<-res$k/(pi*r^2) nis[j]<-res$k/(pi*r^2)
kis[j]<-res$k/intensity2 kis[j]<-res$k/intensity2
lis[j]<-sqrt(res$k/(intensity2*pi))-r lis[j]<-sqrt(res$k/(intensity2*pi))-r
} }
# formatting results # formatting results
labi<-tabMarks labi<-tabMarks
gis<-matrix(gis,nrow=tmax,ncol=nbMarks) gis<-matrix(gis,nrow=tmax,ncol=nbMarks)
kis<-matrix(kis,nrow=tmax,ncol=nbMarks) kis<-matrix(kis,nrow=tmax,ncol=nbMarks)
nis<-matrix(nis,nrow=tmax,ncol=nbMarks) nis<-matrix(nis,nrow=tmax,ncol=nbMarks)
lis<-matrix(lis,nrow=tmax,ncol=nbMarks) lis<-matrix(lis,nrow=tmax,ncol=nbMarks)
call<-match.call() call<-match.call()
res<-list(call=call,r=r,labp=labi,gp.=gis,kp.=kis,lp.=lis,np.=nis,intensity=summary(p)$intensity) 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") class(res)<-c("fads","kp.fun")
return(res) return(res)
} }
kmfun<-function(p,upto,by,nsim=0,alpha=0.01) { kmfun<-function(p,upto,by,nsim=0,alpha=0.01) {
# checking for input parameters # checking for input parameters
stopifnot(inherits(p,"spp")) stopifnot(inherits(p,"spp"))
stopifnot(p$type=="marked") stopifnot(p$type=="marked")
stopifnot(is.numeric(upto)) stopifnot(is.numeric(upto))
stopifnot(upto>=1) stopifnot(upto>=1)
stopifnot(is.numeric(by)) stopifnot(is.numeric(by))
stopifnot(by>0) stopifnot(by>0)
r<-seq(by,upto,by) r<-seq(by,upto,by)
tmax<-length(r) tmax<-length(r)
stopifnot(is.numeric(nsim)) stopifnot(is.numeric(nsim))
stopifnot(nsim>=0) stopifnot(nsim>=0)
nsim<-testInteger(nsim) nsim<-testInteger(nsim)
#cmoy<-mean(p$marks) #cmoy<-mean(p$marks)
cvar<-var(p$marks) cvar<-var(p$marks)
stopifnot(is.numeric(alpha)) stopifnot(is.numeric(alpha))
stopifnot(alpha>=0) stopifnot(alpha>=0)
if(nsim>0) testIC(nsim,alpha) if(nsim>0) testIC(nsim,alpha)
if("rectangle"%in%p$window$type) { if("rectangle"%in%p$window$type) {
cas<-1 cas<-1
xmin<-p$window$xmin xmin<-p$window$xmin
xmax<-p$window$xmax xmax<-p$window$xmax
ymin<-p$window$ymin ymin<-p$window$ymin
ymax<-p$window$ymax ymax<-p$window$ymax
stopifnot(upto<=(0.5*max((xmax-xmin),(ymax-ymin)))) stopifnot(upto<=(0.5*max((xmax-xmin),(ymax-ymin))))
if ("complex"%in%p$window$type) { if ("complex"%in%p$window$type) {
cas<-3 cas<-3
tri<-p$window$triangles tri<-p$window$triangles
nbTri<-nrow(tri) nbTri<-nrow(tri)
} }
} }
else if("circle"%in%p$window$type) { else if("circle"%in%p$window$type) {
cas<-2 cas<-2
x0<-p$window$x0 x0<-p$window$x0
y0<-p$window$y0 y0<-p$window$y0
r0<-p$window$r0 r0<-p$window$r0
stopifnot(upto<=r0) stopifnot(upto<=r0)
if ("complex"%in%p$window$type) { if ("complex"%in%p$window$type) {
cas<-4 cas<-4
tri<-p$window$triangles tri<-p$window$triangles
nbTri<-nrow(tri) nbTri<-nrow(tri)
} }
} }
else else
stop("invalid window type") stop("invalid window type")
intensity<-p$n/area.swin(p$window) intensity<-p$n/area.swin(p$window)
if(cas==1) { #rectangle if(cas==1) { #rectangle
if(nsim==0) { #without CI if(nsim==0) { #without CI
res<-.C("corr_rect", res<-.C("corr_rect",
as.integer(p$n),as.double(p$x),as.double(p$y),as.double(p$marks), 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.double(xmin),as.double(xmax),as.double(ymin),as.double(ymax),
as.integer(tmax),as.double(by), as.integer(tmax),as.double(by),
gm=double(tmax),km=double(tmax), gm=double(tmax),km=double(tmax),
PACKAGE="ads") PACKAGE="ads")
} }
else { #with CI else { #with CI
res<-.C("corr_rect_ic", res<-.C("corr_rect_ic",
as.integer(p$n),as.double(p$x),as.double(p$y),as.double(p$marks), 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.double(xmin),as.double(xmax),as.double(ymin),as.double(ymax),
as.integer(tmax),as.double(by), as.integer(tmax),as.double(by),
as.integer(nsim),as.double(alpha), as.integer(nsim),as.double(alpha),
gm=double(tmax),km=double(tmax), gm=double(tmax),km=double(tmax),
gmic1=double(tmax),gmic2=double(tmax),kmic1=double(tmax),kmic2=double(tmax), gmic1=double(tmax),gmic2=double(tmax),kmic1=double(tmax),kmic2=double(tmax),
gmval=double(tmax),kmval=double(tmax), gmval=double(tmax),kmval=double(tmax),
PACKAGE="ads") PACKAGE="ads")
} }
} }
else if(cas==2) { #circle else if(cas==2) { #circle
if(nsim==0) { #without CI if(nsim==0) { #without CI
res<-.C("corr_disq", res<-.C("corr_disq",
as.integer(p$n),as.double(p$x),as.double(p$y),as.double(p$marks), 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.double(x0),as.double(y0),as.double(r0),
as.integer(tmax),as.double(by), as.integer(tmax),as.double(by),
gm=double(tmax),km=double(tmax), gm=double(tmax),km=double(tmax),
PACKAGE="ads") PACKAGE="ads")
} }
else { #with CI else { #with CI
res<-.C("corr_disq_ic", res<-.C("corr_disq_ic",
as.integer(p$n),as.double(p$x),as.double(p$y),as.double(p$marks), 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.double(x0),as.double(y0),as.double(r0),
as.integer(tmax),as.double(by), as.integer(tmax),as.double(by),
as.integer(nsim),as.double(alpha), as.integer(nsim),as.double(alpha),
gm=double(tmax),km=double(tmax), gm=double(tmax),km=double(tmax),
gmic1=double(tmax),gmic2=double(tmax),kmic1=double(tmax),kmic2=double(tmax), gmic1=double(tmax),gmic2=double(tmax),kmic1=double(tmax),kmic2=double(tmax),
gmval=double(tmax),kmval=double(tmax), gmval=double(tmax),kmval=double(tmax),
PACKAGE="ads") PACKAGE="ads")
} }
} }
else if(cas==3) { #complex within rectangle else if(cas==3) { #complex within rectangle
if(nsim==0) { #without CI if(nsim==0) { #without CI
res<-.C("corr_tr_rect", res<-.C("corr_tr_rect",
as.integer(p$n),as.double(p$x),as.double(p$y),as.double(p$marks), 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.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(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(tmax),as.double(by),
gm=double(tmax),km=double(tmax), gm=double(tmax),km=double(tmax),
PACKAGE="ads") PACKAGE="ads")
} }
else { #with CI else { #with CI
res<-.C("corr_tr_rect_ic", res<-.C("corr_tr_rect_ic",
as.integer(p$n),as.double(p$x),as.double(p$y),as.double(p$marks), 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.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(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(tmax),as.double(by),
as.integer(nsim),as.double(alpha), as.integer(nsim),as.double(alpha),
gm=double(tmax),km=double(tmax), gm=double(tmax),km=double(tmax),
gmic1=double(tmax),gmic2=double(tmax),kmic1=double(tmax),kmic2=double(tmax), gmic1=double(tmax),gmic2=double(tmax),kmic1=double(tmax),kmic2=double(tmax),
gmval=double(tmax),kmval=double(tmax), gmval=double(tmax),kmval=double(tmax),
PACKAGE="ads") PACKAGE="ads")
} }
} }
else if(cas==4) { #complex within circle else if(cas==4) { #complex within circle
if(nsim==0) { #without CI if(nsim==0) { #without CI
res<-.C("corr_tr_disq", res<-.C("corr_tr_disq",
as.integer(p$n),as.double(p$x),as.double(p$y),as.double(p$marks), 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.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(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(tmax),as.double(by),
gm=double(tmax),km=double(tmax), gm=double(tmax),km=double(tmax),
PACKAGE="ads") PACKAGE="ads")
} }
else { #with CI else { #with CI
res<-.C("ripley_tr_disq_ic", res<-.C("corr_tr_disq_ic",
as.integer(p$n),as.double(p$x),as.double(p$y),as.double(p$marks), 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.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(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(tmax),as.double(by),
as.integer(nsim),as.double(alpha), as.integer(nsim),as.double(alpha),
gm=double(tmax),km=double(tmax), gm=double(tmax),km=double(tmax),
gmic1=double(tmax),gmic2=double(tmax),kmic1=double(tmax),kmic2=double(tmax), gmic1=double(tmax),gmic2=double(tmax),kmic1=double(tmax),kmic2=double(tmax),
gmval=double(tmax),kmval=double(tmax), gmval=double(tmax),kmval=double(tmax),
PACKAGE="ads") PACKAGE="ads")
} }
} }
# formatting results # formatting results
gm<-data.frame(obs=res$gm,theo=rep(0,tmax)) gm<-data.frame(obs=res$gm,theo=rep(0,tmax))
km<-data.frame(obs=res$km,theo=rep(0,tmax)) km<-data.frame(obs=res$km,theo=rep(0,tmax))
if(nsim>0) { if(nsim>0) {
gm<-cbind(gm,sup=res$gmic1,inf=res$gmic2,pval=res$gmval/(nsim+1)) 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)) km<-cbind(km,sup=res$kmic1,inf=res$kmic2,pval=res$kmval/(nsim+1))
} }
call<-match.call() call<-match.call()
res<-list(call=call,r=r,gm=gm,km=km) res<-list(call=call,r=r,gm=gm,km=km)
class(res)<-c("fads","kmfun") class(res)<-c("fads","kmfun")
return(res) return(res)
} }
ksfun<-function(p,upto,by,nsim=0,alpha=0.01) { ksfun<-function(p,upto,by,nsim=0,alpha=0.01) {
# checking for input parameters # checking for input parameters
#options( CBoundsCheck = TRUE ) #options( CBoundsCheck = TRUE )
stopifnot(inherits(p,"spp")) stopifnot(inherits(p,"spp"))
stopifnot(p$type=="multivariate") stopifnot(p$type=="multivariate")
stopifnot(is.numeric(upto)) stopifnot(is.numeric(upto))
stopifnot(upto>=1) stopifnot(upto>=1)
stopifnot(is.numeric(by)) stopifnot(is.numeric(by))
stopifnot(by>0) stopifnot(by>0)
r<-seq(by,upto,by) r<-seq(by,upto,by)
tmax<-length(r) tmax<-length(r)
stopifnot(is.numeric(nsim)) stopifnot(is.numeric(nsim))
stopifnot(nsim>=0) stopifnot(nsim>=0)
nsim<-testInteger(nsim) nsim<-testInteger(nsim)
stopifnot(is.numeric(alpha)) stopifnot(is.numeric(alpha))
stopifnot(alpha>=0) stopifnot(alpha>=0)
if(nsim>0) testIC(nsim,alpha) if(nsim>0) testIC(nsim,alpha)
###faire test sur les marks ###faire test sur les marks
if("rectangle"%in%p$window$type) { if("rectangle"%in%p$window$type) {
cas<-1 cas<-1
xmin<-p$window$xmin xmin<-p$window$xmin
xmax<-p$window$xmax xmax<-p$window$xmax
ymin<-p$window$ymin ymin<-p$window$ymin
ymax<-p$window$ymax ymax<-p$window$ymax
stopifnot(upto<=(0.5*max((xmax-xmin),(ymax-ymin)))) stopifnot(upto<=(0.5*max((xmax-xmin),(ymax-ymin))))
if ("complex"%in%p$window$type) { if ("complex"%in%p$window$type) {
cas<-3 cas<-3
tri<-p$window$triangles tri<-p$window$triangles
nbTri<-nrow(tri) nbTri<-nrow(tri)
} }
} }
else if("circle"%in%p$window$type) { else if("circle"%in%p$window$type) {
cas<-2 cas<-2
x0<-p$window$x0 x0<-p$window$x0
y0<-p$window$y0 y0<-p$window$y0
r0<-p$window$r0 r0<-p$window$r0
stopifnot(upto<=r0) stopifnot(upto<=r0)
if ("complex"%in%p$window$type) { if ("complex"%in%p$window$type) {
cas<-4 cas<-4
tri<-p$window$triangles tri<-p$window$triangles
nbTri<-nrow(tri) nbTri<-nrow(tri)
} }
} }
else else
stop("invalid window type") stop("invalid window type")
surface<-area.swin(p$window) surface<-area.swin(p$window)
intensity<-p$n/surface intensity<-p$n/surface
tabMarks<-levels(p$marks) tabMarks<-levels(p$marks)
nbMarks<-nlevels(p$marks) nbMarks<-nlevels(p$marks)
#nbMarks<-length(tabMarks) #nbMarks<-length(tabMarks)
marks<-as.numeric(p$marks) marks<-as.numeric(p$marks)
freq<-as.vector(table(p$marks)) freq<-as.vector(table(p$marks))
D<-1-sum(freq*(freq-1))/(p$n*(p$n-1)) D<-1-sum(freq*(freq-1))/(p$n*(p$n-1))
# computing Shimatani # computing Shimatani
if(cas==1) { #rectangle if(cas==1) { #rectangle
if(nsim==0) { #without CI if(nsim==0) { #without CI
res<-.C("shimatani_rect", res<-.C("shimatani_rect",
as.integer(p$n),as.double(p$x),as.double(p$y), 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(xmin),as.double(xmax),as.double(ymin),as.double(ymax),
as.integer(tmax),as.double(by), as.integer(tmax),as.double(by),
as.integer(nbMarks),as.integer(marks),as.double(surface),gg=double(tmax),kk=double(tmax),erreur=integer(tmax), as.integer(nbMarks),as.integer(marks),as.double(surface),gg=double(tmax),kk=double(tmax),erreur=integer(tmax),
PACKAGE="ads") PACKAGE="ads")
} }
else { #with CI else { #with CI
res<-.C("shimatani_rect_ic", 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(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(tmax),as.double(by), as.integer(nsim), as.double(alpha),
as.integer(nbMarks),as.integer(marks),as.double(surface),as.double(D), 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), 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), gval=double(tmax),kval=double(tmax),erreur=integer(tmax),
PACKAGE="ads") PACKAGE="ads")
} }
} }
else if(cas==2) { #circle else if(cas==2) { #circle
if(nsim==0) { #without CI if(nsim==0) { #without CI
res<-.C("shimatani_disq", res<-.C("shimatani_disq",
as.integer(p$n),as.double(p$x),as.double(p$y), as.integer(p$n),as.double(p$x),as.double(p$y),
as.double(x0),as.double(y0),as.double(r0), as.double(x0),as.double(y0),as.double(r0),
as.integer(tmax),as.double(by), as.integer(tmax),as.double(by),
as.integer(nbMarks),as.integer(marks),as.double(surface),gg=double(tmax),kk=double(tmax),erreur=integer(tmax), as.integer(nbMarks),as.integer(marks),as.double(surface),gg=double(tmax),kk=double(tmax),erreur=integer(tmax),
PACKAGE="ads") PACKAGE="ads")
} }
else { #with CI else { #with CI
res<-.C("shimatani_disq_ic", 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(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(tmax),as.double(by), as.integer(nsim), as.double(alpha),
as.integer(nbMarks),as.integer(marks),as.double(surface),as.double(D), 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), 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), gval=double(tmax),kval=double(tmax),erreur=integer(tmax),
PACKAGE="ads") PACKAGE="ads")
} }
} }
else if(cas==3) { #complex within rectangle else if(cas==3) { #complex within rectangle
if(nsim==0) { #without CI if(nsim==0) { #without CI
res<-.C("shimatani_tr_rect", res<-.C("shimatani_tr_rect",
as.integer(p$n),as.double(p$x),as.double(p$y), 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(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(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(tmax),as.double(by),
as.integer(nbMarks),as.integer(marks),as.double(surface),gg=double(tmax),kk=double(tmax),erreur=integer(tmax), as.integer(nbMarks),as.integer(marks),as.double(surface),gg=double(tmax),kk=double(tmax),erreur=integer(tmax),
PACKAGE="ads") PACKAGE="ads")
} }
else { #with CI else { #with CI
res<-.C("shimatani_tr_rect_ic", 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(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(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(tmax),as.double(by), as.integer(nsim), as.double(alpha),
as.integer(nbMarks),as.integer(marks),as.double(surface),as.double(D), 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), 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), gval=double(tmax),kval=double(tmax),erreur=integer(tmax),
PACKAGE="ads") PACKAGE="ads")
} }
} }
else if(cas==4) { #complex within circle else if(cas==4) { #complex within circle
if(nsim==0) { #without CI if(nsim==0) { #without CI
res<-.C("shimatani_tr_disq", res<-.C("shimatani_tr_disq",
as.integer(p$n),as.double(p$x),as.double(p$y), as.integer(p$n),as.double(p$x),as.double(p$y),
as.double(x0),as.double(y0),as.double(r0), 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(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(tmax),as.double(by),
as.integer(nbMarks),as.integer(marks),as.double(surface),gg=double(tmax),kk=double(tmax),erreur=integer(tmax), as.integer(nbMarks),as.integer(marks),as.double(surface),gg=double(tmax),kk=double(tmax),erreur=integer(tmax),
PACKAGE="ads") PACKAGE="ads")
} }
else { #with CI else { #with CI
res<-.C("shimatani_tr_disq_ic", 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(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(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(tmax),as.double(by), as.integer(nsim), as.double(alpha),
as.integer(nbMarks),as.integer(marks),as.double(surface),as.double(D), 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), 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), gval=double(tmax),kval=double(tmax),erreur=integer(tmax),
PACKAGE="ads") PACKAGE="ads")
} }
} }
if(sum(res$erreur>0)){ if(sum(res$erreur>0)){
message("Error in ", appendLF=F) message("Error in ", appendLF=F)
print(match.call()) print(match.call())
message("No neigbors within distance intervals:") message("No neigbors within distance intervals:")
print(paste(by*(res$erreur[res$erreur>0]-1),"-",by*res$erreur[res$erreur>0])) print(paste(by*(res$erreur[res$erreur>0]-1),"-",by*res$erreur[res$erreur>0]))
message("Increase argument 'by'") message("Increase argument 'by'")
return(res=NULL) return(res=NULL)
} }
gs<-data.frame(obs=res$gg/D,theo=rep(1,tmax)) gs<-data.frame(obs=res$gg/D,theo=rep(1,tmax))
ks<-data.frame(obs=res$kk/D,theo=rep(1,tmax)) ks<-data.frame(obs=res$kk/D,theo=rep(1,tmax))
if(nsim>0) { if(nsim>0) {
gs<-cbind(gs,sup=res$gic1/D,inf=res$gic2/D,pval=res$gval/(nsim+1)) 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)) ks<-cbind(ks,sup=res$kic1/D,inf=res$kic2/D,pval=res$kval/(nsim+1))
} }
call<-match.call() call<-match.call()
res<-list(call=call,r=r,gs=gs,ks=ks) res<-list(call=call,r=r,gs=gs,ks=ks)
class(res)<-c("fads","ksfun") class(res)<-c("fads","ksfun")
return(res) return(res)
} }
################# #################
#V2 that calls K12fun #V2 that calls K12fun
############## ##############
krfun<-function(p,upto,by,nsim=0,dis=NULL,H0=c("rl","se"),alpha=0.01) { krfun<-function(p,upto,by,nsim=0,dis=NULL,H0=c("rl","se"),alpha=0.01) {
# checking for input parameters # checking for input parameters
stopifnot(inherits(p,"spp")) stopifnot(inherits(p,"spp"))
stopifnot(p$type=="multivariate") stopifnot(p$type=="multivariate")
stopifnot(is.numeric(upto)) stopifnot(is.numeric(upto))
stopifnot(upto>=1) stopifnot(upto>=1)
stopifnot(is.numeric(by)) stopifnot(is.numeric(by))
stopifnot(by>0) stopifnot(by>0)
r<-seq(by,upto,by) r<-seq(by,upto,by)
tmax<-length(r) tmax<-length(r)
H0<-H0[1] H0<-H0[1]
stopifnot(H0=="se" || H0=="rl") stopifnot(H0=="se" || H0=="rl")
ifelse(H0=="se",H0<-2,H0<-1) ifelse(H0=="se",H0<-2,H0<-1)
if(is.null(dis)) { if(is.null(dis)) {
stopifnot(H0==1) stopifnot(H0==1)
dis<-as.dist(matrix(1,nlevels(p$marks),nlevels(p$marks))) dis<-as.dist(matrix(1,nlevels(p$marks),nlevels(p$marks)))
attr(dis,"Labels")<-levels(p$marks) attr(dis,"Labels")<-levels(p$marks)
} }
stopifnot(inherits(dis,"dist")) stopifnot(inherits(dis,"dist"))
stopifnot(attr(dis,"Diag")==FALSE) stopifnot(attr(dis,"Diag")==FALSE)
stopifnot(attr(dis,"Upper")==FALSE) stopifnot(attr(dis,"Upper")==FALSE)
stopifnot(suppressWarnings(is.euclid(dis))) stopifnot(suppressWarnings(is.euclid(dis)))
###revoir tests sur dis ###revoir tests sur dis
if(length(levels(p$marks))!=length(labels(dis))) { if(length(levels(p$marks))!=length(labels(dis))) {
stopifnot(all(levels(p$marks)%in%labels(dis))) stopifnot(all(levels(p$marks)%in%labels(dis)))
#dis<-subsetdist(dis,which(labels(dis)%in%levels(p$marks))) #dis<-subsetdist(dis,which(labels(dis)%in%levels(p$marks)))
dis<-subsetdist(dis,levels(p$marks)) dis<-subsetdist(dis,levels(p$marks))
warning("matrix 'dis' have been subsetted to match with levels(p$marks)") warning("matrix 'dis' have been subsetted to match with levels(p$marks)")
} }
#else if(any(labels(dis)!=levels(p$marks))) { #else if(any(labels(dis)!=levels(p$marks))) {
# attr(dis,"Labels")<-levels(p$marks) # attr(dis,"Labels")<-levels(p$marks)
# warning("levels(p$marks) have been assigned to attr(dis, ''Labels'')") # warning("levels(p$marks) have been assigned to attr(dis, ''Labels'')")
# } # }
stopifnot(is.numeric(nsim)) stopifnot(is.numeric(nsim))
stopifnot(nsim>=0) stopifnot(nsim>=0)
nsim<-testInteger(nsim) nsim<-testInteger(nsim)
stopifnot(is.numeric(alpha)) stopifnot(is.numeric(alpha))
stopifnot(alpha>=0) stopifnot(alpha>=0)
if(nsim>0) testIC(nsim,alpha) if(nsim>0) testIC(nsim,alpha)
###faire test sur les marks ###faire test sur les marks
if("rectangle"%in%p$window$type) { if("rectangle"%in%p$window$type) {
cas<-1 cas<-1
xmin<-p$window$xmin xmin<-p$window$xmin
xmax<-p$window$xmax xmax<-p$window$xmax
ymin<-p$window$ymin ymin<-p$window$ymin
ymax<-p$window$ymax ymax<-p$window$ymax
stopifnot(upto<=(0.5*max((xmax-xmin),(ymax-ymin)))) stopifnot(upto<=(0.5*max((xmax-xmin),(ymax-ymin))))
if ("complex"%in%p$window$type) { if ("complex"%in%p$window$type) {
cas<-3 cas<-3
tri<-p$window$triangles tri<-p$window$triangles
nbTri<-nrow(tri) nbTri<-nrow(tri)
} }
} }
else if("circle"%in%p$window$type) { else if("circle"%in%p$window$type) {
cas<-2 cas<-2
x0<-p$window$x0 x0<-p$window$x0
y0<-p$window$y0 y0<-p$window$y0
r0<-p$window$r0 r0<-p$window$r0
stopifnot(upto<=r0) stopifnot(upto<=r0)
if ("complex"%in%p$window$type) { if ("complex"%in%p$window$type) {
cas<-4 cas<-4
tri<-p$window$triangles tri<-p$window$triangles
nbTri<-nrow(tri) nbTri<-nrow(tri)
} }
} }
else else
stop("invalid window type") stop("invalid window type")
surface<-area.swin(p$window) surface<-area.swin(p$window)
intensity<-p$n/surface intensity<-p$n/surface
nbMarks<-nlevels(p$marks) nbMarks<-nlevels(p$marks)
marks<-as.numeric(p$marks) # => position du label dans levels(p$marks) marks<-as.numeric(p$marks) # => position du label dans levels(p$marks)
dis<-as.dist(sortmat(dis,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<-suppressWarnings(divc(as.data.frame(unclass(table(p$marks))),sqrt(2*dis),scale=F)[1,1])
HD<-HD*p$n/(p$n-1) HD<-HD*p$n/(p$n-1)
dis<-as.vector(dis) dis<-as.vector(dis)
# computing Rao # computing Rao
if(cas==1) { #rectangle if(cas==1) { #rectangle
if(nsim==0) { #without CI if(nsim==0) { #without CI
res<-.C("rao_rect", res<-.C("rao_rect",
as.integer(p$n),as.double(p$x),as.double(p$y), 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(xmin),as.double(xmax),as.double(ymin),as.double(ymax),
as.integer(tmax),as.double(by),as.integer(H0), as.integer(tmax),as.double(by),as.integer(H0),
as.integer(nbMarks),as.integer(marks),as.double(dis),as.double(surface),as.double(HD), 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), gg=double(tmax),kk=double(tmax),gs=double(tmax),ks=double(tmax),erreur=integer(tmax),
PACKAGE="ads") PACKAGE="ads")
} }
else { #with CI else { #with CI
res<-.C("rao_rect_ic", 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(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(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), 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), 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), gval=double(tmax),kval=double(tmax),erreur=integer(tmax),
PACKAGE="ads") PACKAGE="ads")
} }
} }
else if(cas==2) { #circle else if(cas==2) { #circle
if(nsim==0) { #without CI if(nsim==0) { #without CI
res<-.C("rao_disq", res<-.C("rao_disq",
as.integer(p$n),as.double(p$x),as.double(p$y), as.integer(p$n),as.double(p$x),as.double(p$y),
as.double(x0),as.double(y0),as.double(r0), as.double(x0),as.double(y0),as.double(r0),
as.integer(tmax),as.double(by),as.integer(H0), as.integer(tmax),as.double(by),as.integer(H0),
as.integer(nbMarks),as.integer(marks),as.double(dis),as.double(surface),as.double(HD), 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), gg=double(tmax),kk=double(tmax),gs=double(tmax),ks=double(tmax),erreur=integer(tmax),
PACKAGE="ads") PACKAGE="ads")
} }
else { #with CI else { #with CI
res<-.C("rao_disq_ic", 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(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(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), 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), 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), gval=double(tmax),kval=double(tmax),erreur=integer(tmax),
PACKAGE="ads") PACKAGE="ads")
} }
} }
else if(cas==3) { #complex within rectangle else if(cas==3) { #complex within rectangle
if(nsim==0) { #without CI if(nsim==0) { #without CI
res<-.C("rao_tr_rect", res<-.C("rao_tr_rect",
as.integer(p$n),as.double(p$x),as.double(p$y), 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(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(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(tmax),as.double(by),as.integer(H0),
as.integer(nbMarks),as.integer(marks),as.double(dis),as.double(surface),as.double(HD), 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), gg=double(tmax),kk=double(tmax),gs=double(tmax),ks=double(tmax),erreur=integer(tmax),
PACKAGE="ads") PACKAGE="ads")
} }
else { #with CI else { #with CI
res<-.C("rao_tr_rect_ic", res<-.C("rao_tr_rect_ic",
as.integer(p$n),as.double(p$x),as.double(p$y), 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(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(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(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), 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), 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), gval=double(tmax),kval=double(tmax),erreur=integer(tmax),
PACKAGE="ads") PACKAGE="ads")
} }
} }
else if(cas==4) { #complex within circle else if(cas==4) { #complex within circle
if(nsim==0) { #without CI if(nsim==0) { #without CI
res<-.C("rao_tr_disq", res<-.C("rao_tr_disq",
as.integer(p$n),as.double(p$x),as.double(p$y), as.integer(p$n),as.double(p$x),as.double(p$y),
as.double(x0),as.double(y0),as.double(r0), 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(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(tmax),as.double(by),as.integer(H0),
as.integer(nbMarks),as.integer(marks),as.double(dis),as.double(surface),as.double(HD), 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), gg=double(tmax),kk=double(tmax),gs=double(tmax),ks=double(tmax),erreur=integer(tmax),
PACKAGE="ads") PACKAGE="ads")
} }
else { #with CI (not based on K12) else { #with CI (not based on K12)
res<-.C("rao_tr_disq_ic", res<-.C("rao_tr_disq_ic",
as.integer(p$n),as.double(p$x),as.double(p$y), as.integer(p$n),as.double(p$x),as.double(p$y),
as.double(x0),as.double(y0),as.double(r0), 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(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(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), 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), 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), gval=double(tmax),kval=double(tmax),serreur=integer(tmax),
PACKAGE="ads") PACKAGE="ads")
} }
} }
if(sum(res$erreur>0)){ if(sum(res$erreur>0)){
message("Error in ", appendLF=F) message("Error in ", appendLF=F)
print(match.call()) print(match.call())
message("No neigbors within distance intervals:") message("No neigbors within distance intervals:")
print(paste(by*(res$erreur[res$erreur>0]-1),"-",by*res$erreur[res$erreur>0])) print(paste(by*(res$erreur[res$erreur>0]-1),"-",by*res$erreur[res$erreur>0]))
message("Increase argument 'by'") message("Increase argument 'by'")
return(res=NULL) return(res=NULL)
} }
if(H0==1) { if(H0==1) {
theog<-rep(1,tmax) theog<-rep(1,tmax)
theok<-rep(1,tmax) theok<-rep(1,tmax)
} }
if(H0==2) { if(H0==2) {
theog<-res$gs theog<-res$gs
theok<-res$ks theok<-res$ks
} }
gr<-data.frame(obs=res$gg,theo=theog) gr<-data.frame(obs=res$gg,theo=theog)
kr<-data.frame(obs=res$kk,theo=theok) kr<-data.frame(obs=res$kk,theo=theok)
if(nsim>0) { if(nsim>0) {
gr<-cbind(gr,sup=res$gic1,inf=res$gic2,pval=res$gval/(nsim+1)) 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)) kr<-cbind(kr,sup=res$kic1,inf=res$kic2,pval=res$kval/(nsim+1))
} }
call<-match.call() call<-match.call()
res<-list(call=call,r=r,gr=gr,kr=kr) res<-list(call=call,r=r,gr=gr,kr=kr)
class(res)<-c("fads","krfun") class(res)<-c("fads","krfun")
return(res) return(res)
} }
kdfun<-function(p,upto,by,dis,nsim=0,alpha=0.01) { kdfun<-function(p,upto,by,dis,nsim=0,alpha=0.01) {
# checking for input parameters # checking for input parameters
stopifnot(inherits(p,"spp")) stopifnot(inherits(p,"spp"))
stopifnot(p$type=="multivariate") stopifnot(p$type=="multivariate")
if(min(p$x)<0) if(min(p$x)<0)
p$x<-p$x+abs(min(p$x)) p$x<-p$x+abs(min(p$x))
if(min(p$y)<0) if(min(p$y)<0)
p$y<-p$y+abs(min(p$y)) p$y<-p$y+abs(min(p$y))
stopifnot(is.numeric(upto)) stopifnot(is.numeric(upto))
stopifnot(upto>=1) stopifnot(upto>=1)
stopifnot(is.numeric(by)) stopifnot(is.numeric(by))
stopifnot(by>0) stopifnot(by>0)
r<-seq(by,upto,by) r<-seq(by,upto,by)
tmax<-length(r) tmax<-length(r)
stopifnot(inherits(dis,"dist")) stopifnot(inherits(dis,"dist"))
stopifnot(attr(dis,"Diag")==FALSE) stopifnot(attr(dis,"Diag")==FALSE)
stopifnot(attr(dis,"Upper")==FALSE) stopifnot(attr(dis,"Upper")==FALSE)
stopifnot(suppressWarnings(is.euclid(dis))) stopifnot(suppressWarnings(is.euclid(dis)))
###revoir tests sur dis ###revoir tests sur dis
if(length(levels(p$marks))!=length(labels(dis))) { if(length(levels(p$marks))!=length(labels(dis))) {
stopifnot(all(levels(p$marks)%in%labels(dis))) stopifnot(all(levels(p$marks)%in%labels(dis)))
#dis<-subsetdist(dis,which(labels(dis)%in%levels(p$marks))) #dis<-subsetdist(dis,which(labels(dis)%in%levels(p$marks)))
dis<-subsetdist(dis,levels(p$marks)) dis<-subsetdist(dis,levels(p$marks))
warning("matrix 'dis' have been subsetted to match with levels(p$marks)") warning("matrix 'dis' have been subsetted to match with levels(p$marks)")
} }
#else if(any(labels(dis)!=levels(p$marks))) { #else if(any(labels(dis)!=levels(p$marks))) {
# attr(dis,"Labels")<-levels(p$marks) # attr(dis,"Labels")<-levels(p$marks)
# warning("levels(p$marks) have been assigned to attr(dis, ''Labels'')") # warning("levels(p$marks) have been assigned to attr(dis, ''Labels'')")
# } # }
stopifnot(is.numeric(nsim)) stopifnot(is.numeric(nsim))
stopifnot(nsim>=0) stopifnot(nsim>=0)
nsim<-testInteger(nsim) nsim<-testInteger(nsim)
stopifnot(is.numeric(alpha)) stopifnot(is.numeric(alpha))
stopifnot(alpha>=0) stopifnot(alpha>=0)
if(nsim>0) testIC(nsim,alpha) if(nsim>0) testIC(nsim,alpha)
surface<-area.swin(p$window) surface<-area.swin(p$window)
intensity<-p$n/surface intensity<-p$n/surface
nbMarks<-nlevels(p$marks) nbMarks<-nlevels(p$marks)
marks<-as.numeric(p$marks) # => position du label dans levels(p$marks) marks<-as.numeric(p$marks) # => position du label dans levels(p$marks)
dis<-as.dist(sortmat(dis,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<-suppressWarnings(divc(as.data.frame(unclass(table(p$marks))),sqrt(2*dis),scale=F)[1,1])
HD<-HD*p$n/(p$n-1) HD<-HD*p$n/(p$n-1)
dis<-as.vector(dis) dis<-as.vector(dis)
###faire test sur les marks ###faire test sur les marks
if(nsim==0) { #without CI if(nsim==0) { #without CI
res<-.C("shen", res<-.C("shen",
as.integer(p$n),as.double(p$x),as.double(p$y), as.integer(p$n),as.double(p$x),as.double(p$y),
as.integer(tmax),as.double(by), as.integer(tmax),as.double(by),
as.integer(nbMarks),as.integer(marks),as.double(dis),as.double(surface),as.double(HD), as.integer(nbMarks),as.integer(marks),as.double(dis),as.double(surface),as.double(HD),
gd=double(tmax),kd=double(tmax),erreur=integer(tmax), gd=double(tmax),kd=double(tmax),erreur=integer(tmax),
PACKAGE="ads") PACKAGE="ads")
} }
else { #with CI else { #with CI
res<-.C("shen_ic", res<-.C("shen_ic",
as.integer(p$n),as.double(p$x),as.double(p$y), 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(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), 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), 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), gval=double(tmax),kval=double(tmax),erreur=integer(tmax),
PACKAGE="ads") PACKAGE="ads")
} }
if(sum(res$erreur>0)){ if(sum(res$erreur>0)){
message("Error in ", appendLF=F) message("Error in ", appendLF=F)
print(match.call()) print(match.call())
message("No neigbors within distance intervals:") message("No neigbors within distance intervals:")
print(paste(by*(res$erreur[res$erreur>0]-1),"-",by*res$erreur[res$erreur>0])) print(paste(by*(res$erreur[res$erreur>0]-1),"-",by*res$erreur[res$erreur>0]))
message("Increase argument 'by'") message("Increase argument 'by'")
return(res=NULL) return(res=NULL)
} }
gd<-data.frame(obs=res$gd,theo=rep(1,tmax)) gd<-data.frame(obs=res$gd,theo=rep(1,tmax))
kd<-data.frame(obs=res$kd,theo=rep(1,tmax)) kd<-data.frame(obs=res$kd,theo=rep(1,tmax))
if(nsim>0) { if(nsim>0) {
gd<-cbind(gd,sup=res$gic1,inf=res$gic2,pval=res$gval/(nsim+1)) 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)) kd<-cbind(kd,sup=res$kic1,inf=res$kic2,pval=res$kval/(nsim+1))
} }
call<-match.call() call<-match.call()
res<-list(call=call,r=r,gd=gd,kd=kd) res<-list(call=call,r=r,gd=gd,kd=kd)
class(res)<-c("fads","kdfun") class(res)<-c("fads","kdfun")
return(res) return(res)
} }
R/plot.vads.R
+ 6
− 34
View file @ 2f2ebbb7
...@@ -28,8 +28,7 @@ plot.vads.dval<-function (x,main,opt=c("dval","cval"),select,chars=c("circles"," ...@@ -28,8 +28,7 @@ plot.vads.dval<-function (x,main,opt=c("dval","cval"),select,chars=c("circles","
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)) maxsize))
def.par <- par(no.readonly = TRUE) def.par <- par(no.readonly = TRUE)
on.exit(par(def.par)) on.exit(par(def.par))
#if(options()$device=="windows")
# csize<-0.75*csize
if (missing(main)) if (missing(main))
main <- deparse(substitute(x)) main <- deparse(substitute(x))
mylayout<-layout(matrix(c(rep(1,nf),seq(2,((nf*nf)+1),1)),(nf+1),nf,byrow=TRUE)) mylayout<-layout(matrix(c(rep(1,nf),seq(2,((nf*nf)+1),1)),(nf+1),nf,byrow=TRUE))
...@@ -54,14 +53,7 @@ plot.vads.dval<-function (x,main,opt=c("dval","cval"),select,chars=c("circles"," ...@@ -54,14 +53,7 @@ plot.vads.dval<-function (x,main,opt=c("dval","cval"),select,chars=c("circles","
text(c(xl[1]+lms[1],xl[2]+lms[2],xl[3]+lms[3]),yl,labels=signif(lm,2),pos=4,cex=1.5) 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 lgende ???
#}
#else
# mylayout<-layout(matrix(seq(1,(nf*nf),1),nf,nf,byrow=TRUE))
ifelse(missing(cols),cols<-1,cols<-cols[1]) ifelse(missing(cols),cols<-1,cols<-cols[1])
if(!missing(char0)||!missing(col0)) { if(!missing(char0)||!missing(col0)) {
ifelse(missing(col0),col0<-cols,col0<-col0[1]) ifelse(missing(col0),col0<-cols,col0<-col0[1])
...@@ -82,7 +74,6 @@ plot.vads.dval<-function (x,main,opt=c("dval","cval"),select,chars=c("circles"," ...@@ -82,7 +74,6 @@ plot.vads.dval<-function (x,main,opt=c("dval","cval"),select,chars=c("circles","
fg=cols,bg=cols,inches=FALSE,add=TRUE,...) fg=cols,bg=cols,inches=FALSE,add=TRUE,...)
} }
} }
## mthode 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,...) { 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,...) {
...@@ -117,14 +108,12 @@ plot.vads.kval<-function (x,main,opt=c("lval","kval","nval","gval"),select,chars ...@@ -117,14 +108,12 @@ plot.vads.kval<-function (x,main,opt=c("lval","kval","nval","gval"),select,chars
else else
stopifnot(opt%in%c("lval","kval","nval","gval")) stopifnot(opt%in%c("lval","kval","nval","gval"))
v<-val v<-val
#val<-data.frame(adjust.marks.size(val,x$window,if(!missing(maxsize)) maxsize))
val<-data.frame(adjust.marks.size(val,x$window)) val<-data.frame(adjust.marks.size(val,x$window))
if(!missing(maxsize)) if(!missing(maxsize))
val<-val*maxsize val<-val*maxsize
def.par <- par(no.readonly = TRUE) def.par <- par(no.readonly = TRUE)
on.exit(par(def.par)) on.exit(par(def.par))
#if(options()$device=="windows")
# csize<-0.75*csize
if (missing(main)) if (missing(main))
main <- deparse(substitute(x)) main <- deparse(substitute(x))
mylayout<-layout(matrix(c(rep(1,nf),seq(2,((nf*nf)+1),1)),(nf+1),nf,byrow=TRUE)) mylayout<-layout(matrix(c(rep(1,nf),seq(2,((nf*nf)+1),1)),(nf+1),nf,byrow=TRUE))
...@@ -155,14 +144,7 @@ plot.vads.kval<-function (x,main,opt=c("lval","kval","nval","gval"),select,chars ...@@ -155,14 +144,7 @@ plot.vads.kval<-function (x,main,opt=c("lval","kval","nval","gval"),select,chars
} }
} }
#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 lgende ???
#}
#else
# mylayout<-layout(matrix(seq(1,(nf*nf),1),nf,nf,byrow=TRUE))
ifelse(missing(cols),cols<-1,cols<-cols[1]) ifelse(missing(cols),cols<-1,cols<-cols[1])
if(!missing(char0)||!missing(col0)) { if(!missing(char0)||!missing(col0)) {
ifelse(missing(col0),col0<-cols,col0<-col0[1]) ifelse(missing(col0),col0<-cols,col0<-col0[1])
...@@ -194,7 +176,6 @@ plot.vads.kval<-function (x,main,opt=c("lval","kval","nval","gval"),select,chars ...@@ -194,7 +176,6 @@ plot.vads.kval<-function (x,main,opt=c("lval","kval","nval","gval"),select,chars
} }
} }
} }
## mthode 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,...) { 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,...) {
...@@ -235,8 +216,7 @@ plot.vads.k12val<-function (x,main,opt=c("lval","kval","nval","gval"),select,cha ...@@ -235,8 +216,7 @@ plot.vads.k12val<-function (x,main,opt=c("lval","kval","nval","gval"),select,cha
val<-val*maxsize val<-val*maxsize
def.par <- par(no.readonly = TRUE) def.par <- par(no.readonly = TRUE)
on.exit(par(def.par)) on.exit(par(def.par))
#if(options()$device=="windows")
# csize<-0.75*csize
if (missing(main)) if (missing(main))
main <- deparse(substitute(x)) main <- deparse(substitute(x))
mylayout<-layout(matrix(c(rep(1,nf),seq(2,((nf*nf)+1),1)),(nf+1),nf,byrow=TRUE)) mylayout<-layout(matrix(c(rep(1,nf),seq(2,((nf*nf)+1),1)),(nf+1),nf,byrow=TRUE))
...@@ -265,14 +245,7 @@ plot.vads.k12val<-function (x,main,opt=c("lval","kval","nval","gval"),select,cha ...@@ -265,14 +245,7 @@ plot.vads.k12val<-function (x,main,opt=c("lval","kval","nval","gval"),select,cha
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) 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 lgende ???
#}
#else
# mylayout<-layout(matrix(seq(1,(nf*nf),1),nf,nf,byrow=TRUE))
ifelse(missing(cols),cols<-1,cols<-cols[1]) ifelse(missing(cols),cols<-1,cols<-cols[1])
if(!missing(char0)||!missing(col0)) { if(!missing(char0)||!missing(col0)) {
ifelse(missing(col0),col0<-cols,col0<-col0[1]) ifelse(missing(col0),col0<-cols,col0<-col0[1])
...@@ -304,5 +277,4 @@ plot.vads.k12val<-function (x,main,opt=c("lval","kval","nval","gval"),select,cha ...@@ -304,5 +277,4 @@ plot.vads.k12val<-function (x,main,opt=c("lval","kval","nval","gval"),select,cha
} }
} }
} }
## mthode en courbes de niveaux ?
} }
R/vads.R
+ 296
− 305
View file @ 2f2ebbb7
dval<-function(p,upto,by,nx,ny) { dval<-function(p,upto,by,nx,ny) {
#si multivari, choix du type de points ??? stopifnot(inherits(p,"spp"))
stopifnot(inherits(p,"spp")) stopifnot(is.numeric(upto))
stopifnot(is.numeric(upto)) stopifnot(is.numeric(by))
stopifnot(is.numeric(by)) stopifnot(by>0)
stopifnot(by>0) r<-seq(by,upto,by)
r<-seq(by,upto,by) tmax<-length(r)
tmax<-length(r) stopifnot(is.numeric(nx))
stopifnot(is.numeric(nx)) stopifnot(nx>=1)
stopifnot(nx>=1) nx<-testInteger(nx)
nx<-testInteger(nx) stopifnot(is.numeric(ny))
stopifnot(is.numeric(ny)) stopifnot(ny>=1)
stopifnot(ny>=1) ny<-testInteger(ny)
ny<-testInteger(ny) if("rectangle"%in%p$window$type) {
if("rectangle"%in%p$window$type) { cas<-1
cas<-1 xmin<-p$window$xmin
xmin<-p$window$xmin xmax<-p$window$xmax
xmax<-p$window$xmax ymin<-p$window$ymin
ymin<-p$window$ymin ymax<-p$window$ymax
ymax<-p$window$ymax stopifnot(upto<=(0.5*max((xmax-xmin),(ymax-ymin))))
stopifnot(upto<=(0.5*max((xmax-xmin),(ymax-ymin)))) xsample<-rep(xmin+(seq(1,nx)-0.5)*(xmax-xmin)/nx,each=ny)
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)
ysample<-rep(ymin+(seq(1,ny)-0.5)*(ymax-ymin)/ny,nx) if ("complex"%in%p$window$type) {
if ("complex"%in%p$window$type) { cas<-3
cas<-3 tri<-p$window$triangles
tri<-p$window$triangles nbTri<-nrow(tri)
nbTri<-nrow(tri) }
} }
} else if("circle"%in%p$window$type) {
else if("circle"%in%p$window$type) { cas<-2
cas<-2 x0<-p$window$x0
x0<-p$window$x0 y0<-p$window$y0
y0<-p$window$y0 r0<-p$window$r0
r0<-p$window$r0 stopifnot(upto<=r0)
stopifnot(upto<=r0) xsample<-rep(x0-r0+(seq(1,nx)-0.5)*2*r0/nx,each=ny)
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)
ysample<-rep(y0-r0+(seq(1,ny)-0.5)*2*r0/ny,nx) if ("complex"%in%p$window$type) {
if ("complex"%in%p$window$type) { cas<-4
cas<-4 tri<-p$window$triangles
tri<-p$window$triangles nbTri<-nrow(tri)
nbTri<-nrow(tri) }
} }
} else
else stop("invalid window type")
stop("invalid window type")
ok <- inside.swin(xsample, ysample, p$window)
ok <- inside.swin(xsample, ysample, p$window) xsample<-xsample[ok]
xsample<-xsample[ok] ysample<-ysample[ok]
ysample<-ysample[ok] stopifnot(length(xsample)==length(ysample))
stopifnot(length(xsample)==length(ysample)) nbSample<-length(xsample)
nbSample<-length(xsample)
if(cas==1) { #rectangle
if(cas==1) { #rectangle count<-.C("density_rect",
count<-.C("density_rect", as.integer(p$n),as.double(p$x),as.double(p$y),
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(xmin),as.double(xmax),as.double(ymin),as.double(ymax), as.integer(tmax),as.double(by),
as.integer(tmax),as.double(by), as.double(xsample),as.double(ysample),as.integer(nbSample),
as.double(xsample),as.double(ysample),as.integer(nbSample), count=double(tmax*nbSample),
count=double(tmax*nbSample), PACKAGE="ads")$count
PACKAGE="ads")$count }
} else if(cas==2) { #circle
else if(cas==2) { #circle count<-.C("density_disq",
count<-.C("density_disq", as.integer(p$n),as.double(p$x),as.double(p$y),
as.integer(p$n),as.double(p$x),as.double(p$y), as.double(x0),as.double(y0),as.double(r0),
as.double(x0),as.double(y0),as.double(r0), as.integer(tmax),as.double(by),
as.integer(tmax),as.double(by), as.double(xsample),as.double(ysample),as.integer(nbSample),
as.double(xsample),as.double(ysample),as.integer(nbSample), count=double(tmax*nbSample),
count=double(tmax*nbSample), PACKAGE="ads")$count
PACKAGE="ads")$count }
} else if(cas==3) { #complex within rectangle
else if(cas==3) { #complex within rectangle count<-.C("density_tr_rect",
count<-.C("density_tr_rect", as.integer(p$n),as.double(p$x),as.double(p$y),
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(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(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(tmax),as.double(by), as.double(xsample),as.double(ysample),as.integer(nbSample),
as.double(xsample),as.double(ysample),as.integer(nbSample), count=double(tmax*nbSample),
count=double(tmax*nbSample), PACKAGE="ads")$count
PACKAGE="ads")$count }
} else if(cas==4) { #complex within circle
else if(cas==4) { #complex within circle count<-.C("density_tr_disq",
count<-.C("density_tr_disq", as.integer(p$n),as.double(p$x),as.double(p$y),
as.integer(p$n),as.double(p$x),as.double(p$y), as.double(x0),as.double(y0),as.double(r0),
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(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(tmax),as.double(by), as.double(xsample),as.double(ysample),as.integer(nbSample),
as.double(xsample),as.double(ysample),as.integer(nbSample), count=double(tmax*nbSample),
count=double(tmax*nbSample), PACKAGE="ads")$count
PACKAGE="ads")$count }
} ## rajouter un indice lorsque les disques ne sont pas independants
## rajouter un indice lorsque les disques ne sont pas indpendants # formatting results
# formatting results dens<-count/(pi*r^2)
dens<-count/(pi*r^2) #grid<-matrix(c(xsample,ysample),nrow=nbSample,ncol=2)
#grid<-matrix(c(xsample,ysample),nrow=nbSample,ncol=2) count<-matrix(count,nrow=nbSample,ncol=tmax,byrow=TRUE)
count<-matrix(count,nrow=nbSample,ncol=tmax,byrow=TRUE) dens<-matrix(dens,nrow=nbSample,ncol=tmax,byrow=TRUE)
dens<-matrix(dens,nrow=nbSample,ncol=tmax,byrow=TRUE) call<-match.call()
call<-match.call() res<-list(call=call,window=p$window,r=r,xy=data.frame(x=xsample,y=ysample),cval=count,dval=dens)
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")
class(res)<-c("vads","dval") return(res)
return(res) }
}
kval<-function(p,upto,by) {
kval<-function(p,upto,by) { # checking for input parameters
# checking for input parameters stopifnot(inherits(p,"spp"))
stopifnot(inherits(p,"spp")) if(p$type!="univariate")
if(p$type!="univariate") warning(paste(p$type,"point pattern has been considered to be univariate\n"))
warning(paste(p$type,"point pattern has been considered to be univariate\n")) stopifnot(is.numeric(upto))
stopifnot(is.numeric(upto)) stopifnot(is.numeric(by))
stopifnot(is.numeric(by)) stopifnot(by>0)
stopifnot(by>0) r<-seq(by,upto,by)
r<-seq(by,upto,by) tmax<-length(r)
tmax<-length(r)
if("rectangle"%in%p$window$type) {
if("rectangle"%in%p$window$type) { cas<-1
cas<-1 xmin<-p$window$xmin
xmin<-p$window$xmin xmax<-p$window$xmax
xmax<-p$window$xmax ymin<-p$window$ymin
ymin<-p$window$ymin ymax<-p$window$ymax
ymax<-p$window$ymax stopifnot(upto<=(0.5*max((xmax-xmin),(ymax-ymin))))
stopifnot(upto<=(0.5*max((xmax-xmin),(ymax-ymin)))) if ("complex"%in%p$window$type) {
if ("complex"%in%p$window$type) { cas<-3
cas<-3 tri<-p$window$triangles
tri<-p$window$triangles nbTri<-nrow(tri)
nbTri<-nrow(tri) }
} }
} else if("circle"%in%p$window$type) {
else if("circle"%in%p$window$type) { cas<-2
cas<-2 x0<-p$window$x0
x0<-p$window$x0 y0<-p$window$y0
y0<-p$window$y0 r0<-p$window$r0
r0<-p$window$r0 stopifnot(upto<=r0)
stopifnot(upto<=r0) if ("complex"%in%p$window$type) {
if ("complex"%in%p$window$type) { cas<-4
cas<-4 tri<-p$window$triangles
tri<-p$window$triangles nbTri<-nrow(tri)
nbTri<-nrow(tri) }
} }
} else
else stop("invalid window type")
stop("invalid window type") intensity<-p$n/area.swin(p$window)
intensity<-p$n/area.swin(p$window)
#computing ripley local functions
#computing ripley local functions if(cas==1) { #rectangle
if(cas==1) { #rectangle res<-.C("ripleylocal_rect",
res<-.C("ripleylocal_rect", as.integer(p$n),as.double(p$x),as.double(p$y),
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(xmin),as.double(xmax),as.double(ymin),as.double(ymax), as.integer(tmax),as.double(by),
as.integer(tmax),as.double(by), gi=double(p$n*tmax),ki=double(p$n*tmax),
gi=double(p$n*tmax),ki=double(p$n*tmax), PACKAGE="ads")
PACKAGE="ads") }
} else if(cas==2) { #circle
else if(cas==2) { #circle res<-.C("ripleylocal_disq",
res<-.C("ripleylocal_disq", as.integer(p$n),as.double(p$x),as.double(p$y),
as.integer(p$n),as.double(p$x),as.double(p$y), as.double(x0),as.double(y0),as.double(r0),
as.double(x0),as.double(y0),as.double(r0), as.integer(tmax),as.double(by),
as.integer(tmax),as.double(by), gi=double(p$n*tmax),ki=double(p$n*tmax),
gi=double(p$n*tmax),ki=double(p$n*tmax), PACKAGE="ads")
PACKAGE="ads") }
} else if(cas==3) { #complex within rectangle
else if(cas==3) { #complex within rectangle res<-.C("ripleylocal_tr_rect",
res<-.C("ripleylocal_tr_rect", as.integer(p$n),as.double(p$x),as.double(p$y),
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(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(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(tmax),as.double(by), gi=double(p$n*tmax),ki=double(p$n*tmax),
gi=double(p$n*tmax),ki=double(p$n*tmax), PACKAGE="ads")
PACKAGE="ads") }
} else if(cas==4) { #complex within circle
else if(cas==4) { #complex within circle res<-.C("ripleylocal_tr_disq",
res<-.C("ripleylocal_tr_disq", as.integer(p$n),as.double(p$x),as.double(p$y),
as.integer(p$n),as.double(p$x),as.double(p$y), as.double(x0),as.double(y0),as.double(r0),
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(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(tmax),as.double(by), gi=double(p$n*tmax),ki=double(p$n*tmax),
gi=double(p$n*tmax),ki=double(p$n*tmax), PACKAGE="ads")
PACKAGE="ads") }
} # formatting results
# formatting results ds<-c(pi,diff(pi*r^2))
#coord<-matrix(c(X$x,X$y),nrow=nbPts,ncol=2) gi<-matrix(res$gi/(intensity*ds),nrow=p$n,ncol=tmax,byrow=TRUE)
#coord<-data.frame(x=p$x,y=p$y) ni<-matrix(res$ki/(pi*r^2),nrow=p$n,ncol=tmax,byrow=TRUE)
#r<-seq(dr,dr*tmax,dr) ki<-matrix(res$ki/intensity,nrow=p$n,ncol=tmax,byrow=TRUE)
#ds<-pi*r^2-pi*seq(0,dr*tmax-dr,dr)^2 li<-matrix(sqrt(res$ki/(intensity*pi))-r,nrow=p$n,ncol=tmax,byrow=TRUE)
ds<-c(pi,diff(pi*r^2)) call<-match.call()
gi<-matrix(res$gi/(intensity*ds),nrow=p$n,ncol=tmax,byrow=TRUE) 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)
ni<-matrix(res$ki/(pi*r^2),nrow=p$n,ncol=tmax,byrow=TRUE) class(res)<-c("vads","kval")
ki<-matrix(res$ki/intensity,nrow=p$n,ncol=tmax,byrow=TRUE) return(res)
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) k12val<-function(p,upto,by,marks) {
class(res)<-c("vads","kval") # checking for input parameters
return(res) stopifnot(inherits(p,"spp"))
} stopifnot(p$type=="multivariate")
stopifnot(is.numeric(upto))
k12val<-function(p,upto,by,marks) { stopifnot(is.numeric(by))
# checking for input parameters stopifnot(by>0)
stopifnot(inherits(p,"spp")) r<-seq(by,upto,by)
stopifnot(p$type=="multivariate") tmax<-length(r)
stopifnot(is.numeric(upto)) if(missing(marks))
stopifnot(is.numeric(by)) marks<-c(1,2)
stopifnot(by>0) stopifnot(length(marks)==2)
r<-seq(by,upto,by) stopifnot(marks[1]!=marks[2])
tmax<-length(r) mark1<-marks[1]
if(missing(marks)) mark2<-marks[2]
marks<-c(1,2) if(is.numeric(mark1))
stopifnot(length(marks)==2) mark1<-levels(p$marks)[testInteger(mark1)]
stopifnot(marks[1]!=marks[2]) else if(!mark1%in%p$marks) stop(paste("mark \'",mark1,"\' doesn\'t exist",sep=""))
mark1<-marks[1] if(is.numeric(mark2))
mark2<-marks[2] mark2<-levels(p$marks)[testInteger(mark2)]
if(is.numeric(mark1)) else if(!mark2%in%p$marks) stop(paste("mark \'",mark2,"\' doesn\'t exist",sep=""))
mark1<-levels(p$marks)[testInteger(mark1)] # initializing variables
else if(!mark1%in%p$marks) stop(paste("mark \'",mark1,"\' doesn\'t exist",sep="")) if("rectangle"%in%p$window$type) {
if(is.numeric(mark2)) cas<-1
mark2<-levels(p$marks)[testInteger(mark2)] xmin<-p$window$xmin
else if(!mark2%in%p$marks) stop(paste("mark \'",mark2,"\' doesn\'t exist",sep="")) xmax<-p$window$xmax
# initializing variables ymin<-p$window$ymin
if("rectangle"%in%p$window$type) { ymax<-p$window$ymax
cas<-1 stopifnot(upto<=(0.5*max((xmax-xmin),(ymax-ymin))))
xmin<-p$window$xmin if ("complex"%in%p$window$type) {
xmax<-p$window$xmax cas<-3
ymin<-p$window$ymin tri<-p$window$triangles
ymax<-p$window$ymax nbTri<-nrow(tri)
stopifnot(upto<=(0.5*max((xmax-xmin),(ymax-ymin)))) }
if ("complex"%in%p$window$type) { }
cas<-3 else if("circle"%in%p$window$type) {
tri<-p$window$triangles cas<-2
nbTri<-nrow(tri) x0<-p$window$x0
} y0<-p$window$y0
} r0<-p$window$r0
else if("circle"%in%p$window$type) { stopifnot(upto<=r0)
cas<-2 if ("complex"%in%p$window$type) {
x0<-p$window$x0 cas<-4
y0<-p$window$y0 tri<-p$window$triangles
r0<-p$window$r0 nbTri<-nrow(tri)
stopifnot(upto<=r0) }
if ("complex"%in%p$window$type) { }
cas<-4 else
tri<-p$window$triangles stop("invalid window type")
nbTri<-nrow(tri) surface<-area.swin(p$window)
} x1<-p$x[p$marks==mark1]
} y1<-p$y[p$marks==mark1]
else x2<-p$x[p$marks==mark2]
stop("invalid window type") y2<-p$y[p$marks==mark2]
surface<-area.swin(p$window) nbPts1<-length(x1)
x1<-p$x[p$marks==mark1] nbPts2<-length(x2)
y1<-p$y[p$marks==mark1] intensity2<-nbPts2/surface
x2<-p$x[p$marks==mark2] #computing intertype local functions
y2<-p$y[p$marks==mark2] if(cas==1) { #rectangle
nbPts1<-length(x1) res<-.C("intertypelocal_rect",
nbPts2<-length(x2) as.integer(nbPts1),as.double(x1),as.double(y1),
intensity2<-nbPts2/surface as.integer(nbPts2),as.double(x2),as.double(y2),
#computing intertype local functions as.double(xmin),as.double(xmax),as.double(ymin),as.double(ymax),
if(cas==1) { #rectangle as.integer(tmax),as.double(by),
res<-.C("intertypelocal_rect", gi=double(nbPts1*tmax),ki=double(nbPts1*tmax),
as.integer(nbPts1),as.double(x1),as.double(y1), PACKAGE="ads")
as.integer(nbPts2),as.double(x2),as.double(y2), }
as.double(xmin),as.double(xmax),as.double(ymin),as.double(ymax), else if(cas==2) { #circle
as.integer(tmax),as.double(by), res<-.C("intertypelocal_disq",
gi=double(nbPts1*tmax),ki=double(nbPts1*tmax), as.integer(nbPts1),as.double(x1),as.double(y1),
PACKAGE="ads") as.integer(nbPts2),as.double(x2),as.double(y2),
} as.double(x0),as.double(y0),as.double(r0),
else if(cas==2) { #circle as.integer(tmax),as.double(by),
res<-.C("intertypelocal_disq", gi=double(nbPts1*tmax),ki=double(nbPts1*tmax),
as.integer(nbPts1),as.double(x1),as.double(y1), PACKAGE="ads")
as.integer(nbPts2),as.double(x2),as.double(y2), }
as.double(x0),as.double(y0),as.double(r0), else if(cas==3) { #complex within rectangle
as.integer(tmax),as.double(by), res<-.C("intertypelocal_tr_rect",
gi=double(nbPts1*tmax),ki=double(nbPts1*tmax), as.integer(nbPts1),as.double(x1),as.double(y1),
PACKAGE="ads") as.integer(nbPts2),as.double(x2),as.double(y2),
} as.double(xmin),as.double(xmax),as.double(ymin),as.double(ymax),
else if(cas==3) { #complex within rectangle 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),
res<-.C("intertypelocal_tr_rect", as.integer(tmax),as.double(by),
as.integer(nbPts1),as.double(x1),as.double(y1), gi=double(nbPts1*tmax),ki=double(nbPts1*tmax),
as.integer(nbPts2),as.double(x2),as.double(y2), PACKAGE="ads")
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), else if(cas==4) { #complex within circle
as.integer(tmax),as.double(by), res<-.C("intertypelocal_tr_disq",
gi=double(nbPts1*tmax),ki=double(nbPts1*tmax), as.integer(nbPts1),as.double(x1),as.double(y1),
PACKAGE="ads") as.integer(nbPts2),as.double(x2),as.double(y2),
} as.double(x0),as.double(y0),as.double(r0),
else if(cas==4) { #complex within circle 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),
res<-.C("intertypelocal_tr_disq", as.integer(tmax),as.double(by),
as.integer(nbPts1),as.double(x1),as.double(y1), gi=double(nbPts1*tmax),ki=double(nbPts1*tmax),
as.integer(nbPts2),as.double(x2),as.double(y2), PACKAGE="ads")
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), # formatting results
as.integer(tmax),as.double(by), ds<-c(pi,diff(pi*r^2))
gi=double(nbPts1*tmax),ki=double(nbPts1*tmax), gi<-matrix(res$gi/(intensity2*ds),nrow=nbPts1,ncol=tmax,byrow=TRUE)
PACKAGE="ads") ni<-matrix(res$ki/(pi*r^2),nrow=nbPts1,ncol=tmax,byrow=TRUE)
} ki<-matrix(res$ki/intensity2,nrow=nbPts1,ncol=tmax,byrow=TRUE)
# formatting results li<-matrix(sqrt(res$ki/(intensity2*pi))-r,nrow=nbPts1,ncol=tmax,byrow=TRUE)
#coord<-matrix(c(x1,y1),nrow=nbPts1,ncol=2) call<-match.call()
#coord<-data.frame(x1=x1,y1=y1) 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))
#r<-seq(dr,dr*tmax,dr) class(res)<-c("vads","k12val")
#ds<-pi*r^2-pi*seq(0,dr*tmax-dr,dr)^2 return(res)
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)
}
src/Zlibs.h
+ 80
− 168
View file @ 2f2ebbb7
double un_point(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_disq(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_rect(int*,double*,double*,double*,double*,double*,double*,double*,int*,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 corr_tr_disq(int*,double*,double*,double*,double*,double*,double*,int*,double*,double*,double*,double*,double*,double*,int*,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_rect(int*,double*,double*,double*,double*,double*,double*,double*,int*,double*,double*,double*,double*,double*,double*,int*,double*,double*,double*);
int density_disq(int*,double*,double*,double*,double*,double*,int*,double*,double*,double*,int*,double*);
int density_rect(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 density_tr_rect(int*,double*,double*,double*,double*,double*,double*,int*,double*,double*,double*,double*,double*,double*,int*,double*,double*,double*,int*,double*);
double deux_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); double deuxbord_point(double,double,double,double,double,double,double,double,double);
double deuxun_point(double,double,double,double,double,double,double,double,double);
double echange_point_disq(int,double*,double*,double,double,double,double,double,double,double*,int*,double*,double*,double*);
double echange_point_rect(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*);
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*);
void ic(int,int,double**,double**,double*,double*,int);
int in_droite(double,double,double,double,double,double,double,double,int); int in_droite(double,double,double,double,double,double,double,double,int);
int in_triangle(double,double,double,double,double,double,double,double,int); int in_triangle(double,double,double,double,double,double,double,double,int);
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*);
void ic(int,int,double **,double **,double *,double *,int); int intertype_disq(int*,double*,double*,int*,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*);
double perim_in_rect(double, double, double, double, double, double, double); int intertype_rect(int*,double*,double*,int*,double*,double*,double*,double*,double*,double*,int*,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 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_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_rect(int*,double*,double*,int*,double*,double*,double*,double*,double*,double*,int*,double*,double*,double*,double*,double*,double*,int*,double*,double*,double*);
int intertype(int*,double*,double*,int*,double*,double*,int*,double*,double*,double*);
int intertypelocal_disq(int*,double*,double*,int*,double*,double*,double*,double*,double*,int*,double*,double*,double*);
int intertypelocal_rect(int*,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*);
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 mimetic_disq(int*,double*,double*,double*,double*,double*,double*,double*,int*,double*,double*,int*,int*,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_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*);
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*);
double perim_in_disq(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 *); double perim_in_rect(double,double,double,double,double,double,double);
double perim_triangle(double,double,double,int,double*,double*,double*,double*,double*,double*);
int randlabelling(double*,double*,int,double*,double*,int,double*,double*,int*);
void randmark(int ,double*,double*);
int randomdist(int*,int,double*,double*);
int randomlab(double*,double*,int,int*,int,double**,int*,double**);
int randshifting_disq(int*,double*,double*,int,double*,double*,double,double,double,double);
int randshifting_rect(int*,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 randshifting_tr_rect(int*,double*,double*,int,double*,double*,double,double,double,double,int,double*,double*,double*,double*,double*,double*,double);
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_disq(int*,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_rect(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 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_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_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 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_disq(int*,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_rect(int*,double*,double*,double*,double*,double*,double*,int*,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_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 ripley_tr_rect(int *,double *,double *,double *,double *,double *,double *,int *,double *,double *, int ripley_tr_disq(int*,double*,double*,double*,double*,double*,int*,double*,double*,double*,double*,double*,double*,int*,double*,double*,double*);
double *,double *,double *,double *,int *,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(int *,double *,double *,double *,double *,double *,int *,double *,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*);
double *,double *,int *,double *,double *,double *); int ripleylocal_disq(int*,double*,double*,double*,double*,double*,int*,double*,double*,double*);
int ripleylocal_rect(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 *, int ripleylocal_tr_disq(int*,double*,double*,double*,double*,double*,int*,double*,double*,double*,double*,double*,double*,int*,double*,double*,double*);
double *,double *,double *,double *,double *,double *,double *,double *,double *,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 ripley_disq_ic(int *,double *,double *,double *,double *,double *,double *,int *,double *,int *,double *, void s_alea_disq(int,double*,double*,double,double,double,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_rect(int,double[],double[],double,double,double,double,double);
void s_alea_disq(int,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);
void s_alea_tr_rect(int,double *,double *,double,double,double,double,int,double *,double *,double *,double *, void s_alea_tr_rect(int,double*,double*,double,double,double,double,int,double*,double*,double*,double*,double*,double*,double);
double *,double *,double); int shen_ic(int*,double*,double*,int*,double*,int*,double*,int*,int*,double*,double*,double*,double*,double*,double*,double*,double*,double*,double*,double*,int*);
void s_alea_tr_disq(int ,double *,double *,double,double,double,int,double *,double *,double *,double *, int shen(int*,double*,double*,int*,double*,int*,int*,double*,double*,double*,double*,double*,int*);
double *,double *,double); 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_disq(int*,double*,double*,double*,double*,double*,int*,double*,int*,int*,double*,double*,double*,int*);
int randlabelling(double *, double *, int, double *, double *,int, 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 randshifting_rect(int *,double *,double *,int,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 randshifting_disq(int *,double *,double *,int,double *,double *,double,double,double,double); 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 randshifting_tr_rect(int *,double *,double *,int,double *,double *,double,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*);
double *,double *,double *,double *,double *,double *,double); 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 randshifting_tr_disq(int *,double *,double *,int,double *,double *,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*);
double *,double *,double *,double *,double *,double *,double); double trois_point(double,double,double,double,double,double,double,double,double);
int randomlab(double *,double *,int,int *,int,double **,int *,double **); double un_point(double,double,double,double,double,double,double,double,double);
void randmark(int ,double *,double *); double ununun_point(double,double,double,double,double,double,double,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 *);
src/adssub.h
+ 23
− 28
View file @ 2f2ebbb7
...@@ -3,31 +3,26 @@ ...@@ -3,31 +3,26 @@
#include <limits.h> #include <limits.h>
#include <R_ext/PrtUtil.h> #include <R_ext/PrtUtil.h>
double Pi(); double bacos(double);
void progress(int,int*, int); void complete_tab(int,double**,double**,int*,int*,int*,double*,double*);
/*double alea ();*/ void decalCirc(int,double*,double*,double*,double*,double);
void freeintvec (int *); void decalCirc2(int,double*,double*,int,double*,double*,double*,double*,double);
void freetab (double **); void decalCircTri(int,double*,double*,double*,double*,double, int,double*,double*,double*,double*,double*,double*);
void freevec (double *); void decalCircTri2(int,double*,double*,int,double*,double*,double*,double*,double,int,double*,double*,double*,double*,double*,double*);
void taballoc (double ***,int,int); void decalRect(int,double*,double*,double*,double*,double*,double*);
void tabintalloc (int ***,int,int); void decalRect2(int,double*,double*,int,double*,double*,double*,double*,double*,double*);
void freeinttab (int **); void decalRectTri(int,double*,double*,double*,double*,double*,double*, int,double*,double*,double*,double*,double*,double*);
void vecalloc (double **vec, int n); void decalRectTri2(int,double*,double*,int,double*,double*,double*,double*,double*,double*, int,double*,double*,double*,double*,double*,double*);
void vecintalloc (int **vec, int n); void decalSample(int,double*,double*,double,double);
double bacos(double a); void decalVal(double*,int,double);
void decalVal(double *,int,double); void freeinttab(int**);
void decalRect(int,double *,double *,double *,double *,double *,double *); void freeintvec(int*);
void decalCirc(int,double *,double *,double *,double *,double); void freetab(double**);
void decalRectTri(int,double *,double *,double *,double *,double *,double *, void freevec(double*);
int,double *,double *,double *,double *,double *,double *); double Pi();
void decalCircTri(int,double *,double *,double *,double *,double, void progress(int,int*,int);
int,double *,double *,double *,double *,double *,double *); void taballoc(double***,int,int);
void decalRect2(int,double *,double *,int,double *,double *,double *,double *,double *,double *); double** taballoca(int,int*);
void decalCirc2(int,double *,double *,int,double *,double *,double *,double *,double); void tabintalloc(int***,int,int);
void decalRectTri2(int,double *,double *,int,double *,double *,double *,double *,double *,double *, void vecalloc(double**,int);
int,double *,double *,double *,double *,double *,double *); void vecintalloc(int**,int);
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 *);
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment