fork download 
  1. exception Empty
  2.  
  3. module type ORDERED = sig
  4.     type t
  5.  
  6.     val eq : t -> t -> bool
  7.     val lt : t -> t -> bool
  8.     val leq : t -> t -> bool
  9. end
  10.  
  11. module type HEAP = sig
  12.     module Elem : ORDERED
  13.  
  14.     type heap
  15.  
  16.     val empty : heap
  17.     val is_empty : heap -> bool
  18.  
  19.     val insert : Elem.t -> heap -> heap
  20.     val merge : heap -> heap -> heap
  21.  
  22.     val find_min : heap -> Elem.t
  23.     val delete_min : heap -> heap
  24. end
  25.  
  26. module SplayHeap (Element : ORDERED) : (HEAP with module Elem = Element) =
  27. struct
  28.   module Elem = Element
  29.  
  30.   type heap = E | T of heap * Elem.t * heap
  31.  
  32.   let empty = E
  33.   let is_empty = ( = ) E
  34.  
  35.   let rec partition pivot = function
  36.     | T (a, x, b) as t -> 
  37.       if x <= pivot then begin
  38.           match b with
  39.             | E -> (t, E)
  40.             | T (b', y, b'') ->
  41.                 if y <= pivot then
  42.                     let (small, big) = partition pivot b''
  43.                     in (T (T (a, x, b), y, small), big)
  44.                 else
  45.                     let (small,big) = partition pivot b'
  46.                     in (T (a, x, small), T (big, y, b''))
  47.         end else begin
  48.           match a with
  49.             | E -> (E, t)
  50.             | T (a', y, a'') ->
  51.                 if y <= pivot then
  52.                     let (small, big) = partition pivot a''
  53.                     in (T (a', y, small), T (big, x, b))
  54.                 else
  55.                     let (small, big) = partition pivot a'
  56.                     in (small, T (big, y, T (a'', x, b)))
  57.         end
  58.     | E -> (E, E)
  59.  
  60.     let insert x t = let a, b = partition x t in T (a,x,b)
  61.  
  62.     let rec merge z t = match z with
  63.           | E            -> t
  64.           | (T (a,x,b))  -> let ta,tb = partition x t in T ((merge ta a), x, (merge tb b))   
  65.  
  66.     let rec find_min z = match z with
  67.         | E           -> failwith "empty heap"
  68.         | (T (E,x,b)) -> x
  69.         | (T (a,x,b)) -> find_min a
  70.  
  71.     let rec deleteMin z = match z with
  72.         | E                   -> failwith "empty heap"
  73.         | (T (E,x,b))         -> b
  74.         | (T (T (E,x,b)) y c) -> T b y c
  75.         | (T (T (a,x,b)) y c) -> T (deleteMin a) x (T b y c)
  76.  
  77. end
  78.  
Compilation error #stdin compilation error #stdout 0s 0KB
comments (?)
stdin 
Standard input is empty
compilation info 
File "prog.ml", line 74, characters 25-26:
Syntax error: ')' expected
File "prog.ml", line 74, characters 10-11:
This '(' might be unmatched
stdout 
Standard output is empty
https://ideone.com/begIeY
language:
OCaml (ocamlopt 4.05.0)
created:
12 years ago
visibility:
secret

Share or Embed source code

Discover > Sphere Engine API

The brand new service which powers Ideone!

Discover > IDE Widget

Widget for compiling and running the source code in a web browser!