diff --git a/R/phonR.R b/R/phonR.R index 1a3d1c1..a8786eb 100644 --- a/R/phonR.R +++ b/R/phonR.R @@ -306,12 +306,22 @@ plotVowels <- function(f1, f2, vowel=NULL, group=NULL, ## color: use default pallete if none specified and pretty=FALSE if (!"col" %in% names(exargs)) exargs$col <- palette() ## linetypes & plotting characters - if (!"lty" %in% names(exargs)) exargs$lty <- seq_len(num.sty) + if (!"lty" %in% names(exargs)) { + if (all(var.col.by==as.numeric(factor(group, levels=unique(group))))) { + exargs$lty <- seq_len(num.col) + } else { + 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] + if (all(var.col.by==as.numeric(factor(group, levels=unique(group))))) { + exargs$lty <- rep(exargs$lty, length.out=num.col)[var.col.by] + } else { + 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)) pch.t <- exargs$pch @@ -378,9 +388,15 @@ plotVowels <- function(f1, f2, vowel=NULL, group=NULL, ## polygon colors if (poly.line) { if ("lty" %in% names(poly.args)) { - poly.args$lty <- rep(poly.args$lty, length.out=num.sty) - if (vary.sty) poly.line.sty <- poly.args$lty[var.sty.by] - else poly.line.sty <- poly.args$lty + if (all(var.sty.by==as.numeric(factor(group, levels=unique(group))))) { + poly.args$lty <- rep(poly.args$lty, length.out=num.sty) + poly.line.sty <- poly.args$lty[var.sty.by] + } else if (all(var.col.by==as.numeric(factor(group, levels=unique(group))))) { + poly.args$lty <- rep(poly.args$lty, length.out=num.col) + poly.line.sty <- poly.args$lty[var.col.by] + } else { + poly.line.sty <- poly.args$lty + } poly.args$lty <- NULL } else { poly.line.sty <- exargs$lty @@ -469,6 +485,8 @@ plotVowels <- function(f1, f2, vowel=NULL, group=NULL, } if (is.null(vowel) && is.null(group)) { byd <- list(d=d) + } else if (all(var.col.by==as.numeric(factor(group, levels=unique(group))))) { + byd <- by(d, d[c("gf","v")], identity) } else { byd <- by(d, d[c("v", "gf")], identity) } @@ -980,7 +998,11 @@ plotVowels <- function(f1, f2, vowel=NULL, group=NULL, legend.lty <- rep(legend.lty, length.out=length(legend.col.lab)) } else if (length(legend.col.lab)) { - legend.lty <- c(legend.lty, rep(NA, length(legend.col.lab))) + if (all(var.col.by==as.numeric(factor(group,levels=unique(group))))) { + legend.lty <- c(rep(NA, length(legend.style.lab)), legend.lty) + } else { + legend.lty <- c(legend.lty, rep(NA, length(legend.col.lab))) + } } } ## reconcile @@ -1006,6 +1028,14 @@ plotVowels <- function(f1, f2, vowel=NULL, group=NULL, legend.brd <- legend.bgf legend.col <- c(rep(par("fg"), length(legend.style.lab)), legend.col) + ## handle case: col.by.vowel and poly.line & sty by group + } else if (vary.sty && vary.col && is.null(legend.bgf) && poly.line && + all(var.sty.by==as.numeric(factor(group,levels=unique(group))))) { + legend.col <- c(rep(par("fg"), length(legend.style.lab)), + legend.col) + legend.bgf <- c(rep(NA, length(legend.style.lab)), + legend.col[-(1:length(legend.style.lab))]) + legend.brd <- legend.bgf ## handle other cases } else { nas <- rep(NA, length(legend.style.lab)) @@ -1043,6 +1073,7 @@ plotVowels <- function(f1, f2, vowel=NULL, group=NULL, } ## draw legend do.call(legend, legend.args) + # return(legend.args) } } @@ -1053,6 +1084,7 @@ plotVowels <- function(f1, f2, vowel=NULL, group=NULL, if (output != "screen") dev.off() ## reset graphical parameters to defaults par(op) + # return(list(byd, group, var.col.by, legend.col)) } diff --git a/tests/test-legend.R b/tests/test-legend.R new file mode 100644 index 0000000..71cb097 --- /dev/null +++ b/tests/test-legend.R @@ -0,0 +1,21 @@ +#!/usr/bin/env R + +source("../R/phonR.R") +load("../data/indoVowels.rda") + +colorby <- rep(c("vowel", "subj", "gender"), each=3) +styleby <- rep(c("vowel", "subj", "gender"), times=3) +grouping <- c("subj", "gender", NA, "gender", NA, "subj", NA, "subj", "gender") + + +cairo_pdf("test-legend-master.pdf", width=16, height=16, pointsize=12, + family="Charis SIL") + par(mfrow=c(3, 3)) + mapply(FUN=function(cb, sb, gr) { + title <- paste0("var.col.by=", cb, ", var.sty.by=", sb, ", group=", gr, collapse="") + plotVowels(indo$f1, indo$f2, indo$vowel, group=indo[[gr]], + var.col.by=indo[[cb]], var.sty.by=indo[[sb]], pretty=TRUE, + plot.tokens=TRUE, plot.means=FALSE, ellipse.line=TRUE, + legend.kwd='bottomright', main=title) + }, colorby, styleby, grouping) +dev.off()