Sakktábla lefedése dominókkal

Fejtörő

Fedjük le a sakktáblát dominókkal úgy, hogy a dominók ne fedjék egymást, és két átellenes sarok kimaradjon!

Akkora dominókat használunk, mint két sakktábla-mező.

Segítség

Gondoljunk a sakktábla mezők színeire!

Megoldás

A lefedés nem lehetséges.

További feladat

Le lehet-e fedni az n*m-es sakktáblát dominókkal úgy, hogy a dominók ne fedjék egymást, és két tetszőlegesen választott mező kimaradjon?

Megoldás (1)

Ha n és m páratlan, akkor a lefedés nem lehetséges.

Megoldás (2)

Ha a két kihagyott mező azonos színű, a lefedés nem lehetséges.

Megoldás (3)

Ha n*m páros, és ha két különböző mezőt hagyunk ki, akkor a lefedés lehetséges.

Konstruktív bizonyítás: Írunk egy programot, amely adott n, m és két különböző színű mező esetén garantáltan megkonstruálja a megoldást.

Nem használhatunk visszalépéses módszert, mivel az nem garantálja a megoldást!

Példa

A 7*8-as sakktáblát lefedjük úgy, hogy kihagyjuk a (2,2) és a (6,7) mezőket:

*Main> solve 7 8 (P 2 2) (P 6 7)

[==][==][==]\/
\/[==][==]  /\
/\[==][==][==]
\/[==][==][==]
/\[==][==][==]
\/[==][==][==]
/\  [==][==]\/
[==][==][==]/\

Másik példa

*Main> solve 4 4 (P 2 2) (P 3 4)

[==]  \/
\/[==]/\
/\  [==]
[==][==]

Segédfüggvények

Segédfüggvény: every

Definiáljuk az every függvényt, amely veszi egy lista minden n-edik elemét.

every :: Int -> [a] -> [a]

Test>
True :: Bool
Test>
True :: Bool

Segédfüggvény: pairs

Definiáljuk a pairs függvényt, amely elkészíti az egymás melletti elemek listáját.

pairs :: [a] -> [(a,a)]

Test>
True :: Bool

Segédfüggvény: rotateTo

Definiáljuk a rotateTo függvényt, ami egy listát egy elem első fordulásánál kettévág, majd a két listát fordított sorrendben fűzi újra össze.

rotateTo :: Eq a => a -> [a] -> [a]

Test>
True :: Bool
Test>
True :: Bool

Sakktábla mezők

A sakktábla egy mezőjét jelölje a következő adatszerkezet:

data Pos 
    = P Int Int  
        deriving (Eq, Ord, Show, Data, Typeable)

Példák:

Koordináták

Hasznosak a következő függvények:

xcord, ycord :: Pos -> Int
xcord (P x y) = x
ycord (P x y) = y

Megjelenítés

A következő függvény sakktáblamezőkhöz rendelt szövegeket jelenít meg:

showCells :: [(Pos, String)] -> String
showCells cells = unlines [ showRow j | j<-[maxY,maxY-1..1] ]  where

  showRow :: Int -> String
  showRow j = concat [ align (showCell (P i j)) | i<-[1..maxX] ]

  align :: String -> String
  align l = take maxWidth (l ++ repeat ' ')

  showCell :: Pos -> String
  showCell p = case filter ((== p) . fst) cells of
        []            -> ""
        (_,c):_     -> c

  maxX     = maximum $ map (xcord  . fst) cells
  maxY     = maximum $ map (ycord  . fst) cells
  maxWidth = maximum $ map (length . snd) cells

Példa

Beírjuk:

*Main> putStr $ showCells 
    [(P 3 2, "!"), (P 1 1, "Hello"), (P 2 3, "World")]

Eredmény:

     World     
          !    
Hello          
Test>
" World \n ! \nHello \n" :: String

Dominók

Egy dominó állhat vízszintesen és függőlegesen. Mindkét esetben eltároljuk a két pozíció közül a minimálisat, amin a dominó elhelyezkedik.

data Domino
    = Horiz Pos 
    | Vert  Pos 
        deriving (Eq, Show, Data, Typeable)

Dominók kirajzolása

Dominókat kirajzoló függvény:

showDominos :: [Domino] -> String
showDominos = showCells . concat . map decompose  where

    decompose :: Domino -> [(Pos, String)]
    decompose (Horiz (P i j)) = [(P i j,"[="),  (P (i+1) j,"=]")]
    decompose (Vert  (P i j)) = [(P i j,"/\\"), (P i (j+1),"\\/")]

Példa

Beírjuk:

*Main> putStr $ showDominos 
    [Vert (P 3 1),Horiz (P 1 1),Vert (P 1 2),Horiz (P 2 3)]

Eredmény:

\/[==]
/\  \/
[==]/\
Test>
"\/[==]\n/\ \/\n[==]/\\n" :: String

Dominók létrehozása

Definiáljuk a következő függvényt:

compose :: Pos -> Pos -> Domino

Test>
True :: Bool
Test>
True :: Bool

compose két egymás melletti pozícióból egy dominót készít.

Körkészítés

Definiáljuk makeCycle-t, ami egy n*m-es sakktábla összes mezőjét felsorolja úgy, hogy az egymás után felsorolt mezők a sakktáblán egymás mellett vannak, és a felsorolásbeli első és utolsó mező is egymás mellett van a sakktáblán (sok megoldás lehetséges). A makeCycle két paramétere n és m.

makeCycle :: Int -> Int -> [Pos]

Test>
[P 1 1, P 1 2, P 1 3, P 1 4, P 2 4, P 3 4, P 4 4, P 4 3, P 3 3, P 2 3, P 2 2, P 3 2, P 4 2, P 4 1, P 3 1, P 2 1] :: [Pos]

Főprogram

solve' :: Int -> Int -> Pos -> Pos -> [Domino]

Test>
[Horiz (P 3 2), Horiz (P 3 1), Horiz (P 1 1), Vert (P 1 2), Horiz (P 1 4), Vert (P 4 3), Horiz (P 2 3)] :: [Domino]

Példa:

A solve' 3 4 (P 2 2) (P 3 4) kiszámolása:

--     -- kör a 3*4-es táblán    
-- [P 1 1,P 1 2,P 1 3,P 1 4,P 2 4,P 3 4,P 3 3,P 2 3,P 2 2,P 3 2,P 3 1,P 2 1]
--     -- elforgatás
-- [P 2 2,P 3 2,P 3 1,P 2 1,P 1 1,P 1 2,P 1 3,P 1 4,P 2 4,P 3 4,P 3 3,P 2 3]
--     -- a két lyuk kivétele
-- [P 3 2,P 3 1,P 2 1,P 1 1,P 1 2,P 1 3,P 1 4,P 2 4,P 3 3,P 2 3]
--     -- párosítás
-- [(P 3 2,P 3 1),(P 2 1,P 1 1),(P 1 2,P 1 3),(P 1 4,P 2 4),(P 3 3,P 2 3)]
--     -- dominók
-- [Vert (P 3 1),Horiz (P 1 1),Vert (P 1 2),Horiz (P 1 4),Horiz (P 2 3)]

Az eredeti feladat megoldása

Írjuk bele solve definíciójába a lehetetlen esetek kezelését!

solve :: Int -> Int -> Pos -> Pos -> IO ()
solve n m (P x y) (P x' y')
    | odd (n*m) || even (x+y+x'+y') = putStrLn "No solution."
solve n m a b = putStr $ showDominos $ solve' n m a b