Noktaları birleştirebilir misin?

Bu zorluk Flow Free'den kaynaklanmaktadır. Çevrimiçi bir sürümü burada bulabilirsiniz: http://www.moh97.us/

Size bir bulmaca verilecek 1ve bulmacanın çözülebilir olması veya dönmemesi durumunda geri dönmelisiniz 0.

Bir bulmacayı çözmek için oyuncu, her boş kareyi tam olarak bir kez kullanarak her bir sayı çiftini bağlamak için bir yol oluşturmalıdır.

Karenin boyutlarında ve ardından her noktanın x, y, c (burada c, rengi temsil eden bir sayıdır) olarak geçirilirsiniz. Örneğin:

Eğer 5,5 0,0,0 3,0,1 1,1,2 1,2,2 4,2,1 4,4,0size geçirildi, bu temsil edecek:

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

Ve dönmelidir 1.

5,2 2,0,1 0,1,2 4,1,2 temsil eder:

..1..
2...2

ve çözülemez çünkü sadece 1 tane var 1.

4,2 0,0,0 3,0,0 0,1,0 3,1,0 temsil eder:

0..0
0..0

ve çözülemez çünkü 2 0saniyeden fazla içerir .

8,6 0,0,1 7,5,1 temsil eder:

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

ve çözülemez (her kareyi kullanamayacağınız için).

2,5 0,0,1 2,0,6 4,0,6 0,1,4 3,1,4 4,1,1 temsil eder:

1.6.6
4..41

ve çözülemez çünkü 1'leri bağlayamazsınız.

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 temsil eder:

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

ve çözülemez çünkü iki yol mutlaka kesişmek zorunda olduğu için 1'leri (veya 3'leri) bağlayamazsınız.

5,2 0,0,1 3,0,1 0,1,3 4,1,1 temsil eder:

1..1.
3...3

ve çözülemez çünkü bir yol oluştururken tüm kareleri kullanamazsınız.

2,2 0,0,0 1,1,0 temsil eder:

1.
.1

ve çözülemez çünkü burada tüm kareleri kullanamazsınız

İşte bazı testler:

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 dönmeli 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 dönmeli 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 döndürmeli

Haskell

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

anahtar

• sc: Sıralı concat
• sp: ayarlanan konum
• dt: nokta türü (ör. satır başı veya sonu)
• reklam: nokta ekle
• ep: yolu genişlet
• rd: çalıştırma noktaları (birincil saf algoritma)