Ville Tirronen

6.10.2011

Muistutuksia

Ryhmät

Hienoa työtä!
Muistakaa päivittää palautusrepon README vastaamaan ryhmän aitoa kokoonpanoa.

Kysymykset

Pariin viimeviikkoon ette ole kysyneet ennen ohjauksia mitään.
Oppiminen on teidän vastuullanne → Tehkää kysymyksiä!

Tämän tilaisuuden tarkoitus & käytäntö

Tarkoitus

Pohditaan hieman miten funktio-ohjelmia kannattaa rakentaa.
Mietitään modulaarisuutta, turvallisuutta ja uudelleenkäytettävyyttä.
Tarkastellaan ohjelmointityyliä.

Käytäntö

Kalvoilla on valittuja ohjelmia
Ryhmä esittää miten ohjelma on tehty ja vastaa harjoitusten kirjoitustehtävään.
Minä esitän omia 'parannuksiani'.

Miten funktio-ohjelma suunnitellaan?

Olio-ohjelmointi

löydetään olennaiset oliot / luokat
Pyritään selvittämään miten oliot kommunikoivat, ts. mitkä ovat niiden väliset yksittäiset relaatiot?
Toteutetaan ohjelma olioiden verkkona.

Funktio-ohjelmointi

Selvitetään olennaiset (algebralliset) tyypit.
Päätellään tarvittavat operaatiot näille tyypeille.
(Selvitetään tyyppejä ja operaatioita koskevat aksioomat.)
Koostetaan ohjelma yo. operaatioista.

hn-so-jl-ma

import Data.Char

main = do 
    putStrLn "Anna merkkijono: " 
    x <- getLine
    if null x then return ()
    else do
        if (onkoPalindromi (poistaErikoisetjaPienenna x)) == Just True 
            then putStrLn "Antamasi merkkijono on palindromi."
            else putStrLn "Antamasi merkkijono ei ole palindromi."

onkoPalindromi :: String -> Maybe Bool
onkoPalindromi [] = Nothing
onkoPalindromi [x] = Just True
onkoPalindromi [x,y] | x==y = Just True
                     | x/=y = Just False
onkoPalindromi xs    | head xs /= last xs = Just False
                     | otherwise = onkoPalindromi $ init.tail $ xs

poistaErikoisetjaPienenna []     = []
poistaErikoisetjaPienenna (x:xs)
                        | isAlpha x = (toLower x):poistaErikoisetjaPienenna xs
                        | otherwise = poistaErikoisetjaPienenna xs

hn-so-jl-ma - korjauksia

poistaErikoisetjaPienenna []     = []
poistaErikoisetjaPienenna (x:xs)
                        | isAlpha x = (toLower x):poistaErikoisetjaPienenna xs
                        | otherwise = poistaErikoisetjaPienenna xs

Käydään lista läpi ja suodatetaan, eli map + filter

poistaErikoisetjaPienenna = map toLower . filter isAlpha

Ei tarvitse huolehtia meneekö rekursio oikein.

hn-so-jl-ma - korjauksia

onkoPalindromi :: String -> Maybe Bool
onkoPalindromi [] = Nothing
onkoPalindromi [x] = Just True
onkoPalindromi [x,y] | x==y = Just True
                     | x/=y = Just False
onkoPalindromi xs    | head xs /= last xs = Just False
                     | otherwise = onkoPalindromi $ init.tail $ xs

sana on palindromi, jos se on sama takaperin.
tyhjä jono on myös palindromi. (Testataan mainissa)

onkoPalindromi :: String -> Bool
onkoPalindromi xs = reverse xs == xs

Ei tarvitse huolehtia meneekö rekursio oikein.

hn-so-jl-ma - korjauksia

Siistitään main
Yhdistetään merkkijonon siivous ja palindromien laskenta

import Data.Char
import Data.List

main = do 
    putStrLn "Anna merkkijono: " 
    x <- getLine
    case x of
        _ | null x           -> return ()
        _ | onkoPalindromi x -> putStrLn "Antamasi merkkijono on palindromi."
        _                    -> putStrLn "Antamasi merkkijono ei ole palindromi."

onkoPalindromi :: String -> Bool
onkoPalindromi x = let l = map toLower . filter isAlpha $ x 
                   in reverse l == l

Säästyi 9 riviä koodia
Poistettiin 8 haarautumiskohtaa. Jokainen niistä oli mahdollinen pesä bugille.

