aboutsummaryrefslogtreecommitdiff
path: root/semestr-3/pf/lista3/lista3.ml
blob: 9f322a523780fb060154262b89d6022c9f40e417 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
(* Zadanie 1 *)

let rec fold_right f acc = function
  | x :: xs -> f x (fold_right f acc xs)
  | [] -> acc

let rec fold_left f acc = function 
  | x :: xs -> fold_left f (f acc x) xs
  | [] -> acc

let length xs = fold_left (fun a b -> a + 1) 0 xs

let rev xs = fold_left (fun xs x -> x :: xs) [] xs

let map f xs = fold_right (fun x xs -> (f x) :: xs) [] xs

let append xs ys = fold_right (fun x xs -> x :: xs) ys xs

let rev_append xs ys = fold_left (fun xs x -> x :: xs) ys xs

let filter f xs = fold_right (fun x xs -> if f x then x :: xs else xs) [] xs

let rev_map f xs = fold_left (fun xs x -> (f x) :: xs) [] xs

(* Zadanie 2 *)

let list_to_num xs = 
  let rec iter res = function
    | [] -> res
    | x :: xs -> iter (res * 10 + x) xs
  in iter 0 xs

let fold_list_to_num xs = fold_left (fun acc x -> (acc * 10 + x)) 0 xs

(* Zadanie 3 *)

let polynomial p x = 
  let rec iter acc = function
    | [] -> acc
    | hd :: tl -> iter (acc *. x +. hd) tl
  in iter 0. p

let fold_polynomial p x = fold_left (fun acc hd -> (acc *. x +. hd)) 0. p

(* Zadanie 4 *)

let rec polynomial_rev_rec p x =
  match p with
  | [] -> 0.
  | hd :: tl -> (polynomial_rev_rec tl x) *. x +. hd

let fr_polynomial_rev p x = fold_right (fun hd acc -> acc *. x +. hd) 0. p

let polynomial_rev_iter p x =
  let rec iter acc xpow = function
    | [] -> acc
    | hd :: tl -> iter (acc +. xpow *. hd) (xpow *. x) tl
  in iter 0. 1. p

let fl_polynomial_rev p x = fst (fold_left (fun (acc, xpow) hd ->  ((acc +. xpow *. hd), (xpow *. x))) (0., 1.) p)

(* Zadanie 5 *)

let for_all pred xs = 
  try fold_left (fun acc x -> if acc && (pred x) then true else raise (Failure "")) true xs with
    Failure _ -> false

let mult_list xs =
  try fold_left (fun acc x -> if x == 0 then raise (Failure "") else acc * x) 0 xs with
    Failure _ -> 0

let sorted = function
  | [] -> true
  | x :: xs ->            
    try snd (fold_left (fun acc x -> if (fst acc) <= x then (x, true) else raise (Failure "")) (x, true) xs)
    with Failure _ -> false  

(* Zadanie 6 *)

let rec fold_left_cps f acc xs k = 
  match xs with
  | [] -> k acc
  | x :: xs -> f acc x (fun v -> fold_left_cps f v xs k)

(* fold_left_cps (fun a b k -> a * b) *)

let  fold_left_with_cps f acc xs = 
  fold_left_cps (fun a b k -> k (f a b)) acc xs (fun x -> x)


(* Zadanie 7 *)

let for_all_cps pred xs =
  fold_left_cps (fun acc x k -> if pred x then k acc else false) true xs (fun x -> x) 

let mult_list_cps xs = 
  fold_left_cps (fun acc x k -> if x == 0 then 0 else k (acc * x)) 1 xs (fun x -> x)

let sorted_cps = function
  | [] -> true
  | x :: xs -> 
    fold_left_cps (fun acc x k -> if (fst acc) <= x then k (x, true) else false) 
      (x, true) xs (fun x -> snd x)

(* Zadanie 8 *)

open Procc

let mapp f =
  let rec echo k =
    recv (fun v ->
        send (f v) (fun () ->
            echo k))
  in echo

let filterr pred = 
  let rec echo k =
    recv (fun v ->
        if pred v then send v (fun () -> echo k) else echo k)
  in echo

let rec nats_from n k = 
  send n (fun () ->
      nats_from (n + 1) k)

let rec sieve k =
  recv (fun n -> 
      send n (fun () -> ((filterr (fun x -> (x mod n) != 0)) <|>> sieve) k))