Edge_test.hs

module Edge_test
where

import           Edge
import           System.IO
import           Test.HUnit
import           Test.HUnit.Tools


answers :: [ Bool ]
answers = [
    False, False,
    True,  True,  True,  True,  True,  False, -- 'A' -> [ 'A' .. 'F' ]
    True,  True,  True,  True,  True,  False, -- 'B'
    True,  True,  True,  True,  True,  False, -- 'C'
    False, False, False, False, True,  False, -- 'D'
    False, False, False, False, False, False, -- 'E'
    False, False, False, True,  True,  False  -- 'F'
  ]

pathEndPoints :: [ (Char, Char) ]
pathEndPoints = [ ('X', 'Y') ] ++ [ ('a', 'b') ] ++
                [ (start, end) | start <- vertices, end <- vertices ]

testData :: [ (Bool, (Char, Char)) ]
testData = zip answers pathEndPoints

testFromData :: (Bool, (Char, Char)) -> Test
testFromData (result, (start, end)) = ("Path from " ++ [start] ++ " to " ++ [end]) ~: result ~=? connected start end limit

allTests :: Test
allTests = test (map testFromData testData)

testNormal :: IO Counts
testNormal = runTestTT allTests

testVerbose :: IO (Counts, Int)
testVerbose = runVerboseTests allTests

testVerbose2 :: IO (Counts, Int)
testVerbose2 = runVerbTestText (putTextToHandle stderr True) allTests

main :: IO ()
main = do
         testNormal
         return ()

Edges.hs

module Edge
where
{-
Imagine the graph below.

         B
        ^ \
       /   \
      /     V
    A <----- C
    |        |
    |        |
    V        V
    D -----> E
    ^       ^
     \     /
      \   /
        F
-}

vertices :: [ Char ]
vertices = [ 'A' .. 'F' ]

edge :: Char -> Char -> Bool
edge 'A' 'B' = True
edge 'A' 'D' = True
edge 'B' 'C' = True
edge 'C' 'A' = True
edge 'C' 'E' = True
edge 'D' 'E' = True
edge 'F' 'D' = True
edge 'F' 'E' = True
edge  _   _  = False

limit :: Int
limit = 6

type Path = [ Char ]

-- list of paths of length k = 1
pathsOfK1 :: [ Path ]
pathsOfK1 = [ [ c ] | c <- vertices ]

-- extend a path with an additioonal vertex that can be reached
extendPath :: Path -> [ Path ]
extendPath [] = pathsOfK1
--extendPath p  = [ c : p | c <- [ 'A' .. 'F' ], edge (last p) c ] -- is equivalent to line below
extendPath p  = [ p ++ [ c ] | c <- vertices, edge (last p) c ]

extendAll :: [ Path ] -> [ Path ]
extendAll [] = pathsOfK1
--extendAll l  = concat [ extendPath p | p <- l ] -- is equivalent to line below
extendAll l  = [ ll | p <- l, ll <- extendPath p ]

allPaths :: [[ Path ]]
allPaths = iterate extendAll [ [] ]

-- we are not interested in paths of length 0 ( [""]) or length 1 (["A","B","C","D","E","F"])
-- therefore we drop the first two elements from allPaths
-- take the next 5 item, for k = 2, 3, 4, 5, 6
pathsOfK2To6 :: [[ Path ]]
pathsOfK2To6 = (take 5 . drop 2) allPaths

-- build up a list of path end-points
connectedPairs :: Int -> [ (Char, Char) ]
connectedPairs lim = [ (head p, last p) | l <- pathsOfK2To6, p <- l ]

-- chek if path starting with x and ending in y was identified as a 'connected pair' above
-- both x and y are members of [ 'A' .. 'F' ]
connected :: Char -> Char -> Int -> Bool
connected x y n = elem (x, y) $ connectedPairs n

Read about the specifics at https://onlinecourses.nptel.ac.in/noc15_cs13/forum?place=msg%2Fnoc15-cs13-discuss%2F8f2WvXWPFns%2FAELKHCOjBgAJ.