5outh

instance Functor Tree where
  fmap f (Leaf a) = Leaf $ f a
  fmap f (Node a b) = Node (f a) (map (fmap f) b)
  
instance Comonad Tree where
  coreturn (Leaf a) = a
  coreturn (Node a _) = a
  cojoin l@(Leaf a)   = Leaf l
  cojoin n@(Node a b) = Node n (map cojoin b)
  x =>> f = fmap f $ cojoin x

5outh

class (Functor w) => Comonad w where
  coreturn :: w a -> a
  cojoin   :: w a -> w (w a)
  (=>>)    ::  w a -> (w a -> b) -> w b 

5outh

reduce f (Leaf x) = x
reduce f (Node x xs) = f x . foldr1 f $ map (reduce f) xs

addTree = reduce (+)
multTree = reduce (*)

5outh

data Tree a = Node a [Tree a] | Leaf a deriving (Show, Eq)

sample = Node 1 [Node 2 [Leaf 5, Leaf 6], Node 3 [Leaf 7], Node 4 [Leaf 8]]

5outh

Leslie Andy
April Andy
Ron Ann
Ron April
Ann Jerry
Ann Andy
Leslie April
Ron Andy
Leslie Ron
Andy Jerry

5outh

module Graph(
  Graph(Graph),
  removeEdge,
  outbound,
  inbound
)where

data Graph a = Graph{ vertices :: [a], edges :: [(a, a)] } deriving Show

removeEdge :: (Eq a) => (a, a) -> Graph a -> Graph a

5outh

danceOutcome = graphFromFile "people.txt" >>= \f -> return $ tsort f

5outh

tsort :: (Eq a) => Graph a -> [a]
tsort graph  = tsort' [] (noInbound graph) graph
  where noInbound (Graph v e) = filter (flip notElem $ map snd e) v
        tsort' l []    (Graph _ []) = reverse l
        tsort' l []    _            = error "There is at least one cycle in this graph."
        tsort' l (n:s) g            = tsort' (n:l) s' g'
          where outEdges = outbound n g
                outNodes = map snd outEdges
                g'       = foldr removeEdge g outEdges
                s'       = s ++ filter (null . flip inbound g') outNodes

5outh

graphFromFile :: String -> IO (Graph String)
graphFromFile f = do
  contents <- readFile f
  let info   = map words $ lines contents
      verts = nub . concat $ info
      conns  = map (\[a, b] -> (a, b)) info
      graph  = Graph verts conns
  return graph

5outh

import Data.List --for later
import System.Environment --for later
import Graph

data Letter = A | B | C | D | E | F deriving (Show, Eq, Enum)

sample :: Graph Letter
sample = Graph [A,B,C,D,E,F] [(A, B), (A, C), (B, D), (C, D), (D, E), (D, F), (B, C), (F, E)]