
> library("betareg")

> data("GasolineYield", package = "betareg")

> data("FoodExpenditure", package = "betareg")

> gy_loglog <- betareg(yield ~ batch + temp, data = GasolineYield, 
+     link = "loglog")

> fe_beta2 <- betareg(I(food/income) ~ income + persons | 
+     persons, data = FoodExpenditure)

> knitr::opts_chunk$set(engine = "R", collapse = TRUE, 
+     comment = "##", message = FALSE, warning = FALSE, echo = TRUE)

> options(width = 70, prompt = "R> ", continue = "+  ", 
+     useFancyQuotes = FALSE, digits = 5)

> par(mfrow = c(1, 2), mar = c(4.1, 4.1, 4.1, 0.1))

> dbeta2 <- function(x, mu, phi = 1) dbeta(x, mu * phi, 
+     (1 - mu) * phi)

> x <- seq(from = 0.01, to = 0.99, length = 200)

> xx <- cbind(x, x, x, x, x)

> yy <- cbind(dbeta2(x, 0.1, 5), dbeta2(x, 0.25, 5), 
+     dbeta2(x, 0.5, 5), dbeta2(x, 0.75, 5), dbeta2(x, 0.9, 5))

> matplot(xx, yy, type = "l", xlab = "y", ylab = "Density", 
+     main = expression(phi == 5), lty = 1, col = "black", ylim = c(0, 
+         15))

> text(0.05, 12, "0.10")

> text(0.95, 12, "0.90")

> text(0.22, 2.8, "0.25")

> text(0.78, 2.8, "0.75")

> text(0.5, 2.3, "0.50")

> yy <- cbind(dbeta2(x, 0.1, 100), dbeta2(x, 0.25, 100), 
+     dbeta2(x, 0.5, 100), dbeta2(x, 0.75, 100), dbeta2(x, 0.9, 
+         100))

> matplot(xx, yy, type = "l", xlab = "y", ylab = "", 
+     main = expression(phi == 100), lty = 1, col = "black", ylim = c(0, 
+         15))

> text(0.1, 14.5, "0.10")

> text(0.9, 14.5, "0.90")

> text(0.25, 9.8, "0.25")

> text(0.75, 9.8, "0.75")

> text(0.5, 8.6, "0.50")

> data("GasolineYield", package = "betareg")

> gy_logit <- betareg(yield ~ batch + temp, data = GasolineYield)

> summary(gy_logit)

Call:
betareg(formula = yield ~ batch + temp, data = GasolineYield)

Quantile residuals:
   Min     1Q Median     3Q    Max 
-2.140 -0.570  0.120  0.704  1.751 

Coefficients (mean model with logit link):
             Estimate Std. Error z value Pr(>|z|)    
(Intercept) -6.159571   0.182325  -33.78  < 2e-16 ***
batch1       1.727729   0.101229   17.07  < 2e-16 ***
batch2       1.322597   0.117902   11.22  < 2e-16 ***
batch3       1.572310   0.116105   13.54  < 2e-16 ***
batch4       1.059714   0.102360   10.35  < 2e-16 ***
batch5       1.133752   0.103523   10.95  < 2e-16 ***
batch6       1.040162   0.106036    9.81  < 2e-16 ***
batch7       0.543692   0.109127    4.98  6.3e-07 ***
batch8       0.495901   0.108926    4.55  5.3e-06 ***
batch9       0.385793   0.118593    3.25   0.0011 ** 
temp         0.010967   0.000413   26.58  < 2e-16 ***

Phi coefficients (precision model with identity link):
      Estimate Std. Error z value Pr(>|z|)    
(phi)      440        110       4  6.3e-05 ***
---
Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 

Type of estimator: ML (maximum likelihood)
Log-likelihood: 84.8 on 12 Df
Pseudo R-squared: 0.962
Number of iterations: 51 (BFGS) + 3 (Fisher scoring) 

> redblue <- hcl(c(0, 260), 90, 40)

