[Distr-commits] r493 - branches/distr-2.2/pkg/distrEllipse branches/distr-2.2/pkg/distrEllipse/R pkg pkg/SweaveListingUtils pkg/SweaveListingUtils/R pkg/SweaveListingUtils/chm pkg/distr pkg/distr/chm pkg/distr/inst/doc pkg/distrEllipse pkg/distrEllipse/R pkg/distrEllipse/chm pkg/distrEllipse/inst pkg/distrEllipse/man
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Tue Jun 30 16:26:54 CEST 2009
Author: ruckdeschel
Date: 2009-06-30 16:26:53 +0200 (Tue, 30 Jun 2009)
New Revision: 493
Added:
pkg/distrEllipse/
pkg/distrEllipse/DESCRIPTION
pkg/distrEllipse/NAMESPACE
pkg/distrEllipse/R/
pkg/distrEllipse/R/01.R
pkg/distrEllipse/R/AllClasses.R
pkg/distrEllipse/R/AllGenerics.R
pkg/distrEllipse/R/AllShow.R
pkg/distrEllipse/R/EllipticalDistribution.R
pkg/distrEllipse/R/MVMixingDistribution.R
pkg/distrEllipse/R/MVNorm.R
pkg/distrEllipse/R/MVt.R
pkg/distrEllipse/R/MultivariateDistrList.R
pkg/distrEllipse/R/SphericalDistribution.R
pkg/distrEllipse/R/distrEllipseOptions.R
pkg/distrEllipse/chm/
pkg/distrEllipse/chm/00Index.html
pkg/distrEllipse/chm/0distrEllipse-package.html
pkg/distrEllipse/chm/EllipticalDistribution-class.html
pkg/distrEllipse/chm/EllipticalDistribution.html
pkg/distrEllipse/chm/EllipticalParameter-class.html
pkg/distrEllipse/chm/MultivarDistrList-class.html
pkg/distrEllipse/chm/MultivarDistrList.html
pkg/distrEllipse/chm/MultivarMixingDistribution-class.html
pkg/distrEllipse/chm/MultivarMixingDistribution.html
pkg/distrEllipse/chm/MvnormDistribution-class.html
pkg/distrEllipse/chm/MvnormDistribution.html
pkg/distrEllipse/chm/MvnormParameter-class.html
pkg/distrEllipse/chm/MvtDistribution-class.html
pkg/distrEllipse/chm/MvtDistribution.html
pkg/distrEllipse/chm/MvtParameter-class.html
pkg/distrEllipse/chm/SphericalDistribution-class.html
pkg/distrEllipse/chm/SphericalDistribution.html
pkg/distrEllipse/chm/distrEllipse.chm
pkg/distrEllipse/chm/distrEllipse.hhp
pkg/distrEllipse/chm/distrEllipse.toc
pkg/distrEllipse/chm/distrEllipseMASK.html
pkg/distrEllipse/chm/distrEllipseoptions.html
pkg/distrEllipse/chm/logo.jpg
pkg/distrEllipse/chm/plot-methods.html
pkg/distrEllipse/inst/
pkg/distrEllipse/inst/CITATION
pkg/distrEllipse/inst/MASKING
pkg/distrEllipse/inst/NEWS
pkg/distrEllipse/man/
pkg/distrEllipse/man/0distrEllipse-package.Rd
pkg/distrEllipse/man/EllipticalDistribution-class.Rd
pkg/distrEllipse/man/EllipticalDistribution.Rd
pkg/distrEllipse/man/EllipticalParameter-class.Rd
pkg/distrEllipse/man/MultivarDistrList-class.Rd
pkg/distrEllipse/man/MultivarDistrList.Rd
pkg/distrEllipse/man/MultivarMixingDistribution-class.Rd
pkg/distrEllipse/man/MultivarMixingDistribution.Rd
pkg/distrEllipse/man/MvnormDistribution-class.Rd
pkg/distrEllipse/man/MvnormDistribution.Rd
pkg/distrEllipse/man/MvnormParameter-class.Rd
pkg/distrEllipse/man/MvtDistribution-class.Rd
pkg/distrEllipse/man/MvtDistribution.Rd
pkg/distrEllipse/man/MvtParameter-class.Rd
pkg/distrEllipse/man/SphericalDistribution-class.Rd
pkg/distrEllipse/man/SphericalDistribution.Rd
pkg/distrEllipse/man/distrEllipseMASK.Rd
pkg/distrEllipse/man/distrEllipseoptions.Rd
pkg/distrEllipse/man/plot-methods.Rd
Modified:
branches/distr-2.2/pkg/distrEllipse/DESCRIPTION
branches/distr-2.2/pkg/distrEllipse/R/EllipticalDistribution.R
pkg/SweaveListingUtils/DESCRIPTION
pkg/SweaveListingUtils/R/SweaveListingOptions.R
pkg/SweaveListingUtils/R/SweaveListingUtils.R
pkg/SweaveListingUtils/R/keywordsStyle.R
pkg/SweaveListingUtils/chm/00Index.html
pkg/SweaveListingUtils/chm/SweaveListingUtils.chm
pkg/distr/DESCRIPTION
pkg/distr/chm/00Index.html
pkg/distr/chm/Distr.chm
pkg/distr/inst/doc/Rplots.pdf
Log:
merged branch 2.2 parts of SweaveListingUtils and distrEllipse into trunk
Modified: branches/distr-2.2/pkg/distrEllipse/DESCRIPTION
===================================================================
--- branches/distr-2.2/pkg/distrEllipse/DESCRIPTION 2009-06-30 12:30:57 UTC (rev 492)
+++ branches/distr-2.2/pkg/distrEllipse/DESCRIPTION 2009-06-30 14:26:53 UTC (rev 493)
@@ -1,6 +1,6 @@
Package: distrEllipse
-Version: 0.1
-Date: 2009-03-26
+Version: 0.2
+Date: 2009-06-30
Title: S4 classes for elliptically contoured distributions
Depends: R(>= 2.8.0), methods, graphics, mvtnorm, setRNG(>= 2006.2-1), distr(>= 2.2), distrEx(>= 2.2), distrSim(>= 2.2), startupmsg
Suggests: distrMod(>= 2.2), distrTEst(>= 2.2)
Modified: branches/distr-2.2/pkg/distrEllipse/R/EllipticalDistribution.R
===================================================================
--- branches/distr-2.2/pkg/distrEllipse/R/EllipticalDistribution.R 2009-06-30 12:30:57 UTC (rev 492)
+++ branches/distr-2.2/pkg/distrEllipse/R/EllipticalDistribution.R 2009-06-30 14:26:53 UTC (rev 493)
@@ -3,7 +3,6 @@
EllipticalDistribution <- function(radDistr = sqrt(Chisq(df = length(loc))),
loc = c(0,0), scale = diag(length(loc)), p = NULL, q = NULL){
-# class(scale) <- "matrix"
ldscale <- as.numeric(determinant(as.matrix(scale),
logarithm = TRUE)$modulus)
Iscale <- solve(scale)
Modified: pkg/SweaveListingUtils/DESCRIPTION
===================================================================
--- pkg/SweaveListingUtils/DESCRIPTION 2009-06-30 12:30:57 UTC (rev 492)
+++ pkg/SweaveListingUtils/DESCRIPTION 2009-06-30 14:26:53 UTC (rev 493)
@@ -1,6 +1,6 @@
Package: SweaveListingUtils
Title: Utilities for Sweave together with TeX listings package
-Version: 0.2
+Version: 0.2.3
Depends: R(>= 2.0.0), startupmsg
Imports: stats
LazyLoad: yes
@@ -12,6 +12,6 @@
vignette and documented source code
Maintainer: Peter Ruckdeschel <Peter.Ruckdeschel at itwm.fraunhofer.de>
License: LGPL-3
-Date: 2009-04-14
+Date: 2009-06-30
LastChangedDate: {$LastChangedDate$}
LastChangedRevision: {$LastChangedRevision$}
Modified: pkg/SweaveListingUtils/R/SweaveListingOptions.R
===================================================================
--- pkg/SweaveListingUtils/R/SweaveListingOptions.R 2009-06-30 12:30:57 UTC (rev 492)
+++ pkg/SweaveListingUtils/R/SweaveListingOptions.R 2009-06-30 14:26:53 UTC (rev 493)
@@ -9,7 +9,11 @@
"language" = "R", "basicstyle" = "{\\color{Rcolor}\\small}",
"keywordstyle" = "{\\bf\\color{Rcolor}}",
"commentstyle" = "{\\color{Rcomment}\\ttfamily\\itshape}",
- "literate" = "{<-}{{$\\leftarrow$}}2{<<-}{{$\\twoheadleftarrow$}}2",
+ "literate" = paste("{<-}{{$\\leftarrow$}}2",
+ "{<<-}{{$\\twoheadleftarrow$}}2",#"%\n",
+ "{~}{{$\\sim$}}1", "{<=}{{$\\leq$}}2",#"%\n",
+ "{>=}{{$\\geq$}}2", "{^}{{$\\scriptstyle\\wedge$}}1", sep=""),
+ ## ~,^,<=, >= as suggested by Frank Harrell
"alsoother" = "{$}", "alsoletter" = "{.<-}",
"otherkeywords" = "{!,!=,~,$,*,\\&,\\%/\\%,\\%*\\%,\\%\\%,<-,<<-,/}"
),
Modified: pkg/SweaveListingUtils/R/SweaveListingUtils.R
===================================================================
--- pkg/SweaveListingUtils/R/SweaveListingUtils.R 2009-06-30 12:30:57 UTC (rev 492)
+++ pkg/SweaveListingUtils/R/SweaveListingUtils.R 2009-06-30 14:26:53 UTC (rev 493)
@@ -193,6 +193,7 @@
cat(line)
lstsetLanguage()
cat(line,"%\n%\n",sep="")
+cat("\n")
return(invisible())
}
Modified: pkg/SweaveListingUtils/R/keywordsStyle.R
===================================================================
--- pkg/SweaveListingUtils/R/keywordsStyle.R 2009-06-30 12:30:57 UTC (rev 492)
+++ pkg/SweaveListingUtils/R/keywordsStyle.R 2009-06-30 14:26:53 UTC (rev 493)
@@ -81,7 +81,8 @@
# print(lP); print(pkgs); print(posIdx); print(search())
if(lP) {for(i in 1: lP){
kwl <- ls(pos = which(pkgs[i] == gsub("package:","",search())))
- kwl <- kwl[grep("^[[:alpha:]]+\\w*",kwl,perl=TRUE)]
+ kwl <- sort(kwl[grep("^[[:alpha:]]+\\w*",kwl,perl=TRUE)],
+ decreasing = TRUE)
genKWL(pkg = pkgs[i], kwd = kwl,
kws = keywordstyles[i])}
}
Modified: pkg/SweaveListingUtils/chm/00Index.html
===================================================================
--- pkg/SweaveListingUtils/chm/00Index.html 2009-06-30 12:30:57 UTC (rev 492)
+++ pkg/SweaveListingUtils/chm/00Index.html 2009-06-30 14:26:53 UTC (rev 493)
@@ -10,7 +10,7 @@
<param name="keyword" value=".. contents">
</object>
-<h2>Help pages for package ‘SweaveListingUtils’ version 0.2</h2>
+<h2>Help pages for package ‘SweaveListingUtils’ version 0.2.3</h2>
<table width="100%">
<tr><td width="25%"><a href="0SweaveListingUtils-package.html">SweaveListingUtils-package</a></td>
Modified: pkg/SweaveListingUtils/chm/SweaveListingUtils.chm
===================================================================
(Binary files differ)
Modified: pkg/distr/DESCRIPTION
===================================================================
--- pkg/distr/DESCRIPTION 2009-06-30 12:30:57 UTC (rev 492)
+++ pkg/distr/DESCRIPTION 2009-06-30 14:26:53 UTC (rev 493)
@@ -1,6 +1,6 @@
Package: distr
-Version: 2.1.1
-Date: 2009-06-16
+Version: 2.1.2
+Date: 2009-06-30
Title: Object orientated implementation of distributions
Description: Object orientated implementation of distributions
Author: Florian Camphausen, Matthias Kohl, Peter Ruckdeschel, Thomas Stabla
Modified: pkg/distr/chm/00Index.html
===================================================================
--- pkg/distr/chm/00Index.html 2009-06-30 12:30:57 UTC (rev 492)
+++ pkg/distr/chm/00Index.html 2009-06-30 14:26:53 UTC (rev 493)
@@ -10,7 +10,7 @@
<param name="keyword" value=".. contents">
</object>
-<h2>Help pages for package ‘distr’ version 2.1.1</h2>
+<h2>Help pages for package ‘distr’ version 2.1.2</h2>
<p align="center">
<a href="# "> </a>
Modified: pkg/distr/chm/Distr.chm
===================================================================
(Binary files differ)
Modified: pkg/distr/inst/doc/Rplots.pdf
===================================================================
--- pkg/distr/inst/doc/Rplots.pdf 2009-06-30 12:30:57 UTC (rev 492)
+++ pkg/distr/inst/doc/Rplots.pdf 2009-06-30 14:26:53 UTC (rev 493)
@@ -2,8 +2,8 @@
%âãÏÓ\r
1 0 obj
<<
-/CreationDate (D:20090617034919)
-/ModDate (D:20090617034919)
+/CreationDate (D:20090630152709)
+/ModDate (D:20090630152709)
/Title (R Graphics Output)
/Producer (R 2.10.0)
/Creator (R)
@@ -47,7 +47,7 @@
38.97 172.78 m 148.04 172.78 l S
38.97 227.22 m 148.04 227.22 l S
38.97 281.66 m 148.04 281.66 l S
-38.97 336.10 m 148.04 336.10 l S
+38.97 336.09 m 148.04 336.09 l S
38.97 390.53 m 148.04 390.53 l S
38.97 444.97 m 148.04 444.97 l S
0.000 0.000 0.000 RG
@@ -275,7 +275,7 @@
65.15 74.45 l
65.25 74.75 l
65.35 75.05 l
-65.45 75.36 l
+65.45 75.37 l
65.55 75.68 l
65.65 76.01 l
65.75 76.34 l
@@ -315,7 +315,7 @@
69.19 93.26 l
69.29 93.95 l
69.39 94.66 l
-69.49 95.38 l
+69.49 95.37 l
69.59 96.11 l
69.70 96.85 l
69.80 97.61 l
@@ -352,16 +352,16 @@
72.93 128.67 l
73.03 129.93 l
73.13 131.22 l
-73.23 132.51 l
+73.23 132.52 l
73.34 133.83 l
73.44 135.17 l
73.54 136.52 l
73.64 137.89 l
73.74 139.28 l
73.84 140.68 l
-73.94 142.11 l
+73.94 142.10 l
74.04 143.55 l
-74.14 145.00 l
+74.14 145.01 l
74.25 146.48 l
74.35 147.98 l
74.45 149.49 l
@@ -375,14 +375,14 @@
75.26 162.23 l
75.36 163.91 l
75.46 165.60 l
-75.56 167.30 l
+75.56 167.31 l
75.66 169.03 l
75.76 170.77 l
75.86 172.53 l
75.96 174.31 l
76.06 176.10 l
76.17 177.92 l
-76.27 179.75 l
+76.27 179.74 l
76.37 181.59 l
76.47 183.45 l
76.57 185.33 l
@@ -390,7 +390,7 @@
76.77 189.14 l
76.87 191.06 l
76.97 193.01 l
-77.08 194.96 l
+77.08 194.97 l
77.18 196.94 l
77.28 198.93 l
77.38 200.93 l
@@ -407,7 +407,7 @@
78.49 223.93 l
78.59 226.10 l
78.69 228.28 l
-78.79 230.47 l
+78.79 230.48 l
78.90 232.68 l
79.00 234.90 l
79.10 237.12 l
@@ -423,8 +423,8 @@
80.11 259.92 l
80.21 262.24 l
80.31 264.57 l
-80.41 266.90 l
-80.51 269.24 l
+80.41 266.91 l
+80.51 269.25 l
80.61 271.59 l
80.72 273.94 l
80.82 276.30 l
@@ -437,7 +437,7 @@
81.52 292.87 l
81.63 295.25 l
81.73 297.62 l
-81.83 300.00 l
+81.83 299.99 l
81.93 302.37 l
82.03 304.74 l
82.13 307.11 l
@@ -445,7 +445,7 @@
82.33 311.84 l
82.43 314.20 l
82.54 316.56 l
-82.64 318.92 l
+82.64 318.91 l
82.74 321.26 l
82.84 323.61 l
82.94 325.95 l
@@ -470,10 +470,10 @@
84.86 368.52 l
84.96 370.62 l
85.06 372.71 l
-85.16 374.79 l
+85.16 374.78 l
85.26 376.84 l
85.37 378.87 l
-85.47 380.88 l
+85.47 380.89 l
85.57 382.88 l
85.67 384.85 l
85.77 386.81 l
@@ -493,7 +493,7 @@
87.19 411.66 l
87.29 413.24 l
87.39 414.79 l
-87.49 416.31 l
+87.49 416.32 l
87.59 417.81 l
87.69 419.27 l
87.79 420.70 l
@@ -579,7 +579,7 @@
95.88 419.32 l
95.98 417.88 l
96.08 416.41 l
-96.18 414.91 l
+96.18 414.92 l
96.28 413.39 l
96.39 411.84 l
96.49 410.26 l
@@ -606,7 +606,7 @@
98.61 371.75 l
98.71 369.70 l
98.81 367.63 l
-98.91 365.56 l
+98.91 365.55 l
99.01 363.46 l
99.11 361.36 l
99.22 359.24 l
@@ -632,11 +632,11 @@
101.24 314.79 l
101.34 312.50 l
101.44 310.22 l
-101.54 307.92 l
+101.54 307.93 l
101.64 305.63 l
101.74 303.34 l
101.84 301.05 l
-101.95 298.76 l
+101.95 298.75 l
102.05 296.46 l
102.15 294.17 l
102.25 291.88 l
@@ -661,31 +661,31 @@
104.17 249.11 l
104.27 246.93 l
104.37 244.75 l
-104.47 242.59 l
+104.47 242.58 l
104.57 240.43 l
104.68 238.28 l
-104.78 236.15 l
+104.78 236.14 l
104.88 234.02 l
104.98 231.90 l
105.08 229.80 l
105.18 227.71 l
-105.28 225.63 l
-105.38 223.55 l
+105.28 225.62 l
+105.38 223.56 l
105.48 221.50 l
105.59 219.45 l
105.69 217.42 l
105.79 215.40 l
105.89 213.39 l
105.99 211.40 l
-106.09 209.42 l
+106.09 209.41 l
106.19 207.45 l
106.29 205.49 l
106.39 203.55 l
106.49 201.63 l
106.60 199.72 l
106.70 197.82 l
-106.80 195.94 l
-106.90 194.06 l
+106.80 195.93 l
+106.90 194.07 l
107.00 192.21 l
107.10 190.37 l
107.20 188.55 l
@@ -703,7 +703,7 @@
108.42 167.88 l
108.52 166.26 l
108.62 164.65 l
-108.72 163.07 l
+108.72 163.06 l
108.82 161.49 l
108.92 159.94 l
109.02 158.40 l
@@ -716,15 +716,15 @@
109.73 148.09 l
109.83 146.68 l
109.93 145.29 l
-110.03 143.91 l
-110.13 142.56 l
+110.03 143.92 l
+110.13 142.55 l
110.24 141.21 l
110.34 139.89 l
110.44 138.58 l
110.54 137.28 l
110.64 136.00 l
110.74 134.74 l
-110.84 133.49 l
+110.84 133.50 l
110.94 132.26 l
111.04 131.05 l
111.15 129.85 l
@@ -733,8 +733,8 @@
111.45 126.35 l
111.55 125.21 l
111.65 124.09 l
-111.75 122.99 l
-111.85 121.89 l
+111.75 122.98 l
+111.85 121.90 l
111.95 120.82 l
112.06 119.76 l
112.16 118.71 l
@@ -761,7 +761,7 @@
114.28 100.03 l
114.38 99.29 l
114.48 98.55 l
-114.58 97.83 l
+114.58 97.84 l
114.68 97.13 l
114.78 96.43 l
114.89 95.75 l
@@ -1093,7 +1093,7 @@
38.97 172.78 m 34.21 172.78 l S
38.97 227.22 m 34.21 227.22 l S
38.97 281.66 m 34.21 281.66 l S
-38.97 336.10 m 34.21 336.10 l S
+38.97 336.09 m 34.21 336.09 l S
38.97 390.53 m 34.21 390.53 l S
38.97 444.97 m 34.21 444.97 l S
BT
Added: pkg/distrEllipse/DESCRIPTION
===================================================================
--- pkg/distrEllipse/DESCRIPTION (rev 0)
+++ pkg/distrEllipse/DESCRIPTION 2009-06-30 14:26:53 UTC (rev 493)
@@ -0,0 +1,14 @@
+Package: distrEllipse
+Version: 0.1
+Date: 2009-06-30
+Title: S4 classes for elliptically contoured distributions
+Depends: R(>= 2.8.0), methods, graphics, mvtnorm, setRNG(>= 2006.2-1), distr(>= 2.2), distrEx(>= 2.2), distrSim(>= 2.2), startupmsg
+Suggests: distrMod(>= 2.2), distrTEst(>= 2.2)
+Author: Peter Ruckdeschel
+Description: Distribution (S4-)classes for elliptically contoured distributions (based on package distr)
+Maintainer: Peter Ruckdeschel <Peter.Ruckdeschel at itwm.fraunhofer.de>
+LazyLoad: yes
+License: LGPL-3
+URL: http://distr.r-forge.r-project.org/
+LastChangedDate: {$LastChangedDate: 2009-03-31 15:31:30 +0200 (Di, 31 Mrz 2009) $}
+LastChangedRevision: {$LastChangedRevision: 447 $}
Added: pkg/distrEllipse/NAMESPACE
===================================================================
--- pkg/distrEllipse/NAMESPACE (rev 0)
+++ pkg/distrEllipse/NAMESPACE 2009-06-30 14:26:53 UTC (rev 493)
@@ -0,0 +1,25 @@
+import("methods")
+importFrom("stats", "simulate")
+importFrom("setRNG", "setRNG")
+import("mvtnorm")
+import("distr")
+import("distrEx")
+import("distrSim")
+import("startupmsg")
+
+export("SphericalDistribution", "EllipticalDistribution",
+ "MVNorm", "MVt", "MultivarDistrList",
+ "MultivarMixingDistribution",
+ "distrEllipseoptions", "getdistrEllipseOption",
+ "distrEllipseMASK")
+exportClasses("EllipticalParameter",
+ "MVNormParameter", "MVtParameter",
+ "SphericalDistribution", "EllipticalDistribution",
+ "MVNormDistribution", "MVtDistribution", "MVDistrList",
+ "MultivarDistrList","MultivarMixingDistribution")
+exportMethods("dimension", "radDistr", "scale", "location", "dim",
+ "radDistr<-", "scale<-", "location<-",
+ "plot.rd", "r.rd", "d.rd", "p.rd", "q.rd",
+ "E", "var", "mean", "sigma","mixCoeff", "mixDistr")
+exportMethods("plot", "show", "showobj", "Symmetry")
+exportMethods("+", "*", "%*%")
Added: pkg/distrEllipse/R/01.R
===================================================================
--- pkg/distrEllipse/R/01.R (rev 0)
+++ pkg/distrEllipse/R/01.R 2009-06-30 14:26:53 UTC (rev 493)
@@ -0,0 +1,37 @@
+.onLoad <- function(lib, pkg){
+ require("methods", character = TRUE, quietly = TRUE)
+ require("distrEx")
+ require("distrSim")
+ require(setRNG)
+}
+
+
+.distrEllipseoptions <- list(
+ Nsim = 2000,
+ withED = TRUE,
+ lwd.Ed = 2,
+ col.Ed = c(3,4),
+ withMean = TRUE,
+ cex.mean = 2,
+ pch.mean = 20,
+ col.mean = 2
+ )
+
+
+.onAttach <- function(library, pkg)
+{
+ unlockBinding(".distrEllipseoptions", asNamespace("distrEllipse"))
+ msga <- gettext(
+ "Some functions from package 'stats' are intentionally masked ---see distrEllipseMASK().\n"
+ )
+ buildStartupMessage(pkg="distrEllipse", msga, packageHelp=TRUE, library=library,
+ # MANUAL="http://www.uni-bayreuth.de/departments/math/org/mathe7/DISTR/distr.pdf",
+ VIGNETTE = gettext("Package \"distrDoc\" provides a vignette to this package as well as to several related packages; try vignette(\"distr\")."))
+###
+ invisible()
+}
+
+distrEllipseMASK <- function(library = NULL)
+{
+ infoShow(pkg = "distrEllipse", filename="MASKING", library = library)
+}
Added: pkg/distrEllipse/R/AllClasses.R
===================================================================
--- pkg/distrEllipse/R/AllClasses.R (rev 0)
+++ pkg/distrEllipse/R/AllClasses.R 2009-06-30 14:26:53 UTC (rev 493)
@@ -0,0 +1,163 @@
+################################################################################
+#
+# Parameter Classes
+#
+################################################################################
+
+
+################################################################################
+# parameter of Elliptical distribution
+################################################################################
+
+setClass("EllipticalParameter", representation(loc = "numeric",
+ scale = "matrix"),
+ prototype(name =
+ gettext("parameter of an elliptically symmetric distribution"),
+ loc=c(0,0), scale = diag(2)),
+ contains = "Parameter",
+ validity = function(object){
+ dim0 <- length(object at loc)
+ if(!nrow(object at scale)==dim0) stop("wrong dimensions")
+ else return(TRUE)
+ })
+
+################################################################################
+# parameter of MV norm distribution
+################################################################################
+setClass("MVNormParameter",
+ contains = "EllipticalParameter")
+
+################################################################################
+# parameter of MV norm distribution
+################################################################################
+setClass("MVtParameter",
+ representation(df = "numeric", ncp = "numeric"),
+ prototype(name = gettext("parameter of multivariate t distribution"),
+ ncp = 0, df = 1),
+ contains = "EllipticalParameter",
+ validity = function(object){
+ dim0 <- length(object at loc)
+ if(!distr:::.isNatural(object at df)) stop("'df' must be an integer")
+ if(!length(object at ncp)==1) stop("wrong dimension for ncp")
+ if(!nrow(object at scale)==dim0) stop("wrong dimensions")
+ else return(TRUE)
+ })
+
+################################################################################
+#
+# Distribution Classes
+#
+################################################################################
+
+
+################################################################################
+# spherically symmetric distributions
+################################################################################
+setClass("SphericalDistribution",
+ representation = representation(radDistr="UnivariateDistribution",
+ Symmetry = "EllipticalSymmetry"),
+ prototype = prototype(r = function(n) matrix(rnorm(2*n),ncol=2),
+ d = function(x, log = FALSE){
+ r2 <- sum(x^2)
+ lg <- -p/2*log(2*pi)-r2/2;
+ return(if(log) lg else exp(lg))},
+ radDistr = sqrt(Chisq(df=2)),
+ Symmetry = SphericalSymmetry(0)),
+ contains = "MultivariateDistribution")
+
+################################################################################
+# elliptically symmetric distributions
+################################################################################
+
+setClass("EllipticalDistribution",
+ prototype = prototype(param = new("EllipticalParameter")),
+ contains = "SphericalDistribution")
+
+################################################################################
+# Multivariate Normal
+################################################################################
+setClass("MVNormDistribution",
+ prototype = prototype(
+ r = function(n){rmvnorm(n, mean = c(0,0), sigma = diag(2))},
+ d = function(x, log = FALSE){dmvnorm(x, mean = c(0,0), sigma = diag(2), log = log)},
+ p = function(lower=-Inf, upper=Inf){
+ pmvnorm(lower=lower, upper=upper, mean = c(0,0), sigma = diag(2))},
+ q = function(p, interval = c(-10, 10), tail = c("lower.tail",
+ "upper.tail", "both.tails")){
+ qmvnorm(p = p, interval = interval, tail = tail,
+ mean = c(0,0), sigma = diag(2))},
+ param = new("MVNormParameter",
+ name = gettext("parameter of multivariate normal distribution"))),
+ contains = "EllipticalDistribution")
+
+################################################################################
+# Multivariate T
+################################################################################
+
+setClass("MVtDistribution",
+ prototype = prototype(
+ r = function(n){rmvt(n)},
+ d = function(x, log = FALSE){dmvt(x, delta=0, sigma = diag(2), log = log)},
+ p = function(lower=-Inf, upper=Inf){
+ pmvt(lower=lower, upper=upper, delta=0, df=1, sigma = diag(2))},
+ q = function(p, interval = c(-10, 10), tail = c("lower.tail",
+ "upper.tail", "both.tails")){
+ qmvt(p = p, interval = interval, tail = tail, df = 1, delta = 0,
+ sigma = diag(2))},
+ param = new("MVtParameter")),
+ contains = "EllipticalDistribution")
+
+################################
+##
+## Distribution List classes
+##
+################################
+
+setClass("MVDistrList",
+ prototype = prototype(list(new("MVNormDistribution"))),
+ contains = "DistrList",
+ validity = function(object){
+ nrvalues <- length(object)
+ dim0 <- object[[1]]@img at dimension
+ # if (dim0 == 1) return(getValidity(getClass("UnivarDistrList"))(object))
+ for(i in 1:nrvalues){
+ if(!is(object[[i]], "MultivariateDistribution"))
+ stop("Element ", i, " is no 'MultivariateDistribution'")
+ if(!object[[i]]@img at dimension==dim0)
+ stop("Dimension mismatch in element ", i, ".")
+ }
+ return(TRUE)
+ })
+
+setClassUnion("MultivarDistrList", c("MVDistrList","UnivarDistrList"))
+
+################################
+##
+## Mixing Distribution classes
+##
+################################
+
+setClass("MultivarMixingDistribution",
+ representation = representation(mixCoeff = "numeric",
+ mixDistr = "MultivarDistrList",
+ Symmetry = "DistributionSymmetry",
+ .withArith = "logical",
+ .withSim = "logical",
+ .logExact = "logical",
+ .lowerExact = "logical"
+ ),
+ prototype = prototype(mixCoeff = 1,
+ mixDistr = new("MVDistrList"),
+ Symmetry = new("NoSymmetry"),
+ .withArith = FALSE,
+ .withSim = FALSE,
+ .logExact = TRUE,
+ .lowerExact = TRUE
+ ),
+ contains = "MultivariateDistribution",
+ validity = function(object){
+ if(any(object at mixCoeff< -.Machine$double.eps) ||
+ sum(object at mixCoeff)>1+.Machine$double.eps)
+ stop("mixing coefficients are no probabilities")
+ return(TRUE)
+ })
Added: pkg/distrEllipse/R/AllGenerics.R
===================================================================
--- pkg/distrEllipse/R/AllGenerics.R (rev 0)
+++ pkg/distrEllipse/R/AllGenerics.R 2009-06-30 14:26:53 UTC (rev 493)
@@ -0,0 +1,26 @@
+
+## Access methods
+if(!isGeneric("radDistr"))
+setGeneric("radDistr", function(object) standardGeneric("radDistr"))
+
+if(!isGeneric("sigma"))
+ setGeneric("sigma", function(object) standardGeneric("sigma"))
+
+
+# Replacement methods
+if(!isGeneric("radDistr<-"))
+ setGeneric("radDistr<-", function(object,value) standardGeneric("radDistr<-"))
+
+## wrappers
+if(!isGeneric("r.rd"))
+ setGeneric("r.rd", function(object) standardGeneric("r.rd"))
+if(!isGeneric("d.rd"))
+ setGeneric("d.rd", function(object) standardGeneric("d.rd"))
+if(!isGeneric("p.rd"))
+ setGeneric("p.rd", function(object) standardGeneric("p.rd"))
+if(!isGeneric("q.rd"))
+ setGeneric("q.rd", function(object) standardGeneric("q.rd"))
+if(!isGeneric("plot.rd"))
+ setGeneric("plot.rd", function(x, ...) standardGeneric("plot.rd"))
+
+
Added: pkg/distrEllipse/R/AllShow.R
===================================================================
--- pkg/distrEllipse/R/AllShow.R (rev 0)
+++ pkg/distrEllipse/R/AllShow.R 2009-06-30 14:26:53 UTC (rev 493)
@@ -0,0 +1,42 @@
+setMethod("showobj", "SphericalDistribution",
+ function(object, className = class(object)[1]){
+ txt <- gettextf("Distribution Object of Class: %s\n", className)
+ parameter = param(object)
+ Names = slotNames(parameter)
+ if(length(Names) > 1){
+ for(i in Names[Names != "name"]){
+ if(is.matrix(slot(parameter, i))){
+ txt <- c(txt, gettextf("%s:\n", i))
+ txt <- c(txt, " ")
+ for(k in 1:ncol(slot(parameter, i)))
+ txt <- c(txt, gettextf("[,%0d] ", k))
+ txt <- c(txt,"\n")
+ for(j in 1:nrow(slot(parameter, i))){
+ txt <- c(txt, gettextf("[%0d,] ", j))
+ for(k in 1:ncol(slot(parameter, i)))
+ txt <- c(txt, gettextf("% 2.2f, ",
+ slot(parameter, i)[j,k]))
+ txt <- c(txt, "\n")
+ }
+ }else{ txt0 <- if(length(slot(parameter,i))>1)
+ paste("(",paste(slot(parameter, i),
+ collapse=","), ")",sep="")
+ else
+ paste(slot(parameter, i))
+ txt <- c(txt,
+ gettextf("%s: %s\n", i, txt0))
+ }}}
+ txt <- c(txt, "\n Distribution of Lengths:\n",
+ showobj(radDistr(object)))
+ return(txt)
+ })
+
+setMethod("show", "SphericalDistribution",
+ function(object){
+ cls <- class(object)[1]
+ cat(showobj(object, className = cls))
+ ws <- distr:::.IssueWarn(object at .withArith, object at .withSim)
+ if(!is.null(ws$msgA)) warning(ws$msgA)
+ if(!is.null(ws$msgS)) warning(ws$msgS)
+ }
+ )
Added: pkg/distrEllipse/R/EllipticalDistribution.R
===================================================================
--- pkg/distrEllipse/R/EllipticalDistribution.R (rev 0)
+++ pkg/distrEllipse/R/EllipticalDistribution.R 2009-06-30 14:26:53 UTC (rev 493)
@@ -0,0 +1,158 @@
+## Generating function
+
+EllipticalDistribution <- function(radDistr = sqrt(Chisq(df = length(loc))),
+ loc = c(0,0), scale = diag(length(loc)), p = NULL, q = NULL){
+
+ ldscale <- as.numeric(determinant(as.matrix(scale),
+ logarithm = TRUE)$modulus)
+ Iscale <- solve(scale)
+
+ dim0 <- length(loc)
+
+ param <- new("EllipticalParameter", loc=loc, scale=scale)
+
+ if(!is(radDistr,"UnivariateDistribution"))
+ stop("must be a univariate Distribution")
+ if(p.l(radDistr)(0)>0)
+ stop("distr must have pos. support")
+
+ dr <- d(radDistr)
+ dlog <- if(distr:::.inArgs("log", dr))
+ quote(dr(r, log = TRUE)) else quote(log(dr(r)))
+
+ if(is(radDistr,"AbscontDistribution")){
+ dfun <- function(x, log = FALSE){}
+ body(dfun) <- substitute({
+ x0 <- x-loc0
+ x1 <- Iscale0 %*% x0
+ r <- colSums(x0*x1)^.5
+ lg <- dlog0
+ lg <- lg + (1-dim1)*log(r) + lgamma(dim1/2) -
+ dim1/2*log(pi)-log(2)- ldscale0/2
+ return(if(log) lg else exp(lg))},
+ list(loc0 = loc, Iscale0 = Iscale, ldscale0 = ldscale,
+ dlog0 = dlog, dim1=dim0))
+ }else dfun <- NULL
+
+ rfun <- function(n){}
+ body(rfun) <- substitute({
+ r0 <- r(radDistr)(n)
+ u0 <- matrix(rnorm(n*dim1),ncol=dim1)
+ u0n <- rowSums(u0^2)^.5
+ un <- t(u0/u0n*r0)
+ scale0 %*% un + loc0
+ }, list(scale0=scale, loc0 = loc, dim1 = dim0))
+
+ img0 <- new("EuclideanSpace", dimension = round(dim0,0))
+
+ new("EllipticalDistribution",
+ r=rfun, d=dfun, p=p, q=q,
+ radDistr = radDistr,
+ img = img0, param = param,
+ .withSim = radDistr at .withSim,
+ .withArith = radDistr at .withArith,
+ .logExact = radDistr at .logExact,
+ .lowerExact = radDistr at .lowerExact,
+ Symmetry = EllipticalSymmetry(loc))
+ }
+
+## Parameter for Elliptically symmetric Distribution
+# accessors
+
+setMethod("scale", "EllipticalParameter",
+ function(x, center, scale) x at scale)
+setMethod("location", "EllipticalParameter",
+ function(object) object at loc)
+
+# replacements
+setReplaceMethod("scale", "EllipticalParameter",
+ function(object, value){ new("EllipticalParameter",
+ loc = object at loc,
+ scale = as.matrix(value))})
+setReplaceMethod("location", "EllipticalParameter",
+ function(object, value) new("EllipticalParameter", loc = value,
+ scale = object at scale))
+
+## Elliptically symmetric Distribution
+# accessors
+setMethod("scale", "EllipticalDistribution",
+ function(x, center, scale) (x at param)@scale)
+setMethod("location", "EllipticalDistribution",
+ function(object) (object at param)@loc)
+# replacements
+setReplaceMethod("scale", "EllipticalDistribution",
+ function(object, value){ param <- new("EllipticalParameter",
+ loc = object at param@loc,
+ scale= as.matrix(value))
+ object at param <- param; object})
+setReplaceMethod("location", "EllipticalDistribution",
+ function(object, value){ param <- new("EllipticalParameter",
+ loc = value,
+ scale = object at param@scale)
+ object at param <- param; object})
+
+
+setAs("UnivariateDistribution", "EllipticalDistribution",
+ function(from){
+ if(!is(Symmetry(from),"SphericalSymmetry"))
+ return(from)
+ else{ sc <- SymmCenter(Symmetry(from))
+ radDistr <- abs(from-sc)
+ ell <- EllipticalDistribution (radDistr = radDistr,
+ loc = sc, scale = 1, p = from at p, q = from at q)
+ ell at r <- from at r
+ ell at d <- from at d
+ ell at .withArith <- from at .withArith
+ ell at .lowerExact <- from at .lowerExact
+ ell at .logExact <- from at .logExact
+ return(ell)}
+})
+
+
+
+setAs("EllipticalDistribution", "UnivariateDistribution",
+ function(from){
+ if(dimension(from)>1) return(from)
+ radD <- radDistr(from)
+ sca <- scale(from)
+ loc <- location(from)
+ if(!is(radD,"AcDcLcDistribution")){
+ rfun <- function(n) sca * r(radD)(n) *
+ sample(c(-1,1),n,replace=TRUE) + loc
+ D <- new("UnivariateDistribution", r = rfun)
+ }
+ else{
+ D <- radD * DiscreteDistribution(sca*c(-1,1)) + loc
+ }
+ D at Symmetry <- SphericalSymmetry(loc)
+ return(D)
+ })
+
+## functionals:
+setMethod("E", signature(object = "EllipticalDistribution",
+ fun = "missing", cond = "missing"),
+ function(object,...) location(object))
+setMethod("var", signature(x = "EllipticalDistribution"),
+ function(x,...) scale(x)%*%t(scale(x)) *
+ E(radDistr(x),fun=function(y)y^2,...)/dimension(x)
+ )
+
+setMethod("+", c("EllipticalDistribution","numeric"),
+ function(e1,e2){ if(dimension(e1)!=length(e2))
+ stop("Dimension mismatch of operands in '+'")
+ location(e1) <- location(e1)+e2
+ return(e1)})
+setMethod("*", c("EllipticalDistribution","numeric"),
+ function(e1,e2){ if((length(e2)!=1)&&length(e2)!=dimension(e1))
+ warning("Dimension mismatch of operands in '*'; using trimming/recycling rules.")
+ e2 <- rep(e2, length.out= dimension(e1))
+ e2 <- if(length(e2)==1) matrix(e2) else diag(e2)
+ scale(e1) <- e2 %*% scale(e1)
+ return(e1)})
+
+setMethod("%*%", signature(x="matrix",y="EllipticalDistribution"),
+ function(x,y){ if(ncol(x)!=dimension(y))
+ stop("Dimension mismatch of operands in '%*%'.")
+ scale(y) <- x %*% scale(y)
+ return(y)})
+
Added: pkg/distrEllipse/R/MVMixingDistribution.R
===================================================================
--- pkg/distrEllipse/R/MVMixingDistribution.R (rev 0)
+++ pkg/distrEllipse/R/MVMixingDistribution.R 2009-06-30 14:26:53 UTC (rev 493)
@@ -0,0 +1,215 @@
+.isEqual <- distr:::.isEqual
+
+MultivarMixingDistribution <- function(..., Dlist, mixCoeff #,
+# withSimplify = getdistrOption("simplifyD")
+ )
+ {
+ ldots <- list(...)
+ if(!missing(Dlist)){
+ Dlist.L <- as(Dlist, "list")
+ if(!is(try(do.call(MultivarDistrList,args=Dlist.L),silent=TRUE),"try-error"))
+ ldots <- c(ldots, Dlist.L)
+ }
+ l <- length(ldots)
+ print(ldots)
+ print(ldots[[2]])
[TRUNCATED]
To get the complete diff run:
svnlook diff /svnroot/distr -r 493
More information about the Distr-commits
mailing list