src/HOL/Data_Structures/Heaps.thy
author wenzelm
Sun, 13 Dec 2020 23:11:41 +0100
changeset 72907 3883f536d84d
parent 72688 8cb82e7f1743
permissions -rw-r--r--
unused (see 29566b6810f7);
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
72688
8cb82e7f1743 proper defn of a heap
nipkow
parents:
diff changeset
     1
(* Author: Tobias Nipkow *)
8cb82e7f1743 proper defn of a heap
nipkow
parents:
diff changeset
     2
8cb82e7f1743 proper defn of a heap
nipkow
parents:
diff changeset
     3
section \<open>Heaps\<close>
8cb82e7f1743 proper defn of a heap
nipkow
parents:
diff changeset
     4
8cb82e7f1743 proper defn of a heap
nipkow
parents:
diff changeset
     5
theory Heaps
8cb82e7f1743 proper defn of a heap
nipkow
parents:
diff changeset
     6
imports
8cb82e7f1743 proper defn of a heap
nipkow
parents:
diff changeset
     7
  "HOL-Library.Tree_Multiset"
8cb82e7f1743 proper defn of a heap
nipkow
parents:
diff changeset
     8
  Priority_Queue_Specs
8cb82e7f1743 proper defn of a heap
nipkow
parents:
diff changeset
     9
begin
8cb82e7f1743 proper defn of a heap
nipkow
parents:
diff changeset
    10
8cb82e7f1743 proper defn of a heap
nipkow
parents:
diff changeset
    11
text \<open>Heap = priority queue on trees:\<close>
8cb82e7f1743 proper defn of a heap
nipkow
parents:
diff changeset
    12
    
8cb82e7f1743 proper defn of a heap
nipkow
parents:
diff changeset
    13
locale Heap =
8cb82e7f1743 proper defn of a heap
nipkow
parents:
diff changeset
    14
fixes insert :: "('a::linorder) \<Rightarrow> 'a tree \<Rightarrow> 'a tree"
8cb82e7f1743 proper defn of a heap
nipkow
parents:
diff changeset
    15
and  del_min :: "'a tree \<Rightarrow> 'a tree"
8cb82e7f1743 proper defn of a heap
nipkow
parents:
diff changeset
    16
assumes mset_insert: "heap q \<Longrightarrow> mset_tree (insert x q) = {#x#} + mset_tree q"
8cb82e7f1743 proper defn of a heap
nipkow
parents:
diff changeset
    17
and    mset_del_min: "\<lbrakk> heap q;  q \<noteq> Leaf \<rbrakk> \<Longrightarrow> mset_tree (del_min q) = mset_tree q - {#value q#}"
8cb82e7f1743 proper defn of a heap
nipkow
parents:
diff changeset
    18
and     heap_insert: "heap q \<Longrightarrow> heap(insert x q)"
8cb82e7f1743 proper defn of a heap
nipkow
parents:
diff changeset
    19
and    heap_del_min: "heap q \<Longrightarrow> heap(del_min q)"
8cb82e7f1743 proper defn of a heap
nipkow
parents:
diff changeset
    20
begin
8cb82e7f1743 proper defn of a heap
nipkow
parents:
diff changeset
    21
8cb82e7f1743 proper defn of a heap
nipkow
parents:
diff changeset
    22
definition empty :: "'a tree" where
8cb82e7f1743 proper defn of a heap
nipkow
parents:
diff changeset
    23
"empty = Leaf"
8cb82e7f1743 proper defn of a heap
nipkow
parents:
diff changeset
    24
8cb82e7f1743 proper defn of a heap
nipkow
parents:
diff changeset
    25
fun is_empty :: "'a tree \<Rightarrow> bool" where
8cb82e7f1743 proper defn of a heap
nipkow
parents:
diff changeset
    26
"is_empty t = (t = Leaf)"
8cb82e7f1743 proper defn of a heap
nipkow
parents:
diff changeset
    27
8cb82e7f1743 proper defn of a heap
nipkow
parents:
diff changeset
    28
