Rで二重ドーナツグラフ作図して保存

Question

png("graph.png", width = 800, height = 700)  # 描画デバイスを開く

x <- c(20, 15, 10, 5)

# 外側の円
pie(x,                 # ダミー
    radius=0.8,        # 半径
    clockwise=T,
    labels=c("A","B","C","D"),
    cex=2,
    col=c("black","yellow","red","blue"))

# 重ね描き
par(new=TRUE)

pie(x,
    clockwise=T,
    labels=c("A","B","C","D"),
    cex=2,
    col=c("red","green","blue","gray"))

# 重ね描き
par(new=TRUE)

# 中央の白円
pie(1,                 # ダミー
    radius=0.4,        # 半径
    col="white",       # 領域の色
    border="white",    # 枠線の色
    labels="")         # ラベル非表示

# テキストの挿入
text(0, 0,             # 挿入位置
     labels="pie12",
     cex=3,
     col="red")

dev.off()

こうしてみたのですが上手くいきません。
一番外側に最も半径の大きい円グラフを描き、次に小さい円グラフを、最後に穴となる部分を描こうと考えたのですが、小さい円グラフが反映されていません。
また、ラベル、つまり各成分の名前はグラフ内に書き込みたいのですが、
この方法も教えて頂けると幸いです。

Comments

[melian]

> 小さい円グラフが反映されていません
radius の指定が抜けちゃっているのが原因。例えば radius = 0.6 を指定すれば OK。
> 各成分の名前はグラフ内に書き込みたい
これは難しい(指定オプションがない)。。。

Answer 1

うお！これは素晴らしい
今出先なんで、後で試してみます！

Answer 2

pie function のソースコードを見ると、以下の部分でラベルを描画しています。lines() で tick(いわゆるヒゲ)、text() でラベルを描いているわけですが、1.05 とか 1.1 という係数を書き替えます。

if (!is.na(lab) && nzchar(lab)) {
    lines(c(1, 1.05) * P$x, c(1, 1.05) * P$y)
    text(1.1 * P$x, 1.1 * P$y, labels[i], xpd = TRUE, 
        adj = ifelse(P$x < 0, 1, 0), ...)
}

R では monkey patching などということはできないので、pie() function のコードをコピペして別名で定義します。そして、pie chart の内側にラベルを描くため、先程の係数を調整します。

if (!is.na(lab) && nzchar(lab)) {
    lines(c(1, 0.95) * P$x, c(1, 0.95) * P$y)
    text(0.92 * P$x, 0.85 * P$y, labels[i], xpd = TRUE, 
        adj = ifelse(P$x > 0, 1, 0), ...)
}

以下、pie315 という関数名を付けて使います。

pie315 <- function (x, labels = names(x), edges = 200, radius = 0.8, clockwise = FALSE, 
    init.angle = if (clockwise) 90 else 0, density = NULL, angle = 45, 
    col = NULL, border = NULL, lty = NULL, main = NULL, ...) 
{
    if (!is.numeric(x) || any(is.na(x) | x < 0)) 
        stop("'x' values must be positive.")
    if (is.null(labels)) 
        labels <- as.character(seq_along(x))
    else labels <- as.graphicsAnnot(labels)
    x <- c(0, cumsum(x)/sum(x))
    dx <- diff(x)
    nx <- length(dx)
    plot.new()
    pin <- par("pin")
    xlim <- ylim <- c(-1, 1)
    if (pin[1L] > pin[2L]) 
        xlim <- (pin[1L]/pin[2L]) * xlim
    else ylim <- (pin[2L]/pin[1L]) * ylim
    dev.hold()
    on.exit(dev.flush())
    plot.window(xlim, ylim, "", asp = 1)
    if (is.null(col)) 
        col <- if (is.null(density)) 
            c("white", "lightblue", "mistyrose", "lightcyan", 
                "lavender", "cornsilk")
        else par("fg")
    if (!is.null(col)) 
        col <- rep_len(col, nx)
    if (!is.null(border)) 
        border <- rep_len(border, nx)
    if (!is.null(lty)) 
        lty <- rep_len(lty, nx)
    angle <- rep(angle, nx)
    if (!is.null(density)) 
        density <- rep_len(density, nx)
    twopi <- if (clockwise) 
        -2 * pi
    else 2 * pi
    t2xy <- function(t) {
        t2p <- twopi * t + init.angle * pi/180
        list(x = radius * cos(t2p), y = radius * sin(t2p))
    }
    for (i in 1L:nx) {
        n <- max(2, floor(edges * dx[i]))
        P <- t2xy(seq.int(x[i], x[i + 1], length.out = n))
        polygon(c(P$x, 0), c(P$y, 0), density = density[i], angle = angle[i], 
            border = border[i], col = col[i], lty = lty[i])
        P <- t2xy(mean(x[i + 0:1]))
        lab <- as.character(labels[i])
        if (!is.na(lab) && nzchar(lab)) {
            lines(c(1, 0.95) * P$x, c(1, 0.95) * P$y)
            text(0.92 * P$x, 0.85 * P$y, labels[i], xpd = TRUE, 
                adj = ifelse(P$x > 0, 1, 0), ...)
        }
    }
    title(main = main, ...)
    invisible(NULL)
}

png("graph.png", width = 800, height = 700)  # 描画デバイスを開く

x <- c(20, 15, 10, 5)

# 外側の円
pie315(x,                 # ダミー
    radius=0.8,        # 半径
    clockwise=T,
    labels=c("A","B","C","D"),
    cex=2,
    col=c("black","yellow","red","blue"))

# 重ね描き
par(new=TRUE)

pie315(x,
    radius=0.6,        # 半径
    clockwise=T,
    labels=c("A","B","C","D"),
    cex=2,
    col=c("red","green","blue","gray"))

# 重ね描き
par(new=TRUE)

# 中央の白円
pie315(1,                 # ダミー
    radius=0.4,        # 半径
    col="white",       # 領域の色
    border="white",    # 枠線の色
    labels="")         # ラベル非表示

# テキストの挿入
text(0, 0,             # 挿入位置
     labels="pie12",
     cex=3,
     col="red")

dev.off()

Comments

[amunagan]

素晴らしい
ところでこの指し棒？を消したり、色を変えたりするのは難しいのでしょうか

[melian]

pie315 関数の中の lines(...) をコメントアウトすれば指し棒は消えて、col= でカラーの指定ができます(lwd で線の太さを指定)。

if (!is.na(lab) && nzchar(lab)) {
lines(c(1, 0.95) * P$x, c(1, 0.95) * P$y, col="blue")
text(0.92 * P$x, 0.85 * P$y, labels[i], xpd = TRUE,
adj = ifelse(P$x > 0, 1, 0), ...)
}

[amunagan]

このif文はなんですか？

[melian]

空文字列ではないラベルが指定されていれば、という意味で、この場合は pie351(..., labels=....,) として実行しているので True になります。

[amunagan]

できました、また新たに質問させて頂きます。