1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
|
#Gradient Legends
#by Andrew Redd
#C 2007
#TODO
#1. make width Calculation
#2. make magrin calculation more presice for longer tick marks
#3. Add Valid Details function
gradientLegendGrob<-function(
at=seq(0,1,length=5), #where to place tick marks
axis.min=min(at), #to specify minimun
axis.max=max(at), #to specify maximum
labels=as.character(at),#specify labels for tick marks
col.fun=grey, #function to specify gradient
delta=.01, #defines level of precicion of gradient
vertical=F, #controls orientation
reverse=F, #controls which side to put the axis on
name=NULL,
gp=NULL,
vp=NULL,
...
){
#generate Rectangles
if(delta<=0||delta>=1)stop("delta must be between 0 and 1.")
if(length(at)!=length(labels))stop("labels and at must be of the same length")
z<-(seq(0,1,by=delta)-delta/2)[-1]
y<-if(vertical) unit(z,"npc") else unit(0.5,"npc")
x<-if(!vertical)unit(z,"npc") else unit(0.5,"npc")
height<-if(vertical) delta else unit(1.5,"char")
width <-if(!vertical) delta else unit(1.5,"char")
just<-if(vertical)
if(reverse) c("right","center") else c("left","center") else
if(reverse) c("center","top") else c("center","bottom")
cols<-col.fun(z)
gp1<-do.call(gpar,append(list(col=NA,fill=cols),gp))
#make Gradient
legvp<-viewport(name="legvp",width=unit(1,"npc")-unit(1,"char"),height=unit(1,"npc")-unit(1,"char"))
#make Gradient Border
rectangles<-rectGrob(name="gradient",x=x,y=y,height=height,width=width,just=just,gp=gp1,vp=legvp)
border<-if(vertical)rectGrob(name="gradBorder",x=x,width=width,just=just,vp=legvp)
else rectGrob(name="gradBorder",y=y,height=height,just=just,vp=legvp)
#Make Ticks
ticks<-if(is.numeric(at)){
w<- (at-axis.min)/(axis.max-axis.min)
x0<-if(!vertical) unit(w,"npc") else unit(.5,"npc")
x1<-if(!vertical) unit(w,"npc") else unit(.5,"npc")+if(reverse) unit(.4,"lines") else unit(-.4,"lines")
y0<-if(vertical) unit(w,"npc") else unit(.5,"npc")
y1<-if(vertical) unit(w,"npc") else unit(.5,"npc")+if(reverse) unit(.4,"lines") else unit(-.4,"lines")
segmentsGrob(x0=x0,x1=x1,y0=y0,y1=y1,vp=legvp,name="ticks")
} else NULL
#Make Labels
axis.labels<-if(all(!is.na(labels))){
w<- (at-axis.min)/(axis.max-axis.min)
x<-if(!vertical) unit(w,"npc") else if(reverse) unit(.5,"npc")+unit(.5,"lines") else unit(.5,"npc")-unit(.5,"lines")
y<-if(vertical) unit(w,"npc") else if(reverse) unit(.5,"npc")+unit(.5,"lines") else unit(.5,"npc")-unit(.5,"lines")
just<-if(vertical) if(reverse)c("left","center") else c("right","center") else
if(reverse)c("center","bottom") else c("center","top")
textGrob(labels,x=x,y=y,just=just,name="labels",vp=legvp)
} else NULL
gTree(at=at,axis.min=axis.min,axis.max=axis.max,col.fun=col.fun,delta=delta,vertical=vertical,reverse=reverse,
childrenvp=legvp,
children=gList(rectangles,border,ticks,axis.labels),
name=name,gp=gp,vp=vp,
cl="gradientLegendGrob")
}
grid.gradientLegendGrob<-function(...){
grad<-gradientLegendGrob(...)
grid.draw(grad)
invisible(grad)
}
widthDetails.gradientLegendGrob<-function(x){
if(x$vertical) unit(1,"null") else{
convertUnit(unit(0.1,"lines"),"inches","x")+widthDetails(x$children[[2]])+widthDetails(x$children[[3]])+widthDetails(x$children[[4]])
}
}
heightDetails.gradientLegendGrob<-function(x){
if(!x$vertical) unit(1,"null") else{
convertUnit(unit(0.1,"lines"),"inches","x")+widthDetails(x$children[[2]])+widthDetails(x$children[[3]])+widthDetails(x$children[[4]])
}
}
#grid.gradientLegendGrob()
#grid.gradientLegendGrob(vertical=T)
#g0<-grid.gradientLegendGrob(vertical=T,reverse=T)
#grid.gradientLegendGrob(1:5,col.fun=hsv,delta=1/1000)
#rb<-function(p)rgb(p,0,1-p)
#g1<-grid.gradientLegendGrob(1:10,col.fun=rb)
#widthDetails(g1)
#widthDetails(g0)
|
