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

# save some typing
knitr::set_alias(w = "fig.width",
                 h = "fig.height",
                 cap = "fig.cap")

# Old Sweave options
# \SweaveOpts{engine=R,eps=TRUE,height=6,width=7,results=hide,fig=FALSE,echo=TRUE}
# \SweaveOpts{engine=R,height=6,width=7,results=hide,fig=FALSE,echo=TRUE}
# \SweaveOpts{prefix.string=fig/vcd-tut,eps=FALSE}
# \SweaveOpts{keep.source=TRUE}


# preload datasets ???
set.seed(1071)
library(vcd)
library(vcdExtra)
library(ggplot2)
data(HairEyeColor)
data(PreSex)
data(Arthritis, package="vcd")
art <- xtabs(~Treatment + Improved, data = Arthritis)
#if(!file.exists("fig")) dir.create("fig")


## ----case-form----------------------------------------------------------------
names(Arthritis)      # show the variables

str(Arthritis)        # show the structure

head(Arthritis,5)     # first 5 observations, same as Arthritis[1:5,] 

## ----frequency-form-----------------------------------------------------------
# Agresti (2002), table 3.11, p. 106
GSS <- data.frame(
  expand.grid(sex = c("female", "male"), 
              party = c("dem", "indep", "rep")),
  count = c(279,165,73,47,225,191))

GSS
names(GSS)
str(GSS)

sum(GSS$count)

## ----table-form1--------------------------------------------------------------
str(HairEyeColor)                      # show the structure

sum(HairEyeColor)                      # number of cases

sapply(dimnames(HairEyeColor), length) # table dimension sizes

## ----table-form2--------------------------------------------------------------
# A 4 x 4 table  Agresti (2002, Table 2.8, p. 57) Job Satisfaction
JobSat <- matrix(c( 1, 2, 1, 0, 
                    3, 3, 6, 1, 
                   10,10,14, 9, 
                    6, 7,12,11), 4, 4)

dimnames(JobSat) = list(
  income = c("< 15k", "15-25k", "25-40k", "> 40k"),
  satisfaction = c("VeryD", "LittleD", "ModerateS", "VeryS")
  )

JobSat

## ----table-form3--------------------------------------------------------------
JobSat <- as.table(JobSat)
str(JobSat)

## ----relevel, eval=FALSE------------------------------------------------------
# dimnames(JobSat)$income <- c(7.5,20,32.5,60)
# dimnames(JobSat)$satisfaction <- 1:4

## ----reorder1-----------------------------------------------------------------
HairEyeColor <- HairEyeColor[, c(1,3,4,2), ]
str(HairEyeColor)

## ----reorder2, echo=TRUE, eval=FALSE------------------------------------------
# Arthritis <- read.csv("arthritis.txt",header=TRUE)
# Arthritis$Improved <- ordered(Arthritis$Improved,
#                               levels=c("None", "Some", "Marked")
#                               )

## -----------------------------------------------------------------------------
data(Arthritis, package="vcd")
art <- xtabs(~Treatment + Improved, data = Arthritis)
mosaic(art, gp = shading_max, split_vertical = TRUE, main="Arthritis: [Treatment] [Improved]")

## ----reorder3-----------------------------------------------------------------
UCB <- aperm(UCBAdmissions, c(2, 1, 3))
dimnames(UCB)[[2]] <- c("Yes", "No")
names(dimnames(UCB)) <- c("Sex", "Admit?", "Department")

# display as a flattened table
stats::ftable(UCB)

## ----structable---------------------------------------------------------------
structable(HairEyeColor)                   # show the table: default

structable(Hair+Sex ~ Eye, HairEyeColor)   # specify col ~ row variables

## ----structable1,eval=FALSE---------------------------------------------------
# HSE < - structable(Hair+Sex ~ Eye, HairEyeColor)   # save structable object
# mosaic(HSE)                                        # plot it

## ----table-setup--------------------------------------------------------------
 n=500
 A <- factor(sample(c("a1","a2"), n, rep=TRUE))
 B <- factor(sample(c("b1","b2"), n, rep=TRUE))
 C <- factor(sample(c("c1","c2"), n, rep=TRUE))
 mydata <- data.frame(A,B,C)

