JCI: FP

Literatura

Podstawowa
1. Miran Lipovaca, Learn You a Haskell for Great Good! A Beginner's Guide, No Starch Press, 2011
2. Will Kurt, Get Programming with Haskell, Manning, 2018
3. Bryan O’Sullivan, John Goerzen, and Don Stewart, Real World Haskell, O’Reilly, 2007
4. Benjamin C. Pierce, Basic Category Theory for Computer Scientists, The MIT Press, 1991
Pomocnicza:
1. S. Tompson, Haskell. The craft for functional Programming, Addison Wesley, 2018
2. B. Milewski, Category Theory for Programmers, Creative Licence, 2017
3. learnyouahaskell.com/chapters
4. Haskell Cheat Sheet: CheatSheet.pdf
5. Haskell 2010 Language Report
6. Hoog$\lambda$e
7. Link do strony z instalatorem Haskela: GHCup
8. J. Cichoń, Monady
Lista zadań: Functional_2024-2025.pdf

Zasady zaliczania kursu

Na laboratoriach będziecie oceniani za aktywność. Rozwiązania zadań będą oceniane w skali 0-2 pkt (w zależości od stopnia trudności, ustalonego przez prowadzącego). Do zdobycia będzie 20 pkt.
Pod koniec maja będą ogłoszone tematy kilku projektów do wyboru. Będziecie mogli je ralizować samodzielnie lub w dwuosobowych grupach. Za realizację projektu będzie można dostać do 10 pkt.
Ocena dostateczna będzie od 10 punktów.

Zagadnienia omówione na wykładzie

W1 (04.03.2025): GHCI i funkcje

Podstawowe polecenie ghci:

:q = wyjście
:t = typ
:i = info
:l = załadowanie modułu

Część kodów, które pojawiły się na tablicy.


module W1 where
-- funkcja jednej zmiennej
f x = 1 + x*(x+1)

g::Num a => a -> a -> a
g x y = 1 + x*y
-- Silnia : IF ... ELSE ...
fact1 :: Integer -> Integer
fact1 n = if n==0 then 1
          else n * fact1 (n-1)
-- Silnia : pattern matching          
fact2 :: Integer -> Integer
fact2 0 = 1
fact2 n = n * fact2 (n - 1)
-- Silnia : case expresion
fact3 n = case n of 
  0 -> 1
  n -> n * fact3 (n-1)
-- Silnia : with let expression  
fact4 :: Integer -> Integer
fact4 n  = let y = fact4 (n-1) in
           if n==0 then 1 else n * y

Ważna sprawa: zrozumienie pojęcia currying i uncurrying.

W2 (11.03.2025): Podstawowe typy

Podstawowe konstruktory typów

(a,b) :pary elementów typu a i b
[a] : ciągi elementów typu a; podstawowe funkcje (:) oraz (++)

Część kodów, które pojawiły się na tablicy.


{-

  modul: W2.hs

  info: Wykład z FP 2024/25 lato

  author: Jacek Cichoń

  date: 11.03.2025

-}



module W02 where

{- PARY -}



fst' (x,_) = x

snd' (_,y) = y



coll n | n == 1    = 1

       | even n    = coll (div n 2)

       | otherwise = coll (3*n+1)

 

collatz :: (Int,Int) -> (Int,Int)

collatz (n,s) | n==1      = (1,s)

              | even n    = collatz (div n 2,s+1)

              | otherwise = collatz (3*n+1,s+1)

lCollatz n = snd (collatz (n,0))



{- LISTY -}

length' []     = 0

length' (x:xs) = 1 + length' xs



head' [] = error "head: pusta lista"

head' (x:xs) = x



tail' [] =[]

tail' (x:xs) = xs



map' f [] = []

map' f (x:xs) = f x : map f xs



filter' p [] = []

filter' p (x:xs) = if p x then x:(filter' p xs) 

                          else filter' p xs

-- Lists comprehension



pythagorean n = [(x,y,z)| z<- [1..n],y<-[1..z], x<-[1..y], gcd x y == 1, x^2 + y^2 == z^2]

Uwagi:

Typ a->a jest intepretowany jako $(\lambda a: \mathrm{Type} \to (a\to a))$
Dummy variable : _
Aplikacja funkcji do zmiennej ma największy priorytet
Notacja infixowa: polecenie gcd x ymożna zapisać jako x `gcd` y
Wyrażenia listowe (list comprehension) są kosztowne.

