[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