[Robast-commits] r339 - in branches/robast-0.7/pkg: ROptEst/R ROptEst/chm ROptEst/man RobAStBase/chm

noreply at r-forge.r-project.org noreply at r-forge.r-project.org
Wed Aug 12 22:12:51 CEST 2009


Author: ruckdeschel
Date: 2009-08-12 22:12:47 +0200 (Wed, 12 Aug 2009)
New Revision: 339

Added:
   branches/robast-0.7/pkg/ROptEst/chm/getinfLM.html
   branches/robast-0.7/pkg/ROptEst/chm/internals.html
   branches/robast-0.7/pkg/ROptEst/man/getinfLM.Rd
   branches/robast-0.7/pkg/ROptEst/man/internals.Rd
Modified:
   branches/robast-0.7/pkg/ROptEst/R/getInfClip.R
   branches/robast-0.7/pkg/ROptEst/R/getInfLM.R
   branches/robast-0.7/pkg/ROptEst/R/getInfRobIC_asGRisk.R
   branches/robast-0.7/pkg/ROptEst/R/getInfRobIC_asHampel.R
   branches/robast-0.7/pkg/ROptEst/chm/ROptEst.chm
   branches/robast-0.7/pkg/RobAStBase/chm/RobAStBase.chm
Log:
ROptEst: small bugs removed in getInfRobIC_asGRisk, getInfRobIC_asHampel, getInfClip
getInfLM now gains (unfortunately not a good idea) the new MSE - optimization routines for obtaining LagrangeMultipliers


Modified: branches/robast-0.7/pkg/ROptEst/R/getInfClip.R
===================================================================
--- branches/robast-0.7/pkg/ROptEst/R/getInfClip.R	2009-08-12 01:28:26 UTC (rev 338)
+++ branches/robast-0.7/pkg/ROptEst/R/getInfClip.R	2009-08-12 20:12:47 UTC (rev 339)
@@ -33,7 +33,7 @@
                                   neighbor = "UncondNeighborhood"),
     function(clip, L2deriv, risk, neighbor, biastype, 
              Distr, stand, cent, trafo){
-        return(neighbor at radius^2*clip + 
+        return(neighbor at radius^2*clip +
                 getInfGamma(L2deriv = L2deriv, risk = risk, neighbor = neighbor, 
                             biastype = biastype, Distr = Distr, stand = stand, 
                             cent = cent, clip = clip))

Modified: branches/robast-0.7/pkg/ROptEst/R/getInfLM.R
===================================================================
--- branches/robast-0.7/pkg/ROptEst/R/getInfLM.R	2009-08-12 01:28:26 UTC (rev 338)
+++ branches/robast-0.7/pkg/ROptEst/R/getInfLM.R	2009-08-12 20:12:47 UTC (rev 339)
@@ -5,7 +5,7 @@
 getLagrangeMultByIter <- function(b, L2deriv, risk, trafo,
                       neighbor, biastype, normtype, Distr,
                       z.start, A.start, w.start, std, z.comp, A.comp, maxiter, tol,
-                      onesetLM, verbose, warnit = TRUE){
+                      verbose, warnit = TRUE){
         LMcall <- match.call()
 
         ## initialization
@@ -47,6 +47,7 @@
                   zc <- z
             }
 
+            # update standardization
             A <- getInfStand(L2deriv = L2deriv, neighbor = neighbor,
                          biastype = biastype, Distr = Distr, A.comp = A.comp,
                          cent = zc, trafo = trafo, w = w)
@@ -57,7 +58,6 @@
                normtype(risk) <- normtype <- updateNorm(normtype = normtype,
                    L2 = L2deriv, neighbor = neighbor, biastype = biastype,
                    Distr = Distr, V.comp = A.comp, cent = z, stand = A, w = w)
-               std <- QuadForm(normtype)
             }
 
             ## precision and iteration counting
@@ -72,33 +72,26 @@
                 break
             }
         }
-        ## shall Lagrange-Multipliers inside weight and outside coincide
-        if (onesetLM&&maxiter>=1){
-            if(is(neighbor,"ContNeighborhood"))
-               cent(w) <- as.numeric(z)
-            if(is(neighbor,"TotalVarNeighborhood"))
-               clip(w) <- c(0,b)+a
-            stand(w) <- A
 
-            weight(w) <- getweight(w, neighbor = neighbor, biastype = biastype,
-                                   normW = normtype)
-        }
-        else normtype <- normtype.old
-
         ## determine LM a
         if(is(neighbor,"ContNeighborhood"))
            a <- as.vector(A %*% z)
 
