## ----setup, include=FALSE-----------------------------------------------------
knitr::opts_chunk$set(
  collapse  = TRUE,
  message   = FALSE,
  warning   = FALSE,
  fig.align = "center",
  fig.height = 5,
  fig.width  = 7,
  fig.path   = "fig/",
  dev        = "png",
  comment    = "#>"
)

# packages to be cited in packages.bib
.to.cite <- c("nestedLogit", "nnet", "car", "ggplot2", "AER", "dplyr",
               "mlogit", "vcd", "MASS")

## ----load-packages------------------------------------------------------------
library(nestedLogit)
library(nnet)       # for: multinom()
library(car)        # for: Anova()
library(ggplot2)

## ----chile-data---------------------------------------------------------------
data("Chile", package = "carData")
str(Chile)

## ----chile-drop---------------------------------------------------------------
colSums(is.na(Chile))

# Drop the 168 rows with missing vote so all models use the same cases
chile <- Chile[!is.na(Chile$vote), ]

# Recode vote with longer labels, ordered by median statusquo (No < Abstain < Undec < Yes)
chile$vote <- factor(chile$vote,
                     levels = c("N", "A", "U", "Y"),
                     labels = c("No", "Abstain", "Undec", "Yes"))
nrow(chile)
table(chile$vote)

## ----chile-eda----------------------------------------------------------------
# statusquo distribution by vote
boxplot(statusquo ~ vote, data = chile,
        xlab = "Vote", ylab = "Attitude toward status quo",
        main  = "Chile 1988: status quo attitude by voting intention")

## ----chile-dichots-eng--------------------------------------------------------
dichots_eng <- logits(
  engage    = dichotomy(engaged    = c("Yes", "No"),
                        disengaged = c("Abstain", "Undec")),
  direction = dichotomy("Yes", "No"),
  disengage = dichotomy("Abstain", "Undec")
)

# print method
dichots_eng

# print as an ASCII tree
as.tree(dichots_eng, response = "vote")

## ----chile-dichots-dir--------------------------------------------------------
dichots_dir <- logits(
  direction  = dichotomy(pro  = c("Yes", "Undec"),
                         anti = c("No", "Abstain")),
  engage_pro = dichotomy("Yes", "Undec"),
  engage_ant = dichotomy("No", "Abstain")
)
dichots_dir

## ----chile-fit----------------------------------------------------------------
mod.formula <- vote ~ statusquo + age + sex + education + income

# Multinomial logit baseline (reference = "No")
chile2 <- within(chile, vote <- relevel(vote, ref = "No"))
chile_multi <- multinom(mod.formula, data = chile2, trace = FALSE)

# Nested logit: engagement-first tree
chile_eng <- nestedLogit(mod.formula, dichotomies = dichots_eng, data = chile)

# Nested logit: direction-first tree
chile_dir <- nestedLogit(mod.formula, dichotomies = dichots_dir, data = chile)

## ----chile-summaries, eval=FALSE----------------------------------------------
# summary(chile_eng)
# summary(chile_dir)

## ----chile-anova--------------------------------------------------------------
Anova(chile_eng)
Anova(chile_dir)

## ----chile-aic----------------------------------------------------------------
data.frame(
  model   = c("Multinomial", "Engagement tree", "Direction tree"),
  logLik  = c(logLik(chile_multi), logLik(chile_eng), logLik(chile_dir)),
  AIC     = c(AIC(chile_multi),    AIC(chile_eng),    AIC(chile_dir))
)

## ----chile-rsq-eng------------------------------------------------------------
RSQ(chile_eng, include = c("AIC", "n"))

## ----chile-rsq-dir------------------------------------------------------------
RSQ(chile_dir, include = c("AIC", "n"))

## ----chile-newdata------------------------------------------------------------
new_chile <- data.frame(
  statusquo = seq(-1.5, 1.5, by = 0.25),
  age       = median(chile$age,    na.rm = TRUE),
  sex       = factor("F",  levels = levels(chile$sex)),
  education = factor("S",  levels = levels(chile$education)),
  income    = median(chile$income, na.rm = TRUE)
)

