{-# OPTIONS_GHC -Wall #-} module DatabaseDesign.Ampersand.Basics.Auxiliaries where import Data.List (nub,elemIndex) import Data.Graph (stronglyConnComp, SCC(CyclicSCC)) import Data.Maybe (fromMaybe) -- | The 'eqClass' function takes an equality test function and a list and returns a list of lists such -- that each sublist in the result contains only equal elements, and all equal elements are in -- the same sublist. For example, -- -- > eqClass "Mississippi" = ["M","iiii","ssss","pp"] -- eqClass :: (a -> a -> Bool) -> [a] -> [[a]] eqClass _ [] = [] eqClass f (x:xs) = (x:[e |e<-xs, f x e]) : eqClass f [e |e<-xs, not (f x e)] -- | eqCl is a very useful function for gathering things that are equal wrt some criterion f. -- For instance, if you want to have persons with the same name: -- 'eqCl name persons' produces a list,in which each element is a list of persons with the same name. eqCl :: Eq b => (a -> b) -> [a] -> [[a]] eqCl _ [] = [] eqCl f (x:xs) = (x:[e |e<-xs, f x==f e]) : eqCl f [e |e<-xs, f x/=f e] -- | getCycles returns a list of cycles in the edges list (each edge is a pair of a from-vertex -- and a list of to-vertices) getCycles :: Eq a => [(a, [a])] -> [[a]] getCycles edges = let allVertices = nub . concat $ [ from : to | (from, to) <- edges ] keyFor v = fromMaybe (error "FATAL") $ elemIndex v allVertices graphEdges = [ (v, keyFor v , map keyFor vs) | (v, vs) <- edges ] in [ vs | CyclicSCC vs <- stronglyConnComp graphEdges ] -- The following function can be used to determine how much of a set of alternative expression is already determined -- | The 'combinations' function returns all possible combinations of lists of list. -- For example, -- -- > combinations [[1,2,3],[10,20],[4]] == [[1,10,4],[1,20,4],[2,10,4],[2,20,4],[3,10,4],[3,20,4]] combinations :: [[a]] -> [[a]] combinations [] = [[]] combinations (es:ess) = [ x:xs | x<-es, xs<-combinations ess] commaEng :: String -> [String] -> String commaEng str [a,b,c] = a++", "++b++", "++str++" "++c commaEng str [a,b] = a++" "++str++" "++b commaEng _ [a] = a commaEng str (a:as) = a++", "++commaEng str as commaEng _ [] = "" commaNL :: String -> [String] -> String commaNL str [a,b] = a++" "++str++" "++b commaNL _ [a] = a commaNL str (a:as) = a++", "++commaNL str as commaNL _ [] = "" fst3 :: (a,b,c)->a snd3 :: (a,b,c)->b thd3 :: (a,b,c)->c fst3 (a,_,_) = a snd3 (_,b,_) = b thd3 (_,_,c) = c class Flippable a where flp :: a -> a