+        std <- if(is(normtype,"QFNorm"))
+                  QuadForm(normtype) else NULL
+
         return(list(A = A, a = a, z = z, w = w,
                     biastype = biastype, normtype = normtype,
-                    risk = risk, std = std, iter = iter, prec = prec, b = b,
+                    normtype.old = normtype.old,
+                    risk = risk, std = std,
+                    iter = iter, prec = prec, b = b,
                     call = LMcall ))
 }
 
 getLagrangeMultByOptim <- function(b, L2deriv, risk, FI, trafo,
                       neighbor, biastype, normtype, Distr,
                       z.start, A.start, w.start, std, z.comp, A.comp, maxiter, tol,
-                      onesetLM, verbose, ...){
+                      verbose, ...){
 
         LMcall <- match.call()
         ### manipulate dots in call -> set control argument for optim
@@ -106,11 +99,11 @@
         if(is.null(dots$method)) dots$method <- "L-BFGS-B"
 
         if(!is.null(dots$control)){
-            if(is.null(dots$control$maxit)) dots$control$maxit <-  maxiter
+            if(is.null(dots$control$maxit)) dots$control$maxit <-  round(maxiter)
             if(is.null(dots$control$reltol)) dots$control$reltol <- tol
             if(is.null(dots$control$abstol)) dots$control$abstol <- tol
         }else{
-            dots$control = list(maxit=maxiter, reltol=tol, abstol=tol)
+            dots$control = list(maxit=min(round(maxiter),1e8), reltol=tol, abstol=tol)
         }
         #print(dots$control)
         ## initialization
@@ -125,8 +118,8 @@
         A0log <- as.logical(cbind(A.comp, as.logical(A.comp%*%as.numeric(z.comp)>0)))
         lvlog <- lvec0[A0log]
         A0vec1 <- A0vec0[A0log]
+#        print(list(A0vec0,A0log,lvlog,A0vec1))
 
-
         iter1 <- 0
         stdC  <- stdC.opt <- std
         optV <- Inf
@@ -143,9 +136,13 @@
             A0vecA <- numeric(p*(k+1))
 
             A0vecA[lvlog] <- A0vec
+
             ### read out current value of LM in usual format
             A0 <- matrix(A0vecA[1:(p*k)],nrow=p,ncol=k)
             a0 <- as.numeric(A0vecA[(p*k)+(1:p)])
+
+#            print(list(A0vecA,A0,a0))
+
             z0 <- as.numeric(solve(A0,a0))
             std0 <- stdC
             w0 <- w1
@@ -189,30 +186,49 @@
             ###### for gamma([Q,]A,b) = E[{Y_A (1-w_b(|Y_A|_Q))}^2]
 
             riskA <- risk0
-            if(is(riskA, "asHampel"))
+            if(is(riskA, "asHampel")){
                riskA <- asMSE(biastype=biastype, normtype=normtype)
+               val <-   (as.numeric(t(a0)%*%std0%*%a0)/2 +
+                          sum(diag(std0%*%A0%*%FI%*%t(A0)))/2 +
+                          ## ~ E |Y_A|_Q^2 / 2
+                          getInfGamma(L2deriv = L2deriv, risk = riskA,
+                                 neighbor = neighbor, biastype = biastype,
+                                 Distr = Distr, stand = A0, cent = z0, clip = b,
+                                 power = 2)/2 -
+                           # ~ - E[|Y_A|_Q^2 (1-w_b(|Y_A|_Q))^2]/2
+                           sum(diag(std0%*%A0%*%t(trafo)) ))
+                        ## ~tr_Q AD'
 
+               ## in case TotalVarNeighborhood additional correction term:
+               if(is(neighbor,"TotalVarNeighborhood"))
+                  val <- (val -a0^2/2 -
+                          E(Distr, fun = function(x){ ## ~ - E Y_-^2/2
+                              L2 <- evalRandVar(L2deriv, as.matrix(x)) [,,1]- z0
+                              Y <- A0 %*% L2
+                              return(Y^2*(Y<0))
+                              },  useApply = FALSE)/2)
 
-            val <-   (as.numeric(t(z0)%*%t(A0)%*%std0%*%A0%*%z0)/2 +
-                       sum(diag(std0%*%A0%*%FI%*%t(A0)))/2 +
-                       ## ~ E |Y_A|_Q^2 / 2
-
-                       getInfGamma(L2deriv = L2deriv, risk = riskA,
-                              neighbor = neighbor, biastype = biastype,
-                              Distr = Distr, stand = A0, cent = z0, clip = b,
-                              power = 2)/2 -
-                        # ~ - E[|Y_A|_Q^2 (1-w_b(|Y_A|_Q))^2]/2
-                        sum(diag(std0%*%A0%*%t(trafo)) ))
+            }else if(is(risk0,"asMSE")){
+               val <- (E(object = Distr, fun = function(x){
+                          X <- evalRandVar(L2deriv, as.matrix(x))[,,1] - z0
+                          Y <- A0 %*% X
+                          nY <- norm(risk0)(Y)
+                          return(nY^2*weight(w0)(X))
+                        },  # E|Y|^2 w
+                        useApply=FALSE) /2 -
+                       sum(diag(std0%*%A0%*%t(trafo)) ))
                      ## ~tr_Q AD'
 
-            ## in case TotalVarNeighborhood additional correction term:
-            if(is(neighbor,"TotalVarNeighborhood"))
-               val <- val -E(Distr, fun = function(x){ ## ~ - E Y_-^2/2
-                                  L2 <- evalRandVar(L2deriv, as.matrix(x)) [,,1]
-                                        - z0
-                                  Y <- stand %*% L2
-                                  return(Y^2*(Y<0)/2)
-                                  },  useApply = FALSE)
+               ## in case TotalVarNeighborhood additional correction term:
+               if(is(neighbor,"TotalVarNeighborhood"))
+                  val <- (val -a0^2/2 -
+                          E(Distr, fun = function(x){
+                              X <- evalRandVar(L2deriv, as.matrix(x))[,,1] - z0
+                              Y <- A0 %*% X
+                              return(Y^2*(Y<0))
+                             },
+                            useApply=FALSE)/2)
+            }
 
             ## if this is the current optimum
             ## transport some values outside the optimizer:
@@ -243,24 +259,13 @@
         a <- as.numeric(Aoptvec[(p*k)+(1:p)])
         z <- z1.opt
         w <- w1.opt
-        risk1 <- risk1.opt
-        stdC <- stdC.opt
-        ## shall Lagrange-Multipliers inside weight and outside coincide
-        if (onesetLM&&maxiter>1){
-            if(is(neighbor,"ContNeighborhood"))
-               cent(w) <- as.numeric(z)
-            if(is(neighbor,"TotalVarNeighborhood"))
-               clip(w) <- c(0,b)+a
-            stand(w) <- A
 
-            weight(w) <- getweight(w, neighbor = neighbor, biastype = biastype,
-                                   normW = normtype1.opt)
-        }
-        else normtype1 <- normtype1.opt.old
 
         return(list(A = A, a = a, z = z, w = w,
-                    biastype = biastype, normtype = normtype,
-                    risk = risk1, std = stdC, iter = iter1,
+                    biastype = biastype, normtype = normtype1.opt,
+                    normtype.old = normtype1.opt.old,
+                    risk = risk1.opt, std = stdC.opt, iter = iter1,
                     prec = opterg$convergence, b = b,
                     call = LMcall ))
-}
\ No newline at end of file
+}
+

