[Robast-commits] r552 - in branches/robast-0.9/pkg: ROptEst/R ROptEst/man RobExtremes/R RobExtremes/inst/AddMaterial/interpolation
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Thu Jan 24 21:25:57 CET 2013
Author: ruckdeschel
Date: 2013-01-24 21:25:57 +0100 (Thu, 24 Jan 2013)
New Revision: 552
Modified:
branches/robast-0.9/pkg/ROptEst/R/getStartIC.R
branches/robast-0.9/pkg/ROptEst/man/internalInterpolate.Rd
branches/robast-0.9/pkg/RobExtremes/R/interpolLM.R
branches/robast-0.9/pkg/RobExtremes/R/sysdata.rda
branches/robast-0.9/pkg/RobExtremes/inst/AddMaterial/interpolation/interpolationscripts.R
Log:
ROptEst/RobExtremes: removed some bugs (functions where identical in grid..!)
Modified: branches/robast-0.9/pkg/ROptEst/R/getStartIC.R
===================================================================
--- branches/robast-0.9/pkg/ROptEst/R/getStartIC.R 2013-01-24 19:20:24 UTC (rev 551)
+++ branches/robast-0.9/pkg/ROptEst/R/getStartIC.R 2013-01-24 20:25:57 UTC (rev 552)
@@ -6,7 +6,7 @@
mc <- match.call(expand.dots=FALSE, call = sys.call(sys.parent(1)))
dots <- as.list(mc$"...")
if("fsCor" %in% names(dots)){
- fsCor <- dots[["fsCor"]]
+ fsCor <- eval(dots[["fsCor"]])
dots$fsCor <- NULL
}else fsCor <- 1
if("eps" %in% names(dots)){
@@ -14,7 +14,7 @@
dots$eps <- NULL
}else eps <- NULL
if("neighbor" %in% names(dots)){
- neighbor <- dots[["neighbor"]]
+ neighbor <- eval(dots[["neighbor"]])
dots$neighbor <- NULL
}else neighbor <- ContNeighborhood()
Modified: branches/robast-0.9/pkg/ROptEst/man/internalInterpolate.Rd
===================================================================
--- branches/robast-0.9/pkg/ROptEst/man/internalInterpolate.Rd 2013-01-24 19:20:24 UTC (rev 551)
+++ branches/robast-0.9/pkg/ROptEst/man/internalInterpolate.Rd 2013-01-24 20:25:57 UTC (rev 552)
@@ -28,67 +28,13 @@
values of \code{\link{approxfun}} before (a function with body of type
\code{.C("R_approxfun", as.double(x),....}) and after R-2.16
(a function with body of type \code{.approxfun(x, y, v, method, yleft,
-yright, f)}); in our interpolation object, there are values for
-both situations with suffices \code{.o} and \code{.n} for before and
+yright, f)}); a similar case happens with \code{splinefun};
+in our interpolation object, there are values for
+both situations with suffices \code{.O} and \code{.N} for before and
after R-2.16, respectively.
\code{.getpsi} reads the respective interpolating function
-from an object from \file{sysdata.rda}
-\code{.constructArg.list} takes a function \code{fun} and the return value
-of \code{match.call} and, as return value, produces a list of arguments where
-the formal arguments of \code{fun} are set to their default values and
-with extra item \code{esc}.\cr
-
-If argument \code{onlyFormals} is \code{TRUE} and the formals contain \code{\dots},
-the returned list only contains formal arguments of \code{fun}, filled with
-default values from the definition where available, and, in addition,
-in element \code{esc} a list with element one of the original matched call
-and, as subsequent elements, with the named, evaluated arguments of the
-matched call which are no formal arguments of \code{fun}.\cr
-
-If argument \code{onlyFormals} is \code{FALSE} or the formals do not contain
-\code{\dots}, the returned list again contains formal arguments of \code{fun}
-filled in with defaults where available, but in addition it contains the arguments
-of the matched calls non matched to formals (in particular those passed on through
-\code{\dots}). Then element \code{esc} in the returned list with contains
-element one of the original matched call coerced to list, i.e., the name of
-the called function.
-
-\code{.fix.in.defaults} takes a list of arguments of \code{fun} taken from a
-matched call obtained by \code{match.call} from within a call of \code{fun}
-(after coercing to list) and supplements this list by formal arguments of
-\code{fun} which are not yet matched but have default arguments (with exactly
-these default values). The return value is the prolongated list.
-
-\code{.pretreat}, if \code{is.numeric(x)} is \code{FALSE}, coerces \code{x}
-to a numeric matrix (by a call to \code{data.matrix} in case
-\code{x} is a data.frame, respectively, by a call to \code{as.matrix} else.
-If \code{na.rm} is \code{TRUE}, \code{x} is reduced to \code{na.omit(x)}.
-The return value is a list of elements \code{x}, the possibly modified
-input \code{x}, and \code{completecases}, the return value of
-\code{compeletecases(x)}.
-
-\code{.check.eps} takes its input (possibly empty in part)
-and returns a list \code{eps} with elements \code{sqn}, \code{e},
-\code{lower}, and \code{upper}. Necessarily the input \code{\dots} must
-contain an argument matching to \code{x}, and \code{sqn} is the square root
-of either the length of \code{x} (if \code{x} is a vector) or the number of
-columns of \code{x} (in case \code{dim(x)==2}). In case \code{\dots} contains
-none of the elements \code{eps}, \code{eps.lower}, \code{eps.upper}, elements
-\code{lower} and \code{upper} of the return value are set to \code{0} and
-\code{0.5}, respectively. Else, if \code{eps} is contained input \code{\dots}
-element \code{e} of the return list is set to \code{eps}, and
-\code{lower} and \code{upper} are left empty. Otherwise, element \code{e}
-of the return list is left empty and \code{lower} and \code{upper} are filled
-with \code{eps.lower} and \code{eps.upper} from input \code{\dots} if available
-and else with default values \code{0} and \code{0.5}, respectively.
-
-\code{.isOKsteps} checks whether argument \code{steps} is a valid
-argument, i.e., is an integer larger than 0 of length 1 and, accordingly,
-returns \code{TRUE} or \code{FALSE}.
-
-\code{.isOKfsCor} checks whether argument \code{fsCor} is a valid
-argument, i.e., larger than 0 and of length 1 and, accordingly,
-returns \code{TRUE} or \code{FALSE}.
+from an object from \file{sysdata.rda} and generates a respective
+\code{HampelIC} object by a call to \code{generateIC}.
}
\keyword{internal}
Modified: branches/robast-0.9/pkg/RobExtremes/R/interpolLM.R
===================================================================
--- branches/robast-0.9/pkg/RobExtremes/R/interpolLM.R 2013-01-24 19:20:24 UTC (rev 551)
+++ branches/robast-0.9/pkg/RobExtremes/R/interpolLM.R 2013-01-24 20:25:57 UTC (rev 552)
@@ -85,18 +85,16 @@
LMGrid2 <- apply(LMGrid,2,function(u) smooth.spline(xiGrid,u)$y)
fctL <- vector("list",ncol(LMGrid))
+ xm <- xiGrid[1]
+ xM <- (rev(xiGrid))[1]
for(i in 1:ncol(LMGrid)){
LMG <- LMGrid[,i]
fct <- splinefun(x=xiGrid,y=LMG)
- xm <- xiGrid[1]
ym <- LMG[1]
dym <- (LMG[2]-LMG[1])/(xiGrid[2]-xiGrid[1])
- xM <- (rev(xiGrid))[1]
- yM <- ym
- dyM <- dym
yM <- (rev(LMG))[1]
dyM <- ((rev(LMG))[2]-(rev(LMG))[1])/((rev(xiGrid))[2]-(rev(xiGrid))[1])
- fctL[[i]] <- function(x){
+ fctX <- function(x){
y0 <- fct(x)
y1 <- y0
y1[x<xm] <- ym+dym*(x[x<xm]-xm)
@@ -105,8 +103,13 @@
warning("There have been xi-values out of range of the interpolation grid.")
return(y1)
}
- environment(fctL[[i]]) <- new.env()
- assign("fct",fct, envir=environment(fctL[[i]]))
+ environment(fctX) <- nE <- new.env()
+ assign("fct",fct, envir=nE)
+ assign("yM",yM, envir=nE)
+ assign("ym",ym, envir=nE)
+ assign("dyM",dyM, envir=nE)
+ assign("dym",dym, envir=nE)
+ fctL[[i]] <- fctX
}
if(ncol(LMGrid)==1) fctL <- fctL[[1]]
Modified: branches/robast-0.9/pkg/RobExtremes/R/sysdata.rda
===================================================================
(Binary files differ)
Modified: branches/robast-0.9/pkg/RobExtremes/inst/AddMaterial/interpolation/interpolationscripts.R
===================================================================
--- branches/robast-0.9/pkg/RobExtremes/inst/AddMaterial/interpolation/interpolationscripts.R 2013-01-24 19:20:24 UTC (rev 551)
+++ branches/robast-0.9/pkg/RobExtremes/inst/AddMaterial/interpolation/interpolationscripts.R 2013-01-24 20:25:57 UTC (rev 552)
@@ -31,3 +31,8 @@
RobExtremes:::.recomputeInterpolators(.myfiles, sysRdaFolder = .myFolder)
## on R-2.15.2
RobExtremes:::.recomputeInterpolators(.myfiles1, sysRdaFolder = .myfolder2)
+
+## some check (R-3.0.0) : fct[[1]] and fct[[2]] should be different...
+require(RobExtremes); RobExtremes:::.recomputeInterpolators("sysdata.rda", sysRdaFolder = ".")
+fct <- getFromNamespace(".OMSE.N", "RobExtremes")[[1]]$fct
+fct[[1]](2);fct[[2]](2)
More information about the Robast-commits
mailing list