Team Haskell

Aliohjelma laskee Christofideen ja Eilonin TSP-estimointikaavan mukaisen arvion optimaalisen reitin pituudesta

void calculateEstimate(int numPoints, double phi)
{
  double estimate=0;
  float minX,minY,maxX,maxY;

  minX=minY=Float.MAX_VALUE;
  maxX=maxY=Float.MIN_VALUE;

//we find the maximum & minimum coordinates
  for(int i=1;i<numPoints;i++) 
  {
    if(xc[i]<minX)
      minX=xc[i];
    if(xc[i]>maxX)
      maxX=xc[i];
    if(yc[i]<minY)
      minY=yc[i];
    if(yc[i]>maxY)
      maxY=yc[i];
  }

//we calculate the area of rectangle including all points
float area=(maxX-minX)*(maxY-minY);
estimate=phi*Math.sqrt(area*(numPoints-1));
}

Team Haskell

estimator :: [(Float, Float)] -> Int -> Float -> Float
estimator [] _ _  = -1.0 --virhearv
estimator _ 0 _   = -1.0
estimator x n phi = phi * sqrt ( fromIntegral (n-1) * areaOf x)

areaOf :: [(Float, Float)] -> Float
areaOf x = leveys * korkeus
 where 
  leveys       = maxx - minx
  korkeus      = maxy - miny 
  (maxx,maxy)  = findMaxs x
  (minx, miny) = findMins x

findMins :: [(Float, Float)] -> (Float, Float)
findMins xs = findCoords minimum xs

findMaxs :: [(Float, Float)] -> (Float, Float)
findMaxs xs = findCoords maximum xs

findCoords :: ([Float] -> Float) -> [(Float, Float)] -> (Float, Float)
findCoords f xs = (minfst, minsnd)
 where
  minfst = f [fst x | x <- xs ]
  minsnd = f [snd x | x <- xs ]

Team Haskell - Ehdotuksia

Olennaiset tyypit ovat suorakaide ja piste.
Operaatiot ovat pinta-ala ja ympäröivän suorakaiteen laskenta.

data Rectangle a = R {left :: a, right :: a, top :: a, bottom :: a}

area :: Num a => Rectangle a -> a
area (R  minx maxx miny maxy) = (maxx-minx) * (maxy-miny)

boundingBox :: (Ord a, Bounded a) => [(a,a)] -> Rectangle a
boundingBox = foldl' f void
    where
     f (R a b c d) (x,y) = R (min a x) (max b x) (min c y) (max d y)
     void = R maxBound minBound maxBound minBound

Team Haskell - Ehdotuksia

Tällöin ohjelma siistiytyy näin:

estimator :: (Ord a, Floating a, Bounded a) => t -> [(a, a)] -> a
estimator phi xs = sqrt $ (genericLength xs-1) * (area . boundingBox $ xs)

data Rectangle a = R {left :: a, right :: a, top :: a, bottom :: a}

area :: Num a => Rectangle a -> a
area (R  minx maxx miny maxy) = (maxx-minx) * (maxy-miny)

boundingBox :: (Ord a, Bounded a) => [(a,a)] -> Rectangle a
boundingBox = foldl' f universe
    where
     f (R a b c d) (x,y) = R (min a x) (max b x) (min c y) (max d y)
     universe = R maxBound minBound maxBound minBound

Säästettiin 11 riviä.
Saatiin alulle yksi yleiskäyttöinen tietotyyppi.
Listan läpikäyntejä vain yksi.

hjst - java

import java.io.*;
import java.util.*;

