src/HOL/Data_Structures/Queue_2Lists.thy
author wenzelm
Sat, 28 Nov 2020 15:15:53 +0100
changeset 72755 8dffbe01a3e1
parent 72642 d152890dd17e
child 79138 e6ae63d1b480
permissions -rw-r--r--
support for Scala compile-time positions;
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
72389
3d255ebe9733 Aded Queues
nipkow
parents:
diff changeset
     1
(* Author: Tobias Nipkow *)
3d255ebe9733 Aded Queues
nipkow
parents:
diff changeset
     2
3d255ebe9733 Aded Queues
nipkow
parents:
diff changeset
     3
section \<open>Queue Implementation via 2 Lists\<close>
3d255ebe9733 Aded Queues
nipkow
parents:
diff changeset
     4
3d255ebe9733 Aded Queues
nipkow
parents:
diff changeset
     5
theory Queue_2Lists
72642
d152890dd17e new theory
nipkow
parents: 72544
diff changeset
     6
imports
d152890dd17e new theory
nipkow
parents: 72544
diff changeset
     7
  Queue_Spec
d152890dd17e new theory
nipkow
parents: 72544
diff changeset
     8
  Reverse
72389
3d255ebe9733 Aded Queues
nipkow
parents:
diff changeset
     9
begin
3d255ebe9733 Aded Queues
nipkow
parents:
diff changeset
    10
3d255ebe9733 Aded Queues
nipkow
parents:
diff changeset
    11
text \<open>Definitions:\<close>
3d255ebe9733 Aded Queues
nipkow
parents:
diff changeset
    12
3d255ebe9733 Aded Queues
nipkow
parents:
diff changeset
    13
type_synonym 'a queue = "'a list \<times> 'a list"
3d255ebe9733 Aded Queues
nipkow
parents:
diff changeset
    14
3d255ebe9733 Aded Queues
nipkow
parents:
diff changeset
    15
fun norm :: "'a queue \<Rightarrow> 'a queue" where
72642
d152890dd17e new theory
nipkow
parents: 72544
diff changeset
    16
"norm (fs,rs) = (if fs = [] then (itrev rs [], []) else (fs,rs))"
72389
3d255ebe9733 Aded Queues
nipkow
parents:
diff changeset
    17
3d255ebe9733 Aded Queues
nipkow
parents:
diff changeset
    18
fun enq :: "'a \<Rightarrow> 'a queue \<Rightarrow> 'a queue" where
72499
f3ec4c151ab1 tuned names
nipkow
parents: 72485
diff changeset
    19
"enq a (fs,rs) = norm(fs, a # rs)"
72389
3d255ebe9733 Aded Queues
nipkow
parents:
diff changeset
    20
3d255ebe9733 Aded Queues
nipkow
parents:
diff changeset
    21
fun deq :: "'a queue \<Rightarrow> 'a queue" where
72499
f3ec4c151ab1 tuned names
nipkow
parents: 72485
diff changeset
    22
"deq (fs,rs) = (if fs = [] then (fs,rs) else norm(tl fs,rs))"
72389
3d255ebe9733 Aded Queues
nipkow
parents:
diff changeset
    23
72485
a0066948e7df renamed constant
nipkow
parents: 72389
diff changeset
    24
fun first :: "'a queue \<Rightarrow> 'a" where
72499
f3ec4c151ab1 tuned names
nipkow
parents: 72485
diff changeset
    25
"first (a # fs,rs) = a"
72389
3d255ebe9733 Aded Queues
nipkow
parents:
diff changeset
    26
3d255ebe9733 Aded Queues
nipkow
parents:
diff changeset
    27
fun is_empty :: "'a queue \<Rightarrow> bool" where
72499
f3ec4c151ab1 tuned names
nipkow
parents: 72485
diff changeset
    28
"is_empty (fs,rs) = (fs = [])"
72389
3d255ebe9733 Aded Queues
nipkow
parents:
diff changeset
    29
3d255ebe9733 Aded Queues
nipkow
parents:
diff changeset
    30
fun list :: "'a queue \<Rightarrow> 'a list" where
72499
f3ec4c151ab1 tuned names
nipkow
parents: 72485
diff changeset
    31
"list (fs,rs) = fs @ rev rs"
72389
3d255ebe9733 Aded Queues
nipkow
parents:
diff changeset
    32
3d255ebe9733 Aded Queues
nipkow
parents:
diff changeset
    33
fun invar :: "'a queue \<Rightarrow> bool" where
72499
f3ec4c151ab1 tuned names
nipkow
parents: 72485
diff changeset
    34
"invar (fs,rs) = (fs = [] \<longrightarrow> rs = [])"
72389
3d255ebe9733 Aded Queues
nipkow
parents:
diff changeset
    35
3d255ebe9733 Aded Queues
nipkow
parents:
diff changeset
    36
3d255ebe9733 Aded Queues
nipkow
parents:
diff changeset
    37
text \<open>Implementation correctness:\<close>
3d255ebe9733 Aded Queues
nipkow
parents:
diff changeset
    38
3d255ebe9733 Aded Queues
nipkow
parents:
diff changeset
    39
interpretation Queue
72485
a0066948e7df renamed constant
nipkow
parents: 72389
diff changeset
    40
where empty = "([],[])" and enq = enq and deq = deq and first = first
72389
3d255ebe9733 Aded Queues
nipkow
parents:
diff changeset
    41
and is_empty = is_empty and list = list and invar = invar
3d255ebe9733 Aded Queues
nipkow
parents:
diff changeset
    42
proof (standard, goal_cases)
3d255ebe9733 Aded Queues
nipkow
parents:
diff changeset
    43
  case 1 show ?case by (simp)
3d255ebe9733 Aded Queues
nipkow
parents:
diff changeset
    44
