# (1) basic fit of a normal distribution with maximum likelihood estimation
#
x1 <- c(6.4,13.3,4.1,1.3,14.1,10.6,9.9,9.6,15.3,22.1,13.4,
13.2,8.4,6.3,8.9,5.2,10.9,14.4)
f1 <- fitdist(x1,"norm")
print(f1)
plot(f1)
summary(f1)
gofstat(f1)
# (2) use the moment matching estimation (using a closed formula)
#
f1b <- fitdist(x1,"norm",method="mme")
summary(f1b)
# (3) moment matching estimation (using a closed formula)
# for log normal distribution
#
f1c <- fitdist(x1,"lnorm",method="mme")
summary(f1c)
# (4) defining your own distribution functions, here for the Gumbel distribution
# for other distributions, see the CRAN task view
# dedicated to probability distributions
#
dgumbel <- function(x,a,b) 1/b*exp((a-x)/b)*exp(-exp((a-x)/b))
pgumbel <- function(q,a,b) exp(-exp((a-q)/b))
qgumbel <- function(p,a,b) a-b*log(-log(p))
f1c <- fitdist(x1,"gumbel",start=list(a=10,b=5))
print(f1c)
plot(f1c)
# (5) fit a discrete distribution (Poisson)
#
x2<-c(rep(4,1),rep(2,3),rep(1,7),rep(0,12))
f2<-fitdist(x2,"pois")
plot(f2)
summary(f2)
gofstat(f2)
# (6) how to change the optimisation method?
#
fitdist(x1,"gamma",optim.method="Nelder-Mead")
fitdist(x1,"gamma",optim.method="BFGS")
fitdist(x1,"gamma",optim.method="L-BFGS-B",lower=c(0,0))
fitdist(x1,"gamma",optim.method="SANN")
# (7) custom optimization function
#
#create the sample
mysample <- rexp(100, 5)
mystart <- 8
res1 <- fitdist(mysample, dexp, start= mystart, optim.method="Nelder-Mead")
#show the result
summary(res1)
#the warning tell us to use optimise, because the Nelder-Mead is not adequate.
#to meet the standard 'fn' argument and specific name arguments, we wrap optimize,
myoptimize <- function(fn, par, ...)
{
res <- optimize(f=fn, ..., maximum=FALSE)
#assume the optimization function minimize
standardres <- c(res, convergence=0, value=res$objective,
par=res$minimum, hessian=NA)
return(standardres)
}
#call fitdist with a 'custom' optimization function
res2 <- fitdist(mysample, dexp, start=mystart, custom.optim=myoptimize,
interval=c(0, 100))
#show the result
summary(res2)
# (8) custom optimization function - another example with the genetic algorithm
#
#set a sample
x1 <- c(6.4, 13.3, 4.1, 1.3, 14.1, 10.6, 9.9, 9.6, 15.3, 22.1,
13.4, 13.2, 8.4, 6.3, 8.9, 5.2, 10.9, 14.4)
fit1 <- fitdist(x1, "gamma")
summary(fit1)
#wrap genoud function rgenoud package
mygenoud <- function(fn, par, ...)
{
require(rgenoud)
res <- genoud(fn, starting.values=par, ...)
standardres <- c(res, convergence=0)
return(standardres)
}
#call fitdist with a 'custom' optimization function
fit2 <- fitdist(x1, "gamma", custom.optim=mygenoud, nvars=2,
Domains=cbind(c(0,0), c(10, 10)), boundary.enforcement=1,
print.level=1, hessian=TRUE)
summary(fit2)
# (9) estimation of the standard deviation of a normal distribution
# by maximum likelihood with the mean fixed at 10 using the argument fix.arg
#
fitdist(x1,"norm",start=list(sd=5),fix.arg=list(mean=10))
# (10) fit of a Weibull distribution to serving size data by maximum likelihood estimation
# or by quantile matching estimation (in this example matching first and third quartiles)
#
data(groundbeef)
serving <- groundbeef$serving
fWmle <- fitdist(serving,"weibull")
summary(fWmle)
plot(fWmle)
gofstat(fWmle)
fWqme <- fitdist(serving,"weibull",method="qme",probs=c(0.25,0.75))
summary(fWqme)
plot(fWqme)
gofstat(fWqme)
# (11) Fit of a Pareto distribution by numerical moment matching estimation
#
require(actuar)
#simulate a sample
x4 <- rpareto(1000, 6, 2)
#empirical raw moment
memp <- function(x, order)
ifelse(order == 1, mean(x), sum(x^order)/length(x))
#fit
fP <- fitdist(x4, "pareto", method="mme",order=c(1, 2), memp="memp",
start=c(10, 10), lower=1, upper=Inf)
summary(fP)
# (12) Fit of a Weibull distribution to serving size data by maximum
# goodness-of-fit estimation using all the distances available
#
data(groundbeef)
serving <- groundbeef$serving
fitdist(serving,"weibull",method="mge",gof="CvM")
fitdist(serving,"weibull",method="mge",gof="KS")
fitdist(serving,"weibull",method="mge",gof="AD")
fitdist(serving,"weibull",method="mge",gof="ADR")
fitdist(serving,"weibull",method="mge",gof="ADL")
fitdist(serving,"weibull",method="mge",gof="AD2R")
fitdist(serving,"weibull",method="mge",gof="AD2L")
fitdist(serving,"weibull",method="mge",gof="AD2")
# (13) Fit of a uniform distribution using Cramer-von Mises or
# Kolmogorov-Smirnov distance
#
u <- runif(50,min=5,max=10)
fuCvM <- fitdist(u,"unif",method="mge",gof="CvM")
summary(fuCvM)
plot(fuCvM)
gofstat(fuCvM)
fuKS <- fitdist(u,"unif",method="mge",gof="KS")
summary(fuKS)
plot(fuKS)
gofstat(fuKS)
Run the code above in your browser using DataLab