[Robast-commits] r115 - in branches/robast-0.6/pkg/RobAStBase: R man
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Wed Jul 23 15:01:37 CEST 2008
Author: stamats
Date: 2008-07-23 15:01:37 +0200 (Wed, 23 Jul 2008)
New Revision: 115
Modified:
branches/robast-0.6/pkg/RobAStBase/R/AllClass.R
branches/robast-0.6/pkg/RobAStBase/R/ContIC.R
branches/robast-0.6/pkg/RobAStBase/R/TotalVarIC.R
branches/robast-0.6/pkg/RobAStBase/R/Weights.R
branches/robast-0.6/pkg/RobAStBase/man/BdStWeight-class.Rd
branches/robast-0.6/pkg/RobAStBase/man/BoundedWeight-class.Rd
branches/robast-0.6/pkg/RobAStBase/man/HampelWeight-class.Rd
Log:
adapted to new implementation
Added warnings in Rd-files for replacement methods, as replacement may lead to inconsistent objects.
Modified: branches/robast-0.6/pkg/RobAStBase/R/AllClass.R
===================================================================
--- branches/robast-0.6/pkg/RobAStBase/R/AllClass.R 2008-07-23 07:17:23 UTC (rev 114)
+++ branches/robast-0.6/pkg/RobAStBase/R/AllClass.R 2008-07-23 13:01:37 UTC (rev 115)
@@ -53,7 +53,7 @@
# Weights
setClass("RobAStControl", representation(name ="character"),
contains = "VIRTUAL")
-
+
setClass("RobWeight", representation(name = "character", weight = "function"),
prototype(name = "some weight", weight = function(x) 1))
setClass("BoundedWeight", representation(clip = "numeric"),
Modified: branches/robast-0.6/pkg/RobAStBase/R/ContIC.R
===================================================================
--- branches/robast-0.6/pkg/RobAStBase/R/ContIC.R 2008-07-23 07:17:23 UTC (rev 114)
+++ branches/robast-0.6/pkg/RobAStBase/R/ContIC.R 2008-07-23 13:01:37 UTC (rev 115)
@@ -100,8 +100,14 @@
function(object, value){
stopifnot(is.numeric(value))
L2Fam <- eval(object at CallL2Fam)
+ w <- object at weight
+ clip(w) <- value
+ weight(w) <- getweight(w, neighbor = ContNeighborhood(radius = object at neighborRadius),
+ biastype = object at biastype,
+ normW = object at normtype)
res <- list(A = object at stand, a = object at cent, b = value, d = object at lowerCase,
- risk = object at Risks, info = object at Infos)
+ risk = object at Risks, info = object at Infos, w = w,
+ normtype = object at normtype, biastype = object at biastype)
object <- generateIC(neighbor = ContNeighborhood(radius = object at neighborRadius),
L2Fam = L2Fam, res = res)
addInfo(object) <- c("clip<-", "The clipping bound has been changed")
@@ -112,8 +118,14 @@
function(object, value){
stopifnot(is.numeric(value))
L2Fam <- eval(object at CallL2Fam)
+ w <- object at weight
+ cent(w) <- value
+ weight(w) <- getweight(w, neighbor = ContNeighborhood(radius = object at neighborRadius),
+ biastype = object at biastype,
+ normW = object at normtype)
res <- list(A = object at stand, a = value, b = object at clip, d = object at lowerCase,
- risk = object at Risks, info = object at Infos)
+ risk = object at Risks, info = object at Infos, w = w,
+ normtype = object at normtype, biastype = object at biastype)
object <- generateIC(neighbor = ContNeighborhood(radius = object at neighborRadius),
L2Fam = L2Fam, res = res)
addInfo(object) <- c("cent<-", "The centering constant has been changed")
@@ -124,8 +136,14 @@
function(object, value){
stopifnot(is.matrix(value))
L2Fam <- eval(object at CallL2Fam)
+ w <- object at weight
+ stand(w) <- value
+ weight(w) <- getweight(w, neighbor = ContNeighborhood(radius = object at neighborRadius),
+ biastype = object at biastype,
+ normW = object at normtype)
res <- list(A = value, a = object at cent, b = object at clip, d = object at lowerCase,
- risk = object at Risks, info = object at Infos)
+ risk = object at Risks, info = object at Infos, w = w,
+ normtype = object at normtype, biastype = object at biastype)
object <- generateIC(neighbor = ContNeighborhood(radius = object at neighborRadius),
L2Fam = L2Fam, res = res)
addInfo(object) <- c("stand<-", "The standardizing matrix has been changed")
@@ -137,7 +155,8 @@
stopifnot(is.null(value)||is.numeric(value))
L2Fam <- eval(object at CallL2Fam)
res <- list(A = object at stand, a = object at cent, b = object at clip, d = value,
- risk = object at Risks, info = object at Infos)
+ risk = object at Risks, info = object at Infos, w = object at weight,
+ normtype = object at normtype, biastype = object at biastype)
object <- generateIC(neighbor = ContNeighborhood(radius = object at neighborRadius),
L2Fam = L2Fam, res = res)
addInfo(object) <- c("lowerCase<-", "The slot 'lowerCase' has been changed")
@@ -148,7 +167,8 @@
function(object, value){
L2Fam <- eval(value)
res <- list(A = object at stand, a = object at cent, b = object at clip, d = object at lowerCase,
- risk = object at Risks, info = object at Infos)
+ risk = object at Risks, info = object at Infos, w = object at weight,
+ normtype = object at normtype, biastype = object at biastype)
object <- generateIC(neighbor = ContNeighborhood(radius = object at neighborRadius),
L2Fam = L2Fam, res = res)
addInfo(object) <- c("CallL2Fam<-", "The slot 'CallL2Fam' has been changed")
Modified: branches/robast-0.6/pkg/RobAStBase/R/TotalVarIC.R
===================================================================
--- branches/robast-0.6/pkg/RobAStBase/R/TotalVarIC.R 2008-07-23 07:17:23 UTC (rev 114)
+++ branches/robast-0.6/pkg/RobAStBase/R/TotalVarIC.R 2008-07-23 13:01:37 UTC (rev 115)
@@ -90,8 +90,14 @@
function(object, value){
stopifnot(is.numeric(value))
L2Fam <- eval(object at CallL2Fam)
+ w <- object at weight
+ clip(w)[1] <- value
+ weight(w) <- getweight(w, neighbor = TotalVarNeighborhood(radius = object at neighborRadius),
+ biastype = object at biastype,
+ normW = object at normtype)
res <- list(A = object at stand, a = value, b = object at clipUp-value,
- d = object at lowerCase, risk = object at Risks, info = object at Infos)
+ d = object at lowerCase, risk = object at Risks, info = object at Infos,
+ w = w, normtype = object at normtype, biastype = object at biastype)
object <- generateIC(neighbor = TotalVarNeighborhood(radius = object at neighborRadius),
L2Fam = L2Fam, res = res)
addInfo(object) <- c("clipLo<-", "The lower clipping bound has been changed")
@@ -102,8 +108,14 @@
function(object, value){
stopifnot(is.numeric(value))
L2Fam <- eval(object at CallL2Fam)
+ w <- object at weight
+ clip(w)[2] <- value
+ weight(w) <- getweight(w, neighbor = TotalVarNeighborhood(radius = object at neighborRadius),
+ biastype = object at biastype,
+ normW = object at normtype)
res <- list(A = object at stand, a = object at clipLo, b = value-object at clipLo,
- d = object at lowerCase, risk = object at Risks, info = object at Infos)
+ d = object at lowerCase, risk = object at Risks, info = object at Infos,
+ w = w, normtype = object at normtype, biastype = object at biastype)
object <- generateIC(neighbor = TotalVarNeighborhood(radius = object at neighborRadius),
L2Fam = L2Fam, res = res)
addInfo(object) <- c("clipUp<-", "The upper clipping bound has been changed")
@@ -114,8 +126,14 @@
function(object, value){
stopifnot(is.matrix(value))
L2Fam <- eval(object at CallL2Fam)
+ w <- object at weight
+ stand(w) <- value
+ weight(w) <- getweight(w, neighbor = TotalVarNeighborhood(radius = object at neighborRadius),
+ biastype = object at biastype,
+ normW = object at normtype)
res <- list(A = value, a = object at clipLo, b = object at clipUp-object@clipLo,
- d = object at lowerCase, risk = object at Risks, info = object at Infos)
+ d = object at lowerCase, risk = object at Risks, info = object at Infos,
+ w = w, normtype = object at normtype, biastype = object at biastype)
object <- generateIC(neighbor = TotalVarNeighborhood(radius = object at neighborRadius),
L2Fam = L2Fam, res = res)
addInfo(object) <- c("stand<-", "The standardizing matrix has been changed")
@@ -127,7 +145,8 @@
stopifnot(is.null(value)||is.numeric(value))
L2Fam <- eval(object at CallL2Fam)
res <- list(A = object at stand, a = object at clipLo, b = object at clipUp-object@clipLo,
- d = value, risk = object at Risks, info = object at Infos)
+ d = value, risk = object at Risks, info = object at Infos,
+ w = object at weight, normtype = object at normtype, biastype = object at biastype)
object <- generateIC(neighbor = TotalVarNeighborhood(radius = object at neighborRadius),
L2Fam = L2Fam, res = res)
addInfo(object) <- c("lowerCase<-", "The slot 'lowerCase' has been changed")
@@ -138,7 +157,8 @@
function(object, value){
L2Fam <- eval(value)
res <- list(A = object at stand, a = object at clipLo, b = object at clipUp-object@clipLo,
- d = object at lowerCase, risk = object at Risks, info = object at Infos)
+ d = object at lowerCase, risk = object at Risks, info = object at Infos,
+ w = object at weight, normtype = object at normtype, biastype = object at biastype)
object <- generateIC(neighbor = TotalVarNeighborhood(radius = object at neighborRadius),
L2Fam = L2Fam, res = res)
addInfo(object) <- c("CallL2Fam<-", "The slot 'CallL2Fam' has been changed")
Modified: branches/robast-0.6/pkg/RobAStBase/R/Weights.R
===================================================================
--- branches/robast-0.6/pkg/RobAStBase/R/Weights.R 2008-07-23 07:17:23 UTC (rev 114)
+++ branches/robast-0.6/pkg/RobAStBase/R/Weights.R 2008-07-23 13:01:37 UTC (rev 115)
@@ -116,7 +116,7 @@
function(x){
y <- A%*%(x-z)
norm0 <- fct(normW)(y)
- ind <- 1-.eq(norm0)
+ ind <- 1-.eq(norm0)
ind*b/(norm0+1-ind)
}
}
@@ -136,7 +136,7 @@
y <- A*(x-z)
indp <- (y>0)
ind0 <- .eq(y)
- indm <- (y<0)
+ indm <- (y<0)
indm*b1/(y+ind0) + indp*b2/(y+ind0)
}
}
@@ -171,7 +171,7 @@
y <- A*x
indp <- (y>0)
ind0 <- .eq(y)
- indm <- (y<0)
+ indm <- (y<0)
indm*b1/(y+ind0) + indp*b2/(y+ind0)
}
}
Modified: branches/robast-0.6/pkg/RobAStBase/man/BdStWeight-class.Rd
===================================================================
--- branches/robast-0.6/pkg/RobAStBase/man/BdStWeight-class.Rd 2008-07-23 07:17:23 UTC (rev 114)
+++ branches/robast-0.6/pkg/RobAStBase/man/BdStWeight-class.Rd 2008-07-23 13:01:37 UTC (rev 115)
@@ -29,8 +29,10 @@
accessor function for slot \code{stand}. }
\item{stand<-}{\code{signature(object = "BdStWeight", value = "matrix")}:
- replacement function for slot \code{stand}. }
-
+ replacement function for slot \code{stand}. This replacement method
+ should be used with great care, as the slot \code{weight} is not
+ simultaneously updated and hence, this may lead to inconsistent
+ objects.}
}
}
\references{
Modified: branches/robast-0.6/pkg/RobAStBase/man/BoundedWeight-class.Rd
===================================================================
--- branches/robast-0.6/pkg/RobAStBase/man/BoundedWeight-class.Rd 2008-07-23 07:17:23 UTC (rev 114)
+++ branches/robast-0.6/pkg/RobAStBase/man/BoundedWeight-class.Rd 2008-07-23 13:01:37 UTC (rev 115)
@@ -25,8 +25,10 @@
accessor function for slot \code{clip}. }
\item{clip<-}{\code{signature(object = "BoundedWeight", value = "numeric")}:
- replacement function for slot \code{clip}. }
-
+ replacement function for slot \code{clip}. This replacement method
+ should be used with great care, as the slot \code{weight} is not
+ simultaneously updated and hence, this may lead to inconsistent
+ objects. }
}
}
\references{
Modified: branches/robast-0.6/pkg/RobAStBase/man/HampelWeight-class.Rd
===================================================================
--- branches/robast-0.6/pkg/RobAStBase/man/HampelWeight-class.Rd 2008-07-23 07:17:23 UTC (rev 114)
+++ branches/robast-0.6/pkg/RobAStBase/man/HampelWeight-class.Rd 2008-07-23 13:01:37 UTC (rev 115)
@@ -31,8 +31,10 @@
accessor function for slot \code{cent}. }
\item{cent<-}{\code{signature(object = "HampelWeight", value = "matrix")}:
- replacement function for slot \code{cent}. }
-
+ replacement function for slot \code{cent}. This replacement method
+ should be used with great care, as the slot \code{weight} is not
+ simultaneously updated and hence, this may lead to inconsistent
+ objects. }
}
}
\references{
More information about the Robast-commits
mailing list