[Robast-commits] r575 - in branches/robast-0.9/pkg: ROptEst/R RobAStBase/R RobExtremes RobExtremes/R RobExtremes/man
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Mon Jan 28 03:57:31 CET 2013
Author: ruckdeschel
Date: 2013-01-28 03:57:29 +0100 (Mon, 28 Jan 2013)
New Revision: 575
Modified:
branches/robast-0.9/pkg/ROptEst/R/roptest.new.R
branches/robast-0.9/pkg/RobAStBase/R/kStepEstimator.R
branches/robast-0.9/pkg/RobExtremes/NAMESPACE
branches/robast-0.9/pkg/RobExtremes/R/Expectation.R
branches/robast-0.9/pkg/RobExtremes/R/GEVFamily.R
branches/robast-0.9/pkg/RobExtremes/R/LDEstimator.R
branches/robast-0.9/pkg/RobExtremes/R/PickandsEstimator.R
branches/robast-0.9/pkg/RobExtremes/man/LDEstimator.Rd
branches/robast-0.9/pkg/RobExtremes/man/PickandsEstimator.Rd
Log:
RobAstBase: + interchanged order of ParamFamily and k (medkMAD) and alpha (PickandsEstimator);
+ in kStepEstimator we force an argument list (to avoid an "argument missing" error)
+ in roptest forgot to treat the case when additional arguments are passed to the initial estimator
Modified: branches/robast-0.9/pkg/ROptEst/R/roptest.new.R
===================================================================
--- branches/robast-0.9/pkg/ROptEst/R/roptest.new.R 2013-01-28 02:34:18 UTC (rev 574)
+++ branches/robast-0.9/pkg/ROptEst/R/roptest.new.R 2013-01-28 02:57:29 UTC (rev 575)
@@ -147,9 +147,17 @@
}
}else{
sy.start <- system.time({
- initial.est <- kStepEstimator.start(eval(startCtrl$initial.est), x = x,
+ sctrl.init <- eval(startCtrl$initial.est)
+ if(!is.null(startCtrl$initial.est.ArgList)){
+ initial.est <- kStepEstimator.start(start = sctrl.init, x = x,
nrvalues = nrvalues, na.rm = na.rm,
L2Fam = L2Fam)
+ }else{
+ initial.est <- kStepEstimator.start(start = sctrl.init, x = x,
+ nrvalues = nrvalues, na.rm = na.rm,
+ L2Fam = L2Fam,
+ startList = startCtrl$initial.est.ArgList)
+ }
})
if(withTimings) print(sy.start)
}
@@ -191,6 +199,7 @@
if (withTimings) print(sy.getStartIC)
}
if(debug){
+ ICstart <- "BUL"
argList <- list(x, IC = ICstart, start = initial.est, steps = steps,
useLast = kStepCtrl$useLast,
withUpdateInKer = kStepCtrl$withUpdateInKer,
Modified: branches/robast-0.9/pkg/RobAStBase/R/kStepEstimator.R
===================================================================
--- branches/robast-0.9/pkg/RobAStBase/R/kStepEstimator.R 2013-01-28 02:34:18 UTC (rev 574)
+++ branches/robast-0.9/pkg/RobAStBase/R/kStepEstimator.R 2013-01-28 02:57:29 UTC (rev 575)
@@ -73,6 +73,7 @@
### use dispatch here (dispatch only on start)
a.var <- if( is(start, "Estimate")) asvar(start) else NULL
IC.UpdateInKer.0 <- if(is(start,"ALEstimate")) start at pIC else NULL
+ force(startArgList)
start.val <- kStepEstimator.start(start, x=x0, nrvalues = k,
na.rm = na.rm, L2Fam = L2Fam,
startList = startArgList)
Modified: branches/robast-0.9/pkg/RobExtremes/NAMESPACE
===================================================================
--- branches/robast-0.9/pkg/RobExtremes/NAMESPACE 2013-01-28 02:34:18 UTC (rev 574)
+++ branches/robast-0.9/pkg/RobExtremes/NAMESPACE 2013-01-28 02:57:29 UTC (rev 575)
@@ -31,4 +31,4 @@
export("getShapeGrid", "getSnGrid",
"PickandsEstimator","QuantileBCCEstimator")
export("loc", "loc<-", "kMAD", "Sn", "Qn",
- "asvarMedkMAD","asvarPickands", "asvarQBCC")
\ No newline at end of file
+ "asvarMedkMAD","asvarPickands", "asvarQBCC")
Modified: branches/robast-0.9/pkg/RobExtremes/R/Expectation.R
===================================================================
--- branches/robast-0.9/pkg/RobExtremes/R/Expectation.R 2013-01-28 02:34:18 UTC (rev 574)
+++ branches/robast-0.9/pkg/RobExtremes/R/Expectation.R 2013-01-28 02:57:29 UTC (rev 575)
@@ -76,7 +76,7 @@
upp <- p(object)(Ib["upp"])
if(is.nan(low)) low <- 0
if(is.nan(upp)) upp <- 1
- return(do.call(distrExIntegrate, c(list(f = integrand,
+ return(do.call(distrExIntegrate, c(list(f = integrand,
lower = low,
upper = upp,
rel.tol = rel.tol,
@@ -137,7 +137,7 @@
else return(mu+sigma*(gamma(1-xi)-1)/xi)
}
else
- return(E(as(object,"AbscontDistribution"), low=low, upp=upp, ...))
+ return(E(object, low=low, upp=upp, fun = function(x)x, ...))
})
setMethod("E", signature(object = "GEV", fun = "function", cond = "missing"),
Modified: branches/robast-0.9/pkg/RobExtremes/R/GEVFamily.R
===================================================================
--- branches/robast-0.9/pkg/RobExtremes/R/GEVFamily.R 2013-01-28 02:34:18 UTC (rev 574)
+++ branches/robast-0.9/pkg/RobExtremes/R/GEVFamily.R 2013-01-28 02:57:29 UTC (rev 575)
@@ -217,7 +217,7 @@
## Pickand estimator
if(is.null(start0Est)){
#source("kMedMad_Qn_Estimators.R")
- e0 <- estimate(PickandsEstimator(x,ParamFamily=GParetoFamily(
+ e0 <- estimate(PickandsEstimator(x,ParamFamily=GEVFamily(
loc = theta[1], scale = theta[2], shape = theta[3])))
}else{
if(is(start0Est,"function")){
@@ -227,6 +227,7 @@
if(!is.null(names(e0)))
e0 <- e0[c("scale", "shape")]
}
+ print(e0); print(str(x)); print(head(summary(x))); print(mu)
if(any(x < mu-e0["scale"]/e0["shape"]))
stop("some data smaller than 'loc-scale/shape' ")
@@ -289,8 +290,10 @@
return(y)
}
## additional centering of scores to increase numerical precision!
+ suppressWarnings({
z1 <- E(distribution, fun=Lambda1)
z2 <- E(distribution, fun=Lambda2)
+ })
return(list(function(x){ Lambda1(x)-z1 },function(x){ Lambda2(x)-z2 }))
}
@@ -355,6 +358,9 @@
}
L2Fam at L2deriv <- L2deriv
+ wG <- getdistrOption("withgaps")
+ on.exit(distroptions(withgaps=wG))
+ distroptions(withgaps=FALSE)
suppressWarnings(
L2Fam at L2derivDistr <- imageDistr(RandVar = L2deriv, distr = distribution)
)
Modified: branches/robast-0.9/pkg/RobExtremes/R/LDEstimator.R
===================================================================
--- branches/robast-0.9/pkg/RobExtremes/R/LDEstimator.R 2013-01-28 02:34:18 UTC (rev 574)
+++ branches/robast-0.9/pkg/RobExtremes/R/LDEstimator.R 2013-01-28 02:57:29 UTC (rev 575)
@@ -125,7 +125,7 @@
}
-medkMAD <- function(x, k=1, ParamFamily, q.lo =1e-3, q.up=15, nuis.idx = NULL,
+medkMAD <- function(x, ParamFamily, k=1, q.lo =1e-3, q.up=15, nuis.idx = NULL,
trafo = NULL, fixed = NULL, asvar.fct = NULL, na.rm = TRUE,
..., vdbg = FALSE){
es.call <- match.call()
@@ -186,12 +186,12 @@
return(es)
}
-medkMADhybr <- function(x, k=1, ParamFamily, q.lo =1e-3, q.up=15,
+medkMADhybr <- function(x, ParamFamily, k=1, q.lo =1e-3, q.up=15,
KK=20, nuis.idx = NULL,
trafo = NULL, fixed = NULL, asvar.fct = NULL, na.rm = TRUE,
...){
i <- 1
- es <- try(medkMAD(x, k = k, ParamFamily = ParamFamily,
+ es <- try(medkMAD(x, ParamFamily = ParamFamily, k = k,
q.lo = q.lo, q.up = q.up,
nuis.idx = nuis.idx, trafo = trafo,
fixed = fixed, asvar.fct = asvar.fct, na.rm = na.rm,
Modified: branches/robast-0.9/pkg/RobExtremes/R/PickandsEstimator.R
===================================================================
--- branches/robast-0.9/pkg/RobExtremes/R/PickandsEstimator.R 2013-01-28 02:34:18 UTC (rev 574)
+++ branches/robast-0.9/pkg/RobExtremes/R/PickandsEstimator.R 2013-01-28 02:57:29 UTC (rev 575)
@@ -36,7 +36,7 @@
return(theta)
}
-PickandsEstimator <- function(x, alpha = 2, ParamFamily=GParetoFamily(),
+PickandsEstimator <- function(x, ParamFamily=GParetoFamily(), alpha = 2,
name, Infos, nuis.idx = NULL,
trafo = NULL, fixed = NULL, na.rm = TRUE,
...){
Modified: branches/robast-0.9/pkg/RobExtremes/man/LDEstimator.Rd
===================================================================
--- branches/robast-0.9/pkg/RobExtremes/man/LDEstimator.Rd 2013-01-28 02:34:18 UTC (rev 574)
+++ branches/robast-0.9/pkg/RobExtremes/man/LDEstimator.Rd 2013-01-28 02:57:29 UTC (rev 575)
@@ -21,10 +21,10 @@
name, Infos, asvar = NULL, nuis.idx = NULL,
trafo = NULL, fixed = NULL, asvar.fct = NULL, na.rm = TRUE,
..., vdbg = FALSE)
-medkMAD(x, k=1, ParamFamily, q.lo =1e-3, q.up=15, nuis.idx = NULL,
+medkMAD(x, ParamFamily, k=1, q.lo =1e-3, q.up=15, nuis.idx = NULL,
trafo = NULL, fixed = NULL, asvar.fct = NULL, na.rm = TRUE,
..., vdbg = FALSE)
-medkMADhybr(x, k=1, ParamFamily, q.lo =1e-3, q.up=15, KK = 20, nuis.idx = NULL,
+medkMADhybr(x, ParamFamily, k=1, q.lo =1e-3, q.up=15, KK = 20, nuis.idx = NULL,
trafo = NULL, fixed = NULL, asvar.fct = NULL, na.rm = TRUE,
...)
medSn(x, ParamFamily, q.lo =1e-3, q.up=10, nuis.idx = NULL,
Modified: branches/robast-0.9/pkg/RobExtremes/man/PickandsEstimator.Rd
===================================================================
--- branches/robast-0.9/pkg/RobExtremes/man/PickandsEstimator.Rd 2013-01-28 02:34:18 UTC (rev 574)
+++ branches/robast-0.9/pkg/RobExtremes/man/PickandsEstimator.Rd 2013-01-28 02:57:29 UTC (rev 575)
@@ -8,7 +8,7 @@
(for the GPD and GEVD) at real data and returns an object of class \code{Estimate}.
}
\usage{
-PickandsEstimator(x, alpha=2, ParamFamily=GParetoFamily(),
+PickandsEstimator(x, ParamFamily=GParetoFamily(), alpha=2,
name, Infos, nuis.idx = NULL,
trafo = NULL, fixed = NULL, na.rm = TRUE,
...)
More information about the Robast-commits
mailing list