Circadian Phase plot in R - r

Question

I've seen a figure in a paper (Perales & Mas, 2007; Plant Cell) and I'm interested in making a similar graph with my data in R.
I have some circadian gene expression data and I need to represent which is the phase (the maximum peak of expression of a certain gene) of some genes. The graph I'm refering to is like a clock in which you can see at what time a gene has its maximum peak of expression.
(C) Phase plot of TOC1:LUC and CAB2:LUC expression in wild-type and TMG plants under the indicated photoperiods. Phases (phase/period × 24 h) were plotted against the strength of the rhythm expressed as relative amplitude error. The rhythm strength is graphed from 0 (center of the plot) to 0.8 (periphery of the circle), which indicates robust and very weak rhythms, respectively.

Answer 1

## generate data
set.seed(1);
gen <- data.frame(gene=c(rep('TOC1',3),rep('CAB2',3)), plant=c(rep(NA,3),'WT','WT','TMG'), photoperiod=c('8:16','12:12','16:8','8:16','16:8','8:16'), hourmean=c(11,13.5,15,4,6.5,6.5), hoursd=c(0.25,0.25,0.25,0.4,0.15,0.4), strengthmean=c(0.25,0.2,0.25,0.32,0.35,0.4), strengthsd=c(0.035,0.03,0.035,0.02,0.03,0.02), num=c(20,20,20,5,10,10), stringsAsFactors=F );
df <- cbind(as.data.frame(lapply(gen[,c('gene','plant','photoperiod')],rep,gen$num)),hour=rnorm(sum(gen$num),rep(gen$hourmean,gen$num),rep(gen$hoursd,gen$num)),strength=rnorm(sum(gen$num),rep(gen$strengthmean,gen$num),rep(gen$strengthsd,gen$num)));
tau <- 2*pi;
## define point specifications per group
ptspec <- data.frame(gene=c('TOC1','TOC1','TOC1','CAB2','CAB2','CAB2'), plant=c(NA,NA,NA,'WT','WT','TMG'), photoperiod=c('8:16','12:12','16:8','8:16','16:8','8:16'), pch=c(22,22,22,21,21,24), col=c('black','red','blue','black','blue','red'), bg=c('white','white','white','black','blue','white'), cex=1.8, lwd=3, stringsAsFactors=F );
## define virtual plot margins and overall plot region
A <- 24;
R <- 0.8;
imar <- 0.25;
bmar <- 0.4;
xlim <- c(-R,R)*(1+imar);
ylim <- c(-R*(1+imar+bmar),R*(1+imar));
## define angular and radial tick parameters
atick <- seq(0,A,3)[-A/3-1];
rtick <- seq(0,R,0.2);
atickLen <- R/50;
atickLabelDist <- atickLen*6;
## plotting helper functions
circles <- function(x,y,r,n=1000,col,lty,lwd,...) {
comb <- cbind(x,y,r);
angles <- tau*0:n/n;
if (!missing(col) && !is.null(col)) col <- rep(col,len=nrow(comb));
if (!missing(lty) && !is.null(lty)) lty <- rep(lty,len=nrow(comb));
if (!missing(lwd) && !is.null(lwd)) lwd <- rep(lwd,len=nrow(comb));
for (i in 1:nrow(comb)) {
args <- list(
comb[i,'x']+comb[i,'r']*cos(angles),
comb[i,'y']+comb[i,'r']*sin(angles)
);
if (!missing(col)) if (is.null(col)) args['col'] <- list(NULL) else args$col <- col[i];
if (!missing(lty)) if (is.null(lty)) args['lty'] <- list(NULL) else args$lty <- lty[i];
if (!missing(lwd)) if (is.null(lwd)) args['lwd'] <- list(NULL) else args$lwd <- lwd[i];
do.call(lines, c(args,...) );
}; ## end for
}; ## end circles()
radials <- function(x,y,a,r,...) {
comb <- cbind(x,y,a,r);
segments(comb[,'x'],comb[,'y'],comb[,'x']+comb[,'r']*cos(comb[,'a']),comb[,'y']+comb[,'r']*sin(comb[,'a']),...);
}; ## end radials()
## main plot
par(mar=c(1,1,1,1)+0.1,xaxs='i',yaxs='i');
plot(NA,xlim=xlim,ylim=ylim,axes=F,xlab='',ylab='');
circles(0,0,rtick,col='#aaaaaa',lty=3);
circles(0,0,R,lwd=2);
radials(0,0,tau*atick/A,R,col='#aaaaaa');
radials(R*cos(tau*atick/A),R*sin(tau*atick/A),tau*atick/A,atickLen,lwd=2);
text((R+atickLabelDist)*cos(tau*atick/A),(R+atickLabelDist)*sin(tau*atick/A),(A-atick+6)%%A,family='sans',font=2,cex=2);
with(merge(df,ptspec)[nrow(df):1,],points(strength*cos(tau*(A-hour+6)%%A/A),strength*sin(tau*(A-hour+6)%%A/A),pch=pch,col=col,bg=bg,cex=cex,lwd=lwd));
## common legend precomputations
legendTopSpace <- R/10;
legendBotSpace <- R/10;
legendDivCut <- R/20;
legendTop <- -R-legendTopSpace;
legendBot <- ylim[1]+legendBotSpace;
legendDivTop <- legendTop-legendDivCut;
legendDivBot <- legendBot+legendDivCut;
legendDivLeftSpace <- R/20;
legendDivRightSpace <- R/10;
legendPtSpace <- R/15;
## legend 1
legend1Gene <- 'TOC1';
legend1PtSpec <- subset(ptspec,gene==legend1Gene);
legend1PtSpec <- legend1PtSpec[nrow(legend1PtSpec):1,];
legend1DivX <- -R+2/5*R;
segments(legend1DivX,legendDivBot,legend1DivX,legendDivTop,lwd=3);
text(legend1DivX-legendDivLeftSpace,(legendTop+legendBot)/2,legend1Gene,c(1,NA),family='sans',font=2,cex=1.5);
legend1PtX <- legend1DivX+legendDivRightSpace;
legend1PtYSpace <- (legendTop-legendBot)/(nrow(legend1PtSpec)+1);
legend1PtY <- seq(legendBot+legend1PtYSpace,legendTop-legend1PtYSpace,len=nrow(legend1PtSpec));
with(legend1PtSpec,points(rep(legend1PtX,nrow(legend1PtSpec)),legend1PtY,pch=pch,col=col,bg=bg,cex=cex,lwd=lwd));
legend1LabelX <- legend1PtX+legendPtSpace;
text(rep(legend1LabelX,nrow(legend1PtSpec)),legend1PtY,with(legend1PtSpec,ifelse(is.na(plant),photoperiod,paste(plant,photoperiod))),c(0,NA),family='sans',font=2,cex=1.5);
## legend 2
legend2Gene <- 'CAB2';
legend2PtSpec <- subset(ptspec,gene==legend2Gene);
legend2PtSpec <- legend2PtSpec[nrow(legend2PtSpec):1,];
legend2DivX <- 2/5*R;
segments(legend2DivX,legendDivBot,legend2DivX,legendDivTop,lwd=3);
text(legend2DivX-legendDivLeftSpace,(legendTop+legendBot)/2,legend2Gene,c(1,NA),family='sans',font=2,cex=1.5);
legend2PtX <- legend2DivX+legendDivRightSpace;
legend2PtYSpace <- (legendTop-legendBot)/(nrow(legend2PtSpec)+1);
legend2PtY <- seq(legendBot+legend2PtYSpace,legendTop-legend2PtYSpace,len=nrow(legend2PtSpec));
with(legend2PtSpec,points(rep(legend2PtX,nrow(legend2PtSpec)),legend2PtY,pch=pch,col=col,bg=bg,cex=cex,lwd=lwd));
legend2LabelX <- legend2PtX+legendPtSpace;
text(rep(legend2LabelX,nrow(legend2PtSpec)),legend2PtY,with(legend2PtSpec,ifelse(is.na(plant),photoperiod,paste(plant,photoperiod))),c(0,NA),family='sans',font=2,cex=1.5);