[Robast-commits] r470 - in branches/robast-0.9/pkg/RobExtremes: . R man
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Sun May 20 22:41:43 CEST 2012
Author: ruckdeschel
Date: 2012-05-20 22:41:42 +0200 (Sun, 20 May 2012)
New Revision: 470
Added:
branches/robast-0.9/pkg/RobExtremes/R/AllShow.R
branches/robast-0.9/pkg/RobExtremes/man/LDEstimate-class.Rd
Modified:
branches/robast-0.9/pkg/RobExtremes/NAMESPACE
branches/robast-0.9/pkg/RobExtremes/R/AllClass.R
branches/robast-0.9/pkg/RobExtremes/R/AllGeneric.R
branches/robast-0.9/pkg/RobExtremes/R/GParetoFamily.R
branches/robast-0.9/pkg/RobExtremes/R/LDEstimator.R
branches/robast-0.9/pkg/RobExtremes/R/interpolSn.R
branches/robast-0.9/pkg/RobExtremes/R/sysdata.rda
branches/robast-0.9/pkg/RobExtremes/man/InternalReturnClasses-class.Rd
branches/robast-0.9/pkg/RobExtremes/man/internal-interpolateSn.Rd
Log:
RobExtremes:
+ considerably improved grid for Sn method for GPareto
+ removed withPos relics in GParetoFamily
+ new LDEstimate class
Modified: branches/robast-0.9/pkg/RobExtremes/NAMESPACE
===================================================================
--- branches/robast-0.9/pkg/RobExtremes/NAMESPACE 2012-05-20 20:35:18 UTC (rev 469)
+++ branches/robast-0.9/pkg/RobExtremes/NAMESPACE 2012-05-20 20:41:42 UTC (rev 470)
@@ -12,10 +12,11 @@
exportClasses("GumbelParameter",
"ParetoParameter",
"GParetoParameter",
- "GEVParameter")
+ "GEVParameter",
+ "LDEstimate")
exportClasses("Gumbel", "Pareto", "GPareto", "GEV")
exportClasses("GParetoFamily", "GumbelLocationFamily")
-exportMethods("initialize")
+exportMethods("initialize", "show")
exportMethods("loc", "loc<-",
"E", "var", "IQR", "median", "kMAD", "Sn", "Qn")
exportMethods("validParameter",
@@ -26,7 +27,7 @@
"Min", "Min<-",
"Range",
"E", "var", "IQR", "skewness", "kurtosis",
- "sd", "median", "mad")
+ "sd", "median", "mad", "dispersion", "location")
exportMethods("modifyModel")
export("EULERMASCHERONICONSTANT","APERYCONSTANT")
export("Gumbel", "Pareto", "GPareto", "GEV")
Modified: branches/robast-0.9/pkg/RobExtremes/R/AllClass.R
===================================================================
--- branches/robast-0.9/pkg/RobExtremes/R/AllClass.R 2012-05-20 20:35:18 UTC (rev 469)
+++ branches/robast-0.9/pkg/RobExtremes/R/AllClass.R 2012-05-20 20:41:42 UTC (rev 470)
@@ -234,8 +234,26 @@
contains = "L2LocationFamily")
## class
-setClass("GParetoFamily",
- prototype= prototype(withPos = TRUE),
- contains="L2ScaleShapeUnion")
+setClass("GParetoFamily", contains="L2ScaleShapeUnion")
+setClass("LDEstimate",
+ representation(location = "numeric",
+ dispersion = "numeric"
+ ),
+ prototype(name = "LD estimate",
+ estimate = numeric(0),
+ samplesize = numeric(0),
+ completecases = logical(0),
+ asvar = NULL,
+ estimate.call = call("{}"),
+ location = 0,
+ dispersion = 1,
+ Infos = matrix(c(character(0),character(0)), ncol=2,
+ dimnames=list(character(0), c("method", "message"))),
+ nuis.idx = NULL,
+ trafo = list(fct = function(x){
+ list(fval = x, mat = matrix(1))},
+ mat = matrix(1))
+ ),
+ contains = "Estimate")
Modified: branches/robast-0.9/pkg/RobExtremes/R/AllGeneric.R
===================================================================
--- branches/robast-0.9/pkg/RobExtremes/R/AllGeneric.R 2012-05-20 20:35:18 UTC (rev 469)
+++ branches/robast-0.9/pkg/RobExtremes/R/AllGeneric.R 2012-05-20 20:41:42 UTC (rev 470)
@@ -20,3 +20,7 @@
if(!isGeneric("Sn")){
setGeneric("Sn", function(x, ...) standardGeneric("Sn"))
}
+
+if(!isGeneric("dispersion")){
+ setGeneric("dispersion", function(object, ...) standardGeneric("dispersion"))
+}
Added: branches/robast-0.9/pkg/RobExtremes/R/AllShow.R
===================================================================
--- branches/robast-0.9/pkg/RobExtremes/R/AllShow.R (rev 0)
+++ branches/robast-0.9/pkg/RobExtremes/R/AllShow.R 2012-05-20 20:41:42 UTC (rev 470)
@@ -0,0 +1,12 @@
+
+setMethod("show", "LDEstimate",
+ function(object){
+ digits <- getOption("digits")
+ show(as(object,"Estimate"))
+ if(getdistrModOption("show.details")!="minimal"){
+ cat("Location:", object at location, "\n")
+ cat("Dispersion:", object at dispersion, "\n")
+ }
+ })
+
+
Modified: branches/robast-0.9/pkg/RobExtremes/R/GParetoFamily.R
===================================================================
--- branches/robast-0.9/pkg/RobExtremes/R/GParetoFamily.R 2012-05-20 20:35:18 UTC (rev 469)
+++ branches/robast-0.9/pkg/RobExtremes/R/GParetoFamily.R 2012-05-20 20:41:42 UTC (rev 470)
@@ -14,7 +14,7 @@
return(FALSE)
#if (any(param[1] <= tol))
# return(FALSE)
- if(object at withPos)
+ if(object at param@withPosRestr)
if (any(param[2] <= tol))
return(FALSE)
return(TRUE)
@@ -246,7 +246,8 @@
}
param <- ParamFamParameter(name = "theta", main = c(theta[2],theta[3]),
fixed = theta[1],
- trafo = trafo)
+ trafo = trafo, withPosRestr = withPos,
+ .returnClsName ="ParamWithScaleAndShapeFamParameter")
## distribution
distribution <- GPareto(loc = loc, scale = scale, shape = shape)
@@ -270,7 +271,6 @@
if(!is.null(names(e0)))
e0 <- e0[c("scale", "shape")]
}
- e0["scale"] <- log(e0["scale"])
names(e0) <- NULL
return(e0)
}
@@ -366,8 +366,6 @@
of.interest0 = of.interest, p0 = p, N0 = N,
trafo0 = trafo, withPos0 = withPos))
- L2Fam at withPos <- withPos
-
L2Fam at LogDeriv <- function(x) (shape+1)/(shape*(scale+(x-loc)))
L2Fam at L2deriv <- L2deriv
Modified: branches/robast-0.9/pkg/RobExtremes/R/LDEstimator.R
===================================================================
--- branches/robast-0.9/pkg/RobExtremes/R/LDEstimator.R 2012-05-20 20:35:18 UTC (rev 469)
+++ branches/robast-0.9/pkg/RobExtremes/R/LDEstimator.R 2012-05-20 20:41:42 UTC (rev 470)
@@ -39,7 +39,7 @@
xi.0 <- uniroot(q.f,lower=q.lo.0,upper=q.up.0)$root
distr.new.0 <- ParamFamily.0 at modifyParam(theta=c("scale"=1,"shape"=xi.0))
m1xi <- do.call(loc.fctal.0, args = .prepend(distr.new.0,loc.fctal.ctrl.0, dots))
- val <- c("shape"=xi.0,"scale"=loc.emp/m1xi)
+ val <- c("shape"=xi.0,"scale"=loc.emp/m1xi, "loc"=loc.emp,"disp"=disp.emp)
return(val)
}
@@ -62,8 +62,10 @@
paste(deparse(substitute(loc.fctal))),
" ","Dispersion:",
paste(deparse(substitute(disp.fctal))))
+
+ LDMval <- NULL
estimator <- function(x,...){
- .LDMatch(x.0= x,
+ LDMval <<- .LDMatch(x.0= x,
loc.est.0 = loc.est, disp.est.0 = disp.est,
loc.fctal.0 = loc.fctal, disp.fctal.0 = disp.fctal,
ParamFamily.0 = ParamFamily,
@@ -72,6 +74,7 @@
disp.est.ctrl.0 = disp.est.ctrl,
disp.fctal.ctrl.0 = disp.fctal.ctrl,
q.lo.0 = q.lo, q.up.0 = q.up, log.q.0 = log.q)
+ return(LDMval[1:2])
}
@@ -93,6 +96,7 @@
estimate at untransformed.asvar <- asvar
+
l.e <- length(estimate at untransformed.estimate)
idx <- NULL
idm <- 1:l.e
@@ -118,7 +122,18 @@
colnames(Infos) <- c("method", "message")
}
estimate at Infos <- Infos
- return(estimate)
+
+ estim <- new("LDEstimate")
+
+ sln <- names(getSlots(class(estimate)))
+ for( i in 1:length(sln))
+ slot(estim, sln[i]) <- slot(estimate, sln[i])
+ rm(estimate)
+
+ estim at dispersion <- LDMval["disp"]
+ estim at location <- LDMval["loc"]
+
+ return(estim)
}
@@ -204,3 +219,6 @@
}
return(c("scale"=NA,"shape"=NA))
}
+
+setMethod("location", "LDEstimate", function(object) object at location)
+setMethod("dispersion", "LDEstimate", function(object) object at dispersion)
\ No newline at end of file
Modified: branches/robast-0.9/pkg/RobExtremes/R/interpolSn.R
===================================================================
--- branches/robast-0.9/pkg/RobExtremes/R/interpolSn.R 2012-05-20 20:35:18 UTC (rev 469)
+++ branches/robast-0.9/pkg/RobExtremes/R/interpolSn.R 2012-05-20 20:41:42 UTC (rev 470)
@@ -176,6 +176,7 @@
setMethod("Sn", signature(x = "GPareto"),
function(x, ...){
if(abs(scale(x)-1)< 1e-12){
+# sng <- .SnGrids
sng <- getFromNamespace(".SnGrids", ns = "RobExtremes")
snf <- sng[["Generalized Pareto Family"]][["fct"]]
ret <- snf(shape(x))
Modified: branches/robast-0.9/pkg/RobExtremes/R/sysdata.rda
===================================================================
(Binary files differ)
Modified: branches/robast-0.9/pkg/RobExtremes/man/InternalReturnClasses-class.Rd
===================================================================
--- branches/robast-0.9/pkg/RobExtremes/man/InternalReturnClasses-class.Rd 2012-05-20 20:35:18 UTC (rev 469)
+++ branches/robast-0.9/pkg/RobExtremes/man/InternalReturnClasses-class.Rd 2012-05-20 20:41:42 UTC (rev 470)
@@ -22,9 +22,8 @@
\section{Described classes}{
In this file we describe classes
\code{BinomFamily}, \code{PoisFamily}, \code{GammaFamily},
-\code{BetaFamily} ``extending'' (no new slots!) class \code{L2ParamFamily},
-class \code{GParetoFamily} extending class \code{L2ParamFamily} with
-extra slot \code{withPos},
+\code{BetaFamily}, class \code{GParetoFamily} ``extending'' (no new slots!)
+class \code{L2ParamFamily},
classes \code{NormLocationFamily} and \code{GumbelLocationFamily},
``extending'' (no new slots!) class \code{"L2LocationFamily"}, classes
\code{NormScaleFamily}, \code{ExpScaleFamily}, and \code{LnormScaleFamily}
@@ -106,8 +105,6 @@
the "standard" parameter value. }
\item{\code{locscalename}:}{(only loc/scale classes)[inherited from class \code{"L2LocationScaleUnion"}]
object of class \code{"character"}: names of location and scale parameter. }
- \item{\code{withPos}:}{(only shape/scale classes) object of class \code{"logical"}:
- Is shape restricted to positive values?}
}}
Added: branches/robast-0.9/pkg/RobExtremes/man/LDEstimate-class.Rd
===================================================================
--- branches/robast-0.9/pkg/RobExtremes/man/LDEstimate-class.Rd (rev 0)
+++ branches/robast-0.9/pkg/RobExtremes/man/LDEstimate-class.Rd 2012-05-20 20:41:42 UTC (rev 470)
@@ -0,0 +1,84 @@
+\name{LDEstimate-class}
+\docType{class}
+\alias{LDEstimate-class}
+\alias{dispersion}
+\alias{dispersion,LDEstimate-method}
+\alias{location,LDEstimate-method}
+\alias{show,LDEstimate-method}
+
+\title{LDEstimate-class.}
+\description{Class of Location Dispersion estimates.}
+\section{Objects from the Class}{
+ Objects can be created by calls of the form \code{new("LDEstimate", ...)}.
+ More frequently they are created via the generating function
+ \code{LDEstimator}.
+}
+\section{Slots}{
+ \describe{
+ \item{\code{name}}{Object of class \code{"character"}:
+ name of the estimator. }
+ \item{\code{estimate}}{Object of class \code{"ANY"}:
+ estimate.}
+ \item{\code{estimate.call}}{Object of class \code{"call"}:
+ call by which estimate was produced.}
+ \item{\code{dispersion}}{Object of class \code{"numeric"}:
+ the value of the fitted dispersion.}
+ \item{\code{location}}{Object of class \code{"numeric"}:
+ the value of the fitted location.}
+ \item{\code{Infos}}{ object of class \code{"matrix"}
+ with two columns named \code{method} and \code{message}:
+ additional informations. }
+ \item{\code{asvar}}{ object of class \code{"OptionalMatrix"}
+ which may contain the asymptotic (co)variance of the estimator. }
+ \item{\code{samplesize}}{ object of class \code{"numeric"} ---
+ the samplesize at which the estimate was evaluated. }
+ \item{\code{nuis.idx}}{ object of class \code{"OptionalNumeric"}:
+ indices of \code{estimate} belonging to the nuisance part}
+ \item{\code{fixed}}{ object of class \code{"OptionalNumeric"}:
+ the fixed and known part of the parameter. }
+ \item{\code{trafo}}{ object of class \code{"list"}:
+ a list with components \code{fct} and \code{mat} (see below). }
+ \item{\code{untransformed.estimate}}{Object of class \code{"ANY"}:
+ untransformed estimate.}
+ \item{\code{untransformed.asvar}}{ object of class \code{"OptionalNumericOrMatrix"}
+ which may contain the asymptotic (co)variance of the untransformed
+ estimator. }
+ \item{\code{completecases}}{ object of class \code{"logical"} ---
+ complete cases at which the estimate was evaluated. }
+ }
+}
+\section{Extends}{
+Class \code{"Estimate"}, directly.
+}
+\section{Methods}{
+ \describe{
+ \item{dispersion}{\code{signature(object = "LDEstimate")}:
+ accessor function for slot \code{dispersion}. }
+
+ \item{location}{\code{signature(object = "LDEstimate")}:
+ accessor function for slot \code{location}. }
+
+ \item{show}{\code{signature(object = "LDEstimate")}}
+
+ }
+}
+
+%\references{}
+\author{Matthias Kohl \email{Matthias.Kohl at stamats.de},\cr
+Peter Ruckdeschel \email{Peter.Ruckdeschel at itwm.fraunhofer.de}}
+%\note{}
+\seealso{\code{\link{Estimate-class}}, \code{\link{LDEstimator}},
+ \code{\link{MCEstimator}}}
+\examples{
+## (empirical) Data
+x <- rgamma(50, scale = 0.5, shape = 3)
+
+## parametric family of probability measures
+G <- GammaFamily(scale = 1, shape = 2)
+
+(S <- medQn(x, G))
+dispersion(S)
+location(S)
+}
+\concept{estimate}
+\keyword{classes}
Modified: branches/robast-0.9/pkg/RobExtremes/man/internal-interpolateSn.Rd
===================================================================
--- branches/robast-0.9/pkg/RobExtremes/man/internal-interpolateSn.Rd 2012-05-20 20:35:18 UTC (rev 469)
+++ branches/robast-0.9/pkg/RobExtremes/man/internal-interpolateSn.Rd 2012-05-20 20:41:42 UTC (rev 470)
@@ -68,7 +68,7 @@
### code to produce grid for GPareto:
RobExtremes:::.saveInterpGrid(sysRdaFolder =
"C:/rtest/RobASt/branches/robast-0.9/pkg/RobExtremes/R",
- accuracy = 5000)
+ accuracy = 5000,upp=10)
}
}
\keyword{internal}
More information about the Robast-commits
mailing list