8

More than 5 years have passed since last update.

# さっそくGTAでDPの練習

Posted at

チェスのナイトが盤面の端から端まで特定の手数で移動する経路をすべて求める。
typelevel-tensor と numeric-prelude も必要。

Knight.hs
``````#!/usr/bin/env runhaskell
{-# LANGUAGE NoImplicitPrelude, RecordWildCards #-}
{-# OPTIONS -Wall #-}
module Main where
import Data.Maybe
import Data.Tensor.TypeLevel
import GTA.Data.JoinList
import GTA.Core hiding (items)
import NumericPrelude

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) <.> 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

fromTo :: Eq a => a -> a -> (a1 -> a1, JoinListAlgebra (a, Int) Bool)
fromTo start goal = id <.> joken where
joken = JoinListAlgebra{..}
c1 `times` c2 = c1 && c2
single (r,n)
| n == 1       = start == r
| n == maxStep = goal  == r
| otherwise    = True
nil = True

main :: IO ()
main = do
putStr \$ pprint2\$ assigns [Vec :~ x :~ y| x<- [1..bdSize], y<-[1..bdSize]] [1..maxStep]
`filterBy` knightSeq2
`filterBy` fromTo (Vec :~ 1 :~ 1)  (Vec :~ bdSize :~ bdSize)
`aggregateBy` result
return ()

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

``````

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
What you can do with signing up
8