背景と目的

多くのプロスポーツでは, 主要なシーズンにおいては各チームが一定の試合数を行うリーグ戦方式が取られている. 一方, 短期間で行われる大会においてはプロアマ問わず, 全体的, あるいは部分的にトーナメント方式が取り入れられている. 1試合ごとに脱落チームが1つ生じるトーナメント方式は, 試合数を抑える (参加チーム数 -1 試合でチャンピオンが決まる) ため, 短期で結果を出す必要がある状況において採用されると考えられる.

このようなトーナメントでは, 偶然でもよく起こるであろう1試合の敗退の影響が大きく, また1チームあたりの試合数が少ないため各チームの真の実力が反映されにくいため, 運の影響が大きいだろうと思われる. 一度負ければ敗退のトーナメントで, どの程度ランダムさの影響があるかをシミュレーションを利用して眺める.

ここではシミュレーションを利用して, 非常に単純な系における

  • 参加チーム数 (これは優勝に必要な連勝数にも関連する)
  • 戦力差の大きさ

の影響を調べる.

シミュレーション関数の設定

それぞれのチームのタレント (チーム力) を平均0の正規分布からサンプリングして常に一定 (トーナメント中に変化しない) とし, それらを用いて勝敗をサンプリングする (Bradley-Terryモデル).

関数を設定する. チーム数とチームタレントのばらつきを引数とする (チーム数は簡単のため2^x (xは1以上の整数) に限る).

# 使ったパッケージ
# tidyverse, knitr, mgcv, cowplot

# 1トーナメントを計算する関数
# チーム数は2の冪乗のみ
sim.one.tournament <- function(total_team = 32, talent_sd = 0.2){
  
  teams <- total_team # チーム数
  # チームタレント (チーム力) を正規分布からrnormでサンプリング. 
  # 平均は0でsdは与えたものを使う
  talent.df <- data.frame(Team_ID = 1:teams, 
                          Talent = rnorm(teams, 0, talent_sd)) 
  # 上から2チームごとに1試合とする
  # 表裏を設定しているが, 別に表裏の性質は考慮していない
  # 単に1試合ごとに対戦チームをコードしたいだけ
  input.df <- data.frame(talent.df %>% select(- Talent),
                         Game_ID = gl(teams/2, 2,teams),
                         TopBot = gl(2, 1, 
                                     length = teams,
                                     label = c("Top", "Bottom")))
  
  total_rounds <- log2(total_team)
  
  if(total_rounds %% 1 != 0){
    print("total_teamには2^x (xは1以上の整数) を入れてください.")
  } else{
    looser.df <- sim.df <- vector("list", 
                                  length(1:total_rounds)) 
    # 負けたラウンドを記録するための空のリスト. これに入れていって最後にbind_rowsでdfにする
    
    # 以下でinput.dfを使って各Game IDでの勝敗を決定する
    for (i in 1:total_rounds) {
      # dfを組み直してTop, Bottomが同じ行に対戦相手が配置されるようにする
      # それらのtalentをtalent.dfから取得する
      # 表が勝利する確率をTalentの値を使って計算する
      
      result <- input.df %>%
        spread(key = TopBot,
               value = Team_ID)
      
      result <- result %>%
        mutate(Tal_top = talent.df[result$Top, 2],
               Tal_bot = talent.df[result$Bot, 2],
               Top_Wpct =  exp(Tal_top) / (exp(Tal_top) + exp(Tal_bot))) # 表が勝利する確率
      # rbinomを使って勝敗の結果を決定する
      result$WL <- with(result, rbinom(nrow(result),
                                       1,
                                       Top_Wpct))
      # 勝者と敗者のteam IDを示す列をつくる
      result <- result %>%
        mutate(Winner = ifelse(WL == 1, Top, Bottom),
               Looser = ifelse(WL == 0, Top, Bottom))
      
      # 敗者が何試合目に敗れたか記録
      looser <- result %>%
        select(Looser)%>%
        mutate(Beaten_at = i)
      looser.df[[i]] <- looser
      
      # 行われた試合数を取得する
      teams <- nrow(result)
      
      # 残ったチームで同様に計算していく
      input.df <- data.frame(Team_ID = result$Winner,
                             Game_ID = gl(teams/2, 2, teams),
                             TopBot = gl(2, 1, 
                                         length = teams,
                                         label = c("Top", "Bottom")))
    }
    
    looser.df <- bind_rows(looser.df)
    
    # team.dfに優勝したかどうかなどの情報を加える
    team.df <- talent.df %>%
      mutate(Winner_FL = ifelse(Team_ID == result$Winner, 1, 0),
             Talent_rank = rank(-Talent),
             Teams = as.factor(total_team),
             SD_type = as.factor(talent_sd),
             Best_team_FL = ifelse(Talent_rank == 1, 1, 0))%>%
      left_join(looser.df, by =c("Team_ID" = "Looser"))
    
    return(team.df)
  }
}


