--------------------------------------------------------------------------------
-- |
-- Module      : Data.Monus.Dist
-- Copyright   : (c) Donnacha Oisín Kidney 2021
-- Maintainer  : mail@doisinkidney.com
-- Stability   : experimental
-- Portability : non-portable
--
-- A 'Monus' for discrete distances.
--------------------------------------------------------------------------------

module Data.Monus.Dist where

import Numeric.Natural ( Natural )
import Data.Bits ( Bits )
import Data.Ix ( Ix )
import Data.Data ( Data, Typeable )
import GHC.Generics ( Generic )
import Data.Monoid ( Sum(Sum) )
import Data.Monus ( Monus )
import Test.QuickCheck
    ( arbitrarySizedNatural, shrinkIntegral, Arbitrary(..) )
import Control.DeepSeq ( NFData )

-- | A very simple 'Monus', based on the addition 'Monoid' on 'Natural' numbers.
-- This represents discrete distances.
newtype Dist = Dist { Dist -> Natural
runDist :: Natural }
  deriving stock (Dist -> Dist -> Bool
(Dist -> Dist -> Bool) -> (Dist -> Dist -> Bool) -> Eq Dist
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Dist -> Dist -> Bool
$c/= :: Dist -> Dist -> Bool
== :: Dist -> Dist -> Bool
$c== :: Dist -> Dist -> Bool
Eq, Eq Dist
Eq Dist
-> (Dist -> Dist -> Ordering)
-> (Dist -> Dist -> Bool)
-> (Dist -> Dist -> Bool)
-> (Dist -> Dist -> Bool)
-> (Dist -> Dist -> Bool)
-> (Dist -> Dist -> Dist)
-> (Dist -> Dist -> Dist)
-> Ord Dist
Dist -> Dist -> Bool
Dist -> Dist -> Ordering
Dist -> Dist -> Dist
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 :: Dist -> Dist -> Dist
$cmin :: Dist -> Dist -> Dist
max :: Dist -> Dist -> Dist
$cmax :: Dist -> Dist -> Dist
>= :: Dist -> Dist -> Bool
$c>= :: Dist -> Dist -> Bool
> :: Dist -> Dist -> Bool
$c> :: Dist -> Dist -> Bool
<= :: Dist -> Dist -> Bool
$c<= :: Dist -> Dist -> Bool
< :: Dist -> Dist -> Bool
$c< :: Dist -> Dist -> Bool
compare :: Dist -> Dist -> Ordering
$ccompare :: Dist -> Dist -> Ordering
Ord, Typeable Dist
Typeable Dist
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> Dist -> c Dist)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c Dist)
-> (Dist -> Constr)
-> (Dist -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c Dist))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Dist))
-> ((forall b. Data b => b -> b) -> Dist -> Dist)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Dist -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Dist -> r)
-> (forall u. (forall d. Data d => d -> u) -> Dist -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> Dist -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> Dist -> m Dist)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Dist -> m Dist)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Dist -> m Dist)
-> Data Dist
Dist -> DataType
Dist -> Constr
(forall b. Data b => b -> b) -> Dist -> Dist
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> Dist -> u
forall u. (forall d. Data d => d -> u) -> Dist -> [u]
forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Dist -> r
forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Dist -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Dist -> m Dist
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Dist -> m Dist
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Dist
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Dist -> c Dist
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Dist)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Dist)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Dist -> m Dist
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Dist -> m Dist
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Dist -> m Dist
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Dist -> m Dist
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Dist -> m Dist
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Dist -> m Dist
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Dist -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Dist -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> Dist -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Dist -> [u]
gmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Dist -> r
$cgmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Dist -> r
gmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Dist -> r
$cgmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Dist -> r
gmapT :: (forall b. Data b => b -> b) -> Dist -> Dist
$cgmapT :: (forall b. Data b => b -> b) -> Dist -> Dist
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Dist)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Dist)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Dist)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Dist)
dataTypeOf :: Dist -> DataType
$cdataTypeOf :: Dist -> DataType
toConstr :: Dist -> Constr
$ctoConstr :: Dist -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Dist
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Dist
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Dist -> c Dist
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Dist -> c Dist
Data, (forall x. Dist -> Rep Dist x)
-> (forall x. Rep Dist x -> Dist) -> Generic Dist
forall x. Rep Dist x -> Dist
forall x. Dist -> Rep Dist x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Dist x -> Dist
$cfrom :: forall x. Dist -> Rep Dist x
Generic, Typeable)
  deriving (Integer -> Dist
Dist -> Dist
Dist -> Dist -> Dist
(Dist -> Dist -> Dist)
-> (Dist -> Dist -> Dist)
-> (Dist -> Dist -> Dist)
-> (Dist -> Dist)
-> (Dist -> Dist)
-> (Dist -> Dist)
-> (Integer -> Dist)
-> Num Dist
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
fromInteger :: Integer -> Dist
$cfromInteger :: Integer -> Dist
signum :: Dist -> Dist
$csignum :: Dist -> Dist
abs :: Dist -> Dist
$cabs :: Dist -> Dist
negate :: Dist -> Dist
$cnegate :: Dist -> Dist
* :: Dist -> Dist -> Dist
$c* :: Dist -> Dist -> Dist
- :: Dist -> Dist -> Dist
$c- :: Dist -> Dist -> Dist
+ :: Dist -> Dist -> Dist
$c+ :: Dist -> Dist -> Dist
Num, Int -> Dist
Dist -> Int
Dist -> [Dist]
Dist -> Dist
Dist -> Dist -> [Dist]
Dist -> Dist -> Dist -> [Dist]
(Dist -> Dist)
-> (Dist -> Dist)
-> (Int -> Dist)
-> (Dist -> Int)
-> (Dist -> [Dist])
-> (Dist -> Dist -> [Dist])
-> (Dist -> Dist -> [Dist])
-> (Dist -> Dist -> Dist -> [Dist])
-> Enum Dist
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 :: Dist -> Dist -> Dist -> [Dist]
$cenumFromThenTo :: Dist -> Dist -> Dist -> [Dist]
enumFromTo :: Dist -> Dist -> [Dist]
$cenumFromTo :: Dist -> Dist -> [Dist]
enumFromThen :: Dist -> Dist -> [Dist]
$cenumFromThen :: Dist -> Dist -> [Dist]
enumFrom :: Dist -> [Dist]
$cenumFrom :: Dist -> [Dist]
fromEnum :: Dist -> Int
$cfromEnum :: Dist -> Int
toEnum :: Int -> Dist
$ctoEnum :: Int -> Dist
pred :: Dist -> Dist
$cpred :: Dist -> Dist
succ :: Dist -> Dist
$csucc :: Dist -> Dist
Enum, Enum Dist
Real Dist
Real Dist
-> Enum Dist
-> (Dist -> Dist -> Dist)
-> (Dist -> Dist -> Dist)
-> (Dist -> Dist -> Dist)
-> (Dist -> Dist -> Dist)
-> (Dist -> Dist -> (Dist, Dist))
-> (Dist -> Dist -> (Dist, Dist))
-> (Dist -> Integer)
-> Integral Dist
Dist -> Integer
Dist -> Dist -> (Dist, Dist)
Dist -> Dist -> Dist
forall a.
Real a
-> Enum a
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> (a, a))
-> (a -> a -> (a, a))
-> (a -> Integer)
-> Integral a
toInteger :: Dist -> Integer
$ctoInteger :: Dist -> Integer
divMod :: Dist -> Dist -> (Dist, Dist)
$cdivMod :: Dist -> Dist -> (Dist, Dist)
quotRem :: Dist -> Dist -> (Dist, Dist)
$cquotRem :: Dist -> Dist -> (Dist, Dist)
mod :: Dist -> Dist -> Dist
$cmod :: Dist -> Dist -> Dist
div :: Dist -> Dist -> Dist
$cdiv :: Dist -> Dist -> Dist
rem :: Dist -> Dist -> Dist
$crem :: Dist -> Dist -> Dist
quot :: Dist -> Dist -> Dist
$cquot :: Dist -> Dist -> Dist
Integral, Int -> Dist -> ShowS
[Dist] -> ShowS
Dist -> String
(Int -> Dist -> ShowS)
-> (Dist -> String) -> ([Dist] -> ShowS) -> Show Dist
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Dist] -> ShowS
$cshowList :: [Dist] -> ShowS
show :: Dist -> String
$cshow :: Dist -> String
showsPrec :: Int -> Dist -> ShowS
$cshowsPrec :: Int -> Dist -> ShowS
Show, ReadPrec [Dist]
ReadPrec Dist
Int -> ReadS Dist
ReadS [Dist]
(Int -> ReadS Dist)
-> ReadS [Dist] -> ReadPrec Dist -> ReadPrec [Dist] -> Read Dist
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Dist]
$creadListPrec :: ReadPrec [Dist]
readPrec :: ReadPrec Dist
$creadPrec :: ReadPrec Dist
readList :: ReadS [Dist]
$creadList :: ReadS [Dist]
readsPrec :: Int -> ReadS Dist
$creadsPrec :: Int -> ReadS Dist
Read, Num Dist
Ord Dist
Num Dist -> Ord Dist -> (Dist -> Rational) -> Real Dist
Dist -> Rational
forall a. Num a -> Ord a -> (a -> Rational) -> Real a
toRational :: Dist -> Rational
$ctoRational :: Dist -> Rational
Real, Ord Dist
Ord Dist
-> ((Dist, Dist) -> [Dist])
-> ((Dist, Dist) -> Dist -> Int)
-> ((Dist, Dist) -> Dist -> Int)
-> ((Dist, Dist) -> Dist -> Bool)
-> ((Dist, Dist) -> Int)
-> ((Dist, Dist) -> Int)
-> Ix Dist
(Dist, Dist) -> Int
(Dist, Dist) -> [Dist]
(Dist, Dist) -> Dist -> Bool
(Dist, Dist) -> Dist -> Int
forall a.
Ord a
-> ((a, a) -> [a])
-> ((a, a) -> a -> Int)
-> ((a, a) -> a -> Int)
-> ((a, a) -> a -> Bool)
-> ((a, a) -> Int)
-> ((a, a) -> Int)
-> Ix a
unsafeRangeSize :: (Dist, Dist) -> Int
$cunsafeRangeSize :: (Dist, Dist) -> Int
rangeSize :: (Dist, Dist) -> Int
$crangeSize :: (Dist, Dist) -> Int
inRange :: (Dist, Dist) -> Dist -> Bool
$cinRange :: (Dist, Dist) -> Dist -> Bool
unsafeIndex :: (Dist, Dist) -> Dist -> Int
$cunsafeIndex :: (Dist, Dist) -> Dist -> Int
index :: (Dist, Dist) -> Dist -> Int
$cindex :: (Dist, Dist) -> Dist -> Int
range :: (Dist, Dist) -> [Dist]
$crange :: (Dist, Dist) -> [Dist]
Ix, Eq Dist
Dist
Eq Dist
-> (Dist -> Dist -> Dist)
-> (Dist -> Dist -> Dist)
-> (Dist -> Dist -> Dist)
-> (Dist -> Dist)
-> (Dist -> Int -> Dist)
-> (Dist -> Int -> Dist)
-> Dist
-> (Int -> Dist)
-> (Dist -> Int -> Dist)
-> (Dist -> Int -> Dist)
-> (Dist -> Int -> Dist)
-> (Dist -> Int -> Bool)
-> (Dist -> Maybe Int)
-> (Dist -> Int)
-> (Dist -> Bool)
-> (Dist -> Int -> Dist)
-> (Dist -> Int -> Dist)
-> (Dist -> Int -> Dist)
-> (Dist -> Int -> Dist)
-> (Dist -> Int -> Dist)
-> (Dist -> Int -> Dist)
-> (Dist -> Int)
-> Bits Dist
Int -> Dist
Dist -> Bool
Dist -> Int
Dist -> Maybe Int
Dist -> Dist
Dist -> Int -> Bool
Dist -> Int -> Dist
Dist -> Dist -> Dist
forall a.
Eq a
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> a
-> (Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> Bool)
-> (a -> Maybe Int)
-> (a -> Int)
-> (a -> Bool)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int)
-> Bits a
popCount :: Dist -> Int
$cpopCount :: Dist -> Int
rotateR :: Dist -> Int -> Dist
$crotateR :: Dist -> Int -> Dist
rotateL :: Dist -> Int -> Dist
$crotateL :: Dist -> Int -> Dist
unsafeShiftR :: Dist -> Int -> Dist
$cunsafeShiftR :: Dist -> Int -> Dist
shiftR :: Dist -> Int -> Dist
$cshiftR :: Dist -> Int -> Dist
unsafeShiftL :: Dist -> Int -> Dist
$cunsafeShiftL :: Dist -> Int -> Dist
shiftL :: Dist -> Int -> Dist
$cshiftL :: Dist -> Int -> Dist
isSigned :: Dist -> Bool
$cisSigned :: Dist -> Bool
bitSize :: Dist -> Int
$cbitSize :: Dist -> Int
bitSizeMaybe :: Dist -> Maybe Int
$cbitSizeMaybe :: Dist -> Maybe Int
testBit :: Dist -> Int -> Bool
$ctestBit :: Dist -> Int -> Bool
complementBit :: Dist -> Int -> Dist
$ccomplementBit :: Dist -> Int -> Dist
clearBit :: Dist -> Int -> Dist
$cclearBit :: Dist -> Int -> Dist
setBit :: Dist -> Int -> Dist
$csetBit :: Dist -> Int -> Dist
bit :: Int -> Dist
$cbit :: Int -> Dist
zeroBits :: Dist
$czeroBits :: Dist
rotate :: Dist -> Int -> Dist
$crotate :: Dist -> Int -> Dist
shift :: Dist -> Int -> Dist
$cshift :: Dist -> Int -> Dist
complement :: Dist -> Dist
$ccomplement :: Dist -> Dist
xor :: Dist -> Dist -> Dist
$cxor :: Dist -> Dist -> Dist
.|. :: Dist -> Dist -> Dist
$c.|. :: Dist -> Dist -> Dist
.&. :: Dist -> Dist -> Dist
$c.&. :: Dist -> Dist -> Dist
Bits, Dist -> ()
(Dist -> ()) -> NFData Dist
forall a. (a -> ()) -> NFData a
rnf :: Dist -> ()
$crnf :: Dist -> ()
NFData) via Natural
  deriving (NonEmpty Dist -> Dist
Dist -> Dist -> Dist
(Dist -> Dist -> Dist)
-> (NonEmpty Dist -> Dist)
-> (forall b. Integral b => b -> Dist -> Dist)
-> Semigroup Dist
forall b. Integral b => b -> Dist -> Dist
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
stimes :: forall b. Integral b => b -> Dist -> Dist
$cstimes :: forall b. Integral b => b -> Dist -> Dist
sconcat :: NonEmpty Dist -> Dist
$csconcat :: NonEmpty Dist -> Dist
<> :: Dist -> Dist -> Dist
$c<> :: Dist -> Dist -> Dist
Semigroup, Semigroup Dist
Dist
Semigroup Dist
-> Dist
-> (Dist -> Dist -> Dist)
-> ([Dist] -> Dist)
-> Monoid Dist
[Dist] -> Dist
Dist -> Dist -> Dist
forall a.
Semigroup a -> a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
mconcat :: [Dist] -> Dist
$cmconcat :: [Dist] -> Dist
mappend :: Dist -> Dist -> Dist
$cmappend :: Dist -> Dist -> Dist
mempty :: Dist
$cmempty :: Dist
Monoid, Ord Dist
Monoid Dist
Ord Dist -> Monoid Dist -> (Dist -> Dist -> Dist) -> Monus Dist
Dist -> Dist -> Dist
forall a. Ord a -> Monoid a -> (a -> a -> a) -> Monus a
|-| :: Dist -> Dist -> Dist
$c|-| :: Dist -> Dist -> Dist
Monus) via (Sum Natural)

instance Arbitrary Dist where
  arbitrary :: Gen Dist
arbitrary = Gen Dist
forall a. Integral a => Gen a
arbitrarySizedNatural
  shrink :: Dist -> [Dist]
shrink = Dist -> [Dist]
forall a. Integral a => a -> [a]
shrinkIntegral

-- | A simple graph with 'Dist'-weighted edges.
--
-- Note that the algorithms in this package can use any monus, not just 'Dist':
-- we specialise here just for simplicity of presentation.
type Graph a = a -> [(a, Dist)]