> plot(yield ~ temp, data = GasolineYield, type = "n", 
+     ylab = "Proportion of crude oil converted to gasoline", xlab = "Temperature at which all ..." ... [TRUNCATED] 

> points(yield ~ temp, data = GasolineYield, cex = 1.75, 
+     pch = 19, col = rev(gray.colors(10))[as.numeric(batch)])

> points(yield ~ temp, data = GasolineYield, cex = 1.75)

> legend("topleft", as.character(1:10), title = "Batch", 
+     col = rev(gray.colors(10)), pch = 19, bty = "n")

> legend("topleft", as.character(1:10), title = "Batch", 
+     pch = 1, bty = "n")

> lines(150:500, predict(gy_logit, newdata = data.frame(temp = 150:500, 
+     batch = "6")), col = redblue[2], lwd = 2, lty = 2)

> lines(150:500, predict(gy_loglog, newdata = data.frame(temp = 150:500, 
+     batch = "6")), col = redblue[1], lwd = 2)

> legend("bottomright", c("log-log", "logit"), col = redblue, 
+     lty = 1:2, lwd = 2, bty = "n")

> par(mfrow = c(3, 2))

> suppressWarnings(RNGversion("3.5.0"))

> set.seed(123)

> plot(gy_logit, which = 1:4, type = "pearson")

> plot(gy_logit, which = 5, type = "deviance", sub.caption = "")

> plot(gy_logit, which = 1, type = "deviance", sub.caption = "")

> gy_logit4 <- update(gy_logit, subset = -4)

> coef(gy_logit, model = "precision")
 (phi) 
440.28 

> coef(gy_logit4, model = "precision")
 (phi) 
577.79 

> data("FoodExpenditure", package = "betareg")

> fe_lm <- lm(I(food/income) ~ income + persons, data = FoodExpenditure)

> library("lmtest")
Loading required package: zoo

Attaching package: 'zoo'

The following objects are masked from 'package:base':

    as.Date, as.Date.numeric


> bptest(fe_lm)

	studentized Breusch-Pagan test

data:  fe_lm
BP = 5.93, df = 2, p-value = 0.051


> fe_beta <- betareg(I(food/income) ~ income + persons, 
+     data = FoodExpenditure)

> summary(fe_beta)

Call:
betareg(formula = I(food/income) ~ income + persons, data = FoodExpenditure)

Quantile residuals:
   Min     1Q Median     3Q    Max 
-2.533 -0.460  0.170  0.642  1.773 

Coefficients (mean model with logit link):
            Estimate Std. Error z value Pr(>|z|)    
(Intercept) -0.62255    0.22385   -2.78   0.0054 ** 
income      -0.01230    0.00304   -4.05  5.1e-05 ***
persons      0.11846    0.03534    3.35   0.0008 ***

Phi coefficients (precision model with identity link):
      Estimate Std. Error z value Pr(>|z|)    
(phi)    35.61       8.08    4.41    1e-05 ***
---
Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 

Type of estimator: ML (maximum likelihood)
Log-likelihood: 45.3 on 4 Df
Pseudo R-squared: 0.388
Number of iterations: 28 (BFGS) + 4 (Fisher scoring) 

> redblueblack <- hcl(c(0, 260, 0), c(90, 90, 0), c(40, 
+     40, 0))

> plot(I(food/income) ~ income, data = FoodExpenditure, 
+     xlab = "Household income", ylab = "Proportion of food expenditures", 
+     main = "Foo ..." ... [TRUNCATED] 

> points(I(food/income) ~ income, data = FoodExpenditure, 
+     cex = 1.75, pch = 19, col = rev(gray.colors(7))[persons])

> points(I(food/income) ~ income, data = FoodExpenditure, 
+     cex = 1.75)

> legend("bottomleft", rev(as.character(sort(unique(FoodExpenditure$persons)))), 
+     title = "Persons", col = gray.colors(7), pch = 19, bty = "n")

> legend("bottomleft", rev(as.character(sort(unique(FoodExpenditure$persons)))), 
+     title = "Persons", pch = 1, bty = "n")

> lines(10:100, predict(fe_lm, newdata = data.frame(income = 10:100, 
+     persons = mean(FoodExpenditure$persons))), col = redblueblack[3], 
+     l .... [TRUNCATED] 

> lines(10:100, predict(fe_beta, newdata = data.frame(income = 10:100, 
+     persons = mean(FoodExpenditure$persons))), col = redblueblack[2], 
+     .... [TRUNCATED] 

> lines(10:100, predict(fe_beta2, newdata = data.frame(income = 10:100, 
+     persons = mean(FoodExpenditure$persons))), col = redblueblack[1], 
+    .... [TRUNCATED] 

> legend("topright", c("logit, var. disp.", "logit, fix. disp.", 
+     "lm"), col = redblueblack, lty = c(1, 5, 2), lwd = 2, bty = "n")

> gy_logit2 <- betareg(yield ~ batch + temp | temp, 
+     data = GasolineYield)

> printCoefmat(summary(gy_logit2)$coefficients$precision)
            Estimate Std. Error z value Pr(>|z|)    
(Intercept)  1.36409    1.22578    1.11     0.27    
temp         0.01457    0.00362    4.03  5.7e-05 ***
---
Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1

> lrtest(gy_logit, gy_logit2)
Likelihood ratio test

Model 1: yield ~ batch + temp
Model 2: yield ~ batch + temp | temp
  #Df LogLik Df Chisq Pr(>Chisq)  
1  12   84.8                      
2  13   87.0  1  4.36      0.037 *
---
Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1

> fe_beta2 <- betareg(I(food/income) ~ income + persons | 
+     persons, data = FoodExpenditure)

> lrtest(fe_beta, fe_beta2)
Likelihood ratio test

Model 1: I(food/income) ~ income + persons
Model 2: I(food/income) ~ income + persons | persons
  #Df LogLik Df Chisq Pr(>Chisq)   
1   4   45.3                       
2   5   49.2  1   7.7     0.0055 **
---
Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1

> AIC(fe_beta, fe_beta2, k = log(nrow(FoodExpenditure)))
         df     AIC
fe_beta   4 -76.117
fe_beta2  5 -80.182

> gy_loglog <- betareg(yield ~ batch + temp, data = GasolineYield, 
+     link = "loglog")

> summary(gy_logit)$pseudo.r.squared
[1] 0.96173

> summary(gy_loglog)$pseudo.r.squared
[1] 0.98523

> AIC(gy_logit, gy_logit2, gy_loglog)
          df     AIC
gy_logit  12 -145.60
gy_logit2 13 -147.95
gy_loglog 12 -168.31

> lrtest(gy_logit, . ~ . + I(predict(gy_logit, type = "link")^2))
Likelihood ratio test

Model 1: yield ~ batch + temp
Model 2: yield ~ batch + temp + I(predict(gy_logit, type = "link")^2)
  #Df LogLik Df Chisq Pr(>Chisq)    
1  12   84.8                        
2  13   96.0  1  22.4    2.2e-06 ***
---
Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1

> lrtest(gy_loglog, . ~ . + I(predict(gy_loglog, type = "link")^2))
Likelihood ratio test

Model 1: yield ~ batch + temp
Model 2: yield ~ batch + temp + I(predict(gy_loglog, type = "link")^2)
  #Df LogLik Df Chisq Pr(>Chisq)
1  12   96.2                    
2  13   97.0  1  1.67        0.2

> plot(abs(residuals(gy_loglog, type = "response")), 
+     abs(residuals(gy_logit, type = "response")))

> abline(0, 1, lty = 2)

> gy_loglog2 <- update(gy_loglog, link.phi = "log")

> summary(gy_loglog2)$iterations
  optim scoring 
     21       2 

> sapply(c("logit", "probit", "cloglog", "cauchit", 
+     "loglog"), function(x) logLik(update(fe_beta2, link = x)))
  logit  probit cloglog cauchit  loglog 
 49.185  49.080  49.359  50.011  48.867 

> data("ReadingSkills", package = "betareg")

> rs_accuracy <- format(round(with(ReadingSkills, tapply(accuracy, 
+     dyslexia, mean)), digits = 3))

> data("ReadingSkills", package = "betareg")

> rs_ols <- lm(qlogis(accuracy) ~ dyslexia * iq, data = ReadingSkills)

> coeftest(rs_ols)

t test of coefficients:

            Estimate Std. Error t value Pr(>|t|)    
(Intercept)    1.601      0.226    7.09  1.4e-08 ***
dyslexia      -1.206      0.226   -5.34  4.0e-06 ***
iq             0.359      0.225    1.59    0.119    
dyslexia:iq   -0.423      0.225   -1.88    0.068 .  
---
Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1


> rs_beta <- betareg(accuracy ~ dyslexia * iq | dyslexia + 
+     iq, data = ReadingSkills, hessian = TRUE)

> coeftest(rs_beta)

z test of coefficients:

                  Estimate Std. Error z value Pr(>|z|)    
(Intercept)          1.123      0.151    7.44  9.8e-14 ***
dyslexia            -0.742      0.151   -4.90  9.7e-07 ***
iq                   0.486      0.167    2.91  0.00360 ** 
dyslexia:iq         -0.581      0.173   -3.37  0.00076 ***
(phi)_(Intercept)    3.304      0.227   14.59  < 2e-16 ***
(phi)_dyslexia       1.747      0.294    5.94  2.8e-09 ***
(phi)_iq             1.229      0.460    2.67  0.00749 ** 
---
Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1


> cl1 <- hcl(c(260, 0), 90, 40)

> cl2 <- hcl(c(260, 0), 10, 95)

> plot(accuracy ~ iq, data = ReadingSkills, col = cl2[as.numeric(dyslexia)], 
+     main = "Reading skills data", xlab = "IQ score", ylab = "Reading a ..." ... [TRUNCATED] 

> points(accuracy ~ iq, data = ReadingSkills, cex = 1.5, 
+     pch = (1:2)[as.numeric(dyslexia)], col = cl1[as.numeric(dyslexia)])

> nd <- data.frame(dyslexia = "no", iq = -30:30/10)

> lines(nd$iq, predict(rs_beta, nd), col = cl1[1], lwd = 2)

> lines(nd$iq, plogis(predict(rs_ols, nd)), col = cl1[1], 
+     lty = 2, lwd = 2)

> nd <- data.frame(dyslexia = "yes", iq = -30:30/10)

> lines(nd$iq, predict(rs_beta, nd), col = cl1[2], lwd = 2)

> lines(nd$iq, plogis(predict(rs_ols, nd)), col = cl1[2], 
+     lty = 2, lwd = 2)

> legend("topleft", c("control", "dyslexic", "betareg", 
+     "lm"), lty = c(NA, NA, 1:2), pch = c(19, 17, NA, NA), lwd = 2, 
+     col = c(cl2, 1, 1 .... [TRUNCATED] 

> legend("topleft", c("control", "dyslexic", "betareg", 
+     "lm"), lty = c(NA, NA, 1:2), pch = c(1, 2, NA, NA), col = c(cl1, 
+     NA, NA), bty =  .... [TRUNCATED] 

> suppressWarnings(RNGversion("3.5.0"))

> set.seed(123)

> y1 <- c(rbeta(150, 0.3 * 4, 0.7 * 4), rbeta(50, 0.5 * 
+     4, 0.5 * 4))

> y2 <- c(rbeta(100, 0.3 * 4, 0.7 * 4), rbeta(100, 0.3 * 
+     8, 0.7 * 8))

> library("strucchange")
Loading required package: sandwich

> y1_gefp <- gefp(y1 ~ 1, fit = betareg)

> y2_gefp <- gefp(y2 ~ 1, fit = betareg)

> plot(y1_gefp, aggregate = FALSE)

> plot(y2_gefp, aggregate = FALSE)

 *** Run successfully completed ***
> proc.time()
   user  system elapsed 
  2.975   0.068   3.038 
