[Robast-commits] r1239 - in pkg/ROptEst: . R inst man
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Sat Nov 12 14:54:39 CET 2022
Author: ruckdeschel
Date: 2022-11-12 14:54:39 +0100 (Sat, 12 Nov 2022)
New Revision: 1239
Modified:
pkg/ROptEst/DESCRIPTION
pkg/ROptEst/R/CheckMakeContIC.R
pkg/ROptEst/R/L1L2normL2deriv.R
pkg/ROptEst/R/LowerCaseMultivariate.R
pkg/ROptEst/R/getInfCent.R
pkg/ROptEst/R/getInfGamma.R
pkg/ROptEst/R/getInfStand.R
pkg/ROptEst/R/getInfV.R
pkg/ROptEst/R/roptest.new.R
pkg/ROptEst/R/updateNorm.R
pkg/ROptEst/inst/NEWS
pkg/ROptEst/man/0ROptEst-package.Rd
pkg/ROptEst/man/internal-interpolate.Rd
Log:
[ROptEst] ported changes from branch 1.3 to trunk and fixed issues in man pages (multiple \items, invalid URLs...) the other packages in RobASt in branch 1.3 remain there...
Modified: pkg/ROptEst/DESCRIPTION
===================================================================
--- pkg/ROptEst/DESCRIPTION 2022-11-12 13:08:02 UTC (rev 1238)
+++ pkg/ROptEst/DESCRIPTION 2022-11-12 13:54:39 UTC (rev 1239)
@@ -1,6 +1,6 @@
Package: ROptEst
-Version: 1.2.1
-Date: 2019-04-07
+Version: 1.3.0
+Date: 2022-11-12
Title: Optimally Robust Estimation
Description: Optimally robust estimation in general smoothly parameterized models using S4
classes and methods.
@@ -19,4 +19,4 @@
Encoding: latin1
LastChangedDate: {$LastChangedDate$}
LastChangedRevision: {$LastChangedRevision$}
-VCS/SVNRevision: 1219
+VCS/SVNRevision: 1238
Modified: pkg/ROptEst/R/CheckMakeContIC.R
===================================================================
--- pkg/ROptEst/R/CheckMakeContIC.R 2022-11-12 13:08:02 UTC (rev 1238)
+++ pkg/ROptEst/R/CheckMakeContIC.R 2022-11-12 13:54:39 UTC (rev 1239)
@@ -208,8 +208,8 @@
res2 <- numeric(nrvalues)
for(i in 1:nrvalues){
if(z.comp[i]){
- Eargs <- c(list(object = Distr, fun = integrand2,
- L2.i = L2deriv at Map[[i]]), dotsI)
+ integrand2i <- function(x) integrand2(x,L2deriv at Map[[i]])
+ Eargs <- c(list(object = Distr, fun = integrand2i), dotsI)
res2[i] <- buf <- do.call(E,Eargs)
if(diagnostic){k <- k + 1; diagn[[k]] <- attr(buf,"diagnostic")}
}else{
@@ -229,9 +229,9 @@
for(i in 1:nrvalues){
for(j in i:nrvalues){
if(A.comp[i,j]){
- Eargs <- c(list(object = Distr, fun = integrandA,
- L2.i = L2deriv at Map[[i]],
- L2.j = L2deriv at Map[[j]], i = i, j = j), dotsI)
+ integrandAij <- function(x) integrandA(x, L2.i = L2deriv at Map[[i]],
+ L2.j = L2deriv at Map[[j]], i = i, j = j)
+ Eargs <- c(list(object = Distr, fun = integrandAij), dotsI)
erg[i, j] <- buf <- do.call(E,Eargs)
if(diagnostic){k <- k + 1; diagn[[k]] <- attr(buf,"diagnostic")}
}
Modified: pkg/ROptEst/R/L1L2normL2deriv.R
===================================================================
--- pkg/ROptEst/R/L1L2normL2deriv.R 2022-11-12 13:08:02 UTC (rev 1238)
+++ pkg/ROptEst/R/L1L2normL2deriv.R 2022-11-12 13:54:39 UTC (rev 1239)
@@ -12,14 +12,13 @@
dotsI <- .filterEargsWEargList(list(...))
if(is.null(dotsI$useApply)) dotsI$useApply <- FALSE
- integrandG <- function(x, L2, stand, cent){
- X <- evalRandVar(L2, as.matrix(x))[,,1] - cent
+ integrandG <- function(x){
+ X <- evalRandVar(L2deriv, as.matrix(x))[,,1] - cent
Y <- apply(X, 2, "%*%", t(stand))
res <- fct(normtype)(Y)
return((res > 0)*res)
}
-
- return(do.call(E, c(list(object = Distr, fun = integrandG, L2 = L2deriv,
- stand = stand, cent = cent),dotsI)))
+ retval <- do.call(E, c(list(object = Distr, fun = integrandG),dotsI))
+ return(retval)
})
Modified: pkg/ROptEst/R/LowerCaseMultivariate.R
===================================================================
--- pkg/ROptEst/R/LowerCaseMultivariate.R 2022-11-12 13:08:02 UTC (rev 1238)
+++ pkg/ROptEst/R/LowerCaseMultivariate.R 2022-11-12 13:54:39 UTC (rev 1239)
@@ -62,8 +62,9 @@
w <<- w0
}
- E1 <- do.call(E,c(list(object = Distr, fun = abs.fct, L2 = L2deriv, stand = A,
- cent = z, normtype.0 = normtype), dotsI))
+ abs.fct.0 <- function(x) abs.fct(x, L2deriv, A, z, normtype)
+
+ E1 <- do.call(E,c(list(object = Distr, fun = abs.fct.0), dotsI))
stA <- if (is(normtype,"QFNorm"))
QuadForm(normtype)%*%A else A
# erg <- E1/sum(diag(stA %*% t(trafo)))
@@ -130,8 +131,10 @@
p <- 1
A <- matrix(param, ncol = k, nrow = 1)
# print(A)
- E1 <- do.call(E, c(list( object = Distr, fun = pos.fct,
- L2 = L2deriv, stand = A), dotsI))
+
+ pos.fct.0 <- function(x) pos.fct(x, L2deriv, A)
+
+ E1 <- do.call(E, c(list( object = Distr, fun = pos.fct.0), dotsI))
erg <- E1/sum(diag(A %*% t(trafo)))
return(erg)
}
@@ -145,14 +148,14 @@
b <- 1/erg$value
stand(w) <- A
- pr.fct <- function(x, L2, pr.sign=1){
- X <- evalRandVar(L2, as.matrix(x)) [,,1]
+ pr.fct <- function(x, pr.sign=1){
+ X <- evalRandVar(L2deriv, as.matrix(x)) [,,1]
Y <- as.numeric(A %*% X)
return(as.numeric(pr.sign*Y>0))
}
- p.p <- do.call(E, c(list( object = Distr, fun = pr.fct, L2 = L2deriv,
+ p.p <- do.call(E, c(list( object = Distr, fun = pr.fct,
pr.sign = 1), dotsI))
- m.p <- do.call(E, c(list( object = Distr, fun = pr.fct, L2 = L2deriv,
+ m.p <- do.call(E, c(list( object = Distr, fun = pr.fct,
pr.sign = -1), dotsI))
Modified: pkg/ROptEst/R/getInfCent.R
===================================================================
--- pkg/ROptEst/R/getInfCent.R 2022-11-12 13:08:02 UTC (rev 1238)
+++ pkg/ROptEst/R/getInfCent.R 2022-11-12 13:54:39 UTC (rev 1239)
@@ -85,8 +85,9 @@
res2 <- numeric(nrvalues)
for(i in 1:nrvalues){
if(z.comp[i]){
- res2[i] <- do.call(E, c(list(object = Distr, fun = integrand2,
- L2.i = L2deriv at Map[[i]]), dotsI))
+ integrand2i <- function(x) integrand2(x, L2.i = L2deriv at Map[[i]])
+ res2[i] <- do.call(E, c(list(object = Distr, fun = integrand2i),
+ dotsI))
}else{
res2[i] <- 0
}
Modified: pkg/ROptEst/R/getInfGamma.R
===================================================================
--- pkg/ROptEst/R/getInfGamma.R 2022-11-12 13:08:02 UTC (rev 1238)
+++ pkg/ROptEst/R/getInfGamma.R 2022-11-12 13:54:39 UTC (rev 1239)
@@ -34,8 +34,8 @@
dotsI <- .filterEargsWEargList(list(...))
if(is.null(dotsI$useApply)) dotsI$useApply <- FALSE
- integrandG <- function(x, L2, stand, cent, clip){
- X <- evalRandVar(L2, as.matrix(x))[,,1] - cent
+ integrandG <- function(x){
+ X <- evalRandVar(L2deriv, as.matrix(x))[,,1] - cent
Y <- stand %*% X
res <- norm(risk)(Y) - clip
@@ -42,8 +42,7 @@
return((res > 0)*res^power)
}
- res <- do.call(E, c(list(object = Distr, fun = integrandG, L2 = L2deriv,
- stand = stand, cent = cent, clip = clip),dotsI))
+ res <- do.call(E, c(list(object = Distr, fun = integrandG),dotsI))
return(-res)
})
@@ -57,8 +56,8 @@
dotsI <- .filterEargsWEargList(list(...))
if(is.null(dotsI$useApply)) dotsI$useApply <- FALSE
- integrandG <- function(x, L2, stand, cent, clip){
- X <- evalRandVar(L2, as.matrix(x))[,,1] - cent
+ integrandG <- function(x){
+ X <- evalRandVar(L2deriv, as.matrix(x))[,,1] - cent
Y <- stand %*% X
res <- Y - clip
@@ -65,8 +64,7 @@
return((res > 0)*res^power)
}
- res <- do.call(E, c(list(object = Distr, fun = integrandG, L2 = L2deriv,
- stand = stand, cent = cent, clip = clip),dotsI))
+ res <- do.call(E, c(list(object = Distr, fun = integrandG),dotsI))
return(-res)
})
###############################################################################
Modified: pkg/ROptEst/R/getInfStand.R
===================================================================
--- pkg/ROptEst/R/getInfStand.R 2022-11-12 13:08:02 UTC (rev 1238)
+++ pkg/ROptEst/R/getInfStand.R 2022-11-12 13:54:39 UTC (rev 1239)
@@ -39,9 +39,10 @@
for(i in 1:nrvalues)
for(j in i:nrvalues)
if(A.comp[i,j]){
- erg[i, j] <- do.call(E, c(list(object = Distr, fun = integrandA,
- L2.i = L2deriv at Map[[i]],
- L2.j = L2deriv at Map[[j]], i = i, j = j), dotsI))
+ integrandAij <- function(x) integrandA(x,L2.i = L2deriv at Map[[i]],
+ L2.j = L2deriv at Map[[j]], i = i, j = j)
+ erg[i, j] <- do.call(E, c(list(object = Distr, fun = integrandAij),
+ dotsI))
}
erg[col(erg) < row(erg)] <- t(erg)[col(erg) < row(erg)]
Modified: pkg/ROptEst/R/getInfV.R
===================================================================
--- pkg/ROptEst/R/getInfV.R 2022-11-12 13:08:02 UTC (rev 1238)
+++ pkg/ROptEst/R/getInfV.R 2022-11-12 13:54:39 UTC (rev 1239)
@@ -56,9 +56,10 @@
for(i in 1:nrvalues)
for(j in i:nrvalues)
if(V.comp[i,j]){
- eArgs <- c(list(object = Distr, fun = integrandV,
+ integrandVij <- function(x) integrandV(x,
L2.i = L2deriv at Map[[i]],
- L2.j = L2deriv at Map[[j]], i = i, j = j), dotsI)
+ L2.j = L2deriv at Map[[j]], i = i, j = j)
+ eArgs <- c(list(object = Distr, fun = integrandVij), dotsI)
erg[i, j] <- do.call(E,eArgs)
}
erg[col(erg) < row(erg)] <- t(erg)[col(erg) < row(erg)]
Modified: pkg/ROptEst/R/roptest.new.R
===================================================================
--- pkg/ROptEst/R/roptest.new.R 2022-11-12 13:08:02 UTC (rev 1238)
+++ pkg/ROptEst/R/roptest.new.R 2022-11-12 13:54:39 UTC (rev 1239)
@@ -390,7 +390,8 @@
withLogScale = kStepCtrl$withLogScale,
withEvalAsVar = withEvalAsVarkStep,
withMakeIC = withMakeICkStep)
- print(argList) }
+ print(argList)
+ }
sy.kStep <- system.time({
kStepArgList <- list(x, IC = ICstart, start = initial.est,
steps = steps, useLast = kStepCtrl$useLast,
@@ -406,8 +407,14 @@
nms <- names(kStepCtrl$E.arglist)
for(nmi in nms) kStepArgList[[nmi]] <- kStepCtrl$E.arglist[[nmi]]
}
- res <- do.call(kStepEstimator, kStepArgList)
- })
+ if(debug){
+ print(substitute({
+ res <- do.call(kStepEstimator, kStepArgList0)
+ }, list(kStepArgList0=kStepEstimator)))
+ }else{
+ res <- do.call(kStepEstimator, kStepArgList)
+ }
+ })
sy.OnlykStep <- attr(res,"timings")
kStepDiagn <- attr(res,"diagnostic")
if (withTimings) print(sy.kStep)
Modified: pkg/ROptEst/R/updateNorm.R
===================================================================
--- pkg/ROptEst/R/updateNorm.R 2022-11-12 13:08:02 UTC (rev 1238)
+++ pkg/ROptEst/R/updateNorm.R 2022-11-12 13:54:39 UTC (rev 1239)
@@ -1,9 +1,10 @@
-#setMethod("updateNorm", "NormType", function(normtype, ...) normtype)
-#setMethod("updateNorm", "InfoNorm", function(normtype, FI, ...)
+# setMethod("updateNorm", "NormType", function(normtype, ...) normtype)
+# setMethod("updateNorm", "InfoNorm", function(normtype, FI, ...)
# {QuadForm(normtype) <- PosSemDefSymmMatrix(FI); normtype})
+
setMethod("updateNorm", "SelfNorm", function(normtype, L2, neighbor, biastype,
- Distr, V.comp, cent, stand, w)
- {Cv <- getInfV(L2deriv = L2, neighbor = neighbor,
+ Distr, V.comp, cent, stand, w){
+ Cv <- getInfV(L2deriv = L2, neighbor = neighbor,
biastype = biastype, Distr = Distr,
V.comp = V.comp, cent = cent, stand = stand, w = w)
QuadForm(normtype) <- PosSemDefSymmMatrix(distr::solve(Cv))
Modified: pkg/ROptEst/inst/NEWS
===================================================================
--- pkg/ROptEst/inst/NEWS 2022-11-12 13:08:02 UTC (rev 1238)
+++ pkg/ROptEst/inst/NEWS 2022-11-12 13:54:39 UTC (rev 1239)
@@ -8,6 +8,17 @@
information)
#######################################
+version 1.3
+#######################################
+
+under the hood:
++ in calls of form do.call(E, .....) we only use functions with one argument;
+ (in calls where a function was passed on as argument, this threw errors...)
++ fixed some broken URLs and changed URLs from http to https where possible
++ triggered by new NOTES uncovered by R CMD check, we deleted duplicate entries for items
+ in internal-interpolate.Rd
+
+#######################################
version 1.2.1
#######################################
Modified: pkg/ROptEst/man/0ROptEst-package.Rd
===================================================================
--- pkg/ROptEst/man/0ROptEst-package.Rd 2022-11-12 13:08:02 UTC (rev 1238)
+++ pkg/ROptEst/man/0ROptEst-package.Rd 2022-11-12 13:54:39 UTC (rev 1239)
@@ -12,8 +12,8 @@
\details{
\tabular{ll}{
Package: \tab ROptEst \cr
-Version: \tab 1.2.1 \cr
-Date: \tab 2019-04-07 \cr
+Version: \tab 1.3.0 \cr
+Date: \tab 2022-11-12 \cr
Depends: \tab R(>= 3.4), methods, distr(>= 2.8.0), distrEx(>= 2.8.0), distrMod(>= 2.8.1),RandVar(>= 1.2.0), RobAStBase(>= 1.2.0) \cr
Suggests: \tab RobLox \cr
Imports: \tab startupmsg, MASS, stats, graphics, utils, grDevices \cr
@@ -21,7 +21,7 @@
Encoding: \tab latin1 \cr
License: \tab LGPL-3 \cr
URL: \tab http://robast.r-forge.r-project.org/\cr
-VCS/SVNRevision: \tab 1219 \cr
+VCS/SVNRevision: \tab 1238 \cr
}
}
\author{
Modified: pkg/ROptEst/man/internal-interpolate.Rd
===================================================================
--- pkg/ROptEst/man/internal-interpolate.Rd 2022-11-12 13:08:02 UTC (rev 1238)
+++ pkg/ROptEst/man/internal-interpolate.Rd 2022-11-12 13:54:39 UTC (rev 1239)
@@ -92,7 +92,6 @@
\item{tol}{ the desired accuracy (convergence tolerance).}
\item{loRad0}{ for numerical reasons: the effective lower bound for the zero search;
internally set to \code{max(loRad,loRad0)}. }
- \item{\dots}{ additional parameters. }
\item{withStartLM}{ logical of length 1: shall the LM's of the preceding grid
value serve as starting value for the next grid value? }
\item{withSmooth}{logical of length 1: shall a smoothing spline be used? }
@@ -113,7 +112,7 @@
\code{PFam} and last arguments \code{GridFileName},
\code{withPrint}; produces the y-values for the
interpolation grid. }
- \item{\dots}{further arguments to be passed on to \code{getFun}. }
+ \item{\dots}{further arguments to be passed on, e.g., to \code{getFun}. }
\item{len}{integer; number of Lagrange multipliers to be calibrated. }
}
\details{
More information about the Robast-commits
mailing list