-- Copyright (c) 2011, David Amos. All rights reserved. {-# LANGUAGE NoMonomorphismRestriction, TupleSections #-} -- |A module of simple utility functions which are used throughout the rest of the library module Math.Core.Utils where import Data.List as L import qualified Data.Set as S toSet = S.toList . S.fromList -- Merge two ordered listsets. Elements appearing in both inputs appear only once in the output mergeSet (x:xs) (y:ys) = case compare x y of LT -> x : mergeSet xs (y:ys) EQ -> x : mergeSet xs ys GT -> y : mergeSet (x:xs) ys mergeSet xs ys = xs ++ ys pairs (x:xs) = map (x,) xs ++ pairs xs pairs [] = [] ordpair x y | x < y = (x,y) | otherwise = (y,x) -- fold a comparison operator through a list foldcmpl p (x1:x2:xs) = p x1 x2 && foldcmpl p (x2:xs) foldcmpl _ _ = True -- This can be expressed as a pure fold: -- foldcmpl cmp (x:xs) = snd $ foldl (\(bool,x') x -> (bool && cmp x' x, x)) (True,x) -- foldcmpl _ [] = True -- However, that is less efficient, as we can't abort as soon as we fail -- (What about using the Maybe monad?) -- for use with L.sortBy cmpfst x y = compare (fst x) (fst y) -- for use with L.groupBy eqfst x y = (==) (fst x) (fst y) fromBase b xs = foldl' (\n x -> n * b + x) 0 xs -- |Given a set @xs@, represented as an ordered list, @powersetdfs xs@ returns the list of all subsets of xs, in lex order powersetdfs :: [a] -> [[a]] powersetdfs xs = map reverse $ dfs [ ([],xs) ] where dfs ( (ls,rs) : nodes ) = ls : dfs (successors (ls,rs) ++ nodes) dfs [] = [] successors (ls,rs) = [ (r:ls, rs') | r:rs' <- L.tails rs ] -- |Given a set @xs@, represented as an ordered list, @powersetbfs xs@ returns the list of all subsets of xs, in shortlex order powersetbfs :: [a] -> [[a]] powersetbfs xs = map reverse $ bfs [ ([],xs) ] where bfs ( (ls,rs) : nodes ) = ls : bfs ( nodes ++ successors (ls,rs) ) bfs [] = [] successors (ls,rs) = [ (r:ls, rs') | r:rs' <- L.tails rs ] -- |Given a positive integer @k@, and a set @xs@, represented as a list, -- @combinationsOf k xs@ returns all k-element subsets of xs. -- The result will be in lex order, relative to the order of the xs. combinationsOf :: Int -> [a] -> [[a]] combinationsOf 0 _ = [[]] combinationsOf _ [] = [] combinationsOf k (x:xs) | k > 0 = map (x:) (combinationsOf (k-1) xs) ++ combinationsOf k xs -- |@choose n k@ is the number of ways of choosing k distinct elements from an n-set choose :: (Integral a) => a -> a -> a choose n k = product [n-k+1..n] `div` product [1..k] -- |The class of finite sets class FinSet x where elts :: [x] -- |A class representing algebraic structures having an inverse operation. -- Although strictly speaking the Num precondition means that we are requiring the structure -- also to be a ring, we do sometimes bend the rules (eg permutation groups). -- Note also that we don't insist that every element has an inverse. class Num a => HasInverses a where inverse :: a -> a infix 8 ^- -- |A trick: x^-1 returns the inverse of x (^-) :: (HasInverses a, Integral b) => a -> b -> a x ^- n = inverse x ^ n