GB2/0000755000176200001440000000000012524221701010620 5ustar liggesusersGB2/NAMESPACE0000644000176200001440000000240212524205674012050 0ustar liggesusersimport(laeken) import(stats) import(survey) importFrom(hypergeo, isgood, genhypergeo_series) importFrom(numDeriv, grad, jacobian) importFrom(cubature, adaptIntegrate) export( dgb2, pgb2, qgb2, rgb2, moment.gb2, incompl.gb2, el.gb2, vl.gb2, sl.gb2, kl.gb2, arpt.gb2, arpr.gb2, rmpg.gb2, qsr.gb2, Thomae, gb2.gini, gini.gb2, gini.b2, gini.dag, gini.sm, main.gb2, main2.gb2, logf.gb2, dlogf.gb2, d2logf.gb2, loglp.gb2, loglh.gb2, scoresp.gb2, scoresh.gb2, info.gb2, prof.gb2, proflogl.gb2, profscores.gb2, fisk, fiskh, ml.gb2, mlh.gb2, profml.gb2, main.emp, mlfit.gb2, nlsfit.gb2, plotsML.gb2, robwts, saveplot, contprof.gb2, contindic.gb2, varscore.gb2, vepar.gb2, derivind.gb2, veind.gb2, fg.cgb2, dl.cgb2, pl.cgb2, dcgb2, pcgb2, prcgb2, mkl.cgb2, moment.cgb2, incompl.cgb2, qcgb2, rcgb2, arpt.cgb2, arpr.cgb2, rmpg.cgb2, qsr.cgb2, main.cgb2, vofp.cgb2, pofv.cgb2, logl.cgb2, scoreU.cgb2, scores.cgb2, ml.cgb2, dplot.cgb2, varscore.cgb2, desvar.cgb2, hess.cgb2, vepar.cgb2, derivind.cgb2, veind.cgb2, pkl.cavgb2, lambda0.cavgb2, logl.cavgb2, scores.cavgb2, scoreU.cavgb2, scorez.cavgb2, ml.cavgb2, dplot.cavgb2, varscore.cavgb2, desvar.cavgb2, hess.cavgb2, vepar.cavgb2, veind.cavgb2 ) GB2/R/0000755000176200001440000000000012524205675011035 5ustar liggesusersGB2/R/Varest.R0000644000176200001440000000461512524205674012431 0ustar liggesusers varscore.gb2 <- function(x, shape1, scale, shape2, shape3, w=rep(1, length(x)), hs=rep(1,length(x))){ m <- length(x) Vsc <- matrix(rep(0,16), ncol=4) for (i in 1:m){ wsci <- w[i]*dlogf.gb2(x[i], shape1, scale, shape2, shape3) Wsci <- wsci%*%t(wsci) Vsc <- Vsc + (hs[i]^2)*Wsci } return(Vsc) } vepar.gb2 <- function(x, Vsc, shape1, scale, shape2, shape3, w=rep(1, length(x)), hs=rep(1,length(x))){ #estimated variance-covariance matrix of af, bf, pf and qf (EVCM) m <- length(x) #the left and right side of the sandwich estimator # = - (sum_{i=1}^m w_i * n_i * h_i ) #where h_i is the matrix of second derivatives of the log density #in this case obtained by the function d2logf.gb2 WDM <- matrix(rep(0,16), ncol=4) for (i in 1:m){ WDM <- WDM + w[i]*hs[i]*d2logf.gb2(x[i], shape1, scale, shape2, shape3) } WDM <- -WDM #sandwich estimator EVCM <- solve(WDM)%*%Vsc%*%solve(WDM) return(list(EVCM,WDM)) } #numerical derivatives of the indicators derivind.gb2 <- function(shape1, scale, shape2, shape3){ par <- c(shape1, scale, shape2, shape3) med <- function(par){ main.gb2(0.6,par[1],par[2],par[3],par[4])[1] } mean <- function(par){ main.gb2(0.6,par[1],par[2],par[3],par[4])[2] } arpr <- function(par){ main.gb2(0.6,par[1],par[2],par[3],par[4])[3] } rmpg <- function(par){ main.gb2(0.6,par[1],par[2],par[3],par[4])[4] } qsr <- function(par){ main.gb2(0.6,par[1],par[2],par[3],par[4])[5] } gini <- function(par){ main.gb2(0.6,par[1],par[2],par[3],par[4])[6] } dmed <- grad(med, par, method= "Richardson", method.args = list()) dmean <- grad(mean, par, method= "Richardson", method.args = list()) darpr <- grad(arpr, par, method= "Richardson", method.args = list()) drmpg <- grad(rmpg, par, method= "Richardson", method.args = list()) dqsr <- grad(qsr, par, method= "Richardson", method.args = list()) dgini <- grad(gini, par, method= "Richardson", method.args = list()) MFDI <- rbind(dmed, dmean, darpr, drmpg, dqsr, dgini, deparse.level=0) return(MFDI) } veind.gb2 <- function(Vpar, shape1, scale, shape2, shape3){ # matrix of first derivatives of the indicators MFDI <- derivind.gb2(shape1, scale, shape2, shape3) #delta method for variance estimation of the indicators # variance-covariance matrix of the indicators IVCM <- matrix(rep(0, 36), ncol=6) for (i in 1:6){ for (j in 1:6){ IVCM[i,j] <- t(MFDI[i,])%*%Vpar%*%MFDI[j,] } } return(IVCM) } GB2/R/MLfitGB2.R0000644000176200001440000000370012524205674012465 0ustar liggesusers#Empirical estimates main.emp <- function(z, w=rep(1, length(z))){ median.emp <- weightedMedian(z, w) mean.emp <- sum(w*z)/sum(w) arpr.emp <- arpr(z, w)$value rmpg.emp <- rmpg(z, w)$value qsr.emp <- qsr(z, w)$value gini.emp <- (gini(z, w)$value)/100 main <- c(median.emp, mean.emp, arpr.emp, rmpg.emp, qsr.emp, gini.emp) names(main) <- c("median", "mean", "arpr", "rmpg", "qsr", "gini") return(main) } # Fit by maximum likelihood, sample of persons mlfit.gb2 <- function(z, w=rep(1, length(z))){ d <- data.frame(inc=z,w=w) d <- d[!is.na(d$inc),] # Truncate at 0 inc <- d$inc[d$inc > 0] w <- d$w[d$inc > 0] # Full log-likelihood fit fitf <- ml.gb2(inc, w)$opt1 af <- fitf$par[1] bf <- fitf$par[2] pf <- fitf$par[3] qf <- fitf$par[4] flik <- fitf$value indicf <- main.gb2(0.6, af, bf, pf, qf) # Profile log-likelihood fit fitp <- profml.gb2(inc, w)$opt1 ap <- fitp$par[1] bp <- fitp$par[2] pp <- prof.gb2(inc, ap, bp, w)[3] qp <- prof.gb2(inc, ap, bp, w)[4] plik <- fitp$value indicp <- main.gb2(0.6, ap, bp, pp, qp) # Values of the empirical estimates indicE <- main.emp(inc, w) type=c("Emp. est","ML full","ML prof") results <- data.frame(type=type, median=round(c(indicE[1],indicf[1],indicp[1])), mean=round(c(indicE[2],indicf[2],indicp[2])), ARPR=round(c(indicE[3],indicf[3],indicp[3]), digits=2), RMPG=round(c(indicE[4],indicf[4],indicp[4]), digits=2), QSR=round(c(indicE[5],indicf[5],indicp[5]), digits=2), GINI=round(c(indicE[6],indicf[6],indicp[6]), digits=2), likelihood=round(c(NA,flik,plik), digits=3), a=round(c(NA,af,ap), digits=2), b=round(c(NA,bf,bp), digits=2),p=round(c(NA,pf,pp), digits=2), q=round(c(NA,qf,qp), digits=2)) return(list(data.frame(results), fitf, fitp)) } GB2/R/Indicators.R0000644000176200001440000000321512524205674013257 0ustar liggesusersarpt.gb2 <- function(prop,shape1,scale,shape2,shape3){ median <- qgb2(0.5,shape1,scale,shape2,shape3) return(prop*median) } arpr.gb2 <- function(prop,shape1,shape2,shape3) { pgb2(arpt.gb2(prop,shape1,1,shape2,shape3),shape1,1,shape2,shape3) } rmpg.gb2 <- function(arpr,shape1,shape2,shape3){ 1-qgb2(arpr/2,shape1,1,shape2,shape3)/qgb2(arpr,shape1,1,shape2,shape3) } qsr.gb2 <- function(shape1,shape2,shape3) { q80 <- qgb2(0.8,shape1,1,shape2,shape3) q20 <- qgb2(0.2,shape1,1,shape2,shape3) return((1-incompl.gb2(q80,1,shape1,1,shape2,shape3))/incompl.gb2(q20,1,shape1,1,shape2,shape3)) } main.gb2 <- function(prop,shape1,scale,shape2,shape3){ median <- qgb2(0.5,shape1,scale,shape2,shape3) mean <- moment.gb2(1,shape1,scale,shape2,shape3) arpr <- arpr.gb2(prop,shape1,shape2,shape3) rmpg <- rmpg.gb2(arpr,shape1,shape2,shape2) qsr <- qsr.gb2(shape1,shape2,shape3) gini <- gini.gb2(shape1,shape2,shape3) main <- c(median,mean,100*arpr,100*rmpg,qsr,gini) names(main) <- c("median", "mean", "arpr", "rmpg", "qsr", "gini") return(main) } main2.gb2 <- function(prop,shape1,scale,shape12,shape13){ shape2 <- shape12/shape1 shape3 <- shape13/shape1 median <- qgb2(0.5,shape1,scale,shape2,shape3) mean <- moment.gb2(1,shape1,scale,shape2,shape3) arpr <- arpr.gb2(prop,shape1,shape2,shape3) rmpg <- rmpg.gb2(arpr,shape1,shape2,shape2) qsr <- qsr.gb2(shape1,shape2,shape3) gini <- gini.gb2(shape1,shape2,shape3) main <- c(median,mean,100*arpr,100*rmpg,qsr,gini) names(main) <- c("median", "mean", "arpr", "rmpg", "qsr", "gini") return(main) }GB2/R/CompoundAuxVarest.r0000644000176200001440000000757712524205674014666 0ustar liggesusersscoreU.cavgb2 <- function (fac, z, lambda) { evl <- exp(z %*% lambda) ck <- apply(evl, 1, sum) + 1 pkl <- evl/ck pkL <- cbind(pkl, 1 - rowSums(pkl)) L <- dim(pkL)[2] denom <- rowSums(pkL * fac) # column vector num <- fac[, -L] midt <- num/as.vector(denom) - 1 U <- pkl[,-L] * midt return(U) } scorez.cavgb2 <- function(U,z){ n <- dim(U)[1] L1 <- dim(U)[2] # L-1 SC <- matrix(nrow=n) for (l in 1:L1){ SCl <-matrix(z*U[,l],nrow= n) # U_kl*z_k colnames(SCl) <- paste(colnames(z),l,sep="") SC <- cbind(SC,SCl) } SC <- SC[,-1] return(SC) } varscore.cavgb2 <- function(SC,w=rep(1,dim(SC)[1])){ Vsc <- varscore.cgb2(SC,w) return(Vsc) } desvar.cavgb2 <- function(data=data, SC=SC, ids=NULL, probs=NULL, strata = NULL, variables = NULL, fpc=NULL, nest = FALSE, check.strata = !nest, weights=NULL,pps=FALSE,variance=c("HT","YG")) { desvar.cgb2(data=data, U=SC, ids=ids, probs=probs, strata = strata, variables = variables, fpc=fpc, nest = nest, check.strata = !nest, weights=weights, pps=pps, variance=variance) } hess.cavgb2 <- function(U,P,z,w=rep(1, dim(z)[1])){ dz <- dim(z) # n x I z: matrix of auxiliary variables dP <- dim(P) # n x L P: matrix of mixture probabilities dU <- dim(U) # n x (L-1) U: matrix of scores, see eq. 21 if (dP[2] ==2) { dU2=1 dU1=length(U) } else { dU1=dU[1] dU2=dU[2] } L1 <- dP[2]-1 Lw <- length(w) if ((dU2!=L1)|!((dU1==Lw) | (Lw==1)) | (dz[1]!=dP[1]) | (dz[1]!=dU1) ){ warning("error in dimensions: no of parameters= ",L1,"; length(w)= ",Lw,"; dim(U)= ",dU[1],",",dU[2],"; dim(P)= ",dP[1],",",dP[2]) return() } n <- dz[1] I <- dz[2] L1 <- dU2 V2 <- matrix(0,nrow=I*L1,ncol=I*L1) nn <- expand.grid(gr=colnames(z),par=1:L1) na <- paste(nn$gr,nn$pa,sep="") colnames(V2)<- na rownames(V2)<- na if (L1==1){ A1 <- -U^2 A2 <- A1 + U - 2*P[,1]*U V2 <- t(z*w)%*%(z*A2) } else{ for (i in 1:L1){ for (j in 1:L1){ a1ij <- -U[,i]*U[,j] a2ij <- -P[,i]*U[,j] - P[,j]*U[,i] + a1ij +(i==j)*U[,i] indi <- (i-1)*I + 1:I indj <- (j-1)*I + 1:I V2[indi,indj] <- t((z*w))%*%(z*a2ij) } } } eigv <- eigen(V2)[[1]] if (max(eigv)>0) { print("Spurious estimates: Fisher information matrix non negative definite.",quote=FALSE) print("Eigenvalues:",quote=FALSE) print(eigv) } else{} return(V2) } vepar.cavgb2 <- function(ml,Vsc, hess) { estimate <- ml[[2]]$par V2 <- hess V <- solve(V2) Vcov <- V %*% Vsc %*% V stderr <- sqrt(diag(Vcov)) Vcor <- diag(1/stderr)%*%Vcov%*%diag(1/stderr) names(estimate) <- rownames(Vcov) dimnames(Vcor) <- dimnames(Vcov) return(list(type="parameter",estimate=estimate, stderr=stderr, Vcov=Vcov, Vcor=Vcor)) } veind.cavgb2 <- function(group,vepar,shape1, scale, shape2, shape3, pl0, P, decomp="r") { L <- length(pl0) K <- length(levels(group)) error <- "FALSE" for (k in 1:K){ dPk <- length(unique(P[group==levels(group)[k]])) if (dPk>L){ error <- "TRUE" warning("the estimated probabilities are not uniquely defined for group ", levels(group)[k]) } } if (error) return() L2 <- L-2 indic <- list() for (k in 1:K){ pk <- as.vector(unique(P[group==levels(group)[k]])) esti <- derivind.cgb2(shape1, scale, shape2, shape3, pl0, pk, decomp=decomp) MFDI <- esti[["jacobian"]] indi <- c(k+K*(0:L2)) Vcov.gr <- vepar[["Vcov"]][indi,indi] Vcov <- MFDI%*%Vcov.gr%*%t(MFDI) stderr <- sqrt(diag(Vcov)) Vcor <- diag(1/stderr)%*%Vcov%*%diag(1/stderr) rownames(Vcor) <- colnames(Vcor) <- rownames(MFDI) ngroup <- levels(group)[k] indic[[k]] <- list(group=ngroup,estimate=esti[["estimate"]],stderr=stderr,Vcov=Vcov,Vcor=Vcor) } indic[["type"]] <- "indicator" return(indic) }GB2/R/ProfLogLikelihood.R0000644000176200001440000000253612524205674014541 0ustar liggesusers # Parameters and weighted sums prof.gb2 <- function(x, shape1, scale, w=rep(1, length(x))){ sw <- sum(w) y <- (x/scale)^shape1 slog <- sum(w*log(y))/sw # = m sloga <- sum(w*log(1+y))/sw sloga.a <- sum(w*log(y)*y/(1+y))/sw r <- sum(w*y/(1+y))/sw s <- 1/(sloga.a-r*slog) p <- r*s q <- (1-r)*s return(c(r, s, p, q, slog, sloga)) } # Profile log-likelihood of a, b proflogl.gb2 <- function(x, shape1, scale, w=rep(1, length(x))){ pars <- prof.gb2(x, shape1, scale, w) pll <- -lbeta(pars[3],pars[4]) + log(abs(shape1)/scale) + (pars[3]-1/shape1)*pars[5] - (pars[3]+pars[4])*pars[6] return(pll) } # Scores for the profile log-likelihood profscores.gb2 <- function(x, shape1, scale, w=rep(1, length(x))){ sw <- sum(w) y <- (x/scale)^shape1 pars <- prof.gb2(x, shape1, scale, w) dr.da <- (1/shape1)*sum(w*y*log(y)/(1+y)^2)/sw ds.da <- -(pars[2]^2/shape1)*sum(w*(y*log(y)/(1+y)^2 + y/(1+y))*(log(y)-pars[5]))/sw dr.db <- -(shape1/scale)*sum(w*y/(1+y)^2)/sw ds.db <- (pars[2]^2)*(shape1/scale)*sum(w*y*(log(y)-pars[5])/(1+y)^2)/sw dpll.dr <- pars[2]*(pars[5] - digamma(pars[3]) + digamma(pars[4])) dpll.ds <- pars[1]*(pars[5] - digamma(pars[3])) + digamma(pars[2]) - (1-pars[1])*digamma(pars[4]) - pars[6] dpll.da <- dpll.dr*dr.da + dpll.ds*ds.da dpll.db <- dpll.dr*dr.db + dpll.ds*ds.db return(c(dpll.da,dpll.db)) }GB2/R/Fisk.R0000644000176200001440000000132412524205674012053 0ustar liggesusers fisk <- function(z, w=rep(1, length(z))){ wmv <- function(z, w){ # weighted mean and variance of log(z) sw <- sum(w) logz <- log(z) mlz <- sum(w*logz)/sw vlz <- sum(w*(logz-mlz)^2)/sw return(list(mlz,vlz)) } ab0 <- wmv(z, w) # Initial values under Fisk x0 <- c(pi/sqrt(3*ab0[[2]]),exp(ab0[[1]]),1,1) return(x0) } fiskh <- function(z, w=rep(1, length(z)), hs=rep(1, length(z))){ wmv <- function(z, w, hs){ # weighted mean and variance of log(z) sw <- sum(w*hs) logz <- log(z) mlz <- sum(w*hs*logz)/sw vlz <- sum(w*hs*(logz-mlz)^2)/sw return(list(mlz,vlz)) } ab0 <- wmv(z, w, hs) # Initial values under Fisk x0 <- c(pi/sqrt(3*ab0[[2]]),exp(ab0[[1]]),1,1) return(x0) }GB2/R/Thomae.R0000644000176200001440000000613612524205674012402 0ustar liggesusers combiopt <- function(g){ ind1 <- c(1, 1, 2, 3) ind2 <- c(2, 4, 3, 4) excess <- sum(g)/2 - g[ind1]- g[ind2] excessopt <- max(excess) ind1 <- ind1[excess==excessopt][1] ind2 <- ind2[excess==excessopt][1] return(list(ind1=ind1, ind2=ind2, excessopt=excessopt)) } ULg <- function(U, L){ u1 <- U[1] u2 <- U[2] u3 <- U[3] l1 <- L[1] l2 <- L[2] #the excess s <- l1 + l2 - u1 - u2 - u3 g1 <- l1 + l2 - u2 - u3 g2 <- l1 + l2 - u1 - u3 g3 <- l1 + l2 - u1 - u2 g <- c(g1, g2, g3, l1, l2) return(list(g=g, excess=s)) } Thomae <- function(U, L, lB, tol, maxiter, debug){ V <- ULg(U,L) g <- V$g # the permuting variables in Thomae's theorem s <- V$excess # the excess corresponding to the input permutation if (s <= 0) return(list(G1=NA)) # negative excess M <- combiopt(g) # optimal combination of Thomae's arguments excessopt <- M$excessopt Lopt <- g[c(M$ind1,M$ind2)] # lower parameters corresponding to the maximum excess Uopt <- g[-c(M$ind1,M$ind2)] - excessopt Gg <- genhypergeo_series(Uopt,Lopt,1, tol=tol, maxiter=maxiter, debug=debug) F32 <- Gg[[1]] out <- NULL if (debug) out <- Gg[[2]] # Equivalence factors are shape1 product - ratio of gammas. # First compute at the logarithmic scale to avoid numerical problems with large values # The log hypergeometric 3F2(U,L;1) is then given by: logG1 <- sum(lgamma(L)-lgamma(Lopt))+ lgamma(s) -lgamma(excessopt) + log(F32) # The term in the Gini expression is thus logG1 <- logG1 + lB G1 <- exp(logG1) return(list(G1=G1, F32=F32, Uopt=Uopt, Lopt=Lopt, out=out)) } gb2.gini <- function(shape1, shape2, shape3, tol=1e-08, maxiter=10000, debug=FALSE){ if (shape1 < 0 | shape2 < 0 | shape3 < 0) {print("Warning: negative parameter", quote=FALSE); return(list(G1=NA, G2=NA, B=NA, Gini=NA))} excess <- shape3-1/shape1 if (excess <= 0) {print("Warning: non-positive excess; expectation does not exist", quote=FALSE); return(list(G1=NA, G2=NA, B=NA, Gini=NA))} if (excess < 1e-10) {print("Warning: excess less than 1e-10; limiting value of 1 forced for Gini", quote=FALSE) return(list(G1=NA, G2=NA, B=NA, Gini=1))} U <- c(1, shape2 + shape3, 2*shape2 + 1/shape1) L1 <- c(shape2 + 1, 2*(shape2 + shape3)) L2 <- c(shape2 + 1 + 1/shape1, 2*(shape2 + shape3)) lB <- lbeta(2*shape3-1/shape1, 2*shape2+1/shape1) - lbeta(shape2, shape3)-lbeta(shape2 + 1/shape1, shape3 - 1/shape1) T1 <- Thomae(U, L1, lB, tol, maxiter, debug) T2 <- Thomae(U, L2, lB, tol, maxiter, debug) G1 <- T1$G1 G2 <- T2$G1 Gini <- G1/shape2 - G2/(shape2+1/shape1) if(is.infinite(G1)) {print("Warning: overflow occured; limiting value of 1 forced for Gini", quote=FALSE) return(list(G1=NA, G2=NA, B=NA, Gini=1))} if(!is.na(Gini) & Gini > 1+1e-10) {print("Warning! Gini estimate > 1:", quote=FALSE); print(Gini); print("Gini forced to 1", quote=FALSE); Gini <-1} return(list(G1=G1, G2=G2, F321 = T1$F32, F322= T2$F32, lB=lB, Gini=Gini, U=U, L1=L1, L2=L2, Uopt1=T1$Uopt, Lopt1=T1$Lopt, T1out=T1$out, T2out=T2$out)) } GB2/R/Contindic.R0000644000176200001440000000131412524205674013070 0ustar liggesuserscontindic.gb2 <- function(resol, shape1, shape21, shape22, shape31, shape32, fn, title, table = FALSE){ pp <- round(seq(shape21,shape22,length.out=resol),digits=2) qq <- round(seq(shape31,shape32,length.out=resol),digits=2) d <- pp %o% qq for (i in 1:resol){ for (j in 1:resol){ d[i,j] <- fn(shape1,pp[i],qq[j]) } } dlim = range(d, finite = TRUE) contour(pp, qq, d, levels = pretty(seq(dlim[1], dlim[2], length.out=17)), xlab = "p", ylab = "q", main = paste("a =", as.character(shape1)), cex=1.8) box() mtext(title,line=0.5) if(table){ d <- rbind(p=pp, d) d <- round(cbind(c(NA,qq), d), digits=2) print(paste("a =", as.character(shape1)), quote=FALSE) print(d) } } GB2/R/CompoundMoments.R0000644000176200001440000000320412524205674014305 0ustar liggesusers# Moment of order k mkl.cgb2 <- function(k, shape1, scale, shape2, shape3, pl0, decomp="r"){ if (decomp=="r") {sh <- shape3 a0 <- shape1} if (decomp=="l") {sh <- shape2 a0 <- -shape1} Egb2 <- moment.gb2(k,shape1,scale,shape2,shape3) u2 <- qgamma(cumsum(pl0),sh) u1 <- c(0,u2[-length(pl0)]) shk <- sh - k/a0 fac <- (pgamma(u2,shk) - pgamma(u1,shk))/(pgamma(u2,sh)-pgamma(u1,sh)) return(Egb2*fac) } # Moment of order k, -ap < k < aq moment.cgb2 <- function(k, shape1, scale, shape2, shape3, pl0, pl, decomp="r"){ pk <- shape2 + k/shape1 qk <- shape3 - k/shape1 if (qk <0) {print("moment does not exist: k >= aq", quote=FALSE);return(NA)} if (pk <0) {print("moment does not exist: k <= -ap", quote=FALSE);return(NA)} Ek <- mkl.cgb2(k,shape1,scale,shape2,shape3,pl0,decomp) return(sum(pl*Ek)) } # Incomplete moment of order k, -ap < k < aq incompl.cgb2 <- function(x, k, shape1, scale, shape2, shape3, pl0, pl, decomp="r"){ pk <- shape2+ k/shape1 qk <- shape3- k/shape1 if (qk <0) {print("moment does not exist: k >= aq", quote=FALSE);return(NA)} if (pk <0) {print("moment does not exist: k <= -ap", quote=FALSE);return(NA)} if (decomp=="r") {sh <- shape3 a0 <- shape1} if (decomp=="l") {sh <- shape2 a0 <- -shape1} shk <- sh -k/a0 u2 <- qgamma(cumsum(pl0),sh) ppl0 <- pgamma(u2,shk) ppl0 <- c(ppl0[1],diff(ppl0)) Fk <- pl.cgb2(x,shape1,scale,pk,qk,ppl0,decomp) Ek <- mkl.cgb2(k,shape1,scale,shape2,shape3,pl0,decomp) Mk <- Ek*Fk num <- sum(pl*Mk) denom <- sum(pl*Ek) return(num/denom) } GB2/R/Gini.R0000644000176200001440000000105212524205674012043 0ustar liggesusersgini.gb2 <- function(shape1,shape2,shape3){ G <- gb2.gini(shape1,shape2,shape3,tol=1e-08,maxiter=10000,debug=FALSE)$Gini return(G) } gini.b2 <- function(shape2,shape3){ G <- beta(2*shape2,2*shape3-1)/(beta(shape2,shape3)^2)*(2/shape2) return(G) } gini.dag <- function(shape1,shape2){ G <- ((gamma(shape2)*gamma(2*shape2+1/shape1))/(gamma(2*shape2)*gamma(shape2+1/shape1))-1) return(G) } gini.sm <- function(shape1,shape3){ G <- (1-(gamma(shape3)*gamma(2*shape3-1/shape1))/(gamma(2*shape3)*gamma(shape3-1/shape1))) return(G) } GB2/R/MLprofGB2.R0000644000176200001440000000126512524205674012655 0ustar liggesusers # Maximum likelihood based on the profile log-likelihood profml.gb2 <- function(z, w=rep(1, length(z)), method=1, hess = FALSE){ fnp <- function(x, z, w){ a <- x[1] b <- x[2] return(-proflogl.gb2(z, a, b, w)) } grp <- function(x, z, w){ a <- x[1] b <- x[2] return(-profscores.gb2(z, a, b, w)) } # Initial values of a and b under Fisk x0 <- fisk(z, w)[1:2] opt1 <- optim(x0, fnp, grp, z, w, method="BFGS", control=list(parscale=x0,pgtol=1e-16), hessian=hess) if (method != 2) return(list(opt1=opt1)) if (method == 2){ opt2 <- optim(x0, fnp, grp, z, w, method="L-BFGS-B", lower=0, control=list(parscale=x0,pgtol=0), hessian=hess) return(list(opt2=opt2)) } }GB2/R/MLfullGB2.R0000644000176200001440000000353312524205674012651 0ustar liggesusers# Maximum likelihood based on the full log-likelihood (personal level) ml.gb2 <- function (z, w=rep(1, length(z)), method = 1, hess = FALSE){ fn <- function(x, z, w) { a <- x[1] b <- x[2] p <- x[3] q <- x[4] return(-loglp.gb2(z, a, b, p, q, w)) } gr <- function(x, z, w) { a <- x[1] b <- x[2] p <- x[3] q <- x[4] return(-scoresp.gb2(z, a, b, p, q, w)) } x0 <- fisk(z, w) opt1 <- optim(x0, fn, gr, z, w, method = "BFGS", control = list(parscale = x0, pgtol = 1e-08), hessian = hess) if (method != 2) return(list(opt1 = opt1)) if (method == 2) { opt2 <- optim(x0, fn, gr, z, w, method = "L-BFGS-B", lower = 0, control = list(parscale = x0, pgtol = 1e-08), hessian = hess) return(list(opt2 = opt2)) } } # Maximum likelihood based on the full log-likelihood (household level) mlh.gb2 <- function (z, w=rep(1, length(z)), hs=rep(1, length(z)), method = 1, hess = FALSE) { fn <- function(x, z, w, hs) { a <- x[1] b <- x[2] p <- x[3] q <- x[4] return(-loglh.gb2(z, a, b, p, q, w, hs)) } gr <- function(x, z, w, hs) { a <- x[1] b <- x[2] p <- x[3] q <- x[4] return(-scoresh.gb2(z, a, b, p, q, w, hs)) } x0 <- fiskh(z, w, hs) opt1 <- optim(x0, fn, gr, z, w, hs, method = "BFGS", control = list(parscale = x0, pgtol = 1e-08), hessian = hess) if (method != 2) return(list(opt1 = opt1)) if (method == 2) { opt2 <- optim(x0, fn, gr, z, w, hs, method = "L-BFGS-B", lower = 0, control = list(parscale = x0, pgtol = 1e-08), hessian = hess) return(list(opt2 = opt2)) } }GB2/R/LogLikelihood.R0000644000176200001440000000432012524205674013703 0ustar liggesusers # Full GB2 log-likelihood (personal level) loglp.gb2 <- function(x, shape1, scale, shape2, shape3, w=rep(1, length(x))){ sw <- sum(w) logf <- logf.gb2(x,shape1,scale,shape2,shape3) logl <- sum(w*logf)/sw return(logl) } # Full GB2 log-likelihood (household level) loglh.gb2 <- function (x, shape1, scale, shape2, shape3, w=rep(1, length(x)), hs = rep(1,length(x))) { logf <- logf.gb2(x, shape1, scale, shape2, shape3) sw <- sum(w*hs) loglh <- sum(w*hs*logf)/sw return(loglh) } # Score functions for the full GB2 log-likelihood (personal level) scoresp.gb2 <- function (x, shape1, scale, shape2, shape3, w=rep(1, length(x))){ sw <- sum(w) lx <- length(x) dlogl <- rep(0,4) for (i in 1:lx) { dlogf <- dlogf.gb2(x[i], shape1, scale, shape2, shape3) dlogl <- dlogl + w[i] * dlogf } return(dlogl/sw) } # Score functions for the full GB2 log-likelihood (household level) scoresh.gb2 <- function(x, shape1, scale, shape2, shape3, w=rep(1, length(x)), hs=rep(1, length(x))){ sw <- sum(w*hs) lx <- length(x) dlogl <- rep(0,4) for (i in 1:lx) { dlogf <- dlogf.gb2(x[i], shape1, scale, shape2, shape3) dlogl <- dlogl + w[i] * hs[i]* dlogf } return(dlogl/sw) } # GB2 Fisher information matrix (I_1) info.gb2 <- function(shape1, scale, shape2, shape3){ I <- matrix(rep(NA,16),ncol=4) psipq <- digamma(shape2) - digamma(shape3) trip <- trigamma(shape2) triq <- trigamma(shape3) trippq <- trigamma(shape2+shape3) tripq <- trip + triq I[1,1] <- (1 + (shape2*shape3/(1+shape2+shape3))*(tripq+(psipq-(shape2-shape3)/(shape2*shape3))^2 - (shape2^2+shape3^2)/(shape2*shape3)^2))/shape1^2 I[1,2] <- (shape2-shape3-shape2*shape3*psipq)/(scale*(1+shape2+shape3)) I[2,1] <- I[1,2] I[2,2] <- shape1^2*shape2*shape3/(scale^2*(1+shape2+shape3)) I[2,3] <- shape1*shape3/(scale*(shape2+shape3)) I[3,2] <- I[2,3] I[2,4] <- -shape1*shape2/(scale*(shape2+shape3)) I[4,2] <- I[2,4] I[1,3] <- -(shape3*psipq-1)/(shape1*(shape2+shape3)) I[3,1] <- I[1,3] I[3,3] <- trip-trippq I[1,4] <- (shape2*psipq+1)/(shape1*(shape2+shape3)) I[4,1] <- I[1,4] I[3,4] <- -trippq I[4,3] <- -trippq I[4,4] <- triq-trippq return(I) } GB2/R/CompoundAuxDensPlot.r0000644000176200001440000000353612524205674015141 0ustar liggesusersdplot.cavgb2 <- function(group,x,shape1, scale, shape2, shape3, pl0, pl, w=rep(1,length(x)), xmax = max(x)*(2/3), ymax=2e-05, decomp="r", choicecol=1:length(levels(group)),xlab=""){ par(mfrow=c(2,1)) K <- length(levels(group)) L <- length(pl0) error <- "FALSE" for (k in 1:K){ dPk <- length(unique(pl[group==levels(group)[k]])) if (dPk>L){ error <- "TRUE" warning("the estimated probabilities are not uniquely defined for group ", levels(group)[k]) } } if (error) return() for (k in 1:K){ pk <- as.vector( unique(pl[group==levels(group)[k],])) fk <- function(x) dcgb2(x,shape1, scale, shape2, shape3,pl0,pk,decomp=decomp) sub=paste("pl0 = (",round(pl0[1],3)) pl1 <- length(pl0)-1 if (pl1 >= 2){ for (i in 2:pl1) { sub <- paste(sub,",", round(pl0[i],3)) } } sub <- paste(sub,",",round(pl0[pl1+1],3),")") # xmax <- max(x)*2/3 # change 28.04.2014 if (k==1){ curve(fk,col=choicecol[k],from=0,to=xmax,lwd=2,ylab="Density",xlab=xlab, main="Compound densities per group", ylim=c(0,ymax)) } else { curve(fk,col=choicecol[k],lwd=2,lty=k,add=TRUE) } } # print("Please, place the cursor for the legend",quote = FALSE) # change 2014-05-19 legend("topright",levels(group), lwd=2,col=choicecol,lty=1:K) # change 2014-05-19 # empirical counterparts for (k in 1:K){ rdk <- x[group==levels(group)[k]] wk <- w[group==levels(group)[k]] wk <- wk/sum(wk) densk <- density(rdk,weights=wk,kernel="epanechnikov") if (k==1){ plot(densk,col=choicecol[k],lwd=2,main="Kernel density estimate per group", xlab=xlab,xlim=c(0,xmax), ylim=c(0,ymax)) } else { lines(densk,col=choicecol[k],lwd=2,lty=k) } } par(mfrow=c(1,1)) }GB2/R/GB2.R0000644000176200001440000000170212524205674011531 0ustar liggesusers dgb2 <- function(x,shape1,scale,shape2,shape3){ y <- (x/scale)^shape1 dy_dx <- (shape1/scale)*(x/scale)^(shape1-1) z <- y/(1+y) z[z==1] <- 1-.Machine$double.eps dz_dy <- (1+y)^(-2) dens <- dbeta(z, shape2, shape3) * dz_dy * dy_dx v <- (x==Inf) dens[v] <- 0 return(dens) } pgb2 <- function(x,shape1,scale,shape2,shape3){ y <- (x/scale)^shape1 z <- y/(1+y) prob <- pbeta(z, shape2, shape3) v <- (x==Inf) prob[v] <- 1 return(prob) } qgb2 <- function (prob, shape1, scale, shape2, shape3) { pr <- sort(prob) ord <- order(prob) z1 <- qbeta( pr[pr<=0.5], shape2, shape3) z2 <- qbeta(1-pr[pr>0.5], shape3, shape2) y <- c( z1/(1 - z1), (1-z2)/z2 ) quant <- y[ord] return(scale * quant^(1/shape1)) } rgb2 <- function(n,shape1,scale,shape2,shape3){ z <- rbeta(n,shape2,shape3) y <- z/(1-z) return(scale*y^(1/shape1)) } GB2/R/CompoundVarest.R0000644000176200001440000000650412524205674014135 0ustar liggesusers # Computes the scores from the Gamma factors scoreU.cgb2 <- function (fac, pl) { L <- length(pl) denom <- fac %*% pl num <- fac[, -L] midt <- num/as.vector(denom) - 1 U <- t(pl[-L]*t(midt)) return(U) } varscore.cgb2 <- function(U,w=rep(1,dim(U)[1])) { if (dim(U)[1] != length(w) ){ warning("error in dimensions: length of w= ",length(w),"; dim(U)= ",dim(U)[1]) return() } Vsc <- t(U*w) %*% (U*w) return(Vsc) } desvar.cgb2 <- function(data=data, U=U, ids=NULL, probs=NULL, strata = NULL, variables = NULL, fpc=NULL, nest = FALSE, check.strata = !nest, weights=NULL, pps=FALSE, variance=c("HT","YG")) { datfull <- cbind(data,U) Names <- colnames(U) formul <- as.formula(paste(" ~ ", paste(Names, collapse= "+"))) dstr <- svydesign(data = datfull, ids=ids, probs=probs, strata = strata, variables = variables, fpc=fpc, nest = nest, check.strata = check.strata, weights=weights,pps=pps,variance=variance) v <-svytotal(formul, dstr, cov=TRUE) Vtheta <- vcov(v) return(list(svytotal=v,Vtheta=Vtheta)) } hess.cgb2 <- function(U,pl,w=rep(1,dim(U)[1])){ L <- length(pl) # 1 x L pl: vector of mixture probabilities dU <- dim(U) # n x (L-1) U: matrix of scores, output of scoreU.cgb2 (see eq. 15) L1 <- L-1 Lw <- length(w) if ((dU[2]!=L1)|(dU[1]!=Lw)){ warning("error in dimensions: no of parameters= ",L1,"; length of w= ",Lw,"; dim(U)= ",dU[1],",",dU[2]) return() } else{ V1 <- -t(U)%*%(U*w) sumsc <- colSums(U*w) # V2 <- V1-pl[-L]%*%t(sumsc) - sumsc%*%t(pl[-L]) + diag(sumsc) V2 <- V1-pl[-L]%*%t(sumsc) - sumsc%*%t(pl[-L]) # change 2014-04-21 V2 <- V2 + ifelse(length(sumsc)==1, sumsc, diag(sumsc)) # change 2014-04-21 colnames(V1)<- paste("v",1:L1,sep="") rownames(V1)<- paste("v",1:L1,sep="") dimnames(V2) <- dimnames(V1) eigv <- eigen(V2)[[1]] return(V2) } } vepar.cgb2 <- function(ml,Vsc, hess) { estimate <- ml[[2]]$par V <- solve(hess) Vcov <- V %*% Vsc %*% V stderr <- sqrt(diag(Vcov)) Vcor <- diag(1/stderr)%*%Vcov%*%diag(1/stderr) names(estimate) <- rownames(Vcov) dimnames(Vcor) <- dimnames(Vcov) return(list(type="parameter",estimate=estimate, stderr=stderr, Vcov=Vcov, Vcor=Vcor)) } derivind.cgb2 <- function (shape1, scale, shape2, shape3, pl0, pl, prop=0.6, decomp="r") { par <-vofp.cgb2(pl) indic <- function(par) { pl <- pofv.cgb2(par) return(main.cgb2(prop, shape1, scale, shape2, shape3,pl0,pl,decomp=decomp)) } estimate <- t(indic(par)) names(estimate) <- c("median","mean","arpr","rmpg","qsr") rownames(estimate) <- "" MFDI <- jacobian(indic, par, method = "Richardson", method.args = list()) rownames(MFDI) <- c("median","mean","arpr","rmpg","qsr") colnames(MFDI) <- paste("v",1:length(par),sep="") return(list(estimate=estimate, jacobian = MFDI)) } veind.cgb2 <- function(Vpar,shape1, scale, shape2, shape3, pl0, pl, decomp="r") { esti <- derivind.cgb2(shape1, scale, shape2, shape3, pl0, pl, decomp=decomp) MFDI <- esti[["jacobian"]] Vcov <- MFDI%*%Vpar[["Vcov"]]%*%t(MFDI) std <- sqrt(diag(Vcov)) Vcor <- diag(1/std)%*%Vcov%*%diag(1/std) rownames(Vcor) <- colnames(Vcor) <- rownames(MFDI) return(list(type="indicator",estimate=esti[["estimate"]],stderr=std,Vcov=Vcov,Vcor=Vcor)) }GB2/R/PlotsML.R0000644000176200001440000000400512524205674012510 0ustar liggesusersplotsML.gb2 <- function(z, shape1, scale, shape2, shape3, w=rep(1,length(z))){ d <- data.frame(inc=z,w=w) d <- d[!is.na(d$inc),] index <- order(d$inc) d <- d[index,] inc <- d$inc w <- d$w cdf <- (cumsum(w) - w/2)/sum(w) # Truncate at 0 d <- data.frame(inc=inc, w=w, cdf=cdf ) x <- d$inc[d$inc > 0] cdf <- d$cdf[d$inc > 0] w <- d$w[d$inc > 0] par(mfrow=c(2,1)) limi=0 kernel="epanechnikov" shift <- min(cdf[x>=limi]) # Computation of the indicators in the original scale fshift <- function(p, shift) (p-shift)/(1-shift) # Inverse transformation ifshift <- function(px, shift) {shift + px*(1-shift)} #limsup <- qgb2(0.999,shape1,scale,shape2,shape3) limsup <- max(x[cdf<= 0.999])+limi #liminf <- qgb2(0.001,shape1,scale,shape2,shape3) liminf <- 0 xlim <- c(liminf,limsup)+limi # Cumulative distribution plot plot(cdf,ifshift(pgb2(x,shape1,scale,shape2,shape3),shift), type="l", col="red", main="Cumulative Distribution plot", xlab="empirical distribution", ylab="GB2 distribution") abline(0,1,lty=2) # Density plot weights <- w/sum(w) dens <- density(x, weights=weights, kernel=kernel) # GB2 mode modeGB2 <- scale*((shape1*shape2-1)/(shape1*shape3+1))^(1/shape1) ysup <- max(dgb2(modeGB2, shape1, scale, shape2, shape3), max(dens$y)) leg.txt <- c(paste("Kernel", " ", sep=""), "GB2 density") xx1 <- qgb2(0.9, shape1, scale, shape2, shape3) xx2 <- qgb2(0.6, shape1, scale, shape2, shape3) yy <- dgb2(xx2, shape1, scale, shape2, shape3) plot(dens,main=paste("Density plot")#, sub=paste("kernel=",kernel) ,xlim=xlim,ylim=c(0,ysup)) curve(dgb2(x,shape1,scale,shape2,shape3),from=liminf,to= limsup,n=2000, col="red", add = TRUE) legend(list(x=xx1,y=yy), legend = leg.txt, col=c("black", "red"), lty=1, bty="n") } saveplot <- function(name, pathout){ local({ dev.set (2) nameplot <- paste(pathout,name,".pdf",sep="") dev.print (device=pdf, file=nameplot); }) } GB2/R/CompoundQuantiles.R0000644000176200001440000000661412524205674014640 0ustar liggesusers # Quantile function qcgb2 <- function(prob, shape1, scale,shape2,shape3,pl0,pl,decomp="r",tol=1e-08,ff=1.5,debug=FALSE,maxiter=50) { decomp1 <- decomp decomp2 <- "l" if (decomp == "l") {decomp2 = "r"} pr <- sort(prob) ord <- order(prob) quant <- rep(NA,length(prob)) ltot <- length(pr) lp0 <- length(pr[pr==0]) lp1 <- length(pr[pr==1]) lp <- lp0+lp1 # new 11.07.12 quant[pr==1] <- Inf quant[pr==0] <- 0 if (lp==length(pr)) return(quant) # new 11.07.12 L1 <- seq_len(length(pr[(0 0) { x0 <- moment.cgb2(1,shape1,1,shape2,shape3,pl0,pl,decomp1) #new 11.07.12; scale=1 p0 <- prcgb2(0,x0,shape1,1,shape2,shape3,pl0,pl,decomp1) #new 11.07.12: scale=1 pr1 <- 0 q1 <- 0 pr2 <- pr[pr>0][1] cc <- 0 while ((pr2 < p0) & (cc < maxiter)) { cc <- cc+1 x0 <- x0/ff # new 11.07.12 p0 <-prcgb2(q1,x0,shape1,1,shape2,shape3,pl0,pl,decomp1,tol,debug=FALSE) #new 11.07.12 # print(c(2,cc,x0,p0)) } for (kk in L1) { i <- 0 k <- kk + lp0 pr2 <- pr[k] while (i < maxiter) { delx <- (pr2-p0)/dcgb2(x0,shape1,1,shape2,shape3,pl0,pl,decomp1) x0 <- max(tol,x0 + delx) p0 <- pr1 + prcgb2(q1,x0,shape1,1,shape2,shape3,pl0,pl,decomp1,tol,debug=FALSE) if (isgood(delx, tol)) { if (debug) print(as.vector(c("iterations=",i,"obs=",k)),quote=F) i <- maxiter+1 } else i <- i+1 } if (i==maxiter) warning("series not converged") quant[k] <- scale*x0 #new 11.07.12 pr1 <- pr[k] q1 <- x0 } } L2 <- seq_len(length(pr[(0.50) { x0 <- moment.cgb2(1,shape1,1,shape3,shape2,pl0,pl,decomp2) #new 11.07.12; scale=1 p0 <- prcgb2(0,x0,shape1,1,shape3,shape2,pl0,pl,decomp2) #new 11.07.12: scale=1 pr1 <- 0 q1 <- 0 pr2 <- 1-pr[ltot-lp1] cc <-0 while ((pr2 < p0) & (cc < maxiter)) { cc <- cc+1 x0 <- x0/ff # new 11.07.12 p0 <-prcgb2(q1,x0,shape1,1,shape3,shape2,pl0,pl,decomp2,tol,debug=FALSE) #new 11.07.12 # print(c(4,cc,x0,p0)) } for (kk in L2) { i <- 0 k <- -kk - lp1+ltot +1 pr2 <- 1- pr[k] while (i < maxiter) { delx <- (pr2-p0)/dcgb2(x0,shape1,1,shape3,shape2,pl0,pl,decomp2) x0 <- max(tol,x0 + delx) p0 <- pr1 + prcgb2(q1,x0,shape1,1,shape3,shape2,pl0,pl,decomp2,tol,debug=FALSE) if (isgood(delx, tol)) { if (debug) print(as.vector(c("iterations=",i,"obs=",k)),quote=F) i <- maxiter+1 } else i <- i+1 } if (i==maxiter) warning("series not converged") quant[k] <- scale/x0 #new 11.07.12 pr1 <-1- pr[k] q1 <- x0 } } return(quant[order(prob)]) } # Random generation rcgb2 <- function(n,shape1,scale,shape2,shape3,pl0,pl,decomp="r",tol=1e-02,maxiter=100,debug = FALSE){ ranu <- runif(n,0,1) rand <- rep(NA,n) rand <-qcgb2(ranu,shape1,scale,shape2,shape3,pl0,pl,decomp=decomp,tol=tol,maxiter=maxiter, debug=debug) return(rand) }GB2/R/CompoundFit.R0000644000176200001440000000303112524205674013403 0ustar liggesusers# Calcualtion of the vl, l=1,...,L-1 as a function of pl, l=1, ..., L vofp.cgb2 <- function(pl){ ncomp <- length(pl) vl <- rep(0, ncomp-1) pL <- pl[ncomp] vl <- log(pl[-ncomp]/pL) return(vl) } # Calculation of the pl, l=1,...,L as a function of vl, l=1, ..., L-1 pofv.cgb2 <- function(vl){ pl <- exp(vl)/(1+sum(exp(vl))) pL <- 1/(1+sum(exp(vl))) pl <- c(pl,pL) return(pl) } # Log-likelihood function logl.cgb2 <- function(fac, pl, w=rep(1, dim(fac)[1])){ sw <- sum(w) mixt <- fac%*%pl logcomp <- log(mixt) logL <- sum(w*logcomp)/sw return(logL) } # Score functions # Weighted mean of the scores scores.cgb2 <- function(fac, pl, w=rep(1, dim(fac)[1])){ sw <- sum(w) L <-length(pl) denom <- fac%*%pl num <- fac[,-L] midt <- num/as.vector(denom) - 1 if (L>2) dlogL <- pl[-L]*colSums(midt*w) if (L==2) dlogL <- pl[-L]*sum(midt*w) return(dlogL/sw) } # Maximum pseudo-likelihood estimation, GB2 as a compound distribution ml.cgb2 <- function (fac, pl0, w = rep(1, dim(fac)[1]), maxiter = 100, fnscale=length(w)) { vl0 <- vofp.cgb2(pl0) fn <- function(vl, fac, w) { pl <- pofv.cgb2(vl) return(-logl.cgb2(fac, pl, w)) } gr <- function(vl, fac, w) { pl <- pofv.cgb2(vl) return(-scores.cgb2(fac, pl, w)) } opt <- optim(vl0, fn, gr, fac, w, method = "BFGS", control = list(maxit = maxiter, fnscale = fnscale), hessian = FALSE) vlf <- opt$par plf <- pofv.cgb2(vlf) return(list(plf, opt)) }GB2/R/NonlinearFit.R0000644000176200001440000000177412524205674013560 0ustar liggesusersnlsfit.gb2 <- function(med, ei4, par0=c(1/ei4[4],med,1,1), cva=1, bound1 = par0[1]*max(0.2,1-2*cva), bound2=par0[1]*min(2,1+2*cva),ei4w=1/ei4){ a0 <- par0[1] b0 <- par0[2] p0 <- par0[3] q0 <- par0[4] # nls fit 1 fit1 <- nls(ei4 ~ main2.gb2(0.6, a, 1, ap, aq)[3:6], weights = ei4w, start = list( a=a0, ap=a0*p0, aq=a0*q0), trace=FALSE, algorithm = "port", lower = c(bound1, 1, 2), upper = c(bound2, 100, 100), control = nls.control(maxiter = 1000, tol = 1e-06, minFactor = 1/1024, printEval = FALSE, warnOnly = TRUE)) an <- coef(fit1)[[1]] pn <- coef(fit1)[[2]]/an qn <- coef(fit1)[[3]]/an # nls fit 2 fit2 <- nls(med ~ qgb2(0.5, an, b, pn, qn), start = list(b=b0), trace=FALSE, algorithm = "port", lower = c(0.01), upper = c(2*b0), control = nls.control(maxiter = 1000, tol = 1e-06, minFactor = 1/1024, printEval = FALSE, warnOnly = TRUE)) bn <- coef(fit2)[[1]] pars <- c(an,bn,pn,qn) return(list(pars, fit1, fit2)) } GB2/R/Moments.R0000644000176200001440000000220012524205674012573 0ustar liggesusersmoment.gb2 <- function(k,shape1,scale,shape2,shape3){ pk <- shape2+ k/shape1 qk <- shape3- k/shape1 if (qk <0) {print("moment does not exist: k >= aq", quote=FALSE);return(NA)} if (pk <0) {print("moment does not exist: k <= -ap", quote=FALSE);return(NA)} logEk <- k*log(scale) + lgamma(pk) + lgamma(qk) - lgamma(shape2) - lgamma(shape3) # Ek <- (scale^k)*(gamma(pk)/gamma(shape2))*(gamma(qk)/gamma(shape3)) return(exp(logEk)) } incompl.gb2 <- function(x,k,shape1,scale,shape2,shape3) { pk <- shape2+ k/shape1 qk <- shape3- k/shape1 if (qk <0) {print("error: k >= aq", quote=FALSE);return(NA)} if (pk <0) {print("error: k <= -ap", quote=FALSE);return(NA)} return(pgb2(x,shape1,scale,pk,qk)) } el.gb2 <- function(shape1,scale,shape2,shape3) {log(scale)+(digamma(shape2)-digamma(shape3))/shape1} vl.gb2 <- function(shape1,shape2,shape3) {(trigamma(shape2)+trigamma(shape3))/shape1^2} sl.gb2 <- function(shape2,shape3) {(psigamma(shape2,deriv=2)-psigamma(shape3,deriv=2))/(vl.gb2(1,shape2,shape3))^(3/2)} kl.gb2 <- function(shape2,shape3) {(psigamma(shape2,deriv=3)+psigamma(shape3,deriv=3))/(vl.gb2(1,shape2,shape3))^2}GB2/R/RobustWeights.R0000644000176200001440000000062112524205674013767 0ustar liggesusersrobwts <- function(x, w=rep(1, length(x)), c=0.01, alpha=0.001) { fiskpar <- fisk(x,w) a <- fiskpar[1] b <- fiskpar[2] num <- abs(((1-alpha)/alpha)^(1/a)-(alpha/(1-alpha))^(1/a)) corr <- pmax(c,pmin(1,num/abs(b/x-1),num/abs(x/b-1))) # a list containing the correction and the adjusted weights return(list(corr, corr*w)) } # prob <- 0.001 ; c <- 0.1 GB2/R/Contprof.R0000644000176200001440000000142412524205674012752 0ustar liggesusers# Contour plot of the profile log-likelihood contprof.gb2 <- function(z, w=rep(1,length(z)), resol, low=0.1, high=20){ # Initial values of a and b under Fisk x0 <- fisk(z, w)[1:2] aa <- seq(low, high, length.out = resol)*x0[1] bb <- seq(low, high, length.out = resol)*x0[2] d <- aa %o% bb for (i in 1:resol){ for (j in 1:resol){ d[i,j] <- proflogl.gb2(z, aa[i], bb[j], w) } } dlim = range(d, finite = TRUE) image(aa, bb, d, xlab = "a", ylab = "b", col = heat.colors(16), breaks = seq(dlim[1], dlim[2], length.out=17), main = "Profile log-likelihood") contour(aa, bb, d, levels = seq(dlim[1], dlim[2], length.out=17), add = TRUE) # The initial Fisk estimate is added as point "F". text(x0[1], x0[2], "F") box() }GB2/R/CompoundDensPlot.r0000644000176200001440000000342212524205674014455 0ustar liggesusersdplot.cgb2 <- function(x, shape1, scale, shape2, shape3, pl0, pl, w=rep(1,length(x)) ,decomp="r", xmax = max(x)*(2/3), choicecol=1:3, kernel="epanechnikov", adjust=1, title=NULL, ylim=NULL){ para <- paste(" a=",round(shape1,2),", b=",round(scale),", p=",round(shape2,2),", q=",round(shape3,2)) sub0=paste("pl0 = (",round(pl0[1],3)) sub=paste("pl = (",round(pl[1],3)) pl1 <- length(pl0)-1 if (pl1 >= 2){ for (i in 2:pl1) { sub0 <- paste(sub0,",", round(pl0[i],3)) sub <- paste(sub,",", round(pl[i],3)) } } sub0 <- paste(sub0,",",round(pl0[pl1+1],3),")") sub <- paste(sub,",",round(pl[pl1+1],3),")") fcgb2 <- function(x) dcgb2(x, shape1, scale, shape2, shape3, pl0, pl, decomp=decomp) fgb2 <- function(x) dgb2(x, shape1, scale, shape2, shape3) # maxx <- max(x)*2/3 # change 28.04.2014: put as argument if (is.null(ylim)) curve(fcgb2, col=choicecol[2], lwd=2, lty=1, from=0, to=xmax, ylab="Density") else curve(fcgb2, col=choicecol[2], lwd=2, lty=1, from=0, to=xmax, ylab="Density", ylim=ylim) curve(fgb2,col=choicecol[1], lwd=2, lty=2, add=TRUE) if (is.null(title)) title <- "Comparison of densities" title(title, sub = paste(para,"; ",sub0,";",sub), cex.sub = 0.75, font.sub = 3) ## empirical counterparts wk <- w/sum(w) densk <- density(x, weights=wk, kernel= kernel, from=0, adjust=adjust) lines(densk, col=choicecol[3], lwd=2, lty=3) # print("Please, place the cursor for the legend",quote = FALSE) legend("topright",c("GB2 ","compound GB2 ","Kernel estimate"), lwd=2,col=choicecol[c(1,2,3)], lty=c(2,1,3)) }GB2/R/CompoundIndicators.R0000644000176200001440000000316412524205674014767 0ustar liggesusers# At-risk-of-poverty threshold arpt.cgb2 <- function(prop, shape1, scale, shape2, shape3, pl0, pl, decomp="r"){ median <- qcgb2(0.5, shape1, scale, shape2, shape3, pl0, pl, decomp) # scaled median return(prop*median) } # At-risk-of-poverty rate arpr.cgb2 <- function(prop, shape1, shape2, shape3, pl0, pl, decomp="r"){ return(pcgb2(arpt.cgb2(prop, shape1, 1, shape2, shape3, pl0, pl, decomp),shape1, 1, shape2, shape3, pl0, pl, decomp)) } # Relative median poverty gap rmpg.cgb2 <- function(arpr, shape1, shape2, shape3, pl0, pl, decomp="r"){ return(1-qcgb2(arpr/2, shape1, 1, shape2, shape3, pl0, pl, decomp)/qcgb2(arpr, shape1, 1, shape2, shape3, pl0, pl, decomp)) } # Quintile share ratio qsr.cgb2 <- function(shape1, shape2, shape3, pl0, pl, decomp="r") { q20 <- qcgb2(0.2, shape1, 1, shape2, shape3, pl0, pl, decomp) q80 <- qcgb2(0.8, shape1, 1, shape2, shape3, pl0, pl, decomp) return((1-incompl.cgb2(q80, 1, shape1, 1, shape2, shape3, pl0, pl, decomp))/incompl.cgb2(q20, 1, shape1, 1, shape2, shape3, pl0, pl, decomp)) } # The four indicators and the median main.cgb2 <- function(prop, shape1, scale, shape2, shape3,pl0,pl,decomp="r"){ arpr <-arpr.cgb2(prop, shape1,shape2, shape3, pl0, pl,decomp=decomp) main <- c(qcgb2(0.5, shape1, scale, shape2, shape3,pl0, pl,decomp=decomp), moment.cgb2(1,shape1, scale, shape2, shape3, pl0, pl,decomp=decomp), arpr , rmpg.cgb2(arpr,shape1,shape2, shape3, pl0, pl,decomp=decomp), qsr.cgb2(shape1,shape2, shape3, pl0, pl,decomp=decomp)) names(main) <- c("median","mean","arpr","rmpg","qsr") return(main) }GB2/R/Compound.R0000644000176200001440000001043412524205674012745 0ustar liggesusers# Gamma factors, which multiplied my the GB2 density give the component densities fg.cgb2 <- function(x, shape1, scale, shape2, shape3, pl0, decomp="r"){ # pl0 is a vector of probabilities which sums to 1 # for ex. pl0 = c(1/3,1/3,1/3) if (decomp=="r") {sh <- shape3 a0 <- shape1} if (decomp=="l") {sh <- shape2 a0 <- -shape1} t <- (x/scale)^a0+1 ncomp <- length(pl0) fac <- matrix(rep(0, times=length(x)*ncomp), ncol=ncomp) u <- qgamma(cumsum(pl0),sh) u1 <-c(0,u[-ncomp]) # dim = ncomp pq <- shape2+shape3 fac[,1] <-pgamma(t*u[1],pq)/pgamma(u[1],sh) for(i in 2:ncomp){ fac[,i] <-(pgamma(t*u[i],pq) - pgamma(t*u1[i],pq))/(pgamma(u[i],sh) - pgamma(u1[i],sh)) } dimnames(fac)[[2]] <- paste("fac",1:dim(fac)[2],sep="") return(fac) } dl.cgb2 <- function(x, shape1, scale, shape2, shape3, pl0, decomp="r"){ # pl0 is a vector of probabilities which sums to 1 # for ex. pl0 = c(1/3,1/3,1/3) L <- length(pl0) fac <- fg.cgb2(x, shape1, scale, shape2, shape3, pl0, decomp) dcl <- fac for (i in 1:L){ dcl[,i] <- dgb2(x,shape1,scale,shape2,shape3)*fac[,i] } colnames(dcl) <- paste("comp",1:L,sep="") return(dcl) #returns a matrix with the l-th component density in the l-th column } # Distribution function library(cubature) pl.cgb2 <- function(y, shape1, scale, shape2, shape3, pl0, decomp="r", tol=1e-05){ ncomp <- length(pl0) Fl <- matrix(rep(1, times=length(y)*ncomp), ncol=ncomp) dimnames(Fl)[[2]] <- paste("comp",1:dim(Fl)[2],sep="") v <- (y, Desislava Nedyalkova . Maintainer: Desislava Nedyalkova Depends: R (>= 3.1.0) Imports: cubature, hypergeo, laeken, numDeriv, stats, survey Suggests: simFrame Description: Package GB2 explores the Generalized Beta distribution of the second kind. Density, cumulative distribution function, quantiles and moments of the distributions are given. Functions for the full log-likelihood, the profile log-likelihood and the scores are provided. Formulas for various indicators of inequality and poverty under the GB2 are implemented. The GB2 is fitted by the methods of maximum pseudo-likelihood estimation using the full and profile log-likelihood, and non-linear least squares estimation of the model parameters. Various plots for the visualization and analysis of the results are provided. Variance estimation of the parameters is provided for the method of maximum pseudo-likelihood estimation. A mixture distribution based on the compounding property of the GB2 is presented (denoted as "compound" in the documentation). This mixture distribution is based on the discretization of the distribution of the underlying random scale parameter. The discretization can be left or right tail. Density, cumulative distribution function, moments and quantiles for the mixture distribution are provided. The compound mixture distribution is fitted using the method of maximum pseudo-likelihood estimation. The fit can also incorporate the use of auxiliary information. In this new version of the package, the mixture case is complemented with new functions for variance estimation by linearization and comparative density plots. License: GPL (>= 2) Packaged: 2015-05-11 20:06:21 UTC; Desi NeedsCompilation: no Repository: CRAN Date/Publication: 2015-05-11 23:48:49 GB2/man/0000755000176200001440000000000012524205675011407 5ustar liggesusersGB2/man/CompoundVarest.Rd0000644000176200001440000001472712524205674014661 0ustar liggesusers\name{CompoundVarest} \Rdversion{2.1} \alias{CompoundVarest} \alias{scoreU.cgb2} \alias{varscore.cgb2} \alias{desvar.cgb2} \alias{hess.cgb2} \alias{vepar.cgb2} \alias{derivind.cgb2} \alias{veind.cgb2} \title{ Variance Estimation of the Compound GB2 Distribution } \description{ Calculation of variance estimates of the parameters of the compound GB2 distribution and of the estimated compound GB2 indicators under cluster sampling. } \usage{ scoreU.cgb2(fac, pl) varscore.cgb2(U, w=rep(1,dim(U)[1])) desvar.cgb2(data=data, U=U, ids=NULL, probs=NULL, strata = NULL, variables = NULL, fpc=NULL, nest = FALSE, check.strata = !nest, weights=NULL, pps=FALSE, variance=c("HT","YG")) hess.cgb2(U, pl, w=rep(1,dim(U)[1])) vepar.cgb2(ml, Vsc, hess) derivind.cgb2(shape1, scale, shape2, shape3, pl0, pl, prop=0.6, decomp="r") veind.cgb2(Vpar, shape1, scale, shape2, shape3, pl0, pl, decomp="r") } \arguments{ \item{fac}{numeric; matrix of Gamma factors (output of \code{fac.cgb2}.} \item{pl}{numeric; a vector of fitted mixture probabilities. Sums to one. If \code{pl} is equal to \code{pl0}, we obtain the GB2 distribution.} \item{U}{numeric; vector of scores. Output of the \code{scoreU.cgb2} function.} \item{w}{numeric; vector of some extrapolation weights. By default \code{w} is a vector of 1.} \item{data}{dataset containing the design information per unit.} \item{ids, probs, strata, variables, fpc, nest, check.strata, weights, pps, variance}{parameters of \code{\link[survey]{svydesign}}.} \item{ml}{numeric; output of the \code{ml.cgb2} function. A list with two components. First component: estimated mixture probabilities. Second component: list containing the output of \code{optim}.} \item{Vsc}{numeric; 4 by 4 matrix.} \item{hess}{numeric; Hessian (bread) for the sandwich variance estimate.} \item{shape1, scale ,shape2, shape3}{numeric; positive parameters of the GB2 distribution.} \item{pl0}{numeric; a vector of initial proportions defining the number of components and the weight of each component density in the decomposition. Sums to one.} \item{prop}{numeric; proportion (in general is set to 0.6).} \item{decomp}{string; specifying if the decomposition of the GB2 is done with respect to the right tail ("r") or the left tail ("l") of the distribution.} \item{Vpar}{numeric; 4 by 4 matrix. Output of the function \code{vepar.cgb2}.} } \details{ Function \code{scoreU.cgb2} calculates the \eqn{N \times (L-1)} matrix of scores \code{U} is defined as \deqn{U(k,\ell)=p_{\ell} \left( \frac{F(k,\ell)}{\sum_{j=1}^L p_{j}\, F(k,j)} - 1\right),} where \eqn{p_\ell, \ell=1,..,L} is the vector of fitted mixture probabilities and \eqn{F} is the \eqn{N \times L} matrix of gamma factors, output of \code{fg.cgb2}. The linearized scores are the columns of \code{U}. They serve to compute the linearization approximation of the covariance matrix of the parameters \eqn{v_\ell=\log(p_\ell/p_L), \ell=1,...,L-1}. Function \code{varscore.cgb2} calculates the middle term of the sandwich variance estimator, that is the \eqn{((L-1) \times (L-1))} estimated variance-covariance matrix of the \eqn{(L-1)} weighted sums of the columns of \code{U}, without design information. \code{desvar.cgb2} calculates the design-based variance-covariance matrix of the \eqn{(L-1)} weighted sums of the columns of \code{U}, invoking \code{svydesign} and \code{svytotal} of package \code{\link{survey}}. \code{hess.cgb2} calculates the Hessian (\eqn{(L-1) \times (L-1))} matrix of second derivatives of the pseudo-log-likelihood with respect to the parameters \eqn{v_\ell}). It should be negative definite. If not, the maximum likelihood estimates are spurious. \code{vepar.cgb2} calculates the sandwich covariance matrix estimate of the vector of parameters \code{v}. \code{veind.cgb2} calculates estimates, standard error, covariance and correlation matrices of the indicators under the compound GB2. } \value{ \code{scoreU.cgb2} returns a \eqn{N \times (L-1)} matrix of scores 0] w <- d$w[d$inc > 0] # Fit using the profile log-likelihood fitp <- profml.gb2(inc, w)$opt1 # Fitted GB2 parameters ap <- fitp$par[1] bp <- fitp$par[2] pp <- prof.gb2(inc, ap, bp, w)[3] qp <- prof.gb2(inc, ap, bp, w)[4] # Profile log-likelihood proflik <- fitp$value # If we want to compare the indicators \dontrun{ # GB2 indicators indicp <- round(main.gb2(0.6,ap,bp,pp,qp), digits=3) # Empirical indicators indice <- round(main.emp(inc,w), digits=3) } # Plots \dontrun{plotsML.gb2(inc,ap,bp,pp,qp,w)} } \keyword{distribution} GB2/man/Indicators.Rd0000644000176200001440000000767612524205674014014 0ustar liggesusers\name{Indicators} \Rdversion{2.1} \alias{Indicators} \alias{arpt.gb2} \alias{arpr.gb2} \alias{rmpg.gb2} \alias{qsr.gb2} \alias{main.gb2} \alias{main2.gb2} \title{Monetary Laeken Indicators under the GB2 } \description{ Functions to calculate four primary social welfare indicators under the GB2, i.e. the at-risk-of-poverty threshold, the at-risk-of-poverty rate, the relative median at-risk-of-poverty gap, and the income quintile share ratio. } \usage{ arpt.gb2(prop, shape1, scale, shape2, shape3) arpr.gb2(prop, shape1, shape2, shape3) rmpg.gb2(arpr, shape1, shape2, shape3) qsr.gb2(shape1, shape2, shape3) main.gb2(prop, shape1, scale, shape2, shape3) main2.gb2(prop, shape1, scale, shape12, shape13) } \arguments{ \item{prop}{numeric; proportion (in general is set to 0.6).} \item{arpr}{numeric; the value of the at-risk-of-poverty rate.} \item{shape1}{numeric; positive parameter.} \item{scale}{numeric; positive parameter.} \item{shape2, shape3}{numeric; positive parameters of the Beta distribution.} \item{shape12}{numeric; the product of the two parameters \code{shape1} and \code{shape2}.} \item{shape13}{numeric; the product of the two parameters \code{shape1} and \code{shape3}.} } \details{ In June 2006, the Social Protection Committee, which is a group of officials of the European Commisiion, adopts a set of common indicators for the social protection and social inclusion process. It consists of a portfolio of 14 overarching indicators (+11 context indicators) meant to reflect the overarching objectives (a) "social cohesion" and (b) "interaction with the Lisbon strategy for growth and jobs (launched in 2000) objectives"; and of three strand portfolios for social inclusion, pensions, and health and long-term care. The at-risk-of-poverty threshold (or ARPT) is defined as 60\% of the median national equivalized income. The at-risk-of-poverty rate (or ARPR) is defined as the share of persons with an equivalised disposable income below the ARPT. The relative median at-risk-of-poverty gap (or RMPG) is defined as the difference between the median equivalised income of persons below the ARPT and the ARPT itself, expressed as a percentage of the ARPT. The income quintile share ratio (or QSR) is defined as the ratio of total income received by the 20\% of the country's population with the highest income (top quintile) to that received by the 20\% of the country's population with the lowest income (lowest quintile). Let \eqn{x_{0.5}}{x_0.5} be the median of a GB2 with parameters \code{shape1} \eqn{= a}, \code{scale} \eqn{= b}, \code{shape2} \eqn{= p} and \code{shape3} \eqn{= q}. Then, \deqn{ARPT(a,b,p,q)=0.6 x_{0.5}}{ARPT(a,b,p,q)=0.6 x_0.5.} The ARPR being scale-free, \eqn{b} can be chosen arbitrarily and can be fixed to 1. The QSR is calculated with the help of the incomplete moments of order 1. \code{main.gb2} and \code{main2.gb2} return a vector containing the following set of GB2 indicators: the median, the mean, the ARPR, the RMPG, the QSR and the Gini coefficient. The only difference is in the input parameters. } \value{ \code{arpt.gb2} gives the ARPT, \code{arpr.gb2} the ARPR, \code{rmpg.gb2} the RMPG, and \code{qsr.gb2} calculates the QSR. \code{main.gb2} returns a vector containing the median of the distribution, the mean of the distribution, the ARPR, the RMPG, the QSR and the Gini coefficient. \code{main2.gb2} produces the same output as \code{main.gb2}. } \references{ \url{http://ec.europa.eu/employment_social/spsi/docs/social_inclusion/2008/indicators_update2008_en.pdf} } \author{ Monique Graf } \seealso{ \code{\link{qgb2}}, \code{\link{incompl.gb2}} } \examples{ a <- 3.9 b <- 18873 p <- 0.97 q <- 1.03 ap <- a*p aq <- a*q arpt <- arpt.gb2(0.6, a, b, p, q) arpr <- arpr.gb2(0.6, a, p, q) rmpg <- rmpg.gb2(arpr, a, p, q) qsr <- qsr.gb2(a, p, q) ind1 <- main.gb2(0.6, a, b, p, q) ind2 <- main2.gb2(0.6, a, b, ap, aq) } \keyword{distribution} GB2/man/Moments.Rd0000644000176200001440000000512012524205674013315 0ustar liggesusers\name{Moments} \Rdversion{2.1} \alias{Moments} \alias{moment.gb2} \alias{incompl.gb2} \alias{el.gb2} \alias{vl.gb2} \alias{sl.gb2} \alias{kl.gb2} \title{ Moments and Other Properties of a GB2 Random Variable } \description{ These functions calculate the moments of order \code{k} and incomplete moments of order \code{k} of a GB2 random variable \eqn{X} as well as the expectation, the variance, the kurtosis and the skewness of \eqn{log(X)}. } \usage{ moment.gb2(k, shape1, scale, shape2, shape3) incompl.gb2(x, k, shape1, scale, shape2, shape3) el.gb2(shape1, scale, shape2, shape3) vl.gb2(shape1, shape2, shape3) sl.gb2(shape2, shape3) kl.gb2(shape2, shape3) } \arguments{ \item{x}{numeric; vector of quantiles.} \item{k}{numeric; order of the moment.} \item{shape1}{numeric; positive parameter.} \item{scale}{numeric; positive parameter.} \item{shape2, shape3}{numeric; positive parameters of the Beta distribution.} } \details{ Let \eqn{X} be a random variable following a GB2 distribution with parameters \code{shape1} \eqn{= a}, \code{scale} \eqn{= b}, \code{shape2} \eqn{= p} and \code{shape3} \eqn{= q}. Moments and incomplete moments of \eqn{X} exist only for \eqn{-ap \le k \le aq}{-ap <= k <= aq}. Moments are given by \deqn{E(X^k) = {b}^{k} \frac{\Gamma (p+k/a) \Gamma (q-k/a)}{\Gamma (p) \Gamma (q)}}{E(X^k) = b^k Gamma(p+k/a) Gamma(q-k/a) / Gamma(p) Gamma(q).} This expression, when considered a function of \code{k}, can be viewed as the moment-generating function of \eqn{Y=log(X)}. Thus, it is useful to compute the moments of \eqn{log(X)}, which are needed for deriving, for instance, the Fisher information matrix of the GB2 distribution. Moments of \eqn{log(X)} exist for all \code{k}. } \value{ \code{moment.gb2} gives the moment of order \code{k}, \code{incompl.gb2} gives the incomplete moment of order \code{k}, \code{El.gb2} gives the expectation of \eqn{log(X)}, \code{vl.gb2} gives the variance of \eqn{log(X)}, \code{sl.gb2} gives the skewness of \eqn{log(X)}, \code{kl.gb2} gives the kurtosis of \eqn{log(X)}. } \references{ Kleiber, C. and Kotz, S. (2003) \emph{Statistical Size Distributions in Economics and Actuarial Sciences}, chapter 6. Wiley, Ney York. } \author{ Monique Graf } \seealso{ \code{\link{gamma}} for the Gamma function and related functions (\code{digamma}, \code{trigamma} and \code{psigamma}). } \examples{ a <- 3.9 b <- 18873 p <- 0.97 q <- 1.03 k <- 2 x <- qgb2(0.6, a, b, p, q) moment.gb2(k, a, b, p, q) incompl.gb2(x, k, a, b, p, q) vl.gb2(a, p, q) kl.gb2(p, q) } \keyword{distribution} GB2/man/Contprof.Rd0000644000176200001440000000261412524205674013472 0ustar liggesusers\name{Contprof} \Rdversion{2.1} \alias{Contprof} \alias{contprof.gb2} \title{ Contour Plot of the Profile Log-likelihood of the GB2 Distribution } \description{ Produces a contour plot of the profile log-likelihood, which is a function of two parameters only. } \usage{ contprof.gb2(z, w=rep(1,length(z)), resol, low=0.1, high=20) } \arguments{ \item{z}{numeric; vector of data values.} \item{w}{numeric; vector of weights. Must have the same length as \code{z}. By default \code{w} is a vector of 1.} \item{resol}{numeric; number of grid points horizontally and vertically. For better graph quality, we recommend a value of 100.} \item{low, high}{numeric; lower and upper factors for scale.} } \details{ The matrix containing the values to be plotted (NAs are allowed) is of size \code{resol} \eqn{\times} \code{resol}. The locations of the grid lines at which the values of the profile log-likelihood are measured are equally-spaced values between \code{low} and \code{high} multiplied by the initial parameters. } \value{ A contour plot of the profile log-likelihood. The initial Fisk estimate is added as point "F". } \seealso{ \code{\link{fisk}} for the Fisk estimate, \code{\link{ProfLogLikelihood}} for the profile log-likelihood and \code{\link{contour}} (package \code{graphics}) for more details on contour plots. } \author{ Monique Graf } \keyword{distribution} GB2/man/CompoundIndicators.Rd0000644000176200001440000000565712524205674015516 0ustar liggesusers\name{CompoundIndicators} \Rdversion{2.1} \alias{CompoundIndicators} \alias{arpt.cgb2} \alias{arpr.cgb2} \alias{rmpg.cgb2} \alias{qsr.cgb2} \alias{main.cgb2} \title{Indicators of Poverty and Social Exclusion under the Compound Distribution based on the GB2 } \description{ Functions to calculate four primary social welfare indicators under the compound GB2 distribution, i.e. the at-risk-of-poverty threshold, the at-risk-of-poverty rate, the relative median at-risk-of-poverty gap, and the income quintile share ratio. } \usage{ arpt.cgb2(prop, shape1, scale, shape2, shape3, pl0, pl, decomp="r") arpr.cgb2(prop, shape1, shape2, shape3, pl0, pl, decomp="r") rmpg.cgb2(arpr, shape1, shape2, shape3, pl0, pl, decomp="r") qsr.cgb2(shape1, shape2, shape3, pl0, pl, decomp="r") main.cgb2(prop, shape1, scale, shape2, shape3, pl0, pl, decomp="r") } \arguments{ \item{prop}{numeric; proportion (in general is set to 0.6).} \item{arpr}{numeric; the value of the at-risk-of-poverty rate.} \item{shape1,scale,shape2,shape3}{numeric; positive parameters of the GB2 distribution.} \item{pl0}{numeric; a vector of initial proportions defining the number of components and the weight of each component density in the decomposition. Sums to one.} \item{pl}{numeric; a vector of mixture probabilities. Sums to one. If \eqn{pl=pl0} we obtain the GB2 distribution.} \item{decomp}{string; specifying if the decomposition of the GB2 is done with respect to the right tail ("r") or the left tail ("l") of the distribution. By default, \code{decomp} = "r" - right tail decomposition.} } \details{ The four indicators are described in details in the case of the GB2. The difference here is that we need to give an initial vector of proportions, fitted proportions and define for which decomposition (left or right) the indicators should be calculated. } \value{ \code{arpt.cgb2} gives the ARPT, \code{arpr.cgb2} the ARPR, \code{rmpg.cgb2} the RMPG, \code{qsr.cgb2} gives the QSR and \code{main.cgb2} calculates the median, the mean, the ARPR, the RMPG and the QSR under the compound GB2. } \author{ Monique Graf } \references{ Graf, M., Nedyalkova, D., Muennich, R., Seger, J. and Zins, S. (2011) AMELI Deliverable 2.1: Parametric Estimation of Income Distributions and Indicators of Poverty and Social Exclusion. \emph{Technical report}, AMELI-Project. } \seealso{ \code{arpr.gb2} for details on the welfare indicators under the GB2. } \examples{ # GB2 parameters a <- 3.9 b <- 18873 p <- 0.97 q <- 1.03 # Proportions defining the component densities p0 <- rep(1/3,3) # Mixture probabilities pl <- c(0.39,0.26,0.35) # for the right discretization arpt <- arpt.cgb2(0.6, a, b, p, q, p0, pl) arpr <- arpr.cgb2(0.6, a, p, q, p0, pl) rmpg <- rmpg.cgb2(arpr, a, p, q, p0, pl) qsr <- qsr.cgb2(a, p, q, p0, pl) # for the left discretization arptleft <- arpt.cgb2(0.6, a, b, p, q, p0, pl, "l") } \keyword{distribution} GB2/man/MLfullGB2.Rd0000644000176200001440000000643112524205674013367 0ustar liggesusers\name{MLfullGB2} \Rdversion{2.1} \alias{MLfullGB2} \alias{ml.gb2} \alias{mlh.gb2} \title{ Maximum Likelihood Estimation of the GB2 Based on the Full Log-likelihood } \description{ Performs maximum pseudo-likelihood estimation through the general-purpose optimisation function \code{optim} from package \code{stats}. Two methods of optimization are considered: BFGS and L-BFGS-B (see \code{optim} documentation for more details). Initial values of the parameters to be optimized over (\eqn{a}, \eqn{b}, \eqn{p} and \eqn{q}) are given from the Fisk distribution and \eqn{p=q=1}. The function to be maximized by \code{optim} is the negative of the full log-likelihood and the gradient is equal to the negative of the scores, respectively for the case of a sample of persons and a sample of households. } \usage{ ml.gb2(z, w=rep(1, length(z)), method=1, hess=FALSE) mlh.gb2(z, w=rep(1, length(z)), hs=rep(1, length(z)), method=1, hess = FALSE) } \arguments{ \item{z}{numeric; vector of data values.} \item{w}{numeric; vector of weights. Must have the same length as \code{z}. By default \code{w} is a vector of 1.} \item{hs}{numeric; vector of household sizes. Must have the same length as \code{z}. By default \code{hs} is a vector of 1.} \item{method}{numeric; the method to be used by \code{optim}. By default, code{method = }1 and the used method is BFGS. If \code{method = }2, method L-BFGS-B is used.} \item{hess}{logical; By default, \code{hess = FALSE}, the hessian matrix is not calculated.} } \details{ Function \code{ml.gb2} performs maximum likelihood estimation through the general-purpose optimization function \code{optim} from package \code{stats}, based on the full log-likelihood calculated in a sample of persons. Function \code{mlh.gb2} performs maximum likelihood estimation through the general-purpose optimization function \code{optim} from package \code{stats}, based on the full log-likelihood calculated in a sample of households. } \value{ \code{ml.gb2} and \code{mlh.gb2} return a list with 1 argument: \code{opt1} for the output of the BFGS fit or \code{opt2} for the output of the L-BFGS fit. Further values are given by the values of \code{optim}. } \references{ Graf, M., Nedyalkova, D., Muennich, R., Seger, J. and Zins, S. (2011) AMELI Deliverable 2.1: Parametric Estimation of Income Distributions and Indicators of Poverty and Social Exclusion. \emph{Technical report}, AMELI-Project. } \seealso{\code{\link{optim}} for the general-purpose optimization and \code{\link{fisk}} for the Fisk distribution. } \author{ Monique Graf } \examples{ \dontrun{ library(laeken) data(eusilc) # Income inc <- as.vector(eusilc$eqIncome) # Weights w <- eusilc$rb050 # Data set d <- data.frame(inc, w) d <- d[!is.na(d$inc),] # Truncate at 0 inc <- d$inc[d$inc > 0] w <- d$w[d$inc > 0] # Fit using the full log-likelihood fitf <- ml.gb2(inc, w) # Fitted GB2 parameters af <- fitf$par[1] bf <- fitf$par[2] pf <- fitf$par[3] qf <- fitf$par[4] # Likelihood flik <- fitf$value # If we want to compare the indicators # GB2 indicators indicf <- round(main.gb2(0.6,af,bf,pf,qf), digits=3) # Empirical indicators indice <- round(main.emp(inc,w), digits=3) # Plots plotsML.gb2(inc,af,bf,pf,qf,w) } } \keyword{distribution} GB2/man/CompoundDensPlot.Rd0000644000176200001440000000431412524205674015134 0ustar liggesusers\name{CompoundDensPlot} \Rdversion{2.1} \alias{CompoundDensPlot} \alias{dplot.cgb2} \title{ Comparison of the GB2, compound GB2 and kernel densities } \description{ Function \code{dplot.cgb2} produces a plot in which the three densities are plotted. } \usage{ dplot.cgb2(x,shape1, scale, shape2, shape3, pl0, pl, w=rep(1,length(x)), decomp="r", xmax = max(x)*(2/3), choicecol=1:3, kernel="epanechnikov", adjust=1, title=NULL, ylim=NULL) } \arguments{ \item{x}{numeric; can be a vector. The value(s) at which the density is calculated, used for the kernel estimate only. \code{x} is positive. } \item{shape1, scale ,shape2, shape3}{numeric; positive parameters of the GB2 distribution. On the plot they are denotes as \code{a}, code{b}, \code{p}, \code{q} and \code{pl0} respectively.} \item{pl0}{numeric; a vector of initial proportions defining the number of components and the weight of each component density in the decomposition. Sums to one.} \item{pl}{numeric; a vector of mixture probabilities (output of \code{\link{ml.cgb2}}). Sums to one. If \code{pl} is equal to \code{pl0}, we obtain the GB2 distribution.} \item{w}{numeric; weights.} \item{decomp}{string; specifying if the decomposition of the GB2 is done with respect to the right tail ("r") or the left tail ("l") of the distribution. By default, \code{decomp} = "r" - right tail decomposition.} \item{xmax}{numeric; maximum \code{x} value to be plotted.} \item{choicecol}{numeric vector of length 3; defines the color with which the density curves will be plotted.} \item{adjust}{numeric; graphical parameter of the generic function \code{\link{density}}.} \item{title}{string; title of the plot. By default is equall to NULL (no title).} \item{ylim}{string; scaling of parameters. By default is equall to NULL (automatic scaling).} \item{kernel}{string; the kernel used for the kernel density estimate. The default value is "Epanechnikov" (see \code{\link{plot.density}}).} } \details{ The legend is placed interactively. } \value{\code{dplot.cgb2} plots a graph with three curves - the GB2 density, the compound GB2 density and the corresponding kernel estimate } \author{ Monique Graf and Desislava Nedyalkova } GB2/man/PlotsML.Rd0000644000176200001440000000233712524205674013234 0ustar liggesusers\name{PlotsML} \Rdversion{2.1} \alias{PlotsML} \alias{plotsML.gb2} \alias{saveplot} \title{ Cumulative Distribution Plot and Kernel Density Plot for the Fitted GB2 } \description{ Function \code{plotsML.gb2} produces two plots. The first is a plot of the empirical cumulative distribution function versus the fitted cumulative distibution function. The second is a plot of the kernel density versus the fitted GB2 density. Function \code{saveplot} saves locally the produced plot. } \usage{ plotsML.gb2(z, shape1, scale, shape2, shape3, w=rep(1,length(z))) saveplot(name, pathout) } \arguments{ \item{z}{numeric; vector of data values.} \item{w}{numeric; vector of weights. Must have the same length as \code{z}. By default \code{w} is a vector of 1.} \item{shape1}{numeric; positive parameter.} \item{scale}{numeric; positive parameter.} \item{shape2, shape3}{numeric; positive parameters of the Beta distribution.} \item{name}{string; the name of the plot.} \item{pathout}{string; the path of the folder or device where the plot will be saved.} } \details{ The used kernel is "Epanechnikov" (see \code{\link{plot}}). } \author{ Monique Graf and Desislava Nedyalkova } \keyword{distribution} GB2/man/LogLikelihood.Rd0000644000176200001440000000463612524205674014433 0ustar liggesusers\name{LogLikelihood} \Rdversion{2.1} \alias{LogLikelihood} \alias{loglp.gb2} \alias{loglh.gb2} \alias{scoresp.gb2} \alias{scoresh.gb2} \alias{info.gb2} \title{ Full Log-likelihood of the GB2 Distribution } \description{ Calculates the log-likelihood, the score functions of the log-likelihood and the Fisher information matrix based on all four parameters of the GB2 distribution. } \usage{ loglp.gb2(x, shape1, scale, shape2, shape3, w=rep(1, length(x))) loglh.gb2(x, shape1, scale, shape2, shape3, w=rep(1, length(x)), hs=rep(1, length(x))) scoresp.gb2(x, shape1, scale, shape2, shape3, w=rep(1, length(x))) scoresh.gb2(x, shape1, scale, shape2, shape3, w=rep(1, length(x)), hs=rep(1, length(x))) info.gb2(shape1, scale, shape2, shape3) } \arguments{ \item{x}{numeric; vector of data values.} \item{shape1}{numeric; positive parameter.} \item{scale}{numeric; positive parameter.} \item{shape2, shape3}{numeric; positive parameters of the Beta distribution.} \item{w}{numeric; vector of weights. Must have the same length as \code{x}. By default \code{w} is a vector of 1.} \item{hs}{numeric; vector of household sizes. Must have the same length as \code{x}. By default \code{hs} is a vector of 1.} } \details{ We express the log-likelihood as a weighted mean of \eqn{log(f)}, evaluated at the data points, where \eqn{f} is the GB2 density with parameters \code{shape1} \eqn{= a}, \code{scale} \eqn{= b}, \code{shape2} \eqn{= p} and \code{shape3} \eqn{= q}. If the weights are not available, then we suppose that \code{w} \eqn{= 1}. \code{loglp.gb2} calculates the log-likelihood in the case where the data is a sample of persons and \code{loglh.gb2} is adapted for a sample of households. Idem for the scores, which are obtained as weighted sums of the first derivatives of \eqn{log(f)} with respect to the GB2 parameters, evaluated at the data points. The Fisher information matrix of the GB2 was obtained by Brazauskas (2002) and is expressed in terms of the second derivatives of the log-likelihood with respect to the GB2 parameters. } \references{ Brazauskas, V. (2002) Fisher information matrix for the Feller-Pareto distribution. \emph{Statistics & Probability Letters}, \bold{59}, 159--167. Kleiber, C. and Kotz, S. (2003) \emph{Statistical Size Distributions in Economics and Actuarial Sciences}, chapter 6. Wiley, Ney York. } \author{ Monique Graf } \keyword{distribution} GB2/man/MLfitGB2.Rd0000644000176200001440000000444512524205674013212 0ustar liggesusers\name{MLfitGB2} \Rdversion{2.1} \alias{MLfitGB2} \alias{main.emp} \alias{mlfit.gb2} \title{ Fitting the GB2 by the Method of Maximum Likelihood Estimation and Comparison of the Fitted Indicators with the Empirical Indicators } \description{ The function \code{mlfit.gb2} makes a call to \code{ml.gb2} and \code{profml.gb2}. Estimates of the GB2 parameters are calculated using maximum likelihood estimation based on the full and profile log-likelihoods. Empirical estimates of the set of primary indicators of poverty and social inclusion are calculated using the function \code{main.emp} (see package \code{laeken}) and these estimates are compared with the indicators calculated with the GB2 fitted parameters using the function \code{\link{main.gb2}}. } \usage{ main.emp(z, w=rep(1, length(z))) mlfit.gb2(z, w=rep(1, length(z))) } \arguments{ \item{z}{numeric; vector of data values.} \item{w}{numeric; vector of weights. Must have the same length as \code{z}. By default \code{w} is a vector of 1.}} \value{ A list containing three different objects. The first is a data frame with the values of the fitted parameters for the full log-likelihood and the profile log-likelihood, the values of the two likelihoods, the values of the GB2 estimates of the indicators and the values of the empirical estimates of the indicators. The second and third objects are, respectively, the fit using the full log-likelihood and the fit using the profile log-likelihood. } \seealso{ \code{\link[stats]{optim}} , \code{\link{ml.gb2}}, \code{\link{profml.gb2}} } \author{ Monique Graf and Desislava Nedyalkova } \examples{ # An example of using the function mlfit.gb2 # See also the examples of ml.gb2 and mlprof.gb2 \dontrun{ library(laeken) data(eusilc) # Income inc <- as.vector(eusilc$eqIncome) # Weights w <- eusilc$rb050 # Data set d <- data.frame(inc, w) d <- d[!is.na(d$inc),] # Truncate at 0 inc <- d$inc[d$inc > 0] w <- d$w[d$inc > 0] # ML fit m1 <- mlfit.gb2(inc,w) # GB2 fitted parameters and indicators through maximum likelihood estimation m1[[1]] # The fit using the full log-likelihood m1[[2]] # The fit using the profile log-likelihood m1[[3]] # ML fit, when no weights are avalable m2 <- mlfit.gb2(inc) # Results m2[[1]] } } \keyword{distribution} GB2/man/Thomae.Rd0000644000176200001440000000512012524205674013110 0ustar liggesusers\name{Thomae} \Rdversion{2.1} \alias{ULg} \alias{combiopt} \alias{Thomae} \alias{gb2.gini} \title{Maximum Excess Representation of a Generalized Hypergeometric Function Using Thomae's Theorem} \description{ Defines Thomae's arguments from the upper (\code{U}) and lower (\code{L}) parameters of a \eqn{_{3}F_{2}(U,L;1)}. Computes the optimal combination leading to the maximum excess. Computes the optimal combination of Thomae's arguments and calculates the optimal representation of the \eqn{_{3}F_{2}(U,L;1)} using the \code{genhypergeo_series} function from package \code{hypergeo}. Computes the Gini coefficient for the GB2 distribution, using Thomae's theorem. } \usage{ ULg(U, L) combiopt(g) Thomae(U, L, lB, tol, maxiter, debug) gb2.gini(shape1, shape2, shape3, tol=1e-08, maxiter=10000, debug=FALSE) } \arguments{ \item{U}{numeric; vector of length 3 giving the upper arguments of the generalized hypergeometric function \eqn{_{3}F_{2}}.} \item{L}{numeric; vector of length 2 giving the lower arguments of the generalized hypergeometric function \eqn{_{3}F_{2}}.} \item{g}{numeric; vector of Thomae's permuting arguments.} \item{lB}{numeric; ratio of beta functions (a common factor in the expression of the Gini coefficient under the GB2).} \item{shape1}{numeric; positive parameter.} \item{shape2, shape3}{numeric; positive parameters of the Beta distribution.} \item{tol}{numeric; tolerance with default 0, meaning to iterate until additional terms do not change the partial sum.} \item{maxiter}{numeric; maximum number of iterations to perform.} \item{debug}{boolean; if \code{TRUE}, returns the list of changes to the partial sum.} } \details{ Internal use only. More details can be found in Graf (2009). } \value{ \code{ULg} returns a list containing Thomae's arguments and the excess, \code{combiopt} gives the optimal combination of Thomae's arguments, \code{Thomae} returns the optimal representation of the \eqn{_{3}F_{2}(U,L;1)}, \code{gb2.gini} returns the value of the Gini coefficient under the GB2. } \references{ Graf, M. (2009) An Efficient Algorithm for the Computation of the Gini coefficient of the Generalized Beta Distribution of the Second Kind. \emph{ASA Proceedings of the Joint Statistical Meetings}, 4835--4843. American Statistical Association (Alexandria, VA). McDonald, J. B. (1984) Some generalized functions for the size distribution of income. \emph{Econometrica}, \bold{52}, 647--663. } \author{Monique Graf} \seealso{ \code{\link[hypergeo]{genhypergeo_series}}, \code{\link{gini.gb2}} } \keyword{distribution} GB2/man/CompoundFit.Rd0000644000176200001440000000730012524205674014124 0ustar liggesusers\name{CompoundFit} \Rdversion{2.1} \alias{CompoundFit} \alias{vofp.cgb2} \alias{pofv.cgb2} \alias{logl.cgb2} \alias{scores.cgb2} \alias{ml.cgb2} \title{ Fitting the Compound Distribution based on the GB2 by the Method of Maximum Likelihood Estimation } \description{ Calculates the log-likelihood, the score functions of the log-likelihood, the weighted mean of scores, and fits the parameters of the Compound Distribution based on the GB2. } \usage{ vofp.cgb2(pl) pofv.cgb2(vl) logl.cgb2(fac, pl, w=rep(1, dim(fac)[1])) scores.cgb2(fac, pl, w=rep(1, dim(fac)[1])) ml.cgb2(fac, pl0, w=rep(1, dim(fac)[1]), maxiter=100, fnscale=length(w)) } \arguments{ \item{pl0}{numeric; vector of initial proportions defining the number of components and the weight of each component density in the decomposition. Sums to one.} \item{pl}{numeric; vector of fitted proportions. Sums to one. If \code{pl} is equal to \code{pl0}, we obtain the GB2 distribution.} \item{fac}{numeric; matrix of Gamma factors (output of \code{fac.cgb2}.} \item{vl}{numeric; vector of parameters. Its length is equal to the length of \code{pl} - 1.} \item{w}{numeric; vector of weights of length the number of rows of the matrix \code{fac}. By default \code{w} is a vector of 1.} \item{maxiter}{numeric; maximum number of iterations to perform. By default \code{maxiter} = 100.} \item{fnscale}{numeric; an overall scaling parameter used in the function \code{\link[stats]{optim}}. By default it is equal to the length of the vector of weights \code{w}.} } \details{ There are only \eqn{L-1} parameters to estimate, because the probabilities \eqn{p_\ell} sum to 1 (L is the dimension of the vector of probailities \eqn{p_\ell}). Knowing this, we change the parameters \eqn{p_\ell} to \eqn{v_\ell=log(p_\ell/p_L), \ \ell= 1, ..., L-1}. This calculation is done through the function \code{vofp.cgb2}. \code{pofv.cgb2} calculates the \eqn{p_\ell} in function of the given \eqn{v_\ell}. We express the log-likelihood as a weighted mean of \eqn{log(f) = log(\sum(p_\ell f_\ell)}, evaluated at the data points, where \eqn{f} is the GB2 compound density. If the weights are not available, then we suppose that \code{w} \eqn{= 1}. Analogically, the scores are obtained as weighted sums of the first derivatives of the log-likelihood, with respect to the parameters \eqn{v_\ell, \ \ell=1, ..., L-1}, evaluated at the data points. Function \code{ml.cgb2} performs maximum likelihood estimation through the general-purpose optimization function \code{optim} from package \code{stats}. The considered method of optimization is BFGS. } \value{ \code{vofp.cgb2} returns a vector of length \eqn{L-1}, where \eqn{L} is the length of the vector \eqn{p_\ell}. \code{pofv.cgb2} returns a vector of length \eqn{\ell}. \code{logl.cgb2} returns the value of the pseudo log-likelihood. \code{scores.cgb2} returns a vector of the weighted mean of the scores of length \eqn{L-1}. \code{ml.cgb2} returns a list containing two objects - the vector of fitted proportions \eqn{\hat{p_\ell}} and the output of the BFGS fit. } \seealso{ \code{\link[stats]{optim}} } \author{ Monique Graf and Desislava Nedyalkova } \examples{ \dontrun{ # GB2 parameters: a <- 4 b <- 1950 p <- 0.8 q <- 0.6 # Proportions defining the component densities: pl0 <- rep(1/3,3) # Mixture probabilities pl <- c(0.1,0.8,0.1) # Random generation: n <- 10000 set.seed(12345) x <- rcgb2(n,a,b,p,q,pl0,pl,decomp="l") # Factors in component densities fac <- fg.cgb2(x,a,b,p,q, pl0,decomp="l") # Estimate the mixture probabilities: estim <- ml.cgb2(fac,pl0) # estimated mixture probabilities: estim[[1]] #[1] 0.09724319 0.78415797 0.11859883 } } \keyword{distribution} GB2/man/Contindic.Rd0000644000176200001440000000353412524205674013614 0ustar liggesusers\name{Contindic} \Rdversion{2.1} \alias{Contindic} \alias{contindic.gb2} \title{ Sensitivity Analysis of Laeken Indicators on GB2 Parameters } \usage{ contindic.gb2(resol, shape1, shape21, shape22, shape31, shape32, fn, title, table=FALSE) } \arguments{ \item{resol}{numeric; number of grid points horizontally and vertically.} \item{shape1}{numeric; positive parameter, first shape parameter of the GB2 distribution.} \item{shape21, shape22, shape31, shape32}{numeric; limits on the positive parameters of the Beta distribution.} \item{fn}{string; the name of the function to be used for the calculation of the values to be plotted.} \item{title}{string; title of the plot.} \item{table}{boolean; if \code{TRUE}, a table containing the values of the function \code{fn} at the different grid points is printed.} } \description{Produces a contour plot of an indicator for a given \code{shape1}. } \details{An indicator is defined as a function of three parameters. The shape parameter, \code{shape1}, is held fixed. The shape parameters \code{shape2} and \code{shape3} vary between \code{shape21} and \code{shape22}, and \code{shape31} and \code{shape32}, respectively. } \value{ A contour plot of a given indicator for a fixed value of the shape parameter \code{shape1}. } \seealso{\code{\link{contour}} (package \code{graphics}) for more details on contour plots. } \author{ Monique Graf } \examples{ par(mfrow=c(2,2)) shape21 <- 0.3 shape31 <- 0.36 shape22 <- 1.5 shape32 <- 1.5 shape11 <- 2.7 shape12 <- 9.2 resol <- 11 rangea <- round(seq(shape11, shape12 ,length.out=4),digits=1) arpr <- function(shape1, shape2, shape3) 100*arpr.gb2(0.6, shape1, shape2, shape3) fonc <- "arpr" for (shape1 in rangea){ contindic.gb2(resol, shape1, shape21, shape22, shape31, shape32, arpr, "At-risk-of-poverty rate", table=TRUE) } } GB2/man/gb2.Rd0000644000176200001440000000436012524205674012352 0ustar liggesusers\name{gb2} \Rdversion{2.1} \alias{gb2} \alias{dgb2} \alias{pgb2} \alias{qgb2} \alias{rgb2} \title{The Generalized Beta Distribution of the Second Kind} \description{Density, distribution function, quantile function and random generation for the Generalized beta distribution of the second kind with parameters \code{a}, \code{b}, \code{p} and \code{q}. } \usage{ dgb2(x, shape1, scale, shape2, shape3) pgb2(x, shape1, scale, shape2, shape3) qgb2(prob, shape1, scale, shape2, shape3) rgb2(n, shape1, scale, shape2, shape3) } \arguments{ \item{x}{numeric; vector of quantiles.} \item{shape1}{numeric; positive parameter.} \item{scale}{numeric; positive parameter.} \item{shape2, shape3}{numeric; positive parameters of the Beta distribution.} \item{prob}{numeric; vector of probabilities.} \item{n}{numeric; number of observations. If \code{length(n) > 1}, the length is taken to be the number required.} } \details{ The Generalized Beta distribution of the second kind with parameters \code{shape1} \eqn{= a}, \code{scale} \eqn{= b}, \code{shape2} \eqn{= p} and \code{shape3} \eqn{= q} has density \deqn{f(x)=\frac{a(x/b)^{ap-1}}{bB(p,q)(1+(x/b)^{a})^{p+q}}}{a(x/b)^(ap-1)/bB(p,q)(1+(x/b)^(a))^(p+q), x \ge 0} for \eqn{a > 0}, \eqn{b > 0}, \eqn{p > 0} and \eqn{q > 0}, where \eqn{B(p,q)} is the Beta function (\code{\link{beta}}). If \code{Z} follows a Beta distribution with parameters \eqn{p} and \eqn{q} and \deqn{y = \frac{z}{1-z},} then \deqn{x = b * y^{1/a}} follows the GB2 distribution. } \value{ \code{dgb2} gives the density, \code{pgb2} the distribution function, \code{qgb2} the quantile function, and \code{rgb2} generates random deviates. } \references{ Kleiber, C. and Kotz, S. (2003) \emph{Statistical Size Distributions in Economics and Actuarial Sciences}, chapter 6. Wiley, Ney York. McDonald, J. B. (1984) Some generalized functions for the size distribution of income. \emph{Econometrica}, \bold{52}, 647--663. } \author{Monique Graf} \seealso{ \code{\link{beta}} for the Beta function and \code{\link{dbeta}} for the Beta distribution. } \examples{ a <- 3.9 b <- 18873 p <- 0.97 q <- 1.03 x <- qgb2(0.6, a, b, p, q) y <- dgb2(x, a, b, p, q) } \keyword{distribution} GB2/man/Varest.Rd0000644000176200001440000002150312524205674013142 0ustar liggesusers\name{Varest} \Rdversion{2.1} \alias{Varest} \alias{varscore.gb2} \alias{vepar.gb2} \alias{derivind.gb2} \alias{veind.gb2} \title{ Variance Estimation of the Parameters of the GB2 Distribution } \description{ Calculation of variance estimates of the estimated GB2 parameters and the estimated GB2 indicators under cluster sampling. } \usage{ varscore.gb2(x, shape1, scale, shape2, shape3, w=rep(1,length(x)), hs=rep(1,length(x))) vepar.gb2(x, Vsc, shape1, scale, shape2, shape3, w=rep(1,length(x)), hs=rep(1,length(x))) derivind.gb2(shape1, scale, shape2, shape3) veind.gb2(Vpar, shape1, scale, shape2, shape3) } \arguments{ \item{x}{numeric; vector of data values.} \item{Vsc}{numeric; 4 by 4 matrix.} \item{shape1}{numeric; positive parameter.} \item{scale}{numeric; positive parameter.} \item{shape2, shape3}{numeric; positive parameters of the Beta distribution.} \item{w}{numeric; vector of weights. Must have the same length as \code{x}. By default \code{w} is a vector of 1.} \item{hs}{numeric; vector of household sizes. Must have the same length as \code{x}. By default \code{w} is a vector of 1.} \item{Vpar}{numeric; 4 by 4 matrix.} } \details{ Knowing the first and second derivatives of \eqn{log(f)}, and using the sandwich variance estimator (see Freedman (2006)), the calculation of the variance estimates of the GB2 parameters is straightforward. \code{Vsc} is a square matrix of size the number of parameters, e.g. the estimated design variance-covariance matrix of the estimated parameters. We know that the GB2 estimates of the Laeken indicators are functions of the GB2 parameters. In this case, the variance estimates of the fitted indicators are obtained using the delta method. The function \code{veind.gb2} uses \code{Vpar}, the sandwich variance estimator of the vector of parameters, in order to obtain the sandwich variance estimator of the indicators. More details can be found in Graf and Nedyalkova (2011). } \value{ \code{varscore.gb2} calculates the middle term of the sandwich variance estimator under simple random cluster sampling. \code{vepar.gb2} returns a list of two elements: the estimated variance-covariance matrix of the estimated GB2 parameters and the second-order partial derivative of the pseudo log-likelihood function. The function \code{veind.gb2} returns the estimated variance-covariance matrix of the estimated GB2 indicators. \code{derivind.gb2} calculates the numerical derivatives of the GB2 indicators and is for internal use only. } \references{ Davison, A. (2003), \emph{Statistical Models}. Cambridge University Press. Freedman, D. A. (2006), On The So-Called "Huber Sandwich Estimator" and "Robust Standard Errors". \emph{The American Statistician}, \bold{60}, 299--302. Graf, M., Nedyalkova, D., Muennich, R., Seger, J. and Zins, S. (2011) AMELI Deliverable 2.1: Parametric Estimation of Income Distributions and Indicators of Poverty and Social Exclusion. \emph{Technical report}, AMELI-Project. Pfeffermann, D. and Sverchkov, M. Yu. (2003), Fitting Generalized Linear Models under Informative Sampling. In, Skinner, C.J. and Chambers, R.L. (eds.). \emph{Analysis of Survey Data}, chapter 12, 175--195. Wiley, New York. } \author{ Monique Graf and Desislava Nedyalkova } \examples{ # An example of variance estimation of the GB2 parameters, # using the dataset "eusilcP" from the R package simFrame. # Takes long time to run \dontrun{ library(survey) library(simFrame) data(eusilcP) # Draw a sample from eusilcP # 1-stage simple random cluster sampling of size 6000 (cluster = household) # directly, #s <- draw(eusilcP[, c("hid", "hsize", "eqIncome")], grouping = "hid", size = 6000) # or setting up 250 samples, and drawing the first one. # This sample setup can be used for running a simulation. set.seed(12345) scs <- setup(eusilcP, grouping = "hid", size = 6000, k = 250) s <- draw(eusilcP[, c("region", "hid", "hsize", "eqIncome")], scs, i=1) # The number of observations (persons) in eusilcP (58654 persons) \dontrun{N <- dim(eusilcP)[1]} # The number of households in eusilcP (25000 households) Nh <- length(unique(eusilcP$hid)) # Survey design corresponding to the drawn sample sdo = svydesign(id=~hid, fpc=rep(Nh,nrow(s)), data=s) \dontrun{summary(sdo)} # Truncated sample (truncate at 0) s <- s[!is.na(s$eqIncome),] str <- s[s$eqIncome > 0, ] eqInc <- str$eqIncome w <- str$.weight # Designs for the truncated sample sdotr <- subset(sdo, eqIncome >0) sddtr = svydesign(id=~hid, strata=~region, fpc=NULL, weights=~.weight, data=str) \dontrun{summary(sdotr)} \dontrun{summary(sddtr)} # Fit by maximum likelihood fit <- ml.gb2(eqInc,w)$opt1 af <- fit$par[1] bf <- fit$par[2] pf <- fit$par[3] qf <- fit$par[4] mlik <- -fit$value # Estimated parameters and indicators, empirical indicators gb2.par <- round(c(af, bf, pf, qf), digits=3) emp.ind <- main.emp(eqInc, w) gb2.ind <- main.gb2(0.6, af, bf, pf, qf) # Scores scores <- matrix(nrow=length(eqInc), ncol=4) for (i in 1:length(eqInc)){ scores[i,] <- dlogf.gb2(eqInc[i], af, bf, pf, qf) } # Data on households only sh <- unique(str) heqInc <- sh$eqIncome hw <- sh$.weight hhs <- sh$hsize hs <- as.numeric(as.vector(hhs)) # Variance of the scores VSC <- varscore.gb2(heqInc, af, bf, pf, qf, hw, hs) # Variance of the scores using the explicit designs, and package survey DV1 <- vcov(svytotal(~scores[,1]+scores[,2]+scores[,3]+scores[,4], design=sdotr)) DV2 <- vcov(svytotal(~scores[,1]+scores[,2]+scores[,3]+scores[,4], design=sddtr)) # Estimated variance-covariance matrix of the parameters af, bf, pf and qf VCMP <- vepar.gb2(heqInc, VSC, af, bf, pf, qf, hw, hs)[[1]] DVCMP1 <- vepar.gb2(heqInc, DV1, af, bf, pf, qf, hw, hs)[[1]] DVCMP2 <- vepar.gb2(heqInc, DV2, af, bf, pf, qf, hw, hs)[[1]] \dontrun{diag(DVCMP1)/diag(VCMP)} \dontrun{diag(DVCMP2)/diag(VCMP)} \dontrun{diag(DV1)/diag(VSC)} \dontrun{diag(DV2)/diag(VSC)} # Standard errors of af, bf, pf and qf se.par <- sqrt(diag(VCMP)) sed1.par <- sqrt(diag(DVCMP1)) sed2.par <- sqrt(diag(DVCMP2)) # Estimated variance-covariance matrix of the indicators (VCMI) VCMI <- veind.gb2(VCMP, af, bf, pf, qf) DVCMI1 <- veind.gb2(DVCMP1, af, bf, pf, qf) DVCMI2 <- veind.gb2(DVCMP2, af, bf, pf, qf) # Standard errors and confidence intervals varest.ind <- diag(VCMI) se.ind <- sqrt(varest.ind) lci.ind <- gb2.ind - 1.96*se.ind uci.ind <- gb2.ind + 1.96*se.ind inCI <- as.numeric(lci.ind <= emp.ind & emp.ind <= uci.ind) # under the sampling design sdotr varestd1.ind <- diag(DVCMI1) sed1.ind <- sqrt(varestd1.ind) lcid1.ind <- gb2.ind - 1.96*sed1.ind ucid1.ind <- gb2.ind + 1.96*sed1.ind inCId1 <- as.numeric(lcid1.ind <= emp.ind & emp.ind <= ucid1.ind) #under the sampling design sddtr varestd2.ind <- diag(DVCMI2) sed2.ind <- sqrt(varestd2.ind) lcid2.ind <- gb2.ind - 1.96*sed2.ind ucid2.ind <- gb2.ind + 1.96*sed2.ind inCId2 <- as.numeric(lcid2.ind <= emp.ind & emp.ind <= ucid2.ind) #coefficients of variation .par (parameters), .ind (indicators) cv.par <- se.par/gb2.par names(cv.par) <- c("am","bm","pm","qm") cvd1.par <- sed1.par/gb2.par names(cvd1.par) <- c("am","bm","pm","qm") cvd2.par <- sed2.par/gb2.par names(cvd2.par) <- c("am","bm","pm","qm") cv.ind <- se.ind/gb2.ind cvd1.ind <- sed1.ind/gb2.ind cvd2.ind <- sed2.ind/gb2.ind #results res <- data.frame(am = af, bm = bf, pm = pf, qm = qf, lik = mlik, median = gb2.ind[[1]], mean = gb2.ind[[2]], ARPR = gb2.ind[[3]], RMPG = gb2.ind[[4]], QSR = gb2.ind[[5]], Gini = gb2.ind[[6]], emedian = emp.ind[[1]], emean = emp.ind[[2]], eARPR = emp.ind[[3]], eRMPG = emp.ind[[4]], eQSR = emp.ind[[5]], eGini = emp.ind[[6]], cva = cv.par[1], cvb = cv.par[2], cvp= cv.par[3], cvq = cv.par[4], cvd1a = cvd1.par[1], cvd1b = cvd1.par[2], cvd1p= cvd1.par[3], cvd1q = cvd1.par[4], cvd2a = cvd2.par[1], cvd2b = cvd2.par[2], cvd2p= cvd2.par[3], cvd2q = cvd2.par[4], cvmed = cv.ind[[1]], cvmean = cv.ind[[2]], cvARPR = cv.ind[[3]], cvRMPG = cv.ind[[4]], cvQSR = cv.ind[[5]], cvGini = cv.ind[[6]], cvd1med = cvd1.ind[[1]], cvd1mean = cvd1.ind[[2]], cvd1ARPR = cvd1.ind[[3]], cvd1RMPG = cvd1.ind[[4]], cvd1QSR = cvd1.ind[[5]], cvd1Gini = cvd1.ind[[6]], cvd2med = cvd2.ind[[1]], cvd2mean = cvd2.ind[[2]], cvd2ARPR = cvd2.ind[[3]], cvd2RMPG = cvd2.ind[[4]], cvd2QSR = cvd2.ind[[5]], cvd2Gini = cvd2.ind[[6]]) res <- list(parameters = data.frame(am = af, bm = bf, pm = pf, qm = qf, lik = mlik), cv.parameters.naive = cv.par, cv.parameters.design1 = cvd1.par, cv.parameters.design2 = cvd2.par, GB2.indicators = gb2.ind, emp.indicators = emp.ind, cv.indicators.naive = cv.ind, cv.indicators.design1 = cvd1.ind, cv.indicators.design2 = cvd2.ind) res \dontrun{inCI} } } \keyword{distribution} GB2/man/CompoundAuxFit.Rd0000644000176200001440000001563612524205674014615 0ustar liggesusers\name{CompoundAuxFit} \Rdversion{2.1} \alias{CompoundAuxFit} \alias{pkl.cavgb2} \alias{lambda0.cavgb2} \alias{logl.cavgb2} \alias{scores.cavgb2} \alias{ml.cavgb2} \title{ Fitting the Compound Distribution based on the GB2 by the Method of Pseudo Maximum Likelihood Estimation using Auxiliary Information } \description{ Calculates the log-likelihood, the score functions of the log-likelihood and fits the compound distribution based on the GB2 and using auxiliary information. } \usage{ pkl.cavgb2(z, lambda) lambda0.cavgb2(pl0, z, w=rep(1, dim(z)[1])) logl.cavgb2(fac, z, lambda, w=rep(1, dim(fac)[1])) scores.cavgb2(fac, z, lambda, w=rep(1, dim(fac)[1])) ml.cavgb2(fac, z, lambda0, w = rep(1, dim(fac)[1]), maxiter = 100, fnscale=length(w)) } \arguments{ \item{z}{numeric; a matrix of auxiliary variables.} \item{lambda}{numeric; a matrix of parameters.} \item{pl0}{numeric; a vector of initial proportions defining the number of components and the weight of each component density in the decomposition. Sums to one.} \item{w}{numeric; vector of weights of length the number of rows of the matrix \code{fac}. By default \code{w} is a vector of 1.} \item{fac}{numeric; a matrix of Gamma factors.} \item{lambda0}{numeric; a matrix of initial parameters.} \item{maxiter}{numeric; maximum number of iterations to perform. By default \code{maxiter} = 100.} \item{fnscale}{numeric; parameter of the \code{\link{optim}} function. By default \code{fnscale} is equal to the lenth of the vector of weights (value of \code{fnscale} in the preceding version of the package). Permits to solve some convergence problems (see \code{\link{optim}}).} } \details{ We model the probabilities \eqn{p_\ell} with auxiliary variables. Let \eqn{z_k} denote the vector of auxiliary information for unit \eqn{k}. This auxiliary information modifies the probabilities \eqn{p_\ell} at the unit level. Denote by \eqn{p_{k,\ell}} the weight of the density \eqn{f_\ell} for unit \eqn{k}. For \eqn{\ell=1,...,L-1}, we pose a linear model for the log-ratio \eqn{v_{k,\ell}}: \deqn{\log(p_{k,\ell}/p_{k,L}) = v_{k,\ell} =\sum_{i=1}^I \lambda_{\ell i} z_{k i}= \mathbf{z}_k^{T} \boldsymbol{\lambda_{\ell}}.} Function \code{pkl.cavgb2} calculates the \eqn{p_{k,\ell}}. Function \code{lambda0.cavgb2} calculates the initial values \eqn{\lambda_{\ell i}}, \eqn{i= 1, ..., I}, \eqn{\ell = 1, ..., L-1} . Let \deqn{\bar{z}_{i}=\sum_k w_k z_{ki}/\sum_k w_k} be the mean value of the \eqn{i}-th explanatory variable. Writing \deqn{\log(\hat{p}^{(0)}_\ell / \hat{p}^{(0)}_L)=v^{(0)}_\ell = \sum_{i=1}^I \lambda^{(0)}_{\ell i} \bar{z}_{i},} we can choose \eqn{\lambda^{(0)}_{\ell i}= v^{(0)}_\ell / (I \bar{z}_{i}).} Analogically to the ordinary fit of the compound distribution based on the GB2 \code{\link{CompoundFit}}, we express the log-likelihood as a weighted mean of \eqn{log(f) = log(\sum(p_{k,\ell} f_\ell(x_k))}, evaluated at the data points, where \eqn{f} is the GB2 compound density. The scores are obtained as the weighted sums of the first derivatives of the log-likelihood, with respect to the parameters \eqn{\lambda_\ell, \ \ell=1, ..., L-1}, evaluated at the data points. Function \code{ml.cavgb2} performs maximum likelihood estimation through the general-purpose optimization function \code{optim} from package \code{stats}. The considered method of optimization is "BFGS" (\code{\link{optim}}). Once we have the fitted parameters \eqn{\hat{\lambda}} we can deduce the fitted parameters \eqn{\hat{v{k\ell}}} and \eqn{\hat{p_{k\ell}}} in function of \eqn{\bar{z}} and \eqn{\hat{\lambda}_{\ell}}. } \value{ \code{pkl.cavgb2} returns a matrix of probabilities. \code{lambda0.cavgb2} returns a matrix of size \eqn{I \times L-1}. \code{logl.cavgb2} returns the value of the pseudo log-likelihood. \code{scores.cavgb2} returns the weighted sum of the scores of the log-likelihood. \code{ml.cavgb2} returns a list containing two objects - the vector of fitted coefficients \eqn{\hat{\lambda_\ell}} and the output of the "BFGS" fit. } \seealso{ \code{\link[stats]{optim}} } \author{ Monique Graf and Desislava Nedyalkova } \examples{ \dontrun{ library(simFrame) data(eusilcP) # Stratified cluster sampling set.seed(12345) srss <- SampleControl(design = "region", grouping = "hid", size = c(200*3, 1095*3, 1390*3, 425*3, 820*3, 990*3, 400*3, 450*3, 230*3), k = 1) # Draw a sample s1 <- draw(eusilcP,srss) #names(s1) # Creation of auxiliary variables ind <- order(s1[["hid"]]) ss1 <- data.frame(hid=s1[["hid"]], region=s1[["region"]], hsize=s1[["hsize"]], peqInc=s1[["eqIncome"]], age=s1[["age"]], pw=s1[[".weight"]])[ind,] ss1[["child"]] <- as.numeric((ss1[["age"]]<=14)) ss1[["adult"]] <- as.numeric((ss1[["age"]]>=20)) sa <- aggregate(ss1[,c("child","adult")],list(ss1[["hid"]]),sum) names(sa)[1] <- "hid" sa[["children"]] <- as.numeric((sa[["child"]]>0)) sa[["single_a"]] <- as.numeric((sa[["adult"]]==1)) sa[["sa.ch"]] <- sa[["single_a"]]*sa[["children"]] sa[["ma.ch"]] <- (1-sa[["single_a"]])*sa[["children"]] sa[["nochild"]] <- 1-sa[["children"]] # New data set ns <- merge(ss1[,c("hid","region","hsize","peqInc","pw")], sa[,c("hid","nochild","sa.ch","ma.ch")], by="hid") # Ordering the data set ns <- ns[!is.na(ns$peqInc),] index <- order(ns$peqInc) ns <- ns[index,] # Truncate at 0 ns <- ns[ns$peqInc>0,] # income peqInc <- ns$peqInc # weights pw <- ns$pw # Adding the weight adjustment c1 <- 0.1 pwa <- robwts(peqInc,pw,c1,0.001)[[1]] corr <- mean(pw)/mean(pwa) pwa <- pwa*corr ns <- data.frame(ns, aw=pwa) # Empirical indicators with original weights emp.ind <- c(main.emp(peqInc, pw), main.emp(peqInc[ns[["nochild"]]==1], pw[ns[["nochild"]]==1]), main.emp(peqInc[ns[["sa.ch"]]==1], pw[ns[["sa.ch"]]==1]), main.emp(peqInc[ns[["ma.ch"]]==1], pw[ns[["ma.ch"]]==1])) # Matrix of auxiliary variables z <- ns[,c("nochild","sa.ch","ma.ch")] #unique(z) z <- as.matrix(z) # global GB2 fit, ML profile log-likelihood gl.fit <- profml.gb2(peqInc,pwa)$opt1 agl.fit <- gl.fit$par[1] bgl.fit <- gl.fit$par[2] pgl.fit <- prof.gb2(peqInc,agl.fit,bgl.fit,pwa)[3] qgl.fit <- prof.gb2(peqInc,agl.fit,bgl.fit,pwa)[4] # Likelihood and convergence proflikgl <- -gl.fit$value convgl <- gl.fit$convergence # Fitted GB2 parameters and indicators profgb2.par <- c(agl.fit, bgl.fit, pgl.fit, qgl.fit) profgb2.ind <- main.gb2(0.6, agl.fit, bgl.fit, pgl.fit, qgl.fit) # Initial lambda and pl pl0 <- c(0.2,0.6,0.2) lambda0 <- lambda0.cavgb2(pl0, z, pwa) # left decomposition decomp <- "l" facgl <- fg.cgb2(peqInc, agl.fit, bgl.fit, pgl.fit, qgl.fit, pl0 ,decomp) fitcml <- ml.cavgb2(facgl, z, lambda0, pwa, maxiter=500) fitcml convcl <- fitcml[[2]]$convergence convcl lambdafitl <- fitcml[[1]] pglfitl <- pkl.cavgb2(diag(rep(1,3),lambdafitl) row.names(pglfitl) <- colnames(z) } } \keyword{distribution} GB2/man/NonlinearFit.Rd0000644000176200001440000001112012524205674014260 0ustar liggesusers\name{NonlinearFit} \Rdversion{2.1} \alias{NonlinearFit} \alias{nlsfit.gb2} \title{ Fitting the GB2 by Minimizing the Distance Between a Set of Empirical Indicators and Their GB2 Expressions } \description{ Fitting the parameters of the GB2 distribution by optimizing the squared weighted distance between a set of empirical indicators, i.e. the median, the ARPR, the RMPG, the QSR and the Gini coefficient, and the GB2 indicators using nonlinear least squares (function \code{nls} from package \code{stats}). } \usage{ nlsfit.gb2(med, ei4, par0=c(1/ei4[4],med,1,1), cva=1, bound1=par0[1]*max(0.2,1-2*cva), bound2=par0[1]*min(2,1+2*cva), ei4w=1/ei4) } \arguments{ \item{med}{numeric; the empirical median.} \item{ei4}{numeric; the values of the empirical indicators.} \item{par0}{numeric; vector of initial values for the GB2 parameters \eqn{a, b, p} and \eqn{q}. The default is to take \eqn{a} equal to the inverse of the empirical Gini coefficient, \eqn{b} equal to the empirical median and \eqn{p = q = 1}.} \item{cva}{numeric; the coefficient of variation of the ML estimate of the parameter \eqn{a}. The default value is 1.} \item{bound1, bound2}{numeric; the lower and upper bounds for the parameter \eqn{a} in the algorithm. The default values are \eqn{0.2*a_{0}} and \eqn{2*a_{0}}, where \eqn{a_{0}} is the initial value of the parameter \eqn{a}.} \item{ei4w}{numeric; vector of weights of to be passed to the \code{nls} function. The default values are the inverse of the empirical indicators.} } \details{ We consider the following set of indicators \eqn{A = (median, ARPR, RMPG, QSR, Gini)} and their corresponding GB2 expressions \eqn{A_{GB2}}. We fit the parameters of the GB2 in two consecutive steps. In the first step, we use the set of indicators, excluding the median, and their corresponding expressions in function of \eqn{a}, \eqn{ap} and \eqn{aq}. The bounds for \eqn{a} are defined in function of the coefficient of variation of the fitted parameter \eqn{\hat(a)}. The nonlinear model that is passed to \code{nls} is given by: \deqn{\sum_{i=1}^4 c_i (A_{empir,i}-A_{GB2,i}(a,ap,aq))^2,} where the weights \eqn{c_i} take the differing scales into account and are given by the vector \code{ei4w}. \eqn{ap} and \eqn{aq} are bounded so that the constraints for the existence of the moments of the GB2 distribution and the excess for calculating the Gini coefficient are fulfilled, i.e. \eqn{ap \ge 1} and \eqn{aq \ge 2}. In the second step, only the the parameter \eqn{b} is estimated, optimizing the weighted square difference between the empirical median and the GB2 median in function of the already obtained NLS parameters \eqn{a, p} and \eqn{q}. } \value{ \code{nlsfit.gb2} returns a list of three values: the fitted GB2 parameters, the first fitted object and the second fitted object. } \seealso{ \code{\link[stats]{nls}}, \code{\link{Thomae}}, \code{\link{moment.gb2}} } \author{ Monique Graf and Desislava Nedyalkova } \examples{ # Takes long time to run, as it makes a call to the function ml.gb2 \dontrun{ library(laeken) data(eusilc) # Personal income inc <- as.vector(eusilc$eqIncome) # Sampling weights w <- eusilc$rb050 # Data set d <- data.frame(inc, w) d <- d[!is.na(d$inc),] # Truncate at 0 d <- d[d$inc > 0,] inc <- d$inc w <- d$w # ML fit, full log-likelihood fitf <- ml.gb2(inc, w)$opt1 # Estimated parameters af <- fitf$par[1] bf <- fitf$par[2] pf <- fitf$par[3] qf <- fitf$par[4] gb2.par <- c(af, bf, pf, qf) # Empirical indicators indicEMP <- main.emp(inc, w) indicEMP <- c(indicEMP[1],indicEMP[3:6]) indicE <- round(indicEMP, digits=3) # Nonlinear fit nn <- nlsfit.gb2(indicEMP[1,3:6],indicEMP[3:6]) an <- nn[[1]][1] bn <- nn[[1]][2] pn <- nn[[1]][3] qn <- nn[[1]][4] # GB2 indicators indicNLS <- c(main.gb2(0.6, an, bn, pn, qn)[1], main.gb2(0.6, an, bn, pn, qn)[3:6]) indicML <- c(main.gb2(0.6, af, bf, pf, qf)[1], main.gb2(0.6, af, bf, pf, qf)[3:6]) indicN <- round(indicNLS, digits=3) indicM <- round(indicML, digits=3) # Likelihoods nlik <- loglp.gb2(inc, an, bn, pn, qn, w) mlik <- loglp.gb2(inc, af, bf, pf, qf, w) # Results type=c("Emp. est", "NLS", "ML full") results <- data.frame(type=type, median=c(indicE[1], indicN[1], indicM[1]), ARPR=c(indicE[2], indicN[2], indicM[2]), RMPG=c(indicE[3], indicN[3], indicM[3]), QSR =c(indicE[4], indicN[4], indicM[4]), GINI=c(indicE[5], indicN[5], indicM[5]), likelihood=c(NA, nlik, mlik), a=c(NA, an, af), b=c(NA, bn, bf) ,p=c(NA, pn, pf), q=c(NA, qn, qf)) } } \keyword{ distribution } GB2/man/Gini.Rd0000644000176200001440000000220412524205674012561 0ustar liggesusers\name{Gini} \Rdversion{2.1} \alias{Gini} \alias{gini.gb2} \alias{gini.b2} \alias{gini.dag} \alias{gini.sm} \title{ Computation of the Gini Coefficient for the GB2 Distribution and its Particular Cases. } \description{ Computes the Gini coefficient for the GB2 distribution using the function \code{\link{gb2.gini}}. Computes the Gini coefficient for the Beta Distribution of the Second Kind, Dagum and Singh-Maddala distributions. } \usage{ gini.gb2(shape1, shape2, shape3) gini.b2(shape2, shape3) gini.dag(shape1, shape2) gini.sm(shape1, shape3) } \arguments{ \item{shape1}{numeric; positive parameter.} \item{shape2, shape3}{numeric; positive parameters of the Beta distribution.} } \value{ The Gini coefficient. } \references{ Kleiber, C. and Kotz, S. (2003) \emph{Statistical Size Distributions in Economics and Actuarial Sciences}, chapter 6. Wiley, Ney York. McDonald, J. B. (1984) Some generalized functions for the size distribution of income. \emph{Econometrica}, \bold{52}, 647--663. } \author{ Monique Graf } \seealso{ \code{\link{gb2.gini}} } %\examples{ %} \keyword{distribution } GB2/man/CompoundAuxVarest.Rd0000644000176200001440000001732312524205674015332 0ustar liggesusers\name{CompoundAuxVarest} \Rdversion{2.1} \alias{CompoundAuxVarest} \alias{scoreU.cavgb2} \alias{scorez.cavgb2} \alias{varscore.cavgb2} \alias{desvar.cavgb2} \alias{hess.cavgb2} \alias{vepar.cavgb2} \alias{veind.cavgb2} \title{ Variance Estimation under the Compound GB2 Distribution Using Auxiliary Information } \description{ Calculation of variance estimates of the parameters of the compound GB2 distribution and of the estimated compound GB2 indicators under a complex survey design (see package \code{\link{survey}}). } \usage{ scoreU.cavgb2(fac, z, lambda) scorez.cavgb2(U,z) varscore.cavgb2(SC, w=rep(1,dim(SC)[1])) desvar.cavgb2(data=data, SC=SC, ids=NULL, probs=NULL, strata = NULL, variables = NULL, fpc=NULL, nest = FALSE, check.strata = !nest, weights=NULL, pps=FALSE, variance=c("HT","YG")) hess.cavgb2(U, P, z, w=rep(1, dim(z)[1])) vepar.cavgb2(ml, Vsc, hess) veind.cavgb2(group, vepar, shape1, scale, shape2, shape3, pl0, P, decomp="r") } \arguments{ \item{fac}{numeric; a matrix of Gamma factors.} \item{z}{numeric; a matrix of auxiliary variables.} \item{lambda}{numeric; a matrix of parameters.} \item{U}{numeric; a matrix of scores \eqn{U_{k,\ell}} (output of the \code{scoreU.cavgb2} function).} \item{SC}{numeric; scores, output of \code{scorez.cavgb2}.} \item{w}{numeric; vector of extrapolation weights. By default \code{w} is a vector of 1.} \item{data}{dataset containing the design information per unit} \item{ids, probs, strata, variables, fpc, nest, check.strata, weights, pps, variance}{parameters of \code{\link[survey]{svydesign}}.} %\item{U}{numeric; scores computed in \code{scoreU.cavgb2}.} \item{P}{numeric; matrix of mixture probabilities (output of \code{pkl.cavgb2}).} %\item{z}{numeric; a matrix of auxiliary variables.} \item{ml}{numeric; estimated values of the vector of v's. Output of the \code{ml.cavgb2} function (the second element in the list).} \item{Vsc}{numeric; 4 by 4 matrix. Variance of the scores \code{SC}, computed in \code{varscore.cavgb2} or with the design information in \code{\link{desvar.cavgb2}}.} \item{hess}{numeric; Hessian (bread) for the sandwich variance estimate (output of \code{hess.cavgb2}).} \item{group}{numeric; a factor variable of the same length as the sample size giving the group membership in the special case when the auxiliary information defines group membership.} \item{vepar}{numeric; output of \code{vepar.cavgb2}.} \item{shape1, scale ,shape2, shape3}{numeric; positive parameters of the GB2 distribution.} \item{pl0}{numeric; a vector of initial proportions defining the number of components and the weight of each component density in the decomposition. Sums to one.} \item{decomp}{string; specifying if the decomposition of the GB2 is done with respect to the right tail ("r") or the left tail ("l") of the distribution.} } \details{ The \eqn{N \times L} matrix of fitted mixture probabilities \code{P}\eqn{=(p_{k,\ell})} depends on the \eqn{N \times I} matrix \code{z} of auxiliary variables. \code{P} has as many distinct rows as there are distinct rows in \code{z}. The \eqn{N \times L} matrix of gamma factors \code{fac}\eqn{=F}, output of \code{fg.cgb2} depends on the vector of initial probabilities \eqn{p_{0,\ell}} only. The \eqn{N \times (L-1)} matrix of scores \code{U} is defined as \deqn{U(k,\ell)=p_{k,\ell} \left( \frac{F(k,\ell)}{\sum_{j=1}^L p_{k,j}\, F(k,j)} - 1\right).} The linearized scores are the columns of a \eqn{N \times I(L-1)} matrix \deqn{SC(k,\,I(\ell-1)+i)= U(k,\ell) \, z(k,i).} Function \code{varscore.cavgb2} calculates the middle term of the sandwich variance estimator, that is the \eqn{(I(L-1) \times I(L-1))} estimated variance-covariance matrix of the \eqn{I(L-1)} weighted sums of the columns of \eqn{SC}, without design information. \code{desvar.cavgb2} calculates the design-based variance-covariance matrix of the \eqn{I(L-1)} weighted sums of the columns of \eqn{SC}, invoking \code{svydesign} and \code{svytotal} of package \code{\link{survey}}. \code{hess.cavgb2} calculates the Hessian (\eqn{I(L-1) \times I(L-1)} matrix of second derivatives of the pseudo-log-likelihood with respect to the parameters). It should be negative definite. If not, the maximum likelihood estimates are spurious. \code{vepar.cavgb2} calculates the sandwich variance estimate of the vectorized matrix of parameters \code{lambda}. \code{veind.cavgb2} calculates estimates, std error, covariance and correlation matrices of the indicators under the compound GB2 with auxiliary variables in the particular case where the unique combinations of the auxiliary variables define a small number of groups. Group membership is specified by the vector \code{group} of length \eqn{N}. } \value{ \code{scoreU.cavgb2} returns a \eqn{N \times (L-1)} matrix of scores \code{U}. \code{scorez.cavgb2} returns a \eqn{N \times I(L-1)} matrix whose columns are the linearized scores \code{SC}. \code{varscore.cavgb2} returns the variance-covariance estimate of the weighted sums of scores \code{SC}, given by weighted cross products. \code{desvar.cavgb2} returns a list of two elements. The first is the output of svytotal and the second is the design-based variance-covariance matrix of the weighted sums of the scores SC. \code{hess.cavgb2} returns the matrix of second derivatives of the likelihood with respect to the parameters (bread for the sandwich variance estimate). \code{vepar.cavgb2} returns a list of five elements - [["type"]] with value "parameter", [["estimate"]] estimated parameters, [["stderr"]] corresponding standard errors, [["Vcov"]] variance -covariance matrix and [["Vcor"]] - correlation matrix. \code{veind.cavgb2} returns a list of five elements: [["type"]] with value "indicator", followed by a list with as many arguments as \code{length(levels(group))}. Each argument is itself a list with 5 arguments: [["group"]] group name, [["estimate"]] estimated indicators under the compound GB2, [["stderr"]] corresponding standard errors, [["Vcov"]] variance -covariance matrix and [["Vcor"]] - correlation matrix. } \references{ Davison, A. (2003), \emph{Statistical Models}. Cambridge University Press. Freedman, D. A. (2006), On The So-Called "Huber Sandwich Estimator" and "Robust Standard Errors". \emph{The American Statistician}, \bold{60}, 299--302. Graf, M., Nedyalkova, D., Muennich, R., Seger, J. and Zins, S. (2011) AMELI Deliverable 2.1: Parametric Estimation of Income Distributions and Indicators of Poverty and Social Exclusion. \emph{Technical report}, AMELI-Project. Pfeffermann, D. and Sverchkov, M. Yu. (2003), Fitting Generalized Linear Models under Informative Sampling. In, Skinner, C.J. and Chambers, R.L. (eds.). \emph{Analysis of Survey Data}, chapter 12, 175--195. Wiley, New York. } \author{ Monique Graf and Desislava Nedyalkova } \examples{ \dontrun{ # Example (following of example in CompoundAuxFit) # Scores U U <- scoreU.cavgb2(facgl, z, lambdafitl) # Scores multiplied by z SC <- scorez.cavgb2(U,z) # Naive variance estimate of sum of scores (Vsc <- varscore.cavgb2(SC,w=pwa)) # Design based variance of sum of scores (desv <- desvar.cavgb2(data=ns,SC=SC,id=~hid,strata=~region,weights=~pwa)) # Hessian hess <- hess.cavgb2(U,pglfitl,z,w=pwa) # 1. Sandwich variance-covariance matrix estimate of parameters using Vsc: Param1 <- vepar.cavgb2(fitcml,Vsc, hess) Param1 # 2. Sandwich variance-covariance matrix estimate of parameters using # the design variance: Param2 <- vepar.cavgb2(fitcml,desv$Vtheta, hess) Param2 # 3. Indicators and conditional variances : takes a long time! (Indic <- veind.cavgb2(group,Param2 ,agl.fit,bgl.fit,pgl.fit,qgl.fit, pl0, pglfitl, decomp="l") ) } } \keyword{distribution} GB2/man/CompoundAuxDensPlot.Rd0000644000176200001440000000421712524205674015614 0ustar liggesusers\name{CompoundAuxDensPlot} \Rdversion{2.1} \alias{CompoundAuxDensPlot} \alias{dplot.cavgb2} \title{ Comparison of the compound GB2 and kernel densities by group } \description{ Function \code{dplot.cavgb2} produces a plot in which the compound and kernel (Epanechnikov) densities are plotted by group. } \usage{ dplot.cavgb2(group, x, shape1, scale, shape2, shape3, pl0, pl, w=rep(1,length(x)), xmax = max(x)*(2/3), ymax=2e-05, decomp="r", choicecol=1:length(levels(group)), xlab="") } \arguments{ \item{group}{numeric; a factor variable giving the group membership of each sampled unit.} \item{x}{numeric; can be a vector. The value(s) at which the density is calculated, used for the kernel estimate only. \code{x} is positive. } \item{shape1, scale, shape2, shape3}{numeric; positive parameters of the GB2 distribution. On the plot they are denotes as \code{a}, \code{b}, \code{p}, \code{q} and \code{pl0} respectively.} \item{pl0}{numeric; a vector of initial proportions defining the number of components and the weight of each component density in the decomposition. Sums to one.} \item{pl}{numeric; a vector of fitted proportions (output of \code{\link{pkl.cavgb2}}). Sums to one. If \code{pl} is equal to \code{pl0}, we obtain the GB2 distribution.} \item{w}{numeric; weights.} \item{xmax}{numeric; scale on the horizontal axis. By default is equal to \eqn{max(x)*(2/3)}.} \item{ymax}{numeric; scale on the vertical axis. By default is equal to 2e-05.} \item{decomp}{string; specifying if the decomposition of the GB2 is done with respect to the right tail ("r") or the left tail ("l") of the distribution. By default, \code{decomp} = "r" - right tail decomposition.} \item{choicecol}{numeric vector of length the number of groups; defines the color with which the density curves will be plotted for each group.} \item{xlab}{string; label for \eqn{x}. The default is " ".} } \details{The legend is placed interactively. } \value{\code{dplot.cavgb2} plots a graph with two curves - the GB2 density, the compound GB2 per group and the corresponding kernel estimate. } \author{ Monique Graf and Desislava Nedyalkova } GB2/man/Compound.Rd0000644000176200001440000001056712524205674013472 0ustar liggesusers\name{Compound} \Rdversion{2.1} \alias{Compound} \alias{fg.cgb2} \alias{dl.cgb2} \alias{pl.cgb2} \alias{dcgb2} \alias{pcgb2} \alias{prcgb2} \title{ Compound Distribution based on the Generalized Beta Distribution of the Second Kind } \description{ Mixture distribution based on the compounding property of the GB2, in short "compound GB2". Decomposition of the GB2 distribution with respect to the left and right tail of the distribution. Calculation of the component densities and cumulative distribution functions. Calculation of the compound density function and the compound cumulative distribution function. } \usage{ fg.cgb2(x, shape1, scale, shape2, shape3, pl0, decomp="r") dl.cgb2(x, shape1, scale, shape2, shape3, pl0, decomp="r") pl.cgb2(y, shape1, scale, shape2, shape3, pl0, decomp="r", tol=1e-05) dcgb2(x, shape1, scale, shape2, shape3, pl0, pl, decomp="r") pcgb2(y, shape1, scale, shape2, shape3, pl0, pl, decomp="r") prcgb2(y1, y2, shape1, scale, shape2, shape3, pl0, pl, decomp="r", tol=1e-08, debug=FALSE) } \arguments{ \item{x}{numeric; can be a vector. The value(s) at which the compound density and the component densities are calculated, \code{x} is positive.} \item{y}{numeric; can be a vector. The value(s) at which the compound distribution function and the component distribution functions are calculated.} \item{y1, y2}{numeric values.} \item{shape1, scale ,shape2, shape3}{numeric; positive parameters of the GB2 distribution.} \item{pl0}{numeric; a vector of initial proportions defining the number of components and the weight of each component density in the decomposition. Sums to one.} \item{pl}{numeric; a vector of fitted proportions. Sums to one. If \code{pl} is equal to \code{pl0}, we obtain the GB2 distribution.} \item{decomp}{string; specifying if the decomposition of the GB2 is done with respect to the right tail ("r") or the left tail ("l") of the distribution. By default, \code{decomp} = "r" - right tail decomposition.} \item{debug}{logical; By default, \code{debug = FALSE}.} \item{tol}{numeric; tolerance with default 0, meaning to iterate until additional terms do not change the partial sum.} } \details{ The number of components \eqn{L} is given by the length of the vector \code{pl0}. In our examples \eqn{L=3}. Let \eqn{N} denote the length of the vector \code{x}. Function \code{fg.cgb2} calculates the \eqn{L} gamma factors which multiply the GB2 density in order to obtain the component density \eqn{f_\ell}. These component densities are calculated using the function \code{dl.cgb2}. Function \code{pl.cgb2} calculates the corresponding \eqn{L} cumulative component distribution functions. Function \code{dcgb2} calculates the resulting compound density function. Function \code{pcgb2} calculates the compound cumulative distribution function for a vector of values \code{y} and function \code{prcgb2}, given 2 arguments \code{y1} and \code{y2}, calculates the probability \eqn{P(min(y1,y2) < Y < max(y1,y2))}, where the random variable \eqn{Y} follows a compound GB2 distribution. } \value{\code{fg.cgb2} returns a matrix of size \eqn{N \times L} of the Gamma factors, \code{dl.cgb2} returns a matrix of size \eqn{N \times L} of component densities, \code{pl.cgb2} returns a matrix containing the \eqn{L} component cdfs, \code{dcgb2} returns a matrix of size \eqn{N \times 1} of the GB2 compound density function, \code{pcgb2} returns a matrix of size \eqn{N \times 1} of the GB2 compound distribution function and \code{prcgb2} returns a probability between 0 and 1. } \references{ Graf, M., Nedyalkova, D., Muennich, R., Seger, J. and Zins, S. (2011) AMELI Deliverable 2.1: Parametric Estimation of Income Distributions and Indicators of Poverty and Social Exclusion. \emph{Technical report}, AMELI-Project. } \author{ Monique Graf and Desislava Nedyalkova } \examples{ #\dontrun{ #\library{cubature} # GB2 parameters af <- 5 bf <- 20000 pf <- 0.45 qf <- 0.75 p0 <- rep(1/3,3) p1 <- c(0.37,0.43,0.2) # a vector of values x <- rep(20000*seq(1,2,length.out=9)) #Gamma components fg.cgb2(20000,af,bf,pf,qf,p0) fg.cgb2(Inf,af,bf,pf,qf,p0,"l") #Component densities dl.cgb2(x,af,bf,pf,qf,p0) dl.cgb2(20000,af,bf,pf,qf,p0,"l") #Component cdf pl.cgb2(25000,af,bf,pf,qf,p0) #Compound cdf pcgb2(x,af,bf,pf,qf,p0,p1) prcgb2(37000,38000,af,bf,pf,qf,p0,p1,"l") #} } \keyword{ distribution } GB2/man/LogDensity.Rd0000644000176200001440000000332212524205674013756 0ustar liggesusers\name{LogDensity} \Rdversion{2.1} \alias{LogDensity} \alias{logf.gb2} \alias{dlogf.gb2} \alias{d2logf.gb2} \title{ Log Density of the GB2 Distribution } \description{ Calculates the log density of the GB2 distribution for a single value or a vector of values. Calculates the first- and second-order partial derivatives of the log density evaluated at a single value.} \usage{ logf.gb2(x, shape1, scale, shape2, shape3) dlogf.gb2(xi, shape1, scale, shape2, shape3) d2logf.gb2(xi, shape1, scale, shape2, shape3) } \arguments{ \item{xi}{numeric; a data value.} \item{x}{numeric; a vector of data values.} \item{shape1}{numeric; positive parameter.} \item{scale}{numeric; positive parameter.} \item{shape2, shape3}{numeric; positive parameters of the Beta distribution.} } \details{ We calculate \eqn{log(f(x, \theta))}, where \eqn{f} is the GB2 density with parameters \code{shape1} \eqn{= a}, \code{scale} \eqn{= b}, \code{shape2} \eqn{= p} and \code{shape3} \eqn{= q}, \eqn{\theta} is the parameter vector. We calculate the first- and second-order partial derivatives of \eqn{log(f(x, \theta))} with respect to the parameter vector \eqn{\theta}. } \value{ Depending on the input \code{logf.gb2} gives the log density for a single value or a vector of values. \code{dlogf.gb2} gives the vector of the four first-order partial derivatives of the log density and \code{d2logf.gb2} gives the \eqn{4 \times 4} matrix of second-order partial derivatives of the log density. } \references{ Brazauskas, V. (2002) Fisher information matrix for the Feller-Pareto distribution. \emph{Statistics \& Probability Letters}, \bold{59}, 159--167. } \author{ Desislava Nedyalkova } \keyword{distribution} GB2/man/CompoundQuantiles.Rd0000644000176200001440000000460512524205674015354 0ustar liggesusers\name{CompoundQuantiles} \Rdversion{2.1} \alias{CompoundQuantiles} \alias{qcgb2} \alias{rcgb2} \title{ Quantiles and random generation of the Compound Distribution based on the GB2 } \description{ Calculation of the quantiles of a compound GB2 random variable. Random generation of compound GB2 variables. } \usage{ qcgb2(prob, shape1, scale, shape2, shape3, pl0, pl, decomp="r", tol=1e-08, ff=1.5, debug=FALSE, maxiter=50) rcgb2(n, shape1, scale, shape2, shape3, pl0, pl, decomp="r", tol=1e-02, maxiter=100, debug = FALSE) } \arguments{ \item{prob}{numeric; vector of probabilities between 0 and 1.} \item{shape1,scale,shape2,shape3}{numeric; positive parameters of the GB2 distribution.} \item{n}{numeric; number of observations. If \code{length(n) > 1}, the length is taken to be the number required.} \item{pl0}{numeric; a vector of initial proportions defining the number of components and the weight of each component density in the decomposition. Sums to one.} \item{pl}{numeric; a vector of mixture probabilities. Sums to one. If \eqn{pl=pl0} we obtain the GB2 distribution.} \item{decomp}{string; specifying if the decomposition of the GB2 is done with respect to the right tail ("r") or the left tail ("l") of the distribution. By default, \code{decomp} = "r" - right tail decomposition.} \item{ff}{numeric; a tuning parameter.} \item{debug}{logical; By default, \code{debug = FALSE}.} \item{maxiter}{numeric; maximum number of iterations to perform.} \item{tol}{numeric; tolerance with default 0, meaning to iterate until additional terms do not change the partial sum.} } \value{ \code{qcgb2} returns a vector of quantiles and \code{rcgb2} return a vector of size \code{n} of GB2 compound random deviates. } \references{ Graf, M., Nedyalkova, D., Muennich, R., Seger, J. and Zins, S. (2011) AMELI Deliverable 2.1: Parametric Estimation of Income Distributions and Indicators of Poverty and Social Exclusion. \emph{Technical report}, AMELI-Project. } \author{ Monique Graf and Desislava Nedyalkova } \examples{ #\dontrun{ #\library{cubature} # GB2 parameters af <- 5 bf <- 20000 pf <- 0.45 qf <- 0.75 p0 <- rep(1/3,3) p1 <- c(0.37,0.43,0.2) #Quantiles qcgb2(0.5,af,bf,pf,qf,p0,p1) qcgb2(1,af,bf,pf,qf,p0,p1) qcgb2(c(0.5,0.8),af,bf,pf,qf,p0,p1) #Random generation rcgb2(10,af,bf,pf,qf,p0,p1) #} } \keyword{distribution}