[Distr-commits] r445 - branches/distr-2.2/pkg/distr branches/distr-2.2/pkg/distr/R branches/distr-2.2/pkg/distr/chm branches/distr-2.2/pkg/distr/demo branches/distr-2.2/pkg/distrMod/demo pkg/distr pkg/distr/R pkg/distr/demo
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Thu Mar 26 15:07:29 CET 2009
Author: ruckdeschel
Date: 2009-03-26 15:07:29 +0100 (Thu, 26 Mar 2009)
New Revision: 445
Modified:
branches/distr-2.2/pkg/distr/NAMESPACE
branches/distr-2.2/pkg/distr/R/Distribution.R
branches/distr-2.2/pkg/distr/R/versionManagement.R
branches/distr-2.2/pkg/distr/chm/Distr.chm
branches/distr-2.2/pkg/distr/demo/ConvolutionNormalDistr.R
branches/distr-2.2/pkg/distrMod/demo/modelExp3.R
pkg/distr/NAMESPACE
pkg/distr/R/Distribution.R
pkg/distr/R/versionManagement.R
pkg/distr/demo/ConvolutionNormalDistr.R
Log:
distr:
+ enhanced conv2NewVersion --- did not work before as intended in cases where
there is a particular initialized method with less arguments...
+ correspondingly .lowerExact, .logExact methods now are exported (in branch also Symmetry)
+ .lowerExact, .logExact methods now issue a warning before coercing to new version and
return corresponding slot of converted object
+ corrected some small bug in demo ConvolutionNormalDistr.R
distrMod:
+ inserted Symmetry information in demo modelExp3.R
Modified: branches/distr-2.2/pkg/distr/NAMESPACE
===================================================================
--- branches/distr-2.2/pkg/distr/NAMESPACE 2009-03-25 19:10:00 UTC (rev 444)
+++ branches/distr-2.2/pkg/distr/NAMESPACE 2009-03-26 14:07:29 UTC (rev 445)
@@ -82,7 +82,7 @@
exportMethods("decomposePM", "simplifyD", "showobj")
exportMethods("Truncate","Minimum","Maximum","Huberize")
exportMethods("solve", "sqrt")
-exportMethods("type", "SymmCenter", "Symmetry")
+exportMethods("type", "SymmCenter", "Symmetry", ".logExact", ".lowerExact")
export("UnivarMixingDistribution", "UnivarLebDecDistribution")
export("RtoDPQ.LC", "flat.LCD", "flat.mix")
exportMethods("abs","exp","^")
Modified: branches/distr-2.2/pkg/distr/R/Distribution.R
===================================================================
--- branches/distr-2.2/pkg/distr/R/Distribution.R 2009-03-25 19:10:00 UTC (rev 444)
+++ branches/distr-2.2/pkg/distr/R/Distribution.R 2009-03-26 14:07:29 UTC (rev 445)
@@ -18,20 +18,38 @@
setMethod(".lowerExact", "Distribution", function(object){
er <- is(try(slot(object, ".lowerExact"), silent = TRUE), "try-error")
if(er){ object0 <- conv2NewVersion(object)
- eval.parent(substitute(object<-object0))
- return(invisible(NULL))}
+ objN <- paste(substitute(object))
+ warning(gettextf("'%s' was generated in an old version of this class.\n",
+ objN),
+ gettextf("'%s' has been converted to the new version",objN),
+ gettextf(" of this class by a call to 'conv2NewVersion'.\n")
+ )
+ eval.parent(substitute(object<-object0))
+ return(object0 at .lowerExact)}
object at .lowerExact})
setMethod(".logExact", "Distribution", function(object){
er <- is(try(slot(object, ".logExact"), silent = TRUE), "try-error")
if(er){ object0 <- conv2NewVersion(object)
+ objN <- paste(substitute(object))
+ warning(gettextf("'%s' was generated in an old version of this class.\n",
+ objN),
+ gettextf("'%s' has been converted to the new version",objN),
+ gettextf(" of this class by a call to 'conv2NewVersion'.\n")
+ )
eval.parent(substitute(object<-object0))
- return(invisible(NULL))}
+ return(object0 at .logExact)}
object at .logExact})
setMethod("Symmetry", "Distribution", function(object){
er <- is(try(slot(object, "Symmetry"), silent = TRUE), "try-error")
if(er){ object0 <- conv2NewVersion(object)
+ objN <- paste(substitute(object))
+ warning(gettextf("'%s' was generated in an old version of this class.\n",
+ objN),
+ gettextf("'%s' has been converted to the new version",objN),
+ gettextf(" of this class by a call to 'conv2NewVersion'.\n")
+ )
eval.parent(substitute(object<-object0))
- return(invisible(NULL))}
+ return(object0 at Symmetry)}
object at Symmetry})
Modified: branches/distr-2.2/pkg/distr/R/versionManagement.R
===================================================================
--- branches/distr-2.2/pkg/distr/R/versionManagement.R 2009-03-25 19:10:00 UTC (rev 444)
+++ branches/distr-2.2/pkg/distr/R/versionManagement.R 2009-03-26 14:07:29 UTC (rev 445)
@@ -32,10 +32,15 @@
slot(object,x) else slot(tryobject,x)
lst <- sapply(slotNames, function(x) getIfExists(x))
names(lst) <- slotNames
+ #
lst <- c(list(Class = class(object)), lst)
- myobj <- do.call("new", args = lst)
+ if(is(try (myobj <- do.call("new", args = lst), silent = TRUE), "try-error")){
+ myobj <- tryobject
+ for(i in 2:length(lst))
+ slot(myobj, name=names(lst)[i]) <- lst[[i]]
+ }
myobj
- })
+ })
setMethod("conv2NewVersion", "LatticeDistribution",
function(object) {
Modified: branches/distr-2.2/pkg/distr/chm/Distr.chm
===================================================================
(Binary files differ)
Modified: branches/distr-2.2/pkg/distr/demo/ConvolutionNormalDistr.R
===================================================================
--- branches/distr-2.2/pkg/distr/demo/ConvolutionNormalDistr.R 2009-03-25 19:10:00 UTC (rev 444)
+++ branches/distr-2.2/pkg/distr/demo/ConvolutionNormalDistr.R 2009-03-26 14:07:29 UTC (rev 445)
@@ -52,7 +52,7 @@
## quantile functions
x <- seq(from = eps, to = 1-eps, length = 1000)
-plot("topleft", type = "l", lwd = 5)
+plot(x, q(AB)(x), type = "l", lwd = 5)
lines(x , q(AB1)(x), col = "orange", lwd = 1)
title("Quantile functions")
legend(0, q(AB)(eps, lower.tail = FALSE),
Modified: branches/distr-2.2/pkg/distrMod/demo/modelExp3.R
===================================================================
--- branches/distr-2.2/pkg/distrMod/demo/modelExp3.R 2009-03-25 19:10:00 UTC (rev 444)
+++ branches/distr-2.2/pkg/distrMod/demo/modelExp3.R 2009-03-26 14:07:29 UTC (rev 445)
@@ -3,7 +3,7 @@
## generation of distribution with density ~ e^{-|x|^3
myD <- AbscontDistribution(d = function(x) exp(-abs(x)^3),
- withS = TRUE)
+ withS = TRUE, Symmetry=SphericalSymmetry(0))
## generating some data from this distribution
## in a location scale model
scl.true <- 2; loc.true <- 3
Modified: pkg/distr/NAMESPACE
===================================================================
--- pkg/distr/NAMESPACE 2009-03-25 19:10:00 UTC (rev 444)
+++ pkg/distr/NAMESPACE 2009-03-26 14:07:29 UTC (rev 445)
@@ -76,6 +76,7 @@
"p.ac", "d.ac", "q.ac", "r.ac")
exportMethods("decomposePM", "simplifyD", "showobj")
exportMethods("Truncate","Minimum","Maximum","Huberize")
+exportMethods(".logExact", ".lowerExact")
export("UnivarMixingDistribution", "UnivarLebDecDistribution")
export("RtoDPQ.LC", "flat.LCD", "flat.mix")
exportMethods("abs","exp","^")
Modified: pkg/distr/R/Distribution.R
===================================================================
--- pkg/distr/R/Distribution.R 2009-03-25 19:10:00 UTC (rev 444)
+++ pkg/distr/R/Distribution.R 2009-03-26 14:07:29 UTC (rev 445)
@@ -17,11 +17,27 @@
setMethod("p", "Distribution", function(object) object at p)
setMethod(".lowerExact", "Distribution", function(object){
er <- is(try(slot(object, ".lowerExact"), silent = TRUE), "try-error")
- if(er) object <- conv2NewVersion(object)
+ if(er){ object0 <- conv2NewVersion(object)
+ objN <- paste(substitute(object))
+ warning(gettextf("'%s' was generated in an old version of this class.\n",
+ objN),
+ gettextf("'%s' has been converted to the new version",objN),
+ gettextf(" of this class by a call to 'conv2NewVersion'.\n")
+ )
+ eval.parent(substitute(object<-object0))
+ return(object0 at .lowerExact)}
object at .lowerExact})
setMethod(".logExact", "Distribution", function(object){
er <- is(try(slot(object, ".logExact"), silent = TRUE), "try-error")
- if(er) object <- conv2NewVersion(object)
+ if(er){ object0 <- conv2NewVersion(object)
+ objN <- paste(substitute(object))
+ warning(gettextf("'%s' was generated in an old version of this class.\n",
+ objN),
+ gettextf("'%s' has been converted to the new version",objN),
+ gettextf(" of this class by a call to 'conv2NewVersion'.\n")
+ )
+ eval.parent(substitute(object<-object0))
+ return(object0 at .logExact)}
object at .logExact})
Modified: pkg/distr/R/versionManagement.R
===================================================================
--- pkg/distr/R/versionManagement.R 2009-03-25 19:10:00 UTC (rev 444)
+++ pkg/distr/R/versionManagement.R 2009-03-26 14:07:29 UTC (rev 445)
@@ -32,10 +32,15 @@
slot(object,x) else slot(tryobject,x)
lst <- sapply(slotNames, function(x) getIfExists(x))
names(lst) <- slotNames
+ #
lst <- c(list(Class = class(object)), lst)
- myobj <- do.call("new", args = lst)
+ if(is(try (myobj <- do.call("new", args = lst), silent = TRUE), "try-error")){
+ myobj <- tryobject
+ for(i in 2:length(lst))
+ slot(myobj, name=names(lst)[i]) <- lst[[i]]
+ }
myobj
- })
+ })
setMethod("conv2NewVersion", "LatticeDistribution",
function(object) {
Modified: pkg/distr/demo/ConvolutionNormalDistr.R
===================================================================
--- pkg/distr/demo/ConvolutionNormalDistr.R 2009-03-25 19:10:00 UTC (rev 444)
+++ pkg/distr/demo/ConvolutionNormalDistr.R 2009-03-26 14:07:29 UTC (rev 445)
@@ -52,7 +52,7 @@
## quantile functions
x <- seq(from = eps, to = 1-eps, length = 1000)
-plot("topleft", type = "l", lwd = 5)
+plot(x, q(AB)(x), type = "l", lwd = 5)
lines(x , q(AB1)(x), col = "orange", lwd = 1)
title("Quantile functions")
legend(0, q(AB)(eps, lower.tail = FALSE),
More information about the Distr-commits
mailing list