open System
type Heap<'a when 'a: equality> =
| EmptyHP
| HP of 'a * Heap<'a> * Heap<'a>


let ex3 = HP(1,HP(2,HP(3,EmptyHP,EmptyHP),HP(5,EmptyHP,EmptyHP)),HP(4,EmptyHP,EmptyHP))

// The type of ex3 is monomorphic. The reason for this is that it is Heap<int>, which means that it has to contain heap with ints.
// If the type was polymorphic, the type would be Heap<'a>

let empty = EmptyHP

exception HeapError of string

//Checks if a heap is empty.
let isEmpty = function
| EmptyHP -> true
| _ -> false

// returns the number of notes within a heap (root inclusive)
let rec size = function
    | EmptyHP -> 0
    | HP(_,l,r) -> 1 + size l + size r

// finds the root value and raises exception if the root is empty
let find = function
| HP(v,_,_) -> v
| EmptyHP -> raise (HeapError "empty")

// test cases
let not_a_heap = HP(1,HP(4,HP(3,EmptyHP,EmptyHP),HP(5,EmptyHP,EmptyHP)),HP(4,EmptyHP,EmptyHP))
let not_a_heap2 = HP(3,HP(2,HP(3,EmptyHP,EmptyHP),HP(5,EmptyHP,EmptyHP)),HP(4,EmptyHP,EmptyHP))

// this functions checks if the heap property is fulfilled. The root node should always be bigger or equal to the child notes
let chkHeapProperty h =
    let rec aux h =
        match h with
        | HP(v,l,r) -> if ((isEmpty l || v < find l) && (isEmpty r || v <find r)) then (aux l) && (aux r) else false
        | EmptyHP -> true
    aux h

let test_chkHeapProperty =
    chkHeapProperty ex3 && not (chkHeapProperty not_a_heap && chkHeapProperty not_a_heap2)

//I made the topdown with preordering. I apply the function first, then I do left and right child node.
let map f h =
    let rec aux h =
        match h with
        | HP(v,l,r) -> HP(f v, aux l, aux r)
        | EmptyHP -> EmptyHP
    aux h


// this function can easily destroy a heap property; however, to do so it must not contain only uneven numbers
let destroy_heap_property h =
    let new_heap = map (fun i -> if (i % 2 = 0) then i*(-1) else i) h
    chkHeapProperty new_heap