Modified: branches/robast-0.7/pkg/ROptEst/R/getInfRobIC_asGRisk.R
===================================================================
--- branches/robast-0.7/pkg/ROptEst/R/getInfRobIC_asGRisk.R	2009-08-12 01:28:26 UTC (rev 338)
+++ branches/robast-0.7/pkg/ROptEst/R/getInfRobIC_asGRisk.R	2009-08-12 20:12:47 UTC (rev 339)
@@ -89,15 +89,19 @@
 
             prec.old <- prec
             prec <- max(abs(z - z.old), abs(c0-c0.old))
-            if(verbose)
-                cat("current precision in IC algo:\t", prec, "\n")
+            if(iter>1){
+               if(verbose)
+                  cat("current precision in IC algo:\t", prec, "\n")
+            }
             if(prec < tol) break
             if(abs(prec.old - prec) < 1e-10){
-                cat("algorithm did not converge!\n", "achieved precision:\t", prec, "\n")
+                if(iter>1)
+                   cat("algorithm did not converge!\n", "achieved precision:\t", prec, "\n")
                 break
             }
             if(iter > maxiter){
-                cat("maximum iterations reached!\n", "achieved precision:\t", prec, "\n")
+                if(iter>1)
+                   cat("maximum iterations reached!\n", "achieved precision:\t", prec, "\n")
                 break
             }
         }
@@ -217,11 +221,6 @@
         prec <- 1
         iter.In <- 0
 
