{-# LANGUAGE ScopedTypeVariables #-} {-# OPTIONS_GHC -fno-full-laziness -funbox-strict-fields #-} -- | Extra list functions -- -- In separate module to aid testing. module Data.HashMap.List ( isPermutationBy , deleteBy , unorderedCompare ) where import Data.Maybe (fromMaybe) import Data.List (sortBy) import Data.Monoid import Prelude -- Note: previous implemenation isPermutation = null (as // bs) -- was O(n^2) too. -- -- This assumes lists are of equal length isPermutationBy :: (a -> b -> Bool) -> [a] -> [b] -> Bool isPermutationBy :: (a -> b -> Bool) -> [a] -> [b] -> Bool isPermutationBy a -> b -> Bool f = [a] -> [b] -> Bool go where f' :: b -> a -> Bool f' = (a -> b -> Bool) -> b -> a -> Bool forall a b c. (a -> b -> c) -> b -> a -> c flip a -> b -> Bool f go :: [a] -> [b] -> Bool go [] [] = Bool True go (a x : [a] xs) (b y : [b] ys) | a -> b -> Bool f a x b y = [a] -> [b] -> Bool go [a] xs [b] ys | Bool otherwise = Bool -> Maybe Bool -> Bool forall a. a -> Maybe a -> a fromMaybe Bool False (Maybe Bool -> Bool) -> Maybe Bool -> Bool forall a b. (a -> b) -> a -> b $ do [a] xs' <- (b -> a -> Bool) -> b -> [a] -> Maybe [a] forall a b. (a -> b -> Bool) -> a -> [b] -> Maybe [b] deleteBy b -> a -> Bool f' b y [a] xs [b] ys' <- (a -> b -> Bool) -> a -> [b] -> Maybe [b] forall a b. (a -> b -> Bool) -> a -> [b] -> Maybe [b] deleteBy a -> b -> Bool f a x [b] ys Bool -> Maybe Bool forall (m :: * -> *) a. Monad m => a -> m a return ([a] -> [b] -> Bool go [a] xs' [b] ys') go [] (b _ : [b] _) = Bool False go (a _ : [a] _) [] = Bool False -- The idea: -- -- Homogeonous version -- -- uc :: (a -> a -> Ordering) -> [a] -> [a] -> Ordering -- uc c as bs = compare (sortBy c as) (sortBy c bs) -- -- But as we have only (a -> b -> Ordering), we cannot directly compare -- elements from the same list. -- -- So when comparing elements from the list, we count how many elements are -- "less and greater" in the other list, and use the count as a metric. -- unorderedCompare :: (a -> b -> Ordering) -> [a] -> [b] -> Ordering unorderedCompare :: (a -> b -> Ordering) -> [a] -> [b] -> Ordering unorderedCompare a -> b -> Ordering c [a] as [b] bs = [a] -> [b] -> Ordering go ((a -> a -> Ordering) -> [a] -> [a] forall a. (a -> a -> Ordering) -> [a] -> [a] sortBy a -> a -> Ordering cmpA [a] as) ((b -> b -> Ordering) -> [b] -> [b] forall a. (a -> a -> Ordering) -> [a] -> [a] sortBy b -> b -> Ordering cmpB [b] bs) where go :: [a] -> [b] -> Ordering go [] [] = Ordering EQ go [] (b _ : [b] _) = Ordering LT go (a _ : [a] _) [] = Ordering GT go (a x : [a] xs) (b y : [b] ys) = a -> b -> Ordering c a x b y Ordering -> Ordering -> Ordering forall a. Monoid a => a -> a -> a `mappend` [a] -> [b] -> Ordering go [a] xs [b] ys cmpA :: a -> a -> Ordering cmpA a a a a' = (Int, Int) -> (Int, Int) -> Ordering forall a. Ord a => a -> a -> Ordering compare (a -> (Int, Int) inB a a) (a -> (Int, Int) inB a a') cmpB :: b -> b -> Ordering cmpB b b b b' = (Int, Int) -> (Int, Int) -> Ordering forall a. Ord a => a -> a -> Ordering compare (b -> (Int, Int) inA b b) (b -> (Int, Int) inA b b') inB :: a -> (Int, Int) inB a a = ([b] -> Int forall (t :: * -> *) a. Foldable t => t a -> Int length ([b] -> Int) -> [b] -> Int forall a b. (a -> b) -> a -> b $ (b -> Bool) -> [b] -> [b] forall a. (a -> Bool) -> [a] -> [a] filter (\b b -> a -> b -> Ordering c a a b b Ordering -> Ordering -> Bool forall a. Eq a => a -> a -> Bool == Ordering GT) [b] bs, Int -> Int forall a. Num a => a -> a negate (Int -> Int) -> Int -> Int forall a b. (a -> b) -> a -> b $ [b] -> Int forall (t :: * -> *) a. Foldable t => t a -> Int length ([b] -> Int) -> [b] -> Int forall a b. (a -> b) -> a -> b $ (b -> Bool) -> [b] -> [b] forall a. (a -> Bool) -> [a] -> [a] filter (\b b -> a -> b -> Ordering c a a b b Ordering -> Ordering -> Bool forall a. Eq a => a -> a -> Bool == Ordering LT) [b] bs) inA :: b -> (Int, Int) inA b b = ([a] -> Int forall (t :: * -> *) a. Foldable t => t a -> Int length ([a] -> Int) -> [a] -> Int forall a b. (a -> b) -> a -> b $ (a -> Bool) -> [a] -> [a] forall a. (a -> Bool) -> [a] -> [a] filter (\a a -> a -> b -> Ordering c a a b b Ordering -> Ordering -> Bool forall a. Eq a => a -> a -> Bool == Ordering LT) [a] as, Int -> Int forall a. Num a => a -> a negate (Int -> Int) -> Int -> Int forall a b. (a -> b) -> a -> b $ [a] -> Int forall (t :: * -> *) a. Foldable t => t a -> Int length ([a] -> Int) -> [a] -> Int forall a b. (a -> b) -> a -> b $ (a -> Bool) -> [a] -> [a] forall a. (a -> Bool) -> [a] -> [a] filter (\a a -> a -> b -> Ordering c a a b b Ordering -> Ordering -> Bool forall a. Eq a => a -> a -> Bool == Ordering GT) [a] as) -- Returns Nothing is nothing deleted deleteBy :: (a -> b -> Bool) -> a -> [b] -> Maybe [b] deleteBy :: (a -> b -> Bool) -> a -> [b] -> Maybe [b] deleteBy a -> b -> Bool _ a _ [] = Maybe [b] forall a. Maybe a Nothing deleteBy a -> b -> Bool eq a x (b y:[b] ys) = if a x a -> b -> Bool `eq` b y then [b] -> Maybe [b] forall a. a -> Maybe a Just [b] ys else ([b] -> [b]) -> Maybe [b] -> Maybe [b] forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b fmap (b y b -> [b] -> [b] forall a. a -> [a] -> [a] :) ((a -> b -> Bool) -> a -> [b] -> Maybe [b] forall a b. (a -> b -> Bool) -> a -> [b] -> Maybe [b] deleteBy a -> b -> Bool eq a x [b] ys)