> import Data.Char
> import Data.Maybe
> import Data.List
> import System(getArgs)
> import System.Random
> import Frekvenssit
> import Sukupuoli
> import Test.QuickCheck
Tämä teksti pohjautuu Tomi Karppisen alkuperäinen nimigeneraattori ohjelmaan. Tekstissä on tarkoitus käydä ensin läpi miten eri funktioiden toteutukset voidaan yksinkertaistaa valmisfunktioita käyttäen. Tämän jälkeen testaamme myös olennaisimman funktion QuickCheck
kirjastolla ja lopuksi esitämme miten ohjelman rakennetta voidaan vieläkin parantaa käyttämällä monadeja.
> vokaalit = "aeiouyäåö"
> aakkoset = ['a'..'z'] ++ ['å', 'ä', 'ö']
> pituudet = [1..15]
>
> arvoNimi2 :: [Double] -> Sukupuoli -> (String, [Double])
> arvoNimi2 r sp = let (nimi, rs) = arvoNimi r sp
> in if kelpaako nimi then (nimi, rs) else arvoNimi2 rs sp
> where
> kelpaako nimi = let v = laskeVokaalit nimi
> pk = laskePerakkaiset (==) nimi
> pl = laskePerakkaiset (\a b -> onkoVokaali a == onkoVokaali b) nimi
> in v > 0 && v < length nimi && pk < 3 && pl < 3
>
> arvoNimi :: [Double] -> Sukupuoli -> (String, [Double])
> arvoNimi r sp = let (pituus, rs) = arvoPituus r sp
> in koostaNimi rs "" sp pituus
> where
> koostaNimi r nimi _ 0 = (nimi, r)
> koostaNimi r nimi sp i = let (kirjain, rs) = arvoKirjain r i sp
> in let (loppu, rs2) = koostaNimi rs nimi sp (i - 1)
> in (kirjain : loppu, rs2)
>
> arvoKirjain :: [Double] -> Int -> Sukupuoli -> (Char, [Double])
> arvoKirjain r i sp = arvoJakaumasta r aakkoset $ kfreq sp !! (min i (length (kfreq sp)-1))
>
> arvoPituus :: [Double] -> Sukupuoli -> (Int, [Double])
> arvoPituus r sp = arvoJakaumasta r pituudet $ pfreq sp
> onkoVokaali :: Char -> Bool
> onkoVokaali = (`elem` vokaalit)
> laskeVokaalit :: String -> Int
> laskeVokaalit s = length . filter onkoVokaali $ s
{-
laskePerakkaiset :: (Char -> Char -> Bool) -> String -> Int
laskePerakkaiset p s = laskeRekursiolla 1 $ laskeEnsimmaiset p s-- laskeRekursiolla 1 $ laskeEnsimmaiset p s
where
laskeEnsimmaiset p s = zipWith p s (tail s)
laskeSeuraavat s = zipWith (&&) s (tail s)
laskeRekursiolla i [] = i
laskeRekursiolla i [a] = if a then i + 1 else i
laskeRekursiolla i x = if laskeTruet x > 0
then laskeRekursiolla (i + 1) . laskeSeuraavat $ x
else i
laskeTruet x = length . filter id $ x
-}
Peräkkäin toistuvien sarjojen määritteleminen 9 riviä helpompaa käyttäen groupBy
funktiota:
> laskePerakkaiset :: (a -> a -> Bool) -> [a] -> Int
> laskePerakkaiset p = maximum . map length . groupBy p
QuickCheck
illä{-
arvoJakaumasta :: (Num b, Ord b) => [b] -> [a] -> [b] -> (a, [b])
arvoJakaumasta (r:rs) x f = (x !! fst (foldl (\a fr -> acc a fr r) (0, 0) f), rs)
where
acc (i, a) f r = if a > r then (i, a) else (i + 1, a + f)
-}
Funktio arvojakaumasta
on määritelty hieman hankalan näköisesti ja erityistä huolta aiheuttaa vaarallinen (!!)
operaattori. Tässä kohtaa pitäisi osoittaa, että foldin arvo on pienempi kuin x
:n pituus, mikä ei ole ollenkaan helppoa. Jaetaan funktiota siis osiin:
> lastMatchingElement p xs = case takeWhile p xs of
> [] -> Nothing
> x -> Just $ last x
Funktion lastMatchingElement
oikeellisuusseuraa suoraan last
ja takeWhile
funktioiden ominaisuuksista. Tämän jälkeen saadaan kirjoitettua funktio arvoJakaumasta
seuraavalla tavalla:
> arvoJakaumastaE _ [] _ = Nothing
> arvoJakaumastaE _ _ [] = Nothing
> arvoJakaumastaE (r:rs) xs fs
> = fmap (\(x,_) -> (x,rs)) $ lastMatchingElement ((<=r) . snd) . zip xs $ scanl (+) 0 fs
Seuraavaksi määritellään arvoJakaumasta “vaarallinen” versio, joka kaataa ohjelman siten, että voimme tarkastella millä parametreilla sitä kutsuttiin. Oikeassa ohjelmassa purkaisimme Maybe
tyypin vasta tätä funktiota kutsuvassa funktiossa, sillä siellä on mahdollista tehdä järjellisempää virheidenhallintaa. Tässä tapauksessa kaataminen on perusteltua, sillä mikään funktion parametreistä ei ole käyttäjän syöte, eli ohjelma joko toimii tai ei toimi ja asialle ei voi tehdä juuri mitään, jos se ei toimi.
> arvoJakaumasta rs xs fs = fromMaybe (error $ "Arvojakaumasta ei täytä ehtoja"++ show (head rs,xs,fs))
> $ arvoJakaumastaE rs xs fs
Koska arvoJakaumasta
on ohjelman ydin ja vieläpä melko monimutkainen sellainen, teemme sille testit käyttäen QuickCheck
kirjastoa. QuickCheck
:n perusidea on se, että ohjelma generoi itse testitapauksensa annettujen sääntöjen pohjalta. Sääntö, jota haluamme nyt testata on, jos arvoJakaumasta
saa parametreikseen (0,1) välin satunnaisluvun, epätyhjän listan ja todennäköisyysjakauman, niin se tuottaa aina arvon listasta xs
:
> prop_arvoE (ZeroOne r) (NonEmpty xs) (Distribution fs) = let (a,_) = arvoJakaumasta [r] xs fs in a `elem` xs
Quickcheck generoi testitapaukset sääntö-funktion parametrien tyyppien mukaan joten joudumme määrittelemään sellaiset tietotyypit kuin (0,1) välin luku, epätyhjä lista ja jakauma, ja käyttämään niitä sääntöfunktiomme parametreinä, jotta saisimme oikeat ehdot täyttäviä testitapauksia.
> newtype ZeroOne = ZeroOne Double deriving Show
> newtype Distribution = Distribution [Double] deriving Show
Jotta QuickCheck
osaisi testata funktioita, jotka käyttävät tämän tyyppisiä arvoja, niille on määriteltävä tyyppiluokka Arbitrary
, joka kertoo, miten luodaan mielivaltainen kunkin tyyppinen alkio. Tällä luokalla on vain yksi funktio, Arbitrary a => arbitrary :: Gen a
, missä tyyppi Gen a
esittää mielivaltaisesti generoitua tyypin a
arvoa. Gen
on myös funktori ja monadi ja ideana onkin koostaa sopiva Gen a
yhdistelemällä olemassa olevia funktioita, kuten esimerkiksi funktioita choose :: Random a => (a, a) -> Gen a
tai oneof :: [Gen a] -> Gen a
.
Esimerkiksi mielivaltainen ZeroOne
alkio voidaan luoda choose
funktiolla:
> instance Arbitrary ZeroOne where
> arbitrary = ZeroOne `fmap` choose (0,1)
Mielivaltainen Distribution
puolestaan tarvitsee enemmän vaivaa, sillä joudumme ensin pitämään huolen siitä, että jakauma ei ole tyhjä ja siitä, että sen summa on 1.
> instance Arbitrary Distribution where
> arbitrary = arbitrary >>= \(NonEmpty xs) -> return . Distribution . norm . map abs $ xs
> where norm xs = map (/sum xs) xs
Voimme testata generaattoreitamme sample :: Show a => Gen a -> IO ()
funktion avulla:
*Main> sample (arbitrary :: Gen Distribution)
Mutta tässä tapauksessa, ainenkin Distribution
generaattoria kannattaa testata myös QuickCheck
illä itsellään. Tätä varten määrittelemme funktion, joka palauttaa True
, mikäli jakauman kaikki alkiot ovat nollaa suurempia ja niiden summa on (liukulukutarkkuudella) yksi:
> prop_is_distr (Distribution xs) = all (>= 0) xs && abs (sum xs - 1) < 0.000001
Itse testaus tapahtuu tulkista kutsumalla quickCheck
funktiota:
*Main> quickCheck prop_is_distr
+++ OK, passed 100 tests.
*Main> quickCheck prop_arvo
+++ OK, passed 100 tests.
Ja koska testit menevät läpi, voimme olla melko varmoja siitä, että arvoJakauma
funktiota on turvallista käyttää em. ehdoilla.
{-
main = do
args <- getArgs
gen <- getStdGen
if length args == 1
then let sp = spKirjaimesta (args !! 0 !! 0)
rands = randomRs (0, 1) gen
in if sp == Nothing
then putStrLn $ virhe
else putStrLn . fst . (arvoNimi2 rands) . fromJust $ sp
else putStrLn $ virhe
-}
Jos korvaamme vielä sisäkkäiset if
’t main
ista, ohjelmamme yksinkertaistuu jälleen:
> main = do
> args <- getArgs
> gen <- getStdGen
> let rands = randomRs (0, 1) gen
> case args of
> ["m"] -> putStrLn . fst . (arvoNimi2 rands) $ Mies
> ["n"] -> putStrLn . fst . (arvoNimi2 rands) $ Nainen
> _ -> putStrLn $ virhe
> where
> virhe = "Parametrit: sukupuoli (m/n)"
Seuraavana on olennaisin yksinkertaistus minkä keksin, eli satunnaislukulistan poistaminen parametreista. Suuri osa ohjelman näennäisestä monimutkaisuudesta tulee siitä, että satunnaislukulistan kuljettaminen kaikkien funktioiden läpi aiheuttaa huomattavan määrän kirjanpitoa.
Tästä päästään eroon huomaamalla, että kaikki satunnaislukuja käsittelevät funktiot ovat tyyppiä
Satunnaislukulista -> Parametri1 -> Parametri2 -> ... -> (Tulos,Satunnaislukulista)
Jos siirrämme satunnaislukulistan viimeiseksi parametriksi, tyypistä tulee
Parametri1 -> Parametri2 -> ... -> (SatunnaislukuLista -> (Tulos,Satunnaislukulista))
Curry-ominaisuuden takia voimme ajatella, että funktion paluuarvo onkin itseasiassa (SatunnaislukuLista -> (Tulos,Satunnaislukulista))
, eli sellainen operaatio, joka laskee Tuloksen
annetun satunnaisuuden perusteella. Tämä on etäisesti samanlainen käsite kuin satunnaismuuttuja todennäköisyyslaskennassa. Mikäli haluamme yhdistää tälläisiä funktioita, olemme tutussa bind
tilanteessa:
arvoPituus :: (SatunnaislukuLista -> (Int,Satunnaislukulista))
arvoNimi :: Int -> (SatunnaislukuLista -> ([Char],Satunnaislukulista))
Ensimmäinen operaatio palauttaa Int
:n muun roskan seassa ja toinen funktio puolestaan haluaisi Int
:n parametrikseen, joten yhdistäminen ei onnistu suoraan. Kirjoitamme siis, totuttuun tapaan, funktion bindRandom
, joka tekee funktioista yhteensopivia:
bindRandom :: (a -> (SatunnaislukuLista -> (b,Satunnaislukulista)))
->
((SatunnaislukuLista -> (a,Satunnaislukulista)) -> (SatunnaislukuLista -> (b,SatunnaislukuLista)))
Eli, bindRandom
ottaa funktion a
:lta ‘satunnaismuuttuja’ b
:ksi ja palauttaa funktion ‘satunnaismuuttuja a
’:lta ‘satunnaismuuttuja b
’:lle. Tämän jälkeen voimme kirjoittaa seuraavasti:
nimi = bindRandom arvoNimi $ arvoPituus
(HT. Toteuta bindRandom
ja unitRandom
)
Varsinaista ohjelmaa tehdessä on hyvä luoda uusi tyyppinimi funktioille (SatunnaislukuLista -> (Int,Satunnaislukulista))
jotta niille voidaan kirjoittaa instanssimääritelmiä.
> type Satunnaislukulista = [Double]
> data Rand a = R (Satunnaislukulista -> (a,Satunnaislukulista))
Seuraavaksi luomme Monad
-instanssin kääntämällä bindRandom
funktiomme sopivasti ympäri.
> instance Monad Rand where
> return x = R $ \rs -> (x,rs)
> (R f) >>= g = R $ \rs -> let (a,rs') = f rs
> (R n) = g a
> in n rs'
Tämän jälkeen, voimme nostaa funktion arvoJakaumasta
käyttämään Rand tyyppiä:
> arvoJakaumasta' xs fs = R $ \(r:rs) -> (s r,rs)
> where
> s r = fst
> . fromMaybe (error $ "Arvo jakaumasta sai huonot parametrit: "++show (r,xs,fs))
> . lastMatchingElement ((<= r) . snd) . zip xs $ scanl (+) 0 fs
arvoJakaumasta’ funktiota voidaan käyttää määrittelemään muut satunnaisfunktiot. Tämä on nyt huomattavasti helpompaa kuin aiemmin, sillä monadi-instanssimme hoitaa satunnaislukujen kuljetuksen, eikä meidän tarvitse enää huolehtia asiasta ollenkaan. Lisäksi Monad
luokan arvoille on monia hyödyllisiä operaatioita, kuten erityisesti funktio mapM
:
> koostaNimi' sp i = mapM (arvoKirjain' sp) [0..i-1]
> arvoKirjain' :: Sukupuoli -> Int -> Rand Char
> arvoKirjain' sp i = arvoJakaumasta' aakkoset $ kfreq sp !! (min i (length (kfreq sp)-1))
> arvoPituus' :: Sukupuoli -> Rand Int
> arvoPituus' sp = arvoJakaumasta' pituudet $ pfreq sp
> arvoNimi' sp = arvoPituus' sp >>= koostaNimi' sp
> arvoNimi2' sp = arvoNimi' sp >>= \nimi ->
> if kelpaako nimi then return nimi else arvoNimi2' sp
> where
> kelpaako nimi = let v = laskeVokaalit nimi
> pk = laskePerakkaiset (==) nimi
> pl = laskePerakkaiset (\a b -> onkoVokaali a == onkoVokaali b) nimi
> in v > 0 && v < length nimi && pk < 3 && pl < 3
Seuraava ongelma onkin se, että miten saamme a
:n ulos Rand a
:sta. Tämä on kuitenkin helppoa. Puramme R
-tietotyypistä ulos alkuperäisen satunnaislukulistalta arvoksi funktion ja syötämme sille listan satunnaislukuja:
> runRandom (R f) rs = fst . f $ rs
> runRandomIO r = getStdGen >>= return . runRandom r . randomRs (0,1)
Näillä säädöillä main
muuttuu todella yksinkertaiseksi, kun siellä ei tarvitse edes valmistella satunnaislukugeneraattoria:
> main' = do
> args <- getArgs
> case args of
> ["m"] -> runRandomIO (arvoNimi2' Mies) >>= putStrLn
> ["n"] -> runRandomIO (arvoNimi2' Nainen) >>= putStrLn
> _ -> putStrLn $ virhe
> where
> virhe = "Parametrit: sukupuoli (m/n)"
blog comments powered by Disqus