[Robast-commits] r1121 - in branches/robast-1.2/pkg/RobAStBase: R inst man

noreply at r-forge.r-project.org noreply at r-forge.r-project.org
Sat Aug 11 15:54:52 CEST 2018


Author: ruckdeschel
Date: 2018-08-11 15:54:52 +0200 (Sat, 11 Aug 2018)
New Revision: 1121

Modified:
   branches/robast-1.2/pkg/RobAStBase/R/ContIC.R
   branches/robast-1.2/pkg/RobAStBase/R/IC.R
   branches/robast-1.2/pkg/RobAStBase/R/generateICfct.R
   branches/robast-1.2/pkg/RobAStBase/R/getboundedIC.R
   branches/robast-1.2/pkg/RobAStBase/R/infoPlot.R
   branches/robast-1.2/pkg/RobAStBase/R/kStepEstimator.R
   branches/robast-1.2/pkg/RobAStBase/R/optIC.R
   branches/robast-1.2/pkg/RobAStBase/R/outlyingPlot.R
   branches/robast-1.2/pkg/RobAStBase/R/qqplot.R
   branches/robast-1.2/pkg/RobAStBase/R/returnlevelplot.R
   branches/robast-1.2/pkg/RobAStBase/inst/NEWS
   branches/robast-1.2/pkg/RobAStBase/man/ALEstimate-class.Rd
Log:
[RobAStBase] branch 1.2:
+ now specified that we want to use distr::solve
+ now generateIC.fct produces vectorized functions (can now use useApply=FALSE in E()) 


Modified: branches/robast-1.2/pkg/RobAStBase/R/ContIC.R
===================================================================
--- branches/robast-1.2/pkg/RobAStBase/R/ContIC.R	2018-08-10 22:49:40 UTC (rev 1120)
+++ branches/robast-1.2/pkg/RobAStBase/R/ContIC.R	2018-08-11 13:54:52 UTC (rev 1121)
@@ -110,7 +110,7 @@
         stopifnot(is.numeric(value))
         L2Fam <- eval(object at CallL2Fam)
         w <- object at weight
-        cent(w) <- as.vector(solve(object at stand) %*% value)
+        cent(w) <- as.vector(distr::solve(object at stand) %*% value)
         weight(w) <- getweight(w, neighbor = ContNeighborhood(radius = object at neighborRadius), 
                                biastype = object at biastype, 
                                normW = object at normtype)

Modified: branches/robast-1.2/pkg/RobAStBase/R/IC.R
===================================================================
--- branches/robast-1.2/pkg/RobAStBase/R/IC.R	2018-08-10 22:49:40 UTC (rev 1120)
+++ branches/robast-1.2/pkg/RobAStBase/R/IC.R	2018-08-11 13:54:52 UTC (rev 1121)
@@ -142,7 +142,7 @@
 
         E10 <- E(L2Fam, IC1 %*% t(L2deriv))
         E1 <- matrix(E10, dims, dims)
-        stand <- trafo %*% solve(E1) 
+        stand <- trafo %*% distr::solve(E1)
         Y <- as(stand %*% IC1, "EuclRandVariable")
         #ICfct <- vector(mode = "list", length = dims)
         #ICfct[[1]] <- function(x){Y(x)}

Modified: branches/robast-1.2/pkg/RobAStBase/R/generateICfct.R
===================================================================
--- branches/robast-1.2/pkg/RobAStBase/R/generateICfct.R	2018-08-10 22:49:40 UTC (rev 1120)
+++ branches/robast-1.2/pkg/RobAStBase/R/generateICfct.R	2018-08-11 13:54:52 UTC (rev 1121)
@@ -13,7 +13,7 @@
         L <- as(diag(dims)%*%L2Fam at L2deriv, "EuclRandVariable")
         distr <- distribution(L2Fam)
 