-        if(is(neighbor,"ContNeighborhood")){
-               w <- new("HampelWeight")
-        }else if(is(neighbor,"TotalVarNeighborhood")){
-               w <- new("BdStWeight")
-        }
 
         ## determining A,a,b with either optimization of iteration:
         if(OptOrIter == 1){
@@ -244,19 +243,15 @@
             Cov <- 0
             Risk <- 1e10
             normtype.old <- normtype
-            z.opt <- z
-            A.opt <- A
-            a.opt <- as.numeric(A.opt %*% z.opt)
-            w.opt <- w
-            std.opt <- std
+            a <- as.numeric(A%*% z)
             normtype.opt <- normtype
 
             asGRiskb <- function(b0){
                iter <<- iter + 1
                erg <- getLagrangeMultByOptim(b = b0, L2deriv = L2deriv, risk = risk,
                          FI = Finfo, trafo = trafo, neighbor = neighbor,
-                         biastype = biastype, normtype = normtype.opt, Distr = Distr,
-                         z.start = z.opt, A.start = A.opt, w.start = w.opt, std = std.opt,
+                         biastype = biastype, normtype = normtype, Distr = Distr,
+                         z.start = z, A.start = A, w.start = w, std = std,
                          z.comp = z.comp, A.comp = A.comp,
                          maxiter = round(maxiter/50*iter^5), tol = tol^(iter^5/40),
                          onesetLM = onesetLM, verbose = verbose, ...)
@@ -265,9 +260,9 @@
                A0 <- erg$A
                a0 <- erg$a
                z0 <- erg$z
-               std0 <- erg$std
+               std0 <- if(is.null(erg$std)) std else erg$std
                biastype0 <- erg$biastype
-               normtype.old0 <- normtype
+               normtype.old0 <- erg$normtype.old
                normtype0 <- erg$normtype
                risk0 <- erg$risk
                iter.In <<- iter.In + erg$iter
@@ -289,31 +284,29 @@
 #               print("A")
 #               print(list(Risk=Risk0,A=A0,a=a0,z=z0,b=b0))
 #               print("...")
-               w.opt <<- w <<- w0
-               A.opt <<- A <<- A0
-               a.opt <<- a <<- a0
-               z.opt <<- z <<- z0
+               w <<- w0
+               A <<- A0
+               a <<- a0
+               z <<- z0
                b <<- b0
-               std.opt <<- std <<- std0
+               std <<- std0
                biastype <<- biastype0
                normtype.old <<- normtype.old0
-               normtype.opt <<- normtype <<- normtype0
+               normtype <<- normtype0
                risk <<- risk0
                prec.In <<- erg$prec
                OptIterCall <<- erg$call
                Cov <<- Cov0
-
-               return(Risk0-sum(diag(std0%*%A0%*%t(trafo))))
+#               print(c(b0,Risk0))
+               return((Risk0-sum(diag(std0%*%A0%*%t(trafo))))^2)
             }
             tol0 <- tol^.5
-            f.l <- asGRiskb(lower)
-            f.u <- asGRiskb(upper)
+#            f.l <- asGRiskb(lower)
+#            f.u <- asGRiskb(upper)
 
-            du <- uniroot(asGRiskb, interval = c(lower,upper), tol = tol0,
-                           f.lower=f.l, f.upper=f.u)
-#            du <- optimize(asGRiskb, interval = c(lower,upper), tol = tol0,
-#                           A.o = A.opt, z.o = z.opt, a.o = a.opt, w.o = w.opt,
-#                           std.o = std.opt, normtype.o = normtype.opt)
+#            du <- uniroot(asGRiskb, interval = c(lower,upper), tol = tol0,
+#                           f.lower=f.l, f.upper=f.u)
+            du <- optimize(asGRiskb, interval = c(1e-4,1e8), tol = tol0^2)
         }else{
             repeat{
                 iter <- iter + 1
@@ -325,9 +318,17 @@
                 LUB <- .getLowUpB(L2deriv = L2deriv, Finfo = Finfo, Distr = Distr,
                                   normtype = normtype, z = z, A = A, radius = radius,
                                   iter = iter)
-                lower <- LUB$lower
-                upper <- if(is.null(upper)) LUB$upper else min(upper,LUB$upper)
 
+                if (!is.null(upper)|(iter == 1))
+                    {lower <- .Machine$double.eps^0.75;
+                      if(is.null(upper)) upper <- 10*LUB$upper
+                }else{ lower <- LUB$lower; upper <- LUB$upper}
+
+            ##
+
+#                lower <- LUB$lower
+#                upper <- if(is.null(upper)) LUB$upper else min(upper,LUB$upper)
+
 #                print(c(lower,upper))
                 ## solve for b
                 b <- try(uniroot(getInfClip,
@@ -355,7 +356,7 @@
                               z.start = z, A.start = A, w.start = w,
                               std = std, z.comp = z.comp,
                               A.comp = A.comp, maxiter = maxit2, tol = tol,
-                              onesetLM = onesetLM, verbose = verbose, warnit = (OptOrIter!=2))
+                              verbose = verbose, warnit = (OptOrIter!=2))
 
                  ## read out solution
                  w <- erg$w
@@ -363,25 +364,15 @@
                  a <- erg$a
                  z <- erg$z
                  biastype <- erg$biastype
-                 normtype.old <- normtype
+                 normtype.old <- erg$normtype.old
                  normtype <- erg$normtype
                  risk <- erg$risk
                  iter.In <- iter.In + erg$iter
                  prec.In <- erg$prec
                  OptIterCall <- erg$call
-                 std <- erg$std
+                 std <- if(is.null(erg$std)) std else erg$std
 #                 print(list(z=z,A=A,b=b))
 
-                 if (onesetLM&&maxiter>1){
-                     if(is(neighbor,"ContNeighborhood"))
-                           cent(w) <- as.numeric(z)
-                     if(is(neighbor,"TotalVarNeighborhood"))
-                           clip(w) <- c(0,b)+a
-                     stand(w) <- A
-                     weight(w) <- getweight(w, neighbor = neighbor, biastype = biastype,
-                                            normW = normtype)
-                     }
-                 else normtype <- normtype.old
 
                  ## check precision and number of iterations in outer b-loop
                  prec.old <- prec
@@ -398,6 +389,18 @@
                      break
                  }
             }
