[分享]彩色無痕跡立體版 漸層背景!

[josephw (Livin' on A Prayer)]

#################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
→ josephw:不想用複製貼上的  我可以直接給你喔!!
→ josephw:還有其他可以分享出來耶!!!!
推 aflilfesy:水唷~ 超漂亮的!!!
推 ym7226:嗯 強
→ josephw:有痕跡版  就是差在給定固定次數...不過感覺比較立體
推 Y0SHIKI:R神~~
推 mangogogo:推～
※ 編輯: josephw         來自: 140.113.191.14       (05/18 23:18)
→ josephw:@@ 有個地方小錯誤改好了
推 Y0SHIKI:我專門找bug的XD
→ Y0SHIKI:大家一起來 detail 唷:P