[Distr-commits] r270 - branches/distr-2.0/pkg/distrMod/inst/scripts
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Tue Aug 26 22:51:48 CEST 2008
Author: ruckdeschel
Date: 2008-08-26 22:51:48 +0200 (Tue, 26 Aug 2008)
New Revision: 270
Added:
branches/distr-2.0/pkg/distrMod/inst/scripts/BetaFam.R
branches/distr-2.0/pkg/distrMod/inst/scripts/PoisFam.R
branches/distr-2.0/pkg/distrMod/inst/scripts/censoredPois.R
branches/distr-2.0/pkg/distrMod/inst/scripts/modelExp3.R
Modified:
branches/distr-2.0/pkg/distrMod/inst/scripts/example_CvMMDE.R
Log:
some more scripts
Added: branches/distr-2.0/pkg/distrMod/inst/scripts/BetaFam.R
===================================================================
--- branches/distr-2.0/pkg/distrMod/inst/scripts/BetaFam.R (rev 0)
+++ branches/distr-2.0/pkg/distrMod/inst/scripts/BetaFam.R 2008-08-26 20:51:48 UTC (rev 270)
@@ -0,0 +1,14 @@
+### some further examples:
+require(distrMod)
+
+
+### Beta Family
+B <- BetaFamily(2,4)
+# generate data
+x <- r(B)(40)
+distroptions(DistrResolution = 1e-10)
+MDEstimator(x, B, distance = TotalVarDist)
+MDEstimator(x, B)
+MDEstimator(x, B, distance = CvMDist, asvar.fct = distrMod:::.CvMMDCovariance)
+(MLE<-MLEstimator(x, B))
+confint(MLE)
Added: branches/distr-2.0/pkg/distrMod/inst/scripts/PoisFam.R
===================================================================
--- branches/distr-2.0/pkg/distrMod/inst/scripts/PoisFam.R (rev 0)
+++ branches/distr-2.0/pkg/distrMod/inst/scripts/PoisFam.R 2008-08-26 20:51:48 UTC (rev 270)
@@ -0,0 +1,14 @@
+### some further examples:
+require(distrMod)
+
+### Poisson Family
+P <- PoisFamily(3)
+# generate data
+x <- r(P)(40)
+MLEstimator(x,P)
+MDEstimator(x,P)
+MDEstimator(x,P, distance = CvMDist, asvar.fct = distrMod:::.CvMMDCovariance)
+MDEstimator(x,P, distance = CvMDist, mu = Norm())
+MDEstimator(x,P, distance = TotalVarDist)
+
+
Added: branches/distr-2.0/pkg/distrMod/inst/scripts/censoredPois.R
===================================================================
--- branches/distr-2.0/pkg/distrMod/inst/scripts/censoredPois.R (rev 0)
+++ branches/distr-2.0/pkg/distrMod/inst/scripts/censoredPois.R 2008-08-26 20:51:48 UTC (rev 270)
@@ -0,0 +1,69 @@
+##########################################################
+### a new model -- a censored Poisson distribution
+### i.e. we only observe values if they are larger than
+## a lower truncation point
+##########################################################
+
+CensoredPoisFamily <- function(lambda = 1, trunc.pt = 2){
+ ## name
+ name <- "Censored Poisson family"
+ ## central distribution
+ distribution <- Truncate(Pois(lambda = lambda), lower= trunc.pt )
+ param0 <- lambda
+ names(param0) <- "lambda"
+ ## parameter definition
+ param <- ParamFamParameter(name = "positive mean",
+ main = param0)
+
+ ## mapping theta -> P_theta
+ modifyParam <- function(theta){
+ Truncate(Pois(lambda = theta), lower = trunc.pt)}
+
+ ## search interval for reasonable parameters
+ startPar <- function(x,...) c(.Machine$double.eps,max(x))
+
+ ## what to do in case of leaving the parameter domain
+ makeOKPar <- function(param) {if(param<=0) return(.Machine$double.eps)
+ return(param)}
+
+ ## mapping theta -> Lambda_theta
+ L2deriv.fct <- function(param){
+ lambda <- main(param)
+ fct <- function(x){}
+ body(fct) <- substitute({
+ x/lambda-ppois(trunc.pt-1, lambda = lambda,
+ lower.tail=FALSE)/
+ ppois(trunc.pt, lambda = lambda,
+ lower.tail=FALSE)},
+ list(lambda = lambda))
+ return(fct)}
+
+ res <- L2ParamFamily(name = name, distribution = distribution,
+ param = param, modifyParam = modifyParam,
+ L2deriv.fct = L2deriv.fct,
+ startPar = startPar, makeOKPar = makeOKPar)
+
+ ## a simplified call
+ res at fam.call <- substitute(CensoredPoisFamily(lambda = l, trunc.pt = t),
+ list(l = lambda, t = trunc.pt))
+ return(res)
+}
+
+## assign the model
+CP <- CensoredPoisFamily(3,2)
+
+## some observations
+CP.data <- r(CP)(40)
+
+## MLE
+(m<- MLEstimator(CP.data, CP))
+confint(m)
+plot(profile(m))
+
+## MDE
+(md.kolm<- MDEstimator(CP.data, CP))
+(md.CvM<- MDEstimator(CP.data, CP, distance = CvMDist,
+ asvar.fct = distrMod:::.CvMMDCovariance))
+confint(md.CvM)
+plot(profile(md.CvM))
+
Modified: branches/distr-2.0/pkg/distrMod/inst/scripts/example_CvMMDE.R
===================================================================
--- branches/distr-2.0/pkg/distrMod/inst/scripts/example_CvMMDE.R 2008-08-26 20:21:39 UTC (rev 269)
+++ branches/distr-2.0/pkg/distrMod/inst/scripts/example_CvMMDE.R 2008-08-26 20:51:48 UTC (rev 270)
@@ -1,10 +1,20 @@
require(distrMod)
+
+## example to CvM MDE for Normal Location and Scale
+
x=rnorm(30)
NF=NormLocationScaleFamily()
+
system.time(print(MDEstimator(x,NF,CvMDist)))
+#with useApply
system.time(print(MDEstimator(x,NF,CvMDist,useApply=TRUE)))
+
MDEstimator(rnorm(30),NF,CvMDist)
+#another sample
MDEstimator(rnorm(30),NF,CvMDist)
+# larger sample size
MDEstimator(rnorm(300),NF,CvMDist)
+
MDEstimator(rnorm(300,mean=2,sd=2),NF,CvMDist)
+#another sample
MDEstimator(rnorm(300,mean=2,sd=2),NF,CvMDist)
Added: branches/distr-2.0/pkg/distrMod/inst/scripts/modelExp3.R
===================================================================
--- branches/distr-2.0/pkg/distrMod/inst/scripts/modelExp3.R (rev 0)
+++ branches/distr-2.0/pkg/distrMod/inst/scripts/modelExp3.R 2008-08-26 20:51:48 UTC (rev 270)
@@ -0,0 +1,37 @@
+##########################################################
+### a new central distribution in a location scale model
+##########################################################
+
+require(distrMod)
+
+my3d <- AbscontDistribution( d = function(x) exp(-abs(x)^3), withS = TRUE)
+plot(my3d)
+## in a location scale model
+scl.true <- 2; loc.true <- 3
+my3dF <- L2LocationScaleFamily(loc = loc.true,
+ scale = scl.true,
+ name = "my3dF",
+ centraldistribution = my3d)
+
+plot(my3dF)
+
+### generate some data out of the model
+x <- r(my3dF)(40)
+
+### evaluate the MLE:
+mledistrMod <- MLEstimator(x,my3dF)
+
+#some profiling
+par(mfrow=c(1,2))
+plot(profile(mledistrMod))
+
+# a confidence interval
+confint(mledistrMod)
+
+(mde.kolm <- (x = x, ParamFamily = my3dF))
+(mde.CvM <- MDEstimator(x = x, ParamFamily = my3dF, distance = CvMDist))
+asvar(mde.CvM) <- distrMod:::.CvMMDCovariance(my3dF,
+ param = ParamFamParameter(main= estimate(MDE)),
+ expon = 2, withplot = TRUE)
+# a confidence interval
+confint(mde.CvM)
More information about the Distr-commits
mailing list