library(tidyverse)
library(magrittr)
library(vcd)
library(vcdExtra)
library(effects)
library(ca)
library(nnet)

Exercise 8.3

The TV dataset is a large sample of TV viewers whose behavior had been recorded for the Neilsen ratings. This data set contains sample television audience data from Neilsen Media Research for the week starting November 6, 1995.

data("TV", package = "vcdExtra")
TV.df <- as.data.frame.table(TV)
  1. Collapse the TV data to a 5x3 two-way table (ignore the effect of time) whereas the rows are the days of the week and the columns are networks.

Treating Network as a three-level response variable, fit a generalized logit model to explain the variation in viewing in relation to Day and Time. The TV data is a three-way table, so you will need to convert it to a frequency data frame first.

TV.table <- xtabs(Freq ~ Day + Network, data = TV.df)
  1. Fit the main-effects model, Network ~ Day + Time, with multinom (). Note that you will have to supply the weights argument because each row of TV.df represents the number of viewers in the Freq variable.
TV.multinom <- multinom(Network ~ Day + Time, data = TV.df, weights = Freq, Hess = TRUE)
## # weights:  48 (30 variable)
## initial  value 41318.808177 
## iter  10 value 38935.947713
## iter  20 value 38818.222728
## iter  30 value 38756.956301
## final  value 38752.186202 
## converged
summary(TV.multinom)
## Call:
## multinom(formula = Network ~ Day + Time, data = TV.df, weights = Freq, 
##     Hess = TRUE)
## 
## Coefficients:
##     (Intercept) DayTuesday DayWednesday DayThursday  DayFriday   Time8:15
## CBS 0.264060911 -0.2839729  -0.66995721  -0.3236498 -0.6728270 0.07101115
## NBC 0.005020656 -0.1156021  -0.01887989   1.2724501 -0.2496648 0.03790697
##        Time8:30    Time8:45   Time9:00   Time9:15   Time9:30   Time9:45
## CBS 0.076997762 -0.29429040 -0.4875213 -0.3664838 -0.4409308 -0.2440312
## NBC 0.006827139 -0.09320663 -0.2106409 -0.2609636 -0.3416990 -0.1617936
##       Time10:00  Time10:15  Time10:30
## CBS -0.29940481 -0.2677118 -0.2239947
## NBC -0.02609353  0.0566143  0.1358038
## 
## Std. Errors:
##     (Intercept) DayTuesday DayWednesday DayThursday  DayFriday   Time8:15
## CBS  0.04983795 0.03797920   0.04355769  0.04501328 0.04192254 0.06398208
## NBC  0.04832104 0.03808235   0.04004444  0.03845629 0.04015187 0.06059674
##       Time8:30   Time8:45   Time9:00   Time9:15   Time9:30   Time9:45
## CBS 0.06204563 0.06958338 0.06154875 0.06229549 0.06164592 0.06774630
## NBC 0.05898492 0.06314121 0.05595830 0.05782973 0.05724928 0.06371518
##      Time10:00  Time10:15  Time10:30
## CBS 0.06242284 0.06296253 0.06277900
## NBC 0.05700440 0.05711720 0.05687154
## 
## Residual Deviance: 77504.37 
## AIC: 77564.37
  1. Prepare an effects plot for the fitted probabilities in this model.
plot(Effect(c("Day", "Time"), TV.multinom), style= "lines", key.args= list(x= 0.05, y= .9))

  1. Interpret these results in comparison to the correspondence analysis in part(a).
TV.ca <- ca(TV.table)
plot(TV.ca)

From the corrspondence analysis we can see that people CBS more on Modays and Tuesdays, watch ABC more on Wednesdays and Fridays, watch more NBC on Thursdays