swish-0.3.0.0: Swish/Utils/ListHelpers.hs
--------------------------------------------------------------------------------
-- See end of this file for licence information.
--------------------------------------------------------------------------------
-- |
-- Module : ListHelpers
-- Copyright : (c) 2003, Graham Klyne, 2009 Vasili I Galchin, 2011 Douglas Burke
-- License : GPL V2
--
-- Maintainer : Douglas Burke
-- Stability : experimental
-- Portability : H98
--
-- This module defines some generic list and related helper functions.
--
--------------------------------------------------------------------------------
module Swish.Utils.ListHelpers
( select, mapset, deleteIndex
, subset, equiv, hasPartitions, addSetElem
, headOrNothing
, pairUngroup, pairsUngroup, pairSort, pairGroup
, breakAll
, powerSet, combinations
, permutations, listProduct
, powerSequences, powerSequences_len, powerSequences_inf
, flist, ffold, allf, anyf, allp, anyp )
where
import Data.Ord (comparing)
import Data.List (union, intersect, sortBy, groupBy)
------------------------------------------------------------
-- Generic helpers
------------------------------------------------------------
-- |Select is like filter, except that it tests one list to select
-- elements from a second list.
select :: ( a -> Bool ) -> [a] -> [b] -> [b]
select _ [] [] = []
select f (e1:l1) (e2:l2)
| f e1 = e2 : select f l1 l2
| otherwise = select f l1 l2
select _ _ _ = error "select supplied with different length lists"
-- |Collect set of values from list under supplied mapping function
mapset :: Eq b => ( a -> b ) -> [a] -> [b]
mapset _ [] = []
mapset f (e:l) = [f e] `union` mapset f l
-- |Delete the n'th element of a list, returning the result
--
-- If the list doesn't have an n'th element, return the list unchanged.
--
deleteIndex :: [a] -> Int -> [a]
deleteIndex [] _ = []
deleteIndex xxs@(x:xs) n
| n < 0 = xxs
| n == 0 = xs
| otherwise = x:deleteIndex xs (n-1)
{-
testdi1 = deleteIndex [1,2,3,4] 0 == [2,3,4]
testdi2 = deleteIndex [1,2,3,4] 1 == [1,3,4]
testdi3 = deleteIndex [1,2,3,4] 2 == [1,2,4]
testdi4 = deleteIndex [1,2,3,4] 3 == [1,2,3]
testdi5 = deleteIndex [1,2,3,4] 4 == [1,2,3,4]
testdi6 = deleteIndex [1,2,3,4] (-1) == [1,2,3,4]
testdi = and
[ testdi1, testdi2, testdi3, testdi4, testdi5, testdi6 ]
-}
------------------------------------------------------------
-- Set functions
------------------------------------------------------------
-- |Subset test
subset :: (Eq a) => [a] -> [a] -> Bool
a `subset` b = and [ ma `elem` b | ma <- a ]
-- |Set equivalence test
equiv :: (Eq a) => [a] -> [a] -> Bool
a `equiv` b = a `subset` b && b `subset` a
-- |Set partition test
--
-- Is it possible to be more efficient here?
-- Maybe something like sort\/merge\/compare?
hasPartitions :: (Eq a) => [a] -> ([a],[a]) -> Bool
a `hasPartitions` (b1,b2) =
null (b1 `intersect` b2) && (a `equiv` (b1 `union` b2))
-- |Add element to set
addSetElem :: (Eq a) => a -> [a] -> [a]
addSetElem e es = if e `elem` es then es else e:es
------------------------------------------------------------
-- Lists and Maybes
------------------------------------------------------------
-- |Return head of a list of @Maybe@'s, or @Nothing@ if list is empty
--
-- Use with @filter isJust@ to select a non-Nothing value from a
-- list when such a value is present.
--
headOrNothing :: [Maybe a] -> Maybe a
headOrNothing [] = Nothing
headOrNothing (a:_) = a
------------------------------------------------------------
-- Filter, ungroup, sort and group pairs by first member
------------------------------------------------------------
{-
pairSelect :: ((a,b) -> Bool) -> ((a,b) -> c) -> [(a,b)] -> [c]
pairSelect p f as = map f (filter p as)
-}
pairUngroup :: (a,[b]) -> [(a,b)]
pairUngroup (a,bs) = [ (a,b) | b <- bs ]
pairsUngroup :: [(a,[b])] -> [(a,b)]
pairsUngroup ps = [ (a,b) | (a,bs) <- ps, b <- bs ]
pairSort :: (Ord a) => [(a,b)] -> [(a,b)]
pairSort = sortBy (comparing fst)
pairGroup :: (Ord a) => [(a,b)] -> [(a,[b])]
pairGroup = map (factor . unzip) . groupBy eqFirst . pairSort
where
-- as is not [] by construction, but would be nice to have
-- this enforced by the types
factor (as, bs) = (head as,bs)
eqFirst a b = fst a == fst b
------------------------------------------------------------
-- Separate list into sublists
------------------------------------------------------------
-- |Break list into a list of sublists, separated by element
-- satisfying supplied condition.
breakAll :: (a -> Bool) -> [a] -> [[a]]
breakAll _ [] = []
breakAll p s = let (h,s') = break p s
in h : breakAll p (drop 1 s')
------------------------------------------------------------
-- Powerset
------------------------------------------------------------
-- [[[TBD... there's a much better implementation in my email,
-- from Christopher Hendrie. This is the raw code.]]]
{-
>ranked_powerset :: [a] -> [[[a]]]
>ranked_powerset = takeWhile (not . null) . foldr next_powerset ([[]] :
repeat [])
>
>next_powerset :: a -> [[[a]]] -> [[[a]]]
>next_powerset x r = zipWith (++) ([] : map (map (x:)) r) r
>
>powerset :: [a] -> [[a]]
>powerset = tail . concat . ranked_powerset
-}
-- |Powerset of a list, in ascending order of size.
-- Assumes the supplied list has no duplicate elements.
powerSet :: [a] -> [[a]]
powerSet as =
concatMap (`combinations` as) [1..length as]
-- |Combinations of n elements from a list, each being returned in the
-- order that they appear in the list.
combinations :: Int -> [a] -> [[a]]
combinations _ [] = [] -- Don't include empty combinations
combinations n as@(ah:at)
| n <= 0 = [[]]
| n > length as = []
| n == length as = [as]
| otherwise = map (ah:) (combinations (n-1) at) ++
combinations n at
{-
-- |Return list of integers from lo to hi.
intRange :: Int -> Int -> [Int]
intRange lo hi = take (hi-lo+1) (iterate (+1) 1)
-}
{-
-- Tests
testcomb0 = combinations 0 "abcd" -- []
testcomb1 = combinations 1 "abcd" -- ["a","b","c","d"]
testcomb2 = combinations 2 "abcd" -- ["ab","ac","ad","bc","bd","cd"]
testcomb3 = combinations 3 "abcd" -- ["abc","abd","acd","bcd"]
testcomb4 = combinations 4 "abcd" -- ["abcd"]
testcomb5 = combinations 5 "abcd" -- []
testpower = powerSet "abc" -- ["a","b","c","ab","ac","bc","abc"]
-}
------------------------------------------------------------
-- Permutations of a list
------------------------------------------------------------
-- This algorithm is copied from an email by S.D.Mechveliani
-- http://www.dcs.gla.ac.uk/mail-www/haskell/msg01936.html
permutations :: [a] -> [[a]]
permutations [] = [[]]
permutations (j:js) = addOne $ permutations js
where
addOne = foldr ((++) . ao) []
ao [] = [[j]]
ao (k:ks) = (j:k:ks) : map (k:) (ao ks)
{-
testperm = permutations [1,2,3] ==
[[1,2,3],[2,1,3],[2,3,1],[1,3,2],[3,1,2],[3,2,1]]
-}
------------------------------------------------------------
-- List product
------------------------------------------------------------
-- |Given a list of lists, construct a new list of lists where
-- each member of the new list is the same length as the original
-- list, and each member corresponds to a different choice of
-- one element from each of the original members in the
-- corresponding position. Thus:
--
-- > listProduct [[a1,a2],[b1],[c1,c2]] =
-- > [ [a1,b1,c1], [a1,b1,c2], [a2,b1,c1], [a2,b1,c2] ]
--
-- Note: The length of the resulting list is the prodicty of
-- lengths of the components of the original list. Thus, if
-- any member of the original list is empty then so is the
-- resulting list:
--
-- > listProduct [[a1,a2],[],[c1,c2]] = []
--
-- NOTE: this is subsumed by 'sequence'
--
listProduct :: [[a]] -> [[a]]
listProduct [] = [[]]
listProduct (as:ass) = concat [ map (a:) (listProduct ass) | a <- as ]
{-
test1 = listProduct [["a1","a2"],["b1"],["c1","c2"]]
test2 = listProduct [["a1","a2"],[],["c1","c2"]]
lp [] = [[]]
lp (as:ass) = concatMap (\a -> (map (a:) (lp ass))) as
-}
------------------------------------------------------------
-- Powersequence (?) -- all sequences from some base values
------------------------------------------------------------
-- |Function to choose all sequences of any length
-- from a supplied set of values, returned in
-- increasing length.
powerSequences :: [a] -> [[a]]
powerSequences rs = concat $ powerSeq_bylen rs [[]]
-- |Construct list of lists of sequences of increasing length
powerSeq_bylen :: [a] -> [[a]] -> [[[a]]]
powerSeq_bylen rs ps = ps : powerSeq_bylen rs (powerSeq_next rs ps)
-- |Return sequences of length n+1 given original sequence
-- and list of all sequences of length n
powerSeq_next :: [a] -> [[a]] -> [[a]]
powerSeq_next rs rss = [ h:t | t <- rss, h <- rs ]
-- |Return all powersequences of a given length
powerSequences_len :: Int -> [a] -> [[a]]
powerSequences_len len rs = powerSeq_bylen rs [[]] !! len
-- |Return all powersequences of indefinite length
-- Observe that any such powersequence will consist of a sequence
-- of a finite length sequence followed by an indefinite number of
-- copies of the head of the base set. To prevent duplicates, the
-- generator constructs only sequences that do not end in the first
-- member of the base set.
powerSequences_inf :: [a] -> [[a]]
powerSequences_inf rs =
map (++pst) $ [] : concat (powerSeq_bylen rs psh)
where
psh = map (:[]) (tail rs)
pst = repeat $ head rs
{- Powersequence tests
t0 = [1,2,3,4,5,6]
t1 = powerSequences t0
t2 = take 15 t1
t3 = powerSequences_len 3 t0
t4 = powerSequences_inf t0
t5 = map (take 6) $ take 15 t4
t6 = take 15 (powerSequences_len 6 t0)
t7 = t5 == t6
t8 = powerSequences_len1 3 t0
t9 = t8 == t3
-}
------------------------------------------------------------
-- Functions, lists and monads
------------------------------------------------------------
-- |Apply list of functions to some value, returning list of results.
-- It's kind of like an converse map.
--
-- This is similar to the 'ap' function in the Monad library.
--
flist :: [a->b] -> a -> [b]
flist fs a = map ($ a) fs
{-
flisttest = flist [(1*),(2*),(3*)] 5 -- [5,10,15]
-}
{-
-- |A more generalized form of flist that works with arbitrary Monads.
-- (Suggested by Derek Elkin.)
fmonad :: Monad m => m (a->b) -> a -> m b
fmonad fm a =
do { f <- fm
; return $ f a
}
-}
{-
fmonadtest = fmonad [(1*),(2*),(3*)] 3 -- [3,6,9]
-}
-- |Fold result from list of functions applied to some value,
-- returning the result of the fold.
--
-- This is similar to the 'ap' function in the Monad library.
--
ffold :: (b->c->c) -> c -> [a->b] -> a -> c
ffold rf ri fs v = foldr rf ri (flist fs v)
{-
ffoldtest0 = ffold ge4and True [(1+),(2+),(3+)] 0 -- False
ffoldtest1 = ffold ge4and True [(1+),(2+),(3+)] 1 -- False
ffoldtest2 = ffold ge4and True [(1+),(2+),(3+)] 2 -- False
ffoldtest3 = ffold ge4and True [(1+),(2+),(3+)] 3 -- True
ge4and v b = (v>=4 && b)
ffoldtest = and [not ffoldtest0,not ffoldtest1,not ffoldtest2,ffoldtest3]
-}
-- |Test if application of all functions in list to a given value
-- satisfies a given condition
--
allf :: (b->Bool) -> [a->b] -> a -> Bool
allf pf fs a = all pf (flist fs a)
{-
allftest0 = allf (>=4) [(1+),(2+),(3+)] 0 -- False
allftest1 = allf (>=4) [(1+),(2+),(3+)] 1 -- False
allftest2 = allf (>=4) [(1+),(2+),(3+)] 2 -- False
allftest3 = allf (>=4) [(1+),(2+),(3+)] 3 -- True
allftest = and [not allftest0,not allftest1,not allftest2,allftest3]
-}
-- |Test if application of any functions in list to a given value
-- satisfies a given condition
--
anyf :: (b->Bool) -> [a->b] -> a -> Bool
anyf pf fs a = any pf (flist fs a)
{-
anyftest0 = anyf (>=4) [(1+),(2+),(3+)] 0 -- False
anyftest1 = anyf (>=4) [(1+),(2+),(3+)] 1 -- True
anyftest2 = anyf (>=4) [(1+),(2+),(3+)] 2 -- True
anyftest3 = anyf (>=4) [(1+),(2+),(3+)] 3 -- True
anyftest = and [not anyftest0,anyftest1,anyftest2,anyftest3]
-}
-- |Test if a value satisfies all predicates in a list
--
allp :: [a->Bool] -> a -> Bool
allp ps a = and (flist ps a)
{-
allptest0 = allp [(>=1),(>=2),(>=3)] 0 -- False
allptest1 = allp [(>=1),(>=2),(>=3)] 1 -- False
allptest2 = allp [(>=1),(>=2),(>=3)] 2 -- False
allptest3 = allp [(>=1),(>=2),(>=3)] 3 -- True
allptest = and [not allptest0,not allptest1,not allptest2,allptest3]
-}
-- |Test if a value satisfies any predicate in a list
--
anyp :: [a->Bool] -> a -> Bool
anyp ps a = or (flist ps a)
{-
anyptest0 = anyp [(>=1),(>=2),(>=3)] 0 -- False
anyptest1 = anyp [(>=1),(>=2),(>=3)] 1 -- True
anyptest2 = anyp [(>=1),(>=2),(>=3)] 2 -- True
anyptest3 = anyp [(>=1),(>=2),(>=3)] 3 -- True
anyptest = and [not anyptest0,anyptest1,anyptest2,anyptest3]
-}
--------------------------------------------------------------------------------
--
-- Copyright (c) 2003, Graham Klyne, 2009 Vasili I Galchin, 2011 Douglas Burke
-- All rights reserved.
--
-- This file is part of Swish.
--
-- Swish is free software; you can redistribute it and/or modify
-- it under the terms of the GNU General Public License as published by
-- the Free Software Foundation; either version 2 of the License, or
-- (at your option) any later version.
--
-- Swish is distributed in the hope that it will be useful,
-- but WITHOUT ANY WARRANTY; without even the implied warranty of
-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-- GNU General Public License for more details.
--
-- You should have received a copy of the GNU General Public License
-- along with Swish; if not, write to:
-- The Free Software Foundation, Inc.,
-- 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
--
--------------------------------------------------------------------------------