From 494dd60175f25bd7798b8494524e3b75afbff9f3 Mon Sep 17 00:00:00 2001
From: Daniel McCloy <dan.mccloy@gmail.com>
Date: Sun, 22 Nov 2015 11:32:13 -0800
Subject: [PATCH 01/11] fix: allow linetype etc for diphthong lines

---
 R/phonR.R | 71 +++++++++++++++++++++++++++++++++++++++++--------------
 1 file changed, 53 insertions(+), 18 deletions(-)

diff --git a/R/phonR.R b/R/phonR.R
index 28cfef1..da28382 100644
--- a/R/phonR.R
+++ b/R/phonR.R
@@ -1,5 +1,5 @@
 ## ## ## ## ## ## ## ## ## ## ## ## ## ## ## ## ## ## ## ## ## ## ## ##
-## phonR version 1.0-6
+## phonR version 1.0-7
 ## Functions for phoneticians and phonologists
 ## AUTHOR: Daniel McCloy, drmccloy@uw.edu
 ## LICENSED UNDER THE GNU GENERAL PUBLIC LICENSE v3.0:
@@ -446,6 +446,7 @@ plotVowels <- function(f1, f2, vowel=NULL, group=NULL,
                     hull.line.col=hull.line.col,
                     hull.line.sty=hull.line.sty,
                     pchmeans=pchm, pchtokens=pcht,
+                    #diph.args.tokens=as.data.frame(diph.args.tokens),
                     stringsAsFactors=FALSE)
     if (diphthong) {
         d$f2d <- lapply(apply(f2d, 1, list), unlist, use.names=FALSE)
@@ -459,6 +460,7 @@ plotVowels <- function(f1, f2, vowel=NULL, group=NULL,
     ## dataframe of means
     m <- lapply(byd, function(i) {
         if (!is.null(i)) {
+            #ix <- !duplicated(i$gf)
             with(i, data.frame(f2=mean(f2, na.rm=TRUE),
                                f1=mean(f1, na.rm=TRUE),
                                v=unique(v), gf=unique(gf),
@@ -466,6 +468,16 @@ plotVowels <- function(f1, f2, vowel=NULL, group=NULL,
                                                 unique(col.means), par("fg")),
                                style=ifelse(length(unique(style)) == 1,
                                             unique(style), 1),
+                               #poly.fill.col=poly.fill.col[ix],
+                               #poly.line.col=poly.line.col[ix],
+                               #poly.line.sty=poly.line.sty[ix],
+                               #hull.fill.col=hull.fill.col[ix],
+                               #hull.line.col=hull.line.col[ix],
+                               #hull.line.sty=hull.line.sty[ix],
+                               #ellipse.fill.col=ellipse.fill.col[ix],
+                               #ellipse.line.col=ellipse.line.col[ix],
+                               #ellipse.line.sty=ellipse.line.sty[ix],
+                               #pchmeans=pchmeans[ix],
                                poly.fill.col=unique(poly.fill.col),
                                poly.line.col=unique(poly.line.col),
                                poly.line.sty=unique(poly.line.sty),
@@ -834,29 +846,52 @@ plotVowels <- function(f1, f2, vowel=NULL, group=NULL,
                     with(m, points(f2, f1, pch=pchmeans, col=col.means,
                                    cex=cex.means))
                 }
+                ## if diph.label.first.only, ignore cex and pch from now on
                 diph.args.means$type <- "l"
+                diph.arrow.means$type <- "l"
             }
-            ## plot lines
-            apply(m, 1, function(i) {
-                ## if diph.label.first.only, cex and pch will get ignored
-                with(i, do.call(points, c(list(t(f2d)[line.range],
-                                               t(f1d)[line.range],
-                                               pch=pchmeans,
-                                               cex=cex.means,
-                                               col=col.means),
-                                          diph.args.means)))
+            ## prepare means args
+            m.args <- apply(m, 1, function(i) {
+                with(i, list(t(f2d)[line.range], t(f1d)[line.range],
+                             pch=pchmeans, cex=cex.means, col=col.means))
             })
+            ## combine diph.args.means with m
+            m.diph <- as.data.frame(lapply(diph.args.means, function(i) {
+                if (length(i) < length(unique(m$gf))) {
+                    rep(i, length_out=nrow(m))
+                } else {
+                    i[m$gfn]
+                }
+            }))
+            m.diph <- split(m.diph, seq(nrow(m.diph)))
+            m.diph <- mapply(function(i, j) {
+                i[names(j)] <- j
+                list(i)
+            }, m.args, m.diph)
+            ## plot lines
+            invisible(lapply(m.diph, function(i) do.call(points, i)))
             ## plot arrowheads
             if (diph.arrows) {
-                apply(m, 1, function(i) {
-                    with(i, do.call(arrows, c(list(x0=t(f2d)[timepts-1],
-                                                   y0=t(f1d)[timepts-1],
-                                                   x1=t(f2d)[timepts],
-                                                   y1=t(f1d)[timepts],
-                                                   col=col.means),
-                                              diph.arrow.means)
-                    ))
+                ## prepare arrow args
+                m.arr.args <- apply(m, 1, function(i) {
+                    with(i, list(x0=t(f2d)[timepts-1], y0=t(f1d)[timepts-1],
+                                 x1=t(f2d)[timepts], y1=t(f1d)[timepts],
+                                 col=col.means))
                 })
+                ## combine diph.arrow.means with m
+                m.arr <- as.data.frame(lapply(diph.arrow.means, function(i) {
+                    if (length(i) < length(unique(m$gf))) {
+                        rep(i, length_out=nrow(m))
+                    } else {
+                        i[m$gfn]
+                    }
+                }))
+                m.arr <- split(m.arr, seq(nrow(m.arr)))
+                m.arr <- mapply(function(i, j) {
+                    i[names(j)] <- j
+                    list(i)
+                }, m.arr.args, m.arr)
+                invisible(lapply(m.arr, function(i) do.call(arrows, i)))
             }
         } else {
             if (is.null(pch.means)) {

From f074a63f5c77ce4947a31775580df20938486269 Mon Sep 17 00:00:00 2001
From: Daniel McCloy <dan.mccloy@gmail.com>
Date: Tue, 24 Nov 2015 21:14:40 -0800
Subject: [PATCH 02/11] WIP: diph mean arrows are styled, but backwards?

---
 R/phonR.R | 120 ++++++++++++++++++++++++------------------------------
 1 file changed, 53 insertions(+), 67 deletions(-)

diff --git a/R/phonR.R b/R/phonR.R
index da28382..5874e47 100644
--- a/R/phonR.R
+++ b/R/phonR.R
@@ -189,8 +189,7 @@ plotVowels <- function(f1, f2, vowel=NULL, group=NULL,
         arrow.only <- c("angle", "length")
         line.only <- c("type")
         if (pretty) {
-            if (is.null(pch.means)) type <- "l"
-            else                    type <- "o"
+            type <- ifelse(is.null(pch.means), "l", "o")
             pretty.diph.tokens <- list(length=0.1, angle=20, type=type)
             pretty.diph.means  <- list(length=0.1, angle=20, type=type,
                                        lwd=2*par("lwd"))
@@ -446,48 +445,43 @@ plotVowels <- function(f1, f2, vowel=NULL, group=NULL,
                     hull.line.col=hull.line.col,
                     hull.line.sty=hull.line.sty,
                     pchmeans=pchm, pchtokens=pcht,
-                    #diph.args.tokens=as.data.frame(diph.args.tokens),
                     stringsAsFactors=FALSE)
     if (diphthong) {
         d$f2d <- lapply(apply(f2d, 1, list), unlist, use.names=FALSE)
         d$f1d <- lapply(apply(f1d, 1, list), unlist, use.names=FALSE)
+        #d.diph <- d
+        #d.diph$f2d <- lapply(apply(f2d, 1, list), unlist, use.names=FALSE)
+        #d.diph$f1d <- lapply(apply(f1d, 1, list), unlist, use.names=FALSE)
+        #d.diph[names(diph.args.tokens)] <- diph.args.tokens
     }
     if (is.null(vowel) && is.null(group)) {
         byd <- list(d=d)
     } else {
         byd <- by(d, d[c("v", "gf")], identity)
     }
-    ## dataframe of means
+    ## dataframe of means. at this point each element of "byd" should have
+    ## exactly 1 vowel and 1 grouping factor (gf) value
     m <- lapply(byd, function(i) {
         if (!is.null(i)) {
-            #ix <- !duplicated(i$gf)
+            idx <- !duplicated(i$gf)
+            fg <- par("fg")
+            tfg <- makeTransparent(fg, fill.opacity)
             with(i, data.frame(f2=mean(f2, na.rm=TRUE),
                                f1=mean(f1, na.rm=TRUE),
-                               v=unique(v), gf=unique(gf),
-                               col.means=ifelse(length(unique(col.means)) == 1,
-                                                unique(col.means), par("fg")),
-                               style=ifelse(length(unique(style)) == 1,
-                                            unique(style), 1),
-                               #poly.fill.col=poly.fill.col[ix],
-                               #poly.line.col=poly.line.col[ix],
-                               #poly.line.sty=poly.line.sty[ix],
-                               #hull.fill.col=hull.fill.col[ix],
-                               #hull.line.col=hull.line.col[ix],
-                               #hull.line.sty=hull.line.sty[ix],
-                               #ellipse.fill.col=ellipse.fill.col[ix],
-                               #ellipse.line.col=ellipse.line.col[ix],
-                               #ellipse.line.sty=ellipse.line.sty[ix],
-                               #pchmeans=pchmeans[ix],
-                               poly.fill.col=unique(poly.fill.col),
-                               poly.line.col=unique(poly.line.col),
-                               poly.line.sty=unique(poly.line.sty),
-                               hull.fill.col=unique(hull.fill.col),
-                               hull.line.col=unique(hull.line.col),
-                               hull.line.sty=unique(hull.line.sty),
-                               ellipse.fill.col=unique(ellipse.fill.col),
-                               ellipse.line.col=unique(ellipse.line.col),
-                               ellipse.line.sty=unique(ellipse.line.sty),
-                               pchmeans=unique(pchmeans),
+                               v=v[idx], gf=gf[idx],
+                               ## mean of a color / style?
+                               col.means=uniquify(col.means, fg),
+                               style=uniquify(style, 1),
+                               poly.fill.col=uniquify(poly.fill.col, tfg),
+                               hull.fill.col=uniquify(hull.fill.col, tfg),
+                               ellipse.fill.col=uniquify(ellipse.fill.col, tfg),
+                               poly.line.col=uniquify(poly.line.col, fg),
+                               hull.line.col=uniquify(hull.line.col, fg),
+                               ellipse.line.col=uniquify(ellipse.line.col, fg),
+                               poly.line.sty=uniquify(poly.line.sty, 1),
+                               hull.line.sty=uniquify(hull.line.sty, 1),
+                               ellipse.line.sty=uniquify(ellipse.line.sty, 1),
+                               pchmeans=uniquify(pchmeans, 1),
                                stringsAsFactors=FALSE))
     }})
     m <- do.call(rbind, m)
@@ -834,8 +828,8 @@ plotVowels <- function(f1, f2, vowel=NULL, group=NULL,
             ## TODO: implement smoothing splines for means
             ## setup
             timepts <- length(m$f2d[[1]])
-            if (diph.arrows) line.range <- 1:(timepts-1)
-            else             line.range <- 1:timepts
+            #if (diph.arrows) line.range <- 1:(timepts-1)
+            #else             line.range <- 1:timepts
 
             ## plot first point
             if (diph.label.first.only) {
@@ -848,50 +842,36 @@ plotVowels <- function(f1, f2, vowel=NULL, group=NULL,
                 }
                 ## if diph.label.first.only, ignore cex and pch from now on
                 diph.args.means$type <- "l"
-                diph.arrow.means$type <- "l"
+                if (diph.arrows) diph.arrow.means$type <- "l"
             }
             ## prepare means args
-            m.args <- apply(m, 1, function(i) {
-                with(i, list(t(f2d)[line.range], t(f1d)[line.range],
-                             pch=pchmeans, cex=cex.means, col=col.means))
+            m.split <- split(m, seq(nrow(m)))
+            m.args <- lapply(m.split, function(i) {
+                with(i, list(f2d[[1]], f1d[[1]], pch=pchmeans, cex=cex.means,
+                             col=col.means, lty=style))
             })
-            ## combine diph.args.means with m
-            m.diph <- as.data.frame(lapply(diph.args.means, function(i) {
-                if (length(i) < length(unique(m$gf))) {
-                    rep(i, length_out=nrow(m))
-                } else {
-                    i[m$gfn]
-                }
-            }))
-            m.diph <- split(m.diph, seq(nrow(m.diph)))
-            m.diph <- mapply(function(i, j) {
-                i[names(j)] <- j
-                list(i)
-            }, m.args, m.diph)
-            ## plot lines
-            invisible(lapply(m.diph, function(i) do.call(points, i)))
+            ## combine diph.args.means with m.args and plot
+            invisible(lapply(m.args, function(i) {
+                i[names(diph.args.means)] <- diph.args.means
+                do.call(points, i)
+                }))
             ## plot arrowheads
             if (diph.arrows) {
                 ## prepare arrow args
-                m.arr.args <- apply(m, 1, function(i) {
-                    with(i, list(x0=t(f2d)[timepts-1], y0=t(f1d)[timepts-1],
-                                 x1=t(f2d)[timepts], y1=t(f1d)[timepts],
+                m.arr.args <- lapply(m.split, function(i) {
+                    xd <- 0.01*diff(i$f2d[[1]][(timepts-1):timepts])
+                    yd <- 0.01*diff(i$f1d[[1]][(timepts-1):timepts])
+                    with(i, list(x0=f2d[[1]][timepts]-xd, y0=f1d[[1]][timepts]-yd,
+                                 x1=f2d[[1]][timepts], y1=f1d[[1]][timepts],
                                  col=col.means))
                 })
-                ## combine diph.arrow.means with m
-                m.arr <- as.data.frame(lapply(diph.arrow.means, function(i) {
-                    if (length(i) < length(unique(m$gf))) {
-                        rep(i, length_out=nrow(m))
-                    } else {
-                        i[m$gfn]
-                    }
+                ## combine with diph.arrow.means and plot
+                invisible(lapply(m.arr.args, function(i){
+                    i[names(diph.arrow.means)] <- diph.arrow.means
+                    i$lty <- "solid"
+                    if ("type" %in% names(i)) i$type <- NULL
+                    do.call(arrows, i)
                 }))
-                m.arr <- split(m.arr, seq(nrow(m.arr)))
-                m.arr <- mapply(function(i, j) {
-                    i[names(j)] <- j
-                    list(i)
-                }, m.arr.args, m.arr)
-                invisible(lapply(m.arr, function(i) do.call(arrows, i)))
             }
         } else {
             if (is.null(pch.means)) {
@@ -1376,6 +1356,12 @@ makeTransparent <- function (color, opacity) {
     trans.color <- do.call(rgb, c(as.data.frame(rgba), maxColorValue=255))
 }
 
+uniquify <- function(x, default.val) {
+    ## x should be a vector
+    ux <- unique(x)
+    ifelse(length(ux) == 1, ux, default.val)
+}
+
 fillTriangle <- function(x, y, vertices) {
     ## pineda's triangle filling algorithm
     x0 <- vertices[1,1]

From a664dcc091fd215f6f43ab5a3e119e618c5411d5 Mon Sep 17 00:00:00 2001
From: Daniel McCloy <dan.mccloy@gmail.com>
Date: Thu, 26 Nov 2015 20:58:03 -0800
Subject: [PATCH 03/11] fix: apply lty to diph mean lines

---
 R/phonR.R | 29 ++++++++++++++---------------
 1 file changed, 14 insertions(+), 15 deletions(-)

diff --git a/R/phonR.R b/R/phonR.R
index 5874e47..253f930 100644
--- a/R/phonR.R
+++ b/R/phonR.R
@@ -289,8 +289,8 @@ plotVowels <- function(f1, f2, vowel=NULL, group=NULL,
     ## ## ## ## ## ## ##
     ## OTHER DEFAULTS ##
     ## ## ## ## ## ## ##
-    vary.col <- ifelse(is.na(var.col.by[1]), FALSE, TRUE)
-    vary.sty <- ifelse(is.na(var.sty.by[1]), FALSE, TRUE)
+    vary.col <- !is.na(var.col.by[1])
+    vary.sty <- !is.na(var.sty.by[1])
     ## color: use default pallete if none specified and pretty=FALSE
     if (!"col" %in% names(exargs)) exargs$col <- palette()
     ## linetypes & plotting characters
@@ -434,7 +434,7 @@ plotVowels <- function(f1, f2, vowel=NULL, group=NULL,
     ## ## ## ## ## ## ## ## ## ##
     d <- data.frame(f1=f1, f2=f2, v=v, gf=factor(gf, levels=unique(gf)),
                     col.tokens=col.tokens, col.means=col.means,
-                    style=var.sty.by,
+                    style=var.sty.by, lty=exargs$lty,
                     ellipse.fill.col=ellipse.fill.col,
                     ellipse.line.col=ellipse.line.col,
                     ellipse.line.sty=ellipse.line.sty,
@@ -444,7 +444,8 @@ plotVowels <- function(f1, f2, vowel=NULL, group=NULL,
                     hull.fill.col=hull.fill.col,
                     hull.line.col=hull.line.col,
                     hull.line.sty=hull.line.sty,
-                    pchmeans=pchm, pchtokens=pcht,
+                    diph.line.sty=exargs$lty,
+                    pchm=pchm, pch.tokens=pcht,
                     stringsAsFactors=FALSE)
     if (diphthong) {
         d$f2d <- lapply(apply(f2d, 1, list), unlist, use.names=FALSE)
@@ -481,7 +482,8 @@ plotVowels <- function(f1, f2, vowel=NULL, group=NULL,
                                poly.line.sty=uniquify(poly.line.sty, 1),
                                hull.line.sty=uniquify(hull.line.sty, 1),
                                ellipse.line.sty=uniquify(ellipse.line.sty, 1),
-                               pchmeans=uniquify(pchmeans, 1),
+                               pchm=uniquify(pchm, 1),
+                               lty.means=uniquify(lty, 1),
                                stringsAsFactors=FALSE))
     }})
     m <- do.call(rbind, m)
@@ -828,16 +830,13 @@ plotVowels <- function(f1, f2, vowel=NULL, group=NULL,
             ## TODO: implement smoothing splines for means
             ## setup
             timepts <- length(m$f2d[[1]])
-            #if (diph.arrows) line.range <- 1:(timepts-1)
-            #else             line.range <- 1:timepts
-
             ## plot first point
             if (diph.label.first.only) {
                 if (!is.null(pch.means)) {
-                    with(m, text(f2, f1, labels=pchmeans, col=col.means,
+                    with(m, text(f2, f1, labels=pchm, col=col.means,
                                  cex=cex.means))
                 } else {
-                    with(m, points(f2, f1, pch=pchmeans, col=col.means,
+                    with(m, points(f2, f1, pch=pchm, col=col.means,
                                    cex=cex.means))
                 }
                 ## if diph.label.first.only, ignore cex and pch from now on
@@ -847,8 +846,8 @@ plotVowels <- function(f1, f2, vowel=NULL, group=NULL,
             ## prepare means args
             m.split <- split(m, seq(nrow(m)))
             m.args <- lapply(m.split, function(i) {
-                with(i, list(f2d[[1]], f1d[[1]], pch=pchmeans, cex=cex.means,
-                             col=col.means, lty=style))
+                with(i, list(f2d[[1]], f1d[[1]], pch=pchm, cex=cex.means,
+                             col=col.means, lty=lty.means))
             })
             ## combine diph.args.means with m.args and plot
             invisible(lapply(m.args, function(i) {
@@ -875,10 +874,10 @@ plotVowels <- function(f1, f2, vowel=NULL, group=NULL,
             }
         } else {
             if (is.null(pch.means)) {
-                with(m, points(f2, f1, col=col.means, pch=pchmeans,
+                with(m, points(f2, f1, col=col.means, pch=pchm,
                                cex=cex.means))
             } else {
-                with(m, text(f2, f1, labels=pchmeans, col=col.means,
+                with(m, text(f2, f1, labels=pchm, col=col.means,
                              cex=cex.means))
             }
         }
@@ -898,7 +897,7 @@ plotVowels <- function(f1, f2, vowel=NULL, group=NULL,
             legend.pch <- NULL
             if (length(legend.style.lab)) {
                 if (plot.means && all(grepl("[[:digit:]]", pch.means))) {
-                    legend.pch <- unique(m$pchmeans)
+                    legend.pch <- unique(m$pchm)
                 } else if (plot.tokens &&
                                all(grepl("[[:digit:]]", pch.tokens))) {
                     legend.pch <- unique(d$pchtokens)

From b3e592b9c6dbb653cbbd0021de8b564b70d667e8 Mon Sep 17 00:00:00 2001
From: Daniel McCloy <dan.mccloy@gmail.com>
Date: Thu, 26 Nov 2015 21:19:54 -0800
Subject: [PATCH 04/11] fix: apply lty to diph token lines

---
 R/phonR.R | 69 ++++++++++++++++++++++++++++++-------------------------
 1 file changed, 38 insertions(+), 31 deletions(-)

diff --git a/R/phonR.R b/R/phonR.R
index 253f930..f61a7c9 100644
--- a/R/phonR.R
+++ b/R/phonR.R
@@ -296,6 +296,7 @@ plotVowels <- function(f1, f2, vowel=NULL, group=NULL,
     ## linetypes & plotting characters
     if (!"lty" %in% names(exargs)) exargs$lty <- seq_len(num.sty)
     if (!"pch" %in% names(exargs)) exargs$pch <- seq_len(num.sty)
+    if (!"lwd" %in% names(exargs)) exargs$lwd <- par("lwd")
     ## recycle user-specified colors to the length we need
     if (vary.col) exargs$col <- rep(exargs$col, length.out=num.col)[var.col.by]
     if (vary.sty) exargs$lty <- rep(exargs$lty, length.out=num.sty)[var.sty.by]
@@ -434,7 +435,7 @@ plotVowels <- function(f1, f2, vowel=NULL, group=NULL,
     ## ## ## ## ## ## ## ## ## ##
     d <- data.frame(f1=f1, f2=f2, v=v, gf=factor(gf, levels=unique(gf)),
                     col.tokens=col.tokens, col.means=col.means,
-                    style=var.sty.by, lty=exargs$lty,
+                    style=var.sty.by, lty=exargs$lty, lwd=exargs$lwd,
                     ellipse.fill.col=ellipse.fill.col,
                     ellipse.line.col=ellipse.line.col,
                     ellipse.line.sty=ellipse.line.sty,
@@ -444,7 +445,6 @@ plotVowels <- function(f1, f2, vowel=NULL, group=NULL,
                     hull.fill.col=hull.fill.col,
                     hull.line.col=hull.line.col,
                     hull.line.sty=hull.line.sty,
-                    diph.line.sty=exargs$lty,
                     pchm=pchm, pch.tokens=pcht,
                     stringsAsFactors=FALSE)
     if (diphthong) {
@@ -484,6 +484,7 @@ plotVowels <- function(f1, f2, vowel=NULL, group=NULL,
                                ellipse.line.sty=uniquify(ellipse.line.sty, 1),
                                pchm=uniquify(pchm, 1),
                                lty.means=uniquify(lty, 1),
+                               lwd.means=uniquify(lwd, par("lwd")),
                                stringsAsFactors=FALSE))
     }})
     m <- do.call(rbind, m)
@@ -719,8 +720,6 @@ plotVowels <- function(f1, f2, vowel=NULL, group=NULL,
         if (diphthong) {
             ## setup
             timepts <- length(d$f2d[[1]])
-            if (diph.arrows) line.range <- 1:(timepts-1)
-            else             line.range <- 1:timepts
             ## no smoothing splines
             if (!diph.smooth || timepts < 4) {
                 if (diph.smooth) warning("Cannot smooth diphthong traces with ",
@@ -729,35 +728,43 @@ plotVowels <- function(f1, f2, vowel=NULL, group=NULL,
                 ## plot first point
                 if (diph.label.first.only) {
                     if (!is.null(pch.tokens)) {
-                        with(d, text(f2, f1, labels=pchtokens, col=col.tokens,
+                        with(d, text(f2, f1, labels=pch.tokens, col=col.tokens,
                                      cex=cex.tokens))
                     } else {
-                        with(d, points(f2, f1, pch=pchtokens, col=col.tokens,
+                        with(d, points(f2, f1, pch=pch.tokens, col=col.tokens,
                                        cex=cex.tokens))
                     }
+                    ## if diph.label.first.only, ignore cex and pch from now on
                     diph.args.tokens$type <- "l"
+                    if (diph.arrows) diph.arrow.tokens$type <- "l"
                 }
-                ## plot lines
-                apply(d, 1, function(i) {
-                    ## if diph.label.first.only, cex and pch will get ignored
-                    with(i, do.call(points, c(list(t(f2d)[line.range],
-                                                   t(f1d)[line.range],
-                                                   pch=pchtokens,
-                                                   cex=cex.tokens,
-                                                   col=col.tokens),
-                                              diph.args.tokens)))
-                    })
-                ## plot arrowheads
+                ## prepare tokens args
+                d.split <- split(d, seq(nrow(d)))
+                d.args <- lapply(d.split, function(i) {
+                    with(i, list(f2d[[1]], f1d[[1]], pch=pch.tokens,
+                                 cex=cex.tokens, col=col.tokens, lty=lty))
+                })
+                ## combine diph.args.means with m.args and plot
+                invisible(lapply(d.args, function(i) {
+                    i[names(diph.args.tokens)] <- diph.args.tokens
+                    do.call(points, i)
+                }))
                 if (diph.arrows) {
-                    apply(d, 1, function(i) {
-                        with(i, do.call(arrows, c(list(x0=t(f2d)[timepts-1],
-                                                       y0=t(f1d)[timepts-1],
-                                                       x1=t(f2d)[timepts],
-                                                       y1=t(f1d)[timepts],
-                                                       col=col.tokens),
-                                                  diph.arrow.tokens)
-                        ))
+                    ## prepare arrow args
+                    d.arr.args <- lapply(d.split, function(i) {
+                        xd <- 0.01*diff(i$f2d[[1]][(timepts-1):timepts])
+                        yd <- 0.01*diff(i$f1d[[1]][(timepts-1):timepts])
+                        with(i, list(x0=f2d[[1]][timepts]-xd, y0=f1d[[1]][timepts]-yd,
+                                     x1=f2d[[1]][timepts], y1=f1d[[1]][timepts],
+                                     col=col.tokens, lwd=lwd))
                     })
+                    ## combine with diph.arrow.means and plot
+                    invisible(lapply(d.arr.args, function(i){
+                        i[names(diph.arrow.tokens)] <- diph.arrow.tokens
+                        i$lty <- "solid"
+                        if ("type" %in% names(i)) i$type <- NULL
+                        do.call(arrows, i)
+                    }))
                 }
             ## diphthong smoothing spline
             } else if (diph.smooth) {  # timepts > 3
@@ -794,7 +801,7 @@ plotVowels <- function(f1, f2, vowel=NULL, group=NULL,
                         if (diph.arrows) {
                             end <- nrow(i)
                             with(i, points(f2[1:end-1], f1[1:end-1],
-                                           col=col.tokens, pch=pchtokens,
+                                           col=col.tokens, pch=pch.tokens,
                                            cex=cex.tokens, type="o"))
                             with(i, do.call(arrows, c(list(x0=f2[end-1],
                                                            y0=f1[end-1],
@@ -804,7 +811,7 @@ plotVowels <- function(f1, f2, vowel=NULL, group=NULL,
                                                       diph.arrow.args)))
                         } else {
                             with(i, points(f2, f1, col=col.tokens,
-                                           pch=pchtokens, cex=cex.tokens,
+                                           pch=pch.tokens, cex=cex.tokens,
                                            type="o"))
                         }
                     },
@@ -815,10 +822,10 @@ plotVowels <- function(f1, f2, vowel=NULL, group=NULL,
             }
         } else {  # !diphthong
             if (is.null(pch.tokens)) {
-                with(d, points(f2, f1, pch=pchtokens, cex=cex.tokens,
+                with(d, points(f2, f1, pch=pch.tokens, cex=cex.tokens,
                                col=col.tokens))
             } else {
-                with(d, text(f2, f1, labels=pchtokens, cex=cex.tokens,
+                with(d, text(f2, f1, labels=pch.tokens, cex=cex.tokens,
                              col=col.tokens))
     }   }   }
 
@@ -862,7 +869,7 @@ plotVowels <- function(f1, f2, vowel=NULL, group=NULL,
                     yd <- 0.01*diff(i$f1d[[1]][(timepts-1):timepts])
                     with(i, list(x0=f2d[[1]][timepts]-xd, y0=f1d[[1]][timepts]-yd,
                                  x1=f2d[[1]][timepts], y1=f1d[[1]][timepts],
-                                 col=col.means))
+                                 col=col.means, lwd=lwd.means))
                 })
                 ## combine with diph.arrow.means and plot
                 invisible(lapply(m.arr.args, function(i){
@@ -900,7 +907,7 @@ plotVowels <- function(f1, f2, vowel=NULL, group=NULL,
                     legend.pch <- unique(m$pchm)
                 } else if (plot.tokens &&
                                all(grepl("[[:digit:]]", pch.tokens))) {
-                    legend.pch <- unique(d$pchtokens)
+                    legend.pch <- unique(d$pch.tokens)
                 }
             }
             ## legend col

From 1995136b956653e385ab3a0586500b398a5ad895 Mon Sep 17 00:00:00 2001
From: Daniel McCloy <dan.mccloy@gmail.com>
Date: Sun, 3 Jan 2016 14:20:11 -0800
Subject: [PATCH 05/11] bump version in DESCRIPTION; some fixes from R CMD
 check

---
 .Rbuildignore     | 2 ++
 DESCRIPTION       | 4 ++--
 man/normVowels.Rd | 4 ++--
 3 files changed, 6 insertions(+), 4 deletions(-)

diff --git a/.Rbuildignore b/.Rbuildignore
index 2bb58e9..4a3fb0b 100644
--- a/.Rbuildignore
+++ b/.Rbuildignore
@@ -2,6 +2,8 @@
 .Rproj.user
 extras
 old-versions
+cache
+gists
 
 index.html
 footer.html
diff --git a/DESCRIPTION b/DESCRIPTION
index b2818bd..a6faed9 100644
--- a/DESCRIPTION
+++ b/DESCRIPTION
@@ -1,8 +1,8 @@
 Package: phonR
 Type: Package
 Title: Tools for Phoneticians and Phonologists
-Version: 1.0-6
-Date: 2015-06-22
+Version: 1.0-7
+Date: 2016-01-03
 Author: Daniel R. McCloy
 Maintainer: Daniel R. McCloy <drmccloy@uw.edu>
 Depends: R (>= 2.10)
diff --git a/man/normVowels.Rd b/man/normVowels.Rd
index aaae96e..bdc3bbd 100644
--- a/man/normVowels.Rd
+++ b/man/normVowels.Rd
@@ -27,7 +27,7 @@
     normNearey2(f, group=NULL, exp=FALSE, ...)
     normSharedLogmean(f, group=NULL, exp=FALSE, ...)
     normWattFabricius(f, vowel, group=NULL)
-    normVowels(method, f0=NULL, f1=NULL, f2=NULL, f3=NULL, 
+    normVowels(method, f0=NULL, f1=NULL, f2=NULL, f3=NULL,
                vowel=NULL, group=NULL, ...)
 }
 \arguments{
@@ -106,7 +106,7 @@ Glasberg, B. R., & Moore, B. C. J. 1990 \dQuote{Derivation of auditory filter sh
 
 Lobanov, B. M. 1971 \dQuote{Classification of Russian vowels spoken by different speakers.} \emph{The Journal of the Acoustical Society of America}, 49(2), 606-608. \url{http://dx.doi.org/10.1121/1.1912396}
 
-McCloy, D. R. 2012 \dQuote{Normalizing and plotting vowels with the phonR package.} \emph{Technical Reports of the UW Linguistic Phonetics Laboratory}. \url{http://depts.washington.edu/phonlab/pubs/McCloy2012_phonR.pdf}
+McCloy, D. R. 2012 \dQuote{Normalizing and plotting vowels with the phonR package.} \emph{Technical Reports of the UW Linguistic Phonetics Laboratory}. \url{http://dan.mccloy.info/pubs/McCloy2012_phonR.pdf}
 
 Nearey, T. M. 1978 \dQuote{Phonetic feature systems for vowels} (Doctoral dissertation, University of Alberta). Reprinted by the Indiana University Linguistics Club. \url{http://www.ualberta.ca/~tnearey/Nearey1978_compressed.pdf}
 

From bb4b3c6ba98a15c697b1948516fd21dada7a3b83 Mon Sep 17 00:00:00 2001
From: drammock <dan.mccloy@gmail.com>
Date: Fri, 12 Aug 2016 15:47:17 -0700
Subject: [PATCH 06/11] fix: use hotellings t-squared for ellipse calculations

---
 R/phonR.R         | 20 +++++++++++---------
 man/plotVowels.Rd | 14 ++++++++------
 2 files changed, 19 insertions(+), 15 deletions(-)

diff --git a/R/phonR.R b/R/phonR.R
index f61a7c9..4909ba6 100644
--- a/R/phonR.R
+++ b/R/phonR.R
@@ -469,7 +469,7 @@ plotVowels <- function(f1, f2, vowel=NULL, group=NULL,
             tfg <- makeTransparent(fg, fill.opacity)
             with(i, data.frame(f2=mean(f2, na.rm=TRUE),
                                f1=mean(f1, na.rm=TRUE),
-                               v=v[idx], gf=gf[idx],
+                               v=v[idx], gf=gf[idx], n=nrow(i),
                                ## mean of a color / style?
                                col.means=uniquify(col.means, fg),
                                style=uniquify(style, 1),
@@ -501,9 +501,8 @@ plotVowels <- function(f1, f2, vowel=NULL, group=NULL,
             with(i, list(colMeans(cbind(f2, f1), na.rm=TRUE)))
         }})
         mu <- do.call(rbind, mu)
-        sigma <- lapply(byd, function(i) { if (!(is.null(i))) {
-            with(i[!(is.na(i$f2)) && !(is.na(i$f1)),],
-                 list(cov(cbind(f2, f1))))
+        sigma <- lapply(byd, function(i) { if (!is.null(i)) {
+            with(na.omit(i[c('f2', 'f1')]), list(cov(cbind(f2, f1))))
         }})
         ## the covariance calculation above still may yield an NA covariance
         ## matrix if a vowel has only 1 token. This is handled later.
@@ -529,11 +528,11 @@ plotVowels <- function(f1, f2, vowel=NULL, group=NULL,
             if (any(is.na(i$sigma))) {
                 i$sigma <- matrix(rep(0, 4), nrow=2)
                 msg <- ifelse(i$gf == "gf", as.character(i$v),
-                              paste("(", i$gf, ", ", i$v, ")", sep=""))
+                              paste0("(", i$gf, ", ", i$v, ")"))
                 message("No ellipse drawn for ", msg,
                         " because there is only one token.")
             }
-            list("mu"=i$mu, "sigma"=i$sigma, "alpha"=1 - ellipse.conf,
+            list("mu"=i$mu, "sigma"=i$sigma, "n"=i$n, "alpha"=1 - ellipse.conf,
                  "draw"=FALSE)
         })
         ellipse.points <- lapply(ellipse.param,
@@ -1339,12 +1338,15 @@ prettyTicks <- function(lim) {
     seq(lims[1],lims[2],step)
 }
 
-ellipse <- function(mu, sigma, alpha=0.05, npoints=250, draw=TRUE, ...) {
-    ## adapted from the (now-defunct) mixtools package
+ellipse <- function(mu, sigma, n, alpha=0.05, npoints=250, draw=TRUE, ...) {
     if (all(sigma == matrix(rep(0, 4), nrow=2))) return(rbind(mu, mu))
     es <- eigen(sigma)
     e1 <- es$vec %*% diag(sqrt(es$val))
-    r1 <- sqrt(qchisq(1 - alpha, 2))
+    # use hotelling's t^2 to compute ellipse (confidence in mean location)
+    p <- length(mu)
+    tsquared <- n * t(mu) %*% solve(sigma) %*% mu
+    coef <- p * (n - 1) / (n - p)
+    r1 <- sqrt(coef * qf(1 - alpha, df1=p, df2=n-p))
     theta <- seq(0, 2 * pi, len=npoints)
     v1 <- cbind(r1 * cos(theta), r1 * sin(theta))
     pts <- t(mu - (e1 %*% t(v1)))
diff --git a/man/plotVowels.Rd b/man/plotVowels.Rd
index bdb7d0d..0a378f3 100644
--- a/man/plotVowels.Rd
+++ b/man/plotVowels.Rd
@@ -59,8 +59,8 @@
     \item{hull.args,poly.args,ellipse.args}{Named list of arguments to be passed
                                             to \code{\link[graphics]{polygon}}.
                                             Useful for controlling line width,
-                                            etc. See "Details" for notes about
-                                            color handling.}
+                                            etc. See \dQuote{Details} for notes
+                                            about color handling.}
     \item{poly.line}{Logical; should a line be drawn tracing the polygon
                      connecting the mean values for each vowel (separately for
                      each level of \code{group})?}
@@ -74,10 +74,12 @@
     \item{ellipse.line}{Logical; should vowel density ellipses be drawn with an
                         outer line?}
     \item{ellipse.fill}{Logical; should vowel density ellipses be filled?}
-    \item{ellipse.conf}{Size of the ellipse (0,1] expressed as a confidence level
-                        (i.e., 0.95 gives a 95\% confidence ellipse).  Defaults
-                        to a confidence level of 0.6827 (equivalent to
-                        plus-or-minus 1 sample standard deviation).}
+    \item{ellipse.conf}{Numeric in range (0,1]; the size of the ellipse
+                        expressed as a confidence level of the estimate of the
+                        true mean (i.e., 0.95 gives a 95\% confidence ellipse).
+                        The default value (0.6827) corresponds to plus-or-minus
+                        one sample standard deviation along the major and minor
+                        axes of the bivariate normal density contour.}
     \item{diph.arrows}{Logical; should the last timepoint of each vowel be
                        marked with an arrowhead?}
     \item{diph.args.tokens,diph.args.means}{List of named arguments to be passed

From 020cc57d526e68347908801032c2e7e1e671a648 Mon Sep 17 00:00:00 2001
From: drammock <dan.mccloy@gmail.com>
Date: Mon, 22 Aug 2016 10:48:13 -0700
Subject: [PATCH 07/11] better docs in ellipse function; small refactor in cov
 calculation

---
 DESCRIPTION |  2 +-
 R/phonR.R   | 24 ++++++++++++++----------
 2 files changed, 15 insertions(+), 11 deletions(-)

diff --git a/DESCRIPTION b/DESCRIPTION
index a6faed9..60fdac7 100644
--- a/DESCRIPTION
+++ b/DESCRIPTION
@@ -2,7 +2,7 @@ Package: phonR
 Type: Package
 Title: Tools for Phoneticians and Phonologists
 Version: 1.0-7
-Date: 2016-01-03
+Date: 2016-08-22
 Author: Daniel R. McCloy
 Maintainer: Daniel R. McCloy <drmccloy@uw.edu>
 Depends: R (>= 2.10)
diff --git a/R/phonR.R b/R/phonR.R
index 4909ba6..d0492e5 100644
--- a/R/phonR.R
+++ b/R/phonR.R
@@ -502,7 +502,7 @@ plotVowels <- function(f1, f2, vowel=NULL, group=NULL,
         }})
         mu <- do.call(rbind, mu)
         sigma <- lapply(byd, function(i) { if (!is.null(i)) {
-            with(na.omit(i[c('f2', 'f1')]), list(cov(cbind(f2, f1))))
+            with(i, list(var(cbind(f2, f1), na.rm=TRUE)))
         }})
         ## the covariance calculation above still may yield an NA covariance
         ## matrix if a vowel has only 1 token. This is handled later.
@@ -1340,16 +1340,20 @@ prettyTicks <- function(lim) {
 
 ellipse <- function(mu, sigma, n, alpha=0.05, npoints=250, draw=TRUE, ...) {
     if (all(sigma == matrix(rep(0, 4), nrow=2))) return(rbind(mu, mu))
-    es <- eigen(sigma)
-    e1 <- es$vec %*% diag(sqrt(es$val))
-    # use hotelling's t^2 to compute ellipse (confidence in mean location)
     p <- length(mu)
-    tsquared <- n * t(mu) %*% solve(sigma) %*% mu
-    coef <- p * (n - 1) / (n - p)
-    r1 <- sqrt(coef * qf(1 - alpha, df1=p, df2=n-p))
-    theta <- seq(0, 2 * pi, len=npoints)
-    v1 <- cbind(r1 * cos(theta), r1 * sin(theta))
-    pts <- t(mu - (e1 %*% t(v1)))
+    es <- eigen(sigma)
+    e1 <- es$vectors %*% diag(sqrt(es$values))
+    theta <- seq(from=0, to=2 * pi, length.out=npoints)
+    unit.circle <- cbind(cos(theta), sin(theta))
+    ## for small n, confidence ellipses for multivariate sample means are
+    ## distributed as Hotelling's T^2, which is (with appropriate scale factor)
+    ## equivalent to an F distribution (hence the qf() function). For large n,
+    ## this asymptotically approaches qchisq(1-alpha, p)
+    scale.factor <- p * (n - 1) / (n - p)
+    critical.radius <- sqrt(scale.factor * qf(1-alpha, df1=p, df2=n-p))
+    ## if we needed it, this would be the t-squared statistic
+    # tsquared <- n * t(mu) %*% solve(sigma) %*% mu
+    pts <- t(mu - (e1 %*% t(critical.radius * unit.circle)))
     if (draw) {
         colnames(pts) <- c("x", "y")
         polygon(pts, ...)

From a6439863b07128890aa2bef9a10b3ca56b08d2b9 Mon Sep 17 00:00:00 2001
From: Daniel McCloy <dan.mccloy@gmail.com>
Date: Mon, 22 Aug 2016 14:48:30 -0700
Subject: [PATCH 08/11] fix namespace for vanilla R

---
 .Rbuildignore | 1 +
 DESCRIPTION   | 4 ++--
 NAMESPACE     | 3 +++
 3 files changed, 6 insertions(+), 2 deletions(-)

diff --git a/.Rbuildignore b/.Rbuildignore
index 4a3fb0b..e9496f3 100644
--- a/.Rbuildignore
+++ b/.Rbuildignore
@@ -6,6 +6,7 @@ cache
 gists
 
 index.html
+index_utf8.html
 footer.html
 knit_phonR.bash
 phonR.pdf
diff --git a/DESCRIPTION b/DESCRIPTION
index 60fdac7..24fb38f 100644
--- a/DESCRIPTION
+++ b/DESCRIPTION
@@ -6,10 +6,10 @@ Date: 2016-08-22
 Author: Daniel R. McCloy
 Maintainer: Daniel R. McCloy <drmccloy@uw.edu>
 Depends: R (>= 2.10)
-Imports: splancs, deldir, plotrix
+Imports: splancs, deldir, plotrix, stats, grDevices, graphics
 Description: Tools for phoneticians and phonologists, including functions for normalization and plotting of vowels.
 License: GPL-3
 URL: http://drammock.github.io/phonR/
-BugReports: https://github.com/drammock/phonR/issues 
+BugReports: https://github.com/drammock/phonR/issues
 LazyLoad: yes
 LazyData: yes
diff --git a/NAMESPACE b/NAMESPACE
index 70c6bfe..9aa0e9b 100644
--- a/NAMESPACE
+++ b/NAMESPACE
@@ -17,3 +17,6 @@ export(repulsiveForce)
 export(repulsiveForceHeatmap)
 export(repulsiveForceHeatmapLegend)
 export(vowelMeansPolygonArea)
+import(graphics)
+import(grDevices)
+import(stats)

From 37adaae4ac175e14bbef7b489803bad0574bbe89 Mon Sep 17 00:00:00 2001
From: drammock <dan.mccloy@gmail.com>
Date: Wed, 24 Aug 2016 11:15:20 -0700
Subject: [PATCH 09/11] fully deprecate var.style.by; fix pch.mean via uniquify
 function; ellipse warning with n==2

---
 R/phonR.R | 82 +++++++++++++++++++++++++++++++++----------------------
 1 file changed, 50 insertions(+), 32 deletions(-)

diff --git a/R/phonR.R b/R/phonR.R
index d0492e5..aab843b 100644
--- a/R/phonR.R
+++ b/R/phonR.R
@@ -27,28 +27,39 @@ plotVowels <- function(f1, f2, vowel=NULL, group=NULL,
     heatmap=FALSE, heatmap.args=NULL, heatmap.legend=FALSE,
     heatmap.legend.args=NULL,
     ## color, style
-    var.col.by=NULL, var.style.by=NULL, fill.opacity=0.3, label.las=NULL,
+    var.col.by=NULL, var.sty.by=NULL, fill.opacity=0.3, label.las=NULL,
     ## legend
     legend.kwd=NULL, legend.args=NULL,
     ## misc
     pretty=FALSE, output="screen", ...)
 {
-    ## to-be-deprecated items
-    var.sty.by <- var.style.by
-
     ## ## ## ## ## ## ## ##
     ## HANDLE EXTRA ARGS ##
     ## ## ## ## ## ## ## ##
     exargs <- list(...)
     font.specified <- "family" %in% names(exargs)
-    # two arguments get overridden no matter what
+    ## to-be-deprecated items
+    if ("var.style.by" %in% names(exargs)) {
+    	message("Argument 'var.style.by' has been deprecated and renamed ",
+    		    "'var.sty.by'. In future versions 'var.style.by' will no ",
+    		    "longer work; please update your code.")
+    	if (!is.null(var.sty.by)) {
+    		message("Additionally, you have passed both the old 'var.style.by'",
+    			    " and the new 'var.sty.by' arguments; the old one will be ",
+    			    "ignored.")
+    	} else {
+    		var.sty.by <- exargs$var.style.by
+    		exargs$var.style.by <- NULL
+    	}
+    }
+    ## two arguments get overridden no matter what
     exargs$ann <- FALSE
     exargs$type <- "n"
-    # Some graphical devices only support inches, so we convert here.
+    ## Some graphical devices only support inches, so we convert here.
     if ("units" %in% names(exargs)) {
         if (!exargs$units %in% c("in", "cm", "mm", "px")) {
-            warning("Unsupported argument value '", units, "': 'units' must be ",
-                    "one of 'in', 'cm', 'mm', or 'px'. Using default ('in').")
+            warning("Unsupported argument value '", units, "': 'units' must be",
+                    " one of 'in', 'cm', 'mm', or 'px'. Using default ('in').")
             exargs$units <- "in"
         }
         if (output %in% c("pdf", "svg", "screen")) {
@@ -302,10 +313,10 @@ plotVowels <- function(f1, f2, vowel=NULL, group=NULL,
     if (vary.sty) exargs$lty <- rep(exargs$lty, length.out=num.sty)[var.sty.by]
     if (vary.sty) exargs$pch <- rep(exargs$pch, length.out=num.sty)[var.sty.by]
     ## set defaults for token and mean plotting characters
-    if (is.null(pch.tokens)) pcht <- exargs$pch
-    else                     pcht <- pch.tokens
-    if (is.null(pch.means))  pchm <- exargs$pch
-    else                     pchm <- pch.means
+    if (is.null(pch.tokens)) pch.t <- exargs$pch
+    else                     pch.t <- pch.tokens
+    if (is.null(pch.means))  pch.m <- exargs$pch
+    else                     pch.m <- pch.means
     ## transparency
     trans.col <- makeTransparent(exargs$col, fill.opacity)
     trans.fg <- makeTransparent(par("fg"), fill.opacity)
@@ -445,7 +456,7 @@ plotVowels <- function(f1, f2, vowel=NULL, group=NULL,
                     hull.fill.col=hull.fill.col,
                     hull.line.col=hull.line.col,
                     hull.line.sty=hull.line.sty,
-                    pchm=pchm, pch.tokens=pcht,
+                    pch.m=pch.m, pch.t=pch.t,
                     stringsAsFactors=FALSE)
     if (diphthong) {
         d$f2d <- lapply(apply(f2d, 1, list), unlist, use.names=FALSE)
@@ -482,7 +493,7 @@ plotVowels <- function(f1, f2, vowel=NULL, group=NULL,
                                poly.line.sty=uniquify(poly.line.sty, 1),
                                hull.line.sty=uniquify(hull.line.sty, 1),
                                ellipse.line.sty=uniquify(ellipse.line.sty, 1),
-                               pchm=uniquify(pchm, 1),
+                               pch.m=uniquify(pch.m, 1),
                                lty.means=uniquify(lty, 1),
                                lwd.means=uniquify(lwd, par("lwd")),
                                stringsAsFactors=FALSE))
@@ -531,6 +542,11 @@ plotVowels <- function(f1, f2, vowel=NULL, group=NULL,
                               paste0("(", i$gf, ", ", i$v, ")"))
                 message("No ellipse drawn for ", msg,
                         " because there is only one token.")
+            } else if (i$n == 2) {
+                msg <- ifelse(i$gf == "gf", as.character(i$v),
+                              paste0("(", i$gf, ", ", i$v, ")"))
+                message("No ellipse drawn for ", msg,
+                        " because there are only two tokens.")
             }
             list("mu"=i$mu, "sigma"=i$sigma, "n"=i$n, "alpha"=1 - ellipse.conf,
                  "draw"=FALSE)
@@ -727,10 +743,10 @@ plotVowels <- function(f1, f2, vowel=NULL, group=NULL,
                 ## plot first point
                 if (diph.label.first.only) {
                     if (!is.null(pch.tokens)) {
-                        with(d, text(f2, f1, labels=pch.tokens, col=col.tokens,
+                        with(d, text(f2, f1, labels=pch.t, col=col.tokens,
                                      cex=cex.tokens))
                     } else {
-                        with(d, points(f2, f1, pch=pch.tokens, col=col.tokens,
+                        with(d, points(f2, f1, pch=pch.t, col=col.tokens,
                                        cex=cex.tokens))
                     }
                     ## if diph.label.first.only, ignore cex and pch from now on
@@ -740,7 +756,7 @@ plotVowels <- function(f1, f2, vowel=NULL, group=NULL,
                 ## prepare tokens args
                 d.split <- split(d, seq(nrow(d)))
                 d.args <- lapply(d.split, function(i) {
-                    with(i, list(f2d[[1]], f1d[[1]], pch=pch.tokens,
+                    with(i, list(f2d[[1]], f1d[[1]], pch=pch.t,
                                  cex=cex.tokens, col=col.tokens, lty=lty))
                 })
                 ## combine diph.args.means with m.args and plot
@@ -753,7 +769,8 @@ plotVowels <- function(f1, f2, vowel=NULL, group=NULL,
                     d.arr.args <- lapply(d.split, function(i) {
                         xd <- 0.01*diff(i$f2d[[1]][(timepts-1):timepts])
                         yd <- 0.01*diff(i$f1d[[1]][(timepts-1):timepts])
-                        with(i, list(x0=f2d[[1]][timepts]-xd, y0=f1d[[1]][timepts]-yd,
+                        with(i, list(x0=f2d[[1]][timepts] - xd,
+                                     y0=f1d[[1]][timepts] - yd,
                                      x1=f2d[[1]][timepts], y1=f1d[[1]][timepts],
                                      col=col.tokens, lwd=lwd))
                     })
@@ -800,7 +817,7 @@ plotVowels <- function(f1, f2, vowel=NULL, group=NULL,
                         if (diph.arrows) {
                             end <- nrow(i)
                             with(i, points(f2[1:end-1], f1[1:end-1],
-                                           col=col.tokens, pch=pch.tokens,
+                                           col=col.tokens, pch=pch.t,
                                            cex=cex.tokens, type="o"))
                             with(i, do.call(arrows, c(list(x0=f2[end-1],
                                                            y0=f1[end-1],
@@ -810,7 +827,7 @@ plotVowels <- function(f1, f2, vowel=NULL, group=NULL,
                                                       diph.arrow.args)))
                         } else {
                             with(i, points(f2, f1, col=col.tokens,
-                                           pch=pch.tokens, cex=cex.tokens,
+                                           pch=pch.t, cex=cex.tokens,
                                            type="o"))
                         }
                     },
@@ -821,10 +838,10 @@ plotVowels <- function(f1, f2, vowel=NULL, group=NULL,
             }
         } else {  # !diphthong
             if (is.null(pch.tokens)) {
-                with(d, points(f2, f1, pch=pch.tokens, cex=cex.tokens,
+                with(d, points(f2, f1, pch=pch.t, cex=cex.tokens,
                                col=col.tokens))
             } else {
-                with(d, text(f2, f1, labels=pch.tokens, cex=cex.tokens,
+                with(d, text(f2, f1, labels=pch.t, cex=cex.tokens,
                              col=col.tokens))
     }   }   }
 
@@ -839,10 +856,10 @@ plotVowels <- function(f1, f2, vowel=NULL, group=NULL,
             ## plot first point
             if (diph.label.first.only) {
                 if (!is.null(pch.means)) {
-                    with(m, text(f2, f1, labels=pchm, col=col.means,
+                    with(m, text(f2, f1, labels=pch.m, col=col.means,
                                  cex=cex.means))
                 } else {
-                    with(m, points(f2, f1, pch=pchm, col=col.means,
+                    with(m, points(f2, f1, pch=pch.m, col=col.means,
                                    cex=cex.means))
                 }
                 ## if diph.label.first.only, ignore cex and pch from now on
@@ -852,7 +869,7 @@ plotVowels <- function(f1, f2, vowel=NULL, group=NULL,
             ## prepare means args
             m.split <- split(m, seq(nrow(m)))
             m.args <- lapply(m.split, function(i) {
-                with(i, list(f2d[[1]], f1d[[1]], pch=pchm, cex=cex.means,
+                with(i, list(f2d[[1]], f1d[[1]], pch=pch.m, cex=cex.means,
                              col=col.means, lty=lty.means))
             })
             ## combine diph.args.means with m.args and plot
@@ -880,10 +897,10 @@ plotVowels <- function(f1, f2, vowel=NULL, group=NULL,
             }
         } else {
             if (is.null(pch.means)) {
-                with(m, points(f2, f1, col=col.means, pch=pchm,
+                with(m, points(f2, f1, col=col.means, pch=pch.m,
                                cex=cex.means))
             } else {
-                with(m, text(f2, f1, labels=pchm, col=col.means,
+                with(m, text(f2, f1, labels=pch.m, col=col.means,
                              cex=cex.means))
             }
         }
@@ -903,10 +920,10 @@ plotVowels <- function(f1, f2, vowel=NULL, group=NULL,
             legend.pch <- NULL
             if (length(legend.style.lab)) {
                 if (plot.means && all(grepl("[[:digit:]]", pch.means))) {
-                    legend.pch <- unique(m$pchm)
+                    legend.pch <- unique(m$pch.m)
                 } else if (plot.tokens &&
                                all(grepl("[[:digit:]]", pch.tokens))) {
-                    legend.pch <- unique(d$pch.tokens)
+                    legend.pch <- unique(d$pch.t)
                 }
             }
             ## legend col
@@ -1340,6 +1357,7 @@ prettyTicks <- function(lim) {
 
 ellipse <- function(mu, sigma, n, alpha=0.05, npoints=250, draw=TRUE, ...) {
     if (all(sigma == matrix(rep(0, 4), nrow=2))) return(rbind(mu, mu))
+    else if (n < 3) return(rbind(mu, mu))
     p <- length(mu)
     es <- eigen(sigma)
     e1 <- es$vectors %*% diag(sqrt(es$values))
@@ -1350,7 +1368,7 @@ ellipse <- function(mu, sigma, n, alpha=0.05, npoints=250, draw=TRUE, ...) {
     ## equivalent to an F distribution (hence the qf() function). For large n,
     ## this asymptotically approaches qchisq(1-alpha, p)
     scale.factor <- p * (n - 1) / (n - p)
-    critical.radius <- sqrt(scale.factor * qf(1-alpha, df1=p, df2=n-p))
+    critical.radius <- sqrt(scale.factor * qf(1 - alpha, df1=p, df2=n - p))
     ## if we needed it, this would be the t-squared statistic
     # tsquared <- n * t(mu) %*% solve(sigma) %*% mu
     pts <- t(mu - (e1 %*% t(critical.radius * unit.circle)))
@@ -1369,8 +1387,8 @@ makeTransparent <- function (color, opacity) {
 }
 
 uniquify <- function(x, default.val) {
-    ## x should be a vector
-    ux <- unique(x)
+    ## x should be a numeric/character vector or factor
+    ux <- unique(as.character(x))
     ifelse(length(ux) == 1, ux, default.val)
 }
 

From 0bce24121c7981e2bef9b5287b41e00c7e37b4dd Mon Sep 17 00:00:00 2001
From: drammock <dan.mccloy@gmail.com>
Date: Wed, 24 Aug 2016 11:22:18 -0700
Subject: [PATCH 10/11] update man file for var.style.by deprecation; simplify
 citation file

---
 inst/CITATION     |  9 ++++-----
 man/plotVowels.Rd | 10 +++++-----
 2 files changed, 9 insertions(+), 10 deletions(-)

diff --git a/inst/CITATION b/inst/CITATION
index c795548..82ccb83 100644
--- a/inst/CITATION
+++ b/inst/CITATION
@@ -1,16 +1,15 @@
 citHeader("To cite package 'phonR' in publications use:")
      
-     year <- sub(".*(2[[:digit:]]{3})-.*", "\\1", meta$Date, perl = TRUE)
+     year <- sub(".*(2[[:digit:]]{3})-.*", "\\1", meta$Date, perl=TRUE)
      vers <- paste("R package version", meta$Version)
      
      citEntry(entry="Manual",
               title = "phonR: tools for phoneticians and phonologists",
-              author = personList(as.person("Daniel McCloy")),
+              author = personList(as.person("Daniel R. McCloy")),
               year = year,
               note = vers,
      
               textVersion =
-              paste("Daniel McCloy (",
-                    year,
+              paste0("Daniel R. McCloy (", year,
                     "). phonR: tools for phoneticians and phonologists. ",
-                    vers, ".", sep=""))
+                    vers, "."))
diff --git a/man/plotVowels.Rd b/man/plotVowels.Rd
index 0a378f3..1a79fd1 100644
--- a/man/plotVowels.Rd
+++ b/man/plotVowels.Rd
@@ -22,7 +22,7 @@
                diph.mean.timept=1, diph.smooth=FALSE,
                heatmap=FALSE, heatmap.args=NULL,
                heatmap.legend=FALSE, heatmap.legend.args=NULL,
-               var.col.by=NULL, var.style.by=NULL,
+               var.col.by=NULL, var.sty.by=NULL,
                fill.opacity=0.3, label.las=NULL,
                legend.kwd=NULL, legend.args=NULL,
                pretty=FALSE, output='screen', ...)
@@ -135,8 +135,8 @@
                                a more complete description of the available arguments.}
     \item{var.col.by}{Vector or factor indicating the dimension along which to vary
                       color.}
-    \item{var.style.by}{Vector or factor indicating the dimension along which to
-                        vary linetype and plotting symbol.}
+    \item{var.sty.by}{Vector or factor indicating the dimension along which to
+                      vary linetype and plotting symbol.}
     \item{fill.opacity}{Number in the range [0, 1] indicating the opacity of
                         color fills for ellipses, hulls, and polygons (if drawn).
                         Does not affect \code{force.heatmap} colors, which are
@@ -186,7 +186,7 @@ data(indoVowels)
 with(indo, plotVowels(f1, f2, vowel, group=gender, plot.means=TRUE,
                       pch.means=vowel, ellipse.line=TRUE, poly.line=TRUE,
                       poly.order=c('i','e','a','o','u'), var.col.by=vowel,
-                      var.style.by=gender, pretty=TRUE, alpha.tokens=0.3,
+                      var.sty.by=gender, pretty=TRUE, alpha.tokens=0.3,
                       cex.means=2))
 # simulate some diphthongs
 f1delta <- sample(c(-10:-5, 5:15), nrow(indo), replace=TRUE)
@@ -204,7 +204,7 @@ indo <- within(indo, {
 with(indo, plotVowels(cbind(f1, f1a, f1b), cbind(f2, f2a, f2b), vowel,
                       group=gender, plot.tokens=TRUE, pch.tokens=NA,
                       alpha.tokens=0.3, plot.means=TRUE, pch.means=vowel,
-                      var.col.by=vowel, var.style.by=gender, pretty=TRUE,
+                      var.col.by=vowel, var.sty.by=gender, pretty=TRUE,
                       diph.arrows=TRUE, diph.args.tokens=list(lwd=0.8),
                       diph.args.means=list(lwd=2)))
 }

From 612e3cd3294afa1c2129baa90d5df34388240329 Mon Sep 17 00:00:00 2001
From: Daniel McCloy <dan.mccloy@gmail.com>
Date: Wed, 24 Aug 2016 13:36:15 -0700
Subject: [PATCH 11/11] fix integer-based symbol plotting for means; convert
 warnings to messages

---
 R/phonR.R | 83 ++++++++++++++++++++++++++++++-------------------------
 1 file changed, 45 insertions(+), 38 deletions(-)

diff --git a/R/phonR.R b/R/phonR.R
index aab843b..1a3d1c1 100644
--- a/R/phonR.R
+++ b/R/phonR.R
@@ -40,17 +40,17 @@ plotVowels <- function(f1, f2, vowel=NULL, group=NULL,
     font.specified <- "family" %in% names(exargs)
     ## to-be-deprecated items
     if ("var.style.by" %in% names(exargs)) {
-    	message("Argument 'var.style.by' has been deprecated and renamed ",
-    		    "'var.sty.by'. In future versions 'var.style.by' will no ",
-    		    "longer work; please update your code.")
-    	if (!is.null(var.sty.by)) {
-    		message("Additionally, you have passed both the old 'var.style.by'",
-    			    " and the new 'var.sty.by' arguments; the old one will be ",
-    			    "ignored.")
-    	} else {
-    		var.sty.by <- exargs$var.style.by
-    		exargs$var.style.by <- NULL
-    	}
+        message("[phonR]: Argument 'var.style.by' has been deprecated and ",
+                "renamed 'var.sty.by'. In future versions 'var.style.by' will ",
+                "no longer work; please update your code.")
+        if (!is.null(var.sty.by)) {
+            message("Additionally, you have passed both the old 'var.style.by'",
+                    " and the new 'var.sty.by' arguments; the old one will be ",
+                    "ignored.")
+        } else {
+            var.sty.by <- exargs$var.style.by
+            exargs$var.style.by <- NULL
+        }
     }
     ## two arguments get overridden no matter what
     exargs$ann <- FALSE
@@ -58,8 +58,9 @@ plotVowels <- function(f1, f2, vowel=NULL, group=NULL,
     ## Some graphical devices only support inches, so we convert here.
     if ("units" %in% names(exargs)) {
         if (!exargs$units %in% c("in", "cm", "mm", "px")) {
-            warning("Unsupported argument value '", units, "': 'units' must be",
-                    " one of 'in', 'cm', 'mm', or 'px'. Using default ('in').")
+            message("[phonR]: Unsupported argument value '", units, "': ",
+                    "'units' must be one of 'in', 'cm', 'mm', or 'px'. Using ",
+                    "default ('in').")
             exargs$units <- "in"
         }
         if (output %in% c("pdf", "svg", "screen")) {
@@ -139,7 +140,7 @@ plotVowels <- function(f1, f2, vowel=NULL, group=NULL,
     output.types <- c("pdf", "svg", "jpg", "tif", "png", "bmp", "screen")
     output.raster <- c("jpg", "tif", "png", "bmp", "screen")
     if (!(output %in% output.types)) {
-        warning("Unknown argument value '", output, "': 'output' ",
+        message("[phonR]: Unknown argument value '", output, "': 'output' ",
                 "must be one of 'pdf', 'svg', 'png', 'tif', 'bmp', ",
                 "'jpg', or 'screen'. Using default ('screen').")
         output <- "screen"
@@ -227,7 +228,7 @@ plotVowels <- function(f1, f2, vowel=NULL, group=NULL,
     if (is.null(vowel)) v <- rep(NA, l)
     else                v <- factor(vowel, levels=unique(vowel))
     if (is.null(group)) gf <- rep("gf", l)
-    else 			    gf <- factor(group, levels=unique(group))
+    else                gf <- factor(group, levels=unique(group))
     ## used later to set default polygon color when color varies by vowel
     col.by.vowel <- identical(as.numeric(factor(var.col.by)),
                               as.numeric(factor(vowel)))
@@ -540,12 +541,12 @@ plotVowels <- function(f1, f2, vowel=NULL, group=NULL,
                 i$sigma <- matrix(rep(0, 4), nrow=2)
                 msg <- ifelse(i$gf == "gf", as.character(i$v),
                               paste0("(", i$gf, ", ", i$v, ")"))
-                message("No ellipse drawn for ", msg,
+                message("[phonR]: No ellipse drawn for ", msg,
                         " because there is only one token.")
             } else if (i$n == 2) {
                 msg <- ifelse(i$gf == "gf", as.character(i$v),
                               paste0("(", i$gf, ", ", i$v, ")"))
-                message("No ellipse drawn for ", msg,
+                message("[phonR]: No ellipse drawn for ", msg,
                         " because there are only two tokens.")
             }
             list("mu"=i$mu, "sigma"=i$sigma, "n"=i$n, "alpha"=1 - ellipse.conf,
@@ -687,14 +688,14 @@ plotVowels <- function(f1, f2, vowel=NULL, group=NULL,
     ## ## ## ## ## ## ##
     if (!is.na(poly.order[1]) && (poly.fill || poly.line)) {
         if (length(poly.order) != length(unique(poly.order))) {
-            message("Duplicate entries in 'poly.order' detected; they will be ",
-                    "ignored.")
+            message("[phonR]: Duplicate entries in 'poly.order' detected; they",
+                    " will be ignored.")
         }
         poly.order <- as.character(poly.order) # as.character in case factor
         v <- unique(as.character(m$v))
         if (length(setdiff(poly.order, v)) > 0) {
-            message("There are vowels in 'poly.order' that are not in ",
-                    "'vowel'; they will be ignored.")
+            message("[phonR]: There are vowels in 'poly.order' that are not in",
+                    " 'vowel'; they will be ignored.")
         }
         poly.order <- intersect(poly.order, v)
         pp <- m
@@ -737,9 +738,10 @@ plotVowels <- function(f1, f2, vowel=NULL, group=NULL,
             timepts <- length(d$f2d[[1]])
             ## no smoothing splines
             if (!diph.smooth || timepts < 4) {
-                if (diph.smooth) warning("Cannot smooth diphthong traces with ",
-                                         "fewer than 4 timepoints. Plotting ",
-                                         "connecting segments instead.")
+                if (diph.smooth) message("[phonR]: Cannot smooth diphthong ",
+                                         "traces with fewer than 4 timepoints.",
+                                         " Plotting connecting segments ",
+                                         "instead.")
                 ## plot first point
                 if (diph.label.first.only) {
                     if (!is.null(pch.tokens)) {
@@ -811,7 +813,7 @@ plotVowels <- function(f1, f2, vowel=NULL, group=NULL,
                                          diph.args.tokens))
                     },
                     error=function(e){
-                        message("Warning: could not plot diphthong smoother. ",
+                        message("[phonR]: Could not plot diphthong smoother. ",
                                 "Plotting connecting segments instead.")
                         message(paste(e, ""))
                         if (diph.arrows) {
@@ -883,8 +885,10 @@ plotVowels <- function(f1, f2, vowel=NULL, group=NULL,
                 m.arr.args <- lapply(m.split, function(i) {
                     xd <- 0.01*diff(i$f2d[[1]][(timepts-1):timepts])
                     yd <- 0.01*diff(i$f1d[[1]][(timepts-1):timepts])
-                    with(i, list(x0=f2d[[1]][timepts]-xd, y0=f1d[[1]][timepts]-yd,
-                                 x1=f2d[[1]][timepts], y1=f1d[[1]][timepts],
+                    with(i, list(x0=f2d[[1]][timepts] - xd,
+                                 y0=f1d[[1]][timepts] - yd,
+                                 x1=f2d[[1]][timepts],
+                                 y1=f1d[[1]][timepts],
                                  col=col.means, lwd=lwd.means))
                 })
                 ## combine with diph.arrow.means and plot
@@ -911,7 +915,7 @@ plotVowels <- function(f1, f2, vowel=NULL, group=NULL,
     ## ## ## ## ##
     if (!is.null(legend.kwd)) {
         if (is.null(legend.col.lab) && is.null(legend.style.lab)) {
-            warning("Legend will not be drawn because var.col.by and ",
+            message("[phonR]: Legend will not be drawn because var.col.by and ",
                     "var.sty.by are both NULL or NA. You will have to use ",
                     "the legend() function.")
         } else {
@@ -1078,7 +1082,7 @@ normVowels <- function(method, f0=NULL, f1=NULL, f2=NULL, f3=NULL,
     else {
         f <- as.matrix(cbind(f1=f1, f2=f2))
         return(normWattFabricius(f, vowel, group))
-}	}
+}    }
 
 
 ## ## ## ## ## ## ## ## ## ## ## ## ## ##
@@ -1089,7 +1093,7 @@ normBark <- function(f) {
     bark <- 26.81 * f / (1960 + f) - 0.53
     bark[bark < 2] <- bark[bark < 2] + 0.15 * (2 - bark[bark < 2])
     bark[bark > 20.1] <- bark[bark > 20.1] + 0.22 * (bark[bark > 20.1] - 20.1)
-	return(bark)
+    return(bark)
 }
 
 #' @export
@@ -1116,7 +1120,7 @@ normLobanov <- function(f, group=NULL) {
         groups <- split(f, group)
         scaled <- lapply(groups, function(x) as.data.frame(scale(x)))
         return(unsplit(scaled, group))
-}	}
+}    }
 
 #' @export
 normLogmean <- function(f, group=NULL, exp=FALSE, ...) {
@@ -1190,7 +1194,7 @@ normWattFabricius <- function(f, vowel, group=NULL) {
     min.id <- apply(means, 2, function(i) apply(do.call(rbind, i), 2, which.min))
     max.id <- apply(means, 2, function(i) apply(do.call(rbind, i), 2, which.max))
     if (length(unique(min.id["f1",]))>1) {
-        warning("The vowel with the lowest mean F1 value (usually /i/)",
+        message("[phonR]: The vowel with the lowest mean F1 value (usually /i/)",
                 "does not match across all speakers/groups. You'll ",
                 "have to calculate s-centroid manually.")
         print(data.frame(minF1=minima["f1",],
@@ -1198,7 +1202,7 @@ normWattFabricius <- function(f, vowel, group=NULL) {
                 group=dimnames(means)[[2]]))
         stop()
     } else if (length(unique(max.id["f1",]))>1) {
-        warning("The vowel with the highest mean F1 value (usually /a/) ",
+        message("[phonR]: The vowel with the highest mean F1 value (usually /a/) ",
                 "does not match across all speakers/groups. You'll ",
                 "have to calculate s-centroid manually.")
         print(data.frame(maxF1=round(maxima["f1",]),
@@ -1220,13 +1224,13 @@ normWattFabricius <- function(f, vowel, group=NULL) {
 #' @export
 vowelMeansPolygonArea <- function(f1, f2, vowel, poly.order, group=NULL) {
     if (length(poly.order) != length(unique(poly.order))) {
-        warning("Duplicate entries in 'poly.order' detected; they will be ",
-                "ignored.")
+        message("[phonR]: Duplicate entries in 'poly.order' detected; they ",
+                "will be ignored.")
     }
     poly.order <- unique(as.character(poly.order)) # as.character in case factor
     v <- unique(as.character(vowel))
     if (length(setdiff(poly.order, v)) > 0) {
-        warning("There are vowels in 'poly.order' that are not in ",
+        message("[phonR]: There are vowels in 'poly.order' that are not in ",
                 "'vowel'; they will be ignored.")
         poly.order <- intersect(poly.order, v)
     }
@@ -1387,8 +1391,11 @@ makeTransparent <- function (color, opacity) {
 }
 
 uniquify <- function(x, default.val) {
-    ## x should be a numeric/character vector or factor
-    ux <- unique(as.character(x))
+    ## handle factors smartly
+    y <- suppressWarnings(as.numeric(as.character(x)))
+    if (any(is.na(y))) x <- as.character(x)
+    else x <- y
+    ux <- unique(x)
     ifelse(length(ux) == 1, ux, default.val)
 }