頭脳王2014 三山崩しをRで解く（必敗型スタートの人と必勝型スタートの人がいた件）

#追記
#録画を見なおしたら衝撃的事実が発覚
#なんと敗者の初期値は必敗の組合せだった！
#ひでえ。放送事故やん

追記２
Nim - sigma425のブログ
すでに言及されていた。しかも、コメント欄が熱い！！！

追記３　本人のコメント？
https://twitter.com/sou_mizukami/status/542321017759092736

録画していた頭脳王を見た。

そこで、コンピュータと対戦するコーナーが有った。

３色のチェスの駒のかたまりがあり、そこから交互に任意の１色の
駒を好きなだけ取っていく。最後の１つを取ったら負け。
２色以上の駒は同時にとってはいけない。

Rで無理やり解いてみる。
勝つために相手（コンピュータ）に渡すべき組合せを探索する。

n <- 10   #コマの最大数
dat <- expand.grid(0:n,0:n,0:n)
dat <- dat[-1,]
nr <- nrow(dat)
row.names(dat) <- seq_len(nr)

flag2 <- flag <- numeric(nr)
flag3 <- 0
dat <- as.matrix(dat)

flag[apply(dat, 1, function(x) sum(x)==1)] <- 1 #flag1=win、1,0,0を相手に渡すと勝利確定 flag=2は負け確定　flag=0は未定

tsugi <- function(x){   #次に考えられる組合せ
      if (x[1]==0){
            temp1 <- NULL
      }else{
            temp1 <- expand.grid(0:(x[1]-1), x[2], x[3])
      }
      if (x[2]==0){
            temp2 <- NULL
      }else{
            temp2 <- expand.grid(x[1], 0:(x[2]-1), x[3])
      }
      if (x[3]==0){
            temp3 <- NULL      
      }else{
            temp3 <- expand.grid(x[1], x[2], 0:(x[3]-1))
      }
      return(rbind(temp1, temp2, temp3))
}

mae <-  function(x){   #前に考えられる組合せ
      if (x[1] == n){
            temp1 <- NULL
      }else{
            temp1 <- expand.grid((x[1]+1):n, x[2], x[3])
      }
      if (x[2] == n){
            temp2 <- NULL
      }else{
            temp2 <- expand.grid(x[1], (x[2]+1):n, x[3])
      }
      if (x[3] == n){
            temp3 <- NULL      
      }else{
            temp3 <- expand.grid(x[1], x[2], (x[3]+1):n)
      }
      return(rbind(temp1, temp2, temp3))
}

same <- function(y){
      which(apply(dat, 1, function(x) all(x == y)))
}

while(sum(flag==0) != 0){
      cat(sum(flag==0),"st")
 if (sum(flag == 1 & flag2 == 0) != 0){
 make.check <- dat[(flag == 1 & flag2 == 0),]
 flag2[flag == 1] <- 1
 temp1 <- NULL
 for (i in seq_len(nrow(make.check))){
       temp1 <- rbind(temp1, mae(make.check[i,])) 
 }
 temp1 <-  as.matrix(unique(temp1, 1, incomparables = FALSE))
 for (i in seq_len(nrow(temp1))){
    flag[apply(dat, 1, function(x) all(x == temp1[i,]))] <- 2
 }
 } ##ここまで絶対負けのチェック

 if (sum(flag==0) != 0){  #未確定が残っていれば
 temp3 <- dat[flag == 0,] #未確定のもの
 cat(sum(flag==0),"make", temp3[1,])
 for (k in seq_len(nrow(temp3))){
       temp4 <- tsugi(temp3[k,])
       if( all(flag[apply(temp4, 1, same)]  == 2)){  #次がすべて負の場合
             flag[same(temp3[k,])] <- 1 #勝ちフラグ達成
       }
} 
}
}

win <- dat[flag==1,]  ##勝ち
lose <- dat[flag==2,]  ##負け
dat[flag==0,]  ##未定

win2 <- (apply(win, 1, sort))
win2 <- unique(win2, 2, incomparables = FALSE)
win2

相手に渡すと必ず勝てる組合せ

> win2
     1 24 36 48 60 72 84 96 108 120 133 146 170 194 218 292 304 340 414 424 472
[1,] 0  0  0  0  0  0  0  0   0   0   1   1   1   1   1   2   2   2   3   3   3
[2,] 0  2  3  4  5  6  7  8   9  10   1   2   4   6   8   4   5   8   4   5   9
[3,] 1  2  3  4  5  6  7  8   9  10   1   3   5   7   9   6   7  10   7   6  10

コンピュータに上記0,2,2とか0,3,3などの組み合わせになるように
うまく取って渡すことを繰り返せば勝てる。