-        L.fct <- function(x) evalRandVar(L,x)
+        L.fct <- function(x) evalRandVar(L,as.matrix(x))[,,1]
         if(nrvalues == 1){
             if(!is.null(res$d)){
                 ICfct[[1]] <- function(x){}
@@ -80,7 +80,7 @@
         dims <- ncol(A)
         L <- as(diag(dims)%*%L2Fam at L2deriv, "EuclRandVariable")
         distr <- distribution(L2Fam)
-        L.fct <- function(x) evalRandVar(L,x)
+        L.fct <- function(x) evalRandVar(L,as.matrix(x))[,,1]
         fastFct <- function(x){}
         if(nrvalues==1L){
            d0 <- if(dims==1L) d else NA

Modified: branches/robast-1.2/pkg/RobAStBase/R/getboundedIC.R
===================================================================
--- branches/robast-1.2/pkg/RobAStBase/R/getboundedIC.R	2018-08-10 22:49:40 UTC (rev 1120)
+++ branches/robast-1.2/pkg/RobAStBase/R/getboundedIC.R	2018-08-11 13:54:52 UTC (rev 1121)
@@ -1,6 +1,6 @@
 getBoundedIC <- function(L2Fam, D=trafo(L2Fam at param)){
         FI <- FisherInfo(L2Fam)
-        bm <- sum(diag(solve(FI)))
+        bm <- sum(diag(distr::solve(FI)))
         w <- new("BoundedWeight", clip = bm, weight = function(x){
                    norm0 <- EuclideanNorm(as.matrix(x))
                    ind2 <- (norm0 < bm/2)
@@ -30,6 +30,6 @@
         L2w0 <- L2w - cent
 
         E1 <- matrix(E(D1, L2w0 %*% t(L2deriv-cent)), dims, dims)
-        stand <- as.matrix(D %*% solve(E1, generalized = TRUE))
+        stand <- as.matrix(D %*% distr::solve(E1, generalized = TRUE))
         return(as(stand %*% L2w0, "EuclRandVariable"))
         }

Modified: branches/robast-1.2/pkg/RobAStBase/R/infoPlot.R
===================================================================
--- branches/robast-1.2/pkg/RobAStBase/R/infoPlot.R	2018-08-10 22:49:40 UTC (rev 1120)
+++ branches/robast-1.2/pkg/RobAStBase/R/infoPlot.R	2018-08-11 13:54:52 UTC (rev 1121)
@@ -207,7 +207,7 @@
             QFc <- diag(dimsA)
             if(is(object,"ContIC") & dimsA>1 )
                {if (is(normtype(object),"QFNorm")) QFc <- QuadForm(normtype(object))
-                QFc0 <- solve( trafo %*% solve(L2Fam at FisherInfo) %*% t(trafo ))
+                QFc0 <- distr::solve( trafo %*% distr::solve(L2Fam at FisherInfo) %*% t(trafo ))
                 if (is(normtype(object),"SelfNorm")|is(normtype(object),"InfoNorm")) 
                     QFc <- QFc0
                }
@@ -223,7 +223,7 @@
 
             QFc.5 <- sqrt(PosSemDefSymmMatrix(QFc))
 
-            classIC <- as(trafo %*% solve(L2Fam at FisherInfo) %*% L2Fam at L2deriv, "EuclRandVariable")
+            classIC <- as(trafo %*% distr::solve(L2Fam at FisherInfo) %*% L2Fam at L2deriv, "EuclRandVariable")
             absInfoClass.f <- t(classIC) %*% QFc %*% classIC
 #            absInfoClass <- absInfoEval(x.vec, absInfoClass.f)
 

Modified: branches/robast-1.2/pkg/RobAStBase/R/kStepEstimator.R
===================================================================
--- branches/robast-1.2/pkg/RobAStBase/R/kStepEstimator.R	2018-08-10 22:49:40 UTC (rev 1120)
+++ branches/robast-1.2/pkg/RobAStBase/R/kStepEstimator.R	2018-08-11 13:54:52 UTC (rev 1121)
@@ -203,7 +203,7 @@
 #                print(Dtau)
                 if(!.isUnitMatrix(Dtau)){
  #                    print("HU1!")
-                     Dminus <- solve(Dtau, generalized = TRUE)
+                     Dminus <- distr::solve(Dtau, generalized = TRUE)
                      projker <- diag(k) - Dminus %*% Dtau
 
                      IC.tot1 <- Dminus %*% IC.c

Modified: branches/robast-1.2/pkg/RobAStBase/R/optIC.R
===================================================================
--- branches/robast-1.2/pkg/RobAStBase/R/optIC.R	2018-08-10 22:49:40 UTC (rev 1120)
+++ branches/robast-1.2/pkg/RobAStBase/R/optIC.R	2018-08-11 13:54:52 UTC (rev 1121)
@@ -3,7 +3,7 @@
 ###############################################################################
 setMethod("optIC", signature(model = "L2ParamFamily", risk = "asCov"),
     function(model, risk, withMakeIC = FALSE){
-        Curve <- as((trafo(model at param) %*% solve(model at FisherInfo)) %*% model at L2deriv, "EuclRandVariable")
+        Curve <- as((trafo(model at param) %*% distr::solve(model at FisherInfo)) %*% model at L2deriv, "EuclRandVariable")
         asCov <- trafo(model at param) %*% solve(model at FisherInfo) %*% t(trafo(model at param))
 
         modifyIC <- function(L2Fam, IC, withMakeIC=FALSE){ optIC(L2Fam, asCov()) }

Modified: branches/robast-1.2/pkg/RobAStBase/R/outlyingPlot.R
===================================================================
--- branches/robast-1.2/pkg/RobAStBase/R/outlyingPlot.R	2018-08-10 22:49:40 UTC (rev 1120)
+++ branches/robast-1.2/pkg/RobAStBase/R/outlyingPlot.R	2018-08-11 13:54:52 UTC (rev 1121)
@@ -111,7 +111,7 @@
          devIC <- data.frame(t(evIC[1:dimevIC,,drop=FALSE]))
          CMcd <- PosSemDefSymmMatrix(rrcov::getCov(rrcov::CovMcd(devIC,alpha=0.5)))
          asVar <- CMcd
-#         asVar <- solve(CMcd)
+#         asVar <- distr::solve(CMcd)
 #         cat("\n", sep="", gettext("Robust asVar"), ":\n")
 #         print(asVar)
       }
@@ -129,8 +129,8 @@
                    }
        }
     
-#       asVar <- PosSemDefSymmMatrix(solve(asVar))
-       mc$dist.x <- QFNorm(name = gettext("Mahalonobis-Norm"), QuadForm = PosSemDefSymmMatrix(solve(asVar)))
+#       asVar <- PosSemDefSymmMatrix(distr::solve(asVar))
+       mc$dist.x <- QFNorm(name = gettext("Mahalonobis-Norm"), QuadForm = PosSemDefSymmMatrix(distr::solve(asVar)))
       }
 
      if(missing(dist.y)){
@@ -161,7 +161,7 @@
        }
      
           mc$dist.y <- QFNorm(name = gettext("Mahalonobis-Norm"), 
-                              QuadForm =  PosSemDefSymmMatrix(solve(asVar)))
+                              QuadForm =  PosSemDefSymmMatrix(distr::solve(asVar)))
      }
 
 

Modified: branches/robast-1.2/pkg/RobAStBase/R/qqplot.R
===================================================================
--- branches/robast-1.2/pkg/RobAStBase/R/qqplot.R	2018-08-10 22:49:40 UTC (rev 1120)
+++ branches/robast-1.2/pkg/RobAStBase/R/qqplot.R	2018-08-11 13:54:52 UTC (rev 1121)
@@ -113,7 +113,7 @@
     FI <- PosSemDefSymmMatrix(FisherInfo(y at center))
     L2D <- as(diag(nrow(FI)) %*% L2deriv(y at center), "EuclRandVariable")
     L2Dx <- evalRandVar(L2D,matrix(x))[,,1]
-    scx <-  solve(sqrt(FI),L2Dx)
+    scx <-  distr::solve(sqrt(FI),L2Dx)
     xD <- fct(distance)(scx)
     cex.pts <- if(is.null(mcl[["cex.pts"]])){
                   if(is.null(mcl[["cex"]])){

Modified: branches/robast-1.2/pkg/RobAStBase/R/returnlevelplot.R
===================================================================
--- branches/robast-1.2/pkg/RobAStBase/R/returnlevelplot.R	2018-08-10 22:49:40 UTC (rev 1120)
+++ branches/robast-1.2/pkg/RobAStBase/R/returnlevelplot.R	2018-08-11 13:54:52 UTC (rev 1121)
@@ -99,7 +99,7 @@
     FI <- PosSemDefSymmMatrix(FisherInfo(y at center))
     L2D <- as(diag(nrow(FI)) %*% L2deriv(y at center), "EuclRandVariable")
     L2Dx <- evalRandVar(L2D,matrix(x))[,,1]
-    scx <-  solve(sqrt(FI),L2Dx)
+    scx <-  distr::solve(sqrt(FI),L2Dx)
     xD <- fct(distance)(scx)
     cex.pts <- if(is.null(mcl[["cex.pts"]])){
                   if(is.null(mcl[["cex"]])){

Modified: branches/robast-1.2/pkg/RobAStBase/inst/NEWS
===================================================================
--- branches/robast-1.2/pkg/RobAStBase/inst/NEWS	2018-08-10 22:49:40 UTC (rev 1120)
+++ branches/robast-1.2/pkg/RobAStBase/inst/NEWS	2018-08-11 13:54:52 UTC (rev 1121)
@@ -65,6 +65,8 @@
   this uses helper function .addTime to produce a matrix with detailed timing
   information which can be read out as argument ) -- it is in package 
   system folder "chkTimeCode" (in inst/chkTimeCode in r-forge)
++ now specified that we want to use distr::solve
++ now generateIC.fct produces vectorized functions (can now use useApply=FALSE in E()) 
   
 #######################################
 version 1.1

Modified: branches/robast-1.2/pkg/RobAStBase/man/ALEstimate-class.Rd
===================================================================
--- branches/robast-1.2/pkg/RobAStBase/man/ALEstimate-class.Rd	2018-08-10 22:49:40 UTC (rev 1120)
+++ branches/robast-1.2/pkg/RobAStBase/man/ALEstimate-class.Rd	2018-08-11 13:54:52 UTC (rev 1121)
@@ -10,6 +10,8 @@
 \alias{pIC,MLEstimate-method}
 \alias{pIC,CvMMDEstimate-method}
 \alias{pIC,MCALEstimate-method}
+\alias{pIC,ML.ALEstimate-method}
+\alias{pIC,CvMMD.ALEstimate-method}
 \alias{asbias}
 \alias{asbias,ALEstimate-method}
 \alias{show,ALEstimate-method}



More information about the Robast-commits mailing list