[Desire-commits] r11 - in packages/loglognorm: . R man src
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Mon May 19 10:18:52 CEST 2008
Author: olafm
Date: 2008-05-19 10:18:52 +0200 (Mon, 19 May 2008)
New Revision: 11
Modified:
packages/loglognorm/DESCRIPTION
packages/loglognorm/R/loglognorm.R
packages/loglognorm/man/dloglognorm.Rd
packages/loglognorm/src/loglognorm.c
Log:
* Add eloglognorm()
* Add vloglognorm()
* Add reference to Holland paper
* Bump version number
Modified: packages/loglognorm/DESCRIPTION
===================================================================
--- packages/loglognorm/DESCRIPTION 2008-05-14 22:55:57 UTC (rev 10)
+++ packages/loglognorm/DESCRIPTION 2008-05-19 08:18:52 UTC (rev 11)
@@ -1,12 +1,12 @@
Package: loglognorm
-Version: 0.9.0
-Date: 2008-05-10
+Version: 0.9.2
+Date: 2008-05-19
Title: Double log normal distribution functions
Author:
Heike Trautmann <trautmann at statistik.uni-dortmund.de>
and Detlef Steuer <detlef.steuer at hsu-hamburg.de>
and Olaf Mersmann <olafm at statistik.uni-dortmund.de>
-Maintainer: desiRe developers <desire-developers at lists.r-forge.r-project.org>
+Maintainer: Olaf Mersmann <olafm at statistik.uni-dortmund.de>
Depends: R (>= 2.7.0)
Description:
License: GPLv2
Modified: packages/loglognorm/R/loglognorm.R
===================================================================
--- packages/loglognorm/R/loglognorm.R 2008-05-14 22:55:57 UTC (rev 10)
+++ packages/loglognorm/R/loglognorm.R 2008-05-19 08:18:52 UTC (rev 11)
@@ -20,6 +20,15 @@
rloglognorm <- function(n, mean=0, sd=1)
.External("qloglognorm", runif(n), mean=mean, sd=sd, PACKAGE="loglognorm")
-eloglognorm <- function(mean=0, sd=1)
- .External("eloglognorm", mean, sd, PACKAGE="loglognorm")
+mloglognorm <- function(mean, sd, moment)
+ .External("mloglognorm", mean, sd, moment, PACKAGE="loglognorm")
+eloglognorm <- function(mean, sd)
+ .External("mloglognorm", mean, sd, rep(1, length(mean)), PACKAGE="loglognorm")
+
+vloglognorm <- function(mean, sd) {
+ m1 <- mloglognorm(mean, sd, rep(1, length(mean)))
+ m2 <- mloglognorm(mean, sd, rep(2, length(mean)))
+ return (m2 - m1^2)
+}
+
Modified: packages/loglognorm/man/dloglognorm.Rd
===================================================================
--- packages/loglognorm/man/dloglognorm.Rd 2008-05-14 22:55:57 UTC (rev 10)
+++ packages/loglognorm/man/dloglognorm.Rd 2008-05-19 08:18:52 UTC (rev 11)
@@ -15,7 +15,9 @@
ploglognorm(q, mean = 0, sd = 1)
qloglognorm(p, mean = 0, sd = 1)
rloglognorm(n, mean = 0, sd = 1)
-eloglognorm(mean = 0, sd = 1)
+mloglognorm(mean, sd, moment)
+eloglognorm(mean, sd)
+vloglognorm(mean, sd)
}
\arguments{
\item{x,q}{vector of quantiles.}
@@ -23,6 +25,7 @@
\item{n}{number of observations.}
\item{mean}{vector of means.}
\item{sd}{vector of standard deviations.}
+ \item{moment}{vector of moments}
}
\details{
If 'mean' or 'sd' are not specified they assume the default values of
@@ -31,10 +34,14 @@
\value{
'dloglognorm' gives the density, 'ploglognorm' gives the distribution
function, 'qloglognorm' gives the quantile function, 'rloglognorm'
- generates random deviates and 'eloglognorm' gives the expected value
- of the distirbution.
+ generates random deviates, 'mloglognorm' returns the rth moment,
+ 'eloglognorm' gives the expected value of the distirbution and
+ vloglognorm the variance.
}
-\references{ FIXME: Erstes auftauchen? }
+\references{
+ B. Holland, M. Ahsanullah (1989): Further Resultson the Distribution
+ of Meinhold and Singpurwalla, The American Statistician 43 (4), p. 216-219
+}
\author{
Heike Trautmann \email{trautmann at statistik.uni-dortmund.de},
Detlef Steuer \email{steuer at hsu-hamburg.de} and
Modified: packages/loglognorm/src/loglognorm.c
===================================================================
--- packages/loglognorm/src/loglognorm.c 2008-05-14 22:55:57 UTC (rev 10)
+++ packages/loglognorm/src/loglognorm.c 2008-05-19 08:18:52 UTC (rev 11)
@@ -115,7 +115,7 @@
typedef struct {
- double mean, sd;
+ double mean, sd, r;
} loglognorm_param;
static void loglognorm_intgr(double *x, int n, void *ex) {
@@ -123,26 +123,27 @@
loglognorm_param *lp = (loglognorm_param *)ex;
const double mean = lp->mean;
const double sd = lp->sd;
+ const double r = lp->r;
/* Taken from Trautmann (2004) p. 54 */
for (i = 0; i < n; ++i) {
- x[i] = exp(-exp(mean + sd * x[i])) * M_1_SQRT_2PI * exp(-0.5 * pow(x[i], 2.0));
+ x[i] = exp(-r*exp(mean + sd * x[i])) * M_1_SQRT_2PI * exp(-0.5 * pow(x[i], 2.0));
}
}
-SEXP eloglognorm(SEXP args) {
- R_len_t i, n_mean, n_sd;
- SEXP s_mean, s_sd, s_ret;
- double *mean, *sd, *ret, tmp;
+SEXP mloglognorm(SEXP args) {
+ R_len_t i, n_mean, n_sd, n_moment;
+ SEXP s_mean, s_sd, s_moment, s_ret;
+ double *mean, *sd, *moment, *ret, tmp;
UNPACK_REAL_VECTOR(args, s_mean, mean);
UNPACK_REAL_VECTOR(args, s_sd, sd);
-
+ UNPACK_REAL_VECTOR(args, s_moment, moment);
n_mean = length(s_mean);
n_sd = length(s_sd);
-
+ n_moment = length(s_moment);
if (n_mean != n_sd)
- error("Length of mean and sd differ (%i != %i)", n_mean, n_sd);
+ error("Length of mean, sd and moment differ (%i != %i)", n_mean, n_sd);
ALLOC_REAL_VECTOR(n_mean, s_ret, ret);
@@ -162,14 +163,15 @@
for (i = 0; i < n_mean; ++i) {
lp.mean = mean[i];
lp.sd = sd[i];
+ lp.r = moment[i];
Rdqagi(loglognorm_intgr, (void *)&lp, &bound, &inf,
&epsabs, &epsrel,
&result, &abserr, &neval, &ier,
&limit, &lenw, &last, iwork, work);
- /* FIXME: Possibly check agains lower bound given in Trautmann
- * (2004):
+ /* FIXME: Possibly check agains lower bound given in
+ * Trautmann (2004):
*
- * E(X) >= exp(-1.0) * Phi(-mean/sd)
+ * E(X^r) >= exp(-r) * Phi(-mean/sd)
*/
if (ier >= 1) { /* Failure */
ret[i] = R_NaN;
@@ -177,7 +179,7 @@
ret[i] = result;
}
}
- UNPROTECT(3);
+ UNPROTECT(4); /* s_mean, s_sd, s_moment, s_ret */
return s_ret;
}
More information about the Desire-commits
mailing list