sublocale Priority_Queue where empty = empty and is_empty = is_empty and insert = insert
8cb82e7f1743 proper defn of a heap
nipkow
parents:
diff changeset
    29
and get_min = "value" and del_min = del_min and invar = heap and mset = mset_tree
8cb82e7f1743 proper defn of a heap
nipkow
parents:
diff changeset
    30
proof (standard, goal_cases)
8cb82e7f1743 proper defn of a heap
nipkow
parents:
diff changeset
    31
  case 1 thus ?case by (simp add: empty_def)
8cb82e7f1743 proper defn of a heap
nipkow
parents:
diff changeset
    32
next
8cb82e7f1743 proper defn of a heap
nipkow
parents:
diff changeset
    33
  case 2 thus ?case by(auto)
8cb82e7f1743 proper defn of a heap
nipkow
parents:
diff changeset
    34
next
8cb82e7f1743 proper defn of a heap
nipkow
parents:
diff changeset
    35
  case 3 thus ?case by(simp add: mset_insert)
8cb82e7f1743 proper defn of a heap
nipkow
parents:
diff changeset
    36
next
8cb82e7f1743 proper defn of a heap
nipkow
parents:
diff changeset
    37
  case 4 thus ?case by(simp add: mset_del_min)
8cb82e7f1743 proper defn of a heap
nipkow
parents:
diff changeset
    38
next
8cb82e7f1743 proper defn of a heap
nipkow
parents:
diff changeset
    39
  case 5 thus ?case by(auto simp: neq_Leaf_iff Min_insert2 simp del: Un_iff)
8cb82e7f1743 proper defn of a heap
nipkow
parents:
diff changeset
    40
next
8cb82e7f1743 proper defn of a heap
nipkow
parents:
diff changeset
    41
  case 6 thus ?case by(simp add: empty_def)
8cb82e7f1743 proper defn of a heap
nipkow
parents:
diff changeset
    42
next
8cb82e7f1743 proper defn of a heap
nipkow
parents:
diff changeset
    43
  case 7 thus ?case by(simp add: heap_insert)
8cb82e7f1743 proper defn of a heap
nipkow
parents:
diff changeset
    44
next
8cb82e7f1743 proper defn of a heap
nipkow
parents:
diff changeset
    45
  case 8 thus ?case by(simp add: heap_del_min)
8cb82e7f1743 proper defn of a heap
nipkow
parents:
diff changeset
    46
qed
8cb82e7f1743 proper defn of a heap
nipkow
parents:
diff changeset
    47
8cb82e7f1743 proper defn of a heap
nipkow
parents:
diff changeset
    48
end
8cb82e7f1743 proper defn of a heap
nipkow
parents:
diff changeset
    49
8cb82e7f1743 proper defn of a heap
nipkow
parents:
diff changeset
    50
8cb82e7f1743 proper defn of a heap
nipkow
parents:
diff changeset
    51
text \<open>Once you have \<open>merge\<close>, \<open>insert\<close> and \<open>del_min\<close> are easy:\<close>
8cb82e7f1743 proper defn of a heap
nipkow
parents:
diff changeset
    52
8cb82e7f1743 proper defn of a heap
nipkow
parents:
diff changeset
    53
locale Heap_Merge =
8cb82e7f1743 proper defn of a heap
nipkow
parents:
diff changeset
    54
fixes merge :: "'a::linorder tree \<Rightarrow> 'a tree \<Rightarrow> 'a tree"
8cb82e7f1743 proper defn of a heap
nipkow
parents:
diff changeset
    55
assumes mset_merge: "\<lbrakk> heap q1; heap q2 \<rbrakk> \<Longrightarrow> mset_tree (merge q1 q2) = mset_tree q1 + mset_tree q2"
8cb82e7f1743 proper defn of a heap
nipkow
parents:
diff changeset
    56