## ----table-ex1----------------------------------------------------------------
# 2-Way Frequency Table
attach(mydata)
mytable <- table(A,B)   # A will be rows, B will be columns
mytable                 # print table

margin.table(mytable, 1) # A frequencies (summed over B)
margin.table(mytable, 2) # B frequencies (summed over A)

prop.table(mytable)    # cell percentages
prop.table(mytable, 1) # row percentages
prop.table(mytable, 2) # column percentages

## ----table-ex2----------------------------------------------------------------
# 3-Way Frequency Table
mytable <- table(A, B, C)
ftable(mytable)

## ----xtabs-ex1----------------------------------------------------------------
# 3-Way Frequency Table
mytable <- xtabs(~A+B+C, data=mydata)

ftable(mytable)    # print table

summary(mytable)   # chi-square test of indepedence

## ----xtabs-ex2----------------------------------------------------------------
(GSStab <- xtabs(count ~ sex + party, data=GSS))

summary(GSStab)

## ----dayton1------------------------------------------------------------------
data("DaytonSurvey", package="vcdExtra")
str(DaytonSurvey)
head(DaytonSurvey)

## ----dayton2------------------------------------------------------------------
# data in frequency form
# collapse over sex and race
Dayton.ACM.df <- aggregate(Freq ~ cigarette+alcohol+marijuana, 
                           data=DaytonSurvey, 
                           FUN=sum)
Dayton.ACM.df

## ----dayton3------------------------------------------------------------------
# in table form
Dayton.tab <- xtabs(Freq ~ cigarette+alcohol+marijuana+sex+race, 
                    data=DaytonSurvey)
structable(cigarette+alcohol+marijuana ~ sex+race, 
           data=Dayton.tab)

## ----dayton4------------------------------------------------------------------
# collapse over sex and race
Dayton.ACM.tab <- apply(Dayton.tab, MARGIN=1:3, FUN=sum)
Dayton.ACM.tab <- margin.table(Dayton.tab, 1:3)   # same result

structable(cigarette+alcohol ~ marijuana, data=Dayton.ACM.tab)

## ----dayton5------------------------------------------------------------------
library(plyr)
Dayton.ACM.df <- plyr::ddply(DaytonSurvey, 
                             .(cigarette, alcohol, marijuana), 
                             plyr::summarise, Freq=sum(Freq))

Dayton.ACM.df

## ----collapse1----------------------------------------------------------------
# create some sample data in frequency form
sex <- c("Male", "Female")
age <- c("10-19", "20-29",  "30-39", "40-49", "50-59", "60-69")
education <- c("low", 'med', 'high')
data <- expand.grid(sex=sex, age=age, education=education)
counts <- rpois(36, 100)   # random Possion cell frequencies
data <- cbind(data, counts)

# make it into a 3-way table
t1 <- xtabs(counts ~ sex + age + education, data=data)
structable(t1)

## ----collapse2----------------------------------------------------------------
# collapse age to 3 levels, education to 2 levels
t2 <- collapse.table(t1, 
         age=c("10-29", "10-29",  "30-49", "30-49", "50-69", "50-69"),
         education=c("<high", "<high", "high"))
structable(t2)

## ----titanicSAVE, include=FALSE, echo=FALSE-----------------------------------
# Save unmodified Titanicp data for collapse_levels() example
saveDat <- Titanicp

## ----titanicp1----------------------------------------------------------------
table(Titanicp$sibsp, Titanicp$parch)

## ----titanicp2----------------------------------------------------------------
library(dplyr)
Titanicp <- Titanicp |>
  mutate(sibspF = case_match(sibsp,
                            0 ~ "0",
                            1 ~ "1",
                            2:max(sibsp) ~ "2+")) |>
  mutate(sibspF = ordered(sibspF)) |>
  mutate(parchF = case_match(parch,
                             0 ~ "0",
                             1 ~ "1",
                             2:max(parch) ~ "2+")) |>
  mutate(parchF = ordered(parchF)) 

table(Titanicp$sibspF, Titanicp$parchF)

