I have 2 a.hs and b.hs files that use only one, is used ~, but the other uses an explicit match
$ diff a.hs b.hs
20,21c20
< (True, js) -> (True, a:js)
< (False, js) -> (False, b:js)
---
> ~(i, js) -> (i, (if i then a else b):js)
This is part of the code that uses a template that works fine.
shortest :: [a] -> [a] -> [a]
shortest xs ys = snd $ shortest' xs ys where
shortest' :: [a] -> [a] -> (Bool, [a])
shortest' [] _ = (True, [])
shortest' _ [] = (False, [])
shortest' (a:as) (b:bs) = case shortest' as bs of
~(i, js) -> (i, (if i then a else b):js)
but when i use
(True, js) -> (True, a:js)
(False, js) -> (False, b:js)
my computer is not responding (memory is almost full).
Am I missing any patterns?
All files can be found here
, (I wonder if SO supports the built-in gist)
I did not write the code initially, this is a modified version of flickyfrans gist
Edit: I think I should post b.hshere to prevent a problem with rotting links in the future.
import Data.Maybe
data Rose a = Rose a [Rose a] deriving Show
newtype Graph a = Graph [(a, Rose a)]
lookupRose :: Eq a => a -> Graph a -> Rose a
lookupRose i (Graph rs) = fromJust $ lookup i rs
fromList :: Eq a => [(a, [a])] -> Graph a
fromList xs = graph where
graph = Graph $ map irose xs
irose (i, is) = (i, Rose i $ map (`lookupRose` graph) is)
shortest :: [a] -> [a] -> [a]
shortest xs ys = snd $ shortest' xs ys where
shortest' :: [a] -> [a] -> (Bool, [a])
shortest' [] _ = (True, [])
shortest' _ [] = (False, [])
shortest' (a:as) (b:bs) = case shortest' as bs of
~(i, js) -> (i, (if i then a else b):js)
path :: Eq a => a -> a -> Graph a -> [a]
path orig dest gr = path' (lookupRose orig gr) where
path' (Rose p ps)
| p == dest = [p]
| otherwise = p : foldr1 shortest (map path' ps)
-------------------------------------------------------------------------------
type Pos = (Int,Int)
posGraph :: [(Pos,[Pos])]
posGraph = [ (a, [b, c, d])
, (b, [a, b, d])
, (c, [a, d, e])
, (d, [a, b, c, g])
, (e, [c, e, f, h])
, (f, [e, g, h])
, (g, [d, f, g])
, (h, [e, f])
]
where [a,b,c,d,e,f,g,h] =
[ (1,1)
, (2,2)
, (3,3)
, (4,4)
, (5,5)
, (6,6)
, (7,7)
, (8,8)
]
main :: IO ()
main = do
print $ path (1,1) (8,8) $ fromList posGraph
print $ path (2,2) (8,8) $ fromList posGraph