+
+        if (onesetLM){
+            if(is(neighbor,"ContNeighborhood"))
+                  cent(w) <- as.numeric(z)
+            if(is(neighbor,"TotalVarNeighborhood"))
+                  clip(w) <- c(0,b)+a
+            stand(w) <- A
+            weight(w) <- getweight(w, neighbor = neighbor, biastype = biastype,
+                                   normW = normtype)
+            }
+        else normtype <- normtype.old
+
         ### issue some diagnostics if wanted
           if(verbose){
              cat("Iterations needed: outer (b-loop):",
@@ -405,11 +408,14 @@
              cat("Precision achieved: all in all (b+A,a-loop):",
                  prec," inner (A,a-loop):", prec.In,"\n")
           }
+
+
         ### determine Covariance of pIC
           Cov <- getInfV(L2deriv = L2deriv, neighbor = neighbor,
                        biastype = biastype, Distr = Distr,
                        V.comp = A.comp, cent = a,
                        stand = A, w = w)
+          print(list(Cov=Cov,A=A,c=a,w=w))
           if(!is(risk, "asMSE")){
               Risk <- getAsRisk(risk = risk, L2deriv = L2deriv, neighbor = neighbor,
                                 biastype = biastype, clip = b, cent = a, stand = A,
@@ -485,7 +491,7 @@
                                    neighbor = neighbor, Distr = Distr, DistrSymm = DistrSymm,
                                    L2derivSymm = L2derivSymm, L2derivDistrSymm = L2derivDistrSymm,
                                    z.start = z.start, A.start = A.start, trafo = trafo,
-                                   maxiter = maxiter, tol = tol, warn = warn, Finfo = Finfo,
+                                   maxiter = round(maxiter), tol = tol, warn = warn, Finfo = Finfo,
                                    verbose = verbose)
                 normtype(risk) <- res$normtype
                 if(!is(risk, "asMSE")){

Modified: branches/robast-0.7/pkg/ROptEst/R/getInfRobIC_asHampel.R
===================================================================
--- branches/robast-0.7/pkg/ROptEst/R/getInfRobIC_asHampel.R	2009-08-12 01:28:26 UTC (rev 338)
+++ branches/robast-0.7/pkg/ROptEst/R/getInfRobIC_asHampel.R	2009-08-12 20:12:47 UTC (rev 339)
@@ -208,7 +208,7 @@
                       biastype = biastype, normtype = normtype, Distr = Distr,
                       z.start = z.start, A.start = A.start, w.start = w, std = std,
                       z.comp = z.comp, A.comp = A.comp, maxiter = maxiter,
-                      tol = tol, onesetLM = onesetLM, verbose = verbose, ...)
+                      tol = tol, verbose = verbose, ...)
         else{
            erg <- getLagrangeMultByIter(b = b, L2deriv = L2deriv, risk = risk,
                       trafo = trafo, neighbor = neighbor, biastype = biastype,
@@ -216,7 +216,7 @@
                       z.start = z.start, A.start = A.start, w.start = w,
                       std = std, z.comp = z.comp,
                       A.comp = A.comp, maxiter = maxiter, tol = tol,
-                      onesetLM = onesetLM, verbose = verbose)
+                      verbose = verbose)
         }
 
         ## read out solution
@@ -225,6 +225,7 @@
         a <- erg$a
         z <- erg$z
         biastype <- erg$biastype
+        normtype.old <- erg$normtype.old
         normtype <- erg$normtype
         risk <- erg$risk
         iter <- erg$iter
@@ -238,6 +239,20 @@
            cat("Precision achieved:", prec,"\n")
         }
 