# 複数試合
sim.multi.tournament <- function(total_team = 32, 
                                 talent_sd = 0.2, 
                                 tournament = 100){
  
  sim.df <- vector("list", length(1:tournament)) 
  
  for(i in seq_along(1:tournament)){
    sim.one <- sim.one.tournament(total_team = total_team, talent_sd = talent_sd)
    sim.one <- sim.one %>%
      mutate(Team_ID = paste(i, Team_ID, sep = "-"),
             Tournament_ID = i)
    sim.df[[i]] <- sim.one
  }
  sim.df <- bind_rows(sim.df) 
  return(sim.df)
}

言うまでもなく, このモデルでは現実に影響を及ぼすであろう様々な要因が考慮されていないと思われる. 例えばこのような要因としては, 過密日程による疲労/怪我への応答性, 各チームにおける日程の過密具合の違い, ホームフィールドアドバンテージなどが考えられる. また, 参加チームを増やして参加チームの能力の分布を一定に保つというのは, 現実のスポーツでは極めて非現実的な仮定である. あくまで, 影響を与える可能性がある要因である, チーム数, 戦力差の影響をざっくり桁感を得よう, という目的にとどまる.

シミュレーション

チーム力 (Talent) を平均0の正規分布からサンプリングし, 勝敗をシミュレーションする. チーム力aのチームと, チーム力bのチームが試合をした時の勝率は以下の式で与えられるとする (Marchi and Albert, 2013; この文献ではMLBのフルシーズンのシミュレーションが記述されている).

exp(a) / (exp(a) + exp(b))

8チームによる1トーナメントの結果例.

one.tournament <- sim.one.tournament(total_team = 8)
one.tournament[2] <- round(one.tournament[2], 3)
kable(one.tournament)
Team_ID Talent Winner_FL Talent_rank Teams SD_type Best_team_FL Beaten_at
1 -0.071 1 5 8 0.2 0 NA
2 -0.283 0 8 8 0.2 0 1
3 -0.214 0 6 8 0.2 0 2
4 0.184 0 1 8 0.2 1 1
5 0.113 0 4 8 0.2 0 3
6 0.132 0 3 8 0.2 0 1
7 -0.228 0 7 8 0.2 0 1
8 0.134 0 2 8 0.2 0 2

チーム力のばらつき (sd) を変化させたときの, 平均的なチームに対する勝率の分布を眺めておく. ここでの“平均的なチーム”というのは実際に参加したチームではなく, とりだそうとしている分布の平均 (つまり0). sd=0.2ぐらいでNPBやMLBでのチーム勝率の分布が概ね再現される. 甲子園ならもっと大きいだろうが測定は困難?

タレントの分散を変化させて, 各条件ごとの平均的なチームに対する勝率の分布を確認する.

# sim.02 <- sim.multi.tournament(total_team = 32,
#                                talent_sd = 0.2,
#                                tournament = 1000)
# 
# sim.05 <- sim.multi.tournament(total_team = 32,
#                                talent_sd = 0.5,
#                                tournament = 1000)
# 
# sim.1 <- sim.multi.tournament(total_team = 32,
#                               talent_sd = 1,
#                               tournament = 1000)
# 
# sim.dist <- rbind(sim.02, sim.05, sim.1)
# 
# sim.dist$Wpct <- exp(sim.dist$Talent) / (exp(sim.dist$Talent) + exp(0))
# save(sim.dist, file="markdown_sim_dist_1.Rdata")

