Haskell

Am 2008-04-03 fand ein Vortrag zu der Programmiersprache Haskell statt. Unten finden sich die Programme, die vom Vortragenden Lutz Donnerhacke im Laufe des Vortrages geschrieben wurden.

module Tlug where

import System.Directory
import Data.List (intersperse, sortBy)

------------------------------------------------------------------------

sortByFile :: [FilePath] -> [FilePath]
sortByFile = sortBy compareByFile
  where
    compareByFile a b = stripDir a `compare` stripDir b
    stripDir = reverse . fst . break ('/'==) . reverse

getAllEntries :: Directory -> IO [FilePath]
getAllEntries dir = do
   let prependDir  = (dir++) . ('/':)
       prependDirM = map prependDir
   
   entries <- getDirectoryContents dir
   (files, directories) <- selectFiles prependDir entries
   putStrLn $ "Debug: " ++ dir ++ ": " ++ concat (intersperse ", " directories)
   
   fss <- mapM getAllEntries
        . prependDirM
    $ [ d | d <- directories, d /= ".", d /= ".." ]

   return $ prependDirM files ++ concat fss

selectFiles :: (FilePath -> FilePath) -> [FilePath] -> IO ([FilePath], [Directory])
selectFiles _  []     = return ([], [])
selectFiles pp (p:ps) = do
   isDir <- doesDirectoryExist (pp p)
   (fs,ds) <- selectFiles pp ps
   return $ if isDir then (fs, p:ds) else (p:fs, ds)

type Directory = FilePath

fac n = length $ permutate [1 .. n]

permutate :: [a] -> [[a]]
permutate [] = [[]]
permutate (x:xs) = concatMap (insertEveryWhere x) (permutate xs)

insertEveryWhere :: a -> [a] -> [[a]]
insertEveryWhere x (y:ys) = (x : y : ys)
                          : map (y :) (insertEveryWhere x ys)
insertEveryWhere x [] = [[x]]

{-
data Vec liste element = Null | Nach liste element

vectorAdd Null Null = Null
vectorAdd (Nach x a) (Nach y b) = Nach (x `vectorAdd` y) (a + b)

vectorLength Null = 0
vectorLength (Nach x _) = 1 + vectorLength x
-}

sortiert [] = True
sortiert [x] = True
sortiert (x:y:xs) | x > y     = False
                  | otherwise = sortiert (y:xs)

sort [] = []
sort xs = mini : sort (rest1 ++ tail rest2)
  where
    mini = minimum xs
    (rest1, rest2) = break (mini ==) xs

qsort [] = []
qsort (x:xs) = qsort [ y | y <- xs, y <  x]
            ++ [x]
            ++ qsort [ y | y <- xs, y >= x]

fibs = 1 : 1 : zipWith (+) fibs (tail fibs)

fib n = fibs !! n

prims = 2 : [ x | x <- [3, 5 ..], isPrim x ]

isPrim = null . factors

factors x = [ p | p <- takeWhile (\p -> p*p <= x) prims
                , x `mod` p == 0 ]