[Robast-commits] r722 - in branches/robast-1.0/pkg: RobAStBase/R RobExtremes/R

[noreply at r-forge.r-project.org]

Author: ruckdeschel
Date: 2014-02-24 18:58:37 +0100 (Mon, 24 Feb 2014)
New Revision: 722

Modified:
   branches/robast-1.0/pkg/RobAStBase/R/ddPlot_utils.R
   branches/robast-1.0/pkg/RobAStBase/R/kStepEstimator.R
   branches/robast-1.0/pkg/RobExtremes/R/getStartIC.R
Log:
RobAStBase: introduce jitter for points in ddPlot for DiscreteDistributions
RobAStBase/RobExtremes: fixed issue with updateStep in kStepEstimator when using interpol risks (somehow modifyIC had not been attached in prior steps...)

Modified: branches/robast-1.0/pkg/RobAStBase/R/ddPlot_utils.R
===================================================================
--- branches/robast-1.0/pkg/RobAStBase/R/ddPlot_utils.R	2014-02-22 23:36:16 UTC (rev 721)
+++ branches/robast-1.0/pkg/RobAStBase/R/ddPlot_utils.R	2014-02-24 17:58:37 UTC (rev 722)
@@ -231,6 +231,12 @@
       id0.xy <- id.n1[id.xy]
       id0.x <- id.n1[id.x]
       id0.y <- id.n1[id.y]
+
+      if(any(duplicated(ndata.x)&duplicated(ndata.y))){
+          ndata.x <- jitter(ndata.x, factor=jitt.fac)
+          ndata.y <- jitter(ndata.y, factor=jitt.fac)
+      }
+
       do.call(plot, args = c(list(x = ndata.x, y=ndata.y, type = "p"), pdots))
       do.call(box,args=c(adots))
 

Modified: branches/robast-1.0/pkg/RobAStBase/R/kStepEstimator.R
===================================================================
--- branches/robast-1.0/pkg/RobAStBase/R/kStepEstimator.R	2014-02-22 23:36:16 UTC (rev 721)
+++ branches/robast-1.0/pkg/RobAStBase/R/kStepEstimator.R	2014-02-24 17:58:37 UTC (rev 722)
@@ -109,13 +109,15 @@
 
                 if(withPreModif){
                    main(Param)[] <- .deleteDim(u.theta[idx])
+#                   print(Param)
                    if (lnx) nuisance(Param)[] <- .deleteDim(u.theta[nuis.idx])
+#                   print(Param)
 #                   print(L2Fam)
                    L2Fam <- modifyModel(L2Fam, Param,
                                .withL2derivDistr = L2Fam at .withEvalL2derivDistr)
 #                   print(L2Fam)
                    IC <- modifyIC(IC)(L2Fam, IC)
-#                   print(IC)
+ #                  print(IC)
                 }
 
                 IC.c <- as(diag(p) %*% IC at Curve, "EuclRandVariable")
@@ -126,6 +128,7 @@
                 IC.tot.0 <- NULL
 #                print(Dtau)
                 if(!.isUnitMatrix(Dtau)){
+ #                    print("HU1!")
                      Dminus <- solve(Dtau, generalized = TRUE)
                      projker <- diag(k) - Dminus %*% Dtau
 
@@ -159,6 +162,7 @@
 
                      theta <- (tf$fct(u.theta))$fval
                 }else{
+#                     print("HU2!")
                      correct <- rowMeans(evalRandVar(IC.c, x0), na.rm = na.rm )
                      iM <- is.matrix(theta)
                      names(correct) <- if(iM) rownames(theta) else names(theta)
@@ -173,6 +177,7 @@
                      IC.tot <- IC.c
                      u.theta <- theta
                 }
+#                print("HU3!")
 
                 var0 <- u.var <- NULL
                 if(with.u.var){
@@ -193,7 +198,6 @@
                       if(withEvalAsVar) var0 <- eval(var0)
                    }
                 }
-
                 if(withPostModif){
                    main(Param)[] <- .deleteDim(u.theta[idx])
                    if (lnx) nuisance(Param)[] <- .deleteDim(u.theta[nuis.idx])

Modified: branches/robast-1.0/pkg/RobExtremes/R/getStartIC.R
===================================================================
--- branches/robast-1.0/pkg/RobExtremes/R/getStartIC.R	2014-02-22 23:36:16 UTC (rev 721)
+++ branches/robast-1.0/pkg/RobExtremes/R/getStartIC.R	2014-02-24 17:58:37 UTC (rev 722)
@@ -12,6 +12,8 @@
     scshnm <- scaleshapename(model)
     shnam <- scshnm["shape"]
 
+    ### check whether mc[-1] is a good strategy to delete risk parameter...!!!
+
     nsng <- character(0)
     sng <- try(getFromNamespace(gridn, ns = "RobAStRDA"), silent=TRUE)
     if(!is(sng,"try-error")) nsng <- names(sng)
@@ -19,7 +21,7 @@
        if(nam %in% nsng){
           fctN <- .versionSuff("fun")
           interpolfct <- sng[[nam]][[fctN]]
-          .modifyIC <- function(L2Fam, IC){
+          .modifyIC0 <- function(L2Fam, IC){
                     para <- param(L2Fam)
                     if(!.is.na.Psi(para, interpolfct, shnam))
                        return(.getPsi(para, interpolfct, L2Fam, type(risk)))
@@ -27,6 +29,11 @@
                        return(do.call(getStartIC, as.list(mc[-1]),
                               envir=parent.frame(2)))
           }
+          .modifyIC <- function(L2Fam,IC){
+               psi.0 <- .modifyIC0(L2Fam,IC)
+               psi.0 at modifyIC <- .modifyIC
+               return(psi.0)
+          }
           if(!.is.na.Psi(param1, interpolfct, shnam)){
              IC0 <- .getPsi(param1, interpolfct, model, type(risk))
              IC0 at modifyIC <- .modifyIC