Rでパレート図

こんにちは。namakemonoです。

本日はパレート図について記載します。

パレート図とは?

パレート図(ぱれーとず)とは、発生数(度数)が降順にプロットされた棒グラフと、その累積構成比を表す折れ線グラフを組み合わせた複合グラフです。
QC7つ道具のうちのひとつで、どの項目に問題があるか、重点的に取り組むべき問題は何かを把握することができます。
035

Rでのパレート図の作成方法

まず、「qcc」というパッケージをインストールします。
パッケージのインストールについてはこちらをご参照ください。


次に対象データの加工をします。今回は「iris」というサンプルデータの1列目を利用します。
1列目のデータを「x」という変数に代入します。
ここで、各項目の度数を集計してみます。
036


間隔が細かすぎるため、1刻みに加工しましょう。
cut関数を利用して、データをグルーピングします。
breaksに、分割する範囲を指定します。今回は3~9に1刻みで分割します。
037


分割した結果、「(5,6]」のような数値に置き換わりました。これは「5より大きい、6以下」を表します。
記号の意味は以下の通りです。

記号 意味
( より大きい
) 未満
[ 以上
] 以下

グルーピングが終わったところで、改めて集計してみましょう。


038


記号のままだと読みにくいので、ラベルを修正しましょう。
names()でラベルを操作できます。
このnames関数に対して、任意のラベルを付けていきます。
054

これでデータの加工が終了しました。
パレート図の出力に移りたいと思います。
先ほどインストールした「qcc」パッケージの「pareto.chart」関数を利用します。
引数には、先ほどまで加工した結果である「z」を使用します。
これでパレート図の完成です。コンソールには数値が表示されます。
左から順に「度数」、「累積度数」、「相対比率」、「累積相対比率」となります。

055
056

ソートさせないためには?

パレート図は度数の大きい順に左から並んでいきます。
ただ、時にはソートさせず、そのままの順番で表示させたいですよね?
そんな時は、自分で関数を再定義しましょう。
関数名を入力すると、関数の中身が表示されます。

> pareto.chart
function (x, ylab = “Frequency”, ylab2 = “Cumulative Percentage”,
xlab, cumperc = seq(0, 100, by = 25), ylim, main, col = heat.colors(length(x)),
plot = TRUE, …)
{
call <- match.call(expand.dots = TRUE) varname <- deparse(substitute(x)) x <- as.table(x) if (length(dim(x)) > 1)
stop(“only one-dimensional object (table, vector, etc.) may be provided”)
x <- sort(x, decreasing = TRUE, na.last = TRUE)
cumsum.x <- cumsum(x) cumperc <- cumperc[cumperc >= 0 & cumperc <= 100] q <- quantile(seq(0, max(cumsum.x, na.rm = TRUE), by = max(cumsum.x, na.rm = TRUE)/100), cumperc/100) tab <- cbind(x, cumsum.x, x/max(cumsum.x, na.rm = TRUE) * 100, cumsum.x/max(cumsum.x, na.rm = TRUE) * 100) colnames(tab) <- c("Frequency", "Cum.Freq.", "Percentage", "Cum.Percent.") names(dimnames(tab)) <- c("", paste("\nPareto chart analysis for", varname)) if (plot) { if (missing(xlab)) xlab <- "" if (missing(ylim)) ylim <- c(0, max(cumsum.x, na.rm = TRUE) * 1.05) if (missing(main)) main <- paste("Pareto Chart for", varname) if (missing(col)) col <- heat.colors(length(x)) w <- max(sapply(names(x), nchar)) if (is.null(call$las)) las <- 3 else las <- call$las if (is.null(call$mar)) { if (las == 1) mar <- c(1, 1, 0, 2) else mar <- c(log(max(w), 2), 0, 0, 2) } else mar <- call$mar oldpar <- par(mar = pmax(par("mar") + mar, c(4.1, 4.1, 3.1, 4.1)), las = las, cex = qcc.options("cex"), no.readonly = TRUE) on.exit(par(oldpar)) pc <- barplot(x, width = 1, space = 0.2, main = main, ylim = ylim, ylab = ylab, xlab = xlab, yaxt = "n", col = col, ...) abline(h = q, col = "lightgrey", lty = 3) rect(pc - 0.5, rep(0, length(x)), pc + 0.5, x, col = col) lines(pc, cumsum.x, type = "b", cex = 0.7, pch = 19) box() axis(2, las = 3) axis(4, at = q, las = 3, labels = paste(cumperc, "%", sep = "")) mtext(ylab2, 4, line = 2.5, las = 3) } return(tab) }



