Ocaml - kody

type 'a bin_tree = Node of 'a bin_tree * 'a * 'a bin_tree | Null;;

(*
 * napisz procedure path: 'a bin_tree -> 'a list,
 * ktora znajduje najdluzsza sciezka (jedna z)
 * od korzenia do liscia i zwraca liste wartosci
 * znajdujacych sie w wezlach tworzacych te
 * sciezke w kolejnosci od korzenia do liscia
 *)

let rec fold_bin_tree f a t =
  match t with
  | Null -> a
  | Node (l,x,r) -> f x (fold_bin_tree f a l) (fold_bin_tree f a r);;

let path t =
  let f = (fun w (dl,ll) (dr,lr) ->
    if dl >dr then
      (dl+1, w::ll)
    else
      (dr+1,w::lr))
  in match (fold_bin_tree f (0,[]) t) with | (a,b) -> b;;

type 'a bin_tree = Node of 'a bin_tree * 'a * 'a bin_tree | Null;;

let rec fold_bin_tree f a t =
  match t with
  | Null -> a
  | Node (l,x,r) -> f x (fold_bin_tree f a l) (fold_bin_tree f a r);;

(*
 * napisz procedure ktora dla
 * danego drzewa binarnego obliczy
 * liczbe wierzcholkow nieprzyslonietych
 * przez wyzsze
*)

let przys0 d =
  let rec pom d max =
    match d with
    | Null -> 0
    | Node (dl,w,dr) ->
        if w >= max then
          (pom dl w + pom dr w + 1)
        else
          (pom dl max + pom dr max)
  in pom d 0;;

let przys d =
  let f = fun w fl fr -> fun max ->
    if w >= max then
      fl w + fr w + 1
    else fl max + fr max
  in (fold_bin_tree f (fun x -> 0) d) 0;;
type 'a tree = Node of 'a tree * 'a * 'a tree | Leaf;;

let d = Node(Leaf,7,Node(Node(Leaf,2,Leaf),3,Node(Leaf,2,Leaf)));;

(*
 * Napisz funkcję liczącą rozmiar (liczba wierzchołków node) i wysokość drzewa jednocześnie
 *     N
 *  L     N
 *      N   N
 *
*)

let max x y = if x > y then x else y;;

let rec sh t =
  match t with
   Leaf -> (0, 0) |
   Node( l, _, r ) ->
     let (sl, hl) = sh l
     and (sr, hr) = sh r
     in (sl + sr + 1, 1 + max hr hl);;

sh d;;
type 'a tree = Node of 'a tree * 'a * 'a tree | Leaf;;

let d = Node(Leaf,7,Node(Node(Leaf,4,Leaf),3,Node(Leaf,2,Leaf)));;

(*
 * Napisz funkcję, która obliczy drzewo lustrzande do danego
 *     N
 *  L     N
 *      N   N
 *
*)

let rec mirror t =
  match t with
   Leaf -> Leaf |
   Node( l, v, r ) ->
     Node(mirror r, v, mirror l);;

mirror d;;
d;;
type 'a tree = Node of 'a tree * 'a * 'a tree | Leaf;;

let d = Node(Leaf,7,Node(Node(Leaf,2,Leaf),3,Node(Leaf,2,Leaf)));;

(*
 * Drzewo nazywamy ultralewicowym, jeśli głębokości kolejnych liści (Leaf) od lewej do prawej tworzą ciąg nierosnący. Napisz procedurę ultraleft 'a tree -> bool, która sprawdza czy drzewo jest ultralewicowe.
 *     N
 *  L     N
 *      N   N
 *
*)

let max x y = if x > y then x else y;;

let rec mirror t =
  match t with
   Leaf -> Leaf |
   Node( l, v, r ) ->
     Node(mirror r, v, mirror l);;

;;
let d = Node(Leaf,7,Node(Node(Leaf,2,Leaf),3,Node(Leaf,2,Leaf)));;

