list-extras (empty) → 0.1.0
raw patch · 8 files changed
+607/−0 lines, 8 filesdep +basesetup-changed
Dependencies added: base
Files
- Data/List/Extras.hs +27/−0
- Data/List/Extras/ArgMax.hs +159/−0
- Data/List/Extras/LazyLength.hs +139/−0
- Data/List/Extras/Pair.hs +122/−0
- LICENSE +33/−0
- Prelude/Listless.hs +53/−0
- Setup.hs +37/−0
- list-extras.cabal +37/−0
+ Data/List/Extras.hs view
@@ -0,0 +1,27 @@++{-# OPTIONS_GHC -Wall -Werror #-}++----------------------------------------------------------------+-- ~ 2008.07.20+-- |+-- Module : Data.List.Extras+-- Copyright : Copyright (c) 2007--2008 wren ng thornton+-- License : BSD3+-- Maintainer : wren@cpan.org+-- Stability : stable+-- Portability : portable+--+-- This module provides a single header for all @Data.List.Extras.*@ modules+----------------------------------------------------------------++module Data.List.Extras+ ( module Data.List.Extras.LazyLength+ , module Data.List.Extras.Pair+ , module Data.List.Extras.ArgMax+ ) where++import Data.List.Extras.LazyLength+import Data.List.Extras.Pair+import Data.List.Extras.ArgMax+----------------------------------------------------------------+----------------------------------------------------------- fin.
+ Data/List/Extras/ArgMax.hs view
@@ -0,0 +1,159 @@++{-# OPTIONS_GHC -Wall -Werror -fno-warn-unused-binds #-}++----------------------------------------------------------------+-- ~ 2008.07.20+-- |+-- Module : Data.List.Extras.ArgMax+-- Copyright : Copyright (c) 2007--2008 wren ng thornton+-- License : BSD3+-- Maintainer : wren@cpan.org+-- Stability : experimental+-- Portability : portable+--+-- This module provides variants of the 'maximum' and 'minimum'+-- functions which return the element for which some function is+-- maximized or minimized.+----------------------------------------------------------------++module Data.List.Extras.ArgMax+ (+ -- * Maximum variations+ argmax, argmax'+ + -- * Minimum variations+ , argmin, argmin'+ + -- * Generic versions+ , argmaxBy, argmaxBy'+ + {- TODO: CPS and monadic variants; argmax2, argmax3,... -}+ {- TODO: make argmax et al "good consumers" for fusion -}+ ) where+-- argmaxM :: (Monad m, Ord b) => (a -> m b) -> [a] -> m (Maybe a)+++----------------------------------------------------------------+----------------------------------------------------------------++-- CPS version... why bother making the list first?+type CPSList a b = ((a -> b -> b) -> b -> b)++-- BUG: This doesn't tail recurse and so it will stack overflow!!!+argmaxCPS :: (Ord b) => (a -> b) -> CPSList a (Maybe (a,b)) -> Maybe a+argmaxCPS f list = list k Nothing >>= Just . fst+ where+ k x Nothing = Just (x, f x)+ k x (Just yfy) = Just (mx x yfy)+ + mx a (b,fb) = let fa = f a in+ if fa > fb+ then (a,fa)+ else (b,fb)+++----------------------------------------------------------------+----------------------------------------------------------------+-- Compared against a generic decorate-fold-undecorate implementation:+-- fst . foldr1 (\a b -> if snd a > snd b then a else b)+-- . map (\x -> (x, f x))+-- that seems to take 50% to 100% more space vs argmax'. Using+-- pattern matching instead of snd seems to improve it, but my tests+-- are a bit unclear.++emptyListError :: String -> a+emptyListError fun = error $ "Data.List.Extras.ArgMax."++fun++": empty list"+++-- | Tail-recursive driver+_argmaxBy :: (b -> b -> Bool) -> (a -> b) -> [a] -> (a,b) -> a+_argmaxBy isBetterThan f = go+ where+ go [] (b,_) = b+ go (x:xs) (b,fb) = go xs $! cmp x (b,fb)+ + cmp a (b,fb) = let fa = f a in+ if fa `isBetterThan` fb+ then (a,fa)+ else (b,fb)+++-- | Direct version of 'argmaxBy' which doesn't catch the empty+-- list error.+argmaxBy' :: (b -> b -> Ordering) -> (a -> b) -> [a] -> a+argmaxBy' _ _ [] = emptyListError "argmaxBy'"+argmaxBy' ord f (x:xs) = _argmaxBy boolOrd f xs (x, f x)+ where+ boolOrd a b = GT == ord a b+++-- | Returns the element of the list which maximizes a function+-- according to a user-defined ordering, or @Nothing@ if the list+-- was empty.+argmaxBy :: (b -> b -> Ordering) -> (a -> b) -> [a] -> Maybe a+argmaxBy _ _ [] = Nothing+argmaxBy ord f xs@(_:_) = Just (argmaxBy' ord f xs)+++----------------------------------------------------------------+-- The specialization pragma add about 21kB to the library size+-- (compared to 29kB base for list-extras). For a basic utility+-- library that's a bit excessive, though if we break the argmax+-- stuff out from list-extras then we might go through with it for+-- performance sake.++-- | Direct version of 'argmax' which doesn't catch the empty list+-- error.+{-+{-# SPECIALIZE argmax' :: (a -> Int) -> [a] -> a #-}+{-# SPECIALIZE argmax' :: (a -> Integer) -> [a] -> a #-}+{-# SPECIALIZE argmax' :: (a -> Float) -> [a] -> a #-}+{-# SPECIALIZE argmax' :: (a -> Double) -> [a] -> a #-}+-}+argmax' :: (Ord b) => (a -> b) -> [a] -> a+argmax' _ [] = emptyListError "argmax'"+argmax' f (x:xs) = _argmaxBy (>) f xs (x, f x)+++-- | Returns the element of the list which maximizes the function,+-- or @Nothing@ if the list was empty.+{-+{-# SPECIALIZE argmax :: (a -> Int) -> [a] -> Maybe a #-}+{-# SPECIALIZE argmax :: (a -> Integer) -> [a] -> Maybe a #-}+{-# SPECIALIZE argmax :: (a -> Float) -> [a] -> Maybe a #-}+{-# SPECIALIZE argmax :: (a -> Double) -> [a] -> Maybe a #-}+-}+argmax :: (Ord b) => (a -> b) -> [a] -> Maybe a+argmax _ [] = Nothing+argmax f xs@(_:_) = Just (argmax' f xs)+++----------------------------------------------------------------++-- | Direct version of 'argmin' which doesn't catch the empty list+-- error.+{-+{-# SPECIALIZE argmin' :: (a -> Int) -> [a] -> a #-}+{-# SPECIALIZE argmin' :: (a -> Integer) -> [a] -> a #-}+{-# SPECIALIZE argmin' :: (a -> Float) -> [a] -> a #-}+{-# SPECIALIZE argmin' :: (a -> Double) -> [a] -> a #-}+-}+argmin' :: (Ord b) => (a -> b) -> [a] -> a+argmin' _ [] = emptyListError "argmin'"+argmin' f (x:xs) = _argmaxBy (<) f xs (x, f x)+++-- | Returns the element of the list which minimizes the function,+-- or @Nothing@ if the list was empty.+{-+{-# SPECIALIZE argmin :: (a -> Int) -> [a] -> Maybe a #-}+{-# SPECIALIZE argmin :: (a -> Integer) -> [a] -> Maybe a #-}+{-# SPECIALIZE argmin :: (a -> Float) -> [a] -> Maybe a #-}+{-# SPECIALIZE argmin :: (a -> Double) -> [a] -> Maybe a #-}+-}+argmin :: (Ord b) => (a -> b) -> [a] -> Maybe a+argmin _ [] = Nothing+argmin f xs@(_:_) = Just (argmin' f xs)++----------------------------------------------------------------+----------------------------------------------------------- fin.
+ Data/List/Extras/LazyLength.hs view
@@ -0,0 +1,139 @@++{-# OPTIONS_GHC -Wall -Werror #-}++----------------------------------------------------------------+-- ~ 2008.07.20+-- |+-- Module : Data.List.Extras.LazyLength+-- Copyright : Copyright (c) 2007--2008 wren ng thornton+-- License : BSD3+-- Maintainer : wren@cpan.org+-- Stability : stable+-- Portability : portable+--+-- This module provides least-strict functions for getting a list's+-- length and doing natural things with it. On GHC this module also+-- uses rewrite rules to convert certain calls to 'length' into our+-- least-strict versions.+--+-- The regular version of @length@ will traverse the entire spine+-- of the list in order to return an answer. For comparing the+-- length against some bound, that is by far too strict. Being too+-- strict can cause a space leak by expanding a lazy list before+-- necessary (or more than is ever necessary). And it can lead to+-- unnecessarily non-terminating programs when trying to determine+-- if an infinite list is longer or shorter than some finite bound.+--+-- A nicer version of @length@ would return some lazy approximation+-- of an answer which retains the proper semantics. An option for+-- doing this is to return Peano integers which can be decremented+-- as much as necessary and no further (i.e. at most one more than+-- the bound). Of course, Peano integers are woefully inefficient+-- and would wreck the cache and burn heap. This module provides+-- functions with the same lazy effect as if we used Peano integers,+-- but does so efficiently instead.+--+-- (For Peano integers see {numbers}"Data.Number.Natural" or+-- {non-negative}"Numeric.NonNegative.Class".)+----------------------------------------------------------------++module Data.List.Extras.LazyLength+ ( lengthBound, negateOrdering+ , lengthCompare+ ) where+++----------------------------------------------------------------+----------------------------------------------------------------+-- | A variant of 'length' which is least-strict for comparing+-- against a boundary length. This function is defined primarily+-- for use by rewrite rules rather than for direct use (though it's+-- fine for that too).+--+-- @lengthBound@ is polymorphic in the return of the helper+-- function so we can use 'compare' as well as '>', '>=', '==',+-- '/=', '<=', '<'. If you want to use any other functions, know+-- that we only preserve the ordering of the list's length vs the+-- boundary length and so the function should not rely on the true+-- values of either of the numbers being compared.++lengthBound :: Int -> (Int -> Int -> a) -> [b] -> a+lengthBound n cmp xs+ | n < 0 = case xs of+ [] -> cmp n 0+ (_:_) -> cmp n 1+ | otherwise = go n xs+ where+ go n' [] = cmp n' 0+ go 0 (_:_) = cmp 0 1+ go n' (_:xs') = (go $! n'-1) xs'+++-- | Flips 'LT' and 'GT'. Used by 'lengthBound' in rewrite rules.+negateOrdering :: Ordering -> Ordering+negateOrdering LT = GT+negateOrdering EQ = EQ+negateOrdering GT = LT+++{-# RULES++"lengthBound/(>)" forall n xs. n > length xs = lengthBound n (>) xs+"lengthBound/(>=)" forall n xs. n >= length xs = lengthBound n (>=) xs+"lengthBound/(==)" forall n xs. n == length xs = lengthBound n (==) xs+"lengthBound/(/=)" forall n xs. n /= length xs = lengthBound n (/=) xs+"lengthBound/(<=)" forall n xs. n <= length xs = lengthBound n (<=) xs+"lengthBound/(<)" forall n xs. n < length xs = lengthBound n (<) xs+"lengthBound/compare" forall n xs.+ compare n (length xs) = lengthBound n compare xs++"lengthBound\\(>)" forall n xs. length xs > n = lengthBound n (<) xs+"lengthBound\\(>=)" forall n xs. length xs >= n = lengthBound n (<=) xs+"lengthBound\\(==)" forall n xs. length xs == n = lengthBound n (==) xs+"lengthBound\\(/=)" forall n xs. length xs /= n = lengthBound n (/=) xs+"lengthBound\\(<=)" forall n xs. length xs <= n = lengthBound n (>=) xs+"lengthBound\\(<)" forall n xs. length xs < n = lengthBound n (>) xs+"lengthBound\\compare" forall n xs.+ compare (length xs) n = negateOrdering (lengthBound n compare xs)+ #-}+++----------------------------------------------------------------+----------------------------------------------------------------+-- | A variant of 'length' which is least-strict for comparing+-- the lengths of two lists. This is as strict as the length of the+-- shorter list (which allows comparing an infinite list against a+-- finite list). The function itself is trivial, but again it's+-- designed primarily for rewrite rules.+--+-- If you're going to immediately follow this with a 'zip' function+-- then see "Data.List.Extras.Pair" instead.++lengthCompare :: [a] -> [b] -> Ordering+lengthCompare [] [] = EQ+lengthCompare (_:_) [] = GT+lengthCompare [] (_:_) = LT+lengthCompare (_:xs) (_:ys) = lengthCompare xs ys+++{-# RULES++"lengthCompare/(>)" forall xs ys.+ length xs > length ys = lengthCompare xs ys == GT+"lengthCompare/(>=)" forall xs ys.+ length xs >= length ys = lengthCompare xs ys /= LT+"lengthCompare/(==)" forall xs ys.+ length xs == length ys = lengthCompare xs ys == EQ+"lengthCompare/(/=)" forall xs ys.+ length xs /= length ys = lengthCompare xs ys /= EQ+"lengthCompare/(<=)" forall xs ys.+ length xs <= length ys = lengthCompare xs ys /= GT+"lengthCompare/(<)" forall xs ys.+ length xs < length ys = lengthCompare xs ys == LT++"lengthCompare/compare" forall n xs.+ compare (length xs) (length ys) = lengthCompare xs ys+ #-}++----------------------------------------------------------------+----------------------------------------------------------- fin.
+ Data/List/Extras/Pair.hs view
@@ -0,0 +1,122 @@++{-# OPTIONS_GHC -Wall -Werror #-}++----------------------------------------------------------------+-- ~ 2008.07.11+-- |+-- Module : Data.List.Extras.Pair+-- Copyright : Copyright (c) 2007--2008 wren ng thornton+-- License : BSD3+-- Maintainer : wren@cpan.org+-- Stability : stable+-- Portability : portable+--+-- This module provides safe zipping functions which will fail+-- (return 'Nothing') on uneven length lists.+----------------------------------------------------------------++module Data.List.Extras.Pair+ (+ -- * Safe functions for zipping lists+ pairWithBy, pairWith, pairBy, pair+ + -- * Special safe zipping functions+ , biject, biject'+ + -- * New (unsafe) zipping functions+ , zipWithBy, zipBy+ ) where+++----------------------------------------------------------------+----------------------------------------------------------------+-- | An unsafe variant of 'pairWithBy' to fill out the interface.+zipWithBy :: (a -> b -> c) -- tuple homomorphism+ -> (c -> d -> d) -> d -- list homomorphism+ -> [a] -> [b] -> d -- a @zip@ function++zipWithBy k f z xs' ys' = zipWB xs' ys' id+ where+ zipWB (x:xs) (y:ys) cc = zipWB xs ys (cc . f (k x y))+ zipWB _ _ cc = cc z+++-- | A version of 'zip' that uses a user-defined list homomorphism.+zipBy :: ((a,b) -> m (a,b) -> m (a,b)) -> m (a,b)+ -> [a] -> [b] -> m (a,b)+zipBy = zipWithBy (,)+++----------------------------------------------------------------+----------------------------------------------------------------+-- | A generic version of 'pair'. The first argument is a tuple+-- homomorphism (i.e. a function for how to combine values from the+-- two lists), the second two arguments form a list homomorphism+-- (i.e. so you can 'foldr' the @[c]@ list directly without actually+-- constructing it).+--+-- In order to evaluate to WHNF 'pairWithBy' is strict in both list+-- arguments, as it must be, to determine that the lists are of the+-- same length. This means it can survive one infinite list (yielding+-- 'Nothing') but that it can't survive two. The implementation is+-- very efficient and uses a tight tail-recursive loop, however+-- with extremely long lists it will be churning through heap and+-- that tightness can make it hard to interrupt (lists of 1 million+-- elements return in 1~2 seconds, but lists of 10 million can lock+-- your system up).++pairWithBy :: (a -> b -> c) -- @(,)@ tuple homomorphism+ -> (c -> d -> d) -- @(:)@ list homomorphism, pt. 1+ -> d -- @[]@ list homomorphism, pt. 2+ -> [a] -> [b] -> Maybe d -- a safer @zip@ function++pairWithBy k f z xs' ys' = pairWB xs' ys' id+ where+ -- N.B. Strict accumulators are usually awesome, but don't+ -- even consider it when doing CPS! Making @cc@ strict degrades+ -- performance significantly; it takes twice as long and twice+ -- as much heap just to get to WHNF. After evaluating the spine+ -- of the resulting list from 'pair' that drops to +10% time+ -- and +25% heap, which is still much worse.+ + pairWB (x:xs) (y:ys) cc = pairWB xs ys (cc . f (k x y))+ pairWB [] [] cc = Just (cc z)+ pairWB _ _ _ = Nothing++----------------------------------------------------------------++-- | A safe version of 'zipWith'.+pairWith :: (a -> b -> c)+ -> [a] -> [b] -> Maybe [c]+pairWith f = pairWithBy f (:) []+++-- | A safe version of 'zip' that uses a user-defined list homomorphism.+pairBy :: ((a,b) -> m (a,b) -> m (a,b)) -> m (a,b)+ -> [a] -> [b] -> Maybe (m (a,b))+pairBy = pairWithBy (,)+++-- | A safe version of 'zip'.+pair :: [a] -> [b] -> Maybe [(a,b)]+pair = pairBy (:) []+++----------------------------------------------------------------+-- These two are just here because they're often requested, and+-- besides they're kinda cute.++-- | A bijection from a list of functions and a list of arguments+-- to a list of results of applying the functions bijectively.+biject :: [a -> b] -> [a] -> Maybe [b]+biject = pairWith ($) -- 'id' also works+++-- | A version of 'biject' that applies functions strictly. N.B.+-- the list is still lazily evaluated, this just makes the functions+-- strict in their argument.+biject' :: [a -> b] -> [a] -> Maybe [b]+biject' = pairWith ($!)++----------------------------------------------------------------+----------------------------------------------------------- fin.
+ LICENSE view
@@ -0,0 +1,33 @@+Copyright (c) 2007--2008, wren ng thornton.+ALL RIGHTS RESERVED.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions+are met:++ * Redistributions of source code must retain the above copyright+ notice, this list of conditions and the following disclaimer.++ * Redistributions in binary form must reproduce the above+ copyright notice, this list of conditions and the following+ disclaimer in the documentation and/or other materials provided+ with the distribution.++ * Neither the name of the copyright holders nor the names of+ other contributors may be used to endorse or promote products+ derived from this software without specific prior written+ permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS+FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE+COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT,+INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING,+BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;+LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER+CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT+LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN+ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE+POSSIBILITY OF SUCH DAMAGE.+
+ Prelude/Listless.hs view
@@ -0,0 +1,53 @@++{-# OPTIONS_GHC -Wall -Werror #-}++----------------------------------------------------------------+-- ~ 2008.07.20+-- |+-- Module : Prelude.Listless+-- Copyright : Copyright (c) 2007--2008 wren ng thornton+-- License : BSD3+-- Maintainer : wren@cpan.org+-- Stability : stable+-- Portability : portable+--+-- This module provides the "Prelude" but removing all the list+-- functions. This is helpful for modules that overload those+-- function names to work for other types.+--+-- Be sure to disable the implicit importing of the prelude when+-- you import this one (by passing @-fno-implicit-prelude@ for GHC,+-- or by explicitly importing the prelude with an empty import list+-- for most implementations).+----------------------------------------------------------------++module Prelude.Listless+ -- We have to manually specify the exports; can't export @module+ -- Prelude@ because that'll export everything and only hide the+ -- noted parts from this module, which is meaningless.+ (($!), ($), (&&), (.), (=<<), Bool(..), Bounded(..), Char,+ Double, Either(..), Enum(..), Eq(..), FilePath, Float, Floating(..),+ Fractional(..), Functor(..), IO, IOError, Int, Integer,+ Integral(..), Maybe(..), Monad(..), Num(..), Ord(..), Ordering(..),+ Rational, Read(..), ReadS, Real(..), RealFloat(..), RealFrac(..),+ Show(..), ShowS, String, (^), (^^), appendFile, asTypeOf, catch,+ const, curry, either, error, even, flip, fromIntegral, fst,+ gcd, getChar, getContents, getLine, id, interact, ioError, lcm,+ lex, maybe, not, odd, otherwise, print, putChar, putStr, putStrLn,+ read, readFile, readIO, readLn, readParen, reads, realToFrac,+ seq, showChar, showParen, showString, shows, snd, subtract,+ uncurry, undefined, until, userError, writeFile, (||))+ + where++import Prelude hiding+ ((!!), (++), all, and, any, break, concat, concatMap, cycle,+ drop, dropWhile, elem, filter, foldl, foldl1, foldr, foldr1,+ head, init, iterate, last, length, lines, lookup, map, mapM,+ mapM_, maximum, minimum, notElem, null, or, product, repeat,+ replicate, reverse, scanl, scanl1, scanr, scanr1, sequence,+ sequence_, span, splitAt, sum, tail, take, takeWhile, unlines,+ unwords, unzip, unzip3, words, zip, zip3, zipWith, zipWith3)++----------------------------------------------------------------+----------------------------------------------------------- fin.
+ Setup.hs view
@@ -0,0 +1,37 @@+#!/usr/bin/env runhaskell++module Main (main) where++-- <http://www.haskell.org/ghc/docs/latest/html/libraries/Cabal/Distribution-Simple.html>+import Distribution.Simple++{-+import Distribution.PackageDescription+import Distribution.Simple.LocalBuildInfo+import System.Exit+import System.Cmd+import System.Directory+import Control.Exception++withCurrentDirectory :: FilePath -> IO a -> IO a+withCurrentDirectory path f = do+ cur <- getCurrentDirectory+ setCurrentDirectory path+ finally f (setCurrentDirectory cur)+++-- <http://blog.holdenkarau.com/2008/07/integrating-your-hunit-or-other-tests.html>+runTestScript :: Args+ -> Bool+ -> PackageDescription+ -> LocalBuildInfo+ -> IO ExitCode+runTestScript args flag pd lbi = withCurrentDirectory "src" (system "make")+++main :: IO ()+main = defaultMainWithHooks defaultUserHooks {runTests = runTestScript}+-}++main :: IO ()+main = defaultMain
+ list-extras.cabal view
@@ -0,0 +1,37 @@+----------------------------------------------------------------+-- wren ng thornton <wren@cpan.org> ~ 2008.07.20+----------------------------------------------------------------++Name: list-extras+Version: 0.1.0+Cabal-Version: >= 1.2+Build-Type: Simple+Stability: stable+Copyright: Copyright (c) 2007--2008 wren ng thornton+License: BSD3+License-File: LICENSE+Author: wren ng thornton+Maintainer: wren@cpan.org+Category: List+Synopsis: Common not-so-common functions for lists+Description: Common not-so-common functions for lists.+ .+ Since "Data.List.Extras" is prime realestate for+ extensions to "Data.List", if you have something+ you'd like to contribute feel free to contact the+ maintainer (I'm friendly). I'm amenable to adopting+ code if you think your functions aren't enough for+ a package on their own. Or if you would rather+ maintain a separate package I can share the+ @Data.List.Extras.Foo@ namespace.++Library+ Exposed-Modules: Prelude.Listless+ , Data.List.Extras+ , Data.List.Extras.ArgMax+ , Data.List.Extras.LazyLength+ , Data.List.Extras.Pair+ Build-Depends: base++----------------------------------------------------------------+----------------------------------------------------------- fin.