W3 (18.03.2025): Sortowania; zip'y; foldy

Kody z wykładu:


module W03 where



import Data.List



{- SORTOWANIA -}

-- qS : lipna wersja

qS [] = []

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

            [x] ++

            (qS [y| y<- xs, y>=x])

            

-- partition

{- komentuje, bo jest w Data.List

partition :: (a->Bool) -> [a] ->([a],[a])

partition _ [] = ([],[])

partition p (x:xs) = if p x then (x:l,r)

                            else (l,x:r)

                     where (l,r) = partition p xs

-}



-- sections 

p3 = (+ 3)

m4 = (4 *)



-- qSort

qSort []     = []

qSort [x]    = [x]

qSort (x:xs) = (qSort l) ++ [x] ++ (qSort r)

               where (l,r) = partition (<x) xs 

-- inSort



inSort [] = []

inSort [x] = [x]

inSort (x:xs) = left ++ [x] ++ right

                where sxs = inSort xs

                      (left,right) = partition (<x) sxs



{- ZIPY -}

-- uzywam ' bo zip i zipWith są w Prelude

zip' [] _ = []

zip' _ [] = []

zip' (x:xs) (y:ys) = (x,y): (zip' xs ys)



zipWith' _ [] _ = [] 

zipWith' _ _ [] = []

zipWith' f (x:xs) (y:ys) = (f x y): zipWith' f xs ys



-- zagadka 

addMat = zipWith (zipWith (+)) 



{-- FOLDY --}

-- uzywam myfold* bo foldy sa w Prelude

add [] = 0

add (x:xs) = x + add xs



prod [] = 1

prod (x:xs) = x * prod xs



myfoldr f e [] = e

myfoldr f e (x:xs) = f x (myfoldr f e xs)



myfoldl f e [] = e

myfoldl f e (x:xs) = foldl f (f e x) xs



-- reverse jest Data.List, flip jest w Prelude

myreverse :: [a] -> [a]

myreverse  = foldl (flip (:)) []

W4 (25.03.2025): Foldy, strumienie, wstęp do typów

Zastosowania foldów i strumienie


module W04a where

import Data.List

sum'       xs  = foldl (+) 0 xs
product'   xs  = foldl (*) 1 xs 
minimum'   xs  = foldl1 min xs

-- fold1 f (x:xs) = foldl f x xs
and'       xs  = foldl (&&) True xs
or'        xs  = foldl (||) False xs
concat'    xxs = foldl (++) [] xxs
concatMap' f   = foldl ((++).f) []

{-- Automaty skonczone --}

-- AUTOMAT DETERMINISTYCZNY 
runDFA :: (s -> c -> s) -> s -> [c] -> s
--runDFA delta start cs = foldl delta start cs
runDFA = foldl

acceptDFA :: (s -> c -> s) -> s -> (s -> Bool) -> [c] -> Bool
acceptDFA delta start accept cs = accept (runDFA delta start cs)
 
-- przyklad: parzysta liczba jedynek

delta 1 '1' = 2
delta 1 _   = 1
delta 2 '1' = 1
delta 2 _   = 2
delta _ _   = 1  

-- AUTOMAT NIEDETRMINISTYCZNY 
-- procedure przekonwertowania automatu niedeterministyczngo
-- na automat deterministyczny
convertDelta :: (Eq s)=>(s->c->[s]) -> ([s]->c->[s]) 
convertDelta delta ss c  = nub (concat(map (\s -> delta s c) ss))
        
runNFA :: (Eq s) => (s->c->[s]) -> s -> [c] -> [s]
runNFA delta start cs = 
  runDFA deltaS [start] cs 
  where deltaS = convertDelta delta

convertAcc :: (s->Bool) -> ([s]->Bool)
convertAcc acc ss = or (map acc ss)

acceptNFA :: (Eq s) => (s->c->[s]) -> s -> (s->Bool) -> [c]->Bool
acceptNFA delta start acc cs = 
  accS (runNFA delta start cs)
  where accS = convertAcc acc
   
-- ciagi konczace sie jedynka
rho :: Int -> Char ->[Int]
rho 1 '1' = [1,2]
rho 1  _  = [1]
rho 2 '1' = [2]
rho 2   _ = [1]
           
{-- "Infinite streams" --}

myrepeat x = x:myrepeat x