load("markdown_sim_dist_1.Rdata")

ggplot(sim.dist,
       aes (x = Wpct)) + 
  geom_density(
    stat = "density",
    position = "identity")+ 
  facet_wrap(~SD_type)+
  theme_bw(base_family = "HiraKakuPro-W3") +
  background_grid(major = "xy", minor = "xy", 
                  size.major = 0.5, colour.major = "gray",
                  size.minor  = 0.15, colour.minor = "gray")+
  labs(x =  "平均的なチームに対する勝率", y =  "確率密度", 
       title =  "異なるTalent SDごとの勝率の分布")

一番左がNPBやMLBに近い. 1はさすがにやりすぎ?

ベスト勝率チームとそうでないチームで, 優勝確率を比較する. 参加試合数を変化させる. こんなに増やすならまとめて計算する関数書けば良かった.

# sim.16 <- sim.multi.tournament(total_team = 16,
#                                talent_sd = 0.2,
#                                tournament = 10000)
# sim.32 <- sim.multi.tournament(total_team = 32,
#                                talent_sd = 0.2,
#                                tournament = 10000)
# sim.64 <- sim.multi.tournament(total_team = 64,
#                                talent_sd = 0.2,
#                                tournament = 10000)
# sim.128 <- sim.multi.tournament(total_team = 128,
#                                talent_sd = 0.2,
#                                tournament = 10000)
# sim.256 <- sim.multi.tournament(total_team = 256,
#                                talent_sd = 0.2,
#                                tournament = 10000)
# sim.team <- bind_rows(sim.16, sim.32, sim.64, sim.128, sim.256)
# sim.team <- sim.team %>%
#   mutate(Teams = factor(Teams, levels = c("16", "32", "64", "128", "256")))
# save(sim.team, file="markdown_sim_team_01.Rdata")

load("markdown_sim_team_01.Rdata")

champ.pct.table <- sim.team %>%
  group_by(Teams, Best_team_FL)%>%
  dplyr::summarise(N =n (),
                   Champion = sum(Winner_FL),
                   Champ_pct = round(Champion/N, 3))

kable(champ.pct.table)
Teams Best_team_FL N Champion Champ_pct
16 0 150000 8866 0.059
16 1 10000 1134 0.113
32 0 310000 9245 0.030
32 1 10000 755 0.076
64 0 630000 9525 0.015
64 1 10000 475 0.048
128 0 1270000 9641 0.008
128 1 10000 359 0.036
256 0 2550000 9767 0.004
256 1 10000 233 0.023

2つの効果が拮抗していると思われる.

  • チーム数が増えることで全体的に優勝確率が低下する
  • 試合数が増えることで情報量が増えて, 強いチームがより優勝しやすい

つまり, 試合数を増やしていくと, ベストなチーム (Best_team_FL=1) の優勝確率 (Champ_pct) も低下するが, 比としては最もチーム力が高いチームが優勝しやすくなっている (参加チームが増えてもChamp_pctの低下が相対的に小さい). 16チームの大会ではベストのチームが優勝する確率はそれ以外のチームの2倍程度だが, 256チームでは5倍まで上昇する. しかしベストチームが優勝する確率は非常に低い.

チーム間の戦力差の大きくする (sd=0.5)

