> import Data.Char
> import Data.Maybe
> import Data.List
> import System(getArgs)
> import System.Random
> import Frekvenssit
> import Sukupuoli
> import Test.QuickCheckTä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 pQuickCheckillä{-
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 fsSeuraavaksi 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 fsKoska 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` xsQuickcheck 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 ShowJotta 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) xsVoimme 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 QuickCheckillä 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.000001Itse 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 mainista, 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 fsarvoJakaumasta’ 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 < 3Seuraava 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)"