Running ‘Ch-Basics.R’
  Comparing ‘Ch-Basics.Rout’ to ‘Ch-Basics.Rout.save’ ... OK
  Running ‘Ch-Intro.R’
  Comparing ‘Ch-Intro.Rout’ to ‘Ch-Intro.Rout.save’ ... OK
  Running ‘Ch-LinearRegression.R’
  Comparing ‘Ch-LinearRegression.Rout’ to ‘Ch-LinearRegression.Rout.save’ ... OK
  Running ‘Ch-Microeconometrics.R’
  Running ‘Ch-Programming.R’ [45s/46s]
  Comparing ‘Ch-Programming.Rout’ to ‘Ch-Programming.Rout.save’ ... OK
  Running ‘Ch-TimeSeries.R’
  Comparing ‘Ch-TimeSeries.Rout’ to ‘Ch-TimeSeries.Rout.save’ ... OK
  Running ‘Ch-Validation.R’ [37s/38s]
  Comparing ‘Ch-Validation.Rout’ to ‘Ch-Validation.Rout.save’ ... OK
Running the tests in ‘tests/Ch-Microeconometrics.R’ failed.
Complete output:
  > ###################################################
  > ### chunk number 1: setup
  > ###################################################
  > options(prompt = "R> ", continue = "+  ", width = 64,
  +   digits = 4, show.signif.stars = FALSE, useFancyQuotes = FALSE)
  R> 
  R> options(SweaveHooks = list(onefig =   function() {par(mfrow = c(1,1))},
  +                             twofig =   function() {par(mfrow = c(1,2))},                           
  +                             threefig = function() {par(mfrow = c(1,3))},
  +                             fourfig =  function() {par(mfrow = c(2,2))},
  +                             sixfig =   function() {par(mfrow = c(3,2))}))
  R> 
  R> library("AER")
  Loading required package: car
  Loading required package: carData
  Loading required package: lmtest
  Loading required package: zoo
  
  Attaching package: 'zoo'
  
  The following objects are masked from 'package:base':
  
      as.Date, as.Date.numeric
  
  Loading required package: sandwich
  Loading required package: survival
  R> 
  R> suppressWarnings(RNGversion("3.5.0"))
  R> set.seed(1071)
  R> 
  R> 
  R> ###################################################
  R> ### chunk number 2: swisslabor-data
  R> ###################################################
  R> data("SwissLabor")
  R> swiss_probit <- glm(participation ~ . + I(age^2),
  +    data = SwissLabor, family = binomial(link = "probit"))
  R> summary(swiss_probit)
  
  Call:
  glm(formula = participation ~ . + I(age^2), family = binomial(link = "probit"), 
      data = SwissLabor)
  
  Deviance Residuals: 
     Min      1Q  Median      3Q     Max  
  -1.919  -0.970  -0.479   1.021   2.480  
  
  Coefficients:
              Estimate Std. Error z value Pr(>|z|)
  (Intercept)   3.7491     1.4069    2.66   0.0077
  income       -0.6669     0.1320   -5.05  4.3e-07
  age           2.0753     0.4054    5.12  3.1e-07
  education     0.0192     0.0179    1.07   0.2843
  youngkids    -0.7145     0.1004   -7.12  1.1e-12
  oldkids      -0.1470     0.0509   -2.89   0.0039
  foreignyes    0.7144     0.1213    5.89  3.9e-09
  I(age^2)     -0.2943     0.0499   -5.89  3.8e-09
  
  (Dispersion parameter for binomial family taken to be 1)
  
      Null deviance: 1203.2  on 871  degrees of freedom
  Residual deviance: 1017.2  on 864  degrees of freedom
  AIC: 1033
  
  Number of Fisher Scoring iterations: 4
  
  R> 
  R> 
  R> ###################################################
  R> ### chunk number 3: swisslabor-plot eval=FALSE
  R> ###################################################
  R> ## plot(participation ~ age, data = SwissLabor, ylevels = 2:1)
  R> 
  R> 
  R> ###################################################
  R> ### chunk number 4: swisslabor-plot-refined
  R> ###################################################
  R> plot(participation ~ education, data = SwissLabor, ylevels = 2:1)
  R> fm <- glm(participation ~ education + I(education^2), data = SwissLabor, family = binomial)
  R> edu <- sort(unique(SwissLabor$education))
  R> prop <- sapply(edu, function(x) mean(SwissLabor$education <= x))
  R> lines(predict(fm, newdata = data.frame(education = edu), type = "response") ~ prop, col = 2)
  R> 
  R> plot(participation ~ age, data = SwissLabor, ylevels = 2:1)
  R> fm <- glm(participation ~ age + I(age^2), data = SwissLabor, family = binomial)
  R> ag <- sort(unique(SwissLabor$age))
  R> prop <- sapply(ag, function(x) mean(SwissLabor$age <= x))
  R> lines(predict(fm, newdata = data.frame(age = ag), type = "response") ~ prop, col = 2)
  R> 
  R> 
  R> ###################################################
  R> ### chunk number 5: effects1
  R> ###################################################
  R> fav <- mean(dnorm(predict(swiss_probit, type = "link")))
  R> fav * coef(swiss_probit)
  (Intercept)      income         age   education   youngkids 
     1.241930   -0.220932    0.687466    0.006359   -0.236682 
      oldkids  foreignyes    I(age^2) 
    -0.048690    0.236644   -0.097505 
  R> 
  R> 
  R> ###################################################
  R> ### chunk number 6: effects2
  R> ###################################################
  R> av <- colMeans(SwissLabor[, -c(1, 7)])
  R> av <- data.frame(rbind(swiss = av, foreign = av),
  +    foreign = factor(c("no", "yes")))
  R> av <- predict(swiss_probit, newdata = av, type = "link")
  R> av <- dnorm(av)
  R> av["swiss"] * coef(swiss_probit)[-7]
  (Intercept)      income         age   education   youngkids 
     1.495137   -0.265976    0.827628    0.007655   -0.284938 
      oldkids    I(age^2) 
    -0.058617   -0.117384 
  R> 
  R> 
  R> ###################################################
  R> ### chunk number 7: effects3
  R> ###################################################
  R> av["foreign"] * coef(swiss_probit)[-7]
  (Intercept)      income         age   education   youngkids 
     1.136517   -0.202180    0.629115    0.005819   -0.216593 
      oldkids    I(age^2) 
    -0.044557   -0.089229 
  R> 
  R> 
  R> ###################################################
  R> ### chunk number 8: mcfadden
  R> ###################################################
  R> swiss_probit0 <- update(swiss_probit, formula = . ~ 1)
  R> 1 - as.vector(logLik(swiss_probit)/logLik(swiss_probit0))
  [1] 0.1546
  R> 
  R> 
  R> ###################################################
  R> ### chunk number 9: confusion-matrix
  R> ###################################################
  R> table(true = SwissLabor$participation,
  +    pred = round(fitted(swiss_probit)))
       pred
  true    0   1
    no  337 134
    yes 146 255
  R> 
  R> 
  R> ###################################################
  R> ### chunk number 10: confusion-matrix1
  R> ###################################################
  R> tab <- table(true = SwissLabor$participation,
  +    pred = round(fitted(swiss_probit)))
  R> tabp <- round(100 * c(tab[1,1] + tab[2,2], tab[2,1] + tab[1,2])/sum(tab), digits = 2)
  R> 
  R> 
  R> ###################################################
  R> ### chunk number 11: roc-plot eval=FALSE
  R> ###################################################
  R> ## library("ROCR")
  R> ## pred <- prediction(fitted(swiss_probit),
  R> ##   SwissLabor$participation)
  R> ## plot(performance(pred, "acc"))
  R> ## plot(performance(pred, "tpr", "fpr"))
  R> ## abline(0, 1, lty = 2)
  R> 
  R> 
  R> ###################################################
  R> ### chunk number 12: roc-plot1
  R> ###################################################
  R> library("ROCR")
  Loading required package: gplots
  
  Attaching package: 'gplots'
  
  The following object is masked from 'package:stats':
  
      lowess
  
  R> pred <- prediction(fitted(swiss_probit),
  +    SwissLabor$participation)
  R> plot(performance(pred, "acc"))
  Error in as.double(y) : 
    cannot coerce type 'S4' to vector of type 'double'
  Calls: plot -> plot -> plot.default -> xy.coords
  Execution halted