{-# LANGUAGE DerivingVia, GeneralizedNewtypeDeriving, StandaloneDeriving #-}
module Math.ParetoFront (
Comparison(..),
Debatable(..),
Front,
Strata,
singleton,
stratum,
getStrata,
getFront,
quota,
nestedFold
) where
import Data.Foldable
import Data.List (partition, transpose)
import Data.Ord (Down(..))
import Data.Semigroup(Arg(..), Max(..), Min(..))
data Comparison =
Dominated |
WeakTie |
StrongTie |
Dominates
deriving(Eq Comparison
Eq Comparison
-> (Comparison -> Comparison -> Ordering)
-> (Comparison -> Comparison -> Bool)
-> (Comparison -> Comparison -> Bool)
-> (Comparison -> Comparison -> Bool)
-> (Comparison -> Comparison -> Bool)
-> (Comparison -> Comparison -> Comparison)
-> (Comparison -> Comparison -> Comparison)
-> Ord Comparison
Comparison -> Comparison -> Bool
Comparison -> Comparison -> Ordering
Comparison -> Comparison -> Comparison
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 :: Comparison -> Comparison -> Comparison
$cmin :: Comparison -> Comparison -> Comparison
max :: Comparison -> Comparison -> Comparison
$cmax :: Comparison -> Comparison -> Comparison
>= :: Comparison -> Comparison -> Bool
$c>= :: Comparison -> Comparison -> Bool
> :: Comparison -> Comparison -> Bool
$c> :: Comparison -> Comparison -> Bool
<= :: Comparison -> Comparison -> Bool
$c<= :: Comparison -> Comparison -> Bool
< :: Comparison -> Comparison -> Bool
$c< :: Comparison -> Comparison -> Bool
compare :: Comparison -> Comparison -> Ordering
$ccompare :: Comparison -> Comparison -> Ordering
$cp1Ord :: Eq Comparison
Ord,Comparison -> Comparison -> Bool
(Comparison -> Comparison -> Bool)
-> (Comparison -> Comparison -> Bool) -> Eq Comparison
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Comparison -> Comparison -> Bool
$c/= :: Comparison -> Comparison -> Bool
== :: Comparison -> Comparison -> Bool
$c== :: Comparison -> Comparison -> Bool
Eq,Int -> Comparison -> ShowS
[Comparison] -> ShowS
Comparison -> String
(Int -> Comparison -> ShowS)
-> (Comparison -> String)
-> ([Comparison] -> ShowS)
-> Show Comparison
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Comparison] -> ShowS
$cshowList :: [Comparison] -> ShowS
show :: Comparison -> String
$cshow :: Comparison -> String
showsPrec :: Int -> Comparison -> ShowS
$cshowsPrec :: Int -> Comparison -> ShowS
Show,ReadPrec [Comparison]
ReadPrec Comparison
Int -> ReadS Comparison
ReadS [Comparison]
(Int -> ReadS Comparison)
-> ReadS [Comparison]
-> ReadPrec Comparison
-> ReadPrec [Comparison]
-> Read Comparison
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Comparison]
$creadListPrec :: ReadPrec [Comparison]
readPrec :: ReadPrec Comparison
$creadPrec :: ReadPrec Comparison
readList :: ReadS [Comparison]
$creadList :: ReadS [Comparison]
readsPrec :: Int -> ReadS Comparison
$creadsPrec :: Int -> ReadS Comparison
Read)
instance Semigroup Comparison where
Comparison
WeakTie <> :: Comparison -> Comparison -> Comparison
<> Comparison
b = Comparison
b
Comparison
a <> Comparison
WeakTie = Comparison
a
Comparison
Dominates <> Comparison
Dominates = Comparison
Dominates
Comparison
Dominated <> Comparison
Dominated = Comparison
Dominated
Comparison
_ <> Comparison
_ = Comparison
StrongTie
instance Monoid Comparison where
mempty :: Comparison
mempty = Comparison
WeakTie
class Debatable a where
weigh :: a -> a -> Comparison
instance Ord a => Debatable (Min a) where
weigh :: Min a -> Min a -> Comparison
weigh (Min a
a) (Min a
b) = case a -> a -> Ordering
forall a. Ord a => a -> a -> Ordering
compare a
a a
b of
Ordering
LT -> Comparison
Dominates
Ordering
GT -> Comparison
Dominated
Ordering
EQ -> Comparison
WeakTie
deriving via Min Int instance Debatable Int
deriving via Min Integer instance Debatable Integer
deriving via Min Double instance Debatable Double
deriving via Min Float instance Debatable Float
deriving via Min (Down a) instance Ord a => Debatable (Max a)
instance Debatable a => Debatable (Down a) where
weigh :: Down a -> Down a -> Comparison
weigh (Down a
a) (Down a
b) = case a -> a -> Comparison
forall a. Debatable a => a -> a -> Comparison
weigh a
a a
b of
Comparison
Dominates -> Comparison
Dominated
Comparison
Dominated -> Comparison
Dominates
Comparison
r -> Comparison
r
instance Debatable a => Debatable (Arg a b) where
weigh :: Arg a b -> Arg a b -> Comparison
weigh (Arg a
a b
_) (Arg a
b b
_) = a -> a -> Comparison
forall a. Debatable a => a -> a -> Comparison
weigh a
a a
b
instance (Debatable a, Debatable b) => Debatable (a,b) where
weigh :: (a, b) -> (a, b) -> Comparison
weigh ~(a
a1,b
a2) ~(a
b1,b
b2) = a -> a -> Comparison
forall a. Debatable a => a -> a -> Comparison
weigh a
a1 a
b1 Comparison -> Comparison -> Comparison
forall a. Semigroup a => a -> a -> a
<> b -> b -> Comparison
forall a. Debatable a => a -> a -> Comparison
weigh b
a2 b
b2
instance (Debatable a, Debatable b, Debatable c) => Debatable (a,b,c) where
weigh :: (a, b, c) -> (a, b, c) -> Comparison
weigh ~(a
a1,b
a2,c
a3) ~(a
b1,b
b2,c
b3) = a -> a -> Comparison
forall a. Debatable a => a -> a -> Comparison
weigh a
a1 a
b1 Comparison -> Comparison -> Comparison
forall a. Semigroup a => a -> a -> a
<> b -> b -> Comparison
forall a. Debatable a => a -> a -> Comparison
weigh b
a2 b
b2 Comparison -> Comparison -> Comparison
forall a. Semigroup a => a -> a -> a
<> c -> c -> Comparison
forall a. Debatable a => a -> a -> Comparison
weigh c
a3 c
b3
instance (Debatable a, Debatable b, Debatable c, Debatable d) =>
Debatable (a,b,c,d) where
weigh :: (a, b, c, d) -> (a, b, c, d) -> Comparison
weigh ~(a
a1,b
a2,c
a3,d
a4) ~(a
b1,b
b2,c
b3,d
b4) = a -> a -> Comparison
forall a. Debatable a => a -> a -> Comparison
weigh a
a1 a
b1 Comparison -> Comparison -> Comparison
forall a. Semigroup a => a -> a -> a
<>
b -> b -> Comparison
forall a. Debatable a => a -> a -> Comparison
weigh b
a2 b
b2 Comparison -> Comparison -> Comparison
forall a. Semigroup a => a -> a -> a
<>
c -> c -> Comparison
forall a. Debatable a => a -> a -> Comparison
weigh c
a3 c
b3 Comparison -> Comparison -> Comparison
forall a. Semigroup a => a -> a -> a
<>
d -> d -> Comparison
forall a. Debatable a => a -> a -> Comparison
weigh d
a4 d
b4
newtype Front a = Front [a] deriving (a -> Front a -> Bool
Front m -> m
Front a -> [a]
Front a -> Bool
Front a -> Int
Front a -> a
Front a -> a
Front a -> a
Front a -> a
(a -> m) -> Front a -> m
(a -> m) -> Front a -> m
(a -> b -> b) -> b -> Front a -> b
(a -> b -> b) -> b -> Front a -> b
(b -> a -> b) -> b -> Front a -> b
(b -> a -> b) -> b -> Front a -> b
(a -> a -> a) -> Front a -> a
(a -> a -> a) -> Front a -> a
(forall m. Monoid m => Front m -> m)
-> (forall m a. Monoid m => (a -> m) -> Front a -> m)
-> (forall m a. Monoid m => (a -> m) -> Front a -> m)
-> (forall a b. (a -> b -> b) -> b -> Front a -> b)
-> (forall a b. (a -> b -> b) -> b -> Front a -> b)
-> (forall b a. (b -> a -> b) -> b -> Front a -> b)
-> (forall b a. (b -> a -> b) -> b -> Front a -> b)
-> (forall a. (a -> a -> a) -> Front a -> a)
-> (forall a. (a -> a -> a) -> Front a -> a)
-> (forall a. Front a -> [a])
-> (forall a. Front a -> Bool)
-> (forall a. Front a -> Int)
-> (forall a. Eq a => a -> Front a -> Bool)
-> (forall a. Ord a => Front a -> a)
-> (forall a. Ord a => Front a -> a)
-> (forall a. Num a => Front a -> a)
-> (forall a. Num a => Front a -> a)
-> Foldable Front
forall a. Eq a => a -> Front a -> Bool
forall a. Num a => Front a -> a
forall a. Ord a => Front a -> a
forall m. Monoid m => Front m -> m
forall a. Front a -> Bool
forall a. Front a -> Int
forall a. Front a -> [a]
forall a. (a -> a -> a) -> Front a -> a
forall m a. Monoid m => (a -> m) -> Front a -> m
forall b a. (b -> a -> b) -> b -> Front a -> b
forall a b. (a -> b -> b) -> b -> Front a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
product :: Front a -> a
$cproduct :: forall a. Num a => Front a -> a
sum :: Front a -> a
$csum :: forall a. Num a => Front a -> a
minimum :: Front a -> a
$cminimum :: forall a. Ord a => Front a -> a
maximum :: Front a -> a
$cmaximum :: forall a. Ord a => Front a -> a
elem :: a -> Front a -> Bool
$celem :: forall a. Eq a => a -> Front a -> Bool
length :: Front a -> Int
$clength :: forall a. Front a -> Int
null :: Front a -> Bool
$cnull :: forall a. Front a -> Bool
toList :: Front a -> [a]
$ctoList :: forall a. Front a -> [a]
foldl1 :: (a -> a -> a) -> Front a -> a
$cfoldl1 :: forall a. (a -> a -> a) -> Front a -> a
foldr1 :: (a -> a -> a) -> Front a -> a
$cfoldr1 :: forall a. (a -> a -> a) -> Front a -> a
foldl' :: (b -> a -> b) -> b -> Front a -> b
$cfoldl' :: forall b a. (b -> a -> b) -> b -> Front a -> b
foldl :: (b -> a -> b) -> b -> Front a -> b
$cfoldl :: forall b a. (b -> a -> b) -> b -> Front a -> b
foldr' :: (a -> b -> b) -> b -> Front a -> b
$cfoldr' :: forall a b. (a -> b -> b) -> b -> Front a -> b
foldr :: (a -> b -> b) -> b -> Front a -> b
$cfoldr :: forall a b. (a -> b -> b) -> b -> Front a -> b
foldMap' :: (a -> m) -> Front a -> m
$cfoldMap' :: forall m a. Monoid m => (a -> m) -> Front a -> m
foldMap :: (a -> m) -> Front a -> m
$cfoldMap :: forall m a. Monoid m => (a -> m) -> Front a -> m
fold :: Front m -> m
$cfold :: forall m. Monoid m => Front m -> m
Foldable, Int -> Front a -> ShowS
[Front a] -> ShowS
Front a -> String
(Int -> Front a -> ShowS)
-> (Front a -> String) -> ([Front a] -> ShowS) -> Show (Front a)
forall a. Show a => Int -> Front a -> ShowS
forall a. Show a => [Front a] -> ShowS
forall a. Show a => Front a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Front a] -> ShowS
$cshowList :: forall a. Show a => [Front a] -> ShowS
show :: Front a -> String
$cshow :: forall a. Show a => Front a -> String
showsPrec :: Int -> Front a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> Front a -> ShowS
Show)
newtype Strata a = Strata [Front a] deriving (Int -> Strata a -> ShowS
[Strata a] -> ShowS
Strata a -> String
(Int -> Strata a -> ShowS)
-> (Strata a -> String) -> ([Strata a] -> ShowS) -> Show (Strata a)
forall a. Show a => Int -> Strata a -> ShowS
forall a. Show a => [Strata a] -> ShowS
forall a. Show a => Strata a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Strata a] -> ShowS
$cshowList :: forall a. Show a => [Strata a] -> ShowS
show :: Strata a -> String
$cshow :: forall a. Show a => Strata a -> String
showsPrec :: Int -> Strata a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> Strata a -> ShowS
Show)
instance Foldable Strata where
foldMap :: (a -> m) -> Strata a -> m
foldMap a -> m
f (Strata [Front a]
l) = (Front a -> m) -> [Front a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap ((a -> m) -> Front a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap a -> m
f) [Front a]
l
singleton :: a -> Front a
singleton :: a -> Front a
singleton a
a = [a] -> Front a
forall a. [a] -> Front a
Front [a
a]
stratum :: a -> Strata a
stratum :: a -> Strata a
stratum a
a = [Front a] -> Strata a
forall a. [Front a] -> Strata a
Strata [a -> Front a
forall a. a -> Front a
singleton a
a]
fuse :: Debatable a => Front a -> Front a -> (Front a, Front a, Front a)
fuse :: Front a -> Front a -> (Front a, Front a, Front a)
fuse (Front [a]
a) (Front [a]
b) = let
m :: [[Comparison]]
m = (a -> [Comparison]) -> [a] -> [[Comparison]]
forall a b. (a -> b) -> [a] -> [b]
map (((a -> Comparison) -> [a] -> [Comparison])
-> [a] -> (a -> Comparison) -> [Comparison]
forall a b c. (a -> b -> c) -> b -> a -> c
flip (a -> Comparison) -> [a] -> [Comparison]
forall a b. (a -> b) -> [a] -> [b]
map [a]
b ((a -> Comparison) -> [Comparison])
-> (a -> a -> Comparison) -> a -> [Comparison]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> a -> Comparison
forall a. Debatable a => a -> a -> Comparison
weigh) [a]
a
m' :: [[Comparison]]
m' = [[Comparison]] -> [[Comparison]]
forall a. [[a]] -> [[a]]
transpose [[Comparison]]
m
s :: [Bool]
s = ([Comparison] -> Bool) -> [[Comparison]] -> [Bool]
forall a b. (a -> b) -> [a] -> [b]
map (Bool -> Bool
not (Bool -> Bool) -> ([Comparison] -> Bool) -> [Comparison] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Comparison -> Bool) -> [Comparison] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Comparison -> Comparison -> Bool
forall a. Eq a => a -> a -> Bool
== Comparison
Dominated)) [[Comparison]]
m
s' :: [Bool]
s' = ([Comparison] -> Bool) -> [[Comparison]] -> [Bool]
forall a b. (a -> b) -> [a] -> [b]
map (Bool -> Bool
not (Bool -> Bool) -> ([Comparison] -> Bool) -> [Comparison] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Comparison -> Bool) -> [Comparison] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Comparison -> Comparison -> Bool
forall a. Eq a => a -> a -> Bool
== Comparison
Dominates)) [[Comparison]]
m'
([(a, Bool)]
f1, [(a, Bool)]
t1) = ((a, Bool) -> Bool) -> [(a, Bool)] -> ([(a, Bool)], [(a, Bool)])
forall a. (a -> Bool) -> [a] -> ([a], [a])
partition (a, Bool) -> Bool
forall a b. (a, b) -> b
snd ([(a, Bool)] -> ([(a, Bool)], [(a, Bool)]))
-> [(a, Bool)] -> ([(a, Bool)], [(a, Bool)])
forall a b. (a -> b) -> a -> b
$ [a] -> [Bool] -> [(a, Bool)]
forall a b. [a] -> [b] -> [(a, b)]
zip [a]
a [Bool]
s
([(a, Bool)]
f2, [(a, Bool)]
t2) = ((a, Bool) -> Bool) -> [(a, Bool)] -> ([(a, Bool)], [(a, Bool)])
forall a. (a -> Bool) -> [a] -> ([a], [a])
partition (a, Bool) -> Bool
forall a b. (a, b) -> b
snd ([(a, Bool)] -> ([(a, Bool)], [(a, Bool)]))
-> [(a, Bool)] -> ([(a, Bool)], [(a, Bool)])
forall a b. (a -> b) -> a -> b
$ [a] -> [Bool] -> [(a, Bool)]
forall a b. [a] -> [b] -> [(a, b)]
zip [a]
b [Bool]
s'
in ([a] -> Front a
forall a. [a] -> Front a
Front ([a] -> Front a) -> [a] -> Front a
forall a b. (a -> b) -> a -> b
$ ((a, Bool) -> a) -> [(a, Bool)] -> [a]
forall a b. (a -> b) -> [a] -> [b]
map (a, Bool) -> a
forall a b. (a, b) -> a
fst ([(a, Bool)]
f1 [(a, Bool)] -> [(a, Bool)] -> [(a, Bool)]
forall a. [a] -> [a] -> [a]
++ [(a, Bool)]
f2), [a] -> Front a
forall a. [a] -> Front a
Front ([a] -> Front a) -> [a] -> Front a
forall a b. (a -> b) -> a -> b
$ ((a, Bool) -> a) -> [(a, Bool)] -> [a]
forall a b. (a -> b) -> [a] -> [b]
map (a, Bool) -> a
forall a b. (a, b) -> a
fst [(a, Bool)]
t1, [a] -> Front a
forall a. [a] -> Front a
Front ([a] -> Front a) -> [a] -> Front a
forall a b. (a -> b) -> a -> b
$ ((a, Bool) -> a) -> [(a, Bool)] -> [a]
forall a b. (a -> b) -> [a] -> [b]
map (a, Bool) -> a
forall a b. (a, b) -> a
fst [(a, Bool)]
t2)
instance Debatable a => Semigroup (Front a) where
Front a
a <> :: Front a -> Front a -> Front a
<> Front a
b = let
(Front a
r, Front a
_, Front a
_) = Front a -> Front a -> (Front a, Front a, Front a)
forall a.
Debatable a =>
Front a -> Front a -> (Front a, Front a, Front a)
fuse Front a
a Front a
b
in Front a
r
instance Debatable a => Monoid (Front a) where
mempty :: Front a
mempty = [a] -> Front a
forall a. [a] -> Front a
Front []
instance Debatable a => Semigroup (Strata a) where
Strata a
a <> :: Strata a -> Strata a -> Strata a
<> Strata a
b = [Strata a] -> Strata a
forall a. Monoid a => [a] -> a
mconcat [Strata a
a,Strata a
b]
instance Debatable a => Monoid (Strata a) where
mempty :: Strata a
mempty = [Front a] -> Strata a
forall a. [Front a] -> Strata a
Strata []
mconcat :: [Strata a] -> Strata a
mconcat = [Front a] -> Strata a
forall a. [Front a] -> Strata a
Strata ([Front a] -> Strata a)
-> ([Strata a] -> [Front a]) -> [Strata a] -> Strata a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[Front a]] -> [Front a]
forall a. Debatable a => [[Front a]] -> [Front a]
rebuild ([[Front a]] -> [Front a])
-> ([Strata a] -> [[Front a]]) -> [Strata a] -> [Front a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[Front a]] -> [[Front a]]
forall a. [[a]] -> [[a]]
transpose ([[Front a]] -> [[Front a]])
-> ([Strata a] -> [[Front a]]) -> [Strata a] -> [[Front a]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Strata a -> [Front a]) -> [Strata a] -> [[Front a]]
forall a b. (a -> b) -> [a] -> [b]
map Strata a -> [Front a]
forall a. Strata a -> [Front a]
getStrata where
rebuild :: [[Front a]] -> [Front a]
rebuild [] = []
rebuild ([] : [[Front a]]
r) = [[Front a]] -> [Front a]
rebuild [[Front a]]
r
rebuild ([Front a
x] : [[Front a]]
r) = Front a
x Front a -> [Front a] -> [Front a]
forall a. a -> [a] -> [a]
: [[Front a]] -> [Front a]
rebuild [[Front a]]
r
rebuild ((Front a
x : Front a
y : [Front a]
s) : [[Front a]]
r) = let
(Front a
f, Front a
p, Front a
q) = Front a -> Front a -> (Front a, Front a, Front a)
forall a.
Debatable a =>
Front a -> Front a -> (Front a, Front a, Front a)
fuse Front a
x Front a
y
r' :: [[Front a]]
r' = Front a -> [[Front a]] -> [[Front a]]
forall a. Front a -> [[Front a]] -> [[Front a]]
push Front a
p ([[Front a]] -> [[Front a]]) -> [[Front a]] -> [[Front a]]
forall a b. (a -> b) -> a -> b
$ Front a -> [[Front a]] -> [[Front a]]
forall a. Front a -> [[Front a]] -> [[Front a]]
push Front a
q [[Front a]]
r
in [[Front a]] -> [Front a]
rebuild ((Front a
fFront a -> [Front a] -> [Front a]
forall a. a -> [a] -> [a]
: [Front a]
s)[Front a] -> [[Front a]] -> [[Front a]]
forall a. a -> [a] -> [a]
: [[Front a]]
r')
push :: Front a -> [[Front a]] -> [[Front a]]
push (Front []) [[Front a]]
r = [[Front a]]
r
push Front a
q [] = [[Front a
q]]
push Front a
q ([Front a]
s : [[Front a]]
r) = ((Front a
qFront a -> [Front a] -> [Front a]
forall a. a -> [a] -> [a]
:[Front a]
s) [Front a] -> [[Front a]] -> [[Front a]]
forall a. a -> [a] -> [a]
: [[Front a]]
r)
getFront :: Front a -> [a]
getFront :: Front a -> [a]
getFront (Front [a]
l) = [a]
l
getStrata :: Strata a -> [Front a]
getStrata :: Strata a -> [Front a]
getStrata (Strata [Front a]
l) = [Front a]
l
quota :: Int -> Strata a -> Strata a
quota :: Int -> Strata a -> Strata a
quota Int
_ (Strata []) = [Front a] -> Strata a
forall a. [Front a] -> Strata a
Strata []
quota Int
n (Strata (Front a
a:[Front a]
r))
| Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 = let
Strata [Front a]
r' = Int -> Strata a -> Strata a
forall a. Int -> Strata a -> Strata a
quota (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (Front a -> [a]
forall a. Front a -> [a]
getFront Front a
a)) ([Front a] -> Strata a
forall a. [Front a] -> Strata a
Strata [Front a]
r)
in [Front a] -> Strata a
forall a. [Front a] -> Strata a
Strata (Front a
a Front a -> [Front a] -> [Front a]
forall a. a -> [a] -> [a]
: [Front a]
r')
| Bool
otherwise = [Front a] -> Strata a
forall a. [Front a] -> Strata a
Strata []
nestedFold :: (Monoid m, Monoid n) => (a -> m) -> (m -> n) -> Strata a -> n
nestedFold :: (a -> m) -> (m -> n) -> Strata a -> n
nestedFold a -> m
f m -> n
g (Strata [Front a]
l) = (Front a -> n) -> [Front a] -> n
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (m -> n
g (m -> n) -> (Front a -> m) -> Front a -> n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> m) -> Front a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap a -> m
f) [Front a]
l