{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
module Math.Combinatorics.Multiset
(
Count
, Multiset(..)
, emptyMS, singletonMS
, consMS, (+:)
, toList
, fromList
, fromListEq
, fromDistinctList
, fromCounts
, getCounts
, size
, disjUnion
, disjUnions
, permutations
, permutationsRLE
, Vec
, vPartitions
, partitions
, splits
, kSubsets
, cycles
, bracelets
, genFixedBracelets
, sequenceMS
) where
import Control.Arrow (first, second, (&&&), (***))
import Control.Monad (forM_, when)
import Control.Monad.Trans.Writer
import qualified Data.IntMap.Strict as IM
import Data.List (group, partition, sort)
import Data.Maybe (catMaybes, fromJust)
type Count = Int
newtype Multiset a = MS { Multiset a -> [(a, Count)]
toCounts :: [(a, Count)] }
deriving (Count -> Multiset a -> ShowS
[Multiset a] -> ShowS
Multiset a -> String
(Count -> Multiset a -> ShowS)
-> (Multiset a -> String)
-> ([Multiset a] -> ShowS)
-> Show (Multiset a)
forall a. Show a => Count -> Multiset a -> ShowS
forall a. Show a => [Multiset a] -> ShowS
forall a. Show a => Multiset a -> String
forall a.
(Count -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Multiset a] -> ShowS
$cshowList :: forall a. Show a => [Multiset a] -> ShowS
show :: Multiset a -> String
$cshow :: forall a. Show a => Multiset a -> String
showsPrec :: Count -> Multiset a -> ShowS
$cshowsPrec :: forall a. Show a => Count -> Multiset a -> ShowS
Show, a -> Multiset b -> Multiset a
(a -> b) -> Multiset a -> Multiset b
(forall a b. (a -> b) -> Multiset a -> Multiset b)
-> (forall a b. a -> Multiset b -> Multiset a) -> Functor Multiset
forall a b. a -> Multiset b -> Multiset a
forall a b. (a -> b) -> Multiset a -> Multiset b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> Multiset b -> Multiset a
$c<$ :: forall a b. a -> Multiset b -> Multiset a
fmap :: (a -> b) -> Multiset a -> Multiset b
$cfmap :: forall a b. (a -> b) -> Multiset a -> Multiset b
Functor)
fromCounts :: [(a, Count)] -> Multiset a
fromCounts :: [(a, Count)] -> Multiset a
fromCounts = [(a, Count)] -> Multiset a
forall a. [(a, Count)] -> Multiset a
MS
getCounts :: Multiset a -> [Count]
getCounts :: Multiset a -> [Count]
getCounts = ((a, Count) -> Count) -> [(a, Count)] -> [Count]
forall a b. (a -> b) -> [a] -> [b]
map (a, Count) -> Count
forall a b. (a, b) -> b
snd ([(a, Count)] -> [Count])
-> (Multiset a -> [(a, Count)]) -> Multiset a -> [Count]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Multiset a -> [(a, Count)]
forall a. Multiset a -> [(a, Count)]
toCounts
size :: Multiset a -> Int
size :: Multiset a -> Count
size = [Count] -> Count
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ([Count] -> Count)
-> (Multiset a -> [Count]) -> Multiset a -> Count
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Multiset a -> [Count]
forall a. Multiset a -> [Count]
getCounts
liftMS :: ([(a, Count)] -> [(b, Count)]) -> Multiset a -> Multiset b
liftMS :: ([(a, Count)] -> [(b, Count)]) -> Multiset a -> Multiset b
liftMS f :: [(a, Count)] -> [(b, Count)]
f (MS m :: [(a, Count)]
m) = [(b, Count)] -> Multiset b
forall a. [(a, Count)] -> Multiset a
MS ([(a, Count)] -> [(b, Count)]
f [(a, Count)]
m)
emptyMS :: Multiset a
emptyMS :: Multiset a
emptyMS = [(a, Count)] -> Multiset a
forall a. [(a, Count)] -> Multiset a
MS []
singletonMS :: a -> Multiset a
singletonMS :: a -> Multiset a
singletonMS a :: a
a = [(a, Count)] -> Multiset a
forall a. [(a, Count)] -> Multiset a
MS [(a
a,1)]
consMS :: (a, Count) -> Multiset a -> Multiset a
consMS :: (a, Count) -> Multiset a -> Multiset a
consMS e :: (a, Count)
e@(_,c :: Count
c) (MS m :: [(a, Count)]
m)
| Count
c Count -> Count -> Bool
forall a. Ord a => a -> a -> Bool
> 0 = [(a, Count)] -> Multiset a
forall a. [(a, Count)] -> Multiset a
MS ((a, Count)
e(a, Count) -> [(a, Count)] -> [(a, Count)]
forall a. a -> [a] -> [a]
:[(a, Count)]
m)
| Bool
otherwise = [(a, Count)] -> Multiset a
forall a. [(a, Count)] -> Multiset a
MS [(a, Count)]
m
(+:) :: (a, Count) -> Multiset a -> Multiset a
+: :: (a, Count) -> Multiset a -> Multiset a
(+:) = (a, Count) -> Multiset a -> Multiset a
forall a. (a, Count) -> Multiset a -> Multiset a
consMS
toList :: Multiset a -> [a]
toList :: Multiset a -> [a]
toList = [(a, Count)] -> [a]
forall a. [(a, Count)] -> [a]
expandCounts ([(a, Count)] -> [a])
-> (Multiset a -> [(a, Count)]) -> Multiset a -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Multiset a -> [(a, Count)]
forall a. Multiset a -> [(a, Count)]
toCounts
expandCounts :: [(a, Count)] -> [a]
expandCounts :: [(a, Count)] -> [a]
expandCounts = ((a, Count) -> [a]) -> [(a, Count)] -> [a]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ((a -> Count -> [a]) -> (a, Count) -> [a]
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry ((Count -> a -> [a]) -> a -> Count -> [a]
forall a b c. (a -> b -> c) -> b -> a -> c
flip Count -> a -> [a]
forall a. Count -> a -> [a]
replicate))
fromList :: Ord a => [a] -> Multiset a
fromList :: [a] -> Multiset a
fromList = [(a, Count)] -> Multiset a
forall a. [(a, Count)] -> Multiset a
fromCounts ([(a, Count)] -> Multiset a)
-> ([a] -> [(a, Count)]) -> [a] -> Multiset a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([a] -> (a, Count)) -> [[a]] -> [(a, Count)]
forall a b. (a -> b) -> [a] -> [b]
map ([a] -> a
forall a. [a] -> a
head ([a] -> a) -> ([a] -> Count) -> [a] -> (a, Count)
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& [a] -> Count
forall (t :: * -> *) a. Foldable t => t a -> Count
length) ([[a]] -> [(a, Count)]) -> ([a] -> [[a]]) -> [a] -> [(a, Count)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [a] -> [[a]]
forall a. Eq a => [a] -> [[a]]
group ([a] -> [[a]]) -> ([a] -> [a]) -> [a] -> [[a]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [a] -> [a]
forall a. Ord a => [a] -> [a]
sort
fromListEq :: Eq a => [a] -> Multiset a
fromListEq :: [a] -> Multiset a
fromListEq = [(a, Count)] -> Multiset a
forall a. [(a, Count)] -> Multiset a
fromCounts ([(a, Count)] -> Multiset a)
-> ([a] -> [(a, Count)]) -> [a] -> Multiset a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [a] -> [(a, Count)]
forall a. Eq a => [a] -> [(a, Count)]
fromListEq'
where fromListEq' :: [a] -> [(a, Count)]
fromListEq' [] = []
fromListEq' (x :: a
x:xs :: [a]
xs) = (a
x, 1 Count -> Count -> Count
forall a. Num a => a -> a -> a
+ [a] -> Count
forall (t :: * -> *) a. Foldable t => t a -> Count
length [a]
xEqs) (a, Count) -> [(a, Count)] -> [(a, Count)]
forall a. a -> [a] -> [a]
: [a] -> [(a, Count)]
fromListEq' [a]
xNeqs
where
(xEqs :: [a]
xEqs, xNeqs :: [a]
xNeqs) = (a -> Bool) -> [a] -> ([a], [a])
forall a. (a -> Bool) -> [a] -> ([a], [a])
partition (a -> a -> Bool
forall a. Eq a => a -> a -> Bool
==a
x) [a]
xs
fromDistinctList :: [a] -> Multiset a
fromDistinctList :: [a] -> Multiset a
fromDistinctList = [(a, Count)] -> Multiset a
forall a. [(a, Count)] -> Multiset a
fromCounts ([(a, Count)] -> Multiset a)
-> ([a] -> [(a, Count)]) -> [a] -> Multiset a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> (a, Count)) -> [a] -> [(a, Count)]
forall a b. (a -> b) -> [a] -> [b]
map (\x :: a
x -> (a
x,1))
disjUnion :: Multiset a -> Multiset a -> Multiset a
disjUnion :: Multiset a -> Multiset a -> Multiset a
disjUnion (MS xs :: [(a, Count)]
xs) (MS ys :: [(a, Count)]
ys) = [(a, Count)] -> Multiset a
forall a. [(a, Count)] -> Multiset a
MS ([(a, Count)]
xs [(a, Count)] -> [(a, Count)] -> [(a, Count)]
forall a. [a] -> [a] -> [a]
++ [(a, Count)]
ys)
disjUnions :: [Multiset a] -> Multiset a
disjUnions :: [Multiset a] -> Multiset a
disjUnions = (Multiset a -> Multiset a -> Multiset a)
-> Multiset a -> [Multiset a] -> Multiset a
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Multiset a -> Multiset a -> Multiset a
forall a. Multiset a -> Multiset a -> Multiset a
disjUnion ([(a, Count)] -> Multiset a
forall a. [(a, Count)] -> Multiset a
MS [])
data RMultiset a = RMS (Maybe (a, Count)) [(a,Count)]
deriving Count -> RMultiset a -> ShowS
[RMultiset a] -> ShowS
RMultiset a -> String
(Count -> RMultiset a -> ShowS)
-> (RMultiset a -> String)
-> ([RMultiset a] -> ShowS)
-> Show (RMultiset a)
forall a. Show a => Count -> RMultiset a -> ShowS
forall a. Show a => [RMultiset a] -> ShowS
forall a. Show a => RMultiset a -> String
forall a.
(Count -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RMultiset a] -> ShowS
$cshowList :: forall a. Show a => [RMultiset a] -> ShowS
show :: RMultiset a -> String
$cshow :: forall a. Show a => RMultiset a -> String
showsPrec :: Count -> RMultiset a -> ShowS
$cshowsPrec :: forall a. Show a => Count -> RMultiset a -> ShowS
Show
toRMS :: Multiset a -> RMultiset a
toRMS :: Multiset a -> RMultiset a
toRMS = Maybe (a, Count) -> [(a, Count)] -> RMultiset a
forall a. Maybe (a, Count) -> [(a, Count)] -> RMultiset a
RMS Maybe (a, Count)
forall a. Maybe a
Nothing ([(a, Count)] -> RMultiset a)
-> (Multiset a -> [(a, Count)]) -> Multiset a -> RMultiset a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Multiset a -> [(a, Count)]
forall a. Multiset a -> [(a, Count)]
toCounts
fromRMS :: RMultiset a -> Multiset a
fromRMS :: RMultiset a -> Multiset a
fromRMS (RMS Nothing m :: [(a, Count)]
m) = [(a, Count)] -> Multiset a
forall a. [(a, Count)] -> Multiset a
MS [(a, Count)]
m
fromRMS (RMS (Just e :: (a, Count)
e) m :: [(a, Count)]
m) = [(a, Count)] -> Multiset a
forall a. [(a, Count)] -> Multiset a
MS ((a, Count)
e(a, Count) -> [(a, Count)] -> [(a, Count)]
forall a. a -> [a] -> [a]
:[(a, Count)]
m)
permutations :: Multiset a -> [[a]]
permutations :: Multiset a -> [[a]]
permutations = ([(a, Count)] -> [a]) -> [[(a, Count)]] -> [[a]]
forall a b. (a -> b) -> [a] -> [b]
map [(a, Count)] -> [a]
forall a. [(a, Count)] -> [a]
expandCounts ([[(a, Count)]] -> [[a]])
-> (Multiset a -> [[(a, Count)]]) -> Multiset a -> [[a]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Multiset a -> [[(a, Count)]]
forall a. Multiset a -> [[(a, Count)]]
permutationsRLE
permutationsRLE :: Multiset a -> [[(a,Count)]]
permutationsRLE :: Multiset a -> [[(a, Count)]]
permutationsRLE (MS []) = [[]]
permutationsRLE m :: Multiset a
m = RMultiset a -> [[(a, Count)]]
forall a. RMultiset a -> [[(a, Count)]]
permutationsRLE' (Multiset a -> RMultiset a
forall a. Multiset a -> RMultiset a
toRMS Multiset a
m)
permutationsRLE' :: RMultiset a -> [[(a,Count)]]
permutationsRLE' :: RMultiset a -> [[(a, Count)]]
permutationsRLE' (RMS Nothing [(x :: a
x,n :: Count
n)]) = [[(a
x,Count
n)]]
permutationsRLE' m :: RMultiset a
m = [ (a, Count)
e (a, Count) -> [(a, Count)] -> [(a, Count)]
forall a. a -> [a] -> [a]
: [(a, Count)]
p
| (e :: (a, Count)
e, m' :: RMultiset a
m') <- RMultiset a -> [((a, Count), RMultiset a)]
forall a. RMultiset a -> [((a, Count), RMultiset a)]
selectRMS RMultiset a
m
, [(a, Count)]
p <- RMultiset a -> [[(a, Count)]]
forall a. RMultiset a -> [[(a, Count)]]
permutationsRLE' RMultiset a
m'
]
selectRMS :: RMultiset a -> [((a, Count), RMultiset a)]
selectRMS :: RMultiset a -> [((a, Count), RMultiset a)]
selectRMS (RMS _ []) = []
selectRMS (RMS e :: Maybe (a, Count)
e ((x :: a
x,n :: Count
n) : ms :: [(a, Count)]
ms)) =
((a
x,Count
n), Maybe (a, Count) -> [(a, Count)] -> RMultiset a
forall a. Maybe (a, Count) -> [(a, Count)] -> RMultiset a
RMS Maybe (a, Count)
forall a. Maybe a
Nothing ([(a, Count)]
-> ((a, Count) -> [(a, Count)]) -> Maybe (a, Count) -> [(a, Count)]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [(a, Count)]
ms ((a, Count) -> [(a, Count)] -> [(a, Count)]
forall a. a -> [a] -> [a]
:[(a, Count)]
ms) Maybe (a, Count)
e)) ((a, Count), RMultiset a)
-> [((a, Count), RMultiset a)] -> [((a, Count), RMultiset a)]
forall a. a -> [a] -> [a]
:
[ ( (a
x,Count
k), Maybe (a, Count) -> [(a, Count)] -> RMultiset a
forall a. Maybe (a, Count) -> [(a, Count)] -> RMultiset a
RMS ((a, Count) -> Maybe (a, Count)
forall a. a -> Maybe a
Just (a
x,Count
nCount -> Count -> Count
forall a. Num a => a -> a -> a
-Count
k))
([(a, Count)]
-> ((a, Count) -> [(a, Count)]) -> Maybe (a, Count) -> [(a, Count)]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [(a, Count)]
ms ((a, Count) -> [(a, Count)] -> [(a, Count)]
forall a. a -> [a] -> [a]
:[(a, Count)]
ms) Maybe (a, Count)
e) )
| Count
k <- [Count
nCount -> Count -> Count
forall a. Num a => a -> a -> a
-1, Count
nCount -> Count -> Count
forall a. Num a => a -> a -> a
-2 .. 1]
] [((a, Count), RMultiset a)]
-> [((a, Count), RMultiset a)] -> [((a, Count), RMultiset a)]
forall a. [a] -> [a] -> [a]
++
(((a, Count), RMultiset a) -> ((a, Count), RMultiset a))
-> [((a, Count), RMultiset a)] -> [((a, Count), RMultiset a)]
forall a b. (a -> b) -> [a] -> [b]
map ((RMultiset a -> RMultiset a)
-> ((a, Count), RMultiset a) -> ((a, Count), RMultiset a)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second ((a, Count) -> RMultiset a -> RMultiset a
forall a. (a, Count) -> RMultiset a -> RMultiset a
consRMS (a
x,Count
n))) (RMultiset a -> [((a, Count), RMultiset a)]
forall a. RMultiset a -> [((a, Count), RMultiset a)]
selectRMS (Maybe (a, Count) -> [(a, Count)] -> RMultiset a
forall a. Maybe (a, Count) -> [(a, Count)] -> RMultiset a
RMS Maybe (a, Count)
e [(a, Count)]
ms))
consRMS :: (a, Count) -> RMultiset a -> RMultiset a
consRMS :: (a, Count) -> RMultiset a -> RMultiset a
consRMS x :: (a, Count)
x (RMS e :: Maybe (a, Count)
e m :: [(a, Count)]
m) = Maybe (a, Count) -> [(a, Count)] -> RMultiset a
forall a. Maybe (a, Count) -> [(a, Count)] -> RMultiset a
RMS Maybe (a, Count)
e ((a, Count)
x(a, Count) -> [(a, Count)] -> [(a, Count)]
forall a. a -> [a] -> [a]
:[(a, Count)]
m)
type Vec = [Count]
(<|=) :: Vec -> Vec -> Bool
xs :: [Count]
xs <|= :: [Count] -> [Count] -> Bool
<|= ys :: [Count]
ys = [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
and ([Bool] -> Bool) -> [Bool] -> Bool
forall a b. (a -> b) -> a -> b
$ (Count -> Count -> Bool) -> [Count] -> [Count] -> [Bool]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Count -> Count -> Bool
forall a. Ord a => a -> a -> Bool
(<=) [Count]
xs [Count]
ys
vZero :: Vec -> Vec
vZero :: [Count] -> [Count]
vZero = (Count -> Count) -> [Count] -> [Count]
forall a b. (a -> b) -> [a] -> [b]
map (Count -> Count -> Count
forall a b. a -> b -> a
const 0)
vIsZero :: Vec -> Bool
vIsZero :: [Count] -> Bool
vIsZero = (Count -> Bool) -> [Count] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (Count -> Count -> Bool
forall a. Eq a => a -> a -> Bool
==0)
(.+.), (.-.) :: Vec -> Vec -> Vec
.+. :: [Count] -> [Count] -> [Count]
(.+.) = (Count -> Count -> Count) -> [Count] -> [Count] -> [Count]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Count -> Count -> Count
forall a. Num a => a -> a -> a
(+)
.-. :: [Count] -> [Count] -> [Count]
(.-.) = (Count -> Count -> Count) -> [Count] -> [Count] -> [Count]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (-)
(*.) :: Count -> Vec -> Vec
*. :: Count -> [Count] -> [Count]
(*.) n :: Count
n = (Count -> Count) -> [Count] -> [Count]
forall a b. (a -> b) -> [a] -> [b]
map (Count
nCount -> Count -> Count
forall a. Num a => a -> a -> a
*)
vDiv :: Vec -> Vec -> Count
vDiv :: [Count] -> [Count] -> Count
vDiv v1 :: [Count]
v1 v2 :: [Count]
v2 = [Count] -> Count
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
minimum ([Count] -> Count)
-> ([Maybe Count] -> [Count]) -> [Maybe Count] -> Count
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Maybe Count] -> [Count]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe Count] -> Count) -> [Maybe Count] -> Count
forall a b. (a -> b) -> a -> b
$ (Count -> Count -> Maybe Count)
-> [Count] -> [Count] -> [Maybe Count]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Count -> Count -> Maybe Count
forall a. Integral a => a -> a -> Maybe a
zdiv [Count]
v1 [Count]
v2
where zdiv :: a -> a -> Maybe a
zdiv _ 0 = Maybe a
forall a. Maybe a
Nothing
zdiv x :: a
x y :: a
y = a -> Maybe a
forall a. a -> Maybe a
Just (a -> Maybe a) -> a -> Maybe a
forall a b. (a -> b) -> a -> b
$ a
x a -> a -> a
forall a. Integral a => a -> a -> a
`div` a
y
vInc :: Vec -> Vec -> Vec
vInc :: [Count] -> [Count] -> [Count]
vInc lim :: [Count]
lim v :: [Count]
v = [Count] -> [Count]
forall a. [a] -> [a]
reverse ([Count] -> [Count] -> [Count]
forall a. (Num a, Ord a) => [a] -> [a] -> [a]
vInc' ([Count] -> [Count]
forall a. [a] -> [a]
reverse [Count]
lim) ([Count] -> [Count]
forall a. [a] -> [a]
reverse [Count]
v))
where vInc' :: [a] -> [a] -> [a]
vInc' _ [] = []
vInc' [] (x :: a
x:xs :: [a]
xs) = a
xa -> a -> a
forall a. Num a => a -> a -> a
+1 a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
xs
vInc' (l :: a
l:ls :: [a]
ls) (x :: a
x:xs :: [a]
xs) | a
x a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< a
l = a
xa -> a -> a
forall a. Num a => a -> a -> a
+1 a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
xs
| Bool
otherwise = 0 a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a] -> [a] -> [a]
vInc' [a]
ls [a]
xs
vPartitions :: Vec -> [Multiset Vec]
vPartitions :: [Count] -> [Multiset [Count]]
vPartitions v :: [Count]
v = [Count] -> [Count] -> [Multiset [Count]]
vPart [Count]
v ([Count] -> [Count]
vZero [Count]
v) where
vPart :: [Count] -> [Count] -> [Multiset [Count]]
vPart v :: [Count]
v _ | [Count] -> Bool
vIsZero [Count]
v = [[([Count], Count)] -> Multiset [Count]
forall a. [(a, Count)] -> Multiset a
MS []]
vPart v :: [Count]
v vL :: [Count]
vL
| [Count]
v [Count] -> [Count] -> Bool
forall a. Ord a => a -> a -> Bool
<= [Count]
vL = []
| Bool
otherwise = [([Count], Count)] -> Multiset [Count]
forall a. [(a, Count)] -> Multiset a
MS [([Count]
v,1)]
Multiset [Count] -> [Multiset [Count]] -> [Multiset [Count]]
forall a. a -> [a] -> [a]
: [ ([Count]
v',Count
k) ([Count], Count) -> Multiset [Count] -> Multiset [Count]
forall a. (a, Count) -> Multiset a -> Multiset a
+: Multiset [Count]
p' | [Count]
v' <- [Count] -> [Count] -> [Count] -> [[Count]]
withinFromTo [Count]
v ([Count] -> [Count]
vHalf [Count]
v) ([Count] -> [Count] -> [Count]
vInc [Count]
v [Count]
vL)
, Count
k <- [1 .. ([Count]
v [Count] -> [Count] -> Count
`vDiv` [Count]
v')]
, Multiset [Count]
p' <- [Count] -> [Count] -> [Multiset [Count]]
vPart ([Count]
v [Count] -> [Count] -> [Count]
.-. (Count
k Count -> [Count] -> [Count]
*. [Count]
v')) [Count]
v' ]
vHalf :: Vec -> Vec
vHalf :: [Count] -> [Count]
vHalf [] = []
vHalf (x :: Count
x:xs :: [Count]
xs) | (Count -> Bool
forall a. Integral a => a -> Bool
even Count
x) = (Count
x Count -> Count -> Count
forall a. Integral a => a -> a -> a
`div` 2) Count -> [Count] -> [Count]
forall a. a -> [a] -> [a]
: [Count] -> [Count]
vHalf [Count]
xs
| Bool
otherwise = (Count
x Count -> Count -> Count
forall a. Integral a => a -> a -> a
`div` 2) Count -> [Count] -> [Count]
forall a. a -> [a] -> [a]
: [Count]
xs
downFrom :: a -> [a]
downFrom n :: a
n = [a
n,(a
na -> a -> a
forall a. Num a => a -> a -> a
-1)..0]
within :: Vec -> [Vec]
within :: [Count] -> [[Count]]
within = [[Count]] -> [[Count]]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence ([[Count]] -> [[Count]])
-> ([Count] -> [[Count]]) -> [Count] -> [[Count]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Count -> [Count]) -> [Count] -> [[Count]]
forall a b. (a -> b) -> [a] -> [b]
map Count -> [Count]
forall a. (Num a, Enum a) => a -> [a]
downFrom
clip :: Vec -> Vec -> Vec
clip :: [Count] -> [Count] -> [Count]
clip = (Count -> Count -> Count) -> [Count] -> [Count] -> [Count]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Count -> Count -> Count
forall a. Ord a => a -> a -> a
min
withinFromTo :: Vec -> Vec -> Vec -> [Vec]
withinFromTo :: [Count] -> [Count] -> [Count] -> [[Count]]
withinFromTo m :: [Count]
m s :: [Count]
s e :: [Count]
e | Bool -> Bool
not ([Count]
s [Count] -> [Count] -> Bool
<|= [Count]
m) = [Count] -> [Count] -> [Count] -> [[Count]]
withinFromTo [Count]
m ([Count] -> [Count] -> [Count]
clip [Count]
m [Count]
s) [Count]
e
withinFromTo m :: [Count]
m s :: [Count]
s e :: [Count]
e | [Count]
e [Count] -> [Count] -> Bool
forall a. Ord a => a -> a -> Bool
> [Count]
s = []
withinFromTo m :: [Count]
m s :: [Count]
s e :: [Count]
e = [Count] -> [Count] -> [Count] -> Bool -> Bool -> [[Count]]
forall a.
(Enum a, Num a, Eq a) =>
[a] -> [a] -> [a] -> Bool -> Bool -> [[a]]
wFT [Count]
m [Count]
s [Count]
e Bool
True Bool
True
where
wFT :: [a] -> [a] -> [a] -> Bool -> Bool -> [[a]]
wFT [] _ _ _ _ = [[]]
wFT (m :: a
m:ms :: [a]
ms) (s :: a
s:ss :: [a]
ss) (e :: a
e:es :: [a]
es) useS :: Bool
useS useE :: Bool
useE =
let start :: a
start = if Bool
useS then a
s else a
m
end :: a
end = if Bool
useE then a
e else 0
in
[a
xa -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
xs | a
x <- [a
start,(a
starta -> a -> a
forall a. Num a => a -> a -> a
-1)..a
end],
let useS' :: Bool
useS' = Bool
useS Bool -> Bool -> Bool
&& a
xa -> a -> Bool
forall a. Eq a => a -> a -> Bool
==a
s,
let useE' :: Bool
useE' = Bool
useE Bool -> Bool -> Bool
&& a
xa -> a -> Bool
forall a. Eq a => a -> a -> Bool
==a
e,
[a]
xs <- [a] -> [a] -> [a] -> Bool -> Bool -> [[a]]
wFT [a]
ms [a]
ss [a]
es Bool
useS' Bool
useE' ]
partitions :: Multiset a -> [Multiset (Multiset a)]
partitions :: Multiset a -> [Multiset (Multiset a)]
partitions (MS []) = [[(Multiset a, Count)] -> Multiset (Multiset a)
forall a. [(a, Count)] -> Multiset a
MS []]
partitions (MS m :: [(a, Count)]
m) = ((Multiset [Count] -> Multiset (Multiset a))
-> [Multiset [Count]] -> [Multiset (Multiset a)]
forall a b. (a -> b) -> [a] -> [b]
map ((Multiset [Count] -> Multiset (Multiset a))
-> [Multiset [Count]] -> [Multiset (Multiset a)])
-> (([Count] -> Multiset a)
-> Multiset [Count] -> Multiset (Multiset a))
-> ([Count] -> Multiset a)
-> [Multiset [Count]]
-> [Multiset (Multiset a)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Count] -> Multiset a)
-> Multiset [Count] -> Multiset (Multiset a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap) ([a] -> [Count] -> Multiset a
forall a. [a] -> [Count] -> Multiset a
combine [a]
elts) ([Multiset [Count]] -> [Multiset (Multiset a)])
-> [Multiset [Count]] -> [Multiset (Multiset a)]
forall a b. (a -> b) -> a -> b
$ [Count] -> [Multiset [Count]]
vPartitions [Count]
counts
where (elts :: [a]
elts, counts :: [Count]
counts) = [(a, Count)] -> ([a], [Count])
forall a b. [(a, b)] -> ([a], [b])
unzip [(a, Count)]
m
combine :: [a] -> [Count] -> Multiset a
combine es :: [a]
es cs :: [Count]
cs = [(a, Count)] -> Multiset a
forall a. [(a, Count)] -> Multiset a
MS ([(a, Count)] -> Multiset a)
-> ([(a, Count)] -> [(a, Count)]) -> [(a, Count)] -> Multiset a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((a, Count) -> Bool) -> [(a, Count)] -> [(a, Count)]
forall a. (a -> Bool) -> [a] -> [a]
filter ((Count -> Count -> Bool
forall a. Eq a => a -> a -> Bool
/=0) (Count -> Bool) -> ((a, Count) -> Count) -> (a, Count) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a, Count) -> Count
forall a b. (a, b) -> b
snd) ([(a, Count)] -> Multiset a) -> [(a, Count)] -> Multiset a
forall a b. (a -> b) -> a -> b
$ [a] -> [Count] -> [(a, Count)]
forall a b. [a] -> [b] -> [(a, b)]
zip [a]
es [Count]
cs
splits :: Multiset a -> [(Multiset a, Multiset a)]
splits :: Multiset a -> [(Multiset a, Multiset a)]
splits (MS []) = [([(a, Count)] -> Multiset a
forall a. [(a, Count)] -> Multiset a
MS [], [(a, Count)] -> Multiset a
forall a. [(a, Count)] -> Multiset a
MS [])]
splits (MS ((x :: a
x,n :: Count
n):m :: [(a, Count)]
m)) =
[Count]
-> (Count -> [(Multiset a, Multiset a)])
-> [(Multiset a, Multiset a)]
forall a b. [a] -> (a -> [b]) -> [b]
for [0..Count
n] ((Count -> [(Multiset a, Multiset a)])
-> [(Multiset a, Multiset a)])
-> (Count -> [(Multiset a, Multiset a)])
-> [(Multiset a, Multiset a)]
forall a b. (a -> b) -> a -> b
$ \k :: Count
k ->
((Multiset a, Multiset a) -> (Multiset a, Multiset a))
-> [(Multiset a, Multiset a)] -> [(Multiset a, Multiset a)]
forall a b. (a -> b) -> [a] -> [b]
map (a -> Count -> Multiset a -> Multiset a
forall a. a -> Count -> Multiset a -> Multiset a
addElt a
x Count
k (Multiset a -> Multiset a)
-> (Multiset a -> Multiset a)
-> (Multiset a, Multiset a)
-> (Multiset a, Multiset a)
forall (a :: * -> * -> *) b c b' c'.
Arrow a =>
a b c -> a b' c' -> a (b, b') (c, c')
*** a -> Count -> Multiset a -> Multiset a
forall a. a -> Count -> Multiset a -> Multiset a
addElt a
x (Count
nCount -> Count -> Count
forall a. Num a => a -> a -> a
-Count
k)) (Multiset a -> [(Multiset a, Multiset a)]
forall a. Multiset a -> [(Multiset a, Multiset a)]
splits ([(a, Count)] -> Multiset a
forall a. [(a, Count)] -> Multiset a
MS [(a, Count)]
m))
kSubsets :: Count -> Multiset a -> [Multiset a]
kSubsets :: Count -> Multiset a -> [Multiset a]
kSubsets 0 _ = [[(a, Count)] -> Multiset a
forall a. [(a, Count)] -> Multiset a
MS []]
kSubsets _ (MS []) = []
kSubsets k :: Count
k (MS ((x :: a
x,n :: Count
n):m :: [(a, Count)]
m)) =
[Count] -> (Count -> [Multiset a]) -> [Multiset a]
forall a b. [a] -> (a -> [b]) -> [b]
for [0 .. Count -> Count -> Count
forall a. Ord a => a -> a -> a
min Count
k Count
n] ((Count -> [Multiset a]) -> [Multiset a])
-> (Count -> [Multiset a]) -> [Multiset a]
forall a b. (a -> b) -> a -> b
$ \j :: Count
j ->
(Multiset a -> Multiset a) -> [Multiset a] -> [Multiset a]
forall a b. (a -> b) -> [a] -> [b]
map (a -> Count -> Multiset a -> Multiset a
forall a. a -> Count -> Multiset a -> Multiset a
addElt a
x Count
j) (Count -> Multiset a -> [Multiset a]
forall a. Count -> Multiset a -> [Multiset a]
kSubsets (Count
k Count -> Count -> Count
forall a. Num a => a -> a -> a
- Count
j) ([(a, Count)] -> Multiset a
forall a. [(a, Count)] -> Multiset a
MS [(a, Count)]
m))
for :: [a] -> (a -> [b]) -> [b]
for = ((a -> [b]) -> [a] -> [b]) -> [a] -> (a -> [b]) -> [b]
forall a b c. (a -> b -> c) -> b -> a -> c
flip (a -> [b]) -> [a] -> [b]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap
addElt :: a -> Count -> Multiset a -> Multiset a
addElt _ 0 = Multiset a -> Multiset a
forall a. a -> a
id
addElt x :: a
x k :: Count
k = ((a
x,Count
k) (a, Count) -> Multiset a -> Multiset a
forall a. (a, Count) -> Multiset a -> Multiset a
+:)
cycles :: Multiset a -> [[a]]
cycles :: Multiset a -> [[a]]
cycles (MS []) = []
cycles m :: Multiset a
m@(MS ((x1 :: a
x1,n1 :: Count
n1):xs :: [(a, Count)]
xs))
| Count
n1 Count -> Count -> Bool
forall a. Eq a => a -> a -> Bool
== 1 = (Count
-> Count -> Count -> [(Count, a)] -> [(Count, (a, Count))] -> [[a]]
forall a.
Count
-> Count -> Count -> [(Count, a)] -> [(Count, (a, Count))] -> [[a]]
cycles' Count
n 2 1 [(0,a
x1)] ([(Count, (a, Count))] -> [(Count, (a, Count))]
forall a. [a] -> [a]
reverse ([(Count, (a, Count))] -> [(Count, (a, Count))])
-> [(Count, (a, Count))] -> [(Count, (a, Count))]
forall a b. (a -> b) -> a -> b
$ [Count] -> [(a, Count)] -> [(Count, (a, Count))]
forall a b. [a] -> [b] -> [(a, b)]
zip [1..] [(a, Count)]
xs))
| Bool
otherwise = (Count
-> Count -> Count -> [(Count, a)] -> [(Count, (a, Count))] -> [[a]]
forall a.
Count
-> Count -> Count -> [(Count, a)] -> [(Count, (a, Count))] -> [[a]]
cycles' Count
n 2 1 [(0,a
x1)] ([(Count, (a, Count))] -> [(Count, (a, Count))]
forall a. [a] -> [a]
reverse ([(Count, (a, Count))] -> [(Count, (a, Count))])
-> [(Count, (a, Count))] -> [(Count, (a, Count))]
forall a b. (a -> b) -> a -> b
$ [Count] -> [(a, Count)] -> [(Count, (a, Count))]
forall a b. [a] -> [b] -> [(a, b)]
zip [0..] ((a
x1,Count
n1Count -> Count -> Count
forall a. Num a => a -> a -> a
-1)(a, Count) -> [(a, Count)] -> [(a, Count)]
forall a. a -> [a] -> [a]
:[(a, Count)]
xs)))
where n :: Count
n = [Count] -> Count
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ([Count] -> Count)
-> (Multiset a -> [Count]) -> Multiset a -> Count
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Multiset a -> [Count]
forall a. Multiset a -> [Count]
getCounts (Multiset a -> Count) -> Multiset a -> Count
forall a b. (a -> b) -> a -> b
$ Multiset a
m
cycles' :: Int -> Int -> Int -> [(Int, a)] -> [(Int, (a,Count))] -> [[a]]
cycles' :: Count
-> Count -> Count -> [(Count, a)] -> [(Count, (a, Count))] -> [[a]]
cycles' n :: Count
n _ p :: Count
p pre :: [(Count, a)]
pre [] | Count
n Count -> Count -> Count
forall a. Integral a => a -> a -> a
`mod` Count
p Count -> Count -> Bool
forall a. Eq a => a -> a -> Bool
== 0 = [((Count, a) -> a) -> [(Count, a)] -> [a]
forall a b. (a -> b) -> [a] -> [b]
map (Count, a) -> a
forall a b. (a, b) -> b
snd [(Count, a)]
pre]
| Bool
otherwise = []
cycles' n :: Count
n t :: Count
t p :: Count
p pre :: [(Count, a)]
pre xs :: [(Count, (a, Count))]
xs =
(((Count, (a, Count)) -> Bool)
-> [(Count, (a, Count))] -> [(Count, (a, Count))]
forall a. (a -> Bool) -> [a] -> [a]
takeWhile ((Count -> Count -> Bool
forall a. Ord a => a -> a -> Bool
>=Count
atp) (Count -> Bool)
-> ((Count, (a, Count)) -> Count) -> (Count, (a, Count)) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Count, (a, Count)) -> Count
forall a b. (a, b) -> a
fst) [(Count, (a, Count))]
xs) [(Count, (a, Count))] -> ((Count, (a, Count)) -> [[a]]) -> [[a]]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \(j :: Count
j, (xj :: a
xj,_)) ->
Count
-> Count -> Count -> [(Count, a)] -> [(Count, (a, Count))] -> [[a]]
forall a.
Count
-> Count -> Count -> [(Count, a)] -> [(Count, (a, Count))] -> [[a]]
cycles' Count
n (Count
tCount -> Count -> Count
forall a. Num a => a -> a -> a
+1) (if Count
j Count -> Count -> Bool
forall a. Eq a => a -> a -> Bool
== Count
atp then Count
p else Count
t)
((Count
j,a
xj)(Count, a) -> [(Count, a)] -> [(Count, a)]
forall a. a -> [a] -> [a]
:[(Count, a)]
pre)
(Count -> [(Count, (a, Count))] -> [(Count, (a, Count))]
forall a. Count -> [(Count, (a, Count))] -> [(Count, (a, Count))]
remove Count
j [(Count, (a, Count))]
xs)
where atp :: Count
atp = (Count, a) -> Count
forall a b. (a, b) -> a
fst ((Count, a) -> Count) -> (Count, a) -> Count
forall a b. (a -> b) -> a -> b
$ [(Count, a)]
pre [(Count, a)] -> Count -> (Count, a)
forall a. [a] -> Count -> a
!! (Count
p Count -> Count -> Count
forall a. Num a => a -> a -> a
- 1)
remove :: Int -> [(Int, (a, Int))] -> [(Int, (a, Int))]
remove :: Count -> [(Count, (a, Count))] -> [(Count, (a, Count))]
remove _ [] = []
remove j :: Count
j (x :: (Count, (a, Count))
x@(j' :: Count
j',(xj :: a
xj,nj :: Count
nj)):xs :: [(Count, (a, Count))]
xs)
| Count
j Count -> Count -> Bool
forall a. Eq a => a -> a -> Bool
== Count
j' Bool -> Bool -> Bool
&& Count
nj Count -> Count -> Bool
forall a. Eq a => a -> a -> Bool
== 1 = [(Count, (a, Count))]
xs
| Count
j Count -> Count -> Bool
forall a. Eq a => a -> a -> Bool
== Count
j' = (Count
j',(a
xj,Count
njCount -> Count -> Count
forall a. Num a => a -> a -> a
-1))(Count, (a, Count))
-> [(Count, (a, Count))] -> [(Count, (a, Count))]
forall a. a -> [a] -> [a]
:[(Count, (a, Count))]
xs
| Bool
otherwise = (Count, (a, Count))
x(Count, (a, Count))
-> [(Count, (a, Count))] -> [(Count, (a, Count))]
forall a. a -> [a] -> [a]
:Count -> [(Count, (a, Count))] -> [(Count, (a, Count))]
forall a. Count -> [(Count, (a, Count))] -> [(Count, (a, Count))]
remove Count
j [(Count, (a, Count))]
xs
class Snocable p a where
(|>) :: p -> a -> p
class Indexable p where
(!) :: p -> Int -> Int
type PreNecklace = [Int]
data Pre = Pre !Int (Maybe Int) PreNecklace
deriving (Count -> Pre -> ShowS
[Pre] -> ShowS
Pre -> String
(Count -> Pre -> ShowS)
-> (Pre -> String) -> ([Pre] -> ShowS) -> Show Pre
forall a.
(Count -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Pre] -> ShowS
$cshowList :: [Pre] -> ShowS
show :: Pre -> String
$cshow :: Pre -> String
showsPrec :: Count -> Pre -> ShowS
$cshowsPrec :: Count -> Pre -> ShowS
Show)
emptyPre :: Pre
emptyPre :: Pre
emptyPre = Count -> Maybe Count -> [Count] -> Pre
Pre 0 Maybe Count
forall a. Maybe a
Nothing []
getPre :: Pre -> PreNecklace
getPre :: Pre -> [Count]
getPre (Pre _ _ as :: [Count]
as) = [Count] -> [Count]
forall a. [a] -> [a]
reverse [Count]
as
instance Snocable Pre Int where
(Pre 0 _ []) |> :: Pre -> Count -> Pre
|> a :: Count
a = Count -> Maybe Count -> [Count] -> Pre
Pre 1 (Count -> Maybe Count
forall a. a -> Maybe a
Just Count
a) [Count
a]
(Pre t :: Count
t a1 :: Maybe Count
a1 as :: [Count]
as) |> a :: Count
a = Count -> Maybe Count -> [Count] -> Pre
Pre (Count
tCount -> Count -> Count
forall a. Num a => a -> a -> a
+1) Maybe Count
a1 (Count
aCount -> [Count] -> [Count]
forall a. a -> [a] -> [a]
:[Count]
as)
instance Indexable Pre where
_ ! :: Pre -> Count -> Count
! 0 = 0
(Pre _ (Just a1 :: Count
a1) _) ! 1 = Count
a1
(Pre t :: Count
t _ as :: [Count]
as) ! i :: Count
i = [Count]
as [Count] -> Count -> Count
forall a. [a] -> Count -> a
!! (Count
tCount -> Count -> Count
forall a. Num a => a -> a -> a
-Count
i)
data RLE a = RLE !Int !Int [(a,Int)]
deriving (Count -> RLE a -> ShowS
[RLE a] -> ShowS
RLE a -> String
(Count -> RLE a -> ShowS)
-> (RLE a -> String) -> ([RLE a] -> ShowS) -> Show (RLE a)
forall a. Show a => Count -> RLE a -> ShowS
forall a. Show a => [RLE a] -> ShowS
forall a. Show a => RLE a -> String
forall a.
(Count -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RLE a] -> ShowS
$cshowList :: forall a. Show a => [RLE a] -> ShowS
show :: RLE a -> String
$cshow :: forall a. Show a => RLE a -> String
showsPrec :: Count -> RLE a -> ShowS
$cshowsPrec :: forall a. Show a => Count -> RLE a -> ShowS
Show)
emptyRLE :: RLE a
emptyRLE :: RLE a
emptyRLE = Count -> Count -> [(a, Count)] -> RLE a
forall a. Count -> Count -> [(a, Count)] -> RLE a
RLE 0 0 []
compareRLE :: Ord a => [(a,Int)] -> [(a,Int)] -> Ordering
compareRLE :: [(a, Count)] -> [(a, Count)] -> Ordering
compareRLE [] [] = Ordering
EQ
compareRLE [] _ = Ordering
LT
compareRLE _ [] = Ordering
GT
compareRLE ((a1 :: a
a1,n1 :: Count
n1):rle1 :: [(a, Count)]
rle1) ((a2 :: a
a2,n2 :: Count
n2):rle2 :: [(a, Count)]
rle2)
| (a
a1,Count
n1) (a, Count) -> (a, Count) -> Bool
forall a. Eq a => a -> a -> Bool
== (a
a2,Count
n2) = [(a, Count)] -> [(a, Count)] -> Ordering
forall a. Ord a => [(a, Count)] -> [(a, Count)] -> Ordering
compareRLE [(a, Count)]
rle1 [(a, Count)]
rle2
| a
a1 a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< a
a2 = Ordering
LT
| a
a1 a -> a -> Bool
forall a. Ord a => a -> a -> Bool
> a
a2 = Ordering
GT
| (Count
n1 Count -> Count -> Bool
forall a. Ord a => a -> a -> Bool
< Count
n2 Bool -> Bool -> Bool
&& ([(a, Count)] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(a, Count)]
rle1 Bool -> Bool -> Bool
|| (a, Count) -> a
forall a b. (a, b) -> a
fst ([(a, Count)] -> (a, Count)
forall a. [a] -> a
head [(a, Count)]
rle1) a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< a
a2)) Bool -> Bool -> Bool
|| (Count
n1 Count -> Count -> Bool
forall a. Ord a => a -> a -> Bool
> Count
n2 Bool -> Bool -> Bool
&& Bool -> Bool
not ([(a, Count)] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(a, Count)]
rle2) Bool -> Bool -> Bool
&& a
a1 a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< (a, Count) -> a
forall a b. (a, b) -> a
fst ([(a, Count)] -> (a, Count)
forall a. [a] -> a
head [(a, Count)]
rle2)) = Ordering
LT
| Bool
otherwise = Ordering
GT
instance Indexable (RLE Int) where
(RLE _ _ []) ! :: RLE Count -> Count -> Count
! _ = String -> Count
forall a. HasCallStack => String -> a
error "Bad index in (!) for RLE"
(RLE n :: Count
n b :: Count
b ((a :: Count
a,v :: Count
v):rest :: [(Count, Count)]
rest)) ! i :: Count
i
| Count
i Count -> Count -> Bool
forall a. Ord a => a -> a -> Bool
<= Count
v = Count
a
| Bool
otherwise = (Count -> Count -> [(Count, Count)] -> RLE Count
forall a. Count -> Count -> [(a, Count)] -> RLE a
RLE (Count
nCount -> Count -> Count
forall a. Num a => a -> a -> a
-Count
v) (Count
bCount -> Count -> Count
forall a. Num a => a -> a -> a
-1) [(Count, Count)]
rest) RLE Count -> Count -> Count
forall p. Indexable p => p -> Count -> Count
! (Count
iCount -> Count -> Count
forall a. Num a => a -> a -> a
-Count
v)
instance Eq a => Snocable (RLE a) a where
(RLE _ _ []) |> :: RLE a -> a -> RLE a
|> a' :: a
a' = Count -> Count -> [(a, Count)] -> RLE a
forall a. Count -> Count -> [(a, Count)] -> RLE a
RLE 1 1 [(a
a',1)]
(RLE n :: Count
n b :: Count
b rle :: [(a, Count)]
rle@((a :: a
a,v :: Count
v):rest :: [(a, Count)]
rest)) |> a' :: a
a'
| a
a a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
a' = Count -> Count -> [(a, Count)] -> RLE a
forall a. Count -> Count -> [(a, Count)] -> RLE a
RLE (Count
nCount -> Count -> Count
forall a. Num a => a -> a -> a
+1) Count
b ((a
a,Count
vCount -> Count -> Count
forall a. Num a => a -> a -> a
+1)(a, Count) -> [(a, Count)] -> [(a, Count)]
forall a. a -> [a] -> [a]
:[(a, Count)]
rest)
| Bool
otherwise = Count -> Count -> [(a, Count)] -> RLE a
forall a. Count -> Count -> [(a, Count)] -> RLE a
RLE (Count
nCount -> Count -> Count
forall a. Num a => a -> a -> a
+1) (Count
bCount -> Count -> Count
forall a. Num a => a -> a -> a
+1) ((a
a',1)(a, Count) -> [(a, Count)] -> [(a, Count)]
forall a. a -> [a] -> [a]
:[(a, Count)]
rle)
data Pre' = Pre' Pre (RLE Int)
deriving Count -> Pre' -> ShowS
[Pre'] -> ShowS
Pre' -> String
(Count -> Pre' -> ShowS)
-> (Pre' -> String) -> ([Pre'] -> ShowS) -> Show Pre'
forall a.
(Count -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Pre'] -> ShowS
$cshowList :: [Pre'] -> ShowS
show :: Pre' -> String
$cshow :: Pre' -> String
showsPrec :: Count -> Pre' -> ShowS
$cshowsPrec :: Count -> Pre' -> ShowS
Show
emptyPre' :: Pre'
emptyPre' :: Pre'
emptyPre' = Pre -> RLE Count -> Pre'
Pre' Pre
emptyPre RLE Count
forall a. RLE a
emptyRLE
getPre' :: Pre' -> PreNecklace
getPre' :: Pre' -> [Count]
getPre' (Pre' pre :: Pre
pre _) = Pre -> [Count]
getPre Pre
pre
instance Indexable Pre' where
_ ! :: Pre' -> Count -> Count
! 0 = 0
(Pre' (Pre len :: Count
len _ _) rle :: RLE Count
rle) ! i :: Count
i = RLE Count
rle RLE Count -> Count -> Count
forall p. Indexable p => p -> Count -> Count
! (Count
len Count -> Count -> Count
forall a. Num a => a -> a -> a
- Count
i Count -> Count -> Count
forall a. Num a => a -> a -> a
+ 1)
instance Snocable Pre' Int where
(Pre' p :: Pre
p rle :: RLE Count
rle) |> :: Pre' -> Count -> Pre'
|> a :: Count
a = Pre -> RLE Count -> Pre'
Pre' (Pre
p Pre -> Count -> Pre
forall p a. Snocable p a => p -> a -> p
|> Count
a) (RLE Count
rle RLE Count -> Count -> RLE Count
forall p a. Snocable p a => p -> a -> p
|> Count
a)
type Bracelet = [Int]
genFixedBracelets :: Int -> [(Int,Int)] -> [Bracelet]
genFixedBracelets :: Count -> [(Count, Count)] -> [[Count]]
genFixedBracelets n :: Count
n [(0,k :: Count
k)] | Count
k Count -> Count -> Bool
forall a. Ord a => a -> a -> Bool
>= Count
n = [Count -> Count -> [Count]
forall a. Count -> a -> [a]
replicate Count
k 0]
| Bool
otherwise = []
genFixedBracelets n :: Count
n content :: [(Count, Count)]
content = Writer [[Count]] () -> [[Count]]
forall w a. Writer w a -> w
execWriter (Count
-> Count -> Count -> IntMap Count -> Pre' -> Writer [[Count]] ()
go 1 1 0 ([(Count, Count)] -> IntMap Count
forall a. [(Count, a)] -> IntMap a
IM.fromList [(Count, Count)]
content) Pre'
emptyPre')
where
go :: Int -> Int -> Int -> IM.IntMap Int -> Pre' -> Writer [Bracelet] ()
go :: Count
-> Count -> Count -> IntMap Count -> Pre' -> Writer [[Count]] ()
go _ _ _ con :: IntMap Count
con _ | IntMap Count -> [Count]
forall a. IntMap a -> [Count]
IM.keys IntMap Count
con [Count] -> [Count] -> Bool
forall a. Eq a => a -> a -> Bool
== [0] = () -> Writer [[Count]] ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
go t :: Count
t p :: Count
p r :: Count
r con :: IntMap Count
con pre :: Pre'
pre@(Pre' (Pre _ _ as :: [Count]
as) _)
| Count
t Count -> Count -> Bool
forall a. Ord a => a -> a -> Bool
> Count
n =
Bool -> Writer [[Count]] () -> Writer [[Count]] ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Count -> [Count] -> [Count]
forall a. Count -> [a] -> [a]
take (Count
n Count -> Count -> Count
forall a. Num a => a -> a -> a
- Count
r) [Count]
as [Count] -> [Count] -> Bool
forall a. Ord a => a -> a -> Bool
>= [Count] -> [Count]
forall a. [a] -> [a]
reverse (Count -> [Count] -> [Count]
forall a. Count -> [a] -> [a]
take (Count
nCount -> Count -> Count
forall a. Num a => a -> a -> a
-Count
r) [Count]
as) Bool -> Bool -> Bool
&& Count
n Count -> Count -> Count
forall a. Integral a => a -> a -> a
`mod` Count
p Count -> Count -> Bool
forall a. Eq a => a -> a -> Bool
== 0) (Writer [[Count]] () -> Writer [[Count]] ())
-> Writer [[Count]] () -> Writer [[Count]] ()
forall a b. (a -> b) -> a -> b
$
[[Count]] -> Writer [[Count]] ()
forall (m :: * -> *) w. Monad m => w -> WriterT w m ()
tell [Pre' -> [Count]
getPre' Pre'
pre]
| Bool
otherwise = do
let a' :: Count
a' = Pre'
pre Pre' -> Count -> Count
forall p. Indexable p => p -> Count -> Count
! (Count
tCount -> Count -> Count
forall a. Num a => a -> a -> a
-Count
p)
[Count] -> (Count -> Writer [[Count]] ()) -> Writer [[Count]] ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ ((Count -> Bool) -> [Count] -> [Count]
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (Count -> Count -> Bool
forall a. Ord a => a -> a -> Bool
< Count
a') ([Count] -> [Count]) -> [Count] -> [Count]
forall a b. (a -> b) -> a -> b
$ IntMap Count -> [Count]
forall a. IntMap a -> [Count]
IM.keys IntMap Count
con) ((Count -> Writer [[Count]] ()) -> Writer [[Count]] ())
-> (Count -> Writer [[Count]] ()) -> Writer [[Count]] ()
forall a b. (a -> b) -> a -> b
$ \j :: Count
j -> do
let con' :: IntMap Count
con' = Count -> IntMap Count -> IntMap Count
decrease Count
j IntMap Count
con
pre' :: Pre'
pre' = Pre'
pre Pre' -> Count -> Pre'
forall p a. Snocable p a => p -> a -> p
|> Count
j
c :: Ordering
c = Count -> Pre' -> Ordering
forall p. p -> Pre' -> Ordering
checkRev2 Count
t Pre'
pre'
p' :: Count
p' | Count
j Count -> Count -> Bool
forall a. Eq a => a -> a -> Bool
/= Count
a' = Count
t
| Bool
otherwise = Count
p
Bool -> Writer [[Count]] () -> Writer [[Count]] ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Ordering
c Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
== Ordering
EQ) (Writer [[Count]] () -> Writer [[Count]] ())
-> Writer [[Count]] () -> Writer [[Count]] ()
forall a b. (a -> b) -> a -> b
$ Count
-> Count -> Count -> IntMap Count -> Pre' -> Writer [[Count]] ()
go (Count
tCount -> Count -> Count
forall a. Num a => a -> a -> a
+1) Count
p' Count
t IntMap Count
con' Pre'
pre'
Bool -> Writer [[Count]] () -> Writer [[Count]] ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Ordering
c Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
== Ordering
GT) (Writer [[Count]] () -> Writer [[Count]] ())
-> Writer [[Count]] () -> Writer [[Count]] ()
forall a b. (a -> b) -> a -> b
$ Count
-> Count -> Count -> IntMap Count -> Pre' -> Writer [[Count]] ()
go (Count
tCount -> Count -> Count
forall a. Num a => a -> a -> a
+1) Count
p' Count
r IntMap Count
con' Pre'
pre'
decrease :: Int -> IM.IntMap Int -> IM.IntMap Int
decrease :: Count -> IntMap Count -> IntMap Count
decrease j :: Count
j con :: IntMap Count
con
| IntMap Count -> Bool
forall a. IntMap a -> Bool
IM.null IntMap Count
con = IntMap Count
con
| Bool
otherwise = (Maybe Count -> Maybe Count)
-> Count -> IntMap Count -> IntMap Count
forall a. (Maybe a -> Maybe a) -> Count -> IntMap a -> IntMap a
IM.alter Maybe Count -> Maybe Count
forall a. (Eq a, Num a) => Maybe a -> Maybe a
q Count
j IntMap Count
con
where
q :: Maybe a -> Maybe a
q (Just 1) = Maybe a
forall a. Maybe a
Nothing
q (Just cnt :: a
cnt) = a -> Maybe a
forall a. a -> Maybe a
Just (a
cnta -> a -> a
forall a. Num a => a -> a -> a
-1)
q _ = Maybe a
forall a. Maybe a
Nothing
checkRev2 :: p -> Pre' -> Ordering
checkRev2 _ (Pre' _ (RLE _ _ rle :: [(Count, Count)]
rle)) = [(Count, Count)] -> [(Count, Count)] -> Ordering
forall a. Ord a => [(a, Count)] -> [(a, Count)] -> Ordering
compareRLE [(Count, Count)]
rle ([(Count, Count)] -> [(Count, Count)]
forall a. [a] -> [a]
reverse [(Count, Count)]
rle)
bracelets :: Multiset a -> [[a]]
bracelets :: Multiset a -> [[a]]
bracelets ms :: Multiset a
ms@(MS cnts :: [(a, Count)]
cnts) = [[a]]
bs
where
contentMap :: IntMap a
contentMap = [(Count, a)] -> IntMap a
forall a. [(Count, a)] -> IntMap a
IM.fromList ([Count] -> [a] -> [(Count, a)]
forall a b. [a] -> [b] -> [(a, b)]
zip [0..] (((a, Count) -> a) -> [(a, Count)] -> [a]
forall a b. (a -> b) -> [a] -> [b]
map (a, Count) -> a
forall a b. (a, b) -> a
fst [(a, Count)]
cnts))
content :: [(Count, Count)]
content = (Count -> (a, Count) -> (Count, Count))
-> [Count] -> [(a, Count)] -> [(Count, Count)]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (\i :: Count
i (_,n :: Count
n) -> (Count
i,Count
n)) [0..] [(a, Count)]
cnts
rawBs :: [[Count]]
rawBs = Count -> [(Count, Count)] -> [[Count]]
genFixedBracelets (Multiset a -> Count
forall a. Multiset a -> Count
size Multiset a
ms) [(Count, Count)]
content
bs :: [[a]]
bs = ([Count] -> [a]) -> [[Count]] -> [[a]]
forall a b. (a -> b) -> [a] -> [b]
map ((Count -> a) -> [Count] -> [a]
forall a b. (a -> b) -> [a] -> [b]
map (Maybe a -> a
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe a -> a) -> (Count -> Maybe a) -> Count -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Count -> IntMap a -> Maybe a) -> IntMap a -> Count -> Maybe a
forall a b c. (a -> b -> c) -> b -> a -> c
flip Count -> IntMap a -> Maybe a
forall a. Count -> IntMap a -> Maybe a
IM.lookup IntMap a
contentMap)) [[Count]]
rawBs
sequenceMS :: Multiset [a] -> [Multiset a]
sequenceMS :: Multiset [a] -> [Multiset a]
sequenceMS = ([Multiset a] -> Multiset a) -> [[Multiset a]] -> [Multiset a]
forall a b. (a -> b) -> [a] -> [b]
map [Multiset a] -> Multiset a
forall a. [Multiset a] -> Multiset a
disjUnions
([[Multiset a]] -> [Multiset a])
-> (Multiset [a] -> [[Multiset a]]) -> Multiset [a] -> [Multiset a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[Multiset a]] -> [[Multiset a]]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence
([[Multiset a]] -> [[Multiset a]])
-> (Multiset [a] -> [[Multiset a]])
-> Multiset [a]
-> [[Multiset a]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (([a], Count) -> [Multiset a]) -> [([a], Count)] -> [[Multiset a]]
forall a b. (a -> b) -> [a] -> [b]
map (\(xs :: [a]
xs, n :: Count
n) -> Count -> Multiset a -> [Multiset a]
forall a. Count -> Multiset a -> [Multiset a]
kSubsets Count
n ([(a, Count)] -> Multiset a
forall a. [(a, Count)] -> Multiset a
MS ([(a, Count)] -> Multiset a) -> [(a, Count)] -> Multiset a
forall a b. (a -> b) -> a -> b
$ ([a], Count) -> [(a, Count)]
forall a. ([a], Count) -> [(a, Count)]
uncollate ([a]
xs, Count
n)))
([([a], Count)] -> [[Multiset a]])
-> (Multiset [a] -> [([a], Count)])
-> Multiset [a]
-> [[Multiset a]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Multiset [a] -> [([a], Count)]
forall a. Multiset a -> [(a, Count)]
toCounts
uncollate :: ([a], Count) -> [(a, Count)]
uncollate :: ([a], Count) -> [(a, Count)]
uncollate (xs :: [a]
xs, n :: Count
n) = (a -> (a, Count)) -> [a] -> [(a, Count)]
forall a b. (a -> b) -> [a] -> [b]
map (\x :: a
x -> (a
x,Count
n)) [a]
xs