public class T1 {
    public static void main(String[] args) {
        BufferedReader fi;
        try {  // Avataan tiedosto lukemista varten
          fi = new BufferedReader(new FileReader("tiedosto.txt"));
        } catch (FileNotFoundException ex) {
          System.out.println("Tiedosto ei aukea!");
          return;
        }
      try {
          String s = new String();
          for( int i = 1;  ( s = fi.readLine() ) != null; i++) {
            // Tulostetaan riveille numerot ja katkaistaan pitkät rivit
            if(s.length() > 40)
                System.out.println("/" + "* 0" + i + " *" + "/ " 
                                       + s.substring(0,40));
            else
                System.out.println("/" + "* 0" + i + " *" + "/ " + s);
          }
    } catch (IOException ex) {
        System.out.println("Virhe tiedostoa luettaessa!");
      } finally {  // Aina ehdottomasti finally:ssa resurssien vapautus
        try {
          fi.close();  // tiedoston sulkeminen heti kun sitä ei enää tarvita
        } catch (IOException ex) {
          System.out.println("Tiedostoa ei saa suljettua!");
        }
      }
    }

hjst - haskell

module Main where

import System.Environment
import System.IO.Error
import System.IO
import Data.List 

-- Palauttaa rivinumeron mukavan pituisena nolla-alkuisena numerona
indexing :: Int -> Int -> String
indexing total current = "/* " ++ take pad (repeat '0') ++ show current ++ " */ "
  where pad = length (show total) - length (show current)

-- Listan alkioit typistettynä 40-merkkisiksi, etuliitteenä vielä rivinumero
formatList :: [String] -> [String]
formatList xs = zipWith op [1..] xs
  where
    op i r = (index i) ++ (take 40 r)
    index = indexing (length xs)

-- Lukee tiedoston ja kopioi sen toiseen tiedostoon.
main = do [luetaan,kirjoitetaan] <- getArgs
          inh <- openFile luetaan ReadMode
          outh <- openFile kirjoitetaan WriteMode
          inputti <- readFile luetaan
          let rivit = lines inputti
          writeFile kirjoitetaan $ unlines (formatList rivit)
          hClose inh
          hClose outh

hjst - korjauksia

Main ei toimi:

-- Lukee tiedoston ja kopioi sen toiseen tiedostoon.
main = do [luetaan,kirjoitetaan] <- getArgs
          inh <- openFile luetaan ReadMode
          outh <- openFile kirjoitetaan WriteMode
          inputti <- readFile luetaan
          let rivit = lines inputti
          writeFile kirjoitetaan $ unlines (formatList rivit)
          hClose inh
          hClose outh

readFile ja writeFile avaavat tiedostonsa itse:

-- Lukee tiedoston ja kopioi sen toiseen tiedostoon.
main = do [luetaan,kirjoitetaan] <- getArgs
          inputti <- readFile luetaan
          let rivit = lines inputti
          writeFile kirjoitetaan $ unlines (formatList rivit)

hjst - korjauksia

-- Lukee tiedoston ja kopioi sen toiseen tiedostoon.
main = do [luetaan,kirjoitetaan] <- getArgs
          inputti <- readFile luetaan
          let rivit = lines inputti
          writeFile kirjoitetaan $ unlines (formatList rivit)

Käytetään yhdistettyjä funktioita

formatString :: String -> String
formatString = unlines . formatList . lines

main = do [luetaan,kirjoitetaan] <- getArgs
          readFile luetaan >>= writeFile kirjoitetaan . formatString

hjst - korjauksia

main = do [luetaan,kirjoitetaan] <- getArgs
          readFile luetaan >>= writeFile kirjoitetaan . formatString

:main kissa => Pattern Match failure

main = do as <- getArgs
          case as of
           [luetaan,kirjoitetaan] 
             -> readFile luetaan >>= writeFile kirjoitetaan . formatString
           [luetaan]         
             -> readFile luetaan >>= putStr . formatString
           [] -> putStrLn "Anna tiedostonimi"

jaheee - PingPong

module Main where

import Graphics.Gloss
import Graphics.Gloss.Data.Vector
import Graphics.Gloss.Interface.Game

data PingPongWorld = GameOver 
                    | Start
                    | World { player1       :: Player
                              ,player2      :: Player
                              ,ball         :: Ball }

data Player = Player Score Paddle

data Paddle = Paddle Point Size State
data State = SUp | SStay | SDown deriving Eq

type Size = Float
type Score = Int 

data Ball = GBLeft | GBRight | Ball Point Velocity Size 
type Velocity = Point

jaheee - PingPong

screenW :: Float
screenW = 400

playerX :: Float
playerX = screenW/2 - 5

padVel = 200

initialWorld sc1 sc2 = World (Player sc1 (Paddle (-playerX,0) 100 SStay)) 
                     (Player sc2 (Paddle (playerX,0) 100 SStay))
                     (Ball (0,0) (150,0) 10)

jaheee - PingPong

drawWorld  (World (Player sc1 p1) (Player sc2 p2) ball@(Ball (bx,_) (_,_) _))
  = rotate rot . pictures $ [drawBall ball, drawPaddle p1
                            , drawPaddle p2 , drawScore,
                            , color red . Line $ [(-screenW/2,screenW/2)
                                                 ,(screenW/2,screenW/2)] 
                            , color red . Line $ [(-screenW/2,-screenW/2)
                                                 ,(screenW/2,-screenW/2)]]
    where
        drawBall (Ball (bx,by) (bvx,bvy) bs) 
            = color red . translate bx by . circle $ bs
        drawBall _ 
            = Blank
        drawScore 
            = color red . translate (-150) (screenW/2) . scale 0.25 0.25 
                        . Text $ (show sc1) ++ " - " ++ (show sc2) 
        drawPaddle  (Paddle (x,y) s _) 
            = color red . translate x y . Line $ [(0,-s/2),(0,s/2)]
        rot = fromIntegral (sc1-sc2) + (fromIntegral (sc1+sc2) * (bx / screenW))

drawWorld w_ = Blank

jaheee - PingPong

simulateWorld _ GameOver = GameOver
simulateWorld _ Start = Start 
simulateWorld _ (World p1@(Player sc1 paddle1) 
                       p2@(Player sc2 paddle2) GBRight) 
    = initialWorld (sc1+1) sc2
simulateWorld _ (World p1@(Player sc1 paddle1) 
                       p2@(Player sc2 paddle2) GBLeft) 
    = initialWorld sc1 (sc2+1)
simulateWorld step (World p1@(Player sc1 paddle1) 
                          p2@(Player sc2 paddle2) ball) 
    = World (Player sc1 (updatePaddle paddle1)) (Player sc2 (updatePaddle paddle2)) (updateBall ball)
    where
        updatePaddle (Paddle (x,y) s state) 
         | state == SUp && y + s/2 < screenW/2 = Paddle (x,y+padVel*step) s state
         | state == SDown && y - s/2 > -screenW/2 = Paddle (x,y-padVel*step) s state
         | otherwise = Paddle (x,y) s state
        updateBall (Ball (x,y) (vx,vy) s) 
         | collidesWithPaddle paddle1 ball = paddleHit paddle1 ball
         | collidesWithPaddle paddle2 ball = paddleHit paddle2 ball
         | x > screenW/2 = GBRight 
         | x < -screenW/2 = GBLeft 
         | y >  screenW/2 = Ball (x+vx*step,screenW/2-(abs vy)*step) (vx,-(abs vy)) s
         | y < -screenW/2 = Ball (x+vx*step,-screenW/2+(abs vy)*step) (vx, abs vy) s
         | otherwise      = Ball (x+vx*step,y+vy*step) (vx, vy) s

jaheee - PingPong

collidesWithPaddle (Paddle (px,py) size _) (Ball (bx,by) _ s) 
    = (abs (py-by) < size/2) && (abs (px-bx) < s/2) 
paddleHit (Paddle (px,py)  _  SStay) (Ball (bx, by) (vx,vy) s) 
    = Ball (bx-(sign px) * s* 2,by) (-vx, vy) s
paddleHit (Paddle (px,py)  size  SUp)   (Ball (bx, by) (vx,vy) s) 
    = Ball (bx-(sign px) * s* 2,by) (-vx, vy+250*(abs (py - by))/size) s
paddleHit (Paddle (px,py)  size  SDown) (Ball (bx, by) (vx,vy) s) 
    = Ball (bx-(sign px) * s* 2,by) (-vx, vy-250*(abs (py - by))/size) s

sign x = x / abs x

jaheee - PingPong

handleEvents (EventKey (Char 'w') Down _ _)
    (World (Player sco (Paddle pos1 size _)) pl2 ball ) 
        = World (Player sco (Paddle pos1 size SUp)) pl2 ball 

handleEvents (EventKey (Char 's') Down _ _)
    (World (Player sco (Paddle pos1 size _)) pl2 ball ) 
        = World (Player sco (Paddle pos1 size SDown)) pl2 ball 

handleEvents (EventKey (Char 'o') Down _ _)
    (World pl1 (Player sco (Paddle pos1 size _)) ball ) 
        = World pl1 (Player sco (Paddle pos1 size SUp)) ball 

handleEvents (EventKey (Char 'l') Down _ _)
    (World pl1 (Player sco (Paddle pos1 size _)) ball ) 
        = World pl1 (Player sco (Paddle pos1 size SDown)) ball 

.. 
..

jaheee - PingPong

main = gameInWindow
            "PingPong"
             (floor screenW, floor screenW)
             (20,20)
             black
             24 
             (initialWorld 0 0)
             drawWorld
             handleEvents
             simulateWorld

jaheee - Korjauksia

Asioille kannattaa antaa enemmän nimiä

Demomiehet

import System.Random

main = do
    let r1 = (randomList 100000 1.0 (mkStdGen 99))
        r2 = (randomList 100000 1.0 (mkStdGen 232))
    print $ 4.0 * likiarvo (laskePi (coord r1 r2))

randomList :: Int -> Double -> StdGen -> [Double]
randomList 0 _ _ = []  
randomList a b c = take a (randomRs(0,b) c)

coord :: [a] -> [b] -> [(a,b)] 
coord a b = zip a b

laskePi :: [(Double,Double)] -> [Bool]
laskePi [] = []  
laskePi ((a,b):xs) = onkoSisalla a b : laskePi xs 

onkoSisalla :: Double -> Double -> Bool
onkoSisalla a b = if (sqrt((a*a)+(b*b)) < 1) then True else False

likiarvo :: [Bool] -> Double
likiarvo [] = 0.0   
likiarvo x = (intToDouble (length (filter (==True) x))) / intToDouble (length(x))

intToDouble :: Int -> Double     
intToDouble x = fromIntegral x

Demomiehet

Paljon turhia tapauksia
Voidaan käyttää yleisempiä funktioita

import System.Random

main = do
    let r1 = (randomList 100000 1.0 (mkStdGen 99))
        r2 = (randomList 100000 1.0 (mkStdGen 232))
    print $ (1/100000) * 4.0 * fromIntegral (count onkoSisalla (zip r1 r2)))

