[Robast-commits] r1056 - branches/robast-1.1/pkg/RobAStBase branches/robast-1.1/pkg/RobAStBase/R branches/robast-1.1/pkg/RobAStBase/inst branches/robast-1.1/pkg/RobAStBase/man branches/robast-1.2/pkg/RobAStBase branches/robast-1.2/pkg/RobAStBase/R branches/robast-1.2/pkg/RobAStBase/inst branches/robast-1.2/pkg/RobAStBase/man pkg/RobAStBase pkg/RobAStBase/R pkg/RobAStBase/inst pkg/RobAStBase/man

noreply at r-forge.r-project.org noreply at r-forge.r-project.org
Wed Jul 25 00:31:37 CEST 2018


Author: ruckdeschel
Date: 2018-07-25 00:31:37 +0200 (Wed, 25 Jul 2018)
New Revision: 1056

Modified:
   branches/robast-1.1/pkg/RobAStBase/DESCRIPTION
   branches/robast-1.1/pkg/RobAStBase/NAMESPACE
   branches/robast-1.1/pkg/RobAStBase/R/AllClass.R
   branches/robast-1.1/pkg/RobAStBase/R/AllGeneric.R
   branches/robast-1.1/pkg/RobAStBase/R/kStepEstimate.R
   branches/robast-1.1/pkg/RobAStBase/R/kStepEstimator.R
   branches/robast-1.1/pkg/RobAStBase/inst/NEWS
   branches/robast-1.1/pkg/RobAStBase/man/kStepEstimate-class.Rd
   branches/robast-1.2/pkg/RobAStBase/DESCRIPTION
   branches/robast-1.2/pkg/RobAStBase/NAMESPACE
   branches/robast-1.2/pkg/RobAStBase/R/AllClass.R
   branches/robast-1.2/pkg/RobAStBase/R/AllGeneric.R
   branches/robast-1.2/pkg/RobAStBase/R/kStepEstimate.R
   branches/robast-1.2/pkg/RobAStBase/R/kStepEstimator.R
   branches/robast-1.2/pkg/RobAStBase/inst/NEWS
   branches/robast-1.2/pkg/RobAStBase/man/kStepEstimate-class.Rd
   pkg/RobAStBase/DESCRIPTION
   pkg/RobAStBase/NAMESPACE
   pkg/RobAStBase/R/AllClass.R
   pkg/RobAStBase/R/AllGeneric.R
   pkg/RobAStBase/R/kStepEstimate.R
   pkg/RobAStBase/R/kStepEstimator.R
   pkg/RobAStBase/inst/NEWS
   pkg/RobAStBase/man/kStepEstimate-class.Rd
Log:
[RobASt] At running scripts of ROptEst some bugs became apparent:
+ DESCRIPTION: we import graphics, grDevices, stats
+ the return value of roptest (of class kStepEstimate) had in slot estimate.call the call to roptest, but also, as an attribute the inner call to robest; subsequently, when printing the call this
  cluttered  the output -> changed this: the call to robest is now in an extra slot robestCall of class OptionalCall which as a rule is NULL but is filled in roptest; it can be accessed by
  accessor robestCall
+ classUnion OptionalCall and S4method robestCall are exported
+ some (non-standard)-scalenames were not correctly found in kStepEstimator; in addition, for nuisances, the restriction to main coordinates idx was missing in kStepEstimator 
  now have an internal function .fix.scalename to name the respective element as scale-coordinate 

Modified: branches/robast-1.1/pkg/RobAStBase/DESCRIPTION
===================================================================
--- branches/robast-1.1/pkg/RobAStBase/DESCRIPTION	2018-07-24 22:18:11 UTC (rev 1055)
+++ branches/robast-1.1/pkg/RobAStBase/DESCRIPTION	2018-07-24 22:31:37 UTC (rev 1056)
@@ -6,7 +6,7 @@
 Depends: R(>= 2.14.0), methods, rrcov, distr(>= 2.5.2), distrEx(>= 2.5), distrMod(>= 2.5.2),
         RandVar(>= 0.9.2)
 Suggests: ROptEst, RUnit (>= 0.4.26)
-Imports: startupmsg
+Imports: startupmsg, graphics, grDevices, stats
 Authors at R: c(person("Matthias", "Kohl", role=c("cre", "cph", "aut"),
         email="Matthias.Kohl at stamats.de"), person("Peter", "Ruckdeschel",role=c("aut", "cph")),
         person("Mykhailo", "Pupashenko", role="ctb", comment="contributed wrapper functions for

Modified: branches/robast-1.1/pkg/RobAStBase/NAMESPACE
===================================================================
--- branches/robast-1.1/pkg/RobAStBase/NAMESPACE	2018-07-24 22:18:11 UTC (rev 1055)
+++ branches/robast-1.1/pkg/RobAStBase/NAMESPACE	2018-07-24 22:31:37 UTC (rev 1056)
@@ -28,7 +28,7 @@
 exportClasses("ALEstimate", "kStepEstimate", "MEstimate")
 exportClasses("cutoff")
 exportClasses("interpolRisk", "OMSRRisk","MBRRisk","RMXRRisk")
-exportClasses("StartClass", "pICList", "OptionalpICList")
+exportClasses("StartClass", "pICList", "OptionalpICList", "OptionalCall")
 exportMethods("show", 
               "plot")
 exportMethods("type", "radius", "radius<-")
@@ -51,7 +51,8 @@
               "neighborRadius", "neighborRadius<-", 
               "clipLo", "clipLo<-", 
               "clipUp", "clipUp<-",
-              "optIC", "start", "startval", "pICList") 
+              "optIC", "start", "startval", "pICList", 
+			  "robestCall") 
 exportMethods("locMEstimator")
 exportMethods("weight", "weight<-", 
               "getweight", 

Modified: branches/robast-1.1/pkg/RobAStBase/R/AllClass.R
===================================================================
--- branches/robast-1.1/pkg/RobAStBase/R/AllClass.R	2018-07-24 22:18:11 UTC (rev 1055)
+++ branches/robast-1.1/pkg/RobAStBase/R/AllClass.R	2018-07-24 22:31:37 UTC (rev 1056)
@@ -214,6 +214,7 @@
             })
 
 ## ALEstimate