この中から「x <- sort(x, decreasing = TRUE, na.last = TRUE)」の行を削除し、関数の再定義を行います。

mypareto<-function (x, ylab = "Frequency", ylab2 = "Cumulative Percentage", xlab, cumperc = seq(0, 100, by = 25), ylim, main, col = heat.colors(length(x)), plot = TRUE, ...) { call <- match.call(expand.dots = TRUE) varname <- deparse(substitute(x)) x <- as.table(x) if (length(dim(x)) > 1)
stop(“only one-dimensional object (table, vector, etc.) may be provided”)
cumsum.x <- cumsum(x) cumperc <- cumperc[cumperc >= 0 & cumperc <= 100] q <- quantile(seq(0, max(cumsum.x, na.rm = TRUE), by = max(cumsum.x, na.rm = TRUE)/100), cumperc/100) tab <- cbind(x, cumsum.x, x/max(cumsum.x, na.rm = TRUE) * 100, cumsum.x/max(cumsum.x, na.rm = TRUE) * 100) colnames(tab) <- c("Frequency", "Cum.Freq.", "Percentage", "Cum.Percent.") names(dimnames(tab)) <- c("", paste("\nPareto chart analysis for", varname)) if (plot) { if (missing(xlab)) xlab <- "" if (missing(ylim)) ylim <- c(0, max(cumsum.x, na.rm = TRUE) * 1.05) if (missing(main)) main <- paste("Pareto Chart for", varname) if (missing(col)) col <- heat.colors(length(x)) w <- max(sapply(names(x), nchar)) if (is.null(call$las)) las <- 3 else las <- call$las if (is.null(call$mar)) { if (las == 1) mar <- c(1, 1, 0, 2) else mar <- c(log(max(w), 2), 0, 0, 2) } else mar <- call$mar oldpar <- par(mar = pmax(par("mar") + mar, c(4.1, 4.1, 3.1, 4.1)), las = las, cex = qcc.options("cex"), no.readonly = TRUE) on.exit(par(oldpar)) pc <- barplot(x, width = 1, space = 0.2, main = main, ylim = ylim, ylab = ylab, xlab = xlab, yaxt = "n", col = col, ...) abline(h = q, col = "lightgrey", lty = 3) rect(pc - 0.5, rep(0, length(x)), pc + 0.5, x, col = col) lines(pc, cumsum.x, type = "b", cex = 0.7, pch = 19) box() axis(2, las = 3) axis(4, at = q, las = 3, labels = paste(cumperc, "%", sep = "")) mtext(ylab2, 4, line = 2.5, las = 3) } return(tab) }



これで関数の再定義が完了しました。
改めて定義した「mypareto」の引数に、先ほど加工したデータ「z」を使用すると、このような図が作成されます。
057
058

最後に

パレート図は問題の把握だけでなく、ある値でどの程度の割合をカバーできるのかを見るときにも使用できます。
(上記の例だと、6未満までで約60%、7未満までで約90%以上を占めていることになります)
使い方次第で強力な武器になります。
ぜひ活用してみてください。

ではでは


2 thoughts on “Rでパレート図

  1. r-de-r

    記号 意味
    ( 以上
    ) 以下
    [ より大きい
    ] 未満

    は,間違いです。全て逆。これは,数学での常識。
    [ が以上,]が以下
    ( がより大きい,) が未満
    cut のオンラインヘルプを見れば分かりますが,区間を決めるデフォルトは,我々(日本)の常識と違っています。
    right
    logical, indicating if the intervals should be closed on the right (and open on the left) or vice versa.

    If a labels parameter is specified, its values are used to name the factor levels. If none is specified, the factor level labels are constructed as “(b1, b2]”, “(b2, b3]” etc. for right = TRUE and as “[b1, b2)”, … if right = FALSE. In this case, dig.lab indicates the minimum number of digits should be used in formatting the numbers b1, b2, …. A larger value (up to 12) will be used if needed to distinguish between any pair of endpoints: if this fails labels such as “Range3” will be used. Formatting is done by formatC.

コメントを残す

メールアドレスが公開されることはありません。

CAPTCHA