[Pomp-commits] r825 - pkg/pomp/R
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Tue Feb 5 23:49:06 CET 2013
Author: kingaa
Date: 2013-02-05 23:49:05 +0100 (Tue, 05 Feb 2013)
New Revision: 825
Modified:
pkg/pomp/R/aaa.R
pkg/pomp/R/basic-probes.R
pkg/pomp/R/bsmc.R
pkg/pomp/R/mif.R
pkg/pomp/R/pfilter.R
pkg/pomp/R/pomp.R
pkg/pomp/R/probe.R
pkg/pomp/R/simulate-pomp.R
pkg/pomp/R/sobol.R
pkg/pomp/R/spect.R
pkg/pomp/R/traj-match.R
pkg/pomp/R/trajectory-pomp.R
Log:
- use explicit integers where appropriate in subsetting operations
Modified: pkg/pomp/R/aaa.R
===================================================================
--- pkg/pomp/R/aaa.R 2013-02-05 16:22:39 UTC (rev 824)
+++ pkg/pomp/R/aaa.R 2013-02-05 22:49:05 UTC (rev 825)
@@ -1,7 +1,7 @@
## .onAttach <- function (...) {
-## version <- library(help=pomp)$info[[1]]
-## version <- strsplit(version[pmatch("Version",version)]," ")[[1]]
-## version <- version[nchar(version)>0][2]
+## version <- library(help=pomp)$info[[1L]]
+## version <- strsplit(version[pmatch("Version",version)]," ")[[1L]]
+## version <- version[nchar(version)>0][2L]
## packageStartupMessage("This is pomp version ",version,"\n")
## }
Modified: pkg/pomp/R/basic-probes.R
===================================================================
--- pkg/pomp/R/basic-probes.R 2013-02-05 16:22:39 UTC (rev 824)
+++ pkg/pomp/R/basic-probes.R 2013-02-05 22:49:05 UTC (rev 825)
@@ -53,9 +53,9 @@
method <- match.arg(method)
lag <- as.integer(lag)
transform <- match.fun(transform)
- var1 <- vars[1]
+ var1 <- vars[1L]
if (length(vars)>1)
- var2 <- vars[2]
+ var2 <- vars[2L]
else
var2 <- var1
function (y) {
@@ -85,9 +85,9 @@
method <- match.arg(method)
lag <- as.integer(lag)
transform <- match.fun(transform)
- var1 <- vars[1]
+ var1 <- vars[1L]
if (length(vars)>1)
- var2 <- vars[2]
+ var2 <- vars[2L]
else
var2 <- var1
function (y) {
@@ -134,8 +134,8 @@
lags <- as.integer(lags)
function (y) .Call(
probe_ccf,
- x=transform(y[vars[1],,drop=TRUE]),
- y=transform(y[vars[2],,drop=TRUE]),
+ x=transform(y[vars[1L],,drop=TRUE]),
+ y=transform(y[vars[2L],,drop=TRUE]),
lags=lags,
corr=corr
)
Modified: pkg/pomp/R/bsmc.R
===================================================================
--- pkg/pomp/R/bsmc.R 2013-02-05 16:22:39 UTC (rev 824)
+++ pkg/pomp/R/bsmc.R 2013-02-05 22:49:05 UTC (rev 825)
@@ -50,7 +50,7 @@
if (missing(seed)) seed <- NULL
if (!is.null(seed)) {
if (!exists(".Random.seed",where=.GlobalEnv))
- runif(1) ## need to initialize the RNG
+ runif(n=1L) ## need to initialize the RNG
save.seed <- get(".Random.seed",pos=.GlobalEnv)
set.seed(seed)
}
@@ -374,17 +374,17 @@
panel=function (x, y, ...) { ## prior, posterior pairwise scatterplot
op <- par(new=TRUE)
on.exit(par(op))
- i <- which(x[1]==all[1,])
- j <- which(y[1]==all[1,])
+ i <- which(x[1L]==all[1L,])
+ j <- which(y[1L]==all[1L,])
points(prior[p1,i],prior[p1,j],pch=20,col=rgb(0.85,0.85,0.85,0.1),xlim=range(all[,i]),ylim=range(all[,j]))
points(post[p2,i],post[p2,j],pch=20,col=rgb(0,0,1,0.01))
},
diag.panel=function (x, ...) { ## marginal posterior histogram
- i <- which(x[1]==all[1,])
+ i <- which(x[1L]==all[1L,])
d1 <- density(prior[,i])
d2 <- density(post[,i])
usr <- par('usr')
- op <- par(usr=c(usr[1:2],0,1.5*max(d1$y,d2$y)))
+ op <- par(usr=c(usr[c(1L,2L)],0,1.5*max(d1$y,d2$y)))
on.exit(par(op))
polygon(d1,col=rgb(0.85,0.85,0.85,0.5))
polygon(d2,col=rgb(0,0,1,0.5))
Modified: pkg/pomp/R/mif.R
===================================================================
--- pkg/pomp/R/mif.R 2013-02-05 16:22:39 UTC (rev 824)
+++ pkg/pomp/R/mif.R 2013-02-05 22:49:05 UTC (rev 825)
@@ -231,7 +231,7 @@
ntimes=ntimes
)
- if ((method=="mif2")&&(Np[1]!=Np[ntimes+1]))
+ if ((method=="mif2")&&(Np[1L]!=Np[ntimes+1]))
stop("the first and last values of ",sQuote("Np")," must agree when method = ",sQuote("mif2"))
if (missing(var.factor))
@@ -264,7 +264,7 @@
c('loglik','nfail',names(theta))
)
)
- conv.rec[1,] <- c(NA,NA,theta)
+ conv.rec[1L,] <- c(NA,NA,theta)
if (!all(is.finite(theta[c(pars,ivps)]))) {
stop(
@@ -281,7 +281,7 @@
obj <- as(object,"pomp")
if (Nmif>0) {
- tmp.mif <- new("mif",object,particles=particles,Np=Np[1])
+ tmp.mif <- new("mif",object,particles=particles,Np=Np[1L])
} else {
pfp <- obj
}
@@ -298,7 +298,7 @@
P <- try(
particles(
tmp.mif,
- Np=Np[1],
+ Np=Np[1L],
center=theta,
sd=sigma.n*var.factor
),
@@ -549,10 +549,10 @@
...
)
- object at conv.rec[ndone+1,c('loglik','nfail')] <- obj at conv.rec[1,c('loglik','nfail')]
+ object at conv.rec[ndone+1,c('loglik','nfail')] <- obj at conv.rec[1L,c('loglik','nfail')]
obj at conv.rec <- rbind(
object at conv.rec,
- obj at conv.rec[-1,colnames(object at conv.rec)]
+ obj at conv.rec[-1L,colnames(object at conv.rec)]
)
obj at Nmif <- as.integer(ndone+Nmif)
Modified: pkg/pomp/R/pfilter.R
===================================================================
--- pkg/pomp/R/pfilter.R 2013-02-05 16:22:39 UTC (rev 824)
+++ pkg/pomp/R/pfilter.R 2013-02-05 22:49:05 UTC (rev 825)
@@ -91,7 +91,7 @@
params <- matrix(
params,
nrow=length(params),
- ncol=Np[1],
+ ncol=Np[1L],
dimnames=list(
names(params),
NULL
@@ -211,7 +211,7 @@
stop(sQuote("pfilter")," error: process simulation error",call.=FALSE)
if (pred.var) { ## check for nonfinite state variables and parameters
- problem.indices <- unique(which(!is.finite(X),arr.ind=TRUE)[,1])
+ problem.indices <- unique(which(!is.finite(X),arr.ind=TRUE)[,1L])
if (length(problem.indices)>0) { # state variables
stop(
sQuote("pfilter")," error: non-finite state variable(s): ",
@@ -220,7 +220,7 @@
)
}
if (random.walk) { # parameters (need to be checked only if 'random.walk=TRUE')
- problem.indices <- unique(which(!is.finite(params[rw.names,,drop=FALSE]),arr.ind=TRUE)[,1])
+ problem.indices <- unique(which(!is.finite(params[rw.names,,drop=FALSE]),arr.ind=TRUE)[,1L])
if (length(problem.indices)>0) {
stop(
sQuote("pfilter")," error: non-finite parameter(s): ",
Modified: pkg/pomp/R/pomp.R
===================================================================
--- pkg/pomp/R/pomp.R 2013-02-05 16:22:39 UTC (rev 824)
+++ pkg/pomp/R/pomp.R 2013-02-05 22:49:05 UTC (rev 825)
@@ -42,7 +42,7 @@
## check t0
if (!is.numeric(t0) || length(t0) > 1)
stop("pomp error: the zero-time ",sQuote("t0")," must be a single number",call.=TRUE)
- if (t0 > times[1])
+ if (t0 > times[1L])
stop("pomp error: the zero-time ",sQuote("t0")," must occur no later than the first observation",call.=TRUE)
storage.mode(t0) <- 'double'
@@ -259,8 +259,8 @@
if (!inherits(formulae[[k]],"formula"))
stop("pomp error: ",sQuote("measurement.model")," takes formulae as arguments",call.=FALSE)
}
- obsnames <- unlist(lapply(formulae,function(x)x[[2]]))
- distrib <- lapply(formulae,function(x)as.character(x[[3]][[1]]))
+ obsnames <- unlist(lapply(formulae,function(x)x[[2L]]))
+ distrib <- lapply(formulae,function(x)as.character(x[[3L]][[1L]]))
ddistrib <- lapply(distrib,function(x)paste0("d",x))
rdistrib <- lapply(distrib,function(x)paste0("r",x))
for (k in seq_len(nobs)) {
@@ -277,7 +277,7 @@
if (inherits(res,'try-error'))
stop("pomp error: random deviate function ",rdistrib[[k]]," not found")
}
- pred.args <- lapply(formulae,function(x)as.list(x[[3]][-1]))
+ pred.args <- lapply(formulae,function(x)as.list(x[[3L]][-1L]))
dcalls <- vector(mode='list',length=nobs)
rcalls <- vector(mode='list',length=nobs)
for (k in seq_len(nobs)) {
Modified: pkg/pomp/R/probe.R
===================================================================
--- pkg/pomp/R/probe.R 2013-02-05 16:22:39 UTC (rev 824)
+++ pkg/pomp/R/probe.R 2013-02-05 22:49:05 UTC (rev 825)
@@ -119,34 +119,34 @@
##plot a histogram for the simulations
usr <- par("usr")
on.exit(par(usr))
- par(usr=c(usr[1:2],0,1.5))
- h <- hist(x[-1],plot=FALSE)
+ par(usr=c(usr[c(1L,2L)],0,1.5))
+ h <- hist(x[-1L],plot=FALSE)
breaks <- h$breaks
nB <- length(breaks)
y <- h$counts
y <- y/max(y)
- rect(breaks[-nB],0,breaks[-1],y,...)
+ rect(breaks[-nB],0,breaks[-1L],y,...)
##plot the data point
- lines(c(x[1],x[1]),c(0,max(h$counts)),col="red")
+ lines(c(x[1L],x[1L]),c(0,max(h$counts)),col="red")
}
##function for plotting above-diagonal panels
above.diag.panel <- function (x, y, ...) {
##plot the simulations
- points(x[-1],y[-1],...)
+ points(x[-1L],y[-1L],...)
##plot the data
mMx <- c(min(x),max(x))
mMy <- c(min(y),max(y))
- lines(c(x[1],x[1]),mMy,col="red")
- lines(mMx,c(y[1],y[1]),col="red")
+ lines(c(x[1L],x[1L]),mMy,col="red")
+ lines(mMx,c(y[1L],y[1L]),col="red")
}
##function for plotting below-diagonal panels
below.diag.panel <- function (x, y, ...) {
mMx <- c(min(x),max(x))
mMy <- c(min(y),max(y))
- x <- x[-1]
- y <- y[-1]
+ x <- x[-1L]
+ y <- y[-1L]
correls <- round(cor(x,y),3)
text(mean(mMx),mean(mMy),correls,cex=1)
}
@@ -155,8 +155,8 @@
nprobes <- length(x at datvals)
nsim <- nrow(x at simvals)
datsimvals <- array(dim=c(nsim+1,nprobes))
- datsimvals[1,] <- x at datvals
- datsimvals[-1,] <- x at simvals
+ datsimvals[1L,] <- x at datvals
+ datsimvals[-1L,] <- x at simvals
labels <- paste("pb",seq_len(nprobes))
if (!is.null(names(x at datvals)))
Modified: pkg/pomp/R/simulate-pomp.R
===================================================================
--- pkg/pomp/R/simulate-pomp.R 2013-02-05 16:22:39 UTC (rev 824)
+++ pkg/pomp/R/simulate-pomp.R 2013-02-05 22:49:05 UTC (rev 825)
@@ -59,14 +59,14 @@
if (as.data.frame) {
if (obs && states) {
dm <- dim(retval$obs)
- nsim <- dm[2]
- ntimes <- dm[3]
+ nsim <- dm[2L]
+ ntimes <- dm[3L]
nm <- rownames(retval$obs)
- dim(retval$obs) <- c(dm[1],prod(dm[-1]))
+ dim(retval$obs) <- c(dm[1L],prod(dm[-1L]))
rownames(retval$obs) <- nm
dm <- dim(retval$states)
nm <- rownames(retval$states)
- dim(retval$states) <- c(dm[1],prod(dm[-1]))
+ dim(retval$states) <- c(dm[1L],prod(dm[-1L]))
rownames(retval$states) <- nm
retval <- cbind(
as.data.frame(t(retval$obs)),
@@ -77,10 +77,10 @@
retval <- retval[order(retval$sim,retval$time),]
} else if (obs || states) {
dm <- dim(retval)
- nsim <- dm[2]
- ntimes <- dm[3]
+ nsim <- dm[2L]
+ ntimes <- dm[3L]
nm <- rownames(retval)
- dim(retval) <- c(dm[1],prod(dm[-1]))
+ dim(retval) <- c(dm[1L],prod(dm[-1L]))
rownames(retval) <- nm
retval <- as.data.frame(t(retval))
retval$sim <- factor(seq_len(nsim))
Modified: pkg/pomp/R/sobol.R
===================================================================
--- pkg/pomp/R/sobol.R 2013-02-05 16:22:39 UTC (rev 824)
+++ pkg/pomp/R/sobol.R 2013-02-05 22:49:05 UTC (rev 825)
@@ -8,7 +8,7 @@
y <- vapply(
seq_len(d),
function (k) {
- vars[[k]][1]+(vars[[k]][2]-vars[[k]][1])*x[k,]
+ vars[[k]][1L]+(vars[[k]][2L]-vars[[k]][1L])*x[k,]
},
numeric(n)
)
Modified: pkg/pomp/R/spect.R
===================================================================
--- pkg/pomp/R/spect.R 2013-02-05 16:22:39 UTC (rev 824)
+++ pkg/pomp/R/spect.R 2013-02-05 22:49:05 UTC (rev 825)
@@ -51,8 +51,8 @@
reuman.kernel <- function (kernel.width) {
ker <- kernel("modified.daniell",m=kernel.width)
x <- seq.int(from=0,to=kernel.width,by=1)/kernel.width
- ker[[1]] <- (15/(16*2*pi))*((x-1)^2)*((x+1)^2)
- ker[[1]] <- ker[[1]]/(2*sum(ker[[1]][-1])+ker[[1]][1])
+ ker[[1L]] <- (15/(16*2*pi))*((x-1)^2)*((x+1)^2)
+ ker[[1L]] <- ker[[1L]]/(2*sum(ker[[1L]][-1])+ker[[1L]][1L])
attr(ker,"name") <- NULL
ker
}
Modified: pkg/pomp/R/traj-match.R
===================================================================
--- pkg/pomp/R/traj-match.R 2013-02-05 16:22:39 UTC (rev 824)
+++ pkg/pomp/R/traj-match.R 2013-02-05 22:49:05 UTC (rev 825)
@@ -132,7 +132,7 @@
## fill 'states' slot of returned object with the trajectory
x <- trajectory(obj)
- obj at states <- array(data=x,dim=dim(x)[c(1,3)])
+ obj at states <- array(data=x,dim=dim(x)[c(1L,3L)])
rownames(obj at states) <- rownames(x)
new(
Modified: pkg/pomp/R/trajectory-pomp.R
===================================================================
--- pkg/pomp/R/trajectory-pomp.R 2013-02-05 16:22:39 UTC (rev 824)
+++ pkg/pomp/R/trajectory-pomp.R 2013-02-05 22:49:05 UTC (rev 825)
@@ -20,7 +20,7 @@
else
t0 <- as.numeric(t0)
- if (t0>times[1])
+ if (t0>times[1L])
stop("the zero-time ",sQuote("t0")," must occur no later than the first observation",call.=FALSE)
ntimes <- length(times)
@@ -76,10 +76,10 @@
if (inherits(X,'try-error'))
stop("trajectory error: error in ODE integrator",call.=FALSE)
- if (attr(X,'istate')[1]!=2)
+ if (attr(X,'istate')[1L]!=2)
warning("abnormal exit from ODE integrator, istate = ",attr(X,'istate'),call.=FALSE)
- x <- array(data=t(X[-1,-1]),dim=c(nvar,nrep,ntimes),dimnames=list(statenames,NULL,NULL))
+ x <- array(data=t(X[-1L,-1L]),dim=c(nvar,nrep,ntimes),dimnames=list(statenames,NULL,NULL))
for (z in znames)
for (r in seq_len(ncol(x)))
@@ -97,7 +97,7 @@
function (k) {
nm <- rownames(x)
y <- x[,k,,drop=FALSE]
- dim(y) <- dim(y)[c(1,3)]
+ dim(y) <- dim(y)[c(1L,3L)]
y <- as.data.frame(t(y))
names(y) <- nm
y$time <- times
More information about the pomp-commits
mailing list