├── 20161011-week2.rkt
├── 20161018-week3.rkt
├── 20161025-week4.rkt
├── 20161108-week5.rkt
├── 20161115-week6.rkt
├── 20161122-week7.rkt
├── 20161129-week8.rkt
├── 20161206-week9.lhs
├── 20161213-week10.hs
├── 20161220-week11.hs
├── 20170103-week12.hs
├── 20170110-week13.hs
├── 20170117-week14.hs
├── README.md
├── exam2016solutions.hs
├── exam2017solutions.hs
├── hw1solutions.hs
└── kontr2solutions.hs


/20161011-week2.rkt:
--------------------------------------------------------------------------------
 1 | #lang racket
 2 | ; Предефиниране на if чрез and и or
 3 | (define (if2 t x y)
 4 |   (or (and t x) y))
 5 | 
 6 | ; Предефиниране на and, or и not чрез if
 7 | (define (and2 x y)
 8 |   (if x y #f))
 9 | 
10 | (define (or2 x y)
11 |   (if x #t y))
12 | 
13 | (define (not2 x)
14 |   (if x #f #t))
15 | 
16 | ; Рекурсивна процедура за намиране на n-тото число на Фибоначи
17 | (define (fib n)
18 |   ;(if (< n 2) n
19 |   ;    (+ (fib (- n 1)) (fib (- n 2)))))
20 |   (cond [(or (negative? n) (not (integer? n))) #f]
21 |         [(< n 2) n]
22 |         [else (+ (fib (- n 1)) (fib (- n 2)))]))
23 | 
24 | ; Намиране на брой корени на квадратно уравнение
25 | ; по дадени коефициенти
26 | (define (roots a b c)
27 |   (define d (- (* b b) (* 4 a c)))
28 |   (cond [(and (= a 0) (= b 0)) 0]
29 |         [(or (= a 0) (= d 0)) 1]
30 |         [(> d 0) 2]
31 |         [else 0])
32 | )
33 | 
34 | ; Изчисляване на биномен коефициент (n над k)
35 | (define (nchoosek n k)
36 |   (if (or (= k 0) (= k n))
37 |       1
38 |       (+ (nchoosek (- n 1) k)
39 |          (nchoosek (- n 1) (- k 1)))))
40 | 
41 | ; Рекурсивна процедура за изчисляване на n!
42 | (define (fact n)
43 |   (if (< n 2) 1
44 |       (* n (fact (- n 1)))))
45 | 
46 | ; Директна формула за изчисление на биномния коефициент
47 | (define (nchk2 n k)
48 |   (/ (fact n)
49 |      (* (fact k) (fact (- n k)))))
50 | 
51 | ; "Бързо" степенуване: T(n)=O(lgn), работи само за n - естествено число
52 | (define (fast-exp x n)
53 |   (define (sq x) (* x x))
54 |   (define k (quotient n 2))
55 |   (cond [(zero? n) 1]
56 |         [(even? n) (sq (fast-exp x k))]
57 |         [else (* (sq (fast-exp x k)) x)])
58 | )
59 | 
60 | ; Обща функция за бързо степенуване, която работи с всякакви степени
61 | (define (fast-exp2 x n)
62 |   (cond [(and (positive? n) (integer? n)) (fast-exp x n)]
63 |         [(integer? n) (/ 1 (fast-exp x (- n)))]
64 |         [else (* (fast-exp2 x (round n))
65 |                  (expt x (- n (round n))))]))
66 | 


--------------------------------------------------------------------------------
/20161018-week3.rkt:
--------------------------------------------------------------------------------
 1 | ; Зад.1 - Да се обърнат цифрите на дадено число -
 2 | ; итеративен вариант
 3 | (define (reverse-int n)
 4 |   (define (helper n res)
 5 |     (if (= n 0)
 6 |         res
 7 |         (helper (quotient n 10) (+ (* res 10) (remainder n 10)))))
 8 |   (helper n 0))
 9 | 
10 | ; Зад.2 - Да се провери дали едно число е палиндром
11 | (define (palindrome? n)
12 |   (= n (reverse-int-iter n)))
13 | 
14 | ; Зад.3 - Да се изчисли сумата от делителите на дадено число
15 | (define (divisors-sum n)
16 |   (define (helper i res)
17 |     (cond [(> i n) res]
18 |           [(= (remainder n i) 0) (helper (+ i 1) (+ res i))]
19 |           [else (helper (+ i 1) res)]))
20 |   (helper 1 0))
21 | 
22 | ; Зад.4 - Да се провери дали число е "съвършено"
23 | (define (perfect? n)
24 |   (= (divisors-sum n) (* 2 n)))
25 | 
26 | ; Зад.5 - Да се провери дали число е просто
27 | (define (prime? n)
28 |   (define sqn (sqrt n))
29 |   (define (helper i)
30 |     (cond [(> i sqn) #t]
31 |           [(= (remainder n i) 0) #f]
32 |           [else (helper (+ i 1))]))
33 |   (if (= n 1)
34 |       #f
35 |       (helper 2)))
36 | 
37 | ; Зад.6 - Да се провери дали цифрите на число са в строго нарастващ ред
38 | (define (increasing? n)
39 |   (define (getLast n) (remainder n 10))
40 |   (define (get2ndLast n) (getLast (quotient n 10)))
41 |   (cond [(< n 10) #t]
42 |         [(>= (get2ndLast n) (getLast n)) #f]
43 |         [else (increasing? (quotient n 10))]))
44 | 
45 | ; Зад.7 - Да се превърне число от десетична в двоична бройна система
46 | (define (toBinary n)
47 |   (define (helper n res bit)
48 |     (if (= n 0)
49 |         res
50 |         (helper (quotient n 2) (+ res (* (remainder n 2) (expt 10 bit))) (+ bit 1))))
51 |   (helper n 0 0))
52 | 
53 | ; Зад.8 - Да се превърне число от двоична в десетична бройна система
54 | ; Забележете приликата между тази и предишната задача. Как може да се
55 | ; напише тогава функция, която променя число от p-ична в q-ична бройна система?
56 | (define (toDecimal n)
57 |   (define (helper n res bit)
58 |     (if (= n 0)
59 |         res
60 |         (helper (quotient n 10) (+ res (* (remainder n 10) (expt 2 bit))) (+ bit 1))))
61 |   (helper n 0 0))
62 | 


--------------------------------------------------------------------------------
/20161025-week4.rkt:
--------------------------------------------------------------------------------
  1 | #lang racket
  2 | ; Обща функция за произведение в интервал - 
  3 | ; рекурсивна дефиниция + изполвайки accumulate
  4 | (define (product a b term next)
  5 |   ;(if (> a b)
  6 |   ;    1
  7 |   ;    (* (term a) (product (next a) b term next))))
  8 |   (accum-iter * 1 a b term next))
  9 | 
 10 | ; Обща функция за сума в интервал - 
 11 | ; рекурсивна дефиниция + изполвайки accumulate
 12 | (define (sum a b term next)
 13 |   ;(if (> a b)
 14 |   ;    0
 15 |   ;    (+ (term a) (sum (next a) b term next)))
 16 |   (accum-iter + 0 a b term next))
 17 | 
 18 | ; Обща функция за сума в интервал - итеративна дефиниция
 19 | (define (sum-iter a b term next)
 20 |   (define (helper res curr)
 21 |     (if (> curr b)
 22 |         res
 23 |         (helper (+ res (term curr)) (next curr))))
 24 |   (helper 0 a))
 25 | 
 26 | ; "Стандартна" функция от по-висок ред accumulate - рекурсивна дефиниция
 27 | (define (accumulate op nv a b term next)
 28 |   (if (> a b)
 29 |       nv
 30 |       (op (term a) (accumulate op nv (next a) b term next))))
 31 | 
 32 | ; accumulate - итеративна дефиниция.
 33 | ; Внимавайте - може да даде различни резултати когато op не е комутативна операция!
 34 | (define (accum-iter op nv a b term next)
 35 |   (define (helper res i)
 36 |     (if (> i b)
 37 |         res
 38 |         (helper (op (term i) res) (next i))))
 39 |   (helper nv a))
 40 | 
 41 | ; Малки, полезни функцийки
 42 | (define (id x) x)
 43 | (define (++ x) (+ x 1))
 44 | 
 45 | ; Зад.1 - Изчисляване на n! с accumulate
 46 | (define (fact-accum n)
 47 |   (product 1 n id ++))
 48 | 
 49 | ; Зад.2 - Степенуване с accumulate
 50 | (define (expt-accum x n)
 51 |   ;(define (term i) x)
 52 |   ;(product 1 n term ++)
 53 |   (product 1 n (lambda (i) x) ++)) ; анонимна функция вместо вложена дефиниция
 54 | 
 55 | ; Зад.3 - Намиране на брой делители на число в интервал
 56 | (define (count-divisors n a b)
 57 |   (define (counter i) (if (= (remainder n i) 0)
 58 |                        1
 59 |                        0))
 60 |   (sum a b counter ++))
 61 | 
 62 | ; Зад.4 - Изчисляване на x+2x^2+...+nx^n
 63 | (define (powers-sum x n)
 64 |   (define (term i) (* i (expt x i)))
 65 |   (if (and (integer? n)
 66 |            (>= n 0))
 67 |       (sum 1 n term ++)
 68 |       #f))
 69 | 
 70 | ; Функция от по-висок ред, която намира приближена
 71 | ; стойност на определен интеграл.
 72 | (define (integrate f a b)
 73 |   (define h 0.001)
 74 |   (sum a
 75 |        (- b h)
 76 |        (lambda (a) (* (f a) h))
 77 |        (lambda (i) (+ i h))))
 78 | 
 79 | ; Зад.5 - Изчисление на биномен коефициент (3 еквивалентни варианта)
 80 | (define (combinations n k)
 81 |   (define (term i) (/ (- (+ n 1) i) i))
 82 |   (product 1 k term ++))
 83 |   
 84 | (define (combinations2 n k)
 85 |   (define (term i) (/ (- (+ n i) k) i))
 86 |   (product 1 k term ++))
 87 | 
 88 | (define (combinations3 n k)
 89 |   (/ (product (- (+ n 1) k) n id ++)
 90 |      (product 1 k id ++)))
 91 | 
 92 | ; Относно синтаксиса на lambda-функциите
 93 | ;(define (f x y) (* x y))
 94 | ;(define f (lambda (x y) (* x y)))
 95 | ;(f 2 3)
 96 | ;((lambda (x y) (* x y)) 2 3)
 97 | 
 98 | ; Зад.6 - проверка дали число е просто, използвайки
 99 | ; "насъбиране" на логически стойности.
100 | (define (prime-accum n)
101 |   (define (term i) (not (= (remainder n i) 0)))
102 |   (define (and2 x y) (and x y))
103 |   (and (> n 1)
104 |        (accum-iter and2 #t 2 (- n 1) term ++)))
105 | 
106 | ; Зад.7 - изчисляване на n!!
107 | (define (!! n)
108 |   (define (2+ x) (+ x 2))
109 |   (define a (if (odd? n) 1 2))
110 |   ;(define a (- 2 (remainder n 2)))
111 |   (product a n id 2+))
112 | 
113 | ; Зад.8 и Зад.9 са съответно дефинициите на sum-iter и accum-iter по-горе.
114 | 
115 | ; Зад.10 - Производна на функция
116 | (define (derivative f)
117 |   (define h 0.0000001)
118 |   (lambda (x) (/ (- (f (+ x h)) (f x)) h)))
119 | 
120 | ;(define id-prim (derivative id))
121 | ;(id-prim 5)  ; т.к. derivative връща функция, то id-prim
122 |               ; е функция и я извикваме като такава
123 | ;((derivative id) 5) ; същото като горния ред
124 | ;(define (f x) (+ (* x x) (* 2 x)))
125 | ;((derivative f) 5)
126 | ;(integrate (derivative f) 1 10)
127 | 
128 | ; Зад.11 - Функция-константа (забележете, че върнатият резултат е функция)
129 | (define (constantly c)
130 |   (lambda (x) c))
131 | 
132 | ; Зад.12 - Обръщане на аргументите на функция (отново връщаме нова функция)
133 | (define (flip f)
134 |   (lambda (x y) (f y x)))
135 | 
136 | ; Зад.13 - Композиция на функции (няма смисъл да казваме, че е функция)
137 | (define (compose f g)
138 |   (lambda (x) (f (g x))))
139 |   
140 | ;(define 2+ (compose ++ ++))
141 | ;(2+ 10) ;-> 12
142 | 
143 | ; Зад.14 - Отрицание на предикат
144 | (define (complement p?)
145 |   (lambda (x) (not (p? x))))
146 | 
147 | (define (my-even? x) (= (remainder x 2) 0))
148 | (define my-odd? (complement my-even?))
149 | 


--------------------------------------------------------------------------------
/20161108-week5.rkt:
--------------------------------------------------------------------------------
  1 | #lang racket
  2 | ; Зад.1. Дължина на списък - рекурсивен (закоментиран) и итеративен вариант
  3 | (define (length* lst)
  4 |   ;(if (null? lst) 0
  5 |   ;    (+ 1 (length* (cdr lst)))))
  6 |   (define (helper lst res)
  7 |     (if (null? lst) res
  8 |         (helper (cdr lst) (+ res 1))))
  9 |   (helper lst 0))
 10 | 
 11 | ; Зад.1. Обръщане на списък - рекурсивен (О(n^2)) и итеративен (O(n)) вариант
 12 | (define (reverse* lst)
 13 |   ;(if (null? lst)
 14 |   ;    '()
 15 |   ;    (append (reverse (cdr lst)) (list (car l)))
 16 |   (define (helper lst res)
 17 |     (if (null? lst)
 18 |         res
 19 |         (helper (cdr lst) (cons (car lst) res))))
 20 |   (helper lst '()))
 21 | 
 22 | ; Зад.2. Взимане на индекс от списък
 23 | (define (nth n lst)
 24 |   (cond [(or (null? lst) (< n 0)) #f]
 25 |         [(= n 0) (car lst)]
 26 |         [else (nth (- n 1) (cdr lst))]))
 27 | 
 28 | ; Зад.3. Взимане на индекс от списък
 29 | (define (range from to)
 30 |   (if (> from to)
 31 |       '()
 32 |       (cons from (range (+ from 1) to))))
 33 |   ;(accumulate cons '() from to (lambda (x) x) (lambda (x) (+ x 1))
 34 | 
 35 | ; Зад.4. Списък от цифрите на число
 36 | (define (digit-list n)
 37 |   (define (helper n res)
 38 |     (if (< n 10)
 39 |         (cons n res)
 40 |         (helper (quotient n 10) (cons (remainder n 10) res))))
 41 |   (helper n '()))
 42 | 
 43 | ; Зад.5. Взимане/премахване на няколко елементи от списък
 44 | (define (take* n lst)
 45 |   (if (or (= n 0) (null? lst))
 46 |       '()
 47 |       (cons (car lst)
 48 |             (take* (- n 1) (cdr lst)))))
 49 | 
 50 | (define (drop* n lst)
 51 |   (if (or (= n 0) (null? lst))
 52 |       lst
 53 |       (drop* (- n 1) (cdr lst))))
 54 | 
 55 | ; Зад.6. Разцепване на списък на парчета
 56 | (define (chunk n lst)
 57 |   (if (null? lst)
 58 |       '()
 59 |       (cons (take* n lst)
 60 |             (chunk n (drop* n lst)))))
 61 | 
 62 | ; Зад.7. - Стандартни функции за проверка на предикат в списък
 63 | (define (all p? lst)
 64 |   (cond [(null? lst) #t]
 65 |         [(not (p? (car lst))) #f]
 66 |         [else (all p? (cdr lst))]))
 67 | 
 68 | ;(define (any p? lst)
 69 | ;  (cond [(null? lst) #f]
 70 | ;        [(p? (car lst)) #t]
 71 | ;        [else (any p? (cdr lst))]))
 72 | 
 73 | (define (any p? lst)
 74 |   (not (all (lambda (x) (not (p? x))) lst)))
 75 | 
 76 | ; Бонус: foldr
 77 | (define (foldr* op nv lst)
 78 |   (if (null? lst)
 79 |       nv
 80 |       (op (car lst)
 81 |           (foldr* op nv (cdr lst)))))
 82 | 
 83 | ; Зад.8. zip
 84 | (define (zip lst1 lst2)
 85 |   (if (or (null? lst1) (null? lst2))
 86 |       '()
 87 |       (cons (cons (car lst1) (car lst2))
 88 |             (zip (cdr lst1) (cdr lst2)))))
 89 | 
 90 | ; Зад.9.
 91 | (define (remove-first val lst)
 92 |   (cond [(null? lst) '()]
 93 |         [(equal? val (car lst)) (cdr lst)]
 94 |         [else (cons (car lst) (remove-first val (cdr lst)))]))
 95 | 
 96 | (define (remove-all val lst)
 97 |   (filter (lambda (x) (not (equal? val x))) lst))
 98 | 
 99 | ; Зад.10.
100 | (define (sum-of-sums lst)
101 |   (define (sum l) (foldr + 0 l))
102 |   (map sum lst))
103 | 
104 | ; Зад.11.
105 | (define (extract-ints lst)
106 |   (filter integer? lst))
107 | 
108 | ; Зад.12.
109 | (define (insert val lst)
110 |   (if (or (null? lst) (< val (car lst)))
111 |       (cons val lst)
112 |       (cons (car lst) (insert val (cdr lst)))))
113 | 
114 | ; Зад.13.
115 | (define (insertion-sort lst)
116 |   (if (null? lst)
117 |       '()
118 |       (insert (car lst) (insertion-sort (cdr lst)))))
119 | 
120 | (define (insertion-sort* lst) ; за ентусиастите
121 |   (foldr insert '() lst))
122 | 
123 | ; Зад.14. Функция, която брои с колко аргументи е извикана
124 | (define (my-arity . xs)
125 |   (length xs)) ; тук xs вече е списък
126 | 
127 | ; Зад.15. Композиция на произволен брой функции
128 | (define (compose . fns)
129 |   (if (null? fns)
130 |       (lambda (x) x)
131 |       (lambda (x) ((car fns) ((apply compose (cdr fns)) x)))))
132 | 
133 | ; Зад.16. За ентусиастите
134 | ; 1. '(1 2 3 4 5)
135 | ; -> '((1 . #f) (2 . #t) (3 . #f) (4 . #t) (5 . #f))
136 | (define (makePairs f lst)
137 |   (map (lambda (x) (cons x (f x))) lst))
138 | 
139 | ; 2. '((1 . #f) (2 . #t) (3 . #f) (4 . #t) (5 . #f))
140 | ; -> '( ((1 . #f) (3 . #f) (5 . #f))
141 | ;       ((2 . #t) (4 . #t)) )
142 | (define (groupPairs lst)
143 |   (let* ((predicate (lambda (x) (equal? (cdr (car lst)) (cdr x))))
144 |          (firsts (filter predicate lst))
145 |          (rest (filter (lambda (x) (not (predicate x))) lst)))
146 |     (if (null? lst)
147 |         '()
148 |         (cons firsts (groupPairs rest)))))
149 | 
150 | ; 3. '( ((1 . #f) (3 . #f) (5 . #f))
151 | ;       ((2 . #t) (4 . #t)) )
152 | ; -> '((#f (1 3 5)) (#t (2 4)))
153 | (define (combineGroups lst)
154 |   (map (lambda (l) (list (cdar l) (map car l))) lst))
155 | 
156 | (define (group-by-f f lst)
157 |   (combineGroups (groupPairs (makePairs f lst))))
158 | ; haskell: group-by-f f = combineGroups . groupPairs . makePairs f
159 | 
160 | ; iei
161 | (define (group-by-f* f lst)
162 |   (let* ((predicate (lambda (x) (equal? (f x) (f (car lst)))))
163 |          (firsts (filter predicate lst))
164 |          (rest (filter (lambda (x) (not (predicate x))) lst)))
165 |     (if (null? lst)
166 |         '()
167 |         (cons (list (f (car lst)) firsts)
168 |               (group-by-f* f rest)))))
169 | 


--------------------------------------------------------------------------------
/20161115-week6.rkt:
--------------------------------------------------------------------------------
  1 | #lang racket
  2 | (define (accumulate op nv term next a b)
  3 |   (if (> a b)
  4 |       nv
  5 |       (op (term a) (accumulate op nv term next (next a) b))))
  6 | 
  7 | ; Зад.1 (Вар.А) - две решения
  8 | ; "броене" с accumulate - функцията term връща само единици и нули, после сумираме
  9 | (define (meetTwice? f g a b)
 10 |   (>= (accumulate + 0
 11 |                   (lambda (i) (if (= (f i) (g i)) 1 0))
 12 |                   (lambda (x) (+ x 1))
 13 |                   a b)
 14 |       2))
 15 | 
 16 | ; да генерираме списък от числата в интервала...
 17 | (define (range a b)
 18 |   ;(if (> a b) '() (cons a (range (+ a 1) b))))
 19 |   (accumulate cons '() (lambda (i) i) (lambda (x) (+ x 1)) a b))
 20 | 
 21 | ; и после да видим дължината му
 22 | (define (meetTwice?? f g a b)
 23 |   (>= (length (filter (lambda (x) (= ((f x) (g x))) (range a b)))
 24 |       2)))
 25 | 
 26 | ; Зад.2 (Вар.А) - също няколко подхода
 27 | (define (is-duplicate? x lst) ; сравняваме с equal?, понеже може и да не са числа
 28 |   (> (length (filter (lambda (y) (equal? x y)) lst)) 1))
 29 | 
 30 | ;(define (find-duplicates lst)
 31 |   ;(filter (lambda (x) (is-duplicate? x lst)) lst))
 32 | 
 33 | ; за премахване на всички срещания на число в списък
 34 | (define (remove-all x lst)
 35 |   (filter (lambda (y) (not (equal? x y))) lst))
 36 | 
 37 | ; намиране на всички повтарящи се елементи в списък
 38 | (define (find-duplicates lst)
 39 |   (cond [(null? lst) '()]
 40 |         [(is-duplicate? (car lst) lst) (cons (car lst)
 41 |                                              (find-duplicates (remove-all (car lst) (cdr lst))))]
 42 |         [else (find-duplicates (cdr lst))]))
 43 | 
 44 | (define (max-duplicate ll)
 45 |   (let [(temp (apply append (map find-duplicates ll)))]
 46 |     (if (null? temp) #f (apply max temp))))
 47 | 
 48 | ; стандартни функции
 49 | (define (all? p? lst)
 50 |   (cond [(null? lst) #t]
 51 |         [(not (p? (car lst))) #f]
 52 |         [else (all? p? (cdr lst))]))
 53 | 
 54 | (define (any? p? lst)
 55 |   (not (all? (lambda (x) (not (p? x))) lst)))
 56 | 
 57 | ; дали списък съдържа повече от едно число, кратно на k
 58 | (define (contains-multiple k lst)
 59 |   (any? (lambda (x) (= (remainder x k) 0)) lst))
 60 | 
 61 | ; Зад.3
 62 | (define (checkMatrix? m k)
 63 |   (all? (lambda (row) (contains-multiple k row)) m))
 64 | 
 65 | ; Зад.9.
 66 | ; ппомощна функция дали списъкът lst1 е префикс на lst2
 67 | (define (begins-with? lst1 lst2)
 68 |   (cond [(and (null? lst1) (null? lst2)) #t] ; '() '() -> #t
 69 |         [(null? lst1) #t]                    ; '() '(1 2 3) -> #t
 70 |         [(null? lst2) #f]                    ; '(1 2 3) '() -> #f
 71 |         [(equal? (car lst1) (car lst2)) (begins-with? (cdr lst1) (cdr lst2))]
 72 |         [else #f]))
 73 | 
 74 | (define (sublist? lst1 lst2)
 75 |   (cond [(null? lst2) (null? lst1)]
 76 |         [(begins-with? lst1 lst2) #t]
 77 |         [else (sublist? lst1 (cdr lst2))]))
 78 | 
 79 | ; Зад.10.
 80 | (define (make-set lst)
 81 |   (if (null? lst)
 82 |       '()
 83 |       (cons (car lst) (make-set (remove-all (car lst) (cdr lst))))))
 84 | 
 85 | ; бонус: най-бързото (за написване) сортиране
 86 | (define (quick-sort lst)
 87 |   (if (null? lst) '()
 88 |       (append (quick-sort (filter (lambda (x) (< x (car lst))) lst))
 89 |                           (filter (lambda (x) (= x (car lst))) lst)
 90 |               (quick-sort (filter (lambda (x) (> x (car lst))) lst)))))
 91 | 
 92 | ; Зад.11.
 93 | (define (histogram lst)
 94 |   ; отново - колко пъти елемент се среща в списък
 95 |   (define (count x lst) (length (filter (lambda (y) (equal? x y)) lst)))
 96 |   (map (lambda (x) (cons x (count x lst))) (make-set lst)))
 97 | 
 98 | ; полезни функции за работа с матрици
 99 | (define (nth-row n m) (list-ref m n))
100 | (define (nth-col n m) (map (lambda (row) (list-ref row n)) m))
101 | (define (row-count m) (length m))
102 | (define (col-count m) (length (car m)))
103 | (define M '((1 2 3) (4 5 6) (7 8 9)))
104 | ; (car m) -> първият ред на матрицата
105 | ; (cdr m) -> всичко без първия ред
106 | ; (map car m) -> първият стълб на матрицата
107 | ; (map cdr m) -> всичко без първия стълб
108 | ; (cdr (map cdr m)) -> всичко без първи ред и първи стълб
109 | ; (map cdr (cdr m)) -> същото като горното
110 | 
111 | ; Зад.12. - класическа задача
112 | ; работи за квадратни и правоъгълни матрици
113 | (define (transpose m)
114 |   (if (null? (car m))
115 |       '()
116 |       (cons (map car m) (transpose (map cdr m)))))
117 | 
118 | ; Зад.13. - триъгълни са:
119 | ; ((1 2 3)  , ((1 2 3 4)  , ((1 2)
120 | ;  (0 4 5)     (0 5 6 7)     (0 3)
121 | ;  (0 0 6))    (0 0 8 9))    (0 0)) и това са всички случаи
122 | (define (triangular? m)
123 |   (define (allZero col) (all? (lambda (x) (= x 0)) col))
124 |   (if (or (null? (car m)) (null? (cdr m))) ; за да обработва коректно и квадратни, и правоъгълни матрици
125 |       #t      ; първата колона, без първия ред
126 |       (and (allZero (cdr (map car m)))
127 |            (triangular? (cdr (map cdr m))))))
128 | 
129 | ; МНОГО полезна функция
130 | (define (null-mat? m)
131 |   (or (null? m) (null? (car m))))
132 | 
133 | ; Зад.14.
134 | (define (main-diag m)
135 |   (if (null-mat? m)
136 |       '()
137 |       (cons (caar m) (main-diag (cdr (map cdr m))))))
138 | 
139 | ; Зад.15. - обръщаме редовете на матрицата огледално и взимаме диагонала на полученото
140 | (define (2nd-diag m)
141 |   (main-diag (map reverse m)))
142 | 
143 | ; Зад.16.
144 | (define (descartes lst1 lst2) ; map-ception
145 |   (apply append (map (lambda (x) (map (lambda (y) (cons x y)) lst2)) lst1)))
146 | 


--------------------------------------------------------------------------------
/20161122-week7.rkt:
--------------------------------------------------------------------------------
  1 | #lang racket
  2 | ; "Стандартни" функции за работа с дървета
  3 | (define (tree? t)
  4 |   (or (null? t)
  5 |       (and (list? t)
  6 |            (= (length t) 3))
  7 |            (tree? (cadr t))
  8 |            (tree? (caddr t))))
  9 | (define empty-tree '())
 10 | (define (make-tree root left right) (list root left right))      ; не искаме просто (define make-tree list) - защо?
 11 | (define (make-leaf root) (make-tree root empty-tree empty-tree)) ; за удобство
 12 | (define root-tree car)
 13 | (define left-tree cadr)
 14 | (define right-tree caddr)
 15 | (define empty-tree? null?)
 16 | 
 17 | ; примерно дърво, над което ще си тестваме
 18 | (define test
 19 |   (make-tree 3
 20 |              (make-tree 1
 21 |                         (make-leaf 2)
 22 |                         empty-tree)
 23 |              (make-tree 5
 24 |                         (make-leaf 9)
 25 |                         (make-leaf 3))))
 26 | 
 27 | ; Зад.1.
 28 | (define (tree-sum t)
 29 |   (if (empty-tree? t)
 30 |       0
 31 |       (+ (root-tree t)
 32 |          (tree-sum (left-tree t))
 33 |          (tree-sum (right-tree t)))))
 34 | 
 35 | ; Помощна функция
 36 | (define (tree-height t)
 37 |   (if (empty-tree? t)
 38 |       -1
 39 |       (+ 1 (max (tree-height (left-tree t))
 40 |                 (tree-height (right-tree t))))))
 41 | 
 42 | ; Зад.2.
 43 | (define (tree-max t)
 44 |   (if (empty-tree? t)
 45 |       -inf.0
 46 |       (max (root-tree t)
 47 |            (tree-max (left-tree t))
 48 |            (tree-max (right-tree t)))))
 49 | 
 50 | ; Зад.3.
 51 | (define (tree-level k t)
 52 |   (cond [(empty-tree? t) '()]
 53 |         [(= k 0) (list (root-tree t))]
 54 |         [else (append (tree-level (- k 1) (left-tree t))
 55 |                       (tree-level (- k 1) (right-tree t)))]))
 56 | 
 57 | ; Зад.4.
 58 | (define (all-levels t)
 59 |   (let [(height (tree-height t))]
 60 |     (map (lambda (i) (tree-level i t)) (range 0 (+ height 1)))))
 61 | 
 62 | ; Зад.5.
 63 | (define (tree-map f t)
 64 |   (if (empty-tree? t)
 65 |       empty-tree
 66 |       (make-tree (f (root-tree t))
 67 |                  (tree-map f (left-tree t))
 68 |                  (tree-map f (right-tree t)))))
 69 | 
 70 | ; Зад.6.
 71 | (define (tree->list t)
 72 |   (if (empty-tree? t)
 73 |       '()
 74 |       (append (tree->list (left-tree t))
 75 |               (list (root-tree t))
 76 |               (tree->list (right-tree t)))))
 77 | 
 78 | ; Зад.7.
 79 | (define (bst-insert val t)
 80 |   (cond [(empty-tree? t) (make-leaf val)]
 81 |         [(< val (root-tree t)) (make-tree (root-tree t)
 82 |                                           (bst-insert val (left-tree t))
 83 |                                           (right-tree t))]
 84 |         ;[(= val (root-tree t)) t]
 85 |         [else (make-tree (root-tree t)
 86 |                          (left-tree t)
 87 |                          (bst-insert val (right-tree t)))]))
 88 | 
 89 | ; Вмъкване на списък от стойности в дърво:
 90 | ; три варианта - рекурсивен, итеративен и fold
 91 | (define (list->tree lst)
 92 |   ;(if (null? lst)
 93 |   ;    empty-tree
 94 |   ;    (bst-insert (car lst)
 95 |   ;                (list->tree (cdr lst))))
 96 |   ;;(define (helper lst result)
 97 |   ;;  (if (null? lst)
 98 |   ;;      result
 99 |   ;;      (helper (cdr lst) (bst-insert (car lst) result))))
100 |   ;;(helper lst empty-tree)
101 |   (foldr bst-insert empty-tree lst))
102 | 
103 | 
104 | ; Зад.8.
105 | (define (tree-sort lst) (tree->list (list->tree lst)))
106 | ;(define tree-sort (compose tree->list list->tree))
107 | ; tree-sort = tree->list . list->tree
108 | 
109 | ; Зад.8+.
110 | ; решение с проверка на генерирания списък + с интервал от "допустими" стойности
111 | (define (valid-bst? t)
112 |   (define (isNonDecr? lst) ; дали стойностите в списъка са в ненамаляващ ред
113 |     (cond [(or (null? lst) (null? (cdr lst))) #t]
114 |           [(> (car lst) (cadr lst)) #f]
115 |           [else (isNonDecr? (cdr lst))]))
116 |   (isNonDecr? (tree->list t)))
117 | 
118 | (define (valid-bst?? t)
119 |   (define (helper t from to)
120 |     (cond [(empty-tree? t) #t]
121 |           [(or (< (root-tree) from)
122 |                (> (root-tree) to)) #f]
123 |           [else (helper (left-tree t) from (root-tree t))
124 |                 (helper (right-tree t) (root-tree t) to)]))
125 |   (helper t -inf.0 +inf.0))
126 | 
127 |         
128 | 


--------------------------------------------------------------------------------
/20161129-week8.rkt:
--------------------------------------------------------------------------------
  1 | #lang racket
  2 | ; функция, която гарантирано ни връща булева стойност
  3 | (define (member? x lst)
  4 |   (if (member x lst) #t #f))
  5 | 
  6 | ; маък граф, над който ще тестваме всички функции
  7 | (define G '((a b c d) ; от а има ребра към b,c,d
  8 |             (b e f)   ; може да бъде и ориентиран
  9 |             (c a d)
 10 |             (d b c g)
 11 |             (e)       ; връх без наследници
 12 |             (f b e)
 13 |             (g a)))
 14 | 
 15 | ; Зад.1. - взимане на всики върхове в граф
 16 | (define (vertices g)
 17 |   (map car g))
 18 | 
 19 | ; взимане на всички наследници на даден връх в граф
 20 | (define (successors v g)
 21 |   (let [(result (assoc v g))]
 22 |     (if result (cdr result) '())))
 23 | 
 24 | ; проверка дали съществува ребро между два върха в графа
 25 | ; заради member и assoc работи коректно дори когато върховете са несъществуващи
 26 | (define (has-edge? u v g)
 27 |   (member? v (successors u g)))
 28 | 
 29 | ; за да добавяме ребро, първо трябва да добавим върховете му
 30 | ; естествено, не добавяме един връх повече от веднъж
 31 | (define (add-vertex v g)
 32 |   (if (member? v (vertices g))
 33 |       g
 34 |       (cons (list v) g)))
 35 | 
 36 | ; Зад.2.
 37 | (define (add-edge u v g)
 38 |   (if (has-edge? u v g)
 39 |       g
 40 |       (let [(newg (add-vertex u (add-vertex v g)))]
 41 |         (map (lambda (l) (if (equal? (car l) u)
 42 |                              (append l (list v))
 43 |                              l))
 44 |              newg))))
 45 | 
 46 | ; след като можем да добавяме едно ребро, защо да не можем
 47 | ; да направим граф от цял списък с ребра?
 48 | (define (make-from-edges lst)
 49 |   ;(if (null? lst)
 50 |   ;    '()
 51 |   ;    (add-edge (caar lst) (cdar lst)
 52 |   ;              (make-from-edges (cdr lst)))))
 53 |   (foldr (lambda (e g) (add-edge (car e)
 54 |                                  (cdr e)
 55 |                                  g))
 56 |          '()
 57 |          lst))
 58 | 
 59 | ; Зад.3. - проверка за съдържане на път в графа
 60 | (define (contains-path? path g)
 61 |   (cond [(null? path) #t]
 62 |         [(null? (cdr path)) (member? (car path) (vertices g))]
 63 |         [(has-edge? (car path) (cadr path) g) (contains-path? (cdr path) g)]
 64 |         [else #f]))
 65 | 
 66 | ; (1 2 3 4) -> ((1 . 2) (2 . 3) (3 . 4))
 67 | ; (zip '(1 2 3) '(4 5 6 7 8)) -> '((1 . 4) (2 . 5) (3 . 6))
 68 | ; (zip path (cdr path))
 69 | (define (contains-path?? path g)
 70 |   (define (make-pairs path) #f) ; това трябва да е гореописаната функция
 71 |   (null? (filter (lambda (e) (not (has-edge? (car e)
 72 |                                              (cdr e)
 73 |                                              g)))
 74 |                  (make-pairs path))))
 75 | 
 76 | ; бонус - map и filter чрез foldr
 77 | (define (map* f lst)
 78 |   (foldr (lambda (x l) (cons (f x) l)) '() lst))
 79 | 
 80 | (define (filter* p? lst)
 81 |   (foldr (lambda (x l) (if (p? x)
 82 |                            (cons x l)
 83 |                            l))
 84 |          '()
 85 |          lst))
 86 | 
 87 | ; Зад.4. - предшественици на връх
 88 | (define (predecessors v g)
 89 |   (filter (lambda (u) (has-edge? u v g)) (vertices g)))
 90 | 
 91 | ; Зад.5. - разширение на път с едно ребро.
 92 | ; Ако пътят е празен, значи връща всички възможни пътищв с дължина 0 (т.е. един връх)
 93 | (define (extend-path path g)
 94 |   (if (null? path)
 95 |       (map list (vertices g))
 96 |       (map (lambda (v) (append path (list v)))
 97 |            (filter (lambda (v) (not (member? v path)))
 98 |                    (successors (last path) g)))))
 99 | 
100 | ; "разширяване" на цял списък от пътища - получаваме друг списък от пътища
101 | (define (extend-paths paths g)
102 |   (apply append (map (lambda (p) (extend-path p g)) paths)))
103 | 
104 | ; Зад.7. - списък с всичките ребра на граф
105 | (define (edge-list g)
106 |   (define (make-pairs-single l) (map (lambda (v) (cons (car l) v))
107 |                                      (cdr l)))
108 |   (apply append (map make-pairs-single g)))
109 | 
110 | ; Зад.8. - обръщане на всички ребра в граф
111 | (define (invert g)
112 |   (define (flip p) (cons (cdr p) (car p)))
113 |   (make-from-edges (map flip (edge-list g))))
114 | 
115 | ; Зад.9. - обхождане в широчина, използвайки помощна функция, която на всяка
116 | ; "итерация" пази текущото "ниво" и изчислява следващото с друга отделна функция (за удобство)
117 | (define (bfs v g)
118 |   (define (get-next-level current visited)
119 |     (apply append (map (lambda (v) (filter (lambda (v) (not (member? v visited)))
120 |                                    (successors v g)))
121 |                        current)))
122 |   (define (helper current result)
123 |     (let [(next (get-next-level current result))]
124 |       (if (null? next)
125 |           result
126 |           (helper next (append result next)))))
127 |   (helper (list v) (list v)))
128 | 
129 | 
130 | 
131 | 
132 | 


--------------------------------------------------------------------------------
/20161206-week9.lhs:
--------------------------------------------------------------------------------
 1 | Целият текст във файл с разширение .lhs по подразбиране е коментар.
 2 | Редовете с истински код трябва да бъдат започнати с '> ' и отделени отделени
 3 | от коментарите с поне един празен ред.
 4 | 
 5 | Константите в Хаскел изглеждат така, както очакваме да изглежда някоя константа.
 6 | Можем изрично да посочим типа ѝ, ако не - компилаторът ще се досети кой е.
 7 | 
 8 | > mypi :: Double
 9 | > mypi = 3.141592
10 | 
11 | Сигнатура на функцията - ако я напишем, трябва да е пълна, т.е. или да пише
12 | конкретните типове (Int,Float,Double,Bool,Char,String,...), или да включва
13 | ограничения за тях в зависимост кои други функции използват тези аргументи.
14 | Ако не я напишем, интерпретаторът ще я deduce-не вместо нас, със все ограничения.
15 | 
16 | Точна сигнатура (ще работи само с Double):
17 | f :: Double -> Double -> Double
18 | Обща, но грешна сигнатура (ще работи със всякакви типове - добре, но + и sqrt не работят със всякакви):
19 | f :: a -> a -> a
20 | Правилна сигнатура с ограничения за типа:
21 | f :: (Floating a) => a -> a -> a
22 | 
23 | 
24 | > f :: (Floating a) => a -> a -> a
25 | > f x y = sqrt (x*x + y*y)
26 | > abc :: Int
27 | > abc = 3
28 | > b :: Float
29 | > b = 4.0
30 | 
31 | Функция, която приема някакво число и изписва какъв му е знака. Извиква оператора <,
32 | който изисква типът да е "сравним", значи и нашата функция трябва да има същото ограничение.
33 | Guard-овете трябва да се индентирани спрямо дефиницията на функцията (няма значение с колко)
34 | 
35 | > saySign :: (Num a, Ord a) => a -> String
36 | > saySign x
37 | >   | x < 0     = "Negative"
38 | >   | x == 0    = "Zero"
39 | >   | otherwise = "Positive"
40 | 
41 | Тривиално рекурсивно изчисление на n-тото число на Фибоначи.
42 | Integral класът се включва в Ord, значи няма нужда да пишем (Ord a, Integral a)
43 | 
44 | > fib :: (Integral a) => a -> a
45 | > fib n = if (n < 2)
46 | >         then n
47 | >         else (fib (n-1)) + (fib (n-2))
48 | 
49 | Изчисление с помощна функция, която дефинираме локално с where дефиниция (също индентирана)
50 | 
51 | > fib' :: (Integral a) => a -> a
52 | > fib' n
53 | >   | n < 0 = 0
54 | >   | otherwise = fibHelper 0 1 startIdx
55 | >   where fibHelper f1 f2 i
56 | >           | i == n    = f1
57 | >           | otherwise = fibHelper f2 (f1+f2) (i+1)
58 | >         startIdx = 0
59 | 
60 | Функция, която брои колко корена има квадратно уравнение по дадени коефициенти
61 | 
62 | > countRoots :: (Ord a, Floating a) => a -> a -> a -> String
63 | > countRoots a b c
64 | >  | a == 0      = "Not a quadratic equation!"
65 | >  | d < 0       = "zero roots"
66 | >  | d == 0      = "one root"
67 | >  | otherwise   = "two roots"
68 | >  where d = b*b - 4*a*c
69 | 
70 | Отделните аргументи може да са различни типове с различни ограничения.
71 | 
72 | > power :: (Num a, Integral b) => a -> b -> a
73 | > power base n
74 | >   | n == 0    = 1
75 | >   | even n    = square (power base (div n 2))
76 | >   | otherwise = base * square (power base (div n 2))
77 | >   where square x = x*x
78 | 
79 | Pattern matching - разписваме граничните случаи като отделни дефиниции.
80 | Искаме те да бъдат преди "общия случай" на функцията по същата логика,
81 | по която правим първо проверките в рекурсивната функция - нов е само синтаксиса.
82 | 
83 | > fib'' :: (Integral a) => a -> a
84 | > fib'' 0 = 0
85 | > fib'' 1 = 1
86 | > fib'' n = fib'' (n-1) + fib'' (n-2)
87 | 
88 | Безполезна функция, която връща 0 ако някой от аргументите й е 0 и сбора на всички иначе.
89 | Може в отделните случаи да ни интересуват само някои аргументи - на другите дори не даваме име.
90 | 
91 | > useless 0 _ _ _ = 0
92 | > useless _ 0 _ _ = 0
93 | > useless _ _ 0 _ = 0
94 | > useless _ _ _ 0 = 0
95 | > useless a b c d = a + b + c + d
96 | 


--------------------------------------------------------------------------------
/20161213-week10.hs:
--------------------------------------------------------------------------------
  1 | -- Зад.1. - можем да pattern match-ваме по компонентите на наредените двойки
  2 | modulus :: Floating a => (a, a) -> a
  3 | modulus (x,y) = sqrt (x^2 + y^2)
  4 | -- без pattern matching:
  5 | -- modulus p = sqrt ((fst p)^2 + (snd p)^2)
  6 | 
  7 | -- можем да pattern match-ваме и наредени тройки, n-торки и т.н.
  8 | modulus3D :: Floating a => (a, a, a) -> a
  9 | modulus3D (x,y,z) = sqrt(x^2 + y^2 + z^2)
 10 | 
 11 | -- Зад.2.
 12 | complAdd :: (Num a, Num b) => (a, b) -> (a, b) -> (a, b)
 13 | complAdd (x1,y1) (x2,y2) = (x1+x2, y1+y2)
 14 | 
 15 | complSub :: (Num a, Num b) => (a, b) -> (a, b) -> (a, b)
 16 | complSub (x1,y1) (x2,y2) = (x1-x2, y1-y2)
 17 | 
 18 | complMul :: Num a => (a, a) -> (a, a) -> (a, a)
 19 | complMul (x1,y1) (x2,y2) = (x1*x2 - y1*y2, x1*y2 + x2*y1)
 20 | 
 21 | -- Зад.3. - три решения с различните синтактични конструкции
 22 | -- pattenr matching
 23 | ackermann :: Integral a => a -> a -> a
 24 | ackermann 0 n = n + 1
 25 | ackermann m 0 = ackermann (m-1) 1
 26 | ackermann m n = ackermann (m-1) (ackermann m (n-1))
 27 | 
 28 | -- при case можем да "разпознаваме" само един "обект",
 29 | -- така че обединяваме двата ни аргумента в наредена двойка
 30 | ackermann' :: Integral a => a -> a -> a
 31 | ackermann' m n = case (m,n) of (0,n) -> n + 1
 32 |                                (m,0) -> ackermann' (m-1) 1
 33 |                                (m,n) -> ackermann' (m-1) (ackermann' m (n-1))
 34 | 
 35 | -- guard-ове
 36 | ackermann2 :: Integral a => a -> a -> a
 37 | ackermann2 m n
 38 |   | m == 0     = n + 1
 39 |   | n == 0     = ackermann2 (m-1) 1
 40 |   | otherwise  = ackermann2 (m-1) (ackermann2 m (n-1))
 41 | 
 42 | -- класически вложени if-ове - изглеждат грозно на всички езици
 43 | ackermann3 :: Integral a => a -> a -> a
 44 | ackermann3 m n = if m == 0
 45 |                  then n+1
 46 |                  else (if n == 0
 47 |                        then ackermann3 (m-1) 1
 48 |                        else ackermann3 (m-1) (ackermann3 m (n-1)))
 49 | 
 50 | -- Зад.4.
 51 | distance :: Floating a => (a, a) -> (a, a) -> a
 52 | distance (x1,y1) (x2,y2) = sqrt((x1-x2)^2 + (y1-y2)^2)
 53 | 
 54 | -- Зад.5.
 55 | replicate' :: Integral a => a -> b -> [b]
 56 | replicate' 0 _ = []
 57 | replicate' n el = el : (replicate' (n-1) el)
 58 | 
 59 | -- Зад.6. - можем да pattern match-ваме и списъци !
 60 | take' :: Integral a => a -> [b] -> [b]
 61 | take' _ [] = []
 62 | take' 0 _ = []
 63 | take' n (x:xs) = x : (take' (n-1) xs)
 64 | --      ^^^^^^
 65 | 
 66 | -- Зад.7. - list comprehension и range
 67 | prime :: Integral a => a -> Bool
 68 | prime 1 = False
 69 | prime n = null [ d | d<-[2..(n-1)], mod n d == 0 ]
 70 | 
 71 | -- Зад.8.
 72 | primes :: Integral a => [a]
 73 | primes = [ x | x<-[2..], prime x ]
 74 | 
 75 | -- Бонуси за list comprehension - декартово произведение на два списъка
 76 | descartes l1 l2 = [ (x,y) | x<-l1, y<-l2 ]
 77 | 
 78 | -- генериране на всички триъгълници с дължини на страните <=10
 79 | -- за повторение подреждаме страните само в нарастващ ред, тоест a<=b<=c
 80 | -- на практика е декартовото произведение на ТРИ списъка, макар и филтрирано
 81 | triangles = [ (a,b,c) | a<-[1..10], b<-[1..10], c<-[1..10],
 82 |                         a+b>c, a+c>b, b+c>a, a<=b, b<=c ]
 83 | 
 84 | -- втори вариант
 85 | triangles2 = [ (a,b,c) | c<-[1..10], b<-[1..c], a<-[1..b],
 86 |                         a+b>c, a+c>b, b+c>a ]
 87 | 
 88 | -- взимане на n-тия елемент на списък - има го и като вграден оператор !!
 89 | nth :: Integral a => a -> [b] -> b
 90 | nth 0 lst = head lst
 91 | nth n lst = nth (n-1) (tail lst) 
 92 | 
 93 | -- Зад.9.
 94 | -- забележка - !! изисква вторият аргумент (индексът) да е точно тип Int
 95 | nthPrime :: Integral a => Int -> a
 96 | nthPrime n = primes !! n
 97 | 
 98 | -- Зад.10. - take и drop аналогично изискват Int, иначе нямаме ограничения за типовете
 99 | removeNth :: Int -> [a] -> [a]
100 | removeNth _ [] = [] -- бяхме забравили дъното на рекурсията !
101 | removeNth n lst = (take (n-1) lst) ++ removeNth n (drop n lst)
102 | 
103 | -- Зад.11. Сито на Ератостен - просто красота
104 | primes2 :: [Int]
105 | primes2 = sieve [2..]
106 |   where sieve (x:xs) = x : sieve (removeNth x xs)
107 |         -- не се притесняваме за празни списъци, тъй като работим с безкрайни такива
108 | 


--------------------------------------------------------------------------------
/20161220-week11.hs:
--------------------------------------------------------------------------------
 1 | -- Зад.1. zip-ване на списъци - два варианта
 2 | -- Съществува такава функция с име zipWith
 3 | zipWith' :: (a -> b -> c) -> [a] -> [b] -> [c]
 4 | zipWith' f lst1 [] = []
 5 | zipWith' f [] lst2 = []
 6 | zipWith' f (x:xs) (y:ys) = (f x y) : zipWith' f xs ys
 7 | 
 8 | -- не пишем сигнатура - при компилация тя бива deduce-ната
 9 | zipWith2 f lst1 lst2
10 |   | null lst1 || null lst2 = []
11 |   | otherwise              = (f x y) : zipWith2 f xs ys
12 |   where x = head lst1
13 |         xs = tail lst1
14 |         y = head lst2
15 |         ys = tail lst2
16 | 
17 | -- Зад.2. - и такава функция има (takeWhile)
18 | takeWhile' :: (a -> Bool) -> [a] -> [a]
19 | takeWhile' _ [] = []
20 | takeWhile' p (x:xs)
21 |   | p x = x : takeWhile' p xs
22 |   | otherwise    = []
23 | 
24 | -- Зад.3. - отново я има вградена
25 | flip' :: (a -> b -> c) -> (b -> a -> c)
26 | flip' f = (\x y -> f y x)
27 | 
28 | -- за да тестваме долните функции
29 | testList = [1,1,2,3,3,3,4,2,2,2,1,1]
30 | 
31 | -- Зад.4 - "компресиране" на списък
32 | -- отново два варианта - с използване на вградените функции и със собствена countMyHead
33 | compress :: Eq a => [a] -> [(a, Int)]
34 | compress [] = []
35 | compress lst = ((head lst), firsts) : compress rest
36 |   where firsts = length (takeWhile (\x -> x == (head lst)) lst)
37 |         rest = dropWhile (\x -> x == (head lst)) lst
38 | 
39 | compress2 :: Eq a => [a] -> [(a, Int)]
40 | compress2 [] = []
41 | compress2 lst = ((head lst), firsts) : compress2 rest
42 |   where firsts = countMyHead lst
43 |         rest = drop firsts lst -- след като знаем колко пъти се повтаря главата,
44 |                                -- знаем колко точно елемента трябва да drop-нем
45 | 
46 | -- pattern matching за празен списък, списък с точно 1 елемент и списък с поне 2 елемента
47 | countMyHead :: Eq a => [a] -> Int
48 | countMyHead [] = 0
49 | countMyHead (x:[]) = 1
50 | countMyHead (x:y:xs)
51 |   | x == y     = 1 + countMyHead (y:xs)
52 |   | otherwise  = 1
53 | 
54 | -- Зад.5. - най-дълъг подсписък от еднакви стойности
55 | maxRepeated :: Eq a => [a] -> Int
56 | maxRepeated lst = maximum (map snd compressed)
57 |   where compressed = compress lst
58 | 
59 | -- Зад.6.
60 | -- итеративен вариант - изискваме Eq заради elem, който използва ==
61 | makeSet :: Eq a => [a] -> [a]
62 | makeSet lst = helper lst []
63 |   where helper [] result = result
64 |         helper (x:xs) result
65 |           | x `elem` result = helper xs result
66 |           | otherwise       = helper xs (x : result)
67 | 
68 | -- рекурсивен вариант - взимаме главата на списъка
69 | -- и после премахваме всички нейни срещания с filter
70 | makeSet' :: Eq a => [a] -> [a]
71 | makeSet' [] = []
72 | makeSet' (x:xs) = x : makeSet (removeHead xs)
73 |   where removeHead lst = filter (\x -> x /= (head lst)) lst
74 | 
75 | -- Зад.7.
76 | histogram :: Eq a => [a] -> [(a, Int)]
77 | histogram lst = [ (el, count el lst) | el<-set ]
78 |   where set = makeSet lst
79 |         count el lst = length (filter (\y -> y == el) lst)
80 | 
81 | -- Зад.8. - вариант с list comprehension за съставяне на всички двойки точки
82 | maxDistance :: [(Double,Double)] -> Double
83 | maxDistance points = maximum [ dist p1 p2 | p1<-points, p2<-points ]
84 |   where dist (x1,y1) (x2,y2) = sqrt ((x1-x2)^2 + (y1-y2)^2)
85 | 
86 | -- Зад.9 - безкраен списък от функции, всяка представляваща композиции на f, започвайки от 1
87 | -- вътрешно си дефинираме n-кратна композиция на функция.
88 | compositions :: (a -> a) -> [(a -> a)]          -- списък от функции, no big deal
89 | compositions f = [ composeN f i | i<-[1..] ]
90 |   where composeN :: (a -> a) -> Int -> (a -> a) -- можем да имаме сигнатури и за локално деф. ф-ции
91 |         composeN f 1 = f
92 |         composeN f n = f . (composeN f (n-1))
93 | 
94 | -- за ентусиастите:
95 | compositions' :: (a -> a) -> [(a -> a)]
96 | compositions' f = f : map (f.) (compositions' f)
97 | 


--------------------------------------------------------------------------------
/20170103-week12.hs:
--------------------------------------------------------------------------------
  1 | -- Зад.1.
  2 | sumProducts :: Num a => [[a]] -> a
  3 | sumProducts ll = sum (map product nonEmptyLists)
  4 |   where nonEmptyLists = filter (\lst -> not (null lst)) ll
  5 | 
  6 | -- Зад.2.
  7 | occurrences :: (Num a, Eq a) => [a] -> [a] -> [Int]
  8 | --occurrences lst1 lst2 = map (\x -> count x lst2) lst1
  9 | occurrences lst1 lst2 = [ count x lst2 | x<-lst1 ] -- същото като горния ред
 10 |   where count el lst = length (filter (\x -> x == el) lst)
 11 | 
 12 | -- Припомняне: транспониране на матрица
 13 | transpose :: [[a]] -> [[a]]
 14 | transpose m
 15 |   | null (head m) = [] -- в зависимост от обхождането "дъното" може да е и (null m)
 16 |   | otherwise     = (firstCol m) : transpose (removeFirstCol m)
 17 |   where firstCol m = map head m
 18 |         removeFirstCol m = map tail m
 19 | 
 20 | -- Зад.3.
 21 | mainDiag :: [[a]] -> [a]
 22 | mainDiag m
 23 |   | null m    = []
 24 |   | otherwise = (head (head m)) : mainDiag (tail (map tail m))
 25 | 
 26 | -- Зад.5.
 27 | sndDiag :: [[a]] -> [a]
 28 | sndDiag m = mainDiag (map reverse m)
 29 | -- sndDiag m = reverse (mainDiag (reverse m))
 30 | 
 31 | -- да проверим дали всички елементи в списък са равни помежду си
 32 | -- е като да проверим дали всички са равни на, например, първия елемент
 33 | allEqual :: (Num a, Eq a) => [a] -> Bool
 34 | allEqual lst = all (\x -> x == head lst) lst
 35 | -- естествено, ако говорим за числа, има и други начини
 36 | --allEqual lst = (minimum lst) == (maximum lst)
 37 | 
 38 | -- можем и с просто обхождане на списъка
 39 | allEqual2 [] = True
 40 | allEqual2 (_:[]) = True -- така pattern-match-ваме списък с точно 1 елемент
 41 | allEqual2 (x:y:rest)
 42 |   | x /= y    = False
 43 |   | otherwise = allEqual2 (y:rest)
 44 | 
 45 | -- Зад.4.
 46 | isSquare :: [[a]] -> Bool
 47 | isSquare m = allEqual (length m : map length m)
 48 | 
 49 | -- Зад.6.
 50 | matchLengths :: [[a]] -> Bool
 51 | matchLengths ll = allEqual (map length ll)
 52 | 
 53 | -- можем директно да сравняваме дали всички са "еквивалентни" на първия
 54 | -- но това ще преизчислява дължините при всяко сравнение!
 55 | matchLengths2 :: [[a]] -> Bool
 56 | matchLengths2 ll = all (\l -> length l == length (head ll)) ll
 57 | 
 58 | -- Зад.7.
 59 | -- Един подход при тези задачи е да "обхождаме" списъците подобно на merge
 60 | setUnion :: (Eq a, Ord a) => [a] -> [a] -> [a]
 61 | setUnion s1 [] = s1
 62 | setUnion [] s2 = s2
 63 | setUnion (x:xs) (y:ys)
 64 |   | x < y  = x : setUnion xs (y:ys)
 65 |   | x == y = x : setUnion xs ys
 66 |   | x > y  = y : setUnion (x:xs) ys
 67 | 
 68 | setIntersect s1 [] = []
 69 | setIntersect [] s2 = []
 70 | setIntersect (x:xs) (y:ys)
 71 |   | x < y  = setIntersect xs (y:ys)
 72 |   | x == y = x : setIntersect xs ys
 73 |   | x > y  = setIntersect (x:xs) ys
 74 | 
 75 | setDiff s1 [] = s1
 76 | setDiff [] s2 = []
 77 | setDiff (x:xs) (y:ys)
 78 |   | x < y  = x : setDiff xs (y:ys)
 79 |   | x == y = setDiff xs ys
 80 |   | x > y  = setDiff (x:xs) ys
 81 | 
 82 | setSymDiff s1 s2 = setUnion (setDiff s1 s2) (setDiff s2 s1)
 83 | 
 84 | -- а за някои функции можем просто да използваме filter или list comprehension
 85 | setIntersect2 s1 s2 = filter (\x -> x `elem` s2) s1
 86 | setDiff2 s1 s2 = filter (\x -> not (x `elem` s2)) s1
 87 | 
 88 | setIntersect3 s1 s2 = [ x | x<-s1, x `elem` s2]
 89 | setDiff3 s1 s2 = [ x | x<-s1, not x `elem` s2]
 90 | 
 91 | -- сортираща функция, която приема и функция за сравнение
 92 | quicksort :: (a -> a -> Bool) -> [a] -> [a]
 93 | quicksort _ [] = []
 94 | quicksort _ (x:[]) = [x]
 95 | --quicksort comp lst@(pivot:rest) =
 96 | --     quicksort comp (filter (\x -> p x pivot) rest)
 97 | --                 ++ (filter (\x -> not (p x pivot || p pivot x)) lst)
 98 | --  ++ quicksort comp (filter (\x -> p pivot x) rest)
 99 | -- по-красиво е с pattern matching
100 | quicksort comp lst@(pivot:rest) =
101 |        quicksort comp [ x | x<-rest, comp x pivot]
102 |                    ++ [ x | x<-lst, not (comp x pivot), not (comp pivot x)]
103 |     ++ quicksort comp [ x | x<-rest, comp pivot x]
104 | 
105 | -- обикновеното сортиране е просто с функцията (<)
106 | quicksort' lst = quicksort (<) lst
107 | -- пример за извикване със "специална" функция - да сравнява по последна цифра
108 | --quicksort (\ x y -> x `mod` 10 < y `mod` 10)
109 | 
110 | -- Зад.8.
111 | -- от списък с някакви елементи взимаме най-често срещания такъв.
112 | -- ако има няколко най-често срещани, взимаме най-големия.
113 | -- За тази задача ни е полезна функцията histogram:
114 | removeAll :: (Eq a) => a -> [a] -> [a]
115 | removeAll x l = filter (/=x) l
116 | 
117 | removeDuplicates :: (Eq a) => [a] -> [a]
118 | removeDuplicates [] = []
119 | removeDuplicates (x:xs) = x : removeDuplicates (removeAll x xs)
120 | 
121 | histogram :: (Eq a) => [a] -> [(a,Int)]
122 | histogram lst = map (\x -> (x,count x lst)) (removeDuplicates lst)
123 |   where count x lst = length (filter (==x) lst)
124 | 
125 | -- за да изчислим най-често срещания елемент можем да вземем
126 | -- хистограмата на списъка и да я сортираме по подходящ начин
127 | mostFrequent :: (Eq a, Ord a) => [a] -> a
128 | mostFrequent lst = fst (head sortedPairs)
129 |   where pairs = histogram lst
130 |         compPairs (x1,c1) (x2,c2) = c1 > c2 || (c1 == c2 && x1 > x2)
131 |         sortedPairs = quicksort compPairs pairs
132 | 
133 | -- Вариант 1: супер бавен, тъй като при всяко сравнение преизчислява mostFrequent
134 | -- но пък поне идеята на решението е ясна
135 | specialSort :: (Eq a, Ord a) => [[a]] -> [[a]]
136 | specialSort ll = quicksort (\x y -> mostFrequent x < mostFrequent y) ll
137 | 
138 | -- Вариант 2: веднъж изчисляваме за всеки x неговия mostFrequent,
139 | -- после ги "окомплектоваме" в наредени двойки. След това сортираме
140 | -- наредените двойки така, както искаме, и накрая от тях взимаме само
141 | -- първите елементи (т.е. оригиналните елементи на списъка)
142 | specialSort' :: (Eq a, Ord a) => [[a]] -> [[a]]
143 | specialSort' ll = map fst sortedPairs
144 |   where pairs = [ (x, mostFrequent x) | x<-ll ]
145 |         compPairs (_,c1) (_,c2) = c1 < c2
146 |         sortedPairs = quicksort compPairs pairs
147 | 


--------------------------------------------------------------------------------
/20170110-week13.hs:
--------------------------------------------------------------------------------
 1 | import Data.List -- за функциите за специална подредба minimumBy, maximumBy
 2 | 
 3 | -- Зад.1.
 4 | -- псевдоним на тип - можем да използваме Point навсякъде
 5 | -- вместо (Double, Double), както и обратното
 6 | type Point = (Double, Double)
 7 | 
 8 | points :: [Point]
 9 | points = [(-1.1, 1), (1.8, 2), (3, 1), (-1, -2)]
10 | 
11 | dist :: Point -> Point -> Double
12 | dist (x1,y1) (x2,y2) = sqrt $ (x1-x2)^2 + (y1-y2)^2
13 | 
14 | maxDistance :: [Point] -> Double
15 | maxDistance pts = maximum [ dist p1 p2 | p1<-pts, p2<-pts ]
16 | 
17 | -- бонус: да приемаме и функцията за разстояние като параметър
18 | maxDistanceBy :: (Point -> Point -> Double) -> [Point] -> Double
19 | maxDistanceBy f pts = maximum [ f p1 p2 | p1<-pts, p2<-pts]
20 | -- тогава maxDistance = maxDistanceBy dist
21 | 
22 | -- ако искаме да върнем не само най-голямото разстояние,
23 | -- ами и точките, между които е то: изграждаме списък (d,p1,p2)
24 | -- и му взимаме елемента с най-голяма стойност на първата позиция
25 | maxDistance1 :: [Point] -> (Double, Point, Point)
26 | maxDistance1 pts = maximumBy (\ p@(d1,_,_) q@(d2,_,_) -> compare d1 d2) [ (dist p1 p2, p1, p2) | p1<-pts, p2<-pts ]
27 | --                                                       ^^^^^^^^^^^^^
28 | 
29 | -- Зад.2.
30 | type Item = (String, Integer)
31 | items :: [Item]
32 | items = [("Milk",3), ("Bread",1), ("Yoghurt",-3),
33 |          ("Butter",5), ("Cheese",-1), ("Pasta",2)]
34 | 
35 | soonestExpiring :: [Item] -> String
36 | soonestExpiring its = fst $ minimumBy
37 |                           (\ i1 i2 -> compare (snd i1) (snd i2))
38 |                           [ i | i<-its, snd i >= 0] -- можем да заменим този ред с някое от по-долните:
39 | --                        filter (\i -> snd i >= 0) its
40 | --                        filter ((>=0) . snd) its
41 | --                        filter (\(_,d) -> d >= 0) its
42 | 
43 | numberExpiring :: [Item] -> Int
44 | numberExpiring its = length [ i | i<-its, (snd i) < 0]
45 | 
46 | longestExpired :: [Item] -> String
47 | longestExpired its = fst $ minimumBy
48 |                          (\ i1 i2 -> compare (snd i1) (snd i2))
49 |                          [ i | i<-its, snd i < 0 ]
50 | -- алтернатива:
51 | longestExpired1 :: [Item] -> String
52 | longestExpired1 = fst . minimumBy (\ i1 i2 -> compare (snd i1) (snd i2))
53 | 
54 | expiringItems its = (soonestExpiring its, numberExpiring its, longestExpired its)
55 | 
56 | ---------------------------------------------------------------------------------------------
57 | 
58 | -- създавайки типа NewPoint, трябва да указваме как конструираме обекти от този тип
59 | -- в случая "кръщаваме" конструктора с думичката Pair (можеше и да е друга, дори и NewPoint)
60 | data NewPoint = Pair Double Double
61 | 
62 | -- в такъв случай единственият начин да конструираме такива обекти
63 | -- е като извикаме този конструктор
64 | p1 :: NewPoint
65 | p1 = Pair 3 5
66 | 
67 | -- естествено, можем да извикваме този конструктор отвсякъде
68 | makePoint :: (Double, Double) -> NewPoint
69 | makePoint (x,y) = Pair x y
70 | --makePoint = uncurry Pair -- за ентусиастите
71 | 
72 | -- единственият начин, по който можем да достъпваме данните на тези обекти,
73 | -- е като pattern match-ваме начина, по който са конструирани
74 | -- например засега имаме само конструктора Pair, и по него "декомпозираме" обекта
75 | getX :: NewPoint -> Double
76 | getX (Pair x _) = x
77 | 
78 | getY :: NewPoint -> Double
79 | getY (Pair _ y) = y
80 | 
81 | -- pattern matching в други функции
82 | dist' :: NewPoint -> NewPoint -> Double
83 | dist' (Pair x1 y1) (Pair x2 y2) = sqrt $ (x1-x2)^2 + (y1-y2)^2
84 | 
85 | -- може и само с get-ъри - както е по-удобно
86 | dist1 :: NewPoint -> NewPoint -> Double
87 | dist1 p1 p2 = sqrt $ ((getX p1) - (getX p2))^2 + ((getY p1) - (getY p2))^2
88 | 
89 | -- сега можем да пренапишем и maxDistance за новия тип данни:
90 | -- първо конструираме списъка от точки по наредените двойки
91 | points' :: [NewPoint]
92 | points' = [ (Pair x y) | (x,y)<-points]
93 | 
94 | -- на практика същия код, но работим с друг тип и друга функция за разстояние
95 | maxDistance' :: [NewPoint] -> Double
96 | maxDistance' pts = maximum [ dist' p1 p2 | p1<-pts, p2<-pts ]
97 | 


--------------------------------------------------------------------------------
/20170117-week14.hs:
--------------------------------------------------------------------------------
  1 | -- Двоично дърво с цели числа във върховете
  2 | data IntTree = Empty | Node Int IntTree IntTree deriving Show
  3 | 
  4 | -- Дърво с произволен брой наследници (в списък) и цели числа във върховете
  5 | data VarTree = Empty' | Node' Int [VarTree]
  6 | 
  7 | vt :: VarTree
  8 | vt = Node' 5 [(Node' 2 []), Empty', (Node' 3 []), (Node' 4 []), (Node' 5 [])]
  9 | 
 10 | -- най-често при работата с такова дърво map-ваме нещо над всички
 11 | -- наследници на възела, и акумулираме получения списък със стойности
 12 | treeSum' :: VarTree -> Int
 13 | treeSum' Empty' = 0
 14 | treeSum' (Node' val children) = val + sum (map treeSum' children)
 15 | 
 16 | -- Втори вариант за представяне: 
 17 | data VarTree2 = Leaf Int | VNode Int [VarTree2]
 18 | 
 19 | vt2 :: VarTree2
 20 | vt2 = VNode 5 [Leaf 2, Leaf 3, Leaf 4, Leaf 5]
 21 | -- стандартни рекурсивни функции
 22 | -- много по-лесно се пишат и разбират, когато се
 23 | -- възползваме от pattern matching за конструкторите на дървото
 24 | -- в случая Empty символизира празното дърво, но на практика е конструктор (без аргументи)
 25 | treeSize :: IntTree -> Int
 26 | treeSize Empty = 0
 27 | treeSize (Node _ lt rt) = 1 + treeSize lt + treeSize rt
 28 | 
 29 | treeSum :: IntTree -> Int
 30 | treeSum Empty = 0
 31 | treeSum (Node val lt rt) = val + treeSum lt + treeSum rt
 32 | 
 33 | isEmpty :: IntTree -> Bool
 34 | isEmpty Empty = True
 35 | isEmpty _ = False
 36 | 
 37 | -- лош стил на програмиране - налага използването на други функции,
 38 | -- които не са способни да обработват всички "случаи" за дървета -> ЛОШО
 39 | --treeSum2 :: IntTree -> Int
 40 | --treeSum2 t = if isEmpty t then 0 else getValue t + ...
 41 | 
 42 | getValue :: IntTree -> Int
 43 | getValue Empty = 0 -- понеже функцията за сумиране разчита на тази!
 44 | getValue (Node val _ _) = val
 45 | 
 46 | -- за удобство
 47 | makeLeaf :: Int -> IntTree
 48 | makeLeaf x = Node x Empty Empty
 49 | 
 50 | testT1 :: IntTree
 51 | testT1 = Node 5 (Node 3 Empty
 52 |                         (makeLeaf 1))
 53 |                 (makeLeaf 2)
 54 | 
 55 | -- задачката от контролното - O(n^2)
 56 | transformSum :: IntTree -> IntTree
 57 | transformSum Empty = Empty
 58 | transformSum t@(Node val lt rt) = Node (treeSum t)
 59 |                                        (transformSum lt)
 60 |                                        (transformSum rt)
 61 | 
 62 | -- O(n): предварително "генерираме" лявото и дясното поддърво, и от тях
 63 | -- "извличаме" стойността в корените им - така не преизчисляваме нищо
 64 | -- по повече от веднъж и функцията е очевидно линейна
 65 | transformSum' :: IntTree -> IntTree
 66 | transformSum' Empty = Empty
 67 | transformSum' (Node val lt rt) = Node (val + leftsum + rightsum)
 68 |                                       lefttree
 69 |                                       righttree
 70 |   where lefttree = transformSum' lt
 71 |         righttree = transformSum' rt
 72 |         leftsum = getValue lefttree
 73 |         rightsum = getValue righttree
 74 | 
 75 | -- Зад.1.
 76 | maxSumPath :: IntTree -> Int
 77 | maxSumPath Empty = 0
 78 | maxSumPath (Node val lt rt) = val + max (maxSumPath lt) (maxSumPath rt)
 79 | 
 80 | -- Зад.2.
 81 | prune :: IntTree -> IntTree
 82 | prune Empty = Empty
 83 | prune (Node _ Empty Empty) = Empty
 84 | prune (Node val lt rt)     = (Node val (prune lt) (prune rt))
 85 | 
 86 | -- Зад.3.
 87 | bloom :: IntTree -> IntTree
 88 | bloom Empty = Empty
 89 | bloom (Node val Empty Empty) = (Node val (makeLeaf val) (makeLeaf val))
 90 | bloom (Node val lt rt)       = (Node val (bloom lt) (bloom rt))
 91 | 
 92 | -- Дърво, което съдържа произволни стойности по върховете - 
 93 | -- приема съдържания тип като параметър подобно на C++.
 94 | -- Оттам нататък винаги дървото върви с типа си - не пишем BST,
 95 | -- както на пишем std::vector, ами "BST a", "BST Int" като
 96 | -- "std::vector<T>" и "std::vector<int>".
 97 | data BST a = BSTEmpty | BSTNode a (BST a) (BST a) deriving Show
 98 | 
 99 | -- Зад.4.
100 | bstsize :: BST a -> Integer
101 | bstsize BSTEmpty = 0
102 | bstsize (BSTNode _ lt rt) = 1 + bstsize lt + bstsize rt
103 | 
104 | bstinsert :: (Eq a, Ord a) => a -> BST a -> BST a
105 | bstinsert x BSTEmpty = BSTNode x BSTEmpty BSTEmpty
106 | bstinsert x t@(BSTNode val lt rt)
107 |   | x == val  = t
108 |   | x < val   = (BSTNode val (bstinsert x lt) rt)
109 |   | otherwise = (BSTNode val lt (bstinsert x rt))
110 | 
111 | bstsearch :: (Eq a, Ord a) => a -> BST a -> Bool
112 | bstsearch _ BSTEmpty = False
113 | bstsearch x (BSTNode val lt rt)
114 |   | x == val  = True
115 |   | x < val   = bstsearch x lt
116 |   | otherwise = bstsearch x rt
117 | 
118 | bstFromList :: (Eq a, Ord a) => [a] -> BST a
119 | bstFromList = foldr bstinsert BSTEmpty
120 | -- bstFromList lst = foldr bstinsert BSTEmpty lst
121 | -- bstFromList lst = foldl (flip bstinsert) BSTEmpty lst
122 | 
123 | testBST :: BST Int
124 | testBST = bstFromList [5,3,6,2,4,8,7,1]
125 | 
126 | -- забележете - тази функция няма ограничения за съдържания тип!
127 | values :: BST a -> [a]
128 | values BSTEmpty = []
129 | values (BSTNode val lt rt) = values lt ++ [val] ++ values rt
130 | 
131 | bstSort :: (Eq a, Ord a) => [a] -> [a]
132 | bstSort = values . bstFromList
133 | -- bstSort lst = values $ bstFromList lst
134 | 
135 | -- Зад.5.
136 | -- нашият map отново ще представлява дърво, съдържащо наредени двойки
137 | data Map k v = MEmpty | MNode (k,v) (Map k v) (Map k v)
138 | 
139 | mapinsert :: (Eq k, Ord k) => k -> v -> Map k v -> Map k v
140 | mapinsert key val MEmpty = (MNode (key,val) MEmpty MEmpty)
141 | mapinsert key val (MNode p@(k1,_) lt rt)
142 |   | key == k1 = (MNode (k1,val) lt rt) -- заместваме старата с новата стойност
143 |   | key < k1  = (MNode p (mapinsert key val lt) rt)
144 |   | otherwise = (MNode p lt (mapinsert key val rt))
145 | 
146 | mapsearch :: (Eq k, Ord k) => k -> Map k v -> Maybe v
147 | mapsearch _ MEmpty = Nothing
148 | mapsearch key (MNode p@(k1,val) lt rt)
149 |   | key == k1 = Just val
150 |   | key < k1  = mapsearch key lt
151 |   | otherwise = mapsearch key rt
152 | 
153 | mapFromList :: (Eq k, Ord k) => [(k,v)] -> Map k v
154 | mapFromList = foldr (uncurry mapinsert) MEmpty           -- lol
155 | -- mapFromList = foldl (flip $ uncurry mapinsert) MEmpty -- loool
156 | -- mapFromList lst = foldr (\(key,val) m -> mapinsert key val m) MEmpty lst 
157 | 
158 | mapvalues :: Map k v -> [(k,v)]
159 | mapvalues MEmpty = []
160 | mapvalues (MNode p lt rt) = mapvalues lt ++ [p] ++ mapvalues rt
161 | 


--------------------------------------------------------------------------------
/README.md:
--------------------------------------------------------------------------------
1 | # Функционално програмиране, Инф3, 2гр.
2 | Тук можете да намерите кода от упражненията по ФП на Инф3, 2 група, зимен семестър 2016-2017.
3 | 


--------------------------------------------------------------------------------
/exam2016solutions.hs:
--------------------------------------------------------------------------------
  1 | import Data.List (maximumBy, delete)
  2 | import Data.Ord (comparing)
  3 | 
  4 | -- полезни функции и за двата варианта
  5 | transpose :: [[a]] -> [[a]]
  6 | transpose m = [ map (!!i) m | i<-[0..l]]
  7 |   where l = length (head m) - 1 -- pred . length . head $ m -- point-free, care-free
  8 | 
  9 | -- стандартни...
 10 | type Graph = [[Int]]
 11 | vertices :: Graph -> [Int]
 12 | vertices = map head
 13 | neighbours :: Int -> Graph -> [Int]
 14 | neighbours v g = tail $ head [ l | l<-g, (head l) == v ]
 15 | 
 16 | -- най-дълъг списък измежду списък от списъци
 17 | maxLength :: [[Int]] -> [Int]
 18 | maxLength = maximumBy $ comparing length
 19 | 
 20 | -- генериране на всички пътища в граф (!)
 21 | allPaths :: Graph -> [[Int]]
 22 | allPaths g = concat [ allPathsStartingWith [v] g | v<-(vertices g) ]
 23 | 
 24 | allPathsStartingWith :: [Int] -> Graph -> [[Int]]
 25 | allPathsStartingWith path g = path : concat [ allPathsStartingWith newPath g | newPath<-allExpansions]
 26 |   where allExpansions = [ path ++ [u] | u<-(vertices g), not $ u `elem` path, u `elem` (neighbours (last path) g) ]
 27 | 
 28 | ------ Вар.А ------
 29 | -- Зад.1
 30 | findColumns :: Eq a => [[a]] -> Int
 31 | findColumns m = length [ col | col<-(transpose m), allInSomeRow col m ]
 32 |     -- дали за някой елемент на m (т.е. ред) е вярно, че всички елементи на lst (някоя колона) са в него
 33 |     where allInSomeRow :: Eq a => [a] -> [[a]] -> Bool
 34 |           allInSomeRow lst m = any (\row -> all (`elem` row) lst) m
 35 | 
 36 | -- Зад.2
 37 | -- сигнатурата не е необходима, но би трябвало да изглежда така:
 38 | combine :: (a -> b) -> (a -> c) -> (b -> c -> d) -> (a -> d)
 39 | combine f g h = \x -> h (f x) (g x)
 40 | 
 41 | -- дали за някои f,g,h от респективните им списъци и някое ff от uns е вярно, че "съвпадат"
 42 | -- където "съвпадението" се проверява от отделна помощна малка функция
 43 | check :: Int -> Int -> [(Int -> Int)] -> [(Int -> Int -> Int)] -> Bool
 44 | check a b uns bins = any id [ matches (combine f g h) ff [a..b] | f<-uns, g<-uns, h<-bins, ff<-uns ]
 45 |   where matches f1 f2 range = all (\x -> f1 x == f2 x) range
 46 | 
 47 | -- Зад.3
 48 | type Plant = (String,Int,Int)
 49 | plName :: Plant -> String
 50 | plName (n,_,_) = n
 51 | plMin :: Plant -> Int
 52 | plMin (_,m,_) = m
 53 | plMax :: Plant -> Int
 54 | plMax (_,_,m) = m
 55 | 
 56 | -- връща наредена двойка от търсения интервал и имената на растенията
 57 | -- идея: първо генерираме всички възможни интервали,
 58 | -- после за всеки съставяме списък от имената на растенията, които виреят в него,
 59 | -- и най-накрая на този списък взимаме максималния елемент по дължината на списъка с имена
 60 | garden :: [Plant] -> ((Int,Int),[String])
 61 | garden plants = maximumBy (comparing $ length . snd) [ (int, getNames int plants) | int<-allIntervals ]
 62 |   where allIntervals = [(minT,maxT) | minT<-(map plMin plants), maxT<-(map plMax plants), minT<maxT ]
 63 |         getNames int plants = [ plName p | p<-plants, growsIn int p ]
 64 |         growsIn (minT,maxT) (_,pMin,pMax) = pMin<=minT && maxT<=pMax
 65 | 
 66 | -- Зад.4
 67 | testGraph1 :: Graph
 68 | testGraph1 = [[1,2,4],[2,3],[3,2],[4]]
 69 | 
 70 | maxPath :: Graph -> Int -> [Int]
 71 | maxPath g v = maxPathHelper [v] (delete v (vertices g)) g
 72 | 
 73 | maxPathHelper :: [Int] -> [Int] -> Graph -> [Int]
 74 | maxPathHelper path unmarked g = if null possibles then path else maxLength possibles
 75 |   where possibles = [ maxPathHelper (expand path u) (delete u unmarked) g | u<-unmarked, canBeExpanded path u ]
 76 |         expand path u = path ++ [u]
 77 |         canBeExpanded path u = u `elem` (neighbours (last path) g)
 78 | 
 79 | -- Алтернативно решение - генерираме всички пътища (вж. най-горе) и взимаме най-дългия:
 80 | -- maxPath g v = maxLength [ p | p<-allPaths g, v == head p ]
 81 | 
 82 | 
 83 | ------ Вар.2 ------
 84 | -- If you're having FP problems I feel bad for you, son
 85 | -- I got 2 exam variants, and that's the toughest one
 86 | 
 87 | -- Зад.1
 88 | hasColumn :: Eq a => [[a]] -> Bool
 89 | hasColumn m = any id [ allInAllRows col m | col<-(transpose m)]
 90 |   -- дали за всеки елемент на m (т.е. ред) е вярно, че всички елементи на lst (някоя колона) са в него
 91 |     where allInAllRows :: Eq a => [a] -> [[a]] -> Bool
 92 |           allInAllRows lst m = all (\row -> all (`elem` row) lst) m
 93 | 
 94 | -- Зад.2
 95 | -- сигнатурата не е необходима, но би трябвало да изглежда така:
 96 | --combine' :: (a -> b) -> (a -> c) -> (b -> c -> d) -> (a -> d)
 97 | combine' :: (a -> c -> d) -> (a -> b -> c) -> (a -> b) -> (a -> d)
 98 | combine' f g h = \x -> f x (g x (h x))
 99 | 
100 | -- дали за някои f,g,h от респективните им списъци и някое ff от uns е вярно, че "съвпадат"
101 | -- където "съвпадението" се проверява от отделна помощна малка функция
102 | check' :: Int -> Int -> [(Int -> Int)] -> [(Int -> Int -> Int)] -> Bool
103 | check' a b uns bins = any id [ matches (combine' f g h) ff [a..b] | f<-bins, g<-bins, h<-uns, ff<-uns ]
104 |   where matches f1 f2 range = all (\x -> f1 x == f2 x) range
105 | 
106 | -- Зад.3
107 | type Play = (String,Int,Int)
108 | -- ще преизползваме plName от Plant типа: plName :: Play -> String; plName (n,_,_) = n
109 | plStart :: Play -> Int
110 | plStart (_,t,_) = t
111 | plTime :: Play -> Int
112 | plTime (_,_,t) = t
113 | 
114 | showtime :: [Play] -> ((Int,Int),[String])
115 | showtime plays = maximumBy (comparing $ length . snd) [ (int, getNames int plays) | int<-allIntervals ]
116 |   where allIntervals = [(i,i+1) | i<-[0..23]]
117 |         getNames int plays = [ plName p | p<-plays, playsIn int p]
118 |         playsIn (start,end) (_,pStart,pTime) = pStart<=start && end<=pStart+(pTime`div`60)
119 | 
120 | -- Зад.4
121 | testGraph2 :: Graph
122 | testGraph2 = [[1,2],[2,3],[3,1,4],[4,2]]
123 | 
124 | maxCycle :: Graph -> Int -> [Int]
125 | maxCycle g v = maxLength [ p++[v] | p<-allPaths g, v == head p, v `elem` (neighbours (last p) g) ]
126 | 
127 | -- iei


--------------------------------------------------------------------------------
/exam2017solutions.hs:
--------------------------------------------------------------------------------
  1 | import Data.List (minimumBy, maximumBy, nub)
  2 | import Data.Ord (comparing)
  3 | 
  4 | -- и за двата варианта: в решенията се използва на няколко места функцията nub,
  5 | -- която премахва повторенията в даден списък. Ако не знаете, че тя е библиотечна,
  6 | -- винаги бихте могли да се я имплементирали сами по следния начин:
  7 | nub' :: Eq a => [a] -> [a]
  8 | nub' [] = []
  9 | nub' (x:xs) = x : nub' (filter (/=x) xs)
 10 | 
 11 | -- и за двата варианта: стандартно шаблонно двоично дърво
 12 | data Tree a = Empty | Node a (Tree a) (Tree a)
 13 | -- не е необходимо, но помага: pretty-printing на дърво
 14 | instance Show a => Show (Tree a) where
 15 |   show = showHelper 0
 16 |     where showHelper pad Empty = replicate pad ' ' ++ "#\n"
 17 |           showHelper pad (Node x lt rt) = showHelper (pad+4) lt
 18 |                                        ++ replicate pad ' ' ++ show x ++ "\n"
 19 |                                        ++ showHelper (pad+4) rt
 20 | 
 21 | testTree :: Tree Int
 22 | testTree = Node 5
 23 |                 (Node 3
 24 |                       (Node 1
 25 |                             Empty
 26 |                             (Node 2 Empty Empty))
 27 |                       (Node 4 Empty Empty))
 28 |                 (Node 6 Empty Empty)
 29 | 
 30 | {----- Вар.А -----}
 31 | -- Зад.1
 32 | longestInterval :: Eq a => (Int -> a) -> (Int -> a) -> Int -> Int -> (Int, Int)
 33 | longestInterval f g a b = maximumBy (comparing (\(a,b) -> b-a)) [ i | i<-allIntervals, everywhereMatch f g i]
 34 |   where allIntervals = [(from,to) | from<-[a..b], to<-[from..b]]
 35 |         everywhereMatch f g (from,to) = null [ x | x<-[from..to], f x /= g x ]
 36 | 
 37 | -- Бонус решение на Зад.1, което работи коректно и когато няма такива интервали
 38 | longestInterval' :: Eq a => (Int -> a) -> (Int -> a) -> Int -> Int -> Maybe (Int, Int)
 39 | longestInterval' f g a b = if null intervals
 40 |                            then Nothing
 41 |                            else Just $ maximumBy (comparing (\(a,b) -> b-a)) intervals
 42 |   where allIntervals = [(from,to) | from<-[a..b], to<-[from..b]]
 43 |         everywhereMatch f g (from,to) = null [ x | x<-[from..to], f x /= g x ]
 44 |         intervals = [ i | i<-allIntervals, everywhereMatch f g i]
 45 | 
 46 | -- Зад.2
 47 | -- помощни функцийки
 48 | min3 a b c = min a (min b c)
 49 | max3 a b c = max a (max b c)
 50 | 
 51 | -- най-малкият интервал, съдържащ всички стойности, очевидно е между най-малката и най-голямата стойност в дървото
 52 | intervalTree :: Tree Int -> Tree (Int, Int)
 53 | intervalTree Empty = Empty
 54 | intervalTree tr@(Node _ left right) = Node (findMin tr, findMax tr)
 55 |                                            (intervalTree left)
 56 |                                            (intervalTree right)
 57 |   where findMin Empty = maxBound -- можем да използваме най-малката валидна стойност, без да попречи на коректността
 58 |         findMin (Node val left right) = min3 val (findMin left) (findMin right)
 59 |         findMax Empty = minBound
 60 |         findMax (Node val left right) = max3 val (findMax left) (findMax right)
 61 | 
 62 | -- Бонус: отново първо генерираме трансформираните поддървета, и от тях "изваждаме" необходимата информация за цялото дърво.
 63 | intervalTree' :: Tree Int -> Tree (Int, Int)
 64 | intervalTree' Empty = Empty
 65 | intervalTree' tr@(Node val left right) = Node (min3 val minLeft minRight, max3 val maxLeft maxRight)
 66 |                                               newLeftTree
 67 |                                               newRightTree
 68 |   where newLeftTree = intervalTree' left
 69 |         newRightTree = intervalTree' right
 70 |         (minLeft, maxLeft) = case newLeftTree of Empty -> (maxBound,minBound) -- забележете "обърнатите" стойности
 71 |                                                  (Node (a,b) _ _) -> (a,b)
 72 |         (minRight, maxRight) = case newRightTree of Empty -> (maxBound, minBound)
 73 |                                                     (Node (a,b) _ _) -> (a,b)
 74 | 
 75 | -- Зад.3
 76 | -- бързо за написване решение, но с малка уловка: Забележете, че b стига само до a и не го надхвърля;
 77 | -- ако беше a<-[1..], b<-[1..], тогава а никога няма да достигне 2 и няма да се генерират всички числа!
 78 | -- Накрая, функцията nub премахва повторенията:
 79 | sumOfSquares1 :: [Int]
 80 | sumOfSquares1 = nub [ a^2 + b^2 | a<-[1..], b<-[1..a] ]
 81 | 
 82 | -- а може и с просто филтриране (но работи доооста по-бавно):
 83 | sumOfSquares2 :: [Int]
 84 | sumOfSquares2 = [ n | n<-[1..], isRepr n ]
 85 |   where isRepr n = not $ null [ (a,b) | a<-[1..n], b<-[1..a], a^2+b^2==n ]
 86 | 
 87 | -- Зад.4
 88 | -- След като изчислим отделно средната дължина, можем първо да филтрираме тези клипове,
 89 | -- които са по-къси от средното, след което да вземем името на този с минимална разлика
 90 | -- между неговото време и средното. fromIntegral се използва навсякъде при работа с
 91 | -- цели и дробни числа, тъй като самото средно може да не е цяло число.
 92 | averageVideo :: [(String,Int)] -> String
 93 | averageVideo vids = fst $ minimumBy (comparing (\(_,v) -> (fromIntegral v) - avg))
 94 |                         $ filter ((<avg) . fromIntegral . snd) vids -- (\(_,v) -> fromIntegral v < avg)
 95 |   where avg = fromIntegral (sum $ map snd vids) / fromIntegral (length vids)
 96 | 
 97 | {----- Вар.Б -----}
 98 | -- Зад.1
 99 | equalityTest :: Eq a => (Int -> a) -> (Int -> a) -> Int -> Int -> Int
100 | equalityTest f g a b = length [ i | i<-allIntervals, nowhereMatch f g i]
101 |   where allIntervals = [(from,to) | from<-[a..b], to<-[from..b]]
102 |         nowhereMatch f g (from,to) = null [ x | x<-[from..to], f x == g x ]
103 | 
104 | -- Зад.2
105 | -- На практика задачата е идентична на тази от вариант А, макар и с променено условие. Така че:
106 | pairTree :: Tree Int -> Tree (Int, Int)
107 | pairTree = intervalTree
108 | 
109 | -- и бонуса, естествено:
110 | pairTree' :: Tree Int -> Tree (Int, Int)
111 | pairTree' = intervalTree'
112 | 
113 | -- Зад.3: вж. коментарите на зад.3 във вариант А
114 | sumOfCubes1 :: [Int]
115 | sumOfCubes1 = nub [ a^3 + b^3 | a<-[1..], b<-[1..a] ]
116 | 
117 | -- а може и с просто филтриране (но работи доооста по-бавно):
118 | sumOfCubes2 :: [Int]
119 | sumOfCubes2 = [ n | n<-[1..], isRepr n ]
120 |   where isRepr n = not $ null [ (a,b) | a<-[1..n], b<-[1..a], a^3+b^3==n ]
121 | 
122 | -- Зад.4
123 | -- Тук е полезно първо да генерираме списъка с всички различни модели на обувки,
124 | -- след което от този списък да вземем името, за което броя различни модели е най-голям.
125 | -- Това изчисление на брой различни модели е най-удобно да се изнесе също във външна функция.
126 | bestRange :: [(String, Int)] -> String
127 | bestRange shoes = maximumBy (comparing getSizes) allNames
128 |   where allNames = nub $ map fst shoes -- всички имена
129 |         getSizes n = length $ nub $ filter ((==n) . fst) shoes -- брой различни размери за дадено име n 


--------------------------------------------------------------------------------
/hw1solutions.hs:
--------------------------------------------------------------------------------
 1 | import Data.List (maximumBy, delete)
 2 | import Data.Ord (comparing)
 3 | 
 4 | -- Зад.1
 5 | hailstone :: Int -> [Int]
 6 | hailstone 1 = [1]
 7 | hailstone n = n : hailstone (if even n then n `div` 2 else 3*n + 1)
 8 | 
 9 | -- Зад.2
10 | prime :: Int -> Bool
11 | prime 1 = False
12 | prime n = null [ d | d<-[2..sqn], (n `mod` d) == 0]
13 |   where sqn = floor . sqrt . fromIntegral $ n
14 | 
15 | primes :: [Int]
16 | primes = filter prime [1..]
17 | 
18 | isNotRepr :: Int -> Bool
19 | isNotRepr n = null [ n | a<-[1..n], b<-[1..(n-a)], prime a, n == a + 2*b*b ]
20 | 
21 | result = length [ n | n<-[10..99], odd n, not $ prime n, isNotRepr n]
22 | 
23 | -- Зад.3
24 | divisors :: Int -> [(Int,Int)]
25 | divisors = combinePairs . allDivs
26 | 
27 | -- функция, която връща гол списък от всички делители: allDivs 120 -> [2,2,2,3,5]
28 | allDivs 1 = []
29 | allDivs n = first : allDivs (n `div` first)
30 |   where first = head $ filter (((==0) . (n `mod`))) primes -- point-free, care-free
31 | 
32 | combinePairs [] = []
33 | combinePairs lst = (head lst, length firsts) : combinePairs rest
34 |   where (firsts,rest) = span (== head lst) lst
35 | 
36 | -- Зад.4
37 | intercalate' :: [a] -> [[a]] -> [a]
38 | intercalate' _ [] = []
39 | intercalate' _ (x:[]) = x
40 | intercalate' m (x:xs) = x ++ m ++ intercalate' m xs
41 | 
42 | -- Зад.5
43 | -- Можем да си позволим да съдържаме стойности и в листата
44 | data Tree = Leaf Int | Node Int Tree Tree
45 | 
46 | getValue :: Tree -> Int
47 | getValue (Leaf x) = x
48 | getValue (Node x _ _) = x
49 | 
50 | -- pretty-print: или как да включим типа Tree в typeclass-а Show
51 | instance Show Tree where
52 |   --show (Leaf x) = "{" ++ show x ++ "}"
53 |   --show (Node x lt rt) = "{" ++ show x ++ " " ++ show lt ++ " " ++ show rt ++"}"
54 |   show = showHelper 0
55 |     where showHelper pad (Leaf x) = replicate pad ' ' ++ show x ++ "\n"
56 |           showHelper pad (Node x lt rt) = showHelper (pad+4) lt
57 |                                        ++ replicate pad ' ' ++ show x ++ "\n"
58 |                                        ++ showHelper (pad+4) rt
59 | 
60 | -- първо превръщаме списъка от числа в списък от листа, който списък
61 | -- после обединяваме по двойки докато не остане с 1 елемент
62 | fenwick :: [Int] -> Tree
63 | fenwick lst = helper . map Leaf $ lst
64 | 
65 | helper :: [Tree] -> Tree
66 | helper (t:[]) = t
67 | helper lst = helper (makePairs lst)
68 |   where makePairs [] = []
69 |         makePairs (x:y:rest) = (Node (getValue x + getValue y) x y) : makePairs rest
70 | 
71 | -- Зад.6
72 | -- Две малки помощни функции, които значително помагат за четимостта на кода по-долу
73 | glue :: String -> String -> String
74 | glue s1 s2 = s1 ++ tail s2
75 | 
76 | isGlueable :: String -> String -> Bool
77 | isGlueable s1 s2 = last s1 == head s2
78 | 
79 | -- За удобство - взимане на най-дълга дума измежду списък
80 | maxLength :: [String] -> String
81 | maxLength = maximumBy $ comparing length
82 | 
83 | -- Най-дългата възможна дума все трябва да започва с някоя от думите в words (ако има такива)...
84 | longestWord :: [String] -> String
85 | longestWord [] = ""
86 | longestWord words = maxLength [ longestStartingWith w (delete w words) | w<-words ]
87 | 
88 | -- На всяка стъпка гледаме каква е най-дългата досега залепена дума, както и множеството от
89 | -- "останалите" думи. Тогава първо проверяваме възможно ли е текущата дума да бъде разширена:
90 | -- ако няма накъде да я разширим дори с една думичка, връщаме самата нея, а ако е възможно - 
91 | -- измежду всички възможности за разширение (изчислени рекурсивно надолу) избираме най-дългата.
92 | -- Естествено, при рекурсивното извикване премахваме слепената думичка w от кандидатите (един вид,
93 | -- маркираме я като използвана).
94 | -- Тази е на практика задача за най-дълъг път в граф.
95 | longestStartingWith :: String -> [String] -> String
96 | longestStartingWith start words = if null possibles then start else maxLength possibles
97 |   where possibles = [ longestStartingWith (glue start w) (delete w words) | w<-words, isGlueable start w ]
98 | 


--------------------------------------------------------------------------------
/kontr2solutions.hs:
--------------------------------------------------------------------------------
  1 | import Data.List
  2 | 
  3 | type Point = (Double, Double)
  4 | 
  5 | points :: [Point]
  6 | points = [(2,8),(-2,4),(1,2),(-4,-1),(5,0)]
  7 | 
  8 | -- Зад.1 - Варианти А и Б
  9 | -- Първа стъпка - функция, която изчислява разстоянието между две точки (на квадрат)
 10 | dist :: Point -> Point -> Double
 11 | dist (x1,y1) (x2,y2) = (x1-x2)^2 + (y1-y2)^2
 12 | 
 13 | -- Втора стъпка - за дадена точка да изчислим търсената сума от кв. на разст. до останалите
 14 | sumDists :: Point -> [Point] -> Double
 15 | sumDists p pts = sum $ map (dist p) pts
 16 | 
 17 | -- след като можем на всяка точка да съпоставяме тази сума, оттук нататък задачата
 18 | -- се свежда до търсенето на минимум/максимум по специален начин в списък - начини много
 19 | findMedoid :: [Point] -> Point
 20 | findMedoid pts = minimumBy (comparing (\p -> sumDists p pts)) pts
 21 | 
 22 | -- (грозна) алтернатива - просто линейно обхождане
 23 | -- (на всяка стъпка трябва да помним и пълния списък с точки)
 24 | --findMedoid pts = helper (head pts) (tail pts) pts
 25 | --  where helper currMin [] _ = currMin
 26 | --        helper currMin (x:rest) allPts
 27 | --          | sumDists x allPts < sumDists currMin allPts = helper x rest allPts
 28 | --          | otherwise                                   = helper currMin rest allPts
 29 | 
 30 | -- аналогични решения и за другия вариант
 31 | findPoint :: [Point] -> Point
 32 | findPoint pts = maximumBy (comparing (\p -> sumDists p pts)) pts
 33 | 
 34 | -- Зад.2 - Вариант А
 35 | -- за всеки k,n изчисляваме i-тата позиция в потока чрез предишните няколко
 36 | -- бавно, неефективно, малко неинтуитивно, но при внимателно индексиране - работещо
 37 | sumLast :: Integer -> Integer -> [Integer]
 38 | sumLast k n = map (\i -> fn k n i) [1..]
 39 |   where fn k _ 1 = k -- първото число е k, независимо от колко "назад" търсим
 40 |         fn k n i = sum [ fn k n j | j<-[(max 1 i-n)..(i-1)] ] -- за да избегнем отрицателни индекси
 41 | 
 42 | -- идея - първо изчисляваме първите n елемента на потока,
 43 | -- след което за всяка следваща позиция пазим "прозореца"
 44 | -- от предишните n стойности. За този прозорец изчисляваме сумата,
 45 | -- добавяме в резултата и после преместваме прозореца.
 46 | sumLast2 :: Integer -> Integer -> [Integer]
 47 | sumLast2 k n = prefix ++ (helper prefix)
 48 |   where helper window = let currSum = sum window
 49 |                         in currSum : helper ((tail window) ++ [currSum])
 50 |         -- с малко съображение виждаме, че първите n числа са последователни
 51 |         -- степени на двойката, умножени по k.
 52 |         prefix = k : map ((k*).(2^)) [0..n-2]
 53 | 
 54 | -- мисля, че вариант Б е очевидно аналогичен - заместете sum с product навсякъде
 55 | 
 56 | -- Зад.3. - Варианти А и Б
 57 | -- Припомняне - ориентиран граф съдържа ойлеров цикъл т.с.т.к. всички върхове
 58 | -- са с равни входящи и изходящи полустепени. Ойлеров път се съдържа ако всички
 59 | -- върхове без два са с равни полустепени, точно за един полустепента на входа
 60 | -- е с 1 повече от тази на изхода, и за точно един важи обратното (sink&source)
 61 | -- Всеки такъв цикъл или път (ако съществува) минава през всички върхове, тоест
 62 | -- търсим просто сумата на теглата във върховете.
 63 | -- Очевидно е НАЙ-удобно за всеки връх да намерим тези полустепени и да "търсим" в тях.
 64 | -- Ако намерим такъв цикъл/път, чак тогава връщаме сумата
 65 | type Graph = [(Char,Int,[Char])]
 66 | g :: Graph
 67 | g = [('a', 2, "bc"),
 68 |      ('b', 4, "ac"),
 69 |      ('c', 1, "ab")]
 70 | 
 71 | -- да живее list comprehension
 72 | outDeg :: Char -> Graph -> Int
 73 | outDeg u g = head [ length nbs | (v,_,nbs)<-g, u==v] -- "филтрираме" графа
 74 | 
 75 | inDeg :: Char -> Graph -> Int
 76 | inDeg u g = length [ (v,w,nbs) | (v,w,nbs)<-g, elem u nbs] -- всички върхове v, за които u е съсед
 77 | 
 78 | -- за всеки връх - наредени двойки от полустепените
 79 | insOuts :: Graph -> [(Int,Int)]
 80 | insOuts g = [ (inDeg u g, outDeg u g) | (u,_,_)<-g ]
 81 | 
 82 | sumWeights :: Graph -> Int
 83 | sumWeights g = sum [ w | (_,w,_)<-g ]
 84 | 
 85 | -- една лесна проверка
 86 | hasEulerCycle :: Graph -> Bool
 87 | hasEulerCycle g = all (\(i,o) -> i == o) degrees
 88 |   where degrees = insOuts g
 89 | 
 90 | -- 3 лесни проверки
 91 | hasEulerPath :: Graph -> Bool
 92 | hasEulerPath g = length [ (i,o) | (i,o)<-degrees, i /= o] == 2  -- точно два върха с различни in/out
 93 |               && length [ (i,o) | (i,o)<-degrees, i == o+1] == 1 -- точно един с in=out+1
 94 |               && length [ (i,o) | (i,o)<-degrees, i == o-1] == 1 -- точно един с in=out-1
 95 |   where degrees = insOuts g
 96 | 
 97 | eulerCycleCost :: Graph -> Int
 98 | eulerCycleCost g = if hasEulerCycle g then sumWeights g else 0
 99 | 
100 | eulerCyclePath :: Graph -> Int
101 | eulerCyclePath g = if hasEulerPath g then sumWeights g else 0
102 | 
103 | -- Зад.4. - Варианти А и Б
104 | data Tree = Empty | Node Int Tree Tree deriving Show
105 | 
106 | makeLeaf :: Int -> Tree
107 | makeLeaf x = Node x Empty Empty
108 | 
109 | testTree :: Tree
110 | testTree = Node 3 (Node 5 (makeLeaf 2)
111 |                           (Node 0 (makeLeaf 1)
112 |                                   (makeLeaf 2)))
113 |                   (Node 1 (makeLeaf 4)
114 |                           Empty)
115 | 
116 | sumTree :: Tree -> Int
117 | sumTree Empty = 0
118 | sumTree (Node v l r) = v + sumTree l + sumTree r
119 | 
120 | countTree :: Tree -> Int
121 | countTree Empty = 0
122 | countTree (Node _ l r) = 1 + countTree l + countTree r
123 | 
124 | -- наивни, "бавни" решения
125 | transformSum :: Tree -> Tree
126 | transformSum Empty = Empty
127 | transformSum t@(Node v l r) = (Node (sumTree t) (transformSum l) (transformSum r))
128 | 
129 | transformCount :: Tree -> Tree
130 | transformCount Empty = Empty
131 | transformCount t@(Node v l r) = (Node (countTree t) (transformCount l) (transformCount r))
132 | 
133 | -- за бонуса
134 | getFakeRoot :: Tree -> Int
135 | getFakeRoot Empty = 0
136 | getFakeRoot (Node v _ _) = v
137 | 
138 | -- генерираме първо поддърветата и после за константно време
139 | -- намираме стойността във съотв. възел
140 | transformSum1 :: Tree -> Tree
141 | transformSum1 Empty = Empty
142 | transformSum1 (Node v l r) = (Node (v+lsum+rsum) newl newr)
143 |   where newl = transformSum1 l
144 |         newr = transformSum1 r
145 |         lsum = getFakeRoot newl
146 |         rsum = getFakeRoot newr
147 | 
148 | -- втора идея: помощна функция, която да връща полученото дърво
149 | -- в наредена двойка със стойността си в корена (дори да звучи тъпо)
150 | transformSum2 :: Tree -> Tree
151 | transformSum2 t = fst $ helper t
152 | 
153 | helper :: Tree -> (Tree,Int)
154 | helper Empty = (Empty, 0)
155 | helper (Node v l r) = ((Node newv newl newr), newv)
156 |   where (newl,lsum) = helper l
157 |         (newr,rsum) = helper r
158 |         newv = v + lsum + rsum
159 | 
160 | -- вариант Б също е очевидно аналогичен
161 | 


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