+setClassUnion("OptionalCall", c("call","NULL"))
 setClassUnion("OptionalInfluenceCurve", c("InfluenceCurve", "NULL"))
 setClassUnion("StartClass", c("numeric", "matrix", "function", "Estimate"))
 setClass("pICList",
@@ -257,7 +258,8 @@
                         startval = "matrix",
                         ustartval = "matrix",
                         ksteps = "OptionalMatrix",
-                        uksteps = "OptionalMatrix"),
+                        uksteps = "OptionalMatrix",
+                        robestCall = "OptionalCall"),
          prototype(name = "Asymptotically linear estimate",
                    estimate = numeric(0),
                    samplesize = numeric(0),
@@ -281,7 +283,8 @@
                    Infos = matrix(c(character(0),character(0)), ncol=2,
                                   dimnames=list(character(0), c("method", "message"))),
                    untransformed.estimate = NULL,
-                   untransformed.asvar = NULL),
+                   untransformed.asvar = NULL,
+                   robestCall = NULL),
          contains = "ALEstimate")
 setClass("MEstimate", 
          representation(Mroot = "numeric"),

Modified: branches/robast-1.1/pkg/RobAStBase/R/AllGeneric.R
===================================================================
--- branches/robast-1.1/pkg/RobAStBase/R/AllGeneric.R	2018-07-24 22:18:11 UTC (rev 1055)
+++ branches/robast-1.1/pkg/RobAStBase/R/AllGeneric.R	2018-07-24 22:31:37 UTC (rev 1056)
@@ -193,6 +193,9 @@
 if(!isGeneric("pICList")){
     setGeneric("pICList", function(object) standardGeneric("pICList"))
 }
+if(!isGeneric("robestCall")){
+    setGeneric("robestCall", function(object) standardGeneric("robestCall"))
+}
 if(!isGeneric("Mroot")){
     setGeneric("Mroot", function(object) standardGeneric("Mroot"))
 }

Modified: branches/robast-1.1/pkg/RobAStBase/R/kStepEstimate.R
===================================================================
--- branches/robast-1.1/pkg/RobAStBase/R/kStepEstimate.R	2018-07-24 22:18:11 UTC (rev 1055)
+++ branches/robast-1.1/pkg/RobAStBase/R/kStepEstimate.R	2018-07-24 22:31:37 UTC (rev 1056)
@@ -2,6 +2,7 @@
 ## Functions and methods for "kStepEstimate" classes and subclasses
 ###############################################################################
 
+setMethod("robestCall", "kStepEstimate", function(object) object at robestCall)
 setMethod("pICList", "kStepEstimate", function(object) object at pICList)
 setMethod("ICList", "kStepEstimate", function(object) object at ICList)
 setMethod("start", "kStepEstimate", function(x) x at start)

Modified: branches/robast-1.1/pkg/RobAStBase/R/kStepEstimator.R
===================================================================
--- branches/robast-1.1/pkg/RobAStBase/R/kStepEstimator.R	2018-07-24 22:18:11 UTC (rev 1055)
+++ branches/robast-1.1/pkg/RobAStBase/R/kStepEstimator.R	2018-07-24 22:31:37 UTC (rev 1056)
@@ -2,6 +2,26 @@
 ## k-step estimator
 ###############################################################################
 
+.fix.scalename <- function(obj, scalename, estname){
+        hasdim <- !is.null(dim(obj))
+        n.obj <- if(hasdim) rownames(obj) else names(obj)
+        if(!is.na(scalename)) if(scalename!="") {
+           if((! (scalename %in% estname)) && "scale" %in% estname)
+                estname[estname=="scale"] <- scalename
+
+           if((! (scalename%in% n.obj)) && "scale" %in% n.obj){
+              n.obj[n.obj=="scale"] <- scalename
+              if(hasdim) rownames(obj) <- n.obj else names(obj) <- n.obj
+           }else{
+              if(length(n.obj)==0) n.obj <- rep("", length(estname))
+              if(all(n.obj=="")) {
+              if(hasdim) rownames(obj) <- estname else names(obj) <- estname
+              }
+           }
+        }
+        return(obj)
+}
+
 setMethod("neighborRadius","ANY",function(object)NA)
 
 ### no dispatch on top layer -> keep product structure of dependence
@@ -90,6 +110,12 @@
         start.val <- matrix(theta,ncol=1)
         rownames(u.start.val) <- u.est.names
         rownames(start.val) <- est.names
+#        print(theta)
+        theta <- .fix.scalename(theta, sclname, est.names)
+#        print(theta)
+#        print(u.theta)
+        u.theta <- .fix.scalename(u.theta, sclname, u.est.names)
+#        print(u.theta)
 
 ### shall intermediate IC's / pIC's be stored?
         pICList <- if(withPICList) vector("list", steps) else NULL
@@ -167,11 +193,14 @@
                                u.theta[sclname] <- scl * exp(correct[sclname]/scl)
                      }else u.theta <- u.theta + correct
 