let ultraleft t =
  let rec help t ok akg osg =
    match t with
      Leaf -> (akg<=osg, akg) |
      Node( l, _, r ) ->
        let (lok, lg) = help l ok (akg+1) osg
        in if not lok then (false, 0)
          else help r (akg+1) lg
  in fst help t 0 max_int;;

ultraleft (mirror d);;
ultraleft d;;


d;;
type 'a tree = Node of 'a tree * 'a * 'a tree | Leaf;;

let d = Node(Leaf,7,Node(Node(Leaf,2,Leaf),3,Node(Leaf,2,Leaf)));;

(*
 * Napisz procedurę, która dla danego drzewa obliczy
 * listę wartości z wierzchołów Node w obiegu infiksowym
 * od lewej do prawej
*)

let infx t =
  let rec pom t li =
    match t with
     Leaf -> li |
     Node( l, v, r ) ->
       pom l (v::(pom r li))
  in pom t [];;

infx d;;
type 'a tree = P | W of 'a * 'a tree list;;

(*
 * Napisz procedurę głębokość, która dla danego drzewa wyznaczy
 * głębokość (maksymalną odległość korzenia od wierzchołków typu W)
*)

let glebokosc t =
  let rec glD t =
    match t with
     | P -> -1
     | W( w,l ) ->
       (glLD l (-1))
  and glLD l wyn =
    match l with
    | [] -> wyn
    | h::t -> (glLD t (max wyn (glD h)))
  in glD t;;
type tree = N of int * tree list;;

(*
 * Firma planuje zorganizować przyjęcie.
 * Hierarchia stanowisk ma strukturę drzewa tree.
 * Każdy pracownik charakteryzuje się
 * pewną 'towarzyskością' wyrażoną liczbą dodatnią.
 * Napisz program, który dobierze gości tak, aby na
 * przyjęciu nie był obezni bezpośredni prełożony
 * żadnego z gości i suma współczynników towarzyskości
 * była maksymalna.
 *
 * pr domowa
 *  znalezc liste gosci
 *  jak zagwarantowac ze prezes bedzie na przyjeciu
*)

let max x y = if x > y then x else y;;

let rec imprezz t =
  let N(w,l) = t
  in let  (slb sl) = imprezLD l 0 0
  in (sl, max sl (slb+w))
and imprezLD l sb s = match l with
[] -> (sb s) |
h::t -> let (shb, sh) = imprezz h
in imprezLD t (sb+shb) (s+sh);;
type tree = Node of tree*tree | Leaf;;

(*
 * idk
 *)

let listaliczbnode d o =
  let rec spacer d l = match d with
    | Leaf -> l
    | Node(dl,dr) -> let (h,t) = match l with
      | [] -> o,[]
      | h::t -> h,t
    in (h+1)::( spacer dl (spacer dr t))
  in spacer d [];;

type 'a bin_tree = Node of 'a bin_tree * 'a * 'a bin_tree | Null;;

(*
 * fold bin tree
 *)

let rec fold_bin_tree f a t =
  match t with
  | Null -> a
  | Node (l,x,r) -> f x (fold_bin_tree f a l) (fold_bin_tree f a r);;
type 'a bin_tree = Node of 'a bin_tree * 'a * 'a bin_tree | Null;;

let rec fold_bin_tree f a t =
  match t with
  | Null -> a
  | Node (l,x,r) -> f x (fold_bin_tree f a l) (fold_bin_tree f a r);;

(*
 * napisz procedure ktora dla
 * danego drzewa binarnego obliczy
 * liste wierzcholkow w obiegu
 * infiksowym za pomoca fold_bind_tree
*)

(* bez fold *)
let infix0 t =
  let rec spacer d l = match d with
  | Null -> l
  | Node(dl,w,dr) -> spacer dl (w::(spacer dr l))
  in spacer t [];;


let infix t =
  let f = (fun w fl fr -> fun aku -> fl (w::(fr aku)))
  in (fold_bin_tree f (fun x -> x ) t) [];;
