-- Data types

-------------

data Edge = Ed String Double

data Vertex = Vt String Double Double [Edge]

data Path = Pt [String] Double

data Vertexa = Vtx Vertex Path Bool

data Nodelist = Nls [Vertex]

data Mainlist = Mls [Vertexa] Bool

-- Graph definitions

--------------------

graph1 = (Nls [

                (Vt "A" 0 0 [(Ed "B" 2), (Ed "C" 4)]),

                (Vt "B" 1 1 [(Ed "A" 2), (Ed "C" 2), (Ed "D" 3)]),

                (Vt "C" 2 2 [(Ed "A" 4), (Ed "B" 2), (Ed "D" 2)]),

                (Vt "D" 1 3 [(Ed "B" 3), (Ed "C" 2)]),

                (Vt "E" 0 0 [])

                ])

-- Main function

----------------

-- Returns a path

astar :: Nodelist -> String -> String -> Double -> [String]

astar (Nls nodes) start _ _ | (null(filter (samename start) nodes))  = ["Wrong start vertex!"]

astar (Nls nodes) _ goal _ | (null(filter (samename goal) nodes)) = ["Wrong goal vertex!"]

astar (Nls nodes) start goal maxcost = reverse (printpath (expansionblock (Nls nodes)

                (Mls [(Vtx (getvert nodes start) (Pt [start] 0) False)] True) (Vtx (getvert nodes goal) (Pt [] 0) False) maxcost) (getvert nodes goal))

-- Print functions

------------------

-- Turns a list into a path of vertices as a string

printvertlist :: [Vertexa] -> [String]

printvertlist [] = []

printvertlist (v:vs) = (printvert v : printvertlist vs)

-- Prints a vertex name (ToString())

printvert :: Vertexa -> String

printvert (Vtx (Vt n _ _ _) _ _) = n

-- Prints a path

printpath :: Mainlist -> Vertex -> [String]

printpath m goal | notreached (Vtx goal (Pt [] 0) False) m = ["No path available!"]

printpath (Mls vs _) goal = getpath (getverta vs (printvert (Vtx goal (Pt [] 0) False)))

getpath :: Vertexa -> [String]

getpath (Vtx _ (Pt p _) _) = p

-- Block function

-----------------

-- Block for expanding nodes, verifies against matches and updates as needed

expansionblock :: Nodelist -> Mainlist -> Vertexa -> Double -> Mainlist

expansionblock (Nls nodes) (Mls open changed) goal cost =

                let minv = (getminvert open goal cost)

                in if (isworthexpanding minv goal cost) && changed

                                then (expansionblock (Nls nodes) (addexpanded (Mls (markexpanded open minv) False) (expandall nodes minv)) goal (getnewcost open (printvert goal) cost))

                                else (Mls open False)

-- Main list related functions

------------------------------

-- Returns a vertex by its name

getvert :: [Vertex] -> String -> Vertex

getvert ((Vt name x y e) : vs) name1 | name1 == name = (Vt name x y e)

getvert (_ : vs) name = getvert vs name

getverta :: [Vertexa] -> String -> Vertexa

getverta (v : vs) name | (printvert v) == name = v

getverta (_ : vs) name = getverta vs name

-- Removes a vertex by its name, returns a new list

remvert :: [Vertexa] -> String -> [Vertexa]

remvert vx s = filter (diffnamea s) vx

-- Returns a vertex with minimal g + h

getminvert :: [Vertexa] -> Vertexa -> Double -> Vertexa

getminvert (v:vs) ve vx | not(notexpanded v) = getminvert vs ve vx

getminvert (v:vs) ve vx = foldl (\acc cur -> if (totalcost cur ve) < (totalcost acc ve) && (notexpanded cur)

then cur else acc) v vs

-- Expand nodes, returns a list of new nodes

expandall :: [Vertex] -> Vertexa -> [Vertexa]

expandall vs (Vtx (Vt a b c e) p r) = map (expandone vs (Vtx (Vt a b c e) p r)) e