-                     theta <- (tf$fct(u.theta))$fval
+                     theta <- (tf$fct(u.theta[idx]))$fval
                 }else{
 #                     print("HU2!")
                      correct <- rowMeans(evalRandVar(IC.c, x0), na.rm = na.rm )
                      iM <- is.matrix(theta)
+#                     print(sclname)
+#                     print(names(theta))
+#                     print(str(theta))
                      names(correct) <- if(iM) rownames(theta) else names(theta)
                      if(logtrf){
                         scl <- if(iM) theta[sclname,1] else theta[sclname]
@@ -255,6 +284,8 @@
                                  withPostModif = (steps>i) | useLast,
                                  with.u.var = i==steps, oldmodifIC = modif.old)
                uksteps[,i] <- u.theta <- upd$u.theta
+#               print(str(upd$theta))
+#               print(nrow(ksteps))
                ksteps[,i] <- theta <- upd$theta
                if(withICList)
                   ICList[[i]] <- new("InfluenceCurve",

Modified: branches/robast-1.1/pkg/RobAStBase/inst/NEWS
===================================================================
--- branches/robast-1.1/pkg/RobAStBase/inst/NEWS	2018-07-24 22:18:11 UTC (rev 1055)
+++ branches/robast-1.1/pkg/RobAStBase/inst/NEWS	2018-07-24 22:31:37 UTC (rev 1056)
@@ -27,6 +27,12 @@
 + in kStepEstimator, withCheck is set to FALSE when getRiskIC is called, and makeIC is only called just 
   before the last update, and, if useLast == TRUE for the last update (of course, only if withMakeIC ==TRUE)
 
+Return value of "roptest"
++ the return value of "roptest", an object of class "kStepEstimate" has a slot "estimate.call" which
+  contains the (matched) call to "roptest"; internally "roptest" calls "robest"; the call to "robest"
+  may be of interest, too, so we have a new slot "robestCall" of class "OptionalCall", ie a call  
+  or NULL (default); it can be accessed via function robestCall() 
+
 bug fix: 
 + slot modifyIC was set to a wrong value in makeIC / former (potential) move was overridden 
 + in .preparePanelFirstLast if condition with.automatic.grid was (possibly) vector valued 

Modified: branches/robast-1.1/pkg/RobAStBase/man/kStepEstimate-class.Rd
===================================================================
--- branches/robast-1.1/pkg/RobAStBase/man/kStepEstimate-class.Rd	2018-07-24 22:18:11 UTC (rev 1055)
+++ branches/robast-1.1/pkg/RobAStBase/man/kStepEstimate-class.Rd	2018-07-24 22:31:37 UTC (rev 1056)
@@ -1,5 +1,6 @@
 \name{kStepEstimate-class}
 \docType{class}
+\alias{OptionalCall-class}
 \alias{kStepEstimate-class}
 \alias{steps}
 \alias{steps,kStepEstimate-method}
@@ -11,6 +12,8 @@
 \alias{ICList,kStepEstimate-method}
 \alias{pICList}
 \alias{pICList,kStepEstimate-method}
+\alias{robestCall}
+\alias{robestCall,kStepEstimate-method}
 \alias{start,kStepEstimate-method}
 \alias{startval}
 \alias{startval,kStepEstimate-method}
@@ -82,6 +85,9 @@
     \item{\code{uksteps}}{Object of class \code{"OptionalMatrix"}:
     the intermediate estimates (in \eqn{k}-space) for the parameter;
     only filled when called from \code{kStepEstimator}. }
+    \item{\code{robestcall}}{Object of class \code{"OptionalCall"}, i.e.,
+     a \code{call} or \code{NULL}: only filled when called from \code{roptest}
+     in package \pkg{ROptEst}.}
   }
 }
 \section{Extends}{
@@ -119,6 +125,8 @@
 
     \item{pICList}{\code{signature(object = "kStepEstimate")}:
       accessor function for slot \code{pICList}. }
+    \item{robestCall}{\code{signature(object = "kStepEstimate")}:
+      accessor function for slot \code{robestCall}. }
 
     \item{show}{\code{signature(object = "kStepEstimate")}: a show method; }
   }

Modified: branches/robast-1.2/pkg/RobAStBase/DESCRIPTION
===================================================================
--- branches/robast-1.2/pkg/RobAStBase/DESCRIPTION	2018-07-24 22:18:11 UTC (rev 1055)
+++ branches/robast-1.2/pkg/RobAStBase/DESCRIPTION	2018-07-24 22:31:37 UTC (rev 1056)
@@ -1,19 +1,22 @@
 Package: RobAStBase
 Version: 1.1.0
