https://github.com/cran/MPS
Tip revision: 75f8da97ce6accda843ea35f39a71edf810b574f authored by Mahdi Teimouri on 03 September 2018, 06:30:03 UTC
version 2.2.0
version 2.2.0
Tip revision: 75f8da9
MPS.R
mpsbetaexpg<-function(mydata, g, location=TRUE, method , sig.level){
min.mydata<-min(mydata)
sort.mydata<-sort(mydata)
n<-length(mydata)
y<-(sort.mydata[2:n]-min.mydata)
y<-(sort.mydata[2:n]-min.mydata)[is.finite(log(sort.mydata[2:n]-min.mydata))]
n<-length(mydata)
qp1<-y[floor(.25*n)]
qp3<-y[floor(.75*n)]
median.mydata<-y[floor(.5*n)]
mean.mydata<-mean(y)
inv.mydata<-1/y[is.finite(1/y)]
inv.mean<-mean(inv.mydata)
std.mydata<-sd(y)
if(g!="birnbaum-saunders" & g!="exp" & g!="rayleigh" & g!="weibull" & g!="gompertz" & g!="gamma"
& g!="log-normal" & g!="chisq" & g!="f" & g!="burrxii" & g!="frechet"
& g!="lomax" & g!="log-logistic" & g!="lfr" & g!="chen")
{ stop ("Baseline distribution not implemented or misspelled. Please check the manual for guidelines.") }
if(g=="log-normal"){
den=function(par,x){meanlog=par[4]; sdlog=par[5]; loc=par[6]; dlnorm(x-loc,meanlog,sdlog)}
cum=function(par,x){meanlog=par[4]; sdlog=par[5]; loc=par[6]; plnorm(x-loc,meanlog,sdlog)}
starts<-c(1,1,1,log(median.mydata),sqrt(2*abs(log(mean.mydata/median.mydata))),(min.mydata-1/length(y)))
if (location==FALSE){
den=function(par,x){meanlog=par[4]; sdlog=par[5]; dlnorm(x,meanlog,sdlog)}
cum=function(par,x){meanlog=par[4]; sdlog=par[5]; plnorm(x,meanlog,sdlog)}
starts<-c(1,1,1,log(median.mydata),sqrt(2*abs(log(mean.mydata/median.mydata))))
}}
if(g=="chisq"){
den=function(par,x){df=par[4]; loc=par[5]; dchisq(x-loc,df)}
cum=function(par,x){df=par[4]; loc=par[5]; pchisq(x-loc,df)}
starts<-c(1,1,1,mean.mydata,(min.mydata-1/length(y)))
if (location==FALSE){
den=function(par,x){df=par[4]; dchisq(x,df)}
cum=function(par,x){df=par[4]; pchisq(x,df)}
starts<-c(1,1,1,mean.mydata)
}}
if(g=="f"){
den=function(par,x){df1=par[4]; df2=par[5]; loc=par[6]; df(x-loc,df1,df2)}
cum=function(par,x){df1=par[4]; df2=par[5]; loc=par[6]; pf(x-loc,df1,df2)}
df.1<-ifelse(inv.mean>1,2*inv.mean/(inv.mean-1),1)
df.2<-ifelse(mean.mydata>1,2*mean.mydata/(mean.mydata-1),1)
starts<-c(1,1,1,df.1,df.2,(min.mydata-1/length(y)))
if (location==FALSE){
den=function(par,x){df1=par[4]; df2=par[5]; df(x,df1,df2)}
cum=function(par,x){df1=par[4]; df2=par[5]; pf(x,df1,df2)}
starts<-c(1,1,1,df.1,df.2)
}}
if(g=="chen"){
den=function(par,x){a=par[4]; b=par[5]; loc=par[6]; a*b*(x-loc)^(a-1)*exp((x-loc)^a)*exp(-b*(exp((x-loc)^a)-1))}
cum=function(par,x){a=par[4]; b=par[5]; loc=par[6]; 1-exp(-b*(exp((x-loc)^a)-1))}
standard.mydata<-(y-mean.mydata)/std.mydata
s.hat<-ifelse(max(standard.mydata)<=1,-log(1-n/(n+.4))/(exp(1)-1),-
log(1-length(standard.mydata[standard.mydata<=1])/length(standard.mydata))/(exp(1)-1))
r.hat<-abs(log(log(1-log(1-0.5)/s.hat))/log(median.mydata))
starts<-c(1,1,1,r.hat,s.hat,(min.mydata-1/length(y)))
if (location==FALSE){
den=function(par,x){a=par[4]; b=par[5]; a*b*(x)^(a-1)*exp((x)^a)*exp(-b*(exp((x)^a)-1))}
cum=function(par,x){a=par[4]; b=par[5]; 1-exp(-b*(exp((x)^a)-1))}
starts<-c(1,1,1,r.hat,s.hat)
}}
if(g=="lfr"){
den=function(par,x){a=par[4]; b=par[5]; loc=par[6]; (a+b*(x-loc))*exp(-a*(x-loc)-(b*(x-loc)^2)/2)}
cum=function(par,x){a=par[4]; b=par[5]; loc=par[6]; 1-exp(-a*(x-loc)-(b*(x-loc)^2)/2)}
ii<-seq(1,(n-1))
yy<--log(1-(ii+0.3)/(n-1+0.4))
res<-summary(lm(yy ~ -1+y+I(y^2)))$coefficient
coeff<-c(abs(res[1,1]),abs(res[2,1]))
z1=NULL;
lfr.log<-function(p) {
z1<--log(sum(p[1]+p[2]*y))+p[1]*sum(y)+p[2]/2*sum(y^2)
z1[z1<1e-16]<-1e-16
}
p.hat<-suppressWarnings(optim(c(abs(coeff[1]),2*abs(coeff[2])),lfr.log)$par)
starts<-c(1,1,1,p.hat[1],p.hat[2],(min.mydata-1/length(y)))
if (location==FALSE){
den=function(par,x){a=par[4]; b=par[5]; (a+b*(x))*exp(-a*(x)-(b*(x)^2)/2)}
cum=function(par,x){a=par[4]; b=par[5]; 1-exp(-a*(x)-(b*(x)^2)/2)}
starts<-c(1,1,1,p.hat[1],p.hat[2])
}}
if(g=="log-logistic"){
den=function(par,x){a=par[4]; b=par[5]; loc=par[6]; (a*b^(-a)*(x-loc)^(a-1))/((((x-loc)/b)^a +1)^2)}
cum=function(par,x){a=par[4]; b=par[5]; loc=par[6]; 1/(((x-loc)/b)^(-a)+1)}
starts<-c(1,1,1,log(0.75/(1-0.75))/log(qp3/median.mydata),median.mydata,(min.mydata-1/length(y)))
if (location==FALSE){
den=function(par,x){a=par[4]; b=par[5]; (a*b^(-a)*(x)^(a-1))/((((x)/b)^a +1)^2)}
cum=function(par,x){a=par[4]; b=par[5]; 1/(((x)/b)^(-a)+1)}
starts<-c(1,1,1,log(0.75/(1-0.75))/log(qp3/median.mydata),median.mydata)
}}
if(g=="lomax"){
den=function(par,x){a=par[4]; b=par[5]; loc=par[6]; (a*b)/((1+a*(x-loc))^(b+1))}
cum=function(par,x){a=par[4]; b=par[5]; loc=par[6]; 1-(1+a*(x-loc))^(-b)}
a.hat<-1
b.hat<-(.5^(-1/a.hat)-1)/median.mydata
z1=NULL;
lomax.log<-function(p) {
z1<--n*log(p[1])-n*log(p[2])+(p[2]+1)*sum(log(1+p[1]*y))
z1[z1<1e-16]<-1e-16
}
p.hat<-suppressWarnings(optim(c(1,b.hat),lomax.log, method)$par)
starts<-c(1,1,1,p.hat[1],p.hat[2],(min.mydata-1/length(y)))
if (location==FALSE){
den=function(par,x){a=par[4]; b=par[5]; (a*b)/((1+a*(x))^(b+1))}
cum=function(par,x){a=par[4]; b=par[5]; 1-(1+a*(x))^(-b)}
starts<-c(1,1,1,p.hat[1],p.hat[2])
}}
if(g=="gompertz"){
den=function(par,x){a=par[4]; b=par[5]; loc=par[6]; b*exp(a*(x-loc))*exp(-(exp(a*(x-loc))-1)*b/a)}
cum=function(par,x){a=par[4]; b=par[5]; loc=par[6]; 1-exp(-(exp(a*(x-loc))-1)*b/a)}
a.hat<-log(log(1-.75)/log(1-.5))/(qp3-median.mydata)
b.hat<--a.hat*log(0.5)/(exp(a.hat*median.mydata)-1)
z1=NULL;
gompertz.log<-function(p){
z1<--n*log(p[2])-p[1]*sum(y)+p[2]/p[1]*sum(exp(p[1]*y)-1)
z1[z1<1e-16]<-1e-16
}
p.hat<-suppressWarnings(optim(c(a.hat,b.hat),gompertz.log, method)$par)
starts<-c(1,1,1,p.hat[1],p.hat[2],(min.mydata-1/length(y)))
if (location==FALSE){
den=function(par,x){a=par[4]; b=par[5]; b*exp(a*(x))*exp(-(exp(a*(x))-1)*b/a)}
cum=function(par,x){a=par[4]; b=par[5]; 1-exp(-(exp(a*(x))-1)*b/a)}
starts<-c(1,1,1,p.hat[1],p.hat[2])
}}
if(g=="exp"){
den=function(par,x){rate=par[4]; loc=par[5]; dexp(x-loc,rate)}
cum=function(par,x){rate=par[4]; loc=par[5]; pexp(x-loc,rate)}
starts<-c(1,1,1,1/mean.mydata,(min.mydata-1/length(y)))
if (location==FALSE){
den=function(par,x){rate=par[4]; dexp(x,rate)}
cum=function(par,x){rate=par[4]; pexp(x,rate)}
starts<-c(1,1,1,1/mean.mydata)
}}
if(g=="rayleigh"){
den=function(par,x){a=par[4]; loc=par[5]; 2*(x-loc)/a*exp(-((x-loc)/a)^2)}
cum=function(par,x){a=par[4]; loc=par[5]; 1-exp(-((x-loc)/a)^2)}
starts<-c(1,1,1,log(2)/(median.mydata)^2,(min.mydata-1/length(y)))
if (location==FALSE){
den=function(par,x){a=par[4]; 2*x/a*exp(-(x/a)^2)}
cum=function(par,x){a=par[4]; 1-exp(-(x/a)^2)}
starts<-c(1,1,1,log(2)/(median.mydata)^2)
}}
if(g=="burrxii"){
den=function(par,x){a=par[4]; d=par[5]; loc=par[6]; d*a*(1+(x-loc)^d)^(-a-1)*((x-loc)^(d-1))}
cum=function(par,x){a=par[4]; d=par[5]; loc=par[6]; 1-(1+(x-loc)^d)^(-a)}
z1=NULL;
burrxii.log<-function(p){
z1<--n*log(p[1])-n*log(p[2])-(p[2]-1)*sum(log(y))+(p[1]+1)*sum(log(1+y^p[2]))
}
p.hat<-suppressWarnings(optim(c(1,1),burrxii.log, method="BFGS")$par)
starts<-c(1,1,1,p.hat[1],p.hat[2],(min.mydata-1/length(y)))
if (location==FALSE){
den=function(par,x){a=par[4]; d=par[5]; d*a*(1+(x)^d)^(-a-1)*((x)^(d-1))}
cum=function(par,x){a=par[4]; d=par[5]; 1-(1+(x)^d)^(-a)}
starts<-c(1,1,1,p.hat[1],p.hat[2])
}}
if(g=="frechet"){
den=function(par,x){a=par[4]; b=par[5]; loc=par[6]; (a*exp(-((x-loc)/b)^(-a))*((x-loc)/b)^(-a-1))/(b)}
cum=function(par,x){a=par[4]; b=par[5]; loc=par[6]; exp(-((x-loc)/b)^(-a))}
cons<-cor(inv.mydata,rank(inv.mydata))*(sd(inv.mydata)/mean(inv.mydata))*sqrt((n+1)/(n-1))/sqrt(3)
a.hat<-abs(ifelse(cons<1,-log(2)/log(1-cons),-log(2)/log(1-.98)))
b.hat<-median(inv.mydata)/(log(2))^(1/a.hat)
starts<-c(1,1,1,a.hat,1/b.hat,(min.mydata-1/length(y)))
if (location==FALSE){
den=function(par,x){a=par[4]; b=par[5]; (a*exp(-((x)/b)^(-a))*((x)/b)^(-a-1))/(b)}
cum=function(par,x){a=par[4]; b=par[5]; exp(-((x)/b)^(-a))}
starts<-c(1,1,1,a.hat,1/b.hat)
}}
if(g=="birnbaum-saunders"){
den=function(par,x){a=par[4]; b=par[5]; loc=par[6]; (sqrt((x-loc)/b)+sqrt(b/(x-loc)))/(2*a*(x-loc))*dnorm((sqrt((x-loc)/b)-sqrt(b/(x-loc)))/a)}
cum=function(par,x){a=par[4]; b=par[5]; loc=par[6]; pnorm((sqrt((x-loc)/b)-sqrt(b/(x-loc)))/a)}
r<-(mean(inv.mydata))^(-1)
b.hat<-sqrt(mean.mydata*r)
a.hat<-sqrt(2*(sqrt(mean.mydata/r)))
starts<-c(1,1,1,a.hat,b.hat,(min.mydata-1/length(y)))
if (location==FALSE){
den=function(par,x){a=par[4]; b=par[5]; (sqrt((x)/b)+sqrt(b/(x)))/(2*a*(x))*dnorm((sqrt((x)/b)-sqrt(b/(x)))/a)}
cum=function(par,x){a=par[4]; b=par[5]; pnorm((sqrt((x)/b)-sqrt(b/(x)))/a)}
starts<-c(1,1,1,a.hat,b.hat)
}}
if(g=="weibull"){
den=function(par,x){shape=par[4]; scale=par[5]; loc=par[6]; dweibull(x-loc,shape,scale)}
cum=function(par,x){shape=par[4]; scale=par[5]; loc=par[6]; pweibull(x-loc,shape,scale)}
cons<-cor(mydata,rank(mydata))*(std.mydata/mean.mydata)*sqrt((n+1)/(n-1))/sqrt(3)
a.hat<-abs(ifelse(cons<1,-log(2)/log(1-cons),-log(2)/log(1-.98)))
b.hat<-median.mydata/(log(2))^(1/a.hat)
starts<-c(1,1,1,a.hat,b.hat,(min.mydata-1/length(y)))
if (location==FALSE){
den=function(par,x){shape=par[4]; scale=par[5]; dweibull(x,shape,scale)}
cum=function(par,x){shape=par[4]; scale=par[5]; pweibull(x,shape,scale)}
starts<-c(1,1,1,a.hat,b.hat)
}}
if(g=="gamma"){
den=function(par,x){shape=par[4]; scale=par[5]; loc=par[6]; dgamma(x-loc,shape,scale)}
cum=function(par,x){shape=par[4]; scale=par[5]; loc=par[6]; pgamma(x-loc,shape,scale)}
a.hat<-uniroot(function(ss) trigamma(ss)-var(log(y)[is.finite(log(y))]),c(0,1000000))$root
b.hat<-mean.mydata/a.hat
starts<-c(1,1,1,a.hat,b.hat,(min.mydata-1/length(y)))
if (location==FALSE){
den=function(par,x){shape=par[4]; scale=par[5]; dgamma(x,shape,scale)}
cum=function(par,x){shape=par[4]; scale=par[5]; pgamma(x,shape,scale)}
starts<-c(1,1,1,a.hat,b.hat)
}}
pdf0<-function(par,x){
f0=den(par,x)
c0=cum(par,x)
a=par[1]
b=par[2]
d=par[3]
d*f0*beta(a,b)^(-1)*(1-c0)^(d*a-1)*(1-(1-c0)^d)^(b-1)}
cdf0<-function(par,x){
f0=den(par,x)
c0=cum(par,x)
a=par[1]
b=par[2]
d=par[3]
1-pbeta((1-c0)**d,shape1=a,shape2=b)}
mpsw<-function(par,x){
z=NULL
z=diff(c(0,cdf0(par,x),1))
for (j in 2:n){if((x[j]-x[j-1])==0){z[j]=pdf0(par,x[j])
}}
z[z<1e-16]=1e-16
-sum(log(z))
}
out<-suppressWarnings(optim(starts,fn=mpsw,x=sort.mydata,method))
n.p<-length(out$par)
if (location==TRUE){
out$par[1:(n.p-1)]<-abs(out$par[1:(n.p-1)])}
else{
out$par[1:n.p]<-abs(out$par[1:n.p])
}
gammam<-(n+1)*(log(n+1)-digamma(1))-1/2-1/(12*(n+1))
sigma2m<-(n+1)*(pi^2/6-1)-1/2-1/(6*(n+1))
c1<-gammam-sqrt(n*sigma2m/2)
c2<-sqrt(sigma2m/(2*n))
stat.chisquare<-(mpsw(out$par,sort.mydata)+n.p/2-c1)/c2
pvalue.chisquare<-pchisq(stat.chisquare,df=n,lower.tail=FALSE)
Moran<-out$value
log.likelihood=sum(log(pdf0(out$par,sort.mydata)))
u=cdf0(out$par,sort.mydata)
von<-c()
anderson<-c()
for(i in 1:n){
u[i]<-ifelse(u[i]==1,0.999999999,u[i])
von[i]=(u[i]-(2*i-1)/(2*n))^2
anderson[i]=(2*i-1)*log(u[i])+(2*n+1-2*i)*log(1-u[i])
}
anderson.stat=-n-mean(anderson)
von.stat=sum(von)+1/(12*n)
CAIC=-2*log.likelihood + 2*n.p + 2*(n.p*(n.p+1))/(n-n.p-1)
AIC=-2*log.likelihood + 2*n.p
BIC=-2*log.likelihood + n.p*log(n)
HQIC=-2*log.likelihood + 2*log(log(n))*n.p
ks.stat=suppressWarnings(ks.test(mydata, "cdf0", par=out$par))
aux2=cbind(AIC, CAIC, BIC, HQIC, von.stat, anderson.stat,log.likelihood,Moran)
colnames(aux2)=c("AIC","CAIC","BIC","HQIC","CM","AD", "log",
"Moran")
rownames(aux2)=c("")
aux3=cbind(ks.stat$statistic,ks.stat$p.value)
colnames(aux3)=c("statistic","p-value")
rownames(aux3)=c("")
aux4=cbind(stat.chisquare,qchisq(sig.level,df=n,lower.tail=FALSE),1-pchisq(stat.chisquare,df=n))
colnames(aux4)=c("statistic","chi-value","p-value")
rownames(aux4)=c("")
aux5=cbind(if(out$convergence==0){"Algorithm Converged"} else {"Algorithm Not Converged"})
list("MPS"=out$par,"Measures"=aux2,"KS"=aux3,"chi-square"=aux4,"Convergence Status"=aux5)
}
mpsbetag<-function(mydata, g, location=TRUE, method, sig.level){
min.mydata<-min(mydata)
sort.mydata<-sort(mydata)
n<-length(mydata)
y<-(sort.mydata[2:n]-min.mydata)
y<-(sort.mydata[2:n]-min.mydata)[is.finite(log(sort.mydata[2:n]-min.mydata))]
n<-length(mydata)
qp1<-y[floor(.25*n)]
qp3<-y[floor(.75*n)]
median.mydata<-y[floor(.5*n)]
mean.mydata<-mean(y)
inv.mydata<-1/y[is.finite(1/y)]
inv.mean<-mean(inv.mydata)
std.mydata<-sd(y)
if(g!="birnbaum-saunders" & g!="exp" & g!="rayleigh" & g!="weibull" & g!="gompertz" & g!="gamma"
& g!="log-normal" & g!="chisq" & g!="f" & g!="burrxii" & g!="frechet"
& g!="lomax" & g!="log-logistic" & g!="lfr" & g!="chen")
{ stop ("Baseline distribution not implemented or misspelled. Please check the manual for guidelines.") }
if(g=="log-normal"){
den=function(par,x){meanlog=par[3]; sdlog=par[4]; loc=par[5]; dlnorm(x-loc,meanlog,sdlog)}
cum=function(par,x){meanlog=par[3]; sdlog=par[4]; loc=par[5]; plnorm(x-loc,meanlog,sdlog)}
starts<-c(1,1,log(median.mydata),sqrt(2*abs(log(mean.mydata/median.mydata))),(min.mydata-1/length(y)))
if (location==FALSE){
den=function(par,x){meanlog=par[3]; sdlog=par[4]; dlnorm(x,meanlog,sdlog)}
cum=function(par,x){meanlog=par[3]; sdlog=par[4]; plnorm(x,meanlog,sdlog)}
starts<-c(1,1,log(median.mydata),sqrt(2*abs(log(mean.mydata/median.mydata))))
}}
if(g=="chisq"){
den=function(par,x){df=par[3]; loc=par[4]; dchisq(x-loc,df)}
cum=function(par,x){df=par[3]; loc=par[4]; pchisq(x-loc,df)}
starts<-c(1,1,mean.mydata,(min.mydata-1/length(y)))
if (location==FALSE){
den=function(par,x){df=par[3]; dchisq(x,df)}
cum=function(par,x){df=par[3]; pchisq(x,df)}
starts<-c(1,1,mean.mydata)
}}
if(g=="f"){
den=function(par,x){df1=par[3]; df2=par[4]; loc=par[5]; df(x-loc,df1,df2)}
cum=function(par,x){df1=par[3]; df2=par[4]; loc=par[5]; pf(x-loc,df1,df2)}
df.1<-ifelse(inv.mean>1,2*inv.mean/(inv.mean-1),1)
df.2<-ifelse(mean.mydata>1,2*mean.mydata/(mean.mydata-1),1)
starts<-c(1,1,df.1,df.2,(min.mydata-1/length(y)))
if (location==FALSE){
den=function(par,x){df1=par[3]; df2=par[4]; df(x,df1,df2)}
cum=function(par,x){df1=par[3]; df2=par[4]; pf(x,df1,df2)}
starts<-c(1,1,df.1,df.2)
}}
if(g=="chen"){
den=function(par,x){a=par[3]; b=par[4]; loc=par[5]; a*b*(x-loc)^(a-1)*exp((x-loc)^a)*exp(-b*(exp((x-loc)^a)-1))}
cum=function(par,x){a=par[3]; b=par[4]; loc=par[5]; 1-exp(-b*(exp((x-loc)^a)-1))}
standard.mydata<-(y-mean.mydata)/std.mydata
s.hat<-ifelse(max(standard.mydata)<=1,-log(1-n/(n+.4))/(exp(1)-1),-
log(1-length(standard.mydata[standard.mydata<=1])/length(standard.mydata))/(exp(1)-1))
r.hat<-abs(log(log(1-log(1-0.5)/s.hat))/log(median.mydata))
starts<-c(1,1,r.hat,s.hat,(min.mydata-1/length(y)))
if (location==FALSE){
den=function(par,x){a=par[3]; b=par[4]; a*b*(x)^(a-1)*exp((x)^a)*exp(-b*(exp((x)^a)-1))}
cum=function(par,x){a=par[3]; b=par[4]; 1-exp(-b*(exp((x)^a)-1))}
starts<-c(1,1,r.hat,s.hat)
}}
if(g=="lfr"){
den=function(par,x){a=par[3]; b=par[4]; loc=par[5]; (a+b*(x-loc))*exp(-a*(x-loc)-(b*(x-loc)^2)/2)}
cum=function(par,x){a=par[3]; b=par[4]; loc=par[5]; 1-exp(-a*(x-loc)-(b*(x-loc)^2)/2)}
ii<-seq(1,(n-1))
yy<--log(1-(ii+0.3)/(n-1+0.4))
res<-summary(lm(yy ~ -1+y+I(y^2)))$coefficient
coeff<-c(abs(res[1,1]),abs(res[2,1]))
z1=NULL;
lfr.log<-function(p) {
z1<--log(sum(p[1]+p[2]*y))+p[1]*sum(y)+p[2]/2*sum(y^2)
z1[z1<1e-16]<-1e-16
}
p.hat<-suppressWarnings(optim(c(abs(coeff[1]),2*abs(coeff[2])),lfr.log)$par)
starts<-c(1,1,p.hat[1],p.hat[2],(min.mydata-1/length(y)))
if (location==FALSE){
den=function(par,x){a=par[3]; b=par[4]; (a+b*(x))*exp(-a*(x)-(b*(x)^2)/2)}
cum=function(par,x){a=par[3]; b=par[4]; 1-exp(-a*(x)-(b*(x)^2)/2)}
starts<-c(1,1,p.hat[1],p.hat[2])
}}
if(g=="log-logistic"){
den=function(par,x){a=par[3]; b=par[4]; loc=par[5]; (a*b^(-a)*(x-loc)^(a-1))/((((x-loc)/b)^a +1)^2)}
cum=function(par,x){a=par[3]; b=par[4]; loc=par[5]; 1/(((x-loc)/b)^(-a)+1)}
starts<-c(1,1,log(0.75/(1-0.75))/log(qp3/median.mydata),median.mydata,(min.mydata-1/length(y)))
if (location==FALSE){
den=function(par,x){a=par[3]; b=par[4]; (a*b^(-a)*(x)^(a-1))/((((x)/b)^a +1)^2)}
cum=function(par,x){a=par[3]; b=par[4]; 1/(((x)/b)^(-a)+1)}
starts<-c(1,1,log(0.75/(1-0.75))/log(qp3/median.mydata),median.mydata)
}}
if(g=="lomax"){
den=function(par,x){a=par[3]; b=par[4]; loc=par[5]; (a*b)/((1+a*(x-loc))^(b+1))}
cum=function(par,x){a=par[3]; b=par[4]; loc=par[5]; 1-(1+a*(x-loc))^(-b)}
a.hat<-1
b.hat<-(.5^(-1/a.hat)-1)/median.mydata
z1=NULL;
lomax.log<-function(p) {
z1<--n*log(p[1])-n*log(p[2])+(p[2]+1)*sum(log(1+p[1]*y))
z1[z1<1e-16]<-1e-16
}
p.hat<-suppressWarnings(optim(c(1,b.hat),lomax.log, method)$par)
starts<-c(1,1,p.hat[1],p.hat[2],(min.mydata-1/length(y)))
if (location==FALSE){
den=function(par,x){a=par[3]; b=par[4]; (a*b)/((1+a*(x))^(b+1))}
cum=function(par,x){a=par[3]; b=par[4]; 1-(1+a*(x))^(-b)}
starts<-c(1,1,p.hat[1],p.hat[2])
}}
if(g=="gompertz"){
den=function(par,x){a=par[3]; b=par[4]; loc=par[5]; b*exp(a*(x-loc))*exp(-(exp(a*(x-loc))-1)*b/a)}
cum=function(par,x){a=par[3]; b=par[4]; loc=par[5]; 1-exp(-(exp(a*(x-loc))-1)*b/a)}
a.hat<-log(log(1-.75)/log(1-.5))/(qp3-median.mydata)
b.hat<--a.hat*log(0.5)/(exp(a.hat*median.mydata)-1)
z1=NULL;
gompertz.log<-function(p){
z1<--n*log(p[2])-p[1]*sum(y)+p[2]/p[1]*sum(exp(p[1]*y)-1)
z1[z1<1e-16]<-1e-16
}
p.hat<-suppressWarnings(optim(c(a.hat,b.hat),gompertz.log, method)$par)
starts<-c(1,1,p.hat[1],p.hat[2],(min.mydata-1/length(y)))
if (location==FALSE){
den=function(par,x){a=par[3]; b=par[4]; b*exp(a*(x))*exp(-(exp(a*(x))-1)*b/a)}
cum=function(par,x){a=par[3]; b=par[4]; 1-exp(-(exp(a*(x))-1)*b/a)}
starts<-c(1,1,p.hat[1],p.hat[2])
}}
if(g=="exp"){
den=function(par,x){rate=par[3]; loc=par[4]; dexp(x-loc,rate)}
cum=function(par,x){rate=par[3]; loc=par[4]; pexp(x-loc,rate)}
starts<-c(1,1,1/mean.mydata,(min.mydata-1/length(y)))
if (location==FALSE){
den=function(par,x){rate=par[3]; dexp(x,rate)}
cum=function(par,x){rate=par[3]; pexp(x,rate)}
starts<-c(1,1,1/mean.mydata)
}}
if(g=="rayleigh"){
den=function(par,x){a=par[3]; loc=par[4]; 2*(x-loc)/a*exp(-((x-loc)/a)^2)}
cum=function(par,x){a=par[3]; loc=par[4]; 1-exp(-((x-loc)/a)^2)}
starts<-c(1,1,log(2)/(median.mydata)^2,(min.mydata-1/length(y)))
if (location==FALSE){
den=function(par,x){a=par[3]; 2*x/a*exp(-(x/a)^2)}
cum=function(par,x){a=par[3]; 1-exp(-(x/a)^2)}
starts<-c(1,1,log(2)/(median.mydata)^2)
}}
if(g=="burrxii"){
den=function(par,x){a=par[3]; d=par[4]; loc=par[5]; d*a*(1+(x-loc)^d)^(-a-1)*((x-loc)^(d-1))}
cum=function(par,x){a=par[3]; d=par[4]; loc=par[5]; 1-(1+(x-loc)^d)^(-a)}
z1=NULL;
burrxii.log<-function(p){
z1<--n*log(p[1])-n*log(p[2])-(p[2]-1)*sum(log(y))+(p[1]+1)*sum(log(1+y^p[2]))
}
p.hat<-suppressWarnings(optim(c(1,1),burrxii.log, method="BFGS")$par)
starts<-c(1,1,p.hat[1],p.hat[2],(min.mydata-1/length(y)))
if (location==FALSE){
den=function(par,x){a=par[3]; d=par[4]; d*a*(1+(x)^d)^(-a-1)*((x)^(d-1))}
cum=function(par,x){a=par[3]; d=par[4]; 1-(1+(x)^d)^(-a)}
starts<-c(1,1,p.hat[1],p.hat[2])
}}
if(g=="frechet"){
den=function(par,x){a=par[3]; b=par[4]; loc=par[5]; (a*exp(-((x-loc)/b)^(-a))*((x-loc)/b)^(-a-1))/(b)}
cum=function(par,x){a=par[3]; b=par[4]; loc=par[5]; exp(-((x-loc)/b)^(-a))}
cons<-cor(inv.mydata,rank(inv.mydata))*(sd(inv.mydata)/mean(inv.mydata))*sqrt((n+1)/(n-1))/sqrt(3)
a.hat<-abs(ifelse(cons<1,-log(2)/log(1-cons),-log(2)/log(1-.98)))
b.hat<-median(inv.mydata)/(log(2))^(1/a.hat)
starts<-c(1,1,a.hat,1/b.hat,(min.mydata-1/length(y)))
if (location==FALSE){
den=function(par,x){a=par[3]; b=par[4]; (a*exp(-((x)/b)^(-a))*((x)/b)^(-a-1))/(b)}
cum=function(par,x){a=par[3]; b=par[4]; exp(-((x)/b)^(-a))}
starts<-c(1,1,a.hat,1/b.hat)
}}
if(g=="birnbaum-saunders"){
den=function(par,x){a=par[3]; b=par[4]; loc=par[5]; (sqrt((x-loc)/b)+sqrt(b/(x-loc)))/(2*a*(x-loc))*dnorm((sqrt((x-loc)/b)-sqrt(b/(x-loc)))/a)}
cum=function(par,x){a=par[3]; b=par[4]; loc=par[5]; pnorm((sqrt((x-loc)/b)-sqrt(b/(x-loc)))/a)}
r<-(mean(inv.mydata))^(-1)
b.hat<-sqrt(mean.mydata*r)
a.hat<-sqrt(2*(sqrt(mean.mydata/r)))
starts<-c(1,1,a.hat,b.hat,(min.mydata-1/length(y)))
if (location==FALSE){
den=function(par,x){a=par[3]; b=par[4]; (sqrt((x)/b)+sqrt(b/(x)))/(2*a*(x))*dnorm((sqrt((x)/b)-sqrt(b/(x)))/a)}
cum=function(par,x){a=par[3]; b=par[4]; pnorm((sqrt((x)/b)-sqrt(b/(x)))/a)}
starts<-c(1,1,a.hat,b.hat)
}}
if(g=="weibull"){
den=function(par,x){shape=par[3]; scale=par[4]; loc=par[5]; dweibull(x-loc,shape,scale)}
cum=function(par,x){shape=par[3]; scale=par[4]; loc=par[5]; pweibull(x-loc,shape,scale)}
cons<-cor(mydata,rank(mydata))*(std.mydata/mean.mydata)*sqrt((n+1)/(n-1))/sqrt(3)
a.hat<-abs(ifelse(cons<1,-log(2)/log(1-cons),-log(2)/log(1-.98)))
b.hat<-median.mydata/(log(2))^(1/a.hat)
starts<-c(1,1,a.hat,b.hat,(min.mydata-1/length(y)))
if (location==FALSE){
den=function(par,x){shape=par[3]; scale=par[4]; dweibull(x,shape,scale)}
cum=function(par,x){shape=par[3]; scale=par[4]; pweibull(x,shape,scale)}
starts<-c(1,1,a.hat,b.hat)
}}
if(g=="gamma"){
den=function(par,x){shape=par[3]; scale=par[4]; loc=par[5]; dgamma(x-loc,shape,scale)}
cum=function(par,x){shape=par[3]; scale=par[4]; loc=par[5]; pgamma(x-loc,shape,scale)}
a.hat<-uniroot(function(ss) trigamma(ss)-var(log(y)[is.finite(log(y))]),c(0,1000000))$root
b.hat<-mean.mydata/a.hat
starts<-c(1,1,a.hat,b.hat,(min.mydata-1/length(y)))
if (location==FALSE){
den=function(par,x){shape=par[3]; scale=par[4]; dgamma(x,shape,scale)}
cum=function(par,x){shape=par[3]; scale=par[4]; pgamma(x,shape,scale)}
starts<-c(1,1,a.hat,b.hat)
}}
pdf0<-function(par,x){
f0=den(par,x)
c0=cum(par,x)
a=par[1]
b=par[2]
f0*beta(a,b)^(-1)*c0^(a-1)*(1-c0)^(b-1)}
cdf0<-function(par,x){
c0=cum(par,x)
a=par[1]
b=par[2]
pbeta(c0,shape1=a,shape2=b)}
mpsw<-function(par,x){
z=NULL
z=diff(c(0,cdf0(par,x),1))
for (j in 2:n){if((x[j]-x[j-1])==0){z[j]=pdf0(par,x[j])
}}
z[z<1e-16]=1e-16
-sum(log(z))
}
out<-suppressWarnings(optim(starts,fn=mpsw,x=sort.mydata,method))
n.p<-length(out$par)
gammam<-(n+1)*(log(n+1)-digamma(1))-1/2-1/(12*(n+1))
sigma2m<-(n+1)*(pi^2/6-1)-1/2-1/(6*(n+1))
c1<-gammam-sqrt(n*sigma2m/2)
c2<-sqrt(sigma2m/(2*n))
stat.chisquare<-(mpsw(out$par,sort.mydata)+n.p/2-c1)/c2
pvalue.chisquare<-pchisq(stat.chisquare,df=n,lower.tail=FALSE)
Moran<-out$value
log.likelihood=sum(log(pdf0(out$par,sort.mydata)))
u=cdf0(out$par,sort.mydata)
von<-c()
anderson<-c()
for(i in 1:n){
u[i]<-ifelse(u[i]==1,0.999999999,u[i])
von[i]=(u[i]-(2*i-1)/(2*n))^2
anderson[i]=(2*i-1)*log(u[i])+(2*n+1-2*i)*log(1-u[i])
}
anderson.stat=-n-mean(anderson)
von.stat=sum(von)+1/(12*n)
CAIC=-2*log.likelihood + 2*n.p + 2*(n.p*(n.p+1))/(n-n.p-1)
AIC=-2*log.likelihood + 2*n.p
BIC=-2*log.likelihood + n.p*log(n)
HQIC=-2*log.likelihood + 2*log(log(n))*n.p
ks.stat=suppressWarnings(ks.test(mydata, "cdf0", par=out$par))
aux2=cbind(AIC, CAIC, BIC, HQIC, von.stat, anderson.stat,log.likelihood,Moran)
colnames(aux2)=c("AIC","CAIC","BIC","HQIC","CM","AD", "log", "Moran")
rownames(aux2)=c("")
aux3=cbind(ks.stat$statistic,ks.stat$p.value)
colnames(aux3)=c("statistic","p-value")
rownames(aux3)=c("")
aux4=cbind(stat.chisquare,qchisq(sig.level,df=n,lower.tail=FALSE),1-pchisq(stat.chisquare,df=n))
colnames(aux4)=c("statistic","chi-value","p-value")
rownames(aux4)=c("")
aux5=cbind(if(out$convergence==0){"Algorithm Converged"} else {"Algorithm Not Converged"})
list("MPS"=out$par,"Measures"=aux2,"KS"=aux3,"chi-square"=aux4,"Convergence Status"=aux5)
}
mpsexpexppg<-function(mydata, g, location=TRUE, method , sig.level){
min.mydata<-min(mydata)
sort.mydata<-sort(mydata)
n<-length(mydata)
y<-(sort.mydata[2:n]-min.mydata)
y<-(sort.mydata[2:n]-min.mydata)[is.finite(log(sort.mydata[2:n]-min.mydata))]
n<-length(mydata)
qp1<-y[floor(.25*n)]
qp3<-y[floor(.75*n)]
median.mydata<-y[floor(.5*n)]
mean.mydata<-mean(y)
inv.mydata<-1/y[is.finite(1/y)]
inv.mean<-mean(inv.mydata)
std.mydata<-sd(y)
if(g!="birnbaum-saunders" & g!="exp" & g!="rayleigh" & g!="weibull" & g!="gompertz" & g!="gamma"
& g!="log-normal" & g!="chisq" & g!="f" & g!="burrxii" & g!="frechet"
& g!="lomax" & g!="log-logistic" & g!="lfr" & g!="chen")
{ stop ("Baseline distribution not implemented or misspelled. Please check the manual for guidelines.") }
if(g=="log-normal"){
den=function(par,x){meanlog=par[3]; sdlog=par[4]; loc=par[5]; dlnorm(x-loc,meanlog,sdlog)}
cum=function(par,x){meanlog=par[3]; sdlog=par[4]; loc=par[5]; plnorm(x-loc,meanlog,sdlog)}
starts<-c(1,1,log(median.mydata),sqrt(2*abs(log(mean.mydata/median.mydata))),(min.mydata-1/length(y)))
if (location==FALSE){
den=function(par,x){meanlog=par[3]; sdlog=par[4]; dlnorm(x,meanlog,sdlog)}
cum=function(par,x){meanlog=par[3]; sdlog=par[4]; plnorm(x,meanlog,sdlog)}
starts<-c(1,1,log(median.mydata),sqrt(2*abs(log(mean.mydata/median.mydata))))
}}
if(g=="chisq"){
den=function(par,x){df=par[3]; loc=par[4]; dchisq(x-loc,df)}
cum=function(par,x){df=par[3]; loc=par[4]; pchisq(x-loc,df)}
starts<-c(1,1,mean.mydata,(min.mydata-1/length(y)))
if (location==FALSE){
den=function(par,x){df=par[3]; dchisq(x,df)}
cum=function(par,x){df=par[3]; pchisq(x,df)}
starts<-c(1,1,mean.mydata)
}}
if(g=="f"){
den=function(par,x){df1=par[3]; df2=par[4]; loc=par[5]; df(x-loc,df1,df2)}
cum=function(par,x){df1=par[3]; df2=par[4]; loc=par[5]; pf(x-loc,df1,df2)}
df.1<-ifelse(inv.mean>1,2*inv.mean/(inv.mean-1),1)
df.2<-ifelse(mean.mydata>1,2*mean.mydata/(mean.mydata-1),1)
starts<-c(1,1,df.1,df.2,(min.mydata-1/length(y)))
if (location==FALSE){
den=function(par,x){df1=par[3]; df2=par[4]; df(x,df1,df2)}
cum=function(par,x){df1=par[3]; df2=par[4]; pf(x,df1,df2)}
starts<-c(1,1,df.1,df.2)
}}
if(g=="chen"){
den=function(par,x){a=par[3]; b=par[4]; loc=par[5]; a*b*(x-loc)^(a-1)*exp((x-loc)^a)*exp(-b*(exp((x-loc)^a)-1))}
cum=function(par,x){a=par[3]; b=par[4]; loc=par[5]; 1-exp(-b*(exp((x-loc)^a)-1))}
standard.mydata<-(y-mean.mydata)/std.mydata
s.hat<-ifelse(max(standard.mydata)<=1,-log(1-n/(n+.4))/(exp(1)-1),-
log(1-length(standard.mydata[standard.mydata<=1])/length(standard.mydata))/(exp(1)-1))
r.hat<-abs(log(log(1-log(1-0.5)/s.hat))/log(median.mydata))
starts<-c(1,1,r.hat,s.hat,(min.mydata-1/length(y)))
if (location==FALSE){
den=function(par,x){a=par[3]; b=par[4]; a*b*(x)^(a-1)*exp((x)^a)*exp(-b*(exp((x)^a)-1))}
cum=function(par,x){a=par[3]; b=par[4]; 1-exp(-b*(exp((x)^a)-1))}
starts<-c(1,1,r.hat,s.hat)
}}
if(g=="lfr"){
den=function(par,x){a=par[3]; b=par[4]; loc=par[5]; (a+b*(x-loc))*exp(-a*(x-loc)-(b*(x-loc)^2)/2)}
cum=function(par,x){a=par[3]; b=par[4]; loc=par[5]; 1-exp(-a*(x-loc)-(b*(x-loc)^2)/2)}
ii<-seq(1,(n-1))
yy<--log(1-(ii+0.3)/(n-1+0.4))
res<-summary(lm(yy ~ -1+y+I(y^2)))$coefficient
coeff<-c(abs(res[1,1]),abs(res[2,1]))
z1=NULL;
lfr.log<-function(p) {
z1<--log(sum(p[1]+p[2]*y))+p[1]*sum(y)+p[2]/2*sum(y^2)
z1[z1<1e-16]<-1e-16
}
p.hat<-suppressWarnings(optim(c(abs(coeff[1]),2*abs(coeff[2])),lfr.log)$par)
starts<-c(1,1,p.hat[1],p.hat[2],(min.mydata-1/length(y)))
if (location==FALSE){
den=function(par,x){a=par[3]; b=par[4]; (a+b*(x))*exp(-a*(x)-(b*(x)^2)/2)}
cum=function(par,x){a=par[3]; b=par[4]; 1-exp(-a*(x)-(b*(x)^2)/2)}
starts<-c(1,1,p.hat[1],p.hat[2])
}}
if(g=="log-logistic"){
den=function(par,x){a=par[3]; b=par[4]; loc=par[5]; (a*b^(-a)*(x-loc)^(a-1))/((((x-loc)/b)^a +1)^2)}
cum=function(par,x){a=par[3]; b=par[4]; loc=par[5]; 1/(((x-loc)/b)^(-a)+1)}
starts<-c(1,1,log(0.75/(1-0.75))/log(qp3/median.mydata),median.mydata,(min.mydata-1/length(y)))
if (location==FALSE){
den=function(par,x){a=par[3]; b=par[4]; (a*b^(-a)*(x)^(a-1))/((((x)/b)^a +1)^2)}
cum=function(par,x){a=par[3]; b=par[4]; 1/(((x)/b)^(-a)+1)}
starts<-c(1,1,log(0.75/(1-0.75))/log(qp3/median.mydata),median.mydata)
}}
if(g=="lomax"){
den=function(par,x){a=par[3]; b=par[4]; loc=par[5]; (a*b)/((1+a*(x-loc))^(b+1))}
cum=function(par,x){a=par[3]; b=par[4]; loc=par[5]; 1-(1+a*(x-loc))^(-b)}
a.hat<-1
b.hat<-(.5^(-1/a.hat)-1)/median.mydata
z1=NULL;
lomax.log<-function(p) {
z1<--n*log(p[1])-n*log(p[2])+(p[2]+1)*sum(log(1+p[1]*y))
z1[z1<1e-16]<-1e-16
}
p.hat<-suppressWarnings(optim(c(1,b.hat),lomax.log, method)$par)
starts<-c(1,1,p.hat[1],p.hat[2],(min.mydata-1/length(y)))
if (location==FALSE){
den=function(par,x){a=par[3]; b=par[4]; (a*b)/((1+a*(x))^(b+1))}
cum=function(par,x){a=par[3]; b=par[4]; 1-(1+a*(x))^(-b)}
starts<-c(1,1,p.hat[1],p.hat[2])
}}
if(g=="gompertz"){
den=function(par,x){a=par[3]; b=par[4]; loc=par[5]; b*exp(a*(x-loc))*exp(-(exp(a*(x-loc))-1)*b/a)}
cum=function(par,x){a=par[3]; b=par[4]; loc=par[5]; 1-exp(-(exp(a*(x-loc))-1)*b/a)}
a.hat<-log(log(1-.75)/log(1-.5))/(qp3-median.mydata)
b.hat<--a.hat*log(0.5)/(exp(a.hat*median.mydata)-1)
z1=NULL;
gompertz.log<-function(p){
z1<--n*log(p[2])-p[1]*sum(y)+p[2]/p[1]*sum(exp(p[1]*y)-1)
z1[z1<1e-16]<-1e-16
}
p.hat<-suppressWarnings(optim(c(a.hat,b.hat),gompertz.log, method)$par)
starts<-c(1,1,p.hat[1],p.hat[2],(min.mydata-1/length(y)))
if (location==FALSE){
den=function(par,x){a=par[3]; b=par[4]; b*exp(a*(x))*exp(-(exp(a*(x))-1)*b/a)}
cum=function(par,x){a=par[3]; b=par[4]; 1-exp(-(exp(a*(x))-1)*b/a)}
starts<-c(1,1,p.hat[1],p.hat[2])
}}
if(g=="exp"){
den=function(par,x){rate=par[3]; loc=par[4]; dexp(x-loc,rate)}
cum=function(par,x){rate=par[3]; loc=par[4]; pexp(x-loc,rate)}
starts<-c(1,1,1/mean.mydata,(min.mydata-1/length(y)))
if (location==FALSE){
den=function(par,x){rate=par[3]; dexp(x,rate)}
cum=function(par,x){rate=par[3]; pexp(x,rate)}
starts<-c(1,1,1/mean.mydata)
}}
if(g=="rayleigh"){
den=function(par,x){a=par[3]; loc=par[4]; 2*(x-loc)/a*exp(-((x-loc)/a)^2)}
cum=function(par,x){a=par[3]; loc=par[4]; 1-exp(-((x-loc)/a)^2)}
starts<-c(1,1,log(2)/(median.mydata)^2,(min.mydata-1/length(y)))
if (location==FALSE){
den=function(par,x){a=par[3]; 2*x/a*exp(-(x/a)^2)}
cum=function(par,x){a=par[3]; 1-exp(-(x/a)^2)}
starts<-c(1,1,log(2)/(median.mydata)^2)
}}
if(g=="burrxii"){
den=function(par,x){a=par[3]; d=par[4]; loc=par[5]; d*a*(1+(x-loc)^d)^(-a-1)*((x-loc)^(d-1))}
cum=function(par,x){a=par[3]; d=par[4]; loc=par[5]; 1-(1+(x-loc)^d)^(-a)}
z1=NULL;
burrxii.log<-function(p){
z1<--n*log(p[1])-n*log(p[2])-(p[2]-1)*sum(log(y))+(p[1]+1)*sum(log(1+y^p[2]))
}
p.hat<-suppressWarnings(optim(c(1,1),burrxii.log, method="BFGS")$par)
starts<-c(1,1,p.hat[1],p.hat[2],(min.mydata-1/length(y)))
if (location==FALSE){
den=function(par,x){a=par[3]; d=par[4]; d*a*(1+(x)^d)^(-a-1)*((x)^(d-1))}
cum=function(par,x){a=par[3]; d=par[4]; 1-(1+(x)^d)^(-a)}
starts<-c(1,1,p.hat[1],p.hat[2])
}}
if(g=="frechet"){
den=function(par,x){a=par[3]; b=par[4]; loc=par[5]; (a*exp(-((x-loc)/b)^(-a))*((x-loc)/b)^(-a-1))/(b)}
cum=function(par,x){a=par[3]; b=par[4]; loc=par[5]; exp(-((x-loc)/b)^(-a))}
cons<-cor(inv.mydata,rank(inv.mydata))*(sd(inv.mydata)/mean(inv.mydata))*sqrt((n+1)/(n-1))/sqrt(3)
a.hat<-abs(ifelse(cons<1,-log(2)/log(1-cons),-log(2)/log(1-.98)))
b.hat<-median(inv.mydata)/(log(2))^(1/a.hat)
starts<-c(1,1,a.hat,1/b.hat,(min.mydata-1/length(y)))
if (location==FALSE){
den=function(par,x){a=par[3]; b=par[4]; (a*exp(-((x)/b)^(-a))*((x)/b)^(-a-1))/(b)}
cum=function(par,x){a=par[3]; b=par[4]; exp(-((x)/b)^(-a))}
starts<-c(1,1,a.hat,1/b.hat)
}}
if(g=="birnbaum-saunders"){
den=function(par,x){a=par[3]; b=par[4]; loc=par[5]; (sqrt((x-loc)/b)+sqrt(b/(x-loc)))/(2*a*(x-loc))*dnorm((sqrt((x-loc)/b)-sqrt(b/(x-loc)))/a)}
cum=function(par,x){a=par[3]; b=par[4]; loc=par[5]; pnorm((sqrt((x-loc)/b)-sqrt(b/(x-loc)))/a)}
r<-(mean(inv.mydata))^(-1)
b.hat<-sqrt(mean.mydata*r)
a.hat<-sqrt(2*(sqrt(mean.mydata/r)))
starts<-c(1,1,a.hat,b.hat,(min.mydata-1/length(y)))
if (location==FALSE){
den=function(par,x){a=par[3]; b=par[4]; (sqrt((x)/b)+sqrt(b/(x)))/(2*a*(x))*dnorm((sqrt((x)/b)-sqrt(b/(x)))/a)}
cum=function(par,x){a=par[3]; b=par[4]; pnorm((sqrt((x)/b)-sqrt(b/(x)))/a)}
starts<-c(1,1,a.hat,b.hat)
}}
if(g=="weibull"){
den=function(par,x){shape=par[3]; scale=par[4]; loc=par[5]; dweibull(x-loc,shape,scale)}
cum=function(par,x){shape=par[3]; scale=par[4]; loc=par[5]; pweibull(x-loc,shape,scale)}
cons<-cor(mydata,rank(mydata))*(std.mydata/mean.mydata)*sqrt((n+1)/(n-1))/sqrt(3)
a.hat<-abs(ifelse(cons<1,-log(2)/log(1-cons),-log(2)/log(1-.98)))
b.hat<-median.mydata/(log(2))^(1/a.hat)
starts<-c(1,1,a.hat,b.hat,(min.mydata-1/length(y)))
if (location==FALSE){
den=function(par,x){shape=par[3]; scale=par[4]; dweibull(x,shape,scale)}
cum=function(par,x){shape=par[3]; scale=par[4]; pweibull(x,shape,scale)}
starts<-c(1,1,a.hat,b.hat)
}}
if(g=="gamma"){
den=function(par,x){shape=par[3]; scale=par[4]; loc=par[5]; dgamma(x-loc,shape,scale)}
cum=function(par,x){shape=par[3]; scale=par[4]; loc=par[5]; pgamma(x-loc,shape,scale)}
a.hat<-uniroot(function(ss) trigamma(ss)-var(log(y)[is.finite(log(y))]),c(0,1000000))$root
b.hat<-mean.mydata/a.hat
starts<-c(1,1,a.hat,b.hat,(min.mydata-1/length(y)))
if (location==FALSE){
den=function(par,x){shape=par[3]; scale=par[4]; dgamma(x,shape,scale)}
cum=function(par,x){shape=par[3]; scale=par[4]; pgamma(x,shape,scale)}
starts<-c(1,1,a.hat,b.hat)
}}
pdf0<-function(par,x){
f0=den(par,x)
c0=cum(par,x)
a=par[1]
b=par[2]
a*b*(1-exp(-b))^(-1)*f0*c0^(a-1)*exp(-b*c0^a)}
cdf0<-function(par,x){
f0=den(par,x)
c0=cum(par,x)
a=par[1]
b=par[2]
(1-exp(-b))^(-1)*(1-exp(-b*c0^a))}
mpsw<-function(par,x){
z=NULL
z=diff(c(0,cdf0(par,x),1))
for (j in 2:n){if((x[j]-x[j-1])==0){z[j]=pdf0(par,x[j])
}}
z[z<1e-16]=1e-16
-sum(log(z))
}
out<-suppressWarnings(optim(starts,fn=mpsw,x=sort.mydata,method))
n.p<-length(out$par)
gammam<-(n+1)*(log(n+1)-digamma(1))-1/2-1/(12*(n+1))
sigma2m<-(n+1)*(pi^2/6-1)-1/2-1/(6*(n+1))
c1<-gammam-sqrt(n*sigma2m/2)
c2<-sqrt(sigma2m/(2*n))
stat.chisquare<-(mpsw(out$par,sort.mydata)+n.p/2-c1)/c2
pvalue.chisquare<-pchisq(stat.chisquare,df=n,lower.tail=FALSE)
Moran<-out$value
log.likelihood=sum(log(pdf0(out$par,sort.mydata)))
u=cdf0(out$par,sort.mydata)
von<-c()
anderson<-c()
for(i in 1:n){
u[i]<-ifelse(u[i]==1,0.999999999,u[i])
von[i]=(u[i]-(2*i-1)/(2*n))^2
anderson[i]=(2*i-1)*log(u[i])+(2*n+1-2*i)*log(1-u[i])
}
anderson.stat=-n-mean(anderson)
von.stat=sum(von)+1/(12*n)
CAIC=-2*log.likelihood + 2*n.p + 2*(n.p*(n.p+1))/(n-n.p-1)
AIC=-2*log.likelihood + 2*n.p
BIC=-2*log.likelihood + n.p*log(n)
HQIC=-2*log.likelihood + 2*log(log(n))*n.p
ks.stat=suppressWarnings(ks.test(mydata, "cdf0", par=out$par))
aux2=cbind(AIC, CAIC, BIC, HQIC, von.stat, anderson.stat,log.likelihood,Moran)
colnames(aux2)=c("AIC","CAIC","BIC","HQIC","CM","AD", "log",
"Moran")
rownames(aux2)=c("")
aux3=cbind(ks.stat$statistic,ks.stat$p.value)
colnames(aux3)=c("statistic","p-value")
rownames(aux3)=c("")
aux4=cbind(stat.chisquare,qchisq(sig.level,df=n,lower.tail=FALSE),1-pchisq(stat.chisquare,df=n))
colnames(aux4)=c("statistic","chi-value","p-value")
rownames(aux4)=c("")
aux5=cbind(if(out$convergence==0){"Algorithm Converged"} else {"Algorithm Not Converged"})
list("MPS"=out$par,"Measures"=aux2,"KS"=aux3,"chi-square"=aux4,"Convergence Status"=aux5)
}
mpsexpgg<-function(mydata, g, location=TRUE, method , sig.level){
min.mydata<-min(mydata)
sort.mydata<-sort(mydata)
n<-length(mydata)
y<-(sort.mydata[2:n]-min.mydata)
y<-(sort.mydata[2:n]-min.mydata)[is.finite(log(sort.mydata[2:n]-min.mydata))]
n<-length(mydata)
qp1<-y[floor(.25*n)]
qp3<-y[floor(.75*n)]
median.mydata<-y[floor(.5*n)]
mean.mydata<-mean(y)
inv.mydata<-1/y[is.finite(1/y)]
inv.mean<-mean(inv.mydata)
std.mydata<-sd(y)
if(g!="birnbaum-saunders" & g!="exp" & g!="rayleigh" & g!="weibull" & g!="gompertz" & g!="gamma"
& g!="log-normal" & g!="chisq" & g!="f" & g!="burrxii" & g!="frechet"
& g!="lomax" & g!="log-logistic" & g!="lfr" & g!="chen")
{ stop ("Baseline distribution not implemented or misspelled. Please check the manual for guidelines.") }
if(g=="log-normal"){
den=function(par,x){meanlog=par[3]; sdlog=par[4]; loc=par[5]; dlnorm(x-loc,meanlog,sdlog)}
cum=function(par,x){meanlog=par[3]; sdlog=par[4]; loc=par[5]; plnorm(x-loc,meanlog,sdlog)}
starts<-c(1,1,log(median.mydata),sqrt(2*abs(log(mean.mydata/median.mydata))),(min.mydata-1/length(y)))
if (location==FALSE){
den=function(par,x){meanlog=par[3]; sdlog=par[4]; dlnorm(x,meanlog,sdlog)}
cum=function(par,x){meanlog=par[3]; sdlog=par[4]; plnorm(x,meanlog,sdlog)}
starts<-c(1,1,log(median.mydata),sqrt(2*abs(log(mean.mydata/median.mydata))))
}}
if(g=="chisq"){
den=function(par,x){df=par[3]; loc=par[4]; dchisq(x-loc,df)}
cum=function(par,x){df=par[3]; loc=par[4]; pchisq(x-loc,df)}
starts<-c(1,1,mean.mydata,(min.mydata-1/length(y)))
if (location==FALSE){
den=function(par,x){df=par[3]; dchisq(x,df)}
cum=function(par,x){df=par[3]; pchisq(x,df)}
starts<-c(1,1,mean.mydata)
}}
if(g=="f"){
den=function(par,x){df1=par[3]; df2=par[4]; loc=par[5]; df(x-loc,df1,df2)}
cum=function(par,x){df1=par[3]; df2=par[4]; loc=par[5]; pf(x-loc,df1,df2)}
df.1<-ifelse(inv.mean>1,2*inv.mean/(inv.mean-1),1)
df.2<-ifelse(mean.mydata>1,2*mean.mydata/(mean.mydata-1),1)
starts<-c(1,1,df.1,df.2,(min.mydata-1/length(y)))
if (location==FALSE){
den=function(par,x){df1=par[3]; df2=par[4]; df(x,df1,df2)}
cum=function(par,x){df1=par[3]; df2=par[4]; pf(x,df1,df2)}
starts<-c(1,1,df.1,df.2)
}}
if(g=="chen"){
den=function(par,x){a=par[3]; b=par[4]; loc=par[5]; a*b*(x-loc)^(a-1)*exp((x-loc)^a)*exp(-b*(exp((x-loc)^a)-1))}
cum=function(par,x){a=par[3]; b=par[4]; loc=par[5]; 1-exp(-b*(exp((x-loc)^a)-1))}
standard.mydata<-(y-mean.mydata)/std.mydata
s.hat<-ifelse(max(standard.mydata)<=1,-log(1-n/(n+.4))/(exp(1)-1),-
log(1-length(standard.mydata[standard.mydata<=1])/length(standard.mydata))/(exp(1)-1))
r.hat<-abs(log(log(1-log(1-0.5)/s.hat))/log(median.mydata))
starts<-c(1,1,r.hat,s.hat,(min.mydata-1/length(y)))
if (location==FALSE){
den=function(par,x){a=par[3]; b=par[4]; a*b*(x)^(a-1)*exp((x)^a)*exp(-b*(exp((x)^a)-1))}
cum=function(par,x){a=par[3]; b=par[4]; 1-exp(-b*(exp((x)^a)-1))}
starts<-c(1,1,r.hat,s.hat)
}}
if(g=="lfr"){
den=function(par,x){a=par[3]; b=par[4]; loc=par[5]; (a+b*(x-loc))*exp(-a*(x-loc)-(b*(x-loc)^2)/2)}
cum=function(par,x){a=par[3]; b=par[4]; loc=par[5]; 1-exp(-a*(x-loc)-(b*(x-loc)^2)/2)}
ii<-seq(1,(n-1))
yy<--log(1-(ii+0.3)/(n-1+0.4))
res<-summary(lm(yy ~ -1+y+I(y^2)))$coefficient
coeff<-c(abs(res[1,1]),abs(res[2,1]))
z1=NULL;
lfr.log<-function(p) {
z1<--log(sum(p[1]+p[2]*y))+p[1]*sum(y)+p[2]/2*sum(y^2)
z1[z1<1e-16]<-1e-16
}
p.hat<-suppressWarnings(optim(c(abs(coeff[1]),2*abs(coeff[2])),lfr.log)$par)
starts<-c(1,1,p.hat[1],p.hat[2],(min.mydata-1/length(y)))
if (location==FALSE){
den=function(par,x){a=par[3]; b=par[4]; (a+b*(x))*exp(-a*(x)-(b*(x)^2)/2)}
cum=function(par,x){a=par[3]; b=par[4]; 1-exp(-a*(x)-(b*(x)^2)/2)}
starts<-c(1,1,p.hat[1],p.hat[2])
}}
if(g=="log-logistic"){
den=function(par,x){a=par[3]; b=par[4]; loc=par[5]; (a*b^(-a)*(x-loc)^(a-1))/((((x-loc)/b)^a +1)^2)}
cum=function(par,x){a=par[3]; b=par[4]; loc=par[5]; 1/(((x-loc)/b)^(-a)+1)}
starts<-c(1,1,log(0.75/(1-0.75))/log(qp3/median.mydata),median.mydata,(min.mydata-1/length(y)))
if (location==FALSE){
den=function(par,x){a=par[3]; b=par[4]; (a*b^(-a)*(x)^(a-1))/((((x)/b)^a +1)^2)}
cum=function(par,x){a=par[3]; b=par[4]; 1/(((x)/b)^(-a)+1)}
starts<-c(1,1,log(0.75/(1-0.75))/log(qp3/median.mydata),median.mydata)
}}
if(g=="lomax"){
den=function(par,x){a=par[3]; b=par[4]; loc=par[5]; (a*b)/((1+a*(x-loc))^(b+1))}
cum=function(par,x){a=par[3]; b=par[4]; loc=par[5]; 1-(1+a*(x-loc))^(-b)}
a.hat<-1
b.hat<-(.5^(-1/a.hat)-1)/median.mydata
z1=NULL;
lomax.log<-function(p) {
z1<--n*log(p[1])-n*log(p[2])+(p[2]+1)*sum(log(1+p[1]*y))
z1[z1<1e-16]<-1e-16
}
p.hat<-suppressWarnings(optim(c(1,b.hat),lomax.log, method)$par)
starts<-c(1,1,p.hat[1],p.hat[2],(min.mydata-1/length(y)))
if (location==FALSE){
den=function(par,x){a=par[3]; b=par[4]; (a*b)/((1+a*(x))^(b+1))}
cum=function(par,x){a=par[3]; b=par[4]; 1-(1+a*(x))^(-b)}
starts<-c(1,1,p.hat[1],p.hat[2])
}}
if(g=="gompertz"){
den=function(par,x){a=par[3]; b=par[4]; loc=par[5]; b*exp(a*(x-loc))*exp(-(exp(a*(x-loc))-1)*b/a)}
cum=function(par,x){a=par[3]; b=par[4]; loc=par[5]; 1-exp(-(exp(a*(x-loc))-1)*b/a)}
a.hat<-log(log(1-.75)/log(1-.5))/(qp3-median.mydata)
b.hat<--a.hat*log(0.5)/(exp(a.hat*median.mydata)-1)
z1=NULL;
gompertz.log<-function(p){
z1<--n*log(p[2])-p[1]*sum(y)+p[2]/p[1]*sum(exp(p[1]*y)-1)
z1[z1<1e-16]<-1e-16
}
p.hat<-suppressWarnings(optim(c(a.hat,b.hat),gompertz.log, method)$par)
starts<-c(1,1,p.hat[1],p.hat[2],(min.mydata-1/length(y)))
if (location==FALSE){
den=function(par,x){a=par[3]; b=par[4]; b*exp(a*(x))*exp(-(exp(a*(x))-1)*b/a)}
cum=function(par,x){a=par[3]; b=par[4]; 1-exp(-(exp(a*(x))-1)*b/a)}
starts<-c(1,1,p.hat[1],p.hat[2])
}}
if(g=="exp"){
den=function(par,x){rate=par[3]; loc=par[4]; dexp(x-loc,rate)}
cum=function(par,x){rate=par[3]; loc=par[4]; pexp(x-loc,rate)}
starts<-c(1,1,1/mean.mydata,(min.mydata-1/length(y)))
if (location==FALSE){
den=function(par,x){rate=par[3]; dexp(x,rate)}
cum=function(par,x){rate=par[3]; pexp(x,rate)}
starts<-c(1,1,1/mean.mydata)
}}
if(g=="rayleigh"){
den=function(par,x){a=par[3]; loc=par[4]; 2*(x-loc)/a*exp(-((x-loc)/a)^2)}
cum=function(par,x){a=par[3]; loc=par[4]; 1-exp(-((x-loc)/a)^2)}
starts<-c(1,1,log(2)/(median.mydata)^2,(min.mydata-1/length(y)))
if (location==FALSE){
den=function(par,x){a=par[3]; 2*x/a*exp(-(x/a)^2)}
cum=function(par,x){a=par[3]; 1-exp(-(x/a)^2)}
starts<-c(1,1,log(2)/(median.mydata)^2)
}}
if(g=="burrxii"){
den=function(par,x){a=par[3]; d=par[4]; loc=par[5]; d*a*(1+(x-loc)^d)^(-a-1)*((x-loc)^(d-1))}
cum=function(par,x){a=par[3]; d=par[4]; loc=par[5]; 1-(1+(x-loc)^d)^(-a)}
z1=NULL;
burrxii.log<-function(p){
z1<--n*log(p[1])-n*log(p[2])-(p[2]-1)*sum(log(y))+(p[1]+1)*sum(log(1+y^p[2]))
}
p.hat<-suppressWarnings(optim(c(1,1),burrxii.log, method="BFGS")$par)
starts<-c(1,1,p.hat[1],p.hat[2],(min.mydata-1/length(y)))
if (location==FALSE){
den=function(par,x){a=par[3]; d=par[4]; d*a*(1+(x)^d)^(-a-1)*((x)^(d-1))}
cum=function(par,x){a=par[3]; d=par[4]; 1-(1+(x)^d)^(-a)}
starts<-c(1,1,p.hat[1],p.hat[2])
}}
if(g=="frechet"){
den=function(par,x){a=par[3]; b=par[4]; loc=par[5]; (a*exp(-((x-loc)/b)^(-a))*((x-loc)/b)^(-a-1))/(b)}
cum=function(par,x){a=par[3]; b=par[4]; loc=par[5]; exp(-((x-loc)/b)^(-a))}
cons<-cor(inv.mydata,rank(inv.mydata))*(sd(inv.mydata)/mean(inv.mydata))*sqrt((n+1)/(n-1))/sqrt(3)
a.hat<-abs(ifelse(cons<1,-log(2)/log(1-cons),-log(2)/log(1-.98)))
b.hat<-median(inv.mydata)/(log(2))^(1/a.hat)
starts<-c(1,1,a.hat,1/b.hat,(min.mydata-1/length(y)))
if (location==FALSE){
den=function(par,x){a=par[3]; b=par[4]; (a*exp(-((x)/b)^(-a))*((x)/b)^(-a-1))/(b)}
cum=function(par,x){a=par[3]; b=par[4]; exp(-((x)/b)^(-a))}
starts<-c(1,1,a.hat,1/b.hat)
}}
if(g=="birnbaum-saunders"){
den=function(par,x){a=par[3]; b=par[4]; loc=par[5]; (sqrt((x-loc)/b)+sqrt(b/(x-loc)))/(2*a*(x-loc))*dnorm((sqrt((x-loc)/b)-sqrt(b/(x-loc)))/a)}
cum=function(par,x){a=par[3]; b=par[4]; loc=par[5]; pnorm((sqrt((x-loc)/b)-sqrt(b/(x-loc)))/a)}
r<-(mean(inv.mydata))^(-1)
b.hat<-sqrt(mean.mydata*r)
a.hat<-sqrt(2*(sqrt(mean.mydata/r)))
starts<-c(1,1,a.hat,b.hat,(min.mydata-1/length(y)))
if (location==FALSE){
den=function(par,x){a=par[3]; b=par[4]; (sqrt((x)/b)+sqrt(b/(x)))/(2*a*(x))*dnorm((sqrt((x)/b)-sqrt(b/(x)))/a)}
cum=function(par,x){a=par[3]; b=par[4]; pnorm((sqrt((x)/b)-sqrt(b/(x)))/a)}
starts<-c(1,1,a.hat,b.hat)
}}
if(g=="weibull"){
den=function(par,x){shape=par[3]; scale=par[4]; loc=par[5]; dweibull(x-loc,shape,scale)}
cum=function(par,x){shape=par[3]; scale=par[4]; loc=par[5]; pweibull(x-loc,shape,scale)}
cons<-cor(mydata,rank(mydata))*(std.mydata/mean.mydata)*sqrt((n+1)/(n-1))/sqrt(3)
a.hat<-abs(ifelse(cons<1,-log(2)/log(1-cons),-log(2)/log(1-.98)))
b.hat<-median.mydata/(log(2))^(1/a.hat)
starts<-c(1,1,a.hat,b.hat,(min.mydata-1/length(y)))
if (location==FALSE){
den=function(par,x){shape=par[3]; scale=par[4]; dweibull(x,shape,scale)}
cum=function(par,x){shape=par[3]; scale=par[4]; pweibull(x,shape,scale)}
starts<-c(1,1,a.hat,b.hat)
}}
if(g=="gamma"){
den=function(par,x){shape=par[3]; scale=par[4]; loc=par[5]; dgamma(x-loc,shape,scale)}
cum=function(par,x){shape=par[3]; scale=par[4]; loc=par[5]; pgamma(x-loc,shape,scale)}
a.hat<-uniroot(function(ss) trigamma(ss)-var(log(y)[is.finite(log(y))]),c(0,1000000))$root
b.hat<-mean.mydata/a.hat
starts<-c(1,1,a.hat,b.hat,(min.mydata-1/length(y)))
if (location==FALSE){
den=function(par,x){shape=par[3]; scale=par[4]; dgamma(x,shape,scale)}
cum=function(par,x){shape=par[3]; scale=par[4]; pgamma(x,shape,scale)}
starts<-c(1,1,a.hat,b.hat)
}}
pdf0<-function(par,x){
f0=den(par,x)
c0=cum(par,x)
r=par[1]
u=par[2]
r*u*f0*((1-c0)^(r-1))*(1-(1-c0)^r)^(u-1)
}
cdf0<-function(par,x){
f0=den(par,x)
c0=cum(par,x)
r=par[1]
u=par[2]
(1-(1-c0)^r)^u
}
mpsw<-function(par,x){
z=NULL
z=diff(c(0,cdf0(par,x),1))
for (j in 2:n){if((x[j]-x[j-1])==0){z[j]=pdf0(par,x[j])
}}
z[z<1e-16]=1e-16
-sum(log(z))
}
out<-suppressWarnings(optim(starts,fn=mpsw,x=sort.mydata,method))
n.p<-length(out$par)
gammam<-(n+1)*(log(n+1)-digamma(1))-1/2-1/(12*(n+1))
sigma2m<-(n+1)*(pi^2/6-1)-1/2-1/(6*(n+1))
c1<-gammam-sqrt(n*sigma2m/2)
c2<-sqrt(sigma2m/(2*n))
stat.chisquare<-(mpsw(out$par,sort.mydata)+n.p/2-c1)/c2
pvalue.chisquare<-pchisq(stat.chisquare,df=n,lower.tail=FALSE)
Moran<-out$value
log.likelihood=sum(log(pdf0(out$par,sort.mydata)))
u=cdf0(out$par,sort.mydata)
von<-c()
anderson<-c()
for(i in 1:n){
u[i]<-ifelse(u[i]==1,0.999999999,u[i])
von[i]=(u[i]-(2*i-1)/(2*n))^2
anderson[i]=(2*i-1)*log(u[i])+(2*n+1-2*i)*log(1-u[i])
}
anderson.stat=-n-mean(anderson)
von.stat=sum(von)+1/(12*n)
CAIC=-2*log.likelihood + 2*n.p + 2*(n.p*(n.p+1))/(n-n.p-1)
AIC=-2*log.likelihood + 2*n.p
BIC=-2*log.likelihood + n.p*log(n)
HQIC=-2*log.likelihood + 2*log(log(n))*n.p
ks.stat=suppressWarnings(ks.test(mydata, "cdf0", par=out$par))
aux2=cbind(AIC, CAIC, BIC, HQIC, von.stat, anderson.stat,log.likelihood,Moran)
colnames(aux2)=c("AIC","CAIC","BIC","HQIC","CM","AD", "log",
"Moran")
rownames(aux2)=c("")
aux3=cbind(ks.stat$statistic,ks.stat$p.value)
colnames(aux3)=c("statistic","p-value")
rownames(aux3)=c("")
aux4=cbind(stat.chisquare,qchisq(sig.level,df=n,lower.tail=FALSE),1-pchisq(stat.chisquare,df=n))
colnames(aux4)=c("statistic","chi-value","p-value")
rownames(aux4)=c("")
aux5=cbind(if(out$convergence==0){"Algorithm Converged"} else {"Algorithm Not Converged"})
list("MPS"=out$par,"Measures"=aux2,"KS"=aux3,"chi-square"=aux4,"Convergence Status"=aux5)
}
mpsexpg<-function(mydata, g, location=TRUE, method , sig.level){
min.mydata<-min(mydata)
sort.mydata<-sort(mydata)
n<-length(mydata)
y<-(sort.mydata[2:n]-min.mydata)
y<-(sort.mydata[2:n]-min.mydata)[is.finite(log(sort.mydata[2:n]-min.mydata))]
n<-length(mydata)
qp1<-y[floor(.25*n)]
qp3<-y[floor(.75*n)]
median.mydata<-y[floor(.5*n)]
mean.mydata<-mean(y)
inv.mydata<-1/y[is.finite(1/y)]
inv.mean<-mean(inv.mydata)
std.mydata<-sd(y)
if(g!="birnbaum-saunders" & g!="exp" & g!="rayleigh" & g!="weibull" & g!="gompertz" & g!="gamma"
& g!="log-normal" & g!="chisq" & g!="f" & g!="burrxii" & g!="frechet"
& g!="lomax" & g!="log-logistic" & g!="lfr" & g!="chen")
{ stop ("Baseline distribution not implemented or misspelled. Please check the manual for guidelines.") }
if(g=="log-normal"){
den=function(par,x){meanlog=par[2]; sdlog=par[3]; loc=par[4]; dlnorm(x-loc,meanlog,sdlog)}
cum=function(par,x){meanlog=par[2]; sdlog=par[3]; loc=par[4]; plnorm(x-loc,meanlog,sdlog)}
starts<-c(1,log(median.mydata),sqrt(2*abs(log(mean.mydata/median.mydata))),(min.mydata-1/length(y)))
if (location==FALSE){
den=function(par,x){meanlog=par[2]; sdlog=par[3]; dlnorm(x,meanlog,sdlog)}
cum=function(par,x){meanlog=par[2]; sdlog=par[3]; plnorm(x,meanlog,sdlog)}
starts<-c(1,log(median.mydata),sqrt(2*abs(log(mean.mydata/median.mydata))))
}}
if(g=="chisq"){
den=function(par,x){df=par[2]; loc=par[3]; dchisq(x-loc,df)}
cum=function(par,x){df=par[2]; loc=par[3]; pchisq(x-loc,df)}
starts<-c(1,mean.mydata,(min.mydata-1/length(y)))
if (location==FALSE){
den=function(par,x){df=par[2]; dchisq(x,df)}
cum=function(par,x){df=par[2]; pchisq(x,df)}
starts<-c(1,mean.mydata)
}}
if(g=="f"){
den=function(par,x){df1=par[2]; df2=par[3]; loc=par[4]; df(x-loc,df1,df2)}
cum=function(par,x){df1=par[2]; df2=par[3]; loc=par[4]; pf(x-loc,df1,df2)}
df.1<-ifelse(inv.mean>1,2*inv.mean/(inv.mean-1),1)
df.2<-ifelse(mean.mydata>1,2*mean.mydata/(mean.mydata-1),1)
starts<-c(1,df.1,df.2,(min.mydata-1/length(y)))
if (location==FALSE){
den=function(par,x){df1=par[2]; df2=par[3]; df(x,df1,df2)}
cum=function(par,x){df1=par[2]; df2=par[3]; pf(x,df1,df2)}
starts<-c(1,df.1,df.2)
}}
if(g=="chen"){
den=function(par,x){a=par[2]; b=par[3]; loc=par[4]; a*b*(x-loc)^(a-1)*exp((x-loc)^a)*exp(-b*(exp((x-loc)^a)-1))}
cum=function(par,x){a=par[2]; b=par[3]; loc=par[4]; 1-exp(-b*(exp((x-loc)^a)-1))}
standard.mydata<-(y-mean.mydata)/std.mydata
s.hat<-ifelse(max(standard.mydata)<=1,-log(1-n/(n+.4))/(exp(1)-1),-
log(1-length(standard.mydata[standard.mydata<=1])/length(standard.mydata))/(exp(1)-1))
r.hat<-abs(log(log(1-log(1-0.5)/s.hat))/log(median.mydata))
starts<-c(1,r.hat,s.hat,(min.mydata-1/length(y)))
if (location==FALSE){
den=function(par,x){a=par[2]; b=par[3]; a*b*(x)^(a-1)*exp((x)^a)*exp(-b*(exp((x)^a)-1))}
cum=function(par,x){a=par[2]; b=par[3]; 1-exp(-b*(exp((x)^a)-1))}
starts<-c(1,r.hat,s.hat)
}}
if(g=="lfr"){
den=function(par,x){a=par[2]; b=par[3]; loc=par[4]; (a+b*(x-loc))*exp(-a*(x-loc)-(b*(x-loc)^2)/2)}
cum=function(par,x){a=par[2]; b=par[3]; loc=par[4]; 1-exp(-a*(x-loc)-(b*(x-loc)^2)/2)}
ii<-seq(1,(n-1))
yy<--log(1-(ii+0.3)/(n-1+0.4))
res<-summary(lm(yy ~ -1+y+I(y^2)))$coefficient
coeff<-c(abs(res[1,1]),abs(res[2,1]))
z1=NULL;
lfr.log<-function(p) {
z1<--log(sum(p[1]+p[2]*y))+p[1]*sum(y)+p[2]/2*sum(y^2)
z1[z1<1e-16]<-1e-16
}
p.hat<-suppressWarnings(optim(c(abs(coeff[1]),2*abs(coeff[2])),lfr.log)$par)
starts<-c(1,p.hat[1],p.hat[2],(min.mydata-1/length(y)))
if (location==FALSE){
den=function(par,x){a=par[2]; b=par[3]; (a+b*(x))*exp(-a*(x)-(b*(x)^2)/2)}
cum=function(par,x){a=par[2]; b=par[3]; 1-exp(-a*(x)-(b*(x)^2)/2)}
starts<-c(1,p.hat[1],p.hat[2])
}}
if(g=="log-logistic"){
den=function(par,x){a=par[2]; b=par[3]; loc=par[4]; (a*b^(-a)*(x-loc)^(a-1))/((((x-loc)/b)^a +1)^2)}
cum=function(par,x){a=par[2]; b=par[3]; loc=par[4]; 1/(((x-loc)/b)^(-a)+1)}
starts<-c(1,log(0.75/(1-0.75))/log(qp3/median.mydata),median.mydata,(min.mydata-1/length(y)))
if (location==FALSE){
den=function(par,x){a=par[2]; b=par[3]; (a*b^(-a)*(x)^(a-1))/((((x)/b)^a +1)^2)}
cum=function(par,x){a=par[2]; b=par[3]; 1/(((x)/b)^(-a)+1)}
starts<-c(1,log(0.75/(1-0.75))/log(qp3/median.mydata),median.mydata)
}}
if(g=="lomax"){
den=function(par,x){a=par[2]; b=par[3]; loc=par[4]; (a*b)/((1+a*(x-loc))^(b+1))}
cum=function(par,x){a=par[2]; b=par[3]; loc=par[4]; 1-(1+a*(x-loc))^(-b)}
a.hat<-1
b.hat<-(.5^(-1/a.hat)-1)/median.mydata
z1=NULL;
lomax.log<-function(p) {
z1<--n*log(p[1])-n*log(p[2])+(p[2]+1)*sum(log(1+p[1]*y))
z1[z1<1e-16]<-1e-16
}
p.hat<-suppressWarnings(optim(c(1,b.hat),lomax.log, method)$par)
starts<-c(1,p.hat[1],p.hat[2],(min.mydata-1/length(y)))
if (location==FALSE){
den=function(par,x){a=par[2]; b=par[3]; (a*b)/((1+a*(x))^(b+1))}
cum=function(par,x){a=par[2]; b=par[3]; 1-(1+a*(x))^(-b)}
starts<-c(1,p.hat[1],p.hat[2])
}}
if(g=="gompertz"){
den=function(par,x){a=par[2]; b=par[3]; loc=par[4]; b*exp(a*(x-loc))*exp(-(exp(a*(x-loc))-1)*b/a)}
cum=function(par,x){a=par[2]; b=par[3]; loc=par[4]; 1-exp(-(exp(a*(x-loc))-1)*b/a)}
a.hat<-log(log(1-.75)/log(1-.5))/(qp3-median.mydata)
b.hat<--a.hat*log(0.5)/(exp(a.hat*median.mydata)-1)
z1=NULL;
gompertz.log<-function(p){
z1<--n*log(p[2])-p[1]*sum(y)+p[2]/p[1]*sum(exp(p[1]*y)-1)
z1[z1<1e-16]<-1e-16
}
p.hat<-suppressWarnings(optim(c(a.hat,b.hat),gompertz.log, method)$par)
starts<-c(1,p.hat[1],p.hat[2],(min.mydata-1/length(y)))
if (location==FALSE){
den=function(par,x){a=par[2]; b=par[3]; b*exp(a*(x))*exp(-(exp(a*(x))-1)*b/a)}
cum=function(par,x){a=par[2]; b=par[3]; 1-exp(-(exp(a*(x))-1)*b/a)}
starts<-c(1,p.hat[1],p.hat[2])
}}
if(g=="exp"){
den=function(par,x){rate=par[2]; loc=par[3]; dexp(x-loc,rate)}
cum=function(par,x){rate=par[2]; loc=par[3]; pexp(x-loc,rate)}
starts<-c(1,1/mean.mydata,(min.mydata-1/length(y)))
if (location==FALSE){
den=function(par,x){rate=par[2]; dexp(x,rate)}
cum=function(par,x){rate=par[2]; pexp(x,rate)}
starts<-c(1,1/mean.mydata)
}}
if(g=="rayleigh"){
den=function(par,x){a=par[2]; loc=par[3]; 2*(x-loc)/a*exp(-((x-loc)/a)^2)}
cum=function(par,x){a=par[2]; loc=par[3]; 1-exp(-((x-loc)/a)^2)}
starts<-c(1,log(2)/(median.mydata)^2,(min.mydata-1/length(y)))
if (location==FALSE){
den=function(par,x){a=par[2]; 2*x/a*exp(-(x/a)^2)}
cum=function(par,x){a=par[2]; 1-exp(-(x/a)^2)}
starts<-c(1,log(2)/(median.mydata)^2)
}}
if(g=="burrxii"){
den=function(par,x){a=par[2]; d=par[3]; loc=par[4]; d*a*(1+(x-loc)^d)^(-a-1)*((x-loc)^(d-1))}
cum=function(par,x){a=par[2]; d=par[3]; loc=par[4]; 1-(1+(x-loc)^d)^(-a)}
z1=NULL;
burrxii.log<-function(p){
z1<--n*log(p[1])-n*log(p[2])-(p[2]-1)*sum(log(y))+(p[1]+1)*sum(log(1+y^p[2]))
}
p.hat<-suppressWarnings(optim(c(1,1),burrxii.log, method="BFGS")$par)
starts<-c(1,p.hat[1],p.hat[2],(min.mydata-1/length(y)))
if (location==FALSE){
den=function(par,x){a=par[2]; d=par[3]; d*a*(1+(x)^d)^(-a-1)*((x)^(d-1))}
cum=function(par,x){a=par[2]; d=par[3]; 1-(1+(x)^d)^(-a)}
starts<-c(1,p.hat[1],p.hat[2])
}}
if(g=="frechet"){
den=function(par,x){a=par[2]; b=par[3]; loc=par[4]; (a*exp(-((x-loc)/b)^(-a))*((x-loc)/b)^(-a-1))/(b)}
cum=function(par,x){a=par[2]; b=par[3]; loc=par[4]; exp(-((x-loc)/b)^(-a))}
cons<-cor(inv.mydata,rank(inv.mydata))*(sd(inv.mydata)/mean(inv.mydata))*sqrt((n+1)/(n-1))/sqrt(3)
a.hat<-abs(ifelse(cons<1,-log(2)/log(1-cons),-log(2)/log(1-.98)))
b.hat<-median(inv.mydata)/(log(2))^(1/a.hat)
starts<-c(1,a.hat,1/b.hat,(min.mydata-1/length(y)))
if (location==FALSE){
den=function(par,x){a=par[2]; b=par[3]; (a*exp(-((x)/b)^(-a))*((x)/b)^(-a-1))/(b)}
cum=function(par,x){a=par[2]; b=par[3]; exp(-((x)/b)^(-a))}
starts<-c(1,a.hat,1/b.hat)
}}
if(g=="birnbaum-saunders"){
den=function(par,x){a=par[2]; b=par[3]; loc=par[4]; (sqrt((x-loc)/b)+sqrt(b/(x-loc)))/(2*a*(x-loc))*dnorm((sqrt((x-loc)/b)-sqrt(b/(x-loc)))/a)}
cum=function(par,x){a=par[2]; b=par[3]; loc=par[4]; pnorm((sqrt((x-loc)/b)-sqrt(b/(x-loc)))/a)}
r<-(mean(inv.mydata))^(-1)
b.hat<-sqrt(mean.mydata*r)
a.hat<-sqrt(2*(sqrt(mean.mydata/r)))
starts<-c(1,a.hat,b.hat,(min.mydata-1/length(y)))
if (location==FALSE){
den=function(par,x){a=par[2]; b=par[3]; (sqrt((x)/b)+sqrt(b/(x)))/(2*a*(x))*dnorm((sqrt((x)/b)-sqrt(b/(x)))/a)}
cum=function(par,x){a=par[2]; b=par[3]; pnorm((sqrt((x)/b)-sqrt(b/(x)))/a)}
starts<-c(1,a.hat,b.hat)
}}
if(g=="weibull"){
den=function(par,x){shape=par[2]; scale=par[3]; loc=par[4]; dweibull(x-loc,shape,scale)}
cum=function(par,x){shape=par[2]; scale=par[3]; loc=par[4]; pweibull(x-loc,shape,scale)}
cons<-cor(mydata,rank(mydata))*(std.mydata/mean.mydata)*sqrt((n+1)/(n-1))/sqrt(3)
a.hat<-abs(ifelse(cons<1,-log(2)/log(1-cons),-log(2)/log(1-.98)))
b.hat<-median.mydata/(log(2))^(1/a.hat)
starts<-c(1,a.hat,b.hat,(min.mydata-1/length(y)))
if (location==FALSE){
den=function(par,x){shape=par[2]; scale=par[3]; dweibull(x,shape,scale)}
cum=function(par,x){shape=par[2]; scale=par[3]; pweibull(x,shape,scale)}
starts<-c(1,a.hat,b.hat)
}}
if(g=="gamma"){
den=function(par,x){shape=par[2]; scale=par[3]; loc=par[4]; dgamma(x-loc,shape,scale)}
cum=function(par,x){shape=par[2]; scale=par[3]; loc=par[4]; pgamma(x-loc,shape,scale)}
a.hat<-uniroot(function(ss) trigamma(ss)-var(log(y)[is.finite(log(y))]),c(0,1000000))$root
b.hat<-mean.mydata/a.hat
starts<-c(1,a.hat,b.hat,(min.mydata-1/length(y)))
if (location==FALSE){
den=function(par,x){shape=par[2]; scale=par[3]; dgamma(x,shape,scale)}
cum=function(par,x){shape=par[2]; scale=par[3]; pgamma(x,shape,scale)}
starts<-c(1,a.hat,b.hat)
}}
pdf0<-function(par,x){
f0=den(par,x)
c0=cum(par,x)
a=par[1]
a*f0*c0^(a-1)
}
cdf0<-function(par,x){
f0=den(par,x)
c0=cum(par,x)
a=par[1]
c0^a
}
mpsw<-function(par,x){
z=NULL
z=diff(c(0,cdf0(par,x),1))
for (j in 2:n){if((x[j]-x[j-1])==0){z[j]=pdf0(par,x[j])
}}
z[z<1e-16]=1e-16
-sum(log(z))
}
out<-suppressWarnings(optim(starts,fn=mpsw,x=sort.mydata,method))
n.p<-length(out$par)
gammam<-(n+1)*(log(n+1)-digamma(1))-1/2-1/(12*(n+1))
sigma2m<-(n+1)*(pi^2/6-1)-1/2-1/(6*(n+1))
c1<-gammam-sqrt(n*sigma2m/2)
c2<-sqrt(sigma2m/(2*n))
stat.chisquare<-(mpsw(out$par,sort.mydata)+n.p/2-c1)/c2
pvalue.chisquare<-pchisq(stat.chisquare,df=n,lower.tail=FALSE)
Moran<-out$value
log.likelihood=sum(log(pdf0(out$par,sort.mydata)))
u=cdf0(out$par,sort.mydata)
von<-c()
anderson<-c()
for(i in 1:n){
u[i]<-ifelse(u[i]==1,0.999999999,u[i])
von[i]=(u[i]-(2*i-1)/(2*n))^2
anderson[i]=(2*i-1)*log(u[i])+(2*n+1-2*i)*log(1-u[i])
}
anderson.stat=-n-mean(anderson)
von.stat=sum(von)+1/(12*n)
CAIC=-2*log.likelihood + 2*n.p + 2*(n.p*(n.p+1))/(n-n.p-1)
AIC=-2*log.likelihood + 2*n.p
BIC=-2*log.likelihood + n.p*log(n)
HQIC=-2*log.likelihood + 2*log(log(n))*n.p
ks.stat=suppressWarnings(ks.test(mydata, "cdf0", par=out$par))
aux2=cbind(AIC, CAIC, BIC, HQIC, von.stat, anderson.stat,log.likelihood,Moran)
colnames(aux2)=c("AIC","CAIC","BIC","HQIC","CM","AD", "log",
"Moran")
rownames(aux2)=c("")
aux3=cbind(ks.stat$statistic,ks.stat$p.value)
colnames(aux3)=c("statistic","p-value")
rownames(aux3)=c("")
aux4=cbind(stat.chisquare,qchisq(sig.level,df=n,lower.tail=FALSE),1-pchisq(stat.chisquare,df=n))
colnames(aux4)=c("statistic","chi-value","p-value")
rownames(aux4)=c("")
aux5=cbind(if(out$convergence==0){"Algorithm Converged"} else {"Algorithm Not Converged"})
list("MPS"=out$par,"Measures"=aux2,"KS"=aux3,"chi-square"=aux4,"Convergence Status"=aux5)
}
mpsexpkumg<-function(mydata, g, location=TRUE, method , sig.level){
min.mydata<-min(mydata)
sort.mydata<-sort(mydata)
n<-length(mydata)
y<-(sort.mydata[2:n]-min.mydata)
y<-(sort.mydata[2:n]-min.mydata)[is.finite(log(sort.mydata[2:n]-min.mydata))]
n<-length(mydata)
qp1<-y[floor(.25*n)]
qp3<-y[floor(.75*n)]
median.mydata<-y[floor(.5*n)]
mean.mydata<-mean(y)
inv.mydata<-1/y[is.finite(1/y)]
inv.mean<-mean(inv.mydata)
std.mydata<-sd(y)
if(g!="birnbaum-saunders" & g!="exp" & g!="rayleigh" & g!="weibull" & g!="gompertz" & g!="gamma"
& g!="log-normal" & g!="chisq" & g!="f" & g!="burrxii" & g!="frechet"
& g!="lomax" & g!="log-logistic" & g!="lfr" & g!="chen")
{ stop ("Baseline distribution not implemented or misspelled. Please check the manual for guidelines.") }
if(g=="log-normal"){
den=function(par,x){meanlog=par[4]; sdlog=par[5]; loc=par[6]; dlnorm(x-loc,meanlog,sdlog)}
cum=function(par,x){meanlog=par[4]; sdlog=par[5]; loc=par[6]; plnorm(x-loc,meanlog,sdlog)}
starts<-c(1,1,1,log(median.mydata),sqrt(2*abs(log(mean.mydata/median.mydata))),(min.mydata-1/length(y)))
if (location==FALSE){
den=function(par,x){meanlog=par[4]; sdlog=par[5]; dlnorm(x,meanlog,sdlog)}
cum=function(par,x){meanlog=par[4]; sdlog=par[5]; plnorm(x,meanlog,sdlog)}
starts<-c(1,1,1,log(median.mydata),sqrt(2*abs(log(mean.mydata/median.mydata))))
}}
if(g=="chisq"){
den=function(par,x){df=par[4]; loc=par[5]; dchisq(x-loc,df)}
cum=function(par,x){df=par[4]; loc=par[5]; pchisq(x-loc,df)}
starts<-c(1,1,1,mean.mydata,(min.mydata-1/length(y)))
if (location==FALSE){
den=function(par,x){df=par[4]; dchisq(x,df)}
cum=function(par,x){df=par[4]; pchisq(x,df)}
starts<-c(1,1,1,mean.mydata)
}}
if(g=="f"){
den=function(par,x){df1=par[4]; df2=par[5]; loc=par[6]; df(x-loc,df1,df2)}
cum=function(par,x){df1=par[4]; df2=par[5]; loc=par[6]; pf(x-loc,df1,df2)}
df.1<-ifelse(inv.mean>1,2*inv.mean/(inv.mean-1),1)
df.2<-ifelse(mean.mydata>1,2*mean.mydata/(mean.mydata-1),1)
starts<-c(1,1,1,df.1,df.2,(min.mydata-1/length(y)))
if (location==FALSE){
den=function(par,x){df1=par[4]; df2=par[5]; df(x,df1,df2)}
cum=function(par,x){df1=par[4]; df2=par[5]; pf(x,df1,df2)}
starts<-c(1,1,1,df.1,df.2)
}}
if(g=="chen"){
den=function(par,x){a=par[4]; b=par[5]; loc=par[6]; a*b*(x-loc)^(a-1)*exp((x-loc)^a)*exp(-b*(exp((x-loc)^a)-1))}
cum=function(par,x){a=par[4]; b=par[5]; loc=par[6]; 1-exp(-b*(exp((x-loc)^a)-1))}
standard.mydata<-(y-mean.mydata)/std.mydata
s.hat<-ifelse(max(standard.mydata)<=1,-log(1-n/(n+.4))/(exp(1)-1),-
log(1-length(standard.mydata[standard.mydata<=1])/length(standard.mydata))/(exp(1)-1))
r.hat<-abs(log(log(1-log(1-0.5)/s.hat))/log(median.mydata))
starts<-c(1,1,1,r.hat,s.hat,(min.mydata-1/length(y)))
if (location==FALSE){
den=function(par,x){a=par[4]; b=par[5]; a*b*(x)^(a-1)*exp((x)^a)*exp(-b*(exp((x)^a)-1))}
cum=function(par,x){a=par[4]; b=par[5]; 1-exp(-b*(exp((x)^a)-1))}
starts<-c(1,1,1,r.hat,s.hat)
}}
if(g=="lfr"){
den=function(par,x){a=par[4]; b=par[5]; loc=par[6]; (a+b*(x-loc))*exp(-a*(x-loc)-(b*(x-loc)^2)/2)}
cum=function(par,x){a=par[4]; b=par[5]; loc=par[6]; 1-exp(-a*(x-loc)-(b*(x-loc)^2)/2)}
ii<-seq(1,(n-1))
yy<--log(1-(ii+0.3)/(n-1+0.4))
res<-summary(lm(yy ~ -1+y+I(y^2)))$coefficient
coeff<-c(abs(res[1,1]),abs(res[2,1]))
z1=NULL;
lfr.log<-function(p) {
z1<--log(sum(p[1]+p[2]*y))+p[1]*sum(y)+p[2]/2*sum(y^2)
z1[z1<1e-16]<-1e-16
}
p.hat<-suppressWarnings(optim(c(abs(coeff[1]),2*abs(coeff[2])),lfr.log)$par)
starts<-c(1,1,1,p.hat[1],p.hat[2],(min.mydata-1/length(y)))
if (location==FALSE){
den=function(par,x){a=par[4]; b=par[5]; (a+b*(x))*exp(-a*(x)-(b*(x)^2)/2)}
cum=function(par,x){a=par[4]; b=par[5]; 1-exp(-a*(x)-(b*(x)^2)/2)}
starts<-c(1,1,1,p.hat[1],p.hat[2])
}}
if(g=="log-logistic"){
den=function(par,x){a=par[4]; b=par[5]; loc=par[6]; (a*b^(-a)*(x-loc)^(a-1))/((((x-loc)/b)^a +1)^2)}
cum=function(par,x){a=par[4]; b=par[5]; loc=par[6]; 1/(((x-loc)/b)^(-a)+1)}
starts<-c(1,1,1,log(0.75/(1-0.75))/log(qp3/median.mydata),median.mydata,(min.mydata-1/length(y)))
if (location==FALSE){
den=function(par,x){a=par[4]; b=par[5]; (a*b^(-a)*(x)^(a-1))/((((x)/b)^a +1)^2)}
cum=function(par,x){a=par[4]; b=par[5]; 1/(((x)/b)^(-a)+1)}
starts<-c(1,1,1,log(0.75/(1-0.75))/log(qp3/median.mydata),median.mydata)
}}
if(g=="lomax"){
den=function(par,x){a=par[4]; b=par[5]; loc=par[6]; (a*b)/((1+a*(x-loc))^(b+1))}
cum=function(par,x){a=par[4]; b=par[5]; loc=par[6]; 1-(1+a*(x-loc))^(-b)}
a.hat<-1
b.hat<-(.5^(-1/a.hat)-1)/median.mydata
z1=NULL;
lomax.log<-function(p) {
z1<--n*log(p[1])-n*log(p[2])+(p[2]+1)*sum(log(1+p[1]*y))
z1[z1<1e-16]<-1e-16
}
p.hat<-suppressWarnings(optim(c(1,b.hat),lomax.log, method)$par)
starts<-c(1,1,1,p.hat[1],p.hat[2],(min.mydata-1/length(y)))
if (location==FALSE){
den=function(par,x){a=par[4]; b=par[5]; (a*b)/((1+a*(x))^(b+1))}
cum=function(par,x){a=par[4]; b=par[5]; 1-(1+a*(x))^(-b)}
starts<-c(1,1,1,p.hat[1],p.hat[2])
}}
if(g=="gompertz"){
den=function(par,x){a=par[4]; b=par[5]; loc=par[6]; b*exp(a*(x-loc))*exp(-(exp(a*(x-loc))-1)*b/a)}
cum=function(par,x){a=par[4]; b=par[5]; loc=par[6]; 1-exp(-(exp(a*(x-loc))-1)*b/a)}
a.hat<-log(log(1-.75)/log(1-.5))/(qp3-median.mydata)
b.hat<--a.hat*log(0.5)/(exp(a.hat*median.mydata)-1)
z1=NULL;
gompertz.log<-function(p){
z1<--n*log(p[2])-p[1]*sum(y)+p[2]/p[1]*sum(exp(p[1]*y)-1)
z1[z1<1e-16]<-1e-16
}
p.hat<-suppressWarnings(optim(c(a.hat,b.hat),gompertz.log, method)$par)
starts<-c(1,1,1,p.hat[1],p.hat[2],(min.mydata-1/length(y)))
if (location==FALSE){
den=function(par,x){a=par[4]; b=par[5]; b*exp(a*(x))*exp(-(exp(a*(x))-1)*b/a)}
cum=function(par,x){a=par[4]; b=par[5]; 1-exp(-(exp(a*(x))-1)*b/a)}
starts<-c(1,1,1,p.hat[1],p.hat[2])
}}
if(g=="exp"){
den=function(par,x){rate=par[4]; loc=par[5]; dexp(x-loc,rate)}
cum=function(par,x){rate=par[4]; loc=par[5]; pexp(x-loc,rate)}
starts<-c(1,1,1,1/mean.mydata,(min.mydata-1/length(y)))
if (location==FALSE){
den=function(par,x){rate=par[4]; dexp(x,rate)}
cum=function(par,x){rate=par[4]; pexp(x,rate)}
starts<-c(1,1,1,1/mean.mydata)
}}
if(g=="rayleigh"){
den=function(par,x){a=par[4]; loc=par[5]; 2*(x-loc)/a*exp(-((x-loc)/a)^2)}
cum=function(par,x){a=par[4]; loc=par[5]; 1-exp(-((x-loc)/a)^2)}
starts<-c(1,1,1,log(2)/(median.mydata)^2,(min.mydata-1/length(y)))
if (location==FALSE){
den=function(par,x){a=par[4]; 2*x/a*exp(-(x/a)^2)}
cum=function(par,x){a=par[4]; 1-exp(-(x/a)^2)}
starts<-c(1,1,1,log(2)/(median.mydata)^2)
}}
if(g=="burrxii"){
den=function(par,x){a=par[4]; d=par[5]; loc=par[6]; d*a*(1+(x-loc)^d)^(-a-1)*((x-loc)^(d-1))}
cum=function(par,x){a=par[4]; d=par[5]; loc=par[6]; 1-(1+(x-loc)^d)^(-a)}
z1=NULL;
burrxii.log<-function(p){
z1<--n*log(p[1])-n*log(p[2])-(p[2]-1)*sum(log(y))+(p[1]+1)*sum(log(1+y^p[2]))
}
p.hat<-suppressWarnings(optim(c(1,1),burrxii.log, method="BFGS")$par)
starts<-c(1,1,1,p.hat[1],p.hat[2],(min.mydata-1/length(y)))
if (location==FALSE){
den=function(par,x){a=par[4]; d=par[5]; d*a*(1+(x)^d)^(-a-1)*((x)^(d-1))}
cum=function(par,x){a=par[4]; d=par[5]; 1-(1+(x)^d)^(-a)}
starts<-c(1,1,1,p.hat[1],p.hat[2])
}}
if(g=="frechet"){
den=function(par,x){a=par[4]; b=par[5]; loc=par[6]; (a*exp(-((x-loc)/b)^(-a))*((x-loc)/b)^(-a-1))/(b)}
cum=function(par,x){a=par[4]; b=par[5]; loc=par[6]; exp(-((x-loc)/b)^(-a))}
cons<-cor(inv.mydata,rank(inv.mydata))*(sd(inv.mydata)/mean(inv.mydata))*sqrt((n+1)/(n-1))/sqrt(3)
a.hat<-abs(ifelse(cons<1,-log(2)/log(1-cons),-log(2)/log(1-.98)))
b.hat<-median(inv.mydata)/(log(2))^(1/a.hat)
starts<-c(1,1,1,a.hat,1/b.hat,(min.mydata-1/length(y)))
if (location==FALSE){
den=function(par,x){a=par[4]; b=par[5]; (a*exp(-((x)/b)^(-a))*((x)/b)^(-a-1))/(b)}
cum=function(par,x){a=par[4]; b=par[5]; exp(-((x)/b)^(-a))}
starts<-c(1,1,1,a.hat,1/b.hat)
}}
if(g=="birnbaum-saunders"){
den=function(par,x){a=par[4]; b=par[5]; loc=par[6]; (sqrt((x-loc)/b)+sqrt(b/(x-loc)))/(2*a*(x-loc))*dnorm((sqrt((x-loc)/b)-sqrt(b/(x-loc)))/a)}
cum=function(par,x){a=par[4]; b=par[5]; loc=par[6]; pnorm((sqrt((x-loc)/b)-sqrt(b/(x-loc)))/a)}
r<-(mean(inv.mydata))^(-1)
b.hat<-sqrt(mean.mydata*r)
a.hat<-sqrt(2*(sqrt(mean.mydata/r)))
starts<-c(1,1,1,a.hat,b.hat,(min.mydata-1/length(y)))
if (location==FALSE){
den=function(par,x){a=par[4]; b=par[5]; (sqrt((x)/b)+sqrt(b/(x)))/(2*a*(x))*dnorm((sqrt((x)/b)-sqrt(b/(x)))/a)}
cum=function(par,x){a=par[4]; b=par[5]; pnorm((sqrt((x)/b)-sqrt(b/(x)))/a)}
starts<-c(1,1,1,a.hat,b.hat)
}}
if(g=="weibull"){
den=function(par,x){shape=par[4]; scale=par[5]; loc=par[6]; dweibull(x-loc,shape,scale)}
cum=function(par,x){shape=par[4]; scale=par[5]; loc=par[6]; pweibull(x-loc,shape,scale)}
cons<-cor(mydata,rank(mydata))*(std.mydata/mean.mydata)*sqrt((n+1)/(n-1))/sqrt(3)
a.hat<-abs(ifelse(cons<1,-log(2)/log(1-cons),-log(2)/log(1-.98)))
b.hat<-median.mydata/(log(2))^(1/a.hat)
starts<-c(1,1,1,a.hat,b.hat,(min.mydata-1/length(y)))
if (location==FALSE){
den=function(par,x){shape=par[4]; scale=par[5]; dweibull(x,shape,scale)}
cum=function(par,x){shape=par[4]; scale=par[5]; pweibull(x,shape,scale)}
starts<-c(1,1,1,a.hat,b.hat)
}}
if(g=="gamma"){
den=function(par,x){shape=par[4]; scale=par[5]; loc=par[6]; dgamma(x-loc,shape,scale)}
cum=function(par,x){shape=par[4]; scale=par[5]; loc=par[6]; pgamma(x-loc,shape,scale)}
a.hat<-uniroot(function(ss) trigamma(ss)-var(log(y)[is.finite(log(y))]),c(0,1000000))$root
b.hat<-mean.mydata/a.hat
starts<-c(1,1,1,a.hat,b.hat,(min.mydata-1/length(y)))
if (location==FALSE){
den=function(par,x){shape=par[4]; scale=par[5]; dgamma(x,shape,scale)}
cum=function(par,x){shape=par[4]; scale=par[5]; pgamma(x,shape,scale)}
starts<-c(1,1,1,a.hat,b.hat)
}}
pdf0<-function(par,x){
f0=den(par,x)
c0=cum(par,x)
a=par[1]
b=par[2]
d=par[3]
a*b*d*f0*c0^(a-1)*(1-c0^a)^(b-1)*(1-(1-c0^a)^b)^(d-1)
}
cdf0<-function(par,x){
f0=den(par,x)
c0=cum(par,x)
a=par[1]
b=par[2]
d=par[3]
(1-(1-c0^a)^b)^d
}
mpsw<-function(par,x){
z=NULL
z=diff(c(0,cdf0(par,x),1))
for (j in 2:n){if((x[j]-x[j-1])==0){z[j]=pdf0(par,x[j])
}}
z[z<1e-16]=1e-16
-sum(log(z))
}
out<-suppressWarnings(optim(starts,fn=mpsw,x=sort.mydata,method))
n.p<-length(out$par)
if (location==TRUE){
out$par[1:(n.p-1)]<-abs(out$par[1:(n.p-1)])}
else{
out$par[1:n.p]<-abs(out$par[1:n.p])
}
gammam<-(n+1)*(log(n+1)-digamma(1))-1/2-1/(12*(n+1))
sigma2m<-(n+1)*(pi^2/6-1)-1/2-1/(6*(n+1))
c1<-gammam-sqrt(n*sigma2m/2)
c2<-sqrt(sigma2m/(2*n))
stat.chisquare<-(mpsw(out$par,sort.mydata)+n.p/2-c1)/c2
pvalue.chisquare<-pchisq(stat.chisquare,df=n,lower.tail=FALSE)
Moran<-out$value
log.likelihood=sum(log(pdf0(out$par,sort.mydata)))
u=cdf0(out$par,sort.mydata)
von<-c()
anderson<-c()
for(i in 1:n){
u[i]<-ifelse(u[i]==1,0.999999999,u[i])
von[i]=(u[i]-(2*i-1)/(2*n))^2
anderson[i]=(2*i-1)*log(u[i])+(2*n+1-2*i)*log(1-u[i])
}
anderson.stat=-n-mean(anderson)
von.stat=sum(von)+1/(12*n)
CAIC=-2*log.likelihood + 2*n.p + 2*(n.p*(n.p+1))/(n-n.p-1)
AIC=-2*log.likelihood + 2*n.p
BIC=-2*log.likelihood + n.p*log(n)
HQIC=-2*log.likelihood + 2*log(log(n))*n.p
ks.stat=suppressWarnings(ks.test(mydata, "cdf0", par=out$par))
aux2=cbind(AIC, CAIC, BIC, HQIC, von.stat, anderson.stat,log.likelihood,Moran)
colnames(aux2)=c("AIC","CAIC","BIC","HQIC","CM","AD", "log",
"Moran")
rownames(aux2)=c("")
aux3=cbind(ks.stat$statistic,ks.stat$p.value)
colnames(aux3)=c("statistic","p-value")
rownames(aux3)=c("")
aux4=cbind(stat.chisquare,qchisq(sig.level,df=n,lower.tail=FALSE),1-pchisq(stat.chisquare,df=n))
colnames(aux4)=c("statistic","chi-value","p-value")
rownames(aux4)=c("")
aux5=cbind(if(out$convergence==0){"Algorithm Converged"} else {"Algorithm Not Converged"})
list("MPS"=out$par,"Measures"=aux2,"KS"=aux3,"chi-square"=aux4,"Convergence Status"=aux5)
}
mpsgammag<-function(mydata, g, location=TRUE, method , sig.level){
min.mydata<-min(mydata)
sort.mydata<-sort(mydata)
n<-length(mydata)
y<-(sort.mydata[2:n]-min.mydata)
y<-(sort.mydata[2:n]-min.mydata)[is.finite(log(sort.mydata[2:n]-min.mydata))]
n<-length(mydata)
qp1<-y[floor(.25*n)]
qp3<-y[floor(.75*n)]
median.mydata<-y[floor(.5*n)]
mean.mydata<-mean(y)
inv.mydata<-1/y[is.finite(1/y)]
inv.mean<-mean(inv.mydata)
std.mydata<-sd(y)
if(g!="birnbaum-saunders" & g!="exp" & g!="rayleigh" & g!="weibull" & g!="gompertz" & g!="gamma"
& g!="log-normal" & g!="chisq" & g!="f" & g!="burrxii" & g!="frechet"
& g!="lomax" & g!="log-logistic" & g!="lfr" & g!="chen")
{ stop ("Baseline distribution not implemented or misspelled. Please check the manual for guidelines.") }
if(g=="log-normal"){
den=function(par,x){meanlog=par[2]; sdlog=par[3]; loc=par[4]; dlnorm(x-loc,meanlog,sdlog)}
cum=function(par,x){meanlog=par[2]; sdlog=par[3]; loc=par[4]; plnorm(x-loc,meanlog,sdlog)}
starts<-c(1,log(median.mydata),sqrt(2*abs(log(mean.mydata/median.mydata))),(min.mydata-1/length(y)))
if (location==FALSE){
den=function(par,x){meanlog=par[2]; sdlog=par[3]; dlnorm(x,meanlog,sdlog)}
cum=function(par,x){meanlog=par[2]; sdlog=par[3]; plnorm(x,meanlog,sdlog)}
starts<-c(1,log(median.mydata),sqrt(2*abs(log(mean.mydata/median.mydata))))
}}
if(g=="chisq"){
den=function(par,x){df=par[2]; loc=par[3]; dchisq(x-loc,df)}
cum=function(par,x){df=par[2]; loc=par[3]; pchisq(x-loc,df)}
starts<-c(1,mean.mydata,(min.mydata-1/length(y)))
if (location==FALSE){
den=function(par,x){df=par[2]; dchisq(x,df)}
cum=function(par,x){df=par[2]; pchisq(x,df)}
starts<-c(1,mean.mydata)
}}
if(g=="f"){
den=function(par,x){df1=par[2]; df2=par[3]; loc=par[4]; df(x-loc,df1,df2)}
cum=function(par,x){df1=par[2]; df2=par[3]; loc=par[4]; pf(x-loc,df1,df2)}
df.1<-ifelse(inv.mean>1,2*inv.mean/(inv.mean-1),1)
df.2<-ifelse(mean.mydata>1,2*mean.mydata/(mean.mydata-1),1)
starts<-c(1,df.1,df.2,(min.mydata-1/length(y)))
if (location==FALSE){
den=function(par,x){df1=par[2]; df2=par[3]; df(x,df1,df2)}
cum=function(par,x){df1=par[2]; df2=par[3]; pf(x,df1,df2)}
starts<-c(1,df.1,df.2)
}}
if(g=="chen"){
den=function(par,x){a=par[2]; b=par[3]; loc=par[4]; a*b*(x-loc)^(a-1)*exp((x-loc)^a)*exp(-b*(exp((x-loc)^a)-1))}
cum=function(par,x){a=par[2]; b=par[3]; loc=par[4]; 1-exp(-b*(exp((x-loc)^a)-1))}
standard.mydata<-(y-mean.mydata)/std.mydata
s.hat<-ifelse(max(standard.mydata)<=1,-log(1-n/(n+.4))/(exp(1)-1),-
log(1-length(standard.mydata[standard.mydata<=1])/length(standard.mydata))/(exp(1)-1))
r.hat<-abs(log(log(1-log(1-0.5)/s.hat))/log(median.mydata))
starts<-c(1,r.hat,s.hat,(min.mydata-1/length(y)))
if (location==FALSE){
den=function(par,x){a=par[2]; b=par[3]; a*b*(x)^(a-1)*exp((x)^a)*exp(-b*(exp((x)^a)-1))}
cum=function(par,x){a=par[2]; b=par[3]; 1-exp(-b*(exp((x)^a)-1))}
starts<-c(1,r.hat,s.hat)
}}
if(g=="lfr"){
den=function(par,x){a=par[2]; b=par[3]; loc=par[4]; (a+b*(x-loc))*exp(-a*(x-loc)-(b*(x-loc)^2)/2)}
cum=function(par,x){a=par[2]; b=par[3]; loc=par[4]; 1-exp(-a*(x-loc)-(b*(x-loc)^2)/2)}
ii<-seq(1,(n-1))
yy<--log(1-(ii+0.3)/(n-1+0.4))
res<-summary(lm(yy ~ -1+y+I(y^2)))$coefficient
coeff<-c(abs(res[1,1]),abs(res[2,1]))
z1=NULL;
lfr.log<-function(p) {
z1<--log(sum(p[1]+p[2]*y))+p[1]*sum(y)+p[2]/2*sum(y^2)
z1[z1<1e-16]<-1e-16
}
p.hat<-suppressWarnings(optim(c(abs(coeff[1]),2*abs(coeff[2])),lfr.log)$par)
starts<-c(1,p.hat[1],p.hat[2],(min.mydata-1/length(y)))
if (location==FALSE){
den=function(par,x){a=par[2]; b=par[3]; (a+b*(x))*exp(-a*(x)-(b*(x)^2)/2)}
cum=function(par,x){a=par[2]; b=par[3]; 1-exp(-a*(x)-(b*(x)^2)/2)}
starts<-c(1,p.hat[1],p.hat[2])
}}
if(g=="log-logistic"){
den=function(par,x){a=par[2]; b=par[3]; loc=par[4]; (a*b^(-a)*(x-loc)^(a-1))/((((x-loc)/b)^a +1)^2)}
cum=function(par,x){a=par[2]; b=par[3]; loc=par[4]; 1/(((x-loc)/b)^(-a)+1)}
starts<-c(1,log(0.75/(1-0.75))/log(qp3/median.mydata),median.mydata,(min.mydata-1/length(y)))
if (location==FALSE){
den=function(par,x){a=par[2]; b=par[3]; (a*b^(-a)*(x)^(a-1))/((((x)/b)^a +1)^2)}
cum=function(par,x){a=par[2]; b=par[3]; 1/(((x)/b)^(-a)+1)}
starts<-c(1,log(0.75/(1-0.75))/log(qp3/median.mydata),median.mydata)
}}
if(g=="lomax"){
den=function(par,x){a=par[2]; b=par[3]; loc=par[4]; (a*b)/((1+a*(x-loc))^(b+1))}
cum=function(par,x){a=par[2]; b=par[3]; loc=par[4]; 1-(1+a*(x-loc))^(-b)}
a.hat<-1
b.hat<-(.5^(-1/a.hat)-1)/median.mydata
z1=NULL;
lomax.log<-function(p) {
z1<--n*log(p[1])-n*log(p[2])+(p[2]+1)*sum(log(1+p[1]*y))
z1[z1<1e-16]<-1e-16
}
p.hat<-suppressWarnings(optim(c(1,b.hat),lomax.log, method)$par)
starts<-c(1,p.hat[1],p.hat[2],(min.mydata-1/length(y)))
if (location==FALSE){
den=function(par,x){a=par[2]; b=par[3]; (a*b)/((1+a*(x))^(b+1))}
cum=function(par,x){a=par[2]; b=par[3]; 1-(1+a*(x))^(-b)}
starts<-c(1,p.hat[1],p.hat[2])
}}
if(g=="gompertz"){
den=function(par,x){a=par[2]; b=par[3]; loc=par[4]; b*exp(a*(x-loc))*exp(-(exp(a*(x-loc))-1)*b/a)}
cum=function(par,x){a=par[2]; b=par[3]; loc=par[4]; 1-exp(-(exp(a*(x-loc))-1)*b/a)}
a.hat<-log(log(1-.75)/log(1-.5))/(qp3-median.mydata)
b.hat<--a.hat*log(0.5)/(exp(a.hat*median.mydata)-1)
z1=NULL;
gompertz.log<-function(p){
z1<--n*log(p[2])-p[1]*sum(y)+p[2]/p[1]*sum(exp(p[1]*y)-1)
z1[z1<1e-16]<-1e-16
}
p.hat<-suppressWarnings(optim(c(a.hat,b.hat),gompertz.log, method)$par)
starts<-c(1,p.hat[1],p.hat[2],(min.mydata-1/length(y)))
if (location==FALSE){
den=function(par,x){a=par[2]; b=par[3]; b*exp(a*(x))*exp(-(exp(a*(x))-1)*b/a)}
cum=function(par,x){a=par[2]; b=par[3]; 1-exp(-(exp(a*(x))-1)*b/a)}
starts<-c(1,p.hat[1],p.hat[2])
}}
if(g=="exp"){
den=function(par,x){rate=par[2]; loc=par[3]; dexp(x-loc,rate)}
cum=function(par,x){rate=par[2]; loc=par[3]; pexp(x-loc,rate)}
starts<-c(1,1/mean.mydata,(min.mydata-1/length(y)))
if (location==FALSE){
den=function(par,x){rate=par[2]; dexp(x,rate)}
cum=function(par,x){rate=par[2]; pexp(x,rate)}
starts<-c(1,1/mean.mydata)
}}
if(g=="rayleigh"){
den=function(par,x){a=par[2]; loc=par[3]; 2*(x-loc)/a*exp(-((x-loc)/a)^2)}
cum=function(par,x){a=par[2]; loc=par[3]; 1-exp(-((x-loc)/a)^2)}
starts<-c(1,log(2)/(median.mydata)^2,(min.mydata-1/length(y)))
if (location==FALSE){
den=function(par,x){a=par[2]; 2*x/a*exp(-(x/a)^2)}
cum=function(par,x){a=par[2]; 1-exp(-(x/a)^2)}
starts<-c(1,log(2)/(median.mydata)^2)
}}
if(g=="burrxii"){
den=function(par,x){a=par[2]; d=par[3]; loc=par[4]; d*a*(1+(x-loc)^d)^(-a-1)*((x-loc)^(d-1))}
cum=function(par,x){a=par[2]; d=par[3]; loc=par[4]; 1-(1+(x-loc)^d)^(-a)}
z1=NULL;
burrxii.log<-function(p){
z1<--n*log(p[1])-n*log(p[2])-(p[2]-1)*sum(log(y))+(p[1]+1)*sum(log(1+y^p[2]))
}
p.hat<-suppressWarnings(optim(c(1,1),burrxii.log, method="BFGS")$par)
starts<-c(1,p.hat[1],p.hat[2],(min.mydata-1/length(y)))
if (location==FALSE){
den=function(par,x){a=par[2]; d=par[3]; d*a*(1+(x)^d)^(-a-1)*((x)^(d-1))}
cum=function(par,x){a=par[2]; d=par[3]; 1-(1+(x)^d)^(-a)}
starts<-c(1,p.hat[1],p.hat[2])
}}
if(g=="frechet"){
den=function(par,x){a=par[2]; b=par[3]; loc=par[4]; (a*exp(-((x-loc)/b)^(-a))*((x-loc)/b)^(-a-1))/(b)}
cum=function(par,x){a=par[2]; b=par[3]; loc=par[4]; exp(-((x-loc)/b)^(-a))}
cons<-cor(inv.mydata,rank(inv.mydata))*(sd(inv.mydata)/mean(inv.mydata))*sqrt((n+1)/(n-1))/sqrt(3)
a.hat<-abs(ifelse(cons<1,-log(2)/log(1-cons),-log(2)/log(1-.98)))
b.hat<-median(inv.mydata)/(log(2))^(1/a.hat)
starts<-c(1,a.hat,1/b.hat,(min.mydata-1/length(y)))
if (location==FALSE){
den=function(par,x){a=par[2]; b=par[3]; (a*exp(-((x)/b)^(-a))*((x)/b)^(-a-1))/(b)}
cum=function(par,x){a=par[2]; b=par[3]; exp(-((x)/b)^(-a))}
starts<-c(1,a.hat,1/b.hat)
}}
if(g=="birnbaum-saunders"){
den=function(par,x){a=par[2]; b=par[3]; loc=par[4]; (sqrt((x-loc)/b)+sqrt(b/(x-loc)))/(2*a*(x-loc))*dnorm((sqrt((x-loc)/b)-sqrt(b/(x-loc)))/a)}
cum=function(par,x){a=par[2]; b=par[3]; loc=par[4]; pnorm((sqrt((x-loc)/b)-sqrt(b/(x-loc)))/a)}
r<-(mean(inv.mydata))^(-1)
b.hat<-sqrt(mean.mydata*r)
a.hat<-sqrt(2*(sqrt(mean.mydata/r)))
starts<-c(1,a.hat,b.hat,(min.mydata-1/length(y)))
if (location==FALSE){
den=function(par,x){a=par[2]; b=par[3]; (sqrt((x)/b)+sqrt(b/(x)))/(2*a*(x))*dnorm((sqrt((x)/b)-sqrt(b/(x)))/a)}
cum=function(par,x){a=par[2]; b=par[3]; pnorm((sqrt((x)/b)-sqrt(b/(x)))/a)}
starts<-c(1,a.hat,b.hat)
}}
if(g=="weibull"){
den=function(par,x){shape=par[2]; scale=par[3]; loc=par[4]; dweibull(x-loc,shape,scale)}
cum=function(par,x){shape=par[2]; scale=par[3]; loc=par[4]; pweibull(x-loc,shape,scale)}
cons<-cor(mydata,rank(mydata))*(std.mydata/mean.mydata)*sqrt((n+1)/(n-1))/sqrt(3)
a.hat<-abs(ifelse(cons<1,-log(2)/log(1-cons),-log(2)/log(1-.98)))
b.hat<-median.mydata/(log(2))^(1/a.hat)
starts<-c(1,a.hat,b.hat,(min.mydata-1/length(y)))
if (location==FALSE){
den=function(par,x){shape=par[2]; scale=par[3]; dweibull(x,shape,scale)}
cum=function(par,x){shape=par[2]; scale=par[3]; pweibull(x,shape,scale)}
starts<-c(1,a.hat,b.hat)
}}
if(g=="gamma"){
den=function(par,x){shape=par[2]; scale=par[3]; loc=par[4]; dgamma(x-loc,shape,scale)}
cum=function(par,x){shape=par[2]; scale=par[3]; loc=par[4]; pgamma(x-loc,shape,scale)}
a.hat<-uniroot(function(ss) trigamma(ss)-var(log(y)[is.finite(log(y))]),c(0,1000000))$root
b.hat<-mean.mydata/a.hat
starts<-c(1,a.hat,b.hat,(min.mydata-1/length(y)))
if (location==FALSE){
den=function(par,x){shape=par[2]; scale=par[3]; dgamma(x,shape,scale)}
cum=function(par,x){shape=par[2]; scale=par[3]; pgamma(x,shape,scale)}
starts<-c(1,a.hat,b.hat)
}}
pdf0<-function(par,x){
f0=den(par,x)
c0=cum(par,x)
a=par[1]
gamma(a)^(-1)*f0*(1-c0)^(-2)*(c0/(1-c0))^(a-1)*exp(-c0/(1-c0))
}
cdf0<-function(par,x){
f0=den(par,x)
c0=cum(par,x)
a=par[1]
pgamma(c0/(1-c0),shape=a)
}
mpsw<-function(par,x){
z=NULL
z=diff(c(0,cdf0(par,x),1))
for (j in 2:n){if((x[j]-x[j-1])==0){z[j]=pdf0(par,x[j])
}}
z[z<1e-16]=1e-16
-sum(log(z))
}
out<-suppressWarnings(optim(starts,fn=mpsw,x=sort.mydata,method))
n.p<-length(out$par)
gammam<-(n+1)*(log(n+1)-digamma(1))-1/2-1/(12*(n+1))
sigma2m<-(n+1)*(pi^2/6-1)-1/2-1/(6*(n+1))
c1<-gammam-sqrt(n*sigma2m/2)
c2<-sqrt(sigma2m/(2*n))
stat.chisquare<-(mpsw(out$par,sort.mydata)+n.p/2-c1)/c2
pvalue.chisquare<-pchisq(stat.chisquare,df=n,lower.tail=FALSE)
Moran<-out$value
log.likelihood=sum(log(pdf0(out$par,sort.mydata)))
u=cdf0(out$par,sort.mydata)
von<-c()
anderson<-c()
for(i in 1:n){
u[i]<-ifelse(u[i]==1,0.999999999,u[i])
von[i]=(u[i]-(2*i-1)/(2*n))^2
anderson[i]=(2*i-1)*log(u[i])+(2*n+1-2*i)*log(1-u[i])
}
anderson.stat=-n-mean(anderson)
von.stat=sum(von)+1/(12*n)
CAIC=-2*log.likelihood + 2*n.p + 2*(n.p*(n.p+1))/(n-n.p-1)
AIC=-2*log.likelihood + 2*n.p
BIC=-2*log.likelihood + n.p*log(n)
HQIC=-2*log.likelihood + 2*log(log(n))*n.p
ks.stat=suppressWarnings(ks.test(mydata, "cdf0", par=out$par))
aux2=cbind(AIC, CAIC, BIC, HQIC, von.stat, anderson.stat,log.likelihood,Moran)
colnames(aux2)=c("AIC","CAIC","BIC","HQIC","CM","AD", "log",
"Moran")
rownames(aux2)=c("")
aux3=cbind(ks.stat$statistic,ks.stat$p.value)
colnames(aux3)=c("statistic","p-value")
rownames(aux3)=c("")
aux4=cbind(stat.chisquare,qchisq(sig.level,df=n,lower.tail=FALSE),1-pchisq(stat.chisquare,df=n))
colnames(aux4)=c("statistic","chi-value","p-value")
rownames(aux4)=c("")
aux5=cbind(if(out$convergence==0){"Algorithm Converged"} else {"Algorithm Not Converged"})
list("MPS"=out$par,"Measures"=aux2,"KS"=aux3,"chi-square"=aux4,"Convergence Status"=aux5)
}
mpsgammag1<-function(mydata, g, location=TRUE, method , sig.level){
min.mydata<-min(mydata)
sort.mydata<-sort(mydata)
n<-length(mydata)
y<-(sort.mydata[2:n]-min.mydata)
y<-(sort.mydata[2:n]-min.mydata)[is.finite(log(sort.mydata[2:n]-min.mydata))]
n<-length(mydata)
qp1<-y[floor(.25*n)]
qp3<-y[floor(.75*n)]
median.mydata<-y[floor(.5*n)]
mean.mydata<-mean(y)
inv.mydata<-1/y[is.finite(1/y)]
inv.mean<-mean(inv.mydata)
std.mydata<-sd(y)
if(g!="birnbaum-saunders" & g!="exp" & g!="rayleigh" & g!="weibull" & g!="gompertz" & g!="gamma"
& g!="log-normal" & g!="chisq" & g!="f" & g!="burrxii" & g!="frechet"
& g!="lomax" & g!="log-logistic" & g!="lfr" & g!="chen")
{ stop ("Baseline distribution not implemented or misspelled. Please check the manual for guidelines.") }
if(g=="log-normal"){
den=function(par,x){meanlog=par[2]; sdlog=par[3]; loc=par[4]; dlnorm(x-loc,meanlog,sdlog)}
cum=function(par,x){meanlog=par[2]; sdlog=par[3]; loc=par[4]; plnorm(x-loc,meanlog,sdlog)}
starts<-c(1,log(median.mydata),sqrt(2*abs(log(mean.mydata/median.mydata))),(min.mydata-1/length(y)))
if (location==FALSE){
den=function(par,x){meanlog=par[2]; sdlog=par[3]; dlnorm(x,meanlog,sdlog)}
cum=function(par,x){meanlog=par[2]; sdlog=par[3]; plnorm(x,meanlog,sdlog)}
starts<-c(1,log(median.mydata),sqrt(2*abs(log(mean.mydata/median.mydata))))
}}
if(g=="chisq"){
den=function(par,x){df=par[2]; loc=par[3]; dchisq(x-loc,df)}
cum=function(par,x){df=par[2]; loc=par[3]; pchisq(x-loc,df)}
starts<-c(1,mean.mydata,(min.mydata-1/length(y)))
if (location==FALSE){
den=function(par,x){df=par[2]; dchisq(x,df)}
cum=function(par,x){df=par[2]; pchisq(x,df)}
starts<-c(1,mean.mydata)
}}
if(g=="f"){
den=function(par,x){df1=par[2]; df2=par[3]; loc=par[4]; df(x-loc,df1,df2)}
cum=function(par,x){df1=par[2]; df2=par[3]; loc=par[4]; pf(x-loc,df1,df2)}
df.1<-ifelse(inv.mean>1,2*inv.mean/(inv.mean-1),1)
df.2<-ifelse(mean.mydata>1,2*mean.mydata/(mean.mydata-1),1)
starts<-c(1,df.1,df.2,(min.mydata-1/length(y)))
if (location==FALSE){
den=function(par,x){df1=par[2]; df2=par[3]; df(x,df1,df2)}
cum=function(par,x){df1=par[2]; df2=par[3]; pf(x,df1,df2)}
starts<-c(1,df.1,df.2)
}}
if(g=="chen"){
den=function(par,x){a=par[2]; b=par[3]; loc=par[4]; a*b*(x-loc)^(a-1)*exp((x-loc)^a)*exp(-b*(exp((x-loc)^a)-1))}
cum=function(par,x){a=par[2]; b=par[3]; loc=par[4]; 1-exp(-b*(exp((x-loc)^a)-1))}
standard.mydata<-(y-mean.mydata)/std.mydata
s.hat<-ifelse(max(standard.mydata)<=1,-log(1-n/(n+.4))/(exp(1)-1),-
log(1-length(standard.mydata[standard.mydata<=1])/length(standard.mydata))/(exp(1)-1))
r.hat<-abs(log(log(1-log(1-0.5)/s.hat))/log(median.mydata))
starts<-c(1,r.hat,s.hat,(min.mydata-1/length(y)))
if (location==FALSE){
den=function(par,x){a=par[2]; b=par[3]; a*b*(x)^(a-1)*exp((x)^a)*exp(-b*(exp((x)^a)-1))}
cum=function(par,x){a=par[2]; b=par[3]; 1-exp(-b*(exp((x)^a)-1))}
starts<-c(1,r.hat,s.hat)
}}
if(g=="lfr"){
den=function(par,x){a=par[2]; b=par[3]; loc=par[4]; (a+b*(x-loc))*exp(-a*(x-loc)-(b*(x-loc)^2)/2)}
cum=function(par,x){a=par[2]; b=par[3]; loc=par[4]; 1-exp(-a*(x-loc)-(b*(x-loc)^2)/2)}
ii<-seq(1,(n-1))
yy<--log(1-(ii+0.3)/(n-1+0.4))
res<-summary(lm(yy ~ -1+y+I(y^2)))$coefficient
coeff<-c(abs(res[1,1]),abs(res[2,1]))
z1=NULL;
lfr.log<-function(p) {
z1<--log(sum(p[1]+p[2]*y))+p[1]*sum(y)+p[2]/2*sum(y^2)
z1[z1<1e-16]<-1e-16
}
p.hat<-suppressWarnings(optim(c(abs(coeff[1]),2*abs(coeff[2])),lfr.log)$par)
starts<-c(1,p.hat[1],p.hat[2],(min.mydata-1/length(y)))
if (location==FALSE){
den=function(par,x){a=par[2]; b=par[3]; (a+b*(x))*exp(-a*(x)-(b*(x)^2)/2)}
cum=function(par,x){a=par[2]; b=par[3]; 1-exp(-a*(x)-(b*(x)^2)/2)}
starts<-c(1,p.hat[1],p.hat[2])
}}
if(g=="log-logistic"){
den=function(par,x){a=par[2]; b=par[3]; loc=par[4]; (a*b^(-a)*(x-loc)^(a-1))/((((x-loc)/b)^a +1)^2)}
cum=function(par,x){a=par[2]; b=par[3]; loc=par[4]; 1/(((x-loc)/b)^(-a)+1)}
starts<-c(1,log(0.75/(1-0.75))/log(qp3/median.mydata),median.mydata,(min.mydata-1/length(y)))
if (location==FALSE){
den=function(par,x){a=par[2]; b=par[3]; (a*b^(-a)*(x)^(a-1))/((((x)/b)^a +1)^2)}
cum=function(par,x){a=par[2]; b=par[3]; 1/(((x)/b)^(-a)+1)}
starts<-c(1,log(0.75/(1-0.75))/log(qp3/median.mydata),median.mydata)
}}
if(g=="lomax"){
den=function(par,x){a=par[2]; b=par[3]; loc=par[4]; (a*b)/((1+a*(x-loc))^(b+1))}
cum=function(par,x){a=par[2]; b=par[3]; loc=par[4]; 1-(1+a*(x-loc))^(-b)}
a.hat<-1
b.hat<-(.5^(-1/a.hat)-1)/median.mydata
z1=NULL;
lomax.log<-function(p) {
z1<--n*log(p[1])-n*log(p[2])+(p[2]+1)*sum(log(1+p[1]*y))
z1[z1<1e-16]<-1e-16
}
p.hat<-suppressWarnings(optim(c(1,b.hat),lomax.log, method)$par)
starts<-c(1,p.hat[1],p.hat[2],(min.mydata-1/length(y)))
if (location==FALSE){
den=function(par,x){a=par[2]; b=par[3]; (a*b)/((1+a*(x))^(b+1))}
cum=function(par,x){a=par[2]; b=par[3]; 1-(1+a*(x))^(-b)}
starts<-c(1,p.hat[1],p.hat[2])
}}
if(g=="gompertz"){
den=function(par,x){a=par[2]; b=par[3]; loc=par[4]; b*exp(a*(x-loc))*exp(-(exp(a*(x-loc))-1)*b/a)}
cum=function(par,x){a=par[2]; b=par[3]; loc=par[4]; 1-exp(-(exp(a*(x-loc))-1)*b/a)}
a.hat<-log(log(1-.75)/log(1-.5))/(qp3-median.mydata)
b.hat<--a.hat*log(0.5)/(exp(a.hat*median.mydata)-1)
z1=NULL;
gompertz.log<-function(p){
z1<--n*log(p[2])-p[1]*sum(y)+p[2]/p[1]*sum(exp(p[1]*y)-1)
z1[z1<1e-16]<-1e-16
}
p.hat<-suppressWarnings(optim(c(a.hat,b.hat),gompertz.log, method)$par)
starts<-c(1,p.hat[1],p.hat[2],(min.mydata-1/length(y)))
if (location==FALSE){
den=function(par,x){a=par[2]; b=par[3]; b*exp(a*(x))*exp(-(exp(a*(x))-1)*b/a)}
cum=function(par,x){a=par[2]; b=par[3]; 1-exp(-(exp(a*(x))-1)*b/a)}
starts<-c(1,p.hat[1],p.hat[2])
}}
if(g=="exp"){
den=function(par,x){rate=par[2]; loc=par[3]; dexp(x-loc,rate)}
cum=function(par,x){rate=par[2]; loc=par[3]; pexp(x-loc,rate)}
starts<-c(1,1/mean.mydata,(min.mydata-1/length(y)))
if (location==FALSE){
den=function(par,x){rate=par[2]; dexp(x,rate)}
cum=function(par,x){rate=par[2]; pexp(x,rate)}
starts<-c(1,1/mean.mydata)
}}
if(g=="rayleigh"){
den=function(par,x){a=par[2]; loc=par[3]; 2*(x-loc)/a*exp(-((x-loc)/a)^2)}
cum=function(par,x){a=par[2]; loc=par[3]; 1-exp(-((x-loc)/a)^2)}
starts<-c(1,log(2)/(median.mydata)^2,(min.mydata-1/length(y)))
if (location==FALSE){
den=function(par,x){a=par[2]; 2*x/a*exp(-(x/a)^2)}
cum=function(par,x){a=par[2]; 1-exp(-(x/a)^2)}
starts<-c(1,log(2)/(median.mydata)^2)
}}
if(g=="burrxii"){
den=function(par,x){a=par[2]; d=par[3]; loc=par[4]; d*a*(1+(x-loc)^d)^(-a-1)*((x-loc)^(d-1))}
cum=function(par,x){a=par[2]; d=par[3]; loc=par[4]; 1-(1+(x-loc)^d)^(-a)}
z1=NULL;
burrxii.log<-function(p){
z1<--n*log(p[1])-n*log(p[2])-(p[2]-1)*sum(log(y))+(p[1]+1)*sum(log(1+y^p[2]))
}
p.hat<-suppressWarnings(optim(c(1,1),burrxii.log, method="BFGS")$par)
starts<-c(1,p.hat[1],p.hat[2],(min.mydata-1/length(y)))
if (location==FALSE){
den=function(par,x){a=par[2]; d=par[3]; d*a*(1+(x)^d)^(-a-1)*((x)^(d-1))}
cum=function(par,x){a=par[2]; d=par[3]; 1-(1+(x)^d)^(-a)}
starts<-c(1,p.hat[1],p.hat[2])
}}
if(g=="frechet"){
den=function(par,x){a=par[2]; b=par[3]; loc=par[4]; (a*exp(-((x-loc)/b)^(-a))*((x-loc)/b)^(-a-1))/(b)}
cum=function(par,x){a=par[2]; b=par[3]; loc=par[4]; exp(-((x-loc)/b)^(-a))}
cons<-cor(inv.mydata,rank(inv.mydata))*(sd(inv.mydata)/mean(inv.mydata))*sqrt((n+1)/(n-1))/sqrt(3)
a.hat<-abs(ifelse(cons<1,-log(2)/log(1-cons),-log(2)/log(1-.98)))
b.hat<-median(inv.mydata)/(log(2))^(1/a.hat)
starts<-c(1,a.hat,1/b.hat,(min.mydata-1/length(y)))
if (location==FALSE){
den=function(par,x){a=par[2]; b=par[3]; (a*exp(-((x)/b)^(-a))*((x)/b)^(-a-1))/(b)}
cum=function(par,x){a=par[2]; b=par[3]; exp(-((x)/b)^(-a))}
starts<-c(1,a.hat,1/b.hat)
}}
if(g=="birnbaum-saunders"){
den=function(par,x){a=par[2]; b=par[3]; loc=par[4]; (sqrt((x-loc)/b)+sqrt(b/(x-loc)))/(2*a*(x-loc))*dnorm((sqrt((x-loc)/b)-sqrt(b/(x-loc)))/a)}
cum=function(par,x){a=par[2]; b=par[3]; loc=par[4]; pnorm((sqrt((x-loc)/b)-sqrt(b/(x-loc)))/a)}
r<-(mean(inv.mydata))^(-1)
b.hat<-sqrt(mean.mydata*r)
a.hat<-sqrt(2*(sqrt(mean.mydata/r)))
starts<-c(1,a.hat,b.hat,(min.mydata-1/length(y)))
if (location==FALSE){
den=function(par,x){a=par[2]; b=par[3]; (sqrt((x)/b)+sqrt(b/(x)))/(2*a*(x))*dnorm((sqrt((x)/b)-sqrt(b/(x)))/a)}
cum=function(par,x){a=par[2]; b=par[3]; pnorm((sqrt((x)/b)-sqrt(b/(x)))/a)}
starts<-c(1,a.hat,b.hat)
}}
if(g=="weibull"){
den=function(par,x){shape=par[2]; scale=par[3]; loc=par[4]; dweibull(x-loc,shape,scale)}
cum=function(par,x){shape=par[2]; scale=par[3]; loc=par[4]; pweibull(x-loc,shape,scale)}
cons<-cor(mydata,rank(mydata))*(std.mydata/mean.mydata)*sqrt((n+1)/(n-1))/sqrt(3)
a.hat<-abs(ifelse(cons<1,-log(2)/log(1-cons),-log(2)/log(1-.98)))
b.hat<-median.mydata/(log(2))^(1/a.hat)
starts<-c(1,a.hat,b.hat,(min.mydata-1/length(y)))
if (location==FALSE){
den=function(par,x){shape=par[2]; scale=par[3]; dweibull(x,shape,scale)}
cum=function(par,x){shape=par[2]; scale=par[3]; pweibull(x,shape,scale)}
starts<-c(1,a.hat,b.hat)
}}
if(g=="gamma"){
den=function(par,x){shape=par[2]; scale=par[3]; loc=par[4]; dgamma(x-loc,shape,scale)}
cum=function(par,x){shape=par[2]; scale=par[3]; loc=par[4]; pgamma(x-loc,shape,scale)}
a.hat<-uniroot(function(ss) trigamma(ss)-var(log(y)[is.finite(log(y))]),c(0,1000000))$root
b.hat<-mean.mydata/a.hat
starts<-c(1,a.hat,b.hat,(min.mydata-1/length(y)))
if (location==FALSE){
den=function(par,x){shape=par[2]; scale=par[3]; dgamma(x,shape,scale)}
cum=function(par,x){shape=par[2]; scale=par[3]; pgamma(x,shape,scale)}
starts<-c(1,a.hat,b.hat)
}}
pdf0<-function(par,x){
f0=den(par,x)
c0=cum(par,x)
a=par[1]
gamma(a)^(-1)*f0*(-log(1-c0))^(a-1)
}
cdf0<-function(par,x){
f0=den(par,x)
c0=cum(par,x)
a=par[1]
pgamma(-log(1-c0),shape=a)
}
mpsw<-function(par,x){
z=NULL
z=diff(c(0,cdf0(par,x),1))
for (j in 2:n){if((x[j]-x[j-1])==0){z[j]=pdf0(par,x[j])
}}
z[z<1e-16]=1e-16
-sum(log(z))
}
out<-suppressWarnings(optim(starts,fn=mpsw,x=sort.mydata,method))
n.p<-length(out$par)
gammam<-(n+1)*(log(n+1)-digamma(1))-1/2-1/(12*(n+1))
sigma2m<-(n+1)*(pi^2/6-1)-1/2-1/(6*(n+1))
c1<-gammam-sqrt(n*sigma2m/2)
c2<-sqrt(sigma2m/(2*n))
stat.chisquare<-(mpsw(out$par,sort.mydata)+n.p/2-c1)/c2
pvalue.chisquare<-pchisq(stat.chisquare,df=n,lower.tail=FALSE)
Moran<-out$value
log.likelihood=sum(log(pdf0(out$par,sort.mydata)))
u=cdf0(out$par,sort.mydata)
von<-c()
anderson<-c()
for(i in 1:n){
u[i]<-ifelse(u[i]==1,0.999999999,u[i])
von[i]=(u[i]-(2*i-1)/(2*n))^2
anderson[i]=(2*i-1)*log(u[i])+(2*n+1-2*i)*log(1-u[i])
}
anderson.stat=-n-mean(anderson)
von.stat=sum(von)+1/(12*n)
CAIC=-2*log.likelihood + 2*n.p + 2*(n.p*(n.p+1))/(n-n.p-1)
AIC=-2*log.likelihood + 2*n.p
BIC=-2*log.likelihood + n.p*log(n)
HQIC=-2*log.likelihood + 2*log(log(n))*n.p
ks.stat=suppressWarnings(ks.test(mydata, "cdf0", par=out$par))
aux2=cbind(AIC, CAIC, BIC, HQIC, von.stat, anderson.stat,log.likelihood,Moran)
colnames(aux2)=c("AIC","CAIC","BIC","HQIC","CM","AD", "log",
"Moran")
rownames(aux2)=c("")
aux3=cbind(ks.stat$statistic,ks.stat$p.value)
colnames(aux3)=c("statistic","p-value")
rownames(aux3)=c("")
aux4=cbind(stat.chisquare,qchisq(sig.level,df=n,lower.tail=FALSE),1-pchisq(stat.chisquare,df=n))
colnames(aux4)=c("statistic","chi-value","p-value")
rownames(aux4)=c("")
aux5=cbind(if(out$convergence==0){"Algorithm Converged"} else {"Algorithm Not Converged"})
list("MPS"=out$par,"Measures"=aux2,"KS"=aux3,"chi-square"=aux4,"Convergence Status"=aux5)
}
mpsgammag2<-function(mydata, g, location=TRUE, method , sig.level){
min.mydata<-min(mydata)
sort.mydata<-sort(mydata)
n<-length(mydata)
y<-(sort.mydata[2:n]-min.mydata)
y<-(sort.mydata[2:n]-min.mydata)[is.finite(log(sort.mydata[2:n]-min.mydata))]
n<-length(mydata)
qp1<-y[floor(.25*n)]
qp3<-y[floor(.75*n)]
median.mydata<-y[floor(.5*n)]
mean.mydata<-mean(y)
inv.mydata<-1/y[is.finite(1/y)]
inv.mean<-mean(inv.mydata)
std.mydata<-sd(y)
if(g!="birnbaum-saunders" & g!="exp" & g!="rayleigh" & g!="weibull" & g!="gompertz" & g!="gamma"
& g!="log-normal" & g!="chisq" & g!="f" & g!="burrxii" & g!="frechet"
& g!="lomax" & g!="log-logistic" & g!="lfr" & g!="chen")
{ stop ("Baseline distribution not implemented or misspelled. Please check the manual for guidelines.") }
if(g=="log-normal"){
den=function(par,x){meanlog=par[2]; sdlog=par[3]; loc=par[4]; dlnorm(x-loc,meanlog,sdlog)}
cum=function(par,x){meanlog=par[2]; sdlog=par[3]; loc=par[4]; plnorm(x-loc,meanlog,sdlog)}
starts<-c(1,log(median.mydata),sqrt(2*abs(log(mean.mydata/median.mydata))),(min.mydata-1/length(y)))
if (location==FALSE){
den=function(par,x){meanlog=par[2]; sdlog=par[3]; dlnorm(x,meanlog,sdlog)}
cum=function(par,x){meanlog=par[2]; sdlog=par[3]; plnorm(x,meanlog,sdlog)}
starts<-c(1,log(median.mydata),sqrt(2*abs(log(mean.mydata/median.mydata))))
}}
if(g=="chisq"){
den=function(par,x){df=par[2]; loc=par[3]; dchisq(x-loc,df)}
cum=function(par,x){df=par[2]; loc=par[3]; pchisq(x-loc,df)}
starts<-c(1,mean.mydata,(min.mydata-1/length(y)))
if (location==FALSE){
den=function(par,x){df=par[2]; dchisq(x,df)}
cum=function(par,x){df=par[2]; pchisq(x,df)}
starts<-c(1,mean.mydata)
}}
if(g=="f"){
den=function(par,x){df1=par[2]; df2=par[3]; loc=par[4]; df(x-loc,df1,df2)}
cum=function(par,x){df1=par[2]; df2=par[3]; loc=par[4]; pf(x-loc,df1,df2)}
df.1<-ifelse(inv.mean>1,2*inv.mean/(inv.mean-1),1)
df.2<-ifelse(mean.mydata>1,2*mean.mydata/(mean.mydata-1),1)
starts<-c(1,df.1,df.2,(min.mydata-1/length(y)))
if (location==FALSE){
den=function(par,x){df1=par[2]; df2=par[3]; df(x,df1,df2)}
cum=function(par,x){df1=par[2]; df2=par[3]; pf(x,df1,df2)}
starts<-c(1,df.1,df.2)
}}
if(g=="chen"){
den=function(par,x){a=par[2]; b=par[3]; loc=par[4]; a*b*(x-loc)^(a-1)*exp((x-loc)^a)*exp(-b*(exp((x-loc)^a)-1))}
cum=function(par,x){a=par[2]; b=par[3]; loc=par[4]; 1-exp(-b*(exp((x-loc)^a)-1))}
standard.mydata<-(y-mean.mydata)/std.mydata
s.hat<-ifelse(max(standard.mydata)<=1,-log(1-n/(n+.4))/(exp(1)-1),-
log(1-length(standard.mydata[standard.mydata<=1])/length(standard.mydata))/(exp(1)-1))
r.hat<-abs(log(log(1-log(1-0.5)/s.hat))/log(median.mydata))
starts<-c(1,r.hat,s.hat,(min.mydata-1/length(y)))
if (location==FALSE){
den=function(par,x){a=par[2]; b=par[3]; a*b*(x)^(a-1)*exp((x)^a)*exp(-b*(exp((x)^a)-1))}
cum=function(par,x){a=par[2]; b=par[3]; 1-exp(-b*(exp((x)^a)-1))}
starts<-c(1,r.hat,s.hat)
}}
if(g=="lfr"){
den=function(par,x){a=par[2]; b=par[3]; loc=par[4]; (a+b*(x-loc))*exp(-a*(x-loc)-(b*(x-loc)^2)/2)}
cum=function(par,x){a=par[2]; b=par[3]; loc=par[4]; 1-exp(-a*(x-loc)-(b*(x-loc)^2)/2)}
ii<-seq(1,(n-1))
yy<--log(1-(ii+0.3)/(n-1+0.4))
res<-summary(lm(yy ~ -1+y+I(y^2)))$coefficient
coeff<-c(abs(res[1,1]),abs(res[2,1]))
z1=NULL;
lfr.log<-function(p) {
z1<--log(sum(p[1]+p[2]*y))+p[1]*sum(y)+p[2]/2*sum(y^2)
z1[z1<1e-16]<-1e-16
}
p.hat<-suppressWarnings(optim(c(abs(coeff[1]),2*abs(coeff[2])),lfr.log)$par)
starts<-c(1,p.hat[1],p.hat[2],(min.mydata-1/length(y)))
if (location==FALSE){
den=function(par,x){a=par[2]; b=par[3]; (a+b*(x))*exp(-a*(x)-(b*(x)^2)/2)}
cum=function(par,x){a=par[2]; b=par[3]; 1-exp(-a*(x)-(b*(x)^2)/2)}
starts<-c(1,p.hat[1],p.hat[2])
}}
if(g=="log-logistic"){
den=function(par,x){a=par[2]; b=par[3]; loc=par[4]; (a*b^(-a)*(x-loc)^(a-1))/((((x-loc)/b)^a +1)^2)}
cum=function(par,x){a=par[2]; b=par[3]; loc=par[4]; 1/(((x-loc)/b)^(-a)+1)}
starts<-c(1,log(0.75/(1-0.75))/log(qp3/median.mydata),median.mydata,(min.mydata-1/length(y)))
if (location==FALSE){
den=function(par,x){a=par[2]; b=par[3]; (a*b^(-a)*(x)^(a-1))/((((x)/b)^a +1)^2)}
cum=function(par,x){a=par[2]; b=par[3]; 1/(((x)/b)^(-a)+1)}
starts<-c(1,log(0.75/(1-0.75))/log(qp3/median.mydata),median.mydata)
}}
if(g=="lomax"){
den=function(par,x){a=par[2]; b=par[3]; loc=par[4]; (a*b)/((1+a*(x-loc))^(b+1))}
cum=function(par,x){a=par[2]; b=par[3]; loc=par[4]; 1-(1+a*(x-loc))^(-b)}
a.hat<-1
b.hat<-(.5^(-1/a.hat)-1)/median.mydata
z1=NULL;
lomax.log<-function(p) {
z1<--n*log(p[1])-n*log(p[2])+(p[2]+1)*sum(log(1+p[1]*y))
z1[z1<1e-16]<-1e-16
}
p.hat<-suppressWarnings(optim(c(1,b.hat),lomax.log, method)$par)
starts<-c(1,p.hat[1],p.hat[2],(min.mydata-1/length(y)))
if (location==FALSE){
den=function(par,x){a=par[2]; b=par[3]; (a*b)/((1+a*(x))^(b+1))}
cum=function(par,x){a=par[2]; b=par[3]; 1-(1+a*(x))^(-b)}
starts<-c(1,p.hat[1],p.hat[2])
}}
if(g=="gompertz"){
den=function(par,x){a=par[2]; b=par[3]; loc=par[4]; b*exp(a*(x-loc))*exp(-(exp(a*(x-loc))-1)*b/a)}
cum=function(par,x){a=par[2]; b=par[3]; loc=par[4]; 1-exp(-(exp(a*(x-loc))-1)*b/a)}
a.hat<-log(log(1-.75)/log(1-.5))/(qp3-median.mydata)
b.hat<--a.hat*log(0.5)/(exp(a.hat*median.mydata)-1)
z1=NULL;
gompertz.log<-function(p){
z1<--n*log(p[2])-p[1]*sum(y)+p[2]/p[1]*sum(exp(p[1]*y)-1)
z1[z1<1e-16]<-1e-16
}
p.hat<-suppressWarnings(optim(c(a.hat,b.hat),gompertz.log, method)$par)
starts<-c(1,p.hat[1],p.hat[2],(min.mydata-1/length(y)))
if (location==FALSE){
den=function(par,x){a=par[2]; b=par[3]; b*exp(a*(x))*exp(-(exp(a*(x))-1)*b/a)}
cum=function(par,x){a=par[2]; b=par[3]; 1-exp(-(exp(a*(x))-1)*b/a)}
starts<-c(1,p.hat[1],p.hat[2])
}}
if(g=="exp"){
den=function(par,x){rate=par[2]; loc=par[3]; dexp(x-loc,rate)}
cum=function(par,x){rate=par[2]; loc=par[3]; pexp(x-loc,rate)}
starts<-c(1,1/mean.mydata,(min.mydata-1/length(y)))
if (location==FALSE){
den=function(par,x){rate=par[2]; dexp(x,rate)}
cum=function(par,x){rate=par[2]; pexp(x,rate)}
starts<-c(1,1/mean.mydata)
}}
if(g=="rayleigh"){
den=function(par,x){a=par[2]; loc=par[3]; 2*(x-loc)/a*exp(-((x-loc)/a)^2)}
cum=function(par,x){a=par[2]; loc=par[3]; 1-exp(-((x-loc)/a)^2)}
starts<-c(1,log(2)/(median.mydata)^2,(min.mydata-1/length(y)))
if (location==FALSE){
den=function(par,x){a=par[2]; 2*x/a*exp(-(x/a)^2)}
cum=function(par,x){a=par[2]; 1-exp(-(x/a)^2)}
starts<-c(1,log(2)/(median.mydata)^2)
}}
if(g=="burrxii"){
den=function(par,x){a=par[2]; d=par[3]; loc=par[4]; d*a*(1+(x-loc)^d)^(-a-1)*((x-loc)^(d-1))}
cum=function(par,x){a=par[2]; d=par[3]; loc=par[4]; 1-(1+(x-loc)^d)^(-a)}
z1=NULL;
burrxii.log<-function(p){
z1<--n*log(p[1])-n*log(p[2])-(p[2]-1)*sum(log(y))+(p[1]+1)*sum(log(1+y^p[2]))
}
p.hat<-suppressWarnings(optim(c(1,1),burrxii.log, method="BFGS")$par)
starts<-c(1,p.hat[1],p.hat[2],(min.mydata-1/length(y)))
if (location==FALSE){
den=function(par,x){a=par[2]; d=par[3]; d*a*(1+(x)^d)^(-a-1)*((x)^(d-1))}
cum=function(par,x){a=par[2]; d=par[3]; 1-(1+(x)^d)^(-a)}
starts<-c(1,p.hat[1],p.hat[2])
}}
if(g=="frechet"){
den=function(par,x){a=par[2]; b=par[3]; loc=par[4]; (a*exp(-((x-loc)/b)^(-a))*((x-loc)/b)^(-a-1))/(b)}
cum=function(par,x){a=par[2]; b=par[3]; loc=par[4]; exp(-((x-loc)/b)^(-a))}
cons<-cor(inv.mydata,rank(inv.mydata))*(sd(inv.mydata)/mean(inv.mydata))*sqrt((n+1)/(n-1))/sqrt(3)
a.hat<-abs(ifelse(cons<1,-log(2)/log(1-cons),-log(2)/log(1-.98)))
b.hat<-median(inv.mydata)/(log(2))^(1/a.hat)
starts<-c(1,a.hat,1/b.hat,(min.mydata-1/length(y)))
if (location==FALSE){
den=function(par,x){a=par[2]; b=par[3]; (a*exp(-((x)/b)^(-a))*((x)/b)^(-a-1))/(b)}
cum=function(par,x){a=par[2]; b=par[3]; exp(-((x)/b)^(-a))}
starts<-c(1,a.hat,1/b.hat)
}}
if(g=="birnbaum-saunders"){
den=function(par,x){a=par[2]; b=par[3]; loc=par[4]; (sqrt((x-loc)/b)+sqrt(b/(x-loc)))/(2*a*(x-loc))*dnorm((sqrt((x-loc)/b)-sqrt(b/(x-loc)))/a)}
cum=function(par,x){a=par[2]; b=par[3]; loc=par[4]; pnorm((sqrt((x-loc)/b)-sqrt(b/(x-loc)))/a)}
r<-(mean(inv.mydata))^(-1)
b.hat<-sqrt(mean.mydata*r)
a.hat<-sqrt(2*(sqrt(mean.mydata/r)))
starts<-c(1,a.hat,b.hat,(min.mydata-1/length(y)))
if (location==FALSE){
den=function(par,x){a=par[2]; b=par[3]; (sqrt((x)/b)+sqrt(b/(x)))/(2*a*(x))*dnorm((sqrt((x)/b)-sqrt(b/(x)))/a)}
cum=function(par,x){a=par[2]; b=par[3]; pnorm((sqrt((x)/b)-sqrt(b/(x)))/a)}
starts<-c(1,a.hat,b.hat)
}}
if(g=="weibull"){
den=function(par,x){shape=par[2]; scale=par[3]; loc=par[4]; dweibull(x-loc,shape,scale)}
cum=function(par,x){shape=par[2]; scale=par[3]; loc=par[4]; pweibull(x-loc,shape,scale)}
cons<-cor(mydata,rank(mydata))*(std.mydata/mean.mydata)*sqrt((n+1)/(n-1))/sqrt(3)
a.hat<-abs(ifelse(cons<1,-log(2)/log(1-cons),-log(2)/log(1-.98)))
b.hat<-median.mydata/(log(2))^(1/a.hat)
starts<-c(1,a.hat,b.hat,(min.mydata-1/length(y)))
if (location==FALSE){
den=function(par,x){shape=par[2]; scale=par[3]; dweibull(x,shape,scale)}
cum=function(par,x){shape=par[2]; scale=par[3]; pweibull(x,shape,scale)}
starts<-c(1,a.hat,b.hat)
}}
if(g=="gamma"){
den=function(par,x){shape=par[2]; scale=par[3]; loc=par[4]; dgamma(x-loc,shape,scale)}
cum=function(par,x){shape=par[2]; scale=par[3]; loc=par[4]; pgamma(x-loc,shape,scale)}
a.hat<-uniroot(function(ss) trigamma(ss)-var(log(y)[is.finite(log(y))]),c(0,1000000))$root
b.hat<-mean.mydata/a.hat
starts<-c(1,a.hat,b.hat,(min.mydata-1/length(y)))
if (location==FALSE){
den=function(par,x){shape=par[2]; scale=par[3]; dgamma(x,shape,scale)}
cum=function(par,x){shape=par[2]; scale=par[3]; pgamma(x,shape,scale)}
starts<-c(1,a.hat,b.hat)
}}
pdf0<-function(par,x){
f0=den(par,x)
c0=cum(par,x)
a=par[1]
gamma(a)^(-1)*f0*(-log(c0))^(a-1)
}
cdf0<-function(par,x){
f0=den(par,x)
c0=cum(par,x)
a=par[1]
pgamma(-log(c0),shape=a)
}
mpsw<-function(par,x){
z=NULL
z=diff(c(0,cdf0(par,x),1))
for (j in 2:n){if((x[j]-x[j-1])==0){z[j]=pdf0(par,x[j])
}}
z[z<1e-16]=1e-16
-sum(log(z))
}
out<-suppressWarnings(optim(starts,fn=mpsw,x=sort.mydata,method))
n.p<-length(out$par)
gammam<-(n+1)*(log(n+1)-digamma(1))-1/2-1/(12*(n+1))
sigma2m<-(n+1)*(pi^2/6-1)-1/2-1/(6*(n+1))
c1<-gammam-sqrt(n*sigma2m/2)
c2<-sqrt(sigma2m/(2*n))
stat.chisquare<-(mpsw(out$par,sort.mydata)+n.p/2-c1)/c2
pvalue.chisquare<-pchisq(stat.chisquare,df=n,lower.tail=FALSE)
Moran<-out$value
log.likelihood=sum(log(pdf0(out$par,sort.mydata)))
u=cdf0(out$par,sort.mydata)
von<-c()
anderson<-c()
for(i in 1:n){
u[i]<-ifelse(u[i]==1,0.999999999,u[i])
von[i]=(u[i]-(2*i-1)/(2*n))^2
anderson[i]=(2*i-1)*log(u[i])+(2*n+1-2*i)*log(1-u[i])
}
anderson.stat=-n-mean(anderson)
von.stat=sum(von)+1/(12*n)
CAIC=-2*log.likelihood + 2*n.p + 2*(n.p*(n.p+1))/(n-n.p-1)
AIC=-2*log.likelihood + 2*n.p
BIC=-2*log.likelihood + n.p*log(n)
HQIC=-2*log.likelihood + 2*log(log(n))*n.p
ks.stat=suppressWarnings(ks.test(mydata, "cdf0", par=out$par))
aux2=cbind(AIC, CAIC, BIC, HQIC, von.stat, anderson.stat,log.likelihood,Moran)
colnames(aux2)=c("AIC","CAIC","BIC","HQIC","CM","AD", "log",
"Moran")
rownames(aux2)=c("")
aux3=cbind(ks.stat$statistic,ks.stat$p.value)
colnames(aux3)=c("statistic","p-value")
rownames(aux3)=c("")
aux4=cbind(stat.chisquare,qchisq(sig.level,df=n,lower.tail=FALSE),1-pchisq(stat.chisquare,df=n))
colnames(aux4)=c("statistic","chi-value","p-value")
rownames(aux4)=c("")
aux5=cbind(if(out$convergence==0){"Algorithm Converged"} else {"Algorithm Not Converged"})
list("MPS"=out$par,"Measures"=aux2,"KS"=aux3,"chi-square"=aux4,"Convergence Status"=aux5)
}
mpsgbetag<-function(mydata, g, location=TRUE, method , sig.level){
min.mydata<-min(mydata)
sort.mydata<-sort(mydata)
n<-length(mydata)
y<-(sort.mydata[2:n]-min.mydata)
y<-(sort.mydata[2:n]-min.mydata)[is.finite(log(sort.mydata[2:n]-min.mydata))]
n<-length(mydata)
qp1<-y[floor(.25*n)]
qp3<-y[floor(.75*n)]
median.mydata<-y[floor(.5*n)]
mean.mydata<-mean(y)
inv.mydata<-1/y[is.finite(1/y)]
inv.mean<-mean(inv.mydata)
std.mydata<-sd(y)
if(g!="birnbaum-saunders" & g!="exp" & g!="rayleigh" & g!="weibull" & g!="gompertz" & g!="gamma"
& g!="log-normal" & g!="chisq" & g!="f" & g!="burrxii" & g!="frechet"
& g!="lomax" & g!="log-logistic" & g!="lfr" & g!="chen")
{ stop ("Baseline distribution not implemented or misspelled. Please check the manual for guidelines.") }
if(g=="log-normal"){
den=function(par,x){meanlog=par[4]; sdlog=par[5]; loc=par[6]; dlnorm(x-loc,meanlog,sdlog)}
cum=function(par,x){meanlog=par[4]; sdlog=par[5]; loc=par[6]; plnorm(x-loc,meanlog,sdlog)}
starts<-c(1,1,1,log(median.mydata),sqrt(2*abs(log(mean.mydata/median.mydata))),(min.mydata-1/length(y)))
if (location==FALSE){
den=function(par,x){meanlog=par[4]; sdlog=par[5]; dlnorm(x,meanlog,sdlog)}
cum=function(par,x){meanlog=par[4]; sdlog=par[5]; plnorm(x,meanlog,sdlog)}
starts<-c(1,1,1,log(median.mydata),sqrt(2*abs(log(mean.mydata/median.mydata))))
}}
if(g=="chisq"){
den=function(par,x){df=par[4]; loc=par[5]; dchisq(x-loc,df)}
cum=function(par,x){df=par[4]; loc=par[5]; pchisq(x-loc,df)}
starts<-c(1,1,1,mean.mydata,(min.mydata-1/length(y)))
if (location==FALSE){
den=function(par,x){df=par[4]; dchisq(x,df)}
cum=function(par,x){df=par[4]; pchisq(x,df)}
starts<-c(1,1,1,mean.mydata)
}}
if(g=="f"){
den=function(par,x){df1=par[4]; df2=par[5]; loc=par[6]; df(x-loc,df1,df2)}
cum=function(par,x){df1=par[4]; df2=par[5]; loc=par[6]; pf(x-loc,df1,df2)}
df.1<-ifelse(inv.mean>1,2*inv.mean/(inv.mean-1),1)
df.2<-ifelse(mean.mydata>1,2*mean.mydata/(mean.mydata-1),1)
starts<-c(1,1,1,df.1,df.2,(min.mydata-1/length(y)))
if (location==FALSE){
den=function(par,x){df1=par[4]; df2=par[5]; df(x,df1,df2)}
cum=function(par,x){df1=par[4]; df2=par[5]; pf(x,df1,df2)}
starts<-c(1,1,1,df.1,df.2)
}}
if(g=="chen"){
den=function(par,x){a=par[4]; b=par[5]; loc=par[6]; a*b*(x-loc)^(a-1)*exp((x-loc)^a)*exp(-b*(exp((x-loc)^a)-1))}
cum=function(par,x){a=par[4]; b=par[5]; loc=par[6]; 1-exp(-b*(exp((x-loc)^a)-1))}
standard.mydata<-(y-mean.mydata)/std.mydata
s.hat<-ifelse(max(standard.mydata)<=1,-log(1-n/(n+.4))/(exp(1)-1),-
log(1-length(standard.mydata[standard.mydata<=1])/length(standard.mydata))/(exp(1)-1))
r.hat<-abs(log(log(1-log(1-0.5)/s.hat))/log(median.mydata))
starts<-c(1,1,1,r.hat,s.hat,(min.mydata-1/length(y)))
if (location==FALSE){
den=function(par,x){a=par[4]; b=par[5]; a*b*(x)^(a-1)*exp((x)^a)*exp(-b*(exp((x)^a)-1))}
cum=function(par,x){a=par[4]; b=par[5]; 1-exp(-b*(exp((x)^a)-1))}
starts<-c(1,1,1,r.hat,s.hat)
}}
if(g=="lfr"){
den=function(par,x){a=par[4]; b=par[5]; loc=par[6]; (a+b*(x-loc))*exp(-a*(x-loc)-(b*(x-loc)^2)/2)}
cum=function(par,x){a=par[4]; b=par[5]; loc=par[6]; 1-exp(-a*(x-loc)-(b*(x-loc)^2)/2)}
ii<-seq(1,(n-1))
yy<--log(1-(ii+0.3)/(n-1+0.4))
res<-summary(lm(yy ~ -1+y+I(y^2)))$coefficient
coeff<-c(abs(res[1,1]),abs(res[2,1]))
z1=NULL;
lfr.log<-function(p) {
z1<--log(sum(p[1]+p[2]*y))+p[1]*sum(y)+p[2]/2*sum(y^2)
z1[z1<1e-16]<-1e-16
}
p.hat<-suppressWarnings(optim(c(abs(coeff[1]),2*abs(coeff[2])),lfr.log)$par)
starts<-c(1,1,1,p.hat[1],p.hat[2],(min.mydata-1/length(y)))
if (location==FALSE){
den=function(par,x){a=par[4]; b=par[5]; (a+b*(x))*exp(-a*(x)-(b*(x)^2)/2)}
cum=function(par,x){a=par[4]; b=par[5]; 1-exp(-a*(x)-(b*(x)^2)/2)}
starts<-c(1,1,1,p.hat[1],p.hat[2])
}}
if(g=="log-logistic"){
den=function(par,x){a=par[4]; b=par[5]; loc=par[6]; (a*b^(-a)*(x-loc)^(a-1))/((((x-loc)/b)^a +1)^2)}
cum=function(par,x){a=par[4]; b=par[5]; loc=par[6]; 1/(((x-loc)/b)^(-a)+1)}
starts<-c(1,1,1,log(0.75/(1-0.75))/log(qp3/median.mydata),median.mydata,(min.mydata-1/length(y)))
if (location==FALSE){
den=function(par,x){a=par[4]; b=par[5]; (a*b^(-a)*(x)^(a-1))/((((x)/b)^a +1)^2)}
cum=function(par,x){a=par[4]; b=par[5]; 1/(((x)/b)^(-a)+1)}
starts<-c(1,1,1,log(0.75/(1-0.75))/log(qp3/median.mydata),median.mydata)
}}
if(g=="lomax"){
den=function(par,x){a=par[4]; b=par[5]; loc=par[6]; (a*b)/((1+a*(x-loc))^(b+1))}
cum=function(par,x){a=par[4]; b=par[5]; loc=par[6]; 1-(1+a*(x-loc))^(-b)}
a.hat<-1
b.hat<-(.5^(-1/a.hat)-1)/median.mydata
z1=NULL;
lomax.log<-function(p) {
z1<--n*log(p[1])-n*log(p[2])+(p[2]+1)*sum(log(1+p[1]*y))
z1[z1<1e-16]<-1e-16
}
p.hat<-suppressWarnings(optim(c(1,b.hat),lomax.log, method)$par)
starts<-c(1,1,1,p.hat[1],p.hat[2],(min.mydata-1/length(y)))
if (location==FALSE){
den=function(par,x){a=par[4]; b=par[5]; (a*b)/((1+a*(x))^(b+1))}
cum=function(par,x){a=par[4]; b=par[5]; 1-(1+a*(x))^(-b)}
starts<-c(1,1,1,p.hat[1],p.hat[2])
}}
if(g=="gompertz"){
den=function(par,x){a=par[4]; b=par[5]; loc=par[6]; b*exp(a*(x-loc))*exp(-(exp(a*(x-loc))-1)*b/a)}
cum=function(par,x){a=par[4]; b=par[5]; loc=par[6]; 1-exp(-(exp(a*(x-loc))-1)*b/a)}
a.hat<-log(log(1-.75)/log(1-.5))/(qp3-median.mydata)
b.hat<--a.hat*log(0.5)/(exp(a.hat*median.mydata)-1)
z1=NULL;
gompertz.log<-function(p){
z1<--n*log(p[2])-p[1]*sum(y)+p[2]/p[1]*sum(exp(p[1]*y)-1)
z1[z1<1e-16]<-1e-16
}
p.hat<-suppressWarnings(optim(c(a.hat,b.hat),gompertz.log, method)$par)
starts<-c(1,1,1,p.hat[1],p.hat[2],(min.mydata-1/length(y)))
if (location==FALSE){
den=function(par,x){a=par[4]; b=par[5]; b*exp(a*(x))*exp(-(exp(a*(x))-1)*b/a)}
cum=function(par,x){a=par[4]; b=par[5]; 1-exp(-(exp(a*(x))-1)*b/a)}
starts<-c(1,1,1,p.hat[1],p.hat[2])
}}
if(g=="exp"){
den=function(par,x){rate=par[4]; loc=par[5]; dexp(x-loc,rate)}
cum=function(par,x){rate=par[4]; loc=par[5]; pexp(x-loc,rate)}
starts<-c(1,1,1,1/mean.mydata,(min.mydata-1/length(y)))
if (location==FALSE){
den=function(par,x){rate=par[4]; dexp(x,rate)}
cum=function(par,x){rate=par[4]; pexp(x,rate)}
starts<-c(1,1,1,1/mean.mydata)
}}
if(g=="rayleigh"){
den=function(par,x){a=par[4]; loc=par[5]; 2*(x-loc)/a*exp(-((x-loc)/a)^2)}
cum=function(par,x){a=par[4]; loc=par[5]; 1-exp(-((x-loc)/a)^2)}
starts<-c(1,1,1,log(2)/(median.mydata)^2,(min.mydata-1/length(y)))
if (location==FALSE){
den=function(par,x){a=par[4]; 2*x/a*exp(-(x/a)^2)}
cum=function(par,x){a=par[4]; 1-exp(-(x/a)^2)}
starts<-c(1,1,1,log(2)/(median.mydata)^2)
}}
if(g=="burrxii"){
den=function(par,x){a=par[4]; d=par[5]; loc=par[6]; d*a*(1+(x-loc)^d)^(-a-1)*((x-loc)^(d-1))}
cum=function(par,x){a=par[4]; d=par[5]; loc=par[6]; 1-(1+(x-loc)^d)^(-a)}
z1=NULL;
burrxii.log<-function(p){
z1<--n*log(p[1])-n*log(p[2])-(p[2]-1)*sum(log(y))+(p[1]+1)*sum(log(1+y^p[2]))
}
p.hat<-suppressWarnings(optim(c(1,1),burrxii.log, method="BFGS")$par)
starts<-c(1,1,1,p.hat[1],p.hat[2],(min.mydata-1/length(y)))
if (location==FALSE){
den=function(par,x){a=par[4]; d=par[5]; d*a*(1+(x)^d)^(-a-1)*((x)^(d-1))}
cum=function(par,x){a=par[4]; d=par[5]; 1-(1+(x)^d)^(-a)}
starts<-c(1,1,1,p.hat[1],p.hat[2])
}}
if(g=="frechet"){
den=function(par,x){a=par[4]; b=par[5]; loc=par[6]; (a*exp(-((x-loc)/b)^(-a))*((x-loc)/b)^(-a-1))/(b)}
cum=function(par,x){a=par[4]; b=par[5]; loc=par[6]; exp(-((x-loc)/b)^(-a))}
cons<-cor(inv.mydata,rank(inv.mydata))*(sd(inv.mydata)/mean(inv.mydata))*sqrt((n+1)/(n-1))/sqrt(3)
a.hat<-abs(ifelse(cons<1,-log(2)/log(1-cons),-log(2)/log(1-.98)))
b.hat<-median(inv.mydata)/(log(2))^(1/a.hat)
starts<-c(1,1,1,a.hat,1/b.hat,(min.mydata-1/length(y)))
if (location==FALSE){
den=function(par,x){a=par[4]; b=par[5]; (a*exp(-((x)/b)^(-a))*((x)/b)^(-a-1))/(b)}
cum=function(par,x){a=par[4]; b=par[5]; exp(-((x)/b)^(-a))}
starts<-c(1,1,1,a.hat,1/b.hat)
}}
if(g=="birnbaum-saunders"){
den=function(par,x){a=par[4]; b=par[5]; loc=par[6]; (sqrt((x-loc)/b)+sqrt(b/(x-loc)))/(2*a*(x-loc))*dnorm((sqrt((x-loc)/b)-sqrt(b/(x-loc)))/a)}
cum=function(par,x){a=par[4]; b=par[5]; loc=par[6]; pnorm((sqrt((x-loc)/b)-sqrt(b/(x-loc)))/a)}
r<-(mean(inv.mydata))^(-1)
b.hat<-sqrt(mean.mydata*r)
a.hat<-sqrt(2*(sqrt(mean.mydata/r)))
starts<-c(1,1,1,a.hat,b.hat,(min.mydata-1/length(y)))
if (location==FALSE){
den=function(par,x){a=par[4]; b=par[5]; (sqrt((x)/b)+sqrt(b/(x)))/(2*a*(x))*dnorm((sqrt((x)/b)-sqrt(b/(x)))/a)}
cum=function(par,x){a=par[4]; b=par[5]; pnorm((sqrt((x)/b)-sqrt(b/(x)))/a)}
starts<-c(1,1,1,a.hat,b.hat)
}}
if(g=="weibull"){
den=function(par,x){shape=par[4]; scale=par[5]; loc=par[6]; dweibull(x-loc,shape,scale)}
cum=function(par,x){shape=par[4]; scale=par[5]; loc=par[6]; pweibull(x-loc,shape,scale)}
cons<-cor(mydata,rank(mydata))*(std.mydata/mean.mydata)*sqrt((n+1)/(n-1))/sqrt(3)
a.hat<-abs(ifelse(cons<1,-log(2)/log(1-cons),-log(2)/log(1-.98)))
b.hat<-median.mydata/(log(2))^(1/a.hat)
starts<-c(1,1,1,a.hat,b.hat,(min.mydata-1/length(y)))
if (location==FALSE){
den=function(par,x){shape=par[4]; scale=par[5]; dweibull(x,shape,scale)}
cum=function(par,x){shape=par[4]; scale=par[5]; pweibull(x,shape,scale)}
starts<-c(1,1,1,a.hat,b.hat)
}}
if(g=="gamma"){
den=function(par,x){shape=par[4]; scale=par[5]; loc=par[6]; dgamma(x-loc,shape,scale)}
cum=function(par,x){shape=par[4]; scale=par[5]; loc=par[6]; pgamma(x-loc,shape,scale)}
a.hat<-uniroot(function(ss) trigamma(ss)-var(log(y)[is.finite(log(y))]),c(0,1000000))$root
b.hat<-mean.mydata/a.hat
starts<-c(1,1,1,a.hat,b.hat,(min.mydata-1/length(y)))
if (location==FALSE){
den=function(par,x){shape=par[4]; scale=par[5]; dgamma(x,shape,scale)}
cum=function(par,x){shape=par[4]; scale=par[5]; pgamma(x,shape,scale)}
starts<-c(1,1,1,a.hat,b.hat)
}}
pdf0<-function(par,x){
f0=den(par,x)
c0=cum(par,x)
a=par[1]
b=par[2]
d=par[3]
d*beta(a,b)^(-1)*f0*c0^(a*d-1)*(1-c0^d)^(b-1)
}
cdf0<-function(par,x){
f0=den(par,x)
c0=cum(par,x)
a=par[1]
b=par[2]
d=par[3]
pbeta(c0^d,shape1=a,shape2=b)
}
mpsw<-function(par,x){
z=NULL
z=diff(c(0,cdf0(par,x),1))
for (j in 2:n){if((x[j]-x[j-1])==0){z[j]=pdf0(par,x[j])
}}
z[z<1e-16]=1e-16
-sum(log(z))
}
out<-suppressWarnings(optim(starts,fn=mpsw,x=sort.mydata,method))
n.p<-length(out$par)
if (location==TRUE){
out$par[1:(n.p-1)]<-abs(out$par[1:(n.p-1)])}
else{
out$par[1:n.p]<-abs(out$par[1:n.p])
}
gammam<-(n+1)*(log(n+1)-digamma(1))-1/2-1/(12*(n+1))
sigma2m<-(n+1)*(pi^2/6-1)-1/2-1/(6*(n+1))
c1<-gammam-sqrt(n*sigma2m/2)
c2<-sqrt(sigma2m/(2*n))
stat.chisquare<-(mpsw(out$par,sort.mydata)+n.p/2-c1)/c2
pvalue.chisquare<-pchisq(stat.chisquare,df=n,lower.tail=FALSE)
Moran<-out$value
log.likelihood=sum(log(pdf0(out$par,sort.mydata)))
u=cdf0(out$par,sort.mydata)
von<-c()
anderson<-c()
for(i in 1:n){
u[i]<-ifelse(u[i]==1,0.999999999,u[i])
von[i]=(u[i]-(2*i-1)/(2*n))^2
anderson[i]=(2*i-1)*log(u[i])+(2*n+1-2*i)*log(1-u[i])
}
anderson.stat=-n-mean(anderson)
von.stat=sum(von)+1/(12*n)
CAIC=-2*log.likelihood + 2*n.p + 2*(n.p*(n.p+1))/(n-n.p-1)
AIC=-2*log.likelihood + 2*n.p
BIC=-2*log.likelihood + n.p*log(n)
HQIC=-2*log.likelihood + 2*log(log(n))*n.p
ks.stat=suppressWarnings(ks.test(mydata, "cdf0", par=out$par))
aux2=cbind(AIC, CAIC, BIC, HQIC, von.stat, anderson.stat,log.likelihood,Moran)
colnames(aux2)=c("AIC","CAIC","BIC","HQIC","CM","AD", "log",
"Moran")
rownames(aux2)=c("")
aux3=cbind(ks.stat$statistic,ks.stat$p.value)
colnames(aux3)=c("statistic","p-value")
rownames(aux3)=c("")
aux4=cbind(stat.chisquare,qchisq(sig.level,df=n,lower.tail=FALSE),1-pchisq(stat.chisquare,df=n))
colnames(aux4)=c("statistic","chi-value","p-value")
rownames(aux4)=c("")
aux5=cbind(if(out$convergence==0){"Algorithm Converged"} else {"Algorithm Not Converged"})
list("MPS"=out$par,"Measures"=aux2,"KS"=aux3,"chi-square"=aux4,"Convergence Status"=aux5)
}
mpsgtransg<-function(mydata, g, location=TRUE, method , sig.level){
min.mydata<-min(mydata)
sort.mydata<-sort(mydata)
n<-length(mydata)
y<-(sort.mydata[2:n]-min.mydata)
y<-(sort.mydata[2:n]-min.mydata)[is.finite(log(sort.mydata[2:n]-min.mydata))]
n<-length(mydata)
qp1<-y[floor(.25*n)]
qp3<-y[floor(.75*n)]
median.mydata<-y[floor(.5*n)]
mean.mydata<-mean(y)
inv.mydata<-1/y[is.finite(1/y)]
inv.mean<-mean(inv.mydata)
std.mydata<-sd(y)
if(g!="birnbaum-saunders" & g!="exp" & g!="rayleigh" & g!="weibull" & g!="gompertz" & g!="gamma"
& g!="log-normal" & g!="chisq" & g!="f" & g!="burrxii" & g!="frechet"
& g!="lomax" & g!="log-logistic" & g!="lfr" & g!="chen")
{ stop ("Baseline distribution not implemented or misspelled. Please check the manual for guidelines.") }
if(g=="log-normal"){
den=function(par,x){meanlog=par[3]; sdlog=par[4]; loc=par[5]; dlnorm(x-loc,meanlog,sdlog)}
cum=function(par,x){meanlog=par[3]; sdlog=par[4]; loc=par[5]; plnorm(x-loc,meanlog,sdlog)}
starts<-c(1,0.5,log(median.mydata),sqrt(2*abs(log(mean.mydata/median.mydata))),(min.mydata-1/length(y)))
if (location==FALSE){
den=function(par,x){meanlog=par[3]; sdlog=par[4]; dlnorm(x,meanlog,sdlog)}
cum=function(par,x){meanlog=par[3]; sdlog=par[4]; plnorm(x,meanlog,sdlog)}
starts<-c(1,0.5,log(median.mydata),sqrt(2*abs(log(mean.mydata/median.mydata))))
}}
if(g=="chisq"){
den=function(par,x){df=par[3]; loc=par[4]; dchisq(x-loc,df)}
cum=function(par,x){df=par[3]; loc=par[4]; pchisq(x-loc,df)}
starts<-c(1,0.5,mean.mydata,(min.mydata-1/length(y)))
if (location==FALSE){
den=function(par,x){df=par[3]; dchisq(x,df)}
cum=function(par,x){df=par[3]; pchisq(x,df)}
starts<-c(1,0.5,mean.mydata)
}}
if(g=="f"){
den=function(par,x){df1=par[3]; df2=par[4]; loc=par[5]; df(x-loc,df1,df2)}
cum=function(par,x){df1=par[3]; df2=par[4]; loc=par[5]; pf(x-loc,df1,df2)}
df.1<-ifelse(inv.mean>1,2*inv.mean/(inv.mean-1),1)
df.2<-ifelse(mean.mydata>1,2*mean.mydata/(mean.mydata-1),1)
starts<-c(1,0.5,df.1,df.2,(min.mydata-1/length(y)))
if (location==FALSE){
den=function(par,x){df1=par[3]; df2=par[4]; df(x,df1,df2)}
cum=function(par,x){df1=par[3]; df2=par[4]; pf(x,df1,df2)}
starts<-c(1,0.5,df.1,df.2)
}}
if(g=="chen"){
den=function(par,x){a=par[3]; b=par[4]; loc=par[5]; a*b*(x-loc)^(a-1)*exp((x-loc)^a)*exp(-b*(exp((x-loc)^a)-1))}
cum=function(par,x){a=par[3]; b=par[4]; loc=par[5]; 1-exp(-b*(exp((x-loc)^a)-1))}
standard.mydata<-(y-mean.mydata)/std.mydata
s.hat<-ifelse(max(standard.mydata)<=1,-log(1-n/(n+.4))/(exp(1)-1),-
log(1-length(standard.mydata[standard.mydata<=1])/length(standard.mydata))/(exp(1)-1))
r.hat<-abs(log(log(1-log(1-0.5)/s.hat))/log(median.mydata))
starts<-c(1,0.5,r.hat,s.hat,(min.mydata-1/length(y)))
if (location==FALSE){
den=function(par,x){a=par[3]; b=par[4]; a*b*(x)^(a-1)*exp((x)^a)*exp(-b*(exp((x)^a)-1))}
cum=function(par,x){a=par[3]; b=par[4]; 1-exp(-b*(exp((x)^a)-1))}
starts<-c(1,0.5,r.hat,s.hat)
}}
if(g=="lfr"){
den=function(par,x){a=par[3]; b=par[4]; loc=par[5]; (a+b*(x-loc))*exp(-a*(x-loc)-(b*(x-loc)^2)/2)}
cum=function(par,x){a=par[3]; b=par[4]; loc=par[5]; 1-exp(-a*(x-loc)-(b*(x-loc)^2)/2)}
ii<-seq(1,(n-1))
yy<--log(1-(ii+0.3)/(n-1+0.4))
res<-summary(lm(yy ~ -1+y+I(y^2)))$coefficient
coeff<-c(abs(res[1,1]),abs(res[2,1]))
z1=NULL;
lfr.log<-function(p) {
z1<--log(sum(p[1]+p[2]*y))+p[1]*sum(y)+p[2]/2*sum(y^2)
z1[z1<1e-16]<-1e-16
}
p.hat<-suppressWarnings(optim(c(abs(coeff[1]),2*abs(coeff[2])),lfr.log)$par)
starts<-c(1,0.5,p.hat[1],p.hat[2],(min.mydata-1/length(y)))
if (location==FALSE){
den=function(par,x){a=par[3]; b=par[4]; (a+b*(x))*exp(-a*(x)-(b*(x)^2)/2)}
cum=function(par,x){a=par[3]; b=par[4]; 1-exp(-a*(x)-(b*(x)^2)/2)}
starts<-c(1,0.5,p.hat[1],p.hat[2])
}}
if(g=="log-logistic"){
den=function(par,x){a=par[3]; b=par[4]; loc=par[5]; (a*b^(-a)*(x-loc)^(a-1))/((((x-loc)/b)^a +1)^2)}
cum=function(par,x){a=par[3]; b=par[4]; loc=par[5]; 1/(((x-loc)/b)^(-a)+1)}
starts<-c(1,0.5,log(0.75/(1-0.75))/log(qp3/median.mydata),median.mydata,(min.mydata-1/length(y)))
if (location==FALSE){
den=function(par,x){a=par[3]; b=par[4]; (a*b^(-a)*(x)^(a-1))/((((x)/b)^a +1)^2)}
cum=function(par,x){a=par[3]; b=par[4]; 1/(((x)/b)^(-a)+1)}
starts<-c(1,0.5,log(0.75/(1-0.75))/log(qp3/median.mydata),median.mydata)
}}
if(g=="lomax"){
den=function(par,x){a=par[3]; b=par[4]; loc=par[5]; (a*b)/((1+a*(x-loc))^(b+1))}
cum=function(par,x){a=par[3]; b=par[4]; loc=par[5]; 1-(1+a*(x-loc))^(-b)}
a.hat<-1
b.hat<-(.5^(-1/a.hat)-1)/median.mydata
z1=NULL;
lomax.log<-function(p) {
z1<--n*log(p[1])-n*log(p[2])+(p[2]+1)*sum(log(1+p[1]*y))
z1[z1<1e-16]<-1e-16
}
p.hat<-suppressWarnings(optim(c(1,b.hat),lomax.log, method)$par)
starts<-c(1,0.5,p.hat[1],p.hat[2],(min.mydata-1/length(y)))
if (location==FALSE){
den=function(par,x){a=par[3]; b=par[4]; (a*b)/((1+a*(x))^(b+1))}
cum=function(par,x){a=par[3]; b=par[4]; 1-(1+a*(x))^(-b)}
starts<-c(1,0.5,p.hat[1],p.hat[2])
}}
if(g=="gompertz"){
den=function(par,x){a=par[3]; b=par[4]; loc=par[5]; b*exp(a*(x-loc))*exp(-(exp(a*(x-loc))-1)*b/a)}
cum=function(par,x){a=par[3]; b=par[4]; loc=par[5]; 1-exp(-(exp(a*(x-loc))-1)*b/a)}
a.hat<-log(log(1-.75)/log(1-.5))/(qp3-median.mydata)
b.hat<--a.hat*log(0.5)/(exp(a.hat*median.mydata)-1)
z1=NULL;
gompertz.log<-function(p){
z1<--n*log(p[2])-p[1]*sum(y)+p[2]/p[1]*sum(exp(p[1]*y)-1)
z1[z1<1e-16]<-1e-16
}
p.hat<-suppressWarnings(optim(c(a.hat,b.hat),gompertz.log, method)$par)
starts<-c(1,0.5,p.hat[1],p.hat[2],(min.mydata-1/length(y)))
if (location==FALSE){
den=function(par,x){a=par[3]; b=par[4]; b*exp(a*(x))*exp(-(exp(a*(x))-1)*b/a)}
cum=function(par,x){a=par[3]; b=par[4]; 1-exp(-(exp(a*(x))-1)*b/a)}
starts<-c(1,0.5,p.hat[1],p.hat[2])
}}
if(g=="exp"){
den=function(par,x){rate=par[3]; loc=par[4]; dexp(x-loc,rate)}
cum=function(par,x){rate=par[3]; loc=par[4]; pexp(x-loc,rate)}
starts<-c(1,0.5,1/mean.mydata,(min.mydata-1/length(y)))
if (location==FALSE){
den=function(par,x){rate=par[3]; dexp(x,rate)}
cum=function(par,x){rate=par[3]; pexp(x,rate)}
starts<-c(1,0.5,1/mean.mydata)
}}
if(g=="rayleigh"){
den=function(par,x){a=par[3]; loc=par[4]; 2*(x-loc)/a*exp(-((x-loc)/a)^2)}
cum=function(par,x){a=par[3]; loc=par[4]; 1-exp(-((x-loc)/a)^2)}
starts<-c(1,0.5,log(2)/(median.mydata)^2,(min.mydata-1/length(y)))
if (location==FALSE){
den=function(par,x){a=par[3]; 2*x/a*exp(-(x/a)^2)}
cum=function(par,x){a=par[3]; 1-exp(-(x/a)^2)}
starts<-c(1,0.5,log(2)/(median.mydata)^2)
}}
if(g=="burrxii"){
den=function(par,x){a=par[3]; d=par[4]; loc=par[5]; d*a*(1+(x-loc)^d)^(-a-1)*((x-loc)^(d-1))}
cum=function(par,x){a=par[3]; d=par[4]; loc=par[5]; 1-(1+(x-loc)^d)^(-a)}
z1=NULL;
burrxii.log<-function(p){
z1<--n*log(p[1])-n*log(p[2])-(p[2]-1)*sum(log(y))+(p[1]+1)*sum(log(1+y^p[2]))
}
p.hat<-suppressWarnings(optim(c(1,1),burrxii.log, method="BFGS")$par)
starts<-c(1,0.5,p.hat[1],p.hat[2],(min.mydata-1/length(y)))
if (location==FALSE){
den=function(par,x){a=par[3]; d=par[4]; d*a*(1+(x)^d)^(-a-1)*((x)^(d-1))}
cum=function(par,x){a=par[3]; d=par[4]; 1-(1+(x)^d)^(-a)}
starts<-c(1,0.5,p.hat[1],p.hat[2])
}}
if(g=="frechet"){
den=function(par,x){a=par[3]; b=par[4]; loc=par[5]; (a*exp(-((x-loc)/b)^(-a))*((x-loc)/b)^(-a-1))/(b)}
cum=function(par,x){a=par[3]; b=par[4]; loc=par[5]; exp(-((x-loc)/b)^(-a))}
cons<-cor(inv.mydata,rank(inv.mydata))*(sd(inv.mydata)/mean(inv.mydata))*sqrt((n+1)/(n-1))/sqrt(3)
a.hat<-abs(ifelse(cons<1,-log(2)/log(1-cons),-log(2)/log(1-.98)))
b.hat<-median(inv.mydata)/(log(2))^(1/a.hat)
starts<-c(1,0.5,a.hat,1/b.hat,(min.mydata-1/length(y)))
if (location==FALSE){
den=function(par,x){a=par[3]; b=par[4]; (a*exp(-((x)/b)^(-a))*((x)/b)^(-a-1))/(b)}
cum=function(par,x){a=par[3]; b=par[4]; exp(-((x)/b)^(-a))}
starts<-c(1,0.5,a.hat,1/b.hat)
}}
if(g=="birnbaum-saunders"){
den=function(par,x){a=par[3]; b=par[4]; loc=par[5]; (sqrt((x-loc)/b)+sqrt(b/(x-loc)))/(2*a*(x-loc))*dnorm((sqrt((x-loc)/b)-sqrt(b/(x-loc)))/a)}
cum=function(par,x){a=par[3]; b=par[4]; loc=par[5]; pnorm((sqrt((x-loc)/b)-sqrt(b/(x-loc)))/a)}
r<-(mean(inv.mydata))^(-1)
b.hat<-sqrt(mean.mydata*r)
a.hat<-sqrt(2*(sqrt(mean.mydata/r)))
starts<-c(1,0.5,a.hat,b.hat,(min.mydata-1/length(y)))
if (location==FALSE){
den=function(par,x){a=par[3]; b=par[4]; (sqrt((x)/b)+sqrt(b/(x)))/(2*a*(x))*dnorm((sqrt((x)/b)-sqrt(b/(x)))/a)}
cum=function(par,x){a=par[3]; b=par[4]; pnorm((sqrt((x)/b)-sqrt(b/(x)))/a)}
starts<-c(1,0.5,a.hat,b.hat)
}}
if(g=="weibull"){
den=function(par,x){shape=par[3]; scale=par[4]; loc=par[5]; dweibull(x-loc,shape,scale)}
cum=function(par,x){shape=par[3]; scale=par[4]; loc=par[5]; pweibull(x-loc,shape,scale)}
cons<-cor(mydata,rank(mydata))*(std.mydata/mean.mydata)*sqrt((n+1)/(n-1))/sqrt(3)
a.hat<-abs(ifelse(cons<1,-log(2)/log(1-cons),-log(2)/log(1-.98)))
b.hat<-median.mydata/(log(2))^(1/a.hat)
starts<-c(1,0.5,a.hat,b.hat,(min.mydata-1/length(y)))
if (location==FALSE){
den=function(par,x){shape=par[3]; scale=par[4]; dweibull(x,shape,scale)}
cum=function(par,x){shape=par[3]; scale=par[4]; pweibull(x,shape,scale)}
starts<-c(1,0.5,a.hat,b.hat)
}}
if(g=="gamma"){
den=function(par,x){shape=par[3]; scale=par[4]; loc=par[5]; dgamma(x-loc,shape,scale)}
cum=function(par,x){shape=par[3]; scale=par[4]; loc=par[5]; pgamma(x-loc,shape,scale)}
a.hat<-uniroot(function(ss) trigamma(ss)-var(log(y)[is.finite(log(y))]),c(0,1000000))$root
b.hat<-mean.mydata/a.hat
starts<-c(1,0.5,a.hat,b.hat,(min.mydata-1/length(y)))
if (location==FALSE){
den=function(par,x){shape=par[3]; scale=par[4]; dgamma(x,shape,scale)}
cum=function(par,x){shape=par[3]; scale=par[4]; pgamma(x,shape,scale)}
starts<-c(1,0.5,a.hat,b.hat)
}}
pdf0<-function(par,x){
f0=den(par,x)
c0=cum(par,x)
a=par[1]
b=par[2]
a*f0*(c0)**(a-1)*(1+b-2*b*c0)*(1+b*(1-c0))**(a-1)
}
cdf0<-function(par,x){
f0=den(par,x)
c0=cum(par,x)
a=par[1]
b=par[2]
(c0)**a*(1+b*(1-c0))**(a)
}
mpsw<-function(par,x){
z=NULL
z=diff(c(0,cdf0(par,x),1))
for (j in 2:n){if((x[j]-x[j-1])==0){z[j]=pdf0(par,x[j])
}}
z[z<1e-16]=1e-16
-sum(log(z))
}
out<-suppressWarnings(optim(starts,fn=mpsw,x=sort.mydata,method))
n.p<-length(out$par)
gammam<-(n+1)*(log(n+1)-digamma(1))-1/2-1/(12*(n+1))
sigma2m<-(n+1)*(pi^2/6-1)-1/2-1/(6*(n+1))
c1<-gammam-sqrt(n*sigma2m/2)
c2<-sqrt(sigma2m/(2*n))
stat.chisquare<-(mpsw(out$par,sort.mydata)+n.p/2-c1)/c2
pvalue.chisquare<-pchisq(stat.chisquare,df=n,lower.tail=FALSE)
Moran<-out$value
log.likelihood=sum(log(pdf0(out$par,sort.mydata)))
u=cdf0(out$par,sort.mydata)
von<-c()
anderson<-c()
for(i in 1:n){
u[i]<-ifelse(u[i]==1,0.999999999,u[i])
von[i]=(u[i]-(2*i-1)/(2*n))^2
anderson[i]=(2*i-1)*log(u[i])+(2*n+1-2*i)*log(1-u[i])
}
anderson.stat=-n-mean(anderson)
von.stat=sum(von)+1/(12*n)
CAIC=-2*log.likelihood + 2*n.p + 2*(n.p*(n.p+1))/(n-n.p-1)
AIC=-2*log.likelihood + 2*n.p
BIC=-2*log.likelihood + n.p*log(n)
HQIC=-2*log.likelihood + 2*log(log(n))*n.p
ks.stat=suppressWarnings(ks.test(mydata, "cdf0", par=out$par))
aux2=cbind(AIC, CAIC, BIC, HQIC, von.stat, anderson.stat,log.likelihood,Moran)
colnames(aux2)=c("AIC","CAIC","BIC","HQIC","CM","AD", "log",
"Moran")
rownames(aux2)=c("")
aux3=cbind(ks.stat$statistic,ks.stat$p.value)
colnames(aux3)=c("statistic","p-value")
rownames(aux3)=c("")
aux4=cbind(stat.chisquare,qchisq(sig.level,df=n,lower.tail=FALSE),1-pchisq(stat.chisquare,df=n))
colnames(aux4)=c("statistic","chi-value","p-value")
rownames(aux4)=c("")
aux5=cbind(if(out$convergence==0){"Algorithm Converged"} else {"Algorithm Not Converged"})
list("MPS"=out$par,"Measures"=aux2,"KS"=aux3,"chi-square"=aux4,"Convergence Status"=aux5)
}
mpskumg<-function(mydata, g, location=TRUE, method , sig.level){
min.mydata<-min(mydata)
sort.mydata<-sort(mydata)
n<-length(mydata)
y<-(sort.mydata[2:n]-min.mydata)
y<-(sort.mydata[2:n]-min.mydata)[is.finite(log(sort.mydata[2:n]-min.mydata))]
n<-length(mydata)
qp1<-y[floor(.25*n)]
qp3<-y[floor(.75*n)]
median.mydata<-y[floor(.5*n)]
mean.mydata<-mean(y)
inv.mydata<-1/y[is.finite(1/y)]
inv.mean<-mean(inv.mydata)
std.mydata<-sd(y)
if(g!="birnbaum-saunders" & g!="exp" & g!="rayleigh" & g!="weibull" & g!="gompertz" & g!="gamma"
& g!="log-normal" & g!="chisq" & g!="f" & g!="burrxii" & g!="frechet"
& g!="lomax" & g!="log-logistic" & g!="lfr" & g!="chen")
{ stop ("Baseline distribution not implemented or misspelled. Please check the manual for guidelines.") }
if(g=="log-normal"){
den=function(par,x){meanlog=par[3]; sdlog=par[4]; loc=par[5]; dlnorm(x-loc,meanlog,sdlog)}
cum=function(par,x){meanlog=par[3]; sdlog=par[4]; loc=par[5]; plnorm(x-loc,meanlog,sdlog)}
starts<-c(1,1,log(median.mydata),sqrt(2*abs(log(mean.mydata/median.mydata))),(min.mydata-1/length(y)))
if (location==FALSE){
den=function(par,x){meanlog=par[3]; sdlog=par[4]; dlnorm(x,meanlog,sdlog)}
cum=function(par,x){meanlog=par[3]; sdlog=par[4]; plnorm(x,meanlog,sdlog)}
starts<-c(1,1,log(median.mydata),sqrt(2*abs(log(mean.mydata/median.mydata))))
}}
if(g=="chisq"){
den=function(par,x){df=par[3]; loc=par[4]; dchisq(x-loc,df)}
cum=function(par,x){df=par[3]; loc=par[4]; pchisq(x-loc,df)}
starts<-c(1,1,mean.mydata,(min.mydata-1/length(y)))
if (location==FALSE){
den=function(par,x){df=par[3]; dchisq(x,df)}
cum=function(par,x){df=par[3]; pchisq(x,df)}
starts<-c(1,1,mean.mydata)
}}
if(g=="f"){
den=function(par,x){df1=par[3]; df2=par[4]; loc=par[5]; df(x-loc,df1,df2)}
cum=function(par,x){df1=par[3]; df2=par[4]; loc=par[5]; pf(x-loc,df1,df2)}
df.1<-ifelse(inv.mean>1,2*inv.mean/(inv.mean-1),1)
df.2<-ifelse(mean.mydata>1,2*mean.mydata/(mean.mydata-1),1)
starts<-c(1,1,df.1,df.2,(min.mydata-1/length(y)))
if (location==FALSE){
den=function(par,x){df1=par[3]; df2=par[4]; df(x,df1,df2)}
cum=function(par,x){df1=par[3]; df2=par[4]; pf(x,df1,df2)}
starts<-c(1,1,df.1,df.2)
}}
if(g=="chen"){
den=function(par,x){a=par[3]; b=par[4]; loc=par[5]; a*b*(x-loc)^(a-1)*exp((x-loc)^a)*exp(-b*(exp((x-loc)^a)-1))}
cum=function(par,x){a=par[3]; b=par[4]; loc=par[5]; 1-exp(-b*(exp((x-loc)^a)-1))}
standard.mydata<-(y-mean.mydata)/std.mydata
s.hat<-ifelse(max(standard.mydata)<=1,-log(1-n/(n+.4))/(exp(1)-1),-
log(1-length(standard.mydata[standard.mydata<=1])/length(standard.mydata))/(exp(1)-1))
r.hat<-abs(log(log(1-log(1-0.5)/s.hat))/log(median.mydata))
starts<-c(1,1,r.hat,s.hat,(min.mydata-1/length(y)))
if (location==FALSE){
den=function(par,x){a=par[3]; b=par[4]; a*b*(x)^(a-1)*exp((x)^a)*exp(-b*(exp((x)^a)-1))}
cum=function(par,x){a=par[3]; b=par[4]; 1-exp(-b*(exp((x)^a)-1))}
starts<-c(1,1,r.hat,s.hat)
}}
if(g=="lfr"){
den=function(par,x){a=par[3]; b=par[4]; loc=par[5]; (a+b*(x-loc))*exp(-a*(x-loc)-(b*(x-loc)^2)/2)}
cum=function(par,x){a=par[3]; b=par[4]; loc=par[5]; 1-exp(-a*(x-loc)-(b*(x-loc)^2)/2)}
ii<-seq(1,(n-1))
yy<--log(1-(ii+0.3)/(n-1+0.4))
res<-summary(lm(yy ~ -1+y+I(y^2)))$coefficient
coeff<-c(abs(res[1,1]),abs(res[2,1]))
z1=NULL;
lfr.log<-function(p) {
z1<--log(sum(p[1]+p[2]*y))+p[1]*sum(y)+p[2]/2*sum(y^2)
z1[z1<1e-16]<-1e-16
}
p.hat<-suppressWarnings(optim(c(abs(coeff[1]),2*abs(coeff[2])),lfr.log)$par)
starts<-c(1,1,p.hat[1],p.hat[2],(min.mydata-1/length(y)))
if (location==FALSE){
den=function(par,x){a=par[3]; b=par[4]; (a+b*(x))*exp(-a*(x)-(b*(x)^2)/2)}
cum=function(par,x){a=par[3]; b=par[4]; 1-exp(-a*(x)-(b*(x)^2)/2)}
starts<-c(1,1,p.hat[1],p.hat[2])
}}
if(g=="log-logistic"){
den=function(par,x){a=par[3]; b=par[4]; loc=par[5]; (a*b^(-a)*(x-loc)^(a-1))/((((x-loc)/b)^a +1)^2)}
cum=function(par,x){a=par[3]; b=par[4]; loc=par[5]; 1/(((x-loc)/b)^(-a)+1)}
starts<-c(1,1,log(0.75/(1-0.75))/log(qp3/median.mydata),median.mydata,(min.mydata-1/length(y)))
if (location==FALSE){
den=function(par,x){a=par[3]; b=par[4]; (a*b^(-a)*(x)^(a-1))/((((x)/b)^a +1)^2)}
cum=function(par,x){a=par[3]; b=par[4]; 1/(((x)/b)^(-a)+1)}
starts<-c(1,1,log(0.75/(1-0.75))/log(qp3/median.mydata),median.mydata)
}}
if(g=="lomax"){
den=function(par,x){a=par[3]; b=par[4]; loc=par[5]; (a*b)/((1+a*(x-loc))^(b+1))}
cum=function(par,x){a=par[3]; b=par[4]; loc=par[5]; 1-(1+a*(x-loc))^(-b)}
a.hat<-1
b.hat<-(.5^(-1/a.hat)-1)/median.mydata
z1=NULL;
lomax.log<-function(p) {
z1<--n*log(p[1])-n*log(p[2])+(p[2]+1)*sum(log(1+p[1]*y))
z1[z1<1e-16]<-1e-16
}
p.hat<-suppressWarnings(optim(c(1,b.hat),lomax.log, method)$par)
starts<-c(1,1,p.hat[1],p.hat[2],(min.mydata-1/length(y)))
if (location==FALSE){
den=function(par,x){a=par[3]; b=par[4]; (a*b)/((1+a*(x))^(b+1))}
cum=function(par,x){a=par[3]; b=par[4]; 1-(1+a*(x))^(-b)}
starts<-c(1,1,p.hat[1],p.hat[2])
}}
if(g=="gompertz"){
den=function(par,x){a=par[3]; b=par[4]; loc=par[5]; b*exp(a*(x-loc))*exp(-(exp(a*(x-loc))-1)*b/a)}
cum=function(par,x){a=par[3]; b=par[4]; loc=par[5]; 1-exp(-(exp(a*(x-loc))-1)*b/a)}
a.hat<-log(log(1-.75)/log(1-.5))/(qp3-median.mydata)
b.hat<--a.hat*log(0.5)/(exp(a.hat*median.mydata)-1)
z1=NULL;
gompertz.log<-function(p){
z1<--n*log(p[2])-p[1]*sum(y)+p[2]/p[1]*sum(exp(p[1]*y)-1)
z1[z1<1e-16]<-1e-16
}
p.hat<-suppressWarnings(optim(c(a.hat,b.hat),gompertz.log, method)$par)
starts<-c(1,1,p.hat[1],p.hat[2],(min.mydata-1/length(y)))
if (location==FALSE){
den=function(par,x){a=par[3]; b=par[4]; b*exp(a*(x))*exp(-(exp(a*(x))-1)*b/a)}
cum=function(par,x){a=par[3]; b=par[4]; 1-exp(-(exp(a*(x))-1)*b/a)}
starts<-c(1,1,p.hat[1],p.hat[2])
}}
if(g=="exp"){
den=function(par,x){rate=par[3]; loc=par[4]; dexp(x-loc,rate)}
cum=function(par,x){rate=par[3]; loc=par[4]; pexp(x-loc,rate)}
starts<-c(1,1,1/mean.mydata,(min.mydata-1/length(y)))
if (location==FALSE){
den=function(par,x){rate=par[3]; dexp(x,rate)}
cum=function(par,x){rate=par[3]; pexp(x,rate)}
starts<-c(1,1,1/mean.mydata)
}}
if(g=="rayleigh"){
den=function(par,x){a=par[3]; loc=par[4]; 2*(x-loc)/a*exp(-((x-loc)/a)^2)}
cum=function(par,x){a=par[3]; loc=par[4]; 1-exp(-((x-loc)/a)^2)}
starts<-c(1,1,log(2)/(median.mydata)^2,(min.mydata-1/length(y)))
if (location==FALSE){
den=function(par,x){a=par[3]; 2*x/a*exp(-(x/a)^2)}
cum=function(par,x){a=par[3]; 1-exp(-(x/a)^2)}
starts<-c(1,1,log(2)/(median.mydata)^2)
}}
if(g=="burrxii"){
den=function(par,x){a=par[3]; d=par[4]; loc=par[5]; d*a*(1+(x-loc)^d)^(-a-1)*((x-loc)^(d-1))}
cum=function(par,x){a=par[3]; d=par[4]; loc=par[5]; 1-(1+(x-loc)^d)^(-a)}
z1=NULL;
burrxii.log<-function(p){
z1<--n*log(p[1])-n*log(p[2])-(p[2]-1)*sum(log(y))+(p[1]+1)*sum(log(1+y^p[2]))
}
p.hat<-suppressWarnings(optim(c(1,1),burrxii.log, method="BFGS")$par)
starts<-c(1,1,p.hat[1],p.hat[2],(min.mydata-1/length(y)))
if (location==FALSE){
den=function(par,x){a=par[3]; d=par[4]; d*a*(1+(x)^d)^(-a-1)*((x)^(d-1))}
cum=function(par,x){a=par[3]; d=par[4]; 1-(1+(x)^d)^(-a)}
starts<-c(1,1,p.hat[1],p.hat[2])
}}
if(g=="frechet"){
den=function(par,x){a=par[3]; b=par[4]; loc=par[5]; (a*exp(-((x-loc)/b)^(-a))*((x-loc)/b)^(-a-1))/(b)}
cum=function(par,x){a=par[3]; b=par[4]; loc=par[5]; exp(-((x-loc)/b)^(-a))}
cons<-cor(inv.mydata,rank(inv.mydata))*(sd(inv.mydata)/mean(inv.mydata))*sqrt((n+1)/(n-1))/sqrt(3)
a.hat<-abs(ifelse(cons<1,-log(2)/log(1-cons),-log(2)/log(1-.98)))
b.hat<-median(inv.mydata)/(log(2))^(1/a.hat)
starts<-c(1,1,a.hat,1/b.hat,(min.mydata-1/length(y)))
if (location==FALSE){
den=function(par,x){a=par[3]; b=par[4]; (a*exp(-((x)/b)^(-a))*((x)/b)^(-a-1))/(b)}
cum=function(par,x){a=par[3]; b=par[4]; exp(-((x)/b)^(-a))}
starts<-c(1,1,a.hat,1/b.hat)
}}
if(g=="birnbaum-saunders"){
den=function(par,x){a=par[3]; b=par[4]; loc=par[5]; (sqrt((x-loc)/b)+sqrt(b/(x-loc)))/(2*a*(x-loc))*dnorm((sqrt((x-loc)/b)-sqrt(b/(x-loc)))/a)}
cum=function(par,x){a=par[3]; b=par[4]; loc=par[5]; pnorm((sqrt((x-loc)/b)-sqrt(b/(x-loc)))/a)}
r<-(mean(inv.mydata))^(-1)
b.hat<-sqrt(mean.mydata*r)
a.hat<-sqrt(2*(sqrt(mean.mydata/r)))
starts<-c(1,1,a.hat,b.hat,(min.mydata-1/length(y)))
if (location==FALSE){
den=function(par,x){a=par[3]; b=par[4]; (sqrt((x)/b)+sqrt(b/(x)))/(2*a*(x))*dnorm((sqrt((x)/b)-sqrt(b/(x)))/a)}
cum=function(par,x){a=par[3]; b=par[4]; pnorm((sqrt((x)/b)-sqrt(b/(x)))/a)}
starts<-c(1,1,a.hat,b.hat)
}}
if(g=="weibull"){
den=function(par,x){shape=par[3]; scale=par[4]; loc=par[5]; dweibull(x-loc,shape,scale)}
cum=function(par,x){shape=par[3]; scale=par[4]; loc=par[5]; pweibull(x-loc,shape,scale)}
cons<-cor(mydata,rank(mydata))*(std.mydata/mean.mydata)*sqrt((n+1)/(n-1))/sqrt(3)
a.hat<-abs(ifelse(cons<1,-log(2)/log(1-cons),-log(2)/log(1-.98)))
b.hat<-median.mydata/(log(2))^(1/a.hat)
starts<-c(1,1,a.hat,b.hat,(min.mydata-1/length(y)))
if (location==FALSE){
den=function(par,x){shape=par[3]; scale=par[4]; dweibull(x,shape,scale)}
cum=function(par,x){shape=par[3]; scale=par[4]; pweibull(x,shape,scale)}
starts<-c(1,1,a.hat,b.hat)
}}
if(g=="gamma"){
den=function(par,x){shape=par[3]; scale=par[4]; loc=par[5]; dgamma(x-loc,shape,scale)}
cum=function(par,x){shape=par[3]; scale=par[4]; loc=par[5]; pgamma(x-loc,shape,scale)}
a.hat<-uniroot(function(ss) trigamma(ss)-var(log(y)[is.finite(log(y))]),c(0,1000000))$root
b.hat<-mean.mydata/a.hat
starts<-c(1,1,a.hat,b.hat,(min.mydata-1/length(y)))
if (location==FALSE){
den=function(par,x){shape=par[3]; scale=par[4]; dgamma(x,shape,scale)}
cum=function(par,x){shape=par[3]; scale=par[4]; pgamma(x,shape,scale)}
starts<-c(1,1,a.hat,b.hat)
}}
pdf0<-function(par,x){
f0=den(par,x)
c0=cum(par,x)
r=par[1]
u=par[2]
r*u*f0*(c0^(r-1))*(1-c0^r)^(u-1)
}
cdf0<-function(par,x){
f0=den(par,x)
c0=cum(par,x)
r=par[1]
u=par[2]
1-(1-c0^r)^u
}
mpsw<-function(par,x){
z=NULL
z=diff(c(0,cdf0(par,x),1))
for (j in 2:n){if((x[j]-x[j-1])==0){z[j]=pdf0(par,x[j])
}}
z[z<1e-16]=1e-16
-sum(log(z))
}
out<-suppressWarnings(optim(starts,fn=mpsw,x=sort.mydata,method))
n.p<-length(out$par)
gammam<-(n+1)*(log(n+1)-digamma(1))-1/2-1/(12*(n+1))
sigma2m<-(n+1)*(pi^2/6-1)-1/2-1/(6*(n+1))
c1<-gammam-sqrt(n*sigma2m/2)
c2<-sqrt(sigma2m/(2*n))
stat.chisquare<-(mpsw(out$par,sort.mydata)+n.p/2-c1)/c2
pvalue.chisquare<-pchisq(stat.chisquare,df=n,lower.tail=FALSE)
Moran<-out$value
log.likelihood=sum(log(pdf0(out$par,sort.mydata)))
u=cdf0(out$par,sort.mydata)
von<-c()
anderson<-c()
for(i in 1:n){
u[i]<-ifelse(u[i]==1,0.999999999,u[i])
von[i]=(u[i]-(2*i-1)/(2*n))^2
anderson[i]=(2*i-1)*log(u[i])+(2*n+1-2*i)*log(1-u[i])
}
anderson.stat=-n-mean(anderson)
von.stat=sum(von)+1/(12*n)
CAIC=-2*log.likelihood + 2*n.p + 2*(n.p*(n.p+1))/(n-n.p-1)
AIC=-2*log.likelihood + 2*n.p
BIC=-2*log.likelihood + n.p*log(n)
HQIC=-2*log.likelihood + 2*log(log(n))*n.p
ks.stat=suppressWarnings(ks.test(mydata, "cdf0", par=out$par))
aux2=cbind(AIC, CAIC, BIC, HQIC, von.stat, anderson.stat,log.likelihood,Moran)
colnames(aux2)=c("AIC","CAIC","BIC","HQIC","CM","AD", "log",
"Moran")
rownames(aux2)=c("")
aux3=cbind(ks.stat$statistic,ks.stat$p.value)
colnames(aux3)=c("statistic","p-value")
rownames(aux3)=c("")
aux4=cbind(stat.chisquare,qchisq(sig.level,df=n,lower.tail=FALSE),1-pchisq(stat.chisquare,df=n))
colnames(aux4)=c("statistic","chi-value","p-value")
rownames(aux4)=c("")
aux5=cbind(if(out$convergence==0){"Algorithm Converged"} else {"Algorithm Not Converged"})
list("MPS"=out$par,"Measures"=aux2,"KS"=aux3,"chi-square"=aux4,"Convergence Status"=aux5)
}
mpsologlogg<-function(mydata, g, location=TRUE, method, sig.level){
min.mydata<-min(mydata)
sort.mydata<-sort(mydata)
n<-length(mydata)
y<-(sort.mydata[2:n]-min.mydata)
y<-(sort.mydata[2:n]-min.mydata)[is.finite(log(sort.mydata[2:n]-min.mydata))]
n<-length(mydata)
qp1<-y[floor(.25*n)]
qp3<-y[floor(.75*n)]
median.mydata<-y[floor(.5*n)]
mean.mydata<-mean(y)
inv.mydata<-1/y[is.finite(1/y)]
inv.mean<-mean(inv.mydata)
std.mydata<-sd(y)
if(g!="birnbaum-saunders" & g!="exp" & g!="rayleigh" & g!="weibull" & g!="gompertz" & g!="gamma"
& g!="log-normal" & g!="chisq" & g!="f" & g!="burrxii" & g!="frechet"
& g!="lomax" & g!="log-logistic" & g!="lfr" & g!="chen")
{ stop ("Baseline distribution not implemented or misspelled. Please check the manual for guidelines.") }
if(g=="log-normal"){
den=function(par,x){meanlog=par[4]; sdlog=par[5]; loc=par[6]; dlnorm(x-loc,meanlog,sdlog)}
cum=function(par,x){meanlog=par[4]; sdlog=par[5]; loc=par[6]; plnorm(x-loc,meanlog,sdlog)}
starts<-c(1,1,1,log(median.mydata),sqrt(2*abs(log(mean.mydata/median.mydata))),(min.mydata-1/length(y)))
if (location==FALSE){
den=function(par,x){meanlog=par[4]; sdlog=par[5]; dlnorm(x,meanlog,sdlog)}
cum=function(par,x){meanlog=par[4]; sdlog=par[5]; plnorm(x,meanlog,sdlog)}
starts<-c(1,1,1,log(median.mydata),sqrt(2*abs(log(mean.mydata/median.mydata))))
}}
if(g=="chisq"){
den=function(par,x){df=par[4]; loc=par[5]; dchisq(x-loc,df)}
cum=function(par,x){df=par[4]; loc=par[5]; pchisq(x-loc,df)}
starts<-c(1,1,1,mean.mydata,(min.mydata-1/length(y)))
if (location==FALSE){
den=function(par,x){df=par[4]; dchisq(x,df)}
cum=function(par,x){df=par[4]; pchisq(x,df)}
starts<-c(1,1,1,mean.mydata)
}}
if(g=="f"){
den=function(par,x){df1=par[4]; df2=par[5]; loc=par[6]; df(x-loc,df1,df2)}
cum=function(par,x){df1=par[4]; df2=par[5]; loc=par[6]; pf(x-loc,df1,df2)}
df.1<-ifelse(inv.mean>1,2*inv.mean/(inv.mean-1),1)
df.2<-ifelse(mean.mydata>1,2*mean.mydata/(mean.mydata-1),1)
starts<-c(1,1,1,df.1,df.2,(min.mydata-1/length(y)))
if (location==FALSE){
den=function(par,x){df1=par[4]; df2=par[5]; df(x,df1,df2)}
cum=function(par,x){df1=par[4]; df2=par[5]; pf(x,df1,df2)}
starts<-c(1,1,1,df.1,df.2)
}}
if(g=="chen"){
den=function(par,x){a=par[4]; b=par[5]; loc=par[6]; a*b*(x-loc)^(a-1)*exp((x-loc)^a)*exp(-b*(exp((x-loc)^a)-1))}
cum=function(par,x){a=par[4]; b=par[5]; loc=par[6]; 1-exp(-b*(exp((x-loc)^a)-1))}
standard.mydata<-(y-mean.mydata)/std.mydata
s.hat<-ifelse(max(standard.mydata)<=1,-log(1-n/(n+.4))/(exp(1)-1),-
log(1-length(standard.mydata[standard.mydata<=1])/length(standard.mydata))/(exp(1)-1))
r.hat<-abs(log(log(1-log(1-0.5)/s.hat))/log(median.mydata))
starts<-c(1,1,1,r.hat,s.hat,(min.mydata-1/length(y)))
if (location==FALSE){
den=function(par,x){a=par[4]; b=par[5]; a*b*(x)^(a-1)*exp((x)^a)*exp(-b*(exp((x)^a)-1))}
cum=function(par,x){a=par[4]; b=par[5]; 1-exp(-b*(exp((x)^a)-1))}
starts<-c(1,1,1,r.hat,s.hat)
}}
if(g=="lfr"){
den=function(par,x){a=par[4]; b=par[5]; loc=par[6]; (a+b*(x-loc))*exp(-a*(x-loc)-(b*(x-loc)^2)/2)}
cum=function(par,x){a=par[4]; b=par[5]; loc=par[6]; 1-exp(-a*(x-loc)-(b*(x-loc)^2)/2)}
ii<-seq(1,(n-1))
yy<--log(1-(ii+0.3)/(n-1+0.4))
res<-summary(lm(yy ~ -1+y+I(y^2)))$coefficient
coeff<-c(abs(res[1,1]),abs(res[2,1]))
z1=NULL;
lfr.log<-function(p) {
z1<--log(sum(p[1]+p[2]*y))+p[1]*sum(y)+p[2]/2*sum(y^2)
z1[z1<1e-16]<-1e-16
}
p.hat<-suppressWarnings(optim(c(abs(coeff[1]),2*abs(coeff[2])),lfr.log)$par)
starts<-c(1,1,1,p.hat[1],p.hat[2],(min.mydata-1/length(y)))
if (location==FALSE){
den=function(par,x){a=par[4]; b=par[5]; (a+b*(x))*exp(-a*(x)-(b*(x)^2)/2)}
cum=function(par,x){a=par[4]; b=par[5]; 1-exp(-a*(x)-(b*(x)^2)/2)}
starts<-c(1,1,1,p.hat[1],p.hat[2])
}}
if(g=="log-logistic"){
den=function(par,x){a=par[4]; b=par[5]; loc=par[6]; (a*b^(-a)*(x-loc)^(a-1))/((((x-loc)/b)^a +1)^2)}
cum=function(par,x){a=par[4]; b=par[5]; loc=par[6]; 1/(((x-loc)/b)^(-a)+1)}
starts<-c(1,1,1,log(0.75/(1-0.75))/log(qp3/median.mydata),median.mydata,(min.mydata-1/length(y)))
if (location==FALSE){
den=function(par,x){a=par[4]; b=par[5]; (a*b^(-a)*(x)^(a-1))/((((x)/b)^a +1)^2)}
cum=function(par,x){a=par[4]; b=par[5]; 1/(((x)/b)^(-a)+1)}
starts<-c(1,1,1,log(0.75/(1-0.75))/log(qp3/median.mydata),median.mydata)
}}
if(g=="lomax"){
den=function(par,x){a=par[4]; b=par[5]; loc=par[6]; (a*b)/((1+a*(x-loc))^(b+1))}
cum=function(par,x){a=par[4]; b=par[5]; loc=par[6]; 1-(1+a*(x-loc))^(-b)}
a.hat<-1
b.hat<-(.5^(-1/a.hat)-1)/median.mydata
z1=NULL;
lomax.log<-function(p) {
z1<--n*log(p[1])-n*log(p[2])+(p[2]+1)*sum(log(1+p[1]*y))
z1[z1<1e-16]<-1e-16
}
p.hat<-suppressWarnings(optim(c(1,b.hat),lomax.log, method)$par)
starts<-c(1,1,1,p.hat[1],p.hat[2],(min.mydata-1/length(y)))
if (location==FALSE){
den=function(par,x){a=par[4]; b=par[5]; (a*b)/((1+a*(x))^(b+1))}
cum=function(par,x){a=par[4]; b=par[5]; 1-(1+a*(x))^(-b)}
starts<-c(1,1,1,p.hat[1],p.hat[2])
}}
if(g=="gompertz"){
den=function(par,x){a=par[4]; b=par[5]; loc=par[6]; b*exp(a*(x-loc))*exp(-(exp(a*(x-loc))-1)*b/a)}
cum=function(par,x){a=par[4]; b=par[5]; loc=par[6]; 1-exp(-(exp(a*(x-loc))-1)*b/a)}
a.hat<-log(log(1-.75)/log(1-.5))/(qp3-median.mydata)
b.hat<--a.hat*log(0.5)/(exp(a.hat*median.mydata)-1)
z1=NULL;
gompertz.log<-function(p){
z1<--n*log(p[2])-p[1]*sum(y)+p[2]/p[1]*sum(exp(p[1]*y)-1)
z1[z1<1e-16]<-1e-16
}
p.hat<-suppressWarnings(optim(c(a.hat,b.hat),gompertz.log, method)$par)
starts<-c(1,1,1,p.hat[1],p.hat[2],(min.mydata-1/length(y)))
if (location==FALSE){
den=function(par,x){a=par[4]; b=par[5]; b*exp(a*(x))*exp(-(exp(a*(x))-1)*b/a)}
cum=function(par,x){a=par[4]; b=par[5]; 1-exp(-(exp(a*(x))-1)*b/a)}
starts<-c(1,1,1,p.hat[1],p.hat[2])
}}
if(g=="exp"){
den=function(par,x){rate=par[4]; loc=par[5]; dexp(x-loc,rate)}
cum=function(par,x){rate=par[4]; loc=par[5]; pexp(x-loc,rate)}
starts<-c(1,1,1,1/mean.mydata,(min.mydata-1/length(y)))
if (location==FALSE){
den=function(par,x){rate=par[4]; dexp(x,rate)}
cum=function(par,x){rate=par[4]; pexp(x,rate)}
starts<-c(1,1,1,1/mean.mydata)
}}
if(g=="rayleigh"){
den=function(par,x){a=par[4]; loc=par[5]; 2*(x-loc)/a*exp(-((x-loc)/a)^2)}
cum=function(par,x){a=par[4]; loc=par[5]; 1-exp(-((x-loc)/a)^2)}
starts<-c(1,1,1,log(2)/(median.mydata)^2,(min.mydata-1/length(y)))
if (location==FALSE){
den=function(par,x){a=par[4]; 2*x/a*exp(-(x/a)^2)}
cum=function(par,x){a=par[4]; 1-exp(-(x/a)^2)}
starts<-c(1,1,1,log(2)/(median.mydata)^2)
}}
if(g=="burrxii"){
den=function(par,x){a=par[4]; d=par[5]; loc=par[6]; d*a*(1+(x-loc)^d)^(-a-1)*((x-loc)^(d-1))}
cum=function(par,x){a=par[4]; d=par[5]; loc=par[6]; 1-(1+(x-loc)^d)^(-a)}
z1=NULL;
burrxii.log<-function(p){
z1<--n*log(p[1])-n*log(p[2])-(p[2]-1)*sum(log(y))+(p[1]+1)*sum(log(1+y^p[2]))
}
p.hat<-suppressWarnings(optim(c(1,1),burrxii.log, method="BFGS")$par)
starts<-c(1,1,1,p.hat[1],p.hat[2],(min.mydata-1/length(y)))
if (location==FALSE){
den=function(par,x){a=par[4]; d=par[5]; d*a*(1+(x)^d)^(-a-1)*((x)^(d-1))}
cum=function(par,x){a=par[4]; d=par[5]; 1-(1+(x)^d)^(-a)}
starts<-c(1,1,1,p.hat[1],p.hat[2])
}}
if(g=="frechet"){
den=function(par,x){a=par[4]; b=par[5]; loc=par[6]; (a*exp(-((x-loc)/b)^(-a))*((x-loc)/b)^(-a-1))/(b)}
cum=function(par,x){a=par[4]; b=par[5]; loc=par[6]; exp(-((x-loc)/b)^(-a))}
cons<-cor(inv.mydata,rank(inv.mydata))*(sd(inv.mydata)/mean(inv.mydata))*sqrt((n+1)/(n-1))/sqrt(3)
a.hat<-abs(ifelse(cons<1,-log(2)/log(1-cons),-log(2)/log(1-.98)))
b.hat<-median(inv.mydata)/(log(2))^(1/a.hat)
starts<-c(1,1,1,a.hat,1/b.hat,(min.mydata-1/length(y)))
if (location==FALSE){
den=function(par,x){a=par[4]; b=par[5]; (a*exp(-((x)/b)^(-a))*((x)/b)^(-a-1))/(b)}
cum=function(par,x){a=par[4]; b=par[5]; exp(-((x)/b)^(-a))}
starts<-c(1,1,1,a.hat,1/b.hat)
}}
if(g=="birnbaum-saunders"){
den=function(par,x){a=par[4]; b=par[5]; loc=par[6]; (sqrt((x-loc)/b)+sqrt(b/(x-loc)))/(2*a*(x-loc))*dnorm((sqrt((x-loc)/b)-sqrt(b/(x-loc)))/a)}
cum=function(par,x){a=par[4]; b=par[5]; loc=par[6]; pnorm((sqrt((x-loc)/b)-sqrt(b/(x-loc)))/a)}
r<-(mean(inv.mydata))^(-1)
b.hat<-sqrt(mean.mydata*r)
a.hat<-sqrt(2*(sqrt(mean.mydata/r)))
starts<-c(1,1,1,a.hat,b.hat,(min.mydata-1/length(y)))
if (location==FALSE){
den=function(par,x){a=par[4]; b=par[5]; (sqrt((x)/b)+sqrt(b/(x)))/(2*a*(x))*dnorm((sqrt((x)/b)-sqrt(b/(x)))/a)}
cum=function(par,x){a=par[4]; b=par[5]; pnorm((sqrt((x)/b)-sqrt(b/(x)))/a)}
starts<-c(1,1,1,a.hat,b.hat)
}}
if(g=="weibull"){
den=function(par,x){shape=par[4]; scale=par[5]; loc=par[6]; dweibull(x-loc,shape,scale)}
cum=function(par,x){shape=par[4]; scale=par[5]; loc=par[6]; pweibull(x-loc,shape,scale)}
cons<-cor(mydata,rank(mydata))*(std.mydata/mean.mydata)*sqrt((n+1)/(n-1))/sqrt(3)
a.hat<-abs(ifelse(cons<1,-log(2)/log(1-cons),-log(2)/log(1-.98)))
b.hat<-median.mydata/(log(2))^(1/a.hat)
starts<-c(1,1,1,a.hat,b.hat,(min.mydata-1/length(y)))
if (location==FALSE){
den=function(par,x){shape=par[4]; scale=par[5]; dweibull(x,shape,scale)}
cum=function(par,x){shape=par[4]; scale=par[5]; pweibull(x,shape,scale)}
starts<-c(1,1,1,a.hat,b.hat)
}}
if(g=="gamma"){
den=function(par,x){shape=par[4]; scale=par[5]; loc=par[6]; dgamma(x-loc,shape,scale)}
cum=function(par,x){shape=par[4]; scale=par[5]; loc=par[6]; pgamma(x-loc,shape,scale)}
a.hat<-uniroot(function(ss) trigamma(ss)-var(log(y)[is.finite(log(y))]),c(0,1000000))$root
b.hat<-mean.mydata/a.hat
starts<-c(1,1,1,a.hat,b.hat,(min.mydata-1/length(y)))
if (location==FALSE){
den=function(par,x){shape=par[4]; scale=par[5]; dgamma(x,shape,scale)}
cum=function(par,x){shape=par[4]; scale=par[5]; pgamma(x,shape,scale)}
starts<-c(1,1,1,a.hat,b.hat)
}}
pdf0<-function(par,x){
f0=den(par,x)
c0=cum(par,x)
a=par[1]
b=par[2]
d=par[3]
a*b*d*f0*c0**(d*a-1)*(1-c0)**(d-1)*(c0**d+(1-c0)**d)**(-a-1)*(1-(c0**d/(c0**d+(1-c0)**d))**a)**(b-1)
}
cdf0<-function(par,x){
f0=den(par,x)
c0=cum(par,x)
a=par[1]
b=par[2]
d=par[3]
1-(1-(c0**d/(c0**d+(1-c0)**d))**a)**b
}
mpsw<-function(par,x){
z=NULL
z=diff(c(0,cdf0(par,x),1))
for (j in 2:n){if((x[j]-x[j-1])==0){z[j]=pdf0(par,x[j])
}}
z[z<1e-16]=1e-16
-sum(log(z))
}
out<-suppressWarnings(optim(starts,fn=mpsw,x=sort.mydata,method))
n.p<-length(out$par)
gammam<-(n+1)*(log(n+1)-digamma(1))-1/2-1/(12*(n+1))
sigma2m<-(n+1)*(pi^2/6-1)-1/2-1/(6*(n+1))
c1<-gammam-sqrt(n*sigma2m/2)
c2<-sqrt(sigma2m/(2*n))
stat.chisquare<-(mpsw(out$par,sort.mydata)+n.p/2-c1)/c2
pvalue.chisquare<-pchisq(stat.chisquare,df=n,lower.tail=FALSE)
Moran<-out$value
log.likelihood=sum(log(pdf0(out$par,sort.mydata)))
u=cdf0(out$par,sort.mydata)
von<-c()
anderson<-c()
for(i in 1:n){
u[i]<-ifelse(u[i]==1,0.999999999,u[i])
von[i]=(u[i]-(2*i-1)/(2*n))^2
anderson[i]=(2*i-1)*log(u[i])+(2*n+1-2*i)*log(1-u[i])
}
anderson.stat=-n-mean(anderson)
von.stat=sum(von)+1/(12*n)
CAIC=-2*log.likelihood + 2*n.p + 2*(n.p*(n.p+1))/(n-n.p-1)
AIC=-2*log.likelihood + 2*n.p
BIC=-2*log.likelihood + n.p*log(n)
HQIC=-2*log.likelihood + 2*log(log(n))*n.p
ks.stat=suppressWarnings(ks.test(mydata, "cdf0", par=out$par))
aux2=cbind(AIC, CAIC, BIC, HQIC, von.stat, anderson.stat,log.likelihood,Moran)
colnames(aux2)=c("AIC","CAIC","BIC","HQIC","CM","AD", "log",
"Moran")
rownames(aux2)=c("")
aux3=cbind(ks.stat$statistic,ks.stat$p.value)
colnames(aux3)=c("statistic","p-value")
rownames(aux3)=c("")
aux4=cbind(stat.chisquare,qchisq(sig.level,df=n,lower.tail=FALSE),1-pchisq(stat.chisquare,df=n))
colnames(aux4)=c("statistic","chi-value","p-value")
rownames(aux4)=c("")
aux5=cbind(if(out$convergence==0){"Algorithm Converged"} else {"Algorithm Not Converged"})
list("MPS"=out$par,"Measures"=aux2,"KS"=aux3,"chi-square"=aux4,"Convergence Status"=aux5)
}
mpsloggammag1<-function(mydata, g, location=TRUE, method , sig.level){
min.mydata<-min(mydata)
sort.mydata<-sort(mydata)
n<-length(mydata)
y<-(sort.mydata[2:n]-min.mydata)
y<-(sort.mydata[2:n]-min.mydata)[is.finite(log(sort.mydata[2:n]-min.mydata))]
n<-length(mydata)
qp1<-y[floor(.25*n)]
qp3<-y[floor(.75*n)]
median.mydata<-y[floor(.5*n)]
mean.mydata<-mean(y)
inv.mydata<-1/y[is.finite(1/y)]
inv.mean<-mean(inv.mydata)
std.mydata<-sd(y)
if(g!="birnbaum-saunders" & g!="exp" & g!="rayleigh" & g!="weibull" & g!="gompertz" & g!="gamma"
& g!="log-normal" & g!="chisq" & g!="f" & g!="burrxii" & g!="frechet"
& g!="lomax" & g!="log-logistic" & g!="lfr" & g!="chen")
{ stop ("Baseline distribution not implemented or misspelled. Please check the manual for guidelines.") }
if(g=="log-normal"){
den=function(par,x){meanlog=par[3]; sdlog=par[4]; loc=par[5]; dlnorm(x-loc,meanlog,sdlog)}
cum=function(par,x){meanlog=par[3]; sdlog=par[4]; loc=par[5]; plnorm(x-loc,meanlog,sdlog)}
starts<-c(1,1,log(median.mydata),sqrt(2*abs(log(mean.mydata/median.mydata))),(min.mydata-1/length(y)))
if (location==FALSE){
den=function(par,x){meanlog=par[3]; sdlog=par[4]; dlnorm(x,meanlog,sdlog)}
cum=function(par,x){meanlog=par[3]; sdlog=par[4]; plnorm(x,meanlog,sdlog)}
starts<-c(1,1,log(median.mydata),sqrt(2*abs(log(mean.mydata/median.mydata))))
}}
if(g=="chisq"){
den=function(par,x){df=par[3]; loc=par[4]; dchisq(x-loc,df)}
cum=function(par,x){df=par[3]; loc=par[4]; pchisq(x-loc,df)}
starts<-c(1,1,mean.mydata,(min.mydata-1/length(y)))
if (location==FALSE){
den=function(par,x){df=par[3]; dchisq(x,df)}
cum=function(par,x){df=par[3]; pchisq(x,df)}
starts<-c(1,1,mean.mydata)
}}
if(g=="f"){
den=function(par,x){df1=par[3]; df2=par[4]; loc=par[5]; df(x-loc,df1,df2)}
cum=function(par,x){df1=par[3]; df2=par[4]; loc=par[5]; pf(x-loc,df1,df2)}
df.1<-ifelse(inv.mean>1,2*inv.mean/(inv.mean-1),1)
df.2<-ifelse(mean.mydata>1,2*mean.mydata/(mean.mydata-1),1)
starts<-c(1,1,df.1,df.2,(min.mydata-1/length(y)))
if (location==FALSE){
den=function(par,x){df1=par[3]; df2=par[4]; df(x,df1,df2)}
cum=function(par,x){df1=par[3]; df2=par[4]; pf(x,df1,df2)}
starts<-c(1,1,df.1,df.2)
}}
if(g=="chen"){
den=function(par,x){a=par[3]; b=par[4]; loc=par[5]; a*b*(x-loc)^(a-1)*exp((x-loc)^a)*exp(-b*(exp((x-loc)^a)-1))}
cum=function(par,x){a=par[3]; b=par[4]; loc=par[5]; 1-exp(-b*(exp((x-loc)^a)-1))}
standard.mydata<-(y-mean.mydata)/std.mydata
s.hat<-ifelse(max(standard.mydata)<=1,-log(1-n/(n+.4))/(exp(1)-1),-
log(1-length(standard.mydata[standard.mydata<=1])/length(standard.mydata))/(exp(1)-1))
r.hat<-abs(log(log(1-log(1-0.5)/s.hat))/log(median.mydata))
starts<-c(1,1,r.hat,s.hat,(min.mydata-1/length(y)))
if (location==FALSE){
den=function(par,x){a=par[3]; b=par[4]; a*b*(x)^(a-1)*exp((x)^a)*exp(-b*(exp((x)^a)-1))}
cum=function(par,x){a=par[3]; b=par[4]; 1-exp(-b*(exp((x)^a)-1))}
starts<-c(1,1,r.hat,s.hat)
}}
if(g=="lfr"){
den=function(par,x){a=par[3]; b=par[4]; loc=par[5]; (a+b*(x-loc))*exp(-a*(x-loc)-(b*(x-loc)^2)/2)}
cum=function(par,x){a=par[3]; b=par[4]; loc=par[5]; 1-exp(-a*(x-loc)-(b*(x-loc)^2)/2)}
ii<-seq(1,(n-1))
yy<--log(1-(ii+0.3)/(n-1+0.4))
res<-summary(lm(yy ~ -1+y+I(y^2)))$coefficient
coeff<-c(abs(res[1,1]),abs(res[2,1]))
z1=NULL;
lfr.log<-function(p) {
z1<--log(sum(p[1]+p[2]*y))+p[1]*sum(y)+p[2]/2*sum(y^2)
z1[z1<1e-16]<-1e-16
}
p.hat<-suppressWarnings(optim(c(abs(coeff[1]),2*abs(coeff[2])),lfr.log)$par)
starts<-c(1,1,p.hat[1],p.hat[2],(min.mydata-1/length(y)))
if (location==FALSE){
den=function(par,x){a=par[3]; b=par[4]; (a+b*(x))*exp(-a*(x)-(b*(x)^2)/2)}
cum=function(par,x){a=par[3]; b=par[4]; 1-exp(-a*(x)-(b*(x)^2)/2)}
starts<-c(1,1,p.hat[1],p.hat[2])
}}
if(g=="log-logistic"){
den=function(par,x){a=par[3]; b=par[4]; loc=par[5]; (a*b^(-a)*(x-loc)^(a-1))/((((x-loc)/b)^a +1)^2)}
cum=function(par,x){a=par[3]; b=par[4]; loc=par[5]; 1/(((x-loc)/b)^(-a)+1)}
starts<-c(1,1,log(0.75/(1-0.75))/log(qp3/median.mydata),median.mydata,(min.mydata-1/length(y)))
if (location==FALSE){
den=function(par,x){a=par[3]; b=par[4]; (a*b^(-a)*(x)^(a-1))/((((x)/b)^a +1)^2)}
cum=function(par,x){a=par[3]; b=par[4]; 1/(((x)/b)^(-a)+1)}
starts<-c(1,1,log(0.75/(1-0.75))/log(qp3/median.mydata),median.mydata)
}}
if(g=="lomax"){
den=function(par,x){a=par[3]; b=par[4]; loc=par[5]; (a*b)/((1+a*(x-loc))^(b+1))}
cum=function(par,x){a=par[3]; b=par[4]; loc=par[5]; 1-(1+a*(x-loc))^(-b)}
a.hat<-1
b.hat<-(.5^(-1/a.hat)-1)/median.mydata
z1=NULL;
lomax.log<-function(p) {
z1<--n*log(p[1])-n*log(p[2])+(p[2]+1)*sum(log(1+p[1]*y))
z1[z1<1e-16]<-1e-16
}
p.hat<-suppressWarnings(optim(c(1,b.hat),lomax.log, method)$par)
starts<-c(1,1,p.hat[1],p.hat[2],(min.mydata-1/length(y)))
if (location==FALSE){
den=function(par,x){a=par[3]; b=par[4]; (a*b)/((1+a*(x))^(b+1))}
cum=function(par,x){a=par[3]; b=par[4]; 1-(1+a*(x))^(-b)}
starts<-c(1,1,p.hat[1],p.hat[2])
}}
if(g=="gompertz"){
den=function(par,x){a=par[3]; b=par[4]; loc=par[5]; b*exp(a*(x-loc))*exp(-(exp(a*(x-loc))-1)*b/a)}
cum=function(par,x){a=par[3]; b=par[4]; loc=par[5]; 1-exp(-(exp(a*(x-loc))-1)*b/a)}
a.hat<-log(log(1-.75)/log(1-.5))/(qp3-median.mydata)
b.hat<--a.hat*log(0.5)/(exp(a.hat*median.mydata)-1)
z1=NULL;
gompertz.log<-function(p){
z1<--n*log(p[2])-p[1]*sum(y)+p[2]/p[1]*sum(exp(p[1]*y)-1)
z1[z1<1e-16]<-1e-16
}
p.hat<-suppressWarnings(optim(c(a.hat,b.hat),gompertz.log, method)$par)
starts<-c(1,1,p.hat[1],p.hat[2],(min.mydata-1/length(y)))
if (location==FALSE){
den=function(par,x){a=par[3]; b=par[4]; b*exp(a*(x))*exp(-(exp(a*(x))-1)*b/a)}
cum=function(par,x){a=par[3]; b=par[4]; 1-exp(-(exp(a*(x))-1)*b/a)}
starts<-c(1,1,p.hat[1],p.hat[2])
}}
if(g=="exp"){
den=function(par,x){rate=par[3]; loc=par[4]; dexp(x-loc,rate)}
cum=function(par,x){rate=par[3]; loc=par[4]; pexp(x-loc,rate)}
starts<-c(1,1,1/mean.mydata,(min.mydata-1/length(y)))
if (location==FALSE){
den=function(par,x){rate=par[3]; dexp(x,rate)}
cum=function(par,x){rate=par[3]; pexp(x,rate)}
starts<-c(1,1,1/mean.mydata)
}}
if(g=="rayleigh"){
den=function(par,x){a=par[3]; loc=par[4]; 2*(x-loc)/a*exp(-((x-loc)/a)^2)}
cum=function(par,x){a=par[3]; loc=par[4]; 1-exp(-((x-loc)/a)^2)}
starts<-c(1,1,log(2)/(median.mydata)^2,(min.mydata-1/length(y)))
if (location==FALSE){
den=function(par,x){a=par[3]; 2*x/a*exp(-(x/a)^2)}
cum=function(par,x){a=par[3]; 1-exp(-(x/a)^2)}
starts<-c(1,1,log(2)/(median.mydata)^2)
}}
if(g=="burrxii"){
den=function(par,x){a=par[3]; d=par[4]; loc=par[5]; d*a*(1+(x-loc)^d)^(-a-1)*((x-loc)^(d-1))}
cum=function(par,x){a=par[3]; d=par[4]; loc=par[5]; 1-(1+(x-loc)^d)^(-a)}
z1=NULL;
burrxii.log<-function(p){
z1<--n*log(p[1])-n*log(p[2])-(p[2]-1)*sum(log(y))+(p[1]+1)*sum(log(1+y^p[2]))
}
p.hat<-suppressWarnings(optim(c(1,1),burrxii.log, method="BFGS")$par)
starts<-c(1,1,p.hat[1],p.hat[2],(min.mydata-1/length(y)))
if (location==FALSE){
den=function(par,x){a=par[3]; d=par[4]; d*a*(1+(x)^d)^(-a-1)*((x)^(d-1))}
cum=function(par,x){a=par[3]; d=par[4]; 1-(1+(x)^d)^(-a)}
starts<-c(1,1,p.hat[1],p.hat[2])
}}
if(g=="frechet"){
den=function(par,x){a=par[3]; b=par[4]; loc=par[5]; (a*exp(-((x-loc)/b)^(-a))*((x-loc)/b)^(-a-1))/(b)}
cum=function(par,x){a=par[3]; b=par[4]; loc=par[5]; exp(-((x-loc)/b)^(-a))}
cons<-cor(inv.mydata,rank(inv.mydata))*(sd(inv.mydata)/mean(inv.mydata))*sqrt((n+1)/(n-1))/sqrt(3)
a.hat<-abs(ifelse(cons<1,-log(2)/log(1-cons),-log(2)/log(1-.98)))
b.hat<-median(inv.mydata)/(log(2))^(1/a.hat)
starts<-c(1,1,a.hat,1/b.hat,(min.mydata-1/length(y)))
if (location==FALSE){
den=function(par,x){a=par[3]; b=par[4]; (a*exp(-((x)/b)^(-a))*((x)/b)^(-a-1))/(b)}
cum=function(par,x){a=par[3]; b=par[4]; exp(-((x)/b)^(-a))}
starts<-c(1,1,a.hat,1/b.hat)
}}
if(g=="birnbaum-saunders"){
den=function(par,x){a=par[3]; b=par[4]; loc=par[5]; (sqrt((x-loc)/b)+sqrt(b/(x-loc)))/(2*a*(x-loc))*dnorm((sqrt((x-loc)/b)-sqrt(b/(x-loc)))/a)}
cum=function(par,x){a=par[3]; b=par[4]; loc=par[5]; pnorm((sqrt((x-loc)/b)-sqrt(b/(x-loc)))/a)}
r<-(mean(inv.mydata))^(-1)
b.hat<-sqrt(mean.mydata*r)
a.hat<-sqrt(2*(sqrt(mean.mydata/r)))
starts<-c(1,1,a.hat,b.hat,(min.mydata-1/length(y)))
if (location==FALSE){
den=function(par,x){a=par[3]; b=par[4]; (sqrt((x)/b)+sqrt(b/(x)))/(2*a*(x))*dnorm((sqrt((x)/b)-sqrt(b/(x)))/a)}
cum=function(par,x){a=par[3]; b=par[4]; pnorm((sqrt((x)/b)-sqrt(b/(x)))/a)}
starts<-c(1,1,a.hat,b.hat)
}}
if(g=="weibull"){
den=function(par,x){shape=par[3]; scale=par[4]; loc=par[5]; dweibull(x-loc,shape,scale)}
cum=function(par,x){shape=par[3]; scale=par[4]; loc=par[5]; pweibull(x-loc,shape,scale)}
cons<-cor(mydata,rank(mydata))*(std.mydata/mean.mydata)*sqrt((n+1)/(n-1))/sqrt(3)
a.hat<-abs(ifelse(cons<1,-log(2)/log(1-cons),-log(2)/log(1-.98)))
b.hat<-median.mydata/(log(2))^(1/a.hat)
starts<-c(1,1,a.hat,b.hat,(min.mydata-1/length(y)))
if (location==FALSE){
den=function(par,x){shape=par[3]; scale=par[4]; dweibull(x,shape,scale)}
cum=function(par,x){shape=par[3]; scale=par[4]; pweibull(x,shape,scale)}
starts<-c(1,1,a.hat,b.hat)
}}
if(g=="gamma"){
den=function(par,x){shape=par[3]; scale=par[4]; loc=par[5]; dgamma(x-loc,shape,scale)}
cum=function(par,x){shape=par[3]; scale=par[4]; loc=par[5]; pgamma(x-loc,shape,scale)}
a.hat<-uniroot(function(ss) trigamma(ss)-var(log(y)[is.finite(log(y))]),c(0,1000000))$root
b.hat<-mean.mydata/a.hat
starts<-c(1,1,a.hat,b.hat,(min.mydata-1/length(y)))
if (location==FALSE){
den=function(par,x){shape=par[3]; scale=par[4]; dgamma(x,shape,scale)}
cum=function(par,x){shape=par[3]; scale=par[4]; pgamma(x,shape,scale)}
starts<-c(1,1,a.hat,b.hat)
}}
pdf0<-function(par,x){
f0=den(par,x)
c0=cum(par,x)
a=par[1]
b=par[2]
b^a*gamma(a)^(-1)*f0*(-log(1-c0))^(a-1)*(1-c0)^(b-1)
}
cdf0<-function(par,x){
f0=den(par,x)
c0=cum(par,x)
a=par[1]
b=par[2]
pgamma(-b*log(1-c0),shape=a)
}
mpsw<-function(par,x){
z=NULL
z=diff(c(0,cdf0(par,x),1))
for (j in 2:n){if((x[j]-x[j-1])==0){z[j]=pdf0(par,x[j])
}}
z[z<1e-16]=1e-16
-sum(log(z))
}
out<-suppressWarnings(optim(starts,fn=mpsw,x=sort.mydata,method))
n.p<-length(out$par)
gammam<-(n+1)*(log(n+1)-digamma(1))-1/2-1/(12*(n+1))
sigma2m<-(n+1)*(pi^2/6-1)-1/2-1/(6*(n+1))
c1<-gammam-sqrt(n*sigma2m/2)
c2<-sqrt(sigma2m/(2*n))
stat.chisquare<-(mpsw(out$par,sort.mydata)+n.p/2-c1)/c2
pvalue.chisquare<-pchisq(stat.chisquare,df=n,lower.tail=FALSE)
Moran<-out$value
log.likelihood=sum(log(pdf0(out$par,sort.mydata)))
u=cdf0(out$par,sort.mydata)
von<-c()
anderson<-c()
for(i in 1:n){
u[i]<-ifelse(u[i]==1,0.999999999,u[i])
von[i]=(u[i]-(2*i-1)/(2*n))^2
anderson[i]=(2*i-1)*log(u[i])+(2*n+1-2*i)*log(1-u[i])
}
anderson.stat=-n-mean(anderson)
von.stat=sum(von)+1/(12*n)
CAIC=-2*log.likelihood + 2*n.p + 2*(n.p*(n.p+1))/(n-n.p-1)
AIC=-2*log.likelihood + 2*n.p
BIC=-2*log.likelihood + n.p*log(n)
HQIC=-2*log.likelihood + 2*log(log(n))*n.p
ks.stat=suppressWarnings(ks.test(mydata, "cdf0", par=out$par))
aux2=cbind(AIC, CAIC, BIC, HQIC, von.stat, anderson.stat,log.likelihood,Moran)
colnames(aux2)=c("AIC","CAIC","BIC","HQIC","CM","AD", "log",
"Moran")
rownames(aux2)=c("")
aux3=cbind(ks.stat$statistic,ks.stat$p.value)
colnames(aux3)=c("statistic","p-value")
rownames(aux3)=c("")
aux4=cbind(stat.chisquare,qchisq(sig.level,df=n,lower.tail=FALSE),1-pchisq(stat.chisquare,df=n))
colnames(aux4)=c("statistic","chi-value","p-value")
rownames(aux4)=c("")
aux5=cbind(if(out$convergence==0){"Algorithm Converged"} else {"Algorithm Not Converged"})
list("MPS"=out$par,"Measures"=aux2,"KS"=aux3,"chi-square"=aux4,"Convergence Status"=aux5)
}
mpsloggammag2<-function(mydata, g, location=TRUE, method , sig.level){
min.mydata<-min(mydata)
sort.mydata<-sort(mydata)
n<-length(mydata)
y<-(sort.mydata[2:n]-min.mydata)
y<-(sort.mydata[2:n]-min.mydata)[is.finite(log(sort.mydata[2:n]-min.mydata))]
n<-length(mydata)
qp1<-y[floor(.25*n)]
qp3<-y[floor(.75*n)]
median.mydata<-y[floor(.5*n)]
mean.mydata<-mean(y)
inv.mydata<-1/y[is.finite(1/y)]
inv.mean<-mean(inv.mydata)
std.mydata<-sd(y)
if(g!="birnbaum-saunders" & g!="exp" & g!="rayleigh" & g!="weibull" & g!="gompertz" & g!="gamma"
& g!="log-normal" & g!="chisq" & g!="f" & g!="burrxii" & g!="frechet"
& g!="lomax" & g!="log-logistic" & g!="lfr" & g!="chen")
{ stop ("Baseline distribution not implemented or misspelled. Please check the manual for guidelines.") }
if(g=="log-normal"){
den=function(par,x){meanlog=par[3]; sdlog=par[4]; loc=par[5]; dlnorm(x-loc,meanlog,sdlog)}
cum=function(par,x){meanlog=par[3]; sdlog=par[4]; loc=par[5]; plnorm(x-loc,meanlog,sdlog)}
starts<-c(1,1,log(median.mydata),sqrt(2*abs(log(mean.mydata/median.mydata))),(min.mydata-1/length(y)))
if (location==FALSE){
den=function(par,x){meanlog=par[3]; sdlog=par[4]; dlnorm(x,meanlog,sdlog)}
cum=function(par,x){meanlog=par[3]; sdlog=par[4]; plnorm(x,meanlog,sdlog)}
starts<-c(1,1,log(median.mydata),sqrt(2*abs(log(mean.mydata/median.mydata))))
}}
if(g=="chisq"){
den=function(par,x){df=par[3]; loc=par[4]; dchisq(x-loc,df)}
cum=function(par,x){df=par[3]; loc=par[4]; pchisq(x-loc,df)}
starts<-c(1,1,mean.mydata,(min.mydata-1/length(y)))
if (location==FALSE){
den=function(par,x){df=par[3]; dchisq(x,df)}
cum=function(par,x){df=par[3]; pchisq(x,df)}
starts<-c(1,1,mean.mydata)
}}
if(g=="f"){
den=function(par,x){df1=par[3]; df2=par[4]; loc=par[5]; df(x-loc,df1,df2)}
cum=function(par,x){df1=par[3]; df2=par[4]; loc=par[5]; pf(x-loc,df1,df2)}
df.1<-ifelse(inv.mean>1,2*inv.mean/(inv.mean-1),1)
df.2<-ifelse(mean.mydata>1,2*mean.mydata/(mean.mydata-1),1)
starts<-c(1,1,df.1,df.2,(min.mydata-1/length(y)))
if (location==FALSE){
den=function(par,x){df1=par[3]; df2=par[4]; df(x,df1,df2)}
cum=function(par,x){df1=par[3]; df2=par[4]; pf(x,df1,df2)}
starts<-c(1,1,df.1,df.2)
}}
if(g=="chen"){
den=function(par,x){a=par[3]; b=par[4]; loc=par[5]; a*b*(x-loc)^(a-1)*exp((x-loc)^a)*exp(-b*(exp((x-loc)^a)-1))}
cum=function(par,x){a=par[3]; b=par[4]; loc=par[5]; 1-exp(-b*(exp((x-loc)^a)-1))}
standard.mydata<-(y-mean.mydata)/std.mydata
s.hat<-ifelse(max(standard.mydata)<=1,-log(1-n/(n+.4))/(exp(1)-1),-
log(1-length(standard.mydata[standard.mydata<=1])/length(standard.mydata))/(exp(1)-1))
r.hat<-abs(log(log(1-log(1-0.5)/s.hat))/log(median.mydata))
starts<-c(1,1,r.hat,s.hat,(min.mydata-1/length(y)))
if (location==FALSE){
den=function(par,x){a=par[3]; b=par[4]; a*b*(x)^(a-1)*exp((x)^a)*exp(-b*(exp((x)^a)-1))}
cum=function(par,x){a=par[3]; b=par[4]; 1-exp(-b*(exp((x)^a)-1))}
starts<-c(1,1,r.hat,s.hat)
}}
if(g=="lfr"){
den=function(par,x){a=par[3]; b=par[4]; loc=par[5]; (a+b*(x-loc))*exp(-a*(x-loc)-(b*(x-loc)^2)/2)}
cum=function(par,x){a=par[3]; b=par[4]; loc=par[5]; 1-exp(-a*(x-loc)-(b*(x-loc)^2)/2)}
ii<-seq(1,(n-1))
yy<--log(1-(ii+0.3)/(n-1+0.4))
res<-summary(lm(yy ~ -1+y+I(y^2)))$coefficient
coeff<-c(abs(res[1,1]),abs(res[2,1]))
z1=NULL;
lfr.log<-function(p) {
z1<--log(sum(p[1]+p[2]*y))+p[1]*sum(y)+p[2]/2*sum(y^2)
z1[z1<1e-16]<-1e-16
}
p.hat<-suppressWarnings(optim(c(abs(coeff[1]),2*abs(coeff[2])),lfr.log)$par)
starts<-c(1,1,p.hat[1],p.hat[2],(min.mydata-1/length(y)))
if (location==FALSE){
den=function(par,x){a=par[3]; b=par[4]; (a+b*(x))*exp(-a*(x)-(b*(x)^2)/2)}
cum=function(par,x){a=par[3]; b=par[4]; 1-exp(-a*(x)-(b*(x)^2)/2)}
starts<-c(1,1,p.hat[1],p.hat[2])
}}
if(g=="log-logistic"){
den=function(par,x){a=par[3]; b=par[4]; loc=par[5]; (a*b^(-a)*(x-loc)^(a-1))/((((x-loc)/b)^a +1)^2)}
cum=function(par,x){a=par[3]; b=par[4]; loc=par[5]; 1/(((x-loc)/b)^(-a)+1)}
starts<-c(1,1,log(0.75/(1-0.75))/log(qp3/median.mydata),median.mydata,(min.mydata-1/length(y)))
if (location==FALSE){
den=function(par,x){a=par[3]; b=par[4]; (a*b^(-a)*(x)^(a-1))/((((x)/b)^a +1)^2)}
cum=function(par,x){a=par[3]; b=par[4]; 1/(((x)/b)^(-a)+1)}
starts<-c(1,1,log(0.75/(1-0.75))/log(qp3/median.mydata),median.mydata)
}}
if(g=="lomax"){
den=function(par,x){a=par[3]; b=par[4]; loc=par[5]; (a*b)/((1+a*(x-loc))^(b+1))}
cum=function(par,x){a=par[3]; b=par[4]; loc=par[5]; 1-(1+a*(x-loc))^(-b)}
a.hat<-1
b.hat<-(.5^(-1/a.hat)-1)/median.mydata
z1=NULL;
lomax.log<-function(p) {
z1<--n*log(p[1])-n*log(p[2])+(p[2]+1)*sum(log(1+p[1]*y))
z1[z1<1e-16]<-1e-16
}
p.hat<-suppressWarnings(optim(c(1,b.hat),lomax.log, method)$par)
starts<-c(1,1,p.hat[1],p.hat[2],(min.mydata-1/length(y)))
if (location==FALSE){
den=function(par,x){a=par[3]; b=par[4]; (a*b)/((1+a*(x))^(b+1))}
cum=function(par,x){a=par[3]; b=par[4]; 1-(1+a*(x))^(-b)}
starts<-c(1,1,p.hat[1],p.hat[2])
}}
if(g=="gompertz"){
den=function(par,x){a=par[3]; b=par[4]; loc=par[5]; b*exp(a*(x-loc))*exp(-(exp(a*(x-loc))-1)*b/a)}
cum=function(par,x){a=par[3]; b=par[4]; loc=par[5]; 1-exp(-(exp(a*(x-loc))-1)*b/a)}
a.hat<-log(log(1-.75)/log(1-.5))/(qp3-median.mydata)
b.hat<--a.hat*log(0.5)/(exp(a.hat*median.mydata)-1)
z1=NULL;
gompertz.log<-function(p){
z1<--n*log(p[2])-p[1]*sum(y)+p[2]/p[1]*sum(exp(p[1]*y)-1)
z1[z1<1e-16]<-1e-16
}
p.hat<-suppressWarnings(optim(c(a.hat,b.hat),gompertz.log, method)$par)
starts<-c(1,1,p.hat[1],p.hat[2],(min.mydata-1/length(y)))
if (location==FALSE){
den=function(par,x){a=par[3]; b=par[4]; b*exp(a*(x))*exp(-(exp(a*(x))-1)*b/a)}
cum=function(par,x){a=par[3]; b=par[4]; 1-exp(-(exp(a*(x))-1)*b/a)}
starts<-c(1,1,p.hat[1],p.hat[2])
}}
if(g=="exp"){
den=function(par,x){rate=par[3]; loc=par[4]; dexp(x-loc,rate)}
cum=function(par,x){rate=par[3]; loc=par[4]; pexp(x-loc,rate)}
starts<-c(1,1,1/mean.mydata,(min.mydata-1/length(y)))
if (location==FALSE){
den=function(par,x){rate=par[3]; dexp(x,rate)}
cum=function(par,x){rate=par[3]; pexp(x,rate)}
starts<-c(1,1,1/mean.mydata)
}}
if(g=="rayleigh"){
den=function(par,x){a=par[3]; loc=par[4]; 2*(x-loc)/a*exp(-((x-loc)/a)^2)}
cum=function(par,x){a=par[3]; loc=par[4]; 1-exp(-((x-loc)/a)^2)}
starts<-c(1,1,log(2)/(median.mydata)^2,(min.mydata-1/length(y)))
if (location==FALSE){
den=function(par,x){a=par[3]; 2*x/a*exp(-(x/a)^2)}
cum=function(par,x){a=par[3]; 1-exp(-(x/a)^2)}
starts<-c(1,1,log(2)/(median.mydata)^2)
}}
if(g=="burrxii"){
den=function(par,x){a=par[3]; d=par[4]; loc=par[5]; d*a*(1+(x-loc)^d)^(-a-1)*((x-loc)^(d-1))}
cum=function(par,x){a=par[3]; d=par[4]; loc=par[5]; 1-(1+(x-loc)^d)^(-a)}
z1=NULL;
burrxii.log<-function(p){
z1<--n*log(p[1])-n*log(p[2])-(p[2]-1)*sum(log(y))+(p[1]+1)*sum(log(1+y^p[2]))
}
p.hat<-suppressWarnings(optim(c(1,1),burrxii.log, method="BFGS")$par)
starts<-c(1,1,p.hat[1],p.hat[2],(min.mydata-1/length(y)))
if (location==FALSE){
den=function(par,x){a=par[3]; d=par[4]; d*a*(1+(x)^d)^(-a-1)*((x)^(d-1))}
cum=function(par,x){a=par[3]; d=par[4]; 1-(1+(x)^d)^(-a)}
starts<-c(1,1,p.hat[1],p.hat[2])
}}
if(g=="frechet"){
den=function(par,x){a=par[3]; b=par[4]; loc=par[5]; (a*exp(-((x-loc)/b)^(-a))*((x-loc)/b)^(-a-1))/(b)}
cum=function(par,x){a=par[3]; b=par[4]; loc=par[5]; exp(-((x-loc)/b)^(-a))}
cons<-cor(inv.mydata,rank(inv.mydata))*(sd(inv.mydata)/mean(inv.mydata))*sqrt((n+1)/(n-1))/sqrt(3)
a.hat<-abs(ifelse(cons<1,-log(2)/log(1-cons),-log(2)/log(1-.98)))
b.hat<-median(inv.mydata)/(log(2))^(1/a.hat)
starts<-c(1,1,a.hat,1/b.hat,(min.mydata-1/length(y)))
if (location==FALSE){
den=function(par,x){a=par[3]; b=par[4]; (a*exp(-((x)/b)^(-a))*((x)/b)^(-a-1))/(b)}
cum=function(par,x){a=par[3]; b=par[4]; exp(-((x)/b)^(-a))}
starts<-c(1,1,a.hat,1/b.hat)
}}
if(g=="birnbaum-saunders"){
den=function(par,x){a=par[3]; b=par[4]; loc=par[5]; (sqrt((x-loc)/b)+sqrt(b/(x-loc)))/(2*a*(x-loc))*dnorm((sqrt((x-loc)/b)-sqrt(b/(x-loc)))/a)}
cum=function(par,x){a=par[3]; b=par[4]; loc=par[5]; pnorm((sqrt((x-loc)/b)-sqrt(b/(x-loc)))/a)}
r<-(mean(inv.mydata))^(-1)
b.hat<-sqrt(mean.mydata*r)
a.hat<-sqrt(2*(sqrt(mean.mydata/r)))
starts<-c(1,1,a.hat,b.hat,(min.mydata-1/length(y)))
if (location==FALSE){
den=function(par,x){a=par[3]; b=par[4]; (sqrt((x)/b)+sqrt(b/(x)))/(2*a*(x))*dnorm((sqrt((x)/b)-sqrt(b/(x)))/a)}
cum=function(par,x){a=par[3]; b=par[4]; pnorm((sqrt((x)/b)-sqrt(b/(x)))/a)}
starts<-c(1,1,a.hat,b.hat)
}}
if(g=="weibull"){
den=function(par,x){shape=par[3]; scale=par[4]; loc=par[5]; dweibull(x-loc,shape,scale)}
cum=function(par,x){shape=par[3]; scale=par[4]; loc=par[5]; pweibull(x-loc,shape,scale)}
cons<-cor(mydata,rank(mydata))*(std.mydata/mean.mydata)*sqrt((n+1)/(n-1))/sqrt(3)
a.hat<-abs(ifelse(cons<1,-log(2)/log(1-cons),-log(2)/log(1-.98)))
b.hat<-median.mydata/(log(2))^(1/a.hat)
starts<-c(1,1,a.hat,b.hat,(min.mydata-1/length(y)))
if (location==FALSE){
den=function(par,x){shape=par[3]; scale=par[4]; dweibull(x,shape,scale)}
cum=function(par,x){shape=par[3]; scale=par[4]; pweibull(x,shape,scale)}
starts<-c(1,1,a.hat,b.hat)
}}
if(g=="gamma"){
den=function(par,x){shape=par[3]; scale=par[4]; loc=par[5]; dgamma(x-loc,shape,scale)}
cum=function(par,x){shape=par[3]; scale=par[4]; loc=par[5]; pgamma(x-loc,shape,scale)}
a.hat<-uniroot(function(ss) trigamma(ss)-var(log(y)[is.finite(log(y))]),c(0,1000000))$root
b.hat<-mean.mydata/a.hat
starts<-c(1,1,a.hat,b.hat,(min.mydata-1/length(y)))
if (location==FALSE){
den=function(par,x){shape=par[3]; scale=par[4]; dgamma(x,shape,scale)}
cum=function(par,x){shape=par[3]; scale=par[4]; pgamma(x,shape,scale)}
starts<-c(1,1,a.hat,b.hat)
}}
pdf0<-function(par,x){
f0=den(par,x)
c0=cum(par,x)
a=par[1]
b=par[2]
b^a*gamma(a)^(-1)*f0*(-log(c0))^(a-1)*(c0)^(b-1)
}
cdf0<-function(par,x){
f0=den(par,x)
c0=cum(par,x)
a=par[1]
b=par[2]
1-pgamma(-b*log(c0),shape=a)
}
mpsw<-function(par,x){
z=NULL
z=diff(c(0,cdf0(par,x),1))
for (j in 2:n){if((x[j]-x[j-1])==0){z[j]=pdf0(par,x[j])
}}
z[z<1e-16]=1e-16
-sum(log(z))
}
out<-suppressWarnings(optim(starts,fn=mpsw,x=sort.mydata,method))
n.p<-length(out$par)
gammam<-(n+1)*(log(n+1)-digamma(1))-1/2-1/(12*(n+1))
sigma2m<-(n+1)*(pi^2/6-1)-1/2-1/(6*(n+1))
c1<-gammam-sqrt(n*sigma2m/2)
c2<-sqrt(sigma2m/(2*n))
stat.chisquare<-(mpsw(out$par,sort.mydata)+n.p/2-c1)/c2
pvalue.chisquare<-pchisq(stat.chisquare,df=n,lower.tail=FALSE)
Moran<-out$value
log.likelihood=sum(log(pdf0(out$par,sort.mydata)))
u=cdf0(out$par,sort.mydata)
von<-c()
anderson<-c()
for(i in 1:n){
u[i]<-ifelse(u[i]==1,0.999999999,u[i])
von[i]=(u[i]-(2*i-1)/(2*n))^2
anderson[i]=(2*i-1)*log(u[i])+(2*n+1-2*i)*log(1-u[i])
}
anderson.stat=-n-mean(anderson)
von.stat=sum(von)+1/(12*n)
CAIC=-2*log.likelihood + 2*n.p + 2*(n.p*(n.p+1))/(n-n.p-1)
AIC=-2*log.likelihood + 2*n.p
BIC=-2*log.likelihood + n.p*log(n)
HQIC=-2*log.likelihood + 2*log(log(n))*n.p
ks.stat=suppressWarnings(ks.test(mydata, "cdf0", par=out$par))
aux2=cbind(AIC, CAIC, BIC, HQIC, von.stat, anderson.stat,log.likelihood,Moran)
colnames(aux2)=c("AIC","CAIC","BIC","HQIC","CM","AD", "log",
"Moran")
rownames(aux2)=c("")
aux3=cbind(ks.stat$statistic,ks.stat$p.value)
colnames(aux3)=c("statistic","p-value")
rownames(aux3)=c("")
aux4=cbind(stat.chisquare,qchisq(sig.level,df=n,lower.tail=FALSE),1-pchisq(stat.chisquare,df=n))
colnames(aux4)=c("statistic","chi-value","p-value")
rownames(aux4)=c("")
aux5=cbind(if(out$convergence==0){"Algorithm Converged"} else {"Algorithm Not Converged"})
list("MPS"=out$par,"Measures"=aux2,"KS"=aux3,"chi-square"=aux4,"Convergence Status"=aux5)
}
mpsgxlogisticg<-function(mydata, g, location=TRUE, method , sig.level){
min.mydata<-min(mydata)
sort.mydata<-sort(mydata)
n<-length(mydata)
y<-(sort.mydata[2:n]-min.mydata)
y<-(sort.mydata[2:n]-min.mydata)[is.finite(log(sort.mydata[2:n]-min.mydata))]
n<-length(mydata)
qp1<-y[floor(.25*n)]
qp3<-y[floor(.75*n)]
median.mydata<-y[floor(.5*n)]
mean.mydata<-mean(y)
inv.mydata<-1/y[is.finite(1/y)]
inv.mean<-mean(inv.mydata)
std.mydata<-sd(y)
if(g!="birnbaum-saunders" & g!="exp" & g!="rayleigh" & g!="weibull" & g!="gompertz" & g!="gamma"
& g!="log-normal" & g!="chisq" & g!="f" & g!="burrxii" & g!="frechet"
& g!="lomax" & g!="log-logistic" & g!="lfr" & g!="chen")
{ stop ("Baseline distribution not implemented or misspelled. Please check the manual for guidelines.") }
if(g=="log-normal"){
den=function(par,x){meanlog=par[2]; sdlog=par[3]; loc=par[4]; dlnorm(x-loc,meanlog,sdlog)}
cum=function(par,x){meanlog=par[2]; sdlog=par[3]; loc=par[4]; plnorm(x-loc,meanlog,sdlog)}
starts<-c(1,log(median.mydata),sqrt(2*abs(log(mean.mydata/median.mydata))),(min.mydata-1/length(y)))
if (location==FALSE){
den=function(par,x){meanlog=par[2]; sdlog=par[3]; dlnorm(x,meanlog,sdlog)}
cum=function(par,x){meanlog=par[2]; sdlog=par[3]; plnorm(x,meanlog,sdlog)}
starts<-c(1,log(median.mydata),sqrt(2*abs(log(mean.mydata/median.mydata))))
}}
if(g=="chisq"){
den=function(par,x){df=par[2]; loc=par[3]; dchisq(x-loc,df)}
cum=function(par,x){df=par[2]; loc=par[3]; pchisq(x-loc,df)}
starts<-c(1,mean.mydata,(min.mydata-1/length(y)))
if (location==FALSE){
den=function(par,x){df=par[2]; dchisq(x,df)}
cum=function(par,x){df=par[2]; pchisq(x,df)}
starts<-c(1,mean.mydata)
}}
if(g=="f"){
den=function(par,x){df1=par[2]; df2=par[3]; loc=par[4]; df(x-loc,df1,df2)}
cum=function(par,x){df1=par[2]; df2=par[3]; loc=par[4]; pf(x-loc,df1,df2)}
df.1<-ifelse(inv.mean>1,2*inv.mean/(inv.mean-1),1)
df.2<-ifelse(mean.mydata>1,2*mean.mydata/(mean.mydata-1),1)
starts<-c(1,df.1,df.2,(min.mydata-1/length(y)))
if (location==FALSE){
den=function(par,x){df1=par[2]; df2=par[3]; df(x,df1,df2)}
cum=function(par,x){df1=par[2]; df2=par[3]; pf(x,df1,df2)}
starts<-c(1,df.1,df.2)
}}
if(g=="chen"){
den=function(par,x){a=par[2]; b=par[3]; loc=par[4]; a*b*(x-loc)^(a-1)*exp((x-loc)^a)*exp(-b*(exp((x-loc)^a)-1))}
cum=function(par,x){a=par[2]; b=par[3]; loc=par[4]; 1-exp(-b*(exp((x-loc)^a)-1))}
standard.mydata<-(y-mean.mydata)/std.mydata
s.hat<-ifelse(max(standard.mydata)<=1,-log(1-n/(n+.4))/(exp(1)-1),-
log(1-length(standard.mydata[standard.mydata<=1])/length(standard.mydata))/(exp(1)-1))
r.hat<-abs(log(log(1-log(1-0.5)/s.hat))/log(median.mydata))
starts<-c(1,r.hat,s.hat,(min.mydata-1/length(y)))
if (location==FALSE){
den=function(par,x){a=par[2]; b=par[3]; a*b*(x)^(a-1)*exp((x)^a)*exp(-b*(exp((x)^a)-1))}
cum=function(par,x){a=par[2]; b=par[3]; 1-exp(-b*(exp((x)^a)-1))}
starts<-c(1,r.hat,s.hat)
}}
if(g=="lfr"){
den=function(par,x){a=par[2]; b=par[3]; loc=par[4]; (a+b*(x-loc))*exp(-a*(x-loc)-(b*(x-loc)^2)/2)}
cum=function(par,x){a=par[2]; b=par[3]; loc=par[4]; 1-exp(-a*(x-loc)-(b*(x-loc)^2)/2)}
ii<-seq(1,(n-1))
yy<--log(1-(ii+0.3)/(n-1+0.4))
res<-summary(lm(yy ~ -1+y+I(y^2)))$coefficient
coeff<-c(abs(res[1,1]),abs(res[2,1]))
z1=NULL;
lfr.log<-function(p) {
z1<--log(sum(p[1]+p[2]*y))+p[1]*sum(y)+p[2]/2*sum(y^2)
z1[z1<1e-16]<-1e-16
}
p.hat<-suppressWarnings(optim(c(abs(coeff[1]),2*abs(coeff[2])),lfr.log)$par)
starts<-c(1,p.hat[1],p.hat[2],(min.mydata-1/length(y)))
if (location==FALSE){
den=function(par,x){a=par[2]; b=par[3]; (a+b*(x))*exp(-a*(x)-(b*(x)^2)/2)}
cum=function(par,x){a=par[2]; b=par[3]; 1-exp(-a*(x)-(b*(x)^2)/2)}
starts<-c(1,p.hat[1],p.hat[2])
}}
if(g=="log-logistic"){
den=function(par,x){a=par[2]; b=par[3]; loc=par[4]; (a*b^(-a)*(x-loc)^(a-1))/((((x-loc)/b)^a +1)^2)}
cum=function(par,x){a=par[2]; b=par[3]; loc=par[4]; 1/(((x-loc)/b)^(-a)+1)}
starts<-c(1,log(0.75/(1-0.75))/log(qp3/median.mydata),median.mydata,(min.mydata-1/length(y)))
if (location==FALSE){
den=function(par,x){a=par[2]; b=par[3]; (a*b^(-a)*(x)^(a-1))/((((x)/b)^a +1)^2)}
cum=function(par,x){a=par[2]; b=par[3]; 1/(((x)/b)^(-a)+1)}
starts<-c(1,log(0.75/(1-0.75))/log(qp3/median.mydata),median.mydata)
}}
if(g=="lomax"){
den=function(par,x){a=par[2]; b=par[3]; loc=par[4]; (a*b)/((1+a*(x-loc))^(b+1))}
cum=function(par,x){a=par[2]; b=par[3]; loc=par[4]; 1-(1+a*(x-loc))^(-b)}
a.hat<-1
b.hat<-(.5^(-1/a.hat)-1)/median.mydata
z1=NULL;
lomax.log<-function(p) {
z1<--n*log(p[1])-n*log(p[2])+(p[2]+1)*sum(log(1+p[1]*y))
z1[z1<1e-16]<-1e-16
}
p.hat<-suppressWarnings(optim(c(1,b.hat),lomax.log, method)$par)
starts<-c(1,p.hat[1],p.hat[2],(min.mydata-1/length(y)))
if (location==FALSE){
den=function(par,x){a=par[2]; b=par[3]; (a*b)/((1+a*(x))^(b+1))}
cum=function(par,x){a=par[2]; b=par[3]; 1-(1+a*(x))^(-b)}
starts<-c(1,p.hat[1],p.hat[2])
}}
if(g=="gompertz"){
den=function(par,x){a=par[2]; b=par[3]; loc=par[4]; b*exp(a*(x-loc))*exp(-(exp(a*(x-loc))-1)*b/a)}
cum=function(par,x){a=par[2]; b=par[3]; loc=par[4]; 1-exp(-(exp(a*(x-loc))-1)*b/a)}
a.hat<-log(log(1-.75)/log(1-.5))/(qp3-median.mydata)
b.hat<--a.hat*log(0.5)/(exp(a.hat*median.mydata)-1)
z1=NULL;
gompertz.log<-function(p){
z1<--n*log(p[2])-p[1]*sum(y)+p[2]/p[1]*sum(exp(p[1]*y)-1)
z1[z1<1e-16]<-1e-16
}
p.hat<-suppressWarnings(optim(c(a.hat,b.hat),gompertz.log, method)$par)
starts<-c(1,p.hat[1],p.hat[2],(min.mydata-1/length(y)))
if (location==FALSE){
den=function(par,x){a=par[2]; b=par[3]; b*exp(a*(x))*exp(-(exp(a*(x))-1)*b/a)}
cum=function(par,x){a=par[2]; b=par[3]; 1-exp(-(exp(a*(x))-1)*b/a)}
starts<-c(1,p.hat[1],p.hat[2])
}}
if(g=="exp"){
den=function(par,x){rate=par[2]; loc=par[3]; dexp(x-loc,rate)}
cum=function(par,x){rate=par[2]; loc=par[3]; pexp(x-loc,rate)}
starts<-c(1,1/mean.mydata,(min.mydata-1/length(y)))
if (location==FALSE){
den=function(par,x){rate=par[2]; dexp(x,rate)}
cum=function(par,x){rate=par[2]; pexp(x,rate)}
starts<-c(1,1/mean.mydata)
}}
if(g=="rayleigh"){
den=function(par,x){a=par[2]; loc=par[3]; 2*(x-loc)/a*exp(-((x-loc)/a)^2)}
cum=function(par,x){a=par[2]; loc=par[3]; 1-exp(-((x-loc)/a)^2)}
starts<-c(1,log(2)/(median.mydata)^2,(min.mydata-1/length(y)))
if (location==FALSE){
den=function(par,x){a=par[2]; 2*x/a*exp(-(x/a)^2)}
cum=function(par,x){a=par[2]; 1-exp(-(x/a)^2)}
starts<-c(1,log(2)/(median.mydata)^2)
}}
if(g=="burrxii"){
den=function(par,x){a=par[2]; d=par[3]; loc=par[4]; d*a*(1+(x-loc)^d)^(-a-1)*((x-loc)^(d-1))}
cum=function(par,x){a=par[2]; d=par[3]; loc=par[4]; 1-(1+(x-loc)^d)^(-a)}
z1=NULL;
burrxii.log<-function(p){
z1<--n*log(p[1])-n*log(p[2])-(p[2]-1)*sum(log(y))+(p[1]+1)*sum(log(1+y^p[2]))
}
p.hat<-suppressWarnings(optim(c(1,1),burrxii.log, method="BFGS")$par)
starts<-c(1,p.hat[1],p.hat[2],(min.mydata-1/length(y)))
if (location==FALSE){
den=function(par,x){a=par[2]; d=par[3]; d*a*(1+(x)^d)^(-a-1)*((x)^(d-1))}
cum=function(par,x){a=par[2]; d=par[3]; 1-(1+(x)^d)^(-a)}
starts<-c(1,p.hat[1],p.hat[2])
}}
if(g=="frechet"){
den=function(par,x){a=par[2]; b=par[3]; loc=par[4]; (a*exp(-((x-loc)/b)^(-a))*((x-loc)/b)^(-a-1))/(b)}
cum=function(par,x){a=par[2]; b=par[3]; loc=par[4]; exp(-((x-loc)/b)^(-a))}
cons<-cor(inv.mydata,rank(inv.mydata))*(sd(inv.mydata)/mean(inv.mydata))*sqrt((n+1)/(n-1))/sqrt(3)
a.hat<-abs(ifelse(cons<1,-log(2)/log(1-cons),-log(2)/log(1-.98)))
b.hat<-median(inv.mydata)/(log(2))^(1/a.hat)
starts<-c(1,a.hat,1/b.hat,(min.mydata-1/length(y)))
if (location==FALSE){
den=function(par,x){a=par[2]; b=par[3]; (a*exp(-((x)/b)^(-a))*((x)/b)^(-a-1))/(b)}
cum=function(par,x){a=par[2]; b=par[3]; exp(-((x)/b)^(-a))}
starts<-c(1,a.hat,1/b.hat)
}}
if(g=="birnbaum-saunders"){
den=function(par,x){a=par[2]; b=par[3]; loc=par[4]; (sqrt((x-loc)/b)+sqrt(b/(x-loc)))/(2*a*(x-loc))*dnorm((sqrt((x-loc)/b)-sqrt(b/(x-loc)))/a)}
cum=function(par,x){a=par[2]; b=par[3]; loc=par[4]; pnorm((sqrt((x-loc)/b)-sqrt(b/(x-loc)))/a)}
r<-(mean(inv.mydata))^(-1)
b.hat<-sqrt(mean.mydata*r)
a.hat<-sqrt(2*(sqrt(mean.mydata/r)))
starts<-c(1,a.hat,b.hat,(min.mydata-1/length(y)))
if (location==FALSE){
den=function(par,x){a=par[2]; b=par[3]; (sqrt((x)/b)+sqrt(b/(x)))/(2*a*(x))*dnorm((sqrt((x)/b)-sqrt(b/(x)))/a)}
cum=function(par,x){a=par[2]; b=par[3]; pnorm((sqrt((x)/b)-sqrt(b/(x)))/a)}
starts<-c(1,a.hat,b.hat)
}}
if(g=="weibull"){
den=function(par,x){shape=par[2]; scale=par[3]; loc=par[4]; dweibull(x-loc,shape,scale)}
cum=function(par,x){shape=par[2]; scale=par[3]; loc=par[4]; pweibull(x-loc,shape,scale)}
cons<-cor(mydata,rank(mydata))*(std.mydata/mean.mydata)*sqrt((n+1)/(n-1))/sqrt(3)
a.hat<-abs(ifelse(cons<1,-log(2)/log(1-cons),-log(2)/log(1-.98)))
b.hat<-median.mydata/(log(2))^(1/a.hat)
starts<-c(1,a.hat,b.hat,(min.mydata-1/length(y)))
if (location==FALSE){
den=function(par,x){shape=par[2]; scale=par[3]; dweibull(x,shape,scale)}
cum=function(par,x){shape=par[2]; scale=par[3]; pweibull(x,shape,scale)}
starts<-c(1,a.hat,b.hat)
}}
if(g=="gamma"){
den=function(par,x){shape=par[2]; scale=par[3]; loc=par[4]; dgamma(x-loc,shape,scale)}
cum=function(par,x){shape=par[2]; scale=par[3]; loc=par[4]; pgamma(x-loc,shape,scale)}
a.hat<-uniroot(function(ss) trigamma(ss)-var(log(y)[is.finite(log(y))]),c(0,1000000))$root
b.hat<-mean.mydata/a.hat
starts<-c(1,a.hat,b.hat,(min.mydata-1/length(y)))
if (location==FALSE){
den=function(par,x){shape=par[2]; scale=par[3]; dgamma(x,shape,scale)}
cum=function(par,x){shape=par[2]; scale=par[3]; pgamma(x,shape,scale)}
starts<-c(1,a.hat,b.hat)
}}
pdf0<-function(par,x){
f0=den(par,x)
c0=cum(par,x)
a=par[1]
a*f0/(1-c0)*(-log(1-c0))**(-a-1)*(1+(-log(1-c0))**(-a))**(-2)
}
cdf0<-function(par,x){
f0=den(par,x)
c0=cum(par,x)
a=par[1]
1/(1+(-log(1-c0))**(-a))
}
mpsw<-function(par,x){
z=NULL
z=diff(c(0,cdf0(par,x),1))
for (j in 2:n){if((x[j]-x[j-1])==0){z[j]=pdf0(par,x[j])
}}
z[z<1e-16]=1e-16
-sum(log(z))
}
out<-suppressWarnings(optim(starts,fn=mpsw,x=sort.mydata,method))
n.p<-length(out$par)
gammam<-(n+1)*(log(n+1)-digamma(1))-1/2-1/(12*(n+1))
sigma2m<-(n+1)*(pi^2/6-1)-1/2-1/(6*(n+1))
c1<-gammam-sqrt(n*sigma2m/2)
c2<-sqrt(sigma2m/(2*n))
stat.chisquare<-(mpsw(out$par,sort.mydata)+n.p/2-c1)/c2
pvalue.chisquare<-pchisq(stat.chisquare,df=n,lower.tail=FALSE)
Moran<-out$value
log.likelihood=sum(log(pdf0(out$par,sort.mydata)))
u=cdf0(out$par,sort.mydata)
von<-c()
anderson<-c()
for(i in 1:n){
u[i]<-ifelse(u[i]==1,0.999999999,u[i])
von[i]=(u[i]-(2*i-1)/(2*n))^2
anderson[i]=(2*i-1)*log(u[i])+(2*n+1-2*i)*log(1-u[i])
}
anderson.stat=-n-mean(anderson)
von.stat=sum(von)+1/(12*n)
CAIC=-2*log.likelihood + 2*n.p + 2*(n.p*(n.p+1))/(n-n.p-1)
AIC=-2*log.likelihood + 2*n.p
BIC=-2*log.likelihood + n.p*log(n)
HQIC=-2*log.likelihood + 2*log(log(n))*n.p
ks.stat=suppressWarnings(ks.test(mydata, "cdf0", par=out$par))
aux2=cbind(AIC, CAIC, BIC, HQIC, von.stat, anderson.stat,log.likelihood,Moran)
colnames(aux2)=c("AIC","CAIC","BIC","HQIC","CM","AD", "log",
"Moran")
rownames(aux2)=c("")
aux3=cbind(ks.stat$statistic,ks.stat$p.value)
colnames(aux3)=c("statistic","p-value")
rownames(aux3)=c("")
aux4=cbind(stat.chisquare,qchisq(sig.level,df=n,lower.tail=FALSE),1-pchisq(stat.chisquare,df=n))
colnames(aux4)=c("statistic","chi-value","p-value")
rownames(aux4)=c("")
aux5=cbind(if(out$convergence==0){"Algorithm Converged"} else {"Algorithm Not Converged"})
list("MPS"=out$par,"Measures"=aux2,"KS"=aux3,"chi-square"=aux4,"Convergence Status"=aux5)
}
mpsgmbetaexpg<-function(mydata, g, location=TRUE, method , sig.level){
min.mydata<-min(mydata)
sort.mydata<-sort(mydata)
n<-length(mydata)
y<-(sort.mydata[2:n]-min.mydata)
y<-(sort.mydata[2:n]-min.mydata)[is.finite(log(sort.mydata[2:n]-min.mydata))]
n<-length(mydata)
qp1<-y[floor(.25*n)]
qp3<-y[floor(.75*n)]
median.mydata<-y[floor(.5*n)]
mean.mydata<-mean(y)
inv.mydata<-1/y[is.finite(1/y)]
inv.mean<-mean(inv.mydata)
std.mydata<-sd(y)
if(g!="birnbaum-saunders" & g!="exp" & g!="rayleigh" & g!="weibull" & g!="gompertz" & g!="gamma"
& g!="log-normal" & g!="chisq" & g!="f" & g!="burrxii" & g!="frechet"
& g!="lomax" & g!="log-logistic" & g!="lfr" & g!="chen")
{ stop ("Baseline distribution not implemented or misspelled. Please check the manual for guidelines.") }
if(g=="log-normal"){
den=function(par,x){meanlog=par[3]; sdlog=par[4]; loc=par[5]; dlnorm(x-loc,meanlog,sdlog)}
cum=function(par,x){meanlog=par[3]; sdlog=par[4]; loc=par[5]; plnorm(x-loc,meanlog,sdlog)}
starts<-c(1,1,log(median.mydata),sqrt(2*abs(log(mean.mydata/median.mydata))),(min.mydata-1/length(y)))
if (location==FALSE){
den=function(par,x){meanlog=par[3]; sdlog=par[4]; dlnorm(x,meanlog,sdlog)}
cum=function(par,x){meanlog=par[3]; sdlog=par[4]; plnorm(x,meanlog,sdlog)}
starts<-c(1,1,log(median.mydata),sqrt(2*abs(log(mean.mydata/median.mydata))))
}}
if(g=="chisq"){
den=function(par,x){df=par[3]; loc=par[4]; dchisq(x-loc,df)}
cum=function(par,x){df=par[3]; loc=par[4]; pchisq(x-loc,df)}
starts<-c(1,1,mean.mydata,(min.mydata-1/length(y)))
if (location==FALSE){
den=function(par,x){df=par[3]; dchisq(x,df)}
cum=function(par,x){df=par[3]; pchisq(x,df)}
starts<-c(1,1,mean.mydata)
}}
if(g=="f"){
den=function(par,x){df1=par[3]; df2=par[4]; loc=par[5]; df(x-loc,df1,df2)}
cum=function(par,x){df1=par[3]; df2=par[4]; loc=par[5]; pf(x-loc,df1,df2)}
df.1<-ifelse(inv.mean>1,2*inv.mean/(inv.mean-1),1)
df.2<-ifelse(mean.mydata>1,2*mean.mydata/(mean.mydata-1),1)
starts<-c(1,1,df.1,df.2,(min.mydata-1/length(y)))
if (location==FALSE){
den=function(par,x){df1=par[3]; df2=par[4]; df(x,df1,df2)}
cum=function(par,x){df1=par[3]; df2=par[4]; pf(x,df1,df2)}
starts<-c(1,1,df.1,df.2)
}}
if(g=="chen"){
den=function(par,x){a=par[3]; b=par[4]; loc=par[5]; a*b*(x-loc)^(a-1)*exp((x-loc)^a)*exp(-b*(exp((x-loc)^a)-1))}
cum=function(par,x){a=par[3]; b=par[4]; loc=par[5]; 1-exp(-b*(exp((x-loc)^a)-1))}
standard.mydata<-(y-mean.mydata)/std.mydata
s.hat<-ifelse(max(standard.mydata)<=1,-log(1-n/(n+.4))/(exp(1)-1),-
log(1-length(standard.mydata[standard.mydata<=1])/length(standard.mydata))/(exp(1)-1))
r.hat<-abs(log(log(1-log(1-0.5)/s.hat))/log(median.mydata))
starts<-c(1,1,r.hat,s.hat,(min.mydata-1/length(y)))
if (location==FALSE){
den=function(par,x){a=par[3]; b=par[4]; a*b*(x)^(a-1)*exp((x)^a)*exp(-b*(exp((x)^a)-1))}
cum=function(par,x){a=par[3]; b=par[4]; 1-exp(-b*(exp((x)^a)-1))}
starts<-c(1,1,r.hat,s.hat)
}}
if(g=="lfr"){
den=function(par,x){a=par[3]; b=par[4]; loc=par[5]; (a+b*(x-loc))*exp(-a*(x-loc)-(b*(x-loc)^2)/2)}
cum=function(par,x){a=par[3]; b=par[4]; loc=par[5]; 1-exp(-a*(x-loc)-(b*(x-loc)^2)/2)}
ii<-seq(1,(n-1))
yy<--log(1-(ii+0.3)/(n-1+0.4))
res<-summary(lm(yy ~ -1+y+I(y^2)))$coefficient
coeff<-c(abs(res[1,1]),abs(res[2,1]))
z1=NULL;
lfr.log<-function(p) {
z1<--log(sum(p[1]+p[2]*y))+p[1]*sum(y)+p[2]/2*sum(y^2)
z1[z1<1e-16]<-1e-16
}
p.hat<-suppressWarnings(optim(c(abs(coeff[1]),2*abs(coeff[2])),lfr.log)$par)
starts<-c(1,1,p.hat[1],p.hat[2],(min.mydata-1/length(y)))
if (location==FALSE){
den=function(par,x){a=par[3]; b=par[4]; (a+b*(x))*exp(-a*(x)-(b*(x)^2)/2)}
cum=function(par,x){a=par[3]; b=par[4]; 1-exp(-a*(x)-(b*(x)^2)/2)}
starts<-c(1,1,p.hat[1],p.hat[2])
}}
if(g=="log-logistic"){
den=function(par,x){a=par[3]; b=par[4]; loc=par[5]; (a*b^(-a)*(x-loc)^(a-1))/((((x-loc)/b)^a +1)^2)}
cum=function(par,x){a=par[3]; b=par[4]; loc=par[5]; 1/(((x-loc)/b)^(-a)+1)}
starts<-c(1,1,log(0.75/(1-0.75))/log(qp3/median.mydata),median.mydata,(min.mydata-1/length(y)))
if (location==FALSE){
den=function(par,x){a=par[3]; b=par[4]; (a*b^(-a)*(x)^(a-1))/((((x)/b)^a +1)^2)}
cum=function(par,x){a=par[3]; b=par[4]; 1/(((x)/b)^(-a)+1)}
starts<-c(1,1,log(0.75/(1-0.75))/log(qp3/median.mydata),median.mydata)
}}
if(g=="lomax"){
den=function(par,x){a=par[3]; b=par[4]; loc=par[5]; (a*b)/((1+a*(x-loc))^(b+1))}
cum=function(par,x){a=par[3]; b=par[4]; loc=par[5]; 1-(1+a*(x-loc))^(-b)}
a.hat<-1
b.hat<-(.5^(-1/a.hat)-1)/median.mydata
z1=NULL;
lomax.log<-function(p) {
z1<--n*log(p[1])-n*log(p[2])+(p[2]+1)*sum(log(1+p[1]*y))
z1[z1<1e-16]<-1e-16
}
p.hat<-suppressWarnings(optim(c(1,b.hat),lomax.log, method)$par)
starts<-c(1,1,p.hat[1],p.hat[2],(min.mydata-1/length(y)))
if (location==FALSE){
den=function(par,x){a=par[3]; b=par[4]; (a*b)/((1+a*(x))^(b+1))}
cum=function(par,x){a=par[3]; b=par[4]; 1-(1+a*(x))^(-b)}
starts<-c(1,1,p.hat[1],p.hat[2])
}}
if(g=="gompertz"){
den=function(par,x){a=par[3]; b=par[4]; loc=par[5]; b*exp(a*(x-loc))*exp(-(exp(a*(x-loc))-1)*b/a)}
cum=function(par,x){a=par[3]; b=par[4]; loc=par[5]; 1-exp(-(exp(a*(x-loc))-1)*b/a)}
a.hat<-log(log(1-.75)/log(1-.5))/(qp3-median.mydata)
b.hat<--a.hat*log(0.5)/(exp(a.hat*median.mydata)-1)
z1=NULL;
gompertz.log<-function(p){
z1<--n*log(p[2])-p[1]*sum(y)+p[2]/p[1]*sum(exp(p[1]*y)-1)
z1[z1<1e-16]<-1e-16
}
p.hat<-suppressWarnings(optim(c(a.hat,b.hat),gompertz.log, method)$par)
starts<-c(1,1,p.hat[1],p.hat[2],(min.mydata-1/length(y)))
if (location==FALSE){
den=function(par,x){a=par[3]; b=par[4]; b*exp(a*(x))*exp(-(exp(a*(x))-1)*b/a)}
cum=function(par,x){a=par[3]; b=par[4]; 1-exp(-(exp(a*(x))-1)*b/a)}
starts<-c(1,1,p.hat[1],p.hat[2])
}}
if(g=="exp"){
den=function(par,x){rate=par[3]; loc=par[4]; dexp(x-loc,rate)}
cum=function(par,x){rate=par[3]; loc=par[4]; pexp(x-loc,rate)}
starts<-c(1,1,1/mean.mydata,(min.mydata-1/length(y)))
if (location==FALSE){
den=function(par,x){rate=par[3]; dexp(x,rate)}
cum=function(par,x){rate=par[3]; pexp(x,rate)}
starts<-c(1,1,1/mean.mydata)
}}
if(g=="rayleigh"){
den=function(par,x){a=par[3]; loc=par[4]; 2*(x-loc)/a*exp(-((x-loc)/a)^2)}
cum=function(par,x){a=par[3]; loc=par[4]; 1-exp(-((x-loc)/a)^2)}
starts<-c(1,1,log(2)/(median.mydata)^2,(min.mydata-1/length(y)))
if (location==FALSE){
den=function(par,x){a=par[3]; 2*x/a*exp(-(x/a)^2)}
cum=function(par,x){a=par[3]; 1-exp(-(x/a)^2)}
starts<-c(1,1,log(2)/(median.mydata)^2)
}}
if(g=="burrxii"){
den=function(par,x){a=par[3]; d=par[4]; loc=par[5]; d*a*(1+(x-loc)^d)^(-a-1)*((x-loc)^(d-1))}
cum=function(par,x){a=par[3]; d=par[4]; loc=par[5]; 1-(1+(x-loc)^d)^(-a)}
z1=NULL;
burrxii.log<-function(p){
z1<--n*log(p[1])-n*log(p[2])-(p[2]-1)*sum(log(y))+(p[1]+1)*sum(log(1+y^p[2]))
}
p.hat<-suppressWarnings(optim(c(1,1),burrxii.log, method="BFGS")$par)
starts<-c(1,1,p.hat[1],p.hat[2],(min.mydata-1/length(y)))
if (location==FALSE){
den=function(par,x){a=par[3]; d=par[4]; d*a*(1+(x)^d)^(-a-1)*((x)^(d-1))}
cum=function(par,x){a=par[3]; d=par[4]; 1-(1+(x)^d)^(-a)}
starts<-c(1,1,p.hat[1],p.hat[2])
}}
if(g=="frechet"){
den=function(par,x){a=par[3]; b=par[4]; loc=par[5]; (a*exp(-((x-loc)/b)^(-a))*((x-loc)/b)^(-a-1))/(b)}
cum=function(par,x){a=par[3]; b=par[4]; loc=par[5]; exp(-((x-loc)/b)^(-a))}
cons<-cor(inv.mydata,rank(inv.mydata))*(sd(inv.mydata)/mean(inv.mydata))*sqrt((n+1)/(n-1))/sqrt(3)
a.hat<-abs(ifelse(cons<1,-log(2)/log(1-cons),-log(2)/log(1-.98)))
b.hat<-median(inv.mydata)/(log(2))^(1/a.hat)
starts<-c(1,1,a.hat,1/b.hat,(min.mydata-1/length(y)))
if (location==FALSE){
den=function(par,x){a=par[3]; b=par[4]; (a*exp(-((x)/b)^(-a))*((x)/b)^(-a-1))/(b)}
cum=function(par,x){a=par[3]; b=par[4]; exp(-((x)/b)^(-a))}
starts<-c(1,1,a.hat,1/b.hat)
}}
if(g=="birnbaum-saunders"){
den=function(par,x){a=par[3]; b=par[4]; loc=par[5]; (sqrt((x-loc)/b)+sqrt(b/(x-loc)))/(2*a*(x-loc))*dnorm((sqrt((x-loc)/b)-sqrt(b/(x-loc)))/a)}
cum=function(par,x){a=par[3]; b=par[4]; loc=par[5]; pnorm((sqrt((x-loc)/b)-sqrt(b/(x-loc)))/a)}
r<-(mean(inv.mydata))^(-1)
b.hat<-sqrt(mean.mydata*r)
a.hat<-sqrt(2*(sqrt(mean.mydata/r)))
starts<-c(1,1,a.hat,b.hat,(min.mydata-1/length(y)))
if (location==FALSE){
den=function(par,x){a=par[3]; b=par[4]; (sqrt((x)/b)+sqrt(b/(x)))/(2*a*(x))*dnorm((sqrt((x)/b)-sqrt(b/(x)))/a)}
cum=function(par,x){a=par[3]; b=par[4]; pnorm((sqrt((x)/b)-sqrt(b/(x)))/a)}
starts<-c(1,1,a.hat,b.hat)
}}
if(g=="weibull"){
den=function(par,x){shape=par[3]; scale=par[4]; loc=par[5]; dweibull(x-loc,shape,scale)}
cum=function(par,x){shape=par[3]; scale=par[4]; loc=par[5]; pweibull(x-loc,shape,scale)}
cons<-cor(mydata,rank(mydata))*(std.mydata/mean.mydata)*sqrt((n+1)/(n-1))/sqrt(3)
a.hat<-abs(ifelse(cons<1,-log(2)/log(1-cons),-log(2)/log(1-.98)))
b.hat<-median.mydata/(log(2))^(1/a.hat)
starts<-c(1,1,a.hat,b.hat,(min.mydata-1/length(y)))
if (location==FALSE){
den=function(par,x){shape=par[3]; scale=par[4]; dweibull(x,shape,scale)}
cum=function(par,x){shape=par[3]; scale=par[4]; pweibull(x,shape,scale)}
starts<-c(1,1,a.hat,b.hat)
}}
if(g=="gamma"){
den=function(par,x){shape=par[3]; scale=par[4]; loc=par[5]; dgamma(x-loc,shape,scale)}
cum=function(par,x){shape=par[3]; scale=par[4]; loc=par[5]; pgamma(x-loc,shape,scale)}
a.hat<-uniroot(function(ss) trigamma(ss)-var(log(y)[is.finite(log(y))]),c(0,1000000))$root
b.hat<-mean.mydata/a.hat
starts<-c(1,1,a.hat,b.hat,(min.mydata-1/length(y)))
if (location==FALSE){
den=function(par,x){shape=par[3]; scale=par[4]; dgamma(x,shape,scale)}
cum=function(par,x){shape=par[3]; scale=par[4]; pgamma(x,shape,scale)}
starts<-c(1,1,a.hat,b.hat)
}}
pdf0<-function(par,x){
f0=den(par,x)
c0=cum(par,x)
a=par[1]
b=par[2]
b*a*f0/(1-c0)**2*exp(-b*c0/(1-c0))*(1-exp(-b*c0/(1-c0)))**(a-1)
}
cdf0<-function(par,x){
f0=den(par,x)
c0=cum(par,x)
a=par[1]
b=par[2]
(1-exp(-b*c0/(1-c0)))**a
}
mpsw<-function(par,x){
z=NULL
z=diff(c(0,cdf0(par,x),1))
for (j in 2:n){if((x[j]-x[j-1])==0){z[j]=pdf0(par,x[j])
}}
z[z<1e-16]=1e-16
-sum(log(z))
}
out<-suppressWarnings(optim(starts,fn=mpsw,x=sort.mydata,method))
n.p<-length(out$par)
gammam<-(n+1)*(log(n+1)-digamma(1))-1/2-1/(12*(n+1))
sigma2m<-(n+1)*(pi^2/6-1)-1/2-1/(6*(n+1))
c1<-gammam-sqrt(n*sigma2m/2)
c2<-sqrt(sigma2m/(2*n))
stat.chisquare<-(mpsw(out$par,sort.mydata)+n.p/2-c1)/c2
pvalue.chisquare<-pchisq(stat.chisquare,df=n,lower.tail=FALSE)
Moran<-out$value
log.likelihood=sum(log(pdf0(out$par,sort.mydata)))
u=cdf0(out$par,sort.mydata)
von<-c()
anderson<-c()
for(i in 1:n){
u[i]<-ifelse(u[i]==1,0.999999999,u[i])
von[i]=(u[i]-(2*i-1)/(2*n))^2
anderson[i]=(2*i-1)*log(u[i])+(2*n+1-2*i)*log(1-u[i])
}
anderson.stat=-n-mean(anderson)
von.stat=sum(von)+1/(12*n)
CAIC=-2*log.likelihood + 2*n.p + 2*(n.p*(n.p+1))/(n-n.p-1)
AIC=-2*log.likelihood + 2*n.p
BIC=-2*log.likelihood + n.p*log(n)
HQIC=-2*log.likelihood + 2*log(log(n))*n.p
ks.stat=suppressWarnings(ks.test(mydata, "cdf0", par=out$par))
aux2=cbind(AIC, CAIC, BIC, HQIC, von.stat, anderson.stat,log.likelihood,Moran)
colnames(aux2)=c("AIC","CAIC","BIC","HQIC","CM","AD", "log",
"Moran")
rownames(aux2)=c("")
aux3=cbind(ks.stat$statistic,ks.stat$p.value)
colnames(aux3)=c("statistic","p-value")
rownames(aux3)=c("")
aux4=cbind(stat.chisquare,qchisq(sig.level,df=n,lower.tail=FALSE),1-pchisq(stat.chisquare,df=n))
colnames(aux4)=c("statistic","chi-value","p-value")
rownames(aux4)=c("")
aux5=cbind(if(out$convergence==0){"Algorithm Converged"} else {"Algorithm Not Converged"})
list("MPS"=out$par,"Measures"=aux2,"KS"=aux3,"chi-square"=aux4,"Convergence Status"=aux5)
}
mpstexpsg<-function(mydata, g, location=TRUE, method , sig.level){
min.mydata<-min(mydata)
sort.mydata<-sort(mydata)
n<-length(mydata)
y<-(sort.mydata[2:n]-min.mydata)
y<-(sort.mydata[2:n]-min.mydata)[is.finite(log(sort.mydata[2:n]-min.mydata))]
n<-length(mydata)
qp1<-y[floor(.25*n)]
qp3<-y[floor(.75*n)]
median.mydata<-y[floor(.5*n)]
mean.mydata<-mean(y)
inv.mydata<-1/y[is.finite(1/y)]
inv.mean<-mean(inv.mydata)
std.mydata<-sd(y)
if(g!="birnbaum-saunders" & g!="exp" & g!="rayleigh" & g!="weibull" & g!="gompertz" & g!="gamma"
& g!="log-normal" & g!="chisq" & g!="f" & g!="burrxii" & g!="frechet"
& g!="lomax" & g!="log-logistic" & g!="lfr" & g!="chen")
{ stop ("Baseline distribution not implemented or misspelled. Please check the manual for guidelines.") }
if(g=="log-normal"){
den=function(par,x){meanlog=par[2]; sdlog=par[3]; loc=par[4]; dlnorm(x-loc,meanlog,sdlog)}
cum=function(par,x){meanlog=par[2]; sdlog=par[3]; loc=par[4]; plnorm(x-loc,meanlog,sdlog)}
starts<-c(1,log(median.mydata),sqrt(2*abs(log(mean.mydata/median.mydata))),(min.mydata-1/length(y)))
if (location==FALSE){
den=function(par,x){meanlog=par[2]; sdlog=par[3]; dlnorm(x,meanlog,sdlog)}
cum=function(par,x){meanlog=par[2]; sdlog=par[3]; plnorm(x,meanlog,sdlog)}
starts<-c(1,log(median.mydata),sqrt(2*abs(log(mean.mydata/median.mydata))))
}}
if(g=="chisq"){
den=function(par,x){df=par[2]; loc=par[3]; dchisq(x-loc,df)}
cum=function(par,x){df=par[2]; loc=par[3]; pchisq(x-loc,df)}
starts<-c(1,mean.mydata,(min.mydata-1/length(y)))
if (location==FALSE){
den=function(par,x){df=par[2]; dchisq(x,df)}
cum=function(par,x){df=par[2]; pchisq(x,df)}
starts<-c(1,mean.mydata)
}}
if(g=="f"){
den=function(par,x){df1=par[2]; df2=par[3]; loc=par[4]; df(x-loc,df1,df2)}
cum=function(par,x){df1=par[2]; df2=par[3]; loc=par[4]; pf(x-loc,df1,df2)}
df.1<-ifelse(inv.mean>1,2*inv.mean/(inv.mean-1),1)
df.2<-ifelse(mean.mydata>1,2*mean.mydata/(mean.mydata-1),1)
starts<-c(1,df.1,df.2,(min.mydata-1/length(y)))
if (location==FALSE){
den=function(par,x){df1=par[2]; df2=par[3]; df(x,df1,df2)}
cum=function(par,x){df1=par[2]; df2=par[3]; pf(x,df1,df2)}
starts<-c(1,df.1,df.2)
}}
if(g=="chen"){
den=function(par,x){a=par[2]; b=par[3]; loc=par[4]; a*b*(x-loc)^(a-1)*exp((x-loc)^a)*exp(-b*(exp((x-loc)^a)-1))}
cum=function(par,x){a=par[2]; b=par[3]; loc=par[4]; 1-exp(-b*(exp((x-loc)^a)-1))}
standard.mydata<-(y-mean.mydata)/std.mydata
s.hat<-ifelse(max(standard.mydata)<=1,-log(1-n/(n+.4))/(exp(1)-1),-
log(1-length(standard.mydata[standard.mydata<=1])/length(standard.mydata))/(exp(1)-1))
r.hat<-abs(log(log(1-log(1-0.5)/s.hat))/log(median.mydata))
starts<-c(1,r.hat,s.hat,(min.mydata-1/length(y)))
if (location==FALSE){
den=function(par,x){a=par[2]; b=par[3]; a*b*(x)^(a-1)*exp((x)^a)*exp(-b*(exp((x)^a)-1))}
cum=function(par,x){a=par[2]; b=par[3]; 1-exp(-b*(exp((x)^a)-1))}
starts<-c(1,r.hat,s.hat)
}}
if(g=="lfr"){
den=function(par,x){a=par[2]; b=par[3]; loc=par[4]; (a+b*(x-loc))*exp(-a*(x-loc)-(b*(x-loc)^2)/2)}
cum=function(par,x){a=par[2]; b=par[3]; loc=par[4]; 1-exp(-a*(x-loc)-(b*(x-loc)^2)/2)}
ii<-seq(1,(n-1))
yy<--log(1-(ii+0.3)/(n-1+0.4))
res<-summary(lm(yy ~ -1+y+I(y^2)))$coefficient
coeff<-c(abs(res[1,1]),abs(res[2,1]))
z1=NULL;
lfr.log<-function(p) {
z1<--log(sum(p[1]+p[2]*y))+p[1]*sum(y)+p[2]/2*sum(y^2)
z1[z1<1e-16]<-1e-16
}
p.hat<-suppressWarnings(optim(c(abs(coeff[1]),2*abs(coeff[2])),lfr.log)$par)
starts<-c(1,p.hat[1],p.hat[2],(min.mydata-1/length(y)))
if (location==FALSE){
den=function(par,x){a=par[2]; b=par[3]; (a+b*(x))*exp(-a*(x)-(b*(x)^2)/2)}
cum=function(par,x){a=par[2]; b=par[3]; 1-exp(-a*(x)-(b*(x)^2)/2)}
starts<-c(1,p.hat[1],p.hat[2])
}}
if(g=="log-logistic"){
den=function(par,x){a=par[2]; b=par[3]; loc=par[4]; (a*b^(-a)*(x-loc)^(a-1))/((((x-loc)/b)^a +1)^2)}
cum=function(par,x){a=par[2]; b=par[3]; loc=par[4]; 1/(((x-loc)/b)^(-a)+1)}
starts<-c(1,log(0.75/(1-0.75))/log(qp3/median.mydata),median.mydata,(min.mydata-1/length(y)))
if (location==FALSE){
den=function(par,x){a=par[2]; b=par[3]; (a*b^(-a)*(x)^(a-1))/((((x)/b)^a +1)^2)}
cum=function(par,x){a=par[2]; b=par[3]; 1/(((x)/b)^(-a)+1)}
starts<-c(1,log(0.75/(1-0.75))/log(qp3/median.mydata),median.mydata)
}}
if(g=="lomax"){
den=function(par,x){a=par[2]; b=par[3]; loc=par[4]; (a*b)/((1+a*(x-loc))^(b+1))}
cum=function(par,x){a=par[2]; b=par[3]; loc=par[4]; 1-(1+a*(x-loc))^(-b)}
a.hat<-1
b.hat<-(.5^(-1/a.hat)-1)/median.mydata
z1=NULL;
lomax.log<-function(p) {
z1<--n*log(p[1])-n*log(p[2])+(p[2]+1)*sum(log(1+p[1]*y))
z1[z1<1e-16]<-1e-16
}
p.hat<-suppressWarnings(optim(c(1,b.hat),lomax.log, method)$par)
starts<-c(1,p.hat[1],p.hat[2],(min.mydata-1/length(y)))
if (location==FALSE){
den=function(par,x){a=par[2]; b=par[3]; (a*b)/((1+a*(x))^(b+1))}
cum=function(par,x){a=par[2]; b=par[3]; 1-(1+a*(x))^(-b)}
starts<-c(1,p.hat[1],p.hat[2])
}}
if(g=="gompertz"){
den=function(par,x){a=par[2]; b=par[3]; loc=par[4]; b*exp(a*(x-loc))*exp(-(exp(a*(x-loc))-1)*b/a)}
cum=function(par,x){a=par[2]; b=par[3]; loc=par[4]; 1-exp(-(exp(a*(x-loc))-1)*b/a)}
a.hat<-log(log(1-.75)/log(1-.5))/(qp3-median.mydata)
b.hat<--a.hat*log(0.5)/(exp(a.hat*median.mydata)-1)
z1=NULL;
gompertz.log<-function(p){
z1<--n*log(p[2])-p[1]*sum(y)+p[2]/p[1]*sum(exp(p[1]*y)-1)
z1[z1<1e-16]<-1e-16
}
p.hat<-suppressWarnings(optim(c(a.hat,b.hat),gompertz.log, method)$par)
starts<-c(1,p.hat[1],p.hat[2],(min.mydata-1/length(y)))
if (location==FALSE){
den=function(par,x){a=par[2]; b=par[3]; b*exp(a*(x))*exp(-(exp(a*(x))-1)*b/a)}
cum=function(par,x){a=par[2]; b=par[3]; 1-exp(-(exp(a*(x))-1)*b/a)}
starts<-c(1,p.hat[1],p.hat[2])
}}
if(g=="exp"){
den=function(par,x){rate=par[2]; loc=par[3]; dexp(x-loc,rate)}
cum=function(par,x){rate=par[2]; loc=par[3]; pexp(x-loc,rate)}
starts<-c(1,1/mean.mydata,(min.mydata-1/length(y)))
if (location==FALSE){
den=function(par,x){rate=par[2]; dexp(x,rate)}
cum=function(par,x){rate=par[2]; pexp(x,rate)}
starts<-c(1,1/mean.mydata)
}}
if(g=="rayleigh"){
den=function(par,x){a=par[2]; loc=par[3]; 2*(x-loc)/a*exp(-((x-loc)/a)^2)}
cum=function(par,x){a=par[2]; loc=par[3]; 1-exp(-((x-loc)/a)^2)}
starts<-c(1,log(2)/(median.mydata)^2,(min.mydata-1/length(y)))
if (location==FALSE){
den=function(par,x){a=par[2]; 2*x/a*exp(-(x/a)^2)}
cum=function(par,x){a=par[2]; 1-exp(-(x/a)^2)}
starts<-c(1,log(2)/(median.mydata)^2)
}}
if(g=="burrxii"){
den=function(par,x){a=par[2]; d=par[3]; loc=par[4]; d*a*(1+(x-loc)^d)^(-a-1)*((x-loc)^(d-1))}
cum=function(par,x){a=par[2]; d=par[3]; loc=par[4]; 1-(1+(x-loc)^d)^(-a)}
z1=NULL;
burrxii.log<-function(p){
z1<--n*log(p[1])-n*log(p[2])-(p[2]-1)*sum(log(y))+(p[1]+1)*sum(log(1+y^p[2]))
}
p.hat<-suppressWarnings(optim(c(1,1),burrxii.log, method="BFGS")$par)
starts<-c(1,p.hat[1],p.hat[2],(min.mydata-1/length(y)))
if (location==FALSE){
den=function(par,x){a=par[2]; d=par[3]; d*a*(1+(x)^d)^(-a-1)*((x)^(d-1))}
cum=function(par,x){a=par[2]; d=par[3]; 1-(1+(x)^d)^(-a)}
starts<-c(1,p.hat[1],p.hat[2])
}}
if(g=="frechet"){
den=function(par,x){a=par[2]; b=par[3]; loc=par[4]; (a*exp(-((x-loc)/b)^(-a))*((x-loc)/b)^(-a-1))/(b)}
cum=function(par,x){a=par[2]; b=par[3]; loc=par[4]; exp(-((x-loc)/b)^(-a))}
cons<-cor(inv.mydata,rank(inv.mydata))*(sd(inv.mydata)/mean(inv.mydata))*sqrt((n+1)/(n-1))/sqrt(3)
a.hat<-abs(ifelse(cons<1,-log(2)/log(1-cons),-log(2)/log(1-.98)))
b.hat<-median(inv.mydata)/(log(2))^(1/a.hat)
starts<-c(1,a.hat,1/b.hat,(min.mydata-1/length(y)))
if (location==FALSE){
den=function(par,x){a=par[2]; b=par[3]; (a*exp(-((x)/b)^(-a))*((x)/b)^(-a-1))/(b)}
cum=function(par,x){a=par[2]; b=par[3]; exp(-((x)/b)^(-a))}
starts<-c(1,a.hat,1/b.hat)
}}
if(g=="birnbaum-saunders"){
den=function(par,x){a=par[2]; b=par[3]; loc=par[4]; (sqrt((x-loc)/b)+sqrt(b/(x-loc)))/(2*a*(x-loc))*dnorm((sqrt((x-loc)/b)-sqrt(b/(x-loc)))/a)}
cum=function(par,x){a=par[2]; b=par[3]; loc=par[4]; pnorm((sqrt((x-loc)/b)-sqrt(b/(x-loc)))/a)}
r<-(mean(inv.mydata))^(-1)
b.hat<-sqrt(mean.mydata*r)
a.hat<-sqrt(2*(sqrt(mean.mydata/r)))
starts<-c(1,a.hat,b.hat,(min.mydata-1/length(y)))
if (location==FALSE){
den=function(par,x){a=par[2]; b=par[3]; (sqrt((x)/b)+sqrt(b/(x)))/(2*a*(x))*dnorm((sqrt((x)/b)-sqrt(b/(x)))/a)}
cum=function(par,x){a=par[2]; b=par[3]; pnorm((sqrt((x)/b)-sqrt(b/(x)))/a)}
starts<-c(1,a.hat,b.hat)
}}
if(g=="weibull"){
den=function(par,x){shape=par[2]; scale=par[3]; loc=par[4]; dweibull(x-loc,shape,scale)}
cum=function(par,x){shape=par[2]; scale=par[3]; loc=par[4]; pweibull(x-loc,shape,scale)}
cons<-cor(mydata,rank(mydata))*(std.mydata/mean.mydata)*sqrt((n+1)/(n-1))/sqrt(3)
a.hat<-abs(ifelse(cons<1,-log(2)/log(1-cons),-log(2)/log(1-.98)))
b.hat<-median.mydata/(log(2))^(1/a.hat)
starts<-c(1,a.hat,b.hat,(min.mydata-1/length(y)))
if (location==FALSE){
den=function(par,x){shape=par[2]; scale=par[3]; dweibull(x,shape,scale)}
cum=function(par,x){shape=par[2]; scale=par[3]; pweibull(x,shape,scale)}
starts<-c(1,a.hat,b.hat)
}}
if(g=="gamma"){
den=function(par,x){shape=par[2]; scale=par[3]; loc=par[4]; dgamma(x-loc,shape,scale)}
cum=function(par,x){shape=par[2]; scale=par[3]; loc=par[4]; pgamma(x-loc,shape,scale)}
a.hat<-uniroot(function(ss) trigamma(ss)-var(log(y)[is.finite(log(y))]),c(0,1000000))$root
b.hat<-mean.mydata/a.hat
starts<-c(1,a.hat,b.hat,(min.mydata-1/length(y)))
if (location==FALSE){
den=function(par,x){shape=par[2]; scale=par[3]; dgamma(x,shape,scale)}
cum=function(par,x){shape=par[2]; scale=par[3]; pgamma(x,shape,scale)}
starts<-c(1,a.hat,b.hat)
}}
pdf0<-function(par,x){
f0=den(par,x)
c0=cum(par,x)
a=par[1]
a*(1-exp(-a))^(-1)*f0*exp(-a*c0)
}
cdf0<-function(par,x){
f0=den(par,x)
c0=cum(par,x)
a=par[1]
(1-exp(-a*c0))*(1-exp(-a))^(-1)
}
mpsw<-function(par,x){
z=NULL
z=diff(c(0,cdf0(par,x),1))
for (j in 2:n){if((x[j]-x[j-1])==0){z[j]=pdf0(par,x[j])
}}
z[z<1e-16]=1e-16
-sum(log(z))
}
out<-suppressWarnings(optim(starts,fn=mpsw,x=sort.mydata,method))
n.p<-length(out$par)
gammam<-(n+1)*(log(n+1)-digamma(1))-1/2-1/(12*(n+1))
sigma2m<-(n+1)*(pi^2/6-1)-1/2-1/(6*(n+1))
c1<-gammam-sqrt(n*sigma2m/2)
c2<-sqrt(sigma2m/(2*n))
stat.chisquare<-(mpsw(out$par,sort.mydata)+n.p/2-c1)/c2
pvalue.chisquare<-pchisq(stat.chisquare,df=n,lower.tail=FALSE)
Moran<-out$value
log.likelihood=sum(log(pdf0(out$par,sort.mydata)))
u=cdf0(out$par,sort.mydata)
von<-c()
anderson<-c()
for(i in 1:n){
u[i]<-ifelse(u[i]==1,0.999999999,u[i])
von[i]=(u[i]-(2*i-1)/(2*n))^2
anderson[i]=(2*i-1)*log(u[i])+(2*n+1-2*i)*log(1-u[i])
}
anderson.stat=-n-mean(anderson)
von.stat=sum(von)+1/(12*n)
CAIC=-2*log.likelihood + 2*n.p + 2*(n.p*(n.p+1))/(n-n.p-1)
AIC=-2*log.likelihood + 2*n.p
BIC=-2*log.likelihood + n.p*log(n)
HQIC=-2*log.likelihood + 2*log(log(n))*n.p
ks.stat=suppressWarnings(ks.test(mydata, "cdf0", par=out$par))
aux2=cbind(AIC, CAIC, BIC, HQIC, von.stat, anderson.stat,log.likelihood,Moran)
colnames(aux2)=c("AIC","CAIC","BIC","HQIC","CM","AD", "log",
"Moran")
rownames(aux2)=c("")
aux3=cbind(ks.stat$statistic,ks.stat$p.value)
colnames(aux3)=c("statistic","p-value")
rownames(aux3)=c("")
aux4=cbind(stat.chisquare,qchisq(sig.level,df=n,lower.tail=FALSE),1-pchisq(stat.chisquare,df=n))
colnames(aux4)=c("statistic","chi-value","p-value")
rownames(aux4)=c("")
aux5=cbind(if(out$convergence==0){"Algorithm Converged"} else {"Algorithm Not Converged"})
list("MPS"=out$par,"Measures"=aux2,"KS"=aux3,"chi-square"=aux4,"Convergence Status"=aux5)
}
mpsweibullg<-function(mydata, g, location=TRUE, method , sig.level){
min.mydata<-min(mydata)
sort.mydata<-sort(mydata)
n<-length(mydata)
y<-(sort.mydata[2:n]-min.mydata)
y<-(sort.mydata[2:n]-min.mydata)[is.finite(log(sort.mydata[2:n]-min.mydata))]
n<-length(mydata)
qp1<-y[floor(.25*n)]
qp3<-y[floor(.75*n)]
median.mydata<-y[floor(.5*n)]
mean.mydata<-mean(y)
inv.mydata<-1/y[is.finite(1/y)]
inv.mean<-mean(inv.mydata)
std.mydata<-sd(y)
if(g!="birnbaum-saunders" & g!="exp" & g!="rayleigh" & g!="weibull" & g!="gompertz" & g!="gamma"
& g!="log-normal" & g!="chisq" & g!="f" & g!="burrxii" & g!="frechet"
& g!="lomax" & g!="log-logistic" & g!="lfr" & g!="chen")
{ stop ("Baseline distribution not implemented or misspelled. Please check the manual for guidelines.") }
if(g=="log-normal"){
den=function(par,x){meanlog=par[3]; sdlog=par[4]; loc=par[5]; dlnorm(x-loc,meanlog,sdlog)}
cum=function(par,x){meanlog=par[3]; sdlog=par[4]; loc=par[5]; plnorm(x-loc,meanlog,sdlog)}
starts<-c(1,1,log(median.mydata),sqrt(2*abs(log(mean.mydata/median.mydata))),(min.mydata-1/length(y)))
if (location==FALSE){
den=function(par,x){meanlog=par[3]; sdlog=par[4]; dlnorm(x,meanlog,sdlog)}
cum=function(par,x){meanlog=par[3]; sdlog=par[4]; plnorm(x,meanlog,sdlog)}
starts<-c(1,1,log(median.mydata),sqrt(2*abs(log(mean.mydata/median.mydata))))
}}
if(g=="chisq"){
den=function(par,x){df=par[3]; loc=par[4]; dchisq(x-loc,df)}
cum=function(par,x){df=par[3]; loc=par[4]; pchisq(x-loc,df)}
starts<-c(1,1,mean.mydata,(min.mydata-1/length(y)))
if (location==FALSE){
den=function(par,x){df=par[3]; dchisq(x,df)}
cum=function(par,x){df=par[3]; pchisq(x,df)}
starts<-c(1,1,mean.mydata)
}}
if(g=="f"){
den=function(par,x){df1=par[3]; df2=par[4]; loc=par[5]; df(x-loc,df1,df2)}
cum=function(par,x){df1=par[3]; df2=par[4]; loc=par[5]; pf(x-loc,df1,df2)}
df.1<-ifelse(inv.mean>1,2*inv.mean/(inv.mean-1),1)
df.2<-ifelse(mean.mydata>1,2*mean.mydata/(mean.mydata-1),1)
starts<-c(1,1,df.1,df.2,(min.mydata-1/length(y)))
if (location==FALSE){
den=function(par,x){df1=par[3]; df2=par[4]; df(x,df1,df2)}
cum=function(par,x){df1=par[3]; df2=par[4]; pf(x,df1,df2)}
starts<-c(1,1,df.1,df.2)
}}
if(g=="chen"){
den=function(par,x){a=par[3]; b=par[4]; loc=par[5]; a*b*(x-loc)^(a-1)*exp((x-loc)^a)*exp(-b*(exp((x-loc)^a)-1))}
cum=function(par,x){a=par[3]; b=par[4]; loc=par[5]; 1-exp(-b*(exp((x-loc)^a)-1))}
standard.mydata<-(y-mean.mydata)/std.mydata
s.hat<-ifelse(max(standard.mydata)<=1,-log(1-n/(n+.4))/(exp(1)-1),-
log(1-length(standard.mydata[standard.mydata<=1])/length(standard.mydata))/(exp(1)-1))
r.hat<-abs(log(log(1-log(1-0.5)/s.hat))/log(median.mydata))
starts<-c(1,1,r.hat,s.hat,(min.mydata-1/length(y)))
if (location==FALSE){
den=function(par,x){a=par[3]; b=par[4]; a*b*(x)^(a-1)*exp((x)^a)*exp(-b*(exp((x)^a)-1))}
cum=function(par,x){a=par[3]; b=par[4]; 1-exp(-b*(exp((x)^a)-1))}
starts<-c(1,1,r.hat,s.hat)
}}
if(g=="lfr"){
den=function(par,x){a=par[3]; b=par[4]; loc=par[5]; (a+b*(x-loc))*exp(-a*(x-loc)-(b*(x-loc)^2)/2)}
cum=function(par,x){a=par[3]; b=par[4]; loc=par[5]; 1-exp(-a*(x-loc)-(b*(x-loc)^2)/2)}
ii<-seq(1,(n-1))
yy<--log(1-(ii+0.3)/(n-1+0.4))
res<-summary(lm(yy ~ -1+y+I(y^2)))$coefficient
coeff<-c(abs(res[1,1]),abs(res[2,1]))
z1=NULL;
lfr.log<-function(p) {
z1<--log(sum(p[1]+p[2]*y))+p[1]*sum(y)+p[2]/2*sum(y^2)
z1[z1<1e-16]<-1e-16
}
p.hat<-suppressWarnings(optim(c(abs(coeff[1]),2*abs(coeff[2])),lfr.log)$par)
starts<-c(1,1,p.hat[1],p.hat[2],(min.mydata-1/length(y)))
if (location==FALSE){
den=function(par,x){a=par[3]; b=par[4]; (a+b*(x))*exp(-a*(x)-(b*(x)^2)/2)}
cum=function(par,x){a=par[3]; b=par[4]; 1-exp(-a*(x)-(b*(x)^2)/2)}
starts<-c(1,1,p.hat[1],p.hat[2])
}}
if(g=="log-logistic"){
den=function(par,x){a=par[3]; b=par[4]; loc=par[5]; (a*b^(-a)*(x-loc)^(a-1))/((((x-loc)/b)^a +1)^2)}
cum=function(par,x){a=par[3]; b=par[4]; loc=par[5]; 1/(((x-loc)/b)^(-a)+1)}
starts<-c(1,1,log(0.75/(1-0.75))/log(qp3/median.mydata),median.mydata,(min.mydata-1/length(y)))
if (location==FALSE){
den=function(par,x){a=par[3]; b=par[4]; (a*b^(-a)*(x)^(a-1))/((((x)/b)^a +1)^2)}
cum=function(par,x){a=par[3]; b=par[4]; 1/(((x)/b)^(-a)+1)}
starts<-c(1,1,log(0.75/(1-0.75))/log(qp3/median.mydata),median.mydata)
}}
if(g=="lomax"){
den=function(par,x){a=par[3]; b=par[4]; loc=par[5]; (a*b)/((1+a*(x-loc))^(b+1))}
cum=function(par,x){a=par[3]; b=par[4]; loc=par[5]; 1-(1+a*(x-loc))^(-b)}
a.hat<-1
b.hat<-(.5^(-1/a.hat)-1)/median.mydata
z1=NULL;
lomax.log<-function(p) {
z1<--n*log(p[1])-n*log(p[2])+(p[2]+1)*sum(log(1+p[1]*y))
z1[z1<1e-16]<-1e-16
}
p.hat<-suppressWarnings(optim(c(1,b.hat),lomax.log, method)$par)
starts<-c(1,1,p.hat[1],p.hat[2],(min.mydata-1/length(y)))
if (location==FALSE){
den=function(par,x){a=par[3]; b=par[4]; (a*b)/((1+a*(x))^(b+1))}
cum=function(par,x){a=par[3]; b=par[4]; 1-(1+a*(x))^(-b)}
starts<-c(1,1,p.hat[1],p.hat[2])
}}
if(g=="gompertz"){
den=function(par,x){a=par[3]; b=par[4]; loc=par[5]; b*exp(a*(x-loc))*exp(-(exp(a*(x-loc))-1)*b/a)}
cum=function(par,x){a=par[3]; b=par[4]; loc=par[5]; 1-exp(-(exp(a*(x-loc))-1)*b/a)}
a.hat<-log(log(1-.75)/log(1-.5))/(qp3-median.mydata)
b.hat<--a.hat*log(0.5)/(exp(a.hat*median.mydata)-1)
z1=NULL;
gompertz.log<-function(p){
z1<--n*log(p[2])-p[1]*sum(y)+p[2]/p[1]*sum(exp(p[1]*y)-1)
z1[z1<1e-16]<-1e-16
}
p.hat<-suppressWarnings(optim(c(a.hat,b.hat),gompertz.log, method)$par)
starts<-c(1,1,p.hat[1],p.hat[2],(min.mydata-1/length(y)))
if (location==FALSE){
den=function(par,x){a=par[3]; b=par[4]; b*exp(a*(x))*exp(-(exp(a*(x))-1)*b/a)}
cum=function(par,x){a=par[3]; b=par[4]; 1-exp(-(exp(a*(x))-1)*b/a)}
starts<-c(1,1,p.hat[1],p.hat[2])
}}
if(g=="exp"){
den=function(par,x){rate=par[3]; loc=par[4]; dexp(x-loc,rate)}
cum=function(par,x){rate=par[3]; loc=par[4]; pexp(x-loc,rate)}
starts<-c(1,1,1/mean.mydata,(min.mydata-1/length(y)))
if (location==FALSE){
den=function(par,x){rate=par[3]; dexp(x,rate)}
cum=function(par,x){rate=par[3]; pexp(x,rate)}
starts<-c(1,1,1/mean.mydata)
}}
if(g=="rayleigh"){
den=function(par,x){a=par[3]; loc=par[4]; 2*(x-loc)/a*exp(-((x-loc)/a)^2)}
cum=function(par,x){a=par[3]; loc=par[4]; 1-exp(-((x-loc)/a)^2)}
starts<-c(1,1,log(2)/(median.mydata)^2,(min.mydata-1/length(y)))
if (location==FALSE){
den=function(par,x){a=par[3]; 2*x/a*exp(-(x/a)^2)}
cum=function(par,x){a=par[3]; 1-exp(-(x/a)^2)}
starts<-c(1,1,log(2)/(median.mydata)^2)
}}
if(g=="burrxii"){
den=function(par,x){a=par[3]; d=par[4]; loc=par[5]; d*a*(1+(x-loc)^d)^(-a-1)*((x-loc)^(d-1))}
cum=function(par,x){a=par[3]; d=par[4]; loc=par[5]; 1-(1+(x-loc)^d)^(-a)}
z1=NULL;
burrxii.log<-function(p){
z1<--n*log(p[1])-n*log(p[2])-(p[2]-1)*sum(log(y))+(p[1]+1)*sum(log(1+y^p[2]))
}
p.hat<-suppressWarnings(optim(c(1,1),burrxii.log, method="BFGS")$par)
starts<-c(1,1,p.hat[1],p.hat[2],(min.mydata-1/length(y)))
if (location==FALSE){
den=function(par,x){a=par[3]; d=par[4]; d*a*(1+(x)^d)^(-a-1)*((x)^(d-1))}
cum=function(par,x){a=par[3]; d=par[4]; 1-(1+(x)^d)^(-a)}
starts<-c(1,1,p.hat[1],p.hat[2])
}}
if(g=="frechet"){
den=function(par,x){a=par[3]; b=par[4]; loc=par[5]; (a*exp(-((x-loc)/b)^(-a))*((x-loc)/b)^(-a-1))/(b)}
cum=function(par,x){a=par[3]; b=par[4]; loc=par[5]; exp(-((x-loc)/b)^(-a))}
cons<-cor(inv.mydata,rank(inv.mydata))*(sd(inv.mydata)/mean(inv.mydata))*sqrt((n+1)/(n-1))/sqrt(3)
a.hat<-abs(ifelse(cons<1,-log(2)/log(1-cons),-log(2)/log(1-.98)))
b.hat<-median(inv.mydata)/(log(2))^(1/a.hat)
starts<-c(1,1,a.hat,1/b.hat,(min.mydata-1/length(y)))
if (location==FALSE){
den=function(par,x){a=par[3]; b=par[4]; (a*exp(-((x)/b)^(-a))*((x)/b)^(-a-1))/(b)}
cum=function(par,x){a=par[3]; b=par[4]; exp(-((x)/b)^(-a))}
starts<-c(1,1,a.hat,1/b.hat)
}}
if(g=="birnbaum-saunders"){
den=function(par,x){a=par[3]; b=par[4]; loc=par[5]; (sqrt((x-loc)/b)+sqrt(b/(x-loc)))/(2*a*(x-loc))*dnorm((sqrt((x-loc)/b)-sqrt(b/(x-loc)))/a)}
cum=function(par,x){a=par[3]; b=par[4]; loc=par[5]; pnorm((sqrt((x-loc)/b)-sqrt(b/(x-loc)))/a)}
r<-(mean(inv.mydata))^(-1)
b.hat<-sqrt(mean.mydata*r)
a.hat<-sqrt(2*(sqrt(mean.mydata/r)))
starts<-c(1,1,a.hat,b.hat,(min.mydata-1/length(y)))
if (location==FALSE){
den=function(par,x){a=par[3]; b=par[4]; (sqrt((x)/b)+sqrt(b/(x)))/(2*a*(x))*dnorm((sqrt((x)/b)-sqrt(b/(x)))/a)}
cum=function(par,x){a=par[3]; b=par[4]; pnorm((sqrt((x)/b)-sqrt(b/(x)))/a)}
starts<-c(1,1,a.hat,b.hat)
}}
if(g=="weibull"){
den=function(par,x){shape=par[3]; scale=par[4]; loc=par[5]; dweibull(x-loc,shape,scale)}
cum=function(par,x){shape=par[3]; scale=par[4]; loc=par[5]; pweibull(x-loc,shape,scale)}
cons<-cor(mydata,rank(mydata))*(std.mydata/mean.mydata)*sqrt((n+1)/(n-1))/sqrt(3)
a.hat<-abs(ifelse(cons<1,-log(2)/log(1-cons),-log(2)/log(1-.98)))
b.hat<-median.mydata/(log(2))^(1/a.hat)
starts<-c(1,1,a.hat,b.hat,(min.mydata-1/length(y)))
if (location==FALSE){
den=function(par,x){shape=par[3]; scale=par[4]; dweibull(x,shape,scale)}
cum=function(par,x){shape=par[3]; scale=par[4]; pweibull(x,shape,scale)}
starts<-c(1,1,a.hat,b.hat)
}}
if(g=="gamma"){
den=function(par,x){shape=par[3]; scale=par[4]; loc=par[5]; dgamma(x-loc,shape,scale)}
cum=function(par,x){shape=par[3]; scale=par[4]; loc=par[5]; pgamma(x-loc,shape,scale)}
a.hat<-uniroot(function(ss) trigamma(ss)-var(log(y)[is.finite(log(y))]),c(0,1000000))$root
b.hat<-mean.mydata/a.hat
starts<-c(1,1,a.hat,b.hat,(min.mydata-1/length(y)))
if (location==FALSE){
den=function(par,x){shape=par[3]; scale=par[4]; dgamma(x,shape,scale)}
cum=function(par,x){shape=par[3]; scale=par[4]; pgamma(x,shape,scale)}
starts<-c(1,1,a.hat,b.hat)
}}
pdf0<-function(par,x){
f0=den(par,x)
c0=cum(par,x)
a=par[1]
b=par[2]
a*b**(-a)*(f0/(1-c0))*(-log(1-c0))**(a-1)*exp(-b**(-a)*(-log(1-c0))**a)
}
cdf0<-function(par,x){
f0=den(par,x)
c0=cum(par,x)
a=par[1]
b=par[2]
1-exp(-b**(-a)*(-log(1-c0))**a)
}
mpsw<-function(par,x){
z=NULL
z=diff(c(0,cdf0(par,x),1))
for (j in 2:n){if((x[j]-x[j-1])==0){z[j]=pdf0(par,x[j])
}}
z[z<1e-16]=1e-16
-sum(log(z))
}
out<-suppressWarnings(optim(starts,fn=mpsw,x=sort.mydata,method))
n.p<-length(out$par)
gammam<-(n+1)*(log(n+1)-digamma(1))-1/2-1/(12*(n+1))
sigma2m<-(n+1)*(pi^2/6-1)-1/2-1/(6*(n+1))
c1<-gammam-sqrt(n*sigma2m/2)
c2<-sqrt(sigma2m/(2*n))
stat.chisquare<-(mpsw(out$par,sort.mydata)+n.p/2-c1)/c2
pvalue.chisquare<-pchisq(stat.chisquare,df=n,lower.tail=FALSE)
Moran<-out$value
log.likelihood=sum(log(pdf0(out$par,sort.mydata)))
u=cdf0(out$par,sort.mydata)
von<-c()
anderson<-c()
for(i in 1:n){
u[i]<-ifelse(u[i]==1,0.999999999,u[i])
von[i]=(u[i]-(2*i-1)/(2*n))^2
anderson[i]=(2*i-1)*log(u[i])+(2*n+1-2*i)*log(1-u[i])
}
anderson.stat=-n-mean(anderson)
von.stat=sum(von)+1/(12*n)
CAIC=-2*log.likelihood + 2*n.p + 2*(n.p*(n.p+1))/(n-n.p-1)
AIC=-2*log.likelihood + 2*n.p
BIC=-2*log.likelihood + n.p*log(n)
HQIC=-2*log.likelihood + 2*log(log(n))*n.p
ks.stat=suppressWarnings(ks.test(mydata, "cdf0", par=out$par))
aux2=cbind(AIC, CAIC, BIC, HQIC, von.stat, anderson.stat,log.likelihood,Moran)
colnames(aux2)=c("AIC","CAIC","BIC","HQIC","CM","AD", "log",
"Moran")
rownames(aux2)=c("")
aux3=cbind(ks.stat$statistic,ks.stat$p.value)
colnames(aux3)=c("statistic","p-value")
rownames(aux3)=c("")
aux4=cbind(stat.chisquare,qchisq(sig.level,df=n,lower.tail=FALSE),1-pchisq(stat.chisquare,df=n))
colnames(aux4)=c("statistic","chi-value","p-value")
rownames(aux4)=c("")
aux5=cbind(if(out$convergence==0){"Algorithm Converged"} else {"Algorithm Not Converged"})
list("MPS"=out$par,"Measures"=aux2,"KS"=aux3,"chi-square"=aux4,"Convergence Status"=aux5)
}
mpsmbetag<-function(mydata, g, location=TRUE, method, sig.level){
min.mydata<-min(mydata)
sort.mydata<-sort(mydata)
n<-length(mydata)
y<-(sort.mydata[2:n]-min.mydata)
y<-(sort.mydata[2:n]-min.mydata)[is.finite(log(sort.mydata[2:n]-min.mydata))]
n<-length(mydata)
qp1<-y[floor(.25*n)]
qp3<-y[floor(.75*n)]
median.mydata<-y[floor(.5*n)]
mean.mydata<-mean(y)
inv.mydata<-1/y[is.finite(1/y)]
inv.mean<-mean(inv.mydata)
std.mydata<-sd(y)
if(g!="birnbaum-saunders" & g!="exp" & g!="rayleigh" & g!="weibull" & g!="gompertz" & g!="gamma"
& g!="log-normal" & g!="chisq" & g!="f" & g!="burrxii" & g!="frechet"
& g!="lomax" & g!="log-logistic" & g!="lfr" & g!="chen")
{ stop ("Baseline distribution not implemented or misspelled. Please check the manual for guidelines.") }
if(g=="log-normal"){
den=function(par,x){meanlog=par[4]; sdlog=par[5]; loc=par[6]; dlnorm(x-loc,meanlog,sdlog)}
cum=function(par,x){meanlog=par[4]; sdlog=par[5]; loc=par[6]; plnorm(x-loc,meanlog,sdlog)}
starts<-c(1,1,0.5,log(median.mydata),sqrt(2*abs(log(mean.mydata/median.mydata))),(min.mydata-1/length(y)))
if (location==FALSE){
den=function(par,x){meanlog=par[4]; sdlog=par[5]; dlnorm(x,meanlog,sdlog)}
cum=function(par,x){meanlog=par[4]; sdlog=par[5]; plnorm(x,meanlog,sdlog)}
starts<-c(1,1,0.5,log(median.mydata),sqrt(2*abs(log(mean.mydata/median.mydata))))
}}
if(g=="chisq"){
den=function(par,x){df=par[4]; loc=par[5]; dchisq(x-loc,df)}
cum=function(par,x){df=par[4]; loc=par[5]; pchisq(x-loc,df)}
starts<-c(1,1,0.5,mean.mydata,(min.mydata-1/length(y)))
if (location==FALSE){
den=function(par,x){df=par[4]; dchisq(x,df)}
cum=function(par,x){df=par[4]; pchisq(x,df)}
starts<-c(1,1,0.5,mean.mydata)
}}
if(g=="f"){
den=function(par,x){df1=par[4]; df2=par[5]; loc=par[6]; df(x-loc,df1,df2)}
cum=function(par,x){df1=par[4]; df2=par[5]; loc=par[6]; pf(x-loc,df1,df2)}
df.1<-ifelse(inv.mean>1,2*inv.mean/(inv.mean-1),1)
df.2<-ifelse(mean.mydata>1,2*mean.mydata/(mean.mydata-1),1)
starts<-c(1,1,0.5,df.1,df.2,(min.mydata-1/length(y)))
if (location==FALSE){
den=function(par,x){df1=par[4]; df2=par[5]; df(x,df1,df2)}
cum=function(par,x){df1=par[4]; df2=par[5]; pf(x,df1,df2)}
starts<-c(1,1,0.5,df.1,df.2)
}}
if(g=="chen"){
den=function(par,x){a=par[4]; b=par[5]; loc=par[6]; a*b*(x-loc)^(a-1)*exp((x-loc)^a)*exp(-b*(exp((x-loc)^a)-1))}
cum=function(par,x){a=par[4]; b=par[5]; loc=par[6]; 1-exp(-b*(exp((x-loc)^a)-1))}
standard.mydata<-(y-mean.mydata)/std.mydata
s.hat<-ifelse(max(standard.mydata)<=1,-log(1-n/(n+.4))/(exp(1)-1),-
log(1-length(standard.mydata[standard.mydata<=1])/length(standard.mydata))/(exp(1)-1))
r.hat<-abs(log(log(1-log(1-0.5)/s.hat))/log(median.mydata))
starts<-c(1,1,0.5,r.hat,s.hat,(min.mydata-1/length(y)))
if (location==FALSE){
den=function(par,x){a=par[4]; b=par[5]; a*b*(x)^(a-1)*exp((x)^a)*exp(-b*(exp((x)^a)-1))}
cum=function(par,x){a=par[4]; b=par[5]; 1-exp(-b*(exp((x)^a)-1))}
starts<-c(1,1,0.5,r.hat,s.hat)
}}
if(g=="lfr"){
den=function(par,x){a=par[4]; b=par[5]; loc=par[6]; (a+b*(x-loc))*exp(-a*(x-loc)-(b*(x-loc)^2)/2)}
cum=function(par,x){a=par[4]; b=par[5]; loc=par[6]; 1-exp(-a*(x-loc)-(b*(x-loc)^2)/2)}
ii<-seq(1,(n-1))
yy<--log(1-(ii+0.3)/(n-1+0.4))
res<-summary(lm(yy ~ -1+y+I(y^2)))$coefficient
coeff<-c(abs(res[1,1]),abs(res[2,1]))
z1=NULL;
lfr.log<-function(p) {
z1<--log(sum(p[1]+p[2]*y))+p[1]*sum(y)+p[2]/2*sum(y^2)
z1[z1<1e-16]<-1e-16
}
p.hat<-suppressWarnings(optim(c(abs(coeff[1]),2*abs(coeff[2])),lfr.log)$par)
starts<-c(1,1,0.5,p.hat[1],p.hat[2],(min.mydata-1/length(y)))
if (location==FALSE){
den=function(par,x){a=par[4]; b=par[5]; (a+b*(x))*exp(-a*(x)-(b*(x)^2)/2)}
cum=function(par,x){a=par[4]; b=par[5]; 1-exp(-a*(x)-(b*(x)^2)/2)}
starts<-c(1,1,0.5,p.hat[1],p.hat[2])
}}
if(g=="log-logistic"){
den=function(par,x){a=par[4]; b=par[5]; loc=par[6]; (a*b^(-a)*(x-loc)^(a-1))/((((x-loc)/b)^a +1)^2)}
cum=function(par,x){a=par[4]; b=par[5]; loc=par[6]; 1/(((x-loc)/b)^(-a)+1)}
starts<-c(1,1,0.5,log(0.75/(1-0.75))/log(qp3/median.mydata),median.mydata,(min.mydata-1/length(y)))
if (location==FALSE){
den=function(par,x){a=par[4]; b=par[5]; (a*b^(-a)*(x)^(a-1))/((((x)/b)^a +1)^2)}
cum=function(par,x){a=par[4]; b=par[5]; 1/(((x)/b)^(-a)+1)}
starts<-c(1,1,0.5,log(0.75/(1-0.75))/log(qp3/median.mydata),median.mydata)
}}
if(g=="lomax"){
den=function(par,x){a=par[4]; b=par[5]; loc=par[6]; (a*b)/((1+a*(x-loc))^(b+1))}
cum=function(par,x){a=par[4]; b=par[5]; loc=par[6]; 1-(1+a*(x-loc))^(-b)}
a.hat<-1
b.hat<-(.5^(-1/a.hat)-1)/median.mydata
z1=NULL;
lomax.log<-function(p) {
z1<--n*log(p[1])-n*log(p[2])+(p[2]+1)*sum(log(1+p[1]*y))
z1[z1<1e-16]<-1e-16
}
p.hat<-suppressWarnings(optim(c(1,b.hat),lomax.log, method)$par)
starts<-c(1,1,0.5,p.hat[1],p.hat[2],(min.mydata-1/length(y)))
if (location==FALSE){
den=function(par,x){a=par[4]; b=par[5]; (a*b)/((1+a*(x))^(b+1))}
cum=function(par,x){a=par[4]; b=par[5]; 1-(1+a*(x))^(-b)}
starts<-c(1,1,0.5,p.hat[1],p.hat[2])
}}
if(g=="gompertz"){
den=function(par,x){a=par[4]; b=par[5]; loc=par[6]; b*exp(a*(x-loc))*exp(-(exp(a*(x-loc))-1)*b/a)}
cum=function(par,x){a=par[4]; b=par[5]; loc=par[6]; 1-exp(-(exp(a*(x-loc))-1)*b/a)}
a.hat<-log(log(1-.75)/log(1-.5))/(qp3-median.mydata)
b.hat<--a.hat*log(0.5)/(exp(a.hat*median.mydata)-1)
z1=NULL;
gompertz.log<-function(p){
z1<--n*log(p[2])-p[1]*sum(y)+p[2]/p[1]*sum(exp(p[1]*y)-1)
z1[z1<1e-16]<-1e-16
}
p.hat<-suppressWarnings(optim(c(a.hat,b.hat),gompertz.log, method)$par)
starts<-c(1,1,0.5,p.hat[1],p.hat[2],(min.mydata-1/length(y)))
if (location==FALSE){
den=function(par,x){a=par[4]; b=par[5]; b*exp(a*(x))*exp(-(exp(a*(x))-1)*b/a)}
cum=function(par,x){a=par[4]; b=par[5]; 1-exp(-(exp(a*(x))-1)*b/a)}
starts<-c(1,1,0.5,p.hat[1],p.hat[2])
}}
if(g=="exp"){
den=function(par,x){rate=par[4]; loc=par[5]; dexp(x-loc,rate)}
cum=function(par,x){rate=par[4]; loc=par[5]; pexp(x-loc,rate)}
starts<-c(1,1,0.5,1/mean.mydata,(min.mydata-1/length(y)))
if (location==FALSE){
den=function(par,x){rate=par[4]; dexp(x,rate)}
cum=function(par,x){rate=par[4]; pexp(x,rate)}
starts<-c(1,1,0.5,1/mean.mydata)
}}
if(g=="rayleigh"){
den=function(par,x){a=par[4]; loc=par[5]; 2*(x-loc)/a*exp(-((x-loc)/a)^2)}
cum=function(par,x){a=par[4]; loc=par[5]; 1-exp(-((x-loc)/a)^2)}
starts<-c(1,1,0.5,log(2)/(median.mydata)^2,(min.mydata-1/length(y)))
if (location==FALSE){
den=function(par,x){a=par[4]; 2*x/a*exp(-(x/a)^2)}
cum=function(par,x){a=par[4]; 1-exp(-(x/a)^2)}
starts<-c(1,1,0.5,log(2)/(median.mydata)^2)
}}
if(g=="burrxii"){
den=function(par,x){a=par[4]; d=par[5]; loc=par[6]; d*a*(1+(x-loc)^d)^(-a-1)*((x-loc)^(d-1))}
cum=function(par,x){a=par[4]; d=par[5]; loc=par[6]; 1-(1+(x-loc)^d)^(-a)}
z1=NULL;
burrxii.log<-function(p){
z1<--n*log(p[1])-n*log(p[2])-(p[2]-1)*sum(log(y))+(p[1]+1)*sum(log(1+y^p[2]))
}
p.hat<-suppressWarnings(optim(c(1,1),burrxii.log, method="BFGS")$par)
starts<-c(1,1,0.5,p.hat[1],p.hat[2],(min.mydata-1/length(y)))
if (location==FALSE){
den=function(par,x){a=par[4]; d=par[5]; d*a*(1+(x)^d)^(-a-1)*((x)^(d-1))}
cum=function(par,x){a=par[4]; d=par[5]; 1-(1+(x)^d)^(-a)}
starts<-c(1,1,0.5,p.hat[1],p.hat[2])
}}
if(g=="frechet"){
den=function(par,x){a=par[4]; b=par[5]; loc=par[6]; (a*exp(-((x-loc)/b)^(-a))*((x-loc)/b)^(-a-1))/(b)}
cum=function(par,x){a=par[4]; b=par[5]; loc=par[6]; exp(-((x-loc)/b)^(-a))}
cons<-cor(inv.mydata,rank(inv.mydata))*(sd(inv.mydata)/mean(inv.mydata))*sqrt((n+1)/(n-1))/sqrt(3)
a.hat<-abs(ifelse(cons<1,-log(2)/log(1-cons),-log(2)/log(1-.98)))
b.hat<-median(inv.mydata)/(log(2))^(1/a.hat)
starts<-c(1,1,0.5,a.hat,1/b.hat,(min.mydata-1/length(y)))
if (location==FALSE){
den=function(par,x){a=par[4]; b=par[5]; (a*exp(-((x)/b)^(-a))*((x)/b)^(-a-1))/(b)}
cum=function(par,x){a=par[4]; b=par[5]; exp(-((x)/b)^(-a))}
starts<-c(1,1,0.5,a.hat,1/b.hat)
}}
if(g=="birnbaum-saunders"){
den=function(par,x){a=par[4]; b=par[5]; loc=par[6]; (sqrt((x-loc)/b)+sqrt(b/(x-loc)))/(2*a*(x-loc))*dnorm((sqrt((x-loc)/b)-sqrt(b/(x-loc)))/a)}
cum=function(par,x){a=par[4]; b=par[5]; loc=par[6]; pnorm((sqrt((x-loc)/b)-sqrt(b/(x-loc)))/a)}
r<-(mean(inv.mydata))^(-1)
b.hat<-sqrt(mean.mydata*r)
a.hat<-sqrt(2*(sqrt(mean.mydata/r)))
starts<-c(1,1,0.5,a.hat,b.hat,(min.mydata-1/length(y)))
if (location==FALSE){
den=function(par,x){a=par[4]; b=par[5]; (sqrt((x)/b)+sqrt(b/(x)))/(2*a*(x))*dnorm((sqrt((x)/b)-sqrt(b/(x)))/a)}
cum=function(par,x){a=par[4]; b=par[5]; pnorm((sqrt((x)/b)-sqrt(b/(x)))/a)}
starts<-c(1,1,0.5,a.hat,b.hat)
}}
if(g=="weibull"){
den=function(par,x){shape=par[4]; scale=par[5]; loc=par[6]; dweibull(x-loc,shape,scale)}
cum=function(par,x){shape=par[4]; scale=par[5]; loc=par[6]; pweibull(x-loc,shape,scale)}
cons<-cor(mydata,rank(mydata))*(std.mydata/mean.mydata)*sqrt((n+1)/(n-1))/sqrt(3)
a.hat<-abs(ifelse(cons<1,-log(2)/log(1-cons),-log(2)/log(1-.98)))
b.hat<-median.mydata/(log(2))^(1/a.hat)
starts<-c(1,1,0.5,a.hat,b.hat,(min.mydata-1/length(y)))
if (location==FALSE){
den=function(par,x){shape=par[4]; scale=par[5]; dweibull(x,shape,scale)}
cum=function(par,x){shape=par[4]; scale=par[5]; pweibull(x,shape,scale)}
starts<-c(1,1,0.5,a.hat,b.hat)
}}
if(g=="gamma"){
den=function(par,x){shape=par[4]; scale=par[5]; loc=par[6]; dgamma(x-loc,shape,scale)}
cum=function(par,x){shape=par[4]; scale=par[5]; loc=par[6]; pgamma(x-loc,shape,scale)}
a.hat<-uniroot(function(ss) trigamma(ss)-var(log(y)[is.finite(log(y))]),c(0,1000000))$root
b.hat<-mean.mydata/a.hat
starts<-c(1,1,0.5,a.hat,b.hat,(min.mydata-1/length(y)))
if (location==FALSE){
den=function(par,x){shape=par[4]; scale=par[5]; dgamma(x,shape,scale)}
cum=function(par,x){shape=par[4]; scale=par[5]; pgamma(x,shape,scale)}
starts<-c(1,1,0.5,a.hat,b.hat)
}}
pdf0<-function(par,x){
f0=den(par,x)
c0=cum(par,x)
a=par[1]
b=par[2]
d=par[3]
d^a*f0*beta(a,b)^(-1)*c0^(a-1)*(1-c0)^(b-1)*(1-(1-d)*c0)^(-a-b)
}
cdf0<-function(par,x){
f0=den(par,x)
c0=cum(par,x)
a=par[1]
b=par[2]
d=par[3]
pbeta(d*c0/(1-(1-d)*c0),shape1=a,shape2=b)
}
mpsw<-function(par,x){
z=NULL
z=diff(c(0,cdf0(par,x),1))
for (j in 2:n){if((x[j]-x[j-1])==0){z[j]=pdf0(par,x[j])
}}
z[z<1e-16]=1e-16
-sum(log(z))
}
out<-suppressWarnings(optim(starts,fn=mpsw,x=sort.mydata,method))
n.p<-length(out$par)
if (location==TRUE){
out$par[1:(n.p-1)]<-abs(out$par[1:(n.p-1)])}
else{
out$par[1:n.p]<-abs(out$par[1:n.p])
}
gammam<-(n+1)*(log(n+1)-digamma(1))-1/2-1/(12*(n+1))
sigma2m<-(n+1)*(pi^2/6-1)-1/2-1/(6*(n+1))
c1<-gammam-sqrt(n*sigma2m/2)
c2<-sqrt(sigma2m/(2*n))
stat.chisquare<-(mpsw(out$par,sort.mydata)+n.p/2-c1)/c2
pvalue.chisquare<-pchisq(stat.chisquare,df=n,lower.tail=FALSE)
Moran<-out$value
log.likelihood=sum(log(pdf0(out$par,sort.mydata)))
u=cdf0(out$par,sort.mydata)
von<-c()
anderson<-c()
for(i in 1:n){
u[i]<-ifelse(u[i]==1,0.999999999,u[i])
von[i]=(u[i]-(2*i-1)/(2*n))^2
anderson[i]=(2*i-1)*log(u[i])+(2*n+1-2*i)*log(1-u[i])
}
anderson.stat=-n-mean(anderson)
von.stat=sum(von)+1/(12*n)
CAIC=-2*log.likelihood + 2*n.p + 2*(n.p*(n.p+1))/(n-n.p-1)
AIC=-2*log.likelihood + 2*n.p
BIC=-2*log.likelihood + n.p*log(n)
HQIC=-2*log.likelihood + 2*log(log(n))*n.p
ks.stat=suppressWarnings(ks.test(mydata, "cdf0", par=out$par))
aux2=cbind(AIC, CAIC, BIC, HQIC, von.stat, anderson.stat,log.likelihood,Moran)
colnames(aux2)=c("AIC","CAIC","BIC","HQIC","CM","AD", "log",
"Moran")
rownames(aux2)=c("")
aux3=cbind(ks.stat$statistic,ks.stat$p.value)
colnames(aux3)=c("statistic","p-value")
rownames(aux3)=c("")
aux4=cbind(stat.chisquare,qchisq(sig.level,df=n,lower.tail=FALSE),1-pchisq(stat.chisquare,df=n))
colnames(aux4)=c("statistic","chi-value","p-value")
rownames(aux4)=c("")
aux5=cbind(if(out$convergence==0){"Algorithm Converged"} else {"Algorithm Not Converged"})
list("MPS"=out$par,"Measures"=aux2,"KS"=aux3,"chi-square"=aux4,"Convergence Status"=aux5)
}
mpsmog<-function(mydata, g, location=TRUE, method , sig.level){
min.mydata<-min(mydata)
sort.mydata<-sort(mydata)
n<-length(mydata)
y<-(sort.mydata[2:n]-min.mydata)
y<-(sort.mydata[2:n]-min.mydata)[is.finite(log(sort.mydata[2:n]-min.mydata))]
n<-length(mydata)
qp1<-y[floor(.25*n)]
qp3<-y[floor(.75*n)]
median.mydata<-y[floor(.5*n)]
mean.mydata<-mean(y)
inv.mydata<-1/y[is.finite(1/y)]
inv.mean<-mean(inv.mydata)
std.mydata<-sd(y)
if(g!="birnbaum-saunders" & g!="exp" & g!="rayleigh" & g!="weibull" & g!="gompertz" & g!="gamma"
& g!="log-normal" & g!="chisq" & g!="f" & g!="burrxii" & g!="frechet"
& g!="lomax" & g!="log-logistic" & g!="lfr" & g!="chen")
{ stop ("Baseline distribution not implemented or misspelled. Please check the manual for guidelines.") }
if(g=="log-normal"){
den=function(par,x){meanlog=par[2]; sdlog=par[3]; loc=par[4]; dlnorm(x-loc,meanlog,sdlog)}
cum=function(par,x){meanlog=par[2]; sdlog=par[3]; loc=par[4]; plnorm(x-loc,meanlog,sdlog)}
starts<-c(0.5,log(median.mydata),sqrt(2*abs(log(mean.mydata/median.mydata))),(min.mydata-1/length(y)))
if (location==FALSE){
den=function(par,x){meanlog=par[2]; sdlog=par[3]; dlnorm(x,meanlog,sdlog)}
cum=function(par,x){meanlog=par[2]; sdlog=par[3]; plnorm(x,meanlog,sdlog)}
starts<-c(1,log(median.mydata),sqrt(2*abs(log(mean.mydata/median.mydata))))
}}
if(g=="chisq"){
den=function(par,x){df=par[2]; loc=par[3]; dchisq(x-loc,df)}
cum=function(par,x){df=par[2]; loc=par[3]; pchisq(x-loc,df)}
starts<-c(1,mean.mydata,(min.mydata-1/length(y)))
if (location==FALSE){
den=function(par,x){df=par[2]; dchisq(x,df)}
cum=function(par,x){df=par[2]; pchisq(x,df)}
starts<-c(1,mean.mydata)
}}
if(g=="f"){
den=function(par,x){df1=par[2]; df2=par[3]; loc=par[4]; df(x-loc,df1,df2)}
cum=function(par,x){df1=par[2]; df2=par[3]; loc=par[4]; pf(x-loc,df1,df2)}
df.1<-ifelse(inv.mean>1,2*inv.mean/(inv.mean-1),1)
df.2<-ifelse(mean.mydata>1,2*mean.mydata/(mean.mydata-1),1)
starts<-c(1,df.1,df.2,(min.mydata-1/length(y)))
if (location==FALSE){
den=function(par,x){df1=par[2]; df2=par[3]; df(x,df1,df2)}
cum=function(par,x){df1=par[2]; df2=par[3]; pf(x,df1,df2)}
starts<-c(1,df.1,df.2)
}}
if(g=="chen"){
den=function(par,x){a=par[2]; b=par[3]; loc=par[4]; a*b*(x-loc)^(a-1)*exp((x-loc)^a)*exp(-b*(exp((x-loc)^a)-1))}
cum=function(par,x){a=par[2]; b=par[3]; loc=par[4]; 1-exp(-b*(exp((x-loc)^a)-1))}
standard.mydata<-(y-mean.mydata)/std.mydata
s.hat<-ifelse(max(standard.mydata)<=1,-log(1-n/(n+.4))/(exp(1)-1),-
log(1-length(standard.mydata[standard.mydata<=1])/length(standard.mydata))/(exp(1)-1))
r.hat<-abs(log(log(1-log(1-0.5)/s.hat))/log(median.mydata))
starts<-c(1,r.hat,s.hat,(min.mydata-1/length(y)))
if (location==FALSE){
den=function(par,x){a=par[2]; b=par[3]; a*b*(x)^(a-1)*exp((x)^a)*exp(-b*(exp((x)^a)-1))}
cum=function(par,x){a=par[2]; b=par[3]; 1-exp(-b*(exp((x)^a)-1))}
starts<-c(1,r.hat,s.hat)
}}
if(g=="lfr"){
den=function(par,x){a=par[2]; b=par[3]; loc=par[4]; (a+b*(x-loc))*exp(-a*(x-loc)-(b*(x-loc)^2)/2)}
cum=function(par,x){a=par[2]; b=par[3]; loc=par[4]; 1-exp(-a*(x-loc)-(b*(x-loc)^2)/2)}
ii<-seq(1,(n-1))
yy<--log(1-(ii+0.3)/(n-1+0.4))
res<-summary(lm(yy ~ -1+y+I(y^2)))$coefficient
coeff<-c(abs(res[1,1]),abs(res[2,1]))
z1=NULL;
lfr.log<-function(p) {
z1<--log(sum(p[1]+p[2]*y))+p[1]*sum(y)+p[2]/2*sum(y^2)
z1[z1<1e-16]<-1e-16
}
p.hat<-suppressWarnings(optim(c(abs(coeff[1]),2*abs(coeff[2])),lfr.log)$par)
starts<-c(1,p.hat[1],p.hat[2],(min.mydata-1/length(y)))
if (location==FALSE){
den=function(par,x){a=par[2]; b=par[3]; (a+b*(x))*exp(-a*(x)-(b*(x)^2)/2)}
cum=function(par,x){a=par[2]; b=par[3]; 1-exp(-a*(x)-(b*(x)^2)/2)}
starts<-c(1,p.hat[1],p.hat[2])
}}
if(g=="log-logistic"){
den=function(par,x){a=par[2]; b=par[3]; loc=par[4]; (a*b^(-a)*(x-loc)^(a-1))/((((x-loc)/b)^a +1)^2)}
cum=function(par,x){a=par[2]; b=par[3]; loc=par[4]; 1/(((x-loc)/b)^(-a)+1)}
starts<-c(1,log(0.75/(1-0.75))/log(qp3/median.mydata),median.mydata,(min.mydata-1/length(y)))
if (location==FALSE){
den=function(par,x){a=par[2]; b=par[3]; (a*b^(-a)*(x)^(a-1))/((((x)/b)^a +1)^2)}
cum=function(par,x){a=par[2]; b=par[3]; 1/(((x)/b)^(-a)+1)}
starts<-c(1,log(0.75/(1-0.75))/log(qp3/median.mydata),median.mydata)
}}
if(g=="lomax"){
den=function(par,x){a=par[2]; b=par[3]; loc=par[4]; (a*b)/((1+a*(x-loc))^(b+1))}
cum=function(par,x){a=par[2]; b=par[3]; loc=par[4]; 1-(1+a*(x-loc))^(-b)}
a.hat<-1
b.hat<-(.5^(-1/a.hat)-1)/median.mydata
z1=NULL;
lomax.log<-function(p) {
z1<--n*log(p[1])-n*log(p[2])+(p[2]+1)*sum(log(1+p[1]*y))
z1[z1<1e-16]<-1e-16
}
p.hat<-suppressWarnings(optim(c(1,b.hat),lomax.log, method)$par)
starts<-c(1,p.hat[1],p.hat[2],(min.mydata-1/length(y)))
if (location==FALSE){
den=function(par,x){a=par[2]; b=par[3]; (a*b)/((1+a*(x))^(b+1))}
cum=function(par,x){a=par[2]; b=par[3]; 1-(1+a*(x))^(-b)}
starts<-c(1,p.hat[1],p.hat[2])
}}
if(g=="gompertz"){
den=function(par,x){a=par[2]; b=par[3]; loc=par[4]; b*exp(a*(x-loc))*exp(-(exp(a*(x-loc))-1)*b/a)}
cum=function(par,x){a=par[2]; b=par[3]; loc=par[4]; 1-exp(-(exp(a*(x-loc))-1)*b/a)}
a.hat<-log(log(1-.75)/log(1-.5))/(qp3-median.mydata)
b.hat<--a.hat*log(0.5)/(exp(a.hat*median.mydata)-1)
z1=NULL;
gompertz.log<-function(p){
z1<--n*log(p[2])-p[1]*sum(y)+p[2]/p[1]*sum(exp(p[1]*y)-1)
z1[z1<1e-16]<-1e-16
}
p.hat<-suppressWarnings(optim(c(a.hat,b.hat),gompertz.log, method)$par)
starts<-c(1,p.hat[1],p.hat[2],(min.mydata-1/length(y)))
if (location==FALSE){
den=function(par,x){a=par[2]; b=par[3]; b*exp(a*(x))*exp(-(exp(a*(x))-1)*b/a)}
cum=function(par,x){a=par[2]; b=par[3]; 1-exp(-(exp(a*(x))-1)*b/a)}
starts<-c(1,p.hat[1],p.hat[2])
}}
if(g=="exp"){
den=function(par,x){rate=par[2]; loc=par[3]; dexp(x-loc,rate)}
cum=function(par,x){rate=par[2]; loc=par[3]; pexp(x-loc,rate)}
starts<-c(1,1/mean.mydata,(min.mydata-1/length(y)))
if (location==FALSE){
den=function(par,x){rate=par[2]; dexp(x,rate)}
cum=function(par,x){rate=par[2]; pexp(x,rate)}
starts<-c(1,1/mean.mydata)
}}
if(g=="rayleigh"){
den=function(par,x){a=par[2]; loc=par[3]; 2*(x-loc)/a*exp(-((x-loc)/a)^2)}
cum=function(par,x){a=par[2]; loc=par[3]; 1-exp(-((x-loc)/a)^2)}
starts<-c(1,log(2)/(median.mydata)^2,(min.mydata-1/length(y)))
if (location==FALSE){
den=function(par,x){a=par[2]; 2*x/a*exp(-(x/a)^2)}
cum=function(par,x){a=par[2]; 1-exp(-(x/a)^2)}
starts<-c(1,log(2)/(median.mydata)^2)
}}
if(g=="burrxii"){
den=function(par,x){a=par[2]; d=par[3]; loc=par[4]; d*a*(1+(x-loc)^d)^(-a-1)*((x-loc)^(d-1))}
cum=function(par,x){a=par[2]; d=par[3]; loc=par[4]; 1-(1+(x-loc)^d)^(-a)}
z1=NULL;
burrxii.log<-function(p){
z1<--n*log(p[1])-n*log(p[2])-(p[2]-1)*sum(log(y))+(p[1]+1)*sum(log(1+y^p[2]))
}
p.hat<-suppressWarnings(optim(c(1,1),burrxii.log, method="BFGS")$par)
starts<-c(1,p.hat[1],p.hat[2],(min.mydata-1/length(y)))
if (location==FALSE){
den=function(par,x){a=par[2]; d=par[3]; d*a*(1+(x)^d)^(-a-1)*((x)^(d-1))}
cum=function(par,x){a=par[2]; d=par[3]; 1-(1+(x)^d)^(-a)}
starts<-c(1,p.hat[1],p.hat[2])
}}
if(g=="frechet"){
den=function(par,x){a=par[2]; b=par[3]; loc=par[4]; (a*exp(-((x-loc)/b)^(-a))*((x-loc)/b)^(-a-1))/(b)}
cum=function(par,x){a=par[2]; b=par[3]; loc=par[4]; exp(-((x-loc)/b)^(-a))}
cons<-cor(inv.mydata,rank(inv.mydata))*(sd(inv.mydata)/mean(inv.mydata))*sqrt((n+1)/(n-1))/sqrt(3)
a.hat<-abs(ifelse(cons<1,-log(2)/log(1-cons),-log(2)/log(1-.98)))
b.hat<-median(inv.mydata)/(log(2))^(1/a.hat)
starts<-c(1,a.hat,1/b.hat,(min.mydata-1/length(y)))
if (location==FALSE){
den=function(par,x){a=par[2]; b=par[3]; (a*exp(-((x)/b)^(-a))*((x)/b)^(-a-1))/(b)}
cum=function(par,x){a=par[2]; b=par[3]; exp(-((x)/b)^(-a))}
starts<-c(1,a.hat,1/b.hat)
}}
if(g=="birnbaum-saunders"){
den=function(par,x){a=par[2]; b=par[3]; loc=par[4]; (sqrt((x-loc)/b)+sqrt(b/(x-loc)))/(2*a*(x-loc))*dnorm((sqrt((x-loc)/b)-sqrt(b/(x-loc)))/a)}
cum=function(par,x){a=par[2]; b=par[3]; loc=par[4]; pnorm((sqrt((x-loc)/b)-sqrt(b/(x-loc)))/a)}
r<-(mean(inv.mydata))^(-1)
b.hat<-sqrt(mean.mydata*r)
a.hat<-sqrt(2*(sqrt(mean.mydata/r)))
starts<-c(1,a.hat,b.hat,(min.mydata-1/length(y)))
if (location==FALSE){
den=function(par,x){a=par[2]; b=par[3]; (sqrt((x)/b)+sqrt(b/(x)))/(2*a*(x))*dnorm((sqrt((x)/b)-sqrt(b/(x)))/a)}
cum=function(par,x){a=par[2]; b=par[3]; pnorm((sqrt((x)/b)-sqrt(b/(x)))/a)}
starts<-c(1,a.hat,b.hat)
}}
if(g=="weibull"){
den=function(par,x){shape=par[2]; scale=par[3]; loc=par[4]; dweibull(x-loc,shape,scale)}
cum=function(par,x){shape=par[2]; scale=par[3]; loc=par[4]; pweibull(x-loc,shape,scale)}
cons<-cor(mydata,rank(mydata))*(std.mydata/mean.mydata)*sqrt((n+1)/(n-1))/sqrt(3)
a.hat<-abs(ifelse(cons<1,-log(2)/log(1-cons),-log(2)/log(1-.98)))
b.hat<-median.mydata/(log(2))^(1/a.hat)
starts<-c(1,a.hat,b.hat,(min.mydata-1/length(y)))
if (location==FALSE){
den=function(par,x){shape=par[2]; scale=par[3]; dweibull(x,shape,scale)}
cum=function(par,x){shape=par[2]; scale=par[3]; pweibull(x,shape,scale)}
starts<-c(1,a.hat,b.hat)
}}
if(g=="gamma"){
den=function(par,x){shape=par[2]; scale=par[3]; loc=par[4]; dgamma(x-loc,shape,scale)}
cum=function(par,x){shape=par[2]; scale=par[3]; loc=par[4]; pgamma(x-loc,shape,scale)}
a.hat<-uniroot(function(ss) trigamma(ss)-var(log(y)[is.finite(log(y))]),c(0,1000000))$root
b.hat<-mean.mydata/a.hat
starts<-c(1,a.hat,b.hat,(min.mydata-1/length(y)))
if (location==FALSE){
den=function(par,x){shape=par[2]; scale=par[3]; dgamma(x,shape,scale)}
cum=function(par,x){shape=par[2]; scale=par[3]; pgamma(x,shape,scale)}
starts<-c(0.5,a.hat,b.hat)
}}
pdf0<-function(par,x){
f0=den(par,x)
c0=cum(par,x)
r=par[1]
r*f0/((1-(1-r)*(1-c0))^2)
}
cdf0<-function(par,x){
f0=den(par,x)
c0=cum(par,x)
r=par[1]
1-r*(1-c0)/(1-(1-r)*(1-c0))
}
mpsw<-function(par,x){
z=NULL
z=diff(c(0,cdf0(par,x),1))
for (j in 2:n){if((x[j]-x[j-1])==0){z[j]=pdf0(par,x[j])
}}
z[z<1e-16]=1e-16
-sum(log(z))
}
out<-suppressWarnings(optim(starts,fn=mpsw,x=sort.mydata,method))
n.p<-length(out$par)
gammam<-(n+1)*(log(n+1)-digamma(1))-1/2-1/(12*(n+1))
sigma2m<-(n+1)*(pi^2/6-1)-1/2-1/(6*(n+1))
c1<-gammam-sqrt(n*sigma2m/2)
c2<-sqrt(sigma2m/(2*n))
stat.chisquare<-(mpsw(out$par,sort.mydata)+n.p/2-c1)/c2
pvalue.chisquare<-pchisq(stat.chisquare,df=n,lower.tail=FALSE)
Moran<-out$value
log.likelihood=sum(log(pdf0(out$par,sort.mydata)))
u=cdf0(out$par,sort.mydata)
von<-c()
anderson<-c()
for(i in 1:n){
u[i]<-ifelse(u[i]==1,0.999999999,u[i])
von[i]=(u[i]-(2*i-1)/(2*n))^2
anderson[i]=(2*i-1)*log(u[i])+(2*n+1-2*i)*log(1-u[i])
}
anderson.stat=-n-mean(anderson)
von.stat=sum(von)+1/(12*n)
CAIC=-2*log.likelihood + 2*n.p + 2*(n.p*(n.p+1))/(n-n.p-1)
AIC=-2*log.likelihood + 2*n.p
BIC=-2*log.likelihood + n.p*log(n)
HQIC=-2*log.likelihood + 2*log(log(n))*n.p
ks.stat=suppressWarnings(ks.test(mydata, "cdf0", par=out$par))
aux2=cbind(AIC, CAIC, BIC, HQIC, von.stat, anderson.stat,log.likelihood,Moran)
colnames(aux2)=c("AIC","CAIC","BIC","HQIC","CM","AD", "log",
"Moran")
rownames(aux2)=c("")
aux3=cbind(ks.stat$statistic,ks.stat$p.value)
colnames(aux3)=c("statistic","p-value")
rownames(aux3)=c("")
aux4=cbind(stat.chisquare,qchisq(sig.level,df=n,lower.tail=FALSE),1-pchisq(stat.chisquare,df=n))
colnames(aux4)=c("statistic","chi-value","p-value")
rownames(aux4)=c("")
aux5=cbind(if(out$convergence==0){"Algorithm Converged"} else {"Algorithm Not Converged"})
list("MPS"=out$par,"Measures"=aux2,"KS"=aux3,"chi-square"=aux4,"Convergence Status"=aux5)
}
mpsmokumg<-function(mydata, g, location=TRUE, method , sig.level){
min.mydata<-min(mydata)
sort.mydata<-sort(mydata)
n<-length(mydata)
y<-(sort.mydata[2:n]-min.mydata)
y<-(sort.mydata[2:n]-min.mydata)[is.finite(log(sort.mydata[2:n]-min.mydata))]
n<-length(mydata)
qp1<-y[floor(.25*n)]
qp3<-y[floor(.75*n)]
median.mydata<-y[floor(.5*n)]
mean.mydata<-mean(y)
inv.mydata<-1/y[is.finite(1/y)]
inv.mean<-mean(inv.mydata)
std.mydata<-sd(y)
if(g!="birnbaum-saunders" & g!="exp" & g!="rayleigh" & g!="weibull" & g!="gompertz" & g!="gamma"
& g!="log-normal" & g!="chisq" & g!="f" & g!="burrxii" & g!="frechet"
& g!="lomax" & g!="log-logistic" & g!="lfr" & g!="chen")
{ stop ("Baseline distribution not implemented or misspelled. Please check the manual for guidelines.") }
if(g=="log-normal"){
den=function(par,x){meanlog=par[4]; sdlog=par[5]; loc=par[6]; dlnorm(x-loc,meanlog,sdlog)}
cum=function(par,x){meanlog=par[4]; sdlog=par[5]; loc=par[6]; plnorm(x-loc,meanlog,sdlog)}
starts<-c(1,1,0.5,log(median.mydata),sqrt(2*abs(log(mean.mydata/median.mydata))),(min.mydata-1/length(y)))
if (location==FALSE){
den=function(par,x){meanlog=par[4]; sdlog=par[5]; dlnorm(x,meanlog,sdlog)}
cum=function(par,x){meanlog=par[4]; sdlog=par[5]; plnorm(x,meanlog,sdlog)}
starts<-c(1,1,0.5,log(median.mydata),sqrt(2*abs(log(mean.mydata/median.mydata))))
}}
if(g=="chisq"){
den=function(par,x){df=par[4]; loc=par[5]; dchisq(x-loc,df)}
cum=function(par,x){df=par[4]; loc=par[5]; pchisq(x-loc,df)}
starts<-c(1,1,0.5,mean.mydata,(min.mydata-1/length(y)))
if (location==FALSE){
den=function(par,x){df=par[4]; dchisq(x,df)}
cum=function(par,x){df=par[4]; pchisq(x,df)}
starts<-c(1,1,0.5,mean.mydata)
}}
if(g=="f"){
den=function(par,x){df1=par[4]; df2=par[5]; loc=par[6]; df(x-loc,df1,df2)}
cum=function(par,x){df1=par[4]; df2=par[5]; loc=par[6]; pf(x-loc,df1,df2)}
df.1<-ifelse(inv.mean>1,2*inv.mean/(inv.mean-1),1)
df.2<-ifelse(mean.mydata>1,2*mean.mydata/(mean.mydata-1),1)
starts<-c(1,1,0.5,df.1,df.2,(min.mydata-1/length(y)))
if (location==FALSE){
den=function(par,x){df1=par[4]; df2=par[5]; df(x,df1,df2)}
cum=function(par,x){df1=par[4]; df2=par[5]; pf(x,df1,df2)}
starts<-c(1,1,0.5,df.1,df.2)
}}
if(g=="chen"){
den=function(par,x){a=par[4]; b=par[5]; loc=par[6]; a*b*(x-loc)^(a-1)*exp((x-loc)^a)*exp(-b*(exp((x-loc)^a)-1))}
cum=function(par,x){a=par[4]; b=par[5]; loc=par[6]; 1-exp(-b*(exp((x-loc)^a)-1))}
standard.mydata<-(y-mean.mydata)/std.mydata
s.hat<-ifelse(max(standard.mydata)<=1,-log(1-n/(n+.4))/(exp(1)-1),-
log(1-length(standard.mydata[standard.mydata<=1])/length(standard.mydata))/(exp(1)-1))
r.hat<-abs(log(log(1-log(1-0.5)/s.hat))/log(median.mydata))
starts<-c(1,1,0.5,r.hat,s.hat,(min.mydata-1/length(y)))
if (location==FALSE){
den=function(par,x){a=par[4]; b=par[5]; a*b*(x)^(a-1)*exp((x)^a)*exp(-b*(exp((x)^a)-1))}
cum=function(par,x){a=par[4]; b=par[5]; 1-exp(-b*(exp((x)^a)-1))}
starts<-c(1,1,0.5,r.hat,s.hat)
}}
if(g=="lfr"){
den=function(par,x){a=par[4]; b=par[5]; loc=par[6]; (a+b*(x-loc))*exp(-a*(x-loc)-(b*(x-loc)^2)/2)}
cum=function(par,x){a=par[4]; b=par[5]; loc=par[6]; 1-exp(-a*(x-loc)-(b*(x-loc)^2)/2)}
ii<-c(seq(1,(n-1)))
yy<--log(1-(ii)/(n+1))
res<-suppressWarnings(summary(lm(yy ~ -1+y+I(y^2)))$coefficient)
coeff<-c(abs(res[1,1]),abs(res[2,1]))
z1=NULL;
lfr.log<-function(p) {
z1<--log(sum(p[1]+p[2]*y))+p[1]*sum(y)+p[2]/2*sum(y^2)
z1[z1<1e-16]<-1e-16
}
p.hat<-suppressWarnings(optim(c(abs(coeff[1]),2*abs(coeff[2])),lfr.log)$par)
starts<-c(1,1,0.5,p.hat[1],p.hat[2],(min.mydata+1/length(y)))
if (location==FALSE){
den=function(par,x){a=par[4]; b=par[5]; (a+b*(x))*exp(-a*(x)-(b*(x)^2)/2)}
cum=function(par,x){a=par[4]; b=par[5]; 1-exp(-a*(x)-(b*(x)^2)/2)}
starts<-c(1,1,0.5,p.hat[1],p.hat[2])
}}
if(g=="log-logistic"){
den=function(par,x){a=par[4]; b=par[5]; loc=par[6]; (a*b^(-a)*(x-loc)^(a-1))/((((x-loc)/b)^a +1)^2)}
cum=function(par,x){a=par[4]; b=par[5]; loc=par[6]; 1/(((x-loc)/b)^(-a)+1)}
starts<-c(1,1,0.5,log(0.75/(1-0.75))/log(qp3/median.mydata),median.mydata,(min.mydata-1/length(y)))
if (location==FALSE){
den=function(par,x){a=par[4]; b=par[5]; (a*b^(-a)*(x)^(a-1))/((((x)/b)^a +1)^2)}
cum=function(par,x){a=par[4]; b=par[5]; 1/(((x)/b)^(-a)+1)}
starts<-c(1,1,0.5,log(0.75/(1-0.75))/log(qp3/median.mydata),median.mydata)
}}
if(g=="lomax"){
den=function(par,x){a=par[4]; b=par[5]; loc=par[6]; (a*b)/((1+a*(x-loc))^(b+1))}
cum=function(par,x){a=par[4]; b=par[5]; loc=par[6]; 1-(1+a*(x-loc))^(-b)}
a.hat<-1
b.hat<-(.5^(-1/a.hat)-1)/median.mydata
z1=NULL;
lomax.log<-function(p) {
z1<--n*log(p[1])-n*log(p[2])+(p[2]+1)*sum(log(1+p[1]*y))
z1[z1<1e-16]<-1e-16
}
p.hat<-suppressWarnings(optim(c(1,b.hat),lomax.log, method)$par)
starts<-c(1,1,0.5,p.hat[1],p.hat[2],(min.mydata-1/length(y)))
if (location==FALSE){
den=function(par,x){a=par[4]; b=par[5]; (a*b)/((1+a*(x))^(b+1))}
cum=function(par,x){a=par[4]; b=par[5]; 1-(1+a*(x))^(-b)}
starts<-c(1,1,0.5,p.hat[1],p.hat[2])
}}
if(g=="gompertz"){
den=function(par,x){a=par[4]; b=par[5]; loc=par[6]; b*exp(a*(x-loc))*exp(-(exp(a*(x-loc))-1)*b/a)}
cum=function(par,x){a=par[4]; b=par[5]; loc=par[6]; 1-exp(-(exp(a*(x-loc))-1)*b/a)}
a.hat<-log(log(1-.75)/log(1-.5))/(qp3-median.mydata)
b.hat<--a.hat*log(0.5)/(exp(a.hat*median.mydata)-1)
z1=NULL;
gompertz.log<-function(p){
z1<--n*log(p[2])-p[1]*sum(y)+p[2]/p[1]*sum(exp(p[1]*y)-1)
z1[z1<1e-16]<-1e-16
}
p.hat<-suppressWarnings(optim(c(a.hat,b.hat),gompertz.log, method)$par)
starts<-c(1,1,0.5,p.hat[1],p.hat[2],(min.mydata-1/length(y)))
if (location==FALSE){
den=function(par,x){a=par[4]; b=par[5]; b*exp(a*(x))*exp(-(exp(a*(x))-1)*b/a)}
cum=function(par,x){a=par[4]; b=par[5]; 1-exp(-(exp(a*(x))-1)*b/a)}
starts<-c(1,1,0.5,p.hat[1],p.hat[2])
}}
if(g=="exp"){
den=function(par,x){rate=par[4]; loc=par[5]; dexp(x-loc,rate)}
cum=function(par,x){rate=par[4]; loc=par[5]; pexp(x-loc,rate)}
starts<-c(1,1,0.5,1/mean.mydata,(min.mydata+1/length(y)))
if (location==FALSE){
den=function(par,x){rate=par[4]; dexp(x,rate)}
cum=function(par,x){rate=par[4]; pexp(x,rate)}
starts<-c(1,1,0.5,1/mean.mydata)
}}
if(g=="rayleigh"){
den=function(par,x){a=par[4]; loc=par[5]; 2*(x-loc)/a*exp(-((x-loc)/a)^2)}
cum=function(par,x){a=par[4]; loc=par[5]; 1-exp(-((x-loc)/a)^2)}
starts<-c(1,1,0.5,log(2)/(median.mydata)^2,(min.mydata-1/length(y)))
if (location==FALSE){
den=function(par,x){a=par[4]; 2*x/a*exp(-(x/a)^2)}
cum=function(par,x){a=par[4]; 1-exp(-(x/a)^2)}
starts<-c(1,1,0.5,log(2)/(median.mydata)^2)
}}
if(g=="burrxii"){
den=function(par,x){a=par[4]; d=par[5]; loc=par[6]; d*a*(1+(x-loc)^d)^(-a-1)*((x-loc)^(d-1))}
cum=function(par,x){a=par[4]; d=par[5]; loc=par[6]; 1-(1+(x-loc)^d)^(-a)}
z1=NULL;
burrxii.log<-function(p){
z1<--n*log(p[1])-n*log(p[2])-(p[2]-1)*sum(log(y))+(p[1]+1)*sum(log(1+y^p[2]))
}
p.hat<-suppressWarnings(optim(c(1,1),burrxii.log, method="BFGS")$par)
starts<-c(1,1,0.5,p.hat[1],p.hat[2],(min.mydata-1/length(y)))
if (location==FALSE){
den=function(par,x){a=par[4]; d=par[5]; d*a*(1+(x)^d)^(-a-1)*((x)^(d-1))}
cum=function(par,x){a=par[4]; d=par[5]; 1-(1+(x)^d)^(-a)}
starts<-c(1,1,0.5,p.hat[1],p.hat[2])
}}
if(g=="frechet"){
den=function(par,x){a=par[4]; b=par[5]; loc=par[6]; (a*exp(-((x-loc)/b)^(-a))*((x-loc)/b)^(-a-1))/(b)}
cum=function(par,x){a=par[4]; b=par[5]; loc=par[6]; exp(-((x-loc)/b)^(-a))}
cons<-cor(inv.mydata,rank(inv.mydata))*(sd(inv.mydata)/mean(inv.mydata))*sqrt((n+1)/(n-1))/sqrt(3)
a.hat<-abs(ifelse(cons<1,-log(2)/log(1-cons),-log(2)/log(1-.98)))
b.hat<-median(inv.mydata)/(log(2))^(1/a.hat)
starts<-c(1,1,0.5,a.hat,1/b.hat,(min.mydata-1/length(y)))
if (location==FALSE){
den=function(par,x){a=par[4]; b=par[5]; (a*exp(-((x)/b)^(-a))*((x)/b)^(-a-1))/(b)}
cum=function(par,x){a=par[4]; b=par[5]; exp(-((x)/b)^(-a))}
starts<-c(1,1,0.5,a.hat,1/b.hat)
}}
if(g=="birnbaum-saunders"){
den=function(par,x){a=par[4]; b=par[5]; loc=par[6]; (sqrt((x-loc)/b)+sqrt(b/(x-loc)))/(2*a*(x-loc))*dnorm((sqrt((x-loc)/b)-sqrt(b/(x-loc)))/a)}
cum=function(par,x){a=par[4]; b=par[5]; loc=par[6]; pnorm((sqrt((x-loc)/b)-sqrt(b/(x-loc)))/a)}
r<-(mean(inv.mydata))^(-1)
b.hat<-sqrt(mean.mydata*r)
a.hat<-sqrt(2*(sqrt(mean.mydata/r)))
starts<-c(1,1,0.5,a.hat,b.hat,(min.mydata-1/length(y)))
if (location==FALSE){
den=function(par,x){a=par[4]; b=par[5]; (sqrt((x)/b)+sqrt(b/(x)))/(2*a*(x))*dnorm((sqrt((x)/b)-sqrt(b/(x)))/a)}
cum=function(par,x){a=par[4]; b=par[5]; pnorm((sqrt((x)/b)-sqrt(b/(x)))/a)}
starts<-c(1,1,0.5,a.hat,b.hat)
}}
if(g=="weibull"){
den=function(par,x){shape=par[4]; scale=par[5]; loc=par[6]; dweibull(x-loc,shape,scale)}
cum=function(par,x){shape=par[4]; scale=par[5]; loc=par[6]; pweibull(x-loc,shape,scale)}
cons<-cor(mydata,rank(mydata))*(std.mydata/mean.mydata)*sqrt((n+1)/(n-1))/sqrt(3)
a.hat<-abs(ifelse(cons<1,-log(2)/log(1-cons),-log(2)/log(1-.98)))
b.hat<-median.mydata/(log(2))^(1/a.hat)
starts<-c(1,1,0.5,a.hat,b.hat,(min.mydata-1/length(y)))
if (location==FALSE){
den=function(par,x){shape=par[4]; scale=par[5]; dweibull(x,shape,scale)}
cum=function(par,x){shape=par[4]; scale=par[5]; pweibull(x,shape,scale)}
starts<-c(1,1,0.5,a.hat,b.hat)
}}
if(g=="gamma"){
den=function(par,x){shape=par[4]; scale=par[5]; loc=par[6]; dgamma(x-loc,shape,scale)}
cum=function(par,x){shape=par[4]; scale=par[5]; loc=par[6]; pgamma(x-loc,shape,scale)}
a.hat<-uniroot(function(ss) trigamma(ss)-var(log(y)[is.finite(log(y))]),c(0,1000000))$root
b.hat<-mean.mydata/a.hat
starts<-c(1,1,0.5,a.hat,b.hat,(min.mydata-1/length(y)))
if (location==FALSE){
den=function(par,x){shape=par[4]; scale=par[5]; dgamma(x,shape,scale)}
cum=function(par,x){shape=par[4]; scale=par[5]; pgamma(x,shape,scale)}
starts<-c(1,1,0.5,a.hat,b.hat)
}}
pdf0<-function(par,x){
f0=den(par,x)
c0=cum(par,x)
a=par[1]
b=par[2]
d=par[3]
(d*a*b*c0^(a-1)*(1-c0^a)^(b-1))/((1-(1-a)*(1-c0^a)^b)^2)
}
cdf0<-function(par,x){
f0=den(par,x)
c0=cum(par,x)
a=par[1]
b=par[2]
d=par[3]
1-(d*(1-c0^a)^b)/(1-(1-d)*(1-c0^a)^b)
}
mpsw<-function(par,x){
z=NULL
z=diff(c(0,cdf0(par,x),1))
for (j in 2:n){if((x[j]-x[j-1])==0){z[j]=pdf0(par,x[j])
}}
z[z<1e-16]=1e-16
-sum(log(z))
}
out<-suppressWarnings(optim(starts,fn=mpsw,x=sort.mydata,method))
n.p<-length(out$par)
gammam<-(n+1)*(log(n+1)-digamma(1))-1/2-1/(12*(n+1))
sigma2m<-(n+1)*(pi^2/6-1)-1/2-1/(6*(n+1))
c1<-gammam-sqrt(n*sigma2m/2)
c2<-sqrt(sigma2m/(2*n))
stat.chisquare<-(mpsw(out$par,sort.mydata)+n.p/2-c1)/c2
pvalue.chisquare<-pchisq(stat.chisquare,df=n,lower.tail=FALSE)
Moran<-out$value
log.likelihood=sum(log(pdf0(out$par,sort.mydata)))
u=cdf0(out$par,sort.mydata)
von<-c()
anderson<-c()
for(i in 1:n){
u[i]<-ifelse(u[i]==1,0.999999999,u[i])
von[i]=(u[i]-(2*i-1)/(2*n))^2
anderson[i]=suppressWarnings((2*i-1)*log(u[i])+(2*n+1-2*i)*log(1-u[i]))
}
anderson.stat=-n-mean(anderson)
von.stat=sum(von)+1/(12*n)
CAIC=-2*log.likelihood + 2*n.p + 2*(n.p*(n.p+1))/(n-n.p-1)
AIC=-2*log.likelihood + 2*n.p
BIC=-2*log.likelihood + n.p*log(n)
HQIC=-2*log.likelihood + 2*log(log(n))*n.p
ks.stat=suppressWarnings(ks.test(mydata, "cdf0", par=out$par))
aux2=cbind(AIC, CAIC, BIC, HQIC, von.stat, anderson.stat,log.likelihood,Moran)
colnames(aux2)=c("AIC","CAIC","BIC","HQIC","CM","AD", "log",
"Moran")
rownames(aux2)=c("")
aux3=cbind(ks.stat$statistic,ks.stat$p.value)
colnames(aux3)=c("statistic","p-value")
rownames(aux3)=c("")
aux4=cbind(stat.chisquare,qchisq(sig.level,df=n,lower.tail=FALSE),1-pchisq(stat.chisquare,df=n))
colnames(aux4)=c("statistic","chi-value","p-value")
rownames(aux4)=c("")
aux5=cbind(if(out$convergence==0){"Algorithm Converged"} else {"Algorithm Not Converged"})
list("MPS"=out$par,"Measures"=aux2,"KS"=aux3,"chi-square"=aux4,"Convergence Status"=aux5)
}
mpsgexppg<-function(mydata, g, location=TRUE, method , sig.level){
min.mydata<-min(mydata)
sort.mydata<-sort(mydata)
n<-length(mydata)
y<-(sort.mydata[2:n]-min.mydata)
y<-(sort.mydata[2:n]-min.mydata)[is.finite(log(sort.mydata[2:n]-min.mydata))]
n<-length(mydata)
qp1<-y[floor(.25*n)]
qp3<-y[floor(.75*n)]
median.mydata<-y[floor(.5*n)]
mean.mydata<-mean(y)
inv.mydata<-1/y[is.finite(1/y)]
inv.mean<-mean(inv.mydata)
std.mydata<-sd(y)
if(g!="birnbaum-saunders" & g!="exp" & g!="rayleigh" & g!="weibull" & g!="gompertz" & g!="gamma"
& g!="log-normal" & g!="chisq" & g!="f" & g!="burrxii" & g!="frechet"
& g!="lomax" & g!="log-logistic" & g!="lfr" & g!="chen")
{ stop ("Baseline distribution not implemented or misspelled. Please check the manual for guidelines.") }
if(g=="log-normal"){
den=function(par,x){meanlog=par[3]; sdlog=par[4]; loc=par[5]; dlnorm(x-loc,meanlog,sdlog)}
cum=function(par,x){meanlog=par[3]; sdlog=par[4]; loc=par[5]; plnorm(x-loc,meanlog,sdlog)}
starts<-c(1,0.5,log(median.mydata),sqrt(2*abs(log(mean.mydata/median.mydata))),(min.mydata-1/length(y)))
if (location==FALSE){
den=function(par,x){meanlog=par[3]; sdlog=par[4]; dlnorm(x,meanlog,sdlog)}
cum=function(par,x){meanlog=par[3]; sdlog=par[4]; plnorm(x,meanlog,sdlog)}
starts<-c(1,0.5,log(median.mydata),sqrt(2*abs(log(mean.mydata/median.mydata))))
}}
if(g=="chisq"){
den=function(par,x){df=par[3]; loc=par[4]; dchisq(x-loc,df)}
cum=function(par,x){df=par[3]; loc=par[4]; pchisq(x-loc,df)}
starts<-c(1,0.5,mean.mydata,(min.mydata-1/length(y)))
if (location==FALSE){
den=function(par,x){df=par[3]; dchisq(x,df)}
cum=function(par,x){df=par[3]; pchisq(x,df)}
starts<-c(1,0.5,mean.mydata)
}}
if(g=="f"){
den=function(par,x){df1=par[3]; df2=par[4]; loc=par[5]; df(x-loc,df1,df2)}
cum=function(par,x){df1=par[3]; df2=par[4]; loc=par[5]; pf(x-loc,df1,df2)}
df.1<-ifelse(inv.mean>1,2*inv.mean/(inv.mean-1),1)
df.2<-ifelse(mean.mydata>1,2*mean.mydata/(mean.mydata-1),1)
starts<-c(1,0.5,df.1,df.2,(min.mydata-1/length(y)))
if (location==FALSE){
den=function(par,x){df1=par[3]; df2=par[4]; df(x,df1,df2)}
cum=function(par,x){df1=par[3]; df2=par[4]; pf(x,df1,df2)}
starts<-c(1,0.5,df.1,df.2)
}}
if(g=="chen"){
den=function(par,x){a=par[3]; b=par[4]; loc=par[5]; a*b*(x-loc)^(a-1)*exp((x-loc)^a)*exp(-b*(exp((x-loc)^a)-1))}
cum=function(par,x){a=par[3]; b=par[4]; loc=par[5]; 1-exp(-b*(exp((x-loc)^a)-1))}
standard.mydata<-(y-mean.mydata)/std.mydata
s.hat<-ifelse(max(standard.mydata)<=1,-log(1-n/(n+.4))/(exp(1)-1),-
log(1-length(standard.mydata[standard.mydata<=1])/length(standard.mydata))/(exp(1)-1))
r.hat<-abs(log(log(1-log(1-0.5)/s.hat))/log(median.mydata))
starts<-c(1,0.5,r.hat,s.hat,(min.mydata-1/length(y)))
if (location==FALSE){
den=function(par,x){a=par[3]; b=par[4]; a*b*(x)^(a-1)*exp((x)^a)*exp(-b*(exp((x)^a)-1))}
cum=function(par,x){a=par[3]; b=par[4]; 1-exp(-b*(exp((x)^a)-1))}
starts<-c(1,0.5,r.hat,s.hat)
}}
if(g=="lfr"){
den=function(par,x){a=par[3]; b=par[4]; loc=par[5]; (a+b*(x-loc))*exp(-a*(x-loc)-(b*(x-loc)^2)/2)}
cum=function(par,x){a=par[3]; b=par[4]; loc=par[5]; 1-exp(-a*(x-loc)-(b*(x-loc)^2)/2)}
ii<-seq(1,(n-1))
yy<--log(1-(ii+0.3)/(n-1+0.4))
res<-summary(lm(yy ~ -1+y+I(y^2)))$coefficient
coeff<-c(abs(res[1,1]),abs(res[2,1]))
z1=NULL;
lfr.log<-function(p) {
z1<--log(sum(p[1]+p[2]*y))+p[1]*sum(y)+p[2]/2*sum(y^2)
z1[z1<1e-16]<-1e-16
}
p.hat<-suppressWarnings(optim(c(abs(coeff[1]),2*abs(coeff[2])),lfr.log)$par)
starts<-c(1,0.5,p.hat[1],p.hat[2],(min.mydata-1/length(y)))
if (location==FALSE){
den=function(par,x){a=par[3]; b=par[4]; (a+b*(x))*exp(-a*(x)-(b*(x)^2)/2)}
cum=function(par,x){a=par[3]; b=par[4]; 1-exp(-a*(x)-(b*(x)^2)/2)}
starts<-c(1,0.5,p.hat[1],p.hat[2])
}}
if(g=="log-logistic"){
den=function(par,x){a=par[3]; b=par[4]; loc=par[5]; (a*b^(-a)*(x-loc)^(a-1))/((((x-loc)/b)^a +1)^2)}
cum=function(par,x){a=par[3]; b=par[4]; loc=par[5]; 1/(((x-loc)/b)^(-a)+1)}
starts<-c(1,0.5,log(0.75/(1-0.75))/log(qp3/median.mydata),median.mydata,(min.mydata-1/length(y)))
if (location==FALSE){
den=function(par,x){a=par[3]; b=par[4]; (a*b^(-a)*(x)^(a-1))/((((x)/b)^a +1)^2)}
cum=function(par,x){a=par[3]; b=par[4]; 1/(((x)/b)^(-a)+1)}
starts<-c(1,0.5,log(0.75/(1-0.75))/log(qp3/median.mydata),median.mydata)
}}
if(g=="lomax"){
den=function(par,x){a=par[3]; b=par[4]; loc=par[5]; (a*b)/((1+a*(x-loc))^(b+1))}
cum=function(par,x){a=par[3]; b=par[4]; loc=par[5]; 1-(1+a*(x-loc))^(-b)}
a.hat<-1
b.hat<-(.5^(-1/a.hat)-1)/median.mydata
z1=NULL;
lomax.log<-function(p) {
z1<--n*log(p[1])-n*log(p[2])+(p[2]+1)*sum(log(1+p[1]*y))
z1[z1<1e-16]<-1e-16
}
p.hat<-suppressWarnings(optim(c(1,b.hat),lomax.log, method)$par)
starts<-c(1,0.5,p.hat[1],p.hat[2],(min.mydata-1/length(y)))
if (location==FALSE){
den=function(par,x){a=par[3]; b=par[4]; (a*b)/((1+a*(x))^(b+1))}
cum=function(par,x){a=par[3]; b=par[4]; 1-(1+a*(x))^(-b)}
starts<-c(1,0.5,p.hat[1],p.hat[2])
}}
if(g=="gompertz"){
den=function(par,x){a=par[3]; b=par[4]; loc=par[5]; b*exp(a*(x-loc))*exp(-(exp(a*(x-loc))-1)*b/a)}
cum=function(par,x){a=par[3]; b=par[4]; loc=par[5]; 1-exp(-(exp(a*(x-loc))-1)*b/a)}
a.hat<-log(log(1-.75)/log(1-.5))/(qp3-median.mydata)
b.hat<--a.hat*log(0.5)/(exp(a.hat*median.mydata)-1)
z1=NULL;
gompertz.log<-function(p){
z1<--n*log(p[2])-p[1]*sum(y)+p[2]/p[1]*sum(exp(p[1]*y)-1)
z1[z1<1e-16]<-1e-16
}
p.hat<-suppressWarnings(optim(c(a.hat,b.hat),gompertz.log, method)$par)
starts<-c(1,0.5,p.hat[1],p.hat[2],(min.mydata-1/length(y)))
if (location==FALSE){
den=function(par,x){a=par[3]; b=par[4]; b*exp(a*(x))*exp(-(exp(a*(x))-1)*b/a)}
cum=function(par,x){a=par[3]; b=par[4]; 1-exp(-(exp(a*(x))-1)*b/a)}
starts<-c(1,0.5,p.hat[1],p.hat[2])
}}
if(g=="exp"){
den=function(par,x){rate=par[3]; loc=par[4]; dexp(x-loc,rate)}
cum=function(par,x){rate=par[3]; loc=par[4]; pexp(x-loc,rate)}
starts<-c(1,0.5,1/mean.mydata,(min.mydata-1/length(y)))
if (location==FALSE){
den=function(par,x){rate=par[3]; dexp(x,rate)}
cum=function(par,x){rate=par[3]; pexp(x,rate)}
starts<-c(1,0.5,1/mean.mydata)
}}
if(g=="rayleigh"){
den=function(par,x){a=par[3]; loc=par[4]; 2*(x-loc)/a*exp(-((x-loc)/a)^2)}
cum=function(par,x){a=par[3]; loc=par[4]; 1-exp(-((x-loc)/a)^2)}
starts<-c(1,0.5,log(2)/(median.mydata)^2,(min.mydata-1/length(y)))
if (location==FALSE){
den=function(par,x){a=par[3]; 2*x/a*exp(-(x/a)^2)}
cum=function(par,x){a=par[3]; 1-exp(-(x/a)^2)}
starts<-c(1,0.5,log(2)/(median.mydata)^2)
}}
if(g=="burrxii"){
den=function(par,x){a=par[3]; d=par[4]; loc=par[5]; d*a*(1+(x-loc)^d)^(-a-1)*((x-loc)^(d-1))}
cum=function(par,x){a=par[3]; d=par[4]; loc=par[5]; 1-(1+(x-loc)^d)^(-a)}
z1=NULL;
burrxii.log<-function(p){
z1<--n*log(p[1])-n*log(p[2])-(p[2]-1)*sum(log(y))+(p[1]+1)*sum(log(1+y^p[2]))
}
p.hat<-suppressWarnings(optim(c(1,1),burrxii.log, method="BFGS")$par)
starts<-c(1,0.5,p.hat[1],p.hat[2],(min.mydata-1/length(y)))
if (location==FALSE){
den=function(par,x){a=par[3]; d=par[4]; d*a*(1+(x)^d)^(-a-1)*((x)^(d-1))}
cum=function(par,x){a=par[3]; d=par[4]; 1-(1+(x)^d)^(-a)}
starts<-c(1,0.5,p.hat[1],p.hat[2])
}}
if(g=="frechet"){
den=function(par,x){a=par[3]; b=par[4]; loc=par[5]; (a*exp(-((x-loc)/b)^(-a))*((x-loc)/b)^(-a-1))/(b)}
cum=function(par,x){a=par[3]; b=par[4]; loc=par[5]; exp(-((x-loc)/b)^(-a))}
cons<-cor(inv.mydata,rank(inv.mydata))*(sd(inv.mydata)/mean(inv.mydata))*sqrt((n+1)/(n-1))/sqrt(3)
a.hat<-abs(ifelse(cons<1,-log(2)/log(1-cons),-log(2)/log(1-.98)))
b.hat<-median(inv.mydata)/(log(2))^(1/a.hat)
starts<-c(1,0.5,a.hat,1/b.hat,(min.mydata-1/length(y)))
if (location==FALSE){
den=function(par,x){a=par[3]; b=par[4]; (a*exp(-((x)/b)^(-a))*((x)/b)^(-a-1))/(b)}
cum=function(par,x){a=par[3]; b=par[4]; exp(-((x)/b)^(-a))}
starts<-c(1,0.5,a.hat,1/b.hat)
}}
if(g=="birnbaum-saunders"){
den=function(par,x){a=par[3]; b=par[4]; loc=par[5]; (sqrt((x-loc)/b)+sqrt(b/(x-loc)))/(2*a*(x-loc))*dnorm((sqrt((x-loc)/b)-sqrt(b/(x-loc)))/a)}
cum=function(par,x){a=par[3]; b=par[4]; loc=par[5]; pnorm((sqrt((x-loc)/b)-sqrt(b/(x-loc)))/a)}
r<-(mean(inv.mydata))^(-1)
b.hat<-sqrt(mean.mydata*r)
a.hat<-sqrt(2*(sqrt(mean.mydata/r)))
starts<-c(1,0.5,a.hat,b.hat,(min.mydata-1/length(y)))
if (location==FALSE){
den=function(par,x){a=par[3]; b=par[4]; (sqrt((x)/b)+sqrt(b/(x)))/(2*a*(x))*dnorm((sqrt((x)/b)-sqrt(b/(x)))/a)}
cum=function(par,x){a=par[3]; b=par[4]; pnorm((sqrt((x)/b)-sqrt(b/(x)))/a)}
starts<-c(1,0.5,a.hat,b.hat)
}}
if(g=="weibull"){
den=function(par,x){shape=par[3]; scale=par[4]; loc=par[5]; dweibull(x-loc,shape,scale)}
cum=function(par,x){shape=par[3]; scale=par[4]; loc=par[5]; pweibull(x-loc,shape,scale)}
cons<-cor(mydata,rank(mydata))*(std.mydata/mean.mydata)*sqrt((n+1)/(n-1))/sqrt(3)
a.hat<-abs(ifelse(cons<1,-log(2)/log(1-cons),-log(2)/log(1-.98)))
b.hat<-median.mydata/(log(2))^(1/a.hat)
starts<-c(1,0.5,a.hat,b.hat,(min.mydata-1/length(y)))
if (location==FALSE){
den=function(par,x){shape=par[3]; scale=par[4]; dweibull(x,shape,scale)}
cum=function(par,x){shape=par[3]; scale=par[4]; pweibull(x,shape,scale)}
starts<-c(1,0.5,a.hat,b.hat)
}}
if(g=="gamma"){
den=function(par,x){shape=par[3]; scale=par[4]; loc=par[5]; dgamma(x-loc,shape,scale)}
cum=function(par,x){shape=par[3]; scale=par[4]; loc=par[5]; pgamma(x-loc,shape,scale)}
a.hat<-uniroot(function(ss) trigamma(ss)-var(log(y)[is.finite(log(y))]),c(0,1000000))$root
b.hat<-mean.mydata/a.hat
starts<-c(1,0.5,a.hat,b.hat,(min.mydata-1/length(y)))
if (location==FALSE){
den=function(par,x){shape=par[3]; scale=par[4]; dgamma(x,shape,scale)}
cum=function(par,x){shape=par[3]; scale=par[4]; pgamma(x,shape,scale)}
starts<-c(1,0.5,a.hat,b.hat)
}}
pdf0<-function(par,x){
f0=den(par,x)
c0=cum(par,x)
theta=par[1]
eta=par[2]
theta*(1-eta)*(1-exp(-theta))*f0*exp(-theta+theta*c0)/(1-exp(-theta)-eta+eta*exp(-theta+theta*c0))**2
}
cdf0<-function(par,x){
f0=den(par,x)
c0=cum(par,x)
theta=par[1]
eta=par[2]
(exp(-theta+theta*c0)-exp(-theta))/(1-exp(-theta)-eta+eta*exp(-theta+theta*c0))
}
mpsw<-function(par,x){
z=NULL
z=diff(c(0,cdf0(par,x),1))
for (j in 2:n){if((x[j]-x[j-1])==0){z[j]=pdf0(par,x[j])
}}
z[z<1e-16]=1e-16
-sum(log(z))
}
out<-suppressWarnings(optim(starts,fn=mpsw,x=sort.mydata,method))
n.p<-length(out$par)
gammam<-(n+1)*(log(n+1)-digamma(1))-1/2-1/(12*(n+1))
sigma2m<-(n+1)*(pi^2/6-1)-1/2-1/(6*(n+1))
c1<-gammam-sqrt(n*sigma2m/2)
c2<-sqrt(sigma2m/(2*n))
stat.chisquare<-(mpsw(out$par,sort.mydata)+n.p/2-c1)/c2
pvalue.chisquare<-pchisq(stat.chisquare,df=n,lower.tail=FALSE)
Moran<-out$value
log.likelihood=sum(log(pdf0(out$par,sort.mydata)))
u=cdf0(out$par,sort.mydata)
von<-c()
anderson<-c()
for(i in 1:n){
u[i]<-ifelse(u[i]==1,0.999999999,u[i])
von[i]=(u[i]-(2*i-1)/(2*n))^2
anderson[i]=(2*i-1)*log(u[i])+(2*n+1-2*i)*log(1-u[i])
}
anderson.stat=-n-mean(anderson)
von.stat=sum(von)+1/(12*n)
CAIC=-2*log.likelihood + 2*n.p + 2*(n.p*(n.p+1))/(n-n.p-1)
AIC=-2*log.likelihood + 2*n.p
BIC=-2*log.likelihood + n.p*log(n)
HQIC=-2*log.likelihood + 2*log(log(n))*n.p
ks.stat=suppressWarnings(ks.test(mydata, "cdf0", par=out$par))
aux2=cbind(AIC, CAIC, BIC, HQIC, von.stat, anderson.stat,log.likelihood,Moran)
colnames(aux2)=c("AIC","CAIC","BIC","HQIC","CM","AD", "log",
"Moran")
rownames(aux2)=c("")
aux3=cbind(ks.stat$statistic,ks.stat$p.value)
colnames(aux3)=c("statistic","p-value")
rownames(aux3)=c("")
aux4=cbind(stat.chisquare,qchisq(sig.level,df=n,lower.tail=FALSE),1-pchisq(stat.chisquare,df=n))
colnames(aux4)=c("statistic","chi-value","p-value")
rownames(aux4)=c("")
aux5=cbind(if(out$convergence==0){"Algorithm Converged"} else {"Algorithm Not Converged"})
list("MPS"=out$par,"Measures"=aux2,"KS"=aux3,"chi-square"=aux4,"Convergence Status"=aux5)
}
pbetaexpg<-function(mydata, g, param, location=TRUE, log.p = FALSE, lower.tail = TRUE){
if(g!="birnbaum-saunders" & g!="exp" & g!="rayleigh" & g!="weibull" & g!="gompertz" & g!="gamma"
& g!="log-normal" & g!="chisq" & g!="f" & g!="burrxii" & g!="frechet"
& g!="lomax" & g!="log-logistic" & g!="lfr" & g!="chen")
{ stop ("Baseline distribution not implemented or misspelled. Please check the manual for guidelines.") }
if(g=="log-normal"){
den=function(par,x){meanlog=par[4]; sdlog=par[5]; loc=par[6]; dlnorm(x-loc,meanlog,sdlog)}
cum=function(par,x){meanlog=par[4]; sdlog=par[5]; loc=par[6]; plnorm(x-loc,meanlog,sdlog)}
if (location==FALSE){
den=function(par,x){meanlog=par[4]; sdlog=par[5]; dlnorm(x,meanlog,sdlog)}
cum=function(par,x){meanlog=par[4]; sdlog=par[5]; plnorm(x,meanlog,sdlog)}
}}
if(g=="chisq"){
den=function(par,x){df=par[4]; loc=par[5]; dchisq(x-loc,df)}
cum=function(par,x){df=par[4]; loc=par[5]; pchisq(x-loc,df)}
if (location==FALSE){
den=function(par,x){df=par[4]; dchisq(x,df)}
cum=function(par,x){df=par[4]; pchisq(x,df)}
}}
if(g=="f"){
den=function(par,x){df1=par[4]; df2=par[5]; loc=par[6]; df(x-loc,df1,df2)}
cum=function(par,x){df1=par[4]; df2=par[5]; loc=par[6]; pf(x-loc,df1,df2)}
if (location==FALSE){
den=function(par,x){df1=par[4]; df2=par[5]; df(x,df1,df2)}
cum=function(par,x){df1=par[4]; df2=par[5]; pf(x,df1,df2)}
}}
if(g=="chen"){
den=function(par,x){a=par[4]; b=par[5]; loc=par[6]; a*b*(x-loc)^(a-1)*exp((x-loc)^a)*exp(-b*(exp((x-loc)^a)-1))}
cum=function(par,x){a=par[4]; b=par[5]; loc=par[6]; 1-exp(-b*(exp((x-loc)^a)-1))}
if (location==FALSE){
den=function(par,x){a=par[4]; b=par[5]; a*b*(x)^(a-1)*exp((x)^a)*exp(-b*(exp((x)^a)-1))}
cum=function(par,x){a=par[4]; b=par[5]; 1-exp(-b*(exp((x)^a)-1))}
}}
if(g=="lfr"){
den=function(par,x){a=par[4]; b=par[5]; loc=par[6]; (a+b*(x-loc))*exp(-a*(x-loc)-(b*(x-loc)^2)/2)}
cum=function(par,x){a=par[4]; b=par[5]; loc=par[6]; 1-exp(-a*(x-loc)-(b*(x-loc)^2)/2)}
if (location==FALSE){
den=function(par,x){a=par[4]; b=par[5]; (a+b*(x))*exp(-a*(x)-(b*(x)^2)/2)}
cum=function(par,x){a=par[4]; b=par[5]; 1-exp(-a*(x)-(b*(x)^2)/2)}
}}
if(g=="log-logistic"){
den=function(par,x){a=par[4]; b=par[5]; loc=par[6]; (a*b^(-a)*(x-loc)^(a-1))/((((x-loc)/b)^a +1)^2)}
cum=function(par,x){a=par[4]; b=par[5]; loc=par[6]; 1/(((x-loc)/b)^(-a)+1)}
if (location==FALSE){
den=function(par,x){a=par[4]; b=par[5]; (a*b^(-a)*(x)^(a-1))/((((x)/b)^a +1)^2)}
cum=function(par,x){a=par[4]; b=par[5]; 1/(((x)/b)^(-a)+1)}
}}
if(g=="lomax"){
den=function(par,x){a=par[4]; b=par[5]; loc=par[6]; (a*b)/((1+a*(x-loc))^(b+1))}
cum=function(par,x){a=par[4]; b=par[5]; loc=par[6]; 1-(1+a*(x-loc))^(-b)}
if (location==FALSE){
den=function(par,x){a=par[4]; b=par[5]; (a*b)/((1+a*(x))^(b+1))}
cum=function(par,x){a=par[4]; b=par[5]; 1-(1+a*(x))^(-b)}
}}
if(g=="gompertz"){
den=function(par,x){a=par[4]; b=par[5]; loc=par[6]; b*exp(a*(x-loc))*exp(-(exp(a*(x-loc))-1)*b/a)}
cum=function(par,x){a=par[4]; b=par[5]; loc=par[6]; 1-exp(-(exp(a*(x-loc))-1)*b/a)}
if (location==FALSE){
den=function(par,x){a=par[4]; b=par[5]; b*exp(a*(x))*exp(-(exp(a*(x))-1)*b/a)}
cum=function(par,x){a=par[4]; b=par[5]; 1-exp(-(exp(a*(x))-1)*b/a)}
}}
if(g=="exp"){
den=function(par,x){rate=par[4]; loc=par[5]; dexp(x-loc,rate)}
cum=function(par,x){rate=par[4]; loc=par[5]; pexp(x-loc,rate)}
if (location==FALSE){
den=function(par,x){rate=par[4]; dexp(x,rate)}
cum=function(par,x){rate=par[4]; pexp(x,rate)}
}}
if(g=="rayleigh"){
den=function(par,x){a=par[4]; loc=par[5]; 2*(x-loc)/a*exp(-((x-loc)/a)^2)}
cum=function(par,x){a=par[4]; loc=par[5]; 1-exp(-((x-loc)/a)^2)}
if (location==FALSE){
den=function(par,x){a=par[4]; 2*x/a*exp(-(x/a)^2)}
cum=function(par,x){a=par[4]; 1-exp(-(x/a)^2)}
}}
if(g=="burrxii"){
den=function(par,x){a=par[4]; d=par[5]; loc=par[6]; d*a*(1+(x-loc)^d)^(-a-1)*((x-loc)^(d-1))}
cum=function(par,x){a=par[4]; d=par[5]; loc=par[6]; 1-(1+(x-loc)^d)^(-a)}
if (location==FALSE){
den=function(par,x){a=par[4]; d=par[5]; d*a*(1+(x)^d)^(-a-1)*((x)^(d-1))}
cum=function(par,x){a=par[4]; d=par[5]; 1-(1+(x)^d)^(-a)}
}}
if(g=="frechet"){
den=function(par,x){a=par[4]; b=par[5]; loc=par[6]; (a*exp(-((x-loc)/b)^(-a))*((x-loc)/b)^(-a-1))/(b)}
cum=function(par,x){a=par[4]; b=par[5]; loc=par[6]; exp(-((x-loc)/b)^(-a))}
if (location==FALSE){
den=function(par,x){a=par[4]; b=par[5]; (a*exp(-((x)/b)^(-a))*((x)/b)^(-a-1))/(b)}
cum=function(par,x){a=par[4]; b=par[5]; exp(-((x)/b)^(-a))}
}}
if(g=="birnbaum-saunders"){
den=function(par,x){a=par[4]; b=par[5]; loc=par[6]; (sqrt((x-loc)/b)+sqrt(b/(x-loc)))/(2*a*(x-loc))*dnorm((sqrt((x-loc)/b)-sqrt(b/(x-loc)))/a)}
cum=function(par,x){a=par[4]; b=par[5]; loc=par[6]; pnorm((sqrt((x-loc)/b)-sqrt(b/(x-loc)))/a)}
if (location==FALSE){
den=function(par,x){a=par[4]; b=par[5]; (sqrt((x)/b)+sqrt(b/(x)))/(2*a*(x))*dnorm((sqrt((x)/b)-sqrt(b/(x)))/a)}
cum=function(par,x){a=par[4]; b=par[5]; pnorm((sqrt((x)/b)-sqrt(b/(x)))/a)}
}}
if(g=="weibull"){
den=function(par,x){shape=par[4]; scale=par[5]; loc=par[6]; dweibull(x-loc,shape,scale)}
cum=function(par,x){shape=par[4]; scale=par[5]; loc=par[6]; pweibull(x-loc,shape,scale)}
if (location==FALSE){
den=function(par,x){shape=par[4]; scale=par[5]; dweibull(x,shape,scale)}
cum=function(par,x){shape=par[4]; scale=par[5]; pweibull(x,shape,scale)}
}}
if(g=="gamma"){
den=function(par,x){shape=par[4]; scale=par[5]; loc=par[6]; dgamma(x-loc,shape,scale)}
cum=function(par,x){shape=par[4]; scale=par[5]; loc=par[6]; pgamma(x-loc,shape,scale)}
if (location==FALSE){
den=function(par,x){shape=par[4]; scale=par[5]; dgamma(x,shape,scale)}
cum=function(par,x){shape=par[4]; scale=par[5]; pgamma(x,shape,scale)}
}}
cdf0<-function(par,x){
f0=den(par,x)
c0=cum(par,x)
a=par[1]
b=par[2]
d=par[3]
1-pbeta((1-c0)**d,shape1=a,shape2=b)
}
cdf<-cdf0(param,mydata)
if(log.p==TRUE & lower.tail == FALSE) cdf<-log(1-cdf)
if(log.p==TRUE & lower.tail == TRUE) cdf<-log(cdf)
if(log.p==FALSE & lower.tail == FALSE) cdf<-1-cdf
return(cdf)
}
dbetaexpg<-function(mydata, g, param, location=TRUE, log=FALSE){
if(g!="birnbaum-saunders" & g!="exp" & g!="rayleigh" & g!="weibull" & g!="gompertz" & g!="gamma"
& g!="log-normal" & g!="chisq" & g!="f" & g!="burrxii" & g!="frechet"
& g!="lomax" & g!="log-logistic" & g!="lfr" & g!="chen")
{ stop ("Baseline distribution not implemented or misspelled. Please check the manual for guidelines.") }
if(g=="log-normal"){
den=function(par,x){meanlog=par[4]; sdlog=par[5]; loc=par[6]; dlnorm(x-loc,meanlog,sdlog)}
cum=function(par,x){meanlog=par[4]; sdlog=par[5]; loc=par[6]; plnorm(x-loc,meanlog,sdlog)}
if (location==FALSE){
den=function(par,x){meanlog=par[4]; sdlog=par[5]; dlnorm(x,meanlog,sdlog)}
cum=function(par,x){meanlog=par[4]; sdlog=par[5]; plnorm(x,meanlog,sdlog)}
}}
if(g=="chisq"){
den=function(par,x){df=par[4]; loc=par[5]; dchisq(x-loc,df)}
cum=function(par,x){df=par[4]; loc=par[5]; pchisq(x-loc,df)}
if (location==FALSE){
den=function(par,x){df=par[4]; dchisq(x,df)}
cum=function(par,x){df=par[4]; pchisq(x,df)}
}}
if(g=="f"){
den=function(par,x){df1=par[4]; df2=par[5]; loc=par[6]; df(x-loc,df1,df2)}
cum=function(par,x){df1=par[4]; df2=par[5]; loc=par[6]; pf(x-loc,df1,df2)}
if (location==FALSE){
den=function(par,x){df1=par[4]; df2=par[5]; df(x,df1,df2)}
cum=function(par,x){df1=par[4]; df2=par[5]; pf(x,df1,df2)}
}}
if(g=="chen"){
den=function(par,x){a=par[4]; b=par[5]; loc=par[6]; a*b*(x-loc)^(a-1)*exp((x-loc)^a)*exp(-b*(exp((x-loc)^a)-1))}
cum=function(par,x){a=par[4]; b=par[5]; loc=par[6]; 1-exp(-b*(exp((x-loc)^a)-1))}
if (location==FALSE){
den=function(par,x){a=par[4]; b=par[5]; a*b*(x)^(a-1)*exp((x)^a)*exp(-b*(exp((x)^a)-1))}
cum=function(par,x){a=par[4]; b=par[5]; 1-exp(-b*(exp((x)^a)-1))}
}}
if(g=="lfr"){
den=function(par,x){a=par[4]; b=par[5]; loc=par[6]; (a+b*(x-loc))*exp(-a*(x-loc)-(b*(x-loc)^2)/2)}
cum=function(par,x){a=par[4]; b=par[5]; loc=par[6]; 1-exp(-a*(x-loc)-(b*(x-loc)^2)/2)}
if (location==FALSE){
den=function(par,x){a=par[4]; b=par[5]; (a+b*(x))*exp(-a*(x)-(b*(x)^2)/2)}
cum=function(par,x){a=par[4]; b=par[5]; 1-exp(-a*(x)-(b*(x)^2)/2)}
}}
if(g=="log-logistic"){
den=function(par,x){a=par[4]; b=par[5]; loc=par[6]; (a*b^(-a)*(x-loc)^(a-1))/((((x-loc)/b)^a +1)^2)}
cum=function(par,x){a=par[4]; b=par[5]; loc=par[6]; 1/(((x-loc)/b)^(-a)+1)}
if (location==FALSE){
den=function(par,x){a=par[4]; b=par[5]; (a*b^(-a)*(x)^(a-1))/((((x)/b)^a +1)^2)}
cum=function(par,x){a=par[4]; b=par[5]; 1/(((x)/b)^(-a)+1)}
}}
if(g=="lomax"){
den=function(par,x){a=par[4]; b=par[5]; loc=par[6]; (a*b)/((1+a*(x-loc))^(b+1))}
cum=function(par,x){a=par[4]; b=par[5]; loc=par[6]; 1-(1+a*(x-loc))^(-b)}
if (location==FALSE){
den=function(par,x){a=par[4]; b=par[5]; (a*b)/((1+a*(x))^(b+1))}
cum=function(par,x){a=par[4]; b=par[5]; 1-(1+a*(x))^(-b)}
}}
if(g=="gompertz"){
den=function(par,x){a=par[4]; b=par[5]; loc=par[6]; b*exp(a*(x-loc))*exp(-(exp(a*(x-loc))-1)*b/a)}
cum=function(par,x){a=par[4]; b=par[5]; loc=par[6]; 1-exp(-(exp(a*(x-loc))-1)*b/a)}
if (location==FALSE){
den=function(par,x){a=par[4]; b=par[5]; b*exp(a*(x))*exp(-(exp(a*(x))-1)*b/a)}
cum=function(par,x){a=par[4]; b=par[5]; 1-exp(-(exp(a*(x))-1)*b/a)}
}}
if(g=="exp"){
den=function(par,x){rate=par[4]; loc=par[5]; dexp(x-loc,rate)}
cum=function(par,x){rate=par[4]; loc=par[5]; pexp(x-loc,rate)}
if (location==FALSE){
den=function(par,x){rate=par[4]; dexp(x,rate)}
cum=function(par,x){rate=par[4]; pexp(x,rate)}
}}
if(g=="rayleigh"){
den=function(par,x){a=par[4]; loc=par[5]; 2*(x-loc)/a*exp(-((x-loc)/a)^2)}
cum=function(par,x){a=par[4]; loc=par[5]; 1-exp(-((x-loc)/a)^2)}
if (location==FALSE){
den=function(par,x){a=par[4]; 2*x/a*exp(-(x/a)^2)}
cum=function(par,x){a=par[4]; 1-exp(-(x/a)^2)}
}}
if(g=="burrxii"){
den=function(par,x){a=par[4]; d=par[5]; loc=par[6]; d*a*(1+(x-loc)^d)^(-a-1)*((x-loc)^(d-1))}
cum=function(par,x){a=par[4]; d=par[5]; loc=par[6]; 1-(1+(x-loc)^d)^(-a)}
if (location==FALSE){
den=function(par,x){a=par[4]; d=par[5]; d*a*(1+(x)^d)^(-a-1)*((x)^(d-1))}
cum=function(par,x){a=par[4]; d=par[5]; 1-(1+(x)^d)^(-a)}
}}
if(g=="frechet"){
den=function(par,x){a=par[4]; b=par[5]; loc=par[6]; (a*exp(-((x-loc)/b)^(-a))*((x-loc)/b)^(-a-1))/(b)}
cum=function(par,x){a=par[4]; b=par[5]; loc=par[6]; exp(-((x-loc)/b)^(-a))}
if (location==FALSE){
den=function(par,x){a=par[4]; b=par[5]; (a*exp(-((x)/b)^(-a))*((x)/b)^(-a-1))/(b)}
cum=function(par,x){a=par[4]; b=par[5]; exp(-((x)/b)^(-a))}
}}
if(g=="birnbaum-saunders"){
den=function(par,x){a=par[4]; b=par[5]; loc=par[6]; (sqrt((x-loc)/b)+sqrt(b/(x-loc)))/(2*a*(x-loc))*dnorm((sqrt((x-loc)/b)-sqrt(b/(x-loc)))/a)}
cum=function(par,x){a=par[4]; b=par[5]; loc=par[6]; pnorm((sqrt((x-loc)/b)-sqrt(b/(x-loc)))/a)}
if (location==FALSE){
den=function(par,x){a=par[4]; b=par[5]; (sqrt((x)/b)+sqrt(b/(x)))/(2*a*(x))*dnorm((sqrt((x)/b)-sqrt(b/(x)))/a)}
cum=function(par,x){a=par[4]; b=par[5]; pnorm((sqrt((x)/b)-sqrt(b/(x)))/a)}
}}
if(g=="weibull"){
den=function(par,x){shape=par[4]; scale=par[5]; loc=par[6]; dweibull(x-loc,shape,scale)}
cum=function(par,x){shape=par[4]; scale=par[5]; loc=par[6]; pweibull(x-loc,shape,scale)}
if (location==FALSE){
den=function(par,x){shape=par[4]; scale=par[5]; dweibull(x,shape,scale)}
cum=function(par,x){shape=par[4]; scale=par[5]; pweibull(x,shape,scale)}
}}
if(g=="gamma"){
den=function(par,x){shape=par[4]; scale=par[5]; loc=par[6]; dgamma(x-loc,shape,scale)}
cum=function(par,x){shape=par[4]; scale=par[5]; loc=par[6]; pgamma(x-loc,shape,scale)}
if (location==FALSE){
den=function(par,x){shape=par[4]; scale=par[5]; dgamma(x,shape,scale)}
cum=function(par,x){shape=par[4]; scale=par[5]; pgamma(x,shape,scale)}
}}
pdf0<-function(par,x){
f0=den(par,x)
c0=cum(par,x)
a=par[1]
b=par[2]
d=par[3]
d*f0*beta(a,b)^(-1)*(1-c0)^(d*a-1)*(1-(1-c0)^d)^(b-1)
}
pdf<-pdf0(param,mydata)
if(log==TRUE){pdf<-log(pdf)}
return(pdf)
}
pbetag<-function(mydata, g, param, location=TRUE, log.p = FALSE, lower.tail = TRUE){
if(g!="birnbaum-saunders" & g!="exp" & g!="rayleigh" & g!="weibull" & g!="gompertz" & g!="gamma"
& g!="log-normal" & g!="chisq" & g!="f" & g!="burrxii" & g!="frechet"
& g!="lomax" & g!="log-logistic" & g!="lfr" & g!="chen")
{ stop ("Baseline distribution not implemented or misspelled. Please check the manual for guidelines.") }
if(g=="log-normal"){
den=function(par,x){meanlog=par[3]; sdlog=par[4]; loc=par[5]; dlnorm(x-loc,meanlog,sdlog)}
cum=function(par,x){meanlog=par[3]; sdlog=par[4]; loc=par[5]; plnorm(x-loc,meanlog,sdlog)}
if (location==FALSE){
den=function(par,x){meanlog=par[3]; sdlog=par[4]; dlnorm(x,meanlog,sdlog)}
cum=function(par,x){meanlog=par[3]; sdlog=par[4]; plnorm(x,meanlog,sdlog)}
}}
if(g=="chisq"){
den=function(par,x){df=par[3]; loc=par[4]; dchisq(x-loc,df)}
cum=function(par,x){df=par[3]; loc=par[4]; pchisq(x-loc,df)}
if (location==FALSE){
den=function(par,x){df=par[3]; dchisq(x,df)}
cum=function(par,x){df=par[3]; pchisq(x,df)}
}}
if(g=="f"){
den=function(par,x){df1=par[3]; df2=par[4]; loc=par[5]; df(x-loc,df1,df2)}
cum=function(par,x){df1=par[3]; df2=par[4]; loc=par[5]; pf(x-loc,df1,df2)}
if (location==FALSE){
den=function(par,x){df1=par[3]; df2=par[4]; df(x,df1,df2)}
cum=function(par,x){df1=par[3]; df2=par[4]; pf(x,df1,df2)}
}}
if(g=="chen"){
den=function(par,x){a=par[3]; b=par[4]; loc=par[5]; a*b*(x-loc)^(a-1)*exp((x-loc)^a)*exp(-b*(exp((x-loc)^a)-1))}
cum=function(par,x){a=par[3]; b=par[4]; loc=par[5]; 1-exp(-b*(exp((x-loc)^a)-1))}
if (location==FALSE){
den=function(par,x){a=par[3]; b=par[4]; a*b*(x)^(a-1)*exp((x)^a)*exp(-b*(exp((x)^a)-1))}
cum=function(par,x){a=par[3]; b=par[4]; 1-exp(-b*(exp((x)^a)-1))}
}}
if(g=="lfr"){
den=function(par,x){a=par[3]; b=par[4]; loc=par[5]; (a+b*(x-loc))*exp(-a*(x-loc)-(b*(x-loc)^2)/2)}
cum=function(par,x){a=par[3]; b=par[4]; loc=par[5]; 1-exp(-a*(x-loc)-(b*(x-loc)^2)/2)}
if (location==FALSE){
den=function(par,x){a=par[3]; b=par[4]; (a+b*(x))*exp(-a*(x)-(b*(x)^2)/2)}
cum=function(par,x){a=par[3]; b=par[4]; 1-exp(-a*(x)-(b*(x)^2)/2)}
}}
if(g=="log-logistic"){
den=function(par,x){a=par[3]; b=par[4]; loc=par[5]; (a*b^(-a)*(x-loc)^(a-1))/((((x-loc)/b)^a +1)^2)}
cum=function(par,x){a=par[3]; b=par[4]; loc=par[5]; 1/(((x-loc)/b)^(-a)+1)}
if (location==FALSE){
den=function(par,x){a=par[3]; b=par[4]; (a*b^(-a)*(x)^(a-1))/((((x)/b)^a +1)^2)}
cum=function(par,x){a=par[3]; b=par[4]; 1/(((x)/b)^(-a)+1)}
}}
if(g=="lomax"){
den=function(par,x){a=par[3]; b=par[4]; loc=par[5]; (a*b)/((1+a*(x-loc))^(b+1))}
cum=function(par,x){a=par[3]; b=par[4]; loc=par[5]; 1-(1+a*(x-loc))^(-b)}
if (location==FALSE){
den=function(par,x){a=par[3]; b=par[4]; (a*b)/((1+a*(x))^(b+1))}
cum=function(par,x){a=par[3]; b=par[4]; 1-(1+a*(x))^(-b)}
}}
if(g=="gompertz"){
den=function(par,x){a=par[3]; b=par[4]; loc=par[5]; b*exp(a*(x-loc))*exp(-(exp(a*(x-loc))-1)*b/a)}
cum=function(par,x){a=par[3]; b=par[4]; loc=par[5]; 1-exp(-(exp(a*(x-loc))-1)*b/a)}
if (location==FALSE){
den=function(par,x){a=par[3]; b=par[4]; b*exp(a*(x))*exp(-(exp(a*(x))-1)*b/a)}
cum=function(par,x){a=par[3]; b=par[4]; 1-exp(-(exp(a*(x))-1)*b/a)}
}}
if(g=="exp"){
den=function(par,x){rate=par[3]; loc=par[4]; dexp(x-loc,rate)}
cum=function(par,x){rate=par[3]; loc=par[4]; pexp(x-loc,rate)}
if (location==FALSE){
den=function(par,x){rate=par[3]; dexp(x,rate)}
cum=function(par,x){rate=par[3]; pexp(x,rate)}
}}
if(g=="rayleigh"){
den=function(par,x){a=par[3]; loc=par[4]; 2*(x-loc)/a*exp(-((x-loc)/a)^2)}
cum=function(par,x){a=par[3]; loc=par[4]; 1-exp(-((x-loc)/a)^2)}
if (location==FALSE){
den=function(par,x){a=par[3]; 2*x/a*exp(-(x/a)^2)}
cum=function(par,x){a=par[3]; 1-exp(-(x/a)^2)}
}}
if(g=="burrxii"){
den=function(par,x){a=par[3]; d=par[4]; loc=par[5]; d*a*(1+(x-loc)^d)^(-a-1)*((x-loc)^(d-1))}
cum=function(par,x){a=par[3]; d=par[4]; loc=par[5]; 1-(1+(x-loc)^d)^(-a)}
if (location==FALSE){
den=function(par,x){a=par[3]; d=par[4]; d*a*(1+(x)^d)^(-a-1)*((x)^(d-1))}
cum=function(par,x){a=par[3]; d=par[4]; 1-(1+(x)^d)^(-a)}
}}
if(g=="frechet"){
den=function(par,x){a=par[3]; b=par[4]; loc=par[5]; (a*exp(-((x-loc)/b)^(-a))*((x-loc)/b)^(-a-1))/(b)}
cum=function(par,x){a=par[3]; b=par[4]; loc=par[5]; exp(-((x-loc)/b)^(-a))}
if (location==FALSE){
den=function(par,x){a=par[3]; b=par[4]; (a*exp(-((x)/b)^(-a))*((x)/b)^(-a-1))/(b)}
cum=function(par,x){a=par[3]; b=par[4]; exp(-((x)/b)^(-a))}
}}
if(g=="birnbaum-saunders"){
den=function(par,x){a=par[3]; b=par[4]; loc=par[5]; (sqrt((x-loc)/b)+sqrt(b/(x-loc)))/(2*a*(x-loc))*dnorm((sqrt((x-loc)/b)-sqrt(b/(x-loc)))/a)}
cum=function(par,x){a=par[3]; b=par[4]; loc=par[5]; pnorm((sqrt((x-loc)/b)-sqrt(b/(x-loc)))/a)}
if (location==FALSE){
den=function(par,x){a=par[3]; b=par[4]; (sqrt((x)/b)+sqrt(b/(x)))/(2*a*(x))*dnorm((sqrt((x)/b)-sqrt(b/(x)))/a)}
cum=function(par,x){a=par[3]; b=par[4]; pnorm((sqrt((x)/b)-sqrt(b/(x)))/a)}
}}
if(g=="weibull"){
den=function(par,x){shape=par[3]; scale=par[4]; loc=par[5]; dweibull(x-loc,shape,scale)}
cum=function(par,x){shape=par[3]; scale=par[4]; loc=par[5]; pweibull(x-loc,shape,scale)}
if (location==FALSE){
den=function(par,x){shape=par[3]; scale=par[4]; dweibull(x,shape,scale)}
cum=function(par,x){shape=par[3]; scale=par[4]; pweibull(x,shape,scale)}
}}
if(g=="gamma"){
den=function(par,x){shape=par[3]; scale=par[4]; loc=par[5]; dgamma(x-loc,shape,scale)}
cum=function(par,x){shape=par[3]; scale=par[4]; loc=par[5]; pgamma(x-loc,shape,scale)}
if (location==FALSE){
den=function(par,x){shape=par[3]; scale=par[4]; dgamma(x,shape,scale)}
cum=function(par,x){shape=par[3]; scale=par[4]; pgamma(x,shape,scale)}
}}
cdf0<-function(par,x){
c0=cum(par,x)
a=par[1]
b=par[2]
pbeta(c0,shape1=a,shape2=b)
}
cdf<-cdf0(param,mydata)
if(log.p==TRUE & lower.tail == FALSE) cdf<-log(1-cdf)
if(log.p==TRUE & lower.tail == TRUE) cdf<-log(cdf)
if(log.p==FALSE & lower.tail == FALSE) cdf<-1-cdf
return(cdf)
}
dbetag<-function(mydata, g, param, location=TRUE, log=FALSE){
if(g!="birnbaum-saunders" & g!="exp" & g!="rayleigh" & g!="weibull" & g!="gompertz" & g!="gamma"
& g!="log-normal" & g!="chisq" & g!="f" & g!="burrxii" & g!="frechet"
& g!="lomax" & g!="log-logistic" & g!="lfr" & g!="chen")
{ stop ("Baseline distribution not implemented or misspelled. Please check the manual for guidelines.") }
if(g=="log-normal"){
den=function(par,x){meanlog=par[3]; sdlog=par[4]; loc=par[5]; dlnorm(x-loc,meanlog,sdlog)}
cum=function(par,x){meanlog=par[3]; sdlog=par[4]; loc=par[5]; plnorm(x-loc,meanlog,sdlog)}
if (location==FALSE){
den=function(par,x){meanlog=par[3]; sdlog=par[4]; dlnorm(x,meanlog,sdlog)}
cum=function(par,x){meanlog=par[3]; sdlog=par[4]; plnorm(x,meanlog,sdlog)}
}}
if(g=="chisq"){
den=function(par,x){df=par[3]; loc=par[4]; dchisq(x-loc,df)}
cum=function(par,x){df=par[3]; loc=par[4]; pchisq(x-loc,df)}
if (location==FALSE){
den=function(par,x){df=par[3]; dchisq(x,df)}
cum=function(par,x){df=par[3]; pchisq(x,df)}
}}
if(g=="f"){
den=function(par,x){df1=par[3]; df2=par[4]; loc=par[5]; df(x-loc,df1,df2)}
cum=function(par,x){df1=par[3]; df2=par[4]; loc=par[5]; pf(x-loc,df1,df2)}
if (location==FALSE){
den=function(par,x){df1=par[3]; df2=par[4]; df(x,df1,df2)}
cum=function(par,x){df1=par[3]; df2=par[4]; pf(x,df1,df2)}
}}
if(g=="chen"){
den=function(par,x){a=par[3]; b=par[4]; loc=par[5]; a*b*(x-loc)^(a-1)*exp((x-loc)^a)*exp(-b*(exp((x-loc)^a)-1))}
cum=function(par,x){a=par[3]; b=par[4]; loc=par[5]; 1-exp(-b*(exp((x-loc)^a)-1))}
if (location==FALSE){
den=function(par,x){a=par[3]; b=par[4]; a*b*(x)^(a-1)*exp((x)^a)*exp(-b*(exp((x)^a)-1))}
cum=function(par,x){a=par[3]; b=par[4]; 1-exp(-b*(exp((x)^a)-1))}
}}
if(g=="lfr"){
den=function(par,x){a=par[3]; b=par[4]; loc=par[5]; (a+b*(x-loc))*exp(-a*(x-loc)-(b*(x-loc)^2)/2)}
cum=function(par,x){a=par[3]; b=par[4]; loc=par[5]; 1-exp(-a*(x-loc)-(b*(x-loc)^2)/2)}
if (location==FALSE){
den=function(par,x){a=par[3]; b=par[4]; (a+b*(x))*exp(-a*(x)-(b*(x)^2)/2)}
cum=function(par,x){a=par[3]; b=par[4]; 1-exp(-a*(x)-(b*(x)^2)/2)}
}}
if(g=="log-logistic"){
den=function(par,x){a=par[3]; b=par[4]; loc=par[5]; (a*b^(-a)*(x-loc)^(a-1))/((((x-loc)/b)^a +1)^2)}
cum=function(par,x){a=par[3]; b=par[4]; loc=par[5]; 1/(((x-loc)/b)^(-a)+1)}
if (location==FALSE){
den=function(par,x){a=par[3]; b=par[4]; (a*b^(-a)*(x)^(a-1))/((((x)/b)^a +1)^2)}
cum=function(par,x){a=par[3]; b=par[4]; 1/(((x)/b)^(-a)+1)}
}}
if(g=="lomax"){
den=function(par,x){a=par[3]; b=par[4]; loc=par[5]; (a*b)/((1+a*(x-loc))^(b+1))}
cum=function(par,x){a=par[3]; b=par[4]; loc=par[5]; 1-(1+a*(x-loc))^(-b)}
if (location==FALSE){
den=function(par,x){a=par[3]; b=par[4]; (a*b)/((1+a*(x))^(b+1))}
cum=function(par,x){a=par[3]; b=par[4]; 1-(1+a*(x))^(-b)}
}}
if(g=="gompertz"){
den=function(par,x){a=par[3]; b=par[4]; loc=par[5]; b*exp(a*(x-loc))*exp(-(exp(a*(x-loc))-1)*b/a)}
cum=function(par,x){a=par[3]; b=par[4]; loc=par[5]; 1-exp(-(exp(a*(x-loc))-1)*b/a)}
if (location==FALSE){
den=function(par,x){a=par[3]; b=par[4]; b*exp(a*(x))*exp(-(exp(a*(x))-1)*b/a)}
cum=function(par,x){a=par[3]; b=par[4]; 1-exp(-(exp(a*(x))-1)*b/a)}
}}
if(g=="exp"){
den=function(par,x){rate=par[3]; loc=par[4]; dexp(x-loc,rate)}
cum=function(par,x){rate=par[3]; loc=par[4]; pexp(x-loc,rate)}
if (location==FALSE){
den=function(par,x){rate=par[3]; dexp(x,rate)}
cum=function(par,x){rate=par[3]; pexp(x,rate)}
}}
if(g=="rayleigh"){
den=function(par,x){a=par[3]; loc=par[4]; 2*(x-loc)/a*exp(-((x-loc)/a)^2)}
cum=function(par,x){a=par[3]; loc=par[4]; 1-exp(-((x-loc)/a)^2)}
if (location==FALSE){
den=function(par,x){a=par[3]; 2*x/a*exp(-(x/a)^2)}
cum=function(par,x){a=par[3]; 1-exp(-(x/a)^2)}
}}
if(g=="burrxii"){
den=function(par,x){a=par[3]; d=par[4]; loc=par[5]; d*a*(1+(x-loc)^d)^(-a-1)*((x-loc)^(d-1))}
cum=function(par,x){a=par[3]; d=par[4]; loc=par[5]; 1-(1+(x-loc)^d)^(-a)}
if (location==FALSE){
den=function(par,x){a=par[3]; d=par[4]; d*a*(1+(x)^d)^(-a-1)*((x)^(d-1))}
cum=function(par,x){a=par[3]; d=par[4]; 1-(1+(x)^d)^(-a)}
}}
if(g=="frechet"){
den=function(par,x){a=par[3]; b=par[4]; loc=par[5]; (a*exp(-((x-loc)/b)^(-a))*((x-loc)/b)^(-a-1))/(b)}
cum=function(par,x){a=par[3]; b=par[4]; loc=par[5]; exp(-((x-loc)/b)^(-a))}
if (location==FALSE){
den=function(par,x){a=par[3]; b=par[4]; (a*exp(-((x)/b)^(-a))*((x)/b)^(-a-1))/(b)}
cum=function(par,x){a=par[3]; b=par[4]; exp(-((x)/b)^(-a))}
}}
if(g=="birnbaum-saunders"){
den=function(par,x){a=par[3]; b=par[4]; loc=par[5]; (sqrt((x-loc)/b)+sqrt(b/(x-loc)))/(2*a*(x-loc))*dnorm((sqrt((x-loc)/b)-sqrt(b/(x-loc)))/a)}
cum=function(par,x){a=par[3]; b=par[4]; loc=par[5]; pnorm((sqrt((x-loc)/b)-sqrt(b/(x-loc)))/a)}
if (location==FALSE){
den=function(par,x){a=par[3]; b=par[4]; (sqrt((x)/b)+sqrt(b/(x)))/(2*a*(x))*dnorm((sqrt((x)/b)-sqrt(b/(x)))/a)}
cum=function(par,x){a=par[3]; b=par[4]; pnorm((sqrt((x)/b)-sqrt(b/(x)))/a)}
}}
if(g=="weibull"){
den=function(par,x){shape=par[3]; scale=par[4]; loc=par[5]; dweibull(x-loc,shape,scale)}
cum=function(par,x){shape=par[3]; scale=par[4]; loc=par[5]; pweibull(x-loc,shape,scale)}
if (location==FALSE){
den=function(par,x){shape=par[3]; scale=par[4]; dweibull(x,shape,scale)}
cum=function(par,x){shape=par[3]; scale=par[4]; pweibull(x,shape,scale)}
}}
if(g=="gamma"){
den=function(par,x){shape=par[3]; scale=par[4]; loc=par[5]; dgamma(x-loc,shape,scale)}
cum=function(par,x){shape=par[3]; scale=par[4]; loc=par[5]; pgamma(x-loc,shape,scale)}
if (location==FALSE){
den=function(par,x){shape=par[3]; scale=par[4]; dgamma(x,shape,scale)}
cum=function(par,x){shape=par[3]; scale=par[4]; pgamma(x,shape,scale)}
}}
pdf0<-function(par,x){
f0=den(par,x)
c0=cum(par,x)
a=par[1]
b=par[2]
f0*beta(a,b)^(-1)*c0^(a-1)*(1-c0)^(b-1)
}
pdf<-pdf0(param,mydata)
if(log==TRUE){pdf<-log(pdf)}
return(pdf)
}
pexpexppg<-function(mydata, g, param, location=TRUE, log.p = FALSE, lower.tail = TRUE){
if(g!="birnbaum-saunders" & g!="exp" & g!="rayleigh" & g!="weibull" & g!="gompertz" & g!="gamma"
& g!="log-normal" & g!="chisq" & g!="f" & g!="burrxii" & g!="frechet"
& g!="lomax" & g!="log-logistic" & g!="lfr" & g!="chen")
{ stop ("Baseline distribution not implemented or misspelled. Please check the manual for guidelines.") }
if(g=="log-normal"){
den=function(par,x){meanlog=par[3]; sdlog=par[4]; loc=par[5]; dlnorm(x-loc,meanlog,sdlog)}
cum=function(par,x){meanlog=par[3]; sdlog=par[4]; loc=par[5]; plnorm(x-loc,meanlog,sdlog)}
if (location==FALSE){
den=function(par,x){meanlog=par[3]; sdlog=par[4]; dlnorm(x,meanlog,sdlog)}
cum=function(par,x){meanlog=par[3]; sdlog=par[4]; plnorm(x,meanlog,sdlog)}
}}
if(g=="chisq"){
den=function(par,x){df=par[3]; loc=par[4]; dchisq(x-loc,df)}
cum=function(par,x){df=par[3]; loc=par[4]; pchisq(x-loc,df)}
if (location==FALSE){
den=function(par,x){df=par[3]; dchisq(x,df)}
cum=function(par,x){df=par[3]; pchisq(x,df)}
}}
if(g=="f"){
den=function(par,x){df1=par[3]; df2=par[4]; loc=par[5]; df(x-loc,df1,df2)}
cum=function(par,x){df1=par[3]; df2=par[4]; loc=par[5]; pf(x-loc,df1,df2)}
if (location==FALSE){
den=function(par,x){df1=par[3]; df2=par[4]; df(x,df1,df2)}
cum=function(par,x){df1=par[3]; df2=par[4]; pf(x,df1,df2)}
}}
if(g=="chen"){
den=function(par,x){a=par[3]; b=par[4]; loc=par[5]; a*b*(x-loc)^(a-1)*exp((x-loc)^a)*exp(-b*(exp((x-loc)^a)-1))}
cum=function(par,x){a=par[3]; b=par[4]; loc=par[5]; 1-exp(-b*(exp((x-loc)^a)-1))}
if (location==FALSE){
den=function(par,x){a=par[3]; b=par[4]; a*b*(x)^(a-1)*exp((x)^a)*exp(-b*(exp((x)^a)-1))}
cum=function(par,x){a=par[3]; b=par[4]; 1-exp(-b*(exp((x)^a)-1))}
}}
if(g=="lfr"){
den=function(par,x){a=par[3]; b=par[4]; loc=par[5]; (a+b*(x-loc))*exp(-a*(x-loc)-(b*(x-loc)^2)/2)}
cum=function(par,x){a=par[3]; b=par[4]; loc=par[5]; 1-exp(-a*(x-loc)-(b*(x-loc)^2)/2)}
if (location==FALSE){
den=function(par,x){a=par[3]; b=par[4]; (a+b*(x))*exp(-a*(x)-(b*(x)^2)/2)}
cum=function(par,x){a=par[3]; b=par[4]; 1-exp(-a*(x)-(b*(x)^2)/2)}
}}
if(g=="log-logistic"){
den=function(par,x){a=par[3]; b=par[4]; loc=par[5]; (a*b^(-a)*(x-loc)^(a-1))/((((x-loc)/b)^a +1)^2)}
cum=function(par,x){a=par[3]; b=par[4]; loc=par[5]; 1/(((x-loc)/b)^(-a)+1)}
if (location==FALSE){
den=function(par,x){a=par[3]; b=par[4]; (a*b^(-a)*(x)^(a-1))/((((x)/b)^a +1)^2)}
cum=function(par,x){a=par[3]; b=par[4]; 1/(((x)/b)^(-a)+1)}
}}
if(g=="lomax"){
den=function(par,x){a=par[3]; b=par[4]; loc=par[5]; (a*b)/((1+a*(x-loc))^(b+1))}
cum=function(par,x){a=par[3]; b=par[4]; loc=par[5]; 1-(1+a*(x-loc))^(-b)}
if (location==FALSE){
den=function(par,x){a=par[3]; b=par[4]; (a*b)/((1+a*(x))^(b+1))}
cum=function(par,x){a=par[3]; b=par[4]; 1-(1+a*(x))^(-b)}
}}
if(g=="gompertz"){
den=function(par,x){a=par[3]; b=par[4]; loc=par[5]; b*exp(a*(x-loc))*exp(-(exp(a*(x-loc))-1)*b/a)}
cum=function(par,x){a=par[3]; b=par[4]; loc=par[5]; 1-exp(-(exp(a*(x-loc))-1)*b/a)}
if (location==FALSE){
den=function(par,x){a=par[3]; b=par[4]; b*exp(a*(x))*exp(-(exp(a*(x))-1)*b/a)}
cum=function(par,x){a=par[3]; b=par[4]; 1-exp(-(exp(a*(x))-1)*b/a)}
}}
if(g=="exp"){
den=function(par,x){rate=par[3]; loc=par[4]; dexp(x-loc,rate)}
cum=function(par,x){rate=par[3]; loc=par[4]; pexp(x-loc,rate)}
if (location==FALSE){
den=function(par,x){rate=par[3]; dexp(x,rate)}
cum=function(par,x){rate=par[3]; pexp(x,rate)}
}}
if(g=="rayleigh"){
den=function(par,x){a=par[3]; loc=par[4]; 2*(x-loc)/a*exp(-((x-loc)/a)^2)}
cum=function(par,x){a=par[3]; loc=par[4]; 1-exp(-((x-loc)/a)^2)}
if (location==FALSE){
den=function(par,x){a=par[3]; 2*x/a*exp(-(x/a)^2)}
cum=function(par,x){a=par[3]; 1-exp(-(x/a)^2)}
}}
if(g=="burrxii"){
den=function(par,x){a=par[3]; d=par[4]; loc=par[5]; d*a*(1+(x-loc)^d)^(-a-1)*((x-loc)^(d-1))}
cum=function(par,x){a=par[3]; d=par[4]; loc=par[5]; 1-(1+(x-loc)^d)^(-a)}
if (location==FALSE){
den=function(par,x){a=par[3]; d=par[4]; d*a*(1+(x)^d)^(-a-1)*((x)^(d-1))}
cum=function(par,x){a=par[3]; d=par[4]; 1-(1+(x)^d)^(-a)}
}}
if(g=="frechet"){
den=function(par,x){a=par[3]; b=par[4]; loc=par[5]; (a*exp(-((x-loc)/b)^(-a))*((x-loc)/b)^(-a-1))/(b)}
cum=function(par,x){a=par[3]; b=par[4]; loc=par[5]; exp(-((x-loc)/b)^(-a))}
if (location==FALSE){
den=function(par,x){a=par[3]; b=par[4]; (a*exp(-((x)/b)^(-a))*((x)/b)^(-a-1))/(b)}
cum=function(par,x){a=par[3]; b=par[4]; exp(-((x)/b)^(-a))}
}}
if(g=="birnbaum-saunders"){
den=function(par,x){a=par[3]; b=par[4]; loc=par[5]; (sqrt((x-loc)/b)+sqrt(b/(x-loc)))/(2*a*(x-loc))*dnorm((sqrt((x-loc)/b)-sqrt(b/(x-loc)))/a)}
cum=function(par,x){a=par[3]; b=par[4]; loc=par[5]; pnorm((sqrt((x-loc)/b)-sqrt(b/(x-loc)))/a)}
if (location==FALSE){
den=function(par,x){a=par[3]; b=par[4]; (sqrt((x)/b)+sqrt(b/(x)))/(2*a*(x))*dnorm((sqrt((x)/b)-sqrt(b/(x)))/a)}
cum=function(par,x){a=par[3]; b=par[4]; pnorm((sqrt((x)/b)-sqrt(b/(x)))/a)}
}}
if(g=="weibull"){
den=function(par,x){shape=par[3]; scale=par[4]; loc=par[5]; dweibull(x-loc,shape,scale)}
cum=function(par,x){shape=par[3]; scale=par[4]; loc=par[5]; pweibull(x-loc,shape,scale)}
if (location==FALSE){
den=function(par,x){shape=par[3]; scale=par[4]; dweibull(x,shape,scale)}
cum=function(par,x){shape=par[3]; scale=par[4]; pweibull(x,shape,scale)}
}}
if(g=="gamma"){
den=function(par,x){shape=par[3]; scale=par[4]; loc=par[5]; dgamma(x-loc,shape,scale)}
cum=function(par,x){shape=par[3]; scale=par[4]; loc=par[5]; pgamma(x-loc,shape,scale)}
if (location==FALSE){
den=function(par,x){shape=par[3]; scale=par[4]; dgamma(x,shape,scale)}
cum=function(par,x){shape=par[3]; scale=par[4]; pgamma(x,shape,scale)}
}}
cdf0<-function(par,x){
f0=den(par,x)
c0=cum(par,x)
a=par[1]
b=par[2]
(1-exp(-b))^(-1)*(1-exp(-b*c0^a))
}
cdf<-cdf0(param,mydata)
if(log.p==TRUE & lower.tail == FALSE) cdf<-log(1-cdf)
if(log.p==TRUE & lower.tail == TRUE) cdf<-log(cdf)
if(log.p==FALSE & lower.tail == FALSE) cdf<-1-cdf
return(cdf)
}
dexpexppg<-function(mydata, g, param, location=TRUE, log=FALSE){
if(g!="birnbaum-saunders" & g!="exp" & g!="rayleigh" & g!="weibull" & g!="gompertz" & g!="gamma"
& g!="log-normal" & g!="chisq" & g!="f" & g!="burrxii" & g!="frechet"
& g!="lomax" & g!="log-logistic" & g!="lfr" & g!="chen")
{ stop ("Baseline distribution not implemented or misspelled. Please check the manual for guidelines.") }
if(g=="log-normal"){
den=function(par,x){meanlog=par[3]; sdlog=par[4]; loc=par[5]; dlnorm(x-loc,meanlog,sdlog)}
cum=function(par,x){meanlog=par[3]; sdlog=par[4]; loc=par[5]; plnorm(x-loc,meanlog,sdlog)}
if (location==FALSE){
den=function(par,x){meanlog=par[3]; sdlog=par[4]; dlnorm(x,meanlog,sdlog)}
cum=function(par,x){meanlog=par[3]; sdlog=par[4]; plnorm(x,meanlog,sdlog)}
}}
if(g=="chisq"){
den=function(par,x){df=par[3]; loc=par[4]; dchisq(x-loc,df)}
cum=function(par,x){df=par[3]; loc=par[4]; pchisq(x-loc,df)}
if (location==FALSE){
den=function(par,x){df=par[3]; dchisq(x,df)}
cum=function(par,x){df=par[3]; pchisq(x,df)}
}}
if(g=="f"){
den=function(par,x){df1=par[3]; df2=par[4]; loc=par[5]; df(x-loc,df1,df2)}
cum=function(par,x){df1=par[3]; df2=par[4]; loc=par[5]; pf(x-loc,df1,df2)}
if (location==FALSE){
den=function(par,x){df1=par[3]; df2=par[4]; df(x,df1,df2)}
cum=function(par,x){df1=par[3]; df2=par[4]; pf(x,df1,df2)}
}}
if(g=="chen"){
den=function(par,x){a=par[3]; b=par[4]; loc=par[5]; a*b*(x-loc)^(a-1)*exp((x-loc)^a)*exp(-b*(exp((x-loc)^a)-1))}
cum=function(par,x){a=par[3]; b=par[4]; loc=par[5]; 1-exp(-b*(exp((x-loc)^a)-1))}
if (location==FALSE){
den=function(par,x){a=par[3]; b=par[4]; a*b*(x)^(a-1)*exp((x)^a)*exp(-b*(exp((x)^a)-1))}
cum=function(par,x){a=par[3]; b=par[4]; 1-exp(-b*(exp((x)^a)-1))}
}}
if(g=="lfr"){
den=function(par,x){a=par[3]; b=par[4]; loc=par[5]; (a+b*(x-loc))*exp(-a*(x-loc)-(b*(x-loc)^2)/2)}
cum=function(par,x){a=par[3]; b=par[4]; loc=par[5]; 1-exp(-a*(x-loc)-(b*(x-loc)^2)/2)}
if (location==FALSE){
den=function(par,x){a=par[3]; b=par[4]; (a+b*(x))*exp(-a*(x)-(b*(x)^2)/2)}
cum=function(par,x){a=par[3]; b=par[4]; 1-exp(-a*(x)-(b*(x)^2)/2)}
}}
if(g=="log-logistic"){
den=function(par,x){a=par[3]; b=par[4]; loc=par[5]; (a*b^(-a)*(x-loc)^(a-1))/((((x-loc)/b)^a +1)^2)}
cum=function(par,x){a=par[3]; b=par[4]; loc=par[5]; 1/(((x-loc)/b)^(-a)+1)}
if (location==FALSE){
den=function(par,x){a=par[3]; b=par[4]; (a*b^(-a)*(x)^(a-1))/((((x)/b)^a +1)^2)}
cum=function(par,x){a=par[3]; b=par[4]; 1/(((x)/b)^(-a)+1)}
}}
if(g=="lomax"){
den=function(par,x){a=par[3]; b=par[4]; loc=par[5]; (a*b)/((1+a*(x-loc))^(b+1))}
cum=function(par,x){a=par[3]; b=par[4]; loc=par[5]; 1-(1+a*(x-loc))^(-b)}
if (location==FALSE){
den=function(par,x){a=par[3]; b=par[4]; (a*b)/((1+a*(x))^(b+1))}
cum=function(par,x){a=par[3]; b=par[4]; 1-(1+a*(x))^(-b)}
}}
if(g=="gompertz"){
den=function(par,x){a=par[3]; b=par[4]; loc=par[5]; b*exp(a*(x-loc))*exp(-(exp(a*(x-loc))-1)*b/a)}
cum=function(par,x){a=par[3]; b=par[4]; loc=par[5]; 1-exp(-(exp(a*(x-loc))-1)*b/a)}
if (location==FALSE){
den=function(par,x){a=par[3]; b=par[4]; b*exp(a*(x))*exp(-(exp(a*(x))-1)*b/a)}
cum=function(par,x){a=par[3]; b=par[4]; 1-exp(-(exp(a*(x))-1)*b/a)}
}}
if(g=="exp"){
den=function(par,x){rate=par[3]; loc=par[4]; dexp(x-loc,rate)}
cum=function(par,x){rate=par[3]; loc=par[4]; pexp(x-loc,rate)}
if (location==FALSE){
den=function(par,x){rate=par[3]; dexp(x,rate)}
cum=function(par,x){rate=par[3]; pexp(x,rate)}
}}
if(g=="rayleigh"){
den=function(par,x){a=par[3]; loc=par[4]; 2*(x-loc)/a*exp(-((x-loc)/a)^2)}
cum=function(par,x){a=par[3]; loc=par[4]; 1-exp(-((x-loc)/a)^2)}
if (location==FALSE){
den=function(par,x){a=par[3]; 2*x/a*exp(-(x/a)^2)}
cum=function(par,x){a=par[3]; 1-exp(-(x/a)^2)}
}}
if(g=="burrxii"){
den=function(par,x){a=par[3]; d=par[4]; loc=par[5]; d*a*(1+(x-loc)^d)^(-a-1)*((x-loc)^(d-1))}
cum=function(par,x){a=par[3]; d=par[4]; loc=par[5]; 1-(1+(x-loc)^d)^(-a)}
if (location==FALSE){
den=function(par,x){a=par[3]; d=par[4]; d*a*(1+(x)^d)^(-a-1)*((x)^(d-1))}
cum=function(par,x){a=par[3]; d=par[4]; 1-(1+(x)^d)^(-a)}
}}
if(g=="frechet"){
den=function(par,x){a=par[3]; b=par[4]; loc=par[5]; (a*exp(-((x-loc)/b)^(-a))*((x-loc)/b)^(-a-1))/(b)}
cum=function(par,x){a=par[3]; b=par[4]; loc=par[5]; exp(-((x-loc)/b)^(-a))}
if (location==FALSE){
den=function(par,x){a=par[3]; b=par[4]; (a*exp(-((x)/b)^(-a))*((x)/b)^(-a-1))/(b)}
cum=function(par,x){a=par[3]; b=par[4]; exp(-((x)/b)^(-a))}
}}
if(g=="birnbaum-saunders"){
den=function(par,x){a=par[3]; b=par[4]; loc=par[5]; (sqrt((x-loc)/b)+sqrt(b/(x-loc)))/(2*a*(x-loc))*dnorm((sqrt((x-loc)/b)-sqrt(b/(x-loc)))/a)}
cum=function(par,x){a=par[3]; b=par[4]; loc=par[5]; pnorm((sqrt((x-loc)/b)-sqrt(b/(x-loc)))/a)}
if (location==FALSE){
den=function(par,x){a=par[3]; b=par[4]; (sqrt((x)/b)+sqrt(b/(x)))/(2*a*(x))*dnorm((sqrt((x)/b)-sqrt(b/(x)))/a)}
cum=function(par,x){a=par[3]; b=par[4]; pnorm((sqrt((x)/b)-sqrt(b/(x)))/a)}
}}
if(g=="weibull"){
den=function(par,x){shape=par[3]; scale=par[4]; loc=par[5]; dweibull(x-loc,shape,scale)}
cum=function(par,x){shape=par[3]; scale=par[4]; loc=par[5]; pweibull(x-loc,shape,scale)}
if (location==FALSE){
den=function(par,x){shape=par[3]; scale=par[4]; dweibull(x,shape,scale)}
cum=function(par,x){shape=par[3]; scale=par[4]; pweibull(x,shape,scale)}
}}
if(g=="gamma"){
den=function(par,x){shape=par[3]; scale=par[4]; loc=par[5]; dgamma(x-loc,shape,scale)}
cum=function(par,x){shape=par[3]; scale=par[4]; loc=par[5]; pgamma(x-loc,shape,scale)}
if (location==FALSE){
den=function(par,x){shape=par[3]; scale=par[4]; dgamma(x,shape,scale)}
cum=function(par,x){shape=par[3]; scale=par[4]; pgamma(x,shape,scale)}
}}
pdf0<-function(par,x){
f0=den(par,x)
c0=cum(par,x)
a=par[1]
b=par[2]
a*b*(1-exp(-b))^(-1)*f0*c0^(a-1)*exp(-b*c0^a)
}
pdf<-pdf0(param,mydata)
if(log==TRUE){pdf<-log(pdf)}
return(pdf)
}
pexpgg<-function(mydata, g, param, location=TRUE, log.p = FALSE, lower.tail = TRUE){
if(g!="birnbaum-saunders" & g!="exp" & g!="rayleigh" & g!="weibull" & g!="gompertz" & g!="gamma"
& g!="log-normal" & g!="chisq" & g!="f" & g!="burrxii" & g!="frechet"
& g!="lomax" & g!="log-logistic" & g!="lfr" & g!="chen")
{ stop ("Baseline distribution not implemented or misspelled. Please check the manual for guidelines.") }
if(g=="log-normal"){
den=function(par,x){meanlog=par[3]; sdlog=par[4]; loc=par[5]; dlnorm(x-loc,meanlog,sdlog)}
cum=function(par,x){meanlog=par[3]; sdlog=par[4]; loc=par[5]; plnorm(x-loc,meanlog,sdlog)}
if (location==FALSE){
den=function(par,x){meanlog=par[3]; sdlog=par[4]; dlnorm(x,meanlog,sdlog)}
cum=function(par,x){meanlog=par[3]; sdlog=par[4]; plnorm(x,meanlog,sdlog)}
}}
if(g=="chisq"){
den=function(par,x){df=par[3]; loc=par[4]; dchisq(x-loc,df)}
cum=function(par,x){df=par[3]; loc=par[4]; pchisq(x-loc,df)}
if (location==FALSE){
den=function(par,x){df=par[3]; dchisq(x,df)}
cum=function(par,x){df=par[3]; pchisq(x,df)}
}}
if(g=="f"){
den=function(par,x){df1=par[3]; df2=par[4]; loc=par[5]; df(x-loc,df1,df2)}
cum=function(par,x){df1=par[3]; df2=par[4]; loc=par[5]; pf(x-loc,df1,df2)}
if (location==FALSE){
den=function(par,x){df1=par[3]; df2=par[4]; df(x,df1,df2)}
cum=function(par,x){df1=par[3]; df2=par[4]; pf(x,df1,df2)}
}}
if(g=="chen"){
den=function(par,x){a=par[3]; b=par[4]; loc=par[5]; a*b*(x-loc)^(a-1)*exp((x-loc)^a)*exp(-b*(exp((x-loc)^a)-1))}
cum=function(par,x){a=par[3]; b=par[4]; loc=par[5]; 1-exp(-b*(exp((x-loc)^a)-1))}
if (location==FALSE){
den=function(par,x){a=par[3]; b=par[4]; a*b*(x)^(a-1)*exp((x)^a)*exp(-b*(exp((x)^a)-1))}
cum=function(par,x){a=par[3]; b=par[4]; 1-exp(-b*(exp((x)^a)-1))}
}}
if(g=="lfr"){
den=function(par,x){a=par[3]; b=par[4]; loc=par[5]; (a+b*(x-loc))*exp(-a*(x-loc)-(b*(x-loc)^2)/2)}
cum=function(par,x){a=par[3]; b=par[4]; loc=par[5]; 1-exp(-a*(x-loc)-(b*(x-loc)^2)/2)}
if (location==FALSE){
den=function(par,x){a=par[3]; b=par[4]; (a+b*(x))*exp(-a*(x)-(b*(x)^2)/2)}
cum=function(par,x){a=par[3]; b=par[4]; 1-exp(-a*(x)-(b*(x)^2)/2)}
}}
if(g=="log-logistic"){
den=function(par,x){a=par[3]; b=par[4]; loc=par[5]; (a*b^(-a)*(x-loc)^(a-1))/((((x-loc)/b)^a +1)^2)}
cum=function(par,x){a=par[3]; b=par[4]; loc=par[5]; 1/(((x-loc)/b)^(-a)+1)}
if (location==FALSE){
den=function(par,x){a=par[3]; b=par[4]; (a*b^(-a)*(x)^(a-1))/((((x)/b)^a +1)^2)}
cum=function(par,x){a=par[3]; b=par[4]; 1/(((x)/b)^(-a)+1)}
}}
if(g=="lomax"){
den=function(par,x){a=par[3]; b=par[4]; loc=par[5]; (a*b)/((1+a*(x-loc))^(b+1))}
cum=function(par,x){a=par[3]; b=par[4]; loc=par[5]; 1-(1+a*(x-loc))^(-b)}
if (location==FALSE){
den=function(par,x){a=par[3]; b=par[4]; (a*b)/((1+a*(x))^(b+1))}
cum=function(par,x){a=par[3]; b=par[4]; 1-(1+a*(x))^(-b)}
}}
if(g=="gompertz"){
den=function(par,x){a=par[3]; b=par[4]; loc=par[5]; b*exp(a*(x-loc))*exp(-(exp(a*(x-loc))-1)*b/a)}
cum=function(par,x){a=par[3]; b=par[4]; loc=par[5]; 1-exp(-(exp(a*(x-loc))-1)*b/a)}
if (location==FALSE){
den=function(par,x){a=par[3]; b=par[4]; b*exp(a*(x))*exp(-(exp(a*(x))-1)*b/a)}
cum=function(par,x){a=par[3]; b=par[4]; 1-exp(-(exp(a*(x))-1)*b/a)}
}}
if(g=="exp"){
den=function(par,x){rate=par[3]; loc=par[4]; dexp(x-loc,rate)}
cum=function(par,x){rate=par[3]; loc=par[4]; pexp(x-loc,rate)}
if (location==FALSE){
den=function(par,x){rate=par[3]; dexp(x,rate)}
cum=function(par,x){rate=par[3]; pexp(x,rate)}
}}
if(g=="rayleigh"){
den=function(par,x){a=par[3]; loc=par[4]; 2*(x-loc)/a*exp(-((x-loc)/a)^2)}
cum=function(par,x){a=par[3]; loc=par[4]; 1-exp(-((x-loc)/a)^2)}
if (location==FALSE){
den=function(par,x){a=par[3]; 2*x/a*exp(-(x/a)^2)}
cum=function(par,x){a=par[3]; 1-exp(-(x/a)^2)}
}}
if(g=="burrxii"){
den=function(par,x){a=par[3]; d=par[4]; loc=par[5]; d*a*(1+(x-loc)^d)^(-a-1)*((x-loc)^(d-1))}
cum=function(par,x){a=par[3]; d=par[4]; loc=par[5]; 1-(1+(x-loc)^d)^(-a)}
if (location==FALSE){
den=function(par,x){a=par[3]; d=par[4]; d*a*(1+(x)^d)^(-a-1)*((x)^(d-1))}
cum=function(par,x){a=par[3]; d=par[4]; 1-(1+(x)^d)^(-a)}
}}
if(g=="frechet"){
den=function(par,x){a=par[3]; b=par[4]; loc=par[5]; (a*exp(-((x-loc)/b)^(-a))*((x-loc)/b)^(-a-1))/(b)}
cum=function(par,x){a=par[3]; b=par[4]; loc=par[5]; exp(-((x-loc)/b)^(-a))}
if (location==FALSE){
den=function(par,x){a=par[3]; b=par[4]; (a*exp(-((x)/b)^(-a))*((x)/b)^(-a-1))/(b)}
cum=function(par,x){a=par[3]; b=par[4]; exp(-((x)/b)^(-a))}
}}
if(g=="birnbaum-saunders"){
den=function(par,x){a=par[3]; b=par[4]; loc=par[5]; (sqrt((x-loc)/b)+sqrt(b/(x-loc)))/(2*a*(x-loc))*dnorm((sqrt((x-loc)/b)-sqrt(b/(x-loc)))/a)}
cum=function(par,x){a=par[3]; b=par[4]; loc=par[5]; pnorm((sqrt((x-loc)/b)-sqrt(b/(x-loc)))/a)}
if (location==FALSE){
den=function(par,x){a=par[3]; b=par[4]; (sqrt((x)/b)+sqrt(b/(x)))/(2*a*(x))*dnorm((sqrt((x)/b)-sqrt(b/(x)))/a)}
cum=function(par,x){a=par[3]; b=par[4]; pnorm((sqrt((x)/b)-sqrt(b/(x)))/a)}
}}
if(g=="weibull"){
den=function(par,x){shape=par[3]; scale=par[4]; loc=par[5]; dweibull(x-loc,shape,scale)}
cum=function(par,x){shape=par[3]; scale=par[4]; loc=par[5]; pweibull(x-loc,shape,scale)}
if (location==FALSE){
den=function(par,x){shape=par[3]; scale=par[4]; dweibull(x,shape,scale)}
cum=function(par,x){shape=par[3]; scale=par[4]; pweibull(x,shape,scale)}
}}
if(g=="gamma"){
den=function(par,x){shape=par[3]; scale=par[4]; loc=par[5]; dgamma(x-loc,shape,scale)}
cum=function(par,x){shape=par[3]; scale=par[4]; loc=par[5]; pgamma(x-loc,shape,scale)}
if (location==FALSE){
den=function(par,x){shape=par[3]; scale=par[4]; dgamma(x,shape,scale)}
cum=function(par,x){shape=par[3]; scale=par[4]; pgamma(x,shape,scale)}
}}
cdf0<-function(par,x){
f0=den(par,x)
c0=cum(par,x)
r=par[1]
u=par[2]
(1-(1-c0)^r)^u
}
cdf<-cdf0(param,mydata)
if(log.p==TRUE & lower.tail == FALSE) cdf<-log(1-cdf)
if(log.p==TRUE & lower.tail == TRUE) cdf<-log(cdf)
if(log.p==FALSE & lower.tail == FALSE) cdf<-1-cdf
return(cdf)
}
dexpgg<-function(mydata, g, param, location=TRUE, log=FALSE){
if(g!="birnbaum-saunders" & g!="exp" & g!="rayleigh" & g!="weibull" & g!="gompertz" & g!="gamma"
& g!="log-normal" & g!="chisq" & g!="f" & g!="burrxii" & g!="frechet"
& g!="lomax" & g!="log-logistic" & g!="lfr" & g!="chen")
{ stop ("Baseline distribution not implemented or misspelled. Please check the manual for guidelines.") }
if(g=="log-normal"){
den=function(par,x){meanlog=par[3]; sdlog=par[4]; loc=par[5]; dlnorm(x-loc,meanlog,sdlog)}
cum=function(par,x){meanlog=par[3]; sdlog=par[4]; loc=par[5]; plnorm(x-loc,meanlog,sdlog)}
if (location==FALSE){
den=function(par,x){meanlog=par[3]; sdlog=par[4]; dlnorm(x,meanlog,sdlog)}
cum=function(par,x){meanlog=par[3]; sdlog=par[4]; plnorm(x,meanlog,sdlog)}
}}
if(g=="chisq"){
den=function(par,x){df=par[3]; loc=par[4]; dchisq(x-loc,df)}
cum=function(par,x){df=par[3]; loc=par[4]; pchisq(x-loc,df)}
if (location==FALSE){
den=function(par,x){df=par[3]; dchisq(x,df)}
cum=function(par,x){df=par[3]; pchisq(x,df)}
}}
if(g=="f"){
den=function(par,x){df1=par[3]; df2=par[4]; loc=par[5]; df(x-loc,df1,df2)}
cum=function(par,x){df1=par[3]; df2=par[4]; loc=par[5]; pf(x-loc,df1,df2)}
if (location==FALSE){
den=function(par,x){df1=par[3]; df2=par[4]; df(x,df1,df2)}
cum=function(par,x){df1=par[3]; df2=par[4]; pf(x,df1,df2)}
}}
if(g=="chen"){
den=function(par,x){a=par[3]; b=par[4]; loc=par[5]; a*b*(x-loc)^(a-1)*exp((x-loc)^a)*exp(-b*(exp((x-loc)^a)-1))}
cum=function(par,x){a=par[3]; b=par[4]; loc=par[5]; 1-exp(-b*(exp((x-loc)^a)-1))}
if (location==FALSE){
den=function(par,x){a=par[3]; b=par[4]; a*b*(x)^(a-1)*exp((x)^a)*exp(-b*(exp((x)^a)-1))}
cum=function(par,x){a=par[3]; b=par[4]; 1-exp(-b*(exp((x)^a)-1))}
}}
if(g=="lfr"){
den=function(par,x){a=par[3]; b=par[4]; loc=par[5]; (a+b*(x-loc))*exp(-a*(x-loc)-(b*(x-loc)^2)/2)}
cum=function(par,x){a=par[3]; b=par[4]; loc=par[5]; 1-exp(-a*(x-loc)-(b*(x-loc)^2)/2)}
if (location==FALSE){
den=function(par,x){a=par[3]; b=par[4]; (a+b*(x))*exp(-a*(x)-(b*(x)^2)/2)}
cum=function(par,x){a=par[3]; b=par[4]; 1-exp(-a*(x)-(b*(x)^2)/2)}
}}
if(g=="log-logistic"){
den=function(par,x){a=par[3]; b=par[4]; loc=par[5]; (a*b^(-a)*(x-loc)^(a-1))/((((x-loc)/b)^a +1)^2)}
cum=function(par,x){a=par[3]; b=par[4]; loc=par[5]; 1/(((x-loc)/b)^(-a)+1)}
if (location==FALSE){
den=function(par,x){a=par[3]; b=par[4]; (a*b^(-a)*(x)^(a-1))/((((x)/b)^a +1)^2)}
cum=function(par,x){a=par[3]; b=par[4]; 1/(((x)/b)^(-a)+1)}
}}
if(g=="lomax"){
den=function(par,x){a=par[3]; b=par[4]; loc=par[5]; (a*b)/((1+a*(x-loc))^(b+1))}
cum=function(par,x){a=par[3]; b=par[4]; loc=par[5]; 1-(1+a*(x-loc))^(-b)}
if (location==FALSE){
den=function(par,x){a=par[3]; b=par[4]; (a*b)/((1+a*(x))^(b+1))}
cum=function(par,x){a=par[3]; b=par[4]; 1-(1+a*(x))^(-b)}
}}
if(g=="gompertz"){
den=function(par,x){a=par[3]; b=par[4]; loc=par[5]; b*exp(a*(x-loc))*exp(-(exp(a*(x-loc))-1)*b/a)}
cum=function(par,x){a=par[3]; b=par[4]; loc=par[5]; 1-exp(-(exp(a*(x-loc))-1)*b/a)}
if (location==FALSE){
den=function(par,x){a=par[3]; b=par[4]; b*exp(a*(x))*exp(-(exp(a*(x))-1)*b/a)}
cum=function(par,x){a=par[3]; b=par[4]; 1-exp(-(exp(a*(x))-1)*b/a)}
}}
if(g=="exp"){
den=function(par,x){rate=par[3]; loc=par[4]; dexp(x-loc,rate)}
cum=function(par,x){rate=par[3]; loc=par[4]; pexp(x-loc,rate)}
if (location==FALSE){
den=function(par,x){rate=par[3]; dexp(x,rate)}
cum=function(par,x){rate=par[3]; pexp(x,rate)}
}}
if(g=="rayleigh"){
den=function(par,x){a=par[3]; loc=par[4]; 2*(x-loc)/a*exp(-((x-loc)/a)^2)}
cum=function(par,x){a=par[3]; loc=par[4]; 1-exp(-((x-loc)/a)^2)}
if (location==FALSE){
den=function(par,x){a=par[3]; 2*x/a*exp(-(x/a)^2)}
cum=function(par,x){a=par[3]; 1-exp(-(x/a)^2)}
}}
if(g=="burrxii"){
den=function(par,x){a=par[3]; d=par[4]; loc=par[5]; d*a*(1+(x-loc)^d)^(-a-1)*((x-loc)^(d-1))}
cum=function(par,x){a=par[3]; d=par[4]; loc=par[5]; 1-(1+(x-loc)^d)^(-a)}
if (location==FALSE){
den=function(par,x){a=par[3]; d=par[4]; d*a*(1+(x)^d)^(-a-1)*((x)^(d-1))}
cum=function(par,x){a=par[3]; d=par[4]; 1-(1+(x)^d)^(-a)}
}}
if(g=="frechet"){
den=function(par,x){a=par[3]; b=par[4]; loc=par[5]; (a*exp(-((x-loc)/b)^(-a))*((x-loc)/b)^(-a-1))/(b)}
cum=function(par,x){a=par[3]; b=par[4]; loc=par[5]; exp(-((x-loc)/b)^(-a))}
if (location==FALSE){
den=function(par,x){a=par[3]; b=par[4]; (a*exp(-((x)/b)^(-a))*((x)/b)^(-a-1))/(b)}
cum=function(par,x){a=par[3]; b=par[4]; exp(-((x)/b)^(-a))}
}}
if(g=="birnbaum-saunders"){
den=function(par,x){a=par[3]; b=par[4]; loc=par[5]; (sqrt((x-loc)/b)+sqrt(b/(x-loc)))/(2*a*(x-loc))*dnorm((sqrt((x-loc)/b)-sqrt(b/(x-loc)))/a)}
cum=function(par,x){a=par[3]; b=par[4]; loc=par[5]; pnorm((sqrt((x-loc)/b)-sqrt(b/(x-loc)))/a)}
if (location==FALSE){
den=function(par,x){a=par[3]; b=par[4]; (sqrt((x)/b)+sqrt(b/(x)))/(2*a*(x))*dnorm((sqrt((x)/b)-sqrt(b/(x)))/a)}
cum=function(par,x){a=par[3]; b=par[4]; pnorm((sqrt((x)/b)-sqrt(b/(x)))/a)}
}}
if(g=="weibull"){
den=function(par,x){shape=par[3]; scale=par[4]; loc=par[5]; dweibull(x-loc,shape,scale)}
cum=function(par,x){shape=par[3]; scale=par[4]; loc=par[5]; pweibull(x-loc,shape,scale)}
if (location==FALSE){
den=function(par,x){shape=par[3]; scale=par[4]; dweibull(x,shape,scale)}
cum=function(par,x){shape=par[3]; scale=par[4]; pweibull(x,shape,scale)}
}}
if(g=="gamma"){
den=function(par,x){shape=par[3]; scale=par[4]; loc=par[5]; dgamma(x-loc,shape,scale)}
cum=function(par,x){shape=par[3]; scale=par[4]; loc=par[5]; pgamma(x-loc,shape,scale)}
if (location==FALSE){
den=function(par,x){shape=par[3]; scale=par[4]; dgamma(x,shape,scale)}
cum=function(par,x){shape=par[3]; scale=par[4]; pgamma(x,shape,scale)}
}}
pdf0<-function(par,x){
f0=den(par,x)
c0=cum(par,x)
r=par[1]
u=par[2]
r*u*f0*((1-c0)^(r-1))*(1-(1-c0)^r)^(u-1)
}
pdf<-pdf0(param,mydata)
if(log==TRUE){pdf<-log(pdf)}
return(pdf)
}
pexpg<-function(mydata, g, param, location=TRUE, log.p = FALSE, lower.tail = TRUE){
if(g!="birnbaum-saunders" & g!="exp" & g!="rayleigh" & g!="weibull" & g!="gompertz" & g!="gamma"
& g!="log-normal" & g!="chisq" & g!="f" & g!="burrxii" & g!="frechet"
& g!="lomax" & g!="log-logistic" & g!="lfr" & g!="chen")
{ stop ("Baseline distribution not implemented or misspelled. Please check the manual for guidelines.") }
if(g=="log-normal"){
den=function(par,x){meanlog=par[2]; sdlog=par[3]; loc=par[4]; dlnorm(x-loc,meanlog,sdlog)}
cum=function(par,x){meanlog=par[2]; sdlog=par[3]; loc=par[4]; plnorm(x-loc,meanlog,sdlog)}
if (location==FALSE){
den=function(par,x){meanlog=par[2]; sdlog=par[3]; dlnorm(x,meanlog,sdlog)}
cum=function(par,x){meanlog=par[2]; sdlog=par[3]; plnorm(x,meanlog,sdlog)}
}}
if(g=="chisq"){
den=function(par,x){df=par[2]; loc=par[3]; dchisq(x-loc,df)}
cum=function(par,x){df=par[2]; loc=par[3]; pchisq(x-loc,df)}
if (location==FALSE){
den=function(par,x){df=par[2]; dchisq(x,df)}
cum=function(par,x){df=par[2]; pchisq(x,df)}
}}
if(g=="f"){
den=function(par,x){df1=par[2]; df2=par[3]; loc=par[4]; df(x-loc,df1,df2)}
cum=function(par,x){df1=par[2]; df2=par[3]; loc=par[4]; pf(x-loc,df1,df2)}
if (location==FALSE){
den=function(par,x){df1=par[2]; df2=par[3]; df(x,df1,df2)}
cum=function(par,x){df1=par[2]; df2=par[3]; pf(x,df1,df2)}
}}
if(g=="chen"){
den=function(par,x){a=par[2]; b=par[3]; loc=par[4]; a*b*(x-loc)^(a-1)*exp((x-loc)^a)*exp(-b*(exp((x-loc)^a)-1))}
cum=function(par,x){a=par[2]; b=par[3]; loc=par[4]; 1-exp(-b*(exp((x-loc)^a)-1))}
if (location==FALSE){
den=function(par,x){a=par[2]; b=par[3]; a*b*(x)^(a-1)*exp((x)^a)*exp(-b*(exp((x)^a)-1))}
cum=function(par,x){a=par[2]; b=par[3]; 1-exp(-b*(exp((x)^a)-1))}
}}
if(g=="lfr"){
den=function(par,x){a=par[2]; b=par[3]; loc=par[4]; (a+b*(x-loc))*exp(-a*(x-loc)-(b*(x-loc)^2)/2)}
cum=function(par,x){a=par[2]; b=par[3]; loc=par[4]; 1-exp(-a*(x-loc)-(b*(x-loc)^2)/2)}
if (location==FALSE){
den=function(par,x){a=par[2]; b=par[3]; (a+b*(x))*exp(-a*(x)-(b*(x)^2)/2)}
cum=function(par,x){a=par[2]; b=par[3]; 1-exp(-a*(x)-(b*(x)^2)/2)}
}}
if(g=="log-logistic"){
den=function(par,x){a=par[2]; b=par[3]; loc=par[4]; (a*b^(-a)*(x-loc)^(a-1))/((((x-loc)/b)^a +1)^2)}
cum=function(par,x){a=par[2]; b=par[3]; loc=par[4]; 1/(((x-loc)/b)^(-a)+1)}
if (location==FALSE){
den=function(par,x){a=par[2]; b=par[3]; (a*b^(-a)*(x)^(a-1))/((((x)/b)^a +1)^2)}
cum=function(par,x){a=par[2]; b=par[3]; 1/(((x)/b)^(-a)+1)}
}}
if(g=="lomax"){
den=function(par,x){a=par[2]; b=par[3]; loc=par[4]; (a*b)/((1+a*(x-loc))^(b+1))}
cum=function(par,x){a=par[2]; b=par[3]; loc=par[4]; 1-(1+a*(x-loc))^(-b)}
if (location==FALSE){
den=function(par,x){a=par[2]; b=par[3]; (a*b)/((1+a*(x))^(b+1))}
cum=function(par,x){a=par[2]; b=par[3]; 1-(1+a*(x))^(-b)}
}}
if(g=="gompertz"){
den=function(par,x){a=par[2]; b=par[3]; loc=par[4]; b*exp(a*(x-loc))*exp(-(exp(a*(x-loc))-1)*b/a)}
cum=function(par,x){a=par[2]; b=par[3]; loc=par[4]; 1-exp(-(exp(a*(x-loc))-1)*b/a)}
if (location==FALSE){
den=function(par,x){a=par[2]; b=par[3]; b*exp(a*(x))*exp(-(exp(a*(x))-1)*b/a)}
cum=function(par,x){a=par[2]; b=par[3]; 1-exp(-(exp(a*(x))-1)*b/a)}
}}
if(g=="exp"){
den=function(par,x){rate=par[2]; loc=par[3]; dexp(x-loc,rate)}
cum=function(par,x){rate=par[2]; loc=par[3]; pexp(x-loc,rate)}
if (location==FALSE){
den=function(par,x){rate=par[2]; dexp(x,rate)}
cum=function(par,x){rate=par[2]; pexp(x,rate)}
}}
if(g=="rayleigh"){
den=function(par,x){a=par[2]; loc=par[3]; 2*(x-loc)/a*exp(-((x-loc)/a)^2)}
cum=function(par,x){a=par[2]; loc=par[3]; 1-exp(-((x-loc)/a)^2)}
if (location==FALSE){
den=function(par,x){a=par[2]; 2*x/a*exp(-(x/a)^2)}
cum=function(par,x){a=par[2]; 1-exp(-(x/a)^2)}
}}
if(g=="burrxii"){
den=function(par,x){a=par[2]; d=par[3]; loc=par[4]; d*a*(1+(x-loc)^d)^(-a-1)*((x-loc)^(d-1))}
cum=function(par,x){a=par[2]; d=par[3]; loc=par[4]; 1-(1+(x-loc)^d)^(-a)}
if (location==FALSE){
den=function(par,x){a=par[2]; d=par[3]; d*a*(1+(x)^d)^(-a-1)*((x)^(d-1))}
cum=function(par,x){a=par[2]; d=par[3]; 1-(1+(x)^d)^(-a)}
}}
if(g=="frechet"){
den=function(par,x){a=par[2]; b=par[3]; loc=par[4]; (a*exp(-((x-loc)/b)^(-a))*((x-loc)/b)^(-a-1))/(b)}
cum=function(par,x){a=par[2]; b=par[3]; loc=par[4]; exp(-((x-loc)/b)^(-a))}
if (location==FALSE){
den=function(par,x){a=par[2]; b=par[3]; (a*exp(-((x)/b)^(-a))*((x)/b)^(-a-1))/(b)}
cum=function(par,x){a=par[2]; b=par[3]; exp(-((x)/b)^(-a))}
}}
if(g=="birnbaum-saunders"){
den=function(par,x){a=par[2]; b=par[3]; loc=par[4]; (sqrt((x-loc)/b)+sqrt(b/(x-loc)))/(2*a*(x-loc))*dnorm((sqrt((x-loc)/b)-sqrt(b/(x-loc)))/a)}
cum=function(par,x){a=par[2]; b=par[3]; loc=par[4]; pnorm((sqrt((x-loc)/b)-sqrt(b/(x-loc)))/a)}
if (location==FALSE){
den=function(par,x){a=par[2]; b=par[3]; (sqrt((x)/b)+sqrt(b/(x)))/(2*a*(x))*dnorm((sqrt((x)/b)-sqrt(b/(x)))/a)}
cum=function(par,x){a=par[2]; b=par[3]; pnorm((sqrt((x)/b)-sqrt(b/(x)))/a)}
}}
if(g=="weibull"){
den=function(par,x){shape=par[2]; scale=par[3]; loc=par[4]; dweibull(x-loc,shape,scale)}
cum=function(par,x){shape=par[2]; scale=par[3]; loc=par[4]; pweibull(x-loc,shape,scale)}
if (location==FALSE){
den=function(par,x){shape=par[2]; scale=par[3]; dweibull(x,shape,scale)}
cum=function(par,x){shape=par[2]; scale=par[3]; pweibull(x,shape,scale)}
}}
if(g=="gamma"){
den=function(par,x){shape=par[2]; scale=par[3]; loc=par[4]; dgamma(x-loc,shape,scale)}
cum=function(par,x){shape=par[2]; scale=par[3]; loc=par[4]; pgamma(x-loc,shape,scale)}
if (location==FALSE){
den=function(par,x){shape=par[2]; scale=par[3]; dgamma(x,shape,scale)}
cum=function(par,x){shape=par[2]; scale=par[3]; pgamma(x,shape,scale)}
}}
cdf0<-function(par,x){
f0=den(par,x)
c0=cum(par,x)
a=par[1]
c0^a
}
cdf<-cdf0(param,mydata)
if(log.p==TRUE & lower.tail == FALSE) cdf<-log(1-cdf)
if(log.p==TRUE & lower.tail == TRUE) cdf<-log(cdf)
if(log.p==FALSE & lower.tail == FALSE) cdf<-1-cdf
return(cdf)
}
dexpg<-function(mydata, g, param, location=TRUE, log=FALSE){
if(g!="birnbaum-saunders" & g!="exp" & g!="rayleigh" & g!="weibull" & g!="gompertz" & g!="gamma"
& g!="log-normal" & g!="chisq" & g!="f" & g!="burrxii" & g!="frechet"
& g!="lomax" & g!="log-logistic" & g!="lfr" & g!="chen")
{ stop ("Baseline distribution not implemented or misspelled. Please check the manual for guidelines.") }
if(g=="log-normal"){
den=function(par,x){meanlog=par[2]; sdlog=par[3]; loc=par[4]; dlnorm(x-loc,meanlog,sdlog)}
cum=function(par,x){meanlog=par[2]; sdlog=par[3]; loc=par[4]; plnorm(x-loc,meanlog,sdlog)}
if (location==FALSE){
den=function(par,x){meanlog=par[2]; sdlog=par[3]; dlnorm(x,meanlog,sdlog)}
cum=function(par,x){meanlog=par[2]; sdlog=par[3]; plnorm(x,meanlog,sdlog)}
}}
if(g=="chisq"){
den=function(par,x){df=par[2]; loc=par[3]; dchisq(x-loc,df)}
cum=function(par,x){df=par[2]; loc=par[3]; pchisq(x-loc,df)}
if (location==FALSE){
den=function(par,x){df=par[2]; dchisq(x,df)}
cum=function(par,x){df=par[2]; pchisq(x,df)}
}}
if(g=="f"){
den=function(par,x){df1=par[2]; df2=par[3]; loc=par[4]; df(x-loc,df1,df2)}
cum=function(par,x){df1=par[2]; df2=par[3]; loc=par[4]; pf(x-loc,df1,df2)}
if (location==FALSE){
den=function(par,x){df1=par[2]; df2=par[3]; df(x,df1,df2)}
cum=function(par,x){df1=par[2]; df2=par[3]; pf(x,df1,df2)}
}}
if(g=="chen"){
den=function(par,x){a=par[2]; b=par[3]; loc=par[4]; a*b*(x-loc)^(a-1)*exp((x-loc)^a)*exp(-b*(exp((x-loc)^a)-1))}
cum=function(par,x){a=par[2]; b=par[3]; loc=par[4]; 1-exp(-b*(exp((x-loc)^a)-1))}
if (location==FALSE){
den=function(par,x){a=par[2]; b=par[3]; a*b*(x)^(a-1)*exp((x)^a)*exp(-b*(exp((x)^a)-1))}
cum=function(par,x){a=par[2]; b=par[3]; 1-exp(-b*(exp((x)^a)-1))}
}}
if(g=="lfr"){
den=function(par,x){a=par[2]; b=par[3]; loc=par[4]; (a+b*(x-loc))*exp(-a*(x-loc)-(b*(x-loc)^2)/2)}
cum=function(par,x){a=par[2]; b=par[3]; loc=par[4]; 1-exp(-a*(x-loc)-(b*(x-loc)^2)/2)}
if (location==FALSE){
den=function(par,x){a=par[2]; b=par[3]; (a+b*(x))*exp(-a*(x)-(b*(x)^2)/2)}
cum=function(par,x){a=par[2]; b=par[3]; 1-exp(-a*(x)-(b*(x)^2)/2)}
}}
if(g=="log-logistic"){
den=function(par,x){a=par[2]; b=par[3]; loc=par[4]; (a*b^(-a)*(x-loc)^(a-1))/((((x-loc)/b)^a +1)^2)}
cum=function(par,x){a=par[2]; b=par[3]; loc=par[4]; 1/(((x-loc)/b)^(-a)+1)}
if (location==FALSE){
den=function(par,x){a=par[2]; b=par[3]; (a*b^(-a)*(x)^(a-1))/((((x)/b)^a +1)^2)}
cum=function(par,x){a=par[2]; b=par[3]; 1/(((x)/b)^(-a)+1)}
}}
if(g=="lomax"){
den=function(par,x){a=par[2]; b=par[3]; loc=par[4]; (a*b)/((1+a*(x-loc))^(b+1))}
cum=function(par,x){a=par[2]; b=par[3]; loc=par[4]; 1-(1+a*(x-loc))^(-b)}
if (location==FALSE){
den=function(par,x){a=par[2]; b=par[3]; (a*b)/((1+a*(x))^(b+1))}
cum=function(par,x){a=par[2]; b=par[3]; 1-(1+a*(x))^(-b)}
}}
if(g=="gompertz"){
den=function(par,x){a=par[2]; b=par[3]; loc=par[4]; b*exp(a*(x-loc))*exp(-(exp(a*(x-loc))-1)*b/a)}
cum=function(par,x){a=par[2]; b=par[3]; loc=par[4]; 1-exp(-(exp(a*(x-loc))-1)*b/a)}
if (location==FALSE){
den=function(par,x){a=par[2]; b=par[3]; b*exp(a*(x))*exp(-(exp(a*(x))-1)*b/a)}
cum=function(par,x){a=par[2]; b=par[3]; 1-exp(-(exp(a*(x))-1)*b/a)}
}}
if(g=="exp"){
den=function(par,x){rate=par[2]; loc=par[3]; dexp(x-loc,rate)}
cum=function(par,x){rate=par[2]; loc=par[3]; pexp(x-loc,rate)}
if (location==FALSE){
den=function(par,x){rate=par[2]; dexp(x,rate)}
cum=function(par,x){rate=par[2]; pexp(x,rate)}
}}
if(g=="rayleigh"){
den=function(par,x){a=par[2]; loc=par[3]; 2*(x-loc)/a*exp(-((x-loc)/a)^2)}
cum=function(par,x){a=par[2]; loc=par[3]; 1-exp(-((x-loc)/a)^2)}
if (location==FALSE){
den=function(par,x){a=par[2]; 2*x/a*exp(-(x/a)^2)}
cum=function(par,x){a=par[2]; 1-exp(-(x/a)^2)}
}}
if(g=="burrxii"){
den=function(par,x){a=par[2]; d=par[3]; loc=par[4]; d*a*(1+(x-loc)^d)^(-a-1)*((x-loc)^(d-1))}
cum=function(par,x){a=par[2]; d=par[3]; loc=par[4]; 1-(1+(x-loc)^d)^(-a)}
if (location==FALSE){
den=function(par,x){a=par[2]; d=par[3]; d*a*(1+(x)^d)^(-a-1)*((x)^(d-1))}
cum=function(par,x){a=par[2]; d=par[3]; 1-(1+(x)^d)^(-a)}
}}
if(g=="frechet"){
den=function(par,x){a=par[2]; b=par[3]; loc=par[4]; (a*exp(-((x-loc)/b)^(-a))*((x-loc)/b)^(-a-1))/(b)}
cum=function(par,x){a=par[2]; b=par[3]; loc=par[4]; exp(-((x-loc)/b)^(-a))}
if (location==FALSE){
den=function(par,x){a=par[2]; b=par[3]; (a*exp(-((x)/b)^(-a))*((x)/b)^(-a-1))/(b)}
cum=function(par,x){a=par[2]; b=par[3]; exp(-((x)/b)^(-a))}
}}
if(g=="birnbaum-saunders"){
den=function(par,x){a=par[2]; b=par[3]; loc=par[4]; (sqrt((x-loc)/b)+sqrt(b/(x-loc)))/(2*a*(x-loc))*dnorm((sqrt((x-loc)/b)-sqrt(b/(x-loc)))/a)}
cum=function(par,x){a=par[2]; b=par[3]; loc=par[4]; pnorm((sqrt((x-loc)/b)-sqrt(b/(x-loc)))/a)}
if (location==FALSE){
den=function(par,x){a=par[2]; b=par[3]; (sqrt((x)/b)+sqrt(b/(x)))/(2*a*(x))*dnorm((sqrt((x)/b)-sqrt(b/(x)))/a)}
cum=function(par,x){a=par[2]; b=par[3]; pnorm((sqrt((x)/b)-sqrt(b/(x)))/a)}
}}
if(g=="weibull"){
den=function(par,x){shape=par[2]; scale=par[3]; loc=par[4]; dweibull(x-loc,shape,scale)}
cum=function(par,x){shape=par[2]; scale=par[3]; loc=par[4]; pweibull(x-loc,shape,scale)}
if (location==FALSE){
den=function(par,x){shape=par[2]; scale=par[3]; dweibull(x,shape,scale)}
cum=function(par,x){shape=par[2]; scale=par[3]; pweibull(x,shape,scale)}
}}
if(g=="gamma"){
den=function(par,x){shape=par[2]; scale=par[3]; loc=par[4]; dgamma(x-loc,shape,scale)}
cum=function(par,x){shape=par[2]; scale=par[3]; loc=par[4]; pgamma(x-loc,shape,scale)}
if (location==FALSE){
den=function(par,x){shape=par[2]; scale=par[3]; dgamma(x,shape,scale)}
cum=function(par,x){shape=par[2]; scale=par[3]; pgamma(x,shape,scale)}
}}
pdf0<-function(par,x){
f0=den(par,x)
c0=cum(par,x)
a=par[1]
a*f0*c0^(a-1)
}
pdf<-pdf0(param,mydata)
if(log==TRUE){pdf<-log(pdf)}
return(pdf)
}
pexpkumg<-function(mydata, g, param, location=TRUE, log.p = FALSE, lower.tail = TRUE){
if(g!="birnbaum-saunders" & g!="exp" & g!="rayleigh" & g!="weibull" & g!="gompertz" & g!="gamma"
& g!="log-normal" & g!="chisq" & g!="f" & g!="burrxii" & g!="frechet"
& g!="lomax" & g!="log-logistic" & g!="lfr" & g!="chen")
{ stop ("Baseline distribution not implemented or misspelled. Please check the manual for guidelines.") }
if(g=="log-normal"){
den=function(par,x){meanlog=par[4]; sdlog=par[5]; loc=par[6]; dlnorm(x-loc,meanlog,sdlog)}
cum=function(par,x){meanlog=par[4]; sdlog=par[5]; loc=par[6]; plnorm(x-loc,meanlog,sdlog)}
if (location==FALSE){
den=function(par,x){meanlog=par[4]; sdlog=par[5]; dlnorm(x,meanlog,sdlog)}
cum=function(par,x){meanlog=par[4]; sdlog=par[5]; plnorm(x,meanlog,sdlog)}
}}
if(g=="chisq"){
den=function(par,x){df=par[4]; loc=par[5]; dchisq(x-loc,df)}
cum=function(par,x){df=par[4]; loc=par[5]; pchisq(x-loc,df)}
if (location==FALSE){
den=function(par,x){df=par[4]; dchisq(x,df)}
cum=function(par,x){df=par[4]; pchisq(x,df)}
}}
if(g=="f"){
den=function(par,x){df1=par[4]; df2=par[5]; loc=par[6]; df(x-loc,df1,df2)}
cum=function(par,x){df1=par[4]; df2=par[5]; loc=par[6]; pf(x-loc,df1,df2)}
if (location==FALSE){
den=function(par,x){df1=par[4]; df2=par[5]; df(x,df1,df2)}
cum=function(par,x){df1=par[4]; df2=par[5]; pf(x,df1,df2)}
}}
if(g=="chen"){
den=function(par,x){a=par[4]; b=par[5]; loc=par[6]; a*b*(x-loc)^(a-1)*exp((x-loc)^a)*exp(-b*(exp((x-loc)^a)-1))}
cum=function(par,x){a=par[4]; b=par[5]; loc=par[6]; 1-exp(-b*(exp((x-loc)^a)-1))}
if (location==FALSE){
den=function(par,x){a=par[4]; b=par[5]; a*b*(x)^(a-1)*exp((x)^a)*exp(-b*(exp((x)^a)-1))}
cum=function(par,x){a=par[4]; b=par[5]; 1-exp(-b*(exp((x)^a)-1))}
}}
if(g=="lfr"){
den=function(par,x){a=par[4]; b=par[5]; loc=par[6]; (a+b*(x-loc))*exp(-a*(x-loc)-(b*(x-loc)^2)/2)}
cum=function(par,x){a=par[4]; b=par[5]; loc=par[6]; 1-exp(-a*(x-loc)-(b*(x-loc)^2)/2)}
if (location==FALSE){
den=function(par,x){a=par[4]; b=par[5]; (a+b*(x))*exp(-a*(x)-(b*(x)^2)/2)}
cum=function(par,x){a=par[4]; b=par[5]; 1-exp(-a*(x)-(b*(x)^2)/2)}
}}
if(g=="log-logistic"){
den=function(par,x){a=par[4]; b=par[5]; loc=par[6]; (a*b^(-a)*(x-loc)^(a-1))/((((x-loc)/b)^a +1)^2)}
cum=function(par,x){a=par[4]; b=par[5]; loc=par[6]; 1/(((x-loc)/b)^(-a)+1)}
if (location==FALSE){
den=function(par,x){a=par[4]; b=par[5]; (a*b^(-a)*(x)^(a-1))/((((x)/b)^a +1)^2)}
cum=function(par,x){a=par[4]; b=par[5]; 1/(((x)/b)^(-a)+1)}
}}
if(g=="lomax"){
den=function(par,x){a=par[4]; b=par[5]; loc=par[6]; (a*b)/((1+a*(x-loc))^(b+1))}
cum=function(par,x){a=par[4]; b=par[5]; loc=par[6]; 1-(1+a*(x-loc))^(-b)}
if (location==FALSE){
den=function(par,x){a=par[4]; b=par[5]; (a*b)/((1+a*(x))^(b+1))}
cum=function(par,x){a=par[4]; b=par[5]; 1-(1+a*(x))^(-b)}
}}
if(g=="gompertz"){
den=function(par,x){a=par[4]; b=par[5]; loc=par[6]; b*exp(a*(x-loc))*exp(-(exp(a*(x-loc))-1)*b/a)}
cum=function(par,x){a=par[4]; b=par[5]; loc=par[6]; 1-exp(-(exp(a*(x-loc))-1)*b/a)}
if (location==FALSE){
den=function(par,x){a=par[4]; b=par[5]; b*exp(a*(x))*exp(-(exp(a*(x))-1)*b/a)}
cum=function(par,x){a=par[4]; b=par[5]; 1-exp(-(exp(a*(x))-1)*b/a)}
}}
if(g=="exp"){
den=function(par,x){rate=par[4]; loc=par[5]; dexp(x-loc,rate)}
cum=function(par,x){rate=par[4]; loc=par[5]; pexp(x-loc,rate)}
if (location==FALSE){
den=function(par,x){rate=par[4]; dexp(x,rate)}
cum=function(par,x){rate=par[4]; pexp(x,rate)}
}}
if(g=="rayleigh"){
den=function(par,x){a=par[4]; loc=par[5]; 2*(x-loc)/a*exp(-((x-loc)/a)^2)}
cum=function(par,x){a=par[4]; loc=par[5]; 1-exp(-((x-loc)/a)^2)}
if (location==FALSE){
den=function(par,x){a=par[4]; 2*x/a*exp(-(x/a)^2)}
cum=function(par,x){a=par[4]; 1-exp(-(x/a)^2)}
}}
if(g=="burrxii"){
den=function(par,x){a=par[4]; d=par[5]; loc=par[6]; d*a*(1+(x-loc)^d)^(-a-1)*((x-loc)^(d-1))}
cum=function(par,x){a=par[4]; d=par[5]; loc=par[6]; 1-(1+(x-loc)^d)^(-a)}
if (location==FALSE){
den=function(par,x){a=par[4]; d=par[5]; d*a*(1+(x)^d)^(-a-1)*((x)^(d-1))}
cum=function(par,x){a=par[4]; d=par[5]; 1-(1+(x)^d)^(-a)}
}}
if(g=="frechet"){
den=function(par,x){a=par[4]; b=par[5]; loc=par[6]; (a*exp(-((x-loc)/b)^(-a))*((x-loc)/b)^(-a-1))/(b)}
cum=function(par,x){a=par[4]; b=par[5]; loc=par[6]; exp(-((x-loc)/b)^(-a))}
if (location==FALSE){
den=function(par,x){a=par[4]; b=par[5]; (a*exp(-((x)/b)^(-a))*((x)/b)^(-a-1))/(b)}
cum=function(par,x){a=par[4]; b=par[5]; exp(-((x)/b)^(-a))}
}}
if(g=="birnbaum-saunders"){
den=function(par,x){a=par[4]; b=par[5]; loc=par[6]; (sqrt((x-loc)/b)+sqrt(b/(x-loc)))/(2*a*(x-loc))*dnorm((sqrt((x-loc)/b)-sqrt(b/(x-loc)))/a)}
cum=function(par,x){a=par[4]; b=par[5]; loc=par[6]; pnorm((sqrt((x-loc)/b)-sqrt(b/(x-loc)))/a)}
if (location==FALSE){
den=function(par,x){a=par[4]; b=par[5]; (sqrt((x)/b)+sqrt(b/(x)))/(2*a*(x))*dnorm((sqrt((x)/b)-sqrt(b/(x)))/a)}
cum=function(par,x){a=par[4]; b=par[5]; pnorm((sqrt((x)/b)-sqrt(b/(x)))/a)}
}}
if(g=="weibull"){
den=function(par,x){shape=par[4]; scale=par[5]; loc=par[6]; dweibull(x-loc,shape,scale)}
cum=function(par,x){shape=par[4]; scale=par[5]; loc=par[6]; pweibull(x-loc,shape,scale)}
if (location==FALSE){
den=function(par,x){shape=par[4]; scale=par[5]; dweibull(x,shape,scale)}
cum=function(par,x){shape=par[4]; scale=par[5]; pweibull(x,shape,scale)}
}}
if(g=="gamma"){
den=function(par,x){shape=par[4]; scale=par[5]; loc=par[6]; dgamma(x-loc,shape,scale)}
cum=function(par,x){shape=par[4]; scale=par[5]; loc=par[6]; pgamma(x-loc,shape,scale)}
if (location==FALSE){
den=function(par,x){shape=par[4]; scale=par[5]; dgamma(x,shape,scale)}
cum=function(par,x){shape=par[4]; scale=par[5]; pgamma(x,shape,scale)}
}}
cdf0<-function(par,x){
f0=den(par,x)
c0=cum(par,x)
a=par[1]
b=par[2]
d=par[3]
(1-(1-c0^a)^b)^d
}
cdf<-cdf0(param,mydata)
if(log.p==TRUE & lower.tail == FALSE) cdf<-log(1-cdf)
if(log.p==TRUE & lower.tail == TRUE) cdf<-log(cdf)
if(log.p==FALSE & lower.tail == FALSE) cdf<-1-cdf
return(cdf)
}
dexpkumg<-function(mydata, g, param, location=TRUE, log=FALSE){
if(g!="birnbaum-saunders" & g!="exp" & g!="rayleigh" & g!="weibull" & g!="gompertz" & g!="gamma"
& g!="log-normal" & g!="chisq" & g!="f" & g!="burrxii" & g!="frechet"
& g!="lomax" & g!="log-logistic" & g!="lfr" & g!="chen")
{ stop ("Baseline distribution not implemented or misspelled. Please check the manual for guidelines.") }
if(g=="log-normal"){
den=function(par,x){meanlog=par[4]; sdlog=par[5]; loc=par[6]; dlnorm(x-loc,meanlog,sdlog)}
cum=function(par,x){meanlog=par[4]; sdlog=par[5]; loc=par[6]; plnorm(x-loc,meanlog,sdlog)}
if (location==FALSE){
den=function(par,x){meanlog=par[4]; sdlog=par[5]; dlnorm(x,meanlog,sdlog)}
cum=function(par,x){meanlog=par[4]; sdlog=par[5]; plnorm(x,meanlog,sdlog)}
}}
if(g=="chisq"){
den=function(par,x){df=par[4]; loc=par[5]; dchisq(x-loc,df)}
cum=function(par,x){df=par[4]; loc=par[5]; pchisq(x-loc,df)}
if (location==FALSE){
den=function(par,x){df=par[4]; dchisq(x,df)}
cum=function(par,x){df=par[4]; pchisq(x,df)}
}}
if(g=="f"){
den=function(par,x){df1=par[4]; df2=par[5]; loc=par[6]; df(x-loc,df1,df2)}
cum=function(par,x){df1=par[4]; df2=par[5]; loc=par[6]; pf(x-loc,df1,df2)}
if (location==FALSE){
den=function(par,x){df1=par[4]; df2=par[5]; df(x,df1,df2)}
cum=function(par,x){df1=par[4]; df2=par[5]; pf(x,df1,df2)}
}}
if(g=="chen"){
den=function(par,x){a=par[4]; b=par[5]; loc=par[6]; a*b*(x-loc)^(a-1)*exp((x-loc)^a)*exp(-b*(exp((x-loc)^a)-1))}
cum=function(par,x){a=par[4]; b=par[5]; loc=par[6]; 1-exp(-b*(exp((x-loc)^a)-1))}
if (location==FALSE){
den=function(par,x){a=par[4]; b=par[5]; a*b*(x)^(a-1)*exp((x)^a)*exp(-b*(exp((x)^a)-1))}
cum=function(par,x){a=par[4]; b=par[5]; 1-exp(-b*(exp((x)^a)-1))}
}}
if(g=="lfr"){
den=function(par,x){a=par[4]; b=par[5]; loc=par[6]; (a+b*(x-loc))*exp(-a*(x-loc)-(b*(x-loc)^2)/2)}
cum=function(par,x){a=par[4]; b=par[5]; loc=par[6]; 1-exp(-a*(x-loc)-(b*(x-loc)^2)/2)}
if (location==FALSE){
den=function(par,x){a=par[4]; b=par[5]; (a+b*(x))*exp(-a*(x)-(b*(x)^2)/2)}
cum=function(par,x){a=par[4]; b=par[5]; 1-exp(-a*(x)-(b*(x)^2)/2)}
}}
if(g=="log-logistic"){
den=function(par,x){a=par[4]; b=par[5]; loc=par[6]; (a*b^(-a)*(x-loc)^(a-1))/((((x-loc)/b)^a +1)^2)}
cum=function(par,x){a=par[4]; b=par[5]; loc=par[6]; 1/(((x-loc)/b)^(-a)+1)}
if (location==FALSE){
den=function(par,x){a=par[4]; b=par[5]; (a*b^(-a)*(x)^(a-1))/((((x)/b)^a +1)^2)}
cum=function(par,x){a=par[4]; b=par[5]; 1/(((x)/b)^(-a)+1)}
}}
if(g=="lomax"){
den=function(par,x){a=par[4]; b=par[5]; loc=par[6]; (a*b)/((1+a*(x-loc))^(b+1))}
cum=function(par,x){a=par[4]; b=par[5]; loc=par[6]; 1-(1+a*(x-loc))^(-b)}
if (location==FALSE){
den=function(par,x){a=par[4]; b=par[5]; (a*b)/((1+a*(x))^(b+1))}
cum=function(par,x){a=par[4]; b=par[5]; 1-(1+a*(x))^(-b)}
}}
if(g=="gompertz"){
den=function(par,x){a=par[4]; b=par[5]; loc=par[6]; b*exp(a*(x-loc))*exp(-(exp(a*(x-loc))-1)*b/a)}
cum=function(par,x){a=par[4]; b=par[5]; loc=par[6]; 1-exp(-(exp(a*(x-loc))-1)*b/a)}
if (location==FALSE){
den=function(par,x){a=par[4]; b=par[5]; b*exp(a*(x))*exp(-(exp(a*(x))-1)*b/a)}
cum=function(par,x){a=par[4]; b=par[5]; 1-exp(-(exp(a*(x))-1)*b/a)}
}}
if(g=="exp"){
den=function(par,x){rate=par[4]; loc=par[5]; dexp(x-loc,rate)}
cum=function(par,x){rate=par[4]; loc=par[5]; pexp(x-loc,rate)}
if (location==FALSE){
den=function(par,x){rate=par[4]; dexp(x,rate)}
cum=function(par,x){rate=par[4]; pexp(x,rate)}
}}
if(g=="rayleigh"){
den=function(par,x){a=par[4]; loc=par[5]; 2*(x-loc)/a*exp(-((x-loc)/a)^2)}
cum=function(par,x){a=par[4]; loc=par[5]; 1-exp(-((x-loc)/a)^2)}
if (location==FALSE){
den=function(par,x){a=par[4]; 2*x/a*exp(-(x/a)^2)}
cum=function(par,x){a=par[4]; 1-exp(-(x/a)^2)}
}}
if(g=="burrxii"){
den=function(par,x){a=par[4]; d=par[5]; loc=par[6]; d*a*(1+(x-loc)^d)^(-a-1)*((x-loc)^(d-1))}
cum=function(par,x){a=par[4]; d=par[5]; loc=par[6]; 1-(1+(x-loc)^d)^(-a)}
if (location==FALSE){
den=function(par,x){a=par[4]; d=par[5]; d*a*(1+(x)^d)^(-a-1)*((x)^(d-1))}
cum=function(par,x){a=par[4]; d=par[5]; 1-(1+(x)^d)^(-a)}
}}
if(g=="frechet"){
den=function(par,x){a=par[4]; b=par[5]; loc=par[6]; (a*exp(-((x-loc)/b)^(-a))*((x-loc)/b)^(-a-1))/(b)}
cum=function(par,x){a=par[4]; b=par[5]; loc=par[6]; exp(-((x-loc)/b)^(-a))}
if (location==FALSE){
den=function(par,x){a=par[4]; b=par[5]; (a*exp(-((x)/b)^(-a))*((x)/b)^(-a-1))/(b)}
cum=function(par,x){a=par[4]; b=par[5]; exp(-((x)/b)^(-a))}
}}
if(g=="birnbaum-saunders"){
den=function(par,x){a=par[4]; b=par[5]; loc=par[6]; (sqrt((x-loc)/b)+sqrt(b/(x-loc)))/(2*a*(x-loc))*dnorm((sqrt((x-loc)/b)-sqrt(b/(x-loc)))/a)}
cum=function(par,x){a=par[4]; b=par[5]; loc=par[6]; pnorm((sqrt((x-loc)/b)-sqrt(b/(x-loc)))/a)}
if (location==FALSE){
den=function(par,x){a=par[4]; b=par[5]; (sqrt((x)/b)+sqrt(b/(x)))/(2*a*(x))*dnorm((sqrt((x)/b)-sqrt(b/(x)))/a)}
cum=function(par,x){a=par[4]; b=par[5]; pnorm((sqrt((x)/b)-sqrt(b/(x)))/a)}
}}
if(g=="weibull"){
den=function(par,x){shape=par[4]; scale=par[5]; loc=par[6]; dweibull(x-loc,shape,scale)}
cum=function(par,x){shape=par[4]; scale=par[5]; loc=par[6]; pweibull(x-loc,shape,scale)}
if (location==FALSE){
den=function(par,x){shape=par[4]; scale=par[5]; dweibull(x,shape,scale)}
cum=function(par,x){shape=par[4]; scale=par[5]; pweibull(x,shape,scale)}
}}
if(g=="gamma"){
den=function(par,x){shape=par[4]; scale=par[5]; loc=par[6]; dgamma(x-loc,shape,scale)}
cum=function(par,x){shape=par[4]; scale=par[5]; loc=par[6]; pgamma(x-loc,shape,scale)}
if (location==FALSE){
den=function(par,x){shape=par[4]; scale=par[5]; dgamma(x,shape,scale)}
cum=function(par,x){shape=par[4]; scale=par[5]; pgamma(x,shape,scale)}
}}
pdf0<-function(par,x){
f0=den(par,x)
c0=cum(par,x)
a=par[1]
b=par[2]
d=par[3]
a*b*d*f0*c0^(a-1)*(1-c0^a)^(b-1)*(1-(1-c0^a)^b)^(d-1)
}
pdf<-pdf0(param,mydata)
if(log==TRUE){pdf<-log(pdf)}
return(pdf)
}
pgammag<-function(mydata, g, param, location=TRUE, log.p = FALSE, lower.tail = TRUE){
if(g!="birnbaum-saunders" & g!="exp" & g!="rayleigh" & g!="weibull" & g!="gompertz" & g!="gamma"
& g!="log-normal" & g!="chisq" & g!="f" & g!="burrxii" & g!="frechet"
& g!="lomax" & g!="log-logistic" & g!="lfr" & g!="chen")
{ stop ("Baseline distribution not implemented or misspelled. Please check the manual for guidelines.") }
if(g=="log-normal"){
den=function(par,x){meanlog=par[2]; sdlog=par[3]; loc=par[4]; dlnorm(x-loc,meanlog,sdlog)}
cum=function(par,x){meanlog=par[2]; sdlog=par[3]; loc=par[4]; plnorm(x-loc,meanlog,sdlog)}
if (location==FALSE){
den=function(par,x){meanlog=par[2]; sdlog=par[3]; dlnorm(x,meanlog,sdlog)}
cum=function(par,x){meanlog=par[2]; sdlog=par[3]; plnorm(x,meanlog,sdlog)}
}}
if(g=="chisq"){
den=function(par,x){df=par[2]; loc=par[3]; dchisq(x-loc,df)}
cum=function(par,x){df=par[2]; loc=par[3]; pchisq(x-loc,df)}
if (location==FALSE){
den=function(par,x){df=par[2]; dchisq(x,df)}
cum=function(par,x){df=par[2]; pchisq(x,df)}
}}
if(g=="f"){
den=function(par,x){df1=par[2]; df2=par[3]; loc=par[4]; df(x-loc,df1,df2)}
cum=function(par,x){df1=par[2]; df2=par[3]; loc=par[4]; pf(x-loc,df1,df2)}
if (location==FALSE){
den=function(par,x){df1=par[2]; df2=par[3]; df(x,df1,df2)}
cum=function(par,x){df1=par[2]; df2=par[3]; pf(x,df1,df2)}
}}
if(g=="chen"){
den=function(par,x){a=par[2]; b=par[3]; loc=par[4]; a*b*(x-loc)^(a-1)*exp((x-loc)^a)*exp(-b*(exp((x-loc)^a)-1))}
cum=function(par,x){a=par[2]; b=par[3]; loc=par[4]; 1-exp(-b*(exp((x-loc)^a)-1))}
if (location==FALSE){
den=function(par,x){a=par[2]; b=par[3]; a*b*(x)^(a-1)*exp((x)^a)*exp(-b*(exp((x)^a)-1))}
cum=function(par,x){a=par[2]; b=par[3]; 1-exp(-b*(exp((x)^a)-1))}
}}
if(g=="lfr"){
den=function(par,x){a=par[2]; b=par[3]; loc=par[4]; (a+b*(x-loc))*exp(-a*(x-loc)-(b*(x-loc)^2)/2)}
cum=function(par,x){a=par[2]; b=par[3]; loc=par[4]; 1-exp(-a*(x-loc)-(b*(x-loc)^2)/2)}
if (location==FALSE){
den=function(par,x){a=par[2]; b=par[3]; (a+b*(x))*exp(-a*(x)-(b*(x)^2)/2)}
cum=function(par,x){a=par[2]; b=par[3]; 1-exp(-a*(x)-(b*(x)^2)/2)}
}}
if(g=="log-logistic"){
den=function(par,x){a=par[2]; b=par[3]; loc=par[4]; (a*b^(-a)*(x-loc)^(a-1))/((((x-loc)/b)^a +1)^2)}
cum=function(par,x){a=par[2]; b=par[3]; loc=par[4]; 1/(((x-loc)/b)^(-a)+1)}
if (location==FALSE){
den=function(par,x){a=par[2]; b=par[3]; (a*b^(-a)*(x)^(a-1))/((((x)/b)^a +1)^2)}
cum=function(par,x){a=par[2]; b=par[3]; 1/(((x)/b)^(-a)+1)}
}}
if(g=="lomax"){
den=function(par,x){a=par[2]; b=par[3]; loc=par[4]; (a*b)/((1+a*(x-loc))^(b+1))}
cum=function(par,x){a=par[2]; b=par[3]; loc=par[4]; 1-(1+a*(x-loc))^(-b)}
if (location==FALSE){
den=function(par,x){a=par[2]; b=par[3]; (a*b)/((1+a*(x))^(b+1))}
cum=function(par,x){a=par[2]; b=par[3]; 1-(1+a*(x))^(-b)}
}}
if(g=="gompertz"){
den=function(par,x){a=par[2]; b=par[3]; loc=par[4]; b*exp(a*(x-loc))*exp(-(exp(a*(x-loc))-1)*b/a)}
cum=function(par,x){a=par[2]; b=par[3]; loc=par[4]; 1-exp(-(exp(a*(x-loc))-1)*b/a)}
if (location==FALSE){
den=function(par,x){a=par[2]; b=par[3]; b*exp(a*(x))*exp(-(exp(a*(x))-1)*b/a)}
cum=function(par,x){a=par[2]; b=par[3]; 1-exp(-(exp(a*(x))-1)*b/a)}
}}
if(g=="exp"){
den=function(par,x){rate=par[2]; loc=par[3]; dexp(x-loc,rate)}
cum=function(par,x){rate=par[2]; loc=par[3]; pexp(x-loc,rate)}
if (location==FALSE){
den=function(par,x){rate=par[2]; dexp(x,rate)}
cum=function(par,x){rate=par[2]; pexp(x,rate)}
}}
if(g=="rayleigh"){
den=function(par,x){a=par[2]; loc=par[3]; 2*(x-loc)/a*exp(-((x-loc)/a)^2)}
cum=function(par,x){a=par[2]; loc=par[3]; 1-exp(-((x-loc)/a)^2)}
if (location==FALSE){
den=function(par,x){a=par[2]; 2*x/a*exp(-(x/a)^2)}
cum=function(par,x){a=par[2]; 1-exp(-(x/a)^2)}
}}
if(g=="burrxii"){
den=function(par,x){a=par[2]; d=par[3]; loc=par[4]; d*a*(1+(x-loc)^d)^(-a-1)*((x-loc)^(d-1))}
cum=function(par,x){a=par[2]; d=par[3]; loc=par[4]; 1-(1+(x-loc)^d)^(-a)}
if (location==FALSE){
den=function(par,x){a=par[2]; d=par[3]; d*a*(1+(x)^d)^(-a-1)*((x)^(d-1))}
cum=function(par,x){a=par[2]; d=par[3]; 1-(1+(x)^d)^(-a)}
}}
if(g=="frechet"){
den=function(par,x){a=par[2]; b=par[3]; loc=par[4]; (a*exp(-((x-loc)/b)^(-a))*((x-loc)/b)^(-a-1))/(b)}
cum=function(par,x){a=par[2]; b=par[3]; loc=par[4]; exp(-((x-loc)/b)^(-a))}
if (location==FALSE){
den=function(par,x){a=par[2]; b=par[3]; (a*exp(-((x)/b)^(-a))*((x)/b)^(-a-1))/(b)}
cum=function(par,x){a=par[2]; b=par[3]; exp(-((x)/b)^(-a))}
}}
if(g=="birnbaum-saunders"){
den=function(par,x){a=par[2]; b=par[3]; loc=par[4]; (sqrt((x-loc)/b)+sqrt(b/(x-loc)))/(2*a*(x-loc))*dnorm((sqrt((x-loc)/b)-sqrt(b/(x-loc)))/a)}
cum=function(par,x){a=par[2]; b=par[3]; loc=par[4]; pnorm((sqrt((x-loc)/b)-sqrt(b/(x-loc)))/a)}
if (location==FALSE){
den=function(par,x){a=par[2]; b=par[3]; (sqrt((x)/b)+sqrt(b/(x)))/(2*a*(x))*dnorm((sqrt((x)/b)-sqrt(b/(x)))/a)}
cum=function(par,x){a=par[2]; b=par[3]; pnorm((sqrt((x)/b)-sqrt(b/(x)))/a)}
}}
if(g=="weibull"){
den=function(par,x){shape=par[2]; scale=par[3]; loc=par[4]; dweibull(x-loc,shape,scale)}
cum=function(par,x){shape=par[2]; scale=par[3]; loc=par[4]; pweibull(x-loc,shape,scale)}
if (location==FALSE){
den=function(par,x){shape=par[2]; scale=par[3]; dweibull(x,shape,scale)}
cum=function(par,x){shape=par[2]; scale=par[3]; pweibull(x,shape,scale)}
}}
if(g=="gamma"){
den=function(par,x){shape=par[2]; scale=par[3]; loc=par[4]; dgamma(x-loc,shape,scale)}
cum=function(par,x){shape=par[2]; scale=par[3]; loc=par[4]; pgamma(x-loc,shape,scale)}
if (location==FALSE){
den=function(par,x){shape=par[2]; scale=par[3]; dgamma(x,shape,scale)}
cum=function(par,x){shape=par[2]; scale=par[3]; pgamma(x,shape,scale)}
}}
cdf0<-function(par,x){
f0=den(par,x)
c0=cum(par,x)
a=par[1]
pgamma(c0/(1-c0),shape=a)
}
cdf<-cdf0(param,mydata)
if(log.p==TRUE & lower.tail == FALSE) cdf<-log(1-cdf)
if(log.p==TRUE & lower.tail == TRUE) cdf<-log(cdf)
if(log.p==FALSE & lower.tail == FALSE) cdf<-1-cdf
return(cdf)
}
dgammag<-function(mydata, g, param, location=TRUE, log=FALSE){
if(g!="birnbaum-saunders" & g!="exp" & g!="rayleigh" & g!="weibull" & g!="gompertz" & g!="gamma"
& g!="log-normal" & g!="chisq" & g!="f" & g!="burrxii" & g!="frechet"
& g!="lomax" & g!="log-logistic" & g!="lfr" & g!="chen")
{ stop ("Baseline distribution not implemented or misspelled. Please check the manual for guidelines.") }
if(g=="log-normal"){
den=function(par,x){meanlog=par[2]; sdlog=par[3]; loc=par[4]; dlnorm(x-loc,meanlog,sdlog)}
cum=function(par,x){meanlog=par[2]; sdlog=par[3]; loc=par[4]; plnorm(x-loc,meanlog,sdlog)}
if (location==FALSE){
den=function(par,x){meanlog=par[2]; sdlog=par[3]; dlnorm(x,meanlog,sdlog)}
cum=function(par,x){meanlog=par[2]; sdlog=par[3]; plnorm(x,meanlog,sdlog)}
}}
if(g=="chisq"){
den=function(par,x){df=par[2]; loc=par[3]; dchisq(x-loc,df)}
cum=function(par,x){df=par[2]; loc=par[3]; pchisq(x-loc,df)}
if (location==FALSE){
den=function(par,x){df=par[2]; dchisq(x,df)}
cum=function(par,x){df=par[2]; pchisq(x,df)}
}}
if(g=="f"){
den=function(par,x){df1=par[2]; df2=par[3]; loc=par[4]; df(x-loc,df1,df2)}
cum=function(par,x){df1=par[2]; df2=par[3]; loc=par[4]; pf(x-loc,df1,df2)}
if (location==FALSE){
den=function(par,x){df1=par[2]; df2=par[3]; df(x,df1,df2)}
cum=function(par,x){df1=par[2]; df2=par[3]; pf(x,df1,df2)}
}}
if(g=="chen"){
den=function(par,x){a=par[2]; b=par[3]; loc=par[4]; a*b*(x-loc)^(a-1)*exp((x-loc)^a)*exp(-b*(exp((x-loc)^a)-1))}
cum=function(par,x){a=par[2]; b=par[3]; loc=par[4]; 1-exp(-b*(exp((x-loc)^a)-1))}
if (location==FALSE){
den=function(par,x){a=par[2]; b=par[3]; a*b*(x)^(a-1)*exp((x)^a)*exp(-b*(exp((x)^a)-1))}
cum=function(par,x){a=par[2]; b=par[3]; 1-exp(-b*(exp((x)^a)-1))}
}}
if(g=="lfr"){
den=function(par,x){a=par[2]; b=par[3]; loc=par[4]; (a+b*(x-loc))*exp(-a*(x-loc)-(b*(x-loc)^2)/2)}
cum=function(par,x){a=par[2]; b=par[3]; loc=par[4]; 1-exp(-a*(x-loc)-(b*(x-loc)^2)/2)}
if (location==FALSE){
den=function(par,x){a=par[2]; b=par[3]; (a+b*(x))*exp(-a*(x)-(b*(x)^2)/2)}
cum=function(par,x){a=par[2]; b=par[3]; 1-exp(-a*(x)-(b*(x)^2)/2)}
}}
if(g=="log-logistic"){
den=function(par,x){a=par[2]; b=par[3]; loc=par[4]; (a*b^(-a)*(x-loc)^(a-1))/((((x-loc)/b)^a +1)^2)}
cum=function(par,x){a=par[2]; b=par[3]; loc=par[4]; 1/(((x-loc)/b)^(-a)+1)}
if (location==FALSE){
den=function(par,x){a=par[2]; b=par[3]; (a*b^(-a)*(x)^(a-1))/((((x)/b)^a +1)^2)}
cum=function(par,x){a=par[2]; b=par[3]; 1/(((x)/b)^(-a)+1)}
}}
if(g=="lomax"){
den=function(par,x){a=par[2]; b=par[3]; loc=par[4]; (a*b)/((1+a*(x-loc))^(b+1))}
cum=function(par,x){a=par[2]; b=par[3]; loc=par[4]; 1-(1+a*(x-loc))^(-b)}
if (location==FALSE){
den=function(par,x){a=par[2]; b=par[3]; (a*b)/((1+a*(x))^(b+1))}
cum=function(par,x){a=par[2]; b=par[3]; 1-(1+a*(x))^(-b)}
}}
if(g=="gompertz"){
den=function(par,x){a=par[2]; b=par[3]; loc=par[4]; b*exp(a*(x-loc))*exp(-(exp(a*(x-loc))-1)*b/a)}
cum=function(par,x){a=par[2]; b=par[3]; loc=par[4]; 1-exp(-(exp(a*(x-loc))-1)*b/a)}
if (location==FALSE){
den=function(par,x){a=par[2]; b=par[3]; b*exp(a*(x))*exp(-(exp(a*(x))-1)*b/a)}
cum=function(par,x){a=par[2]; b=par[3]; 1-exp(-(exp(a*(x))-1)*b/a)}
}}
if(g=="exp"){
den=function(par,x){rate=par[2]; loc=par[3]; dexp(x-loc,rate)}
cum=function(par,x){rate=par[2]; loc=par[3]; pexp(x-loc,rate)}
if (location==FALSE){
den=function(par,x){rate=par[2]; dexp(x,rate)}
cum=function(par,x){rate=par[2]; pexp(x,rate)}
}}
if(g=="rayleigh"){
den=function(par,x){a=par[2]; loc=par[3]; 2*(x-loc)/a*exp(-((x-loc)/a)^2)}
cum=function(par,x){a=par[2]; loc=par[3]; 1-exp(-((x-loc)/a)^2)}
if (location==FALSE){
den=function(par,x){a=par[2]; 2*x/a*exp(-(x/a)^2)}
cum=function(par,x){a=par[2]; 1-exp(-(x/a)^2)}
}}
if(g=="burrxii"){
den=function(par,x){a=par[2]; d=par[3]; loc=par[4]; d*a*(1+(x-loc)^d)^(-a-1)*((x-loc)^(d-1))}
cum=function(par,x){a=par[2]; d=par[3]; loc=par[4]; 1-(1+(x-loc)^d)^(-a)}
if (location==FALSE){
den=function(par,x){a=par[2]; d=par[3]; d*a*(1+(x)^d)^(-a-1)*((x)^(d-1))}
cum=function(par,x){a=par[2]; d=par[3]; 1-(1+(x)^d)^(-a)}
}}
if(g=="frechet"){
den=function(par,x){a=par[2]; b=par[3]; loc=par[4]; (a*exp(-((x-loc)/b)^(-a))*((x-loc)/b)^(-a-1))/(b)}
cum=function(par,x){a=par[2]; b=par[3]; loc=par[4]; exp(-((x-loc)/b)^(-a))}
if (location==FALSE){
den=function(par,x){a=par[2]; b=par[3]; (a*exp(-((x)/b)^(-a))*((x)/b)^(-a-1))/(b)}
cum=function(par,x){a=par[2]; b=par[3]; exp(-((x)/b)^(-a))}
}}
if(g=="birnbaum-saunders"){
den=function(par,x){a=par[2]; b=par[3]; loc=par[4]; (sqrt((x-loc)/b)+sqrt(b/(x-loc)))/(2*a*(x-loc))*dnorm((sqrt((x-loc)/b)-sqrt(b/(x-loc)))/a)}
cum=function(par,x){a=par[2]; b=par[3]; loc=par[4]; pnorm((sqrt((x-loc)/b)-sqrt(b/(x-loc)))/a)}
if (location==FALSE){
den=function(par,x){a=par[2]; b=par[3]; (sqrt((x)/b)+sqrt(b/(x)))/(2*a*(x))*dnorm((sqrt((x)/b)-sqrt(b/(x)))/a)}
cum=function(par,x){a=par[2]; b=par[3]; pnorm((sqrt((x)/b)-sqrt(b/(x)))/a)}
}}
if(g=="weibull"){
den=function(par,x){shape=par[2]; scale=par[3]; loc=par[4]; dweibull(x-loc,shape,scale)}
cum=function(par,x){shape=par[2]; scale=par[3]; loc=par[4]; pweibull(x-loc,shape,scale)}
if (location==FALSE){
den=function(par,x){shape=par[2]; scale=par[3]; dweibull(x,shape,scale)}
cum=function(par,x){shape=par[2]; scale=par[3]; pweibull(x,shape,scale)}
}}
if(g=="gamma"){
den=function(par,x){shape=par[2]; scale=par[3]; loc=par[4]; dgamma(x-loc,shape,scale)}
cum=function(par,x){shape=par[2]; scale=par[3]; loc=par[4]; pgamma(x-loc,shape,scale)}
if (location==FALSE){
den=function(par,x){shape=par[2]; scale=par[3]; dgamma(x,shape,scale)}
cum=function(par,x){shape=par[2]; scale=par[3]; pgamma(x,shape,scale)}
}}
pdf0<-function(par,x){
f0=den(par,x)
c0=cum(par,x)
a=par[1]
gamma(a)^(-1)*f0*(1-c0)^(-2)*(c0/(1-c0))^(a-1)*exp(-c0/(1-c0))
}
pdf<-pdf0(param,mydata)
if(log==TRUE){pdf<-log(pdf)}
return(pdf)
}
pgammag1<-function(mydata, g, param, location=TRUE, log.p = FALSE, lower.tail = TRUE){
if(g!="birnbaum-saunders" & g!="exp" & g!="rayleigh" & g!="weibull" & g!="gompertz" & g!="gamma"
& g!="log-normal" & g!="chisq" & g!="f" & g!="burrxii" & g!="frechet"
& g!="lomax" & g!="log-logistic" & g!="lfr" & g!="chen")
{ stop ("Baseline distribution not implemented or misspelled. Please check the manual for guidelines.") }
if(g=="log-normal"){
den=function(par,x){meanlog=par[2]; sdlog=par[3]; loc=par[4]; dlnorm(x-loc,meanlog,sdlog)}
cum=function(par,x){meanlog=par[2]; sdlog=par[3]; loc=par[4]; plnorm(x-loc,meanlog,sdlog)}
if (location==FALSE){
den=function(par,x){meanlog=par[2]; sdlog=par[3]; dlnorm(x,meanlog,sdlog)}
cum=function(par,x){meanlog=par[2]; sdlog=par[3]; plnorm(x,meanlog,sdlog)}
}}
if(g=="chisq"){
den=function(par,x){df=par[2]; loc=par[3]; dchisq(x-loc,df)}
cum=function(par,x){df=par[2]; loc=par[3]; pchisq(x-loc,df)}
if (location==FALSE){
den=function(par,x){df=par[2]; dchisq(x,df)}
cum=function(par,x){df=par[2]; pchisq(x,df)}
}}
if(g=="f"){
den=function(par,x){df1=par[2]; df2=par[3]; loc=par[4]; df(x-loc,df1,df2)}
cum=function(par,x){df1=par[2]; df2=par[3]; loc=par[4]; pf(x-loc,df1,df2)}
if (location==FALSE){
den=function(par,x){df1=par[2]; df2=par[3]; df(x,df1,df2)}
cum=function(par,x){df1=par[2]; df2=par[3]; pf(x,df1,df2)}
}}
if(g=="chen"){
den=function(par,x){a=par[2]; b=par[3]; loc=par[4]; a*b*(x-loc)^(a-1)*exp((x-loc)^a)*exp(-b*(exp((x-loc)^a)-1))}
cum=function(par,x){a=par[2]; b=par[3]; loc=par[4]; 1-exp(-b*(exp((x-loc)^a)-1))}
if (location==FALSE){
den=function(par,x){a=par[2]; b=par[3]; a*b*(x)^(a-1)*exp((x)^a)*exp(-b*(exp((x)^a)-1))}
cum=function(par,x){a=par[2]; b=par[3]; 1-exp(-b*(exp((x)^a)-1))}
}}
if(g=="lfr"){
den=function(par,x){a=par[2]; b=par[3]; loc=par[4]; (a+b*(x-loc))*exp(-a*(x-loc)-(b*(x-loc)^2)/2)}
cum=function(par,x){a=par[2]; b=par[3]; loc=par[4]; 1-exp(-a*(x-loc)-(b*(x-loc)^2)/2)}
if (location==FALSE){
den=function(par,x){a=par[2]; b=par[3]; (a+b*(x))*exp(-a*(x)-(b*(x)^2)/2)}
cum=function(par,x){a=par[2]; b=par[3]; 1-exp(-a*(x)-(b*(x)^2)/2)}
}}
if(g=="log-logistic"){
den=function(par,x){a=par[2]; b=par[3]; loc=par[4]; (a*b^(-a)*(x-loc)^(a-1))/((((x-loc)/b)^a +1)^2)}
cum=function(par,x){a=par[2]; b=par[3]; loc=par[4]; 1/(((x-loc)/b)^(-a)+1)}
if (location==FALSE){
den=function(par,x){a=par[2]; b=par[3]; (a*b^(-a)*(x)^(a-1))/((((x)/b)^a +1)^2)}
cum=function(par,x){a=par[2]; b=par[3]; 1/(((x)/b)^(-a)+1)}
}}
if(g=="lomax"){
den=function(par,x){a=par[2]; b=par[3]; loc=par[4]; (a*b)/((1+a*(x-loc))^(b+1))}
cum=function(par,x){a=par[2]; b=par[3]; loc=par[4]; 1-(1+a*(x-loc))^(-b)}
if (location==FALSE){
den=function(par,x){a=par[2]; b=par[3]; (a*b)/((1+a*(x))^(b+1))}
cum=function(par,x){a=par[2]; b=par[3]; 1-(1+a*(x))^(-b)}
}}
if(g=="gompertz"){
den=function(par,x){a=par[2]; b=par[3]; loc=par[4]; b*exp(a*(x-loc))*exp(-(exp(a*(x-loc))-1)*b/a)}
cum=function(par,x){a=par[2]; b=par[3]; loc=par[4]; 1-exp(-(exp(a*(x-loc))-1)*b/a)}
if (location==FALSE){
den=function(par,x){a=par[2]; b=par[3]; b*exp(a*(x))*exp(-(exp(a*(x))-1)*b/a)}
cum=function(par,x){a=par[2]; b=par[3]; 1-exp(-(exp(a*(x))-1)*b/a)}
}}
if(g=="exp"){
den=function(par,x){rate=par[2]; loc=par[3]; dexp(x-loc,rate)}
cum=function(par,x){rate=par[2]; loc=par[3]; pexp(x-loc,rate)}
if (location==FALSE){
den=function(par,x){rate=par[2]; dexp(x,rate)}
cum=function(par,x){rate=par[2]; pexp(x,rate)}
}}
if(g=="rayleigh"){
den=function(par,x){a=par[2]; loc=par[3]; 2*(x-loc)/a*exp(-((x-loc)/a)^2)}
cum=function(par,x){a=par[2]; loc=par[3]; 1-exp(-((x-loc)/a)^2)}
if (location==FALSE){
den=function(par,x){a=par[2]; 2*x/a*exp(-(x/a)^2)}
cum=function(par,x){a=par[2]; 1-exp(-(x/a)^2)}
}}
if(g=="burrxii"){
den=function(par,x){a=par[2]; d=par[3]; loc=par[4]; d*a*(1+(x-loc)^d)^(-a-1)*((x-loc)^(d-1))}
cum=function(par,x){a=par[2]; d=par[3]; loc=par[4]; 1-(1+(x-loc)^d)^(-a)}
if (location==FALSE){
den=function(par,x){a=par[2]; d=par[3]; d*a*(1+(x)^d)^(-a-1)*((x)^(d-1))}
cum=function(par,x){a=par[2]; d=par[3]; 1-(1+(x)^d)^(-a)}
}}
if(g=="frechet"){
den=function(par,x){a=par[2]; b=par[3]; loc=par[4]; (a*exp(-((x-loc)/b)^(-a))*((x-loc)/b)^(-a-1))/(b)}
cum=function(par,x){a=par[2]; b=par[3]; loc=par[4]; exp(-((x-loc)/b)^(-a))}
if (location==FALSE){
den=function(par,x){a=par[2]; b=par[3]; (a*exp(-((x)/b)^(-a))*((x)/b)^(-a-1))/(b)}
cum=function(par,x){a=par[2]; b=par[3]; exp(-((x)/b)^(-a))}
}}
if(g=="birnbaum-saunders"){
den=function(par,x){a=par[2]; b=par[3]; loc=par[4]; (sqrt((x-loc)/b)+sqrt(b/(x-loc)))/(2*a*(x-loc))*dnorm((sqrt((x-loc)/b)-sqrt(b/(x-loc)))/a)}
cum=function(par,x){a=par[2]; b=par[3]; loc=par[4]; pnorm((sqrt((x-loc)/b)-sqrt(b/(x-loc)))/a)}
if (location==FALSE){
den=function(par,x){a=par[2]; b=par[3]; (sqrt((x)/b)+sqrt(b/(x)))/(2*a*(x))*dnorm((sqrt((x)/b)-sqrt(b/(x)))/a)}
cum=function(par,x){a=par[2]; b=par[3]; pnorm((sqrt((x)/b)-sqrt(b/(x)))/a)}
}}
if(g=="weibull"){
den=function(par,x){shape=par[2]; scale=par[3]; loc=par[4]; dweibull(x-loc,shape,scale)}
cum=function(par,x){shape=par[2]; scale=par[3]; loc=par[4]; pweibull(x-loc,shape,scale)}
if (location==FALSE){
den=function(par,x){shape=par[2]; scale=par[3]; dweibull(x,shape,scale)}
cum=function(par,x){shape=par[2]; scale=par[3]; pweibull(x,shape,scale)}
}}
if(g=="gamma"){
den=function(par,x){shape=par[2]; scale=par[3]; loc=par[4]; dgamma(x-loc,shape,scale)}
cum=function(par,x){shape=par[2]; scale=par[3]; loc=par[4]; pgamma(x-loc,shape,scale)}
if (location==FALSE){
den=function(par,x){shape=par[2]; scale=par[3]; dgamma(x,shape,scale)}
cum=function(par,x){shape=par[2]; scale=par[3]; pgamma(x,shape,scale)}
}}
cdf0<-function(par,x){
f0=den(par,x)
c0=cum(par,x)
a=par[1]
pgamma(-log(1-c0),shape=a)
}
cdf<-cdf0(param,mydata)
if(log.p==TRUE & lower.tail == FALSE) cdf<-log(1-cdf)
if(log.p==TRUE & lower.tail == TRUE) cdf<-log(cdf)
if(log.p==FALSE & lower.tail == FALSE) cdf<-1-cdf
return(cdf)
}
dgammag1<-function(mydata, g, param, location=TRUE, log=FALSE){
if(g!="birnbaum-saunders" & g!="exp" & g!="rayleigh" & g!="weibull" & g!="gompertz" & g!="gamma"
& g!="log-normal" & g!="chisq" & g!="f" & g!="burrxii" & g!="frechet"
& g!="lomax" & g!="log-logistic" & g!="lfr" & g!="chen")
{ stop ("Baseline distribution not implemented or misspelled. Please check the manual for guidelines.") }
if(g=="log-normal"){
den=function(par,x){meanlog=par[2]; sdlog=par[3]; loc=par[4]; dlnorm(x-loc,meanlog,sdlog)}
cum=function(par,x){meanlog=par[2]; sdlog=par[3]; loc=par[4]; plnorm(x-loc,meanlog,sdlog)}
if (location==FALSE){
den=function(par,x){meanlog=par[2]; sdlog=par[3]; dlnorm(x,meanlog,sdlog)}
cum=function(par,x){meanlog=par[2]; sdlog=par[3]; plnorm(x,meanlog,sdlog)}
}}
if(g=="chisq"){
den=function(par,x){df=par[2]; loc=par[3]; dchisq(x-loc,df)}
cum=function(par,x){df=par[2]; loc=par[3]; pchisq(x-loc,df)}
if (location==FALSE){
den=function(par,x){df=par[2]; dchisq(x,df)}
cum=function(par,x){df=par[2]; pchisq(x,df)}
}}
if(g=="f"){
den=function(par,x){df1=par[2]; df2=par[3]; loc=par[4]; df(x-loc,df1,df2)}
cum=function(par,x){df1=par[2]; df2=par[3]; loc=par[4]; pf(x-loc,df1,df2)}
if (location==FALSE){
den=function(par,x){df1=par[2]; df2=par[3]; df(x,df1,df2)}
cum=function(par,x){df1=par[2]; df2=par[3]; pf(x,df1,df2)}
}}
if(g=="chen"){
den=function(par,x){a=par[2]; b=par[3]; loc=par[4]; a*b*(x-loc)^(a-1)*exp((x-loc)^a)*exp(-b*(exp((x-loc)^a)-1))}
cum=function(par,x){a=par[2]; b=par[3]; loc=par[4]; 1-exp(-b*(exp((x-loc)^a)-1))}
if (location==FALSE){
den=function(par,x){a=par[2]; b=par[3]; a*b*(x)^(a-1)*exp((x)^a)*exp(-b*(exp((x)^a)-1))}
cum=function(par,x){a=par[2]; b=par[3]; 1-exp(-b*(exp((x)^a)-1))}
}}
if(g=="lfr"){
den=function(par,x){a=par[2]; b=par[3]; loc=par[4]; (a+b*(x-loc))*exp(-a*(x-loc)-(b*(x-loc)^2)/2)}
cum=function(par,x){a=par[2]; b=par[3]; loc=par[4]; 1-exp(-a*(x-loc)-(b*(x-loc)^2)/2)}
if (location==FALSE){
den=function(par,x){a=par[2]; b=par[3]; (a+b*(x))*exp(-a*(x)-(b*(x)^2)/2)}
cum=function(par,x){a=par[2]; b=par[3]; 1-exp(-a*(x)-(b*(x)^2)/2)}
}}
if(g=="log-logistic"){
den=function(par,x){a=par[2]; b=par[3]; loc=par[4]; (a*b^(-a)*(x-loc)^(a-1))/((((x-loc)/b)^a +1)^2)}
cum=function(par,x){a=par[2]; b=par[3]; loc=par[4]; 1/(((x-loc)/b)^(-a)+1)}
if (location==FALSE){
den=function(par,x){a=par[2]; b=par[3]; (a*b^(-a)*(x)^(a-1))/((((x)/b)^a +1)^2)}
cum=function(par,x){a=par[2]; b=par[3]; 1/(((x)/b)^(-a)+1)}
}}
if(g=="lomax"){
den=function(par,x){a=par[2]; b=par[3]; loc=par[4]; (a*b)/((1+a*(x-loc))^(b+1))}
cum=function(par,x){a=par[2]; b=par[3]; loc=par[4]; 1-(1+a*(x-loc))^(-b)}
if (location==FALSE){
den=function(par,x){a=par[2]; b=par[3]; (a*b)/((1+a*(x))^(b+1))}
cum=function(par,x){a=par[2]; b=par[3]; 1-(1+a*(x))^(-b)}
}}
if(g=="gompertz"){
den=function(par,x){a=par[2]; b=par[3]; loc=par[4]; b*exp(a*(x-loc))*exp(-(exp(a*(x-loc))-1)*b/a)}
cum=function(par,x){a=par[2]; b=par[3]; loc=par[4]; 1-exp(-(exp(a*(x-loc))-1)*b/a)}
if (location==FALSE){
den=function(par,x){a=par[2]; b=par[3]; b*exp(a*(x))*exp(-(exp(a*(x))-1)*b/a)}
cum=function(par,x){a=par[2]; b=par[3]; 1-exp(-(exp(a*(x))-1)*b/a)}
}}
if(g=="exp"){
den=function(par,x){rate=par[2]; loc=par[3]; dexp(x-loc,rate)}
cum=function(par,x){rate=par[2]; loc=par[3]; pexp(x-loc,rate)}
if (location==FALSE){
den=function(par,x){rate=par[2]; dexp(x,rate)}
cum=function(par,x){rate=par[2]; pexp(x,rate)}
}}
if(g=="rayleigh"){
den=function(par,x){a=par[2]; loc=par[3]; 2*(x-loc)/a*exp(-((x-loc)/a)^2)}
cum=function(par,x){a=par[2]; loc=par[3]; 1-exp(-((x-loc)/a)^2)}
if (location==FALSE){
den=function(par,x){a=par[2]; 2*x/a*exp(-(x/a)^2)}
cum=function(par,x){a=par[2]; 1-exp(-(x/a)^2)}
}}
if(g=="burrxii"){
den=function(par,x){a=par[2]; d=par[3]; loc=par[4]; d*a*(1+(x-loc)^d)^(-a-1)*((x-loc)^(d-1))}
cum=function(par,x){a=par[2]; d=par[3]; loc=par[4]; 1-(1+(x-loc)^d)^(-a)}
if (location==FALSE){
den=function(par,x){a=par[2]; d=par[3]; d*a*(1+(x)^d)^(-a-1)*((x)^(d-1))}
cum=function(par,x){a=par[2]; d=par[3]; 1-(1+(x)^d)^(-a)}
}}
if(g=="frechet"){
den=function(par,x){a=par[2]; b=par[3]; loc=par[4]; (a*exp(-((x-loc)/b)^(-a))*((x-loc)/b)^(-a-1))/(b)}
cum=function(par,x){a=par[2]; b=par[3]; loc=par[4]; exp(-((x-loc)/b)^(-a))}
if (location==FALSE){
den=function(par,x){a=par[2]; b=par[3]; (a*exp(-((x)/b)^(-a))*((x)/b)^(-a-1))/(b)}
cum=function(par,x){a=par[2]; b=par[3]; exp(-((x)/b)^(-a))}
}}
if(g=="birnbaum-saunders"){
den=function(par,x){a=par[2]; b=par[3]; loc=par[4]; (sqrt((x-loc)/b)+sqrt(b/(x-loc)))/(2*a*(x-loc))*dnorm((sqrt((x-loc)/b)-sqrt(b/(x-loc)))/a)}
cum=function(par,x){a=par[2]; b=par[3]; loc=par[4]; pnorm((sqrt((x-loc)/b)-sqrt(b/(x-loc)))/a)}
if (location==FALSE){
den=function(par,x){a=par[2]; b=par[3]; (sqrt((x)/b)+sqrt(b/(x)))/(2*a*(x))*dnorm((sqrt((x)/b)-sqrt(b/(x)))/a)}
cum=function(par,x){a=par[2]; b=par[3]; pnorm((sqrt((x)/b)-sqrt(b/(x)))/a)}
}}
if(g=="weibull"){
den=function(par,x){shape=par[2]; scale=par[3]; loc=par[4]; dweibull(x-loc,shape,scale)}
cum=function(par,x){shape=par[2]; scale=par[3]; loc=par[4]; pweibull(x-loc,shape,scale)}
if (location==FALSE){
den=function(par,x){shape=par[2]; scale=par[3]; dweibull(x,shape,scale)}
cum=function(par,x){shape=par[2]; scale=par[3]; pweibull(x,shape,scale)}
}}
if(g=="gamma"){
den=function(par,x){shape=par[2]; scale=par[3]; loc=par[4]; dgamma(x-loc,shape,scale)}
cum=function(par,x){shape=par[2]; scale=par[3]; loc=par[4]; pgamma(x-loc,shape,scale)}
if (location==FALSE){
den=function(par,x){shape=par[2]; scale=par[3]; dgamma(x,shape,scale)}
cum=function(par,x){shape=par[2]; scale=par[3]; pgamma(x,shape,scale)}
}}
pdf0<-function(par,x){
f0=den(par,x)
c0=cum(par,x)
a=par[1]
gamma(a)^(-1)*f0*(-log(1-c0))^(a-1)
}
pdf<-pdf0(param,mydata)
if(log==TRUE){pdf<-log(pdf)}
return(pdf)
}
pgammag2<-function(mydata, g, param, location=TRUE, log.p = FALSE, lower.tail = TRUE){
if(g!="birnbaum-saunders" & g!="exp" & g!="rayleigh" & g!="weibull" & g!="gompertz" & g!="gamma"
& g!="log-normal" & g!="chisq" & g!="f" & g!="burrxii" & g!="frechet"
& g!="lomax" & g!="log-logistic" & g!="lfr" & g!="chen")
{ stop ("Baseline distribution not implemented or misspelled. Please check the manual for guidelines.") }
if(g=="log-normal"){
den=function(par,x){meanlog=par[2]; sdlog=par[3]; loc=par[4]; dlnorm(x-loc,meanlog,sdlog)}
cum=function(par,x){meanlog=par[2]; sdlog=par[3]; loc=par[4]; plnorm(x-loc,meanlog,sdlog)}
if (location==FALSE){
den=function(par,x){meanlog=par[2]; sdlog=par[3]; dlnorm(x,meanlog,sdlog)}
cum=function(par,x){meanlog=par[2]; sdlog=par[3]; plnorm(x,meanlog,sdlog)}
}}
if(g=="chisq"){
den=function(par,x){df=par[2]; loc=par[3]; dchisq(x-loc,df)}
cum=function(par,x){df=par[2]; loc=par[3]; pchisq(x-loc,df)}
if (location==FALSE){
den=function(par,x){df=par[2]; dchisq(x,df)}
cum=function(par,x){df=par[2]; pchisq(x,df)}
}}
if(g=="f"){
den=function(par,x){df1=par[2]; df2=par[3]; loc=par[4]; df(x-loc,df1,df2)}
cum=function(par,x){df1=par[2]; df2=par[3]; loc=par[4]; pf(x-loc,df1,df2)}
if (location==FALSE){
den=function(par,x){df1=par[2]; df2=par[3]; df(x,df1,df2)}
cum=function(par,x){df1=par[2]; df2=par[3]; pf(x,df1,df2)}
}}
if(g=="chen"){
den=function(par,x){a=par[2]; b=par[3]; loc=par[4]; a*b*(x-loc)^(a-1)*exp((x-loc)^a)*exp(-b*(exp((x-loc)^a)-1))}
cum=function(par,x){a=par[2]; b=par[3]; loc=par[4]; 1-exp(-b*(exp((x-loc)^a)-1))}
if (location==FALSE){
den=function(par,x){a=par[2]; b=par[3]; a*b*(x)^(a-1)*exp((x)^a)*exp(-b*(exp((x)^a)-1))}
cum=function(par,x){a=par[2]; b=par[3]; 1-exp(-b*(exp((x)^a)-1))}
}}
if(g=="lfr"){
den=function(par,x){a=par[2]; b=par[3]; loc=par[4]; (a+b*(x-loc))*exp(-a*(x-loc)-(b*(x-loc)^2)/2)}
cum=function(par,x){a=par[2]; b=par[3]; loc=par[4]; 1-exp(-a*(x-loc)-(b*(x-loc)^2)/2)}
if (location==FALSE){
den=function(par,x){a=par[2]; b=par[3]; (a+b*(x))*exp(-a*(x)-(b*(x)^2)/2)}
cum=function(par,x){a=par[2]; b=par[3]; 1-exp(-a*(x)-(b*(x)^2)/2)}
}}
if(g=="log-logistic"){
den=function(par,x){a=par[2]; b=par[3]; loc=par[4]; (a*b^(-a)*(x-loc)^(a-1))/((((x-loc)/b)^a +1)^2)}
cum=function(par,x){a=par[2]; b=par[3]; loc=par[4]; 1/(((x-loc)/b)^(-a)+1)}
if (location==FALSE){
den=function(par,x){a=par[2]; b=par[3]; (a*b^(-a)*(x)^(a-1))/((((x)/b)^a +1)^2)}
cum=function(par,x){a=par[2]; b=par[3]; 1/(((x)/b)^(-a)+1)}
}}
if(g=="lomax"){
den=function(par,x){a=par[2]; b=par[3]; loc=par[4]; (a*b)/((1+a*(x-loc))^(b+1))}
cum=function(par,x){a=par[2]; b=par[3]; loc=par[4]; 1-(1+a*(x-loc))^(-b)}
if (location==FALSE){
den=function(par,x){a=par[2]; b=par[3]; (a*b)/((1+a*(x))^(b+1))}
cum=function(par,x){a=par[2]; b=par[3]; 1-(1+a*(x))^(-b)}
}}
if(g=="gompertz"){
den=function(par,x){a=par[2]; b=par[3]; loc=par[4]; b*exp(a*(x-loc))*exp(-(exp(a*(x-loc))-1)*b/a)}
cum=function(par,x){a=par[2]; b=par[3]; loc=par[4]; 1-exp(-(exp(a*(x-loc))-1)*b/a)}
if (location==FALSE){
den=function(par,x){a=par[2]; b=par[3]; b*exp(a*(x))*exp(-(exp(a*(x))-1)*b/a)}
cum=function(par,x){a=par[2]; b=par[3]; 1-exp(-(exp(a*(x))-1)*b/a)}
}}
if(g=="exp"){
den=function(par,x){rate=par[2]; loc=par[3]; dexp(x-loc,rate)}
cum=function(par,x){rate=par[2]; loc=par[3]; pexp(x-loc,rate)}
if (location==FALSE){
den=function(par,x){rate=par[2]; dexp(x,rate)}
cum=function(par,x){rate=par[2]; pexp(x,rate)}
}}
if(g=="rayleigh"){
den=function(par,x){a=par[2]; loc=par[3]; 2*(x-loc)/a*exp(-((x-loc)/a)^2)}
cum=function(par,x){a=par[2]; loc=par[3]; 1-exp(-((x-loc)/a)^2)}
if (location==FALSE){
den=function(par,x){a=par[2]; 2*x/a*exp(-(x/a)^2)}
cum=function(par,x){a=par[2]; 1-exp(-(x/a)^2)}
}}
if(g=="burrxii"){
den=function(par,x){a=par[2]; d=par[3]; loc=par[4]; d*a*(1+(x-loc)^d)^(-a-1)*((x-loc)^(d-1))}
cum=function(par,x){a=par[2]; d=par[3]; loc=par[4]; 1-(1+(x-loc)^d)^(-a)}
if (location==FALSE){
den=function(par,x){a=par[2]; d=par[3]; d*a*(1+(x)^d)^(-a-1)*((x)^(d-1))}
cum=function(par,x){a=par[2]; d=par[3]; 1-(1+(x)^d)^(-a)}
}}
if(g=="frechet"){
den=function(par,x){a=par[2]; b=par[3]; loc=par[4]; (a*exp(-((x-loc)/b)^(-a))*((x-loc)/b)^(-a-1))/(b)}
cum=function(par,x){a=par[2]; b=par[3]; loc=par[4]; exp(-((x-loc)/b)^(-a))}
if (location==FALSE){
den=function(par,x){a=par[2]; b=par[3]; (a*exp(-((x)/b)^(-a))*((x)/b)^(-a-1))/(b)}
cum=function(par,x){a=par[2]; b=par[3]; exp(-((x)/b)^(-a))}
}}
if(g=="birnbaum-saunders"){
den=function(par,x){a=par[2]; b=par[3]; loc=par[4]; (sqrt((x-loc)/b)+sqrt(b/(x-loc)))/(2*a*(x-loc))*dnorm((sqrt((x-loc)/b)-sqrt(b/(x-loc)))/a)}
cum=function(par,x){a=par[2]; b=par[3]; loc=par[4]; pnorm((sqrt((x-loc)/b)-sqrt(b/(x-loc)))/a)}
if (location==FALSE){
den=function(par,x){a=par[2]; b=par[3]; (sqrt((x)/b)+sqrt(b/(x)))/(2*a*(x))*dnorm((sqrt((x)/b)-sqrt(b/(x)))/a)}
cum=function(par,x){a=par[2]; b=par[3]; pnorm((sqrt((x)/b)-sqrt(b/(x)))/a)}
}}
if(g=="weibull"){
den=function(par,x){shape=par[2]; scale=par[3]; loc=par[4]; dweibull(x-loc,shape,scale)}
cum=function(par,x){shape=par[2]; scale=par[3]; loc=par[4]; pweibull(x-loc,shape,scale)}
if (location==FALSE){
den=function(par,x){shape=par[2]; scale=par[3]; dweibull(x,shape,scale)}
cum=function(par,x){shape=par[2]; scale=par[3]; pweibull(x,shape,scale)}
}}
if(g=="gamma"){
den=function(par,x){shape=par[2]; scale=par[3]; loc=par[4]; dgamma(x-loc,shape,scale)}
cum=function(par,x){shape=par[2]; scale=par[3]; loc=par[4]; pgamma(x-loc,shape,scale)}
if (location==FALSE){
den=function(par,x){shape=par[2]; scale=par[3]; dgamma(x,shape,scale)}
cum=function(par,x){shape=par[2]; scale=par[3]; pgamma(x,shape,scale)}
}}
cdf0<-function(par,x){
f0=den(par,x)
c0=cum(par,x)
a=par[1]
pgamma(-log(c0),shape=a)
}
cdf<-cdf0(param,mydata)
if(log.p==TRUE & lower.tail == FALSE) cdf<-log(1-cdf)
if(log.p==TRUE & lower.tail == TRUE) cdf<-log(cdf)
if(log.p==FALSE & lower.tail == FALSE) cdf<-1-cdf
return(cdf)
}
dgammag2<-function(mydata, g, param, location=TRUE, log=FALSE){
if(g!="birnbaum-saunders" & g!="exp" & g!="rayleigh" & g!="weibull" & g!="gompertz" & g!="gamma"
& g!="log-normal" & g!="chisq" & g!="f" & g!="burrxii" & g!="frechet"
& g!="lomax" & g!="log-logistic" & g!="lfr" & g!="chen")
{ stop ("Baseline distribution not implemented or misspelled. Please check the manual for guidelines.") }
if(g=="log-normal"){
den=function(par,x){meanlog=par[2]; sdlog=par[3]; loc=par[4]; dlnorm(x-loc,meanlog,sdlog)}
cum=function(par,x){meanlog=par[2]; sdlog=par[3]; loc=par[4]; plnorm(x-loc,meanlog,sdlog)}
if (location==FALSE){
den=function(par,x){meanlog=par[2]; sdlog=par[3]; dlnorm(x,meanlog,sdlog)}
cum=function(par,x){meanlog=par[2]; sdlog=par[3]; plnorm(x,meanlog,sdlog)}
}}
if(g=="chisq"){
den=function(par,x){df=par[2]; loc=par[3]; dchisq(x-loc,df)}
cum=function(par,x){df=par[2]; loc=par[3]; pchisq(x-loc,df)}
if (location==FALSE){
den=function(par,x){df=par[2]; dchisq(x,df)}
cum=function(par,x){df=par[2]; pchisq(x,df)}
}}
if(g=="f"){
den=function(par,x){df1=par[2]; df2=par[3]; loc=par[4]; df(x-loc,df1,df2)}
cum=function(par,x){df1=par[2]; df2=par[3]; loc=par[4]; pf(x-loc,df1,df2)}
if (location==FALSE){
den=function(par,x){df1=par[2]; df2=par[3]; df(x,df1,df2)}
cum=function(par,x){df1=par[2]; df2=par[3]; pf(x,df1,df2)}
}}
if(g=="chen"){
den=function(par,x){a=par[2]; b=par[3]; loc=par[4]; a*b*(x-loc)^(a-1)*exp((x-loc)^a)*exp(-b*(exp((x-loc)^a)-1))}
cum=function(par,x){a=par[2]; b=par[3]; loc=par[4]; 1-exp(-b*(exp((x-loc)^a)-1))}
if (location==FALSE){
den=function(par,x){a=par[2]; b=par[3]; a*b*(x)^(a-1)*exp((x)^a)*exp(-b*(exp((x)^a)-1))}
cum=function(par,x){a=par[2]; b=par[3]; 1-exp(-b*(exp((x)^a)-1))}
}}
if(g=="lfr"){
den=function(par,x){a=par[2]; b=par[3]; loc=par[4]; (a+b*(x-loc))*exp(-a*(x-loc)-(b*(x-loc)^2)/2)}
cum=function(par,x){a=par[2]; b=par[3]; loc=par[4]; 1-exp(-a*(x-loc)-(b*(x-loc)^2)/2)}
if (location==FALSE){
den=function(par,x){a=par[2]; b=par[3]; (a+b*(x))*exp(-a*(x)-(b*(x)^2)/2)}
cum=function(par,x){a=par[2]; b=par[3]; 1-exp(-a*(x)-(b*(x)^2)/2)}
}}
if(g=="log-logistic"){
den=function(par,x){a=par[2]; b=par[3]; loc=par[4]; (a*b^(-a)*(x-loc)^(a-1))/((((x-loc)/b)^a +1)^2)}
cum=function(par,x){a=par[2]; b=par[3]; loc=par[4]; 1/(((x-loc)/b)^(-a)+1)}
if (location==FALSE){
den=function(par,x){a=par[2]; b=par[3]; (a*b^(-a)*(x)^(a-1))/((((x)/b)^a +1)^2)}
cum=function(par,x){a=par[2]; b=par[3]; 1/(((x)/b)^(-a)+1)}
}}
if(g=="lomax"){
den=function(par,x){a=par[2]; b=par[3]; loc=par[4]; (a*b)/((1+a*(x-loc))^(b+1))}
cum=function(par,x){a=par[2]; b=par[3]; loc=par[4]; 1-(1+a*(x-loc))^(-b)}
if (location==FALSE){
den=function(par,x){a=par[2]; b=par[3]; (a*b)/((1+a*(x))^(b+1))}
cum=function(par,x){a=par[2]; b=par[3]; 1-(1+a*(x))^(-b)}
}}
if(g=="gompertz"){
den=function(par,x){a=par[2]; b=par[3]; loc=par[4]; b*exp(a*(x-loc))*exp(-(exp(a*(x-loc))-1)*b/a)}
cum=function(par,x){a=par[2]; b=par[3]; loc=par[4]; 1-exp(-(exp(a*(x-loc))-1)*b/a)}
if (location==FALSE){
den=function(par,x){a=par[2]; b=par[3]; b*exp(a*(x))*exp(-(exp(a*(x))-1)*b/a)}
cum=function(par,x){a=par[2]; b=par[3]; 1-exp(-(exp(a*(x))-1)*b/a)}
}}
if(g=="exp"){
den=function(par,x){rate=par[2]; loc=par[3]; dexp(x-loc,rate)}
cum=function(par,x){rate=par[2]; loc=par[3]; pexp(x-loc,rate)}
if (location==FALSE){
den=function(par,x){rate=par[2]; dexp(x,rate)}
cum=function(par,x){rate=par[2]; pexp(x,rate)}
}}
if(g=="rayleigh"){
den=function(par,x){a=par[2]; loc=par[3]; 2*(x-loc)/a*exp(-((x-loc)/a)^2)}
cum=function(par,x){a=par[2]; loc=par[3]; 1-exp(-((x-loc)/a)^2)}
if (location==FALSE){
den=function(par,x){a=par[2]; 2*x/a*exp(-(x/a)^2)}
cum=function(par,x){a=par[2]; 1-exp(-(x/a)^2)}
}}
if(g=="burrxii"){
den=function(par,x){a=par[2]; d=par[3]; loc=par[4]; d*a*(1+(x-loc)^d)^(-a-1)*((x-loc)^(d-1))}
cum=function(par,x){a=par[2]; d=par[3]; loc=par[4]; 1-(1+(x-loc)^d)^(-a)}
if (location==FALSE){
den=function(par,x){a=par[2]; d=par[3]; d*a*(1+(x)^d)^(-a-1)*((x)^(d-1))}
cum=function(par,x){a=par[2]; d=par[3]; 1-(1+(x)^d)^(-a)}
}}
if(g=="frechet"){
den=function(par,x){a=par[2]; b=par[3]; loc=par[4]; (a*exp(-((x-loc)/b)^(-a))*((x-loc)/b)^(-a-1))/(b)}
cum=function(par,x){a=par[2]; b=par[3]; loc=par[4]; exp(-((x-loc)/b)^(-a))}
if (location==FALSE){
den=function(par,x){a=par[2]; b=par[3]; (a*exp(-((x)/b)^(-a))*((x)/b)^(-a-1))/(b)}
cum=function(par,x){a=par[2]; b=par[3]; exp(-((x)/b)^(-a))}
}}
if(g=="birnbaum-saunders"){
den=function(par,x){a=par[2]; b=par[3]; loc=par[4]; (sqrt((x-loc)/b)+sqrt(b/(x-loc)))/(2*a*(x-loc))*dnorm((sqrt((x-loc)/b)-sqrt(b/(x-loc)))/a)}
cum=function(par,x){a=par[2]; b=par[3]; loc=par[4]; pnorm((sqrt((x-loc)/b)-sqrt(b/(x-loc)))/a)}
if (location==FALSE){
den=function(par,x){a=par[2]; b=par[3]; (sqrt((x)/b)+sqrt(b/(x)))/(2*a*(x))*dnorm((sqrt((x)/b)-sqrt(b/(x)))/a)}
cum=function(par,x){a=par[2]; b=par[3]; pnorm((sqrt((x)/b)-sqrt(b/(x)))/a)}
}}
if(g=="weibull"){
den=function(par,x){shape=par[2]; scale=par[3]; loc=par[4]; dweibull(x-loc,shape,scale)}
cum=function(par,x){shape=par[2]; scale=par[3]; loc=par[4]; pweibull(x-loc,shape,scale)}
if (location==FALSE){
den=function(par,x){shape=par[2]; scale=par[3]; dweibull(x,shape,scale)}
cum=function(par,x){shape=par[2]; scale=par[3]; pweibull(x,shape,scale)}
}}
if(g=="gamma"){
den=function(par,x){shape=par[2]; scale=par[3]; loc=par[4]; dgamma(x-loc,shape,scale)}
cum=function(par,x){shape=par[2]; scale=par[3]; loc=par[4]; pgamma(x-loc,shape,scale)}
if (location==FALSE){
den=function(par,x){shape=par[2]; scale=par[3]; dgamma(x,shape,scale)}
cum=function(par,x){shape=par[2]; scale=par[3]; pgamma(x,shape,scale)}
}}
pdf0<-function(par,x){
f0=den(par,x)
c0=cum(par,x)
a=par[1]
gamma(a)^(-1)*f0*(-log(c0))^(a-1)
}
pdf<-pdf0(param,mydata)
if(log==TRUE){pdf<-log(pdf)}
return(pdf)
}
pgbetag<-function(mydata, g, param, location=TRUE, log.p = FALSE, lower.tail = TRUE){
if(g!="birnbaum-saunders" & g!="exp" & g!="rayleigh" & g!="weibull" & g!="gompertz" & g!="gamma"
& g!="log-normal" & g!="chisq" & g!="f" & g!="burrxii" & g!="frechet"
& g!="lomax" & g!="log-logistic" & g!="lfr" & g!="chen")
{ stop ("Baseline distribution not implemented or misspelled. Please check the manual for guidelines.") }
if(g=="log-normal"){
den=function(par,x){meanlog=par[4]; sdlog=par[5]; loc=par[6]; dlnorm(x-loc,meanlog,sdlog)}
cum=function(par,x){meanlog=par[4]; sdlog=par[5]; loc=par[6]; plnorm(x-loc,meanlog,sdlog)}
if (location==FALSE){
den=function(par,x){meanlog=par[4]; sdlog=par[5]; dlnorm(x,meanlog,sdlog)}
cum=function(par,x){meanlog=par[4]; sdlog=par[5]; plnorm(x,meanlog,sdlog)}
}}
if(g=="chisq"){
den=function(par,x){df=par[4]; loc=par[5]; dchisq(x-loc,df)}
cum=function(par,x){df=par[4]; loc=par[5]; pchisq(x-loc,df)}
if (location==FALSE){
den=function(par,x){df=par[4]; dchisq(x,df)}
cum=function(par,x){df=par[4]; pchisq(x,df)}
}}
if(g=="f"){
den=function(par,x){df1=par[4]; df2=par[5]; loc=par[6]; df(x-loc,df1,df2)}
cum=function(par,x){df1=par[4]; df2=par[5]; loc=par[6]; pf(x-loc,df1,df2)}
if (location==FALSE){
den=function(par,x){df1=par[4]; df2=par[5]; df(x,df1,df2)}
cum=function(par,x){df1=par[4]; df2=par[5]; pf(x,df1,df2)}
}}
if(g=="chen"){
den=function(par,x){a=par[4]; b=par[5]; loc=par[6]; a*b*(x-loc)^(a-1)*exp((x-loc)^a)*exp(-b*(exp((x-loc)^a)-1))}
cum=function(par,x){a=par[4]; b=par[5]; loc=par[6]; 1-exp(-b*(exp((x-loc)^a)-1))}
if (location==FALSE){
den=function(par,x){a=par[4]; b=par[5]; a*b*(x)^(a-1)*exp((x)^a)*exp(-b*(exp((x)^a)-1))}
cum=function(par,x){a=par[4]; b=par[5]; 1-exp(-b*(exp((x)^a)-1))}
}}
if(g=="lfr"){
den=function(par,x){a=par[4]; b=par[5]; loc=par[6]; (a+b*(x-loc))*exp(-a*(x-loc)-(b*(x-loc)^2)/2)}
cum=function(par,x){a=par[4]; b=par[5]; loc=par[6]; 1-exp(-a*(x-loc)-(b*(x-loc)^2)/2)}
if (location==FALSE){
den=function(par,x){a=par[4]; b=par[5]; (a+b*(x))*exp(-a*(x)-(b*(x)^2)/2)}
cum=function(par,x){a=par[4]; b=par[5]; 1-exp(-a*(x)-(b*(x)^2)/2)}
}}
if(g=="log-logistic"){
den=function(par,x){a=par[4]; b=par[5]; loc=par[6]; (a*b^(-a)*(x-loc)^(a-1))/((((x-loc)/b)^a +1)^2)}
cum=function(par,x){a=par[4]; b=par[5]; loc=par[6]; 1/(((x-loc)/b)^(-a)+1)}
if (location==FALSE){
den=function(par,x){a=par[4]; b=par[5]; (a*b^(-a)*(x)^(a-1))/((((x)/b)^a +1)^2)}
cum=function(par,x){a=par[4]; b=par[5]; 1/(((x)/b)^(-a)+1)}
}}
if(g=="lomax"){
den=function(par,x){a=par[4]; b=par[5]; loc=par[6]; (a*b)/((1+a*(x-loc))^(b+1))}
cum=function(par,x){a=par[4]; b=par[5]; loc=par[6]; 1-(1+a*(x-loc))^(-b)}
if (location==FALSE){
den=function(par,x){a=par[4]; b=par[5]; (a*b)/((1+a*(x))^(b+1))}
cum=function(par,x){a=par[4]; b=par[5]; 1-(1+a*(x))^(-b)}
}}
if(g=="gompertz"){
den=function(par,x){a=par[4]; b=par[5]; loc=par[6]; b*exp(a*(x-loc))*exp(-(exp(a*(x-loc))-1)*b/a)}
cum=function(par,x){a=par[4]; b=par[5]; loc=par[6]; 1-exp(-(exp(a*(x-loc))-1)*b/a)}
if (location==FALSE){
den=function(par,x){a=par[4]; b=par[5]; b*exp(a*(x))*exp(-(exp(a*(x))-1)*b/a)}
cum=function(par,x){a=par[4]; b=par[5]; 1-exp(-(exp(a*(x))-1)*b/a)}
}}
if(g=="exp"){
den=function(par,x){rate=par[4]; loc=par[5]; dexp(x-loc,rate)}
cum=function(par,x){rate=par[4]; loc=par[5]; pexp(x-loc,rate)}
if (location==FALSE){
den=function(par,x){rate=par[4]; dexp(x,rate)}
cum=function(par,x){rate=par[4]; pexp(x,rate)}
}}
if(g=="rayleigh"){
den=function(par,x){a=par[4]; loc=par[5]; 2*(x-loc)/a*exp(-((x-loc)/a)^2)}
cum=function(par,x){a=par[4]; loc=par[5]; 1-exp(-((x-loc)/a)^2)}
if (location==FALSE){
den=function(par,x){a=par[4]; 2*x/a*exp(-(x/a)^2)}
cum=function(par,x){a=par[4]; 1-exp(-(x/a)^2)}
}}
if(g=="burrxii"){
den=function(par,x){a=par[4]; d=par[5]; loc=par[6]; d*a*(1+(x-loc)^d)^(-a-1)*((x-loc)^(d-1))}
cum=function(par,x){a=par[4]; d=par[5]; loc=par[6]; 1-(1+(x-loc)^d)^(-a)}
if (location==FALSE){
den=function(par,x){a=par[4]; d=par[5]; d*a*(1+(x)^d)^(-a-1)*((x)^(d-1))}
cum=function(par,x){a=par[4]; d=par[5]; 1-(1+(x)^d)^(-a)}
}}
if(g=="frechet"){
den=function(par,x){a=par[4]; b=par[5]; loc=par[6]; (a*exp(-((x-loc)/b)^(-a))*((x-loc)/b)^(-a-1))/(b)}
cum=function(par,x){a=par[4]; b=par[5]; loc=par[6]; exp(-((x-loc)/b)^(-a))}
if (location==FALSE){
den=function(par,x){a=par[4]; b=par[5]; (a*exp(-((x)/b)^(-a))*((x)/b)^(-a-1))/(b)}
cum=function(par,x){a=par[4]; b=par[5]; exp(-((x)/b)^(-a))}
}}
if(g=="birnbaum-saunders"){
den=function(par,x){a=par[4]; b=par[5]; loc=par[6]; (sqrt((x-loc)/b)+sqrt(b/(x-loc)))/(2*a*(x-loc))*dnorm((sqrt((x-loc)/b)-sqrt(b/(x-loc)))/a)}
cum=function(par,x){a=par[4]; b=par[5]; loc=par[6]; pnorm((sqrt((x-loc)/b)-sqrt(b/(x-loc)))/a)}
if (location==FALSE){
den=function(par,x){a=par[4]; b=par[5]; (sqrt((x)/b)+sqrt(b/(x)))/(2*a*(x))*dnorm((sqrt((x)/b)-sqrt(b/(x)))/a)}
cum=function(par,x){a=par[4]; b=par[5]; pnorm((sqrt((x)/b)-sqrt(b/(x)))/a)}
}}
if(g=="weibull"){
den=function(par,x){shape=par[4]; scale=par[5]; loc=par[6]; dweibull(x-loc,shape,scale)}
cum=function(par,x){shape=par[4]; scale=par[5]; loc=par[6]; pweibull(x-loc,shape,scale)}
if (location==FALSE){
den=function(par,x){shape=par[4]; scale=par[5]; dweibull(x,shape,scale)}
cum=function(par,x){shape=par[4]; scale=par[5]; pweibull(x,shape,scale)}
}}
if(g=="gamma"){
den=function(par,x){shape=par[4]; scale=par[5]; loc=par[6]; dgamma(x-loc,shape,scale)}
cum=function(par,x){shape=par[4]; scale=par[5]; loc=par[6]; pgamma(x-loc,shape,scale)}
if (location==FALSE){
den=function(par,x){shape=par[4]; scale=par[5]; dgamma(x,shape,scale)}
cum=function(par,x){shape=par[4]; scale=par[5]; pgamma(x,shape,scale)}
}}
cdf0<-function(par,x){
f0=den(par,x)
c0=cum(par,x)
a=par[1]
b=par[2]
d=par[3]
pbeta(c0^d,shape1=a,shape2=b)
}
cdf<-cdf0(param,mydata)
if(log.p==TRUE & lower.tail == FALSE) cdf<-log(1-cdf)
if(log.p==TRUE & lower.tail == TRUE) cdf<-log(cdf)
if(log.p==FALSE & lower.tail == FALSE) cdf<-1-cdf
return(cdf)
}
dgbetag<-function(mydata, g, param, location=TRUE, log=FALSE){
if(g!="birnbaum-saunders" & g!="exp" & g!="rayleigh" & g!="weibull" & g!="gompertz" & g!="gamma"
& g!="log-normal" & g!="chisq" & g!="f" & g!="burrxii" & g!="frechet"
& g!="lomax" & g!="log-logistic" & g!="lfr" & g!="chen")
{ stop ("Baseline distribution not implemented or misspelled. Please check the manual for guidelines.") }
if(g=="log-normal"){
den=function(par,x){meanlog=par[4]; sdlog=par[5]; loc=par[6]; dlnorm(x-loc,meanlog,sdlog)}
cum=function(par,x){meanlog=par[4]; sdlog=par[5]; loc=par[6]; plnorm(x-loc,meanlog,sdlog)}
if (location==FALSE){
den=function(par,x){meanlog=par[4]; sdlog=par[5]; dlnorm(x,meanlog,sdlog)}
cum=function(par,x){meanlog=par[4]; sdlog=par[5]; plnorm(x,meanlog,sdlog)}
}}
if(g=="chisq"){
den=function(par,x){df=par[4]; loc=par[5]; dchisq(x-loc,df)}
cum=function(par,x){df=par[4]; loc=par[5]; pchisq(x-loc,df)}
if (location==FALSE){
den=function(par,x){df=par[4]; dchisq(x,df)}
cum=function(par,x){df=par[4]; pchisq(x,df)}
}}
if(g=="f"){
den=function(par,x){df1=par[4]; df2=par[5]; loc=par[6]; df(x-loc,df1,df2)}
cum=function(par,x){df1=par[4]; df2=par[5]; loc=par[6]; pf(x-loc,df1,df2)}
if (location==FALSE){
den=function(par,x){df1=par[4]; df2=par[5]; df(x,df1,df2)}
cum=function(par,x){df1=par[4]; df2=par[5]; pf(x,df1,df2)}
}}
if(g=="chen"){
den=function(par,x){a=par[4]; b=par[5]; loc=par[6]; a*b*(x-loc)^(a-1)*exp((x-loc)^a)*exp(-b*(exp((x-loc)^a)-1))}
cum=function(par,x){a=par[4]; b=par[5]; loc=par[6]; 1-exp(-b*(exp((x-loc)^a)-1))}
if (location==FALSE){
den=function(par,x){a=par[4]; b=par[5]; a*b*(x)^(a-1)*exp((x)^a)*exp(-b*(exp((x)^a)-1))}
cum=function(par,x){a=par[4]; b=par[5]; 1-exp(-b*(exp((x)^a)-1))}
}}
if(g=="lfr"){
den=function(par,x){a=par[4]; b=par[5]; loc=par[6]; (a+b*(x-loc))*exp(-a*(x-loc)-(b*(x-loc)^2)/2)}
cum=function(par,x){a=par[4]; b=par[5]; loc=par[6]; 1-exp(-a*(x-loc)-(b*(x-loc)^2)/2)}
if (location==FALSE){
den=function(par,x){a=par[4]; b=par[5]; (a+b*(x))*exp(-a*(x)-(b*(x)^2)/2)}
cum=function(par,x){a=par[4]; b=par[5]; 1-exp(-a*(x)-(b*(x)^2)/2)}
}}
if(g=="log-logistic"){
den=function(par,x){a=par[4]; b=par[5]; loc=par[6]; (a*b^(-a)*(x-loc)^(a-1))/((((x-loc)/b)^a +1)^2)}
cum=function(par,x){a=par[4]; b=par[5]; loc=par[6]; 1/(((x-loc)/b)^(-a)+1)}
if (location==FALSE){
den=function(par,x){a=par[4]; b=par[5]; (a*b^(-a)*(x)^(a-1))/((((x)/b)^a +1)^2)}
cum=function(par,x){a=par[4]; b=par[5]; 1/(((x)/b)^(-a)+1)}
}}
if(g=="lomax"){
den=function(par,x){a=par[4]; b=par[5]; loc=par[6]; (a*b)/((1+a*(x-loc))^(b+1))}
cum=function(par,x){a=par[4]; b=par[5]; loc=par[6]; 1-(1+a*(x-loc))^(-b)}
if (location==FALSE){
den=function(par,x){a=par[4]; b=par[5]; (a*b)/((1+a*(x))^(b+1))}
cum=function(par,x){a=par[4]; b=par[5]; 1-(1+a*(x))^(-b)}
}}
if(g=="gompertz"){
den=function(par,x){a=par[4]; b=par[5]; loc=par[6]; b*exp(a*(x-loc))*exp(-(exp(a*(x-loc))-1)*b/a)}
cum=function(par,x){a=par[4]; b=par[5]; loc=par[6]; 1-exp(-(exp(a*(x-loc))-1)*b/a)}
if (location==FALSE){
den=function(par,x){a=par[4]; b=par[5]; b*exp(a*(x))*exp(-(exp(a*(x))-1)*b/a)}
cum=function(par,x){a=par[4]; b=par[5]; 1-exp(-(exp(a*(x))-1)*b/a)}
}}
if(g=="exp"){
den=function(par,x){rate=par[4]; loc=par[5]; dexp(x-loc,rate)}
cum=function(par,x){rate=par[4]; loc=par[5]; pexp(x-loc,rate)}
if (location==FALSE){
den=function(par,x){rate=par[4]; dexp(x,rate)}
cum=function(par,x){rate=par[4]; pexp(x,rate)}
}}
if(g=="rayleigh"){
den=function(par,x){a=par[4]; loc=par[5]; 2*(x-loc)/a*exp(-((x-loc)/a)^2)}
cum=function(par,x){a=par[4]; loc=par[5]; 1-exp(-((x-loc)/a)^2)}
if (location==FALSE){
den=function(par,x){a=par[4]; 2*x/a*exp(-(x/a)^2)}
cum=function(par,x){a=par[4]; 1-exp(-(x/a)^2)}
}}
if(g=="burrxii"){
den=function(par,x){a=par[4]; d=par[5]; loc=par[6]; d*a*(1+(x-loc)^d)^(-a-1)*((x-loc)^(d-1))}
cum=function(par,x){a=par[4]; d=par[5]; loc=par[6]; 1-(1+(x-loc)^d)^(-a)}
if (location==FALSE){
den=function(par,x){a=par[4]; d=par[5]; d*a*(1+(x)^d)^(-a-1)*((x)^(d-1))}
cum=function(par,x){a=par[4]; d=par[5]; 1-(1+(x)^d)^(-a)}
}}
if(g=="frechet"){
den=function(par,x){a=par[4]; b=par[5]; loc=par[6]; (a*exp(-((x-loc)/b)^(-a))*((x-loc)/b)^(-a-1))/(b)}
cum=function(par,x){a=par[4]; b=par[5]; loc=par[6]; exp(-((x-loc)/b)^(-a))}
if (location==FALSE){
den=function(par,x){a=par[4]; b=par[5]; (a*exp(-((x)/b)^(-a))*((x)/b)^(-a-1))/(b)}
cum=function(par,x){a=par[4]; b=par[5]; exp(-((x)/b)^(-a))}
}}
if(g=="birnbaum-saunders"){
den=function(par,x){a=par[4]; b=par[5]; loc=par[6]; (sqrt((x-loc)/b)+sqrt(b/(x-loc)))/(2*a*(x-loc))*dnorm((sqrt((x-loc)/b)-sqrt(b/(x-loc)))/a)}
cum=function(par,x){a=par[4]; b=par[5]; loc=par[6]; pnorm((sqrt((x-loc)/b)-sqrt(b/(x-loc)))/a)}
if (location==FALSE){
den=function(par,x){a=par[4]; b=par[5]; (sqrt((x)/b)+sqrt(b/(x)))/(2*a*(x))*dnorm((sqrt((x)/b)-sqrt(b/(x)))/a)}
cum=function(par,x){a=par[4]; b=par[5]; pnorm((sqrt((x)/b)-sqrt(b/(x)))/a)}
}}
if(g=="weibull"){
den=function(par,x){shape=par[4]; scale=par[5]; loc=par[6]; dweibull(x-loc,shape,scale)}
cum=function(par,x){shape=par[4]; scale=par[5]; loc=par[6]; pweibull(x-loc,shape,scale)}
if (location==FALSE){
den=function(par,x){shape=par[4]; scale=par[5]; dweibull(x,shape,scale)}
cum=function(par,x){shape=par[4]; scale=par[5]; pweibull(x,shape,scale)}
}}
if(g=="gamma"){
den=function(par,x){shape=par[4]; scale=par[5]; loc=par[6]; dgamma(x-loc,shape,scale)}
cum=function(par,x){shape=par[4]; scale=par[5]; loc=par[6]; pgamma(x-loc,shape,scale)}
if (location==FALSE){
den=function(par,x){shape=par[4]; scale=par[5]; dgamma(x,shape,scale)}
cum=function(par,x){shape=par[4]; scale=par[5]; pgamma(x,shape,scale)}
}}
pdf0<-function(par,x){
f0=den(par,x)
c0=cum(par,x)
a=par[1]
b=par[2]
d=par[3]
d*beta(a,b)^(-1)*f0*c0^(a*d-1)*(1-c0^d)^(b-1)
}
pdf<-pdf0(param,mydata)
if(log==TRUE){pdf<-log(pdf)}
return(pdf)
}
pgtransg<-function(mydata, g, param, location=TRUE, log.p = FALSE, lower.tail = TRUE){
if(g!="birnbaum-saunders" & g!="exp" & g!="rayleigh" & g!="weibull" & g!="gompertz" & g!="gamma"
& g!="log-normal" & g!="chisq" & g!="f" & g!="burrxii" & g!="frechet"
& g!="lomax" & g!="log-logistic" & g!="lfr" & g!="chen")
{ stop ("Baseline distribution not implemented or misspelled. Please check the manual for guidelines.") }
if(g=="log-normal"){
den=function(par,x){meanlog=par[3]; sdlog=par[4]; loc=par[5]; dlnorm(x-loc,meanlog,sdlog)}
cum=function(par,x){meanlog=par[3]; sdlog=par[4]; loc=par[5]; plnorm(x-loc,meanlog,sdlog)}
if (location==FALSE){
den=function(par,x){meanlog=par[3]; sdlog=par[4]; dlnorm(x,meanlog,sdlog)}
cum=function(par,x){meanlog=par[3]; sdlog=par[4]; plnorm(x,meanlog,sdlog)}
}}
if(g=="chisq"){
den=function(par,x){df=par[3]; loc=par[4]; dchisq(x-loc,df)}
cum=function(par,x){df=par[3]; loc=par[4]; pchisq(x-loc,df)}
if (location==FALSE){
den=function(par,x){df=par[3]; dchisq(x,df)}
cum=function(par,x){df=par[3]; pchisq(x,df)}
}}
if(g=="f"){
den=function(par,x){df1=par[3]; df2=par[4]; loc=par[5]; df(x-loc,df1,df2)}
cum=function(par,x){df1=par[3]; df2=par[4]; loc=par[5]; pf(x-loc,df1,df2)}
if (location==FALSE){
den=function(par,x){df1=par[3]; df2=par[4]; df(x,df1,df2)}
cum=function(par,x){df1=par[3]; df2=par[4]; pf(x,df1,df2)}
}}
if(g=="chen"){
den=function(par,x){a=par[3]; b=par[4]; loc=par[5]; a*b*(x-loc)^(a-1)*exp((x-loc)^a)*exp(-b*(exp((x-loc)^a)-1))}
cum=function(par,x){a=par[3]; b=par[4]; loc=par[5]; 1-exp(-b*(exp((x-loc)^a)-1))}
if (location==FALSE){
den=function(par,x){a=par[3]; b=par[4]; a*b*(x)^(a-1)*exp((x)^a)*exp(-b*(exp((x)^a)-1))}
cum=function(par,x){a=par[3]; b=par[4]; 1-exp(-b*(exp((x)^a)-1))}
}}
if(g=="lfr"){
den=function(par,x){a=par[3]; b=par[4]; loc=par[5]; (a+b*(x-loc))*exp(-a*(x-loc)-(b*(x-loc)^2)/2)}
cum=function(par,x){a=par[3]; b=par[4]; loc=par[5]; 1-exp(-a*(x-loc)-(b*(x-loc)^2)/2)}
if (location==FALSE){
den=function(par,x){a=par[3]; b=par[4]; (a+b*(x))*exp(-a*(x)-(b*(x)^2)/2)}
cum=function(par,x){a=par[3]; b=par[4]; 1-exp(-a*(x)-(b*(x)^2)/2)}
}}
if(g=="log-logistic"){
den=function(par,x){a=par[3]; b=par[4]; loc=par[5]; (a*b^(-a)*(x-loc)^(a-1))/((((x-loc)/b)^a +1)^2)}
cum=function(par,x){a=par[3]; b=par[4]; loc=par[5]; 1/(((x-loc)/b)^(-a)+1)}
if (location==FALSE){
den=function(par,x){a=par[3]; b=par[4]; (a*b^(-a)*(x)^(a-1))/((((x)/b)^a +1)^2)}
cum=function(par,x){a=par[3]; b=par[4]; 1/(((x)/b)^(-a)+1)}
}}
if(g=="lomax"){
den=function(par,x){a=par[3]; b=par[4]; loc=par[5]; (a*b)/((1+a*(x-loc))^(b+1))}
cum=function(par,x){a=par[3]; b=par[4]; loc=par[5]; 1-(1+a*(x-loc))^(-b)}
if (location==FALSE){
den=function(par,x){a=par[3]; b=par[4]; (a*b)/((1+a*(x))^(b+1))}
cum=function(par,x){a=par[3]; b=par[4]; 1-(1+a*(x))^(-b)}
}}
if(g=="gompertz"){
den=function(par,x){a=par[3]; b=par[4]; loc=par[5]; b*exp(a*(x-loc))*exp(-(exp(a*(x-loc))-1)*b/a)}
cum=function(par,x){a=par[3]; b=par[4]; loc=par[5]; 1-exp(-(exp(a*(x-loc))-1)*b/a)}
if (location==FALSE){
den=function(par,x){a=par[3]; b=par[4]; b*exp(a*(x))*exp(-(exp(a*(x))-1)*b/a)}
cum=function(par,x){a=par[3]; b=par[4]; 1-exp(-(exp(a*(x))-1)*b/a)}
}}
if(g=="exp"){
den=function(par,x){rate=par[3]; loc=par[4]; dexp(x-loc,rate)}
cum=function(par,x){rate=par[3]; loc=par[4]; pexp(x-loc,rate)}
if (location==FALSE){
den=function(par,x){rate=par[3]; dexp(x,rate)}
cum=function(par,x){rate=par[3]; pexp(x,rate)}
}}
if(g=="rayleigh"){
den=function(par,x){a=par[3]; loc=par[4]; 2*(x-loc)/a*exp(-((x-loc)/a)^2)}
cum=function(par,x){a=par[3]; loc=par[4]; 1-exp(-((x-loc)/a)^2)}
if (location==FALSE){
den=function(par,x){a=par[3]; 2*x/a*exp(-(x/a)^2)}
cum=function(par,x){a=par[3]; 1-exp(-(x/a)^2)}
}}
if(g=="burrxii"){
den=function(par,x){a=par[3]; d=par[4]; loc=par[5]; d*a*(1+(x-loc)^d)^(-a-1)*((x-loc)^(d-1))}
cum=function(par,x){a=par[3]; d=par[4]; loc=par[5]; 1-(1+(x-loc)^d)^(-a)}
if (location==FALSE){
den=function(par,x){a=par[3]; d=par[4]; d*a*(1+(x)^d)^(-a-1)*((x)^(d-1))}
cum=function(par,x){a=par[3]; d=par[4]; 1-(1+(x)^d)^(-a)}
}}
if(g=="frechet"){
den=function(par,x){a=par[3]; b=par[4]; loc=par[5]; (a*exp(-((x-loc)/b)^(-a))*((x-loc)/b)^(-a-1))/(b)}
cum=function(par,x){a=par[3]; b=par[4]; loc=par[5]; exp(-((x-loc)/b)^(-a))}
if (location==FALSE){
den=function(par,x){a=par[3]; b=par[4]; (a*exp(-((x)/b)^(-a))*((x)/b)^(-a-1))/(b)}
cum=function(par,x){a=par[3]; b=par[4]; exp(-((x)/b)^(-a))}
}}
if(g=="birnbaum-saunders"){
den=function(par,x){a=par[3]; b=par[4]; loc=par[5]; (sqrt((x-loc)/b)+sqrt(b/(x-loc)))/(2*a*(x-loc))*dnorm((sqrt((x-loc)/b)-sqrt(b/(x-loc)))/a)}
cum=function(par,x){a=par[3]; b=par[4]; loc=par[5]; pnorm((sqrt((x-loc)/b)-sqrt(b/(x-loc)))/a)}
if (location==FALSE){
den=function(par,x){a=par[3]; b=par[4]; (sqrt((x)/b)+sqrt(b/(x)))/(2*a*(x))*dnorm((sqrt((x)/b)-sqrt(b/(x)))/a)}
cum=function(par,x){a=par[3]; b=par[4]; pnorm((sqrt((x)/b)-sqrt(b/(x)))/a)}
}}
if(g=="weibull"){
den=function(par,x){shape=par[3]; scale=par[4]; loc=par[5]; dweibull(x-loc,shape,scale)}
cum=function(par,x){shape=par[3]; scale=par[4]; loc=par[5]; pweibull(x-loc,shape,scale)}
if (location==FALSE){
den=function(par,x){shape=par[3]; scale=par[4]; dweibull(x,shape,scale)}
cum=function(par,x){shape=par[3]; scale=par[4]; pweibull(x,shape,scale)}
}}
if(g=="gamma"){
den=function(par,x){shape=par[3]; scale=par[4]; loc=par[5]; dgamma(x-loc,shape,scale)}
cum=function(par,x){shape=par[3]; scale=par[4]; loc=par[5]; pgamma(x-loc,shape,scale)}
if (location==FALSE){
den=function(par,x){shape=par[3]; scale=par[4]; dgamma(x,shape,scale)}
cum=function(par,x){shape=par[3]; scale=par[4]; pgamma(x,shape,scale)}
}}
cdf0<-function(par,x){
f0=den(par,x)
c0=cum(par,x)
a=par[1]
b=par[2]
(c0)**a*(1+b*(1-c0))**(a)
}
cdf<-cdf0(param,mydata)
if(log.p==TRUE & lower.tail == FALSE) cdf<-log(1-cdf)
if(log.p==TRUE & lower.tail == TRUE) cdf<-log(cdf)
if(log.p==FALSE & lower.tail == FALSE) cdf<-1-cdf
return(cdf)
}
dgtransg<-function(mydata, g, param, location=TRUE, log=FALSE){
if(g!="birnbaum-saunders" & g!="exp" & g!="rayleigh" & g!="weibull" & g!="gompertz" & g!="gamma"
& g!="log-normal" & g!="chisq" & g!="f" & g!="burrxii" & g!="frechet"
& g!="lomax" & g!="log-logistic" & g!="lfr" & g!="chen")
{ stop ("Baseline distribution not implemented or misspelled. Please check the manual for guidelines.") }
if(g=="log-normal"){
den=function(par,x){meanlog=par[3]; sdlog=par[4]; loc=par[5]; dlnorm(x-loc,meanlog,sdlog)}
cum=function(par,x){meanlog=par[3]; sdlog=par[4]; loc=par[5]; plnorm(x-loc,meanlog,sdlog)}
if (location==FALSE){
den=function(par,x){meanlog=par[3]; sdlog=par[4]; dlnorm(x,meanlog,sdlog)}
cum=function(par,x){meanlog=par[3]; sdlog=par[4]; plnorm(x,meanlog,sdlog)}
}}
if(g=="chisq"){
den=function(par,x){df=par[3]; loc=par[4]; dchisq(x-loc,df)}
cum=function(par,x){df=par[3]; loc=par[4]; pchisq(x-loc,df)}
if (location==FALSE){
den=function(par,x){df=par[3]; dchisq(x,df)}
cum=function(par,x){df=par[3]; pchisq(x,df)}
}}
if(g=="f"){
den=function(par,x){df1=par[3]; df2=par[4]; loc=par[5]; df(x-loc,df1,df2)}
cum=function(par,x){df1=par[3]; df2=par[4]; loc=par[5]; pf(x-loc,df1,df2)}
if (location==FALSE){
den=function(par,x){df1=par[3]; df2=par[4]; df(x,df1,df2)}
cum=function(par,x){df1=par[3]; df2=par[4]; pf(x,df1,df2)}
}}
if(g=="chen"){
den=function(par,x){a=par[3]; b=par[4]; loc=par[5]; a*b*(x-loc)^(a-1)*exp((x-loc)^a)*exp(-b*(exp((x-loc)^a)-1))}
cum=function(par,x){a=par[3]; b=par[4]; loc=par[5]; 1-exp(-b*(exp((x-loc)^a)-1))}
if (location==FALSE){
den=function(par,x){a=par[3]; b=par[4]; a*b*(x)^(a-1)*exp((x)^a)*exp(-b*(exp((x)^a)-1))}
cum=function(par,x){a=par[3]; b=par[4]; 1-exp(-b*(exp((x)^a)-1))}
}}
if(g=="lfr"){
den=function(par,x){a=par[3]; b=par[4]; loc=par[5]; (a+b*(x-loc))*exp(-a*(x-loc)-(b*(x-loc)^2)/2)}
cum=function(par,x){a=par[3]; b=par[4]; loc=par[5]; 1-exp(-a*(x-loc)-(b*(x-loc)^2)/2)}
if (location==FALSE){
den=function(par,x){a=par[3]; b=par[4]; (a+b*(x))*exp(-a*(x)-(b*(x)^2)/2)}
cum=function(par,x){a=par[3]; b=par[4]; 1-exp(-a*(x)-(b*(x)^2)/2)}
}}
if(g=="log-logistic"){
den=function(par,x){a=par[3]; b=par[4]; loc=par[5]; (a*b^(-a)*(x-loc)^(a-1))/((((x-loc)/b)^a +1)^2)}
cum=function(par,x){a=par[3]; b=par[4]; loc=par[5]; 1/(((x-loc)/b)^(-a)+1)}
if (location==FALSE){
den=function(par,x){a=par[3]; b=par[4]; (a*b^(-a)*(x)^(a-1))/((((x)/b)^a +1)^2)}
cum=function(par,x){a=par[3]; b=par[4]; 1/(((x)/b)^(-a)+1)}
}}
if(g=="lomax"){
den=function(par,x){a=par[3]; b=par[4]; loc=par[5]; (a*b)/((1+a*(x-loc))^(b+1))}
cum=function(par,x){a=par[3]; b=par[4]; loc=par[5]; 1-(1+a*(x-loc))^(-b)}
if (location==FALSE){
den=function(par,x){a=par[3]; b=par[4]; (a*b)/((1+a*(x))^(b+1))}
cum=function(par,x){a=par[3]; b=par[4]; 1-(1+a*(x))^(-b)}
}}
if(g=="gompertz"){
den=function(par,x){a=par[3]; b=par[4]; loc=par[5]; b*exp(a*(x-loc))*exp(-(exp(a*(x-loc))-1)*b/a)}
cum=function(par,x){a=par[3]; b=par[4]; loc=par[5]; 1-exp(-(exp(a*(x-loc))-1)*b/a)}
if (location==FALSE){
den=function(par,x){a=par[3]; b=par[4]; b*exp(a*(x))*exp(-(exp(a*(x))-1)*b/a)}
cum=function(par,x){a=par[3]; b=par[4]; 1-exp(-(exp(a*(x))-1)*b/a)}
}}
if(g=="exp"){
den=function(par,x){rate=par[3]; loc=par[4]; dexp(x-loc,rate)}
cum=function(par,x){rate=par[3]; loc=par[4]; pexp(x-loc,rate)}
if (location==FALSE){
den=function(par,x){rate=par[3]; dexp(x,rate)}
cum=function(par,x){rate=par[3]; pexp(x,rate)}
}}
if(g=="rayleigh"){
den=function(par,x){a=par[3]; loc=par[4]; 2*(x-loc)/a*exp(-((x-loc)/a)^2)}
cum=function(par,x){a=par[3]; loc=par[4]; 1-exp(-((x-loc)/a)^2)}
if (location==FALSE){
den=function(par,x){a=par[3]; 2*x/a*exp(-(x/a)^2)}
cum=function(par,x){a=par[3]; 1-exp(-(x/a)^2)}
}}
if(g=="burrxii"){
den=function(par,x){a=par[3]; d=par[4]; loc=par[5]; d*a*(1+(x-loc)^d)^(-a-1)*((x-loc)^(d-1))}
cum=function(par,x){a=par[3]; d=par[4]; loc=par[5]; 1-(1+(x-loc)^d)^(-a)}
if (location==FALSE){
den=function(par,x){a=par[3]; d=par[4]; d*a*(1+(x)^d)^(-a-1)*((x)^(d-1))}
cum=function(par,x){a=par[3]; d=par[4]; 1-(1+(x)^d)^(-a)}
}}
if(g=="frechet"){
den=function(par,x){a=par[3]; b=par[4]; loc=par[5]; (a*exp(-((x-loc)/b)^(-a))*((x-loc)/b)^(-a-1))/(b)}
cum=function(par,x){a=par[3]; b=par[4]; loc=par[5]; exp(-((x-loc)/b)^(-a))}
if (location==FALSE){
den=function(par,x){a=par[3]; b=par[4]; (a*exp(-((x)/b)^(-a))*((x)/b)^(-a-1))/(b)}
cum=function(par,x){a=par[3]; b=par[4]; exp(-((x)/b)^(-a))}
}}
if(g=="birnbaum-saunders"){
den=function(par,x){a=par[3]; b=par[4]; loc=par[5]; (sqrt((x-loc)/b)+sqrt(b/(x-loc)))/(2*a*(x-loc))*dnorm((sqrt((x-loc)/b)-sqrt(b/(x-loc)))/a)}
cum=function(par,x){a=par[3]; b=par[4]; loc=par[5]; pnorm((sqrt((x-loc)/b)-sqrt(b/(x-loc)))/a)}
if (location==FALSE){
den=function(par,x){a=par[3]; b=par[4]; (sqrt((x)/b)+sqrt(b/(x)))/(2*a*(x))*dnorm((sqrt((x)/b)-sqrt(b/(x)))/a)}
cum=function(par,x){a=par[3]; b=par[4]; pnorm((sqrt((x)/b)-sqrt(b/(x)))/a)}
}}
if(g=="weibull"){
den=function(par,x){shape=par[3]; scale=par[4]; loc=par[5]; dweibull(x-loc,shape,scale)}
cum=function(par,x){shape=par[3]; scale=par[4]; loc=par[5]; pweibull(x-loc,shape,scale)}
if (location==FALSE){
den=function(par,x){shape=par[3]; scale=par[4]; dweibull(x,shape,scale)}
cum=function(par,x){shape=par[3]; scale=par[4]; pweibull(x,shape,scale)}
}}
if(g=="gamma"){
den=function(par,x){shape=par[3]; scale=par[4]; loc=par[5]; dgamma(x-loc,shape,scale)}
cum=function(par,x){shape=par[3]; scale=par[4]; loc=par[5]; pgamma(x-loc,shape,scale)}
if (location==FALSE){
den=function(par,x){shape=par[3]; scale=par[4]; dgamma(x,shape,scale)}
cum=function(par,x){shape=par[3]; scale=par[4]; pgamma(x,shape,scale)}
}}
pdf0<-function(par,x){
f0=den(par,x)
c0=cum(par,x)
a=par[1]
b=par[2]
a*f0*(c0)**(a-1)*(1+b-2*b*c0)*(1+b*(1-c0))**(a-1)
}
pdf<-pdf0(param,mydata)
if(log==TRUE){pdf<-log(pdf)}
return(pdf)
}
pkumg<-function(mydata, g, param, location=TRUE, log.p = FALSE, lower.tail = TRUE){
if(g!="birnbaum-saunders" & g!="exp" & g!="rayleigh" & g!="weibull" & g!="gompertz" & g!="gamma"
& g!="log-normal" & g!="chisq" & g!="f" & g!="burrxii" & g!="frechet"
& g!="lomax" & g!="log-logistic" & g!="lfr" & g!="chen")
{ stop ("Baseline distribution not implemented or misspelled. Please check the manual for guidelines.") }
if(g=="log-normal"){
den=function(par,x){meanlog=par[3]; sdlog=par[4]; loc=par[5]; dlnorm(x-loc,meanlog,sdlog)}
cum=function(par,x){meanlog=par[3]; sdlog=par[4]; loc=par[5]; plnorm(x-loc,meanlog,sdlog)}
if (location==FALSE){
den=function(par,x){meanlog=par[3]; sdlog=par[4]; dlnorm(x,meanlog,sdlog)}
cum=function(par,x){meanlog=par[3]; sdlog=par[4]; plnorm(x,meanlog,sdlog)}
}}
if(g=="chisq"){
den=function(par,x){df=par[3]; loc=par[4]; dchisq(x-loc,df)}
cum=function(par,x){df=par[3]; loc=par[4]; pchisq(x-loc,df)}
if (location==FALSE){
den=function(par,x){df=par[3]; dchisq(x,df)}
cum=function(par,x){df=par[3]; pchisq(x,df)}
}}
if(g=="f"){
den=function(par,x){df1=par[3]; df2=par[4]; loc=par[5]; df(x-loc,df1,df2)}
cum=function(par,x){df1=par[3]; df2=par[4]; loc=par[5]; pf(x-loc,df1,df2)}
if (location==FALSE){
den=function(par,x){df1=par[3]; df2=par[4]; df(x,df1,df2)}
cum=function(par,x){df1=par[3]; df2=par[4]; pf(x,df1,df2)}
}}
if(g=="chen"){
den=function(par,x){a=par[3]; b=par[4]; loc=par[5]; a*b*(x-loc)^(a-1)*exp((x-loc)^a)*exp(-b*(exp((x-loc)^a)-1))}
cum=function(par,x){a=par[3]; b=par[4]; loc=par[5]; 1-exp(-b*(exp((x-loc)^a)-1))}
if (location==FALSE){
den=function(par,x){a=par[3]; b=par[4]; a*b*(x)^(a-1)*exp((x)^a)*exp(-b*(exp((x)^a)-1))}
cum=function(par,x){a=par[3]; b=par[4]; 1-exp(-b*(exp((x)^a)-1))}
}}
if(g=="lfr"){
den=function(par,x){a=par[3]; b=par[4]; loc=par[5]; (a+b*(x-loc))*exp(-a*(x-loc)-(b*(x-loc)^2)/2)}
cum=function(par,x){a=par[3]; b=par[4]; loc=par[5]; 1-exp(-a*(x-loc)-(b*(x-loc)^2)/2)}
if (location==FALSE){
den=function(par,x){a=par[3]; b=par[4]; (a+b*(x))*exp(-a*(x)-(b*(x)^2)/2)}
cum=function(par,x){a=par[3]; b=par[4]; 1-exp(-a*(x)-(b*(x)^2)/2)}
}}
if(g=="log-logistic"){
den=function(par,x){a=par[3]; b=par[4]; loc=par[5]; (a*b^(-a)*(x-loc)^(a-1))/((((x-loc)/b)^a +1)^2)}
cum=function(par,x){a=par[3]; b=par[4]; loc=par[5]; 1/(((x-loc)/b)^(-a)+1)}
if (location==FALSE){
den=function(par,x){a=par[3]; b=par[4]; (a*b^(-a)*(x)^(a-1))/((((x)/b)^a +1)^2)}
cum=function(par,x){a=par[3]; b=par[4]; 1/(((x)/b)^(-a)+1)}
}}
if(g=="lomax"){
den=function(par,x){a=par[3]; b=par[4]; loc=par[5]; (a*b)/((1+a*(x-loc))^(b+1))}
cum=function(par,x){a=par[3]; b=par[4]; loc=par[5]; 1-(1+a*(x-loc))^(-b)}
if (location==FALSE){
den=function(par,x){a=par[3]; b=par[4]; (a*b)/((1+a*(x))^(b+1))}
cum=function(par,x){a=par[3]; b=par[4]; 1-(1+a*(x))^(-b)}
}}
if(g=="gompertz"){
den=function(par,x){a=par[3]; b=par[4]; loc=par[5]; b*exp(a*(x-loc))*exp(-(exp(a*(x-loc))-1)*b/a)}
cum=function(par,x){a=par[3]; b=par[4]; loc=par[5]; 1-exp(-(exp(a*(x-loc))-1)*b/a)}
if (location==FALSE){
den=function(par,x){a=par[3]; b=par[4]; b*exp(a*(x))*exp(-(exp(a*(x))-1)*b/a)}
cum=function(par,x){a=par[3]; b=par[4]; 1-exp(-(exp(a*(x))-1)*b/a)}
}}
if(g=="exp"){
den=function(par,x){rate=par[3]; loc=par[4]; dexp(x-loc,rate)}
cum=function(par,x){rate=par[3]; loc=par[4]; pexp(x-loc,rate)}
if (location==FALSE){
den=function(par,x){rate=par[3]; dexp(x,rate)}
cum=function(par,x){rate=par[3]; pexp(x,rate)}
}}
if(g=="rayleigh"){
den=function(par,x){a=par[3]; loc=par[4]; 2*(x-loc)/a*exp(-((x-loc)/a)^2)}
cum=function(par,x){a=par[3]; loc=par[4]; 1-exp(-((x-loc)/a)^2)}
if (location==FALSE){
den=function(par,x){a=par[3]; 2*x/a*exp(-(x/a)^2)}
cum=function(par,x){a=par[3]; 1-exp(-(x/a)^2)}
}}
if(g=="burrxii"){
den=function(par,x){a=par[3]; d=par[4]; loc=par[5]; d*a*(1+(x-loc)^d)^(-a-1)*((x-loc)^(d-1))}
cum=function(par,x){a=par[3]; d=par[4]; loc=par[5]; 1-(1+(x-loc)^d)^(-a)}
if (location==FALSE){
den=function(par,x){a=par[3]; d=par[4]; d*a*(1+(x)^d)^(-a-1)*((x)^(d-1))}
cum=function(par,x){a=par[3]; d=par[4]; 1-(1+(x)^d)^(-a)}
}}
if(g=="frechet"){
den=function(par,x){a=par[3]; b=par[4]; loc=par[5]; (a*exp(-((x-loc)/b)^(-a))*((x-loc)/b)^(-a-1))/(b)}
cum=function(par,x){a=par[3]; b=par[4]; loc=par[5]; exp(-((x-loc)/b)^(-a))}
if (location==FALSE){
den=function(par,x){a=par[3]; b=par[4]; (a*exp(-((x)/b)^(-a))*((x)/b)^(-a-1))/(b)}
cum=function(par,x){a=par[3]; b=par[4]; exp(-((x)/b)^(-a))}
}}
if(g=="birnbaum-saunders"){
den=function(par,x){a=par[3]; b=par[4]; loc=par[5]; (sqrt((x-loc)/b)+sqrt(b/(x-loc)))/(2*a*(x-loc))*dnorm((sqrt((x-loc)/b)-sqrt(b/(x-loc)))/a)}
cum=function(par,x){a=par[3]; b=par[4]; loc=par[5]; pnorm((sqrt((x-loc)/b)-sqrt(b/(x-loc)))/a)}
if (location==FALSE){
den=function(par,x){a=par[3]; b=par[4]; (sqrt((x)/b)+sqrt(b/(x)))/(2*a*(x))*dnorm((sqrt((x)/b)-sqrt(b/(x)))/a)}
cum=function(par,x){a=par[3]; b=par[4]; pnorm((sqrt((x)/b)-sqrt(b/(x)))/a)}
}}
if(g=="weibull"){
den=function(par,x){shape=par[3]; scale=par[4]; loc=par[5]; dweibull(x-loc,shape,scale)}
cum=function(par,x){shape=par[3]; scale=par[4]; loc=par[5]; pweibull(x-loc,shape,scale)}
if (location==FALSE){
den=function(par,x){shape=par[3]; scale=par[4]; dweibull(x,shape,scale)}
cum=function(par,x){shape=par[3]; scale=par[4]; pweibull(x,shape,scale)}
}}
if(g=="gamma"){
den=function(par,x){shape=par[3]; scale=par[4]; loc=par[5]; dgamma(x-loc,shape,scale)}
cum=function(par,x){shape=par[3]; scale=par[4]; loc=par[5]; pgamma(x-loc,shape,scale)}
if (location==FALSE){
den=function(par,x){shape=par[3]; scale=par[4]; dgamma(x,shape,scale)}
cum=function(par,x){shape=par[3]; scale=par[4]; pgamma(x,shape,scale)}
}}
cdf0<-function(par,x){
f0=den(par,x)
c0=cum(par,x)
r=par[1]
u=par[2]
1-(1-c0^r)^u
}
cdf<-cdf0(param,mydata)
if(log.p==TRUE & lower.tail == FALSE) cdf<-log(1-cdf)
if(log.p==TRUE & lower.tail == TRUE) cdf<-log(cdf)
if(log.p==FALSE & lower.tail == FALSE) cdf<-1-cdf
return(cdf)
}
dkumg<-function(mydata, g, param, location=TRUE, log=FALSE){
if(g!="birnbaum-saunders" & g!="exp" & g!="rayleigh" & g!="weibull" & g!="gompertz" & g!="gamma"
& g!="log-normal" & g!="chisq" & g!="f" & g!="burrxii" & g!="frechet"
& g!="lomax" & g!="log-logistic" & g!="lfr" & g!="chen")
{ stop ("Baseline distribution not implemented or misspelled. Please check the manual for guidelines.") }
if(g=="log-normal"){
den=function(par,x){meanlog=par[3]; sdlog=par[4]; loc=par[5]; dlnorm(x-loc,meanlog,sdlog)}
cum=function(par,x){meanlog=par[3]; sdlog=par[4]; loc=par[5]; plnorm(x-loc,meanlog,sdlog)}
if (location==FALSE){
den=function(par,x){meanlog=par[3]; sdlog=par[4]; dlnorm(x,meanlog,sdlog)}
cum=function(par,x){meanlog=par[3]; sdlog=par[4]; plnorm(x,meanlog,sdlog)}
}}
if(g=="chisq"){
den=function(par,x){df=par[3]; loc=par[4]; dchisq(x-loc,df)}
cum=function(par,x){df=par[3]; loc=par[4]; pchisq(x-loc,df)}
if (location==FALSE){
den=function(par,x){df=par[3]; dchisq(x,df)}
cum=function(par,x){df=par[3]; pchisq(x,df)}
}}
if(g=="f"){
den=function(par,x){df1=par[3]; df2=par[4]; loc=par[5]; df(x-loc,df1,df2)}
cum=function(par,x){df1=par[3]; df2=par[4]; loc=par[5]; pf(x-loc,df1,df2)}
if (location==FALSE){
den=function(par,x){df1=par[3]; df2=par[4]; df(x,df1,df2)}
cum=function(par,x){df1=par[3]; df2=par[4]; pf(x,df1,df2)}
}}
if(g=="chen"){
den=function(par,x){a=par[3]; b=par[4]; loc=par[5]; a*b*(x-loc)^(a-1)*exp((x-loc)^a)*exp(-b*(exp((x-loc)^a)-1))}
cum=function(par,x){a=par[3]; b=par[4]; loc=par[5]; 1-exp(-b*(exp((x-loc)^a)-1))}
if (location==FALSE){
den=function(par,x){a=par[3]; b=par[4]; a*b*(x)^(a-1)*exp((x)^a)*exp(-b*(exp((x)^a)-1))}
cum=function(par,x){a=par[3]; b=par[4]; 1-exp(-b*(exp((x)^a)-1))}
}}
if(g=="lfr"){
den=function(par,x){a=par[3]; b=par[4]; loc=par[5]; (a+b*(x-loc))*exp(-a*(x-loc)-(b*(x-loc)^2)/2)}
cum=function(par,x){a=par[3]; b=par[4]; loc=par[5]; 1-exp(-a*(x-loc)-(b*(x-loc)^2)/2)}
if (location==FALSE){
den=function(par,x){a=par[3]; b=par[4]; (a+b*(x))*exp(-a*(x)-(b*(x)^2)/2)}
cum=function(par,x){a=par[3]; b=par[4]; 1-exp(-a*(x)-(b*(x)^2)/2)}
}}
if(g=="log-logistic"){
den=function(par,x){a=par[3]; b=par[4]; loc=par[5]; (a*b^(-a)*(x-loc)^(a-1))/((((x-loc)/b)^a +1)^2)}
cum=function(par,x){a=par[3]; b=par[4]; loc=par[5]; 1/(((x-loc)/b)^(-a)+1)}
if (location==FALSE){
den=function(par,x){a=par[3]; b=par[4]; (a*b^(-a)*(x)^(a-1))/((((x)/b)^a +1)^2)}
cum=function(par,x){a=par[3]; b=par[4]; 1/(((x)/b)^(-a)+1)}
}}
if(g=="lomax"){
den=function(par,x){a=par[3]; b=par[4]; loc=par[5]; (a*b)/((1+a*(x-loc))^(b+1))}
cum=function(par,x){a=par[3]; b=par[4]; loc=par[5]; 1-(1+a*(x-loc))^(-b)}
if (location==FALSE){
den=function(par,x){a=par[3]; b=par[4]; (a*b)/((1+a*(x))^(b+1))}
cum=function(par,x){a=par[3]; b=par[4]; 1-(1+a*(x))^(-b)}
}}
if(g=="gompertz"){
den=function(par,x){a=par[3]; b=par[4]; loc=par[5]; b*exp(a*(x-loc))*exp(-(exp(a*(x-loc))-1)*b/a)}
cum=function(par,x){a=par[3]; b=par[4]; loc=par[5]; 1-exp(-(exp(a*(x-loc))-1)*b/a)}
if (location==FALSE){
den=function(par,x){a=par[3]; b=par[4]; b*exp(a*(x))*exp(-(exp(a*(x))-1)*b/a)}
cum=function(par,x){a=par[3]; b=par[4]; 1-exp(-(exp(a*(x))-1)*b/a)}
}}
if(g=="exp"){
den=function(par,x){rate=par[3]; loc=par[4]; dexp(x-loc,rate)}
cum=function(par,x){rate=par[3]; loc=par[4]; pexp(x-loc,rate)}
if (location==FALSE){
den=function(par,x){rate=par[3]; dexp(x,rate)}
cum=function(par,x){rate=par[3]; pexp(x,rate)}
}}
if(g=="rayleigh"){
den=function(par,x){a=par[3]; loc=par[4]; 2*(x-loc)/a*exp(-((x-loc)/a)^2)}
cum=function(par,x){a=par[3]; loc=par[4]; 1-exp(-((x-loc)/a)^2)}
if (location==FALSE){
den=function(par,x){a=par[3]; 2*x/a*exp(-(x/a)^2)}
cum=function(par,x){a=par[3]; 1-exp(-(x/a)^2)}
}}
if(g=="burrxii"){
den=function(par,x){a=par[3]; d=par[4]; loc=par[5]; d*a*(1+(x-loc)^d)^(-a-1)*((x-loc)^(d-1))}
cum=function(par,x){a=par[3]; d=par[4]; loc=par[5]; 1-(1+(x-loc)^d)^(-a)}
if (location==FALSE){
den=function(par,x){a=par[3]; d=par[4]; d*a*(1+(x)^d)^(-a-1)*((x)^(d-1))}
cum=function(par,x){a=par[3]; d=par[4]; 1-(1+(x)^d)^(-a)}
}}
if(g=="frechet"){
den=function(par,x){a=par[3]; b=par[4]; loc=par[5]; (a*exp(-((x-loc)/b)^(-a))*((x-loc)/b)^(-a-1))/(b)}
cum=function(par,x){a=par[3]; b=par[4]; loc=par[5]; exp(-((x-loc)/b)^(-a))}
if (location==FALSE){
den=function(par,x){a=par[3]; b=par[4]; (a*exp(-((x)/b)^(-a))*((x)/b)^(-a-1))/(b)}
cum=function(par,x){a=par[3]; b=par[4]; exp(-((x)/b)^(-a))}
}}
if(g=="birnbaum-saunders"){
den=function(par,x){a=par[3]; b=par[4]; loc=par[5]; (sqrt((x-loc)/b)+sqrt(b/(x-loc)))/(2*a*(x-loc))*dnorm((sqrt((x-loc)/b)-sqrt(b/(x-loc)))/a)}
cum=function(par,x){a=par[3]; b=par[4]; loc=par[5]; pnorm((sqrt((x-loc)/b)-sqrt(b/(x-loc)))/a)}
if (location==FALSE){
den=function(par,x){a=par[3]; b=par[4]; (sqrt((x)/b)+sqrt(b/(x)))/(2*a*(x))*dnorm((sqrt((x)/b)-sqrt(b/(x)))/a)}
cum=function(par,x){a=par[3]; b=par[4]; pnorm((sqrt((x)/b)-sqrt(b/(x)))/a)}
}}
if(g=="weibull"){
den=function(par,x){shape=par[3]; scale=par[4]; loc=par[5]; dweibull(x-loc,shape,scale)}
cum=function(par,x){shape=par[3]; scale=par[4]; loc=par[5]; pweibull(x-loc,shape,scale)}
if (location==FALSE){
den=function(par,x){shape=par[3]; scale=par[4]; dweibull(x,shape,scale)}
cum=function(par,x){shape=par[3]; scale=par[4]; pweibull(x,shape,scale)}
}}
if(g=="gamma"){
den=function(par,x){shape=par[3]; scale=par[4]; loc=par[5]; dgamma(x-loc,shape,scale)}
cum=function(par,x){shape=par[3]; scale=par[4]; loc=par[5]; pgamma(x-loc,shape,scale)}
if (location==FALSE){
den=function(par,x){shape=par[3]; scale=par[4]; dgamma(x,shape,scale)}
cum=function(par,x){shape=par[3]; scale=par[4]; pgamma(x,shape,scale)}
}}
pdf0<-function(par,x){
f0=den(par,x)
c0=cum(par,x)
r=par[1]
u=par[2]
r*u*f0*(c0^(r-1))*(1-c0^r)^(u-1)
}
pdf<-pdf0(param,mydata)
if(log==TRUE){pdf<-log(pdf)}
return(pdf)
}
pologlogg<-function(mydata, g, param, location=TRUE, log.p = FALSE, lower.tail = TRUE){
if(g!="birnbaum-saunders" & g!="exp" & g!="rayleigh" & g!="weibull" & g!="gompertz" & g!="gamma"
& g!="log-normal" & g!="chisq" & g!="f" & g!="burrxii" & g!="frechet"
& g!="lomax" & g!="log-logistic" & g!="lfr" & g!="chen")
{ stop ("Baseline distribution not implemented or misspelled. Please check the manual for guidelines.") }
if(g=="log-normal"){
den=function(par,x){meanlog=par[4]; sdlog=par[5]; loc=par[6]; dlnorm(x-loc,meanlog,sdlog)}
cum=function(par,x){meanlog=par[4]; sdlog=par[5]; loc=par[6]; plnorm(x-loc,meanlog,sdlog)}
if (location==FALSE){
den=function(par,x){meanlog=par[4]; sdlog=par[5]; dlnorm(x,meanlog,sdlog)}
cum=function(par,x){meanlog=par[4]; sdlog=par[5]; plnorm(x,meanlog,sdlog)}
}}
if(g=="chisq"){
den=function(par,x){df=par[4]; loc=par[5]; dchisq(x-loc,df)}
cum=function(par,x){df=par[4]; loc=par[5]; pchisq(x-loc,df)}
if (location==FALSE){
den=function(par,x){df=par[4]; dchisq(x,df)}
cum=function(par,x){df=par[4]; pchisq(x,df)}
}}
if(g=="f"){
den=function(par,x){df1=par[4]; df2=par[5]; loc=par[6]; df(x-loc,df1,df2)}
cum=function(par,x){df1=par[4]; df2=par[5]; loc=par[6]; pf(x-loc,df1,df2)}
if (location==FALSE){
den=function(par,x){df1=par[4]; df2=par[5]; df(x,df1,df2)}
cum=function(par,x){df1=par[4]; df2=par[5]; pf(x,df1,df2)}
}}
if(g=="chen"){
den=function(par,x){a=par[4]; b=par[5]; loc=par[6]; a*b*(x-loc)^(a-1)*exp((x-loc)^a)*exp(-b*(exp((x-loc)^a)-1))}
cum=function(par,x){a=par[4]; b=par[5]; loc=par[6]; 1-exp(-b*(exp((x-loc)^a)-1))}
if (location==FALSE){
den=function(par,x){a=par[4]; b=par[5]; a*b*(x)^(a-1)*exp((x)^a)*exp(-b*(exp((x)^a)-1))}
cum=function(par,x){a=par[4]; b=par[5]; 1-exp(-b*(exp((x)^a)-1))}
}}
if(g=="lfr"){
den=function(par,x){a=par[4]; b=par[5]; loc=par[6]; (a+b*(x-loc))*exp(-a*(x-loc)-(b*(x-loc)^2)/2)}
cum=function(par,x){a=par[4]; b=par[5]; loc=par[6]; 1-exp(-a*(x-loc)-(b*(x-loc)^2)/2)}
if (location==FALSE){
den=function(par,x){a=par[4]; b=par[5]; (a+b*(x))*exp(-a*(x)-(b*(x)^2)/2)}
cum=function(par,x){a=par[4]; b=par[5]; 1-exp(-a*(x)-(b*(x)^2)/2)}
}}
if(g=="log-logistic"){
den=function(par,x){a=par[4]; b=par[5]; loc=par[6]; (a*b^(-a)*(x-loc)^(a-1))/((((x-loc)/b)^a +1)^2)}
cum=function(par,x){a=par[4]; b=par[5]; loc=par[6]; 1/(((x-loc)/b)^(-a)+1)}
if (location==FALSE){
den=function(par,x){a=par[4]; b=par[5]; (a*b^(-a)*(x)^(a-1))/((((x)/b)^a +1)^2)}
cum=function(par,x){a=par[4]; b=par[5]; 1/(((x)/b)^(-a)+1)}
}}
if(g=="lomax"){
den=function(par,x){a=par[4]; b=par[5]; loc=par[6]; (a*b)/((1+a*(x-loc))^(b+1))}
cum=function(par,x){a=par[4]; b=par[5]; loc=par[6]; 1-(1+a*(x-loc))^(-b)}
if (location==FALSE){
den=function(par,x){a=par[4]; b=par[5]; (a*b)/((1+a*(x))^(b+1))}
cum=function(par,x){a=par[4]; b=par[5]; 1-(1+a*(x))^(-b)}
}}
if(g=="gompertz"){
den=function(par,x){a=par[4]; b=par[5]; loc=par[6]; b*exp(a*(x-loc))*exp(-(exp(a*(x-loc))-1)*b/a)}
cum=function(par,x){a=par[4]; b=par[5]; loc=par[6]; 1-exp(-(exp(a*(x-loc))-1)*b/a)}
if (location==FALSE){
den=function(par,x){a=par[4]; b=par[5]; b*exp(a*(x))*exp(-(exp(a*(x))-1)*b/a)}
cum=function(par,x){a=par[4]; b=par[5]; 1-exp(-(exp(a*(x))-1)*b/a)}
}}
if(g=="exp"){
den=function(par,x){rate=par[4]; loc=par[5]; dexp(x-loc,rate)}
cum=function(par,x){rate=par[4]; loc=par[5]; pexp(x-loc,rate)}
if (location==FALSE){
den=function(par,x){rate=par[4]; dexp(x,rate)}
cum=function(par,x){rate=par[4]; pexp(x,rate)}
}}
if(g=="rayleigh"){
den=function(par,x){a=par[4]; loc=par[5]; 2*(x-loc)/a*exp(-((x-loc)/a)^2)}
cum=function(par,x){a=par[4]; loc=par[5]; 1-exp(-((x-loc)/a)^2)}
if (location==FALSE){
den=function(par,x){a=par[4]; 2*x/a*exp(-(x/a)^2)}
cum=function(par,x){a=par[4]; 1-exp(-(x/a)^2)}
}}
if(g=="burrxii"){
den=function(par,x){a=par[4]; d=par[5]; loc=par[6]; d*a*(1+(x-loc)^d)^(-a-1)*((x-loc)^(d-1))}
cum=function(par,x){a=par[4]; d=par[5]; loc=par[6]; 1-(1+(x-loc)^d)^(-a)}
if (location==FALSE){
den=function(par,x){a=par[4]; d=par[5]; d*a*(1+(x)^d)^(-a-1)*((x)^(d-1))}
cum=function(par,x){a=par[4]; d=par[5]; 1-(1+(x)^d)^(-a)}
}}
if(g=="frechet"){
den=function(par,x){a=par[4]; b=par[5]; loc=par[6]; (a*exp(-((x-loc)/b)^(-a))*((x-loc)/b)^(-a-1))/(b)}
cum=function(par,x){a=par[4]; b=par[5]; loc=par[6]; exp(-((x-loc)/b)^(-a))}
if (location==FALSE){
den=function(par,x){a=par[4]; b=par[5]; (a*exp(-((x)/b)^(-a))*((x)/b)^(-a-1))/(b)}
cum=function(par,x){a=par[4]; b=par[5]; exp(-((x)/b)^(-a))}
}}
if(g=="birnbaum-saunders"){
den=function(par,x){a=par[4]; b=par[5]; loc=par[6]; (sqrt((x-loc)/b)+sqrt(b/(x-loc)))/(2*a*(x-loc))*dnorm((sqrt((x-loc)/b)-sqrt(b/(x-loc)))/a)}
cum=function(par,x){a=par[4]; b=par[5]; loc=par[6]; pnorm((sqrt((x-loc)/b)-sqrt(b/(x-loc)))/a)}
if (location==FALSE){
den=function(par,x){a=par[4]; b=par[5]; (sqrt((x)/b)+sqrt(b/(x)))/(2*a*(x))*dnorm((sqrt((x)/b)-sqrt(b/(x)))/a)}
cum=function(par,x){a=par[4]; b=par[5]; pnorm((sqrt((x)/b)-sqrt(b/(x)))/a)}
}}
if(g=="weibull"){
den=function(par,x){shape=par[4]; scale=par[5]; loc=par[6]; dweibull(x-loc,shape,scale)}
cum=function(par,x){shape=par[4]; scale=par[5]; loc=par[6]; pweibull(x-loc,shape,scale)}
if (location==FALSE){
den=function(par,x){shape=par[4]; scale=par[5]; dweibull(x,shape,scale)}
cum=function(par,x){shape=par[4]; scale=par[5]; pweibull(x,shape,scale)}
}}
if(g=="gamma"){
den=function(par,x){shape=par[4]; scale=par[5]; loc=par[6]; dgamma(x-loc,shape,scale)}
cum=function(par,x){shape=par[4]; scale=par[5]; loc=par[6]; pgamma(x-loc,shape,scale)}
if (location==FALSE){
den=function(par,x){shape=par[4]; scale=par[5]; dgamma(x,shape,scale)}
cum=function(par,x){shape=par[4]; scale=par[5]; pgamma(x,shape,scale)}
}}
cdf0<-function(par,x){
f0=den(par,x)
c0=cum(par,x)
a=par[1]
b=par[2]
d=par[3]
1-(1-(c0**d/(c0**d+(1-c0)**d))**a)**b
}
cdf<-cdf0(param,mydata)
if(log.p==TRUE & lower.tail == FALSE) cdf<-log(1-cdf)
if(log.p==TRUE & lower.tail == TRUE) cdf<-log(cdf)
if(log.p==FALSE & lower.tail == FALSE) cdf<-1-cdf
return(cdf)
}
dologlogg<-function(mydata, g, param, location=TRUE, log=FALSE){
if(g!="birnbaum-saunders" & g!="exp" & g!="rayleigh" & g!="weibull" & g!="gompertz" & g!="gamma"
& g!="log-normal" & g!="chisq" & g!="f" & g!="burrxii" & g!="frechet"
& g!="lomax" & g!="log-logistic" & g!="lfr" & g!="chen")
{ stop ("Baseline distribution not implemented or misspelled. Please check the manual for guidelines.") }
if(g=="log-normal"){
den=function(par,x){meanlog=par[4]; sdlog=par[5]; loc=par[6]; dlnorm(x-loc,meanlog,sdlog)}
cum=function(par,x){meanlog=par[4]; sdlog=par[5]; loc=par[6]; plnorm(x-loc,meanlog,sdlog)}
if (location==FALSE){
den=function(par,x){meanlog=par[4]; sdlog=par[5]; dlnorm(x,meanlog,sdlog)}
cum=function(par,x){meanlog=par[4]; sdlog=par[5]; plnorm(x,meanlog,sdlog)}
}}
if(g=="chisq"){
den=function(par,x){df=par[4]; loc=par[5]; dchisq(x-loc,df)}
cum=function(par,x){df=par[4]; loc=par[5]; pchisq(x-loc,df)}
if (location==FALSE){
den=function(par,x){df=par[4]; dchisq(x,df)}
cum=function(par,x){df=par[4]; pchisq(x,df)}
}}
if(g=="f"){
den=function(par,x){df1=par[4]; df2=par[5]; loc=par[6]; df(x-loc,df1,df2)}
cum=function(par,x){df1=par[4]; df2=par[5]; loc=par[6]; pf(x-loc,df1,df2)}
if (location==FALSE){
den=function(par,x){df1=par[4]; df2=par[5]; df(x,df1,df2)}
cum=function(par,x){df1=par[4]; df2=par[5]; pf(x,df1,df2)}
}}
if(g=="chen"){
den=function(par,x){a=par[4]; b=par[5]; loc=par[6]; a*b*(x-loc)^(a-1)*exp((x-loc)^a)*exp(-b*(exp((x-loc)^a)-1))}
cum=function(par,x){a=par[4]; b=par[5]; loc=par[6]; 1-exp(-b*(exp((x-loc)^a)-1))}
if (location==FALSE){
den=function(par,x){a=par[4]; b=par[5]; a*b*(x)^(a-1)*exp((x)^a)*exp(-b*(exp((x)^a)-1))}
cum=function(par,x){a=par[4]; b=par[5]; 1-exp(-b*(exp((x)^a)-1))}
}}
if(g=="lfr"){
den=function(par,x){a=par[4]; b=par[5]; loc=par[6]; (a+b*(x-loc))*exp(-a*(x-loc)-(b*(x-loc)^2)/2)}
cum=function(par,x){a=par[4]; b=par[5]; loc=par[6]; 1-exp(-a*(x-loc)-(b*(x-loc)^2)/2)}
if (location==FALSE){
den=function(par,x){a=par[4]; b=par[5]; (a+b*(x))*exp(-a*(x)-(b*(x)^2)/2)}
cum=function(par,x){a=par[4]; b=par[5]; 1-exp(-a*(x)-(b*(x)^2)/2)}
}}
if(g=="log-logistic"){
den=function(par,x){a=par[4]; b=par[5]; loc=par[6]; (a*b^(-a)*(x-loc)^(a-1))/((((x-loc)/b)^a +1)^2)}
cum=function(par,x){a=par[4]; b=par[5]; loc=par[6]; 1/(((x-loc)/b)^(-a)+1)}
if (location==FALSE){
den=function(par,x){a=par[4]; b=par[5]; (a*b^(-a)*(x)^(a-1))/((((x)/b)^a +1)^2)}
cum=function(par,x){a=par[4]; b=par[5]; 1/(((x)/b)^(-a)+1)}
}}
if(g=="lomax"){
den=function(par,x){a=par[4]; b=par[5]; loc=par[6]; (a*b)/((1+a*(x-loc))^(b+1))}
cum=function(par,x){a=par[4]; b=par[5]; loc=par[6]; 1-(1+a*(x-loc))^(-b)}
if (location==FALSE){
den=function(par,x){a=par[4]; b=par[5]; (a*b)/((1+a*(x))^(b+1))}
cum=function(par,x){a=par[4]; b=par[5]; 1-(1+a*(x))^(-b)}
}}
if(g=="gompertz"){
den=function(par,x){a=par[4]; b=par[5]; loc=par[6]; b*exp(a*(x-loc))*exp(-(exp(a*(x-loc))-1)*b/a)}
cum=function(par,x){a=par[4]; b=par[5]; loc=par[6]; 1-exp(-(exp(a*(x-loc))-1)*b/a)}
if (location==FALSE){
den=function(par,x){a=par[4]; b=par[5]; b*exp(a*(x))*exp(-(exp(a*(x))-1)*b/a)}
cum=function(par,x){a=par[4]; b=par[5]; 1-exp(-(exp(a*(x))-1)*b/a)}
}}
if(g=="exp"){
den=function(par,x){rate=par[4]; loc=par[5]; dexp(x-loc,rate)}
cum=function(par,x){rate=par[4]; loc=par[5]; pexp(x-loc,rate)}
if (location==FALSE){
den=function(par,x){rate=par[4]; dexp(x,rate)}
cum=function(par,x){rate=par[4]; pexp(x,rate)}
}}
if(g=="rayleigh"){
den=function(par,x){a=par[4]; loc=par[5]; 2*(x-loc)/a*exp(-((x-loc)/a)^2)}
cum=function(par,x){a=par[4]; loc=par[5]; 1-exp(-((x-loc)/a)^2)}
if (location==FALSE){
den=function(par,x){a=par[4]; 2*x/a*exp(-(x/a)^2)}
cum=function(par,x){a=par[4]; 1-exp(-(x/a)^2)}
}}
if(g=="burrxii"){
den=function(par,x){a=par[4]; d=par[5]; loc=par[6]; d*a*(1+(x-loc)^d)^(-a-1)*((x-loc)^(d-1))}
cum=function(par,x){a=par[4]; d=par[5]; loc=par[6]; 1-(1+(x-loc)^d)^(-a)}
if (location==FALSE){
den=function(par,x){a=par[4]; d=par[5]; d*a*(1+(x)^d)^(-a-1)*((x)^(d-1))}
cum=function(par,x){a=par[4]; d=par[5]; 1-(1+(x)^d)^(-a)}
}}
if(g=="frechet"){
den=function(par,x){a=par[4]; b=par[5]; loc=par[6]; (a*exp(-((x-loc)/b)^(-a))*((x-loc)/b)^(-a-1))/(b)}
cum=function(par,x){a=par[4]; b=par[5]; loc=par[6]; exp(-((x-loc)/b)^(-a))}
if (location==FALSE){
den=function(par,x){a=par[4]; b=par[5]; (a*exp(-((x)/b)^(-a))*((x)/b)^(-a-1))/(b)}
cum=function(par,x){a=par[4]; b=par[5]; exp(-((x)/b)^(-a))}
}}
if(g=="birnbaum-saunders"){
den=function(par,x){a=par[4]; b=par[5]; loc=par[6]; (sqrt((x-loc)/b)+sqrt(b/(x-loc)))/(2*a*(x-loc))*dnorm((sqrt((x-loc)/b)-sqrt(b/(x-loc)))/a)}
cum=function(par,x){a=par[4]; b=par[5]; loc=par[6]; pnorm((sqrt((x-loc)/b)-sqrt(b/(x-loc)))/a)}
if (location==FALSE){
den=function(par,x){a=par[4]; b=par[5]; (sqrt((x)/b)+sqrt(b/(x)))/(2*a*(x))*dnorm((sqrt((x)/b)-sqrt(b/(x)))/a)}
cum=function(par,x){a=par[4]; b=par[5]; pnorm((sqrt((x)/b)-sqrt(b/(x)))/a)}
}}
if(g=="weibull"){
den=function(par,x){shape=par[4]; scale=par[5]; loc=par[6]; dweibull(x-loc,shape,scale)}
cum=function(par,x){shape=par[4]; scale=par[5]; loc=par[6]; pweibull(x-loc,shape,scale)}
if (location==FALSE){
den=function(par,x){shape=par[4]; scale=par[5]; dweibull(x,shape,scale)}
cum=function(par,x){shape=par[4]; scale=par[5]; pweibull(x,shape,scale)}
}}
if(g=="gamma"){
den=function(par,x){shape=par[4]; scale=par[5]; loc=par[6]; dgamma(x-loc,shape,scale)}
cum=function(par,x){shape=par[4]; scale=par[5]; loc=par[6]; pgamma(x-loc,shape,scale)}
if (location==FALSE){
den=function(par,x){shape=par[4]; scale=par[5]; dgamma(x,shape,scale)}
cum=function(par,x){shape=par[4]; scale=par[5]; pgamma(x,shape,scale)}
}}
pdf0<-function(par,x){
f0=den(par,x)
c0=cum(par,x)
a=par[1]
b=par[2]
d=par[3]
a*b*d*f0*c0**(d*a-1)*(1-c0)**(d-1)*(c0**d+(1-c0)**d)**(-a-1)*(1-(c0**d/(c0**d+(1-c0)**d))**a)**(b-1)
}
pdf<-pdf0(param,mydata)
if(log==TRUE){pdf<-log(pdf)}
return(pdf)
}
ploggammag1<-function(mydata, g, param, location=TRUE, log.p = FALSE, lower.tail = TRUE){
if(g!="birnbaum-saunders" & g!="exp" & g!="rayleigh" & g!="weibull" & g!="gompertz" & g!="gamma"
& g!="log-normal" & g!="chisq" & g!="f" & g!="burrxii" & g!="frechet"
& g!="lomax" & g!="log-logistic" & g!="lfr" & g!="chen")
{ stop ("Baseline distribution not implemented or misspelled. Please check the manual for guidelines.") }
if(g=="log-normal"){
den=function(par,x){meanlog=par[3]; sdlog=par[4]; loc=par[5]; dlnorm(x-loc,meanlog,sdlog)}
cum=function(par,x){meanlog=par[3]; sdlog=par[4]; loc=par[5]; plnorm(x-loc,meanlog,sdlog)}
if (location==FALSE){
den=function(par,x){meanlog=par[3]; sdlog=par[4]; dlnorm(x,meanlog,sdlog)}
cum=function(par,x){meanlog=par[3]; sdlog=par[4]; plnorm(x,meanlog,sdlog)}
}}
if(g=="chisq"){
den=function(par,x){df=par[3]; loc=par[4]; dchisq(x-loc,df)}
cum=function(par,x){df=par[3]; loc=par[4]; pchisq(x-loc,df)}
if (location==FALSE){
den=function(par,x){df=par[3]; dchisq(x,df)}
cum=function(par,x){df=par[3]; pchisq(x,df)}
}}
if(g=="f"){
den=function(par,x){df1=par[3]; df2=par[4]; loc=par[5]; df(x-loc,df1,df2)}
cum=function(par,x){df1=par[3]; df2=par[4]; loc=par[5]; pf(x-loc,df1,df2)}
if (location==FALSE){
den=function(par,x){df1=par[3]; df2=par[4]; df(x,df1,df2)}
cum=function(par,x){df1=par[3]; df2=par[4]; pf(x,df1,df2)}
}}
if(g=="chen"){
den=function(par,x){a=par[3]; b=par[4]; loc=par[5]; a*b*(x-loc)^(a-1)*exp((x-loc)^a)*exp(-b*(exp((x-loc)^a)-1))}
cum=function(par,x){a=par[3]; b=par[4]; loc=par[5]; 1-exp(-b*(exp((x-loc)^a)-1))}
if (location==FALSE){
den=function(par,x){a=par[3]; b=par[4]; a*b*(x)^(a-1)*exp((x)^a)*exp(-b*(exp((x)^a)-1))}
cum=function(par,x){a=par[3]; b=par[4]; 1-exp(-b*(exp((x)^a)-1))}
}}
if(g=="lfr"){
den=function(par,x){a=par[3]; b=par[4]; loc=par[5]; (a+b*(x-loc))*exp(-a*(x-loc)-(b*(x-loc)^2)/2)}
cum=function(par,x){a=par[3]; b=par[4]; loc=par[5]; 1-exp(-a*(x-loc)-(b*(x-loc)^2)/2)}
if (location==FALSE){
den=function(par,x){a=par[3]; b=par[4]; (a+b*(x))*exp(-a*(x)-(b*(x)^2)/2)}
cum=function(par,x){a=par[3]; b=par[4]; 1-exp(-a*(x)-(b*(x)^2)/2)}
}}
if(g=="log-logistic"){
den=function(par,x){a=par[3]; b=par[4]; loc=par[5]; (a*b^(-a)*(x-loc)^(a-1))/((((x-loc)/b)^a +1)^2)}
cum=function(par,x){a=par[3]; b=par[4]; loc=par[5]; 1/(((x-loc)/b)^(-a)+1)}
if (location==FALSE){
den=function(par,x){a=par[3]; b=par[4]; (a*b^(-a)*(x)^(a-1))/((((x)/b)^a +1)^2)}
cum=function(par,x){a=par[3]; b=par[4]; 1/(((x)/b)^(-a)+1)}
}}
if(g=="lomax"){
den=function(par,x){a=par[3]; b=par[4]; loc=par[5]; (a*b)/((1+a*(x-loc))^(b+1))}
cum=function(par,x){a=par[3]; b=par[4]; loc=par[5]; 1-(1+a*(x-loc))^(-b)}
if (location==FALSE){
den=function(par,x){a=par[3]; b=par[4]; (a*b)/((1+a*(x))^(b+1))}
cum=function(par,x){a=par[3]; b=par[4]; 1-(1+a*(x))^(-b)}
}}
if(g=="gompertz"){
den=function(par,x){a=par[3]; b=par[4]; loc=par[5]; b*exp(a*(x-loc))*exp(-(exp(a*(x-loc))-1)*b/a)}
cum=function(par,x){a=par[3]; b=par[4]; loc=par[5]; 1-exp(-(exp(a*(x-loc))-1)*b/a)}
if (location==FALSE){
den=function(par,x){a=par[3]; b=par[4]; b*exp(a*(x))*exp(-(exp(a*(x))-1)*b/a)}
cum=function(par,x){a=par[3]; b=par[4]; 1-exp(-(exp(a*(x))-1)*b/a)}
}}
if(g=="exp"){
den=function(par,x){rate=par[3]; loc=par[4]; dexp(x-loc,rate)}
cum=function(par,x){rate=par[3]; loc=par[4]; pexp(x-loc,rate)}
if (location==FALSE){
den=function(par,x){rate=par[3]; dexp(x,rate)}
cum=function(par,x){rate=par[3]; pexp(x,rate)}
}}
if(g=="rayleigh"){
den=function(par,x){a=par[3]; loc=par[4]; 2*(x-loc)/a*exp(-((x-loc)/a)^2)}
cum=function(par,x){a=par[3]; loc=par[4]; 1-exp(-((x-loc)/a)^2)}
if (location==FALSE){
den=function(par,x){a=par[3]; 2*x/a*exp(-(x/a)^2)}
cum=function(par,x){a=par[3]; 1-exp(-(x/a)^2)}
}}
if(g=="burrxii"){
den=function(par,x){a=par[3]; d=par[4]; loc=par[5]; d*a*(1+(x-loc)^d)^(-a-1)*((x-loc)^(d-1))}
cum=function(par,x){a=par[3]; d=par[4]; loc=par[5]; 1-(1+(x-loc)^d)^(-a)}
if (location==FALSE){
den=function(par,x){a=par[3]; d=par[4]; d*a*(1+(x)^d)^(-a-1)*((x)^(d-1))}
cum=function(par,x){a=par[3]; d=par[4]; 1-(1+(x)^d)^(-a)}
}}
if(g=="frechet"){
den=function(par,x){a=par[3]; b=par[4]; loc=par[5]; (a*exp(-((x-loc)/b)^(-a))*((x-loc)/b)^(-a-1))/(b)}
cum=function(par,x){a=par[3]; b=par[4]; loc=par[5]; exp(-((x-loc)/b)^(-a))}
if (location==FALSE){
den=function(par,x){a=par[3]; b=par[4]; (a*exp(-((x)/b)^(-a))*((x)/b)^(-a-1))/(b)}
cum=function(par,x){a=par[3]; b=par[4]; exp(-((x)/b)^(-a))}
}}
if(g=="birnbaum-saunders"){
den=function(par,x){a=par[3]; b=par[4]; loc=par[5]; (sqrt((x-loc)/b)+sqrt(b/(x-loc)))/(2*a*(x-loc))*dnorm((sqrt((x-loc)/b)-sqrt(b/(x-loc)))/a)}
cum=function(par,x){a=par[3]; b=par[4]; loc=par[5]; pnorm((sqrt((x-loc)/b)-sqrt(b/(x-loc)))/a)}
if (location==FALSE){
den=function(par,x){a=par[3]; b=par[4]; (sqrt((x)/b)+sqrt(b/(x)))/(2*a*(x))*dnorm((sqrt((x)/b)-sqrt(b/(x)))/a)}
cum=function(par,x){a=par[3]; b=par[4]; pnorm((sqrt((x)/b)-sqrt(b/(x)))/a)}
}}
if(g=="weibull"){
den=function(par,x){shape=par[3]; scale=par[4]; loc=par[5]; dweibull(x-loc,shape,scale)}
cum=function(par,x){shape=par[3]; scale=par[4]; loc=par[5]; pweibull(x-loc,shape,scale)}
if (location==FALSE){
den=function(par,x){shape=par[3]; scale=par[4]; dweibull(x,shape,scale)}
cum=function(par,x){shape=par[3]; scale=par[4]; pweibull(x,shape,scale)}
}}
if(g=="gamma"){
den=function(par,x){shape=par[3]; scale=par[4]; loc=par[5]; dgamma(x-loc,shape,scale)}
cum=function(par,x){shape=par[3]; scale=par[4]; loc=par[5]; pgamma(x-loc,shape,scale)}
if (location==FALSE){
den=function(par,x){shape=par[3]; scale=par[4]; dgamma(x,shape,scale)}
cum=function(par,x){shape=par[3]; scale=par[4]; pgamma(x,shape,scale)}
}}
cdf0<-function(par,x){
f0=den(par,x)
c0=cum(par,x)
a=par[1]
b=par[2]
pgamma(-b*log(1-c0),shape=a)
}
cdf<-cdf0(param,mydata)
if(log.p==TRUE & lower.tail == FALSE) cdf<-log(1-cdf)
if(log.p==TRUE & lower.tail == TRUE) cdf<-log(cdf)
if(log.p==FALSE & lower.tail == FALSE) cdf<-1-cdf
return(cdf)
}
dloggammag1<-function(mydata, g, param, location=TRUE, log=FALSE){
if(g!="birnbaum-saunders" & g!="exp" & g!="rayleigh" & g!="weibull" & g!="gompertz" & g!="gamma"
& g!="log-normal" & g!="chisq" & g!="f" & g!="burrxii" & g!="frechet"
& g!="lomax" & g!="log-logistic" & g!="lfr" & g!="chen")
{ stop ("Baseline distribution not implemented or misspelled. Please check the manual for guidelines.") }
if(g=="log-normal"){
den=function(par,x){meanlog=par[3]; sdlog=par[4]; loc=par[5]; dlnorm(x-loc,meanlog,sdlog)}
cum=function(par,x){meanlog=par[3]; sdlog=par[4]; loc=par[5]; plnorm(x-loc,meanlog,sdlog)}
if (location==FALSE){
den=function(par,x){meanlog=par[3]; sdlog=par[4]; dlnorm(x,meanlog,sdlog)}
cum=function(par,x){meanlog=par[3]; sdlog=par[4]; plnorm(x,meanlog,sdlog)}
}}
if(g=="chisq"){
den=function(par,x){df=par[3]; loc=par[4]; dchisq(x-loc,df)}
cum=function(par,x){df=par[3]; loc=par[4]; pchisq(x-loc,df)}
if (location==FALSE){
den=function(par,x){df=par[3]; dchisq(x,df)}
cum=function(par,x){df=par[3]; pchisq(x,df)}
}}
if(g=="f"){
den=function(par,x){df1=par[3]; df2=par[4]; loc=par[5]; df(x-loc,df1,df2)}
cum=function(par,x){df1=par[3]; df2=par[4]; loc=par[5]; pf(x-loc,df1,df2)}
if (location==FALSE){
den=function(par,x){df1=par[3]; df2=par[4]; df(x,df1,df2)}
cum=function(par,x){df1=par[3]; df2=par[4]; pf(x,df1,df2)}
}}
if(g=="chen"){
den=function(par,x){a=par[3]; b=par[4]; loc=par[5]; a*b*(x-loc)^(a-1)*exp((x-loc)^a)*exp(-b*(exp((x-loc)^a)-1))}
cum=function(par,x){a=par[3]; b=par[4]; loc=par[5]; 1-exp(-b*(exp((x-loc)^a)-1))}
if (location==FALSE){
den=function(par,x){a=par[3]; b=par[4]; a*b*(x)^(a-1)*exp((x)^a)*exp(-b*(exp((x)^a)-1))}
cum=function(par,x){a=par[3]; b=par[4]; 1-exp(-b*(exp((x)^a)-1))}
}}
if(g=="lfr"){
den=function(par,x){a=par[3]; b=par[4]; loc=par[5]; (a+b*(x-loc))*exp(-a*(x-loc)-(b*(x-loc)^2)/2)}
cum=function(par,x){a=par[3]; b=par[4]; loc=par[5]; 1-exp(-a*(x-loc)-(b*(x-loc)^2)/2)}
if (location==FALSE){
den=function(par,x){a=par[3]; b=par[4]; (a+b*(x))*exp(-a*(x)-(b*(x)^2)/2)}
cum=function(par,x){a=par[3]; b=par[4]; 1-exp(-a*(x)-(b*(x)^2)/2)}
}}
if(g=="log-logistic"){
den=function(par,x){a=par[3]; b=par[4]; loc=par[5]; (a*b^(-a)*(x-loc)^(a-1))/((((x-loc)/b)^a +1)^2)}
cum=function(par,x){a=par[3]; b=par[4]; loc=par[5]; 1/(((x-loc)/b)^(-a)+1)}
if (location==FALSE){
den=function(par,x){a=par[3]; b=par[4]; (a*b^(-a)*(x)^(a-1))/((((x)/b)^a +1)^2)}
cum=function(par,x){a=par[3]; b=par[4]; 1/(((x)/b)^(-a)+1)}
}}
if(g=="lomax"){
den=function(par,x){a=par[3]; b=par[4]; loc=par[5]; (a*b)/((1+a*(x-loc))^(b+1))}
cum=function(par,x){a=par[3]; b=par[4]; loc=par[5]; 1-(1+a*(x-loc))^(-b)}
if (location==FALSE){
den=function(par,x){a=par[3]; b=par[4]; (a*b)/((1+a*(x))^(b+1))}
cum=function(par,x){a=par[3]; b=par[4]; 1-(1+a*(x))^(-b)}
}}
if(g=="gompertz"){
den=function(par,x){a=par[3]; b=par[4]; loc=par[5]; b*exp(a*(x-loc))*exp(-(exp(a*(x-loc))-1)*b/a)}
cum=function(par,x){a=par[3]; b=par[4]; loc=par[5]; 1-exp(-(exp(a*(x-loc))-1)*b/a)}
if (location==FALSE){
den=function(par,x){a=par[3]; b=par[4]; b*exp(a*(x))*exp(-(exp(a*(x))-1)*b/a)}
cum=function(par,x){a=par[3]; b=par[4]; 1-exp(-(exp(a*(x))-1)*b/a)}
}}
if(g=="exp"){
den=function(par,x){rate=par[3]; loc=par[4]; dexp(x-loc,rate)}
cum=function(par,x){rate=par[3]; loc=par[4]; pexp(x-loc,rate)}
if (location==FALSE){
den=function(par,x){rate=par[3]; dexp(x,rate)}
cum=function(par,x){rate=par[3]; pexp(x,rate)}
}}
if(g=="rayleigh"){
den=function(par,x){a=par[3]; loc=par[4]; 2*(x-loc)/a*exp(-((x-loc)/a)^2)}
cum=function(par,x){a=par[3]; loc=par[4]; 1-exp(-((x-loc)/a)^2)}
if (location==FALSE){
den=function(par,x){a=par[3]; 2*x/a*exp(-(x/a)^2)}
cum=function(par,x){a=par[3]; 1-exp(-(x/a)^2)}
}}
if(g=="burrxii"){
den=function(par,x){a=par[3]; d=par[4]; loc=par[5]; d*a*(1+(x-loc)^d)^(-a-1)*((x-loc)^(d-1))}
cum=function(par,x){a=par[3]; d=par[4]; loc=par[5]; 1-(1+(x-loc)^d)^(-a)}
if (location==FALSE){
den=function(par,x){a=par[3]; d=par[4]; d*a*(1+(x)^d)^(-a-1)*((x)^(d-1))}
cum=function(par,x){a=par[3]; d=par[4]; 1-(1+(x)^d)^(-a)}
}}
if(g=="frechet"){
den=function(par,x){a=par[3]; b=par[4]; loc=par[5]; (a*exp(-((x-loc)/b)^(-a))*((x-loc)/b)^(-a-1))/(b)}
cum=function(par,x){a=par[3]; b=par[4]; loc=par[5]; exp(-((x-loc)/b)^(-a))}
if (location==FALSE){
den=function(par,x){a=par[3]; b=par[4]; (a*exp(-((x)/b)^(-a))*((x)/b)^(-a-1))/(b)}
cum=function(par,x){a=par[3]; b=par[4]; exp(-((x)/b)^(-a))}
}}
if(g=="birnbaum-saunders"){
den=function(par,x){a=par[3]; b=par[4]; loc=par[5]; (sqrt((x-loc)/b)+sqrt(b/(x-loc)))/(2*a*(x-loc))*dnorm((sqrt((x-loc)/b)-sqrt(b/(x-loc)))/a)}
cum=function(par,x){a=par[3]; b=par[4]; loc=par[5]; pnorm((sqrt((x-loc)/b)-sqrt(b/(x-loc)))/a)}
if (location==FALSE){
den=function(par,x){a=par[3]; b=par[4]; (sqrt((x)/b)+sqrt(b/(x)))/(2*a*(x))*dnorm((sqrt((x)/b)-sqrt(b/(x)))/a)}
cum=function(par,x){a=par[3]; b=par[4]; pnorm((sqrt((x)/b)-sqrt(b/(x)))/a)}
}}
if(g=="weibull"){
den=function(par,x){shape=par[3]; scale=par[4]; loc=par[5]; dweibull(x-loc,shape,scale)}
cum=function(par,x){shape=par[3]; scale=par[4]; loc=par[5]; pweibull(x-loc,shape,scale)}
if (location==FALSE){
den=function(par,x){shape=par[3]; scale=par[4]; dweibull(x,shape,scale)}
cum=function(par,x){shape=par[3]; scale=par[4]; pweibull(x,shape,scale)}
}}
if(g=="gamma"){
den=function(par,x){shape=par[3]; scale=par[4]; loc=par[5]; dgamma(x-loc,shape,scale)}
cum=function(par,x){shape=par[3]; scale=par[4]; loc=par[5]; pgamma(x-loc,shape,scale)}
if (location==FALSE){
den=function(par,x){shape=par[3]; scale=par[4]; dgamma(x,shape,scale)}
cum=function(par,x){shape=par[3]; scale=par[4]; pgamma(x,shape,scale)}
}}
pdf0<-function(par,x){
f0=den(par,x)
c0=cum(par,x)
a=par[1]
b=par[2]
b^a*gamma(a)^(-1)*f0*(-log(1-c0))^(a-1)*(1-c0)^(b-1)
}
pdf<-pdf0(param,mydata)
if(log==TRUE){pdf<-log(pdf)}
return(pdf)
}
ploggammag2<-function(mydata, g, param, location=TRUE, log.p = FALSE, lower.tail = TRUE){
if(g!="birnbaum-saunders" & g!="exp" & g!="rayleigh" & g!="weibull" & g!="gompertz" & g!="gamma"
& g!="log-normal" & g!="chisq" & g!="f" & g!="burrxii" & g!="frechet"
& g!="lomax" & g!="log-logistic" & g!="lfr" & g!="chen")
{ stop ("Baseline distribution not implemented or misspelled. Please check the manual for guidelines.") }
if(g=="log-normal"){
den=function(par,x){meanlog=par[3]; sdlog=par[4]; loc=par[5]; dlnorm(x-loc,meanlog,sdlog)}
cum=function(par,x){meanlog=par[3]; sdlog=par[4]; loc=par[5]; plnorm(x-loc,meanlog,sdlog)}
if (location==FALSE){
den=function(par,x){meanlog=par[3]; sdlog=par[4]; dlnorm(x,meanlog,sdlog)}
cum=function(par,x){meanlog=par[3]; sdlog=par[4]; plnorm(x,meanlog,sdlog)}
}}
if(g=="chisq"){
den=function(par,x){df=par[3]; loc=par[4]; dchisq(x-loc,df)}
cum=function(par,x){df=par[3]; loc=par[4]; pchisq(x-loc,df)}
if (location==FALSE){
den=function(par,x){df=par[3]; dchisq(x,df)}
cum=function(par,x){df=par[3]; pchisq(x,df)}
}}
if(g=="f"){
den=function(par,x){df1=par[3]; df2=par[4]; loc=par[5]; df(x-loc,df1,df2)}
cum=function(par,x){df1=par[3]; df2=par[4]; loc=par[5]; pf(x-loc,df1,df2)}
if (location==FALSE){
den=function(par,x){df1=par[3]; df2=par[4]; df(x,df1,df2)}
cum=function(par,x){df1=par[3]; df2=par[4]; pf(x,df1,df2)}
}}
if(g=="chen"){
den=function(par,x){a=par[3]; b=par[4]; loc=par[5]; a*b*(x-loc)^(a-1)*exp((x-loc)^a)*exp(-b*(exp((x-loc)^a)-1))}
cum=function(par,x){a=par[3]; b=par[4]; loc=par[5]; 1-exp(-b*(exp((x-loc)^a)-1))}
if (location==FALSE){
den=function(par,x){a=par[3]; b=par[4]; a*b*(x)^(a-1)*exp((x)^a)*exp(-b*(exp((x)^a)-1))}
cum=function(par,x){a=par[3]; b=par[4]; 1-exp(-b*(exp((x)^a)-1))}
}}
if(g=="lfr"){
den=function(par,x){a=par[3]; b=par[4]; loc=par[5]; (a+b*(x-loc))*exp(-a*(x-loc)-(b*(x-loc)^2)/2)}
cum=function(par,x){a=par[3]; b=par[4]; loc=par[5]; 1-exp(-a*(x-loc)-(b*(x-loc)^2)/2)}
if (location==FALSE){
den=function(par,x){a=par[3]; b=par[4]; (a+b*(x))*exp(-a*(x)-(b*(x)^2)/2)}
cum=function(par,x){a=par[3]; b=par[4]; 1-exp(-a*(x)-(b*(x)^2)/2)}
}}
if(g=="log-logistic"){
den=function(par,x){a=par[3]; b=par[4]; loc=par[5]; (a*b^(-a)*(x-loc)^(a-1))/((((x-loc)/b)^a +1)^2)}
cum=function(par,x){a=par[3]; b=par[4]; loc=par[5]; 1/(((x-loc)/b)^(-a)+1)}
if (location==FALSE){
den=function(par,x){a=par[3]; b=par[4]; (a*b^(-a)*(x)^(a-1))/((((x)/b)^a +1)^2)}
cum=function(par,x){a=par[3]; b=par[4]; 1/(((x)/b)^(-a)+1)}
}}
if(g=="lomax"){
den=function(par,x){a=par[3]; b=par[4]; loc=par[5]; (a*b)/((1+a*(x-loc))^(b+1))}
cum=function(par,x){a=par[3]; b=par[4]; loc=par[5]; 1-(1+a*(x-loc))^(-b)}
if (location==FALSE){
den=function(par,x){a=par[3]; b=par[4]; (a*b)/((1+a*(x))^(b+1))}
cum=function(par,x){a=par[3]; b=par[4]; 1-(1+a*(x))^(-b)}
}}
if(g=="gompertz"){
den=function(par,x){a=par[3]; b=par[4]; loc=par[5]; b*exp(a*(x-loc))*exp(-(exp(a*(x-loc))-1)*b/a)}
cum=function(par,x){a=par[3]; b=par[4]; loc=par[5]; 1-exp(-(exp(a*(x-loc))-1)*b/a)}
if (location==FALSE){
den=function(par,x){a=par[3]; b=par[4]; b*exp(a*(x))*exp(-(exp(a*(x))-1)*b/a)}
cum=function(par,x){a=par[3]; b=par[4]; 1-exp(-(exp(a*(x))-1)*b/a)}
}}
if(g=="exp"){
den=function(par,x){rate=par[3]; loc=par[4]; dexp(x-loc,rate)}
cum=function(par,x){rate=par[3]; loc=par[4]; pexp(x-loc,rate)}
if (location==FALSE){
den=function(par,x){rate=par[3]; dexp(x,rate)}
cum=function(par,x){rate=par[3]; pexp(x,rate)}
}}
if(g=="rayleigh"){
den=function(par,x){a=par[3]; loc=par[4]; 2*(x-loc)/a*exp(-((x-loc)/a)^2)}
cum=function(par,x){a=par[3]; loc=par[4]; 1-exp(-((x-loc)/a)^2)}
if (location==FALSE){
den=function(par,x){a=par[3]; 2*x/a*exp(-(x/a)^2)}
cum=function(par,x){a=par[3]; 1-exp(-(x/a)^2)}
}}
if(g=="burrxii"){
den=function(par,x){a=par[3]; d=par[4]; loc=par[5]; d*a*(1+(x-loc)^d)^(-a-1)*((x-loc)^(d-1))}
cum=function(par,x){a=par[3]; d=par[4]; loc=par[5]; 1-(1+(x-loc)^d)^(-a)}
if (location==FALSE){
den=function(par,x){a=par[3]; d=par[4]; d*a*(1+(x)^d)^(-a-1)*((x)^(d-1))}
cum=function(par,x){a=par[3]; d=par[4]; 1-(1+(x)^d)^(-a)}
}}
if(g=="frechet"){
den=function(par,x){a=par[3]; b=par[4]; loc=par[5]; (a*exp(-((x-loc)/b)^(-a))*((x-loc)/b)^(-a-1))/(b)}
cum=function(par,x){a=par[3]; b=par[4]; loc=par[5]; exp(-((x-loc)/b)^(-a))}
if (location==FALSE){
den=function(par,x){a=par[3]; b=par[4]; (a*exp(-((x)/b)^(-a))*((x)/b)^(-a-1))/(b)}
cum=function(par,x){a=par[3]; b=par[4]; exp(-((x)/b)^(-a))}
}}
if(g=="birnbaum-saunders"){
den=function(par,x){a=par[3]; b=par[4]; loc=par[5]; (sqrt((x-loc)/b)+sqrt(b/(x-loc)))/(2*a*(x-loc))*dnorm((sqrt((x-loc)/b)-sqrt(b/(x-loc)))/a)}
cum=function(par,x){a=par[3]; b=par[4]; loc=par[5]; pnorm((sqrt((x-loc)/b)-sqrt(b/(x-loc)))/a)}
if (location==FALSE){
den=function(par,x){a=par[3]; b=par[4]; (sqrt((x)/b)+sqrt(b/(x)))/(2*a*(x))*dnorm((sqrt((x)/b)-sqrt(b/(x)))/a)}
cum=function(par,x){a=par[3]; b=par[4]; pnorm((sqrt((x)/b)-sqrt(b/(x)))/a)}
}}
if(g=="weibull"){
den=function(par,x){shape=par[3]; scale=par[4]; loc=par[5]; dweibull(x-loc,shape,scale)}
cum=function(par,x){shape=par[3]; scale=par[4]; loc=par[5]; pweibull(x-loc,shape,scale)}
if (location==FALSE){
den=function(par,x){shape=par[3]; scale=par[4]; dweibull(x,shape,scale)}
cum=function(par,x){shape=par[3]; scale=par[4]; pweibull(x,shape,scale)}
}}
if(g=="gamma"){
den=function(par,x){shape=par[3]; scale=par[4]; loc=par[5]; dgamma(x-loc,shape,scale)}
cum=function(par,x){shape=par[3]; scale=par[4]; loc=par[5]; pgamma(x-loc,shape,scale)}
if (location==FALSE){
den=function(par,x){shape=par[3]; scale=par[4]; dgamma(x,shape,scale)}
cum=function(par,x){shape=par[3]; scale=par[4]; pgamma(x,shape,scale)}
}}
cdf0<-function(par,x){
f0=den(par,x)
c0=cum(par,x)
a=par[1]
b=par[2]
1-pgamma(-b*log(c0),shape=a)
}
cdf<-cdf0(param,mydata)
if(log.p==TRUE & lower.tail == FALSE) cdf<-log(1-cdf)
if(log.p==TRUE & lower.tail == TRUE) cdf<-log(cdf)
if(log.p==FALSE & lower.tail == FALSE) cdf<-1-cdf
return(cdf)
}
dloggammag2<-function(mydata, g, param, location=TRUE, log=FALSE){
if(g!="birnbaum-saunders" & g!="exp" & g!="rayleigh" & g!="weibull" & g!="gompertz" & g!="gamma"
& g!="log-normal" & g!="chisq" & g!="f" & g!="burrxii" & g!="frechet"
& g!="lomax" & g!="log-logistic" & g!="lfr" & g!="chen")
{ stop ("Baseline distribution not implemented or misspelled. Please check the manual for guidelines.") }
if(g=="log-normal"){
den=function(par,x){meanlog=par[3]; sdlog=par[4]; loc=par[5]; dlnorm(x-loc,meanlog,sdlog)}
cum=function(par,x){meanlog=par[3]; sdlog=par[4]; loc=par[5]; plnorm(x-loc,meanlog,sdlog)}
if (location==FALSE){
den=function(par,x){meanlog=par[3]; sdlog=par[4]; dlnorm(x,meanlog,sdlog)}
cum=function(par,x){meanlog=par[3]; sdlog=par[4]; plnorm(x,meanlog,sdlog)}
}}
if(g=="chisq"){
den=function(par,x){df=par[3]; loc=par[4]; dchisq(x-loc,df)}
cum=function(par,x){df=par[3]; loc=par[4]; pchisq(x-loc,df)}
if (location==FALSE){
den=function(par,x){df=par[3]; dchisq(x,df)}
cum=function(par,x){df=par[3]; pchisq(x,df)}
}}
if(g=="f"){
den=function(par,x){df1=par[3]; df2=par[4]; loc=par[5]; df(x-loc,df1,df2)}
cum=function(par,x){df1=par[3]; df2=par[4]; loc=par[5]; pf(x-loc,df1,df2)}
if (location==FALSE){
den=function(par,x){df1=par[3]; df2=par[4]; df(x,df1,df2)}
cum=function(par,x){df1=par[3]; df2=par[4]; pf(x,df1,df2)}
}}
if(g=="chen"){
den=function(par,x){a=par[3]; b=par[4]; loc=par[5]; a*b*(x-loc)^(a-1)*exp((x-loc)^a)*exp(-b*(exp((x-loc)^a)-1))}
cum=function(par,x){a=par[3]; b=par[4]; loc=par[5]; 1-exp(-b*(exp((x-loc)^a)-1))}
if (location==FALSE){
den=function(par,x){a=par[3]; b=par[4]; a*b*(x)^(a-1)*exp((x)^a)*exp(-b*(exp((x)^a)-1))}
cum=function(par,x){a=par[3]; b=par[4]; 1-exp(-b*(exp((x)^a)-1))}
}}
if(g=="lfr"){
den=function(par,x){a=par[3]; b=par[4]; loc=par[5]; (a+b*(x-loc))*exp(-a*(x-loc)-(b*(x-loc)^2)/2)}
cum=function(par,x){a=par[3]; b=par[4]; loc=par[5]; 1-exp(-a*(x-loc)-(b*(x-loc)^2)/2)}
if (location==FALSE){
den=function(par,x){a=par[3]; b=par[4]; (a+b*(x))*exp(-a*(x)-(b*(x)^2)/2)}
cum=function(par,x){a=par[3]; b=par[4]; 1-exp(-a*(x)-(b*(x)^2)/2)}
}}
if(g=="log-logistic"){
den=function(par,x){a=par[3]; b=par[4]; loc=par[5]; (a*b^(-a)*(x-loc)^(a-1))/((((x-loc)/b)^a +1)^2)}
cum=function(par,x){a=par[3]; b=par[4]; loc=par[5]; 1/(((x-loc)/b)^(-a)+1)}
if (location==FALSE){
den=function(par,x){a=par[3]; b=par[4]; (a*b^(-a)*(x)^(a-1))/((((x)/b)^a +1)^2)}
cum=function(par,x){a=par[3]; b=par[4]; 1/(((x)/b)^(-a)+1)}
}}
if(g=="lomax"){
den=function(par,x){a=par[3]; b=par[4]; loc=par[5]; (a*b)/((1+a*(x-loc))^(b+1))}
cum=function(par,x){a=par[3]; b=par[4]; loc=par[5]; 1-(1+a*(x-loc))^(-b)}
if (location==FALSE){
den=function(par,x){a=par[3]; b=par[4]; (a*b)/((1+a*(x))^(b+1))}
cum=function(par,x){a=par[3]; b=par[4]; 1-(1+a*(x))^(-b)}
}}
if(g=="gompertz"){
den=function(par,x){a=par[3]; b=par[4]; loc=par[5]; b*exp(a*(x-loc))*exp(-(exp(a*(x-loc))-1)*b/a)}
cum=function(par,x){a=par[3]; b=par[4]; loc=par[5]; 1-exp(-(exp(a*(x-loc))-1)*b/a)}
if (location==FALSE){
den=function(par,x){a=par[3]; b=par[4]; b*exp(a*(x))*exp(-(exp(a*(x))-1)*b/a)}
cum=function(par,x){a=par[3]; b=par[4]; 1-exp(-(exp(a*(x))-1)*b/a)}
}}
if(g=="exp"){
den=function(par,x){rate=par[3]; loc=par[4]; dexp(x-loc,rate)}
cum=function(par,x){rate=par[3]; loc=par[4]; pexp(x-loc,rate)}
if (location==FALSE){
den=function(par,x){rate=par[3]; dexp(x,rate)}
cum=function(par,x){rate=par[3]; pexp(x,rate)}
}}
if(g=="rayleigh"){
den=function(par,x){a=par[3]; loc=par[4]; 2*(x-loc)/a*exp(-((x-loc)/a)^2)}
cum=function(par,x){a=par[3]; loc=par[4]; 1-exp(-((x-loc)/a)^2)}
if (location==FALSE){
den=function(par,x){a=par[3]; 2*x/a*exp(-(x/a)^2)}
cum=function(par,x){a=par[3]; 1-exp(-(x/a)^2)}
}}
if(g=="burrxii"){
den=function(par,x){a=par[3]; d=par[4]; loc=par[5]; d*a*(1+(x-loc)^d)^(-a-1)*((x-loc)^(d-1))}
cum=function(par,x){a=par[3]; d=par[4]; loc=par[5]; 1-(1+(x-loc)^d)^(-a)}
if (location==FALSE){
den=function(par,x){a=par[3]; d=par[4]; d*a*(1+(x)^d)^(-a-1)*((x)^(d-1))}
cum=function(par,x){a=par[3]; d=par[4]; 1-(1+(x)^d)^(-a)}
}}
if(g=="frechet"){
den=function(par,x){a=par[3]; b=par[4]; loc=par[5]; (a*exp(-((x-loc)/b)^(-a))*((x-loc)/b)^(-a-1))/(b)}
cum=function(par,x){a=par[3]; b=par[4]; loc=par[5]; exp(-((x-loc)/b)^(-a))}
if (location==FALSE){
den=function(par,x){a=par[3]; b=par[4]; (a*exp(-((x)/b)^(-a))*((x)/b)^(-a-1))/(b)}
cum=function(par,x){a=par[3]; b=par[4]; exp(-((x)/b)^(-a))}
}}
if(g=="birnbaum-saunders"){
den=function(par,x){a=par[3]; b=par[4]; loc=par[5]; (sqrt((x-loc)/b)+sqrt(b/(x-loc)))/(2*a*(x-loc))*dnorm((sqrt((x-loc)/b)-sqrt(b/(x-loc)))/a)}
cum=function(par,x){a=par[3]; b=par[4]; loc=par[5]; pnorm((sqrt((x-loc)/b)-sqrt(b/(x-loc)))/a)}
if (location==FALSE){
den=function(par,x){a=par[3]; b=par[4]; (sqrt((x)/b)+sqrt(b/(x)))/(2*a*(x))*dnorm((sqrt((x)/b)-sqrt(b/(x)))/a)}
cum=function(par,x){a=par[3]; b=par[4]; pnorm((sqrt((x)/b)-sqrt(b/(x)))/a)}
}}
if(g=="weibull"){
den=function(par,x){shape=par[3]; scale=par[4]; loc=par[5]; dweibull(x-loc,shape,scale)}
cum=function(par,x){shape=par[3]; scale=par[4]; loc=par[5]; pweibull(x-loc,shape,scale)}
if (location==FALSE){
den=function(par,x){shape=par[3]; scale=par[4]; dweibull(x,shape,scale)}
cum=function(par,x){shape=par[3]; scale=par[4]; pweibull(x,shape,scale)}
}}
if(g=="gamma"){
den=function(par,x){shape=par[3]; scale=par[4]; loc=par[5]; dgamma(x-loc,shape,scale)}
cum=function(par,x){shape=par[3]; scale=par[4]; loc=par[5]; pgamma(x-loc,shape,scale)}
if (location==FALSE){
den=function(par,x){shape=par[3]; scale=par[4]; dgamma(x,shape,scale)}
cum=function(par,x){shape=par[3]; scale=par[4]; pgamma(x,shape,scale)}
}}
pdf0<-function(par,x){
f0=den(par,x)
c0=cum(par,x)
a=par[1]
b=par[2]
b^a*gamma(a)^(-1)*f0*(-log(c0))^(a-1)*(c0)^(b-1)
}
pdf<-pdf0(param,mydata)
if(log==TRUE){pdf<-log(pdf)}
return(pdf)
}
pgxlogisticg<-function(mydata, g, param, location=TRUE, log.p = FALSE, lower.tail = TRUE){
if(g!="birnbaum-saunders" & g!="exp" & g!="rayleigh" & g!="weibull" & g!="gompertz" & g!="gamma"
& g!="log-normal" & g!="chisq" & g!="f" & g!="burrxii" & g!="frechet"
& g!="lomax" & g!="log-logistic" & g!="lfr" & g!="chen")
{ stop ("Baseline distribution not implemented or misspelled. Please check the manual for guidelines.") }
if(g=="log-normal"){
den=function(par,x){meanlog=par[2]; sdlog=par[3]; loc=par[4]; dlnorm(x-loc,meanlog,sdlog)}
cum=function(par,x){meanlog=par[2]; sdlog=par[3]; loc=par[4]; plnorm(x-loc,meanlog,sdlog)}
if (location==FALSE){
den=function(par,x){meanlog=par[2]; sdlog=par[3]; dlnorm(x,meanlog,sdlog)}
cum=function(par,x){meanlog=par[2]; sdlog=par[3]; plnorm(x,meanlog,sdlog)}
}}
if(g=="chisq"){
den=function(par,x){df=par[2]; loc=par[3]; dchisq(x-loc,df)}
cum=function(par,x){df=par[2]; loc=par[3]; pchisq(x-loc,df)}
if (location==FALSE){
den=function(par,x){df=par[2]; dchisq(x,df)}
cum=function(par,x){df=par[2]; pchisq(x,df)}
}}
if(g=="f"){
den=function(par,x){df1=par[2]; df2=par[3]; loc=par[4]; df(x-loc,df1,df2)}
cum=function(par,x){df1=par[2]; df2=par[3]; loc=par[4]; pf(x-loc,df1,df2)}
if (location==FALSE){
den=function(par,x){df1=par[2]; df2=par[3]; df(x,df1,df2)}
cum=function(par,x){df1=par[2]; df2=par[3]; pf(x,df1,df2)}
}}
if(g=="chen"){
den=function(par,x){a=par[2]; b=par[3]; loc=par[4]; a*b*(x-loc)^(a-1)*exp((x-loc)^a)*exp(-b*(exp((x-loc)^a)-1))}
cum=function(par,x){a=par[2]; b=par[3]; loc=par[4]; 1-exp(-b*(exp((x-loc)^a)-1))}
if (location==FALSE){
den=function(par,x){a=par[2]; b=par[3]; a*b*(x)^(a-1)*exp((x)^a)*exp(-b*(exp((x)^a)-1))}
cum=function(par,x){a=par[2]; b=par[3]; 1-exp(-b*(exp((x)^a)-1))}
}}
if(g=="lfr"){
den=function(par,x){a=par[2]; b=par[3]; loc=par[4]; (a+b*(x-loc))*exp(-a*(x-loc)-(b*(x-loc)^2)/2)}
cum=function(par,x){a=par[2]; b=par[3]; loc=par[4]; 1-exp(-a*(x-loc)-(b*(x-loc)^2)/2)}
if (location==FALSE){
den=function(par,x){a=par[2]; b=par[3]; (a+b*(x))*exp(-a*(x)-(b*(x)^2)/2)}
cum=function(par,x){a=par[2]; b=par[3]; 1-exp(-a*(x)-(b*(x)^2)/2)}
}}
if(g=="log-logistic"){
den=function(par,x){a=par[2]; b=par[3]; loc=par[4]; (a*b^(-a)*(x-loc)^(a-1))/((((x-loc)/b)^a +1)^2)}
cum=function(par,x){a=par[2]; b=par[3]; loc=par[4]; 1/(((x-loc)/b)^(-a)+1)}
if (location==FALSE){
den=function(par,x){a=par[2]; b=par[3]; (a*b^(-a)*(x)^(a-1))/((((x)/b)^a +1)^2)}
cum=function(par,x){a=par[2]; b=par[3]; 1/(((x)/b)^(-a)+1)}
}}
if(g=="lomax"){
den=function(par,x){a=par[2]; b=par[3]; loc=par[4]; (a*b)/((1+a*(x-loc))^(b+1))}
cum=function(par,x){a=par[2]; b=par[3]; loc=par[4]; 1-(1+a*(x-loc))^(-b)}
if (location==FALSE){
den=function(par,x){a=par[2]; b=par[3]; (a*b)/((1+a*(x))^(b+1))}
cum=function(par,x){a=par[2]; b=par[3]; 1-(1+a*(x))^(-b)}
}}
if(g=="gompertz"){
den=function(par,x){a=par[2]; b=par[3]; loc=par[4]; b*exp(a*(x-loc))*exp(-(exp(a*(x-loc))-1)*b/a)}
cum=function(par,x){a=par[2]; b=par[3]; loc=par[4]; 1-exp(-(exp(a*(x-loc))-1)*b/a)}
if (location==FALSE){
den=function(par,x){a=par[2]; b=par[3]; b*exp(a*(x))*exp(-(exp(a*(x))-1)*b/a)}
cum=function(par,x){a=par[2]; b=par[3]; 1-exp(-(exp(a*(x))-1)*b/a)}
}}
if(g=="exp"){
den=function(par,x){rate=par[2]; loc=par[3]; dexp(x-loc,rate)}
cum=function(par,x){rate=par[2]; loc=par[3]; pexp(x-loc,rate)}
if (location==FALSE){
den=function(par,x){rate=par[2]; dexp(x,rate)}
cum=function(par,x){rate=par[2]; pexp(x,rate)}
}}
if(g=="rayleigh"){
den=function(par,x){a=par[2]; loc=par[3]; 2*(x-loc)/a*exp(-((x-loc)/a)^2)}
cum=function(par,x){a=par[2]; loc=par[3]; 1-exp(-((x-loc)/a)^2)}
if (location==FALSE){
den=function(par,x){a=par[2]; 2*x/a*exp(-(x/a)^2)}
cum=function(par,x){a=par[2]; 1-exp(-(x/a)^2)}
}}
if(g=="burrxii"){
den=function(par,x){a=par[2]; d=par[3]; loc=par[4]; d*a*(1+(x-loc)^d)^(-a-1)*((x-loc)^(d-1))}
cum=function(par,x){a=par[2]; d=par[3]; loc=par[4]; 1-(1+(x-loc)^d)^(-a)}
if (location==FALSE){
den=function(par,x){a=par[2]; d=par[3]; d*a*(1+(x)^d)^(-a-1)*((x)^(d-1))}
cum=function(par,x){a=par[2]; d=par[3]; 1-(1+(x)^d)^(-a)}
}}
if(g=="frechet"){
den=function(par,x){a=par[2]; b=par[3]; loc=par[4]; (a*exp(-((x-loc)/b)^(-a))*((x-loc)/b)^(-a-1))/(b)}
cum=function(par,x){a=par[2]; b=par[3]; loc=par[4]; exp(-((x-loc)/b)^(-a))}
if (location==FALSE){
den=function(par,x){a=par[2]; b=par[3]; (a*exp(-((x)/b)^(-a))*((x)/b)^(-a-1))/(b)}
cum=function(par,x){a=par[2]; b=par[3]; exp(-((x)/b)^(-a))}
}}
if(g=="birnbaum-saunders"){
den=function(par,x){a=par[2]; b=par[3]; loc=par[4]; (sqrt((x-loc)/b)+sqrt(b/(x-loc)))/(2*a*(x-loc))*dnorm((sqrt((x-loc)/b)-sqrt(b/(x-loc)))/a)}
cum=function(par,x){a=par[2]; b=par[3]; loc=par[4]; pnorm((sqrt((x-loc)/b)-sqrt(b/(x-loc)))/a)}
if (location==FALSE){
den=function(par,x){a=par[2]; b=par[3]; (sqrt((x)/b)+sqrt(b/(x)))/(2*a*(x))*dnorm((sqrt((x)/b)-sqrt(b/(x)))/a)}
cum=function(par,x){a=par[2]; b=par[3]; pnorm((sqrt((x)/b)-sqrt(b/(x)))/a)}
}}
if(g=="weibull"){
den=function(par,x){shape=par[2]; scale=par[3]; loc=par[4]; dweibull(x-loc,shape,scale)}
cum=function(par,x){shape=par[2]; scale=par[3]; loc=par[4]; pweibull(x-loc,shape,scale)}
if (location==FALSE){
den=function(par,x){shape=par[2]; scale=par[3]; dweibull(x,shape,scale)}
cum=function(par,x){shape=par[2]; scale=par[3]; pweibull(x,shape,scale)}
}}
if(g=="gamma"){
den=function(par,x){shape=par[2]; scale=par[3]; loc=par[4]; dgamma(x-loc,shape,scale)}
cum=function(par,x){shape=par[2]; scale=par[3]; loc=par[4]; pgamma(x-loc,shape,scale)}
if (location==FALSE){
den=function(par,x){shape=par[2]; scale=par[3]; dgamma(x,shape,scale)}
cum=function(par,x){shape=par[2]; scale=par[3]; pgamma(x,shape,scale)}
}}
cdf0<-function(par,x){
f0=den(par,x)
c0=cum(par,x)
a=par[1]
1/(1+(-log(1-c0))**(-a))
}
cdf<-cdf0(param,mydata)
if(log.p==TRUE & lower.tail == FALSE) cdf<-log(1-cdf)
if(log.p==TRUE & lower.tail == TRUE) cdf<-log(cdf)
if(log.p==FALSE & lower.tail == FALSE) cdf<-1-cdf
return(cdf)
}
dgxlogisticg<-function(mydata, g, param, location=TRUE, log=FALSE){
if(g!="birnbaum-saunders" & g!="exp" & g!="rayleigh" & g!="weibull" & g!="gompertz" & g!="gamma"
& g!="log-normal" & g!="chisq" & g!="f" & g!="burrxii" & g!="frechet"
& g!="lomax" & g!="log-logistic" & g!="lfr" & g!="chen")
{ stop ("Baseline distribution not implemented or misspelled. Please check the manual for guidelines.") }
if(g=="log-normal"){
den=function(par,x){meanlog=par[2]; sdlog=par[3]; loc=par[4]; dlnorm(x-loc,meanlog,sdlog)}
cum=function(par,x){meanlog=par[2]; sdlog=par[3]; loc=par[4]; plnorm(x-loc,meanlog,sdlog)}
if (location==FALSE){
den=function(par,x){meanlog=par[2]; sdlog=par[3]; dlnorm(x,meanlog,sdlog)}
cum=function(par,x){meanlog=par[2]; sdlog=par[3]; plnorm(x,meanlog,sdlog)}
}}
if(g=="chisq"){
den=function(par,x){df=par[2]; loc=par[3]; dchisq(x-loc,df)}
cum=function(par,x){df=par[2]; loc=par[3]; pchisq(x-loc,df)}
if (location==FALSE){
den=function(par,x){df=par[2]; dchisq(x,df)}
cum=function(par,x){df=par[2]; pchisq(x,df)}
}}
if(g=="f"){
den=function(par,x){df1=par[2]; df2=par[3]; loc=par[4]; df(x-loc,df1,df2)}
cum=function(par,x){df1=par[2]; df2=par[3]; loc=par[4]; pf(x-loc,df1,df2)}
if (location==FALSE){
den=function(par,x){df1=par[2]; df2=par[3]; df(x,df1,df2)}
cum=function(par,x){df1=par[2]; df2=par[3]; pf(x,df1,df2)}
}}
if(g=="chen"){
den=function(par,x){a=par[2]; b=par[3]; loc=par[4]; a*b*(x-loc)^(a-1)*exp((x-loc)^a)*exp(-b*(exp((x-loc)^a)-1))}
cum=function(par,x){a=par[2]; b=par[3]; loc=par[4]; 1-exp(-b*(exp((x-loc)^a)-1))}
if (location==FALSE){
den=function(par,x){a=par[2]; b=par[3]; a*b*(x)^(a-1)*exp((x)^a)*exp(-b*(exp((x)^a)-1))}
cum=function(par,x){a=par[2]; b=par[3]; 1-exp(-b*(exp((x)^a)-1))}
}}
if(g=="lfr"){
den=function(par,x){a=par[2]; b=par[3]; loc=par[4]; (a+b*(x-loc))*exp(-a*(x-loc)-(b*(x-loc)^2)/2)}
cum=function(par,x){a=par[2]; b=par[3]; loc=par[4]; 1-exp(-a*(x-loc)-(b*(x-loc)^2)/2)}
if (location==FALSE){
den=function(par,x){a=par[2]; b=par[3]; (a+b*(x))*exp(-a*(x)-(b*(x)^2)/2)}
cum=function(par,x){a=par[2]; b=par[3]; 1-exp(-a*(x)-(b*(x)^2)/2)}
}}
if(g=="log-logistic"){
den=function(par,x){a=par[2]; b=par[3]; loc=par[4]; (a*b^(-a)*(x-loc)^(a-1))/((((x-loc)/b)^a +1)^2)}
cum=function(par,x){a=par[2]; b=par[3]; loc=par[4]; 1/(((x-loc)/b)^(-a)+1)}
if (location==FALSE){
den=function(par,x){a=par[2]; b=par[3]; (a*b^(-a)*(x)^(a-1))/((((x)/b)^a +1)^2)}
cum=function(par,x){a=par[2]; b=par[3]; 1/(((x)/b)^(-a)+1)}
}}
if(g=="lomax"){
den=function(par,x){a=par[2]; b=par[3]; loc=par[4]; (a*b)/((1+a*(x-loc))^(b+1))}
cum=function(par,x){a=par[2]; b=par[3]; loc=par[4]; 1-(1+a*(x-loc))^(-b)}
if (location==FALSE){
den=function(par,x){a=par[2]; b=par[3]; (a*b)/((1+a*(x))^(b+1))}
cum=function(par,x){a=par[2]; b=par[3]; 1-(1+a*(x))^(-b)}
}}
if(g=="gompertz"){
den=function(par,x){a=par[2]; b=par[3]; loc=par[4]; b*exp(a*(x-loc))*exp(-(exp(a*(x-loc))-1)*b/a)}
cum=function(par,x){a=par[2]; b=par[3]; loc=par[4]; 1-exp(-(exp(a*(x-loc))-1)*b/a)}
if (location==FALSE){
den=function(par,x){a=par[2]; b=par[3]; b*exp(a*(x))*exp(-(exp(a*(x))-1)*b/a)}
cum=function(par,x){a=par[2]; b=par[3]; 1-exp(-(exp(a*(x))-1)*b/a)}
}}
if(g=="exp"){
den=function(par,x){rate=par[2]; loc=par[3]; dexp(x-loc,rate)}
cum=function(par,x){rate=par[2]; loc=par[3]; pexp(x-loc,rate)}
if (location==FALSE){
den=function(par,x){rate=par[2]; dexp(x,rate)}
cum=function(par,x){rate=par[2]; pexp(x,rate)}
}}
if(g=="rayleigh"){
den=function(par,x){a=par[2]; loc=par[3]; 2*(x-loc)/a*exp(-((x-loc)/a)^2)}
cum=function(par,x){a=par[2]; loc=par[3]; 1-exp(-((x-loc)/a)^2)}
if (location==FALSE){
den=function(par,x){a=par[2]; 2*x/a*exp(-(x/a)^2)}
cum=function(par,x){a=par[2]; 1-exp(-(x/a)^2)}
}}
if(g=="burrxii"){
den=function(par,x){a=par[2]; d=par[3]; loc=par[4]; d*a*(1+(x-loc)^d)^(-a-1)*((x-loc)^(d-1))}
cum=function(par,x){a=par[2]; d=par[3]; loc=par[4]; 1-(1+(x-loc)^d)^(-a)}
if (location==FALSE){
den=function(par,x){a=par[2]; d=par[3]; d*a*(1+(x)^d)^(-a-1)*((x)^(d-1))}
cum=function(par,x){a=par[2]; d=par[3]; 1-(1+(x)^d)^(-a)}
}}
if(g=="frechet"){
den=function(par,x){a=par[2]; b=par[3]; loc=par[4]; (a*exp(-((x-loc)/b)^(-a))*((x-loc)/b)^(-a-1))/(b)}
cum=function(par,x){a=par[2]; b=par[3]; loc=par[4]; exp(-((x-loc)/b)^(-a))}
if (location==FALSE){
den=function(par,x){a=par[2]; b=par[3]; (a*exp(-((x)/b)^(-a))*((x)/b)^(-a-1))/(b)}
cum=function(par,x){a=par[2]; b=par[3]; exp(-((x)/b)^(-a))}
}}
if(g=="birnbaum-saunders"){
den=function(par,x){a=par[2]; b=par[3]; loc=par[4]; (sqrt((x-loc)/b)+sqrt(b/(x-loc)))/(2*a*(x-loc))*dnorm((sqrt((x-loc)/b)-sqrt(b/(x-loc)))/a)}
cum=function(par,x){a=par[2]; b=par[3]; loc=par[4]; pnorm((sqrt((x-loc)/b)-sqrt(b/(x-loc)))/a)}
if (location==FALSE){
den=function(par,x){a=par[2]; b=par[3]; (sqrt((x)/b)+sqrt(b/(x)))/(2*a*(x))*dnorm((sqrt((x)/b)-sqrt(b/(x)))/a)}
cum=function(par,x){a=par[2]; b=par[3]; pnorm((sqrt((x)/b)-sqrt(b/(x)))/a)}
}}
if(g=="weibull"){
den=function(par,x){shape=par[2]; scale=par[3]; loc=par[4]; dweibull(x-loc,shape,scale)}
cum=function(par,x){shape=par[2]; scale=par[3]; loc=par[4]; pweibull(x-loc,shape,scale)}
if (location==FALSE){
den=function(par,x){shape=par[2]; scale=par[3]; dweibull(x,shape,scale)}
cum=function(par,x){shape=par[2]; scale=par[3]; pweibull(x,shape,scale)}
}}
if(g=="gamma"){
den=function(par,x){shape=par[2]; scale=par[3]; loc=par[4]; dgamma(x-loc,shape,scale)}
cum=function(par,x){shape=par[2]; scale=par[3]; loc=par[4]; pgamma(x-loc,shape,scale)}
if (location==FALSE){
den=function(par,x){shape=par[2]; scale=par[3]; dgamma(x,shape,scale)}
cum=function(par,x){shape=par[2]; scale=par[3]; pgamma(x,shape,scale)}
}}
pdf0<-function(par,x){
f0=den(par,x)
c0=cum(par,x)
a=par[1]
a*f0/(1-c0)*(-log(1-c0))**(-a-1)*(1+(-log(1-c0))**(-a))**(-2)
}
pdf<-pdf0(param,mydata)
if(log==TRUE){pdf<-log(pdf)}
return(pdf)
}
pgmbetaexpg<-function(mydata, g, param, location=TRUE, log.p = FALSE, lower.tail = TRUE){
if(g!="birnbaum-saunders" & g!="exp" & g!="rayleigh" & g!="weibull" & g!="gompertz" & g!="gamma"
& g!="log-normal" & g!="chisq" & g!="f" & g!="burrxii" & g!="frechet"
& g!="lomax" & g!="log-logistic" & g!="lfr" & g!="chen")
{ stop ("Baseline distribution not implemented or misspelled. Please check the manual for guidelines.") }
if(g=="log-normal"){
den=function(par,x){meanlog=par[3]; sdlog=par[4]; loc=par[5]; dlnorm(x-loc,meanlog,sdlog)}
cum=function(par,x){meanlog=par[3]; sdlog=par[4]; loc=par[5]; plnorm(x-loc,meanlog,sdlog)}
if (location==FALSE){
den=function(par,x){meanlog=par[3]; sdlog=par[4]; dlnorm(x,meanlog,sdlog)}
cum=function(par,x){meanlog=par[3]; sdlog=par[4]; plnorm(x,meanlog,sdlog)}
}}
if(g=="chisq"){
den=function(par,x){df=par[3]; loc=par[4]; dchisq(x-loc,df)}
cum=function(par,x){df=par[3]; loc=par[4]; pchisq(x-loc,df)}
if (location==FALSE){
den=function(par,x){df=par[3]; dchisq(x,df)}
cum=function(par,x){df=par[3]; pchisq(x,df)}
}}
if(g=="f"){
den=function(par,x){df1=par[3]; df2=par[4]; loc=par[5]; df(x-loc,df1,df2)}
cum=function(par,x){df1=par[3]; df2=par[4]; loc=par[5]; pf(x-loc,df1,df2)}
if (location==FALSE){
den=function(par,x){df1=par[3]; df2=par[4]; df(x,df1,df2)}
cum=function(par,x){df1=par[3]; df2=par[4]; pf(x,df1,df2)}
}}
if(g=="chen"){
den=function(par,x){a=par[3]; b=par[4]; loc=par[5]; a*b*(x-loc)^(a-1)*exp((x-loc)^a)*exp(-b*(exp((x-loc)^a)-1))}
cum=function(par,x){a=par[3]; b=par[4]; loc=par[5]; 1-exp(-b*(exp((x-loc)^a)-1))}
if (location==FALSE){
den=function(par,x){a=par[3]; b=par[4]; a*b*(x)^(a-1)*exp((x)^a)*exp(-b*(exp((x)^a)-1))}
cum=function(par,x){a=par[3]; b=par[4]; 1-exp(-b*(exp((x)^a)-1))}
}}
if(g=="lfr"){
den=function(par,x){a=par[3]; b=par[4]; loc=par[5]; (a+b*(x-loc))*exp(-a*(x-loc)-(b*(x-loc)^2)/2)}
cum=function(par,x){a=par[3]; b=par[4]; loc=par[5]; 1-exp(-a*(x-loc)-(b*(x-loc)^2)/2)}
if (location==FALSE){
den=function(par,x){a=par[3]; b=par[4]; (a+b*(x))*exp(-a*(x)-(b*(x)^2)/2)}
cum=function(par,x){a=par[3]; b=par[4]; 1-exp(-a*(x)-(b*(x)^2)/2)}
}}
if(g=="log-logistic"){
den=function(par,x){a=par[3]; b=par[4]; loc=par[5]; (a*b^(-a)*(x-loc)^(a-1))/((((x-loc)/b)^a +1)^2)}
cum=function(par,x){a=par[3]; b=par[4]; loc=par[5]; 1/(((x-loc)/b)^(-a)+1)}
if (location==FALSE){
den=function(par,x){a=par[3]; b=par[4]; (a*b^(-a)*(x)^(a-1))/((((x)/b)^a +1)^2)}
cum=function(par,x){a=par[3]; b=par[4]; 1/(((x)/b)^(-a)+1)}
}}
if(g=="lomax"){
den=function(par,x){a=par[3]; b=par[4]; loc=par[5]; (a*b)/((1+a*(x-loc))^(b+1))}
cum=function(par,x){a=par[3]; b=par[4]; loc=par[5]; 1-(1+a*(x-loc))^(-b)}
if (location==FALSE){
den=function(par,x){a=par[3]; b=par[4]; (a*b)/((1+a*(x))^(b+1))}
cum=function(par,x){a=par[3]; b=par[4]; 1-(1+a*(x))^(-b)}
}}
if(g=="gompertz"){
den=function(par,x){a=par[3]; b=par[4]; loc=par[5]; b*exp(a*(x-loc))*exp(-(exp(a*(x-loc))-1)*b/a)}
cum=function(par,x){a=par[3]; b=par[4]; loc=par[5]; 1-exp(-(exp(a*(x-loc))-1)*b/a)}
if (location==FALSE){
den=function(par,x){a=par[3]; b=par[4]; b*exp(a*(x))*exp(-(exp(a*(x))-1)*b/a)}
cum=function(par,x){a=par[3]; b=par[4]; 1-exp(-(exp(a*(x))-1)*b/a)}
}}
if(g=="exp"){
den=function(par,x){rate=par[3]; loc=par[4]; dexp(x-loc,rate)}
cum=function(par,x){rate=par[3]; loc=par[4]; pexp(x-loc,rate)}
if (location==FALSE){
den=function(par,x){rate=par[3]; dexp(x,rate)}
cum=function(par,x){rate=par[3]; pexp(x,rate)}
}}
if(g=="rayleigh"){
den=function(par,x){a=par[3]; loc=par[4]; 2*(x-loc)/a*exp(-((x-loc)/a)^2)}
cum=function(par,x){a=par[3]; loc=par[4]; 1-exp(-((x-loc)/a)^2)}
if (location==FALSE){
den=function(par,x){a=par[3]; 2*x/a*exp(-(x/a)^2)}
cum=function(par,x){a=par[3]; 1-exp(-(x/a)^2)}
}}
if(g=="burrxii"){
den=function(par,x){a=par[3]; d=par[4]; loc=par[5]; d*a*(1+(x-loc)^d)^(-a-1)*((x-loc)^(d-1))}
cum=function(par,x){a=par[3]; d=par[4]; loc=par[5]; 1-(1+(x-loc)^d)^(-a)}
if (location==FALSE){
den=function(par,x){a=par[3]; d=par[4]; d*a*(1+(x)^d)^(-a-1)*((x)^(d-1))}
cum=function(par,x){a=par[3]; d=par[4]; 1-(1+(x)^d)^(-a)}
}}
if(g=="frechet"){
den=function(par,x){a=par[3]; b=par[4]; loc=par[5]; (a*exp(-((x-loc)/b)^(-a))*((x-loc)/b)^(-a-1))/(b)}
cum=function(par,x){a=par[3]; b=par[4]; loc=par[5]; exp(-((x-loc)/b)^(-a))}
if (location==FALSE){
den=function(par,x){a=par[3]; b=par[4]; (a*exp(-((x)/b)^(-a))*((x)/b)^(-a-1))/(b)}
cum=function(par,x){a=par[3]; b=par[4]; exp(-((x)/b)^(-a))}
}}
if(g=="birnbaum-saunders"){
den=function(par,x){a=par[3]; b=par[4]; loc=par[5]; (sqrt((x-loc)/b)+sqrt(b/(x-loc)))/(2*a*(x-loc))*dnorm((sqrt((x-loc)/b)-sqrt(b/(x-loc)))/a)}
cum=function(par,x){a=par[3]; b=par[4]; loc=par[5]; pnorm((sqrt((x-loc)/b)-sqrt(b/(x-loc)))/a)}
if (location==FALSE){
den=function(par,x){a=par[3]; b=par[4]; (sqrt((x)/b)+sqrt(b/(x)))/(2*a*(x))*dnorm((sqrt((x)/b)-sqrt(b/(x)))/a)}
cum=function(par,x){a=par[3]; b=par[4]; pnorm((sqrt((x)/b)-sqrt(b/(x)))/a)}
}}
if(g=="weibull"){
den=function(par,x){shape=par[3]; scale=par[4]; loc=par[5]; dweibull(x-loc,shape,scale)}
cum=function(par,x){shape=par[3]; scale=par[4]; loc=par[5]; pweibull(x-loc,shape,scale)}
if (location==FALSE){
den=function(par,x){shape=par[3]; scale=par[4]; dweibull(x,shape,scale)}
cum=function(par,x){shape=par[3]; scale=par[4]; pweibull(x,shape,scale)}
}}
if(g=="gamma"){
den=function(par,x){shape=par[3]; scale=par[4]; loc=par[5]; dgamma(x-loc,shape,scale)}
cum=function(par,x){shape=par[3]; scale=par[4]; loc=par[5]; pgamma(x-loc,shape,scale)}
if (location==FALSE){
den=function(par,x){shape=par[3]; scale=par[4]; dgamma(x,shape,scale)}
cum=function(par,x){shape=par[3]; scale=par[4]; pgamma(x,shape,scale)}
}}
cdf0<-function(par,x){
f0=den(par,x)
c0=cum(par,x)
a=par[1]
b=par[2]
(1-exp(-b*c0/(1-c0)))**a
}
cdf<-cdf0(param,mydata)
if(log.p==TRUE & lower.tail == FALSE) cdf<-log(1-cdf)
if(log.p==TRUE & lower.tail == TRUE) cdf<-log(cdf)
if(log.p==FALSE & lower.tail == FALSE) cdf<-1-cdf
return(cdf)
}
dgmbetaexpg<-function(mydata, g, param, location=TRUE, log=FALSE){
if(g!="birnbaum-saunders" & g!="exp" & g!="rayleigh" & g!="weibull" & g!="gompertz" & g!="gamma"
& g!="log-normal" & g!="chisq" & g!="f" & g!="burrxii" & g!="frechet"
& g!="lomax" & g!="log-logistic" & g!="lfr" & g!="chen")
{ stop ("Baseline distribution not implemented or misspelled. Please check the manual for guidelines.") }
if(g=="log-normal"){
den=function(par,x){meanlog=par[3]; sdlog=par[4]; loc=par[5]; dlnorm(x-loc,meanlog,sdlog)}
cum=function(par,x){meanlog=par[3]; sdlog=par[4]; loc=par[5]; plnorm(x-loc,meanlog,sdlog)}
if (location==FALSE){
den=function(par,x){meanlog=par[3]; sdlog=par[4]; dlnorm(x,meanlog,sdlog)}
cum=function(par,x){meanlog=par[3]; sdlog=par[4]; plnorm(x,meanlog,sdlog)}
}}
if(g=="chisq"){
den=function(par,x){df=par[3]; loc=par[4]; dchisq(x-loc,df)}
cum=function(par,x){df=par[3]; loc=par[4]; pchisq(x-loc,df)}
if (location==FALSE){
den=function(par,x){df=par[3]; dchisq(x,df)}
cum=function(par,x){df=par[3]; pchisq(x,df)}
}}
if(g=="f"){
den=function(par,x){df1=par[3]; df2=par[4]; loc=par[5]; df(x-loc,df1,df2)}
cum=function(par,x){df1=par[3]; df2=par[4]; loc=par[5]; pf(x-loc,df1,df2)}
if (location==FALSE){
den=function(par,x){df1=par[3]; df2=par[4]; df(x,df1,df2)}
cum=function(par,x){df1=par[3]; df2=par[4]; pf(x,df1,df2)}
}}
if(g=="chen"){
den=function(par,x){a=par[3]; b=par[4]; loc=par[5]; a*b*(x-loc)^(a-1)*exp((x-loc)^a)*exp(-b*(exp((x-loc)^a)-1))}
cum=function(par,x){a=par[3]; b=par[4]; loc=par[5]; 1-exp(-b*(exp((x-loc)^a)-1))}
if (location==FALSE){
den=function(par,x){a=par[3]; b=par[4]; a*b*(x)^(a-1)*exp((x)^a)*exp(-b*(exp((x)^a)-1))}
cum=function(par,x){a=par[3]; b=par[4]; 1-exp(-b*(exp((x)^a)-1))}
}}
if(g=="lfr"){
den=function(par,x){a=par[3]; b=par[4]; loc=par[5]; (a+b*(x-loc))*exp(-a*(x-loc)-(b*(x-loc)^2)/2)}
cum=function(par,x){a=par[3]; b=par[4]; loc=par[5]; 1-exp(-a*(x-loc)-(b*(x-loc)^2)/2)}
if (location==FALSE){
den=function(par,x){a=par[3]; b=par[4]; (a+b*(x))*exp(-a*(x)-(b*(x)^2)/2)}
cum=function(par,x){a=par[3]; b=par[4]; 1-exp(-a*(x)-(b*(x)^2)/2)}
}}
if(g=="log-logistic"){
den=function(par,x){a=par[3]; b=par[4]; loc=par[5]; (a*b^(-a)*(x-loc)^(a-1))/((((x-loc)/b)^a +1)^2)}
cum=function(par,x){a=par[3]; b=par[4]; loc=par[5]; 1/(((x-loc)/b)^(-a)+1)}
if (location==FALSE){
den=function(par,x){a=par[3]; b=par[4]; (a*b^(-a)*(x)^(a-1))/((((x)/b)^a +1)^2)}
cum=function(par,x){a=par[3]; b=par[4]; 1/(((x)/b)^(-a)+1)}
}}
if(g=="lomax"){
den=function(par,x){a=par[3]; b=par[4]; loc=par[5]; (a*b)/((1+a*(x-loc))^(b+1))}
cum=function(par,x){a=par[3]; b=par[4]; loc=par[5]; 1-(1+a*(x-loc))^(-b)}
if (location==FALSE){
den=function(par,x){a=par[3]; b=par[4]; (a*b)/((1+a*(x))^(b+1))}
cum=function(par,x){a=par[3]; b=par[4]; 1-(1+a*(x))^(-b)}
}}
if(g=="gompertz"){
den=function(par,x){a=par[3]; b=par[4]; loc=par[5]; b*exp(a*(x-loc))*exp(-(exp(a*(x-loc))-1)*b/a)}
cum=function(par,x){a=par[3]; b=par[4]; loc=par[5]; 1-exp(-(exp(a*(x-loc))-1)*b/a)}
if (location==FALSE){
den=function(par,x){a=par[3]; b=par[4]; b*exp(a*(x))*exp(-(exp(a*(x))-1)*b/a)}
cum=function(par,x){a=par[3]; b=par[4]; 1-exp(-(exp(a*(x))-1)*b/a)}
}}
if(g=="exp"){
den=function(par,x){rate=par[3]; loc=par[4]; dexp(x-loc,rate)}
cum=function(par,x){rate=par[3]; loc=par[4]; pexp(x-loc,rate)}
if (location==FALSE){
den=function(par,x){rate=par[3]; dexp(x,rate)}
cum=function(par,x){rate=par[3]; pexp(x,rate)}
}}
if(g=="rayleigh"){
den=function(par,x){a=par[3]; loc=par[4]; 2*(x-loc)/a*exp(-((x-loc)/a)^2)}
cum=function(par,x){a=par[3]; loc=par[4]; 1-exp(-((x-loc)/a)^2)}
if (location==FALSE){
den=function(par,x){a=par[3]; 2*x/a*exp(-(x/a)^2)}
cum=function(par,x){a=par[3]; 1-exp(-(x/a)^2)}
}}
if(g=="burrxii"){
den=function(par,x){a=par[3]; d=par[4]; loc=par[5]; d*a*(1+(x-loc)^d)^(-a-1)*((x-loc)^(d-1))}
cum=function(par,x){a=par[3]; d=par[4]; loc=par[5]; 1-(1+(x-loc)^d)^(-a)}
if (location==FALSE){
den=function(par,x){a=par[3]; d=par[4]; d*a*(1+(x)^d)^(-a-1)*((x)^(d-1))}
cum=function(par,x){a=par[3]; d=par[4]; 1-(1+(x)^d)^(-a)}
}}
if(g=="frechet"){
den=function(par,x){a=par[3]; b=par[4]; loc=par[5]; (a*exp(-((x-loc)/b)^(-a))*((x-loc)/b)^(-a-1))/(b)}
cum=function(par,x){a=par[3]; b=par[4]; loc=par[5]; exp(-((x-loc)/b)^(-a))}
if (location==FALSE){
den=function(par,x){a=par[3]; b=par[4]; (a*exp(-((x)/b)^(-a))*((x)/b)^(-a-1))/(b)}
cum=function(par,x){a=par[3]; b=par[4]; exp(-((x)/b)^(-a))}
}}
if(g=="birnbaum-saunders"){
den=function(par,x){a=par[3]; b=par[4]; loc=par[5]; (sqrt((x-loc)/b)+sqrt(b/(x-loc)))/(2*a*(x-loc))*dnorm((sqrt((x-loc)/b)-sqrt(b/(x-loc)))/a)}
cum=function(par,x){a=par[3]; b=par[4]; loc=par[5]; pnorm((sqrt((x-loc)/b)-sqrt(b/(x-loc)))/a)}
if (location==FALSE){
den=function(par,x){a=par[3]; b=par[4]; (sqrt((x)/b)+sqrt(b/(x)))/(2*a*(x))*dnorm((sqrt((x)/b)-sqrt(b/(x)))/a)}
cum=function(par,x){a=par[3]; b=par[4]; pnorm((sqrt((x)/b)-sqrt(b/(x)))/a)}
}}
if(g=="weibull"){
den=function(par,x){shape=par[3]; scale=par[4]; loc=par[5]; dweibull(x-loc,shape,scale)}
cum=function(par,x){shape=par[3]; scale=par[4]; loc=par[5]; pweibull(x-loc,shape,scale)}
if (location==FALSE){
den=function(par,x){shape=par[3]; scale=par[4]; dweibull(x,shape,scale)}
cum=function(par,x){shape=par[3]; scale=par[4]; pweibull(x,shape,scale)}
}}
if(g=="gamma"){
den=function(par,x){shape=par[3]; scale=par[4]; loc=par[5]; dgamma(x-loc,shape,scale)}
cum=function(par,x){shape=par[3]; scale=par[4]; loc=par[5]; pgamma(x-loc,shape,scale)}
if (location==FALSE){
den=function(par,x){shape=par[3]; scale=par[4]; dgamma(x,shape,scale)}
cum=function(par,x){shape=par[3]; scale=par[4]; pgamma(x,shape,scale)}
}}
pdf0<-function(par,x){
f0=den(par,x)
c0=cum(par,x)
a=par[1]
b=par[2]
b*a*f0/(1-c0)**2*exp(-b*c0/(1-c0))*(1-exp(-b*c0/(1-c0)))**(a-1)
}
pdf<-pdf0(param,mydata)
if(log==TRUE){pdf<-log(pdf)}
return(pdf)
}
ptexpsg<-function(mydata, g, param, location=TRUE, log.p = FALSE, lower.tail = TRUE){
if(g!="birnbaum-saunders" & g!="exp" & g!="rayleigh" & g!="weibull" & g!="gompertz" & g!="gamma"
& g!="log-normal" & g!="chisq" & g!="f" & g!="burrxii" & g!="frechet"
& g!="lomax" & g!="log-logistic" & g!="lfr" & g!="chen")
{ stop ("Baseline distribution not implemented or misspelled. Please check the manual for guidelines.") }
if(g=="log-normal"){
den=function(par,x){meanlog=par[2]; sdlog=par[3]; loc=par[4]; dlnorm(x-loc,meanlog,sdlog)}
cum=function(par,x){meanlog=par[2]; sdlog=par[3]; loc=par[4]; plnorm(x-loc,meanlog,sdlog)}
if (location==FALSE){
den=function(par,x){meanlog=par[2]; sdlog=par[3]; dlnorm(x,meanlog,sdlog)}
cum=function(par,x){meanlog=par[2]; sdlog=par[3]; plnorm(x,meanlog,sdlog)}
}}
if(g=="chisq"){
den=function(par,x){df=par[2]; loc=par[3]; dchisq(x-loc,df)}
cum=function(par,x){df=par[2]; loc=par[3]; pchisq(x-loc,df)}
if (location==FALSE){
den=function(par,x){df=par[2]; dchisq(x,df)}
cum=function(par,x){df=par[2]; pchisq(x,df)}
}}
if(g=="f"){
den=function(par,x){df1=par[2]; df2=par[3]; loc=par[4]; df(x-loc,df1,df2)}
cum=function(par,x){df1=par[2]; df2=par[3]; loc=par[4]; pf(x-loc,df1,df2)}
if (location==FALSE){
den=function(par,x){df1=par[2]; df2=par[3]; df(x,df1,df2)}
cum=function(par,x){df1=par[2]; df2=par[3]; pf(x,df1,df2)}
}}
if(g=="chen"){
den=function(par,x){a=par[2]; b=par[3]; loc=par[4]; a*b*(x-loc)^(a-1)*exp((x-loc)^a)*exp(-b*(exp((x-loc)^a)-1))}
cum=function(par,x){a=par[2]; b=par[3]; loc=par[4]; 1-exp(-b*(exp((x-loc)^a)-1))}
if (location==FALSE){
den=function(par,x){a=par[2]; b=par[3]; a*b*(x)^(a-1)*exp((x)^a)*exp(-b*(exp((x)^a)-1))}
cum=function(par,x){a=par[2]; b=par[3]; 1-exp(-b*(exp((x)^a)-1))}
}}
if(g=="lfr"){
den=function(par,x){a=par[2]; b=par[3]; loc=par[4]; (a+b*(x-loc))*exp(-a*(x-loc)-(b*(x-loc)^2)/2)}
cum=function(par,x){a=par[2]; b=par[3]; loc=par[4]; 1-exp(-a*(x-loc)-(b*(x-loc)^2)/2)}
if (location==FALSE){
den=function(par,x){a=par[2]; b=par[3]; (a+b*(x))*exp(-a*(x)-(b*(x)^2)/2)}
cum=function(par,x){a=par[2]; b=par[3]; 1-exp(-a*(x)-(b*(x)^2)/2)}
}}
if(g=="log-logistic"){
den=function(par,x){a=par[2]; b=par[3]; loc=par[4]; (a*b^(-a)*(x-loc)^(a-1))/((((x-loc)/b)^a +1)^2)}
cum=function(par,x){a=par[2]; b=par[3]; loc=par[4]; 1/(((x-loc)/b)^(-a)+1)}
if (location==FALSE){
den=function(par,x){a=par[2]; b=par[3]; (a*b^(-a)*(x)^(a-1))/((((x)/b)^a +1)^2)}
cum=function(par,x){a=par[2]; b=par[3]; 1/(((x)/b)^(-a)+1)}
}}
if(g=="lomax"){
den=function(par,x){a=par[2]; b=par[3]; loc=par[4]; (a*b)/((1+a*(x-loc))^(b+1))}
cum=function(par,x){a=par[2]; b=par[3]; loc=par[4]; 1-(1+a*(x-loc))^(-b)}
if (location==FALSE){
den=function(par,x){a=par[2]; b=par[3]; (a*b)/((1+a*(x))^(b+1))}
cum=function(par,x){a=par[2]; b=par[3]; 1-(1+a*(x))^(-b)}
}}
if(g=="gompertz"){
den=function(par,x){a=par[2]; b=par[3]; loc=par[4]; b*exp(a*(x-loc))*exp(-(exp(a*(x-loc))-1)*b/a)}
cum=function(par,x){a=par[2]; b=par[3]; loc=par[4]; 1-exp(-(exp(a*(x-loc))-1)*b/a)}
if (location==FALSE){
den=function(par,x){a=par[2]; b=par[3]; b*exp(a*(x))*exp(-(exp(a*(x))-1)*b/a)}
cum=function(par,x){a=par[2]; b=par[3]; 1-exp(-(exp(a*(x))-1)*b/a)}
}}
if(g=="exp"){
den=function(par,x){rate=par[2]; loc=par[3]; dexp(x-loc,rate)}
cum=function(par,x){rate=par[2]; loc=par[3]; pexp(x-loc,rate)}
if (location==FALSE){
den=function(par,x){rate=par[2]; dexp(x,rate)}
cum=function(par,x){rate=par[2]; pexp(x,rate)}
}}
if(g=="rayleigh"){
den=function(par,x){a=par[2]; loc=par[3]; 2*(x-loc)/a*exp(-((x-loc)/a)^2)}
cum=function(par,x){a=par[2]; loc=par[3]; 1-exp(-((x-loc)/a)^2)}
if (location==FALSE){
den=function(par,x){a=par[2]; 2*x/a*exp(-(x/a)^2)}
cum=function(par,x){a=par[2]; 1-exp(-(x/a)^2)}
}}
if(g=="burrxii"){
den=function(par,x){a=par[2]; d=par[3]; loc=par[4]; d*a*(1+(x-loc)^d)^(-a-1)*((x-loc)^(d-1))}
cum=function(par,x){a=par[2]; d=par[3]; loc=par[4]; 1-(1+(x-loc)^d)^(-a)}
if (location==FALSE){
den=function(par,x){a=par[2]; d=par[3]; d*a*(1+(x)^d)^(-a-1)*((x)^(d-1))}
cum=function(par,x){a=par[2]; d=par[3]; 1-(1+(x)^d)^(-a)}
}}
if(g=="frechet"){
den=function(par,x){a=par[2]; b=par[3]; loc=par[4]; (a*exp(-((x-loc)/b)^(-a))*((x-loc)/b)^(-a-1))/(b)}
cum=function(par,x){a=par[2]; b=par[3]; loc=par[4]; exp(-((x-loc)/b)^(-a))}
if (location==FALSE){
den=function(par,x){a=par[2]; b=par[3]; (a*exp(-((x)/b)^(-a))*((x)/b)^(-a-1))/(b)}
cum=function(par,x){a=par[2]; b=par[3]; exp(-((x)/b)^(-a))}
}}
if(g=="birnbaum-saunders"){
den=function(par,x){a=par[2]; b=par[3]; loc=par[4]; (sqrt((x-loc)/b)+sqrt(b/(x-loc)))/(2*a*(x-loc))*dnorm((sqrt((x-loc)/b)-sqrt(b/(x-loc)))/a)}
cum=function(par,x){a=par[2]; b=par[3]; loc=par[4]; pnorm((sqrt((x-loc)/b)-sqrt(b/(x-loc)))/a)}
if (location==FALSE){
den=function(par,x){a=par[2]; b=par[3]; (sqrt((x)/b)+sqrt(b/(x)))/(2*a*(x))*dnorm((sqrt((x)/b)-sqrt(b/(x)))/a)}
cum=function(par,x){a=par[2]; b=par[3]; pnorm((sqrt((x)/b)-sqrt(b/(x)))/a)}
}}
if(g=="weibull"){
den=function(par,x){shape=par[2]; scale=par[3]; loc=par[4]; dweibull(x-loc,shape,scale)}
cum=function(par,x){shape=par[2]; scale=par[3]; loc=par[4]; pweibull(x-loc,shape,scale)}
if (location==FALSE){
den=function(par,x){shape=par[2]; scale=par[3]; dweibull(x,shape,scale)}
cum=function(par,x){shape=par[2]; scale=par[3]; pweibull(x,shape,scale)}
}}
if(g=="gamma"){
den=function(par,x){shape=par[2]; scale=par[3]; loc=par[4]; dgamma(x-loc,shape,scale)}
cum=function(par,x){shape=par[2]; scale=par[3]; loc=par[4]; pgamma(x-loc,shape,scale)}
if (location==FALSE){
den=function(par,x){shape=par[2]; scale=par[3]; dgamma(x,shape,scale)}
cum=function(par,x){shape=par[2]; scale=par[3]; pgamma(x,shape,scale)}
}}
cdf0<-function(par,x){
f0=den(par,x)
c0=cum(par,x)
a=par[1]
(1-exp(-a*c0))*(1-exp(-a))^(-1)
}
cdf<-cdf0(param,mydata)
if(log.p==TRUE & lower.tail == FALSE) cdf<-log(1-cdf)
if(log.p==TRUE & lower.tail == TRUE) cdf<-log(cdf)
if(log.p==FALSE & lower.tail == FALSE) cdf<-1-cdf
return(cdf)
}
dtexpsg<-function(mydata, g, param, location=TRUE, log=FALSE){
if(g!="birnbaum-saunders" & g!="exp" & g!="rayleigh" & g!="weibull" & g!="gompertz" & g!="gamma"
& g!="log-normal" & g!="chisq" & g!="f" & g!="burrxii" & g!="frechet"
& g!="lomax" & g!="log-logistic" & g!="lfr" & g!="chen")
{ stop ("Baseline distribution not implemented or misspelled. Please check the manual for guidelines.") }
if(g=="log-normal"){
den=function(par,x){meanlog=par[2]; sdlog=par[3]; loc=par[4]; dlnorm(x-loc,meanlog,sdlog)}
cum=function(par,x){meanlog=par[2]; sdlog=par[3]; loc=par[4]; plnorm(x-loc,meanlog,sdlog)}
if (location==FALSE){
den=function(par,x){meanlog=par[2]; sdlog=par[3]; dlnorm(x,meanlog,sdlog)}
cum=function(par,x){meanlog=par[2]; sdlog=par[3]; plnorm(x,meanlog,sdlog)}
}}
if(g=="chisq"){
den=function(par,x){df=par[2]; loc=par[3]; dchisq(x-loc,df)}
cum=function(par,x){df=par[2]; loc=par[3]; pchisq(x-loc,df)}
if (location==FALSE){
den=function(par,x){df=par[2]; dchisq(x,df)}
cum=function(par,x){df=par[2]; pchisq(x,df)}
}}
if(g=="f"){
den=function(par,x){df1=par[2]; df2=par[3]; loc=par[4]; df(x-loc,df1,df2)}
cum=function(par,x){df1=par[2]; df2=par[3]; loc=par[4]; pf(x-loc,df1,df2)}
if (location==FALSE){
den=function(par,x){df1=par[2]; df2=par[3]; df(x,df1,df2)}
cum=function(par,x){df1=par[2]; df2=par[3]; pf(x,df1,df2)}
}}
if(g=="chen"){
den=function(par,x){a=par[2]; b=par[3]; loc=par[4]; a*b*(x-loc)^(a-1)*exp((x-loc)^a)*exp(-b*(exp((x-loc)^a)-1))}
cum=function(par,x){a=par[2]; b=par[3]; loc=par[4]; 1-exp(-b*(exp((x-loc)^a)-1))}
if (location==FALSE){
den=function(par,x){a=par[2]; b=par[3]; a*b*(x)^(a-1)*exp((x)^a)*exp(-b*(exp((x)^a)-1))}
cum=function(par,x){a=par[2]; b=par[3]; 1-exp(-b*(exp((x)^a)-1))}
}}
if(g=="lfr"){
den=function(par,x){a=par[2]; b=par[3]; loc=par[4]; (a+b*(x-loc))*exp(-a*(x-loc)-(b*(x-loc)^2)/2)}
cum=function(par,x){a=par[2]; b=par[3]; loc=par[4]; 1-exp(-a*(x-loc)-(b*(x-loc)^2)/2)}
if (location==FALSE){
den=function(par,x){a=par[2]; b=par[3]; (a+b*(x))*exp(-a*(x)-(b*(x)^2)/2)}
cum=function(par,x){a=par[2]; b=par[3]; 1-exp(-a*(x)-(b*(x)^2)/2)}
}}
if(g=="log-logistic"){
den=function(par,x){a=par[2]; b=par[3]; loc=par[4]; (a*b^(-a)*(x-loc)^(a-1))/((((x-loc)/b)^a +1)^2)}
cum=function(par,x){a=par[2]; b=par[3]; loc=par[4]; 1/(((x-loc)/b)^(-a)+1)}
if (location==FALSE){
den=function(par,x){a=par[2]; b=par[3]; (a*b^(-a)*(x)^(a-1))/((((x)/b)^a +1)^2)}
cum=function(par,x){a=par[2]; b=par[3]; 1/(((x)/b)^(-a)+1)}
}}
if(g=="lomax"){
den=function(par,x){a=par[2]; b=par[3]; loc=par[4]; (a*b)/((1+a*(x-loc))^(b+1))}
cum=function(par,x){a=par[2]; b=par[3]; loc=par[4]; 1-(1+a*(x-loc))^(-b)}
if (location==FALSE){
den=function(par,x){a=par[2]; b=par[3]; (a*b)/((1+a*(x))^(b+1))}
cum=function(par,x){a=par[2]; b=par[3]; 1-(1+a*(x))^(-b)}
}}
if(g=="gompertz"){
den=function(par,x){a=par[2]; b=par[3]; loc=par[4]; b*exp(a*(x-loc))*exp(-(exp(a*(x-loc))-1)*b/a)}
cum=function(par,x){a=par[2]; b=par[3]; loc=par[4]; 1-exp(-(exp(a*(x-loc))-1)*b/a)}
if (location==FALSE){
den=function(par,x){a=par[2]; b=par[3]; b*exp(a*(x))*exp(-(exp(a*(x))-1)*b/a)}
cum=function(par,x){a=par[2]; b=par[3]; 1-exp(-(exp(a*(x))-1)*b/a)}
}}
if(g=="exp"){
den=function(par,x){rate=par[2]; loc=par[3]; dexp(x-loc,rate)}
cum=function(par,x){rate=par[2]; loc=par[3]; pexp(x-loc,rate)}
if (location==FALSE){
den=function(par,x){rate=par[2]; dexp(x,rate)}
cum=function(par,x){rate=par[2]; pexp(x,rate)}
}}
if(g=="rayleigh"){
den=function(par,x){a=par[2]; loc=par[3]; 2*(x-loc)/a*exp(-((x-loc)/a)^2)}
cum=function(par,x){a=par[2]; loc=par[3]; 1-exp(-((x-loc)/a)^2)}
if (location==FALSE){
den=function(par,x){a=par[2]; 2*x/a*exp(-(x/a)^2)}
cum=function(par,x){a=par[2]; 1-exp(-(x/a)^2)}
}}
if(g=="burrxii"){
den=function(par,x){a=par[2]; d=par[3]; loc=par[4]; d*a*(1+(x-loc)^d)^(-a-1)*((x-loc)^(d-1))}
cum=function(par,x){a=par[2]; d=par[3]; loc=par[4]; 1-(1+(x-loc)^d)^(-a)}
if (location==FALSE){
den=function(par,x){a=par[2]; d=par[3]; d*a*(1+(x)^d)^(-a-1)*((x)^(d-1))}
cum=function(par,x){a=par[2]; d=par[3]; 1-(1+(x)^d)^(-a)}
}}
if(g=="frechet"){
den=function(par,x){a=par[2]; b=par[3]; loc=par[4]; (a*exp(-((x-loc)/b)^(-a))*((x-loc)/b)^(-a-1))/(b)}
cum=function(par,x){a=par[2]; b=par[3]; loc=par[4]; exp(-((x-loc)/b)^(-a))}
if (location==FALSE){
den=function(par,x){a=par[2]; b=par[3]; (a*exp(-((x)/b)^(-a))*((x)/b)^(-a-1))/(b)}
cum=function(par,x){a=par[2]; b=par[3]; exp(-((x)/b)^(-a))}
}}
if(g=="birnbaum-saunders"){
den=function(par,x){a=par[2]; b=par[3]; loc=par[4]; (sqrt((x-loc)/b)+sqrt(b/(x-loc)))/(2*a*(x-loc))*dnorm((sqrt((x-loc)/b)-sqrt(b/(x-loc)))/a)}
cum=function(par,x){a=par[2]; b=par[3]; loc=par[4]; pnorm((sqrt((x-loc)/b)-sqrt(b/(x-loc)))/a)}
if (location==FALSE){
den=function(par,x){a=par[2]; b=par[3]; (sqrt((x)/b)+sqrt(b/(x)))/(2*a*(x))*dnorm((sqrt((x)/b)-sqrt(b/(x)))/a)}
cum=function(par,x){a=par[2]; b=par[3]; pnorm((sqrt((x)/b)-sqrt(b/(x)))/a)}
}}
if(g=="weibull"){
den=function(par,x){shape=par[2]; scale=par[3]; loc=par[4]; dweibull(x-loc,shape,scale)}
cum=function(par,x){shape=par[2]; scale=par[3]; loc=par[4]; pweibull(x-loc,shape,scale)}
if (location==FALSE){
den=function(par,x){shape=par[2]; scale=par[3]; dweibull(x,shape,scale)}
cum=function(par,x){shape=par[2]; scale=par[3]; pweibull(x,shape,scale)}
}}
if(g=="gamma"){
den=function(par,x){shape=par[2]; scale=par[3]; loc=par[4]; dgamma(x-loc,shape,scale)}
cum=function(par,x){shape=par[2]; scale=par[3]; loc=par[4]; pgamma(x-loc,shape,scale)}
if (location==FALSE){
den=function(par,x){shape=par[2]; scale=par[3]; dgamma(x,shape,scale)}
cum=function(par,x){shape=par[2]; scale=par[3]; pgamma(x,shape,scale)}
}}
pdf0<-function(par,x){
f0=den(par,x)
c0=cum(par,x)
a=par[1]
a*(1-exp(-a))^(-1)*f0*exp(-a*c0)
}
pdf<-pdf0(param,mydata)
if(log==TRUE){pdf<-log(pdf)}
return(pdf)
}
pweibullg<-function(mydata, g, param, location=TRUE, log.p = FALSE, lower.tail = TRUE){
if(g!="birnbaum-saunders" & g!="exp" & g!="rayleigh" & g!="weibull" & g!="gompertz" & g!="gamma"
& g!="log-normal" & g!="chisq" & g!="f" & g!="burrxii" & g!="frechet"
& g!="lomax" & g!="log-logistic" & g!="lfr" & g!="chen")
{ stop ("Baseline distribution not implemented or misspelled. Please check the manual for guidelines.") }
if(g=="log-normal"){
den=function(par,x){meanlog=par[3]; sdlog=par[4]; loc=par[5]; dlnorm(x-loc,meanlog,sdlog)}
cum=function(par,x){meanlog=par[3]; sdlog=par[4]; loc=par[5]; plnorm(x-loc,meanlog,sdlog)}
if (location==FALSE){
den=function(par,x){meanlog=par[3]; sdlog=par[4]; dlnorm(x,meanlog,sdlog)}
cum=function(par,x){meanlog=par[3]; sdlog=par[4]; plnorm(x,meanlog,sdlog)}
}}
if(g=="chisq"){
den=function(par,x){df=par[3]; loc=par[4]; dchisq(x-loc,df)}
cum=function(par,x){df=par[3]; loc=par[4]; pchisq(x-loc,df)}
if (location==FALSE){
den=function(par,x){df=par[3]; dchisq(x,df)}
cum=function(par,x){df=par[3]; pchisq(x,df)}
}}
if(g=="f"){
den=function(par,x){df1=par[3]; df2=par[4]; loc=par[5]; df(x-loc,df1,df2)}
cum=function(par,x){df1=par[3]; df2=par[4]; loc=par[5]; pf(x-loc,df1,df2)}
if (location==FALSE){
den=function(par,x){df1=par[3]; df2=par[4]; df(x,df1,df2)}
cum=function(par,x){df1=par[3]; df2=par[4]; pf(x,df1,df2)}
}}
if(g=="chen"){
den=function(par,x){a=par[3]; b=par[4]; loc=par[5]; a*b*(x-loc)^(a-1)*exp((x-loc)^a)*exp(-b*(exp((x-loc)^a)-1))}
cum=function(par,x){a=par[3]; b=par[4]; loc=par[5]; 1-exp(-b*(exp((x-loc)^a)-1))}
if (location==FALSE){
den=function(par,x){a=par[3]; b=par[4]; a*b*(x)^(a-1)*exp((x)^a)*exp(-b*(exp((x)^a)-1))}
cum=function(par,x){a=par[3]; b=par[4]; 1-exp(-b*(exp((x)^a)-1))}
}}
if(g=="lfr"){
den=function(par,x){a=par[3]; b=par[4]; loc=par[5]; (a+b*(x-loc))*exp(-a*(x-loc)-(b*(x-loc)^2)/2)}
cum=function(par,x){a=par[3]; b=par[4]; loc=par[5]; 1-exp(-a*(x-loc)-(b*(x-loc)^2)/2)}
if (location==FALSE){
den=function(par,x){a=par[3]; b=par[4]; (a+b*(x))*exp(-a*(x)-(b*(x)^2)/2)}
cum=function(par,x){a=par[3]; b=par[4]; 1-exp(-a*(x)-(b*(x)^2)/2)}
}}
if(g=="log-logistic"){
den=function(par,x){a=par[3]; b=par[4]; loc=par[5]; (a*b^(-a)*(x-loc)^(a-1))/((((x-loc)/b)^a +1)^2)}
cum=function(par,x){a=par[3]; b=par[4]; loc=par[5]; 1/(((x-loc)/b)^(-a)+1)}
if (location==FALSE){
den=function(par,x){a=par[3]; b=par[4]; (a*b^(-a)*(x)^(a-1))/((((x)/b)^a +1)^2)}
cum=function(par,x){a=par[3]; b=par[4]; 1/(((x)/b)^(-a)+1)}
}}
if(g=="lomax"){
den=function(par,x){a=par[3]; b=par[4]; loc=par[5]; (a*b)/((1+a*(x-loc))^(b+1))}
cum=function(par,x){a=par[3]; b=par[4]; loc=par[5]; 1-(1+a*(x-loc))^(-b)}
if (location==FALSE){
den=function(par,x){a=par[3]; b=par[4]; (a*b)/((1+a*(x))^(b+1))}
cum=function(par,x){a=par[3]; b=par[4]; 1-(1+a*(x))^(-b)}
}}
if(g=="gompertz"){
den=function(par,x){a=par[3]; b=par[4]; loc=par[5]; b*exp(a*(x-loc))*exp(-(exp(a*(x-loc))-1)*b/a)}
cum=function(par,x){a=par[3]; b=par[4]; loc=par[5]; 1-exp(-(exp(a*(x-loc))-1)*b/a)}
if (location==FALSE){
den=function(par,x){a=par[3]; b=par[4]; b*exp(a*(x))*exp(-(exp(a*(x))-1)*b/a)}
cum=function(par,x){a=par[3]; b=par[4]; 1-exp(-(exp(a*(x))-1)*b/a)}
}}
if(g=="exp"){
den=function(par,x){rate=par[3]; loc=par[4]; dexp(x-loc,rate)}
cum=function(par,x){rate=par[3]; loc=par[4]; pexp(x-loc,rate)}
if (location==FALSE){
den=function(par,x){rate=par[3]; dexp(x,rate)}
cum=function(par,x){rate=par[3]; pexp(x,rate)}
}}
if(g=="rayleigh"){
den=function(par,x){a=par[3]; loc=par[4]; 2*(x-loc)/a*exp(-((x-loc)/a)^2)}
cum=function(par,x){a=par[3]; loc=par[4]; 1-exp(-((x-loc)/a)^2)}
if (location==FALSE){
den=function(par,x){a=par[3]; 2*x/a*exp(-(x/a)^2)}
cum=function(par,x){a=par[3]; 1-exp(-(x/a)^2)}
}}
if(g=="burrxii"){
den=function(par,x){a=par[3]; d=par[4]; loc=par[5]; d*a*(1+(x-loc)^d)^(-a-1)*((x-loc)^(d-1))}
cum=function(par,x){a=par[3]; d=par[4]; loc=par[5]; 1-(1+(x-loc)^d)^(-a)}
if (location==FALSE){
den=function(par,x){a=par[3]; d=par[4]; d*a*(1+(x)^d)^(-a-1)*((x)^(d-1))}
cum=function(par,x){a=par[3]; d=par[4]; 1-(1+(x)^d)^(-a)}
}}
if(g=="frechet"){
den=function(par,x){a=par[3]; b=par[4]; loc=par[5]; (a*exp(-((x-loc)/b)^(-a))*((x-loc)/b)^(-a-1))/(b)}
cum=function(par,x){a=par[3]; b=par[4]; loc=par[5]; exp(-((x-loc)/b)^(-a))}
if (location==FALSE){
den=function(par,x){a=par[3]; b=par[4]; (a*exp(-((x)/b)^(-a))*((x)/b)^(-a-1))/(b)}
cum=function(par,x){a=par[3]; b=par[4]; exp(-((x)/b)^(-a))}
}}
if(g=="birnbaum-saunders"){
den=function(par,x){a=par[3]; b=par[4]; loc=par[5]; (sqrt((x-loc)/b)+sqrt(b/(x-loc)))/(2*a*(x-loc))*dnorm((sqrt((x-loc)/b)-sqrt(b/(x-loc)))/a)}
cum=function(par,x){a=par[3]; b=par[4]; loc=par[5]; pnorm((sqrt((x-loc)/b)-sqrt(b/(x-loc)))/a)}
if (location==FALSE){
den=function(par,x){a=par[3]; b=par[4]; (sqrt((x)/b)+sqrt(b/(x)))/(2*a*(x))*dnorm((sqrt((x)/b)-sqrt(b/(x)))/a)}
cum=function(par,x){a=par[3]; b=par[4]; pnorm((sqrt((x)/b)-sqrt(b/(x)))/a)}
}}
if(g=="weibull"){
den=function(par,x){shape=par[3]; scale=par[4]; loc=par[5]; dweibull(x-loc,shape,scale)}
cum=function(par,x){shape=par[3]; scale=par[4]; loc=par[5]; pweibull(x-loc,shape,scale)}
if (location==FALSE){
den=function(par,x){shape=par[3]; scale=par[4]; dweibull(x,shape,scale)}
cum=function(par,x){shape=par[3]; scale=par[4]; pweibull(x,shape,scale)}
}}
if(g=="gamma"){
den=function(par,x){shape=par[3]; scale=par[4]; loc=par[5]; dgamma(x-loc,shape,scale)}
cum=function(par,x){shape=par[3]; scale=par[4]; loc=par[5]; pgamma(x-loc,shape,scale)}
if (location==FALSE){
den=function(par,x){shape=par[3]; scale=par[4]; dgamma(x,shape,scale)}
cum=function(par,x){shape=par[3]; scale=par[4]; pgamma(x,shape,scale)}
}}
cdf0<-function(par,x){
f0=den(par,x)
c0=cum(par,x)
a=par[1]
b=par[2]
1-exp(-b**(-a)*(-log(1-c0))**a)
}
cdf<-cdf0(param,mydata)
if(log.p==TRUE & lower.tail == FALSE) cdf<-log(1-cdf)
if(log.p==TRUE & lower.tail == TRUE) cdf<-log(cdf)
if(log.p==FALSE & lower.tail == FALSE) cdf<-1-cdf
return(cdf)
}
dweibullg<-function(mydata, g, param, location=TRUE, log=FALSE){
if(g!="birnbaum-saunders" & g!="exp" & g!="rayleigh" & g!="weibull" & g!="gompertz" & g!="gamma"
& g!="log-normal" & g!="chisq" & g!="f" & g!="burrxii" & g!="frechet"
& g!="lomax" & g!="log-logistic" & g!="lfr" & g!="chen")
{ stop ("Baseline distribution not implemented or misspelled. Please check the manual for guidelines.") }
if(g=="log-normal"){
den=function(par,x){meanlog=par[3]; sdlog=par[4]; loc=par[5]; dlnorm(x-loc,meanlog,sdlog)}
cum=function(par,x){meanlog=par[3]; sdlog=par[4]; loc=par[5]; plnorm(x-loc,meanlog,sdlog)}
if (location==FALSE){
den=function(par,x){meanlog=par[3]; sdlog=par[4]; dlnorm(x,meanlog,sdlog)}
cum=function(par,x){meanlog=par[3]; sdlog=par[4]; plnorm(x,meanlog,sdlog)}
}}
if(g=="chisq"){
den=function(par,x){df=par[3]; loc=par[4]; dchisq(x-loc,df)}
cum=function(par,x){df=par[3]; loc=par[4]; pchisq(x-loc,df)}
if (location==FALSE){
den=function(par,x){df=par[3]; dchisq(x,df)}
cum=function(par,x){df=par[3]; pchisq(x,df)}
}}
if(g=="f"){
den=function(par,x){df1=par[3]; df2=par[4]; loc=par[5]; df(x-loc,df1,df2)}
cum=function(par,x){df1=par[3]; df2=par[4]; loc=par[5]; pf(x-loc,df1,df2)}
if (location==FALSE){
den=function(par,x){df1=par[3]; df2=par[4]; df(x,df1,df2)}
cum=function(par,x){df1=par[3]; df2=par[4]; pf(x,df1,df2)}
}}
if(g=="chen"){
den=function(par,x){a=par[3]; b=par[4]; loc=par[5]; a*b*(x-loc)^(a-1)*exp((x-loc)^a)*exp(-b*(exp((x-loc)^a)-1))}
cum=function(par,x){a=par[3]; b=par[4]; loc=par[5]; 1-exp(-b*(exp((x-loc)^a)-1))}
if (location==FALSE){
den=function(par,x){a=par[3]; b=par[4]; a*b*(x)^(a-1)*exp((x)^a)*exp(-b*(exp((x)^a)-1))}
cum=function(par,x){a=par[3]; b=par[4]; 1-exp(-b*(exp((x)^a)-1))}
}}
if(g=="lfr"){
den=function(par,x){a=par[3]; b=par[4]; loc=par[5]; (a+b*(x-loc))*exp(-a*(x-loc)-(b*(x-loc)^2)/2)}
cum=function(par,x){a=par[3]; b=par[4]; loc=par[5]; 1-exp(-a*(x-loc)-(b*(x-loc)^2)/2)}
if (location==FALSE){
den=function(par,x){a=par[3]; b=par[4]; (a+b*(x))*exp(-a*(x)-(b*(x)^2)/2)}
cum=function(par,x){a=par[3]; b=par[4]; 1-exp(-a*(x)-(b*(x)^2)/2)}
}}
if(g=="log-logistic"){
den=function(par,x){a=par[3]; b=par[4]; loc=par[5]; (a*b^(-a)*(x-loc)^(a-1))/((((x-loc)/b)^a +1)^2)}
cum=function(par,x){a=par[3]; b=par[4]; loc=par[5]; 1/(((x-loc)/b)^(-a)+1)}
if (location==FALSE){
den=function(par,x){a=par[3]; b=par[4]; (a*b^(-a)*(x)^(a-1))/((((x)/b)^a +1)^2)}
cum=function(par,x){a=par[3]; b=par[4]; 1/(((x)/b)^(-a)+1)}
}}
if(g=="lomax"){
den=function(par,x){a=par[3]; b=par[4]; loc=par[5]; (a*b)/((1+a*(x-loc))^(b+1))}
cum=function(par,x){a=par[3]; b=par[4]; loc=par[5]; 1-(1+a*(x-loc))^(-b)}
if (location==FALSE){
den=function(par,x){a=par[3]; b=par[4]; (a*b)/((1+a*(x))^(b+1))}
cum=function(par,x){a=par[3]; b=par[4]; 1-(1+a*(x))^(-b)}
}}
if(g=="gompertz"){
den=function(par,x){a=par[3]; b=par[4]; loc=par[5]; b*exp(a*(x-loc))*exp(-(exp(a*(x-loc))-1)*b/a)}
cum=function(par,x){a=par[3]; b=par[4]; loc=par[5]; 1-exp(-(exp(a*(x-loc))-1)*b/a)}
if (location==FALSE){
den=function(par,x){a=par[3]; b=par[4]; b*exp(a*(x))*exp(-(exp(a*(x))-1)*b/a)}
cum=function(par,x){a=par[3]; b=par[4]; 1-exp(-(exp(a*(x))-1)*b/a)}
}}
if(g=="exp"){
den=function(par,x){rate=par[3]; loc=par[4]; dexp(x-loc,rate)}
cum=function(par,x){rate=par[3]; loc=par[4]; pexp(x-loc,rate)}
if (location==FALSE){
den=function(par,x){rate=par[3]; dexp(x,rate)}
cum=function(par,x){rate=par[3]; pexp(x,rate)}
}}
if(g=="rayleigh"){
den=function(par,x){a=par[3]; loc=par[4]; 2*(x-loc)/a*exp(-((x-loc)/a)^2)}
cum=function(par,x){a=par[3]; loc=par[4]; 1-exp(-((x-loc)/a)^2)}
if (location==FALSE){
den=function(par,x){a=par[3]; 2*x/a*exp(-(x/a)^2)}
cum=function(par,x){a=par[3]; 1-exp(-(x/a)^2)}
}}
if(g=="burrxii"){
den=function(par,x){a=par[3]; d=par[4]; loc=par[5]; d*a*(1+(x-loc)^d)^(-a-1)*((x-loc)^(d-1))}
cum=function(par,x){a=par[3]; d=par[4]; loc=par[5]; 1-(1+(x-loc)^d)^(-a)}
if (location==FALSE){
den=function(par,x){a=par[3]; d=par[4]; d*a*(1+(x)^d)^(-a-1)*((x)^(d-1))}
cum=function(par,x){a=par[3]; d=par[4]; 1-(1+(x)^d)^(-a)}
}}
if(g=="frechet"){
den=function(par,x){a=par[3]; b=par[4]; loc=par[5]; (a*exp(-((x-loc)/b)^(-a))*((x-loc)/b)^(-a-1))/(b)}
cum=function(par,x){a=par[3]; b=par[4]; loc=par[5]; exp(-((x-loc)/b)^(-a))}
if (location==FALSE){
den=function(par,x){a=par[3]; b=par[4]; (a*exp(-((x)/b)^(-a))*((x)/b)^(-a-1))/(b)}
cum=function(par,x){a=par[3]; b=par[4]; exp(-((x)/b)^(-a))}
}}
if(g=="birnbaum-saunders"){
den=function(par,x){a=par[3]; b=par[4]; loc=par[5]; (sqrt((x-loc)/b)+sqrt(b/(x-loc)))/(2*a*(x-loc))*dnorm((sqrt((x-loc)/b)-sqrt(b/(x-loc)))/a)}
cum=function(par,x){a=par[3]; b=par[4]; loc=par[5]; pnorm((sqrt((x-loc)/b)-sqrt(b/(x-loc)))/a)}
if (location==FALSE){
den=function(par,x){a=par[3]; b=par[4]; (sqrt((x)/b)+sqrt(b/(x)))/(2*a*(x))*dnorm((sqrt((x)/b)-sqrt(b/(x)))/a)}
cum=function(par,x){a=par[3]; b=par[4]; pnorm((sqrt((x)/b)-sqrt(b/(x)))/a)}
}}
if(g=="weibull"){
den=function(par,x){shape=par[3]; scale=par[4]; loc=par[5]; dweibull(x-loc,shape,scale)}
cum=function(par,x){shape=par[3]; scale=par[4]; loc=par[5]; pweibull(x-loc,shape,scale)}
if (location==FALSE){
den=function(par,x){shape=par[3]; scale=par[4]; dweibull(x,shape,scale)}
cum=function(par,x){shape=par[3]; scale=par[4]; pweibull(x,shape,scale)}
}}
if(g=="gamma"){
den=function(par,x){shape=par[3]; scale=par[4]; loc=par[5]; dgamma(x-loc,shape,scale)}
cum=function(par,x){shape=par[3]; scale=par[4]; loc=par[5]; pgamma(x-loc,shape,scale)}
if (location==FALSE){
den=function(par,x){shape=par[3]; scale=par[4]; dgamma(x,shape,scale)}
cum=function(par,x){shape=par[3]; scale=par[4]; pgamma(x,shape,scale)}
}}
pdf0<-function(par,x){
f0=den(par,x)
c0=cum(par,x)
a=par[1]
b=par[2]
a*b**(-a)*(f0/(1-c0))*(-log(1-c0))**(a-1)*exp(-b**(-a)*(-log(1-c0))**a)
}
pdf<-pdf0(param,mydata)
if(log==TRUE){pdf<-log(pdf)}
return(pdf)
}
pmbetag<-function(mydata, g, param, location=TRUE, log.p = FALSE, lower.tail = TRUE){
if(g!="birnbaum-saunders" & g!="exp" & g!="rayleigh" & g!="weibull" & g!="gompertz" & g!="gamma"
& g!="log-normal" & g!="chisq" & g!="f" & g!="burrxii" & g!="frechet"
& g!="lomax" & g!="log-logistic" & g!="lfr" & g!="chen")
{ stop ("Baseline distribution not implemented or misspelled. Please check the manual for guidelines.") }
if(g=="log-normal"){
den=function(par,x){meanlog=par[4]; sdlog=par[5]; loc=par[6]; dlnorm(x-loc,meanlog,sdlog)}
cum=function(par,x){meanlog=par[4]; sdlog=par[5]; loc=par[6]; plnorm(x-loc,meanlog,sdlog)}
if (location==FALSE){
den=function(par,x){meanlog=par[4]; sdlog=par[5]; dlnorm(x,meanlog,sdlog)}
cum=function(par,x){meanlog=par[4]; sdlog=par[5]; plnorm(x,meanlog,sdlog)}
}}
if(g=="chisq"){
den=function(par,x){df=par[4]; loc=par[5]; dchisq(x-loc,df)}
cum=function(par,x){df=par[4]; loc=par[5]; pchisq(x-loc,df)}
if (location==FALSE){
den=function(par,x){df=par[4]; dchisq(x,df)}
cum=function(par,x){df=par[4]; pchisq(x,df)}
}}
if(g=="f"){
den=function(par,x){df1=par[4]; df2=par[5]; loc=par[6]; df(x-loc,df1,df2)}
cum=function(par,x){df1=par[4]; df2=par[5]; loc=par[6]; pf(x-loc,df1,df2)}
if (location==FALSE){
den=function(par,x){df1=par[4]; df2=par[5]; df(x,df1,df2)}
cum=function(par,x){df1=par[4]; df2=par[5]; pf(x,df1,df2)}
}}
if(g=="chen"){
den=function(par,x){a=par[4]; b=par[5]; loc=par[6]; a*b*(x-loc)^(a-1)*exp((x-loc)^a)*exp(-b*(exp((x-loc)^a)-1))}
cum=function(par,x){a=par[4]; b=par[5]; loc=par[6]; 1-exp(-b*(exp((x-loc)^a)-1))}
if (location==FALSE){
den=function(par,x){a=par[4]; b=par[5]; a*b*(x)^(a-1)*exp((x)^a)*exp(-b*(exp((x)^a)-1))}
cum=function(par,x){a=par[4]; b=par[5]; 1-exp(-b*(exp((x)^a)-1))}
}}
if(g=="lfr"){
den=function(par,x){a=par[4]; b=par[5]; loc=par[6]; (a+b*(x-loc))*exp(-a*(x-loc)-(b*(x-loc)^2)/2)}
cum=function(par,x){a=par[4]; b=par[5]; loc=par[6]; 1-exp(-a*(x-loc)-(b*(x-loc)^2)/2)}
if (location==FALSE){
den=function(par,x){a=par[4]; b=par[5]; (a+b*(x))*exp(-a*(x)-(b*(x)^2)/2)}
cum=function(par,x){a=par[4]; b=par[5]; 1-exp(-a*(x)-(b*(x)^2)/2)}
}}
if(g=="log-logistic"){
den=function(par,x){a=par[4]; b=par[5]; loc=par[6]; (a*b^(-a)*(x-loc)^(a-1))/((((x-loc)/b)^a +1)^2)}
cum=function(par,x){a=par[4]; b=par[5]; loc=par[6]; 1/(((x-loc)/b)^(-a)+1)}
if (location==FALSE){
den=function(par,x){a=par[4]; b=par[5]; (a*b^(-a)*(x)^(a-1))/((((x)/b)^a +1)^2)}
cum=function(par,x){a=par[4]; b=par[5]; 1/(((x)/b)^(-a)+1)}
}}
if(g=="lomax"){
den=function(par,x){a=par[4]; b=par[5]; loc=par[6]; (a*b)/((1+a*(x-loc))^(b+1))}
cum=function(par,x){a=par[4]; b=par[5]; loc=par[6]; 1-(1+a*(x-loc))^(-b)}
if (location==FALSE){
den=function(par,x){a=par[4]; b=par[5]; (a*b)/((1+a*(x))^(b+1))}
cum=function(par,x){a=par[4]; b=par[5]; 1-(1+a*(x))^(-b)}
}}
if(g=="gompertz"){
den=function(par,x){a=par[4]; b=par[5]; loc=par[6]; b*exp(a*(x-loc))*exp(-(exp(a*(x-loc))-1)*b/a)}
cum=function(par,x){a=par[4]; b=par[5]; loc=par[6]; 1-exp(-(exp(a*(x-loc))-1)*b/a)}
if (location==FALSE){
den=function(par,x){a=par[4]; b=par[5]; b*exp(a*(x))*exp(-(exp(a*(x))-1)*b/a)}
cum=function(par,x){a=par[4]; b=par[5]; 1-exp(-(exp(a*(x))-1)*b/a)}
}}
if(g=="exp"){
den=function(par,x){rate=par[4]; loc=par[5]; dexp(x-loc,rate)}
cum=function(par,x){rate=par[4]; loc=par[5]; pexp(x-loc,rate)}
if (location==FALSE){
den=function(par,x){rate=par[4]; dexp(x,rate)}
cum=function(par,x){rate=par[4]; pexp(x,rate)}
}}
if(g=="rayleigh"){
den=function(par,x){a=par[4]; loc=par[5]; 2*(x-loc)/a*exp(-((x-loc)/a)^2)}
cum=function(par,x){a=par[4]; loc=par[5]; 1-exp(-((x-loc)/a)^2)}
if (location==FALSE){
den=function(par,x){a=par[4]; 2*x/a*exp(-(x/a)^2)}
cum=function(par,x){a=par[4]; 1-exp(-(x/a)^2)}
}}
if(g=="burrxii"){
den=function(par,x){a=par[4]; d=par[5]; loc=par[6]; d*a*(1+(x-loc)^d)^(-a-1)*((x-loc)^(d-1))}
cum=function(par,x){a=par[4]; d=par[5]; loc=par[6]; 1-(1+(x-loc)^d)^(-a)}
if (location==FALSE){
den=function(par,x){a=par[4]; d=par[5]; d*a*(1+(x)^d)^(-a-1)*((x)^(d-1))}
cum=function(par,x){a=par[4]; d=par[5]; 1-(1+(x)^d)^(-a)}
}}
if(g=="frechet"){
den=function(par,x){a=par[4]; b=par[5]; loc=par[6]; (a*exp(-((x-loc)/b)^(-a))*((x-loc)/b)^(-a-1))/(b)}
cum=function(par,x){a=par[4]; b=par[5]; loc=par[6]; exp(-((x-loc)/b)^(-a))}
if (location==FALSE){
den=function(par,x){a=par[4]; b=par[5]; (a*exp(-((x)/b)^(-a))*((x)/b)^(-a-1))/(b)}
cum=function(par,x){a=par[4]; b=par[5]; exp(-((x)/b)^(-a))}
}}
if(g=="birnbaum-saunders"){
den=function(par,x){a=par[4]; b=par[5]; loc=par[6]; (sqrt((x-loc)/b)+sqrt(b/(x-loc)))/(2*a*(x-loc))*dnorm((sqrt((x-loc)/b)-sqrt(b/(x-loc)))/a)}
cum=function(par,x){a=par[4]; b=par[5]; loc=par[6]; pnorm((sqrt((x-loc)/b)-sqrt(b/(x-loc)))/a)}
if (location==FALSE){
den=function(par,x){a=par[4]; b=par[5]; (sqrt((x)/b)+sqrt(b/(x)))/(2*a*(x))*dnorm((sqrt((x)/b)-sqrt(b/(x)))/a)}
cum=function(par,x){a=par[4]; b=par[5]; pnorm((sqrt((x)/b)-sqrt(b/(x)))/a)}
}}
if(g=="weibull"){
den=function(par,x){shape=par[4]; scale=par[5]; loc=par[6]; dweibull(x-loc,shape,scale)}
cum=function(par,x){shape=par[4]; scale=par[5]; loc=par[6]; pweibull(x-loc,shape,scale)}
if (location==FALSE){
den=function(par,x){shape=par[4]; scale=par[5]; dweibull(x,shape,scale)}
cum=function(par,x){shape=par[4]; scale=par[5]; pweibull(x,shape,scale)}
}}
if(g=="gamma"){
den=function(par,x){shape=par[4]; scale=par[5]; loc=par[6]; dgamma(x-loc,shape,scale)}
cum=function(par,x){shape=par[4]; scale=par[5]; loc=par[6]; pgamma(x-loc,shape,scale)}
if (location==FALSE){
den=function(par,x){shape=par[4]; scale=par[5]; dgamma(x,shape,scale)}
cum=function(par,x){shape=par[4]; scale=par[5]; pgamma(x,shape,scale)}
}}
cdf0<-function(par,x){
f0=den(par,x)
c0=cum(par,x)
a=par[1]
b=par[2]
d=par[3]
pbeta(d*c0/(1-(1-d)*c0),shape1=a,shape2=b)
}
cdf<-cdf0(param,mydata)
if(log.p==TRUE & lower.tail == FALSE) cdf<-log(1-cdf)
if(log.p==TRUE & lower.tail == TRUE) cdf<-log(cdf)
if(log.p==FALSE & lower.tail == FALSE) cdf<-1-cdf
return(cdf)
}
dmbetag<-function(mydata, g, param, location=TRUE, log=FALSE){
if(g!="birnbaum-saunders" & g!="exp" & g!="rayleigh" & g!="weibull" & g!="gompertz" & g!="gamma"
& g!="log-normal" & g!="chisq" & g!="f" & g!="burrxii" & g!="frechet"
& g!="lomax" & g!="log-logistic" & g!="lfr" & g!="chen")
{ stop ("Baseline distribution not implemented or misspelled. Please check the manual for guidelines.") }
if(g=="log-normal"){
den=function(par,x){meanlog=par[4]; sdlog=par[5]; loc=par[6]; dlnorm(x-loc,meanlog,sdlog)}
cum=function(par,x){meanlog=par[4]; sdlog=par[5]; loc=par[6]; plnorm(x-loc,meanlog,sdlog)}
if (location==FALSE){
den=function(par,x){meanlog=par[4]; sdlog=par[5]; dlnorm(x,meanlog,sdlog)}
cum=function(par,x){meanlog=par[4]; sdlog=par[5]; plnorm(x,meanlog,sdlog)}
}}
if(g=="chisq"){
den=function(par,x){df=par[4]; loc=par[5]; dchisq(x-loc,df)}
cum=function(par,x){df=par[4]; loc=par[5]; pchisq(x-loc,df)}
if (location==FALSE){
den=function(par,x){df=par[4]; dchisq(x,df)}
cum=function(par,x){df=par[4]; pchisq(x,df)}
}}
if(g=="f"){
den=function(par,x){df1=par[4]; df2=par[5]; loc=par[6]; df(x-loc,df1,df2)}
cum=function(par,x){df1=par[4]; df2=par[5]; loc=par[6]; pf(x-loc,df1,df2)}
if (location==FALSE){
den=function(par,x){df1=par[4]; df2=par[5]; df(x,df1,df2)}
cum=function(par,x){df1=par[4]; df2=par[5]; pf(x,df1,df2)}
}}
if(g=="chen"){
den=function(par,x){a=par[4]; b=par[5]; loc=par[6]; a*b*(x-loc)^(a-1)*exp((x-loc)^a)*exp(-b*(exp((x-loc)^a)-1))}
cum=function(par,x){a=par[4]; b=par[5]; loc=par[6]; 1-exp(-b*(exp((x-loc)^a)-1))}
if (location==FALSE){
den=function(par,x){a=par[4]; b=par[5]; a*b*(x)^(a-1)*exp((x)^a)*exp(-b*(exp((x)^a)-1))}
cum=function(par,x){a=par[4]; b=par[5]; 1-exp(-b*(exp((x)^a)-1))}
}}
if(g=="lfr"){
den=function(par,x){a=par[4]; b=par[5]; loc=par[6]; (a+b*(x-loc))*exp(-a*(x-loc)-(b*(x-loc)^2)/2)}
cum=function(par,x){a=par[4]; b=par[5]; loc=par[6]; 1-exp(-a*(x-loc)-(b*(x-loc)^2)/2)}
if (location==FALSE){
den=function(par,x){a=par[4]; b=par[5]; (a+b*(x))*exp(-a*(x)-(b*(x)^2)/2)}
cum=function(par,x){a=par[4]; b=par[5]; 1-exp(-a*(x)-(b*(x)^2)/2)}
}}
if(g=="log-logistic"){
den=function(par,x){a=par[4]; b=par[5]; loc=par[6]; (a*b^(-a)*(x-loc)^(a-1))/((((x-loc)/b)^a +1)^2)}
cum=function(par,x){a=par[4]; b=par[5]; loc=par[6]; 1/(((x-loc)/b)^(-a)+1)}
if (location==FALSE){
den=function(par,x){a=par[4]; b=par[5]; (a*b^(-a)*(x)^(a-1))/((((x)/b)^a +1)^2)}
cum=function(par,x){a=par[4]; b=par[5]; 1/(((x)/b)^(-a)+1)}
}}
if(g=="lomax"){
den=function(par,x){a=par[4]; b=par[5]; loc=par[6]; (a*b)/((1+a*(x-loc))^(b+1))}
cum=function(par,x){a=par[4]; b=par[5]; loc=par[6]; 1-(1+a*(x-loc))^(-b)}
if (location==FALSE){
den=function(par,x){a=par[4]; b=par[5]; (a*b)/((1+a*(x))^(b+1))}
cum=function(par,x){a=par[4]; b=par[5]; 1-(1+a*(x))^(-b)}
}}
if(g=="gompertz"){
den=function(par,x){a=par[4]; b=par[5]; loc=par[6]; b*exp(a*(x-loc))*exp(-(exp(a*(x-loc))-1)*b/a)}
cum=function(par,x){a=par[4]; b=par[5]; loc=par[6]; 1-exp(-(exp(a*(x-loc))-1)*b/a)}
if (location==FALSE){
den=function(par,x){a=par[4]; b=par[5]; b*exp(a*(x))*exp(-(exp(a*(x))-1)*b/a)}
cum=function(par,x){a=par[4]; b=par[5]; 1-exp(-(exp(a*(x))-1)*b/a)}
}}
if(g=="exp"){
den=function(par,x){rate=par[4]; loc=par[5]; dexp(x-loc,rate)}
cum=function(par,x){rate=par[4]; loc=par[5]; pexp(x-loc,rate)}
if (location==FALSE){
den=function(par,x){rate=par[4]; dexp(x,rate)}
cum=function(par,x){rate=par[4]; pexp(x,rate)}
}}
if(g=="rayleigh"){
den=function(par,x){a=par[4]; loc=par[5]; 2*(x-loc)/a*exp(-((x-loc)/a)^2)}
cum=function(par,x){a=par[4]; loc=par[5]; 1-exp(-((x-loc)/a)^2)}
if (location==FALSE){
den=function(par,x){a=par[4]; 2*x/a*exp(-(x/a)^2)}
cum=function(par,x){a=par[4]; 1-exp(-(x/a)^2)}
}}
if(g=="burrxii"){
den=function(par,x){a=par[4]; d=par[5]; loc=par[6]; d*a*(1+(x-loc)^d)^(-a-1)*((x-loc)^(d-1))}
cum=function(par,x){a=par[4]; d=par[5]; loc=par[6]; 1-(1+(x-loc)^d)^(-a)}
if (location==FALSE){
den=function(par,x){a=par[4]; d=par[5]; d*a*(1+(x)^d)^(-a-1)*((x)^(d-1))}
cum=function(par,x){a=par[4]; d=par[5]; 1-(1+(x)^d)^(-a)}
}}
if(g=="frechet"){
den=function(par,x){a=par[4]; b=par[5]; loc=par[6]; (a*exp(-((x-loc)/b)^(-a))*((x-loc)/b)^(-a-1))/(b)}
cum=function(par,x){a=par[4]; b=par[5]; loc=par[6]; exp(-((x-loc)/b)^(-a))}
if (location==FALSE){
den=function(par,x){a=par[4]; b=par[5]; (a*exp(-((x)/b)^(-a))*((x)/b)^(-a-1))/(b)}
cum=function(par,x){a=par[4]; b=par[5]; exp(-((x)/b)^(-a))}
}}
if(g=="birnbaum-saunders"){
den=function(par,x){a=par[4]; b=par[5]; loc=par[6]; (sqrt((x-loc)/b)+sqrt(b/(x-loc)))/(2*a*(x-loc))*dnorm((sqrt((x-loc)/b)-sqrt(b/(x-loc)))/a)}
cum=function(par,x){a=par[4]; b=par[5]; loc=par[6]; pnorm((sqrt((x-loc)/b)-sqrt(b/(x-loc)))/a)}
if (location==FALSE){
den=function(par,x){a=par[4]; b=par[5]; (sqrt((x)/b)+sqrt(b/(x)))/(2*a*(x))*dnorm((sqrt((x)/b)-sqrt(b/(x)))/a)}
cum=function(par,x){a=par[4]; b=par[5]; pnorm((sqrt((x)/b)-sqrt(b/(x)))/a)}
}}
if(g=="weibull"){
den=function(par,x){shape=par[4]; scale=par[5]; loc=par[6]; dweibull(x-loc,shape,scale)}
cum=function(par,x){shape=par[4]; scale=par[5]; loc=par[6]; pweibull(x-loc,shape,scale)}
if (location==FALSE){
den=function(par,x){shape=par[4]; scale=par[5]; dweibull(x,shape,scale)}
cum=function(par,x){shape=par[4]; scale=par[5]; pweibull(x,shape,scale)}
}}
if(g=="gamma"){
den=function(par,x){shape=par[4]; scale=par[5]; loc=par[6]; dgamma(x-loc,shape,scale)}
cum=function(par,x){shape=par[4]; scale=par[5]; loc=par[6]; pgamma(x-loc,shape,scale)}
if (location==FALSE){
den=function(par,x){shape=par[4]; scale=par[5]; dgamma(x,shape,scale)}
cum=function(par,x){shape=par[4]; scale=par[5]; pgamma(x,shape,scale)}
}}
pdf0<-function(par,x){
f0=den(par,x)
c0=cum(par,x)
a=par[1]
b=par[2]
d=par[3]
d^a*f0*beta(a,b)^(-1)*c0^(a-1)*(1-c0)^(b-1)*(1-(1-d)*c0)^(-a-b)
}
pdf<-pdf0(param,mydata)
if(log==TRUE){pdf<-log(pdf)}
return(pdf)
}
pmog<-function(mydata, g, param, location=TRUE, log.p = FALSE, lower.tail = TRUE){
if(g!="birnbaum-saunders" & g!="exp" & g!="rayleigh" & g!="weibull" & g!="gompertz" & g!="gamma"
& g!="log-normal" & g!="chisq" & g!="f" & g!="burrxii" & g!="frechet"
& g!="lomax" & g!="log-logistic" & g!="lfr" & g!="chen")
{ stop ("Baseline distribution not implemented or misspelled. Please check the manual for guidelines.") }
if(g=="log-normal"){
den=function(par,x){meanlog=par[2]; sdlog=par[3]; loc=par[4]; dlnorm(x-loc,meanlog,sdlog)}
cum=function(par,x){meanlog=par[2]; sdlog=par[3]; loc=par[4]; plnorm(x-loc,meanlog,sdlog)}
if (location==FALSE){
den=function(par,x){meanlog=par[2]; sdlog=par[3]; dlnorm(x,meanlog,sdlog)}
cum=function(par,x){meanlog=par[2]; sdlog=par[3]; plnorm(x,meanlog,sdlog)}
}}
if(g=="chisq"){
den=function(par,x){df=par[2]; loc=par[3]; dchisq(x-loc,df)}
cum=function(par,x){df=par[2]; loc=par[3]; pchisq(x-loc,df)}
if (location==FALSE){
den=function(par,x){df=par[2]; dchisq(x,df)}
cum=function(par,x){df=par[2]; pchisq(x,df)}
}}
if(g=="f"){
den=function(par,x){df1=par[2]; df2=par[3]; loc=par[4]; df(x-loc,df1,df2)}
cum=function(par,x){df1=par[2]; df2=par[3]; loc=par[4]; pf(x-loc,df1,df2)}
if (location==FALSE){
den=function(par,x){df1=par[2]; df2=par[3]; df(x,df1,df2)}
cum=function(par,x){df1=par[2]; df2=par[3]; pf(x,df1,df2)}
}}
if(g=="chen"){
den=function(par,x){a=par[2]; b=par[3]; loc=par[4]; a*b*(x-loc)^(a-1)*exp((x-loc)^a)*exp(-b*(exp((x-loc)^a)-1))}
cum=function(par,x){a=par[2]; b=par[3]; loc=par[4]; 1-exp(-b*(exp((x-loc)^a)-1))}
if (location==FALSE){
den=function(par,x){a=par[2]; b=par[3]; a*b*(x)^(a-1)*exp((x)^a)*exp(-b*(exp((x)^a)-1))}
cum=function(par,x){a=par[2]; b=par[3]; 1-exp(-b*(exp((x)^a)-1))}
}}
if(g=="lfr"){
den=function(par,x){a=par[2]; b=par[3]; loc=par[4]; (a+b*(x-loc))*exp(-a*(x-loc)-(b*(x-loc)^2)/2)}
cum=function(par,x){a=par[2]; b=par[3]; loc=par[4]; 1-exp(-a*(x-loc)-(b*(x-loc)^2)/2)}
if (location==FALSE){
den=function(par,x){a=par[2]; b=par[3]; (a+b*(x))*exp(-a*(x)-(b*(x)^2)/2)}
cum=function(par,x){a=par[2]; b=par[3]; 1-exp(-a*(x)-(b*(x)^2)/2)}
}}
if(g=="log-logistic"){
den=function(par,x){a=par[2]; b=par[3]; loc=par[4]; (a*b^(-a)*(x-loc)^(a-1))/((((x-loc)/b)^a +1)^2)}
cum=function(par,x){a=par[2]; b=par[3]; loc=par[4]; 1/(((x-loc)/b)^(-a)+1)}
if (location==FALSE){
den=function(par,x){a=par[2]; b=par[3]; (a*b^(-a)*(x)^(a-1))/((((x)/b)^a +1)^2)}
cum=function(par,x){a=par[2]; b=par[3]; 1/(((x)/b)^(-a)+1)}
}}
if(g=="lomax"){
den=function(par,x){a=par[2]; b=par[3]; loc=par[4]; (a*b)/((1+a*(x-loc))^(b+1))}
cum=function(par,x){a=par[2]; b=par[3]; loc=par[4]; 1-(1+a*(x-loc))^(-b)}
if (location==FALSE){
den=function(par,x){a=par[2]; b=par[3]; (a*b)/((1+a*(x))^(b+1))}
cum=function(par,x){a=par[2]; b=par[3]; 1-(1+a*(x))^(-b)}
}}
if(g=="gompertz"){
den=function(par,x){a=par[2]; b=par[3]; loc=par[4]; b*exp(a*(x-loc))*exp(-(exp(a*(x-loc))-1)*b/a)}
cum=function(par,x){a=par[2]; b=par[3]; loc=par[4]; 1-exp(-(exp(a*(x-loc))-1)*b/a)}
if (location==FALSE){
den=function(par,x){a=par[2]; b=par[3]; b*exp(a*(x))*exp(-(exp(a*(x))-1)*b/a)}
cum=function(par,x){a=par[2]; b=par[3]; 1-exp(-(exp(a*(x))-1)*b/a)}
}}
if(g=="exp"){
den=function(par,x){rate=par[2]; loc=par[3]; dexp(x-loc,rate)}
cum=function(par,x){rate=par[2]; loc=par[3]; pexp(x-loc,rate)}
if (location==FALSE){
den=function(par,x){rate=par[2]; dexp(x,rate)}
cum=function(par,x){rate=par[2]; pexp(x,rate)}
}}
if(g=="rayleigh"){
den=function(par,x){a=par[2]; loc=par[3]; 2*(x-loc)/a*exp(-((x-loc)/a)^2)}
cum=function(par,x){a=par[2]; loc=par[3]; 1-exp(-((x-loc)/a)^2)}
if (location==FALSE){
den=function(par,x){a=par[2]; 2*x/a*exp(-(x/a)^2)}
cum=function(par,x){a=par[2]; 1-exp(-(x/a)^2)}
}}
if(g=="burrxii"){
den=function(par,x){a=par[2]; d=par[3]; loc=par[4]; d*a*(1+(x-loc)^d)^(-a-1)*((x-loc)^(d-1))}
cum=function(par,x){a=par[2]; d=par[3]; loc=par[4]; 1-(1+(x-loc)^d)^(-a)}
if (location==FALSE){
den=function(par,x){a=par[2]; d=par[3]; d*a*(1+(x)^d)^(-a-1)*((x)^(d-1))}
cum=function(par,x){a=par[2]; d=par[3]; 1-(1+(x)^d)^(-a)}
}}
if(g=="frechet"){
den=function(par,x){a=par[2]; b=par[3]; loc=par[4]; (a*exp(-((x-loc)/b)^(-a))*((x-loc)/b)^(-a-1))/(b)}
cum=function(par,x){a=par[2]; b=par[3]; loc=par[4]; exp(-((x-loc)/b)^(-a))}
if (location==FALSE){
den=function(par,x){a=par[2]; b=par[3]; (a*exp(-((x)/b)^(-a))*((x)/b)^(-a-1))/(b)}
cum=function(par,x){a=par[2]; b=par[3]; exp(-((x)/b)^(-a))}
}}
if(g=="birnbaum-saunders"){
den=function(par,x){a=par[2]; b=par[3]; loc=par[4]; (sqrt((x-loc)/b)+sqrt(b/(x-loc)))/(2*a*(x-loc))*dnorm((sqrt((x-loc)/b)-sqrt(b/(x-loc)))/a)}
cum=function(par,x){a=par[2]; b=par[3]; loc=par[4]; pnorm((sqrt((x-loc)/b)-sqrt(b/(x-loc)))/a)}
if (location==FALSE){
den=function(par,x){a=par[2]; b=par[3]; (sqrt((x)/b)+sqrt(b/(x)))/(2*a*(x))*dnorm((sqrt((x)/b)-sqrt(b/(x)))/a)}
cum=function(par,x){a=par[2]; b=par[3]; pnorm((sqrt((x)/b)-sqrt(b/(x)))/a)}
}}
if(g=="weibull"){
den=function(par,x){shape=par[2]; scale=par[3]; loc=par[4]; dweibull(x-loc,shape,scale)}
cum=function(par,x){shape=par[2]; scale=par[3]; loc=par[4]; pweibull(x-loc,shape,scale)}
if (location==FALSE){
den=function(par,x){shape=par[2]; scale=par[3]; dweibull(x,shape,scale)}
cum=function(par,x){shape=par[2]; scale=par[3]; pweibull(x,shape,scale)}
}}
if(g=="gamma"){
den=function(par,x){shape=par[2]; scale=par[3]; loc=par[4]; dgamma(x-loc,shape,scale)}
cum=function(par,x){shape=par[2]; scale=par[3]; loc=par[4]; pgamma(x-loc,shape,scale)}
if (location==FALSE){
den=function(par,x){shape=par[2]; scale=par[3]; dgamma(x,shape,scale)}
cum=function(par,x){shape=par[2]; scale=par[3]; pgamma(x,shape,scale)}
}}
cdf0<-function(par,x){
f0=den(par,x)
c0=cum(par,x)
r=par[1]
1-r*(1-c0)/(1-(1-r)*(1-c0))
}
cdf<-cdf0(param,mydata)
if(log.p==TRUE & lower.tail == FALSE) cdf<-log(1-cdf)
if(log.p==TRUE & lower.tail == TRUE) cdf<-log(cdf)
if(log.p==FALSE & lower.tail == FALSE) cdf<-1-cdf
return(cdf)
}
dmog<-function(mydata, g, param, location=TRUE, log=FALSE){
if(g!="birnbaum-saunders" & g!="exp" & g!="rayleigh" & g!="weibull" & g!="gompertz" & g!="gamma"
& g!="log-normal" & g!="chisq" & g!="f" & g!="burrxii" & g!="frechet"
& g!="lomax" & g!="log-logistic" & g!="lfr" & g!="chen")
{ stop ("Baseline distribution not implemented or misspelled. Please check the manual for guidelines.") }
if(g=="log-normal"){
den=function(par,x){meanlog=par[2]; sdlog=par[3]; loc=par[4]; dlnorm(x-loc,meanlog,sdlog)}
cum=function(par,x){meanlog=par[2]; sdlog=par[3]; loc=par[4]; plnorm(x-loc,meanlog,sdlog)}
if (location==FALSE){
den=function(par,x){meanlog=par[2]; sdlog=par[3]; dlnorm(x,meanlog,sdlog)}
cum=function(par,x){meanlog=par[2]; sdlog=par[3]; plnorm(x,meanlog,sdlog)}
}}
if(g=="chisq"){
den=function(par,x){df=par[2]; loc=par[3]; dchisq(x-loc,df)}
cum=function(par,x){df=par[2]; loc=par[3]; pchisq(x-loc,df)}
if (location==FALSE){
den=function(par,x){df=par[2]; dchisq(x,df)}
cum=function(par,x){df=par[2]; pchisq(x,df)}
}}
if(g=="f"){
den=function(par,x){df1=par[2]; df2=par[3]; loc=par[4]; df(x-loc,df1,df2)}
cum=function(par,x){df1=par[2]; df2=par[3]; loc=par[4]; pf(x-loc,df1,df2)}
if (location==FALSE){
den=function(par,x){df1=par[2]; df2=par[3]; df(x,df1,df2)}
cum=function(par,x){df1=par[2]; df2=par[3]; pf(x,df1,df2)}
}}
if(g=="chen"){
den=function(par,x){a=par[2]; b=par[3]; loc=par[4]; a*b*(x-loc)^(a-1)*exp((x-loc)^a)*exp(-b*(exp((x-loc)^a)-1))}
cum=function(par,x){a=par[2]; b=par[3]; loc=par[4]; 1-exp(-b*(exp((x-loc)^a)-1))}
if (location==FALSE){
den=function(par,x){a=par[2]; b=par[3]; a*b*(x)^(a-1)*exp((x)^a)*exp(-b*(exp((x)^a)-1))}
cum=function(par,x){a=par[2]; b=par[3]; 1-exp(-b*(exp((x)^a)-1))}
}}
if(g=="lfr"){
den=function(par,x){a=par[2]; b=par[3]; loc=par[4]; (a+b*(x-loc))*exp(-a*(x-loc)-(b*(x-loc)^2)/2)}
cum=function(par,x){a=par[2]; b=par[3]; loc=par[4]; 1-exp(-a*(x-loc)-(b*(x-loc)^2)/2)}
if (location==FALSE){
den=function(par,x){a=par[2]; b=par[3]; (a+b*(x))*exp(-a*(x)-(b*(x)^2)/2)}
cum=function(par,x){a=par[2]; b=par[3]; 1-exp(-a*(x)-(b*(x)^2)/2)}
}}
if(g=="log-logistic"){
den=function(par,x){a=par[2]; b=par[3]; loc=par[4]; (a*b^(-a)*(x-loc)^(a-1))/((((x-loc)/b)^a +1)^2)}
cum=function(par,x){a=par[2]; b=par[3]; loc=par[4]; 1/(((x-loc)/b)^(-a)+1)}
if (location==FALSE){
den=function(par,x){a=par[2]; b=par[3]; (a*b^(-a)*(x)^(a-1))/((((x)/b)^a +1)^2)}
cum=function(par,x){a=par[2]; b=par[3]; 1/(((x)/b)^(-a)+1)}
}}
if(g=="lomax"){
den=function(par,x){a=par[2]; b=par[3]; loc=par[4]; (a*b)/((1+a*(x-loc))^(b+1))}
cum=function(par,x){a=par[2]; b=par[3]; loc=par[4]; 1-(1+a*(x-loc))^(-b)}
if (location==FALSE){
den=function(par,x){a=par[2]; b=par[3]; (a*b)/((1+a*(x))^(b+1))}
cum=function(par,x){a=par[2]; b=par[3]; 1-(1+a*(x))^(-b)}
}}
if(g=="gompertz"){
den=function(par,x){a=par[2]; b=par[3]; loc=par[4]; b*exp(a*(x-loc))*exp(-(exp(a*(x-loc))-1)*b/a)}
cum=function(par,x){a=par[2]; b=par[3]; loc=par[4]; 1-exp(-(exp(a*(x-loc))-1)*b/a)}
if (location==FALSE){
den=function(par,x){a=par[2]; b=par[3]; b*exp(a*(x))*exp(-(exp(a*(x))-1)*b/a)}
cum=function(par,x){a=par[2]; b=par[3]; 1-exp(-(exp(a*(x))-1)*b/a)}
}}
if(g=="exp"){
den=function(par,x){rate=par[2]; loc=par[3]; dexp(x-loc,rate)}
cum=function(par,x){rate=par[2]; loc=par[3]; pexp(x-loc,rate)}
if (location==FALSE){
den=function(par,x){rate=par[2]; dexp(x,rate)}
cum=function(par,x){rate=par[2]; pexp(x,rate)}
}}
if(g=="rayleigh"){
den=function(par,x){a=par[2]; loc=par[3]; 2*(x-loc)/a*exp(-((x-loc)/a)^2)}
cum=function(par,x){a=par[2]; loc=par[3]; 1-exp(-((x-loc)/a)^2)}
if (location==FALSE){
den=function(par,x){a=par[2]; 2*x/a*exp(-(x/a)^2)}
cum=function(par,x){a=par[2]; 1-exp(-(x/a)^2)}
}}
if(g=="burrxii"){
den=function(par,x){a=par[2]; d=par[3]; loc=par[4]; d*a*(1+(x-loc)^d)^(-a-1)*((x-loc)^(d-1))}
cum=function(par,x){a=par[2]; d=par[3]; loc=par[4]; 1-(1+(x-loc)^d)^(-a)}
if (location==FALSE){
den=function(par,x){a=par[2]; d=par[3]; d*a*(1+(x)^d)^(-a-1)*((x)^(d-1))}
cum=function(par,x){a=par[2]; d=par[3]; 1-(1+(x)^d)^(-a)}
}}
if(g=="frechet"){
den=function(par,x){a=par[2]; b=par[3]; loc=par[4]; (a*exp(-((x-loc)/b)^(-a))*((x-loc)/b)^(-a-1))/(b)}
cum=function(par,x){a=par[2]; b=par[3]; loc=par[4]; exp(-((x-loc)/b)^(-a))}
if (location==FALSE){
den=function(par,x){a=par[2]; b=par[3]; (a*exp(-((x)/b)^(-a))*((x)/b)^(-a-1))/(b)}
cum=function(par,x){a=par[2]; b=par[3]; exp(-((x)/b)^(-a))}
}}
if(g=="birnbaum-saunders"){
den=function(par,x){a=par[2]; b=par[3]; loc=par[4]; (sqrt((x-loc)/b)+sqrt(b/(x-loc)))/(2*a*(x-loc))*dnorm((sqrt((x-loc)/b)-sqrt(b/(x-loc)))/a)}
cum=function(par,x){a=par[2]; b=par[3]; loc=par[4]; pnorm((sqrt((x-loc)/b)-sqrt(b/(x-loc)))/a)}
if (location==FALSE){
den=function(par,x){a=par[2]; b=par[3]; (sqrt((x)/b)+sqrt(b/(x)))/(2*a*(x))*dnorm((sqrt((x)/b)-sqrt(b/(x)))/a)}
cum=function(par,x){a=par[2]; b=par[3]; pnorm((sqrt((x)/b)-sqrt(b/(x)))/a)}
}}
if(g=="weibull"){
den=function(par,x){shape=par[2]; scale=par[3]; loc=par[4]; dweibull(x-loc,shape,scale)}
cum=function(par,x){shape=par[2]; scale=par[3]; loc=par[4]; pweibull(x-loc,shape,scale)}
if (location==FALSE){
den=function(par,x){shape=par[2]; scale=par[3]; dweibull(x,shape,scale)}
cum=function(par,x){shape=par[2]; scale=par[3]; pweibull(x,shape,scale)}
}}
if(g=="gamma"){
den=function(par,x){shape=par[2]; scale=par[3]; loc=par[4]; dgamma(x-loc,shape,scale)}
cum=function(par,x){shape=par[2]; scale=par[3]; loc=par[4]; pgamma(x-loc,shape,scale)}
if (location==FALSE){
den=function(par,x){shape=par[2]; scale=par[3]; dgamma(x,shape,scale)}
cum=function(par,x){shape=par[2]; scale=par[3]; pgamma(x,shape,scale)}
}}
pdf0<-function(par,x){
f0=den(par,x)
c0=cum(par,x)
r=par[1]
r*f0/((1-(1-r)*(1-c0))^2)
}
pdf<-pdf0(param,mydata)
if(log==TRUE){pdf<-log(pdf)}
return(pdf)
}
pgexppg<-function(mydata, g, param, location = TRUE, log.p = FALSE, lower.tail = TRUE){
if(g!="birnbaum-saunders" & g!="exp" & g!="rayleigh" & g!="weibull" & g!="gompertz" & g!="gamma"
& g!="log-normal" & g!="chisq" & g!="f" & g!="burrxii" & g!="frechet"
& g!="lomax" & g!="log-logistic" & g!="lfr" & g!="chen")
{ stop ("Baseline distribution not implemented or misspelled. Please check the manual for guidelines.") }
if(g=="log-normal"){
den=function(par,x){meanlog=par[3]; sdlog=par[4]; loc=par[5]; dlnorm(x-loc,meanlog,sdlog)}
cum=function(par,x){meanlog=par[3]; sdlog=par[4]; loc=par[5]; plnorm(x-loc,meanlog,sdlog)}
if (location==FALSE){
den=function(par,x){meanlog=par[3]; sdlog=par[4]; dlnorm(x,meanlog,sdlog)}
cum=function(par,x){meanlog=par[3]; sdlog=par[4]; plnorm(x,meanlog,sdlog)}
}}
if(g=="chisq"){
den=function(par,x){df=par[3]; loc=par[4]; dchisq(x-loc,df)}
cum=function(par,x){df=par[3]; loc=par[4]; pchisq(x-loc,df)}
if (location==FALSE){
den=function(par,x){df=par[3]; dchisq(x,df)}
cum=function(par,x){df=par[3]; pchisq(x,df)}
}}
if(g=="f"){
den=function(par,x){df1=par[3]; df2=par[4]; loc=par[5]; df(x-loc,df1,df2)}
cum=function(par,x){df1=par[3]; df2=par[4]; loc=par[5]; pf(x-loc,df1,df2)}
if (location==FALSE){
den=function(par,x){df1=par[3]; df2=par[4]; df(x,df1,df2)}
cum=function(par,x){df1=par[3]; df2=par[4]; pf(x,df1,df2)}
}}
if(g=="chen"){
den=function(par,x){a=par[3]; b=par[4]; loc=par[5]; a*b*(x-loc)^(a-1)*exp((x-loc)^a)*exp(-b*(exp((x-loc)^a)-1))}
cum=function(par,x){a=par[3]; b=par[4]; loc=par[5]; 1-exp(-b*(exp((x-loc)^a)-1))}
if (location==FALSE){
den=function(par,x){a=par[3]; b=par[4]; a*b*(x)^(a-1)*exp((x)^a)*exp(-b*(exp((x)^a)-1))}
cum=function(par,x){a=par[3]; b=par[4]; 1-exp(-b*(exp((x)^a)-1))}
}}
if(g=="lfr"){
den=function(par,x){a=par[3]; b=par[4]; loc=par[5]; (a+b*(x-loc))*exp(-a*(x-loc)-(b*(x-loc)^2)/2)}
cum=function(par,x){a=par[3]; b=par[4]; loc=par[5]; 1-exp(-a*(x-loc)-(b*(x-loc)^2)/2)}
if (location==FALSE){
den=function(par,x){a=par[3]; b=par[4]; (a+b*(x))*exp(-a*(x)-(b*(x)^2)/2)}
cum=function(par,x){a=par[3]; b=par[4]; 1-exp(-a*(x)-(b*(x)^2)/2)}
}}
if(g=="log-logistic"){
den=function(par,x){a=par[3]; b=par[4]; loc=par[5]; (a*b^(-a)*(x-loc)^(a-1))/((((x-loc)/b)^a +1)^2)}
cum=function(par,x){a=par[3]; b=par[4]; loc=par[5]; 1/(((x-loc)/b)^(-a)+1)}
if (location==FALSE){
den=function(par,x){a=par[3]; b=par[4]; (a*b^(-a)*(x)^(a-1))/((((x)/b)^a +1)^2)}
cum=function(par,x){a=par[3]; b=par[4]; 1/(((x)/b)^(-a)+1)}
}}
if(g=="lomax"){
den=function(par,x){a=par[3]; b=par[4]; loc=par[5]; (a*b)/((1+a*(x-loc))^(b+1))}
cum=function(par,x){a=par[3]; b=par[4]; loc=par[5]; 1-(1+a*(x-loc))^(-b)}
if (location==FALSE){
den=function(par,x){a=par[3]; b=par[4]; (a*b)/((1+a*(x))^(b+1))}
cum=function(par,x){a=par[3]; b=par[4]; 1-(1+a*(x))^(-b)}
}}
if(g=="gompertz"){
den=function(par,x){a=par[3]; b=par[4]; loc=par[5]; b*exp(a*(x-loc))*exp(-(exp(a*(x-loc))-1)*b/a)}
cum=function(par,x){a=par[3]; b=par[4]; loc=par[5]; 1-exp(-(exp(a*(x-loc))-1)*b/a)}
if (location==FALSE){
den=function(par,x){a=par[3]; b=par[4]; b*exp(a*(x))*exp(-(exp(a*(x))-1)*b/a)}
cum=function(par,x){a=par[3]; b=par[4]; 1-exp(-(exp(a*(x))-1)*b/a)}
}}
if(g=="exp"){
den=function(par,x){rate=par[3]; loc=par[4]; dexp(x-loc,rate)}
cum=function(par,x){rate=par[3]; loc=par[4]; pexp(x-loc,rate)}
if (location==FALSE){
den=function(par,x){rate=par[3]; dexp(x,rate)}
cum=function(par,x){rate=par[3]; pexp(x,rate)}
}}
if(g=="rayleigh"){
den=function(par,x){a=par[3]; loc=par[4]; 2*(x-loc)/a*exp(-((x-loc)/a)^2)}
cum=function(par,x){a=par[3]; loc=par[4]; 1-exp(-((x-loc)/a)^2)}
if (location==FALSE){
den=function(par,x){a=par[3]; 2*x/a*exp(-(x/a)^2)}
cum=function(par,x){a=par[3]; 1-exp(-(x/a)^2)}
}}
if(g=="burrxii"){
den=function(par,x){a=par[3]; d=par[4]; loc=par[5]; d*a*(1+(x-loc)^d)^(-a-1)*((x-loc)^(d-1))}
cum=function(par,x){a=par[3]; d=par[4]; loc=par[5]; 1-(1+(x-loc)^d)^(-a)}
if (location==FALSE){
den=function(par,x){a=par[3]; d=par[4]; d*a*(1+(x)^d)^(-a-1)*((x)^(d-1))}
cum=function(par,x){a=par[3]; d=par[4]; 1-(1+(x)^d)^(-a)}
}}
if(g=="frechet"){
den=function(par,x){a=par[3]; b=par[4]; loc=par[5]; (a*exp(-((x-loc)/b)^(-a))*((x-loc)/b)^(-a-1))/(b)}
cum=function(par,x){a=par[3]; b=par[4]; loc=par[5]; exp(-((x-loc)/b)^(-a))}
if (location==FALSE){
den=function(par,x){a=par[3]; b=par[4]; (a*exp(-((x)/b)^(-a))*((x)/b)^(-a-1))/(b)}
cum=function(par,x){a=par[3]; b=par[4]; exp(-((x)/b)^(-a))}
}}
if(g=="birnbaum-saunders"){
den=function(par,x){a=par[3]; b=par[4]; loc=par[5]; (sqrt((x-loc)/b)+sqrt(b/(x-loc)))/(2*a*(x-loc))*dnorm((sqrt((x-loc)/b)-sqrt(b/(x-loc)))/a)}
cum=function(par,x){a=par[3]; b=par[4]; loc=par[5]; pnorm((sqrt((x-loc)/b)-sqrt(b/(x-loc)))/a)}
if (location==FALSE){
den=function(par,x){a=par[3]; b=par[4]; (sqrt((x)/b)+sqrt(b/(x)))/(2*a*(x))*dnorm((sqrt((x)/b)-sqrt(b/(x)))/a)}
cum=function(par,x){a=par[3]; b=par[4]; pnorm((sqrt((x)/b)-sqrt(b/(x)))/a)}
}}
if(g=="weibull"){
den=function(par,x){shape=par[3]; scale=par[4]; loc=par[5]; dweibull(x-loc,shape,scale)}
cum=function(par,x){shape=par[3]; scale=par[4]; loc=par[5]; pweibull(x-loc,shape,scale)}
if (location==FALSE){
den=function(par,x){shape=par[3]; scale=par[4]; dweibull(x,shape,scale)}
cum=function(par,x){shape=par[3]; scale=par[4]; pweibull(x,shape,scale)}
}}
if(g=="gamma"){
den=function(par,x){shape=par[3]; scale=par[4]; loc=par[5]; dgamma(x-loc,shape,scale)}
cum=function(par,x){shape=par[3]; scale=par[4]; loc=par[5]; pgamma(x-loc,shape,scale)}
if (location==FALSE){
den=function(par,x){shape=par[3]; scale=par[4]; dgamma(x,shape,scale)}
cum=function(par,x){shape=par[3]; scale=par[4]; pgamma(x,shape,scale)}
}}
cdf0<-function(par,x){
f0=den(par,x)
c0=cum(par,x)
theta=par[1]
eta=par[2]
(exp(-theta+theta*c0)-exp(-theta))/(1-exp(-theta)-eta+eta*exp(-theta+theta*c0))
}
cdf<-cdf0(param,mydata)
if(log.p==TRUE & lower.tail == FALSE) cdf<-log(1-cdf)
if(log.p==TRUE & lower.tail == TRUE) cdf<-log(cdf)
if(log.p==FALSE & lower.tail == FALSE) cdf<-1-cdf
return(cdf)
}
dgexppg<-function(mydata, g, param, location=TRUE, log=FALSE){
if(g!="birnbaum-saunders" & g!="exp" & g!="rayleigh" & g!="weibull" & g!="gompertz" & g!="gamma"
& g!="log-normal" & g!="chisq" & g!="f" & g!="burrxii" & g!="frechet"
& g!="lomax" & g!="log-logistic" & g!="lfr" & g!="chen")
{ stop ("Baseline distribution not implemented or misspelled. Please check the manual for guidelines.") }
if(g=="log-normal"){
den=function(par,x){meanlog=par[3]; sdlog=par[4]; loc=par[5]; dlnorm(x-loc,meanlog,sdlog)}
cum=function(par,x){meanlog=par[3]; sdlog=par[4]; loc=par[5]; plnorm(x-loc,meanlog,sdlog)}
if (location==FALSE){
den=function(par,x){meanlog=par[3]; sdlog=par[4]; dlnorm(x,meanlog,sdlog)}
cum=function(par,x){meanlog=par[3]; sdlog=par[4]; plnorm(x,meanlog,sdlog)}
}}
if(g=="chisq"){
den=function(par,x){df=par[3]; loc=par[4]; dchisq(x-loc,df)}
cum=function(par,x){df=par[3]; loc=par[4]; pchisq(x-loc,df)}
if (location==FALSE){
den=function(par,x){df=par[3]; dchisq(x,df)}
cum=function(par,x){df=par[3]; pchisq(x,df)}
}}
if(g=="f"){
den=function(par,x){df1=par[3]; df2=par[4]; loc=par[5]; df(x-loc,df1,df2)}
cum=function(par,x){df1=par[3]; df2=par[4]; loc=par[5]; pf(x-loc,df1,df2)}
if (location==FALSE){
den=function(par,x){df1=par[3]; df2=par[4]; df(x,df1,df2)}
cum=function(par,x){df1=par[3]; df2=par[4]; pf(x,df1,df2)}
}}
if(g=="chen"){
den=function(par,x){a=par[3]; b=par[4]; loc=par[5]; a*b*(x-loc)^(a-1)*exp((x-loc)^a)*exp(-b*(exp((x-loc)^a)-1))}
cum=function(par,x){a=par[3]; b=par[4]; loc=par[5]; 1-exp(-b*(exp((x-loc)^a)-1))}
if (location==FALSE){
den=function(par,x){a=par[3]; b=par[4]; a*b*(x)^(a-1)*exp((x)^a)*exp(-b*(exp((x)^a)-1))}
cum=function(par,x){a=par[3]; b=par[4]; 1-exp(-b*(exp((x)^a)-1))}
}}
if(g=="lfr"){
den=function(par,x){a=par[3]; b=par[4]; loc=par[5]; (a+b*(x-loc))*exp(-a*(x-loc)-(b*(x-loc)^2)/2)}
cum=function(par,x){a=par[3]; b=par[4]; loc=par[5]; 1-exp(-a*(x-loc)-(b*(x-loc)^2)/2)}
if (location==FALSE){
den=function(par,x){a=par[3]; b=par[4]; (a+b*(x))*exp(-a*(x)-(b*(x)^2)/2)}
cum=function(par,x){a=par[3]; b=par[4]; 1-exp(-a*(x)-(b*(x)^2)/2)}
}}
if(g=="log-logistic"){
den=function(par,x){a=par[3]; b=par[4]; loc=par[5]; (a*b^(-a)*(x-loc)^(a-1))/((((x-loc)/b)^a +1)^2)}
cum=function(par,x){a=par[3]; b=par[4]; loc=par[5]; 1/(((x-loc)/b)^(-a)+1)}
if (location==FALSE){
den=function(par,x){a=par[3]; b=par[4]; (a*b^(-a)*(x)^(a-1))/((((x)/b)^a +1)^2)}
cum=function(par,x){a=par[3]; b=par[4]; 1/(((x)/b)^(-a)+1)}
}}
if(g=="lomax"){
den=function(par,x){a=par[3]; b=par[4]; loc=par[5]; (a*b)/((1+a*(x-loc))^(b+1))}
cum=function(par,x){a=par[3]; b=par[4]; loc=par[5]; 1-(1+a*(x-loc))^(-b)}
if (location==FALSE){
den=function(par,x){a=par[3]; b=par[4]; (a*b)/((1+a*(x))^(b+1))}
cum=function(par,x){a=par[3]; b=par[4]; 1-(1+a*(x))^(-b)}
}}
if(g=="gompertz"){
den=function(par,x){a=par[3]; b=par[4]; loc=par[5]; b*exp(a*(x-loc))*exp(-(exp(a*(x-loc))-1)*b/a)}
cum=function(par,x){a=par[3]; b=par[4]; loc=par[5]; 1-exp(-(exp(a*(x-loc))-1)*b/a)}
if (location==FALSE){
den=function(par,x){a=par[3]; b=par[4]; b*exp(a*(x))*exp(-(exp(a*(x))-1)*b/a)}
cum=function(par,x){a=par[3]; b=par[4]; 1-exp(-(exp(a*(x))-1)*b/a)}
}}
if(g=="exp"){
den=function(par,x){rate=par[3]; loc=par[4]; dexp(x-loc,rate)}
cum=function(par,x){rate=par[3]; loc=par[4]; pexp(x-loc,rate)}
if (location==FALSE){
den=function(par,x){rate=par[3]; dexp(x,rate)}
cum=function(par,x){rate=par[3]; pexp(x,rate)}
}}
if(g=="rayleigh"){
den=function(par,x){a=par[3]; loc=par[4]; 2*(x-loc)/a*exp(-((x-loc)/a)^2)}
cum=function(par,x){a=par[3]; loc=par[4]; 1-exp(-((x-loc)/a)^2)}
if (location==FALSE){
den=function(par,x){a=par[3]; 2*x/a*exp(-(x/a)^2)}
cum=function(par,x){a=par[3]; 1-exp(-(x/a)^2)}
}}
if(g=="burrxii"){
den=function(par,x){a=par[3]; d=par[4]; loc=par[5]; d*a*(1+(x-loc)^d)^(-a-1)*((x-loc)^(d-1))}
cum=function(par,x){a=par[3]; d=par[4]; loc=par[5]; 1-(1+(x-loc)^d)^(-a)}
if (location==FALSE){
den=function(par,x){a=par[3]; d=par[4]; d*a*(1+(x)^d)^(-a-1)*((x)^(d-1))}
cum=function(par,x){a=par[3]; d=par[4]; 1-(1+(x)^d)^(-a)}
}}
if(g=="frechet"){
den=function(par,x){a=par[3]; b=par[4]; loc=par[5]; (a*exp(-((x-loc)/b)^(-a))*((x-loc)/b)^(-a-1))/(b)}
cum=function(par,x){a=par[3]; b=par[4]; loc=par[5]; exp(-((x-loc)/b)^(-a))}
if (location==FALSE){
den=function(par,x){a=par[3]; b=par[4]; (a*exp(-((x)/b)^(-a))*((x)/b)^(-a-1))/(b)}
cum=function(par,x){a=par[3]; b=par[4]; exp(-((x)/b)^(-a))}
}}
if(g=="birnbaum-saunders"){
den=function(par,x){a=par[3]; b=par[4]; loc=par[5]; (sqrt((x-loc)/b)+sqrt(b/(x-loc)))/(2*a*(x-loc))*dnorm((sqrt((x-loc)/b)-sqrt(b/(x-loc)))/a)}
cum=function(par,x){a=par[3]; b=par[4]; loc=par[5]; pnorm((sqrt((x-loc)/b)-sqrt(b/(x-loc)))/a)}
if (location==FALSE){
den=function(par,x){a=par[3]; b=par[4]; (sqrt((x)/b)+sqrt(b/(x)))/(2*a*(x))*dnorm((sqrt((x)/b)-sqrt(b/(x)))/a)}
cum=function(par,x){a=par[3]; b=par[4]; pnorm((sqrt((x)/b)-sqrt(b/(x)))/a)}
}}
if(g=="weibull"){
den=function(par,x){shape=par[3]; scale=par[4]; loc=par[5]; dweibull(x-loc,shape,scale)}
cum=function(par,x){shape=par[3]; scale=par[4]; loc=par[5]; pweibull(x-loc,shape,scale)}
if (location==FALSE){
den=function(par,x){shape=par[3]; scale=par[4]; dweibull(x,shape,scale)}
cum=function(par,x){shape=par[3]; scale=par[4]; pweibull(x,shape,scale)}
}}
if(g=="gamma"){
den=function(par,x){shape=par[3]; scale=par[4]; loc=par[5]; dgamma(x-loc,shape,scale)}
cum=function(par,x){shape=par[3]; scale=par[4]; loc=par[5]; pgamma(x-loc,shape,scale)}
if (location==FALSE){
den=function(par,x){shape=par[3]; scale=par[4]; dgamma(x,shape,scale)}
cum=function(par,x){shape=par[3]; scale=par[4]; pgamma(x,shape,scale)}
}}
pdf0<-function(par,x){
f0=den(par,x)
c0=cum(par,x)
theta=par[1]
eta=par[2]
theta*(1-eta)*(1-exp(-theta))*f0*exp(-theta+theta*c0)/(1-exp(-theta)-eta+eta*exp(-theta+theta*c0))**2
}
pdf<-pdf0(param,mydata)
if(log==TRUE){pdf<-log(pdf)}
return(pdf)
}
pmokumg<-function(mydata, g, param, location=TRUE, log.p = FALSE, lower.tail = TRUE){
if(g!="birnbaum-saunders" & g!="exp" & g!="rayleigh" & g!="weibull" & g!="gompertz" & g!="gamma"
& g!="log-normal" & g!="chisq" & g!="f" & g!="burrxii" & g!="frechet"
& g!="lomax" & g!="log-logistic" & g!="lfr" & g!="chen")
{ stop ("Baseline distribution not implemented or misspelled. Please check the manual for guidelines.") }
if(g=="log-normal"){
den=function(par,x){meanlog=par[4]; sdlog=par[5]; loc=par[6]; dlnorm(x-loc,meanlog,sdlog)}
cum=function(par,x){meanlog=par[4]; sdlog=par[5]; loc=par[6]; plnorm(x-loc,meanlog,sdlog)}
if (location==FALSE){
den=function(par,x){meanlog=par[4]; sdlog=par[5]; dlnorm(x,meanlog,sdlog)}
cum=function(par,x){meanlog=par[4]; sdlog=par[5]; plnorm(x,meanlog,sdlog)}
}}
if(g=="chisq"){
den=function(par,x){df=par[4]; loc=par[5]; dchisq(x-loc,df)}
cum=function(par,x){df=par[4]; loc=par[5]; pchisq(x-loc,df)}
if (location==FALSE){
den=function(par,x){df=par[4]; dchisq(x,df)}
cum=function(par,x){df=par[4]; pchisq(x,df)}
}}
if(g=="f"){
den=function(par,x){df1=par[4]; df2=par[5]; loc=par[6]; df(x-loc,df1,df2)}
cum=function(par,x){df1=par[4]; df2=par[5]; loc=par[6]; pf(x-loc,df1,df2)}
if (location==FALSE){
den=function(par,x){df1=par[4]; df2=par[5]; df(x,df1,df2)}
cum=function(par,x){df1=par[4]; df2=par[5]; pf(x,df1,df2)}
}}
if(g=="chen"){
den=function(par,x){a=par[4]; b=par[5]; loc=par[6]; a*b*(x-loc)^(a-1)*exp((x-loc)^a)*exp(-b*(exp((x-loc)^a)-1))}
cum=function(par,x){a=par[4]; b=par[5]; loc=par[6]; 1-exp(-b*(exp((x-loc)^a)-1))}
if (location==FALSE){
den=function(par,x){a=par[4]; b=par[5]; a*b*(x)^(a-1)*exp((x)^a)*exp(-b*(exp((x)^a)-1))}
cum=function(par,x){a=par[4]; b=par[5]; 1-exp(-b*(exp((x)^a)-1))}
}}
if(g=="lfr"){
den=function(par,x){a=par[4]; b=par[5]; loc=par[6]; (a+b*(x-loc))*exp(-a*(x-loc)-(b*(x-loc)^2)/2)}
cum=function(par,x){a=par[4]; b=par[5]; loc=par[6]; 1-exp(-a*(x-loc)-(b*(x-loc)^2)/2)}
if (location==FALSE){
den=function(par,x){a=par[4]; b=par[5]; (a+b*(x))*exp(-a*(x)-(b*(x)^2)/2)}
cum=function(par,x){a=par[4]; b=par[5]; 1-exp(-a*(x)-(b*(x)^2)/2)}
}}
if(g=="log-logistic"){
den=function(par,x){a=par[4]; b=par[5]; loc=par[6]; (a*b^(-a)*(x-loc)^(a-1))/((((x-loc)/b)^a +1)^2)}
cum=function(par,x){a=par[4]; b=par[5]; loc=par[6]; 1/(((x-loc)/b)^(-a)+1)}
if (location==FALSE){
den=function(par,x){a=par[4]; b=par[5]; (a*b^(-a)*(x)^(a-1))/((((x)/b)^a +1)^2)}
cum=function(par,x){a=par[4]; b=par[5]; 1/(((x)/b)^(-a)+1)}
}}
if(g=="lomax"){
den=function(par,x){a=par[4]; b=par[5]; loc=par[6]; (a*b)/((1+a*(x-loc))^(b+1))}
cum=function(par,x){a=par[4]; b=par[5]; loc=par[6]; 1-(1+a*(x-loc))^(-b)}
if (location==FALSE){
den=function(par,x){a=par[4]; b=par[5]; (a*b)/((1+a*(x))^(b+1))}
cum=function(par,x){a=par[4]; b=par[5]; 1-(1+a*(x))^(-b)}
}}
if(g=="gompertz"){
den=function(par,x){a=par[4]; b=par[5]; loc=par[6]; b*exp(a*(x-loc))*exp(-(exp(a*(x-loc))-1)*b/a)}
cum=function(par,x){a=par[4]; b=par[5]; loc=par[6]; 1-exp(-(exp(a*(x-loc))-1)*b/a)}
if (location==FALSE){
den=function(par,x){a=par[4]; b=par[5]; b*exp(a*(x))*exp(-(exp(a*(x))-1)*b/a)}
cum=function(par,x){a=par[4]; b=par[5]; 1-exp(-(exp(a*(x))-1)*b/a)}
}}
if(g=="exp"){
den=function(par,x){rate=par[4]; loc=par[5]; dexp(x-loc,rate)}
cum=function(par,x){rate=par[4]; loc=par[5]; pexp(x-loc,rate)}
if (location==FALSE){
den=function(par,x){rate=par[4]; dexp(x,rate)}
cum=function(par,x){rate=par[4]; pexp(x,rate)}
}}
if(g=="rayleigh"){
den=function(par,x){a=par[4]; loc=par[5]; 2*(x-loc)/a*exp(-((x-loc)/a)^2)}
cum=function(par,x){a=par[4]; loc=par[5]; 1-exp(-((x-loc)/a)^2)}
if (location==FALSE){
den=function(par,x){a=par[4]; 2*x/a*exp(-(x/a)^2)}
cum=function(par,x){a=par[4]; 1-exp(-(x/a)^2)}
}}
if(g=="burrxii"){
den=function(par,x){a=par[4]; d=par[5]; loc=par[6]; d*a*(1+(x-loc)^d)^(-a-1)*((x-loc)^(d-1))}
cum=function(par,x){a=par[4]; d=par[5]; loc=par[6]; 1-(1+(x-loc)^d)^(-a)}
if (location==FALSE){
den=function(par,x){a=par[4]; d=par[5]; d*a*(1+(x)^d)^(-a-1)*((x)^(d-1))}
cum=function(par,x){a=par[4]; d=par[5]; 1-(1+(x)^d)^(-a)}
}}
if(g=="frechet"){
den=function(par,x){a=par[4]; b=par[5]; loc=par[6]; (a*exp(-((x-loc)/b)^(-a))*((x-loc)/b)^(-a-1))/(b)}
cum=function(par,x){a=par[4]; b=par[5]; loc=par[6]; exp(-((x-loc)/b)^(-a))}
if (location==FALSE){
den=function(par,x){a=par[4]; b=par[5]; (a*exp(-((x)/b)^(-a))*((x)/b)^(-a-1))/(b)}
cum=function(par,x){a=par[4]; b=par[5]; exp(-((x)/b)^(-a))}
}}
if(g=="birnbaum-saunders"){
den=function(par,x){a=par[4]; b=par[5]; loc=par[6]; (sqrt((x-loc)/b)+sqrt(b/(x-loc)))/(2*a*(x-loc))*dnorm((sqrt((x-loc)/b)-sqrt(b/(x-loc)))/a)}
cum=function(par,x){a=par[4]; b=par[5]; loc=par[6]; pnorm((sqrt((x-loc)/b)-sqrt(b/(x-loc)))/a)}
if (location==FALSE){
den=function(par,x){a=par[4]; b=par[5]; (sqrt((x)/b)+sqrt(b/(x)))/(2*a*(x))*dnorm((sqrt((x)/b)-sqrt(b/(x)))/a)}
cum=function(par,x){a=par[4]; b=par[5]; pnorm((sqrt((x)/b)-sqrt(b/(x)))/a)}
}}
if(g=="weibull"){
den=function(par,x){shape=par[4]; scale=par[5]; loc=par[6]; dweibull(x-loc,shape,scale)}
cum=function(par,x){shape=par[4]; scale=par[5]; loc=par[6]; pweibull(x-loc,shape,scale)}
if (location==FALSE){
den=function(par,x){shape=par[4]; scale=par[5]; dweibull(x,shape,scale)}
cum=function(par,x){shape=par[4]; scale=par[5]; pweibull(x,shape,scale)}
}}
if(g=="gamma"){
den=function(par,x){shape=par[4]; scale=par[5]; loc=par[6]; dgamma(x-loc,shape,scale)}
cum=function(par,x){shape=par[4]; scale=par[5]; loc=par[6]; pgamma(x-loc,shape,scale)}
if (location==FALSE){
den=function(par,x){shape=par[4]; scale=par[5]; dgamma(x,shape,scale)}
cum=function(par,x){shape=par[4]; scale=par[5]; pgamma(x,shape,scale)}
}}
cdf0<-function(par,x){
f0=den(par,x)
c0=cum(par,x)
a=par[1]
b=par[2]
d=par[3]
1-(d*(1-c0^a)^b)/(1-(1-d)*(1-c0^a)^b)
}
cdf<-cdf0(param,mydata)
if(log.p==TRUE & lower.tail == FALSE) cdf<-log(1-cdf)
if(log.p==TRUE & lower.tail == TRUE) cdf<-log(cdf)
if(log.p==FALSE & lower.tail == FALSE) cdf<-1-cdf
return(cdf)
}
dmokumg<-function(mydata, g, param, location=TRUE, log=FALSE){
if(g!="birnbaum-saunders" & g!="exp" & g!="rayleigh" & g!="weibull" & g!="gompertz" & g!="gamma"
& g!="log-normal" & g!="chisq" & g!="f" & g!="burrxii" & g!="frechet"
& g!="lomax" & g!="log-logistic" & g!="lfr" & g!="chen")
{ stop ("Baseline distribution not implemented or misspelled. Please check the manual for guidelines.") }
if(g=="log-normal"){
den=function(par,x){meanlog=par[4]; sdlog=par[5]; loc=par[6]; dlnorm(x-loc,meanlog,sdlog)}
cum=function(par,x){meanlog=par[4]; sdlog=par[5]; loc=par[6]; plnorm(x-loc,meanlog,sdlog)}
if (location==FALSE){
den=function(par,x){meanlog=par[4]; sdlog=par[5]; dlnorm(x,meanlog,sdlog)}
cum=function(par,x){meanlog=par[4]; sdlog=par[5]; plnorm(x,meanlog,sdlog)}
}}
if(g=="chisq"){
den=function(par,x){df=par[4]; loc=par[5]; dchisq(x-loc,df)}
cum=function(par,x){df=par[4]; loc=par[5]; pchisq(x-loc,df)}
if (location==FALSE){
den=function(par,x){df=par[4]; dchisq(x,df)}
cum=function(par,x){df=par[4]; pchisq(x,df)}
}}
if(g=="f"){
den=function(par,x){df1=par[4]; df2=par[5]; loc=par[6]; df(x-loc,df1,df2)}
cum=function(par,x){df1=par[4]; df2=par[5]; loc=par[6]; pf(x-loc,df1,df2)}
if (location==FALSE){
den=function(par,x){df1=par[4]; df2=par[5]; df(x,df1,df2)}
cum=function(par,x){df1=par[4]; df2=par[5]; pf(x,df1,df2)}
}}
if(g=="chen"){
den=function(par,x){a=par[4]; b=par[5]; loc=par[6]; a*b*(x-loc)^(a-1)*exp((x-loc)^a)*exp(-b*(exp((x-loc)^a)-1))}
cum=function(par,x){a=par[4]; b=par[5]; loc=par[6]; 1-exp(-b*(exp((x-loc)^a)-1))}
if (location==FALSE){
den=function(par,x){a=par[4]; b=par[5]; a*b*(x)^(a-1)*exp((x)^a)*exp(-b*(exp((x)^a)-1))}
cum=function(par,x){a=par[4]; b=par[5]; 1-exp(-b*(exp((x)^a)-1))}
}}
if(g=="lfr"){
den=function(par,x){a=par[4]; b=par[5]; loc=par[6]; (a+b*(x-loc))*exp(-a*(x-loc)-(b*(x-loc)^2)/2)}
cum=function(par,x){a=par[4]; b=par[5]; loc=par[6]; 1-exp(-a*(x-loc)-(b*(x-loc)^2)/2)}
if (location==FALSE){
den=function(par,x){a=par[4]; b=par[5]; (a+b*(x))*exp(-a*(x)-(b*(x)^2)/2)}
cum=function(par,x){a=par[4]; b=par[5]; 1-exp(-a*(x)-(b*(x)^2)/2)}
}}
if(g=="log-logistic"){
den=function(par,x){a=par[4]; b=par[5]; loc=par[6]; (a*b^(-a)*(x-loc)^(a-1))/((((x-loc)/b)^a +1)^2)}
cum=function(par,x){a=par[4]; b=par[5]; loc=par[6]; 1/(((x-loc)/b)^(-a)+1)}
if (location==FALSE){
den=function(par,x){a=par[4]; b=par[5]; (a*b^(-a)*(x)^(a-1))/((((x)/b)^a +1)^2)}
cum=function(par,x){a=par[4]; b=par[5]; 1/(((x)/b)^(-a)+1)}
}}
if(g=="lomax"){
den=function(par,x){a=par[4]; b=par[5]; loc=par[6]; (a*b)/((1+a*(x-loc))^(b+1))}
cum=function(par,x){a=par[4]; b=par[5]; loc=par[6]; 1-(1+a*(x-loc))^(-b)}
if (location==FALSE){
den=function(par,x){a=par[4]; b=par[5]; (a*b)/((1+a*(x))^(b+1))}
cum=function(par,x){a=par[4]; b=par[5]; 1-(1+a*(x))^(-b)}
}}
if(g=="gompertz"){
den=function(par,x){a=par[4]; b=par[5]; loc=par[6]; b*exp(a*(x-loc))*exp(-(exp(a*(x-loc))-1)*b/a)}
cum=function(par,x){a=par[4]; b=par[5]; loc=par[6]; 1-exp(-(exp(a*(x-loc))-1)*b/a)}
if (location==FALSE){
den=function(par,x){a=par[4]; b=par[5]; b*exp(a*(x))*exp(-(exp(a*(x))-1)*b/a)}
cum=function(par,x){a=par[4]; b=par[5]; 1-exp(-(exp(a*(x))-1)*b/a)}
}}
if(g=="exp"){
den=function(par,x){rate=par[4]; loc=par[5]; dexp(x-loc,rate)}
cum=function(par,x){rate=par[4]; loc=par[5]; pexp(x-loc,rate)}
if (location==FALSE){
den=function(par,x){rate=par[4]; dexp(x,rate)}
cum=function(par,x){rate=par[4]; pexp(x,rate)}
}}
if(g=="rayleigh"){
den=function(par,x){a=par[4]; loc=par[5]; 2*(x-loc)/a*exp(-((x-loc)/a)^2)}
cum=function(par,x){a=par[4]; loc=par[5]; 1-exp(-((x-loc)/a)^2)}
if (location==FALSE){
den=function(par,x){a=par[4]; 2*x/a*exp(-(x/a)^2)}
cum=function(par,x){a=par[4]; 1-exp(-(x/a)^2)}
}}
if(g=="burrxii"){
den=function(par,x){a=par[4]; d=par[5]; loc=par[6]; d*a*(1+(x-loc)^d)^(-a-1)*((x-loc)^(d-1))}
cum=function(par,x){a=par[4]; d=par[5]; loc=par[6]; 1-(1+(x-loc)^d)^(-a)}
if (location==FALSE){
den=function(par,x){a=par[4]; d=par[5]; d*a*(1+(x)^d)^(-a-1)*((x)^(d-1))}
cum=function(par,x){a=par[4]; d=par[5]; 1-(1+(x)^d)^(-a)}
}}
if(g=="frechet"){
den=function(par,x){a=par[4]; b=par[5]; loc=par[6]; (a*exp(-((x-loc)/b)^(-a))*((x-loc)/b)^(-a-1))/(b)}
cum=function(par,x){a=par[4]; b=par[5]; loc=par[6]; exp(-((x-loc)/b)^(-a))}
if (location==FALSE){
den=function(par,x){a=par[4]; b=par[5]; (a*exp(-((x)/b)^(-a))*((x)/b)^(-a-1))/(b)}
cum=function(par,x){a=par[4]; b=par[5]; exp(-((x)/b)^(-a))}
}}
if(g=="birnbaum-saunders"){
den=function(par,x){a=par[4]; b=par[5]; loc=par[6]; (sqrt((x-loc)/b)+sqrt(b/(x-loc)))/(2*a*(x-loc))*dnorm((sqrt((x-loc)/b)-sqrt(b/(x-loc)))/a)}
cum=function(par,x){a=par[4]; b=par[5]; loc=par[6]; pnorm((sqrt((x-loc)/b)-sqrt(b/(x-loc)))/a)}
if (location==FALSE){
den=function(par,x){a=par[4]; b=par[5]; (sqrt((x)/b)+sqrt(b/(x)))/(2*a*(x))*dnorm((sqrt((x)/b)-sqrt(b/(x)))/a)}
cum=function(par,x){a=par[4]; b=par[5]; pnorm((sqrt((x)/b)-sqrt(b/(x)))/a)}
}}
if(g=="weibull"){
den=function(par,x){shape=par[4]; scale=par[5]; loc=par[6]; dweibull(x-loc,shape,scale)}
cum=function(par,x){shape=par[4]; scale=par[5]; loc=par[6]; pweibull(x-loc,shape,scale)}
if (location==FALSE){
den=function(par,x){shape=par[4]; scale=par[5]; dweibull(x,shape,scale)}
cum=function(par,x){shape=par[4]; scale=par[5]; pweibull(x,shape,scale)}
}}
if(g=="gamma"){
den=function(par,x){shape=par[4]; scale=par[5]; loc=par[6]; dgamma(x-loc,shape,scale)}
cum=function(par,x){shape=par[4]; scale=par[5]; loc=par[6]; pgamma(x-loc,shape,scale)}
if (location==FALSE){
den=function(par,x){shape=par[4]; scale=par[5]; dgamma(x,shape,scale)}
cum=function(par,x){shape=par[4]; scale=par[5]; pgamma(x,shape,scale)}
}}
pdf0<-function(par,x){
f0=den(par,x)
c0=cum(par,x)
a=par[1]
b=par[2]
d=par[3]
(d*a*b*c0^(a-1)*(1-c0^a)^(b-1))/((1-(1-a)*(1-c0^a)^b)^2)
}
pdf<-pdf0(param,mydata)
if(log==TRUE){pdf<-log(pdf)}
return(pdf)
}
mpsweibullextg<-function(mydata, g, location=TRUE, method , sig.level){
min.mydata<-min(mydata)
sort.mydata<-sort(mydata)
n<-length(mydata)
y<-(sort.mydata[2:n]-min.mydata)
y<-(sort.mydata[2:n]-min.mydata)[is.finite(log(sort.mydata[2:n]-min.mydata))]
n<-length(mydata)
qp1<-y[floor(.25*n)]
qp3<-y[floor(.75*n)]
median.mydata<-y[floor(.5*n)]
mean.mydata<-mean(y)
inv.mydata<-1/y[is.finite(1/y)]
inv.mean<-mean(inv.mydata)
std.mydata<-sd(y)
if(g!="birnbaum-saunders" & g!="exp" & g!="rayleigh" & g!="weibull" & g!="gompertz" & g!="gamma"
& g!="log-normal" & g!="chisq" & g!="f" & g!="burrxii" & g!="frechet"
& g!="lomax" & g!="log-logistic" & g!="lfr" & g!="chen")
{ stop ("Baseline distribution not implemented or misspelled. Please check the manual for guidelines.") }
if(g=="log-normal"){
den=function(par,x){meanlog=par[3]; sdlog=par[4]; loc=par[5]; dlnorm(x-loc,meanlog,sdlog)}
cum=function(par,x){meanlog=par[3]; sdlog=par[4]; loc=par[5]; plnorm(x-loc,meanlog,sdlog)}
starts<-c(1,1,log(median.mydata),sqrt(2*abs(log(mean.mydata/median.mydata))),(min.mydata-1/length(y)))
if (location=="FALSE"){
den=function(par,x){meanlog=par[3]; sdlog=par[4]; dlnorm(x,meanlog,sdlog)}
cum=function(par,x){meanlog=par[3]; sdlog=par[4]; plnorm(x,meanlog,sdlog)}
starts<-c(1,1,log(median.mydata),sqrt(2*abs(log(mean.mydata/median.mydata))))
}}
if(g=="chisq"){
den=function(par,x){df=par[3]; loc=par[4]; dchisq(x-loc,df)}
cum=function(par,x){df=par[3]; loc=par[4]; pchisq(x-loc,df)}
starts<-c(1,1,mean.mydata,(min.mydata-1/length(y)))
if (location=="FALSE"){
den=function(par,x){df=par[3]; dchisq(x,df)}
cum=function(par,x){df=par[3]; pchisq(x,df)}
starts<-c(1,1,mean.mydata)
}}
if(g=="f"){
den=function(par,x){df1=par[3]; df2=par[4]; loc=par[5]; df(x-loc,df1,df2)}
cum=function(par,x){df1=par[3]; df2=par[4]; loc=par[5]; pf(x-loc,df1,df2)}
df.1<-ifelse(inv.mean>1,2*inv.mean/(inv.mean-1),1)
df.2<-ifelse(mean.mydata>1,2*mean.mydata/(mean.mydata-1),1)
starts<-c(1,1,df.1,df.2,(min.mydata-1/length(y)))
if (location=="FALSE"){
den=function(par,x){df1=par[3]; df2=par[4]; df(x,df1,df2)}
cum=function(par,x){df1=par[3]; df2=par[4]; pf(x,df1,df2)}
starts<-c(1,1,df.1,df.2)
}}
if(g=="chen"){
den=function(par,x){a=par[3]; b=par[4]; loc=par[5]; a*b*(x-loc)^(a-1)*exp((x-loc)^a)*exp(-b*(exp((x-loc)^a)-1))}
cum=function(par,x){a=par[3]; b=par[4]; loc=par[5]; 1-exp(-b*(exp((x-loc)^a)-1))}
standard.mydata<-(y-mean.mydata)/std.mydata
s.hat<-ifelse(max(standard.mydata)<=1,-log(1-n/(n+.4))/(exp(1)-1),-
log(1-length(standard.mydata[standard.mydata<=1])/length(standard.mydata))/(exp(1)-1))
r.hat<-abs(log(log(1-log(1-0.5)/s.hat))/log(median.mydata))
starts<-c(1,1,r.hat,s.hat,(min.mydata-1/length(y)))
if (location=="FALSE"){
den=function(par,x){a=par[3]; b=par[4]; a*b*(x)^(a-1)*exp((x)^a)*exp(-b*(exp((x)^a)-1))}
cum=function(par,x){a=par[3]; b=par[4]; 1-exp(-b*(exp((x)^a)-1))}
starts<-c(1,1,r.hat,s.hat)
}}
if(g=="lfr"){
den=function(par,x){a=par[3]; b=par[4]; loc=par[5]; (a+b*(x-loc))*exp(-a*(x-loc)-(b*(x-loc)^2)/2)}
cum=function(par,x){a=par[3]; b=par[4]; loc=par[5]; 1-exp(-a*(x-loc)-(b*(x-loc)^2)/2)}
ii<-seq(1,(n-1))
yy<--log(1-(ii+0.3)/(n-1+0.4))
res<-summary(lm(yy ~ -1+y+I(y^2)))$coefficient
coeff<-c(abs(res[1,1]),abs(res[2,1]))
z1=NULL;
lfr.log<-function(p) {
z1<--log(sum(p[1]+p[2]*y))+p[1]*sum(y)+p[2]/2*sum(y^2)
z1[z1<1e-16]<-1e-16
}
p.hat<-suppressWarnings(optim(c(abs(coeff[1]),2*abs(coeff[2])),lfr.log)$par)
starts<-c(1,1,p.hat[1],p.hat[2],(min.mydata-1/length(y)))
if (location=="FALSE"){
den=function(par,x){a=par[3]; b=par[4]; (a+b*(x))*exp(-a*(x)-(b*(x)^2)/2)}
cum=function(par,x){a=par[3]; b=par[4]; 1-exp(-a*(x)-(b*(x)^2)/2)}
starts<-c(1,1,p.hat[1],p.hat[2])
}}
if(g=="log-logistic"){
den=function(par,x){a=par[3]; b=par[4]; loc=par[5]; (a*b^(-a)*(x-loc)^(a-1))/((((x-loc)/b)^a +1)^2)}
cum=function(par,x){a=par[3]; b=par[4]; loc=par[5]; 1/(((x-loc)/b)^(-a)+1)}
starts<-c(1,1,log(0.75/(1-0.75))/log(qp3/median.mydata),median.mydata,(min.mydata-1/length(y)))
if (location=="FALSE"){
den=function(par,x){a=par[3]; b=par[4]; (a*b^(-a)*(x)^(a-1))/((((x)/b)^a +1)^2)}
cum=function(par,x){a=par[3]; b=par[4]; 1/(((x)/b)^(-a)+1)}
starts<-c(1,1,log(0.75/(1-0.75))/log(qp3/median.mydata),median.mydata)
}}
if(g=="lomax"){
den=function(par,x){a=par[3]; b=par[4]; loc=par[5]; (a*b)/((1+a*(x-loc))^(b+1))}
cum=function(par,x){a=par[3]; b=par[4]; loc=par[5]; 1-(1+a*(x-loc))^(-b)}
a.hat<-1
b.hat<-(.5^(-1/a.hat)-1)/median.mydata
z1=NULL;
lomax.log<-function(p) {
z1<--n*log(p[1])-n*log(p[2])+(p[2]+1)*sum(log(1+p[1]*y))
z1[z1<1e-16]<-1e-16
}
p.hat<-suppressWarnings(optim(c(1,b.hat),lomax.log, method)$par)
starts<-c(1,1,p.hat[1],p.hat[2],(min.mydata-1/length(y)))
if (location=="FALSE"){
den=function(par,x){a=par[3]; b=par[4]; (a*b)/((1+a*(x))^(b+1))}
cum=function(par,x){a=par[3]; b=par[4]; 1-(1+a*(x))^(-b)}
starts<-c(1,1,p.hat[1],p.hat[2])
}}
if(g=="gompertz"){
den=function(par,x){a=par[3]; b=par[4]; loc=par[5]; b*exp(a*(x-loc))*exp(-(exp(a*(x-loc))-1)*b/a)}
cum=function(par,x){a=par[3]; b=par[4]; loc=par[5]; 1-exp(-(exp(a*(x-loc))-1)*b/a)}
a.hat<-log(log(1-.75)/log(1-.5))/(qp3-median.mydata)
b.hat<--a.hat*log(0.5)/(exp(a.hat*median.mydata)-1)
z1=NULL;
gompertz.log<-function(p){
z1<--n*log(p[2])-p[1]*sum(y)+p[2]/p[1]*sum(exp(p[1]*y)-1)
z1[z1<1e-16]<-1e-16
}
p.hat<-suppressWarnings(optim(c(a.hat,b.hat),gompertz.log, method)$par)
starts<-c(1,1,p.hat[1],p.hat[2],(min.mydata-1/length(y)))
if (location=="FALSE"){
den=function(par,x){a=par[3]; b=par[4]; b*exp(a*(x))*exp(-(exp(a*(x))-1)*b/a)}
cum=function(par,x){a=par[3]; b=par[4]; 1-exp(-(exp(a*(x))-1)*b/a)}
starts<-c(1,1,p.hat[1],p.hat[2])
}}
if(g=="exp"){
den=function(par,x){rate=par[3]; loc=par[4]; dexp(x-loc,rate)}
cum=function(par,x){rate=par[3]; loc=par[4]; pexp(x-loc,rate)}
starts<-c(1,1,1/mean.mydata,(min.mydata-1/length(y)))
if (location=="FALSE"){
den=function(par,x){rate=par[3]; dexp(x,rate)}
cum=function(par,x){rate=par[3]; pexp(x,rate)}
starts<-c(1,1,1/mean.mydata)
}}
if(g=="rayleigh"){
den=function(par,x){a=par[3]; loc=par[4]; 2*(x-loc)/a*exp(-((x-loc)/a)^2)}
cum=function(par,x){a=par[3]; loc=par[4]; 1-exp(-((x-loc)/a)^2)}
starts<-c(1,1,log(2)/(median.mydata)^2,(min.mydata-1/length(y)))
if (location=="FALSE"){
den=function(par,x){a=par[3]; 2*x/a*exp(-(x/a)^2)}
cum=function(par,x){a=par[3]; 1-exp(-(x/a)^2)}
starts<-c(1,1,log(2)/(median.mydata)^2)
}}
if(g=="burrxii"){
den=function(par,x){a=par[3]; d=par[4]; loc=par[5]; d*a*(1+(x-loc)^d)^(-a-1)*((x-loc)^(d-1))}
cum=function(par,x){a=par[3]; d=par[4]; loc=par[5]; 1-(1+(x-loc)^d)^(-a)}
z1=NULL;
burrxii.log<-function(p){
z1<--n*log(p[1])-n*log(p[2])-(p[2]-1)*sum(log(y))+(p[1]+1)*sum(log(1+y^p[2]))
}
p.hat<-suppressWarnings(optim(c(1,1),burrxii.log, method="BFGS")$par)
starts<-c(1,1,p.hat[1],p.hat[2],(min.mydata-1/length(y)))
if (location=="FALSE"){
den=function(par,x){a=par[3]; d=par[4]; d*a*(1+(x)^d)^(-a-1)*((x)^(d-1))}
cum=function(par,x){a=par[3]; d=par[4]; 1-(1+(x)^d)^(-a)}
starts<-c(1,1,p.hat[1],p.hat[2])
}}
if(g=="frechet"){
den=function(par,x){a=par[3]; b=par[4]; loc=par[5]; (a*exp(-((x-loc)/b)^(-a))*((x-loc)/b)^(-a-1))/(b)}
cum=function(par,x){a=par[3]; b=par[4]; loc=par[5]; exp(-((x-loc)/b)^(-a))}
cons<-cor(inv.mydata,rank(inv.mydata))*(sd(inv.mydata)/mean(inv.mydata))*sqrt((n+1)/(n-1))/sqrt(3)
a.hat<-abs(ifelse(cons<1,-log(2)/log(1-cons),-log(2)/log(1-.98)))
b.hat<-median(inv.mydata)/(log(2))^(1/a.hat)
starts<-c(1,1,a.hat,1/b.hat,(min.mydata-1/length(y)))
if (location=="FALSE"){
den=function(par,x){a=par[3]; b=par[4]; (a*exp(-((x)/b)^(-a))*((x)/b)^(-a-1))/(b)}
cum=function(par,x){a=par[3]; b=par[4]; exp(-((x)/b)^(-a))}
starts<-c(1,1,a.hat,1/b.hat)
}}
if(g=="birnbaum-saunders"){
den=function(par,x){a=par[3]; b=par[4]; loc=par[5]; (sqrt((x-loc)/b)+sqrt(b/(x-loc)))/(2*a*(x-loc))*dnorm((sqrt((x-loc)/b)-sqrt(b/(x-loc)))/a)}
cum=function(par,x){a=par[3]; b=par[4]; loc=par[5]; pnorm((sqrt((x-loc)/b)-sqrt(b/(x-loc)))/a)}
r<-(mean(inv.mydata))^(-1)
b.hat<-sqrt(mean.mydata*r)
a.hat<-sqrt(2*(sqrt(mean.mydata/r)))
starts<-c(1,1,a.hat,b.hat,(min.mydata-1/length(y)))
if (location=="FALSE"){
den=function(par,x){a=par[3]; b=par[4]; (sqrt((x)/b)+sqrt(b/(x)))/(2*a*(x))*dnorm((sqrt((x)/b)-sqrt(b/(x)))/a)}
cum=function(par,x){a=par[3]; b=par[4]; pnorm((sqrt((x)/b)-sqrt(b/(x)))/a)}
starts<-c(1,1,a.hat,b.hat)
}}
if(g=="weibull"){
den=function(par,x){shape=par[3]; scale=par[4]; loc=par[5]; dweibull(x-loc,shape,scale)}
cum=function(par,x){shape=par[3]; scale=par[4]; loc=par[5]; pweibull(x-loc,shape,scale)}
cons<-cor(mydata,rank(mydata))*(std.mydata/mean.mydata)*sqrt((n+1)/(n-1))/sqrt(3)
a.hat<-abs(ifelse(cons<1,-log(2)/log(1-cons),-log(2)/log(1-.98)))
b.hat<-median.mydata/(log(2))^(1/a.hat)
starts<-c(1,1,a.hat,b.hat,(min.mydata-1/length(y)))
if (location=="FALSE"){
den=function(par,x){shape=par[3]; scale=par[4]; dweibull(x,shape,scale)}
cum=function(par,x){shape=par[3]; scale=par[4]; pweibull(x,shape,scale)}
starts<-c(1,1,a.hat,b.hat)
}}
if(g=="gamma"){
den=function(par,x){shape=par[3]; scale=par[4]; loc=par[5]; dgamma(x-loc,shape,scale)}
cum=function(par,x){shape=par[3]; scale=par[4]; loc=par[5]; pgamma(x-loc,shape,scale)}
a.hat<-uniroot(function(ss) trigamma(ss)-var(log(y)[is.finite(log(y))]),c(0,1000000))$root
b.hat<-mean.mydata/a.hat
starts<-c(1,1,a.hat,b.hat,(min.mydata-1/length(y)))
if (location=="FALSE"){
den=function(par,x){shape=par[3]; scale=par[4]; dgamma(x,shape,scale)}
cum=function(par,x){shape=par[3]; scale=par[4]; pgamma(x,shape,scale)}
starts<-c(1,1,a.hat,b.hat)
}}
pdf0<-function(par,x){
f0=den(par,x)
c0=cum(par,x)
a=par[1]
b=par[2]
a*b*f0*c0**(a-1)/((1-c0)**(a+1))*exp(-b*(c0/(1-c0))**a)
}
cdf0<-function(par,x){
f0=den(par,x)
c0=cum(par,x)
a=par[1]
b=par[2]
1-exp(-b*(c0/(1-c0))**a)
}
mpsw<-function(par,x){
z=NULL
z=diff(c(0,cdf0(par,x),1))
for (j in 2:n){if((x[j]-x[j-1])==0){z[j]=pdf0(par,x[j])
}}
z[z<1e-16]=1e-16
-sum(log(z))
}
out<-suppressWarnings(optim(starts,fn=mpsw,x=sort.mydata,method))
n.p<-length(out$par)
gammam<-(n+1)*(log(n+1)-digamma(1))-1/2-1/(12*(n+1))
sigma2m<-(n+1)*(pi^2/6-1)-1/2-1/(6*(n+1))
c1<-gammam-sqrt(n*sigma2m/2)
c2<-sqrt(sigma2m/(2*n))
stat.chisquare<-(mpsw(out$par,sort.mydata)+n.p/2-c1)/c2
pvalue.chisquare<-pchisq(stat.chisquare,df=n,lower.tail=FALSE)
Moran<-out$value
log.likelihood=sum(log(pdf0(out$par,sort.mydata)))
u=cdf0(out$par,sort.mydata)
von<-c()
anderson<-c()
for(i in 1:n){
u[i]<-ifelse(u[i]==1,0.999999999,u[i])
von[i]=(u[i]-(2*i-1)/(2*n))^2
anderson[i]=(2*i-1)*log(u[i])+(2*n+1-2*i)*log(1-u[i])
}
anderson.stat=-n-mean(anderson)
von.stat=sum(von)+1/(12*n)
CAIC=-2*log.likelihood + 2*n.p + 2*(n.p*(n.p+1))/(n-n.p-1)
AIC=-2*log.likelihood + 2*n.p
BIC=-2*log.likelihood + n.p*log(n)
HQIC=-2*log.likelihood + 2*log(log(n))*n.p
ks.stat=suppressWarnings(ks.test(mydata, "cdf0", par=out$par))
aux2=cbind(AIC, CAIC, BIC, HQIC, von.stat, anderson.stat,log.likelihood,Moran)
colnames(aux2)=c("AIC","CAIC","BIC","HQIC","CM","AD", "log",
"Moran")
rownames(aux2)=c("")
aux3=cbind(ks.stat$statistic,ks.stat$p.value)
colnames(aux3)=c("statistic","p-value")
rownames(aux3)=c("")
aux4=cbind(stat.chisquare,qchisq(sig.level,df=n,lower.tail=FALSE),1-pchisq(stat.chisquare,df=n))
colnames(aux4)=c("statistic","chi-value","p-value")
rownames(aux4)=c("")
aux5=cbind(if(out$convergence==0){"Algorithm Converged"} else {"Algorithm Not Converged"})
list("MPS"=out$par,"Measures"=aux2,"KS"=aux3,"chi-square"=aux4,"Convergence Status"=aux5)
}
pweibullextg<-function(mydata, g, param, location=TRUE, log.p = FALSE, lower.tail = TRUE){
if(g!="birnbaum-saunders" & g!="exp" & g!="rayleigh" & g!="weibull" & g!="gompertz" & g!="gamma"
& g!="log-normal" & g!="chisq" & g!="f" & g!="burrxii" & g!="frechet"
& g!="lomax" & g!="log-logistic" & g!="lfr" & g!="chen")
{ stop ("Baseline distribution not implemented or misspelled. Please check the manual for guidelines.") }
if(g=="log-normal"){
den=function(par,x){meanlog=par[3]; sdlog=par[4]; loc=par[5]; dlnorm(x-loc,meanlog,sdlog)}
cum=function(par,x){meanlog=par[3]; sdlog=par[4]; loc=par[5]; plnorm(x-loc,meanlog,sdlog)}
if (location=="FALSE"){
den=function(par,x){meanlog=par[3]; sdlog=par[4]; dlnorm(x,meanlog,sdlog)}
cum=function(par,x){meanlog=par[3]; sdlog=par[4]; plnorm(x,meanlog,sdlog)}
}}
if(g=="chisq"){
den=function(par,x){df=par[3]; loc=par[4]; dchisq(x-loc,df)}
cum=function(par,x){df=par[3]; loc=par[4]; pchisq(x-loc,df)}
if (location=="FALSE"){
den=function(par,x){df=par[3]; dchisq(x,df)}
cum=function(par,x){df=par[3]; pchisq(x,df)}
}}
if(g=="f"){
den=function(par,x){df1=par[3]; df2=par[4]; loc=par[5]; df(x-loc,df1,df2)}
cum=function(par,x){df1=par[3]; df2=par[4]; loc=par[5]; pf(x-loc,df1,df2)}
if (location=="FALSE"){
den=function(par,x){df1=par[3]; df2=par[4]; df(x,df1,df2)}
cum=function(par,x){df1=par[3]; df2=par[4]; pf(x,df1,df2)}
}}
if(g=="chen"){
den=function(par,x){a=par[3]; b=par[4]; loc=par[5]; a*b*(x-loc)^(a-1)*exp((x-loc)^a)*exp(-b*(exp((x-loc)^a)-1))}
cum=function(par,x){a=par[3]; b=par[4]; loc=par[5]; 1-exp(-b*(exp((x-loc)^a)-1))}
if (location=="FALSE"){
den=function(par,x){a=par[3]; b=par[4]; a*b*(x)^(a-1)*exp((x)^a)*exp(-b*(exp((x)^a)-1))}
cum=function(par,x){a=par[3]; b=par[4]; 1-exp(-b*(exp((x)^a)-1))}
}}
if(g=="lfr"){
den=function(par,x){a=par[3]; b=par[4]; loc=par[5]; (a+b*(x-loc))*exp(-a*(x-loc)-(b*(x-loc)^2)/2)}
cum=function(par,x){a=par[3]; b=par[4]; loc=par[5]; 1-exp(-a*(x-loc)-(b*(x-loc)^2)/2)}
if (location=="FALSE"){
den=function(par,x){a=par[3]; b=par[4]; (a+b*(x))*exp(-a*(x)-(b*(x)^2)/2)}
cum=function(par,x){a=par[3]; b=par[4]; 1-exp(-a*(x)-(b*(x)^2)/2)}
}}
if(g=="log-logistic"){
den=function(par,x){a=par[3]; b=par[4]; loc=par[5]; (a*b^(-a)*(x-loc)^(a-1))/((((x-loc)/b)^a +1)^2)}
cum=function(par,x){a=par[3]; b=par[4]; loc=par[5]; 1/(((x-loc)/b)^(-a)+1)}
if (location=="FALSE"){
den=function(par,x){a=par[3]; b=par[4]; (a*b^(-a)*(x)^(a-1))/((((x)/b)^a +1)^2)}
cum=function(par,x){a=par[3]; b=par[4]; 1/(((x)/b)^(-a)+1)}
}}
if(g=="lomax"){
den=function(par,x){a=par[3]; b=par[4]; loc=par[5]; (a*b)/((1+a*(x-loc))^(b+1))}
cum=function(par,x){a=par[3]; b=par[4]; loc=par[5]; 1-(1+a*(x-loc))^(-b)}
if (location=="FALSE"){
den=function(par,x){a=par[3]; b=par[4]; (a*b)/((1+a*(x))^(b+1))}
cum=function(par,x){a=par[3]; b=par[4]; 1-(1+a*(x))^(-b)}
}}
if(g=="gompertz"){
den=function(par,x){a=par[3]; b=par[4]; loc=par[5]; b*exp(a*(x-loc))*exp(-(exp(a*(x-loc))-1)*b/a)}
cum=function(par,x){a=par[3]; b=par[4]; loc=par[5]; 1-exp(-(exp(a*(x-loc))-1)*b/a)}
if (location=="FALSE"){
den=function(par,x){a=par[3]; b=par[4]; b*exp(a*(x))*exp(-(exp(a*(x))-1)*b/a)}
cum=function(par,x){a=par[3]; b=par[4]; 1-exp(-(exp(a*(x))-1)*b/a)}
}}
if(g=="exp"){
den=function(par,x){rate=par[3]; loc=par[4]; dexp(x-loc,rate)}
cum=function(par,x){rate=par[3]; loc=par[4]; pexp(x-loc,rate)}
if (location=="FALSE"){
den=function(par,x){rate=par[3]; dexp(x,rate)}
cum=function(par,x){rate=par[3]; pexp(x,rate)}
}}
if(g=="rayleigh"){
den=function(par,x){a=par[3]; loc=par[4]; 2*(x-loc)/a*exp(-((x-loc)/a)^2)}
cum=function(par,x){a=par[3]; loc=par[4]; 1-exp(-((x-loc)/a)^2)}
if (location=="FALSE"){
den=function(par,x){a=par[3]; 2*x/a*exp(-(x/a)^2)}
cum=function(par,x){a=par[3]; 1-exp(-(x/a)^2)}
}}
if(g=="burrxii"){
den=function(par,x){a=par[3]; d=par[4]; loc=par[5]; d*a*(1+(x-loc)^d)^(-a-1)*((x-loc)^(d-1))}
cum=function(par,x){a=par[3]; d=par[4]; loc=par[5]; 1-(1+(x-loc)^d)^(-a)}
if (location=="FALSE"){
den=function(par,x){a=par[3]; d=par[4]; d*a*(1+(x)^d)^(-a-1)*((x)^(d-1))}
cum=function(par,x){a=par[3]; d=par[4]; 1-(1+(x)^d)^(-a)}
}}
if(g=="frechet"){
den=function(par,x){a=par[3]; b=par[4]; loc=par[5]; (a*exp(-((x-loc)/b)^(-a))*((x-loc)/b)^(-a-1))/(b)}
cum=function(par,x){a=par[3]; b=par[4]; loc=par[5]; exp(-((x-loc)/b)^(-a))}
if (location=="FALSE"){
den=function(par,x){a=par[3]; b=par[4]; (a*exp(-((x)/b)^(-a))*((x)/b)^(-a-1))/(b)}
cum=function(par,x){a=par[3]; b=par[4]; exp(-((x)/b)^(-a))}
}}
if(g=="birnbaum-saunders"){
den=function(par,x){a=par[3]; b=par[4]; loc=par[5]; (sqrt((x-loc)/b)+sqrt(b/(x-loc)))/(2*a*(x-loc))*dnorm((sqrt((x-loc)/b)-sqrt(b/(x-loc)))/a)}
cum=function(par,x){a=par[3]; b=par[4]; loc=par[5]; pnorm((sqrt((x-loc)/b)-sqrt(b/(x-loc)))/a)}
if (location=="FALSE"){
den=function(par,x){a=par[3]; b=par[4]; (sqrt((x)/b)+sqrt(b/(x)))/(2*a*(x))*dnorm((sqrt((x)/b)-sqrt(b/(x)))/a)}
cum=function(par,x){a=par[3]; b=par[4]; pnorm((sqrt((x)/b)-sqrt(b/(x)))/a)}
}}
if(g=="weibull"){
den=function(par,x){shape=par[3]; scale=par[4]; loc=par[5]; dweibull(x-loc,shape,scale)}
cum=function(par,x){shape=par[3]; scale=par[4]; loc=par[5]; pweibull(x-loc,shape,scale)}
if (location=="FALSE"){
den=function(par,x){shape=par[3]; scale=par[4]; dweibull(x,shape,scale)}
cum=function(par,x){shape=par[3]; scale=par[4]; pweibull(x,shape,scale)}
}}
if(g=="gamma"){
den=function(par,x){shape=par[3]; scale=par[4]; loc=par[5]; dgamma(x-loc,shape,scale)}
cum=function(par,x){shape=par[3]; scale=par[4]; loc=par[5]; pgamma(x-loc,shape,scale)}
if (location=="FALSE"){
den=function(par,x){shape=par[3]; scale=par[4]; dgamma(x,shape,scale)}
cum=function(par,x){shape=par[3]; scale=par[4]; pgamma(x,shape,scale)}
}}
cdf0<-function(par,x){
f0=den(par,x)
c0=cum(par,x)
a=par[1]
b=par[2]
1-exp(-b*(c0/(1-c0))**a)
}
cdf<-cdf0(param,mydata)
if(log.p==TRUE & lower.tail == FALSE) cdf<-log(1-cdf)
if(log.p==TRUE & lower.tail == TRUE) cdf<-log(cdf)
if(log.p==FALSE & lower.tail == FALSE) cdf<-1-cdf
return(cdf)
}
dweibullextg<-function(mydata, g, param, location=TRUE, log=FALSE){
if(g!="birnbaum-saunders" & g!="exp" & g!="rayleigh" & g!="weibull" & g!="gompertz" & g!="gamma"
& g!="log-normal" & g!="chisq" & g!="f" & g!="burrxii" & g!="frechet"
& g!="lomax" & g!="log-logistic" & g!="lfr" & g!="chen")
{ stop ("Baseline distribution not implemented or misspelled. Please check the manual for guidelines.") }
if(g=="log-normal"){
den=function(par,x){meanlog=par[3]; sdlog=par[4]; loc=par[5]; dlnorm(x-loc,meanlog,sdlog)}
cum=function(par,x){meanlog=par[3]; sdlog=par[4]; loc=par[5]; plnorm(x-loc,meanlog,sdlog)}
if (location=="FALSE"){
den=function(par,x){meanlog=par[3]; sdlog=par[4]; dlnorm(x,meanlog,sdlog)}
cum=function(par,x){meanlog=par[3]; sdlog=par[4]; plnorm(x,meanlog,sdlog)}
}}
if(g=="chisq"){
den=function(par,x){df=par[3]; loc=par[4]; dchisq(x-loc,df)}
cum=function(par,x){df=par[3]; loc=par[4]; pchisq(x-loc,df)}
if (location=="FALSE"){
den=function(par,x){df=par[3]; dchisq(x,df)}
cum=function(par,x){df=par[3]; pchisq(x,df)}
}}
if(g=="f"){
den=function(par,x){df1=par[3]; df2=par[4]; loc=par[5]; df(x-loc,df1,df2)}
cum=function(par,x){df1=par[3]; df2=par[4]; loc=par[5]; pf(x-loc,df1,df2)}
if (location=="FALSE"){
den=function(par,x){df1=par[3]; df2=par[4]; df(x,df1,df2)}
cum=function(par,x){df1=par[3]; df2=par[4]; pf(x,df1,df2)}
}}
if(g=="chen"){
den=function(par,x){a=par[3]; b=par[4]; loc=par[5]; a*b*(x-loc)^(a-1)*exp((x-loc)^a)*exp(-b*(exp((x-loc)^a)-1))}
cum=function(par,x){a=par[3]; b=par[4]; loc=par[5]; 1-exp(-b*(exp((x-loc)^a)-1))}
if (location=="FALSE"){
den=function(par,x){a=par[3]; b=par[4]; a*b*(x)^(a-1)*exp((x)^a)*exp(-b*(exp((x)^a)-1))}
cum=function(par,x){a=par[3]; b=par[4]; 1-exp(-b*(exp((x)^a)-1))}
}}
if(g=="lfr"){
den=function(par,x){a=par[3]; b=par[4]; loc=par[5]; (a+b*(x-loc))*exp(-a*(x-loc)-(b*(x-loc)^2)/2)}
cum=function(par,x){a=par[3]; b=par[4]; loc=par[5]; 1-exp(-a*(x-loc)-(b*(x-loc)^2)/2)}
if (location=="FALSE"){
den=function(par,x){a=par[3]; b=par[4]; (a+b*(x))*exp(-a*(x)-(b*(x)^2)/2)}
cum=function(par,x){a=par[3]; b=par[4]; 1-exp(-a*(x)-(b*(x)^2)/2)}
}}
if(g=="log-logistic"){
den=function(par,x){a=par[3]; b=par[4]; loc=par[5]; (a*b^(-a)*(x-loc)^(a-1))/((((x-loc)/b)^a +1)^2)}
cum=function(par,x){a=par[3]; b=par[4]; loc=par[5]; 1/(((x-loc)/b)^(-a)+1)}
if (location=="FALSE"){
den=function(par,x){a=par[3]; b=par[4]; (a*b^(-a)*(x)^(a-1))/((((x)/b)^a +1)^2)}
cum=function(par,x){a=par[3]; b=par[4]; 1/(((x)/b)^(-a)+1)}
}}
if(g=="lomax"){
den=function(par,x){a=par[3]; b=par[4]; loc=par[5]; (a*b)/((1+a*(x-loc))^(b+1))}
cum=function(par,x){a=par[3]; b=par[4]; loc=par[5]; 1-(1+a*(x-loc))^(-b)}
if (location=="FALSE"){
den=function(par,x){a=par[3]; b=par[4]; (a*b)/((1+a*(x))^(b+1))}
cum=function(par,x){a=par[3]; b=par[4]; 1-(1+a*(x))^(-b)}
}}
if(g=="gompertz"){
den=function(par,x){a=par[3]; b=par[4]; loc=par[5]; b*exp(a*(x-loc))*exp(-(exp(a*(x-loc))-1)*b/a)}
cum=function(par,x){a=par[3]; b=par[4]; loc=par[5]; 1-exp(-(exp(a*(x-loc))-1)*b/a)}
if (location=="FALSE"){
den=function(par,x){a=par[3]; b=par[4]; b*exp(a*(x))*exp(-(exp(a*(x))-1)*b/a)}
cum=function(par,x){a=par[3]; b=par[4]; 1-exp(-(exp(a*(x))-1)*b/a)}
}}
if(g=="exp"){
den=function(par,x){rate=par[3]; loc=par[4]; dexp(x-loc,rate)}
cum=function(par,x){rate=par[3]; loc=par[4]; pexp(x-loc,rate)}
if (location=="FALSE"){
den=function(par,x){rate=par[3]; dexp(x,rate)}
cum=function(par,x){rate=par[3]; pexp(x,rate)}
}}
if(g=="rayleigh"){
den=function(par,x){a=par[3]; loc=par[4]; 2*(x-loc)/a*exp(-((x-loc)/a)^2)}
cum=function(par,x){a=par[3]; loc=par[4]; 1-exp(-((x-loc)/a)^2)}
if (location=="FALSE"){
den=function(par,x){a=par[3]; 2*x/a*exp(-(x/a)^2)}
cum=function(par,x){a=par[3]; 1-exp(-(x/a)^2)}
}}
if(g=="burrxii"){
den=function(par,x){a=par[3]; d=par[4]; loc=par[5]; d*a*(1+(x-loc)^d)^(-a-1)*((x-loc)^(d-1))}
cum=function(par,x){a=par[3]; d=par[4]; loc=par[5]; 1-(1+(x-loc)^d)^(-a)}
if (location=="FALSE"){
den=function(par,x){a=par[3]; d=par[4]; d*a*(1+(x)^d)^(-a-1)*((x)^(d-1))}
cum=function(par,x){a=par[3]; d=par[4]; 1-(1+(x)^d)^(-a)}
}}
if(g=="frechet"){
den=function(par,x){a=par[3]; b=par[4]; loc=par[5]; (a*exp(-((x-loc)/b)^(-a))*((x-loc)/b)^(-a-1))/(b)}
cum=function(par,x){a=par[3]; b=par[4]; loc=par[5]; exp(-((x-loc)/b)^(-a))}
if (location=="FALSE"){
den=function(par,x){a=par[3]; b=par[4]; (a*exp(-((x)/b)^(-a))*((x)/b)^(-a-1))/(b)}
cum=function(par,x){a=par[3]; b=par[4]; exp(-((x)/b)^(-a))}
}}
if(g=="birnbaum-saunders"){
den=function(par,x){a=par[3]; b=par[4]; loc=par[5]; (sqrt((x-loc)/b)+sqrt(b/(x-loc)))/(2*a*(x-loc))*dnorm((sqrt((x-loc)/b)-sqrt(b/(x-loc)))/a)}
cum=function(par,x){a=par[3]; b=par[4]; loc=par[5]; pnorm((sqrt((x-loc)/b)-sqrt(b/(x-loc)))/a)}
if (location=="FALSE"){
den=function(par,x){a=par[3]; b=par[4]; (sqrt((x)/b)+sqrt(b/(x)))/(2*a*(x))*dnorm((sqrt((x)/b)-sqrt(b/(x)))/a)}
cum=function(par,x){a=par[3]; b=par[4]; pnorm((sqrt((x)/b)-sqrt(b/(x)))/a)}
}}
if(g=="weibull"){
den=function(par,x){shape=par[3]; scale=par[4]; loc=par[5]; dweibull(x-loc,shape,scale)}
cum=function(par,x){shape=par[3]; scale=par[4]; loc=par[5]; pweibull(x-loc,shape,scale)}
if (location=="FALSE"){
den=function(par,x){shape=par[3]; scale=par[4]; dweibull(x,shape,scale)}
cum=function(par,x){shape=par[3]; scale=par[4]; pweibull(x,shape,scale)}
}}
if(g=="gamma"){
den=function(par,x){shape=par[3]; scale=par[4]; loc=par[5]; dgamma(x-loc,shape,scale)}
cum=function(par,x){shape=par[3]; scale=par[4]; loc=par[5]; pgamma(x-loc,shape,scale)}
if (location=="FALSE"){
den=function(par,x){shape=par[3]; scale=par[4]; dgamma(x,shape,scale)}
cum=function(par,x){shape=par[3]; scale=par[4]; pgamma(x,shape,scale)}
}}
pdf0<-function(par,x){
f0=den(par,x)
c0=cum(par,x)
a=par[1]
b=par[2]
a*b*f0*c0**(a-1)/((1-c0)**(a+1))*exp(-b*(c0/(1-c0))**a)
}
pdf<-pdf0(param,mydata)
if(log==TRUE){pdf<-log(pdf)}
return(pdf)
}
qmokumg<-function(p, g, param, location=TRUE, log.p = FALSE, lower.tail = TRUE){
if(g!="birnbaum-saunders" & g!="exp" & g!="rayleigh" & g!="weibull" & g!="gompertz" & g!="gamma"
& g!="log-normal" & g!="chisq" & g!="f" & g!="burrxii" & g!="frechet"
& g!="lomax" & g!="log-logistic" & g!="lfr" & g!="chen")
{ stop ("Baseline distribution not implemented or misspelled. Please check the manual for guidelines.") }
if(g=="log-normal"){
quan0=function(par,x){meanlog=par[4]; sdlog=par[5]; loc=par[6]; qlnorm(x,meanlog,sdlog)+loc}
if (location==FALSE){
quan0=function(par,x){meanlog=par[4]; sdlog=par[5]; qlnorm(x,meanlog,sdlog)}
}}
if(g=="chisq"){
quan0=function(par,x){df=par[4]; loc=par[5]; qchisq(x,df)+loc}
if (location==FALSE){
quan0=function(par,x){df=par[4]; qchisq(x,df)}
}}
if(g=="f"){
quan0=function(par,x){df1=par[4]; df2=par[5]; loc=par[6]; qf(x,df1,df2)+loc}
if (location==FALSE){
quan0=function(par,x){df1=par[4]; df2=par[5]; qf(x,df1,df2)}
}}
if(g=="chen"){
quan0=function(par,x){a=par[4]; b=par[5]; loc=par[6]; (log(1-log(1-x)/b))^(1/a)+loc}
if (location==FALSE){
quan0=function(par,x){a=par[4]; b=par[5]; (log(1-log(1-x)/b))^(1/a)}
}}
if(g=="lfr"){
quan0=function(par,x){a=par[4]; b=par[5]; loc=par[6]; (-a+sqrt(a^2-2*b*log(1-x)))/b+loc}
if (location==FALSE){
quan0=function(par,x){a=par[4]; b=par[5]; (-a+sqrt(a^2-2*b*log(1-x)))/b}
}}
if(g=="log-logistic"){
quan0=function(par,x){a=par[4]; b=par[5]; loc=par[6]; b*(1/x-1)^(-1/a)+loc}
if (location==FALSE){
quan0=function(par,x){a=par[4]; b=par[5]; b*(1/x-1)^(-1/a)}
}}
if(g=="lomax"){
quan0=function(par,x){a=par[4]; b=par[5]; loc=par[6]; ((1-x)^(-1/b)-1)/a+loc}
if (location==FALSE){
quan0=function(par,x){a=par[4]; b=par[5]; ((1-x)^(-1/b)-1)/a}
}}
if(g=="gompertz"){
quan0=function(par,x){a=par[4]; b=par[5]; loc=par[6]; log(1-a/b*log(1-x))/a+loc}
if (location==FALSE){
quan0=function(par,x){a=par[4]; b=par[5]; log(1-a/b*log(1-x))/a}
}}
if(g=="exp"){
quan0=function(par,x){rate=par[4]; loc=par[5]; qexp(x,rate)+loc}
if (location==FALSE){
quan0=function(par,x){rate=par[4]; qexp(x,rate)}
}}
if(g=="rayleigh"){
quan0=function(par,x){a=par[4]; loc=par[5]; a*(-log(1-x))^(1/2)+loc}
if (location==FALSE){
quan0=function(par,x){a=par[4]; a*(-log(1-x))^(1/2)}
}}
if(g=="burrxii"){
quan0=function(par,x){a=par[4]; d=par[5]; loc=par[6]; (1/(1-x)-1)^(1/d)+loc}
if (location==FALSE){
quan0=function(par,x){a=par[4]; d=par[5]; (1/(1-x)-1)^(1/d)}
}}
if(g=="frechet"){
quan0=function(par,x){a=par[4]; b=par[5]; loc=par[6]; b*(-log(x))^(-1/a)+loc}
if (location==FALSE){
quan0=function(par,x){a=par[4]; b=par[5]; b*(-log(x))^(-1/a)}
}}
if(g=="birnbaum-saunders"){
quan0=function(par,x){a=par[4]; b=par[5]; loc=par[6]; b/4*(a*qnorm(x)+sqrt((a*qnorm(x))^2+4))^2+loc}
if (location==FALSE){
quan0=function(par,x){a=par[4]; b=par[5]; b/4*(a*qnorm(x)+sqrt((a*qnorm(x))^2+4))^2}
}}
if(g=="weibull"){
quan0=function(par,x){shape=par[4]; scale=par[5]; loc=par[6]; qweibull(x,shape,scale)+loc}
if (location==FALSE){
quan0=function(par,x){shape=par[4]; scale=par[5]; qweibull(x,shape,scale)}
}}
if(g=="gamma"){
quan0=function(par,x){shape=par[4]; scale=par[5]; loc=par[6]; qgamma(x,shape,scale)+loc}
if (location==FALSE){
quan0=function(par,x){shape=par[4]; scale=par[5]; qgamma(x,shape,scale)}
}}
quan<-function(par,x){
a=par[1]
b=par[2]
d=par[3]
quan0(par,(1-((1-x)/(d+(1-d)*(1-x)))^(1/b))^(1/a))
}
out<-quan(param,p)
if(log.p==TRUE & lower.tail == FALSE) out<-quan(param,exp(p-1))
if(log.p==TRUE & lower.tail == TRUE) out<-quan(param,exp(-p))
if(log.p==FALSE & lower.tail == FALSE) out<-quan(param,1-p)
return(out)
}
rmokumg<-function(n, g, param, location=TRUE){
if(g!="birnbaum-saunders" & g!="exp" & g!="rayleigh" & g!="weibull" & g!="gompertz" & g!="gamma"
& g!="log-normal" & g!="chisq" & g!="f" & g!="burrxii" & g!="frechet"
& g!="lomax" & g!="log-logistic" & g!="lfr" & g!="chen")
{ stop ("Baseline distribution not implemented or misspelled. Please check the manual for guidelines.") }
if(n %% 1 !=0) { stop ("parameter n must be integer.") }
if(g=="log-normal"){
quan0=function(par,x){meanlog=par[4]; sdlog=par[5]; loc=par[6]; qlnorm(x,meanlog,sdlog)+loc}
if (location==FALSE){
quan0=function(par,x){meanlog=par[4]; sdlog=par[5]; qlnorm(x,meanlog,sdlog)}
}}
if(g=="chisq"){
quan0=function(par,x){df=par[4]; loc=par[5]; qchisq(x,df)+loc}
if (location==FALSE){
quan0=function(par,x){df=par[4]; qchisq(x,df)}
}}
if(g=="f"){
quan0=function(par,x){df1=par[4]; df2=par[5]; loc=par[6]; qf(x,df1,df2)+loc}
if (location==FALSE){
quan0=function(par,x){df1=par[4]; df2=par[5]; qf(x,df1,df2)}
}}
if(g=="chen"){
quan0=function(par,x){a=par[4]; b=par[5]; loc=par[6]; (log(1-log(1-x)/b))^(1/a)+loc}
if (location==FALSE){
quan0=function(par,x){a=par[4]; b=par[5]; (log(1-log(1-x)/b))^(1/a)}
}}
if(g=="lfr"){
quan0=function(par,x){a=par[4]; b=par[5]; loc=par[6]; (-a+sqrt(a^2-2*b*log(1-x)))/b+loc}
if (location==FALSE){
quan0=function(par,x){a=par[4]; b=par[5]; (-a+sqrt(a^2-2*b*log(1-x)))/b}
}}
if(g=="log-logistic"){
quan0=function(par,x){a=par[4]; b=par[5]; loc=par[6]; b*(1/x-1)^(-1/a)+loc}
if (location==FALSE){
quan0=function(par,x){a=par[4]; b=par[5]; b*(1/x-1)^(-1/a)}
}}
if(g=="lomax"){
quan0=function(par,x){a=par[4]; b=par[5]; loc=par[6]; ((1-x)^(-1/b)-1)/a+loc}
if (location==FALSE){
quan0=function(par,x){a=par[4]; b=par[5]; ((1-x)^(-1/b)-1)/a}
}}
if(g=="gompertz"){
quan0=function(par,x){a=par[4]; b=par[5]; loc=par[6]; log(1-a/b*log(1-x))/a+loc}
if (location==FALSE){
quan0=function(par,x){a=par[4]; b=par[5]; log(1-a/b*log(1-x))/a}
}}
if(g=="exp"){
quan0=function(par,x){rate=par[4]; loc=par[5]; qexp(x,rate)+loc}
if (location==FALSE){
quan0=function(par,x){rate=par[4]; qexp(x,rate)}
}}
if(g=="rayleigh"){
quan0=function(par,x){a=par[4]; loc=par[5]; a*(-log(1-x))^(1/2)+loc}
if (location==FALSE){
quan0=function(par,x){a=par[4]; a*(-log(1-x))^(1/2)}
}}
if(g=="burrxii"){
quan0=function(par,x){a=par[4]; d=par[5]; loc=par[6]; (1/(1-x)-1)^(1/d)+loc}
if (location==FALSE){
quan0=function(par,x){a=par[4]; d=par[5]; (1/(1-x)-1)^(1/d)}
}}
if(g=="frechet"){
quan0=function(par,x){a=par[4]; b=par[5]; loc=par[6]; b*(-log(x))^(-1/a)+loc}
if (location==FALSE){
quan0=function(par,x){a=par[4]; b=par[5]; b*(-log(x))^(-1/a)}
}}
if(g=="birnbaum-saunders"){
quan0=function(par,x){a=par[4]; b=par[5]; loc=par[6]; b/4*(a*qnorm(x)+sqrt((a*qnorm(x))^2+4))^2+loc}
if (location==FALSE){
quan0=function(par,x){a=par[4]; b=par[5]; b/4*(a*qnorm(x)+sqrt((a*qnorm(x))^2+4))^2}
}}
if(g=="weibull"){
quan0=function(par,x){shape=par[4]; scale=par[5]; loc=par[6]; qweibull(x,shape,scale)+loc}
if (location==FALSE){
quan0=function(par,x){shape=par[4]; scale=par[5]; qweibull(x,shape,scale)}
}}
if(g=="gamma"){
quan0=function(par,x){shape=par[4]; scale=par[5]; loc=par[6]; qgamma(x,shape,scale)+loc}
if (location==FALSE){
quan0=function(par,x){shape=par[4]; scale=par[5]; qgamma(x,shape,scale)}
}}
quan<-function(par,x){
a=par[1]
b=par[2]
d=par[3]
quan0(par,(1-((1-x)/(d+(1-d)*(1-x)))^(1/b))^(1/a))
}
return(quan(param,runif(n)))
}
qmbetag<-function(p, g, param, location=TRUE, log.p = FALSE, lower.tail = TRUE){
if(g!="birnbaum-saunders" & g!="exp" & g!="rayleigh" & g!="weibull" & g!="gompertz" & g!="gamma"
& g!="log-normal" & g!="chisq" & g!="f" & g!="burrxii" & g!="frechet"
& g!="lomax" & g!="log-logistic" & g!="lfr" & g!="chen")
{ stop ("Baseline distribution not implemented or misspelled. Please check the manual for guidelines.") }
if(g=="log-normal"){
quan0=function(par,x){meanlog=par[4]; sdlog=par[5]; loc=par[6]; qlnorm(x,meanlog,sdlog)+loc}
if (location==FALSE){
quan0=function(par,x){meanlog=par[4]; sdlog=par[5]; qlnorm(x,meanlog,sdlog)}
}}
if(g=="chisq"){
quan0=function(par,x){df=par[4]; loc=par[5]; qchisq(x,df)+loc}
if (location==FALSE){
quan0=function(par,x){df=par[4]; qchisq(x,df)}
}}
if(g=="f"){
quan0=function(par,x){df1=par[4]; df2=par[5]; loc=par[6]; qf(x,df1,df2)+loc}
if (location==FALSE){
quan0=function(par,x){df1=par[4]; df2=par[5]; qf(x,df1,df2)}
}}
if(g=="chen"){
quan0=function(par,x){a=par[4]; b=par[5]; loc=par[6]; (log(1-log(1-x)/b))^(1/a)+loc}
if (location==FALSE){
quan0=function(par,x){a=par[4]; b=par[5]; (log(1-log(1-x)/b))^(1/a)}
}}
if(g=="lfr"){
quan0=function(par,x){a=par[4]; b=par[5]; loc=par[6]; (-a+sqrt(a^2-2*b*log(1-x)))/b+loc}
if (location==FALSE){
quan0=function(par,x){a=par[4]; b=par[5]; (-a+sqrt(a^2-2*b*log(1-x)))/b}
}}
if(g=="log-logistic"){
quan0=function(par,x){a=par[4]; b=par[5]; loc=par[6]; b*(1/x-1)^(-1/a)+loc}
if (location==FALSE){
quan0=function(par,x){a=par[4]; b=par[5]; b*(1/x-1)^(-1/a)}
}}
if(g=="lomax"){
quan0=function(par,x){a=par[4]; b=par[5]; loc=par[6]; ((1-x)^(-1/b)-1)/a+loc}
if (location==FALSE){
quan0=function(par,x){a=par[4]; b=par[5]; ((1-x)^(-1/b)-1)/a}
}}
if(g=="gompertz"){
quan0=function(par,x){a=par[4]; b=par[5]; loc=par[6]; log(1-a/b*log(1-x))/a+loc}
if (location==FALSE){
quan0=function(par,x){a=par[4]; b=par[5]; log(1-a/b*log(1-x))/a}
}}
if(g=="exp"){
quan0=function(par,x){rate=par[4]; loc=par[5]; qexp(x,rate)+loc}
if (location==FALSE){
quan0=function(par,x){rate=par[4]; qexp(x,rate)}
}}
if(g=="rayleigh"){
quan0=function(par,x){a=par[4]; loc=par[5]; a*(-log(1-x))^(1/2)+loc}
if (location==FALSE){
quan0=function(par,x){a=par[4]; a*(-log(1-x))^(1/2)}
}}
if(g=="burrxii"){
quan0=function(par,x){a=par[4]; d=par[5]; loc=par[6]; (1/(1-x)-1)^(1/d)+loc}
if (location==FALSE){
quan0=function(par,x){a=par[4]; d=par[5]; (1/(1-x)-1)^(1/d)}
}}
if(g=="frechet"){
quan0=function(par,x){a=par[4]; b=par[5]; loc=par[6]; b*(-log(x))^(-1/a)+loc}
if (location==FALSE){
quan0=function(par,x){a=par[4]; b=par[5]; b*(-log(x))^(-1/a)}
}}
if(g=="birnbaum-saunders"){
quan0=function(par,x){a=par[4]; b=par[5]; loc=par[6]; b/4*(a*qnorm(x)+sqrt((a*qnorm(x))^2+4))^2+loc}
if (location==FALSE){
quan0=function(par,x){a=par[4]; b=par[5]; b/4*(a*qnorm(x)+sqrt((a*qnorm(x))^2+4))^2}
}}
if(g=="weibull"){
quan0=function(par,x){shape=par[4]; scale=par[5]; loc=par[6]; qweibull(x,shape,scale)+loc}
if (location==FALSE){
quan0=function(par,x){shape=par[4]; scale=par[5]; qweibull(x,shape,scale)}
}}
if(g=="gamma"){
quan0=function(par,x){shape=par[4]; scale=par[5]; loc=par[6]; qgamma(x,shape,scale)+loc}
if (location==FALSE){
quan0=function(par,x){shape=par[4]; scale=par[5]; qgamma(x,shape,scale)}
}}
quan<-function(par,x){
a=par[1]
b=par[2]
d=par[3]
quan0(par,qbeta(x,shape1=a,shape2=b)/(d+(1-d)*qbeta(x,shape1=a,shape2=b)))
}
out<-quan(param,p)
if(log.p==TRUE & lower.tail == FALSE) out<-quan(param,exp(p-1))
if(log.p==TRUE & lower.tail == TRUE) out<-quan(param,exp(-p))
if(log.p==FALSE & lower.tail == FALSE) out<-quan(param,1-p)
return(out)
}
rmbetag<-function(n, g, param, location=TRUE){
if(g!="birnbaum-saunders" & g!="exp" & g!="rayleigh" & g!="weibull" & g!="gompertz" & g!="gamma"
& g!="log-normal" & g!="chisq" & g!="f" & g!="burrxii" & g!="frechet"
& g!="lomax" & g!="log-logistic" & g!="lfr" & g!="chen")
{ stop ("Baseline distribution not implemented or misspelled. Please check the manual for guidelines.") }
if(n %% 1 !=0) { stop ("parameter n must be integer.") }
if(g=="log-normal"){
quan0=function(par,x){meanlog=par[4]; sdlog=par[5]; loc=par[6]; qlnorm(x,meanlog,sdlog)+loc}
if (location==FALSE){
quan0=function(par,x){meanlog=par[4]; sdlog=par[5]; qlnorm(x,meanlog,sdlog)}
}}
if(g=="chisq"){
quan0=function(par,x){df=par[4]; loc=par[5]; qchisq(x,df)+loc}
if (location==FALSE){
quan0=function(par,x){df=par[4]; qchisq(x,df)}
}}
if(g=="f"){
quan0=function(par,x){df1=par[4]; df2=par[5]; loc=par[6]; qf(x,df1,df2)+loc}
if (location==FALSE){
quan0=function(par,x){df1=par[4]; df2=par[5]; qf(x,df1,df2)}
}}
if(g=="chen"){
quan0=function(par,x){a=par[4]; b=par[5]; loc=par[6]; (log(1-log(1-x)/b))^(1/a)+loc}
if (location==FALSE){
quan0=function(par,x){a=par[4]; b=par[5]; (log(1-log(1-x)/b))^(1/a)}
}}
if(g=="lfr"){
quan0=function(par,x){a=par[4]; b=par[5]; loc=par[6]; (-a+sqrt(a^2-2*b*log(1-x)))/b+loc}
if (location==FALSE){
quan0=function(par,x){a=par[4]; b=par[5]; (-a+sqrt(a^2-2*b*log(1-x)))/b}
}}
if(g=="log-logistic"){
quan0=function(par,x){a=par[4]; b=par[5]; loc=par[6]; b*(1/x-1)^(-1/a)+loc}
if (location==FALSE){
quan0=function(par,x){a=par[4]; b=par[5]; b*(1/x-1)^(-1/a)}
}}
if(g=="lomax"){
quan0=function(par,x){a=par[4]; b=par[5]; loc=par[6]; ((1-x)^(-1/b)-1)/a+loc}
if (location==FALSE){
quan0=function(par,x){a=par[4]; b=par[5]; ((1-x)^(-1/b)-1)/a}
}}
if(g=="gompertz"){
quan0=function(par,x){a=par[4]; b=par[5]; loc=par[6]; log(1-a/b*log(1-x))/a+loc}
if (location==FALSE){
quan0=function(par,x){a=par[4]; b=par[5]; log(1-a/b*log(1-x))/a}
}}
if(g=="exp"){
quan0=function(par,x){rate=par[4]; loc=par[5]; qexp(x,rate)+loc}
if (location==FALSE){
quan0=function(par,x){rate=par[4]; qexp(x,rate)}
}}
if(g=="rayleigh"){
quan0=function(par,x){a=par[4]; loc=par[5]; a*(-log(1-x))^(1/2)+loc}
if (location==FALSE){
quan0=function(par,x){a=par[4]; a*(-log(1-x))^(1/2)}
}}
if(g=="burrxii"){
quan0=function(par,x){a=par[4]; d=par[5]; loc=par[6]; (1/(1-x)-1)^(1/d)+loc}
if (location==FALSE){
quan0=function(par,x){a=par[4]; d=par[5]; (1/(1-x)-1)^(1/d)}
}}
if(g=="frechet"){
quan0=function(par,x){a=par[4]; b=par[5]; loc=par[6]; b*(-log(x))^(-1/a)+loc}
if (location==FALSE){
quan0=function(par,x){a=par[4]; b=par[5]; b*(-log(x))^(-1/a)}
}}
if(g=="birnbaum-saunders"){
quan0=function(par,x){a=par[4]; b=par[5]; loc=par[6]; b/4*(a*qnorm(x)+sqrt((a*qnorm(x))^2+4))^2+loc}
if (location==FALSE){
quan0=function(par,x){a=par[4]; b=par[5]; b/4*(a*qnorm(x)+sqrt((a*qnorm(x))^2+4))^2}
}}
if(g=="weibull"){
quan0=function(par,x){shape=par[4]; scale=par[5]; loc=par[6]; qweibull(x,shape,scale)+loc}
if (location==FALSE){
quan0=function(par,x){shape=par[4]; scale=par[5]; qweibull(x,shape,scale)}
}}
if(g=="gamma"){
quan0=function(par,x){shape=par[4]; scale=par[5]; loc=par[6]; qgamma(x,shape,scale)+loc}
if (location==FALSE){
quan0=function(par,x){shape=par[4]; scale=par[5]; qgamma(x,shape,scale)}
}}
quan<-function(par,x){
a=par[1]
b=par[2]
d=par[3]
quan0(par,qbeta(x,shape1=a,shape2=b)/(d+(1-d)*qbeta(x,shape1=a,shape2=b)))
}
return(quan(param,runif(n)))
}
qgbetag<-function(p, g, param, location=TRUE, log.p = FALSE, lower.tail = TRUE){
if(g!="birnbaum-saunders" & g!="exp" & g!="rayleigh" & g!="weibull" & g!="gompertz" & g!="gamma"
& g!="log-normal" & g!="chisq" & g!="f" & g!="burrxii" & g!="frechet"
& g!="lomax" & g!="log-logistic" & g!="lfr" & g!="chen")
{ stop ("Baseline distribution not implemented or misspelled. Please check the manual for guidelines.") }
if(g=="log-normal"){
quan0=function(par,x){meanlog=par[4]; sdlog=par[5]; loc=par[6]; qlnorm(x,meanlog,sdlog)+loc}
if (location==FALSE){
quan0=function(par,x){meanlog=par[4]; sdlog=par[5]; qlnorm(x,meanlog,sdlog)}
}}
if(g=="chisq"){
quan0=function(par,x){df=par[4]; loc=par[5]; qchisq(x,df)+loc}
if (location==FALSE){
quan0=function(par,x){df=par[4]; qchisq(x,df)}
}}
if(g=="f"){
quan0=function(par,x){df1=par[4]; df2=par[5]; loc=par[6]; qf(x,df1,df2)+loc}
if (location==FALSE){
quan0=function(par,x){df1=par[4]; df2=par[5]; qf(x,df1,df2)}
}}
if(g=="chen"){
quan0=function(par,x){a=par[4]; b=par[5]; loc=par[6]; (log(1-log(1-x)/b))^(1/a)+loc}
if (location==FALSE){
quan0=function(par,x){a=par[4]; b=par[5]; (log(1-log(1-x)/b))^(1/a)}
}}
if(g=="lfr"){
quan0=function(par,x){a=par[4]; b=par[5]; loc=par[6]; (-a+sqrt(a^2-2*b*log(1-x)))/b+loc}
if (location==FALSE){
quan0=function(par,x){a=par[4]; b=par[5]; (-a+sqrt(a^2-2*b*log(1-x)))/b}
}}
if(g=="log-logistic"){
quan0=function(par,x){a=par[4]; b=par[5]; loc=par[6]; b*(1/x-1)^(-1/a)+loc}
if (location==FALSE){
quan0=function(par,x){a=par[4]; b=par[5]; b*(1/x-1)^(-1/a)}
}}
if(g=="lomax"){
quan0=function(par,x){a=par[4]; b=par[5]; loc=par[6]; ((1-x)^(-1/b)-1)/a+loc}
if (location==FALSE){
quan0=function(par,x){a=par[4]; b=par[5]; ((1-x)^(-1/b)-1)/a}
}}
if(g=="gompertz"){
quan0=function(par,x){a=par[4]; b=par[5]; loc=par[6]; log(1-a/b*log(1-x))/a+loc}
if (location==FALSE){
quan0=function(par,x){a=par[4]; b=par[5]; log(1-a/b*log(1-x))/a}
}}
if(g=="exp"){
quan0=function(par,x){rate=par[4]; loc=par[5]; qexp(x,rate)+loc}
if (location==FALSE){
quan0=function(par,x){rate=par[4]; qexp(x,rate)}
}}
if(g=="rayleigh"){
quan0=function(par,x){a=par[4]; loc=par[5]; a*(-log(1-x))^(1/2)+loc}
if (location==FALSE){
quan0=function(par,x){a=par[4]; a*(-log(1-x))^(1/2)}
}}
if(g=="burrxii"){
quan0=function(par,x){a=par[4]; d=par[5]; loc=par[6]; (1/(1-x)-1)^(1/d)+loc}
if (location==FALSE){
quan0=function(par,x){a=par[4]; d=par[5]; (1/(1-x)-1)^(1/d)}
}}
if(g=="frechet"){
quan0=function(par,x){a=par[4]; b=par[5]; loc=par[6]; b*(-log(x))^(-1/a)+loc}
if (location==FALSE){
quan0=function(par,x){a=par[4]; b=par[5]; b*(-log(x))^(-1/a)}
}}
if(g=="birnbaum-saunders"){
quan0=function(par,x){a=par[4]; b=par[5]; loc=par[6]; b/4*(a*qnorm(x)+sqrt((a*qnorm(x))^2+4))^2+loc}
if (location==FALSE){
quan0=function(par,x){a=par[4]; b=par[5]; b/4*(a*qnorm(x)+sqrt((a*qnorm(x))^2+4))^2}
}}
if(g=="weibull"){
quan0=function(par,x){shape=par[4]; scale=par[5]; loc=par[6]; qweibull(x,shape,scale)+loc}
if (location==FALSE){
quan0=function(par,x){shape=par[4]; scale=par[5]; qweibull(x,shape,scale)}
}}
if(g=="gamma"){
quan0=function(par,x){shape=par[4]; scale=par[5]; loc=par[6]; qgamma(x,shape,scale)+loc}
if (location==FALSE){
quan0=function(par,x){shape=par[4]; scale=par[5]; qgamma(x,shape,scale)}
}}
quan<-function(par,x){
a=par[1]
b=par[2]
d=par[3]
quan0(par,(qbeta(x,shape1=a,shape2=b))^(1/d))
}
out<-quan(param,p)
if(log.p==TRUE & lower.tail == FALSE) out<-quan(param,exp(p-1))
if(log.p==TRUE & lower.tail == TRUE) out<-quan(param,exp(-p))
if(log.p==FALSE & lower.tail == FALSE) out<-quan(param,1-p)
return(out)
}
rgbetag<-function(n, g, param, location=TRUE){
if(g!="birnbaum-saunders" & g!="exp" & g!="rayleigh" & g!="weibull" & g!="gompertz" & g!="gamma"
& g!="log-normal" & g!="chisq" & g!="f" & g!="burrxii" & g!="frechet"
& g!="lomax" & g!="log-logistic" & g!="lfr" & g!="chen")
{ stop ("Baseline distribution not implemented or misspelled. Please check the manual for guidelines.") }
if(n %% 1 !=0) { stop ("parameter n must be integer.") }
if(g=="log-normal"){
quan0=function(par,x){meanlog=par[4]; sdlog=par[5]; loc=par[6]; qlnorm(x,meanlog,sdlog)+loc}
if (location==FALSE){
quan0=function(par,x){meanlog=par[4]; sdlog=par[5]; qlnorm(x,meanlog,sdlog)}
}}
if(g=="chisq"){
quan0=function(par,x){df=par[4]; loc=par[5]; qchisq(x,df)+loc}
if (location==FALSE){
quan0=function(par,x){df=par[4]; qchisq(x,df)}
}}
if(g=="f"){
quan0=function(par,x){df1=par[4]; df2=par[5]; loc=par[6]; qf(x,df1,df2)+loc}
if (location==FALSE){
quan0=function(par,x){df1=par[4]; df2=par[5]; qf(x,df1,df2)}
}}
if(g=="chen"){
quan0=function(par,x){a=par[4]; b=par[5]; loc=par[6]; (log(1-log(1-x)/b))^(1/a)+loc}
if (location==FALSE){
quan0=function(par,x){a=par[4]; b=par[5]; (log(1-log(1-x)/b))^(1/a)}
}}
if(g=="lfr"){
quan0=function(par,x){a=par[4]; b=par[5]; loc=par[6]; (-a+sqrt(a^2-2*b*log(1-x)))/b+loc}
if (location==FALSE){
quan0=function(par,x){a=par[4]; b=par[5]; (-a+sqrt(a^2-2*b*log(1-x)))/b}
}}
if(g=="log-logistic"){
quan0=function(par,x){a=par[4]; b=par[5]; loc=par[6]; b*(1/x-1)^(-1/a)+loc}
if (location==FALSE){
quan0=function(par,x){a=par[4]; b=par[5]; b*(1/x-1)^(-1/a)}
}}
if(g=="lomax"){
quan0=function(par,x){a=par[4]; b=par[5]; loc=par[6]; ((1-x)^(-1/b)-1)/a+loc}
if (location==FALSE){
quan0=function(par,x){a=par[4]; b=par[5]; ((1-x)^(-1/b)-1)/a}
}}
if(g=="gompertz"){
quan0=function(par,x){a=par[4]; b=par[5]; loc=par[6]; log(1-a/b*log(1-x))/a+loc}
if (location==FALSE){
quan0=function(par,x){a=par[4]; b=par[5]; log(1-a/b*log(1-x))/a}
}}
if(g=="exp"){
quan0=function(par,x){rate=par[4]; loc=par[5]; qexp(x,rate)+loc}
if (location==FALSE){
quan0=function(par,x){rate=par[4]; qexp(x,rate)}
}}
if(g=="rayleigh"){
quan0=function(par,x){a=par[4]; loc=par[5]; a*(-log(1-x))^(1/2)+loc}
if (location==FALSE){
quan0=function(par,x){a=par[4]; a*(-log(1-x))^(1/2)}
}}
if(g=="burrxii"){
quan0=function(par,x){a=par[4]; d=par[5]; loc=par[6]; (1/(1-x)-1)^(1/d)+loc}
if (location==FALSE){
quan0=function(par,x){a=par[4]; d=par[5]; (1/(1-x)-1)^(1/d)}
}}
if(g=="frechet"){
quan0=function(par,x){a=par[4]; b=par[5]; loc=par[6]; b*(-log(x))^(-1/a)+loc}
if (location==FALSE){
quan0=function(par,x){a=par[4]; b=par[5]; b*(-log(x))^(-1/a)}
}}
if(g=="birnbaum-saunders"){
quan0=function(par,x){a=par[4]; b=par[5]; loc=par[6]; b/4*(a*qnorm(x)+sqrt((a*qnorm(x))^2+4))^2+loc}
if (location==FALSE){
quan0=function(par,x){a=par[4]; b=par[5]; b/4*(a*qnorm(x)+sqrt((a*qnorm(x))^2+4))^2}
}}
if(g=="weibull"){
quan0=function(par,x){shape=par[4]; scale=par[5]; loc=par[6]; qweibull(x,shape,scale)+loc}
if (location==FALSE){
quan0=function(par,x){shape=par[4]; scale=par[5]; qweibull(x,shape,scale)}
}}
if(g=="gamma"){
quan0=function(par,x){shape=par[4]; scale=par[5]; loc=par[6]; qgamma(x,shape,scale)+loc}
if (location==FALSE){
quan0=function(par,x){shape=par[4]; scale=par[5]; qgamma(x,shape,scale)}
}}
quan<-function(par,x){
a=par[1]
b=par[2]
d=par[3]
quan0(par,(qbeta(x,shape1=a,shape2=b))^(1/d))
}
return(quan(param,runif(n)))
}
qexpkumg<-function(p, g, param, location=TRUE, log.p = FALSE, lower.tail = TRUE){
if(g!="birnbaum-saunders" & g!="exp" & g!="rayleigh" & g!="weibull" & g!="gompertz" & g!="gamma"
& g!="log-normal" & g!="chisq" & g!="f" & g!="burrxii" & g!="frechet"
& g!="lomax" & g!="log-logistic" & g!="lfr" & g!="chen")
{ stop ("Baseline distribution not implemented or misspelled. Please check the manual for guidelines.") }
if(g=="log-normal"){
quan0=function(par,x){meanlog=par[4]; sdlog=par[5]; loc=par[6]; qlnorm(x,meanlog,sdlog)+loc}
if (location==FALSE){
quan0=function(par,x){meanlog=par[4]; sdlog=par[5]; qlnorm(x,meanlog,sdlog)}
}}
if(g=="chisq"){
quan0=function(par,x){df=par[4]; loc=par[5]; qchisq(x,df)+loc}
if (location==FALSE){
quan0=function(par,x){df=par[4]; qchisq(x,df)}
}}
if(g=="f"){
quan0=function(par,x){df1=par[4]; df2=par[5]; loc=par[6]; qf(x,df1,df2)+loc}
if (location==FALSE){
quan0=function(par,x){df1=par[4]; df2=par[5]; qf(x,df1,df2)}
}}
if(g=="chen"){
quan0=function(par,x){a=par[4]; b=par[5]; loc=par[6]; (log(1-log(1-x)/b))^(1/a)+loc}
if (location==FALSE){
quan0=function(par,x){a=par[4]; b=par[5]; (log(1-log(1-x)/b))^(1/a)}
}}
if(g=="lfr"){
quan0=function(par,x){a=par[4]; b=par[5]; loc=par[6]; (-a+sqrt(a^2-2*b*log(1-x)))/b+loc}
if (location==FALSE){
quan0=function(par,x){a=par[4]; b=par[5]; (-a+sqrt(a^2-2*b*log(1-x)))/b}
}}
if(g=="log-logistic"){
quan0=function(par,x){a=par[4]; b=par[5]; loc=par[6]; b*(1/x-1)^(-1/a)+loc}
if (location==FALSE){
quan0=function(par,x){a=par[4]; b=par[5]; b*(1/x-1)^(-1/a)}
}}
if(g=="lomax"){
quan0=function(par,x){a=par[4]; b=par[5]; loc=par[6]; ((1-x)^(-1/b)-1)/a+loc}
if (location==FALSE){
quan0=function(par,x){a=par[4]; b=par[5]; ((1-x)^(-1/b)-1)/a}
}}
if(g=="gompertz"){
quan0=function(par,x){a=par[4]; b=par[5]; loc=par[6]; log(1-a/b*log(1-x))/a+loc}
if (location==FALSE){
quan0=function(par,x){a=par[4]; b=par[5]; log(1-a/b*log(1-x))/a}
}}
if(g=="exp"){
quan0=function(par,x){rate=par[4]; loc=par[5]; qexp(x,rate)+loc}
if (location==FALSE){
quan0=function(par,x){rate=par[4]; qexp(x,rate)}
}}
if(g=="rayleigh"){
quan0=function(par,x){a=par[4]; loc=par[5]; a*(-log(1-x))^(1/2)+loc}
if (location==FALSE){
quan0=function(par,x){a=par[4]; a*(-log(1-x))^(1/2)}
}}
if(g=="burrxii"){
quan0=function(par,x){a=par[4]; d=par[5]; loc=par[6]; (1/(1-x)-1)^(1/d)+loc}
if (location==FALSE){
quan0=function(par,x){a=par[4]; d=par[5]; (1/(1-x)-1)^(1/d)}
}}
if(g=="frechet"){
quan0=function(par,x){a=par[4]; b=par[5]; loc=par[6]; b*(-log(x))^(-1/a)+loc}
if (location==FALSE){
quan0=function(par,x){a=par[4]; b=par[5]; b*(-log(x))^(-1/a)}
}}
if(g=="birnbaum-saunders"){
quan0=function(par,x){a=par[4]; b=par[5]; loc=par[6]; b/4*(a*qnorm(x)+sqrt((a*qnorm(x))^2+4))^2+loc}
if (location==FALSE){
quan0=function(par,x){a=par[4]; b=par[5]; b/4*(a*qnorm(x)+sqrt((a*qnorm(x))^2+4))^2}
}}
if(g=="weibull"){
quan0=function(par,x){shape=par[4]; scale=par[5]; loc=par[6]; qweibull(x,shape,scale)+loc}
if (location==FALSE){
quan0=function(par,x){shape=par[4]; scale=par[5]; qweibull(x,shape,scale)}
}}
if(g=="gamma"){
quan0=function(par,x){shape=par[4]; scale=par[5]; loc=par[6]; qgamma(x,shape,scale)+loc}
if (location==FALSE){
quan0=function(par,x){shape=par[4]; scale=par[5]; qgamma(x,shape,scale)}
}}
quan<-function(par,x){
a=par[1]
b=par[2]
d=par[3]
quan0(par,(1-(1-x^(1/d))^(1/b))^(1/a))
}
out<-quan(param,p)
if(log.p==TRUE & lower.tail == FALSE) out<-quan(param,exp(p-1))
if(log.p==TRUE & lower.tail == TRUE) out<-quan(param,exp(-p))
if(log.p==FALSE & lower.tail == FALSE) out<-quan(param,1-p)
return(out)
}
rexpkumg<-function(n, g, param, location=TRUE){
if(g!="birnbaum-saunders" & g!="exp" & g!="rayleigh" & g!="weibull" & g!="gompertz" & g!="gamma"
& g!="log-normal" & g!="chisq" & g!="f" & g!="burrxii" & g!="frechet"
& g!="lomax" & g!="log-logistic" & g!="lfr" & g!="chen")
{ stop ("Baseline distribution not implemented or misspelled. Please check the manual for guidelines.") }
if(n %% 1 !=0) { stop ("parameter n must be integer.") }
if(g=="log-normal"){
quan0=function(par,x){meanlog=par[4]; sdlog=par[5]; loc=par[6]; qlnorm(x,meanlog,sdlog)+loc}
if (location==FALSE){
quan0=function(par,x){meanlog=par[4]; sdlog=par[5]; qlnorm(x,meanlog,sdlog)}
}}
if(g=="chisq"){
quan0=function(par,x){df=par[4]; loc=par[5]; qchisq(x,df)+loc}
if (location==FALSE){
quan0=function(par,x){df=par[4]; qchisq(x,df)}
}}
if(g=="f"){
quan0=function(par,x){df1=par[4]; df2=par[5]; loc=par[6]; qf(x,df1,df2)+loc}
if (location==FALSE){
quan0=function(par,x){df1=par[4]; df2=par[5]; qf(x,df1,df2)}
}}
if(g=="chen"){
quan0=function(par,x){a=par[4]; b=par[5]; loc=par[6]; (log(1-log(1-x)/b))^(1/a)+loc}
if (location==FALSE){
quan0=function(par,x){a=par[4]; b=par[5]; (log(1-log(1-x)/b))^(1/a)}
}}
if(g=="lfr"){
quan0=function(par,x){a=par[4]; b=par[5]; loc=par[6]; (-a+sqrt(a^2-2*b*log(1-x)))/b+loc}
if (location==FALSE){
quan0=function(par,x){a=par[4]; b=par[5]; (-a+sqrt(a^2-2*b*log(1-x)))/b}
}}
if(g=="log-logistic"){
quan0=function(par,x){a=par[4]; b=par[5]; loc=par[6]; b*(1/x-1)^(-1/a)+loc}
if (location==FALSE){
quan0=function(par,x){a=par[4]; b=par[5]; b*(1/x-1)^(-1/a)}
}}
if(g=="lomax"){
quan0=function(par,x){a=par[4]; b=par[5]; loc=par[6]; ((1-x)^(-1/b)-1)/a+loc}
if (location==FALSE){
quan0=function(par,x){a=par[4]; b=par[5]; ((1-x)^(-1/b)-1)/a}
}}
if(g=="gompertz"){
quan0=function(par,x){a=par[4]; b=par[5]; loc=par[6]; log(1-a/b*log(1-x))/a+loc}
if (location==FALSE){
quan0=function(par,x){a=par[4]; b=par[5]; log(1-a/b*log(1-x))/a}
}}
if(g=="exp"){
quan0=function(par,x){rate=par[4]; loc=par[5]; qexp(x,rate)+loc}
if (location==FALSE){
quan0=function(par,x){rate=par[4]; qexp(x,rate)}
}}
if(g=="rayleigh"){
quan0=function(par,x){a=par[4]; loc=par[5]; a*(-log(1-x))^(1/2)+loc}
if (location==FALSE){
quan0=function(par,x){a=par[4]; a*(-log(1-x))^(1/2)}
}}
if(g=="burrxii"){
quan0=function(par,x){a=par[4]; d=par[5]; loc=par[6]; (1/(1-x)-1)^(1/d)+loc}
if (location==FALSE){
quan0=function(par,x){a=par[4]; d=par[5]; (1/(1-x)-1)^(1/d)}
}}
if(g=="frechet"){
quan0=function(par,x){a=par[4]; b=par[5]; loc=par[6]; b*(-log(x))^(-1/a)+loc}
if (location==FALSE){
quan0=function(par,x){a=par[4]; b=par[5]; b*(-log(x))^(-1/a)}
}}
if(g=="birnbaum-saunders"){
quan0=function(par,x){a=par[4]; b=par[5]; loc=par[6]; b/4*(a*qnorm(x)+sqrt((a*qnorm(x))^2+4))^2+loc}
if (location==FALSE){
quan0=function(par,x){a=par[4]; b=par[5]; b/4*(a*qnorm(x)+sqrt((a*qnorm(x))^2+4))^2}
}}
if(g=="weibull"){
quan0=function(par,x){shape=par[4]; scale=par[5]; loc=par[6]; qweibull(x,shape,scale)+loc}
if (location==FALSE){
quan0=function(par,x){shape=par[4]; scale=par[5]; qweibull(x,shape,scale)}
}}
if(g=="gamma"){
quan0=function(par,x){shape=par[4]; scale=par[5]; loc=par[6]; qgamma(x,shape,scale)+loc}
if (location==FALSE){
quan0=function(par,x){shape=par[4]; scale=par[5]; qgamma(x,shape,scale)}
}}
quan<-function(par,x){
a=par[1]
b=par[2]
d=par[3]
quan0(par,(1-(1-x^(1/d))^(1/b))^(1/a))
}
return(quan(param,runif(n)))
}
qbetaexpg<-function(p, g, param, location=TRUE, log.p = FALSE, lower.tail = TRUE){
if(g!="birnbaum-saunders" & g!="exp" & g!="rayleigh" & g!="weibull" & g!="gompertz" & g!="gamma"
& g!="log-normal" & g!="chisq" & g!="f" & g!="burrxii" & g!="frechet"
& g!="lomax" & g!="log-logistic" & g!="lfr" & g!="chen")
{ stop ("Baseline distribution not implemented or misspelled. Please check the manual for guidelines.") }
if(g=="log-normal"){
quan0=function(par,x){meanlog=par[4]; sdlog=par[5]; loc=par[6]; qlnorm(x,meanlog,sdlog)+loc}
if (location==FALSE){
quan0=function(par,x){meanlog=par[4]; sdlog=par[5]; qlnorm(x,meanlog,sdlog)}
}}
if(g=="chisq"){
quan0=function(par,x){df=par[4]; loc=par[5]; qchisq(x,df)+loc}
if (location==FALSE){
quan0=function(par,x){df=par[4]; qchisq(x,df)}
}}
if(g=="f"){
quan0=function(par,x){df1=par[4]; df2=par[5]; loc=par[6]; qf(x,df1,df2)+loc}
if (location==FALSE){
quan0=function(par,x){df1=par[4]; df2=par[5]; qf(x,df1,df2)}
}}
if(g=="chen"){
quan0=function(par,x){a=par[4]; b=par[5]; loc=par[6]; (log(1-log(1-x)/b))^(1/a)+loc}
if (location==FALSE){
quan0=function(par,x){a=par[4]; b=par[5]; (log(1-log(1-x)/b))^(1/a)}
}}
if(g=="lfr"){
quan0=function(par,x){a=par[4]; b=par[5]; loc=par[6]; (-a+sqrt(a^2-2*b*log(1-x)))/b+loc}
if (location==FALSE){
quan0=function(par,x){a=par[4]; b=par[5]; (-a+sqrt(a^2-2*b*log(1-x)))/b}
}}
if(g=="log-logistic"){
quan0=function(par,x){a=par[4]; b=par[5]; loc=par[6]; b*(1/x-1)^(-1/a)+loc}
if (location==FALSE){
quan0=function(par,x){a=par[4]; b=par[5]; b*(1/x-1)^(-1/a)}
}}
if(g=="lomax"){
quan0=function(par,x){a=par[4]; b=par[5]; loc=par[6]; ((1-x)^(-1/b)-1)/a+loc}
if (location==FALSE){
quan0=function(par,x){a=par[4]; b=par[5]; ((1-x)^(-1/b)-1)/a}
}}
if(g=="gompertz"){
quan0=function(par,x){a=par[4]; b=par[5]; loc=par[6]; log(1-a/b*log(1-x))/a+loc}
if (location==FALSE){
quan0=function(par,x){a=par[4]; b=par[5]; log(1-a/b*log(1-x))/a}
}}
if(g=="exp"){
quan0=function(par,x){rate=par[4]; loc=par[5]; qexp(x,rate)+loc}
if (location==FALSE){
quan0=function(par,x){rate=par[4]; qexp(x,rate)}
}}
if(g=="rayleigh"){
quan0=function(par,x){a=par[4]; loc=par[5]; a*(-log(1-x))^(1/2)+loc}
if (location==FALSE){
quan0=function(par,x){a=par[4]; a*(-log(1-x))^(1/2)}
}}
if(g=="burrxii"){
quan0=function(par,x){a=par[4]; d=par[5]; loc=par[6]; (1/(1-x)-1)^(1/d)+loc}
if (location==FALSE){
quan0=function(par,x){a=par[4]; d=par[5]; (1/(1-x)-1)^(1/d)}
}}
if(g=="frechet"){
quan0=function(par,x){a=par[4]; b=par[5]; loc=par[6]; b*(-log(x))^(-1/a)+loc}
if (location==FALSE){
quan0=function(par,x){a=par[4]; b=par[5]; b*(-log(x))^(-1/a)}
}}
if(g=="birnbaum-saunders"){
quan0=function(par,x){a=par[4]; b=par[5]; loc=par[6]; b/4*(a*qnorm(x)+sqrt((a*qnorm(x))^2+4))^2+loc}
if (location==FALSE){
quan0=function(par,x){a=par[4]; b=par[5]; b/4*(a*qnorm(x)+sqrt((a*qnorm(x))^2+4))^2}
}}
if(g=="weibull"){
quan0=function(par,x){shape=par[4]; scale=par[5]; loc=par[6]; qweibull(x,shape,scale)+loc}
if (location==FALSE){
quan0=function(par,x){shape=par[4]; scale=par[5]; qweibull(x,shape,scale)}
}}
if(g=="gamma"){
quan0=function(par,x){shape=par[4]; scale=par[5]; loc=par[6]; qgamma(x,shape,scale)+loc}
if (location==FALSE){
quan0=function(par,x){shape=par[4]; scale=par[5]; qgamma(x,shape,scale)}
}}
quan<-function(par,x){
a=par[1]
b=par[2]
d=par[3]
quan0(par,1-(qbeta(x,shape1=a,shape2=b))^(1/d))
}
out<-quan(param,p)
if(log.p==TRUE & lower.tail == FALSE) out<-quan(param,exp(p-1))
if(log.p==TRUE & lower.tail == TRUE) out<-quan(param,exp(-p))
if(log.p==FALSE & lower.tail == FALSE) out<-quan(param,1-p)
return(out)
}
rbetaexpg<-function(n, g, param, location=TRUE){
if(g!="birnbaum-saunders" & g!="exp" & g!="rayleigh" & g!="weibull" & g!="gompertz" & g!="gamma"
& g!="log-normal" & g!="chisq" & g!="f" & g!="burrxii" & g!="frechet"
& g!="lomax" & g!="log-logistic" & g!="lfr" & g!="chen")
{ stop ("Baseline distribution not implemented or misspelled. Please check the manual for guidelines.") }
if(n %% 1 !=0) { stop ("parameter n must be integer.") }
if(g=="log-normal"){
quan0=function(par,x){meanlog=par[4]; sdlog=par[5]; loc=par[6]; qlnorm(x,meanlog,sdlog)+loc}
if (location==FALSE){
quan0=function(par,x){meanlog=par[4]; sdlog=par[5]; qlnorm(x,meanlog,sdlog)}
}}
if(g=="chisq"){
quan0=function(par,x){df=par[4]; loc=par[5]; qchisq(x,df)+loc}
if (location==FALSE){
quan0=function(par,x){df=par[4]; qchisq(x,df)}
}}
if(g=="f"){
quan0=function(par,x){df1=par[4]; df2=par[5]; loc=par[6]; qf(x,df1,df2)+loc}
if (location==FALSE){
quan0=function(par,x){df1=par[4]; df2=par[5]; qf(x,df1,df2)}
}}
if(g=="chen"){
quan0=function(par,x){a=par[4]; b=par[5]; loc=par[6]; (log(1-log(1-x)/b))^(1/a)+loc}
if (location==FALSE){
quan0=function(par,x){a=par[4]; b=par[5]; (log(1-log(1-x)/b))^(1/a)}
}}
if(g=="lfr"){
quan0=function(par,x){a=par[4]; b=par[5]; loc=par[6]; (-a+sqrt(a^2-2*b*log(1-x)))/b+loc}
if (location==FALSE){
quan0=function(par,x){a=par[4]; b=par[5]; (-a+sqrt(a^2-2*b*log(1-x)))/b}
}}
if(g=="log-logistic"){
quan0=function(par,x){a=par[4]; b=par[5]; loc=par[6]; b*(1/x-1)^(-1/a)+loc}
if (location==FALSE){
quan0=function(par,x){a=par[4]; b=par[5]; b*(1/x-1)^(-1/a)}
}}
if(g=="lomax"){
quan0=function(par,x){a=par[4]; b=par[5]; loc=par[6]; ((1-x)^(-1/b)-1)/a+loc}
if (location==FALSE){
quan0=function(par,x){a=par[4]; b=par[5]; ((1-x)^(-1/b)-1)/a}
}}
if(g=="gompertz"){
quan0=function(par,x){a=par[4]; b=par[5]; loc=par[6]; log(1-a/b*log(1-x))/a+loc}
if (location==FALSE){
quan0=function(par,x){a=par[4]; b=par[5]; log(1-a/b*log(1-x))/a}
}}
if(g=="exp"){
quan0=function(par,x){rate=par[4]; loc=par[5]; qexp(x,rate)+loc}
if (location==FALSE){
quan0=function(par,x){rate=par[4]; qexp(x,rate)}
}}
if(g=="rayleigh"){
quan0=function(par,x){a=par[4]; loc=par[5]; a*(-log(1-x))^(1/2)+loc}
if (location==FALSE){
quan0=function(par,x){a=par[4]; a*(-log(1-x))^(1/2)}
}}
if(g=="burrxii"){
quan0=function(par,x){a=par[4]; d=par[5]; loc=par[6]; (1/(1-x)-1)^(1/d)+loc}
if (location==FALSE){
quan0=function(par,x){a=par[4]; d=par[5]; (1/(1-x)-1)^(1/d)}
}}
if(g=="frechet"){
quan0=function(par,x){a=par[4]; b=par[5]; loc=par[6]; b*(-log(x))^(-1/a)+loc}
if (location==FALSE){
quan0=function(par,x){a=par[4]; b=par[5]; b*(-log(x))^(-1/a)}
}}
if(g=="birnbaum-saunders"){
quan0=function(par,x){a=par[4]; b=par[5]; loc=par[6]; b/4*(a*qnorm(x)+sqrt((a*qnorm(x))^2+4))^2+loc}
if (location==FALSE){
quan0=function(par,x){a=par[4]; b=par[5]; b/4*(a*qnorm(x)+sqrt((a*qnorm(x))^2+4))^2}
}}
if(g=="weibull"){
quan0=function(par,x){shape=par[4]; scale=par[5]; loc=par[6]; qweibull(x,shape,scale)+loc}
if (location==FALSE){
quan0=function(par,x){shape=par[4]; scale=par[5]; qweibull(x,shape,scale)}
}}
if(g=="gamma"){
quan0=function(par,x){shape=par[4]; scale=par[5]; loc=par[6]; qgamma(x,shape,scale)+loc}
if (location==FALSE){
quan0=function(par,x){shape=par[4]; scale=par[5]; qgamma(x,shape,scale)}
}}
quan<-function(par,x){
a=par[1]
b=par[2]
d=par[3]
quan0(par,1-(qbeta(x,shape1=a,shape2=b))^(1/d))
}
return(quan(param,runif(n)))
}
qologlogg<-function(p, g, param, location=TRUE, log.p = FALSE, lower.tail = TRUE){
if(g!="birnbaum-saunders" & g!="exp" & g!="rayleigh" & g!="weibull" & g!="gompertz" & g!="gamma"
& g!="log-normal" & g!="chisq" & g!="f" & g!="burrxii" & g!="frechet"
& g!="lomax" & g!="log-logistic" & g!="lfr" & g!="chen")
{ stop ("Baseline distribution not implemented or misspelled. Please check the manual for guidelines.") }
if(g=="log-normal"){
quan0=function(par,x){meanlog=par[4]; sdlog=par[5]; loc=par[6]; qlnorm(x,meanlog,sdlog)+loc}
if (location==FALSE){
quan0=function(par,x){meanlog=par[4]; sdlog=par[5]; qlnorm(x,meanlog,sdlog)}
}}
if(g=="chisq"){
quan0=function(par,x){df=par[4]; loc=par[5]; qchisq(x,df)+loc}
if (location==FALSE){
quan0=function(par,x){df=par[4]; qchisq(x,df)}
}}
if(g=="f"){
quan0=function(par,x){df1=par[4]; df2=par[5]; loc=par[6]; qf(x,df1,df2)+loc}
if (location==FALSE){
quan0=function(par,x){df1=par[4]; df2=par[5]; qf(x,df1,df2)}
}}
if(g=="chen"){
quan0=function(par,x){a=par[4]; b=par[5]; loc=par[6]; (log(1-log(1-x)/b))^(1/a)+loc}
if (location==FALSE){
quan0=function(par,x){a=par[4]; b=par[5]; (log(1-log(1-x)/b))^(1/a)}
}}
if(g=="lfr"){
quan0=function(par,x){a=par[4]; b=par[5]; loc=par[6]; (-a+sqrt(a^2-2*b*log(1-x)))/b+loc}
if (location==FALSE){
quan0=function(par,x){a=par[4]; b=par[5]; (-a+sqrt(a^2-2*b*log(1-x)))/b}
}}
if(g=="log-logistic"){
quan0=function(par,x){a=par[4]; b=par[5]; loc=par[6]; b*(1/x-1)^(-1/a)+loc}
if (location==FALSE){
quan0=function(par,x){a=par[4]; b=par[5]; b*(1/x-1)^(-1/a)}
}}
if(g=="lomax"){
quan0=function(par,x){a=par[4]; b=par[5]; loc=par[6]; ((1-x)^(-1/b)-1)/a+loc}
if (location==FALSE){
quan0=function(par,x){a=par[4]; b=par[5]; ((1-x)^(-1/b)-1)/a}
}}
if(g=="gompertz"){
quan0=function(par,x){a=par[4]; b=par[5]; loc=par[6]; log(1-a/b*log(1-x))/a+loc}
if (location==FALSE){
quan0=function(par,x){a=par[4]; b=par[5]; log(1-a/b*log(1-x))/a}
}}
if(g=="exp"){
quan0=function(par,x){rate=par[4]; loc=par[5]; qexp(x,rate)+loc}
if (location==FALSE){
quan0=function(par,x){rate=par[4]; qexp(x,rate)}
}}
if(g=="rayleigh"){
quan0=function(par,x){a=par[4]; loc=par[5]; a*(-log(1-x))^(1/2)+loc}
if (location==FALSE){
quan0=function(par,x){a=par[4]; a*(-log(1-x))^(1/2)}
}}
if(g=="burrxii"){
quan0=function(par,x){a=par[4]; d=par[5]; loc=par[6]; (1/(1-x)-1)^(1/d)+loc}
if (location==FALSE){
quan0=function(par,x){a=par[4]; d=par[5]; (1/(1-x)-1)^(1/d)}
}}
if(g=="frechet"){
quan0=function(par,x){a=par[4]; b=par[5]; loc=par[6]; b*(-log(x))^(-1/a)+loc}
if (location==FALSE){
quan0=function(par,x){a=par[4]; b=par[5]; b*(-log(x))^(-1/a)}
}}
if(g=="birnbaum-saunders"){
quan0=function(par,x){a=par[4]; b=par[5]; loc=par[6]; b/4*(a*qnorm(x)+sqrt((a*qnorm(x))^2+4))^2+loc}
if (location==FALSE){
quan0=function(par,x){a=par[4]; b=par[5]; b/4*(a*qnorm(x)+sqrt((a*qnorm(x))^2+4))^2}
}}
if(g=="weibull"){
quan0=function(par,x){shape=par[4]; scale=par[5]; loc=par[6]; qweibull(x,shape,scale)+loc}
if (location==FALSE){
quan0=function(par,x){shape=par[4]; scale=par[5]; qweibull(x,shape,scale)}
}}
if(g=="gamma"){
quan0=function(par,x){shape=par[4]; scale=par[5]; loc=par[6]; qgamma(x,shape,scale)+loc}
if (location==FALSE){
quan0=function(par,x){shape=par[4]; scale=par[5]; qgamma(x,shape,scale)}
}}
quan<-function(par,x){
a=par[1]
b=par[2]
d=par[3]
quan0(par,(((1-(1-(1-x)^(1/b))^(1/a))/(1-(1-x)^(1/b))^(1/a))^(1/d))/(1+((1-(1-(1-x)^(1/b))^(1/a))/(1-(1-x)^(1/b))^(1/a))^(1/d)))
}
out<-quan(param,p)
if(log.p==TRUE & lower.tail == FALSE) out<-quan(param,exp(p-1))
if(log.p==TRUE & lower.tail == TRUE) out<-quan(param,exp(-p))
if(log.p==FALSE & lower.tail == FALSE) out<-quan(param,1-p)
return(out)
}
rologlogg<-function(n, g, param, location=TRUE){
if(g!="birnbaum-saunders" & g!="exp" & g!="rayleigh" & g!="weibull" & g!="gompertz" & g!="gamma"
& g!="log-normal" & g!="chisq" & g!="f" & g!="burrxii" & g!="frechet"
& g!="lomax" & g!="log-logistic" & g!="lfr" & g!="chen")
{ stop ("Baseline distribution not implemented or misspelled. Please check the manual for guidelines.") }
if(n %% 1 !=0) { stop ("parameter n must be integer.") }
if(g=="log-normal"){
quan0=function(par,x){meanlog=par[4]; sdlog=par[5]; loc=par[6]; qlnorm(x,meanlog,sdlog)+loc}
if (location==FALSE){
quan0=function(par,x){meanlog=par[4]; sdlog=par[5]; qlnorm(x,meanlog,sdlog)}
}}
if(g=="chisq"){
quan0=function(par,x){df=par[4]; loc=par[5]; qchisq(x,df)+loc}
if (location==FALSE){
quan0=function(par,x){df=par[4]; qchisq(x,df)}
}}
if(g=="f"){
quan0=function(par,x){df1=par[4]; df2=par[5]; loc=par[6]; qf(x,df1,df2)+loc}
if (location==FALSE){
quan0=function(par,x){df1=par[4]; df2=par[5]; qf(x,df1,df2)}
}}
if(g=="chen"){
quan0=function(par,x){a=par[4]; b=par[5]; loc=par[6]; (log(1-log(1-x)/b))^(1/a)+loc}
if (location==FALSE){
quan0=function(par,x){a=par[4]; b=par[5]; (log(1-log(1-x)/b))^(1/a)}
}}
if(g=="lfr"){
quan0=function(par,x){a=par[4]; b=par[5]; loc=par[6]; (-a+sqrt(a^2-2*b*log(1-x)))/b+loc}
if (location==FALSE){
quan0=function(par,x){a=par[4]; b=par[5]; (-a+sqrt(a^2-2*b*log(1-x)))/b}
}}
if(g=="log-logistic"){
quan0=function(par,x){a=par[4]; b=par[5]; loc=par[6]; b*(1/x-1)^(-1/a)+loc}
if (location==FALSE){
quan0=function(par,x){a=par[4]; b=par[5]; b*(1/x-1)^(-1/a)}
}}
if(g=="lomax"){
quan0=function(par,x){a=par[4]; b=par[5]; loc=par[6]; ((1-x)^(-1/b)-1)/a+loc}
if (location==FALSE){
quan0=function(par,x){a=par[4]; b=par[5]; ((1-x)^(-1/b)-1)/a}
}}
if(g=="gompertz"){
quan0=function(par,x){a=par[4]; b=par[5]; loc=par[6]; log(1-a/b*log(1-x))/a+loc}
if (location==FALSE){
quan0=function(par,x){a=par[4]; b=par[5]; log(1-a/b*log(1-x))/a}
}}
if(g=="exp"){
quan0=function(par,x){rate=par[4]; loc=par[5]; qexp(x,rate)+loc}
if (location==FALSE){
quan0=function(par,x){rate=par[4]; qexp(x,rate)}
}}
if(g=="rayleigh"){
quan0=function(par,x){a=par[4]; loc=par[5]; a*(-log(1-x))^(1/2)+loc}
if (location==FALSE){
quan0=function(par,x){a=par[4]; a*(-log(1-x))^(1/2)}
}}
if(g=="burrxii"){
quan0=function(par,x){a=par[4]; d=par[5]; loc=par[6]; (1/(1-x)-1)^(1/d)+loc}
if (location==FALSE){
quan0=function(par,x){a=par[4]; d=par[5]; (1/(1-x)-1)^(1/d)}
}}
if(g=="frechet"){
quan0=function(par,x){a=par[4]; b=par[5]; loc=par[6]; b*(-log(x))^(-1/a)+loc}
if (location==FALSE){
quan0=function(par,x){a=par[4]; b=par[5]; b*(-log(x))^(-1/a)}
}}
if(g=="birnbaum-saunders"){
quan0=function(par,x){a=par[4]; b=par[5]; loc=par[6]; b/4*(a*qnorm(x)+sqrt((a*qnorm(x))^2+4))^2+loc}
if (location==FALSE){
quan0=function(par,x){a=par[4]; b=par[5]; b/4*(a*qnorm(x)+sqrt((a*qnorm(x))^2+4))^2}
}}
if(g=="weibull"){
quan0=function(par,x){shape=par[4]; scale=par[5]; loc=par[6]; qweibull(x,shape,scale)+loc}
if (location==FALSE){
quan0=function(par,x){shape=par[4]; scale=par[5]; qweibull(x,shape,scale)}
}}
if(g=="gamma"){
quan0=function(par,x){shape=par[4]; scale=par[5]; loc=par[6]; qgamma(x,shape,scale)+loc}
if (location==FALSE){
quan0=function(par,x){shape=par[4]; scale=par[5]; qgamma(x,shape,scale)}
}}
quan<-function(par,x){
a=par[1]
b=par[2]
d=par[3]
quan0(par,(((1-(1-(1-x)^(1/b))^(1/a))/(1-(1-x)^(1/b))^(1/a))^(1/d))/(1+((1-(1-(1-x)^(1/b))^(1/a))/(1-(1-x)^(1/b))^(1/a))^(1/d)))
}
return(quan(param,runif(n)))
}
qweibullextg<-function(p, g, param, location=TRUE, log.p = FALSE, lower.tail = TRUE){
if(g!="birnbaum-saunders" & g!="exp" & g!="rayleigh" & g!="weibull" & g!="gompertz" & g!="gamma"
& g!="log-normal" & g!="chisq" & g!="f" & g!="burrxii" & g!="frechet"
& g!="lomax" & g!="log-logistic" & g!="lfr" & g!="chen")
{ stop ("Baseline distribution not implemented or misspelled. Please check the manual for guidelines.") }
if(g=="log-normal"){
quan0=function(par,x){meanlog=par[3]; sdlog=par[4]; loc=par[5]; qlnorm(x,meanlog,sdlog)+loc}
if (location==FALSE){
quan0=function(par,x){meanlog=par[3]; sdlog=par[4]; qlnorm(x,meanlog,sdlog)}
}}
if(g=="chisq"){
quan0=function(par,x){df=par[3]; loc=par[4]; qchisq(x,df)+loc}
if (location==FALSE){
quan0=function(par,x){df=par[3]; qchisq(x,df)}
}}
if(g=="f"){
quan0=function(par,x){df1=par[3]; df2=par[4]; loc=par[5]; qf(x,df1,df2)+loc}
if (location==FALSE){
quan0=function(par,x){df1=par[3]; df2=par[4]; qf(x,df1,df2)}
}}
if(g=="chen"){
quan0=function(par,x){a=par[3]; b=par[4]; loc=par[5]; (log(1-log(1-x)/b))^(1/a)+loc}
if (location==FALSE){
quan0=function(par,x){a=par[3]; b=par[4]; (log(1-log(1-x)/b))^(1/a)}
}}
if(g=="lfr"){
quan0=function(par,x){a=par[3]; b=par[4]; loc=par[5]; (-a+sqrt(a^2-2*b*log(1-x)))/b+loc}
if (location==FALSE){
quan0=function(par,x){a=par[3]; b=par[4]; (-a+sqrt(a^2-2*b*log(1-x)))/b}
}}
if(g=="log-logistic"){
quan0=function(par,x){a=par[3]; b=par[4]; loc=par[5]; b*(1/x-1)^(-1/a)+loc}
if (location==FALSE){
quan0=function(par,x){a=par[3]; b=par[4]; b*(1/x-1)^(-1/a)}
}}
if(g=="lomax"){
quan0=function(par,x){a=par[3]; b=par[4]; loc=par[5]; ((1-x)^(-1/b)-1)/a+loc}
if (location==FALSE){
quan0=function(par,x){a=par[3]; b=par[4]; ((1-x)^(-1/b)-1)/a}
}}
if(g=="gompertz"){
quan0=function(par,x){a=par[3]; b=par[4]; loc=par[5]; log(1-a/b*log(1-x))/a+loc}
if (location==FALSE){
quan0=function(par,x){a=par[3]; b=par[4]; log(1-a/b*log(1-x))/a}
}}
if(g=="exp"){
quan0=function(par,x){rate=par[3]; loc=par[4]; qexp(x,rate)+loc}
if (location==FALSE){
quan0=function(par,x){rate=par[3]; qexp(x,rate)}
}}
if(g=="rayleigh"){
quan0=function(par,x){a=par[3]; loc=par[4]; a*(-log(1-x))^(1/2)+loc}
if (location==FALSE){
quan0=function(par,x){a=par[3]; a*(-log(1-x))^(1/2)}
}}
if(g=="burrxii"){
quan0=function(par,x){a=par[3]; d=par[4]; loc=par[5]; (1/(1-x)-1)^(1/d)+loc}
if (location==FALSE){
quan0=function(par,x){a=par[3]; d=par[4]; (1/(1-x)-1)^(1/d)}
}}
if(g=="frechet"){
quan0=function(par,x){a=par[3]; b=par[4]; loc=par[5]; b*(-log(x))^(-1/a)+loc}
if (location==FALSE){
quan0=function(par,x){a=par[3]; b=par[4]; b*(-log(x))^(-1/a)}
}}
if(g=="birnbaum-saunders"){
quan0=function(par,x){a=par[3]; b=par[4]; loc=par[5]; b/4*(a*qnorm(x)+sqrt((a*qnorm(x))^2+4))^2+loc}
if (location==FALSE){
quan0=function(par,x){a=par[3]; b=par[4]; b/4*(a*qnorm(x)+sqrt((a*qnorm(x))^2+4))^2}
}}
if(g=="weibull"){
quan0=function(par,x){shape=par[3]; scale=par[4]; loc=par[5]; qweibull(x,shape,scale)+loc}
if (location==FALSE){
quan0=function(par,x){shape=par[3]; scale=par[4]; qweibull(x,shape,scale)}
}}
if(g=="gamma"){
quan0=function(par,x){shape=par[3]; scale=par[4]; loc=par[5]; qgamma(x,shape,scale)+loc}
if (location==FALSE){
quan0=function(par,x){shape=par[3]; scale=par[4]; qgamma(x,shape,scale)}
}}
quan<-function(par,x){
a=par[1]
b=par[2]
quan0(par,(-log(1-x)/b)^(1/a)/(1+(-log(1-x)/b)^(1/a)))
}
out<-quan(param,p)
if(log.p==TRUE & lower.tail == FALSE) out<-quan(param,exp(p-1))
if(log.p==TRUE & lower.tail == TRUE) out<-quan(param,exp(-p))
if(log.p==FALSE & lower.tail == FALSE) out<-quan(param,1-p)
return(out)
}
rweibullextg<-function(n, g, param, location=TRUE){
if(g!="birnbaum-saunders" & g!="exp" & g!="rayleigh" & g!="weibull" & g!="gompertz" & g!="gamma"
& g!="log-normal" & g!="chisq" & g!="f" & g!="burrxii" & g!="frechet"
& g!="lomax" & g!="log-logistic" & g!="lfr" & g!="chen")
{ stop ("Baseline distribution not implemented or misspelled. Please check the manual for guidelines.") }
if(n %% 1 !=0) { stop ("parameter n must be integer.") }
if(g=="log-normal"){
quan0=function(par,x){meanlog=par[3]; sdlog=par[4]; loc=par[5]; qlnorm(x,meanlog,sdlog)+loc}
if (location==FALSE){
quan0=function(par,x){meanlog=par[3]; sdlog=par[4]; qlnorm(x,meanlog,sdlog)}
}}
if(g=="chisq"){
quan0=function(par,x){df=par[3]; loc=par[4]; qchisq(x,df)+loc}
if (location==FALSE){
quan0=function(par,x){df=par[3]; qchisq(x,df)}
}}
if(g=="f"){
quan0=function(par,x){df1=par[3]; df2=par[4]; loc=par[5]; qf(x,df1,df2)+loc}
if (location==FALSE){
quan0=function(par,x){df1=par[3]; df2=par[4]; qf(x,df1,df2)}
}}
if(g=="chen"){
quan0=function(par,x){a=par[3]; b=par[4]; loc=par[5]; (log(1-log(1-x)/b))^(1/a)+loc}
if (location==FALSE){
quan0=function(par,x){a=par[3]; b=par[4]; (log(1-log(1-x)/b))^(1/a)}
}}
if(g=="lfr"){
quan0=function(par,x){a=par[3]; b=par[4]; loc=par[5]; (-a+sqrt(a^2-2*b*log(1-x)))/b+loc}
if (location==FALSE){
quan0=function(par,x){a=par[3]; b=par[4]; (-a+sqrt(a^2-2*b*log(1-x)))/b}
}}
if(g=="log-logistic"){
quan0=function(par,x){a=par[3]; b=par[4]; loc=par[5]; b*(1/x-1)^(-1/a)+loc}
if (location==FALSE){
quan0=function(par,x){a=par[3]; b=par[4]; b*(1/x-1)^(-1/a)}
}}
if(g=="lomax"){
quan0=function(par,x){a=par[3]; b=par[4]; loc=par[5]; ((1-x)^(-1/b)-1)/a+loc}
if (location==FALSE){
quan0=function(par,x){a=par[3]; b=par[4]; ((1-x)^(-1/b)-1)/a}
}}
if(g=="gompertz"){
quan0=function(par,x){a=par[3]; b=par[4]; loc=par[5]; log(1-a/b*log(1-x))/a+loc}
if (location==FALSE){
quan0=function(par,x){a=par[3]; b=par[4]; log(1-a/b*log(1-x))/a}
}}
if(g=="exp"){
quan0=function(par,x){rate=par[3]; loc=par[4]; qexp(x,rate)+loc}
if (location==FALSE){
quan0=function(par,x){rate=par[3]; qexp(x,rate)}
}}
if(g=="rayleigh"){
quan0=function(par,x){a=par[3]; loc=par[4]; a*(-log(1-x))^(1/2)+loc}
if (location==FALSE){
quan0=function(par,x){a=par[3]; a*(-log(1-x))^(1/2)}
}}
if(g=="burrxii"){
quan0=function(par,x){a=par[3]; d=par[4]; loc=par[5]; (1/(1-x)-1)^(1/d)+loc}
if (location==FALSE){
quan0=function(par,x){a=par[3]; d=par[4]; (1/(1-x)-1)^(1/d)}
}}
if(g=="frechet"){
quan0=function(par,x){a=par[3]; b=par[4]; loc=par[5]; b*(-log(x))^(-1/a)+loc}
if (location==FALSE){
quan0=function(par,x){a=par[3]; b=par[4]; b*(-log(x))^(-1/a)}
}}
if(g=="birnbaum-saunders"){
quan0=function(par,x){a=par[3]; b=par[4]; loc=par[5]; b/4*(a*qnorm(x)+sqrt((a*qnorm(x))^2+4))^2+loc}
if (location==FALSE){
quan0=function(par,x){a=par[3]; b=par[4]; b/4*(a*qnorm(x)+sqrt((a*qnorm(x))^2+4))^2}
}}
if(g=="weibull"){
quan0=function(par,x){shape=par[3]; scale=par[4]; loc=par[5]; qweibull(x,shape,scale)+loc}
if (location==FALSE){
quan0=function(par,x){shape=par[3]; scale=par[4]; qweibull(x,shape,scale)}
}}
if(g=="gamma"){
quan0=function(par,x){shape=par[3]; scale=par[4]; loc=par[5]; qgamma(x,shape,scale)+loc}
if (location==FALSE){
quan0=function(par,x){shape=par[3]; scale=par[4]; qgamma(x,shape,scale)}
}}
quan<-function(par,x){
a=par[1]
b=par[2]
quan0(par,(-log(1-x)/b)^(1/a)/(1+(-log(1-x)/b)^(1/a)))
}
return(quan(param,runif(n)))
}
qloggammag2<-function(p, g, param, location=TRUE, log.p = FALSE, lower.tail = TRUE){
if(g!="birnbaum-saunders" & g!="exp" & g!="rayleigh" & g!="weibull" & g!="gompertz" & g!="gamma"
& g!="log-normal" & g!="chisq" & g!="f" & g!="burrxii" & g!="frechet"
& g!="lomax" & g!="log-logistic" & g!="lfr" & g!="chen")
{ stop ("Baseline distribution not implemented or misspelled. Please check the manual for guidelines.") }
if(g=="log-normal"){
quan0=function(par,x){meanlog=par[3]; sdlog=par[4]; loc=par[5]; qlnorm(x,meanlog,sdlog)+loc}
if (location==FALSE){
quan0=function(par,x){meanlog=par[3]; sdlog=par[4]; qlnorm(x,meanlog,sdlog)}
}}
if(g=="chisq"){
quan0=function(par,x){df=par[3]; loc=par[4]; qchisq(x,df)+loc}
if (location==FALSE){
quan0=function(par,x){df=par[3]; qchisq(x,df)}
}}
if(g=="f"){
quan0=function(par,x){df1=par[3]; df2=par[4]; loc=par[5]; qf(x,df1,df2)+loc}
if (location==FALSE){
quan0=function(par,x){df1=par[3]; df2=par[4]; qf(x,df1,df2)}
}}
if(g=="chen"){
quan0=function(par,x){a=par[3]; b=par[4]; loc=par[5]; (log(1-log(1-x)/b))^(1/a)+loc}
if (location==FALSE){
quan0=function(par,x){a=par[3]; b=par[4]; (log(1-log(1-x)/b))^(1/a)}
}}
if(g=="lfr"){
quan0=function(par,x){a=par[3]; b=par[4]; loc=par[5]; (-a+sqrt(a^2-2*b*log(1-x)))/b+loc}
if (location==FALSE){
quan0=function(par,x){a=par[3]; b=par[4]; (-a+sqrt(a^2-2*b*log(1-x)))/b}
}}
if(g=="log-logistic"){
quan0=function(par,x){a=par[3]; b=par[4]; loc=par[5]; b*(1/x-1)^(-1/a)+loc}
if (location==FALSE){
quan0=function(par,x){a=par[3]; b=par[4]; b*(1/x-1)^(-1/a)}
}}
if(g=="lomax"){
quan0=function(par,x){a=par[3]; b=par[4]; loc=par[5]; ((1-x)^(-1/b)-1)/a+loc}
if (location==FALSE){
quan0=function(par,x){a=par[3]; b=par[4]; ((1-x)^(-1/b)-1)/a}
}}
if(g=="gompertz"){
quan0=function(par,x){a=par[3]; b=par[4]; loc=par[5]; log(1-a/b*log(1-x))/a+loc}
if (location==FALSE){
quan0=function(par,x){a=par[3]; b=par[4]; log(1-a/b*log(1-x))/a}
}}
if(g=="exp"){
quan0=function(par,x){rate=par[3]; loc=par[4]; qexp(x,rate)+loc}
if (location==FALSE){
quan0=function(par,x){rate=par[3]; qexp(x,rate)}
}}
if(g=="rayleigh"){
quan0=function(par,x){a=par[3]; loc=par[4]; a*(-log(1-x))^(1/2)+loc}
if (location==FALSE){
quan0=function(par,x){a=par[3]; a*(-log(1-x))^(1/2)}
}}
if(g=="burrxii"){
quan0=function(par,x){a=par[3]; d=par[4]; loc=par[5]; (1/(1-x)-1)^(1/d)+loc}
if (location==FALSE){
quan0=function(par,x){a=par[3]; d=par[4]; (1/(1-x)-1)^(1/d)}
}}
if(g=="frechet"){
quan0=function(par,x){a=par[3]; b=par[4]; loc=par[5]; b*(-log(x))^(-1/a)+loc}
if (location==FALSE){
quan0=function(par,x){a=par[3]; b=par[4]; b*(-log(x))^(-1/a)}
}}
if(g=="birnbaum-saunders"){
quan0=function(par,x){a=par[3]; b=par[4]; loc=par[5]; b/4*(a*qnorm(x)+sqrt((a*qnorm(x))^2+4))^2+loc}
if (location==FALSE){
quan0=function(par,x){a=par[3]; b=par[4]; b/4*(a*qnorm(x)+sqrt((a*qnorm(x))^2+4))^2}
}}
if(g=="weibull"){
quan0=function(par,x){shape=par[3]; scale=par[4]; loc=par[5]; qweibull(x,shape,scale)+loc}
if (location==FALSE){
quan0=function(par,x){shape=par[3]; scale=par[4]; qweibull(x,shape,scale)}
}}
if(g=="gamma"){
quan0=function(par,x){shape=par[3]; scale=par[4]; loc=par[5]; qgamma(x,shape,scale)+loc}
if (location==FALSE){
quan0=function(par,x){shape=par[3]; scale=par[4]; qgamma(x,shape,scale)}
}}
quan<-function(par,x){
a=par[1]
b=par[2]
quan0(par,exp(-qgamma(1-x,shape=a,scale=1)/b))
}
out<-quan(param,p)
if(log.p==TRUE & lower.tail == FALSE) out<-quan(param,exp(p-1))
if(log.p==TRUE & lower.tail == TRUE) out<-quan(param,exp(-p))
if(log.p==FALSE & lower.tail == FALSE) out<-quan(param,1-p)
return(out)
}
rloggammag2<-function(n, g, param, location=TRUE){
if(g!="birnbaum-saunders" & g!="exp" & g!="rayleigh" & g!="weibull" & g!="gompertz" & g!="gamma"
& g!="log-normal" & g!="chisq" & g!="f" & g!="burrxii" & g!="frechet"
& g!="lomax" & g!="log-logistic" & g!="lfr" & g!="chen")
{ stop ("Baseline distribution not implemented or misspelled. Please check the manual for guidelines.") }
if(n %% 1 !=0) { stop ("parameter n must be integer.") }
if(g=="log-normal"){
quan0=function(par,x){meanlog=par[3]; sdlog=par[4]; loc=par[5]; qlnorm(x,meanlog,sdlog)+loc}
if (location==FALSE){
quan0=function(par,x){meanlog=par[3]; sdlog=par[4]; qlnorm(x,meanlog,sdlog)}
}}
if(g=="chisq"){
quan0=function(par,x){df=par[3]; loc=par[4]; qchisq(x,df)+loc}
if (location==FALSE){
quan0=function(par,x){df=par[3]; qchisq(x,df)}
}}
if(g=="f"){
quan0=function(par,x){df1=par[3]; df2=par[4]; loc=par[5]; qf(x,df1,df2)+loc}
if (location==FALSE){
quan0=function(par,x){df1=par[3]; df2=par[4]; qf(x,df1,df2)}
}}
if(g=="chen"){
quan0=function(par,x){a=par[3]; b=par[4]; loc=par[5]; (log(1-log(1-x)/b))^(1/a)+loc}
if (location==FALSE){
quan0=function(par,x){a=par[3]; b=par[4]; (log(1-log(1-x)/b))^(1/a)}
}}
if(g=="lfr"){
quan0=function(par,x){a=par[3]; b=par[4]; loc=par[5]; (-a+sqrt(a^2-2*b*log(1-x)))/b+loc}
if (location==FALSE){
quan0=function(par,x){a=par[3]; b=par[4]; (-a+sqrt(a^2-2*b*log(1-x)))/b}
}}
if(g=="log-logistic"){
quan0=function(par,x){a=par[3]; b=par[4]; loc=par[5]; b*(1/x-1)^(-1/a)+loc}
if (location==FALSE){
quan0=function(par,x){a=par[3]; b=par[4]; b*(1/x-1)^(-1/a)}
}}
if(g=="lomax"){
quan0=function(par,x){a=par[3]; b=par[4]; loc=par[5]; ((1-x)^(-1/b)-1)/a+loc}
if (location==FALSE){
quan0=function(par,x){a=par[3]; b=par[4]; ((1-x)^(-1/b)-1)/a}
}}
if(g=="gompertz"){
quan0=function(par,x){a=par[3]; b=par[4]; loc=par[5]; log(1-a/b*log(1-x))/a+loc}
if (location==FALSE){
quan0=function(par,x){a=par[3]; b=par[4]; log(1-a/b*log(1-x))/a}
}}
if(g=="exp"){
quan0=function(par,x){rate=par[3]; loc=par[4]; qexp(x,rate)+loc}
if (location==FALSE){
quan0=function(par,x){rate=par[3]; qexp(x,rate)}
}}
if(g=="rayleigh"){
quan0=function(par,x){a=par[3]; loc=par[4]; a*(-log(1-x))^(1/2)+loc}
if (location==FALSE){
quan0=function(par,x){a=par[3]; a*(-log(1-x))^(1/2)}
}}
if(g=="burrxii"){
quan0=function(par,x){a=par[3]; d=par[4]; loc=par[5]; (1/(1-x)-1)^(1/d)+loc}
if (location==FALSE){
quan0=function(par,x){a=par[3]; d=par[4]; (1/(1-x)-1)^(1/d)}
}}
if(g=="frechet"){
quan0=function(par,x){a=par[3]; b=par[4]; loc=par[5]; b*(-log(x))^(-1/a)+loc}
if (location==FALSE){
quan0=function(par,x){a=par[3]; b=par[4]; b*(-log(x))^(-1/a)}
}}
if(g=="birnbaum-saunders"){
quan0=function(par,x){a=par[3]; b=par[4]; loc=par[5]; b/4*(a*qnorm(x)+sqrt((a*qnorm(x))^2+4))^2+loc}
if (location==FALSE){
quan0=function(par,x){a=par[3]; b=par[4]; b/4*(a*qnorm(x)+sqrt((a*qnorm(x))^2+4))^2}
}}
if(g=="weibull"){
quan0=function(par,x){shape=par[3]; scale=par[4]; loc=par[5]; qweibull(x,shape,scale)+loc}
if (location==FALSE){
quan0=function(par,x){shape=par[3]; scale=par[4]; qweibull(x,shape,scale)}
}}
if(g=="gamma"){
quan0=function(par,x){shape=par[3]; scale=par[4]; loc=par[5]; qgamma(x,shape,scale)+loc}
if (location==FALSE){
quan0=function(par,x){shape=par[3]; scale=par[4]; qgamma(x,shape,scale)}
}}
quan<-function(par,x){
a=par[1]
b=par[2]
quan0(par,exp(-qgamma(1-x,shape=a,scale=1)/b))
}
return(quan(param,runif(n)))
}
qexpexppg<-function(p, g, param, location=TRUE, log.p = FALSE, lower.tail = TRUE){
if(g!="birnbaum-saunders" & g!="exp" & g!="rayleigh" & g!="weibull" & g!="gompertz" & g!="gamma"
& g!="log-normal" & g!="chisq" & g!="f" & g!="burrxii" & g!="frechet"
& g!="lomax" & g!="log-logistic" & g!="lfr" & g!="chen")
{ stop ("Baseline distribution not implemented or misspelled. Please check the manual for guidelines.") }
if(g=="log-normal"){
quan0=function(par,x){meanlog=par[3]; sdlog=par[4]; loc=par[5]; qlnorm(x,meanlog,sdlog)+loc}
if (location==FALSE){
quan0=function(par,x){meanlog=par[3]; sdlog=par[4]; qlnorm(x,meanlog,sdlog)}
}}
if(g=="chisq"){
quan0=function(par,x){df=par[3]; loc=par[4]; qchisq(x,df)+loc}
if (location==FALSE){
quan0=function(par,x){df=par[3]; qchisq(x,df)}
}}
if(g=="f"){
quan0=function(par,x){df1=par[3]; df2=par[4]; loc=par[5]; qf(x,df1,df2)+loc}
if (location==FALSE){
quan0=function(par,x){df1=par[3]; df2=par[4]; qf(x,df1,df2)}
}}
if(g=="chen"){
quan0=function(par,x){a=par[3]; b=par[4]; loc=par[5]; (log(1-log(1-x)/b))^(1/a)+loc}
if (location==FALSE){
quan0=function(par,x){a=par[3]; b=par[4]; (log(1-log(1-x)/b))^(1/a)}
}}
if(g=="lfr"){
quan0=function(par,x){a=par[3]; b=par[4]; loc=par[5]; (-a+sqrt(a^2-2*b*log(1-x)))/b+loc}
if (location==FALSE){
quan0=function(par,x){a=par[3]; b=par[4]; (-a+sqrt(a^2-2*b*log(1-x)))/b}
}}
if(g=="log-logistic"){
quan0=function(par,x){a=par[3]; b=par[4]; loc=par[5]; b*(1/x-1)^(-1/a)+loc}
if (location==FALSE){
quan0=function(par,x){a=par[3]; b=par[4]; b*(1/x-1)^(-1/a)}
}}
if(g=="lomax"){
quan0=function(par,x){a=par[3]; b=par[4]; loc=par[5]; ((1-x)^(-1/b)-1)/a+loc}
if (location==FALSE){
quan0=function(par,x){a=par[3]; b=par[4]; ((1-x)^(-1/b)-1)/a}
}}
if(g=="gompertz"){
quan0=function(par,x){a=par[3]; b=par[4]; loc=par[5]; log(1-a/b*log(1-x))/a+loc}
if (location==FALSE){
quan0=function(par,x){a=par[3]; b=par[4]; log(1-a/b*log(1-x))/a}
}}
if(g=="exp"){
quan0=function(par,x){rate=par[3]; loc=par[4]; qexp(x,rate)+loc}
if (location==FALSE){
quan0=function(par,x){rate=par[3]; qexp(x,rate)}
}}
if(g=="rayleigh"){
quan0=function(par,x){a=par[3]; loc=par[4]; a*(-log(1-x))^(1/2)+loc}
if (location==FALSE){
quan0=function(par,x){a=par[3]; a*(-log(1-x))^(1/2)}
}}
if(g=="burrxii"){
quan0=function(par,x){a=par[3]; d=par[4]; loc=par[5]; (1/(1-x)-1)^(1/d)+loc}
if (location==FALSE){
quan0=function(par,x){a=par[3]; d=par[4]; (1/(1-x)-1)^(1/d)}
}}
if(g=="frechet"){
quan0=function(par,x){a=par[3]; b=par[4]; loc=par[5]; b*(-log(x))^(-1/a)+loc}
if (location==FALSE){
quan0=function(par,x){a=par[3]; b=par[4]; b*(-log(x))^(-1/a)}
}}
if(g=="birnbaum-saunders"){
quan0=function(par,x){a=par[3]; b=par[4]; loc=par[5]; b/4*(a*qnorm(x)+sqrt((a*qnorm(x))^2+4))^2+loc}
if (location==FALSE){
quan0=function(par,x){a=par[3]; b=par[4]; b/4*(a*qnorm(x)+sqrt((a*qnorm(x))^2+4))^2}
}}
if(g=="weibull"){
quan0=function(par,x){shape=par[3]; scale=par[4]; loc=par[5]; qweibull(x,shape,scale)+loc}
if (location==FALSE){
quan0=function(par,x){shape=par[3]; scale=par[4]; qweibull(x,shape,scale)}
}}
if(g=="gamma"){
quan0=function(par,x){shape=par[3]; scale=par[4]; loc=par[5]; qgamma(x,shape,scale)+loc}
if (location==FALSE){
quan0=function(par,x){shape=par[3]; scale=par[4]; qgamma(x,shape,scale)}
}}
quan<-function(par,x){
a=par[1]
b=par[2]
quan0(par,(-log(1-x*(1-exp(-b)))/b)^(1/a))
}
out<-quan(param,p)
if(log.p==TRUE & lower.tail == FALSE) out<-quan(param,exp(p-1))
if(log.p==TRUE & lower.tail == TRUE) out<-quan(param,exp(-p))
if(log.p==FALSE & lower.tail == FALSE) out<-quan(param,1-p)
return(out)
}
rexpexppg<-function(n, g, param, location=TRUE){
if(g!="birnbaum-saunders" & g!="exp" & g!="rayleigh" & g!="weibull" & g!="gompertz" & g!="gamma"
& g!="log-normal" & g!="chisq" & g!="f" & g!="burrxii" & g!="frechet"
& g!="lomax" & g!="log-logistic" & g!="lfr" & g!="chen")
{ stop ("Baseline distribution not implemented or misspelled. Please check the manual for guidelines.") }
if(n %% 1 !=0) { stop ("parameter n must be integer.") }
if(g=="log-normal"){
quan0=function(par,x){meanlog=par[3]; sdlog=par[4]; loc=par[5]; qlnorm(x,meanlog,sdlog)+loc}
if (location==FALSE){
quan0=function(par,x){meanlog=par[3]; sdlog=par[4]; qlnorm(x,meanlog,sdlog)}
}}
if(g=="chisq"){
quan0=function(par,x){df=par[3]; loc=par[4]; qchisq(x,df)+loc}
if (location==FALSE){
quan0=function(par,x){df=par[3]; qchisq(x,df)}
}}
if(g=="f"){
quan0=function(par,x){df1=par[3]; df2=par[4]; loc=par[5]; qf(x,df1,df2)+loc}
if (location==FALSE){
quan0=function(par,x){df1=par[3]; df2=par[4]; qf(x,df1,df2)}
}}
if(g=="chen"){
quan0=function(par,x){a=par[3]; b=par[4]; loc=par[5]; (log(1-log(1-x)/b))^(1/a)+loc}
if (location==FALSE){
quan0=function(par,x){a=par[3]; b=par[4]; (log(1-log(1-x)/b))^(1/a)}
}}
if(g=="lfr"){
quan0=function(par,x){a=par[3]; b=par[4]; loc=par[5]; (-a+sqrt(a^2-2*b*log(1-x)))/b+loc}
if (location==FALSE){
quan0=function(par,x){a=par[3]; b=par[4]; (-a+sqrt(a^2-2*b*log(1-x)))/b}
}}
if(g=="log-logistic"){
quan0=function(par,x){a=par[3]; b=par[4]; loc=par[5]; b*(1/x-1)^(-1/a)+loc}
if (location==FALSE){
quan0=function(par,x){a=par[3]; b=par[4]; b*(1/x-1)^(-1/a)}
}}
if(g=="lomax"){
quan0=function(par,x){a=par[3]; b=par[4]; loc=par[5]; ((1-x)^(-1/b)-1)/a+loc}
if (location==FALSE){
quan0=function(par,x){a=par[3]; b=par[4]; ((1-x)^(-1/b)-1)/a}
}}
if(g=="gompertz"){
quan0=function(par,x){a=par[3]; b=par[4]; loc=par[5]; log(1-a/b*log(1-x))/a+loc}
if (location==FALSE){
quan0=function(par,x){a=par[3]; b=par[4]; log(1-a/b*log(1-x))/a}
}}
if(g=="exp"){
quan0=function(par,x){rate=par[3]; loc=par[4]; qexp(x,rate)+loc}
if (location==FALSE){
quan0=function(par,x){rate=par[3]; qexp(x,rate)}
}}
if(g=="rayleigh"){
quan0=function(par,x){a=par[3]; loc=par[4]; a*(-log(1-x))^(1/2)+loc}
if (location==FALSE){
quan0=function(par,x){a=par[3]; a*(-log(1-x))^(1/2)}
}}
if(g=="burrxii"){
quan0=function(par,x){a=par[3]; d=par[4]; loc=par[5]; (1/(1-x)-1)^(1/d)+loc}
if (location==FALSE){
quan0=function(par,x){a=par[3]; d=par[4]; (1/(1-x)-1)^(1/d)}
}}
if(g=="frechet"){
quan0=function(par,x){a=par[3]; b=par[4]; loc=par[5]; b*(-log(x))^(-1/a)+loc}
if (location==FALSE){
quan0=function(par,x){a=par[3]; b=par[4]; b*(-log(x))^(-1/a)}
}}
if(g=="birnbaum-saunders"){
quan0=function(par,x){a=par[3]; b=par[4]; loc=par[5]; b/4*(a*qnorm(x)+sqrt((a*qnorm(x))^2+4))^2+loc}
if (location==FALSE){
quan0=function(par,x){a=par[3]; b=par[4]; b/4*(a*qnorm(x)+sqrt((a*qnorm(x))^2+4))^2}
}}
if(g=="weibull"){
quan0=function(par,x){shape=par[3]; scale=par[4]; loc=par[5]; qweibull(x,shape,scale)+loc}
if (location==FALSE){
quan0=function(par,x){shape=par[3]; scale=par[4]; qweibull(x,shape,scale)}
}}
if(g=="gamma"){
quan0=function(par,x){shape=par[3]; scale=par[4]; loc=par[5]; qgamma(x,shape,scale)+loc}
if (location==FALSE){
quan0=function(par,x){shape=par[3]; scale=par[4]; qgamma(x,shape,scale)}
}}
quan<-function(par,x){
a=par[1]
b=par[2]
quan0(par,(-log(1-x*(1-exp(-b)))/b)^(1/a))
}
return(quan(param,runif(n)))
}
qexpgg<-function(p, g, param, location=TRUE, log.p = FALSE, lower.tail = TRUE){
if(g!="birnbaum-saunders" & g!="exp" & g!="rayleigh" & g!="weibull" & g!="gompertz" & g!="gamma"
& g!="log-normal" & g!="chisq" & g!="f" & g!="burrxii" & g!="frechet"
& g!="lomax" & g!="log-logistic" & g!="lfr" & g!="chen")
{ stop ("Baseline distribution not implemented or misspelled. Please check the manual for guidelines.") }
if(g=="log-normal"){
quan0=function(par,x){meanlog=par[3]; sdlog=par[4]; loc=par[5]; qlnorm(x,meanlog,sdlog)+loc}
if (location==FALSE){
quan0=function(par,x){meanlog=par[3]; sdlog=par[4]; qlnorm(x,meanlog,sdlog)}
}}
if(g=="chisq"){
quan0=function(par,x){df=par[3]; loc=par[4]; qchisq(x,df)+loc}
if (location==FALSE){
quan0=function(par,x){df=par[3]; qchisq(x,df)}
}}
if(g=="f"){
quan0=function(par,x){df1=par[3]; df2=par[4]; loc=par[5]; qf(x,df1,df2)+loc}
if (location==FALSE){
quan0=function(par,x){df1=par[3]; df2=par[4]; qf(x,df1,df2)}
}}
if(g=="chen"){
quan0=function(par,x){a=par[3]; b=par[4]; loc=par[5]; (log(1-log(1-x)/b))^(1/a)+loc}
if (location==FALSE){
quan0=function(par,x){a=par[3]; b=par[4]; (log(1-log(1-x)/b))^(1/a)}
}}
if(g=="lfr"){
quan0=function(par,x){a=par[3]; b=par[4]; loc=par[5]; (-a+sqrt(a^2-2*b*log(1-x)))/b+loc}
if (location==FALSE){
quan0=function(par,x){a=par[3]; b=par[4]; (-a+sqrt(a^2-2*b*log(1-x)))/b}
}}
if(g=="log-logistic"){
quan0=function(par,x){a=par[3]; b=par[4]; loc=par[5]; b*(1/x-1)^(-1/a)+loc}
if (location==FALSE){
quan0=function(par,x){a=par[3]; b=par[4]; b*(1/x-1)^(-1/a)}
}}
if(g=="lomax"){
quan0=function(par,x){a=par[3]; b=par[4]; loc=par[5]; ((1-x)^(-1/b)-1)/a+loc}
if (location==FALSE){
quan0=function(par,x){a=par[3]; b=par[4]; ((1-x)^(-1/b)-1)/a}
}}
if(g=="gompertz"){
quan0=function(par,x){a=par[3]; b=par[4]; loc=par[5]; log(1-a/b*log(1-x))/a+loc}
if (location==FALSE){
quan0=function(par,x){a=par[3]; b=par[4]; log(1-a/b*log(1-x))/a}
}}
if(g=="exp"){
quan0=function(par,x){rate=par[3]; loc=par[4]; qexp(x,rate)+loc}
if (location==FALSE){
quan0=function(par,x){rate=par[3]; qexp(x,rate)}
}}
if(g=="rayleigh"){
quan0=function(par,x){a=par[3]; loc=par[4]; a*(-log(1-x))^(1/2)+loc}
if (location==FALSE){
quan0=function(par,x){a=par[3]; a*(-log(1-x))^(1/2)}
}}
if(g=="burrxii"){
quan0=function(par,x){a=par[3]; d=par[4]; loc=par[5]; (1/(1-x)-1)^(1/d)+loc}
if (location==FALSE){
quan0=function(par,x){a=par[3]; d=par[4]; (1/(1-x)-1)^(1/d)}
}}
if(g=="frechet"){
quan0=function(par,x){a=par[3]; b=par[4]; loc=par[5]; b*(-log(x))^(-1/a)+loc}
if (location==FALSE){
quan0=function(par,x){a=par[3]; b=par[4]; b*(-log(x))^(-1/a)}
}}
if(g=="birnbaum-saunders"){
quan0=function(par,x){a=par[3]; b=par[4]; loc=par[5]; b/4*(a*qnorm(x)+sqrt((a*qnorm(x))^2+4))^2+loc}
if (location==FALSE){
quan0=function(par,x){a=par[3]; b=par[4]; b/4*(a*qnorm(x)+sqrt((a*qnorm(x))^2+4))^2}
}}
if(g=="weibull"){
quan0=function(par,x){shape=par[3]; scale=par[4]; loc=par[5]; qweibull(x,shape,scale)+loc}
if (location==FALSE){
quan0=function(par,x){shape=par[3]; scale=par[4]; qweibull(x,shape,scale)}
}}
if(g=="gamma"){
quan0=function(par,x){shape=par[3]; scale=par[4]; loc=par[5]; qgamma(x,shape,scale)+loc}
if (location==FALSE){
quan0=function(par,x){shape=par[3]; scale=par[4]; qgamma(x,shape,scale)}
}}
quan<-function(par,x){
a=par[1]
b=par[2]
quan0(par,1-(1-x^(1/b))^(1/a))
}
out<-quan(param,p)
if(log.p==TRUE & lower.tail == FALSE) out<-quan(param,exp(p-1))
if(log.p==TRUE & lower.tail == TRUE) out<-quan(param,exp(-p))
if(log.p==FALSE & lower.tail == FALSE) out<-quan(param,1-p)
return(out)
}
rexpgg<-function(n, g, param, location=TRUE){
if(g!="birnbaum-saunders" & g!="exp" & g!="rayleigh" & g!="weibull" & g!="gompertz" & g!="gamma"
& g!="log-normal" & g!="chisq" & g!="f" & g!="burrxii" & g!="frechet"
& g!="lomax" & g!="log-logistic" & g!="lfr" & g!="chen")
{ stop ("Baseline distribution not implemented or misspelled. Please check the manual for guidelines.") }
if(n %% 1 !=0) { stop ("parameter n must be integer.") }
if(g=="log-normal"){
quan0=function(par,x){meanlog=par[3]; sdlog=par[4]; loc=par[5]; qlnorm(x,meanlog,sdlog)+loc}
if (location==FALSE){
quan0=function(par,x){meanlog=par[3]; sdlog=par[4]; qlnorm(x,meanlog,sdlog)}
}}
if(g=="chisq"){
quan0=function(par,x){df=par[3]; loc=par[4]; qchisq(x,df)+loc}
if (location==FALSE){
quan0=function(par,x){df=par[3]; qchisq(x,df)}
}}
if(g=="f"){
quan0=function(par,x){df1=par[3]; df2=par[4]; loc=par[5]; qf(x,df1,df2)+loc}
if (location==FALSE){
quan0=function(par,x){df1=par[3]; df2=par[4]; qf(x,df1,df2)}
}}
if(g=="chen"){
quan0=function(par,x){a=par[3]; b=par[4]; loc=par[5]; (log(1-log(1-x)/b))^(1/a)+loc}
if (location==FALSE){
quan0=function(par,x){a=par[3]; b=par[4]; (log(1-log(1-x)/b))^(1/a)}
}}
if(g=="lfr"){
quan0=function(par,x){a=par[3]; b=par[4]; loc=par[5]; (-a+sqrt(a^2-2*b*log(1-x)))/b+loc}
if (location==FALSE){
quan0=function(par,x){a=par[3]; b=par[4]; (-a+sqrt(a^2-2*b*log(1-x)))/b}
}}
if(g=="log-logistic"){
quan0=function(par,x){a=par[3]; b=par[4]; loc=par[5]; b*(1/x-1)^(-1/a)+loc}
if (location==FALSE){
quan0=function(par,x){a=par[3]; b=par[4]; b*(1/x-1)^(-1/a)}
}}
if(g=="lomax"){
quan0=function(par,x){a=par[3]; b=par[4]; loc=par[5]; ((1-x)^(-1/b)-1)/a+loc}
if (location==FALSE){
quan0=function(par,x){a=par[3]; b=par[4]; ((1-x)^(-1/b)-1)/a}
}}
if(g=="gompertz"){
quan0=function(par,x){a=par[3]; b=par[4]; loc=par[5]; log(1-a/b*log(1-x))/a+loc}
if (location==FALSE){
quan0=function(par,x){a=par[3]; b=par[4]; log(1-a/b*log(1-x))/a}
}}
if(g=="exp"){
quan0=function(par,x){rate=par[3]; loc=par[4]; qexp(x,rate)+loc}
if (location==FALSE){
quan0=function(par,x){rate=par[3]; qexp(x,rate)}
}}
if(g=="rayleigh"){
quan0=function(par,x){a=par[3]; loc=par[4]; a*(-log(1-x))^(1/2)+loc}
if (location==FALSE){
quan0=function(par,x){a=par[3]; a*(-log(1-x))^(1/2)}
}}
if(g=="burrxii"){
quan0=function(par,x){a=par[3]; d=par[4]; loc=par[5]; (1/(1-x)-1)^(1/d)+loc}
if (location==FALSE){
quan0=function(par,x){a=par[3]; d=par[4]; (1/(1-x)-1)^(1/d)}
}}
if(g=="frechet"){
quan0=function(par,x){a=par[3]; b=par[4]; loc=par[5]; b*(-log(x))^(-1/a)+loc}
if (location==FALSE){
quan0=function(par,x){a=par[3]; b=par[4]; b*(-log(x))^(-1/a)}
}}
if(g=="birnbaum-saunders"){
quan0=function(par,x){a=par[3]; b=par[4]; loc=par[5]; b/4*(a*qnorm(x)+sqrt((a*qnorm(x))^2+4))^2+loc}
if (location==FALSE){
quan0=function(par,x){a=par[3]; b=par[4]; b/4*(a*qnorm(x)+sqrt((a*qnorm(x))^2+4))^2}
}}
if(g=="weibull"){
quan0=function(par,x){shape=par[3]; scale=par[4]; loc=par[5]; qweibull(x,shape,scale)+loc}
if (location==FALSE){
quan0=function(par,x){shape=par[3]; scale=par[4]; qweibull(x,shape,scale)}
}}
if(g=="gamma"){
quan0=function(par,x){shape=par[3]; scale=par[4]; loc=par[5]; qgamma(x,shape,scale)+loc}
if (location==FALSE){
quan0=function(par,x){shape=par[3]; scale=par[4]; qgamma(x,shape,scale)}
}}
quan<-function(par,x){
a=par[1]
b=par[2]
quan0(par,1-(1-x^(1/b))^(1/a))
}
return(quan(param,runif(n)))
}
qweibullg<-function(p, g, param, location=TRUE, log.p = FALSE, lower.tail = TRUE){
if(g!="birnbaum-saunders" & g!="exp" & g!="rayleigh" & g!="weibull" & g!="gompertz" & g!="gamma"
& g!="log-normal" & g!="chisq" & g!="f" & g!="burrxii" & g!="frechet"
& g!="lomax" & g!="log-logistic" & g!="lfr" & g!="chen")
{ stop ("Baseline distribution not implemented or misspelled. Please check the manual for guidelines.") }
if(g=="log-normal"){
quan0=function(par,x){meanlog=par[3]; sdlog=par[4]; loc=par[5]; qlnorm(x,meanlog,sdlog)+loc}
if (location==FALSE){
quan0=function(par,x){meanlog=par[3]; sdlog=par[4]; qlnorm(x,meanlog,sdlog)}
}}
if(g=="chisq"){
quan0=function(par,x){df=par[3]; loc=par[4]; qchisq(x,df)+loc}
if (location==FALSE){
quan0=function(par,x){df=par[3]; qchisq(x,df)}
}}
if(g=="f"){
quan0=function(par,x){df1=par[3]; df2=par[4]; loc=par[5]; qf(x,df1,df2)+loc}
if (location==FALSE){
quan0=function(par,x){df1=par[3]; df2=par[4]; qf(x,df1,df2)}
}}
if(g=="chen"){
quan0=function(par,x){a=par[3]; b=par[4]; loc=par[5]; (log(1-log(1-x)/b))^(1/a)+loc}
if (location==FALSE){
quan0=function(par,x){a=par[3]; b=par[4]; (log(1-log(1-x)/b))^(1/a)}
}}
if(g=="lfr"){
quan0=function(par,x){a=par[3]; b=par[4]; loc=par[5]; (-a+sqrt(a^2-2*b*log(1-x)))/b+loc}
if (location==FALSE){
quan0=function(par,x){a=par[3]; b=par[4]; (-a+sqrt(a^2-2*b*log(1-x)))/b}
}}
if(g=="log-logistic"){
quan0=function(par,x){a=par[3]; b=par[4]; loc=par[5]; b*(1/x-1)^(-1/a)+loc}
if (location==FALSE){
quan0=function(par,x){a=par[3]; b=par[4]; b*(1/x-1)^(-1/a)}
}}
if(g=="lomax"){
quan0=function(par,x){a=par[3]; b=par[4]; loc=par[5]; ((1-x)^(-1/b)-1)/a+loc}
if (location==FALSE){
quan0=function(par,x){a=par[3]; b=par[4]; ((1-x)^(-1/b)-1)/a}
}}
if(g=="gompertz"){
quan0=function(par,x){a=par[3]; b=par[4]; loc=par[5]; log(1-a/b*log(1-x))/a+loc}
if (location==FALSE){
quan0=function(par,x){a=par[3]; b=par[4]; log(1-a/b*log(1-x))/a}
}}
if(g=="exp"){
quan0=function(par,x){rate=par[3]; loc=par[4]; qexp(x,rate)+loc}
if (location==FALSE){
quan0=function(par,x){rate=par[3]; qexp(x,rate)}
}}
if(g=="rayleigh"){
quan0=function(par,x){a=par[3]; loc=par[4]; a*(-log(1-x))^(1/2)+loc}
if (location==FALSE){
quan0=function(par,x){a=par[3]; a*(-log(1-x))^(1/2)}
}}
if(g=="burrxii"){
quan0=function(par,x){a=par[3]; d=par[4]; loc=par[5]; (1/(1-x)-1)^(1/d)+loc}
if (location==FALSE){
quan0=function(par,x){a=par[3]; d=par[4]; (1/(1-x)-1)^(1/d)}
}}
if(g=="frechet"){
quan0=function(par,x){a=par[3]; b=par[4]; loc=par[5]; b*(-log(x))^(-1/a)+loc}
if (location==FALSE){
quan0=function(par,x){a=par[3]; b=par[4]; b*(-log(x))^(-1/a)}
}}
if(g=="birnbaum-saunders"){
quan0=function(par,x){a=par[3]; b=par[4]; loc=par[5]; b/4*(a*qnorm(x)+sqrt((a*qnorm(x))^2+4))^2+loc}
if (location==FALSE){
quan0=function(par,x){a=par[3]; b=par[4]; b/4*(a*qnorm(x)+sqrt((a*qnorm(x))^2+4))^2}
}}
if(g=="weibull"){
quan0=function(par,x){shape=par[3]; scale=par[4]; loc=par[5]; qweibull(x,shape,scale)+loc}
if (location==FALSE){
quan0=function(par,x){shape=par[3]; scale=par[4]; qweibull(x,shape,scale)}
}}
if(g=="gamma"){
quan0=function(par,x){shape=par[3]; scale=par[4]; loc=par[5]; qgamma(x,shape,scale)+loc}
if (location==FALSE){
quan0=function(par,x){shape=par[3]; scale=par[4]; qgamma(x,shape,scale)}
}}
quan<-function(par,x){
a=par[1]
b=par[2]
quan0(par,1-exp(-b*(-log(1-x))^(1/a)))
}
out<-quan(param,p)
if(log.p==TRUE & lower.tail == FALSE) out<-quan(param,exp(p-1))
if(log.p==TRUE & lower.tail == TRUE) out<-quan(param,exp(-p))
if(log.p==FALSE & lower.tail == FALSE) out<-quan(param,1-p)
return(out)
}
rweibullg<-function(n, g, param, location=TRUE){
if(g!="birnbaum-saunders" & g!="exp" & g!="rayleigh" & g!="weibull" & g!="gompertz" & g!="gamma"
& g!="log-normal" & g!="chisq" & g!="f" & g!="burrxii" & g!="frechet"
& g!="lomax" & g!="log-logistic" & g!="lfr" & g!="chen")
{ stop ("Baseline distribution not implemented or misspelled. Please check the manual for guidelines.") }
if(n %% 1 !=0) { stop ("parameter n must be integer.") }
if(g=="log-normal"){
quan0=function(par,x){meanlog=par[3]; sdlog=par[4]; loc=par[5]; qlnorm(x,meanlog,sdlog)+loc}
if (location==FALSE){
quan0=function(par,x){meanlog=par[3]; sdlog=par[4]; qlnorm(x,meanlog,sdlog)}
}}
if(g=="chisq"){
quan0=function(par,x){df=par[3]; loc=par[4]; qchisq(x,df)+loc}
if (location==FALSE){
quan0=function(par,x){df=par[3]; qchisq(x,df)}
}}
if(g=="f"){
quan0=function(par,x){df1=par[3]; df2=par[4]; loc=par[5]; qf(x,df1,df2)+loc}
if (location==FALSE){
quan0=function(par,x){df1=par[3]; df2=par[4]; qf(x,df1,df2)}
}}
if(g=="chen"){
quan0=function(par,x){a=par[3]; b=par[4]; loc=par[5]; (log(1-log(1-x)/b))^(1/a)+loc}
if (location==FALSE){
quan0=function(par,x){a=par[3]; b=par[4]; (log(1-log(1-x)/b))^(1/a)}
}}
if(g=="lfr"){
quan0=function(par,x){a=par[3]; b=par[4]; loc=par[5]; (-a+sqrt(a^2-2*b*log(1-x)))/b+loc}
if (location==FALSE){
quan0=function(par,x){a=par[3]; b=par[4]; (-a+sqrt(a^2-2*b*log(1-x)))/b}
}}
if(g=="log-logistic"){
quan0=function(par,x){a=par[3]; b=par[4]; loc=par[5]; b*(1/x-1)^(-1/a)+loc}
if (location==FALSE){
quan0=function(par,x){a=par[3]; b=par[4]; b*(1/x-1)^(-1/a)}
}}
if(g=="lomax"){
quan0=function(par,x){a=par[3]; b=par[4]; loc=par[5]; ((1-x)^(-1/b)-1)/a+loc}
if (location==FALSE){
quan0=function(par,x){a=par[3]; b=par[4]; ((1-x)^(-1/b)-1)/a}
}}
if(g=="gompertz"){
quan0=function(par,x){a=par[3]; b=par[4]; loc=par[5]; log(1-a/b*log(1-x))/a+loc}
if (location==FALSE){
quan0=function(par,x){a=par[3]; b=par[4]; log(1-a/b*log(1-x))/a}
}}
if(g=="exp"){
quan0=function(par,x){rate=par[3]; loc=par[4]; qexp(x,rate)+loc}
if (location==FALSE){
quan0=function(par,x){rate=par[3]; qexp(x,rate)}
}}
if(g=="rayleigh"){
quan0=function(par,x){a=par[3]; loc=par[4]; a*(-log(1-x))^(1/2)+loc}
if (location==FALSE){
quan0=function(par,x){a=par[3]; a*(-log(1-x))^(1/2)}
}}
if(g=="burrxii"){
quan0=function(par,x){a=par[3]; d=par[4]; loc=par[5]; (1/(1-x)-1)^(1/d)+loc}
if (location==FALSE){
quan0=function(par,x){a=par[3]; d=par[4]; (1/(1-x)-1)^(1/d)}
}}
if(g=="frechet"){
quan0=function(par,x){a=par[3]; b=par[4]; loc=par[5]; b*(-log(x))^(-1/a)+loc}
if (location==FALSE){
quan0=function(par,x){a=par[3]; b=par[4]; b*(-log(x))^(-1/a)}
}}
if(g=="birnbaum-saunders"){
quan0=function(par,x){a=par[3]; b=par[4]; loc=par[5]; b/4*(a*qnorm(x)+sqrt((a*qnorm(x))^2+4))^2+loc}
if (location==FALSE){
quan0=function(par,x){a=par[3]; b=par[4]; b/4*(a*qnorm(x)+sqrt((a*qnorm(x))^2+4))^2}
}}
if(g=="weibull"){
quan0=function(par,x){shape=par[3]; scale=par[4]; loc=par[5]; qweibull(x,shape,scale)+loc}
if (location==FALSE){
quan0=function(par,x){shape=par[3]; scale=par[4]; qweibull(x,shape,scale)}
}}
if(g=="gamma"){
quan0=function(par,x){shape=par[3]; scale=par[4]; loc=par[5]; qgamma(x,shape,scale)+loc}
if (location==FALSE){
quan0=function(par,x){shape=par[3]; scale=par[4]; qgamma(x,shape,scale)}
}}
quan<-function(par,x){
a=par[1]
b=par[2]
quan0(par,1-exp(-b*(-log(1-x))^(1/a)))
}
return(quan(param,runif(n)))
}
qgmbetaexpg<-function(p, g, param, location=TRUE, log.p = FALSE, lower.tail = TRUE){
if(g!="birnbaum-saunders" & g!="exp" & g!="rayleigh" & g!="weibull" & g!="gompertz" & g!="gamma"
& g!="log-normal" & g!="chisq" & g!="f" & g!="burrxii" & g!="frechet"
& g!="lomax" & g!="log-logistic" & g!="lfr" & g!="chen")
{ stop ("Baseline distribution not implemented or misspelled. Please check the manual for guidelines.") }
if(g=="log-normal"){
quan0=function(par,x){meanlog=par[3]; sdlog=par[4]; loc=par[5]; qlnorm(x,meanlog,sdlog)+loc}
if (location==FALSE){
quan0=function(par,x){meanlog=par[3]; sdlog=par[4]; qlnorm(x,meanlog,sdlog)}
}}
if(g=="chisq"){
quan0=function(par,x){df=par[3]; loc=par[4]; qchisq(x,df)+loc}
if (location==FALSE){
quan0=function(par,x){df=par[3]; qchisq(x,df)}
}}
if(g=="f"){
quan0=function(par,x){df1=par[3]; df2=par[4]; loc=par[5]; qf(x,df1,df2)+loc}
if (location==FALSE){
quan0=function(par,x){df1=par[3]; df2=par[4]; qf(x,df1,df2)}
}}
if(g=="chen"){
quan0=function(par,x){a=par[3]; b=par[4]; loc=par[5]; (log(1-log(1-x)/b))^(1/a)+loc}
if (location==FALSE){
quan0=function(par,x){a=par[3]; b=par[4]; (log(1-log(1-x)/b))^(1/a)}
}}
if(g=="lfr"){
quan0=function(par,x){a=par[3]; b=par[4]; loc=par[5]; (-a+sqrt(a^2-2*b*log(1-x)))/b+loc}
if (location==FALSE){
quan0=function(par,x){a=par[3]; b=par[4]; (-a+sqrt(a^2-2*b*log(1-x)))/b}
}}
if(g=="log-logistic"){
quan0=function(par,x){a=par[3]; b=par[4]; loc=par[5]; b*(1/x-1)^(-1/a)+loc}
if (location==FALSE){
quan0=function(par,x){a=par[3]; b=par[4]; b*(1/x-1)^(-1/a)}
}}
if(g=="lomax"){
quan0=function(par,x){a=par[3]; b=par[4]; loc=par[5]; ((1-x)^(-1/b)-1)/a+loc}
if (location==FALSE){
quan0=function(par,x){a=par[3]; b=par[4]; ((1-x)^(-1/b)-1)/a}
}}
if(g=="gompertz"){
quan0=function(par,x){a=par[3]; b=par[4]; loc=par[5]; log(1-a/b*log(1-x))/a+loc}
if (location==FALSE){
quan0=function(par,x){a=par[3]; b=par[4]; log(1-a/b*log(1-x))/a}
}}
if(g=="exp"){
quan0=function(par,x){rate=par[3]; loc=par[4]; qexp(x,rate)+loc}
if (location==FALSE){
quan0=function(par,x){rate=par[3]; qexp(x,rate)}
}}
if(g=="rayleigh"){
quan0=function(par,x){a=par[3]; loc=par[4]; a*(-log(1-x))^(1/2)+loc}
if (location==FALSE){
quan0=function(par,x){a=par[3]; a*(-log(1-x))^(1/2)}
}}
if(g=="burrxii"){
quan0=function(par,x){a=par[3]; d=par[4]; loc=par[5]; (1/(1-x)-1)^(1/d)+loc}
if (location==FALSE){
quan0=function(par,x){a=par[3]; d=par[4]; (1/(1-x)-1)^(1/d)}
}}
if(g=="frechet"){
quan0=function(par,x){a=par[3]; b=par[4]; loc=par[5]; b*(-log(x))^(-1/a)+loc}
if (location==FALSE){
quan0=function(par,x){a=par[3]; b=par[4]; b*(-log(x))^(-1/a)}
}}
if(g=="birnbaum-saunders"){
quan0=function(par,x){a=par[3]; b=par[4]; loc=par[5]; b/4*(a*qnorm(x)+sqrt((a*qnorm(x))^2+4))^2+loc}
if (location==FALSE){
quan0=function(par,x){a=par[3]; b=par[4]; b/4*(a*qnorm(x)+sqrt((a*qnorm(x))^2+4))^2}
}}
if(g=="weibull"){
quan0=function(par,x){shape=par[3]; scale=par[4]; loc=par[5]; qweibull(x,shape,scale)+loc}
if (location==FALSE){
quan0=function(par,x){shape=par[3]; scale=par[4]; qweibull(x,shape,scale)}
}}
if(g=="gamma"){
quan0=function(par,x){shape=par[3]; scale=par[4]; loc=par[5]; qgamma(x,shape,scale)+loc}
if (location==FALSE){
quan0=function(par,x){shape=par[3]; scale=par[4]; qgamma(x,shape,scale)}
}}
quan<-function(par,x){
a=par[1]
b=par[2]
quan0(par,(-log(1-x^(1/a))/b)/(1+(-log(1-x^(1/a))/b)))
}
out<-quan(param,p)
if(log.p==TRUE & lower.tail == FALSE) out<-quan(param,exp(p-1))
if(log.p==TRUE & lower.tail == TRUE) out<-quan(param,exp(-p))
if(log.p==FALSE & lower.tail == FALSE) out<-quan(param,1-p)
return(out)
}
rgmbetaexpg<-function(n, g, param, location=TRUE){
if(g!="birnbaum-saunders" & g!="exp" & g!="rayleigh" & g!="weibull" & g!="gompertz" & g!="gamma"
& g!="log-normal" & g!="chisq" & g!="f" & g!="burrxii" & g!="frechet"
& g!="lomax" & g!="log-logistic" & g!="lfr" & g!="chen")
{ stop ("Baseline distribution not implemented or misspelled. Please check the manual for guidelines.") }
if(n %% 1 !=0) { stop ("parameter n must be integer.") }
if(g=="log-normal"){
quan0=function(par,x){meanlog=par[3]; sdlog=par[4]; loc=par[5]; qlnorm(x,meanlog,sdlog)+loc}
if (location==FALSE){
quan0=function(par,x){meanlog=par[3]; sdlog=par[4]; qlnorm(x,meanlog,sdlog)}
}}
if(g=="chisq"){
quan0=function(par,x){df=par[3]; loc=par[4]; qchisq(x,df)+loc}
if (location==FALSE){
quan0=function(par,x){df=par[3]; qchisq(x,df)}
}}
if(g=="f"){
quan0=function(par,x){df1=par[3]; df2=par[4]; loc=par[5]; qf(x,df1,df2)+loc}
if (location==FALSE){
quan0=function(par,x){df1=par[3]; df2=par[4]; qf(x,df1,df2)}
}}
if(g=="chen"){
quan0=function(par,x){a=par[3]; b=par[4]; loc=par[5]; (log(1-log(1-x)/b))^(1/a)+loc}
if (location==FALSE){
quan0=function(par,x){a=par[3]; b=par[4]; (log(1-log(1-x)/b))^(1/a)}
}}
if(g=="lfr"){
quan0=function(par,x){a=par[3]; b=par[4]; loc=par[5]; (-a+sqrt(a^2-2*b*log(1-x)))/b+loc}
if (location==FALSE){
quan0=function(par,x){a=par[3]; b=par[4]; (-a+sqrt(a^2-2*b*log(1-x)))/b}
}}
if(g=="log-logistic"){
quan0=function(par,x){a=par[3]; b=par[4]; loc=par[5]; b*(1/x-1)^(-1/a)+loc}
if (location==FALSE){
quan0=function(par,x){a=par[3]; b=par[4]; b*(1/x-1)^(-1/a)}
}}
if(g=="lomax"){
quan0=function(par,x){a=par[3]; b=par[4]; loc=par[5]; ((1-x)^(-1/b)-1)/a+loc}
if (location==FALSE){
quan0=function(par,x){a=par[3]; b=par[4]; ((1-x)^(-1/b)-1)/a}
}}
if(g=="gompertz"){
quan0=function(par,x){a=par[3]; b=par[4]; loc=par[5]; log(1-a/b*log(1-x))/a+loc}
if (location==FALSE){
quan0=function(par,x){a=par[3]; b=par[4]; log(1-a/b*log(1-x))/a}
}}
if(g=="exp"){
quan0=function(par,x){rate=par[3]; loc=par[4]; qexp(x,rate)+loc}
if (location==FALSE){
quan0=function(par,x){rate=par[3]; qexp(x,rate)}
}}
if(g=="rayleigh"){
quan0=function(par,x){a=par[3]; loc=par[4]; a*(-log(1-x))^(1/2)+loc}
if (location==FALSE){
quan0=function(par,x){a=par[3]; a*(-log(1-x))^(1/2)}
}}
if(g=="burrxii"){
quan0=function(par,x){a=par[3]; d=par[4]; loc=par[5]; (1/(1-x)-1)^(1/d)+loc}
if (location==FALSE){
quan0=function(par,x){a=par[3]; d=par[4]; (1/(1-x)-1)^(1/d)}
}}
if(g=="frechet"){
quan0=function(par,x){a=par[3]; b=par[4]; loc=par[5]; b*(-log(x))^(-1/a)+loc}
if (location==FALSE){
quan0=function(par,x){a=par[3]; b=par[4]; b*(-log(x))^(-1/a)}
}}
if(g=="birnbaum-saunders"){
quan0=function(par,x){a=par[3]; b=par[4]; loc=par[5]; b/4*(a*qnorm(x)+sqrt((a*qnorm(x))^2+4))^2+loc}
if (location==FALSE){
quan0=function(par,x){a=par[3]; b=par[4]; b/4*(a*qnorm(x)+sqrt((a*qnorm(x))^2+4))^2}
}}
if(g=="weibull"){
quan0=function(par,x){shape=par[3]; scale=par[4]; loc=par[5]; qweibull(x,shape,scale)+loc}
if (location==FALSE){
quan0=function(par,x){shape=par[3]; scale=par[4]; qweibull(x,shape,scale)}
}}
if(g=="gamma"){
quan0=function(par,x){shape=par[3]; scale=par[4]; loc=par[5]; qgamma(x,shape,scale)+loc}
if (location==FALSE){
quan0=function(par,x){shape=par[3]; scale=par[4]; qgamma(x,shape,scale)}
}}
quan<-function(par,x){
a=par[1]
b=par[2]
quan0(par,(-log(1-x^(1/a))/b)/(1+(-log(1-x^(1/a))/b)))
}
return(quan(param,runif(n)))
}
qgtransg<-function(p, g, param, location=TRUE, log.p = FALSE, lower.tail = TRUE){
if(g!="birnbaum-saunders" & g!="exp" & g!="rayleigh" & g!="weibull" & g!="gompertz" & g!="gamma"
& g!="log-normal" & g!="chisq" & g!="f" & g!="burrxii" & g!="frechet"
& g!="lomax" & g!="log-logistic" & g!="lfr" & g!="chen")
{ stop ("Baseline distribution not implemented or misspelled. Please check the manual for guidelines.") }
if(g=="log-normal"){
quan0=function(par,x){meanlog=par[3]; sdlog=par[4]; loc=par[5]; qlnorm(x,meanlog,sdlog)+loc}
if (location==FALSE){
quan0=function(par,x){meanlog=par[3]; sdlog=par[4]; qlnorm(x,meanlog,sdlog)}
}}
if(g=="chisq"){
quan0=function(par,x){df=par[3]; loc=par[4]; qchisq(x,df)+loc}
if (location==FALSE){
quan0=function(par,x){df=par[3]; qchisq(x,df)}
}}
if(g=="f"){
quan0=function(par,x){df1=par[3]; df2=par[4]; loc=par[5]; qf(x,df1,df2)+loc}
if (location==FALSE){
quan0=function(par,x){df1=par[3]; df2=par[4]; qf(x,df1,df2)}
}}
if(g=="chen"){
quan0=function(par,x){a=par[3]; b=par[4]; loc=par[5]; (log(1-log(1-x)/b))^(1/a)+loc}
if (location==FALSE){
quan0=function(par,x){a=par[3]; b=par[4]; (log(1-log(1-x)/b))^(1/a)}
}}
if(g=="lfr"){
quan0=function(par,x){a=par[3]; b=par[4]; loc=par[5]; (-a+sqrt(a^2-2*b*log(1-x)))/b+loc}
if (location==FALSE){
quan0=function(par,x){a=par[3]; b=par[4]; (-a+sqrt(a^2-2*b*log(1-x)))/b}
}}
if(g=="log-logistic"){
quan0=function(par,x){a=par[3]; b=par[4]; loc=par[5]; b*(1/x-1)^(-1/a)+loc}
if (location==FALSE){
quan0=function(par,x){a=par[3]; b=par[4]; b*(1/x-1)^(-1/a)}
}}
if(g=="lomax"){
quan0=function(par,x){a=par[3]; b=par[4]; loc=par[5]; ((1-x)^(-1/b)-1)/a+loc}
if (location==FALSE){
quan0=function(par,x){a=par[3]; b=par[4]; ((1-x)^(-1/b)-1)/a}
}}
if(g=="gompertz"){
quan0=function(par,x){a=par[3]; b=par[4]; loc=par[5]; log(1-a/b*log(1-x))/a+loc}
if (location==FALSE){
quan0=function(par,x){a=par[3]; b=par[4]; log(1-a/b*log(1-x))/a}
}}
if(g=="exp"){
quan0=function(par,x){rate=par[3]; loc=par[4]; qexp(x,rate)+loc}
if (location==FALSE){
quan0=function(par,x){rate=par[3]; qexp(x,rate)}
}}
if(g=="rayleigh"){
quan0=function(par,x){a=par[3]; loc=par[4]; a*(-log(1-x))^(1/2)+loc}
if (location==FALSE){
quan0=function(par,x){a=par[3]; a*(-log(1-x))^(1/2)}
}}
if(g=="burrxii"){
quan0=function(par,x){a=par[3]; d=par[4]; loc=par[5]; (1/(1-x)-1)^(1/d)+loc}
if (location==FALSE){
quan0=function(par,x){a=par[3]; d=par[4]; (1/(1-x)-1)^(1/d)}
}}
if(g=="frechet"){
quan0=function(par,x){a=par[3]; b=par[4]; loc=par[5]; b*(-log(x))^(-1/a)+loc}
if (location==FALSE){
quan0=function(par,x){a=par[3]; b=par[4]; b*(-log(x))^(-1/a)}
}}
if(g=="birnbaum-saunders"){
quan0=function(par,x){a=par[3]; b=par[4]; loc=par[5]; b/4*(a*qnorm(x)+sqrt((a*qnorm(x))^2+4))^2+loc}
if (location==FALSE){
quan0=function(par,x){a=par[3]; b=par[4]; b/4*(a*qnorm(x)+sqrt((a*qnorm(x))^2+4))^2}
}}
if(g=="weibull"){
quan0=function(par,x){shape=par[3]; scale=par[4]; loc=par[5]; qweibull(x,shape,scale)+loc}
if (location==FALSE){
quan0=function(par,x){shape=par[3]; scale=par[4]; qweibull(x,shape,scale)}
}}
if(g=="gamma"){
quan0=function(par,x){shape=par[3]; scale=par[4]; loc=par[5]; qgamma(x,shape,scale)+loc}
if (location==FALSE){
quan0=function(par,x){shape=par[3]; scale=par[4]; qgamma(x,shape,scale)}
}}
quan<-function(par,x){
a=par[1]
b=par[2]
quan0(par,(1+b-sqrt((1+b)^2-4*b*x^(1/a)))/(2*b))
}
out<-quan(param,p)
if(log.p==TRUE & lower.tail == FALSE) out<-quan(param,exp(p-1))
if(log.p==TRUE & lower.tail == TRUE) out<-quan(param,exp(-p))
if(log.p==FALSE & lower.tail == FALSE) out<-quan(param,1-p)
return(out)
}
rgtransg<-function(n, g, param, location=TRUE){
if(g!="birnbaum-saunders" & g!="exp" & g!="rayleigh" & g!="weibull" & g!="gompertz" & g!="gamma"
& g!="log-normal" & g!="chisq" & g!="f" & g!="burrxii" & g!="frechet"
& g!="lomax" & g!="log-logistic" & g!="lfr" & g!="chen")
{ stop ("Baseline distribution not implemented or misspelled. Please check the manual for guidelines.") }
if(n %% 1 !=0) { stop ("parameter n must be integer.") }
if(g=="log-normal"){
quan0=function(par,x){meanlog=par[3]; sdlog=par[4]; loc=par[5]; qlnorm(x,meanlog,sdlog)+loc}
if (location==FALSE){
quan0=function(par,x){meanlog=par[3]; sdlog=par[4]; qlnorm(x,meanlog,sdlog)}
}}
if(g=="chisq"){
quan0=function(par,x){df=par[3]; loc=par[4]; qchisq(x,df)+loc}
if (location==FALSE){
quan0=function(par,x){df=par[3]; qchisq(x,df)}
}}
if(g=="f"){
quan0=function(par,x){df1=par[3]; df2=par[4]; loc=par[5]; qf(x,df1,df2)+loc}
if (location==FALSE){
quan0=function(par,x){df1=par[3]; df2=par[4]; qf(x,df1,df2)}
}}
if(g=="chen"){
quan0=function(par,x){a=par[3]; b=par[4]; loc=par[5]; (log(1-log(1-x)/b))^(1/a)+loc}
if (location==FALSE){
quan0=function(par,x){a=par[3]; b=par[4]; (log(1-log(1-x)/b))^(1/a)}
}}
if(g=="lfr"){
quan0=function(par,x){a=par[3]; b=par[4]; loc=par[5]; (-a+sqrt(a^2-2*b*log(1-x)))/b+loc}
if (location==FALSE){
quan0=function(par,x){a=par[3]; b=par[4]; (-a+sqrt(a^2-2*b*log(1-x)))/b}
}}
if(g=="log-logistic"){
quan0=function(par,x){a=par[3]; b=par[4]; loc=par[5]; b*(1/x-1)^(-1/a)+loc}
if (location==FALSE){
quan0=function(par,x){a=par[3]; b=par[4]; b*(1/x-1)^(-1/a)}
}}
if(g=="lomax"){
quan0=function(par,x){a=par[3]; b=par[4]; loc=par[5]; ((1-x)^(-1/b)-1)/a+loc}
if (location==FALSE){
quan0=function(par,x){a=par[3]; b=par[4]; ((1-x)^(-1/b)-1)/a}
}}
if(g=="gompertz"){
quan0=function(par,x){a=par[3]; b=par[4]; loc=par[5]; log(1-a/b*log(1-x))/a+loc}
if (location==FALSE){
quan0=function(par,x){a=par[3]; b=par[4]; log(1-a/b*log(1-x))/a}
}}
if(g=="exp"){
quan0=function(par,x){rate=par[3]; loc=par[4]; qexp(x,rate)+loc}
if (location==FALSE){
quan0=function(par,x){rate=par[3]; qexp(x,rate)}
}}
if(g=="rayleigh"){
quan0=function(par,x){a=par[3]; loc=par[4]; a*(-log(1-x))^(1/2)+loc}
if (location==FALSE){
quan0=function(par,x){a=par[3]; a*(-log(1-x))^(1/2)}
}}
if(g=="burrxii"){
quan0=function(par,x){a=par[3]; d=par[4]; loc=par[5]; (1/(1-x)-1)^(1/d)+loc}
if (location==FALSE){
quan0=function(par,x){a=par[3]; d=par[4]; (1/(1-x)-1)^(1/d)}
}}
if(g=="frechet"){
quan0=function(par,x){a=par[3]; b=par[4]; loc=par[5]; b*(-log(x))^(-1/a)+loc}
if (location==FALSE){
quan0=function(par,x){a=par[3]; b=par[4]; b*(-log(x))^(-1/a)}
}}
if(g=="birnbaum-saunders"){
quan0=function(par,x){a=par[3]; b=par[4]; loc=par[5]; b/4*(a*qnorm(x)+sqrt((a*qnorm(x))^2+4))^2+loc}
if (location==FALSE){
quan0=function(par,x){a=par[3]; b=par[4]; b/4*(a*qnorm(x)+sqrt((a*qnorm(x))^2+4))^2}
}}
if(g=="weibull"){
quan0=function(par,x){shape=par[3]; scale=par[4]; loc=par[5]; qweibull(x,shape,scale)+loc}
if (location==FALSE){
quan0=function(par,x){shape=par[3]; scale=par[4]; qweibull(x,shape,scale)}
}}
if(g=="gamma"){
quan0=function(par,x){shape=par[3]; scale=par[4]; loc=par[5]; qgamma(x,shape,scale)+loc}
if (location==FALSE){
quan0=function(par,x){shape=par[3]; scale=par[4]; qgamma(x,shape,scale)}
}}
quan<-function(par,x){
a=par[1]
b=par[2]
quan0(par,(1+b-sqrt((1+b)^2-4*b*x^(1/a)))/(2*b))
}
return(quan(param,runif(n)))
}
qbetag<-function(p, g, param, location=TRUE, log.p = FALSE, lower.tail = TRUE){
if(g!="birnbaum-saunders" & g!="exp" & g!="rayleigh" & g!="weibull" & g!="gompertz" & g!="gamma"
& g!="log-normal" & g!="chisq" & g!="f" & g!="burrxii" & g!="frechet"
& g!="lomax" & g!="log-logistic" & g!="lfr" & g!="chen")
{ stop ("Baseline distribution not implemented or misspelled. Please check the manual for guidelines.") }
if(g=="log-normal"){
quan0=function(par,x){meanlog=par[3]; sdlog=par[4]; loc=par[5]; qlnorm(x,meanlog,sdlog)+loc}
if (location==FALSE){
quan0=function(par,x){meanlog=par[3]; sdlog=par[4]; qlnorm(x,meanlog,sdlog)}
}}
if(g=="chisq"){
quan0=function(par,x){df=par[3]; loc=par[4]; qchisq(x,df)+loc}
if (location==FALSE){
quan0=function(par,x){df=par[3]; qchisq(x,df)}
}}
if(g=="f"){
quan0=function(par,x){df1=par[3]; df2=par[4]; loc=par[5]; qf(x,df1,df2)+loc}
if (location==FALSE){
quan0=function(par,x){df1=par[3]; df2=par[4]; qf(x,df1,df2)}
}}
if(g=="chen"){
quan0=function(par,x){a=par[3]; b=par[4]; loc=par[5]; (log(1-log(1-x)/b))^(1/a)+loc}
if (location==FALSE){
quan0=function(par,x){a=par[3]; b=par[4]; (log(1-log(1-x)/b))^(1/a)}
}}
if(g=="lfr"){
quan0=function(par,x){a=par[3]; b=par[4]; loc=par[5]; (-a+sqrt(a^2-2*b*log(1-x)))/b+loc}
if (location==FALSE){
quan0=function(par,x){a=par[3]; b=par[4]; (-a+sqrt(a^2-2*b*log(1-x)))/b}
}}
if(g=="log-logistic"){
quan0=function(par,x){a=par[3]; b=par[4]; loc=par[5]; b*(1/x-1)^(-1/a)+loc}
if (location==FALSE){
quan0=function(par,x){a=par[3]; b=par[4]; b*(1/x-1)^(-1/a)}
}}
if(g=="lomax"){
quan0=function(par,x){a=par[3]; b=par[4]; loc=par[5]; ((1-x)^(-1/b)-1)/a+loc}
if (location==FALSE){
quan0=function(par,x){a=par[3]; b=par[4]; ((1-x)^(-1/b)-1)/a}
}}
if(g=="gompertz"){
quan0=function(par,x){a=par[3]; b=par[4]; loc=par[5]; log(1-a/b*log(1-x))/a+loc}
if (location==FALSE){
quan0=function(par,x){a=par[3]; b=par[4]; log(1-a/b*log(1-x))/a}
}}
if(g=="exp"){
quan0=function(par,x){rate=par[3]; loc=par[4]; qexp(x,rate)+loc}
if (location==FALSE){
quan0=function(par,x){rate=par[3]; qexp(x,rate)}
}}
if(g=="rayleigh"){
quan0=function(par,x){a=par[3]; loc=par[4]; a*(-log(1-x))^(1/2)+loc}
if (location==FALSE){
quan0=function(par,x){a=par[3]; a*(-log(1-x))^(1/2)}
}}
if(g=="burrxii"){
quan0=function(par,x){a=par[3]; d=par[4]; loc=par[5]; (1/(1-x)-1)^(1/d)+loc}
if (location==FALSE){
quan0=function(par,x){a=par[3]; d=par[4]; (1/(1-x)-1)^(1/d)}
}}
if(g=="frechet"){
quan0=function(par,x){a=par[3]; b=par[4]; loc=par[5]; b*(-log(x))^(-1/a)+loc}
if (location==FALSE){
quan0=function(par,x){a=par[3]; b=par[4]; b*(-log(x))^(-1/a)}
}}
if(g=="birnbaum-saunders"){
quan0=function(par,x){a=par[3]; b=par[4]; loc=par[5]; b/4*(a*qnorm(x)+sqrt((a*qnorm(x))^2+4))^2+loc}
if (location==FALSE){
quan0=function(par,x){a=par[3]; b=par[4]; b/4*(a*qnorm(x)+sqrt((a*qnorm(x))^2+4))^2}
}}
if(g=="weibull"){
quan0=function(par,x){shape=par[3]; scale=par[4]; loc=par[5]; qweibull(x,shape,scale)+loc}
if (location==FALSE){
quan0=function(par,x){shape=par[3]; scale=par[4]; qweibull(x,shape,scale)}
}}
if(g=="gamma"){
quan0=function(par,x){shape=par[3]; scale=par[4]; loc=par[5]; qgamma(x,shape,scale)+loc}
if (location==FALSE){
quan0=function(par,x){shape=par[3]; scale=par[4]; qgamma(x,shape,scale)}
}}
quan<-function(par,x){
a=par[1]
b=par[2]
quan0(par,qbeta(x,shape1=a,shape2=b))
}
out<-quan(param,p)
if(log.p==TRUE & lower.tail == FALSE) out<-quan(param,exp(p-1))
if(log.p==TRUE & lower.tail == TRUE) out<-quan(param,exp(-p))
if(log.p==FALSE & lower.tail == FALSE) out<-quan(param,1-p)
return(out)
}
rbetag<-function(n, g, param, location=TRUE){
if(g!="birnbaum-saunders" & g!="exp" & g!="rayleigh" & g!="weibull" & g!="gompertz" & g!="gamma"
& g!="log-normal" & g!="chisq" & g!="f" & g!="burrxii" & g!="frechet"
& g!="lomax" & g!="log-logistic" & g!="lfr" & g!="chen")
{ stop ("Baseline distribution not implemented or misspelled. Please check the manual for guidelines.") }
if(n %% 1 !=0) { stop ("parameter n must be integer.") }
if(g=="log-normal"){
quan0=function(par,x){meanlog=par[3]; sdlog=par[4]; loc=par[5]; qlnorm(x,meanlog,sdlog)+loc}
if (location==FALSE){
quan0=function(par,x){meanlog=par[3]; sdlog=par[4]; qlnorm(x,meanlog,sdlog)}
}}
if(g=="chisq"){
quan0=function(par,x){df=par[3]; loc=par[4]; qchisq(x,df)+loc}
if (location==FALSE){
quan0=function(par,x){df=par[3]; qchisq(x,df)}
}}
if(g=="f"){
quan0=function(par,x){df1=par[3]; df2=par[4]; loc=par[5]; qf(x,df1,df2)+loc}
if (location==FALSE){
quan0=function(par,x){df1=par[3]; df2=par[4]; qf(x,df1,df2)}
}}
if(g=="chen"){
quan0=function(par,x){a=par[3]; b=par[4]; loc=par[5]; (log(1-log(1-x)/b))^(1/a)+loc}
if (location==FALSE){
quan0=function(par,x){a=par[3]; b=par[4]; (log(1-log(1-x)/b))^(1/a)}
}}
if(g=="lfr"){
quan0=function(par,x){a=par[3]; b=par[4]; loc=par[5]; (-a+sqrt(a^2-2*b*log(1-x)))/b+loc}
if (location==FALSE){
quan0=function(par,x){a=par[3]; b=par[4]; (-a+sqrt(a^2-2*b*log(1-x)))/b}
}}
if(g=="log-logistic"){
quan0=function(par,x){a=par[3]; b=par[4]; loc=par[5]; b*(1/x-1)^(-1/a)+loc}
if (location==FALSE){
quan0=function(par,x){a=par[3]; b=par[4]; b*(1/x-1)^(-1/a)}
}}
if(g=="lomax"){
quan0=function(par,x){a=par[3]; b=par[4]; loc=par[5]; ((1-x)^(-1/b)-1)/a+loc}
if (location==FALSE){
quan0=function(par,x){a=par[3]; b=par[4]; ((1-x)^(-1/b)-1)/a}
}}
if(g=="gompertz"){
quan0=function(par,x){a=par[3]; b=par[4]; loc=par[5]; log(1-a/b*log(1-x))/a+loc}
if (location==FALSE){
quan0=function(par,x){a=par[3]; b=par[4]; log(1-a/b*log(1-x))/a}
}}
if(g=="exp"){
quan0=function(par,x){rate=par[3]; loc=par[4]; qexp(x,rate)+loc}
if (location==FALSE){
quan0=function(par,x){rate=par[3]; qexp(x,rate)}
}}
if(g=="rayleigh"){
quan0=function(par,x){a=par[3]; loc=par[4]; a*(-log(1-x))^(1/2)+loc}
if (location==FALSE){
quan0=function(par,x){a=par[3]; a*(-log(1-x))^(1/2)}
}}
if(g=="burrxii"){
quan0=function(par,x){a=par[3]; d=par[4]; loc=par[5]; (1/(1-x)-1)^(1/d)+loc}
if (location==FALSE){
quan0=function(par,x){a=par[3]; d=par[4]; (1/(1-x)-1)^(1/d)}
}}
if(g=="frechet"){
quan0=function(par,x){a=par[3]; b=par[4]; loc=par[5]; b*(-log(x))^(-1/a)+loc}
if (location==FALSE){
quan0=function(par,x){a=par[3]; b=par[4]; b*(-log(x))^(-1/a)}
}}
if(g=="birnbaum-saunders"){
quan0=function(par,x){a=par[3]; b=par[4]; loc=par[5]; b/4*(a*qnorm(x)+sqrt((a*qnorm(x))^2+4))^2+loc}
if (location==FALSE){
quan0=function(par,x){a=par[3]; b=par[4]; b/4*(a*qnorm(x)+sqrt((a*qnorm(x))^2+4))^2}
}}
if(g=="weibull"){
quan0=function(par,x){shape=par[3]; scale=par[4]; loc=par[5]; qweibull(x,shape,scale)+loc}
if (location==FALSE){
quan0=function(par,x){shape=par[3]; scale=par[4]; qweibull(x,shape,scale)}
}}
if(g=="gamma"){
quan0=function(par,x){shape=par[3]; scale=par[4]; loc=par[5]; qgamma(x,shape,scale)+loc}
if (location==FALSE){
quan0=function(par,x){shape=par[3]; scale=par[4]; qgamma(x,shape,scale)}
}}
quan<-function(par,x){
a=par[1]
b=par[2]
quan0(par,qbeta(x,shape1=a,shape2=b))
}
return(quan(param,runif(n)))
}
qgexppg<-function(p, g, param, location=TRUE, log.p = FALSE, lower.tail = TRUE){
if(g!="birnbaum-saunders" & g!="exp" & g!="rayleigh" & g!="weibull" & g!="gompertz" & g!="gamma"
& g!="log-normal" & g!="chisq" & g!="f" & g!="burrxii" & g!="frechet"
& g!="lomax" & g!="log-logistic" & g!="lfr" & g!="chen")
{ stop ("Baseline distribution not implemented or misspelled. Please check the manual for guidelines.") }
if(g=="log-normal"){
quan0=function(par,x){meanlog=par[3]; sdlog=par[4]; loc=par[5]; qlnorm(x,meanlog,sdlog)+loc}
if (location==FALSE){
quan0=function(par,x){meanlog=par[3]; sdlog=par[4]; qlnorm(x,meanlog,sdlog)}
}}
if(g=="chisq"){
quan0=function(par,x){df=par[3]; loc=par[4]; qchisq(x,df)+loc}
if (location==FALSE){
quan0=function(par,x){df=par[3]; qchisq(x,df)}
}}
if(g=="f"){
quan0=function(par,x){df1=par[3]; df2=par[4]; loc=par[5]; qf(x,df1,df2)+loc}
if (location==FALSE){
quan0=function(par,x){df1=par[3]; df2=par[4]; qf(x,df1,df2)}
}}
if(g=="chen"){
quan0=function(par,x){a=par[3]; b=par[4]; loc=par[5]; (log(1-log(1-x)/b))^(1/a)+loc}
if (location==FALSE){
quan0=function(par,x){a=par[3]; b=par[4]; (log(1-log(1-x)/b))^(1/a)}
}}
if(g=="lfr"){
quan0=function(par,x){a=par[3]; b=par[4]; loc=par[5]; (-a+sqrt(a^2-2*b*log(1-x)))/b+loc}
if (location==FALSE){
quan0=function(par,x){a=par[3]; b=par[4]; (-a+sqrt(a^2-2*b*log(1-x)))/b}
}}
if(g=="log-logistic"){
quan0=function(par,x){a=par[3]; b=par[4]; loc=par[5]; b*(1/x-1)^(-1/a)+loc}
if (location==FALSE){
quan0=function(par,x){a=par[3]; b=par[4]; b*(1/x-1)^(-1/a)}
}}
if(g=="lomax"){
quan0=function(par,x){a=par[3]; b=par[4]; loc=par[5]; ((1-x)^(-1/b)-1)/a+loc}
if (location==FALSE){
quan0=function(par,x){a=par[3]; b=par[4]; ((1-x)^(-1/b)-1)/a}
}}
if(g=="gompertz"){
quan0=function(par,x){a=par[3]; b=par[4]; loc=par[5]; log(1-a/b*log(1-x))/a+loc}
if (location==FALSE){
quan0=function(par,x){a=par[3]; b=par[4]; log(1-a/b*log(1-x))/a}
}}
if(g=="exp"){
quan0=function(par,x){rate=par[3]; loc=par[4]; qexp(x,rate)+loc}
if (location==FALSE){
quan0=function(par,x){rate=par[3]; qexp(x,rate)}
}}
if(g=="rayleigh"){
quan0=function(par,x){a=par[3]; loc=par[4]; a*(-log(1-x))^(1/2)+loc}
if (location==FALSE){
quan0=function(par,x){a=par[3]; a*(-log(1-x))^(1/2)}
}}
if(g=="burrxii"){
quan0=function(par,x){a=par[3]; d=par[4]; loc=par[5]; (1/(1-x)-1)^(1/d)+loc}
if (location==FALSE){
quan0=function(par,x){a=par[3]; d=par[4]; (1/(1-x)-1)^(1/d)}
}}
if(g=="frechet"){
quan0=function(par,x){a=par[3]; b=par[4]; loc=par[5]; b*(-log(x))^(-1/a)+loc}
if (location==FALSE){
quan0=function(par,x){a=par[3]; b=par[4]; b*(-log(x))^(-1/a)}
}}
if(g=="birnbaum-saunders"){
quan0=function(par,x){a=par[3]; b=par[4]; loc=par[5]; b/4*(a*qnorm(x)+sqrt((a*qnorm(x))^2+4))^2+loc}
if (location==FALSE){
quan0=function(par,x){a=par[3]; b=par[4]; b/4*(a*qnorm(x)+sqrt((a*qnorm(x))^2+4))^2}
}}
if(g=="weibull"){
quan0=function(par,x){shape=par[3]; scale=par[4]; loc=par[5]; qweibull(x,shape,scale)+loc}
if (location==FALSE){
quan0=function(par,x){shape=par[3]; scale=par[4]; qweibull(x,shape,scale)}
}}
if(g=="gamma"){
quan0=function(par,x){shape=par[3]; scale=par[4]; loc=par[5]; qgamma(x,shape,scale)+loc}
if (location==FALSE){
quan0=function(par,x){shape=par[3]; scale=par[4]; qgamma(x,shape,scale)}
}}
quan<-function(par,x){
theta=par[1]
eta=par[2]
quan0(par,1+log(((1-exp(-theta))*x-x*eta+exp(-theta))/(1-x*eta))/theta)
}
out<-quan(param,p)
if(log.p==TRUE & lower.tail == FALSE) out<-quan(param,exp(p-1))
if(log.p==TRUE & lower.tail == TRUE) out<-quan(param,exp(-p))
if(log.p==FALSE & lower.tail == FALSE) out<-quan(param,1-p)
return(out)
}
rgexppg<-function(n, g, param, location=TRUE){
if(g!="birnbaum-saunders" & g!="exp" & g!="rayleigh" & g!="weibull" & g!="gompertz" & g!="gamma"
& g!="log-normal" & g!="chisq" & g!="f" & g!="burrxii" & g!="frechet"
& g!="lomax" & g!="log-logistic" & g!="lfr" & g!="chen")
{ stop ("Baseline distribution not implemented or misspelled. Please check the manual for guidelines.") }
if(n %% 1 !=0) { stop ("parameter n must be integer.") }
if(g=="log-normal"){
quan0=function(par,x){meanlog=par[3]; sdlog=par[4]; loc=par[5]; qlnorm(x,meanlog,sdlog)+loc}
if (location==FALSE){
quan0=function(par,x){meanlog=par[3]; sdlog=par[4]; qlnorm(x,meanlog,sdlog)}
}}
if(g=="chisq"){
quan0=function(par,x){df=par[3]; loc=par[4]; qchisq(x,df)+loc}
if (location==FALSE){
quan0=function(par,x){df=par[3]; qchisq(x,df)}
}}
if(g=="f"){
quan0=function(par,x){df1=par[3]; df2=par[4]; loc=par[5]; qf(x,df1,df2)+loc}
if (location==FALSE){
quan0=function(par,x){df1=par[3]; df2=par[4]; qf(x,df1,df2)}
}}
if(g=="chen"){
quan0=function(par,x){a=par[3]; b=par[4]; loc=par[5]; (log(1-log(1-x)/b))^(1/a)+loc}
if (location==FALSE){
quan0=function(par,x){a=par[3]; b=par[4]; (log(1-log(1-x)/b))^(1/a)}
}}
if(g=="lfr"){
quan0=function(par,x){a=par[3]; b=par[4]; loc=par[5]; (-a+sqrt(a^2-2*b*log(1-x)))/b+loc}
if (location==FALSE){
quan0=function(par,x){a=par[3]; b=par[4]; (-a+sqrt(a^2-2*b*log(1-x)))/b}
}}
if(g=="log-logistic"){
quan0=function(par,x){a=par[3]; b=par[4]; loc=par[5]; b*(1/x-1)^(-1/a)+loc}
if (location==FALSE){
quan0=function(par,x){a=par[3]; b=par[4]; b*(1/x-1)^(-1/a)}
}}
if(g=="lomax"){
quan0=function(par,x){a=par[3]; b=par[4]; loc=par[5]; ((1-x)^(-1/b)-1)/a+loc}
if (location==FALSE){
quan0=function(par,x){a=par[3]; b=par[4]; ((1-x)^(-1/b)-1)/a}
}}
if(g=="gompertz"){
quan0=function(par,x){a=par[3]; b=par[4]; loc=par[5]; log(1-a/b*log(1-x))/a+loc}
if (location==FALSE){
quan0=function(par,x){a=par[3]; b=par[4]; log(1-a/b*log(1-x))/a}
}}
if(g=="exp"){
quan0=function(par,x){rate=par[3]; loc=par[4]; qexp(x,rate)+loc}
if (location==FALSE){
quan0=function(par,x){rate=par[3]; qexp(x,rate)}
}}
if(g=="rayleigh"){
quan0=function(par,x){a=par[3]; loc=par[4]; a*(-log(1-x))^(1/2)+loc}
if (location==FALSE){
quan0=function(par,x){a=par[3]; a*(-log(1-x))^(1/2)}
}}
if(g=="burrxii"){
quan0=function(par,x){a=par[3]; d=par[4]; loc=par[5]; (1/(1-x)-1)^(1/d)+loc}
if (location==FALSE){
quan0=function(par,x){a=par[3]; d=par[4]; (1/(1-x)-1)^(1/d)}
}}
if(g=="frechet"){
quan0=function(par,x){a=par[3]; b=par[4]; loc=par[5]; b*(-log(x))^(-1/a)+loc}
if (location==FALSE){
quan0=function(par,x){a=par[3]; b=par[4]; b*(-log(x))^(-1/a)}
}}
if(g=="birnbaum-saunders"){
quan0=function(par,x){a=par[3]; b=par[4]; loc=par[5]; b/4*(a*qnorm(x)+sqrt((a*qnorm(x))^2+4))^2+loc}
if (location==FALSE){
quan0=function(par,x){a=par[3]; b=par[4]; b/4*(a*qnorm(x)+sqrt((a*qnorm(x))^2+4))^2}
}}
if(g=="weibull"){
quan0=function(par,x){shape=par[3]; scale=par[4]; loc=par[5]; qweibull(x,shape,scale)+loc}
if (location==FALSE){
quan0=function(par,x){shape=par[3]; scale=par[4]; qweibull(x,shape,scale)}
}}
if(g=="gamma"){
quan0=function(par,x){shape=par[3]; scale=par[4]; loc=par[5]; qgamma(x,shape,scale)+loc}
if (location==FALSE){
quan0=function(par,x){shape=par[3]; scale=par[4]; qgamma(x,shape,scale)}
}}
quan<-function(par,x){
theta=par[1]
eta=par[2]
quan0(par,1+log(((1-exp(-theta))*x-x*eta+exp(-theta))/(1-x*eta))/theta)
}
return(quan(param,runif(n)))
}
qgxlogisticg<-function(p, g, param, location=TRUE, log.p = FALSE, lower.tail = TRUE){
if(g!="birnbaum-saunders" & g!="exp" & g!="rayleigh" & g!="weibull" & g!="gompertz" & g!="gamma"
& g!="log-normal" & g!="chisq" & g!="f" & g!="burrxii" & g!="frechet"
& g!="lomax" & g!="log-logistic" & g!="lfr" & g!="chen")
{ stop ("Baseline distribution not implemented or misspelled. Please check the manual for guidelines.") }
if(g=="log-normal"){
quan0=function(par,x){meanlog=par[2]; sdlog=par[3]; loc=par[4]; qlnorm(x,meanlog,sdlog)+loc}
if (location==FALSE){
quan0=function(par,x){meanlog=par[2]; sdlog=par[3]; qlnorm(x,meanlog,sdlog)}
}}
if(g=="chisq"){
quan0=function(par,x){df=par[2]; loc=par[3]; qchisq(x,df)+loc}
if (location==FALSE){
quan0=function(par,x){df=par[2]; qchisq(x,df)}
}}
if(g=="f"){
quan0=function(par,x){df1=par[2]; df2=par[3]; loc=par[4]; qf(x,df1,df2)+loc}
if (location==FALSE){
quan0=function(par,x){df1=par[2]; df2=par[3]; qf(x,df1,df2)}
}}
if(g=="chen"){
quan0=function(par,x){a=par[2]; b=par[3]; loc=par[4]; (log(1-log(1-x)/b))^(1/a)+loc}
if (location==FALSE){
quan0=function(par,x){a=par[2]; b=par[3]; (log(1-log(1-x)/b))^(1/a)}
}}
if(g=="lfr"){
quan0=function(par,x){a=par[2]; b=par[3]; loc=par[4]; (-a+sqrt(a^2-2*b*log(1-x)))/b+loc}
if (location==FALSE){
quan0=function(par,x){a=par[2]; b=par[3]; (-a+sqrt(a^2-2*b*log(1-x)))/b}
}}
if(g=="log-logistic"){
quan0=function(par,x){a=par[2]; b=par[3]; loc=par[4]; b*(1/x-1)^(-1/a)+loc}
if (location==FALSE){
quan0=function(par,x){a=par[2]; b=par[3]; b*(1/x-1)^(-1/a)}
}}
if(g=="lomax"){
quan0=function(par,x){a=par[2]; b=par[3]; loc=par[4]; ((1-x)^(-1/b)-1)/a+loc}
if (location==FALSE){
quan0=function(par,x){a=par[2]; b=par[3]; ((1-x)^(-1/b)-1)/a}
}}
if(g=="gompertz"){
quan0=function(par,x){a=par[2]; b=par[3]; loc=par[4]; log(1-a/b*log(1-x))/a+loc}
if (location==FALSE){
quan0=function(par,x){a=par[2]; b=par[3]; log(1-a/b*log(1-x))/a}
}}
if(g=="exp"){
quan0=function(par,x){rate=par[2]; loc=par[3]; qexp(x,rate)+loc}
if (location==FALSE){
quan0=function(par,x){rate=par[2]; qexp(x,rate)}
}}
if(g=="rayleigh"){
quan0=function(par,x){a=par[2]; loc=par[3]; a*(-log(1-x))^(1/2)+loc}
if (location==FALSE){
quan0=function(par,x){a=par[2]; a*(-log(1-x))^(1/2)}
}}
if(g=="burrxii"){
quan0=function(par,x){a=par[2]; d=par[3]; loc=par[4]; (1/(1-x)-1)^(1/d)+loc}
if (location==FALSE){
quan0=function(par,x){a=par[2]; d=par[3]; (1/(1-x)-1)^(1/d)}
}}
if(g=="frechet"){
quan0=function(par,x){a=par[2]; b=par[3]; loc=par[4]; b*(-log(x))^(-1/a)+loc}
if (location==FALSE){
quan0=function(par,x){a=par[2]; b=par[3]; b*(-log(x))^(-1/a)}
}}
if(g=="birnbaum-saunders"){
quan0=function(par,x){a=par[2]; b=par[3]; loc=par[4]; b/4*(a*qnorm(x)+sqrt((a*qnorm(x))^2+4))^2+loc}
if (location==FALSE){
quan0=function(par,x){a=par[2]; b=par[3]; b/4*(a*qnorm(x)+sqrt((a*qnorm(x))^2+4))^2}
}}
if(g=="weibull"){
quan0=function(par,x){shape=par[2]; scale=par[3]; loc=par[4]; qweibull(x,shape,scale)+loc}
if (location==FALSE){
quan0=function(par,x){shape=par[2]; scale=par[3]; qweibull(x,shape,scale)}
}}
if(g=="gamma"){
quan0=function(par,x){shape=par[2]; scale=par[3]; loc=par[4]; qgamma(x,shape,scale)+loc}
if (location==FALSE){
quan0=function(par,x){shape=par[2]; scale=par[3]; qgamma(x,shape,scale)}
}}
quan<-function(par,x){
a=par[1]
quan0(par,1-exp(-((1-x)/x)^(-1/a)))
}
out<-quan(param,p)
if(log.p==TRUE & lower.tail == FALSE) out<-quan(param,exp(p-1))
if(log.p==TRUE & lower.tail == TRUE) out<-quan(param,exp(-p))
if(log.p==FALSE & lower.tail == FALSE) out<-quan(param,1-p)
return(out)
}
rgxlogisticg<-function(n, g, param, location=TRUE){
if(g!="birnbaum-saunders" & g!="exp" & g!="rayleigh" & g!="weibull" & g!="gompertz" & g!="gamma"
& g!="log-normal" & g!="chisq" & g!="f" & g!="burrxii" & g!="frechet"
& g!="lomax" & g!="log-logistic" & g!="lfr" & g!="chen")
{ stop ("Baseline distribution not implemented or misspelled. Please check the manual for guidelines.") }
if(n %% 1 !=0) { stop ("parameter n must be integer.") }
if(g=="log-normal"){
quan0=function(par,x){meanlog=par[2]; sdlog=par[3]; loc=par[4]; qlnorm(x,meanlog,sdlog)+loc}
if (location==FALSE){
quan0=function(par,x){meanlog=par[2]; sdlog=par[3]; qlnorm(x,meanlog,sdlog)}
}}
if(g=="chisq"){
quan0=function(par,x){df=par[2]; loc=par[3]; qchisq(x,df)+loc}
if (location==FALSE){
quan0=function(par,x){df=par[2]; qchisq(x,df)}
}}
if(g=="f"){
quan0=function(par,x){df1=par[2]; df2=par[3]; loc=par[4]; qf(x,df1,df2)+loc}
if (location==FALSE){
quan0=function(par,x){df1=par[2]; df2=par[3]; qf(x,df1,df2)}
}}
if(g=="chen"){
quan0=function(par,x){a=par[2]; b=par[3]; loc=par[4]; (log(1-log(1-x)/b))^(1/a)+loc}
if (location==FALSE){
quan0=function(par,x){a=par[2]; b=par[3]; (log(1-log(1-x)/b))^(1/a)}
}}
if(g=="lfr"){
quan0=function(par,x){a=par[2]; b=par[3]; loc=par[4]; (-a+sqrt(a^2-2*b*log(1-x)))/b+loc}
if (location==FALSE){
quan0=function(par,x){a=par[2]; b=par[3]; (-a+sqrt(a^2-2*b*log(1-x)))/b}
}}
if(g=="log-logistic"){
quan0=function(par,x){a=par[2]; b=par[3]; loc=par[4]; b*(1/x-1)^(-1/a)+loc}
if (location==FALSE){
quan0=function(par,x){a=par[2]; b=par[3]; b*(1/x-1)^(-1/a)}
}}
if(g=="lomax"){
quan0=function(par,x){a=par[2]; b=par[3]; loc=par[4]; ((1-x)^(-1/b)-1)/a+loc}
if (location==FALSE){
quan0=function(par,x){a=par[2]; b=par[3]; ((1-x)^(-1/b)-1)/a}
}}
if(g=="gompertz"){
quan0=function(par,x){a=par[2]; b=par[3]; loc=par[4]; log(1-a/b*log(1-x))/a+loc}
if (location==FALSE){
quan0=function(par,x){a=par[2]; b=par[3]; log(1-a/b*log(1-x))/a}
}}
if(g=="exp"){
quan0=function(par,x){rate=par[2]; loc=par[3]; qexp(x,rate)+loc}
if (location==FALSE){
quan0=function(par,x){rate=par[2]; qexp(x,rate)}
}}
if(g=="rayleigh"){
quan0=function(par,x){a=par[2]; loc=par[3]; a*(-log(1-x))^(1/2)+loc}
if (location==FALSE){
quan0=function(par,x){a=par[2]; a*(-log(1-x))^(1/2)}
}}
if(g=="burrxii"){
quan0=function(par,x){a=par[2]; d=par[3]; loc=par[4]; (1/(1-x)-1)^(1/d)+loc}
if (location==FALSE){
quan0=function(par,x){a=par[2]; d=par[3]; (1/(1-x)-1)^(1/d)}
}}
if(g=="frechet"){
quan0=function(par,x){a=par[2]; b=par[3]; loc=par[4]; b*(-log(x))^(-1/a)+loc}
if (location==FALSE){
quan0=function(par,x){a=par[2]; b=par[3]; b*(-log(x))^(-1/a)}
}}
if(g=="birnbaum-saunders"){
quan0=function(par,x){a=par[2]; b=par[3]; loc=par[4]; b/4*(a*qnorm(x)+sqrt((a*qnorm(x))^2+4))^2+loc}
if (location==FALSE){
quan0=function(par,x){a=par[2]; b=par[3]; b/4*(a*qnorm(x)+sqrt((a*qnorm(x))^2+4))^2}
}}
if(g=="weibull"){
quan0=function(par,x){shape=par[2]; scale=par[3]; loc=par[4]; qweibull(x,shape,scale)+loc}
if (location==FALSE){
quan0=function(par,x){shape=par[2]; scale=par[3]; qweibull(x,shape,scale)}
}}
if(g=="gamma"){
quan0=function(par,x){shape=par[2]; scale=par[3]; loc=par[4]; qgamma(x,shape,scale)+loc}
if (location==FALSE){
quan0=function(par,x){shape=par[2]; scale=par[3]; qgamma(x,shape,scale)}
}}
quan<-function(par,x){
a=par[1]
quan0(par,1-exp(-((1-x)/x)^(-1/a)))
}
return(quan(param,runif(n)))
}
qmog<-function(p, g, param, location=TRUE, log.p = FALSE, lower.tail = TRUE){
if(g!="birnbaum-saunders" & g!="exp" & g!="rayleigh" & g!="weibull" & g!="gompertz" & g!="gamma"
& g!="log-normal" & g!="chisq" & g!="f" & g!="burrxii" & g!="frechet"
& g!="lomax" & g!="log-logistic" & g!="lfr" & g!="chen")
{ stop ("Baseline distribution not implemented or misspelled. Please check the manual for guidelines.") }
if(g=="log-normal"){
quan0=function(par,x){meanlog=par[2]; sdlog=par[3]; loc=par[4]; qlnorm(x,meanlog,sdlog)+loc}
if (location==FALSE){
quan0=function(par,x){meanlog=par[2]; sdlog=par[3]; qlnorm(x,meanlog,sdlog)}
}}
if(g=="chisq"){
quan0=function(par,x){df=par[2]; loc=par[3]; qchisq(x,df)+loc}
if (location==FALSE){
quan0=function(par,x){df=par[2]; qchisq(x,df)}
}}
if(g=="f"){
quan0=function(par,x){df1=par[2]; df2=par[3]; loc=par[4]; qf(x,df1,df2)+loc}
if (location==FALSE){
quan0=function(par,x){df1=par[2]; df2=par[3]; qf(x,df1,df2)}
}}
if(g=="chen"){
quan0=function(par,x){a=par[2]; b=par[3]; loc=par[4]; (log(1-log(1-x)/b))^(1/a)+loc}
if (location==FALSE){
quan0=function(par,x){a=par[2]; b=par[3]; (log(1-log(1-x)/b))^(1/a)}
}}
if(g=="lfr"){
quan0=function(par,x){a=par[2]; b=par[3]; loc=par[4]; (-a+sqrt(a^2-2*b*log(1-x)))/b+loc}
if (location==FALSE){
quan0=function(par,x){a=par[2]; b=par[3]; (-a+sqrt(a^2-2*b*log(1-x)))/b}
}}
if(g=="log-logistic"){
quan0=function(par,x){a=par[2]; b=par[3]; loc=par[4]; b*(1/x-1)^(-1/a)+loc}
if (location==FALSE){
quan0=function(par,x){a=par[2]; b=par[3]; b*(1/x-1)^(-1/a)}
}}
if(g=="lomax"){
quan0=function(par,x){a=par[2]; b=par[3]; loc=par[4]; ((1-x)^(-1/b)-1)/a+loc}
if (location==FALSE){
quan0=function(par,x){a=par[2]; b=par[3]; ((1-x)^(-1/b)-1)/a}
}}
if(g=="gompertz"){
quan0=function(par,x){a=par[2]; b=par[3]; loc=par[4]; log(1-a/b*log(1-x))/a+loc}
if (location==FALSE){
quan0=function(par,x){a=par[2]; b=par[3]; log(1-a/b*log(1-x))/a}
}}
if(g=="exp"){
quan0=function(par,x){rate=par[2]; loc=par[3]; qexp(x,rate)+loc}
if (location==FALSE){
quan0=function(par,x){rate=par[2]; qexp(x,rate)}
}}
if(g=="rayleigh"){
quan0=function(par,x){a=par[2]; loc=par[3]; a*(-log(1-x))^(1/2)+loc}
if (location==FALSE){
quan0=function(par,x){a=par[2]; a*(-log(1-x))^(1/2)}
}}
if(g=="burrxii"){
quan0=function(par,x){a=par[2]; d=par[3]; loc=par[4]; (1/(1-x)-1)^(1/d)+loc}
if (location==FALSE){
quan0=function(par,x){a=par[2]; d=par[3]; (1/(1-x)-1)^(1/d)}
}}
if(g=="frechet"){
quan0=function(par,x){a=par[2]; b=par[3]; loc=par[4]; b*(-log(x))^(-1/a)+loc}
if (location==FALSE){
quan0=function(par,x){a=par[2]; b=par[3]; b*(-log(x))^(-1/a)}
}}
if(g=="birnbaum-saunders"){
quan0=function(par,x){a=par[2]; b=par[3]; loc=par[4]; b/4*(a*qnorm(x)+sqrt((a*qnorm(x))^2+4))^2+loc}
if (location==FALSE){
quan0=function(par,x){a=par[2]; b=par[3]; b/4*(a*qnorm(x)+sqrt((a*qnorm(x))^2+4))^2}
}}
if(g=="weibull"){
quan0=function(par,x){shape=par[2]; scale=par[3]; loc=par[4]; qweibull(x,shape,scale)+loc}
if (location==FALSE){
quan0=function(par,x){shape=par[2]; scale=par[3]; qweibull(x,shape,scale)}
}}
if(g=="gamma"){
quan0=function(par,x){shape=par[2]; scale=par[3]; loc=par[4]; qgamma(x,shape,scale)+loc}
if (location==FALSE){
quan0=function(par,x){shape=par[2]; scale=par[3]; qgamma(x,shape,scale)}
}}
quan<-function(par,x){
a=par[1]
quan0(par,1-(1-x)/(a+(1-x)*(1-a)))
}
out<-quan(param,p)
if(log.p==TRUE & lower.tail == FALSE) out<-quan(param,exp(p-1))
if(log.p==TRUE & lower.tail == TRUE) out<-quan(param,exp(-p))
if(log.p==FALSE & lower.tail == FALSE) out<-quan(param,1-p)
return(out)
}
rmog<-function(n, g, param, location=TRUE){
if(g!="birnbaum-saunders" & g!="exp" & g!="rayleigh" & g!="weibull" & g!="gompertz" & g!="gamma"
& g!="log-normal" & g!="chisq" & g!="f" & g!="burrxii" & g!="frechet"
& g!="lomax" & g!="log-logistic" & g!="lfr" & g!="chen")
{ stop ("Baseline distribution not implemented or misspelled. Please check the manual for guidelines.") }
if(n %% 1 !=0) { stop ("parameter n must be integer.") }
if(g=="log-normal"){
quan0=function(par,x){meanlog=par[2]; sdlog=par[3]; loc=par[4]; qlnorm(x,meanlog,sdlog)+loc}
if (location==FALSE){
quan0=function(par,x){meanlog=par[2]; sdlog=par[3]; qlnorm(x,meanlog,sdlog)}
}}
if(g=="chisq"){
quan0=function(par,x){df=par[2]; loc=par[3]; qchisq(x,df)+loc}
if (location==FALSE){
quan0=function(par,x){df=par[2]; qchisq(x,df)}
}}
if(g=="f"){
quan0=function(par,x){df1=par[2]; df2=par[3]; loc=par[4]; qf(x,df1,df2)+loc}
if (location==FALSE){
quan0=function(par,x){df1=par[2]; df2=par[3]; qf(x,df1,df2)}
}}
if(g=="chen"){
quan0=function(par,x){a=par[2]; b=par[3]; loc=par[4]; (log(1-log(1-x)/b))^(1/a)+loc}
if (location==FALSE){
quan0=function(par,x){a=par[2]; b=par[3]; (log(1-log(1-x)/b))^(1/a)}
}}
if(g=="lfr"){
quan0=function(par,x){a=par[2]; b=par[3]; loc=par[4]; (-a+sqrt(a^2-2*b*log(1-x)))/b+loc}
if (location==FALSE){
quan0=function(par,x){a=par[2]; b=par[3]; (-a+sqrt(a^2-2*b*log(1-x)))/b}
}}
if(g=="log-logistic"){
quan0=function(par,x){a=par[2]; b=par[3]; loc=par[4]; b*(1/x-1)^(-1/a)+loc}
if (location==FALSE){
quan0=function(par,x){a=par[2]; b=par[3]; b*(1/x-1)^(-1/a)}
}}
if(g=="lomax"){
quan0=function(par,x){a=par[2]; b=par[3]; loc=par[4]; ((1-x)^(-1/b)-1)/a+loc}
if (location==FALSE){
quan0=function(par,x){a=par[2]; b=par[3]; ((1-x)^(-1/b)-1)/a}
}}
if(g=="gompertz"){
quan0=function(par,x){a=par[2]; b=par[3]; loc=par[4]; log(1-a/b*log(1-x))/a+loc}
if (location==FALSE){
quan0=function(par,x){a=par[2]; b=par[3]; log(1-a/b*log(1-x))/a}
}}
if(g=="exp"){
quan0=function(par,x){rate=par[2]; loc=par[3]; qexp(x,rate)+loc}
if (location==FALSE){
quan0=function(par,x){rate=par[2]; qexp(x,rate)}
}}
if(g=="rayleigh"){
quan0=function(par,x){a=par[2]; loc=par[3]; a*(-log(1-x))^(1/2)+loc}
if (location==FALSE){
quan0=function(par,x){a=par[2]; a*(-log(1-x))^(1/2)}
}}
if(g=="burrxii"){
quan0=function(par,x){a=par[2]; d=par[3]; loc=par[4]; (1/(1-x)-1)^(1/d)+loc}
if (location==FALSE){
quan0=function(par,x){a=par[2]; d=par[3]; (1/(1-x)-1)^(1/d)}
}}
if(g=="frechet"){
quan0=function(par,x){a=par[2]; b=par[3]; loc=par[4]; b*(-log(x))^(-1/a)+loc}
if (location==FALSE){
quan0=function(par,x){a=par[2]; b=par[3]; b*(-log(x))^(-1/a)}
}}
if(g=="birnbaum-saunders"){
quan0=function(par,x){a=par[2]; b=par[3]; loc=par[4]; b/4*(a*qnorm(x)+sqrt((a*qnorm(x))^2+4))^2+loc}
if (location==FALSE){
quan0=function(par,x){a=par[2]; b=par[3]; b/4*(a*qnorm(x)+sqrt((a*qnorm(x))^2+4))^2}
}}
if(g=="weibull"){
quan0=function(par,x){shape=par[2]; scale=par[3]; loc=par[4]; qweibull(x,shape,scale)+loc}
if (location==FALSE){
quan0=function(par,x){shape=par[2]; scale=par[3]; qweibull(x,shape,scale)}
}}
if(g=="gamma"){
quan0=function(par,x){shape=par[2]; scale=par[3]; loc=par[4]; qgamma(x,shape,scale)+loc}
if (location==FALSE){
quan0=function(par,x){shape=par[2]; scale=par[3]; qgamma(x,shape,scale)}
}}
quan<-function(par,x){
a=par[1]
quan0(par,1-(1-x)/(a+(1-x)*(1-a)))
}
return(quan(param,runif(n)))
}
qgammag<-function(p, g, param, location=TRUE, log.p = FALSE, lower.tail = TRUE){
if(g!="birnbaum-saunders" & g!="exp" & g!="rayleigh" & g!="weibull" & g!="gompertz" & g!="gamma"
& g!="log-normal" & g!="chisq" & g!="f" & g!="burrxii" & g!="frechet"
& g!="lomax" & g!="log-logistic" & g!="lfr" & g!="chen")
{ stop ("Baseline distribution not implemented or misspelled. Please check the manual for guidelines.") }
if(g=="log-normal"){
quan0=function(par,x){meanlog=par[2]; sdlog=par[3]; loc=par[4]; qlnorm(x,meanlog,sdlog)+loc}
if (location==FALSE){
quan0=function(par,x){meanlog=par[2]; sdlog=par[3]; qlnorm(x,meanlog,sdlog)}
}}
if(g=="chisq"){
quan0=function(par,x){df=par[2]; loc=par[3]; qchisq(x,df)+loc}
if (location==FALSE){
quan0=function(par,x){df=par[2]; qchisq(x,df)}
}}
if(g=="f"){
quan0=function(par,x){df1=par[2]; df2=par[3]; loc=par[4]; qf(x,df1,df2)+loc}
if (location==FALSE){
quan0=function(par,x){df1=par[2]; df2=par[3]; qf(x,df1,df2)}
}}
if(g=="chen"){
quan0=function(par,x){a=par[2]; b=par[3]; loc=par[4]; (log(1-log(1-x)/b))^(1/a)+loc}
if (location==FALSE){
quan0=function(par,x){a=par[2]; b=par[3]; (log(1-log(1-x)/b))^(1/a)}
}}
if(g=="lfr"){
quan0=function(par,x){a=par[2]; b=par[3]; loc=par[4]; (-a+sqrt(a^2-2*b*log(1-x)))/b+loc}
if (location==FALSE){
quan0=function(par,x){a=par[2]; b=par[3]; (-a+sqrt(a^2-2*b*log(1-x)))/b}
}}
if(g=="log-logistic"){
quan0=function(par,x){a=par[2]; b=par[3]; loc=par[4]; b*(1/x-1)^(-1/a)+loc}
if (location==FALSE){
quan0=function(par,x){a=par[2]; b=par[3]; b*(1/x-1)^(-1/a)}
}}
if(g=="lomax"){
quan0=function(par,x){a=par[2]; b=par[3]; loc=par[4]; ((1-x)^(-1/b)-1)/a+loc}
if (location==FALSE){
quan0=function(par,x){a=par[2]; b=par[3]; ((1-x)^(-1/b)-1)/a}
}}
if(g=="gompertz"){
quan0=function(par,x){a=par[2]; b=par[3]; loc=par[4]; log(1-a/b*log(1-x))/a+loc}
if (location==FALSE){
quan0=function(par,x){a=par[2]; b=par[3]; log(1-a/b*log(1-x))/a}
}}
if(g=="exp"){
quan0=function(par,x){rate=par[2]; loc=par[3]; qexp(x,rate)+loc}
if (location==FALSE){
quan0=function(par,x){rate=par[2]; qexp(x,rate)}
}}
if(g=="rayleigh"){
quan0=function(par,x){a=par[2]; loc=par[3]; a*(-log(1-x))^(1/2)+loc}
if (location==FALSE){
quan0=function(par,x){a=par[2]; a*(-log(1-x))^(1/2)}
}}
if(g=="burrxii"){
quan0=function(par,x){a=par[2]; d=par[3]; loc=par[4]; (1/(1-x)-1)^(1/d)+loc}
if (location==FALSE){
quan0=function(par,x){a=par[2]; d=par[3]; (1/(1-x)-1)^(1/d)}
}}
if(g=="frechet"){
quan0=function(par,x){a=par[2]; b=par[3]; loc=par[4]; b*(-log(x))^(-1/a)+loc}
if (location==FALSE){
quan0=function(par,x){a=par[2]; b=par[3]; b*(-log(x))^(-1/a)}
}}
if(g=="birnbaum-saunders"){
quan0=function(par,x){a=par[2]; b=par[3]; loc=par[4]; b/4*(a*qnorm(x)+sqrt((a*qnorm(x))^2+4))^2+loc}
if (location==FALSE){
quan0=function(par,x){a=par[2]; b=par[3]; b/4*(a*qnorm(x)+sqrt((a*qnorm(x))^2+4))^2}
}}
if(g=="weibull"){
quan0=function(par,x){shape=par[2]; scale=par[3]; loc=par[4]; qweibull(x,shape,scale)+loc}
if (location==FALSE){
quan0=function(par,x){shape=par[2]; scale=par[3]; qweibull(x,shape,scale)}
}}
if(g=="gamma"){
quan0=function(par,x){shape=par[2]; scale=par[3]; loc=par[4]; qgamma(x,shape,scale)+loc}
if (location==FALSE){
quan0=function(par,x){shape=par[2]; scale=par[3]; qgamma(x,shape,scale)}
}}
quan<-function(par,x){
a=par[1]
quan0(par,qgamma(x,shape=a)/(1+qgamma(x,shape=a)))
}
out<-quan(param,p)
if(log.p==TRUE & lower.tail == FALSE) out<-quan(param,exp(p-1))
if(log.p==TRUE & lower.tail == TRUE) out<-quan(param,exp(-p))
if(log.p==FALSE & lower.tail == FALSE) out<-quan(param,1-p)
return(out)
}
rgammag<-function(n, g, param, location=TRUE){
if(g!="birnbaum-saunders" & g!="exp" & g!="rayleigh" & g!="weibull" & g!="gompertz" & g!="gamma"
& g!="log-normal" & g!="chisq" & g!="f" & g!="burrxii" & g!="frechet"
& g!="lomax" & g!="log-logistic" & g!="lfr" & g!="chen")
{ stop ("Baseline distribution not implemented or misspelled. Please check the manual for guidelines.") }
if(n %% 1 !=0) { stop ("parameter n must be integer.") }
if(g=="log-normal"){
quan0=function(par,x){meanlog=par[2]; sdlog=par[3]; loc=par[4]; qlnorm(x,meanlog,sdlog)+loc}
if (location==FALSE){
quan0=function(par,x){meanlog=par[2]; sdlog=par[3]; qlnorm(x,meanlog,sdlog)}
}}
if(g=="chisq"){
quan0=function(par,x){df=par[2]; loc=par[3]; qchisq(x,df)+loc}
if (location==FALSE){
quan0=function(par,x){df=par[2]; qchisq(x,df)}
}}
if(g=="f"){
quan0=function(par,x){df1=par[2]; df2=par[3]; loc=par[4]; qf(x,df1,df2)+loc}
if (location==FALSE){
quan0=function(par,x){df1=par[2]; df2=par[3]; qf(x,df1,df2)}
}}
if(g=="chen"){
quan0=function(par,x){a=par[2]; b=par[3]; loc=par[4]; (log(1-log(1-x)/b))^(1/a)+loc}
if (location==FALSE){
quan0=function(par,x){a=par[2]; b=par[3]; (log(1-log(1-x)/b))^(1/a)}
}}
if(g=="lfr"){
quan0=function(par,x){a=par[2]; b=par[3]; loc=par[4]; (-a+sqrt(a^2-2*b*log(1-x)))/b+loc}
if (location==FALSE){
quan0=function(par,x){a=par[2]; b=par[3]; (-a+sqrt(a^2-2*b*log(1-x)))/b}
}}
if(g=="log-logistic"){
quan0=function(par,x){a=par[2]; b=par[3]; loc=par[4]; b*(1/x-1)^(-1/a)+loc}
if (location==FALSE){
quan0=function(par,x){a=par[2]; b=par[3]; b*(1/x-1)^(-1/a)}
}}
if(g=="lomax"){
quan0=function(par,x){a=par[2]; b=par[3]; loc=par[4]; ((1-x)^(-1/b)-1)/a+loc}
if (location==FALSE){
quan0=function(par,x){a=par[2]; b=par[3]; ((1-x)^(-1/b)-1)/a}
}}
if(g=="gompertz"){
quan0=function(par,x){a=par[2]; b=par[3]; loc=par[4]; log(1-a/b*log(1-x))/a+loc}
if (location==FALSE){
quan0=function(par,x){a=par[2]; b=par[3]; log(1-a/b*log(1-x))/a}
}}
if(g=="exp"){
quan0=function(par,x){rate=par[2]; loc=par[3]; qexp(x,rate)+loc}
if (location==FALSE){
quan0=function(par,x){rate=par[2]; qexp(x,rate)}
}}
if(g=="rayleigh"){
quan0=function(par,x){a=par[2]; loc=par[3]; a*(-log(1-x))^(1/2)+loc}
if (location==FALSE){
quan0=function(par,x){a=par[2]; a*(-log(1-x))^(1/2)}
}}
if(g=="burrxii"){
quan0=function(par,x){a=par[2]; d=par[3]; loc=par[4]; (1/(1-x)-1)^(1/d)+loc}
if (location==FALSE){
quan0=function(par,x){a=par[2]; d=par[3]; (1/(1-x)-1)^(1/d)}
}}
if(g=="frechet"){
quan0=function(par,x){a=par[2]; b=par[3]; loc=par[4]; b*(-log(x))^(-1/a)+loc}
if (location==FALSE){
quan0=function(par,x){a=par[2]; b=par[3]; b*(-log(x))^(-1/a)}
}}
if(g=="birnbaum-saunders"){
quan0=function(par,x){a=par[2]; b=par[3]; loc=par[4]; b/4*(a*qnorm(x)+sqrt((a*qnorm(x))^2+4))^2+loc}
if (location==FALSE){
quan0=function(par,x){a=par[2]; b=par[3]; b/4*(a*qnorm(x)+sqrt((a*qnorm(x))^2+4))^2}
}}
if(g=="weibull"){
quan0=function(par,x){shape=par[2]; scale=par[3]; loc=par[4]; qweibull(x,shape,scale)+loc}
if (location==FALSE){
quan0=function(par,x){shape=par[2]; scale=par[3]; qweibull(x,shape,scale)}
}}
if(g=="gamma"){
quan0=function(par,x){shape=par[2]; scale=par[3]; loc=par[4]; qgamma(x,shape,scale)+loc}
if (location==FALSE){
quan0=function(par,x){shape=par[2]; scale=par[3]; qgamma(x,shape,scale)}
}}
quan<-function(par,x){
a=par[1]
quan0(par,qgamma(x,shape=a)/(1+qgamma(x,shape=a)))
}
return(quan(param,runif(n)))
}
qgammag1<-function(p, g, param, location=TRUE, log.p = FALSE, lower.tail = TRUE){
if(g!="birnbaum-saunders" & g!="exp" & g!="rayleigh" & g!="weibull" & g!="gompertz" & g!="gamma"
& g!="log-normal" & g!="chisq" & g!="f" & g!="burrxii" & g!="frechet"
& g!="lomax" & g!="log-logistic" & g!="lfr" & g!="chen")
{ stop ("Baseline distribution not implemented or misspelled. Please check the manual for guidelines.") }
if(g=="log-normal"){
quan0=function(par,x){meanlog=par[2]; sdlog=par[3]; loc=par[4]; qlnorm(x,meanlog,sdlog)+loc}
if (location==FALSE){
quan0=function(par,x){meanlog=par[2]; sdlog=par[3]; qlnorm(x,meanlog,sdlog)}
}}
if(g=="chisq"){
quan0=function(par,x){df=par[2]; loc=par[3]; qchisq(x,df)+loc}
if (location==FALSE){
quan0=function(par,x){df=par[2]; qchisq(x,df)}
}}
if(g=="f"){
quan0=function(par,x){df1=par[2]; df2=par[3]; loc=par[4]; qf(x,df1,df2)+loc}
if (location==FALSE){
quan0=function(par,x){df1=par[2]; df2=par[3]; qf(x,df1,df2)}
}}
if(g=="chen"){
quan0=function(par,x){a=par[2]; b=par[3]; loc=par[4]; (log(1-log(1-x)/b))^(1/a)+loc}
if (location==FALSE){
quan0=function(par,x){a=par[2]; b=par[3]; (log(1-log(1-x)/b))^(1/a)}
}}
if(g=="lfr"){
quan0=function(par,x){a=par[2]; b=par[3]; loc=par[4]; (-a+sqrt(a^2-2*b*log(1-x)))/b+loc}
if (location==FALSE){
quan0=function(par,x){a=par[2]; b=par[3]; (-a+sqrt(a^2-2*b*log(1-x)))/b}
}}
if(g=="log-logistic"){
quan0=function(par,x){a=par[2]; b=par[3]; loc=par[4]; b*(1/x-1)^(-1/a)+loc}
if (location==FALSE){
quan0=function(par,x){a=par[2]; b=par[3]; b*(1/x-1)^(-1/a)}
}}
if(g=="lomax"){
quan0=function(par,x){a=par[2]; b=par[3]; loc=par[4]; ((1-x)^(-1/b)-1)/a+loc}
if (location==FALSE){
quan0=function(par,x){a=par[2]; b=par[3]; ((1-x)^(-1/b)-1)/a}
}}
if(g=="gompertz"){
quan0=function(par,x){a=par[2]; b=par[3]; loc=par[4]; log(1-a/b*log(1-x))/a+loc}
if (location==FALSE){
quan0=function(par,x){a=par[2]; b=par[3]; log(1-a/b*log(1-x))/a}
}}
if(g=="exp"){
quan0=function(par,x){rate=par[2]; loc=par[3]; qexp(x,rate)+loc}
if (location==FALSE){
quan0=function(par,x){rate=par[2]; qexp(x,rate)}
}}
if(g=="rayleigh"){
quan0=function(par,x){a=par[2]; loc=par[3]; a*(-log(1-x))^(1/2)+loc}
if (location==FALSE){
quan0=function(par,x){a=par[2]; a*(-log(1-x))^(1/2)}
}}
if(g=="burrxii"){
quan0=function(par,x){a=par[2]; d=par[3]; loc=par[4]; (1/(1-x)-1)^(1/d)+loc}
if (location==FALSE){
quan0=function(par,x){a=par[2]; d=par[3]; (1/(1-x)-1)^(1/d)}
}}
if(g=="frechet"){
quan0=function(par,x){a=par[2]; b=par[3]; loc=par[4]; b*(-log(x))^(-1/a)+loc}
if (location==FALSE){
quan0=function(par,x){a=par[2]; b=par[3]; b*(-log(x))^(-1/a)}
}}
if(g=="birnbaum-saunders"){
quan0=function(par,x){a=par[2]; b=par[3]; loc=par[4]; b/4*(a*qnorm(x)+sqrt((a*qnorm(x))^2+4))^2+loc}
if (location==FALSE){
quan0=function(par,x){a=par[2]; b=par[3]; b/4*(a*qnorm(x)+sqrt((a*qnorm(x))^2+4))^2}
}}
if(g=="weibull"){
quan0=function(par,x){shape=par[2]; scale=par[3]; loc=par[4]; qweibull(x,shape,scale)+loc}
if (location==FALSE){
quan0=function(par,x){shape=par[2]; scale=par[3]; qweibull(x,shape,scale)}
}}
if(g=="gamma"){
quan0=function(par,x){shape=par[2]; scale=par[3]; loc=par[4]; qgamma(x,shape,scale)+loc}
if (location==FALSE){
quan0=function(par,x){shape=par[2]; scale=par[3]; qgamma(x,shape,scale)}
}}
quan<-function(par,x){
a=par[1]
quan0(par, 1-exp(-qgamma(x,shape=a)))
}
out<-quan(param,p)
if(log.p==TRUE & lower.tail == FALSE) out<-quan(param,exp(p-1))
if(log.p==TRUE & lower.tail == TRUE) out<-quan(param,exp(-p))
if(log.p==FALSE & lower.tail == FALSE) out<-quan(param,1-p)
return(out)
}
rgammag1<-function(n, g, param, location=TRUE){
if(g!="birnbaum-saunders" & g!="exp" & g!="rayleigh" & g!="weibull" & g!="gompertz" & g!="gamma"
& g!="log-normal" & g!="chisq" & g!="f" & g!="burrxii" & g!="frechet"
& g!="lomax" & g!="log-logistic" & g!="lfr" & g!="chen")
{ stop ("Baseline distribution not implemented or misspelled. Please check the manual for guidelines.") }
if(n %% 1 !=0) { stop ("parameter n must be integer.") }
if(g=="log-normal"){
quan0=function(par,x){meanlog=par[2]; sdlog=par[3]; loc=par[4]; qlnorm(x,meanlog,sdlog)+loc}
if (location==FALSE){
quan0=function(par,x){meanlog=par[2]; sdlog=par[3]; qlnorm(x,meanlog,sdlog)}
}}
if(g=="chisq"){
quan0=function(par,x){df=par[2]; loc=par[3]; qchisq(x,df)+loc}
if (location==FALSE){
quan0=function(par,x){df=par[2]; qchisq(x,df)}
}}
if(g=="f"){
quan0=function(par,x){df1=par[2]; df2=par[3]; loc=par[4]; qf(x,df1,df2)+loc}
if (location==FALSE){
quan0=function(par,x){df1=par[2]; df2=par[3]; qf(x,df1,df2)}
}}
if(g=="chen"){
quan0=function(par,x){a=par[2]; b=par[3]; loc=par[4]; (log(1-log(1-x)/b))^(1/a)+loc}
if (location==FALSE){
quan0=function(par,x){a=par[2]; b=par[3]; (log(1-log(1-x)/b))^(1/a)}
}}
if(g=="lfr"){
quan0=function(par,x){a=par[2]; b=par[3]; loc=par[4]; (-a+sqrt(a^2-2*b*log(1-x)))/b+loc}
if (location==FALSE){
quan0=function(par,x){a=par[2]; b=par[3]; (-a+sqrt(a^2-2*b*log(1-x)))/b}
}}
if(g=="log-logistic"){
quan0=function(par,x){a=par[2]; b=par[3]; loc=par[4]; b*(1/x-1)^(-1/a)+loc}
if (location==FALSE){
quan0=function(par,x){a=par[2]; b=par[3]; b*(1/x-1)^(-1/a)}
}}
if(g=="lomax"){
quan0=function(par,x){a=par[2]; b=par[3]; loc=par[4]; ((1-x)^(-1/b)-1)/a+loc}
if (location==FALSE){
quan0=function(par,x){a=par[2]; b=par[3]; ((1-x)^(-1/b)-1)/a}
}}
if(g=="gompertz"){
quan0=function(par,x){a=par[2]; b=par[3]; loc=par[4]; log(1-a/b*log(1-x))/a+loc}
if (location==FALSE){
quan0=function(par,x){a=par[2]; b=par[3]; log(1-a/b*log(1-x))/a}
}}
if(g=="exp"){
quan0=function(par,x){rate=par[2]; loc=par[3]; qexp(x,rate)+loc}
if (location==FALSE){
quan0=function(par,x){rate=par[2]; qexp(x,rate)}
}}
if(g=="rayleigh"){
quan0=function(par,x){a=par[2]; loc=par[3]; a*(-log(1-x))^(1/2)+loc}
if (location==FALSE){
quan0=function(par,x){a=par[2]; a*(-log(1-x))^(1/2)}
}}
if(g=="burrxii"){
quan0=function(par,x){a=par[2]; d=par[3]; loc=par[4]; (1/(1-x)-1)^(1/d)+loc}
if (location==FALSE){
quan0=function(par,x){a=par[2]; d=par[3]; (1/(1-x)-1)^(1/d)}
}}
if(g=="frechet"){
quan0=function(par,x){a=par[2]; b=par[3]; loc=par[4]; b*(-log(x))^(-1/a)+loc}
if (location==FALSE){
quan0=function(par,x){a=par[2]; b=par[3]; b*(-log(x))^(-1/a)}
}}
if(g=="birnbaum-saunders"){
quan0=function(par,x){a=par[2]; b=par[3]; loc=par[4]; b/4*(a*qnorm(x)+sqrt((a*qnorm(x))^2+4))^2+loc}
if (location==FALSE){
quan0=function(par,x){a=par[2]; b=par[3]; b/4*(a*qnorm(x)+sqrt((a*qnorm(x))^2+4))^2}
}}
if(g=="weibull"){
quan0=function(par,x){shape=par[2]; scale=par[3]; loc=par[4]; qweibull(x,shape,scale)+loc}
if (location==FALSE){
quan0=function(par,x){shape=par[2]; scale=par[3]; qweibull(x,shape,scale)}
}}
if(g=="gamma"){
quan0=function(par,x){shape=par[2]; scale=par[3]; loc=par[4]; qgamma(x,shape,scale)+loc}
if (location==FALSE){
quan0=function(par,x){shape=par[2]; scale=par[3]; qgamma(x,shape,scale)}
}}
quan<-function(par,x){
a=par[1]
quan0(par, 1-exp(-qgamma(x,shape=a)))
}
return(quan(param,runif(n)))
}
qgammag2<-function(p, g, param, location=TRUE, log.p = FALSE, lower.tail = TRUE){
if(g!="birnbaum-saunders" & g!="exp" & g!="rayleigh" & g!="weibull" & g!="gompertz" & g!="gamma"
& g!="log-normal" & g!="chisq" & g!="f" & g!="burrxii" & g!="frechet"
& g!="lomax" & g!="log-logistic" & g!="lfr" & g!="chen")
{ stop ("Baseline distribution not implemented or misspelled. Please check the manual for guidelines.") }
if(g=="log-normal"){
quan0=function(par,x){meanlog=par[2]; sdlog=par[3]; loc=par[4]; qlnorm(x,meanlog,sdlog)+loc}
if (location==FALSE){
quan0=function(par,x){meanlog=par[2]; sdlog=par[3]; qlnorm(x,meanlog,sdlog)}
}}
if(g=="chisq"){
quan0=function(par,x){df=par[2]; loc=par[3]; qchisq(x,df)+loc}
if (location==FALSE){
quan0=function(par,x){df=par[2]; qchisq(x,df)}
}}
if(g=="f"){
quan0=function(par,x){df1=par[2]; df2=par[3]; loc=par[4]; qf(x,df1,df2)+loc}
if (location==FALSE){
quan0=function(par,x){df1=par[2]; df2=par[3]; qf(x,df1,df2)}
}}
if(g=="chen"){
quan0=function(par,x){a=par[2]; b=par[3]; loc=par[4]; (log(1-log(1-x)/b))^(1/a)+loc}
if (location==FALSE){
quan0=function(par,x){a=par[2]; b=par[3]; (log(1-log(1-x)/b))^(1/a)}
}}
if(g=="lfr"){
quan0=function(par,x){a=par[2]; b=par[3]; loc=par[4]; (-a+sqrt(a^2-2*b*log(1-x)))/b+loc}
if (location==FALSE){
quan0=function(par,x){a=par[2]; b=par[3]; (-a+sqrt(a^2-2*b*log(1-x)))/b}
}}
if(g=="log-logistic"){
quan0=function(par,x){a=par[2]; b=par[3]; loc=par[4]; b*(1/x-1)^(-1/a)+loc}
if (location==FALSE){
quan0=function(par,x){a=par[2]; b=par[3]; b*(1/x-1)^(-1/a)}
}}
if(g=="lomax"){
quan0=function(par,x){a=par[2]; b=par[3]; loc=par[4]; ((1-x)^(-1/b)-1)/a+loc}
if (location==FALSE){
quan0=function(par,x){a=par[2]; b=par[3]; ((1-x)^(-1/b)-1)/a}
}}
if(g=="gompertz"){
quan0=function(par,x){a=par[2]; b=par[3]; loc=par[4]; log(1-a/b*log(1-x))/a+loc}
if (location==FALSE){
quan0=function(par,x){a=par[2]; b=par[3]; log(1-a/b*log(1-x))/a}
}}
if(g=="exp"){
quan0=function(par,x){rate=par[2]; loc=par[3]; qexp(x,rate)+loc}
if (location==FALSE){
quan0=function(par,x){rate=par[2]; qexp(x,rate)}
}}
if(g=="rayleigh"){
quan0=function(par,x){a=par[2]; loc=par[3]; a*(-log(1-x))^(1/2)+loc}
if (location==FALSE){
quan0=function(par,x){a=par[2]; a*(-log(1-x))^(1/2)}
}}
if(g=="burrxii"){
quan0=function(par,x){a=par[2]; d=par[3]; loc=par[4]; (1/(1-x)-1)^(1/d)+loc}
if (location==FALSE){
quan0=function(par,x){a=par[2]; d=par[3]; (1/(1-x)-1)^(1/d)}
}}
if(g=="frechet"){
quan0=function(par,x){a=par[2]; b=par[3]; loc=par[4]; b*(-log(x))^(-1/a)+loc}
if (location==FALSE){
quan0=function(par,x){a=par[2]; b=par[3]; b*(-log(x))^(-1/a)}
}}
if(g=="birnbaum-saunders"){
quan0=function(par,x){a=par[2]; b=par[3]; loc=par[4]; b/4*(a*qnorm(x)+sqrt((a*qnorm(x))^2+4))^2+loc}
if (location==FALSE){
quan0=function(par,x){a=par[2]; b=par[3]; b/4*(a*qnorm(x)+sqrt((a*qnorm(x))^2+4))^2}
}}
if(g=="weibull"){
quan0=function(par,x){shape=par[2]; scale=par[3]; loc=par[4]; qweibull(x,shape,scale)+loc}
if (location==FALSE){
quan0=function(par,x){shape=par[2]; scale=par[3]; qweibull(x,shape,scale)}
}}
if(g=="gamma"){
quan0=function(par,x){shape=par[2]; scale=par[3]; loc=par[4]; qgamma(x,shape,scale)+loc}
if (location==FALSE){
quan0=function(par,x){shape=par[2]; scale=par[3]; qgamma(x,shape,scale)}
}}
quan<-function(par,x){
a=par[1]
quan0(par, exp(-qgamma(x,shape=a)))
}
out<-quan(param,p)
if(log.p==TRUE & lower.tail == FALSE) out<-quan(param,exp(p-1))
if(log.p==TRUE & lower.tail == TRUE) out<-quan(param,exp(-p))
if(log.p==FALSE & lower.tail == FALSE) out<-quan(param,1-p)
return(out)
}
rgammag2<-function(n, g, param, location=TRUE){
if(g!="birnbaum-saunders" & g!="exp" & g!="rayleigh" & g!="weibull" & g!="gompertz" & g!="gamma"
& g!="log-normal" & g!="chisq" & g!="f" & g!="burrxii" & g!="frechet"
& g!="lomax" & g!="log-logistic" & g!="lfr" & g!="chen")
{ stop ("Baseline distribution not implemented or misspelled. Please check the manual for guidelines.") }
if(n %% 1 !=0) { stop ("parameter n must be integer.") }
if(g=="log-normal"){
quan0=function(par,x){meanlog=par[2]; sdlog=par[3]; loc=par[4]; qlnorm(x,meanlog,sdlog)+loc}
if (location==FALSE){
quan0=function(par,x){meanlog=par[2]; sdlog=par[3]; qlnorm(x,meanlog,sdlog)}
}}
if(g=="chisq"){
quan0=function(par,x){df=par[2]; loc=par[3]; qchisq(x,df)+loc}
if (location==FALSE){
quan0=function(par,x){df=par[2]; qchisq(x,df)}
}}
if(g=="f"){
quan0=function(par,x){df1=par[2]; df2=par[3]; loc=par[4]; qf(x,df1,df2)+loc}
if (location==FALSE){
quan0=function(par,x){df1=par[2]; df2=par[3]; qf(x,df1,df2)}
}}
if(g=="chen"){
quan0=function(par,x){a=par[2]; b=par[3]; loc=par[4]; (log(1-log(1-x)/b))^(1/a)+loc}
if (location==FALSE){
quan0=function(par,x){a=par[2]; b=par[3]; (log(1-log(1-x)/b))^(1/a)}
}}
if(g=="lfr"){
quan0=function(par,x){a=par[2]; b=par[3]; loc=par[4]; (-a+sqrt(a^2-2*b*log(1-x)))/b+loc}
if (location==FALSE){
quan0=function(par,x){a=par[2]; b=par[3]; (-a+sqrt(a^2-2*b*log(1-x)))/b}
}}
if(g=="log-logistic"){
quan0=function(par,x){a=par[2]; b=par[3]; loc=par[4]; b*(1/x-1)^(-1/a)+loc}
if (location==FALSE){
quan0=function(par,x){a=par[2]; b=par[3]; b*(1/x-1)^(-1/a)}
}}
if(g=="lomax"){
quan0=function(par,x){a=par[2]; b=par[3]; loc=par[4]; ((1-x)^(-1/b)-1)/a+loc}
if (location==FALSE){
quan0=function(par,x){a=par[2]; b=par[3]; ((1-x)^(-1/b)-1)/a}
}}
if(g=="gompertz"){
quan0=function(par,x){a=par[2]; b=par[3]; loc=par[4]; log(1-a/b*log(1-x))/a+loc}
if (location==FALSE){
quan0=function(par,x){a=par[2]; b=par[3]; log(1-a/b*log(1-x))/a}
}}
if(g=="exp"){
quan0=function(par,x){rate=par[2]; loc=par[3]; qexp(x,rate)+loc}
if (location==FALSE){
quan0=function(par,x){rate=par[2]; qexp(x,rate)}
}}
if(g=="rayleigh"){
quan0=function(par,x){a=par[2]; loc=par[3]; a*(-log(1-x))^(1/2)+loc}
if (location==FALSE){
quan0=function(par,x){a=par[2]; a*(-log(1-x))^(1/2)}
}}
if(g=="burrxii"){
quan0=function(par,x){a=par[2]; d=par[3]; loc=par[4]; (1/(1-x)-1)^(1/d)+loc}
if (location==FALSE){
quan0=function(par,x){a=par[2]; d=par[3]; (1/(1-x)-1)^(1/d)}
}}
if(g=="frechet"){
quan0=function(par,x){a=par[2]; b=par[3]; loc=par[4]; b*(-log(x))^(-1/a)+loc}
if (location==FALSE){
quan0=function(par,x){a=par[2]; b=par[3]; b*(-log(x))^(-1/a)}
}}
if(g=="birnbaum-saunders"){
quan0=function(par,x){a=par[2]; b=par[3]; loc=par[4]; b/4*(a*qnorm(x)+sqrt((a*qnorm(x))^2+4))^2+loc}
if (location==FALSE){
quan0=function(par,x){a=par[2]; b=par[3]; b/4*(a*qnorm(x)+sqrt((a*qnorm(x))^2+4))^2}
}}
if(g=="weibull"){
quan0=function(par,x){shape=par[2]; scale=par[3]; loc=par[4]; qweibull(x,shape,scale)+loc}
if (location==FALSE){
quan0=function(par,x){shape=par[2]; scale=par[3]; qweibull(x,shape,scale)}
}}
if(g=="gamma"){
quan0=function(par,x){shape=par[2]; scale=par[3]; loc=par[4]; qgamma(x,shape,scale)+loc}
if (location==FALSE){
quan0=function(par,x){shape=par[2]; scale=par[3]; qgamma(x,shape,scale)}
}}
quan<-function(par,x){
a=par[1]
quan0(par, exp(-qgamma(x,shape=a)))
}
return(quan(param,runif(n)))
}
qexpg<-function(p, g, param, location=TRUE, log.p = FALSE, lower.tail = TRUE){
if(g!="birnbaum-saunders" & g!="exp" & g!="rayleigh" & g!="weibull" & g!="gompertz" & g!="gamma"
& g!="log-normal" & g!="chisq" & g!="f" & g!="burrxii" & g!="frechet"
& g!="lomax" & g!="log-logistic" & g!="lfr" & g!="chen")
{ stop ("Baseline distribution not implemented or misspelled. Please check the manual for guidelines.") }
if(g=="log-normal"){
quan0=function(par,x){meanlog=par[2]; sdlog=par[3]; loc=par[4]; qlnorm(x,meanlog,sdlog)+loc}
if (location==FALSE){
quan0=function(par,x){meanlog=par[2]; sdlog=par[3]; qlnorm(x,meanlog,sdlog)}
}}
if(g=="chisq"){
quan0=function(par,x){df=par[2]; loc=par[3]; qchisq(x,df)+loc}
if (location==FALSE){
quan0=function(par,x){df=par[2]; qchisq(x,df)}
}}
if(g=="f"){
quan0=function(par,x){df1=par[2]; df2=par[3]; loc=par[4]; qf(x,df1,df2)+loc}
if (location==FALSE){
quan0=function(par,x){df1=par[2]; df2=par[3]; qf(x,df1,df2)}
}}
if(g=="chen"){
quan0=function(par,x){a=par[2]; b=par[3]; loc=par[4]; (log(1-log(1-x)/b))^(1/a)+loc}
if (location==FALSE){
quan0=function(par,x){a=par[2]; b=par[3]; (log(1-log(1-x)/b))^(1/a)}
}}
if(g=="lfr"){
quan0=function(par,x){a=par[2]; b=par[3]; loc=par[4]; (-a+sqrt(a^2-2*b*log(1-x)))/b+loc}
if (location==FALSE){
quan0=function(par,x){a=par[2]; b=par[3]; (-a+sqrt(a^2-2*b*log(1-x)))/b}
}}
if(g=="log-logistic"){
quan0=function(par,x){a=par[2]; b=par[3]; loc=par[4]; b*(1/x-1)^(-1/a)+loc}
if (location==FALSE){
quan0=function(par,x){a=par[2]; b=par[3]; b*(1/x-1)^(-1/a)}
}}
if(g=="lomax"){
quan0=function(par,x){a=par[2]; b=par[3]; loc=par[4]; ((1-x)^(-1/b)-1)/a+loc}
if (location==FALSE){
quan0=function(par,x){a=par[2]; b=par[3]; ((1-x)^(-1/b)-1)/a}
}}
if(g=="gompertz"){
quan0=function(par,x){a=par[2]; b=par[3]; loc=par[4]; log(1-a/b*log(1-x))/a+loc}
if (location==FALSE){
quan0=function(par,x){a=par[2]; b=par[3]; log(1-a/b*log(1-x))/a}
}}
if(g=="exp"){
quan0=function(par,x){rate=par[2]; loc=par[3]; qexp(x,rate)+loc}
if (location==FALSE){
quan0=function(par,x){rate=par[2]; qexp(x,rate)}
}}
if(g=="rayleigh"){
quan0=function(par,x){a=par[2]; loc=par[3]; a*(-log(1-x))^(1/2)+loc}
if (location==FALSE){
quan0=function(par,x){a=par[2]; a*(-log(1-x))^(1/2)}
}}
if(g=="burrxii"){
quan0=function(par,x){a=par[2]; d=par[3]; loc=par[4]; (1/(1-x)-1)^(1/d)+loc}
if (location==FALSE){
quan0=function(par,x){a=par[2]; d=par[3]; (1/(1-x)-1)^(1/d)}
}}
if(g=="frechet"){
quan0=function(par,x){a=par[2]; b=par[3]; loc=par[4]; b*(-log(x))^(-1/a)+loc}
if (location==FALSE){
quan0=function(par,x){a=par[2]; b=par[3]; b*(-log(x))^(-1/a)}
}}
if(g=="birnbaum-saunders"){
quan0=function(par,x){a=par[2]; b=par[3]; loc=par[4]; b/4*(a*qnorm(x)+sqrt((a*qnorm(x))^2+4))^2+loc}
if (location==FALSE){
quan0=function(par,x){a=par[2]; b=par[3]; b/4*(a*qnorm(x)+sqrt((a*qnorm(x))^2+4))^2}
}}
if(g=="weibull"){
quan0=function(par,x){shape=par[2]; scale=par[3]; loc=par[4]; qweibull(x,shape,scale)+loc}
if (location==FALSE){
quan0=function(par,x){shape=par[2]; scale=par[3]; qweibull(x,shape,scale)}
}}
if(g=="gamma"){
quan0=function(par,x){shape=par[2]; scale=par[3]; loc=par[4]; qgamma(x,shape,scale)+loc}
if (location==FALSE){
quan0=function(par,x){shape=par[2]; scale=par[3]; qgamma(x,shape,scale)}
}}
quan<-function(par,x){
a=par[1]
quan0(par,x^(1/a))
}
out<-quan(param,p)
if(log.p==TRUE & lower.tail == FALSE) out<-quan(param,exp(p-1))
if(log.p==TRUE & lower.tail == TRUE) out<-quan(param,exp(-p))
if(log.p==FALSE & lower.tail == FALSE) out<-quan(param,1-p)
return(out)
}
rexpg<-function(n, g, param, location=TRUE){
if(g!="birnbaum-saunders" & g!="exp" & g!="rayleigh" & g!="weibull" & g!="gompertz" & g!="gamma"
& g!="log-normal" & g!="chisq" & g!="f" & g!="burrxii" & g!="frechet"
& g!="lomax" & g!="log-logistic" & g!="lfr" & g!="chen")
{ stop ("Baseline distribution not implemented or misspelled. Please check the manual for guidelines.") }
if(n %% 1 !=0) { stop ("parameter n must be integer.") }
if(g=="log-normal"){
quan0=function(par,x){meanlog=par[2]; sdlog=par[3]; loc=par[4]; qlnorm(x,meanlog,sdlog)+loc}
if (location==FALSE){
quan0=function(par,x){meanlog=par[2]; sdlog=par[3]; qlnorm(x,meanlog,sdlog)}
}}
if(g=="chisq"){
quan0=function(par,x){df=par[2]; loc=par[3]; qchisq(x,df)+loc}
if (location==FALSE){
quan0=function(par,x){df=par[2]; qchisq(x,df)}
}}
if(g=="f"){
quan0=function(par,x){df1=par[2]; df2=par[3]; loc=par[4]; qf(x,df1,df2)+loc}
if (location==FALSE){
quan0=function(par,x){df1=par[2]; df2=par[3]; qf(x,df1,df2)}
}}
if(g=="chen"){
quan0=function(par,x){a=par[2]; b=par[3]; loc=par[4]; (log(1-log(1-x)/b))^(1/a)+loc}
if (location==FALSE){
quan0=function(par,x){a=par[2]; b=par[3]; (log(1-log(1-x)/b))^(1/a)}
}}
if(g=="lfr"){
quan0=function(par,x){a=par[2]; b=par[3]; loc=par[4]; (-a+sqrt(a^2-2*b*log(1-x)))/b+loc}
if (location==FALSE){
quan0=function(par,x){a=par[2]; b=par[3]; (-a+sqrt(a^2-2*b*log(1-x)))/b}
}}
if(g=="log-logistic"){
quan0=function(par,x){a=par[2]; b=par[3]; loc=par[4]; b*(1/x-1)^(-1/a)+loc}
if (location==FALSE){
quan0=function(par,x){a=par[2]; b=par[3]; b*(1/x-1)^(-1/a)}
}}
if(g=="lomax"){
quan0=function(par,x){a=par[2]; b=par[3]; loc=par[4]; ((1-x)^(-1/b)-1)/a+loc}
if (location==FALSE){
quan0=function(par,x){a=par[2]; b=par[3]; ((1-x)^(-1/b)-1)/a}
}}
if(g=="gompertz"){
quan0=function(par,x){a=par[2]; b=par[3]; loc=par[4]; log(1-a/b*log(1-x))/a+loc}
if (location==FALSE){
quan0=function(par,x){a=par[2]; b=par[3]; log(1-a/b*log(1-x))/a}
}}
if(g=="exp"){
quan0=function(par,x){rate=par[2]; loc=par[3]; qexp(x,rate)+loc}
if (location==FALSE){
quan0=function(par,x){rate=par[2]; qexp(x,rate)}
}}
if(g=="rayleigh"){
quan0=function(par,x){a=par[2]; loc=par[3]; a*(-log(1-x))^(1/2)+loc}
if (location==FALSE){
quan0=function(par,x){a=par[2]; a*(-log(1-x))^(1/2)}
}}
if(g=="burrxii"){
quan0=function(par,x){a=par[2]; d=par[3]; loc=par[4]; (1/(1-x)-1)^(1/d)+loc}
if (location==FALSE){
quan0=function(par,x){a=par[2]; d=par[3]; (1/(1-x)-1)^(1/d)}
}}
if(g=="frechet"){
quan0=function(par,x){a=par[2]; b=par[3]; loc=par[4]; b*(-log(x))^(-1/a)+loc}
if (location==FALSE){
quan0=function(par,x){a=par[2]; b=par[3]; b*(-log(x))^(-1/a)}
}}
if(g=="birnbaum-saunders"){
quan0=function(par,x){a=par[2]; b=par[3]; loc=par[4]; b/4*(a*qnorm(x)+sqrt((a*qnorm(x))^2+4))^2+loc}
if (location==FALSE){
quan0=function(par,x){a=par[2]; b=par[3]; b/4*(a*qnorm(x)+sqrt((a*qnorm(x))^2+4))^2}
}}
if(g=="weibull"){
quan0=function(par,x){shape=par[2]; scale=par[3]; loc=par[4]; qweibull(x,shape,scale)+loc}
if (location==FALSE){
quan0=function(par,x){shape=par[2]; scale=par[3]; qweibull(x,shape,scale)}
}}
if(g=="gamma"){
quan0=function(par,x){shape=par[2]; scale=par[3]; loc=par[4]; qgamma(x,shape,scale)+loc}
if (location==FALSE){
quan0=function(par,x){shape=par[2]; scale=par[3]; qgamma(x,shape,scale)}
}}
quan<-function(par,x){
a=par[1]
quan0(par,x^(1/a))
}
return(quan(param,runif(n)))
}
qtexpsg<-function(p, g, param, location=TRUE, log.p = FALSE, lower.tail = TRUE){
if(g!="birnbaum-saunders" & g!="exp" & g!="rayleigh" & g!="weibull" & g!="gompertz" & g!="gamma"
& g!="log-normal" & g!="chisq" & g!="f" & g!="burrxii" & g!="frechet"
& g!="lomax" & g!="log-logistic" & g!="lfr" & g!="chen")
{ stop ("Baseline distribution not implemented or misspelled. Please check the manual for guidelines.") }
if(g=="log-normal"){
quan0=function(par,x){meanlog=par[2]; sdlog=par[3]; loc=par[4]; qlnorm(x,meanlog,sdlog)+loc}
if (location==FALSE){
quan0=function(par,x){meanlog=par[2]; sdlog=par[3]; qlnorm(x,meanlog,sdlog)}
}}
if(g=="chisq"){
quan0=function(par,x){df=par[2]; loc=par[3]; qchisq(x,df)+loc}
if (location==FALSE){
quan0=function(par,x){df=par[2]; qchisq(x,df)}
}}
if(g=="f"){
quan0=function(par,x){df1=par[2]; df2=par[3]; loc=par[4]; qf(x,df1,df2)+loc}
if (location==FALSE){
quan0=function(par,x){df1=par[2]; df2=par[3]; qf(x,df1,df2)}
}}
if(g=="chen"){
quan0=function(par,x){a=par[2]; b=par[3]; loc=par[4]; (log(1-log(1-x)/b))^(1/a)+loc}
if (location==FALSE){
quan0=function(par,x){a=par[2]; b=par[3]; (log(1-log(1-x)/b))^(1/a)}
}}
if(g=="lfr"){
quan0=function(par,x){a=par[2]; b=par[3]; loc=par[4]; (-a+sqrt(a^2-2*b*log(1-x)))/b+loc}
if (location==FALSE){
quan0=function(par,x){a=par[2]; b=par[3]; (-a+sqrt(a^2-2*b*log(1-x)))/b}
}}
if(g=="log-logistic"){
quan0=function(par,x){a=par[2]; b=par[3]; loc=par[4]; b*(1/x-1)^(-1/a)+loc}
if (location==FALSE){
quan0=function(par,x){a=par[2]; b=par[3]; b*(1/x-1)^(-1/a)}
}}
if(g=="lomax"){
quan0=function(par,x){a=par[2]; b=par[3]; loc=par[4]; ((1-x)^(-1/b)-1)/a+loc}
if (location==FALSE){
quan0=function(par,x){a=par[2]; b=par[3]; ((1-x)^(-1/b)-1)/a}
}}
if(g=="gompertz"){
quan0=function(par,x){a=par[2]; b=par[3]; loc=par[4]; log(1-a/b*log(1-x))/a+loc}
if (location==FALSE){
quan0=function(par,x){a=par[2]; b=par[3]; log(1-a/b*log(1-x))/a}
}}
if(g=="exp"){
quan0=function(par,x){rate=par[2]; loc=par[3]; qexp(x,rate)+loc}
if (location==FALSE){
quan0=function(par,x){rate=par[2]; qexp(x,rate)}
}}
if(g=="rayleigh"){
quan0=function(par,x){a=par[2]; loc=par[3]; a*(-log(1-x))^(1/2)+loc}
if (location==FALSE){
quan0=function(par,x){a=par[2]; a*(-log(1-x))^(1/2)}
}}
if(g=="burrxii"){
quan0=function(par,x){a=par[2]; d=par[3]; loc=par[4]; (1/(1-x)-1)^(1/d)+loc}
if (location==FALSE){
quan0=function(par,x){a=par[2]; d=par[3]; (1/(1-x)-1)^(1/d)}
}}
if(g=="frechet"){
quan0=function(par,x){a=par[2]; b=par[3]; loc=par[4]; b*(-log(x))^(-1/a)+loc}
if (location==FALSE){
quan0=function(par,x){a=par[2]; b=par[3]; b*(-log(x))^(-1/a)}
}}
if(g=="birnbaum-saunders"){
quan0=function(par,x){a=par[2]; b=par[3]; loc=par[4]; b/4*(a*qnorm(x)+sqrt((a*qnorm(x))^2+4))^2+loc}
if (location==FALSE){
quan0=function(par,x){a=par[2]; b=par[3]; b/4*(a*qnorm(x)+sqrt((a*qnorm(x))^2+4))^2}
}}
if(g=="weibull"){
quan0=function(par,x){shape=par[2]; scale=par[3]; loc=par[4]; qweibull(x,shape,scale)+loc}
if (location==FALSE){
quan0=function(par,x){shape=par[2]; scale=par[3]; qweibull(x,shape,scale)}
}}
if(g=="gamma"){
quan0=function(par,x){shape=par[2]; scale=par[3]; loc=par[4]; qgamma(x,shape,scale)+loc}
if (location==FALSE){
quan0=function(par,x){shape=par[2]; scale=par[3]; qgamma(x,shape,scale)}
}}
quan<-function(par,x){
a=par[1]
quan0(par,-log(1-x*(1-exp(-a)))/a)
}
out<-quan(param,p)
if(log.p==TRUE & lower.tail == FALSE) out<-quan(param,exp(p-1))
if(log.p==TRUE & lower.tail == TRUE) out<-quan(param,exp(-p))
if(log.p==FALSE & lower.tail == FALSE) out<-quan(param,1-p)
return(out)
}
rtexpsg<-function(n, g, param, location=TRUE){
if(g!="birnbaum-saunders" & g!="exp" & g!="rayleigh" & g!="weibull" & g!="gompertz" & g!="gamma"
& g!="log-normal" & g!="chisq" & g!="f" & g!="burrxii" & g!="frechet"
& g!="lomax" & g!="log-logistic" & g!="lfr" & g!="chen")
{ stop ("Baseline distribution not implemented or misspelled. Please check the manual for guidelines.") }
if(n %% 1 !=0) { stop ("parameter n must be integer.") }
if(g=="log-normal"){
quan0=function(par,x){meanlog=par[2]; sdlog=par[3]; loc=par[4]; qlnorm(x,meanlog,sdlog)+loc}
if (location==FALSE){
quan0=function(par,x){meanlog=par[2]; sdlog=par[3]; qlnorm(x,meanlog,sdlog)}
}}
if(g=="chisq"){
quan0=function(par,x){df=par[2]; loc=par[3]; qchisq(x,df)+loc}
if (location==FALSE){
quan0=function(par,x){df=par[2]; qchisq(x,df)}
}}
if(g=="f"){
quan0=function(par,x){df1=par[2]; df2=par[3]; loc=par[4]; qf(x,df1,df2)+loc}
if (location==FALSE){
quan0=function(par,x){df1=par[2]; df2=par[3]; qf(x,df1,df2)}
}}
if(g=="chen"){
quan0=function(par,x){a=par[2]; b=par[3]; loc=par[4]; (log(1-log(1-x)/b))^(1/a)+loc}
if (location==FALSE){
quan0=function(par,x){a=par[2]; b=par[3]; (log(1-log(1-x)/b))^(1/a)}
}}
if(g=="lfr"){
quan0=function(par,x){a=par[2]; b=par[3]; loc=par[4]; (-a+sqrt(a^2-2*b*log(1-x)))/b+loc}
if (location==FALSE){
quan0=function(par,x){a=par[2]; b=par[3]; (-a+sqrt(a^2-2*b*log(1-x)))/b}
}}
if(g=="log-logistic"){
quan0=function(par,x){a=par[2]; b=par[3]; loc=par[4]; b*(1/x-1)^(-1/a)+loc}
if (location==FALSE){
quan0=function(par,x){a=par[2]; b=par[3]; b*(1/x-1)^(-1/a)}
}}
if(g=="lomax"){
quan0=function(par,x){a=par[2]; b=par[3]; loc=par[4]; ((1-x)^(-1/b)-1)/a+loc}
if (location==FALSE){
quan0=function(par,x){a=par[2]; b=par[3]; ((1-x)^(-1/b)-1)/a}
}}
if(g=="gompertz"){
quan0=function(par,x){a=par[2]; b=par[3]; loc=par[4]; log(1-a/b*log(1-x))/a+loc}
if (location==FALSE){
quan0=function(par,x){a=par[2]; b=par[3]; log(1-a/b*log(1-x))/a}
}}
if(g=="exp"){
quan0=function(par,x){rate=par[2]; loc=par[3]; qexp(x,rate)+loc}
if (location==FALSE){
quan0=function(par,x){rate=par[2]; qexp(x,rate)}
}}
if(g=="rayleigh"){
quan0=function(par,x){a=par[2]; loc=par[3]; a*(-log(1-x))^(1/2)+loc}
if (location==FALSE){
quan0=function(par,x){a=par[2]; a*(-log(1-x))^(1/2)}
}}
if(g=="burrxii"){
quan0=function(par,x){a=par[2]; d=par[3]; loc=par[4]; (1/(1-x)-1)^(1/d)+loc}
if (location==FALSE){
quan0=function(par,x){a=par[2]; d=par[3]; (1/(1-x)-1)^(1/d)}
}}
if(g=="frechet"){
quan0=function(par,x){a=par[2]; b=par[3]; loc=par[4]; b*(-log(x))^(-1/a)+loc}
if (location==FALSE){
quan0=function(par,x){a=par[2]; b=par[3]; b*(-log(x))^(-1/a)}
}}
if(g=="birnbaum-saunders"){
quan0=function(par,x){a=par[2]; b=par[3]; loc=par[4]; b/4*(a*qnorm(x)+sqrt((a*qnorm(x))^2+4))^2+loc}
if (location==FALSE){
quan0=function(par,x){a=par[2]; b=par[3]; b/4*(a*qnorm(x)+sqrt((a*qnorm(x))^2+4))^2}
}}
if(g=="weibull"){
quan0=function(par,x){shape=par[2]; scale=par[3]; loc=par[4]; qweibull(x,shape,scale)+loc}
if (location==FALSE){
quan0=function(par,x){shape=par[2]; scale=par[3]; qweibull(x,shape,scale)}
}}
if(g=="gamma"){
quan0=function(par,x){shape=par[2]; scale=par[3]; loc=par[4]; qgamma(x,shape,scale)+loc}
if (location==FALSE){
quan0=function(par,x){shape=par[2]; scale=par[3]; qgamma(x,shape,scale)}
}}
quan<-function(par,x){
a=par[1]
quan0(par,-log(1-x*(1-exp(-a)))/a)
}
return(quan(param,runif(n)))
}
qkumg<-function(p, g, param, location=TRUE, log.p = FALSE, lower.tail = TRUE){
if(g!="birnbaum-saunders" & g!="exp" & g!="rayleigh" & g!="weibull" & g!="gompertz" & g!="gamma"
& g!="log-normal" & g!="chisq" & g!="f" & g!="burrxii" & g!="frechet"
& g!="lomax" & g!="log-logistic" & g!="lfr" & g!="chen")
{ stop ("Baseline distribution not implemented or misspelled. Please check the manual for guidelines.") }
if(g=="log-normal"){
quan0=function(par,x){meanlog=par[3]; sdlog=par[4]; loc=par[5]; qlnorm(x,meanlog,sdlog)+loc}
if (location==FALSE){
quan0=function(par,x){meanlog=par[3]; sdlog=par[4]; qlnorm(x,meanlog,sdlog)}
}}
if(g=="chisq"){
quan0=function(par,x){df=par[3]; loc=par[4]; qchisq(x,df)+loc}
if (location==FALSE){
quan0=function(par,x){df=par[3]; qchisq(x,df)}
}}
if(g=="f"){
quan0=function(par,x){df1=par[3]; df2=par[4]; loc=par[5]; qf(x,df1,df2)+loc}
if (location==FALSE){
quan0=function(par,x){df1=par[3]; df2=par[4]; qf(x,df1,df2)}
}}
if(g=="chen"){
quan0=function(par,x){a=par[3]; b=par[4]; loc=par[5]; (log(1-log(1-x)/b))^(1/a)+loc}
if (location==FALSE){
quan0=function(par,x){a=par[3]; b=par[4]; (log(1-log(1-x)/b))^(1/a)}
}}
if(g=="lfr"){
quan0=function(par,x){a=par[3]; b=par[4]; loc=par[5]; (-a+sqrt(a^2-2*b*log(1-x)))/b+loc}
if (location==FALSE){
quan0=function(par,x){a=par[3]; b=par[4]; (-a+sqrt(a^2-2*b*log(1-x)))/b}
}}
if(g=="log-logistic"){
quan0=function(par,x){a=par[3]; b=par[4]; loc=par[5]; b*(1/x-1)^(-1/a)+loc}
if (location==FALSE){
quan0=function(par,x){a=par[3]; b=par[4]; b*(1/x-1)^(-1/a)}
}}
if(g=="lomax"){
quan0=function(par,x){a=par[3]; b=par[4]; loc=par[5]; ((1-x)^(-1/b)-1)/a+loc}
if (location==FALSE){
quan0=function(par,x){a=par[3]; b=par[4]; ((1-x)^(-1/b)-1)/a}
}}
if(g=="gompertz"){
quan0=function(par,x){a=par[3]; b=par[4]; loc=par[5]; log(1-a/b*log(1-x))/a+loc}
if (location==FALSE){
quan0=function(par,x){a=par[3]; b=par[4]; log(1-a/b*log(1-x))/a}
}}
if(g=="exp"){
quan0=function(par,x){rate=par[3]; loc=par[4]; qexp(x,rate)+loc}
if (location==FALSE){
quan0=function(par,x){rate=par[3]; qexp(x,rate)}
}}
if(g=="rayleigh"){
quan0=function(par,x){a=par[3]; loc=par[4]; a*(-log(1-x))^(1/2)+loc}
if (location==FALSE){
quan0=function(par,x){a=par[3]; a*(-log(1-x))^(1/2)}
}}
if(g=="burrxii"){
quan0=function(par,x){a=par[3]; d=par[4]; loc=par[5]; (1/(1-x)-1)^(1/d)+loc}
if (location==FALSE){
quan0=function(par,x){a=par[3]; d=par[4]; (1/(1-x)-1)^(1/d)}
}}
if(g=="frechet"){
quan0=function(par,x){a=par[3]; b=par[4]; loc=par[5]; b*(-log(x))^(-1/a)+loc}
if (location==FALSE){
quan0=function(par,x){a=par[3]; b=par[4]; b*(-log(x))^(-1/a)}
}}
if(g=="birnbaum-saunders"){
quan0=function(par,x){a=par[3]; b=par[4]; loc=par[5]; b/4*(a*qnorm(x)+sqrt((a*qnorm(x))^2+4))^2+loc}
if (location==FALSE){
quan0=function(par,x){a=par[3]; b=par[4]; b/4*(a*qnorm(x)+sqrt((a*qnorm(x))^2+4))^2}
}}
if(g=="weibull"){
quan0=function(par,x){shape=par[3]; scale=par[4]; loc=par[5]; qweibull(x,shape,scale)+loc}
if (location==FALSE){
quan0=function(par,x){shape=par[3]; scale=par[4]; qweibull(x,shape,scale)}
}}
if(g=="gamma"){
quan0=function(par,x){shape=par[3]; scale=par[4]; loc=par[5]; qgamma(x,shape,scale)+loc}
if (location==FALSE){
quan0=function(par,x){shape=par[3]; scale=par[4]; qgamma(x,shape,scale)}
}}
quan<-function(par,x){
a=par[1]
b=par[2]
quan0(par,(1-(1-x)^(1/b))^(1/a))
}
out<-quan(param,p)
if(log.p==TRUE & lower.tail == FALSE) out<-quan(param,exp(p-1))
if(log.p==TRUE & lower.tail == TRUE) out<-quan(param,exp(-p))
if(log.p==FALSE & lower.tail == FALSE) out<-quan(param,1-p)
return(out)
}
rkumg<-function(n, g, param, location=TRUE){
if(g!="birnbaum-saunders" & g!="exp" & g!="rayleigh" & g!="weibull" & g!="gompertz" & g!="gamma"
& g!="log-normal" & g!="chisq" & g!="f" & g!="burrxii" & g!="frechet"
& g!="lomax" & g!="log-logistic" & g!="lfr" & g!="chen")
{ stop ("Baseline distribution not implemented or misspelled. Please check the manual for guidelines.") }
if(n %% 1 !=0) { stop ("parameter n must be integer.") }
if(g=="log-normal"){
quan0=function(par,x){meanlog=par[3]; sdlog=par[4]; loc=par[5]; qlnorm(x,meanlog,sdlog)+loc}
if (location==FALSE){
quan0=function(par,x){meanlog=par[3]; sdlog=par[4]; qlnorm(x,meanlog,sdlog)}
}}
if(g=="chisq"){
quan0=function(par,x){df=par[3]; loc=par[4]; qchisq(x,df)+loc}
if (location==FALSE){
quan0=function(par,x){df=par[3]; qchisq(x,df)}
}}
if(g=="f"){
quan0=function(par,x){df1=par[3]; df2=par[4]; loc=par[5]; qf(x,df1,df2)+loc}
if (location==FALSE){
quan0=function(par,x){df1=par[3]; df2=par[4]; qf(x,df1,df2)}
}}
if(g=="chen"){
quan0=function(par,x){a=par[3]; b=par[4]; loc=par[5]; (log(1-log(1-x)/b))^(1/a)+loc}
if (location==FALSE){
quan0=function(par,x){a=par[3]; b=par[4]; (log(1-log(1-x)/b))^(1/a)}
}}
if(g=="lfr"){
quan0=function(par,x){a=par[3]; b=par[4]; loc=par[5]; (-a+sqrt(a^2-2*b*log(1-x)))/b+loc}
if (location==FALSE){
quan0=function(par,x){a=par[3]; b=par[4]; (-a+sqrt(a^2-2*b*log(1-x)))/b}
}}
if(g=="log-logistic"){
quan0=function(par,x){a=par[3]; b=par[4]; loc=par[5]; b*(1/x-1)^(-1/a)+loc}
if (location==FALSE){
quan0=function(par,x){a=par[3]; b=par[4]; b*(1/x-1)^(-1/a)}
}}
if(g=="lomax"){
quan0=function(par,x){a=par[3]; b=par[4]; loc=par[5]; ((1-x)^(-1/b)-1)/a+loc}
if (location==FALSE){
quan0=function(par,x){a=par[3]; b=par[4]; ((1-x)^(-1/b)-1)/a}
}}
if(g=="gompertz"){
quan0=function(par,x){a=par[3]; b=par[4]; loc=par[5]; log(1-a/b*log(1-x))/a+loc}
if (location==FALSE){
quan0=function(par,x){a=par[3]; b=par[4]; log(1-a/b*log(1-x))/a}
}}
if(g=="exp"){
quan0=function(par,x){rate=par[3]; loc=par[4]; qexp(x,rate)+loc}
if (location==FALSE){
quan0=function(par,x){rate=par[3]; qexp(x,rate)}
}}
if(g=="rayleigh"){
quan0=function(par,x){a=par[3]; loc=par[4]; a*(-log(1-x))^(1/2)+loc}
if (location==FALSE){
quan0=function(par,x){a=par[3]; a*(-log(1-x))^(1/2)}
}}
if(g=="burrxii"){
quan0=function(par,x){a=par[3]; d=par[4]; loc=par[5]; (1/(1-x)-1)^(1/d)+loc}
if (location==FALSE){
quan0=function(par,x){a=par[3]; d=par[4]; (1/(1-x)-1)^(1/d)}
}}
if(g=="frechet"){
quan0=function(par,x){a=par[3]; b=par[4]; loc=par[5]; b*(-log(x))^(-1/a)+loc}
if (location==FALSE){
quan0=function(par,x){a=par[3]; b=par[4]; b*(-log(x))^(-1/a)}
}}
if(g=="birnbaum-saunders"){
quan0=function(par,x){a=par[3]; b=par[4]; loc=par[5]; b/4*(a*qnorm(x)+sqrt((a*qnorm(x))^2+4))^2+loc}
if (location==FALSE){
quan0=function(par,x){a=par[3]; b=par[4]; b/4*(a*qnorm(x)+sqrt((a*qnorm(x))^2+4))^2}
}}
if(g=="weibull"){
quan0=function(par,x){shape=par[3]; scale=par[4]; loc=par[5]; qweibull(x,shape,scale)+loc}
if (location==FALSE){
quan0=function(par,x){shape=par[3]; scale=par[4]; qweibull(x,shape,scale)}
}}
if(g=="gamma"){
quan0=function(par,x){shape=par[3]; scale=par[4]; loc=par[5]; qgamma(x,shape,scale)+loc}
if (location==FALSE){
quan0=function(par,x){shape=par[3]; scale=par[4]; qgamma(x,shape,scale)}
}}
quan<-function(par,x){
a=par[1]
b=par[2]
quan0(par,(1-(1-x)^(1/b))^(1/a))
}
return(quan(param,runif(n)))
}
qloggammag1<-function(p, g, param, location=TRUE, log.p = FALSE, lower.tail = TRUE){
if(g!="birnbaum-saunders" & g!="exp" & g!="rayleigh" & g!="weibull" & g!="gompertz" & g!="gamma"
& g!="log-normal" & g!="chisq" & g!="f" & g!="burrxii" & g!="frechet"
& g!="lomax" & g!="log-logistic" & g!="lfr" & g!="chen")
{ stop ("Baseline distribution not implemented or misspelled. Please check the manual for guidelines.") }
if(g=="log-normal"){
quan0=function(par,x){meanlog=par[3]; sdlog=par[4]; loc=par[5]; qlnorm(x,meanlog,sdlog)+loc}
if (location==FALSE){
quan0=function(par,x){meanlog=par[3]; sdlog=par[4]; qlnorm(x,meanlog,sdlog)}
}}
if(g=="chisq"){
quan0=function(par,x){df=par[3]; loc=par[4]; qchisq(x,df)+loc}
if (location==FALSE){
quan0=function(par,x){df=par[3]; qchisq(x,df)}
}}
if(g=="f"){
quan0=function(par,x){df1=par[3]; df2=par[4]; loc=par[5]; qf(x,df1,df2)+loc}
if (location==FALSE){
quan0=function(par,x){df1=par[3]; df2=par[4]; qf(x,df1,df2)}
}}
if(g=="chen"){
quan0=function(par,x){a=par[3]; b=par[4]; loc=par[5]; (log(1-log(1-x)/b))^(1/a)+loc}
if (location==FALSE){
quan0=function(par,x){a=par[3]; b=par[4]; (log(1-log(1-x)/b))^(1/a)}
}}
if(g=="lfr"){
quan0=function(par,x){a=par[3]; b=par[4]; loc=par[5]; (-a+sqrt(a^2-2*b*log(1-x)))/b+loc}
if (location==FALSE){
quan0=function(par,x){a=par[3]; b=par[4]; (-a+sqrt(a^2-2*b*log(1-x)))/b}
}}
if(g=="log-logistic"){
quan0=function(par,x){a=par[3]; b=par[4]; loc=par[5]; b*(1/x-1)^(-1/a)+loc}
if (location==FALSE){
quan0=function(par,x){a=par[3]; b=par[4]; b*(1/x-1)^(-1/a)}
}}
if(g=="lomax"){
quan0=function(par,x){a=par[3]; b=par[4]; loc=par[5]; ((1-x)^(-1/b)-1)/a+loc}
if (location==FALSE){
quan0=function(par,x){a=par[3]; b=par[4]; ((1-x)^(-1/b)-1)/a}
}}
if(g=="gompertz"){
quan0=function(par,x){a=par[3]; b=par[4]; loc=par[5]; log(1-a/b*log(1-x))/a+loc}
if (location==FALSE){
quan0=function(par,x){a=par[3]; b=par[4]; log(1-a/b*log(1-x))/a}
}}
if(g=="exp"){
quan0=function(par,x){rate=par[3]; loc=par[4]; qexp(x,rate)+loc}
if (location==FALSE){
quan0=function(par,x){rate=par[3]; qexp(x,rate)}
}}
if(g=="rayleigh"){
quan0=function(par,x){a=par[3]; loc=par[4]; a*(-log(1-x))^(1/2)+loc}
if (location==FALSE){
quan0=function(par,x){a=par[3]; a*(-log(1-x))^(1/2)}
}}
if(g=="burrxii"){
quan0=function(par,x){a=par[3]; d=par[4]; loc=par[5]; (1/(1-x)-1)^(1/d)+loc}
if (location==FALSE){
quan0=function(par,x){a=par[3]; d=par[4]; (1/(1-x)-1)^(1/d)}
}}
if(g=="frechet"){
quan0=function(par,x){a=par[3]; b=par[4]; loc=par[5]; b*(-log(x))^(-1/a)+loc}
if (location==FALSE){
quan0=function(par,x){a=par[3]; b=par[4]; b*(-log(x))^(-1/a)}
}}
if(g=="birnbaum-saunders"){
quan0=function(par,x){a=par[3]; b=par[4]; loc=par[5]; b/4*(a*qnorm(x)+sqrt((a*qnorm(x))^2+4))^2+loc}
if (location==FALSE){
quan0=function(par,x){a=par[3]; b=par[4]; b/4*(a*qnorm(x)+sqrt((a*qnorm(x))^2+4))^2}
}}
if(g=="weibull"){
quan0=function(par,x){shape=par[3]; scale=par[4]; loc=par[5]; qweibull(x,shape,scale)+loc}
if (location==FALSE){
quan0=function(par,x){shape=par[3]; scale=par[4]; qweibull(x,shape,scale)}
}}
if(g=="gamma"){
quan0=function(par,x){shape=par[3]; scale=par[4]; loc=par[5]; qgamma(x,shape,scale)+loc}
if (location==FALSE){
quan0=function(par,x){shape=par[3]; scale=par[4]; qgamma(x,shape,scale)}
}}
quan<-function(par,x){
a=par[1]
b=par[2]
quan0(par,1-exp(-qgamma(x,shape=a,scale=1)/b))
}
out<-quan(param,p)
if(log.p==TRUE & lower.tail == FALSE) out<-quan(param,exp(p-1))
if(log.p==TRUE & lower.tail == TRUE) out<-quan(param,exp(-p))
if(log.p==FALSE & lower.tail == FALSE) out<-quan(param,1-p)
return(out)
}
rloggammag1<-function(n, g, param, location=TRUE){
if(g!="birnbaum-saunders" & g!="exp" & g!="rayleigh" & g!="weibull" & g!="gompertz" & g!="gamma"
& g!="log-normal" & g!="chisq" & g!="f" & g!="burrxii" & g!="frechet"
& g!="lomax" & g!="log-logistic" & g!="lfr" & g!="chen")
{ stop ("Baseline distribution not implemented or misspelled. Please check the manual for guidelines.") }
if(n %% 1 !=0) { stop ("parameter n must be integer.") }
if(g=="log-normal"){
quan0=function(par,x){meanlog=par[3]; sdlog=par[4]; loc=par[5]; qlnorm(x,meanlog,sdlog)+loc}
if (location==FALSE){
quan0=function(par,x){meanlog=par[3]; sdlog=par[4]; qlnorm(x,meanlog,sdlog)}
}}
if(g=="chisq"){
quan0=function(par,x){df=par[3]; loc=par[4]; qchisq(x,df)+loc}
if (location==FALSE){
quan0=function(par,x){df=par[3]; qchisq(x,df)}
}}
if(g=="f"){
quan0=function(par,x){df1=par[3]; df2=par[4]; loc=par[5]; qf(x,df1,df2)+loc}
if (location==FALSE){
quan0=function(par,x){df1=par[3]; df2=par[4]; qf(x,df1,df2)}
}}
if(g=="chen"){
quan0=function(par,x){a=par[3]; b=par[4]; loc=par[5]; (log(1-log(1-x)/b))^(1/a)+loc}
if (location==FALSE){
quan0=function(par,x){a=par[3]; b=par[4]; (log(1-log(1-x)/b))^(1/a)}
}}
if(g=="lfr"){
quan0=function(par,x){a=par[3]; b=par[4]; loc=par[5]; (-a+sqrt(a^2-2*b*log(1-x)))/b+loc}
if (location==FALSE){
quan0=function(par,x){a=par[3]; b=par[4]; (-a+sqrt(a^2-2*b*log(1-x)))/b}
}}
if(g=="log-logistic"){
quan0=function(par,x){a=par[3]; b=par[4]; loc=par[5]; b*(1/x-1)^(-1/a)+loc}
if (location==FALSE){
quan0=function(par,x){a=par[3]; b=par[4]; b*(1/x-1)^(-1/a)}
}}
if(g=="lomax"){
quan0=function(par,x){a=par[3]; b=par[4]; loc=par[5]; ((1-x)^(-1/b)-1)/a+loc}
if (location==FALSE){
quan0=function(par,x){a=par[3]; b=par[4]; ((1-x)^(-1/b)-1)/a}
}}
if(g=="gompertz"){
quan0=function(par,x){a=par[3]; b=par[4]; loc=par[5]; log(1-a/b*log(1-x))/a+loc}
if (location==FALSE){
quan0=function(par,x){a=par[3]; b=par[4]; log(1-a/b*log(1-x))/a}
}}
if(g=="exp"){
quan0=function(par,x){rate=par[3]; loc=par[4]; qexp(x,rate)+loc}
if (location==FALSE){
quan0=function(par,x){rate=par[3]; qexp(x,rate)}
}}
if(g=="rayleigh"){
quan0=function(par,x){a=par[3]; loc=par[4]; a*(-log(1-x))^(1/2)+loc}
if (location==FALSE){
quan0=function(par,x){a=par[3]; a*(-log(1-x))^(1/2)}
}}
if(g=="burrxii"){
quan0=function(par,x){a=par[3]; d=par[4]; loc=par[5]; (1/(1-x)-1)^(1/d)+loc}
if (location==FALSE){
quan0=function(par,x){a=par[3]; d=par[4]; (1/(1-x)-1)^(1/d)}
}}
if(g=="frechet"){
quan0=function(par,x){a=par[3]; b=par[4]; loc=par[5]; b*(-log(x))^(-1/a)+loc}
if (location==FALSE){
quan0=function(par,x){a=par[3]; b=par[4]; b*(-log(x))^(-1/a)}
}}
if(g=="birnbaum-saunders"){
quan0=function(par,x){a=par[3]; b=par[4]; loc=par[5]; b/4*(a*qnorm(x)+sqrt((a*qnorm(x))^2+4))^2+loc}
if (location==FALSE){
quan0=function(par,x){a=par[3]; b=par[4]; b/4*(a*qnorm(x)+sqrt((a*qnorm(x))^2+4))^2}
}}
if(g=="weibull"){
quan0=function(par,x){shape=par[3]; scale=par[4]; loc=par[5]; qweibull(x,shape,scale)+loc}
if (location==FALSE){
quan0=function(par,x){shape=par[3]; scale=par[4]; qweibull(x,shape,scale)}
}}
if(g=="gamma"){
quan0=function(par,x){shape=par[3]; scale=par[4]; loc=par[5]; qgamma(x,shape,scale)+loc}
if (location==FALSE){
quan0=function(par,x){shape=par[3]; scale=par[4]; qgamma(x,shape,scale)}
}}
quan<-function(par,x){
a=par[1]
b=par[2]
quan0(par,1-exp(-qgamma(x,shape=a,scale=1)/b))
}
return(quan(param,runif(n)))
}