[Depmix-commits] r675 - in pkg/depmixS4: . R
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Wed Nov 14 12:33:25 CET 2018
Author: ingmarvisser
Date: 2018-11-14 12:33:25 +0100 (Wed, 14 Nov 2018)
New Revision: 675
Added:
pkg/depmixS4/R/confint.R
pkg/depmixS4/R/format.perc.R
pkg/depmixS4/R/standardError.R
Modified:
pkg/depmixS4/NAMESPACE
pkg/depmixS4/R/allGenerics.R
pkg/depmixS4/R/depmixfit.R
pkg/depmixS4/R/hessian.R
pkg/depmixS4/R/vcov.R
Log:
=added files/functions standardError.R, confint.R and format.perc.R function
Modified: pkg/depmixS4/NAMESPACE
===================================================================
--- pkg/depmixS4/NAMESPACE 2018-10-19 15:25:03 UTC (rev 674)
+++ pkg/depmixS4/NAMESPACE 2018-11-14 11:33:25 UTC (rev 675)
@@ -24,7 +24,8 @@
viterbi,
mlogit,
logLik,
- hessian2vcov
+ hessian2vcov,
+ format.perc
)
exportClasses(
@@ -68,7 +69,9 @@
logLik,
getmodel,
hessian,
- vcov
+ vcov,
+ standardError,
+ confint
)
useDynLib(depmixS4, .registration = TRUE)
\ No newline at end of file
Modified: pkg/depmixS4/R/allGenerics.R
===================================================================
--- pkg/depmixS4/R/allGenerics.R 2018-10-19 15:25:03 UTC (rev 674)
+++ pkg/depmixS4/R/allGenerics.R 2018-11-14 11:33:25 UTC (rev 675)
@@ -56,7 +56,9 @@
setGeneric("hessian", function(object, ...) standardGeneric("hessian"))
+setGeneric("standardError", function(object, ...) standardGeneric("standardError"))
+
# functions
setGeneric("fit", function(object, ...) standardGeneric("fit"))
Added: pkg/depmixS4/R/confint.R
===================================================================
--- pkg/depmixS4/R/confint.R (rev 0)
+++ pkg/depmixS4/R/confint.R 2018-11-14 11:33:25 UTC (rev 675)
@@ -0,0 +1,51 @@
+#
+# Ingmar Visser, 8-11-2019
+#
+# Description
+#
+# Computes confidence intervals for (dep)mix model parameters.
+#
+# Details
+#
+# Confidence intervals are computed through the variance-covariance matrix
+# which in turn is computed using the hessian and the linear constraints
+# of the model. See ?vcov, ?hessian and ?standarderror for more details on
+# these underlying functions. The confidence intervals are computed using
+# the normal theory assumptions. The desired significance level can be
+# supplied through the 'level' argument.
+#
+# Value
+#
+#
+
+setMethod("confint", "mix",
+ function(object, level=0.95, digits=4, fixed=NULL, equal=NULL,
+ conrows=NULL, conrows.upper=NULL, conrows.lower=NULL,
+ tolerance=1e-9,
+ method="finiteDifferences", ...) {
+
+ vc <- vcov(object,fixed=fixed,equal=equal,
+ conrows=conrows,conrows.upper=conrows.upper,conrows.lower=conrows.lower,
+ tolerance=tolerance,method=method, ...)
+
+ ses <- sqrt(diag(vc$vcov))
+
+ pars <- getpars(object)
+
+ elements <- vc$elements
+
+ parsinc <- pars[which(elements=="inc")]
+
+ upper <- parsinc+qnorm(0.5+level/2)*ses
+ lower <- parsinc-qnorm(0.5+level/2)*ses
+
+ ret <- data.frame(pars=round(pars,digits), constr=elements, lower=NA, upper=NA)
+
+ ret$lower[which(elements=="inc")] <- round(lower, digits)
+ ret$upper[which(elements=="inc")] <- round(upper, digits)
+
+ colnames(ret)[3:4] <- c(format.perc(0.5-level/2, 3),format.perc(0.5+level/2, 3))
+
+ return(ret)
+}
+)
Modified: pkg/depmixS4/R/depmixfit.R
===================================================================
--- pkg/depmixS4/R/depmixfit.R 2018-10-19 15:25:03 UTC (rev 674)
+++ pkg/depmixS4/R/depmixfit.R 2018-11-14 11:33:25 UTC (rev 675)
@@ -102,7 +102,10 @@
# select only those columns of the constraint matrix that correspond to non-fixed parameters
linconFull <- lincon
- lincon <- lincon[,!fixed,drop=FALSE]
+ lin.uFull <- lin.u
+ lin.lFull <- lin.l
+
+ lincon <- lincon[,!fixed,drop=FALSE]
# remove redundant rows in lincon (all zeroes)
allzero <- which(apply(lincon,1,function(y) all(y==0)))
@@ -219,8 +222,8 @@
}
object at conMat <- linconFull
- object at lin.upper <- lin.u
- object at lin.lower <- lin.l
+ object at lin.upper <- lin.uFull
+ object at lin.lower <- lin.lFull
object at posterior <- viterbi(object)
Added: pkg/depmixS4/R/format.perc.R
===================================================================
--- pkg/depmixS4/R/format.perc.R (rev 0)
+++ pkg/depmixS4/R/format.perc.R 2018-11-14 11:33:25 UTC (rev 675)
@@ -0,0 +1,5 @@
+format.perc <-
+function (probs, digits) {
+ paste(format(100 * probs, trim = TRUE,
+ scientific = FALSE, digits = digits), "%")
+}
Modified: pkg/depmixS4/R/hessian.R
===================================================================
--- pkg/depmixS4/R/hessian.R 2018-10-19 15:25:03 UTC (rev 674)
+++ pkg/depmixS4/R/hessian.R 2018-11-14 11:33:25 UTC (rev 675)
@@ -75,4 +75,6 @@
return(list(hessian=fdh$Hessian,elements=elements))
}
-)
\ No newline at end of file
+)
+
+
Added: pkg/depmixS4/R/standardError.R
===================================================================
--- pkg/depmixS4/R/standardError.R (rev 0)
+++ pkg/depmixS4/R/standardError.R 2018-11-14 11:33:25 UTC (rev 675)
@@ -0,0 +1,45 @@
+#
+# Ingmar Visser, 19-10-2018
+#
+# Description
+#
+# Computes standard errors for (dep)mix model parameters.
+#
+# Details
+#
+# Standard errors are computed through the variance-covariance matrix
+# which in turn is computed using the hessian and the linear constraints
+# of the model. See ?vcov and ?hessian for more details on this.
+#
+# Value
+#
+# A data.frame with columns: pars=parameter values, constr=whether the
+# parameter is 'inc'luded, 'fix'ed or estimated on the bound, 'bnd',
+# and the column ses with the standard errors.
+#
+
+setMethod("standardError", "mix",
+ function(object, digits=4, fixed=NULL, equal=NULL,
+ conrows=NULL, conrows.upper=NULL, conrows.lower=NULL,
+ tolerance=1e-9,
+ method="finiteDifferences", ...) {
+
+ vc <- vcov(object,fixed=fixed,equal=equal,
+ conrows=conrows,conrows.upper=conrows.upper,conrows.lower=conrows.lower,
+ tolerance=tolerance,method=method, ...)
+
+ ses <- sqrt(diag(vc$vcov))
+
+ pars <- getpars(object)
+
+ elements <- vc$elements
+
+ parsinc <- pars[which(elements=="inc")]
+
+ ret <- data.frame(pars=round(pars,digits), constr=elements, ses=NA)
+
+ ret$ses[which(elements=="inc")] <- round(ses,digits)
+
+ return(ret)
+}
+)
\ No newline at end of file
Modified: pkg/depmixS4/R/vcov.R
===================================================================
--- pkg/depmixS4/R/vcov.R 2018-10-19 15:25:03 UTC (rev 674)
+++ pkg/depmixS4/R/vcov.R 2018-11-14 11:33:25 UTC (rev 675)
@@ -58,16 +58,22 @@
# set those fixed parameters in the appropriate submodels
object <- setpars(object,fixed,which="fixed")
-
+
# get standard constraints from (sub)models
constraints <- getConstraints(object)
- lincon=constraints$lincon
- lin.u=constraints$lin.u
- lin.l=constraints$lin.l
- par.u=constraints$par.u
- par.l=constraints$par.l
+ lincon <- constraints$lincon
+ lin.u <- constraints$lin.u
+ lin.l <- constraints$lin.l
+ par.u <- constraints$par.u
+ par.l <- constraints$par.l
+ if(class(object)=="depmix.fitted"|class(object)=="mix.fitted") {
+ lincon <- object at conMat
+ lin.u <- object at lin.upper
+ lin.l <- object at lin.lower
+ }
+
# incorporate equality constraints provided with the hessian function, if any
if(eq) {
if(length(equal)!=npar(object)) stop("'equal' does not have correct length")
More information about the depmix-commits
mailing list