-Date: 2018-07-23
+Date: 2018-07-08
 Title: Robust Asymptotic Statistics
 Description: Base S4-classes and functions for robust asymptotic statistics.
-Depends: R(>= 2.14.0), methods, rrcov, distr(>= 2.5.2), distrEx(>= 2.5), distrMod(>= 2.5.2), RandVar(>= 0.9.2)
+Depends: R(>= 2.14.0), methods, rrcov, distr(>= 2.5.2), distrEx(>= 2.5), distrMod(>= 2.5.2),
+        RandVar(>= 0.9.2)
 Suggests: ROptEst, RUnit (>= 0.4.26)
-Imports: startupmsg
-Authors at R: c(person("Matthias", "Kohl", role=c("cre", "cph", "aut"), email="Matthias.Kohl at stamats.de"), person("Peter",
-          "Ruckdeschel",role=c("aut", "cph")), person("Mykhailo", "Pupashenko", role="ctb", comment="contributed wrapper
-          functions for diagnostic plots"), person("Gerald", "Kroisandt", role="ctb", comment="contributed testing
-          routines"), person("R Core Team", role = c("ctb", "cph"), comment="for source file 'format.perc'"))
+Imports: startupmsg, graphics, grDevices, stats
+Authors at R: c(person("Matthias", "Kohl", role=c("cre", "cph", "aut"),
+        email="Matthias.Kohl at stamats.de"), person("Peter", "Ruckdeschel",role=c("aut", "cph")),
+        person("Mykhailo", "Pupashenko", role="ctb", comment="contributed wrapper functions for
+        diagnostic plots"), person("Gerald", "Kroisandt", role="ctb", comment="contributed
+        testing routines"), person("R Core Team", role = c("ctb", "cph"), comment="for source
+        file 'format.perc'"))
 ByteCompile: yes
 License: LGPL-3
 Encoding: latin1
 URL: http://robast.r-forge.r-project.org/
 LastChangedDate: {$LastChangedDate$}
 LastChangedRevision: {$LastChangedRevision$}
-VCS/SVNRevision: 1040
+VCS/SVNRevision: 940

Modified: branches/robast-1.2/pkg/RobAStBase/NAMESPACE
===================================================================
--- branches/robast-1.2/pkg/RobAStBase/NAMESPACE	2018-07-24 22:18:11 UTC (rev 1055)
+++ branches/robast-1.2/pkg/RobAStBase/NAMESPACE	2018-07-24 22:31:37 UTC (rev 1056)
@@ -28,7 +28,7 @@
 exportClasses("ALEstimate", "kStepEstimate", "MEstimate")
 exportClasses("cutoff")
 exportClasses("interpolRisk", "OMSRRisk","MBRRisk","RMXRRisk")
-exportClasses("StartClass", "pICList", "OptionalpICList")
+exportClasses("StartClass", "pICList", "OptionalpICList", "OptionalCall")
 exportMethods("show", 
               "plot")
 exportMethods("type", "radius", "radius<-")
@@ -51,7 +51,8 @@
               "neighborRadius", "neighborRadius<-", 
               "clipLo", "clipLo<-", 
               "clipUp", "clipUp<-",
-              "optIC", "start", "startval", "pICList") 
+              "optIC", "start", "startval", "pICList", 
+			  "robestCall") 
 exportMethods("locMEstimator")
 exportMethods("weight", "weight<-", 
               "getweight", 

Modified: branches/robast-1.2/pkg/RobAStBase/R/AllClass.R
===================================================================
--- branches/robast-1.2/pkg/RobAStBase/R/AllClass.R	2018-07-24 22:18:11 UTC (rev 1055)
+++ branches/robast-1.2/pkg/RobAStBase/R/AllClass.R	2018-07-24 22:31:37 UTC (rev 1056)
@@ -214,6 +214,7 @@
             })
 
 ## ALEstimate
+setClassUnion("OptionalCall", c("call","NULL"))
 setClassUnion("OptionalInfluenceCurve", c("InfluenceCurve", "NULL"))
 setClassUnion("StartClass", c("numeric", "matrix", "function", "Estimate"))
 setClass("pICList",
@@ -257,7 +258,8 @@
                         startval = "matrix",
                         ustartval = "matrix",
                         ksteps = "OptionalMatrix",
-                        uksteps = "OptionalMatrix"),
+                        uksteps = "OptionalMatrix",
+                        robestCall = "OptionalCall"),
          prototype(name = "Asymptotically linear estimate",
                    estimate = numeric(0),
                    samplesize = numeric(0),
@@ -281,7 +283,8 @@
                    Infos = matrix(c(character(0),character(0)), ncol=2,
                                   dimnames=list(character(0), c("method", "message"))),
                    untransformed.estimate = NULL,
-                   untransformed.asvar = NULL),
+                   untransformed.asvar = NULL,
+                   robestCall = NULL),
          contains = "ALEstimate")
 setClass("MEstimate", 
          representation(Mroot = "numeric"),

Modified: branches/robast-1.2/pkg/RobAStBase/R/AllGeneric.R
===================================================================
--- branches/robast-1.2/pkg/RobAStBase/R/AllGeneric.R	2018-07-24 22:18:11 UTC (rev 1055)
+++ branches/robast-1.2/pkg/RobAStBase/R/AllGeneric.R	2018-07-24 22:31:37 UTC (rev 1056)
@@ -193,6 +193,9 @@
 if(!isGeneric("pICList")){
     setGeneric("pICList", function(object) standardGeneric("pICList"))
 }
+if(!isGeneric("robestCall")){
+    setGeneric("robestCall", function(object) standardGeneric("robestCall"))
+}
 if(!isGeneric("Mroot")){
     setGeneric("Mroot", function(object) standardGeneric("Mroot"))
 }

Modified: branches/robast-1.2/pkg/RobAStBase/R/kStepEstimate.R
===================================================================
--- branches/robast-1.2/pkg/RobAStBase/R/kStepEstimate.R	2018-07-24 22:18:11 UTC (rev 1055)
+++ branches/robast-1.2/pkg/RobAStBase/R/kStepEstimate.R	2018-07-24 22:31:37 UTC (rev 1056)
@@ -2,6 +2,7 @@
 ## Functions and methods for "kStepEstimate" classes and subclasses
 ###############################################################################
 
+setMethod("robestCall", "kStepEstimate", function(object) object at robestCall)
 setMethod("pICList", "kStepEstimate", function(object) object at pICList)
 setMethod("ICList", "kStepEstimate", function(object) object at ICList)
 setMethod("start", "kStepEstimate", function(x) x at start)

Modified: branches/robast-1.2/pkg/RobAStBase/R/kStepEstimator.R
===================================================================
--- branches/robast-1.2/pkg/RobAStBase/R/kStepEstimator.R	2018-07-24 22:18:11 UTC (rev 1055)
+++ branches/robast-1.2/pkg/RobAStBase/R/kStepEstimator.R	2018-07-24 22:31:37 UTC (rev 1056)
@@ -2,6 +2,26 @@
 ## k-step estimator
 ###############################################################################
 
+.fix.scalename <- function(obj, scalename, estname){
+        hasdim <- !is.null(dim(obj))
+        n.obj <- if(hasdim) rownames(obj) else names(obj)
+        if(!is.na(scalename)) if(scalename!="") {
+           if((! (scalename %in% estname)) && "scale" %in% estname)
+                estname[estname=="scale"] <- scalename
+
+           if((! (scalename%in% n.obj)) && "scale" %in% n.obj){
+              n.obj[n.obj=="scale"] <- scalename
+              if(hasdim) rownames(obj) <- n.obj else names(obj) <- n.obj
+           }else{
+              if(length(n.obj)==0) n.obj <- rep("", length(estname))
+              if(all(n.obj=="")) {
+              if(hasdim) rownames(obj) <- estname else names(obj) <- estname
+              }
+           }
+        }
+        return(obj)
+}
+
 setMethod("neighborRadius","ANY",function(object)NA)
 
 ### no dispatch on top layer -> keep product structure of dependence
@@ -90,6 +110,12 @@
         start.val <- matrix(theta,ncol=1)
         rownames(u.start.val) <- u.est.names
         rownames(start.val) <- est.names
+#        print(theta)
+        theta <- .fix.scalename(theta, sclname, est.names)
+#        print(theta)
+#        print(u.theta)
+        u.theta <- .fix.scalename(u.theta, sclname, u.est.names)
+#        print(u.theta)
 
 ### shall intermediate IC's / pIC's be stored?
         pICList <- if(withPICList) vector("list", steps) else NULL
@@ -167,11 +193,14 @@
                                u.theta[sclname] <- scl * exp(correct[sclname]/scl)
                      }else u.theta <- u.theta + correct
 
