[Robast-commits] r1108 - in branches/robast-1.2/pkg: ROptEst/R RobAStBase/R RobExtremes/R
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Mon Aug 6 22:51:33 CEST 2018
Author: ruckdeschel
Date: 2018-08-06 22:51:33 +0200 (Mon, 06 Aug 2018)
New Revision: 1108
Modified:
branches/robast-1.2/pkg/ROptEst/R/getModifyIC.R
branches/robast-1.2/pkg/ROptEst/R/getStartIClcsc.R
branches/robast-1.2/pkg/RobAStBase/R/IC.R
branches/robast-1.2/pkg/RobAStBase/R/kStepEstimator.R
branches/robast-1.2/pkg/RobExtremes/R/getStartIC.R
branches/robast-1.2/pkg/RobExtremes/R/getStartICPareto.R
branches/robast-1.2/pkg/RobExtremes/R/gevgpddiag.R
Log:
[RobAStBase,ROptEst,RobExtremes] branch 2.8 some bug fixes and defaults in withMakeIC to FALSE
Modified: branches/robast-1.2/pkg/ROptEst/R/getModifyIC.R
===================================================================
--- branches/robast-1.2/pkg/ROptEst/R/getModifyIC.R 2018-08-06 18:39:39 UTC (rev 1107)
+++ branches/robast-1.2/pkg/ROptEst/R/getModifyIC.R 2018-08-06 20:51:33 UTC (rev 1108)
@@ -10,7 +10,7 @@
dots <- mcl[["..."]]
dots$verbose <- NULL
dots$warn <- FALSE
- modIC <- function(L2Fam, IC, withMakeIC){}
+ modIC <- function(L2Fam, IC, withMakeIC = FALSE){}
body(modIC) <- substitute({ verbose <- getRobAStBaseOption("all.verbose")
infMod <- InfRobModel(L2Fam, nghb)
IC.0 <- do.call(optIC, args = c(list(infMod, risk=R),
@@ -26,7 +26,7 @@
setMethod("getModifyIC", signature(L2FamIC = "L2LocationFamily",
neighbor = "UncondNeighborhood", risk = "asGRisk"),
function(L2FamIC, neighbor, risk, ...){
- modIC <- function(L2Fam, IC, withMakeIC){
+ modIC <- function(L2Fam, IC, withMakeIC = FALSE){
D <- distribution(eval(CallL2Fam(IC)))
if(is(L2Fam, "L2LocationFamily") && is(distribution(L2Fam), class(D))){
CallL2Fam(IC) <- fam.call(L2Fam)
@@ -114,7 +114,7 @@
function(L2FamIC, neighbor, risk, ..., modifyICwarn = NULL){
if(missing(modifyICwarn)|| is.null(modifyICwarn))
modifyICwarn <- getRobAStBaseOption("modifyICwarn")
- modIC <- function(L2Fam, IC, withMakeIC){
+ modIC <- function(L2Fam, IC, withMakeIC = FALSE){
ICL2Fam <- eval(CallL2Fam(IC))
if(is(L2Fam, "L2ScaleFamily") && is(distribution(L2Fam), class(distribution(ICL2Fam)))){
res <- scaleUpdateIC(sdneu = main(L2Fam),
@@ -139,7 +139,7 @@
if(missing(modifyICwarn)|| is.null(modifyICwarn))
modifyICwarn <- getRobAStBaseOption("modifyICwarn")
- modIC <- function(L2Fam, IC, withMakeIC){
+ modIC <- function(L2Fam, IC, withMakeIC = FALSE){
ICL2Fam <- eval(CallL2Fam(IC))
if(is(L2Fam, "L2LocationScaleFamily") && is(distribution(L2Fam),
class(distribution(ICL2Fam)))){
Modified: branches/robast-1.2/pkg/ROptEst/R/getStartIClcsc.R
===================================================================
--- branches/robast-1.2/pkg/ROptEst/R/getStartIClcsc.R 2018-08-06 18:39:39 UTC (rev 1107)
+++ branches/robast-1.2/pkg/ROptEst/R/getStartIClcsc.R 2018-08-06 20:51:33 UTC (rev 1108)
@@ -25,14 +25,14 @@
if(length(nsng)){
if(gridn %in% nsng){
LMref <- famg[[gridn]]
- .modifyIC0 <- function(L2Fam, IC, withMakeIC){
+ .modifyIC0 <- function(L2Fam, IC, withMakeIC = FALSE){
para <- param(L2Fam)
return(intfct(para, LMref, L2Fam, type(risk)))
}
- .modifyIC <- function(L2Fam,IC, withMakeIC){
- psi.0 <- .modifyIC0(L2Fam,IC, withMakeIC)
- psi.0 at modifyIC <- .modifyIC0
+ .modifyIC <- function(L2Fam,IC, withMakeIC = FALSE){
+ psi.0 <- .modifyIC0(L2Fam,IC, withMakeIC = withMakeIC)
+ psi.0 at modifyIC <- .modifyIC
return(psi.0)
}
Modified: branches/robast-1.2/pkg/RobAStBase/R/IC.R
===================================================================
--- branches/robast-1.2/pkg/RobAStBase/R/IC.R 2018-08-06 18:39:39 UTC (rev 1107)
+++ branches/robast-1.2/pkg/RobAStBase/R/IC.R 2018-08-06 20:51:33 UTC (rev 1108)
@@ -149,7 +149,7 @@
if(!is.function(IC at modifyIC))
- IC at modifyIC <- function(L2Fam, IC, withMakeIC) return(makeIC(IC,L2Fam))
+ IC at modifyIC <- function(L2Fam, IC, withMakeIC = FALSE) return(makeIC(IC,L2Fam))
# modifyIC <- ..modifnew
# }else{
# .modifyIC <- IC at modifyIC
Modified: branches/robast-1.2/pkg/RobAStBase/R/kStepEstimator.R
===================================================================
--- branches/robast-1.2/pkg/RobAStBase/R/kStepEstimator.R 2018-08-06 18:39:39 UTC (rev 1107)
+++ branches/robast-1.2/pkg/RobAStBase/R/kStepEstimator.R 2018-08-06 20:51:33 UTC (rev 1108)
@@ -132,8 +132,7 @@
### update - function
updateStep <- function(u.theta, theta, IC, L2Fam, Param,
withPreModif = FALSE,
- withPostModif = TRUE, with.u.var = FALSE,
- oldmodifIC = NULL
+ withPostModif = TRUE, with.u.var = FALSE
){
if(withPreModif){
@@ -146,7 +145,7 @@
.withL2derivDistr = L2Fam at .withEvalL2derivDistr)
# print(L2Fam)
IC <- modifyIC(IC)(L2Fam, IC, withMakeIC = FALSE)
- if(steps==1L &&withMakeIC){
+ if(steps==1L && withMakeIC){
IC <- makeIC(IC, L2Fam)
# IC at modifyIC <- oldmodifIC
}
@@ -272,14 +271,13 @@
rownames(uksteps) <- u.est.names
if(!is(modifyIC(IC), "NULL") ){
for(i in 1:steps){
- modif.old <- modifyIC(IC)
+# modif.old <- modifyIC(IC)
if(i>1){
IC <- upd$IC
L2Fam <- upd$L2Fam
- if((i==steps)&&withMakeIC){
- IC <- makeIC(IC,L2Fam)
+ if((i==steps)&&withMakeIC) IC <- makeIC(IC,L2Fam)
# IC at modifyIC <- modif.old
- }
+
Param <- upd$Param
tf <- trafo(L2Fam, Param)
withPre <- FALSE
@@ -287,7 +285,7 @@
upd <- updateStep(u.theta,theta,IC, L2Fam, Param,
withPreModif = withPre,
withPostModif = (steps>i) | useLast,
- with.u.var = i==steps, oldmodifIC = modif.old)
+ with.u.var = (i==steps), oldmodifIC = modif.old)
uksteps[,i] <- u.theta <- upd$u.theta
# print(str(upd$theta))
# print(nrow(ksteps))
Modified: branches/robast-1.2/pkg/RobExtremes/R/getStartIC.R
===================================================================
--- branches/robast-1.2/pkg/RobExtremes/R/getStartIC.R 2018-08-06 18:39:39 UTC (rev 1107)
+++ branches/robast-1.2/pkg/RobExtremes/R/getStartIC.R 2018-08-06 20:51:33 UTC (rev 1108)
@@ -26,10 +26,11 @@
if(length(nsng)){
if(gridn %in% nsng){
interpolfct <- famg[[gridn]][[.versionSuff("fun")]]
- .modifyIC0 <- function(L2Fam, IC, withMakeIC){
+ .modifyIC0 <- function(L2Fam, IC, withMakeIC = FALSE){
para <- param(L2Fam)
if(!.is.na.Psi(para, interpolfct, shnam))
- return(.getPsi(para, interpolfct, L2Fam, type(risk), withMakeIC))
+ return(.getPsi(para, interpolfct, L2Fam, type(risk),
+ withMakeIC = withMakeIC))
else{
IC0 <- do.call(getStartIC, as.list(mc[-1]),
envir=parent.frame(2))
@@ -37,14 +38,14 @@
return(IC0)
}
}
- .modifyIC <- function(L2Fam,IC, withMakeIC){
- psi.0 <- .modifyIC0(L2Fam,IC, withMakeIC)
- psi.0 at modifyIC <- .modifyIC0
+ .modifyIC <- function(L2Fam,IC, withMakeIC = FALSE){
+ psi.0 <- .modifyIC0(L2Fam,IC, withMakeIC = withMakeIC)
+ psi.0 at modifyIC <- .modifyIC
return(psi.0)
}
if(!.is.na.Psi(param1, interpolfct, shnam)){
- IC0 <- .getPsi(param1, interpolfct, model, type(risk), withMakeIC)
+ IC0 <- .getPsi(param1, interpolfct, model, type(risk), withMakeIC = withMakeIC)
IC0 at modifyIC <- .modifyIC
return(IC0)
}
@@ -63,7 +64,6 @@
mc$risk <- if(type(risk)==".MBRE") asMSE() else asBias()
mc$neighbor <- ContNeighborhood(radius=0.5)
-
gridn <- gsub("\\.","",type(risk))
nam <- paste(".",gsub("[F,f]amily","",gsub(" ","",name(model))),sep="")
@@ -80,40 +80,27 @@
if(length(nsng)){
if(gridn %in% nsng){
interpolfct <- famg[[gridn]][[.versionSuff("fun")]]
- if(withMakeIC){
- .modifyIC0 <- function(L2Fam, IC){
+ .modifyIC0 <- function(L2Fam, IC, withMakeIC = FALSE){
para <- param(L2Fam)
if(!.is.na.Psi(para, interpolfct, shnam))
- return(.getPsi.wL(para, interpolfct, L2Fam, type(risk), withMakeIC))
+ return(.getPsi.wL(para, interpolfct, L2Fam, type(risk),
+ withMakeIC = withMakeIC))
else{
IC0 <- do.call(getStartIC, as.list(mc[-1]),
envir=parent.frame(2))
- IC0 <- makeIC(IC0, L2Fam)
+ if(withMakeIC) IC0 <- makeIC(IC0, L2Fam)
return(IC0)
}
- }
- }else{
- .modifyIC0 <- function(L2Fam, IC){
- para <- param(L2Fam)
- if(!.is.na.Psi(para, interpolfct, shnam))
- return(.getPsi.wL(para, interpolfct, L2Fam, type(risk), withMakeIC))
- else{
- IC0 <- do.call(getStartIC, as.list(mc[-1]),
- envir=parent.frame(2))
- return(IC0)
- }
- }
}
- if(withMakeIC) attr(.modifyIC0,"hasMakeICin.modifyIC") <- TRUE
- .modifyIC <- function(L2Fam,IC){
- psi.0 <- .modifyIC0(L2Fam,IC)
+ .modifyIC <- function(L2Fam,IC, withMakeIC = FALSE){
+ psi.0 <- .modifyIC0(L2Fam,IC, withMakeIC = withMakeIC)
psi.0 at modifyIC <- .modifyIC
return(psi.0)
}
- if(withMakeIC) attr(.modifyIC,"hasMakeICin.modifyIC") <- TRUE
if(!.is.na.Psi(param1, interpolfct, shnam)){
- IC0 <- .getPsi.wL(param1, interpolfct, model, type(risk), withMakeIC)
+ IC0 <- .getPsi.wL(param1, interpolfct, model, type(risk),
+ withMakeIC = withMakeIC)
IC0 at modifyIC <- .modifyIC
return(IC0)
}
Modified: branches/robast-1.2/pkg/RobExtremes/R/getStartICPareto.R
===================================================================
--- branches/robast-1.2/pkg/RobExtremes/R/getStartICPareto.R 2018-08-06 18:39:39 UTC (rev 1107)
+++ branches/robast-1.2/pkg/RobExtremes/R/getStartICPareto.R 2018-08-06 20:51:33 UTC (rev 1108)
@@ -3,18 +3,16 @@
param1 <- param(model)
xi <- main(param1)
- .modifyIC0 <- function(L2Fam, IC, withMakeIC){
+ .modifyIC0 <- function(L2Fam, IC, withMakeIC = FALSE){
xi0 <- main(param(L2Fam))
- return(.getPsi.P(xi0, L2Fam, type(risk), withMakeIC))
+ return(.getPsi.P(xi0, L2Fam, type(risk), withMakeIC = withMakeIC))
}
- attr(.modifyIC0,"hasMakeICin.modifyIC") <- TRUE
- .modifyIC <- function(L2Fam,IC, withMakeIC){
- psi.0 <- .modifyIC0(L2Fam,IC, withMakeIC)
- psi.0 at modifyIC <- .modifyIC0
+ .modifyIC <- function(L2Fam,IC, withMakeIC = FALSE){
+ psi.0 <- .modifyIC0(L2Fam,IC, withMakeIC = withMakeIC)
+ psi.0 at modifyIC <- .modifyIC
return(psi.0)
}
- attr(.modifyIC,"hasMakeICin.modifyIC") <- TRUE
- IC0 <- .getPsi.P(xi, model, type(risk), withMakeIC)
+ IC0 <- .getPsi.P(xi, model, type(risk), withMakeIC = withMakeIC)
IC0 at modifyIC <- .modifyIC
return(IC0)
})
Modified: branches/robast-1.2/pkg/RobExtremes/R/gevgpddiag.R
===================================================================
--- branches/robast-1.2/pkg/RobExtremes/R/gevgpddiag.R 2018-08-06 18:39:39 UTC (rev 1107)
+++ branches/robast-1.2/pkg/RobExtremes/R/gevgpddiag.R 2018-08-06 20:51:33 UTC (rev 1108)
@@ -74,7 +74,7 @@
es.call <- z at estimate.call
nm.call <- names(es.call)
if("pIC" %in% names(getSlots(class(z)))){
- PFam0 <- eval(z at pIC@CallL2Fam)
+ PFam0 <- eval(pIC(z)@CallL2Fam)
}else{
PFam <- NULL
if("ParamFamily" %in% nm.call)
More information about the Robast-commits
mailing list