randomList :: Int -> Double -> StdGen -> [Double]
randomList a b c = take a (randomRs(0,b) c)

onkoSisalla :: (Double, Double) -> Bool
onkoSisalla (a, b) = (sqrt((a*a)+(b*b)) < 1)

count :: (a -> Bool) -> [a] -> Int
count x = length . filter p

ryhmah

module Main where

type Piste a = (a,a)

viivaIntegraali :: (Floating a) => (Piste a -> a) -> (a -> Piste a) -> [a] -> a
viivaIntegraali funktio polku väli = sum $ zipWith ala väli (tail väli)
    where
    ala x y = (keskiarvo x y)*(välinpituus x y)
    välinpituus x y = pituus (polku x .- polku y)
    keskiarvo x y =  (funktio (polku x) + funktio (polku y))/2


(.-) :: (Floating a) => Piste a -> Piste a-> Piste a
(x,y) .- (u,v) = (x-u,y-v)
infixl 6 .-

pituus :: (Floating a) => Piste a -> a
pituus (x,y) = sqrt (x**2+y**2)

-- Tässä muuten hämää käsittämätön numeerinen virhe listan automaagisessa
-- generaatiossa. Keskimmäinen lista on ihan eri näköinen jos sen ensin
-- generoi kokonaislukuina ja sitten jakaa jokaisen luvun kymmenellä eli map (/10)
-- [51,52..100].

