[Robast-commits] r584 - in branches/robast-0.9/pkg/ROptEst: R man

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

Author: ruckdeschel
Date: 2013-02-01 08:20:42 +0100 (Fri, 01 Feb 2013)
New Revision: 584

Modified:
   branches/robast-0.9/pkg/ROptEst/R/getStartIC.R
   branches/robast-0.9/pkg/ROptEst/R/roptest.new.R
   branches/robast-0.9/pkg/ROptEst/man/getStartIC-methods.Rd
Log:
two silly errors in roptest.new.R -> threw error when passed on S4-estimators as starting estimators; getStartIC now also dispatches on asCov, trASCov, and asBias risk

Modified: branches/robast-0.9/pkg/ROptEst/R/getStartIC.R
===================================================================
--- branches/robast-0.9/pkg/ROptEst/R/getStartIC.R	2013-02-01 07:17:45 UTC (rev 583)
+++ branches/robast-0.9/pkg/ROptEst/R/getStartIC.R	2013-02-01 07:20:42 UTC (rev 584)
@@ -1,7 +1,7 @@
 setMethod("getStartIC",signature(model = "ANY", risk = "ANY"),
            function(model, risk, ...) stop("not yet implemented"))
 
-setMethod("getStartIC",signature(model = "L2ParamFamily", risk = "asRisk"),
+setMethod("getStartIC",signature(model = "L2ParamFamily", risk = "asGRisk"),
            function(model, risk, ..., ..debug=FALSE){
     mc <- match.call(expand.dots=FALSE, call = sys.call(sys.parent(1)))
     dots <- as.list(mc$"...")
@@ -19,7 +19,7 @@
     }else neighbor <- ContNeighborhood()
 
     sm.rmx <- selectMethod("radiusMinimaxIC", signature(
-                 class(model),class(neighbor),class(risk)))
+               class(model),class(neighbor),class(risk)))
     dots.rmx <- .fix.in.defaults(dots, sm.rmx)
     dots.rmx$L2Fam <- NULL
     dots.rmx$neighbor <- NULL
@@ -31,7 +31,8 @@
     dots.optic <- .fix.in.defaults(dots, sm.optic)
     dots.optic$model <- NULL
     dots.optic$risk <- NULL
