{-# LANGUAGE TypeFamilies #-}
-----------------------------------------------------------------------------
-- |
-- Module     : Algebra.Graph.Labelled.Example.Network
-- Copyright  : (c) Andrey Mokhov 2016-2022
-- License    : MIT (see the file LICENSE)
-- Maintainer : andrey.mokhov@gmail.com
-- Stability  : experimental
--
-- __Alga__ is a library for algebraic construction and manipulation of graphs
-- in Haskell. See <https://github.com/snowleopard/alga-paper this paper> for the
-- motivation behind the library, the underlying theory, and implementation details.
--
-- This module contains a simple example of using edge-labelled graphs defined
-- in the module "Algebra.Graph.Labelled" for working with networks, i.e. graphs
-- whose edges are labelled with distances.
-----------------------------------------------------------------------------
module Algebra.Graph.Labelled.Example.Network where

import Algebra.Graph.Labelled

-- | Our example networks have /cities/ as vertices.
data City = Aberdeen
          | Edinburgh
          | Glasgow
          | London
          | Newcastle
          deriving (City
City -> City -> Bounded City
forall a. a -> a -> Bounded a
maxBound :: City
$cmaxBound :: City
minBound :: City
$cminBound :: City
Bounded, Int -> City
City -> Int
City -> [City]
City -> City
City -> City -> [City]
City -> City -> City -> [City]
(City -> City)
-> (City -> City)
-> (Int -> City)
-> (City -> Int)
-> (City -> [City])
-> (City -> City -> [City])
-> (City -> City -> [City])
-> (City -> City -> City -> [City])
-> Enum City
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: City -> City -> City -> [City]
$cenumFromThenTo :: City -> City -> City -> [City]
enumFromTo :: City -> City -> [City]
$cenumFromTo :: City -> City -> [City]
enumFromThen :: City -> City -> [City]
$cenumFromThen :: City -> City -> [City]
enumFrom :: City -> [City]
$cenumFrom :: City -> [City]
fromEnum :: City -> Int
$cfromEnum :: City -> Int
toEnum :: Int -> City
$ctoEnum :: Int -> City
pred :: City -> City
$cpred :: City -> City
succ :: City -> City
$csucc :: City -> City
Enum, City -> City -> Bool
(City -> City -> Bool) -> (City -> City -> Bool) -> Eq City
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: City -> City -> Bool
$c/= :: City -> City -> Bool
== :: City -> City -> Bool
$c== :: City -> City -> Bool
Eq, Eq City
Eq City
-> (City -> City -> Ordering)
-> (City -> City -> Bool)
-> (City -> City -> Bool)
-> (City -> City -> Bool)
-> (City -> City -> Bool)
-> (City -> City -> City)
-> (City -> City -> City)
-> Ord City
City -> City -> Bool
City -> City -> Ordering
City -> City -> City
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: City -> City -> City
$cmin :: City -> City -> City
max :: City -> City -> City
$cmax :: City -> City -> City
>= :: City -> City -> Bool
$c>= :: City -> City -> Bool
> :: City -> City -> Bool
$c> :: City -> City -> Bool
<= :: City -> City -> Bool
$c<= :: City -> City -> Bool
< :: City -> City -> Bool
$c< :: City -> City -> Bool
compare :: City -> City -> Ordering
$ccompare :: City -> City -> Ordering
$cp1Ord :: Eq City
Ord, Int -> City -> ShowS
[City] -> ShowS
City -> String
(Int -> City -> ShowS)
-> (City -> String) -> ([City] -> ShowS) -> Show City
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [City] -> ShowS
$cshowList :: [City] -> ShowS
show :: City -> String
$cshow :: City -> String
showsPrec :: Int -> City -> ShowS
$cshowsPrec :: Int -> City -> ShowS
Show)

-- | For simplicity we measure /journey times/ in integer number of minutes.
type JourneyTime = Int

-- | A part of the EastCoast train network between 'Aberdeen' and 'London'.
--
-- @
-- eastCoast = 'overlays' [ 'Aberdeen'  '-<'&#49;50'>-' 'Edinburgh'
--                      , 'Edinburgh' '-<' 90'>-' 'Newcastle'
--                      , 'Newcastle' '-<'&#49;70'>-' 'London' ]
-- @
eastCoast :: Network JourneyTime City
eastCoast :: Network Int City
eastCoast = [Network Int City] -> Network Int City
forall e a. Monoid e => [Graph e a] -> Graph e a
overlays [ City
Aberdeen  City -> Distance Int -> (City, Distance Int)
forall a e. a -> e -> (a, e)
-<Distance Int
150(City, Distance Int) -> City -> Network Int City
forall a e. (a, e) -> a -> Graph e a
>- City
Edinburgh
                     , City
Edinburgh City -> Distance Int -> (City, Distance Int)
forall a e. a -> e -> (a, e)
-< Distance Int
90(City, Distance Int) -> City -> Network Int City
forall a e. (a, e) -> a -> Graph e a
>- City
Newcastle
                     , City
Newcastle City -> Distance Int -> (City, Distance Int)
forall a e. a -> e -> (a, e)
-<Distance Int
170(City, Distance Int) -> City -> Network Int City
forall a e. (a, e) -> a -> Graph e a
>- City
London ]

-- | A part of the ScotRail train network between 'Aberdeen' and 'Glasgow'.
--
-- @
-- scotRail = 'overlays' [ 'Aberdeen'  '-<'&#49;40'>-' 'Edinburgh'
--                     , 'Edinburgh' '-<' 50'>-' 'Glasgow'
--                     , 'Edinburgh' '-<' 70'>-' 'Glasgow' ]
-- @
scotRail :: Network JourneyTime City
scotRail :: Network Int City
scotRail = [Network Int City] -> Network Int City
forall e a. Monoid e => [Graph e a] -> Graph e a
overlays [ City
Aberdeen  City -> Distance Int -> (City, Distance Int)
forall a e. a -> e -> (a, e)
-<Distance Int
140(City, Distance Int) -> City -> Network Int City
forall a e. (a, e) -> a -> Graph e a
>- City
Edinburgh
                    , City
Edinburgh City -> Distance Int -> (City, Distance Int)
forall a e. a -> e -> (a, e)
-< Distance Int
50(City, Distance Int) -> City -> Network Int City
forall a e. (a, e) -> a -> Graph e a
>- City
Glasgow
                    , City
Edinburgh City -> Distance Int -> (City, Distance Int)
forall a e. a -> e -> (a, e)
-< Distance Int
70(City, Distance Int) -> City -> Network Int City
forall a e. (a, e) -> a -> Graph e a
>- City
Glasgow ]

-- TODO: Add an illustration.
-- | An example train network.
--
-- @
-- network = 'overlay' 'scotRail' 'eastCoast'
-- @
network :: Network JourneyTime City
network :: Network Int City
network = Network Int City -> Network Int City -> Network Int City
forall e a. Monoid e => Graph e a -> Graph e a -> Graph e a
overlay Network Int City
scotRail Network Int City
eastCoast