Problem in finding starting values for shifted exponential distribution - r

I am trying to fit shifted exponential distribution to my data but fitdist function giving error of 100 and failing to estimate starting values. I also used plotdist function to find starting or initial values in order to fit the distribution and I have obtained the followings plots with parameters rate = 0.155 shift = 0.00001 after iteration process and even I used these values in fitdist as well.
I used mledist function to calculate starting values of distribution parameters as well but it is also not working. I used fitdist function as well it gives the following error:
Error in fitdist(x, "sexp", start = list(rate = 0.155, shift = 1e-05)) :
the function mle failed to estimate the parameters,
with the error code 100
The code is as below:
library(fitdistrplus)
library(readxl)
library(tidyverse)
library(here)
library(janitor)
# Load data-------------------------------
pvr <- read_excel(here("data", "pvr.xlsx"))
pvr <- pvr %>%
select(-starts_with("...")) %>%
clean_names(case = "snake")
x <- pvr$headway
rate <- 0.155
shift <- 0.00001
dsexp <- function(x, rate, shift)
dexp(x-shift, rate=rate)
psexp <- function(x, rate, shift)
pexp(x-shift, rate=rate)
qsexp <- function(x, rate, shift)
qexp(x-shift, rate=rate)
f12 <- fitdist(x, "sexp", start = list(rate=0.155, shift=0.00001), lower = c(0, -min(x)))
The data may be downloaded from the following link below:
https://ptagovsa-my.sharepoint.com/:x:/g/personal/kkhan_tga_gov_sa/EfzCE5h0jexCkVw0Ak2S2_MBWf3WUywMd1izw41r0EsLeQ?e=EiqWDc
Can anyone help me in this regard?

The fitdist function uses mle method as default. The code works just by changing the method from mle to mse or mge.

Related

Is it possible to adapt standard prediction interval code for dlm in R with other distribution?

Using the dlm package in R I fit a dynamic linear model to a time series data set, consisting of 20 observations. I then use the dlmForecast function to predict future values (which I can validate against the genuine data for said period).
I use the following code to create a prediction interval;
ciTheory <- (outer(sapply(fut1$Q, FUN=function(x) sqrt(diag(x))), qnorm(c(0.05,0.95))) +
as.vector(t(fut1$f)))
However my data does not follow a normal distribution and I wondered whether it would be possible to
adapt the qnorm function for other distributions. I have tried qt, but am unable to apply qgamma.......
Just wondered if anyone knew how you would go about sorting this.....
Below is a reproduced version of my code...
library(dlm)
data <- c(20.68502, 17.28549, 12.18363, 13.53479, 15.38779, 16.14770, 20.17536, 43.39321, 42.91027, 49.41402, 59.22262, 55.42043)
mod.build <- function(par) {
dlmModPoly(1, dV = exp(par[1]), dW = exp(par[2]))
}
# Returns most likely estimate of relevant values for parameters
mle <- dlmMLE(a2, rep(0,2), mod.build); #nileMLE$conv
if(mle$convergence==0) print("converged") else print("did not converge")
mod1 <- dlmModPoly(dV = v, dW = c(0, w))
mod1Filt <- dlmFilter(a1, mod1)
fut1 <- dlmForecast(mod1Filt, n = 7)
Cheers

Error using fitdist with truncated distributions

