monads and knightmoves

Author: xtangle

haskell/playground/monads/knightmoves/knightmoves.hs

@@ -0,0 +1,41 @@
+import           Control.Monad (guard)
+import           Data.List     (last)
+
+type KnightPos = (Int, Int)
+
+moveKnight :: KnightPos -> [KnightPos]
+moveKnight (c, r) = do
+    (c', r') <-
+        [ (c + 2, r - 1)
+        , (c + 2, r + 1)
+        , (c - 2, r - 1)
+        , (c - 2, r + 1)
+        , (c + 1, r - 2)
+        , (c + 1, r + 2)
+        , (c - 1, r - 2)
+        , (c - 1, r + 2)
+        ]
+    guard (c' `elem` [1 .. 8] && r' `elem` [1 .. 8])
+    return (c', r')
+
+paths :: KnightPos -> [[KnightPos]]
+paths start =
+    let addMoves :: [KnightPos] -> [[KnightPos]]
+        addMoves ls@(x:_) = (: ls) <$> moveKnight x
+        pathsFrom :: [[KnightPos]] -> [[KnightPos]]
+        pathsFrom paths = paths ++ pathsFrom (paths >>= addMoves)
+     in map reverse $ pathsFrom (addMoves [start])
+
+pathsIn :: KnightPos -> Int -> [[KnightPos]]
+pathsIn start n =
+    let paths' = paths start
+        bounded = takeWhile ((<= n + 1) . length)
+     in bounded paths'
+
+pathsTo :: KnightPos -> KnightPos -> [[KnightPos]]
+pathsTo start end =
+    let ended = filter ((== end) . last)
+     in ended $ paths start
+
+minMovesTo :: KnightPos -> KnightPos -> Int
+minMovesTo start end = subtract 1 . length . head $ pathsTo start end

haskell/playground/monads/monads/monads.hs

@@ -0,0 +1,49 @@
+import           Control.Monad
+
+-- Monad laws
+-- 1. left identity:  return x >>= f   =  f x
+-- 2. right identity: m >>= return     =  m
+-- 3. associativity:  (m >>= f) >>= g  =  m >>= (\x -> f x >>= g)
+h =
+    let f x = [x, -x]
+        g x = [x * 3, x * 2]
+     in f <=< g
+
+type Birds = Int
+
+type Pole = (Birds, Birds)
+
+landLeft :: Birds -> Pole -> Maybe Pole
+landLeft n (left, right)
+    | abs ((left + n) - right) < 4 = Just (left + n, right)
+    | otherwise = Nothing
+
+landRight :: Birds -> Pole -> Maybe Pole
+landRight n (left, right)
+    | abs (left - (right + n)) < 4 = Just (left, right + n)
+    | otherwise = Nothing
+
+-- try:
+-- return (0, 0) >>= landLeft 1 >>= landRight 4 >>= landRight (-2)
+-- return (0, 0) >>= landLeft 1 >>= landRight 4 >>= landLeft (-1) >>= landRight (-2)
+banana :: Pole -> Maybe Pole
+banana _ = Nothing
+
+routine :: Maybe Pole
+routine = do
+    let start = (0, 0)
+    first <- landLeft 2 start
+    second <- landRight 2 first
+    landLeft 1 second
+
+-- or:
+-- return (0, 0) >>= landLeft 2 >>= landRight 2 >>= landLeft 1
+routine' :: Maybe Pole
+routine' = do
+    let start = (0, 0)
+    first <- landLeft 2 start
+    Nothing
+    second <- landRight 2 first
+    landLeft 1 second
+-- or:
+-- return (0, 0) >>= landLeft 2 >>= landRight 2 >> Nothing >>= landLeft 1

haskell/playground/playground.cabal

@@ -8,6 +8,7 @@ maintainer:     example@example.com
 copyright:      2019 Author name here
 license:        BSD3
 license-file:   LICENSE
+cabal-version:  >= 1.2
 build-type:     Simple
 extra-source-files:
     README.md