T-shirt design for this year's Latin American PCM workshop in San Juan, Puerto Rico

Part of the tradition of the workshop series I have been offering over the past few years has beeen to include a course t-shirt, and part of this tradition has become to build the design of the t-shirt entirely using R. For instance, see previous designs for workshops in Valdivia, Chile, UNAM in Mexico City, and Ilhabela, Brazil.

This is possibly the most elaborate yet as I had the idea to first use phylo.to.map to show a geographic map with points in countries from which we've had students in this or previous editions, then to blow up the island of Puerto Rico (our home for this workshop version), and, finally, to overlay a flag of Puerto Rico onto the island.

For this one you will have to install the packages mapdata and png, not to mention the latest version of phytools.

library(phytools)
library(mapdata)
library(png)

## set seed
set.seed(289)

## shuffle function
shuffle<-function(ind,n){
    for(i in 1:n){
        ## pick 2
        ii<-sample(1:length(ind),2)
        ## swap 'em
        x<-ind[ii[1]]
        y<-ind[ii[2]]
        ind[ii[1]]<-y
        ind[ii[2]]<-x
    }
    ind
}

## shadow text function
shadowtext<-function(x,y,labels,...,
    offset=0.05,shadow.col="grey",col="black"){
    if(length(offset)==1) offset<-rep(offset,2)
    if(hasArg(cex)) cex<-list(...)$cex else cex<-1
    asp<-par()$din[2]/par()$din[1]
    offset.x<-offset[1]*strwidth("W")*cex
    offset.y<-offset[2]*strheight("W")*cex
    text(x-offset.x,y+offset.y,labels,...,col=shadow.col)
    text(x,y,labels,...,col=col)
}

## read in city coordinates
coords<-read.csv(
    file="http://www.phytools.org/SanJuan2016/data/Latin-American-cities.csv",
    row.names=1)
coords<-coords[1:12,] ## first twelve
coords<-as.matrix(coords)
rownames(coords)<-gsub(" ","_",rownames(coords))
coords<-coords[order(coords[,1]),]

## stretch the tree a little bit to make it look better
tree<-phytools:::lambdaTree(pbtree(n=nrow(coords),
    tip.label=rownames(coords),scale=1),0.8)
tree$tip.label<-shuffle(tree$tip.label,1)

## create an object (first pass)
obj<-phylo.to.map(tree,coords,database="worldHires",plot=FALSE,
    regions=c("Argentina","Bolivia","Brazil","Chile","Colombia",
    "Costa Rica","Cuba","Dominican Republic","Ecuador","El Salvador",
    "French Guiana","Guatemala","Haiti","Honduras",
    "Mexico","Nicaragua","Panama","Paraguay","Peru",
    "Puerto Rico","Saint Bartelemy","Saint Martin","Uruguay",
    "Venezuela",
    "Belize","Guyana","Suriname","Jamaica"),rotate=FALSE)
## get elements that correspond with the main island of PR
ii<-grep("Puerto Rico",obj$map$names)-1
jj<-which(is.na(obj$map$x))
pr.x<-obj$map$x[(jj[ii[1]]+1):(jj[ii[1]+1]-1)]
pr.y<-obj$map$y[(jj[ii[1]]+1):(jj[ii[1]+1]-1)]
## move San Juan (we're going to make the island big
coords["San_Juan",]<-20*(coords["San_Juan",]-c(mean(pr.y),mean(pr.x)))+
    c(28,-50)
## create phylo.to.map object to plot
obj<-phylo.to.map(tree,coords,database="worldHires",plot=FALSE,
    regions=c("Argentina","Bolivia","Brazil","Chile","Colombia",
    "Costa Rica","Cuba","Dominican Republic","Ecuador","El Salvador",
    "French Guiana","Guatemala","Haiti","Honduras",
    "Mexico","Nicaragua","Panama","Paraguay","Peru",
    "Puerto Rico","Saint Bartelemy","Saint Martin","Uruguay",
    "Venezuela",
    "Belize","Guyana","Suriname","Jamaica"),rotate=FALSE)

## layout for our heading
layout(matrix(c(1,2),2,1),heights=c(0.16,0.84))
par(mar=rep(0,4))
## create header
plot.new()
plot.window(xlim=c(-1,1),ylim=c(-1,1))
shadowtext(x=0,y=0.2,
    "Latin American Macroevolution Workshop\nSan Juan, Puerto Rico",
    cex=1.8)
shadowtext(x=0,y=-0.9,"June 28 - July 1, 2016",cex=1)
## plot phylo.to.map object
par(lwd=2)
plot(obj,direction="rightwards",ftype="off",lwd=2,split=c(0.17,0.83),
    xlim=c(-120,-36),colors="blue",pch=21)
ii<-grep("Puerto Rico",obj$map$names)-1
jj<-which(is.na(obj$map$x))
pr.x<-obj$map$x[(jj[ii[1]]+1):(jj[ii[1]+1]-1)]
pr.y<-obj$map$y[(jj[ii[1]]+1):(jj[ii[1]+1]-1)]
## this is for the blowout box
box1.x<-c(-67.20739,-67.17,-65.62316,-65.92952)
box1.y<-c(17.95173,18.47613,18.38505,17.96829)
box2.x<-20*(box1.x-mean(pr.x))-50
box2.y<-20*(box1.y-mean(pr.y))+28
## lines for PR blowout
for(i in 1:4) lines(c(box1.x[i],box2.x[i]),c(box1.y[i],box2.y[i]),lwd=1,
    lty="dashed")
## blowout PR (although we we actually plot our PNG
mm.x<-mean(pr.x)
mm.y<-mean(pr.y)
pr.x<-20*(pr.x-mm.x)-50
pr.y<-20*(pr.y-mm.y)+28
## read PNG
download.file("http://www.phytools.org/SanJuan2016/data/PR_flag_island.png", 
    "PR_flag_island.png",mode="wb")
pr.flag<-readPNG(source="PR_flag_island.png")
## add image to map
rasterImage(pr.flag,min(pr.x),min(pr.y),max(pr.x),max(pr.y))
X<-read.csv("http://www.phytools.org/SanJuan2016/data/PR_MAP_Coordinates.csv",
    row.names=1)
polygon(19.9*(X[7605:24846,1]-mm.x)-50,
    19.9*(X[7605:24846,2]-mm.y)+28,
    lwd=2)
## re-plot the cities and the line to San Juan to it overlies PNG
lastPP<-get("last_plot.phylo", envir = .PlotPhyloEnv)
lines(c(lastPP$xx[which(obj$tree$tip.label=="San_Juan")],
    coords["San_Juan",2]),
    c(lastPP$yy[which(obj$tree$tip.label=="San_Juan")],
    coords["San_Juan",1]),lty="dashed",col="blue")
points(coords[,2],coords[,1],pch=21,fg="black",bg="blue",cex=1.1,lwd=1)
points(lastPP$xx[1:Ntip(tree)],lastPP$yy[1:Ntip(tree)],pch=21,fg="black",
    bg="blue",cex=0.8,lwd=1)

Here is a (somewhat blurry) photo of all the course students & instructors sporting the design!

(Larger version here.)

Better still, here is a snapshot from when we built the design in R during the final exercise of the course (on visualization methods):

(Photo by Saúl Domínguez Guerrero.)

Thanks to all the participants for a terrific workshop - as well as to my co-instructors Luke Harmon, Mike Alfaro, and especially Ricardo Betancur for making it all happen.