Content

  • 出生比率参照:https://www.mhlw.go.jp/toukei/saikin/hw/jinkou/kakutei17/dl/03_h1.pdf
  • 男:484,449/946,065=0.51、女:1-0.51=0.49(2017年)
  • 1人の男がもうける子供の数を4人、3人、2人、1人として試行回数50回のシミュレーションを行うと、第1世代に男子が出生しない割合はいずれの場合も一般的な有意水準である5%を超えている(それぞれ8%、8%、34%、56%)。よって今回のシミュレーションの結果は1人の男がもうける子供の数が4人以下の場合、同有意水準のもと第0世代(最初の男)で奥義が途絶える可能性が棄却されないことを示唆している。
  • 1人の男がもうける子供の数を1人としたシミュレーションの結果、50回の試行のうち第10世代まで絶えること無く男子が出生し奥義が伝承されたのは 0 回。長くとも第4世代で奥義が途絶えている。
  • あくまでもシミュレーションの結果であり、解析解では無いことに留意してください。

共通関数・引数 サンプル Pattern Blue Pattern Sepia Pattern Yellow Pattern Red

共通関数・引数
set.seed(20190502)
f_mailline <- function(trials,generation,boy_to_girl_ratio,number_of_children_per_man){
  GenX <- vector()
  for(ttt in seq(trials)){
    cat('試行',ttt,'回目\n')
    number_of_children <- number_of_children_per_man
    for(ggg in seq(generation)){
      children <- sapply(seq(number_of_children),function(x)sample(x = c('B','G'),size = 1,prob = c(boy_to_girl_ratio,1-boy_to_girl_ratio)))
      cat('Gen.',ggg,':',children,':',sum(children=='B'),'/',length(children),'(男子人数/男子女子総数)\n')
      if(all(children=='G')){break}
      number_of_children <- sum(children=='B')*number_of_children_per_man
    }
    cat('\n')
    GenX[ttt] <- ggg
  }
  result <- data.frame(table(GenX))
  result$`Ratio(%)` <- round(result$Freq/trials*100)
  return(result)
}
# trials 試行回数
# generation 世代番号。最初の男は第0世代とする。
# boy_to_girl_ratio 出生する男子と女子の比率。例 0.51 → 男子:女子 = 0.51:0.49。ここでは世代に渡って不変と設定する。
# number_of_children_per_man 1人の男がもうける子供の数。確率変数とせず設定した人数の子供を必ずもうけるとする。
# B:男子、G:女子
trials <- 50
generation <- 11
boy_to_girl_ratio <- 0.51

サンプル
  • 10回の試行のうち第10世代まで絶えること無く男子が生まれた回数をシミュレーション。
  • 一人の男がもうける子供の数は 2人とする。
  • 出生比率は男:女=0.51:0.49とする。
  • シミュレーションの結果、10回の試行のうち第10世代まで絶えること無く男子が出生し奥義が伝承されたのは2回(20%)。第1世代に男子が出生せず第0世代(最初の男)で奥義が途絶えたのも2回(20%)。*結果出力欄の「シミュレーション結果」を参照。
result <- f_mailline(trials = 10,generation = 11,boy_to_girl_ratio = 0.51,number_of_children_per_man = 2)
試行 1 回目
Gen. 1 : G B : 1 / 2 (男子人数/男子女子総数)
Gen. 2 : B G : 1 / 2 (男子人数/男子女子総数)
Gen. 3 : B G : 1 / 2 (男子人数/男子女子総数)
Gen. 4 : G G : 0 / 2 (男子人数/男子女子総数)

試行 2 回目
Gen. 1 : G B : 1 / 2 (男子人数/男子女子総数)
Gen. 2 : B G : 1 / 2 (男子人数/男子女子総数)
Gen. 3 : G G : 0 / 2 (男子人数/男子女子総数)

試行 3 回目
Gen. 1 : G G : 0 / 2 (男子人数/男子女子総数)

試行 4 回目
Gen. 1 : B B : 2 / 2 (男子人数/男子女子総数)
Gen. 2 : G G G G : 0 / 4 (男子人数/男子女子総数)

試行 5 回目
Gen. 1 : B B : 2 / 2 (男子人数/男子女子総数)
Gen. 2 : B G G G : 1 / 4 (男子人数/男子女子総数)
Gen. 3 : B G : 1 / 2 (男子人数/男子女子総数)
Gen. 4 : B G : 1 / 2 (男子人数/男子女子総数)
Gen. 5 : B B : 2 / 2 (男子人数/男子女子総数)
Gen. 6 : G B G B : 2 / 4 (男子人数/男子女子総数)
Gen. 7 : G G G B : 1 / 4 (男子人数/男子女子総数)
Gen. 8 : B G : 1 / 2 (男子人数/男子女子総数)
Gen. 9 : B G : 1 / 2 (男子人数/男子女子総数)
Gen. 10 : G B : 1 / 2 (男子人数/男子女子総数)
Gen. 11 : B G : 1 / 2 (男子人数/男子女子総数)

試行 6 回目
Gen. 1 : G G : 0 / 2 (男子人数/男子女子総数)

試行 7 回目
Gen. 1 : B B : 2 / 2 (男子人数/男子女子総数)
Gen. 2 : G G B G : 1 / 4 (男子人数/男子女子総数)
Gen. 3 : G B : 1 / 2 (男子人数/男子女子総数)
Gen. 4 : G G : 0 / 2 (男子人数/男子女子総数)

