ギャスケットコードの改良を機に、シェルピンスキーのカーペットの作図方法を閃いた。

Rで作るシェルピンスキーのカーペット（四角形）

変数xは自然数のみ有効となり、描画する。

main

Sierpinski.carpet <- function(x=3) {    # x = depth
    plot(0,0,main="Sierpinski carpet",xlab=" ",ylab=" ",xaxt="n",yaxt="n")
    y <- c(-1,1, 1,1, 1,-1, -1,-1)   　 # Set the position
    polygon(c(y[1],y[3],y[5],y[7]),c(y[2],y[4],y[6],y[8]),col="gray")
    if(x > 0) {
        Sierpinski.carpet.square(x-1,y)
    }
}

上記で使用している関数（サブルーチン）

sub

Sierpinski.carpet.square <- function(x,y) {
    xy <- c((y[1]*2+y[3])/3,(y[2]*2+y[8])/3,(y[1]+y[3]*2)/3,(y[4]*2+y[6])/3,(y[5]*2+y[7])/3,(y[4]+y[6]*2)/3,(y[5]+y[7]*2)/3,(y[2]+y[8]*2)/3)
    polygon(c(xy[1],xy[3],xy[5],xy[7]),c(xy[2],xy[4],xy[6],xy[8]),col="white",border=F)  # center
    if(x > 0) {
        Recall(x-1,c(y[1],y[2], xy[1],y[2], xy[1],xy[2], y[1],xy[2]))      # topleft
        Recall(x-1,c(xy[1],y[2], xy[3],y[4], xy[3],xy[4], xy[1],xy[2]))    # top
        Recall(x-1,c(xy[3],y[4], y[3],y[4], y[3],xy[4], xy[3],xy[4]))      # topright
        Recall(x-1,c(xy[3],xy[4], y[3],xy[4], y[5],xy[6], xy[5],xy[6]))    # right
        Recall(x-1,c(xy[5],xy[6], y[5],xy[6], y[5],y[6], xy[5],y[6]))      # bottomright
        Recall(x-1,c(xy[7],xy[8], xy[5],xy[6], xy[5],y[6], xy[7],y[8]))    # bottom
        Recall(x-1,c(y[7],xy[8], xy[7],xy[8], xy[7],y[8], y[7],y[8]))      # bottomleft
        Recall(x-1,c(y[1],xy[2], xy[1],xy[2], xy[7],xy[8], y[7],xy[8]))    # left
    }
}

gif出力

当コードでは左上から時計回りにくり抜く処理をしていく。よって、処理を関数readline()を用いて止めながら取得した画像を繋げると、こうなる。

余談だが、70枚を超える画像をgifアニメーションにするのは手間だった。
どうにかRで手早くgifアニメーション画像を作れないものだろうか。