## ----chile-predict------------------------------------------------------------
pred_eng <- as.data.frame(predict(chile_eng, newdata = new_chile))
pred_dir <- as.data.frame(predict(chile_dir, newdata = new_chile))

## ----chile-plot, fig.height=5, fig.width=9------------------------------------
# as.data.frame() returns long format: one row per (observation × response level)
# with predictor columns, plus 'response', 'p', 'se.p', 'logit', 'se.logit'
pred_long <- rbind(
  transform(pred_eng, model = "Engagement-first tree"),
  transform(pred_dir, model = "Direction-first tree")
)

ggplot(pred_long, aes(x = statusquo, y = p, colour = response, fill = response)) +
  geom_ribbon(aes(ymin = pmax(0, p - 1.96 * se.p),
                  ymax = pmin(1, p + 1.96 * se.p)),
              alpha = 0.15, colour = NA) +
  geom_line(linewidth = 1.2) +
  geom_point(color = "blacK") +
  facet_wrap(~ model) +
  labs(x      = "Attitude toward status quo",
       y      = "Predicted probability",
       colour = "Vote", fill = "Vote",
       title  = "Chile 1988: predicted vote probabilities by tree structure") +
  theme_bw()

## ----chile-plot-logit, fig.height=5, fig.width=6------------------------------
# Logit-scale plot using the new scale= argument
plot(chile_eng, "statusquo",
     others = list(age       = median(chile$age, na.rm = TRUE),
                   sex       = "F",
                   education = "S",
                   income    = median(chile$income, na.rm = TRUE)),
     scale  = "logit",
     xlab   = "Attitude toward status quo",
     main   = "Engagement-first tree")

## ----travel-pkg, include=FALSE------------------------------------------------
have_AER <- requireNamespace("AER",   quietly = TRUE)
have_dplyr <- requireNamespace("dplyr", quietly = TRUE)

## ----travel-eval, eval=have_AER && have_dplyr---------------------------------
library(AER)
library(dplyr)
data("TravelMode", package = "AER")
str(TravelMode)

## ----travel-reshape, eval=have_AER && have_dplyr------------------------------
tm <- TravelMode |>
  filter(choice == "yes") |>
  select(mode, income, size) |>
  mutate(mode = relevel(factor(mode), ref = "car"))

table(tm$mode)

## ----travel-dichots, eval=have_AER && have_dplyr------------------------------
travel_dichots <- logits(
  pvt_pub  = dichotomy("car", public = c("air", "train", "bus")),
  air_grnd = dichotomy("air", ground = c("train", "bus")),
  tr_bus   = dichotomy("train", "bus")
)
travel_dichots

## ----travel-fit, eval=have_AER && have_dplyr----------------------------------
tm_multi  <- multinom(mode ~ income + size, data = tm, trace = FALSE)
tm_nested <- nestedLogit(mode ~ income + size,
                         dichotomies = travel_dichots,
                         data = tm)
summary(tm_nested)
Anova(tm_nested)

## ----travel-predict, eval=have_AER && have_dplyr------------------------------
new_tm <- data.frame(income = seq(10, 60, by = 10), size = 1)

# as.data.frame() returns long format; reshape to wide for comparison
pred_tm_nested_long <- as.data.frame(predict(tm_nested, newdata = new_tm))
nested_wide <- reshape(
  pred_tm_nested_long[, c("income", "size", "response", "p")],
  idvar     = c("income", "size"),
  timevar   = "response",
  direction = "wide"
)
names(nested_wide) <- sub("^p\\.", "", names(nested_wide))

pred_tm_multi <- as.data.frame(predict(tm_multi, newdata = new_tm,
                                       type = "probs"))

cat("Nested logit:\n")
cbind(income = new_tm$income, round(nested_wide[, levels(tm$mode)], 3))

cat("Multinomial logit:\n")
cbind(income = new_tm$income, round(pred_tm_multi[, levels(tm$mode)], 3))

