home Funktionale Programmierung: Beispiele und Tests für Monoide Prof. Dr. Uwe Schmidt FH Wedel
Halbgruppen und Monoide
Inhaltsverzeichnis

Beispiele und Tests für Monoide

weiter
weiter

Mittelwert einer Liste von Zahlen

-- Arithmetic Mean of a sequence of numbers
 
module Mean where
 
import Data.Monoid
 
-- the naive solution: with speace leak
 
mean :: (Fractional a) => [a] -> a
mean xs
  = sum xs / fromIntegral (length xs)
 
-- --------------------
--
-- the solution with monoids and a single pass over the sequence
 
mean' :: (Fractional a) => [a] -> a
mean' xs =
  (\ (s, l) -> getSum s / fromIntegral (getSum l))
  . mconcat
  . fmap (\ x -> (Sum x, Sum (1::Int)) )
  $ xs
 
-- --------------------
--
-- :set +s for statistics
--
-- no meaningful timings within ghci
--
-- () -> Double: no result caching
 
t1, t1' :: () -> Double
 
t1  () = mean  [1.0 .. 1000000.0]
t1' () = mean' [1.0 .. 1000000.0]
 
-- --------------------
weiter

Test auf korrekte Klammerung

module Parens where
 
-- check in a string, whether parenthesis are balanced
--
-- two solutions
--
-- 1. with a monoid for counting opening and closing parenthesis
--    (seen in a talk by Edward Kmett about semigroups, monoids and inverse semigrops)
--
-- 2. naive solution: simplification by reduction
 
-- ----------------------------------------
 
data P = P !Int !Int deriving (Eq, Show)
 
instance Semigroup P where
  P x1 y1 <> P x2 y2
    | y1 < x2   = P (x1 + (x2 - y1))  y2
    | otherwise = P  x1  ((y1 - x2) + y2)
 
instance Monoid P where
  mempty = P 0 0
 
balanced :: Foldable t => t Char -> Bool
balanced s = toP s == mempty
 
showP :: P -> String
showP (P x y) = replicate x ')' ++ replicate y '('
 
-- the working horse
--
-- map-reduce with parse as map and <> as reduce
 
toP :: Foldable t => t Char -> P
toP s = foldMap parse s
 
parse :: Char -> P
parse '(' = P 0 1
parse ')' = P 1 0
parse _   = mempty
 
-- more abstract
-- modular, parsing and counting separated
-- constant space for intermediate results
-- may be parallelized due to Semigroup and Monoid instance
-- all chars are processed only once
 
-- ----------------------------------------
 
balanced' :: String -> Bool
balanced' = null . reduce []
 
showP' :: String -> String
showP' = reduce []
 
-- the working horse, scan input, reduce pairs of parenthesis
-- and remember none matching parenthesis
--
-- sequential and chars are compared multiple times
-- intermediate data may grow proportional to input size
 
reduce :: String -> String -> String
reduce xs         []         = reverse xs          -- input read, return result
reduce ('(' : xs) (')' : ys) = reduce xs ys        -- simplify a pair of ()
reduce xs           (y : ys)
  | y == '(' || y == ')'     = reduce (y : xs) ys  -- store parenthesis
  | otherwise                = reduce      xs  ys  -- forget all other chars
 
-- ----------------------------------------
weiter

Fibonacci mit Laufzeit O(log n)

-- http://www.haskellforall.com/2020/04/blazing-fast-fibonacci-numbers-using.html
-- a blog entry by Gabriel Gonzales
--
-- fast fibonacci: O(log n)
 
module Main where
 
import System.Environment (getArgs)
 
-- --------------------
--
-- standard algorithm with runtime O(n)
 
fib0 :: Integer -> Integer
fib0 = fib' 0 1
  where
    fib' x0 x1 n
      | n == 0    = x0
      | otherwise = fib' x1 (x0 + x1) (n - 1)
 
-- --------------------
--
-- 2x2 matrix for computing the next step
 
