[Depmix-commits] r545 - pkg/depmixS4/R
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Thu Jul 26 11:10:38 CEST 2012
Author: ingmarvisser
Date: 2012-07-26 11:10:38 +0200 (Thu, 26 Jul 2012)
New Revision: 545
Modified:
pkg/depmixS4/R/depmixfit-class.R
Log:
Removed the summary function of fitted models; the summary method is now identical to the summary method of non-fitted models (which was non-existent in earlier versions).
Modified: pkg/depmixS4/R/depmixfit-class.R
===================================================================
--- pkg/depmixS4/R/depmixfit-class.R 2012-07-26 09:09:44 UTC (rev 544)
+++ pkg/depmixS4/R/depmixfit-class.R 2012-07-26 09:10:38 UTC (rev 545)
@@ -37,32 +37,6 @@
}
)
-setMethod("summary","mix.fitted",
- function(object,which="all") {
- ans=switch(which,
- "all" = 1,
- "response" = 2,
- "prior" = 3,
- stop("Invalid 'which' argument in summary of fitted mix model")
- )
- if(ans==1|ans==3) {
- cat("Mixture probabilities model \n")
- show(object at prior)
- cat("\n")
- }
- if(ans==1|ans==2) {
- for(i in 1:object at nstates) {
- cat("Response model(s) for state", i,"\n\n")
- for(j in 1:object at nresp) {
- cat("Response model for response",j,"\n")
- show(object at response[[i]][[j]])
- cat("\n")
- }
- cat("\n")
- }
- }
- }
-)
#
# Ingmar Visser, 23-3-2008
@@ -98,87 +72,3 @@
cat("BIC: ", BIC(object),"\n")
}
)
-
-# copied from hmmr (and removed there)
-
-setMethod("summary","depmix.fitted",
- function(object,which="all", compact=TRUE) {
- ns <- object at nstates
- ans=switch(which,
- "all" = 1,
- "response" = 2,
- "prior" = 3,
- "transition" = 4,
- stop("Invalid 'which' argument in summary of fitted depmix model")
- )
- if(ans==1|ans==3) {
- # show the prior models
- cat("Initial state probabilties model \n")
- if(compact & object at prior@formula==~1) {
- pr <- object at prior@parameters$coefficients
- rownames(pr) <- ""
- colnames(pr) <- paste("St",1:ns,sep="")
- cat(pr,"\n")
- } else show(object at prior)
- }
- if(ans==1|ans==4) {
- # show the transition models
- if(compact & object at transition[[1]]@formula==~1) {
- cat("\nTransition matrix \n")
- pars <- getpars(object)
- trm <- matrix(pars[(ns+1):(ns^2+ns)],ns,ns,byr=T)
- rownames(trm) <- paste("fromS",1:ns,sep="")
- colnames(trm) <- paste("toS",1:ns,sep="")
- print(trm)
- cat("\n")
- } else {
- for(i in 1:ns) {
- cat("Transition model for state (component)", i,"\n")
- show(object at transition[[i]])
- cat("\n")
- }
- cat("\n")
- }
- }
- if(ans==1|ans==2) {
- # show the response models
- if(!compact) {
- for(i in 1:ns) {
- cat("Response model(s) for state", i,"\n\n")
- for(j in 1:object at nresp) {
- cat("Response model for response",j,"\n")
- show(object at response[[i]][[j]])
- cat("\n")
- }
- cat("\n")
- }
- } else {
- cat("Response parameters \n")
- for(j in 1:object at nresp) {
- cat("Resp",j, ":", object at response[[1]][[j]]@family$family, "\n")
- }
- pars <- list()
- np <- numeric(object at nresp)
- for(j in 1:object at nresp) {
- np[j] <- npar(object at response[[1]][[j]])
- pars[[j]] <- matrix(,nr=ns,nc=np[j])
- }
- allpars <- matrix(,nr=ns,nc=0)
- nms <- c()
- for(j in 1:object at nresp) {
- for(i in 1:ns) {
- pars[[j]][i,]=getpars(object at response[[i]][[j]])
- }
- nms <- c(nms,paste("Resp",j,1:np[j],sep="."))
- allpars <- cbind(allpars,pars[[j]])
- }
- rownames(allpars) <- paste("St",1:ns,sep="")
- colnames(allpars) <- nms
- print(allpars)
- }
- }
- }
-)
-
-
-
More information about the depmix-commits
mailing list