-    if(is.null(eps$e)){
+
+    if(is.null(eps[["e"]])){
         dots.rmx$loRad <- eps$sqn * eps$lower
         dots.rmx$upRad <- eps$sqn * eps$upper
         arg.rmx <- c(list(L2Fam = model, neighbor = neighbor,
@@ -59,8 +60,36 @@
   return(ICstart)
   })
 
+setMethod("getStartIC",signature(model = "L2ParamFamily", risk = "asCov"),
+           function(model, risk, ..., ..debug=FALSE){
+    return(optIC(model, risk))
+  })
+setMethod("getStartIC",signature(model = "L2ParamFamily", risk = "trAsCov"),
+     getMethod("getStartIC", signature(model = "L2ParamFamily", risk = "asCov"))
+           )
 
+setMethod("getStartIC",signature(model = "L2ParamFamily", risk = "asBias"),
+           function(model, risk, ..., ..debug=FALSE){
+    mc <- match.call(expand.dots=FALSE, call = sys.call(sys.parent(1)))
+    dots <- as.list(mc$"...")
+    if("fsCor" %in% names(dots)){
+        fsCor <- eval(dots[["fsCor"]])
+        dots$fsCor <- NULL
+    }else fsCor <- 1
+    if("eps" %in% names(dots)){
+       eps <- dots[["eps"]]
+       dots$eps <- NULL
+    }else eps <- NULL
+    if("neighbor" %in% names(dots)){
+       neighbor <- eval(dots[["neighbor"]])
+       dots$neighbor <- NULL
+    }else neighbor <- ContNeighborhood()
 
+    infMod <- InfRobModel(center = model, neighbor = neighbor)
+    return(optIC(infMod, risk))
+           })
+
+
 setMethod("getStartIC",signature(model = "L2ScaleShapeUnion", risk = "interpolRisk"),
            function(model, risk, ...){
 
@@ -74,11 +103,15 @@
     sng <- try(getFromNamespace(.versionSuff(gridn), ns = "RobExtremes"),
                                  silent=TRUE)
     if(!is(sng,"try-error")) nsng <- names(sng)
+    #print(.versionSuff(gridn))
     if(length(nsng)){
        if(nam %in% nsng){
           interpolfct <- sng[[nam]]$fct
           #print(xi)
           #print(beta)
+          #print(head(sng[[nam]]$grid))
+          #print(xi)
+          #print(beta)
           .modifyIC <- function(L2Fam, IC){
                    para <- param(L2Fam)
                    xi0 <- main(para)["shape"]#[scaleshapename(L2Fam)["scale"]]

Modified: branches/robast-0.9/pkg/ROptEst/R/roptest.new.R
===================================================================
--- branches/robast-0.9/pkg/ROptEst/R/roptest.new.R	2013-02-01 07:17:45 UTC (rev 583)
+++ branches/robast-0.9/pkg/ROptEst/R/roptest.new.R	2013-02-01 07:20:42 UTC (rev 584)
@@ -83,7 +83,6 @@
     nbCtrl    <- .fix.in.defaults(nbCtrl, gennbCtrl)
     startCtrl <- .fix.in.defaults(startCtrl, genstartCtrl)
     kStepCtrl <- .fix.in.defaults(kStepCtrl, genkStepCtrl)
-        
     es.list <- as.list(es.call0[-1])
     es.list <- c(es.list,nbCtrl)
     es.list$nbCtrl <- NULL
@@ -148,10 +147,10 @@
     }else{
     sy.start <- system.time({
       sctrl.init <- eval(startCtrl$initial.est)
-      if(!is.null(startCtrl$initial.est.ArgList)){
+      if(is.null(startCtrl$initial.est.ArgList)){
        initial.est <-  kStepEstimator.start(start = sctrl.init, x = x,
                                         nrvalues = nrvalues, na.rm = na.rm,
-                                        L2Fam = L2Fam)
+                                        L2Fam = L2Fam, startList = NULL)
       }else{
        initial.est <-  kStepEstimator.start(start = sctrl.init, x = x,
                                         nrvalues = nrvalues, na.rm = na.rm,
@@ -172,6 +171,7 @@
 
     if(!is(risk,"interpolRisk"))
        es.list0$eps <- do.call(.check.eps, args=c(nbCtrl,list("x"=x)))
+   
     es.list0$risk <- NULL
     es.list0$L2Fam <- NULL
     neighbor <- eval(es.list0$neighbor)

Modified: branches/robast-0.9/pkg/ROptEst/man/getStartIC-methods.Rd
===================================================================
--- branches/robast-0.9/pkg/ROptEst/man/getStartIC-methods.Rd	2013-02-01 07:17:45 UTC (rev 583)
+++ branches/robast-0.9/pkg/ROptEst/man/getStartIC-methods.Rd	2013-02-01 07:20:42 UTC (rev 584)
@@ -3,7 +3,10 @@
 \alias{getStartIC-methods}
 \alias{getStartIC}
 \alias{getStartIC,ANY,ANY-method}
-\alias{getStartIC,L2ParamFamily,asRisk-method}
+\alias{getStartIC,L2ParamFamily,asGRisk-method}
+\alias{getStartIC,L2ParamFamily,asBias-method}
+\alias{getStartIC,L2ParamFamily,asCov-method}
+\alias{getStartIC,L2ParamFamily,trAsCov-method}
 \alias{getStartIC,L2ScaleShapeUnion,interpolRisk-method}
 
 \title{Methods for Function getStartIC in Package `ROptEst' }