Tilaisuuden tarkoitus
- Käydään läpi käytännön asioita
- Koodikatselmoidaan ryhmien tuotoksia:
- Pohditaan ratkaisujen mielekkyyttä
- Kartoitetaan vaihtoehtoja
import Prelude hiding ((++)) -- HYVÄ! (++) :: [a] -> [a] -> [a] (++) [] [] = [] -- Turha (++) xs [] = xs -- Turha (++) [] xs = xs (++) (x:xs) ys = x : (xs ++ ys)
merge [] [] = [] -- Turha merge (xs) [] = (xs) merge [] (xs) = (xs)
halflen xs = floor(length xs % 2)
Kun x == a, length (ilman a (x:b)) == length (ilman a b) <= length (x:b) Kun x != a, length (ilman a (x:b)) == length (x:b) <= length (x:b)Väite on induktiotodistuksen nojalla tosi.
ilman :: String -> Char -> String ilman "" _ = "" ilman (x:xs) c | x == c = ilman xs c | otherwise = x : (ilman xs) c
puu :: Int -> Picture
puu 1 = color green (circle 50)
puu oksia = pictures [
(color orange . translate 0 50 . rectangleSolid 10 $ 100 ),
(translate 0 100 . rotate 40 . scale 0.7 0.7 $ puu (oksia-1)),
(translate 0 100 . rotate (-40) . scale 0.7 0.7 $ puu (oksia-1))
]
main = displayInWindow "Puu" (500,500) (20,20) blue (puu 5)
permutations (x:xs)
= [let (left, right) = splitAt i p in left++(x:right)
| p <- permutations xs
, i <- [0..length p]]
permutations (x:xs)
= [ left ++ (x:right)
| p <- permutations xs
, i <- [0..length p]
, let (left, right) = splitAt i p ]
yhdista :: [a] -> [a] -> [a] yhdista [] [] = [] yhdista [] (y:yx) = y : yhdista [] yx -- == yhdista [] (yx) = yx yhdista (x:xs) (yx) = x : yhdista xs yx
ilman :: Char -> [Char] -> [Char] ilman _ [] = [] ilman kirjain (x:xs) | x == kirjain = ilman kirjain xs | otherwise = x:ilman kirjain xs
module Main where
import Graphics.Gloss
import System.Environment
-- kaivellaan komentorivillä annettu parametri ja kutsutaan puuta sillä
-- (a = rekursion syvyys) read muuntaa merkkimuotoisen muutujan siihen
-- muotoon jossa sitä tullaan käyttämään
main = getArgs >>= (\[a] ->
displayInWindow "Puu" (700,700) (20,20) blue (puu (read a)))
puu 0 = blank
puu x = pictures
[color (makeColor8 144 66 16 255) (rectangleSolid 40 400)
,scale 0.6 0.6 (rotate (40 + 4 * (fromIntegral x))
(translate 0 200 (puu (x-1))))
,scale 0.6 0.6 (rotate (-40 - 4 * (fromIntegral x))
(translate 0 200 (puu (x-1))))
,translate 0 200 (color (makeColor8 (50 - x) (255 - x*10) (50 - x) 240)
(circleSolid 150))
]
kaanna :: [a] -> [a] kaanna [] = [] kaanna x = (last x):kaanna(init x)
import Prelude hiding ((++)) -- HYVÄ! (++) :: [a] -> [a] -> [a] (++) [] [] = [] (++) [] (y:ys) = y : [] ++ ys -- == (++) [] ys = ys (++) (x:xs) y = x : xs ++ y
ilman a x:xs = ilman a [x] ++ ilman a xs
=> length(ilman a x:xs) -- koska ilman a x:xs = ilman a [x] ++ ilman a xs
^- Tämä pitäisi todistaa erikseen
= length (ilman a [x]) + length(ilman a xs)
<= length([x]) + length(xs) -- perustapaus, ind oletus + kolmioey
= length(x:xs)
summa :: [Integer] -> Integer summa [] = 0 summa (x:xs) = x + summa xs
ilman :: Ord a => a -> [a] -> [a]
ilman _ [] = []
ilman x (y:ys)
| x == y = ilman x ys
| otherwise = y:[] ++ ilman x ys
y:[] ++ x = y:([]++x) = y:x
y:[] = [y]
mergesort :: [Integer] -> [Integer] -> [Integer]
mergesort [] [] = [];
mergesort [] ys = ys;
mergesort xs [] = xs;
mergesort (x:xs)(y:ys)
| x < y = x:mergesort xs (y:ys)
| otherwise = y:mergesort (x:xs) ys
-- Toteuta ‘mergesort’ algoritmi listoille.
mergesortListalle :: [Integer] -> [Integer]
mergesortListalle [] = []
mergesortListalle (x:xs) = mergesort [x] (mergesortListalle xs)
{- Todistan nyt, etta jos length (ilman a bs) <= length bs niin: -}
length (ilman a b:bs) <= length b:bs -- Miksi tämä väite pitäisi paikkaansa?
{- length b:bs voidaan kirjoittaa muodossa 1 + length bs -}
length (ilman a b:bs) <= 1 + length bs
{- length (ilman a b:bs) voidaan kirjoittaa muodossa length (ilman a bs)
+ length (ilman a [b]) -}
{- Miksi?-}
length (ilman a bs) + length (ilman a [b]) <= 1 + length bs
{- Induktio oletuksen nojalla length (ilman a bs) <= length bs niin
eli riittaa riittaa tutkia jaljelle jaaneet -}
length (ilman a [b]) <= 1 --epayhtalon vasen puoli voi saada arvoiksi 0 tai 1
{- Vaite on todistettu -}
yhdista :: [t] -> [t] -> [t] yhdista k [] = k yhdista [] m = m yhdista k m = yhdista (init k) (last k : m)
module Main where
import Graphics.Gloss
data Oksa = Oksa (Float,Float) Float Float Float deriving (Show)
type Puu = [Oksa]
ekaPuu = [Oksa (0,-100) 0 5 100]
uusiOksa :: Oksa -> [Oksa]
uusiOksa (Oksa (x,y) kulma leveys korkeus)
= [Oksa (x-2/3*leveys,y+(korkeus/2*cos (2*pi/360*(kulma-20))))
(kulma-20) (leveys/2) (korkeus/2)
,Oksa (x+2/3*leveys,y+(korkeus/2*cos (2*pi/360*(kulma+20))))
(kulma+20) (leveys/2) (korkeus/2)]
puu :: [Oksa] -> [Oksa]
puu vanhaPuu = vanhaPuu ++ lisaaOksa ++ puu lisaaOksa
where lisaaOksa = concat [uusiOksa x | x <- vanhaPuu]
oksat = pictures [translate x y . rotate kulma . color green . rectangleSolid leveys $ korkeus
| Oksa (x,y) kulma leveys korkeus <- take 10000 $ puu ekaPuu]
^^^^^^^^^^
main = displayInWindow "Puu" (500,500) (20,20) blue oksat
summa :: [Int] -> Int summa [] = 0 summa (x:xs) = x + summa(xs) main = print (summa [1,2,3,4,5])
parilliset :: [Int] -> [Int]
parilliset [] = []
parilliset [x]
| x `mod` 2 == 0 = [x]
| otherwise = []
parilliset (x:xs) = (parilliset [x]) ++ (parilliset xs)
length xs <= length (x:xs) --Tämä on tosi listan ominaisuuksien perusteella.
import Graphics.Gloss
data Puu = Lehti | Haara Puu Puu Puu
showpuu :: Puu -> Picture
showpuu Lehti = color green (rectangleSolid 10 10)
showpuu (Haara l k r) = Pictures [
(color (greyN 0.3) (translate 0 5 (rectangleSolid 5 40))),
(rotate (-20) (translate 0 25 (showpuu l))),
(translate 0 25 (showpuu k)),
(rotate 20 (translate 0 25 (showpuu r)))]
main = displayInWindow "Puu" (500,500) (20,20) blue
(showpuu (Haara (Haara Lehti Lehti Lehti)
(Haara Lehti (Haara Lehti Lehti Lehti) Lehti) Lehti))
rev1 []=[] rev1 (x:xs) = rev xs ++ [x]
rev2 = rev2' [] rev2' a [] = a rev2' a (x:xs) = rev2' (x:a) xs