# sim.05.16 <- sim.multi.tournament(total_team = 16,
#                                talent_sd = 0.5,
#                                tournament = 10000)
# sim.05.32 <- sim.multi.tournament(total_team = 32,
#                                talent_sd = 0.5,
#                                tournament = 10000)
# sim.05.64 <- sim.multi.tournament(total_team = 64,
#                                talent_sd = 0.5,
#                                tournament = 10000)
# sim.05.128 <- sim.multi.tournament(total_team = 128,
#                                talent_sd = 0.5,
#                                tournament = 10000)
# sim.05.256 <- sim.multi.tournament(total_team = 256,
#                                talent_sd = 0.5,
#                                tournament = 10000)
# sim.team.05 <- bind_rows(sim.05.16, sim.05.32, sim.05.64,
#                          sim.05.128, sim.05.256)%>%
#   mutate(Teams = factor(Teams, levels = c("16", "32", "64", "128", "256")))
# save(sim.team.05, file="markdown_sim_team_05_01.Rdata")

load("markdown_sim_team_05_01.Rdata")

champ.pct.table3 <- sim.team.05 %>% group_by(Teams, Best_team_FL)%>%
  dplyr::summarise(N =n (),
                   Champion = sum(Winner_FL),
                   Champ_pct = round(Champion/N, 3))
kable(champ.pct.table3)
Teams Best_team_FL N Champion Champ_pct
16 0 150000 7784 0.052
16 1 10000 2216 0.222
32 0 310000 8279 0.027
32 1 10000 1721 0.172
64 0 630000 8668 0.014
64 1 10000 1332 0.133
128 0 1270000 8949 0.007
128 1 10000 1051 0.105
256 0 2550000 9075 0.004
256 1 10000 925 0.092

SD=0.2よりは全体的にベストチームが勝ちやすくなった. 戦力差があるため, ベストチームの能力が大きい値になりやすいことが効いているだろう. 16チームの大会ではベストのチームが優勝する確率はそれ以外のチームの4倍程度だが, 256チームでは20倍まで上昇する. とはいえ, ここでもどの試合数でもベストチームが優勝する確率はそれほど高くはない.

ベストチームがどこで負けたか眺める.

sim.team %>% 
  filter(Best_team_FL == 1)%>%
  filter(Teams == "32" | Teams == "256")%>%
  ggplot(aes(x = Beaten_at))+
  geom_histogram(alpha = 0.7,
                 binwidth = 1,
                 colour="black", fill="gray")+
  theme_bw(base_family = "HiraKakuPro-W3") +
  facet_wrap(~Teams)+
  labs(title = "タレントSD=0.02においてベストチームが負けたラウンド",
       x = "負けラウンド",
       y = "N")

ベストのチームも初戦で35%強程度負けている. 要するに平均的なチームに対して65%程度の勝率だったということだろう. 負けチームの分だけ数が減るので, 次のラウンドでは負けチーム数としては減少する .

同様にsd=0.5の時の負けラウンド.

sim.team.05 %>% 
  filter(Best_team_FL == 1)%>%
  filter(Teams == "32" | Teams == "256")%>%
  ggplot(aes(x = Beaten_at))+
  geom_histogram(alpha = 0.7,
                 binwidth = 1,
                 colour="black", fill="gray")+
  theme_bw(base_family = "HiraKakuPro-W3") +
  facet_wrap(~Teams)+
  labs(title = "タレントSD=0.05においてベストチームが負けたラウンド",
       x = "負けラウンド",
       y = "N")

戦力差が大きい設定になったため, 初戦の敗退は20-25%程度まで低下した. 勝ち残る確率が上がり, よりラウンド数が大きい試合で敗退している.

“最も優秀”ではなく, 上位層で見る. 各トーナメントにおけるタレントのランクが上位25%のチームが勝った回数などをカウントする. これならチーム数が増えた影響をキャンセルできるはずである.

temp.list <- vector("list", length = 5)
team.vector <- c("16", "32", "64", "128", "256")
for(i in seq_along(team.vector)){
  rank.df <- sim.team %>%
    filter(Teams == team.vector[i])%>%
    mutate(Top25pct = ifelse(Talent_rank < as.numeric(team.vector[i])/4 + 1, 1, 0))
  temp.list[[i]] <- rank.df
}

sim.team <- bind_rows(temp.list)

champ.pct.table2 <- sim.team %>% group_by(Teams, Top25pct)%>%
  dplyr::summarise(N =n (),
                   Champion = sum(Winner_FL),
                   Champ_pct = round(Champion/N, 3))

