[Distr-commits] r555 - in branches/distr-2.2/pkg/distrMod: R chm man
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Thu Aug 27 16:31:59 CEST 2009
Author: ruckdeschel
Date: 2009-08-27 16:31:58 +0200 (Thu, 27 Aug 2009)
New Revision: 555
Modified:
branches/distr-2.2/pkg/distrMod/R/0distrModUtils.R
branches/distr-2.2/pkg/distrMod/R/AllClass.R
branches/distr-2.2/pkg/distrMod/R/AllShow.R
branches/distr-2.2/pkg/distrMod/R/Estimate.R
branches/distr-2.2/pkg/distrMod/R/ParamFamParameter.R
branches/distr-2.2/pkg/distrMod/R/ParamFamily.R
branches/distr-2.2/pkg/distrMod/R/internalMleCalc.R
branches/distr-2.2/pkg/distrMod/chm/distrMod.chm
branches/distr-2.2/pkg/distrMod/chm/internals.html
branches/distr-2.2/pkg/distrMod/chm/trafo-methods.html
branches/distr-2.2/pkg/distrMod/man/internals.Rd
branches/distr-2.2/pkg/distrMod/man/trafo-methods.Rd
Log:
---------------------------------------------------------------------------------------
distrMod: several changes to enable kStepEstimator for dealing with nuisance parameters
---------------------------------------------------------------------------------------
+new utility: .deleteDim to delete /only/ dim attribute
+utility .validTrafo(), in presence of nuisance, covering coordinates p+1..k,
now accepts for matrices either dim p x p or p x k
and in case ncol(trafo==k)
+correspondingly modified validity function slot in ParamFamParameter()
+show methods for class Estimate are a bit more careful:
- in principle they accept estimate slots with a dim attribute
- special care is taken to whether untransformed.asvar is not NULL / NA-free
+modified some accessors
- re-deleted the deletion of attribute dim in accessors [untransformed.]estimate()
- accessors to [untransoformed.]asvar now coerce to matrix, but only so if the item is not NULL
+in .process.meCalcRes delete dim attribute for slots [untransformed.]estimate unless
already present in main (and nuisance)
+method trafo is changed for nuisance parameters:
-for signature ParamFamily, ParamFamParameter now takes special care
about presence of a nuisance parameter:
if so it returns as mat item a matrix with corresponding zero-columns for
the nuisance coordinates so that it has dim p x k where k=length(main)+length(nuisance)
-.validTrafo calls in ParamFamParameter.R
(in generating function ParamFamParameter,
in trafo-methods signature ParamFamParameter, missing
in main<- method for signature ParamFamParameter
in trafo<- method for signature ParamFamParameter)
are now prepended with necessary dimension
calculations in order to check whether its dim is pxp or pxk (see point ".validTrafo")
Modified: branches/distr-2.2/pkg/distrMod/R/0distrModUtils.R
===================================================================
--- branches/distr-2.2/pkg/distrMod/R/0distrModUtils.R 2009-08-26 02:48:36 UTC (rev 554)
+++ branches/distr-2.2/pkg/distrMod/R/0distrModUtils.R 2009-08-27 14:31:58 UTC (rev 555)
@@ -1,4 +1,12 @@
-.getLogDeriv <- function(distr,
+.deleteDim <- function(x){
+ attribs <- attributes(x)
+ attribs$dim <- NULL
+ attribs$dimnames <- NULL
+ attributes(x) <- attribs
+ x
+ }
+
+.getLogDeriv <- function(distr,
lowerTruncQuantile = getdistrExOption("ElowerTruncQuantile"),
upperTruncQuantile = getdistrExOption("EupperTruncQuantile"),
IQR.fac = getdistrExOption("IQR.fac")){
@@ -62,21 +70,23 @@
isTRUE(all.equal(m, diag(m.row), check.attributes = FALSE))
}
-.validTrafo <- function(trafo, dimension){
+.validTrafo <- function(trafo, dimension, dimensionwithN){
##checks whether trafo is valid
+ ret <- FALSE
if(!is.function(trafo)){
- if(ncol(trafo) != dimension)
+ if((ncol(trafo) != dimension) && (ncol(trafo) != dimensionwithN))
stop("invalid transformation:\n",
"number of columns of 'trafo' not equal to ",
"dimension of the parameter")
- if(nrow(trafo) > dimension)
- stop("invalid transformation:\n",
- "number of rows of 'trafo' larger than ",
- "dimension of the parameter")
+# if(nrow(trafo) > dimension)
+# stop("invalid transformation:\n",
+# "number of rows of 'trafo' larger than ",
+# "dimension of the parameter")
if(any(!is.finite(trafo)))
stop("infinite or missing values in 'trafo'")
+ ret <- (ncol(trafo) == dimensionwithN)
}
- return(invisible())
+ return(ret)
}
##caching:
Modified: branches/distr-2.2/pkg/distrMod/R/AllClass.R
===================================================================
--- branches/distr-2.2/pkg/distrMod/R/AllClass.R 2009-08-26 02:48:36 UTC (rev 554)
+++ branches/distr-2.2/pkg/distrMod/R/AllClass.R 2009-08-27 14:31:58 UTC (rev 555)
@@ -104,8 +104,9 @@
stop("invalid transformation:\n",
"should be a matrix or a function")
if(is.matrix(object at trafo)){
- dimension <- length(object at main) #+ length(object at nuisance)
- .validTrafo(object at trafo, dimension) ### check validity
+ ln.m <- length(object at main)
+ ln.n <- length(object at nuisance)
+ .validTrafo(object at trafo, ln.m, ln.m+ln.n) ### check validity
return(TRUE)}
})
@@ -402,10 +403,17 @@
untransformed.estimate = NULL,
untransformed.asvar = NULL),
validity = function(object){
- if(is.null(dim(object at estimate)))
- len <- length(object at estimate)
- else
- len <- dim(object at estimate)[1]
+ if(is.null(object at untransformed.estimate)){
+ if(is.null(dim(object at estimate)))
+ len <- length(object at estimate)
+ else
+ len <- dim(object at estimate)[1]
+ }else{
+ if(is.null(dim(object at untransformed.estimate)))
+ len <- length(object at untransformed.estimate)
+ else
+ len <- dim(object at untransformed.estimate)[1]
+ }
if(!is.character(object at Infos))
stop("'Infos' contains no matrix of characters")
if(ncol(object at Infos)!=2)
Modified: branches/distr-2.2/pkg/distrMod/R/AllShow.R
===================================================================
--- branches/distr-2.2/pkg/distrMod/R/AllShow.R 2009-08-26 02:48:36 UTC (rev 554)
+++ branches/distr-2.2/pkg/distrMod/R/AllShow.R 2009-08-27 14:31:58 UTC (rev 555)
@@ -147,12 +147,37 @@
if(!is.null(object at asvar)){
sd0 <- sqrt(diag(object at asvar)/object at samplesize)
- untransformed.sd0 <- sqrt(diag(object at untransformed.asvar)/object at samplesize)
-
+ if(!is.null(object at untransformed.asvar) && all(!is.na(object at untransformed.asvar)))
+ untransformed.sd0 <- sqrt(diag(object at untransformed.asvar)/object at samplesize)
+ else untransformed.sd0 <- NULL
+
if(getdistrModOption("show.details")!="minimal")
cat(gettextf("estimate:\n"))
- .show.with.sd(object at estimate,sd0)
+ dim.est <- dim(object at estimate)
+ if(is.null(dim.est))
+ .show.with.sd(object at estimate,sd0)
+ else{
+ if(length(dim.est) >2) stop("not yet implemented")
+ c.nms <- colnames(object at estimate)
+ r.nms <- rownames(object at estimate)
+ rn <- dim.est[1]; cn <- dim.est[2]
+ if(rn == 1){
+ dim(object at estimate) <- NULL
+ names(object at estimate) <- c.nms
+ .show.with.sd(object at estimate,sd0)
+ }else{
+ cni <- (1:cn)-1
+ for(k in 1:rn){
+ cat("Row [", r.nms[k], ",]:\n", sep="")
+ oe <- object at estimate[k,,drop=TRUE]
+ names(oe) <- paste("[",r.nms[k],",",c.nms,"]",sep="")
+ sd1 <- sd0[cni*rn+k]
+ .show.with.sd(oe,sd1)
+ }
+ }
+ }
+
if(!is.null(object at nuis.idx)){
cat(gettextf("nuisance parameter:\n"))
print(nuisance(object), quote = FALSE)
@@ -171,12 +196,18 @@
if(getdistrModOption("show.details")=="maximal"){
if(!.isUnitMatrix(trafo.mat)){
- cat(gettextf("untransformed estimate:\n"))
- .show.with.sd(object at untransformed.estimate,untransformed.sd0)
-
- cat(gettextf("asymptotic (co)variance of untransformed estimate (multiplied with samplesize):\n"))
- print(object at untransformed.asvar[,])
+ if(!is.null(untransformed.sd0) && all(!is.na(untransformed.sd0))){
+ cat(gettextf("untransformed estimate:\n"))
+ .show.with.sd(object at untransformed.estimate,untransformed.sd0)
+ }else{
+ cat(gettextf("untransformed estimate:\n"))
+ print(object at untransformed.estimate, quote = FALSE)
}
+ if(!is.null(object at untransformed.asvar)){
+ cat(gettextf("asymptotic (co)variance of untransformed estimate (multiplied with samplesize):\n"))
+ print(object at untransformed.asvar[,])
+ }
+ }
}
}else{
Modified: branches/distr-2.2/pkg/distrMod/R/Estimate.R
===================================================================
--- branches/distr-2.2/pkg/distrMod/R/Estimate.R 2009-08-26 02:48:36 UTC (rev 554)
+++ branches/distr-2.2/pkg/distrMod/R/Estimate.R 2009-08-27 14:31:58 UTC (rev 555)
@@ -8,14 +8,14 @@
setMethod("estimate", "Estimate", function(object){
es <- object at estimate
- dim(es) <- NULL
- names(es) <- names(object at estimate)
+# dim(es) <- NULL
+# names(es) <- names(object at estimate)
es})
setMethod("untransformed.estimate", "Estimate",
function(object){
u.es <- object at untransformed.estimate
- dim(u.es) <- NULL
- names(u.es) <- names(object at untransformed.estimate)
+# dim(u.es) <- NULL
+# names(u.es) <- names(object at untransformed.estimate)
u.es
})
setMethod("estimate.call", "Estimate", function(object) object at estimate.call)
@@ -60,7 +60,9 @@
setMethod("samplesize", "Estimate", function(object, onlycompletecases = TRUE)
object at samplesize+(1-onlycompletecases)*sum(object at completecases==FALSE))
setMethod("completecases", "Estimate", function(object) object at completecases)
-setMethod("asvar", "Estimate", function(object) object at asvar)
+setMethod("asvar", "Estimate", function(object)
+ if(!is.null(object at asvar))
+ as.matrix(object at asvar))
setReplaceMethod("asvar", "Estimate",
function(object, value){
@@ -75,7 +77,9 @@
object})
setMethod("untransformed.asvar", "Estimate", function(object)
- as.matrix(object at untransformed.asvar))
+ if(!is.null(object at untransformed.asvar))
+ as.matrix(object at untransformed.asvar)
+ else NULL )
setMethod("optimwarn", "MCEstimate", function(object) object at optimwarn)
setMethod("criterion", "MCEstimate", function(object) object at criterion)
@@ -89,7 +93,9 @@
setMethod("nuisance", "Estimate", function(object) {
if(is.null(object at nuis.idx))
return(NULL)
- else return (estimate(object)[object at nuis.idx])
+ if(!is.null(untransformed.estimate))
+ return (untransformed.estimate(object)[object at nuis.idx])
+ return (estimate(object)[object at nuis.idx])
})
setMethod("main", "Estimate", function(object) {
if(is.null(object at nuis.idx))
Modified: branches/distr-2.2/pkg/distrMod/R/ParamFamParameter.R
===================================================================
--- branches/distr-2.2/pkg/distrMod/R/ParamFamParameter.R 2009-08-26 02:48:36 UTC (rev 554)
+++ branches/distr-2.2/pkg/distrMod/R/ParamFamParameter.R 2009-08-27 14:31:58 UTC (rev 555)
@@ -10,8 +10,12 @@
if(missing(trafo))
trafo <- diag(length(main))
- dimension <- length(main) #+ length(nuisance)
- .validTrafo(trafo, dimension) ### check validity
+ ln.m <- length(main)
+ ln.n <- length(nuisance)
+ ln <- ln.m + ln.m
+
+ if(.validTrafo(trafo, dimension = ln.m, dimensionwithN = ln)) ### check validity
+ trafo <- trafo[,1:ln.m,drop=FALSE]
PFP <- new("ParamFamParameter")
PFP at name <- name
PFP at main <- main
@@ -28,18 +32,42 @@
setMethod("fixed", "ParamFamParameter", function(object) object at fixed)
setMethod("trafo", signature(object = "ParamFamParameter", param = "missing"),
function(object, param){
+
+ main0 <- main(object)
+ ln.m <- length(main0)
+ nms.m <- names(main0)
+
+ nuis0 <- nuisance(object)
+ ln.n <- length(nuis0)
+
if(is.function(object at trafo)) {
- main0 <- main(object)
retv <- object at trafo(main0)
- return(retv$mat)}
- else return(object at trafo)})
+ mat <- mat0 <- retv$mat
+ }else{
+ mat <- mat0 <- object at trafo
+ }
+ if(ln.n){
+ nms.n <- names(nuis0)
+ nms <- c(nms.m,nms.n)
+ ln <- ln.m + ln.n
+ lmx <- 1:ln.m
+ lnx <- ln.m + (1:ln.n)
+ mat0 <- matrix(0, ln.m, ln, dimnames=list(nms.m,nms))
+ mat0[lmx,lmx] <- mat
+ }
+ return(mat0)
+})
+
## replace methods
setReplaceMethod("main", "ParamFamParameter",
function(object, value){
+ ln.m <- length(main(object))
+ ln.n <- length(nuisance(object))
+ ln <- ln.m + ln.m
object at main <- value
- dimension <- length(object at main) # + length(object at nuisance)
- .validTrafo(object at trafo, dimension)
+ dum <- .validTrafo(object at trafo, dimension = ln.m,
+ dimensionwithN = ln) ### check validity
object
})
setReplaceMethod("nuisance", "ParamFamParameter",
@@ -54,8 +82,11 @@
})
setReplaceMethod("trafo", "ParamFamParameter",
function(object, value){
- dimension <- length(object at main)# + length(object at nuisance)
- .validTrafo(value, dimension) ### check validity
+ ln.m <- length(main(object))
+ ln.n <- length(nuisance(object))
+ ln <- ln.m + ln.m
+ if(.validTrafo(value, dimension = ln.m, dimensionwithN = ln))
+ value <- value[,1:ln.m,drop=FALSE] ### check validity
object at trafo <- value
object
})
Modified: branches/distr-2.2/pkg/distrMod/R/ParamFamily.R
===================================================================
--- branches/distr-2.2/pkg/distrMod/R/ParamFamily.R 2009-08-26 02:48:36 UTC (rev 554)
+++ branches/distr-2.2/pkg/distrMod/R/ParamFamily.R 2009-08-27 14:31:58 UTC (rev 555)
@@ -76,14 +76,38 @@
return(trafo(param0))})
setMethod("trafo", signature(object = "ParamFamily", param = "ParamFamParameter"),
function(object, param){
+
param0 <- object at param
+
if(is.function(param0 at trafo))
- return(list(fct = param0 at trafo,
- mat = (param0 at trafo(main(param)))$mat))
- else return(list(fct = function(x) {
+ lis <- list(fct = param0 at trafo,
+ mat = (param0 at trafo(main(param)))$mat)
+ else lis <- list(fct = function(x) {
list(fval = param0 at trafo%*%x,
mat = param0 at trafo)},
- mat = param0 at trafo))
+ mat = param0 at trafo)
+ mat <- mat0 <- lis$mat
+
+ main0 <- main(object)
+ ln.m <- length(main0)
+ nms.m <- names(main0)
+
+ nuis0 <- nuisance(object)
+ ln.n <- length(nuis0)
+
+
+ if(ln.n){
+ nms.n <- names(nuis0)
+ nms <- c(nms.m,nms.n)
+ ln <- ln.m + ln.n
+ lmx <- 1:ln.m
+ lnx <- ln.m + (1:ln.n)
+ mat0 <- matrix(0, ln.m, ln, dimnames=list(nms.m,nms))
+ mat0[lmx,lmx] <- mat
+ }
+
+ lis$mat <- mat0
+ return(lis)
})
setMethod("trafo.fct", signature(object = "ParamFamily"),
Modified: branches/distr-2.2/pkg/distrMod/R/internalMleCalc.R
===================================================================
--- branches/distr-2.2/pkg/distrMod/R/internalMleCalc.R 2009-08-26 02:48:36 UTC (rev 554)
+++ branches/distr-2.2/pkg/distrMod/R/internalMleCalc.R 2009-08-27 14:31:58 UTC (rev 555)
@@ -27,6 +27,9 @@
jdx <- if(lnx) lmx + 1:lnx else idx
nuis.idx <- if(lnx) jdx else NULL
+ hasnodim.main <- is.null(dim(main(PFam)))
+ hasnodim.nuis <- is.null(dim(nuisance(PFam)))
+
theta <- res$estimate
crit <- res$criterion
param <- res$param
@@ -92,12 +95,19 @@
if(!.isUnitMatrix(traf0$mat)){
estimate <- traf0$fct(estimate)$fval
+ estimate <- .deleteDim(estimate)
trafm <- traf0$mat
if(!is.null(asvar)){
asvar <- trafm%*%asvar[idx,idx]%*%t(trafm)
rownames(asvar) <- colnames(asvar) <- c(names(estimate))
}
+ }else{
+ if(hasnodim.main)
+ estimate <- .deleteDim(estimate)
}
+ if(hasnodim.main & hasnodim.nuis)
+ untransformed.estimate <- .deleteDim(untransformed.estimate)
+
res.me <- new("MCEstimate", name = est.name, estimate = estimate,
criterion = crit, asvar = asvar, Infos = Infos,
samplesize = res$samplesize, nuis.idx = nuis.idx,
Modified: branches/distr-2.2/pkg/distrMod/chm/distrMod.chm
===================================================================
(Binary files differ)
Modified: branches/distr-2.2/pkg/distrMod/chm/internals.html
===================================================================
--- branches/distr-2.2/pkg/distrMod/chm/internals.html 2009-08-26 02:48:36 UTC (rev 554)
+++ branches/distr-2.2/pkg/distrMod/chm/internals.html 2009-08-27 14:31:58 UTC (rev 555)
@@ -1,10 +1,10 @@
<html><head><title>Internal functions of package distrMod</title>
-<meta http-equiv="Content-Type" content="text/html; charset=iso-8859-1">
+<meta http-equiv="Content-Type" content="text/html; charset=utf-8">
<link rel="stylesheet" type="text/css" href="Rchm.css">
-</head>
-<body>
+</head><body>
-<table width="100%"><tr><td>internals_for_distrMod(distrMod)</td><td align="right">R Documentation</td></tr></table><object type="application/x-oleobject" classid="clsid:1e2a7bd0-dab9-11d0-b93a-00c04fc99f9e">
+<table width="100%"><tr><td>internals_for_distrMod(distrMod)</td><td align="right">R Documentation</td></tr></table>
+<object type="application/x-oleobject" classid="clsid:1e2a7bd0-dab9-11d0-b93a-00c04fc99f9e">
<param name="keyword" value="R: internals_for_distrMod">
<param name="keyword" value="R: .inArgs">
<param name="keyword" value="R: .isUnitMatrix">
@@ -12,6 +12,7 @@
<param name="keyword" value="R: .CvMMDCovariance">
<param name="keyword" value="R: .show.with.sd">
<param name="keyword" value="R: .getLogDeriv">
+<param name="keyword" value="R: .deleteDim">
<param name="keyword" value=" Internal functions of package distrMod">
</object>
@@ -22,8 +23,7 @@
<h3>Description</h3>
<p>
-These functions are used internally by package ``distrMod''.
-</p>
+These functions are used internally by package “distrMod”.</p>
<h3>Usage</h3>
@@ -32,7 +32,7 @@
.inArgs(arg, fct)
.isUnitMatrix(m)
.csimpsum(fx)
-.validTrafo(trafo, dimension)
+.validTrafo(trafo, dimension, dimensionwithN)
.CvMMDCovariance(L2Fam, param, mu = distribution(L2Fam),
withplot = FALSE, withpreIC = FALSE,
N = getdistrOption("DefaultNrGridPoints")+1,
@@ -44,6 +44,7 @@
lowerTruncQuantile = getdistrExOption("ElowerTruncQuantile"),
upperTruncQuantile = getdistrExOption("EupperTruncQuantile"),
IQR.fac = getdistrExOption("IQR.fac"))
+.deleteDim(x)
</pre>
@@ -58,19 +59,22 @@
a function</td></tr>
<tr valign="top"><td><code>m</code></td>
<td>
-a matrix</td></tr>
+a matrix</td></tr>
<tr valign="top"><td><code>est</code></td>
<td>
an estimator; usually a vector</td></tr>
<tr valign="top"><td><code>s</code></td>
<td>
-a standard deviation</td></tr>
+a standard deviation</td></tr>
<tr valign="top"><td><code>trafo</code></td>
<td>
an object of class <code>MatrixorFunction</code></td></tr>
<tr valign="top"><td><code>dimension</code></td>
<td>
-a numeric</td></tr>
+a numeric — length of main part of the parameter</td></tr>
+<tr valign="top"><td><code>dimensionwithN</code></td>
+<td>
+a numeric — length of main and nuisance part of the parameter</td></tr>
<tr valign="top"><td><code>L2Fam</code></td>
<td>
an object of class <code>L2ParamFamily</code> — for
@@ -87,7 +91,7 @@
measure (resp. distribution) for CvM distance</td></tr>
<tr valign="top"><td><code>rel.tol</code></td>
<td>
-relative tolerance for <code>distrExIntegrate</code>.</td></tr>
+relative tolerance for <code>distrExIntegrate</code>.</td></tr>
<tr valign="top"><td><code>TruncQuantile</code></td>
<td>
quantile for quantile based integration range.</td></tr>
@@ -114,7 +118,7 @@
<tr valign="top"><td><code>N</code></td>
<td>
a numeric: the number of gridpoints for constructing the
-<i>mu</i>- resp. <i>P_theta</i>-``primitive''
+<i>mu</i>- resp. <i>P_theta</i>-“primitive”
function</td></tr>
<tr valign="top"><td><code>fx</code></td>
<td>
@@ -126,8 +130,12 @@
<td>
further argument to be passed through — so
<code>.CvMMDCovariance</code> can digest more arguments</td></tr>
+<tr valign="top"><td><code>x</code></td>
+<td>
+a possibly named vector, which may have a <code>dim</code> attribute</td></tr>
</table>
+
<h3>Details</h3>
<p>
@@ -161,13 +169,18 @@
<p>
<code>.getLogDeriv</code> determines numerically the negative logarithmic derivative of the
density of distribution <code>distr</code>; to this end uses <code>D1ss</code>,
-<code>D2ss</code> from Martin Maechler's package <span class="pkg">sfsmisc</span>.
+<code>D2ss</code> from Martin Maechler's package <span class="pkg">sfsmisc</span>.
</p>
+<p>
+<code>.deleteDim</code> deletes a possible <code>dim</code> argument (sets it to <code>NULL</code>)
+but retains all other possible attributes, in particular a <code>name</code> attribute.
+</p>
<h3>Value</h3>
-<table summary="R argblock">
+<p>
+<table summary="R valueblock">
<tr valign="top"><td><code>.getLogderiv</code></td>
<td>
a function in one argument <code>x</code> — the negative logarithmic
@@ -192,8 +205,13 @@
<tr valign="top"><td><code>.show.with.sd</code></td>
<td>
<code>invisible()</code></td></tr>
+<tr valign="top"><td><code>.deleteDim</code></td>
+<td>
+vector <code>x</code> without <code>dim</code> attribute</td></tr>
</table>
+</p>
+
<h3>Author(s)</h3>
<p>
@@ -205,15 +223,22 @@
<h3>See Also</h3>
<p>
-<code><a href="MLEstimator.html">MLEstimator</a></code>,
-<code><a href="Estimate-class.html">Estimate-class</a></code>,
-<code><a href="MCEstimate-class.html">MCEstimate-class</a></code>,
-<code><a href="Confint-class.html">Confint-class</a></code>,
-<code><a href="ParamFamParameter-class.html">ParamFamParameter-class</a></code>
+<code></code>,
+<code></code>,
+<code></code>,
+<code></code>,
+<code></code>
</p>
+<script Language="JScript">
+function findlink(pkg, fn) {
+var Y, link;
+Y = location.href.lastIndexOf("\\") + 1;
+link = location.href.substring(0, Y);
+link = link + "../../" + pkg + "/chtml/" + pkg + ".chm::/" + fn;
+location.href = link;
+}
+</script>
-
<hr><div align="center">[Package <em>distrMod</em> version 2.2 <a href="00Index.html">Index</a>]</div>
-
</body></html>
Modified: branches/distr-2.2/pkg/distrMod/chm/trafo-methods.html
===================================================================
--- branches/distr-2.2/pkg/distrMod/chm/trafo-methods.html 2009-08-26 02:48:36 UTC (rev 554)
+++ branches/distr-2.2/pkg/distrMod/chm/trafo-methods.html 2009-08-27 14:31:58 UTC (rev 555)
@@ -1,10 +1,10 @@
<html><head><title>Methods for function trafo in Package ‘distrMod’</title>
-<meta http-equiv="Content-Type" content="text/html; charset=iso-8859-1">
+<meta http-equiv="Content-Type" content="text/html; charset=utf-8">
<link rel="stylesheet" type="text/css" href="Rchm.css">
-</head>
-<body>
+</head><body>
-<table width="100%"><tr><td>trafo-methods(distrMod)</td><td align="right">R Documentation</td></tr></table><object type="application/x-oleobject" classid="clsid:1e2a7bd0-dab9-11d0-b93a-00c04fc99f9e">
+<table width="100%"><tr><td>trafo-methods(distrMod)</td><td align="right">R Documentation</td></tr></table>
+<object type="application/x-oleobject" classid="clsid:1e2a7bd0-dab9-11d0-b93a-00c04fc99f9e">
<param name="keyword" value="R: trafo-methods">
<param name="keyword" value="R: trafo">
<param name="keyword" value="R: trafo,Estimate,missing-method">
@@ -38,16 +38,15 @@
<pre>
trafo(object, param)
-## S4 method for signature 'Estimate, missing':
+## S4 method for signature 'Estimate,missing':
trafo(object,param)
-## S4 method for signature 'ParamFamParameter, missing':
+## S4 method for signature 'ParamFamParameter,missing':
trafo(object,param)
-## S4 method for signature 'ParamFamily, missing':
+## S4 method for signature 'ParamFamily,missing':
trafo(object,param)
-## S4 method for signature 'ParamFamily,
-## ParamFamParameter':
+## S4 method for signature 'ParamFamily,ParamFamParameter':
trafo(object,param)
-## S4 method for signature 'Estimate, ParamFamParameter':
+## S4 method for signature 'Estimate,ParamFamParameter':
trafo(object,param)
trafo.fct(object)
trafo(object) <- value
@@ -79,6 +78,7 @@
additional argument(s) for methods.</td></tr>
</table>
+
<h3>Details</h3>
<p>
@@ -139,6 +139,7 @@
<p>
According to the signature, <EM>method</EM> <code>trafo</code> will return different
return value types. For signature
+
<dl>
<dt><code>Estimate,missing</code>:</dt><dd>it will return a list with entries
<code>fct</code>, the function <i>tau</i>, and <code>mat</code>, the matrix
@@ -156,6 +157,9 @@
<code>Estimate,missing</code>.</dd>
</dl>
+</p>
+
+
<h3>Value</h3>
<p>
@@ -163,8 +167,7 @@
For <code>trafo.fct</code>, we return the corresponding function
<i>tau()</i> (see below).
For <code>trafo</code>, we have:
-</p>
-<table summary="R argblock">
+<table summary="R valueblock">
<tr valign="top"><td><code>signature <code>Estimate,missing</code>:</code></td>
<td>
a list of length two with components
@@ -184,7 +187,9 @@
a list of length two
with components <code>fct</code> and <code>mat</code> (see below)</td></tr>
</table>
+</p>
+
<h3>Examples</h3>
<pre>
@@ -213,8 +218,5 @@
</pre>
-
-
<hr><div align="center">[Package <em>distrMod</em> version 2.2 <a href="00Index.html">Index</a>]</div>
-
</body></html>
Modified: branches/distr-2.2/pkg/distrMod/man/internals.Rd
===================================================================
--- branches/distr-2.2/pkg/distrMod/man/internals.Rd 2009-08-26 02:48:36 UTC (rev 554)
+++ branches/distr-2.2/pkg/distrMod/man/internals.Rd 2009-08-27 14:31:58 UTC (rev 555)
@@ -6,6 +6,7 @@
\alias{.CvMMDCovariance}
\alias{.show.with.sd}
\alias{.getLogDeriv}
+\alias{.deleteDim}
\title{Internal functions of package distrMod}
@@ -16,7 +17,7 @@
.inArgs(arg, fct)
.isUnitMatrix(m)
.csimpsum(fx)
-.validTrafo(trafo, dimension)
+.validTrafo(trafo, dimension, dimensionwithN)
.CvMMDCovariance(L2Fam, param, mu = distribution(L2Fam),
withplot = FALSE, withpreIC = FALSE,
N = getdistrOption("DefaultNrGridPoints")+1,
@@ -28,6 +29,7 @@
lowerTruncQuantile = getdistrExOption("ElowerTruncQuantile"),
upperTruncQuantile = getdistrExOption("EupperTruncQuantile"),
IQR.fac = getdistrExOption("IQR.fac"))
+.deleteDim(x)
}
@@ -38,7 +40,8 @@
\item{est}{an estimator; usually a vector}
\item{s}{a standard deviation}
\item{trafo}{an object of class \code{MatrixorFunction}}
- \item{dimension}{a numeric}
+ \item{dimension}{a numeric --- length of main part of the parameter}
+ \item{dimensionwithN}{a numeric --- length of main and nuisance part of the parameter}
\item{L2Fam}{an object of class \code{L2ParamFamily} --- for
which we want to determine the IC resp. the as. [co]variance of the corresponding
Minimum CvM estimator}
@@ -66,6 +69,7 @@
\item{distr}{an object of class \code{AbscontDistribution}}
\item{\dots}{further argument to be passed through --- so
\code{.CvMMDCovariance} can digest more arguments}
+ \item{x}{a possibly named vector, which may have a \code{dim} attribute}
}
\details{
@@ -94,6 +98,9 @@
\code{.getLogDeriv} determines numerically the negative logarithmic derivative of the
density of distribution \code{distr}; to this end uses \code{D1ss},
\code{D2ss} from Martin Maechler's package \pkg{sfsmisc}.
+
+\code{.deleteDim} deletes a possible \code{dim} argument (sets it to \code{NULL})
+but retains all other possible attributes, in particular a \code{name} attribute.
}
\value{
@@ -107,6 +114,7 @@
the corresponding Minimum CvM estimator or list withcomponents
\code{preIC} and \code{var} ---see above}
\item{.show.with.sd}{\code{invisible()}}
+\item{.deleteDim}{vector \code{x} without \code{dim} attribute}
}
\author{
Modified: branches/distr-2.2/pkg/distrMod/man/trafo-methods.Rd
===================================================================
--- branches/distr-2.2/pkg/distrMod/man/trafo-methods.Rd 2009-08-26 02:48:36 UTC (rev 554)
+++ branches/distr-2.2/pkg/distrMod/man/trafo-methods.Rd 2009-08-27 14:31:58 UTC (rev 555)
@@ -20,7 +20,7 @@
versions.
}
\usage{
-trafo(object, param)
+trafo(object, param, ...)
\S4method{trafo}{Estimate,missing}(object,param)
\S4method{trafo}{ParamFamParameter,missing}(object,param)
\S4method{trafo}{ParamFamily,missing}(object,param)
@@ -41,7 +41,7 @@
(the function value, see below)
and \code{mat} (a matrix --- with the same dimensions consistency
conditions as above).}
- \item{\dots}{additional argument(s) for methods.}
+ \item{\dots}{additional argument(s) for methods; not used so far.}
}
\value{
The return value depends on the signature.
More information about the Distr-commits
mailing list