author | Christian Urban <christian dot urban at kcl dot ac dot uk> |
Fri, 15 Apr 2016 14:44:09 +0100 | |
changeset 124 | 71a3300d497b |
parent 100 | 3d2b59f15f26 |
permissions | -rw-r--r-- |
0
110247f9d47e
added
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
|
1 |
theory Moment |
110247f9d47e
added
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
|
2 |
imports Main |
110247f9d47e
added
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
|
3 |
begin |
110247f9d47e
added
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
|
4 |
|
69
1dc801552dfd
simplified Moment.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
67
diff
changeset
|
5 |
definition moment :: "nat \<Rightarrow> 'a list \<Rightarrow> 'a list" |
1dc801552dfd
simplified Moment.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
67
diff
changeset
|
6 |
where "moment n s = rev (take n (rev s))" |
67 | 7 |
|
70
92ca2410b3d9
further simplificaton of Moment.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
69
diff
changeset
|
8 |
value "moment 3 [0, 1, 2, 3, 4, 5, 6, 7, 8, 9::int]" |
92ca2410b3d9
further simplificaton of Moment.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
69
diff
changeset
|
9 |
value "moment 2 [5, 4, 3, 2, 1, 0::int]" |
0
110247f9d47e
added
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
|
10 |
|
110247f9d47e
added
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
|
11 |
lemma moment_app [simp]: |
69
1dc801552dfd
simplified Moment.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
67
diff
changeset
|
12 |
assumes ile: "i \<le> length s" |
70
92ca2410b3d9
further simplificaton of Moment.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
69
diff
changeset
|
13 |
shows "moment i (s' @ s) = moment i s" |
69
1dc801552dfd
simplified Moment.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
67
diff
changeset
|
14 |
using assms unfolding moment_def by simp |
0
110247f9d47e
added
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
|
15 |
|
70
92ca2410b3d9
further simplificaton of Moment.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
69
diff
changeset
|
16 |
lemma moment_eq [simp]: "moment (length s) (s' @ s) = s" |
69
1dc801552dfd
simplified Moment.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
67
diff
changeset
|
17 |
unfolding moment_def by simp |
0
110247f9d47e
added
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
|
18 |
|
110247f9d47e
added
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
|
19 |
lemma moment_ge [simp]: "length s \<le> n \<Longrightarrow> moment n s = s" |
110247f9d47e
added
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
|
20 |
by (unfold moment_def, simp) |
110247f9d47e
added
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
|
21 |
|
110247f9d47e
added
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
|
22 |
lemma moment_zero [simp]: "moment 0 s = []" |
69
1dc801552dfd
simplified Moment.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
67
diff
changeset
|
23 |
by (simp add:moment_def) |
0
110247f9d47e
added
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
|
24 |
|
74 | 25 |
lemma least_idx: |
26 |
assumes "Q (i::nat)" |
|
27 |
obtains j where "j \<le> i" "Q j" "\<forall> k < j. \<not> Q k" |
|
28 |
using assms |
|
29 |
by (metis ex_least_nat_le le0 not_less0) |
|
30 |
||
31 |
lemma duration_idx: |
|
32 |
assumes "\<not> Q (i::nat)" |
|
33 |
and "Q j" |
|
34 |
and "i \<le> j" |
|
35 |
obtains k where "i \<le> k" "k < j" "\<not> Q k" "\<forall> i'. k < i' \<and> i' \<le> j \<longrightarrow> Q i'" |
|
36 |
proof - |
|
37 |
let ?Q = "\<lambda> t. t \<le> j \<and> \<not> Q (j - t)" |
|
38 |
have "?Q (j - i)" using assms by (simp add: assms(1)) |
|
39 |
from least_idx [of ?Q, OF this] |
|
40 |
obtain l |
|
41 |
where h: "l \<le> j - i" "\<not> Q (j - l)" "\<forall>k<l. \<not> (k \<le> j \<and> \<not> Q (j - k))" |
|
42 |
by metis |
|
43 |
let ?k = "j - l" |
|
44 |
have "i \<le> ?k" using assms(3) h(1) by linarith |
|
45 |
moreover have "?k < j" by (metis assms(2) diff_le_self h(2) le_neq_implies_less) |
|
46 |
moreover have "\<not> Q ?k" by (simp add: h(2)) |
|
47 |
moreover have "\<forall> i'. ?k < i' \<and> i' \<le> j \<longrightarrow> Q i'" |
|
48 |
by (metis diff_diff_cancel diff_le_self diff_less_mono2 h(3) |
|
49 |
less_imp_diff_less not_less) |
|
50 |
ultimately show ?thesis using that by metis |
|
0
110247f9d47e
added
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
|
51 |
qed |
110247f9d47e
added
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
|
52 |
|
74 | 53 |
lemma p_split_gen: |
54 |
assumes "Q s" |
|
55 |
and "\<not> Q (moment k s)" |
|
56 |
shows "(\<exists> i. i < length s \<and> k \<le> i \<and> \<not> Q (moment i s) \<and> (\<forall> i' > i. Q (moment i' s)))" |
|
57 |
proof(cases "k \<le> length s") |
|
58 |
case True |
|
59 |
let ?Q = "\<lambda> t. Q (moment t s)" |
|
60 |
have "?Q (length s)" using assms(1) by simp |
|
61 |
from duration_idx[of ?Q, OF assms(2) this True] |
|
62 |
obtain i where h: "k \<le> i" "i < length s" "\<not> Q (moment i s)" |
|
63 |
"\<forall>i'. i < i' \<and> i' \<le> length s \<longrightarrow> Q (moment i' s)" by metis |
|
64 |
moreover have "(\<forall> i' > i. Q (moment i' s))" using h(4) assms(1) not_less |
|
65 |
by fastforce |
|
66 |
ultimately show ?thesis by metis |
|
67 |
qed (insert assms, auto) |
|
68 |
||
0
110247f9d47e
added
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
|
69 |
lemma p_split: |
74 | 70 |
assumes qs: "Q s" |
71 |
and nq: "\<not> Q []" |
|
72 |
shows "(\<exists> i. i < length s \<and> \<not> Q (moment i s) \<and> (\<forall> i' > i. Q (moment i' s)))" |
|
0
110247f9d47e
added
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
|
73 |
proof - |
110247f9d47e
added
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
|
74 |
from nq have "\<not> Q (moment 0 s)" by simp |
110247f9d47e
added
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
|
75 |
from p_split_gen [of Q s 0, OF qs this] |
74 | 76 |
show ?thesis by auto |
0
110247f9d47e
added
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
|
77 |
qed |
110247f9d47e
added
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
|
78 |
|
71
04caf0ccb3ae
some small change
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
70
diff
changeset
|
79 |
lemma moment_Suc_tl: |
04caf0ccb3ae
some small change
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
70
diff
changeset
|
80 |
assumes "Suc i \<le> length s" |
04caf0ccb3ae
some small change
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
70
diff
changeset
|
81 |
shows "tl (moment (Suc i) s) = moment i s" |
74 | 82 |
using assms |
83 |
by (simp add:moment_def rev_take, |
|
84 |
metis Suc_diff_le diff_Suc_Suc drop_Suc tl_drop) |
|
100 | 85 |
|
86 |
lemma moment_Suc_hd: |
|
87 |
assumes "Suc i \<le> length s" |
|
88 |
shows "hd (moment (Suc i) s) = s!(length s - Suc i)" |
|
89 |
by (simp add:moment_def rev_take, |
|
90 |
subst hd_drop_conv_nth, insert assms, auto) |
|
73 | 91 |
|
71
04caf0ccb3ae
some small change
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
70
diff
changeset
|
92 |
lemma moment_plus: |
04caf0ccb3ae
some small change
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
70
diff
changeset
|
93 |
assumes "Suc i \<le> length s" |
04caf0ccb3ae
some small change
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
70
diff
changeset
|
94 |
shows "(moment (Suc i) s) = (hd (moment (Suc i) s)) # (moment i s)" |
04caf0ccb3ae
some small change
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
70
diff
changeset
|
95 |
proof - |
73 | 96 |
have "(moment (Suc i) s) \<noteq> []" using assms |
97 |
by (simp add:moment_def rev_take) |
|
71
04caf0ccb3ae
some small change
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
70
diff
changeset
|
98 |
hence "(moment (Suc i) s) = (hd (moment (Suc i) s)) # tl (moment (Suc i) s)" |
04caf0ccb3ae
some small change
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
70
diff
changeset
|
99 |
by auto |
04caf0ccb3ae
some small change
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
70
diff
changeset
|
100 |
with moment_Suc_tl[OF assms] |
04caf0ccb3ae
some small change
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
70
diff
changeset
|
101 |
show ?thesis by metis |
0
110247f9d47e
added
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
|
102 |
qed |
110247f9d47e
added
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
|
103 |
|
35
92f61f6a0fe7
added a bit more text to the paper and separated a theory about Max
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
0
diff
changeset
|
104 |
end |
70
92ca2410b3d9
further simplificaton of Moment.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
69
diff
changeset
|
105 |