[Depmix-commits] r190 - in trunk: R man
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Thu Jun 26 02:14:14 CEST 2008
Author: maarten
Date: 2008-06-26 02:14:14 +0200 (Thu, 26 Jun 2008)
New Revision: 190
Modified:
trunk/R/responseGLMBINOM.R
trunk/R/responseGLMGAMMA.R
trunk/R/responseGLMMULTINOM.R
trunk/R/responseGLMPOISSON.R
trunk/R/responseMVN.R
trunk/R/responseNORM.R
trunk/R/simulate.R
trunk/man/simulate.Rd
Log:
- fixed simulate documentation and simulate methods (times argument rather than time)
Modified: trunk/R/responseGLMBINOM.R
===================================================================
--- trunk/R/responseGLMBINOM.R 2008-06-25 14:42:17 UTC (rev 189)
+++ trunk/R/responseGLMBINOM.R 2008-06-26 00:14:14 UTC (rev 190)
@@ -31,12 +31,13 @@
)
setMethod("simulate",signature(object="BINOMresponse"),
- function(object,nsim=1,seed=NULL,time) {
- if(missing(time)) {
+ function(object,nsim=1,seed=NULL,times) {
+ if(!is.null(seed)) set.seed(seed)
+ if(missing(times)) {
# draw in one go
pr <- predict(object)
} else {
- pr <- predict(object)[time,]
+ pr <- predict(object)[times,]
}
nt <- nrow(pr)
if(NCOL(object at y) == 2) {
Modified: trunk/R/responseGLMGAMMA.R
===================================================================
--- trunk/R/responseGLMGAMMA.R 2008-06-25 14:42:17 UTC (rev 189)
+++ trunk/R/responseGLMGAMMA.R 2008-06-26 00:14:14 UTC (rev 190)
@@ -20,12 +20,13 @@
)
setMethod("simulate",signature(object="GAMMAresponse"),
- function(object,nsim=1,seed=NULL,time) {
- if(missing(time)) {
+ function(object,nsim=1,seed=NULL,times) {
+ if(!is.null(seed)) set.seed(seed)
+ if(missing(times)) {
# draw in one go
shape <- predict(object)
} else {
- shape <- predict(object)[time,]
+ shape <- predict(object)[times,]
}
nt <- nrow(shape)
response <- rgamma(nt*nsim,shape=shape)
Modified: trunk/R/responseGLMMULTINOM.R
===================================================================
--- trunk/R/responseGLMMULTINOM.R 2008-06-25 14:42:17 UTC (rev 189)
+++ trunk/R/responseGLMMULTINOM.R 2008-06-26 00:14:14 UTC (rev 190)
@@ -56,13 +56,14 @@
)
setMethod("simulate",signature(object="MULTINOMresponse"),
- function(object,nsim=1,seed=NULL,time) {
- if(missing(time)) {
+ function(object,nsim=1,seed=NULL,times) {
+ if(!is.null(seed)) set.seed(seed)
+ if(missing(times)) {
# draw all times in one go
pr <- predict(object)
} else {
- pr <- predict(object)[time,]
- if(length(time)==1) pr <- matrix(pr,ncol=length(pr))
+ pr <- predict(object)[times,]
+ if(length(times)==1) pr <- matrix(pr,ncol=length(pr))
}
nt <- nrow(pr)
sims <- array(apply(pr,1,rmultinom,n=nsim,size=1),dim=c(ncol(pr),nsim,nt))
Modified: trunk/R/responseGLMPOISSON.R
===================================================================
--- trunk/R/responseGLMPOISSON.R 2008-06-25 14:42:17 UTC (rev 189)
+++ trunk/R/responseGLMPOISSON.R 2008-06-26 00:14:14 UTC (rev 190)
@@ -20,12 +20,13 @@
)
setMethod("simulate",signature(object="POISSONresponse"),
- function(object,nsim=1,seed=NULL,time) {
- if(missing(time)) {
+ function(object,nsim=1,seed=NULL,times) {
+ if(!is.null(seed)) set.seed(seed)
+ if(missing(times)) {
# draw in one go
lambda <- predict(object)
} else {
- lambda <- predict(object)[time,]
+ lambda <- predict(object)[times,]
}
nt <- nrow(lambda)
response <- rpois(nt*nsim,lambda=lambda)
Modified: trunk/R/responseMVN.R
===================================================================
--- trunk/R/responseMVN.R 2008-06-25 14:42:17 UTC (rev 189)
+++ trunk/R/responseMVN.R 2008-06-26 00:14:14 UTC (rev 190)
@@ -66,12 +66,13 @@
)
setMethod("simulate",signature(object="MVNresponse"),
- function(object,nsim=1,seed=NULL,time) {
- if(missing(time)) {
+ function(object,nsim=1,seed=NULL,times) {
+ if(!is.null(seed)) set.seed(seed)
+ if(missing(times)) {
# draw in one go
mu <- predict(object)
} else {
- mu <- predict(object)[time,]
+ mu <- predict(object)[times,]
}
nt <- nrow(mu)
response <- mvrnorm(nt*nsim,mu=mu,Sigma=object at parameters$Sigma)
Modified: trunk/R/responseNORM.R
===================================================================
--- trunk/R/responseNORM.R 2008-06-25 14:42:17 UTC (rev 189)
+++ trunk/R/responseNORM.R 2008-06-26 00:14:14 UTC (rev 190)
@@ -44,12 +44,13 @@
)
setMethod("simulate",signature(object="NORMresponse"),
- function(object,nsim=1,seed=NULL,time) {
- if(missing(time)) {
+ function(object,nsim=1,seed=NULL,times) {
+ if(!is.null(seed)) set.seed(seed)
+ if(missing(times)) {
# draw in one go
mu <- predict(object)
} else {
- mu <- predict(object)[time]
+ mu <- predict(object)[times]
}
nt <- length(mu)
sd <- getpars(object)["sd"]
Modified: trunk/R/simulate.R
===================================================================
--- trunk/R/simulate.R 2008-06-25 14:42:17 UTC (rev 189)
+++ trunk/R/simulate.R 2008-06-26 00:14:14 UTC (rev 190)
@@ -93,19 +93,20 @@
)
setMethod("simulate",signature(object="transInit"),
- function(object,nsim=1,seed=NULL,is.prior=FALSE,time) {
+ function(object,nsim=1,seed=NULL,times,is.prior=FALSE) {
+ if(!is.null(seed)) set.seed(seed)
if(is.prior) {
pr <- dens(object)
sims <- array(apply(pr,1,rmultinom,n=nsim,size=1),dim=c(ncol(pr),nsim,nrow(pr)))
states <- t(apply(sims,c(2,3), function(x) which(x==1)))
return(states)
} else {
- if(missing(time)) {
+ if(missing(times)) {
# this is likely to be a stationary model...
pr <- predict(object)
} else {
- pr <- predict(object)[time,]
- if(length(time)==1) pr <- matrix(pr,ncol=length(pr))
+ pr <- predict(object)[times,]
+ if(length(times)==1) pr <- matrix(pr,ncol=length(pr))
}
nt <- nrow(pr)
sims <- array(apply(pr,1,rmultinom,n=nsim,size=1),dim=c(ncol(pr),nsim,nt))
Modified: trunk/man/simulate.Rd
===================================================================
--- trunk/man/simulate.Rd 2008-06-25 14:42:17 UTC (rev 189)
+++ trunk/man/simulate.Rd 2008-06-26 00:14:14 UTC (rev 190)
@@ -28,11 +28,11 @@
\S4method{simulate}{depmix}(object, nsim=1, seed=NULL, ...)
- \S4method{simulate}{response}(object, nsim=1, seed=NULL, times=NULL, ...)
+ \S4method{simulate}{response}(object, nsim=1, seed=NULL, times, ...)
- \S4method{simulate}{GLMresponse}(object, nsim=1, seed=NULL, times=NULL, ...)
+ \S4method{simulate}{GLMresponse}(object, nsim=1, seed=NULL, times, ...)
- \S4method{simulate}{transInit}(object, nsim=1, seed=NULL, times=NULL, ...)
+ \S4method{simulate}{transInit}(object, nsim=1, seed=NULL, times, is.prior=FALSE, ...)
}
\arguments{
@@ -45,9 +45,12 @@
\item{seed}{Set the seed.}
- \item{times}{An indicator vector indicating for which times in the
+ \item{times}{(optional) An indicator vector indicating for which times in the
complete series to generate the data. For internal use.}
+ \item{is.prior}{For \code{transInit} objects, indicates whether it is a prior
+ (init) model, or not (i.e., it is a transition model)}
+
\item{...}{Not used currently.}
}
More information about the depmix-commits
mailing list