## ----titanicLOAD, include=FALSE, echo=FALSE-----------------------------------
# Load unmodified Titanicp data for collapse_levels() example
Titanicp <- saveDat

## ----collapse_level-ex1-------------------------------------------------------
str(Titanicp) # The original dataset

Titanicp <- within(Titanicp, {
  parchF <- factor(parch)
  sibspF <- factor(sibsp)
})

Titanicp <- collapse_levels(
  Titanicp,
  parchF = list(
    "2+" = c("2", "3", "4", "5", "6", "9")
  ),
  sibspF = list(
    "2+" = c("2", "3", "4", "5", "8")
  )
)

table(Titanicp$sibspF, Titanicp$parchF)

## ----convert-ex1--------------------------------------------------------------
as.data.frame(GSStab)

## ----convert-ex2--------------------------------------------------------------
Art.tab <- with(Arthritis, table(Treatment, Sex, Improved))
str(Art.tab)

ftable(Art.tab)

## ----convert-ex3--------------------------------------------------------------
Art.df <- expand.dft(Art.tab)
str(Art.df)

## ----tidyconvert-ex1----------------------------------------------------------
# tidy = TRUE (default) returns a tibble
GSS.ff <- as_freqform(GSStab, tidy = FALSE)
GSS.ff

## ----tidyconvert-ex2----------------------------------------------------------
as_table(GSS.ff, freq = "Freq") # When present, freq column must be specified

## ----tidyconvert-ex3----------------------------------------------------------
tidy_Art.tab <- as_table(Arthritis, dims = c("Treatment", "Sex", "Improved"))
str(tidy_Art.tab)

ftable(tidy_Art.tab)

## ----tidyconvert-ex4----------------------------------------------------------
tidy_Art.df <- as_caseform(tidy_Art.tab, tidy = FALSE)
str(tidy_Art.df)

## ----tv1----------------------------------------------------------------------
tv.data<-read.table(system.file("extdata","tv.dat", package="vcdExtra"))
head(tv.data,5)

## ----tv2,eval=FALSE-----------------------------------------------------------
# tv.data<-read.table("C:/R/data/tv.dat")

## ----tv3----------------------------------------------------------------------
TV <- array(tv.data[,5], dim=c(5,11,5,3))                                        
dimnames(TV) <- list(c("Monday","Tuesday","Wednesday","Thursday","Friday"), 
                     c("8:00","8:15","8:30","8:45","9:00","9:15","9:30",         
                       "9:45","10:00","10:15","10:30"),                            
                     c("ABC","CBS","NBC","Fox","Other"), 
                     c("Off","Switch","Persist"))

names(dimnames(TV))<-c("Day", "Time", "Network", "State")

## ----tv3a,eval=FALSE----------------------------------------------------------
# TV <- xtabs(V5 ~ ., data=tv.data)
# dimnames(TV) <- list(Day = c("Monday","Tuesday","Wednesday","Thursday","Friday"),
#                      Time = c("8:00","8:15","8:30","8:45","9:00","9:15","9:30",
#                               "9:45","10:00","10:15","10:30"),
#                      Network = c("ABC","CBS","NBC","Fox","Other"),
#                      State = c("Off","Switch","Persist"))
# 
# # table dimensions
# dim(TV)

## ----tv4----------------------------------------------------------------------
TV2 <- TV[,,1:3,]      # keep only ABC, CBS, NBC
TV2 <- TV2[,,,3]       # keep only Persist -- now a 3 way table
structable(TV2)

## ----tv5----------------------------------------------------------------------
TV.df <- as.data.frame.table(TV2)
levels(TV.df$Time) <- c(rep("8:00", 2),
                        rep("8:30", 2),
                        rep("9:00", 2), 
                        rep("9:30", 2), 
                        rep("10:00",2),
                            "10:30"
                        )

TV3 <- xtabs(Freq ~ Day + Time + Network, TV.df)

structable(Day ~ Time+Network, TV3)

## ----tv-mosaic1, fig.height=6, fig.width=7------------------------------------
mosaic(TV3, shade = TRUE,
       labeling = labeling_border(rot_labels = c(0, 0, 0, 90)))

