Links und Funktionen
Sprachumschaltung

Navigationspfad
Sie sind hier: Startseite / Lehre / SS 2012 / Funktionale Programmierung / Übungen / Lösung 02


Inhaltsbereich

Lösung 02

Lösung zu Blatt 02

Haskell source code icon 02SheetSolution.hs — Haskell source code, 4 KB (4879 bytes)

Dateiinhalt

-- | Functional Programming, course at LMU, summer term 2012
--   Andreas Abel and Steffen Jost
--
-- Exercise sheet 2, 2012-05-03
--
-- Instructions:
--
-- Replace all occurrences of 'undefined' and 'Undefined' by sensible code.
-- Do not change the type of functions you are asked to implement!
--
-- Submit your solutions via UniWorX.

----------------------------------------------------------------------
-- Header
--
-- You can add imports and LANGUAGE pragmas here.
----------------------------------------------------------------------

module Main where

import Control.Applicative ((<$>))
import Control.Monad

import qualified Data.List as List

import Debug.Trace

import System.Directory
import System.Environment
import System.FilePath

----------------------------------------------------------------------
-- Exercise 1  Sudoku-Board as list of lists
----------------------------------------------------------------------

-- | A completely filled Sudoku board is represented as a list of 9 rows
--   which are each a list of 9 numbers between 1 and 9 (inclusively).
type Sudoku = [Row]
type Row    = [Int]
type Group  = [Int]

-- | A (completely filled) Sudoku board is valid if all its @rows@, @columns@
--   and @n×n@-@blocks@ are permutations of @1..n*n@.
validSudoku :: Int -> Sudoku -> Bool
validSudoku n s = all validGroup $ rows s ++ columns s ++ blocks n s

validGroup :: Group -> Bool
validGroup g = List.sort g == [1..length g]

-- | Return the rows of a Sudoku board.
rows :: Sudoku -> [Group]
rows = id

-- | Return the columns of a Sudoku board.
columns :: Sudoku -> [Group]
columns = transpose

-- | Transpose a matrix.
transpose :: [[a]] -> [[a]]
transpose                 [] = [] -- no rows ==> no columns
transpose      ([]      : _) = [] -- empty columns ==> no columns
transpose rows@((_ : _) : _) = map head rows : transpose (map tail rows)

-- | Return the n × n subquares a Sudoku board.
blocks :: Int -> Sudoku -> [Group]
blocks n = concat . map (map concat . transpose . map (groups n)) . groups n

-- | Partition a list in sublists of length @n@.
groups :: Int -> [a] -> [[a]]
groups n [] = []
groups n l  = let (g,xs) = splitAt n l in g : groups n xs

----------------------------------------------------------------------
-- Exercise 2 Printing the directory tree
----------------------------------------------------------------------

whenM :: Monad m => m Bool -> m a -> m ()
whenM mb mt = do
  b <- mb
  when b $ do
    mt
    return ()
-- or, in one line:
-- whenM mb mt = mb >>= flip when (mt >> return ())

-- | @printIndented n p@ outputs the file name component of @p@
--   indented by @2 * n@ spaces.
printIndented :: Int -> FilePath -> IO ()
printIndented n p = putStrLn $ replicate (2 * n) ' ' ++ takeFileName p

-- | Print the directory tree recursively, starting with directory @root@.
--   Files and hidden directories are skipped.
--
--   For instance, a directory structure
--
--     @
--     root
--       aDir
--         aFile1
--       bDir
--         cDir
--           cFile1
--       dFile
--
--     @
--
--  is printed as
--
--    @
--       aDir
--       bDir
--         cDir
--    @
--
--  with sensible indentation to express child and sibling relations.
--
mainDir :: FilePath -> IO ()
mainDir root = mapM_ (printDirTree 0 root) =<< getDirectoryContents root

printDirTree :: Int -> FilePath -> FilePath -> IO ()
printDirTree n root ('.':_) = return () -- exclude "." ".." etc
printDirTree n root p = do
  let root' = root </> p
  whenM (doesDirectoryExist root') $ do
    printIndented n p
    mapM_ (printDirTree (n + 1) root') =<< getDirectoryContents root'

main :: IO ()
main = do
  args <- getArgs
  mainDir $ if null args then "." else head args

----------------------------------------------------------------------
-- Exercise 3  Lazy monadic Boolean operators
----------------------------------------------------------------------

-- Conjunction and Disjunction are lazy

verbose :: Bool -> Bool
verbose b = trace ("encountered " ++ show b) b

tA = [True, False, True, False]
tO = [False, True, False, True]

testA = and $ map verbose tA
testO = or  $ map verbose tO

-- Naive adaption to a monad makes them strict

verboseM :: Bool -> IO Bool
verboseM b = putStrLn ("encountered " ++ show b) >> return b

testMA = and <$> mapM verboseM tA
testMO = or  <$> mapM verboseM tO

-- Implement lazy monadic conjunction and disjunction!

andM :: Monad m => [m Bool] -> m Bool
andM []         = return True
andM (mb : mbs) = do
  b <- mb
  if b then andM mbs else return False

orM :: Monad m => [m Bool] -> m Bool
orM []         = return False
orM (mb : mbs) = do
  b <- mb
  if b then return True else orM mbs

-- The following test cases should only print those Booleans
-- that are necessary to determine the result of the operation!

testLA = andM $ map verboseM tA
testLO = orM  $ map verboseM tO
Verweise
Übung 02

Artikelaktionen


Funktionsleiste