module Data.IntTrie
( IntTrie, identity, apply, modify, modify', overwrite,
mirror, modifyAscList, modifyDescList )
where
import Control.Applicative
import Control.Arrow (first, second)
import Data.Bits
import Data.Function (fix)
import Data.Monoid (Monoid(..))
import Data.Semigroup (Semigroup(..))
data IntTrie a = IntTrie (BitTrie a) a (BitTrie a)
data BitTrie a = BitTrie a (BitTrie a) (BitTrie a)
instance Functor BitTrie where
fmap :: forall a b. (a -> b) -> BitTrie a -> BitTrie b
fmap a -> b
f ~(BitTrie a
x BitTrie a
l BitTrie a
r) = b -> BitTrie b -> BitTrie b -> BitTrie b
forall a. a -> BitTrie a -> BitTrie a -> BitTrie a
BitTrie (a -> b
f a
x) ((a -> b) -> BitTrie a -> BitTrie b
forall a b. (a -> b) -> BitTrie a -> BitTrie b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f BitTrie a
l) ((a -> b) -> BitTrie a -> BitTrie b
forall a b. (a -> b) -> BitTrie a -> BitTrie b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f BitTrie a
r)
instance Applicative BitTrie where
pure :: forall a. a -> BitTrie a
pure a
x = (BitTrie a -> BitTrie a) -> BitTrie a
forall a. (a -> a) -> a
fix (\BitTrie a
g -> a -> BitTrie a -> BitTrie a -> BitTrie a
forall a. a -> BitTrie a -> BitTrie a -> BitTrie a
BitTrie a
x BitTrie a
g BitTrie a
g)
~(BitTrie a -> b
f BitTrie (a -> b)
fl BitTrie (a -> b)
fr) <*> :: forall a b. BitTrie (a -> b) -> BitTrie a -> BitTrie b
<*> ~(BitTrie a
x BitTrie a
xl BitTrie a
xr) = b -> BitTrie b -> BitTrie b -> BitTrie b
forall a. a -> BitTrie a -> BitTrie a -> BitTrie a
BitTrie (a -> b
f a
x) (BitTrie (a -> b)
fl BitTrie (a -> b) -> BitTrie a -> BitTrie b
forall a b. BitTrie (a -> b) -> BitTrie a -> BitTrie b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> BitTrie a
xl) (BitTrie (a -> b)
fr BitTrie (a -> b) -> BitTrie a -> BitTrie b
forall a b. BitTrie (a -> b) -> BitTrie a -> BitTrie b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> BitTrie a
xr)
instance Semigroup a => Semigroup (BitTrie a) where
<> :: BitTrie a -> BitTrie a -> BitTrie a
(<>) = (a -> a -> a) -> BitTrie a -> BitTrie a -> BitTrie a
forall a b c. (a -> b -> c) -> BitTrie a -> BitTrie b -> BitTrie c
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 a -> a -> a
forall a. Semigroup a => a -> a -> a
(<>)
instance Monoid a => Monoid (BitTrie a) where
mempty :: BitTrie a
mempty = a -> BitTrie a
forall a. a -> BitTrie a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
forall a. Monoid a => a
mempty
mappend :: BitTrie a -> BitTrie a -> BitTrie a
mappend = (a -> a -> a) -> BitTrie a -> BitTrie a -> BitTrie a
forall a b c. (a -> b -> c) -> BitTrie a -> BitTrie b -> BitTrie c
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 a -> a -> a
forall a. Monoid a => a -> a -> a
mappend
instance Functor IntTrie where
fmap :: forall a b. (a -> b) -> IntTrie a -> IntTrie b
fmap a -> b
f ~(IntTrie BitTrie a
neg a
z BitTrie a
pos) = BitTrie b -> b -> BitTrie b -> IntTrie b
forall a. BitTrie a -> a -> BitTrie a -> IntTrie a
IntTrie ((a -> b) -> BitTrie a -> BitTrie b
forall a b. (a -> b) -> BitTrie a -> BitTrie b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f BitTrie a
neg) (a -> b
f a
z) ((a -> b) -> BitTrie a -> BitTrie b
forall a b. (a -> b) -> BitTrie a -> BitTrie b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f BitTrie a
pos)
instance Applicative IntTrie where
pure :: forall a. a -> IntTrie a
pure a
x = BitTrie a -> a -> BitTrie a -> IntTrie a
forall a. BitTrie a -> a -> BitTrie a -> IntTrie a
IntTrie (a -> BitTrie a
forall a. a -> BitTrie a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
x) a
x (a -> BitTrie a
forall a. a -> BitTrie a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
x)
IntTrie BitTrie (a -> b)
fneg a -> b
fz BitTrie (a -> b)
fpos <*> :: forall a b. IntTrie (a -> b) -> IntTrie a -> IntTrie b
<*> IntTrie BitTrie a
xneg a
xz BitTrie a
xpos =
BitTrie b -> b -> BitTrie b -> IntTrie b
forall a. BitTrie a -> a -> BitTrie a -> IntTrie a
IntTrie (BitTrie (a -> b)
fneg BitTrie (a -> b) -> BitTrie a -> BitTrie b
forall a b. BitTrie (a -> b) -> BitTrie a -> BitTrie b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> BitTrie a
xneg) (a -> b
fz a
xz) (BitTrie (a -> b)
fpos BitTrie (a -> b) -> BitTrie a -> BitTrie b
forall a b. BitTrie (a -> b) -> BitTrie a -> BitTrie b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> BitTrie a
xpos)
instance Semigroup a => Semigroup (IntTrie a) where
<> :: IntTrie a -> IntTrie a -> IntTrie a
(<>) = (a -> a -> a) -> IntTrie a -> IntTrie a -> IntTrie a
forall a b c. (a -> b -> c) -> IntTrie a -> IntTrie b -> IntTrie c
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 a -> a -> a
forall a. Semigroup a => a -> a -> a
(<>)
instance Monoid a => Monoid (IntTrie a) where
mempty :: IntTrie a
mempty = a -> IntTrie a
forall a. a -> IntTrie a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
forall a. Monoid a => a
mempty
mappend :: IntTrie a -> IntTrie a -> IntTrie a
mappend = (a -> a -> a) -> IntTrie a -> IntTrie a -> IntTrie a
forall a b c. (a -> b -> c) -> IntTrie a -> IntTrie b -> IntTrie c
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 a -> a -> a
forall a. Monoid a => a -> a -> a
mappend
apply :: (Ord b, Num b, Bits b) => IntTrie a -> b -> a
apply :: forall b a. (Ord b, Num b, Bits b) => IntTrie a -> b -> a
apply (IntTrie BitTrie a
neg a
z BitTrie a
pos) b
x =
case b -> b -> Ordering
forall a. Ord a => a -> a -> Ordering
compare b
x b
0 of
Ordering
LT -> BitTrie a -> b -> a
forall b a. (Num b, Bits b) => BitTrie a -> b -> a
applyPositive BitTrie a
neg (-b
x)
Ordering
EQ -> a
z
Ordering
GT -> BitTrie a -> b -> a
forall b a. (Num b, Bits b) => BitTrie a -> b -> a
applyPositive BitTrie a
pos b
x
applyPositive :: (Num b, Bits b) => BitTrie a -> b -> a
applyPositive :: forall b a. (Num b, Bits b) => BitTrie a -> b -> a
applyPositive (BitTrie a
one BitTrie a
even BitTrie a
odd) b
x
| b
x b -> b -> Bool
forall a. Eq a => a -> a -> Bool
== b
1 = a
one
| b -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
testBit b
x Int
0 = BitTrie a -> b -> a
forall b a. (Num b, Bits b) => BitTrie a -> b -> a
applyPositive BitTrie a
odd (b
x b -> Int -> b
forall a. Bits a => a -> Int -> a
`shiftR` Int
1)
| Bool
otherwise = BitTrie a -> b -> a
forall b a. (Num b, Bits b) => BitTrie a -> b -> a
applyPositive BitTrie a
even (b
x b -> Int -> b
forall a. Bits a => a -> Int -> a
`shiftR` Int
1)
identity :: (Num a, Bits a) => IntTrie a
identity :: forall a. (Num a, Bits a) => IntTrie a
identity = BitTrie a -> a -> BitTrie a -> IntTrie a
forall a. BitTrie a -> a -> BitTrie a -> IntTrie a
IntTrie ((a -> a) -> BitTrie a -> BitTrie a
forall a b. (a -> b) -> BitTrie a -> BitTrie b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> a
forall a. Num a => a -> a
negate BitTrie a
forall a. (Num a, Bits a) => BitTrie a
identityPositive) a
0 BitTrie a
forall a. (Num a, Bits a) => BitTrie a
identityPositive
identityPositive :: (Num a, Bits a) => BitTrie a
identityPositive :: forall a. (Num a, Bits a) => BitTrie a
identityPositive = BitTrie a
go
where
go :: BitTrie a
go = a -> BitTrie a -> BitTrie a -> BitTrie a
forall a. a -> BitTrie a -> BitTrie a -> BitTrie a
BitTrie a
1 ((a -> a) -> BitTrie a -> BitTrie a
forall a b. (a -> b) -> BitTrie a -> BitTrie b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (a -> Int -> a
forall a. Bits a => a -> Int -> a
`shiftL` Int
1) BitTrie a
go) ((a -> a) -> BitTrie a -> BitTrie a
forall a b. (a -> b) -> BitTrie a -> BitTrie b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\a
n -> (a
n a -> Int -> a
forall a. Bits a => a -> Int -> a
`shiftL` Int
1) a -> a -> a
forall a. Bits a => a -> a -> a
.|. a
1) BitTrie a
go)
modify :: (Ord b, Num b, Bits b) => b -> (a -> a) -> IntTrie a -> IntTrie a
modify :: forall b a.
(Ord b, Num b, Bits b) =>
b -> (a -> a) -> IntTrie a -> IntTrie a
modify b
x a -> a
f ~(IntTrie BitTrie a
neg a
z BitTrie a
pos) =
case b -> b -> Ordering
forall a. Ord a => a -> a -> Ordering
compare b
x b
0 of
Ordering
LT -> BitTrie a -> a -> BitTrie a -> IntTrie a
forall a. BitTrie a -> a -> BitTrie a -> IntTrie a
IntTrie (b -> (a -> a) -> BitTrie a -> BitTrie a
forall b a.
(Num b, Bits b) =>
b -> (a -> a) -> BitTrie a -> BitTrie a
modifyPositive (-b
x) a -> a
f BitTrie a
neg) a
z BitTrie a
pos
Ordering
EQ -> BitTrie a -> a -> BitTrie a -> IntTrie a
forall a. BitTrie a -> a -> BitTrie a -> IntTrie a
IntTrie BitTrie a
neg (a -> a
f a
z) BitTrie a
pos
Ordering
GT -> BitTrie a -> a -> BitTrie a -> IntTrie a
forall a. BitTrie a -> a -> BitTrie a -> IntTrie a
IntTrie BitTrie a
neg a
z (b -> (a -> a) -> BitTrie a -> BitTrie a
forall b a.
(Num b, Bits b) =>
b -> (a -> a) -> BitTrie a -> BitTrie a
modifyPositive b
x a -> a
f BitTrie a
pos)
modifyPositive :: (Num b, Bits b) => b -> (a -> a) -> BitTrie a -> BitTrie a
modifyPositive :: forall b a.
(Num b, Bits b) =>
b -> (a -> a) -> BitTrie a -> BitTrie a
modifyPositive b
x a -> a
f ~(BitTrie a
one BitTrie a
even BitTrie a
odd)
| b
x b -> b -> Bool
forall a. Eq a => a -> a -> Bool
== b
1 = a -> BitTrie a -> BitTrie a -> BitTrie a
forall a. a -> BitTrie a -> BitTrie a -> BitTrie a
BitTrie (a -> a
f a
one) BitTrie a
even BitTrie a
odd
| b -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
testBit b
x Int
0 = a -> BitTrie a -> BitTrie a -> BitTrie a
forall a. a -> BitTrie a -> BitTrie a -> BitTrie a
BitTrie a
one BitTrie a
even (b -> (a -> a) -> BitTrie a -> BitTrie a
forall b a.
(Num b, Bits b) =>
b -> (a -> a) -> BitTrie a -> BitTrie a
modifyPositive (b
x b -> Int -> b
forall a. Bits a => a -> Int -> a
`shiftR` Int
1) a -> a
f BitTrie a
odd)
| Bool
otherwise = a -> BitTrie a -> BitTrie a -> BitTrie a
forall a. a -> BitTrie a -> BitTrie a -> BitTrie a
BitTrie a
one (b -> (a -> a) -> BitTrie a -> BitTrie a
forall b a.
(Num b, Bits b) =>
b -> (a -> a) -> BitTrie a -> BitTrie a
modifyPositive (b
x b -> Int -> b
forall a. Bits a => a -> Int -> a
`shiftR` Int
1) a -> a
f BitTrie a
even) BitTrie a
odd
modify' :: (Ord b, Num b, Bits b) => b -> (a -> a) -> IntTrie a -> IntTrie a
modify' :: forall b a.
(Ord b, Num b, Bits b) =>
b -> (a -> a) -> IntTrie a -> IntTrie a
modify' b
x a -> a
f (IntTrie BitTrie a
neg a
z BitTrie a
pos) =
case b -> b -> Ordering
forall a. Ord a => a -> a -> Ordering
compare b
x b
0 of
Ordering
LT -> (BitTrie a -> a -> BitTrie a -> IntTrie a
forall a. BitTrie a -> a -> BitTrie a -> IntTrie a
IntTrie (BitTrie a -> a -> BitTrie a -> IntTrie a)
-> BitTrie a -> a -> BitTrie a -> IntTrie a
forall a b. (a -> b) -> a -> b
$! b -> (a -> a) -> BitTrie a -> BitTrie a
forall b a.
(Num b, Bits b) =>
b -> (a -> a) -> BitTrie a -> BitTrie a
modifyPositive' (-b
x) a -> a
f BitTrie a
neg) a
z BitTrie a
pos
Ordering
EQ -> (BitTrie a -> a -> BitTrie a -> IntTrie a
forall a. BitTrie a -> a -> BitTrie a -> IntTrie a
IntTrie BitTrie a
neg (a -> BitTrie a -> IntTrie a) -> a -> BitTrie a -> IntTrie a
forall a b. (a -> b) -> a -> b
$! a -> a
f a
z) BitTrie a
pos
Ordering
GT -> BitTrie a -> a -> BitTrie a -> IntTrie a
forall a. BitTrie a -> a -> BitTrie a -> IntTrie a
IntTrie BitTrie a
neg a
z (BitTrie a -> IntTrie a) -> BitTrie a -> IntTrie a
forall a b. (a -> b) -> a -> b
$! b -> (a -> a) -> BitTrie a -> BitTrie a
forall b a.
(Num b, Bits b) =>
b -> (a -> a) -> BitTrie a -> BitTrie a
modifyPositive' b
x a -> a
f BitTrie a
pos
modifyPositive' :: (Num b, Bits b) => b -> (a -> a) -> BitTrie a -> BitTrie a
modifyPositive' :: forall b a.
(Num b, Bits b) =>
b -> (a -> a) -> BitTrie a -> BitTrie a
modifyPositive' b
x a -> a
f (BitTrie a
one BitTrie a
even BitTrie a
odd)
| b
x b -> b -> Bool
forall a. Eq a => a -> a -> Bool
== b
1 = (a -> BitTrie a -> BitTrie a -> BitTrie a
forall a. a -> BitTrie a -> BitTrie a -> BitTrie a
BitTrie (a -> BitTrie a -> BitTrie a -> BitTrie a)
-> a -> BitTrie a -> BitTrie a -> BitTrie a
forall a b. (a -> b) -> a -> b
$! a -> a
f a
one) BitTrie a
even BitTrie a
odd
| b -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
testBit b
x Int
0 = a -> BitTrie a -> BitTrie a -> BitTrie a
forall a. a -> BitTrie a -> BitTrie a -> BitTrie a
BitTrie a
one BitTrie a
even (BitTrie a -> BitTrie a) -> BitTrie a -> BitTrie a
forall a b. (a -> b) -> a -> b
$! b -> (a -> a) -> BitTrie a -> BitTrie a
forall b a.
(Num b, Bits b) =>
b -> (a -> a) -> BitTrie a -> BitTrie a
modifyPositive' (b
x b -> Int -> b
forall a. Bits a => a -> Int -> a
`shiftR` Int
1) a -> a
f BitTrie a
odd
| Bool
otherwise = (a -> BitTrie a -> BitTrie a -> BitTrie a
forall a. a -> BitTrie a -> BitTrie a -> BitTrie a
BitTrie a
one (BitTrie a -> BitTrie a -> BitTrie a)
-> BitTrie a -> BitTrie a -> BitTrie a
forall a b. (a -> b) -> a -> b
$! b -> (a -> a) -> BitTrie a -> BitTrie a
forall b a.
(Num b, Bits b) =>
b -> (a -> a) -> BitTrie a -> BitTrie a
modifyPositive' (b
x b -> Int -> b
forall a. Bits a => a -> Int -> a
`shiftR` Int
1) a -> a
f BitTrie a
even) BitTrie a
odd
overwrite :: (Ord b, Num b, Bits b) => b -> a -> IntTrie a -> IntTrie a
overwrite :: forall b a.
(Ord b, Num b, Bits b) =>
b -> a -> IntTrie a -> IntTrie a
overwrite b
i a
x = b -> (a -> a) -> IntTrie a -> IntTrie a
forall b a.
(Ord b, Num b, Bits b) =>
b -> (a -> a) -> IntTrie a -> IntTrie a
modify b
i (a -> a -> a
forall a b. a -> b -> a
const a
x)
mirror :: IntTrie a -> IntTrie a
mirror :: forall a. IntTrie a -> IntTrie a
mirror ~(IntTrie BitTrie a
neg a
z BitTrie a
pos) = BitTrie a -> a -> BitTrie a -> IntTrie a
forall a. BitTrie a -> a -> BitTrie a -> IntTrie a
IntTrie BitTrie a
pos a
z BitTrie a
neg
modifyAscList :: (Ord b, Num b, Bits b) => [(b, a -> a)] -> IntTrie a -> IntTrie a
modifyAscList :: forall b a.
(Ord b, Num b, Bits b) =>
[(b, a -> a)] -> IntTrie a -> IntTrie a
modifyAscList [(b, a -> a)]
ifs ~t :: IntTrie a
t@(IntTrie BitTrie a
neg a
z BitTrie a
pos) =
case ((b, a -> a) -> Bool)
-> [(b, a -> a)] -> ([(b, a -> a)], [(b, a -> a)])
forall a. (a -> Bool) -> [a] -> ([a], [a])
break ((b -> b -> Bool
forall a. Ord a => a -> a -> Bool
>= b
0) (b -> Bool) -> ((b, a -> a) -> b) -> (b, a -> a) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (b, a -> a) -> b
forall a b. (a, b) -> a
fst) [(b, a -> a)]
ifs of
([], []) -> IntTrie a
t
([(b, a -> a)]
nifs, (b
0, a -> a
f):[(b, a -> a)]
pifs) -> BitTrie a -> a -> BitTrie a -> IntTrie a
forall a. BitTrie a -> a -> BitTrie a -> IntTrie a
IntTrie ([(b, a -> a)] -> BitTrie a -> BitTrie a
forall {a}. [(b, a -> a)] -> BitTrie a -> BitTrie a
modifyAscListNegative [(b, a -> a)]
nifs BitTrie a
neg) (a -> a
f a
z)
([(b, a -> a)] -> BitTrie a -> BitTrie a
forall b a.
(Ord b, Num b, Bits b) =>
[(b, a -> a)] -> BitTrie a -> BitTrie a
modifyAscListPositive [(b, a -> a)]
pifs BitTrie a
pos)
([(b, a -> a)]
nifs, [(b, a -> a)]
pifs) -> BitTrie a -> a -> BitTrie a -> IntTrie a
forall a. BitTrie a -> a -> BitTrie a -> IntTrie a
IntTrie ([(b, a -> a)] -> BitTrie a -> BitTrie a
forall {a}. [(b, a -> a)] -> BitTrie a -> BitTrie a
modifyAscListNegative [(b, a -> a)]
nifs BitTrie a
neg) a
z
([(b, a -> a)] -> BitTrie a -> BitTrie a
forall b a.
(Ord b, Num b, Bits b) =>
[(b, a -> a)] -> BitTrie a -> BitTrie a
modifyAscListPositive [(b, a -> a)]
pifs BitTrie a
pos)
where modifyAscListNegative :: [(b, a -> a)] -> BitTrie a -> BitTrie a
modifyAscListNegative = [(b, a -> a)] -> BitTrie a -> BitTrie a
forall b a.
(Ord b, Num b, Bits b) =>
[(b, a -> a)] -> BitTrie a -> BitTrie a
modifyAscListPositive ([(b, a -> a)] -> BitTrie a -> BitTrie a)
-> ([(b, a -> a)] -> [(b, a -> a)])
-> [(b, a -> a)]
-> BitTrie a
-> BitTrie a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((b, a -> a) -> (b, a -> a)) -> [(b, a -> a)] -> [(b, a -> a)]
forall a b. (a -> b) -> [a] -> [b]
map ((b -> b) -> (b, a -> a) -> (b, a -> a)
forall b c d. (b -> c) -> (b, d) -> (c, d)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first b -> b
forall a. Num a => a -> a
negate) ([(b, a -> a)] -> [(b, a -> a)])
-> ([(b, a -> a)] -> [(b, a -> a)])
-> [(b, a -> a)]
-> [(b, a -> a)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(b, a -> a)] -> [(b, a -> a)]
forall a. [a] -> [a]
reverse
modifyDescList :: (Ord b, Num b, Bits b) => [(b, a -> a)] -> IntTrie a -> IntTrie a
modifyDescList :: forall b a.
(Ord b, Num b, Bits b) =>
[(b, a -> a)] -> IntTrie a -> IntTrie a
modifyDescList [(b, a -> a)]
ifs = IntTrie a -> IntTrie a
forall a. IntTrie a -> IntTrie a
mirror (IntTrie a -> IntTrie a)
-> (IntTrie a -> IntTrie a) -> IntTrie a -> IntTrie a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(b, a -> a)] -> IntTrie a -> IntTrie a
forall b a.
(Ord b, Num b, Bits b) =>
[(b, a -> a)] -> IntTrie a -> IntTrie a
modifyAscList (((b, a -> a) -> (b, a -> a)) -> [(b, a -> a)] -> [(b, a -> a)]
forall a b. (a -> b) -> [a] -> [b]
map ((b -> b) -> (b, a -> a) -> (b, a -> a)
forall b c d. (b -> c) -> (b, d) -> (c, d)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first b -> b
forall a. Num a => a -> a
negate) [(b, a -> a)]
ifs) (IntTrie a -> IntTrie a)
-> (IntTrie a -> IntTrie a) -> IntTrie a -> IntTrie a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IntTrie a -> IntTrie a
forall a. IntTrie a -> IntTrie a
mirror
modifyAscListPositive :: (Ord b, Num b, Bits b) => [(b, a -> a)] -> BitTrie a -> BitTrie a
modifyAscListPositive :: forall b a.
(Ord b, Num b, Bits b) =>
[(b, a -> a)] -> BitTrie a -> BitTrie a
modifyAscListPositive [] BitTrie a
t = BitTrie a
t
modifyAscListPositive ((b
0, a -> a
_):[(b, a -> a)]
_) BitTrie a
_ =
[Char] -> BitTrie a
forall a. HasCallStack => [Char] -> a
error [Char]
"modifyAscList: expected strictly monotonic indices"
modifyAscListPositive ifs :: [(b, a -> a)]
ifs@((b
i, a -> a
f):[(b, a -> a)]
_) ~(BitTrie a
one BitTrie a
even BitTrie a
odd) = a -> BitTrie a -> BitTrie a -> BitTrie a
forall a. a -> BitTrie a -> BitTrie a -> BitTrie a
BitTrie a
one' BitTrie a
even' BitTrie a
odd' where
(a
one', [(b, a -> a)]
ifs') = if b
i b -> b -> Bool
forall a. Eq a => a -> a -> Bool
== b
1 then (a -> a
f a
one, [(b, a -> a)] -> [(b, a -> a)]
forall a. HasCallStack => [a] -> [a]
tail [(b, a -> a)]
ifs) else (a
one, [(b, a -> a)]
ifs)
even' :: BitTrie a
even' = [(b, a -> a)] -> BitTrie a -> BitTrie a
forall b a.
(Ord b, Num b, Bits b) =>
[(b, a -> a)] -> BitTrie a -> BitTrie a
modifyAscListPositive [(b, a -> a)]
ifsEven BitTrie a
even
odd' :: BitTrie a
odd' = [(b, a -> a)] -> BitTrie a -> BitTrie a
forall b a.
(Ord b, Num b, Bits b) =>
[(b, a -> a)] -> BitTrie a -> BitTrie a
modifyAscListPositive [(b, a -> a)]
ifsOdd BitTrie a
odd
([(b, a -> a)]
ifsOdd, [(b, a -> a)]
ifsEven) = ([(b, a -> a)] -> [(b, a -> a)])
-> ([(b, a -> a)], [(b, a -> a)]) -> ([(b, a -> a)], [(b, a -> a)])
forall {t} {b}. (t -> b) -> (t, t) -> (b, b)
both (((b, a -> a) -> (b, a -> a)) -> [(b, a -> a)] -> [(b, a -> a)]
forall a b. (a -> b) -> [a] -> [b]
map (((b, a -> a) -> (b, a -> a)) -> [(b, a -> a)] -> [(b, a -> a)])
-> ((b, a -> a) -> (b, a -> a)) -> [(b, a -> a)] -> [(b, a -> a)]
forall a b. (a -> b) -> a -> b
$ (b -> b) -> (b, a -> a) -> (b, a -> a)
forall b c d. (b -> c) -> (b, d) -> (c, d)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first (b -> Int -> b
forall a. Bits a => a -> Int -> a
`shiftR` Int
1)) (([(b, a -> a)], [(b, a -> a)]) -> ([(b, a -> a)], [(b, a -> a)]))
-> ([(b, a -> a)], [(b, a -> a)]) -> ([(b, a -> a)], [(b, a -> a)])
forall a b. (a -> b) -> a -> b
$ [(b, a -> a)] -> ([(b, a -> a)], [(b, a -> a)])
forall b a.
(Num b, Bits b) =>
[(b, a -> a)] -> ([(b, a -> a)], [(b, a -> a)])
partitionIndices [(b, a -> a)]
ifs'
both :: (t -> b) -> (t, t) -> (b, b)
both t -> b
f (t
x, t
y) = (t -> b
f t
x, t -> b
f t
y)
partitionIndices :: (Num b, Bits b) => [(b, a -> a)] -> ([(b, a -> a)], [(b, a -> a)])
partitionIndices :: forall b a.
(Num b, Bits b) =>
[(b, a -> a)] -> ([(b, a -> a)], [(b, a -> a)])
partitionIndices [] = ([], [])
partitionIndices [(b, a -> a)
x] = if b -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
testBit ((b, a -> a) -> b
forall a b. (a, b) -> a
fst (b, a -> a)
x) Int
0 then ([(b, a -> a)
x], []) else ([], [(b, a -> a)
x])
partitionIndices ((b, a -> a)
x:xs :: [(b, a -> a)]
xs@((b, a -> a)
y:[(b, a -> a)]
_)) = case b -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
testBit ((b, a -> a) -> b
forall a b. (a, b) -> a
fst (b, a -> a)
x) Int
0 of
Bool
False -> (if b -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
testBit ((b, a -> a) -> b
forall a b. (a, b) -> a
fst (b, a -> a)
y) Int
0 then [(b, a -> a)]
odd else (b, a -> a)
forall {a}. (b, a -> a)
pad(b, a -> a) -> [(b, a -> a)] -> [(b, a -> a)]
forall a. a -> [a] -> [a]
:[(b, a -> a)]
odd, (b, a -> a)
x(b, a -> a) -> [(b, a -> a)] -> [(b, a -> a)]
forall a. a -> [a] -> [a]
:[(b, a -> a)]
even)
Bool
True -> ((b, a -> a)
x(b, a -> a) -> [(b, a -> a)] -> [(b, a -> a)]
forall a. a -> [a] -> [a]
:[(b, a -> a)]
odd, if b -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
testBit ((b, a -> a) -> b
forall a b. (a, b) -> a
fst (b, a -> a)
y) Int
0 then (b, a -> a)
forall {a}. (b, a -> a)
pad(b, a -> a) -> [(b, a -> a)] -> [(b, a -> a)]
forall a. a -> [a] -> [a]
:[(b, a -> a)]
even else [(b, a -> a)]
even)
where ~([(b, a -> a)]
odd, [(b, a -> a)]
even) = [(b, a -> a)] -> ([(b, a -> a)], [(b, a -> a)])
forall b a.
(Num b, Bits b) =>
[(b, a -> a)] -> ([(b, a -> a)], [(b, a -> a)])
partitionIndices [(b, a -> a)]
xs
pad :: (b, a -> a)
pad = ((b, a -> a) -> b
forall a b. (a, b) -> a
fst (b, a -> a)
y b -> b -> b
forall a. Num a => a -> a -> a
- b
1, a -> a
forall a. a -> a
id)