Exercises/ex12/ex12.thy
author nipkow
Sat, 08 Jul 2017 19:03:42 +0200
changeset 69841 d2283b15d2ca
parent 69840 0c9bba1e8e97
child 69842 985eb3b647ab
permissions -rw-r--r--
.
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
69840
nipkow
parents:
diff changeset
     1
theory ex12
nipkow
parents:
diff changeset
     2
imports Complex_Main
nipkow
parents:
diff changeset
     3
begin
nipkow
parents:
diff changeset
     4
nipkow
parents:
diff changeset
     5
subsection "Uebungsaufgabe"
nipkow
parents:
diff changeset
     6
nipkow
parents:
diff changeset
     7
text \<open>Consider locale \<open>Queue\<close> in file \<open>Thys/Amortized_Examples\<close>. A call of \<open>deq (xs,[])\<close>
nipkow
parents:
diff changeset
     8
requires the reversal of \<open>xs\<close>, which may be very long. We can reduce that impact
nipkow
parents:
diff changeset
     9
by shifting \<open>xs\<close> over to \<open>ys\<close> whenever \<open>length xs > length ys\<close>. This does not improve
nipkow
parents:
diff changeset
    10
the amortized complexity (in fact it increases it by 1) but reduces the worst case complexity
nipkow
parents:
diff changeset
    11
of individual calls of \<open>deq\<close>. Modify local \<open>Queue\<close> as follows:\<close>
nipkow
parents:
diff changeset
    12
nipkow
parents:
diff changeset
    13
locale Queue
nipkow
parents:
diff changeset
    14
begin
nipkow
parents:
diff changeset
    15
nipkow
parents:
diff changeset
    16
type_synonym 'a queue = "'a list * 'a list"
nipkow
parents:
diff changeset
    17
nipkow
parents:
diff changeset
    18
fun balance :: "'a queue \<Rightarrow> 'a queue" where
nipkow
parents:
diff changeset
    19
"balance(xs,ys) = (if size xs \<le> size ys then (xs,ys) else ([], ys @ rev xs))"
nipkow
parents:
diff changeset
    20
nipkow
parents:
diff changeset
    21
fun enq :: "'a \<Rightarrow> 'a queue \<Rightarrow> 'a queue" where
nipkow
parents:
diff changeset
    22
"enq a (xs,ys) = balance (a#xs, ys)"
nipkow
parents:
diff changeset
    23
nipkow
parents:
diff changeset
    24
fun deq :: "'a queue \<Rightarrow> 'a queue" where
nipkow
parents:
diff changeset
    25
"deq (xs,ys) = balance (xs, tl ys)"
nipkow
parents:
diff changeset
    26
69841
nipkow
parents: 69840
diff changeset
    27
text \<open>Note that we assume that the size computation in \<open>balance\<close> only takes constant time.
nipkow
parents: 69840
diff changeset
    28
In reality the time is linear. How would you avoid that?\<close>
nipkow
parents: 69840
diff changeset
    29
69840
nipkow
parents:
diff changeset
    30
fun t_enq :: "'a \<Rightarrow> 'a queue \<Rightarrow> nat" where
nipkow
parents:
diff changeset
    31
"t_enq a (xs,ys) = 1 + (if size xs + 1 \<le> size ys then 0 else size xs + 1 + size ys)"
nipkow
parents:
diff changeset
    32
nipkow
parents:
diff changeset
    33
fun t_deq :: "'a queue \<Rightarrow> nat" where
nipkow
parents:
diff changeset
    34
"t_deq (xs,ys) = (if size xs \<le> size ys - 1 then 0 else size xs + (size ys - 1))"
nipkow
parents:
diff changeset
    35
nipkow
parents:
diff changeset
    36
end
nipkow
parents:
diff changeset
    37
nipkow
parents:
diff changeset
    38
text \<open>You will also have to modify \<open>invar\<close> and \<open>\<Phi>\<close>. In the end you should be able to prove
nipkow
parents:
diff changeset
    39
