| 
72389
 | 
     1  | 
(* Author: Tobias Nipkow *)
  | 
| 
 | 
     2  | 
  | 
| 
 | 
     3  | 
section \<open>Queue Implementation via 2 Lists\<close>
  | 
| 
 | 
     4  | 
  | 
| 
 | 
     5  | 
theory Queue_2Lists
  | 
| 
72642
 | 
     6  | 
imports
  | 
| 
 | 
     7  | 
  Queue_Spec
  | 
| 
 | 
     8  | 
  Reverse
  | 
| 
72389
 | 
     9  | 
begin
  | 
| 
 | 
    10  | 
  | 
| 
 | 
    11  | 
text \<open>Definitions:\<close>
  | 
| 
 | 
    12  | 
  | 
| 
 | 
    13  | 
type_synonym 'a queue = "'a list \<times> 'a list"
  | 
| 
 | 
    14  | 
  | 
| 
 | 
    15  | 
fun norm :: "'a queue \<Rightarrow> 'a queue" where
  | 
| 
72642
 | 
    16  | 
"norm (fs,rs) = (if fs = [] then (itrev rs [], []) else (fs,rs))"
  | 
| 
72389
 | 
    17  | 
  | 
| 
 | 
    18  | 
fun enq :: "'a \<Rightarrow> 'a queue \<Rightarrow> 'a queue" where
  | 
| 
72499
 | 
    19  | 
"enq a (fs,rs) = norm(fs, a # rs)"
  | 
| 
72389
 | 
    20  | 
  | 
| 
 | 
    21  | 
fun deq :: "'a queue \<Rightarrow> 'a queue" where
  | 
| 
72499
 | 
    22  | 
"deq (fs,rs) = (if fs = [] then (fs,rs) else norm(tl fs,rs))"
  | 
| 
72389
 | 
    23  | 
  | 
| 
72485
 | 
    24  | 
fun first :: "'a queue \<Rightarrow> 'a" where
  | 
| 
72499
 | 
    25  | 
"first (a # fs,rs) = a"
  | 
| 
72389
 | 
    26  | 
  | 
| 
 | 
    27  | 
fun is_empty :: "'a queue \<Rightarrow> bool" where
  | 
| 
72499
 | 
    28  | 
"is_empty (fs,rs) = (fs = [])"
  | 
| 
72389
 | 
    29  | 
  | 
| 
 | 
    30  | 
fun list :: "'a queue \<Rightarrow> 'a list" where
  | 
| 
72499
 | 
    31  | 
"list (fs,rs) = fs @ rev rs"
  | 
| 
72389
 | 
    32  | 
  | 
| 
 | 
    33  | 
fun invar :: "'a queue \<Rightarrow> bool" where
  | 
| 
72499
 | 
    34  | 
"invar (fs,rs) = (fs = [] \<longrightarrow> rs = [])"
  | 
| 
72389
 | 
    35  | 
  | 
| 
 | 
    36  | 
  | 
| 
 | 
    37  | 
text \<open>Implementation correctness:\<close>
  | 
| 
 | 
    38  | 
  | 
| 
 | 
    39  | 
interpretation Queue
  | 
| 
72485
 | 
    40  | 
where empty = "([],[])" and enq = enq and deq = deq and first = first
  | 
| 
72389
 | 
    41  | 
and is_empty = is_empty and list = list and invar = invar
  | 
| 
 | 
    42  | 
proof (standard, goal_cases)
  | 
| 
 | 
    43  | 
  case 1 show ?case by (simp)
  | 
| 
 | 
    44  | 
next
  | 
| 
 | 
    45  | 
  case (2 q) thus ?case by(cases q) (simp)
  | 
| 
 | 
    46  | 
next
  | 
| 
72642
 | 
    47  | 
  case (3 q) thus ?case by(cases q) (simp add: itrev_Nil)
  | 
| 
72389
 | 
    48  | 
next
  | 
| 
 | 
    49  | 
  case (4 q) thus ?case by(cases q) (auto simp: neq_Nil_conv)
  | 
| 
 | 
    50  | 
next
  | 
| 
 | 
    51  | 
  case (5 q) thus ?case by(cases q) (auto)
  | 
| 
 | 
    52  | 
next
  | 
| 
 | 
    53  | 
  case 6 show ?case by(simp)
  | 
| 
 | 
    54  | 
next
  | 
| 
 | 
    55  | 
  case (7 q) thus ?case by(cases q) (simp)
  | 
| 
 | 
    56  | 
next
  | 
| 
 | 
    57  | 
  case (8 q) thus ?case by(cases q) (simp)
  | 
| 
 | 
    58  | 
qed
  | 
| 
 | 
    59  | 
  | 
| 
 | 
    60  | 
text \<open>Running times:\<close>
  | 
| 
 | 
    61  | 
  | 
| 
72544
 | 
    62  | 
fun T_norm :: "'a queue \<Rightarrow> nat" where
  | 
| 
72642
 | 
    63  | 
"T_norm (fs,rs) = (if fs = [] then T_itrev rs [] else 0) + 1"
  | 
| 
72389
 | 
    64  | 
  | 
| 
72544
 | 
    65  | 
fun T_enq :: "'a \<Rightarrow> 'a queue \<Rightarrow> nat" where
  | 
| 
 | 
    66  | 
"T_enq a (fs,rs) = T_norm(fs, a # rs) + 1"
  | 
| 
72389
 | 
    67  | 
  | 
| 
72544
 | 
    68  | 
fun T_deq :: "'a queue \<Rightarrow> nat" where
  | 
| 
 | 
    69  | 
"T_deq (fs,rs) = (if fs = [] then 0 else T_norm(tl fs,rs)) + 1"
  | 
| 
72389
 | 
    70  | 
  | 
| 
72544
 | 
    71  | 
fun T_first :: "'a queue \<Rightarrow> nat" where
  | 
| 
 | 
    72  | 
"T_first (a # fs,rs) = 1"
  | 
| 
72389
 | 
    73  | 
  | 
| 
72544
 | 
    74  | 
fun T_is_empty :: "'a queue \<Rightarrow> nat" where
  | 
| 
 | 
    75  | 
"T_is_empty (fs,rs) = 1"
  | 
| 
72389
 | 
    76  | 
  | 
| 
 | 
    77  | 
text \<open>Amortized running times:\<close>
  | 
| 
 | 
    78  | 
  | 
| 
 | 
    79  | 
fun \<Phi> :: "'a queue \<Rightarrow> nat" where
  | 
| 
72499
 | 
    80  | 
"\<Phi>(fs,rs) = length rs"
  | 
| 
72389
 | 
    81  | 
  | 
| 
72642
 | 
    82  | 
lemma a_enq: "T_enq a (fs,rs) + \<Phi>(enq a (fs,rs)) - \<Phi>(fs,rs) \<le> 4"
  | 
| 
 | 
    83  | 
by(auto simp: T_itrev)
  | 
| 
72389
 | 
    84  | 
  | 
| 
72642
 | 
    85  | 
lemma a_deq: "T_deq (fs,rs) + \<Phi>(deq (fs,rs)) - \<Phi>(fs,rs) \<le> 3"
  | 
| 
 | 
    86  | 
by(auto simp: T_itrev)
  | 
| 
72389
 | 
    87  | 
  | 
| 
 | 
    88  | 
end
  |