Lecture 07 (#9)

.vitepress/config.mts

@@ -33,6 +33,7 @@ export default defineConfig({
           { text: '04: Pattern Matching & Lazy Evaluation', link: '/lectures/lecture04'},
           { text: '05: Macros & Interpreters', link: '/lectures/lecture05'},
           { text: '06: Lambda Calculus', link: '/lectures/lecture06'},
+          { text: '07: Haskell', link: '/lectures/lecture07'},
           { text: 'Bonus: Immutable datastructures', link: '/lectures/bonus'},
         ]
       },

code/jarnik.hs

@@ -0,0 +1,51 @@
+import Data.List
+
+type Vertex = Char
+type Edge = (Vertex,Vertex)
+type Weight = Int 
+type Graph = [(Edge,Weight)]
+
+graph :: Graph
+graph = [(('A','B'), 7)
+        ,(('A','D'), 5)
+        ,(('D','B'), 9)
+        ,(('C','B'), 8)
+        ,(('E','B'), 7)
+        ,(('C','E'), 5)
+        ,(('D','E'), 15)
+        ,(('D','F'), 6)
+        ,(('F','E'), 8)
+        ,(('F','G'), 11)
+        ,(('E','G'), 9)
+        ]
+
+deduplicate :: [Vertex] -> [Vertex]
+deduplicate [] = []
+deduplicate (v:vs) = v:(deduplicate filtered)
+    where filtered = [ u | u <- vs, u /= v ]
+
+vertices :: Graph -> [Vertex]
+vertices g = deduplicate $ concat [ [a,b] | ((a,b), _) <- g ]
+
+sortGraph :: Graph -> Graph 
+sortGraph g = sortOn snd g 
+
+checkEdge :: Edge -> [Vertex] -> Bool
+checkEdge (a,b) visit = p /= q
+    where p = a `elem` visit
+          q = b `elem` visit
+
+findEdge :: [Vertex] -> Graph -> (Edge, Weight)
+findEdge visit graph = head [ (e,w) | (e,w) <- graph, checkEdge e visit ]
+
+jarnik :: Graph -> Graph
+jarnik graph = iter vs [] where
+  graph' = sortGraph graph 
+  (_:vs) = vertices graph
+
+  iter :: [Vertex] -> Graph -> Graph
+  iter [] tree = tree
+  iter visit tree = iter visit' tree' where
+    edge@((a,b),_) = findEdge visit graph'
+    visit'    = [ v | v <- visit, v /= a && v /= b ]
+    tree'       = edge:tree

code/test.hs

@@ -0,0 +1,26 @@
+-- average matrix w h = 
+
+transpose ([]:_) = []
+transpose x = (map head x) : transpose (map tail x)
+
+mat :: [[Int]]
+mat = [[1..4]
+      ,[1..4]]
+
+avg n = map mean . (chunks n)
+
+mean xs = sum xs / fromIntegral (length xs)
+
+averageBlocks matrix w h = cols (rows matrix) where
+  rows = map (avg w)
+  cols = transpose . map (avg h) . transpose
+
+chunks :: Int -> [a] -> [[a]]
+chunks _ [] = []
+chunks n xs =
+    let (ys, zs) = splitAt n xs
+    in  ys : chunks n zs
+
+
+f x | x==1      = "a"
+    | otherwise = x

lectures/index.md

@@ -56,6 +56,11 @@ programming came from.
 For the interested read there is another lecture on immutable datastructures like random access
 lists.
 
+## [Lecture 7](lecture07): Introduction to Haskell
+
+[Slides](https://github.com/aicenter/FUP/blob/main/lectures/lecture07.pdf).
+[Log](https://github.com/aicenter/FUP/blob/main/lectures/lecture07.hs).
+
 ## Old recorded lectures
 
 Old recorded lectures from 2021 can be found [here](https://cw.fel.cvut.cz/b202/courses/fup/lectures/start).

lectures/lecture07.hs

@@ -0,0 +1,69 @@
+factorial :: Integer -> Integer
+factorial 0 = 1
+factorial n = n * factorial (n-1)
+
+factorial2 :: Integer -> Integer
+factorial2 n = iter n 1 where
+    iter 0 acc = acc
+    iter k acc = iter (k-1) (k*acc)
+
+power :: Integer -> Integer -> Integer
+power _ 0 = 1
+power n k = n * power n (k-1)
+
+(+/+) :: Integer -> Integer -> Integer
+x +/+ y = 2*x + y
+infixr 8 +/+
+
+discr :: Float -> Float -> Float -> Float
+discr a b c = x - y 
+    where x = b*b
+          y = 4*a*c
+
+discr2 :: Float -> (Float -> (Float -> Float))
+discr2 a b c = 
+    let x = b*b
+        y = 4*a*c
+    in x - y
+
+g :: Int -> Int
+g x = y+z where
+            y = 1+2  -- layout rule: mult-line definition of y
+                +x
+            z = 10   -- layout rule: block continuation 
+
+myAbs :: Int -> Int
+myAbs x | x >= 0 = x
+
+solver :: Float -> Float -> Float -> String
+solver a b c | d >= 0 = let f1 x y z = ((-y) + sqrt z) / 2*x -- let can be inside guarded equations
+                            f2 x y z = ((-y) - sqrt z) / 2*x -- let can contain also function definitions
+                        in show (f1 a b d, f2 a b d)
+             | d < 0 = "Complex roots"
+    where d = discr a b c -- where applies to all guarded equations
+
+second :: (Int, Int, Int) -> Int 
+second (_,x,_) = x
+
+f :: (Int, [Char], (Int, Char)) -> [Char]
+f (1, x:xs, (2,y)) = x:y:xs    
+f (_, _, _) = ""
+
+flatten :: [[Int]] -> [Int]
+flatten xss = [x | xs <- xss, x <- xs]
+
+factors :: Int -> [Int]
+factors n = [x | x <- [1..n], mod n x == 0]
+
+prime :: Int -> Bool
+prime n = factors n == [1,n]
+
+primes :: [Int]
+primes = [x | x <- [2..], prime x]
+
+qsort :: [Int] -> [Int]
+qsort [] = []
+qsort (x:xs) = qsort smaller ++ [x] ++ qsort bigger 
+   where 
+    smaller = [y | y <- xs, y <= x]
+    bigger = [y | y <- xs, y > x]