我试图制作一个"斜率图" R中的可视化,类似于此博客文章中的可视化:
http://www.r-bloggers.com/a-nifty-line-plot-to-visualize-multivariate-time-series/
我从大师赛第1,2和第3轮废弃高尔夫比分,并以与博文中相同的格式安排了93个高尔夫球手的名字。 注意:高尔夫球手被逐轮淘汰,所以我生成了一些假分数,以保证数据集没有差距(稍后会回到这个问题)。
我正在使用plot.qual函数,其代码可以在git上找到: https://gist.github.com/fawda123/5281518/raw/a7194a748cda5a8d2ea83f87e4a59496ee5e0953/plot_qual.r
注意:由于某些原因我无法使用paste0函数,因此我将代码更改为粘贴(...,sep ="",...)。不确定这是否导致问题。
我已将数据存储在Masters.2013中。数据的格式与博客文章的格式相同,但有更多的列(93)比博客文章使用的更多(25)。
当我运行plot.qual(Masters.2013)时,收到以下错误消息:
> plot.qual(Masters.2013) 警告信息: 在plot.qual(Masters.2013)中: 列之间没有足够的空间
我将列数减少到25,5,2等(plot.qual(Masters.2013 [,1:5]),但每次都会出现错误信息。
情节看起来很拥挤没有线条(会张贴图片,但没有足够的声誉)
我不认为问题与数据有关,因为格式与博客文章相同,似乎几乎正常。
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)