## ----travel-aic, eval=have_AER && have_dplyr----------------------------------
data.frame(
  model  = c("Multinomial", "Nested"),
  logLik = c(logLik(tm_multi), logLik(tm_nested)),
  AIC    = c(AIC(tm_multi),    AIC(tm_nested))
)

## ----fishing-pkg, include=FALSE-----------------------------------------------
have_mlogit <- requireNamespace("mlogit", quietly = TRUE)

## ----fishing-load, eval=have_mlogit-------------------------------------------
data("Fishing", package = "mlogit")
str(Fishing)

## ----fishing-dichots, eval=have_mlogit----------------------------------------
fishing_dichots <- logits(
  shore_vessel = dichotomy(shore  = c("beach", "pier"),
                           vessel = c("boat",  "charter")),
  shore_type   = dichotomy("beach", "pier"),
  vessel_type  = dichotomy("boat",  "charter")
)
fishing_dichots
as.tree(fishing_dichots, response = "mode")

## ----fishing-fit, eval=have_mlogit--------------------------------------------
fish_nested <- nestedLogit(mode ~ income,
                           dichotomies = fishing_dichots,
                           data = Fishing)
summary(fish_nested)
Anova(fish_nested)

## ----fishing-plot, eval=have_mlogit-------------------------------------------
plot(fish_nested, x.var = "income",
     xlab  = "Monthly income (USD)",
     main  = "Fishing mode choice vs. income",
     label=TRUE, label.col="black",
     cex.lab = 1.2)

## ----arthritis-pkg, include=FALSE---------------------------------------------
have_vcd <- requireNamespace("vcd", quietly = TRUE)

## ----arthritis-load, eval=have_vcd--------------------------------------------
data("Arthritis", package = "vcd")
str(Arthritis)
table(Arthritis$Improved)

## ----arthritis-dichots, eval=have_vcd-----------------------------------------
arth_dichots <- continuationLogits(c("None", "Some", "Marked"))
arth_dichots

## ----arthritis-fit, eval=have_vcd---------------------------------------------
arth_nested <- nestedLogit(Improved ~ Treatment + Sex + Age,
                           dichotomies = arth_dichots,
                           data = Arthritis)
summary(arth_nested)
Anova(arth_nested)

## ----arthritis-plot, eval=have_vcd--------------------------------------------
plot(arth_nested, x.var = "Age",
     others = list(Treatment = "Treated", Sex = "Female"),
     xlab   = "Age",
     main   = "Arthritis: Treatment = Treated, Sex = Female")

## ----survey-load--------------------------------------------------------------
data("survey", package = "MASS")
# Drop NAs on Smoke
sv <- survey[!is.na(survey$Smoke), ]
table(sv$Smoke)

## ----smoke-dichots------------------------------------------------------------
smoke_dichots <- continuationLogits(c("Never", "Occas", "Regul", "Heavy"))
smoke_dichots

## ----smoke-fit----------------------------------------------------------------
smoke_nested <- nestedLogit(Smoke ~ Sex + Age + Exer,
                            dichotomies = smoke_dichots,
                            data = sv)
summary(smoke_nested)
Anova(smoke_nested)

## ----smoke-plot---------------------------------------------------------------
plot(smoke_nested, x.var = "Age",
     others = list(Sex = "Female", Exer = "Some"),
     xlab   = "Age",
     main   = "Smoking: Female students, some exercise")

## ----pneumo-pkg, include=FALSE------------------------------------------------
have_VGAM <- requireNamespace("VGAM", quietly = TRUE)

## ----pneumo-show, eval=have_VGAM----------------------------------------------
data("pneumo", package = "VGAM")
pneumo

## ----pneumo-fit, eval=have_VGAM-----------------------------------------------
# pneumo is aggregated; nestedLogit() needs individual-level data or
# frequency weights — requires expansion or a weighted interface.
# Placeholder: would use continuationLogits(c("normal", "mild", "severe"))

## ----session-info-------------------------------------------------------------
sessionInfo()

## ----write-bib, echo=FALSE----------------------------------------------------
pkgs <- unique(c(.to.cite, .packages()))
knitr::write_bib(pkgs, file = here::here("vignettes", "packages.bib"))