data Matrix2x2 = Matrix
    { x00 :: Integer, x01 :: Integer
    , x10 :: Integer, x11 :: Integer
    }
 
instance Semigroup Matrix2x2 where
  Matrix l00 l01 l10 l11 <> Matrix r00 r01 r10 r11 =
    Matrix
    { x00 = l00 * r00 + l01 * r10, x01 = l00 * r01 + l01 * r11
    , x10 = l10 * r00 + l11 * r10, x11 = l10 * r01 + l11 * r11
    }
 
instance Monoid Matrix2x2 where
  mempty =
    Matrix
    { x00 = 1, x01 = 0
    , x10 = 0, x11 = 1
    }
 
-- --------------------
--
-- fast exponentiation
-- generalized to monoids
--
-- copied from Data.Monoid
 
mtimes :: Monoid a => Integer -> a -> a
mtimes n x
  | n == 0 = mempty
  | n >  0 = stimes n x
  | otherwise = error "mtimes: negative argument"
 
stimes :: Semigroup a => Integer -> a -> a
stimes n x
  | n == 1    = x
  | even n    = stimes (n `div` 2) (x <> x)
  | otherwise = stimes (n - 1) x <> x
 
-- --------------------
 
fib :: Integer -> Integer
fib n = x01 (mtimes n matrix)
  where
    matrix =
      Matrix
      { x00 = 0, x01 = 1
      , x10 = 1, x11 = 1
      }
 
-- --------------------
 
main :: IO ()
main = do (inp : _) <- getArgs
          let arg = read inp
          let res = fib arg
          let out = "fib " <> show arg <> " = " <> show res
          putStrLn out
 
 
-- --------------------
--
-- simple test with removed output
--
-- :set +s
 
t1 = (== 0) $ fib  (10^6)
t2 = (== 0) $ fib0 (10^6)
 
-- --------------------
weiter

Flexibles Sortieren von Tabellen

module SortTable where
 
-- flexible Sortierung von Tabellen
-- mit Semigroup Instanz fuer Vergleichsfunktionen
 
import Data.Function (on)
import Data.List     (sortBy)
 
{-
sortBy :: (a -> a -> Ordering) -> [a] -> [a]
on     :: (b -> b -> c) -> (a -> b) -> a -> a -> c
-}
 
data Person = P
  { name :: String
  , vorname :: String
  , plz :: Int
  , ort :: String
  }
  deriving (Eq, Ord, Show)
 
type Personen = [Person]
 
personen :: Personen
personen =
  [ P "Merkel"   "Angela" 10115 "Berlin"
  , P "FH Wedel" ""       22880 "Wedel"
  , P ""         "Eto"    30449 "Hannover"
  , P "Seeler"   "Uwe"    22419 "Hamburg"
  ]
 
cName, cVorname, cPlz, cOrt :: Person -> Person -> Ordering
cName    = compare `on` name
cVorname = compare `on` vorname
cPlz     = compare `on` plz
cOrt     = compare `on` ort
 
p0, p1, p2, p3 :: Personen
p0 = sortBy compare personen
p1 = sortBy (cOrt <> cPlz <> cName <> cVorname) personen
p2 = sortBy (cVorname <> cName <> cOrt <> cPlz) personen
p3 = sortBy (flip cOrt <> cPlz <> cName <> cVorname) personen
 
pp :: Person -> String
pp (P n v p o) =
  fmt 10 n <> fmt 8 v <> fmt 6 (show p) <> o
 
pps :: Personen -> String
pps = unlines . map pp
 
fmt :: Int -> String -> String
fmt n = take n . reverse . (replicate n ' ' ++) . reverse
 
pr :: Personen  -> IO ()
pr = putStrLn . pps
SeitenanfangHalbgruppen und Monoide
Inhaltsverzeichnis
Letzte Änderung: 26.09.2020
© Prof. Dr. Uwe Schmidt
Prof. Dr. Uwe Schmidt FH Wedel