I am trying to fit a certain truncated distribution to a data set. For example, for a lognormal distribution, I define the density function of the truncated distribution as:
dtlnorm <- function(x, meanlog, sdlog,low)
dlnorm(x,meanlog,sdlog)/(1-plnorm(low,meanlog,sdlog))* (x >= low)
where low is the truncation point.
My data is the following vector
Data <- c(1068295.00589834, 1406446.49289834, 1540330.78489834, 1152321.94489834,
3108649.66189834, 3718417.97089834, 2981945.18089834, 4552923.31989834,
5747260.98289834, 2105461.57989834, 1044515.95889834, 1133641.75289834,
3847920.72789834, 2536441.02989834, 3073854.15789834, 1591039.28389834,
2592446.73289834, 4989152.55189834, 2426457.45489834, 120265066.499898,
6888222046.1999, 1092811.87089834, 3440123.51689834, 74684298.1398983,
1475038.27689834, 1124226.39489834, 11739544.5798983, 1187688.74489834,
1023193.88789834, 18784663.9698983)
To fit the distribution, I write:
fitdist(Data,distr="tlnorm",method="mle",start = list(meanlog=0,sdlog=0),fix.arg = list(low=100))
But the following error appears:
Error in fitdist(Data, distr = "tlnorm", method = "mle", start = list(meanlog = 0, :
the function mle failed to estimate the parameters,
with the error code 100
I do not know what is happening. Can somebody help me? Thank you!

exponential fit singularity in r

I'm trying to fit a bi-exponential function on this dataset but I can't seem to get it to converge. I've tried using nls2 grid search for the best starting point, I've also tried using nlsLM but neither method works. Does anyone have any suggestions?
function: y = a1*exp(-n1*t) + a2*exp(-n2*t) + c
here is the code:
y <- c(1324,1115,1140,934,1013,982,1048,1143,754,906,895,900,765,808,680,731,728,794,706,531,629,629,519,514,516,454,465,630,415,347,257,363,275,379,329,263,301,315,283,354,230,257,196,268,262,236,220,239,255,213,275,273,294,169,257,178,207,169,169,297,
227,189,214,168,263,227,185,220,169,229,174,231,178,141,195,223,258,206,181,200,150,200,169,194,230,162,174,194,225,216,196,213,150,235,231,224,244,161,219,222,210,
186,188,197,177,251,248,223,273,145,257,236,214,194,211,213,175,168,223,192,318,
263,234,163,202,239,189,216,206,185,185,191,340,145,188,305,112,252,213,245,240,196,196,179,235,241,177,196,191,181,240,164,202,201,306,214,212,185,192,178,203,203,239,141,203,190,216,174,219,153,177,223,207,186,213,173,210,191,258,277)
t <- seq(1,length(y),1)
mydata <- data.frame(t=t,y=y)
library(nls2)
fo <- y~a1*exp(-n1*t)+a2*exp(-n2*t)+c
grd <- expand.grid(a1=seq(-12030,1100,by=3000),
a2=seq(-22110,1900,by=2000),
n1=seq(0.01,.95,by=0.4),
n2=seq(0.02,.9,by=0.25),
c=seq(100,400,by=50))
fit <- nls2(fo, data=allout, start=grd, algorithm='brute-force', control=list(maxiter=100))
fit2 <- nls(fo, data=allout, start=as.list(coef(fit)), control=list(minFactor=1e-12, maxiter=200),trace=F)
error: maximum iteration exceeded
However, if I use nlsLM then I get singularity gradient matrix at initial parameter estimate.

Model fitting with nls.lm in R, "Error: unused argument"

I'm trying to use the nls.lm function in the minpack.lm to fit a non-linear model to some data from a psychophysics experiment.
I've had a search around and can't find a lot of information about the package so have essentially copied the format of the example given on the nls.lm help page. Unfortunately my script is still failing to run and R is throwing out this error:
Error in fn(par, ...) :
unused argument (observed = c(0.1429, 0.2857, 0.375, 0.3846, 0.4667, 0.6154))
It appears that the script thinks the data I want to fit the model to is irrelevant, which is definitely wrong.
I'm expecting it to fit the model and produce a value of 0.5403 for the spare parameter (w).
Any help is greatly appreciated.
I'm making the transfer from Matlab over to R so apologies if my code looks sloppy.
Here's the script.
install.packages("pracma")
require(pracma)
install.packages("minpack.lm")
require(minpack.lm)
# Residual function, uses parameter w (e.g. .23) to predict accuracy error at a given ratio [e.g. 2:1]
residFun=function(w,n) .5 * erfc( abs(n[,1]-n[,2])/ ((sqrt(2)*w) * sqrt( (n[,1]^2) + (n[,2]^2) ) ) )
# example for residFun
# calculates an error rate of 2.59%
a=matrix(c(2,1),1,byrow=TRUE)
residFun(.23,a)
# Initial guess for parameter to be fitted (w)
parStart=list(w=0.2)
# Recorded accuracies in matrix, 1- gives errors to input into residFun
# i.e. the y-values I want to fit the model
Acc=1-(matrix(c(0.8571,0.7143,0.6250,0.6154,0.5333,0.3846),ncol=6))
# Ratios (converted to proportions) used in testing
# i.e. the points along the x-axis to fit the above data to
Ratios=matrix(c(0.3,0.7,0.4,0.6,0.42,0.58,0.45,0.55,0.47,0.53,0.49,0.51),nrow=6,byrow=TRUE)
# non-linear model fitting, attempting to calculate the value of w using the Levenberg-Marquardt nonlinear least-squares algorithm
output=nls.lm(par=parStart,fn=residFun,observed=Acc,n=Ratios)
# Error message shown after running
# Error in fn(par, ...) :
# unused argument (observed = c(0.1429, 0.2857, 0.375, 0.3846, 0.4667, 0.6154))
The error means you passed a function an argument that it did not expect. ?nls.lm has no argument observed, so it is passed to the function passed to fn, in your case, residFun. However, residFun doesn't expect this argument either, hence the error. You need to redefine this function like this :
# Residual function, uses parameter w (e.g. .23) to predict accuracy error at a given ratio [e.g. 2:1]
residFun=function(par,observed, n) {
w <- par$w
r <- observed - (.5 * erfc( abs(n[,1]-n[,2])/ ((sqrt(2)*w) * sqrt( (n[,1]^2) + (n[,2]^2) ) ) ))
return(r)
}
It gives the following result :
> output = nls.lm(par=parStart,fn=residFun,observed=Acc,n=Ratios)
> output
Nonlinear regression via the Levenberg-Marquardt algorithm
parameter estimates: 0.540285874836135
residual sum-of-squares: 0.02166
reason terminated: Relative error in the sum of squares is at most `ftol'.
Why that happened :
It seems that you were inspired by this example in he documentation :
## residual function
residFun <- function(p, observed, xx) observed - getPred(p,xx)
## starting values for parameters
parStart <- list(a=3,b=-.001, c=1)
## perform fit
nls.out <- nls.lm(par=parStart, fn = residFun, observed = simDNoisy,
xx = x, control = nls.lm.control(nprint=1))
Note that observed is an argument of residFun here.

bootstrap proportion confidence interval

I would like to produce confidence intervals for proportions using the boot package if possible.
I have a vector and I would like to set a threshold and then calculate the proportions below the specified level.
After that I would like to use the bootstrap function in the boot package to calculate the confidence intervals for the proportions.
Simple example of what I have so far:
library(boot)
vec <- abs(rnorm(1000)*10) #generate example vector
data_to_tb <- vec
tb <- function(data) {
sum(data < 10, na.rm = FALSE)/length(data) #function for generating the proportion
}
tb(data_to_tb)
boot(data = data_to_tb, statistic = tb, R = 999)
quantile(boot.out$t, c(.025,.975))
However, I get this error message:
> boot(data = data_to_tb, statistic = tb, R = 999)
Error in statistic(data, original, ...) : unused argument (original)
I can not get it to work though, help appreciated
Your problem is your function tb - it needs two arguments. From the help file ?boot
statistic A function which when applied to data returns a vector
containing the statistic(s) of interest. When sim = "parametric", the
first argument to statistic must be the data. For each replicate a
simulated dataset returned by ran.gen will be passed. In all other
cases statistic must take at least two arguments.

Resources