[Stpp-commits] r27 - in pkg: R man
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Fri Feb 12 15:47:25 CET 2010
Author: gabriele
Date: 2010-02-12 15:47:25 +0100 (Fri, 12 Feb 2010)
New Revision: 27
Modified:
pkg/R/animation.r
pkg/R/rinfec.r
pkg/R/rinter.r
pkg/R/rlgcp.r
pkg/R/rpcp.r
pkg/R/rpp.r
pkg/R/stani.R
pkg/man/rinfec.Rd
pkg/man/rinter.Rd
pkg/man/rlgcp.Rd
pkg/man/rpcp.Rd
pkg/man/rpp.Rd
Log:
Modified: pkg/R/animation.r
===================================================================
--- pkg/R/animation.r 2010-02-11 10:45:50 UTC (rev 26)
+++ pkg/R/animation.r 2010-02-12 14:47:25 UTC (rev 27)
@@ -1,4 +1,4 @@
-animation <- function(xyt, s.region, t.region, runtime=1, incident="red", prevalent="pink3", pch=19, cex=0.5, plot.s.region=T, scales=T, border.frac=0.05, add=F)
+animation <- function(xyt, s.region, t.region, runtime=1, incident="red", prevalent="pink3", pch=19, cex=0.5, plot.s.region=TRUE, scales=TRUE, border.frac=0.05, add=FALSE)
{
#
# Description:
@@ -40,14 +40,15 @@
npts<-length(tt)
T0 <- max(t.region)
- if (add==F)
+ if (add==FALSE)
{
- if (scales==F)
+ par(pty="s",mfrow=c(1,1))
+ if (scales==FALSE)
plot(xy[,1],xy[,2],type="n",xlim=xlim,ylim=ylim,xaxt="n",yaxt="n",bty="n",xlab=" ",ylab=" ")
- if (scales==T)
+ if (scales==TRUE)
plot(sxyt[,1],sxyt[,2],type="n",xlim=xlim,ylim=ylim,bty="n",xlab="X",ylab="Y")
- if (plot.s.region==T)
- polymap(as.points(s.region),add=T,lwd=2)
+ if (plot.s.region==TRUE)
+ polymap(as.points(s.region),add=TRUE,lwd=2)
}
nplotted<-0
tt.now<-0
Modified: pkg/R/rinfec.r
===================================================================
--- pkg/R/rinfec.r 2010-02-11 10:45:50 UTC (rev 26)
+++ pkg/R/rinfec.r 2010-02-12 14:47:25 UTC (rev 27)
@@ -349,12 +349,12 @@
dimnames(pattern.interm) <- list(NULL,c("x","y","t"))
if (nsim==1)
{
- pattern <- pattern.interm
+ pattern <- as.3dpoints(pattern.interm)
ni <- ni+1
}
else
{
- pattern[[ni]] <- pattern.interm
+ pattern[[ni]] <- as.3dpoints(pattern.interm)
ni <- ni+1
}
}
Modified: pkg/R/rinter.r
===================================================================
--- pkg/R/rinter.r 2010-02-11 10:45:50 UTC (rev 26)
+++ pkg/R/rinter.r 2010-02-12 14:47:25 UTC (rev 27)
@@ -57,12 +57,12 @@
if (nsim==1)
{
- pattern <- cbind(pattern.interm,times.interm)
+ pattern <- as.3dpoints(cbind(pattern.interm,times.interm))
ni <- ni+1
}
else
{
- pattern[[ni]] <- cbind(pattern.interm,times.interm)
+ pattern[[ni]] <- as.3dpoints(cbind(pattern.interm,times.interm))
ni <- ni+1
}
}
Modified: pkg/R/rlgcp.r
===================================================================
--- pkg/R/rlgcp.r 2010-02-11 10:45:50 UTC (rev 26)
+++ pkg/R/rlgcp.r 2010-02-12 14:47:25 UTC (rev 27)
@@ -205,13 +205,13 @@
if (nsim==1)
{
- pattern <- pattern.interm
+ pattern <- as.3dpoints(pattern.interm)
index.t <- index.times
Lambdafin <- Lambda
}
else
{
- pattern[[ni]] <- pattern.interm
+ pattern[[ni]] <- as.3dpoints(pattern.interm)
index.t[[ni]] <- index.times
Lambdafin[[ni]] <- Lambda
}
Modified: pkg/R/rpcp.r
===================================================================
--- pkg/R/rpcp.r 2010-02-11 10:45:50 UTC (rev 26)
+++ pkg/R/rpcp.r 2010-02-12 14:47:25 UTC (rev 27)
@@ -1,114 +1,114 @@
-rpcp <- function(s.region, t.region, nparents=NULL, npoints=NULL, lambda=NULL, mc=NULL, nsim=1, cluster="uniform", maxrad, infectious=TRUE, edge = "larger.region", ...)
-{
- #
- # Simulate a space-time Poisson cluster process in a region D x T.
- # Children are simulated within a cylinder defined around the parent.
- #
- # Requires Splancs package.
- #
- # Arguments:
- #
- # s.region: two columns matrix specifying polygonal region containing
- # all data locations. If s.region is missing, the unit square
- # is considered.
- #
- # t.region: vector containing the minimum and maximum values of
- # the time interval.
- #
- # nparents: number of parents. If missing, nparents is from a
- # Poisson distribution with intensity lambda.
- #
- # npoints: number of points to simulate. If NULL (default), the
- # number of points is from a Poisson distribution with
- # mean the double integral of lambda over s.region and
- # t.region.
- #
- # lambda: intensity of the parent process. Can be either a numeric
- # value or a function. If NULL, it is constant and equal
- # to nparents / volume of the domain.
- #
- # mc: average number of children per parent. It is used when
- # npoints is NULL.
- #
- # nsim: number of simulations to generate. Default is 1.
- #
- # cluster: distribution of children. "uniform", "normal" and
- # exponential are currently implemented.
- # Either a single value if the distribution in space
- # and time is the same, or a vector of length 2, given
- # first the spatial distribution of children and then
- # the temporal distribution.
- #
- # maxrad: vector of length 2 giving the maximum spatial and temporal
- # variation of the offspring.
- # maxrads = maximum distance between parent and child (radius of
- # a circle centred at the parent).
- # maxradt = maximum time separiting parent and child.
- # For a normal distribution of children, maxrad corresponds to
- # the 2 * standard deviation of location of children relative
- # to their parent, such that children lies in the 95% IC
- # of the normal distribution.
- #
- # infectious: If TRUE (default), corresponds to infectious diseases
- # (times of children are always greater than parent's time).
- #
- # edge: specify the edge correction to use, "weight", "larger.region",
- # "without".
- #
- # ...: additional parameters of the intensity of the parent process.
- #
- # Value:
- # xyt: matrix (or list of matrix if nsim>1) containing the points (x,y,t)
- # of the simulated point process.
- #
-
-
- if (missing(cluster)) cluster <- "uniform"
-
- if (missing(s.region)) s.region <- matrix(c(0,0,1,1,0,1,1,0),ncol=2)
- if (missing(t.region)) t.region <- c(0,1)
-
- if (missing(maxrad)) maxrad <- c(0.05,0.05)
- maxrads <- maxrad[1]
- maxradt <- maxrad[2]
-
- if (length(cluster)==1)
- {
- s.distr <- cluster
- t.distr <- cluster
- }
- else
- {
- s.distr <- cluster[1]
- t.distr <- cluster[2]
- }
-
- t.region <- sort(t.region)
- s.area <- areapl(s.region)
- t.area <- t.region[2]-t.region[1]
- pattern <- list()
-
- ni <- 1
-
- while(ni<=nsim)
- {
- if (edge=="larger.region")
- pattern.interm <- pcp.larger.region(s.region=s.region, t.region=t.region, nparents=nparents, npoints=npoints, lambda=lambda, mc=mc, cluster=cluster, maxrad=maxrad, infecD=infectious, ...)$pts
-
- if (edge=="without")
- pattern.interm <- pcp.larger.region(s.region=s.region, t.region=t.region, nparents=nparents, npoints=npoints, lambda=lambda, mc=mc, cluster=cluster, maxrad=maxrad, infecD=infectious, maxradlarger=c(0,0), ...)$pts
-
- if (nsim==1)
- pattern <- pattern.interm
- else
- pattern[[ni]] <- pattern.interm
-
- ni <- ni+1
- }
-
- invisible(return(list(xyt=pattern,s.region=s.region,t.region=t.region)))
-}
-
-
-
-
+rpcp <- function(s.region, t.region, nparents=NULL, npoints=NULL, lambda=NULL, mc=NULL, nsim=1, cluster="uniform", maxrad, infectious=TRUE, edge = "larger.region", ...)
+{
+ #
+ # Simulate a space-time Poisson cluster process in a region D x T.
+ # Children are simulated within a cylinder defined around the parent.
+ #
+ # Requires Splancs package.
+ #
+ # Arguments:
+ #
+ # s.region: two columns matrix specifying polygonal region containing
+ # all data locations. If s.region is missing, the unit square
+ # is considered.
+ #
+ # t.region: vector containing the minimum and maximum values of
+ # the time interval.
+ #
+ # nparents: number of parents. If missing, nparents is from a
+ # Poisson distribution with intensity lambda.
+ #
+ # npoints: number of points to simulate. If NULL (default), the
+ # number of points is from a Poisson distribution with
+ # mean the double integral of lambda over s.region and
+ # t.region.
+ #
+ # lambda: intensity of the parent process. Can be either a numeric
+ # value or a function. If NULL, it is constant and equal
+ # to nparents / volume of the domain.
+ #
+ # mc: average number of children per parent. It is used when
+ # npoints is NULL.
+ #
+ # nsim: number of simulations to generate. Default is 1.
+ #
+ # cluster: distribution of children. "uniform", "normal" and
+ # exponential are currently implemented.
+ # Either a single value if the distribution in space
+ # and time is the same, or a vector of length 2, given
+ # first the spatial distribution of children and then
+ # the temporal distribution.
+ #
+ # maxrad: vector of length 2 giving the maximum spatial and temporal
+ # variation of the offspring.
+ # maxrads = maximum distance between parent and child (radius of
+ # a circle centred at the parent).
+ # maxradt = maximum time separiting parent and child.
+ # For a normal distribution of children, maxrad corresponds to
+ # the 2 * standard deviation of location of children relative
+ # to their parent, such that children lies in the 95% IC
+ # of the normal distribution.
+ #
+ # infectious: If TRUE (default), corresponds to infectious diseases
+ # (times of children are always greater than parent's time).
+ #
+ # edge: specify the edge correction to use, "weight", "larger.region",
+ # "without".
+ #
+ # ...: additional parameters of the intensity of the parent process.
+ #
+ # Value:
+ # xyt: matrix (or list of matrix if nsim>1) containing the points (x,y,t)
+ # of the simulated point process.
+ #
+
+
+ if (missing(cluster)) cluster <- "uniform"
+
+ if (missing(s.region)) s.region <- matrix(c(0,0,1,1,0,1,1,0),ncol=2)
+ if (missing(t.region)) t.region <- c(0,1)
+
+ if (missing(maxrad)) maxrad <- c(0.05,0.05)
+ maxrads <- maxrad[1]
+ maxradt <- maxrad[2]
+
+ if (length(cluster)==1)
+ {
+ s.distr <- cluster
+ t.distr <- cluster
+ }
+ else
+ {
+ s.distr <- cluster[1]
+ t.distr <- cluster[2]
+ }
+
+ t.region <- sort(t.region)
+ s.area <- areapl(s.region)
+ t.area <- t.region[2]-t.region[1]
+ pattern <- list()
+
+ ni <- 1
+
+ while(ni<=nsim)
+ {
+ if (edge=="larger.region")
+ pattern.interm <- pcp.larger.region(s.region=s.region, t.region=t.region, nparents=nparents, npoints=npoints, lambda=lambda, mc=mc, cluster=cluster, maxrad=maxrad, infecD=infectious, ...)$pts
+
+ if (edge=="without")
+ pattern.interm <- pcp.larger.region(s.region=s.region, t.region=t.region, nparents=nparents, npoints=npoints, lambda=lambda, mc=mc, cluster=cluster, maxrad=maxrad, infecD=infectious, maxradlarger=c(0,0), ...)$pts
+
+ if (nsim==1)
+ pattern <- as.3dpoints(pattern.interm)
+ else
+ pattern[[ni]] <- as.3dpoints(pattern.interm)
+
+ ni <- ni+1
+ }
+
+ invisible(return(list(xyt=pattern,s.region=s.region,t.region=t.region)))
+}
+
+
+
+
Modified: pkg/R/rpp.r
===================================================================
--- pkg/R/rpp.r 2010-02-11 10:45:50 UTC (rev 26)
+++ pkg/R/rpp.r 2010-02-12 14:47:25 UTC (rev 27)
@@ -82,12 +82,12 @@
hpp <- rhpp(lambda=lambda, s.region=s.region, t.region=t.region, npoints=npoints, replace=replace, discrete.time=discrete.time)
if (nsim==1)
{
- pattern <- hpp$pts
+ pattern <- as.3dpoints(hpp$pts)
index.t <- hpp$index.t
}
else
{
- pattern[[ni]] <- hpp$pts
+ pattern[[ni]] <- as.3dpoints(hpp$pts)
index.t[[ni]] <- hpp$index.t
}
ni <- ni+1
@@ -140,12 +140,12 @@
if (nsim==1)
{
- pattern <- ipp$pts
+ pattern <- as.3dpoints(ipp$pts)
index.t <- ipp$index.t
}
else
{
- pattern[[ni]] <- ipp$pts
+ pattern[[ni]] <- as.3dpoints(ipp$pts)
index.t[[ni]] <- ipp$index.t
}
ni <- ni+1
@@ -160,12 +160,12 @@
if (nsim==1)
{
- pattern <- ipp$pts
+ pattern <- as.3dpoints(ipp$pts)
index.t <- ipp$index.t
}
else
{
- pattern[[ni]] <- ipp$pts
+ pattern[[ni]] <- as.3dpoints(ipp$pts)
index.t[[ni]] <- ipp$index.t
}
ni <- ni+1
Modified: pkg/R/stani.R
===================================================================
--- pkg/R/stani.R 2010-02-11 10:45:50 UTC (rev 26)
+++ pkg/R/stani.R 2010-02-12 14:47:25 UTC (rev 27)
@@ -1,189 +1,189 @@
-
-.listmerge = function (x, y, ...)
-{
-### taken from RCurl
- if (length(x) == 0)
- return(y)
- if (length(y) == 0)
- return(x)
- i = match(names(y), names(x))
- i = is.na(i)
- if (any(i))
- x[names(y)[which(i)]] = y[which(i)]
- x
-}
-
-
-.stan3d.redraw <- function(o) {
- ## switch off redraws
- par3d(skipRedraw=TRUE)
- np=dim(o$xyt)[1]
-
- ## compute new states
- tin = rep(1,np)
- tin[o$xyt[,3]>(o$t-o$width)]=2
- tin[o$xyt[,3]>o$t]=3
-
- ## which points have changed state since last time?
- changed = tin != o$xyt[,5]
-
- ## remove any that changed
- if(any(changed)){
- rgl.pop(id=o$xyt[changed,4])
- }
-
- ## now add them back in their correct state:
- for(i in (1:np)[changed]){
-
-### should be as simple as this:
-### material3d(o$states[[tin[i]]])
-### but setting alpha is causing problems. Bug reported. Hence:
-
- sphereList = list(x=o$xyt[i,1],y=o$xyt[i,2],z=o$xyt[i,3],radius=o$states[[tin[i]]]$radius)
- materialList = o$states[[tin[i]]]
- pList = .listmerge(sphereList,materialList)
- o$xyt[i,4]=do.call(spheres3d,pList)
-
- o$xyt[i,5]=tin[i]
- }
- ## start drawing again:
- par3d(skipRedraw=FALSE)
-
- ## update the slider positions
- .store(o)
-
- ## and return the modified object:
- return(o)
-}
-
-.rp.stan3d <- function(xyt,tlim,twid,states) {
- t=tlim[1];width=twid
- e=new.env()
- stan.panel <- rp.control(title="space-time animation",
- xyt=xyt, t=tlim[1], width=twid,
- states=states,
- e=e
- )
- rp.slider(stan.panel, t, title = "time", from=tlim[1], to=tlim[2], action = .stan3d.redraw,showvalue=TRUE)
- rp.slider(stan.panel, width, title = "window", from=0, to=diff(tlim), action = .stan3d.redraw,showvalue=TRUE)
- rp.button(stan.panel,action=function(p){par3d(FOV=0,userMatrix = rotationMatrix(0, 1,0,0));return(p)},title="reset axes")
- rp.button(stan.panel,action=.store,title="quit",quitbutton=TRUE)
- rp.do(stan.panel, .stan3d.redraw)
- rp.block(stan.panel)
- return(e)
-}
-
-.store = function(panel){
- assign("t",panel$t,env=panel$e)
- assign("width",panel$width,env=panel$e)
- return(panel)
-}
-
-stani <- function(xyt,tlim=range(xyt[,3],na.rm=TRUE),twid=diff(tlim)/20,persist=FALSE,states,bgpoly,bgframe=TRUE,bgimage,bgcol=gray(seq(0,1,len=12))){
- require(rgl)
- require(rpanel)
- if(missing(states)){
- ## default colouring scheme:
- states=list(
- past=list(col="blue",radius=1/80,alpha=0.5,lit=FALSE),
- present=list(col="red",radius=1/30,alpha=0.5,lit=FALSE),
- ## still-to-come points are invisible (alpha=0)
- future=list(col="yellow",alpha=0.0,radius=1/80,lit=FALSE)
- )
- if(persist){
- states$past=states$present
- }
- }
-
- maxRadius = max(states$past$radius,states$present$radius,states$future$radius)
- xr = range(xyt[,1],na.rm=TRUE)
- yr = range(xyt[,2],na.rm=TRUE)
- tr = range(xyt[,3],na.rm=TRUE)
- diag=sqrt(diff(xr)^2+diff(yr)^2+diff(tr)^2)
-
- states$past$radius=states$past$radius*diag
- states$present$radius=states$present$radius*diag
- states$future$radius=states$future$radius*diag
-
- .setPlot(xr[1],xr[2],yr[1],yr[2],tr[1],tr[2],maxRadius)
-
- if(!missing(bgpoly)){
- poly=rbind(bgpoly,bgpoly[1,])
- poly=cbind(poly,min(tr))
- lines3d(poly,size=2.0)
- if(bgframe){
- ci=chull(bgpoly)
- nci=length(ci)
- cpoints=bgpoly[ci,]
- cpoints2 = cpoints[rep(1:nci,rep(2,nci)),]
- cpoints2 = cbind(cpoints2,c(min(tr),max(tr)))
- segments3d(cpoints2)
- poly=cbind(poly[,1:2],max(tr))
- lines3d(poly,size=2.0)
- }
- }
-
- if(!missing(bgimage)){
- .setBG(bgimage,min(tr),col=bgcol)
- }
-
- xyt=data.frame(xyt)
- xyt$id=NA
- ## initially all points will need redrawing:
- xyt$state=-1
-
-
- ## these points will get redrawn immediately... probably a better way to do this:
- cat("Setting up...")
- npts = dim(xyt)[1]
- if(npts>=100){
- tenths = as.integer(seq(1,npts,len=10))
- }
-
- for(i in 1:(dim(xyt)[1])){
- if(npts>=100){
- tn = (1:10)[tenths == i]
- if(length(tn)>0){
- cat(paste(11-tn,"...",sep=""))
- }
- }
- xyt[i,4]=points3d(xyt[i,1,drop=FALSE],xyt[i,2,drop=FALSE],xyt[i,3,drop=FALSE],alpha=0.0)
- }
- cat("...done\n")
- env = .rp.stan3d(xyt,tlim,twid,states)
- ret=list()
- for(n in ls(env)){
- ret[[n]]=get(n,env=env)
- }
- return(ret)
-}
-
-.ranger <- function(x,margin=0.2){
- lim=range(x,na.rm=TRUE)
- lim=lim+c(-margin,margin)*diff(lim)
- return(lim)
-}
-
-.setPlot=function(xmin,xmax,ymin,ymax,tmin,tmax,radius=1/20){
- require(rgl)
- diag=sqrt((xmax-xmin)^2+(ymax-ymin)^2+(tmax-tmin)^2)
- xr=c(xmax,xmin)+c(radius*(xmax-xmin),-radius*(xmax-xmin))*2
- yr=c(ymax,ymin)+c(radius*(ymax-ymin),-radius*(ymax-ymin))*2
- tr=c(tmax,tmin)+c(radius*(tmax-tmin),-radius*(tmax-tmin))*2
-
-
- plot3d(xr,yr,tr,type="n",col="red",box=TRUE,axes=FALSE,xlab="x",ylab="y",zlab="t")
- axis3d('x-',tick=FALSE)
- axis3d('y-',tick=FALSE)
- axis3d('z-')
- par3d(FOV=0)
- AR=(xmax-xmin)/(ymax-ymin)
- aspect3d(AR,1,1)
- par3d(userMatrix = rotationMatrix(0, 1,0,0))
-
-}
-
-.setBG=function(xyz,zplane,col=heat.colors(12)){
- cols = col[as.integer(cut(xyz$z,length(col)))]
- surface3d(xyz$x,xyz$y,rep(zplane,prod(dim(xyz$z))),col=cols,lit=FALSE)
-}
+
+.listmerge = function (x, y, ...)
+{
+### taken from RCurl
+ if (length(x) == 0)
+ return(y)
+ if (length(y) == 0)
+ return(x)
+ i = match(names(y), names(x))
+ i = is.na(i)
+ if (any(i))
+ x[names(y)[which(i)]] = y[which(i)]
+ x
+}
+
+
+.stan3d.redraw <- function(o) {
+ ## switch off redraws
+ par3d(skipRedraw=TRUE)
+ np=dim(o$xyt)[1]
+
+ ## compute new states
+ tin = rep(1,np)
+ tin[o$xyt[,3]>(o$t-o$width)]=2
+ tin[o$xyt[,3]>o$t]=3
+
+ ## which points have changed state since last time?
+ changed = tin != o$xyt[,5]
+
+ ## remove any that changed
+ if(any(changed)){
+ rgl.pop(id=o$xyt[changed,4])
+ }
+
+ ## now add them back in their correct state:
+ for(i in (1:np)[changed]){
+
+### should be as simple as this:
+### material3d(o$states[[tin[i]]])
+### but setting alpha is causing problems. Bug reported. Hence:
+
+ sphereList = list(x=o$xyt[i,1],y=o$xyt[i,2],z=o$xyt[i,3],radius=o$states[[tin[i]]]$radius)
+ materialList = o$states[[tin[i]]]
+ pList = .listmerge(sphereList,materialList)
+ o$xyt[i,4]=do.call(spheres3d,pList)
+
+ o$xyt[i,5]=tin[i]
+ }
+ ## start drawing again:
+ par3d(skipRedraw=FALSE)
+
+ ## update the slider positions
+ .store(o)
+
+ ## and return the modified object:
+ return(o)
+}
+
+.rp.stan3d <- function(xyt,tlim,twid,states) {
+ t=tlim[1];width=twid
+ e=new.env()
+ stan.panel <- rp.control(title="space-time animation",
+ xyt=xyt, t=tlim[1], width=twid,
+ states=states,
+ e=e
+ )
+ rp.slider(stan.panel, t, title = "time", from=tlim[1], to=tlim[2], action = .stan3d.redraw,showvalue=TRUE)
+ rp.slider(stan.panel, width, title = "window", from=0, to=diff(tlim), action = .stan3d.redraw,showvalue=TRUE)
+ rp.button(stan.panel,action=function(p){par3d(FOV=0,userMatrix = rotationMatrix(0, 1,0,0));return(p)},title="reset axes")
+ rp.button(stan.panel,action=.store,title="quit",quitbutton=TRUE)
+ rp.do(stan.panel, .stan3d.redraw)
+ rp.block(stan.panel)
+ return(e)
+}
+
+.store = function(panel){
+ assign("t",panel$t,env=panel$e)
+ assign("width",panel$width,env=panel$e)
+ return(panel)
+}
+
+stani <- function(xyt,tlim=range(xyt[,3],na.rm=TRUE),twid=diff(tlim)/20,persist=FALSE,states,bgpoly,bgframe=TRUE,bgimage,bgcol=gray(seq(0,1,len=12))){
+ require(rgl)
+ require(rpanel)
+ if(missing(states)){
+ ## default colouring scheme:
+ states=list(
+ past=list(col="blue",radius=1/80,alpha=0.5,lit=FALSE),
+ present=list(col="red",radius=1/30,alpha=0.5,lit=FALSE),
+ ## still-to-come points are invisible (alpha=0)
+ future=list(col="yellow",alpha=0.0,radius=1/80,lit=FALSE)
+ )
+ if(persist){
+ states$past=states$present
+ }
+ }
+
+ maxRadius = max(states$past$radius,states$present$radius,states$future$radius)
+ xr = range(xyt[,1],na.rm=TRUE)
+ yr = range(xyt[,2],na.rm=TRUE)
+ tr = range(xyt[,3],na.rm=TRUE)
+ diag=sqrt(diff(xr)^2+diff(yr)^2+diff(tr)^2)
+
+ states$past$radius=states$past$radius*diag
+ states$present$radius=states$present$radius*diag
+ states$future$radius=states$future$radius*diag
+
+ .setPlot(xr[1],xr[2],yr[1],yr[2],tr[1],tr[2],maxRadius)
+
+ if(!missing(bgpoly)){
+ poly=rbind(bgpoly,bgpoly[1,])
+ poly=cbind(poly,min(tr))
+ lines3d(poly,size=2.0)
+ if(bgframe){
+ ci=chull(bgpoly)
+ nci=length(ci)
+ cpoints=bgpoly[ci,]
+ cpoints2 = cpoints[rep(1:nci,rep(2,nci)),]
+ cpoints2 = cbind(cpoints2,c(min(tr),max(tr)))
+ segments3d(cpoints2)
+ poly=cbind(poly[,1:2],max(tr))
+ lines3d(poly,size=2.0)
+ }
+ }
+
+ if(!missing(bgimage)){
+ .setBG(bgimage,min(tr),col=bgcol)
+ }
+
+ xyt=data.frame(xyt[,1:3])
+ xyt$id=NA
+ ## initially all points will need redrawing:
+ xyt$state=-1
+
+
+ ## these points will get redrawn immediately... probably a better way to do this:
+ cat("Setting up...")
+ npts = dim(xyt)[1]
+ if(npts>=100){
+ tenths = as.integer(seq(1,npts,len=10))
+ }
+
+ for(i in 1:(dim(xyt)[1])){
+ if(npts>=100){
+ tn = (1:10)[tenths == i]
+ if(length(tn)>0){
+ cat(paste(11-tn,"...",sep=""))
+ }
+ }
+ xyt[i,4]=points3d(xyt[i,1,drop=FALSE],xyt[i,2,drop=FALSE],xyt[i,3,drop=FALSE],alpha=0.0)
+ }
+ cat("...done\n")
+ env = .rp.stan3d(xyt,tlim,twid,states)
+ ret=list()
+ for(n in ls(env)){
+ ret[[n]]=get(n,env=env)
+ }
+ return(ret)
+}
+
+.ranger <- function(x,margin=0.2){
+ lim=range(x,na.rm=TRUE)
+ lim=lim+c(-margin,margin)*diff(lim)
+ return(lim)
+}
+
+.setPlot=function(xmin,xmax,ymin,ymax,tmin,tmax,radius=1/20){
+ require(rgl)
+ diag=sqrt((xmax-xmin)^2+(ymax-ymin)^2+(tmax-tmin)^2)
+ xr=c(xmax,xmin)+c(radius*(xmax-xmin),-radius*(xmax-xmin))*2
+ yr=c(ymax,ymin)+c(radius*(ymax-ymin),-radius*(ymax-ymin))*2
+ tr=c(tmax,tmin)+c(radius*(tmax-tmin),-radius*(tmax-tmin))*2
+
+
+ plot3d(xr,yr,tr,type="n",col="red",box=TRUE,axes=FALSE,xlab="x",ylab="y",zlab="t")
+ axis3d('x-',tick=FALSE)
+ axis3d('y-',tick=FALSE)
+ axis3d('z-')
+ par3d(FOV=0)
+ AR=(xmax-xmin)/(ymax-ymin)
+ aspect3d(AR,1,1)
+ par3d(userMatrix = rotationMatrix(0, 1,0,0))
+
+}
+
+.setBG=function(xyz,zplane,col=heat.colors(12)){
+ cols = col[as.integer(cut(xyz$z,length(col)))]
+ surface3d(xyz$x,xyz$y,rep(zplane,prod(dim(xyz$z))),col=cols,lit=FALSE)
+}
Modified: pkg/man/rinfec.Rd
===================================================================
--- pkg/man/rinfec.Rd 2010-02-11 10:45:50 UTC (rev 26)
+++ pkg/man/rinfec.Rd 2010-02-12 14:47:25 UTC (rev 27)
@@ -53,7 +53,9 @@
value{
A list containing:
\item{xyt}{matrix (or list of matrices if \code{nsim}>1)
-containing the points (x,y,t) of the simulated point pattern.}
+containing the points (x,y,t) of the simulated point pattern.
+\code{xyt} (or any element of the list if \code{nsim}>1)) is an object
+of the class \code{stpp}.}
\item{s.region, t.region}{parameters passed in argument.}
}
@@ -79,4 +81,4 @@
inf2 = rinfec(npoints=100, alpha=4, beta=0.6, gamma=20, maxrad=c(12000,20), s.region=northcumbria, t.region=c(1,2000), s.distr="poisson", t.distr="uniform", h="step", p="min", recent=1, lambda=Ls$z, inhibition=FALSE)
image(Ls$x, Ls$y, Ls$z, col=grey((1000:1)/1000)); polygon(northcumbria,lwd=2)
animation(inf2$xyt, add=TRUE, cex=0.7, runtime=15)
-}
\ No newline at end of file
+}
Modified: pkg/man/rinter.Rd
===================================================================
--- pkg/man/rinter.Rd 2010-02-11 10:45:50 UTC (rev 26)
+++ pkg/man/rinter.Rd 2010-02-12 14:47:25 UTC (rev 27)
@@ -48,7 +48,9 @@
value{
A list containing:
\item{xyt}{matrix (or list of matrices if \code{nsim}>1)
-containing the points (x,y,t) of the simulated point pattern.}
+containing the points (x,y,t) of the simulated point pattern.
+\code{xyt} (or any element of the list if \code{nsim}>1)) is an object
+of the class \code{stpp}.}
\item{s.region, t.region}{parameters passed in argument.}
}
Modified: pkg/man/rlgcp.Rd
===================================================================
--- pkg/man/rlgcp.Rd 2010-02-11 10:45:50 UTC (rev 26)
+++ pkg/man/rlgcp.Rd 2010-02-12 14:47:25 UTC (rev 27)
@@ -113,7 +113,9 @@
\value{
A list containing:
\item{xyt}{matrix (or list of matrices if \code{nsim}>1)
-containing the points (x,y,t) of the simulated point pattern.}
+containing the points (x,y,t) of the simulated point pattern.
+\code{xyt} (or any element of the list if \code{nsim}>1)) is an object
+of the class \code{stpp}.}
\item{s.region, t.region}{parameters passed in argument.}
\item{Lambda}{nx * ny * nt array (or list of array if \code{nsim}>1)
of the intensity.}
Modified: pkg/man/rpcp.Rd
===================================================================
--- pkg/man/rpcp.Rd 2010-02-11 10:45:50 UTC (rev 26)
+++ pkg/man/rpcp.Rd 2010-02-12 14:47:25 UTC (rev 27)
@@ -55,7 +55,9 @@
\value{
A list containing:
\item{xyt}{matrix (or list of matrices if \code{nsim}>1)
-containing the points (x,y,t) of the simulated point pattern.}
+containing the points (x,y,t) of the simulated point pattern.
+\code{xyt} (or any element of the list if \code{nsim}>1)) is an object
+of the class \code{stpp}.}
\item{s.region, t.region}{parameters passed in argument.}
}
Modified: pkg/man/rpp.Rd
===================================================================
--- pkg/man/rpp.Rd 2010-02-11 10:45:50 UTC (rev 26)
+++ pkg/man/rpp.Rd 2010-02-12 14:47:25 UTC (rev 27)
@@ -44,7 +44,9 @@
\value{
A list containing:
\item{xyt}{matrix (or list of matrices if \code{nsim}>1)
-containing the points (x,y,t) of the simulated point pattern.}
+containing the points (x,y,t) of the simulated point pattern.
+\code{xyt} (or any element of the list if \code{nsim}>1)) is an object
+of the class \code{stpp}.}
\item{t.index}{vector of times index.}
\item{Lambda}{nx x ny x nt array of the intensity surface at each time.}
\item{s.region, t.region, lambda}{parameters passed in argument.}
@@ -89,4 +91,4 @@
t.region=c(1,200), discrete.time=TRUE)
image(Ls$x, Ls$y, Ls$z, col=grey((1000:1)/1000)); polygon(northcumbria)
animation(ipp2$xyt, add=TRUE, cex=0.7, runtime=15)
-}
\ No newline at end of file
+}
More information about the Stpp-commits
mailing list