+        ## shall Lagrange-Multipliers inside weight and outside coincide
+        if (onesetLM){
+            if(is(neighbor,"ContNeighborhood"))
+               cent(w) <- as.numeric(z)
+            if(is(neighbor,"TotalVarNeighborhood"))
+               clip(w) <- c(0,b)+a
+            stand(w) <- A
+
+            weight(w) <- getweight(w, neighbor = neighbor, biastype = biastype,
+                                   normW = normtype)
+        }
+        else normtype <- normtype.old
+
+
         ### determine Covariance of pIC
         Cov <- getInfV(L2deriv = L2deriv, neighbor = neighbor,
                        biastype = biastype, Distr = Distr,

Modified: branches/robast-0.7/pkg/ROptEst/chm/ROptEst.chm
===================================================================
(Binary files differ)

Added: branches/robast-0.7/pkg/ROptEst/chm/getinfLM.html
===================================================================
--- branches/robast-0.7/pkg/ROptEst/chm/getinfLM.html	                        (rev 0)
+++ branches/robast-0.7/pkg/ROptEst/chm/getinfLM.html	2009-08-12 20:12:47 UTC (rev 339)
@@ -0,0 +1,207 @@
+<html><head><title>Functions to determine Lagrange multipliers</title>
+<meta http-equiv="Content-Type" content="text/html; charset=utf-8">
+<link rel="stylesheet" type="text/css" href="Rchm.css">
+</head><body>
+
+<table width="100%"><tr><td>getInfLM(ROptEst)</td><td align="right">R Documentation</td></tr></table>
+<object type="application/x-oleobject" classid="clsid:1e2a7bd0-dab9-11d0-b93a-00c04fc99f9e">
+<param name="keyword" value="R:   getInfLM">
+<param name="keyword" value="R:   getLagrangeMultByOptim">
+<param name="keyword" value="R:   getLagrangeMultByIter">
+<param name="keyword" value=" Functions to determine Lagrange multipliers">
+</object>
+
+
+<h2>Functions to determine Lagrange multipliers</h2>
+
+
+<h3>Description</h3>
+
+<p>
+Functions to determine Lagrange multipliers <code>A</code> and <code>a</code>
+in a Hampel problem or in a(n) (inner) loop in a MSE problem; can be done
+either by optimization or by fixed point iteration. These functions are
+rarely called directly.
+</p>
+
+
+<h3>Usage</h3>
+
+<pre>
+getLagrangeMultByIter(b, L2deriv, risk, trafo,
+                      neighbor, biastype, normtype, Distr,
+                      z.start, A.start, w.start, std, z.comp, A.comp, maxiter, tol,
+                      verbose, warnit = TRUE)
+getLagrangeMultByOptim(b, L2deriv, risk, FI, trafo,
+                      neighbor, biastype, normtype, Distr,
+                      z.start, A.start, w.start,  std, z.comp, A.comp, maxiter, tol,
+                      verbose, ...)
+
+</pre>
+
+
+<h3>Arguments</h3>
+
+<table summary="R argblock">
+<tr valign="top"><td><code>b</code></td>
+<td>
+numeric; (<i>&gt;b_min</i>; clipping bound
+for which the Lagrange multipliers are searched</td></tr>
+<tr valign="top"><td><code>L2deriv</code></td>
+<td>
+ L2-derivative of some L2-differentiable family
+of probability measures. </td></tr>
+<tr valign="top"><td><code>risk</code></td>
+<td>
+ object of class <code>"RiskType"</code>. </td></tr>
+<tr valign="top"><td><code>FI</code></td>
+<td>
+ matrix: Fisher information. </td></tr>
+<tr valign="top"><td><code>trafo</code></td>
+<td>
+ matrix: transformation of the parameter. </td></tr>
+<tr valign="top"><td><code>neighbor</code></td>
+<td>
+ object of class <code>"Neighborhood"</code>. </td></tr>
+<tr valign="top"><td><code>biastype</code></td>
+<td>
+object of class <code>"BiasType"</code> &mdash; the bias type with we work.</td></tr>
+<tr valign="top"><td><code>normtype</code></td>
+<td>
+object of class <code>"NormType"</code> &mdash; the norm type with we work.</td></tr>
+<tr valign="top"><td><code>Distr</code></td>
+<td>
+ object of class <code>"Distribution"</code>. </td></tr>
+<tr valign="top"><td><code>z.start</code></td>
+<td>
+ initial value for the centering constant. </td></tr>
+<tr valign="top"><td><code>A.start</code></td>
+<td>
+ initial value for the standardizing matrix. </td></tr>
+<tr valign="top"><td><code>w.start</code></td>
+<td>
+ initial value for the weight function. </td></tr>
+<tr valign="top"><td><code>std</code></td>
+<td>
+ matrix of (or which may coerced to) class
+<code>PosSemDefSymmMatrix</code> for use of different
+(standardizing) norm. </td></tr>
+<tr valign="top"><td><code>z.comp</code></td>
+<td>
+ logical vector: indication which components of the
+centering constant have to be computed. </td></tr>
+<tr valign="top"><td><code>A.comp</code></td>
+<td>
+ matrix: indication which components of the standardizing
+matrix have to be computed. </td></tr>
+<tr valign="top"><td><code>maxiter</code></td>
+<td>
+ the maximum number of iterations. </td></tr>
+<tr valign="top"><td><code>tol</code></td>
+<td>
+ the desired accuracy (convergence tolerance).</td></tr>
+<tr valign="top"><td><code>verbose</code></td>
+<td>
+ logical: if <code>TRUE</code>, some messages are printed. </td></tr>
+<tr valign="top"><td><code>warnit</code></td>
+<td>
+ logical: if <code>TRUE</code> warning is issued if
+maximal number of iterations is reached. </td></tr>
+<tr valign="top"><td><code>...</code></td>
+<td>
+ additional parameters for <code>optim</code>. </td></tr>
+</table>
+
+
+<h3>Value</h3>
+
+<p>a list with items
+<table summary="R valueblock">
+<tr valign="top"><td><code>A</code></td>
+<td>
+Lagrange multiplier <code>A</code> (standardizing matrix)</td></tr>
+<tr valign="top"><td><code>a</code></td>
+<td>
+Lagrange multiplier <code>a</code> (centering in <code>p</code>-space)</td></tr>
+<tr valign="top"><td><code>z</code></td>
+<td>
+Lagrange multiplier <code>z</code> (centering in <code>k</code>-space)</td></tr>
+<tr valign="top"><td><code>w</code></td>
+<td>
+weight function involving Lagrange multipliers</td></tr>
+<tr valign="top"><td><code>biastype</code></td>
+<td>
+(possibly modified) bias type <code>biastype</code> from argument</td></tr>
+<tr valign="top"><td><code>normtype</code></td>
+<td>
+(possibly modified) norm type <code>normtype</code> from argument</td></tr>
+<tr valign="top"><td><code>normtype.old</code></td>
+<td>
+(possibly modified) norm type <code>normtype</code>
+before last (internal) update</td></tr>
+<tr valign="top"><td><code>risk</code></td>
+<td>
+(possibly [norm-]modified) risk <code>risk</code> from argument</td></tr>
+<tr valign="top"><td><code>std</code></td>
+<td>
+(possibly modified) argument <code>std</code></td></tr>
+<tr valign="top"><td><code>iter</code></td>
+<td>
+number of iterations needed</td></tr>
+<tr valign="top"><td><code>prec</code></td>
+<td>
+precision achieved</td></tr>
+<tr valign="top"><td><code>b</code></td>
+<td>
+used clippng height <code>b</code></td></tr>
+<tr valign="top"><td><code>call</code></td>
+<td>
+call with which either <code>getLagrangeMultByIter</code> or
+<code>getLagrangeMultByOptim</code> was called </td></tr>
+</table>
+</p>
+
+
+<h3>Author(s)</h3>
+
+<p>Peter Ruckdeschel <a href="mailto:Peter.Ruckdeschel at itwm.fraunhofer.de">Peter.Ruckdeschel at itwm.fraunhofer.de</a></p>
+
+
+<h3>References</h3>
+
+<p>
+Rieder, H. (1980) Estimates derived from robust tests. Ann. Stats. <B>8</B>: 106-115.
+</p>
+<p>
+Rieder, H. (1994) <EM>Robust Asymptotic Statistics</EM>. New York: Springer.
+</p>
+<p>
+Ruckdeschel, P. and Rieder, H. (2004) Optimal Influence Curves for
+General Loss Functions. Statistics &amp; Decisions <B>22</B>: 201-223.
+</p>
+<p>
+Ruckdeschel, P. (2005) Optimally One-Sided Bounded Influence Curves.
+Mathematical Methods in Statistics <EM>14</EM>(1), 105-131.
+</p>
+<p>
+Kohl, M. (2005) <EM>Numerical Contributions to the Asymptotic Theory of Robustness</EM>.
+Bayreuth: Dissertation.
+</p>
+
+
+<h3>See Also</h3>
+
+<p><code><a href="../../RobAStBase/html/InfRobModel-class.html">InfRobModel-class</a></code></p>
+
+<script Language="JScript">
+function findlink(pkg, fn) {
+var Y, link;
+Y = location.href.lastIndexOf("\\") + 1;
+link = location.href.substring(0, Y);
+link = link + "../../" + pkg + "/chtml/" + pkg + ".chm::/" + fn;
+location.href = link;
+}
+</script>
+
+<hr><div align="center">[Package <em>ROptEst</em> version 0.7 <a href="00Index.html">Index</a>]</div>
+</body></html>

Added: branches/robast-0.7/pkg/ROptEst/chm/internals.html
===================================================================
--- branches/robast-0.7/pkg/ROptEst/chm/internals.html	                        (rev 0)
+++ branches/robast-0.7/pkg/ROptEst/chm/internals.html	2009-08-12 20:12:47 UTC (rev 339)
@@ -0,0 +1,182 @@
+<html><head><title>Internal / Helper functions of package ROptEst</title>
+<meta http-equiv="Content-Type" content="text/html; charset=utf-8">
+<link rel="stylesheet" type="text/css" href="Rchm.css">
+</head><body>
+
+<table width="100%"><tr><td>internals_for_ROptEst(ROptEst)</td><td align="right">R Documentation</td></tr></table>
+<object type="application/x-oleobject" classid="clsid:1e2a7bd0-dab9-11d0-b93a-00c04fc99f9e">
+<param name="keyword" value="R:   internals_for_ROptEst">
+<param name="keyword" value=" Internal / Helper functions of package ROptEst">
+</object>
+
+
+<h2>Internal / Helper functions of package ROptEst</h2>
+
+
+<h3>Description</h3>
+
+<p>
+These functions are used internally by package <span class="pkg">ROptEst</span>.</p>
+
+
+<h3>Usage</h3>
+
+<pre>
+### helper function to check whether given b is in (bmin, bmax)
+###        if not returns corresponding upper / lower case solution
+
+.checkUpLow(L2deriv, b, risk, neighbor, biastype, normtype,
+                        Distr, Finfo, DistrSymm, L2derivSymm,
+                        L2derivDistrSymm, z.start, A.start, trafo, maxiter,
+                        tol, QuadForm, verbose, nrvalpts, warn)
+                        
+### helper function to return the upper case solution if r=0
+.getUpperSol(L2deriv, b, radius, risk, neighbor, biastype,
+                       normtype, Distr, Finfo, trafo,
+                       QuadForm, verbose, warn)
+
+### helper function to return the lower case solution if b-search was not successful
+.getLowerSol(L2deriv, risk, neighbor, Distr, DistrSymm,
+                         L2derivSymm, L2derivDistrSymm,
+                         z.start, A.start, trafo,
+                         maxiter, tol, warn, Finfo, verbose)
+
+
+### helper function to return upper &amp; lower bounds for b for b-search
+.getLowUpB(L2deriv, Finfo, Distr, normtype, z, A, radius, iter)
+
+</pre>
+
+
+<h3>Arguments</h3>
+
+<table summary="R argblock">
+<tr valign="top"><td><code>L2deriv</code></td>
+<td>
+ L2-derivative of some L2-differentiable family
+of probability measures. </td></tr>
+<tr valign="top"><td><code>b</code></td>
+<td>
+numeric; clipping bound under consideration.</td></tr>
+<tr valign="top"><td><code>risk</code></td>
+<td>
+ object of class <code>"RiskType"</code>. </td></tr>
+<tr valign="top"><td><code>neighbor</code></td>
+<td>
+ object of class <code>"Neighborhood"</code>. </td></tr>
+<tr valign="top"><td><code>biastype</code></td>
+<td>
+object of class <code>"BiasType"</code> &mdash; the bias type with we work.</td></tr>
+<tr valign="top"><td><code>normtype</code></td>
+<td>
+object of class <code>"NormType"</code> &mdash; the norm type with we work.</td></tr>
+<tr valign="top"><td><code>Distr</code></td>
+<td>
+ object of class <code>"Distribution"</code>. </td></tr>
+<tr valign="top"><td><code>Finfo</code></td>
+<td>
+ Fisher information matrix. </td></tr>
+<tr valign="top"><td><code>DistrSymm</code></td>
+<td>
+ object of class <code>"DistributionSymmetry"</code>. </td></tr>
+<tr valign="top"><td><code>L2derivSymm</code></td>
+<td>
+ object of class <code>"FunSymmList"</code>. </td></tr>
+<tr valign="top"><td><code>L2derivDistrSymm</code></td>
+<td>
+ object of class <code>"DistrSymmList"</code>. </td></tr>
+<tr valign="top"><td><code>z.start</code></td>
+<td>
+ initial value for the centering constant. </td></tr>
+<tr valign="top"><td><code>A.start</code></td>
+<td>
+ initial value for the standardizing matrix. </td></tr>
+<tr valign="top"><td><code>trafo</code></td>
+<td>
+ matrix: transformation of the parameter. </td></tr>
+<tr valign="top"><td><code>maxiter</code></td>
+<td>
+ the maximum number of iterations. </td></tr>
+<tr valign="top"><td><code>tol</code></td>
+<td>
+ the desired accuracy (convergence tolerance).</td></tr>
+<tr valign="top"><td><code>QuadForm</code></td>
+<td>
+ matrix of (or which may coerced to) class
+<code>PosSemDefSymmMatrix</code> for use of different
+(standardizing) norm </td></tr>
+<tr valign="top"><td><code>verbose</code></td>
+<td>
+ logical: if <code>TRUE</code>, some messages are printed. </td></tr>
+<tr valign="top"><td><code>nrvalpts</code></td>
+<td>
+integer: number of evaluation points.</td></tr>
[TRUNCATED]

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


More information about the Robast-commits mailing list