[Robast-commits] r519 - in pkg/RobLox: . R inst/scripts man
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Wed Sep 12 20:01:55 CEST 2012
Author: stamats
Date: 2012-09-12 20:01:54 +0200 (Wed, 12 Sep 2012)
New Revision: 519
Added:
pkg/RobLox/R/ZZZinternal.R
Removed:
pkg/RobLox/R/0pre2160.R
Modified:
pkg/RobLox/DESCRIPTION
pkg/RobLox/R/sysdata.rda
pkg/RobLox/inst/scripts/LMinterpolation.R
pkg/RobLox/man/0RobLox-package.Rd
Log:
Kurt Hornik (CRAN) reported problems with the approach of using approxfun. Hence, I've implemented a new approach based on approx and saved values.
Modified: pkg/RobLox/DESCRIPTION
===================================================================
--- pkg/RobLox/DESCRIPTION 2012-09-12 15:32:35 UTC (rev 518)
+++ pkg/RobLox/DESCRIPTION 2012-09-12 18:01:54 UTC (rev 519)
@@ -1,6 +1,6 @@
Package: RobLox
-Version: 0.8.1
-Date: 2012-09-10
+Version: 0.8.2
+Date: 2012-09-12
Title: Optimally robust influence curves and estimators for location and scale
Description: Functions for the determination of optimally robust influence curves and
estimators in case of normal location and/or scale
@@ -15,4 +15,4 @@
URL: http://robast.r-forge.r-project.org/
LastChangedDate: {$LastChangedDate$}
LastChangedRevision: {$LastChangedRevision$}
-SVNRevision: 454
+SVNRevision: 519
Deleted: pkg/RobLox/R/0pre2160.R
===================================================================
--- pkg/RobLox/R/0pre2160.R 2012-09-12 15:32:35 UTC (rev 518)
+++ pkg/RobLox/R/0pre2160.R 2012-09-12 18:01:54 UTC (rev 519)
@@ -1,55 +0,0 @@
-## due to a change to .C in 2.16.0
-
-.getA1.locsc <- if(getRversion() < "2.16.0"){
- function(v) .getA1.locsc.old(v)
- }else{
- function(v) .getA1.locsc.new(v)
- }
-
-.getA2.locsc <- if(getRversion() < "2.16.0"){
- function(v) .getA2.locsc.old(v)
- }else{
- function(v) .getA2.locsc.new(v)
- }
-
-.geta.locsc <- if(getRversion() < "2.16.0"){
- function(v) .geta.locsc.old(v)
- }else{
- function(v) .geta.locsc.new(v)
- }
-
-.getb.locsc <- if(getRversion() < "2.16.0"){
- function(v) .getb.locsc.old(v)
- }else{
- function(v) .getb.locsc.new(v)
- }
-
-.getA.sc <- if(getRversion() < "2.16.0"){
- function(v) .getA.sc.old(v)
- }else{
- function(v) .getA.sc.new(v)
- }
-
-.geta.sc <- if(getRversion() < "2.16.0"){
- function(v) .geta.sc.old(v)
- }else{
- function(v) .geta.sc.new(v)
- }
-
-.getb.sc <- if(getRversion() < "2.16.0"){
- function(v) .getb.sc.old(v)
- }else{
- function(v) .getb.sc.new(v)
- }
-
-.getA.loc <- if(getRversion() < "2.16.0"){
- function(v) .getA.loc.old(v)
- }else{
- function(v) .getA.loc.new(v)
- }
-
-.getb.loc <- if(getRversion() < "2.16.0"){
- function(v) .getb.loc.old(v)
- }else{
- function(v) .getb.loc.new(v)
- }
Copied: pkg/RobLox/R/ZZZinternal.R (from rev 512, pkg/RobLox/R/0pre2160.R)
===================================================================
--- pkg/RobLox/R/ZZZinternal.R (rev 0)
+++ pkg/RobLox/R/ZZZinternal.R 2012-09-12 18:01:54 UTC (rev 519)
@@ -0,0 +1,34 @@
+## due to a change to .C in 2.16.0
+## location
+.getA.loc <- function(r){
+ approx(x = .radius.gitter, y = .A.loc, xout = r, yleft = 1)$y
+}
+.getb.loc <- function(r){
+ approx(x = .radius.gitter, y = .b.loc, xout = r, yleft = Inf)$y
+}
+
+## scale
+.getA.sc <- function(r){
+ approx(x = .radius.gitter, y = .A.sc, xout = r, yleft = 0.5)$y
+}
+.geta.sc <- function(r){
+ approx(x = .radius.gitter, y = .a.sc, xout = r, yleft = 0)$y
+}
+.getb.sc <- function(r){
+ approx(x = .radius.gitter, y = .b.sc, xout = r, yleft = Inf)$y
+}
+
+## location and scale
+.getA1.locsc <- function(r){
+ approx(x = .radius.gitter, y = .A1.locsc, xout = r, yleft = 1)$y
+}
+.getA2.locsc <- function(r){
+ approx(x = .radius.gitter, y = .A2.locsc, xout = r, yleft = 0.5)$y
+}
+.geta.locsc <- function(r){
+ approx(x = .radius.gitter, y = .a.locsc, xout = r, yleft = 0)$y
+}
+.getb.locsc <- function(r){
+ approx(x = .radius.gitter, y = .b.locsc, xout = r, yleft = Inf)$y
+}
+
Modified: pkg/RobLox/R/sysdata.rda
===================================================================
(Binary files differ)
Modified: pkg/RobLox/inst/scripts/LMinterpolation.R
===================================================================
--- pkg/RobLox/inst/scripts/LMinterpolation.R 2012-09-12 15:32:35 UTC (rev 518)
+++ pkg/RobLox/inst/scripts/LMinterpolation.R 2012-09-12 18:01:54 UTC (rev 519)
@@ -19,70 +19,25 @@
#locationScale <- sapply(radius, rlsOptIC.AL, computeIC = FALSE)
## location
-A.loc <- unlist(location[1,])
-b.loc <- unlist(location[3,])
-if(getRversion() < "2.16.0"){
- .getA.loc.old <- approxfun(radius, A.loc, yleft = 1)
- .getb.loc.old <- approxfun(radius, b.loc, yleft = Inf)
- .getA.loc.old <- approxfun(radius, A.loc, yleft = 1)
- .getb.loc.old <- approxfun(radius, b.loc, yleft = Inf)
-}else{
- .getA.loc.new <- approxfun(radius, A.loc, yleft = 1)
- .getb.loc.new <- approxfun(radius, b.loc, yleft = Inf)
- .getA.loc.new <- approxfun(radius, A.loc, yleft = 1)
- .getb.loc.new <- approxfun(radius, b.loc, yleft = Inf)
-}
+.A.loc <- unlist(location[1,])
+.b.loc <- unlist(location[3,])
## scale
-A.sc <- unlist(scale[1,])
-a.sc <- unlist(scale[2,])
-b.sc <- unlist(scale[3,])
-if(getRversion() < "2.16.0"){
- .getA.sc.old <- approxfun(radius, A.sc, yleft = 0.5)
- .geta.sc.old <- approxfun(radius, a.sc, yleft = 0)
- .getb.sc.old <- approxfun(radius, b.sc, yleft = Inf)
-}else{
- .getA.sc.new <- approxfun(radius, A.sc, yleft = 0.5)
- .geta.sc.new <- approxfun(radius, a.sc, yleft = 0)
- .getb.sc.new <- approxfun(radius, b.sc, yleft = Inf)
-}
+.A.sc <- unlist(scale[1,])
+.a.sc <- unlist(scale[2,])
+.b.sc <- unlist(scale[3,])
## location and scale
n <- length(radius)
-A1.locsc <- unlist(locationScale[1,])[seq(1, 4*n-3, by = 4)]
-A2.locsc <- unlist(locationScale[1,])[seq(4, 4*n, by = 4)]
-a.locsc <- unlist(locationScale[2,])[seq(2, 2*n, by = 2)]
-b.locsc <- unlist(locationScale[3,])
-if(getRversion() < "2.16.0"){
- .getA1.locsc.old <- approxfun(radius, A1.locsc, yleft = 1)
- .getA2.locsc.old <- approxfun(radius, A2.locsc, yleft = 0.5)
- .geta.locsc.old <- approxfun(radius, a.locsc, yleft = 0)
- .getb.locsc.old <- approxfun(radius, b.locsc, yleft = Inf)
-}else{
- .getA1.locsc.new <- approxfun(radius, A1.locsc, yleft = 1)
- .getA2.locsc.new <- approxfun(radius, A2.locsc, yleft = 0.5)
- .geta.locsc.new <- approxfun(radius, a.locsc, yleft = 0)
- .getb.locsc.new <- approxfun(radius, b.locsc, yleft = Inf)
-}
+.A1.locsc <- unlist(locationScale[1,])[seq(1, 4*n-3, by = 4)]
+.A2.locsc <- unlist(locationScale[1,])[seq(4, 4*n, by = 4)]
+.a.locsc <- unlist(locationScale[2,])[seq(2, 2*n, by = 2)]
+.b.locsc <- unlist(locationScale[3,])
-if(getRversion() < "2.16.0"){
- save(.getA.loc.old, .getb.loc.old, .getA.sc.old, .geta.sc.old, .getb.sc.old,
- .getA1.locsc.old, .getA2.locsc.old, .geta.locsc.old, .getb.locsc.old,
- file = "savedataOld.rda")
-}else{
- save(.getA.loc.new, .getb.loc.new, .getA.sc.new, .geta.sc.new, .getb.sc.new,
- .getA1.locsc.new, .getA2.locsc.new, .geta.locsc.new, .getb.locsc.new,
- file = "savedataNew.rda")
-}
+.radius.gitter <- radius
## Saving the results in sysdata.rda
#load("sysdata.rda")
-#load("savedataOld.rda")
-#load("savedataNew.rda")
-#save(.finiteSampleRadius.loc, .finiteSampleRadius.locsc, .finiteSampleRadius.sc,
-# .getA1.locsc.new, .getA1.locsc.old, .getA2.locsc.new, .getA2.locsc.old,
-# .getA.loc.new, .getA.loc.old, .geta.locsc.new, .geta.locsc.old,
-# .geta.sc.new, .getA.sc.new, .geta.sc.old, .getA.sc.old,
-# .getb.loc.new, .getb.loc.old, .getb.locsc.new, .getb.locsc.old,
-# .getb.sc.new, .getb.sc.old, file = "sysdata.rda")
-
+save(.radius.gitter, .finiteSampleRadius.loc, .finiteSampleRadius.locsc, .finiteSampleRadius.sc,
+ .A.loc, .b.loc, .A.sc, .a.sc, .b.sc, .A1.locsc, .A2.locsc, .a.locsc, .b.locsc,
+ file = "sysdata.rda")
Modified: pkg/RobLox/man/0RobLox-package.Rd
===================================================================
--- pkg/RobLox/man/0RobLox-package.Rd 2012-09-12 15:32:35 UTC (rev 518)
+++ pkg/RobLox/man/0RobLox-package.Rd 2012-09-12 18:01:54 UTC (rev 519)
@@ -12,15 +12,15 @@
\details{
\tabular{ll}{
Package: \tab RobLox \cr
-Version: \tab 0.8.1 \cr
-Date: \tab 2012-09-10 \cr
+Version: \tab 0.8.2 \cr
+Date: \tab 2012-09-12 \cr
Depends: \tab R(>= 2.7.0), stats, lattice, RColorBrewer, Biobase, distr, distrMod, RobAStBase\cr
Suggests: \tab MASS\cr
LazyLoad: \tab yes \cr
ByteCompile: \tab yes \cr
License: \tab LGPL-3 \cr
URL: \tab http://robast.r-forge.r-project.org/\cr
-SVNRevision: \tab 439 \cr
+SVNRevision: \tab 519 \cr
}
}
\author{Matthias Kohl \email{matthias.kohl at stamats.de}}
More information about the Robast-commits
mailing list