# GTALib / examples / Knight.hs

 ``` 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110``` ```#!/usr/bin/env runhaskell {-# LANGUAGE NoImplicitPrelude, RecordWildCards, FlexibleInstances, TypeSynonymInstances #-} {-# OPTIONS -Wall #-} {- Example GTA program to solve Knight's move problem: Find a way to move a knight from a corner of a board to the opposite corner. The original code is Knight.hs (http://qiita.com/items/a372458d171e373285b1) by @nushio . -} module Main where import Data.Maybe import Data.Tensor.TypeLevel import GTA.Data.JoinList import GTA.Core hiding (items) import NumericPrelude import Test.QuickCheck knightMoves :: [Vec2 Int] knightMoves = [Vec :~ x :~ y | x <- [-2..2], y<-[-2..2], x^2 + y^2 == 5] canMoveTo :: Vec2 Int -> Vec2 Int -> Bool canMoveTo a b = (a - b) `elem` knightMoves bdSize :: Int bdSize = 8 maxStep :: Int maxStep = 7 knightSeq' :: JoinList (Vec2 Int) -> Bool knightSeq' = isJust . ws where ws Nil = Just Nothing ws (Single r) = Just \$ Just (r,r) ws (x1 `Times` x2) = do a1 <- ws x1 a2 <- ws x2 case (a1, a2) of (Nothing, _) -> return a2 (_, Nothing) -> return a1 (Just (r0,r1),Just (r2,r3)) | canMoveTo r1 r2 -> return \$ Just (r0,r3) | otherwise -> Nothing knightSeq :: (Maybe a -> Bool, JoinListAlgebra (Vec2 Int) (Maybe (Maybe (Vec2 Int, Vec2 Int)))) knightSeq = (isJust) <.> ws where ws = JoinListAlgebra{..} where nil = Just Nothing single r = Just \$ Just (r,r) x1 `times` x2 = do a1 <- x1 a2 <- x2 case (a1, a2) of (Nothing, _) -> return a2 (_, Nothing) -> return a1 (Just (r0,r1),Just (r2,r3)) | canMoveTo r1 r2 -> return \$ Just (r0,r3) | otherwise -> Nothing knightSeq2 :: (Maybe a -> Bool, JoinListAlgebra (Vec2 Int, t) (Maybe (Maybe (Vec2 Int, Vec2 Int)))) knightSeq2 = (isJust) <.> knightSeq2Hom knightSeq2Hom :: JoinListAlgebra (Vec2 Int, t) (Maybe (Maybe (Vec2 Int, Vec2 Int))) knightSeq2Hom = JoinListAlgebra{..} where nil = Just Nothing single (r,_) = Just \$ Just (r,r) x1 `times` x2 = do a1 <- x1 a2 <- x2 case (a1, a2) of (Nothing, _) -> return a2 (_, Nothing) -> return a1 (Just (r0,r1),Just (r2,r3)) | canMoveTo r1 r2 -> return \$ Just (r0,r3) | otherwise -> Nothing instance Arbitrary (Vec2 Int) where arbitrary = oneof [return \$ Vec :~ x :~ y | x<- [1..bdSize], y<-[1..bdSize]] -- check of the associativity and the identity check_knightSeq2 :: IO () check_knightSeq2 = (quickCheck \$ prop_Associativity knightSeq2Hom) >> (quickCheck \$ prop_Identity knightSeq2Hom) main :: IO () main = do putStr \$ pprint2\$ assignsBy genSigns [1..maxStep] `filterBy` knightSeq2 `aggregateBy` result return () where genSigns n | n == 1 = [(Vec :~ 1 :~ 1)] | n == maxStep = [(Vec :~ bdSize :~ bdSize)] | otherwise = [Vec :~ x :~ y| x<- [1..bdSize], y<-[1..bdSize]] pprint :: Bag (JoinList (Vec2 Int)) -> String pprint (Bag xs) = unlines \$ map (unwords . map (\ (Vec :~ x :~ y) -> show x ++ "," ++ show y) . dejoinize) xs pprint2:: Bag (JoinList (Vec2 Int,Int)) -> String pprint2(Bag xs) = unlines \$ map (unwords . map (\ ((Vec :~ x :~ y),_) -> show x ++ "," ++ show y) . dejoinize) xs ```