「オフラインリアルタイムどう書くE13の問題」をRで解く

「六角形のテトロミノ」問題（http://qiita.com/Nabetani/items/50cd05989b6e2812f879 ） を解きました。
問題は→[こちら](http://nabetani.sakura.ne.jp/hena/orde13hextet/)
ひと言でいうと、六角ミノ４つの配置を、平行・回転移動を含めて判定する問題です（鏡像はNG）。

Rで書きました。特に工夫のない全探索ですが、ミノのサイズは固定なので効率性を追求せずアルゴリズムの分かりやすさを重視しました。

## 考え方

### 文字の配置を行列で表現

６つの方角を０〜５の数字で表します。

- 0 = 右
- 1 = 右上
- 2 = 左上
- 3 = 左
- 4 = 左下
- 5 = 右下

![letters.png](https://qiita-image-store.s3.amazonaws.com/0/80588/6586361e-3747-3bc1-0571-74796a2949ea.png)

例えば、kから見てgは右上なので、$X[k,g] = 1$ と置きます。すると、このアルファベットの配置は、２３×２３の行列で表すことができます。ただし、隣合わせでない文字や自分自身との組合せには−１を入れます。

### 各パターンのプロトタイプを作成

例で与えられているように、`"glmq"`はパターンBに該当します。該当する文字の部分の配置行列を抜き出すと、

```r
   g  l  m  q
g -1  5 -1 -1
l  2 -1  0  5
m -1  3 -1  4
q -1  2  1 -1
```
これをBのプロトタイプとして保持しておきます。
他の各パターンについても、同様に行列のプロトタイプを作っておきます。

### 一致判定

以上の準備を元に、与えられた入力値に対して、保持しているプロトタイプに「一致」するかを１つ１つ検証していきます。ただし、「一致」とは、回転移動とインデックスの入れ替えによって全ての要素が等しくできることを指します（鏡像はNG）。
なお、回転移動は、非負のセルに1を足して`mod 6`をすることで表現できます。
インデックスの入れ替え方は、$4!=24$通りしかないので、全探索しています。

## 実装
```r
library(combiter)
check <- function(u, v)
{
  # check if matrix u can be converted to matrix v

  # first rotate u until the number sets are equal
  # then permute u until all numbers match
  for (j in 1:6)
  {
    if (all(sort(u) == sort(v))) {
      # permutate u until all numbers are equal
      ip <- iperm(4)
      while (hasNext(ip))
      {
        i <- nextElem(ip)
        if (all(u[i, i] == v)) return(TRUE)
      }
    }
    u[u>=0] <- (u[u>=0] + 1) %% 6
  }
  return(FALSE)
}

solve <- function(s, only_BDI = TRUE)
{
  # s is a four-length string
  # return one of BDIJLNOSYZ-
  x <- matrix(c(
    -1,0,-1,-1,-1,5,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,
    3,-1,0,-1,-1,4,5,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,
    -1,3,-1,0,-1,-1,4,5,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,
    -1,-1,3,-1,0,-1,-1,4,5,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,
    -1,-1,-1,3,-1,-1,-1,-1,4,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,
    2,1,-1,-1,-1,-1,0,-1,-1,4,5,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,
    -1,2,1,-1,-1,3,-1,0,-1,-1,4,5,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,
    -1,-1,2,1,-1,-1,3,-1,0,-1,-1,4,5,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,
    -1,-1,-1,2,1,-1,-1,3,-1,-1,-1,-1,4,5,-1,-1,-1,-1,-1,-1,-1,-1,-1,
    -1,-1,-1,-1,-1,1,-1,-1,-1,-1,0,-1,-1,-1,5,-1,-1,-1,-1,-1,-1,-1,-1,
    -1,-1,-1,-1,-1,2,1,-1,-1,3,-1,0,-1,-1,4,5,-1,-1,-1,-1,-1,-1,-1,
    -1,-1,-1,-1,-1,-1,2,1,-1,-1,3,-1,0,-1,-1,4,5,-1,-1,-1,-1,-1,-1,
    -1,-1,-1,-1,-1,-1,-1,2,1,-1,-1,3,-1,0,-1,-1,4,5,-1,-1,-1,-1,-1,
    -1,-1,-1,-1,-1,-1,-1,-1,2,-1,-1,-1,3,-1,-1,-1,-1,4,-1,-1,-1,-1,-1,
    -1,-1,-1,-1,-1,-1,-1,-1,-1,2,1,-1,-1,-1,-1,0,-1,-1,4,5,-1,-1,-1,
    -1,-1,-1,-1,-1,-1,-1,-1,-1,-1,2,1,-1,-1,3,-1,0,-1,-1,4,5,-1,-1,
    -1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,2,1,-1,-1,3,-1,0,-1,-1,4,5,-1,
    -1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,2,1,-1,-1,3,-1,-1,-1,-1,4,5,
    -1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,1,-1,-1,-1,-1,0,-1,-1,-1,
    -1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,2,1,-1,-1,3,-1,0,-1,-1,
    -1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,2,1,-1,-1,3,-1,0,-1,
    -1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,2,1,-1,-1,3,-1,0,
    -1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,2,-1,-1,-1,3,-1
  ), nrow=23, ncol=23)
  rownames(x) <- letters[1:23]
  colnames(x) <- letters[1:23]

  B <- x[c('g','l','m','q'), c('g','l','m','q')]
  D <- x[c('g','l','p','q'), c('g','l','p','q')]
  I <- x[c('a','b','c','d'), c('a','b','c','d')]
  J <- x[c('d','h','k','l'), c('d','h','k','l')]
  L <- x[c('g','l','q','r'), c('g','l','q','r')]
  N <- x[c('l','m','p','r'), c('l','m','p','r')]
  O <- x[c('h','l','m','q'), c('h','l','m','q')]
  S <- x[c('c','g','l','p'), c('c','g','l','p')]
  Y <- x[c('g','l','m','p'), c('g','l','m','p')]
  Z <- x[c('c','h','l','q'), c('c','h','l','q')]

  ind <- unlist(strsplit(s, ''))
  u <- x[ind, ind]
  if (check(u, B)) return('B')
  if (check(u, D)) return('D')
  if (check(u, I)) return('I')
  if (only_BDI) return('-')

  if (check(u, J)) return('J')
  if (check(u, L)) return('L')
  if (check(u, N)) return('N')
  if (check(u, O)) return('O')
  if (check(u, S)) return('S')
  if (check(u, Y)) return('Y')
  if (check(u, Z)) return('Z')
  return('-')
}


test_cases <- c("glmq", "fhoq", "lmpr", "glmp", "dhkl", "glpq", "hlmq", "eimq",
                "cglp", "chlq", "glqr", "cdef", "hijk", "kpqu", "hklm", "mqrw",
                "nrvw", "abfj", "abcf", "mrvw", "ptuv", "lmnr", "hklp", "himr",
                "dhil", "hlpt", "stuv", "bglq", "glmn", "fghm", "cdgk", "lpst",
                "imrw", "dinr", "cdin", "eghi", "cdeg", "bgko", "eimr", "jotu",
                "kotu", "lqtu", "cdim", "klot", "kloq", "kmpq", "qrvw", "mnqr",
                "kopt", "mnpq", "bfko", "chin", "hmnq", "nqrw", "bchi", "inrw",
                "cfgj", "jnpv", "flmp", "adpw", "eilr", "bejv", "enot", "fghq",
                "cjms", "elov", "chlm", "acop", "finr", "qstu", "abdq", "jkln",
                "fjkn", "ijmn", "flqr")
answers <- c("B", "-", "-", "-", "-", "D", "-", "I", "-", "-", "-", "-",
             "-", "B", "B", "B", "B", "B", "B", "D", "D", "D", "D", "D", "D",
             "I", "I", "I", "-", "-", "-", "-", "-", "-", "-", "-", "-", "-",
             "-", "-", "-", "-", "-", "-", "-", "-", "-", "-", "-", "-", "-",
             "-", "-", "-", "-", "-", "-", "-", "-", "-", "-", "-", "-", "-",
             "-", "-", "D", "-", "-", "-", "-", "-", "-", "-", "-")
correct <- 0
for (i in seq_along(test_cases))
{
  cat(sprintf('case %2d. ', i-1))
  s <- test_cases[i]
  result <- solve(s)
  answer <- answers[i]
  cat('result=', result, 'expected=', answer, ' ')
  if (result == answer) {
    cat('GOOD!\n')
    correct <- correct + 1
  } else {
    cat('BOOO!\n')
  }
}
cat(correct, '/', length(test_cases), 'correct!\n\n')



test_cases2 <- c("glmq", "fhoq", "lmpr", "glmp", "dhkl", "glpq", "hlmq", "eimq",
                 "cglp", "chlq", "glqr", "cdef", "hijk", "kpqu", "hklm", "mqrw",
                 "nrvw", "abfj", "abcf", "mrvw", "ptuv", "lmnr", "hklp", "himr",
                 "dhil", "hlpt", "stuv", "bglq", "glmn", "fghm", "cdgk", "lpst",
                 "imrw", "dinr", "cdin", "eghi", "cdeg", "bgko", "eimr", "jotu",
                 "kotu", "lqtu", "cdim", "klot", "kloq", "kmpq", "qrvw", "mnqr",
                 "kopt", "mnpq", "bfko", "chin", "hmnq", "nqrw", "bchi", "inrw",
                 "cfgj", "jnpv", "flmp", "adpw", "eilr", "bejv", "enot", "fghq",
                 "cjms", "elov", "chlm", "acop", "finr", "qstu", "abdq", "jkln",
                 "fjkn", "ijmn", "flqr")
answers2 <- c("B", "-", "N", "Y", "J", "D", "O", "I", "S", "Z", "L", "-",
              "-", "B", "B", "B", "B", "B", "B", "D", "D", "D", "D", "D", "D",
              "I", "I", "I", "J", "J", "J", "J", "J", "J", "L", "L", "L", "L",
              "L", "L", "N", "N", "N", "N", "N", "N", "O", "O", "O", "S", "S",
              "S", "Y", "Y", "Z", "Z", "Z", "-", "-", "-", "-", "-", "-", "-",
              "-", "-", "D", "-", "-", "L", "-", "-", "-", "-", "-")
correct <- 0
for (i in seq_along(test_cases2))
{
  cat(sprintf('case %2d. ', i-1))
  s <- test_cases2[i]
  result <- solve(s, only_BDI=FALSE)
  answer <- answers2[i]
  cat('result=', result, 'expected=', answer, ' ')
  if (result == answer) {
    cat('GOOD!\n')
    correct <- correct + 1
  } else {
    cat('BOOO!\n')
  }
}
cat(correct, '/', length(test_cases2), 'correct!\n\n')
```