試行 8 回目
Gen. 1 : G B : 1 / 2 (男子人数/男子女子総数)
Gen. 2 : B B : 2 / 2 (男子人数/男子女子総数)
Gen. 3 : G G B G : 1 / 4 (男子人数/男子女子総数)
Gen. 4 : G B : 1 / 2 (男子人数/男子女子総数)
Gen. 5 : B G : 1 / 2 (男子人数/男子女子総数)
Gen. 6 : G G : 0 / 2 (男子人数/男子女子総数)

試行 9 回目
Gen. 1 : G B : 1 / 2 (男子人数/男子女子総数)
Gen. 2 : G G : 0 / 2 (男子人数/男子女子総数)

試行 10 回目
Gen. 1 : B B : 2 / 2 (男子人数/男子女子総数)
Gen. 2 : G G G B : 1 / 4 (男子人数/男子女子総数)
Gen. 3 : G B : 1 / 2 (男子人数/男子女子総数)
Gen. 4 : B B : 2 / 2 (男子人数/男子女子総数)
Gen. 5 : G B B B : 3 / 4 (男子人数/男子女子総数)
Gen. 6 : B B G G B G : 3 / 6 (男子人数/男子女子総数)
Gen. 7 : G G G G B B : 2 / 6 (男子人数/男子女子総数)
Gen. 8 : B G B G : 2 / 4 (男子人数/男子女子総数)
Gen. 9 : G G B G : 1 / 4 (男子人数/男子女子総数)
Gen. 10 : B B : 2 / 2 (男子人数/男子女子総数)
Gen. 11 : G B G B : 2 / 4 (男子人数/男子女子総数)
  • シミュレーション結果
  GenX Freq Ratio(%)
1    1    2       20
2    2    2       20
3    3    1       10
4    4    2       20
5    6    1       10
6   11    2       20

number_of_children_per_man <- 4
result <- f_mailline(trials = trials,generation = generation,boy_to_girl_ratio = boy_to_girl_ratio,number_of_children_per_man = number_of_children_per_man)
Pattern Blue
  • 50回の試行のうち第10世代まで絶えること無く男子が生まれた回数をシミュレーション。
  • 1人の男がもうける子供の数は4人とする。
  • 出生比率は男:女=0.51:0.49とする。
  • シミュレーションの結果、50回の試行のうち第10世代まで絶えること無く男子が出生し奥義が伝承されたのは46回(92%)。第1世代に男子が出生せず第0世代(最初の男)で奥義が途絶えたのは4回(8%)。
  GenX Freq Ratio(%)
1    1    4        8
2   11   46       92

number_of_children_per_man <- 3
result <- f_mailline(trials = trials,generation = generation,boy_to_girl_ratio = boy_to_girl_ratio,number_of_children_per_man = number_of_children_per_man)
Pattern Sepia
  • 50回の試行のうち第10世代まで絶えること無く男子が生まれた回数をシミュレーション。
  • 1人の男がもうける子供の数は3人とする。
  • 出生比率は男:女=0.51:0.49とする。
  • シミュレーションの結果、50回の試行のうち第10世代まで絶えること無く男子が出生し奥義が伝承されたのは39回(78%)。第1世代に男子が出生せず第0世代(最初の男)で奥義が途絶えたのは4回(8%)。
  GenX Freq Ratio(%)
1    1    4        8
2    2    2        4
3    3    2        4
4    4    2        4
5    9    1        2
6   11   39       78

number_of_children_per_man <- 2
result <- f_mailline(trials = trials,generation = generation,boy_to_girl_ratio = boy_to_girl_ratio,number_of_children_per_man = number_of_children_per_man)
Pattern Yellow
  • 50回の試行のうち第10世代まで絶えること無く男子が生まれた回数をシミュレーション。
  • 1人の男がもうける子供の数は2人とする。
  • 出生比率は男:女=0.51:0.49とする。
  • シミュレーションの結果、50回の試行のうち第10世代まで絶えること無く男子が出生し奥義が伝承されたのは17回(34%)。第1世代に男子が出生せず第0世代(最初の男)で奥義が途絶えたのは17回(34%)。
  GenX Freq Ratio(%)
1    1   17       34
2    2    3        6
3    3    1        2
4    4    6       12
5    5    3        6
6    6    1        2
7    7    1        2
8    8    1        2
9   11   17       34

number_of_children_per_man <- 1
result <- f_mailline(trials = trials,generation = generation,boy_to_girl_ratio = boy_to_girl_ratio,number_of_children_per_man = number_of_children_per_man)
Pattern Red
  • 50回の試行のうち第10世代まで絶えること無く男子が生まれた回数をシミュレーション。
  • 1人の男がもうける子供の数は1人とする。
  • 出生比率は男:女=0.51:0.49とする。
  • シミュレーションの結果、50回の試行のうち第10世代まで絶えること無く男子が出生し奥義が伝承されたのは0回(0%)。第1世代に男子が出生せず第0世代(最初の男)で奥義が途絶えたのは28回(56%)。
  GenX Freq Ratio(%)
1    1   28       56
2    2   10       20
3    3    6       12
4    4    4        8
5    5    2        4