esimerkkiVäli = [1,2..5]++[5.1,5.2..10]++[11,12..15]

esimerkkiPolku :: (Floating a) => a -> Piste a
esimerkkiPolku t = (sinh t,sin t)

esimerkkiFunktio :: (Floating a) => Piste a -> a
esimerkkiFunktio (x,y) = x*y**2

main = print $ viivaIntegraali esimerkkiFunktio esimerkkiPolku esimerkkiVäli

-- Lisäbonus
integraali :: (Floating a) => (a -> a) -> [a] -> a
integraali funktio väli = viivaIntegraali (ulotteistaja funktio) pisteyttäjä väli
    where
    pisteyttäjä x = (x,0)
    ulotteistaja funktio (x,y) = funktio x

mmvp

module Main where

import Graphics.Gloss hiding (Path, Point)
import Graphics.Gloss.Data.Vector
import Graphics.Gloss.Interface.Game hiding (Path, Point)
import qualified Data.Map as Map 
import Random

type Point a = (a, a)
type Path a = [Point a]

-- Vektorioperaattorit
(.-) , (.+) :: (Num a) => Point a -> Point a -> Point a
(x,y) .- (u,v) = (x-u,y-v)
(x,y) .+ (u,v) = (x+u,y+v)
infixl 6 .- , .+
infixl 7 .*
(.*) :: (Num a) => a -> Point a -> Point a
s .* (u,v) = (s*u,s*v)

