ドットを接続できますか？

この課題は、Flow Freeに基づいています。オンライン版はここで見つけることができます：http：//www.moh97.us/

パズルが渡されます。1パズルが解ける0場合、または解けない場合は戻らなければなりません。

パズルを解くには、プレーヤーは空の四角を1回だけ使用して、数字の各ペアを接続するパスを作成する必要があります。

正方形の寸法で渡され、次に各ドットのx、y、c（cは色を表す数字）に渡されます。例えば：

あなた5,5 0,0,0 3,0,1 1,1,2 1,2,2 4,2,1 4,4,0に渡された場合、それは以下を表します：

0..1.
.2...
.2..1
....0

そして、1を返します。

5,2 2,0,1 0,1,2 4,1,2 を表します：

..1..
2...2

が1つしかないため、解けません1。

4,2 0,0,0 3,0,0 0,1,0 3,1,0 を表します：

0..0
0..0

また、2 0秒以上含まれるため、解けません。

8,6 0,0,1 7,5,1 を表します：

1.......
........
........
........
........
.......1

そして、あなたはすべての正方形を使用することはできないので、解決できません。

2,5 0,0,1 2,0,6 4,0,6 0,1,4 3,1,4 4,1,1 を表します：

1.6.6
4..41

1を接続できないため、解決できません。

6,3 1,0,4 5,0,1 0,1,4 1,1,3 5,1,3 0,2,2 3,2,2 5,2,1 を表します：

.4...1
43...3
2..2.1

2つのパスは必ず交差する必要があるため、1（または3）を接続できないため、解決できません。

5,2 0,0,1 3,0,1 0,1,3 4,1,1 を表します：

1..1.
3...3

パスを作成する際にすべての正方形を使用することはできないため、解決できません。

2,2 0,0,0 1,1,0 を表します：

1.
.1

ここでもすべての正方形を使用できないため、解けません

以下にいくつかのテストを示します。

5,5 0,3,0 0,4,1 1,2,2 1,3,1 2,0,0 3,0,4 3,1,2 3,3,5 3,4,4 4,4,5 1を返す必要があります

13,13 1,1,0 9,1,1 10,1,2 11,1,3 1,2,4 2,2,5 5,2,6 7,2,7 3,3,0 5,4,6 6,4,1 9,6,3 4,7,8 5,8,9 12,8,8 11,9,10 2,10,4 4,10,2 9,10,5 11,10,7 1,11,9 12,12,10 1を返す必要があります

7,7 0,0,0 0,1,1 1,1,2 2,1,3 4,2,4 0,3,1 5,3,3 0,4,4 2,4,5 5,4,2 0,5,0 1,5,5 3,5,6 3,7,6 0を返す必要があります

ハスケル

import Data.List.Split
import qualified Data.Sequence as Q
import Data.List
import Control.Monad

data A a = S a | E a | P a | X deriving Eq

sc = foldr1 (Q.><)
sp b x y p = Q.update y (Q.update x p $ b `Q.index` y) b
dt b c | S c `elem` sc b = E c
       | otherwise = S c
ad b [x, y, c] = sp b x y (dt b c)

ep b [x, y, c] = do
  let nps = filter ob [(x+1, y), (x-1, y), (x, y+1), (x, y-1)]
      ns = map gp nps
  [b | E c `elem` ns] ++ do
    (x', y') <- filter ((== X) . gp) nps
    ep (sp b x' y' (P c)) [x', y', c]
  where ob (u, v) = 0 <= u && u < length (b `Q.index` 0) && 0 <= v && v < length b
        gp (u, v) = b `Q.index` v `Q.index` u

rd i = let [c, r] : ps = (map read . splitOn ",") <$> words i :: [[Int]]
           e = Q.replicate r $ Q.replicate c X
           cs = map last ps
           ss = nubBy (\[_,_,c1] [_,_,c2] -> c1 == c2) ps
           b = foldl ad e ps
           bs = foldM ep b ss
       in if even (length cs) && length ss == length cs `div` 2 &&
             (all (\[j,k] -> j==k) . chunksOf 2 . sort $ cs) &&
             any (null . Q.elemIndicesL X . sc) bs
           then 1
           else 0

main = rd <$> getContents >>= print

キー

• sc：Seq concat
• sp：設定位置
• dt：ドットタイプ（つまり、行の開始または終了）
• 広告：ドットを追加
• ep：パスを延長
• rd：ドットの実行（プライマリピュアアルゴリズム）