[Distr-commits] r322 - in pkg/distr: R inst/doc man
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Thu Oct 30 11:51:15 CET 2008
Author: stamats
Date: 2008-10-30 11:51:15 +0100 (Thu, 30 Oct 2008)
New Revision: 322
Modified:
pkg/distr/R/AllClasses.R
pkg/distr/R/DiscreteDistribution.R
pkg/distr/R/LatticeDistribution.R
pkg/distr/R/setIsRelations.R
pkg/distr/inst/doc/newDistributions.pdf
pkg/distr/man/DiscreteDistribution-class.Rd
pkg/distr/man/LatticeDistribution-class.Rd
Log:
some changes to the connections between LatticeDistribution and DiscreteDistribution resp. between AffLinLatticeDistribution and AffLinDiscreteDistribution. Now discrete models in package ROptEst work again ...
Modified: pkg/distr/R/AllClasses.R
===================================================================
--- pkg/distr/R/AllClasses.R 2008-10-30 05:19:16 UTC (rev 321)
+++ pkg/distr/R/AllClasses.R 2008-10-30 10:51:15 UTC (rev 322)
@@ -908,7 +908,7 @@
)
setClass("AffLinLatticeDistribution",
- contains = c("AffLinDiscreteDistribution", "LatticeDistribution")
+ contains = c("LatticeDistribution", "AffLinDiscreteDistribution")
)
Modified: pkg/distr/R/DiscreteDistribution.R
===================================================================
--- pkg/distr/R/DiscreteDistribution.R 2008-10-30 05:19:16 UTC (rev 321)
+++ pkg/distr/R/DiscreteDistribution.R 2008-10-30 10:51:15 UTC (rev 322)
@@ -194,6 +194,10 @@
setMethod("+", c("DiscreteDistribution","DiscreteDistribution"),
function(e1,e2){
+ e1 <- as(e1, "LatticeDistribution")
+ e2 <- as(e2, "LatticeDistribution")
+ if(is(e1, "LatticeDistribution") & is(e2, "LatticeDistribution"))
+ return(as(e1 + e2, "DiscreteDistribution"))
convolutedsupport <- rep(support(e1), each = length(support(e2))) +
support(e2)
Modified: pkg/distr/R/LatticeDistribution.R
===================================================================
--- pkg/distr/R/LatticeDistribution.R 2008-10-30 05:19:16 UTC (rev 321)
+++ pkg/distr/R/LatticeDistribution.R 2008-10-30 10:51:15 UTC (rev 322)
@@ -142,26 +142,28 @@
setMethod("lattice", "LatticeDistribution", function(object) object at lattice)
-setAs("LatticeDistribution", "DiscreteDistribution",
- def = function(from, to){
- cF <- class(from)
- value <- if (cF!="LatticeDistribution")
- new(cF) else new("DiscreteDistribution")
- for (what in slotNames("DiscreteDistribution"))
- slot(value, what) <- slot(from, what)
- supp.old <- from at support
- o.warn <- getOption("warn"); options(warn = -2)
- d.old <- from at d(from at support)
- options(warn = o.warn)
- supp.new <- supp.old[d.old > 0]
- value at support <- supp.new
- value
- }
-)
+## canceling out of lattice points with mass 0
+#setAs("LatticeDistribution", "DiscreteDistribution",
+# def = function(from){
+# cF <- class(from)[1]
+# value <- if (cF!="LatticeDistribution")
+# new(cF) else new("DiscreteDistribution")
+# for (what in slotNames("DiscreteDistribution"))
+# slot(value, what) <- slot(from, what)
+# supp.old <- from at support
+# o.warn <- getOption("warn"); options(warn = -2)
+# d.old <- from at d(from at support)
+# options(warn = o.warn)
+# supp.new <- supp.old[d.old > 0]
+# value at support <- supp.new
+# value
+# }
+#)
+
setAs("AffLinLatticeDistribution","AffLinDiscreteDistribution",
- def = function(from, to){
+ def = function(from){
value <- new("AffLinDiscreteDistribution")
for (what in slotNames("AffLinDiscreteDistribution"))
slot(value, what) <- slot(from, what)
@@ -179,9 +181,9 @@
function(e1,e2){
### Step 1
- e1 <- as(e1, "LatticeDistribution")
- e2 <- as(e2, "LatticeDistribution")
- ### casting necessary due to setIs
+# e1 <- as(e1, "LatticeDistribution")
+# e2 <- as(e2, "LatticeDistribution")
+# ### casting necessary due to setIs
### Lattice Calculations:
w1 <- width(lattice(e1))
Modified: pkg/distr/R/setIsRelations.R
===================================================================
--- pkg/distr/R/setIsRelations.R 2008-10-30 05:19:16 UTC (rev 321)
+++ pkg/distr/R/setIsRelations.R 2008-10-30 10:51:15 UTC (rev 322)
@@ -42,17 +42,28 @@
)
## if support is affine linear, a DiscreteDistribution is a LatticeDistribution
-setIs("DiscreteDistribution", "LatticeDistribution",
- test = function(object) .is.vector.lattice(support(object)),
- coerce = function(from)
- LatticeDistribution(DiscreteDistribution = from),
- replace = function(from,value)
- LatticeDistribution(
- r = value at r, d = value at d, q = value at q, p = value at p,
- support = value at support, img =value at img,
- .withSim = value at .withSim, .withArith = value at .withArith,
- lattice = value at lattice)
- )
+setAs("DiscreteDistribution", "LatticeDistribution",
+ function(from){
+ if(!.is.vector.lattice(from at support))
+ return(from)
+ else
+ return(new("LatticeDistribution", r = from at r, d = from at d,
+ q = from at q, p = from at p, support = from at support,
+ lattice = .make.lattice.es.vector(from at support),
+ .withArith = FALSE, .withSim = FALSE, img = from at img,
+ param = from at param))
+ })
+#setIs("DiscreteDistribution", "LatticeDistribution",
+# test = function(object) .is.vector.lattice(support(object)),
+# coerce = function(from)
+# LatticeDistribution(DiscreteDistribution = from),
+# replace = function(from,value)
+# LatticeDistribution(
+# r = value at r, d = value at d, q = value at q, p = value at p,
+# support = value at support, img =value at img,
+# .withSim = value at .withSim, .withArith = value at .withArith,
+# lattice = value at lattice)
+# )
#setAs("LatticeDistribution", "DiscreteDistribution",
Modified: pkg/distr/inst/doc/newDistributions.pdf
===================================================================
(Binary files differ)
Modified: pkg/distr/man/DiscreteDistribution-class.Rd
===================================================================
--- pkg/distr/man/DiscreteDistribution-class.Rd 2008-10-30 05:19:16 UTC (rev 321)
+++ pkg/distr/man/DiscreteDistribution-class.Rd 2008-10-30 10:51:15 UTC (rev 322)
@@ -4,6 +4,7 @@
\alias{AffLinDiscreteDistribution-class}
\alias{initialize,DiscreteDistribution-method}
\alias{initialize,AffLinDiscreteDistribution-method}
+\alias{coerce,DiscreteDistribution,LatticeDistribution-method}
\title{Class "DiscreteDistribution"}
\description{The \code{DiscreteDistribution}-class is the mother-class of the class \code{LatticeDistribution}.}
@@ -36,6 +37,9 @@
\section{Methods}{
\describe{
\item{initialize}{\code{signature(.Object = "DiscreteDistribution")}: initialize method }
+ \item{\code{coerce}}{\code{signature(from = "DiscreteDistribution",
+ to = "LatticeDistribution")}: coerces an object from \code{"DiscreteDistribution"}
+ to \code{"LatticeDistribution"} if support of \code{from} is a lattice.}
\item{Math}{\code{signature(x = "DiscreteDistribution")}: application of a mathematical function, e.g. \code{sin} or
\code{tan} to this discrete distribution}
\code{abs}{\code{signature(x = "DiscreteDistribution")}: exact image distribution of \code{abs(x)}.}
Modified: pkg/distr/man/LatticeDistribution-class.Rd
===================================================================
--- pkg/distr/man/LatticeDistribution-class.Rd 2008-10-30 05:19:16 UTC (rev 321)
+++ pkg/distr/man/LatticeDistribution-class.Rd 2008-10-30 10:51:15 UTC (rev 322)
@@ -7,7 +7,7 @@
\alias{lattice,LatticeDistribution-method}
\alias{initialize,LatticeDistribution-method}
\alias{initialize,AffLinLatticeDistribution-method}
-\alias{coerce,LatticeDistribution,DiscreteDistribution-method}
+%\alias{coerce,LatticeDistribution,DiscreteDistribution-method}
\alias{coerce,AffLinLatticeDistribution,AffLinDiscreteDistribution-method}
@@ -88,10 +88,10 @@
e2 = "LatticeDistribution")}: Convolution of two lattice
distributions. The slots p, d and q are approximated by grids.}
\item{\code{lattice}}{accessor method to the corresponding slot.}
- \item{\code{coerce}}{\code{signature(from = "LatticeDistribution",
- to = "DiscreteDistribution")}: coerces an object from
- \code{"LatticeDistribution"} to \code{"DiscreteDistribution"}
- thereby cancelling out support points with probability 0.}
+% \item{\code{coerce}}{\code{signature(from = "LatticeDistribution",
+% to = "DiscreteDistribution")}: coerces an object from
+% \code{"LatticeDistribution"} to \code{"DiscreteDistribution"}
+% thereby cancelling out support points with probability 0.}
}
}
More information about the Distr-commits
mailing list