{-# LANGUAGE
MultiWayIf
, TypeOperators
, DefaultSignatures
, MultiParamTypeClasses
, FlexibleContexts
, FlexibleInstances
#-}
module Finite.Class
( T
, Finite(..)
, GFinite(..)
) where
import Control.Exception
( assert
)
import Finite.Type
( T
, FiniteBounds
, (#<<)
, (<<#)
, v2t
, (\#)
, (#)
)
import GHC.Generics
( Generic
, Rep
, (:*:)(..)
, (:+:)(..)
, U1(..)
, M1(..)
, K1(..)
, from
, to
)
import qualified Data.IntSet as S
( toList
, fromList
, fromAscList
, difference
)
class Finite b a where
elements
:: FiniteBounds b
=> T a -> Int
default elements
:: (Generic a, GFinite b (Rep a), FiniteBounds b)
=> T a -> Int
elements T a
t = T (Rep a Any) -> Int
forall b (f :: * -> *) a.
(GFinite b f, FiniteBounds b) =>
T (f a) -> Int
gelements (T (Rep a Any) -> Int) -> Rep a Any -> Int
forall a b. (T a -> b) -> a -> b
#<< a -> Rep a Any
forall a x. Generic a => a -> Rep a x
from (a -> Rep a Any) -> T a -> Rep a Any
forall a b. (a -> b) -> T a -> b
<<# T a
t
index
:: FiniteBounds b
=> a -> Int
default index
:: (Generic a, GFinite b (Rep a), FiniteBounds b)
=> a -> Int
index a
v = (Int -> Int -> Int
forall a. Num a => a -> a -> a
+ (T a -> Int
forall b a. (Finite b a, FiniteBounds b) => T a -> Int
offset (T a -> Int) -> T a -> Int
forall a b. (a -> b) -> a -> b
$ a -> T a
forall a. a -> T a
v2t a
v)) (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$ Rep a Any -> Int
forall b (f :: * -> *) a.
(GFinite b f, FiniteBounds b) =>
f a -> Int
gindex (Rep a Any -> Int) -> Rep a Any -> Int
forall a b. (a -> b) -> a -> b
$ a -> Rep a Any
forall a x. Generic a => a -> Rep a x
from a
v
value
:: FiniteBounds b => Int -> a
default value
:: (Generic a, GFinite b (Rep a), FiniteBounds b)
=> Int -> a
value Int
v =
let
o :: Int
o = T a -> Int
forall b a. (Finite b a, FiniteBounds b) => T a -> Int
offset (T a -> Int) -> T a -> Int
forall a b. (a -> b) -> a -> b
$ a -> T a
forall a. a -> T a
v2t a
r
e :: Int
e = T a -> Int
forall b a. (Finite b a, FiniteBounds b) => T a -> Int
elements (T a -> Int) -> T a -> Int
forall a b. (a -> b) -> a -> b
$ a -> T a
forall a. a -> T a
v2t a
r
r :: a
r = Rep a Any -> a
forall a x. Generic a => Rep a x -> a
to (Rep a Any -> a) -> Rep a Any -> a
forall a b. (a -> b) -> a -> b
$ Int -> Rep a Any
forall b (f :: * -> *) a.
(GFinite b f, FiniteBounds b) =>
Int -> f a
gvalue (Int
v Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
o)
in
Bool -> a -> a
forall a. (?callStack::CallStack) => Bool -> a -> a
assert (Int
v Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
o Bool -> Bool -> Bool
&& Int
v Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
o Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
e) a
r
offset
:: FiniteBounds b
=> T a -> Int
offset T a
_ = Int
0
values
:: FiniteBounds b
=> [a]
values =
let
rs :: [a]
rs = (Int -> a) -> [Int] -> [a]
forall a b. (a -> b) -> [a] -> [b]
map Int -> a
forall b a. (Finite b a, FiniteBounds b) => Int -> a
value [Int]
xs
o :: Int
o = T a -> Int
forall b a. (Finite b a, FiniteBounds b) => T a -> Int
offset (T a -> Int) -> T a -> Int
forall a b. (a -> b) -> a -> b
$ [a] -> T a
forall a. [a] -> T a
f [a]
rs
n :: Int
n = T a -> Int
forall b a. (Finite b a, FiniteBounds b) => T a -> Int
elements (T a -> Int) -> T a -> Int
forall a b. (a -> b) -> a -> b
$ [a] -> T a
forall a. [a] -> T a
f [a]
rs
xs :: [Int]
xs = [Int
o, Int
o Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1 .. Int
o Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1]
in
[a]
rs
where
f :: [a] -> T a
f :: [a] -> T a
f [a]
_ = T a
forall a. T a
(#)
complement
:: FiniteBounds b
=> [a] -> [a]
complement [a]
xs =
let
o :: Int
o = T a -> Int
forall b a. (Finite b a, FiniteBounds b) => T a -> Int
offset (T a -> Int) -> T a -> Int
forall a b. (a -> b) -> a -> b
$ [a] -> T a
forall a. [a] -> T a
f [a]
rs
n :: Int
n = T a -> Int
forall b a. (Finite b a, FiniteBounds b) => T a -> Int
elements (T a -> Int) -> T a -> Int
forall a b. (a -> b) -> a -> b
$ [a] -> T a
forall a. [a] -> T a
f [a]
rs
s :: IntSet
s = [Int] -> IntSet
S.fromList ([Int] -> IntSet) -> [Int] -> IntSet
forall a b. (a -> b) -> a -> b
$ (a -> Int) -> [a] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map a -> Int
forall b a. (Finite b a, FiniteBounds b) => a -> Int
index [a]
xs
a :: IntSet
a = [Int] -> IntSet
S.fromAscList [Int
o, Int
o Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1 .. Int
o Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1]
rs :: [a]
rs = (Int -> a) -> [Int] -> [a]
forall a b. (a -> b) -> [a] -> [b]
map Int -> a
forall b a. (Finite b a, FiniteBounds b) => Int -> a
value ([Int] -> [a]) -> [Int] -> [a]
forall a b. (a -> b) -> a -> b
$ IntSet -> [Int]
S.toList (IntSet -> [Int]) -> IntSet -> [Int]
forall a b. (a -> b) -> a -> b
$ IntSet -> IntSet -> IntSet
S.difference IntSet
a IntSet
s
in
[a]
rs
where
f :: [a] -> T a
f :: [a] -> T a
f [a]
_ = T a
forall a. T a
(#)
(|<|)
:: FiniteBounds b
=> a -> a -> Bool
(|<|) a
x a
y =
a -> Int
forall b a. (Finite b a, FiniteBounds b) => a -> Int
index a
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< a -> Int
forall b a. (Finite b a, FiniteBounds b) => a -> Int
index a
y
infixr |<|
(|<=|)
:: FiniteBounds b
=> a -> a -> Bool
(|<=|) a
x a
y =
a -> Int
forall b a. (Finite b a, FiniteBounds b) => a -> Int
index a
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= a -> Int
forall b a. (Finite b a, FiniteBounds b) => a -> Int
index a
y
infixr |<=|
(|>=|)
:: FiniteBounds b
=> a -> a -> Bool
(|>=|) a
x a
y =
a -> Int
forall b a. (Finite b a, FiniteBounds b) => a -> Int
index a
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= a -> Int
forall b a. (Finite b a, FiniteBounds b) => a -> Int
index a
y
infixr |>=|
(|>|)
:: FiniteBounds b
=> a -> a -> Bool
(|>|) a
x a
y =
a -> Int
forall b a. (Finite b a, FiniteBounds b) => a -> Int
index a
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> a -> Int
forall b a. (Finite b a, FiniteBounds b) => a -> Int
index a
y
infixr |>|
(|==|)
:: FiniteBounds b
=> a -> a -> Bool
(|==|) a
x a
y =
a -> Int
forall b a. (Finite b a, FiniteBounds b) => a -> Int
index a
x Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== a -> Int
forall b a. (Finite b a, FiniteBounds b) => a -> Int
index a
y
infixr |==|
(|/=|)
:: FiniteBounds b
=> a -> a -> Bool
(|/=|) a
x a
y =
a -> Int
forall b a. (Finite b a, FiniteBounds b) => a -> Int
index a
x Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= a -> Int
forall b a. (Finite b a, FiniteBounds b) => a -> Int
index a
y
infixr |/=|
initial
:: FiniteBounds b
=> T a -> a
initial T a
t =
Int -> a
forall b a. (Finite b a, FiniteBounds b) => Int -> a
value (Int -> a) -> Int -> a
forall a b. (a -> b) -> a -> b
$ T a -> Int
forall b a. (Finite b a, FiniteBounds b) => T a -> Int
offset T a
t
final
:: FiniteBounds b
=> T a -> a
final T a
t =
Int -> a
forall b a. (Finite b a, FiniteBounds b) => Int -> a
value (Int -> a) -> Int -> a
forall a b. (a -> b) -> a -> b
$ T a -> Int
forall b a. (Finite b a, FiniteBounds b) => T a -> Int
offset T a
t Int -> Int -> Int
forall a. Num a => a -> a -> a
+ T a -> Int
forall b a. (Finite b a, FiniteBounds b) => T a -> Int
elements T a
t Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1
next
:: FiniteBounds b
=> a -> a
next a
x =
let i :: Int
i = a -> Int
forall b a. (Finite b a, FiniteBounds b) => a -> Int
index a
x
in Bool -> a -> a
forall a. (?callStack::CallStack) => Bool -> a -> a
assert (Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< T a -> Int
forall b a. (Finite b a, FiniteBounds b) => T a -> Int
offset (a -> T a
forall a. a -> T a
v2t a
x) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ T a -> Int
forall b a. (Finite b a, FiniteBounds b) => T a -> Int
elements (a -> T a
forall a. a -> T a
v2t a
x) Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
(a -> a) -> a -> a
forall a b. (a -> b) -> a -> b
$ Int -> a
forall b a. (Finite b a, FiniteBounds b) => Int -> a
value (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
previous
:: FiniteBounds b
=> a -> a
previous a
x =
let i :: Int
i = a -> Int
forall b a. (Finite b a, FiniteBounds b) => a -> Int
index a
x
in Bool -> a -> a
forall a. (?callStack::CallStack) => Bool -> a -> a
assert (Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> T a -> Int
forall b a. (Finite b a, FiniteBounds b) => T a -> Int
offset (a -> T a
forall a. a -> T a
v2t a
x))
(a -> a) -> a -> a
forall a b. (a -> b) -> a -> b
$ Int -> a
forall b a. (Finite b a, FiniteBounds b) => Int -> a
value (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
bounds
:: FiniteBounds b
=> T a -> (a, a)
bounds T a
t =
(T a -> a
forall b a. (Finite b a, FiniteBounds b) => T a -> a
initial T a
t, T a -> a
forall b a. (Finite b a, FiniteBounds b) => T a -> a
final T a
t)
class GFinite b f where
gelements :: FiniteBounds b => T (f a) -> Int
gindex :: FiniteBounds b => f a -> Int
gvalue :: FiniteBounds b => Int -> f a
instance
(GFinite b f, GFinite b g)
=> GFinite b (f :*: g) where
gelements :: T ((:*:) f g a) -> Int
gelements T ((:*:) f g a)
x =
T (f a) -> Int
forall b (f :: * -> *) a.
(GFinite b f, FiniteBounds b) =>
T (f a) -> Int
gelements ((forall b a. b -> T a
forall (f :: * -> *) (g :: * -> *) a. T ((:*:) f g a) -> T (f a)
(\#) :: T ((f :*: g) a) -> T (f a)) T ((:*:) f g a)
x) Int -> Int -> Int
forall a. Num a => a -> a -> a
*
T (g a) -> Int
forall b (f :: * -> *) a.
(GFinite b f, FiniteBounds b) =>
T (f a) -> Int
gelements ((forall b a. b -> T a
forall (f :: * -> *) (g :: * -> *) a. T ((:*:) f g a) -> T (g a)
(\#) :: T ((f :*: g) a) -> T (g a)) T ((:*:) f g a)
x)
gindex :: (:*:) f g a -> Int
gindex (f a
f :*: g a
g) =
(f a -> Int
forall b (f :: * -> *) a.
(GFinite b f, FiniteBounds b) =>
f a -> Int
gindex f a
f Int -> Int -> Int
forall a. Num a => a -> a -> a
* (T (g a) -> Int
forall b (f :: * -> *) a.
(GFinite b f, FiniteBounds b) =>
T (f a) -> Int
gelements (T (g a) -> Int) -> g a -> Int
forall a b. (T a -> b) -> a -> b
#<< g a
g)) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ g a -> Int
forall b (f :: * -> *) a.
(GFinite b f, FiniteBounds b) =>
f a -> Int
gindex g a
g
gvalue :: Int -> (:*:) f g a
gvalue Int
n =
let
m :: Int
m = T (g a) -> Int
forall b (f :: * -> *) a.
(GFinite b f, FiniteBounds b) =>
T (f a) -> Int
gelements (T (g a) -> Int) -> g a -> Int
forall a b. (T a -> b) -> a -> b
#<< g a
g
f :: f a
f = Int -> f a
forall b (f :: * -> *) a.
(GFinite b f, FiniteBounds b) =>
Int -> f a
gvalue (Int
n Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
m)
g :: g a
g = Int -> g a
forall b (f :: * -> *) a.
(GFinite b f, FiniteBounds b) =>
Int -> f a
gvalue (Int
n Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` Int
m)
in
(f a
forall a. f a
f f a -> g a -> (:*:) f g a
forall k (f :: k -> *) (g :: k -> *) (p :: k).
f p -> g p -> (:*:) f g p
:*: g a
forall a. g a
g)
instance
(GFinite b f, GFinite b g)
=> GFinite b (f :+: g) where
gelements :: T ((:+:) f g a) -> Int
gelements T ((:+:) f g a)
x =
T (f a) -> Int
forall b (f :: * -> *) a.
(GFinite b f, FiniteBounds b) =>
T (f a) -> Int
gelements ((forall b a. b -> T a
forall (f :: * -> *) (g :: * -> *) a. T ((:+:) f g a) -> T (f a)
(\#) :: T ((f :+: g) a) -> T (f a)) T ((:+:) f g a)
x) Int -> Int -> Int
forall a. Num a => a -> a -> a
+
T (g a) -> Int
forall b (f :: * -> *) a.
(GFinite b f, FiniteBounds b) =>
T (f a) -> Int
gelements ((forall b a. b -> T a
forall (f :: * -> *) (g :: * -> *) a. T ((:+:) f g a) -> T (g a)
(\#) :: T ((f :+: g) a) -> T (g a)) T ((:+:) f g a)
x)
gindex :: (:+:) f g a -> Int
gindex (:+:) f g a
x = case (:+:) f g a
x of
R1 g a
y -> g a -> Int
forall b (f :: * -> *) a.
(GFinite b f, FiniteBounds b) =>
f a -> Int
gindex g a
y
L1 f a
y -> f a -> Int
forall b (f :: * -> *) a.
(GFinite b f, FiniteBounds b) =>
f a -> Int
gindex f a
y Int -> Int -> Int
forall a. Num a => a -> a -> a
+ T (g a) -> Int
forall b (f :: * -> *) a.
(GFinite b f, FiniteBounds b) =>
T (f a) -> Int
gelements ((forall b a. b -> T a
forall (f :: * -> *) (g :: * -> *) a. (:+:) f g a -> T (g a)
(\#) :: (f :+: g) a -> T (g a)) (:+:) f g a
x)
gvalue :: Int -> (:+:) f g a
gvalue Int
n =
let
m :: Int
m = T (g a) -> Int
forall b (f :: * -> *) a.
(GFinite b f, FiniteBounds b) =>
T (f a) -> Int
gelements (T (g a) -> Int) -> g a -> Int
forall a b. (T a -> b) -> a -> b
#<< g a
g
g :: g a
g = Int -> g a
forall b (f :: * -> *) a.
(GFinite b f, FiniteBounds b) =>
Int -> f a
gvalue (Int
n Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` Int
m)
f :: f a
f = Int -> f a
forall b (f :: * -> *) a.
(GFinite b f, FiniteBounds b) =>
Int -> f a
gvalue (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
m)
in if
| Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
m -> g a -> (:+:) f g a
forall k (f :: k -> *) (g :: k -> *) (p :: k). g p -> (:+:) f g p
R1 g a
forall a. g a
g
| Bool
otherwise -> f a -> (:+:) f g a
forall k (f :: k -> *) (g :: k -> *) (p :: k). f p -> (:+:) f g p
L1 f a
forall a. f a
f
instance
GFinite c U1 where
gelements :: T (U1 a) -> Int
gelements T (U1 a)
_ = Int
1
gindex :: U1 a -> Int
gindex U1 a
U1 = Int
0
gvalue :: Int -> U1 a
gvalue Int
_ = U1 a
forall k (p :: k). U1 p
U1
instance
(GFinite c f)
=> GFinite c (M1 i v f) where
gelements :: T (M1 i v f a) -> Int
gelements =
T (f a) -> Int
forall b (f :: * -> *) a.
(GFinite b f, FiniteBounds b) =>
T (f a) -> Int
gelements (T (f a) -> Int)
-> (T (M1 i v f a) -> T (f a)) -> T (M1 i v f a) -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall b a. b -> T a
forall i (v :: Meta) (f :: * -> *) p. T (M1 i v f p) -> T (f p)
(\#) :: T ((M1 i v f) p) -> T (f p))
gindex :: M1 i v f a -> Int
gindex (M1 f a
x) = f a -> Int
forall b (f :: * -> *) a.
(GFinite b f, FiniteBounds b) =>
f a -> Int
gindex f a
x
gvalue :: Int -> M1 i v f a
gvalue = f a -> M1 i v f a
forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 (f a -> M1 i v f a) -> (Int -> f a) -> Int -> M1 i v f a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> f a
forall b (f :: * -> *) a.
(GFinite b f, FiniteBounds b) =>
Int -> f a
gvalue
instance
(Finite b a)
=> GFinite b (K1 i a) where
gelements :: T (K1 i a a) -> Int
gelements =
T a -> Int
forall b a. (Finite b a, FiniteBounds b) => T a -> Int
elements (T a -> Int) -> (T (K1 i a a) -> T a) -> T (K1 i a a) -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall b a. b -> T a
forall i a c. T (K1 i a c) -> T a
(\#) :: T ((K1 i a) c) -> T a)
gindex :: K1 i a a -> Int
gindex (K1 a
x) = a -> Int
forall b a. (Finite b a, FiniteBounds b) => a -> Int
index a
x Int -> Int -> Int
forall a. Num a => a -> a -> a
- (T a -> Int
forall b a. (Finite b a, FiniteBounds b) => T a -> Int
offset (T a -> Int) -> a -> Int
forall a b. (T a -> b) -> a -> b
#<< a
x)
gvalue :: Int -> K1 i a a
gvalue Int
n =
let
m :: Int
m = T a -> Int
forall b a. (Finite b a, FiniteBounds b) => T a -> Int
offset (T a -> Int) -> a -> Int
forall a b. (T a -> b) -> a -> b
#<< a
x
x :: a
x = Int -> a
forall b a. (Finite b a, FiniteBounds b) => Int -> a
value (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
m)
in
a -> K1 i a a
forall k i c (p :: k). c -> K1 i c p
K1 a
x