[Depmix-commits] r569 - pkg/depmixS4/R

[noreply at r-forge.r-project.org]

Author: maarten
Date: 2012-09-19 15:57:32 +0200 (Wed, 19 Sep 2012)
New Revision: 569

Modified:
   pkg/depmixS4/R/depmix-class.R
Log:
- updated summary function to allow different response models

Modified: pkg/depmixS4/R/depmix-class.R
===================================================================
--- pkg/depmixS4/R/depmix-class.R	2012-09-18 19:34:30 UTC (rev 568)
+++ pkg/depmixS4/R/depmix-class.R	2012-09-19 13:57:32 UTC (rev 569)
@@ -408,31 +408,55 @@
 								}
 						} 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)
+								# get the parameter names
+								allparnames <- list()
+								parnames <- list() # for renaming empty names
 								for(j in 1:object at nresp) {
-										np[j] <- npar(object at response[[1]][[j]]) # this will not always work!
+								    parnames[[j]] <- list()
+								    nms <- character()
+								    for(i in 1:ns) {
+								        tnms <- names(getpars(object at response[[i]][[j]]))
+								        if(any(tnms == "")) {
+								            tnms[tnms == ""] <- paste("noname",1:sum(tnms == ""),sep="") # assume unnamed parameters are the same between
+								           
+								        }
+								        parnames[[j]][[i]] <- tnms
+								        nms <- c(nms,tnms)
+								    }
+								    allparnames[[j]] <- unique(nms)
+								}
+								
+								
+								for(j in 1:object at nresp) {
+										#np[j] <- npar(object at response[[1]][[j]]) # this will not always work!
+										np[j] <- length(allparnames[[j]]) 
 										pars[[j]] <- matrix(,nr=ns,nc=np[j])
+										colnames(pars[[j]]) <- allparnames[[j]]
 								}
 								allpars <- matrix(,nr=ns,nc=0)
 								nms <- c()
 								for(j in 1:object at nresp) {
 										for(i in 1:ns) {
 												tmp <- getpars(object at response[[i]][[j]])
-												pars[[j]][i,] <- tmp
+												#pars[[j]][i,] <- tmp
+												pars[[j]][i,parnames[[j]][[i]]] <- tmp
 										}
 										nmsresp <- paste("Re",j,sep="")
-										nmstmp <- names(tmp)
+										#nmstmp <- names(tmp)
+										nmstmp <- allparnames[[j]]
 										if(is.null(nmstmp)) nmstmp <- 1:length(tmp)
 										nms <- c(nms,paste(nmsresp,nmstmp,sep="."))
 										allpars <- cbind(allpars,pars[[j]])					
 								}
 								rownames(allpars) <- paste("St",1:ns,sep="")
 								colnames(allpars) <- nms
-								print(allpars)
+								print(allpars,na.print=".")
 						}
 				}
 		}