[Robast-commits] r1182 - in branches/robast-1.2/pkg/ROptRegTS: R inst
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Sat Mar 2 16:58:01 CET 2019
Author: ruckdeschel
Date: 2019-03-02 16:58:00 +0100 (Sat, 02 Mar 2019)
New Revision: 1182
Modified:
branches/robast-1.2/pkg/ROptRegTS/R/CondIC.R
branches/robast-1.2/pkg/ROptRegTS/R/Expectation.R
branches/robast-1.2/pkg/ROptRegTS/R/L2RegTypeFamily.R
branches/robast-1.2/pkg/ROptRegTS/inst/NEWS
Log:
[ROptRegTS] branch 1.2: for compatibility with the new capsulation of E()-arguments, we removed additional functional arguments f1 from calls to E() and replaced them by the actual maps
Modified: branches/robast-1.2/pkg/ROptRegTS/R/CondIC.R
===================================================================
--- branches/robast-1.2/pkg/ROptRegTS/R/CondIC.R 2019-03-02 15:47:59 UTC (rev 1181)
+++ branches/robast-1.2/pkg/ROptRegTS/R/CondIC.R 2019-03-02 15:58:00 UTC (rev 1182)
@@ -41,9 +41,8 @@
IC1 <- as(diag(nrow(trafo)) %*% IC at Curve, "EuclRandVariable")
cent <- array(0, c(length(IC1), length(cond), nrow(trafo)))
for(i in 1:length(IC1)){
- fct <- function(x, cond, f1){ f1(cbind(t(cond),x)) }
- cent[i,,] <- apply(cond, 1, .condE, D1 = L2Fam at distribution, fct = fct,
- f1 = IC1 at Map[[i]])
+ fct <- function(x, cond){ IC1 at Map[[i]](cbind(t(cond),x)) }
+ cent[i,,] <- apply(cond, 1, .condE, D1 = L2Fam at distribution, fct = fct)
}
if(out)
cat("precision of conditional centering:\t", max(abs(cent)), "\n")
@@ -54,9 +53,8 @@
IC.L2 <- IC1 %*% t(L2deriv)
res <- numeric(length(IC.L2))
for(i in 1:length(IC.L2)){
- fct <- function(x, cond, f1){ f1(cbind(t(cond),x)) }
- res[i] <- E(K, .condE, D1 = L2Fam at distribution, fct = fct,
- f1 = IC.L2 at Map[[i]])
+ fct <- function(x, cond){ IC.L2 at Map[[i]](cbind(t(cond),x)) }
+ res[i] <- E(K, .condE, D1 = L2Fam at distribution, fct = fct)
}
consist <- matrix(res, nrow = nrow(trafo)) - trafo
if(out){
@@ -90,9 +88,8 @@
IC1 <- as(diag(nrow(trafo)) %*% IC at Curve, "EuclRandVariable")
cent <- array(0, c(length(IC1), length(cond), nrow(trafo)))
for(i in 1:length(IC1)){
- fct <- function(x, cond, f1){ f1(cbind(t(cond),x)) }
- cent[i,,] <- apply(cond, 1, .condE, D1 = L2Fam at distribution, fct = fct,
- f1 = IC1 at Map[[i]])
+ fct <- function(x, cond){ IC1 at Map[[i]](cbind(t(cond),x)) }
+ cent[i,,] <- apply(cond, 1, .condE, D1 = L2Fam at distribution, fct = fct)
}
if(out)
cat("precision of conditional centering:\t", max(abs(cent)), "\n")
@@ -103,9 +100,8 @@
IC.L2 <- IC1 %*% t(L2deriv)
res <- numeric(length(IC.L2))
for(i in 1:length(IC.L2)){
- fct <- function(x, cond, f1){ f1(cbind(t(cond),x)) }
- res[i] <- E(K, .condE, D1 = L2Fam at distribution, fct = fct,
- f1 = IC.L2 at Map[[i]])
+ fct <- function(x, cond) IC.L2 at Map[[i]](cbind(t(cond),x))
+ res[i] <- E(K, .condE, D1 = L2Fam at distribution, fct = fct)
}
consist <- matrix(res, nrow = nrow(trafo)) - trafo
if(out){
Modified: branches/robast-1.2/pkg/ROptRegTS/R/Expectation.R
===================================================================
--- branches/robast-1.2/pkg/ROptRegTS/R/Expectation.R 2019-03-02 15:47:59 UTC (rev 1181)
+++ branches/robast-1.2/pkg/ROptRegTS/R/Expectation.R 2019-03-02 15:58:00 UTC (rev 1182)
@@ -9,12 +9,12 @@
fun = "EuclRandVariable",
cond = "missing"),
function(object, fun){
- fct <- function(x, cond, f1){ f1(cbind(t(cond),x)) }
-
+# fct <- function(x, cond, f1){ f1(cbind(t(cond),x)) }
res <- numeric(length(fun))
for(i in 1:length(fun)){
+ fct <- function(x,cond) fun at Map[[i]](cbind(t(cond),x))
res[i] <- E(object at RegDistr, .condE, D1 = object at distribution,
- fct = fct, f1 = fun at Map[[i]])
+ fct = fct)
}
return(res)
Modified: branches/robast-1.2/pkg/ROptRegTS/R/L2RegTypeFamily.R
===================================================================
--- branches/robast-1.2/pkg/ROptRegTS/R/L2RegTypeFamily.R 2019-03-02 15:47:59 UTC (rev 1181)
+++ branches/robast-1.2/pkg/ROptRegTS/R/L2RegTypeFamily.R 2019-03-02 15:58:00 UTC (rev 1182)
@@ -48,10 +48,12 @@
L2.L2 <- L2deriv1 %*% t(L2deriv1)
res <- numeric(length(L2.L2))
for(i in 1:length(L2.L2)){
- fct <- function(x, cond, f1){ f1(cbind(cond,x)) }
- res[i] <- E(RegDistr, .condE, D1 = distribution, fct = fct,
- f1 = L2.L2 at Map[[i]])
- }
+ #fct <- function(x, cond, f1){ f1(cbind(cond,x)) }
+ #res[i] <- E(RegDistr, .condE, D1 = distribution, fct = fct,
+ # f1 = L2.L2 at Map[[i]])
+ fct <- function(x,cond) L2.L2 at Map[[i]](cbind(cond,x))
+ res[i] <- E(RegDistr, .condE, D1 = distribution, fct = fct)
+ }
FisherInfo <- PosDefSymmMatrix(matrix(res, nrow = dims))
}else{
stop("not yet implemented")
Modified: branches/robast-1.2/pkg/ROptRegTS/inst/NEWS
===================================================================
--- branches/robast-1.2/pkg/ROptRegTS/inst/NEWS 2019-03-02 15:47:59 UTC (rev 1181)
+++ branches/robast-1.2/pkg/ROptRegTS/inst/NEWS 2019-03-02 15:58:00 UTC (rev 1182)
@@ -12,6 +12,8 @@
under the hood
+ now specified that we want to use distr::solve
++ for compatibility with the new capsulation of E()-arguments, we removed additional
+ functional arguments f1 from calls to E() and replaced them by the actual maps
#######################################
version 1.1
More information about the Robast-commits
mailing list