ワールドカップ予選突破まで勝ち点はあと何点？

ちょっと怪しいながらもイラクに勝ってほっと安心。前のイラクの試合を見たときはジーコらしいぐだぐだな試合をしていたので楽勝かと思ったらちゃんとしたサッカーになっていたので何が起こったんでしょうか？日本はボランチとCBの補強が課題。今は大丈夫でも2年後を考えるとなんとしても次が来てもらわないと困ります。

さて、いつになったら安心できるのかということでちょっと勝ち点を計算してみました。単純に残りの12試合の全ての勝敗パターン(3^12=531441)を計算してみただけです。3位でもプレーオフはありますが考慮せず、勝敗がランダムに発生し得失点差は日本が不利だと仮定して計算すると日本が勝ち抜けできないパターンは40969パターンあり、つまり7.7%になります。よほどのことがないかぎり問題がないということですね。

あと何勝すれば勝ち抜けなのか？ちなみにオーストラリア残り5連勝などということが起これば勝ち点16でも敗退するパターンが6あります。つまり理論的には勝ち抜けには17点が必要になります。逆に言えば一敗は問題ありません。現実問題として二敗しても大丈夫ということがわかります。

早く確定するといいですね。10/16の試合が終わったらまた計算結果を出します。

あと計算につかったプログラムを残しておきます。

import Control.Monad
import Data.List 

data Country = Japan | Jordan | Australia | Oman | Iraq deriving (Eq,Show)
data Result  = HomeWin | Draw | AwayWin deriving (Eq,Show)

countries = [Japan, Jordan , Australia, Oman, Iraq]

countryPriority :: Country -> Int
countryPriority x 
  | x == Japan = 0
  | otherwise = 5
    
matchDone = 
  [ ((Japan,3),(Oman,0))
  , ((Jordan,1),(Iraq,1))
  , ((Japan,3),(Jordan,0))
  , ((Oman,1),(Australia,1))
  , ((Australia,1),(Japan,1))
  , ((Iraq,1),(Oman,1))
  , ((Japan,3),(Iraq,0))
  , ((Jordan,3),(Australia,0)) 
  ]

matchLeft = 
  [ (Oman, Jordan)
  , (Iraq,    Australia)
  , (Iraq,    Jordan)
  , (Oman,    Japan)
  , (Australia,   Oman)
  , (Jordan,    Japan)
  , (Japan,    Australia)
  , (Oman,    Iraq)
  , (Iraq,    Japan)
  , (Australia,   Jordan)
  , (Jordan,    Oman)
  , (Australia,   Iraq) ]

leftPattern = replicateM leftMatchNum [HomeWin, Draw, AwayWin]
leftMatchNum = length matchLeft
  
resultToPoint :: ((Country, Country), Result) -> ((Country, Int),(Country, Int))
resultToPoint ((x,y), r) 
  | r == HomeWin = ((x,3),(y,0))
  | r == AwayWin = ((x,0),(y,3))
  | r == Draw    = ((x,1),(y,1))
  
resultToPointPattern :: [Result] -> [((Country, Int), (Country, Int))]
resultToPointPattern result= map resultToPoint (zip matchLeft result)

calcPoint :: [((Country, Int), (Country, Int))] -> Country -> (Country, Int)
calcPoint pp c = (c,
    sum $ (map (snd . fst) $ filter (\x@(h,a) -> fst h == c ) pp)
    ++    (map (snd . snd) $ filter (\x@(h,a) -> fst a == c ) pp))

resultCompare :: (Country, Int) -> (Country, Int) -> Ordering
resultCompare (c1,r1) (c2,r2) 
  | r1 > r2 = LT
  | r1 < r2 = GT
  | r1 == r2 = compare (countryPriority c2) (countryPriority c1)
  
orderByJapan :: [(Country,Int)] -> [(Country,Int)] -> Ordering
orderByJapan x y = 
  compare 
  (fmap snd $ find (\a@(c,r) -> c == Japan) x)
  (fmap snd $ find (\a@(c,r) -> c == Japan) y)


main = do
  let pointPattern = 
        map (\pt -> 
                sortBy resultCompare 
                 (map (calcPoint (matchDone ++ (resultToPointPattern pt))) 
                  countries)
              ) leftPattern
  let lossPattern = filter  (\x -> not (elem Japan (map (\y@(c,r)->c) 
                                                    (take 2 x))))
                   pointPattern
  mapM_ print $ sortBy orderByJapan lossPattern
  print $ length lossPattern
  print $ (3 ^ leftMatchNum)
  print $ (fromIntegral (length lossPattern))/(3 ^ leftMatchNum)