R中的plot.qual函数:文字太大了

时间:2013-04-13 18:30:08

标签: r

我试图制作一个"斜率图" 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]),但每次都会出现错误信息。

情节看起来很拥挤没有线条(会张贴图片,但没有足够的声誉)

我不认为问题与数据有关,因为格式与博客文章相同,似乎几乎正常。

plot.qual code

编辑:添加一些示例数据(如下),感谢评论的人。此外 - 当添加par(cex = .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)

0 个答案:

没有答案