{-# LANGUAGE ScopedTypeVariables #-}
{-# OPTIONS_GHC -fno-full-laziness -funbox-strict-fields #-}
module Data.HashMap.List
( isPermutationBy
, deleteBy
, unorderedCompare
) where
import Data.Maybe (fromMaybe)
import Data.List (sortBy)
import Data.Monoid
import Prelude
isPermutationBy :: (a -> b -> Bool) -> [a] -> [b] -> Bool
isPermutationBy f = go
where
f' = flip f
go [] [] = True
go (x : xs) (y : ys)
| f x y = go xs ys
| otherwise = fromMaybe False $ do
xs' <- deleteBy f' y xs
ys' <- deleteBy f x ys
return (go xs' ys')
go [] (_ : _) = False
go (_ : _) [] = False
unorderedCompare :: (a -> b -> Ordering) -> [a] -> [b] -> Ordering
unorderedCompare c as bs = go (sortBy cmpA as) (sortBy cmpB bs)
where
go [] [] = EQ
go [] (_ : _) = LT
go (_ : _) [] = GT
go (x : xs) (y : ys) = c x y `mappend` go xs ys
cmpA a a' = compare (inB a) (inB a')
cmpB b b' = compare (inA b) (inA b')
inB a = (length $ filter (\b -> c a b == GT) bs, negate $ length $ filter (\b -> c a b == LT) bs)
inA b = (length $ filter (\a -> c a b == LT) as, negate $ length $ filter (\a -> c a b == GT) as)
deleteBy :: (a -> b -> Bool) -> a -> [b] -> Maybe [b]
deleteBy _ _ [] = Nothing
deleteBy eq x (y:ys) = if x `eq` y then Just ys else fmap (y :) (deleteBy eq x ys)