Skip to content

Instantly share code, notes, and snippets.

@fizbin fizbin/util.hs
Last active Aug 29, 2015

Embed
What would you like to do?
Some simple haskell utilities
import qualified Data.Map.Strict as M
-- The code in any functions here should be too small to really be coverable by copyright, but just in case:
{-
Copyright 2014 Daniel Martin
I, Daniel Martin, license this to you under the Apache License, Version 2.0 (the
"License"); you may not use this file except in compliance
with the License. You may obtain a copy of the License at
http://www.apache.org/licenses/LICENSE-2.0
Unless required by applicable law or agreed to in writing,
software distributed under the License is distributed on an
"AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY
KIND, either express or implied. See the License for the
specific language governing permissions and limitations
under the License.
-}
{- Basically, anything in this file should be copied and pasted freely.
CAVEAT USER: Don't credit me when you find it useful, and don't blame me when it
doesn't work as expected. -}
-- | Finds those 'a's in the given 'lst' that result in the same thing when
-- passed to 'f'. It is a more efficient version of
-- '\f lst -> filter ((>= 2) . length) $ groupWith f lst'
duplicatesBy :: Ord b => (a -> b) -> [a] -> [[a]]
duplicatesBy f lst = -- filter ((>= 2) . length) $ groupWith f lst
M.elems $ snd $ foldr pushMap (M.empty, M.empty) lst
where
pushMap thing (mapA, mapB) = let
fval = f thing
in case M.lookup fval mapA of
Nothing -> (M.insert fval thing mapA, mapB)
Just thing' ->
(mapA, M.insert fval
(thing : M.findWithDefault [thing'] fval mapB) mapB)
-- | Finds those 'a's in the given 'lst' that result in a unique value when
-- passed to 'f'. It is a more efficient version of
-- '\f lst -> filter ((< 2) . length) $ groupWith f lst'
uniquesBy :: Ord b => (a -> b) -> [a] -> [a]
uniquesBy f lst = -- filter ((< 2) . length) $ groupWith f lst
M.elems $ uncurry (M.differenceWith (\_ _ -> Nothing)) $
foldl' pushMap (M.empty, M.empty) lst
where
pushMap (mapA, mapB) thing = let
fval = f thing
in case M.lookup fval mapA of
Nothing -> (M.insert fval thing mapA, mapB)
Just _ -> (mapA, M.insert fval () mapB)
-- | Frequently, some variant on this ends up as a local definition:
loop f x = case f x of
Left x' -> loop f x'
Right a -> a
-- Or its shortened version:
loop' f = either (loop' f) id . f
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment
You can’t perform that action at this time.