module SmartGroup (groupAll, groupNum, groupLog) where
import Data.Heap as Heap
import Data.Set as Set
import Data.Map as Map
import Data.Monoid
import Data.Ord
data StringL = StringL {str :: String, count :: Int} deriving (Eq, Show)
instance Ord StringL where compare (StringL i a) (StringL x b) = compare a b `mappend` compare i x
data SizeMap a = Unsplittable (Set a) | Splittable (Map StringL (Set a)) deriving (Eq, Show)
instance Ord s => Ord (SizeMap s) where
compare (Splittable a) (Splittable b) = compare (Map.size a) (Map.size b)
compare (Unsplittable a) (Unsplittable b) = compare a b
compare (Unsplittable _) (Splittable _) = LT
compare (Splittable _) (Unsplittable _) = GT
type WordAssoc a = MaxHeap (SizeMap a)
toSet (Unsplittable x) = x
toSet (Splittable x) = Set.unions (Map.elems x)
intLog :: Int -> Int
intLog = truncate . logBase 2 . fromIntegral
groupWith :: Ord a => (Int -> WordAssoc a -> WordAssoc a) -> Int -> (a -> String) -> [a] -> [[a]]
groupWith f i c = mkList . f i . mkAssoc . mkMap c
groupAll :: Ord a => Int -> (a -> String) -> [a] -> [[a]]
groupAll = groupWith $ \i x->
let cycleSplit n = case splitIt i n of
(Just a) -> cycleSplit a
Nothing -> n
in cycleSplit x
groupNum :: Ord a => Int -> Int -> (a -> String) -> [a] -> [[a]]
groupNum i = groupWith $ \x->
let splitTimes n m =
if Heap.size m >= n then m else
case splitIt x m of
(Just a) -> splitTimes n a
Nothing -> m
in splitTimes i
groupLog :: Ord a => Int -> (a -> String) -> [a] -> [[a]]
groupLog i f s = groupNum (intLog (length s)) i f s
mkMap :: Ord a => (a -> String) -> [a] -> Map String (Set a)
mkMap f = foldl (\m x->
foldl (\m' i-> if length i > 3
then Map.alter (Just . maybe (Set.singleton x) (Set.insert x)) i m' else m')
m (words $ f x)) Map.empty
mkAssoc :: Ord a => Map String (Set a) -> MaxHeap (SizeMap a)
mkAssoc m = Heap.singleton . Splittable . Map.mapKeys (\k-> StringL k (Set.size (m Map.! k))) $ m
splitIt :: Ord a => Int -> WordAssoc a -> Maybe (WordAssoc a)
splitIt i s = case Heap.view s of
(Just ((Unsplittable _),_)) -> Nothing
(Just ((Splittable x),xs)) ->
let
(Just (as,b)) = Map.maxView x
x1 = sizeMap i $ flip Map.mapMaybe b $ \n->
let m = Set.difference n as
in if Set.null m then Nothing else Just m
x2 = sizeMap i $ flip Map.mapMaybe b $ \n->
let m = Set.intersection n as
in if Set.null m then Nothing else Just m
x3 = as Set.\\ (Set.unions (Map.elems b))
in Just $ (if Set.null x3 then id else Heap.insert (Unsplittable x3)) $
Heap.insert x1 $ Heap.insert x2 xs
sizeMap :: Ord a => Int -> (Map StringL (Set a)) -> (SizeMap a)
sizeMap i m = case Map.findMax m of
(StringL _ c,_) -> if c >= i then Splittable m
else Unsplittable (Set.unions (Map.elems m))
mkList :: Ord a => WordAssoc a -> [[a]]
mkList = Prelude.map (Set.toList . toSet) . Heap.toList