myrepeat' x = xs where xs = x : xs

cycle' []  = error "cycle: emptyList"
cycle' xs  = xs' where xs' = xs ++ xs'

iterate' :: (a -> a) -> a -> [a]
iterate' f x =  x : iterate f (f x)

approSqrt:: Double->[Double]
approSqrt a = iterate (\x->(x+a/x)/2) a

-- liczby fibonacciego
fibb = 0:1: zipWith (+) fibb (tail fibb)

-- liczby pierwsze
sieve (p:xs) = p : sieve (filter (\n -> mod n p /= 0) xs)
primes = sieve [2..]

better_sieve (p:xs) = p: sieve (filter(\n -> n<p*p ||(mod n p /= 0)) xs)

addGF xs ys = zipWith (+) xs ys

Konstrukcja "type"


module Fizyka(Point,Vector,Time,

              move, translate, moveInGF) where



type Point = (Double,Double)

type Vector = (Double,Double)

type Time = Double



constG = 9.80655



-- lokalna funkcje

generalMove :: Point -> Vector -> Time -> Double -> Point

generalMove (x,y) (vx,vy) t acc = (x+vx*t, y + vy*t + acc*t*t/2)



-- upublicznione 

move :: Point -> Vector -> Time -> Point

move p v t = generalMove p v t 0 



translate :: Point -> Vector -> Point

translate p v = generalMove p v 1 0



moveInGF :: Point -> Vector -> Time -> Point

moveInGF p v t = generalMove p v t (-constG)

Konstrukcja "data" - wstęp


module W04b where



{-- Typy numerowane --}

data DOW = Po|Wt|Sr|Cz|Pi|So|Ni deriving (Eq,Ord,Enum,Bounded)



instance Show DOW where

  show Po = "Poniedziałek"

  show Wt = "Wtorek"

  show Sr = "Środa"

  show Cz = "Czwartek"

  show Pi = "Piatek"

  show So = "Sobota"

  show Ni = "Niedziela"



dniPracujace = [Po .. Pi] -- efekt Enum

Proponuję rzucić okiem na następującą stronę: The Evolution of a Haskell Programmer, na której Fritz Ruehr'er wygłupia się z różnymi sposobami zdefiniowania funkcji silnia.

W5 (01.04.2025): Typy, wstęp do funktorów

Zastosowania foldów i strumienie


module W5b where



-- prototyp

data Osoba' = Osoba' String String String Int Int Int



imie' :: Osoba' -> String

imie' (Osoba' _ x _ _ _ _) = x

-- itd 



{-- RECORD SYNTAX --}



data Osoba = Osoba

     {

      idO :: String

     ,imie :: String

     ,nazwisko :: String

     ,rokUr :: Int

     ,miesiacUr :: Int

     ,dzienUr :: Int

     } deriving (Show,Eq)

  

aaa = Osoba "001" "Anna" "Nowicka" 2005 5 12



bbb = Osoba{idO = "002", 

            imie = "Jan", 

            nazwisko="Balicki", 

            rokUr=2004, miesiacUr = 10, dzienUr = 12}



-- lekkie ulepszenie   



data Date = Date{rok::Int,miesiac::Int,dzien::Int} 

     deriving(Eq)

     

instance Show Date where

  show (Date r m d) = 

    (show r) ++"."++(show m)++"."++(show d)

  

data Person = Person

     {

      _idO :: String

     ,_imie :: String

     ,_nazwisko :: String

     , dataUr :: Date

     } deriving (Show,Eq)

  

ccc = Person "001" "Anna" "Balicka" (Date 2005 5 12)



zmienDate :: Person -> Date -> Person

zmienDate osoba nowaData = 

  osoba{dataUr = nowaData}



zmienRokUr :: Person ->Int -> Person

