読んだ。
[0907.0455] The Peter Principle Revisited: A Computational Study
こんな動画を見た。
www.youtube.com
2010年のイグノーベル賞で、Peterの法則というものをシミュレーションで示した、という話。
社員地位構造が階層的な場合、昇進するときに能力に応じて昇進させるより、ランダムに昇進させたほうが、全体としての価値が高まる、という結論である。
論文では、Peterの法則と一般常識的な仮説のふたつと、昇進させるときのルールみっつを想定して、各々かけあわせて6つの結果をシミュレーションしている。
Peterの法則は、各階層において社員が昇進すると、その新たな部署においてはいままでの能力は引き継がれず、再度（ランダムに）能力を開発する。例えば、SE業だけやっていた平社員が突然管理職になったときに、新たに必要となる管理職能力に対して、これまで培ってきたSE能力は一切加味されない。これはシミュレーションでは、能力値を昇進時に新たにランダムサンプリングすることで表現される。
一般常識的（Common sense strategy）な仮説では、昇進時にこれまでの能力は引き継がれる、という設定である。これは先の例でいくと、管理職業務にSE能力を流用できる、ということになる。これはシミュレーションでは、昇進前の能力値に対して、（個人ではなく、すべての社員が持ちうる理論上）最大能力値の±10%以内の能力 が昇進時に加算される、とする。この
の選び方は明示されていなかったので正規分布でも一様分布でもいいが、一様分布にした。
昇進のさせ方は3通りあり、ある役職が空いたときに、下の役職の社員たちの中から、能力値が（1）最大の者、（2）最低の者、（3）に関係なくランダム、を選ぶという作戦である。
シミュレーションの細かい設定としては、全社員人
nの会社において、役職が6つある。である。各役職の人数は
niであり、,
である。
社員の能力はcompetenceというある実数で定義される。これはいろいろな能力が合算された結果、なんらかのひとつの値になったものとする。社員は年齢ageが定義されており、competenceは正規分布 かつ
の範囲、
ageは正規分布かつ
の範囲である。両端が切られているのでなんとなく切断正規分布
truncnorm パッケージを使用した。各社員agentには、competence、age、役職の階層levelの属性がある。
さて、昇進させるには役職が空かないといけないが、役職を空けるには解雇しなければならない。解雇のルールは、competenceについて、恣意的に4以下の場合は、次の時刻ステップで解雇される。また、各時刻ステップでageは1つ加算され、60歳以上は解雇される、とする。役職が空いたときに、下の階層から、上の3つの昇進ルールで昇進させ、新たにcompetenceとageをランダムに割り振ったlevelが1の新入社員を採用し、全体は 人が保たれるようにする。
会社全体の価値は、各社員のcompetenceを、各役職の重要度, (
)
riで重み付け和を取ったものとする。会社の価値global efficiency は、ある階層での
competence の和 を用いて
となる。これは の範囲になる。
これを1000時間単位、50回（こちらの環境では30回）行うと、figure 2 となる。
社員の能力は昇進先でも活かされるはずだ、という一般常識的な仮説が真であれば、昇進させる人物はcompetenceが高い者を選ぶと、会社全体の価値は上がる。一方で、昇進先ではこれまでの能力は活かされず、一新される（新たにランダムサンプリングした能力で働かなければならない）というPeterの法則が真であれば、competenceが低いものを昇進させるほうが、会社全体の価値は上がる。というより、後者においては、配置換えに近いイメージである。
一般常識的な仮説もしくはPeterの法則と、最大能力/最低能力者を昇進させる、という戦略があべこべの場合、会社全体の価値は下がる。
一般常識的な仮説が真なのか、Peterの法則が真なのか、はたまたその中間が真なのかは誰にもわからないが、ランダムに昇進させる社員を選べば、少なくとも最初の状態よりかは会社全体の価値は上がる、ということになる。
library(truncnorm) ni <- c(81, 41, 21, 11, 5, 1) n <- sum(ni) ri <- c(0.2, 0.4, 0.6, 0.8, 0.9, 1) delta <- 0.1 # competence parameter comp_p <- c(7, 2) # age parameter age_p <- c(25, 5) # range trunc <- list(competence=c(1, 10), age=c(18, 60)) thres <- c(competence=4, age=60) niter <- 30 Time <- 1000 promote_method <- c("The best", "The worst", "Random") hypothesis <- c("Common", "Peter") Eff <- array(0, c(niter, Time, length(promote_method), length(hypothesis))) # the best: 1 # the worst: 2 # random: 3 # Peter: P # Common: C for(hy in seq(hypothesis)){ for(pm in seq(promote_method)){ for(iter in seq(niter)){ agent <- cbind.data.frame( competence=rtruncnorm(n, trunc$competence[1], trunc$competence[2], comp_p[1], comp_p[2]), age=floor(rtruncnorm(n, trunc$age[1], trunc$age[2], age_p[1], age_p[2])), level=unlist(mapply(rep, seq(ni), ni)) ) Eff[iter, 1, pm, hy] <- sum(agent$competence*ri[agent$level])/(sum(ni*ri))*10 for(ti in seq(Time)[-1]){ agent$age <- agent$age + 1 # retirement ret_idx <- agent$competence < thres["competence"] | agent$age > thres["age"] ret_agent <- agent[ret_idx,] ret_levels <- unique(ret_agent$level) n_ret <- c(table(factor(ret_agent$level, factor(seq(ni)))), 0) nl <- sum(ret_idx) if(nl > 0){ # no retirement new_agent <- cbind.data.frame( competence=rtruncnorm(nl, trunc$competence[1], trunc$competence[2], comp_p[1], comp_p[2]), age=floor(rtruncnorm(nl, trunc$age[1], trunc$age[2], age_p[1], age_p[2])), level=1 ) # promotion if(promote_method[pm] == "Random"){ # random promote_idx <- unlist(mapply(function(l) sample(which(agent$level==l-1 & !ret_idx), sum(n_ret[l:length(n_ret)])), 2:length(ni))) } else if (promote_method[pm] == "The best"){ # best promote_idx <- unlist( mapply(function(l){ a <- which(agent$level==l-1 & !ret_idx) tail(a[order(agent$competence[a])], sum(n_ret[l:length(n_ret)])) }, 2:length(ni)) ) } else { # worst promote_idx <- unlist( mapply(function(l){ a <- which(agent$level==l-1 & !ret_idx) head(a[order(agent$competence[a])], sum(n_ret[l:length(n_ret)])) }, 2:length(ni)) ) } agent[ret_idx,] <- new_agent agent$level[promote_idx] <- agent$level[promote_idx] + 1 if(hypothesis[hy] == "Peter"){ # Peter hypothesis agent$competence[promote_idx] <- rtruncnorm(length(promote_idx), trunc$competence[1], trunc$competence[2], comp_p[1], comp_p[2]) } else { # Common sense hypothesis d <- trunc$competence[2]*delta inherits <- runif(length(promote_idx), min=-d, max=d) agent$competence[promote_idx] <- agent$competence[promote_idx]+inherits } } Eff[iter, ti, pm, hy] <- sum(agent$competence*ri[agent$level])/(sum(ni*ri))*10 } } # boxplot(Eff[, , pm, hy], main=sprintf("%s hypothesis, %s strategy", hypothesis[hy], promote_method[pm])) } } yl <- range(Eff) xl <- c(1, Time) h <- mean(Eff[,1,,]) cols <- matrix(c("green", "skyblue", "cyan", "red", "orange", "yellow3"), length(promote_method), length(hypothesis)) txt <- outer(promote_method, hypothesis, paste, sep="; ") par(mar=c(4, 4.5, 2, 10), cex=2) plot(0, xlim=xl, ylim=yl, type="n", xlab="Time", ylab="Efficiency [%]", las=1) for(hy in seq(hypothesis)){ for(pm in seq(promote_method)){ v <- mapply(function(z) z$conf.int, apply(Eff[,,pm,hy], 2, t.test)) for(i in seq(Time)){ segments(i, v[1, i], y1=v[2, i], col=cols[pm, hy]) } text(par()$usr[2], mean(v[, Time]), txt[pm, hy], xpd=TRUE, pos=4, font=2, col=cols[pm, hy] ) }} abline(h=h, lty=3, lwd=3) text(par()$usr[2], h, "Averaged Initial Efficiency", xpd=TRUE, pos=4, font=2, cex=0.7)
