On 05/12/2010 07:34 PM, Simon Kiss wrote:
I'm working with the following code below to generate a
how do I set the h,c, and l values such that the significant, positive
residuals appear different on a grayscale printer from significant
grayscale residuals. The challenge as I see it is that one can only
distinguish the positive and negative residuals with the hue/. Varying
the chroma and the luminance only affect the distinctions between large
and small and significant and non significant. But my positive and
negative residuals are both large (absolutely) and significant, meaning
that they will have the same chroma and luminosity, but different hues.
I guess the key here is to find two separate hue values that appear
substantially different *on a grayscale printer* at the same chroma and
luminance. I have read through Zeileis et al. (2007, 2008) but can't
quite find the answer there.
I have also tried the Friendly shading to vary the line type, but I
can't find line types that are different enough to communicate the
difference between positive and negative residuals clearly.
Your assistance is appreciated.
>mosaic(~educ+trade_off_scaled, shade=TRUE, main="Support For
Environmental Protection At The Expense of Creating Jobs By Education",
gp=shading_hcl(CST17$observed, CST17$expected, ASR17, df=6, h=c(260,0),
c=c(100,0), l=c(90,0)), labeling_args=list(rot_labels=c(25,90,0,0),
offset_labels=c(1,0,0,2), offset_varnames=c(2,0,0,4),
set_varnames=c(trade_off_scaled="Protecting The Environment Is More
Important Than Creating Jobs", educ="Level of Education")))
Hi Simon,
I thought that the symbolbox function might do something useful, but it
required a bit of modification. The attached mod allows the user to fill
a rectangle with symbols, which includes things like "+" and "-".
Jim
symbolbox<-function(x1,y1,x2,y2,tot,relw=0.5,fg=par("fg"),bg=par("bg"),
pch=NULL,pch.cex=1,box=TRUE,debug=FALSE,...) {
if(debug) cat("symbolbox:",x1,y1,x2,y2,tot,"\n")
x <- c(x1,x2)
y <- c(y1,y2)
if (x2 < x1) x<-rev(x)
if (y2 < y1) y<-rev(y)
pin<-par("pin")
usr<-par("usr")
usr.pin<-diff(par("usr"))[c(1,3)]/par("pin")
dx<-diff(x)/usr.pin[1]
dy<-diff(y)/usr.pin[2]
area<-dx*dy
m<-dx*sqrt(tot/area)
n<-dy*sqrt(tot/area)
rm<-max(round(m),1)
rn<-max(round(n),1)
while(rm*rn < tot) {
if((dx*sqrt(tot/area)-m) > (dy*sqrt(tot/area)-n)) {
rm <- rm + 1
}
else {
rn <- rn + 1
}
}
if(is.null(pch)) {
m<-rm
n<-rn
if(debug) cat("symbolbox:",dx,dy,m,n,rm,rn,tot,"\n")
r<-dx/m*relw/2
dx<-dx/m*usr.pin[1]
dy<-dy/n*usr.pin[2]
mat<-matrix(1:(m*n),nrow=m,ncol=n)
xpos<-x[1]+(row(mat)[mat <= tot] - 0.5) * dx
ypos<-y[1]+(col(mat)[mat <= tot] - 0.5) * dy
symbols(xpos,ypos,rep(1,tot),bg=bg,fg=fg,add=TRUE,inches=r)
if(box)
polygon(x[c(1,1,2,2,1)],y[c(1,2,2,1,1)],border=fg,...)
}
else {
rect(x1,y1,x2,y2,col=bg,border=fg)
plotlim<-par("usr")
clip(x1,x2,y1,y2)
xinc<-strwidth("M",cex=pch.cex)
yinc<-strheight("M",cex=pch.cex)
xpos<-seq(x1+xinc/2,x2,by=xinc)
lenxpos<-length(xpos)
ypos<-seq(y1+yinc/2,y2,by=yinc)
lenypos<-length(ypos)
xpos<-rep(xpos,each=lenypos)
ypos<-rep(ypos,lenxpos)
points(xpos,ypos,pch=pch)
do.call("clip",as.list(plotlim))
}
}
______________________________________________
R-help@r-project.org mailing list
https://stat.ethz.ch/mailman/listinfo/r-help
PLEASE do read the posting guide http://www.R-project.org/posting-guide.html
and provide commented, minimal, self-contained, reproducible code.