-                     theta <- (tf$fct(u.theta))$fval
+                     theta <- (tf$fct(u.theta[idx]))$fval
                 }else{
 #                     print("HU2!")
                      correct <- rowMeans(evalRandVar(IC.c, x0), na.rm = na.rm )
                      iM <- is.matrix(theta)
+#                     print(sclname)
+#                     print(names(theta))
+#                     print(str(theta))
                      names(correct) <- if(iM) rownames(theta) else names(theta)
                      if(logtrf){
                         scl <- if(iM) theta[sclname,1] else theta[sclname]
@@ -255,6 +284,8 @@
                                  withPostModif = (steps>i) | useLast,
                                  with.u.var = i==steps, oldmodifIC = modif.old)
                uksteps[,i] <- u.theta <- upd$u.theta
+#               print(str(upd$theta))
+#               print(nrow(ksteps))
                ksteps[,i] <- theta <- upd$theta
                if(withICList)
                   ICList[[i]] <- new("InfluenceCurve",

Modified: branches/robast-1.2/pkg/RobAStBase/inst/NEWS
===================================================================
--- branches/robast-1.2/pkg/RobAStBase/inst/NEWS	2018-07-24 22:18:11 UTC (rev 1055)
+++ branches/robast-1.2/pkg/RobAStBase/inst/NEWS	2018-07-24 22:31:37 UTC (rev 1056)
@@ -27,6 +27,12 @@
 + in kStepEstimator, withCheck is set to FALSE when getRiskIC is called, and makeIC is only called just 
   before the last update, and, if useLast == TRUE for the last update (of course, only if withMakeIC ==TRUE)
 
+Return value of "roptest"
++ the return value of "roptest", an object of class "kStepEstimate" has a slot "estimate.call" which
+  contains the (matched) call to "roptest"; internally "roptest" calls "robest"; the call to "robest"
+  may be of interest, too, so we have a new slot "robestCall" of class "OptionalCall", ie a call  
+  or NULL (default); it can be accessed via function robestCall() 
+
 bug fix: 
 + slot modifyIC was set to a wrong value in makeIC / former (potential) move was overridden 
 + in .preparePanelFirstLast if condition with.automatic.grid was (possibly) vector valued 

Modified: branches/robast-1.2/pkg/RobAStBase/man/kStepEstimate-class.Rd
===================================================================
--- branches/robast-1.2/pkg/RobAStBase/man/kStepEstimate-class.Rd	2018-07-24 22:18:11 UTC (rev 1055)
+++ branches/robast-1.2/pkg/RobAStBase/man/kStepEstimate-class.Rd	2018-07-24 22:31:37 UTC (rev 1056)
@@ -1,5 +1,6 @@
 \name{kStepEstimate-class}
 \docType{class}
+\alias{OptionalCall-class}
 \alias{kStepEstimate-class}
 \alias{steps}
 \alias{steps,kStepEstimate-method}
@@ -11,6 +12,8 @@
 \alias{ICList,kStepEstimate-method}
 \alias{pICList}
 \alias{pICList,kStepEstimate-method}
+\alias{robestCall}
+\alias{robestCall,kStepEstimate-method}
 \alias{start,kStepEstimate-method}
 \alias{startval}
 \alias{startval,kStepEstimate-method}
@@ -82,6 +85,9 @@
     \item{\code{uksteps}}{Object of class \code{"OptionalMatrix"}:
     the intermediate estimates (in \eqn{k}-space) for the parameter;
     only filled when called from \code{kStepEstimator}. }
+    \item{\code{robestcall}}{Object of class \code{"OptionalCall"}, i.e.,
+     a \code{call} or \code{NULL}: only filled when called from \code{roptest}
+     in package \pkg{ROptEst}.}
   }
 }
 \section{Extends}{
@@ -119,6 +125,8 @@
 
     \item{pICList}{\code{signature(object = "kStepEstimate")}:
       accessor function for slot \code{pICList}. }
+    \item{robestCall}{\code{signature(object = "kStepEstimate")}:
+      accessor function for slot \code{robestCall}. }
 
     \item{show}{\code{signature(object = "kStepEstimate")}: a show method; }
   }