snakeSize = 5
snakeSizeF = fromIntegral snakeSize

left = (-1, 0)
right = (1, 0)
up = (0, 1)
down = (0, -1)

type Controls = Map.Map Key (Point Int)
type Direction = Point Int
data Turn = Turn {
    direction :: Direction,
    timestamp :: Int
} deriving (Eq)

data Player = Player {
    startPosition :: Point Int,
    colour :: Color,
    turns :: [Turn],
    controls :: Controls,
    randomNumbers :: [Int],
    timeOfDeath :: Int
} 

instance Eq Player where 
    p1 == p2 = (colour p1) == (colour p2)

data GameState = GameState {
    players :: [Player],
    time :: Float,
    bounds :: Point Int
}

isAlive player = timeOfDeath player == 0

isAIPlayer player = Map.null (controls player)

isGameOver :: GameState -> Bool
isGameOver game = length (filter isAlive (players game)) < 2

playerDirection player = direction . last $ turns player

playerCanTurnToDirection player (x1, y1) = x1 + x2 /= 0 && y1 + y2 /= 0
    where 
        (x2, y2) = playerDirection player

updateGameState :: Float -> GameState -> GameState
updateGameState delta game@(GameState players prevTime bounds) = 
    if isGameOver game then
        game
    else
        GameState (map (updatePlayer (floor time)) 
                  (updateAIPlayers game)) time bounds
    where
        time = prevTime + 1  --TODO: Use delta

        updatePlayer time player@(Player startPosition colour turns controls 
                                  nums tod) 
          = Player startPosition colour turns controls nums timeOfDeath
            where timeOfDeath = if isAlive player then
                                    (if (collidesWithBounds bounds position) 
                                        || collidesWithOthers then time else 0)
                                else tod
                where
                    position@(x, y) = playerPosition time player
                    collidesWithOthers = foldl (\acc other -> 
                                                  acc || checkCollision player other ) 
                                               False players
                        where checkCollision player other 
                               = collidesWithPath (playerPath excludeHeadIfSelf other) (x, y)
                            where excludeHeadIfSelf = if other == player then time - 1 else time


updateAIPlayers :: GameState -> [Player]
updateAIPlayers game@(GameState players prevTime bounds) 
    = map (\player -> if isAIPlayer player && isAlive player 
                        then updateAIPlayer game player 
                        else player) players

updateAIPlayer :: GameState -> Player -> Player
updateAIPlayer game@(GameState players prevTime bounds) 
               player@(Player startPosition _ turns _ rands _)
    | collidesWithSomething || time - (timestamp (last turns)) >= 20 + (rand1 `mod` 30) 
        = turnAIPlayer game (player {randomNumbers = newRands})
    | otherwise = player
        where
            rand1 = head rands
            rand2 = head (drop 1 rands)
            newRands = drop 2 rands
            time = floor prevTime
            collidesWithSomething = 
                case playerCollisionDistanceAtDirection game player (playerDirection player) (2 + rand2 `mod` 10) 
                    of Just x -> True 
                       Nothing -> False

playerCollidesAtDirection :: GameState -> Player -> Direction -> Int -> Bool
playerCollidesAtDirection (GameState players prevTime bounds) player direction distance
    = any collidesWithPlayer players || collidesWithBounds bounds nextPosition
    where
        time = floor prevTime
        collidesWithPlayer otherPlayer = collidesWithPath (playerPath time otherPlayer) nextPosition 
        nextPosition = (playerPosition time player .+ distance .* direction)

playerCollisionDistanceAtDirection :: GameState -> Player -> Direction -> Int -> Maybe Int
playerCollisionDistanceAtDirection game player direction maxDistance
    | noCollisionDistance < maxDistance = Just (noCollisionDistance + 1)
    | otherwise = Nothing
    where noCollisionDistance = case takeWhile (\distance -> not $ playerCollidesAtDirection game 
                                                                       player direction distance) 
                                     [1..maxDistance] of 
                                 [] -> 0
                                 xs -> last xs