kable(champ.pct.table2)
Teams Top25pct N Champion Champ_pct
16 0 120000 6132 0.051
16 1 40000 3868 0.097
32 0 240000 5838 0.024
32 1 80000 4162 0.052
64 0 480000 5426 0.011
64 1 160000 4574 0.029
128 0 960000 5057 0.005
128 1 320000 4943 0.015
256 0 1920000 4666 0.002
256 1 640000 5334 0.008

チーム数が増えるほど上位25%が優勝チームになる確率は上昇している. チーム数が増えると, それだけ優勝に必要な連勝数が大きくなるため, 運の要素は小さくなる. しかし, 参加が32-64チームでは上位25%の優勝確率は半分にも満たない. 参加を256チームまで増やしてもそれほどの改善は見られず, 53%程度である.

TalentのSD=0.5について, 同様に上位層について集計する.

Teams Top25pct N Champion Champ_pct
16 0 120000 4200 0.035
16 1 40000 5800 0.145
32 0 240000 3465 0.014
32 1 80000 6535 0.082
64 0 480000 2640 0.006
64 1 160000 7360 0.046
128 0 960000 1970 0.002
128 1 320000 8030 0.025
256 0 1920000 1469 0.001
256 1 640000 8531 0.013

チーム間の差が大きいので, いわゆる番狂わせが減るためか強いチームが優勝しやすくなると思われる. 上位25%が優勝する確率は32-64チームで70%程度にもなっている. 参加チーム数を増やすことの効果もSD=0.2の場合よりも大きいようだ.

まとめ

トーナメント型の大会において, 優れたチームが勝ち上がるかどうかを決定する要因としては, チーム間の戦力差の影響が大きいのではないか. チーム数を増やして必要な最大連勝数を上昇させることでも, 優れたチームの優勝確率は改善するが, 戦力差がNPBやMLBのようなある程度拮抗した環境である場合, その効果は限定的である.

おまけ

初めに思いついたときは安直にロジスティック回帰を考えていた. 結果的にはチーム数が増えることの効果で見づらいため, 上のテーブル方式のほうが個人的にわかりやすく, 前に持っていった. ロジスティック回帰の誤差範囲をざっくり確認する.

# シミュレーション結果を使ってロジスティック回帰を行う関数
win.logistic.func <- function(input.data){
  logit <- gam(Winner_FL ~ Talent,
               data = input.data, family = binomial)
  
  # summary(logit)
  logit_data <- data.frame(Talent = seq(-10, 10, 0.01))
  logit_data <- cbind(logit_data, 
                      predict(logit, 
                              newdata = logit_data, 
                              type = "link", se = TRUE))
  
  logit_data <- within(logit_data, {
    PredictedProb <- plogis(fit)
    LL <- plogis(fit - (1.96 * se.fit))
    UL <- plogis(fit + (1.96 * se.fit))
  })
}

# シミュレーションからロジスティック回帰までまとめる
sim.logi.func <- function(total_team = 32, 
                          talent_sd = 1, 
                          tournament = 100){
  sim.df <- sim.multi.tournament(total_team = total_team, 
                                 talent_sd = talent_sd, 
                                 tournament = tournament)
  logi <- win.logistic.func(sim.df)
  logi <- mutate(logi,
                 Wpct = exp(Talent) / (exp(Talent) + exp(0)), # 平均的なチームに対する勝率
                 # プロットをつくるときにtalentでそのまま示すより解釈が容易になると思ってこれを入れている
                 Team = as.factor(total_team),
                 Talent_SD = as.factor(talent_sd))
  # return(sim.df)
}
# # 一度結果を保存してからlogistic回帰する場合

# sim.test <- sim.multi.tournament(total_team = 32,
#                                talent_sd = 0.2,
#                                tournament = 4000)
# logi.sim.test <- win.logistic.func(sim.test)
# logi.sim.test$Wpct <- with(logi.sim.test, exp(Talent) / (exp(Talent) + exp(0)))
# save(logi.sim.test, file="markdown_sim_test_1.Rdata")