Modified: pkg/RobAStBase/DESCRIPTION
===================================================================
--- pkg/RobAStBase/DESCRIPTION	2018-07-24 22:18:11 UTC (rev 1055)
+++ pkg/RobAStBase/DESCRIPTION	2018-07-24 22:31:37 UTC (rev 1056)
@@ -1,19 +1,22 @@
 Package: RobAStBase
 Version: 1.1.0
-Date: 2018-07-23
+Date: 2018-07-08
 Title: Robust Asymptotic Statistics
 Description: Base S4-classes and functions for robust asymptotic statistics.
-Depends: R(>= 2.14.0), methods, rrcov, distr(>= 2.5.2), distrEx(>= 2.5), distrMod(>= 2.5.2), RandVar(>= 0.9.2)
+Depends: R(>= 2.14.0), methods, rrcov, distr(>= 2.5.2), distrEx(>= 2.5), distrMod(>= 2.5.2),
+        RandVar(>= 0.9.2)
 Suggests: ROptEst, RUnit (>= 0.4.26)
-Imports: startupmsg
-Authors at R: c(person("Matthias", "Kohl", role=c("cre", "cph", "aut"), email="Matthias.Kohl at stamats.de"), person("Peter",
-          "Ruckdeschel",role=c("aut", "cph")), person("Mykhailo", "Pupashenko", role="ctb", comment="contributed wrapper
-          functions for diagnostic plots"), person("Gerald", "Kroisandt", role="ctb", comment="contributed testing
-          routines"), person("R Core Team", role = c("ctb", "cph"), comment="for source file 'format.perc'"))
+Imports: startupmsg, graphics, grDevices, stats
+Authors at R: c(person("Matthias", "Kohl", role=c("cre", "cph", "aut"),
+        email="Matthias.Kohl at stamats.de"), person("Peter", "Ruckdeschel",role=c("aut", "cph")),
+        person("Mykhailo", "Pupashenko", role="ctb", comment="contributed wrapper functions for
+        diagnostic plots"), person("Gerald", "Kroisandt", role="ctb", comment="contributed
+        testing routines"), person("R Core Team", role = c("ctb", "cph"), comment="for source
+        file 'format.perc'"))
 ByteCompile: yes
 License: LGPL-3
 Encoding: latin1
 URL: http://robast.r-forge.r-project.org/
 LastChangedDate: {$LastChangedDate$}
 LastChangedRevision: {$LastChangedRevision$}
-VCS/SVNRevision: 1040
+VCS/SVNRevision: 940

Modified: pkg/RobAStBase/NAMESPACE
===================================================================
--- pkg/RobAStBase/NAMESPACE	2018-07-24 22:18:11 UTC (rev 1055)
+++ pkg/RobAStBase/NAMESPACE	2018-07-24 22:31:37 UTC (rev 1056)
@@ -28,7 +28,7 @@
 exportClasses("ALEstimate", "kStepEstimate", "MEstimate")
 exportClasses("cutoff")
 exportClasses("interpolRisk", "OMSRRisk","MBRRisk","RMXRRisk")
-exportClasses("StartClass", "pICList", "OptionalpICList")
+exportClasses("StartClass", "pICList", "OptionalpICList", "OptionalCall")
 exportMethods("show", 
               "plot")
 exportMethods("type", "radius", "radius<-")
@@ -51,7 +51,8 @@
               "neighborRadius", "neighborRadius<-", 
               "clipLo", "clipLo<-", 
               "clipUp", "clipUp<-",
-              "optIC", "start", "startval", "pICList") 
+              "optIC", "start", "startval", "pICList", 
+			  "robestCall") 
 exportMethods("locMEstimator")
 exportMethods("weight", "weight<-", 
               "getweight", 

Modified: pkg/RobAStBase/R/AllClass.R
===================================================================
--- pkg/RobAStBase/R/AllClass.R	2018-07-24 22:18:11 UTC (rev 1055)
+++ pkg/RobAStBase/R/AllClass.R	2018-07-24 22:31:37 UTC (rev 1056)
@@ -214,6 +214,7 @@
             })
 
 ## ALEstimate
+setClassUnion("OptionalCall", c("call","NULL"))
 setClassUnion("OptionalInfluenceCurve", c("InfluenceCurve", "NULL"))
 setClassUnion("StartClass", c("numeric", "matrix", "function", "Estimate"))
 setClass("pICList",
@@ -257,7 +258,8 @@
                         startval = "matrix",
                         ustartval = "matrix",
                         ksteps = "OptionalMatrix",
-                        uksteps = "OptionalMatrix"),
+                        uksteps = "OptionalMatrix",
+                        robestCall = "OptionalCall"),
          prototype(name = "Asymptotically linear estimate",
                    estimate = numeric(0),
                    samplesize = numeric(0),
@@ -281,7 +283,8 @@
                    Infos = matrix(c(character(0),character(0)), ncol=2,
                                   dimnames=list(character(0), c("method", "message"))),
                    untransformed.estimate = NULL,
-                   untransformed.asvar = NULL),
+                   untransformed.asvar = NULL,
+                   robestCall = NULL),
          contains = "ALEstimate")
 setClass("MEstimate", 
          representation(Mroot = "numeric"),

Modified: pkg/RobAStBase/R/AllGeneric.R
===================================================================
--- pkg/RobAStBase/R/AllGeneric.R	2018-07-24 22:18:11 UTC (rev 1055)
+++ pkg/RobAStBase/R/AllGeneric.R	2018-07-24 22:31:37 UTC (rev 1056)
@@ -193,6 +193,9 @@
 if(!isGeneric("pICList")){
     setGeneric("pICList", function(object) standardGeneric("pICList"))
 }
+if(!isGeneric("robestCall")){
+    setGeneric("robestCall", function(object) standardGeneric("robestCall"))
+}
 if(!isGeneric("Mroot")){
     setGeneric("Mroot", function(object) standardGeneric("Mroot"))
 }

Modified: pkg/RobAStBase/R/kStepEstimate.R
===================================================================
--- pkg/RobAStBase/R/kStepEstimate.R	2018-07-24 22:18:11 UTC (rev 1055)
+++ pkg/RobAStBase/R/kStepEstimate.R	2018-07-24 22:31:37 UTC (rev 1056)
@@ -2,6 +2,7 @@
 ## Functions and methods for "kStepEstimate" classes and subclasses
 ###############################################################################
 
+setMethod("robestCall", "kStepEstimate", function(object) object at robestCall)
 setMethod("pICList", "kStepEstimate", function(object) object at pICList)
 setMethod("ICList", "kStepEstimate", function(object) object at ICList)
 setMethod("start", "kStepEstimate", function(x) x at start)

Modified: pkg/RobAStBase/R/kStepEstimator.R
===================================================================
--- pkg/RobAStBase/R/kStepEstimator.R	2018-07-24 22:18:11 UTC (rev 1055)
+++ pkg/RobAStBase/R/kStepEstimator.R	2018-07-24 22:31:37 UTC (rev 1056)
@@ -2,6 +2,26 @@
 ## k-step estimator
 ###############################################################################
 
+.fix.scalename <- function(obj, scalename, estname){
+        hasdim <- !is.null(dim(obj))
+        n.obj <- if(hasdim) rownames(obj) else names(obj)
+        if(!is.na(scalename)) if(scalename!="") {
+           if((! (scalename %in% estname)) && "scale" %in% estname)
+                estname[estname=="scale"] <- scalename
+
+           if((! (scalename%in% n.obj)) && "scale" %in% n.obj){
+              n.obj[n.obj=="scale"] <- scalename
+              if(hasdim) rownames(obj) <- n.obj else names(obj) <- n.obj
+           }else{
+              if(length(n.obj)==0) n.obj <- rep("", length(estname))
+              if(all(n.obj=="")) {
+              if(hasdim) rownames(obj) <- estname else names(obj) <- estname
+              }
+           }
+        }
+        return(obj)
+}
+
 setMethod("neighborRadius","ANY",function(object)NA)
 
 ### no dispatch on top layer -> keep product structure of dependence
@@ -90,6 +110,12 @@
         start.val <- matrix(theta,ncol=1)
         rownames(u.start.val) <- u.est.names
         rownames(start.val) <- est.names
+#        print(theta)
+        theta <- .fix.scalename(theta, sclname, est.names)
+#        print(theta)
+#        print(u.theta)
+        u.theta <- .fix.scalename(u.theta, sclname, u.est.names)
+#        print(u.theta)
 
 ### shall intermediate IC's / pIC's be stored?
         pICList <- if(withPICList) vector("list", steps) else NULL
@@ -167,11 +193,14 @@
                                u.theta[sclname] <- scl * exp(correct[sclname]/scl)
                      }else u.theta <- u.theta + correct
 