zmienRokUr osoba rokUr = 

  let urodziny  = dataUr osoba 

      urodziny' = urodziny{rok = rokUr} in 

   osoba{dataUr = urodziny'}



-- to samo - inny zapis

zmienRokUr' osoba rokUr = 

  osoba{dataUr = (dataUr osoba){rok = rokUr}}



--- Pozniej: lenses 



{-- TYPY PARAMETRYZOWALNE --}



-- MODEL KATEGORYJNY: PP (X) = X x X



data Para a = Para (a,a) deriving (Show,Eq)



-- MODEL :: jesli f:X->Y to (fmap f):(X x X) -> (Y x Y)



instance Functor Para  where

  fmap f (Para (x,y)) = Para (f x, f y)



--pmap :: (a->b) -> Para a -> Para b

--pmap f (Para (x,y)) = Para (f x, f y)



f x = 3.5 * x*(1-x)

-- uzycie: fmap f Para(0.25,0.75)

                  

{-- FUNKTOR MAYBE --}



-- data Maybe a = Nothing |  Just a

-- MODEL: MB(X) = ({0} x {*}) u ({1} x X) 

-- fmap f Nothing = Nothing

-- fmap f (Just x) = Just (f x)



safeHead []    = Nothing

safeHead (x:_) = Just x



safeSqrt x 

  | x>=0      = Just (sqrt x)

  | otherwise = Nothing 



safeLog  x 

  | x>0  = Just (log x)

  | otherwise = Nothing



safeDiv x 0 = Nothing 

safeDiv x y = Just (x/y)



-- zaczynamy partyzantkę;

-- pozniej zrobimy to lepiej



-- sqrt(log x)

composeMB :: (a-> Maybe b) -> (b -> Maybe c) -> (a -> Maybe c)

composeMB f g x =

  case f x of 

   Nothing -> Nothing

   Just y  -> g y

 

expr1 = composeMB safeLog safeSqrt



-- (sqrt x)/log(x +1)

composeMB2 :: (a->b->Maybe c) -> Maybe a -> Maybe b -> Maybe c

composeMB2 _ Nothing _  = Nothing

composeMB2 _ _ Nothing  = Nothing

composeMB2 op (Just x) (Just y) = op x y             



expr2 x = let sn = safeSqrt x

              sd = safeLog (x^2-4) in

          composeMB2 safeDiv sn sd

Oto skompresowany katalog W5_BD.zip, z plikami którymi bawiliśmy się na wykładzie.

W6 (08.04.2025): Elementy Teorii Kategorii; wstęp do funktorów

Oto kody omawiane na wykładzie, po uwzględnieniu większości propozycji programu hlint:


module W6a where



import Data.List

import Test.QuickCheck

import Data.Char



{-- PODSTAWOWE FUNKTORY  --}



data    MAYBE  a = NOTHING | JUST a

newtype READER a b = READER{runReader:: a -> b}

newtype WRITER m a = WRITER (a, m)

  

    

instance Functor MAYBE where

  fmap _ NOTHING  =  NOTHING

  fmap f (JUST x) =  JUST (f x)

  

instance Functor (READER a) where

  fmap f (READER phi) = READER (f . phi)

    

instance Functor (WRITER m) where

  fmap f (WRITER (x,m)) = WRITER (f x, m)





{-- Zastosowanie --}



clearChar ch = let lc = toLower ch in

               if lc `elem` ['a'..'z'] then lc 

               else ' '               



toWords :: String ->[String]

toWords = words . map clearChar



filtrujSW :: [String] -> String -> [String]

filtrujSW ws stopW  = 

  let stw = words stopW in

  filter (`notElem` stw) ws



pogrupuj :: [String] -> [(String,Int)]

pogrupuj = sortBy (\ (_,k) (_,l) -> compare l k) . 

           map (\ g -> (head g,length g)) . group . sort 



topN :: [String] -> Int -> [(String,Int)]

topN xs ile = take ile (pogrupuj xs)



-- Zanurzamy obliczenia w funktor RE



type RE a = READER (String, String, Int) a

---- (book, stopwords, ile)



toWordsRE :: RE String -> RE [String]

toWordsRE = fmap toWords



filtrujRE :: RE [String] -> RE [String]

filtrujRE (READER α) =

  READER (\ (b,sw,i) -> filtrujSW (α (b,sw,i)) sw)



topNRE :: RE [String] -> RE [(String,Int)]

topNRE (READER β) =

  READER (\ (b,sw,ile) -> topN (β (b,sw,ile)) ile)



-- teraz inicjujemy proces

getBookRE :: RE String

getBookRE = READER (\(book,_,_) -> book)

-- i skladamy wszystkie funkcje

findTopNRE = (topNRE . filtrujRE . toWordsRE) getBookRE

-- Oto użycie

findTopN = runReader findTopNRE



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

  

run bookPath ile = do

  book <- readFile ("Dane/"++bookPath)

  sw   <- readFile "Dane/stop_words_english.txt" 

  print $ findTopN (book, sw, ile)

Spróbujcie sprawdzić działanie powyższego kodu wywołując w ghci
findTopN ("Ala ma kota, Ala ma psa, Ala ma kanarka", "", 4)

W7 (15.04.2025): Wstęp do funktorów

Quick Check


module W7a where

import Data.List

import Test.QuickCheck

{-- Zabawa z liczbami pierwszymi  --}

-- niezbyt efentywna funkcja

-- Zadanie: zrób to lepiej

primeQ n = 

  length ([k | k<- [1..n], n `mod` k == 0]) == 2

-- wielomian Eulera

eulerPoly n = n*n + n + 41

-- własność do przetestowania 

checkEulerPoly' :: Int -> Bool

checkEulerPoly' n = 

  primeQ (eulerPoly (abs n)) 

checkEuler' = quickCheck checkEulerPoly'

-- trochę lepiej

checkEulerPoly :: Int -> Property

checkEulerPoly n = (n>=0) ==> primeQ (eulerPoly n) 

checkEuler = quickCheck checkEulerPoly



{-- SPLIT string 

  CEL:

    split :: Char -> String -> [String]

  przykład działania:

  split '/' "data/usr/include" = ["data", "usr", "include"]

  split '/' "/usr/include/dat" = ["", "usr", "include", "dat"]

--}

split1 :: Char -> String -> [String]

split1 c [] = []

split1 c xs = 

  let x1 = takeWhile (/= c) xs

      x2 = dropWhile (/= c) xs in

  x1 : if null x2 then [] 

                  else split1 c (tail x2)



unsplit :: Char -> [String] -> String

unsplit c wx = intercalate [c] wx

 -- intercalate :: [a] -> [[a]] -> [a]



{-- 

  wlasnosc do przetestowania :

   ((unsplit c) . (split c)) xs == xs 

    kontrola liczby testów:

    quickCheck (withMaxSuccess 1000 propertyToCheck)

--}

 

propSplit1 c xs = unsplit c (split1 c xs) == xs

checkSplit1 = quickCheck (withMaxSuccess  1000 propSplit1)



-- Poprawiona funkcja SPLIT ---------------

split :: Char -> String -> [String]

split c "" = [""]

split c xs = 

  let x1 = takeWhile (/= c) xs

      x2 = dropWhile (/= c) xs in

  x1 : if null x2 then [] 

                  else split c (tail x2)

-- testowanie ze zbieraniem inforacji o testach: 

--    collect

checkSplit c xs = let ys = split c  xs in

                   collect (length ys) $ unsplit c ys == xs

                   

testSplit = quickCheck (withMaxSuccess 100000 checkSplit)



-- READ: https://jesper.sikanda.be/posts/quickcheck-intro.html

Podstawowe konstruktory danych


module W7b where

{-- PODSTAWOWE FUNKTORY  --}

-- DWA NOWE FUNKTORY



newtype STATE s x = ST (s -> (x,s))

data    EITHER a b = LEFT a | RIGHT b



instance Functor (STATE s) where

  fmap f (ST σ) = ST( \s -> let (x ,t) = σ s in (f x,t))



instance Functor (EITHER a) where

  fmap _ (LEFT x)  = LEFT x

  fmap f (RIGHT x) = RIGHT (f x)

  

-- Przykłady typów parametryzowalnych które nie są 

-- funktorami



newtype ToInt a = TInt (a->Int) 

newtype Predicate a = Pred (a->Bool)

newtype Endo  a = Endo (a->a)

  

-- Typy rekurencynje  



data SimpleTree a = Leaf a | Node (SimpleTree a) (SimpleTree a) 

     deriving (Eq)

Rozważamy odwzorowanie $F(X) = \NN + (X\times X)$ i definiujemy $F^{0} = F(\emptyset)$, $F^{n+1} = F(F^n)$. Mamy (sprawdźcie to) $$ F^0 \subseteq F^1 \subseteq F^2 \subseteq F^3 \subseteq \ldots$$ Kładziemy $F^{\omega} = \bigcup_{n\geq 0} F^n$. Mamy $F(F^\omega) = f^\omega$ (sprawdźcie to). Z tego wynika, że zbiór $F^\omega$ jest najmniejszym punktem stałym odwzorowania $F$. Ten zbiór jest izomorficzny z SimpleTree $\NN$. Tak Haskell interpretuje ten typ rekurencyjny.