randomAITurnDirection :: GameState -> Player -> Int -> Maybe Direction
randomAITurnDirection game player randomNumber = if null candidates 
                                                     then Nothing 
                                                     else Just $ candidates !! (randomNumber `mod` length candidates)
    where
        candidates = map fst $ filter (\(direction, distance) -> distance == maxDistance)
                                 collisionDistances
        maxDistance = foldr max 0 $ map snd collisionDistances
        collisionDistances = [(direction, collisionDistanceAtDirection direction) 
                             | direction <- legalDirections] 
        legalDirections = [d | d <- [left, right, up, down]
                          ,playerCanTurnToDirection player d
                          ,not (playerCollidesAtDirection game player d 1)]
        collisionDistanceAtDirection direction 
            = case playerCollisionDistanceAtDirection game player direction 10 of 
                    Just x -> x
                    Nothing -> infiniteDistance
        infiniteDistance = 100000

turnAIPlayer :: GameState -> Player -> Player
turnAIPlayer game@(GameState players prevTime bounds) 
             player@(Player startPosition _ turns _ rands _)
     = case randomAITurnDirection game player (head rands) of 
         Nothing -> player
         Just direction -> (turnPlayer (Turn direction time) player) 
                            { randomNumbers = drop 1 rands }
             where
                time = floor prevTime

-- Converts path to a list of lines
lineByLine :: [a] -> [(a,a)]
lineByLine [] = []
lineByLine (x:[]) = []
lineByLine (x:xs) = (x,head xs):(lineByLine xs)

collidesWithPath :: (Path Int) -> (Point Int) -> Bool
collidesWithPath path point 
    = any (\line -> collidesWithLine line point) (lineByLine path)
    where collidesWithLine ((x1,y1),(x2,y2)) (x, y)
             = (x >= (min x1 x2) && y >= (min y1 y2) 
                && x <= (max x1 x2) && y <= (max y1 y2))

collidesWithBounds :: (Point Int) -> (Point Int) -> Bool
collidesWithBounds (bx, by) (x, y) = x < -bx || y < -by || x > bx || y > by

-- Returns players position at specific point in time
playerPosition :: Int -> Player -> Point Int
playerPosition time player = last (playerPath time player)


pathFromTurns :: Int -> Point Int -> [Turn] -> Path Int
pathFromTurns time turnPosition [] = [turnPosition]
pathFromTurns time turnPosition ((Turn direction turnTime):turns) 
 = turnPosition : (pathFromTurns time nextTurnPosition turns)
    where
        nextTurnPosition = turnPosition .+ ((nextTurnTime time turns) - turnTime) .* direction
        nextTurnTime time [] = time
        nextTurnTime _ ((Turn _ t):turns) = t


playerPath :: Int -> Player -> Path Int
playerPath time player = pathFromTurns playerTime (startPosition player) (turns player)
    where
        playerTime = if isAlive player then time else timeOfDeath player

-- For drawing thicker lines
lineAsRect :: Path Float -> Picture
lineAsRect path = pictures (map drawRect (lineByLine path))

drawRect :: (Point Float, Point Float) -> Picture
drawRect ((x1, y1), (x2, y2)) = translate (x + 0.5 * w) y pic
    where
        x = min x1 x2 - 0.5
        y = min y1 y2 - 0.5
        w = ((max x1 x2) + 0.5 - x)
        h = ((max y1 y2) + 0.5 - y)
        pic = rectangleUpperSolid w h 


drawGame :: GameState -> Picture
drawGame game = pictures (map (drawPlayer game) (players game))
    where drawPlayer game player 
           = scale snakeSizeF snakeSizeF . Color drawColor . lineAsRect 
                $ map convertTuple (playerPath (floor (time game)) player)
        where
            drawColor = if isAlive player then colour player else greyN 0.5
            convertTuple (x, y) = (fromIntegral x, fromIntegral y)

-- Handles player input
handleInput :: Event -> GameState -> GameState
handleInput (EventKey key Down _ _) game = 
    if isGameOver game then
        initGameState
    else
        GameState playerList (time game) (bounds game)
        where playerList = [ if isAlive player then handleInputFor player else player 
                           | player <- (players game) ]
            where handleInputFor player = case Map.lookup key (controls player) of
                Nothing -> player
                Just direction -> turnPlayer (Turn direction (floor (time game))) player
handleInput _ g = g

turnPlayer :: Turn -> Player -> Player
turnPlayer turn player = 
    if isLegal then
        Player (startPosition player) (colour player) ((turns player) ++ [turn]) 
               (controls player) (randomNumbers player) 0
    else
        player
            where
                lastTurn = last (turns player)
                (x1, y1) = direction lastTurn
                (x2, y2) = direction turn
                isLegal = (playerCanTurnToDirection player (direction turn)) 
                            && timestamp lastTurn < timestamp turn


