LoginSignup
0
0

More than 5 years have passed since last update.

@kota9(Kota Mori)

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

Last updated at Posted at 2017-04-19

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

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

考え方

文字の配置を行列で表現

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

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

letters.png

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

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

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

   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$通りしかないので、全探索しています。

実装

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')
0
0
0

Register as a new user and use Qiita more conveniently

  1. You get articles that match your needs
  2. You can efficiently read back useful information
  3. You can use dark theme
What you can do with signing up
Sign upLogin
0
0