that the amortized complexity of \<open>enq\<close> is \<open> \<le> 3\<close> and of \<open>deq\<close> is \<open>= 0\<close>.\<close>
nipkow
parents:
diff changeset
    40
nipkow
parents:
diff changeset
    41
(* hide *)
nipkow
parents:
diff changeset
    42
context Queue
nipkow
parents:
diff changeset
    43
begin
nipkow
parents:
diff changeset
    44
nipkow
parents:
diff changeset
    45
definition "init = ([],[])"
nipkow
parents:
diff changeset
    46
nipkow
parents:
diff changeset
    47
fun invar where
nipkow
parents:
diff changeset
    48
"invar (xs,ys) = (size xs \<le> size ys)"
nipkow
parents:
diff changeset
    49
nipkow
parents:
diff changeset
    50
fun \<Phi> :: "'a queue \<Rightarrow> nat" where
nipkow
parents:
diff changeset
    51
"\<Phi> (xs,ys) = 2 * size xs"
nipkow
parents:
diff changeset
    52
nipkow
parents:
diff changeset
    53
lemma "\<Phi> t \<ge> 0"
nipkow
parents:
diff changeset
    54
apply(cases t)
nipkow
parents:
diff changeset
    55
apply(auto)
nipkow
parents:
diff changeset
    56
done
nipkow
parents:
diff changeset
    57
nipkow
parents:
diff changeset
    58
lemma "\<Phi> init = 0"
nipkow
parents:
diff changeset
    59
by(simp add: init_def)
nipkow
parents:
diff changeset
    60
nipkow
parents:
diff changeset
    61
lemma a_enq: "invar q \<Longrightarrow> t_enq a q + \<Phi>(enq a q) - \<Phi> q \<le> 3"
nipkow
parents:
diff changeset
    62
apply(cases q)
nipkow
parents:
diff changeset
    63
apply(auto)
nipkow
parents:
diff changeset
    64
done
nipkow
parents:
diff changeset
    65
nipkow
parents:
diff changeset
    66
lemma a_deq: "invar q \<Longrightarrow> t_deq q + \<Phi>(deq q) - \<Phi> q = 0"
nipkow
parents:
diff changeset
    67
apply(cases q)
nipkow
parents:
diff changeset
    68
apply(auto)
nipkow
parents:
diff changeset
    69
done
nipkow
parents:
diff changeset
    70
nipkow
parents:
diff changeset
    71
end
nipkow
parents:
diff changeset
    72
(* end hide *)
nipkow
parents:
diff changeset
    73
nipkow
parents:
diff changeset
    74
subsection "Homework"
nipkow
parents:
diff changeset
    75
nipkow
parents:
diff changeset
    76
type_synonym tab = "nat \<times> nat"
nipkow
parents:
diff changeset
    77
nipkow
parents:
diff changeset
    78
text \<open>In file \<open>Thys/Amortized_Examples\<close> in the repository there is a formalization
nipkow
parents:
diff changeset
    79
of dynamic tables in locale \<open>Dyn_Tab\<close> with the potential function \<open>\<Phi> (n,l) = 2*n - l\<close>
nipkow
parents:
diff changeset
    80
and a discussion of why this is tricky. The standard definition you find in textbooks
nipkow
parents:
diff changeset
    81
does not rely on cut-off subtraction on \<open>nat\<close> but uses standard real numbers:\<close>
nipkow
parents:
diff changeset
    82
nipkow
parents:
diff changeset
    83
fun \<Phi> :: "tab \<Rightarrow> real" where
nipkow
parents:
diff changeset
    84
"\<Phi> (n,l) = 2*(real n) - real l"
nipkow
parents:
diff changeset
    85
nipkow
parents:
diff changeset
    86
text \<open>Start with the locale \<open>Dyn_Tab\<close> in file \<open>Thys/Amortized_Examples\<close>
nipkow
parents:
diff changeset
    87
