## Sunday, July 3, 2016

### 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
}

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,y,labels,...,col=col)
}

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",
"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",
"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(matrix(c(1,2),2,1),heights=c(0.16,0.84))
par(mar=rep(0,4))
plot.new()
plot.window(xlim=c(-1,1),ylim=c(-1,1))
"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
"PR_flag_island.png",mode="wb")
rasterImage(pr.flag,min(pr.x),min(pr.y),max(pr.x),max(pr.y))
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.