# these are the possible Plotnik vowel codes vowelCodes <- c(1,2,3,5,6,7,11,12,21,22,41,47,61,42,62,63,72,73,82,43,53,14,24,44,54,64,74,94) vowelNames <- vector() vowelNames[1] = 'IH' # 'i' vowelNames[2] = 'EH' # 'e' vowelNames[3] = 'AE' # 'ae' vowelNames[5] = 'AA' # 'o' vowelNames[6] = 'AH' # '^' vowelNames[7] = 'UH' # 'u' vowelNames[11] = 'IYC' # 'iyC' vowelNames[12] = 'IY' # 'iy' vowelNames[21] = 'EYC' # 'eyC' vowelNames[22] = 'EY' # 'ey' vowelNames[41] = 'AYV' # 'ayV' vowelNames[47] = 'AY0' # 'ay0' vowelNames[61] = 'OY' # 'oy' vowelNames[42] = 'AW' # 'aw' vowelNames[62] = 'OWC' # 'owC' vowelNames[63] = 'OWF' # 'owF' vowelNames[72] = 'KUW' # 'Kuw' vowelNames[73] = 'TUW' # 'Tuw' vowelNames[82] = 'IW' # 'iw' vowelNames[43] = 'AAH' # 'ah' vowelNames[53] = 'AO' # 'oh' vowelNames[14] = 'IYR' # 'iyr' vowelNames[24] = 'EYR' # 'eyr' vowelNames[44] = 'AAR' # 'ahr' vowelNames[54] = 'AOR' # 'ohr' vowelNames[64] = 'OWR' # 'owr' vowelNames[74] = 'UWR' # 'uwr' vowelNames[94] = 'ER' # '*hr' vowelNamesPlotnik <- vector() vowelNamesPlotnik[1] = 'i' vowelNamesPlotnik[2] = 'e' vowelNamesPlotnik[3] = 'ae' vowelNamesPlotnik[5] = 'o' vowelNamesPlotnik[6] = '^' vowelNamesPlotnik[7] = 'u' vowelNamesPlotnik[11] = 'iyC' vowelNamesPlotnik[12] = 'iy' vowelNamesPlotnik[21] = 'eyC' vowelNamesPlotnik[22] = 'ey' vowelNamesPlotnik[41] = 'ayV' vowelNamesPlotnik[47] = 'ay0' vowelNamesPlotnik[61] = 'oy' vowelNamesPlotnik[42] = 'aw' vowelNamesPlotnik[62] = 'owC' vowelNamesPlotnik[63] = 'owF' vowelNamesPlotnik[72] = 'Kuw' vowelNamesPlotnik[73] = 'Tuw' vowelNamesPlotnik[82] = 'iw' vowelNamesPlotnik[43] = 'ah' vowelNamesPlotnik[53] = 'oh' vowelNamesPlotnik[14] = 'iyr' vowelNamesPlotnik[24] = 'eyr' vowelNamesPlotnik[44] = 'ahr' vowelNamesPlotnik[54] = 'ohr' vowelNamesPlotnik[64] = 'owr' vowelNamesPlotnik[74] = 'uwr' vowelNamesPlotnik[94] = '*hr' vowelColors <- vector() vowelColors[1] <- "lightgreen" vowelColors[11] <- "lightgreen" vowelColors[12] <- "lightgreen" vowelColors[14] <- "lightgreen" vowelColors[2] <- "gold" vowelColors[21] <- "gold" vowelColors[22] <- "gold" vowelColors[6] <- "gold" vowelColors[24] <- "gold" vowelColors[3] <- "red" vowelColors[44] <- "red" vowelColors[45] <- "red" vowelColors[43] <- "red" vowelColors[5] <- "magenta" vowelColors[7] <- "skyblue" vowelColors[41] <- "green" vowelColors[42] <- "darkgreen" vowelColors[53] <- "pink" vowelColors[61] <- "gray" vowelColors[62] <- "blue" vowelColors[63] <- "blue" vowelColors[72] <- "lightblue" get_color <- function(code) { if (code==1 || code==11 || code==12 || code == 14) { color <- "lightgreen" } else if (code==2 || code==21 || code==22 || code==6 || code == 24) { color <- "gold" } else if (code==44 || code==45 || code == 43) { color <- "red" } else if (code == 7) { color <- "skyblue" } else if (code == 41) { color <- "green" } else if (code == 42) { color <- "darkgreen" } else if (code==62 || code==63) { color <- "blue" } else if (code==61) { color <- "gray" } else if (code == 72) { color <- "lightblue" } else { color <- "black" } return(color) } get_pch <- function(code) { if (code==3 || code==5) { pch <- 22 } else if (code == 14) { pch <- 10 } else if (code == 41 || code == 47 || code==53) { pch <- 25 } else if (code == 44) { pch <- 3 } else if (code==62 || code==63 || code==61) { pch <- 23 } else if (code == 6 || code == 42) { pch <- 17 } else if (code == 2) { pch <- 18 } else if (code == 43) { pch <- 4 } else if (code == 72 || code == 73) { pch <- 21 } else if (code == 64) { pch <- 10 } else if (code == 74) { pch <- 9 } else if (code == 94) { pch <- 12 } # by default, draw a filled circle else { pch <- 19 } return(pch) } get_bg <- function(code) { if (code==53) { bg <- "pink" } else if (code == 3 | code == 43) { bg <- "red" } else if (code == 1 | code == 11 | code == 12 | code == 14) { bg <- "lightgreen" } else if (code == 5) { bg <- "magenta" } else if (code == 41 || code == 47) { bg <- "green" } else if (code == 42) { bg <- "darkgreen" } else if (code==61) { bg <- "gray" } else if (code==2 || code==21 || code==22 || code==6 || code == 24 | code == 94) { bg <- "gold" } else if (code == 62 || code == 63 || code==54) { bg <- "blue" } else if (code == 7) { bg <- "skyblue" } else if (code == 72 || code == 73) { bg <- "lightblue" } else { bg <- "black" } return(bg) } clearPlot <- function() { plot(0, 0, xlab="F2", ylab="F1", ylim=c(1100, 350), xlim=c(2600, 550)) } plotTokens <- function(cd, f1, f2, labels) { pch <- get_pch(cd) color <- get_color(cd) bg <- get_bg(cd) points(f2, f1, col=color, pch=pch, bg=bg) text(f2, f1, labels, pos='4', cex=0.6) # text(f2, f1, labels, pos='4') } plotVowel <- function(v, cd, zoom=F, label=T, f1min.override=NA, f1max.override=NA, f2min.override=NA, f2max.override=NA) { v <- v[v$str==1,] if (zoom) { f1min <- min(v$f1[v$cd==cd]) f1max <- max(v$f1[v$cd==cd]) f2min <- min(v$f2[v$cd==cd]) f2max <- max(v$f2[v$cd==cd]) } else { f1min <- min(v$f1) f1max <- max(v$f1) f2min <- min(v$f2) f2max <- max(v$f2) } if (!is.na(f1min.override)) { f1min <- f1min.override } if (!is.na(f1max.override)) { f1max <- f1max.override } if (!is.na(f2min.override)) { f2min <- f2min.override } if (!is.na(f2max.override)) { f2max <- f2max.override } pad <- 50 plot(0, 0, xlab="F2", ylab="F1", ylim=c(f1max+pad, f1min-pad), xlim=c(f2max+pad, f2min-pad)) f1 <- v$f1[v$cd==cd] f2 <- v$f2[v$cd==cd] if (label) { labs <- v$wd[v$cd==cd] } else { labs <- rep('', length(f1)) } plotTokens(cd, f1, f2, labels=labs) } plotVowels <- function(v, codes, zoom=F, label=F, legend=T, f1min.override=NA, f1max.override=NA, f2min.override=NA, f2max.override=NA) { # these are for the non-zoom case, will be overwritten later if zoom is T f1min <- min(v$f1) f1max <- max(v$f1) f2min <- min(v$f2) f2max <- max(v$f2) if (codes[1] != "all") { v <- v[v$str==1 & v$cd %in% codes,] } if (zoom) { f1min <- min(v$f1[v$cd %in% codes]) f1max <- max(v$f1[v$cd %in% codes]) f2min <- min(v$f2[v$cd %in% codes]) f2max <- max(v$f2[v$cd %in% codes]) } if (!is.na(f1min.override)) { f1min <- f1min.override } if (!is.na(f1max.override)) { f1max <- f1max.override } if (!is.na(f2min.override)) { f2min <- f2min.override } if (!is.na(f2max.override)) { f2max <- f2max.override } pad <- 50 plot(0, 0, xlab="F2", ylab="F1", ylim=c(f1max+pad, f1min-pad), xlim=c(f2max+pad, f2min-pad)) # plot the entire vowel chart for a speaker if (codes[1] == "all") { for (cd in c(1,2,3,5,6,7,11,12,21,22,41,47,61,42,62,63,72,73,82,43,53,14,24,44,54,64,74,94)) { # if there are no tokens of this vowel for this speaker, then skip it if (nrow(v[v$cd==cd,]) == 0) { cat("Skipping: ", cd, " (no tokens)\n") next } cat("Plotting: ", cd, "\n") f1 <- v$f1[v$cd==cd] f2 <- v$f2[v$cd==cd] if (label) { labs <- v$wd[v$cd==cd] } else { labs <- rep('', length(f1)) } plotTokens(cd, f1, f2, labels=labs) } } # plot only those vowels specified by the user else { for (cd in codes) { f1 <- v$f1[v$cd==cd] f2 <- v$f2[v$cd==cd] if (label) { labs <- v$wd[v$cd==cd] } else { labs <- rep('', length(f1)) } plotTokens(cd, f1, f2, labels=labs) } } if (legend) { # legend("bottomright", c("/o/", "/oh/"), pch=c(15, 25), pt.bg=c("magenta", "pink"), col=c("magenta", "pink"), cex=1.5) pchValues <- array() bgValues <- array() colorValues <- array() labelValues <-array() for (i in 1:length(codes)) { pchValues[i] <- get_pch(codes[i]) bgValues[i] <- get_bg(codes[i]) colorValues[i] <- get_color(codes[i]) labelValues[i] <- paste('/', vowelNamesPlotnik[codes[i]], '/', sep='') } legend("bottomright", labelValues, pch=pchValues, pt.bg=bgValues, col=colorValues, cex=1.5) } } # returns mean F1 and F2 values plotnikMean <- function(v, cd) { # use only the vowels that have the specified code v <- v[v$cd==cd,] # only calculate the mean from tokens with primary stress v <- v[v$str==1,] # exclude the following environments from the means calculations: # 1) /w/, /y/ onset # 2) /l/, /r/ coda # 3) /KR/ onset # 4) /n/ coda for /i/, /e/, /ae/, and /aw/ if (cd %in% c(1,2,3,42)) { f1 <- mean(v$f1[v$ps != 8 & v$ps != 9 & v$fm != 5 & v$fm != 6 & v$fm != 4]) f2 <- mean(v$f2[v$ps != 8 & v$ps != 9 & v$fm != 5 & v$fm != 6 & v$fm != 4]) } else { f1 <- mean(v$f1[v$ps != 8 & v$ps != 9 & v$fm != 5 & v$fm != 6]) f2 <- mean(v$f2[v$ps != 8 & v$ps != 9 & v$fm != 5 & v$fm != 6]) } means <- list(f1Mean = f1, f2Mean = f2) } plotMean <- function(v, cd) { # display the mean symbol as a circle with a black outline and the fill color corresponding to the color for the vowel tokens bg <- get_bg(cd) pch <- 21 color <- 'black' means <- plotnikMean(v, cd) print(means$f1Mean) print(means$f2Mean) points(means$f2Mean, means$f1Mean, col=color, pch=pch, bg=bg, cex=4) text(means$f2Mean, means$f1Mean, labels=vowelNamesPlotnik[cd]) } plotMeans <- function(v, codes) { if (codes[1]=="all") { for (cd in c(1,2,3,5,6,7,11,12,21,22,41,47,61,42,62,63,72,73,82,43,53,14,24,44,54,64,74,94)) { plotMean(v, cd) } } else { for (cd in codes) { plotMean(v, cd) } } }