-                     theta <- (tf$fct(u.theta))$fval
+                     theta <- (tf$fct(u.theta[idx]))$fval
                 }else{
 #                     print("HU2!")
                      correct <- rowMeans(evalRandVar(IC.c, x0), na.rm = na.rm )
                      iM <- is.matrix(theta)
+#                     print(sclname)
+#                     print(names(theta))
+#                     print(str(theta))
                      names(correct) <- if(iM) rownames(theta) else names(theta)
                      if(logtrf){
                         scl <- if(iM) theta[sclname,1] else theta[sclname]
@@ -255,6 +284,8 @@
                                  withPostModif = (steps>i) | useLast,
                                  with.u.var = i==steps, oldmodifIC = modif.old)
                uksteps[,i] <- u.theta <- upd$u.theta
+#               print(str(upd$theta))
+#               print(nrow(ksteps))
                ksteps[,i] <- theta <- upd$theta
                if(withICList)
                   ICList[[i]] <- new("InfluenceCurve",

Modified: pkg/RobAStBase/inst/NEWS
===================================================================
--- pkg/RobAStBase/inst/NEWS	2018-07-24 22:18:11 UTC (rev 1055)
+++ pkg/RobAStBase/inst/NEWS	2018-07-24 22:31:37 UTC (rev 1056)
@@ -27,6 +27,12 @@
 + in kStepEstimator, withCheck is set to FALSE when getRiskIC is called, and makeIC is only called just 
   before the last update, and, if useLast == TRUE for the last update (of course, only if withMakeIC ==TRUE)
 
+Return value of "roptest"
++ the return value of "roptest", an object of class "kStepEstimate" has a slot "estimate.call" which
+  contains the (matched) call to "roptest"; internally "roptest" calls "robest"; the call to "robest"
+  may be of interest, too, so we have a new slot "robestCall" of class "OptionalCall", ie a call  
+  or NULL (default); it can be accessed via function robestCall() 
+
 bug fix: 
 + slot modifyIC was set to a wrong value in makeIC / former (potential) move was overridden 
 + in .preparePanelFirstLast if condition with.automatic.grid was (possibly) vector valued 

Modified: pkg/RobAStBase/man/kStepEstimate-class.Rd
===================================================================
--- pkg/RobAStBase/man/kStepEstimate-class.Rd	2018-07-24 22:18:11 UTC (rev 1055)
+++ pkg/RobAStBase/man/kStepEstimate-class.Rd	2018-07-24 22:31:37 UTC (rev 1056)
@@ -1,5 +1,6 @@
 \name{kStepEstimate-class}
 \docType{class}
+\alias{OptionalCall-class}
 \alias{kStepEstimate-class}
 \alias{steps}
 \alias{steps,kStepEstimate-method}
@@ -11,6 +12,8 @@
 \alias{ICList,kStepEstimate-method}
 \alias{pICList}
 \alias{pICList,kStepEstimate-method}
+\alias{robestCall}
+\alias{robestCall,kStepEstimate-method}
 \alias{start,kStepEstimate-method}
 \alias{startval}
 \alias{startval,kStepEstimate-method}
@@ -82,6 +85,9 @@
     \item{\code{uksteps}}{Object of class \code{"OptionalMatrix"}:
     the intermediate estimates (in \eqn{k}-space) for the parameter;
     only filled when called from \code{kStepEstimator}. }
+    \item{\code{robestcall}}{Object of class \code{"OptionalCall"}, i.e.,
+     a \code{call} or \code{NULL}: only filled when called from \code{roptest}
+     in package \pkg{ROptEst}.}
   }
 }
 \section{Extends}{
@@ -119,6 +125,8 @@
 
     \item{pICList}{\code{signature(object = "kStepEstimate")}:
       accessor function for slot \code{pICList}. }
+    \item{robestCall}{\code{signature(object = "kStepEstimate")}:
+      accessor function for slot \code{robestCall}. }
 
[TRUNCATED]

To get the complete diff run:
    svnlook diff /svnroot/robast -r 1056


More information about the Robast-commits mailing list