# Create_Figs3_4-5_Dec2020.R
# R Script accompanying _Sociophonetics_ by Tyler Kendall & Valerie Fridland
# Tyler Kendall & Valerie Fridland, 2020 (CC BY 4.0)
# 
# This simple script recreates Figure 3.2 in the book. In addition to recreating
#  the figure, it is meant as an example for using Vowels.R for vowel plotting.
#

# Install the vowels.R library if you do not have it installed already
# e.g. > install.packages("vowels", dependencies=T)
library(vowels)

# Set up graphical defaults, so it is easy to reset to the initial settings later
par(bg="white")
defaults<-par(no.readonly=TRUE)

# Set the path to the input file, which you can obtain from the _Sociophonetics_ 
#  website
path.to.file <- "~/Documents/Fig3.4-5-data_Brittany+Andrew.txt"

# Read in the data
input <- read.delim(path.to.file, header=TRUE)

# Add a new column with the IPA characters for the VowelCat
#  Note: This requires that the list of IPA characters matches the VowelCats, so
#  you will want to check this if you make any changes to the file
input$IPA <- as.factor(input$VowelCat)
levels(input$IPA) # Check the levels before replacing with a list of IPA characters
levels(input$IPA) <- c("æ", "æ", "e", "el", "e", "æN", "æ", "i", "i", "ɛ", "ɛ", "ɪ", "ɑɪD", "ɪ", "ɑɪT", "o", "u", "ɑ", "ɔ", "ɑw", "ol", "ʌ", "ɔl", "ɑl", "ɑɪl", "æl", "ʊ", "ul")

# Reorder the columns so that the new IPA column is in 2nd position
input <- input[, c(1, 14, 3:9, 2, 10:13)]

# You can check this:
head(input)

# For plotting raw, unnormalized data (Figure 3.4):

# Now pull out the two speakers into new data.frames - this allows us to modify
#  those further for plotting without changing the main data.frame anymore.
sp1 <- input[input$Speaker=="Brittany", ]
sp2 <- input[input$Speaker=="Andrew", ]

# Remove some of the less important categories
sp1 <- droplevels(sp1[-which(sp1$IPA %in% c("el", "ɛl", "ɪl", "ʌl", "ʌN", "ɔl", "ɑl", "ɑɪl", "æl", "il")),])
sp2 <- droplevels(sp2[-which(sp2$IPA %in% c("el", "ɛl", "ɪl", "ʌl", "ʌN", "ɔl", "ɑl", "ɑɪl", "æl", "il")),])

# Use Vowels.R to generate means for the first speaker
msp1 <- compute.means(sp1[,1:9])

# Trim from the individual tokens cases with 2 or fewer tokens
sp1 <- droplevels(sp1[sp1$IPA %in% msp1$Vowel[msp1$N > 2],])

# Repeat for the second speaker
msp2 <- compute.means(sp2[,1:9])
sp2 <- droplevels(sp2[sp2$IPA %in% msp2$Vowel[msp2$N > 2],])

# Set up plotting space
par(mai=c(0.6, 0.6, 0.2, 0.2), family="Helvetica")
par(mfrow=c(1,2))

# Use vowelplot to first set up the plotting space, but just print in white at first
vowelplot(msp1, color="vowels", color.choice="white", title=unique(sp1$Speaker), label="vowels", leg=NA, xlim=c(3500, 500), ylim=c(1200, 300))
# Now add gray ellipses
add.spread.vowelplot(sp1[order(sp1$Vowel),1:9], ellipsis=TRUE, sd.mult=1, color="vowels", color.choice="darkgray")
# Now, using regular text() function to add text to a plot, add the IPA characters
text(msp1[,5], msp1[,4], msp1[,2], col="black")

# Repeat for speaker 2
vowelplot(msp2, color="vowels", color.choice="white", title=unique(sp2$Speaker), label="vowels", leg=NA, xlim=c(3500, 500), ylim=c(1200, 300))
add.spread.vowelplot(sp2[order(sp2$Vowel),1:9], ellipsis=TRUE, sd.mult=1, color="vowels", color.choice="darkgray")
text(msp2[,5], msp2[,4], msp2[,2], col="black")

# Return settings to their defaults
par(defaults)


# For plotting normalized data (Figure 3.5):

# First normalize the vowels, using Lobanov method:
normd <- norm.lobanov(input)

# Now pull out the two speakers into new data.frames - this allows us to modify
#  those further for plotting without changing the main data.frame anymore.
nsp1 <- normd[normd$Speaker=="Brittany", ]
nsp2 <- normd[normd$Speaker=="Andrew", ]

# Remove some of the less important categories
nsp1 <- droplevels(nsp1[-which(nsp1$Vowel %in% c("el", "ɛl", "ɪl", "ʌl", "ʌN", "ɔl", "ɑl", "ɑɪl", "æl", "il")),])
nsp2 <- droplevels(nsp2[-which(nsp2$Vowel %in% c("el", "ɛl", "ɪl", "ʌl", "ʌN", "ɔl", "ɑl", "ɑɪl", "æl", "il")),])

# Use Vowels.R to generate means for the first speaker
mnsp1 <- compute.means(nsp1)

# Trim from the individual tokens cases with 2 or fewer tokens
nsp1 <- droplevels(nsp1[nsp1$Vowel %in% mnsp1$Vowel[mnsp1$N > 2],])

# Repeat for the second nspeaker
mnsp2 <- compute.means(nsp2)
nsp2 <- droplevels(nsp2[nsp2$Vowel %in% mnsp2$Vowel[mnsp2$N > 2],])

# Set up plotting space
par(mai=c(0.6, 0.6, 0.2, 0.2), family="Helvetica")
par(mfrow=c(1,2))

# Use vowelplot to first set up the plotting space, but just print in white at first
vowelplot(mnsp1, color="vowels", color.choice="white", title=unique(nsp1$Speaker), label="vowels", leg=NA, xlim=c(2, -2), ylim=c(2, -2))
# Now add gray ellipses
add.spread.vowelplot(nsp1[order(nsp1$Vowel),], ellipsis=TRUE, sd.mult=1, color="vowels", color.choice="darkgray")
# Now, using regular text() function to add text to a plot, add the IPA characters
text(mnsp1[,5], mnsp1[,4], mnsp1[,2], col="black")

# Repeat for speaker 2
vowelplot(mnsp2, color="vowels", color.choice="white", title=unique(nsp2$Speaker), label="vowels", leg=NA, xlim=c(2, -2), ylim=c(2, -2))
add.spread.vowelplot(nsp2[order(nsp2$Vowel),], ellipsis=TRUE, sd.mult=1, color="vowels", color.choice="darkgray")
text(mnsp2[,5], mnsp2[,4], mnsp2[,2], col="black")

# Return settings to their defaults
par(defaults)