author | haftmann |
Fri, 05 Feb 2010 14:33:50 +0100 | |
changeset 35028 | 108662d50512 |
parent 34978 | 874150ddd50a |
child 35115 | 446c5063e4fd |
permissions | -rw-r--r-- |
13462 | 1 |
(* Title: HOL/List.thy |
2 |
Author: Tobias Nipkow |
|
923 | 3 |
*) |
4 |
||
13114 | 5 |
header {* The datatype of finite lists *} |
13122 | 6 |
|
15131 | 7 |
theory List |
33593 | 8 |
imports Plain Presburger ATP_Linkup Recdef |
31055
2cf6efca6c71
proper structures for list and string code generation stuff
haftmann
parents:
31048
diff
changeset
|
9 |
uses ("Tools/list_code.ML") |
15131 | 10 |
begin |
923 | 11 |
|
13142 | 12 |
datatype 'a list = |
13366 | 13 |
Nil ("[]") |
14 |
| Cons 'a "'a list" (infixr "#" 65) |
|
923 | 15 |
|
34941 | 16 |
syntax |
17 |
-- {* list Enumeration *} |
|
18 |
"@list" :: "args => 'a list" ("[(_)]") |
|
19 |
||
20 |
translations |
|
21 |
"[x, xs]" == "x#[xs]" |
|
22 |
"[x]" == "x#[]" |
|
23 |
||
15392 | 24 |
subsection{*Basic list processing functions*} |
15302 | 25 |
|
34941 | 26 |
primrec |
27 |
hd :: "'a list \<Rightarrow> 'a" where |
|
28 |
"hd (x # xs) = x" |
|
29 |
||
30 |
primrec |
|
31 |
tl :: "'a list \<Rightarrow> 'a list" where |
|
32 |
"tl [] = []" |
|
33 |
| "tl (x # xs) = xs" |
|
34 |
||
35 |
primrec |
|
36 |
last :: "'a list \<Rightarrow> 'a" where |
|
37 |
"last (x # xs) = (if xs = [] then x else last xs)" |
|
38 |
||
39 |
primrec |
|
40 |
butlast :: "'a list \<Rightarrow> 'a list" where |
|
41 |
"butlast []= []" |
|
42 |
| "butlast (x # xs) = (if xs = [] then [] else x # butlast xs)" |
|
43 |
||
44 |
primrec |
|
45 |
set :: "'a list \<Rightarrow> 'a set" where |
|
46 |
"set [] = {}" |
|
47 |
| "set (x # xs) = insert x (set xs)" |
|
48 |
||
49 |
primrec |
|
50 |
map :: "('a \<Rightarrow> 'b) \<Rightarrow> 'a list \<Rightarrow> 'b list" where |
|
51 |
"map f [] = []" |
|
52 |
| "map f (x # xs) = f x # map f xs" |
|
53 |
||
54 |
primrec |
|
55 |
append :: "'a list \<Rightarrow> 'a list \<Rightarrow> 'a list" (infixr "@" 65) where |
|
56 |
append_Nil:"[] @ ys = ys" |
|
57 |
| append_Cons: "(x#xs) @ ys = x # xs @ ys" |
|
58 |
||
59 |
primrec |
|
60 |
rev :: "'a list \<Rightarrow> 'a list" where |
|
61 |
"rev [] = []" |
|
62 |
| "rev (x # xs) = rev xs @ [x]" |
|
63 |
||
64 |
primrec |
|
65 |
filter:: "('a \<Rightarrow> bool) \<Rightarrow> 'a list \<Rightarrow> 'a list" where |
|
66 |
"filter P [] = []" |
|
67 |
| "filter P (x # xs) = (if P x then x # filter P xs else filter P xs)" |
|
68 |
||
69 |
syntax |
|
70 |
-- {* Special syntax for filter *} |
|
71 |
"@filter" :: "[pttrn, 'a list, bool] => 'a list" ("(1[_<-_./ _])") |
|
72 |
||
73 |
translations |
|
74 |
"[x<-xs . P]"== "CONST filter (%x. P) xs" |
|
75 |
||
76 |
syntax (xsymbols) |
|
77 |
"@filter" :: "[pttrn, 'a list, bool] => 'a list"("(1[_\<leftarrow>_ ./ _])") |
|
78 |
syntax (HTML output) |
|
79 |
"@filter" :: "[pttrn, 'a list, bool] => 'a list"("(1[_\<leftarrow>_ ./ _])") |
|
80 |
||
81 |
primrec |
|
82 |
foldl :: "('b \<Rightarrow> 'a \<Rightarrow> 'b) \<Rightarrow> 'b \<Rightarrow> 'a list \<Rightarrow> 'b" where |
|
83 |
foldl_Nil: "foldl f a [] = a" |
|
84 |
| foldl_Cons: "foldl f a (x # xs) = foldl f (f a x) xs" |
|
85 |
||
86 |
primrec |
|
87 |
foldr :: "('a \<Rightarrow> 'b \<Rightarrow> 'b) \<Rightarrow> 'a list \<Rightarrow> 'b \<Rightarrow> 'b" where |
|
88 |
"foldr f [] a = a" |
|
89 |
| "foldr f (x # xs) a = f x (foldr f xs a)" |
|
90 |
||
91 |
primrec |
|
92 |
concat:: "'a list list \<Rightarrow> 'a list" where |
|
93 |
"concat [] = []" |
|
94 |
| "concat (x # xs) = x @ concat xs" |
|
95 |
||
96 |
primrec (in monoid_add) |
|
97 |
listsum :: "'a list \<Rightarrow> 'a" where |
|
98 |
"listsum [] = 0" |
|
99 |
| "listsum (x # xs) = x + listsum xs" |
|
100 |
||
101 |
primrec |
|
102 |
drop:: "nat \<Rightarrow> 'a list \<Rightarrow> 'a list" where |
|
103 |
drop_Nil: "drop n [] = []" |
|
104 |
| drop_Cons: "drop n (x # xs) = (case n of 0 \<Rightarrow> x # xs | Suc m \<Rightarrow> drop m xs)" |
|
105 |
-- {*Warning: simpset does not contain this definition, but separate |
|
106 |
theorems for @{text "n = 0"} and @{text "n = Suc k"} *} |
|
107 |
||
108 |
primrec |
|
109 |
take:: "nat \<Rightarrow> 'a list \<Rightarrow> 'a list" where |
|
110 |
take_Nil:"take n [] = []" |
|
111 |
| take_Cons: "take n (x # xs) = (case n of 0 \<Rightarrow> [] | Suc m \<Rightarrow> x # take m xs)" |
|
112 |
-- {*Warning: simpset does not contain this definition, but separate |
|
113 |
theorems for @{text "n = 0"} and @{text "n = Suc k"} *} |
|
114 |
||
115 |
primrec |
|
116 |
nth :: "'a list => nat => 'a" (infixl "!" 100) where |
|
117 |
nth_Cons: "(x # xs) ! n = (case n of 0 \<Rightarrow> x | Suc k \<Rightarrow> xs ! k)" |
|
118 |
-- {*Warning: simpset does not contain this definition, but separate |
|
119 |
theorems for @{text "n = 0"} and @{text "n = Suc k"} *} |
|
120 |
||
121 |
primrec |
|
122 |
list_update :: "'a list \<Rightarrow> nat \<Rightarrow> 'a \<Rightarrow> 'a list" where |
|
123 |
"list_update [] i v = []" |
|
124 |
| "list_update (x # xs) i v = (case i of 0 \<Rightarrow> v # xs | Suc j \<Rightarrow> x # list_update xs j v)" |
|
923 | 125 |
|
13146 | 126 |
nonterminals lupdbinds lupdbind |
5077
71043526295f
* HOL/List: new function list_update written xs[i:=v] that updates the i-th
nipkow
parents:
4643
diff
changeset
|
127 |
|
923 | 128 |
syntax |
13366 | 129 |
"_lupdbind":: "['a, 'a] => lupdbind" ("(2_ :=/ _)") |
130 |
"" :: "lupdbind => lupdbinds" ("_") |
|
131 |
"_lupdbinds" :: "[lupdbind, lupdbinds] => lupdbinds" ("_,/ _") |
|
132 |
"_LUpdate" :: "['a, lupdbinds] => 'a" ("_/[(_)]" [900,0] 900) |
|
5077
71043526295f
* HOL/List: new function list_update written xs[i:=v] that updates the i-th
nipkow
parents:
4643
diff
changeset
|
133 |
|
923 | 134 |
translations |
13366 | 135 |
"_LUpdate xs (_lupdbinds b bs)"== "_LUpdate (_LUpdate xs b) bs" |
34941 | 136 |
"xs[i:=x]" == "CONST list_update xs i x" |
137 |
||
138 |
primrec |
|
139 |
takeWhile :: "('a \<Rightarrow> bool) \<Rightarrow> 'a list \<Rightarrow> 'a list" where |
|
140 |
"takeWhile P [] = []" |
|
141 |
| "takeWhile P (x # xs) = (if P x then x # takeWhile P xs else [])" |
|
142 |
||
143 |
primrec |
|
144 |
dropWhile :: "('a \<Rightarrow> bool) \<Rightarrow> 'a list \<Rightarrow> 'a list" where |
|
145 |
"dropWhile P [] = []" |
|
146 |
| "dropWhile P (x # xs) = (if P x then dropWhile P xs else x # xs)" |
|
147 |
||
148 |
primrec |
|
149 |
zip :: "'a list \<Rightarrow> 'b list \<Rightarrow> ('a \<times> 'b) list" where |
|
150 |
"zip xs [] = []" |
|
151 |
| zip_Cons: "zip xs (y # ys) = (case xs of [] => [] | z # zs => (z, y) # zip zs ys)" |
|
152 |
-- {*Warning: simpset does not contain this definition, but separate |
|
153 |
theorems for @{text "xs = []"} and @{text "xs = z # zs"} *} |
|
154 |
||
155 |
primrec |
|
156 |
upt :: "nat \<Rightarrow> nat \<Rightarrow> nat list" ("(1[_..</_'])") where |
|
157 |
upt_0: "[i..<0] = []" |
|
158 |
| upt_Suc: "[i..<(Suc j)] = (if i <= j then [i..<j] @ [j] else [])" |
|
159 |
||
160 |
primrec |
|
161 |
distinct :: "'a list \<Rightarrow> bool" where |
|
162 |
"distinct [] \<longleftrightarrow> True" |
|
163 |
| "distinct (x # xs) \<longleftrightarrow> x \<notin> set xs \<and> distinct xs" |
|
164 |
||
165 |
primrec |
|
166 |
remdups :: "'a list \<Rightarrow> 'a list" where |
|
167 |
"remdups [] = []" |
|
168 |
| "remdups (x # xs) = (if x \<in> set xs then remdups xs else x # remdups xs)" |
|
169 |
||
34978
874150ddd50a
canonical insert operation; generalized lemma foldl_apply_inv to foldl_apply
haftmann
parents:
34942
diff
changeset
|
170 |
definition |
874150ddd50a
canonical insert operation; generalized lemma foldl_apply_inv to foldl_apply
haftmann
parents:
34942
diff
changeset
|
171 |
insert :: "'a \<Rightarrow> 'a list \<Rightarrow> 'a list" where |
874150ddd50a
canonical insert operation; generalized lemma foldl_apply_inv to foldl_apply
haftmann
parents:
34942
diff
changeset
|
172 |
"insert x xs = (if x \<in> set xs then xs else x # xs)" |
874150ddd50a
canonical insert operation; generalized lemma foldl_apply_inv to foldl_apply
haftmann
parents:
34942
diff
changeset
|
173 |
|
874150ddd50a
canonical insert operation; generalized lemma foldl_apply_inv to foldl_apply
haftmann
parents:
34942
diff
changeset
|
174 |
hide (open) const insert hide (open) fact insert_def |
874150ddd50a
canonical insert operation; generalized lemma foldl_apply_inv to foldl_apply
haftmann
parents:
34942
diff
changeset
|
175 |
|
34941 | 176 |
primrec |
177 |
remove1 :: "'a \<Rightarrow> 'a list \<Rightarrow> 'a list" where |
|
178 |
"remove1 x [] = []" |
|
179 |
| "remove1 x (y # xs) = (if x = y then xs else y # remove1 x xs)" |
|
180 |
||
181 |
primrec |
|
182 |
removeAll :: "'a \<Rightarrow> 'a list \<Rightarrow> 'a list" where |
|
183 |
"removeAll x [] = []" |
|
184 |
| "removeAll x (y # xs) = (if x = y then removeAll x xs else y # removeAll x xs)" |
|
185 |
||
186 |
primrec |
|
187 |
replicate :: "nat \<Rightarrow> 'a \<Rightarrow> 'a list" where |
|
188 |
replicate_0: "replicate 0 x = []" |
|
189 |
| replicate_Suc: "replicate (Suc n) x = x # replicate n x" |
|
3342
ec3b55fcb165
New operator "lists" for formalizing sets of lists
paulson
parents:
3320
diff
changeset
|
190 |
|
13142 | 191 |
text {* |
14589 | 192 |
Function @{text size} is overloaded for all datatypes. Users may |
13366 | 193 |
refer to the list version as @{text length}. *} |
13142 | 194 |
|
19363 | 195 |
abbreviation |
34941 | 196 |
length :: "'a list \<Rightarrow> nat" where |
197 |
"length \<equiv> size" |
|
15307 | 198 |
|
21061
580dfc999ef6
added normal post setup; cleaned up "execution" constants
haftmann
parents:
21046
diff
changeset
|
199 |
definition |
21404
eb85850d3eb7
more robust syntax for definition/abbreviation/notation;
wenzelm
parents:
21211
diff
changeset
|
200 |
rotate1 :: "'a list \<Rightarrow> 'a list" where |
eb85850d3eb7
more robust syntax for definition/abbreviation/notation;
wenzelm
parents:
21211
diff
changeset
|
201 |
"rotate1 xs = (case xs of [] \<Rightarrow> [] | x#xs \<Rightarrow> xs @ [x])" |
eb85850d3eb7
more robust syntax for definition/abbreviation/notation;
wenzelm
parents:
21211
diff
changeset
|
202 |
|
eb85850d3eb7
more robust syntax for definition/abbreviation/notation;
wenzelm
parents:
21211
diff
changeset
|
203 |
definition |
eb85850d3eb7
more robust syntax for definition/abbreviation/notation;
wenzelm
parents:
21211
diff
changeset
|
204 |
rotate :: "nat \<Rightarrow> 'a list \<Rightarrow> 'a list" where |
30971 | 205 |
"rotate n = rotate1 ^^ n" |
21404
eb85850d3eb7
more robust syntax for definition/abbreviation/notation;
wenzelm
parents:
21211
diff
changeset
|
206 |
|
eb85850d3eb7
more robust syntax for definition/abbreviation/notation;
wenzelm
parents:
21211
diff
changeset
|
207 |
definition |
eb85850d3eb7
more robust syntax for definition/abbreviation/notation;
wenzelm
parents:
21211
diff
changeset
|
208 |
list_all2 :: "('a => 'b => bool) => 'a list => 'b list => bool" where |
28562 | 209 |
[code del]: "list_all2 P xs ys = |
21061
580dfc999ef6
added normal post setup; cleaned up "execution" constants
haftmann
parents:
21046
diff
changeset
|
210 |
(length xs = length ys \<and> (\<forall>(x, y) \<in> set (zip xs ys). P x y))" |
21404
eb85850d3eb7
more robust syntax for definition/abbreviation/notation;
wenzelm
parents:
21211
diff
changeset
|
211 |
|
eb85850d3eb7
more robust syntax for definition/abbreviation/notation;
wenzelm
parents:
21211
diff
changeset
|
212 |
definition |
eb85850d3eb7
more robust syntax for definition/abbreviation/notation;
wenzelm
parents:
21211
diff
changeset
|
213 |
sublist :: "'a list => nat set => 'a list" where |
eb85850d3eb7
more robust syntax for definition/abbreviation/notation;
wenzelm
parents:
21211
diff
changeset
|
214 |
"sublist xs A = map fst (filter (\<lambda>p. snd p \<in> A) (zip xs [0..<size xs]))" |
17086 | 215 |
|
216 |
primrec |
|
34941 | 217 |
splice :: "'a list \<Rightarrow> 'a list \<Rightarrow> 'a list" where |
218 |
"splice [] ys = ys" |
|
219 |
| "splice (x # xs) ys = (if ys = [] then x # xs else x # hd ys # splice xs (tl ys))" |
|
21061
580dfc999ef6
added normal post setup; cleaned up "execution" constants
haftmann
parents:
21046
diff
changeset
|
220 |
-- {*Warning: simpset does not contain the second eqn but a derived one. *} |
580dfc999ef6
added normal post setup; cleaned up "execution" constants
haftmann
parents:
21046
diff
changeset
|
221 |
|
26771 | 222 |
text{* |
223 |
\begin{figure}[htbp] |
|
224 |
\fbox{ |
|
225 |
\begin{tabular}{l} |
|
27381 | 226 |
@{lemma "[a,b]@[c,d] = [a,b,c,d]" by simp}\\ |
227 |
@{lemma "length [a,b,c] = 3" by simp}\\ |
|
228 |
@{lemma "set [a,b,c] = {a,b,c}" by simp}\\ |
|
229 |
@{lemma "map f [a,b,c] = [f a, f b, f c]" by simp}\\ |
|
230 |
@{lemma "rev [a,b,c] = [c,b,a]" by simp}\\ |
|
231 |
@{lemma "hd [a,b,c,d] = a" by simp}\\ |
|
232 |
@{lemma "tl [a,b,c,d] = [b,c,d]" by simp}\\ |
|
233 |
@{lemma "last [a,b,c,d] = d" by simp}\\ |
|
234 |
@{lemma "butlast [a,b,c,d] = [a,b,c]" by simp}\\ |
|
235 |
@{lemma[source] "filter (\<lambda>n::nat. n<2) [0,2,1] = [0,1]" by simp}\\ |
|
236 |
@{lemma "concat [[a,b],[c,d,e],[],[f]] = [a,b,c,d,e,f]" by simp}\\ |
|
237 |
@{lemma "foldl f x [a,b,c] = f (f (f x a) b) c" by simp}\\ |
|
238 |
@{lemma "foldr f [a,b,c] x = f a (f b (f c x))" by simp}\\ |
|
239 |
@{lemma "zip [a,b,c] [x,y,z] = [(a,x),(b,y),(c,z)]" by simp}\\ |
|
240 |
@{lemma "zip [a,b] [x,y,z] = [(a,x),(b,y)]" by simp}\\ |
|
241 |
@{lemma "splice [a,b,c] [x,y,z] = [a,x,b,y,c,z]" by simp}\\ |
|
242 |
@{lemma "splice [a,b,c,d] [x,y] = [a,x,b,y,c,d]" by simp}\\ |
|
243 |
@{lemma "take 2 [a,b,c,d] = [a,b]" by simp}\\ |
|
244 |
@{lemma "take 6 [a,b,c,d] = [a,b,c,d]" by simp}\\ |
|
245 |
@{lemma "drop 2 [a,b,c,d] = [c,d]" by simp}\\ |
|
246 |
@{lemma "drop 6 [a,b,c,d] = []" by simp}\\ |
|
247 |
@{lemma "takeWhile (%n::nat. n<3) [1,2,3,0] = [1,2]" by simp}\\ |
|
248 |
@{lemma "dropWhile (%n::nat. n<3) [1,2,3,0] = [3,0]" by simp}\\ |
|
249 |
@{lemma "distinct [2,0,1::nat]" by simp}\\ |
|
250 |
@{lemma "remdups [2,0,2,1::nat,2] = [0,1,2]" by simp}\\ |
|
34978
874150ddd50a
canonical insert operation; generalized lemma foldl_apply_inv to foldl_apply
haftmann
parents:
34942
diff
changeset
|
251 |
@{lemma "List.insert 2 [0::nat,1,2] = [0,1,2]" by (simp add: List.insert_def)}\\ |
874150ddd50a
canonical insert operation; generalized lemma foldl_apply_inv to foldl_apply
haftmann
parents:
34942
diff
changeset
|
252 |
@{lemma "List.insert 3 [0::nat,1,2] = [3, 0,1,2]" by (simp add: List.insert_def)}\\ |
27381 | 253 |
@{lemma "remove1 2 [2,0,2,1::nat,2] = [0,2,1,2]" by simp}\\ |
27693 | 254 |
@{lemma "removeAll 2 [2,0,2,1::nat,2] = [0,1]" by simp}\\ |
27381 | 255 |
@{lemma "nth [a,b,c,d] 2 = c" by simp}\\ |
256 |
@{lemma "[a,b,c,d][2 := x] = [a,b,x,d]" by simp}\\ |
|
257 |
@{lemma "sublist [a,b,c,d,e] {0,2,3} = [a,c,d]" by (simp add:sublist_def)}\\ |
|
258 |
@{lemma "rotate1 [a,b,c,d] = [b,c,d,a]" by (simp add:rotate1_def)}\\ |
|
259 |
@{lemma "rotate 3 [a,b,c,d] = [d,a,b,c]" by (simp add:rotate1_def rotate_def nat_number)}\\ |
|
260 |
@{lemma "replicate 4 a = [a,a,a,a]" by (simp add:nat_number)}\\ |
|
261 |
@{lemma "[2..<5] = [2,3,4]" by (simp add:nat_number)}\\ |
|
262 |
@{lemma "listsum [1,2,3::nat] = 6" by simp} |
|
26771 | 263 |
\end{tabular}} |
264 |
\caption{Characteristic examples} |
|
265 |
\label{fig:Characteristic} |
|
266 |
\end{figure} |
|
29927 | 267 |
Figure~\ref{fig:Characteristic} shows characteristic examples |
26771 | 268 |
that should give an intuitive understanding of the above functions. |
269 |
*} |
|
270 |
||
24616 | 271 |
text{* The following simple sort functions are intended for proofs, |
272 |
not for efficient implementations. *} |
|
273 |
||
25221
5ded95dda5df
append/member: more light-weight way to declare authentic syntax;
wenzelm
parents:
25215
diff
changeset
|
274 |
context linorder |
5ded95dda5df
append/member: more light-weight way to declare authentic syntax;
wenzelm
parents:
25215
diff
changeset
|
275 |
begin |
5ded95dda5df
append/member: more light-weight way to declare authentic syntax;
wenzelm
parents:
25215
diff
changeset
|
276 |
|
5ded95dda5df
append/member: more light-weight way to declare authentic syntax;
wenzelm
parents:
25215
diff
changeset
|
277 |
fun sorted :: "'a list \<Rightarrow> bool" where |
24697 | 278 |
"sorted [] \<longleftrightarrow> True" | |
279 |
"sorted [x] \<longleftrightarrow> True" | |
|
25062 | 280 |
"sorted (x#y#zs) \<longleftrightarrow> x <= y \<and> sorted (y#zs)" |
24697 | 281 |
|
33639
603320b93668
New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents:
33593
diff
changeset
|
282 |
primrec insort_key :: "('b \<Rightarrow> 'a) \<Rightarrow> 'b \<Rightarrow> 'b list \<Rightarrow> 'b list" where |
603320b93668
New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents:
33593
diff
changeset
|
283 |
"insort_key f x [] = [x]" | |
603320b93668
New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents:
33593
diff
changeset
|
284 |
"insort_key f x (y#ys) = (if f x \<le> f y then (x#y#ys) else y#(insort_key f x ys))" |
603320b93668
New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents:
33593
diff
changeset
|
285 |
|
603320b93668
New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents:
33593
diff
changeset
|
286 |
primrec sort_key :: "('b \<Rightarrow> 'a) \<Rightarrow> 'b list \<Rightarrow> 'b list" where |
603320b93668
New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents:
33593
diff
changeset
|
287 |
"sort_key f [] = []" | |
603320b93668
New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents:
33593
diff
changeset
|
288 |
"sort_key f (x#xs) = insort_key f x (sort_key f xs)" |
603320b93668
New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents:
33593
diff
changeset
|
289 |
|
603320b93668
New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents:
33593
diff
changeset
|
290 |
abbreviation "sort \<equiv> sort_key (\<lambda>x. x)" |
603320b93668
New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents:
33593
diff
changeset
|
291 |
abbreviation "insort \<equiv> insort_key (\<lambda>x. x)" |
24616 | 292 |
|
25221
5ded95dda5df
append/member: more light-weight way to declare authentic syntax;
wenzelm
parents:
25215
diff
changeset
|
293 |
end |
5ded95dda5df
append/member: more light-weight way to declare authentic syntax;
wenzelm
parents:
25215
diff
changeset
|
294 |
|
24616 | 295 |
|
23388 | 296 |
subsubsection {* List comprehension *} |
23192 | 297 |
|
24349 | 298 |
text{* Input syntax for Haskell-like list comprehension notation. |
299 |
Typical example: @{text"[(x,y). x \<leftarrow> xs, y \<leftarrow> ys, x \<noteq> y]"}, |
|
300 |
the list of all pairs of distinct elements from @{text xs} and @{text ys}. |
|
301 |
The syntax is as in Haskell, except that @{text"|"} becomes a dot |
|
302 |
(like in Isabelle's set comprehension): @{text"[e. x \<leftarrow> xs, \<dots>]"} rather than |
|
303 |
\verb![e| x <- xs, ...]!. |
|
304 |
||
305 |
The qualifiers after the dot are |
|
306 |
\begin{description} |
|
307 |
\item[generators] @{text"p \<leftarrow> xs"}, |
|
24476
f7ad9fbbeeaa
turned list comprehension translations into ML to optimize base case
nipkow
parents:
24471
diff
changeset
|
308 |
where @{text p} is a pattern and @{text xs} an expression of list type, or |
f7ad9fbbeeaa
turned list comprehension translations into ML to optimize base case
nipkow
parents:
24471
diff
changeset
|
309 |
\item[guards] @{text"b"}, where @{text b} is a boolean expression. |
f7ad9fbbeeaa
turned list comprehension translations into ML to optimize base case
nipkow
parents:
24471
diff
changeset
|
310 |
%\item[local bindings] @ {text"let x = e"}. |
24349 | 311 |
\end{description} |
23240 | 312 |
|
24476
f7ad9fbbeeaa
turned list comprehension translations into ML to optimize base case
nipkow
parents:
24471
diff
changeset
|
313 |
Just like in Haskell, list comprehension is just a shorthand. To avoid |
f7ad9fbbeeaa
turned list comprehension translations into ML to optimize base case
nipkow
parents:
24471
diff
changeset
|
314 |
misunderstandings, the translation into desugared form is not reversed |
f7ad9fbbeeaa
turned list comprehension translations into ML to optimize base case
nipkow
parents:
24471
diff
changeset
|
315 |
upon output. Note that the translation of @{text"[e. x \<leftarrow> xs]"} is |
f7ad9fbbeeaa
turned list comprehension translations into ML to optimize base case
nipkow
parents:
24471
diff
changeset
|
316 |
optmized to @{term"map (%x. e) xs"}. |
23240 | 317 |
|
24349 | 318 |
It is easy to write short list comprehensions which stand for complex |
319 |
expressions. During proofs, they may become unreadable (and |
|
320 |
mangled). In such cases it can be advisable to introduce separate |
|
321 |
definitions for the list comprehensions in question. *} |
|
322 |
||
23209 | 323 |
(* |
23240 | 324 |
Proper theorem proving support would be nice. For example, if |
23192 | 325 |
@{text"set[f x y. x \<leftarrow> xs, y \<leftarrow> ys, P x y]"} |
326 |
produced something like |
|
23209 | 327 |
@{term"{z. EX x: set xs. EX y:set ys. P x y \<and> z = f x y}"}. |
328 |
*) |
|
329 |
||
23240 | 330 |
nonterminals lc_qual lc_quals |
23192 | 331 |
|
332 |
syntax |
|
23240 | 333 |
"_listcompr" :: "'a \<Rightarrow> lc_qual \<Rightarrow> lc_quals \<Rightarrow> 'a list" ("[_ . __") |
24349 | 334 |
"_lc_gen" :: "'a \<Rightarrow> 'a list \<Rightarrow> lc_qual" ("_ <- _") |
23240 | 335 |
"_lc_test" :: "bool \<Rightarrow> lc_qual" ("_") |
24476
f7ad9fbbeeaa
turned list comprehension translations into ML to optimize base case
nipkow
parents:
24471
diff
changeset
|
336 |
(*"_lc_let" :: "letbinds => lc_qual" ("let _")*) |
23240 | 337 |
"_lc_end" :: "lc_quals" ("]") |
338 |
"_lc_quals" :: "lc_qual \<Rightarrow> lc_quals \<Rightarrow> lc_quals" (", __") |
|
24349 | 339 |
"_lc_abs" :: "'a => 'b list => 'b list" |
23192 | 340 |
|
24476
f7ad9fbbeeaa
turned list comprehension translations into ML to optimize base case
nipkow
parents:
24471
diff
changeset
|
341 |
(* These are easier than ML code but cannot express the optimized |
f7ad9fbbeeaa
turned list comprehension translations into ML to optimize base case
nipkow
parents:
24471
diff
changeset
|
342 |
translation of [e. p<-xs] |
23192 | 343 |
translations |
24349 | 344 |
"[e. p<-xs]" => "concat(map (_lc_abs p [e]) xs)" |
23240 | 345 |
"_listcompr e (_lc_gen p xs) (_lc_quals Q Qs)" |
24349 | 346 |
=> "concat (map (_lc_abs p (_listcompr e Q Qs)) xs)" |
23240 | 347 |
"[e. P]" => "if P then [e] else []" |
348 |
"_listcompr e (_lc_test P) (_lc_quals Q Qs)" |
|
349 |
=> "if P then (_listcompr e Q Qs) else []" |
|
24349 | 350 |
"_listcompr e (_lc_let b) (_lc_quals Q Qs)" |
351 |
=> "_Let b (_listcompr e Q Qs)" |
|
24476
f7ad9fbbeeaa
turned list comprehension translations into ML to optimize base case
nipkow
parents:
24471
diff
changeset
|
352 |
*) |
23240 | 353 |
|
23279
e39dd93161d9
tuned list comprehension, changed filter syntax from : to <-
nipkow
parents:
23246
diff
changeset
|
354 |
syntax (xsymbols) |
24349 | 355 |
"_lc_gen" :: "'a \<Rightarrow> 'a list \<Rightarrow> lc_qual" ("_ \<leftarrow> _") |
23279
e39dd93161d9
tuned list comprehension, changed filter syntax from : to <-
nipkow
parents:
23246
diff
changeset
|
356 |
syntax (HTML output) |
24349 | 357 |
"_lc_gen" :: "'a \<Rightarrow> 'a list \<Rightarrow> lc_qual" ("_ \<leftarrow> _") |
358 |
||
359 |
parse_translation (advanced) {* |
|
360 |
let |
|
24476
f7ad9fbbeeaa
turned list comprehension translations into ML to optimize base case
nipkow
parents:
24471
diff
changeset
|
361 |
val NilC = Syntax.const @{const_name Nil}; |
f7ad9fbbeeaa
turned list comprehension translations into ML to optimize base case
nipkow
parents:
24471
diff
changeset
|
362 |
val ConsC = Syntax.const @{const_name Cons}; |
f7ad9fbbeeaa
turned list comprehension translations into ML to optimize base case
nipkow
parents:
24471
diff
changeset
|
363 |
val mapC = Syntax.const @{const_name map}; |
f7ad9fbbeeaa
turned list comprehension translations into ML to optimize base case
nipkow
parents:
24471
diff
changeset
|
364 |
val concatC = Syntax.const @{const_name concat}; |
f7ad9fbbeeaa
turned list comprehension translations into ML to optimize base case
nipkow
parents:
24471
diff
changeset
|
365 |
val IfC = Syntax.const @{const_name If}; |
f7ad9fbbeeaa
turned list comprehension translations into ML to optimize base case
nipkow
parents:
24471
diff
changeset
|
366 |
fun singl x = ConsC $ x $ NilC; |
f7ad9fbbeeaa
turned list comprehension translations into ML to optimize base case
nipkow
parents:
24471
diff
changeset
|
367 |
|
f7ad9fbbeeaa
turned list comprehension translations into ML to optimize base case
nipkow
parents:
24471
diff
changeset
|
368 |
fun pat_tr ctxt p e opti = (* %x. case x of p => e | _ => [] *) |
24349 | 369 |
let |
29281 | 370 |
val x = Free (Name.variant (fold Term.add_free_names [p, e] []) "x", dummyT); |
24476
f7ad9fbbeeaa
turned list comprehension translations into ML to optimize base case
nipkow
parents:
24471
diff
changeset
|
371 |
val e = if opti then singl e else e; |
f7ad9fbbeeaa
turned list comprehension translations into ML to optimize base case
nipkow
parents:
24471
diff
changeset
|
372 |
val case1 = Syntax.const "_case1" $ p $ e; |
24349 | 373 |
val case2 = Syntax.const "_case1" $ Syntax.const Term.dummy_patternN |
24476
f7ad9fbbeeaa
turned list comprehension translations into ML to optimize base case
nipkow
parents:
24471
diff
changeset
|
374 |
$ NilC; |
24349 | 375 |
val cs = Syntax.const "_case2" $ case1 $ case2 |
33968
f94fb13ecbb3
modernized structures and tuned headers of datatype package modules; joined former datatype.ML and datatype_rep_proofs.ML
haftmann
parents:
33640
diff
changeset
|
376 |
val ft = Datatype_Case.case_tr false Datatype.info_of_constr |
24349 | 377 |
ctxt [x, cs] |
378 |
in lambda x ft end; |
|
379 |
||
24476
f7ad9fbbeeaa
turned list comprehension translations into ML to optimize base case
nipkow
parents:
24471
diff
changeset
|
380 |
fun abs_tr ctxt (p as Free(s,T)) e opti = |
24349 | 381 |
let val thy = ProofContext.theory_of ctxt; |
382 |
val s' = Sign.intern_const thy s |
|
24476
f7ad9fbbeeaa
turned list comprehension translations into ML to optimize base case
nipkow
parents:
24471
diff
changeset
|
383 |
in if Sign.declared_const thy s' |
f7ad9fbbeeaa
turned list comprehension translations into ML to optimize base case
nipkow
parents:
24471
diff
changeset
|
384 |
then (pat_tr ctxt p e opti, false) |
f7ad9fbbeeaa
turned list comprehension translations into ML to optimize base case
nipkow
parents:
24471
diff
changeset
|
385 |
else (lambda p e, true) |
24349 | 386 |
end |
24476
f7ad9fbbeeaa
turned list comprehension translations into ML to optimize base case
nipkow
parents:
24471
diff
changeset
|
387 |
| abs_tr ctxt p e opti = (pat_tr ctxt p e opti, false); |
f7ad9fbbeeaa
turned list comprehension translations into ML to optimize base case
nipkow
parents:
24471
diff
changeset
|
388 |
|
f7ad9fbbeeaa
turned list comprehension translations into ML to optimize base case
nipkow
parents:
24471
diff
changeset
|
389 |
fun lc_tr ctxt [e, Const("_lc_test",_)$b, qs] = |
f7ad9fbbeeaa
turned list comprehension translations into ML to optimize base case
nipkow
parents:
24471
diff
changeset
|
390 |
let val res = case qs of Const("_lc_end",_) => singl e |
f7ad9fbbeeaa
turned list comprehension translations into ML to optimize base case
nipkow
parents:
24471
diff
changeset
|
391 |
| Const("_lc_quals",_)$q$qs => lc_tr ctxt [e,q,qs]; |
f7ad9fbbeeaa
turned list comprehension translations into ML to optimize base case
nipkow
parents:
24471
diff
changeset
|
392 |
in IfC $ b $ res $ NilC end |
f7ad9fbbeeaa
turned list comprehension translations into ML to optimize base case
nipkow
parents:
24471
diff
changeset
|
393 |
| lc_tr ctxt [e, Const("_lc_gen",_) $ p $ es, Const("_lc_end",_)] = |
f7ad9fbbeeaa
turned list comprehension translations into ML to optimize base case
nipkow
parents:
24471
diff
changeset
|
394 |
(case abs_tr ctxt p e true of |
f7ad9fbbeeaa
turned list comprehension translations into ML to optimize base case
nipkow
parents:
24471
diff
changeset
|
395 |
(f,true) => mapC $ f $ es |
f7ad9fbbeeaa
turned list comprehension translations into ML to optimize base case
nipkow
parents:
24471
diff
changeset
|
396 |
| (f, false) => concatC $ (mapC $ f $ es)) |
f7ad9fbbeeaa
turned list comprehension translations into ML to optimize base case
nipkow
parents:
24471
diff
changeset
|
397 |
| lc_tr ctxt [e, Const("_lc_gen",_) $ p $ es, Const("_lc_quals",_)$q$qs] = |
f7ad9fbbeeaa
turned list comprehension translations into ML to optimize base case
nipkow
parents:
24471
diff
changeset
|
398 |
let val e' = lc_tr ctxt [e,q,qs]; |
f7ad9fbbeeaa
turned list comprehension translations into ML to optimize base case
nipkow
parents:
24471
diff
changeset
|
399 |
in concatC $ (mapC $ (fst(abs_tr ctxt p e' false)) $ es) end |
f7ad9fbbeeaa
turned list comprehension translations into ML to optimize base case
nipkow
parents:
24471
diff
changeset
|
400 |
|
f7ad9fbbeeaa
turned list comprehension translations into ML to optimize base case
nipkow
parents:
24471
diff
changeset
|
401 |
in [("_listcompr", lc_tr)] end |
24349 | 402 |
*} |
23279
e39dd93161d9
tuned list comprehension, changed filter syntax from : to <-
nipkow
parents:
23246
diff
changeset
|
403 |
|
23240 | 404 |
(* |
405 |
term "[(x,y,z). b]" |
|
24476
f7ad9fbbeeaa
turned list comprehension translations into ML to optimize base case
nipkow
parents:
24471
diff
changeset
|
406 |
term "[(x,y,z). x\<leftarrow>xs]" |
f7ad9fbbeeaa
turned list comprehension translations into ML to optimize base case
nipkow
parents:
24471
diff
changeset
|
407 |
term "[e x y. x\<leftarrow>xs, y\<leftarrow>ys]" |
f7ad9fbbeeaa
turned list comprehension translations into ML to optimize base case
nipkow
parents:
24471
diff
changeset
|
408 |
term "[(x,y,z). x<a, x>b]" |
f7ad9fbbeeaa
turned list comprehension translations into ML to optimize base case
nipkow
parents:
24471
diff
changeset
|
409 |
term "[(x,y,z). x\<leftarrow>xs, x>b]" |
f7ad9fbbeeaa
turned list comprehension translations into ML to optimize base case
nipkow
parents:
24471
diff
changeset
|
410 |
term "[(x,y,z). x<a, x\<leftarrow>xs]" |
24349 | 411 |
term "[(x,y). Cons True x \<leftarrow> xs]" |
412 |
term "[(x,y,z). Cons x [] \<leftarrow> xs]" |
|
23240 | 413 |
term "[(x,y,z). x<a, x>b, x=d]" |
414 |
term "[(x,y,z). x<a, x>b, y\<leftarrow>ys]" |
|
415 |
term "[(x,y,z). x<a, x\<leftarrow>xs,y>b]" |
|
416 |
term "[(x,y,z). x<a, x\<leftarrow>xs, y\<leftarrow>ys]" |
|
417 |
term "[(x,y,z). x\<leftarrow>xs, x>b, y<a]" |
|
418 |
term "[(x,y,z). x\<leftarrow>xs, x>b, y\<leftarrow>ys]" |
|
419 |
term "[(x,y,z). x\<leftarrow>xs, y\<leftarrow>ys,y>x]" |
|
420 |
term "[(x,y,z). x\<leftarrow>xs, y\<leftarrow>ys,z\<leftarrow>zs]" |
|
24349 | 421 |
term "[(x,y). x\<leftarrow>xs, let xx = x+x, y\<leftarrow>ys, y \<noteq> xx]" |
23192 | 422 |
*) |
423 |
||
21061
580dfc999ef6
added normal post setup; cleaned up "execution" constants
haftmann
parents:
21046
diff
changeset
|
424 |
subsubsection {* @{const Nil} and @{const Cons} *} |
580dfc999ef6
added normal post setup; cleaned up "execution" constants
haftmann
parents:
21046
diff
changeset
|
425 |
|
580dfc999ef6
added normal post setup; cleaned up "execution" constants
haftmann
parents:
21046
diff
changeset
|
426 |
lemma not_Cons_self [simp]: |
580dfc999ef6
added normal post setup; cleaned up "execution" constants
haftmann
parents:
21046
diff
changeset
|
427 |
"xs \<noteq> x # xs" |
13145 | 428 |
by (induct xs) auto |
13114 | 429 |
|
13142 | 430 |
lemmas not_Cons_self2 [simp] = not_Cons_self [symmetric] |
13114 | 431 |
|
13142 | 432 |
lemma neq_Nil_conv: "(xs \<noteq> []) = (\<exists>y ys. xs = y # ys)" |
13145 | 433 |
by (induct xs) auto |
13114 | 434 |
|
13142 | 435 |
lemma length_induct: |
21061
580dfc999ef6
added normal post setup; cleaned up "execution" constants
haftmann
parents:
21046
diff
changeset
|
436 |
"(\<And>xs. \<forall>ys. length ys < length xs \<longrightarrow> P ys \<Longrightarrow> P xs) \<Longrightarrow> P xs" |
17589 | 437 |
by (rule measure_induct [of length]) iprover |
13114 | 438 |
|
439 |
||
21061
580dfc999ef6
added normal post setup; cleaned up "execution" constants
haftmann
parents:
21046
diff
changeset
|
440 |
subsubsection {* @{const length} *} |
13114 | 441 |
|
13142 | 442 |
text {* |
21061
580dfc999ef6
added normal post setup; cleaned up "execution" constants
haftmann
parents:
21046
diff
changeset
|
443 |
Needs to come before @{text "@"} because of theorem @{text |
580dfc999ef6
added normal post setup; cleaned up "execution" constants
haftmann
parents:
21046
diff
changeset
|
444 |
append_eq_append_conv}. |
13142 | 445 |
*} |
13114 | 446 |
|
13142 | 447 |
lemma length_append [simp]: "length (xs @ ys) = length xs + length ys" |
13145 | 448 |
by (induct xs) auto |
13114 | 449 |
|
13142 | 450 |
lemma length_map [simp]: "length (map f xs) = length xs" |
13145 | 451 |
by (induct xs) auto |
13114 | 452 |
|
13142 | 453 |
lemma length_rev [simp]: "length (rev xs) = length xs" |
13145 | 454 |
by (induct xs) auto |
13114 | 455 |
|
13142 | 456 |
lemma length_tl [simp]: "length (tl xs) = length xs - 1" |
13145 | 457 |
by (cases xs) auto |
13114 | 458 |
|
13142 | 459 |
lemma length_0_conv [iff]: "(length xs = 0) = (xs = [])" |
13145 | 460 |
by (induct xs) auto |
13114 | 461 |
|
13142 | 462 |
lemma length_greater_0_conv [iff]: "(0 < length xs) = (xs \<noteq> [])" |
13145 | 463 |
by (induct xs) auto |
13114 | 464 |
|
23479 | 465 |
lemma length_pos_if_in_set: "x : set xs \<Longrightarrow> length xs > 0" |
466 |
by auto |
|
467 |
||
13114 | 468 |
lemma length_Suc_conv: |
13145 | 469 |
"(length xs = Suc n) = (\<exists>y ys. xs = y # ys \<and> length ys = n)" |
470 |
by (induct xs) auto |
|
13142 | 471 |
|
14025 | 472 |
lemma Suc_length_conv: |
473 |
"(Suc n = length xs) = (\<exists>y ys. xs = y # ys \<and> length ys = n)" |
|
14208 | 474 |
apply (induct xs, simp, simp) |
14025 | 475 |
apply blast |
476 |
done |
|
477 |
||
25221
5ded95dda5df
append/member: more light-weight way to declare authentic syntax;
wenzelm
parents:
25215
diff
changeset
|
478 |
lemma impossible_Cons: "length xs <= length ys ==> xs = x # ys = False" |
5ded95dda5df
append/member: more light-weight way to declare authentic syntax;
wenzelm
parents:
25215
diff
changeset
|
479 |
by (induct xs) auto |
5ded95dda5df
append/member: more light-weight way to declare authentic syntax;
wenzelm
parents:
25215
diff
changeset
|
480 |
|
26442
57fb6a8b099e
restructuring; explicit case names for rule list_induct2
haftmann
parents:
26300
diff
changeset
|
481 |
lemma list_induct2 [consumes 1, case_names Nil Cons]: |
57fb6a8b099e
restructuring; explicit case names for rule list_induct2
haftmann
parents:
26300
diff
changeset
|
482 |
"length xs = length ys \<Longrightarrow> P [] [] \<Longrightarrow> |
57fb6a8b099e
restructuring; explicit case names for rule list_induct2
haftmann
parents:
26300
diff
changeset
|
483 |
(\<And>x xs y ys. length xs = length ys \<Longrightarrow> P xs ys \<Longrightarrow> P (x#xs) (y#ys)) |
57fb6a8b099e
restructuring; explicit case names for rule list_induct2
haftmann
parents:
26300
diff
changeset
|
484 |
\<Longrightarrow> P xs ys" |
57fb6a8b099e
restructuring; explicit case names for rule list_induct2
haftmann
parents:
26300
diff
changeset
|
485 |
proof (induct xs arbitrary: ys) |
57fb6a8b099e
restructuring; explicit case names for rule list_induct2
haftmann
parents:
26300
diff
changeset
|
486 |
case Nil then show ?case by simp |
57fb6a8b099e
restructuring; explicit case names for rule list_induct2
haftmann
parents:
26300
diff
changeset
|
487 |
next |
57fb6a8b099e
restructuring; explicit case names for rule list_induct2
haftmann
parents:
26300
diff
changeset
|
488 |
case (Cons x xs ys) then show ?case by (cases ys) simp_all |
57fb6a8b099e
restructuring; explicit case names for rule list_induct2
haftmann
parents:
26300
diff
changeset
|
489 |
qed |
57fb6a8b099e
restructuring; explicit case names for rule list_induct2
haftmann
parents:
26300
diff
changeset
|
490 |
|
57fb6a8b099e
restructuring; explicit case names for rule list_induct2
haftmann
parents:
26300
diff
changeset
|
491 |
lemma list_induct3 [consumes 2, case_names Nil Cons]: |
57fb6a8b099e
restructuring; explicit case names for rule list_induct2
haftmann
parents:
26300
diff
changeset
|
492 |
"length xs = length ys \<Longrightarrow> length ys = length zs \<Longrightarrow> P [] [] [] \<Longrightarrow> |
57fb6a8b099e
restructuring; explicit case names for rule list_induct2
haftmann
parents:
26300
diff
changeset
|
493 |
(\<And>x xs y ys z zs. length xs = length ys \<Longrightarrow> length ys = length zs \<Longrightarrow> P xs ys zs \<Longrightarrow> P (x#xs) (y#ys) (z#zs)) |
57fb6a8b099e
restructuring; explicit case names for rule list_induct2
haftmann
parents:
26300
diff
changeset
|
494 |
\<Longrightarrow> P xs ys zs" |
57fb6a8b099e
restructuring; explicit case names for rule list_induct2
haftmann
parents:
26300
diff
changeset
|
495 |
proof (induct xs arbitrary: ys zs) |
57fb6a8b099e
restructuring; explicit case names for rule list_induct2
haftmann
parents:
26300
diff
changeset
|
496 |
case Nil then show ?case by simp |
57fb6a8b099e
restructuring; explicit case names for rule list_induct2
haftmann
parents:
26300
diff
changeset
|
497 |
next |
57fb6a8b099e
restructuring; explicit case names for rule list_induct2
haftmann
parents:
26300
diff
changeset
|
498 |
case (Cons x xs ys zs) then show ?case by (cases ys, simp_all) |
57fb6a8b099e
restructuring; explicit case names for rule list_induct2
haftmann
parents:
26300
diff
changeset
|
499 |
(cases zs, simp_all) |
57fb6a8b099e
restructuring; explicit case names for rule list_induct2
haftmann
parents:
26300
diff
changeset
|
500 |
qed |
13114 | 501 |
|
22493
db930e490fe5
added another rule for simultaneous induction, and lemmas for zip
krauss
parents:
22422
diff
changeset
|
502 |
lemma list_induct2': |
db930e490fe5
added another rule for simultaneous induction, and lemmas for zip
krauss
parents:
22422
diff
changeset
|
503 |
"\<lbrakk> P [] []; |
db930e490fe5
added another rule for simultaneous induction, and lemmas for zip
krauss
parents:
22422
diff
changeset
|
504 |
\<And>x xs. P (x#xs) []; |
db930e490fe5
added another rule for simultaneous induction, and lemmas for zip
krauss
parents:
22422
diff
changeset
|
505 |
\<And>y ys. P [] (y#ys); |
db930e490fe5
added another rule for simultaneous induction, and lemmas for zip
krauss
parents:
22422
diff
changeset
|
506 |
\<And>x xs y ys. P xs ys \<Longrightarrow> P (x#xs) (y#ys) \<rbrakk> |
db930e490fe5
added another rule for simultaneous induction, and lemmas for zip
krauss
parents:
22422
diff
changeset
|
507 |
\<Longrightarrow> P xs ys" |
db930e490fe5
added another rule for simultaneous induction, and lemmas for zip
krauss
parents:
22422
diff
changeset
|
508 |
by (induct xs arbitrary: ys) (case_tac x, auto)+ |
db930e490fe5
added another rule for simultaneous induction, and lemmas for zip
krauss
parents:
22422
diff
changeset
|
509 |
|
22143
cf58486ca11b
Added simproc list_neq (prompted by an application)
nipkow
parents:
21911
diff
changeset
|
510 |
lemma neq_if_length_neq: "length xs \<noteq> length ys \<Longrightarrow> (xs = ys) == False" |
24349 | 511 |
by (rule Eq_FalseI) auto |
24037 | 512 |
|
513 |
simproc_setup list_neq ("(xs::'a list) = ys") = {* |
|
22143
cf58486ca11b
Added simproc list_neq (prompted by an application)
nipkow
parents:
21911
diff
changeset
|
514 |
(* |
cf58486ca11b
Added simproc list_neq (prompted by an application)
nipkow
parents:
21911
diff
changeset
|
515 |
Reduces xs=ys to False if xs and ys cannot be of the same length. |
cf58486ca11b
Added simproc list_neq (prompted by an application)
nipkow
parents:
21911
diff
changeset
|
516 |
This is the case if the atomic sublists of one are a submultiset |
cf58486ca11b
Added simproc list_neq (prompted by an application)
nipkow
parents:
21911
diff
changeset
|
517 |
of those of the other list and there are fewer Cons's in one than the other. |
cf58486ca11b
Added simproc list_neq (prompted by an application)
nipkow
parents:
21911
diff
changeset
|
518 |
*) |
24037 | 519 |
|
520 |
let |
|
22143
cf58486ca11b
Added simproc list_neq (prompted by an application)
nipkow
parents:
21911
diff
changeset
|
521 |
|
29856 | 522 |
fun len (Const(@{const_name Nil},_)) acc = acc |
523 |
| len (Const(@{const_name Cons},_) $ _ $ xs) (ts,n) = len xs (ts,n+1) |
|
524 |
| len (Const(@{const_name append},_) $ xs $ ys) acc = len xs (len ys acc) |
|
525 |
| len (Const(@{const_name rev},_) $ xs) acc = len xs acc |
|
526 |
| len (Const(@{const_name map},_) $ _ $ xs) acc = len xs acc |
|
22143
cf58486ca11b
Added simproc list_neq (prompted by an application)
nipkow
parents:
21911
diff
changeset
|
527 |
| len t (ts,n) = (t::ts,n); |
cf58486ca11b
Added simproc list_neq (prompted by an application)
nipkow
parents:
21911
diff
changeset
|
528 |
|
24037 | 529 |
fun list_neq _ ss ct = |
22143
cf58486ca11b
Added simproc list_neq (prompted by an application)
nipkow
parents:
21911
diff
changeset
|
530 |
let |
24037 | 531 |
val (Const(_,eqT) $ lhs $ rhs) = Thm.term_of ct; |
22143
cf58486ca11b
Added simproc list_neq (prompted by an application)
nipkow
parents:
21911
diff
changeset
|
532 |
val (ls,m) = len lhs ([],0) and (rs,n) = len rhs ([],0); |
cf58486ca11b
Added simproc list_neq (prompted by an application)
nipkow
parents:
21911
diff
changeset
|
533 |
fun prove_neq() = |
cf58486ca11b
Added simproc list_neq (prompted by an application)
nipkow
parents:
21911
diff
changeset
|
534 |
let |
cf58486ca11b
Added simproc list_neq (prompted by an application)
nipkow
parents:
21911
diff
changeset
|
535 |
val Type(_,listT::_) = eqT; |
22994 | 536 |
val size = HOLogic.size_const listT; |
22143
cf58486ca11b
Added simproc list_neq (prompted by an application)
nipkow
parents:
21911
diff
changeset
|
537 |
val eq_len = HOLogic.mk_eq (size $ lhs, size $ rhs); |
cf58486ca11b
Added simproc list_neq (prompted by an application)
nipkow
parents:
21911
diff
changeset
|
538 |
val neq_len = HOLogic.mk_Trueprop (HOLogic.Not $ eq_len); |
cf58486ca11b
Added simproc list_neq (prompted by an application)
nipkow
parents:
21911
diff
changeset
|
539 |
val thm = Goal.prove (Simplifier.the_context ss) [] [] neq_len |
22633 | 540 |
(K (simp_tac (Simplifier.inherit_context ss @{simpset}) 1)); |
541 |
in SOME (thm RS @{thm neq_if_length_neq}) end |
|
22143
cf58486ca11b
Added simproc list_neq (prompted by an application)
nipkow
parents:
21911
diff
changeset
|
542 |
in |
23214 | 543 |
if m < n andalso submultiset (op aconv) (ls,rs) orelse |
544 |
n < m andalso submultiset (op aconv) (rs,ls) |
|
22143
cf58486ca11b
Added simproc list_neq (prompted by an application)
nipkow
parents:
21911
diff
changeset
|
545 |
then prove_neq() else NONE |
cf58486ca11b
Added simproc list_neq (prompted by an application)
nipkow
parents:
21911
diff
changeset
|
546 |
end; |
24037 | 547 |
in list_neq end; |
22143
cf58486ca11b
Added simproc list_neq (prompted by an application)
nipkow
parents:
21911
diff
changeset
|
548 |
*} |
cf58486ca11b
Added simproc list_neq (prompted by an application)
nipkow
parents:
21911
diff
changeset
|
549 |
|
cf58486ca11b
Added simproc list_neq (prompted by an application)
nipkow
parents:
21911
diff
changeset
|
550 |
|
15392 | 551 |
subsubsection {* @{text "@"} -- append *} |
13114 | 552 |
|
13142 | 553 |
lemma append_assoc [simp]: "(xs @ ys) @ zs = xs @ (ys @ zs)" |
13145 | 554 |
by (induct xs) auto |
13114 | 555 |
|
13142 | 556 |
lemma append_Nil2 [simp]: "xs @ [] = xs" |
13145 | 557 |
by (induct xs) auto |
3507 | 558 |
|
13142 | 559 |
lemma append_is_Nil_conv [iff]: "(xs @ ys = []) = (xs = [] \<and> ys = [])" |
13145 | 560 |
by (induct xs) auto |
13114 | 561 |
|
13142 | 562 |
lemma Nil_is_append_conv [iff]: "([] = xs @ ys) = (xs = [] \<and> ys = [])" |
13145 | 563 |
by (induct xs) auto |
13114 | 564 |
|
13142 | 565 |
lemma append_self_conv [iff]: "(xs @ ys = xs) = (ys = [])" |
13145 | 566 |
by (induct xs) auto |
13114 | 567 |
|
13142 | 568 |
lemma self_append_conv [iff]: "(xs = xs @ ys) = (ys = [])" |
13145 | 569 |
by (induct xs) auto |
13114 | 570 |
|
25221
5ded95dda5df
append/member: more light-weight way to declare authentic syntax;
wenzelm
parents:
25215
diff
changeset
|
571 |
lemma append_eq_append_conv [simp, noatp]: |
24526 | 572 |
"length xs = length ys \<or> length us = length vs |
13883
0451e0fb3f22
Re-structured some proofs in order to get rid of rule_format attribute.
berghofe
parents:
13863
diff
changeset
|
573 |
==> (xs@us = ys@vs) = (xs=ys \<and> us=vs)" |
24526 | 574 |
apply (induct xs arbitrary: ys) |
14208 | 575 |
apply (case_tac ys, simp, force) |
576 |
apply (case_tac ys, force, simp) |
|
13145 | 577 |
done |
13142 | 578 |
|
24526 | 579 |
lemma append_eq_append_conv2: "(xs @ ys = zs @ ts) = |
580 |
(EX us. xs = zs @ us & us @ ys = ts | xs @ us = zs & ys = us@ ts)" |
|
581 |
apply (induct xs arbitrary: ys zs ts) |
|
14495 | 582 |
apply fastsimp |
583 |
apply(case_tac zs) |
|
584 |
apply simp |
|
585 |
apply fastsimp |
|
586 |
done |
|
587 |
||
34910
b23bd3ee4813
same_append_eq / append_same_eq are now used for simplifying induction rules.
berghofe
parents:
34064
diff
changeset
|
588 |
lemma same_append_eq [iff, induct_simp]: "(xs @ ys = xs @ zs) = (ys = zs)" |
13145 | 589 |
by simp |
13142 | 590 |
|
591 |
lemma append1_eq_conv [iff]: "(xs @ [x] = ys @ [y]) = (xs = ys \<and> x = y)" |
|
13145 | 592 |
by simp |
13114 | 593 |
|
34910
b23bd3ee4813
same_append_eq / append_same_eq are now used for simplifying induction rules.
berghofe
parents:
34064
diff
changeset
|
594 |
lemma append_same_eq [iff, induct_simp]: "(ys @ xs = zs @ xs) = (ys = zs)" |
13145 | 595 |
by simp |
13114 | 596 |
|
13142 | 597 |
lemma append_self_conv2 [iff]: "(xs @ ys = ys) = (xs = [])" |
13145 | 598 |
using append_same_eq [of _ _ "[]"] by auto |
3507 | 599 |
|
13142 | 600 |
lemma self_append_conv2 [iff]: "(ys = xs @ ys) = (xs = [])" |
13145 | 601 |
using append_same_eq [of "[]"] by auto |
13114 | 602 |
|
24286
7619080e49f0
ATP blacklisting is now in theory data, attribute noatp
paulson
parents:
24219
diff
changeset
|
603 |
lemma hd_Cons_tl [simp,noatp]: "xs \<noteq> [] ==> hd xs # tl xs = xs" |
13145 | 604 |
by (induct xs) auto |
13114 | 605 |
|
13142 | 606 |
lemma hd_append: "hd (xs @ ys) = (if xs = [] then hd ys else hd xs)" |
13145 | 607 |
by (induct xs) auto |
13114 | 608 |
|
13142 | 609 |
lemma hd_append2 [simp]: "xs \<noteq> [] ==> hd (xs @ ys) = hd xs" |
13145 | 610 |
by (simp add: hd_append split: list.split) |
13114 | 611 |
|
13142 | 612 |
lemma tl_append: "tl (xs @ ys) = (case xs of [] => tl ys | z#zs => zs @ ys)" |
13145 | 613 |
by (simp split: list.split) |
13114 | 614 |
|
13142 | 615 |
lemma tl_append2 [simp]: "xs \<noteq> [] ==> tl (xs @ ys) = tl xs @ ys" |
13145 | 616 |
by (simp add: tl_append split: list.split) |
13114 | 617 |
|
618 |
||
14300 | 619 |
lemma Cons_eq_append_conv: "x#xs = ys@zs = |
620 |
(ys = [] & x#xs = zs | (EX ys'. x#ys' = ys & xs = ys'@zs))" |
|
621 |
by(cases ys) auto |
|
622 |
||
15281 | 623 |
lemma append_eq_Cons_conv: "(ys@zs = x#xs) = |
624 |
(ys = [] & zs = x#xs | (EX ys'. ys = x#ys' & ys'@zs = xs))" |
|
625 |
by(cases ys) auto |
|
626 |
||
14300 | 627 |
|
13142 | 628 |
text {* Trivial rules for solving @{text "@"}-equations automatically. *} |
13114 | 629 |
|
630 |
lemma eq_Nil_appendI: "xs = ys ==> xs = [] @ ys" |
|
13145 | 631 |
by simp |
13114 | 632 |
|
13142 | 633 |
lemma Cons_eq_appendI: |
13145 | 634 |
"[| x # xs1 = ys; xs = xs1 @ zs |] ==> x # xs = ys @ zs" |
635 |
by (drule sym) simp |
|
13114 | 636 |
|
13142 | 637 |
lemma append_eq_appendI: |
13145 | 638 |
"[| xs @ xs1 = zs; ys = xs1 @ us |] ==> xs @ ys = zs @ us" |
639 |
by (drule sym) simp |
|
13114 | 640 |
|
641 |
||
13142 | 642 |
text {* |
13145 | 643 |
Simplification procedure for all list equalities. |
644 |
Currently only tries to rearrange @{text "@"} to see if |
|
645 |
- both lists end in a singleton list, |
|
646 |
- or both lists end in the same list. |
|
13142 | 647 |
*} |
648 |
||
26480 | 649 |
ML {* |
3507 | 650 |
local |
651 |
||
29856 | 652 |
fun last (cons as Const(@{const_name Cons},_) $ _ $ xs) = |
653 |
(case xs of Const(@{const_name Nil},_) => cons | _ => last xs) |
|
654 |
| last (Const(@{const_name append},_) $ _ $ ys) = last ys |
|
13462 | 655 |
| last t = t; |
13114 | 656 |
|
29856 | 657 |
fun list1 (Const(@{const_name Cons},_) $ _ $ Const(@{const_name Nil},_)) = true |
13462 | 658 |
| list1 _ = false; |
13114 | 659 |
|
29856 | 660 |
fun butlast ((cons as Const(@{const_name Cons},_) $ x) $ xs) = |
661 |
(case xs of Const(@{const_name Nil},_) => xs | _ => cons $ butlast xs) |
|
662 |
| butlast ((app as Const(@{const_name append},_) $ xs) $ ys) = app $ butlast ys |
|
663 |
| butlast xs = Const(@{const_name Nil},fastype_of xs); |
|
13114 | 664 |
|
22633 | 665 |
val rearr_ss = HOL_basic_ss addsimps [@{thm append_assoc}, |
666 |
@{thm append_Nil}, @{thm append_Cons}]; |
|
16973 | 667 |
|
20044
92cc2f4c7335
simprocs: no theory argument -- use simpset context instead;
wenzelm
parents:
19890
diff
changeset
|
668 |
fun list_eq ss (F as (eq as Const(_,eqT)) $ lhs $ rhs) = |
13462 | 669 |
let |
670 |
val lastl = last lhs and lastr = last rhs; |
|
671 |
fun rearr conv = |
|
672 |
let |
|
673 |
val lhs1 = butlast lhs and rhs1 = butlast rhs; |
|
674 |
val Type(_,listT::_) = eqT |
|
675 |
val appT = [listT,listT] ---> listT |
|
29856 | 676 |
val app = Const(@{const_name append},appT) |
13462 | 677 |
val F2 = eq $ (app$lhs1$lastl) $ (app$rhs1$lastr) |
13480
bb72bd43c6c3
use Tactic.prove instead of prove_goalw_cterm in internal proofs!
wenzelm
parents:
13462
diff
changeset
|
678 |
val eq = HOLogic.mk_Trueprop (HOLogic.mk_eq (F,F2)); |
20044
92cc2f4c7335
simprocs: no theory argument -- use simpset context instead;
wenzelm
parents:
19890
diff
changeset
|
679 |
val thm = Goal.prove (Simplifier.the_context ss) [] [] eq |
17877
67d5ab1cb0d8
Simplifier.inherit_context instead of Simplifier.inherit_bounds;
wenzelm
parents:
17830
diff
changeset
|
680 |
(K (simp_tac (Simplifier.inherit_context ss rearr_ss) 1)); |
15531 | 681 |
in SOME ((conv RS (thm RS trans)) RS eq_reflection) end; |
13114 | 682 |
|
13462 | 683 |
in |
22633 | 684 |
if list1 lastl andalso list1 lastr then rearr @{thm append1_eq_conv} |
685 |
else if lastl aconv lastr then rearr @{thm append_same_eq} |
|
15531 | 686 |
else NONE |
13462 | 687 |
end; |
688 |
||
13114 | 689 |
in |
13462 | 690 |
|
691 |
val list_eq_simproc = |
|
32010 | 692 |
Simplifier.simproc @{theory} "list_eq" ["(xs::'a list) = ys"] (K list_eq); |
13462 | 693 |
|
13114 | 694 |
end; |
695 |
||
696 |
Addsimprocs [list_eq_simproc]; |
|
697 |
*} |
|
698 |
||
699 |
||
15392 | 700 |
subsubsection {* @{text map} *} |
13114 | 701 |
|
13142 | 702 |
lemma map_ext: "(!!x. x : set xs --> f x = g x) ==> map f xs = map g xs" |
13145 | 703 |
by (induct xs) simp_all |
13114 | 704 |
|
13142 | 705 |
lemma map_ident [simp]: "map (\<lambda>x. x) = (\<lambda>xs. xs)" |
13145 | 706 |
by (rule ext, induct_tac xs) auto |
13114 | 707 |
|
13142 | 708 |
lemma map_append [simp]: "map f (xs @ ys) = map f xs @ map f ys" |
13145 | 709 |
by (induct xs) auto |
13114 | 710 |
|
33639
603320b93668
New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents:
33593
diff
changeset
|
711 |
lemma map_map [simp]: "map f (map g xs) = map (f \<circ> g) xs" |
603320b93668
New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents:
33593
diff
changeset
|
712 |
by (induct xs) auto |
603320b93668
New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents:
33593
diff
changeset
|
713 |
|
13142 | 714 |
lemma rev_map: "rev (map f xs) = map f (rev xs)" |
13145 | 715 |
by (induct xs) auto |
13114 | 716 |
|
13737 | 717 |
lemma map_eq_conv[simp]: "(map f xs = map g xs) = (!x : set xs. f x = g x)" |
718 |
by (induct xs) auto |
|
719 |
||
19770
be5c23ebe1eb
HOL/Tools/function_package: Added support for mutual recursive definitions.
krauss
parents:
19623
diff
changeset
|
720 |
lemma map_cong [fundef_cong, recdef_cong]: |
13145 | 721 |
"xs = ys ==> (!!x. x : set ys ==> f x = g x) ==> map f xs = map g ys" |
722 |
-- {* a congruence rule for @{text map} *} |
|
13737 | 723 |
by simp |
13114 | 724 |
|
13142 | 725 |
lemma map_is_Nil_conv [iff]: "(map f xs = []) = (xs = [])" |
13145 | 726 |
by (cases xs) auto |
13114 | 727 |
|
13142 | 728 |
lemma Nil_is_map_conv [iff]: "([] = map f xs) = (xs = [])" |
13145 | 729 |
by (cases xs) auto |
13114 | 730 |
|
18447 | 731 |
lemma map_eq_Cons_conv: |
14025 | 732 |
"(map f xs = y#ys) = (\<exists>z zs. xs = z#zs \<and> f z = y \<and> map f zs = ys)" |
13145 | 733 |
by (cases xs) auto |
13114 | 734 |
|
18447 | 735 |
lemma Cons_eq_map_conv: |
14025 | 736 |
"(x#xs = map f ys) = (\<exists>z zs. ys = z#zs \<and> x = f z \<and> xs = map f zs)" |
737 |
by (cases ys) auto |
|
738 |
||
18447 | 739 |
lemmas map_eq_Cons_D = map_eq_Cons_conv [THEN iffD1] |
740 |
lemmas Cons_eq_map_D = Cons_eq_map_conv [THEN iffD1] |
|
741 |
declare map_eq_Cons_D [dest!] Cons_eq_map_D [dest!] |
|
742 |
||
14111 | 743 |
lemma ex_map_conv: |
744 |
"(EX xs. ys = map f xs) = (ALL y : set ys. EX x. y = f x)" |
|
18447 | 745 |
by(induct ys, auto simp add: Cons_eq_map_conv) |
14111 | 746 |
|
15110
78b5636eabc7
Added a number of new thms and the new function remove1
nipkow
parents:
15072
diff
changeset
|
747 |
lemma map_eq_imp_length_eq: |
26734 | 748 |
assumes "map f xs = map f ys" |
749 |
shows "length xs = length ys" |
|
750 |
using assms proof (induct ys arbitrary: xs) |
|
751 |
case Nil then show ?case by simp |
|
752 |
next |
|
753 |
case (Cons y ys) then obtain z zs where xs: "xs = z # zs" by auto |
|
754 |
from Cons xs have "map f zs = map f ys" by simp |
|
755 |
moreover with Cons have "length zs = length ys" by blast |
|
756 |
with xs show ?case by simp |
|
757 |
qed |
|
758 |
||
15110
78b5636eabc7
Added a number of new thms and the new function remove1
nipkow
parents:
15072
diff
changeset
|
759 |
lemma map_inj_on: |
78b5636eabc7
Added a number of new thms and the new function remove1
nipkow
parents:
15072
diff
changeset
|
760 |
"[| map f xs = map f ys; inj_on f (set xs Un set ys) |] |
78b5636eabc7
Added a number of new thms and the new function remove1
nipkow
parents:
15072
diff
changeset
|
761 |
==> xs = ys" |
78b5636eabc7
Added a number of new thms and the new function remove1
nipkow
parents:
15072
diff
changeset
|
762 |
apply(frule map_eq_imp_length_eq) |
78b5636eabc7
Added a number of new thms and the new function remove1
nipkow
parents:
15072
diff
changeset
|
763 |
apply(rotate_tac -1) |
78b5636eabc7
Added a number of new thms and the new function remove1
nipkow
parents:
15072
diff
changeset
|
764 |
apply(induct rule:list_induct2) |
78b5636eabc7
Added a number of new thms and the new function remove1
nipkow
parents:
15072
diff
changeset
|
765 |
apply simp |
78b5636eabc7
Added a number of new thms and the new function remove1
nipkow
parents:
15072
diff
changeset
|
766 |
apply(simp) |
78b5636eabc7
Added a number of new thms and the new function remove1
nipkow
parents:
15072
diff
changeset
|
767 |
apply (blast intro:sym) |
78b5636eabc7
Added a number of new thms and the new function remove1
nipkow
parents:
15072
diff
changeset
|
768 |
done |
78b5636eabc7
Added a number of new thms and the new function remove1
nipkow
parents:
15072
diff
changeset
|
769 |
|
78b5636eabc7
Added a number of new thms and the new function remove1
nipkow
parents:
15072
diff
changeset
|
770 |
lemma inj_on_map_eq_map: |
78b5636eabc7
Added a number of new thms and the new function remove1
nipkow
parents:
15072
diff
changeset
|
771 |
"inj_on f (set xs Un set ys) \<Longrightarrow> (map f xs = map f ys) = (xs = ys)" |
78b5636eabc7
Added a number of new thms and the new function remove1
nipkow
parents:
15072
diff
changeset
|
772 |
by(blast dest:map_inj_on) |
78b5636eabc7
Added a number of new thms and the new function remove1
nipkow
parents:
15072
diff
changeset
|
773 |
|
13114 | 774 |
lemma map_injective: |
24526 | 775 |
"map f xs = map f ys ==> inj f ==> xs = ys" |
776 |
by (induct ys arbitrary: xs) (auto dest!:injD) |
|
13114 | 777 |
|
14339 | 778 |
lemma inj_map_eq_map[simp]: "inj f \<Longrightarrow> (map f xs = map f ys) = (xs = ys)" |
779 |
by(blast dest:map_injective) |
|
780 |
||
13114 | 781 |
lemma inj_mapI: "inj f ==> inj (map f)" |
17589 | 782 |
by (iprover dest: map_injective injD intro: inj_onI) |
13114 | 783 |
|
784 |
lemma inj_mapD: "inj (map f) ==> inj f" |
|
14208 | 785 |
apply (unfold inj_on_def, clarify) |
13145 | 786 |
apply (erule_tac x = "[x]" in ballE) |
14208 | 787 |
apply (erule_tac x = "[y]" in ballE, simp, blast) |
13145 | 788 |
apply blast |
789 |
done |
|
13114 | 790 |
|
14339 | 791 |
lemma inj_map[iff]: "inj (map f) = inj f" |
13145 | 792 |
by (blast dest: inj_mapD intro: inj_mapI) |
13114 | 793 |
|
15303 | 794 |
lemma inj_on_mapI: "inj_on f (\<Union>(set ` A)) \<Longrightarrow> inj_on (map f) A" |
795 |
apply(rule inj_onI) |
|
796 |
apply(erule map_inj_on) |
|
797 |
apply(blast intro:inj_onI dest:inj_onD) |
|
798 |
done |
|
799 |
||
14343 | 800 |
lemma map_idI: "(\<And>x. x \<in> set xs \<Longrightarrow> f x = x) \<Longrightarrow> map f xs = xs" |
801 |
by (induct xs, auto) |
|
13114 | 802 |
|
14402
4201e1916482
moved lemmas from MicroJava/Comp/AuxLemmas.thy to List.thy
nipkow
parents:
14395
diff
changeset
|
803 |
lemma map_fun_upd [simp]: "y \<notin> set xs \<Longrightarrow> map (f(y:=v)) xs = map f xs" |
4201e1916482
moved lemmas from MicroJava/Comp/AuxLemmas.thy to List.thy
nipkow
parents:
14395
diff
changeset
|
804 |
by (induct xs) auto |
4201e1916482
moved lemmas from MicroJava/Comp/AuxLemmas.thy to List.thy
nipkow
parents:
14395
diff
changeset
|
805 |
|
15110
78b5636eabc7
Added a number of new thms and the new function remove1
nipkow
parents:
15072
diff
changeset
|
806 |
lemma map_fst_zip[simp]: |
78b5636eabc7
Added a number of new thms and the new function remove1
nipkow
parents:
15072
diff
changeset
|
807 |
"length xs = length ys \<Longrightarrow> map fst (zip xs ys) = xs" |
78b5636eabc7
Added a number of new thms and the new function remove1
nipkow
parents:
15072
diff
changeset
|
808 |
by (induct rule:list_induct2, simp_all) |
78b5636eabc7
Added a number of new thms and the new function remove1
nipkow
parents:
15072
diff
changeset
|
809 |
|
78b5636eabc7
Added a number of new thms and the new function remove1
nipkow
parents:
15072
diff
changeset
|
810 |
lemma map_snd_zip[simp]: |
78b5636eabc7
Added a number of new thms and the new function remove1
nipkow
parents:
15072
diff
changeset
|
811 |
"length xs = length ys \<Longrightarrow> map snd (zip xs ys) = ys" |
78b5636eabc7
Added a number of new thms and the new function remove1
nipkow
parents:
15072
diff
changeset
|
812 |
by (induct rule:list_induct2, simp_all) |
78b5636eabc7
Added a number of new thms and the new function remove1
nipkow
parents:
15072
diff
changeset
|
813 |
|
78b5636eabc7
Added a number of new thms and the new function remove1
nipkow
parents:
15072
diff
changeset
|
814 |
|
15392 | 815 |
subsubsection {* @{text rev} *} |
13114 | 816 |
|
13142 | 817 |
lemma rev_append [simp]: "rev (xs @ ys) = rev ys @ rev xs" |
13145 | 818 |
by (induct xs) auto |
13114 | 819 |
|
13142 | 820 |
lemma rev_rev_ident [simp]: "rev (rev xs) = xs" |
13145 | 821 |
by (induct xs) auto |
13114 | 822 |
|
15870 | 823 |
lemma rev_swap: "(rev xs = ys) = (xs = rev ys)" |
824 |
by auto |
|
825 |
||
13142 | 826 |
lemma rev_is_Nil_conv [iff]: "(rev xs = []) = (xs = [])" |
13145 | 827 |
by (induct xs) auto |
13114 | 828 |
|
13142 | 829 |
lemma Nil_is_rev_conv [iff]: "([] = rev xs) = (xs = [])" |
13145 | 830 |
by (induct xs) auto |
13114 | 831 |
|
15870 | 832 |
lemma rev_singleton_conv [simp]: "(rev xs = [x]) = (xs = [x])" |
833 |
by (cases xs) auto |
|
834 |
||
835 |
lemma singleton_rev_conv [simp]: "([x] = rev xs) = (xs = [x])" |
|
836 |
by (cases xs) auto |
|
837 |
||
21061
580dfc999ef6
added normal post setup; cleaned up "execution" constants
haftmann
parents:
21046
diff
changeset
|
838 |
lemma rev_is_rev_conv [iff]: "(rev xs = rev ys) = (xs = ys)" |
580dfc999ef6
added normal post setup; cleaned up "execution" constants
haftmann
parents:
21046
diff
changeset
|
839 |
apply (induct xs arbitrary: ys, force) |
14208 | 840 |
apply (case_tac ys, simp, force) |
13145 | 841 |
done |
13114 | 842 |
|
15439 | 843 |
lemma inj_on_rev[iff]: "inj_on rev A" |
844 |
by(simp add:inj_on_def) |
|
845 |
||
13366 | 846 |
lemma rev_induct [case_names Nil snoc]: |
847 |
"[| P []; !!x xs. P xs ==> P (xs @ [x]) |] ==> P xs" |
|
15489
d136af442665
Replaced application of subst by simplesubst in proof of rev_induct
berghofe
parents:
15439
diff
changeset
|
848 |
apply(simplesubst rev_rev_ident[symmetric]) |
13145 | 849 |
apply(rule_tac list = "rev xs" in list.induct, simp_all) |
850 |
done |
|
13114 | 851 |
|
13366 | 852 |
lemma rev_exhaust [case_names Nil snoc]: |
853 |
"(xs = [] ==> P) ==>(!!ys y. xs = ys @ [y] ==> P) ==> P" |
|
13145 | 854 |
by (induct xs rule: rev_induct) auto |
13114 | 855 |
|
13366 | 856 |
lemmas rev_cases = rev_exhaust |
857 |
||
18423 | 858 |
lemma rev_eq_Cons_iff[iff]: "(rev xs = y#ys) = (xs = rev ys @ [y])" |
859 |
by(rule rev_cases[of xs]) auto |
|
860 |
||
13114 | 861 |
|
15392 | 862 |
subsubsection {* @{text set} *} |
13114 | 863 |
|
13142 | 864 |
lemma finite_set [iff]: "finite (set xs)" |
13145 | 865 |
by (induct xs) auto |
13114 | 866 |
|
13142 | 867 |
lemma set_append [simp]: "set (xs @ ys) = (set xs \<union> set ys)" |
13145 | 868 |
by (induct xs) auto |
13114 | 869 |
|
17830 | 870 |
lemma hd_in_set[simp]: "xs \<noteq> [] \<Longrightarrow> hd xs : set xs" |
871 |
by(cases xs) auto |
|
14099 | 872 |
|
13142 | 873 |
lemma set_subset_Cons: "set xs \<subseteq> set (x # xs)" |
13145 | 874 |
by auto |
13114 | 875 |
|
14099 | 876 |
lemma set_ConsD: "y \<in> set (x # xs) \<Longrightarrow> y=x \<or> y \<in> set xs" |
877 |
by auto |
|
878 |
||
13142 | 879 |
lemma set_empty [iff]: "(set xs = {}) = (xs = [])" |
13145 | 880 |
by (induct xs) auto |
13114 | 881 |
|
15245 | 882 |
lemma set_empty2[iff]: "({} = set xs) = (xs = [])" |
883 |
by(induct xs) auto |
|
884 |
||
13142 | 885 |
lemma set_rev [simp]: "set (rev xs) = set xs" |
13145 | 886 |
by (induct xs) auto |
13114 | 887 |
|
13142 | 888 |
lemma set_map [simp]: "set (map f xs) = f`(set xs)" |
13145 | 889 |
by (induct xs) auto |
13114 | 890 |
|
13142 | 891 |
lemma set_filter [simp]: "set (filter P xs) = {x. x : set xs \<and> P x}" |
13145 | 892 |
by (induct xs) auto |
13114 | 893 |
|
32417 | 894 |
lemma set_upt [simp]: "set[i..<j] = {i..<j}" |
895 |
by (induct j) (simp_all add: atLeastLessThanSuc) |
|
13114 | 896 |
|
13142 | 897 |
|
25221
5ded95dda5df
append/member: more light-weight way to declare authentic syntax;
wenzelm
parents:
25215
diff
changeset
|
898 |
lemma split_list: "x : set xs \<Longrightarrow> \<exists>ys zs. xs = ys @ x # zs" |
18049 | 899 |
proof (induct xs) |
26073 | 900 |
case Nil thus ?case by simp |
901 |
next |
|
902 |
case Cons thus ?case by (auto intro: Cons_eq_appendI) |
|
903 |
qed |
|
904 |
||
26734 | 905 |
lemma in_set_conv_decomp: "x \<in> set xs \<longleftrightarrow> (\<exists>ys zs. xs = ys @ x # zs)" |
906 |
by (auto elim: split_list) |
|
26073 | 907 |
|
908 |
lemma split_list_first: "x : set xs \<Longrightarrow> \<exists>ys zs. xs = ys @ x # zs \<and> x \<notin> set ys" |
|
909 |
proof (induct xs) |
|
910 |
case Nil thus ?case by simp |
|
18049 | 911 |
next |
912 |
case (Cons a xs) |
|
913 |
show ?case |
|
914 |
proof cases |
|
25221
5ded95dda5df
append/member: more light-weight way to declare authentic syntax;
wenzelm
parents:
25215
diff
changeset
|
915 |
assume "x = a" thus ?case using Cons by fastsimp |
18049 | 916 |
next |
26073 | 917 |
assume "x \<noteq> a" thus ?case using Cons by(fastsimp intro!: Cons_eq_appendI) |
918 |
qed |
|
919 |
qed |
|
920 |
||
921 |
lemma in_set_conv_decomp_first: |
|
922 |
"(x : set xs) = (\<exists>ys zs. xs = ys @ x # zs \<and> x \<notin> set ys)" |
|
26734 | 923 |
by (auto dest!: split_list_first) |
26073 | 924 |
|
925 |
lemma split_list_last: "x : set xs \<Longrightarrow> \<exists>ys zs. xs = ys @ x # zs \<and> x \<notin> set zs" |
|
926 |
proof (induct xs rule:rev_induct) |
|
927 |
case Nil thus ?case by simp |
|
928 |
next |
|
929 |
case (snoc a xs) |
|
930 |
show ?case |
|
931 |
proof cases |
|
932 |
assume "x = a" thus ?case using snoc by simp (metis ex_in_conv set_empty2) |
|
933 |
next |
|
934 |
assume "x \<noteq> a" thus ?case using snoc by fastsimp |
|
18049 | 935 |
qed |
936 |
qed |
|
937 |
||
26073 | 938 |
lemma in_set_conv_decomp_last: |
939 |
"(x : set xs) = (\<exists>ys zs. xs = ys @ x # zs \<and> x \<notin> set zs)" |
|
26734 | 940 |
by (auto dest!: split_list_last) |
26073 | 941 |
|
942 |
lemma split_list_prop: "\<exists>x \<in> set xs. P x \<Longrightarrow> \<exists>ys x zs. xs = ys @ x # zs & P x" |
|
943 |
proof (induct xs) |
|
944 |
case Nil thus ?case by simp |
|
945 |
next |
|
946 |
case Cons thus ?case |
|
947 |
by(simp add:Bex_def)(metis append_Cons append.simps(1)) |
|
948 |
qed |
|
949 |
||
950 |
lemma split_list_propE: |
|
26734 | 951 |
assumes "\<exists>x \<in> set xs. P x" |
952 |
obtains ys x zs where "xs = ys @ x # zs" and "P x" |
|
953 |
using split_list_prop [OF assms] by blast |
|
26073 | 954 |
|
955 |
lemma split_list_first_prop: |
|
956 |
"\<exists>x \<in> set xs. P x \<Longrightarrow> |
|
957 |
\<exists>ys x zs. xs = ys@x#zs \<and> P x \<and> (\<forall>y \<in> set ys. \<not> P y)" |
|
26734 | 958 |
proof (induct xs) |
26073 | 959 |
case Nil thus ?case by simp |
960 |
next |
|
961 |
case (Cons x xs) |
|
962 |
show ?case |
|
963 |
proof cases |
|
964 |
assume "P x" |
|
26734 | 965 |
thus ?thesis by simp |
966 |
(metis Un_upper1 contra_subsetD in_set_conv_decomp_first self_append_conv2 set_append) |
|
26073 | 967 |
next |
968 |
assume "\<not> P x" |
|
969 |
hence "\<exists>x\<in>set xs. P x" using Cons(2) by simp |
|
970 |
thus ?thesis using `\<not> P x` Cons(1) by (metis append_Cons set_ConsD) |
|
971 |
qed |
|
972 |
qed |
|
973 |
||
974 |
lemma split_list_first_propE: |
|
26734 | 975 |
assumes "\<exists>x \<in> set xs. P x" |
976 |
obtains ys x zs where "xs = ys @ x # zs" and "P x" and "\<forall>y \<in> set ys. \<not> P y" |
|
977 |
using split_list_first_prop [OF assms] by blast |
|
26073 | 978 |
|
979 |
lemma split_list_first_prop_iff: |
|
980 |
"(\<exists>x \<in> set xs. P x) \<longleftrightarrow> |
|
981 |
(\<exists>ys x zs. xs = ys@x#zs \<and> P x \<and> (\<forall>y \<in> set ys. \<not> P y))" |
|
26734 | 982 |
by (rule, erule split_list_first_prop) auto |
26073 | 983 |
|
984 |
lemma split_list_last_prop: |
|
985 |
"\<exists>x \<in> set xs. P x \<Longrightarrow> |
|
986 |
\<exists>ys x zs. xs = ys@x#zs \<and> P x \<and> (\<forall>z \<in> set zs. \<not> P z)" |
|
987 |
proof(induct xs rule:rev_induct) |
|
988 |
case Nil thus ?case by simp |
|
989 |
next |
|
990 |
case (snoc x xs) |
|
991 |
show ?case |
|
992 |
proof cases |
|
993 |
assume "P x" thus ?thesis by (metis emptyE set_empty) |
|
994 |
next |
|
995 |
assume "\<not> P x" |
|
996 |
hence "\<exists>x\<in>set xs. P x" using snoc(2) by simp |
|
997 |
thus ?thesis using `\<not> P x` snoc(1) by fastsimp |
|
998 |
qed |
|
999 |
qed |
|
1000 |
||
1001 |
lemma split_list_last_propE: |
|
26734 | 1002 |
assumes "\<exists>x \<in> set xs. P x" |
1003 |
obtains ys x zs where "xs = ys @ x # zs" and "P x" and "\<forall>z \<in> set zs. \<not> P z" |
|
1004 |
using split_list_last_prop [OF assms] by blast |
|
26073 | 1005 |
|
1006 |
lemma split_list_last_prop_iff: |
|
1007 |
"(\<exists>x \<in> set xs. P x) \<longleftrightarrow> |
|
1008 |
(\<exists>ys x zs. xs = ys@x#zs \<and> P x \<and> (\<forall>z \<in> set zs. \<not> P z))" |
|
26734 | 1009 |
by (metis split_list_last_prop [where P=P] in_set_conv_decomp) |
26073 | 1010 |
|
1011 |
lemma finite_list: "finite A ==> EX xs. set xs = A" |
|
26734 | 1012 |
by (erule finite_induct) |
1013 |
(auto simp add: set.simps(2) [symmetric] simp del: set.simps(2)) |
|
13508 | 1014 |
|
14388 | 1015 |
lemma card_length: "card (set xs) \<le> length xs" |
1016 |
by (induct xs) (auto simp add: card_insert_if) |
|
13114 | 1017 |
|
26442
57fb6a8b099e
restructuring; explicit case names for rule list_induct2
haftmann
parents:
26300
diff
changeset
|
1018 |
lemma set_minus_filter_out: |
57fb6a8b099e
restructuring; explicit case names for rule list_induct2
haftmann
parents:
26300
diff
changeset
|
1019 |
"set xs - {y} = set (filter (\<lambda>x. \<not> (x = y)) xs)" |
57fb6a8b099e
restructuring; explicit case names for rule list_induct2
haftmann
parents:
26300
diff
changeset
|
1020 |
by (induct xs) auto |
15168 | 1021 |
|
15392 | 1022 |
subsubsection {* @{text filter} *} |
13114 | 1023 |
|
13142 | 1024 |
lemma filter_append [simp]: "filter P (xs @ ys) = filter P xs @ filter P ys" |
13145 | 1025 |
by (induct xs) auto |
13114 | 1026 |
|
15305 | 1027 |
lemma rev_filter: "rev (filter P xs) = filter P (rev xs)" |
1028 |
by (induct xs) simp_all |
|
1029 |
||
13142 | 1030 |
lemma filter_filter [simp]: "filter P (filter Q xs) = filter (\<lambda>x. Q x \<and> P x) xs" |
13145 | 1031 |
by (induct xs) auto |
13114 | 1032 |
|
16998 | 1033 |
lemma length_filter_le [simp]: "length (filter P xs) \<le> length xs" |
1034 |
by (induct xs) (auto simp add: le_SucI) |
|
1035 |
||
18423 | 1036 |
lemma sum_length_filter_compl: |
1037 |
"length(filter P xs) + length(filter (%x. ~P x) xs) = length xs" |
|
1038 |
by(induct xs) simp_all |
|
1039 |
||
13142 | 1040 |
lemma filter_True [simp]: "\<forall>x \<in> set xs. P x ==> filter P xs = xs" |
13145 | 1041 |
by (induct xs) auto |
13114 | 1042 |
|
13142 | 1043 |
lemma filter_False [simp]: "\<forall>x \<in> set xs. \<not> P x ==> filter P xs = []" |
13145 | 1044 |
by (induct xs) auto |
13114 | 1045 |
|
16998 | 1046 |
lemma filter_empty_conv: "(filter P xs = []) = (\<forall>x\<in>set xs. \<not> P x)" |
24349 | 1047 |
by (induct xs) simp_all |
16998 | 1048 |
|
1049 |
lemma filter_id_conv: "(filter P xs = xs) = (\<forall>x\<in>set xs. P x)" |
|
1050 |
apply (induct xs) |
|
1051 |
apply auto |
|
1052 |
apply(cut_tac P=P and xs=xs in length_filter_le) |
|
1053 |
apply simp |
|
1054 |
done |
|
13114 | 1055 |
|
16965 | 1056 |
lemma filter_map: |
1057 |
"filter P (map f xs) = map f (filter (P o f) xs)" |
|
1058 |
by (induct xs) simp_all |
|
1059 |
||
1060 |
lemma length_filter_map[simp]: |
|
1061 |
"length (filter P (map f xs)) = length(filter (P o f) xs)" |
|
1062 |
by (simp add:filter_map) |
|
1063 |
||
13142 | 1064 |
lemma filter_is_subset [simp]: "set (filter P xs) \<le> set xs" |
13145 | 1065 |
by auto |
13114 | 1066 |
|
15246 | 1067 |
lemma length_filter_less: |
1068 |
"\<lbrakk> x : set xs; ~ P x \<rbrakk> \<Longrightarrow> length(filter P xs) < length xs" |
|
1069 |
proof (induct xs) |
|
1070 |
case Nil thus ?case by simp |
|
1071 |
next |
|
1072 |
case (Cons x xs) thus ?case |
|
1073 |
apply (auto split:split_if_asm) |
|
1074 |
using length_filter_le[of P xs] apply arith |
|
1075 |
done |
|
1076 |
qed |
|
13114 | 1077 |
|
15281 | 1078 |
lemma length_filter_conv_card: |
1079 |
"length(filter p xs) = card{i. i < length xs & p(xs!i)}" |
|
1080 |
proof (induct xs) |
|
1081 |
case Nil thus ?case by simp |
|
1082 |
next |
|
1083 |
case (Cons x xs) |
|
1084 |
let ?S = "{i. i < length xs & p(xs!i)}" |
|
1085 |
have fin: "finite ?S" by(fast intro: bounded_nat_set_is_finite) |
|
1086 |
show ?case (is "?l = card ?S'") |
|
1087 |
proof (cases) |
|
1088 |
assume "p x" |
|
1089 |
hence eq: "?S' = insert 0 (Suc ` ?S)" |
|
25162 | 1090 |
by(auto simp: image_def split:nat.split dest:gr0_implies_Suc) |
15281 | 1091 |
have "length (filter p (x # xs)) = Suc(card ?S)" |
23388 | 1092 |
using Cons `p x` by simp |
15281 | 1093 |
also have "\<dots> = Suc(card(Suc ` ?S))" using fin |
1094 |
by (simp add: card_image inj_Suc) |
|
1095 |
also have "\<dots> = card ?S'" using eq fin |
|
1096 |
by (simp add:card_insert_if) (simp add:image_def) |
|
1097 |
finally show ?thesis . |
|
1098 |
next |
|
1099 |
assume "\<not> p x" |
|
1100 |
hence eq: "?S' = Suc ` ?S" |
|
25162 | 1101 |
by(auto simp add: image_def split:nat.split elim:lessE) |
15281 | 1102 |
have "length (filter p (x # xs)) = card ?S" |
23388 | 1103 |
using Cons `\<not> p x` by simp |
15281 | 1104 |
also have "\<dots> = card(Suc ` ?S)" using fin |
1105 |
by (simp add: card_image inj_Suc) |
|
1106 |
also have "\<dots> = card ?S'" using eq fin |
|
1107 |
by (simp add:card_insert_if) |
|
1108 |
finally show ?thesis . |
|
1109 |
qed |
|
1110 |
qed |
|
1111 |
||
17629 | 1112 |
lemma Cons_eq_filterD: |
1113 |
"x#xs = filter P ys \<Longrightarrow> |
|
1114 |
\<exists>us vs. ys = us @ x # vs \<and> (\<forall>u\<in>set us. \<not> P u) \<and> P x \<and> xs = filter P vs" |
|
19585 | 1115 |
(is "_ \<Longrightarrow> \<exists>us vs. ?P ys us vs") |
17629 | 1116 |
proof(induct ys) |
1117 |
case Nil thus ?case by simp |
|
1118 |
next |
|
1119 |
case (Cons y ys) |
|
1120 |
show ?case (is "\<exists>x. ?Q x") |
|
1121 |
proof cases |
|
1122 |
assume Py: "P y" |
|
1123 |
show ?thesis |
|
1124 |
proof cases |
|
25221
5ded95dda5df
append/member: more light-weight way to declare authentic syntax;
wenzelm
parents:
25215
diff
changeset
|
1125 |
assume "x = y" |
5ded95dda5df
append/member: more light-weight way to declare authentic syntax;
wenzelm
parents:
25215
diff
changeset
|
1126 |
with Py Cons.prems have "?Q []" by simp |
5ded95dda5df
append/member: more light-weight way to declare authentic syntax;
wenzelm
parents:
25215
diff
changeset
|
1127 |
then show ?thesis .. |
17629 | 1128 |
next |
25221
5ded95dda5df
append/member: more light-weight way to declare authentic syntax;
wenzelm
parents:
25215
diff
changeset
|
1129 |
assume "x \<noteq> y" |
5ded95dda5df
append/member: more light-weight way to declare authentic syntax;
wenzelm
parents:
25215
diff
changeset
|
1130 |
with Py Cons.prems show ?thesis by simp |
17629 | 1131 |
qed |
1132 |
next |
|
25221
5ded95dda5df
append/member: more light-weight way to declare authentic syntax;
wenzelm
parents:
25215
diff
changeset
|
1133 |
assume "\<not> P y" |
5ded95dda5df
append/member: more light-weight way to declare authentic syntax;
wenzelm
parents:
25215
diff
changeset
|
1134 |
with Cons obtain us vs where "?P (y#ys) (y#us) vs" by fastsimp |
5ded95dda5df
append/member: more light-weight way to declare authentic syntax;
wenzelm
parents:
25215
diff
changeset
|
1135 |
then have "?Q (y#us)" by simp |
5ded95dda5df
append/member: more light-weight way to declare authentic syntax;
wenzelm
parents:
25215
diff
changeset
|
1136 |
then show ?thesis .. |
17629 | 1137 |
qed |
1138 |
qed |
|
1139 |
||
1140 |
lemma filter_eq_ConsD: |
|
1141 |
"filter P ys = x#xs \<Longrightarrow> |
|
1142 |
\<exists>us vs. ys = us @ x # vs \<and> (\<forall>u\<in>set us. \<not> P u) \<and> P x \<and> xs = filter P vs" |
|
1143 |
by(rule Cons_eq_filterD) simp |
|
1144 |
||
1145 |
lemma filter_eq_Cons_iff: |
|
1146 |
"(filter P ys = x#xs) = |
|
1147 |
(\<exists>us vs. ys = us @ x # vs \<and> (\<forall>u\<in>set us. \<not> P u) \<and> P x \<and> xs = filter P vs)" |
|
1148 |
by(auto dest:filter_eq_ConsD) |
|
1149 |
||
1150 |
lemma Cons_eq_filter_iff: |
|
1151 |
"(x#xs = filter P ys) = |
|
1152 |
(\<exists>us vs. ys = us @ x # vs \<and> (\<forall>u\<in>set us. \<not> P u) \<and> P x \<and> xs = filter P vs)" |
|
1153 |
by(auto dest:Cons_eq_filterD) |
|
1154 |
||
19770
be5c23ebe1eb
HOL/Tools/function_package: Added support for mutual recursive definitions.
krauss
parents:
19623
diff
changeset
|
1155 |
lemma filter_cong[fundef_cong, recdef_cong]: |
17501 | 1156 |
"xs = ys \<Longrightarrow> (\<And>x. x \<in> set ys \<Longrightarrow> P x = Q x) \<Longrightarrow> filter P xs = filter Q ys" |
1157 |
apply simp |
|
1158 |
apply(erule thin_rl) |
|
1159 |
by (induct ys) simp_all |
|
1160 |
||
15281 | 1161 |
|
26442
57fb6a8b099e
restructuring; explicit case names for rule list_induct2
haftmann
parents:
26300
diff
changeset
|
1162 |
subsubsection {* List partitioning *} |
57fb6a8b099e
restructuring; explicit case names for rule list_induct2
haftmann
parents:
26300
diff
changeset
|
1163 |
|
57fb6a8b099e
restructuring; explicit case names for rule list_induct2
haftmann
parents:
26300
diff
changeset
|
1164 |
primrec partition :: "('a \<Rightarrow> bool) \<Rightarrow>'a list \<Rightarrow> 'a list \<times> 'a list" where |
57fb6a8b099e
restructuring; explicit case names for rule list_induct2
haftmann
parents:
26300
diff
changeset
|
1165 |
"partition P [] = ([], [])" |
57fb6a8b099e
restructuring; explicit case names for rule list_induct2
haftmann
parents:
26300
diff
changeset
|
1166 |
| "partition P (x # xs) = |
57fb6a8b099e
restructuring; explicit case names for rule list_induct2
haftmann
parents:
26300
diff
changeset
|
1167 |
(let (yes, no) = partition P xs |
57fb6a8b099e
restructuring; explicit case names for rule list_induct2
haftmann
parents:
26300
diff
changeset
|
1168 |
in if P x then (x # yes, no) else (yes, x # no))" |
57fb6a8b099e
restructuring; explicit case names for rule list_induct2
haftmann
parents:
26300
diff
changeset
|
1169 |
|
57fb6a8b099e
restructuring; explicit case names for rule list_induct2
haftmann
parents:
26300
diff
changeset
|
1170 |
lemma partition_filter1: |
57fb6a8b099e
restructuring; explicit case names for rule list_induct2
haftmann
parents:
26300
diff
changeset
|
1171 |
"fst (partition P xs) = filter P xs" |
57fb6a8b099e
restructuring; explicit case names for rule list_induct2
haftmann
parents:
26300
diff
changeset
|
1172 |
by (induct xs) (auto simp add: Let_def split_def) |
57fb6a8b099e
restructuring; explicit case names for rule list_induct2
haftmann
parents:
26300
diff
changeset
|
1173 |
|
57fb6a8b099e
restructuring; explicit case names for rule list_induct2
haftmann
parents:
26300
diff
changeset
|
1174 |
lemma partition_filter2: |
57fb6a8b099e
restructuring; explicit case names for rule list_induct2
haftmann
parents:
26300
diff
changeset
|
1175 |
"snd (partition P xs) = filter (Not o P) xs" |
57fb6a8b099e
restructuring; explicit case names for rule list_induct2
haftmann
parents:
26300
diff
changeset
|
1176 |
by (induct xs) (auto simp add: Let_def split_def) |
57fb6a8b099e
restructuring; explicit case names for rule list_induct2
haftmann
parents:
26300
diff
changeset
|
1177 |
|
57fb6a8b099e
restructuring; explicit case names for rule list_induct2
haftmann
parents:
26300
diff
changeset
|
1178 |
lemma partition_P: |
57fb6a8b099e
restructuring; explicit case names for rule list_induct2
haftmann
parents:
26300
diff
changeset
|
1179 |
assumes "partition P xs = (yes, no)" |
57fb6a8b099e
restructuring; explicit case names for rule list_induct2
haftmann
parents:
26300
diff
changeset
|
1180 |
shows "(\<forall>p \<in> set yes. P p) \<and> (\<forall>p \<in> set no. \<not> P p)" |
57fb6a8b099e
restructuring; explicit case names for rule list_induct2
haftmann
parents:
26300
diff
changeset
|
1181 |
proof - |
57fb6a8b099e
restructuring; explicit case names for rule list_induct2
haftmann
parents:
26300
diff
changeset
|
1182 |
from assms have "yes = fst (partition P xs)" and "no = snd (partition P xs)" |
57fb6a8b099e
restructuring; explicit case names for rule list_induct2
haftmann
parents:
26300
diff
changeset
|
1183 |
by simp_all |
57fb6a8b099e
restructuring; explicit case names for rule list_induct2
haftmann
parents:
26300
diff
changeset
|
1184 |
then show ?thesis by (simp_all add: partition_filter1 partition_filter2) |
57fb6a8b099e
restructuring; explicit case names for rule list_induct2
haftmann
parents:
26300
diff
changeset
|
1185 |
qed |
57fb6a8b099e
restructuring; explicit case names for rule list_induct2
haftmann
parents:
26300
diff
changeset
|
1186 |
|
57fb6a8b099e
restructuring; explicit case names for rule list_induct2
haftmann
parents:
26300
diff
changeset
|
1187 |
lemma partition_set: |
57fb6a8b099e
restructuring; explicit case names for rule list_induct2
haftmann
parents:
26300
diff
changeset
|
1188 |
assumes "partition P xs = (yes, no)" |
57fb6a8b099e
restructuring; explicit case names for rule list_induct2
haftmann
parents:
26300
diff
changeset
|
1189 |
shows "set yes \<union> set no = set xs" |
57fb6a8b099e
restructuring; explicit case names for rule list_induct2
haftmann
parents:
26300
diff
changeset
|
1190 |
proof - |
57fb6a8b099e
restructuring; explicit case names for rule list_induct2
haftmann
parents:
26300
diff
changeset
|
1191 |
from assms have "yes = fst (partition P xs)" and "no = snd (partition P xs)" |
57fb6a8b099e
restructuring; explicit case names for rule list_induct2
haftmann
parents:
26300
diff
changeset
|
1192 |
by simp_all |
57fb6a8b099e
restructuring; explicit case names for rule list_induct2
haftmann
parents:
26300
diff
changeset
|
1193 |
then show ?thesis by (auto simp add: partition_filter1 partition_filter2) |
57fb6a8b099e
restructuring; explicit case names for rule list_induct2
haftmann
parents:
26300
diff
changeset
|
1194 |
qed |
57fb6a8b099e
restructuring; explicit case names for rule list_induct2
haftmann
parents:
26300
diff
changeset
|
1195 |
|
33639
603320b93668
New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents:
33593
diff
changeset
|
1196 |
lemma partition_filter_conv[simp]: |
603320b93668
New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents:
33593
diff
changeset
|
1197 |
"partition f xs = (filter f xs,filter (Not o f) xs)" |
603320b93668
New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents:
33593
diff
changeset
|
1198 |
unfolding partition_filter2[symmetric] |
603320b93668
New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents:
33593
diff
changeset
|
1199 |
unfolding partition_filter1[symmetric] by simp |
603320b93668
New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents:
33593
diff
changeset
|
1200 |
|
603320b93668
New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents:
33593
diff
changeset
|
1201 |
declare partition.simps[simp del] |
26442
57fb6a8b099e
restructuring; explicit case names for rule list_induct2
haftmann
parents:
26300
diff
changeset
|
1202 |
|
15392 | 1203 |
subsubsection {* @{text concat} *} |
13114 | 1204 |
|
13142 | 1205 |
lemma concat_append [simp]: "concat (xs @ ys) = concat xs @ concat ys" |
13145 | 1206 |
by (induct xs) auto |
13114 | 1207 |
|
18447 | 1208 |
lemma concat_eq_Nil_conv [simp]: "(concat xss = []) = (\<forall>xs \<in> set xss. xs = [])" |
13145 | 1209 |
by (induct xss) auto |
13114 | 1210 |
|
18447 | 1211 |
lemma Nil_eq_concat_conv [simp]: "([] = concat xss) = (\<forall>xs \<in> set xss. xs = [])" |
13145 | 1212 |
by (induct xss) auto |
13114 | 1213 |
|
24308 | 1214 |
lemma set_concat [simp]: "set (concat xs) = (UN x:set xs. set x)" |
13145 | 1215 |
by (induct xs) auto |
13114 | 1216 |
|
24476
f7ad9fbbeeaa
turned list comprehension translations into ML to optimize base case
nipkow
parents:
24471
diff
changeset
|
1217 |
lemma concat_map_singleton[simp]: "concat(map (%x. [f x]) xs) = map f xs" |
24349 | 1218 |
by (induct xs) auto |
1219 |
||
13142 | 1220 |
lemma map_concat: "map f (concat xs) = concat (map (map f) xs)" |
13145 | 1221 |
by (induct xs) auto |
13114 | 1222 |
|
13142 | 1223 |
lemma filter_concat: "filter p (concat xs) = concat (map (filter p) xs)" |
13145 | 1224 |
by (induct xs) auto |
13114 | 1225 |
|
13142 | 1226 |
lemma rev_concat: "rev (concat xs) = concat (map rev (rev xs))" |
13145 | 1227 |
by (induct xs) auto |
13114 | 1228 |
|
1229 |
||
15392 | 1230 |
subsubsection {* @{text nth} *} |
13114 | 1231 |
|
29827 | 1232 |
lemma nth_Cons_0 [simp, code]: "(x # xs)!0 = x" |
13145 | 1233 |
by auto |
13114 | 1234 |
|
29827 | 1235 |
lemma nth_Cons_Suc [simp, code]: "(x # xs)!(Suc n) = xs!n" |
13145 | 1236 |
by auto |
13114 | 1237 |
|
13142 | 1238 |
declare nth.simps [simp del] |
13114 | 1239 |
|
1240 |
lemma nth_append: |
|
24526 | 1241 |
"(xs @ ys)!n = (if n < length xs then xs!n else ys!(n - length xs))" |
1242 |
apply (induct xs arbitrary: n, simp) |
|
14208 | 1243 |
apply (case_tac n, auto) |
13145 | 1244 |
done |
13114 | 1245 |
|
14402
4201e1916482
moved lemmas from MicroJava/Comp/AuxLemmas.thy to List.thy
nipkow
parents:
14395
diff
changeset
|
1246 |
lemma nth_append_length [simp]: "(xs @ x # ys) ! length xs = x" |
25221
5ded95dda5df
append/member: more light-weight way to declare authentic syntax;
wenzelm
parents:
25215
diff
changeset
|
1247 |
by (induct xs) auto |
14402
4201e1916482
moved lemmas from MicroJava/Comp/AuxLemmas.thy to List.thy
nipkow
parents:
14395
diff
changeset
|
1248 |
|
4201e1916482
moved lemmas from MicroJava/Comp/AuxLemmas.thy to List.thy
nipkow
parents:
14395
diff
changeset
|
1249 |
lemma nth_append_length_plus[simp]: "(xs @ ys) ! (length xs + n) = ys ! n" |
25221
5ded95dda5df
append/member: more light-weight way to declare authentic syntax;
wenzelm
parents:
25215
diff
changeset
|
1250 |
by (induct xs) auto |
14402
4201e1916482
moved lemmas from MicroJava/Comp/AuxLemmas.thy to List.thy
nipkow
parents:
14395
diff
changeset
|
1251 |
|
24526 | 1252 |
lemma nth_map [simp]: "n < length xs ==> (map f xs)!n = f(xs!n)" |
1253 |
apply (induct xs arbitrary: n, simp) |
|
14208 | 1254 |
apply (case_tac n, auto) |
13145 | 1255 |
done |
13114 | 1256 |
|
18423 | 1257 |
lemma hd_conv_nth: "xs \<noteq> [] \<Longrightarrow> hd xs = xs!0" |
1258 |
by(cases xs) simp_all |
|
1259 |
||
18049 | 1260 |
|
1261 |
lemma list_eq_iff_nth_eq: |
|
24526 | 1262 |
"(xs = ys) = (length xs = length ys \<and> (ALL i<length xs. xs!i = ys!i))" |
1263 |
apply(induct xs arbitrary: ys) |
|
24632 | 1264 |
apply force |
18049 | 1265 |
apply(case_tac ys) |
1266 |
apply simp |
|
1267 |
apply(simp add:nth_Cons split:nat.split)apply blast |
|
1268 |
done |
|
1269 |
||
13142 | 1270 |
lemma set_conv_nth: "set xs = {xs!i | i. i < length xs}" |
15251 | 1271 |
apply (induct xs, simp, simp) |
13145 | 1272 |
apply safe |
24632 | 1273 |
apply (metis nat_case_0 nth.simps zero_less_Suc) |
1274 |
apply (metis less_Suc_eq_0_disj nth_Cons_Suc) |
|
14208 | 1275 |
apply (case_tac i, simp) |
24632 | 1276 |
apply (metis diff_Suc_Suc nat_case_Suc nth.simps zero_less_diff) |
13145 | 1277 |
done |
13114 | 1278 |
|
17501 | 1279 |
lemma in_set_conv_nth: "(x \<in> set xs) = (\<exists>i < length xs. xs!i = x)" |
1280 |
by(auto simp:set_conv_nth) |
|
1281 |
||
13145 | 1282 |
lemma list_ball_nth: "[| n < length xs; !x : set xs. P x|] ==> P(xs!n)" |
1283 |
by (auto simp add: set_conv_nth) |
|
13114 | 1284 |
|
13142 | 1285 |
lemma nth_mem [simp]: "n < length xs ==> xs!n : set xs" |
13145 | 1286 |
by (auto simp add: set_conv_nth) |
13114 | 1287 |
|
1288 |
lemma all_nth_imp_all_set: |
|
13145 | 1289 |
"[| !i < length xs. P(xs!i); x : set xs|] ==> P x" |
1290 |
by (auto simp add: set_conv_nth) |
|
13114 | 1291 |
|
1292 |
lemma all_set_conv_all_nth: |
|
13145 | 1293 |
"(\<forall>x \<in> set xs. P x) = (\<forall>i. i < length xs --> P (xs ! i))" |
1294 |
by (auto simp add: set_conv_nth) |
|
13114 | 1295 |
|
25296 | 1296 |
lemma rev_nth: |
1297 |
"n < size xs \<Longrightarrow> rev xs ! n = xs ! (length xs - Suc n)" |
|
1298 |
proof (induct xs arbitrary: n) |
|
1299 |
case Nil thus ?case by simp |
|
1300 |
next |
|
1301 |
case (Cons x xs) |
|
1302 |
hence n: "n < Suc (length xs)" by simp |
|
1303 |
moreover |
|
1304 |
{ assume "n < length xs" |
|
1305 |
with n obtain n' where "length xs - n = Suc n'" |
|
1306 |
by (cases "length xs - n", auto) |
|
1307 |
moreover |
|
1308 |
then have "length xs - Suc n = n'" by simp |
|
1309 |
ultimately |
|
1310 |
have "xs ! (length xs - Suc n) = (x # xs) ! (length xs - n)" by simp |
|
1311 |
} |
|
1312 |
ultimately |
|
1313 |
show ?case by (clarsimp simp add: Cons nth_append) |
|
1314 |
qed |
|
13114 | 1315 |
|
31159 | 1316 |
lemma Skolem_list_nth: |
1317 |
"(ALL i<k. EX x. P i x) = (EX xs. size xs = k & (ALL i<k. P i (xs!i)))" |
|
1318 |
(is "_ = (EX xs. ?P k xs)") |
|
1319 |
proof(induct k) |
|
1320 |
case 0 show ?case by simp |
|
1321 |
next |
|
1322 |
case (Suc k) |
|
1323 |
show ?case (is "?L = ?R" is "_ = (EX xs. ?P' xs)") |
|
1324 |
proof |
|
1325 |
assume "?R" thus "?L" using Suc by auto |
|
1326 |
next |
|
1327 |
assume "?L" |
|
1328 |
with Suc obtain x xs where "?P k xs & P k x" by (metis less_Suc_eq) |
|
1329 |
hence "?P'(xs@[x])" by(simp add:nth_append less_Suc_eq) |
|
1330 |
thus "?R" .. |
|
1331 |
qed |
|
1332 |
qed |
|
1333 |
||
1334 |
||
15392 | 1335 |
subsubsection {* @{text list_update} *} |
13114 | 1336 |
|
24526 | 1337 |
lemma length_list_update [simp]: "length(xs[i:=x]) = length xs" |
1338 |
by (induct xs arbitrary: i) (auto split: nat.split) |
|
13114 | 1339 |
|
1340 |
lemma nth_list_update: |
|
24526 | 1341 |
"i < length xs==> (xs[i:=x])!j = (if i = j then x else xs!j)" |
1342 |
by (induct xs arbitrary: i j) (auto simp add: nth_Cons split: nat.split) |
|
13114 | 1343 |
|
13142 | 1344 |
lemma nth_list_update_eq [simp]: "i < length xs ==> (xs[i:=x])!i = x" |
13145 | 1345 |
by (simp add: nth_list_update) |
13114 | 1346 |
|
24526 | 1347 |
lemma nth_list_update_neq [simp]: "i \<noteq> j ==> xs[i:=x]!j = xs!j" |
1348 |
by (induct xs arbitrary: i j) (auto simp add: nth_Cons split: nat.split) |
|
13114 | 1349 |
|
24526 | 1350 |
lemma list_update_id[simp]: "xs[i := xs!i] = xs" |
1351 |
by (induct xs arbitrary: i) (simp_all split:nat.splits) |
|
1352 |
||
1353 |
lemma list_update_beyond[simp]: "length xs \<le> i \<Longrightarrow> xs[i:=x] = xs" |
|
1354 |
apply (induct xs arbitrary: i) |
|
17501 | 1355 |
apply simp |
1356 |
apply (case_tac i) |
|
1357 |
apply simp_all |
|
1358 |
done |
|
1359 |
||
31077 | 1360 |
lemma list_update_nonempty[simp]: "xs[k:=x] = [] \<longleftrightarrow> xs=[]" |
1361 |
by(metis length_0_conv length_list_update) |
|
1362 |
||
13114 | 1363 |
lemma list_update_same_conv: |
24526 | 1364 |
"i < length xs ==> (xs[i := x] = xs) = (xs!i = x)" |
1365 |
by (induct xs arbitrary: i) (auto split: nat.split) |
|
13114 | 1366 |
|
14187 | 1367 |
lemma list_update_append1: |
24526 | 1368 |
"i < size xs \<Longrightarrow> (xs @ ys)[i:=x] = xs[i:=x] @ ys" |
1369 |
apply (induct xs arbitrary: i, simp) |
|
14187 | 1370 |
apply(simp split:nat.split) |
1371 |
done |
|
1372 |
||
15868 | 1373 |
lemma list_update_append: |
24526 | 1374 |
"(xs @ ys) [n:= x] = |
15868 | 1375 |
(if n < length xs then xs[n:= x] @ ys else xs @ (ys [n-length xs:= x]))" |
24526 | 1376 |
by (induct xs arbitrary: n) (auto split:nat.splits) |
15868 | 1377 |
|
14402
4201e1916482
moved lemmas from MicroJava/Comp/AuxLemmas.thy to List.thy
nipkow
parents:
14395
diff
changeset
|
1378 |
lemma list_update_length [simp]: |
4201e1916482
moved lemmas from MicroJava/Comp/AuxLemmas.thy to List.thy
nipkow
parents:
14395
diff
changeset
|
1379 |
"(xs @ x # ys)[length xs := y] = (xs @ y # ys)" |
4201e1916482
moved lemmas from MicroJava/Comp/AuxLemmas.thy to List.thy
nipkow
parents:
14395
diff
changeset
|
1380 |
by (induct xs, auto) |
4201e1916482
moved lemmas from MicroJava/Comp/AuxLemmas.thy to List.thy
nipkow
parents:
14395
diff
changeset
|
1381 |
|
31264 | 1382 |
lemma map_update: "map f (xs[k:= y]) = (map f xs)[k := f y]" |
1383 |
by(induct xs arbitrary: k)(auto split:nat.splits) |
|
1384 |
||
1385 |
lemma rev_update: |
|
1386 |
"k < length xs \<Longrightarrow> rev (xs[k:= y]) = (rev xs)[length xs - k - 1 := y]" |
|
1387 |
by (induct xs arbitrary: k) (auto simp: list_update_append split:nat.splits) |
|
1388 |
||
13114 | 1389 |
lemma update_zip: |
31080 | 1390 |
"(zip xs ys)[i:=xy] = zip (xs[i:=fst xy]) (ys[i:=snd xy])" |
24526 | 1391 |
by (induct ys arbitrary: i xy xs) (auto, case_tac xs, auto split: nat.split) |
1392 |
||
1393 |
lemma set_update_subset_insert: "set(xs[i:=x]) <= insert x (set xs)" |
|
1394 |
by (induct xs arbitrary: i) (auto split: nat.split) |
|
13114 | 1395 |
|
1396 |
lemma set_update_subsetI: "[| set xs <= A; x:A |] ==> set(xs[i := x]) <= A" |
|
13145 | 1397 |
by (blast dest!: set_update_subset_insert [THEN subsetD]) |
13114 | 1398 |
|
24526 | 1399 |
lemma set_update_memI: "n < length xs \<Longrightarrow> x \<in> set (xs[n := x])" |
1400 |
by (induct xs arbitrary: n) (auto split:nat.splits) |
|
15868 | 1401 |
|
31077 | 1402 |
lemma list_update_overwrite[simp]: |
24796 | 1403 |
"xs [i := x, i := y] = xs [i := y]" |
31077 | 1404 |
apply (induct xs arbitrary: i) apply simp |
1405 |
apply (case_tac i, simp_all) |
|
24796 | 1406 |
done |
1407 |
||
1408 |
lemma list_update_swap: |
|
1409 |
"i \<noteq> i' \<Longrightarrow> xs [i := x, i' := x'] = xs [i' := x', i := x]" |
|
1410 |
apply (induct xs arbitrary: i i') |
|
1411 |
apply simp |
|
1412 |
apply (case_tac i, case_tac i') |
|
1413 |
apply auto |
|
1414 |
apply (case_tac i') |
|
1415 |
apply auto |
|
1416 |
done |
|
1417 |
||
29827 | 1418 |
lemma list_update_code [code]: |
1419 |
"[][i := y] = []" |
|
1420 |
"(x # xs)[0 := y] = y # xs" |
|
1421 |
"(x # xs)[Suc i := y] = x # xs[i := y]" |
|
1422 |
by simp_all |
|
1423 |
||
13114 | 1424 |
|
15392 | 1425 |
subsubsection {* @{text last} and @{text butlast} *} |
13114 | 1426 |
|
13142 | 1427 |
lemma last_snoc [simp]: "last (xs @ [x]) = x" |
13145 | 1428 |
by (induct xs) auto |
13114 | 1429 |
|
13142 | 1430 |
lemma butlast_snoc [simp]: "butlast (xs @ [x]) = xs" |
13145 | 1431 |
by (induct xs) auto |
13114 | 1432 |
|
14302 | 1433 |
lemma last_ConsL: "xs = [] \<Longrightarrow> last(x#xs) = x" |
1434 |
by(simp add:last.simps) |
|
1435 |
||
1436 |
lemma last_ConsR: "xs \<noteq> [] \<Longrightarrow> last(x#xs) = last xs" |
|
1437 |
by(simp add:last.simps) |
|
1438 |
||
1439 |
lemma last_append: "last(xs @ ys) = (if ys = [] then last xs else last ys)" |
|
1440 |
by (induct xs) (auto) |
|
1441 |
||
1442 |
lemma last_appendL[simp]: "ys = [] \<Longrightarrow> last(xs @ ys) = last xs" |
|
1443 |
by(simp add:last_append) |
|
1444 |
||
1445 |
lemma last_appendR[simp]: "ys \<noteq> [] \<Longrightarrow> last(xs @ ys) = last ys" |
|
1446 |
by(simp add:last_append) |
|
1447 |
||
17762 | 1448 |
lemma hd_rev: "xs \<noteq> [] \<Longrightarrow> hd(rev xs) = last xs" |
1449 |
by(rule rev_exhaust[of xs]) simp_all |
|
1450 |
||
1451 |
lemma last_rev: "xs \<noteq> [] \<Longrightarrow> last(rev xs) = hd xs" |
|
1452 |
by(cases xs) simp_all |
|
1453 |
||
17765 | 1454 |
lemma last_in_set[simp]: "as \<noteq> [] \<Longrightarrow> last as \<in> set as" |
1455 |
by (induct as) auto |
|
17762 | 1456 |
|
13142 | 1457 |
lemma length_butlast [simp]: "length (butlast xs) = length xs - 1" |
13145 | 1458 |
by (induct xs rule: rev_induct) auto |
13114 | 1459 |
|
1460 |
lemma butlast_append: |
|
24526 | 1461 |
"butlast (xs @ ys) = (if ys = [] then butlast xs else xs @ butlast ys)" |
1462 |
by (induct xs arbitrary: ys) auto |
|
13114 | 1463 |
|
13142 | 1464 |
lemma append_butlast_last_id [simp]: |
13145 | 1465 |
"xs \<noteq> [] ==> butlast xs @ [last xs] = xs" |
1466 |
by (induct xs) auto |
|
13114 | 1467 |
|
13142 | 1468 |
lemma in_set_butlastD: "x : set (butlast xs) ==> x : set xs" |
13145 | 1469 |
by (induct xs) (auto split: split_if_asm) |
13114 | 1470 |
|
1471 |
lemma in_set_butlast_appendI: |
|
13145 | 1472 |
"x : set (butlast xs) | x : set (butlast ys) ==> x : set (butlast (xs @ ys))" |
1473 |
by (auto dest: in_set_butlastD simp add: butlast_append) |
|
13114 | 1474 |
|
24526 | 1475 |
lemma last_drop[simp]: "n < length xs \<Longrightarrow> last (drop n xs) = last xs" |
1476 |
apply (induct xs arbitrary: n) |
|
17501 | 1477 |
apply simp |
1478 |
apply (auto split:nat.split) |
|
1479 |
done |
|
1480 |
||
30128
365ee7319b86
revert some Suc 0 lemmas back to their original forms; added some simp rules for (1::nat)
huffman
parents:
30079
diff
changeset
|
1481 |
lemma last_conv_nth: "xs\<noteq>[] \<Longrightarrow> last xs = xs!(length xs - 1)" |
17589 | 1482 |
by(induct xs)(auto simp:neq_Nil_conv) |
1483 |
||
30128
365ee7319b86
revert some Suc 0 lemmas back to their original forms; added some simp rules for (1::nat)
huffman
parents:
30079
diff
changeset
|
1484 |
lemma butlast_conv_take: "butlast xs = take (length xs - 1) xs" |
26584
46f3b89b2445
move lemmas from Word/BinBoolList.thy to List.thy
huffman
parents:
26480
diff
changeset
|
1485 |
by (induct xs, simp, case_tac xs, simp_all) |
46f3b89b2445
move lemmas from Word/BinBoolList.thy to List.thy
huffman
parents:
26480
diff
changeset
|
1486 |
|
31077 | 1487 |
lemma last_list_update: |
1488 |
"xs \<noteq> [] \<Longrightarrow> last(xs[k:=x]) = (if k = size xs - 1 then x else last xs)" |
|
1489 |
by (auto simp: last_conv_nth) |
|
1490 |
||
1491 |
lemma butlast_list_update: |
|
1492 |
"butlast(xs[k:=x]) = |
|
1493 |
(if k = size xs - 1 then butlast xs else (butlast xs)[k:=x])" |
|
1494 |
apply(cases xs rule:rev_cases) |
|
1495 |
apply simp |
|
1496 |
apply(simp add:list_update_append split:nat.splits) |
|
1497 |
done |
|
1498 |
||
24796 | 1499 |
|
15392 | 1500 |
subsubsection {* @{text take} and @{text drop} *} |
13114 | 1501 |
|
13142 | 1502 |
lemma take_0 [simp]: "take 0 xs = []" |
13145 | 1503 |
by (induct xs) auto |
13114 | 1504 |
|
13142 | 1505 |
lemma drop_0 [simp]: "drop 0 xs = xs" |
13145 | 1506 |
by (induct xs) auto |
13114 | 1507 |
|
13142 | 1508 |
lemma take_Suc_Cons [simp]: "take (Suc n) (x # xs) = x # take n xs" |
13145 | 1509 |
by simp |
13114 | 1510 |
|
13142 | 1511 |
lemma drop_Suc_Cons [simp]: "drop (Suc n) (x # xs) = drop n xs" |
13145 | 1512 |
by simp |
13114 | 1513 |
|
13142 | 1514 |
declare take_Cons [simp del] and drop_Cons [simp del] |
13114 | 1515 |
|
30128
365ee7319b86
revert some Suc 0 lemmas back to their original forms; added some simp rules for (1::nat)
huffman
parents:
30079
diff
changeset
|
1516 |
lemma take_1_Cons [simp]: "take 1 (x # xs) = [x]" |
365ee7319b86
revert some Suc 0 lemmas back to their original forms; added some simp rules for (1::nat)
huffman
parents:
30079
diff
changeset
|
1517 |
unfolding One_nat_def by simp |
365ee7319b86
revert some Suc 0 lemmas back to their original forms; added some simp rules for (1::nat)
huffman
parents:
30079
diff
changeset
|
1518 |
|
365ee7319b86
revert some Suc 0 lemmas back to their original forms; added some simp rules for (1::nat)
huffman
parents:
30079
diff
changeset
|
1519 |
lemma drop_1_Cons [simp]: "drop 1 (x # xs) = xs" |
365ee7319b86
revert some Suc 0 lemmas back to their original forms; added some simp rules for (1::nat)
huffman
parents:
30079
diff
changeset
|
1520 |
unfolding One_nat_def by simp |
365ee7319b86
revert some Suc 0 lemmas back to their original forms; added some simp rules for (1::nat)
huffman
parents:
30079
diff
changeset
|
1521 |
|
15110
78b5636eabc7
Added a number of new thms and the new function remove1
nipkow
parents:
15072
diff
changeset
|
1522 |
lemma take_Suc: "xs ~= [] ==> take (Suc n) xs = hd xs # take n (tl xs)" |
78b5636eabc7
Added a number of new thms and the new function remove1
nipkow
parents:
15072
diff
changeset
|
1523 |
by(clarsimp simp add:neq_Nil_conv) |
78b5636eabc7
Added a number of new thms and the new function remove1
nipkow
parents:
15072
diff
changeset
|
1524 |
|
14187 | 1525 |
lemma drop_Suc: "drop (Suc n) xs = drop n (tl xs)" |
1526 |
by(cases xs, simp_all) |
|
1527 |
||
26584
46f3b89b2445
move lemmas from Word/BinBoolList.thy to List.thy
huffman
parents:
26480
diff
changeset
|
1528 |
lemma take_tl: "take n (tl xs) = tl (take (Suc n) xs)" |
46f3b89b2445
move lemmas from Word/BinBoolList.thy to List.thy
huffman
parents:
26480
diff
changeset
|
1529 |
by (induct xs arbitrary: n) simp_all |
46f3b89b2445
move lemmas from Word/BinBoolList.thy to List.thy
huffman
parents:
26480
diff
changeset
|
1530 |
|
24526 | 1531 |
lemma drop_tl: "drop n (tl xs) = tl(drop n xs)" |
1532 |
by(induct xs arbitrary: n, simp_all add:drop_Cons drop_Suc split:nat.split) |
|
1533 |
||
26584
46f3b89b2445
move lemmas from Word/BinBoolList.thy to List.thy
huffman
parents:
26480
diff
changeset
|
1534 |
lemma tl_take: "tl (take n xs) = take (n - 1) (tl xs)" |
46f3b89b2445
move lemmas from Word/BinBoolList.thy to List.thy
huffman
parents:
26480
diff
changeset
|
1535 |
by (cases n, simp, cases xs, auto) |
46f3b89b2445
move lemmas from Word/BinBoolList.thy to List.thy
huffman
parents:
26480
diff
changeset
|
1536 |
|
46f3b89b2445
move lemmas from Word/BinBoolList.thy to List.thy
huffman
parents:
26480
diff
changeset
|
1537 |
lemma tl_drop: "tl (drop n xs) = drop n (tl xs)" |
46f3b89b2445
move lemmas from Word/BinBoolList.thy to List.thy
huffman
parents:
26480
diff
changeset
|
1538 |
by (simp only: drop_tl) |
46f3b89b2445
move lemmas from Word/BinBoolList.thy to List.thy
huffman
parents:
26480
diff
changeset
|
1539 |
|
24526 | 1540 |
lemma nth_via_drop: "drop n xs = y#ys \<Longrightarrow> xs!n = y" |
1541 |
apply (induct xs arbitrary: n, simp) |
|
14187 | 1542 |
apply(simp add:drop_Cons nth_Cons split:nat.splits) |
1543 |
done |
|
1544 |
||
13913 | 1545 |
lemma take_Suc_conv_app_nth: |
24526 | 1546 |
"i < length xs \<Longrightarrow> take (Suc i) xs = take i xs @ [xs!i]" |
1547 |
apply (induct xs arbitrary: i, simp) |
|
14208 | 1548 |
apply (case_tac i, auto) |
13913 | 1549 |
done |
1550 |
||
14591 | 1551 |
lemma drop_Suc_conv_tl: |
24526 | 1552 |
"i < length xs \<Longrightarrow> (xs!i) # (drop (Suc i) xs) = drop i xs" |
1553 |
apply (induct xs arbitrary: i, simp) |
|
14591 | 1554 |
apply (case_tac i, auto) |
1555 |
done |
|
1556 |
||
24526 | 1557 |
lemma length_take [simp]: "length (take n xs) = min (length xs) n" |
1558 |
by (induct n arbitrary: xs) (auto, case_tac xs, auto) |
|
1559 |
||
1560 |
lemma length_drop [simp]: "length (drop n xs) = (length xs - n)" |
|
1561 |
by (induct n arbitrary: xs) (auto, case_tac xs, auto) |
|
1562 |
||
1563 |
lemma take_all [simp]: "length xs <= n ==> take n xs = xs" |
|
1564 |
by (induct n arbitrary: xs) (auto, case_tac xs, auto) |
|
1565 |
||
1566 |
lemma drop_all [simp]: "length xs <= n ==> drop n xs = []" |
|
1567 |
by (induct n arbitrary: xs) (auto, case_tac xs, auto) |
|
13114 | 1568 |
|
13142 | 1569 |
lemma take_append [simp]: |
24526 | 1570 |
"take n (xs @ ys) = (take n xs @ take (n - length xs) ys)" |
1571 |
by (induct n arbitrary: xs) (auto, case_tac xs, auto) |
|
13114 | 1572 |
|
13142 | 1573 |
lemma drop_append [simp]: |
24526 | 1574 |
"drop n (xs @ ys) = drop n xs @ drop (n - length xs) ys" |
1575 |
by (induct n arbitrary: xs) (auto, case_tac xs, auto) |
|
1576 |
||
1577 |
lemma take_take [simp]: "take n (take m xs) = take (min n m) xs" |
|
1578 |
apply (induct m arbitrary: xs n, auto) |
|
14208 | 1579 |
apply (case_tac xs, auto) |
15236
f289e8ba2bb3
Proofs needed to be updated because induction now preserves name of
nipkow
parents:
15176
diff
changeset
|
1580 |
apply (case_tac n, auto) |
13145 | 1581 |
done |
13114 | 1582 |
|
24526 | 1583 |
lemma drop_drop [simp]: "drop n (drop m xs) = drop (n + m) xs" |
1584 |
apply (induct m arbitrary: xs, auto) |
|
14208 | 1585 |
apply (case_tac xs, auto) |
13145 | 1586 |
done |
13114 | 1587 |
|
24526 | 1588 |
lemma take_drop: "take n (drop m xs) = drop m (take (n + m) xs)" |
1589 |
apply (induct m arbitrary: xs n, auto) |
|
14208 | 1590 |
apply (case_tac xs, auto) |
13145 | 1591 |
done |
13114 | 1592 |
|
24526 | 1593 |
lemma drop_take: "drop n (take m xs) = take (m-n) (drop n xs)" |
1594 |
apply(induct xs arbitrary: m n) |
|
14802 | 1595 |
apply simp |
1596 |
apply(simp add: take_Cons drop_Cons split:nat.split) |
|
1597 |
done |
|
1598 |
||
24526 | 1599 |
lemma append_take_drop_id [simp]: "take n xs @ drop n xs = xs" |
1600 |
apply (induct n arbitrary: xs, auto) |
|
14208 | 1601 |
apply (case_tac xs, auto) |
13145 | 1602 |
done |
13114 | 1603 |
|
24526 | 1604 |
lemma take_eq_Nil[simp]: "(take n xs = []) = (n = 0 \<or> xs = [])" |
1605 |
apply(induct xs arbitrary: n) |
|
15110
78b5636eabc7
Added a number of new thms and the new function remove1
nipkow
parents:
15072
diff
changeset
|
1606 |
apply simp |
78b5636eabc7
Added a number of new thms and the new function remove1
nipkow
parents:
15072
diff
changeset
|
1607 |
apply(simp add:take_Cons split:nat.split) |
78b5636eabc7
Added a number of new thms and the new function remove1
nipkow
parents:
15072
diff
changeset
|
1608 |
done |
78b5636eabc7
Added a number of new thms and the new function remove1
nipkow
parents:
15072
diff
changeset
|
1609 |
|
24526 | 1610 |
lemma drop_eq_Nil[simp]: "(drop n xs = []) = (length xs <= n)" |
1611 |
apply(induct xs arbitrary: n) |
|
15110
78b5636eabc7
Added a number of new thms and the new function remove1
nipkow
parents:
15072
diff
changeset
|
1612 |
apply simp |
78b5636eabc7
Added a number of new thms and the new function remove1
nipkow
parents:
15072
diff
changeset
|
1613 |
apply(simp add:drop_Cons split:nat.split) |
78b5636eabc7
Added a number of new thms and the new function remove1
nipkow
parents:
15072
diff
changeset
|
1614 |
done |
78b5636eabc7
Added a number of new thms and the new function remove1
nipkow
parents:
15072
diff
changeset
|
1615 |
|
24526 | 1616 |
lemma take_map: "take n (map f xs) = map f (take n xs)" |
1617 |
apply (induct n arbitrary: xs, auto) |
|
14208 | 1618 |
apply (case_tac xs, auto) |
13145 | 1619 |
done |
13114 | 1620 |
|
24526 | 1621 |
lemma drop_map: "drop n (map f xs) = map f (drop n xs)" |
1622 |
apply (induct n arbitrary: xs, auto) |
|
14208 | 1623 |
apply (case_tac xs, auto) |
13145 | 1624 |
done |
13114 | 1625 |
|
24526 | 1626 |
lemma rev_take: "rev (take i xs) = drop (length xs - i) (rev xs)" |
1627 |
apply (induct xs arbitrary: i, auto) |
|
14208 | 1628 |
apply (case_tac i, auto) |
13145 | 1629 |
done |
13114 | 1630 |
|
24526 | 1631 |
lemma rev_drop: "rev (drop i xs) = take (length xs - i) (rev xs)" |
1632 |
apply (induct xs arbitrary: i, auto) |
|
14208 | 1633 |
apply (case_tac i, auto) |
13145 | 1634 |
done |
13114 | 1635 |
|
24526 | 1636 |
lemma nth_take [simp]: "i < n ==> (take n xs)!i = xs!i" |
1637 |
apply (induct xs arbitrary: i n, auto) |
|
14208 | 1638 |
apply (case_tac n, blast) |
1639 |
apply (case_tac i, auto) |
|
13145 | 1640 |
done |
13114 | 1641 |
|
13142 | 1642 |
lemma nth_drop [simp]: |
24526 | 1643 |
"n + i <= length xs ==> (drop n xs)!i = xs!(n + i)" |
1644 |
apply (induct n arbitrary: xs i, auto) |
|
14208 | 1645 |
apply (case_tac xs, auto) |
13145 | 1646 |
done |
3507 | 1647 |
|
26584
46f3b89b2445
move lemmas from Word/BinBoolList.thy to List.thy
huffman
parents:
26480
diff
changeset
|
1648 |
lemma butlast_take: |
30128
365ee7319b86
revert some Suc 0 lemmas back to their original forms; added some simp rules for (1::nat)
huffman
parents:
30079
diff
changeset
|
1649 |
"n <= length xs ==> butlast (take n xs) = take (n - 1) xs" |
26584
46f3b89b2445
move lemmas from Word/BinBoolList.thy to List.thy
huffman
parents:
26480
diff
changeset
|
1650 |
by (simp add: butlast_conv_take min_max.inf_absorb1 min_max.inf_absorb2) |
46f3b89b2445
move lemmas from Word/BinBoolList.thy to List.thy
huffman
parents:
26480
diff
changeset
|
1651 |
|
46f3b89b2445
move lemmas from Word/BinBoolList.thy to List.thy
huffman
parents:
26480
diff
changeset
|
1652 |
lemma butlast_drop: "butlast (drop n xs) = drop n (butlast xs)" |
30128
365ee7319b86
revert some Suc 0 lemmas back to their original forms; added some simp rules for (1::nat)
huffman
parents:
30079
diff
changeset
|
1653 |
by (simp add: butlast_conv_take drop_take add_ac) |
26584
46f3b89b2445
move lemmas from Word/BinBoolList.thy to List.thy
huffman
parents:
26480
diff
changeset
|
1654 |
|
46f3b89b2445
move lemmas from Word/BinBoolList.thy to List.thy
huffman
parents:
26480
diff
changeset
|
1655 |
lemma take_butlast: "n < length xs ==> take n (butlast xs) = take n xs" |
46f3b89b2445
move lemmas from Word/BinBoolList.thy to List.thy
huffman
parents:
26480
diff
changeset
|
1656 |
by (simp add: butlast_conv_take min_max.inf_absorb1) |
46f3b89b2445
move lemmas from Word/BinBoolList.thy to List.thy
huffman
parents:
26480
diff
changeset
|
1657 |
|
46f3b89b2445
move lemmas from Word/BinBoolList.thy to List.thy
huffman
parents:
26480
diff
changeset
|
1658 |
lemma drop_butlast: "drop n (butlast xs) = butlast (drop n xs)" |
30128
365ee7319b86
revert some Suc 0 lemmas back to their original forms; added some simp rules for (1::nat)
huffman
parents:
30079
diff
changeset
|
1659 |
by (simp add: butlast_conv_take drop_take add_ac) |
26584
46f3b89b2445
move lemmas from Word/BinBoolList.thy to List.thy
huffman
parents:
26480
diff
changeset
|
1660 |
|
18423 | 1661 |
lemma hd_drop_conv_nth: "\<lbrakk> xs \<noteq> []; n < length xs \<rbrakk> \<Longrightarrow> hd(drop n xs) = xs!n" |
1662 |
by(simp add: hd_conv_nth) |
|
1663 |
||
24526 | 1664 |
lemma set_take_subset: "set(take n xs) \<subseteq> set xs" |
1665 |
by(induct xs arbitrary: n)(auto simp:take_Cons split:nat.split) |
|
1666 |
||
1667 |
lemma set_drop_subset: "set(drop n xs) \<subseteq> set xs" |
|
1668 |
by(induct xs arbitrary: n)(auto simp:drop_Cons split:nat.split) |
|
14025 | 1669 |
|
14187 | 1670 |
lemma in_set_takeD: "x : set(take n xs) \<Longrightarrow> x : set xs" |
1671 |
using set_take_subset by fast |
|
1672 |
||
1673 |
lemma in_set_dropD: "x : set(drop n xs) \<Longrightarrow> x : set xs" |
|
1674 |
using set_drop_subset by fast |
|
1675 |
||
13114 | 1676 |
lemma append_eq_conv_conj: |
24526 | 1677 |
"(xs @ ys = zs) = (xs = take (length xs) zs \<and> ys = drop (length xs) zs)" |
1678 |
apply (induct xs arbitrary: zs, simp, clarsimp) |
|
14208 | 1679 |
apply (case_tac zs, auto) |
13145 | 1680 |
done |
13142 | 1681 |
|
24526 | 1682 |
lemma take_add: |
1683 |
"i+j \<le> length(xs) \<Longrightarrow> take (i+j) xs = take i xs @ take j (drop i xs)" |
|
1684 |
apply (induct xs arbitrary: i, auto) |
|
1685 |
apply (case_tac i, simp_all) |
|
14050 | 1686 |
done |
1687 |
||
14300 | 1688 |
lemma append_eq_append_conv_if: |
24526 | 1689 |
"(xs\<^isub>1 @ xs\<^isub>2 = ys\<^isub>1 @ ys\<^isub>2) = |
14300 | 1690 |
(if size xs\<^isub>1 \<le> size ys\<^isub>1 |
1691 |
then xs\<^isub>1 = take (size xs\<^isub>1) ys\<^isub>1 \<and> xs\<^isub>2 = drop (size xs\<^isub>1) ys\<^isub>1 @ ys\<^isub>2 |
|
1692 |
else take (size ys\<^isub>1) xs\<^isub>1 = ys\<^isub>1 \<and> drop (size ys\<^isub>1) xs\<^isub>1 @ xs\<^isub>2 = ys\<^isub>2)" |
|
24526 | 1693 |
apply(induct xs\<^isub>1 arbitrary: ys\<^isub>1) |
14300 | 1694 |
apply simp |
1695 |
apply(case_tac ys\<^isub>1) |
|
1696 |
apply simp_all |
|
1697 |
done |
|
1698 |
||
15110
78b5636eabc7
Added a number of new thms and the new function remove1
nipkow
parents:
15072
diff
changeset
|
1699 |
lemma take_hd_drop: |
30079
293b896b9c25
make proofs work whether or not One_nat_def is a simp rule; replace 1 with Suc 0 in the rhs of some simp rules
huffman
parents:
30008
diff
changeset
|
1700 |
"n < length xs \<Longrightarrow> take n xs @ [hd (drop n xs)] = take (Suc n) xs" |
24526 | 1701 |
apply(induct xs arbitrary: n) |
15110
78b5636eabc7
Added a number of new thms and the new function remove1
nipkow
parents:
15072
diff
changeset
|
1702 |
apply simp |
78b5636eabc7
Added a number of new thms and the new function remove1
nipkow
parents:
15072
diff
changeset
|
1703 |
apply(simp add:drop_Cons split:nat.split) |
78b5636eabc7
Added a number of new thms and the new function remove1
nipkow
parents:
15072
diff
changeset
|
1704 |
done |
78b5636eabc7
Added a number of new thms and the new function remove1
nipkow
parents:
15072
diff
changeset
|
1705 |
|
17501 | 1706 |
lemma id_take_nth_drop: |
1707 |
"i < length xs \<Longrightarrow> xs = take i xs @ xs!i # drop (Suc i) xs" |
|
1708 |
proof - |
|
1709 |
assume si: "i < length xs" |
|
1710 |
hence "xs = take (Suc i) xs @ drop (Suc i) xs" by auto |
|
1711 |
moreover |
|
1712 |
from si have "take (Suc i) xs = take i xs @ [xs!i]" |
|
1713 |
apply (rule_tac take_Suc_conv_app_nth) by arith |
|
1714 |
ultimately show ?thesis by auto |
|
1715 |
qed |
|
1716 |
||
1717 |
lemma upd_conv_take_nth_drop: |
|
1718 |
"i < length xs \<Longrightarrow> xs[i:=a] = take i xs @ a # drop (Suc i) xs" |
|
1719 |
proof - |
|
1720 |
assume i: "i < length xs" |
|
1721 |
have "xs[i:=a] = (take i xs @ xs!i # drop (Suc i) xs)[i:=a]" |
|
1722 |
by(rule arg_cong[OF id_take_nth_drop[OF i]]) |
|
1723 |
also have "\<dots> = take i xs @ a # drop (Suc i) xs" |
|
1724 |
using i by (simp add: list_update_append) |
|
1725 |
finally show ?thesis . |
|
1726 |
qed |
|
1727 |
||
24796 | 1728 |
lemma nth_drop': |
1729 |
"i < length xs \<Longrightarrow> xs ! i # drop (Suc i) xs = drop i xs" |
|
1730 |
apply (induct i arbitrary: xs) |
|
1731 |
apply (simp add: neq_Nil_conv) |
|
1732 |
apply (erule exE)+ |
|
1733 |
apply simp |
|
1734 |
apply (case_tac xs) |
|
1735 |
apply simp_all |
|
1736 |
done |
|
1737 |
||
13114 | 1738 |
|
15392 | 1739 |
subsubsection {* @{text takeWhile} and @{text dropWhile} *} |
13114 | 1740 |
|
33639
603320b93668
New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents:
33593
diff
changeset
|
1741 |
lemma length_takeWhile_le: "length (takeWhile P xs) \<le> length xs" |
603320b93668
New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents:
33593
diff
changeset
|
1742 |
by (induct xs) auto |
603320b93668
New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents:
33593
diff
changeset
|
1743 |
|
13142 | 1744 |
lemma takeWhile_dropWhile_id [simp]: "takeWhile P xs @ dropWhile P xs = xs" |
13145 | 1745 |
by (induct xs) auto |
13114 | 1746 |
|
13142 | 1747 |
lemma takeWhile_append1 [simp]: |
13145 | 1748 |
"[| x:set xs; ~P(x)|] ==> takeWhile P (xs @ ys) = takeWhile P xs" |
1749 |
by (induct xs) auto |
|
13114 | 1750 |
|
13142 | 1751 |
lemma takeWhile_append2 [simp]: |
13145 | 1752 |
"(!!x. x : set xs ==> P x) ==> takeWhile P (xs @ ys) = xs @ takeWhile P ys" |
1753 |
by (induct xs) auto |
|
13114 | 1754 |
|
13142 | 1755 |
lemma takeWhile_tail: "\<not> P x ==> takeWhile P (xs @ (x#l)) = takeWhile P xs" |
13145 | 1756 |
by (induct xs) auto |
13114 | 1757 |
|
33639
603320b93668
New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents:
33593
diff
changeset
|
1758 |
lemma takeWhile_nth: "j < length (takeWhile P xs) \<Longrightarrow> takeWhile P xs ! j = xs ! j" |
603320b93668
New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents:
33593
diff
changeset
|
1759 |
apply (subst (3) takeWhile_dropWhile_id[symmetric]) unfolding nth_append by auto |
603320b93668
New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents:
33593
diff
changeset
|
1760 |
|
603320b93668
New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents:
33593
diff
changeset
|
1761 |
lemma dropWhile_nth: "j < length (dropWhile P xs) \<Longrightarrow> dropWhile P xs ! j = xs ! (j + length (takeWhile P xs))" |
603320b93668
New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents:
33593
diff
changeset
|
1762 |
apply (subst (3) takeWhile_dropWhile_id[symmetric]) unfolding nth_append by auto |
603320b93668
New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents:
33593
diff
changeset
|
1763 |
|
603320b93668
New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents:
33593
diff
changeset
|
1764 |
lemma length_dropWhile_le: "length (dropWhile P xs) \<le> length xs" |
603320b93668
New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents:
33593
diff
changeset
|
1765 |
by (induct xs) auto |
603320b93668
New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents:
33593
diff
changeset
|
1766 |
|
13142 | 1767 |
lemma dropWhile_append1 [simp]: |
13145 | 1768 |
"[| x : set xs; ~P(x)|] ==> dropWhile P (xs @ ys) = (dropWhile P xs)@ys" |
1769 |
by (induct xs) auto |
|
13114 | 1770 |
|
13142 | 1771 |
lemma dropWhile_append2 [simp]: |
13145 | 1772 |
"(!!x. x:set xs ==> P(x)) ==> dropWhile P (xs @ ys) = dropWhile P ys" |
1773 |
by (induct xs) auto |
|
13114 | 1774 |
|
23971
e6d505d5b03d
renamed lemma "set_take_whileD" to "set_takeWhileD"
krauss
parents:
23740
diff
changeset
|
1775 |
lemma set_takeWhileD: "x : set (takeWhile P xs) ==> x : set xs \<and> P x" |
13145 | 1776 |
by (induct xs) (auto split: split_if_asm) |
13114 | 1777 |
|
13913 | 1778 |
lemma takeWhile_eq_all_conv[simp]: |
1779 |
"(takeWhile P xs = xs) = (\<forall>x \<in> set xs. P x)" |
|
1780 |
by(induct xs, auto) |
|
1781 |
||
1782 |
lemma dropWhile_eq_Nil_conv[simp]: |
|
1783 |
"(dropWhile P xs = []) = (\<forall>x \<in> set xs. P x)" |
|
1784 |
by(induct xs, auto) |
|
1785 |
||
1786 |
lemma dropWhile_eq_Cons_conv: |
|
1787 |
"(dropWhile P xs = y#ys) = (xs = takeWhile P xs @ y # ys & \<not> P y)" |
|
1788 |
by(induct xs, auto) |
|
1789 |
||
31077 | 1790 |
lemma distinct_takeWhile[simp]: "distinct xs ==> distinct (takeWhile P xs)" |
1791 |
by (induct xs) (auto dest: set_takeWhileD) |
|
1792 |
||
1793 |
lemma distinct_dropWhile[simp]: "distinct xs ==> distinct (dropWhile P xs)" |
|
1794 |
by (induct xs) auto |
|
1795 |
||
33639
603320b93668
New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents:
33593
diff
changeset
|
1796 |
lemma takeWhile_map: "takeWhile P (map f xs) = map f (takeWhile (P \<circ> f) xs)" |
603320b93668
New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents:
33593
diff
changeset
|
1797 |
by (induct xs) auto |
603320b93668
New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents:
33593
diff
changeset
|
1798 |
|
603320b93668
New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents:
33593
diff
changeset
|
1799 |
lemma dropWhile_map: "dropWhile P (map f xs) = map f (dropWhile (P \<circ> f) xs)" |
603320b93668
New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents:
33593
diff
changeset
|
1800 |
by (induct xs) auto |
603320b93668
New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents:
33593
diff
changeset
|
1801 |
|
603320b93668
New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents:
33593
diff
changeset
|
1802 |
lemma takeWhile_eq_take: "takeWhile P xs = take (length (takeWhile P xs)) xs" |
603320b93668
New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents:
33593
diff
changeset
|
1803 |
by (induct xs) auto |
603320b93668
New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents:
33593
diff
changeset
|
1804 |
|
603320b93668
New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents:
33593
diff
changeset
|
1805 |
lemma dropWhile_eq_drop: "dropWhile P xs = drop (length (takeWhile P xs)) xs" |
603320b93668
New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents:
33593
diff
changeset
|
1806 |
by (induct xs) auto |
603320b93668
New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents:
33593
diff
changeset
|
1807 |
|
603320b93668
New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents:
33593
diff
changeset
|
1808 |
lemma hd_dropWhile: |
603320b93668
New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents:
33593
diff
changeset
|
1809 |
"dropWhile P xs \<noteq> [] \<Longrightarrow> \<not> P (hd (dropWhile P xs))" |
603320b93668
New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents:
33593
diff
changeset
|
1810 |
using assms by (induct xs) auto |
603320b93668
New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents:
33593
diff
changeset
|
1811 |
|
603320b93668
New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents:
33593
diff
changeset
|
1812 |
lemma takeWhile_eq_filter: |
603320b93668
New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents:
33593
diff
changeset
|
1813 |
assumes "\<And> x. x \<in> set (dropWhile P xs) \<Longrightarrow> \<not> P x" |
603320b93668
New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents:
33593
diff
changeset
|
1814 |
shows "takeWhile P xs = filter P xs" |
603320b93668
New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents:
33593
diff
changeset
|
1815 |
proof - |
603320b93668
New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents:
33593
diff
changeset
|
1816 |
have A: "filter P xs = filter P (takeWhile P xs @ dropWhile P xs)" |
603320b93668
New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents:
33593
diff
changeset
|
1817 |
by simp |
603320b93668
New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents:
33593
diff
changeset
|
1818 |
have B: "filter P (dropWhile P xs) = []" |
603320b93668
New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents:
33593
diff
changeset
|
1819 |
unfolding filter_empty_conv using assms by blast |
603320b93668
New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents:
33593
diff
changeset
|
1820 |
have "filter P xs = takeWhile P xs" |
603320b93668
New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents:
33593
diff
changeset
|
1821 |
unfolding A filter_append B |
603320b93668
New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents:
33593
diff
changeset
|
1822 |
by (auto simp add: filter_id_conv dest: set_takeWhileD) |
603320b93668
New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents:
33593
diff
changeset
|
1823 |
thus ?thesis .. |
603320b93668
New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents:
33593
diff
changeset
|
1824 |
qed |
603320b93668
New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents:
33593
diff
changeset
|
1825 |
|
603320b93668
New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents:
33593
diff
changeset
|
1826 |
lemma takeWhile_eq_take_P_nth: |
603320b93668
New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents:
33593
diff
changeset
|
1827 |
"\<lbrakk> \<And> i. \<lbrakk> i < n ; i < length xs \<rbrakk> \<Longrightarrow> P (xs ! i) ; n < length xs \<Longrightarrow> \<not> P (xs ! n) \<rbrakk> \<Longrightarrow> |
603320b93668
New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents:
33593
diff
changeset
|
1828 |
takeWhile P xs = take n xs" |
603320b93668
New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents:
33593
diff
changeset
|
1829 |
proof (induct xs arbitrary: n) |
603320b93668
New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents:
33593
diff
changeset
|
1830 |
case (Cons x xs) |
603320b93668
New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents:
33593
diff
changeset
|
1831 |
thus ?case |
603320b93668
New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents:
33593
diff
changeset
|
1832 |
proof (cases n) |
603320b93668
New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents:
33593
diff
changeset
|
1833 |
case (Suc n') note this[simp] |
603320b93668
New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents:
33593
diff
changeset
|
1834 |
have "P x" using Cons.prems(1)[of 0] by simp |
603320b93668
New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents:
33593
diff
changeset
|
1835 |
moreover have "takeWhile P xs = take n' xs" |
603320b93668
New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents:
33593
diff
changeset
|
1836 |
proof (rule Cons.hyps) |
603320b93668
New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents:
33593
diff
changeset
|
1837 |
case goal1 thus "P (xs ! i)" using Cons.prems(1)[of "Suc i"] by simp |
603320b93668
New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents:
33593
diff
changeset
|
1838 |
next case goal2 thus ?case using Cons by auto |
603320b93668
New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents:
33593
diff
changeset
|
1839 |
qed |
603320b93668
New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents:
33593
diff
changeset
|
1840 |
ultimately show ?thesis by simp |
603320b93668
New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents:
33593
diff
changeset
|
1841 |
qed simp |
603320b93668
New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents:
33593
diff
changeset
|
1842 |
qed simp |
603320b93668
New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents:
33593
diff
changeset
|
1843 |
|
603320b93668
New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents:
33593
diff
changeset
|
1844 |
lemma nth_length_takeWhile: |
603320b93668
New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents:
33593
diff
changeset
|
1845 |
"length (takeWhile P xs) < length xs \<Longrightarrow> \<not> P (xs ! length (takeWhile P xs))" |
603320b93668
New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents:
33593
diff
changeset
|
1846 |
by (induct xs) auto |
603320b93668
New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents:
33593
diff
changeset
|
1847 |
|
603320b93668
New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents:
33593
diff
changeset
|
1848 |
lemma length_takeWhile_less_P_nth: |
603320b93668
New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents:
33593
diff
changeset
|
1849 |
assumes all: "\<And> i. i < j \<Longrightarrow> P (xs ! i)" and "j \<le> length xs" |
603320b93668
New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents:
33593
diff
changeset
|
1850 |
shows "j \<le> length (takeWhile P xs)" |
603320b93668
New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents:
33593
diff
changeset
|
1851 |
proof (rule classical) |
603320b93668
New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents:
33593
diff
changeset
|
1852 |
assume "\<not> ?thesis" |
603320b93668
New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents:
33593
diff
changeset
|
1853 |
hence "length (takeWhile P xs) < length xs" using assms by simp |
603320b93668
New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents:
33593
diff
changeset
|
1854 |
thus ?thesis using all `\<not> ?thesis` nth_length_takeWhile[of P xs] by auto |
603320b93668
New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents:
33593
diff
changeset
|
1855 |
qed |
31077 | 1856 |
|
17501 | 1857 |
text{* The following two lemmmas could be generalized to an arbitrary |
1858 |
property. *} |
|
1859 |
||
1860 |
lemma takeWhile_neq_rev: "\<lbrakk>distinct xs; x \<in> set xs\<rbrakk> \<Longrightarrow> |
|
1861 |
takeWhile (\<lambda>y. y \<noteq> x) (rev xs) = rev (tl (dropWhile (\<lambda>y. y \<noteq> x) xs))" |
|
1862 |
by(induct xs) (auto simp: takeWhile_tail[where l="[]"]) |
|
1863 |
||
1864 |
lemma dropWhile_neq_rev: "\<lbrakk>distinct xs; x \<in> set xs\<rbrakk> \<Longrightarrow> |
|
1865 |
dropWhile (\<lambda>y. y \<noteq> x) (rev xs) = x # rev (takeWhile (\<lambda>y. y \<noteq> x) xs)" |
|
1866 |
apply(induct xs) |
|
1867 |
apply simp |
|
1868 |
apply auto |
|
1869 |
apply(subst dropWhile_append2) |
|
1870 |
apply auto |
|
1871 |
done |
|
1872 |
||
18423 | 1873 |
lemma takeWhile_not_last: |
1874 |
"\<lbrakk> xs \<noteq> []; distinct xs\<rbrakk> \<Longrightarrow> takeWhile (\<lambda>y. y \<noteq> last xs) xs = butlast xs" |
|
1875 |
apply(induct xs) |
|
1876 |
apply simp |
|
1877 |
apply(case_tac xs) |
|
1878 |
apply(auto) |
|
1879 |
done |
|
1880 |
||
19770
be5c23ebe1eb
HOL/Tools/function_package: Added support for mutual recursive definitions.
krauss
parents:
19623
diff
changeset
|
1881 |
lemma takeWhile_cong [fundef_cong, recdef_cong]: |
18336
1a2e30b37ed3
Added recdef congruence rules for bounded quantifiers and commonly used
krauss
parents:
18049
diff
changeset
|
1882 |
"[| l = k; !!x. x : set l ==> P x = Q x |] |
1a2e30b37ed3
Added recdef congruence rules for bounded quantifiers and commonly used
krauss
parents:
18049
diff
changeset
|
1883 |
==> takeWhile P l = takeWhile Q k" |
24349 | 1884 |
by (induct k arbitrary: l) (simp_all) |
18336
1a2e30b37ed3
Added recdef congruence rules for bounded quantifiers and commonly used
krauss
parents:
18049
diff
changeset
|
1885 |
|
19770
be5c23ebe1eb
HOL/Tools/function_package: Added support for mutual recursive definitions.
krauss
parents:
19623
diff
changeset
|
1886 |
lemma dropWhile_cong [fundef_cong, recdef_cong]: |
18336
1a2e30b37ed3
Added recdef congruence rules for bounded quantifiers and commonly used
krauss
parents:
18049
diff
changeset
|
1887 |
"[| l = k; !!x. x : set l ==> P x = Q x |] |
1a2e30b37ed3
Added recdef congruence rules for bounded quantifiers and commonly used
krauss
parents:
18049
diff
changeset
|
1888 |
==> dropWhile P l = dropWhile Q k" |
24349 | 1889 |
by (induct k arbitrary: l, simp_all) |
18336
1a2e30b37ed3
Added recdef congruence rules for bounded quantifiers and commonly used
krauss
parents:
18049
diff
changeset
|
1890 |
|
13114 | 1891 |
|
15392 | 1892 |
subsubsection {* @{text zip} *} |
13114 | 1893 |
|
13142 | 1894 |
lemma zip_Nil [simp]: "zip [] ys = []" |
13145 | 1895 |
by (induct ys) auto |
13114 | 1896 |
|
13142 | 1897 |
lemma zip_Cons_Cons [simp]: "zip (x # xs) (y # ys) = (x, y) # zip xs ys" |
13145 | 1898 |
by simp |
13114 | 1899 |
|
13142 | 1900 |
declare zip_Cons [simp del] |
13114 | 1901 |
|
15281 | 1902 |
lemma zip_Cons1: |
1903 |
"zip (x#xs) ys = (case ys of [] \<Rightarrow> [] | y#ys \<Rightarrow> (x,y)#zip xs ys)" |
|
1904 |
by(auto split:list.split) |
|
1905 |
||
13142 | 1906 |
lemma length_zip [simp]: |
22493
db930e490fe5
added another rule for simultaneous induction, and lemmas for zip
krauss
parents:
22422
diff
changeset
|
1907 |
"length (zip xs ys) = min (length xs) (length ys)" |
db930e490fe5
added another rule for simultaneous induction, and lemmas for zip
krauss
parents:
22422
diff
changeset
|
1908 |
by (induct xs ys rule:list_induct2') auto |
13114 | 1909 |
|
34978
874150ddd50a
canonical insert operation; generalized lemma foldl_apply_inv to foldl_apply
haftmann
parents:
34942
diff
changeset
|
1910 |
lemma zip_obtain_same_length: |
874150ddd50a
canonical insert operation; generalized lemma foldl_apply_inv to foldl_apply
haftmann
parents:
34942
diff
changeset
|
1911 |
assumes "\<And>zs ws n. length zs = length ws \<Longrightarrow> n = min (length xs) (length ys) |
874150ddd50a
canonical insert operation; generalized lemma foldl_apply_inv to foldl_apply
haftmann
parents:
34942
diff
changeset
|
1912 |
\<Longrightarrow> zs = take n xs \<Longrightarrow> ws = take n ys \<Longrightarrow> P (zip zs ws)" |
874150ddd50a
canonical insert operation; generalized lemma foldl_apply_inv to foldl_apply
haftmann
parents:
34942
diff
changeset
|
1913 |
shows "P (zip xs ys)" |
874150ddd50a
canonical insert operation; generalized lemma foldl_apply_inv to foldl_apply
haftmann
parents:
34942
diff
changeset
|
1914 |
proof - |
874150ddd50a
canonical insert operation; generalized lemma foldl_apply_inv to foldl_apply
haftmann
parents:
34942
diff
changeset
|
1915 |
let ?n = "min (length xs) (length ys)" |
874150ddd50a
canonical insert operation; generalized lemma foldl_apply_inv to foldl_apply
haftmann
parents:
34942
diff
changeset
|
1916 |
have "P (zip (take ?n xs) (take ?n ys))" |
874150ddd50a
canonical insert operation; generalized lemma foldl_apply_inv to foldl_apply
haftmann
parents:
34942
diff
changeset
|
1917 |
by (rule assms) simp_all |
874150ddd50a
canonical insert operation; generalized lemma foldl_apply_inv to foldl_apply
haftmann
parents:
34942
diff
changeset
|
1918 |
moreover have "zip xs ys = zip (take ?n xs) (take ?n ys)" |
874150ddd50a
canonical insert operation; generalized lemma foldl_apply_inv to foldl_apply
haftmann
parents:
34942
diff
changeset
|
1919 |
proof (induct xs arbitrary: ys) |
874150ddd50a
canonical insert operation; generalized lemma foldl_apply_inv to foldl_apply
haftmann
parents:
34942
diff
changeset
|
1920 |
case Nil then show ?case by simp |
874150ddd50a
canonical insert operation; generalized lemma foldl_apply_inv to foldl_apply
haftmann
parents:
34942
diff
changeset
|
1921 |
next |
874150ddd50a
canonical insert operation; generalized lemma foldl_apply_inv to foldl_apply
haftmann
parents:
34942
diff
changeset
|
1922 |
case (Cons x xs) then show ?case by (cases ys) simp_all |
874150ddd50a
canonical insert operation; generalized lemma foldl_apply_inv to foldl_apply
haftmann
parents:
34942
diff
changeset
|
1923 |
qed |
874150ddd50a
canonical insert operation; generalized lemma foldl_apply_inv to foldl_apply
haftmann
parents:
34942
diff
changeset
|
1924 |
ultimately show ?thesis by simp |
874150ddd50a
canonical insert operation; generalized lemma foldl_apply_inv to foldl_apply
haftmann
parents:
34942
diff
changeset
|
1925 |
qed |
874150ddd50a
canonical insert operation; generalized lemma foldl_apply_inv to foldl_apply
haftmann
parents:
34942
diff
changeset
|
1926 |
|
13114 | 1927 |
lemma zip_append1: |
22493
db930e490fe5
added another rule for simultaneous induction, and lemmas for zip
krauss
parents:
22422
diff
changeset
|
1928 |
"zip (xs @ ys) zs = |
13145 | 1929 |
zip xs (take (length xs) zs) @ zip ys (drop (length xs) zs)" |
22493
db930e490fe5
added another rule for simultaneous induction, and lemmas for zip
krauss
parents:
22422
diff
changeset
|
1930 |
by (induct xs zs rule:list_induct2') auto |
13114 | 1931 |
|
1932 |
lemma zip_append2: |
|
22493
db930e490fe5
added another rule for simultaneous induction, and lemmas for zip
krauss
parents:
22422
diff
changeset
|
1933 |
"zip xs (ys @ zs) = |
13145 | 1934 |
zip (take (length ys) xs) ys @ zip (drop (length ys) xs) zs" |
22493
db930e490fe5
added another rule for simultaneous induction, and lemmas for zip
krauss
parents:
22422
diff
changeset
|
1935 |
by (induct xs ys rule:list_induct2') auto |
13114 | 1936 |
|
13142 | 1937 |
lemma zip_append [simp]: |
1938 |
"[| length xs = length us; length ys = length vs |] ==> |
|
13145 | 1939 |
zip (xs@ys) (us@vs) = zip xs us @ zip ys vs" |
1940 |
by (simp add: zip_append1) |
|
13114 | 1941 |
|
1942 |
lemma zip_rev: |
|
14247 | 1943 |
"length xs = length ys ==> zip (rev xs) (rev ys) = rev (zip xs ys)" |
1944 |
by (induct rule:list_induct2, simp_all) |
|
13114 | 1945 |
|
33639
603320b93668
New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents:
33593
diff
changeset
|
1946 |
lemma zip_map_map: |
603320b93668
New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents:
33593
diff
changeset
|
1947 |
"zip (map f xs) (map g ys) = map (\<lambda> (x, y). (f x, g y)) (zip xs ys)" |
603320b93668
New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents:
33593
diff
changeset
|
1948 |
proof (induct xs arbitrary: ys) |
603320b93668
New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents:
33593
diff
changeset
|
1949 |
case (Cons x xs) note Cons_x_xs = Cons.hyps |
603320b93668
New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents:
33593
diff
changeset
|
1950 |
show ?case |
603320b93668
New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents:
33593
diff
changeset
|
1951 |
proof (cases ys) |
603320b93668
New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents:
33593
diff
changeset
|
1952 |
case (Cons y ys') |
603320b93668
New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents:
33593
diff
changeset
|
1953 |
show ?thesis unfolding Cons using Cons_x_xs by simp |
603320b93668
New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents:
33593
diff
changeset
|
1954 |
qed simp |
603320b93668
New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents:
33593
diff
changeset
|
1955 |
qed simp |
603320b93668
New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents:
33593
diff
changeset
|
1956 |
|
603320b93668
New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents:
33593
diff
changeset
|
1957 |
lemma zip_map1: |
603320b93668
New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents:
33593
diff
changeset
|
1958 |
"zip (map f xs) ys = map (\<lambda>(x, y). (f x, y)) (zip xs ys)" |
603320b93668
New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents:
33593
diff
changeset
|
1959 |
using zip_map_map[of f xs "\<lambda>x. x" ys] by simp |
603320b93668
New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents:
33593
diff
changeset
|
1960 |
|
603320b93668
New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents:
33593
diff
changeset
|
1961 |
lemma zip_map2: |
603320b93668
New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents:
33593
diff
changeset
|
1962 |
"zip xs (map f ys) = map (\<lambda>(x, y). (x, f y)) (zip xs ys)" |
603320b93668
New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents:
33593
diff
changeset
|
1963 |
using zip_map_map[of "\<lambda>x. x" xs f ys] by simp |
603320b93668
New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents:
33593
diff
changeset
|
1964 |
|
23096 | 1965 |
lemma map_zip_map: |
33639
603320b93668
New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents:
33593
diff
changeset
|
1966 |
"map f (zip (map g xs) ys) = map (%(x,y). f(g x, y)) (zip xs ys)" |
603320b93668
New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents:
33593
diff
changeset
|
1967 |
unfolding zip_map1 by auto |
23096 | 1968 |
|
1969 |
lemma map_zip_map2: |
|
33639
603320b93668
New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents:
33593
diff
changeset
|
1970 |
"map f (zip xs (map g ys)) = map (%(x,y). f(x, g y)) (zip xs ys)" |
603320b93668
New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents:
33593
diff
changeset
|
1971 |
unfolding zip_map2 by auto |
23096 | 1972 |
|
31080 | 1973 |
text{* Courtesy of Andreas Lochbihler: *} |
1974 |
lemma zip_same_conv_map: "zip xs xs = map (\<lambda>x. (x, x)) xs" |
|
1975 |
by(induct xs) auto |
|
1976 |
||
13142 | 1977 |
lemma nth_zip [simp]: |
24526 | 1978 |
"[| i < length xs; i < length ys|] ==> (zip xs ys)!i = (xs!i, ys!i)" |
1979 |
apply (induct ys arbitrary: i xs, simp) |
|
13145 | 1980 |
apply (case_tac xs) |
1981 |
apply (simp_all add: nth.simps split: nat.split) |
|
1982 |
done |
|
13114 | 1983 |
|
1984 |
lemma set_zip: |
|
13145 | 1985 |
"set (zip xs ys) = {(xs!i, ys!i) | i. i < min (length xs) (length ys)}" |
31080 | 1986 |
by(simp add: set_conv_nth cong: rev_conj_cong) |
13114 | 1987 |
|
33639
603320b93668
New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents:
33593
diff
changeset
|
1988 |
lemma zip_same: "((a,b) \<in> set (zip xs xs)) = (a \<in> set xs \<and> a = b)" |
603320b93668
New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents:
33593
diff
changeset
|
1989 |
by(induct xs) auto |
603320b93668
New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents:
33593
diff
changeset
|
1990 |
|
13114 | 1991 |
lemma zip_update: |
31080 | 1992 |
"zip (xs[i:=x]) (ys[i:=y]) = (zip xs ys)[i:=(x,y)]" |
1993 |
by(rule sym, simp add: update_zip) |
|
13114 | 1994 |
|
13142 | 1995 |
lemma zip_replicate [simp]: |
24526 | 1996 |
"zip (replicate i x) (replicate j y) = replicate (min i j) (x,y)" |
1997 |
apply (induct i arbitrary: j, auto) |
|
14208 | 1998 |
apply (case_tac j, auto) |
13145 | 1999 |
done |
13114 | 2000 |
|
19487 | 2001 |
lemma take_zip: |
24526 | 2002 |
"take n (zip xs ys) = zip (take n xs) (take n ys)" |
2003 |
apply (induct n arbitrary: xs ys) |
|
19487 | 2004 |
apply simp |
2005 |
apply (case_tac xs, simp) |
|
2006 |
apply (case_tac ys, simp_all) |
|
2007 |
done |
|
2008 |
||
2009 |
lemma drop_zip: |
|
24526 | 2010 |
"drop n (zip xs ys) = zip (drop n xs) (drop n ys)" |
2011 |
apply (induct n arbitrary: xs ys) |
|
19487 | 2012 |
apply simp |
2013 |
apply (case_tac xs, simp) |
|
2014 |
apply (case_tac ys, simp_all) |
|
2015 |
done |
|
2016 |
||
33639
603320b93668
New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents:
33593
diff
changeset
|
2017 |
lemma zip_takeWhile_fst: "zip (takeWhile P xs) ys = takeWhile (P \<circ> fst) (zip xs ys)" |
603320b93668
New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents:
33593
diff
changeset
|
2018 |
proof (induct xs arbitrary: ys) |
603320b93668
New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents:
33593
diff
changeset
|
2019 |
case (Cons x xs) thus ?case by (cases ys) auto |
603320b93668
New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents:
33593
diff
changeset
|
2020 |
qed simp |
603320b93668
New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents:
33593
diff
changeset
|
2021 |
|
603320b93668
New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents:
33593
diff
changeset
|
2022 |
lemma zip_takeWhile_snd: "zip xs (takeWhile P ys) = takeWhile (P \<circ> snd) (zip xs ys)" |
603320b93668
New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents:
33593
diff
changeset
|
2023 |
proof (induct xs arbitrary: ys) |
603320b93668
New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents:
33593
diff
changeset
|
2024 |
case (Cons x xs) thus ?case by (cases ys) auto |
603320b93668
New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents:
33593
diff
changeset
|
2025 |
qed simp |
603320b93668
New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents:
33593
diff
changeset
|
2026 |
|
22493
db930e490fe5
added another rule for simultaneous induction, and lemmas for zip
krauss
parents:
22422
diff
changeset
|
2027 |
lemma set_zip_leftD: |
db930e490fe5
added another rule for simultaneous induction, and lemmas for zip
krauss
parents:
22422
diff
changeset
|
2028 |
"(x,y)\<in> set (zip xs ys) \<Longrightarrow> x \<in> set xs" |
db930e490fe5
added another rule for simultaneous induction, and lemmas for zip
krauss
parents:
22422
diff
changeset
|
2029 |
by (induct xs ys rule:list_induct2') auto |
db930e490fe5
added another rule for simultaneous induction, and lemmas for zip
krauss
parents:
22422
diff
changeset
|
2030 |
|
db930e490fe5
added another rule for simultaneous induction, and lemmas for zip
krauss
parents:
22422
diff
changeset
|
2031 |
lemma set_zip_rightD: |
db930e490fe5
added another rule for simultaneous induction, and lemmas for zip
krauss
parents:
22422
diff
changeset
|
2032 |
"(x,y)\<in> set (zip xs ys) \<Longrightarrow> y \<in> set ys" |
db930e490fe5
added another rule for simultaneous induction, and lemmas for zip
krauss
parents:
22422
diff
changeset
|
2033 |
by (induct xs ys rule:list_induct2') auto |
13142 | 2034 |
|
23983 | 2035 |
lemma in_set_zipE: |
2036 |
"(x,y) : set(zip xs ys) \<Longrightarrow> (\<lbrakk> x : set xs; y : set ys \<rbrakk> \<Longrightarrow> R) \<Longrightarrow> R" |
|
2037 |
by(blast dest: set_zip_leftD set_zip_rightD) |
|
2038 |
||
29829 | 2039 |
lemma zip_map_fst_snd: |
2040 |
"zip (map fst zs) (map snd zs) = zs" |
|
2041 |
by (induct zs) simp_all |
|
2042 |
||
2043 |
lemma zip_eq_conv: |
|
2044 |
"length xs = length ys \<Longrightarrow> zip xs ys = zs \<longleftrightarrow> map fst zs = xs \<and> map snd zs = ys" |
|
2045 |
by (auto simp add: zip_map_fst_snd) |
|
2046 |
||
33639
603320b93668
New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents:
33593
diff
changeset
|
2047 |
lemma distinct_zipI1: |
603320b93668
New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents:
33593
diff
changeset
|
2048 |
"distinct xs \<Longrightarrow> distinct (zip xs ys)" |
603320b93668
New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents:
33593
diff
changeset
|
2049 |
proof (induct xs arbitrary: ys) |
603320b93668
New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents:
33593
diff
changeset
|
2050 |
case (Cons x xs) |
603320b93668
New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents:
33593
diff
changeset
|
2051 |
show ?case |
603320b93668
New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents:
33593
diff
changeset
|
2052 |
proof (cases ys) |
603320b93668
New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents:
33593
diff
changeset
|
2053 |
case (Cons y ys') |
603320b93668
New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents:
33593
diff
changeset
|
2054 |
have "(x, y) \<notin> set (zip xs ys')" |
603320b93668
New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents:
33593
diff
changeset
|
2055 |
using Cons.prems by (auto simp: set_zip) |
603320b93668
New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents:
33593
diff
changeset
|
2056 |
thus ?thesis |
603320b93668
New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents:
33593
diff
changeset
|
2057 |
unfolding Cons zip_Cons_Cons distinct.simps |
603320b93668
New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents:
33593
diff
changeset
|
2058 |
using Cons.hyps Cons.prems by simp |
603320b93668
New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents:
33593
diff
changeset
|
2059 |
qed simp |
603320b93668
New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents:
33593
diff
changeset
|
2060 |
qed simp |
603320b93668
New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents:
33593
diff
changeset
|
2061 |
|
603320b93668
New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents:
33593
diff
changeset
|
2062 |
lemma distinct_zipI2: |
603320b93668
New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents:
33593
diff
changeset
|
2063 |
"distinct xs \<Longrightarrow> distinct (zip xs ys)" |
603320b93668
New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents:
33593
diff
changeset
|
2064 |
proof (induct xs arbitrary: ys) |
603320b93668
New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents:
33593
diff
changeset
|
2065 |
case (Cons x xs) |
603320b93668
New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents:
33593
diff
changeset
|
2066 |
show ?case |
603320b93668
New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents:
33593
diff
changeset
|
2067 |
proof (cases ys) |
603320b93668
New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents:
33593
diff
changeset
|
2068 |
case (Cons y ys') |
603320b93668
New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents:
33593
diff
changeset
|
2069 |
have "(x, y) \<notin> set (zip xs ys')" |
603320b93668
New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents:
33593
diff
changeset
|
2070 |
using Cons.prems by (auto simp: set_zip) |
603320b93668
New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents:
33593
diff
changeset
|
2071 |
thus ?thesis |
603320b93668
New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents:
33593
diff
changeset
|
2072 |
unfolding Cons zip_Cons_Cons distinct.simps |
603320b93668
New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents:
33593
diff
changeset
|
2073 |
using Cons.hyps Cons.prems by simp |
603320b93668
New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents:
33593
diff
changeset
|
2074 |
qed simp |
603320b93668
New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents:
33593
diff
changeset
|
2075 |
qed simp |
29829 | 2076 |
|
15392 | 2077 |
subsubsection {* @{text list_all2} *} |
13114 | 2078 |
|
14316
91b897b9a2dc
added some [intro?] and [trans] for list_all2 lemmas
kleing
parents:
14302
diff
changeset
|
2079 |
lemma list_all2_lengthD [intro?]: |
91b897b9a2dc
added some [intro?] and [trans] for list_all2 lemmas
kleing
parents:
14302
diff
changeset
|
2080 |
"list_all2 P xs ys ==> length xs = length ys" |
24349 | 2081 |
by (simp add: list_all2_def) |
19607
07eeb832f28d
introduced characters for code generator; some improved code lemmas for some list functions
haftmann
parents:
19585
diff
changeset
|
2082 |
|
19787 | 2083 |
lemma list_all2_Nil [iff, code]: "list_all2 P [] ys = (ys = [])" |
24349 | 2084 |
by (simp add: list_all2_def) |
19607
07eeb832f28d
introduced characters for code generator; some improved code lemmas for some list functions
haftmann
parents:
19585
diff
changeset
|
2085 |
|
19787 | 2086 |
lemma list_all2_Nil2 [iff, code]: "list_all2 P xs [] = (xs = [])" |
24349 | 2087 |
by (simp add: list_all2_def) |
19607
07eeb832f28d
introduced characters for code generator; some improved code lemmas for some list functions
haftmann
parents:
19585
diff
changeset
|
2088 |
|
07eeb832f28d
introduced characters for code generator; some improved code lemmas for some list functions
haftmann
parents:
19585
diff
changeset
|
2089 |
lemma list_all2_Cons [iff, code]: |
07eeb832f28d
introduced characters for code generator; some improved code lemmas for some list functions
haftmann
parents:
19585
diff
changeset
|
2090 |
"list_all2 P (x # xs) (y # ys) = (P x y \<and> list_all2 P xs ys)" |
24349 | 2091 |
by (auto simp add: list_all2_def) |
13114 | 2092 |
|
2093 |
lemma list_all2_Cons1: |
|
13145 | 2094 |
"list_all2 P (x # xs) ys = (\<exists>z zs. ys = z # zs \<and> P x z \<and> list_all2 P xs zs)" |
2095 |
by (cases ys) auto |
|
13114 | 2096 |
|
2097 |
lemma list_all2_Cons2: |
|
13145 | 2098 |
"list_all2 P xs (y # ys) = (\<exists>z zs. xs = z # zs \<and> P z y \<and> list_all2 P zs ys)" |
2099 |
by (cases xs) auto |
|
13114 | 2100 |
|
13142 | 2101 |
lemma list_all2_rev [iff]: |
13145 | 2102 |
"list_all2 P (rev xs) (rev ys) = list_all2 P xs ys" |
2103 |
by (simp add: list_all2_def zip_rev cong: conj_cong) |
|
13114 | 2104 |
|
13863 | 2105 |
lemma list_all2_rev1: |
2106 |
"list_all2 P (rev xs) ys = list_all2 P xs (rev ys)" |
|
2107 |
by (subst list_all2_rev [symmetric]) simp |
|
2108 |
||
13114 | 2109 |
lemma list_all2_append1: |
13145 | 2110 |
"list_all2 P (xs @ ys) zs = |
2111 |
(EX us vs. zs = us @ vs \<and> length us = length xs \<and> length vs = length ys \<and> |
|
2112 |
list_all2 P xs us \<and> list_all2 P ys vs)" |
|
2113 |
apply (simp add: list_all2_def zip_append1) |
|
2114 |
apply (rule iffI) |
|
2115 |
apply (rule_tac x = "take (length xs) zs" in exI) |
|
2116 |
apply (rule_tac x = "drop (length xs) zs" in exI) |
|
14208 | 2117 |
apply (force split: nat_diff_split simp add: min_def, clarify) |
13145 | 2118 |
apply (simp add: ball_Un) |
2119 |
done |
|
13114 | 2120 |
|
2121 |
lemma list_all2_append2: |
|
13145 | 2122 |
"list_all2 P xs (ys @ zs) = |
2123 |
(EX us vs. xs = us @ vs \<and> length us = length ys \<and> length vs = length zs \<and> |
|
2124 |
list_all2 P us ys \<and> list_all2 P vs zs)" |
|
2125 |
apply (simp add: list_all2_def zip_append2) |
|
2126 |
apply (rule iffI) |
|
2127 |
apply (rule_tac x = "take (length ys) xs" in exI) |
|
2128 |
apply (rule_tac x = "drop (length ys) xs" in exI) |
|
14208 | 2129 |
apply (force split: nat_diff_split simp add: min_def, clarify) |
13145 | 2130 |
apply (simp add: ball_Un) |
2131 |
done |
|
13114 | 2132 |
|
13863 | 2133 |
lemma list_all2_append: |
14247 | 2134 |
"length xs = length ys \<Longrightarrow> |
2135 |
list_all2 P (xs@us) (ys@vs) = (list_all2 P xs ys \<and> list_all2 P us vs)" |
|
2136 |
by (induct rule:list_induct2, simp_all) |
|
13863 | 2137 |
|
2138 |
lemma list_all2_appendI [intro?, trans]: |
|
2139 |
"\<lbrakk> list_all2 P a b; list_all2 P c d \<rbrakk> \<Longrightarrow> list_all2 P (a@c) (b@d)" |
|
24349 | 2140 |
by (simp add: list_all2_append list_all2_lengthD) |
13863 | 2141 |
|
13114 | 2142 |
lemma list_all2_conv_all_nth: |
13145 | 2143 |
"list_all2 P xs ys = |
2144 |
(length xs = length ys \<and> (\<forall>i < length xs. P (xs!i) (ys!i)))" |
|
2145 |
by (force simp add: list_all2_def set_zip) |
|
13114 | 2146 |
|
13883
0451e0fb3f22
Re-structured some proofs in order to get rid of rule_format attribute.
berghofe
parents:
13863
diff
changeset
|
2147 |
lemma list_all2_trans: |
0451e0fb3f22
Re-structured some proofs in order to get rid of rule_format attribute.
berghofe
parents:
13863
diff
changeset
|
2148 |
assumes tr: "!!a b c. P1 a b ==> P2 b c ==> P3 a c" |
0451e0fb3f22
Re-structured some proofs in order to get rid of rule_format attribute.
berghofe
parents:
13863
diff
changeset
|
2149 |
shows "!!bs cs. list_all2 P1 as bs ==> list_all2 P2 bs cs ==> list_all2 P3 as cs" |
0451e0fb3f22
Re-structured some proofs in order to get rid of rule_format attribute.
berghofe
parents:
13863
diff
changeset
|
2150 |
(is "!!bs cs. PROP ?Q as bs cs") |
0451e0fb3f22
Re-structured some proofs in order to get rid of rule_format attribute.
berghofe
parents:
13863
diff
changeset
|
2151 |
proof (induct as) |
0451e0fb3f22
Re-structured some proofs in order to get rid of rule_format attribute.
berghofe
parents:
13863
diff
changeset
|
2152 |
fix x xs bs assume I1: "!!bs cs. PROP ?Q xs bs cs" |
0451e0fb3f22
Re-structured some proofs in order to get rid of rule_format attribute.
berghofe
parents:
13863
diff
changeset
|
2153 |
show "!!cs. PROP ?Q (x # xs) bs cs" |
0451e0fb3f22
Re-structured some proofs in order to get rid of rule_format attribute.
berghofe
parents:
13863
diff
changeset
|
2154 |
proof (induct bs) |
0451e0fb3f22
Re-structured some proofs in order to get rid of rule_format attribute.
berghofe
parents:
13863
diff
changeset
|
2155 |
fix y ys cs assume I2: "!!cs. PROP ?Q (x # xs) ys cs" |
0451e0fb3f22
Re-structured some proofs in order to get rid of rule_format attribute.
berghofe
parents:
13863
diff
changeset
|
2156 |
show "PROP ?Q (x # xs) (y # ys) cs" |
0451e0fb3f22
Re-structured some proofs in order to get rid of rule_format attribute.
berghofe
parents:
13863
diff
changeset
|
2157 |
by (induct cs) (auto intro: tr I1 I2) |
0451e0fb3f22
Re-structured some proofs in order to get rid of rule_format attribute.
berghofe
parents:
13863
diff
changeset
|
2158 |
qed simp |
0451e0fb3f22
Re-structured some proofs in order to get rid of rule_format attribute.
berghofe
parents:
13863
diff
changeset
|
2159 |
qed simp |
0451e0fb3f22
Re-structured some proofs in order to get rid of rule_format attribute.
berghofe
parents:
13863
diff
changeset
|
2160 |
|
13863 | 2161 |
lemma list_all2_all_nthI [intro?]: |
2162 |
"length a = length b \<Longrightarrow> (\<And>n. n < length a \<Longrightarrow> P (a!n) (b!n)) \<Longrightarrow> list_all2 P a b" |
|
24349 | 2163 |
by (simp add: list_all2_conv_all_nth) |
13863 | 2164 |
|
14395 | 2165 |
lemma list_all2I: |
2166 |
"\<forall>x \<in> set (zip a b). split P x \<Longrightarrow> length a = length b \<Longrightarrow> list_all2 P a b" |
|
24349 | 2167 |
by (simp add: list_all2_def) |
14395 | 2168 |
|
14328 | 2169 |
lemma list_all2_nthD: |
13863 | 2170 |
"\<lbrakk> list_all2 P xs ys; p < size xs \<rbrakk> \<Longrightarrow> P (xs!p) (ys!p)" |
24349 | 2171 |
by (simp add: list_all2_conv_all_nth) |
13863 | 2172 |
|
14302 | 2173 |
lemma list_all2_nthD2: |
2174 |
"\<lbrakk>list_all2 P xs ys; p < size ys\<rbrakk> \<Longrightarrow> P (xs!p) (ys!p)" |
|
24349 | 2175 |
by (frule list_all2_lengthD) (auto intro: list_all2_nthD) |
14302 | 2176 |
|
13863 | 2177 |
lemma list_all2_map1: |
2178 |
"list_all2 P (map f as) bs = list_all2 (\<lambda>x y. P (f x) y) as bs" |
|
24349 | 2179 |
by (simp add: list_all2_conv_all_nth) |
13863 | 2180 |
|
2181 |
lemma list_all2_map2: |
|
2182 |
"list_all2 P as (map f bs) = list_all2 (\<lambda>x y. P x (f y)) as bs" |
|
24349 | 2183 |
by (auto simp add: list_all2_conv_all_nth) |
13863 | 2184 |
|
14316
91b897b9a2dc
added some [intro?] and [trans] for list_all2 lemmas
kleing
parents:
14302
diff
changeset
|
2185 |
lemma list_all2_refl [intro?]: |
13863 | 2186 |
"(\<And>x. P x x) \<Longrightarrow> list_all2 P xs xs" |
24349 | 2187 |
by (simp add: list_all2_conv_all_nth) |
13863 | 2188 |
|
2189 |
lemma list_all2_update_cong: |
|
2190 |
"\<lbrakk> i<size xs; list_all2 P xs ys; P x y \<rbrakk> \<Longrightarrow> list_all2 P (xs[i:=x]) (ys[i:=y])" |
|
24349 | 2191 |
by (simp add: list_all2_conv_all_nth nth_list_update) |
13863 | 2192 |
|
2193 |
lemma list_all2_update_cong2: |
|
2194 |
"\<lbrakk>list_all2 P xs ys; P x y; i < length ys\<rbrakk> \<Longrightarrow> list_all2 P (xs[i:=x]) (ys[i:=y])" |
|
24349 | 2195 |
by (simp add: list_all2_lengthD list_all2_update_cong) |
13863 | 2196 |
|
14302 | 2197 |
lemma list_all2_takeI [simp,intro?]: |
24526 | 2198 |
"list_all2 P xs ys \<Longrightarrow> list_all2 P (take n xs) (take n ys)" |
2199 |
apply (induct xs arbitrary: n ys) |
|
2200 |
apply simp |
|
2201 |
apply (clarsimp simp add: list_all2_Cons1) |
|
2202 |
apply (case_tac n) |
|
2203 |
apply auto |
|
2204 |
done |
|
14302 | 2205 |
|
2206 |
lemma list_all2_dropI [simp,intro?]: |
|
24526 | 2207 |
"list_all2 P as bs \<Longrightarrow> list_all2 P (drop n as) (drop n bs)" |
2208 |
apply (induct as arbitrary: n bs, simp) |
|
2209 |
apply (clarsimp simp add: list_all2_Cons1) |
|
2210 |
apply (case_tac n, simp, simp) |
|
2211 |
done |
|
13863 | 2212 |
|
14327 | 2213 |
lemma list_all2_mono [intro?]: |
24526 | 2214 |
"list_all2 P xs ys \<Longrightarrow> (\<And>xs ys. P xs ys \<Longrightarrow> Q xs ys) \<Longrightarrow> list_all2 Q xs ys" |
2215 |
apply (induct xs arbitrary: ys, simp) |
|
2216 |
apply (case_tac ys, auto) |
|
2217 |
done |
|
13863 | 2218 |
|
22551 | 2219 |
lemma list_all2_eq: |
2220 |
"xs = ys \<longleftrightarrow> list_all2 (op =) xs ys" |
|
24349 | 2221 |
by (induct xs ys rule: list_induct2') auto |
22551 | 2222 |
|
13142 | 2223 |
|
15392 | 2224 |
subsubsection {* @{text foldl} and @{text foldr} *} |
13142 | 2225 |
|
2226 |
lemma foldl_append [simp]: |
|
24526 | 2227 |
"foldl f a (xs @ ys) = foldl f (foldl f a xs) ys" |
2228 |
by (induct xs arbitrary: a) auto |
|
13142 | 2229 |
|
14402
4201e1916482
moved lemmas from MicroJava/Comp/AuxLemmas.thy to List.thy
nipkow
parents:
14395
diff
changeset
|
2230 |
lemma foldr_append[simp]: "foldr f (xs @ ys) a = foldr f xs (foldr f ys a)" |
4201e1916482
moved lemmas from MicroJava/Comp/AuxLemmas.thy to List.thy
nipkow
parents:
14395
diff
changeset
|
2231 |
by (induct xs) auto |
4201e1916482
moved lemmas from MicroJava/Comp/AuxLemmas.thy to List.thy
nipkow
parents:
14395
diff
changeset
|
2232 |
|
23096 | 2233 |
lemma foldr_map: "foldr g (map f xs) a = foldr (g o f) xs a" |
2234 |
by(induct xs) simp_all |
|
2235 |
||
24449 | 2236 |
text{* For efficient code generation: avoid intermediate list. *} |
31998
2c7a24f74db9
code attributes use common underscore convention
haftmann
parents:
31930
diff
changeset
|
2237 |
lemma foldl_map[code_unfold]: |
24449 | 2238 |
"foldl g a (map f xs) = foldl (%a x. g a (f x)) a xs" |
23096 | 2239 |
by(induct xs arbitrary:a) simp_all |
2240 |
||
34978
874150ddd50a
canonical insert operation; generalized lemma foldl_apply_inv to foldl_apply
haftmann
parents:
34942
diff
changeset
|
2241 |
lemma foldl_apply: |
874150ddd50a
canonical insert operation; generalized lemma foldl_apply_inv to foldl_apply
haftmann
parents:
34942
diff
changeset
|
2242 |
assumes "\<And>x. x \<in> set xs \<Longrightarrow> f x \<circ> h = h \<circ> g x" |
874150ddd50a
canonical insert operation; generalized lemma foldl_apply_inv to foldl_apply
haftmann
parents:
34942
diff
changeset
|
2243 |
shows "foldl (\<lambda>s x. f x s) (h s) xs = h (foldl (\<lambda>s x. g x s) s xs)" |
874150ddd50a
canonical insert operation; generalized lemma foldl_apply_inv to foldl_apply
haftmann
parents:
34942
diff
changeset
|
2244 |
by (rule sym, insert assms, induct xs arbitrary: s) (simp_all add: expand_fun_eq) |
31930 | 2245 |
|
19770
be5c23ebe1eb
HOL/Tools/function_package: Added support for mutual recursive definitions.
krauss
parents:
19623
diff
changeset
|
2246 |
lemma foldl_cong [fundef_cong, recdef_cong]: |
18336
1a2e30b37ed3
Added recdef congruence rules for bounded quantifiers and commonly used
krauss
parents:
18049
diff
changeset
|
2247 |
"[| a = b; l = k; !!a x. x : set l ==> f a x = g a x |] |
1a2e30b37ed3
Added recdef congruence rules for bounded quantifiers and commonly used
krauss
parents:
18049
diff
changeset
|
2248 |
==> foldl f a l = foldl g b k" |
24349 | 2249 |
by (induct k arbitrary: a b l) simp_all |
18336
1a2e30b37ed3
Added recdef congruence rules for bounded quantifiers and commonly used
krauss
parents:
18049
diff
changeset
|
2250 |
|
19770
be5c23ebe1eb
HOL/Tools/function_package: Added support for mutual recursive definitions.
krauss
parents:
19623
diff
changeset
|
2251 |
lemma foldr_cong [fundef_cong, recdef_cong]: |
18336
1a2e30b37ed3
Added recdef congruence rules for bounded quantifiers and commonly used
krauss
parents:
18049
diff
changeset
|
2252 |
"[| a = b; l = k; !!a x. x : set l ==> f x a = g x a |] |
1a2e30b37ed3
Added recdef congruence rules for bounded quantifiers and commonly used
krauss
parents:
18049
diff
changeset
|
2253 |
==> foldr f l a = foldr g k b" |
24349 | 2254 |
by (induct k arbitrary: a b l) simp_all |
18336
1a2e30b37ed3
Added recdef congruence rules for bounded quantifiers and commonly used
krauss
parents:
18049
diff
changeset
|
2255 |
|
24449 | 2256 |
lemma (in semigroup_add) foldl_assoc: |
25062 | 2257 |
shows "foldl op+ (x+y) zs = x + (foldl op+ y zs)" |
24449 | 2258 |
by (induct zs arbitrary: y) (simp_all add:add_assoc) |
2259 |
||
2260 |
lemma (in monoid_add) foldl_absorb0: |
|
25062 | 2261 |
shows "x + (foldl op+ 0 zs) = foldl op+ x zs" |
24449 | 2262 |
by (induct zs) (simp_all add:foldl_assoc) |
2263 |
||
2264 |
||
23096 | 2265 |
text{* The ``First Duality Theorem'' in Bird \& Wadler: *} |
2266 |
||
2267 |
lemma foldl_foldr1_lemma: |
|
2268 |
"foldl op + a xs = a + foldr op + xs (0\<Colon>'a::monoid_add)" |
|
2269 |
by (induct xs arbitrary: a) (auto simp:add_assoc) |
|
2270 |
||
2271 |
corollary foldl_foldr1: |
|
2272 |
"foldl op + 0 xs = foldr op + xs (0\<Colon>'a::monoid_add)" |
|
2273 |
by (simp add:foldl_foldr1_lemma) |
|
2274 |
||
2275 |
||
2276 |
text{* The ``Third Duality Theorem'' in Bird \& Wadler: *} |
|
2277 |
||
14402
4201e1916482
moved lemmas from MicroJava/Comp/AuxLemmas.thy to List.thy
nipkow
parents:
14395
diff
changeset
|
2278 |
lemma foldr_foldl: "foldr f xs a = foldl (%x y. f y x) a (rev xs)" |
4201e1916482
moved lemmas from MicroJava/Comp/AuxLemmas.thy to List.thy
nipkow
parents:
14395
diff
changeset
|
2279 |
by (induct xs) auto |
4201e1916482
moved lemmas from MicroJava/Comp/AuxLemmas.thy to List.thy
nipkow
parents:
14395
diff
changeset
|
2280 |
|
4201e1916482
moved lemmas from MicroJava/Comp/AuxLemmas.thy to List.thy
nipkow
parents:
14395
diff
changeset
|
2281 |
lemma foldl_foldr: "foldl f a xs = foldr (%x y. f y x) (rev xs) a" |
4201e1916482
moved lemmas from MicroJava/Comp/AuxLemmas.thy to List.thy
nipkow
parents:
14395
diff
changeset
|
2282 |
by (simp add: foldr_foldl [of "%x y. f y x" "rev xs"]) |
4201e1916482
moved lemmas from MicroJava/Comp/AuxLemmas.thy to List.thy
nipkow
parents:
14395
diff
changeset
|
2283 |
|
25062 | 2284 |
lemma (in ab_semigroup_add) foldr_conv_foldl: "foldr op + xs a = foldl op + a xs" |
24471
d7cf53c1085f
removed unused theorems ; added lifting properties for foldr and foldl
chaieb
parents:
24461
diff
changeset
|
2285 |
by (induct xs, auto simp add: foldl_assoc add_commute) |
d7cf53c1085f
removed unused theorems ; added lifting properties for foldr and foldl
chaieb
parents:
24461
diff
changeset
|
2286 |
|
13142 | 2287 |
text {* |
13145 | 2288 |
Note: @{text "n \<le> foldl (op +) n ns"} looks simpler, but is more |
2289 |
difficult to use because it requires an additional transitivity step. |
|
13142 | 2290 |
*} |
2291 |
||
24526 | 2292 |
lemma start_le_sum: "(m::nat) <= n ==> m <= foldl (op +) n ns" |
2293 |
by (induct ns arbitrary: n) auto |
|
2294 |
||
2295 |
lemma elem_le_sum: "(n::nat) : set ns ==> n <= foldl (op +) 0 ns" |
|
13145 | 2296 |
by (force intro: start_le_sum simp add: in_set_conv_decomp) |
13142 | 2297 |
|
2298 |
lemma sum_eq_0_conv [iff]: |
|
24526 | 2299 |
"(foldl (op +) (m::nat) ns = 0) = (m = 0 \<and> (\<forall>n \<in> set ns. n = 0))" |
2300 |
by (induct ns arbitrary: m) auto |
|
13114 | 2301 |
|
24471
d7cf53c1085f
removed unused theorems ; added lifting properties for foldr and foldl
chaieb
parents:
24461
diff
changeset
|
2302 |
lemma foldr_invariant: |
d7cf53c1085f
removed unused theorems ; added lifting properties for foldr and foldl
chaieb
parents:
24461
diff
changeset
|
2303 |
"\<lbrakk>Q x ; \<forall> x\<in> set xs. P x; \<forall> x y. P x \<and> Q y \<longrightarrow> Q (f x y) \<rbrakk> \<Longrightarrow> Q (foldr f xs x)" |
d7cf53c1085f
removed unused theorems ; added lifting properties for foldr and foldl
chaieb
parents:
24461
diff
changeset
|
2304 |
by (induct xs, simp_all) |
d7cf53c1085f
removed unused theorems ; added lifting properties for foldr and foldl
chaieb
parents:
24461
diff
changeset
|
2305 |
|
d7cf53c1085f
removed unused theorems ; added lifting properties for foldr and foldl
chaieb
parents:
24461
diff
changeset
|
2306 |
lemma foldl_invariant: |
d7cf53c1085f
removed unused theorems ; added lifting properties for foldr and foldl
chaieb
parents:
24461
diff
changeset
|
2307 |
"\<lbrakk>Q x ; \<forall> x\<in> set xs. P x; \<forall> x y. P x \<and> Q y \<longrightarrow> Q (f y x) \<rbrakk> \<Longrightarrow> Q (foldl f x xs)" |
d7cf53c1085f
removed unused theorems ; added lifting properties for foldr and foldl
chaieb
parents:
24461
diff
changeset
|
2308 |
by (induct xs arbitrary: x, simp_all) |
d7cf53c1085f
removed unused theorems ; added lifting properties for foldr and foldl
chaieb
parents:
24461
diff
changeset
|
2309 |
|
34978
874150ddd50a
canonical insert operation; generalized lemma foldl_apply_inv to foldl_apply
haftmann
parents:
34942
diff
changeset
|
2310 |
lemma foldl_weak_invariant: |
874150ddd50a
canonical insert operation; generalized lemma foldl_apply_inv to foldl_apply
haftmann
parents:
34942
diff
changeset
|
2311 |
assumes "P s" |
874150ddd50a
canonical insert operation; generalized lemma foldl_apply_inv to foldl_apply
haftmann
parents:
34942
diff
changeset
|
2312 |
and "\<And>s x. x \<in> set xs \<Longrightarrow> P s \<Longrightarrow> P (f s x)" |
874150ddd50a
canonical insert operation; generalized lemma foldl_apply_inv to foldl_apply
haftmann
parents:
34942
diff
changeset
|
2313 |
shows "P (foldl f s xs)" |
874150ddd50a
canonical insert operation; generalized lemma foldl_apply_inv to foldl_apply
haftmann
parents:
34942
diff
changeset
|
2314 |
using assms by (induct xs arbitrary: s) simp_all |
874150ddd50a
canonical insert operation; generalized lemma foldl_apply_inv to foldl_apply
haftmann
parents:
34942
diff
changeset
|
2315 |
|
31455 | 2316 |
text {* @{const foldl} and @{const concat} *} |
24449 | 2317 |
|
2318 |
lemma foldl_conv_concat: |
|
29782 | 2319 |
"foldl (op @) xs xss = xs @ concat xss" |
2320 |
proof (induct xss arbitrary: xs) |
|
2321 |
case Nil show ?case by simp |
|
2322 |
next |
|
2323 |
interpret monoid_add "[]" "op @" proof qed simp_all |
|
2324 |
case Cons then show ?case by (simp add: foldl_absorb0) |
|
2325 |
qed |
|
2326 |
||
2327 |
lemma concat_conv_foldl: "concat xss = foldl (op @) [] xss" |
|
2328 |
by (simp add: foldl_conv_concat) |
|
2329 |
||
31455 | 2330 |
text {* @{const Finite_Set.fold} and @{const foldl} *} |
2331 |
||
2332 |
lemma (in fun_left_comm_idem) fold_set: |
|
2333 |
"fold f y (set xs) = foldl (\<lambda>y x. f x y) y xs" |
|
2334 |
by (rule sym, induct xs arbitrary: y) (simp_all add: fold_fun_comm) |
|
2335 |
||
32681
adeac3cbb659
lemma relating fold1 and foldl; code_unfold rules for Inf_fin, Sup_fin, Min, Max, Inf, Sup
haftmann
parents:
32422
diff
changeset
|
2336 |
lemma (in ab_semigroup_idem_mult) fold1_set: |
adeac3cbb659
lemma relating fold1 and foldl; code_unfold rules for Inf_fin, Sup_fin, Min, Max, Inf, Sup
haftmann
parents:
32422
diff
changeset
|
2337 |
assumes "xs \<noteq> []" |
adeac3cbb659
lemma relating fold1 and foldl; code_unfold rules for Inf_fin, Sup_fin, Min, Max, Inf, Sup
haftmann
parents:
32422
diff
changeset
|
2338 |
shows "fold1 times (set xs) = foldl times (hd xs) (tl xs)" |
adeac3cbb659
lemma relating fold1 and foldl; code_unfold rules for Inf_fin, Sup_fin, Min, Max, Inf, Sup
haftmann
parents:
32422
diff
changeset
|
2339 |
proof - |
adeac3cbb659
lemma relating fold1 and foldl; code_unfold rules for Inf_fin, Sup_fin, Min, Max, Inf, Sup
haftmann
parents:
32422
diff
changeset
|
2340 |
interpret fun_left_comm_idem times by (fact fun_left_comm_idem) |
adeac3cbb659
lemma relating fold1 and foldl; code_unfold rules for Inf_fin, Sup_fin, Min, Max, Inf, Sup
haftmann
parents:
32422
diff
changeset
|
2341 |
from assms obtain y ys where xs: "xs = y # ys" |
adeac3cbb659
lemma relating fold1 and foldl; code_unfold rules for Inf_fin, Sup_fin, Min, Max, Inf, Sup
haftmann
parents:
32422
diff
changeset
|
2342 |
by (cases xs) auto |
adeac3cbb659
lemma relating fold1 and foldl; code_unfold rules for Inf_fin, Sup_fin, Min, Max, Inf, Sup
haftmann
parents:
32422
diff
changeset
|
2343 |
show ?thesis |
adeac3cbb659
lemma relating fold1 and foldl; code_unfold rules for Inf_fin, Sup_fin, Min, Max, Inf, Sup
haftmann
parents:
32422
diff
changeset
|
2344 |
proof (cases "set ys = {}") |
adeac3cbb659
lemma relating fold1 and foldl; code_unfold rules for Inf_fin, Sup_fin, Min, Max, Inf, Sup
haftmann
parents:
32422
diff
changeset
|
2345 |
case True with xs show ?thesis by simp |
adeac3cbb659
lemma relating fold1 and foldl; code_unfold rules for Inf_fin, Sup_fin, Min, Max, Inf, Sup
haftmann
parents:
32422
diff
changeset
|
2346 |
next |
adeac3cbb659
lemma relating fold1 and foldl; code_unfold rules for Inf_fin, Sup_fin, Min, Max, Inf, Sup
haftmann
parents:
32422
diff
changeset
|
2347 |
case False |
adeac3cbb659
lemma relating fold1 and foldl; code_unfold rules for Inf_fin, Sup_fin, Min, Max, Inf, Sup
haftmann
parents:
32422
diff
changeset
|
2348 |
then have "fold1 times (insert y (set ys)) = fold times y (set ys)" |
adeac3cbb659
lemma relating fold1 and foldl; code_unfold rules for Inf_fin, Sup_fin, Min, Max, Inf, Sup
haftmann
parents:
32422
diff
changeset
|
2349 |
by (simp only: finite_set fold1_eq_fold_idem) |
adeac3cbb659
lemma relating fold1 and foldl; code_unfold rules for Inf_fin, Sup_fin, Min, Max, Inf, Sup
haftmann
parents:
32422
diff
changeset
|
2350 |
with xs show ?thesis by (simp add: fold_set mult_commute) |
adeac3cbb659
lemma relating fold1 and foldl; code_unfold rules for Inf_fin, Sup_fin, Min, Max, Inf, Sup
haftmann
parents:
32422
diff
changeset
|
2351 |
qed |
adeac3cbb659
lemma relating fold1 and foldl; code_unfold rules for Inf_fin, Sup_fin, Min, Max, Inf, Sup
haftmann
parents:
32422
diff
changeset
|
2352 |
qed |
adeac3cbb659
lemma relating fold1 and foldl; code_unfold rules for Inf_fin, Sup_fin, Min, Max, Inf, Sup
haftmann
parents:
32422
diff
changeset
|
2353 |
|
adeac3cbb659
lemma relating fold1 and foldl; code_unfold rules for Inf_fin, Sup_fin, Min, Max, Inf, Sup
haftmann
parents:
32422
diff
changeset
|
2354 |
lemma (in lattice) Inf_fin_set_fold [code_unfold]: |
adeac3cbb659
lemma relating fold1 and foldl; code_unfold rules for Inf_fin, Sup_fin, Min, Max, Inf, Sup
haftmann
parents:
32422
diff
changeset
|
2355 |
"Inf_fin (set (x # xs)) = foldl inf x xs" |
adeac3cbb659
lemma relating fold1 and foldl; code_unfold rules for Inf_fin, Sup_fin, Min, Max, Inf, Sup
haftmann
parents:
32422
diff
changeset
|
2356 |
proof - |
adeac3cbb659
lemma relating fold1 and foldl; code_unfold rules for Inf_fin, Sup_fin, Min, Max, Inf, Sup
haftmann
parents:
32422
diff
changeset
|
2357 |
interpret ab_semigroup_idem_mult "inf :: 'a \<Rightarrow> 'a \<Rightarrow> 'a" |
adeac3cbb659
lemma relating fold1 and foldl; code_unfold rules for Inf_fin, Sup_fin, Min, Max, Inf, Sup
haftmann
parents:
32422
diff
changeset
|
2358 |
by (fact ab_semigroup_idem_mult_inf) |
adeac3cbb659
lemma relating fold1 and foldl; code_unfold rules for Inf_fin, Sup_fin, Min, Max, Inf, Sup
haftmann
parents:
32422
diff
changeset
|
2359 |
show ?thesis |
adeac3cbb659
lemma relating fold1 and foldl; code_unfold rules for Inf_fin, Sup_fin, Min, Max, Inf, Sup
haftmann
parents:
32422
diff
changeset
|
2360 |
by (simp add: Inf_fin_def fold1_set del: set.simps) |
adeac3cbb659
lemma relating fold1 and foldl; code_unfold rules for Inf_fin, Sup_fin, Min, Max, Inf, Sup
haftmann
parents:
32422
diff
changeset
|
2361 |
qed |
adeac3cbb659
lemma relating fold1 and foldl; code_unfold rules for Inf_fin, Sup_fin, Min, Max, Inf, Sup
haftmann
parents:
32422
diff
changeset
|
2362 |
|
adeac3cbb659
lemma relating fold1 and foldl; code_unfold rules for Inf_fin, Sup_fin, Min, Max, Inf, Sup
haftmann
parents:
32422
diff
changeset
|
2363 |
lemma (in lattice) Sup_fin_set_fold [code_unfold]: |
adeac3cbb659
lemma relating fold1 and foldl; code_unfold rules for Inf_fin, Sup_fin, Min, Max, Inf, Sup
haftmann
parents:
32422
diff
changeset
|
2364 |
"Sup_fin (set (x # xs)) = foldl sup x xs" |
adeac3cbb659
lemma relating fold1 and foldl; code_unfold rules for Inf_fin, Sup_fin, Min, Max, Inf, Sup
haftmann
parents:
32422
diff
changeset
|
2365 |
proof - |
adeac3cbb659
lemma relating fold1 and foldl; code_unfold rules for Inf_fin, Sup_fin, Min, Max, Inf, Sup
haftmann
parents:
32422
diff
changeset
|
2366 |
interpret ab_semigroup_idem_mult "sup :: 'a \<Rightarrow> 'a \<Rightarrow> 'a" |
adeac3cbb659
lemma relating fold1 and foldl; code_unfold rules for Inf_fin, Sup_fin, Min, Max, Inf, Sup
haftmann
parents:
32422
diff
changeset
|
2367 |
by (fact ab_semigroup_idem_mult_sup) |
adeac3cbb659
lemma relating fold1 and foldl; code_unfold rules for Inf_fin, Sup_fin, Min, Max, Inf, Sup
haftmann
parents:
32422
diff
changeset
|
2368 |
show ?thesis |
adeac3cbb659
lemma relating fold1 and foldl; code_unfold rules for Inf_fin, Sup_fin, Min, Max, Inf, Sup
haftmann
parents:
32422
diff
changeset
|
2369 |
by (simp add: Sup_fin_def fold1_set del: set.simps) |
adeac3cbb659
lemma relating fold1 and foldl; code_unfold rules for Inf_fin, Sup_fin, Min, Max, Inf, Sup
haftmann
parents:
32422
diff
changeset
|
2370 |
qed |
adeac3cbb659
lemma relating fold1 and foldl; code_unfold rules for Inf_fin, Sup_fin, Min, Max, Inf, Sup
haftmann
parents:
32422
diff
changeset
|
2371 |
|
adeac3cbb659
lemma relating fold1 and foldl; code_unfold rules for Inf_fin, Sup_fin, Min, Max, Inf, Sup
haftmann
parents:
32422
diff
changeset
|
2372 |
lemma (in linorder) Min_fin_set_fold [code_unfold]: |
adeac3cbb659
lemma relating fold1 and foldl; code_unfold rules for Inf_fin, Sup_fin, Min, Max, Inf, Sup
haftmann
parents:
32422
diff
changeset
|
2373 |
"Min (set (x # xs)) = foldl min x xs" |
adeac3cbb659
lemma relating fold1 and foldl; code_unfold rules for Inf_fin, Sup_fin, Min, Max, Inf, Sup
haftmann
parents:
32422
diff
changeset
|
2374 |
proof - |
adeac3cbb659
lemma relating fold1 and foldl; code_unfold rules for Inf_fin, Sup_fin, Min, Max, Inf, Sup
haftmann
parents:
32422
diff
changeset
|
2375 |
interpret ab_semigroup_idem_mult "min :: 'a \<Rightarrow> 'a \<Rightarrow> 'a" |
adeac3cbb659
lemma relating fold1 and foldl; code_unfold rules for Inf_fin, Sup_fin, Min, Max, Inf, Sup
haftmann
parents:
32422
diff
changeset
|
2376 |
by (fact ab_semigroup_idem_mult_min) |
adeac3cbb659
lemma relating fold1 and foldl; code_unfold rules for Inf_fin, Sup_fin, Min, Max, Inf, Sup
haftmann
parents:
32422
diff
changeset
|
2377 |
show ?thesis |
adeac3cbb659
lemma relating fold1 and foldl; code_unfold rules for Inf_fin, Sup_fin, Min, Max, Inf, Sup
haftmann
parents:
32422
diff
changeset
|
2378 |
by (simp add: Min_def fold1_set del: set.simps) |
adeac3cbb659
lemma relating fold1 and foldl; code_unfold rules for Inf_fin, Sup_fin, Min, Max, Inf, Sup
haftmann
parents:
32422
diff
changeset
|
2379 |
qed |
adeac3cbb659
lemma relating fold1 and foldl; code_unfold rules for Inf_fin, Sup_fin, Min, Max, Inf, Sup
haftmann
parents:
32422
diff
changeset
|
2380 |
|
adeac3cbb659
lemma relating fold1 and foldl; code_unfold rules for Inf_fin, Sup_fin, Min, Max, Inf, Sup
haftmann
parents:
32422
diff
changeset
|
2381 |
lemma (in linorder) Max_fin_set_fold [code_unfold]: |
adeac3cbb659
lemma relating fold1 and foldl; code_unfold rules for Inf_fin, Sup_fin, Min, Max, Inf, Sup
haftmann
parents:
32422
diff
changeset
|
2382 |
"Max (set (x # xs)) = foldl max x xs" |
adeac3cbb659
lemma relating fold1 and foldl; code_unfold rules for Inf_fin, Sup_fin, Min, Max, Inf, Sup
haftmann
parents:
32422
diff
changeset
|
2383 |
proof - |
adeac3cbb659
lemma relating fold1 and foldl; code_unfold rules for Inf_fin, Sup_fin, Min, Max, Inf, Sup
haftmann
parents:
32422
diff
changeset
|
2384 |
interpret ab_semigroup_idem_mult "max :: 'a \<Rightarrow> 'a \<Rightarrow> 'a" |
adeac3cbb659
lemma relating fold1 and foldl; code_unfold rules for Inf_fin, Sup_fin, Min, Max, Inf, Sup
haftmann
parents:
32422
diff
changeset
|
2385 |
by (fact ab_semigroup_idem_mult_max) |
adeac3cbb659
lemma relating fold1 and foldl; code_unfold rules for Inf_fin, Sup_fin, Min, Max, Inf, Sup
haftmann
parents:
32422
diff
changeset
|
2386 |
show ?thesis |
adeac3cbb659
lemma relating fold1 and foldl; code_unfold rules for Inf_fin, Sup_fin, Min, Max, Inf, Sup
haftmann
parents:
32422
diff
changeset
|
2387 |
by (simp add: Max_def fold1_set del: set.simps) |
adeac3cbb659
lemma relating fold1 and foldl; code_unfold rules for Inf_fin, Sup_fin, Min, Max, Inf, Sup
haftmann
parents:
32422
diff
changeset
|
2388 |
qed |
adeac3cbb659
lemma relating fold1 and foldl; code_unfold rules for Inf_fin, Sup_fin, Min, Max, Inf, Sup
haftmann
parents:
32422
diff
changeset
|
2389 |
|
adeac3cbb659
lemma relating fold1 and foldl; code_unfold rules for Inf_fin, Sup_fin, Min, Max, Inf, Sup
haftmann
parents:
32422
diff
changeset
|
2390 |
lemma (in complete_lattice) Inf_set_fold [code_unfold]: |
adeac3cbb659
lemma relating fold1 and foldl; code_unfold rules for Inf_fin, Sup_fin, Min, Max, Inf, Sup
haftmann
parents:
32422
diff
changeset
|
2391 |
"Inf (set xs) = foldl inf top xs" |
34007
aea892559fc5
tuned lattices theory fragements; generlized some lemmas from sets to lattices
haftmann
parents:
33972
diff
changeset
|
2392 |
proof - |
aea892559fc5
tuned lattices theory fragements; generlized some lemmas from sets to lattices
haftmann
parents:
33972
diff
changeset
|
2393 |
interpret fun_left_comm_idem "inf :: 'a \<Rightarrow> 'a \<Rightarrow> 'a" |
aea892559fc5
tuned lattices theory fragements; generlized some lemmas from sets to lattices
haftmann
parents:
33972
diff
changeset
|
2394 |
by (fact fun_left_comm_idem_inf) |
aea892559fc5
tuned lattices theory fragements; generlized some lemmas from sets to lattices
haftmann
parents:
33972
diff
changeset
|
2395 |
show ?thesis by (simp add: Inf_fold_inf fold_set inf_commute) |
aea892559fc5
tuned lattices theory fragements; generlized some lemmas from sets to lattices
haftmann
parents:
33972
diff
changeset
|
2396 |
qed |
32681
adeac3cbb659
lemma relating fold1 and foldl; code_unfold rules for Inf_fin, Sup_fin, Min, Max, Inf, Sup
haftmann
parents:
32422
diff
changeset
|
2397 |
|
adeac3cbb659
lemma relating fold1 and foldl; code_unfold rules for Inf_fin, Sup_fin, Min, Max, Inf, Sup
haftmann
parents:
32422
diff
changeset
|
2398 |
lemma (in complete_lattice) Sup_set_fold [code_unfold]: |
adeac3cbb659
lemma relating fold1 and foldl; code_unfold rules for Inf_fin, Sup_fin, Min, Max, Inf, Sup
haftmann
parents:
32422
diff
changeset
|
2399 |
"Sup (set xs) = foldl sup bot xs" |
34007
aea892559fc5
tuned lattices theory fragements; generlized some lemmas from sets to lattices
haftmann
parents:
33972
diff
changeset
|
2400 |
proof - |
aea892559fc5
tuned lattices theory fragements; generlized some lemmas from sets to lattices
haftmann
parents:
33972
diff
changeset
|
2401 |
interpret fun_left_comm_idem "sup :: 'a \<Rightarrow> 'a \<Rightarrow> 'a" |
aea892559fc5
tuned lattices theory fragements; generlized some lemmas from sets to lattices
haftmann
parents:
33972
diff
changeset
|
2402 |
by (fact fun_left_comm_idem_sup) |
aea892559fc5
tuned lattices theory fragements; generlized some lemmas from sets to lattices
haftmann
parents:
33972
diff
changeset
|
2403 |
show ?thesis by (simp add: Sup_fold_sup fold_set sup_commute) |
aea892559fc5
tuned lattices theory fragements; generlized some lemmas from sets to lattices
haftmann
parents:
33972
diff
changeset
|
2404 |
qed |
aea892559fc5
tuned lattices theory fragements; generlized some lemmas from sets to lattices
haftmann
parents:
33972
diff
changeset
|
2405 |
|
aea892559fc5
tuned lattices theory fragements; generlized some lemmas from sets to lattices
haftmann
parents:
33972
diff
changeset
|
2406 |
lemma (in complete_lattice) INFI_set_fold: |
aea892559fc5
tuned lattices theory fragements; generlized some lemmas from sets to lattices
haftmann
parents:
33972
diff
changeset
|
2407 |
"INFI (set xs) f = foldl (\<lambda>y x. inf (f x) y) top xs" |
aea892559fc5
tuned lattices theory fragements; generlized some lemmas from sets to lattices
haftmann
parents:
33972
diff
changeset
|
2408 |
unfolding INFI_def set_map [symmetric] Inf_set_fold foldl_map |
aea892559fc5
tuned lattices theory fragements; generlized some lemmas from sets to lattices
haftmann
parents:
33972
diff
changeset
|
2409 |
by (simp add: inf_commute) |
aea892559fc5
tuned lattices theory fragements; generlized some lemmas from sets to lattices
haftmann
parents:
33972
diff
changeset
|
2410 |
|
aea892559fc5
tuned lattices theory fragements; generlized some lemmas from sets to lattices
haftmann
parents:
33972
diff
changeset
|
2411 |
lemma (in complete_lattice) SUPR_set_fold: |
aea892559fc5
tuned lattices theory fragements; generlized some lemmas from sets to lattices
haftmann
parents:
33972
diff
changeset
|
2412 |
"SUPR (set xs) f = foldl (\<lambda>y x. sup (f x) y) bot xs" |
aea892559fc5
tuned lattices theory fragements; generlized some lemmas from sets to lattices
haftmann
parents:
33972
diff
changeset
|
2413 |
unfolding SUPR_def set_map [symmetric] Sup_set_fold foldl_map |
aea892559fc5
tuned lattices theory fragements; generlized some lemmas from sets to lattices
haftmann
parents:
33972
diff
changeset
|
2414 |
by (simp add: sup_commute) |
31455 | 2415 |
|
23096 | 2416 |
subsubsection {* List summation: @{const listsum} and @{text"\<Sum>"}*} |
2417 |
||
26442
57fb6a8b099e
restructuring; explicit case names for rule list_induct2
haftmann
parents:
26300
diff
changeset
|
2418 |
lemma listsum_append [simp]: "listsum (xs @ ys) = listsum xs + listsum ys" |
24449 | 2419 |
by (induct xs) (simp_all add:add_assoc) |
2420 |
||
26442
57fb6a8b099e
restructuring; explicit case names for rule list_induct2
haftmann
parents:
26300
diff
changeset
|
2421 |
lemma listsum_rev [simp]: |
57fb6a8b099e
restructuring; explicit case names for rule list_induct2
haftmann
parents:
26300
diff
changeset
|
2422 |
fixes xs :: "'a\<Colon>comm_monoid_add list" |
57fb6a8b099e
restructuring; explicit case names for rule list_induct2
haftmann
parents:
26300
diff
changeset
|
2423 |
shows "listsum (rev xs) = listsum xs" |
24449 | 2424 |
by (induct xs) (simp_all add:add_ac) |
2425 |
||
31022 | 2426 |
lemma listsum_map_remove1: |
2427 |
fixes f :: "'a \<Rightarrow> ('b::comm_monoid_add)" |
|
2428 |
shows "x : set xs \<Longrightarrow> listsum(map f xs) = f x + listsum(map f (remove1 x xs))" |
|
2429 |
by (induct xs)(auto simp add:add_ac) |
|
2430 |
||
2431 |
lemma list_size_conv_listsum: |
|
2432 |
"list_size f xs = listsum (map f xs) + size xs" |
|
2433 |
by(induct xs) auto |
|
2434 |
||
26442
57fb6a8b099e
restructuring; explicit case names for rule list_induct2
haftmann
parents:
26300
diff
changeset
|
2435 |
lemma listsum_foldr: "listsum xs = foldr (op +) xs 0" |
57fb6a8b099e
restructuring; explicit case names for rule list_induct2
haftmann
parents:
26300
diff
changeset
|
2436 |
by (induct xs) auto |
57fb6a8b099e
restructuring; explicit case names for rule list_induct2
haftmann
parents:
26300
diff
changeset
|
2437 |
|
57fb6a8b099e
restructuring; explicit case names for rule list_induct2
haftmann
parents:
26300
diff
changeset
|
2438 |
lemma length_concat: "length (concat xss) = listsum (map length xss)" |
57fb6a8b099e
restructuring; explicit case names for rule list_induct2
haftmann
parents:
26300
diff
changeset
|
2439 |
by (induct xss) simp_all |
23096 | 2440 |
|
33639
603320b93668
New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents:
33593
diff
changeset
|
2441 |
lemma listsum_map_filter: |
603320b93668
New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents:
33593
diff
changeset
|
2442 |
fixes f :: "'a \<Rightarrow> 'b \<Colon> comm_monoid_add" |
603320b93668
New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents:
33593
diff
changeset
|
2443 |
assumes "\<And> x. \<lbrakk> x \<in> set xs ; \<not> P x \<rbrakk> \<Longrightarrow> f x = 0" |
603320b93668
New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents:
33593
diff
changeset
|
2444 |
shows "listsum (map f (filter P xs)) = listsum (map f xs)" |
603320b93668
New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents:
33593
diff
changeset
|
2445 |
using assms by (induct xs) auto |
603320b93668
New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents:
33593
diff
changeset
|
2446 |
|
24449 | 2447 |
text{* For efficient code generation --- |
2448 |
@{const listsum} is not tail recursive but @{const foldl} is. *} |
|
31998
2c7a24f74db9
code attributes use common underscore convention
haftmann
parents:
31930
diff
changeset
|
2449 |
lemma listsum[code_unfold]: "listsum xs = foldl (op +) 0 xs" |
23096 | 2450 |
by(simp add:listsum_foldr foldl_foldr1) |
2451 |
||
31077 | 2452 |
lemma distinct_listsum_conv_Setsum: |
2453 |
"distinct xs \<Longrightarrow> listsum xs = Setsum(set xs)" |
|
2454 |
by (induct xs) simp_all |
|
2455 |
||
24449 | 2456 |
|
23096 | 2457 |
text{* Some syntactic sugar for summing a function over a list: *} |
2458 |
||
2459 |
syntax |
|
2460 |
"_listsum" :: "pttrn => 'a list => 'b => 'b" ("(3SUM _<-_. _)" [0, 51, 10] 10) |
|
2461 |
syntax (xsymbols) |
|
2462 |
"_listsum" :: "pttrn => 'a list => 'b => 'b" ("(3\<Sum>_\<leftarrow>_. _)" [0, 51, 10] 10) |
|
2463 |
syntax (HTML output) |
|
2464 |
"_listsum" :: "pttrn => 'a list => 'b => 'b" ("(3\<Sum>_\<leftarrow>_. _)" [0, 51, 10] 10) |
|
2465 |
||
2466 |
translations -- {* Beware of argument permutation! *} |
|
34941 | 2467 |
"SUM x<-xs. b" == "CONST listsum (CONST map (%x. b) xs)" |
2468 |
"\<Sum>x\<leftarrow>xs. b" == "CONST listsum (CONST map (%x. b) xs)" |
|
23096 | 2469 |
|
26442
57fb6a8b099e
restructuring; explicit case names for rule list_induct2
haftmann
parents:
26300
diff
changeset
|
2470 |
lemma listsum_triv: "(\<Sum>x\<leftarrow>xs. r) = of_nat (length xs) * r" |
57fb6a8b099e
restructuring; explicit case names for rule list_induct2
haftmann
parents:
26300
diff
changeset
|
2471 |
by (induct xs) (simp_all add: left_distrib) |
57fb6a8b099e
restructuring; explicit case names for rule list_induct2
haftmann
parents:
26300
diff
changeset
|
2472 |
|
23096 | 2473 |
lemma listsum_0 [simp]: "(\<Sum>x\<leftarrow>xs. 0) = 0" |
26442
57fb6a8b099e
restructuring; explicit case names for rule list_induct2
haftmann
parents:
26300
diff
changeset
|
2474 |
by (induct xs) (simp_all add: left_distrib) |
23096 | 2475 |
|
2476 |
text{* For non-Abelian groups @{text xs} needs to be reversed on one side: *} |
|
2477 |
lemma uminus_listsum_map: |
|
26442
57fb6a8b099e
restructuring; explicit case names for rule list_induct2
haftmann
parents:
26300
diff
changeset
|
2478 |
fixes f :: "'a \<Rightarrow> 'b\<Colon>ab_group_add" |
57fb6a8b099e
restructuring; explicit case names for rule list_induct2
haftmann
parents:
26300
diff
changeset
|
2479 |
shows "- listsum (map f xs) = (listsum (map (uminus o f) xs))" |
57fb6a8b099e
restructuring; explicit case names for rule list_induct2
haftmann
parents:
26300
diff
changeset
|
2480 |
by (induct xs) simp_all |
23096 | 2481 |
|
31258 | 2482 |
lemma listsum_addf: |
2483 |
fixes f g :: "'a \<Rightarrow> 'b::comm_monoid_add" |
|
2484 |
shows "(\<Sum>x\<leftarrow>xs. f x + g x) = listsum (map f xs) + listsum (map g xs)" |
|
2485 |
by (induct xs) (simp_all add: algebra_simps) |
|
2486 |
||
2487 |
lemma listsum_subtractf: |
|
2488 |
fixes f g :: "'a \<Rightarrow> 'b::ab_group_add" |
|
2489 |
shows "(\<Sum>x\<leftarrow>xs. f x - g x) = listsum (map f xs) - listsum (map g xs)" |
|
2490 |
by (induct xs) simp_all |
|
2491 |
||
2492 |
lemma listsum_const_mult: |
|
2493 |
fixes f :: "'a \<Rightarrow> 'b::semiring_0" |
|
2494 |
shows "(\<Sum>x\<leftarrow>xs. c * f x) = c * (\<Sum>x\<leftarrow>xs. f x)" |
|
2495 |
by (induct xs, simp_all add: algebra_simps) |
|
2496 |
||
2497 |
lemma listsum_mult_const: |
|
2498 |
fixes f :: "'a \<Rightarrow> 'b::semiring_0" |
|
2499 |
shows "(\<Sum>x\<leftarrow>xs. f x * c) = (\<Sum>x\<leftarrow>xs. f x) * c" |
|
2500 |
by (induct xs, simp_all add: algebra_simps) |
|
2501 |
||
2502 |
lemma listsum_abs: |
|
35028
108662d50512
more consistent naming of type classes involving orderings (and lattices) -- c.f. NEWS
haftmann
parents:
34978
diff
changeset
|
2503 |
fixes xs :: "'a::ordered_ab_group_add_abs list" |
31258 | 2504 |
shows "\<bar>listsum xs\<bar> \<le> listsum (map abs xs)" |
2505 |
by (induct xs, simp, simp add: order_trans [OF abs_triangle_ineq]) |
|
2506 |
||
2507 |
lemma listsum_mono: |
|
35028
108662d50512
more consistent naming of type classes involving orderings (and lattices) -- c.f. NEWS
haftmann
parents:
34978
diff
changeset
|
2508 |
fixes f g :: "'a \<Rightarrow> 'b::{comm_monoid_add, ordered_ab_semigroup_add}" |
31258 | 2509 |
shows "(\<And>x. x \<in> set xs \<Longrightarrow> f x \<le> g x) \<Longrightarrow> (\<Sum>x\<leftarrow>xs. f x) \<le> (\<Sum>x\<leftarrow>xs. g x)" |
2510 |
by (induct xs, simp, simp add: add_mono) |
|
2511 |
||
13114 | 2512 |
|
24645 | 2513 |
subsubsection {* @{text upt} *} |
13114 | 2514 |
|
17090 | 2515 |
lemma upt_rec[code]: "[i..<j] = (if i<j then i#[Suc i..<j] else [])" |
2516 |
-- {* simp does not terminate! *} |
|
13145 | 2517 |
by (induct j) auto |
13142 | 2518 |
|
32005 | 2519 |
lemmas upt_rec_number_of[simp] = upt_rec[of "number_of m" "number_of n", standard] |
2520 |
||
15425 | 2521 |
lemma upt_conv_Nil [simp]: "j <= i ==> [i..<j] = []" |
13145 | 2522 |
by (subst upt_rec) simp |
13114 | 2523 |
|
15425 | 2524 |
lemma upt_eq_Nil_conv[simp]: "([i..<j] = []) = (j = 0 \<or> j <= i)" |
15281 | 2525 |
by(induct j)simp_all |
2526 |
||
2527 |
lemma upt_eq_Cons_conv: |
|
24526 | 2528 |
"([i..<j] = x#xs) = (i < j & i = x & [i+1..<j] = xs)" |
2529 |
apply(induct j arbitrary: x xs) |
|
15281 | 2530 |
apply simp |
2531 |
apply(clarsimp simp add: append_eq_Cons_conv) |
|
2532 |
apply arith |
|
2533 |
done |
|
2534 |
||
15425 | 2535 |
lemma upt_Suc_append: "i <= j ==> [i..<(Suc j)] = [i..<j]@[j]" |
13145 | 2536 |
-- {* Only needed if @{text upt_Suc} is deleted from the simpset. *} |
2537 |
by simp |
|
13114 | 2538 |
|
15425 | 2539 |
lemma upt_conv_Cons: "i < j ==> [i..<j] = i # [Suc i..<j]" |
26734 | 2540 |
by (simp add: upt_rec) |
13114 | 2541 |
|
15425 | 2542 |
lemma upt_add_eq_append: "i<=j ==> [i..<j+k] = [i..<j]@[j..<j+k]" |
13145 | 2543 |
-- {* LOOPS as a simprule, since @{text "j <= j"}. *} |
2544 |
by (induct k) auto |
|
13114 | 2545 |
|
15425 | 2546 |
lemma length_upt [simp]: "length [i..<j] = j - i" |
13145 | 2547 |
by (induct j) (auto simp add: Suc_diff_le) |
13114 | 2548 |
|
15425 | 2549 |
lemma nth_upt [simp]: "i + k < j ==> [i..<j] ! k = i + k" |
13145 | 2550 |
apply (induct j) |
2551 |
apply (auto simp add: less_Suc_eq nth_append split: nat_diff_split) |
|
2552 |
done |
|
13114 | 2553 |
|
17906 | 2554 |
|
2555 |
lemma hd_upt[simp]: "i < j \<Longrightarrow> hd[i..<j] = i" |
|
2556 |
by(simp add:upt_conv_Cons) |
|
2557 |
||
2558 |
lemma last_upt[simp]: "i < j \<Longrightarrow> last[i..<j] = j - 1" |
|
2559 |
apply(cases j) |
|
2560 |
apply simp |
|
2561 |
by(simp add:upt_Suc_append) |
|
2562 |
||
24526 | 2563 |
lemma take_upt [simp]: "i+m <= n ==> take m [i..<n] = [i..<i+m]" |
2564 |
apply (induct m arbitrary: i, simp) |
|
13145 | 2565 |
apply (subst upt_rec) |
2566 |
apply (rule sym) |
|
2567 |
apply (subst upt_rec) |
|
2568 |
apply (simp del: upt.simps) |
|
2569 |
done |
|
3507 | 2570 |
|
17501 | 2571 |
lemma drop_upt[simp]: "drop m [i..<j] = [i+m..<j]" |
2572 |
apply(induct j) |
|
2573 |
apply auto |
|
2574 |
done |
|
2575 |
||
24645 | 2576 |
lemma map_Suc_upt: "map Suc [m..<n] = [Suc m..<Suc n]" |
13145 | 2577 |
by (induct n) auto |
13114 | 2578 |
|
24526 | 2579 |
lemma nth_map_upt: "i < n-m ==> (map f [m..<n]) ! i = f(m+i)" |
2580 |
apply (induct n m arbitrary: i rule: diff_induct) |
|
13145 | 2581 |
prefer 3 apply (subst map_Suc_upt[symmetric]) |
2582 |
apply (auto simp add: less_diff_conv nth_upt) |
|
2583 |
done |
|
13114 | 2584 |
|
13883
0451e0fb3f22
Re-structured some proofs in order to get rid of rule_format attribute.
berghofe
parents:
13863
diff
changeset
|
2585 |
lemma nth_take_lemma: |
24526 | 2586 |
"k <= length xs ==> k <= length ys ==> |
13883
0451e0fb3f22
Re-structured some proofs in order to get rid of rule_format attribute.
berghofe
parents:
13863
diff
changeset
|
2587 |
(!!i. i < k --> xs!i = ys!i) ==> take k xs = take k ys" |
24526 | 2588 |
apply (atomize, induct k arbitrary: xs ys) |
14208 | 2589 |
apply (simp_all add: less_Suc_eq_0_disj all_conj_distrib, clarify) |
13145 | 2590 |
txt {* Both lists must be non-empty *} |
14208 | 2591 |
apply (case_tac xs, simp) |
2592 |
apply (case_tac ys, clarify) |
|
13145 | 2593 |
apply (simp (no_asm_use)) |
2594 |
apply clarify |
|
2595 |
txt {* prenexing's needed, not miniscoping *} |
|
2596 |
apply (simp (no_asm_use) add: all_simps [symmetric] del: all_simps) |
|
2597 |
apply blast |
|
2598 |
done |
|
13114 | 2599 |
|
2600 |
lemma nth_equalityI: |
|
2601 |
"[| length xs = length ys; ALL i < length xs. xs!i = ys!i |] ==> xs = ys" |
|
13145 | 2602 |
apply (frule nth_take_lemma [OF le_refl eq_imp_le]) |
2603 |
apply (simp_all add: take_all) |
|
2604 |
done |
|
13142 | 2605 |
|
24796 | 2606 |
lemma map_nth: |
2607 |
"map (\<lambda>i. xs ! i) [0..<length xs] = xs" |
|
2608 |
by (rule nth_equalityI, auto) |
|
2609 |
||
13863 | 2610 |
(* needs nth_equalityI *) |
2611 |
lemma list_all2_antisym: |
|
2612 |
"\<lbrakk> (\<And>x y. \<lbrakk>P x y; Q y x\<rbrakk> \<Longrightarrow> x = y); list_all2 P xs ys; list_all2 Q ys xs \<rbrakk> |
|
2613 |
\<Longrightarrow> xs = ys" |
|
2614 |
apply (simp add: list_all2_conv_all_nth) |
|
14208 | 2615 |
apply (rule nth_equalityI, blast, simp) |
13863 | 2616 |
done |
2617 |
||
13142 | 2618 |
lemma take_equalityI: "(\<forall>i. take i xs = take i ys) ==> xs = ys" |
13145 | 2619 |
-- {* The famous take-lemma. *} |
2620 |
apply (drule_tac x = "max (length xs) (length ys)" in spec) |
|
2621 |
apply (simp add: le_max_iff_disj take_all) |
|
2622 |
done |
|
13142 | 2623 |
|
2624 |
||
15302 | 2625 |
lemma take_Cons': |
2626 |
"take n (x # xs) = (if n = 0 then [] else x # take (n - 1) xs)" |
|
2627 |
by (cases n) simp_all |
|
2628 |
||
2629 |
lemma drop_Cons': |
|
2630 |
"drop n (x # xs) = (if n = 0 then x # xs else drop (n - 1) xs)" |
|
2631 |
by (cases n) simp_all |
|
2632 |
||
2633 |
lemma nth_Cons': "(x # xs)!n = (if n = 0 then x else xs!(n - 1))" |
|
2634 |
by (cases n) simp_all |
|
2635 |
||
18622 | 2636 |
lemmas take_Cons_number_of = take_Cons'[of "number_of v",standard] |
2637 |
lemmas drop_Cons_number_of = drop_Cons'[of "number_of v",standard] |
|
2638 |
lemmas nth_Cons_number_of = nth_Cons'[of _ _ "number_of v",standard] |
|
2639 |
||
2640 |
declare take_Cons_number_of [simp] |
|
2641 |
drop_Cons_number_of [simp] |
|
2642 |
nth_Cons_number_of [simp] |
|
15302 | 2643 |
|
2644 |
||
32415
1dddf2f64266
got rid of complicated class finite_intvl_succ and defined "upto" directly on int, the only instance of the class.
nipkow
parents:
32078
diff
changeset
|
2645 |
subsubsection {* @{text upto}: interval-list on @{typ int} *} |
1dddf2f64266
got rid of complicated class finite_intvl_succ and defined "upto" directly on int, the only instance of the class.
nipkow
parents:
32078
diff
changeset
|
2646 |
|
1dddf2f64266
got rid of complicated class finite_intvl_succ and defined "upto" directly on int, the only instance of the class.
nipkow
parents:
32078
diff
changeset
|
2647 |
(* FIXME make upto tail recursive? *) |
1dddf2f64266
got rid of complicated class finite_intvl_succ and defined "upto" directly on int, the only instance of the class.
nipkow
parents:
32078
diff
changeset
|
2648 |
|
1dddf2f64266
got rid of complicated class finite_intvl_succ and defined "upto" directly on int, the only instance of the class.
nipkow
parents:
32078
diff
changeset
|
2649 |
function upto :: "int \<Rightarrow> int \<Rightarrow> int list" ("(1[_../_])") where |
1dddf2f64266
got rid of complicated class finite_intvl_succ and defined "upto" directly on int, the only instance of the class.
nipkow
parents:
32078
diff
changeset
|
2650 |
"upto i j = (if i \<le> j then i # [i+1..j] else [])" |
1dddf2f64266
got rid of complicated class finite_intvl_succ and defined "upto" directly on int, the only instance of the class.
nipkow
parents:
32078
diff
changeset
|
2651 |
by auto |
1dddf2f64266
got rid of complicated class finite_intvl_succ and defined "upto" directly on int, the only instance of the class.
nipkow
parents:
32078
diff
changeset
|
2652 |
termination |
1dddf2f64266
got rid of complicated class finite_intvl_succ and defined "upto" directly on int, the only instance of the class.
nipkow
parents:
32078
diff
changeset
|
2653 |
by(relation "measure(%(i::int,j). nat(j - i + 1))") auto |
1dddf2f64266
got rid of complicated class finite_intvl_succ and defined "upto" directly on int, the only instance of the class.
nipkow
parents:
32078
diff
changeset
|
2654 |
|
1dddf2f64266
got rid of complicated class finite_intvl_succ and defined "upto" directly on int, the only instance of the class.
nipkow
parents:
32078
diff
changeset
|
2655 |
declare upto.simps[code, simp del] |
1dddf2f64266
got rid of complicated class finite_intvl_succ and defined "upto" directly on int, the only instance of the class.
nipkow
parents:
32078
diff
changeset
|
2656 |
|
1dddf2f64266
got rid of complicated class finite_intvl_succ and defined "upto" directly on int, the only instance of the class.
nipkow
parents:
32078
diff
changeset
|
2657 |
lemmas upto_rec_number_of[simp] = |
1dddf2f64266
got rid of complicated class finite_intvl_succ and defined "upto" directly on int, the only instance of the class.
nipkow
parents:
32078
diff
changeset
|
2658 |
upto.simps[of "number_of m" "number_of n", standard] |
1dddf2f64266
got rid of complicated class finite_intvl_succ and defined "upto" directly on int, the only instance of the class.
nipkow
parents:
32078
diff
changeset
|
2659 |
|
1dddf2f64266
got rid of complicated class finite_intvl_succ and defined "upto" directly on int, the only instance of the class.
nipkow
parents:
32078
diff
changeset
|
2660 |
lemma upto_empty[simp]: "j < i \<Longrightarrow> [i..j] = []" |
1dddf2f64266
got rid of complicated class finite_intvl_succ and defined "upto" directly on int, the only instance of the class.
nipkow
parents:
32078
diff
changeset
|
2661 |
by(simp add: upto.simps) |
1dddf2f64266
got rid of complicated class finite_intvl_succ and defined "upto" directly on int, the only instance of the class.
nipkow
parents:
32078
diff
changeset
|
2662 |
|
1dddf2f64266
got rid of complicated class finite_intvl_succ and defined "upto" directly on int, the only instance of the class.
nipkow
parents:
32078
diff
changeset
|
2663 |
lemma set_upto[simp]: "set[i..j] = {i..j}" |
1dddf2f64266
got rid of complicated class finite_intvl_succ and defined "upto" directly on int, the only instance of the class.
nipkow
parents:
32078
diff
changeset
|
2664 |
apply(induct i j rule:upto.induct) |
1dddf2f64266
got rid of complicated class finite_intvl_succ and defined "upto" directly on int, the only instance of the class.
nipkow
parents:
32078
diff
changeset
|
2665 |
apply(simp add: upto.simps simp_from_to) |
1dddf2f64266
got rid of complicated class finite_intvl_succ and defined "upto" directly on int, the only instance of the class.
nipkow
parents:
32078
diff
changeset
|
2666 |
done |
1dddf2f64266
got rid of complicated class finite_intvl_succ and defined "upto" directly on int, the only instance of the class.
nipkow
parents:
32078
diff
changeset
|
2667 |
|
1dddf2f64266
got rid of complicated class finite_intvl_succ and defined "upto" directly on int, the only instance of the class.
nipkow
parents:
32078
diff
changeset
|
2668 |
|
15392 | 2669 |
subsubsection {* @{text "distinct"} and @{text remdups} *} |
13142 | 2670 |
|
2671 |
lemma distinct_append [simp]: |
|
13145 | 2672 |
"distinct (xs @ ys) = (distinct xs \<and> distinct ys \<and> set xs \<inter> set ys = {})" |
2673 |
by (induct xs) auto |
|
13142 | 2674 |
|
15305 | 2675 |
lemma distinct_rev[simp]: "distinct(rev xs) = distinct xs" |
2676 |
by(induct xs) auto |
|
2677 |
||
13142 | 2678 |
lemma set_remdups [simp]: "set (remdups xs) = set xs" |
13145 | 2679 |
by (induct xs) (auto simp add: insert_absorb) |
13142 | 2680 |
|
2681 |
lemma distinct_remdups [iff]: "distinct (remdups xs)" |
|
13145 | 2682 |
by (induct xs) auto |
13142 | 2683 |
|
25287 | 2684 |
lemma distinct_remdups_id: "distinct xs ==> remdups xs = xs" |
2685 |
by (induct xs, auto) |
|
2686 |
||
26734 | 2687 |
lemma remdups_id_iff_distinct [simp]: "remdups xs = xs \<longleftrightarrow> distinct xs" |
2688 |
by (metis distinct_remdups distinct_remdups_id) |
|
25287 | 2689 |
|
24566 | 2690 |
lemma finite_distinct_list: "finite A \<Longrightarrow> EX xs. set xs = A & distinct xs" |
24632 | 2691 |
by (metis distinct_remdups finite_list set_remdups) |
24566 | 2692 |
|
15072 | 2693 |
lemma remdups_eq_nil_iff [simp]: "(remdups x = []) = (x = [])" |
24349 | 2694 |
by (induct x, auto) |
15072 | 2695 |
|
2696 |
lemma remdups_eq_nil_right_iff [simp]: "([] = remdups x) = (x = [])" |
|
24349 | 2697 |
by (induct x, auto) |
15072 | 2698 |
|
15245 | 2699 |
lemma length_remdups_leq[iff]: "length(remdups xs) <= length xs" |
2700 |
by (induct xs) auto |
|
2701 |
||
2702 |
lemma length_remdups_eq[iff]: |
|
2703 |
"(length (remdups xs) = length xs) = (remdups xs = xs)" |
|
2704 |
apply(induct xs) |
|
2705 |
apply auto |
|
2706 |
apply(subgoal_tac "length (remdups xs) <= length xs") |
|
2707 |
apply arith |
|
2708 |
apply(rule length_remdups_leq) |
|
2709 |
done |
|
2710 |
||
33945 | 2711 |
lemma remdups_filter: "remdups(filter P xs) = filter P (remdups xs)" |
2712 |
apply(induct xs) |
|
2713 |
apply auto |
|
2714 |
done |
|
18490 | 2715 |
|
2716 |
lemma distinct_map: |
|
2717 |
"distinct(map f xs) = (distinct xs & inj_on f (set xs))" |
|
2718 |
by (induct xs) auto |
|
2719 |
||
2720 |
||
13142 | 2721 |
lemma distinct_filter [simp]: "distinct xs ==> distinct (filter P xs)" |
13145 | 2722 |
by (induct xs) auto |
13114 | 2723 |
|
17501 | 2724 |
lemma distinct_upt[simp]: "distinct[i..<j]" |
2725 |
by (induct j) auto |
|
2726 |
||
32415
1dddf2f64266
got rid of complicated class finite_intvl_succ and defined "upto" directly on int, the only instance of the class.
nipkow
parents:
32078
diff
changeset
|
2727 |
lemma distinct_upto[simp]: "distinct[i..j]" |
1dddf2f64266
got rid of complicated class finite_intvl_succ and defined "upto" directly on int, the only instance of the class.
nipkow
parents:
32078
diff
changeset
|
2728 |
apply(induct i j rule:upto.induct) |
1dddf2f64266
got rid of complicated class finite_intvl_succ and defined "upto" directly on int, the only instance of the class.
nipkow
parents:
32078
diff
changeset
|
2729 |
apply(subst upto.simps) |
1dddf2f64266
got rid of complicated class finite_intvl_succ and defined "upto" directly on int, the only instance of the class.
nipkow
parents:
32078
diff
changeset
|
2730 |
apply(simp) |
1dddf2f64266
got rid of complicated class finite_intvl_succ and defined "upto" directly on int, the only instance of the class.
nipkow
parents:
32078
diff
changeset
|
2731 |
done |
1dddf2f64266
got rid of complicated class finite_intvl_succ and defined "upto" directly on int, the only instance of the class.
nipkow
parents:
32078
diff
changeset
|
2732 |
|
24526 | 2733 |
lemma distinct_take[simp]: "distinct xs \<Longrightarrow> distinct (take i xs)" |
2734 |
apply(induct xs arbitrary: i) |
|
17501 | 2735 |
apply simp |
2736 |
apply (case_tac i) |
|
2737 |
apply simp_all |
|
2738 |
apply(blast dest:in_set_takeD) |
|
2739 |
done |
|
2740 |
||
24526 | 2741 |
lemma distinct_drop[simp]: "distinct xs \<Longrightarrow> distinct (drop i xs)" |
2742 |
apply(induct xs arbitrary: i) |
|
17501 | 2743 |
apply simp |
2744 |
apply (case_tac i) |
|
2745 |
apply simp_all |
|
2746 |
done |
|
2747 |
||
2748 |
lemma distinct_list_update: |
|
2749 |
assumes d: "distinct xs" and a: "a \<notin> set xs - {xs!i}" |
|
2750 |
shows "distinct (xs[i:=a])" |
|
2751 |
proof (cases "i < length xs") |
|
2752 |
case True |
|
2753 |
with a have "a \<notin> set (take i xs @ xs ! i # drop (Suc i) xs) - {xs!i}" |
|
2754 |
apply (drule_tac id_take_nth_drop) by simp |
|
2755 |
with d True show ?thesis |
|
2756 |
apply (simp add: upd_conv_take_nth_drop) |
|
2757 |
apply (drule subst [OF id_take_nth_drop]) apply assumption |
|
2758 |
apply simp apply (cases "a = xs!i") apply simp by blast |
|
2759 |
next |
|
2760 |
case False with d show ?thesis by auto |
|
2761 |
qed |
|
2762 |
||
31363
7493b571b37d
Added theorems about distinct & concat, map & replicate and concat & replicate
hoelzl
parents:
31264
diff
changeset
|
2763 |
lemma distinct_concat: |
7493b571b37d
Added theorems about distinct & concat, map & replicate and concat & replicate
hoelzl
parents:
31264
diff
changeset
|
2764 |
assumes "distinct xs" |
7493b571b37d
Added theorems about distinct & concat, map & replicate and concat & replicate
hoelzl
parents:
31264
diff
changeset
|
2765 |
and "\<And> ys. ys \<in> set xs \<Longrightarrow> distinct ys" |
7493b571b37d
Added theorems about distinct & concat, map & replicate and concat & replicate
hoelzl
parents:
31264
diff
changeset
|
2766 |
and "\<And> ys zs. \<lbrakk> ys \<in> set xs ; zs \<in> set xs ; ys \<noteq> zs \<rbrakk> \<Longrightarrow> set ys \<inter> set zs = {}" |
7493b571b37d
Added theorems about distinct & concat, map & replicate and concat & replicate
hoelzl
parents:
31264
diff
changeset
|
2767 |
shows "distinct (concat xs)" |
7493b571b37d
Added theorems about distinct & concat, map & replicate and concat & replicate
hoelzl
parents:
31264
diff
changeset
|
2768 |
using assms by (induct xs) auto |
17501 | 2769 |
|
2770 |
text {* It is best to avoid this indexed version of distinct, but |
|
2771 |
sometimes it is useful. *} |
|
2772 |
||
13142 | 2773 |
lemma distinct_conv_nth: |
17501 | 2774 |
"distinct xs = (\<forall>i < size xs. \<forall>j < size xs. i \<noteq> j --> xs!i \<noteq> xs!j)" |
15251 | 2775 |
apply (induct xs, simp, simp) |
14208 | 2776 |
apply (rule iffI, clarsimp) |
13145 | 2777 |
apply (case_tac i) |
14208 | 2778 |
apply (case_tac j, simp) |
13145 | 2779 |
apply (simp add: set_conv_nth) |
2780 |
apply (case_tac j) |
|
24648 | 2781 |
apply (clarsimp simp add: set_conv_nth, simp) |
13145 | 2782 |
apply (rule conjI) |
24648 | 2783 |
(*TOO SLOW |
24632 | 2784 |
apply (metis Zero_neq_Suc gr0_conv_Suc in_set_conv_nth lessI less_trans_Suc nth_Cons' nth_Cons_Suc) |
24648 | 2785 |
*) |
2786 |
apply (clarsimp simp add: set_conv_nth) |
|
2787 |
apply (erule_tac x = 0 in allE, simp) |
|
2788 |
apply (erule_tac x = "Suc i" in allE, simp, clarsimp) |
|
25130 | 2789 |
(*TOO SLOW |
24632 | 2790 |
apply (metis Suc_Suc_eq lessI less_trans_Suc nth_Cons_Suc) |
25130 | 2791 |
*) |
2792 |
apply (erule_tac x = "Suc i" in allE, simp) |
|
2793 |
apply (erule_tac x = "Suc j" in allE, simp) |
|
13145 | 2794 |
done |
13114 | 2795 |
|
18490 | 2796 |
lemma nth_eq_iff_index_eq: |
2797 |
"\<lbrakk> distinct xs; i < length xs; j < length xs \<rbrakk> \<Longrightarrow> (xs!i = xs!j) = (i = j)" |
|
2798 |
by(auto simp: distinct_conv_nth) |
|
2799 |
||
15110
78b5636eabc7
Added a number of new thms and the new function remove1
nipkow
parents:
15072
diff
changeset
|
2800 |
lemma distinct_card: "distinct xs ==> card (set xs) = size xs" |
24349 | 2801 |
by (induct xs) auto |
14388 | 2802 |
|
15110
78b5636eabc7
Added a number of new thms and the new function remove1
nipkow
parents:
15072
diff
changeset
|
2803 |
lemma card_distinct: "card (set xs) = size xs ==> distinct xs" |
14388 | 2804 |
proof (induct xs) |
2805 |
case Nil thus ?case by simp |
|
2806 |
next |
|
2807 |
case (Cons x xs) |
|
2808 |
show ?case |
|
2809 |
proof (cases "x \<in> set xs") |
|
2810 |
case False with Cons show ?thesis by simp |
|
2811 |
next |
|
2812 |
case True with Cons.prems |
|
2813 |
have "card (set xs) = Suc (length xs)" |
|
2814 |
by (simp add: card_insert_if split: split_if_asm) |
|
2815 |
moreover have "card (set xs) \<le> length xs" by (rule card_length) |
|
2816 |
ultimately have False by simp |
|
2817 |
thus ?thesis .. |
|
2818 |
qed |
|
2819 |
qed |
|
2820 |
||
25287 | 2821 |
lemma not_distinct_decomp: "~ distinct ws ==> EX xs ys zs y. ws = xs@[y]@ys@[y]@zs" |
2822 |
apply (induct n == "length ws" arbitrary:ws) apply simp |
|
2823 |
apply(case_tac ws) apply simp |
|
2824 |
apply (simp split:split_if_asm) |
|
2825 |
apply (metis Cons_eq_appendI eq_Nil_appendI split_list) |
|
2826 |
done |
|
18490 | 2827 |
|
2828 |
lemma length_remdups_concat: |
|
2829 |
"length(remdups(concat xss)) = card(\<Union>xs \<in> set xss. set xs)" |
|
24308 | 2830 |
by(simp add: set_concat distinct_card[symmetric]) |
17906 | 2831 |
|
33639
603320b93668
New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents:
33593
diff
changeset
|
2832 |
lemma length_remdups_card_conv: "length(remdups xs) = card(set xs)" |
603320b93668
New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents:
33593
diff
changeset
|
2833 |
proof - |
603320b93668
New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents:
33593
diff
changeset
|
2834 |
have xs: "concat[xs] = xs" by simp |
603320b93668
New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents:
33593
diff
changeset
|
2835 |
from length_remdups_concat[of "[xs]"] show ?thesis unfolding xs by simp |
603320b93668
New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents:
33593
diff
changeset
|
2836 |
qed |
17906 | 2837 |
|
34978
874150ddd50a
canonical insert operation; generalized lemma foldl_apply_inv to foldl_apply
haftmann
parents:
34942
diff
changeset
|
2838 |
subsubsection {* @{const insert} *} |
874150ddd50a
canonical insert operation; generalized lemma foldl_apply_inv to foldl_apply
haftmann
parents:
34942
diff
changeset
|
2839 |
|
874150ddd50a
canonical insert operation; generalized lemma foldl_apply_inv to foldl_apply
haftmann
parents:
34942
diff
changeset
|
2840 |
lemma in_set_insert [simp]: |
874150ddd50a
canonical insert operation; generalized lemma foldl_apply_inv to foldl_apply
haftmann
parents:
34942
diff
changeset
|
2841 |
"x \<in> set xs \<Longrightarrow> List.insert x xs = xs" |
874150ddd50a
canonical insert operation; generalized lemma foldl_apply_inv to foldl_apply
haftmann
parents:
34942
diff
changeset
|
2842 |
by (simp add: List.insert_def) |
874150ddd50a
canonical insert operation; generalized lemma foldl_apply_inv to foldl_apply
haftmann
parents:
34942
diff
changeset
|
2843 |
|
874150ddd50a
canonical insert operation; generalized lemma foldl_apply_inv to foldl_apply
haftmann
parents:
34942
diff
changeset
|
2844 |
lemma not_in_set_insert [simp]: |
874150ddd50a
canonical insert operation; generalized lemma foldl_apply_inv to foldl_apply
haftmann
parents:
34942
diff
changeset
|
2845 |
"x \<notin> set xs \<Longrightarrow> List.insert x xs = x # xs" |
874150ddd50a
canonical insert operation; generalized lemma foldl_apply_inv to foldl_apply
haftmann
parents:
34942
diff
changeset
|
2846 |
by (simp add: List.insert_def) |
874150ddd50a
canonical insert operation; generalized lemma foldl_apply_inv to foldl_apply
haftmann
parents:
34942
diff
changeset
|
2847 |
|
874150ddd50a
canonical insert operation; generalized lemma foldl_apply_inv to foldl_apply
haftmann
parents:
34942
diff
changeset
|
2848 |
lemma insert_Nil [simp]: |
874150ddd50a
canonical insert operation; generalized lemma foldl_apply_inv to foldl_apply
haftmann
parents:
34942
diff
changeset
|
2849 |
"List.insert x [] = [x]" |
874150ddd50a
canonical insert operation; generalized lemma foldl_apply_inv to foldl_apply
haftmann
parents:
34942
diff
changeset
|
2850 |
by simp |
874150ddd50a
canonical insert operation; generalized lemma foldl_apply_inv to foldl_apply
haftmann
parents:
34942
diff
changeset
|
2851 |
|
874150ddd50a
canonical insert operation; generalized lemma foldl_apply_inv to foldl_apply
haftmann
parents:
34942
diff
changeset
|
2852 |
lemma set_insert: |
874150ddd50a
canonical insert operation; generalized lemma foldl_apply_inv to foldl_apply
haftmann
parents:
34942
diff
changeset
|
2853 |
"set (List.insert x xs) = insert x (set xs)" |
874150ddd50a
canonical insert operation; generalized lemma foldl_apply_inv to foldl_apply
haftmann
parents:
34942
diff
changeset
|
2854 |
by (auto simp add: List.insert_def) |
874150ddd50a
canonical insert operation; generalized lemma foldl_apply_inv to foldl_apply
haftmann
parents:
34942
diff
changeset
|
2855 |
|
874150ddd50a
canonical insert operation; generalized lemma foldl_apply_inv to foldl_apply
haftmann
parents:
34942
diff
changeset
|
2856 |
|
15392 | 2857 |
subsubsection {* @{text remove1} *} |
15110
78b5636eabc7
Added a number of new thms and the new function remove1
nipkow
parents:
15072
diff
changeset
|
2858 |
|
18049 | 2859 |
lemma remove1_append: |
2860 |
"remove1 x (xs @ ys) = |
|
2861 |
(if x \<in> set xs then remove1 x xs @ ys else xs @ remove1 x ys)" |
|
2862 |
by (induct xs) auto |
|
2863 |
||
23479 | 2864 |
lemma in_set_remove1[simp]: |
2865 |
"a \<noteq> b \<Longrightarrow> a : set(remove1 b xs) = (a : set xs)" |
|
2866 |
apply (induct xs) |
|
2867 |
apply auto |
|
2868 |
done |
|
2869 |
||
15110
78b5636eabc7
Added a number of new thms and the new function remove1
nipkow
parents:
15072
diff
changeset
|
2870 |
lemma set_remove1_subset: "set(remove1 x xs) <= set xs" |
78b5636eabc7
Added a number of new thms and the new function remove1
nipkow
parents:
15072
diff
changeset
|
2871 |
apply(induct xs) |
78b5636eabc7
Added a number of new thms and the new function remove1
nipkow
parents:
15072
diff
changeset
|
2872 |
apply simp |
78b5636eabc7
Added a number of new thms and the new function remove1
nipkow
parents:
15072
diff
changeset
|
2873 |
apply simp |
78b5636eabc7
Added a number of new thms and the new function remove1
nipkow
parents:
15072
diff
changeset
|
2874 |
apply blast |
78b5636eabc7
Added a number of new thms and the new function remove1
nipkow
parents:
15072
diff
changeset
|
2875 |
done |
78b5636eabc7
Added a number of new thms and the new function remove1
nipkow
parents:
15072
diff
changeset
|
2876 |
|
17724 | 2877 |
lemma set_remove1_eq [simp]: "distinct xs ==> set(remove1 x xs) = set xs - {x}" |
15110
78b5636eabc7
Added a number of new thms and the new function remove1
nipkow
parents:
15072
diff
changeset
|
2878 |
apply(induct xs) |
78b5636eabc7
Added a number of new thms and the new function remove1
nipkow
parents:
15072
diff
changeset
|
2879 |
apply simp |
78b5636eabc7
Added a number of new thms and the new function remove1
nipkow
parents:
15072
diff
changeset
|
2880 |
apply simp |
78b5636eabc7
Added a number of new thms and the new function remove1
nipkow
parents:
15072
diff
changeset
|
2881 |
apply blast |
78b5636eabc7
Added a number of new thms and the new function remove1
nipkow
parents:
15072
diff
changeset
|
2882 |
done |
78b5636eabc7
Added a number of new thms and the new function remove1
nipkow
parents:
15072
diff
changeset
|
2883 |
|
23479 | 2884 |
lemma length_remove1: |
30128
365ee7319b86
revert some Suc 0 lemmas back to their original forms; added some simp rules for (1::nat)
huffman
parents:
30079
diff
changeset
|
2885 |
"length(remove1 x xs) = (if x : set xs then length xs - 1 else length xs)" |
23479 | 2886 |
apply (induct xs) |
2887 |
apply (auto dest!:length_pos_if_in_set) |
|
2888 |
done |
|
2889 |
||
18049 | 2890 |
lemma remove1_filter_not[simp]: |
2891 |
"\<not> P x \<Longrightarrow> remove1 x (filter P xs) = filter P xs" |
|
2892 |
by(induct xs) auto |
|
2893 |
||
15110
78b5636eabc7
Added a number of new thms and the new function remove1
nipkow
parents:
15072
diff
changeset
|
2894 |
lemma notin_set_remove1[simp]: "x ~: set xs ==> x ~: set(remove1 y xs)" |
78b5636eabc7
Added a number of new thms and the new function remove1
nipkow
parents:
15072
diff
changeset
|
2895 |
apply(insert set_remove1_subset) |
78b5636eabc7
Added a number of new thms and the new function remove1
nipkow
parents:
15072
diff
changeset
|
2896 |
apply fast |
78b5636eabc7
Added a number of new thms and the new function remove1
nipkow
parents:
15072
diff
changeset
|
2897 |
done |
78b5636eabc7
Added a number of new thms and the new function remove1
nipkow
parents:
15072
diff
changeset
|
2898 |
|
78b5636eabc7
Added a number of new thms and the new function remove1
nipkow
parents:
15072
diff
changeset
|
2899 |
lemma distinct_remove1[simp]: "distinct xs ==> distinct(remove1 x xs)" |
78b5636eabc7
Added a number of new thms and the new function remove1
nipkow
parents:
15072
diff
changeset
|
2900 |
by (induct xs) simp_all |
78b5636eabc7
Added a number of new thms and the new function remove1
nipkow
parents:
15072
diff
changeset
|
2901 |
|
13114 | 2902 |
|
27693 | 2903 |
subsubsection {* @{text removeAll} *} |
2904 |
||
34978
874150ddd50a
canonical insert operation; generalized lemma foldl_apply_inv to foldl_apply
haftmann
parents:
34942
diff
changeset
|
2905 |
lemma removeAll_filter_not_eq: |
874150ddd50a
canonical insert operation; generalized lemma foldl_apply_inv to foldl_apply
haftmann
parents:
34942
diff
changeset
|
2906 |
"removeAll x = filter (\<lambda>y. x \<noteq> y)" |
874150ddd50a
canonical insert operation; generalized lemma foldl_apply_inv to foldl_apply
haftmann
parents:
34942
diff
changeset
|
2907 |
proof |
874150ddd50a
canonical insert operation; generalized lemma foldl_apply_inv to foldl_apply
haftmann
parents:
34942
diff
changeset
|
2908 |
fix xs |
874150ddd50a
canonical insert operation; generalized lemma foldl_apply_inv to foldl_apply
haftmann
parents:
34942
diff
changeset
|
2909 |
show "removeAll x xs = filter (\<lambda>y. x \<noteq> y) xs" |
874150ddd50a
canonical insert operation; generalized lemma foldl_apply_inv to foldl_apply
haftmann
parents:
34942
diff
changeset
|
2910 |
by (induct xs) auto |
874150ddd50a
canonical insert operation; generalized lemma foldl_apply_inv to foldl_apply
haftmann
parents:
34942
diff
changeset
|
2911 |
qed |
874150ddd50a
canonical insert operation; generalized lemma foldl_apply_inv to foldl_apply
haftmann
parents:
34942
diff
changeset
|
2912 |
|
27693 | 2913 |
lemma removeAll_append[simp]: |
2914 |
"removeAll x (xs @ ys) = removeAll x xs @ removeAll x ys" |
|
2915 |
by (induct xs) auto |
|
2916 |
||
2917 |
lemma set_removeAll[simp]: "set(removeAll x xs) = set xs - {x}" |
|
2918 |
by (induct xs) auto |
|
2919 |
||
2920 |
lemma removeAll_id[simp]: "x \<notin> set xs \<Longrightarrow> removeAll x xs = xs" |
|
2921 |
by (induct xs) auto |
|
2922 |
||
2923 |
(* Needs count:: 'a \<Rightarrow> a' list \<Rightarrow> nat |
|
2924 |
lemma length_removeAll: |
|
2925 |
"length(removeAll x xs) = length xs - count x xs" |
|
2926 |
*) |
|
2927 |
||
2928 |
lemma removeAll_filter_not[simp]: |
|
2929 |
"\<not> P x \<Longrightarrow> removeAll x (filter P xs) = filter P xs" |
|
2930 |
by(induct xs) auto |
|
2931 |
||
34978
874150ddd50a
canonical insert operation; generalized lemma foldl_apply_inv to foldl_apply
haftmann
parents:
34942
diff
changeset
|
2932 |
lemma distinct_removeAll: |
874150ddd50a
canonical insert operation; generalized lemma foldl_apply_inv to foldl_apply
haftmann
parents:
34942
diff
changeset
|
2933 |
"distinct xs \<Longrightarrow> distinct (removeAll x xs)" |
874150ddd50a
canonical insert operation; generalized lemma foldl_apply_inv to foldl_apply
haftmann
parents:
34942
diff
changeset
|
2934 |
by (simp add: removeAll_filter_not_eq) |
27693 | 2935 |
|
2936 |
lemma distinct_remove1_removeAll: |
|
2937 |
"distinct xs ==> remove1 x xs = removeAll x xs" |
|
2938 |
by (induct xs) simp_all |
|
2939 |
||
2940 |
lemma map_removeAll_inj_on: "inj_on f (insert x (set xs)) \<Longrightarrow> |
|
2941 |
map f (removeAll x xs) = removeAll (f x) (map f xs)" |
|
2942 |
by (induct xs) (simp_all add:inj_on_def) |
|
2943 |
||
2944 |
lemma map_removeAll_inj: "inj f \<Longrightarrow> |
|
2945 |
map f (removeAll x xs) = removeAll (f x) (map f xs)" |
|
2946 |
by(metis map_removeAll_inj_on subset_inj_on subset_UNIV) |
|
2947 |
||
2948 |
||
15392 | 2949 |
subsubsection {* @{text replicate} *} |
13114 | 2950 |
|
13142 | 2951 |
lemma length_replicate [simp]: "length (replicate n x) = n" |
13145 | 2952 |
by (induct n) auto |
13124 | 2953 |
|
13142 | 2954 |
lemma map_replicate [simp]: "map f (replicate n x) = replicate n (f x)" |
13145 | 2955 |
by (induct n) auto |
13114 | 2956 |
|
31363
7493b571b37d
Added theorems about distinct & concat, map & replicate and concat & replicate
hoelzl
parents:
31264
diff
changeset
|
2957 |
lemma map_replicate_const: |
7493b571b37d
Added theorems about distinct & concat, map & replicate and concat & replicate
hoelzl
parents:
31264
diff
changeset
|
2958 |
"map (\<lambda> x. k) lst = replicate (length lst) k" |
7493b571b37d
Added theorems about distinct & concat, map & replicate and concat & replicate
hoelzl
parents:
31264
diff
changeset
|
2959 |
by (induct lst) auto |
7493b571b37d
Added theorems about distinct & concat, map & replicate and concat & replicate
hoelzl
parents:
31264
diff
changeset
|
2960 |
|
13114 | 2961 |
lemma replicate_app_Cons_same: |
13145 | 2962 |
"(replicate n x) @ (x # xs) = x # replicate n x @ xs" |
2963 |
by (induct n) auto |
|
13114 | 2964 |
|
13142 | 2965 |
lemma rev_replicate [simp]: "rev (replicate n x) = replicate n x" |
14208 | 2966 |
apply (induct n, simp) |
13145 | 2967 |
apply (simp add: replicate_app_Cons_same) |
2968 |
done |
|
13114 | 2969 |
|
13142 | 2970 |
lemma replicate_add: "replicate (n + m) x = replicate n x @ replicate m x" |
13145 | 2971 |
by (induct n) auto |
13114 | 2972 |
|
16397 | 2973 |
text{* Courtesy of Matthias Daum: *} |
2974 |
lemma append_replicate_commute: |
|
2975 |
"replicate n x @ replicate k x = replicate k x @ replicate n x" |
|
2976 |
apply (simp add: replicate_add [THEN sym]) |
|
2977 |
apply (simp add: add_commute) |
|
2978 |
done |
|
2979 |
||
31080 | 2980 |
text{* Courtesy of Andreas Lochbihler: *} |
2981 |
lemma filter_replicate: |
|
2982 |
"filter P (replicate n x) = (if P x then replicate n x else [])" |
|
2983 |
by(induct n) auto |
|
2984 |
||
13142 | 2985 |
lemma hd_replicate [simp]: "n \<noteq> 0 ==> hd (replicate n x) = x" |
13145 | 2986 |
by (induct n) auto |
13114 | 2987 |
|
13142 | 2988 |
lemma tl_replicate [simp]: "n \<noteq> 0 ==> tl (replicate n x) = replicate (n - 1) x" |
13145 | 2989 |
by (induct n) auto |
13114 | 2990 |
|
13142 | 2991 |
lemma last_replicate [simp]: "n \<noteq> 0 ==> last (replicate n x) = x" |
13145 | 2992 |
by (atomize (full), induct n) auto |
13114 | 2993 |
|
24526 | 2994 |
lemma nth_replicate[simp]: "i < n ==> (replicate n x)!i = x" |
2995 |
apply (induct n arbitrary: i, simp) |
|
13145 | 2996 |
apply (simp add: nth_Cons split: nat.split) |
2997 |
done |
|
13114 | 2998 |
|
16397 | 2999 |
text{* Courtesy of Matthias Daum (2 lemmas): *} |
3000 |
lemma take_replicate[simp]: "take i (replicate k x) = replicate (min i k) x" |
|
3001 |
apply (case_tac "k \<le> i") |
|
3002 |
apply (simp add: min_def) |
|
3003 |
apply (drule not_leE) |
|
3004 |
apply (simp add: min_def) |
|
3005 |
apply (subgoal_tac "replicate k x = replicate i x @ replicate (k - i) x") |
|
3006 |
apply simp |
|
3007 |
apply (simp add: replicate_add [symmetric]) |
|
3008 |
done |
|
3009 |
||
24526 | 3010 |
lemma drop_replicate[simp]: "drop i (replicate k x) = replicate (k-i) x" |
3011 |
apply (induct k arbitrary: i) |
|
16397 | 3012 |
apply simp |
3013 |
apply clarsimp |
|
3014 |
apply (case_tac i) |
|
3015 |
apply simp |
|
3016 |
apply clarsimp |
|
3017 |
done |
|
3018 |
||
3019 |
||
13142 | 3020 |
lemma set_replicate_Suc: "set (replicate (Suc n) x) = {x}" |
13145 | 3021 |
by (induct n) auto |
13114 | 3022 |
|
13142 | 3023 |
lemma set_replicate [simp]: "n \<noteq> 0 ==> set (replicate n x) = {x}" |
13145 | 3024 |
by (fast dest!: not0_implies_Suc intro!: set_replicate_Suc) |
13114 | 3025 |
|
13142 | 3026 |
lemma set_replicate_conv_if: "set (replicate n x) = (if n = 0 then {} else {x})" |
13145 | 3027 |
by auto |
13114 | 3028 |
|
13142 | 3029 |
lemma in_set_replicateD: "x : set (replicate n y) ==> x = y" |
13145 | 3030 |
by (simp add: set_replicate_conv_if split: split_if_asm) |
13114 | 3031 |
|
24796 | 3032 |
lemma replicate_append_same: |
3033 |
"replicate i x @ [x] = x # replicate i x" |
|
3034 |
by (induct i) simp_all |
|
3035 |
||
3036 |
lemma map_replicate_trivial: |
|
3037 |
"map (\<lambda>i. x) [0..<i] = replicate i x" |
|
3038 |
by (induct i) (simp_all add: replicate_append_same) |
|
3039 |
||
31363
7493b571b37d
Added theorems about distinct & concat, map & replicate and concat & replicate
hoelzl
parents:
31264
diff
changeset
|
3040 |
lemma concat_replicate_trivial[simp]: |
7493b571b37d
Added theorems about distinct & concat, map & replicate and concat & replicate
hoelzl
parents:
31264
diff
changeset
|
3041 |
"concat (replicate i []) = []" |
7493b571b37d
Added theorems about distinct & concat, map & replicate and concat & replicate
hoelzl
parents:
31264
diff
changeset
|
3042 |
by (induct i) (auto simp add: map_replicate_const) |
13114 | 3043 |
|
28642 | 3044 |
lemma replicate_empty[simp]: "(replicate n x = []) \<longleftrightarrow> n=0" |
3045 |
by (induct n) auto |
|
3046 |
||
3047 |
lemma empty_replicate[simp]: "([] = replicate n x) \<longleftrightarrow> n=0" |
|
3048 |
by (induct n) auto |
|
3049 |
||
3050 |
lemma replicate_eq_replicate[simp]: |
|
3051 |
"(replicate m x = replicate n y) \<longleftrightarrow> (m=n & (m\<noteq>0 \<longrightarrow> x=y))" |
|
3052 |
apply(induct m arbitrary: n) |
|
3053 |
apply simp |
|
3054 |
apply(induct_tac n) |
|
3055 |
apply auto |
|
3056 |
done |
|
3057 |
||
3058 |
||
15392 | 3059 |
subsubsection{*@{text rotate1} and @{text rotate}*} |
15302 | 3060 |
|
3061 |
lemma rotate_simps[simp]: "rotate1 [] = [] \<and> rotate1 (x#xs) = xs @ [x]" |
|
3062 |
by(simp add:rotate1_def) |
|
3063 |
||
3064 |
lemma rotate0[simp]: "rotate 0 = id" |
|
3065 |
by(simp add:rotate_def) |
|
3066 |
||
3067 |
lemma rotate_Suc[simp]: "rotate (Suc n) xs = rotate1(rotate n xs)" |
|
3068 |
by(simp add:rotate_def) |
|
3069 |
||
3070 |
lemma rotate_add: |
|
3071 |
"rotate (m+n) = rotate m o rotate n" |
|
3072 |
by(simp add:rotate_def funpow_add) |
|
3073 |
||
3074 |
lemma rotate_rotate: "rotate m (rotate n xs) = rotate (m+n) xs" |
|
3075 |
by(simp add:rotate_add) |
|
3076 |
||
18049 | 3077 |
lemma rotate1_rotate_swap: "rotate1 (rotate n xs) = rotate n (rotate1 xs)" |
3078 |
by(simp add:rotate_def funpow_swap1) |
|
3079 |
||
15302 | 3080 |
lemma rotate1_length01[simp]: "length xs <= 1 \<Longrightarrow> rotate1 xs = xs" |
3081 |
by(cases xs) simp_all |
|
3082 |
||
3083 |
lemma rotate_length01[simp]: "length xs <= 1 \<Longrightarrow> rotate n xs = xs" |
|
3084 |
apply(induct n) |
|
3085 |
apply simp |
|
3086 |
apply (simp add:rotate_def) |
|
13145 | 3087 |
done |
13114 | 3088 |
|
15302 | 3089 |
lemma rotate1_hd_tl: "xs \<noteq> [] \<Longrightarrow> rotate1 xs = tl xs @ [hd xs]" |
3090 |
by(simp add:rotate1_def split:list.split) |
|
3091 |
||
3092 |
lemma rotate_drop_take: |
|
3093 |
"rotate n xs = drop (n mod length xs) xs @ take (n mod length xs) xs" |
|
3094 |
apply(induct n) |
|
3095 |
apply simp |
|
3096 |
apply(simp add:rotate_def) |
|
3097 |
apply(cases "xs = []") |
|
3098 |
apply (simp) |
|
3099 |
apply(case_tac "n mod length xs = 0") |
|
3100 |
apply(simp add:mod_Suc) |
|
3101 |
apply(simp add: rotate1_hd_tl drop_Suc take_Suc) |
|
3102 |
apply(simp add:mod_Suc rotate1_hd_tl drop_Suc[symmetric] drop_tl[symmetric] |
|
3103 |
take_hd_drop linorder_not_le) |
|
13145 | 3104 |
done |
13114 | 3105 |
|
15302 | 3106 |
lemma rotate_conv_mod: "rotate n xs = rotate (n mod length xs) xs" |
3107 |
by(simp add:rotate_drop_take) |
|
3108 |
||
3109 |
lemma rotate_id[simp]: "n mod length xs = 0 \<Longrightarrow> rotate n xs = xs" |
|
3110 |
by(simp add:rotate_drop_take) |
|
3111 |
||
3112 |
lemma length_rotate1[simp]: "length(rotate1 xs) = length xs" |
|
3113 |
by(simp add:rotate1_def split:list.split) |
|
3114 |
||
24526 | 3115 |
lemma length_rotate[simp]: "length(rotate n xs) = length xs" |
3116 |
by (induct n arbitrary: xs) (simp_all add:rotate_def) |
|
15302 | 3117 |
|
3118 |
lemma distinct1_rotate[simp]: "distinct(rotate1 xs) = distinct xs" |
|
3119 |
by(simp add:rotate1_def split:list.split) blast |
|
3120 |
||
3121 |
lemma distinct_rotate[simp]: "distinct(rotate n xs) = distinct xs" |
|
3122 |
by (induct n) (simp_all add:rotate_def) |
|
3123 |
||
3124 |
lemma rotate_map: "rotate n (map f xs) = map f (rotate n xs)" |
|
3125 |
by(simp add:rotate_drop_take take_map drop_map) |
|
3126 |
||
3127 |
lemma set_rotate1[simp]: "set(rotate1 xs) = set xs" |
|
3128 |
by(simp add:rotate1_def split:list.split) |
|
3129 |
||
3130 |
lemma set_rotate[simp]: "set(rotate n xs) = set xs" |
|
3131 |
by (induct n) (simp_all add:rotate_def) |
|
3132 |
||
3133 |
lemma rotate1_is_Nil_conv[simp]: "(rotate1 xs = []) = (xs = [])" |
|
3134 |
by(simp add:rotate1_def split:list.split) |
|
3135 |
||
3136 |
lemma rotate_is_Nil_conv[simp]: "(rotate n xs = []) = (xs = [])" |
|
3137 |
by (induct n) (simp_all add:rotate_def) |
|
13114 | 3138 |
|
15439 | 3139 |
lemma rotate_rev: |
3140 |
"rotate n (rev xs) = rev(rotate (length xs - (n mod length xs)) xs)" |
|
3141 |
apply(simp add:rotate_drop_take rev_drop rev_take) |
|
3142 |
apply(cases "length xs = 0") |
|
3143 |
apply simp |
|
3144 |
apply(cases "n mod length xs = 0") |
|
3145 |
apply simp |
|
3146 |
apply(simp add:rotate_drop_take rev_drop rev_take) |
|
3147 |
done |
|
3148 |
||
18423 | 3149 |
lemma hd_rotate_conv_nth: "xs \<noteq> [] \<Longrightarrow> hd(rotate n xs) = xs!(n mod length xs)" |
3150 |
apply(simp add:rotate_drop_take hd_append hd_drop_conv_nth hd_conv_nth) |
|
3151 |
apply(subgoal_tac "length xs \<noteq> 0") |
|
3152 |
prefer 2 apply simp |
|
3153 |
using mod_less_divisor[of "length xs" n] by arith |
|
3154 |
||
13114 | 3155 |
|
15392 | 3156 |
subsubsection {* @{text sublist} --- a generalization of @{text nth} to sets *} |
13114 | 3157 |
|
13142 | 3158 |
lemma sublist_empty [simp]: "sublist xs {} = []" |
13145 | 3159 |
by (auto simp add: sublist_def) |
13114 | 3160 |
|
13142 | 3161 |
lemma sublist_nil [simp]: "sublist [] A = []" |
13145 | 3162 |
by (auto simp add: sublist_def) |
13114 | 3163 |
|
15281 | 3164 |
lemma length_sublist: |
3165 |
"length(sublist xs I) = card{i. i < length xs \<and> i : I}" |
|
3166 |
by(simp add: sublist_def length_filter_conv_card cong:conj_cong) |
|
3167 |
||
3168 |
lemma sublist_shift_lemma_Suc: |
|
24526 | 3169 |
"map fst (filter (%p. P(Suc(snd p))) (zip xs is)) = |
3170 |
map fst (filter (%p. P(snd p)) (zip xs (map Suc is)))" |
|
3171 |
apply(induct xs arbitrary: "is") |
|
15281 | 3172 |
apply simp |
3173 |
apply (case_tac "is") |
|
3174 |
apply simp |
|
3175 |
apply simp |
|
3176 |
done |
|
3177 |
||
13114 | 3178 |
lemma sublist_shift_lemma: |
23279
e39dd93161d9
tuned list comprehension, changed filter syntax from : to <-
nipkow
parents:
23246
diff
changeset
|
3179 |
"map fst [p<-zip xs [i..<i + length xs] . snd p : A] = |
e39dd93161d9
tuned list comprehension, changed filter syntax from : to <-
nipkow
parents:
23246
diff
changeset
|
3180 |
map fst [p<-zip xs [0..<length xs] . snd p + i : A]" |
13145 | 3181 |
by (induct xs rule: rev_induct) (simp_all add: add_commute) |
13114 | 3182 |
|
3183 |
lemma sublist_append: |
|
15168 | 3184 |
"sublist (l @ l') A = sublist l A @ sublist l' {j. j + length l : A}" |
13145 | 3185 |
apply (unfold sublist_def) |
14208 | 3186 |
apply (induct l' rule: rev_induct, simp) |
13145 | 3187 |
apply (simp add: upt_add_eq_append[of 0] zip_append sublist_shift_lemma) |
3188 |
apply (simp add: add_commute) |
|
3189 |
done |
|
13114 | 3190 |
|
3191 |
lemma sublist_Cons: |
|
13145 | 3192 |
"sublist (x # l) A = (if 0:A then [x] else []) @ sublist l {j. Suc j : A}" |
3193 |
apply (induct l rule: rev_induct) |
|
3194 |
apply (simp add: sublist_def) |
|
3195 |
apply (simp del: append_Cons add: append_Cons[symmetric] sublist_append) |
|
3196 |
done |
|
13114 | 3197 |
|
24526 | 3198 |
lemma set_sublist: "set(sublist xs I) = {xs!i|i. i<size xs \<and> i \<in> I}" |
3199 |
apply(induct xs arbitrary: I) |
|
25162 | 3200 |
apply(auto simp: sublist_Cons nth_Cons split:nat.split dest!: gr0_implies_Suc) |
15281 | 3201 |
done |
3202 |
||
3203 |
lemma set_sublist_subset: "set(sublist xs I) \<subseteq> set xs" |
|
3204 |
by(auto simp add:set_sublist) |
|
3205 |
||
3206 |
lemma notin_set_sublistI[simp]: "x \<notin> set xs \<Longrightarrow> x \<notin> set(sublist xs I)" |
|
3207 |
by(auto simp add:set_sublist) |
|
3208 |
||
3209 |
lemma in_set_sublistD: "x \<in> set(sublist xs I) \<Longrightarrow> x \<in> set xs" |
|
3210 |
by(auto simp add:set_sublist) |
|
3211 |
||
13142 | 3212 |
lemma sublist_singleton [simp]: "sublist [x] A = (if 0 : A then [x] else [])" |
13145 | 3213 |
by (simp add: sublist_Cons) |
13114 | 3214 |
|
15281 | 3215 |
|
24526 | 3216 |
lemma distinct_sublistI[simp]: "distinct xs \<Longrightarrow> distinct(sublist xs I)" |
3217 |
apply(induct xs arbitrary: I) |
|
15281 | 3218 |
apply simp |
3219 |
apply(auto simp add:sublist_Cons) |
|
3220 |
done |
|
3221 |
||
3222 |
||
15045 | 3223 |
lemma sublist_upt_eq_take [simp]: "sublist l {..<n} = take n l" |
14208 | 3224 |
apply (induct l rule: rev_induct, simp) |
13145 | 3225 |
apply (simp split: nat_diff_split add: sublist_append) |
3226 |
done |
|
13114 | 3227 |
|
24526 | 3228 |
lemma filter_in_sublist: |
3229 |
"distinct xs \<Longrightarrow> filter (%x. x \<in> set(sublist xs s)) xs = sublist xs s" |
|
3230 |
proof (induct xs arbitrary: s) |
|
17501 | 3231 |
case Nil thus ?case by simp |
3232 |
next |
|
3233 |
case (Cons a xs) |
|
3234 |
moreover hence "!x. x: set xs \<longrightarrow> x \<noteq> a" by auto |
|
3235 |
ultimately show ?case by(simp add: sublist_Cons cong:filter_cong) |
|
3236 |
qed |
|
3237 |
||
13114 | 3238 |
|
19390 | 3239 |
subsubsection {* @{const splice} *} |
3240 |
||
19607
07eeb832f28d
introduced characters for code generator; some improved code lemmas for some list functions
haftmann
parents:
19585
diff
changeset
|
3241 |
lemma splice_Nil2 [simp, code]: |
19390 | 3242 |
"splice xs [] = xs" |
3243 |
by (cases xs) simp_all |
|
3244 |
||
19607
07eeb832f28d
introduced characters for code generator; some improved code lemmas for some list functions
haftmann
parents:
19585
diff
changeset
|
3245 |
lemma splice_Cons_Cons [simp, code]: |
19390 | 3246 |
"splice (x#xs) (y#ys) = x # y # splice xs ys" |
3247 |
by simp |
|
3248 |
||
19607
07eeb832f28d
introduced characters for code generator; some improved code lemmas for some list functions
haftmann
parents:
19585
diff
changeset
|
3249 |
declare splice.simps(2) [simp del, code del] |
19390 | 3250 |
|
24526 | 3251 |
lemma length_splice[simp]: "length(splice xs ys) = length xs + length ys" |
3252 |
apply(induct xs arbitrary: ys) apply simp |
|
22793 | 3253 |
apply(case_tac ys) |
3254 |
apply auto |
|
3255 |
done |
|
3256 |
||
34933 | 3257 |
subsubsection{*Transpose*} |
3258 |
||
3259 |
function transpose where |
|
3260 |
"transpose [] = []" | |
|
3261 |
"transpose ([] # xss) = transpose xss" | |
|
3262 |
"transpose ((x#xs) # xss) = |
|
3263 |
(x # [h. (h#t) \<leftarrow> xss]) # transpose (xs # [t. (h#t) \<leftarrow> xss])" |
|
3264 |
by pat_completeness auto |
|
3265 |
||
3266 |
lemma transpose_aux_filter_head: |
|
3267 |
"concat (map (list_case [] (\<lambda>h t. [h])) xss) = |
|
3268 |
map (\<lambda>xs. hd xs) [ys\<leftarrow>xss . ys \<noteq> []]" |
|
3269 |
by (induct xss) (auto split: list.split) |
|
3270 |
||
3271 |
lemma transpose_aux_filter_tail: |
|
3272 |
"concat (map (list_case [] (\<lambda>h t. [t])) xss) = |
|
3273 |
map (\<lambda>xs. tl xs) [ys\<leftarrow>xss . ys \<noteq> []]" |
|
3274 |
by (induct xss) (auto split: list.split) |
|
3275 |
||
3276 |
lemma transpose_aux_max: |
|
3277 |
"max (Suc (length xs)) (foldr (\<lambda>xs. max (length xs)) xss 0) = |
|
3278 |
Suc (max (length xs) (foldr (\<lambda>x. max (length x - Suc 0)) [ys\<leftarrow>xss . ys\<noteq>[]] 0))" |
|
3279 |
(is "max _ ?foldB = Suc (max _ ?foldA)") |
|
3280 |
proof (cases "[ys\<leftarrow>xss . ys\<noteq>[]] = []") |
|
3281 |
case True |
|
3282 |
hence "foldr (\<lambda>xs. max (length xs)) xss 0 = 0" |
|
3283 |
proof (induct xss) |
|
3284 |
case (Cons x xs) |
|
3285 |
moreover hence "x = []" by (cases x) auto |
|
3286 |
ultimately show ?case by auto |
|
3287 |
qed simp |
|
3288 |
thus ?thesis using True by simp |
|
3289 |
next |
|
3290 |
case False |
|
3291 |
||
3292 |
have foldA: "?foldA = foldr (\<lambda>x. max (length x)) [ys\<leftarrow>xss . ys \<noteq> []] 0 - 1" |
|
3293 |
by (induct xss) auto |
|
3294 |
have foldB: "?foldB = foldr (\<lambda>x. max (length x)) [ys\<leftarrow>xss . ys \<noteq> []] 0" |
|
3295 |
by (induct xss) auto |
|
3296 |
||
3297 |
have "0 < ?foldB" |
|
3298 |
proof - |
|
3299 |
from False |
|
3300 |
obtain z zs where zs: "[ys\<leftarrow>xss . ys \<noteq> []] = z#zs" by (auto simp: neq_Nil_conv) |
|
3301 |
hence "z \<in> set ([ys\<leftarrow>xss . ys \<noteq> []])" by auto |
|
3302 |
hence "z \<noteq> []" by auto |
|
3303 |
thus ?thesis |
|
3304 |
unfolding foldB zs |
|
3305 |
by (auto simp: max_def intro: less_le_trans) |
|
3306 |
qed |
|
3307 |
thus ?thesis |
|
3308 |
unfolding foldA foldB max_Suc_Suc[symmetric] |
|
3309 |
by simp |
|
3310 |
qed |
|
3311 |
||
3312 |
termination transpose |
|
3313 |
by (relation "measure (\<lambda>xs. foldr (\<lambda>xs. max (length xs)) xs 0 + length xs)") |
|
3314 |
(auto simp: transpose_aux_filter_tail foldr_map comp_def transpose_aux_max less_Suc_eq_le) |
|
3315 |
||
3316 |
lemma transpose_empty: "(transpose xs = []) \<longleftrightarrow> (\<forall>x \<in> set xs. x = [])" |
|
3317 |
by (induct rule: transpose.induct) simp_all |
|
3318 |
||
3319 |
lemma length_transpose: |
|
3320 |
fixes xs :: "'a list list" |
|
3321 |
shows "length (transpose xs) = foldr (\<lambda>xs. max (length xs)) xs 0" |
|
3322 |
by (induct rule: transpose.induct) |
|
3323 |
(auto simp: transpose_aux_filter_tail foldr_map comp_def transpose_aux_max |
|
3324 |
max_Suc_Suc[symmetric] simp del: max_Suc_Suc) |
|
3325 |
||
3326 |
lemma nth_transpose: |
|
3327 |
fixes xs :: "'a list list" |
|
3328 |
assumes "i < length (transpose xs)" |
|
3329 |
shows "transpose xs ! i = map (\<lambda>xs. xs ! i) [ys \<leftarrow> xs. i < length ys]" |
|
3330 |
using assms proof (induct arbitrary: i rule: transpose.induct) |
|
3331 |
case (3 x xs xss) |
|
3332 |
def XS == "(x # xs) # xss" |
|
3333 |
hence [simp]: "XS \<noteq> []" by auto |
|
3334 |
thus ?case |
|
3335 |
proof (cases i) |
|
3336 |
case 0 |
|
3337 |
thus ?thesis by (simp add: transpose_aux_filter_head hd_conv_nth) |
|
3338 |
next |
|
3339 |
case (Suc j) |
|
3340 |
have *: "\<And>xss. xs # map tl xss = map tl ((x#xs)#xss)" by simp |
|
3341 |
have **: "\<And>xss. (x#xs) # filter (\<lambda>ys. ys \<noteq> []) xss = filter (\<lambda>ys. ys \<noteq> []) ((x#xs)#xss)" by simp |
|
3342 |
{ fix x have "Suc j < length x \<longleftrightarrow> x \<noteq> [] \<and> j < length x - Suc 0" |
|
3343 |
by (cases x) simp_all |
|
3344 |
} note *** = this |
|
3345 |
||
3346 |
have j_less: "j < length (transpose (xs # concat (map (list_case [] (\<lambda>h t. [t])) xss)))" |
|
3347 |
using "3.prems" by (simp add: transpose_aux_filter_tail length_transpose Suc) |
|
3348 |
||
3349 |
show ?thesis |
|
3350 |
unfolding transpose.simps `i = Suc j` nth_Cons_Suc "3.hyps"[OF j_less] |
|
3351 |
apply (auto simp: transpose_aux_filter_tail filter_map comp_def length_transpose * ** *** XS_def[symmetric]) |
|
3352 |
apply (rule_tac y=x in list.exhaust) |
|
3353 |
by auto |
|
3354 |
qed |
|
3355 |
qed simp_all |
|
3356 |
||
3357 |
lemma transpose_map_map: |
|
3358 |
"transpose (map (map f) xs) = map (map f) (transpose xs)" |
|
3359 |
proof (rule nth_equalityI, safe) |
|
3360 |
have [simp]: "length (transpose (map (map f) xs)) = length (transpose xs)" |
|
3361 |
by (simp add: length_transpose foldr_map comp_def) |
|
3362 |
show "length (transpose (map (map f) xs)) = length (map (map f) (transpose xs))" by simp |
|
3363 |
||
3364 |
fix i assume "i < length (transpose (map (map f) xs))" |
|
3365 |
thus "transpose (map (map f) xs) ! i = map (map f) (transpose xs) ! i" |
|
3366 |
by (simp add: nth_transpose filter_map comp_def) |
|
3367 |
qed |
|
24616 | 3368 |
|
31557 | 3369 |
subsubsection {* (In)finiteness *} |
28642 | 3370 |
|
3371 |
lemma finite_maxlen: |
|
3372 |
"finite (M::'a list set) ==> EX n. ALL s:M. size s < n" |
|
3373 |
proof (induct rule: finite.induct) |
|
3374 |
case emptyI show ?case by simp |
|
3375 |
next |
|
3376 |
case (insertI M xs) |
|
3377 |
then obtain n where "\<forall>s\<in>M. length s < n" by blast |
|
3378 |
hence "ALL s:insert xs M. size s < max n (size xs) + 1" by auto |
|
3379 |
thus ?case .. |
|
3380 |
qed |
|
3381 |
||
31557 | 3382 |
lemma finite_lists_length_eq: |
3383 |
assumes "finite A" |
|
3384 |
shows "finite {xs. set xs \<subseteq> A \<and> length xs = n}" (is "finite (?S n)") |
|
3385 |
proof(induct n) |
|
3386 |
case 0 show ?case by simp |
|
3387 |
next |
|
3388 |
case (Suc n) |
|
3389 |
have "?S (Suc n) = (\<Union>x\<in>A. (\<lambda>xs. x#xs) ` ?S n)" |
|
3390 |
by (auto simp:length_Suc_conv) |
|
3391 |
then show ?case using `finite A` |
|
3392 |
by (auto intro: finite_imageI Suc) (* FIXME metis? *) |
|
3393 |
qed |
|
3394 |
||
3395 |
lemma finite_lists_length_le: |
|
3396 |
assumes "finite A" shows "finite {xs. set xs \<subseteq> A \<and> length xs \<le> n}" |
|
3397 |
(is "finite ?S") |
|
3398 |
proof- |
|
3399 |
have "?S = (\<Union>n\<in>{0..n}. {xs. set xs \<subseteq> A \<and> length xs = n})" by auto |
|
3400 |
thus ?thesis by (auto intro: finite_lists_length_eq[OF `finite A`]) |
|
3401 |
qed |
|
3402 |
||
28642 | 3403 |
lemma infinite_UNIV_listI: "~ finite(UNIV::'a list set)" |
3404 |
apply(rule notI) |
|
3405 |
apply(drule finite_maxlen) |
|
3406 |
apply (metis UNIV_I length_replicate less_not_refl) |
|
3407 |
done |
|
3408 |
||
3409 |
||
24616 | 3410 |
subsection {*Sorting*} |
3411 |
||
24617 | 3412 |
text{* Currently it is not shown that @{const sort} returns a |
3413 |
permutation of its input because the nicest proof is via multisets, |
|
3414 |
which are not yet available. Alternatively one could define a function |
|
3415 |
that counts the number of occurrences of an element in a list and use |
|
3416 |
that instead of multisets to state the correctness property. *} |
|
3417 |
||
24616 | 3418 |
context linorder |
3419 |
begin |
|
3420 |
||
33639
603320b93668
New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents:
33593
diff
changeset
|
3421 |
lemma length_insert[simp] : "length (insort_key f x xs) = Suc (length xs)" |
603320b93668
New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents:
33593
diff
changeset
|
3422 |
by (induct xs, auto) |
603320b93668
New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents:
33593
diff
changeset
|
3423 |
|
603320b93668
New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents:
33593
diff
changeset
|
3424 |
lemma length_sort[simp]: "length (sort_key f xs) = length xs" |
603320b93668
New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents:
33593
diff
changeset
|
3425 |
by (induct xs, auto) |
603320b93668
New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents:
33593
diff
changeset
|
3426 |
|
25062 | 3427 |
lemma sorted_Cons: "sorted (x#xs) = (sorted xs & (ALL y:set xs. x <= y))" |
24616 | 3428 |
apply(induct xs arbitrary: x) apply simp |
3429 |
by simp (blast intro: order_trans) |
|
3430 |
||
3431 |
lemma sorted_append: |
|
25062 | 3432 |
"sorted (xs@ys) = (sorted xs & sorted ys & (\<forall>x \<in> set xs. \<forall>y \<in> set ys. x\<le>y))" |
24616 | 3433 |
by (induct xs) (auto simp add:sorted_Cons) |
3434 |
||
31201 | 3435 |
lemma sorted_nth_mono: |
33639
603320b93668
New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents:
33593
diff
changeset
|
3436 |
"sorted xs \<Longrightarrow> i \<le> j \<Longrightarrow> j < length xs \<Longrightarrow> xs!i \<le> xs!j" |
31201 | 3437 |
by (induct xs arbitrary: i j) (auto simp:nth_Cons' sorted_Cons) |
3438 |
||
33639
603320b93668
New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents:
33593
diff
changeset
|
3439 |
lemma sorted_rev_nth_mono: |
603320b93668
New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents:
33593
diff
changeset
|
3440 |
"sorted (rev xs) \<Longrightarrow> i \<le> j \<Longrightarrow> j < length xs \<Longrightarrow> xs!j \<le> xs!i" |
603320b93668
New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents:
33593
diff
changeset
|
3441 |
using sorted_nth_mono[ of "rev xs" "length xs - j - 1" "length xs - i - 1"] |
603320b93668
New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents:
33593
diff
changeset
|
3442 |
rev_nth[of "length xs - i - 1" "xs"] rev_nth[of "length xs - j - 1" "xs"] |
603320b93668
New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents:
33593
diff
changeset
|
3443 |
by auto |
603320b93668
New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents:
33593
diff
changeset
|
3444 |
|
603320b93668
New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents:
33593
diff
changeset
|
3445 |
lemma sorted_nth_monoI: |
603320b93668
New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents:
33593
diff
changeset
|
3446 |
"(\<And> i j. \<lbrakk> i \<le> j ; j < length xs \<rbrakk> \<Longrightarrow> xs ! i \<le> xs ! j) \<Longrightarrow> sorted xs" |
603320b93668
New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents:
33593
diff
changeset
|
3447 |
proof (induct xs) |
603320b93668
New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents:
33593
diff
changeset
|
3448 |
case (Cons x xs) |
603320b93668
New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents:
33593
diff
changeset
|
3449 |
have "sorted xs" |
603320b93668
New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents:
33593
diff
changeset
|
3450 |
proof (rule Cons.hyps) |
603320b93668
New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents:
33593
diff
changeset
|
3451 |
fix i j assume "i \<le> j" and "j < length xs" |
603320b93668
New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents:
33593
diff
changeset
|
3452 |
with Cons.prems[of "Suc i" "Suc j"] |
603320b93668
New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents:
33593
diff
changeset
|
3453 |
show "xs ! i \<le> xs ! j" by auto |
603320b93668
New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents:
33593
diff
changeset
|
3454 |
qed |
603320b93668
New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents:
33593
diff
changeset
|
3455 |
moreover |
603320b93668
New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents:
33593
diff
changeset
|
3456 |
{ |
603320b93668
New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents:
33593
diff
changeset
|
3457 |
fix y assume "y \<in> set xs" |
603320b93668
New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents:
33593
diff
changeset
|
3458 |
then obtain j where "j < length xs" and "xs ! j = y" |
603320b93668
New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents:
33593
diff
changeset
|
3459 |
unfolding in_set_conv_nth by blast |
603320b93668
New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents:
33593
diff
changeset
|
3460 |
with Cons.prems[of 0 "Suc j"] |
603320b93668
New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents:
33593
diff
changeset
|
3461 |
have "x \<le> y" |
603320b93668
New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents:
33593
diff
changeset
|
3462 |
by auto |
603320b93668
New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents:
33593
diff
changeset
|
3463 |
} |
603320b93668
New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents:
33593
diff
changeset
|
3464 |
ultimately |
603320b93668
New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents:
33593
diff
changeset
|
3465 |
show ?case |
603320b93668
New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents:
33593
diff
changeset
|
3466 |
unfolding sorted_Cons by auto |
603320b93668
New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents:
33593
diff
changeset
|
3467 |
qed simp |
603320b93668
New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents:
33593
diff
changeset
|
3468 |
|
603320b93668
New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents:
33593
diff
changeset
|
3469 |
lemma sorted_equals_nth_mono: |
603320b93668
New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents:
33593
diff
changeset
|
3470 |
"sorted xs = (\<forall>j < length xs. \<forall>i \<le> j. xs ! i \<le> xs ! j)" |
603320b93668
New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents:
33593
diff
changeset
|
3471 |
by (auto intro: sorted_nth_monoI sorted_nth_mono) |
603320b93668
New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents:
33593
diff
changeset
|
3472 |
|
603320b93668
New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents:
33593
diff
changeset
|
3473 |
lemma set_insort: "set(insort_key f x xs) = insert x (set xs)" |
24616 | 3474 |
by (induct xs) auto |
3475 |
||
33639
603320b93668
New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents:
33593
diff
changeset
|
3476 |
lemma set_sort[simp]: "set(sort_key f xs) = set xs" |
24616 | 3477 |
by (induct xs) (simp_all add:set_insort) |
3478 |
||
33639
603320b93668
New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents:
33593
diff
changeset
|
3479 |
lemma distinct_insort: "distinct (insort_key f x xs) = (x \<notin> set xs \<and> distinct xs)" |
24616 | 3480 |
by(induct xs)(auto simp:set_insort) |
3481 |
||
33639
603320b93668
New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents:
33593
diff
changeset
|
3482 |
lemma distinct_sort[simp]: "distinct (sort_key f xs) = distinct xs" |
24616 | 3483 |
by(induct xs)(simp_all add:distinct_insort set_sort) |
3484 |
||
33639
603320b93668
New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents:
33593
diff
changeset
|
3485 |
lemma sorted_insort_key: "sorted (map f (insort_key f x xs)) = sorted (map f xs)" |
603320b93668
New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents:
33593
diff
changeset
|
3486 |
by(induct xs)(auto simp:sorted_Cons set_insort) |
603320b93668
New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents:
33593
diff
changeset
|
3487 |
|
24616 | 3488 |
lemma sorted_insort: "sorted (insort x xs) = sorted xs" |
33639
603320b93668
New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents:
33593
diff
changeset
|
3489 |
using sorted_insort_key[where f="\<lambda>x. x"] by simp |
603320b93668
New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents:
33593
diff
changeset
|
3490 |
|
603320b93668
New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents:
33593
diff
changeset
|
3491 |
theorem sorted_sort_key[simp]: "sorted (map f (sort_key f xs))" |
603320b93668
New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents:
33593
diff
changeset
|
3492 |
by(induct xs)(auto simp:sorted_insort_key) |
24616 | 3493 |
|
3494 |
theorem sorted_sort[simp]: "sorted (sort xs)" |
|
33639
603320b93668
New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents:
33593
diff
changeset
|
3495 |
by(induct xs)(auto simp:sorted_insort) |
603320b93668
New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents:
33593
diff
changeset
|
3496 |
|
603320b93668
New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents:
33593
diff
changeset
|
3497 |
lemma insort_is_Cons: "\<forall>x\<in>set xs. f a \<le> f x \<Longrightarrow> insort_key f a xs = a # xs" |
26143
314c0bcb7df7
Added useful general lemmas from the work with the HeapMonad
bulwahn
parents:
26073
diff
changeset
|
3498 |
by (cases xs) auto |
314c0bcb7df7
Added useful general lemmas from the work with the HeapMonad
bulwahn
parents:
26073
diff
changeset
|
3499 |
|
314c0bcb7df7
Added useful general lemmas from the work with the HeapMonad
bulwahn
parents:
26073
diff
changeset
|
3500 |
lemma sorted_remove1: "sorted xs \<Longrightarrow> sorted (remove1 a xs)" |
33639
603320b93668
New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents:
33593
diff
changeset
|
3501 |
by(induct xs)(auto simp add: sorted_Cons) |
603320b93668
New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents:
33593
diff
changeset
|
3502 |
|
603320b93668
New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents:
33593
diff
changeset
|
3503 |
lemma insort_key_remove1: "\<lbrakk> a \<in> set xs; sorted (map f xs) ; inj_on f (set xs) \<rbrakk> |
603320b93668
New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents:
33593
diff
changeset
|
3504 |
\<Longrightarrow> insort_key f a (remove1 a xs) = xs" |
603320b93668
New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents:
33593
diff
changeset
|
3505 |
proof (induct xs) |
603320b93668
New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents:
33593
diff
changeset
|
3506 |
case (Cons x xs) |
603320b93668
New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents:
33593
diff
changeset
|
3507 |
thus ?case |
603320b93668
New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents:
33593
diff
changeset
|
3508 |
proof (cases "x = a") |
603320b93668
New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents:
33593
diff
changeset
|
3509 |
case False |
603320b93668
New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents:
33593
diff
changeset
|
3510 |
hence "f x \<noteq> f a" using Cons.prems by auto |
603320b93668
New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents:
33593
diff
changeset
|
3511 |
hence "f x < f a" using Cons.prems by (auto simp: sorted_Cons) |
603320b93668
New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents:
33593
diff
changeset
|
3512 |
thus ?thesis using Cons by (auto simp: sorted_Cons insort_is_Cons) |
603320b93668
New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents:
33593
diff
changeset
|
3513 |
qed (auto simp: sorted_Cons insort_is_Cons) |
603320b93668
New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents:
33593
diff
changeset
|
3514 |
qed simp |
26143
314c0bcb7df7
Added useful general lemmas from the work with the HeapMonad
bulwahn
parents:
26073
diff
changeset
|
3515 |
|
314c0bcb7df7
Added useful general lemmas from the work with the HeapMonad
bulwahn
parents:
26073
diff
changeset
|
3516 |
lemma insort_remove1: "\<lbrakk> a \<in> set xs; sorted xs \<rbrakk> \<Longrightarrow> insort a (remove1 a xs) = xs" |
33639
603320b93668
New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents:
33593
diff
changeset
|
3517 |
using insort_key_remove1[where f="\<lambda>x. x"] by simp |
26143
314c0bcb7df7
Added useful general lemmas from the work with the HeapMonad
bulwahn
parents:
26073
diff
changeset
|
3518 |
|
314c0bcb7df7
Added useful general lemmas from the work with the HeapMonad
bulwahn
parents:
26073
diff
changeset
|
3519 |
lemma sorted_remdups[simp]: |
314c0bcb7df7
Added useful general lemmas from the work with the HeapMonad
bulwahn
parents:
26073
diff
changeset
|
3520 |
"sorted l \<Longrightarrow> sorted (remdups l)" |
314c0bcb7df7
Added useful general lemmas from the work with the HeapMonad
bulwahn
parents:
26073
diff
changeset
|
3521 |
by (induct l) (auto simp: sorted_Cons) |
314c0bcb7df7
Added useful general lemmas from the work with the HeapMonad
bulwahn
parents:
26073
diff
changeset
|
3522 |
|
24645 | 3523 |
lemma sorted_distinct_set_unique: |
3524 |
assumes "sorted xs" "distinct xs" "sorted ys" "distinct ys" "set xs = set ys" |
|
3525 |
shows "xs = ys" |
|
3526 |
proof - |
|
26734 | 3527 |
from assms have 1: "length xs = length ys" by (auto dest!: distinct_card) |
24645 | 3528 |
from assms show ?thesis |
3529 |
proof(induct rule:list_induct2[OF 1]) |
|
3530 |
case 1 show ?case by simp |
|
3531 |
next |
|
3532 |
case 2 thus ?case by (simp add:sorted_Cons) |
|
3533 |
(metis Diff_insert_absorb antisym insertE insert_iff) |
|
3534 |
qed |
|
3535 |
qed |
|
3536 |
||
3537 |
lemma finite_sorted_distinct_unique: |
|
3538 |
shows "finite A \<Longrightarrow> EX! xs. set xs = A & sorted xs & distinct xs" |
|
3539 |
apply(drule finite_distinct_list) |
|
3540 |
apply clarify |
|
3541 |
apply(rule_tac a="sort xs" in ex1I) |
|
3542 |
apply (auto simp: sorted_distinct_set_unique) |
|
3543 |
done |
|
3544 |
||
29626 | 3545 |
lemma sorted_take: |
3546 |
"sorted xs \<Longrightarrow> sorted (take n xs)" |
|
3547 |
proof (induct xs arbitrary: n rule: sorted.induct) |
|
3548 |
case 1 show ?case by simp |
|
3549 |
next |
|
3550 |
case 2 show ?case by (cases n) simp_all |
|
3551 |
next |
|
3552 |
case (3 x y xs) |
|
3553 |
then have "x \<le> y" by simp |
|
3554 |
show ?case proof (cases n) |
|
3555 |
case 0 then show ?thesis by simp |
|
3556 |
next |
|
3557 |
case (Suc m) |
|
3558 |
with 3 have "sorted (take m (y # xs))" by simp |
|
3559 |
with Suc `x \<le> y` show ?thesis by (cases m) simp_all |
|
3560 |
qed |
|
3561 |
qed |
|
3562 |
||
3563 |
lemma sorted_drop: |
|
3564 |
"sorted xs \<Longrightarrow> sorted (drop n xs)" |
|
3565 |
proof (induct xs arbitrary: n rule: sorted.induct) |
|
3566 |
case 1 show ?case by simp |
|
3567 |
next |
|
3568 |
case 2 show ?case by (cases n) simp_all |
|
3569 |
next |
|
3570 |
case 3 then show ?case by (cases n) simp_all |
|
3571 |
qed |
|
3572 |
||
33639
603320b93668
New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents:
33593
diff
changeset
|
3573 |
lemma sorted_dropWhile: "sorted xs \<Longrightarrow> sorted (dropWhile P xs)" |
603320b93668
New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents:
33593
diff
changeset
|
3574 |
unfolding dropWhile_eq_drop by (rule sorted_drop) |
603320b93668
New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents:
33593
diff
changeset
|
3575 |
|
603320b93668
New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents:
33593
diff
changeset
|
3576 |
lemma sorted_takeWhile: "sorted xs \<Longrightarrow> sorted (takeWhile P xs)" |
603320b93668
New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents:
33593
diff
changeset
|
3577 |
apply (subst takeWhile_eq_take) by (rule sorted_take) |
29626 | 3578 |
|
34933 | 3579 |
lemma sorted_filter: |
3580 |
"sorted (map f xs) \<Longrightarrow> sorted (map f (filter P xs))" |
|
3581 |
by (induct xs) (simp_all add: sorted_Cons) |
|
3582 |
||
3583 |
lemma foldr_max_sorted: |
|
3584 |
assumes "sorted (rev xs)" |
|
3585 |
shows "foldr max xs y = (if xs = [] then y else max (xs ! 0) y)" |
|
3586 |
using assms proof (induct xs) |
|
3587 |
case (Cons x xs) |
|
3588 |
moreover hence "sorted (rev xs)" using sorted_append by auto |
|
3589 |
ultimately show ?case |
|
3590 |
by (cases xs, auto simp add: sorted_append max_def) |
|
3591 |
qed simp |
|
3592 |
||
3593 |
lemma filter_equals_takeWhile_sorted_rev: |
|
3594 |
assumes sorted: "sorted (rev (map f xs))" |
|
3595 |
shows "[x \<leftarrow> xs. t < f x] = takeWhile (\<lambda> x. t < f x) xs" |
|
3596 |
(is "filter ?P xs = ?tW") |
|
3597 |
proof (rule takeWhile_eq_filter[symmetric]) |
|
3598 |
let "?dW" = "dropWhile ?P xs" |
|
3599 |
fix x assume "x \<in> set ?dW" |
|
3600 |
then obtain i where i: "i < length ?dW" and nth_i: "x = ?dW ! i" |
|
3601 |
unfolding in_set_conv_nth by auto |
|
3602 |
hence "length ?tW + i < length (?tW @ ?dW)" |
|
3603 |
unfolding length_append by simp |
|
3604 |
hence i': "length (map f ?tW) + i < length (map f xs)" by simp |
|
3605 |
have "(map f ?tW @ map f ?dW) ! (length (map f ?tW) + i) \<le> |
|
3606 |
(map f ?tW @ map f ?dW) ! (length (map f ?tW) + 0)" |
|
3607 |
using sorted_rev_nth_mono[OF sorted _ i', of "length ?tW"] |
|
3608 |
unfolding map_append[symmetric] by simp |
|
3609 |
hence "f x \<le> f (?dW ! 0)" |
|
3610 |
unfolding nth_append_length_plus nth_i |
|
3611 |
using i preorder_class.le_less_trans[OF le0 i] by simp |
|
3612 |
also have "... \<le> t" |
|
3613 |
using hd_dropWhile[of "?P" xs] le0[THEN preorder_class.le_less_trans, OF i] |
|
3614 |
using hd_conv_nth[of "?dW"] by simp |
|
3615 |
finally show "\<not> t < f x" by simp |
|
3616 |
qed |
|
3617 |
||
24616 | 3618 |
end |
3619 |
||
25277 | 3620 |
lemma sorted_upt[simp]: "sorted[i..<j]" |
3621 |
by (induct j) (simp_all add:sorted_append) |
|
3622 |
||
32415
1dddf2f64266
got rid of complicated class finite_intvl_succ and defined "upto" directly on int, the only instance of the class.
nipkow
parents:
32078
diff
changeset
|
3623 |
lemma sorted_upto[simp]: "sorted[i..j]" |
1dddf2f64266
got rid of complicated class finite_intvl_succ and defined "upto" directly on int, the only instance of the class.
nipkow
parents:
32078
diff
changeset
|
3624 |
apply(induct i j rule:upto.induct) |
1dddf2f64266
got rid of complicated class finite_intvl_succ and defined "upto" directly on int, the only instance of the class.
nipkow
parents:
32078
diff
changeset
|
3625 |
apply(subst upto.simps) |
1dddf2f64266
got rid of complicated class finite_intvl_succ and defined "upto" directly on int, the only instance of the class.
nipkow
parents:
32078
diff
changeset
|
3626 |
apply(simp add:sorted_Cons) |
1dddf2f64266
got rid of complicated class finite_intvl_succ and defined "upto" directly on int, the only instance of the class.
nipkow
parents:
32078
diff
changeset
|
3627 |
done |
1dddf2f64266
got rid of complicated class finite_intvl_succ and defined "upto" directly on int, the only instance of the class.
nipkow
parents:
32078
diff
changeset
|
3628 |
|
34933 | 3629 |
subsubsection {*@{const transpose} on sorted lists*} |
3630 |
||
3631 |
lemma sorted_transpose[simp]: |
|
3632 |
shows "sorted (rev (map length (transpose xs)))" |
|
3633 |
by (auto simp: sorted_equals_nth_mono rev_nth nth_transpose |
|
3634 |
length_filter_conv_card intro: card_mono) |
|
3635 |
||
3636 |
lemma transpose_max_length: |
|
3637 |
"foldr (\<lambda>xs. max (length xs)) (transpose xs) 0 = length [x \<leftarrow> xs. x \<noteq> []]" |
|
3638 |
(is "?L = ?R") |
|
3639 |
proof (cases "transpose xs = []") |
|
3640 |
case False |
|
3641 |
have "?L = foldr max (map length (transpose xs)) 0" |
|
3642 |
by (simp add: foldr_map comp_def) |
|
3643 |
also have "... = length (transpose xs ! 0)" |
|
3644 |
using False sorted_transpose by (simp add: foldr_max_sorted) |
|
3645 |
finally show ?thesis |
|
3646 |
using False by (simp add: nth_transpose) |
|
3647 |
next |
|
3648 |
case True |
|
3649 |
hence "[x \<leftarrow> xs. x \<noteq> []] = []" |
|
3650 |
by (auto intro!: filter_False simp: transpose_empty) |
|
3651 |
thus ?thesis by (simp add: transpose_empty True) |
|
3652 |
qed |
|
3653 |
||
3654 |
lemma length_transpose_sorted: |
|
3655 |
fixes xs :: "'a list list" |
|
3656 |
assumes sorted: "sorted (rev (map length xs))" |
|
3657 |
shows "length (transpose xs) = (if xs = [] then 0 else length (xs ! 0))" |
|
3658 |
proof (cases "xs = []") |
|
3659 |
case False |
|
3660 |
thus ?thesis |
|
3661 |
using foldr_max_sorted[OF sorted] False |
|
3662 |
unfolding length_transpose foldr_map comp_def |
|
3663 |
by simp |
|
3664 |
qed simp |
|
3665 |
||
3666 |
lemma nth_nth_transpose_sorted[simp]: |
|
3667 |
fixes xs :: "'a list list" |
|
3668 |
assumes sorted: "sorted (rev (map length xs))" |
|
3669 |
and i: "i < length (transpose xs)" |
|
3670 |
and j: "j < length [ys \<leftarrow> xs. i < length ys]" |
|
3671 |
shows "transpose xs ! i ! j = xs ! j ! i" |
|
3672 |
using j filter_equals_takeWhile_sorted_rev[OF sorted, of i] |
|
3673 |
nth_transpose[OF i] nth_map[OF j] |
|
3674 |
by (simp add: takeWhile_nth) |
|
3675 |
||
3676 |
lemma transpose_column_length: |
|
3677 |
fixes xs :: "'a list list" |
|
3678 |
assumes sorted: "sorted (rev (map length xs))" and "i < length xs" |
|
3679 |
shows "length (filter (\<lambda>ys. i < length ys) (transpose xs)) = length (xs ! i)" |
|
3680 |
proof - |
|
3681 |
have "xs \<noteq> []" using `i < length xs` by auto |
|
3682 |
note filter_equals_takeWhile_sorted_rev[OF sorted, simp] |
|
3683 |
{ fix j assume "j \<le> i" |
|
3684 |
note sorted_rev_nth_mono[OF sorted, of j i, simplified, OF this `i < length xs`] |
|
3685 |
} note sortedE = this[consumes 1] |
|
3686 |
||
3687 |
have "{j. j < length (transpose xs) \<and> i < length (transpose xs ! j)} |
|
3688 |
= {..< length (xs ! i)}" |
|
3689 |
proof safe |
|
3690 |
fix j |
|
3691 |
assume "j < length (transpose xs)" and "i < length (transpose xs ! j)" |
|
3692 |
with this(2) nth_transpose[OF this(1)] |
|
3693 |
have "i < length (takeWhile (\<lambda>ys. j < length ys) xs)" by simp |
|
3694 |
from nth_mem[OF this] takeWhile_nth[OF this] |
|
3695 |
show "j < length (xs ! i)" by (auto dest: set_takeWhileD) |
|
3696 |
next |
|
3697 |
fix j assume "j < length (xs ! i)" |
|
3698 |
thus "j < length (transpose xs)" |
|
3699 |
using foldr_max_sorted[OF sorted] `xs \<noteq> []` sortedE[OF le0] |
|
3700 |
by (auto simp: length_transpose comp_def foldr_map) |
|
3701 |
||
3702 |
have "Suc i \<le> length (takeWhile (\<lambda>ys. j < length ys) xs)" |
|
3703 |
using `i < length xs` `j < length (xs ! i)` less_Suc_eq_le |
|
3704 |
by (auto intro!: length_takeWhile_less_P_nth dest!: sortedE) |
|
3705 |
with nth_transpose[OF `j < length (transpose xs)`] |
|
3706 |
show "i < length (transpose xs ! j)" by simp |
|
3707 |
qed |
|
3708 |
thus ?thesis by (simp add: length_filter_conv_card) |
|
3709 |
qed |
|
3710 |
||
3711 |
lemma transpose_column: |
|
3712 |
fixes xs :: "'a list list" |
|
3713 |
assumes sorted: "sorted (rev (map length xs))" and "i < length xs" |
|
3714 |
shows "map (\<lambda>ys. ys ! i) (filter (\<lambda>ys. i < length ys) (transpose xs)) |
|
3715 |
= xs ! i" (is "?R = _") |
|
3716 |
proof (rule nth_equalityI, safe) |
|
3717 |
show length: "length ?R = length (xs ! i)" |
|
3718 |
using transpose_column_length[OF assms] by simp |
|
3719 |
||
3720 |
fix j assume j: "j < length ?R" |
|
3721 |
note * = less_le_trans[OF this, unfolded length_map, OF length_filter_le] |
|
3722 |
from j have j_less: "j < length (xs ! i)" using length by simp |
|
3723 |
have i_less_tW: "Suc i \<le> length (takeWhile (\<lambda>ys. Suc j \<le> length ys) xs)" |
|
3724 |
proof (rule length_takeWhile_less_P_nth) |
|
3725 |
show "Suc i \<le> length xs" using `i < length xs` by simp |
|
3726 |
fix k assume "k < Suc i" |
|
3727 |
hence "k \<le> i" by auto |
|
3728 |
with sorted_rev_nth_mono[OF sorted this] `i < length xs` |
|
3729 |
have "length (xs ! i) \<le> length (xs ! k)" by simp |
|
3730 |
thus "Suc j \<le> length (xs ! k)" using j_less by simp |
|
3731 |
qed |
|
3732 |
have i_less_filter: "i < length [ys\<leftarrow>xs . j < length ys]" |
|
3733 |
unfolding filter_equals_takeWhile_sorted_rev[OF sorted, of j] |
|
3734 |
using i_less_tW by (simp_all add: Suc_le_eq) |
|
3735 |
from j show "?R ! j = xs ! i ! j" |
|
3736 |
unfolding filter_equals_takeWhile_sorted_rev[OF sorted_transpose, of i] |
|
3737 |
by (simp add: takeWhile_nth nth_nth_transpose_sorted[OF sorted * i_less_filter]) |
|
3738 |
qed |
|
3739 |
||
3740 |
lemma transpose_transpose: |
|
3741 |
fixes xs :: "'a list list" |
|
3742 |
assumes sorted: "sorted (rev (map length xs))" |
|
3743 |
shows "transpose (transpose xs) = takeWhile (\<lambda>x. x \<noteq> []) xs" (is "?L = ?R") |
|
3744 |
proof - |
|
3745 |
have len: "length ?L = length ?R" |
|
3746 |
unfolding length_transpose transpose_max_length |
|
3747 |
using filter_equals_takeWhile_sorted_rev[OF sorted, of 0] |
|
3748 |
by simp |
|
3749 |
||
3750 |
{ fix i assume "i < length ?R" |
|
3751 |
with less_le_trans[OF _ length_takeWhile_le[of _ xs]] |
|
3752 |
have "i < length xs" by simp |
|
3753 |
} note * = this |
|
3754 |
show ?thesis |
|
3755 |
by (rule nth_equalityI) |
|
3756 |
(simp_all add: len nth_transpose transpose_column[OF sorted] * takeWhile_nth) |
|
3757 |
qed |
|
24616 | 3758 |
|
34934
440605046777
Added transpose_rectangle, when the input list is rectangular.
hoelzl
parents:
34933
diff
changeset
|
3759 |
theorem transpose_rectangle: |
440605046777
Added transpose_rectangle, when the input list is rectangular.
hoelzl
parents:
34933
diff
changeset
|
3760 |
assumes "xs = [] \<Longrightarrow> n = 0" |
440605046777
Added transpose_rectangle, when the input list is rectangular.
hoelzl
parents:
34933
diff
changeset
|
3761 |
assumes rect: "\<And> i. i < length xs \<Longrightarrow> length (xs ! i) = n" |
440605046777
Added transpose_rectangle, when the input list is rectangular.
hoelzl
parents:
34933
diff
changeset
|
3762 |
shows "transpose xs = map (\<lambda> i. map (\<lambda> j. xs ! j ! i) [0..<length xs]) [0..<n]" |
440605046777
Added transpose_rectangle, when the input list is rectangular.
hoelzl
parents:
34933
diff
changeset
|
3763 |
(is "?trans = ?map") |
440605046777
Added transpose_rectangle, when the input list is rectangular.
hoelzl
parents:
34933
diff
changeset
|
3764 |
proof (rule nth_equalityI) |
440605046777
Added transpose_rectangle, when the input list is rectangular.
hoelzl
parents:
34933
diff
changeset
|
3765 |
have "sorted (rev (map length xs))" |
440605046777
Added transpose_rectangle, when the input list is rectangular.
hoelzl
parents:
34933
diff
changeset
|
3766 |
by (auto simp: rev_nth rect intro!: sorted_nth_monoI) |
440605046777
Added transpose_rectangle, when the input list is rectangular.
hoelzl
parents:
34933
diff
changeset
|
3767 |
from foldr_max_sorted[OF this] assms |
440605046777
Added transpose_rectangle, when the input list is rectangular.
hoelzl
parents:
34933
diff
changeset
|
3768 |
show len: "length ?trans = length ?map" |
440605046777
Added transpose_rectangle, when the input list is rectangular.
hoelzl
parents:
34933
diff
changeset
|
3769 |
by (simp_all add: length_transpose foldr_map comp_def) |
440605046777
Added transpose_rectangle, when the input list is rectangular.
hoelzl
parents:
34933
diff
changeset
|
3770 |
moreover |
440605046777
Added transpose_rectangle, when the input list is rectangular.
hoelzl
parents:
34933
diff
changeset
|
3771 |
{ fix i assume "i < n" hence "[ys\<leftarrow>xs . i < length ys] = xs" |
440605046777
Added transpose_rectangle, when the input list is rectangular.
hoelzl
parents:
34933
diff
changeset
|
3772 |
using rect by (auto simp: in_set_conv_nth intro!: filter_True) } |
440605046777
Added transpose_rectangle, when the input list is rectangular.
hoelzl
parents:
34933
diff
changeset
|
3773 |
ultimately show "\<forall>i < length ?trans. ?trans ! i = ?map ! i" |
440605046777
Added transpose_rectangle, when the input list is rectangular.
hoelzl
parents:
34933
diff
changeset
|
3774 |
by (auto simp: nth_transpose intro: nth_equalityI) |
440605046777
Added transpose_rectangle, when the input list is rectangular.
hoelzl
parents:
34933
diff
changeset
|
3775 |
qed |
24616 | 3776 |
|
25069 | 3777 |
subsubsection {* @{text sorted_list_of_set} *} |
3778 |
||
3779 |
text{* This function maps (finite) linearly ordered sets to sorted |
|
3780 |
lists. Warning: in most cases it is not a good idea to convert from |
|
3781 |
sets to lists but one should convert in the other direction (via |
|
3782 |
@{const set}). *} |
|
3783 |
||
3784 |
||
3785 |
context linorder |
|
3786 |
begin |
|
3787 |
||
3788 |
definition |
|
3789 |
sorted_list_of_set :: "'a set \<Rightarrow> 'a list" where |
|
28562 | 3790 |
[code del]: "sorted_list_of_set A == THE xs. set xs = A & sorted xs & distinct xs" |
25069 | 3791 |
|
3792 |
lemma sorted_list_of_set[simp]: "finite A \<Longrightarrow> |
|
3793 |
set(sorted_list_of_set A) = A & |
|
3794 |
sorted(sorted_list_of_set A) & distinct(sorted_list_of_set A)" |
|
3795 |
apply(simp add:sorted_list_of_set_def) |
|
3796 |
apply(rule the1I2) |
|
3797 |
apply(simp_all add: finite_sorted_distinct_unique) |
|
3798 |
done |
|
3799 |
||
3800 |
lemma sorted_list_of_empty[simp]: "sorted_list_of_set {} = []" |
|
3801 |
unfolding sorted_list_of_set_def |
|
3802 |
apply(subst the_equality[of _ "[]"]) |
|
3803 |
apply simp_all |
|
3804 |
done |
|
3805 |
||
3806 |
end |
|
3807 |
||
15392 | 3808 |
subsubsection {* @{text lists}: the list-forming operator over sets *} |
15302 | 3809 |
|
23740 | 3810 |
inductive_set |
22262 | 3811 |
lists :: "'a set => 'a list set" |
23740 | 3812 |
for A :: "'a set" |
3813 |
where |
|
3814 |
Nil [intro!]: "[]: lists A" |
|
27715 | 3815 |
| Cons [intro!,noatp]: "[| a: A; l: lists A|] ==> a#l : lists A" |
24286
7619080e49f0
ATP blacklisting is now in theory data, attribute noatp
paulson
parents:
24219
diff
changeset
|
3816 |
|
7619080e49f0
ATP blacklisting is now in theory data, attribute noatp
paulson
parents:
24219
diff
changeset
|
3817 |
inductive_cases listsE [elim!,noatp]: "x#l : lists A" |
7619080e49f0
ATP blacklisting is now in theory data, attribute noatp
paulson
parents:
24219
diff
changeset
|
3818 |
inductive_cases listspE [elim!,noatp]: "listsp A (x # l)" |
23740 | 3819 |
|
3820 |
lemma listsp_mono [mono]: "A \<le> B ==> listsp A \<le> listsp B" |
|
34064
eee04bbbae7e
avoid dependency on implicit dest rule predicate1D in proofs
haftmann
parents:
34007
diff
changeset
|
3821 |
by (rule predicate1I, erule listsp.induct, (blast dest: predicate1D)+) |
26795
a27607030a1c
- Explicitely applied predicate1I in a few proofs, because it is no longer
berghofe
parents:
26771
diff
changeset
|
3822 |
|
a27607030a1c
- Explicitely applied predicate1I in a few proofs, because it is no longer
berghofe
parents:
26771
diff
changeset
|
3823 |
lemmas lists_mono = listsp_mono [to_set pred_subset_eq] |
22262 | 3824 |
|
22422
ee19cdb07528
stepping towards uniform lattice theory development in HOL
haftmann
parents:
22262
diff
changeset
|
3825 |
lemma listsp_infI: |
ee19cdb07528
stepping towards uniform lattice theory development in HOL
haftmann
parents:
22262
diff
changeset
|
3826 |
assumes l: "listsp A l" shows "listsp B l ==> listsp (inf A B) l" using l |
24349 | 3827 |
by induct blast+ |
15302 | 3828 |
|
22422
ee19cdb07528
stepping towards uniform lattice theory development in HOL
haftmann
parents:
22262
diff
changeset
|
3829 |
lemmas lists_IntI = listsp_infI [to_set] |
ee19cdb07528
stepping towards uniform lattice theory development in HOL
haftmann
parents:
22262
diff
changeset
|
3830 |
|
ee19cdb07528
stepping towards uniform lattice theory development in HOL
haftmann
parents:
22262
diff
changeset
|
3831 |
lemma listsp_inf_eq [simp]: "listsp (inf A B) = inf (listsp A) (listsp B)" |
ee19cdb07528
stepping towards uniform lattice theory development in HOL
haftmann
parents:
22262
diff
changeset
|
3832 |
proof (rule mono_inf [where f=listsp, THEN order_antisym]) |
22262 | 3833 |
show "mono listsp" by (simp add: mono_def listsp_mono) |
26795
a27607030a1c
- Explicitely applied predicate1I in a few proofs, because it is no longer
berghofe
parents:
26771
diff
changeset
|
3834 |
show "inf (listsp A) (listsp B) \<le> listsp (inf A B)" by (blast intro!: listsp_infI predicate1I) |
14388 | 3835 |
qed |
3836 |
||
22422
ee19cdb07528
stepping towards uniform lattice theory development in HOL
haftmann
parents:
22262
diff
changeset
|
3837 |
lemmas listsp_conj_eq [simp] = listsp_inf_eq [simplified inf_fun_eq inf_bool_eq] |
ee19cdb07528
stepping towards uniform lattice theory development in HOL
haftmann
parents:
22262
diff
changeset
|
3838 |
|
26795
a27607030a1c
- Explicitely applied predicate1I in a few proofs, because it is no longer
berghofe
parents:
26771
diff
changeset
|
3839 |
lemmas lists_Int_eq [simp] = listsp_inf_eq [to_set pred_equals_eq] |
22262 | 3840 |
|
3841 |
lemma append_in_listsp_conv [iff]: |
|
3842 |
"(listsp A (xs @ ys)) = (listsp A xs \<and> listsp A ys)" |
|
15302 | 3843 |
by (induct xs) auto |
3844 |
||
22262 | 3845 |
lemmas append_in_lists_conv [iff] = append_in_listsp_conv [to_set] |
3846 |
||
3847 |
lemma in_listsp_conv_set: "(listsp A xs) = (\<forall>x \<in> set xs. A x)" |
|
3848 |
-- {* eliminate @{text listsp} in favour of @{text set} *} |
|
15302 | 3849 |
by (induct xs) auto |
3850 |
||
22262 | 3851 |
lemmas in_lists_conv_set = in_listsp_conv_set [to_set] |
3852 |
||
24286
7619080e49f0
ATP blacklisting is now in theory data, attribute noatp
paulson
parents:
24219
diff
changeset
|
3853 |
lemma in_listspD [dest!,noatp]: "listsp A xs ==> \<forall>x\<in>set xs. A x" |
22262 | 3854 |
by (rule in_listsp_conv_set [THEN iffD1]) |
3855 |
||
24286
7619080e49f0
ATP blacklisting is now in theory data, attribute noatp
paulson
parents:
24219
diff
changeset
|
3856 |
lemmas in_listsD [dest!,noatp] = in_listspD [to_set] |
7619080e49f0
ATP blacklisting is now in theory data, attribute noatp
paulson
parents:
24219
diff
changeset
|
3857 |
|
7619080e49f0
ATP blacklisting is now in theory data, attribute noatp
paulson
parents:
24219
diff
changeset
|
3858 |
lemma in_listspI [intro!,noatp]: "\<forall>x\<in>set xs. A x ==> listsp A xs" |
22262 | 3859 |
by (rule in_listsp_conv_set [THEN iffD2]) |
3860 |
||
24286
7619080e49f0
ATP blacklisting is now in theory data, attribute noatp
paulson
parents:
24219
diff
changeset
|
3861 |
lemmas in_listsI [intro!,noatp] = in_listspI [to_set] |
15302 | 3862 |
|
3863 |
lemma lists_UNIV [simp]: "lists UNIV = UNIV" |
|
3864 |
by auto |
|
3865 |
||
17086 | 3866 |
|
3867 |
||
3868 |
subsubsection{* Inductive definition for membership *} |
|
3869 |
||
23740 | 3870 |
inductive ListMem :: "'a \<Rightarrow> 'a list \<Rightarrow> bool" |
22262 | 3871 |
where |
3872 |
elem: "ListMem x (x # xs)" |
|
3873 |
| insert: "ListMem x xs \<Longrightarrow> ListMem x (y # xs)" |
|
3874 |
||
3875 |
lemma ListMem_iff: "(ListMem x xs) = (x \<in> set xs)" |
|
17086 | 3876 |
apply (rule iffI) |
3877 |
apply (induct set: ListMem) |
|
3878 |
apply auto |
|
3879 |
apply (induct xs) |
|
3880 |
apply (auto intro: ListMem.intros) |
|
3881 |
done |
|
3882 |
||
3883 |
||
3884 |
||
15392 | 3885 |
subsubsection{*Lists as Cartesian products*} |
15302 | 3886 |
|
3887 |
text{*@{text"set_Cons A Xs"}: the set of lists with head drawn from |
|
3888 |
@{term A} and tail drawn from @{term Xs}.*} |
|
3889 |
||
34941 | 3890 |
definition |
3891 |
set_Cons :: "'a set \<Rightarrow> 'a list set \<Rightarrow> 'a list set" where |
|
3892 |
[code del]: "set_Cons A XS = {z. \<exists>x xs. z = x # xs \<and> x \<in> A \<and> xs \<in> XS}" |
|
15302 | 3893 |
|
17724 | 3894 |
lemma set_Cons_sing_Nil [simp]: "set_Cons A {[]} = (%x. [x])`A" |
15302 | 3895 |
by (auto simp add: set_Cons_def) |
3896 |
||
3897 |
text{*Yields the set of lists, all of the same length as the argument and |
|
3898 |
with elements drawn from the corresponding element of the argument.*} |
|
3899 |
||
3900 |
primrec |
|
34941 | 3901 |
listset :: "'a set list \<Rightarrow> 'a list set" where |
3902 |
"listset [] = {[]}" |
|
3903 |
| "listset (A # As) = set_Cons A (listset As)" |
|
15302 | 3904 |
|
3905 |
||
15656 | 3906 |
subsection{*Relations on Lists*} |
3907 |
||
3908 |
subsubsection {* Length Lexicographic Ordering *} |
|
3909 |
||
3910 |
text{*These orderings preserve well-foundedness: shorter lists |
|
3911 |
precede longer lists. These ordering are not used in dictionaries.*} |
|
34941 | 3912 |
|
3913 |
primrec -- {*The lexicographic ordering for lists of the specified length*} |
|
3914 |
lexn :: "('a \<times> 'a) set \<Rightarrow> nat \<Rightarrow> ('a list \<times> 'a list) set" where |
|
3915 |
"lexn r 0 = {}" |
|
3916 |
| "lexn r (Suc n) = (prod_fun (%(x, xs). x#xs) (%(x, xs). x#xs) ` (r <*lex*> lexn r n)) Int |
|
3917 |
{(xs, ys). length xs = Suc n \<and> length ys = Suc n}" |
|
3918 |
||
3919 |
definition |
|
3920 |
lex :: "('a \<times> 'a) set \<Rightarrow> ('a list \<times> 'a list) set" where |
|
3921 |
[code del]: "lex r = (\<Union>n. lexn r n)" -- {*Holds only between lists of the same length*} |
|
3922 |
||
3923 |
definition |
|
3924 |
lenlex :: "('a \<times> 'a) set => ('a list \<times> 'a list) set" where |
|
3925 |
[code del]: "lenlex r = inv_image (less_than <*lex*> lex r) (\<lambda>xs. (length xs, xs))" |
|
3926 |
-- {*Compares lists by their length and then lexicographically*} |
|
15302 | 3927 |
|
3928 |
lemma wf_lexn: "wf r ==> wf (lexn r n)" |
|
3929 |
apply (induct n, simp, simp) |
|
3930 |
apply(rule wf_subset) |
|
3931 |
prefer 2 apply (rule Int_lower1) |
|
3932 |
apply(rule wf_prod_fun_image) |
|
3933 |
prefer 2 apply (rule inj_onI, auto) |
|
3934 |
done |
|
3935 |
||
3936 |
lemma lexn_length: |
|
24526 | 3937 |
"(xs, ys) : lexn r n ==> length xs = n \<and> length ys = n" |
3938 |
by (induct n arbitrary: xs ys) auto |
|
15302 | 3939 |
|
3940 |
lemma wf_lex [intro!]: "wf r ==> wf (lex r)" |
|
3941 |
apply (unfold lex_def) |
|
3942 |
apply (rule wf_UN) |
|
3943 |
apply (blast intro: wf_lexn, clarify) |
|
3944 |
apply (rename_tac m n) |
|
3945 |
apply (subgoal_tac "m \<noteq> n") |
|
3946 |
prefer 2 apply blast |
|
3947 |
apply (blast dest: lexn_length not_sym) |
|
3948 |
done |
|
3949 |
||
3950 |
lemma lexn_conv: |
|
15656 | 3951 |
"lexn r n = |
3952 |
{(xs,ys). length xs = n \<and> length ys = n \<and> |
|
3953 |
(\<exists>xys x y xs' ys'. xs= xys @ x#xs' \<and> ys= xys @ y # ys' \<and> (x, y):r)}" |
|
18423 | 3954 |
apply (induct n, simp) |
15302 | 3955 |
apply (simp add: image_Collect lex_prod_def, safe, blast) |
3956 |
apply (rule_tac x = "ab # xys" in exI, simp) |
|
3957 |
apply (case_tac xys, simp_all, blast) |
|
3958 |
done |
|
3959 |
||
3960 |
lemma lex_conv: |
|
15656 | 3961 |
"lex r = |
3962 |
{(xs,ys). length xs = length ys \<and> |
|
3963 |
(\<exists>xys x y xs' ys'. xs = xys @ x # xs' \<and> ys = xys @ y # ys' \<and> (x, y):r)}" |
|
15302 | 3964 |
by (force simp add: lex_def lexn_conv) |
3965 |
||
15693 | 3966 |
lemma wf_lenlex [intro!]: "wf r ==> wf (lenlex r)" |
3967 |
by (unfold lenlex_def) blast |
|
3968 |
||
3969 |
lemma lenlex_conv: |
|
3970 |
"lenlex r = {(xs,ys). length xs < length ys | |
|
15656 | 3971 |
length xs = length ys \<and> (xs, ys) : lex r}" |
30198 | 3972 |
by (simp add: lenlex_def Id_on_def lex_prod_def inv_image_def) |
15302 | 3973 |
|
3974 |
lemma Nil_notin_lex [iff]: "([], ys) \<notin> lex r" |
|
3975 |
by (simp add: lex_conv) |
|
3976 |
||
3977 |
lemma Nil2_notin_lex [iff]: "(xs, []) \<notin> lex r" |
|
3978 |
by (simp add:lex_conv) |
|
3979 |
||
18447 | 3980 |
lemma Cons_in_lex [simp]: |
15656 | 3981 |
"((x # xs, y # ys) : lex r) = |
3982 |
((x, y) : r \<and> length xs = length ys | x = y \<and> (xs, ys) : lex r)" |
|
15302 | 3983 |
apply (simp add: lex_conv) |
3984 |
apply (rule iffI) |
|
3985 |
prefer 2 apply (blast intro: Cons_eq_appendI, clarify) |
|
3986 |
apply (case_tac xys, simp, simp) |
|
3987 |
apply blast |
|
3988 |
done |
|
3989 |
||
3990 |
||
15656 | 3991 |
subsubsection {* Lexicographic Ordering *} |
3992 |
||
3993 |
text {* Classical lexicographic ordering on lists, ie. "a" < "ab" < "b". |
|
3994 |
This ordering does \emph{not} preserve well-foundedness. |
|
17090 | 3995 |
Author: N. Voelker, March 2005. *} |
15656 | 3996 |
|
34941 | 3997 |
definition |
3998 |
lexord :: "('a \<times> 'a) set \<Rightarrow> ('a list \<times> 'a list) set" where |
|
3999 |
[code del]: "lexord r = {(x,y ). \<exists> a v. y = x @ a # v \<or> |
|
15656 | 4000 |
(\<exists> u a b v w. (a,b) \<in> r \<and> x = u @ (a # v) \<and> y = u @ (b # w))}" |
4001 |
||
4002 |
lemma lexord_Nil_left[simp]: "([],y) \<in> lexord r = (\<exists> a x. y = a # x)" |
|
24349 | 4003 |
by (unfold lexord_def, induct_tac y, auto) |
15656 | 4004 |
|
4005 |
lemma lexord_Nil_right[simp]: "(x,[]) \<notin> lexord r" |
|
24349 | 4006 |
by (unfold lexord_def, induct_tac x, auto) |
15656 | 4007 |
|
4008 |
lemma lexord_cons_cons[simp]: |
|
4009 |
"((a # x, b # y) \<in> lexord r) = ((a,b)\<in> r | (a = b & (x,y)\<in> lexord r))" |
|
4010 |
apply (unfold lexord_def, safe, simp_all) |
|
4011 |
apply (case_tac u, simp, simp) |
|
4012 |
apply (case_tac u, simp, clarsimp, blast, blast, clarsimp) |
|
4013 |
apply (erule_tac x="b # u" in allE) |
|
4014 |
by force |
|
4015 |
||
4016 |
lemmas lexord_simps = lexord_Nil_left lexord_Nil_right lexord_cons_cons |
|
4017 |
||
4018 |
lemma lexord_append_rightI: "\<exists> b z. y = b # z \<Longrightarrow> (x, x @ y) \<in> lexord r" |
|
24349 | 4019 |
by (induct_tac x, auto) |
15656 | 4020 |
|
4021 |
lemma lexord_append_left_rightI: |
|
4022 |
"(a,b) \<in> r \<Longrightarrow> (u @ a # x, u @ b # y) \<in> lexord r" |
|
24349 | 4023 |
by (induct_tac u, auto) |
15656 | 4024 |
|
4025 |
lemma lexord_append_leftI: " (u,v) \<in> lexord r \<Longrightarrow> (x @ u, x @ v) \<in> lexord r" |
|
24349 | 4026 |
by (induct x, auto) |
15656 | 4027 |
|
4028 |
lemma lexord_append_leftD: |
|
4029 |
"\<lbrakk> (x @ u, x @ v) \<in> lexord r; (! a. (a,a) \<notin> r) \<rbrakk> \<Longrightarrow> (u,v) \<in> lexord r" |
|
24349 | 4030 |
by (erule rev_mp, induct_tac x, auto) |
15656 | 4031 |
|
4032 |
lemma lexord_take_index_conv: |
|
4033 |
"((x,y) : lexord r) = |
|
4034 |
((length x < length y \<and> take (length x) y = x) \<or> |
|
4035 |
(\<exists>i. i < min(length x)(length y) & take i x = take i y & (x!i,y!i) \<in> r))" |
|
4036 |
apply (unfold lexord_def Let_def, clarsimp) |
|
4037 |
apply (rule_tac f = "(% a b. a \<or> b)" in arg_cong2) |
|
4038 |
apply auto |
|
4039 |
apply (rule_tac x="hd (drop (length x) y)" in exI) |
|
4040 |
apply (rule_tac x="tl (drop (length x) y)" in exI) |
|
4041 |
apply (erule subst, simp add: min_def) |
|
4042 |
apply (rule_tac x ="length u" in exI, simp) |
|
4043 |
apply (rule_tac x ="take i x" in exI) |
|
4044 |
apply (rule_tac x ="x ! i" in exI) |
|
4045 |
apply (rule_tac x ="y ! i" in exI, safe) |
|
4046 |
apply (rule_tac x="drop (Suc i) x" in exI) |
|
4047 |
apply (drule sym, simp add: drop_Suc_conv_tl) |
|
4048 |
apply (rule_tac x="drop (Suc i) y" in exI) |
|
4049 |
by (simp add: drop_Suc_conv_tl) |
|
4050 |
||
4051 |
-- {* lexord is extension of partial ordering List.lex *} |
|
4052 |
lemma lexord_lex: " (x,y) \<in> lex r = ((x,y) \<in> lexord r \<and> length x = length y)" |
|
4053 |
apply (rule_tac x = y in spec) |
|
4054 |
apply (induct_tac x, clarsimp) |
|
4055 |
by (clarify, case_tac x, simp, force) |
|
4056 |
||
4057 |
lemma lexord_irreflexive: "(! x. (x,x) \<notin> r) \<Longrightarrow> (y,y) \<notin> lexord r" |
|
4058 |
by (induct y, auto) |
|
4059 |
||
4060 |
lemma lexord_trans: |
|
4061 |
"\<lbrakk> (x, y) \<in> lexord r; (y, z) \<in> lexord r; trans r \<rbrakk> \<Longrightarrow> (x, z) \<in> lexord r" |
|
4062 |
apply (erule rev_mp)+ |
|
4063 |
apply (rule_tac x = x in spec) |
|
4064 |
apply (rule_tac x = z in spec) |
|
4065 |
apply ( induct_tac y, simp, clarify) |
|
4066 |
apply (case_tac xa, erule ssubst) |
|
4067 |
apply (erule allE, erule allE) -- {* avoid simp recursion *} |
|
4068 |
apply (case_tac x, simp, simp) |
|
24632 | 4069 |
apply (case_tac x, erule allE, erule allE, simp) |
15656 | 4070 |
apply (erule_tac x = listb in allE) |
4071 |
apply (erule_tac x = lista in allE, simp) |
|
4072 |
apply (unfold trans_def) |
|
4073 |
by blast |
|
4074 |
||
4075 |
lemma lexord_transI: "trans r \<Longrightarrow> trans (lexord r)" |
|
24349 | 4076 |
by (rule transI, drule lexord_trans, blast) |
15656 | 4077 |
|
4078 |
lemma lexord_linear: "(! a b. (a,b)\<in> r | a = b | (b,a) \<in> r) \<Longrightarrow> (x,y) : lexord r | x = y | (y,x) : lexord r" |
|
4079 |
apply (rule_tac x = y in spec) |
|
4080 |
apply (induct_tac x, rule allI) |
|
4081 |
apply (case_tac x, simp, simp) |
|
4082 |
apply (rule allI, case_tac x, simp, simp) |
|
4083 |
by blast |
|
4084 |
||
4085 |
||
21103
367b4ad7c7cc
Added "measures" combinator for lexicographic combinations of multiple measures.
krauss
parents:
21079
diff
changeset
|
4086 |
subsection {* Lexicographic combination of measure functions *} |
367b4ad7c7cc
Added "measures" combinator for lexicographic combinations of multiple measures.
krauss
parents:
21079
diff
changeset
|
4087 |
|
367b4ad7c7cc
Added "measures" combinator for lexicographic combinations of multiple measures.
krauss
parents:
21079
diff
changeset
|
4088 |
text {* These are useful for termination proofs *} |
367b4ad7c7cc
Added "measures" combinator for lexicographic combinations of multiple measures.
krauss
parents:
21079
diff
changeset
|
4089 |
|
367b4ad7c7cc
Added "measures" combinator for lexicographic combinations of multiple measures.
krauss
parents:
21079
diff
changeset
|
4090 |
definition |
367b4ad7c7cc
Added "measures" combinator for lexicographic combinations of multiple measures.
krauss
parents:
21079
diff
changeset
|
4091 |
"measures fs = inv_image (lex less_than) (%a. map (%f. f a) fs)" |
367b4ad7c7cc
Added "measures" combinator for lexicographic combinations of multiple measures.
krauss
parents:
21079
diff
changeset
|
4092 |
|
21106
51599a81b308
Added "recdef_wf" and "simp" attribute to "wf_measures"
krauss
parents:
21103
diff
changeset
|
4093 |
lemma wf_measures[recdef_wf, simp]: "wf (measures fs)" |
24349 | 4094 |
unfolding measures_def |
4095 |
by blast |
|
21103
367b4ad7c7cc
Added "measures" combinator for lexicographic combinations of multiple measures.
krauss
parents:
21079
diff
changeset
|
4096 |
|
367b4ad7c7cc
Added "measures" combinator for lexicographic combinations of multiple measures.
krauss
parents:
21079
diff
changeset
|
4097 |
lemma in_measures[simp]: |
367b4ad7c7cc
Added "measures" combinator for lexicographic combinations of multiple measures.
krauss
parents:
21079
diff
changeset
|
4098 |
"(x, y) \<in> measures [] = False" |
367b4ad7c7cc
Added "measures" combinator for lexicographic combinations of multiple measures.
krauss
parents:
21079
diff
changeset
|
4099 |
"(x, y) \<in> measures (f # fs) |
367b4ad7c7cc
Added "measures" combinator for lexicographic combinations of multiple measures.
krauss
parents:
21079
diff
changeset
|
4100 |
= (f x < f y \<or> (f x = f y \<and> (x, y) \<in> measures fs))" |
24349 | 4101 |
unfolding measures_def |
4102 |
by auto |
|
21103
367b4ad7c7cc
Added "measures" combinator for lexicographic combinations of multiple measures.
krauss
parents:
21079
diff
changeset
|
4103 |
|
367b4ad7c7cc
Added "measures" combinator for lexicographic combinations of multiple measures.
krauss
parents:
21079
diff
changeset
|
4104 |
lemma measures_less: "f x < f y ==> (x, y) \<in> measures (f#fs)" |
24349 | 4105 |
by simp |
21103
367b4ad7c7cc
Added "measures" combinator for lexicographic combinations of multiple measures.
krauss
parents:
21079
diff
changeset
|
4106 |
|
367b4ad7c7cc
Added "measures" combinator for lexicographic combinations of multiple measures.
krauss
parents:
21079
diff
changeset
|
4107 |
lemma measures_lesseq: "f x <= f y ==> (x, y) \<in> measures fs ==> (x, y) \<in> measures (f#fs)" |
24349 | 4108 |
by auto |
21103
367b4ad7c7cc
Added "measures" combinator for lexicographic combinations of multiple measures.
krauss
parents:
21079
diff
changeset
|
4109 |
|
367b4ad7c7cc
Added "measures" combinator for lexicographic combinations of multiple measures.
krauss
parents:
21079
diff
changeset
|
4110 |
|
15392 | 4111 |
subsubsection{*Lifting a Relation on List Elements to the Lists*} |
15302 | 4112 |
|
23740 | 4113 |
inductive_set |
4114 |
listrel :: "('a * 'a)set => ('a list * 'a list)set" |
|
4115 |
for r :: "('a * 'a)set" |
|
22262 | 4116 |
where |
23740 | 4117 |
Nil: "([],[]) \<in> listrel r" |
4118 |
| Cons: "[| (x,y) \<in> r; (xs,ys) \<in> listrel r |] ==> (x#xs, y#ys) \<in> listrel r" |
|
4119 |
||
4120 |
inductive_cases listrel_Nil1 [elim!]: "([],xs) \<in> listrel r" |
|
4121 |
inductive_cases listrel_Nil2 [elim!]: "(xs,[]) \<in> listrel r" |
|
4122 |
inductive_cases listrel_Cons1 [elim!]: "(y#ys,xs) \<in> listrel r" |
|
4123 |
inductive_cases listrel_Cons2 [elim!]: "(xs,y#ys) \<in> listrel r" |
|
15302 | 4124 |
|
4125 |
||
4126 |
lemma listrel_mono: "r \<subseteq> s \<Longrightarrow> listrel r \<subseteq> listrel s" |
|
4127 |
apply clarify |
|
23740 | 4128 |
apply (erule listrel.induct) |
4129 |
apply (blast intro: listrel.intros)+ |
|
15302 | 4130 |
done |
4131 |
||
4132 |
lemma listrel_subset: "r \<subseteq> A \<times> A \<Longrightarrow> listrel r \<subseteq> lists A \<times> lists A" |
|
4133 |
apply clarify |
|
23740 | 4134 |
apply (erule listrel.induct, auto) |
15302 | 4135 |
done |
4136 |
||
30198 | 4137 |
lemma listrel_refl_on: "refl_on A r \<Longrightarrow> refl_on (lists A) (listrel r)" |
4138 |
apply (simp add: refl_on_def listrel_subset Ball_def) |
|
15302 | 4139 |
apply (rule allI) |
4140 |
apply (induct_tac x) |
|
23740 | 4141 |
apply (auto intro: listrel.intros) |
15302 | 4142 |
done |
4143 |
||
4144 |
lemma listrel_sym: "sym r \<Longrightarrow> sym (listrel r)" |
|
4145 |
apply (auto simp add: sym_def) |
|
23740 | 4146 |
apply (erule listrel.induct) |
4147 |
apply (blast intro: listrel.intros)+ |
|
15302 | 4148 |
done |
4149 |
||
4150 |
lemma listrel_trans: "trans r \<Longrightarrow> trans (listrel r)" |
|
4151 |
apply (simp add: trans_def) |
|
4152 |
apply (intro allI) |
|
4153 |
apply (rule impI) |
|
23740 | 4154 |
apply (erule listrel.induct) |
4155 |
apply (blast intro: listrel.intros)+ |
|
15302 | 4156 |
done |
4157 |
||
4158 |
theorem equiv_listrel: "equiv A r \<Longrightarrow> equiv (lists A) (listrel r)" |
|
30198 | 4159 |
by (simp add: equiv_def listrel_refl_on listrel_sym listrel_trans) |
15302 | 4160 |
|
4161 |
lemma listrel_Nil [simp]: "listrel r `` {[]} = {[]}" |
|
23740 | 4162 |
by (blast intro: listrel.intros) |
15302 | 4163 |
|
4164 |
lemma listrel_Cons: |
|
33318
ddd97d9dfbfb
moved Nat_Transfer before Divides; distributed Nat_Transfer setup accordingly
haftmann
parents:
32960
diff
changeset
|
4165 |
"listrel r `` {x#xs} = set_Cons (r``{x}) (listrel r `` {xs})" |
ddd97d9dfbfb
moved Nat_Transfer before Divides; distributed Nat_Transfer setup accordingly
haftmann
parents:
32960
diff
changeset
|
4166 |
by (auto simp add: set_Cons_def intro: listrel.intros) |
15302 | 4167 |
|
4168 |
||
26749
397a1aeede7d
* New attribute "termination_simp": Simp rules for termination proofs
krauss
parents:
26734
diff
changeset
|
4169 |
subsection {* Size function *} |
397a1aeede7d
* New attribute "termination_simp": Simp rules for termination proofs
krauss
parents:
26734
diff
changeset
|
4170 |
|
26875
e18574413bc4
Measure functions can now be declared via special rules, allowing for a
krauss
parents:
26795
diff
changeset
|
4171 |
lemma [measure_function]: "is_measure f \<Longrightarrow> is_measure (list_size f)" |
e18574413bc4
Measure functions can now be declared via special rules, allowing for a
krauss
parents:
26795
diff
changeset
|
4172 |
by (rule is_measure_trivial) |
e18574413bc4
Measure functions can now be declared via special rules, allowing for a
krauss
parents:
26795
diff
changeset
|
4173 |
|
e18574413bc4
Measure functions can now be declared via special rules, allowing for a
krauss
parents:
26795
diff
changeset
|
4174 |
lemma [measure_function]: "is_measure f \<Longrightarrow> is_measure (option_size f)" |
e18574413bc4
Measure functions can now be declared via special rules, allowing for a
krauss
parents:
26795
diff
changeset
|
4175 |
by (rule is_measure_trivial) |
e18574413bc4
Measure functions can now be declared via special rules, allowing for a
krauss
parents:
26795
diff
changeset
|
4176 |
|
e18574413bc4
Measure functions can now be declared via special rules, allowing for a
krauss
parents:
26795
diff
changeset
|
4177 |
lemma list_size_estimation[termination_simp]: |
e18574413bc4
Measure functions can now be declared via special rules, allowing for a
krauss
parents:
26795
diff
changeset
|
4178 |
"x \<in> set xs \<Longrightarrow> y < f x \<Longrightarrow> y < list_size f xs" |
26749
397a1aeede7d
* New attribute "termination_simp": Simp rules for termination proofs
krauss
parents:
26734
diff
changeset
|
4179 |
by (induct xs) auto |
397a1aeede7d
* New attribute "termination_simp": Simp rules for termination proofs
krauss
parents:
26734
diff
changeset
|
4180 |
|
26875
e18574413bc4
Measure functions can now be declared via special rules, allowing for a
krauss
parents:
26795
diff
changeset
|
4181 |
lemma list_size_estimation'[termination_simp]: |
e18574413bc4
Measure functions can now be declared via special rules, allowing for a
krauss
parents:
26795
diff
changeset
|
4182 |
"x \<in> set xs \<Longrightarrow> y \<le> f x \<Longrightarrow> y \<le> list_size f xs" |
e18574413bc4
Measure functions can now be declared via special rules, allowing for a
krauss
parents:
26795
diff
changeset
|
4183 |
by (induct xs) auto |
e18574413bc4
Measure functions can now be declared via special rules, allowing for a
krauss
parents:
26795
diff
changeset
|
4184 |
|
e18574413bc4
Measure functions can now be declared via special rules, allowing for a
krauss
parents:
26795
diff
changeset
|
4185 |
lemma list_size_map[simp]: "list_size f (map g xs) = list_size (f o g) xs" |
e18574413bc4
Measure functions can now be declared via special rules, allowing for a
krauss
parents:
26795
diff
changeset
|
4186 |
by (induct xs) auto |
e18574413bc4
Measure functions can now be declared via special rules, allowing for a
krauss
parents:
26795
diff
changeset
|
4187 |
|
e18574413bc4
Measure functions can now be declared via special rules, allowing for a
krauss
parents:
26795
diff
changeset
|
4188 |
lemma list_size_pointwise[termination_simp]: |
e18574413bc4
Measure functions can now be declared via special rules, allowing for a
krauss
parents:
26795
diff
changeset
|
4189 |
"(\<And>x. x \<in> set xs \<Longrightarrow> f x < g x) \<Longrightarrow> list_size f xs \<le> list_size g xs" |
e18574413bc4
Measure functions can now be declared via special rules, allowing for a
krauss
parents:
26795
diff
changeset
|
4190 |
by (induct xs) force+ |
26749
397a1aeede7d
* New attribute "termination_simp": Simp rules for termination proofs
krauss
parents:
26734
diff
changeset
|
4191 |
|
31048
ac146fc38b51
refined HOL string theories and corresponding ML fragments
haftmann
parents:
31022
diff
changeset
|
4192 |
|
33318
ddd97d9dfbfb
moved Nat_Transfer before Divides; distributed Nat_Transfer setup accordingly
haftmann
parents:
32960
diff
changeset
|
4193 |
subsection {* Transfer *} |
ddd97d9dfbfb
moved Nat_Transfer before Divides; distributed Nat_Transfer setup accordingly
haftmann
parents:
32960
diff
changeset
|
4194 |
|
ddd97d9dfbfb
moved Nat_Transfer before Divides; distributed Nat_Transfer setup accordingly
haftmann
parents:
32960
diff
changeset
|
4195 |
definition |
ddd97d9dfbfb
moved Nat_Transfer before Divides; distributed Nat_Transfer setup accordingly
haftmann
parents:
32960
diff
changeset
|
4196 |
embed_list :: "nat list \<Rightarrow> int list" |
ddd97d9dfbfb
moved Nat_Transfer before Divides; distributed Nat_Transfer setup accordingly
haftmann
parents:
32960
diff
changeset
|
4197 |
where |
ddd97d9dfbfb
moved Nat_Transfer before Divides; distributed Nat_Transfer setup accordingly
haftmann
parents:
32960
diff
changeset
|
4198 |
"embed_list l = map int l" |
ddd97d9dfbfb
moved Nat_Transfer before Divides; distributed Nat_Transfer setup accordingly
haftmann
parents:
32960
diff
changeset
|
4199 |
|
ddd97d9dfbfb
moved Nat_Transfer before Divides; distributed Nat_Transfer setup accordingly
haftmann
parents:
32960
diff
changeset
|
4200 |
definition |
ddd97d9dfbfb
moved Nat_Transfer before Divides; distributed Nat_Transfer setup accordingly
haftmann
parents:
32960
diff
changeset
|
4201 |
nat_list :: "int list \<Rightarrow> bool" |
ddd97d9dfbfb
moved Nat_Transfer before Divides; distributed Nat_Transfer setup accordingly
haftmann
parents:
32960
diff
changeset
|
4202 |
where |
ddd97d9dfbfb
moved Nat_Transfer before Divides; distributed Nat_Transfer setup accordingly
haftmann
parents:
32960
diff
changeset
|
4203 |
"nat_list l = nat_set (set l)" |
ddd97d9dfbfb
moved Nat_Transfer before Divides; distributed Nat_Transfer setup accordingly
haftmann
parents:
32960
diff
changeset
|
4204 |
|
ddd97d9dfbfb
moved Nat_Transfer before Divides; distributed Nat_Transfer setup accordingly
haftmann
parents:
32960
diff
changeset
|
4205 |
definition |
ddd97d9dfbfb
moved Nat_Transfer before Divides; distributed Nat_Transfer setup accordingly
haftmann
parents:
32960
diff
changeset
|
4206 |
return_list :: "int list \<Rightarrow> nat list" |
ddd97d9dfbfb
moved Nat_Transfer before Divides; distributed Nat_Transfer setup accordingly
haftmann
parents:
32960
diff
changeset
|
4207 |
where |
ddd97d9dfbfb
moved Nat_Transfer before Divides; distributed Nat_Transfer setup accordingly
haftmann
parents:
32960
diff
changeset
|
4208 |
"return_list l = map nat l" |
ddd97d9dfbfb
moved Nat_Transfer before Divides; distributed Nat_Transfer setup accordingly
haftmann
parents:
32960
diff
changeset
|
4209 |
|
ddd97d9dfbfb
moved Nat_Transfer before Divides; distributed Nat_Transfer setup accordingly
haftmann
parents:
32960
diff
changeset
|
4210 |
lemma transfer_nat_int_list_return_embed: "nat_list l \<longrightarrow> |
ddd97d9dfbfb
moved Nat_Transfer before Divides; distributed Nat_Transfer setup accordingly
haftmann
parents:
32960
diff
changeset
|
4211 |
embed_list (return_list l) = l" |
ddd97d9dfbfb
moved Nat_Transfer before Divides; distributed Nat_Transfer setup accordingly
haftmann
parents:
32960
diff
changeset
|
4212 |
unfolding embed_list_def return_list_def nat_list_def nat_set_def |
ddd97d9dfbfb
moved Nat_Transfer before Divides; distributed Nat_Transfer setup accordingly
haftmann
parents:
32960
diff
changeset
|
4213 |
apply (induct l) |
ddd97d9dfbfb
moved Nat_Transfer before Divides; distributed Nat_Transfer setup accordingly
haftmann
parents:
32960
diff
changeset
|
4214 |
apply auto |
ddd97d9dfbfb
moved Nat_Transfer before Divides; distributed Nat_Transfer setup accordingly
haftmann
parents:
32960
diff
changeset
|
4215 |
done |
ddd97d9dfbfb
moved Nat_Transfer before Divides; distributed Nat_Transfer setup accordingly
haftmann
parents:
32960
diff
changeset
|
4216 |
|
ddd97d9dfbfb
moved Nat_Transfer before Divides; distributed Nat_Transfer setup accordingly
haftmann
parents:
32960
diff
changeset
|
4217 |
lemma transfer_nat_int_list_functions: |
ddd97d9dfbfb
moved Nat_Transfer before Divides; distributed Nat_Transfer setup accordingly
haftmann
parents:
32960
diff
changeset
|
4218 |
"l @ m = return_list (embed_list l @ embed_list m)" |
ddd97d9dfbfb
moved Nat_Transfer before Divides; distributed Nat_Transfer setup accordingly
haftmann
parents:
32960
diff
changeset
|
4219 |
"[] = return_list []" |
ddd97d9dfbfb
moved Nat_Transfer before Divides; distributed Nat_Transfer setup accordingly
haftmann
parents:
32960
diff
changeset
|
4220 |
unfolding return_list_def embed_list_def |
ddd97d9dfbfb
moved Nat_Transfer before Divides; distributed Nat_Transfer setup accordingly
haftmann
parents:
32960
diff
changeset
|
4221 |
apply auto |
ddd97d9dfbfb
moved Nat_Transfer before Divides; distributed Nat_Transfer setup accordingly
haftmann
parents:
32960
diff
changeset
|
4222 |
apply (induct l, auto) |
ddd97d9dfbfb
moved Nat_Transfer before Divides; distributed Nat_Transfer setup accordingly
haftmann
parents:
32960
diff
changeset
|
4223 |
apply (induct m, auto) |
ddd97d9dfbfb
moved Nat_Transfer before Divides; distributed Nat_Transfer setup accordingly
haftmann
parents:
32960
diff
changeset
|
4224 |
done |
ddd97d9dfbfb
moved Nat_Transfer before Divides; distributed Nat_Transfer setup accordingly
haftmann
parents:
32960
diff
changeset
|
4225 |
|
ddd97d9dfbfb
moved Nat_Transfer before Divides; distributed Nat_Transfer setup accordingly
haftmann
parents:
32960
diff
changeset
|
4226 |
(* |
ddd97d9dfbfb
moved Nat_Transfer before Divides; distributed Nat_Transfer setup accordingly
haftmann
parents:
32960
diff
changeset
|
4227 |
lemma transfer_nat_int_fold1: "fold f l x = |
ddd97d9dfbfb
moved Nat_Transfer before Divides; distributed Nat_Transfer setup accordingly
haftmann
parents:
32960
diff
changeset
|
4228 |
fold (%x. f (nat x)) (embed_list l) x"; |
ddd97d9dfbfb
moved Nat_Transfer before Divides; distributed Nat_Transfer setup accordingly
haftmann
parents:
32960
diff
changeset
|
4229 |
*) |
ddd97d9dfbfb
moved Nat_Transfer before Divides; distributed Nat_Transfer setup accordingly
haftmann
parents:
32960
diff
changeset
|
4230 |
|
ddd97d9dfbfb
moved Nat_Transfer before Divides; distributed Nat_Transfer setup accordingly
haftmann
parents:
32960
diff
changeset
|
4231 |
|
21061
580dfc999ef6
added normal post setup; cleaned up "execution" constants
haftmann
parents:
21046
diff
changeset
|
4232 |
subsection {* Code generator *} |
580dfc999ef6
added normal post setup; cleaned up "execution" constants
haftmann
parents:
21046
diff
changeset
|
4233 |
|
580dfc999ef6
added normal post setup; cleaned up "execution" constants
haftmann
parents:
21046
diff
changeset
|
4234 |
subsubsection {* Setup *} |
15064
4f3102b50197
- Moved code generator setup for lists from Main.thy to List.thy
berghofe
parents:
15045
diff
changeset
|
4235 |
|
31055
2cf6efca6c71
proper structures for list and string code generation stuff
haftmann
parents:
31048
diff
changeset
|
4236 |
use "Tools/list_code.ML" |
2cf6efca6c71
proper structures for list and string code generation stuff
haftmann
parents:
31048
diff
changeset
|
4237 |
|
31048
ac146fc38b51
refined HOL string theories and corresponding ML fragments
haftmann
parents:
31022
diff
changeset
|
4238 |
code_type list |
ac146fc38b51
refined HOL string theories and corresponding ML fragments
haftmann
parents:
31022
diff
changeset
|
4239 |
(SML "_ list") |
ac146fc38b51
refined HOL string theories and corresponding ML fragments
haftmann
parents:
31022
diff
changeset
|
4240 |
(OCaml "_ list") |
34886 | 4241 |
(Haskell "![(_)]") |
4242 |
(Scala "List[(_)]") |
|
31048
ac146fc38b51
refined HOL string theories and corresponding ML fragments
haftmann
parents:
31022
diff
changeset
|
4243 |
|
ac146fc38b51
refined HOL string theories and corresponding ML fragments
haftmann
parents:
31022
diff
changeset
|
4244 |
code_const Nil |
ac146fc38b51
refined HOL string theories and corresponding ML fragments
haftmann
parents:
31022
diff
changeset
|
4245 |
(SML "[]") |
ac146fc38b51
refined HOL string theories and corresponding ML fragments
haftmann
parents:
31022
diff
changeset
|
4246 |
(OCaml "[]") |
ac146fc38b51
refined HOL string theories and corresponding ML fragments
haftmann
parents:
31022
diff
changeset
|
4247 |
(Haskell "[]") |
34886 | 4248 |
(Scala "Nil") |
31048
ac146fc38b51
refined HOL string theories and corresponding ML fragments
haftmann
parents:
31022
diff
changeset
|
4249 |
|
ac146fc38b51
refined HOL string theories and corresponding ML fragments
haftmann
parents:
31022
diff
changeset
|
4250 |
code_instance list :: eq |
ac146fc38b51
refined HOL string theories and corresponding ML fragments
haftmann
parents:
31022
diff
changeset
|
4251 |
(Haskell -) |
ac146fc38b51
refined HOL string theories and corresponding ML fragments
haftmann
parents:
31022
diff
changeset
|
4252 |
|
ac146fc38b51
refined HOL string theories and corresponding ML fragments
haftmann
parents:
31022
diff
changeset
|
4253 |
code_const "eq_class.eq \<Colon> 'a\<Colon>eq list \<Rightarrow> 'a list \<Rightarrow> bool" |
ac146fc38b51
refined HOL string theories and corresponding ML fragments
haftmann
parents:
31022
diff
changeset
|
4254 |
(Haskell infixl 4 "==") |
ac146fc38b51
refined HOL string theories and corresponding ML fragments
haftmann
parents:
31022
diff
changeset
|
4255 |
|
ac146fc38b51
refined HOL string theories and corresponding ML fragments
haftmann
parents:
31022
diff
changeset
|
4256 |
code_reserved SML |
ac146fc38b51
refined HOL string theories and corresponding ML fragments
haftmann
parents:
31022
diff
changeset
|
4257 |
list |
ac146fc38b51
refined HOL string theories and corresponding ML fragments
haftmann
parents:
31022
diff
changeset
|
4258 |
|
ac146fc38b51
refined HOL string theories and corresponding ML fragments
haftmann
parents:
31022
diff
changeset
|
4259 |
code_reserved OCaml |
ac146fc38b51
refined HOL string theories and corresponding ML fragments
haftmann
parents:
31022
diff
changeset
|
4260 |
list |
ac146fc38b51
refined HOL string theories and corresponding ML fragments
haftmann
parents:
31022
diff
changeset
|
4261 |
|
16770
1f1b1fae30e4
Auxiliary functions to be used in generated code are now defined using "attach".
berghofe
parents:
16634
diff
changeset
|
4262 |
types_code |
1f1b1fae30e4
Auxiliary functions to be used in generated code are now defined using "attach".
berghofe
parents:
16634
diff
changeset
|
4263 |
"list" ("_ list") |
1f1b1fae30e4
Auxiliary functions to be used in generated code are now defined using "attach".
berghofe
parents:
16634
diff
changeset
|
4264 |
attach (term_of) {* |
21760 | 4265 |
fun term_of_list f T = HOLogic.mk_list T o map f; |
16770
1f1b1fae30e4
Auxiliary functions to be used in generated code are now defined using "attach".
berghofe
parents:
16634
diff
changeset
|
4266 |
*} |
1f1b1fae30e4
Auxiliary functions to be used in generated code are now defined using "attach".
berghofe
parents:
16634
diff
changeset
|
4267 |
attach (test) {* |
25885 | 4268 |
fun gen_list' aG aT i j = frequency |
4269 |
[(i, fn () => |
|
4270 |
let |
|
4271 |
val (x, t) = aG j; |
|
4272 |
val (xs, ts) = gen_list' aG aT (i-1) j |
|
4273 |
in (x :: xs, fn () => HOLogic.cons_const aT $ t () $ ts ()) end), |
|
4274 |
(1, fn () => ([], fn () => HOLogic.nil_const aT))] () |
|
4275 |
and gen_list aG aT i = gen_list' aG aT i i; |
|
16770
1f1b1fae30e4
Auxiliary functions to be used in generated code are now defined using "attach".
berghofe
parents:
16634
diff
changeset
|
4276 |
*} |
31048
ac146fc38b51
refined HOL string theories and corresponding ML fragments
haftmann
parents:
31022
diff
changeset
|
4277 |
|
ac146fc38b51
refined HOL string theories and corresponding ML fragments
haftmann
parents:
31022
diff
changeset
|
4278 |
consts_code Cons ("(_ ::/ _)") |
20588 | 4279 |
|
20453
855f07fabd76
final syntax for some Isar code generator keywords
haftmann
parents:
20439
diff
changeset
|
4280 |
setup {* |
855f07fabd76
final syntax for some Isar code generator keywords
haftmann
parents:
20439
diff
changeset
|
4281 |
let |
31055
2cf6efca6c71
proper structures for list and string code generation stuff
haftmann
parents:
31048
diff
changeset
|
4282 |
fun list_codegen thy defs dep thyname b t gr = |
2cf6efca6c71
proper structures for list and string code generation stuff
haftmann
parents:
31048
diff
changeset
|
4283 |
let |
2cf6efca6c71
proper structures for list and string code generation stuff
haftmann
parents:
31048
diff
changeset
|
4284 |
val ts = HOLogic.dest_list t; |
2cf6efca6c71
proper structures for list and string code generation stuff
haftmann
parents:
31048
diff
changeset
|
4285 |
val (_, gr') = Codegen.invoke_tycodegen thy defs dep thyname false |
2cf6efca6c71
proper structures for list and string code generation stuff
haftmann
parents:
31048
diff
changeset
|
4286 |
(fastype_of t) gr; |
2cf6efca6c71
proper structures for list and string code generation stuff
haftmann
parents:
31048
diff
changeset
|
4287 |
val (ps, gr'') = fold_map |
2cf6efca6c71
proper structures for list and string code generation stuff
haftmann
parents:
31048
diff
changeset
|
4288 |
(Codegen.invoke_codegen thy defs dep thyname false) ts gr' |
2cf6efca6c71
proper structures for list and string code generation stuff
haftmann
parents:
31048
diff
changeset
|
4289 |
in SOME (Pretty.list "[" "]" ps, gr'') end handle TERM _ => NONE; |
2cf6efca6c71
proper structures for list and string code generation stuff
haftmann
parents:
31048
diff
changeset
|
4290 |
in |
34886 | 4291 |
fold (List_Code.add_literal_list) ["SML", "OCaml", "Haskell", "Scala"] |
31055
2cf6efca6c71
proper structures for list and string code generation stuff
haftmann
parents:
31048
diff
changeset
|
4292 |
#> Codegen.add_codegen "list_codegen" list_codegen |
2cf6efca6c71
proper structures for list and string code generation stuff
haftmann
parents:
31048
diff
changeset
|
4293 |
end |
20453
855f07fabd76
final syntax for some Isar code generator keywords
haftmann
parents:
20439
diff
changeset
|
4294 |
*} |
15064
4f3102b50197
- Moved code generator setup for lists from Main.thy to List.thy
berghofe
parents:
15045
diff
changeset
|
4295 |
|
21061
580dfc999ef6
added normal post setup; cleaned up "execution" constants
haftmann
parents:
21046
diff
changeset
|
4296 |
|
580dfc999ef6
added normal post setup; cleaned up "execution" constants
haftmann
parents:
21046
diff
changeset
|
4297 |
subsubsection {* Generation of efficient code *} |
580dfc999ef6
added normal post setup; cleaned up "execution" constants
haftmann
parents:
21046
diff
changeset
|
4298 |
|
25221
5ded95dda5df
append/member: more light-weight way to declare authentic syntax;
wenzelm
parents:
25215
diff
changeset
|
4299 |
primrec |
25559 | 4300 |
member :: "'a \<Rightarrow> 'a list \<Rightarrow> bool" (infixl "mem" 55) |
4301 |
where |
|
4302 |
"x mem [] \<longleftrightarrow> False" |
|
28515 | 4303 |
| "x mem (y#ys) \<longleftrightarrow> x = y \<or> x mem ys" |
21061
580dfc999ef6
added normal post setup; cleaned up "execution" constants
haftmann
parents:
21046
diff
changeset
|
4304 |
|
580dfc999ef6
added normal post setup; cleaned up "execution" constants
haftmann
parents:
21046
diff
changeset
|
4305 |
primrec |
26442
57fb6a8b099e
restructuring; explicit case names for rule list_induct2
haftmann
parents:
26300
diff
changeset
|
4306 |
null:: "'a list \<Rightarrow> bool" |
57fb6a8b099e
restructuring; explicit case names for rule list_induct2
haftmann
parents:
26300
diff
changeset
|
4307 |
where |
21061
580dfc999ef6
added normal post setup; cleaned up "execution" constants
haftmann
parents:
21046
diff
changeset
|
4308 |
"null [] = True" |
26442
57fb6a8b099e
restructuring; explicit case names for rule list_induct2
haftmann
parents:
26300
diff
changeset
|
4309 |
| "null (x#xs) = False" |
21061
580dfc999ef6
added normal post setup; cleaned up "execution" constants
haftmann
parents:
21046
diff
changeset
|
4310 |
|
580dfc999ef6
added normal post setup; cleaned up "execution" constants
haftmann
parents:
21046
diff
changeset
|
4311 |
primrec |
26442
57fb6a8b099e
restructuring; explicit case names for rule list_induct2
haftmann
parents:
26300
diff
changeset
|
4312 |
list_inter :: "'a list \<Rightarrow> 'a list \<Rightarrow> 'a list" |
57fb6a8b099e
restructuring; explicit case names for rule list_induct2
haftmann
parents:
26300
diff
changeset
|
4313 |
where |
21061
580dfc999ef6
added normal post setup; cleaned up "execution" constants
haftmann
parents:
21046
diff
changeset
|
4314 |
"list_inter [] bs = []" |
26442
57fb6a8b099e
restructuring; explicit case names for rule list_induct2
haftmann
parents:
26300
diff
changeset
|
4315 |
| "list_inter (a#as) bs = |
21061
580dfc999ef6
added normal post setup; cleaned up "execution" constants
haftmann
parents:
21046
diff
changeset
|
4316 |
(if a \<in> set bs then a # list_inter as bs else list_inter as bs)" |
580dfc999ef6
added normal post setup; cleaned up "execution" constants
haftmann
parents:
21046
diff
changeset
|
4317 |
|
580dfc999ef6
added normal post setup; cleaned up "execution" constants
haftmann
parents:
21046
diff
changeset
|
4318 |
primrec |
26442
57fb6a8b099e
restructuring; explicit case names for rule list_induct2
haftmann
parents:
26300
diff
changeset
|
4319 |
list_all :: "('a \<Rightarrow> bool) \<Rightarrow> ('a list \<Rightarrow> bool)" |
57fb6a8b099e
restructuring; explicit case names for rule list_induct2
haftmann
parents:
26300
diff
changeset
|
4320 |
where |
21061
580dfc999ef6
added normal post setup; cleaned up "execution" constants
haftmann
parents:
21046
diff
changeset
|
4321 |
"list_all P [] = True" |
26442
57fb6a8b099e
restructuring; explicit case names for rule list_induct2
haftmann
parents:
26300
diff
changeset
|
4322 |
| "list_all P (x#xs) = (P x \<and> list_all P xs)" |
21061
580dfc999ef6
added normal post setup; cleaned up "execution" constants
haftmann
parents:
21046
diff
changeset
|
4323 |
|
580dfc999ef6
added normal post setup; cleaned up "execution" constants
haftmann
parents:
21046
diff
changeset
|
4324 |
primrec |
26442
57fb6a8b099e
restructuring; explicit case names for rule list_induct2
haftmann
parents:
26300
diff
changeset
|
4325 |
list_ex :: "('a \<Rightarrow> bool) \<Rightarrow> 'a list \<Rightarrow> bool" |
57fb6a8b099e
restructuring; explicit case names for rule list_induct2
haftmann
parents:
26300
diff
changeset
|
4326 |
where |
21061
580dfc999ef6
added normal post setup; cleaned up "execution" constants
haftmann
parents:
21046
diff
changeset
|
4327 |
"list_ex P [] = False" |
26442
57fb6a8b099e
restructuring; explicit case names for rule list_induct2
haftmann
parents:
26300
diff
changeset
|
4328 |
| "list_ex P (x#xs) = (P x \<or> list_ex P xs)" |
21061
580dfc999ef6
added normal post setup; cleaned up "execution" constants
haftmann
parents:
21046
diff
changeset
|
4329 |
|
580dfc999ef6
added normal post setup; cleaned up "execution" constants
haftmann
parents:
21046
diff
changeset
|
4330 |
primrec |
26442
57fb6a8b099e
restructuring; explicit case names for rule list_induct2
haftmann
parents:
26300
diff
changeset
|
4331 |
filtermap :: "('a \<Rightarrow> 'b option) \<Rightarrow> 'a list \<Rightarrow> 'b list" |
57fb6a8b099e
restructuring; explicit case names for rule list_induct2
haftmann
parents:
26300
diff
changeset
|
4332 |
where |
21061
580dfc999ef6
added normal post setup; cleaned up "execution" constants
haftmann
parents:
21046
diff
changeset
|
4333 |
"filtermap f [] = []" |
26442
57fb6a8b099e
restructuring; explicit case names for rule list_induct2
haftmann
parents:
26300
diff
changeset
|
4334 |
| "filtermap f (x#xs) = |
21061
580dfc999ef6
added normal post setup; cleaned up "execution" constants
haftmann
parents:
21046
diff
changeset
|
4335 |
(case f x of None \<Rightarrow> filtermap f xs |
580dfc999ef6
added normal post setup; cleaned up "execution" constants
haftmann
parents:
21046
diff
changeset
|
4336 |
| Some y \<Rightarrow> y # filtermap f xs)" |
580dfc999ef6
added normal post setup; cleaned up "execution" constants
haftmann
parents:
21046
diff
changeset
|
4337 |
|
580dfc999ef6
added normal post setup; cleaned up "execution" constants
haftmann
parents:
21046
diff
changeset
|
4338 |
primrec |
26442
57fb6a8b099e
restructuring; explicit case names for rule list_induct2
haftmann
parents:
26300
diff
changeset
|
4339 |
map_filter :: "('a \<Rightarrow> 'b) \<Rightarrow> ('a \<Rightarrow> bool) \<Rightarrow> 'a list \<Rightarrow> 'b list" |
57fb6a8b099e
restructuring; explicit case names for rule list_induct2
haftmann
parents:
26300
diff
changeset
|
4340 |
where |
21061
580dfc999ef6
added normal post setup; cleaned up "execution" constants
haftmann
parents:
21046
diff
changeset
|
4341 |
"map_filter f P [] = []" |
26442
57fb6a8b099e
restructuring; explicit case names for rule list_induct2
haftmann
parents:
26300
diff
changeset
|
4342 |
| "map_filter f P (x#xs) = |
21061
580dfc999ef6
added normal post setup; cleaned up "execution" constants
haftmann
parents:
21046
diff
changeset
|
4343 |
(if P x then f x # map_filter f P xs else map_filter f P xs)" |
580dfc999ef6
added normal post setup; cleaned up "execution" constants
haftmann
parents:
21046
diff
changeset
|
4344 |
|
28789
5a404273ea8f
added length_unique operation for code generation
haftmann
parents:
28708
diff
changeset
|
4345 |
primrec |
5a404273ea8f
added length_unique operation for code generation
haftmann
parents:
28708
diff
changeset
|
4346 |
length_unique :: "'a list \<Rightarrow> nat" |
5a404273ea8f
added length_unique operation for code generation
haftmann
parents:
28708
diff
changeset
|
4347 |
where |
5a404273ea8f
added length_unique operation for code generation
haftmann
parents:
28708
diff
changeset
|
4348 |
"length_unique [] = 0" |
5a404273ea8f
added length_unique operation for code generation
haftmann
parents:
28708
diff
changeset
|
4349 |
| "length_unique (x#xs) = |
5a404273ea8f
added length_unique operation for code generation
haftmann
parents:
28708
diff
changeset
|
4350 |
(if x \<in> set xs then length_unique xs else Suc (length_unique xs))" |
5a404273ea8f
added length_unique operation for code generation
haftmann
parents:
28708
diff
changeset
|
4351 |
|
33639
603320b93668
New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents:
33593
diff
changeset
|
4352 |
primrec |
603320b93668
New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents:
33593
diff
changeset
|
4353 |
concat_map :: "('a => 'b list) => 'a list => 'b list" |
603320b93668
New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents:
33593
diff
changeset
|
4354 |
where |
603320b93668
New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents:
33593
diff
changeset
|
4355 |
"concat_map f [] = []" |
603320b93668
New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents:
33593
diff
changeset
|
4356 |
| "concat_map f (x#xs) = f x @ concat_map f xs" |
603320b93668
New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents:
33593
diff
changeset
|
4357 |
|
21061
580dfc999ef6
added normal post setup; cleaned up "execution" constants
haftmann
parents:
21046
diff
changeset
|
4358 |
text {* |
21754
6316163ae934
moved char/string syntax to Tools/string_syntax.ML;
wenzelm
parents:
21548
diff
changeset
|
4359 |
Only use @{text mem} for generating executable code. Otherwise use |
6316163ae934
moved char/string syntax to Tools/string_syntax.ML;
wenzelm
parents:
21548
diff
changeset
|
4360 |
@{prop "x : set xs"} instead --- it is much easier to reason about. |
21061
580dfc999ef6
added normal post setup; cleaned up "execution" constants
haftmann
parents:
21046
diff
changeset
|
4361 |
The same is true for @{const list_all} and @{const list_ex}: write |
580dfc999ef6
added normal post setup; cleaned up "execution" constants
haftmann
parents:
21046
diff
changeset
|
4362 |
@{text "\<forall>x\<in>set xs"} and @{text "\<exists>x\<in>set xs"} instead because the HOL |
21754
6316163ae934
moved char/string syntax to Tools/string_syntax.ML;
wenzelm
parents:
21548
diff
changeset
|
4363 |
quantifiers are aleady known to the automatic provers. In fact, the |
6316163ae934
moved char/string syntax to Tools/string_syntax.ML;
wenzelm
parents:
21548
diff
changeset
|
4364 |
declarations in the code subsection make sure that @{text "\<in>"}, |
6316163ae934
moved char/string syntax to Tools/string_syntax.ML;
wenzelm
parents:
21548
diff
changeset
|
4365 |
@{text "\<forall>x\<in>set xs"} and @{text "\<exists>x\<in>set xs"} are implemented |
6316163ae934
moved char/string syntax to Tools/string_syntax.ML;
wenzelm
parents:
21548
diff
changeset
|
4366 |
efficiently. |
21061
580dfc999ef6
added normal post setup; cleaned up "execution" constants
haftmann
parents:
21046
diff
changeset
|
4367 |
|
580dfc999ef6
added normal post setup; cleaned up "execution" constants
haftmann
parents:
21046
diff
changeset
|
4368 |
Efficient emptyness check is implemented by @{const null}. |
580dfc999ef6
added normal post setup; cleaned up "execution" constants
haftmann
parents:
21046
diff
changeset
|
4369 |
|
23060 | 4370 |
The functions @{const filtermap} and @{const map_filter} are just |
4371 |
there to generate efficient code. Do not use |
|
21754
6316163ae934
moved char/string syntax to Tools/string_syntax.ML;
wenzelm
parents:
21548
diff
changeset
|
4372 |
them for modelling and proving. |
21061
580dfc999ef6
added normal post setup; cleaned up "execution" constants
haftmann
parents:
21046
diff
changeset
|
4373 |
*} |
580dfc999ef6
added normal post setup; cleaned up "execution" constants
haftmann
parents:
21046
diff
changeset
|
4374 |
|
23060 | 4375 |
lemma rev_foldl_cons [code]: |
4376 |
"rev xs = foldl (\<lambda>xs x. x # xs) [] xs" |
|
4377 |
proof (induct xs) |
|
4378 |
case Nil then show ?case by simp |
|
4379 |
next |
|
4380 |
case Cons |
|
4381 |
{ |
|
4382 |
fix x xs ys |
|
4383 |
have "foldl (\<lambda>xs x. x # xs) ys xs @ [x] |
|
4384 |
= foldl (\<lambda>xs x. x # xs) (ys @ [x]) xs" |
|
4385 |
by (induct xs arbitrary: ys) auto |
|
4386 |
} |
|
4387 |
note aux = this |
|
4388 |
show ?case by (induct xs) (auto simp add: Cons aux) |
|
4389 |
qed |
|
4390 |
||
31998
2c7a24f74db9
code attributes use common underscore convention
haftmann
parents:
31930
diff
changeset
|
4391 |
lemma mem_iff [code_post]: |
22422
ee19cdb07528
stepping towards uniform lattice theory development in HOL
haftmann
parents:
22262
diff
changeset
|
4392 |
"x mem xs \<longleftrightarrow> x \<in> set xs" |
24349 | 4393 |
by (induct xs) auto |
21061
580dfc999ef6
added normal post setup; cleaned up "execution" constants
haftmann
parents:
21046
diff
changeset
|
4394 |
|
31998
2c7a24f74db9
code attributes use common underscore convention
haftmann
parents:
31930
diff
changeset
|
4395 |
lemmas in_set_code [code_unfold] = mem_iff [symmetric] |
21061
580dfc999ef6
added normal post setup; cleaned up "execution" constants
haftmann
parents:
21046
diff
changeset
|
4396 |
|
31154 | 4397 |
lemma empty_null: |
22422
ee19cdb07528
stepping towards uniform lattice theory development in HOL
haftmann
parents:
22262
diff
changeset
|
4398 |
"xs = [] \<longleftrightarrow> null xs" |
24349 | 4399 |
by (cases xs) simp_all |
21061
580dfc999ef6
added normal post setup; cleaned up "execution" constants
haftmann
parents:
21046
diff
changeset
|
4400 |
|
32069
6d28bbd33e2c
prefer code_inline over code_unfold; use code_unfold_post where appropriate
haftmann
parents:
31998
diff
changeset
|
4401 |
lemma [code_unfold]: |
31154 | 4402 |
"eq_class.eq xs [] \<longleftrightarrow> null xs" |
4403 |
by (simp add: eq empty_null) |
|
4404 |
||
31998
2c7a24f74db9
code attributes use common underscore convention
haftmann
parents:
31930
diff
changeset
|
4405 |
lemmas null_empty [code_post] = |
21061
580dfc999ef6
added normal post setup; cleaned up "execution" constants
haftmann
parents:
21046
diff
changeset
|
4406 |
empty_null [symmetric] |
580dfc999ef6
added normal post setup; cleaned up "execution" constants
haftmann
parents:
21046
diff
changeset
|
4407 |
|
580dfc999ef6
added normal post setup; cleaned up "execution" constants
haftmann
parents:
21046
diff
changeset
|
4408 |
lemma list_inter_conv: |
580dfc999ef6
added normal post setup; cleaned up "execution" constants
haftmann
parents:
21046
diff
changeset
|
4409 |
"set (list_inter xs ys) = set xs \<inter> set ys" |
24349 | 4410 |
by (induct xs) auto |
21061
580dfc999ef6
added normal post setup; cleaned up "execution" constants
haftmann
parents:
21046
diff
changeset
|
4411 |
|
31998
2c7a24f74db9
code attributes use common underscore convention
haftmann
parents:
31930
diff
changeset
|
4412 |
lemma list_all_iff [code_post]: |
22422
ee19cdb07528
stepping towards uniform lattice theory development in HOL
haftmann
parents:
22262
diff
changeset
|
4413 |
"list_all P xs \<longleftrightarrow> (\<forall>x \<in> set xs. P x)" |
24349 | 4414 |
by (induct xs) auto |
21061
580dfc999ef6
added normal post setup; cleaned up "execution" constants
haftmann
parents:
21046
diff
changeset
|
4415 |
|
31998
2c7a24f74db9
code attributes use common underscore convention
haftmann
parents:
31930
diff
changeset
|
4416 |
lemmas list_ball_code [code_unfold] = list_all_iff [symmetric] |
21061
580dfc999ef6
added normal post setup; cleaned up "execution" constants
haftmann
parents:
21046
diff
changeset
|
4417 |
|
580dfc999ef6
added normal post setup; cleaned up "execution" constants
haftmann
parents:
21046
diff
changeset
|
4418 |
lemma list_all_append [simp]: |
22422
ee19cdb07528
stepping towards uniform lattice theory development in HOL
haftmann
parents:
22262
diff
changeset
|
4419 |
"list_all P (xs @ ys) \<longleftrightarrow> (list_all P xs \<and> list_all P ys)" |
24349 | 4420 |
by (induct xs) auto |
21061
580dfc999ef6
added normal post setup; cleaned up "execution" constants
haftmann
parents:
21046
diff
changeset
|
4421 |
|
580dfc999ef6
added normal post setup; cleaned up "execution" constants
haftmann
parents:
21046
diff
changeset
|
4422 |
lemma list_all_rev [simp]: |
22422
ee19cdb07528
stepping towards uniform lattice theory development in HOL
haftmann
parents:
22262
diff
changeset
|
4423 |
"list_all P (rev xs) \<longleftrightarrow> list_all P xs" |
24349 | 4424 |
by (simp add: list_all_iff) |
21061
580dfc999ef6
added normal post setup; cleaned up "execution" constants
haftmann
parents:
21046
diff
changeset
|
4425 |
|
22506 | 4426 |
lemma list_all_length: |
4427 |
"list_all P xs \<longleftrightarrow> (\<forall>n < length xs. P (xs ! n))" |
|
4428 |
unfolding list_all_iff by (auto intro: all_nth_imp_all_set) |
|
4429 |
||
31998
2c7a24f74db9
code attributes use common underscore convention
haftmann
parents:
31930
diff
changeset
|
4430 |
lemma list_ex_iff [code_post]: |
22422
ee19cdb07528
stepping towards uniform lattice theory development in HOL
haftmann
parents:
22262
diff
changeset
|
4431 |
"list_ex P xs \<longleftrightarrow> (\<exists>x \<in> set xs. P x)" |
24349 | 4432 |
by (induct xs) simp_all |
21061
580dfc999ef6
added normal post setup; cleaned up "execution" constants
haftmann
parents:
21046
diff
changeset
|
4433 |
|
31998
2c7a24f74db9
code attributes use common underscore convention
haftmann
parents:
31930
diff
changeset
|
4434 |
lemmas list_bex_code [code_unfold] = |
22799
ed7d53db2170
moved code generation pretty integers and characters to separate theories
haftmann
parents:
22793
diff
changeset
|
4435 |
list_ex_iff [symmetric] |
21061
580dfc999ef6
added normal post setup; cleaned up "execution" constants
haftmann
parents:
21046
diff
changeset
|
4436 |
|
22506 | 4437 |
lemma list_ex_length: |
4438 |
"list_ex P xs \<longleftrightarrow> (\<exists>n < length xs. P (xs ! n))" |
|
4439 |
unfolding list_ex_iff set_conv_nth by auto |
|
4440 |
||
21061
580dfc999ef6
added normal post setup; cleaned up "execution" constants
haftmann
parents:
21046
diff
changeset
|
4441 |
lemma filtermap_conv: |
580dfc999ef6
added normal post setup; cleaned up "execution" constants
haftmann
parents:
21046
diff
changeset
|
4442 |
"filtermap f xs = map (\<lambda>x. the (f x)) (filter (\<lambda>x. f x \<noteq> None) xs)" |
24349 | 4443 |
by (induct xs) (simp_all split: option.split) |
21061
580dfc999ef6
added normal post setup; cleaned up "execution" constants
haftmann
parents:
21046
diff
changeset
|
4444 |
|
580dfc999ef6
added normal post setup; cleaned up "execution" constants
haftmann
parents:
21046
diff
changeset
|
4445 |
lemma map_filter_conv [simp]: |
580dfc999ef6
added normal post setup; cleaned up "execution" constants
haftmann
parents:
21046
diff
changeset
|
4446 |
"map_filter f P xs = map f (filter P xs)" |
24349 | 4447 |
by (induct xs) auto |
21061
580dfc999ef6
added normal post setup; cleaned up "execution" constants
haftmann
parents:
21046
diff
changeset
|
4448 |
|
32069
6d28bbd33e2c
prefer code_inline over code_unfold; use code_unfold_post where appropriate
haftmann
parents:
31998
diff
changeset
|
4449 |
lemma length_remdups_length_unique [code_unfold]: |
28789
5a404273ea8f
added length_unique operation for code generation
haftmann
parents:
28708
diff
changeset
|
4450 |
"length (remdups xs) = length_unique xs" |
33639
603320b93668
New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents:
33593
diff
changeset
|
4451 |
by (induct xs) simp_all |
603320b93668
New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents:
33593
diff
changeset
|
4452 |
|
603320b93668
New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents:
33593
diff
changeset
|
4453 |
lemma concat_map_code[code_unfold]: |
603320b93668
New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents:
33593
diff
changeset
|
4454 |
"concat(map f xs) = concat_map f xs" |
603320b93668
New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents:
33593
diff
changeset
|
4455 |
by (induct xs) simp_all |
28789
5a404273ea8f
added length_unique operation for code generation
haftmann
parents:
28708
diff
changeset
|
4456 |
|
32681
adeac3cbb659
lemma relating fold1 and foldl; code_unfold rules for Inf_fin, Sup_fin, Min, Max, Inf, Sup
haftmann
parents:
32422
diff
changeset
|
4457 |
declare INFI_def [code_unfold] |
adeac3cbb659
lemma relating fold1 and foldl; code_unfold rules for Inf_fin, Sup_fin, Min, Max, Inf, Sup
haftmann
parents:
32422
diff
changeset
|
4458 |
declare SUPR_def [code_unfold] |
adeac3cbb659
lemma relating fold1 and foldl; code_unfold rules for Inf_fin, Sup_fin, Min, Max, Inf, Sup
haftmann
parents:
32422
diff
changeset
|
4459 |
|
adeac3cbb659
lemma relating fold1 and foldl; code_unfold rules for Inf_fin, Sup_fin, Min, Max, Inf, Sup
haftmann
parents:
32422
diff
changeset
|
4460 |
declare set_map [symmetric, code_unfold] |
adeac3cbb659
lemma relating fold1 and foldl; code_unfold rules for Inf_fin, Sup_fin, Min, Max, Inf, Sup
haftmann
parents:
32422
diff
changeset
|
4461 |
|
28789
5a404273ea8f
added length_unique operation for code generation
haftmann
parents:
28708
diff
changeset
|
4462 |
hide (open) const length_unique |
5a404273ea8f
added length_unique operation for code generation
haftmann
parents:
28708
diff
changeset
|
4463 |
|
24449 | 4464 |
|
4465 |
text {* Code for bounded quantification and summation over nats. *} |
|
21891
b4e4ea3db161
added code lemmas for quantification over bounded nats
haftmann
parents:
21871
diff
changeset
|
4466 |
|
31998
2c7a24f74db9
code attributes use common underscore convention
haftmann
parents:
31930
diff
changeset
|
4467 |
lemma atMost_upto [code_unfold]: |
28072
a45e8c872dc1
It appears that the code generator (Stefan's) needs some laws that appear superfluous: {..n} = set ...
nipkow
parents:
28068
diff
changeset
|
4468 |
"{..n} = set [0..<Suc n]" |
a45e8c872dc1
It appears that the code generator (Stefan's) needs some laws that appear superfluous: {..n} = set ...
nipkow
parents:
28068
diff
changeset
|
4469 |
by auto |
a45e8c872dc1
It appears that the code generator (Stefan's) needs some laws that appear superfluous: {..n} = set ...
nipkow
parents:
28068
diff
changeset
|
4470 |
|
31998
2c7a24f74db9
code attributes use common underscore convention
haftmann
parents:
31930
diff
changeset
|
4471 |
lemma atLeast_upt [code_unfold]: |
28072
a45e8c872dc1
It appears that the code generator (Stefan's) needs some laws that appear superfluous: {..n} = set ...
nipkow
parents:
28068
diff
changeset
|
4472 |
"{..<n} = set [0..<n]" |
a45e8c872dc1
It appears that the code generator (Stefan's) needs some laws that appear superfluous: {..n} = set ...
nipkow
parents:
28068
diff
changeset
|
4473 |
by auto |
a45e8c872dc1
It appears that the code generator (Stefan's) needs some laws that appear superfluous: {..n} = set ...
nipkow
parents:
28068
diff
changeset
|
4474 |
|
31998
2c7a24f74db9
code attributes use common underscore convention
haftmann
parents:
31930
diff
changeset
|
4475 |
lemma greaterThanLessThan_upt [code_unfold]: |
21891
b4e4ea3db161
added code lemmas for quantification over bounded nats
haftmann
parents:
21871
diff
changeset
|
4476 |
"{n<..<m} = set [Suc n..<m]" |
24349 | 4477 |
by auto |
22799
ed7d53db2170
moved code generation pretty integers and characters to separate theories
haftmann
parents:
22793
diff
changeset
|
4478 |
|
32417 | 4479 |
lemmas atLeastLessThan_upt [code_unfold] = set_upt [symmetric] |
22799
ed7d53db2170
moved code generation pretty integers and characters to separate theories
haftmann
parents:
22793
diff
changeset
|
4480 |
|
31998
2c7a24f74db9
code attributes use common underscore convention
haftmann
parents:
31930
diff
changeset
|
4481 |
lemma greaterThanAtMost_upt [code_unfold]: |
24645 | 4482 |
"{n<..m} = set [Suc n..<Suc m]" |
24349 | 4483 |
by auto |
22799
ed7d53db2170
moved code generation pretty integers and characters to separate theories
haftmann
parents:
22793
diff
changeset
|
4484 |
|
31998
2c7a24f74db9
code attributes use common underscore convention
haftmann
parents:
31930
diff
changeset
|
4485 |
lemma atLeastAtMost_upt [code_unfold]: |
24645 | 4486 |
"{n..m} = set [n..<Suc m]" |
24349 | 4487 |
by auto |
22799
ed7d53db2170
moved code generation pretty integers and characters to separate theories
haftmann
parents:
22793
diff
changeset
|
4488 |
|
31998
2c7a24f74db9
code attributes use common underscore convention
haftmann
parents:
31930
diff
changeset
|
4489 |
lemma all_nat_less_eq [code_unfold]: |
21891
b4e4ea3db161
added code lemmas for quantification over bounded nats
haftmann
parents:
21871
diff
changeset
|
4490 |
"(\<forall>m<n\<Colon>nat. P m) \<longleftrightarrow> (\<forall>m \<in> {0..<n}. P m)" |
24349 | 4491 |
by auto |
22799
ed7d53db2170
moved code generation pretty integers and characters to separate theories
haftmann
parents:
22793
diff
changeset
|
4492 |
|
31998
2c7a24f74db9
code attributes use common underscore convention
haftmann
parents:
31930
diff
changeset
|
4493 |
lemma ex_nat_less_eq [code_unfold]: |
21891
b4e4ea3db161
added code lemmas for quantification over bounded nats
haftmann
parents:
21871
diff
changeset
|
4494 |
"(\<exists>m<n\<Colon>nat. P m) \<longleftrightarrow> (\<exists>m \<in> {0..<n}. P m)" |
24349 | 4495 |
by auto |
22799
ed7d53db2170
moved code generation pretty integers and characters to separate theories
haftmann
parents:
22793
diff
changeset
|
4496 |
|
31998
2c7a24f74db9
code attributes use common underscore convention
haftmann
parents:
31930
diff
changeset
|
4497 |
lemma all_nat_less [code_unfold]: |
21891
b4e4ea3db161
added code lemmas for quantification over bounded nats
haftmann
parents:
21871
diff
changeset
|
4498 |
"(\<forall>m\<le>n\<Colon>nat. P m) \<longleftrightarrow> (\<forall>m \<in> {0..n}. P m)" |
24349 | 4499 |
by auto |
22799
ed7d53db2170
moved code generation pretty integers and characters to separate theories
haftmann
parents:
22793
diff
changeset
|
4500 |
|
31998
2c7a24f74db9
code attributes use common underscore convention
haftmann
parents:
31930
diff
changeset
|
4501 |
lemma ex_nat_less [code_unfold]: |
21891
b4e4ea3db161
added code lemmas for quantification over bounded nats
haftmann
parents:
21871
diff
changeset
|
4502 |
"(\<exists>m\<le>n\<Colon>nat. P m) \<longleftrightarrow> (\<exists>m \<in> {0..n}. P m)" |
24349 | 4503 |
by auto |
22799
ed7d53db2170
moved code generation pretty integers and characters to separate theories
haftmann
parents:
22793
diff
changeset
|
4504 |
|
27715 | 4505 |
lemma setsum_set_distinct_conv_listsum: |
4506 |
"distinct xs \<Longrightarrow> setsum f (set xs) = listsum (map f xs)" |
|
4507 |
by (induct xs) simp_all |
|
4508 |
||
31998
2c7a24f74db9
code attributes use common underscore convention
haftmann
parents:
31930
diff
changeset
|
4509 |
lemma setsum_set_upt_conv_listsum [code_unfold]: |
27715 | 4510 |
"setsum f (set [m..<n]) = listsum (map f [m..<n])" |
4511 |
by (rule setsum_set_distinct_conv_listsum) simp |
|
4512 |
||
33639
603320b93668
New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents:
33593
diff
changeset
|
4513 |
text {* General equivalence between @{const listsum} and @{const setsum} *} |
603320b93668
New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents:
33593
diff
changeset
|
4514 |
lemma listsum_setsum_nth: |
603320b93668
New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents:
33593
diff
changeset
|
4515 |
"listsum xs = (\<Sum> i = 0 ..< length xs. xs ! i)" |
603320b93668
New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents:
33593
diff
changeset
|
4516 |
using setsum_set_upt_conv_listsum[of "op ! xs" 0 "length xs"] |
603320b93668
New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents:
33593
diff
changeset
|
4517 |
by (simp add: map_nth) |
27715 | 4518 |
|
4519 |
text {* Code for summation over ints. *} |
|
4520 |
||
31998
2c7a24f74db9
code attributes use common underscore convention
haftmann
parents:
31930
diff
changeset
|
4521 |
lemma greaterThanLessThan_upto [code_unfold]: |
27715 | 4522 |
"{i<..<j::int} = set [i+1..j - 1]" |
4523 |
by auto |
|
4524 |
||
31998
2c7a24f74db9
code attributes use common underscore convention
haftmann
parents:
31930
diff
changeset
|
4525 |
lemma atLeastLessThan_upto [code_unfold]: |
27715 | 4526 |
"{i..<j::int} = set [i..j - 1]" |
4527 |
by auto |
|
4528 |
||
31998
2c7a24f74db9
code attributes use common underscore convention
haftmann
parents:
31930
diff
changeset
|
4529 |
lemma greaterThanAtMost_upto [code_unfold]: |
27715 | 4530 |
"{i<..j::int} = set [i+1..j]" |
4531 |
by auto |
|
4532 |
||
32415
1dddf2f64266
got rid of complicated class finite_intvl_succ and defined "upto" directly on int, the only instance of the class.
nipkow
parents:
32078
diff
changeset
|
4533 |
lemmas atLeastAtMost_upto [code_unfold] = set_upto[symmetric] |
27715 | 4534 |
|
31998
2c7a24f74db9
code attributes use common underscore convention
haftmann
parents:
31930
diff
changeset
|
4535 |
lemma setsum_set_upto_conv_listsum [code_unfold]: |
27715 | 4536 |
"setsum f (set [i..j::int]) = listsum (map f [i..j])" |
4537 |
by (rule setsum_set_distinct_conv_listsum) simp |
|
24449 | 4538 |
|
32422
46fc4d4ff4c0
code generator: quantifiers over {_.._::int} and {_..<_::nat}
nipkow
parents:
32417
diff
changeset
|
4539 |
|
46fc4d4ff4c0
code generator: quantifiers over {_.._::int} and {_..<_::nat}
nipkow
parents:
32417
diff
changeset
|
4540 |
text {* Optimized code for @{text"\<forall>i\<in>{a..b::int}"} and @{text"\<forall>n:{a..<b::nat}"} |
46fc4d4ff4c0
code generator: quantifiers over {_.._::int} and {_..<_::nat}
nipkow
parents:
32417
diff
changeset
|
4541 |
and similiarly for @{text"\<exists>"}. *} |
46fc4d4ff4c0
code generator: quantifiers over {_.._::int} and {_..<_::nat}
nipkow
parents:
32417
diff
changeset
|
4542 |
|
46fc4d4ff4c0
code generator: quantifiers over {_.._::int} and {_..<_::nat}
nipkow
parents:
32417
diff
changeset
|
4543 |
function all_from_to_nat :: "(nat \<Rightarrow> bool) \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> bool" where |
46fc4d4ff4c0
code generator: quantifiers over {_.._::int} and {_..<_::nat}
nipkow
parents:
32417
diff
changeset
|
4544 |
"all_from_to_nat P i j = |
46fc4d4ff4c0
code generator: quantifiers over {_.._::int} and {_..<_::nat}
nipkow
parents:
32417
diff
changeset
|
4545 |
(if i < j then if P i then all_from_to_nat P (i+1) j else False |
46fc4d4ff4c0
code generator: quantifiers over {_.._::int} and {_..<_::nat}
nipkow
parents:
32417
diff
changeset
|
4546 |
else True)" |
46fc4d4ff4c0
code generator: quantifiers over {_.._::int} and {_..<_::nat}
nipkow
parents:
32417
diff
changeset
|
4547 |
by auto |
46fc4d4ff4c0
code generator: quantifiers over {_.._::int} and {_..<_::nat}
nipkow
parents:
32417
diff
changeset
|
4548 |
termination |
46fc4d4ff4c0
code generator: quantifiers over {_.._::int} and {_..<_::nat}
nipkow
parents:
32417
diff
changeset
|
4549 |
by (relation "measure(%(P,i,j). j - i)") auto |
46fc4d4ff4c0
code generator: quantifiers over {_.._::int} and {_..<_::nat}
nipkow
parents:
32417
diff
changeset
|
4550 |
|
46fc4d4ff4c0
code generator: quantifiers over {_.._::int} and {_..<_::nat}
nipkow
parents:
32417
diff
changeset
|
4551 |
declare all_from_to_nat.simps[simp del] |
46fc4d4ff4c0
code generator: quantifiers over {_.._::int} and {_..<_::nat}
nipkow
parents:
32417
diff
changeset
|
4552 |
|
46fc4d4ff4c0
code generator: quantifiers over {_.._::int} and {_..<_::nat}
nipkow
parents:
32417
diff
changeset
|
4553 |
lemma all_from_to_nat_iff_ball: |
46fc4d4ff4c0
code generator: quantifiers over {_.._::int} and {_..<_::nat}
nipkow
parents:
32417
diff
changeset
|
4554 |
"all_from_to_nat P i j = (ALL n : {i ..< j}. P n)" |
46fc4d4ff4c0
code generator: quantifiers over {_.._::int} and {_..<_::nat}
nipkow
parents:
32417
diff
changeset
|
4555 |
proof(induct P i j rule:all_from_to_nat.induct) |
46fc4d4ff4c0
code generator: quantifiers over {_.._::int} and {_..<_::nat}
nipkow
parents:
32417
diff
changeset
|
4556 |
case (1 P i j) |
46fc4d4ff4c0
code generator: quantifiers over {_.._::int} and {_..<_::nat}
nipkow
parents:
32417
diff
changeset
|
4557 |
let ?yes = "i < j & P i" |
46fc4d4ff4c0
code generator: quantifiers over {_.._::int} and {_..<_::nat}
nipkow
parents:
32417
diff
changeset
|
4558 |
show ?case |
46fc4d4ff4c0
code generator: quantifiers over {_.._::int} and {_..<_::nat}
nipkow
parents:
32417
diff
changeset
|
4559 |
proof (cases) |
46fc4d4ff4c0
code generator: quantifiers over {_.._::int} and {_..<_::nat}
nipkow
parents:
32417
diff
changeset
|
4560 |
assume ?yes |
46fc4d4ff4c0
code generator: quantifiers over {_.._::int} and {_..<_::nat}
nipkow
parents:
32417
diff
changeset
|
4561 |
hence "all_from_to_nat P i j = (P i & all_from_to_nat P (i+1) j)" |
46fc4d4ff4c0
code generator: quantifiers over {_.._::int} and {_..<_::nat}
nipkow
parents:
32417
diff
changeset
|
4562 |
by(simp add: all_from_to_nat.simps) |
46fc4d4ff4c0
code generator: quantifiers over {_.._::int} and {_..<_::nat}
nipkow
parents:
32417
diff
changeset
|
4563 |
also have "... = (P i & (ALL n : {i+1 ..< j}. P n))" using `?yes` 1 by simp |
46fc4d4ff4c0
code generator: quantifiers over {_.._::int} and {_..<_::nat}
nipkow
parents:
32417
diff
changeset
|
4564 |
also have "... = (ALL n : {i ..< j}. P n)" (is "?L = ?R") |
46fc4d4ff4c0
code generator: quantifiers over {_.._::int} and {_..<_::nat}
nipkow
parents:
32417
diff
changeset
|
4565 |
proof |
46fc4d4ff4c0
code generator: quantifiers over {_.._::int} and {_..<_::nat}
nipkow
parents:
32417
diff
changeset
|
4566 |
assume L: ?L |
46fc4d4ff4c0
code generator: quantifiers over {_.._::int} and {_..<_::nat}
nipkow
parents:
32417
diff
changeset
|
4567 |
show ?R |
46fc4d4ff4c0
code generator: quantifiers over {_.._::int} and {_..<_::nat}
nipkow
parents:
32417
diff
changeset
|
4568 |
proof clarify |
32960
69916a850301
eliminated hard tabulators, guessing at each author's individual tab-width;
wenzelm
parents:
32681
diff
changeset
|
4569 |
fix n assume n: "n : {i..<j}" |
69916a850301
eliminated hard tabulators, guessing at each author's individual tab-width;
wenzelm
parents:
32681
diff
changeset
|
4570 |
show "P n" |
69916a850301
eliminated hard tabulators, guessing at each author's individual tab-width;
wenzelm
parents:
32681
diff
changeset
|
4571 |
proof cases |
69916a850301
eliminated hard tabulators, guessing at each author's individual tab-width;
wenzelm
parents:
32681
diff
changeset
|
4572 |
assume "n = i" thus "P n" using L by simp |
69916a850301
eliminated hard tabulators, guessing at each author's individual tab-width;
wenzelm
parents:
32681
diff
changeset
|
4573 |
next |
69916a850301
eliminated hard tabulators, guessing at each author's individual tab-width;
wenzelm
parents:
32681
diff
changeset
|
4574 |
assume "n ~= i" |
69916a850301
eliminated hard tabulators, guessing at each author's individual tab-width;
wenzelm
parents:
32681
diff
changeset
|
4575 |
hence "i+1 <= n" using n by auto |
69916a850301
eliminated hard tabulators, guessing at each author's individual tab-width;
wenzelm
parents:
32681
diff
changeset
|
4576 |
thus "P n" using L n by simp |
69916a850301
eliminated hard tabulators, guessing at each author's individual tab-width;
wenzelm
parents:
32681
diff
changeset
|
4577 |
qed |
32422
46fc4d4ff4c0
code generator: quantifiers over {_.._::int} and {_..<_::nat}
nipkow
parents:
32417
diff
changeset
|
4578 |
qed |
46fc4d4ff4c0
code generator: quantifiers over {_.._::int} and {_..<_::nat}
nipkow
parents:
32417
diff
changeset
|
4579 |
next |
46fc4d4ff4c0
code generator: quantifiers over {_.._::int} and {_..<_::nat}
nipkow
parents:
32417
diff
changeset
|
4580 |
assume R: ?R thus ?L using `?yes` 1 by auto |
46fc4d4ff4c0
code generator: quantifiers over {_.._::int} and {_..<_::nat}
nipkow
parents:
32417
diff
changeset
|
4581 |
qed |
46fc4d4ff4c0
code generator: quantifiers over {_.._::int} and {_..<_::nat}
nipkow
parents:
32417
diff
changeset
|
4582 |
finally show ?thesis . |
46fc4d4ff4c0
code generator: quantifiers over {_.._::int} and {_..<_::nat}
nipkow
parents:
32417
diff
changeset
|
4583 |
next |
46fc4d4ff4c0
code generator: quantifiers over {_.._::int} and {_..<_::nat}
nipkow
parents:
32417
diff
changeset
|
4584 |
assume "~?yes" thus ?thesis by(auto simp add: all_from_to_nat.simps) |
46fc4d4ff4c0
code generator: quantifiers over {_.._::int} and {_..<_::nat}
nipkow
parents:
32417
diff
changeset
|
4585 |
qed |
46fc4d4ff4c0
code generator: quantifiers over {_.._::int} and {_..<_::nat}
nipkow
parents:
32417
diff
changeset
|
4586 |
qed |
46fc4d4ff4c0
code generator: quantifiers over {_.._::int} and {_..<_::nat}
nipkow
parents:
32417
diff
changeset
|
4587 |
|
46fc4d4ff4c0
code generator: quantifiers over {_.._::int} and {_..<_::nat}
nipkow
parents:
32417
diff
changeset
|
4588 |
|
46fc4d4ff4c0
code generator: quantifiers over {_.._::int} and {_..<_::nat}
nipkow
parents:
32417
diff
changeset
|
4589 |
lemma list_all_iff_all_from_to_nat[code_unfold]: |
46fc4d4ff4c0
code generator: quantifiers over {_.._::int} and {_..<_::nat}
nipkow
parents:
32417
diff
changeset
|
4590 |
"list_all P [i..<j] = all_from_to_nat P i j" |
46fc4d4ff4c0
code generator: quantifiers over {_.._::int} and {_..<_::nat}
nipkow
parents:
32417
diff
changeset
|
4591 |
by(simp add: all_from_to_nat_iff_ball list_all_iff) |
46fc4d4ff4c0
code generator: quantifiers over {_.._::int} and {_..<_::nat}
nipkow
parents:
32417
diff
changeset
|
4592 |
|
46fc4d4ff4c0
code generator: quantifiers over {_.._::int} and {_..<_::nat}
nipkow
parents:
32417
diff
changeset
|
4593 |
lemma list_ex_iff_not_all_from_to_not_nat[code_unfold]: |
46fc4d4ff4c0
code generator: quantifiers over {_.._::int} and {_..<_::nat}
nipkow
parents:
32417
diff
changeset
|
4594 |
"list_ex P [i..<j] = (~all_from_to_nat (%x. ~P x) i j)" |
46fc4d4ff4c0
code generator: quantifiers over {_.._::int} and {_..<_::nat}
nipkow
parents:
32417
diff
changeset
|
4595 |
by(simp add: all_from_to_nat_iff_ball list_ex_iff) |
46fc4d4ff4c0
code generator: quantifiers over {_.._::int} and {_..<_::nat}
nipkow
parents:
32417
diff
changeset
|
4596 |
|
46fc4d4ff4c0
code generator: quantifiers over {_.._::int} and {_..<_::nat}
nipkow
parents:
32417
diff
changeset
|
4597 |
|
46fc4d4ff4c0
code generator: quantifiers over {_.._::int} and {_..<_::nat}
nipkow
parents:
32417
diff
changeset
|
4598 |
function all_from_to_int :: "(int \<Rightarrow> bool) \<Rightarrow> int \<Rightarrow> int \<Rightarrow> bool" where |
46fc4d4ff4c0
code generator: quantifiers over {_.._::int} and {_..<_::nat}
nipkow
parents:
32417
diff
changeset
|
4599 |
"all_from_to_int P i j = |
46fc4d4ff4c0
code generator: quantifiers over {_.._::int} and {_..<_::nat}
nipkow
parents:
32417
diff
changeset
|
4600 |
(if i <= j then if P i then all_from_to_int P (i+1) j else False |
46fc4d4ff4c0
code generator: quantifiers over {_.._::int} and {_..<_::nat}
nipkow
parents:
32417
diff
changeset
|
4601 |
else True)" |
46fc4d4ff4c0
code generator: quantifiers over {_.._::int} and {_..<_::nat}
nipkow
parents:
32417
diff
changeset
|
4602 |
by auto |
46fc4d4ff4c0
code generator: quantifiers over {_.._::int} and {_..<_::nat}
nipkow
parents:
32417
diff
changeset
|
4603 |
termination |
46fc4d4ff4c0
code generator: quantifiers over {_.._::int} and {_..<_::nat}
nipkow
parents:
32417
diff
changeset
|
4604 |
by (relation "measure(%(P,i,j). nat(j - i + 1))") auto |
46fc4d4ff4c0
code generator: quantifiers over {_.._::int} and {_..<_::nat}
nipkow
parents:
32417
diff
changeset
|
4605 |
|
46fc4d4ff4c0
code generator: quantifiers over {_.._::int} and {_..<_::nat}
nipkow
parents:
32417
diff
changeset
|
4606 |
declare all_from_to_int.simps[simp del] |
46fc4d4ff4c0
code generator: quantifiers over {_.._::int} and {_..<_::nat}
nipkow
parents:
32417
diff
changeset
|
4607 |
|
46fc4d4ff4c0
code generator: quantifiers over {_.._::int} and {_..<_::nat}
nipkow
parents:
32417
diff
changeset
|
4608 |
lemma all_from_to_int_iff_ball: |
46fc4d4ff4c0
code generator: quantifiers over {_.._::int} and {_..<_::nat}
nipkow
parents:
32417
diff
changeset
|
4609 |
"all_from_to_int P i j = (ALL n : {i .. j}. P n)" |
46fc4d4ff4c0
code generator: quantifiers over {_.._::int} and {_..<_::nat}
nipkow
parents:
32417
diff
changeset
|
4610 |
proof(induct P i j rule:all_from_to_int.induct) |
46fc4d4ff4c0
code generator: quantifiers over {_.._::int} and {_..<_::nat}
nipkow
parents:
32417
diff
changeset
|
4611 |
case (1 P i j) |
46fc4d4ff4c0
code generator: quantifiers over {_.._::int} and {_..<_::nat}
nipkow
parents:
32417
diff
changeset
|
4612 |
let ?yes = "i <= j & P i" |
46fc4d4ff4c0
code generator: quantifiers over {_.._::int} and {_..<_::nat}
nipkow
parents:
32417
diff
changeset
|
4613 |
show ?case |
46fc4d4ff4c0
code generator: quantifiers over {_.._::int} and {_..<_::nat}
nipkow
parents:
32417
diff
changeset
|
4614 |
proof (cases) |
46fc4d4ff4c0
code generator: quantifiers over {_.._::int} and {_..<_::nat}
nipkow
parents:
32417
diff
changeset
|
4615 |
assume ?yes |
46fc4d4ff4c0
code generator: quantifiers over {_.._::int} and {_..<_::nat}
nipkow
parents:
32417
diff
changeset
|
4616 |
hence "all_from_to_int P i j = (P i & all_from_to_int P (i+1) j)" |
46fc4d4ff4c0
code generator: quantifiers over {_.._::int} and {_..<_::nat}
nipkow
parents:
32417
diff
changeset
|
4617 |
by(simp add: all_from_to_int.simps) |
46fc4d4ff4c0
code generator: quantifiers over {_.._::int} and {_..<_::nat}
nipkow
parents:
32417
diff
changeset
|
4618 |
also have "... = (P i & (ALL n : {i+1 .. j}. P n))" using `?yes` 1 by simp |
46fc4d4ff4c0
code generator: quantifiers over {_.._::int} and {_..<_::nat}
nipkow
parents:
32417
diff
changeset
|
4619 |
also have "... = (ALL n : {i .. j}. P n)" (is "?L = ?R") |
46fc4d4ff4c0
code generator: quantifiers over {_.._::int} and {_..<_::nat}
nipkow
parents:
32417
diff
changeset
|
4620 |
proof |
46fc4d4ff4c0
code generator: quantifiers over {_.._::int} and {_..<_::nat}
nipkow
parents:
32417
diff
changeset
|
4621 |
assume L: ?L |
46fc4d4ff4c0
code generator: quantifiers over {_.._::int} and {_..<_::nat}
nipkow
parents:
32417
diff
changeset
|
4622 |
show ?R |
46fc4d4ff4c0
code generator: quantifiers over {_.._::int} and {_..<_::nat}
nipkow
parents:
32417
diff
changeset
|
4623 |
proof clarify |
32960
69916a850301
eliminated hard tabulators, guessing at each author's individual tab-width;
wenzelm
parents:
32681
diff
changeset
|
4624 |
fix n assume n: "n : {i..j}" |
69916a850301
eliminated hard tabulators, guessing at each author's individual tab-width;
wenzelm
parents:
32681
diff
changeset
|
4625 |
show "P n" |
69916a850301
eliminated hard tabulators, guessing at each author's individual tab-width;
wenzelm
parents:
32681
diff
changeset
|
4626 |
proof cases |
69916a850301
eliminated hard tabulators, guessing at each author's individual tab-width;
wenzelm
parents:
32681
diff
changeset
|
4627 |
assume "n = i" thus "P n" using L by simp |
69916a850301
eliminated hard tabulators, guessing at each author's individual tab-width;
wenzelm
parents:
32681
diff
changeset
|
4628 |
next |
69916a850301
eliminated hard tabulators, guessing at each author's individual tab-width;
wenzelm
parents:
32681
diff
changeset
|
4629 |
assume "n ~= i" |
69916a850301
eliminated hard tabulators, guessing at each author's individual tab-width;
wenzelm
parents:
32681
diff
changeset
|
4630 |
hence "i+1 <= n" using n by auto |
69916a850301
eliminated hard tabulators, guessing at each author's individual tab-width;
wenzelm
parents:
32681
diff
changeset
|
4631 |
thus "P n" using L n by simp |
69916a850301
eliminated hard tabulators, guessing at each author's individual tab-width;
wenzelm
parents:
32681
diff
changeset
|
4632 |
qed |
32422
46fc4d4ff4c0
code generator: quantifiers over {_.._::int} and {_..<_::nat}
nipkow
parents:
32417
diff
changeset
|
4633 |
qed |
46fc4d4ff4c0
code generator: quantifiers over {_.._::int} and {_..<_::nat}
nipkow
parents:
32417
diff
changeset
|
4634 |
next |
46fc4d4ff4c0
code generator: quantifiers over {_.._::int} and {_..<_::nat}
nipkow
parents:
32417
diff
changeset
|
4635 |
assume R: ?R thus ?L using `?yes` 1 by auto |
46fc4d4ff4c0
code generator: quantifiers over {_.._::int} and {_..<_::nat}
nipkow
parents:
32417
diff
changeset
|
4636 |
qed |
46fc4d4ff4c0
code generator: quantifiers over {_.._::int} and {_..<_::nat}
nipkow
parents:
32417
diff
changeset
|
4637 |
finally show ?thesis . |
46fc4d4ff4c0
code generator: quantifiers over {_.._::int} and {_..<_::nat}
nipkow
parents:
32417
diff
changeset
|
4638 |
next |
46fc4d4ff4c0
code generator: quantifiers over {_.._::int} and {_..<_::nat}
nipkow
parents:
32417
diff
changeset
|
4639 |
assume "~?yes" thus ?thesis by(auto simp add: all_from_to_int.simps) |
46fc4d4ff4c0
code generator: quantifiers over {_.._::int} and {_..<_::nat}
nipkow
parents:
32417
diff
changeset
|
4640 |
qed |
46fc4d4ff4c0
code generator: quantifiers over {_.._::int} and {_..<_::nat}
nipkow
parents:
32417
diff
changeset
|
4641 |
qed |
46fc4d4ff4c0
code generator: quantifiers over {_.._::int} and {_..<_::nat}
nipkow
parents:
32417
diff
changeset
|
4642 |
|
46fc4d4ff4c0
code generator: quantifiers over {_.._::int} and {_..<_::nat}
nipkow
parents:
32417
diff
changeset
|
4643 |
lemma list_all_iff_all_from_to_int[code_unfold]: |
46fc4d4ff4c0
code generator: quantifiers over {_.._::int} and {_..<_::nat}
nipkow
parents:
32417
diff
changeset
|
4644 |
"list_all P [i..j] = all_from_to_int P i j" |
46fc4d4ff4c0
code generator: quantifiers over {_.._::int} and {_..<_::nat}
nipkow
parents:
32417
diff
changeset
|
4645 |
by(simp add: all_from_to_int_iff_ball list_all_iff) |
46fc4d4ff4c0
code generator: quantifiers over {_.._::int} and {_..<_::nat}
nipkow
parents:
32417
diff
changeset
|
4646 |
|
46fc4d4ff4c0
code generator: quantifiers over {_.._::int} and {_..<_::nat}
nipkow
parents:
32417
diff
changeset
|
4647 |
lemma list_ex_iff_not_all_from_to_not_int[code_unfold]: |
46fc4d4ff4c0
code generator: quantifiers over {_.._::int} and {_..<_::nat}
nipkow
parents:
32417
diff
changeset
|
4648 |
"list_ex P [i..j] = (~ all_from_to_int (%x. ~P x) i j)" |
46fc4d4ff4c0
code generator: quantifiers over {_.._::int} and {_..<_::nat}
nipkow
parents:
32417
diff
changeset
|
4649 |
by(simp add: all_from_to_int_iff_ball list_ex_iff) |
46fc4d4ff4c0
code generator: quantifiers over {_.._::int} and {_..<_::nat}
nipkow
parents:
32417
diff
changeset
|
4650 |
|
23388 | 4651 |
end |