[Distr-commits] r192 - in branches/distr-2.0/pkg/distrMod: R man
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Wed Jul 23 16:15:00 CEST 2008
Author: stamats
Date: 2008-07-23 16:14:59 +0200 (Wed, 23 Jul 2008)
New Revision: 192
Modified:
branches/distr-2.0/pkg/distrMod/R/L2GroupFamilies.R
branches/distr-2.0/pkg/distrMod/R/L2ParamFamily.R
branches/distr-2.0/pkg/distrMod/R/SimpleL2ParamFamilies.R
branches/distr-2.0/pkg/distrMod/man/L2LocationFamily.Rd
branches/distr-2.0/pkg/distrMod/man/L2LocationScaleFamily.Rd
branches/distr-2.0/pkg/distrMod/man/L2ScaleFamily.Rd
Log:
slightly modified generating function L2LocationFamily and adapted corresponding simple L2 location families.
Modified: branches/distr-2.0/pkg/distrMod/R/L2GroupFamilies.R
===================================================================
--- branches/distr-2.0/pkg/distrMod/R/L2GroupFamilies.R 2008-07-23 07:01:14 UTC (rev 191)
+++ branches/distr-2.0/pkg/distrMod/R/L2GroupFamilies.R 2008-07-23 14:14:59 UTC (rev 192)
@@ -1,68 +1,65 @@
##################################################################
## L2 location family
##################################################################
-L2LocationFamily <- function(loc = 0, scale = 1, name, centraldistribution = Norm(),
- LogDeriv = function(x)x, L2derivDistr.0,
+L2LocationFamily <- function(loc = 0, name, centraldistribution = Norm(),
+ LogDeriv = function(x) x, L2derivDistr.0,
FisherInfo.0,
distrSymm, L2derivSymm, L2derivDistrSymm,
trafo, ...){
if(missing(name))
name <- "L2 location family"
- distribution <- scale*centraldistribution+loc
-
- if(missing(distrSymm))
- {distrSymm <- SphericalSymmetry(SymmCenter = loc)
+ distribution <- centraldistribution + loc
+
+ if(missing(distrSymm)){
+ distrSymm <- SphericalSymmetry(SymmCenter = loc)
}else{
if(!is(distrSymm, "NoSymmetry")){
if(!is(distrSymm at SymmCenter, "numeric"))
stop("slot 'SymmCenter' of 'distrSymm' has to be of class 'numeric'")
if(length(distrSymm at SymmCenter) != 1)
stop("slot 'SymmCenter' of 'distrSymm' has wrong dimension")
- }
- }
+ }
+ }
param0 <- loc
names(param0) <- "loc"
param <- ParamFamParameter(name = "location", main = param0, trafo = trafo)
- modifyParam <- function(theta){}
- body(modifyParam) <- substitute({ scale*centraldistribution+theta },
- list(scale = scale))
+ modifyParam <- function(theta){ centraldistribution + theta }
props <- c(paste("The", name, "is invariant under"),
"the group of transformations 'g(x) = x + loc'",
"with location parameter 'loc'")
L2deriv.fct <- function(param){
loc <- main(param)
fct <- function(x){}
- body(fct) <- substitute({ LogDeriv((x - loc)/scale)/scale },
- list(loc = loc, scale = scale))
+ body(fct) <- substitute({ LogDeriv(x - loc) }, list(loc = loc))
return(fct)}
L2deriv <- EuclRandVarList(RealRandVariable(list(L2deriv.fct(param)), Domain = Reals()))
-
- if(missing (L2derivSymm))
- {L2derivSymm <- FunSymmList(OddSymmetric(SymmCenter = loc))
+
+ if(missing (L2derivSymm)){
+ L2derivSymm <- FunSymmList(OddSymmetric(SymmCenter = loc))
}else{
- if(!length(L2derivSymm) == 1)
- stop("wrong length of argument L2derivSymm")
- }
-
+ if(!length(L2derivSymm) == 1)
+ stop("wrong length of argument L2derivSymm")
+ }
+
L2derivDistr <- if(missing(L2derivDistr.0))
imageDistr(RandVar = L2deriv, distr = distribution) else
UnivarDistrList(L2derivDistr.0)
- if(missing (L2derivDistrSymm))
- {L2derivDistrSymm <- DistrSymmList(SphericalSymmetry(SymmCenter = 0))
+ if(missing (L2derivDistrSymm)){
+ L2derivDistrSymm <- DistrSymmList(SphericalSymmetry(SymmCenter = 0))
}else{
- if(!length(L2derivSymm) == 1)
- stop("wrong length of argument L2derivSymm")
- }
-
+ if(!length(L2derivSymm) == 1)
+ stop("wrong length of argument L2derivSymm")
+ }
+
FI0 <- if(missing(FisherInfo.0))
E(centraldistribution, fun = function(x) LogDeriv(x)^2,
useApply = FALSE, ...) else FisherInfo.0
-
- FisherInfo.fct <- function(param) PosDefSymmMatrix(FI0/scale^2)
+ FisherInfo.fct <- function(param) PosDefSymmMatrix(FI0)
+
L2Fam <- new("L2LocationFamily")
L2Fam at name <- name
L2Fam at distribution <- distribution
@@ -87,25 +84,25 @@
## L2 scale family
##################################################################
L2ScaleFamily <- function(scale = 1, loc = 0, name, centraldistribution = Norm(),
- LogDeriv = function(x)x ,L2derivDistr.0,
- FisherInfo.0,
- distrSymm, L2derivSymm, L2derivDistrSymm,
- trafo, ...){
+ LogDeriv = function(x) x, L2derivDistr.0,
+ FisherInfo.0,
+ distrSymm, L2derivSymm, L2derivDistrSymm,
+ trafo, ...){
if(missing(name))
name <- "L2 scale family"
- distribution <- scale*centraldistribution+loc
-
- if(missing(distrSymm))
- {distrSymm <- SphericalSymmetry(SymmCenter = loc)
+ distribution <- scale*centraldistribution + loc
+
+ if(missing(distrSymm)){
+ distrSymm <- SphericalSymmetry(SymmCenter = loc)
}else{
- if(!is(distrSymm, "NoSymmetry")){
+ if(!is(distrSymm, "NoSymmetry")){
if(!is(distrSymm at SymmCenter, "numeric"))
stop("slot 'SymmCenter' of 'distrSymm' has to be of class 'numeric'")
if(length(distrSymm at SymmCenter) != 1)
stop("slot 'SymmCenter' of 'distrSymm' has wrong dimension")
- }
- }
+ }
+ }
param0 <- scale
names(param0) <- "scale"
@@ -124,23 +121,23 @@
return(fct)}
L2deriv <- EuclRandVarList(RealRandVariable(list(L2deriv.fct(param)), Domain = Reals()))
- if(missing (L2derivSymm))
- {L2derivSymm <- FunSymmList(EvenSymmetric(SymmCenter = mean))
+ if(missing (L2derivSymm)){
+ L2derivSymm <- FunSymmList(EvenSymmetric(SymmCenter = loc))
}else{
- if(!length(L2derivSymm) == 1)
- stop("wrong length of argument L2derivSymm")
- }
+ if(!length(L2derivSymm) == 1)
+ stop("wrong length of argument L2derivSymm")
+ }
L2derivDistr <- if(missing(L2derivDistr.0))
imageDistr(RandVar = L2deriv, distr = distribution) else
UnivarDistrList(L2derivDistr.0)
- if(missing (L2derivDistrSymm))
- {L2derivDistrSymm <- DistrSymmList(NoSymmetry())
+ if(missing (L2derivDistrSymm)){
+ L2derivDistrSymm <- DistrSymmList(NoSymmetry())
}else{
- if(!length(L2derivSymm) == 1)
- stop("wrong length of argument L2derivSymm")
- }
+ if(!length(L2derivSymm) == 1)
+ stop("wrong length of argument L2derivSymm")
+ }
FI0 <- if(missing(FisherInfo.0))
E(centraldistribution, fun = function(x) (x*LogDeriv(x)-1)^2,
@@ -182,17 +179,17 @@
name <- "L2 location and scale family"
distribution <- scale*centraldistribution+loc
-
- if(missing(distrSymm))
- {distrSymm <- SphericalSymmetry(SymmCenter = loc)
+
+ if(missing(distrSymm)){
+ distrSymm <- SphericalSymmetry(SymmCenter = loc)
}else{
- if(!is(distrSymm, "NoSymmetry")){
+ if(!is(distrSymm, "NoSymmetry")){
if(!is(distrSymm at SymmCenter, "numeric"))
stop("slot 'SymmCenter' of 'distrSymm' has to be of class 'numeric'")
if(length(distrSymm at SymmCenter) != 1)
stop("slot 'SymmCenter' of 'distrSymm' has wrong dimension")
- }
- }
+ }
+ }
param0 <- c(loc, scale)
names(param0) <- c("loc", "scale")
@@ -217,42 +214,42 @@
L2deriv <- EuclRandVarList(RealRandVariable(L2deriv.fct(param),
Domain = Reals()))
-
- if(missing (L2derivSymm))
- {L2derivSymm <- FunSymmList(OddSymmetric(SymmCenter = loc),
+
+ if(missing (L2derivSymm)){
+ L2derivSymm <- FunSymmList(OddSymmetric(SymmCenter = loc),
EvenSymmetric(SymmCenter = loc))
}else{
- if(!length(L2derivSymm) == 2)
- stop("wrong length of argument L2derivSymm")
- }
+ if(!length(L2derivSymm) == 2)
+ stop("wrong length of argument L2derivSymm")
+ }
L2derivDistr <- if (missing(L2derivDistr.0))
imageDistr(RandVar = L2deriv, distr = distribution) else
UnivarDistrList(L2derivDistr.0[[1]],L2derivDistr.0[[2]])
- if(missing (L2derivDistrSymm))
- {L2derivDistrSymm <- DistrSymmList(SphericalSymmetry(), NoSymmetry())
+ if(missing (L2derivDistrSymm)){
+ L2derivDistrSymm <- DistrSymmList(SphericalSymmetry(), NoSymmetry())
}else{
- if(!length(L2derivSymm) == 1)
- stop("wrong length of argument L2derivSymm")
- }
+ if(!length(L2derivSymm) == 1)
+ stop("wrong length of argument L2derivSymm")
+ }
- if(missing(FisherInfo.0))
- { FI11 <- E(centraldistribution, fun = function(x) LogDeriv(x)^2,
- useApply = FALSE, ...)
+ if(missing(FisherInfo.0)){
+ FI11 <- E(centraldistribution, fun = function(x) LogDeriv(x)^2,
+ useApply = FALSE, ...)
FI22 <- E(centraldistribution, fun = function(x) (x*LogDeriv(x)-1)^2,
useApply = FALSE, ...)
- if( is(distrSymm, "SphericalSymmetry") )
- { FI12 <- 0
- } else {
- FI12 <- E(centraldistribution, fun = function(x) x*LogDeriv(x)^2,
- useApply = FALSE, ...)
- }
+ if( is(distrSymm, "SphericalSymmetry") ){
+ FI12 <- 0
+ }else{
+ FI12 <- E(centraldistribution, fun = function(x) x*LogDeriv(x)^2,
+ useApply = FALSE, ...)
+ }
FI0 <- matrix(c(FI11,FI12,FI12,FI22),2,2)
- } else{
+ }else{
FI0 <- FisherInfo.0
- }
-
+ }
+
FisherInfo.fct <- function(param){
scale <- main(param)[2]
PosDefSymmMatrix(FI0/scale^2)}
Modified: branches/distr-2.0/pkg/distrMod/R/L2ParamFamily.R
===================================================================
--- branches/distr-2.0/pkg/distrMod/R/L2ParamFamily.R 2008-07-23 07:01:14 UTC (rev 191)
+++ branches/distr-2.0/pkg/distrMod/R/L2ParamFamily.R 2008-07-23 14:14:59 UTC (rev 192)
@@ -14,7 +14,7 @@
if(missing(name))
name <- "L_2 differentiable parametric family of probability measures"
if(missing(param)&&missing(main))
- param <- ParamFamParameter(name = "location", main = 0, trafo =matrix(1))
+ param <- ParamFamParameter(name = "location", main = 0, trafo =matrix(1))
if(missing(param))
param <- ParamFamParameter(name = paste("Parameter of", name),
main = main, nuisance = nuisance,
Modified: branches/distr-2.0/pkg/distrMod/R/SimpleL2ParamFamilies.R
===================================================================
--- branches/distr-2.0/pkg/distrMod/R/SimpleL2ParamFamilies.R 2008-07-23 07:01:14 UTC (rev 191)
+++ branches/distr-2.0/pkg/distrMod/R/SimpleL2ParamFamilies.R 2008-07-23 14:14:59 UTC (rev 192)
@@ -94,7 +94,7 @@
fct2 <- function(x){}
body(fct1) <- substitute({ (x/scale - shape)/scale },
list(scale = scale, shape = shape))
- body(fct2) <- substitute({ (log(x/scale) - digamma(shape)) },
+ body(fct2) <- substitute({ log(x/scale) - digamma(shape) },
list(scale = scale, shape = shape))
return(list(fct1, fct2))}
L2derivSymm <- FunSymmList(OddSymmetric(SymmCenter = scale*shape), NonSymmetric())
@@ -337,9 +337,11 @@
## Normal location family
##################################################################
NormLocationFamily <- function(mean = 0, sd = 1, trafo){
- L2LocationFamily(loc = mean, scale = sd, name = "normal location family",
- L2derivDistr.0 = Norm(mean = 0, sd=1/sd),
- FisherInfo.0 = 1, trafo = trafo)
+ L2LocationFamily(loc = mean, name = "normal location family",
+ centraldistribution = Norm(mean = 0, sd = sd),
+ LogDeriv = function(x) x/sd^2,
+ L2derivDistr.0 = Norm(mean = 0, sd = 1/sd),
+ FisherInfo.0 = 1/sd^2, trafo = trafo)
}
##################################################################
@@ -363,7 +365,7 @@
}
###############################################################################
-# other location and / or scale models
+## other location and / or scale models
###############################################################################
##################################################################
@@ -405,10 +407,10 @@
GumbelLocationFamily <- function(loc = 0, scale = 1, trafo){
L2LocationFamily(loc = loc, scale = scale,
name = "Gumbel location family",
- centraldistribution = Gumbel(loc = 0),
- LogDeriv = function(x) 1 - exp(-x),
+ centraldistribution = Gumbel(loc = 0, scale = scale),
+ LogDeriv = function(x) (1 - exp(-x/scale))/scale,
L2derivDistr.0 = (1 - Exp(rate = 1))/scale,
- FisherInfo.0 = 1,
+ FisherInfo.0 = 1/scale^2,
distrSymm = NoSymmetry(),
L2derivSymm = FunSymmList(NonSymmetric()),
L2derivDistrSymm = DistrSymmList(NoSymmetry()),
Modified: branches/distr-2.0/pkg/distrMod/man/L2LocationFamily.Rd
===================================================================
--- branches/distr-2.0/pkg/distrMod/man/L2LocationFamily.Rd 2008-07-23 07:01:14 UTC (rev 191)
+++ branches/distr-2.0/pkg/distrMod/man/L2LocationFamily.Rd 2008-07-23 14:14:59 UTC (rev 192)
@@ -6,14 +6,13 @@
Generates an object of class \code{"L2LocationFamily"}.
}
\usage{
-L2LocationFamily(loc = 0, scale = 1, name, centraldistribution = Norm(),
+L2LocationFamily(loc = 0, name, centraldistribution = Norm(),
LogDeriv = function(x)x, L2derivDistr.0,
FisherInfo.0, distrSymm, L2derivSymm, L2derivDistrSymm,
trafo, ...)
}
\arguments{
\item{loc}{numeric: location parameter of the model. }
- \item{scale}{postive number: scale of the model. }
\item{name}{character: name of the parametric family. }
\item{centraldistribution}{object of class \code{"AbscontDistribution"}:
central distribution; we assume from the beginning, that centraldistribution
Modified: branches/distr-2.0/pkg/distrMod/man/L2LocationScaleFamily.Rd
===================================================================
--- branches/distr-2.0/pkg/distrMod/man/L2LocationScaleFamily.Rd 2008-07-23 07:01:14 UTC (rev 191)
+++ branches/distr-2.0/pkg/distrMod/man/L2LocationScaleFamily.Rd 2008-07-23 14:14:59 UTC (rev 192)
@@ -7,13 +7,13 @@
}
\usage{
L2LocationScaleFamily(loc = 0, scale = 1, name, centraldistribution = Norm(),
- LogDeriv = function(x)x, L2derivDistr.0,
- FisherInfo.0, distrSymm, L2derivSymm, L2derivDistrSymm,
- trafo, ...)
+ LogDeriv = function(x) x, L2derivDistr.0,
+ FisherInfo.0, distrSymm, L2derivSymm, L2derivDistrSymm,
+ trafo, ...)
}
\arguments{
\item{loc}{numeric: location parameter of the model. }
- \item{scale}{postive number: scale of the model. }
+ \item{scale}{positive number: scale of the model. }
\item{name}{character: name of the parametric family. }
\item{centraldistribution}{object of class \code{"AbscontDistribution"}:
central distribution; we assume by default, that centraldistribution
Modified: branches/distr-2.0/pkg/distrMod/man/L2ScaleFamily.Rd
===================================================================
--- branches/distr-2.0/pkg/distrMod/man/L2ScaleFamily.Rd 2008-07-23 07:01:14 UTC (rev 191)
+++ branches/distr-2.0/pkg/distrMod/man/L2ScaleFamily.Rd 2008-07-23 14:14:59 UTC (rev 192)
@@ -8,11 +8,11 @@
\usage{
L2ScaleFamily(scale = 1, loc = 0, name, centraldistribution = Norm(),
LogDeriv = function(x)x, L2derivDistr.0,
- FisherInfo.0, distrSymm, L2derivSymm, L2derivDistrSymm,
- trafo, ...)
+ FisherInfo.0, distrSymm, L2derivSymm, L2derivDistrSymm,
+ trafo, ...)
}
\arguments{
- \item{scale}{postive number: scale parameter of the model }
+ \item{scale}{positive number: scale parameter of the model }
\item{loc}{numeric: location parameter of the model }
\item{name}{character: name of the parametric family. }
\item{centraldistribution}{object of class \code{"AbscontDistribution"}:
More information about the Distr-commits
mailing list