[Robast-commits] r85 - in pkg: ROptEst/R ROptEst/chm RobAStBase RobAStBase/R RobAStBase/chm RobAStBase/man
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Sun Mar 30 23:40:33 CEST 2008
Author: ruckdeschel
Date: 2008-03-30 23:40:32 +0200 (Sun, 30 Mar 2008)
New Revision: 85
Added:
pkg/RobAStBase/R/comparePlot.R
pkg/RobAStBase/chm/comparePlot.html
pkg/RobAStBase/man/comparePlot.Rd
Modified:
pkg/ROptEst/R/getInfRobIC_asGRisk.R
pkg/ROptEst/chm/ROptEst.chm
pkg/RobAStBase/NAMESPACE
pkg/RobAStBase/R/AllGeneric.R
pkg/RobAStBase/chm/00Index.html
pkg/RobAStBase/chm/RobAStBase.chm
pkg/RobAStBase/chm/RobAStBase.hhp
pkg/RobAStBase/chm/RobAStBase.toc
Log:
new generic function comparePlot for comparison plots of ICS...
Modified: pkg/ROptEst/R/getInfRobIC_asGRisk.R
===================================================================
--- pkg/ROptEst/R/getInfRobIC_asGRisk.R 2008-03-30 15:10:25 UTC (rev 84)
+++ pkg/ROptEst/R/getInfRobIC_asGRisk.R 2008-03-30 21:40:32 UTC (rev 85)
@@ -136,7 +136,7 @@
if(is(normtype,"InfoNorm") || is(normtype,"SelfNorm") )
{QuadForm(normtype) <- PosSemDefSymmMatrix(FI);
normtype(risk) <- normtype}
- QF <- if(is(normtype,"QFNorm")) QuadForm(normtype) else diag(nrow(A.start))
+ QF <- if(is(normtype,"QFNorm")) QuadForm(normtype) else diag(nrow(trafo))
if(is.null(z.start)) z.start <- numeric(ncol(trafo))
if(is.null(A.start)) A.start <- trafo %*% solve(Finfo)
Modified: pkg/ROptEst/chm/ROptEst.chm
===================================================================
(Binary files differ)
Modified: pkg/RobAStBase/NAMESPACE
===================================================================
--- pkg/RobAStBase/NAMESPACE 2008-03-30 15:10:25 UTC (rev 84)
+++ pkg/RobAStBase/NAMESPACE 2008-03-30 21:40:32 UTC (rev 85)
@@ -47,6 +47,7 @@
"makeIC", "normtype", "biastype")
exportMethods("getRiskIC")
exportMethods("getBiasIC")
+exportMethods("comparePlot")
export("ContNeighborhood", "TotalVarNeighborhood")
export("FixRobModel", "InfRobModel")
export("InfluenceCurve", "IC", "ContIC", "TotalVarIC")
Modified: pkg/RobAStBase/R/AllGeneric.R
===================================================================
--- pkg/RobAStBase/R/AllGeneric.R 2008-03-30 15:10:25 UTC (rev 84)
+++ pkg/RobAStBase/R/AllGeneric.R 2008-03-30 21:40:32 UTC (rev 85)
@@ -166,3 +166,6 @@
setGeneric(".evalBiasIC",
function(IC, neighbor, biastype, ...) standardGeneric(".evalBiasIC"))
}
+if(!isGeneric("comparePlot")){
+ setGeneric("comparePlot", function(obj1,obj2,...) standardGeneric("comparePlot"))
+}
Added: pkg/RobAStBase/R/comparePlot.R
===================================================================
--- pkg/RobAStBase/R/comparePlot.R (rev 0)
+++ pkg/RobAStBase/R/comparePlot.R 2008-03-30 21:40:32 UTC (rev 85)
@@ -0,0 +1,92 @@
+setMethod("comparePlot", signature("IC","IC"),
+ function(obj1,obj2, obj3 = NULL, obj4 = NULL, ...){
+ L2Fam <- eval(obj1 at CallL2Fam)
+ L2Fam1c <- obj1 at CallL2Fam
+ L2Fam2c <- obj2 at CallL2Fam
+ if(!identical(L2Fam1c,L2Fam2c))
+ stop("ICs need to be defined for the same model")
+
+ e1 <- L2Fam at distribution
+ if(!is(e1, "UnivariateDistribution")) stop("not yet implemented")
+
+ if(is(e1, "AbscontDistribution")){
+ lower <- ifelse(is.finite(q(e1)(0)), q(e1)(0), q(e1)(getdistrOption("TruncQuantile")))
+ upper <- ifelse(is.finite(q(e1)(1)), q(e1)(1), q(e1)(1 - getdistrOption("TruncQuantile")))
+ h <- upper - lower
+ x.vec <- seq(from = lower - 0.1*h, to = upper + 0.1*h, length = 1000)
+ plty <- "l"
+ lty <- "solid"
+ }else{
+ if(is(e1, "DiscreteDistribution")){
+ x.vec <- support(e1)
+ plty <- "p"
+ lty <- "dotted"
+ }else{
+ x.vec <- r(e1)(1000)
+ x.vec <- sort(unique(x.vec))
+ plty <- "p"
+ lty <- "dotted"
+ }
+ }
+
+ dims <- nrow(L2Fam at param@trafo)
+ IC1 <- as(diag(dims) %*% obj1 at Curve, "EuclRandVariable")
+ IC2 <- as(diag(dims) %*% obj2 at Curve, "EuclRandVariable")
+
+ obj <- obj3
+ if(is(obj, "IC"))
+ {
+ if(!identical(L2Fam1c,obj at CallL2Fam))
+ stop("ICs need to be defined for the same model")
+ IC3 <- as(diag(dims) %*% obj3 at Curve, "EuclRandVariable")
+ }
+
+ obj <- obj4
+ if(is(obj, "IC"))
+ {
+ if(!identical(L2Fam1c,obj at CallL2Fam))
+ stop("ICs need to be defined for the same model")
+ IC4 <- as(diag(dims) %*% obj4 at Curve, "EuclRandVariable")
+ }
+
+ w0 <- options("warn")
+ options(warn = -1)
+ opar <- par()
+ nrows <- trunc(sqrt(dims))
+ ncols <- ceiling(dims/nrows)
+ par(mfrow = c(nrows, ncols))
+
+ if(is(e1, "DiscreteDistribution"))
+ x.vec1 <- seq(from = min(x.vec), to = max(x.vec), length = 1000)
+
+ for(i in 1:dims){
+ matp <- cbind(sapply(x.vec, IC1 at Map[[i]]),sapply(x.vec, IC2 at Map[[i]]))
+ if(is(obj3, "IC"))
+ matp <- cbind(matp,sapply(x.vec, IC3 at Map[[i]]))
+ if(is(obj4, "IC"))
+ matp <- cbind(matp,sapply(x.vec, IC4 at Map[[i]]))
+
+ matplot(x.vec, matp,
+ type = plty, lty = lty,
+ xlab = "x", ylab = "(partial) IC")
+ if(is(e1, "DiscreteDistribution")){
+ matp1 <- cbind(sapply(x.vec1, IC1 at Map[[i]]),sapply(x.vec1, IC2 at Map[[i]]))
+ if(is(obj3, "IC"))
+ matp1 <- cbind(matp1,sapply(x.vec1, IC3 at Map[[i]]))
+ if(is(obj4, "IC"))
+ matp1 <- cbind(matp1,sapply(x.vec1, IC4 at Map[[i]]))
+ matlines(x.vec1, matp1, lty = "dotted")
+ }
+
+ if(is.null(L2Fam at param@nuisance))
+ title(paste("Component", i, "of (partial) ICs\nfor", name(L2Fam)[1],
+ "\nwith main parameter (", paste(round(L2Fam at param@main, 3), collapse = ", "), ")"), cex.main = 0.8)
+ else
+ title(paste("Component", i, "of (partial) ICs\nfor", name(L2Fam)[1],
+ "\nwith main parameter (", paste(round(L2Fam at param@main, 3), collapse = ", "),
+ ")\nand nuisance parameter (", paste(round(L2Fam at param@nuisance, 3), collapse = ", "), ")"), cex.main = 0.8)
+ }
+ par(opar)
+ options(w0)
+ invisible()
+ })
Modified: pkg/RobAStBase/chm/00Index.html
===================================================================
--- pkg/RobAStBase/chm/00Index.html 2008-03-30 15:10:25 UTC (rev 84)
+++ pkg/RobAStBase/chm/00Index.html 2008-03-30 21:40:32 UTC (rev 85)
@@ -113,6 +113,12 @@
<td>Influence curve of total variation type</td></tr>
<tr><td width="25%"><a href="TotalVarIC-class.html">clipUp<-,TotalVarIC-method</a></td>
<td>Influence curve of total variation type</td></tr>
+<tr><td width="25%"><a href="comparePlot.html">comparePlot</a></td>
+<td>Compare - Plots</td></tr>
+<tr><td width="25%"><a href="comparePlot.html">comparePlot,IC,IC-method</a></td>
+<td>Compare - Plots</td></tr>
+<tr><td width="25%"><a href="comparePlot.html">comparePlot-methods</a></td>
+<td>Compare - Plots</td></tr>
<tr><td width="25%"><a href="ContIC.html">ContIC</a></td>
<td>Generating function for ContIC-class</td></tr>
<tr><td width="25%"><a href="ContIC-class.html">ContIC-class</a></td>
Modified: pkg/RobAStBase/chm/RobAStBase.chm
===================================================================
(Binary files differ)
Modified: pkg/RobAStBase/chm/RobAStBase.hhp
===================================================================
--- pkg/RobAStBase/chm/RobAStBase.hhp 2008-03-30 15:10:25 UTC (rev 84)
+++ pkg/RobAStBase/chm/RobAStBase.hhp 2008-03-30 21:40:32 UTC (rev 85)
@@ -38,6 +38,7 @@
TotalVarNeighborhood.html
UncondNeighborhood-class.html
checkIC.html
+comparePlot.html
evalIC.html
generateIC.html
generateICfct.html
Modified: pkg/RobAStBase/chm/RobAStBase.toc
===================================================================
--- pkg/RobAStBase/chm/RobAStBase.toc 2008-03-30 15:10:25 UTC (rev 84)
+++ pkg/RobAStBase/chm/RobAStBase.toc 2008-03-30 21:40:32 UTC (rev 85)
@@ -178,6 +178,18 @@
<param name="Local" value="TotalVarIC-class.html">
</OBJECT>
<LI> <OBJECT type="text/sitemap">
+<param name="Name" value="comparePlot">
+<param name="Local" value="comparePlot.html">
+</OBJECT>
+<LI> <OBJECT type="text/sitemap">
+<param name="Name" value="comparePlot,IC,IC-method">
+<param name="Local" value="comparePlot.html">
+</OBJECT>
+<LI> <OBJECT type="text/sitemap">
+<param name="Name" value="comparePlot-methods">
+<param name="Local" value="comparePlot.html">
+</OBJECT>
+<LI> <OBJECT type="text/sitemap">
<param name="Name" value="ContIC">
<param name="Local" value="ContIC.html">
</OBJECT>
@@ -739,6 +751,10 @@
</OBJECT>
<UL>
<LI> <OBJECT type="text/sitemap">
+<param name="Name" value="Compare - Plots">
+<param name="Local" value="comparePlot.html">
+</OBJECT>
+<LI> <OBJECT type="text/sitemap">
<param name="Name" value="Contamination Neighborhood">
<param name="Local" value="ContNeighborhood-class.html">
</OBJECT>
Added: pkg/RobAStBase/chm/comparePlot.html
===================================================================
--- pkg/RobAStBase/chm/comparePlot.html (rev 0)
+++ pkg/RobAStBase/chm/comparePlot.html 2008-03-30 21:40:32 UTC (rev 85)
@@ -0,0 +1,104 @@
+<html><head><title>Compare - Plots</title>
+<meta http-equiv="Content-Type" content="text/html; charset=iso-8859-1">
+<link rel="stylesheet" type="text/css" href="Rchm.css">
+</head>
+<body>
+
+<table width="100%"><tr><td>comparePlot-methods(RobAStBase)</td><td align="right">R Documentation</td></tr></table><object type="application/x-oleobject" classid="clsid:1e2a7bd0-dab9-11d0-b93a-00c04fc99f9e">
+<param name="keyword" value="R: comparePlot">
+<param name="keyword" value="R: comparePlot-methods">
+<param name="keyword" value="R: comparePlot,IC,IC-method">
+<param name="keyword" value=" Compare - Plots">
+</object>
+
+
+<h2>Compare - Plots</h2>
+
+
+<h3>Description</h3>
+
+<p>
+Plots 2-4 influence curves to the same model.
+</p>
+
+
+<h3>Usage</h3>
+
+<pre>
+comparePlot(obj1, obj2, ... )
+## S4 method for signature 'IC, IC':
+comparePlot(obj1, obj2, obj3 = NULL, obj4 = NULL, ... )
+</pre>
+
+
+<h3>Arguments</h3>
+
+<table summary="R argblock">
+<tr valign="top"><td><code>obj1</code></td>
+<td>
+object of class <code>"InfluenceCurve"</code> </td></tr>
+<tr valign="top"><td><code>obj2</code></td>
+<td>
+object of class <code>"InfluenceCurve"</code> to be compared with <code>obj1</code></td></tr>
+<tr valign="top"><td><code>obj3</code></td>
+<td>
+optional: object of class <code>"InfluenceCurve"</code> to be compared with <code>obj1</code></td></tr>
+<tr valign="top"><td><code>obj4</code></td>
+<td>
+optional: object of class <code>"InfluenceCurve"</code> to be compared with <code>obj1</code></td></tr>
+<tr valign="top"><td><code>...</code></td>
+<td>
+further arguments to be passed to <code>plot</code></td></tr>
+</table>
+
+<h3>Author(s)</h3>
+
+<p>
+Peter Ruckdeschel <a href="mailto:Peter.Ruckdeschel at uni-bayreuth.de">Peter.Ruckdeschel at uni-bayreuth.de</a>
+</p>
+
+
+<h3>References</h3>
+
+<p>
+Kohl, M. (2005) <EM>Numerical Contributions to the Asymptotic Theory of Robustness</EM>.
+Bayreuth: Dissertation.
+</p>
+
+
+<h3>See Also</h3>
+
+<p>
+<code><a onclick="findlink('distrMod', 'L2ParamFamily-class.html')" style="text-decoration: underline; color: blue; cursor: hand">L2ParamFamily-class</a></code>, <code><a href="IC-class.html">IC-class</a></code>, <code><a onclick="findlink('base', 'plot.html')" style="text-decoration: underline; color: blue; cursor: hand">plot</a></code>
+</p>
+
+
+<h3>Examples</h3>
+
+<pre>
+if(require(ROptEst)){
+
+N0 <- NormLocationScaleFamily(mean=0, sd=1)
+N0.Rob1 <- InfRobModel(center = N0, neighbor = ContNeighborhood(radius = 0.5))
+
+IC1 <- optIC(model = N0, risk = asCov())
+IC2 <- optIC(model = N0.Rob1, risk = asMSE())
+
+comparePlot(IC1,IC2)
+}
+</pre>
+
+<script Language="JScript">
+function findlink(pkg, fn) {
+var Y, link;
+Y = location.href.lastIndexOf("\\") + 1;
+link = location.href.substring(0, Y);
+link = link + "../../" + pkg + "/chtml/" + pkg + ".chm::/" + fn;
+location.href = link;
+}
+</script>
+
+
+<hr><div align="center">[Package <em>RobAStBase</em> version 0.1.0 <a href="00Index.html">Index]</a></div>
+
+</body></html>
Added: pkg/RobAStBase/man/comparePlot.Rd
===================================================================
--- pkg/RobAStBase/man/comparePlot.Rd (rev 0)
+++ pkg/RobAStBase/man/comparePlot.Rd 2008-03-30 21:40:32 UTC (rev 85)
@@ -0,0 +1,42 @@
+\name{comparePlot-methods}
+\docType{methods}
+\alias{comparePlot}
+\alias{comparePlot-methods}
+\alias{comparePlot,IC,IC-method}
+
+\title{Compare - Plots}
+\description{
+ Plots 2-4 influence curves to the same model.
+}
+\usage{
+comparePlot(obj1, obj2, ... )
+\S4method{comparePlot}{IC,IC}(obj1, obj2, obj3 = NULL, obj4 = NULL, ... )
+}
+\arguments{
+ \item{obj1}{ object of class \code{"InfluenceCurve"} }
+ \item{obj2}{ object of class \code{"InfluenceCurve"} to be compared with \code{obj1}}
+ \item{obj3}{ optional: object of class \code{"InfluenceCurve"} to be compared with \code{obj1}}
+ \item{obj4}{ optional: object of class \code{"InfluenceCurve"} to be compared with \code{obj1}}
+ \item{\dots}{further arguments to be passed to \code{plot}}
+}
+%\value{}
+\references{
+ Kohl, M. (2005) \emph{Numerical Contributions to the Asymptotic Theory of Robustness}.
+ Bayreuth: Dissertation.
+}
+\author{Peter Ruckdeschel \email{Peter.Ruckdeschel at uni-bayreuth.de}}
+%\note{}
+\seealso{\code{\link[distrMod]{L2ParamFamily-class}}, \code{\link{IC-class}}, \code{\link[base]{plot}}}
+\examples{
+if(require(ROptEst)){
+
+N0 <- NormLocationScaleFamily(mean=0, sd=1)
+N0.Rob1 <- InfRobModel(center = N0, neighbor = ContNeighborhood(radius = 0.5))
+
+IC1 <- optIC(model = N0, risk = asCov())
+IC2 <- optIC(model = N0.Rob1, risk = asMSE())
+
+comparePlot(IC1,IC2)
+}
+}
+\keyword{}
More information about the Robast-commits
mailing list