解いた後に、これは三山崩しという有名なゲームだと知った。
必勝法はここに詳しい
http://www.ise.chuo-u.ac.jp/ISE/outline/Gmajor/matsui/contents03.html
つまり、これは必勝法を知っているかどうかの知識問題だったわけだ。
うろ覚えだった場合、当然後の人ほど思い出す時間があるので有利。
その場で必勝法を作ったとしたら、まさに宇宙人と言えよう。
でも彼らなら有り得そうだ。

ググって、必勝法がわかったので、そっちの方向で検証する

library(oro.dicom)
bi2 <- Vectorize(dec2base)
bi3 <- function(x) bi2(x,2,4)

res <- matrix(ncol = ncol(win2), nrow = 3)
for (i in seq_len(ncol(win2))){
      res[,i] <- sapply(win2[,i], bi3) 
}
res

> res
     [,1]   [,2]   [,3]   [,4]   [,5]   [,6]   [,7]   [,8]   [,9]   [,10]  [,11]  [,12]  [,13]  [,14] 
[1,] "0000" "0000" "0000" "0000" "0000" "0000" "0000" "0000" "0000" "0000" "0001" "0001" "0001" "0001"
[2,] "0000" "0010" "0011" "0100" "0101" "0110" "0111" "1000" "1001" "1010" "0001" "0010" "0100" "0110"
[3,] "0001" "0010" "0011" "0100" "0101" "0110" "0111" "1000" "1001" "1010" "0001" "0011" "0101" "0111"
     [,15]  [,16]  [,17]  [,18]  [,19]  [,20]  [,21] 
[1,] "0001" "0010" "0010" "0010" "0011" "0011" "0011"
[2,] "1000" "0100" "0101" "1000" "0100" "0101" "1001"
[3,] "1001" "0110" "0111" "1010" "0111" "0110" "1010"
tasu <- function(x) sum(as.numeric(x))
apply(res, 2, tasu)

> apply(res, 2, tasu)
 [1]    1   20   22  200  202  220  222 2000 2002 2020    3   22  202  222 2002  220  222 2020  222  222 2022
>

#たしかに、自明の0,0,1と1,1,1以外各桁が偶数だ。

#各桁が偶数になる組み合わせ全部を探索する

res2 <- dat
for (i in seq_len(nrow(res2))){
      res2[i,] <- sapply(dat[i,], bi3) 
}

tasu <- function(x) sum(as.numeric(x))

ni <- apply(res2, 1, tasu)

bal <- function(x) {
      temp <- NULL
      guu <- function(y) y %% 2 == 0
      temp[1] <- guu(x %/% 1000)
      temp[2] <- guu(x %/% 100)
      temp[3] <- guu(x %/% 10)
      temp[4] <- guu(x %% 10)
      all(temp == TRUE)
}

ans <- dat[sapply(ni, bal),]
ans2 <- (apply(ans, 1, sort))
ans2 <- unique(ans2, 2, incomparables = FALSE)
ans2

> ans2
     12 24 36 48 60 72 84 96 108 120 146 170 194 218 292 304 340 414 424 472
[1,]  0  0  0  0  0  0  0  0   0   0   1   1   1   1   2   2   2   3   3   3
[2,]  1  2  3  4  5  6  7  8   9  10   2   4   6   8   4   5   8   4   5   9
[3,]  1  2  3  4  5  6  7  8   9  10   3   5   7   9   6   7  10   7   6  10

> win2
     1 24 36 48 60 72 84 96 108 120 133 146 170 194 218 292 304 340 414 424 472
[1,] 0  0  0  0  0  0  0  0   0   0   1   1   1   1   1   2   2   2   3   3   3
[2,] 0  2  3  4  5  6  7  8   9  10   1   2   4   6   8   4   5   8   4   5   9
[3,] 1  2  3  4  5  6  7  8   9  10   1   3   5   7   9   6   7  10   7   6  10

うむ、自明の0,0,1と1,1,1以外一致した。完璧。

しかし、時間がかかりすぎる。もっと良いアルゴリズムはあるだろう。

そして、録画を見なおした所衝撃的事実が判明

敗者の初期値
3,9,10

えっ3,9,10！？？？？
相手に渡すと必勝の組合せじゃん。
これが自分に回ってきているとなると、自分必敗。
相手コンピュータだし絶対敗けるじゃん。
と思ったら、わざとミスするプログラムっぽい。
しかし、人によって必敗スタートとはいかがなものか。
ちょっと公平じゃないんじゃね。

人3,9,10（スタートが必敗型）から1,9,10
com1,9,10から1,9,8（必勝）
人1,9,8から1,7,8
com1,7,8から1,7,6（必勝）
人1,7,6から1,5,6（訂正：ビデオ見なおしたら数字が変わっていただけだった。勘違い）
1,5,6から以降カットされて分からず

勝者は
人4,5,9(スタートが必勝に持ち込める型)から4,5,1(必勝)
com4,5,1から4,3,1
人4,3,1から2,3,1(必勝)
com2,3,1から2,3,0
人2,3,0から2,2,0（必勝）
com2,2,0から2,1,0
人2,1,0から0,1,0（必勝）