-- $Id: Aufgabe4.lhs,v 1.5 2003/12/14 12:17:14 fp010 Exp $
-- enough of literate mode as emacs' haskell-mode gets confused with it :-(
----------------------------------------------------------------------------
\begin{code}
module Aufgabe4(compr,uncompr,sums,sumBoth,anzSigmaSymbole) where
import Prelude
import Char (toUpper)
import Ix (Ix(inRange))

----------------------------------------------------------------------------
compr :: String -> [(Int,Char)]
uncompr :: [(Int,Char)] -> String

{-
well, here's the straightforward one:
 
compr (x:xs) = compress' 1 x xs where
   compress' n y (x:xs) | y == x    = compress' (n + 1) y xs
  		        | otherwise = (n,y) : (compress' 1 x xs)
   compress' n y [] = [(n,y)]
compr [] = []

well, here is some ugly higher-order variant:

compr s = reverse (foldl (\l c -> if (not (null l)) && (c == snd (head l)) 
                                  then ((fst (head l))+1,c):(tail l) 
                                  else (1,c):l) [] s)
-}

-- and here the variant we use...
compr (x:xs) = (length rep + 1,x) : compr rest 
               where (rep,rest) = span (==x) xs
compr [] = []

-- as for uncompr, much simpler, and much nicer:

uncompr = concat . map (uncurry replicate)

---------------------------------------------------------------------------
sums :: [Integer] -> [Integer]

-- *yawn*

sums = reverse . scanr1 (+)

{- or alternatively

sums = scanl1 (+) . reverse

-- some written out variants:

sums xs = sums' 0 (reverse xs)
  where
    sums' n (x:xs) = let n' = n + x in n' : sums' n' xs
    sums' _ [] = []

-- yet another one...

sums xs = sums' (sum xs) [] xs
  where
    sums' n rs (x:xs) = sums' (n-x) (n:rs) xs
    sums' _ rs [] = rs

-}

----------------------------------------------------------------------------
sumBoth :: [Integer] -> [Integer] -> Integer

{- finally something more to do :-)
-- if we were supposed to use stuff from the List module...

import List (nub,union,(\\),intersect)
sumBoth a b = sum . nub $ union a b \\ intersect a b

-- on the other hand, this is quite slow... so we'll do it ourself...
-}

-- helper function for sorting lists:

sort :: Ord a => [a] -> [a]

{- straightforward, compact ...but slow quicksort:

sort (x:xs) = sort (filter (<=x) xs) ++ x : sort (filter (>x) xs)
sort [] = []

-- here another very cool quicksort variant, proposed by a colleague

sort = foldl (\s t -> (\(u, v) -> u++[t]++v) (break (>t) s)) []

-}

-- well, insertion sort is better for lists:

sort = foldr insert [] 
  where
    insert x ys@(y:ys') | x > y = y : insert x ys'
			| otherwise = x : ys
    insert x [] = [x]

------------------------------------
uniq :: Eq a => [a] -> [a]

{- variant #1:

uniq (x1:x2:xs) | x1 == x2 = uniq (x2:xs)
                | otherwise = x1 : (uniq (x2:xs))
uniq [x1] = [x1]
uniq [] = []

-- variant #2:

uniq = map snd . compr

-- variant #3

uniq = snd . unzip . compr
-}

-- variant #4, the one we finally use:

uniq (x:xs) = x : uniq (dropWhile (==x) xs)
uniq [] = []

------------------------------------
-- finally we have everything we want for the implementation...

sumBoth xs ys = sum (xsect (us xs) (us ys)) 
  where
    us = uniq . sort
    xsect xs@(x:xs') ys@(y:ys') | x < y = x : (xsect xs' ys)
			        | x > y = y : (xsect xs ys')
				| otherwise = xsect xs' ys'
    xsect xs [] = xs
    xsect [] ys = ys

----------------------------------------------------------------------------
anzSigmaSymbole :: String -> [[(Char,Int)]]

-- ...who would have guessed one would be able to write it that concise? =)


anzSigmaSymbole s =
  map ((map (\(x,y)->(y,x))) . compr . sort)
    (zipWith filter [inRange ('a','z'), inRange ('A','Z'), (`elem`"AEIOU")]
      [s,s,map toUpper s])

{- btw, the last line could have been written as well (thus allowing for a
-- points-free implementation)

((zipWith ($) [id,id,map toUpper]) . (replicate 3)) s

-- alternative (slower) helper definitions, for the 3rd line:

isSigmaL c = elem c ['a'..'z']
isSigmaU c = elem c ['A'..'Z']
isSigmaV c = elem c "aeiouAEIOU"

-}

\end{code}
----------------------------------------------------------------------------
-- $Log: Aufgabe4.lhs,v $
-- Revision 1.5  2003/12/14 12:17:14  fp010
-- added imports
--
-- Revision 1.4  2003/11/26 07:29:56  fp010
-- added a few more comments
--
-- Revision 1.3  2003/11/21 07:44:34  fp010
-- got annoyed enough and converted '>' lhs-style to LaTeX-block lhs-style;
--
-- Revision 1.2  2003/11/20 15:53:20  fp010
-- forgot module line; added new variants for compr; replaced
-- quicksort-helper with efficient insertion-sort based algorithm; added
-- some variants for uniq-helper; tuned anzSigmaSymbole a bit;
--
-- Revision 1.1  2003/11/20 06:47:44  fp010
-- first quickndirty draft
--
--