Rのgridでタートルグラフィックス

久保さんのところでRのlibrary(grid)の話がでていて、そういえばこれまで食わず嫌いだったことに気がついたので、ちょっと試してみた。

こういうものはコードを書かないとなかなか身に付かないので、何か書いてみようと、昔懐かしのタートルグラフィックスのプログラムを書いてみた。


コッホ曲線

コードは「続きを読む」の後に置いておきましたので、参考にしようなどという奇特な方がいらっしゃいましたら、ご自由にどうぞ。

##
## turtle graphics
##

# use grid
library(grid)

turtle.init <- function(vp = viewport(0.5, 0.5, width = 1, height = 1,
                             xscale=c(-1, 1), yscale=c(-1, 1)),
                        col = "black", loc = c(0, 0), angle = 0,
                        pen = TRUE) {
    grid.newpage()
    pushViewport(vp)
    grid.move.to(0, 0, default.units = "native")

    # environment to keep parameters
    turtle <- new.env()
    assign("col", col, envir = turtle)
    assign("loc", loc, envir = turtle)
    assign("angle", angle, envir = turtle)
    assign("pen", TRUE, envir = turtle)

    # return the environment
    turtle
}

pen.up <- function(turtle) {
    if (is.environment(turtle)) {
        assign("pen", FALSE, envir = turtle)
    } else {
        stop("The first argument must be an environment.")
    }
}

pen.down <- function(turtle) {
    if (is.environment(turtle)) {
        assign("pen", TRUE, envir = turtle)
    } else {
        stop("The argument must be an environment.")
    }
}

set.color <- function(turtle, col) {
    if (is.environment(turtle)) {
        assign("col", col, envir = turtle)
    } else {
        stop("The first argument must be an environment.")
    }
}
    
set.angle <- function(turtle, angle = 0) {
    if (is.environment(turtle)) {
        assign("angle", angle, envir = turtle)
    } else {
        stop("The first argument must be an environment.")
    }
}
    
set.location <- function(turtle, loc = c(0, 0)) {
    if (is.environment(turtle)) {
        assign("loc", loc, envir = turtle)
        grid.move.to(loc[1], loc[2], default.units = "native")
    } else {
        stop("The first argument must be an environment.")
    }
}
    
forward <- function(turtle, length) {
    if (is.environment(turtle)) {
        loc <- get("loc", envir = turtle)
        pen <- get("pen", envir = turtle)
        col <- get("col", envir = turtle)
        x <- loc[1] + length * cos(turtle$angle * pi / 180)
        y <- loc[2] + length * sin(turtle$angle * pi / 180)
        if (pen)
            grid.line.to(x, y,
                         gp = gpar(col = col),
                         default.units = "native")
        else
            grid.move.to(x, y,
                         default.units = "native")
        assign("loc", c(x, y), envir = turtle)
    } else {
        stop("The first argument must be an environment.")
    }
}

backword <- function(turtle, length) {
    forward(turtle, -length)
}

left <- function(turtle, angle) {
    if (is.environment(turtle)) {
        t.angle <- get("angle", envir = turtle)
        assign("angle", t.angle + angle, envir = turtle)
    } else {
        stop("The first argument must be an environment.")      
    }
}

right <- function(turtle, angle) {
    left(turtle, -angle)
}


# Koch curve
koch <- function(turtle, level = 4, length = 1) {
    if  (level > 0) {
        koch(turtle, level - 1, length / 3)
        left(turtle, 60)
        koch(turtle, level - 1, length / 3)
        right(turtle, 120)
        koch(turtle, level - 1, length / 3)
        left(turtle, 60)
        koch(turtle, level - 1, length / 3)
    } else {
        forward(turtle, length)
    }
}

# run
t <- turtle.init()
set.location(t, c(-0.8, -0.2))
set.angle(t, 0)
set.color(t, "blue")
koch(t, 5, 1.6)

タグ：library(grid) R