(*
 * Napisz procedurę exists która dla
 * danego predykatu i listy sprawdzi czy
 * na liscie jest element spełniający predykat.
*)

let exists li p =
  List.fold_left
    (fun a h ->
      if a = true then
        a
      else
        p h)
    false
    li;;
(*
 * Za pomocą procedury non oraz procedury exists
 * napisz forall, która sprawdza czy dany predykat
 * jest spełniony przez wszystkie elementy listy
*)

let non p = fun x -> not (p x);;

let exists li p =
  List.fold_left
    (fun a h ->
      if a = true then
        a
      else
        p h)
    false
    li;;

let forall li p = not ( exists li (non p) );;
(*
 * Zapisz procedurę append za pomocą fold_left, fold_right
*)

let append_r li1 li2 =
  List.fold_right (fun h a -> h::a) li1 li2;;
type 'a tree = Node of 'a * 'a tree list;;

(*
 * sprzwdz czy dzrzewo jest zrownowazone
 * ( czy wszystkie liscie sa na tym samym
 *   poziomie)
 *)

let zrwn t =
  let f = fun _ l ->
    fold_left ( fun ( ... jpg
let f x = if x mod 3 = 0 then -5 else -x;;
f 1;;
f 2;;
f 3;;
f 4;;

let find f n =
  let rec help a b s m d=
    if b = n+1 then
      d
    else if s + (f b) > m then
      help a (b+1) (s+(f b)) (s+(f b)) (b-a+1)
    else if s + (f b) < 0 then
      help (b+1) (b+1) 0 m d
    else
      help a (b+1) (s + (f b)) m d
  in help 1 1 0 (f 1) 1;;

find f 4;;

let find f n =
  let rec pom a b s smin smax d =
    if b = n + 1 then d
    else if s + (f b) < smin then pom(b+1) (b+1) (s+(f b))  smax d
    else if s + (f b) - smin > smax then pom a (b+1) (s+(f b)) smin (s+(f b)-smin) (b-a+1)
    else pom a (b+1)  (s+ (f b)) smin smax d
  in pom 1 1 0 0 0 0;;

find f 4;;
(*
 * Niech f : R -> R będze funkcją
 * bijekcją
 * ciągłą
 * rosnącą i to tak, że V d > 0 : f(x+d) - f(x) >= d
 * f(0) = 0
 * Zaimplementuj procedurę odwrotnść, której wynikiem
 * dla parametru f będzie przybliżone f^-1 z dokładnością
 * zadaną przez stałą epsilon
 * ( czyli jeśli q = odwrotnosc f to V x : | q(x) - f^-1 (x)| <= epsilon )
*)

let eps = 0.001;;

let odwrotnosc f =
  fun y ->
    let rec szukaj l p = let s = (l+.p) /. 2.
    in if abs_float ( f(s) -. y ) < eps then
      s
    else if f(s) > y then
      szukaj l s
    else
      szukaj s p
    in if (abs_float y) < eps then 0.
    else if y > 0. then szukaj 0. y
    else szukaj y 0.;;

module type NOSNIK =
  sig
    type t
  end;;

(* op jest łączna *)

module type MONOID =
  sig
    type t
    val op : t -> t -> t
    val e : t
  end;;

(*
 * Zdefiniuj moduły MonoidLiczbCałkowitych i MonoidFunkcji
*)

module MonoidLiczbCalkowitych : MONOID with type t = int =
  struct
    type t = int
    let op = (+)
    let e = 0
  end;;

module M = MonoidLiczbCalkowitych;;

let tree = M.op M.e 3;;

module MonoidFunkcjiCalkowitych : MONOID with type t = int -> int =
  struct
    type t = int -> int
    let op = fun f g -> fun x -> f(g x)
    let e = fun x -> x
  end;;

module M = MonoidFunkcjiCalkowitych;;
let tree = M.op M.e (fun x -> 3);;

(*
 * Zbuduj monoid składania funkcji - funktor który
 * dla określonego typu t konstruuje to co powyżej
*)

module MonoidFunkcji (N: NOSNIK) : MONOID with type t = N.t -> N.t =
  struct
    type t = N.t -> N.t
    let op f g x = f( g x)
    let e = fun x -> x
  end;;

module MF = MonoidFunkcji (struct type t = int end);;
let x = MF.op (fun x -> x+1) (fun x -> x+2);;
let xx = MF.op (M.e) (M.e)
let y = x 3;;

(*
 * Zdefiniuj funktor, który dla danego
 * monoidu definiuje operację ptęgowania
*)

module type MONOID_Z_POTEGOWANIEM =
  sig
    type t
    val op: t -> t -> t
    val e: t
    val pot : int -> t -> t
  end;;

module MonoidZPotegowaniemFunktorow(M: MONOID) : MONOID_Z_POTEGOWANIEM with type t = M.t =
  struct
    type t = M.t
    let op = M.op
    let e = M.e
    let rec pot n a =
      if n<=0 then e else op a (pot(n-1) a)
  end;;

module Pott = MonoidZPotegowaniemFunktorow( MonoidFunkcji ( struct type t = int end ) );;
let f = Pott.pot 3 ( fun x -> x + 1 );;
let x = f 1;;

(*
 * Zdefiniuj funktor, który na podstawie dwóch
 * porządków liniowych tworzy porządek leksykograficzny
 * na parach odpowiedniego typu
*)

module type PORZADEK_LINIOWY =
  sig
    type t
    val porownaj : t -> t -> bool
  end;;

module PorzadekLiniowyFunktor(A: PORZADEK_LINIOWY) (B: PORZADEK_LINIOWY) : PORZADEK_LINIOWY
with type t = A.t * B.t =
  struct
    type t = A.t * B.t
    let porownaj (a1,b1) (a2,b2) =
      if A.porownaj a1 a2 then
        if A.porownaj a2 a1 then
          B.porownaj b1 b2
        else
          true
      else
        false
  end;;
(*
 * Napisz moduł Counter o następującej sygnaturze
*)

module type COUNTER = sig
  type counter
  val make : unit -> counter
  val inc : counter -> int
  val reset : unit -> unit
end;;

(*
 * hehe nie dziala
module type MyCOUNTER: COUNTER = struct
  type counter = int ref * int ref
  let make () = (ref 0, ref 0)
  let cnt_reset = ref 0
  let inc c =
    match c with
    (c_val, c_res) ->
      if !c_res = !cnt_reset then
        c_val := !c_val+1; !c_val
      else
        c_val := 1; c_res  := cnt_reset; !c_val
  let reset = cnt_reset := !cnt_reset + 1
end;;
*)



(*
 * Dana jest tablica liczb całkowitych
 * zawierająca permutację liczb od 0 do n
 * ( n >= 0 ). Napisz porcedurę cykl : int array -> int,
 * która wyznaczy długość najdłuższego cyklu
 * danej permutacji. Twoja procedura nie
 * może zmieniać danej tablicy.
*)

(*
let cykl t =
  let odw = make (length t) false
  and wyn = ref 0
  in begin
    for j - 0 to (length t) - 1 do
      if not odw.(j) then begin
        odw.(j) <- true;
        let dl = ref 1 and k = ref t.(j)
        in while !k <> j do
          odw.(!k) <- true;
          incr dl;
          k = t.(!k);
        done;
        if !wyn < !dl then
          wyn := !dl;
      end;
      end;
        done;
    !wyn;
  end;;
*)

type 'a drzewo =
  Puste | Wezel of 'a * 'a drzewo * 'a drzewo * 'a drzewo ref;;

(*
 * Drzewo binarne z fastrygą to drzewo
 * w którym każdy węzeł posiada
 * dodatkowo referencję na następny węzełw
 * porządku infiksowym (ostatni na
 * Pustą). Napsiz procedurę fastryguj
 * : 'a drzewo -> uint która sfastryguje dane drzewo.
 *)

zdj
let fastryguj d =
  let rec spacer x s =
    match x with
    | Pus



type 'a tree = Node of 'a * 'a tree list;;

let nieparzyste t =
  let rec pomw Node(_,lista) =
    let (rozm,wyn) = poml lista (1,0) in
    if rozm mod 2 = 1 then
      (rozm, wyn+1)
    else
      (rozm,wyn)
    and poml l (roz_a, wyn_a) =
      match l with
      | [] -> (roz_a, wyn_a) =
        match l with
        | [] (roz_a, wyn_a)
        | h::t ->
            let (roz_d, wyn_d) = pomw h
            in poml t (roz_a+roz_d, wyn_a+wyn_d)
  in sec (pomw t);;
(*
 * Napisz program wybierający element dominujący z listy.
 * Uzasadnij jego poprawność.
*)
(*
 * Napisz procedurę budującą listę n pierwszych liczb naturalnych
 *)

let rec build n =
  if n = 0 then []
  else n::build (n-1);;

(*
 * warunek początkowy: n całkowite n >= 0
 * warunek końcowy: build n = [n;n-1;...1]
 *)


let rec build_tail n =
  let rec pom i l =
    if i = n+1 then l
    else pom (i+1) (i::l)
  in pom 1 [];;


build_tail 10;;

(*
 * warunek początkowy:
   * 1 <= i <= n+1  i całkowite
   * l - lista liczb całkowitych
 * warunek końcowy:
   * pom i l = [n ... i] @ l
 *
 * warunek początkowy:
   * 1 <= i <= n+1  i całkowite
   * l l = [i-1 ... 1]
 * warunek końcowy:
   * pom i l = [n ... 1]
*)
(*
 * Załóżmy, że dana jest lista [x1, x2, ... xn].
 * Napisz procedurę tails α list -> (α list) list,
 * która dla danej listy twoezt listę jej wszystkich sufiksów,
 * uporządkowanych według ich długości (można wybrać malejąc czy rosnąco)
*)

let build_tail l =
  let rec pom l res =
    match l with
    | [] -> []::res
    | h::t -> pom t (l::res)
  in pom l [];;

build_tail [1;2;3]


let rec build l =
  match l with
  | [] -> [[]]
  | h::t -> l::build t;;

build [1;2;3]
(*
 * Dane są dwie listy liczb całkowitych uporządkowane niemalejąco.
 * Oblicz ile różnych liczb występuje na tych listach.
*)

let min x y = if x < y then x else y;;

let uniqe l1 l2 =
  let rec pom l1 l2 wyn ost =
    match l1, l2 with
    | [], [] -> wyn
    | [], h::t ->
        if h <> ost then
          pom [] t (wyn+1) h
        else
          pom [] t wyn h
    | h::t, [] -> pom [] l1 wyn ost
    | h1::t1, h2::t2 ->
        if h1 <= h2 then
          if h1 <> ost then
            pom t1 l2 (wyn+1) h1
          else
            pom t1 l2 wyn h1
        else
          pom l2 l1 wyn ost
  in pom l1 l2 0 0;;

uniqe [1;2;4;5] [2;6;8];;
(*
 * Napisz procedurę trójki int list -> (int * int * int) list,
 * która dla zadanej listy liczb dodatnich całkowitych, uporządkowanej
 * rosnąco, stworzy listę takich trójek (a,b,c) liczb z danej listy,
 * że a < b < c  i  c < a + b
*)

let three l =
  let rec lo3 l a b =
    match l with
    | [] -> []
    | h::t ->
      if a < b && b < h && h < a + b then
        (a,b,h)::(lo3 t a b)
      else
        lo3 t a b
  and lo2 l a =
    match l with
    | [] -> []
    | h::t -> (lo3 l a h) @ (lo2 t a)
  and lo1 l =
    match l with
    | [] -> []
    | h::t -> (lo2 l h) @ (lo1 t)
  in lo1 l;;

three [1;2;3;4];;

let three_tail l =
  let rec help a b l res=
    match l with
      [] -> res |
      h::t ->
        if h < a + b then
          help a b t ((a,b,h)::res)
       else
           help a b t res
  in
  let rec help2 a l res =
    match l with
      [] -> res |
      h::t -> help2 a t (help a h t res)
  in
  let rec help3 l res =
    match l with
      [] -> res |
      h::t -> help3 t (help2 h t res)
  in help3 l [];;

three_tail [1;2;3;4;5;6;7;8;9;11;111;1123];;

(*
 * praca domowa
*)
(*
 * Palindrom to taka lista, że p = rev p.
 * Napisz procedurę palindrom list -> int,
 * która dla danej listy obliczy długość
 * jej najdłuższego spójnego fragmentu,
 * która jest palindromem.
*)
let pow x y =
  let rec help a ac y =
    if y = 0 then
      ac
    else
      if y mod 2 = 1 then
        help (a*a) (ac*a) (y/2)
      else
        help (a*a) (ac) (y/2)
  in help x 1 y;;

pow 2 4;;
pow 3 4;;
pow 9 15;;

(*
 * Napisz funkcje elementy: 'a list -> int list -> 'a list,
 * która dla list [x1; x2; ... xn] [y1; y2; ... yn ]
 * zwraca listę [x(y1); x(y2); ... x(yn)]
*)
let elementy lx ly =
  let comp (ax,ay) (bx,by) =
    compare ax bx
  in let (y2 = sort comp1 (fold_left fun (la, ind) x -> ((x,ind)::la, ind+1) ([],1) ly)
  in let wybierz lx ind ly2 wyn =
    match ly2 with
    | [] -> wyn
    | (hy,hi)::t ->
        if hy=ind then
          wybierz lx ind t ((hi,hd lx)::wyn)
        else
          wybierz (tl lx) (ind + 1) ly2 wyn
  in let lwyn2 = sort comp (wybierz ly 1 ly2 [])
  in rev(fold_left (fun aku (ax,ay) -> ay::aku) [] lwyn2)
(*
 * Napisz procedurę przedział in list -> int -> int,
 * która dla zadanej listy [x1, ... xn] oraz
 * dla liczby całkowietej r >= 0 obiliczy taką liczbę
 * całkowitą c, że |{ i : |xi -c| <= r}| jest maksymalne
*)

let przedzial l r =
  let l = sort compare l
  in let pom c ip lp ik lk max_n max_c =
    match lk with
    | [] -> max_c
    | hk::tk -> match lp
    ...
(*
 * Tokmek ma zapawkę, z której wystają
 * drewniane słupki różnej wysokości.
 * Jednym uderzeniem młotka można wbić
 * lub wysunąć wybrany słupek o 1.
 * Napisz procedure slupki int list -> int,
 * która dla danej listy początkowych wyskosści
 * słupka obliczy minimalną liczbę uderzeń
 * młotka potrzebnych do wyrównania wysokości słupków.
*)

let slupki l =
  let mediana l =
    List.nth (List.sort compare l) ((List.length l) / 2) in
  let med = mediana l in
  List.fold_left (fun aku a -> aku + abs(a-med)) 0 l;;
(*
 * Dana jest tablica prostokątna rozmiaru n na m
 * posortowana rosnąco kolumnowo i wierszowo.
 * Sprawdź czy w tablicy jest wartość x.
*)

(* nie bedziemy pisac *)

(*
 * Dana jest tablica nxn reprezentująca czy
 * osoba x zna osobę y. Sprawdź czy wśród n osób
 * istnieje osobistość = ktość kogo każdy zna i kto
 * i kto nikogo nie zna
*)

(* ... *)

(*
 * Dany jest graf nieskierowany, którego
 * wierzchołki są ponumerowane od 0 do n-1.
 * Napisz procedurę path : graph -> int,
 * która wyznacza długości ( liczy liczbę krawędzi)
 * najdłuższej ścieżki w tm grafie, na której
 * numery wierzchołków tworzą ciąg rosnący
*)

type graph = int list array;;

let path G =
  let odl = Array.make (Array.length G) -1 in
  let spacer nr =
    1 + List.fold_left (fun aku w = if w <= nr then aku
    else
      max aku odl.(w)) (-1) G.(nr)
  in let maxi = ref 0
  in for i := n-1 downto 0 do
    maxi := max (!maxi) (odl.(i) <- spacer i; odl.(i))
  done
  !maxi
;;

(*
 * Dana jest prosotkątna mapa górzystego
 * terenu w postaci prostokątnej tablicy
 * dodatnich liczb całkowitych o wymiarach NxM.
 * Chcemy przejść z pola (0,0) do pola do pola
 * (N-1, M-1) ale nie chcemy wspinać się zbyt wysoko.
 * Możemy przesuwać się w kierunkach N, W, S, E.
 * Napisz procedurę wysokość : int array attay -> int
 * która dla danej ampy terenu określi minimalną
 * największą wysokość na którą musi wejść
*)
(*
 * Na szachownicy jest ustalonych n wież,
 * które należy pokolorować. Jeśli dwie
 * wieże się atakuję (są w tej samej kolumnie
 * lub rzędzie) to muszą być tego samego koloru.
 * Napisz procedurę kolory int int * int list -> int,
 * która na podstawie listy współrzędnych wież
 * wyznaczy maksymalną liczbę kolorów, których
 * można użyć kolorując wieże. Pierwszy parametr to
 * rozmiar szachownicy, zakładamy, że współrzędne wież są poprawne.
*)

module type FIND_UNION = sig
  type ’a set
  val make_set : ’a ->’a set
  val find : ’a set ->’a
  val equivalent : ’a set ->’a set ->bool
  val union : ’a set ->’a set ->unit
  val elements : ’a set ->’a list
  val n_of_sets : unit->int
end;;

(*
 * zakładamy, że istnieje Find_Union_Functor
*)

let kolory n l =
  let module FU = Find_Union_Functor (struct end) and
  x = Array.make n None and
  y = Array.make n None and
  pom l =
    match l with
    | [] -> FU.n_of_sets ()
    | (xh,yh)::t -> begin
      let kol = FU.make_set (xh,yh) in
      if x.(xh) = None then
        x.(xh) <- Some kol
      else
        FU.union x.(xh) kol;
      if y.(yh) = None then
        y.(yh) <- Some kol
      else
        FU.union y.(yh) kol;
      pom t
    end
  in pom l;;


(*
 * Na drzewie wisi n małpek ponumerowanych od 1 do n.
 * Małpka z nr 1 trzyma się gałęzi ogonem. Pozostałe małpki
 * albo są trzymane przez innne, albo trzymają się innych
 * małpek, albo jedno i drugie. Każda małpka ma dwie łapki przednie,
 * każdą może trzymać co najwyżej jedną inną małpkę (za ogon).
 * Rozpoczynając od chwili 0, co sekundę jedna z małpek puszcza
 * jedną łapkę, W ten sposób małpki spadają na ziemię, gdzie
 * dalej mogą puszczać łapki. Czas spadania małpek jest
 * pomijalnie mały. Zaprojektuj algorytm, który na podstawie opisu
 * tego, która małpka trzyma którą, oraz na podstawie opisu
 * łapek puszczanych w kolejbnych chwilach, dla każdej małpki
 * wyznaczy moment kiedy spadnie ona na ziemię.
*)
(*
 * Wygładzenie funkcji z odstępem dx polega na uśrednieniu
 * f(x-dx), f(x) i f(x+dx)
 * Napisz procedurę wygładzającą daną funkcję z zadanym odstępem.
 * Zwróć uwagę na kolejność argumentów.
*)

let wygladzenie f dx x = ( f(x -. dx) +. f(x) +. f( x +. dx) ) /. 3.;;
let wygladzenie dx f = fun x -> ( f(x -. dx) +. f(x) +. f( x +. dx) ) /. 3.;;