next
3d255ebe9733 Aded Queues
nipkow
parents:
diff changeset
    45
  case (2 q) thus ?case by(cases q) (simp)
3d255ebe9733 Aded Queues
nipkow
parents:
diff changeset
    46
next
72642
d152890dd17e new theory
nipkow
parents: 72544
diff changeset
    47
  case (3 q) thus ?case by(cases q) (simp add: itrev_Nil)
72389
3d255ebe9733 Aded Queues
nipkow
parents:
diff changeset
    48
next
3d255ebe9733 Aded Queues
nipkow
parents:
diff changeset
    49
  case (4 q) thus ?case by(cases q) (auto simp: neq_Nil_conv)
3d255ebe9733 Aded Queues
nipkow
parents:
diff changeset
    50
next
3d255ebe9733 Aded Queues
nipkow
parents:
diff changeset
    51
  case (5 q) thus ?case by(cases q) (auto)
3d255ebe9733 Aded Queues
nipkow
parents:
diff changeset
    52
next
3d255ebe9733 Aded Queues
nipkow
parents:
diff changeset
    53
  case 6 show ?case by(simp)
3d255ebe9733 Aded Queues
nipkow
parents:
diff changeset
    54
next
3d255ebe9733 Aded Queues
nipkow
parents:
diff changeset
    55
  case (7 q) thus ?case by(cases q) (simp)
3d255ebe9733 Aded Queues
nipkow
parents:
diff changeset
    56
next
3d255ebe9733 Aded Queues
nipkow
parents:
diff changeset
    57
  case (8 q) thus ?case by(cases q) (simp)
3d255ebe9733 Aded Queues
nipkow
parents:
diff changeset
    58
qed
3d255ebe9733 Aded Queues
nipkow
parents:
diff changeset
    59
3d255ebe9733 Aded Queues
nipkow
parents:
diff changeset
    60
text \<open>Running times:\<close>
3d255ebe9733 Aded Queues
nipkow
parents:
diff changeset
    61
72544
15aa84226a57 tuned: t -> T
nipkow
parents: 72499
diff changeset
    62
fun T_norm :: "'a queue \<Rightarrow> nat" where
72642
d152890dd17e new theory
nipkow
parents: 72544
diff changeset
    63
"T_norm (fs,rs) = (if fs = [] then T_itrev rs [] else 0) + 1"
72389
3d255ebe9733 Aded Queues
nipkow
parents:
diff changeset
    64
72544
15aa84226a57 tuned: t -> T
nipkow
parents: 72499
diff changeset
    65
fun T_enq :: "'a \<Rightarrow> 'a queue \<Rightarrow> nat" where
15aa84226a57 tuned: t -> T
nipkow
parents: 72499
diff changeset
    66
"T_enq a (fs,rs) = T_norm(fs, a # rs) + 1"
72389
3d255ebe9733 Aded Queues
nipkow
parents:
diff changeset
    67
72544
15aa84226a57 tuned: t -> T
nipkow
parents: 72499
diff changeset
    68
fun T_deq :: "'a queue \<Rightarrow> nat" where
15aa84226a57 tuned: t -> T
nipkow
parents: 72499
diff changeset
    69
"T_deq (fs,rs) = (if fs = [] then 0 else T_norm(tl fs,rs)) + 1"
72389
3d255ebe9733 Aded Queues
nipkow
parents:
diff changeset
    70
72544
15aa84226a57 tuned: t -> T
nipkow
parents: 72499
diff changeset
    71
fun T_first :: "'a queue \<Rightarrow> nat" where
15aa84226a57 tuned: t -> T
nipkow
parents: 72499
diff changeset
    72
"T_first (a # fs,rs) = 1"
72389
3d255ebe9733 Aded Queues
nipkow
parents:
diff changeset
    73
72544
15aa84226a57 tuned: t -> T
nipkow
parents: 72499
diff changeset
    74
fun T_is_empty :: "'a queue \<Rightarrow> nat" where
15aa84226a57 tuned: t -> T
nipkow
parents: 72499
diff changeset
    75
"T_is_empty (fs,rs) = 1"
72389
3d255ebe9733 Aded Queues
nipkow
parents:
diff changeset
    76
3d255ebe9733 Aded Queues
nipkow
parents:
diff changeset
    77
text \<open>Amortized running times:\<close>
3d255ebe9733 Aded Queues
nipkow
parents:
diff changeset
    78
3d255ebe9733 Aded Queues
nipkow
parents:
diff changeset
    79
fun \<Phi> :: "'a queue \<Rightarrow> nat" where
72499
f3ec4c151ab1 tuned names
nipkow
parents: 72485
diff changeset
    80
"\<Phi>(fs,rs) = length rs"
72389
3d255ebe9733 Aded Queues
nipkow
parents:
diff changeset
    81
72642
d152890dd17e new theory
nipkow
parents: 72544
diff changeset
    82
lemma a_enq: "T_enq a (fs,rs) + \<Phi>(enq a (fs,rs)) - \<Phi>(fs,rs) \<le> 4"
d152890dd17e new theory
nipkow
parents: 72544
diff changeset
    83
by(auto simp: T_itrev)
72389
3d255ebe9733 Aded Queues
nipkow
parents:
diff changeset
    84
72642
d152890dd17e new theory
nipkow
parents: 72544
diff changeset
    85
lemma a_deq: "T_deq (fs,rs) + \<Phi>(deq (fs,rs)) - \<Phi>(fs,rs) \<le> 3"
d152890dd17e new theory
nipkow
parents: 72544
diff changeset
    86
by(auto simp: T_itrev)
72389
3d255ebe9733 Aded Queues
nipkow
parents:
diff changeset
    87
3d255ebe9733 Aded Queues
nipkow
parents:
diff changeset
    88
end