expandone :: [Vertex] -> Vertexa -> Edge -> Vertexa

expandone vs (Vtx _ (Pt p x) _) (Ed n c) = (Vtx (getvert vs n) (Pt (n:p) (c + x)) False)

-- Udates list, setting present node to expanded

markexpanded :: [Vertexa] -> Vertexa -> [Vertexa]

markexpanded (v:exp) v1 | (printvert v) == (printvert v1) = ((setexpanded v):exp)

markexpanded (e:exp) v = (e:(markexpanded exp v))

setexpanded :: Vertexa -> Vertexa

setexpanded (Vtx v p r) = (Vtx v p True)

-- Udates list, adding expanded nodes and checking distances

addexpanded :: Mainlist -> [Vertexa] -> Mainlist

addexpanded m [] = m

addexpanded m (e:exp) = addexpanded (cheaperpath m e) exp

-- Replace a vertex path by a cheaper path if available

cheaperpath ::  Mainlist -> Vertexa ->  Mainlist

cheaperpath (Mls [] _) e = (Mls [e] True)

cheaperpath (Mls (v:vx) b) e | (printvert e) == (printvert v) =

                if (getcheapest e v) then (Mls (e:vx) True) else (Mls (v:vx) b)

cheaperpath (Mls (v:vx) b) e = addtomainlist (cheaperpath (Mls vx b) e) v

-- Returns a Vertexa list from a Mainlist

addtomainlist :: Mainlist -> Vertexa ->  Mainlist

addtomainlist (Mls vs b) v = (Mls (v:vs) b)

prn :: Mainlist -> Bool

prn (Mls m b) = b

-- Name filter predicates

-------------------------

-- Returns True if string matches the Vertexa name

samename :: String -> Vertex -> Bool

samename n (Vt name _ _ _) = if (n == name) then True else False

-- Returns True if string matches the Vertexa name

samenamea :: String -> Vertexa -> Bool

samenamea n1 n = if (n1 == (printvert n)) then True else False

-- Returns True if string does not match the Vertex name

diffnamea :: String -> Vertexa -> Bool

diffnamea a b = not (samenamea a b)

-- Returns True if node has not been reached yet

notreached :: Vertexa -> Mainlist -> Bool

notreached v (Mls open _) = (null(filter (samenamea (printvert v)) open))

-- Returns True if node has not been expanded yet

notexpanded :: Vertexa -> Bool

notexpanded (Vtx _ (Pt p _) b) = (not b)

-- Cost-related functions

-------------------------

-- Returns the value of g(current)

cost :: Vertexa -> Double

cost (Vtx _ (Pt _ x) _) = x

-- Returns the value of h(current, goal)

heuri :: Vertexa -> Vertexa -> Double

heuri (Vtx (Vt _ x1 y1 _) _ _) (Vtx (Vt _ x2 y2 _) _ _) = sqrt ((x1 - x2)^2 + (y1 - y2)^2)

-- Returns g(current) + h(current, goal)

totalcost :: Vertexa -> Vertexa -> Double

totalcost a b = (cost a) + (heuri a b)

-- Returns true if the first vertex is cheaper than the second

getcheapest :: Vertexa -> Vertexa -> Bool

getcheapest (Vtx _ (Pt _ x) _) (Vtx _ (Pt _ y) _) = if x < y then True else False

-- Tests if the vertex is potentially worth expanding

isworthexpanding :: Vertexa -> Vertexa -> Double -> Bool

isworthexpanding a b c = if (totalcost a b) < c then True else False

-- Returns new cost after a cycle, leaves intact if no path found

getnewcost :: [Vertexa] -> String -> Double -> Double

getnewcost [] _ x = x

getnewcost ((Vtx (Vt name _ _ _) (Pt p x) _): vs) name1 oldcost | name1 == name && x < oldcost = getnewcost vs name1 x

getnewcost (_ : vs) vert oldcost = getnewcost vs vert oldcost