load("markdown_sim_test_1.Rdata")
ggplot(logi.sim.test, aes(x = Wpct, y = PredictedProb)) +
  geom_ribbon(aes(ymin = LL,ymax = UL),  fill = "grey70", alpha = 0.5) +
  geom_line() +
  theme_bw(base_family = "HiraKakuPro-W3") +
  scale_fill_discrete(guide=FALSE)+
  background_grid(major = "xy", minor = "xy", 
                  size.major = 0.5, colour.major = "gray",
                  size.minor  = 0.15, colour.minor = "gray")+
  labs(title = "チーム数32, talent sd = 0.2", 
       subtitle = "ロジスティック回帰. 誤差範囲は1.96 * SE.", 
       x = "平均的なチームに対する勝率", y = "優勝確率",
       colour = "結果")

sd = 0.2でも1000回は回さないと推定が甘すぎる (この例では4000回). sdが小さいと勝率が高いゾーンでのサンプル数が減るので, 試行回数をより増やす必要があると考えられる.

チーム数を32で固定し, タレントを0.2, 0.5, 1で計算してみる.

# logi.02.32 <- sim.logi.func(total_team = 32,
#                       talent_sd = 0.2,
#                       tournament = 4000)
# logi.05.32 <- sim.logi.func(total_team = 32,
#                            talent_sd = 0.5,
#                            tournament = 4000)
# logi.10.32 <- sim.logi.func(total_team = 32,
#                            talent_sd = 1,
#                            tournament = 4000)
# logi.32.team <- rbind(logi.02.32, logi.05.32, logi.10.32)

# save(logi.32.team, file="markdown_logi_32_teams_1.Rdata")

load("markdown_logi_32_teams_1.Rdata")
ggplot(logi.32.team, aes(x = Wpct, y = PredictedProb,
                  linetype = Talent_SD)) +
  geom_line() +
  xlim(0.5, 1)+
  theme_bw(base_family = "HiraKakuPro-W3") +
  scale_fill_discrete(guide=FALSE)+
  background_grid(major = "xy", minor = "xy", 
                  size.major = 0.5, colour.major = "gray",
                  size.minor  = 0.15, colour.minor = "gray")+
  labs(title = "チーム数32のトーナメントにおける優勝確率", 
       subtitle = "チームタレントのSDを変化させたロジスティック回帰.", 
       x = "平均的なチームに対する勝率", y = "優勝確率",
       colour = "チームタレントのSD")

sdが大きいと, 参加者内での平均的なチームに対する勝率が高い (or 低い) チームが出やすくなるので, 例えば勝率0.7ぐらいのNPBでは恐ろしく強いチームであっても頻繁に出るようになる. そのため, 勝率0.7ぐらいの強いチームでも優勝確率は低下するのだろうと思われる.

sd=0.2に固定し, 試合数を変動させる場合.

# logi.02.8 <- sim.logi.func(total_team = 8,
#                            talent_sd = 0.2,
#                            tournament = 10000)
# logi.02.16 <- sim.logi.func(total_team = 16,
#                            talent_sd = 0.2,
#                            tournament = 10000)
# logi.02.32.2 <- sim.logi.func(total_team = 32,
#                            talent_sd = 0.2,
#                            tournament = 10000)
# logi.02.64 <- sim.logi.func(total_team = 64,
#                            talent_sd = 0.2,
#                            tournament = 10000)
# logi.02.128 <- sim.logi.func(total_team = 128,
#                            talent_sd = 0.2,
#                            tournament = 10000)
# logi.02.256 <- sim.logi.func(total_team = 256,
#                            talent_sd = 0.2,
#                            tournament = 10000)
# logi.fixed.sd <- rbind(logi.02.8,
#                        logi.02.16,
#                        logi.02.32.2,
#                        logi.02.64,
#                        logi.02.128,
#                        logi.02.256)
# save(logi.fixed.sd, file="markdown_logi_fixed_sd_01.Rdata")