but use the above definition of \<open>\<Phi> :: tab \<Rightarrow> real\<close>. A number of proofs will now fail
nipkow
parents:
diff changeset
    88
because the invariant is now too weak.
nipkow
parents:
diff changeset
    89
Find a stronger invariant such that all the proofs work again.\<close>
nipkow
parents:
diff changeset
    90
nipkow
parents:
diff changeset
    91
(* hide *)
nipkow
parents:
diff changeset
    92
locale Dyn_Tab
nipkow
parents:
diff changeset
    93
begin
nipkow
parents:
diff changeset
    94
nipkow
parents:
diff changeset
    95
type_synonym tab = "nat \<times> nat"
nipkow
parents:
diff changeset
    96
nipkow
parents:
diff changeset
    97
fun invar :: "tab \<Rightarrow> bool" where
nipkow
parents:
diff changeset
    98
"invar (n,l) = (n=0 \<and> l = 0 \<or> l < 2*n \<and> n \<le> l)"
nipkow
parents:
diff changeset
    99
nipkow
parents:
diff changeset
   100
definition init :: tab where
nipkow
parents:
diff changeset
   101
"init = (0,0)"
nipkow
parents:
diff changeset
   102
nipkow
parents:
diff changeset
   103
text\<open>Insertion: the element does not matter\<close>
nipkow
parents:
diff changeset
   104
fun ins :: "tab \<Rightarrow> tab" where
nipkow
parents:
diff changeset
   105
"ins (n,l) = (n+1, if n<l then l else if l=0 then 1 else 2*l)"
nipkow
parents:
diff changeset
   106
nipkow
parents:
diff changeset
   107
text\<open>Time: if the table overflows, we count only the time for copying elements\<close>
nipkow
parents:
diff changeset
   108
fun t_ins :: "nat \<times> nat \<Rightarrow> nat" where
nipkow
parents:
diff changeset
   109
"t_ins (n,l) = (if n<l then 1 else n+1)"
nipkow
parents:
diff changeset
   110
nipkow
parents:
diff changeset
   111
lemma "invar init"
nipkow
parents:
diff changeset
   112
by(simp add: init_def)
nipkow
parents:
diff changeset
   113
nipkow
parents:
diff changeset
   114
lemma "invar t \<Longrightarrow> invar(ins t)"
nipkow
parents:
diff changeset
   115
apply(cases t)
nipkow
parents:
diff changeset
   116
apply(auto)
nipkow
parents:
diff changeset
   117
done
nipkow
parents:
diff changeset
   118
nipkow
parents:
diff changeset
   119
fun \<Phi> :: "tab \<Rightarrow> real" where
nipkow
parents:
diff changeset
   120
"\<Phi> (n,l) = 2*(real n) - real l"
nipkow
parents:
diff changeset
   121
nipkow
parents:
diff changeset
   122
lemma "invar t \<Longrightarrow> \<Phi> t \<ge> 0"
nipkow
parents:
diff changeset
   123
apply(cases t)
nipkow
parents:
diff changeset
   124
apply(auto)
nipkow
parents:
diff changeset
   125
done
nipkow
parents:
diff changeset
   126
nipkow
parents:
diff changeset
   127
lemma "\<Phi> init = 0"
nipkow
parents:
diff changeset
   128
by(simp add: init_def)
nipkow
parents:
diff changeset
   129
nipkow
parents:
diff changeset
   130
lemma a_ins: "invar t \<Longrightarrow> t_ins t + \<Phi>(ins t) - \<Phi> t \<le> 3"
nipkow
parents:
diff changeset
   131
apply(cases t)
nipkow
parents:
diff changeset
   132
apply(auto split: if_splits)
nipkow
parents:
diff changeset
   133
done
nipkow
parents:
diff changeset
   134
nipkow
parents:
diff changeset
   135
end
nipkow
parents:
diff changeset
   136
(* end hide *)
nipkow
parents:
diff changeset
   137
nipkow
parents:
diff changeset
   138
end