-- Helper for creating new players
initPlayers :: [(Color, Int, Controls)] -> [Player]
initPlayers [] = []
initPlayers ((colour,seed,ctrl):xs) 
    = (Player (0, 10 * length xs) colour [ Turn right 0 ] ctrl randomNumbers 0):(initPlayers xs)
    where
        randomNumbers = randomRs (1, 10000) (mkStdGen seed) 

-- Initializes the game
initGameState = GameState {
    players = initPlayers [
        (blue, 1, Map.fromList [ (SpecialKey KeyUp, up), (SpecialKey KeyDown, down)
                               , (SpecialKey KeyLeft, left), (SpecialKey KeyRight, right) ]),
        (green, 2, Map.empty),
        (red, 3, Map.empty) ],
    time = 0,
    bounds = (320 `div` snakeSize, 240 `div` snakeSize)
}

main = gameInWindow
    "Tron"
    (640, 480)
    (20, 20)
    black
    24
    initGameState
    drawGame
    handleInput
    updateGameState

mmvp - comments

You really seem to be fighting with haskell:
- Nested where (I've never used this myself)
- Explicit recursion instead of maps
- Explicit folds where named ones would do: foldr max 0 == maximum
- Lots of unnecessary lambdas, for example:

candidates = map fst $ filter (\(direction, distance) 
                                -> distance == maxDistance)
                                 collisionDistances

Is equal to

candidates = filter (==maxDistance) . map fst $ collisionDistances

mmvp - comments

Example of too explicit foldl

collidesWithOthers = foldl (\acc other -> 
                      acc || checkCollision player other ) 
                   False players

Which is the same as

collidesWithOthers = any (checkCollision player) players

mmvp - comments

The internal logic is convoluting your code.
- Testing for dead players everywhere. Just plonk them to different list and be done with it.
- Huge numbers of parameters. Use a reader or state monad for encapsulation
- Is time really necessary?
Style issues
- Using tuples for everything. Records are more clear.
- if's everywhere. Use cases or guards, or rethink. Haskell program of this size usually has one or two if statements overall.
- Use HLint for your code.

jjat - kesken

module Main where
import Char
import Maybe

data Valuutta = Valuutta { lyhenne :: String,
                           nimi :: String,
                           kurssi :: Double }                          

uusiValuutta :: String -> String -> Double -> Valuutta
uusiValuutta lyhenne nimi kerroin = Valuutta (uppercase lyhenne) nimi kerroin

vaihdaEuroksi = (*)

etsiKurssi :: String -> [Valuutta] -> Maybe Double
etsiKurssi _ [] = Nothing
etsiKurssi lyhenne ((Valuutta a b c):xs) 
                        | a == lyhenne = Just c
                        | otherwise = etsiKurssi lyhenne xs

main = do putStrLn "Ohjelma muuntaa eri valuuttoja euroiksi. Ohjelma loppuu, kun painat q. Kurssi on otettu 3.10.2011."
          kysy teeValuutat
          putStrLn "Kiitos!"

kysy valuutat = do putStrLn "Anna summa ja rahan lyhenne: "
                   rahat <- getLine
                   if rahat == "q" 
                      then return ()
                      else do (parseSyote rahat) `testaaSyote` valuutat
                              kysy valuutat

uppercase = map toUpper

parseSyote :: String -> Maybe (Double, String)
parseSyote teksti = if (2 >= (length sanat))
                      then Just ((read (head sanat) :: Double) , last sanat)
                      else Nothing
                    where sanat = words teksti

testaaSyote Nothing _ = putStrLn "Antamasi raha ei ollut kelvollinen"
testaaSyote (Just (a,b)) valuutat = 
    do let kurssi = etsiKurssi (uppercase b) valuutat
       if kurssi == Nothing 
          then putStrLn "Antamaasi valuuttaa ei ole"
          else putStrLn $ (show a) ++ " " ++ b ++ " on " ++ (show (vaihdaEuroksi a (fromJust kurssi))) ++ " euroa"
       putStrLn ""

teeValuutat :: [Valuutta]
teeValuutat = [Valuutta "SKR" "kruunu" 0.6, Valuutta "$" "dollari" 1.2]