and invar_merge: "\<lbrakk> heap q1; heap q2 \<rbrakk> \<Longrightarrow> heap (merge q1 q2)"
8cb82e7f1743 proper defn of a heap
nipkow
parents:
diff changeset
    57
begin
8cb82e7f1743 proper defn of a heap
nipkow
parents:
diff changeset
    58
8cb82e7f1743 proper defn of a heap
nipkow
parents:
diff changeset
    59
fun insert :: "'a \<Rightarrow> 'a tree \<Rightarrow> 'a tree" where
8cb82e7f1743 proper defn of a heap
nipkow
parents:
diff changeset
    60
"insert x t = merge (Node Leaf x Leaf) t"
8cb82e7f1743 proper defn of a heap
nipkow
parents:
diff changeset
    61
8cb82e7f1743 proper defn of a heap
nipkow
parents:
diff changeset
    62
fun del_min :: "'a tree \<Rightarrow> 'a tree" where
8cb82e7f1743 proper defn of a heap
nipkow
parents:
diff changeset
    63
"del_min Leaf = Leaf" |
8cb82e7f1743 proper defn of a heap
nipkow
parents:
diff changeset
    64
"del_min (Node l x r) = merge l r"
8cb82e7f1743 proper defn of a heap
nipkow
parents:
diff changeset
    65
8cb82e7f1743 proper defn of a heap
nipkow
parents:
diff changeset
    66
interpretation Heap insert del_min
8cb82e7f1743 proper defn of a heap
nipkow
parents:
diff changeset
    67
proof(standard, goal_cases)
8cb82e7f1743 proper defn of a heap
nipkow
parents:
diff changeset
    68
  case 1 thus ?case by(simp add:mset_merge)
8cb82e7f1743 proper defn of a heap
nipkow
parents:
diff changeset
    69
next
8cb82e7f1743 proper defn of a heap
nipkow
parents:
diff changeset
    70
  case (2 q) thus ?case by(cases q)(auto simp: mset_merge)
8cb82e7f1743 proper defn of a heap
nipkow
parents:
diff changeset
    71
next
8cb82e7f1743 proper defn of a heap
nipkow
parents:
diff changeset
    72
  case 3 thus ?case by (simp add: invar_merge)
8cb82e7f1743 proper defn of a heap
nipkow
parents:
diff changeset
    73
next
8cb82e7f1743 proper defn of a heap
nipkow
parents:
diff changeset
    74
  case (4 q) thus ?case by (cases q)(auto simp: invar_merge)
8cb82e7f1743 proper defn of a heap
nipkow
parents:
diff changeset
    75
qed
8cb82e7f1743 proper defn of a heap
nipkow
parents:
diff changeset
    76
8cb82e7f1743 proper defn of a heap
nipkow
parents:
diff changeset
    77
sublocale PQM: Priority_Queue_Merge where empty = empty and is_empty = is_empty and insert = insert
8cb82e7f1743 proper defn of a heap
nipkow
parents:
diff changeset
    78
and get_min = "value" and del_min = del_min and invar = heap and mset = mset_tree and merge = merge
8cb82e7f1743 proper defn of a heap
nipkow
parents:
diff changeset
    79
proof(standard, goal_cases)
8cb82e7f1743 proper defn of a heap
nipkow
parents:
diff changeset
    80
  case 1 thus ?case by (simp add: mset_merge)
8cb82e7f1743 proper defn of a heap
nipkow
parents:
diff changeset
    81
next
8cb82e7f1743 proper defn of a heap
nipkow
parents:
diff changeset
    82
  case 2 thus ?case by (simp add: invar_merge)
8cb82e7f1743 proper defn of a heap
nipkow
parents:
diff changeset
    83
qed
8cb82e7f1743 proper defn of a heap
nipkow
parents:
diff changeset
    84
8cb82e7f1743 proper defn of a heap
nipkow
parents:
diff changeset
    85
end
8cb82e7f1743 proper defn of a heap
nipkow
parents:
diff changeset
    86
8cb82e7f1743 proper defn of a heap
nipkow
parents:
diff changeset
    87
end