load("markdown_logi_fixed_sd_01.Rdata")
ggplot(logi.fixed.sd, aes(x = Wpct, y = PredictedProb,
                 linetype = Team)) +
  geom_line() +
  xlim(0, 1)+
  theme_bw(base_family = "HiraKakuPro-W3") +
  scale_fill_discrete(guide=FALSE)+
  background_grid(major = "xy", minor = "xy", 
                  size.major = 0.5, colour.major = "gray",
                  size.minor  = 0.15, colour.minor = "gray")+
  labs(title = "NPB程度の勝率差を持つ集団によるトーナメントにおける,
       優勝確率の推定", 
       subtitle = "推定にはシミュレーション(Bradley-Terryモデル)を用いた. 
出場チーム数を変化させてノックアウトステージ型トーナメントを組み, 
優勝したかどうかでロジスティック回帰.", 
       # 誤差範囲は1.96 * SE.", 
       x = "平均的なチームに対する勝率", y = "優勝確率",
       colour = "出場チーム数")

2つの効果が拮抗していると思われる.

  • チーム数が増えることで全体的に優勝確率が低下する
  • 試合数が増えることで情報量が増えて, 強いチームがより優勝しやすい

例えば, 参加チームが8 (試合数で3) の場合, 平均的な勝率のチームでもそこそこ勝つ (1/8) が, チーム数を増やしていくと反比例して勝率が低下する. 強いチームでもチーム数が増えるので確率が低下するが, 平均的なチームのように, チーム数を2倍にしても1/2にはならず, 減少の割合は比較的小さいようだ.

この条件では128と256では差があまりない?

これだけ見てもわかるようなわからないような.

sd=0.5で試合数を変動させる場合.

# logi.05.8 <- sim.logi.func(total_team = 8,
#                            talent_sd = 0.5,
#                            tournament = 10000)
# logi.05.16 <- sim.logi.func(total_team = 16,
#                            talent_sd = 0.5,
#                            tournament = 10000)
# logi.05.32.2 <- sim.logi.func(total_team = 32,
#                            talent_sd = 0.5,
#                            tournament = 10000)
# logi.05.64 <- sim.logi.func(total_team = 64,
#                            talent_sd = 0.5,
#                            tournament = 10000)
# logi.05.128 <- sim.logi.func(total_team = 128,
#                            talent_sd = 0.5,
#                            tournament = 10000)
# logi.05.256 <- sim.logi.func(total_team = 256,
#                            talent_sd = 0.5,
#                            tournament = 10000)
# logi.fixed.sd05 <- rbind(logi.05.8,
#                        logi.05.16,
#                        logi.05.32.2,
#                        logi.05.64,
#                        logi.05.128,
#                        logi.05.256)
# save(logi.fixed.sd05, file="markdown_logi_fixed_sd05_01.Rdata")

load("markdown_logi_fixed_sd05_01.Rdata")
ggplot(logi.fixed.sd05, aes(x = Wpct, y = PredictedProb,
                 linetype = Team)) +
  geom_line() +
  xlim(0, 1)+
  theme_bw(base_family = "HiraKakuPro-W3") +
  scale_fill_discrete(guide=FALSE)+
  background_grid(major = "xy", minor = "xy", 
                  size.major = 0.5, colour.major = "gray",
                  size.minor  = 0.15, colour.minor = "gray")+
  labs(title = "タレントSD=0.5の集団によるトーナメントにおける,
       優勝確率の推定", 
       subtitle = "推定にはシミュレーション(Bradley-Terryモデル)を用いた. 
出場チーム数を変化させてノックアウトステージ型トーナメントを組み, 
優勝したかどうかでロジスティック回帰.", 
       x = "出場チームの平均的なチームに対する勝率", y = "優勝確率",
       colour = "出場チーム数")

NPBではまずありえないような勝率0.75ぐらいのチームでも優勝確率が抑えられている. 極端に強いチームが出やすくなっているためだろう.

チーム間の戦力差を増加させたこの条件では128と256の間ではっきりした差が見えている感じがする.