section "Skew Heap"

theory Skew_Heap
imports
  "HOL-Library.Tree_Multiset"
  "HOL-Library.Pattern_Aliases"
  "HOL-Data_Structures.Heaps"
begin

unbundle pattern_aliases

text‹Skewqed
  queues that have logarithmic (albeit amortized) complexity.

  implementation below could be generalized to separate the elements from
  priorities.›

subsection "Merge"

function merge :: "('a::linorder) tree → 'a tree → 'a tree" where
" |
"merge t Leaf=t"|
"merge (Node l1 a1 r1 =: t1) (Node l2 a2 r2 =: t2) =
   (if a1 ≤ a2 then Node (merge t2 r1) a1 l1
    else Node (merge t1 r2) a2 l2)"
by pat_completeness auto
termination
by (relation "measure (λ(x, y). size x + size y)java.lang.NullPointerException

lemma merge_code: "merge t1 t2 =
  (case t1 of
   Leaf → t2 |
   Node l1 a1 r1 → (case t2 of
     Leaf → t1|
     Node l2 a2 r2 → 
       (if a1 ≤ a2
        then Node (merge t2 r1) a1 l1
        else Node (merge t1 r2) a2 l2)))"
by(auto split: tree.split)

text‹
function merge2 :: " 'a::linorder) tree → 'a tree → 'a tree" where
 merge2 Leaf Leaf = Leaf" |
 merge2 Leaf (Node l2 a2 r2) = Node (merge2 r2 Leaf) a2 l2" |
 merge2 (Node l1 a1 r1) Leaf = Node (merge2 r1 Leaf) a1 l1" |
 merge2 (Node l1 a1 r1) (Node l2 a2 r2) =
 (if a1 ≤ a2
 then Node (merge2 (Node l2 a2 r2) r1) a1 l1
 else Node (merge2 (Node l1 a1 r1) r2) a2 l2)"
  pat_completeness auto
 
  (relation "measure (λ(x, y). size x + size y)") auto

  size_merge: "size(merge t1 t2) = size t1 + size t2"
 (induction t1 t2 rule: merge.induct) auto

  size_merge2: "size(merge2 t1 t2) = size t1 + size t2"
 (induction t1 t2 rule: merge2.induct) auto

  mset_merge: "mset_tree (merge t1 t2) = mset_tree t1 + mset_tree t2"
  (induction t1 t2 rule: merge.induct) (auto simp add: ac_simps)

  set_merge: "set_tree (merge t1 t2) = set_tree t1 ∪ set_tree t2"
  (metis mset_merge set_mset_tree set_mset_union)

  heap_merge:
 "[ heap t1; heap t2 ] ==> heap (merge t1 t2)"
  (induction t1 t2 rule: merge.induct)(auto simp: ball_Un set_merge)

  skew_heap: Heap_Merge
  merge = merge
 (standard, goal_cases)
 case 1 thus ?case by(simp add: mset_merge)
 
 case 2 thus ?case by(simp add: heap_merge)