I'm attempting to make a "slope graph" visualization in R, similar to the visualization found in this blog post here:
http://www.r-bloggers.com/a-nifty-line-plot-to-visualize-multivariate-time-series/
I'm scrapping golf scores from Rounds 1,2 and 3 of the Masters and have arranged the 93 Golfer's names in the same format as found in the blog post. Note: Golfers are eliminated from round to round, so I generated some fake scores just to keep the data set free of gaps (will return to this issue later).
I'm using the plot.qual function, the code for which can be found on git here: https://gist.github.com/fawda123/5281518/raw/a7194a748cda5a8d2ea83f87e4a59496ee5e0953/plot_qual.r
Note: For some reason I could not use the paste0 function, so I altered the code to paste(...,sep=" ",...). Not sure if this is causing the issue or not.
I've stored the data in Masters.2013. The data is in the same format as the blog post, although there are more columns (93) than the blog post uses (25).
When I run plot.qual(Masters.2013), I get the following error message:
> plot.qual(Masters.2013) Warning message: In plot.qual(Masters.2013) : not enough space for lines between columns
I reduced the number of columns to 25, 5, 2, etc. (plot.qual(Masters.2013[,1:5]), but the error message persists each time.
The plot comes out looking crowded with no lines (Would post image but do not have enough reputation)
I don't think the issue is with the data, as the format is the same as the blog post, and appears to be nearly working.
plot.qual code below
EDIT: Adding some sample data (below), thanks for those who commented. Also- When adding par(cex=.5) it produces a better result, however I'm wondering if the text can size automatically so the connecting lines always meet with the edges of the text.
Data=structure(list(PLAYER = structure(1:3, .Label = c("Round 1",
"Round 2", "Round 3"), class = "factor"), Marc.Leishman = c(66L,
66L, 69L), Fred.Couples = c(68L, 71L, 73L), Jim.Furyk = c(69L,
69L, 70L), Tiger.Woods = c(70L, 70L, 71L), Angel.Cabrera = c(71L,
69L, 68L), John.Senden = c(72L, 72L, 67L), Adam.Scott = c(69L,
72L, 78L), Jason.Dufner = c(72L, 69L, 64L), David.Lynn = c(68L,
73L, 71L), Lee.Westwood = c(70L, 70L, 80L), Justin.Rose = c(70L,
70L, 70L), K.J..Choi = c(70L, 70L, 74L), Rickie.Fowler = c(68L,
68L, 76L), Jason.Day = c(70L, 70L, 73L)), .Names = c("PLAYER",
"Marc.Leishman", "Fred.Couples", "Jim.Furyk", "Tiger.Woods",
"Angel.Cabrera", "John.Senden", "Adam.Scott", "Jason.Dufner",
"David.Lynn", "Lee.Westwood", "Justin.Rose", "K.J..Choi", "Rickie.Fowler",
"Jason.Day"), row.names = c(NA, 3L), class = "data.frame")
plot.qual<-function(x,x.locs=c(0.01,0.99),y.locs=c(0,1),steps=NULL,sp.names=NULL,dt.tx=T,rsc=T,
ln.st=NULL,rs.ln=c(3,15),ln.cl='RdYlGn',alpha=0.7,leg=T,...){
require(RColorBrewer)
require(scales)
if(length(x.locs) != 2 | length(y.locs) != 2)
stop('x and y dimensions must be two-element vectors')
if(x.locs[1]<0 | x.locs[2]>1 | y.locs[1]<0 | y.locs[2]>1)
stop('x and y dimensions must in range of 0--1')
dim.x<-c(0,1) #plot dims x
dim.y<-c(0,1) #plot dims y
wrn.val<-F
x[,1]<-as.character(x[,1])
tot.sp<-ncol(x)-1
sp.col<-2:ncol(x)
#rescale if T, sort legend for later
sp.orig<-x[,sp.col]
if(length(rs.ln)==1) rsc<-F
if(rsc) x[,sp.col]<-rescale(x[,sp.col],rs.ln)
if(rsc==F & leg) leg<-F #no legend if line widths aren't rescaled
#reorder species columns, add rank as integer
first.ord<-order(x[1,sp.col],decreasing=T)
x[,sp.col]<-x[,sp.col][,first.ord]
names(x)[sp.col]<-names(x)[sp.col][first.ord]
names(x)[sp.col]<-paste(1:tot.sp,sep=" ",names(x)[sp.col])
#list of spp by date, arranged in decreasing order for each date
dt.dat.srt<-vector('list',nrow(x))
names(dt.dat.srt)<-x[,1]
for(val in 1:nrow(x)){
tmp<-t(x[val,sp.col])
tmp<-tmp[order(tmp,decreasing=T),,drop=F]
dt.dat.srt[[val]]<-tmp
}
#initiate plot object
plot(dim.x,dim.y,type='n',axes=F,xlab='',ylab='',...)
#subset for steps, if provided
if(!is.null(steps)) dt.dat.srt<-dt.dat.srt[names(dt.dat.srt) %in% steps]
#plot legend
if(leg){
y.locs[1]<-0.05*diff(y.locs)+y.locs[1]
leg.txt<-format(round(seq(min(sp.orig),max(sp.orig),length=5),2),nsmall=2,digits=2)
leg.wds<-seq(rs.ln[1],rs.ln[2],length=5)
legend('bottom',(y.locs[1]- y.olds)/2,col=alpha('black',alpha),lwd=leg.wds,legend=leg.txt,bty='n',
horiz=T)
}
#x locations
x.vals<-rep(seq(x.locs[1],x.locs[2],length=length(dt.dat.srt)),each=tot.sp)
x.vals<-split(x.vals,x.vals)
#y locations, rearranged in loop, exception if dates are plotted
if(dt.tx) y.vals<-rev(seq(y.locs[1],y.locs[2],length=tot.sp+1))[-1]
else y.vals<-rev(seq(y.locs[1],y.locs[2],length=tot.sp))
#get line colors
if(length(ln.cl)==1)
if(ln.cl %in% row.names(brewer.pal.info)){
pal.num<-brewer.pal.info[row.names(brewer.pal.info) == ln.cl,1]
ln.cl<-brewer.pal(pal.num,ln.cl)
}
line.cols<-alpha(colorRampPalette(ln.cl)(tot.sp),alpha)
#define distance of lines from labels
if(is.null(ln.st)){
str.max<-max(strwidth(row.names(dt.dat.srt[[1]])))
if(diff(x.locs)-length(dt.dat.srt)*str.max < 0){
warning('not enough space for lines between columns')
wrn.val<-T
}
else
ln.st<-0.2*str.max + str.max/2
}
for(val in 1:(length(dt.dat.srt)-1)){
#temp data to plot
plt.tmp<-dt.dat.srt[c(val,val+1)]
x.tmp<-x.vals[c(val,val+1)]
#plot temp text for column
text(x.tmp[[1]],y.vals,row.names(plt.tmp[[1]]))
if(val == length(dt.dat.srt)-1){
text(x.tmp[[2]],y.vals,row.names(plt.tmp[[2]]))
if(dt.tx){
dt.txt<-substitute(italic(x),list(x=names(plt.tmp)[2]))
text(unique(x.tmp[[2]]),y.locs[2],dt.txt)
}
}
if(dt.tx){
dt.txt<-substitute(italic(x),list(x=names(plt.tmp)[1]))
text(unique(x.tmp[[1]]),y.locs[2],dt.txt)
}
srt.ln.y<-match(row.names(plt.tmp[[1]]),row.names(plt.tmp[[2]]))
#if no line rescale, use first element of rs.ln
if(rsc) lwd.val<-plt.tmp[[1]][,1]
else lwd.val<-rep(rs.ln[1],tot.sp)
#vector for species selection of line segments
if(is.null(sp.names)) sel.sp<-rep(T,tot.sp)
else{
sel.names<-unlist(lapply(strsplit(row.names(plt.tmp[[1]]),' '),function(x) x[2]))
sel.sp<-(sel.names %in% sp.names)
}
#for lines
if(!wrn.val)
segments(
x.tmp[[1]][sel.sp]+ln.st,
y.vals[sel.sp],
x.tmp[[2]][sel.sp]-ln.st,
y.vals[srt.ln.y][sel.sp],
col=line.cols[sel.sp],
lwd=lwd.val[sel.sp]
)
#resort color vector for next colummn
srt.cl.y<-match(row.names(plt.tmp[[2]]),row.names(plt.tmp[[1]]))
line.cols<-line.cols[srt.cl.y]
}
}
par(mar=c(1,1,1,1),family='serif',cex=.5)
plot.qual(Data)
