[Robast-commits] r635 - in branches/robast-0.9/pkg: ROptEst/R ROptEst/man RobExtremes/R RobExtremes/inst/AddMaterial/interpolation RobExtremes/man
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Fri Mar 15 13:27:10 CET 2013
Author: ruckdeschel
Date: 2013-03-15 13:27:10 +0100 (Fri, 15 Mar 2013)
New Revision: 635
Modified:
branches/robast-0.9/pkg/ROptEst/R/interpolLM.R
branches/robast-0.9/pkg/ROptEst/R/radiusMinimaxIC.R
branches/robast-0.9/pkg/ROptEst/man/internal-interpolate.Rd
branches/robast-0.9/pkg/ROptEst/man/radiusMinimaxIC.Rd
branches/robast-0.9/pkg/RobExtremes/R/AllClass.R
branches/robast-0.9/pkg/RobExtremes/R/Expectation.R
branches/robast-0.9/pkg/RobExtremes/R/interpolLM.R
branches/robast-0.9/pkg/RobExtremes/inst/AddMaterial/interpolation/interpolationscripts.R
branches/robast-0.9/pkg/RobExtremes/man/E.Rd
branches/robast-0.9/pkg/RobExtremes/man/internal-interpolate.Rd
Log:
(1) for GammaFamily: in RobExtremes overloaded E() method by quantile-trick integration
(2) radiusMinimaxIC gains arguments loRad.s upRad.s to have different search intervals for
inner and outer optimization in RMX -> leave inner range as [0,Inf] and in the sequence of
xi-grid values only search in [r.old/1.4, r.old*1.4] in the outer optimization where
r.old is lf radius from the previous grid value.
(3) as both edges can be critic => start from median grid-value and first go from there to left edge
and then from there to right edge (and afterwards reorder).
Modified: branches/robast-0.9/pkg/ROptEst/R/interpolLM.R
===================================================================
--- branches/robast-0.9/pkg/ROptEst/R/interpolLM.R 2013-03-15 07:53:46 UTC (rev 634)
+++ branches/robast-0.9/pkg/ROptEst/R/interpolLM.R 2013-03-15 12:27:10 UTC (rev 635)
@@ -11,8 +11,11 @@
tol = tol, warn = FALSE,
loRad0 = loRad0, returnNAifProblem = TRUE)
if(is.na(IC)) return(NA)
+ txt <- "least favorable radius:"
+ wL <- grepl(txt, Infos(IC)[,"message"])
+ rad <- as.numeric(gsub(txt, "", Infos(IC)[wL,"message"]))
return(list(b=clip(IC), a=cent(IC), a.w = cent(weight(IC)),
- A=stand(IC), A.w = stand(weight(IC))))
+ A=stand(IC), A.w = stand(weight(IC)), rad=rad))
}
.MBRE.th <- function(th, PFam, modifyfct,
@@ -20,7 +23,7 @@
lower = 1e-4, OptOrIter = "iterate",
maxiter = 50, tol = .Machine$double.eps^0.4, ...){
PFam <- modifyfct(th,PFam)
- RobM <- InfRobModel(center = PFam, neighbor = ContNeighborhood(radius = 15))
+ RobM <- InfRobModel(center = PFam, neighbor = ContNeighborhood(radius = 6))
IC <- optIC(model = RobM, risk = asBias(), verbose = FALSE,
z.start = z.start, A.start = A.start, upper = upper,
lower = lower, OptOrIter = OptOrIter,
@@ -57,13 +60,20 @@
upper = 1e4, lower = 1e-4, OptOrIter = "iterate",
maxiter = 50, tol = .Machine$double.eps^0.4,
loRad = 0, upRad = Inf, loRad0 = 1e-3,
+ loRad.s=0.2, up.Rad.s=1,
withStartLM = TRUE
){
wprint <- function(...){ if (withPrint) print(...)}
thGrid <- unique(sort(thGrid))
+ lG <- length(thGrid)
+ lG2 <- lG%/%2
+ olG <- c(lG2:1,(lG2+1):lG)
+ thGrid <- thGrid[olG]
itLM <- 0
- z.start <- NULL
- A.start <- NULL
+ z1 <- z.start <- NULL
+ A1 <- A.start <- NULL
+ r1l <- r.start.l <- NULL
+ r1u <- r.start.u <- NULL
getLM <- function(th){
itLM <<- itLM + 1
if(withPrint) cat("Evaluation Nr.", itLM," at th = ",th,"\n")
@@ -72,17 +82,35 @@
z.start = z.start, A.start = A.start,
upper = upper, lower = lower, OptOrIter = OptOrIter,
maxiter = maxiter, tol = tol,
- loRad = loRad, upRad = upRad, loRad0 = loRad0),
+ loRad = loRad, upRad = upRad, loRad0 = loRad0,
+ loRad.s = r.start.l, upRad.s = r.start.u),
silent=TRUE)
print(a)
print(A.start)
print(z.start)
+ print(c(r.start.l,r.start.u))
if(is(a,"try-error")|any(is.na(a))){ a <- rep(NA,13)}else{
if(withStartLM){
- pdim <- length(a[["a"]])
- kdim <- length(a[["a.w"]])
+ if(itLM==1){
+ z1 <<- a[["a.w"]]
+ A1 <<- a[["A"]]
+ if(!is.null(a$rad)){
+ r1l <<- max(a[["rad"]]/1.3,loRad)
+ r1u <<- min(a[["rad"]]*1.3,upRad)
+ }
+ }
z.start <<- a[["a.w"]]
- A.start <<- matrix(a[["A"]],pdim,kdim)
+ A.start <<- a[["A"]]
+ if(!is.null(a$rad)){
+ r.start.l <<- max(a[["rad"]]/1.3,loRad)
+ r.start.u <<- min(a[["rad"]]*1.3,upRad)
+ }
+ if(itLM==lG2){
+ z.start <<- z1
+ A.start <<- A1
+ r.start.l <<- r1l
+ r.start.u <<- r1u
+ }
a <- c(a[["b"]],a[["a"]],a[["a.w"]],a[["A"]],a[["A.w"]])
}
}
Modified: branches/robast-0.9/pkg/ROptEst/R/radiusMinimaxIC.R
===================================================================
--- branches/robast-0.9/pkg/ROptEst/R/radiusMinimaxIC.R 2013-03-15 07:53:46 UTC (rev 634)
+++ branches/robast-0.9/pkg/ROptEst/R/radiusMinimaxIC.R 2013-03-15 12:27:10 UTC (rev 635)
@@ -9,7 +9,8 @@
A.start = NULL, upper = NULL, lower = NULL,
OptOrIter = "iterate", maxiter = 50,
tol = .Machine$double.eps^0.4, warn = FALSE,
- verbose = NULL, loRad0 = 1e-3, ..., returnNAifProblem = FALSE){
+ verbose = NULL, loRad0 = 1e-3, ..., returnNAifProblem = FALSE,
+ loRad.s = NULL, upRad.s = NULL){
if(missing(verbose)|| is.null(verbose))
verbose <- getRobAStBaseOption("all.verbose")
ow <- options("warn")
@@ -20,6 +21,7 @@
stop("'upRad' is not of length == 1")
if(loRad >= upRad)
stop("'upRad < loRad' is not fulfilled")
+
biastype <- biastype(risk)
L2derivDim <- numberOfMaps(L2Fam at L2deriv)
trafo <- trafo(L2Fam at param)
@@ -160,8 +162,9 @@
}
}
- lower <- max(loRad, loRad0)
- upper <- if(upRad == Inf) max(lower+2, 4) else upRad
+ lower <- if(is.null(loRad.s)) max(loRad, loRad0) else loRad.s
+ upper <- if(is.null(upRad.s)) {
+ if(upRad == Inf) max(lower+2, 4) else upRad } else upRad.s
leastFavR <- try(
uniroot(fct.Ie, lower = lower, upper = upper,
tol = .Machine$double.eps^0.25)$root , silent = TRUE)
Modified: branches/robast-0.9/pkg/ROptEst/man/internal-interpolate.Rd
===================================================================
--- branches/robast-0.9/pkg/ROptEst/man/internal-interpolate.Rd 2013-03-15 07:53:46 UTC (rev 634)
+++ branches/robast-0.9/pkg/ROptEst/man/internal-interpolate.Rd 2013-03-15 12:27:10 UTC (rev 635)
@@ -38,7 +38,7 @@
upper = 1e4, lower = 1e-4, OptOrIter = "iterate",
maxiter = 50, tol = .Machine$double.eps^0.4,
loRad = 0, upRad = Inf, loRad0 = 1e-3,
- withStartLM = TRUE)
+ loRad.s = 0.2, up.Rad.s = 1, withStartLM = TRUE)
.saveGridToCSV(Grid, toFileCSV, namPFam, nameInSysdata)
@@ -62,8 +62,19 @@
\item{radius}{ [for OMSE]: positive numeric of length 1: the radius of the
neighborhood for which the LM's are to be computed;
defaults to 0.5. }
- \item{loRad}{ the lower end point of the interval to be searched. }
- \item{upRad}{ the upper end point of the interval to be searched. }
+ \item{loRad}{ the lower end point of the interval to be searched
+ in the inner optimization (for the least favorable situation
+ to the user-guessed radius). }
+ \item{upRad}{ the upper end point of the interval to be searched in the
+ inner optimization (for the least favorable situation
+ to the user-guessed radius). }
+ \item{loRad.s}{ the lower end point of the interval
+ to be searched in the outer optimization
+ (for the user-guessed radius); if \code{NULL}
+ set to \code{loRad} in the algorithm. }
+ \item{upRad.s}{ the upper end point of the interval to be searched in the
+ outer optimization (for the user-guessed radius); if
+ \code{NULL} set to \code{upRad} in the algorithm. }
\item{z.start}{ initial value for the centering constant. }
\item{A.start}{ initial value for the standardizing matrix. }
\item{upper}{ upper bound for the optimal clipping bound. }
Modified: branches/robast-0.9/pkg/ROptEst/man/radiusMinimaxIC.Rd
===================================================================
--- branches/robast-0.9/pkg/ROptEst/man/radiusMinimaxIC.Rd 2013-03-15 07:53:46 UTC (rev 634)
+++ branches/robast-0.9/pkg/ROptEst/man/radiusMinimaxIC.Rd 2013-03-15 12:27:10 UTC (rev 635)
@@ -15,14 +15,18 @@
upper = NULL, lower = NULL, OptOrIter = "iterate",
maxiter = 50, tol = .Machine$double.eps^0.4,
warn = FALSE, verbose = NULL, loRad0 = 1e-3, ...,
- returnNAifProblem = FALSE)
+ returnNAifProblem = FALSE, loRad.s = NULL, upRad.s = NULL)
}
\arguments{
\item{L2Fam}{ L2-differentiable family of probability measures. }
\item{neighbor}{ object of class \code{"Neighborhood"}. }
\item{risk}{ object of class \code{"RiskType"}. }
- \item{loRad}{ the lower end point of the interval to be searched. }
- \item{upRad}{ the upper end point of the interval to be searched. }
+ \item{loRad}{ the lower end point of the interval to be searched
+ in the inner optimization (for the least favorable situation
+ to the user-guessed radius). }
+ \item{upRad}{ the upper end point of the interval to be searched in the
+ inner optimization (for the least favorable situation
+ to the user-guessed radius). }
\item{z.start}{ initial value for the centering constant. }
\item{A.start}{ initial value for the standardizing matrix. }
\item{upper}{ upper bound for the optimal clipping bound. }
@@ -46,6 +50,13 @@
\item{returnNAifProblem}{logical (of length 1):
if \code{TRUE} (not the default), in case of convergence problems in
the algorithm, returns \code{NA}. }
+ \item{loRad.s}{ the lower end point of the interval
+ to be searched in the outer optimization
+ (for the user-guessed radius); if \code{NULL} (default)
+ set to \code{loRad} in the algorithm. }
+ \item{upRad.s}{ the upper end point of the interval to be searched in the
+ outer optimization (for the user-guessed radius); if
+ \code{NULL} (default) set to \code{upRad} in the algorithm. }
}
\details{
In case the neighborhood radius is unknown, Rieder et al. (2001, 2008)
Modified: branches/robast-0.9/pkg/RobExtremes/R/AllClass.R
===================================================================
--- branches/robast-0.9/pkg/RobExtremes/R/AllClass.R 2013-03-15 07:53:46 UTC (rev 634)
+++ branches/robast-0.9/pkg/RobExtremes/R/AllClass.R 2013-03-15 12:27:10 UTC (rev 635)
@@ -235,7 +235,7 @@
### for integration:
setClassUnion("DistributionsIntegratingByQuantiles",
- c("Weibull", "GEV", "GPareto", "Pareto"))
+ c("Weibull", "GEV", "GPareto", "Pareto", "Gammad"))
## models:
Modified: branches/robast-0.9/pkg/RobExtremes/R/Expectation.R
===================================================================
--- branches/robast-0.9/pkg/RobExtremes/R/Expectation.R 2013-03-15 07:53:46 UTC (rev 634)
+++ branches/robast-0.9/pkg/RobExtremes/R/Expectation.R 2013-03-15 12:27:10 UTC (rev 635)
@@ -150,3 +150,7 @@
signature(object = "DistributionsIntegratingByQuantiles",
fun = "function", cond = "missing")))
+setMethod("E", signature(object = "Gammad", fun = "function", cond = "missing"),
+ getMethod("E",
+ signature(object = "DistributionsIntegratingByQuantiles",
+ fun = "function", cond = "missing")))
Modified: branches/robast-0.9/pkg/RobExtremes/R/interpolLM.R
===================================================================
--- branches/robast-0.9/pkg/RobExtremes/R/interpolLM.R 2013-03-15 07:53:46 UTC (rev 634)
+++ branches/robast-0.9/pkg/RobExtremes/R/interpolLM.R 2013-03-15 12:27:10 UTC (rev 635)
@@ -37,6 +37,7 @@
upper = 1e4, lower = 1e-4, OptOrIter = "iterate",
maxiter = 150, tol = .Machine$double.eps^0.5,
loRad = 0, upRad = Inf, loRad0 = 1e-3,
+ loRad.s=0.2, up.Rad.s=1,
withStartLM = TRUE){
namF <- gsub("\\.th$","",paste(deparse(substitute(optF))))
namF <- gsub("^\\.(.+)","\\1",namF)
@@ -50,7 +51,8 @@
nameInSysdata = namF, withPrint = TRUE, radius = radius,
upper = upper, lower = lower, OptOrIter = OptOrIter,
maxiter = maxiter, tol = tol, loRad = loRad, upRad = upRad,
- loRad0 = loRad0, withStartLM = withStartLM)
+ loRad0 = loRad0, loRad.s = loRad.s, up.Rad.s = up.Rad.s,
+ withStartLM = withStartLM)
}
Modified: branches/robast-0.9/pkg/RobExtremes/inst/AddMaterial/interpolation/interpolationscripts.R
===================================================================
--- branches/robast-0.9/pkg/RobExtremes/inst/AddMaterial/interpolation/interpolationscripts.R 2013-03-15 07:53:46 UTC (rev 634)
+++ branches/robast-0.9/pkg/RobExtremes/inst/AddMaterial/interpolation/interpolationscripts.R 2013-03-15 12:27:10 UTC (rev 635)
@@ -21,11 +21,11 @@
#PF <- WeibullFamily()
###
.svInt <- RobExtremes:::.svInt
-.svInt1 <- function(){
- RobExtremes:::.generateInterpGridSn(PFam = PF)}
+#.svInt1 <- function(){
+# RobExtremes:::.generateInterpGridSn(PFam = PF)}
## to make this parallel, start this on several processors
#.svInt1()
-.svInt(.OMSE.th, PFam=PF)
-.svInt(.MBRE.th, PFam=PF)
+#.svInt(.OMSE.th, PFam=PF)
+#.svInt(.MBRE.th, PFam=PF)
.svInt(.RMXE.th, PFam=PF)
setwd(oldwd)
Modified: branches/robast-0.9/pkg/RobExtremes/man/E.Rd
===================================================================
--- branches/robast-0.9/pkg/RobExtremes/man/E.Rd 2013-03-15 07:53:46 UTC (rev 634)
+++ branches/robast-0.9/pkg/RobExtremes/man/E.Rd 2013-03-15 12:27:10 UTC (rev 635)
@@ -10,6 +10,8 @@
\alias{E,Weibull,function,missing-method}
\alias{E,GEV,missing,missing-method}
\alias{E,Pareto,missing,missing-method}
+\alias{E,Gammad,function,missing-method}
+\alias{E,Pareto,function,missing-method}
\title{Generic Function for the Computation of (Conditional) Expectations}
\description{
Modified: branches/robast-0.9/pkg/RobExtremes/man/internal-interpolate.Rd
===================================================================
--- branches/robast-0.9/pkg/RobExtremes/man/internal-interpolate.Rd 2013-03-15 07:53:46 UTC (rev 634)
+++ branches/robast-0.9/pkg/RobExtremes/man/internal-interpolate.Rd 2013-03-15 12:27:10 UTC (rev 635)
@@ -36,7 +36,7 @@
PFam = GParetoFamily(shape=1,scale=2), radius = 0.5, upper = 1e4,
lower = 1e-4, OptOrIter = "iterate", maxiter = 150,
tol = .Machine$double.eps^0.5, loRad = 0, upRad = Inf, loRad0 = 1e-3,
- withStartLM = TRUE)
+ loRad.s = 0.2, up.Rad.s = 1, withStartLM = TRUE)
.generateInterpGridSn(xiGrid = getShapeGrid(500, cutoff.at.0=0.005),
PFam = GParetoFamily(), withPrint = TRUE)
@@ -66,8 +66,19 @@
\item{radius}{ [for OMSE]: positive numeric of length 1: the radius of the
neighborhood for which the LM's are to be computed;
defaults to 0.5. }
- \item{loRad}{ the lower end point of the interval to be searched. }
- \item{upRad}{ the upper end point of the interval to be searched. }
+ \item{loRad}{ the lower end point of the interval to be searched
+ in the inner optimization (for the least favorable situation
+ to the user-guessed radius). }
+ \item{upRad}{ the upper end point of the interval to be searched in the
+ inner optimization (for the least favorable situation
+ to the user-guessed radius). }
+ \item{loRad.s}{ the lower end point of the interval
+ to be searched in the outer optimization
+ (for the user-guessed radius); if \code{NULL}
+ set to \code{loRad} in the algorithm. }
+ \item{upRad.s}{ the upper end point of the interval to be searched in the
+ outer optimization (for the user-guessed radius); if
+ \code{NULL} set to \code{upRad} in the algorithm. }
\item{upper}{ upper bound for the optimal clipping bound. }
\item{lower}{ lower bound for the optimal clipping bound. }
\item{OptOrIter}{character; which method to be used for determining Lagrange
More information about the Robast-commits
mailing list