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.

library("dplyr")
## Warning: package 'dplyr' was built under R version 3.4.3
## 
## Attaching package: 'dplyr'
## The following objects are masked from 'package:stats':
## 
##     filter, lag
## The following objects are masked from 'package:base':
## 
##     intersect, setdiff, setequal, union
library("reshape2")
## Warning: package 'reshape2' was built under R version 3.4.3
library("nnet")
## Warning: package 'nnet' was built under R version 3.4.4
library("effects")
## Warning: package 'effects' was built under R version 3.4.4
## Loading required package: carData
## lattice theme set by effectsTheme()
## See ?effectsTheme for details.
library("ca")
## Warning: package 'ca' was built under R version 3.4.4
data("TV",package="vcdExtra")
str(TV)
##  int [1:5, 1:11, 1:3] 146 244 233 174 294 151 181 161 183 281 ...
##  - attr(*, "dimnames")=List of 3
##   ..$ Day    : chr [1:5] "Monday" "Tuesday" "Wednesday" "Thursday" ...
##   ..$ Time   : chr [1:11] "8:00" "8:15" "8:30" "8:45" ...
##   ..$ Network: chr [1:3] "ABC" "CBS" "NBC"
TV
## , , Network = ABC
## 
##            Time
## Day         8:00 8:15 8:30 8:45 9:00 9:15 9:30 9:45 10:00 10:15 10:30
##   Monday     146  151  156   83  325  350  386  340   352   280   278
##   Tuesday    244  181  231  205  385  283  345  192   329   351   364
##   Wednesday  233  161  194  156  339  264  279  140   237   228   203
##   Thursday   174  183  197  181  187  198  211   86   110   122   117
##   Friday     294  281  305  239  278  246  245  138   246   232   233
## 
## , , Network = CBS
## 
##            Time
## Day         8:00 8:15 8:30 8:45 9:00 9:15 9:30 9:45 10:00 10:15 10:30
##   Monday     337  293  304  233  311  251  241  164   252   265   272
##   Tuesday    173  180  184  109  218  235  256  250   274   263   261
##   Wednesday  158  126  207   59   98  103  122   86   109   105   110
##   Thursday   196  185  195  104  106  116  116   47   102    84    84
##   Friday     130  144  154   81  129  153  136  126   138   136   152
## 
## , , Network = NBC
## 
##            Time
## Day         8:00 8:15 8:30 8:45 9:00 9:15 9:30 9:45 10:00 10:15 10:30
##   Monday     263  219  236  140  226  235  239  246   279   263   283
##   Tuesday    315  254  280  241  370  214  195  111   188   190   210
##   Wednesday  134  146  166   66  194  230  264  143   274   289   306
##   Thursday   515  463  472  477  590  473  446  349   649   705   747
##   Friday     195  220  248  160  172  164  169   85   183   198   204
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.
tv.table2way<-xtabs(Freq~Day+Network, data=TV.df)
tv.table2way
##            Network
## Day          ABC  CBS  NBC
##   Monday    2847 2923 2629
##   Tuesday   3110 2403 2568
##   Wednesday 2434 1283 2212
##   Thursday  1766 1335 5886
##   Friday    2737 1479 1998
  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

??? (c) 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=0.9))

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

From the plot we can see that On Mondays(and Tuesdays with a smaller probability), people are more likely to watch CBS; On Wednesdays and Fridays, people are more likely to ABC; On Thursdays, people are more likely to watch NBC. This plot in part C indicated the same general tendencies.