SearchSpec.hs

module Algorithm.SearchSpec (
  main,
  spec
  ) where

import Test.Hspec
import Algorithm.Search
import qualified Data.Map as Map
import Data.Maybe (fromJust)

main :: IO ()
main = hspec spec

-- | Example cyclic directed unweighted graph
cyclicUnweightedGraph :: Map.Map Int [Int]
cyclicUnweightedGraph = Map.fromList [
  (0, [1, 2, 3]),
  (1, [4, 6]),
  (2, [0, 1, 6, 8]),
  (3, [1, 2]),
  (4, [0]),
  (5, [4]),
  (6, [4]),
  (8, [0, 5])
  ]

-- | Example acyclic directed unweighted graph
acyclicUnweightedGraph :: Map.Map Int [Int]
acyclicUnweightedGraph = Map.fromList [
  (0, [1, 2, 3]),
  (1, [4]),
  (2, [5]),
  (3, [2]),
  (4, []),
  (5, [])
  ]

-- | Example cyclic directed weighted graph
cyclicWeightedGraph :: Map.Map Char [(Char, Int)]
cyclicWeightedGraph = Map.fromList [
  ('a', [('b', 1), ('c', 2)]),
  ('b', [('a', 1), ('c', 2), ('d', 5)]),
  ('c', [('a', 1), ('d', 2)]),
  ('d', [])
  ]

-- | Example for taxicab path finding
taxicabNeighbors :: (Int, Int) -> [(Int, Int)]
taxicabNeighbors (x, y) = [(x, y + 1), (x - 1, y), (x + 1, y), (x, y - 1)]

isWall :: (Int, Int) -> Bool
isWall(x,y)=x==1&&(-2)<=y&&y<=1

taxicabDistance :: (Int, Int) -> (Int, Int) -> Int
taxicabDistance (x1, y1) (x2, y2) = abs (x2 - x1) + abs (y2 - y1)

spec :: Spec
spec = do
  describe "bfs" $ do
    let next = (cyclicUnweightedGraph Map.!)
    it "performs breadth-first search" $
      bfs next (== 4) 0 `shouldBe` Just [1, 4]
    it "handles pruning" $
      bfs (next `pruning` odd) (== 4) 0 `shouldBe` Just [2, 6, 4]
    it "returns Nothing when no path is possible" $
      bfs (next `pruning` odd `pruning` (== 6)) (== 4) 0 `shouldBe` Nothing
  describe "dfs" $ do
    let next = (cyclicUnweightedGraph Map.!)
    it "performs depth-first search" $
      dfs next (== 4) 0 `shouldBe` Just [3, 2, 8, 5, 4]
    it "handles pruning" $
      dfs (next `pruning` odd) (== 4) 0 `shouldBe` Just [2, 6, 4]
    it "returns Nothing when no path is possible" $
      dfs (next `pruning` odd `pruning` (== 6)) (== 4) 0 `shouldBe` Nothing
    it "handles doubly-inserted nodes" $
      dfs (acyclicUnweightedGraph Map.!) (==4) 0 `shouldBe` Just [1, 4]
  describe "dijkstra" $ do
    let next = map fst . (cyclicWeightedGraph Map.!)
        cost a b = fromJust . lookup b $ cyclicWeightedGraph Map.! a
    it "performs dijkstra's algorithm" $
      dijkstra next cost (== 'd') 'a'
        `shouldBe` Just (4, ['c', 'd'])
    it "handles pruning" $
      dijkstra (next `pruning` (== 'c')) cost (== 'd') 'a'
        `shouldBe` Just (6, ['b', 'd'])
    it "returns Nothing when no path is possible" $
      dijkstra (next `pruning` (== 'b') `pruning` (== 'c')) cost (== 'd') 'a'
        `shouldBe` Nothing
    it "handles zero-length solutions" $
      dijkstra next cost (== 'd') 'd' `shouldBe` Just (0, [])
  describe "aStar" $ do
    let start = (0, 0)
        end = (2, 0)
    it "performs the A* algorithm" $
      aStar taxicabNeighbors taxicabDistance (taxicabDistance end) (== end)
        start
        `shouldBe` Just (2, [(1, 0), (2, 0)])
    it "handles pruning" $
      aStar (taxicabNeighbors `pruning` isWall) taxicabDistance
        (taxicabDistance end) (== end) start
        `shouldBe` Just (6, [(0, 1), (0, 2), (1, 2), (2, 2), (2, 1), (2, 0)])
    it "returns Nothing when no path is possible" $
      aStar
        (taxicabNeighbors
          `pruning` isWall
          `pruning` (\ p -> taxicabDistance p (0,0) > 1)
        )
        taxicabDistance
        (taxicabDistance end)
        (== end)
        start
        `shouldBe` Nothing
    it "handles zero-length solutions" $
      aStar taxicabNeighbors taxicabDistance (taxicabDistance end) (== start)
        start
        `shouldBe` Just (0, [])
  describe "incrementalCosts" $ do
    let cost a b = fromJust . lookup b $ cyclicWeightedGraph Map.! a
    it "gives the incremental costs along a path" $
      incrementalCosts cost ['a', 'b', 'd'] `shouldBe` [1, 5]
    it "handles zero-length paths" $ do
      incrementalCosts cost [] `shouldBe` []
      incrementalCosts cost ['a'] `shouldBe` []