作者josephw (Livin' on A Prayer)
看板NCTU-STAT95G
标题[分享]彩色无痕迹立体版 渐层背景!
时间Sun May 18 14:57:04 2008
#################NOTE###################################################
## x与y 是图型的范围, 需给一向量
## (1) r,g,b 在 [0,1]之间, 越低越深色 反之越接近浅色;
## (2) xcorint (ycorint)是x座标(y座标)位数的间格
## (3) 若不要加外框在最後 axbox打FALSE
## (4) r, g, b 只要有1个等於1就是纯白
## 其余与plot 里参数类似
#########################################################################
background2 <- function(x = c(-20,20), y = c(-20,20), r = 0.5, g=0.5, b =
0.5, xcorint = 5, ycorint = 5, axbox = TRUE, xlable="",ylable="",title ="")
{
ax <- min(x)
bx <- max(x)
ay <- min(y)
by <- max(y)
if(ax == bx || ay == by ||r > 1 ||r < 0 ||g > 1 ||g < 0 ||b > 1 ||b < 0 ){
warning("给我去看note!!")
return(0);
}
if(xcorint > bx || ycorint > by){
warning("间隔大於你的最大轴座标啦")
return(0);
}
plot(x, y,type='n',axes=F,xlab= xlable,ylab= ylable,main = title)
i <- 1
while(r+i*0.005 < 1 && g+i*0.005 < 1 && b+i*0.005 < 1){
if(r == 0){
if(b == 0)
polygon(c(ax+(i-1)/10-5,ax+(i-1)/10-5,bx-(i-1)/10+5,bx-(i-1)/10+5)
,c(ay+(i-1)/10-5,by-(i-1)/10+5, by-(i-1)/10+5,
ay+(i-1)/10-5),col= rgb(0,g+i*0.005,0), lty=0)
else if(g == 0)
polygon(c(ax+(i-1)/10-5,ax+(i-1)/10-5,bx-(i-1)/10+5,bx-(i-1)/10+5)
,c(ay+(i-1)/10-5,by-(i-1)/10+5,by-(i-1)/10+5,ay+(i-1)/10-5)
,col= rgb(0,0,b+i*0.005), lty=0)
else
polygon(c(ax+(i-1)/10-5,ax+(i-1)/10-5,bx-(i-1)/10+5,bx-(i-1)/10+5)
,c(ay+(i-1)/10-5,by-(i-1)/10+5,by-(i-1)/10+5,ay+(i-1)/10-5)
,col= rgb(0,g+i*0.005,b+i*0.005), lty=0)
}
else if(b == 0){
if(g == 0)
polygon(c(ax+(i-1)/10-5,ax+(i-1)/10-5,bx-(i-1)/10+5,bx-(i-1)/10+5)
,c(ay+(i-1)/10-5,by-(i-1)/10+5,by-(i-1)/10+5,ay+(i-1)/10-5),
col= rgb(r+i*0.005,0,0), lty=0)
else
polygon(c(ax+(i-1)/10-5,ax+(i-1)/10-5,bx-(i-1)/10+5,bx-(i-1)/10+5)
,c(ay+(i-1)/10-5,by-(i-1)/10+5,by-(i-1)/10+5,ay+(i-1)/10-5),
col= rgb(r+i*0.005,g+i*0.005,0), lty=0)
}
else if(g == 0)
polygon(c(ax+(i-1)/10-5,ax+(i-1)/10-5,bx-(i-1)/10+5,bx-(i-1)/10+5),
c(ay+(i-1)/10-5,by-(i-1)/10+5, by-(i-1)/10+5, ay+(i-1)/10-5),
col= rgb(r+i*0.005,0,b+i*0.005), lty=0)
else
polygon(c(ax+(i-1)/10-5,ax+(i-1)/10-5,bx-(i-1)/10+5,bx-(i-1)/10+5),
c(ay+(i-1)/10-5,by-(i-1)/10+5, by-(i-1)/10+5, ay+(i-1)/10-5),
col= rgb(r+i*0.005,g+i*0.005,b+i*0.005), lty=0)
i <- i+1
}
ix<- seq(ax,bx,xcorint)
iy<- seq(ay,by,ycorint)
abline(v=ix, h=iy, col = "lightyellow", lty = "dotted")
if(axbox == TRUE){
box()
axis(1, ix)
axis(2, iy)
}
else{
axis(1, seq(ax-xcorint,bx+xcorint,xcorint),lwd=2, lty='dotted')
axis(2, seq(ay-ycorint,by+ycorint,ycorint),lwd=2 , lty='dotted')
}
}
## Example:想要试试 用下面喔
x <-c(-20,20)
y <-c(-30,30)
##(1)红色
background2(x , y, r = 0.1, g = 0, b = 0)
windows()
##(2)绿色
background2(x , y, r = 0, g = 0.1, b = 0)
windows()
##(3)蓝色
background2(x , y, r = 0, g = 0, b = 0.1)
windows()
##(4)黄色(在b=0)
background2(x , y, r = 0.1, g = 0.1, b = 0)
windows()
##(5)灰色(在r=g=b)
background2(x , y, r = 0.1, g = 0.1, b = 0.1)
windows()
##(5)纯白色无虚线!
background2(x , y, r = 1, g = 1, b = 1)
--
※ 发信站: 批踢踢实业坊(ptt.cc)
◆ From: 140.113.191.14
1F：→ josephw:不想用复制贴上的 我可以直接给你喔!! 05/18 14:57
2F：→ josephw:还有其他可以分享出来耶!!!! 05/18 14:58
3F：推 aflilfesy:水唷~ 超漂亮的!!! 05/18 14:59
4F：推 ym7226:嗯 强 05/18 14:59
5F：→ josephw:有痕迹版 就是差在给定固定次数...不过感觉比较立体 05/18 15:12
6F：推 Y0SHIKI:R神~~ 05/18 20:19
7F：推 mangogogo:推～ 05/18 21:45
※ 编辑: josephw 来自: 140.113.191.14 (05/18 23:18)
8F：→ josephw:@@ 有个地方小错误改好了 05/18 23:18
9F：推 Y0SHIKI:我专门找bug的XD 05/18 23:38
10F：→ Y0SHIKI:大家一起来 detail 唷:P 05/18 23:38