author | haftmann |
Wed, 13 Feb 2013 13:38:52 +0100 | |
changeset 51096 | 60e4b75fefe1 |
parent 50548 | 0aec55e63795 |
child 51112 | da97167e03f7 |
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 |
44013
5cfc1c36ae97
moved recdef package to HOL/Library/Old_Recdef.thy
krauss
parents:
43594
diff
changeset
|
8 |
imports Plain Presburger Code_Numeral Quotient ATP |
15131 | 9 |
begin |
923 | 10 |
|
13142 | 11 |
datatype 'a list = |
13366 | 12 |
Nil ("[]") |
13 |
| Cons 'a "'a list" (infixr "#" 65) |
|
923 | 14 |
|
34941 | 15 |
syntax |
16 |
-- {* list Enumeration *} |
|
35115 | 17 |
"_list" :: "args => 'a list" ("[(_)]") |
34941 | 18 |
|
19 |
translations |
|
20 |
"[x, xs]" == "x#[xs]" |
|
21 |
"[x]" == "x#[]" |
|
22 |
||
35115 | 23 |
|
24 |
subsection {* Basic list processing functions *} |
|
15302 | 25 |
|
50548 | 26 |
primrec hd :: "'a list \<Rightarrow> 'a" where |
27 |
"hd (x # xs) = x" |
|
28 |
||
29 |
primrec tl :: "'a list \<Rightarrow> 'a list" where |
|
30 |
"tl [] = []" | |
|
31 |
"tl (x # xs) = xs" |
|
32 |
||
33 |
primrec last :: "'a list \<Rightarrow> 'a" where |
|
34 |
"last (x # xs) = (if xs = [] then x else last xs)" |
|
35 |
||
36 |
primrec butlast :: "'a list \<Rightarrow> 'a list" where |
|
37 |
"butlast []= []" | |
|
38 |
"butlast (x # xs) = (if xs = [] then [] else x # butlast xs)" |
|
39 |
||
40 |
primrec set :: "'a list \<Rightarrow> 'a set" where |
|
41 |
"set [] = {}" | |
|
42 |
"set (x # xs) = insert x (set xs)" |
|
43 |
||
44 |
definition coset :: "'a list \<Rightarrow> 'a set" where |
|
45 |
[simp]: "coset xs = - set xs" |
|
46 |
||
47 |
primrec map :: "('a \<Rightarrow> 'b) \<Rightarrow> 'a list \<Rightarrow> 'b list" where |
|
48 |
"map f [] = []" | |
|
49 |
"map f (x # xs) = f x # map f xs" |
|
50 |
||
51 |
primrec append :: "'a list \<Rightarrow> 'a list \<Rightarrow> 'a list" (infixr "@" 65) where |
|
52 |
append_Nil: "[] @ ys = ys" | |
|
53 |
append_Cons: "(x#xs) @ ys = x # xs @ ys" |
|
54 |
||
55 |
primrec rev :: "'a list \<Rightarrow> 'a list" where |
|
56 |
"rev [] = []" | |
|
57 |
"rev (x # xs) = rev xs @ [x]" |
|
58 |
||
59 |
primrec filter:: "('a \<Rightarrow> bool) \<Rightarrow> 'a list \<Rightarrow> 'a list" where |
|
60 |
"filter P [] = []" | |
|
61 |
"filter P (x # xs) = (if P x then x # filter P xs else filter P xs)" |
|
34941 | 62 |
|
63 |
syntax |
|
64 |
-- {* Special syntax for filter *} |
|
35115 | 65 |
"_filter" :: "[pttrn, 'a list, bool] => 'a list" ("(1[_<-_./ _])") |
34941 | 66 |
|
67 |
translations |
|
68 |
"[x<-xs . P]"== "CONST filter (%x. P) xs" |
|
69 |
||
70 |
syntax (xsymbols) |
|
35115 | 71 |
"_filter" :: "[pttrn, 'a list, bool] => 'a list"("(1[_\<leftarrow>_ ./ _])") |
34941 | 72 |
syntax (HTML output) |
35115 | 73 |
"_filter" :: "[pttrn, 'a list, bool] => 'a list"("(1[_\<leftarrow>_ ./ _])") |
34941 | 74 |
|
50548 | 75 |
primrec fold :: "('a \<Rightarrow> 'b \<Rightarrow> 'b) \<Rightarrow> 'a list \<Rightarrow> 'b \<Rightarrow> 'b" where |
76 |
fold_Nil: "fold f [] = id" | |
|
77 |
fold_Cons: "fold f (x # xs) = fold f xs \<circ> f x" |
|
78 |
||
79 |
primrec foldr :: "('a \<Rightarrow> 'b \<Rightarrow> 'b) \<Rightarrow> 'a list \<Rightarrow> 'b \<Rightarrow> 'b" where |
|
80 |
foldr_Nil: "foldr f [] = id" | |
|
81 |
foldr_Cons: "foldr f (x # xs) = f x \<circ> foldr f xs" |
|
82 |
||
83 |
primrec foldl :: "('b \<Rightarrow> 'a \<Rightarrow> 'b) \<Rightarrow> 'b \<Rightarrow> 'a list \<Rightarrow> 'b" where |
|
84 |
foldl_Nil: "foldl f a [] = a" | |
|
85 |
foldl_Cons: "foldl f a (x # xs) = foldl f (f a x) xs" |
|
86 |
||
87 |
primrec concat:: "'a list list \<Rightarrow> 'a list" where |
|
88 |
"concat [] = []" | |
|
89 |
"concat (x # xs) = x @ concat xs" |
|
90 |
||
91 |
definition (in monoid_add) listsum :: "'a list \<Rightarrow> 'a" where |
|
92 |
"listsum xs = foldr plus xs 0" |
|
93 |
||
94 |
primrec drop:: "nat \<Rightarrow> 'a list \<Rightarrow> 'a list" where |
|
95 |
drop_Nil: "drop n [] = []" | |
|
96 |
drop_Cons: "drop n (x # xs) = (case n of 0 \<Rightarrow> x # xs | Suc m \<Rightarrow> drop m xs)" |
|
34941 | 97 |
-- {*Warning: simpset does not contain this definition, but separate |
98 |
theorems for @{text "n = 0"} and @{text "n = Suc k"} *} |
|
99 |
||
50548 | 100 |
primrec take:: "nat \<Rightarrow> 'a list \<Rightarrow> 'a list" where |
101 |
take_Nil:"take n [] = []" | |
|
102 |
take_Cons: "take n (x # xs) = (case n of 0 \<Rightarrow> [] | Suc m \<Rightarrow> x # take m xs)" |
|
34941 | 103 |
-- {*Warning: simpset does not contain this definition, but separate |
104 |
theorems for @{text "n = 0"} and @{text "n = Suc k"} *} |
|
105 |
||
50548 | 106 |
primrec nth :: "'a list => nat => 'a" (infixl "!" 100) where |
107 |
nth_Cons: "(x # xs) ! n = (case n of 0 \<Rightarrow> x | Suc k \<Rightarrow> xs ! k)" |
|
34941 | 108 |
-- {*Warning: simpset does not contain this definition, but separate |
109 |
theorems for @{text "n = 0"} and @{text "n = Suc k"} *} |
|
110 |
||
50548 | 111 |
primrec list_update :: "'a list \<Rightarrow> nat \<Rightarrow> 'a \<Rightarrow> 'a list" where |
112 |
"list_update [] i v = []" | |
|
113 |
"list_update (x # xs) i v = |
|
114 |
(case i of 0 \<Rightarrow> v # xs | Suc j \<Rightarrow> x # list_update xs j v)" |
|
923 | 115 |
|
41229
d797baa3d57c
replaced command 'nonterminals' by slightly modernized version 'nonterminal';
wenzelm
parents:
41075
diff
changeset
|
116 |
nonterminal lupdbinds and lupdbind |
5077
71043526295f
* HOL/List: new function list_update written xs[i:=v] that updates the i-th
nipkow
parents:
4643
diff
changeset
|
117 |
|
923 | 118 |
syntax |
13366 | 119 |
"_lupdbind":: "['a, 'a] => lupdbind" ("(2_ :=/ _)") |
120 |
"" :: "lupdbind => lupdbinds" ("_") |
|
121 |
"_lupdbinds" :: "[lupdbind, lupdbinds] => lupdbinds" ("_,/ _") |
|
122 |
"_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
|
123 |
|
923 | 124 |
translations |
35115 | 125 |
"_LUpdate xs (_lupdbinds b bs)" == "_LUpdate (_LUpdate xs b) bs" |
34941 | 126 |
"xs[i:=x]" == "CONST list_update xs i x" |
127 |
||
50548 | 128 |
primrec takeWhile :: "('a \<Rightarrow> bool) \<Rightarrow> 'a list \<Rightarrow> 'a list" where |
129 |
"takeWhile P [] = []" | |
|
130 |
"takeWhile P (x # xs) = (if P x then x # takeWhile P xs else [])" |
|
131 |
||
132 |
primrec dropWhile :: "('a \<Rightarrow> bool) \<Rightarrow> 'a list \<Rightarrow> 'a list" where |
|
133 |
"dropWhile P [] = []" | |
|
134 |
"dropWhile P (x # xs) = (if P x then dropWhile P xs else x # xs)" |
|
135 |
||
136 |
primrec zip :: "'a list \<Rightarrow> 'b list \<Rightarrow> ('a \<times> 'b) list" where |
|
137 |
"zip xs [] = []" | |
|
138 |
zip_Cons: "zip xs (y # ys) = |
|
139 |
(case xs of [] => [] | z # zs => (z, y) # zip zs ys)" |
|
34941 | 140 |
-- {*Warning: simpset does not contain this definition, but separate |
141 |
theorems for @{text "xs = []"} and @{text "xs = z # zs"} *} |
|
142 |
||
50548 | 143 |
primrec product :: "'a list \<Rightarrow> 'b list \<Rightarrow> ('a \<times> 'b) list" where |
144 |
"product [] _ = []" | |
|
145 |
"product (x#xs) ys = map (Pair x) ys @ product xs ys" |
|
49948
744934b818c7
moved quite generic material from theory Enum to more appropriate places
haftmann
parents:
49808
diff
changeset
|
146 |
|
744934b818c7
moved quite generic material from theory Enum to more appropriate places
haftmann
parents:
49808
diff
changeset
|
147 |
hide_const (open) product |
744934b818c7
moved quite generic material from theory Enum to more appropriate places
haftmann
parents:
49808
diff
changeset
|
148 |
|
50548 | 149 |
primrec upt :: "nat \<Rightarrow> nat \<Rightarrow> nat list" ("(1[_..</_'])") where |
150 |
upt_0: "[i..<0] = []" | |
|
151 |
upt_Suc: "[i..<(Suc j)] = (if i <= j then [i..<j] @ [j] else [])" |
|
152 |
||
153 |
definition insert :: "'a \<Rightarrow> 'a list \<Rightarrow> 'a list" where |
|
154 |
"insert x xs = (if x \<in> set xs then xs else x # xs)" |
|
34978
874150ddd50a
canonical insert operation; generalized lemma foldl_apply_inv to foldl_apply
haftmann
parents:
34942
diff
changeset
|
155 |
|
36176
3fe7e97ccca8
replaced generic 'hide' command by more conventional 'hide_class', 'hide_type', 'hide_const', 'hide_fact' -- frees some popular keywords;
wenzelm
parents:
36154
diff
changeset
|
156 |
hide_const (open) insert |
3fe7e97ccca8
replaced generic 'hide' command by more conventional 'hide_class', 'hide_type', 'hide_const', 'hide_fact' -- frees some popular keywords;
wenzelm
parents:
36154
diff
changeset
|
157 |
hide_fact (open) insert_def |
34978
874150ddd50a
canonical insert operation; generalized lemma foldl_apply_inv to foldl_apply
haftmann
parents:
34942
diff
changeset
|
158 |
|
47122 | 159 |
primrec find :: "('a \<Rightarrow> bool) \<Rightarrow> 'a list \<Rightarrow> 'a option" where |
50548 | 160 |
"find _ [] = None" | |
161 |
"find P (x#xs) = (if P x then Some x else find P xs)" |
|
47122 | 162 |
|
163 |
hide_const (open) find |
|
164 |
||
51096 | 165 |
primrec those :: "'a option list \<Rightarrow> 'a list option" |
166 |
where |
|
167 |
"those [] = Some []" | |
|
168 |
"those (x # xs) = (case x of |
|
169 |
None \<Rightarrow> None |
|
170 |
| Some y \<Rightarrow> Option.map (Cons y) (those xs))" |
|
171 |
||
50548 | 172 |
primrec remove1 :: "'a \<Rightarrow> 'a list \<Rightarrow> 'a list" where |
173 |
"remove1 x [] = []" | |
|
174 |
"remove1 x (y # xs) = (if x = y then xs else y # remove1 x xs)" |
|
175 |
||
176 |
primrec removeAll :: "'a \<Rightarrow> 'a list \<Rightarrow> 'a list" where |
|
177 |
"removeAll x [] = []" | |
|
178 |
"removeAll x (y # xs) = (if x = y then removeAll x xs else y # removeAll x xs)" |
|
179 |
||
180 |
primrec distinct :: "'a list \<Rightarrow> bool" where |
|
181 |
"distinct [] \<longleftrightarrow> True" | |
|
182 |
"distinct (x # xs) \<longleftrightarrow> x \<notin> set xs \<and> distinct xs" |
|
183 |
||
184 |
primrec remdups :: "'a list \<Rightarrow> 'a list" where |
|
185 |
"remdups [] = []" | |
|
186 |
"remdups (x # xs) = (if x \<in> set xs then remdups xs else x # remdups xs)" |
|
187 |
||
188 |
primrec replicate :: "nat \<Rightarrow> 'a \<Rightarrow> 'a list" where |
|
189 |
replicate_0: "replicate 0 x = []" | |
|
190 |
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
|
191 |
|
13142 | 192 |
text {* |
14589 | 193 |
Function @{text size} is overloaded for all datatypes. Users may |
13366 | 194 |
refer to the list version as @{text length}. *} |
13142 | 195 |
|
50548 | 196 |
abbreviation length :: "'a list \<Rightarrow> nat" where |
197 |
"length \<equiv> size" |
|
15307 | 198 |
|
46440
d4994e2e7364
use 'primrec' to define "rotate1", for uniformity (and to help first-order tools that rely on "Spec_Rules")
blanchet
parents:
46439
diff
changeset
|
199 |
primrec rotate1 :: "'a list \<Rightarrow> 'a list" where |
50548 | 200 |
"rotate1 [] = []" | |
201 |
"rotate1 (x # xs) = xs @ [x]" |
|
202 |
||
203 |
definition rotate :: "nat \<Rightarrow> 'a list \<Rightarrow> 'a list" where |
|
204 |
"rotate n = rotate1 ^^ n" |
|
205 |
||
206 |
definition list_all2 :: "('a \<Rightarrow> 'b \<Rightarrow> bool) \<Rightarrow> 'a list \<Rightarrow> 'b list \<Rightarrow> bool" where |
|
207 |
"list_all2 P xs ys = |
|
208 |
(length xs = length ys \<and> (\<forall>(x, y) \<in> set (zip xs ys). P x y))" |
|
209 |
||
210 |
definition sublist :: "'a list => nat set => 'a list" where |
|
211 |
"sublist xs A = map fst (filter (\<lambda>p. snd p \<in> A) (zip xs [0..<size xs]))" |
|
212 |
||
213 |
primrec sublists :: "'a list \<Rightarrow> 'a list list" where |
|
214 |
"sublists [] = [[]]" | |
|
215 |
"sublists (x#xs) = (let xss = sublists xs in map (Cons x) xss @ xss)" |
|
216 |
||
217 |
primrec n_lists :: "nat \<Rightarrow> 'a list \<Rightarrow> 'a list list" where |
|
218 |
"n_lists 0 xs = [[]]" | |
|
219 |
"n_lists (Suc n) xs = concat (map (\<lambda>ys. map (\<lambda>y. y # ys) xs) (n_lists n xs))" |
|
49948
744934b818c7
moved quite generic material from theory Enum to more appropriate places
haftmann
parents:
49808
diff
changeset
|
220 |
|
744934b818c7
moved quite generic material from theory Enum to more appropriate places
haftmann
parents:
49808
diff
changeset
|
221 |
hide_const (open) n_lists |
744934b818c7
moved quite generic material from theory Enum to more appropriate places
haftmann
parents:
49808
diff
changeset
|
222 |
|
40593
1e57b18d27b1
code eqn for slice was missing; redefined splice with fun
nipkow
parents:
40365
diff
changeset
|
223 |
fun splice :: "'a list \<Rightarrow> 'a list \<Rightarrow> 'a list" where |
1e57b18d27b1
code eqn for slice was missing; redefined splice with fun
nipkow
parents:
40365
diff
changeset
|
224 |
"splice [] ys = ys" | |
1e57b18d27b1
code eqn for slice was missing; redefined splice with fun
nipkow
parents:
40365
diff
changeset
|
225 |
"splice xs [] = xs" | |
1e57b18d27b1
code eqn for slice was missing; redefined splice with fun
nipkow
parents:
40365
diff
changeset
|
226 |
"splice (x#xs) (y#ys) = x # y # splice xs ys" |
21061
580dfc999ef6
added normal post setup; cleaned up "execution" constants
haftmann
parents:
21046
diff
changeset
|
227 |
|
26771 | 228 |
text{* |
229 |
\begin{figure}[htbp] |
|
230 |
\fbox{ |
|
231 |
\begin{tabular}{l} |
|
27381 | 232 |
@{lemma "[a,b]@[c,d] = [a,b,c,d]" by simp}\\ |
233 |
@{lemma "length [a,b,c] = 3" by simp}\\ |
|
234 |
@{lemma "set [a,b,c] = {a,b,c}" by simp}\\ |
|
235 |
@{lemma "map f [a,b,c] = [f a, f b, f c]" by simp}\\ |
|
236 |
@{lemma "rev [a,b,c] = [c,b,a]" by simp}\\ |
|
237 |
@{lemma "hd [a,b,c,d] = a" by simp}\\ |
|
238 |
@{lemma "tl [a,b,c,d] = [b,c,d]" by simp}\\ |
|
239 |
@{lemma "last [a,b,c,d] = d" by simp}\\ |
|
240 |
@{lemma "butlast [a,b,c,d] = [a,b,c]" by simp}\\ |
|
241 |
@{lemma[source] "filter (\<lambda>n::nat. n<2) [0,2,1] = [0,1]" by simp}\\ |
|
242 |
@{lemma "concat [[a,b],[c,d,e],[],[f]] = [a,b,c,d,e,f]" by simp}\\ |
|
46133
d9fe85d3d2cd
incorporated canonical fold combinator on lists into body of List theory; refactored passages on List.fold(l/r)
haftmann
parents:
46125
diff
changeset
|
243 |
@{lemma "fold f [a,b,c] x = f c (f b (f a x))" by simp}\\ |
47397
d654c73e4b12
no preference wrt. fold(l/r); prefer fold rather than foldr for iterating over lists in generated code
haftmann
parents:
47131
diff
changeset
|
244 |
@{lemma "foldr f [a,b,c] x = f a (f b (f c x))" by simp}\\ |
d654c73e4b12
no preference wrt. fold(l/r); prefer fold rather than foldr for iterating over lists in generated code
haftmann
parents:
47131
diff
changeset
|
245 |
@{lemma "foldl f x [a,b,c] = f (f (f x a) b) c" by simp}\\ |
27381 | 246 |
@{lemma "zip [a,b,c] [x,y,z] = [(a,x),(b,y),(c,z)]" by simp}\\ |
247 |
@{lemma "zip [a,b] [x,y,z] = [(a,x),(b,y)]" by simp}\\ |
|
49948
744934b818c7
moved quite generic material from theory Enum to more appropriate places
haftmann
parents:
49808
diff
changeset
|
248 |
@{lemma "List.product [a,b] [c,d] = [(a, c), (a, d), (b, c), (b, d)]" by simp}\\ |
27381 | 249 |
@{lemma "splice [a,b,c] [x,y,z] = [a,x,b,y,c,z]" by simp}\\ |
250 |
@{lemma "splice [a,b,c,d] [x,y] = [a,x,b,y,c,d]" by simp}\\ |
|
251 |
@{lemma "take 2 [a,b,c,d] = [a,b]" by simp}\\ |
|
252 |
@{lemma "take 6 [a,b,c,d] = [a,b,c,d]" by simp}\\ |
|
253 |
@{lemma "drop 2 [a,b,c,d] = [c,d]" by simp}\\ |
|
254 |
@{lemma "drop 6 [a,b,c,d] = []" by simp}\\ |
|
255 |
@{lemma "takeWhile (%n::nat. n<3) [1,2,3,0] = [1,2]" by simp}\\ |
|
256 |
@{lemma "dropWhile (%n::nat. n<3) [1,2,3,0] = [3,0]" by simp}\\ |
|
257 |
@{lemma "distinct [2,0,1::nat]" by simp}\\ |
|
258 |
@{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
|
259 |
@{lemma "List.insert 2 [0::nat,1,2] = [0,1,2]" by (simp add: List.insert_def)}\\ |
35295 | 260 |
@{lemma "List.insert 3 [0::nat,1,2] = [3,0,1,2]" by (simp add: List.insert_def)}\\ |
47122 | 261 |
@{lemma "List.find (%i::int. i>0) [0,0] = None" by simp}\\ |
262 |
@{lemma "List.find (%i::int. i>0) [0,1,0,2] = Some 1" by simp}\\ |
|
27381 | 263 |
@{lemma "remove1 2 [2,0,2,1::nat,2] = [0,2,1,2]" by simp}\\ |
27693 | 264 |
@{lemma "removeAll 2 [2,0,2,1::nat,2] = [0,1]" by simp}\\ |
27381 | 265 |
@{lemma "nth [a,b,c,d] 2 = c" by simp}\\ |
266 |
@{lemma "[a,b,c,d][2 := x] = [a,b,x,d]" by simp}\\ |
|
267 |
@{lemma "sublist [a,b,c,d,e] {0,2,3} = [a,c,d]" by (simp add:sublist_def)}\\ |
|
49948
744934b818c7
moved quite generic material from theory Enum to more appropriate places
haftmann
parents:
49808
diff
changeset
|
268 |
@{lemma "sublists [a,b] = [[a, b], [a], [b], []]" by simp}\\ |
744934b818c7
moved quite generic material from theory Enum to more appropriate places
haftmann
parents:
49808
diff
changeset
|
269 |
@{lemma "List.n_lists 2 [a,b,c] = [[a, a], [b, a], [c, a], [a, b], [b, b], [c, b], [a, c], [b, c], [c, c]]" by (simp add: eval_nat_numeral)}\\ |
46440
d4994e2e7364
use 'primrec' to define "rotate1", for uniformity (and to help first-order tools that rely on "Spec_Rules")
blanchet
parents:
46439
diff
changeset
|
270 |
@{lemma "rotate1 [a,b,c,d] = [b,c,d,a]" by simp}\\ |
d4994e2e7364
use 'primrec' to define "rotate1", for uniformity (and to help first-order tools that rely on "Spec_Rules")
blanchet
parents:
46439
diff
changeset
|
271 |
@{lemma "rotate 3 [a,b,c,d] = [d,a,b,c]" by (simp add:rotate_def eval_nat_numeral)}\\ |
40077 | 272 |
@{lemma "replicate 4 a = [a,a,a,a]" by (simp add:eval_nat_numeral)}\\ |
273 |
@{lemma "[2..<5] = [2,3,4]" by (simp add:eval_nat_numeral)}\\ |
|
47397
d654c73e4b12
no preference wrt. fold(l/r); prefer fold rather than foldr for iterating over lists in generated code
haftmann
parents:
47131
diff
changeset
|
274 |
@{lemma "listsum [1,2,3::nat] = 6" by (simp add: listsum_def)} |
26771 | 275 |
\end{tabular}} |
276 |
\caption{Characteristic examples} |
|
277 |
\label{fig:Characteristic} |
|
278 |
\end{figure} |
|
29927 | 279 |
Figure~\ref{fig:Characteristic} shows characteristic examples |
26771 | 280 |
that should give an intuitive understanding of the above functions. |
281 |
*} |
|
282 |
||
24616 | 283 |
text{* The following simple sort functions are intended for proofs, |
284 |
not for efficient implementations. *} |
|
285 |
||
25221
5ded95dda5df
append/member: more light-weight way to declare authentic syntax;
wenzelm
parents:
25215
diff
changeset
|
286 |
context linorder |
5ded95dda5df
append/member: more light-weight way to declare authentic syntax;
wenzelm
parents:
25215
diff
changeset
|
287 |
begin |
5ded95dda5df
append/member: more light-weight way to declare authentic syntax;
wenzelm
parents:
25215
diff
changeset
|
288 |
|
39915
ecf97cf3d248
turned distinct and sorted into inductive predicates: yields nice induction principles for free; more elegant proofs
haftmann
parents:
39774
diff
changeset
|
289 |
inductive sorted :: "'a list \<Rightarrow> bool" where |
ecf97cf3d248
turned distinct and sorted into inductive predicates: yields nice induction principles for free; more elegant proofs
haftmann
parents:
39774
diff
changeset
|
290 |
Nil [iff]: "sorted []" |
ecf97cf3d248
turned distinct and sorted into inductive predicates: yields nice induction principles for free; more elegant proofs
haftmann
parents:
39774
diff
changeset
|
291 |
| Cons: "\<forall>y\<in>set xs. x \<le> y \<Longrightarrow> sorted xs \<Longrightarrow> sorted (x # xs)" |
ecf97cf3d248
turned distinct and sorted into inductive predicates: yields nice induction principles for free; more elegant proofs
haftmann
parents:
39774
diff
changeset
|
292 |
|
ecf97cf3d248
turned distinct and sorted into inductive predicates: yields nice induction principles for free; more elegant proofs
haftmann
parents:
39774
diff
changeset
|
293 |
lemma sorted_single [iff]: |
ecf97cf3d248
turned distinct and sorted into inductive predicates: yields nice induction principles for free; more elegant proofs
haftmann
parents:
39774
diff
changeset
|
294 |
"sorted [x]" |
ecf97cf3d248
turned distinct and sorted into inductive predicates: yields nice induction principles for free; more elegant proofs
haftmann
parents:
39774
diff
changeset
|
295 |
by (rule sorted.Cons) auto |
ecf97cf3d248
turned distinct and sorted into inductive predicates: yields nice induction principles for free; more elegant proofs
haftmann
parents:
39774
diff
changeset
|
296 |
|
ecf97cf3d248
turned distinct and sorted into inductive predicates: yields nice induction principles for free; more elegant proofs
haftmann
parents:
39774
diff
changeset
|
297 |
lemma sorted_many: |
ecf97cf3d248
turned distinct and sorted into inductive predicates: yields nice induction principles for free; more elegant proofs
haftmann
parents:
39774
diff
changeset
|
298 |
"x \<le> y \<Longrightarrow> sorted (y # zs) \<Longrightarrow> sorted (x # y # zs)" |
ecf97cf3d248
turned distinct and sorted into inductive predicates: yields nice induction principles for free; more elegant proofs
haftmann
parents:
39774
diff
changeset
|
299 |
by (rule sorted.Cons) (cases "y # zs" rule: sorted.cases, auto) |
ecf97cf3d248
turned distinct and sorted into inductive predicates: yields nice induction principles for free; more elegant proofs
haftmann
parents:
39774
diff
changeset
|
300 |
|
ecf97cf3d248
turned distinct and sorted into inductive predicates: yields nice induction principles for free; more elegant proofs
haftmann
parents:
39774
diff
changeset
|
301 |
lemma sorted_many_eq [simp, code]: |
ecf97cf3d248
turned distinct and sorted into inductive predicates: yields nice induction principles for free; more elegant proofs
haftmann
parents:
39774
diff
changeset
|
302 |
"sorted (x # y # zs) \<longleftrightarrow> x \<le> y \<and> sorted (y # zs)" |
ecf97cf3d248
turned distinct and sorted into inductive predicates: yields nice induction principles for free; more elegant proofs
haftmann
parents:
39774
diff
changeset
|
303 |
by (auto intro: sorted_many elim: sorted.cases) |
ecf97cf3d248
turned distinct and sorted into inductive predicates: yields nice induction principles for free; more elegant proofs
haftmann
parents:
39774
diff
changeset
|
304 |
|
ecf97cf3d248
turned distinct and sorted into inductive predicates: yields nice induction principles for free; more elegant proofs
haftmann
parents:
39774
diff
changeset
|
305 |
lemma [code]: |
ecf97cf3d248
turned distinct and sorted into inductive predicates: yields nice induction principles for free; more elegant proofs
haftmann
parents:
39774
diff
changeset
|
306 |
"sorted [] \<longleftrightarrow> True" |
ecf97cf3d248
turned distinct and sorted into inductive predicates: yields nice induction principles for free; more elegant proofs
haftmann
parents:
39774
diff
changeset
|
307 |
"sorted [x] \<longleftrightarrow> True" |
ecf97cf3d248
turned distinct and sorted into inductive predicates: yields nice induction principles for free; more elegant proofs
haftmann
parents:
39774
diff
changeset
|
308 |
by simp_all |
24697 | 309 |
|
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
|
310 |
primrec insort_key :: "('b \<Rightarrow> 'a) \<Rightarrow> 'b \<Rightarrow> 'b list \<Rightarrow> 'b list" where |
50548 | 311 |
"insort_key f x [] = [x]" | |
312 |
"insort_key f x (y#ys) = |
|
313 |
(if f x \<le> f y then (x#y#ys) else y#(insort_key f x ys))" |
|
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
|
314 |
|
35195 | 315 |
definition sort_key :: "('b \<Rightarrow> 'a) \<Rightarrow> 'b list \<Rightarrow> 'b list" where |
50548 | 316 |
"sort_key f xs = foldr (insort_key f) 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
|
317 |
|
40210
aee7ef725330
sorting: avoid _key suffix if lemma applies both to simple and generalized variant; generalized insort_insert to insort_insert_key; additional lemmas
haftmann
parents:
40195
diff
changeset
|
318 |
definition insort_insert_key :: "('b \<Rightarrow> 'a) \<Rightarrow> 'b \<Rightarrow> 'b list \<Rightarrow> 'b list" where |
50548 | 319 |
"insort_insert_key f x xs = |
320 |
(if f x \<in> f ` set xs then xs else insort_key f x xs)" |
|
40210
aee7ef725330
sorting: avoid _key suffix if lemma applies both to simple and generalized variant; generalized insort_insert to insort_insert_key; additional lemmas
haftmann
parents:
40195
diff
changeset
|
321 |
|
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
|
322 |
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
|
323 |
abbreviation "insort \<equiv> insort_key (\<lambda>x. x)" |
40210
aee7ef725330
sorting: avoid _key suffix if lemma applies both to simple and generalized variant; generalized insort_insert to insort_insert_key; additional lemmas
haftmann
parents:
40195
diff
changeset
|
324 |
abbreviation "insort_insert \<equiv> insort_insert_key (\<lambda>x. x)" |
35608 | 325 |
|
25221
5ded95dda5df
append/member: more light-weight way to declare authentic syntax;
wenzelm
parents:
25215
diff
changeset
|
326 |
end |
5ded95dda5df
append/member: more light-weight way to declare authentic syntax;
wenzelm
parents:
25215
diff
changeset
|
327 |
|
24616 | 328 |
|
23388 | 329 |
subsubsection {* List comprehension *} |
23192 | 330 |
|
24349 | 331 |
text{* Input syntax for Haskell-like list comprehension notation. |
332 |
Typical example: @{text"[(x,y). x \<leftarrow> xs, y \<leftarrow> ys, x \<noteq> y]"}, |
|
333 |
the list of all pairs of distinct elements from @{text xs} and @{text ys}. |
|
334 |
The syntax is as in Haskell, except that @{text"|"} becomes a dot |
|
335 |
(like in Isabelle's set comprehension): @{text"[e. x \<leftarrow> xs, \<dots>]"} rather than |
|
336 |
\verb![e| x <- xs, ...]!. |
|
337 |
||
338 |
The qualifiers after the dot are |
|
339 |
\begin{description} |
|
340 |
\item[generators] @{text"p \<leftarrow> xs"}, |
|
24476
f7ad9fbbeeaa
turned list comprehension translations into ML to optimize base case
nipkow
parents:
24471
diff
changeset
|
341 |
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
|
342 |
\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
|
343 |
%\item[local bindings] @ {text"let x = e"}. |
24349 | 344 |
\end{description} |
23240 | 345 |
|
24476
f7ad9fbbeeaa
turned list comprehension translations into ML to optimize base case
nipkow
parents:
24471
diff
changeset
|
346 |
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
|
347 |
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
|
348 |
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
|
349 |
optmized to @{term"map (%x. e) xs"}. |
23240 | 350 |
|
24349 | 351 |
It is easy to write short list comprehensions which stand for complex |
352 |
expressions. During proofs, they may become unreadable (and |
|
353 |
mangled). In such cases it can be advisable to introduce separate |
|
354 |
definitions for the list comprehensions in question. *} |
|
355 |
||
46138
85f8d8a8c711
improved list comprehension syntax: more careful treatment of position constraints, which enables PIDE markup;
wenzelm
parents:
46133
diff
changeset
|
356 |
nonterminal lc_qual and lc_quals |
23192 | 357 |
|
358 |
syntax |
|
46138
85f8d8a8c711
improved list comprehension syntax: more careful treatment of position constraints, which enables PIDE markup;
wenzelm
parents:
46133
diff
changeset
|
359 |
"_listcompr" :: "'a \<Rightarrow> lc_qual \<Rightarrow> lc_quals \<Rightarrow> 'a list" ("[_ . __") |
85f8d8a8c711
improved list comprehension syntax: more careful treatment of position constraints, which enables PIDE markup;
wenzelm
parents:
46133
diff
changeset
|
360 |
"_lc_gen" :: "'a \<Rightarrow> 'a list \<Rightarrow> lc_qual" ("_ <- _") |
85f8d8a8c711
improved list comprehension syntax: more careful treatment of position constraints, which enables PIDE markup;
wenzelm
parents:
46133
diff
changeset
|
361 |
"_lc_test" :: "bool \<Rightarrow> lc_qual" ("_") |
85f8d8a8c711
improved list comprehension syntax: more careful treatment of position constraints, which enables PIDE markup;
wenzelm
parents:
46133
diff
changeset
|
362 |
(*"_lc_let" :: "letbinds => lc_qual" ("let _")*) |
85f8d8a8c711
improved list comprehension syntax: more careful treatment of position constraints, which enables PIDE markup;
wenzelm
parents:
46133
diff
changeset
|
363 |
"_lc_end" :: "lc_quals" ("]") |
85f8d8a8c711
improved list comprehension syntax: more careful treatment of position constraints, which enables PIDE markup;
wenzelm
parents:
46133
diff
changeset
|
364 |
"_lc_quals" :: "lc_qual \<Rightarrow> lc_quals \<Rightarrow> lc_quals" (", __") |
85f8d8a8c711
improved list comprehension syntax: more careful treatment of position constraints, which enables PIDE markup;
wenzelm
parents:
46133
diff
changeset
|
365 |
"_lc_abs" :: "'a => 'b list => 'b list" |
23192 | 366 |
|
24476
f7ad9fbbeeaa
turned list comprehension translations into ML to optimize base case
nipkow
parents:
24471
diff
changeset
|
367 |
(* 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
|
368 |
translation of [e. p<-xs] |
23192 | 369 |
translations |
46138
85f8d8a8c711
improved list comprehension syntax: more careful treatment of position constraints, which enables PIDE markup;
wenzelm
parents:
46133
diff
changeset
|
370 |
"[e. p<-xs]" => "concat(map (_lc_abs p [e]) xs)" |
85f8d8a8c711
improved list comprehension syntax: more careful treatment of position constraints, which enables PIDE markup;
wenzelm
parents:
46133
diff
changeset
|
371 |
"_listcompr e (_lc_gen p xs) (_lc_quals Q Qs)" |
85f8d8a8c711
improved list comprehension syntax: more careful treatment of position constraints, which enables PIDE markup;
wenzelm
parents:
46133
diff
changeset
|
372 |
=> "concat (map (_lc_abs p (_listcompr e Q Qs)) xs)" |
85f8d8a8c711
improved list comprehension syntax: more careful treatment of position constraints, which enables PIDE markup;
wenzelm
parents:
46133
diff
changeset
|
373 |
"[e. P]" => "if P then [e] else []" |
85f8d8a8c711
improved list comprehension syntax: more careful treatment of position constraints, which enables PIDE markup;
wenzelm
parents:
46133
diff
changeset
|
374 |
"_listcompr e (_lc_test P) (_lc_quals Q Qs)" |
85f8d8a8c711
improved list comprehension syntax: more careful treatment of position constraints, which enables PIDE markup;
wenzelm
parents:
46133
diff
changeset
|
375 |
=> "if P then (_listcompr e Q Qs) else []" |
85f8d8a8c711
improved list comprehension syntax: more careful treatment of position constraints, which enables PIDE markup;
wenzelm
parents:
46133
diff
changeset
|
376 |
"_listcompr e (_lc_let b) (_lc_quals Q Qs)" |
85f8d8a8c711
improved list comprehension syntax: more careful treatment of position constraints, which enables PIDE markup;
wenzelm
parents:
46133
diff
changeset
|
377 |
=> "_Let b (_listcompr e Q Qs)" |
24476
f7ad9fbbeeaa
turned list comprehension translations into ML to optimize base case
nipkow
parents:
24471
diff
changeset
|
378 |
*) |
23240 | 379 |
|
23279
e39dd93161d9
tuned list comprehension, changed filter syntax from : to <-
nipkow
parents:
23246
diff
changeset
|
380 |
syntax (xsymbols) |
46138
85f8d8a8c711
improved list comprehension syntax: more careful treatment of position constraints, which enables PIDE markup;
wenzelm
parents:
46133
diff
changeset
|
381 |
"_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
|
382 |
syntax (HTML output) |
46138
85f8d8a8c711
improved list comprehension syntax: more careful treatment of position constraints, which enables PIDE markup;
wenzelm
parents:
46133
diff
changeset
|
383 |
"_lc_gen" :: "'a \<Rightarrow> 'a list \<Rightarrow> lc_qual" ("_ \<leftarrow> _") |
24349 | 384 |
|
385 |
parse_translation (advanced) {* |
|
46138
85f8d8a8c711
improved list comprehension syntax: more careful treatment of position constraints, which enables PIDE markup;
wenzelm
parents:
46133
diff
changeset
|
386 |
let |
85f8d8a8c711
improved list comprehension syntax: more careful treatment of position constraints, which enables PIDE markup;
wenzelm
parents:
46133
diff
changeset
|
387 |
val NilC = Syntax.const @{const_syntax Nil}; |
85f8d8a8c711
improved list comprehension syntax: more careful treatment of position constraints, which enables PIDE markup;
wenzelm
parents:
46133
diff
changeset
|
388 |
val ConsC = Syntax.const @{const_syntax Cons}; |
85f8d8a8c711
improved list comprehension syntax: more careful treatment of position constraints, which enables PIDE markup;
wenzelm
parents:
46133
diff
changeset
|
389 |
val mapC = Syntax.const @{const_syntax map}; |
85f8d8a8c711
improved list comprehension syntax: more careful treatment of position constraints, which enables PIDE markup;
wenzelm
parents:
46133
diff
changeset
|
390 |
val concatC = Syntax.const @{const_syntax concat}; |
85f8d8a8c711
improved list comprehension syntax: more careful treatment of position constraints, which enables PIDE markup;
wenzelm
parents:
46133
diff
changeset
|
391 |
val IfC = Syntax.const @{const_syntax If}; |
85f8d8a8c711
improved list comprehension syntax: more careful treatment of position constraints, which enables PIDE markup;
wenzelm
parents:
46133
diff
changeset
|
392 |
|
85f8d8a8c711
improved list comprehension syntax: more careful treatment of position constraints, which enables PIDE markup;
wenzelm
parents:
46133
diff
changeset
|
393 |
fun single x = ConsC $ x $ NilC; |
85f8d8a8c711
improved list comprehension syntax: more careful treatment of position constraints, which enables PIDE markup;
wenzelm
parents:
46133
diff
changeset
|
394 |
|
85f8d8a8c711
improved list comprehension syntax: more careful treatment of position constraints, which enables PIDE markup;
wenzelm
parents:
46133
diff
changeset
|
395 |
fun pat_tr ctxt p e opti = (* %x. case x of p => e | _ => [] *) |
85f8d8a8c711
improved list comprehension syntax: more careful treatment of position constraints, which enables PIDE markup;
wenzelm
parents:
46133
diff
changeset
|
396 |
let |
85f8d8a8c711
improved list comprehension syntax: more careful treatment of position constraints, which enables PIDE markup;
wenzelm
parents:
46133
diff
changeset
|
397 |
(* FIXME proper name context!? *) |
85f8d8a8c711
improved list comprehension syntax: more careful treatment of position constraints, which enables PIDE markup;
wenzelm
parents:
46133
diff
changeset
|
398 |
val x = |
85f8d8a8c711
improved list comprehension syntax: more careful treatment of position constraints, which enables PIDE markup;
wenzelm
parents:
46133
diff
changeset
|
399 |
Free (singleton (Name.variant_list (fold Term.add_free_names [p, e] [])) "x", dummyT); |
85f8d8a8c711
improved list comprehension syntax: more careful treatment of position constraints, which enables PIDE markup;
wenzelm
parents:
46133
diff
changeset
|
400 |
val e = if opti then single e else e; |
85f8d8a8c711
improved list comprehension syntax: more careful treatment of position constraints, which enables PIDE markup;
wenzelm
parents:
46133
diff
changeset
|
401 |
val case1 = Syntax.const @{syntax_const "_case1"} $ p $ e; |
85f8d8a8c711
improved list comprehension syntax: more careful treatment of position constraints, which enables PIDE markup;
wenzelm
parents:
46133
diff
changeset
|
402 |
val case2 = |
85f8d8a8c711
improved list comprehension syntax: more careful treatment of position constraints, which enables PIDE markup;
wenzelm
parents:
46133
diff
changeset
|
403 |
Syntax.const @{syntax_const "_case1"} $ |
85f8d8a8c711
improved list comprehension syntax: more careful treatment of position constraints, which enables PIDE markup;
wenzelm
parents:
46133
diff
changeset
|
404 |
Syntax.const @{const_syntax dummy_pattern} $ NilC; |
85f8d8a8c711
improved list comprehension syntax: more careful treatment of position constraints, which enables PIDE markup;
wenzelm
parents:
46133
diff
changeset
|
405 |
val cs = Syntax.const @{syntax_const "_case2"} $ case1 $ case2; |
85f8d8a8c711
improved list comprehension syntax: more careful treatment of position constraints, which enables PIDE markup;
wenzelm
parents:
46133
diff
changeset
|
406 |
in Syntax_Trans.abs_tr [x, Datatype_Case.case_tr false ctxt [x, cs]] end; |
85f8d8a8c711
improved list comprehension syntax: more careful treatment of position constraints, which enables PIDE markup;
wenzelm
parents:
46133
diff
changeset
|
407 |
|
85f8d8a8c711
improved list comprehension syntax: more careful treatment of position constraints, which enables PIDE markup;
wenzelm
parents:
46133
diff
changeset
|
408 |
fun abs_tr ctxt p e opti = |
85f8d8a8c711
improved list comprehension syntax: more careful treatment of position constraints, which enables PIDE markup;
wenzelm
parents:
46133
diff
changeset
|
409 |
(case Term_Position.strip_positions p of |
85f8d8a8c711
improved list comprehension syntax: more careful treatment of position constraints, which enables PIDE markup;
wenzelm
parents:
46133
diff
changeset
|
410 |
Free (s, T) => |
85f8d8a8c711
improved list comprehension syntax: more careful treatment of position constraints, which enables PIDE markup;
wenzelm
parents:
46133
diff
changeset
|
411 |
let |
85f8d8a8c711
improved list comprehension syntax: more careful treatment of position constraints, which enables PIDE markup;
wenzelm
parents:
46133
diff
changeset
|
412 |
val thy = Proof_Context.theory_of ctxt; |
85f8d8a8c711
improved list comprehension syntax: more careful treatment of position constraints, which enables PIDE markup;
wenzelm
parents:
46133
diff
changeset
|
413 |
val s' = Proof_Context.intern_const ctxt s; |
85f8d8a8c711
improved list comprehension syntax: more careful treatment of position constraints, which enables PIDE markup;
wenzelm
parents:
46133
diff
changeset
|
414 |
in |
85f8d8a8c711
improved list comprehension syntax: more careful treatment of position constraints, which enables PIDE markup;
wenzelm
parents:
46133
diff
changeset
|
415 |
if Sign.declared_const thy s' |
85f8d8a8c711
improved list comprehension syntax: more careful treatment of position constraints, which enables PIDE markup;
wenzelm
parents:
46133
diff
changeset
|
416 |
then (pat_tr ctxt p e opti, false) |
85f8d8a8c711
improved list comprehension syntax: more careful treatment of position constraints, which enables PIDE markup;
wenzelm
parents:
46133
diff
changeset
|
417 |
else (Syntax_Trans.abs_tr [p, e], true) |
85f8d8a8c711
improved list comprehension syntax: more careful treatment of position constraints, which enables PIDE markup;
wenzelm
parents:
46133
diff
changeset
|
418 |
end |
85f8d8a8c711
improved list comprehension syntax: more careful treatment of position constraints, which enables PIDE markup;
wenzelm
parents:
46133
diff
changeset
|
419 |
| _ => (pat_tr ctxt p e opti, false)); |
85f8d8a8c711
improved list comprehension syntax: more careful treatment of position constraints, which enables PIDE markup;
wenzelm
parents:
46133
diff
changeset
|
420 |
|
85f8d8a8c711
improved list comprehension syntax: more careful treatment of position constraints, which enables PIDE markup;
wenzelm
parents:
46133
diff
changeset
|
421 |
fun lc_tr ctxt [e, Const (@{syntax_const "_lc_test"}, _) $ b, qs] = |
85f8d8a8c711
improved list comprehension syntax: more careful treatment of position constraints, which enables PIDE markup;
wenzelm
parents:
46133
diff
changeset
|
422 |
let |
85f8d8a8c711
improved list comprehension syntax: more careful treatment of position constraints, which enables PIDE markup;
wenzelm
parents:
46133
diff
changeset
|
423 |
val res = |
85f8d8a8c711
improved list comprehension syntax: more careful treatment of position constraints, which enables PIDE markup;
wenzelm
parents:
46133
diff
changeset
|
424 |
(case qs of |
85f8d8a8c711
improved list comprehension syntax: more careful treatment of position constraints, which enables PIDE markup;
wenzelm
parents:
46133
diff
changeset
|
425 |
Const (@{syntax_const "_lc_end"}, _) => single e |
85f8d8a8c711
improved list comprehension syntax: more careful treatment of position constraints, which enables PIDE markup;
wenzelm
parents:
46133
diff
changeset
|
426 |
| Const (@{syntax_const "_lc_quals"}, _) $ q $ qs => lc_tr ctxt [e, q, qs]); |
85f8d8a8c711
improved list comprehension syntax: more careful treatment of position constraints, which enables PIDE markup;
wenzelm
parents:
46133
diff
changeset
|
427 |
in IfC $ b $ res $ NilC end |
85f8d8a8c711
improved list comprehension syntax: more careful treatment of position constraints, which enables PIDE markup;
wenzelm
parents:
46133
diff
changeset
|
428 |
| lc_tr ctxt |
85f8d8a8c711
improved list comprehension syntax: more careful treatment of position constraints, which enables PIDE markup;
wenzelm
parents:
46133
diff
changeset
|
429 |
[e, Const (@{syntax_const "_lc_gen"}, _) $ p $ es, |
85f8d8a8c711
improved list comprehension syntax: more careful treatment of position constraints, which enables PIDE markup;
wenzelm
parents:
46133
diff
changeset
|
430 |
Const(@{syntax_const "_lc_end"}, _)] = |
85f8d8a8c711
improved list comprehension syntax: more careful treatment of position constraints, which enables PIDE markup;
wenzelm
parents:
46133
diff
changeset
|
431 |
(case abs_tr ctxt p e true of |
85f8d8a8c711
improved list comprehension syntax: more careful treatment of position constraints, which enables PIDE markup;
wenzelm
parents:
46133
diff
changeset
|
432 |
(f, true) => mapC $ f $ es |
85f8d8a8c711
improved list comprehension syntax: more careful treatment of position constraints, which enables PIDE markup;
wenzelm
parents:
46133
diff
changeset
|
433 |
| (f, false) => concatC $ (mapC $ f $ es)) |
85f8d8a8c711
improved list comprehension syntax: more careful treatment of position constraints, which enables PIDE markup;
wenzelm
parents:
46133
diff
changeset
|
434 |
| lc_tr ctxt |
85f8d8a8c711
improved list comprehension syntax: more careful treatment of position constraints, which enables PIDE markup;
wenzelm
parents:
46133
diff
changeset
|
435 |
[e, Const (@{syntax_const "_lc_gen"}, _) $ p $ es, |
85f8d8a8c711
improved list comprehension syntax: more careful treatment of position constraints, which enables PIDE markup;
wenzelm
parents:
46133
diff
changeset
|
436 |
Const (@{syntax_const "_lc_quals"}, _) $ q $ qs] = |
85f8d8a8c711
improved list comprehension syntax: more careful treatment of position constraints, which enables PIDE markup;
wenzelm
parents:
46133
diff
changeset
|
437 |
let val e' = lc_tr ctxt [e, q, qs]; |
85f8d8a8c711
improved list comprehension syntax: more careful treatment of position constraints, which enables PIDE markup;
wenzelm
parents:
46133
diff
changeset
|
438 |
in concatC $ (mapC $ (fst (abs_tr ctxt p e' false)) $ es) end; |
85f8d8a8c711
improved list comprehension syntax: more careful treatment of position constraints, which enables PIDE markup;
wenzelm
parents:
46133
diff
changeset
|
439 |
|
85f8d8a8c711
improved list comprehension syntax: more careful treatment of position constraints, which enables PIDE markup;
wenzelm
parents:
46133
diff
changeset
|
440 |
in [(@{syntax_const "_listcompr"}, lc_tr)] end |
24349 | 441 |
*} |
23279
e39dd93161d9
tuned list comprehension, changed filter syntax from : to <-
nipkow
parents:
23246
diff
changeset
|
442 |
|
42167 | 443 |
ML {* |
444 |
let |
|
445 |
val read = Syntax.read_term @{context}; |
|
446 |
fun check s1 s2 = read s1 aconv read s2 orelse error ("Check failed: " ^ quote s1); |
|
447 |
in |
|
448 |
check "[(x,y,z). b]" "if b then [(x, y, z)] else []"; |
|
449 |
check "[(x,y,z). x\<leftarrow>xs]" "map (\<lambda>x. (x, y, z)) xs"; |
|
450 |
check "[e x y. x\<leftarrow>xs, y\<leftarrow>ys]" "concat (map (\<lambda>x. map (\<lambda>y. e x y) ys) xs)"; |
|
451 |
check "[(x,y,z). x<a, x>b]" "if x < a then if b < x then [(x, y, z)] else [] else []"; |
|
452 |
check "[(x,y,z). x\<leftarrow>xs, x>b]" "concat (map (\<lambda>x. if b < x then [(x, y, z)] else []) xs)"; |
|
453 |
check "[(x,y,z). x<a, x\<leftarrow>xs]" "if x < a then map (\<lambda>x. (x, y, z)) xs else []"; |
|
454 |
check "[(x,y). Cons True x \<leftarrow> xs]" |
|
455 |
"concat (map (\<lambda>xa. case xa of [] \<Rightarrow> [] | True # x \<Rightarrow> [(x, y)] | False # x \<Rightarrow> []) xs)"; |
|
456 |
check "[(x,y,z). Cons x [] \<leftarrow> xs]" |
|
457 |
"concat (map (\<lambda>xa. case xa of [] \<Rightarrow> [] | [x] \<Rightarrow> [(x, y, z)] | x # aa # lista \<Rightarrow> []) xs)"; |
|
458 |
check "[(x,y,z). x<a, x>b, x=d]" |
|
459 |
"if x < a then if b < x then if x = d then [(x, y, z)] else [] else [] else []"; |
|
460 |
check "[(x,y,z). x<a, x>b, y\<leftarrow>ys]" |
|
461 |
"if x < a then if b < x then map (\<lambda>y. (x, y, z)) ys else [] else []"; |
|
462 |
check "[(x,y,z). x<a, x\<leftarrow>xs,y>b]" |
|
463 |
"if x < a then concat (map (\<lambda>x. if b < y then [(x, y, z)] else []) xs) else []"; |
|
464 |
check "[(x,y,z). x<a, x\<leftarrow>xs, y\<leftarrow>ys]" |
|
465 |
"if x < a then concat (map (\<lambda>x. map (\<lambda>y. (x, y, z)) ys) xs) else []"; |
|
466 |
check "[(x,y,z). x\<leftarrow>xs, x>b, y<a]" |
|
467 |
"concat (map (\<lambda>x. if b < x then if y < a then [(x, y, z)] else [] else []) xs)"; |
|
468 |
check "[(x,y,z). x\<leftarrow>xs, x>b, y\<leftarrow>ys]" |
|
469 |
"concat (map (\<lambda>x. if b < x then map (\<lambda>y. (x, y, z)) ys else []) xs)"; |
|
470 |
check "[(x,y,z). x\<leftarrow>xs, y\<leftarrow>ys,y>x]" |
|
471 |
"concat (map (\<lambda>x. concat (map (\<lambda>y. if x < y then [(x, y, z)] else []) ys)) xs)"; |
|
472 |
check "[(x,y,z). x\<leftarrow>xs, y\<leftarrow>ys,z\<leftarrow>zs]" |
|
473 |
"concat (map (\<lambda>x. concat (map (\<lambda>y. map (\<lambda>z. (x, y, z)) zs) ys)) xs)" |
|
474 |
end; |
|
475 |
*} |
|
476 |
||
35115 | 477 |
(* |
24349 | 478 |
term "[(x,y). x\<leftarrow>xs, let xx = x+x, y\<leftarrow>ys, y \<noteq> xx]" |
23192 | 479 |
*) |
480 |
||
42167 | 481 |
|
50422
ee729dbd1b7f
avoid ML_file in large theory files to improve performance of dependency discovery of main HOL (approx. 1s CPU time) -- relevant for any application using it, e.g. small paper sessions;
wenzelm
parents:
50134
diff
changeset
|
482 |
ML {* |
ee729dbd1b7f
avoid ML_file in large theory files to improve performance of dependency discovery of main HOL (approx. 1s CPU time) -- relevant for any application using it, e.g. small paper sessions;
wenzelm
parents:
50134
diff
changeset
|
483 |
(* Simproc for rewriting list comprehensions applied to List.set to set |
ee729dbd1b7f
avoid ML_file in large theory files to improve performance of dependency discovery of main HOL (approx. 1s CPU time) -- relevant for any application using it, e.g. small paper sessions;
wenzelm
parents:
50134
diff
changeset
|
484 |
comprehension. *) |
ee729dbd1b7f
avoid ML_file in large theory files to improve performance of dependency discovery of main HOL (approx. 1s CPU time) -- relevant for any application using it, e.g. small paper sessions;
wenzelm
parents:
50134
diff
changeset
|
485 |
|
ee729dbd1b7f
avoid ML_file in large theory files to improve performance of dependency discovery of main HOL (approx. 1s CPU time) -- relevant for any application using it, e.g. small paper sessions;
wenzelm
parents:
50134
diff
changeset
|
486 |
signature LIST_TO_SET_COMPREHENSION = |
ee729dbd1b7f
avoid ML_file in large theory files to improve performance of dependency discovery of main HOL (approx. 1s CPU time) -- relevant for any application using it, e.g. small paper sessions;
wenzelm
parents:
50134
diff
changeset
|
487 |
sig |
ee729dbd1b7f
avoid ML_file in large theory files to improve performance of dependency discovery of main HOL (approx. 1s CPU time) -- relevant for any application using it, e.g. small paper sessions;
wenzelm
parents:
50134
diff
changeset
|
488 |
val simproc : simpset -> cterm -> thm option |
ee729dbd1b7f
avoid ML_file in large theory files to improve performance of dependency discovery of main HOL (approx. 1s CPU time) -- relevant for any application using it, e.g. small paper sessions;
wenzelm
parents:
50134
diff
changeset
|
489 |
end |
ee729dbd1b7f
avoid ML_file in large theory files to improve performance of dependency discovery of main HOL (approx. 1s CPU time) -- relevant for any application using it, e.g. small paper sessions;
wenzelm
parents:
50134
diff
changeset
|
490 |
|
ee729dbd1b7f
avoid ML_file in large theory files to improve performance of dependency discovery of main HOL (approx. 1s CPU time) -- relevant for any application using it, e.g. small paper sessions;
wenzelm
parents:
50134
diff
changeset
|
491 |
structure List_to_Set_Comprehension : LIST_TO_SET_COMPREHENSION = |
ee729dbd1b7f
avoid ML_file in large theory files to improve performance of dependency discovery of main HOL (approx. 1s CPU time) -- relevant for any application using it, e.g. small paper sessions;
wenzelm
parents:
50134
diff
changeset
|
492 |
struct |
ee729dbd1b7f
avoid ML_file in large theory files to improve performance of dependency discovery of main HOL (approx. 1s CPU time) -- relevant for any application using it, e.g. small paper sessions;
wenzelm
parents:
50134
diff
changeset
|
493 |
|
ee729dbd1b7f
avoid ML_file in large theory files to improve performance of dependency discovery of main HOL (approx. 1s CPU time) -- relevant for any application using it, e.g. small paper sessions;
wenzelm
parents:
50134
diff
changeset
|
494 |
(* conversion *) |
ee729dbd1b7f
avoid ML_file in large theory files to improve performance of dependency discovery of main HOL (approx. 1s CPU time) -- relevant for any application using it, e.g. small paper sessions;
wenzelm
parents:
50134
diff
changeset
|
495 |
|
ee729dbd1b7f
avoid ML_file in large theory files to improve performance of dependency discovery of main HOL (approx. 1s CPU time) -- relevant for any application using it, e.g. small paper sessions;
wenzelm
parents:
50134
diff
changeset
|
496 |
fun all_exists_conv cv ctxt ct = |
ee729dbd1b7f
avoid ML_file in large theory files to improve performance of dependency discovery of main HOL (approx. 1s CPU time) -- relevant for any application using it, e.g. small paper sessions;
wenzelm
parents:
50134
diff
changeset
|
497 |
(case Thm.term_of ct of |
ee729dbd1b7f
avoid ML_file in large theory files to improve performance of dependency discovery of main HOL (approx. 1s CPU time) -- relevant for any application using it, e.g. small paper sessions;
wenzelm
parents:
50134
diff
changeset
|
498 |
Const (@{const_name HOL.Ex}, _) $ Abs _ => |
ee729dbd1b7f
avoid ML_file in large theory files to improve performance of dependency discovery of main HOL (approx. 1s CPU time) -- relevant for any application using it, e.g. small paper sessions;
wenzelm
parents:
50134
diff
changeset
|
499 |
Conv.arg_conv (Conv.abs_conv (all_exists_conv cv o #2) ctxt) ct |
ee729dbd1b7f
avoid ML_file in large theory files to improve performance of dependency discovery of main HOL (approx. 1s CPU time) -- relevant for any application using it, e.g. small paper sessions;
wenzelm
parents:
50134
diff
changeset
|
500 |
| _ => cv ctxt ct) |
ee729dbd1b7f
avoid ML_file in large theory files to improve performance of dependency discovery of main HOL (approx. 1s CPU time) -- relevant for any application using it, e.g. small paper sessions;
wenzelm
parents:
50134
diff
changeset
|
501 |
|
ee729dbd1b7f
avoid ML_file in large theory files to improve performance of dependency discovery of main HOL (approx. 1s CPU time) -- relevant for any application using it, e.g. small paper sessions;
wenzelm
parents:
50134
diff
changeset
|
502 |
fun all_but_last_exists_conv cv ctxt ct = |
ee729dbd1b7f
avoid ML_file in large theory files to improve performance of dependency discovery of main HOL (approx. 1s CPU time) -- relevant for any application using it, e.g. small paper sessions;
wenzelm
parents:
50134
diff
changeset
|
503 |
(case Thm.term_of ct of |
ee729dbd1b7f
avoid ML_file in large theory files to improve performance of dependency discovery of main HOL (approx. 1s CPU time) -- relevant for any application using it, e.g. small paper sessions;
wenzelm
parents:
50134
diff
changeset
|
504 |
Const (@{const_name HOL.Ex}, _) $ Abs (_, _, Const (@{const_name HOL.Ex}, _) $ _) => |
ee729dbd1b7f
avoid ML_file in large theory files to improve performance of dependency discovery of main HOL (approx. 1s CPU time) -- relevant for any application using it, e.g. small paper sessions;
wenzelm
parents:
50134
diff
changeset
|
505 |
Conv.arg_conv (Conv.abs_conv (all_but_last_exists_conv cv o #2) ctxt) ct |
ee729dbd1b7f
avoid ML_file in large theory files to improve performance of dependency discovery of main HOL (approx. 1s CPU time) -- relevant for any application using it, e.g. small paper sessions;
wenzelm
parents:
50134
diff
changeset
|
506 |
| _ => cv ctxt ct) |
ee729dbd1b7f
avoid ML_file in large theory files to improve performance of dependency discovery of main HOL (approx. 1s CPU time) -- relevant for any application using it, e.g. small paper sessions;
wenzelm
parents:
50134
diff
changeset
|
507 |
|
ee729dbd1b7f
avoid ML_file in large theory files to improve performance of dependency discovery of main HOL (approx. 1s CPU time) -- relevant for any application using it, e.g. small paper sessions;
wenzelm
parents:
50134
diff
changeset
|
508 |
fun Collect_conv cv ctxt ct = |
ee729dbd1b7f
avoid ML_file in large theory files to improve performance of dependency discovery of main HOL (approx. 1s CPU time) -- relevant for any application using it, e.g. small paper sessions;
wenzelm
parents:
50134
diff
changeset
|
509 |
(case Thm.term_of ct of |
ee729dbd1b7f
avoid ML_file in large theory files to improve performance of dependency discovery of main HOL (approx. 1s CPU time) -- relevant for any application using it, e.g. small paper sessions;
wenzelm
parents:
50134
diff
changeset
|
510 |
Const (@{const_name Set.Collect}, _) $ Abs _ => Conv.arg_conv (Conv.abs_conv cv ctxt) ct |
ee729dbd1b7f
avoid ML_file in large theory files to improve performance of dependency discovery of main HOL (approx. 1s CPU time) -- relevant for any application using it, e.g. small paper sessions;
wenzelm
parents:
50134
diff
changeset
|
511 |
| _ => raise CTERM ("Collect_conv", [ct])) |
ee729dbd1b7f
avoid ML_file in large theory files to improve performance of dependency discovery of main HOL (approx. 1s CPU time) -- relevant for any application using it, e.g. small paper sessions;
wenzelm
parents:
50134
diff
changeset
|
512 |
|
ee729dbd1b7f
avoid ML_file in large theory files to improve performance of dependency discovery of main HOL (approx. 1s CPU time) -- relevant for any application using it, e.g. small paper sessions;
wenzelm
parents:
50134
diff
changeset
|
513 |
fun Trueprop_conv cv ct = |
ee729dbd1b7f
avoid ML_file in large theory files to improve performance of dependency discovery of main HOL (approx. 1s CPU time) -- relevant for any application using it, e.g. small paper sessions;
wenzelm
parents:
50134
diff
changeset
|
514 |
(case Thm.term_of ct of |
ee729dbd1b7f
avoid ML_file in large theory files to improve performance of dependency discovery of main HOL (approx. 1s CPU time) -- relevant for any application using it, e.g. small paper sessions;
wenzelm
parents:
50134
diff
changeset
|
515 |
Const (@{const_name Trueprop}, _) $ _ => Conv.arg_conv cv ct |
ee729dbd1b7f
avoid ML_file in large theory files to improve performance of dependency discovery of main HOL (approx. 1s CPU time) -- relevant for any application using it, e.g. small paper sessions;
wenzelm
parents:
50134
diff
changeset
|
516 |
| _ => raise CTERM ("Trueprop_conv", [ct])) |
ee729dbd1b7f
avoid ML_file in large theory files to improve performance of dependency discovery of main HOL (approx. 1s CPU time) -- relevant for any application using it, e.g. small paper sessions;
wenzelm
parents:
50134
diff
changeset
|
517 |
|
ee729dbd1b7f
avoid ML_file in large theory files to improve performance of dependency discovery of main HOL (approx. 1s CPU time) -- relevant for any application using it, e.g. small paper sessions;
wenzelm
parents:
50134
diff
changeset
|
518 |
fun eq_conv cv1 cv2 ct = |
ee729dbd1b7f
avoid ML_file in large theory files to improve performance of dependency discovery of main HOL (approx. 1s CPU time) -- relevant for any application using it, e.g. small paper sessions;
wenzelm
parents:
50134
diff
changeset
|
519 |
(case Thm.term_of ct of |
ee729dbd1b7f
avoid ML_file in large theory files to improve performance of dependency discovery of main HOL (approx. 1s CPU time) -- relevant for any application using it, e.g. small paper sessions;
wenzelm
parents:
50134
diff
changeset
|
520 |
Const (@{const_name HOL.eq}, _) $ _ $ _ => Conv.combination_conv (Conv.arg_conv cv1) cv2 ct |
ee729dbd1b7f
avoid ML_file in large theory files to improve performance of dependency discovery of main HOL (approx. 1s CPU time) -- relevant for any application using it, e.g. small paper sessions;
wenzelm
parents:
50134
diff
changeset
|
521 |
| _ => raise CTERM ("eq_conv", [ct])) |
ee729dbd1b7f
avoid ML_file in large theory files to improve performance of dependency discovery of main HOL (approx. 1s CPU time) -- relevant for any application using it, e.g. small paper sessions;
wenzelm
parents:
50134
diff
changeset
|
522 |
|
ee729dbd1b7f
avoid ML_file in large theory files to improve performance of dependency discovery of main HOL (approx. 1s CPU time) -- relevant for any application using it, e.g. small paper sessions;
wenzelm
parents:
50134
diff
changeset
|
523 |
fun conj_conv cv1 cv2 ct = |
ee729dbd1b7f
avoid ML_file in large theory files to improve performance of dependency discovery of main HOL (approx. 1s CPU time) -- relevant for any application using it, e.g. small paper sessions;
wenzelm
parents:
50134
diff
changeset
|
524 |
(case Thm.term_of ct of |
ee729dbd1b7f
avoid ML_file in large theory files to improve performance of dependency discovery of main HOL (approx. 1s CPU time) -- relevant for any application using it, e.g. small paper sessions;
wenzelm
parents:
50134
diff
changeset
|
525 |
Const (@{const_name HOL.conj}, _) $ _ $ _ => Conv.combination_conv (Conv.arg_conv cv1) cv2 ct |
ee729dbd1b7f
avoid ML_file in large theory files to improve performance of dependency discovery of main HOL (approx. 1s CPU time) -- relevant for any application using it, e.g. small paper sessions;
wenzelm
parents:
50134
diff
changeset
|
526 |
| _ => raise CTERM ("conj_conv", [ct])) |
ee729dbd1b7f
avoid ML_file in large theory files to improve performance of dependency discovery of main HOL (approx. 1s CPU time) -- relevant for any application using it, e.g. small paper sessions;
wenzelm
parents:
50134
diff
changeset
|
527 |
|
ee729dbd1b7f
avoid ML_file in large theory files to improve performance of dependency discovery of main HOL (approx. 1s CPU time) -- relevant for any application using it, e.g. small paper sessions;
wenzelm
parents:
50134
diff
changeset
|
528 |
fun rewr_conv' th = Conv.rewr_conv (mk_meta_eq th) |
ee729dbd1b7f
avoid ML_file in large theory files to improve performance of dependency discovery of main HOL (approx. 1s CPU time) -- relevant for any application using it, e.g. small paper sessions;
wenzelm
parents:
50134
diff
changeset
|
529 |
|
ee729dbd1b7f
avoid ML_file in large theory files to improve performance of dependency discovery of main HOL (approx. 1s CPU time) -- relevant for any application using it, e.g. small paper sessions;
wenzelm
parents:
50134
diff
changeset
|
530 |
fun conjunct_assoc_conv ct = |
ee729dbd1b7f
avoid ML_file in large theory files to improve performance of dependency discovery of main HOL (approx. 1s CPU time) -- relevant for any application using it, e.g. small paper sessions;
wenzelm
parents:
50134
diff
changeset
|
531 |
Conv.try_conv |
ee729dbd1b7f
avoid ML_file in large theory files to improve performance of dependency discovery of main HOL (approx. 1s CPU time) -- relevant for any application using it, e.g. small paper sessions;
wenzelm
parents:
50134
diff
changeset
|
532 |
(rewr_conv' @{thm conj_assoc} then_conv conj_conv Conv.all_conv conjunct_assoc_conv) ct |
ee729dbd1b7f
avoid ML_file in large theory files to improve performance of dependency discovery of main HOL (approx. 1s CPU time) -- relevant for any application using it, e.g. small paper sessions;
wenzelm
parents:
50134
diff
changeset
|
533 |
|
ee729dbd1b7f
avoid ML_file in large theory files to improve performance of dependency discovery of main HOL (approx. 1s CPU time) -- relevant for any application using it, e.g. small paper sessions;
wenzelm
parents:
50134
diff
changeset
|
534 |
fun right_hand_set_comprehension_conv conv ctxt = |
ee729dbd1b7f
avoid ML_file in large theory files to improve performance of dependency discovery of main HOL (approx. 1s CPU time) -- relevant for any application using it, e.g. small paper sessions;
wenzelm
parents:
50134
diff
changeset
|
535 |
Trueprop_conv (eq_conv Conv.all_conv |
ee729dbd1b7f
avoid ML_file in large theory files to improve performance of dependency discovery of main HOL (approx. 1s CPU time) -- relevant for any application using it, e.g. small paper sessions;
wenzelm
parents:
50134
diff
changeset
|
536 |
(Collect_conv (all_exists_conv conv o #2) ctxt)) |
ee729dbd1b7f
avoid ML_file in large theory files to improve performance of dependency discovery of main HOL (approx. 1s CPU time) -- relevant for any application using it, e.g. small paper sessions;
wenzelm
parents:
50134
diff
changeset
|
537 |
|
ee729dbd1b7f
avoid ML_file in large theory files to improve performance of dependency discovery of main HOL (approx. 1s CPU time) -- relevant for any application using it, e.g. small paper sessions;
wenzelm
parents:
50134
diff
changeset
|
538 |
|
ee729dbd1b7f
avoid ML_file in large theory files to improve performance of dependency discovery of main HOL (approx. 1s CPU time) -- relevant for any application using it, e.g. small paper sessions;
wenzelm
parents:
50134
diff
changeset
|
539 |
(* term abstraction of list comprehension patterns *) |
ee729dbd1b7f
avoid ML_file in large theory files to improve performance of dependency discovery of main HOL (approx. 1s CPU time) -- relevant for any application using it, e.g. small paper sessions;
wenzelm
parents:
50134
diff
changeset
|
540 |
|
ee729dbd1b7f
avoid ML_file in large theory files to improve performance of dependency discovery of main HOL (approx. 1s CPU time) -- relevant for any application using it, e.g. small paper sessions;
wenzelm
parents:
50134
diff
changeset
|
541 |
datatype termlets = If | Case of (typ * int) |
ee729dbd1b7f
avoid ML_file in large theory files to improve performance of dependency discovery of main HOL (approx. 1s CPU time) -- relevant for any application using it, e.g. small paper sessions;
wenzelm
parents:
50134
diff
changeset
|
542 |
|
ee729dbd1b7f
avoid ML_file in large theory files to improve performance of dependency discovery of main HOL (approx. 1s CPU time) -- relevant for any application using it, e.g. small paper sessions;
wenzelm
parents:
50134
diff
changeset
|
543 |
fun simproc ss redex = |
ee729dbd1b7f
avoid ML_file in large theory files to improve performance of dependency discovery of main HOL (approx. 1s CPU time) -- relevant for any application using it, e.g. small paper sessions;
wenzelm
parents:
50134
diff
changeset
|
544 |
let |
ee729dbd1b7f
avoid ML_file in large theory files to improve performance of dependency discovery of main HOL (approx. 1s CPU time) -- relevant for any application using it, e.g. small paper sessions;
wenzelm
parents:
50134
diff
changeset
|
545 |
val ctxt = Simplifier.the_context ss |
ee729dbd1b7f
avoid ML_file in large theory files to improve performance of dependency discovery of main HOL (approx. 1s CPU time) -- relevant for any application using it, e.g. small paper sessions;
wenzelm
parents:
50134
diff
changeset
|
546 |
val thy = Proof_Context.theory_of ctxt |
ee729dbd1b7f
avoid ML_file in large theory files to improve performance of dependency discovery of main HOL (approx. 1s CPU time) -- relevant for any application using it, e.g. small paper sessions;
wenzelm
parents:
50134
diff
changeset
|
547 |
val set_Nil_I = @{thm trans} OF [@{thm set.simps(1)}, @{thm empty_def}] |
ee729dbd1b7f
avoid ML_file in large theory files to improve performance of dependency discovery of main HOL (approx. 1s CPU time) -- relevant for any application using it, e.g. small paper sessions;
wenzelm
parents:
50134
diff
changeset
|
548 |
val set_singleton = @{lemma "set [a] = {x. x = a}" by simp} |
ee729dbd1b7f
avoid ML_file in large theory files to improve performance of dependency discovery of main HOL (approx. 1s CPU time) -- relevant for any application using it, e.g. small paper sessions;
wenzelm
parents:
50134
diff
changeset
|
549 |
val inst_Collect_mem_eq = @{lemma "set A = {x. x : set A}" by simp} |
ee729dbd1b7f
avoid ML_file in large theory files to improve performance of dependency discovery of main HOL (approx. 1s CPU time) -- relevant for any application using it, e.g. small paper sessions;
wenzelm
parents:
50134
diff
changeset
|
550 |
val del_refl_eq = @{lemma "(t = t & P) == P" by simp} |
ee729dbd1b7f
avoid ML_file in large theory files to improve performance of dependency discovery of main HOL (approx. 1s CPU time) -- relevant for any application using it, e.g. small paper sessions;
wenzelm
parents:
50134
diff
changeset
|
551 |
fun mk_set T = Const (@{const_name List.set}, HOLogic.listT T --> HOLogic.mk_setT T) |
ee729dbd1b7f
avoid ML_file in large theory files to improve performance of dependency discovery of main HOL (approx. 1s CPU time) -- relevant for any application using it, e.g. small paper sessions;
wenzelm
parents:
50134
diff
changeset
|
552 |
fun dest_set (Const (@{const_name List.set}, _) $ xs) = xs |
ee729dbd1b7f
avoid ML_file in large theory files to improve performance of dependency discovery of main HOL (approx. 1s CPU time) -- relevant for any application using it, e.g. small paper sessions;
wenzelm
parents:
50134
diff
changeset
|
553 |
fun dest_singleton_list (Const (@{const_name List.Cons}, _) |
ee729dbd1b7f
avoid ML_file in large theory files to improve performance of dependency discovery of main HOL (approx. 1s CPU time) -- relevant for any application using it, e.g. small paper sessions;
wenzelm
parents:
50134
diff
changeset
|
554 |
$ t $ (Const (@{const_name List.Nil}, _))) = t |
ee729dbd1b7f
avoid ML_file in large theory files to improve performance of dependency discovery of main HOL (approx. 1s CPU time) -- relevant for any application using it, e.g. small paper sessions;
wenzelm
parents:
50134
diff
changeset
|
555 |
| dest_singleton_list t = raise TERM ("dest_singleton_list", [t]) |
ee729dbd1b7f
avoid ML_file in large theory files to improve performance of dependency discovery of main HOL (approx. 1s CPU time) -- relevant for any application using it, e.g. small paper sessions;
wenzelm
parents:
50134
diff
changeset
|
556 |
(* We check that one case returns a singleton list and all other cases |
ee729dbd1b7f
avoid ML_file in large theory files to improve performance of dependency discovery of main HOL (approx. 1s CPU time) -- relevant for any application using it, e.g. small paper sessions;
wenzelm
parents:
50134
diff
changeset
|
557 |
return [], and return the index of the one singleton list case *) |
ee729dbd1b7f
avoid ML_file in large theory files to improve performance of dependency discovery of main HOL (approx. 1s CPU time) -- relevant for any application using it, e.g. small paper sessions;
wenzelm
parents:
50134
diff
changeset
|
558 |
fun possible_index_of_singleton_case cases = |
ee729dbd1b7f
avoid ML_file in large theory files to improve performance of dependency discovery of main HOL (approx. 1s CPU time) -- relevant for any application using it, e.g. small paper sessions;
wenzelm
parents:
50134
diff
changeset
|
559 |
let |
ee729dbd1b7f
avoid ML_file in large theory files to improve performance of dependency discovery of main HOL (approx. 1s CPU time) -- relevant for any application using it, e.g. small paper sessions;
wenzelm
parents:
50134
diff
changeset
|
560 |
fun check (i, case_t) s = |
ee729dbd1b7f
avoid ML_file in large theory files to improve performance of dependency discovery of main HOL (approx. 1s CPU time) -- relevant for any application using it, e.g. small paper sessions;
wenzelm
parents:
50134
diff
changeset
|
561 |
(case strip_abs_body case_t of |
ee729dbd1b7f
avoid ML_file in large theory files to improve performance of dependency discovery of main HOL (approx. 1s CPU time) -- relevant for any application using it, e.g. small paper sessions;
wenzelm
parents:
50134
diff
changeset
|
562 |
(Const (@{const_name List.Nil}, _)) => s |
ee729dbd1b7f
avoid ML_file in large theory files to improve performance of dependency discovery of main HOL (approx. 1s CPU time) -- relevant for any application using it, e.g. small paper sessions;
wenzelm
parents:
50134
diff
changeset
|
563 |
| _ => (case s of NONE => SOME i | SOME _ => NONE)) |
ee729dbd1b7f
avoid ML_file in large theory files to improve performance of dependency discovery of main HOL (approx. 1s CPU time) -- relevant for any application using it, e.g. small paper sessions;
wenzelm
parents:
50134
diff
changeset
|
564 |
in |
ee729dbd1b7f
avoid ML_file in large theory files to improve performance of dependency discovery of main HOL (approx. 1s CPU time) -- relevant for any application using it, e.g. small paper sessions;
wenzelm
parents:
50134
diff
changeset
|
565 |
fold_index check cases NONE |
ee729dbd1b7f
avoid ML_file in large theory files to improve performance of dependency discovery of main HOL (approx. 1s CPU time) -- relevant for any application using it, e.g. small paper sessions;
wenzelm
parents:
50134
diff
changeset
|
566 |
end |
ee729dbd1b7f
avoid ML_file in large theory files to improve performance of dependency discovery of main HOL (approx. 1s CPU time) -- relevant for any application using it, e.g. small paper sessions;
wenzelm
parents:
50134
diff
changeset
|
567 |
(* returns (case_expr type index chosen_case) option *) |
ee729dbd1b7f
avoid ML_file in large theory files to improve performance of dependency discovery of main HOL (approx. 1s CPU time) -- relevant for any application using it, e.g. small paper sessions;
wenzelm
parents:
50134
diff
changeset
|
568 |
fun dest_case case_term = |
ee729dbd1b7f
avoid ML_file in large theory files to improve performance of dependency discovery of main HOL (approx. 1s CPU time) -- relevant for any application using it, e.g. small paper sessions;
wenzelm
parents:
50134
diff
changeset
|
569 |
let |
ee729dbd1b7f
avoid ML_file in large theory files to improve performance of dependency discovery of main HOL (approx. 1s CPU time) -- relevant for any application using it, e.g. small paper sessions;
wenzelm
parents:
50134
diff
changeset
|
570 |
val (case_const, args) = strip_comb case_term |
ee729dbd1b7f
avoid ML_file in large theory files to improve performance of dependency discovery of main HOL (approx. 1s CPU time) -- relevant for any application using it, e.g. small paper sessions;
wenzelm
parents:
50134
diff
changeset
|
571 |
in |
ee729dbd1b7f
avoid ML_file in large theory files to improve performance of dependency discovery of main HOL (approx. 1s CPU time) -- relevant for any application using it, e.g. small paper sessions;
wenzelm
parents:
50134
diff
changeset
|
572 |
(case try dest_Const case_const of |
ee729dbd1b7f
avoid ML_file in large theory files to improve performance of dependency discovery of main HOL (approx. 1s CPU time) -- relevant for any application using it, e.g. small paper sessions;
wenzelm
parents:
50134
diff
changeset
|
573 |
SOME (c, T) => |
ee729dbd1b7f
avoid ML_file in large theory files to improve performance of dependency discovery of main HOL (approx. 1s CPU time) -- relevant for any application using it, e.g. small paper sessions;
wenzelm
parents:
50134
diff
changeset
|
574 |
(case Datatype.info_of_case thy c of |
ee729dbd1b7f
avoid ML_file in large theory files to improve performance of dependency discovery of main HOL (approx. 1s CPU time) -- relevant for any application using it, e.g. small paper sessions;
wenzelm
parents:
50134
diff
changeset
|
575 |
SOME _ => |
ee729dbd1b7f
avoid ML_file in large theory files to improve performance of dependency discovery of main HOL (approx. 1s CPU time) -- relevant for any application using it, e.g. small paper sessions;
wenzelm
parents:
50134
diff
changeset
|
576 |
(case possible_index_of_singleton_case (fst (split_last args)) of |
ee729dbd1b7f
avoid ML_file in large theory files to improve performance of dependency discovery of main HOL (approx. 1s CPU time) -- relevant for any application using it, e.g. small paper sessions;
wenzelm
parents:
50134
diff
changeset
|
577 |
SOME i => |
ee729dbd1b7f
avoid ML_file in large theory files to improve performance of dependency discovery of main HOL (approx. 1s CPU time) -- relevant for any application using it, e.g. small paper sessions;
wenzelm
parents:
50134
diff
changeset
|
578 |
let |
ee729dbd1b7f
avoid ML_file in large theory files to improve performance of dependency discovery of main HOL (approx. 1s CPU time) -- relevant for any application using it, e.g. small paper sessions;
wenzelm
parents:
50134
diff
changeset
|
579 |
val (Ts, _) = strip_type T |
ee729dbd1b7f
avoid ML_file in large theory files to improve performance of dependency discovery of main HOL (approx. 1s CPU time) -- relevant for any application using it, e.g. small paper sessions;
wenzelm
parents:
50134
diff
changeset
|
580 |
val T' = List.last Ts |
ee729dbd1b7f
avoid ML_file in large theory files to improve performance of dependency discovery of main HOL (approx. 1s CPU time) -- relevant for any application using it, e.g. small paper sessions;
wenzelm
parents:
50134
diff
changeset
|
581 |
in SOME (List.last args, T', i, nth args i) end |
ee729dbd1b7f
avoid ML_file in large theory files to improve performance of dependency discovery of main HOL (approx. 1s CPU time) -- relevant for any application using it, e.g. small paper sessions;
wenzelm
parents:
50134
diff
changeset
|
582 |
| NONE => NONE) |
ee729dbd1b7f
avoid ML_file in large theory files to improve performance of dependency discovery of main HOL (approx. 1s CPU time) -- relevant for any application using it, e.g. small paper sessions;
wenzelm
parents:
50134
diff
changeset
|
583 |
| NONE => NONE) |
ee729dbd1b7f
avoid ML_file in large theory files to improve performance of dependency discovery of main HOL (approx. 1s CPU time) -- relevant for any application using it, e.g. small paper sessions;
wenzelm
parents:
50134
diff
changeset
|
584 |
| NONE => NONE) |
ee729dbd1b7f
avoid ML_file in large theory files to improve performance of dependency discovery of main HOL (approx. 1s CPU time) -- relevant for any application using it, e.g. small paper sessions;
wenzelm
parents:
50134
diff
changeset
|
585 |
end |
ee729dbd1b7f
avoid ML_file in large theory files to improve performance of dependency discovery of main HOL (approx. 1s CPU time) -- relevant for any application using it, e.g. small paper sessions;
wenzelm
parents:
50134
diff
changeset
|
586 |
(* returns condition continuing term option *) |
ee729dbd1b7f
avoid ML_file in large theory files to improve performance of dependency discovery of main HOL (approx. 1s CPU time) -- relevant for any application using it, e.g. small paper sessions;
wenzelm
parents:
50134
diff
changeset
|
587 |
fun dest_if (Const (@{const_name If}, _) $ cond $ then_t $ Const (@{const_name Nil}, _)) = |
ee729dbd1b7f
avoid ML_file in large theory files to improve performance of dependency discovery of main HOL (approx. 1s CPU time) -- relevant for any application using it, e.g. small paper sessions;
wenzelm
parents:
50134
diff
changeset
|
588 |
SOME (cond, then_t) |
ee729dbd1b7f
avoid ML_file in large theory files to improve performance of dependency discovery of main HOL (approx. 1s CPU time) -- relevant for any application using it, e.g. small paper sessions;
wenzelm
parents:
50134
diff
changeset
|
589 |
| dest_if _ = NONE |
ee729dbd1b7f
avoid ML_file in large theory files to improve performance of dependency discovery of main HOL (approx. 1s CPU time) -- relevant for any application using it, e.g. small paper sessions;
wenzelm
parents:
50134
diff
changeset
|
590 |
fun tac _ [] = rtac set_singleton 1 ORELSE rtac inst_Collect_mem_eq 1 |
ee729dbd1b7f
avoid ML_file in large theory files to improve performance of dependency discovery of main HOL (approx. 1s CPU time) -- relevant for any application using it, e.g. small paper sessions;
wenzelm
parents:
50134
diff
changeset
|
591 |
| tac ctxt (If :: cont) = |
ee729dbd1b7f
avoid ML_file in large theory files to improve performance of dependency discovery of main HOL (approx. 1s CPU time) -- relevant for any application using it, e.g. small paper sessions;
wenzelm
parents:
50134
diff
changeset
|
592 |
Splitter.split_tac [@{thm split_if}] 1 |
ee729dbd1b7f
avoid ML_file in large theory files to improve performance of dependency discovery of main HOL (approx. 1s CPU time) -- relevant for any application using it, e.g. small paper sessions;
wenzelm
parents:
50134
diff
changeset
|
593 |
THEN rtac @{thm conjI} 1 |
ee729dbd1b7f
avoid ML_file in large theory files to improve performance of dependency discovery of main HOL (approx. 1s CPU time) -- relevant for any application using it, e.g. small paper sessions;
wenzelm
parents:
50134
diff
changeset
|
594 |
THEN rtac @{thm impI} 1 |
ee729dbd1b7f
avoid ML_file in large theory files to improve performance of dependency discovery of main HOL (approx. 1s CPU time) -- relevant for any application using it, e.g. small paper sessions;
wenzelm
parents:
50134
diff
changeset
|
595 |
THEN Subgoal.FOCUS (fn {prems, context, ...} => |
ee729dbd1b7f
avoid ML_file in large theory files to improve performance of dependency discovery of main HOL (approx. 1s CPU time) -- relevant for any application using it, e.g. small paper sessions;
wenzelm
parents:
50134
diff
changeset
|
596 |
CONVERSION (right_hand_set_comprehension_conv (K |
ee729dbd1b7f
avoid ML_file in large theory files to improve performance of dependency discovery of main HOL (approx. 1s CPU time) -- relevant for any application using it, e.g. small paper sessions;
wenzelm
parents:
50134
diff
changeset
|
597 |
(conj_conv (Conv.rewr_conv (List.last prems RS @{thm Eq_TrueI})) Conv.all_conv |
ee729dbd1b7f
avoid ML_file in large theory files to improve performance of dependency discovery of main HOL (approx. 1s CPU time) -- relevant for any application using it, e.g. small paper sessions;
wenzelm
parents:
50134
diff
changeset
|
598 |
then_conv |
ee729dbd1b7f
avoid ML_file in large theory files to improve performance of dependency discovery of main HOL (approx. 1s CPU time) -- relevant for any application using it, e.g. small paper sessions;
wenzelm
parents:
50134
diff
changeset
|
599 |
rewr_conv' @{lemma "(True & P) = P" by simp})) context) 1) ctxt 1 |
ee729dbd1b7f
avoid ML_file in large theory files to improve performance of dependency discovery of main HOL (approx. 1s CPU time) -- relevant for any application using it, e.g. small paper sessions;
wenzelm
parents:
50134
diff
changeset
|
600 |
THEN tac ctxt cont |
ee729dbd1b7f
avoid ML_file in large theory files to improve performance of dependency discovery of main HOL (approx. 1s CPU time) -- relevant for any application using it, e.g. small paper sessions;
wenzelm
parents:
50134
diff
changeset
|
601 |
THEN rtac @{thm impI} 1 |
ee729dbd1b7f
avoid ML_file in large theory files to improve performance of dependency discovery of main HOL (approx. 1s CPU time) -- relevant for any application using it, e.g. small paper sessions;
wenzelm
parents:
50134
diff
changeset
|
602 |
THEN Subgoal.FOCUS (fn {prems, context, ...} => |
ee729dbd1b7f
avoid ML_file in large theory files to improve performance of dependency discovery of main HOL (approx. 1s CPU time) -- relevant for any application using it, e.g. small paper sessions;
wenzelm
parents:
50134
diff
changeset
|
603 |
CONVERSION (right_hand_set_comprehension_conv (K |
ee729dbd1b7f
avoid ML_file in large theory files to improve performance of dependency discovery of main HOL (approx. 1s CPU time) -- relevant for any application using it, e.g. small paper sessions;
wenzelm
parents:
50134
diff
changeset
|
604 |
(conj_conv (Conv.rewr_conv (List.last prems RS @{thm Eq_FalseI})) Conv.all_conv |
ee729dbd1b7f
avoid ML_file in large theory files to improve performance of dependency discovery of main HOL (approx. 1s CPU time) -- relevant for any application using it, e.g. small paper sessions;
wenzelm
parents:
50134
diff
changeset
|
605 |
then_conv rewr_conv' @{lemma "(False & P) = False" by simp})) context) 1) ctxt 1 |
ee729dbd1b7f
avoid ML_file in large theory files to improve performance of dependency discovery of main HOL (approx. 1s CPU time) -- relevant for any application using it, e.g. small paper sessions;
wenzelm
parents:
50134
diff
changeset
|
606 |
THEN rtac set_Nil_I 1 |
ee729dbd1b7f
avoid ML_file in large theory files to improve performance of dependency discovery of main HOL (approx. 1s CPU time) -- relevant for any application using it, e.g. small paper sessions;
wenzelm
parents:
50134
diff
changeset
|
607 |
| tac ctxt (Case (T, i) :: cont) = |
ee729dbd1b7f
avoid ML_file in large theory files to improve performance of dependency discovery of main HOL (approx. 1s CPU time) -- relevant for any application using it, e.g. small paper sessions;
wenzelm
parents:
50134
diff
changeset
|
608 |
let |
ee729dbd1b7f
avoid ML_file in large theory files to improve performance of dependency discovery of main HOL (approx. 1s CPU time) -- relevant for any application using it, e.g. small paper sessions;
wenzelm
parents:
50134
diff
changeset
|
609 |
val info = Datatype.the_info thy (fst (dest_Type T)) |
ee729dbd1b7f
avoid ML_file in large theory files to improve performance of dependency discovery of main HOL (approx. 1s CPU time) -- relevant for any application using it, e.g. small paper sessions;
wenzelm
parents:
50134
diff
changeset
|
610 |
in |
ee729dbd1b7f
avoid ML_file in large theory files to improve performance of dependency discovery of main HOL (approx. 1s CPU time) -- relevant for any application using it, e.g. small paper sessions;
wenzelm
parents:
50134
diff
changeset
|
611 |
(* do case distinction *) |
ee729dbd1b7f
avoid ML_file in large theory files to improve performance of dependency discovery of main HOL (approx. 1s CPU time) -- relevant for any application using it, e.g. small paper sessions;
wenzelm
parents:
50134
diff
changeset
|
612 |
Splitter.split_tac [#split info] 1 |
ee729dbd1b7f
avoid ML_file in large theory files to improve performance of dependency discovery of main HOL (approx. 1s CPU time) -- relevant for any application using it, e.g. small paper sessions;
wenzelm
parents:
50134
diff
changeset
|
613 |
THEN EVERY (map_index (fn (i', _) => |
ee729dbd1b7f
avoid ML_file in large theory files to improve performance of dependency discovery of main HOL (approx. 1s CPU time) -- relevant for any application using it, e.g. small paper sessions;
wenzelm
parents:
50134
diff
changeset
|
614 |
(if i' < length (#case_rewrites info) - 1 then rtac @{thm conjI} 1 else all_tac) |
ee729dbd1b7f
avoid ML_file in large theory files to improve performance of dependency discovery of main HOL (approx. 1s CPU time) -- relevant for any application using it, e.g. small paper sessions;
wenzelm
parents:
50134
diff
changeset
|
615 |
THEN REPEAT_DETERM (rtac @{thm allI} 1) |
ee729dbd1b7f
avoid ML_file in large theory files to improve performance of dependency discovery of main HOL (approx. 1s CPU time) -- relevant for any application using it, e.g. small paper sessions;
wenzelm
parents:
50134
diff
changeset
|
616 |
THEN rtac @{thm impI} 1 |
ee729dbd1b7f
avoid ML_file in large theory files to improve performance of dependency discovery of main HOL (approx. 1s CPU time) -- relevant for any application using it, e.g. small paper sessions;
wenzelm
parents:
50134
diff
changeset
|
617 |
THEN (if i' = i then |
ee729dbd1b7f
avoid ML_file in large theory files to improve performance of dependency discovery of main HOL (approx. 1s CPU time) -- relevant for any application using it, e.g. small paper sessions;
wenzelm
parents:
50134
diff
changeset
|
618 |
(* continue recursively *) |
ee729dbd1b7f
avoid ML_file in large theory files to improve performance of dependency discovery of main HOL (approx. 1s CPU time) -- relevant for any application using it, e.g. small paper sessions;
wenzelm
parents:
50134
diff
changeset
|
619 |
Subgoal.FOCUS (fn {prems, context, ...} => |
ee729dbd1b7f
avoid ML_file in large theory files to improve performance of dependency discovery of main HOL (approx. 1s CPU time) -- relevant for any application using it, e.g. small paper sessions;
wenzelm
parents:
50134
diff
changeset
|
620 |
CONVERSION (Thm.eta_conversion then_conv right_hand_set_comprehension_conv (K |
ee729dbd1b7f
avoid ML_file in large theory files to improve performance of dependency discovery of main HOL (approx. 1s CPU time) -- relevant for any application using it, e.g. small paper sessions;
wenzelm
parents:
50134
diff
changeset
|
621 |
((conj_conv |
ee729dbd1b7f
avoid ML_file in large theory files to improve performance of dependency discovery of main HOL (approx. 1s CPU time) -- relevant for any application using it, e.g. small paper sessions;
wenzelm
parents:
50134
diff
changeset
|
622 |
(eq_conv Conv.all_conv (rewr_conv' (List.last prems)) then_conv |
ee729dbd1b7f
avoid ML_file in large theory files to improve performance of dependency discovery of main HOL (approx. 1s CPU time) -- relevant for any application using it, e.g. small paper sessions;
wenzelm
parents:
50134
diff
changeset
|
623 |
(Conv.try_conv (Conv.rewrs_conv (map mk_meta_eq (#inject info))))) |
ee729dbd1b7f
avoid ML_file in large theory files to improve performance of dependency discovery of main HOL (approx. 1s CPU time) -- relevant for any application using it, e.g. small paper sessions;
wenzelm
parents:
50134
diff
changeset
|
624 |
Conv.all_conv) |
ee729dbd1b7f
avoid ML_file in large theory files to improve performance of dependency discovery of main HOL (approx. 1s CPU time) -- relevant for any application using it, e.g. small paper sessions;
wenzelm
parents:
50134
diff
changeset
|
625 |
then_conv (Conv.try_conv (Conv.rewr_conv del_refl_eq)) |
ee729dbd1b7f
avoid ML_file in large theory files to improve performance of dependency discovery of main HOL (approx. 1s CPU time) -- relevant for any application using it, e.g. small paper sessions;
wenzelm
parents:
50134
diff
changeset
|
626 |
then_conv conjunct_assoc_conv)) context |
ee729dbd1b7f
avoid ML_file in large theory files to improve performance of dependency discovery of main HOL (approx. 1s CPU time) -- relevant for any application using it, e.g. small paper sessions;
wenzelm
parents:
50134
diff
changeset
|
627 |
then_conv (Trueprop_conv (eq_conv Conv.all_conv (Collect_conv (fn (_, ctxt) => |
ee729dbd1b7f
avoid ML_file in large theory files to improve performance of dependency discovery of main HOL (approx. 1s CPU time) -- relevant for any application using it, e.g. small paper sessions;
wenzelm
parents:
50134
diff
changeset
|
628 |
Conv.repeat_conv |
ee729dbd1b7f
avoid ML_file in large theory files to improve performance of dependency discovery of main HOL (approx. 1s CPU time) -- relevant for any application using it, e.g. small paper sessions;
wenzelm
parents:
50134
diff
changeset
|
629 |
(all_but_last_exists_conv |
ee729dbd1b7f
avoid ML_file in large theory files to improve performance of dependency discovery of main HOL (approx. 1s CPU time) -- relevant for any application using it, e.g. small paper sessions;
wenzelm
parents:
50134
diff
changeset
|
630 |
(K (rewr_conv' |
ee729dbd1b7f
avoid ML_file in large theory files to improve performance of dependency discovery of main HOL (approx. 1s CPU time) -- relevant for any application using it, e.g. small paper sessions;
wenzelm
parents:
50134
diff
changeset
|
631 |
@{lemma "(EX x. x = t & P x) = P t" by simp})) ctxt)) context)))) 1) ctxt 1 |
ee729dbd1b7f
avoid ML_file in large theory files to improve performance of dependency discovery of main HOL (approx. 1s CPU time) -- relevant for any application using it, e.g. small paper sessions;
wenzelm
parents:
50134
diff
changeset
|
632 |
THEN tac ctxt cont |
ee729dbd1b7f
avoid ML_file in large theory files to improve performance of dependency discovery of main HOL (approx. 1s CPU time) -- relevant for any application using it, e.g. small paper sessions;
wenzelm
parents:
50134
diff
changeset
|
633 |
else |
ee729dbd1b7f
avoid ML_file in large theory files to improve performance of dependency discovery of main HOL (approx. 1s CPU time) -- relevant for any application using it, e.g. small paper sessions;
wenzelm
parents:
50134
diff
changeset
|
634 |
Subgoal.FOCUS (fn {prems, context, ...} => |
ee729dbd1b7f
avoid ML_file in large theory files to improve performance of dependency discovery of main HOL (approx. 1s CPU time) -- relevant for any application using it, e.g. small paper sessions;
wenzelm
parents:
50134
diff
changeset
|
635 |
CONVERSION |
ee729dbd1b7f
avoid ML_file in large theory files to improve performance of dependency discovery of main HOL (approx. 1s CPU time) -- relevant for any application using it, e.g. small paper sessions;
wenzelm
parents:
50134
diff
changeset
|
636 |
(right_hand_set_comprehension_conv (K |
ee729dbd1b7f
avoid ML_file in large theory files to improve performance of dependency discovery of main HOL (approx. 1s CPU time) -- relevant for any application using it, e.g. small paper sessions;
wenzelm
parents:
50134
diff
changeset
|
637 |
(conj_conv |
ee729dbd1b7f
avoid ML_file in large theory files to improve performance of dependency discovery of main HOL (approx. 1s CPU time) -- relevant for any application using it, e.g. small paper sessions;
wenzelm
parents:
50134
diff
changeset
|
638 |
((eq_conv Conv.all_conv |
ee729dbd1b7f
avoid ML_file in large theory files to improve performance of dependency discovery of main HOL (approx. 1s CPU time) -- relevant for any application using it, e.g. small paper sessions;
wenzelm
parents:
50134
diff
changeset
|
639 |
(rewr_conv' (List.last prems))) then_conv |
ee729dbd1b7f
avoid ML_file in large theory files to improve performance of dependency discovery of main HOL (approx. 1s CPU time) -- relevant for any application using it, e.g. small paper sessions;
wenzelm
parents:
50134
diff
changeset
|
640 |
(Conv.rewrs_conv (map (fn th => th RS @{thm Eq_FalseI}) (#distinct info)))) |
ee729dbd1b7f
avoid ML_file in large theory files to improve performance of dependency discovery of main HOL (approx. 1s CPU time) -- relevant for any application using it, e.g. small paper sessions;
wenzelm
parents:
50134
diff
changeset
|
641 |
Conv.all_conv then_conv |
ee729dbd1b7f
avoid ML_file in large theory files to improve performance of dependency discovery of main HOL (approx. 1s CPU time) -- relevant for any application using it, e.g. small paper sessions;
wenzelm
parents:
50134
diff
changeset
|
642 |
(rewr_conv' @{lemma "(False & P) = False" by simp}))) context then_conv |
ee729dbd1b7f
avoid ML_file in large theory files to improve performance of dependency discovery of main HOL (approx. 1s CPU time) -- relevant for any application using it, e.g. small paper sessions;
wenzelm
parents:
50134
diff
changeset
|
643 |
Trueprop_conv |
ee729dbd1b7f
avoid ML_file in large theory files to improve performance of dependency discovery of main HOL (approx. 1s CPU time) -- relevant for any application using it, e.g. small paper sessions;
wenzelm
parents:
50134
diff
changeset
|
644 |
(eq_conv Conv.all_conv |
ee729dbd1b7f
avoid ML_file in large theory files to improve performance of dependency discovery of main HOL (approx. 1s CPU time) -- relevant for any application using it, e.g. small paper sessions;
wenzelm
parents:
50134
diff
changeset
|
645 |
(Collect_conv (fn (_, ctxt) => |
ee729dbd1b7f
avoid ML_file in large theory files to improve performance of dependency discovery of main HOL (approx. 1s CPU time) -- relevant for any application using it, e.g. small paper sessions;
wenzelm
parents:
50134
diff
changeset
|
646 |
Conv.repeat_conv |
ee729dbd1b7f
avoid ML_file in large theory files to improve performance of dependency discovery of main HOL (approx. 1s CPU time) -- relevant for any application using it, e.g. small paper sessions;
wenzelm
parents:
50134
diff
changeset
|
647 |
(Conv.bottom_conv |
ee729dbd1b7f
avoid ML_file in large theory files to improve performance of dependency discovery of main HOL (approx. 1s CPU time) -- relevant for any application using it, e.g. small paper sessions;
wenzelm
parents:
50134
diff
changeset
|
648 |
(K (rewr_conv' |
ee729dbd1b7f
avoid ML_file in large theory files to improve performance of dependency discovery of main HOL (approx. 1s CPU time) -- relevant for any application using it, e.g. small paper sessions;
wenzelm
parents:
50134
diff
changeset
|
649 |
@{lemma "(EX x. P) = P" by simp})) ctxt)) context))) 1) ctxt 1 |
ee729dbd1b7f
avoid ML_file in large theory files to improve performance of dependency discovery of main HOL (approx. 1s CPU time) -- relevant for any application using it, e.g. small paper sessions;
wenzelm
parents:
50134
diff
changeset
|
650 |
THEN rtac set_Nil_I 1)) (#case_rewrites info)) |
ee729dbd1b7f
avoid ML_file in large theory files to improve performance of dependency discovery of main HOL (approx. 1s CPU time) -- relevant for any application using it, e.g. small paper sessions;
wenzelm
parents:
50134
diff
changeset
|
651 |
end |
ee729dbd1b7f
avoid ML_file in large theory files to improve performance of dependency discovery of main HOL (approx. 1s CPU time) -- relevant for any application using it, e.g. small paper sessions;
wenzelm
parents:
50134
diff
changeset
|
652 |
fun make_inner_eqs bound_vs Tis eqs t = |
ee729dbd1b7f
avoid ML_file in large theory files to improve performance of dependency discovery of main HOL (approx. 1s CPU time) -- relevant for any application using it, e.g. small paper sessions;
wenzelm
parents:
50134
diff
changeset
|
653 |
(case dest_case t of |
ee729dbd1b7f
avoid ML_file in large theory files to improve performance of dependency discovery of main HOL (approx. 1s CPU time) -- relevant for any application using it, e.g. small paper sessions;
wenzelm
parents:
50134
diff
changeset
|
654 |
SOME (x, T, i, cont) => |
ee729dbd1b7f
avoid ML_file in large theory files to improve performance of dependency discovery of main HOL (approx. 1s CPU time) -- relevant for any application using it, e.g. small paper sessions;
wenzelm
parents:
50134
diff
changeset
|
655 |
let |
ee729dbd1b7f
avoid ML_file in large theory files to improve performance of dependency discovery of main HOL (approx. 1s CPU time) -- relevant for any application using it, e.g. small paper sessions;
wenzelm
parents:
50134
diff
changeset
|
656 |
val (vs, body) = strip_abs (Pattern.eta_long (map snd bound_vs) cont) |
ee729dbd1b7f
avoid ML_file in large theory files to improve performance of dependency discovery of main HOL (approx. 1s CPU time) -- relevant for any application using it, e.g. small paper sessions;
wenzelm
parents:
50134
diff
changeset
|
657 |
val x' = incr_boundvars (length vs) x |
ee729dbd1b7f
avoid ML_file in large theory files to improve performance of dependency discovery of main HOL (approx. 1s CPU time) -- relevant for any application using it, e.g. small paper sessions;
wenzelm
parents:
50134
diff
changeset
|
658 |
val eqs' = map (incr_boundvars (length vs)) eqs |
ee729dbd1b7f
avoid ML_file in large theory files to improve performance of dependency discovery of main HOL (approx. 1s CPU time) -- relevant for any application using it, e.g. small paper sessions;
wenzelm
parents:
50134
diff
changeset
|
659 |
val (constr_name, _) = nth (the (Datatype.get_constrs thy (fst (dest_Type T)))) i |
ee729dbd1b7f
avoid ML_file in large theory files to improve performance of dependency discovery of main HOL (approx. 1s CPU time) -- relevant for any application using it, e.g. small paper sessions;
wenzelm
parents:
50134
diff
changeset
|
660 |
val constr_t = |
ee729dbd1b7f
avoid ML_file in large theory files to improve performance of dependency discovery of main HOL (approx. 1s CPU time) -- relevant for any application using it, e.g. small paper sessions;
wenzelm
parents:
50134
diff
changeset
|
661 |
list_comb |
ee729dbd1b7f
avoid ML_file in large theory files to improve performance of dependency discovery of main HOL (approx. 1s CPU time) -- relevant for any application using it, e.g. small paper sessions;
wenzelm
parents:
50134
diff
changeset
|
662 |
(Const (constr_name, map snd vs ---> T), map Bound (((length vs) - 1) downto 0)) |
ee729dbd1b7f
avoid ML_file in large theory files to improve performance of dependency discovery of main HOL (approx. 1s CPU time) -- relevant for any application using it, e.g. small paper sessions;
wenzelm
parents:
50134
diff
changeset
|
663 |
val constr_eq = Const (@{const_name HOL.eq}, T --> T --> @{typ bool}) $ constr_t $ x' |
ee729dbd1b7f
avoid ML_file in large theory files to improve performance of dependency discovery of main HOL (approx. 1s CPU time) -- relevant for any application using it, e.g. small paper sessions;
wenzelm
parents:
50134
diff
changeset
|
664 |
in |
ee729dbd1b7f
avoid ML_file in large theory files to improve performance of dependency discovery of main HOL (approx. 1s CPU time) -- relevant for any application using it, e.g. small paper sessions;
wenzelm
parents:
50134
diff
changeset
|
665 |
make_inner_eqs (rev vs @ bound_vs) (Case (T, i) :: Tis) (constr_eq :: eqs') body |
ee729dbd1b7f
avoid ML_file in large theory files to improve performance of dependency discovery of main HOL (approx. 1s CPU time) -- relevant for any application using it, e.g. small paper sessions;
wenzelm
parents:
50134
diff
changeset
|
666 |
end |
ee729dbd1b7f
avoid ML_file in large theory files to improve performance of dependency discovery of main HOL (approx. 1s CPU time) -- relevant for any application using it, e.g. small paper sessions;
wenzelm
parents:
50134
diff
changeset
|
667 |
| NONE => |
ee729dbd1b7f
avoid ML_file in large theory files to improve performance of dependency discovery of main HOL (approx. 1s CPU time) -- relevant for any application using it, e.g. small paper sessions;
wenzelm
parents:
50134
diff
changeset
|
668 |
(case dest_if t of |
ee729dbd1b7f
avoid ML_file in large theory files to improve performance of dependency discovery of main HOL (approx. 1s CPU time) -- relevant for any application using it, e.g. small paper sessions;
wenzelm
parents:
50134
diff
changeset
|
669 |
SOME (condition, cont) => make_inner_eqs bound_vs (If :: Tis) (condition :: eqs) cont |
ee729dbd1b7f
avoid ML_file in large theory files to improve performance of dependency discovery of main HOL (approx. 1s CPU time) -- relevant for any application using it, e.g. small paper sessions;
wenzelm
parents:
50134
diff
changeset
|
670 |
| NONE => |
ee729dbd1b7f
avoid ML_file in large theory files to improve performance of dependency discovery of main HOL (approx. 1s CPU time) -- relevant for any application using it, e.g. small paper sessions;
wenzelm
parents:
50134
diff
changeset
|
671 |
if eqs = [] then NONE (* no rewriting, nothing to be done *) |
ee729dbd1b7f
avoid ML_file in large theory files to improve performance of dependency discovery of main HOL (approx. 1s CPU time) -- relevant for any application using it, e.g. small paper sessions;
wenzelm
parents:
50134
diff
changeset
|
672 |
else |
ee729dbd1b7f
avoid ML_file in large theory files to improve performance of dependency discovery of main HOL (approx. 1s CPU time) -- relevant for any application using it, e.g. small paper sessions;
wenzelm
parents:
50134
diff
changeset
|
673 |
let |
ee729dbd1b7f
avoid ML_file in large theory files to improve performance of dependency discovery of main HOL (approx. 1s CPU time) -- relevant for any application using it, e.g. small paper sessions;
wenzelm
parents:
50134
diff
changeset
|
674 |
val Type (@{type_name List.list}, [rT]) = fastype_of1 (map snd bound_vs, t) |
ee729dbd1b7f
avoid ML_file in large theory files to improve performance of dependency discovery of main HOL (approx. 1s CPU time) -- relevant for any application using it, e.g. small paper sessions;
wenzelm
parents:
50134
diff
changeset
|
675 |
val pat_eq = |
ee729dbd1b7f
avoid ML_file in large theory files to improve performance of dependency discovery of main HOL (approx. 1s CPU time) -- relevant for any application using it, e.g. small paper sessions;
wenzelm
parents:
50134
diff
changeset
|
676 |
(case try dest_singleton_list t of |
ee729dbd1b7f
avoid ML_file in large theory files to improve performance of dependency discovery of main HOL (approx. 1s CPU time) -- relevant for any application using it, e.g. small paper sessions;
wenzelm
parents:
50134
diff
changeset
|
677 |
SOME t' => |
ee729dbd1b7f
avoid ML_file in large theory files to improve performance of dependency discovery of main HOL (approx. 1s CPU time) -- relevant for any application using it, e.g. small paper sessions;
wenzelm
parents:
50134
diff
changeset
|
678 |
Const (@{const_name HOL.eq}, rT --> rT --> @{typ bool}) $ |
ee729dbd1b7f
avoid ML_file in large theory files to improve performance of dependency discovery of main HOL (approx. 1s CPU time) -- relevant for any application using it, e.g. small paper sessions;
wenzelm
parents:
50134
diff
changeset
|
679 |
Bound (length bound_vs) $ t' |
ee729dbd1b7f
avoid ML_file in large theory files to improve performance of dependency discovery of main HOL (approx. 1s CPU time) -- relevant for any application using it, e.g. small paper sessions;
wenzelm
parents:
50134
diff
changeset
|
680 |
| NONE => |
ee729dbd1b7f
avoid ML_file in large theory files to improve performance of dependency discovery of main HOL (approx. 1s CPU time) -- relevant for any application using it, e.g. small paper sessions;
wenzelm
parents:
50134
diff
changeset
|
681 |
Const (@{const_name Set.member}, rT --> HOLogic.mk_setT rT --> @{typ bool}) $ |
ee729dbd1b7f
avoid ML_file in large theory files to improve performance of dependency discovery of main HOL (approx. 1s CPU time) -- relevant for any application using it, e.g. small paper sessions;
wenzelm
parents:
50134
diff
changeset
|
682 |
Bound (length bound_vs) $ (mk_set rT $ t)) |
ee729dbd1b7f
avoid ML_file in large theory files to improve performance of dependency discovery of main HOL (approx. 1s CPU time) -- relevant for any application using it, e.g. small paper sessions;
wenzelm
parents:
50134
diff
changeset
|
683 |
val reverse_bounds = curry subst_bounds |
ee729dbd1b7f
avoid ML_file in large theory files to improve performance of dependency discovery of main HOL (approx. 1s CPU time) -- relevant for any application using it, e.g. small paper sessions;
wenzelm
parents:
50134
diff
changeset
|
684 |
((map Bound ((length bound_vs - 1) downto 0)) @ [Bound (length bound_vs)]) |
ee729dbd1b7f
avoid ML_file in large theory files to improve performance of dependency discovery of main HOL (approx. 1s CPU time) -- relevant for any application using it, e.g. small paper sessions;
wenzelm
parents:
50134
diff
changeset
|
685 |
val eqs' = map reverse_bounds eqs |
ee729dbd1b7f
avoid ML_file in large theory files to improve performance of dependency discovery of main HOL (approx. 1s CPU time) -- relevant for any application using it, e.g. small paper sessions;
wenzelm
parents:
50134
diff
changeset
|
686 |
val pat_eq' = reverse_bounds pat_eq |
ee729dbd1b7f
avoid ML_file in large theory files to improve performance of dependency discovery of main HOL (approx. 1s CPU time) -- relevant for any application using it, e.g. small paper sessions;
wenzelm
parents:
50134
diff
changeset
|
687 |
val inner_t = |
ee729dbd1b7f
avoid ML_file in large theory files to improve performance of dependency discovery of main HOL (approx. 1s CPU time) -- relevant for any application using it, e.g. small paper sessions;
wenzelm
parents:
50134
diff
changeset
|
688 |
fold (fn (_, T) => fn t => HOLogic.exists_const T $ absdummy T t) |
ee729dbd1b7f
avoid ML_file in large theory files to improve performance of dependency discovery of main HOL (approx. 1s CPU time) -- relevant for any application using it, e.g. small paper sessions;
wenzelm
parents:
50134
diff
changeset
|
689 |
(rev bound_vs) (fold (curry HOLogic.mk_conj) eqs' pat_eq') |
ee729dbd1b7f
avoid ML_file in large theory files to improve performance of dependency discovery of main HOL (approx. 1s CPU time) -- relevant for any application using it, e.g. small paper sessions;
wenzelm
parents:
50134
diff
changeset
|
690 |
val lhs = term_of redex |
ee729dbd1b7f
avoid ML_file in large theory files to improve performance of dependency discovery of main HOL (approx. 1s CPU time) -- relevant for any application using it, e.g. small paper sessions;
wenzelm
parents:
50134
diff
changeset
|
691 |
val rhs = HOLogic.mk_Collect ("x", rT, inner_t) |
ee729dbd1b7f
avoid ML_file in large theory files to improve performance of dependency discovery of main HOL (approx. 1s CPU time) -- relevant for any application using it, e.g. small paper sessions;
wenzelm
parents:
50134
diff
changeset
|
692 |
val rewrite_rule_t = HOLogic.mk_Trueprop (HOLogic.mk_eq (lhs, rhs)) |
ee729dbd1b7f
avoid ML_file in large theory files to improve performance of dependency discovery of main HOL (approx. 1s CPU time) -- relevant for any application using it, e.g. small paper sessions;
wenzelm
parents:
50134
diff
changeset
|
693 |
in |
ee729dbd1b7f
avoid ML_file in large theory files to improve performance of dependency discovery of main HOL (approx. 1s CPU time) -- relevant for any application using it, e.g. small paper sessions;
wenzelm
parents:
50134
diff
changeset
|
694 |
SOME |
ee729dbd1b7f
avoid ML_file in large theory files to improve performance of dependency discovery of main HOL (approx. 1s CPU time) -- relevant for any application using it, e.g. small paper sessions;
wenzelm
parents:
50134
diff
changeset
|
695 |
((Goal.prove ctxt [] [] rewrite_rule_t |
ee729dbd1b7f
avoid ML_file in large theory files to improve performance of dependency discovery of main HOL (approx. 1s CPU time) -- relevant for any application using it, e.g. small paper sessions;
wenzelm
parents:
50134
diff
changeset
|
696 |
(fn {context, ...} => tac context (rev Tis))) RS @{thm eq_reflection}) |
ee729dbd1b7f
avoid ML_file in large theory files to improve performance of dependency discovery of main HOL (approx. 1s CPU time) -- relevant for any application using it, e.g. small paper sessions;
wenzelm
parents:
50134
diff
changeset
|
697 |
end)) |
ee729dbd1b7f
avoid ML_file in large theory files to improve performance of dependency discovery of main HOL (approx. 1s CPU time) -- relevant for any application using it, e.g. small paper sessions;
wenzelm
parents:
50134
diff
changeset
|
698 |
in |
ee729dbd1b7f
avoid ML_file in large theory files to improve performance of dependency discovery of main HOL (approx. 1s CPU time) -- relevant for any application using it, e.g. small paper sessions;
wenzelm
parents:
50134
diff
changeset
|
699 |
make_inner_eqs [] [] [] (dest_set (term_of redex)) |
ee729dbd1b7f
avoid ML_file in large theory files to improve performance of dependency discovery of main HOL (approx. 1s CPU time) -- relevant for any application using it, e.g. small paper sessions;
wenzelm
parents:
50134
diff
changeset
|
700 |
end |
ee729dbd1b7f
avoid ML_file in large theory files to improve performance of dependency discovery of main HOL (approx. 1s CPU time) -- relevant for any application using it, e.g. small paper sessions;
wenzelm
parents:
50134
diff
changeset
|
701 |
|
ee729dbd1b7f
avoid ML_file in large theory files to improve performance of dependency discovery of main HOL (approx. 1s CPU time) -- relevant for any application using it, e.g. small paper sessions;
wenzelm
parents:
50134
diff
changeset
|
702 |
end |
ee729dbd1b7f
avoid ML_file in large theory files to improve performance of dependency discovery of main HOL (approx. 1s CPU time) -- relevant for any application using it, e.g. small paper sessions;
wenzelm
parents:
50134
diff
changeset
|
703 |
*} |
41463
edbf0a86fb1c
adding simproc to rewrite list comprehensions to set comprehensions; adopting proofs
bulwahn
parents:
41372
diff
changeset
|
704 |
|
edbf0a86fb1c
adding simproc to rewrite list comprehensions to set comprehensions; adopting proofs
bulwahn
parents:
41372
diff
changeset
|
705 |
simproc_setup list_to_set_comprehension ("set xs") = {* K List_to_Set_Comprehension.simproc *} |
edbf0a86fb1c
adding simproc to rewrite list comprehensions to set comprehensions; adopting proofs
bulwahn
parents:
41372
diff
changeset
|
706 |
|
46133
d9fe85d3d2cd
incorporated canonical fold combinator on lists into body of List theory; refactored passages on List.fold(l/r)
haftmann
parents:
46125
diff
changeset
|
707 |
code_datatype set coset |
d9fe85d3d2cd
incorporated canonical fold combinator on lists into body of List theory; refactored passages on List.fold(l/r)
haftmann
parents:
46125
diff
changeset
|
708 |
|
d9fe85d3d2cd
incorporated canonical fold combinator on lists into body of List theory; refactored passages on List.fold(l/r)
haftmann
parents:
46125
diff
changeset
|
709 |
hide_const (open) coset |
35115 | 710 |
|
49948
744934b818c7
moved quite generic material from theory Enum to more appropriate places
haftmann
parents:
49808
diff
changeset
|
711 |
|
21061
580dfc999ef6
added normal post setup; cleaned up "execution" constants
haftmann
parents:
21046
diff
changeset
|
712 |
subsubsection {* @{const Nil} and @{const Cons} *} |
580dfc999ef6
added normal post setup; cleaned up "execution" constants
haftmann
parents:
21046
diff
changeset
|
713 |
|
580dfc999ef6
added normal post setup; cleaned up "execution" constants
haftmann
parents:
21046
diff
changeset
|
714 |
lemma not_Cons_self [simp]: |
580dfc999ef6
added normal post setup; cleaned up "execution" constants
haftmann
parents:
21046
diff
changeset
|
715 |
"xs \<noteq> x # xs" |
13145 | 716 |
by (induct xs) auto |
13114 | 717 |
|
41697 | 718 |
lemma not_Cons_self2 [simp]: |
719 |
"x # xs \<noteq> xs" |
|
720 |
by (rule not_Cons_self [symmetric]) |
|
13114 | 721 |
|
13142 | 722 |
lemma neq_Nil_conv: "(xs \<noteq> []) = (\<exists>y ys. xs = y # ys)" |
13145 | 723 |
by (induct xs) auto |
13114 | 724 |
|
13142 | 725 |
lemma length_induct: |
21061
580dfc999ef6
added normal post setup; cleaned up "execution" constants
haftmann
parents:
21046
diff
changeset
|
726 |
"(\<And>xs. \<forall>ys. length ys < length xs \<longrightarrow> P ys \<Longrightarrow> P xs) \<Longrightarrow> P xs" |
17589 | 727 |
by (rule measure_induct [of length]) iprover |
13114 | 728 |
|
37289 | 729 |
lemma list_nonempty_induct [consumes 1, case_names single cons]: |
730 |
assumes "xs \<noteq> []" |
|
731 |
assumes single: "\<And>x. P [x]" |
|
732 |
assumes cons: "\<And>x xs. xs \<noteq> [] \<Longrightarrow> P xs \<Longrightarrow> P (x # xs)" |
|
733 |
shows "P xs" |
|
734 |
using `xs \<noteq> []` proof (induct xs) |
|
735 |
case Nil then show ?case by simp |
|
736 |
next |
|
737 |
case (Cons x xs) show ?case proof (cases xs) |
|
738 |
case Nil with single show ?thesis by simp |
|
739 |
next |
|
740 |
case Cons then have "xs \<noteq> []" by simp |
|
741 |
moreover with Cons.hyps have "P xs" . |
|
742 |
ultimately show ?thesis by (rule cons) |
|
743 |
qed |
|
744 |
qed |
|
745 |
||
45714 | 746 |
lemma inj_split_Cons: "inj_on (\<lambda>(xs, n). n#xs) X" |
747 |
by (auto intro!: inj_onI) |
|
13114 | 748 |
|
49948
744934b818c7
moved quite generic material from theory Enum to more appropriate places
haftmann
parents:
49808
diff
changeset
|
749 |
|
21061
580dfc999ef6
added normal post setup; cleaned up "execution" constants
haftmann
parents:
21046
diff
changeset
|
750 |
subsubsection {* @{const length} *} |
13114 | 751 |
|
13142 | 752 |
text {* |
21061
580dfc999ef6
added normal post setup; cleaned up "execution" constants
haftmann
parents:
21046
diff
changeset
|
753 |
Needs to come before @{text "@"} because of theorem @{text |
580dfc999ef6
added normal post setup; cleaned up "execution" constants
haftmann
parents:
21046
diff
changeset
|
754 |
append_eq_append_conv}. |
13142 | 755 |
*} |
13114 | 756 |
|
13142 | 757 |
lemma length_append [simp]: "length (xs @ ys) = length xs + length ys" |
13145 | 758 |
by (induct xs) auto |
13114 | 759 |
|
13142 | 760 |
lemma length_map [simp]: "length (map f xs) = length xs" |
13145 | 761 |
by (induct xs) auto |
13114 | 762 |
|
13142 | 763 |
lemma length_rev [simp]: "length (rev xs) = length xs" |
13145 | 764 |
by (induct xs) auto |
13114 | 765 |
|
13142 | 766 |
lemma length_tl [simp]: "length (tl xs) = length xs - 1" |
13145 | 767 |
by (cases xs) auto |
13114 | 768 |
|
13142 | 769 |
lemma length_0_conv [iff]: "(length xs = 0) = (xs = [])" |
13145 | 770 |
by (induct xs) auto |
13114 | 771 |
|
13142 | 772 |
lemma length_greater_0_conv [iff]: "(0 < length xs) = (xs \<noteq> [])" |
13145 | 773 |
by (induct xs) auto |
13114 | 774 |
|
23479 | 775 |
lemma length_pos_if_in_set: "x : set xs \<Longrightarrow> length xs > 0" |
776 |
by auto |
|
777 |
||
13114 | 778 |
lemma length_Suc_conv: |
13145 | 779 |
"(length xs = Suc n) = (\<exists>y ys. xs = y # ys \<and> length ys = n)" |
780 |
by (induct xs) auto |
|
13142 | 781 |
|
14025 | 782 |
lemma Suc_length_conv: |
783 |
"(Suc n = length xs) = (\<exists>y ys. xs = y # ys \<and> length ys = n)" |
|
14208 | 784 |
apply (induct xs, simp, simp) |
14025 | 785 |
apply blast |
786 |
done |
|
787 |
||
25221
5ded95dda5df
append/member: more light-weight way to declare authentic syntax;
wenzelm
parents:
25215
diff
changeset
|
788 |
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
|
789 |
by (induct xs) auto |
5ded95dda5df
append/member: more light-weight way to declare authentic syntax;
wenzelm
parents:
25215
diff
changeset
|
790 |
|
26442
57fb6a8b099e
restructuring; explicit case names for rule list_induct2
haftmann
parents:
26300
diff
changeset
|
791 |
lemma list_induct2 [consumes 1, case_names Nil Cons]: |
57fb6a8b099e
restructuring; explicit case names for rule list_induct2
haftmann
parents:
26300
diff
changeset
|
792 |
"length xs = length ys \<Longrightarrow> P [] [] \<Longrightarrow> |
57fb6a8b099e
restructuring; explicit case names for rule list_induct2
haftmann
parents:
26300
diff
changeset
|
793 |
(\<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
|
794 |
\<Longrightarrow> P xs ys" |
57fb6a8b099e
restructuring; explicit case names for rule list_induct2
haftmann
parents:
26300
diff
changeset
|
795 |
proof (induct xs arbitrary: ys) |
57fb6a8b099e
restructuring; explicit case names for rule list_induct2
haftmann
parents:
26300
diff
changeset
|
796 |
case Nil then show ?case by simp |
57fb6a8b099e
restructuring; explicit case names for rule list_induct2
haftmann
parents:
26300
diff
changeset
|
797 |
next |
57fb6a8b099e
restructuring; explicit case names for rule list_induct2
haftmann
parents:
26300
diff
changeset
|
798 |
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
|
799 |
qed |
57fb6a8b099e
restructuring; explicit case names for rule list_induct2
haftmann
parents:
26300
diff
changeset
|
800 |
|
57fb6a8b099e
restructuring; explicit case names for rule list_induct2
haftmann
parents:
26300
diff
changeset
|
801 |
lemma list_induct3 [consumes 2, case_names Nil Cons]: |
57fb6a8b099e
restructuring; explicit case names for rule list_induct2
haftmann
parents:
26300
diff
changeset
|
802 |
"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
|
803 |
(\<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
|
804 |
\<Longrightarrow> P xs ys zs" |
57fb6a8b099e
restructuring; explicit case names for rule list_induct2
haftmann
parents:
26300
diff
changeset
|
805 |
proof (induct xs arbitrary: ys zs) |
57fb6a8b099e
restructuring; explicit case names for rule list_induct2
haftmann
parents:
26300
diff
changeset
|
806 |
case Nil then show ?case by simp |
57fb6a8b099e
restructuring; explicit case names for rule list_induct2
haftmann
parents:
26300
diff
changeset
|
807 |
next |
57fb6a8b099e
restructuring; explicit case names for rule list_induct2
haftmann
parents:
26300
diff
changeset
|
808 |
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
|
809 |
(cases zs, simp_all) |
57fb6a8b099e
restructuring; explicit case names for rule list_induct2
haftmann
parents:
26300
diff
changeset
|
810 |
qed |
13114 | 811 |
|
36154
11c6106d7787
Respectfullness and preservation of list_rel
Cezary Kaliszyk <kaliszyk@in.tum.de>
parents:
35828
diff
changeset
|
812 |
lemma list_induct4 [consumes 3, case_names Nil Cons]: |
11c6106d7787
Respectfullness and preservation of list_rel
Cezary Kaliszyk <kaliszyk@in.tum.de>
parents:
35828
diff
changeset
|
813 |
"length xs = length ys \<Longrightarrow> length ys = length zs \<Longrightarrow> length zs = length ws \<Longrightarrow> |
11c6106d7787
Respectfullness and preservation of list_rel
Cezary Kaliszyk <kaliszyk@in.tum.de>
parents:
35828
diff
changeset
|
814 |
P [] [] [] [] \<Longrightarrow> (\<And>x xs y ys z zs w ws. length xs = length ys \<Longrightarrow> |
11c6106d7787
Respectfullness and preservation of list_rel
Cezary Kaliszyk <kaliszyk@in.tum.de>
parents:
35828
diff
changeset
|
815 |
length ys = length zs \<Longrightarrow> length zs = length ws \<Longrightarrow> P xs ys zs ws \<Longrightarrow> |
11c6106d7787
Respectfullness and preservation of list_rel
Cezary Kaliszyk <kaliszyk@in.tum.de>
parents:
35828
diff
changeset
|
816 |
P (x#xs) (y#ys) (z#zs) (w#ws)) \<Longrightarrow> P xs ys zs ws" |
11c6106d7787
Respectfullness and preservation of list_rel
Cezary Kaliszyk <kaliszyk@in.tum.de>
parents:
35828
diff
changeset
|
817 |
proof (induct xs arbitrary: ys zs ws) |
11c6106d7787
Respectfullness and preservation of list_rel
Cezary Kaliszyk <kaliszyk@in.tum.de>
parents:
35828
diff
changeset
|
818 |
case Nil then show ?case by simp |
11c6106d7787
Respectfullness and preservation of list_rel
Cezary Kaliszyk <kaliszyk@in.tum.de>
parents:
35828
diff
changeset
|
819 |
next |
11c6106d7787
Respectfullness and preservation of list_rel
Cezary Kaliszyk <kaliszyk@in.tum.de>
parents:
35828
diff
changeset
|
820 |
case (Cons x xs ys zs ws) then show ?case by ((cases ys, simp_all), (cases zs,simp_all)) (cases ws, simp_all) |
11c6106d7787
Respectfullness and preservation of list_rel
Cezary Kaliszyk <kaliszyk@in.tum.de>
parents:
35828
diff
changeset
|
821 |
qed |
11c6106d7787
Respectfullness and preservation of list_rel
Cezary Kaliszyk <kaliszyk@in.tum.de>
parents:
35828
diff
changeset
|
822 |
|
22493
db930e490fe5
added another rule for simultaneous induction, and lemmas for zip
krauss
parents:
22422
diff
changeset
|
823 |
lemma list_induct2': |
db930e490fe5
added another rule for simultaneous induction, and lemmas for zip
krauss
parents:
22422
diff
changeset
|
824 |
"\<lbrakk> P [] []; |
db930e490fe5
added another rule for simultaneous induction, and lemmas for zip
krauss
parents:
22422
diff
changeset
|
825 |
\<And>x xs. P (x#xs) []; |
db930e490fe5
added another rule for simultaneous induction, and lemmas for zip
krauss
parents:
22422
diff
changeset
|
826 |
\<And>y ys. P [] (y#ys); |
db930e490fe5
added another rule for simultaneous induction, and lemmas for zip
krauss
parents:
22422
diff
changeset
|
827 |
\<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
|
828 |
\<Longrightarrow> P xs ys" |
db930e490fe5
added another rule for simultaneous induction, and lemmas for zip
krauss
parents:
22422
diff
changeset
|
829 |
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
|
830 |
|
22143
cf58486ca11b
Added simproc list_neq (prompted by an application)
nipkow
parents:
21911
diff
changeset
|
831 |
lemma neq_if_length_neq: "length xs \<noteq> length ys \<Longrightarrow> (xs = ys) == False" |
24349 | 832 |
by (rule Eq_FalseI) auto |
24037 | 833 |
|
834 |
simproc_setup list_neq ("(xs::'a list) = ys") = {* |
|
22143
cf58486ca11b
Added simproc list_neq (prompted by an application)
nipkow
parents:
21911
diff
changeset
|
835 |
(* |
cf58486ca11b
Added simproc list_neq (prompted by an application)
nipkow
parents:
21911
diff
changeset
|
836 |
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
|
837 |
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
|
838 |
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
|
839 |
*) |
24037 | 840 |
|
841 |
let |
|
22143
cf58486ca11b
Added simproc list_neq (prompted by an application)
nipkow
parents:
21911
diff
changeset
|
842 |
|
29856 | 843 |
fun len (Const(@{const_name Nil},_)) acc = acc |
844 |
| len (Const(@{const_name Cons},_) $ _ $ xs) (ts,n) = len xs (ts,n+1) |
|
845 |
| len (Const(@{const_name append},_) $ xs $ ys) acc = len xs (len ys acc) |
|
846 |
| len (Const(@{const_name rev},_) $ xs) acc = len xs acc |
|
847 |
| 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
|
848 |
| len t (ts,n) = (t::ts,n); |
cf58486ca11b
Added simproc list_neq (prompted by an application)
nipkow
parents:
21911
diff
changeset
|
849 |
|
24037 | 850 |
fun list_neq _ ss ct = |
22143
cf58486ca11b
Added simproc list_neq (prompted by an application)
nipkow
parents:
21911
diff
changeset
|
851 |
let |
24037 | 852 |
val (Const(_,eqT) $ lhs $ rhs) = Thm.term_of ct; |
22143
cf58486ca11b
Added simproc list_neq (prompted by an application)
nipkow
parents:
21911
diff
changeset
|
853 |
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
|
854 |
fun prove_neq() = |
cf58486ca11b
Added simproc list_neq (prompted by an application)
nipkow
parents:
21911
diff
changeset
|
855 |
let |
cf58486ca11b
Added simproc list_neq (prompted by an application)
nipkow
parents:
21911
diff
changeset
|
856 |
val Type(_,listT::_) = eqT; |
22994 | 857 |
val size = HOLogic.size_const listT; |
22143
cf58486ca11b
Added simproc list_neq (prompted by an application)
nipkow
parents:
21911
diff
changeset
|
858 |
val eq_len = HOLogic.mk_eq (size $ lhs, size $ rhs); |
cf58486ca11b
Added simproc list_neq (prompted by an application)
nipkow
parents:
21911
diff
changeset
|
859 |
val neq_len = HOLogic.mk_Trueprop (HOLogic.Not $ eq_len); |
cf58486ca11b
Added simproc list_neq (prompted by an application)
nipkow
parents:
21911
diff
changeset
|
860 |
val thm = Goal.prove (Simplifier.the_context ss) [] [] neq_len |
22633 | 861 |
(K (simp_tac (Simplifier.inherit_context ss @{simpset}) 1)); |
862 |
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
|
863 |
in |
23214 | 864 |
if m < n andalso submultiset (op aconv) (ls,rs) orelse |
865 |
n < m andalso submultiset (op aconv) (rs,ls) |
|
22143
cf58486ca11b
Added simproc list_neq (prompted by an application)
nipkow
parents:
21911
diff
changeset
|
866 |
then prove_neq() else NONE |
cf58486ca11b
Added simproc list_neq (prompted by an application)
nipkow
parents:
21911
diff
changeset
|
867 |
end; |
24037 | 868 |
in list_neq end; |
22143
cf58486ca11b
Added simproc list_neq (prompted by an application)
nipkow
parents:
21911
diff
changeset
|
869 |
*} |
cf58486ca11b
Added simproc list_neq (prompted by an application)
nipkow
parents:
21911
diff
changeset
|
870 |
|
cf58486ca11b
Added simproc list_neq (prompted by an application)
nipkow
parents:
21911
diff
changeset
|
871 |
|
15392 | 872 |
subsubsection {* @{text "@"} -- append *} |
13114 | 873 |
|
13142 | 874 |
lemma append_assoc [simp]: "(xs @ ys) @ zs = xs @ (ys @ zs)" |
13145 | 875 |
by (induct xs) auto |
13114 | 876 |
|
13142 | 877 |
lemma append_Nil2 [simp]: "xs @ [] = xs" |
13145 | 878 |
by (induct xs) auto |
3507 | 879 |
|
13142 | 880 |
lemma append_is_Nil_conv [iff]: "(xs @ ys = []) = (xs = [] \<and> ys = [])" |
13145 | 881 |
by (induct xs) auto |
13114 | 882 |
|
13142 | 883 |
lemma Nil_is_append_conv [iff]: "([] = xs @ ys) = (xs = [] \<and> ys = [])" |
13145 | 884 |
by (induct xs) auto |
13114 | 885 |
|
13142 | 886 |
lemma append_self_conv [iff]: "(xs @ ys = xs) = (ys = [])" |
13145 | 887 |
by (induct xs) auto |
13114 | 888 |
|
13142 | 889 |
lemma self_append_conv [iff]: "(xs = xs @ ys) = (ys = [])" |
13145 | 890 |
by (induct xs) auto |
13114 | 891 |
|
35828
46cfc4b8112e
now use "Named_Thms" for "noatp", and renamed "noatp" to "no_atp"
blanchet
parents:
35827
diff
changeset
|
892 |
lemma append_eq_append_conv [simp, no_atp]: |
24526 | 893 |
"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
|
894 |
==> (xs@us = ys@vs) = (xs=ys \<and> us=vs)" |
24526 | 895 |
apply (induct xs arbitrary: ys) |
14208 | 896 |
apply (case_tac ys, simp, force) |
897 |
apply (case_tac ys, force, simp) |
|
13145 | 898 |
done |
13142 | 899 |
|
24526 | 900 |
lemma append_eq_append_conv2: "(xs @ ys = zs @ ts) = |
901 |
(EX us. xs = zs @ us & us @ ys = ts | xs @ us = zs & ys = us@ ts)" |
|
902 |
apply (induct xs arbitrary: ys zs ts) |
|
44890
22f665a2e91c
new fastforce replacing fastsimp - less confusing name
nipkow
parents:
44635
diff
changeset
|
903 |
apply fastforce |
14495 | 904 |
apply(case_tac zs) |
905 |
apply simp |
|
44890
22f665a2e91c
new fastforce replacing fastsimp - less confusing name
nipkow
parents:
44635
diff
changeset
|
906 |
apply fastforce |
14495 | 907 |
done |
908 |
||
34910
b23bd3ee4813
same_append_eq / append_same_eq are now used for simplifying induction rules.
berghofe
parents:
34064
diff
changeset
|
909 |
lemma same_append_eq [iff, induct_simp]: "(xs @ ys = xs @ zs) = (ys = zs)" |
13145 | 910 |
by simp |
13142 | 911 |
|
912 |
lemma append1_eq_conv [iff]: "(xs @ [x] = ys @ [y]) = (xs = ys \<and> x = y)" |
|
13145 | 913 |
by simp |
13114 | 914 |
|
34910
b23bd3ee4813
same_append_eq / append_same_eq are now used for simplifying induction rules.
berghofe
parents:
34064
diff
changeset
|
915 |
lemma append_same_eq [iff, induct_simp]: "(ys @ xs = zs @ xs) = (ys = zs)" |
13145 | 916 |
by simp |
13114 | 917 |
|
13142 | 918 |
lemma append_self_conv2 [iff]: "(xs @ ys = ys) = (xs = [])" |
13145 | 919 |
using append_same_eq [of _ _ "[]"] by auto |
3507 | 920 |
|
13142 | 921 |
lemma self_append_conv2 [iff]: "(ys = xs @ ys) = (xs = [])" |
13145 | 922 |
using append_same_eq [of "[]"] by auto |
13114 | 923 |
|
35828
46cfc4b8112e
now use "Named_Thms" for "noatp", and renamed "noatp" to "no_atp"
blanchet
parents:
35827
diff
changeset
|
924 |
lemma hd_Cons_tl [simp,no_atp]: "xs \<noteq> [] ==> hd xs # tl xs = xs" |
13145 | 925 |
by (induct xs) auto |
13114 | 926 |
|
13142 | 927 |
lemma hd_append: "hd (xs @ ys) = (if xs = [] then hd ys else hd xs)" |
13145 | 928 |
by (induct xs) auto |
13114 | 929 |
|
13142 | 930 |
lemma hd_append2 [simp]: "xs \<noteq> [] ==> hd (xs @ ys) = hd xs" |
13145 | 931 |
by (simp add: hd_append split: list.split) |
13114 | 932 |
|
13142 | 933 |
lemma tl_append: "tl (xs @ ys) = (case xs of [] => tl ys | z#zs => zs @ ys)" |
13145 | 934 |
by (simp split: list.split) |
13114 | 935 |
|
13142 | 936 |
lemma tl_append2 [simp]: "xs \<noteq> [] ==> tl (xs @ ys) = tl xs @ ys" |
13145 | 937 |
by (simp add: tl_append split: list.split) |
13114 | 938 |
|
939 |
||
14300 | 940 |
lemma Cons_eq_append_conv: "x#xs = ys@zs = |
941 |
(ys = [] & x#xs = zs | (EX ys'. x#ys' = ys & xs = ys'@zs))" |
|
942 |
by(cases ys) auto |
|
943 |
||
15281 | 944 |
lemma append_eq_Cons_conv: "(ys@zs = x#xs) = |
945 |
(ys = [] & zs = x#xs | (EX ys'. ys = x#ys' & ys'@zs = xs))" |
|
946 |
by(cases ys) auto |
|
947 |
||
14300 | 948 |
|
13142 | 949 |
text {* Trivial rules for solving @{text "@"}-equations automatically. *} |
13114 | 950 |
|
951 |
lemma eq_Nil_appendI: "xs = ys ==> xs = [] @ ys" |
|
13145 | 952 |
by simp |
13114 | 953 |
|
13142 | 954 |
lemma Cons_eq_appendI: |
13145 | 955 |
"[| x # xs1 = ys; xs = xs1 @ zs |] ==> x # xs = ys @ zs" |
956 |
by (drule sym) simp |
|
13114 | 957 |
|
13142 | 958 |
lemma append_eq_appendI: |
13145 | 959 |
"[| xs @ xs1 = zs; ys = xs1 @ us |] ==> xs @ ys = zs @ us" |
960 |
by (drule sym) simp |
|
13114 | 961 |
|
962 |
||
13142 | 963 |
text {* |
13145 | 964 |
Simplification procedure for all list equalities. |
965 |
Currently only tries to rearrange @{text "@"} to see if |
|
966 |
- both lists end in a singleton list, |
|
967 |
- or both lists end in the same list. |
|
13142 | 968 |
*} |
969 |
||
43594 | 970 |
simproc_setup list_eq ("(xs::'a list) = ys") = {* |
13462 | 971 |
let |
43594 | 972 |
fun last (cons as Const (@{const_name Cons}, _) $ _ $ xs) = |
973 |
(case xs of Const (@{const_name Nil}, _) => cons | _ => last xs) |
|
974 |
| last (Const(@{const_name append},_) $ _ $ ys) = last ys |
|
975 |
| last t = t; |
|
976 |
||
977 |
fun list1 (Const(@{const_name Cons},_) $ _ $ Const(@{const_name Nil},_)) = true |
|
978 |
| list1 _ = false; |
|
979 |
||
980 |
fun butlast ((cons as Const(@{const_name Cons},_) $ x) $ xs) = |
|
981 |
(case xs of Const (@{const_name Nil}, _) => xs | _ => cons $ butlast xs) |
|
982 |
| butlast ((app as Const (@{const_name append}, _) $ xs) $ ys) = app $ butlast ys |
|
983 |
| butlast xs = Const(@{const_name Nil}, fastype_of xs); |
|
984 |
||
985 |
val rearr_ss = |
|
986 |
HOL_basic_ss addsimps [@{thm append_assoc}, @{thm append_Nil}, @{thm append_Cons}]; |
|
987 |
||
988 |
fun list_eq ss (F as (eq as Const(_,eqT)) $ lhs $ rhs) = |
|
13462 | 989 |
let |
43594 | 990 |
val lastl = last lhs and lastr = last rhs; |
991 |
fun rearr conv = |
|
992 |
let |
|
993 |
val lhs1 = butlast lhs and rhs1 = butlast rhs; |
|
994 |
val Type(_,listT::_) = eqT |
|
995 |
val appT = [listT,listT] ---> listT |
|
996 |
val app = Const(@{const_name append},appT) |
|
997 |
val F2 = eq $ (app$lhs1$lastl) $ (app$rhs1$lastr) |
|
998 |
val eq = HOLogic.mk_Trueprop (HOLogic.mk_eq (F,F2)); |
|
999 |
val thm = Goal.prove (Simplifier.the_context ss) [] [] eq |
|
1000 |
(K (simp_tac (Simplifier.inherit_context ss rearr_ss) 1)); |
|
1001 |
in SOME ((conv RS (thm RS trans)) RS eq_reflection) end; |
|
1002 |
in |
|
1003 |
if list1 lastl andalso list1 lastr then rearr @{thm append1_eq_conv} |
|
1004 |
else if lastl aconv lastr then rearr @{thm append_same_eq} |
|
1005 |
else NONE |
|
1006 |
end; |
|
1007 |
in fn _ => fn ss => fn ct => list_eq ss (term_of ct) end; |
|
13114 | 1008 |
*} |
1009 |
||
1010 |
||
49948
744934b818c7
moved quite generic material from theory Enum to more appropriate places
haftmann
parents:
49808
diff
changeset
|
1011 |
subsubsection {* @{const map} *} |
13114 | 1012 |
|
40210
aee7ef725330
sorting: avoid _key suffix if lemma applies both to simple and generalized variant; generalized insort_insert to insort_insert_key; additional lemmas
haftmann
parents:
40195
diff
changeset
|
1013 |
lemma hd_map: |
aee7ef725330
sorting: avoid _key suffix if lemma applies both to simple and generalized variant; generalized insort_insert to insort_insert_key; additional lemmas
haftmann
parents:
40195
diff
changeset
|
1014 |
"xs \<noteq> [] \<Longrightarrow> hd (map f xs) = f (hd xs)" |
aee7ef725330
sorting: avoid _key suffix if lemma applies both to simple and generalized variant; generalized insort_insert to insort_insert_key; additional lemmas
haftmann
parents:
40195
diff
changeset
|
1015 |
by (cases xs) simp_all |
aee7ef725330
sorting: avoid _key suffix if lemma applies both to simple and generalized variant; generalized insort_insert to insort_insert_key; additional lemmas
haftmann
parents:
40195
diff
changeset
|
1016 |
|
aee7ef725330
sorting: avoid _key suffix if lemma applies both to simple and generalized variant; generalized insort_insert to insort_insert_key; additional lemmas
haftmann
parents:
40195
diff
changeset
|
1017 |
lemma map_tl: |
aee7ef725330
sorting: avoid _key suffix if lemma applies both to simple and generalized variant; generalized insort_insert to insort_insert_key; additional lemmas
haftmann
parents:
40195
diff
changeset
|
1018 |
"map f (tl xs) = tl (map f xs)" |
aee7ef725330
sorting: avoid _key suffix if lemma applies both to simple and generalized variant; generalized insort_insert to insort_insert_key; additional lemmas
haftmann
parents:
40195
diff
changeset
|
1019 |
by (cases xs) simp_all |
aee7ef725330
sorting: avoid _key suffix if lemma applies both to simple and generalized variant; generalized insort_insert to insort_insert_key; additional lemmas
haftmann
parents:
40195
diff
changeset
|
1020 |
|
13142 | 1021 |
lemma map_ext: "(!!x. x : set xs --> f x = g x) ==> map f xs = map g xs" |
13145 | 1022 |
by (induct xs) simp_all |
13114 | 1023 |
|
13142 | 1024 |
lemma map_ident [simp]: "map (\<lambda>x. x) = (\<lambda>xs. xs)" |
13145 | 1025 |
by (rule ext, induct_tac xs) auto |
13114 | 1026 |
|
13142 | 1027 |
lemma map_append [simp]: "map f (xs @ ys) = map f xs @ map f ys" |
13145 | 1028 |
by (induct xs) auto |
13114 | 1029 |
|
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
|
1030 |
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
|
1031 |
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
|
1032 |
|
35208 | 1033 |
lemma map_comp_map[simp]: "((map f) o (map g)) = map(f o g)" |
1034 |
apply(rule ext) |
|
1035 |
apply(simp) |
|
1036 |
done |
|
1037 |
||
13142 | 1038 |
lemma rev_map: "rev (map f xs) = map f (rev xs)" |
13145 | 1039 |
by (induct xs) auto |
13114 | 1040 |
|
13737 | 1041 |
lemma map_eq_conv[simp]: "(map f xs = map g xs) = (!x : set xs. f x = g x)" |
1042 |
by (induct xs) auto |
|
1043 |
||
44013
5cfc1c36ae97
moved recdef package to HOL/Library/Old_Recdef.thy
krauss
parents:
43594
diff
changeset
|
1044 |
lemma map_cong [fundef_cong]: |
40122
1d8ad2ff3e01
dropped (almost) redundant distinct.induct rule; distinct_simps again named distinct.simps
haftmann
parents:
40077
diff
changeset
|
1045 |
"xs = ys \<Longrightarrow> (\<And>x. x \<in> set ys \<Longrightarrow> f x = g x) \<Longrightarrow> map f xs = map g ys" |
1d8ad2ff3e01
dropped (almost) redundant distinct.induct rule; distinct_simps again named distinct.simps
haftmann
parents:
40077
diff
changeset
|
1046 |
by simp |
13114 | 1047 |
|
13142 | 1048 |
lemma map_is_Nil_conv [iff]: "(map f xs = []) = (xs = [])" |
13145 | 1049 |
by (cases xs) auto |
13114 | 1050 |
|
13142 | 1051 |
lemma Nil_is_map_conv [iff]: "([] = map f xs) = (xs = [])" |
13145 | 1052 |
by (cases xs) auto |
13114 | 1053 |
|
18447 | 1054 |
lemma map_eq_Cons_conv: |
14025 | 1055 |
"(map f xs = y#ys) = (\<exists>z zs. xs = z#zs \<and> f z = y \<and> map f zs = ys)" |
13145 | 1056 |
by (cases xs) auto |
13114 | 1057 |
|
18447 | 1058 |
lemma Cons_eq_map_conv: |
14025 | 1059 |
"(x#xs = map f ys) = (\<exists>z zs. ys = z#zs \<and> x = f z \<and> xs = map f zs)" |
1060 |
by (cases ys) auto |
|
1061 |
||
18447 | 1062 |
lemmas map_eq_Cons_D = map_eq_Cons_conv [THEN iffD1] |
1063 |
lemmas Cons_eq_map_D = Cons_eq_map_conv [THEN iffD1] |
|
1064 |
declare map_eq_Cons_D [dest!] Cons_eq_map_D [dest!] |
|
1065 |
||
14111 | 1066 |
lemma ex_map_conv: |
1067 |
"(EX xs. ys = map f xs) = (ALL y : set ys. EX x. y = f x)" |
|
18447 | 1068 |
by(induct ys, auto simp add: Cons_eq_map_conv) |
14111 | 1069 |
|
15110
78b5636eabc7
Added a number of new thms and the new function remove1
nipkow
parents:
15072
diff
changeset
|
1070 |
lemma map_eq_imp_length_eq: |
35510 | 1071 |
assumes "map f xs = map g ys" |
26734 | 1072 |
shows "length xs = length ys" |
1073 |
using assms proof (induct ys arbitrary: xs) |
|
1074 |
case Nil then show ?case by simp |
|
1075 |
next |
|
1076 |
case (Cons y ys) then obtain z zs where xs: "xs = z # zs" by auto |
|
35510 | 1077 |
from Cons xs have "map f zs = map g ys" by simp |
26734 | 1078 |
moreover with Cons have "length zs = length ys" by blast |
1079 |
with xs show ?case by simp |
|
1080 |
qed |
|
1081 |
||
15110
78b5636eabc7
Added a number of new thms and the new function remove1
nipkow
parents:
15072
diff
changeset
|
1082 |
lemma map_inj_on: |
78b5636eabc7
Added a number of new thms and the new function remove1
nipkow
parents:
15072
diff
changeset
|
1083 |
"[| 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
|
1084 |
==> xs = ys" |
78b5636eabc7
Added a number of new thms and the new function remove1
nipkow
parents:
15072
diff
changeset
|
1085 |
apply(frule map_eq_imp_length_eq) |
78b5636eabc7
Added a number of new thms and the new function remove1
nipkow
parents:
15072
diff
changeset
|
1086 |
apply(rotate_tac -1) |
78b5636eabc7
Added a number of new thms and the new function remove1
nipkow
parents:
15072
diff
changeset
|
1087 |
apply(induct rule:list_induct2) |
78b5636eabc7
Added a number of new thms and the new function remove1
nipkow
parents:
15072
diff
changeset
|
1088 |
apply simp |
78b5636eabc7
Added a number of new thms and the new function remove1
nipkow
parents:
15072
diff
changeset
|
1089 |
apply(simp) |
78b5636eabc7
Added a number of new thms and the new function remove1
nipkow
parents:
15072
diff
changeset
|
1090 |
apply (blast intro:sym) |
78b5636eabc7
Added a number of new thms and the new function remove1
nipkow
parents:
15072
diff
changeset
|
1091 |
done |
78b5636eabc7
Added a number of new thms and the new function remove1
nipkow
parents:
15072
diff
changeset
|
1092 |
|
78b5636eabc7
Added a number of new thms and the new function remove1
nipkow
parents:
15072
diff
changeset
|
1093 |
lemma inj_on_map_eq_map: |
78b5636eabc7
Added a number of new thms and the new function remove1
nipkow
parents:
15072
diff
changeset
|
1094 |
"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
|
1095 |
by(blast dest:map_inj_on) |
78b5636eabc7
Added a number of new thms and the new function remove1
nipkow
parents:
15072
diff
changeset
|
1096 |
|
13114 | 1097 |
lemma map_injective: |
24526 | 1098 |
"map f xs = map f ys ==> inj f ==> xs = ys" |
1099 |
by (induct ys arbitrary: xs) (auto dest!:injD) |
|
13114 | 1100 |
|
14339 | 1101 |
lemma inj_map_eq_map[simp]: "inj f \<Longrightarrow> (map f xs = map f ys) = (xs = ys)" |
1102 |
by(blast dest:map_injective) |
|
1103 |
||
13114 | 1104 |
lemma inj_mapI: "inj f ==> inj (map f)" |
17589 | 1105 |
by (iprover dest: map_injective injD intro: inj_onI) |
13114 | 1106 |
|
1107 |
lemma inj_mapD: "inj (map f) ==> inj f" |
|
14208 | 1108 |
apply (unfold inj_on_def, clarify) |
13145 | 1109 |
apply (erule_tac x = "[x]" in ballE) |
14208 | 1110 |
apply (erule_tac x = "[y]" in ballE, simp, blast) |
13145 | 1111 |
apply blast |
1112 |
done |
|
13114 | 1113 |
|
14339 | 1114 |
lemma inj_map[iff]: "inj (map f) = inj f" |
13145 | 1115 |
by (blast dest: inj_mapD intro: inj_mapI) |
13114 | 1116 |
|
15303 | 1117 |
lemma inj_on_mapI: "inj_on f (\<Union>(set ` A)) \<Longrightarrow> inj_on (map f) A" |
1118 |
apply(rule inj_onI) |
|
1119 |
apply(erule map_inj_on) |
|
1120 |
apply(blast intro:inj_onI dest:inj_onD) |
|
1121 |
done |
|
1122 |
||
14343 | 1123 |
lemma map_idI: "(\<And>x. x \<in> set xs \<Longrightarrow> f x = x) \<Longrightarrow> map f xs = xs" |
1124 |
by (induct xs, auto) |
|
13114 | 1125 |
|
14402
4201e1916482
moved lemmas from MicroJava/Comp/AuxLemmas.thy to List.thy
nipkow
parents:
14395
diff
changeset
|
1126 |
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
|
1127 |
by (induct xs) auto |
4201e1916482
moved lemmas from MicroJava/Comp/AuxLemmas.thy to List.thy
nipkow
parents:
14395
diff
changeset
|
1128 |
|
15110
78b5636eabc7
Added a number of new thms and the new function remove1
nipkow
parents:
15072
diff
changeset
|
1129 |
lemma map_fst_zip[simp]: |
78b5636eabc7
Added a number of new thms and the new function remove1
nipkow
parents:
15072
diff
changeset
|
1130 |
"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
|
1131 |
by (induct rule:list_induct2, simp_all) |
78b5636eabc7
Added a number of new thms and the new function remove1
nipkow
parents:
15072
diff
changeset
|
1132 |
|
78b5636eabc7
Added a number of new thms and the new function remove1
nipkow
parents:
15072
diff
changeset
|
1133 |
lemma map_snd_zip[simp]: |
78b5636eabc7
Added a number of new thms and the new function remove1
nipkow
parents:
15072
diff
changeset
|
1134 |
"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
|
1135 |
by (induct rule:list_induct2, simp_all) |
78b5636eabc7
Added a number of new thms and the new function remove1
nipkow
parents:
15072
diff
changeset
|
1136 |
|
41505
6d19301074cf
"enriched_type" replaces less specific "type_lifting"
haftmann
parents:
41463
diff
changeset
|
1137 |
enriched_type map: map |
47122 | 1138 |
by (simp_all add: id_def) |
1139 |
||
49948
744934b818c7
moved quite generic material from theory Enum to more appropriate places
haftmann
parents:
49808
diff
changeset
|
1140 |
declare map.id [simp] |
744934b818c7
moved quite generic material from theory Enum to more appropriate places
haftmann
parents:
49808
diff
changeset
|
1141 |
|
744934b818c7
moved quite generic material from theory Enum to more appropriate places
haftmann
parents:
49808
diff
changeset
|
1142 |
|
744934b818c7
moved quite generic material from theory Enum to more appropriate places
haftmann
parents:
49808
diff
changeset
|
1143 |
subsubsection {* @{const rev} *} |
13114 | 1144 |
|
13142 | 1145 |
lemma rev_append [simp]: "rev (xs @ ys) = rev ys @ rev xs" |
13145 | 1146 |
by (induct xs) auto |
13114 | 1147 |
|
13142 | 1148 |
lemma rev_rev_ident [simp]: "rev (rev xs) = xs" |
13145 | 1149 |
by (induct xs) auto |
13114 | 1150 |
|
15870 | 1151 |
lemma rev_swap: "(rev xs = ys) = (xs = rev ys)" |
1152 |
by auto |
|
1153 |
||
13142 | 1154 |
lemma rev_is_Nil_conv [iff]: "(rev xs = []) = (xs = [])" |
13145 | 1155 |
by (induct xs) auto |
13114 | 1156 |
|
13142 | 1157 |
lemma Nil_is_rev_conv [iff]: "([] = rev xs) = (xs = [])" |
13145 | 1158 |
by (induct xs) auto |
13114 | 1159 |
|
15870 | 1160 |
lemma rev_singleton_conv [simp]: "(rev xs = [x]) = (xs = [x])" |
1161 |
by (cases xs) auto |
|
1162 |
||
1163 |
lemma singleton_rev_conv [simp]: "([x] = rev xs) = (xs = [x])" |
|
1164 |
by (cases xs) auto |
|
1165 |
||
46439
2388be11cb50
removed fact that confuses SPASS -- better rely on "rev_rev_ident", which is stronger and more ATP friendly
blanchet
parents:
46424
diff
changeset
|
1166 |
lemma rev_is_rev_conv [iff, no_atp]: "(rev xs = rev ys) = (xs = ys)" |
21061
580dfc999ef6
added normal post setup; cleaned up "execution" constants
haftmann
parents:
21046
diff
changeset
|
1167 |
apply (induct xs arbitrary: ys, force) |
14208 | 1168 |
apply (case_tac ys, simp, force) |
13145 | 1169 |
done |
13114 | 1170 |
|
15439 | 1171 |
lemma inj_on_rev[iff]: "inj_on rev A" |
1172 |
by(simp add:inj_on_def) |
|
1173 |
||
13366 | 1174 |
lemma rev_induct [case_names Nil snoc]: |
1175 |
"[| 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
|
1176 |
apply(simplesubst rev_rev_ident[symmetric]) |
13145 | 1177 |
apply(rule_tac list = "rev xs" in list.induct, simp_all) |
1178 |
done |
|
13114 | 1179 |
|
13366 | 1180 |
lemma rev_exhaust [case_names Nil snoc]: |
1181 |
"(xs = [] ==> P) ==>(!!ys y. xs = ys @ [y] ==> P) ==> P" |
|
13145 | 1182 |
by (induct xs rule: rev_induct) auto |
13114 | 1183 |
|
13366 | 1184 |
lemmas rev_cases = rev_exhaust |
1185 |
||
18423 | 1186 |
lemma rev_eq_Cons_iff[iff]: "(rev xs = y#ys) = (xs = rev ys @ [y])" |
1187 |
by(rule rev_cases[of xs]) auto |
|
1188 |
||
13114 | 1189 |
|
49948
744934b818c7
moved quite generic material from theory Enum to more appropriate places
haftmann
parents:
49808
diff
changeset
|
1190 |
subsubsection {* @{const set} *} |
13114 | 1191 |
|
46698
f1dfcf8be88d
converting "set [...]" to "{...}" in evaluation results
nipkow
parents:
46669
diff
changeset
|
1192 |
declare set.simps [code_post] --"pretty output" |
f1dfcf8be88d
converting "set [...]" to "{...}" in evaluation results
nipkow
parents:
46669
diff
changeset
|
1193 |
|
13142 | 1194 |
lemma finite_set [iff]: "finite (set xs)" |
13145 | 1195 |
by (induct xs) auto |
13114 | 1196 |
|
13142 | 1197 |
lemma set_append [simp]: "set (xs @ ys) = (set xs \<union> set ys)" |
13145 | 1198 |
by (induct xs) auto |
13114 | 1199 |
|
17830 | 1200 |
lemma hd_in_set[simp]: "xs \<noteq> [] \<Longrightarrow> hd xs : set xs" |
1201 |
by(cases xs) auto |
|
14099 | 1202 |
|
13142 | 1203 |
lemma set_subset_Cons: "set xs \<subseteq> set (x # xs)" |
13145 | 1204 |
by auto |
13114 | 1205 |
|
14099 | 1206 |
lemma set_ConsD: "y \<in> set (x # xs) \<Longrightarrow> y=x \<or> y \<in> set xs" |
1207 |
by auto |
|
1208 |
||
13142 | 1209 |
lemma set_empty [iff]: "(set xs = {}) = (xs = [])" |
13145 | 1210 |
by (induct xs) auto |
13114 | 1211 |
|
15245 | 1212 |
lemma set_empty2[iff]: "({} = set xs) = (xs = [])" |
1213 |
by(induct xs) auto |
|
1214 |
||
13142 | 1215 |
lemma set_rev [simp]: "set (rev xs) = set xs" |
13145 | 1216 |
by (induct xs) auto |
13114 | 1217 |
|
13142 | 1218 |
lemma set_map [simp]: "set (map f xs) = f`(set xs)" |
13145 | 1219 |
by (induct xs) auto |
13114 | 1220 |
|
13142 | 1221 |
lemma set_filter [simp]: "set (filter P xs) = {x. x : set xs \<and> P x}" |
13145 | 1222 |
by (induct xs) auto |
13114 | 1223 |
|
32417 | 1224 |
lemma set_upt [simp]: "set[i..<j] = {i..<j}" |
41463
edbf0a86fb1c
adding simproc to rewrite list comprehensions to set comprehensions; adopting proofs
bulwahn
parents:
41372
diff
changeset
|
1225 |
by (induct j) auto |
13114 | 1226 |
|
13142 | 1227 |
|
25221
5ded95dda5df
append/member: more light-weight way to declare authentic syntax;
wenzelm
parents:
25215
diff
changeset
|
1228 |
lemma split_list: "x : set xs \<Longrightarrow> \<exists>ys zs. xs = ys @ x # zs" |
18049 | 1229 |
proof (induct xs) |
26073 | 1230 |
case Nil thus ?case by simp |
1231 |
next |
|
1232 |
case Cons thus ?case by (auto intro: Cons_eq_appendI) |
|
1233 |
qed |
|
1234 |
||
26734 | 1235 |
lemma in_set_conv_decomp: "x \<in> set xs \<longleftrightarrow> (\<exists>ys zs. xs = ys @ x # zs)" |
1236 |
by (auto elim: split_list) |
|
26073 | 1237 |
|
1238 |
lemma split_list_first: "x : set xs \<Longrightarrow> \<exists>ys zs. xs = ys @ x # zs \<and> x \<notin> set ys" |
|
1239 |
proof (induct xs) |
|
1240 |
case Nil thus ?case by simp |
|
18049 | 1241 |
next |
1242 |
case (Cons a xs) |
|
1243 |
show ?case |
|
1244 |
proof cases |
|
44890
22f665a2e91c
new fastforce replacing fastsimp - less confusing name
nipkow
parents:
44635
diff
changeset
|
1245 |
assume "x = a" thus ?case using Cons by fastforce |
18049 | 1246 |
next |
44890
22f665a2e91c
new fastforce replacing fastsimp - less confusing name
nipkow
parents:
44635
diff
changeset
|
1247 |
assume "x \<noteq> a" thus ?case using Cons by(fastforce intro!: Cons_eq_appendI) |
26073 | 1248 |
qed |
1249 |
qed |
|
1250 |
||
1251 |
lemma in_set_conv_decomp_first: |
|
1252 |
"(x : set xs) = (\<exists>ys zs. xs = ys @ x # zs \<and> x \<notin> set ys)" |
|
26734 | 1253 |
by (auto dest!: split_list_first) |
26073 | 1254 |
|
40122
1d8ad2ff3e01
dropped (almost) redundant distinct.induct rule; distinct_simps again named distinct.simps
haftmann
parents:
40077
diff
changeset
|
1255 |
lemma split_list_last: "x \<in> set xs \<Longrightarrow> \<exists>ys zs. xs = ys @ x # zs \<and> x \<notin> set zs" |
1d8ad2ff3e01
dropped (almost) redundant distinct.induct rule; distinct_simps again named distinct.simps
haftmann
parents:
40077
diff
changeset
|
1256 |
proof (induct xs rule: rev_induct) |
26073 | 1257 |
case Nil thus ?case by simp |
1258 |
next |
|
1259 |
case (snoc a xs) |
|
1260 |
show ?case |
|
1261 |
proof cases |
|
40122
1d8ad2ff3e01
dropped (almost) redundant distinct.induct rule; distinct_simps again named distinct.simps
haftmann
parents:
40077
diff
changeset
|
1262 |
assume "x = a" thus ?case using snoc by (metis List.set.simps(1) emptyE) |
26073 | 1263 |
next |
44890
22f665a2e91c
new fastforce replacing fastsimp - less confusing name
nipkow
parents:
44635
diff
changeset
|
1264 |
assume "x \<noteq> a" thus ?case using snoc by fastforce |
18049 | 1265 |
qed |
1266 |
qed |
|
1267 |
||
26073 | 1268 |
lemma in_set_conv_decomp_last: |
1269 |
"(x : set xs) = (\<exists>ys zs. xs = ys @ x # zs \<and> x \<notin> set zs)" |
|
26734 | 1270 |
by (auto dest!: split_list_last) |
26073 | 1271 |
|
1272 |
lemma split_list_prop: "\<exists>x \<in> set xs. P x \<Longrightarrow> \<exists>ys x zs. xs = ys @ x # zs & P x" |
|
1273 |
proof (induct xs) |
|
1274 |
case Nil thus ?case by simp |
|
1275 |
next |
|
1276 |
case Cons thus ?case |
|
1277 |
by(simp add:Bex_def)(metis append_Cons append.simps(1)) |
|
1278 |
qed |
|
1279 |
||
1280 |
lemma split_list_propE: |
|
26734 | 1281 |
assumes "\<exists>x \<in> set xs. P x" |
1282 |
obtains ys x zs where "xs = ys @ x # zs" and "P x" |
|
1283 |
using split_list_prop [OF assms] by blast |
|
26073 | 1284 |
|
1285 |
lemma split_list_first_prop: |
|
1286 |
"\<exists>x \<in> set xs. P x \<Longrightarrow> |
|
1287 |
\<exists>ys x zs. xs = ys@x#zs \<and> P x \<and> (\<forall>y \<in> set ys. \<not> P y)" |
|
26734 | 1288 |
proof (induct xs) |
26073 | 1289 |
case Nil thus ?case by simp |
1290 |
next |
|
1291 |
case (Cons x xs) |
|
1292 |
show ?case |
|
1293 |
proof cases |
|
1294 |
assume "P x" |
|
40122
1d8ad2ff3e01
dropped (almost) redundant distinct.induct rule; distinct_simps again named distinct.simps
haftmann
parents:
40077
diff
changeset
|
1295 |
thus ?thesis by simp (metis Un_upper1 contra_subsetD in_set_conv_decomp_first self_append_conv2 set_append) |
26073 | 1296 |
next |
1297 |
assume "\<not> P x" |
|
1298 |
hence "\<exists>x\<in>set xs. P x" using Cons(2) by simp |
|
1299 |
thus ?thesis using `\<not> P x` Cons(1) by (metis append_Cons set_ConsD) |
|
1300 |
qed |
|
1301 |
qed |
|
1302 |
||
1303 |
lemma split_list_first_propE: |
|
26734 | 1304 |
assumes "\<exists>x \<in> set xs. P x" |
1305 |
obtains ys x zs where "xs = ys @ x # zs" and "P x" and "\<forall>y \<in> set ys. \<not> P y" |
|
1306 |
using split_list_first_prop [OF assms] by blast |
|
26073 | 1307 |
|
1308 |
lemma split_list_first_prop_iff: |
|
1309 |
"(\<exists>x \<in> set xs. P x) \<longleftrightarrow> |
|
1310 |
(\<exists>ys x zs. xs = ys@x#zs \<and> P x \<and> (\<forall>y \<in> set ys. \<not> P y))" |
|
26734 | 1311 |
by (rule, erule split_list_first_prop) auto |
26073 | 1312 |
|
1313 |
lemma split_list_last_prop: |
|
1314 |
"\<exists>x \<in> set xs. P x \<Longrightarrow> |
|
1315 |
\<exists>ys x zs. xs = ys@x#zs \<and> P x \<and> (\<forall>z \<in> set zs. \<not> P z)" |
|
1316 |
proof(induct xs rule:rev_induct) |
|
1317 |
case Nil thus ?case by simp |
|
1318 |
next |
|
1319 |
case (snoc x xs) |
|
1320 |
show ?case |
|
1321 |
proof cases |
|
1322 |
assume "P x" thus ?thesis by (metis emptyE set_empty) |
|
1323 |
next |
|
1324 |
assume "\<not> P x" |
|
1325 |
hence "\<exists>x\<in>set xs. P x" using snoc(2) by simp |
|
44890
22f665a2e91c
new fastforce replacing fastsimp - less confusing name
nipkow
parents:
44635
diff
changeset
|
1326 |
thus ?thesis using `\<not> P x` snoc(1) by fastforce |
26073 | 1327 |
qed |
1328 |
qed |
|
1329 |
||
1330 |
lemma split_list_last_propE: |
|
26734 | 1331 |
assumes "\<exists>x \<in> set xs. P x" |
1332 |
obtains ys x zs where "xs = ys @ x # zs" and "P x" and "\<forall>z \<in> set zs. \<not> P z" |
|
1333 |
using split_list_last_prop [OF assms] by blast |
|
26073 | 1334 |
|
1335 |
lemma split_list_last_prop_iff: |
|
1336 |
"(\<exists>x \<in> set xs. P x) \<longleftrightarrow> |
|
1337 |
(\<exists>ys x zs. xs = ys@x#zs \<and> P x \<and> (\<forall>z \<in> set zs. \<not> P z))" |
|
26734 | 1338 |
by (metis split_list_last_prop [where P=P] in_set_conv_decomp) |
26073 | 1339 |
|
1340 |
lemma finite_list: "finite A ==> EX xs. set xs = A" |
|
26734 | 1341 |
by (erule finite_induct) |
1342 |
(auto simp add: set.simps(2) [symmetric] simp del: set.simps(2)) |
|
13508 | 1343 |
|
14388 | 1344 |
lemma card_length: "card (set xs) \<le> length xs" |
1345 |
by (induct xs) (auto simp add: card_insert_if) |
|
13114 | 1346 |
|
26442
57fb6a8b099e
restructuring; explicit case names for rule list_induct2
haftmann
parents:
26300
diff
changeset
|
1347 |
lemma set_minus_filter_out: |
57fb6a8b099e
restructuring; explicit case names for rule list_induct2
haftmann
parents:
26300
diff
changeset
|
1348 |
"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
|
1349 |
by (induct xs) auto |
15168 | 1350 |
|
35115 | 1351 |
|
49948
744934b818c7
moved quite generic material from theory Enum to more appropriate places
haftmann
parents:
49808
diff
changeset
|
1352 |
subsubsection {* @{const filter} *} |
13114 | 1353 |
|
13142 | 1354 |
lemma filter_append [simp]: "filter P (xs @ ys) = filter P xs @ filter P ys" |
13145 | 1355 |
by (induct xs) auto |
13114 | 1356 |
|
15305 | 1357 |
lemma rev_filter: "rev (filter P xs) = filter P (rev xs)" |
1358 |
by (induct xs) simp_all |
|
1359 |
||
13142 | 1360 |
lemma filter_filter [simp]: "filter P (filter Q xs) = filter (\<lambda>x. Q x \<and> P x) xs" |
13145 | 1361 |
by (induct xs) auto |
13114 | 1362 |
|
16998 | 1363 |
lemma length_filter_le [simp]: "length (filter P xs) \<le> length xs" |
1364 |
by (induct xs) (auto simp add: le_SucI) |
|
1365 |
||
18423 | 1366 |
lemma sum_length_filter_compl: |
1367 |
"length(filter P xs) + length(filter (%x. ~P x) xs) = length xs" |
|
1368 |
by(induct xs) simp_all |
|
1369 |
||
13142 | 1370 |
lemma filter_True [simp]: "\<forall>x \<in> set xs. P x ==> filter P xs = xs" |
13145 | 1371 |
by (induct xs) auto |
13114 | 1372 |
|
13142 | 1373 |
lemma filter_False [simp]: "\<forall>x \<in> set xs. \<not> P x ==> filter P xs = []" |
13145 | 1374 |
by (induct xs) auto |
13114 | 1375 |
|
16998 | 1376 |
lemma filter_empty_conv: "(filter P xs = []) = (\<forall>x\<in>set xs. \<not> P x)" |
24349 | 1377 |
by (induct xs) simp_all |
16998 | 1378 |
|
1379 |
lemma filter_id_conv: "(filter P xs = xs) = (\<forall>x\<in>set xs. P x)" |
|
1380 |
apply (induct xs) |
|
1381 |
apply auto |
|
1382 |
apply(cut_tac P=P and xs=xs in length_filter_le) |
|
1383 |
apply simp |
|
1384 |
done |
|
13114 | 1385 |
|
16965 | 1386 |
lemma filter_map: |
1387 |
"filter P (map f xs) = map f (filter (P o f) xs)" |
|
1388 |
by (induct xs) simp_all |
|
1389 |
||
1390 |
lemma length_filter_map[simp]: |
|
1391 |
"length (filter P (map f xs)) = length(filter (P o f) xs)" |
|
1392 |
by (simp add:filter_map) |
|
1393 |
||
13142 | 1394 |
lemma filter_is_subset [simp]: "set (filter P xs) \<le> set xs" |
13145 | 1395 |
by auto |
13114 | 1396 |
|
15246 | 1397 |
lemma length_filter_less: |
1398 |
"\<lbrakk> x : set xs; ~ P x \<rbrakk> \<Longrightarrow> length(filter P xs) < length xs" |
|
1399 |
proof (induct xs) |
|
1400 |
case Nil thus ?case by simp |
|
1401 |
next |
|
1402 |
case (Cons x xs) thus ?case |
|
1403 |
apply (auto split:split_if_asm) |
|
1404 |
using length_filter_le[of P xs] apply arith |
|
1405 |
done |
|
1406 |
qed |
|
13114 | 1407 |
|
15281 | 1408 |
lemma length_filter_conv_card: |
1409 |
"length(filter p xs) = card{i. i < length xs & p(xs!i)}" |
|
1410 |
proof (induct xs) |
|
1411 |
case Nil thus ?case by simp |
|
1412 |
next |
|
1413 |
case (Cons x xs) |
|
1414 |
let ?S = "{i. i < length xs & p(xs!i)}" |
|
1415 |
have fin: "finite ?S" by(fast intro: bounded_nat_set_is_finite) |
|
1416 |
show ?case (is "?l = card ?S'") |
|
1417 |
proof (cases) |
|
1418 |
assume "p x" |
|
1419 |
hence eq: "?S' = insert 0 (Suc ` ?S)" |
|
25162 | 1420 |
by(auto simp: image_def split:nat.split dest:gr0_implies_Suc) |
15281 | 1421 |
have "length (filter p (x # xs)) = Suc(card ?S)" |
23388 | 1422 |
using Cons `p x` by simp |
15281 | 1423 |
also have "\<dots> = Suc(card(Suc ` ?S))" using fin |
44921 | 1424 |
by (simp add: card_image) |
15281 | 1425 |
also have "\<dots> = card ?S'" using eq fin |
1426 |
by (simp add:card_insert_if) (simp add:image_def) |
|
1427 |
finally show ?thesis . |
|
1428 |
next |
|
1429 |
assume "\<not> p x" |
|
1430 |
hence eq: "?S' = Suc ` ?S" |
|
25162 | 1431 |
by(auto simp add: image_def split:nat.split elim:lessE) |
15281 | 1432 |
have "length (filter p (x # xs)) = card ?S" |
23388 | 1433 |
using Cons `\<not> p x` by simp |
15281 | 1434 |
also have "\<dots> = card(Suc ` ?S)" using fin |
44921 | 1435 |
by (simp add: card_image) |
15281 | 1436 |
also have "\<dots> = card ?S'" using eq fin |
1437 |
by (simp add:card_insert_if) |
|
1438 |
finally show ?thesis . |
|
1439 |
qed |
|
1440 |
qed |
|
1441 |
||
17629 | 1442 |
lemma Cons_eq_filterD: |
1443 |
"x#xs = filter P ys \<Longrightarrow> |
|
1444 |
\<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 | 1445 |
(is "_ \<Longrightarrow> \<exists>us vs. ?P ys us vs") |
17629 | 1446 |
proof(induct ys) |
1447 |
case Nil thus ?case by simp |
|
1448 |
next |
|
1449 |
case (Cons y ys) |
|
1450 |
show ?case (is "\<exists>x. ?Q x") |
|
1451 |
proof cases |
|
1452 |
assume Py: "P y" |
|
1453 |
show ?thesis |
|
1454 |
proof cases |
|
25221
5ded95dda5df
append/member: more light-weight way to declare authentic syntax;
wenzelm
parents:
25215
diff
changeset
|
1455 |
assume "x = y" |
5ded95dda5df
append/member: more light-weight way to declare authentic syntax;
wenzelm
parents:
25215
diff
changeset
|
1456 |
with Py Cons.prems have "?Q []" by simp |
5ded95dda5df
append/member: more light-weight way to declare authentic syntax;
wenzelm
parents:
25215
diff
changeset
|
1457 |
then show ?thesis .. |
17629 | 1458 |
next |
25221
5ded95dda5df
append/member: more light-weight way to declare authentic syntax;
wenzelm
parents:
25215
diff
changeset
|
1459 |
assume "x \<noteq> y" |
5ded95dda5df
append/member: more light-weight way to declare authentic syntax;
wenzelm
parents:
25215
diff
changeset
|
1460 |
with Py Cons.prems show ?thesis by simp |
17629 | 1461 |
qed |
1462 |
next |
|
25221
5ded95dda5df
append/member: more light-weight way to declare authentic syntax;
wenzelm
parents:
25215
diff
changeset
|
1463 |
assume "\<not> P y" |
44890
22f665a2e91c
new fastforce replacing fastsimp - less confusing name
nipkow
parents:
44635
diff
changeset
|
1464 |
with Cons obtain us vs where "?P (y#ys) (y#us) vs" by fastforce |
25221
5ded95dda5df
append/member: more light-weight way to declare authentic syntax;
wenzelm
parents:
25215
diff
changeset
|
1465 |
then have "?Q (y#us)" by simp |
5ded95dda5df
append/member: more light-weight way to declare authentic syntax;
wenzelm
parents:
25215
diff
changeset
|
1466 |
then show ?thesis .. |
17629 | 1467 |
qed |
1468 |
qed |
|
1469 |
||
1470 |
lemma filter_eq_ConsD: |
|
1471 |
"filter P ys = x#xs \<Longrightarrow> |
|
1472 |
\<exists>us vs. ys = us @ x # vs \<and> (\<forall>u\<in>set us. \<not> P u) \<and> P x \<and> xs = filter P vs" |
|
1473 |
by(rule Cons_eq_filterD) simp |
|
1474 |
||
1475 |
lemma filter_eq_Cons_iff: |
|
1476 |
"(filter P ys = x#xs) = |
|
1477 |
(\<exists>us vs. ys = us @ x # vs \<and> (\<forall>u\<in>set us. \<not> P u) \<and> P x \<and> xs = filter P vs)" |
|
1478 |
by(auto dest:filter_eq_ConsD) |
|
1479 |
||
1480 |
lemma Cons_eq_filter_iff: |
|
1481 |
"(x#xs = filter P ys) = |
|
1482 |
(\<exists>us vs. ys = us @ x # vs \<and> (\<forall>u\<in>set us. \<not> P u) \<and> P x \<and> xs = filter P vs)" |
|
1483 |
by(auto dest:Cons_eq_filterD) |
|
1484 |
||
44013
5cfc1c36ae97
moved recdef package to HOL/Library/Old_Recdef.thy
krauss
parents:
43594
diff
changeset
|
1485 |
lemma filter_cong[fundef_cong]: |
17501 | 1486 |
"xs = ys \<Longrightarrow> (\<And>x. x \<in> set ys \<Longrightarrow> P x = Q x) \<Longrightarrow> filter P xs = filter Q ys" |
1487 |
apply simp |
|
1488 |
apply(erule thin_rl) |
|
1489 |
by (induct ys) simp_all |
|
1490 |
||
15281 | 1491 |
|
26442
57fb6a8b099e
restructuring; explicit case names for rule list_induct2
haftmann
parents:
26300
diff
changeset
|
1492 |
subsubsection {* List partitioning *} |
57fb6a8b099e
restructuring; explicit case names for rule list_induct2
haftmann
parents:
26300
diff
changeset
|
1493 |
|
57fb6a8b099e
restructuring; explicit case names for rule list_induct2
haftmann
parents:
26300
diff
changeset
|
1494 |
primrec partition :: "('a \<Rightarrow> bool) \<Rightarrow>'a list \<Rightarrow> 'a list \<times> 'a list" where |
50548 | 1495 |
"partition P [] = ([], [])" | |
1496 |
"partition P (x # xs) = |
|
1497 |
(let (yes, no) = partition P xs |
|
1498 |
in if P x then (x # yes, no) else (yes, x # no))" |
|
26442
57fb6a8b099e
restructuring; explicit case names for rule list_induct2
haftmann
parents:
26300
diff
changeset
|
1499 |
|
57fb6a8b099e
restructuring; explicit case names for rule list_induct2
haftmann
parents:
26300
diff
changeset
|
1500 |
lemma partition_filter1: |
57fb6a8b099e
restructuring; explicit case names for rule list_induct2
haftmann
parents:
26300
diff
changeset
|
1501 |
"fst (partition P xs) = filter P xs" |
57fb6a8b099e
restructuring; explicit case names for rule list_induct2
haftmann
parents:
26300
diff
changeset
|
1502 |
by (induct xs) (auto simp add: Let_def split_def) |
57fb6a8b099e
restructuring; explicit case names for rule list_induct2
haftmann
parents:
26300
diff
changeset
|
1503 |
|
57fb6a8b099e
restructuring; explicit case names for rule list_induct2
haftmann
parents:
26300
diff
changeset
|
1504 |
lemma partition_filter2: |
57fb6a8b099e
restructuring; explicit case names for rule list_induct2
haftmann
parents:
26300
diff
changeset
|
1505 |
"snd (partition P xs) = filter (Not o P) xs" |
57fb6a8b099e
restructuring; explicit case names for rule list_induct2
haftmann
parents:
26300
diff
changeset
|
1506 |
by (induct xs) (auto simp add: Let_def split_def) |
57fb6a8b099e
restructuring; explicit case names for rule list_induct2
haftmann
parents:
26300
diff
changeset
|
1507 |
|
57fb6a8b099e
restructuring; explicit case names for rule list_induct2
haftmann
parents:
26300
diff
changeset
|
1508 |
lemma partition_P: |
57fb6a8b099e
restructuring; explicit case names for rule list_induct2
haftmann
parents:
26300
diff
changeset
|
1509 |
assumes "partition P xs = (yes, no)" |
57fb6a8b099e
restructuring; explicit case names for rule list_induct2
haftmann
parents:
26300
diff
changeset
|
1510 |
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
|
1511 |
proof - |
57fb6a8b099e
restructuring; explicit case names for rule list_induct2
haftmann
parents:
26300
diff
changeset
|
1512 |
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
|
1513 |
by simp_all |
57fb6a8b099e
restructuring; explicit case names for rule list_induct2
haftmann
parents:
26300
diff
changeset
|
1514 |
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
|
1515 |
qed |
57fb6a8b099e
restructuring; explicit case names for rule list_induct2
haftmann
parents:
26300
diff
changeset
|
1516 |
|
57fb6a8b099e
restructuring; explicit case names for rule list_induct2
haftmann
parents:
26300
diff
changeset
|
1517 |
lemma partition_set: |
57fb6a8b099e
restructuring; explicit case names for rule list_induct2
haftmann
parents:
26300
diff
changeset
|
1518 |
assumes "partition P xs = (yes, no)" |
57fb6a8b099e
restructuring; explicit case names for rule list_induct2
haftmann
parents:
26300
diff
changeset
|
1519 |
shows "set yes \<union> set no = set xs" |
57fb6a8b099e
restructuring; explicit case names for rule list_induct2
haftmann
parents:
26300
diff
changeset
|
1520 |
proof - |
57fb6a8b099e
restructuring; explicit case names for rule list_induct2
haftmann
parents:
26300
diff
changeset
|
1521 |
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
|
1522 |
by simp_all |
57fb6a8b099e
restructuring; explicit case names for rule list_induct2
haftmann
parents:
26300
diff
changeset
|
1523 |
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
|
1524 |
qed |
57fb6a8b099e
restructuring; explicit case names for rule list_induct2
haftmann
parents:
26300
diff
changeset
|
1525 |
|
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
|
1526 |
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
|
1527 |
"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
|
1528 |
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
|
1529 |
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
|
1530 |
|
603320b93668
New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents:
33593
diff
changeset
|
1531 |
declare partition.simps[simp del] |
26442
57fb6a8b099e
restructuring; explicit case names for rule list_induct2
haftmann
parents:
26300
diff
changeset
|
1532 |
|
35115 | 1533 |
|
49948
744934b818c7
moved quite generic material from theory Enum to more appropriate places
haftmann
parents:
49808
diff
changeset
|
1534 |
subsubsection {* @{const concat} *} |
13114 | 1535 |
|
13142 | 1536 |
lemma concat_append [simp]: "concat (xs @ ys) = concat xs @ concat ys" |
13145 | 1537 |
by (induct xs) auto |
13114 | 1538 |
|
18447 | 1539 |
lemma concat_eq_Nil_conv [simp]: "(concat xss = []) = (\<forall>xs \<in> set xss. xs = [])" |
13145 | 1540 |
by (induct xss) auto |
13114 | 1541 |
|
18447 | 1542 |
lemma Nil_eq_concat_conv [simp]: "([] = concat xss) = (\<forall>xs \<in> set xss. xs = [])" |
13145 | 1543 |
by (induct xss) auto |
13114 | 1544 |
|
24308 | 1545 |
lemma set_concat [simp]: "set (concat xs) = (UN x:set xs. set x)" |
13145 | 1546 |
by (induct xs) auto |
13114 | 1547 |
|
24476
f7ad9fbbeeaa
turned list comprehension translations into ML to optimize base case
nipkow
parents:
24471
diff
changeset
|
1548 |
lemma concat_map_singleton[simp]: "concat(map (%x. [f x]) xs) = map f xs" |
24349 | 1549 |
by (induct xs) auto |
1550 |
||
13142 | 1551 |
lemma map_concat: "map f (concat xs) = concat (map (map f) xs)" |
13145 | 1552 |
by (induct xs) auto |
13114 | 1553 |
|
13142 | 1554 |
lemma filter_concat: "filter p (concat xs) = concat (map (filter p) xs)" |
13145 | 1555 |
by (induct xs) auto |
13114 | 1556 |
|
13142 | 1557 |
lemma rev_concat: "rev (concat xs) = concat (map rev (rev xs))" |
13145 | 1558 |
by (induct xs) auto |
13114 | 1559 |
|
40365
a1456f2e1c9d
added two lemmas about injectivity of concat to the list theory
bulwahn
parents:
40304
diff
changeset
|
1560 |
lemma concat_eq_concat_iff: "\<forall>(x, y) \<in> set (zip xs ys). length x = length y ==> length xs = length ys ==> (concat xs = concat ys) = (xs = ys)" |
a1456f2e1c9d
added two lemmas about injectivity of concat to the list theory
bulwahn
parents:
40304
diff
changeset
|
1561 |
proof (induct xs arbitrary: ys) |
a1456f2e1c9d
added two lemmas about injectivity of concat to the list theory
bulwahn
parents:
40304
diff
changeset
|
1562 |
case (Cons x xs ys) |
a1456f2e1c9d
added two lemmas about injectivity of concat to the list theory
bulwahn
parents:
40304
diff
changeset
|
1563 |
thus ?case by (cases ys) auto |
a1456f2e1c9d
added two lemmas about injectivity of concat to the list theory
bulwahn
parents:
40304
diff
changeset
|
1564 |
qed (auto) |
a1456f2e1c9d
added two lemmas about injectivity of concat to the list theory
bulwahn
parents:
40304
diff
changeset
|
1565 |
|
a1456f2e1c9d
added two lemmas about injectivity of concat to the list theory
bulwahn
parents:
40304
diff
changeset
|
1566 |
lemma concat_injective: "concat xs = concat ys ==> length xs = length ys ==> \<forall>(x, y) \<in> set (zip xs ys). length x = length y ==> xs = ys" |
a1456f2e1c9d
added two lemmas about injectivity of concat to the list theory
bulwahn
parents:
40304
diff
changeset
|
1567 |
by (simp add: concat_eq_concat_iff) |
a1456f2e1c9d
added two lemmas about injectivity of concat to the list theory
bulwahn
parents:
40304
diff
changeset
|
1568 |
|
13114 | 1569 |
|
49948
744934b818c7
moved quite generic material from theory Enum to more appropriate places
haftmann
parents:
49808
diff
changeset
|
1570 |
subsubsection {* @{const nth} *} |
13114 | 1571 |
|
29827 | 1572 |
lemma nth_Cons_0 [simp, code]: "(x # xs)!0 = x" |
13145 | 1573 |
by auto |
13114 | 1574 |
|
29827 | 1575 |
lemma nth_Cons_Suc [simp, code]: "(x # xs)!(Suc n) = xs!n" |
13145 | 1576 |
by auto |
13114 | 1577 |
|
13142 | 1578 |
declare nth.simps [simp del] |
13114 | 1579 |
|
41842 | 1580 |
lemma nth_Cons_pos[simp]: "0 < n \<Longrightarrow> (x#xs) ! n = xs ! (n - 1)" |
1581 |
by(auto simp: Nat.gr0_conv_Suc) |
|
1582 |
||
13114 | 1583 |
lemma nth_append: |
24526 | 1584 |
"(xs @ ys)!n = (if n < length xs then xs!n else ys!(n - length xs))" |
1585 |
apply (induct xs arbitrary: n, simp) |
|
14208 | 1586 |
apply (case_tac n, auto) |
13145 | 1587 |
done |
13114 | 1588 |
|
14402
4201e1916482
moved lemmas from MicroJava/Comp/AuxLemmas.thy to List.thy
nipkow
parents:
14395
diff
changeset
|
1589 |
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
|
1590 |
by (induct xs) auto |
14402
4201e1916482
moved lemmas from MicroJava/Comp/AuxLemmas.thy to List.thy
nipkow
parents:
14395
diff
changeset
|
1591 |
|
4201e1916482
moved lemmas from MicroJava/Comp/AuxLemmas.thy to List.thy
nipkow
parents:
14395
diff
changeset
|
1592 |
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
|
1593 |
by (induct xs) auto |
14402
4201e1916482
moved lemmas from MicroJava/Comp/AuxLemmas.thy to List.thy
nipkow
parents:
14395
diff
changeset
|
1594 |
|
24526 | 1595 |
lemma nth_map [simp]: "n < length xs ==> (map f xs)!n = f(xs!n)" |
1596 |
apply (induct xs arbitrary: n, simp) |
|
14208 | 1597 |
apply (case_tac n, auto) |
13145 | 1598 |
done |
13114 | 1599 |
|
45841 | 1600 |
lemma nth_tl: |
1601 |
assumes "n < length (tl x)" shows "tl x ! n = x ! Suc n" |
|
1602 |
using assms by (induct x) auto |
|
1603 |
||
18423 | 1604 |
lemma hd_conv_nth: "xs \<noteq> [] \<Longrightarrow> hd xs = xs!0" |
1605 |
by(cases xs) simp_all |
|
1606 |
||
18049 | 1607 |
|
1608 |
lemma list_eq_iff_nth_eq: |
|
24526 | 1609 |
"(xs = ys) = (length xs = length ys \<and> (ALL i<length xs. xs!i = ys!i))" |
1610 |
apply(induct xs arbitrary: ys) |
|
24632 | 1611 |
apply force |
18049 | 1612 |
apply(case_tac ys) |
1613 |
apply simp |
|
1614 |
apply(simp add:nth_Cons split:nat.split)apply blast |
|
1615 |
done |
|
1616 |
||
13142 | 1617 |
lemma set_conv_nth: "set xs = {xs!i | i. i < length xs}" |
15251 | 1618 |
apply (induct xs, simp, simp) |
13145 | 1619 |
apply safe |
24632 | 1620 |
apply (metis nat_case_0 nth.simps zero_less_Suc) |
1621 |
apply (metis less_Suc_eq_0_disj nth_Cons_Suc) |
|
14208 | 1622 |
apply (case_tac i, simp) |
24632 | 1623 |
apply (metis diff_Suc_Suc nat_case_Suc nth.simps zero_less_diff) |
13145 | 1624 |
done |
13114 | 1625 |
|
17501 | 1626 |
lemma in_set_conv_nth: "(x \<in> set xs) = (\<exists>i < length xs. xs!i = x)" |
1627 |
by(auto simp:set_conv_nth) |
|
1628 |
||
13145 | 1629 |
lemma list_ball_nth: "[| n < length xs; !x : set xs. P x|] ==> P(xs!n)" |
1630 |
by (auto simp add: set_conv_nth) |
|
13114 | 1631 |
|
13142 | 1632 |
lemma nth_mem [simp]: "n < length xs ==> xs!n : set xs" |
13145 | 1633 |
by (auto simp add: set_conv_nth) |
13114 | 1634 |
|
1635 |
lemma all_nth_imp_all_set: |
|
13145 | 1636 |
"[| !i < length xs. P(xs!i); x : set xs|] ==> P x" |
1637 |
by (auto simp add: set_conv_nth) |
|
13114 | 1638 |
|
1639 |
lemma all_set_conv_all_nth: |
|
13145 | 1640 |
"(\<forall>x \<in> set xs. P x) = (\<forall>i. i < length xs --> P (xs ! i))" |
1641 |
by (auto simp add: set_conv_nth) |
|
13114 | 1642 |
|
25296 | 1643 |
lemma rev_nth: |
1644 |
"n < size xs \<Longrightarrow> rev xs ! n = xs ! (length xs - Suc n)" |
|
1645 |
proof (induct xs arbitrary: n) |
|
1646 |
case Nil thus ?case by simp |
|
1647 |
next |
|
1648 |
case (Cons x xs) |
|
1649 |
hence n: "n < Suc (length xs)" by simp |
|
1650 |
moreover |
|
1651 |
{ assume "n < length xs" |
|
1652 |
with n obtain n' where "length xs - n = Suc n'" |
|
1653 |
by (cases "length xs - n", auto) |
|
1654 |
moreover |
|
1655 |
then have "length xs - Suc n = n'" by simp |
|
1656 |
ultimately |
|
1657 |
have "xs ! (length xs - Suc n) = (x # xs) ! (length xs - n)" by simp |
|
1658 |
} |
|
1659 |
ultimately |
|
1660 |
show ?case by (clarsimp simp add: Cons nth_append) |
|
1661 |
qed |
|
13114 | 1662 |
|
31159 | 1663 |
lemma Skolem_list_nth: |
1664 |
"(ALL i<k. EX x. P i x) = (EX xs. size xs = k & (ALL i<k. P i (xs!i)))" |
|
1665 |
(is "_ = (EX xs. ?P k xs)") |
|
1666 |
proof(induct k) |
|
1667 |
case 0 show ?case by simp |
|
1668 |
next |
|
1669 |
case (Suc k) |
|
1670 |
show ?case (is "?L = ?R" is "_ = (EX xs. ?P' xs)") |
|
1671 |
proof |
|
1672 |
assume "?R" thus "?L" using Suc by auto |
|
1673 |
next |
|
1674 |
assume "?L" |
|
1675 |
with Suc obtain x xs where "?P k xs & P k x" by (metis less_Suc_eq) |
|
1676 |
hence "?P'(xs@[x])" by(simp add:nth_append less_Suc_eq) |
|
1677 |
thus "?R" .. |
|
1678 |
qed |
|
1679 |
qed |
|
1680 |
||
1681 |
||
49948
744934b818c7
moved quite generic material from theory Enum to more appropriate places
haftmann
parents:
49808
diff
changeset
|
1682 |
subsubsection {* @{const list_update} *} |
13114 | 1683 |
|
24526 | 1684 |
lemma length_list_update [simp]: "length(xs[i:=x]) = length xs" |
1685 |
by (induct xs arbitrary: i) (auto split: nat.split) |
|
13114 | 1686 |
|
1687 |
lemma nth_list_update: |
|
24526 | 1688 |
"i < length xs==> (xs[i:=x])!j = (if i = j then x else xs!j)" |
1689 |
by (induct xs arbitrary: i j) (auto simp add: nth_Cons split: nat.split) |
|
13114 | 1690 |
|
13142 | 1691 |
lemma nth_list_update_eq [simp]: "i < length xs ==> (xs[i:=x])!i = x" |
13145 | 1692 |
by (simp add: nth_list_update) |
13114 | 1693 |
|
24526 | 1694 |
lemma nth_list_update_neq [simp]: "i \<noteq> j ==> xs[i:=x]!j = xs!j" |
1695 |
by (induct xs arbitrary: i j) (auto simp add: nth_Cons split: nat.split) |
|
13114 | 1696 |
|
24526 | 1697 |
lemma list_update_id[simp]: "xs[i := xs!i] = xs" |
1698 |
by (induct xs arbitrary: i) (simp_all split:nat.splits) |
|
1699 |
||
1700 |
lemma list_update_beyond[simp]: "length xs \<le> i \<Longrightarrow> xs[i:=x] = xs" |
|
1701 |
apply (induct xs arbitrary: i) |
|
17501 | 1702 |
apply simp |
1703 |
apply (case_tac i) |
|
1704 |
apply simp_all |
|
1705 |
done |
|
1706 |
||
31077 | 1707 |
lemma list_update_nonempty[simp]: "xs[k:=x] = [] \<longleftrightarrow> xs=[]" |
1708 |
by(metis length_0_conv length_list_update) |
|
1709 |
||
13114 | 1710 |
lemma list_update_same_conv: |
24526 | 1711 |
"i < length xs ==> (xs[i := x] = xs) = (xs!i = x)" |
1712 |
by (induct xs arbitrary: i) (auto split: nat.split) |
|
13114 | 1713 |
|
14187 | 1714 |
lemma list_update_append1: |
24526 | 1715 |
"i < size xs \<Longrightarrow> (xs @ ys)[i:=x] = xs[i:=x] @ ys" |
1716 |
apply (induct xs arbitrary: i, simp) |
|
14187 | 1717 |
apply(simp split:nat.split) |
1718 |
done |
|
1719 |
||
15868 | 1720 |
lemma list_update_append: |
24526 | 1721 |
"(xs @ ys) [n:= x] = |
15868 | 1722 |
(if n < length xs then xs[n:= x] @ ys else xs @ (ys [n-length xs:= x]))" |
24526 | 1723 |
by (induct xs arbitrary: n) (auto split:nat.splits) |
15868 | 1724 |
|
14402
4201e1916482
moved lemmas from MicroJava/Comp/AuxLemmas.thy to List.thy
nipkow
parents:
14395
diff
changeset
|
1725 |
lemma list_update_length [simp]: |
4201e1916482
moved lemmas from MicroJava/Comp/AuxLemmas.thy to List.thy
nipkow
parents:
14395
diff
changeset
|
1726 |
"(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
|
1727 |
by (induct xs, auto) |
4201e1916482
moved lemmas from MicroJava/Comp/AuxLemmas.thy to List.thy
nipkow
parents:
14395
diff
changeset
|
1728 |
|
31264 | 1729 |
lemma map_update: "map f (xs[k:= y]) = (map f xs)[k := f y]" |
1730 |
by(induct xs arbitrary: k)(auto split:nat.splits) |
|
1731 |
||
1732 |
lemma rev_update: |
|
1733 |
"k < length xs \<Longrightarrow> rev (xs[k:= y]) = (rev xs)[length xs - k - 1 := y]" |
|
1734 |
by (induct xs arbitrary: k) (auto simp: list_update_append split:nat.splits) |
|
1735 |
||
13114 | 1736 |
lemma update_zip: |
31080 | 1737 |
"(zip xs ys)[i:=xy] = zip (xs[i:=fst xy]) (ys[i:=snd xy])" |
24526 | 1738 |
by (induct ys arbitrary: i xy xs) (auto, case_tac xs, auto split: nat.split) |
1739 |
||
1740 |
lemma set_update_subset_insert: "set(xs[i:=x]) <= insert x (set xs)" |
|
1741 |
by (induct xs arbitrary: i) (auto split: nat.split) |
|
13114 | 1742 |
|
1743 |
lemma set_update_subsetI: "[| set xs <= A; x:A |] ==> set(xs[i := x]) <= A" |
|
13145 | 1744 |
by (blast dest!: set_update_subset_insert [THEN subsetD]) |
13114 | 1745 |
|
24526 | 1746 |
lemma set_update_memI: "n < length xs \<Longrightarrow> x \<in> set (xs[n := x])" |
1747 |
by (induct xs arbitrary: n) (auto split:nat.splits) |
|
15868 | 1748 |
|
31077 | 1749 |
lemma list_update_overwrite[simp]: |
24796 | 1750 |
"xs [i := x, i := y] = xs [i := y]" |
31077 | 1751 |
apply (induct xs arbitrary: i) apply simp |
1752 |
apply (case_tac i, simp_all) |
|
24796 | 1753 |
done |
1754 |
||
1755 |
lemma list_update_swap: |
|
1756 |
"i \<noteq> i' \<Longrightarrow> xs [i := x, i' := x'] = xs [i' := x', i := x]" |
|
1757 |
apply (induct xs arbitrary: i i') |
|
1758 |
apply simp |
|
1759 |
apply (case_tac i, case_tac i') |
|
1760 |
apply auto |
|
1761 |
apply (case_tac i') |
|
1762 |
apply auto |
|
1763 |
done |
|
1764 |
||
29827 | 1765 |
lemma list_update_code [code]: |
1766 |
"[][i := y] = []" |
|
1767 |
"(x # xs)[0 := y] = y # xs" |
|
1768 |
"(x # xs)[Suc i := y] = x # xs[i := y]" |
|
1769 |
by simp_all |
|
1770 |
||
13114 | 1771 |
|
49948
744934b818c7
moved quite generic material from theory Enum to more appropriate places
haftmann
parents:
49808
diff
changeset
|
1772 |
subsubsection {* @{const last} and @{const butlast} *} |
13114 | 1773 |
|
13142 | 1774 |
lemma last_snoc [simp]: "last (xs @ [x]) = x" |
13145 | 1775 |
by (induct xs) auto |
13114 | 1776 |
|
13142 | 1777 |
lemma butlast_snoc [simp]: "butlast (xs @ [x]) = xs" |
13145 | 1778 |
by (induct xs) auto |
13114 | 1779 |
|
14302 | 1780 |
lemma last_ConsL: "xs = [] \<Longrightarrow> last(x#xs) = x" |
44921 | 1781 |
by simp |
14302 | 1782 |
|
1783 |
lemma last_ConsR: "xs \<noteq> [] \<Longrightarrow> last(x#xs) = last xs" |
|
44921 | 1784 |
by simp |
14302 | 1785 |
|
1786 |
lemma last_append: "last(xs @ ys) = (if ys = [] then last xs else last ys)" |
|
1787 |
by (induct xs) (auto) |
|
1788 |
||
1789 |
lemma last_appendL[simp]: "ys = [] \<Longrightarrow> last(xs @ ys) = last xs" |
|
1790 |
by(simp add:last_append) |
|
1791 |
||
1792 |
lemma last_appendR[simp]: "ys \<noteq> [] \<Longrightarrow> last(xs @ ys) = last ys" |
|
1793 |
by(simp add:last_append) |
|
1794 |
||
45841 | 1795 |
lemma last_tl: "xs = [] \<or> tl xs \<noteq> [] \<Longrightarrow>last (tl xs) = last xs" |
1796 |
by (induct xs) simp_all |
|
1797 |
||
1798 |
lemma butlast_tl: "butlast (tl xs) = tl (butlast xs)" |
|
1799 |
by (induct xs) simp_all |
|
1800 |
||
17762 | 1801 |
lemma hd_rev: "xs \<noteq> [] \<Longrightarrow> hd(rev xs) = last xs" |
1802 |
by(rule rev_exhaust[of xs]) simp_all |
|
1803 |
||
1804 |
lemma last_rev: "xs \<noteq> [] \<Longrightarrow> last(rev xs) = hd xs" |
|
1805 |
by(cases xs) simp_all |
|
1806 |
||
17765 | 1807 |
lemma last_in_set[simp]: "as \<noteq> [] \<Longrightarrow> last as \<in> set as" |
1808 |
by (induct as) auto |
|
17762 | 1809 |
|
13142 | 1810 |
lemma length_butlast [simp]: "length (butlast xs) = length xs - 1" |
13145 | 1811 |
by (induct xs rule: rev_induct) auto |
13114 | 1812 |
|
1813 |
lemma butlast_append: |
|
24526 | 1814 |
"butlast (xs @ ys) = (if ys = [] then butlast xs else xs @ butlast ys)" |
1815 |
by (induct xs arbitrary: ys) auto |
|
13114 | 1816 |
|
13142 | 1817 |
lemma append_butlast_last_id [simp]: |
13145 | 1818 |
"xs \<noteq> [] ==> butlast xs @ [last xs] = xs" |
1819 |
by (induct xs) auto |
|
13114 | 1820 |
|
13142 | 1821 |
lemma in_set_butlastD: "x : set (butlast xs) ==> x : set xs" |
13145 | 1822 |
by (induct xs) (auto split: split_if_asm) |
13114 | 1823 |
|
1824 |
lemma in_set_butlast_appendI: |
|
13145 | 1825 |
"x : set (butlast xs) | x : set (butlast ys) ==> x : set (butlast (xs @ ys))" |
1826 |
by (auto dest: in_set_butlastD simp add: butlast_append) |
|
13114 | 1827 |
|
24526 | 1828 |
lemma last_drop[simp]: "n < length xs \<Longrightarrow> last (drop n xs) = last xs" |
1829 |
apply (induct xs arbitrary: n) |
|
17501 | 1830 |
apply simp |
1831 |
apply (auto split:nat.split) |
|
1832 |
done |
|
1833 |
||
45841 | 1834 |
lemma nth_butlast: |
1835 |
assumes "n < length (butlast xs)" shows "butlast xs ! n = xs ! n" |
|
1836 |
proof (cases xs) |
|
1837 |
case (Cons y ys) |
|
1838 |
moreover from assms have "butlast xs ! n = (butlast xs @ [last xs]) ! n" |
|
1839 |
by (simp add: nth_append) |
|
1840 |
ultimately show ?thesis using append_butlast_last_id by simp |
|
1841 |
qed simp |
|
1842 |
||
30128
365ee7319b86
revert some Suc 0 lemmas back to their original forms; added some simp rules for (1::nat)
huffman
parents:
30079
diff
changeset
|
1843 |
lemma last_conv_nth: "xs\<noteq>[] \<Longrightarrow> last xs = xs!(length xs - 1)" |
17589 | 1844 |
by(induct xs)(auto simp:neq_Nil_conv) |
1845 |
||
30128
365ee7319b86
revert some Suc 0 lemmas back to their original forms; added some simp rules for (1::nat)
huffman
parents:
30079
diff
changeset
|
1846 |
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
|
1847 |
by (induct xs, simp, case_tac xs, simp_all) |
46f3b89b2445
move lemmas from Word/BinBoolList.thy to List.thy
huffman
parents:
26480
diff
changeset
|
1848 |
|
31077 | 1849 |
lemma last_list_update: |
1850 |
"xs \<noteq> [] \<Longrightarrow> last(xs[k:=x]) = (if k = size xs - 1 then x else last xs)" |
|
1851 |
by (auto simp: last_conv_nth) |
|
1852 |
||
1853 |
lemma butlast_list_update: |
|
1854 |
"butlast(xs[k:=x]) = |
|
1855 |
(if k = size xs - 1 then butlast xs else (butlast xs)[k:=x])" |
|
1856 |
apply(cases xs rule:rev_cases) |
|
1857 |
apply simp |
|
1858 |
apply(simp add:list_update_append split:nat.splits) |
|
1859 |
done |
|
1860 |
||
36851 | 1861 |
lemma last_map: |
1862 |
"xs \<noteq> [] \<Longrightarrow> last (map f xs) = f (last xs)" |
|
1863 |
by (cases xs rule: rev_cases) simp_all |
|
1864 |
||
1865 |
lemma map_butlast: |
|
1866 |
"map f (butlast xs) = butlast (map f xs)" |
|
1867 |
by (induct xs) simp_all |
|
1868 |
||
40230 | 1869 |
lemma snoc_eq_iff_butlast: |
1870 |
"xs @ [x] = ys \<longleftrightarrow> (ys \<noteq> [] & butlast ys = xs & last ys = x)" |
|
1871 |
by (metis append_butlast_last_id append_is_Nil_conv butlast_snoc last_snoc not_Cons_self) |
|
1872 |
||
24796 | 1873 |
|
49948
744934b818c7
moved quite generic material from theory Enum to more appropriate places
haftmann
parents:
49808
diff
changeset
|
1874 |
subsubsection {* @{const take} and @{const drop} *} |
13114 | 1875 |
|
13142 | 1876 |
lemma take_0 [simp]: "take 0 xs = []" |
13145 | 1877 |
by (induct xs) auto |
13114 | 1878 |
|
13142 | 1879 |
lemma drop_0 [simp]: "drop 0 xs = xs" |
13145 | 1880 |
by (induct xs) auto |
13114 | 1881 |
|
13142 | 1882 |
lemma take_Suc_Cons [simp]: "take (Suc n) (x # xs) = x # take n xs" |
13145 | 1883 |
by simp |
13114 | 1884 |
|
13142 | 1885 |
lemma drop_Suc_Cons [simp]: "drop (Suc n) (x # xs) = drop n xs" |
13145 | 1886 |
by simp |
13114 | 1887 |
|
13142 | 1888 |
declare take_Cons [simp del] and drop_Cons [simp del] |
13114 | 1889 |
|
30128
365ee7319b86
revert some Suc 0 lemmas back to their original forms; added some simp rules for (1::nat)
huffman
parents:
30079
diff
changeset
|
1890 |
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
|
1891 |
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
|
1892 |
|
365ee7319b86
revert some Suc 0 lemmas back to their original forms; added some simp rules for (1::nat)
huffman
parents:
30079
diff
changeset
|
1893 |
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
|
1894 |
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
|
1895 |
|
15110
78b5636eabc7
Added a number of new thms and the new function remove1
nipkow
parents:
15072
diff
changeset
|
1896 |
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
|
1897 |
by(clarsimp simp add:neq_Nil_conv) |
78b5636eabc7
Added a number of new thms and the new function remove1
nipkow
parents:
15072
diff
changeset
|
1898 |
|
14187 | 1899 |
lemma drop_Suc: "drop (Suc n) xs = drop n (tl xs)" |
1900 |
by(cases xs, simp_all) |
|
1901 |
||
26584
46f3b89b2445
move lemmas from Word/BinBoolList.thy to List.thy
huffman
parents:
26480
diff
changeset
|
1902 |
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
|
1903 |
by (induct xs arbitrary: n) simp_all |
46f3b89b2445
move lemmas from Word/BinBoolList.thy to List.thy
huffman
parents:
26480
diff
changeset
|
1904 |
|
24526 | 1905 |
lemma drop_tl: "drop n (tl xs) = tl(drop n xs)" |
1906 |
by(induct xs arbitrary: n, simp_all add:drop_Cons drop_Suc split:nat.split) |
|
1907 |
||
26584
46f3b89b2445
move lemmas from Word/BinBoolList.thy to List.thy
huffman
parents:
26480
diff
changeset
|
1908 |
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
|
1909 |
by (cases n, simp, cases xs, auto) |
46f3b89b2445
move lemmas from Word/BinBoolList.thy to List.thy
huffman
parents:
26480
diff
changeset
|
1910 |
|
46f3b89b2445
move lemmas from Word/BinBoolList.thy to List.thy
huffman
parents:
26480
diff
changeset
|
1911 |
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
|
1912 |
by (simp only: drop_tl) |
46f3b89b2445
move lemmas from Word/BinBoolList.thy to List.thy
huffman
parents:
26480
diff
changeset
|
1913 |
|
24526 | 1914 |
lemma nth_via_drop: "drop n xs = y#ys \<Longrightarrow> xs!n = y" |
1915 |
apply (induct xs arbitrary: n, simp) |
|
14187 | 1916 |
apply(simp add:drop_Cons nth_Cons split:nat.splits) |
1917 |
done |
|
1918 |
||
13913 | 1919 |
lemma take_Suc_conv_app_nth: |
24526 | 1920 |
"i < length xs \<Longrightarrow> take (Suc i) xs = take i xs @ [xs!i]" |
1921 |
apply (induct xs arbitrary: i, simp) |
|
14208 | 1922 |
apply (case_tac i, auto) |
13913 | 1923 |
done |
1924 |
||
14591 | 1925 |
lemma drop_Suc_conv_tl: |
24526 | 1926 |
"i < length xs \<Longrightarrow> (xs!i) # (drop (Suc i) xs) = drop i xs" |
1927 |
apply (induct xs arbitrary: i, simp) |
|
14591 | 1928 |
apply (case_tac i, auto) |
1929 |
done |
|
1930 |
||
24526 | 1931 |
lemma length_take [simp]: "length (take n xs) = min (length xs) n" |
1932 |
by (induct n arbitrary: xs) (auto, case_tac xs, auto) |
|
1933 |
||
1934 |
lemma length_drop [simp]: "length (drop n xs) = (length xs - n)" |
|
1935 |
by (induct n arbitrary: xs) (auto, case_tac xs, auto) |
|
1936 |
||
1937 |
lemma take_all [simp]: "length xs <= n ==> take n xs = xs" |
|
1938 |
by (induct n arbitrary: xs) (auto, case_tac xs, auto) |
|
1939 |
||
1940 |
lemma drop_all [simp]: "length xs <= n ==> drop n xs = []" |
|
1941 |
by (induct n arbitrary: xs) (auto, case_tac xs, auto) |
|
13114 | 1942 |
|
13142 | 1943 |
lemma take_append [simp]: |
24526 | 1944 |
"take n (xs @ ys) = (take n xs @ take (n - length xs) ys)" |
1945 |
by (induct n arbitrary: xs) (auto, case_tac xs, auto) |
|
13114 | 1946 |
|
13142 | 1947 |
lemma drop_append [simp]: |
24526 | 1948 |
"drop n (xs @ ys) = drop n xs @ drop (n - length xs) ys" |
1949 |
by (induct n arbitrary: xs) (auto, case_tac xs, auto) |
|
1950 |
||
1951 |
lemma take_take [simp]: "take n (take m xs) = take (min n m) xs" |
|
1952 |
apply (induct m arbitrary: xs n, auto) |
|
14208 | 1953 |
apply (case_tac xs, auto) |
15236
f289e8ba2bb3
Proofs needed to be updated because induction now preserves name of
nipkow
parents:
15176
diff
changeset
|
1954 |
apply (case_tac n, auto) |
13145 | 1955 |
done |
13114 | 1956 |
|
24526 | 1957 |
lemma drop_drop [simp]: "drop n (drop m xs) = drop (n + m) xs" |
1958 |
apply (induct m arbitrary: xs, auto) |
|
14208 | 1959 |
apply (case_tac xs, auto) |
13145 | 1960 |
done |
13114 | 1961 |
|
24526 | 1962 |
lemma take_drop: "take n (drop m xs) = drop m (take (n + m) xs)" |
1963 |
apply (induct m arbitrary: xs n, auto) |
|
14208 | 1964 |
apply (case_tac xs, auto) |
13145 | 1965 |
done |
13114 | 1966 |
|
24526 | 1967 |
lemma drop_take: "drop n (take m xs) = take (m-n) (drop n xs)" |
1968 |
apply(induct xs arbitrary: m n) |
|
14802 | 1969 |
apply simp |
1970 |
apply(simp add: take_Cons drop_Cons split:nat.split) |
|
1971 |
done |
|
1972 |
||
24526 | 1973 |
lemma append_take_drop_id [simp]: "take n xs @ drop n xs = xs" |
1974 |
apply (induct n arbitrary: xs, auto) |
|
14208 | 1975 |
apply (case_tac xs, auto) |
13145 | 1976 |
done |
13114 | 1977 |
|
24526 | 1978 |
lemma take_eq_Nil[simp]: "(take n xs = []) = (n = 0 \<or> xs = [])" |
1979 |
apply(induct xs arbitrary: n) |
|
15110
78b5636eabc7
Added a number of new thms and the new function remove1
nipkow
parents:
15072
diff
changeset
|
1980 |
apply simp |
78b5636eabc7
Added a number of new thms and the new function remove1
nipkow
parents:
15072
diff
changeset
|
1981 |
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
|
1982 |
done |
78b5636eabc7
Added a number of new thms and the new function remove1
nipkow
parents:
15072
diff
changeset
|
1983 |
|
24526 | 1984 |
lemma drop_eq_Nil[simp]: "(drop n xs = []) = (length xs <= n)" |
1985 |
apply(induct xs arbitrary: n) |
|
15110
78b5636eabc7
Added a number of new thms and the new function remove1
nipkow
parents:
15072
diff
changeset
|
1986 |
apply simp |
78b5636eabc7
Added a number of new thms and the new function remove1
nipkow
parents:
15072
diff
changeset
|
1987 |
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
|
1988 |
done |
78b5636eabc7
Added a number of new thms and the new function remove1
nipkow
parents:
15072
diff
changeset
|
1989 |
|
24526 | 1990 |
lemma take_map: "take n (map f xs) = map f (take n xs)" |
1991 |
apply (induct n arbitrary: xs, auto) |
|
14208 | 1992 |
apply (case_tac xs, auto) |
13145 | 1993 |
done |
13114 | 1994 |
|
24526 | 1995 |
lemma drop_map: "drop n (map f xs) = map f (drop n xs)" |
1996 |
apply (induct n arbitrary: xs, auto) |
|
14208 | 1997 |
apply (case_tac xs, auto) |
13145 | 1998 |
done |
13114 | 1999 |
|
24526 | 2000 |
lemma rev_take: "rev (take i xs) = drop (length xs - i) (rev xs)" |
2001 |
apply (induct xs arbitrary: i, auto) |
|
14208 | 2002 |
apply (case_tac i, auto) |
13145 | 2003 |
done |
13114 | 2004 |
|
24526 | 2005 |
lemma rev_drop: "rev (drop i xs) = take (length xs - i) (rev xs)" |
2006 |
apply (induct xs arbitrary: i, auto) |
|
14208 | 2007 |
apply (case_tac i, auto) |
13145 | 2008 |
done |
13114 | 2009 |
|
24526 | 2010 |
lemma nth_take [simp]: "i < n ==> (take n xs)!i = xs!i" |
2011 |
apply (induct xs arbitrary: i n, auto) |
|
14208 | 2012 |
apply (case_tac n, blast) |
2013 |
apply (case_tac i, auto) |
|
13145 | 2014 |
done |
13114 | 2015 |
|
13142 | 2016 |
lemma nth_drop [simp]: |
24526 | 2017 |
"n + i <= length xs ==> (drop n xs)!i = xs!(n + i)" |
2018 |
apply (induct n arbitrary: xs i, auto) |
|
14208 | 2019 |
apply (case_tac xs, auto) |
13145 | 2020 |
done |
3507 | 2021 |
|
26584
46f3b89b2445
move lemmas from Word/BinBoolList.thy to List.thy
huffman
parents:
26480
diff
changeset
|
2022 |
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
|
2023 |
"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
|
2024 |
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
|
2025 |
|
46f3b89b2445
move lemmas from Word/BinBoolList.thy to List.thy
huffman
parents:
26480
diff
changeset
|
2026 |
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
|
2027 |
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
|
2028 |
|
46f3b89b2445
move lemmas from Word/BinBoolList.thy to List.thy
huffman
parents:
26480
diff
changeset
|
2029 |
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
|
2030 |
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
|
2031 |
|
46f3b89b2445
move lemmas from Word/BinBoolList.thy to List.thy
huffman
parents:
26480
diff
changeset
|
2032 |
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
|
2033 |
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
|
2034 |
|
46500
0196966d6d2d
removing unnecessary premises in theorems of List theory
bulwahn
parents:
46448
diff
changeset
|
2035 |
lemma hd_drop_conv_nth: "n < length xs \<Longrightarrow> hd(drop n xs) = xs!n" |
18423 | 2036 |
by(simp add: hd_conv_nth) |
2037 |
||
35248 | 2038 |
lemma set_take_subset_set_take: |
2039 |
"m <= n \<Longrightarrow> set(take m xs) <= set(take n xs)" |
|
41463
edbf0a86fb1c
adding simproc to rewrite list comprehensions to set comprehensions; adopting proofs
bulwahn
parents:
41372
diff
changeset
|
2040 |
apply (induct xs arbitrary: m n) |
edbf0a86fb1c
adding simproc to rewrite list comprehensions to set comprehensions; adopting proofs
bulwahn
parents:
41372
diff
changeset
|
2041 |
apply simp |
edbf0a86fb1c
adding simproc to rewrite list comprehensions to set comprehensions; adopting proofs
bulwahn
parents:
41372
diff
changeset
|
2042 |
apply (case_tac n) |
edbf0a86fb1c
adding simproc to rewrite list comprehensions to set comprehensions; adopting proofs
bulwahn
parents:
41372
diff
changeset
|
2043 |
apply (auto simp: take_Cons) |
edbf0a86fb1c
adding simproc to rewrite list comprehensions to set comprehensions; adopting proofs
bulwahn
parents:
41372
diff
changeset
|
2044 |
done |
35248 | 2045 |
|
24526 | 2046 |
lemma set_take_subset: "set(take n xs) \<subseteq> set xs" |
2047 |
by(induct xs arbitrary: n)(auto simp:take_Cons split:nat.split) |
|
2048 |
||
2049 |
lemma set_drop_subset: "set(drop n xs) \<subseteq> set xs" |
|
2050 |
by(induct xs arbitrary: n)(auto simp:drop_Cons split:nat.split) |
|
14025 | 2051 |
|
35248 | 2052 |
lemma set_drop_subset_set_drop: |
2053 |
"m >= n \<Longrightarrow> set(drop m xs) <= set(drop n xs)" |
|
2054 |
apply(induct xs arbitrary: m n) |
|
2055 |
apply(auto simp:drop_Cons split:nat.split) |
|
2056 |
apply (metis set_drop_subset subset_iff) |
|
2057 |
done |
|
2058 |
||
14187 | 2059 |
lemma in_set_takeD: "x : set(take n xs) \<Longrightarrow> x : set xs" |
2060 |
using set_take_subset by fast |
|
2061 |
||
2062 |
lemma in_set_dropD: "x : set(drop n xs) \<Longrightarrow> x : set xs" |
|
2063 |
using set_drop_subset by fast |
|
2064 |
||
13114 | 2065 |
lemma append_eq_conv_conj: |
24526 | 2066 |
"(xs @ ys = zs) = (xs = take (length xs) zs \<and> ys = drop (length xs) zs)" |
2067 |
apply (induct xs arbitrary: zs, simp, clarsimp) |
|
14208 | 2068 |
apply (case_tac zs, auto) |
13145 | 2069 |
done |
13142 | 2070 |
|
24526 | 2071 |
lemma take_add: |
42713 | 2072 |
"take (i+j) xs = take i xs @ take j (drop i xs)" |
24526 | 2073 |
apply (induct xs arbitrary: i, auto) |
2074 |
apply (case_tac i, simp_all) |
|
14050 | 2075 |
done |
2076 |
||
14300 | 2077 |
lemma append_eq_append_conv_if: |
24526 | 2078 |
"(xs\<^isub>1 @ xs\<^isub>2 = ys\<^isub>1 @ ys\<^isub>2) = |
14300 | 2079 |
(if size xs\<^isub>1 \<le> size ys\<^isub>1 |
2080 |
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 |
|
2081 |
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 | 2082 |
apply(induct xs\<^isub>1 arbitrary: ys\<^isub>1) |
14300 | 2083 |
apply simp |
2084 |
apply(case_tac ys\<^isub>1) |
|
2085 |
apply simp_all |
|
2086 |
done |
|
2087 |
||
15110
78b5636eabc7
Added a number of new thms and the new function remove1
nipkow
parents:
15072
diff
changeset
|
2088 |
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
|
2089 |
"n < length xs \<Longrightarrow> take n xs @ [hd (drop n xs)] = take (Suc n) xs" |
24526 | 2090 |
apply(induct xs arbitrary: n) |
15110
78b5636eabc7
Added a number of new thms and the new function remove1
nipkow
parents:
15072
diff
changeset
|
2091 |
apply simp |
78b5636eabc7
Added a number of new thms and the new function remove1
nipkow
parents:
15072
diff
changeset
|
2092 |
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
|
2093 |
done |
78b5636eabc7
Added a number of new thms and the new function remove1
nipkow
parents:
15072
diff
changeset
|
2094 |
|
17501 | 2095 |
lemma id_take_nth_drop: |
2096 |
"i < length xs \<Longrightarrow> xs = take i xs @ xs!i # drop (Suc i) xs" |
|
2097 |
proof - |
|
2098 |
assume si: "i < length xs" |
|
2099 |
hence "xs = take (Suc i) xs @ drop (Suc i) xs" by auto |
|
2100 |
moreover |
|
2101 |
from si have "take (Suc i) xs = take i xs @ [xs!i]" |
|
2102 |
apply (rule_tac take_Suc_conv_app_nth) by arith |
|
2103 |
ultimately show ?thesis by auto |
|
2104 |
qed |
|
2105 |
||
2106 |
lemma upd_conv_take_nth_drop: |
|
2107 |
"i < length xs \<Longrightarrow> xs[i:=a] = take i xs @ a # drop (Suc i) xs" |
|
2108 |
proof - |
|
2109 |
assume i: "i < length xs" |
|
2110 |
have "xs[i:=a] = (take i xs @ xs!i # drop (Suc i) xs)[i:=a]" |
|
2111 |
by(rule arg_cong[OF id_take_nth_drop[OF i]]) |
|
2112 |
also have "\<dots> = take i xs @ a # drop (Suc i) xs" |
|
2113 |
using i by (simp add: list_update_append) |
|
2114 |
finally show ?thesis . |
|
2115 |
qed |
|
2116 |
||
24796 | 2117 |
lemma nth_drop': |
2118 |
"i < length xs \<Longrightarrow> xs ! i # drop (Suc i) xs = drop i xs" |
|
2119 |
apply (induct i arbitrary: xs) |
|
2120 |
apply (simp add: neq_Nil_conv) |
|
2121 |
apply (erule exE)+ |
|
2122 |
apply simp |
|
2123 |
apply (case_tac xs) |
|
2124 |
apply simp_all |
|
2125 |
done |
|
2126 |
||
13114 | 2127 |
|
49948
744934b818c7
moved quite generic material from theory Enum to more appropriate places
haftmann
parents:
49808
diff
changeset
|
2128 |
subsubsection {* @{const takeWhile} and @{const dropWhile} *} |
13114 | 2129 |
|
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
|
2130 |
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
|
2131 |
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
|
2132 |
|
13142 | 2133 |
lemma takeWhile_dropWhile_id [simp]: "takeWhile P xs @ dropWhile P xs = xs" |
13145 | 2134 |
by (induct xs) auto |
13114 | 2135 |
|
13142 | 2136 |
lemma takeWhile_append1 [simp]: |
13145 | 2137 |
"[| x:set xs; ~P(x)|] ==> takeWhile P (xs @ ys) = takeWhile P xs" |
2138 |
by (induct xs) auto |
|
13114 | 2139 |
|
13142 | 2140 |
lemma takeWhile_append2 [simp]: |
13145 | 2141 |
"(!!x. x : set xs ==> P x) ==> takeWhile P (xs @ ys) = xs @ takeWhile P ys" |
2142 |
by (induct xs) auto |
|
13114 | 2143 |
|
13142 | 2144 |
lemma takeWhile_tail: "\<not> P x ==> takeWhile P (xs @ (x#l)) = takeWhile P xs" |
13145 | 2145 |
by (induct xs) auto |
13114 | 2146 |
|
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
|
2147 |
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
|
2148 |
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
|
2149 |
|
603320b93668
New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents:
33593
diff
changeset
|
2150 |
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
|
2151 |
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
|
2152 |
|
603320b93668
New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents:
33593
diff
changeset
|
2153 |
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
|
2154 |
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
|
2155 |
|
13142 | 2156 |
lemma dropWhile_append1 [simp]: |
13145 | 2157 |
"[| x : set xs; ~P(x)|] ==> dropWhile P (xs @ ys) = (dropWhile P xs)@ys" |
2158 |
by (induct xs) auto |
|
13114 | 2159 |
|
13142 | 2160 |
lemma dropWhile_append2 [simp]: |
13145 | 2161 |
"(!!x. x:set xs ==> P(x)) ==> dropWhile P (xs @ ys) = dropWhile P ys" |
2162 |
by (induct xs) auto |
|
13114 | 2163 |
|
45841 | 2164 |
lemma dropWhile_append3: |
2165 |
"\<not> P y \<Longrightarrow>dropWhile P (xs @ y # ys) = dropWhile P xs @ y # ys" |
|
2166 |
by (induct xs) auto |
|
2167 |
||
2168 |
lemma dropWhile_last: |
|
2169 |
"x \<in> set xs \<Longrightarrow> \<not> P x \<Longrightarrow> last (dropWhile P xs) = last xs" |
|
2170 |
by (auto simp add: dropWhile_append3 in_set_conv_decomp) |
|
2171 |
||
2172 |
lemma set_dropWhileD: "x \<in> set (dropWhile P xs) \<Longrightarrow> x \<in> set xs" |
|
2173 |
by (induct xs) (auto split: split_if_asm) |
|
2174 |
||
23971
e6d505d5b03d
renamed lemma "set_take_whileD" to "set_takeWhileD"
krauss
parents:
23740
diff
changeset
|
2175 |
lemma set_takeWhileD: "x : set (takeWhile P xs) ==> x : set xs \<and> P x" |
13145 | 2176 |
by (induct xs) (auto split: split_if_asm) |
13114 | 2177 |
|
13913 | 2178 |
lemma takeWhile_eq_all_conv[simp]: |
2179 |
"(takeWhile P xs = xs) = (\<forall>x \<in> set xs. P x)" |
|
2180 |
by(induct xs, auto) |
|
2181 |
||
2182 |
lemma dropWhile_eq_Nil_conv[simp]: |
|
2183 |
"(dropWhile P xs = []) = (\<forall>x \<in> set xs. P x)" |
|
2184 |
by(induct xs, auto) |
|
2185 |
||
2186 |
lemma dropWhile_eq_Cons_conv: |
|
2187 |
"(dropWhile P xs = y#ys) = (xs = takeWhile P xs @ y # ys & \<not> P y)" |
|
2188 |
by(induct xs, auto) |
|
2189 |
||
31077 | 2190 |
lemma distinct_takeWhile[simp]: "distinct xs ==> distinct (takeWhile P xs)" |
2191 |
by (induct xs) (auto dest: set_takeWhileD) |
|
2192 |
||
2193 |
lemma distinct_dropWhile[simp]: "distinct xs ==> distinct (dropWhile P xs)" |
|
2194 |
by (induct xs) auto |
|
2195 |
||
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
|
2196 |
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
|
2197 |
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
|
2198 |
|
603320b93668
New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents:
33593
diff
changeset
|
2199 |
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
|
2200 |
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
|
2201 |
|
603320b93668
New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents:
33593
diff
changeset
|
2202 |
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
|
2203 |
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
|
2204 |
|
603320b93668
New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents:
33593
diff
changeset
|
2205 |
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
|
2206 |
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
|
2207 |
|
603320b93668
New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents:
33593
diff
changeset
|
2208 |
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
|
2209 |
"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
|
2210 |
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
|
2211 |
|
603320b93668
New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents:
33593
diff
changeset
|
2212 |
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
|
2213 |
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
|
2214 |
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
|
2215 |
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
|
2216 |
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
|
2217 |
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
|
2218 |
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
|
2219 |
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
|
2220 |
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
|
2221 |
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
|
2222 |
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
|
2223 |
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
|
2224 |
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
|
2225 |
|
603320b93668
New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents:
33593
diff
changeset
|
2226 |
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
|
2227 |
"\<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
|
2228 |
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
|
2229 |
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
|
2230 |
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
|
2231 |
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
|
2232 |
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
|
2233 |
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
|
2234 |
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
|
2235 |
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
|
2236 |
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
|
2237 |
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
|
2238 |
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
|
2239 |
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
|
2240 |
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
|
2241 |
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
|
2242 |
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
|
2243 |
|
603320b93668
New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents:
33593
diff
changeset
|
2244 |
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
|
2245 |
"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
|
2246 |
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
|
2247 |
|
603320b93668
New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents:
33593
diff
changeset
|
2248 |
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
|
2249 |
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
|
2250 |
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
|
2251 |
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
|
2252 |
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
|
2253 |
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
|
2254 |
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
|
2255 |
qed |
31077 | 2256 |
|
17501 | 2257 |
text{* The following two lemmmas could be generalized to an arbitrary |
2258 |
property. *} |
|
2259 |
||
2260 |
lemma takeWhile_neq_rev: "\<lbrakk>distinct xs; x \<in> set xs\<rbrakk> \<Longrightarrow> |
|
2261 |
takeWhile (\<lambda>y. y \<noteq> x) (rev xs) = rev (tl (dropWhile (\<lambda>y. y \<noteq> x) xs))" |
|
2262 |
by(induct xs) (auto simp: takeWhile_tail[where l="[]"]) |
|
2263 |
||
2264 |
lemma dropWhile_neq_rev: "\<lbrakk>distinct xs; x \<in> set xs\<rbrakk> \<Longrightarrow> |
|
2265 |
dropWhile (\<lambda>y. y \<noteq> x) (rev xs) = x # rev (takeWhile (\<lambda>y. y \<noteq> x) xs)" |
|
2266 |
apply(induct xs) |
|
2267 |
apply simp |
|
2268 |
apply auto |
|
2269 |
apply(subst dropWhile_append2) |
|
2270 |
apply auto |
|
2271 |
done |
|
2272 |
||
18423 | 2273 |
lemma takeWhile_not_last: |
46500
0196966d6d2d
removing unnecessary premises in theorems of List theory
bulwahn
parents:
46448
diff
changeset
|
2274 |
"distinct xs \<Longrightarrow> takeWhile (\<lambda>y. y \<noteq> last xs) xs = butlast xs" |
18423 | 2275 |
apply(induct xs) |
2276 |
apply simp |
|
2277 |
apply(case_tac xs) |
|
2278 |
apply(auto) |
|
2279 |
done |
|
2280 |
||
44013
5cfc1c36ae97
moved recdef package to HOL/Library/Old_Recdef.thy
krauss
parents:
43594
diff
changeset
|
2281 |
lemma takeWhile_cong [fundef_cong]: |
18336
1a2e30b37ed3
Added recdef congruence rules for bounded quantifiers and commonly used
krauss
parents:
18049
diff
changeset
|
2282 |
"[| 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
|
2283 |
==> takeWhile P l = takeWhile Q k" |
24349 | 2284 |
by (induct k arbitrary: l) (simp_all) |
18336
1a2e30b37ed3
Added recdef congruence rules for bounded quantifiers and commonly used
krauss
parents:
18049
diff
changeset
|
2285 |
|
44013
5cfc1c36ae97
moved recdef package to HOL/Library/Old_Recdef.thy
krauss
parents:
43594
diff
changeset
|
2286 |
lemma dropWhile_cong [fundef_cong]: |
18336
1a2e30b37ed3
Added recdef congruence rules for bounded quantifiers and commonly used
krauss
parents:
18049
diff
changeset
|
2287 |
"[| 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
|
2288 |
==> dropWhile P l = dropWhile Q k" |
24349 | 2289 |
by (induct k arbitrary: l, simp_all) |
18336
1a2e30b37ed3
Added recdef congruence rules for bounded quantifiers and commonly used
krauss
parents:
18049
diff
changeset
|
2290 |
|
13114 | 2291 |
|
49948
744934b818c7
moved quite generic material from theory Enum to more appropriate places
haftmann
parents:
49808
diff
changeset
|
2292 |
subsubsection {* @{const zip} *} |
13114 | 2293 |
|
13142 | 2294 |
lemma zip_Nil [simp]: "zip [] ys = []" |
13145 | 2295 |
by (induct ys) auto |
13114 | 2296 |
|
13142 | 2297 |
lemma zip_Cons_Cons [simp]: "zip (x # xs) (y # ys) = (x, y) # zip xs ys" |
13145 | 2298 |
by simp |
13114 | 2299 |
|
13142 | 2300 |
declare zip_Cons [simp del] |
13114 | 2301 |
|
36198 | 2302 |
lemma [code]: |
2303 |
"zip [] ys = []" |
|
2304 |
"zip xs [] = []" |
|
2305 |
"zip (x # xs) (y # ys) = (x, y) # zip xs ys" |
|
2306 |
by (fact zip_Nil zip.simps(1) zip_Cons_Cons)+ |
|
2307 |
||
15281 | 2308 |
lemma zip_Cons1: |
2309 |
"zip (x#xs) ys = (case ys of [] \<Rightarrow> [] | y#ys \<Rightarrow> (x,y)#zip xs ys)" |
|
2310 |
by(auto split:list.split) |
|
2311 |
||
13142 | 2312 |
lemma length_zip [simp]: |
22493
db930e490fe5
added another rule for simultaneous induction, and lemmas for zip
krauss
parents:
22422
diff
changeset
|
2313 |
"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
|
2314 |
by (induct xs ys rule:list_induct2') auto |
13114 | 2315 |
|
34978
874150ddd50a
canonical insert operation; generalized lemma foldl_apply_inv to foldl_apply
haftmann
parents:
34942
diff
changeset
|
2316 |
lemma zip_obtain_same_length: |
874150ddd50a
canonical insert operation; generalized lemma foldl_apply_inv to foldl_apply
haftmann
parents:
34942
diff
changeset
|
2317 |
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
|
2318 |
\<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
|
2319 |
shows "P (zip xs ys)" |
874150ddd50a
canonical insert operation; generalized lemma foldl_apply_inv to foldl_apply
haftmann
parents:
34942
diff
changeset
|
2320 |
proof - |
874150ddd50a
canonical insert operation; generalized lemma foldl_apply_inv to foldl_apply
haftmann
parents:
34942
diff
changeset
|
2321 |
let ?n = "min (length xs) (length ys)" |
874150ddd50a
canonical insert operation; generalized lemma foldl_apply_inv to foldl_apply
haftmann
parents:
34942
diff
changeset
|
2322 |
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
|
2323 |
by (rule assms) simp_all |
874150ddd50a
canonical insert operation; generalized lemma foldl_apply_inv to foldl_apply
haftmann
parents:
34942
diff
changeset
|
2324 |
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
|
2325 |
proof (induct xs arbitrary: ys) |
874150ddd50a
canonical insert operation; generalized lemma foldl_apply_inv to foldl_apply
haftmann
parents:
34942
diff
changeset
|
2326 |
case Nil then show ?case by simp |
874150ddd50a
canonical insert operation; generalized lemma foldl_apply_inv to foldl_apply
haftmann
parents:
34942
diff
changeset
|
2327 |
next |
874150ddd50a
canonical insert operation; generalized lemma foldl_apply_inv to foldl_apply
haftmann
parents:
34942
diff
changeset
|
2328 |
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
|
2329 |
qed |
874150ddd50a
canonical insert operation; generalized lemma foldl_apply_inv to foldl_apply
haftmann
parents:
34942
diff
changeset
|
2330 |
ultimately show ?thesis by simp |
874150ddd50a
canonical insert operation; generalized lemma foldl_apply_inv to foldl_apply
haftmann
parents:
34942
diff
changeset
|
2331 |
qed |
874150ddd50a
canonical insert operation; generalized lemma foldl_apply_inv to foldl_apply
haftmann
parents:
34942
diff
changeset
|
2332 |
|
13114 | 2333 |
lemma zip_append1: |
22493
db930e490fe5
added another rule for simultaneous induction, and lemmas for zip
krauss
parents:
22422
diff
changeset
|
2334 |
"zip (xs @ ys) zs = |
13145 | 2335 |
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
|
2336 |
by (induct xs zs rule:list_induct2') auto |
13114 | 2337 |
|
2338 |
lemma zip_append2: |
|
22493
db930e490fe5
added another rule for simultaneous induction, and lemmas for zip
krauss
parents:
22422
diff
changeset
|
2339 |
"zip xs (ys @ zs) = |
13145 | 2340 |
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
|
2341 |
by (induct xs ys rule:list_induct2') auto |
13114 | 2342 |
|
13142 | 2343 |
lemma zip_append [simp]: |
46500
0196966d6d2d
removing unnecessary premises in theorems of List theory
bulwahn
parents:
46448
diff
changeset
|
2344 |
"[| length xs = length us |] ==> |
13145 | 2345 |
zip (xs@ys) (us@vs) = zip xs us @ zip ys vs" |
2346 |
by (simp add: zip_append1) |
|
13114 | 2347 |
|
2348 |
lemma zip_rev: |
|
14247 | 2349 |
"length xs = length ys ==> zip (rev xs) (rev ys) = rev (zip xs ys)" |
2350 |
by (induct rule:list_induct2, simp_all) |
|
13114 | 2351 |
|
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
|
2352 |
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
|
2353 |
"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
|
2354 |
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
|
2355 |
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
|
2356 |
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
|
2357 |
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
|
2358 |
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
|
2359 |
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
|
2360 |
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
|
2361 |
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
|
2362 |
|
603320b93668
New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents:
33593
diff
changeset
|
2363 |
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
|
2364 |
"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
|
2365 |
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
|
2366 |
|
603320b93668
New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents:
33593
diff
changeset
|
2367 |
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
|
2368 |
"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
|
2369 |
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
|
2370 |
|
23096 | 2371 |
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
|
2372 |
"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
|
2373 |
unfolding zip_map1 by auto |
23096 | 2374 |
|
2375 |
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
|
2376 |
"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
|
2377 |
unfolding zip_map2 by auto |
23096 | 2378 |
|
31080 | 2379 |
text{* Courtesy of Andreas Lochbihler: *} |
2380 |
lemma zip_same_conv_map: "zip xs xs = map (\<lambda>x. (x, x)) xs" |
|
2381 |
by(induct xs) auto |
|
2382 |
||
13142 | 2383 |
lemma nth_zip [simp]: |
24526 | 2384 |
"[| i < length xs; i < length ys|] ==> (zip xs ys)!i = (xs!i, ys!i)" |
2385 |
apply (induct ys arbitrary: i xs, simp) |
|
13145 | 2386 |
apply (case_tac xs) |
2387 |
apply (simp_all add: nth.simps split: nat.split) |
|
2388 |
done |
|
13114 | 2389 |
|
2390 |
lemma set_zip: |
|
13145 | 2391 |
"set (zip xs ys) = {(xs!i, ys!i) | i. i < min (length xs) (length ys)}" |
31080 | 2392 |
by(simp add: set_conv_nth cong: rev_conj_cong) |
13114 | 2393 |
|
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
|
2394 |
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
|
2395 |
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
|
2396 |
|
13114 | 2397 |
lemma zip_update: |
31080 | 2398 |
"zip (xs[i:=x]) (ys[i:=y]) = (zip xs ys)[i:=(x,y)]" |
2399 |
by(rule sym, simp add: update_zip) |
|
13114 | 2400 |
|
13142 | 2401 |
lemma zip_replicate [simp]: |
24526 | 2402 |
"zip (replicate i x) (replicate j y) = replicate (min i j) (x,y)" |
2403 |
apply (induct i arbitrary: j, auto) |
|
14208 | 2404 |
apply (case_tac j, auto) |
13145 | 2405 |
done |
13114 | 2406 |
|
19487 | 2407 |
lemma take_zip: |
24526 | 2408 |
"take n (zip xs ys) = zip (take n xs) (take n ys)" |
2409 |
apply (induct n arbitrary: xs ys) |
|
19487 | 2410 |
apply simp |
2411 |
apply (case_tac xs, simp) |
|
2412 |
apply (case_tac ys, simp_all) |
|
2413 |
done |
|
2414 |
||
2415 |
lemma drop_zip: |
|
24526 | 2416 |
"drop n (zip xs ys) = zip (drop n xs) (drop n ys)" |
2417 |
apply (induct n arbitrary: xs ys) |
|
19487 | 2418 |
apply simp |
2419 |
apply (case_tac xs, simp) |
|
2420 |
apply (case_tac ys, simp_all) |
|
2421 |
done |
|
2422 |
||
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
|
2423 |
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
|
2424 |
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
|
2425 |
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
|
2426 |
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
|
2427 |
|
603320b93668
New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents:
33593
diff
changeset
|
2428 |
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
|
2429 |
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
|
2430 |
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
|
2431 |
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
|
2432 |
|
22493
db930e490fe5
added another rule for simultaneous induction, and lemmas for zip
krauss
parents:
22422
diff
changeset
|
2433 |
lemma set_zip_leftD: |
db930e490fe5
added another rule for simultaneous induction, and lemmas for zip
krauss
parents:
22422
diff
changeset
|
2434 |
"(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
|
2435 |
by (induct xs ys rule:list_induct2') auto |
db930e490fe5
added another rule for simultaneous induction, and lemmas for zip
krauss
parents:
22422
diff
changeset
|
2436 |
|
db930e490fe5
added another rule for simultaneous induction, and lemmas for zip
krauss
parents:
22422
diff
changeset
|
2437 |
lemma set_zip_rightD: |
db930e490fe5
added another rule for simultaneous induction, and lemmas for zip
krauss
parents:
22422
diff
changeset
|
2438 |
"(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
|
2439 |
by (induct xs ys rule:list_induct2') auto |
13142 | 2440 |
|
23983 | 2441 |
lemma in_set_zipE: |
2442 |
"(x,y) : set(zip xs ys) \<Longrightarrow> (\<lbrakk> x : set xs; y : set ys \<rbrakk> \<Longrightarrow> R) \<Longrightarrow> R" |
|
2443 |
by(blast dest: set_zip_leftD set_zip_rightD) |
|
2444 |
||
29829 | 2445 |
lemma zip_map_fst_snd: |
2446 |
"zip (map fst zs) (map snd zs) = zs" |
|
2447 |
by (induct zs) simp_all |
|
2448 |
||
2449 |
lemma zip_eq_conv: |
|
2450 |
"length xs = length ys \<Longrightarrow> zip xs ys = zs \<longleftrightarrow> map fst zs = xs \<and> map snd zs = ys" |
|
2451 |
by (auto simp add: zip_map_fst_snd) |
|
2452 |
||
35115 | 2453 |
|
49948
744934b818c7
moved quite generic material from theory Enum to more appropriate places
haftmann
parents:
49808
diff
changeset
|
2454 |
subsubsection {* @{const list_all2} *} |
13114 | 2455 |
|
14316
91b897b9a2dc
added some [intro?] and [trans] for list_all2 lemmas
kleing
parents:
14302
diff
changeset
|
2456 |
lemma list_all2_lengthD [intro?]: |
91b897b9a2dc
added some [intro?] and [trans] for list_all2 lemmas
kleing
parents:
14302
diff
changeset
|
2457 |
"list_all2 P xs ys ==> length xs = length ys" |
24349 | 2458 |
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
|
2459 |
|
19787 | 2460 |
lemma list_all2_Nil [iff, code]: "list_all2 P [] ys = (ys = [])" |
24349 | 2461 |
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
|
2462 |
|
19787 | 2463 |
lemma list_all2_Nil2 [iff, code]: "list_all2 P xs [] = (xs = [])" |
24349 | 2464 |
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
|
2465 |
|
07eeb832f28d
introduced characters for code generator; some improved code lemmas for some list functions
haftmann
parents:
19585
diff
changeset
|
2466 |
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
|
2467 |
"list_all2 P (x # xs) (y # ys) = (P x y \<and> list_all2 P xs ys)" |
24349 | 2468 |
by (auto simp add: list_all2_def) |
13114 | 2469 |
|
2470 |
lemma list_all2_Cons1: |
|
13145 | 2471 |
"list_all2 P (x # xs) ys = (\<exists>z zs. ys = z # zs \<and> P x z \<and> list_all2 P xs zs)" |
2472 |
by (cases ys) auto |
|
13114 | 2473 |
|
2474 |
lemma list_all2_Cons2: |
|
13145 | 2475 |
"list_all2 P xs (y # ys) = (\<exists>z zs. xs = z # zs \<and> P z y \<and> list_all2 P zs ys)" |
2476 |
by (cases xs) auto |
|
13114 | 2477 |
|
45794 | 2478 |
lemma list_all2_induct |
2479 |
[consumes 1, case_names Nil Cons, induct set: list_all2]: |
|
2480 |
assumes P: "list_all2 P xs ys" |
|
2481 |
assumes Nil: "R [] []" |
|
47640 | 2482 |
assumes Cons: "\<And>x xs y ys. |
2483 |
\<lbrakk>P x y; list_all2 P xs ys; R xs ys\<rbrakk> \<Longrightarrow> R (x # xs) (y # ys)" |
|
45794 | 2484 |
shows "R xs ys" |
2485 |
using P |
|
2486 |
by (induct xs arbitrary: ys) (auto simp add: list_all2_Cons1 Nil Cons) |
|
2487 |
||
13142 | 2488 |
lemma list_all2_rev [iff]: |
13145 | 2489 |
"list_all2 P (rev xs) (rev ys) = list_all2 P xs ys" |
2490 |
by (simp add: list_all2_def zip_rev cong: conj_cong) |
|
13114 | 2491 |
|
13863 | 2492 |
lemma list_all2_rev1: |
2493 |
"list_all2 P (rev xs) ys = list_all2 P xs (rev ys)" |
|
2494 |
by (subst list_all2_rev [symmetric]) simp |
|
2495 |
||
13114 | 2496 |
lemma list_all2_append1: |
13145 | 2497 |
"list_all2 P (xs @ ys) zs = |
2498 |
(EX us vs. zs = us @ vs \<and> length us = length xs \<and> length vs = length ys \<and> |
|
2499 |
list_all2 P xs us \<and> list_all2 P ys vs)" |
|
2500 |
apply (simp add: list_all2_def zip_append1) |
|
2501 |
apply (rule iffI) |
|
2502 |
apply (rule_tac x = "take (length xs) zs" in exI) |
|
2503 |
apply (rule_tac x = "drop (length xs) zs" in exI) |
|
14208 | 2504 |
apply (force split: nat_diff_split simp add: min_def, clarify) |
13145 | 2505 |
apply (simp add: ball_Un) |
2506 |
done |
|
13114 | 2507 |
|
2508 |
lemma list_all2_append2: |
|
13145 | 2509 |
"list_all2 P xs (ys @ zs) = |
2510 |
(EX us vs. xs = us @ vs \<and> length us = length ys \<and> length vs = length zs \<and> |
|
2511 |
list_all2 P us ys \<and> list_all2 P vs zs)" |
|
2512 |
apply (simp add: list_all2_def zip_append2) |
|
2513 |
apply (rule iffI) |
|
2514 |
apply (rule_tac x = "take (length ys) xs" in exI) |
|
2515 |
apply (rule_tac x = "drop (length ys) xs" in exI) |
|
14208 | 2516 |
apply (force split: nat_diff_split simp add: min_def, clarify) |
13145 | 2517 |
apply (simp add: ball_Un) |
2518 |
done |
|
13114 | 2519 |
|
13863 | 2520 |
lemma list_all2_append: |
14247 | 2521 |
"length xs = length ys \<Longrightarrow> |
2522 |
list_all2 P (xs@us) (ys@vs) = (list_all2 P xs ys \<and> list_all2 P us vs)" |
|
2523 |
by (induct rule:list_induct2, simp_all) |
|
13863 | 2524 |
|
2525 |
lemma list_all2_appendI [intro?, trans]: |
|
2526 |
"\<lbrakk> list_all2 P a b; list_all2 P c d \<rbrakk> \<Longrightarrow> list_all2 P (a@c) (b@d)" |
|
24349 | 2527 |
by (simp add: list_all2_append list_all2_lengthD) |
13863 | 2528 |
|
13114 | 2529 |
lemma list_all2_conv_all_nth: |
13145 | 2530 |
"list_all2 P xs ys = |
2531 |
(length xs = length ys \<and> (\<forall>i < length xs. P (xs!i) (ys!i)))" |
|
2532 |
by (force simp add: list_all2_def set_zip) |
|
13114 | 2533 |
|
13883
0451e0fb3f22
Re-structured some proofs in order to get rid of rule_format attribute.
berghofe
parents:
13863
diff
changeset
|
2534 |
lemma list_all2_trans: |
0451e0fb3f22
Re-structured some proofs in order to get rid of rule_format attribute.
berghofe
parents:
13863
diff
changeset
|
2535 |
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
|
2536 |
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
|
2537 |
(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
|
2538 |
proof (induct as) |
0451e0fb3f22
Re-structured some proofs in order to get rid of rule_format attribute.
berghofe
parents:
13863
diff
changeset
|
2539 |
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
|
2540 |
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
|
2541 |
proof (induct bs) |
0451e0fb3f22
Re-structured some proofs in order to get rid of rule_format attribute.
berghofe
parents:
13863
diff
changeset
|
2542 |
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
|
2543 |
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
|
2544 |
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
|
2545 |
qed simp |
0451e0fb3f22
Re-structured some proofs in order to get rid of rule_format attribute.
berghofe
parents:
13863
diff
changeset
|
2546 |
qed simp |
0451e0fb3f22
Re-structured some proofs in order to get rid of rule_format attribute.
berghofe
parents:
13863
diff
changeset
|
2547 |
|
13863 | 2548 |
lemma list_all2_all_nthI [intro?]: |
2549 |
"length a = length b \<Longrightarrow> (\<And>n. n < length a \<Longrightarrow> P (a!n) (b!n)) \<Longrightarrow> list_all2 P a b" |
|
24349 | 2550 |
by (simp add: list_all2_conv_all_nth) |
13863 | 2551 |
|
14395 | 2552 |
lemma list_all2I: |
2553 |
"\<forall>x \<in> set (zip a b). split P x \<Longrightarrow> length a = length b \<Longrightarrow> list_all2 P a b" |
|
24349 | 2554 |
by (simp add: list_all2_def) |
14395 | 2555 |
|
14328 | 2556 |
lemma list_all2_nthD: |
13863 | 2557 |
"\<lbrakk> list_all2 P xs ys; p < size xs \<rbrakk> \<Longrightarrow> P (xs!p) (ys!p)" |
24349 | 2558 |
by (simp add: list_all2_conv_all_nth) |
13863 | 2559 |
|
14302 | 2560 |
lemma list_all2_nthD2: |
2561 |
"\<lbrakk>list_all2 P xs ys; p < size ys\<rbrakk> \<Longrightarrow> P (xs!p) (ys!p)" |
|
24349 | 2562 |
by (frule list_all2_lengthD) (auto intro: list_all2_nthD) |
14302 | 2563 |
|
13863 | 2564 |
lemma list_all2_map1: |
2565 |
"list_all2 P (map f as) bs = list_all2 (\<lambda>x y. P (f x) y) as bs" |
|
24349 | 2566 |
by (simp add: list_all2_conv_all_nth) |
13863 | 2567 |
|
2568 |
lemma list_all2_map2: |
|
2569 |
"list_all2 P as (map f bs) = list_all2 (\<lambda>x y. P x (f y)) as bs" |
|
24349 | 2570 |
by (auto simp add: list_all2_conv_all_nth) |
13863 | 2571 |
|
14316
91b897b9a2dc
added some [intro?] and [trans] for list_all2 lemmas
kleing
parents:
14302
diff
changeset
|
2572 |
lemma list_all2_refl [intro?]: |
13863 | 2573 |
"(\<And>x. P x x) \<Longrightarrow> list_all2 P xs xs" |
24349 | 2574 |
by (simp add: list_all2_conv_all_nth) |
13863 | 2575 |
|
2576 |
lemma list_all2_update_cong: |
|
46669
c1d2ab32174a
one general list_all2_update_cong instead of two special ones
bulwahn
parents:
46664
diff
changeset
|
2577 |
"\<lbrakk> list_all2 P xs ys; P x y \<rbrakk> \<Longrightarrow> list_all2 P (xs[i:=x]) (ys[i:=y])" |
c1d2ab32174a
one general list_all2_update_cong instead of two special ones
bulwahn
parents:
46664
diff
changeset
|
2578 |
by (cases "i < length ys") (auto simp add: list_all2_conv_all_nth nth_list_update) |
13863 | 2579 |
|
14302 | 2580 |
lemma list_all2_takeI [simp,intro?]: |
24526 | 2581 |
"list_all2 P xs ys \<Longrightarrow> list_all2 P (take n xs) (take n ys)" |
2582 |
apply (induct xs arbitrary: n ys) |
|
2583 |
apply simp |
|
2584 |
apply (clarsimp simp add: list_all2_Cons1) |
|
2585 |
apply (case_tac n) |
|
2586 |
apply auto |
|
2587 |
done |
|
14302 | 2588 |
|
2589 |
lemma list_all2_dropI [simp,intro?]: |
|
24526 | 2590 |
"list_all2 P as bs \<Longrightarrow> list_all2 P (drop n as) (drop n bs)" |
2591 |
apply (induct as arbitrary: n bs, simp) |
|
2592 |
apply (clarsimp simp add: list_all2_Cons1) |
|
2593 |
apply (case_tac n, simp, simp) |
|
2594 |
done |
|
13863 | 2595 |
|
14327 | 2596 |
lemma list_all2_mono [intro?]: |
24526 | 2597 |
"list_all2 P xs ys \<Longrightarrow> (\<And>xs ys. P xs ys \<Longrightarrow> Q xs ys) \<Longrightarrow> list_all2 Q xs ys" |
2598 |
apply (induct xs arbitrary: ys, simp) |
|
2599 |
apply (case_tac ys, auto) |
|
2600 |
done |
|
13863 | 2601 |
|
22551 | 2602 |
lemma list_all2_eq: |
2603 |
"xs = ys \<longleftrightarrow> list_all2 (op =) xs ys" |
|
24349 | 2604 |
by (induct xs ys rule: list_induct2') auto |
22551 | 2605 |
|
40230 | 2606 |
lemma list_eq_iff_zip_eq: |
2607 |
"xs = ys \<longleftrightarrow> length xs = length ys \<and> (\<forall>(x,y) \<in> set (zip xs ys). x = y)" |
|
2608 |
by(auto simp add: set_zip list_all2_eq list_all2_conv_all_nth cong: conj_cong) |
|
2609 |
||
13142 | 2610 |
|
49948
744934b818c7
moved quite generic material from theory Enum to more appropriate places
haftmann
parents:
49808
diff
changeset
|
2611 |
subsubsection {* @{const List.product} *} |
744934b818c7
moved quite generic material from theory Enum to more appropriate places
haftmann
parents:
49808
diff
changeset
|
2612 |
|
744934b818c7
moved quite generic material from theory Enum to more appropriate places
haftmann
parents:
49808
diff
changeset
|
2613 |
lemma product_list_set: |
744934b818c7
moved quite generic material from theory Enum to more appropriate places
haftmann
parents:
49808
diff
changeset
|
2614 |
"set (List.product xs ys) = set xs \<times> set ys" |
744934b818c7
moved quite generic material from theory Enum to more appropriate places
haftmann
parents:
49808
diff
changeset
|
2615 |
by (induct xs) auto |
744934b818c7
moved quite generic material from theory Enum to more appropriate places
haftmann
parents:
49808
diff
changeset
|
2616 |
|
744934b818c7
moved quite generic material from theory Enum to more appropriate places
haftmann
parents:
49808
diff
changeset
|
2617 |
|
47397
d654c73e4b12
no preference wrt. fold(l/r); prefer fold rather than foldr for iterating over lists in generated code
haftmann
parents:
47131
diff
changeset
|
2618 |
subsubsection {* @{const fold} with natural argument order *} |
46133
d9fe85d3d2cd
incorporated canonical fold combinator on lists into body of List theory; refactored passages on List.fold(l/r)
haftmann
parents:
46125
diff
changeset
|
2619 |
|
48828
441a4eed7823
prefer eta-expanded code equations for fold, to accomodate tail recursion optimisation in Scala
haftmann
parents:
48619
diff
changeset
|
2620 |
lemma fold_simps [code]: -- {* eta-expanded variant for generated code -- enables tail-recursion optimisation in Scala *} |
441a4eed7823
prefer eta-expanded code equations for fold, to accomodate tail recursion optimisation in Scala
haftmann
parents:
48619
diff
changeset
|
2621 |
"fold f [] s = s" |
441a4eed7823
prefer eta-expanded code equations for fold, to accomodate tail recursion optimisation in Scala
haftmann
parents:
48619
diff
changeset
|
2622 |
"fold f (x # xs) s = fold f xs (f x s)" |
441a4eed7823
prefer eta-expanded code equations for fold, to accomodate tail recursion optimisation in Scala
haftmann
parents:
48619
diff
changeset
|
2623 |
by simp_all |
441a4eed7823
prefer eta-expanded code equations for fold, to accomodate tail recursion optimisation in Scala
haftmann
parents:
48619
diff
changeset
|
2624 |
|
46133
d9fe85d3d2cd
incorporated canonical fold combinator on lists into body of List theory; refactored passages on List.fold(l/r)
haftmann
parents:
46125
diff
changeset
|
2625 |
lemma fold_remove1_split: |
d9fe85d3d2cd
incorporated canonical fold combinator on lists into body of List theory; refactored passages on List.fold(l/r)
haftmann
parents:
46125
diff
changeset
|
2626 |
assumes f: "\<And>x y. x \<in> set xs \<Longrightarrow> y \<in> set xs \<Longrightarrow> f x \<circ> f y = f y \<circ> f x" |
d9fe85d3d2cd
incorporated canonical fold combinator on lists into body of List theory; refactored passages on List.fold(l/r)
haftmann
parents:
46125
diff
changeset
|
2627 |
and x: "x \<in> set xs" |
d9fe85d3d2cd
incorporated canonical fold combinator on lists into body of List theory; refactored passages on List.fold(l/r)
haftmann
parents:
46125
diff
changeset
|
2628 |
shows "fold f xs = fold f (remove1 x xs) \<circ> f x" |
49739 | 2629 |
using assms by (induct xs) (auto simp add: comp_assoc) |
46133
d9fe85d3d2cd
incorporated canonical fold combinator on lists into body of List theory; refactored passages on List.fold(l/r)
haftmann
parents:
46125
diff
changeset
|
2630 |
|
d9fe85d3d2cd
incorporated canonical fold combinator on lists into body of List theory; refactored passages on List.fold(l/r)
haftmann
parents:
46125
diff
changeset
|
2631 |
lemma fold_cong [fundef_cong]: |
d9fe85d3d2cd
incorporated canonical fold combinator on lists into body of List theory; refactored passages on List.fold(l/r)
haftmann
parents:
46125
diff
changeset
|
2632 |
"a = b \<Longrightarrow> xs = ys \<Longrightarrow> (\<And>x. x \<in> set xs \<Longrightarrow> f x = g x) |
d9fe85d3d2cd
incorporated canonical fold combinator on lists into body of List theory; refactored passages on List.fold(l/r)
haftmann
parents:
46125
diff
changeset
|
2633 |
\<Longrightarrow> fold f xs a = fold g ys b" |
d9fe85d3d2cd
incorporated canonical fold combinator on lists into body of List theory; refactored passages on List.fold(l/r)
haftmann
parents:
46125
diff
changeset
|
2634 |
by (induct ys arbitrary: a b xs) simp_all |
d9fe85d3d2cd
incorporated canonical fold combinator on lists into body of List theory; refactored passages on List.fold(l/r)
haftmann
parents:
46125
diff
changeset
|
2635 |
|
d9fe85d3d2cd
incorporated canonical fold combinator on lists into body of List theory; refactored passages on List.fold(l/r)
haftmann
parents:
46125
diff
changeset
|
2636 |
lemma fold_id: |
d9fe85d3d2cd
incorporated canonical fold combinator on lists into body of List theory; refactored passages on List.fold(l/r)
haftmann
parents:
46125
diff
changeset
|
2637 |
assumes "\<And>x. x \<in> set xs \<Longrightarrow> f x = id" |
d9fe85d3d2cd
incorporated canonical fold combinator on lists into body of List theory; refactored passages on List.fold(l/r)
haftmann
parents:
46125
diff
changeset
|
2638 |
shows "fold f xs = id" |
d9fe85d3d2cd
incorporated canonical fold combinator on lists into body of List theory; refactored passages on List.fold(l/r)
haftmann
parents:
46125
diff
changeset
|
2639 |
using assms by (induct xs) simp_all |
d9fe85d3d2cd
incorporated canonical fold combinator on lists into body of List theory; refactored passages on List.fold(l/r)
haftmann
parents:
46125
diff
changeset
|
2640 |
|
d9fe85d3d2cd
incorporated canonical fold combinator on lists into body of List theory; refactored passages on List.fold(l/r)
haftmann
parents:
46125
diff
changeset
|
2641 |
lemma fold_commute: |
d9fe85d3d2cd
incorporated canonical fold combinator on lists into body of List theory; refactored passages on List.fold(l/r)
haftmann
parents:
46125
diff
changeset
|
2642 |
assumes "\<And>x. x \<in> set xs \<Longrightarrow> h \<circ> g x = f x \<circ> h" |
d9fe85d3d2cd
incorporated canonical fold combinator on lists into body of List theory; refactored passages on List.fold(l/r)
haftmann
parents:
46125
diff
changeset
|
2643 |
shows "h \<circ> fold g xs = fold f xs \<circ> h" |
d9fe85d3d2cd
incorporated canonical fold combinator on lists into body of List theory; refactored passages on List.fold(l/r)
haftmann
parents:
46125
diff
changeset
|
2644 |
using assms by (induct xs) (simp_all add: fun_eq_iff) |
d9fe85d3d2cd
incorporated canonical fold combinator on lists into body of List theory; refactored passages on List.fold(l/r)
haftmann
parents:
46125
diff
changeset
|
2645 |
|
d9fe85d3d2cd
incorporated canonical fold combinator on lists into body of List theory; refactored passages on List.fold(l/r)
haftmann
parents:
46125
diff
changeset
|
2646 |
lemma fold_commute_apply: |
d9fe85d3d2cd
incorporated canonical fold combinator on lists into body of List theory; refactored passages on List.fold(l/r)
haftmann
parents:
46125
diff
changeset
|
2647 |
assumes "\<And>x. x \<in> set xs \<Longrightarrow> h \<circ> g x = f x \<circ> h" |
d9fe85d3d2cd
incorporated canonical fold combinator on lists into body of List theory; refactored passages on List.fold(l/r)
haftmann
parents:
46125
diff
changeset
|
2648 |
shows "h (fold g xs s) = fold f xs (h s)" |
d9fe85d3d2cd
incorporated canonical fold combinator on lists into body of List theory; refactored passages on List.fold(l/r)
haftmann
parents:
46125
diff
changeset
|
2649 |
proof - |
d9fe85d3d2cd
incorporated canonical fold combinator on lists into body of List theory; refactored passages on List.fold(l/r)
haftmann
parents:
46125
diff
changeset
|
2650 |
from assms have "h \<circ> fold g xs = fold f xs \<circ> h" by (rule fold_commute) |
d9fe85d3d2cd
incorporated canonical fold combinator on lists into body of List theory; refactored passages on List.fold(l/r)
haftmann
parents:
46125
diff
changeset
|
2651 |
then show ?thesis by (simp add: fun_eq_iff) |
37605
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
2652 |
qed |
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
2653 |
|
46133
d9fe85d3d2cd
incorporated canonical fold combinator on lists into body of List theory; refactored passages on List.fold(l/r)
haftmann
parents:
46125
diff
changeset
|
2654 |
lemma fold_invariant: |
d9fe85d3d2cd
incorporated canonical fold combinator on lists into body of List theory; refactored passages on List.fold(l/r)
haftmann
parents:
46125
diff
changeset
|
2655 |
assumes "\<And>x. x \<in> set xs \<Longrightarrow> Q x" and "P s" |
d9fe85d3d2cd
incorporated canonical fold combinator on lists into body of List theory; refactored passages on List.fold(l/r)
haftmann
parents:
46125
diff
changeset
|
2656 |
and "\<And>x s. Q x \<Longrightarrow> P s \<Longrightarrow> P (f x s)" |
d9fe85d3d2cd
incorporated canonical fold combinator on lists into body of List theory; refactored passages on List.fold(l/r)
haftmann
parents:
46125
diff
changeset
|
2657 |
shows "P (fold f xs s)" |
34978
874150ddd50a
canonical insert operation; generalized lemma foldl_apply_inv to foldl_apply
haftmann
parents:
34942
diff
changeset
|
2658 |
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
|
2659 |
|
46133
d9fe85d3d2cd
incorporated canonical fold combinator on lists into body of List theory; refactored passages on List.fold(l/r)
haftmann
parents:
46125
diff
changeset
|
2660 |
lemma fold_append [simp]: |
d9fe85d3d2cd
incorporated canonical fold combinator on lists into body of List theory; refactored passages on List.fold(l/r)
haftmann
parents:
46125
diff
changeset
|
2661 |
"fold f (xs @ ys) = fold f ys \<circ> fold f xs" |
d9fe85d3d2cd
incorporated canonical fold combinator on lists into body of List theory; refactored passages on List.fold(l/r)
haftmann
parents:
46125
diff
changeset
|
2662 |
by (induct xs) simp_all |
d9fe85d3d2cd
incorporated canonical fold combinator on lists into body of List theory; refactored passages on List.fold(l/r)
haftmann
parents:
46125
diff
changeset
|
2663 |
|
d9fe85d3d2cd
incorporated canonical fold combinator on lists into body of List theory; refactored passages on List.fold(l/r)
haftmann
parents:
46125
diff
changeset
|
2664 |
lemma fold_map [code_unfold]: |
d9fe85d3d2cd
incorporated canonical fold combinator on lists into body of List theory; refactored passages on List.fold(l/r)
haftmann
parents:
46125
diff
changeset
|
2665 |
"fold g (map f xs) = fold (g o f) xs" |
d9fe85d3d2cd
incorporated canonical fold combinator on lists into body of List theory; refactored passages on List.fold(l/r)
haftmann
parents:
46125
diff
changeset
|
2666 |
by (induct xs) simp_all |
d9fe85d3d2cd
incorporated canonical fold combinator on lists into body of List theory; refactored passages on List.fold(l/r)
haftmann
parents:
46125
diff
changeset
|
2667 |
|
d9fe85d3d2cd
incorporated canonical fold combinator on lists into body of List theory; refactored passages on List.fold(l/r)
haftmann
parents:
46125
diff
changeset
|
2668 |
lemma fold_rev: |
d9fe85d3d2cd
incorporated canonical fold combinator on lists into body of List theory; refactored passages on List.fold(l/r)
haftmann
parents:
46125
diff
changeset
|
2669 |
assumes "\<And>x y. x \<in> set xs \<Longrightarrow> y \<in> set xs \<Longrightarrow> f y \<circ> f x = f x \<circ> f y" |
d9fe85d3d2cd
incorporated canonical fold combinator on lists into body of List theory; refactored passages on List.fold(l/r)
haftmann
parents:
46125
diff
changeset
|
2670 |
shows "fold f (rev xs) = fold f xs" |
d9fe85d3d2cd
incorporated canonical fold combinator on lists into body of List theory; refactored passages on List.fold(l/r)
haftmann
parents:
46125
diff
changeset
|
2671 |
using assms by (induct xs) (simp_all add: fold_commute_apply fun_eq_iff) |
d9fe85d3d2cd
incorporated canonical fold combinator on lists into body of List theory; refactored passages on List.fold(l/r)
haftmann
parents:
46125
diff
changeset
|
2672 |
|
d9fe85d3d2cd
incorporated canonical fold combinator on lists into body of List theory; refactored passages on List.fold(l/r)
haftmann
parents:
46125
diff
changeset
|
2673 |
lemma fold_Cons_rev: |
d9fe85d3d2cd
incorporated canonical fold combinator on lists into body of List theory; refactored passages on List.fold(l/r)
haftmann
parents:
46125
diff
changeset
|
2674 |
"fold Cons xs = append (rev xs)" |
d9fe85d3d2cd
incorporated canonical fold combinator on lists into body of List theory; refactored passages on List.fold(l/r)
haftmann
parents:
46125
diff
changeset
|
2675 |
by (induct xs) simp_all |
d9fe85d3d2cd
incorporated canonical fold combinator on lists into body of List theory; refactored passages on List.fold(l/r)
haftmann
parents:
46125
diff
changeset
|
2676 |
|
d9fe85d3d2cd
incorporated canonical fold combinator on lists into body of List theory; refactored passages on List.fold(l/r)
haftmann
parents:
46125
diff
changeset
|
2677 |
lemma rev_conv_fold [code]: |
d9fe85d3d2cd
incorporated canonical fold combinator on lists into body of List theory; refactored passages on List.fold(l/r)
haftmann
parents:
46125
diff
changeset
|
2678 |
"rev xs = fold Cons xs []" |
d9fe85d3d2cd
incorporated canonical fold combinator on lists into body of List theory; refactored passages on List.fold(l/r)
haftmann
parents:
46125
diff
changeset
|
2679 |
by (simp add: fold_Cons_rev) |
d9fe85d3d2cd
incorporated canonical fold combinator on lists into body of List theory; refactored passages on List.fold(l/r)
haftmann
parents:
46125
diff
changeset
|
2680 |
|
d9fe85d3d2cd
incorporated canonical fold combinator on lists into body of List theory; refactored passages on List.fold(l/r)
haftmann
parents:
46125
diff
changeset
|
2681 |
lemma fold_append_concat_rev: |
d9fe85d3d2cd
incorporated canonical fold combinator on lists into body of List theory; refactored passages on List.fold(l/r)
haftmann
parents:
46125
diff
changeset
|
2682 |
"fold append xss = append (concat (rev xss))" |
d9fe85d3d2cd
incorporated canonical fold combinator on lists into body of List theory; refactored passages on List.fold(l/r)
haftmann
parents:
46125
diff
changeset
|
2683 |
by (induct xss) simp_all |
d9fe85d3d2cd
incorporated canonical fold combinator on lists into body of List theory; refactored passages on List.fold(l/r)
haftmann
parents:
46125
diff
changeset
|
2684 |
|
d9fe85d3d2cd
incorporated canonical fold combinator on lists into body of List theory; refactored passages on List.fold(l/r)
haftmann
parents:
46125
diff
changeset
|
2685 |
text {* @{const Finite_Set.fold} and @{const fold} *} |
d9fe85d3d2cd
incorporated canonical fold combinator on lists into body of List theory; refactored passages on List.fold(l/r)
haftmann
parents:
46125
diff
changeset
|
2686 |
|
d9fe85d3d2cd
incorporated canonical fold combinator on lists into body of List theory; refactored passages on List.fold(l/r)
haftmann
parents:
46125
diff
changeset
|
2687 |
lemma (in comp_fun_commute) fold_set_fold_remdups: |
d9fe85d3d2cd
incorporated canonical fold combinator on lists into body of List theory; refactored passages on List.fold(l/r)
haftmann
parents:
46125
diff
changeset
|
2688 |
"Finite_Set.fold f y (set xs) = fold f (remdups xs) y" |
35195 | 2689 |
by (rule sym, induct xs arbitrary: y) (simp_all add: fold_fun_comm insert_absorb) |
2690 |
||
48619 | 2691 |
lemma (in ab_semigroup_mult) fold1_distinct_set_fold: |
2692 |
assumes "xs \<noteq> []" |
|
2693 |
assumes d: "distinct xs" |
|
2694 |
shows "Finite_Set.fold1 times (set xs) = List.fold times (tl xs) (hd xs)" |
|
2695 |
proof - |
|
2696 |
interpret comp_fun_commute times by (fact comp_fun_commute) |
|
2697 |
from assms obtain y ys where xs: "xs = y # ys" |
|
2698 |
by (cases xs) auto |
|
2699 |
then have *: "y \<notin> set ys" using assms by simp |
|
2700 |
from xs d have **: "remdups ys = ys" by safe (induct ys, auto) |
|
2701 |
show ?thesis |
|
2702 |
proof (cases "set ys = {}") |
|
2703 |
case True with xs show ?thesis by simp |
|
2704 |
next |
|
2705 |
case False |
|
2706 |
then have "fold1 times (Set.insert y (set ys)) = Finite_Set.fold times y (set ys)" |
|
2707 |
by (simp_all add: fold1_eq_fold *) |
|
2708 |
with xs show ?thesis |
|
2709 |
by (simp add: fold_set_fold_remdups **) |
|
2710 |
qed |
|
2711 |
qed |
|
2712 |
||
46133
d9fe85d3d2cd
incorporated canonical fold combinator on lists into body of List theory; refactored passages on List.fold(l/r)
haftmann
parents:
46125
diff
changeset
|
2713 |
lemma (in comp_fun_idem) fold_set_fold: |
d9fe85d3d2cd
incorporated canonical fold combinator on lists into body of List theory; refactored passages on List.fold(l/r)
haftmann
parents:
46125
diff
changeset
|
2714 |
"Finite_Set.fold f y (set xs) = fold f xs y" |
31455 | 2715 |
by (rule sym, induct xs arbitrary: y) (simp_all add: fold_fun_comm) |
2716 |
||
46133
d9fe85d3d2cd
incorporated canonical fold combinator on lists into body of List theory; refactored passages on List.fold(l/r)
haftmann
parents:
46125
diff
changeset
|
2717 |
lemma (in ab_semigroup_idem_mult) fold1_set_fold: |
32681
adeac3cbb659
lemma relating fold1 and foldl; code_unfold rules for Inf_fin, Sup_fin, Min, Max, Inf, Sup
haftmann
parents:
32422
diff
changeset
|
2718 |
assumes "xs \<noteq> []" |
46133
d9fe85d3d2cd
incorporated canonical fold combinator on lists into body of List theory; refactored passages on List.fold(l/r)
haftmann
parents:
46125
diff
changeset
|
2719 |
shows "Finite_Set.fold1 times (set xs) = fold times (tl xs) (hd xs)" |
32681
adeac3cbb659
lemma relating fold1 and foldl; code_unfold rules for Inf_fin, Sup_fin, Min, Max, Inf, Sup
haftmann
parents:
32422
diff
changeset
|
2720 |
proof - |
42871
1c0b99f950d9
names of fold_set locales resemble name of characteristic property more closely
haftmann
parents:
42809
diff
changeset
|
2721 |
interpret comp_fun_idem times by (fact comp_fun_idem) |
32681
adeac3cbb659
lemma relating fold1 and foldl; code_unfold rules for Inf_fin, Sup_fin, Min, Max, Inf, Sup
haftmann
parents:
32422
diff
changeset
|
2722 |
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
|
2723 |
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
|
2724 |
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
|
2725 |
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
|
2726 |
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
|
2727 |
next |
adeac3cbb659
lemma relating fold1 and foldl; code_unfold rules for Inf_fin, Sup_fin, Min, Max, Inf, Sup
haftmann
parents:
32422
diff
changeset
|
2728 |
case False |
46034 | 2729 |
then have "fold1 times (insert y (set ys)) = Finite_Set.fold times y (set ys)" |
32681
adeac3cbb659
lemma relating fold1 and foldl; code_unfold rules for Inf_fin, Sup_fin, Min, Max, Inf, Sup
haftmann
parents:
32422
diff
changeset
|
2730 |
by (simp only: finite_set fold1_eq_fold_idem) |
46133
d9fe85d3d2cd
incorporated canonical fold combinator on lists into body of List theory; refactored passages on List.fold(l/r)
haftmann
parents:
46125
diff
changeset
|
2731 |
with xs show ?thesis by (simp add: fold_set_fold mult_commute) |
32681
adeac3cbb659
lemma relating fold1 and foldl; code_unfold rules for Inf_fin, Sup_fin, Min, Max, Inf, Sup
haftmann
parents:
32422
diff
changeset
|
2732 |
qed |
adeac3cbb659
lemma relating fold1 and foldl; code_unfold rules for Inf_fin, Sup_fin, Min, Max, Inf, Sup
haftmann
parents:
32422
diff
changeset
|
2733 |
qed |
adeac3cbb659
lemma relating fold1 and foldl; code_unfold rules for Inf_fin, Sup_fin, Min, Max, Inf, Sup
haftmann
parents:
32422
diff
changeset
|
2734 |
|
47397
d654c73e4b12
no preference wrt. fold(l/r); prefer fold rather than foldr for iterating over lists in generated code
haftmann
parents:
47131
diff
changeset
|
2735 |
lemma union_set_fold [code]: |
46147
2c4d8de91c4c
moved lemmas about List.set and set operations to List theory
haftmann
parents:
46143
diff
changeset
|
2736 |
"set xs \<union> A = fold Set.insert xs A" |
2c4d8de91c4c
moved lemmas about List.set and set operations to List theory
haftmann
parents:
46143
diff
changeset
|
2737 |
proof - |
2c4d8de91c4c
moved lemmas about List.set and set operations to List theory
haftmann
parents:
46143
diff
changeset
|
2738 |
interpret comp_fun_idem Set.insert |
2c4d8de91c4c
moved lemmas about List.set and set operations to List theory
haftmann
parents:
46143
diff
changeset
|
2739 |
by (fact comp_fun_idem_insert) |
2c4d8de91c4c
moved lemmas about List.set and set operations to List theory
haftmann
parents:
46143
diff
changeset
|
2740 |
show ?thesis by (simp add: union_fold_insert fold_set_fold) |
2c4d8de91c4c
moved lemmas about List.set and set operations to List theory
haftmann
parents:
46143
diff
changeset
|
2741 |
qed |
2c4d8de91c4c
moved lemmas about List.set and set operations to List theory
haftmann
parents:
46143
diff
changeset
|
2742 |
|
47397
d654c73e4b12
no preference wrt. fold(l/r); prefer fold rather than foldr for iterating over lists in generated code
haftmann
parents:
47131
diff
changeset
|
2743 |
lemma union_coset_filter [code]: |
d654c73e4b12
no preference wrt. fold(l/r); prefer fold rather than foldr for iterating over lists in generated code
haftmann
parents:
47131
diff
changeset
|
2744 |
"List.coset xs \<union> A = List.coset (List.filter (\<lambda>x. x \<notin> A) xs)" |
d654c73e4b12
no preference wrt. fold(l/r); prefer fold rather than foldr for iterating over lists in generated code
haftmann
parents:
47131
diff
changeset
|
2745 |
by auto |
d654c73e4b12
no preference wrt. fold(l/r); prefer fold rather than foldr for iterating over lists in generated code
haftmann
parents:
47131
diff
changeset
|
2746 |
|
d654c73e4b12
no preference wrt. fold(l/r); prefer fold rather than foldr for iterating over lists in generated code
haftmann
parents:
47131
diff
changeset
|
2747 |
lemma minus_set_fold [code]: |
46147
2c4d8de91c4c
moved lemmas about List.set and set operations to List theory
haftmann
parents:
46143
diff
changeset
|
2748 |
"A - set xs = fold Set.remove xs A" |
2c4d8de91c4c
moved lemmas about List.set and set operations to List theory
haftmann
parents:
46143
diff
changeset
|
2749 |
proof - |
2c4d8de91c4c
moved lemmas about List.set and set operations to List theory
haftmann
parents:
46143
diff
changeset
|
2750 |
interpret comp_fun_idem Set.remove |
2c4d8de91c4c
moved lemmas about List.set and set operations to List theory
haftmann
parents:
46143
diff
changeset
|
2751 |
by (fact comp_fun_idem_remove) |
2c4d8de91c4c
moved lemmas about List.set and set operations to List theory
haftmann
parents:
46143
diff
changeset
|
2752 |
show ?thesis |
2c4d8de91c4c
moved lemmas about List.set and set operations to List theory
haftmann
parents:
46143
diff
changeset
|
2753 |
by (simp add: minus_fold_remove [of _ A] fold_set_fold) |
2c4d8de91c4c
moved lemmas about List.set and set operations to List theory
haftmann
parents:
46143
diff
changeset
|
2754 |
qed |
2c4d8de91c4c
moved lemmas about List.set and set operations to List theory
haftmann
parents:
46143
diff
changeset
|
2755 |
|
47397
d654c73e4b12
no preference wrt. fold(l/r); prefer fold rather than foldr for iterating over lists in generated code
haftmann
parents:
47131
diff
changeset
|
2756 |
lemma minus_coset_filter [code]: |
d654c73e4b12
no preference wrt. fold(l/r); prefer fold rather than foldr for iterating over lists in generated code
haftmann
parents:
47131
diff
changeset
|
2757 |
"A - List.coset xs = set (List.filter (\<lambda>x. x \<in> A) xs)" |
d654c73e4b12
no preference wrt. fold(l/r); prefer fold rather than foldr for iterating over lists in generated code
haftmann
parents:
47131
diff
changeset
|
2758 |
by auto |
d654c73e4b12
no preference wrt. fold(l/r); prefer fold rather than foldr for iterating over lists in generated code
haftmann
parents:
47131
diff
changeset
|
2759 |
|
d654c73e4b12
no preference wrt. fold(l/r); prefer fold rather than foldr for iterating over lists in generated code
haftmann
parents:
47131
diff
changeset
|
2760 |
lemma inter_set_filter [code]: |
d654c73e4b12
no preference wrt. fold(l/r); prefer fold rather than foldr for iterating over lists in generated code
haftmann
parents:
47131
diff
changeset
|
2761 |
"A \<inter> set xs = set (List.filter (\<lambda>x. x \<in> A) xs)" |
d654c73e4b12
no preference wrt. fold(l/r); prefer fold rather than foldr for iterating over lists in generated code
haftmann
parents:
47131
diff
changeset
|
2762 |
by auto |
d654c73e4b12
no preference wrt. fold(l/r); prefer fold rather than foldr for iterating over lists in generated code
haftmann
parents:
47131
diff
changeset
|
2763 |
|
d654c73e4b12
no preference wrt. fold(l/r); prefer fold rather than foldr for iterating over lists in generated code
haftmann
parents:
47131
diff
changeset
|
2764 |
lemma inter_coset_fold [code]: |
d654c73e4b12
no preference wrt. fold(l/r); prefer fold rather than foldr for iterating over lists in generated code
haftmann
parents:
47131
diff
changeset
|
2765 |
"A \<inter> List.coset xs = fold Set.remove xs A" |
d654c73e4b12
no preference wrt. fold(l/r); prefer fold rather than foldr for iterating over lists in generated code
haftmann
parents:
47131
diff
changeset
|
2766 |
by (simp add: Diff_eq [symmetric] minus_set_fold) |
d654c73e4b12
no preference wrt. fold(l/r); prefer fold rather than foldr for iterating over lists in generated code
haftmann
parents:
47131
diff
changeset
|
2767 |
|
46133
d9fe85d3d2cd
incorporated canonical fold combinator on lists into body of List theory; refactored passages on List.fold(l/r)
haftmann
parents:
46125
diff
changeset
|
2768 |
lemma (in lattice) Inf_fin_set_fold: |
d9fe85d3d2cd
incorporated canonical fold combinator on lists into body of List theory; refactored passages on List.fold(l/r)
haftmann
parents:
46125
diff
changeset
|
2769 |
"Inf_fin (set (x # xs)) = fold inf xs x" |
d9fe85d3d2cd
incorporated canonical fold combinator on lists into body of List theory; refactored passages on List.fold(l/r)
haftmann
parents:
46125
diff
changeset
|
2770 |
proof - |
d9fe85d3d2cd
incorporated canonical fold combinator on lists into body of List theory; refactored passages on List.fold(l/r)
haftmann
parents:
46125
diff
changeset
|
2771 |
interpret ab_semigroup_idem_mult "inf :: 'a \<Rightarrow> 'a \<Rightarrow> 'a" |
d9fe85d3d2cd
incorporated canonical fold combinator on lists into body of List theory; refactored passages on List.fold(l/r)
haftmann
parents:
46125
diff
changeset
|
2772 |
by (fact ab_semigroup_idem_mult_inf) |
d9fe85d3d2cd
incorporated canonical fold combinator on lists into body of List theory; refactored passages on List.fold(l/r)
haftmann
parents:
46125
diff
changeset
|
2773 |
show ?thesis |
d9fe85d3d2cd
incorporated canonical fold combinator on lists into body of List theory; refactored passages on List.fold(l/r)
haftmann
parents:
46125
diff
changeset
|
2774 |
by (simp add: Inf_fin_def fold1_set_fold del: set.simps) |
d9fe85d3d2cd
incorporated canonical fold combinator on lists into body of List theory; refactored passages on List.fold(l/r)
haftmann
parents:
46125
diff
changeset
|
2775 |
qed |
d9fe85d3d2cd
incorporated canonical fold combinator on lists into body of List theory; refactored passages on List.fold(l/r)
haftmann
parents:
46125
diff
changeset
|
2776 |
|
47397
d654c73e4b12
no preference wrt. fold(l/r); prefer fold rather than foldr for iterating over lists in generated code
haftmann
parents:
47131
diff
changeset
|
2777 |
declare Inf_fin_set_fold [code] |
d654c73e4b12
no preference wrt. fold(l/r); prefer fold rather than foldr for iterating over lists in generated code
haftmann
parents:
47131
diff
changeset
|
2778 |
|
46133
d9fe85d3d2cd
incorporated canonical fold combinator on lists into body of List theory; refactored passages on List.fold(l/r)
haftmann
parents:
46125
diff
changeset
|
2779 |
lemma (in lattice) Sup_fin_set_fold: |
d9fe85d3d2cd
incorporated canonical fold combinator on lists into body of List theory; refactored passages on List.fold(l/r)
haftmann
parents:
46125
diff
changeset
|
2780 |
"Sup_fin (set (x # xs)) = fold sup xs x" |
d9fe85d3d2cd
incorporated canonical fold combinator on lists into body of List theory; refactored passages on List.fold(l/r)
haftmann
parents:
46125
diff
changeset
|
2781 |
proof - |
d9fe85d3d2cd
incorporated canonical fold combinator on lists into body of List theory; refactored passages on List.fold(l/r)
haftmann
parents:
46125
diff
changeset
|
2782 |
interpret ab_semigroup_idem_mult "sup :: 'a \<Rightarrow> 'a \<Rightarrow> 'a" |
d9fe85d3d2cd
incorporated canonical fold combinator on lists into body of List theory; refactored passages on List.fold(l/r)
haftmann
parents:
46125
diff
changeset
|
2783 |
by (fact ab_semigroup_idem_mult_sup) |
d9fe85d3d2cd
incorporated canonical fold combinator on lists into body of List theory; refactored passages on List.fold(l/r)
haftmann
parents:
46125
diff
changeset
|
2784 |
show ?thesis |
d9fe85d3d2cd
incorporated canonical fold combinator on lists into body of List theory; refactored passages on List.fold(l/r)
haftmann
parents:
46125
diff
changeset
|
2785 |
by (simp add: Sup_fin_def fold1_set_fold del: set.simps) |
d9fe85d3d2cd
incorporated canonical fold combinator on lists into body of List theory; refactored passages on List.fold(l/r)
haftmann
parents:
46125
diff
changeset
|
2786 |
qed |
d9fe85d3d2cd
incorporated canonical fold combinator on lists into body of List theory; refactored passages on List.fold(l/r)
haftmann
parents:
46125
diff
changeset
|
2787 |
|
47397
d654c73e4b12
no preference wrt. fold(l/r); prefer fold rather than foldr for iterating over lists in generated code
haftmann
parents:
47131
diff
changeset
|
2788 |
declare Sup_fin_set_fold [code] |
d654c73e4b12
no preference wrt. fold(l/r); prefer fold rather than foldr for iterating over lists in generated code
haftmann
parents:
47131
diff
changeset
|
2789 |
|
46133
d9fe85d3d2cd
incorporated canonical fold combinator on lists into body of List theory; refactored passages on List.fold(l/r)
haftmann
parents:
46125
diff
changeset
|
2790 |
lemma (in linorder) Min_fin_set_fold: |
d9fe85d3d2cd
incorporated canonical fold combinator on lists into body of List theory; refactored passages on List.fold(l/r)
haftmann
parents:
46125
diff
changeset
|
2791 |
"Min (set (x # xs)) = fold min xs x" |
d9fe85d3d2cd
incorporated canonical fold combinator on lists into body of List theory; refactored passages on List.fold(l/r)
haftmann
parents:
46125
diff
changeset
|
2792 |
proof - |
d9fe85d3d2cd
incorporated canonical fold combinator on lists into body of List theory; refactored passages on List.fold(l/r)
haftmann
parents:
46125
diff
changeset
|
2793 |
interpret ab_semigroup_idem_mult "min :: 'a \<Rightarrow> 'a \<Rightarrow> 'a" |
d9fe85d3d2cd
incorporated canonical fold combinator on lists into body of List theory; refactored passages on List.fold(l/r)
haftmann
parents:
46125
diff
changeset
|
2794 |
by (fact ab_semigroup_idem_mult_min) |
d9fe85d3d2cd
incorporated canonical fold combinator on lists into body of List theory; refactored passages on List.fold(l/r)
haftmann
parents:
46125
diff
changeset
|
2795 |
show ?thesis |
d9fe85d3d2cd
incorporated canonical fold combinator on lists into body of List theory; refactored passages on List.fold(l/r)
haftmann
parents:
46125
diff
changeset
|
2796 |
by (simp add: Min_def fold1_set_fold del: set.simps) |
d9fe85d3d2cd
incorporated canonical fold combinator on lists into body of List theory; refactored passages on List.fold(l/r)
haftmann
parents:
46125
diff
changeset
|
2797 |
qed |
d9fe85d3d2cd
incorporated canonical fold combinator on lists into body of List theory; refactored passages on List.fold(l/r)
haftmann
parents:
46125
diff
changeset
|
2798 |
|
47397
d654c73e4b12
no preference wrt. fold(l/r); prefer fold rather than foldr for iterating over lists in generated code
haftmann
parents:
47131
diff
changeset
|
2799 |
declare Min_fin_set_fold [code] |
d654c73e4b12
no preference wrt. fold(l/r); prefer fold rather than foldr for iterating over lists in generated code
haftmann
parents:
47131
diff
changeset
|
2800 |
|
46133
d9fe85d3d2cd
incorporated canonical fold combinator on lists into body of List theory; refactored passages on List.fold(l/r)
haftmann
parents:
46125
diff
changeset
|
2801 |
lemma (in linorder) Max_fin_set_fold: |
d9fe85d3d2cd
incorporated canonical fold combinator on lists into body of List theory; refactored passages on List.fold(l/r)
haftmann
parents:
46125
diff
changeset
|
2802 |
"Max (set (x # xs)) = fold max xs x" |
d9fe85d3d2cd
incorporated canonical fold combinator on lists into body of List theory; refactored passages on List.fold(l/r)
haftmann
parents:
46125
diff
changeset
|
2803 |
proof - |
d9fe85d3d2cd
incorporated canonical fold combinator on lists into body of List theory; refactored passages on List.fold(l/r)
haftmann
parents:
46125
diff
changeset
|
2804 |
interpret ab_semigroup_idem_mult "max :: 'a \<Rightarrow> 'a \<Rightarrow> 'a" |
d9fe85d3d2cd
incorporated canonical fold combinator on lists into body of List theory; refactored passages on List.fold(l/r)
haftmann
parents:
46125
diff
changeset
|
2805 |
by (fact ab_semigroup_idem_mult_max) |
d9fe85d3d2cd
incorporated canonical fold combinator on lists into body of List theory; refactored passages on List.fold(l/r)
haftmann
parents:
46125
diff
changeset
|
2806 |
show ?thesis |
d9fe85d3d2cd
incorporated canonical fold combinator on lists into body of List theory; refactored passages on List.fold(l/r)
haftmann
parents:
46125
diff
changeset
|
2807 |
by (simp add: Max_def fold1_set_fold del: set.simps) |
d9fe85d3d2cd
incorporated canonical fold combinator on lists into body of List theory; refactored passages on List.fold(l/r)
haftmann
parents:
46125
diff
changeset
|
2808 |
qed |
d9fe85d3d2cd
incorporated canonical fold combinator on lists into body of List theory; refactored passages on List.fold(l/r)
haftmann
parents:
46125
diff
changeset
|
2809 |
|
47397
d654c73e4b12
no preference wrt. fold(l/r); prefer fold rather than foldr for iterating over lists in generated code
haftmann
parents:
47131
diff
changeset
|
2810 |
declare Max_fin_set_fold [code] |
d654c73e4b12
no preference wrt. fold(l/r); prefer fold rather than foldr for iterating over lists in generated code
haftmann
parents:
47131
diff
changeset
|
2811 |
|
46133
d9fe85d3d2cd
incorporated canonical fold combinator on lists into body of List theory; refactored passages on List.fold(l/r)
haftmann
parents:
46125
diff
changeset
|
2812 |
lemma (in complete_lattice) Inf_set_fold: |
d9fe85d3d2cd
incorporated canonical fold combinator on lists into body of List theory; refactored passages on List.fold(l/r)
haftmann
parents:
46125
diff
changeset
|
2813 |
"Inf (set xs) = fold inf xs top" |
d9fe85d3d2cd
incorporated canonical fold combinator on lists into body of List theory; refactored passages on List.fold(l/r)
haftmann
parents:
46125
diff
changeset
|
2814 |
proof - |
d9fe85d3d2cd
incorporated canonical fold combinator on lists into body of List theory; refactored passages on List.fold(l/r)
haftmann
parents:
46125
diff
changeset
|
2815 |
interpret comp_fun_idem "inf :: 'a \<Rightarrow> 'a \<Rightarrow> 'a" |
d9fe85d3d2cd
incorporated canonical fold combinator on lists into body of List theory; refactored passages on List.fold(l/r)
haftmann
parents:
46125
diff
changeset
|
2816 |
by (fact comp_fun_idem_inf) |
d9fe85d3d2cd
incorporated canonical fold combinator on lists into body of List theory; refactored passages on List.fold(l/r)
haftmann
parents:
46125
diff
changeset
|
2817 |
show ?thesis by (simp add: Inf_fold_inf fold_set_fold inf_commute) |
d9fe85d3d2cd
incorporated canonical fold combinator on lists into body of List theory; refactored passages on List.fold(l/r)
haftmann
parents:
46125
diff
changeset
|
2818 |
qed |
d9fe85d3d2cd
incorporated canonical fold combinator on lists into body of List theory; refactored passages on List.fold(l/r)
haftmann
parents:
46125
diff
changeset
|
2819 |
|
47397
d654c73e4b12
no preference wrt. fold(l/r); prefer fold rather than foldr for iterating over lists in generated code
haftmann
parents:
47131
diff
changeset
|
2820 |
declare Inf_set_fold [where 'a = "'a set", code] |
d654c73e4b12
no preference wrt. fold(l/r); prefer fold rather than foldr for iterating over lists in generated code
haftmann
parents:
47131
diff
changeset
|
2821 |
|
46133
d9fe85d3d2cd
incorporated canonical fold combinator on lists into body of List theory; refactored passages on List.fold(l/r)
haftmann
parents:
46125
diff
changeset
|
2822 |
lemma (in complete_lattice) Sup_set_fold: |
d9fe85d3d2cd
incorporated canonical fold combinator on lists into body of List theory; refactored passages on List.fold(l/r)
haftmann
parents:
46125
diff
changeset
|
2823 |
"Sup (set xs) = fold sup xs bot" |
d9fe85d3d2cd
incorporated canonical fold combinator on lists into body of List theory; refactored passages on List.fold(l/r)
haftmann
parents:
46125
diff
changeset
|
2824 |
proof - |
d9fe85d3d2cd
incorporated canonical fold combinator on lists into body of List theory; refactored passages on List.fold(l/r)
haftmann
parents:
46125
diff
changeset
|
2825 |
interpret comp_fun_idem "sup :: 'a \<Rightarrow> 'a \<Rightarrow> 'a" |
d9fe85d3d2cd
incorporated canonical fold combinator on lists into body of List theory; refactored passages on List.fold(l/r)
haftmann
parents:
46125
diff
changeset
|
2826 |
by (fact comp_fun_idem_sup) |
d9fe85d3d2cd
incorporated canonical fold combinator on lists into body of List theory; refactored passages on List.fold(l/r)
haftmann
parents:
46125
diff
changeset
|
2827 |
show ?thesis by (simp add: Sup_fold_sup fold_set_fold sup_commute) |
d9fe85d3d2cd
incorporated canonical fold combinator on lists into body of List theory; refactored passages on List.fold(l/r)
haftmann
parents:
46125
diff
changeset
|
2828 |
qed |
d9fe85d3d2cd
incorporated canonical fold combinator on lists into body of List theory; refactored passages on List.fold(l/r)
haftmann
parents:
46125
diff
changeset
|
2829 |
|
47397
d654c73e4b12
no preference wrt. fold(l/r); prefer fold rather than foldr for iterating over lists in generated code
haftmann
parents:
47131
diff
changeset
|
2830 |
declare Sup_set_fold [where 'a = "'a set", code] |
d654c73e4b12
no preference wrt. fold(l/r); prefer fold rather than foldr for iterating over lists in generated code
haftmann
parents:
47131
diff
changeset
|
2831 |
|
46133
d9fe85d3d2cd
incorporated canonical fold combinator on lists into body of List theory; refactored passages on List.fold(l/r)
haftmann
parents:
46125
diff
changeset
|
2832 |
lemma (in complete_lattice) INF_set_fold: |
d9fe85d3d2cd
incorporated canonical fold combinator on lists into body of List theory; refactored passages on List.fold(l/r)
haftmann
parents:
46125
diff
changeset
|
2833 |
"INFI (set xs) f = fold (inf \<circ> f) xs top" |
d9fe85d3d2cd
incorporated canonical fold combinator on lists into body of List theory; refactored passages on List.fold(l/r)
haftmann
parents:
46125
diff
changeset
|
2834 |
unfolding INF_def set_map [symmetric] Inf_set_fold fold_map .. |
d9fe85d3d2cd
incorporated canonical fold combinator on lists into body of List theory; refactored passages on List.fold(l/r)
haftmann
parents:
46125
diff
changeset
|
2835 |
|
47397
d654c73e4b12
no preference wrt. fold(l/r); prefer fold rather than foldr for iterating over lists in generated code
haftmann
parents:
47131
diff
changeset
|
2836 |
declare INF_set_fold [code] |
d654c73e4b12
no preference wrt. fold(l/r); prefer fold rather than foldr for iterating over lists in generated code
haftmann
parents:
47131
diff
changeset
|
2837 |
|
46133
d9fe85d3d2cd
incorporated canonical fold combinator on lists into body of List theory; refactored passages on List.fold(l/r)
haftmann
parents:
46125
diff
changeset
|
2838 |
lemma (in complete_lattice) SUP_set_fold: |
d9fe85d3d2cd
incorporated canonical fold combinator on lists into body of List theory; refactored passages on List.fold(l/r)
haftmann
parents:
46125
diff
changeset
|
2839 |
"SUPR (set xs) f = fold (sup \<circ> f) xs bot" |
d9fe85d3d2cd
incorporated canonical fold combinator on lists into body of List theory; refactored passages on List.fold(l/r)
haftmann
parents:
46125
diff
changeset
|
2840 |
unfolding SUP_def set_map [symmetric] Sup_set_fold fold_map .. |
d9fe85d3d2cd
incorporated canonical fold combinator on lists into body of List theory; refactored passages on List.fold(l/r)
haftmann
parents:
46125
diff
changeset
|
2841 |
|
47397
d654c73e4b12
no preference wrt. fold(l/r); prefer fold rather than foldr for iterating over lists in generated code
haftmann
parents:
47131
diff
changeset
|
2842 |
declare SUP_set_fold [code] |
46133
d9fe85d3d2cd
incorporated canonical fold combinator on lists into body of List theory; refactored passages on List.fold(l/r)
haftmann
parents:
46125
diff
changeset
|
2843 |
|
49948
744934b818c7
moved quite generic material from theory Enum to more appropriate places
haftmann
parents:
49808
diff
changeset
|
2844 |
|
46133
d9fe85d3d2cd
incorporated canonical fold combinator on lists into body of List theory; refactored passages on List.fold(l/r)
haftmann
parents:
46125
diff
changeset
|
2845 |
subsubsection {* Fold variants: @{const foldr} and @{const foldl} *} |
d9fe85d3d2cd
incorporated canonical fold combinator on lists into body of List theory; refactored passages on List.fold(l/r)
haftmann
parents:
46125
diff
changeset
|
2846 |
|
d9fe85d3d2cd
incorporated canonical fold combinator on lists into body of List theory; refactored passages on List.fold(l/r)
haftmann
parents:
46125
diff
changeset
|
2847 |
text {* Correspondence *} |
d9fe85d3d2cd
incorporated canonical fold combinator on lists into body of List theory; refactored passages on List.fold(l/r)
haftmann
parents:
46125
diff
changeset
|
2848 |
|
47397
d654c73e4b12
no preference wrt. fold(l/r); prefer fold rather than foldr for iterating over lists in generated code
haftmann
parents:
47131
diff
changeset
|
2849 |
lemma foldr_conv_fold [code_abbrev]: |
d654c73e4b12
no preference wrt. fold(l/r); prefer fold rather than foldr for iterating over lists in generated code
haftmann
parents:
47131
diff
changeset
|
2850 |
"foldr f xs = fold f (rev xs)" |
d654c73e4b12
no preference wrt. fold(l/r); prefer fold rather than foldr for iterating over lists in generated code
haftmann
parents:
47131
diff
changeset
|
2851 |
by (induct xs) simp_all |
d654c73e4b12
no preference wrt. fold(l/r); prefer fold rather than foldr for iterating over lists in generated code
haftmann
parents:
47131
diff
changeset
|
2852 |
|
d654c73e4b12
no preference wrt. fold(l/r); prefer fold rather than foldr for iterating over lists in generated code
haftmann
parents:
47131
diff
changeset
|
2853 |
lemma foldl_conv_fold: |
d654c73e4b12
no preference wrt. fold(l/r); prefer fold rather than foldr for iterating over lists in generated code
haftmann
parents:
47131
diff
changeset
|
2854 |
"foldl f s xs = fold (\<lambda>x s. f s x) xs s" |
d654c73e4b12
no preference wrt. fold(l/r); prefer fold rather than foldr for iterating over lists in generated code
haftmann
parents:
47131
diff
changeset
|
2855 |
by (induct xs arbitrary: s) simp_all |
d654c73e4b12
no preference wrt. fold(l/r); prefer fold rather than foldr for iterating over lists in generated code
haftmann
parents:
47131
diff
changeset
|
2856 |
|
d654c73e4b12
no preference wrt. fold(l/r); prefer fold rather than foldr for iterating over lists in generated code
haftmann
parents:
47131
diff
changeset
|
2857 |
lemma foldr_conv_foldl: -- {* The ``Third Duality Theorem'' in Bird \& Wadler: *} |
46133
d9fe85d3d2cd
incorporated canonical fold combinator on lists into body of List theory; refactored passages on List.fold(l/r)
haftmann
parents:
46125
diff
changeset
|
2858 |
"foldr f xs a = foldl (\<lambda>x y. f y x) a (rev xs)" |
47397
d654c73e4b12
no preference wrt. fold(l/r); prefer fold rather than foldr for iterating over lists in generated code
haftmann
parents:
47131
diff
changeset
|
2859 |
by (simp add: foldr_conv_fold foldl_conv_fold) |
d654c73e4b12
no preference wrt. fold(l/r); prefer fold rather than foldr for iterating over lists in generated code
haftmann
parents:
47131
diff
changeset
|
2860 |
|
d654c73e4b12
no preference wrt. fold(l/r); prefer fold rather than foldr for iterating over lists in generated code
haftmann
parents:
47131
diff
changeset
|
2861 |
lemma foldl_conv_foldr: |
46133
d9fe85d3d2cd
incorporated canonical fold combinator on lists into body of List theory; refactored passages on List.fold(l/r)
haftmann
parents:
46125
diff
changeset
|
2862 |
"foldl f a xs = foldr (\<lambda>x y. f y x) (rev xs) a" |
47397
d654c73e4b12
no preference wrt. fold(l/r); prefer fold rather than foldr for iterating over lists in generated code
haftmann
parents:
47131
diff
changeset
|
2863 |
by (simp add: foldr_conv_fold foldl_conv_fold) |
46133
d9fe85d3d2cd
incorporated canonical fold combinator on lists into body of List theory; refactored passages on List.fold(l/r)
haftmann
parents:
46125
diff
changeset
|
2864 |
|
d9fe85d3d2cd
incorporated canonical fold combinator on lists into body of List theory; refactored passages on List.fold(l/r)
haftmann
parents:
46125
diff
changeset
|
2865 |
lemma foldr_fold: |
d9fe85d3d2cd
incorporated canonical fold combinator on lists into body of List theory; refactored passages on List.fold(l/r)
haftmann
parents:
46125
diff
changeset
|
2866 |
assumes "\<And>x y. x \<in> set xs \<Longrightarrow> y \<in> set xs \<Longrightarrow> f y \<circ> f x = f x \<circ> f y" |
d9fe85d3d2cd
incorporated canonical fold combinator on lists into body of List theory; refactored passages on List.fold(l/r)
haftmann
parents:
46125
diff
changeset
|
2867 |
shows "foldr f xs = fold f xs" |
47397
d654c73e4b12
no preference wrt. fold(l/r); prefer fold rather than foldr for iterating over lists in generated code
haftmann
parents:
47131
diff
changeset
|
2868 |
using assms unfolding foldr_conv_fold by (rule fold_rev) |
46133
d9fe85d3d2cd
incorporated canonical fold combinator on lists into body of List theory; refactored passages on List.fold(l/r)
haftmann
parents:
46125
diff
changeset
|
2869 |
|
d9fe85d3d2cd
incorporated canonical fold combinator on lists into body of List theory; refactored passages on List.fold(l/r)
haftmann
parents:
46125
diff
changeset
|
2870 |
lemma foldr_cong [fundef_cong]: |
d9fe85d3d2cd
incorporated canonical fold combinator on lists into body of List theory; refactored passages on List.fold(l/r)
haftmann
parents:
46125
diff
changeset
|
2871 |
"a = b \<Longrightarrow> l = k \<Longrightarrow> (\<And>a x. x \<in> set l \<Longrightarrow> f x a = g x a) \<Longrightarrow> foldr f l a = foldr g k b" |
47397
d654c73e4b12
no preference wrt. fold(l/r); prefer fold rather than foldr for iterating over lists in generated code
haftmann
parents:
47131
diff
changeset
|
2872 |
by (auto simp add: foldr_conv_fold intro!: fold_cong) |
46133
d9fe85d3d2cd
incorporated canonical fold combinator on lists into body of List theory; refactored passages on List.fold(l/r)
haftmann
parents:
46125
diff
changeset
|
2873 |
|
d9fe85d3d2cd
incorporated canonical fold combinator on lists into body of List theory; refactored passages on List.fold(l/r)
haftmann
parents:
46125
diff
changeset
|
2874 |
lemma foldl_cong [fundef_cong]: |
d9fe85d3d2cd
incorporated canonical fold combinator on lists into body of List theory; refactored passages on List.fold(l/r)
haftmann
parents:
46125
diff
changeset
|
2875 |
"a = b \<Longrightarrow> l = k \<Longrightarrow> (\<And>a x. x \<in> set l \<Longrightarrow> f a x = g a x) \<Longrightarrow> foldl f a l = foldl g b k" |
47397
d654c73e4b12
no preference wrt. fold(l/r); prefer fold rather than foldr for iterating over lists in generated code
haftmann
parents:
47131
diff
changeset
|
2876 |
by (auto simp add: foldl_conv_fold intro!: fold_cong) |
46133
d9fe85d3d2cd
incorporated canonical fold combinator on lists into body of List theory; refactored passages on List.fold(l/r)
haftmann
parents:
46125
diff
changeset
|
2877 |
|
d9fe85d3d2cd
incorporated canonical fold combinator on lists into body of List theory; refactored passages on List.fold(l/r)
haftmann
parents:
46125
diff
changeset
|
2878 |
lemma foldr_append [simp]: |
d9fe85d3d2cd
incorporated canonical fold combinator on lists into body of List theory; refactored passages on List.fold(l/r)
haftmann
parents:
46125
diff
changeset
|
2879 |
"foldr f (xs @ ys) a = foldr f xs (foldr f ys a)" |
47397
d654c73e4b12
no preference wrt. fold(l/r); prefer fold rather than foldr for iterating over lists in generated code
haftmann
parents:
47131
diff
changeset
|
2880 |
by (simp add: foldr_conv_fold) |
46133
d9fe85d3d2cd
incorporated canonical fold combinator on lists into body of List theory; refactored passages on List.fold(l/r)
haftmann
parents:
46125
diff
changeset
|
2881 |
|
d9fe85d3d2cd
incorporated canonical fold combinator on lists into body of List theory; refactored passages on List.fold(l/r)
haftmann
parents:
46125
diff
changeset
|
2882 |
lemma foldl_append [simp]: |
d9fe85d3d2cd
incorporated canonical fold combinator on lists into body of List theory; refactored passages on List.fold(l/r)
haftmann
parents:
46125
diff
changeset
|
2883 |
"foldl f a (xs @ ys) = foldl f (foldl f a xs) ys" |
47397
d654c73e4b12
no preference wrt. fold(l/r); prefer fold rather than foldr for iterating over lists in generated code
haftmann
parents:
47131
diff
changeset
|
2884 |
by (simp add: foldl_conv_fold) |
46133
d9fe85d3d2cd
incorporated canonical fold combinator on lists into body of List theory; refactored passages on List.fold(l/r)
haftmann
parents:
46125
diff
changeset
|
2885 |
|
d9fe85d3d2cd
incorporated canonical fold combinator on lists into body of List theory; refactored passages on List.fold(l/r)
haftmann
parents:
46125
diff
changeset
|
2886 |
lemma foldr_map [code_unfold]: |
d9fe85d3d2cd
incorporated canonical fold combinator on lists into body of List theory; refactored passages on List.fold(l/r)
haftmann
parents:
46125
diff
changeset
|
2887 |
"foldr g (map f xs) a = foldr (g o f) xs a" |
47397
d654c73e4b12
no preference wrt. fold(l/r); prefer fold rather than foldr for iterating over lists in generated code
haftmann
parents:
47131
diff
changeset
|
2888 |
by (simp add: foldr_conv_fold fold_map rev_map) |
46133
d9fe85d3d2cd
incorporated canonical fold combinator on lists into body of List theory; refactored passages on List.fold(l/r)
haftmann
parents:
46125
diff
changeset
|
2889 |
|
d9fe85d3d2cd
incorporated canonical fold combinator on lists into body of List theory; refactored passages on List.fold(l/r)
haftmann
parents:
46125
diff
changeset
|
2890 |
lemma foldl_map [code_unfold]: |
d9fe85d3d2cd
incorporated canonical fold combinator on lists into body of List theory; refactored passages on List.fold(l/r)
haftmann
parents:
46125
diff
changeset
|
2891 |
"foldl g a (map f xs) = foldl (\<lambda>a x. g a (f x)) a xs" |
47397
d654c73e4b12
no preference wrt. fold(l/r); prefer fold rather than foldr for iterating over lists in generated code
haftmann
parents:
47131
diff
changeset
|
2892 |
by (simp add: foldl_conv_fold fold_map comp_def) |
46133
d9fe85d3d2cd
incorporated canonical fold combinator on lists into body of List theory; refactored passages on List.fold(l/r)
haftmann
parents:
46125
diff
changeset
|
2893 |
|
d9fe85d3d2cd
incorporated canonical fold combinator on lists into body of List theory; refactored passages on List.fold(l/r)
haftmann
parents:
46125
diff
changeset
|
2894 |
lemma concat_conv_foldr [code]: |
d9fe85d3d2cd
incorporated canonical fold combinator on lists into body of List theory; refactored passages on List.fold(l/r)
haftmann
parents:
46125
diff
changeset
|
2895 |
"concat xss = foldr append xss []" |
47397
d654c73e4b12
no preference wrt. fold(l/r); prefer fold rather than foldr for iterating over lists in generated code
haftmann
parents:
47131
diff
changeset
|
2896 |
by (simp add: fold_append_concat_rev foldr_conv_fold) |
46133
d9fe85d3d2cd
incorporated canonical fold combinator on lists into body of List theory; refactored passages on List.fold(l/r)
haftmann
parents:
46125
diff
changeset
|
2897 |
|
35115 | 2898 |
|
49948
744934b818c7
moved quite generic material from theory Enum to more appropriate places
haftmann
parents:
49808
diff
changeset
|
2899 |
subsubsection {* @{const upt} *} |
13114 | 2900 |
|
17090 | 2901 |
lemma upt_rec[code]: "[i..<j] = (if i<j then i#[Suc i..<j] else [])" |
2902 |
-- {* simp does not terminate! *} |
|
13145 | 2903 |
by (induct j) auto |
13142 | 2904 |
|
47108
2a1953f0d20d
merged fork with new numeral representation (see NEWS)
huffman
parents:
46898
diff
changeset
|
2905 |
lemmas upt_rec_numeral[simp] = upt_rec[of "numeral m" "numeral n"] for m n |
32005 | 2906 |
|
15425 | 2907 |
lemma upt_conv_Nil [simp]: "j <= i ==> [i..<j] = []" |
13145 | 2908 |
by (subst upt_rec) simp |
13114 | 2909 |
|
15425 | 2910 |
lemma upt_eq_Nil_conv[simp]: "([i..<j] = []) = (j = 0 \<or> j <= i)" |
15281 | 2911 |
by(induct j)simp_all |
2912 |
||
2913 |
lemma upt_eq_Cons_conv: |
|
24526 | 2914 |
"([i..<j] = x#xs) = (i < j & i = x & [i+1..<j] = xs)" |
2915 |
apply(induct j arbitrary: x xs) |
|
15281 | 2916 |
apply simp |
2917 |
apply(clarsimp simp add: append_eq_Cons_conv) |
|
2918 |
apply arith |
|
2919 |
done |
|
2920 |
||
15425 | 2921 |
lemma upt_Suc_append: "i <= j ==> [i..<(Suc j)] = [i..<j]@[j]" |
13145 | 2922 |
-- {* Only needed if @{text upt_Suc} is deleted from the simpset. *} |
2923 |
by simp |
|
13114 | 2924 |
|
15425 | 2925 |
lemma upt_conv_Cons: "i < j ==> [i..<j] = i # [Suc i..<j]" |
26734 | 2926 |
by (simp add: upt_rec) |
13114 | 2927 |
|
15425 | 2928 |
lemma upt_add_eq_append: "i<=j ==> [i..<j+k] = [i..<j]@[j..<j+k]" |
13145 | 2929 |
-- {* LOOPS as a simprule, since @{text "j <= j"}. *} |
2930 |
by (induct k) auto |
|
13114 | 2931 |
|
15425 | 2932 |
lemma length_upt [simp]: "length [i..<j] = j - i" |
13145 | 2933 |
by (induct j) (auto simp add: Suc_diff_le) |
13114 | 2934 |
|
15425 | 2935 |
lemma nth_upt [simp]: "i + k < j ==> [i..<j] ! k = i + k" |
13145 | 2936 |
apply (induct j) |
2937 |
apply (auto simp add: less_Suc_eq nth_append split: nat_diff_split) |
|
2938 |
done |
|
13114 | 2939 |
|
17906 | 2940 |
|
2941 |
lemma hd_upt[simp]: "i < j \<Longrightarrow> hd[i..<j] = i" |
|
2942 |
by(simp add:upt_conv_Cons) |
|
2943 |
||
2944 |
lemma last_upt[simp]: "i < j \<Longrightarrow> last[i..<j] = j - 1" |
|
2945 |
apply(cases j) |
|
2946 |
apply simp |
|
2947 |
by(simp add:upt_Suc_append) |
|
2948 |
||
24526 | 2949 |
lemma take_upt [simp]: "i+m <= n ==> take m [i..<n] = [i..<i+m]" |
2950 |
apply (induct m arbitrary: i, simp) |
|
13145 | 2951 |
apply (subst upt_rec) |
2952 |
apply (rule sym) |
|
2953 |
apply (subst upt_rec) |
|
2954 |
apply (simp del: upt.simps) |
|
2955 |
done |
|
3507 | 2956 |
|
17501 | 2957 |
lemma drop_upt[simp]: "drop m [i..<j] = [i+m..<j]" |
2958 |
apply(induct j) |
|
2959 |
apply auto |
|
2960 |
done |
|
2961 |
||
24645 | 2962 |
lemma map_Suc_upt: "map Suc [m..<n] = [Suc m..<Suc n]" |
13145 | 2963 |
by (induct n) auto |
13114 | 2964 |
|
24526 | 2965 |
lemma nth_map_upt: "i < n-m ==> (map f [m..<n]) ! i = f(m+i)" |
2966 |
apply (induct n m arbitrary: i rule: diff_induct) |
|
13145 | 2967 |
prefer 3 apply (subst map_Suc_upt[symmetric]) |
44921 | 2968 |
apply (auto simp add: less_diff_conv) |
13145 | 2969 |
done |
13114 | 2970 |
|
13883
0451e0fb3f22
Re-structured some proofs in order to get rid of rule_format attribute.
berghofe
parents:
13863
diff
changeset
|
2971 |
lemma nth_take_lemma: |
24526 | 2972 |
"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
|
2973 |
(!!i. i < k --> xs!i = ys!i) ==> take k xs = take k ys" |
24526 | 2974 |
apply (atomize, induct k arbitrary: xs ys) |
14208 | 2975 |
apply (simp_all add: less_Suc_eq_0_disj all_conj_distrib, clarify) |
13145 | 2976 |
txt {* Both lists must be non-empty *} |
14208 | 2977 |
apply (case_tac xs, simp) |
2978 |
apply (case_tac ys, clarify) |
|
13145 | 2979 |
apply (simp (no_asm_use)) |
2980 |
apply clarify |
|
2981 |
txt {* prenexing's needed, not miniscoping *} |
|
2982 |
apply (simp (no_asm_use) add: all_simps [symmetric] del: all_simps) |
|
2983 |
apply blast |
|
2984 |
done |
|
13114 | 2985 |
|
2986 |
lemma nth_equalityI: |
|
2987 |
"[| length xs = length ys; ALL i < length xs. xs!i = ys!i |] ==> xs = ys" |
|
44921 | 2988 |
by (frule nth_take_lemma [OF le_refl eq_imp_le]) simp_all |
13142 | 2989 |
|
24796 | 2990 |
lemma map_nth: |
2991 |
"map (\<lambda>i. xs ! i) [0..<length xs] = xs" |
|
2992 |
by (rule nth_equalityI, auto) |
|
2993 |
||
13863 | 2994 |
(* needs nth_equalityI *) |
2995 |
lemma list_all2_antisym: |
|
2996 |
"\<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> |
|
2997 |
\<Longrightarrow> xs = ys" |
|
2998 |
apply (simp add: list_all2_conv_all_nth) |
|
14208 | 2999 |
apply (rule nth_equalityI, blast, simp) |
13863 | 3000 |
done |
3001 |
||
13142 | 3002 |
lemma take_equalityI: "(\<forall>i. take i xs = take i ys) ==> xs = ys" |
13145 | 3003 |
-- {* The famous take-lemma. *} |
3004 |
apply (drule_tac x = "max (length xs) (length ys)" in spec) |
|
44921 | 3005 |
apply (simp add: le_max_iff_disj) |
13145 | 3006 |
done |
13142 | 3007 |
|
3008 |
||
15302 | 3009 |
lemma take_Cons': |
3010 |
"take n (x # xs) = (if n = 0 then [] else x # take (n - 1) xs)" |
|
3011 |
by (cases n) simp_all |
|
3012 |
||
3013 |
lemma drop_Cons': |
|
3014 |
"drop n (x # xs) = (if n = 0 then x # xs else drop (n - 1) xs)" |
|
3015 |
by (cases n) simp_all |
|
3016 |
||
3017 |
lemma nth_Cons': "(x # xs)!n = (if n = 0 then x else xs!(n - 1))" |
|
3018 |
by (cases n) simp_all |
|
3019 |
||
47108
2a1953f0d20d
merged fork with new numeral representation (see NEWS)
huffman
parents:
46898
diff
changeset
|
3020 |
lemma take_Cons_numeral [simp]: |
2a1953f0d20d
merged fork with new numeral representation (see NEWS)
huffman
parents:
46898
diff
changeset
|
3021 |
"take (numeral v) (x # xs) = x # take (numeral v - 1) xs" |
2a1953f0d20d
merged fork with new numeral representation (see NEWS)
huffman
parents:
46898
diff
changeset
|
3022 |
by (simp add: take_Cons') |
2a1953f0d20d
merged fork with new numeral representation (see NEWS)
huffman
parents:
46898
diff
changeset
|
3023 |
|
2a1953f0d20d
merged fork with new numeral representation (see NEWS)
huffman
parents:
46898
diff
changeset
|
3024 |
lemma drop_Cons_numeral [simp]: |
2a1953f0d20d
merged fork with new numeral representation (see NEWS)
huffman
parents:
46898
diff
changeset
|
3025 |
"drop (numeral v) (x # xs) = drop (numeral v - 1) xs" |
2a1953f0d20d
merged fork with new numeral representation (see NEWS)
huffman
parents:
46898
diff
changeset
|
3026 |
by (simp add: drop_Cons') |
2a1953f0d20d
merged fork with new numeral representation (see NEWS)
huffman
parents:
46898
diff
changeset
|
3027 |
|
2a1953f0d20d
merged fork with new numeral representation (see NEWS)
huffman
parents:
46898
diff
changeset
|
3028 |
lemma nth_Cons_numeral [simp]: |
2a1953f0d20d
merged fork with new numeral representation (see NEWS)
huffman
parents:
46898
diff
changeset
|
3029 |
"(x # xs) ! numeral v = xs ! (numeral v - 1)" |
2a1953f0d20d
merged fork with new numeral representation (see NEWS)
huffman
parents:
46898
diff
changeset
|
3030 |
by (simp add: nth_Cons') |
15302 | 3031 |
|
3032 |
||
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
|
3033 |
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
|
3034 |
|
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
|
3035 |
(* 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
|
3036 |
|
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
|
3037 |
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
|
3038 |
"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
|
3039 |
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
|
3040 |
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
|
3041 |
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
|
3042 |
|
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
|
3043 |
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
|
3044 |
|
47108
2a1953f0d20d
merged fork with new numeral representation (see NEWS)
huffman
parents:
46898
diff
changeset
|
3045 |
lemmas upto_rec_numeral [simp] = |
2a1953f0d20d
merged fork with new numeral representation (see NEWS)
huffman
parents:
46898
diff
changeset
|
3046 |
upto.simps[of "numeral m" "numeral n"] |
2a1953f0d20d
merged fork with new numeral representation (see NEWS)
huffman
parents:
46898
diff
changeset
|
3047 |
upto.simps[of "numeral m" "neg_numeral n"] |
2a1953f0d20d
merged fork with new numeral representation (see NEWS)
huffman
parents:
46898
diff
changeset
|
3048 |
upto.simps[of "neg_numeral m" "numeral n"] |
2a1953f0d20d
merged fork with new numeral representation (see NEWS)
huffman
parents:
46898
diff
changeset
|
3049 |
upto.simps[of "neg_numeral m" "neg_numeral n"] for m n |
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
|
3050 |
|
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
|
3051 |
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
|
3052 |
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
|
3053 |
|
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
|
3054 |
lemma set_upto[simp]: "set[i..j] = {i..j}" |
41463
edbf0a86fb1c
adding simproc to rewrite list comprehensions to set comprehensions; adopting proofs
bulwahn
parents:
41372
diff
changeset
|
3055 |
proof(induct i j rule:upto.induct) |
edbf0a86fb1c
adding simproc to rewrite list comprehensions to set comprehensions; adopting proofs
bulwahn
parents:
41372
diff
changeset
|
3056 |
case (1 i j) |
edbf0a86fb1c
adding simproc to rewrite list comprehensions to set comprehensions; adopting proofs
bulwahn
parents:
41372
diff
changeset
|
3057 |
from this show ?case |
edbf0a86fb1c
adding simproc to rewrite list comprehensions to set comprehensions; adopting proofs
bulwahn
parents:
41372
diff
changeset
|
3058 |
unfolding upto.simps[of i j] simp_from_to[of i j] by auto |
edbf0a86fb1c
adding simproc to rewrite list comprehensions to set comprehensions; adopting proofs
bulwahn
parents:
41372
diff
changeset
|
3059 |
qed |
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
|
3060 |
|
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
|
3061 |
|
49948
744934b818c7
moved quite generic material from theory Enum to more appropriate places
haftmann
parents:
49808
diff
changeset
|
3062 |
subsubsection {* @{const distinct} and @{const remdups} *} |
13142 | 3063 |
|
40210
aee7ef725330
sorting: avoid _key suffix if lemma applies both to simple and generalized variant; generalized insort_insert to insort_insert_key; additional lemmas
haftmann
parents:
40195
diff
changeset
|
3064 |
lemma distinct_tl: |
aee7ef725330
sorting: avoid _key suffix if lemma applies both to simple and generalized variant; generalized insort_insert to insort_insert_key; additional lemmas
haftmann
parents:
40195
diff
changeset
|
3065 |
"distinct xs \<Longrightarrow> distinct (tl xs)" |
aee7ef725330
sorting: avoid _key suffix if lemma applies both to simple and generalized variant; generalized insort_insert to insort_insert_key; additional lemmas
haftmann
parents:
40195
diff
changeset
|
3066 |
by (cases xs) simp_all |
aee7ef725330
sorting: avoid _key suffix if lemma applies both to simple and generalized variant; generalized insort_insert to insort_insert_key; additional lemmas
haftmann
parents:
40195
diff
changeset
|
3067 |
|
13142 | 3068 |
lemma distinct_append [simp]: |
13145 | 3069 |
"distinct (xs @ ys) = (distinct xs \<and> distinct ys \<and> set xs \<inter> set ys = {})" |
3070 |
by (induct xs) auto |
|
13142 | 3071 |
|
15305 | 3072 |
lemma distinct_rev[simp]: "distinct(rev xs) = distinct xs" |
3073 |
by(induct xs) auto |
|
3074 |
||
13142 | 3075 |
lemma set_remdups [simp]: "set (remdups xs) = set xs" |
13145 | 3076 |
by (induct xs) (auto simp add: insert_absorb) |
13142 | 3077 |
|
3078 |
lemma distinct_remdups [iff]: "distinct (remdups xs)" |
|
13145 | 3079 |
by (induct xs) auto |
13142 | 3080 |
|
25287 | 3081 |
lemma distinct_remdups_id: "distinct xs ==> remdups xs = xs" |
3082 |
by (induct xs, auto) |
|
3083 |
||
26734 | 3084 |
lemma remdups_id_iff_distinct [simp]: "remdups xs = xs \<longleftrightarrow> distinct xs" |
3085 |
by (metis distinct_remdups distinct_remdups_id) |
|
25287 | 3086 |
|
24566 | 3087 |
lemma finite_distinct_list: "finite A \<Longrightarrow> EX xs. set xs = A & distinct xs" |
24632 | 3088 |
by (metis distinct_remdups finite_list set_remdups) |
24566 | 3089 |
|
15072 | 3090 |
lemma remdups_eq_nil_iff [simp]: "(remdups x = []) = (x = [])" |
46440
d4994e2e7364
use 'primrec' to define "rotate1", for uniformity (and to help first-order tools that rely on "Spec_Rules")
blanchet
parents:
46439
diff
changeset
|
3091 |
by (induct x, auto) |
15072 | 3092 |
|
3093 |
lemma remdups_eq_nil_right_iff [simp]: "([] = remdups x) = (x = [])" |
|
24349 | 3094 |
by (induct x, auto) |
15072 | 3095 |
|
15245 | 3096 |
lemma length_remdups_leq[iff]: "length(remdups xs) <= length xs" |
3097 |
by (induct xs) auto |
|
3098 |
||
3099 |
lemma length_remdups_eq[iff]: |
|
3100 |
"(length (remdups xs) = length xs) = (remdups xs = xs)" |
|
3101 |
apply(induct xs) |
|
3102 |
apply auto |
|
3103 |
apply(subgoal_tac "length (remdups xs) <= length xs") |
|
3104 |
apply arith |
|
3105 |
apply(rule length_remdups_leq) |
|
3106 |
done |
|
3107 |
||
33945 | 3108 |
lemma remdups_filter: "remdups(filter P xs) = filter P (remdups xs)" |
3109 |
apply(induct xs) |
|
3110 |
apply auto |
|
3111 |
done |
|
18490 | 3112 |
|
3113 |
lemma distinct_map: |
|
3114 |
"distinct(map f xs) = (distinct xs & inj_on f (set xs))" |
|
3115 |
by (induct xs) auto |
|
3116 |
||
13142 | 3117 |
lemma distinct_filter [simp]: "distinct xs ==> distinct (filter P xs)" |
13145 | 3118 |
by (induct xs) auto |
13114 | 3119 |
|
17501 | 3120 |
lemma distinct_upt[simp]: "distinct[i..<j]" |
3121 |
by (induct j) auto |
|
3122 |
||
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
|
3123 |
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
|
3124 |
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
|
3125 |
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
|
3126 |
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
|
3127 |
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
|
3128 |
|
24526 | 3129 |
lemma distinct_take[simp]: "distinct xs \<Longrightarrow> distinct (take i xs)" |
3130 |
apply(induct xs arbitrary: i) |
|
17501 | 3131 |
apply simp |
3132 |
apply (case_tac i) |
|
3133 |
apply simp_all |
|
3134 |
apply(blast dest:in_set_takeD) |
|
3135 |
done |
|
3136 |
||
24526 | 3137 |
lemma distinct_drop[simp]: "distinct xs \<Longrightarrow> distinct (drop i xs)" |
3138 |
apply(induct xs arbitrary: i) |
|
17501 | 3139 |
apply simp |
3140 |
apply (case_tac i) |
|
3141 |
apply simp_all |
|
3142 |
done |
|
3143 |
||
3144 |
lemma distinct_list_update: |
|
3145 |
assumes d: "distinct xs" and a: "a \<notin> set xs - {xs!i}" |
|
3146 |
shows "distinct (xs[i:=a])" |
|
3147 |
proof (cases "i < length xs") |
|
3148 |
case True |
|
3149 |
with a have "a \<notin> set (take i xs @ xs ! i # drop (Suc i) xs) - {xs!i}" |
|
3150 |
apply (drule_tac id_take_nth_drop) by simp |
|
3151 |
with d True show ?thesis |
|
3152 |
apply (simp add: upd_conv_take_nth_drop) |
|
3153 |
apply (drule subst [OF id_take_nth_drop]) apply assumption |
|
3154 |
apply simp apply (cases "a = xs!i") apply simp by blast |
|
3155 |
next |
|
3156 |
case False with d show ?thesis by auto |
|
3157 |
qed |
|
3158 |
||
31363
7493b571b37d
Added theorems about distinct & concat, map & replicate and concat & replicate
hoelzl
parents:
31264
diff
changeset
|
3159 |
lemma distinct_concat: |
7493b571b37d
Added theorems about distinct & concat, map & replicate and concat & replicate
hoelzl
parents:
31264
diff
changeset
|
3160 |
assumes "distinct xs" |
7493b571b37d
Added theorems about distinct & concat, map & replicate and concat & replicate
hoelzl
parents:
31264
diff
changeset
|
3161 |
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
|
3162 |
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
|
3163 |
shows "distinct (concat xs)" |
7493b571b37d
Added theorems about distinct & concat, map & replicate and concat & replicate
hoelzl
parents:
31264
diff
changeset
|
3164 |
using assms by (induct xs) auto |
17501 | 3165 |
|
3166 |
text {* It is best to avoid this indexed version of distinct, but |
|
3167 |
sometimes it is useful. *} |
|
3168 |
||
13142 | 3169 |
lemma distinct_conv_nth: |
17501 | 3170 |
"distinct xs = (\<forall>i < size xs. \<forall>j < size xs. i \<noteq> j --> xs!i \<noteq> xs!j)" |
15251 | 3171 |
apply (induct xs, simp, simp) |
14208 | 3172 |
apply (rule iffI, clarsimp) |
13145 | 3173 |
apply (case_tac i) |
14208 | 3174 |
apply (case_tac j, simp) |
13145 | 3175 |
apply (simp add: set_conv_nth) |
3176 |
apply (case_tac j) |
|
46440
d4994e2e7364
use 'primrec' to define "rotate1", for uniformity (and to help first-order tools that rely on "Spec_Rules")
blanchet
parents:
46439
diff
changeset
|
3177 |
apply (clarsimp simp add: set_conv_nth, simp) |
13145 | 3178 |
apply (rule conjI) |
24648 | 3179 |
(*TOO SLOW |
24632 | 3180 |
apply (metis Zero_neq_Suc gr0_conv_Suc in_set_conv_nth lessI less_trans_Suc nth_Cons' nth_Cons_Suc) |
24648 | 3181 |
*) |
3182 |
apply (clarsimp simp add: set_conv_nth) |
|
3183 |
apply (erule_tac x = 0 in allE, simp) |
|
3184 |
apply (erule_tac x = "Suc i" in allE, simp, clarsimp) |
|
25130 | 3185 |
(*TOO SLOW |
24632 | 3186 |
apply (metis Suc_Suc_eq lessI less_trans_Suc nth_Cons_Suc) |
25130 | 3187 |
*) |
3188 |
apply (erule_tac x = "Suc i" in allE, simp) |
|
3189 |
apply (erule_tac x = "Suc j" in allE, simp) |
|
13145 | 3190 |
done |
13114 | 3191 |
|
18490 | 3192 |
lemma nth_eq_iff_index_eq: |
3193 |
"\<lbrakk> distinct xs; i < length xs; j < length xs \<rbrakk> \<Longrightarrow> (xs!i = xs!j) = (i = j)" |
|
3194 |
by(auto simp: distinct_conv_nth) |
|
3195 |
||
15110
78b5636eabc7
Added a number of new thms and the new function remove1
nipkow
parents:
15072
diff
changeset
|
3196 |
lemma distinct_card: "distinct xs ==> card (set xs) = size xs" |
24349 | 3197 |
by (induct xs) auto |
14388 | 3198 |
|
15110
78b5636eabc7
Added a number of new thms and the new function remove1
nipkow
parents:
15072
diff
changeset
|
3199 |
lemma card_distinct: "card (set xs) = size xs ==> distinct xs" |
14388 | 3200 |
proof (induct xs) |
3201 |
case Nil thus ?case by simp |
|
3202 |
next |
|
3203 |
case (Cons x xs) |
|
3204 |
show ?case |
|
3205 |
proof (cases "x \<in> set xs") |
|
3206 |
case False with Cons show ?thesis by simp |
|
3207 |
next |
|
3208 |
case True with Cons.prems |
|
46440
d4994e2e7364
use 'primrec' to define "rotate1", for uniformity (and to help first-order tools that rely on "Spec_Rules")
blanchet
parents:
46439
diff
changeset
|
3209 |
have "card (set xs) = Suc (length xs)" |
14388 | 3210 |
by (simp add: card_insert_if split: split_if_asm) |
3211 |
moreover have "card (set xs) \<le> length xs" by (rule card_length) |
|
3212 |
ultimately have False by simp |
|
3213 |
thus ?thesis .. |
|
3214 |
qed |
|
3215 |
qed |
|
3216 |
||
45115
93c1ac6727a3
adding lemma to List library for executable equation of the (refl) transitive closure
bulwahn
parents:
44928
diff
changeset
|
3217 |
lemma distinct_length_filter: "distinct xs \<Longrightarrow> length (filter P xs) = card ({x. P x} Int set xs)" |
93c1ac6727a3
adding lemma to List library for executable equation of the (refl) transitive closure
bulwahn
parents:
44928
diff
changeset
|
3218 |
by (induct xs) (auto) |
93c1ac6727a3
adding lemma to List library for executable equation of the (refl) transitive closure
bulwahn
parents:
44928
diff
changeset
|
3219 |
|
25287 | 3220 |
lemma not_distinct_decomp: "~ distinct ws ==> EX xs ys zs y. ws = xs@[y]@ys@[y]@zs" |
3221 |
apply (induct n == "length ws" arbitrary:ws) apply simp |
|
3222 |
apply(case_tac ws) apply simp |
|
3223 |
apply (simp split:split_if_asm) |
|
3224 |
apply (metis Cons_eq_appendI eq_Nil_appendI split_list) |
|
3225 |
done |
|
18490 | 3226 |
|
45841 | 3227 |
lemma not_distinct_conv_prefix: |
3228 |
defines "dec as xs y ys \<equiv> y \<in> set xs \<and> distinct xs \<and> as = xs @ y # ys" |
|
3229 |
shows "\<not>distinct as \<longleftrightarrow> (\<exists>xs y ys. dec as xs y ys)" (is "?L = ?R") |
|
3230 |
proof |
|
3231 |
assume "?L" then show "?R" |
|
3232 |
proof (induct "length as" arbitrary: as rule: less_induct) |
|
3233 |
case less |
|
3234 |
obtain xs ys zs y where decomp: "as = (xs @ y # ys) @ y # zs" |
|
3235 |
using not_distinct_decomp[OF less.prems] by auto |
|
3236 |
show ?case |
|
3237 |
proof (cases "distinct (xs @ y # ys)") |
|
3238 |
case True |
|
3239 |
with decomp have "dec as (xs @ y # ys) y zs" by (simp add: dec_def) |
|
3240 |
then show ?thesis by blast |
|
3241 |
next |
|
3242 |
case False |
|
3243 |
with less decomp obtain xs' y' ys' where "dec (xs @ y # ys) xs' y' ys'" |
|
3244 |
by atomize_elim auto |
|
3245 |
with decomp have "dec as xs' y' (ys' @ y # zs)" by (simp add: dec_def) |
|
3246 |
then show ?thesis by blast |
|
3247 |
qed |
|
3248 |
qed |
|
3249 |
qed (auto simp: dec_def) |
|
3250 |
||
49948
744934b818c7
moved quite generic material from theory Enum to more appropriate places
haftmann
parents:
49808
diff
changeset
|
3251 |
lemma distinct_product: |
744934b818c7
moved quite generic material from theory Enum to more appropriate places
haftmann
parents:
49808
diff
changeset
|
3252 |
assumes "distinct xs" and "distinct ys" |
744934b818c7
moved quite generic material from theory Enum to more appropriate places
haftmann
parents:
49808
diff
changeset
|
3253 |
shows "distinct (List.product xs ys)" |
744934b818c7
moved quite generic material from theory Enum to more appropriate places
haftmann
parents:
49808
diff
changeset
|
3254 |
using assms by (induct xs) |
744934b818c7
moved quite generic material from theory Enum to more appropriate places
haftmann
parents:
49808
diff
changeset
|
3255 |
(auto intro: inj_onI simp add: product_list_set distinct_map) |
744934b818c7
moved quite generic material from theory Enum to more appropriate places
haftmann
parents:
49808
diff
changeset
|
3256 |
|
18490 | 3257 |
lemma length_remdups_concat: |
44921 | 3258 |
"length (remdups (concat xss)) = card (\<Union>xs\<in>set xss. set xs)" |
3259 |
by (simp add: distinct_card [symmetric]) |
|
17906 | 3260 |
|
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
|
3261 |
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
|
3262 |
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
|
3263 |
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
|
3264 |
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
|
3265 |
qed |
17906 | 3266 |
|
36275 | 3267 |
lemma remdups_remdups: |
3268 |
"remdups (remdups xs) = remdups xs" |
|
3269 |
by (induct xs) simp_all |
|
3270 |
||
36851 | 3271 |
lemma distinct_butlast: |
46500
0196966d6d2d
removing unnecessary premises in theorems of List theory
bulwahn
parents:
46448
diff
changeset
|
3272 |
assumes "distinct xs" |
36851 | 3273 |
shows "distinct (butlast xs)" |
46500
0196966d6d2d
removing unnecessary premises in theorems of List theory
bulwahn
parents:
46448
diff
changeset
|
3274 |
proof (cases "xs = []") |
0196966d6d2d
removing unnecessary premises in theorems of List theory
bulwahn
parents:
46448
diff
changeset
|
3275 |
case False |
0196966d6d2d
removing unnecessary premises in theorems of List theory
bulwahn
parents:
46448
diff
changeset
|
3276 |
from `xs \<noteq> []` obtain ys y where "xs = ys @ [y]" by (cases xs rule: rev_cases) auto |
0196966d6d2d
removing unnecessary premises in theorems of List theory
bulwahn
parents:
46448
diff
changeset
|
3277 |
with `distinct xs` show ?thesis by simp |
0196966d6d2d
removing unnecessary premises in theorems of List theory
bulwahn
parents:
46448
diff
changeset
|
3278 |
qed (auto) |
36851 | 3279 |
|
39728 | 3280 |
lemma remdups_map_remdups: |
3281 |
"remdups (map f (remdups xs)) = remdups (map f xs)" |
|
3282 |
by (induct xs) simp_all |
|
3283 |
||
39915
ecf97cf3d248
turned distinct and sorted into inductive predicates: yields nice induction principles for free; more elegant proofs
haftmann
parents:
39774
diff
changeset
|
3284 |
lemma distinct_zipI1: |
ecf97cf3d248
turned distinct and sorted into inductive predicates: yields nice induction principles for free; more elegant proofs
haftmann
parents:
39774
diff
changeset
|
3285 |
assumes "distinct xs" |
ecf97cf3d248
turned distinct and sorted into inductive predicates: yields nice induction principles for free; more elegant proofs
haftmann
parents:
39774
diff
changeset
|
3286 |
shows "distinct (zip xs ys)" |
ecf97cf3d248
turned distinct and sorted into inductive predicates: yields nice induction principles for free; more elegant proofs
haftmann
parents:
39774
diff
changeset
|
3287 |
proof (rule zip_obtain_same_length) |
ecf97cf3d248
turned distinct and sorted into inductive predicates: yields nice induction principles for free; more elegant proofs
haftmann
parents:
39774
diff
changeset
|
3288 |
fix xs' :: "'a list" and ys' :: "'b list" and n |
ecf97cf3d248
turned distinct and sorted into inductive predicates: yields nice induction principles for free; more elegant proofs
haftmann
parents:
39774
diff
changeset
|
3289 |
assume "length xs' = length ys'" |
ecf97cf3d248
turned distinct and sorted into inductive predicates: yields nice induction principles for free; more elegant proofs
haftmann
parents:
39774
diff
changeset
|
3290 |
assume "xs' = take n xs" |
ecf97cf3d248
turned distinct and sorted into inductive predicates: yields nice induction principles for free; more elegant proofs
haftmann
parents:
39774
diff
changeset
|
3291 |
with assms have "distinct xs'" by simp |
ecf97cf3d248
turned distinct and sorted into inductive predicates: yields nice induction principles for free; more elegant proofs
haftmann
parents:
39774
diff
changeset
|
3292 |
with `length xs' = length ys'` show "distinct (zip xs' ys')" |
ecf97cf3d248
turned distinct and sorted into inductive predicates: yields nice induction principles for free; more elegant proofs
haftmann
parents:
39774
diff
changeset
|
3293 |
by (induct xs' ys' rule: list_induct2) (auto elim: in_set_zipE) |
ecf97cf3d248
turned distinct and sorted into inductive predicates: yields nice induction principles for free; more elegant proofs
haftmann
parents:
39774
diff
changeset
|
3294 |
qed |
ecf97cf3d248
turned distinct and sorted into inductive predicates: yields nice induction principles for free; more elegant proofs
haftmann
parents:
39774
diff
changeset
|
3295 |
|
ecf97cf3d248
turned distinct and sorted into inductive predicates: yields nice induction principles for free; more elegant proofs
haftmann
parents:
39774
diff
changeset
|
3296 |
lemma distinct_zipI2: |
ecf97cf3d248
turned distinct and sorted into inductive predicates: yields nice induction principles for free; more elegant proofs
haftmann
parents:
39774
diff
changeset
|
3297 |
assumes "distinct ys" |
ecf97cf3d248
turned distinct and sorted into inductive predicates: yields nice induction principles for free; more elegant proofs
haftmann
parents:
39774
diff
changeset
|
3298 |
shows "distinct (zip xs ys)" |
ecf97cf3d248
turned distinct and sorted into inductive predicates: yields nice induction principles for free; more elegant proofs
haftmann
parents:
39774
diff
changeset
|
3299 |
proof (rule zip_obtain_same_length) |
ecf97cf3d248
turned distinct and sorted into inductive predicates: yields nice induction principles for free; more elegant proofs
haftmann
parents:
39774
diff
changeset
|
3300 |
fix xs' :: "'b list" and ys' :: "'a list" and n |
ecf97cf3d248
turned distinct and sorted into inductive predicates: yields nice induction principles for free; more elegant proofs
haftmann
parents:
39774
diff
changeset
|
3301 |
assume "length xs' = length ys'" |
ecf97cf3d248
turned distinct and sorted into inductive predicates: yields nice induction principles for free; more elegant proofs
haftmann
parents:
39774
diff
changeset
|
3302 |
assume "ys' = take n ys" |
ecf97cf3d248
turned distinct and sorted into inductive predicates: yields nice induction principles for free; more elegant proofs
haftmann
parents:
39774
diff
changeset
|
3303 |
with assms have "distinct ys'" by simp |
ecf97cf3d248
turned distinct and sorted into inductive predicates: yields nice induction principles for free; more elegant proofs
haftmann
parents:
39774
diff
changeset
|
3304 |
with `length xs' = length ys'` show "distinct (zip xs' ys')" |
ecf97cf3d248
turned distinct and sorted into inductive predicates: yields nice induction principles for free; more elegant proofs
haftmann
parents:
39774
diff
changeset
|
3305 |
by (induct xs' ys' rule: list_induct2) (auto elim: in_set_zipE) |
ecf97cf3d248
turned distinct and sorted into inductive predicates: yields nice induction principles for free; more elegant proofs
haftmann
parents:
39774
diff
changeset
|
3306 |
qed |
ecf97cf3d248
turned distinct and sorted into inductive predicates: yields nice induction principles for free; more elegant proofs
haftmann
parents:
39774
diff
changeset
|
3307 |
|
47122 | 3308 |
lemma set_take_disj_set_drop_if_distinct: |
3309 |
"distinct vs \<Longrightarrow> i \<le> j \<Longrightarrow> set (take i vs) \<inter> set (drop j vs) = {}" |
|
3310 |
by (auto simp: in_set_conv_nth distinct_conv_nth) |
|
3311 |
||
44635
3d046864ebe6
added two lemmas about "distinct" to help Sledgehammer
blanchet
parents:
44619
diff
changeset
|
3312 |
(* The next two lemmas help Sledgehammer. *) |
3d046864ebe6
added two lemmas about "distinct" to help Sledgehammer
blanchet
parents:
44619
diff
changeset
|
3313 |
|
3d046864ebe6
added two lemmas about "distinct" to help Sledgehammer
blanchet
parents:
44619
diff
changeset
|
3314 |
lemma distinct_singleton: "distinct [x]" by simp |
3d046864ebe6
added two lemmas about "distinct" to help Sledgehammer
blanchet
parents:
44619
diff
changeset
|
3315 |
|
3d046864ebe6
added two lemmas about "distinct" to help Sledgehammer
blanchet
parents:
44619
diff
changeset
|
3316 |
lemma distinct_length_2_or_more: |
3d046864ebe6
added two lemmas about "distinct" to help Sledgehammer
blanchet
parents:
44619
diff
changeset
|
3317 |
"distinct (a # b # xs) \<longleftrightarrow> (a \<noteq> b \<and> distinct (a # xs) \<and> distinct (b # xs))" |
3d046864ebe6
added two lemmas about "distinct" to help Sledgehammer
blanchet
parents:
44619
diff
changeset
|
3318 |
by (metis distinct.simps(2) hd.simps hd_in_set list.simps(2) set_ConsD set_rev_mp set_subset_Cons) |
3d046864ebe6
added two lemmas about "distinct" to help Sledgehammer
blanchet
parents:
44619
diff
changeset
|
3319 |
|
49948
744934b818c7
moved quite generic material from theory Enum to more appropriate places
haftmann
parents:
49808
diff
changeset
|
3320 |
|
37605
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
3321 |
subsubsection {* List summation: @{const listsum} and @{text"\<Sum>"}*} |
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
3322 |
|
39774 | 3323 |
lemma (in monoid_add) listsum_simps [simp]: |
3324 |
"listsum [] = 0" |
|
46133
d9fe85d3d2cd
incorporated canonical fold combinator on lists into body of List theory; refactored passages on List.fold(l/r)
haftmann
parents:
46125
diff
changeset
|
3325 |
"listsum (x # xs) = x + listsum xs" |
39774 | 3326 |
by (simp_all add: listsum_def) |
3327 |
||
3328 |
lemma (in monoid_add) listsum_append [simp]: |
|
3329 |
"listsum (xs @ ys) = listsum xs + listsum ys" |
|
3330 |
by (induct xs) (simp_all add: add.assoc) |
|
3331 |
||
3332 |
lemma (in comm_monoid_add) listsum_rev [simp]: |
|
3333 |
"listsum (rev xs) = listsum xs" |
|
47397
d654c73e4b12
no preference wrt. fold(l/r); prefer fold rather than foldr for iterating over lists in generated code
haftmann
parents:
47131
diff
changeset
|
3334 |
by (simp add: listsum_def foldr_fold fold_rev fun_eq_iff add_ac) |
46133
d9fe85d3d2cd
incorporated canonical fold combinator on lists into body of List theory; refactored passages on List.fold(l/r)
haftmann
parents:
46125
diff
changeset
|
3335 |
|
d9fe85d3d2cd
incorporated canonical fold combinator on lists into body of List theory; refactored passages on List.fold(l/r)
haftmann
parents:
46125
diff
changeset
|
3336 |
lemma (in monoid_add) fold_plus_listsum_rev: |
d9fe85d3d2cd
incorporated canonical fold combinator on lists into body of List theory; refactored passages on List.fold(l/r)
haftmann
parents:
46125
diff
changeset
|
3337 |
"fold plus xs = plus (listsum (rev xs))" |
d9fe85d3d2cd
incorporated canonical fold combinator on lists into body of List theory; refactored passages on List.fold(l/r)
haftmann
parents:
46125
diff
changeset
|
3338 |
proof |
d9fe85d3d2cd
incorporated canonical fold combinator on lists into body of List theory; refactored passages on List.fold(l/r)
haftmann
parents:
46125
diff
changeset
|
3339 |
fix x |
d9fe85d3d2cd
incorporated canonical fold combinator on lists into body of List theory; refactored passages on List.fold(l/r)
haftmann
parents:
46125
diff
changeset
|
3340 |
have "fold plus xs x = fold plus xs (x + 0)" by simp |
d9fe85d3d2cd
incorporated canonical fold combinator on lists into body of List theory; refactored passages on List.fold(l/r)
haftmann
parents:
46125
diff
changeset
|
3341 |
also have "\<dots> = fold plus (x # xs) 0" by simp |
47397
d654c73e4b12
no preference wrt. fold(l/r); prefer fold rather than foldr for iterating over lists in generated code
haftmann
parents:
47131
diff
changeset
|
3342 |
also have "\<dots> = foldr plus (rev xs @ [x]) 0" by (simp add: foldr_conv_fold) |
46133
d9fe85d3d2cd
incorporated canonical fold combinator on lists into body of List theory; refactored passages on List.fold(l/r)
haftmann
parents:
46125
diff
changeset
|
3343 |
also have "\<dots> = listsum (rev xs @ [x])" by (simp add: listsum_def) |
d9fe85d3d2cd
incorporated canonical fold combinator on lists into body of List theory; refactored passages on List.fold(l/r)
haftmann
parents:
46125
diff
changeset
|
3344 |
also have "\<dots> = listsum (rev xs) + listsum [x]" by simp |
d9fe85d3d2cd
incorporated canonical fold combinator on lists into body of List theory; refactored passages on List.fold(l/r)
haftmann
parents:
46125
diff
changeset
|
3345 |
finally show "fold plus xs x = listsum (rev xs) + x" by simp |
d9fe85d3d2cd
incorporated canonical fold combinator on lists into body of List theory; refactored passages on List.fold(l/r)
haftmann
parents:
46125
diff
changeset
|
3346 |
qed |
d9fe85d3d2cd
incorporated canonical fold combinator on lists into body of List theory; refactored passages on List.fold(l/r)
haftmann
parents:
46125
diff
changeset
|
3347 |
|
d9fe85d3d2cd
incorporated canonical fold combinator on lists into body of List theory; refactored passages on List.fold(l/r)
haftmann
parents:
46125
diff
changeset
|
3348 |
text{* Some syntactic sugar for summing a function over a list: *} |
d9fe85d3d2cd
incorporated canonical fold combinator on lists into body of List theory; refactored passages on List.fold(l/r)
haftmann
parents:
46125
diff
changeset
|
3349 |
|
d9fe85d3d2cd
incorporated canonical fold combinator on lists into body of List theory; refactored passages on List.fold(l/r)
haftmann
parents:
46125
diff
changeset
|
3350 |
syntax |
d9fe85d3d2cd
incorporated canonical fold combinator on lists into body of List theory; refactored passages on List.fold(l/r)
haftmann
parents:
46125
diff
changeset
|
3351 |
"_listsum" :: "pttrn => 'a list => 'b => 'b" ("(3SUM _<-_. _)" [0, 51, 10] 10) |
d9fe85d3d2cd
incorporated canonical fold combinator on lists into body of List theory; refactored passages on List.fold(l/r)
haftmann
parents:
46125
diff
changeset
|
3352 |
syntax (xsymbols) |
d9fe85d3d2cd
incorporated canonical fold combinator on lists into body of List theory; refactored passages on List.fold(l/r)
haftmann
parents:
46125
diff
changeset
|
3353 |
"_listsum" :: "pttrn => 'a list => 'b => 'b" ("(3\<Sum>_\<leftarrow>_. _)" [0, 51, 10] 10) |
d9fe85d3d2cd
incorporated canonical fold combinator on lists into body of List theory; refactored passages on List.fold(l/r)
haftmann
parents:
46125
diff
changeset
|
3354 |
syntax (HTML output) |
d9fe85d3d2cd
incorporated canonical fold combinator on lists into body of List theory; refactored passages on List.fold(l/r)
haftmann
parents:
46125
diff
changeset
|
3355 |
"_listsum" :: "pttrn => 'a list => 'b => 'b" ("(3\<Sum>_\<leftarrow>_. _)" [0, 51, 10] 10) |
d9fe85d3d2cd
incorporated canonical fold combinator on lists into body of List theory; refactored passages on List.fold(l/r)
haftmann
parents:
46125
diff
changeset
|
3356 |
|
d9fe85d3d2cd
incorporated canonical fold combinator on lists into body of List theory; refactored passages on List.fold(l/r)
haftmann
parents:
46125
diff
changeset
|
3357 |
translations -- {* Beware of argument permutation! *} |
d9fe85d3d2cd
incorporated canonical fold combinator on lists into body of List theory; refactored passages on List.fold(l/r)
haftmann
parents:
46125
diff
changeset
|
3358 |
"SUM x<-xs. b" == "CONST listsum (CONST map (%x. b) xs)" |
d9fe85d3d2cd
incorporated canonical fold combinator on lists into body of List theory; refactored passages on List.fold(l/r)
haftmann
parents:
46125
diff
changeset
|
3359 |
"\<Sum>x\<leftarrow>xs. b" == "CONST listsum (CONST map (%x. b) xs)" |
39774 | 3360 |
|
3361 |
lemma (in comm_monoid_add) listsum_map_remove1: |
|
3362 |
"x \<in> set xs \<Longrightarrow> listsum (map f xs) = f x + listsum (map f (remove1 x xs))" |
|
3363 |
by (induct xs) (auto simp add: ac_simps) |
|
3364 |
||
3365 |
lemma (in monoid_add) list_size_conv_listsum: |
|
37605
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
3366 |
"list_size f xs = listsum (map f xs) + size xs" |
39774 | 3367 |
by (induct xs) auto |
3368 |
||
3369 |
lemma (in monoid_add) length_concat: |
|
3370 |
"length (concat xss) = listsum (map length xss)" |
|
3371 |
by (induct xss) simp_all |
|
3372 |
||
3373 |
lemma (in monoid_add) listsum_map_filter: |
|
3374 |
assumes "\<And>x. x \<in> set xs \<Longrightarrow> \<not> P x \<Longrightarrow> f x = 0" |
|
37605
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
3375 |
shows "listsum (map f (filter P xs)) = listsum (map f xs)" |
39774 | 3376 |
using assms by (induct xs) auto |
3377 |
||
3378 |
lemma (in monoid_add) distinct_listsum_conv_Setsum: |
|
3379 |
"distinct xs \<Longrightarrow> listsum xs = Setsum (set xs)" |
|
3380 |
by (induct xs) simp_all |
|
3381 |
||
3382 |
lemma listsum_eq_0_nat_iff_nat [simp]: |
|
3383 |
"listsum ns = (0::nat) \<longleftrightarrow> (\<forall>n \<in> set ns. n = 0)" |
|
47397
d654c73e4b12
no preference wrt. fold(l/r); prefer fold rather than foldr for iterating over lists in generated code
haftmann
parents:
47131
diff
changeset
|
3384 |
by (induct ns) simp_all |
d654c73e4b12
no preference wrt. fold(l/r); prefer fold rather than foldr for iterating over lists in generated code
haftmann
parents:
47131
diff
changeset
|
3385 |
|
d654c73e4b12
no preference wrt. fold(l/r); prefer fold rather than foldr for iterating over lists in generated code
haftmann
parents:
47131
diff
changeset
|
3386 |
lemma member_le_listsum_nat: |
d654c73e4b12
no preference wrt. fold(l/r); prefer fold rather than foldr for iterating over lists in generated code
haftmann
parents:
47131
diff
changeset
|
3387 |
"(n :: nat) \<in> set ns \<Longrightarrow> n \<le> listsum ns" |
d654c73e4b12
no preference wrt. fold(l/r); prefer fold rather than foldr for iterating over lists in generated code
haftmann
parents:
47131
diff
changeset
|
3388 |
by (induct ns) auto |
39774 | 3389 |
|
3390 |
lemma elem_le_listsum_nat: |
|
3391 |
"k < size ns \<Longrightarrow> ns ! k \<le> listsum (ns::nat list)" |
|
47397
d654c73e4b12
no preference wrt. fold(l/r); prefer fold rather than foldr for iterating over lists in generated code
haftmann
parents:
47131
diff
changeset
|
3392 |
by (rule member_le_listsum_nat) simp |
37605
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
3393 |
|
39774 | 3394 |
lemma listsum_update_nat: |
47397
d654c73e4b12
no preference wrt. fold(l/r); prefer fold rather than foldr for iterating over lists in generated code
haftmann
parents:
47131
diff
changeset
|
3395 |
"k < size ns \<Longrightarrow> listsum (ns[k := (n::nat)]) = listsum ns + n - ns ! k" |
37605
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
3396 |
apply(induct ns arbitrary:k) |
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
3397 |
apply (auto split:nat.split) |
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
3398 |
apply(drule elem_le_listsum_nat) |
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
3399 |
apply arith |
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
3400 |
done |
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
3401 |
|
39774 | 3402 |
lemma (in monoid_add) listsum_triv: |
3403 |
"(\<Sum>x\<leftarrow>xs. r) = of_nat (length xs) * r" |
|
49962
a8cc904a6820
Renamed {left,right}_distrib to distrib_{right,left}.
webertj
parents:
49808
diff
changeset
|
3404 |
by (induct xs) (simp_all add: distrib_right) |
37605
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
3405 |
|
39774 | 3406 |
lemma (in monoid_add) listsum_0 [simp]: |
3407 |
"(\<Sum>x\<leftarrow>xs. 0) = 0" |
|
49962
a8cc904a6820
Renamed {left,right}_distrib to distrib_{right,left}.
webertj
parents:
49808
diff
changeset
|
3408 |
by (induct xs) (simp_all add: distrib_right) |
37605
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
3409 |
|
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
3410 |
text{* For non-Abelian groups @{text xs} needs to be reversed on one side: *} |
39774 | 3411 |
lemma (in ab_group_add) uminus_listsum_map: |
3412 |
"- listsum (map f xs) = listsum (map (uminus \<circ> f) xs)" |
|
3413 |
by (induct xs) simp_all |
|
3414 |
||
3415 |
lemma (in comm_monoid_add) listsum_addf: |
|
3416 |
"(\<Sum>x\<leftarrow>xs. f x + g x) = listsum (map f xs) + listsum (map g xs)" |
|
3417 |
by (induct xs) (simp_all add: algebra_simps) |
|
3418 |
||
3419 |
lemma (in ab_group_add) listsum_subtractf: |
|
3420 |
"(\<Sum>x\<leftarrow>xs. f x - g x) = listsum (map f xs) - listsum (map g xs)" |
|
3421 |
by (induct xs) (simp_all add: algebra_simps) |
|
3422 |
||
3423 |
lemma (in semiring_0) listsum_const_mult: |
|
3424 |
"(\<Sum>x\<leftarrow>xs. c * f x) = c * (\<Sum>x\<leftarrow>xs. f x)" |
|
3425 |
by (induct xs) (simp_all add: algebra_simps) |
|
3426 |
||
3427 |
lemma (in semiring_0) listsum_mult_const: |
|
3428 |
"(\<Sum>x\<leftarrow>xs. f x * c) = (\<Sum>x\<leftarrow>xs. f x) * c" |
|
3429 |
by (induct xs) (simp_all add: algebra_simps) |
|
3430 |
||
3431 |
lemma (in ordered_ab_group_add_abs) listsum_abs: |
|
3432 |
"\<bar>listsum xs\<bar> \<le> listsum (map abs xs)" |
|
3433 |
by (induct xs) (simp_all add: order_trans [OF abs_triangle_ineq]) |
|
37605
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
3434 |
|
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
3435 |
lemma listsum_mono: |
39774 | 3436 |
fixes f g :: "'a \<Rightarrow> 'b::{monoid_add, ordered_ab_semigroup_add}" |
37605
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
3437 |
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)" |
39774 | 3438 |
by (induct xs) (simp, simp add: add_mono) |
3439 |
||
3440 |
lemma (in monoid_add) listsum_distinct_conv_setsum_set: |
|
37605
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
3441 |
"distinct xs \<Longrightarrow> listsum (map f xs) = setsum f (set xs)" |
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
3442 |
by (induct xs) simp_all |
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
3443 |
|
39774 | 3444 |
lemma (in monoid_add) interv_listsum_conv_setsum_set_nat: |
37605
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
3445 |
"listsum (map f [m..<n]) = setsum f (set [m..<n])" |
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
3446 |
by (simp add: listsum_distinct_conv_setsum_set) |
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
3447 |
|
39774 | 3448 |
lemma (in monoid_add) interv_listsum_conv_setsum_set_int: |
37605
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
3449 |
"listsum (map f [k..l]) = setsum f (set [k..l])" |
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
3450 |
by (simp add: listsum_distinct_conv_setsum_set) |
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
3451 |
|
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
3452 |
text {* General equivalence between @{const listsum} and @{const setsum} *} |
39774 | 3453 |
lemma (in monoid_add) listsum_setsum_nth: |
37605
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
3454 |
"listsum xs = (\<Sum> i = 0 ..< length xs. xs ! i)" |
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
3455 |
using interv_listsum_conv_setsum_set_nat [of "op ! xs" 0 "length xs"] by (simp add: map_nth) |
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
3456 |
|
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
3457 |
|
34978
874150ddd50a
canonical insert operation; generalized lemma foldl_apply_inv to foldl_apply
haftmann
parents:
34942
diff
changeset
|
3458 |
subsubsection {* @{const insert} *} |
874150ddd50a
canonical insert operation; generalized lemma foldl_apply_inv to foldl_apply
haftmann
parents:
34942
diff
changeset
|
3459 |
|
874150ddd50a
canonical insert operation; generalized lemma foldl_apply_inv to foldl_apply
haftmann
parents:
34942
diff
changeset
|
3460 |
lemma in_set_insert [simp]: |
874150ddd50a
canonical insert operation; generalized lemma foldl_apply_inv to foldl_apply
haftmann
parents:
34942
diff
changeset
|
3461 |
"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
|
3462 |
by (simp add: List.insert_def) |
874150ddd50a
canonical insert operation; generalized lemma foldl_apply_inv to foldl_apply
haftmann
parents:
34942
diff
changeset
|
3463 |
|
874150ddd50a
canonical insert operation; generalized lemma foldl_apply_inv to foldl_apply
haftmann
parents:
34942
diff
changeset
|
3464 |
lemma not_in_set_insert [simp]: |
874150ddd50a
canonical insert operation; generalized lemma foldl_apply_inv to foldl_apply
haftmann
parents:
34942
diff
changeset
|
3465 |
"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
|
3466 |
by (simp add: List.insert_def) |
874150ddd50a
canonical insert operation; generalized lemma foldl_apply_inv to foldl_apply
haftmann
parents:
34942
diff
changeset
|
3467 |
|
874150ddd50a
canonical insert operation; generalized lemma foldl_apply_inv to foldl_apply
haftmann
parents:
34942
diff
changeset
|
3468 |
lemma insert_Nil [simp]: |
874150ddd50a
canonical insert operation; generalized lemma foldl_apply_inv to foldl_apply
haftmann
parents:
34942
diff
changeset
|
3469 |
"List.insert x [] = [x]" |
874150ddd50a
canonical insert operation; generalized lemma foldl_apply_inv to foldl_apply
haftmann
parents:
34942
diff
changeset
|
3470 |
by simp |
874150ddd50a
canonical insert operation; generalized lemma foldl_apply_inv to foldl_apply
haftmann
parents:
34942
diff
changeset
|
3471 |
|
35295 | 3472 |
lemma set_insert [simp]: |
34978
874150ddd50a
canonical insert operation; generalized lemma foldl_apply_inv to foldl_apply
haftmann
parents:
34942
diff
changeset
|
3473 |
"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
|
3474 |
by (auto simp add: List.insert_def) |
874150ddd50a
canonical insert operation; generalized lemma foldl_apply_inv to foldl_apply
haftmann
parents:
34942
diff
changeset
|
3475 |
|
35295 | 3476 |
lemma distinct_insert [simp]: |
3477 |
"distinct xs \<Longrightarrow> distinct (List.insert x xs)" |
|
3478 |
by (simp add: List.insert_def) |
|
3479 |
||
36275 | 3480 |
lemma insert_remdups: |
3481 |
"List.insert x (remdups xs) = remdups (List.insert x xs)" |
|
3482 |
by (simp add: List.insert_def) |
|
3483 |
||
34978
874150ddd50a
canonical insert operation; generalized lemma foldl_apply_inv to foldl_apply
haftmann
parents:
34942
diff
changeset
|
3484 |
|
47122 | 3485 |
subsubsection {* @{const List.find} *} |
3486 |
||
3487 |
lemma find_None_iff: "List.find P xs = None \<longleftrightarrow> \<not> (\<exists>x. x \<in> set xs \<and> P x)" |
|
3488 |
proof (induction xs) |
|
3489 |
case Nil thus ?case by simp |
|
3490 |
next |
|
3491 |
case (Cons x xs) thus ?case by (fastforce split: if_splits) |
|
3492 |
qed |
|
3493 |
||
3494 |
lemma find_Some_iff: |
|
3495 |
"List.find P xs = Some x \<longleftrightarrow> |
|
3496 |
(\<exists>i<length xs. P (xs!i) \<and> x = xs!i \<and> (\<forall>j<i. \<not> P (xs!j)))" |
|
3497 |
proof (induction xs) |
|
3498 |
case Nil thus ?case by simp |
|
3499 |
next |
|
3500 |
case (Cons x xs) thus ?case |
|
3501 |
by(auto simp: nth_Cons' split: if_splits) |
|
3502 |
(metis One_nat_def diff_Suc_1 less_Suc_eq_0_disj) |
|
3503 |
qed |
|
3504 |
||
3505 |
lemma find_cong[fundef_cong]: |
|
3506 |
assumes "xs = ys" and "\<And>x. x \<in> set ys \<Longrightarrow> P x = Q x" |
|
3507 |
shows "List.find P xs = List.find Q ys" |
|
3508 |
proof (cases "List.find P xs") |
|
3509 |
case None thus ?thesis by (metis find_None_iff assms) |
|
3510 |
next |
|
3511 |
case (Some x) |
|
3512 |
hence "List.find Q ys = Some x" using assms |
|
3513 |
by (auto simp add: find_Some_iff) |
|
3514 |
thus ?thesis using Some by auto |
|
3515 |
qed |
|
3516 |
||
3517 |
||
3518 |
subsubsection {* @{const remove1} *} |
|
15110
78b5636eabc7
Added a number of new thms and the new function remove1
nipkow
parents:
15072
diff
changeset
|
3519 |
|
18049 | 3520 |
lemma remove1_append: |
3521 |
"remove1 x (xs @ ys) = |
|
3522 |
(if x \<in> set xs then remove1 x xs @ ys else xs @ remove1 x ys)" |
|
3523 |
by (induct xs) auto |
|
3524 |
||
36903 | 3525 |
lemma remove1_commute: "remove1 x (remove1 y zs) = remove1 y (remove1 x zs)" |
3526 |
by (induct zs) auto |
|
3527 |
||
23479 | 3528 |
lemma in_set_remove1[simp]: |
3529 |
"a \<noteq> b \<Longrightarrow> a : set(remove1 b xs) = (a : set xs)" |
|
3530 |
apply (induct xs) |
|
3531 |
apply auto |
|
3532 |
done |
|
3533 |
||
15110
78b5636eabc7
Added a number of new thms and the new function remove1
nipkow
parents:
15072
diff
changeset
|
3534 |
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
|
3535 |
apply(induct xs) |
78b5636eabc7
Added a number of new thms and the new function remove1
nipkow
parents:
15072
diff
changeset
|
3536 |
apply simp |
78b5636eabc7
Added a number of new thms and the new function remove1
nipkow
parents:
15072
diff
changeset
|
3537 |
apply simp |
78b5636eabc7
Added a number of new thms and the new function remove1
nipkow
parents:
15072
diff
changeset
|
3538 |
apply blast |
78b5636eabc7
Added a number of new thms and the new function remove1
nipkow
parents:
15072
diff
changeset
|
3539 |
done |
78b5636eabc7
Added a number of new thms and the new function remove1
nipkow
parents:
15072
diff
changeset
|
3540 |
|
17724 | 3541 |
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
|
3542 |
apply(induct xs) |
78b5636eabc7
Added a number of new thms and the new function remove1
nipkow
parents:
15072
diff
changeset
|
3543 |
apply simp |
78b5636eabc7
Added a number of new thms and the new function remove1
nipkow
parents:
15072
diff
changeset
|
3544 |
apply simp |
78b5636eabc7
Added a number of new thms and the new function remove1
nipkow
parents:
15072
diff
changeset
|
3545 |
apply blast |
78b5636eabc7
Added a number of new thms and the new function remove1
nipkow
parents:
15072
diff
changeset
|
3546 |
done |
78b5636eabc7
Added a number of new thms and the new function remove1
nipkow
parents:
15072
diff
changeset
|
3547 |
|
23479 | 3548 |
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
|
3549 |
"length(remove1 x xs) = (if x : set xs then length xs - 1 else length xs)" |
23479 | 3550 |
apply (induct xs) |
3551 |
apply (auto dest!:length_pos_if_in_set) |
|
3552 |
done |
|
3553 |
||
18049 | 3554 |
lemma remove1_filter_not[simp]: |
3555 |
"\<not> P x \<Longrightarrow> remove1 x (filter P xs) = filter P xs" |
|
3556 |
by(induct xs) auto |
|
3557 |
||
39073 | 3558 |
lemma filter_remove1: |
3559 |
"filter Q (remove1 x xs) = remove1 x (filter Q xs)" |
|
3560 |
by (induct xs) auto |
|
3561 |
||
15110
78b5636eabc7
Added a number of new thms and the new function remove1
nipkow
parents:
15072
diff
changeset
|
3562 |
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
|
3563 |
apply(insert set_remove1_subset) |
78b5636eabc7
Added a number of new thms and the new function remove1
nipkow
parents:
15072
diff
changeset
|
3564 |
apply fast |
78b5636eabc7
Added a number of new thms and the new function remove1
nipkow
parents:
15072
diff
changeset
|
3565 |
done |
78b5636eabc7
Added a number of new thms and the new function remove1
nipkow
parents:
15072
diff
changeset
|
3566 |
|
78b5636eabc7
Added a number of new thms and the new function remove1
nipkow
parents:
15072
diff
changeset
|
3567 |
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
|
3568 |
by (induct xs) simp_all |
78b5636eabc7
Added a number of new thms and the new function remove1
nipkow
parents:
15072
diff
changeset
|
3569 |
|
36275 | 3570 |
lemma remove1_remdups: |
3571 |
"distinct xs \<Longrightarrow> remove1 x (remdups xs) = remdups (remove1 x xs)" |
|
3572 |
by (induct xs) simp_all |
|
3573 |
||
37107 | 3574 |
lemma remove1_idem: |
3575 |
assumes "x \<notin> set xs" |
|
3576 |
shows "remove1 x xs = xs" |
|
3577 |
using assms by (induct xs) simp_all |
|
3578 |
||
13114 | 3579 |
|
49948
744934b818c7
moved quite generic material from theory Enum to more appropriate places
haftmann
parents:
49808
diff
changeset
|
3580 |
subsubsection {* @{const removeAll} *} |
27693 | 3581 |
|
34978
874150ddd50a
canonical insert operation; generalized lemma foldl_apply_inv to foldl_apply
haftmann
parents:
34942
diff
changeset
|
3582 |
lemma removeAll_filter_not_eq: |
874150ddd50a
canonical insert operation; generalized lemma foldl_apply_inv to foldl_apply
haftmann
parents:
34942
diff
changeset
|
3583 |
"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
|
3584 |
proof |
874150ddd50a
canonical insert operation; generalized lemma foldl_apply_inv to foldl_apply
haftmann
parents:
34942
diff
changeset
|
3585 |
fix xs |
874150ddd50a
canonical insert operation; generalized lemma foldl_apply_inv to foldl_apply
haftmann
parents:
34942
diff
changeset
|
3586 |
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
|
3587 |
by (induct xs) auto |
874150ddd50a
canonical insert operation; generalized lemma foldl_apply_inv to foldl_apply
haftmann
parents:
34942
diff
changeset
|
3588 |
qed |
874150ddd50a
canonical insert operation; generalized lemma foldl_apply_inv to foldl_apply
haftmann
parents:
34942
diff
changeset
|
3589 |
|
27693 | 3590 |
lemma removeAll_append[simp]: |
3591 |
"removeAll x (xs @ ys) = removeAll x xs @ removeAll x ys" |
|
3592 |
by (induct xs) auto |
|
3593 |
||
3594 |
lemma set_removeAll[simp]: "set(removeAll x xs) = set xs - {x}" |
|
3595 |
by (induct xs) auto |
|
3596 |
||
3597 |
lemma removeAll_id[simp]: "x \<notin> set xs \<Longrightarrow> removeAll x xs = xs" |
|
3598 |
by (induct xs) auto |
|
3599 |
||
46448
f1201fac7398
more specification of the quotient package in IsarRef
Cezary Kaliszyk <cezarykaliszyk@gmail.com>
parents:
46440
diff
changeset
|
3600 |
(* Needs count:: 'a \<Rightarrow> 'a list \<Rightarrow> nat |
27693 | 3601 |
lemma length_removeAll: |
3602 |
"length(removeAll x xs) = length xs - count x xs" |
|
3603 |
*) |
|
3604 |
||
3605 |
lemma removeAll_filter_not[simp]: |
|
3606 |
"\<not> P x \<Longrightarrow> removeAll x (filter P xs) = filter P xs" |
|
3607 |
by(induct xs) auto |
|
3608 |
||
34978
874150ddd50a
canonical insert operation; generalized lemma foldl_apply_inv to foldl_apply
haftmann
parents:
34942
diff
changeset
|
3609 |
lemma distinct_removeAll: |
874150ddd50a
canonical insert operation; generalized lemma foldl_apply_inv to foldl_apply
haftmann
parents:
34942
diff
changeset
|
3610 |
"distinct xs \<Longrightarrow> distinct (removeAll x xs)" |
874150ddd50a
canonical insert operation; generalized lemma foldl_apply_inv to foldl_apply
haftmann
parents:
34942
diff
changeset
|
3611 |
by (simp add: removeAll_filter_not_eq) |
27693 | 3612 |
|
3613 |
lemma distinct_remove1_removeAll: |
|
3614 |
"distinct xs ==> remove1 x xs = removeAll x xs" |
|
3615 |
by (induct xs) simp_all |
|
3616 |
||
3617 |
lemma map_removeAll_inj_on: "inj_on f (insert x (set xs)) \<Longrightarrow> |
|
3618 |
map f (removeAll x xs) = removeAll (f x) (map f xs)" |
|
3619 |
by (induct xs) (simp_all add:inj_on_def) |
|
3620 |
||
3621 |
lemma map_removeAll_inj: "inj f \<Longrightarrow> |
|
3622 |
map f (removeAll x xs) = removeAll (f x) (map f xs)" |
|
3623 |
by(metis map_removeAll_inj_on subset_inj_on subset_UNIV) |
|
3624 |
||
3625 |
||
49948
744934b818c7
moved quite generic material from theory Enum to more appropriate places
haftmann
parents:
49808
diff
changeset
|
3626 |
subsubsection {* @{const replicate} *} |
13114 | 3627 |
|
13142 | 3628 |
lemma length_replicate [simp]: "length (replicate n x) = n" |
13145 | 3629 |
by (induct n) auto |
13124 | 3630 |
|
36622
e393a91f86df
Generalize swap_inj_on; add simps for Times; add Ex_list_of_length, log_inj; Added missing locale edges for linordered semiring with 1.
hoelzl
parents:
36275
diff
changeset
|
3631 |
lemma Ex_list_of_length: "\<exists>xs. length xs = n" |
e393a91f86df
Generalize swap_inj_on; add simps for Times; add Ex_list_of_length, log_inj; Added missing locale edges for linordered semiring with 1.
hoelzl
parents:
36275
diff
changeset
|
3632 |
by (rule exI[of _ "replicate n undefined"]) simp |
e393a91f86df
Generalize swap_inj_on; add simps for Times; add Ex_list_of_length, log_inj; Added missing locale edges for linordered semiring with 1.
hoelzl
parents:
36275
diff
changeset
|
3633 |
|
13142 | 3634 |
lemma map_replicate [simp]: "map f (replicate n x) = replicate n (f x)" |
13145 | 3635 |
by (induct n) auto |
13114 | 3636 |
|
31363
7493b571b37d
Added theorems about distinct & concat, map & replicate and concat & replicate
hoelzl
parents:
31264
diff
changeset
|
3637 |
lemma map_replicate_const: |
7493b571b37d
Added theorems about distinct & concat, map & replicate and concat & replicate
hoelzl
parents:
31264
diff
changeset
|
3638 |
"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
|
3639 |
by (induct lst) auto |
7493b571b37d
Added theorems about distinct & concat, map & replicate and concat & replicate
hoelzl
parents:
31264
diff
changeset
|
3640 |
|
13114 | 3641 |
lemma replicate_app_Cons_same: |
13145 | 3642 |
"(replicate n x) @ (x # xs) = x # replicate n x @ xs" |
3643 |
by (induct n) auto |
|
13114 | 3644 |
|
13142 | 3645 |
lemma rev_replicate [simp]: "rev (replicate n x) = replicate n x" |
14208 | 3646 |
apply (induct n, simp) |
13145 | 3647 |
apply (simp add: replicate_app_Cons_same) |
3648 |
done |
|
13114 | 3649 |
|
13142 | 3650 |
lemma replicate_add: "replicate (n + m) x = replicate n x @ replicate m x" |
13145 | 3651 |
by (induct n) auto |
13114 | 3652 |
|
16397 | 3653 |
text{* Courtesy of Matthias Daum: *} |
3654 |
lemma append_replicate_commute: |
|
3655 |
"replicate n x @ replicate k x = replicate k x @ replicate n x" |
|
3656 |
apply (simp add: replicate_add [THEN sym]) |
|
3657 |
apply (simp add: add_commute) |
|
3658 |
done |
|
3659 |
||
31080 | 3660 |
text{* Courtesy of Andreas Lochbihler: *} |
3661 |
lemma filter_replicate: |
|
3662 |
"filter P (replicate n x) = (if P x then replicate n x else [])" |
|
3663 |
by(induct n) auto |
|
3664 |
||
13142 | 3665 |
lemma hd_replicate [simp]: "n \<noteq> 0 ==> hd (replicate n x) = x" |
13145 | 3666 |
by (induct n) auto |
13114 | 3667 |
|
46500
0196966d6d2d
removing unnecessary premises in theorems of List theory
bulwahn
parents:
46448
diff
changeset
|
3668 |
lemma tl_replicate [simp]: "tl (replicate n x) = replicate (n - 1) x" |
13145 | 3669 |
by (induct n) auto |
13114 | 3670 |
|
13142 | 3671 |
lemma last_replicate [simp]: "n \<noteq> 0 ==> last (replicate n x) = x" |
13145 | 3672 |
by (atomize (full), induct n) auto |
13114 | 3673 |
|
24526 | 3674 |
lemma nth_replicate[simp]: "i < n ==> (replicate n x)!i = x" |
3675 |
apply (induct n arbitrary: i, simp) |
|
13145 | 3676 |
apply (simp add: nth_Cons split: nat.split) |
3677 |
done |
|
13114 | 3678 |
|
16397 | 3679 |
text{* Courtesy of Matthias Daum (2 lemmas): *} |
3680 |
lemma take_replicate[simp]: "take i (replicate k x) = replicate (min i k) x" |
|
3681 |
apply (case_tac "k \<le> i") |
|
3682 |
apply (simp add: min_def) |
|
3683 |
apply (drule not_leE) |
|
3684 |
apply (simp add: min_def) |
|
3685 |
apply (subgoal_tac "replicate k x = replicate i x @ replicate (k - i) x") |
|
3686 |
apply simp |
|
3687 |
apply (simp add: replicate_add [symmetric]) |
|
3688 |
done |
|
3689 |
||
24526 | 3690 |
lemma drop_replicate[simp]: "drop i (replicate k x) = replicate (k-i) x" |
3691 |
apply (induct k arbitrary: i) |
|
16397 | 3692 |
apply simp |
3693 |
apply clarsimp |
|
3694 |
apply (case_tac i) |
|
3695 |
apply simp |
|
3696 |
apply clarsimp |
|
3697 |
done |
|
3698 |
||
3699 |
||
13142 | 3700 |
lemma set_replicate_Suc: "set (replicate (Suc n) x) = {x}" |
13145 | 3701 |
by (induct n) auto |
13114 | 3702 |
|
13142 | 3703 |
lemma set_replicate [simp]: "n \<noteq> 0 ==> set (replicate n x) = {x}" |
13145 | 3704 |
by (fast dest!: not0_implies_Suc intro!: set_replicate_Suc) |
13114 | 3705 |
|
13142 | 3706 |
lemma set_replicate_conv_if: "set (replicate n x) = (if n = 0 then {} else {x})" |
13145 | 3707 |
by auto |
13114 | 3708 |
|
37456 | 3709 |
lemma in_set_replicate[simp]: "(x : set (replicate n y)) = (x = y & n \<noteq> 0)" |
3710 |
by (simp add: set_replicate_conv_if) |
|
3711 |
||
37454 | 3712 |
lemma Ball_set_replicate[simp]: |
3713 |
"(ALL x : set(replicate n a). P x) = (P a | n=0)" |
|
3714 |
by(simp add: set_replicate_conv_if) |
|
3715 |
||
3716 |
lemma Bex_set_replicate[simp]: |
|
3717 |
"(EX x : set(replicate n a). P x) = (P a & n\<noteq>0)" |
|
3718 |
by(simp add: set_replicate_conv_if) |
|
13114 | 3719 |
|
24796 | 3720 |
lemma replicate_append_same: |
3721 |
"replicate i x @ [x] = x # replicate i x" |
|
3722 |
by (induct i) simp_all |
|
3723 |
||
3724 |
lemma map_replicate_trivial: |
|
3725 |
"map (\<lambda>i. x) [0..<i] = replicate i x" |
|
3726 |
by (induct i) (simp_all add: replicate_append_same) |
|
3727 |
||
31363
7493b571b37d
Added theorems about distinct & concat, map & replicate and concat & replicate
hoelzl
parents:
31264
diff
changeset
|
3728 |
lemma concat_replicate_trivial[simp]: |
7493b571b37d
Added theorems about distinct & concat, map & replicate and concat & replicate
hoelzl
parents:
31264
diff
changeset
|
3729 |
"concat (replicate i []) = []" |
7493b571b37d
Added theorems about distinct & concat, map & replicate and concat & replicate
hoelzl
parents:
31264
diff
changeset
|
3730 |
by (induct i) (auto simp add: map_replicate_const) |
13114 | 3731 |
|
28642 | 3732 |
lemma replicate_empty[simp]: "(replicate n x = []) \<longleftrightarrow> n=0" |
3733 |
by (induct n) auto |
|
3734 |
||
3735 |
lemma empty_replicate[simp]: "([] = replicate n x) \<longleftrightarrow> n=0" |
|
3736 |
by (induct n) auto |
|
3737 |
||
3738 |
lemma replicate_eq_replicate[simp]: |
|
3739 |
"(replicate m x = replicate n y) \<longleftrightarrow> (m=n & (m\<noteq>0 \<longrightarrow> x=y))" |
|
3740 |
apply(induct m arbitrary: n) |
|
3741 |
apply simp |
|
3742 |
apply(induct_tac n) |
|
3743 |
apply auto |
|
3744 |
done |
|
3745 |
||
39534
c798d4f1b682
generalized lemma insort_remove1 to insort_key_remove1
haftmann
parents:
39302
diff
changeset
|
3746 |
lemma replicate_length_filter: |
c798d4f1b682
generalized lemma insort_remove1 to insort_key_remove1
haftmann
parents:
39302
diff
changeset
|
3747 |
"replicate (length (filter (\<lambda>y. x = y) xs)) x = filter (\<lambda>y. x = y) xs" |
c798d4f1b682
generalized lemma insort_remove1 to insort_key_remove1
haftmann
parents:
39302
diff
changeset
|
3748 |
by (induct xs) auto |
c798d4f1b682
generalized lemma insort_remove1 to insort_key_remove1
haftmann
parents:
39302
diff
changeset
|
3749 |
|
42714
fcba668b0839
add a lemma about commutative append to List.thy
noschinl
parents:
42713
diff
changeset
|
3750 |
lemma comm_append_are_replicate: |
fcba668b0839
add a lemma about commutative append to List.thy
noschinl
parents:
42713
diff
changeset
|
3751 |
fixes xs ys :: "'a list" |
fcba668b0839
add a lemma about commutative append to List.thy
noschinl
parents:
42713
diff
changeset
|
3752 |
assumes "xs \<noteq> []" "ys \<noteq> []" |
fcba668b0839
add a lemma about commutative append to List.thy
noschinl
parents:
42713
diff
changeset
|
3753 |
assumes "xs @ ys = ys @ xs" |
fcba668b0839
add a lemma about commutative append to List.thy
noschinl
parents:
42713
diff
changeset
|
3754 |
shows "\<exists>m n zs. concat (replicate m zs) = xs \<and> concat (replicate n zs) = ys" |
fcba668b0839
add a lemma about commutative append to List.thy
noschinl
parents:
42713
diff
changeset
|
3755 |
using assms |
fcba668b0839
add a lemma about commutative append to List.thy
noschinl
parents:
42713
diff
changeset
|
3756 |
proof (induct "length (xs @ ys)" arbitrary: xs ys rule: less_induct) |
fcba668b0839
add a lemma about commutative append to List.thy
noschinl
parents:
42713
diff
changeset
|
3757 |
case less |
fcba668b0839
add a lemma about commutative append to List.thy
noschinl
parents:
42713
diff
changeset
|
3758 |
|
fcba668b0839
add a lemma about commutative append to List.thy
noschinl
parents:
42713
diff
changeset
|
3759 |
def xs' \<equiv> "if (length xs \<le> length ys) then xs else ys" |
fcba668b0839
add a lemma about commutative append to List.thy
noschinl
parents:
42713
diff
changeset
|
3760 |
and ys' \<equiv> "if (length xs \<le> length ys) then ys else xs" |
fcba668b0839
add a lemma about commutative append to List.thy
noschinl
parents:
42713
diff
changeset
|
3761 |
then have |
fcba668b0839
add a lemma about commutative append to List.thy
noschinl
parents:
42713
diff
changeset
|
3762 |
prems': "length xs' \<le> length ys'" |
fcba668b0839
add a lemma about commutative append to List.thy
noschinl
parents:
42713
diff
changeset
|
3763 |
"xs' @ ys' = ys' @ xs'" |
fcba668b0839
add a lemma about commutative append to List.thy
noschinl
parents:
42713
diff
changeset
|
3764 |
and "xs' \<noteq> []" |
fcba668b0839
add a lemma about commutative append to List.thy
noschinl
parents:
42713
diff
changeset
|
3765 |
and len: "length (xs @ ys) = length (xs' @ ys')" |
fcba668b0839
add a lemma about commutative append to List.thy
noschinl
parents:
42713
diff
changeset
|
3766 |
using less by (auto intro: less.hyps) |
fcba668b0839
add a lemma about commutative append to List.thy
noschinl
parents:
42713
diff
changeset
|
3767 |
|
fcba668b0839
add a lemma about commutative append to List.thy
noschinl
parents:
42713
diff
changeset
|
3768 |
from prems' |
fcba668b0839
add a lemma about commutative append to List.thy
noschinl
parents:
42713
diff
changeset
|
3769 |
obtain ws where "ys' = xs' @ ws" |
fcba668b0839
add a lemma about commutative append to List.thy
noschinl
parents:
42713
diff
changeset
|
3770 |
by (auto simp: append_eq_append_conv2) |
fcba668b0839
add a lemma about commutative append to List.thy
noschinl
parents:
42713
diff
changeset
|
3771 |
|
fcba668b0839
add a lemma about commutative append to List.thy
noschinl
parents:
42713
diff
changeset
|
3772 |
have "\<exists>m n zs. concat (replicate m zs) = xs' \<and> concat (replicate n zs) = ys'" |
fcba668b0839
add a lemma about commutative append to List.thy
noschinl
parents:
42713
diff
changeset
|
3773 |
proof (cases "ws = []") |
fcba668b0839
add a lemma about commutative append to List.thy
noschinl
parents:
42713
diff
changeset
|
3774 |
case True |
fcba668b0839
add a lemma about commutative append to List.thy
noschinl
parents:
42713
diff
changeset
|
3775 |
then have "concat (replicate 1 xs') = xs'" |
fcba668b0839
add a lemma about commutative append to List.thy
noschinl
parents:
42713
diff
changeset
|
3776 |
and "concat (replicate 1 xs') = ys'" |
fcba668b0839
add a lemma about commutative append to List.thy
noschinl
parents:
42713
diff
changeset
|
3777 |
using `ys' = xs' @ ws` by auto |
fcba668b0839
add a lemma about commutative append to List.thy
noschinl
parents:
42713
diff
changeset
|
3778 |
then show ?thesis by blast |
fcba668b0839
add a lemma about commutative append to List.thy
noschinl
parents:
42713
diff
changeset
|
3779 |
next |
fcba668b0839
add a lemma about commutative append to List.thy
noschinl
parents:
42713
diff
changeset
|
3780 |
case False |
fcba668b0839
add a lemma about commutative append to List.thy
noschinl
parents:
42713
diff
changeset
|
3781 |
from `ys' = xs' @ ws` and `xs' @ ys' = ys' @ xs'` |
fcba668b0839
add a lemma about commutative append to List.thy
noschinl
parents:
42713
diff
changeset
|
3782 |
have "xs' @ ws = ws @ xs'" by simp |
fcba668b0839
add a lemma about commutative append to List.thy
noschinl
parents:
42713
diff
changeset
|
3783 |
then have "\<exists>m n zs. concat (replicate m zs) = xs' \<and> concat (replicate n zs) = ws" |
fcba668b0839
add a lemma about commutative append to List.thy
noschinl
parents:
42713
diff
changeset
|
3784 |
using False and `xs' \<noteq> []` and `ys' = xs' @ ws` and len |
fcba668b0839
add a lemma about commutative append to List.thy
noschinl
parents:
42713
diff
changeset
|
3785 |
by (intro less.hyps) auto |
fcba668b0839
add a lemma about commutative append to List.thy
noschinl
parents:
42713
diff
changeset
|
3786 |
then obtain m n zs where "concat (replicate m zs) = xs'" |
fcba668b0839
add a lemma about commutative append to List.thy
noschinl
parents:
42713
diff
changeset
|
3787 |
and "concat (replicate n zs) = ws" by blast |
fcba668b0839
add a lemma about commutative append to List.thy
noschinl
parents:
42713
diff
changeset
|
3788 |
moreover |
fcba668b0839
add a lemma about commutative append to List.thy
noschinl
parents:
42713
diff
changeset
|
3789 |
then have "concat (replicate (m + n) zs) = ys'" |
fcba668b0839
add a lemma about commutative append to List.thy
noschinl
parents:
42713
diff
changeset
|
3790 |
using `ys' = xs' @ ws` |
fcba668b0839
add a lemma about commutative append to List.thy
noschinl
parents:
42713
diff
changeset
|
3791 |
by (simp add: replicate_add) |
fcba668b0839
add a lemma about commutative append to List.thy
noschinl
parents:
42713
diff
changeset
|
3792 |
ultimately |
fcba668b0839
add a lemma about commutative append to List.thy
noschinl
parents:
42713
diff
changeset
|
3793 |
show ?thesis by blast |
fcba668b0839
add a lemma about commutative append to List.thy
noschinl
parents:
42713
diff
changeset
|
3794 |
qed |
fcba668b0839
add a lemma about commutative append to List.thy
noschinl
parents:
42713
diff
changeset
|
3795 |
then show ?case |
fcba668b0839
add a lemma about commutative append to List.thy
noschinl
parents:
42713
diff
changeset
|
3796 |
using xs'_def ys'_def by metis |
fcba668b0839
add a lemma about commutative append to List.thy
noschinl
parents:
42713
diff
changeset
|
3797 |
qed |
fcba668b0839
add a lemma about commutative append to List.thy
noschinl
parents:
42713
diff
changeset
|
3798 |
|
fcba668b0839
add a lemma about commutative append to List.thy
noschinl
parents:
42713
diff
changeset
|
3799 |
lemma comm_append_is_replicate: |
fcba668b0839
add a lemma about commutative append to List.thy
noschinl
parents:
42713
diff
changeset
|
3800 |
fixes xs ys :: "'a list" |
fcba668b0839
add a lemma about commutative append to List.thy
noschinl
parents:
42713
diff
changeset
|
3801 |
assumes "xs \<noteq> []" "ys \<noteq> []" |
fcba668b0839
add a lemma about commutative append to List.thy
noschinl
parents:
42713
diff
changeset
|
3802 |
assumes "xs @ ys = ys @ xs" |
fcba668b0839
add a lemma about commutative append to List.thy
noschinl
parents:
42713
diff
changeset
|
3803 |
shows "\<exists>n zs. n > 1 \<and> concat (replicate n zs) = xs @ ys" |
fcba668b0839
add a lemma about commutative append to List.thy
noschinl
parents:
42713
diff
changeset
|
3804 |
|
fcba668b0839
add a lemma about commutative append to List.thy
noschinl
parents:
42713
diff
changeset
|
3805 |
proof - |
fcba668b0839
add a lemma about commutative append to List.thy
noschinl
parents:
42713
diff
changeset
|
3806 |
obtain m n zs where "concat (replicate m zs) = xs" |
fcba668b0839
add a lemma about commutative append to List.thy
noschinl
parents:
42713
diff
changeset
|
3807 |
and "concat (replicate n zs) = ys" |
fcba668b0839
add a lemma about commutative append to List.thy
noschinl
parents:
42713
diff
changeset
|
3808 |
using assms by (metis comm_append_are_replicate) |
fcba668b0839
add a lemma about commutative append to List.thy
noschinl
parents:
42713
diff
changeset
|
3809 |
then have "m + n > 1" and "concat (replicate (m+n) zs) = xs @ ys" |
fcba668b0839
add a lemma about commutative append to List.thy
noschinl
parents:
42713
diff
changeset
|
3810 |
using `xs \<noteq> []` and `ys \<noteq> []` |
fcba668b0839
add a lemma about commutative append to List.thy
noschinl
parents:
42713
diff
changeset
|
3811 |
by (auto simp: replicate_add) |
fcba668b0839
add a lemma about commutative append to List.thy
noschinl
parents:
42713
diff
changeset
|
3812 |
then show ?thesis by blast |
fcba668b0839
add a lemma about commutative append to List.thy
noschinl
parents:
42713
diff
changeset
|
3813 |
qed |
fcba668b0839
add a lemma about commutative append to List.thy
noschinl
parents:
42713
diff
changeset
|
3814 |
|
28642 | 3815 |
|
49948
744934b818c7
moved quite generic material from theory Enum to more appropriate places
haftmann
parents:
49808
diff
changeset
|
3816 |
subsubsection {* @{const rotate1} and @{const rotate} *} |
15302 | 3817 |
|
3818 |
lemma rotate0[simp]: "rotate 0 = id" |
|
3819 |
by(simp add:rotate_def) |
|
3820 |
||
3821 |
lemma rotate_Suc[simp]: "rotate (Suc n) xs = rotate1(rotate n xs)" |
|
3822 |
by(simp add:rotate_def) |
|
3823 |
||
3824 |
lemma rotate_add: |
|
3825 |
"rotate (m+n) = rotate m o rotate n" |
|
3826 |
by(simp add:rotate_def funpow_add) |
|
3827 |
||
3828 |
lemma rotate_rotate: "rotate m (rotate n xs) = rotate (m+n) xs" |
|
3829 |
by(simp add:rotate_add) |
|
3830 |
||
18049 | 3831 |
lemma rotate1_rotate_swap: "rotate1 (rotate n xs) = rotate n (rotate1 xs)" |
3832 |
by(simp add:rotate_def funpow_swap1) |
|
3833 |
||
15302 | 3834 |
lemma rotate1_length01[simp]: "length xs <= 1 \<Longrightarrow> rotate1 xs = xs" |
3835 |
by(cases xs) simp_all |
|
3836 |
||
3837 |
lemma rotate_length01[simp]: "length xs <= 1 \<Longrightarrow> rotate n xs = xs" |
|
3838 |
apply(induct n) |
|
3839 |
apply simp |
|
3840 |
apply (simp add:rotate_def) |
|
13145 | 3841 |
done |
13114 | 3842 |
|
15302 | 3843 |
lemma rotate1_hd_tl: "xs \<noteq> [] \<Longrightarrow> rotate1 xs = tl xs @ [hd xs]" |
46440
d4994e2e7364
use 'primrec' to define "rotate1", for uniformity (and to help first-order tools that rely on "Spec_Rules")
blanchet
parents:
46439
diff
changeset
|
3844 |
by (cases xs) simp_all |
15302 | 3845 |
|
3846 |
lemma rotate_drop_take: |
|
3847 |
"rotate n xs = drop (n mod length xs) xs @ take (n mod length xs) xs" |
|
3848 |
apply(induct n) |
|
3849 |
apply simp |
|
3850 |
apply(simp add:rotate_def) |
|
3851 |
apply(cases "xs = []") |
|
3852 |
apply (simp) |
|
3853 |
apply(case_tac "n mod length xs = 0") |
|
3854 |
apply(simp add:mod_Suc) |
|
3855 |
apply(simp add: rotate1_hd_tl drop_Suc take_Suc) |
|
3856 |
apply(simp add:mod_Suc rotate1_hd_tl drop_Suc[symmetric] drop_tl[symmetric] |
|
3857 |
take_hd_drop linorder_not_le) |
|
13145 | 3858 |
done |
13114 | 3859 |
|
15302 | 3860 |
lemma rotate_conv_mod: "rotate n xs = rotate (n mod length xs) xs" |
3861 |
by(simp add:rotate_drop_take) |
|
3862 |
||
3863 |
lemma rotate_id[simp]: "n mod length xs = 0 \<Longrightarrow> rotate n xs = xs" |
|
3864 |
by(simp add:rotate_drop_take) |
|
3865 |
||
3866 |
lemma length_rotate1[simp]: "length(rotate1 xs) = length xs" |
|
46440
d4994e2e7364
use 'primrec' to define "rotate1", for uniformity (and to help first-order tools that rely on "Spec_Rules")
blanchet
parents:
46439
diff
changeset
|
3867 |
by (cases xs) simp_all |
15302 | 3868 |
|
24526 | 3869 |
lemma length_rotate[simp]: "length(rotate n xs) = length xs" |
3870 |
by (induct n arbitrary: xs) (simp_all add:rotate_def) |
|
15302 | 3871 |
|
3872 |
lemma distinct1_rotate[simp]: "distinct(rotate1 xs) = distinct xs" |
|
46440
d4994e2e7364
use 'primrec' to define "rotate1", for uniformity (and to help first-order tools that rely on "Spec_Rules")
blanchet
parents:
46439
diff
changeset
|
3873 |
by (cases xs) auto |
15302 | 3874 |
|
3875 |
lemma distinct_rotate[simp]: "distinct(rotate n xs) = distinct xs" |
|
3876 |
by (induct n) (simp_all add:rotate_def) |
|
3877 |
||
3878 |
lemma rotate_map: "rotate n (map f xs) = map f (rotate n xs)" |
|
3879 |
by(simp add:rotate_drop_take take_map drop_map) |
|
3880 |
||
3881 |
lemma set_rotate1[simp]: "set(rotate1 xs) = set xs" |
|
46440
d4994e2e7364
use 'primrec' to define "rotate1", for uniformity (and to help first-order tools that rely on "Spec_Rules")
blanchet
parents:
46439
diff
changeset
|
3882 |
by (cases xs) auto |
15302 | 3883 |
|
3884 |
lemma set_rotate[simp]: "set(rotate n xs) = set xs" |
|
3885 |
by (induct n) (simp_all add:rotate_def) |
|
3886 |
||
3887 |
lemma rotate1_is_Nil_conv[simp]: "(rotate1 xs = []) = (xs = [])" |
|
46440
d4994e2e7364
use 'primrec' to define "rotate1", for uniformity (and to help first-order tools that rely on "Spec_Rules")
blanchet
parents:
46439
diff
changeset
|
3888 |
by (cases xs) auto |
15302 | 3889 |
|
3890 |
lemma rotate_is_Nil_conv[simp]: "(rotate n xs = []) = (xs = [])" |
|
3891 |
by (induct n) (simp_all add:rotate_def) |
|
13114 | 3892 |
|
15439 | 3893 |
lemma rotate_rev: |
3894 |
"rotate n (rev xs) = rev(rotate (length xs - (n mod length xs)) xs)" |
|
3895 |
apply(simp add:rotate_drop_take rev_drop rev_take) |
|
3896 |
apply(cases "length xs = 0") |
|
3897 |
apply simp |
|
3898 |
apply(cases "n mod length xs = 0") |
|
3899 |
apply simp |
|
3900 |
apply(simp add:rotate_drop_take rev_drop rev_take) |
|
3901 |
done |
|
3902 |
||
18423 | 3903 |
lemma hd_rotate_conv_nth: "xs \<noteq> [] \<Longrightarrow> hd(rotate n xs) = xs!(n mod length xs)" |
3904 |
apply(simp add:rotate_drop_take hd_append hd_drop_conv_nth hd_conv_nth) |
|
3905 |
apply(subgoal_tac "length xs \<noteq> 0") |
|
3906 |
prefer 2 apply simp |
|
3907 |
using mod_less_divisor[of "length xs" n] by arith |
|
3908 |
||
13114 | 3909 |
|
49948
744934b818c7
moved quite generic material from theory Enum to more appropriate places
haftmann
parents:
49808
diff
changeset
|
3910 |
subsubsection {* @{const sublist} --- a generalization of @{const nth} to sets *} |
13114 | 3911 |
|
13142 | 3912 |
lemma sublist_empty [simp]: "sublist xs {} = []" |
13145 | 3913 |
by (auto simp add: sublist_def) |
13114 | 3914 |
|
13142 | 3915 |
lemma sublist_nil [simp]: "sublist [] A = []" |
13145 | 3916 |
by (auto simp add: sublist_def) |
13114 | 3917 |
|
15281 | 3918 |
lemma length_sublist: |
3919 |
"length(sublist xs I) = card{i. i < length xs \<and> i : I}" |
|
3920 |
by(simp add: sublist_def length_filter_conv_card cong:conj_cong) |
|
3921 |
||
3922 |
lemma sublist_shift_lemma_Suc: |
|
24526 | 3923 |
"map fst (filter (%p. P(Suc(snd p))) (zip xs is)) = |
3924 |
map fst (filter (%p. P(snd p)) (zip xs (map Suc is)))" |
|
3925 |
apply(induct xs arbitrary: "is") |
|
15281 | 3926 |
apply simp |
3927 |
apply (case_tac "is") |
|
3928 |
apply simp |
|
3929 |
apply simp |
|
3930 |
done |
|
3931 |
||
13114 | 3932 |
lemma sublist_shift_lemma: |
23279
e39dd93161d9
tuned list comprehension, changed filter syntax from : to <-
nipkow
parents:
23246
diff
changeset
|
3933 |
"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
|
3934 |
map fst [p<-zip xs [0..<length xs] . snd p + i : A]" |
13145 | 3935 |
by (induct xs rule: rev_induct) (simp_all add: add_commute) |
13114 | 3936 |
|
3937 |
lemma sublist_append: |
|
15168 | 3938 |
"sublist (l @ l') A = sublist l A @ sublist l' {j. j + length l : A}" |
13145 | 3939 |
apply (unfold sublist_def) |
14208 | 3940 |
apply (induct l' rule: rev_induct, simp) |
44921 | 3941 |
apply (simp add: upt_add_eq_append[of 0] sublist_shift_lemma) |
13145 | 3942 |
apply (simp add: add_commute) |
3943 |
done |
|
13114 | 3944 |
|
3945 |
lemma sublist_Cons: |
|
13145 | 3946 |
"sublist (x # l) A = (if 0:A then [x] else []) @ sublist l {j. Suc j : A}" |
3947 |
apply (induct l rule: rev_induct) |
|
3948 |
apply (simp add: sublist_def) |
|
3949 |
apply (simp del: append_Cons add: append_Cons[symmetric] sublist_append) |
|
3950 |
done |
|
13114 | 3951 |
|
24526 | 3952 |
lemma set_sublist: "set(sublist xs I) = {xs!i|i. i<size xs \<and> i \<in> I}" |
3953 |
apply(induct xs arbitrary: I) |
|
25162 | 3954 |
apply(auto simp: sublist_Cons nth_Cons split:nat.split dest!: gr0_implies_Suc) |
15281 | 3955 |
done |
3956 |
||
3957 |
lemma set_sublist_subset: "set(sublist xs I) \<subseteq> set xs" |
|
3958 |
by(auto simp add:set_sublist) |
|
3959 |
||
3960 |
lemma notin_set_sublistI[simp]: "x \<notin> set xs \<Longrightarrow> x \<notin> set(sublist xs I)" |
|
3961 |
by(auto simp add:set_sublist) |
|
3962 |
||
3963 |
lemma in_set_sublistD: "x \<in> set(sublist xs I) \<Longrightarrow> x \<in> set xs" |
|
3964 |
by(auto simp add:set_sublist) |
|
3965 |
||
13142 | 3966 |
lemma sublist_singleton [simp]: "sublist [x] A = (if 0 : A then [x] else [])" |
13145 | 3967 |
by (simp add: sublist_Cons) |
13114 | 3968 |
|
15281 | 3969 |
|
24526 | 3970 |
lemma distinct_sublistI[simp]: "distinct xs \<Longrightarrow> distinct(sublist xs I)" |
3971 |
apply(induct xs arbitrary: I) |
|
15281 | 3972 |
apply simp |
3973 |
apply(auto simp add:sublist_Cons) |
|
3974 |
done |
|
3975 |
||
3976 |
||
15045 | 3977 |
lemma sublist_upt_eq_take [simp]: "sublist l {..<n} = take n l" |
14208 | 3978 |
apply (induct l rule: rev_induct, simp) |
13145 | 3979 |
apply (simp split: nat_diff_split add: sublist_append) |
3980 |
done |
|
13114 | 3981 |
|
24526 | 3982 |
lemma filter_in_sublist: |
3983 |
"distinct xs \<Longrightarrow> filter (%x. x \<in> set(sublist xs s)) xs = sublist xs s" |
|
3984 |
proof (induct xs arbitrary: s) |
|
17501 | 3985 |
case Nil thus ?case by simp |
3986 |
next |
|
3987 |
case (Cons a xs) |
|
3988 |
moreover hence "!x. x: set xs \<longrightarrow> x \<noteq> a" by auto |
|
3989 |
ultimately show ?case by(simp add: sublist_Cons cong:filter_cong) |
|
3990 |
qed |
|
3991 |
||
13114 | 3992 |
|
49948
744934b818c7
moved quite generic material from theory Enum to more appropriate places
haftmann
parents:
49808
diff
changeset
|
3993 |
subsubsection {* @{const sublists} and @{const List.n_lists} *} |
744934b818c7
moved quite generic material from theory Enum to more appropriate places
haftmann
parents:
49808
diff
changeset
|
3994 |
|
744934b818c7
moved quite generic material from theory Enum to more appropriate places
haftmann
parents:
49808
diff
changeset
|
3995 |
lemma length_sublists: |
744934b818c7
moved quite generic material from theory Enum to more appropriate places
haftmann
parents:
49808
diff
changeset
|
3996 |
"length (sublists xs) = 2 ^ length xs" |
744934b818c7
moved quite generic material from theory Enum to more appropriate places
haftmann
parents:
49808
diff
changeset
|
3997 |
by (induct xs) (simp_all add: Let_def) |
744934b818c7
moved quite generic material from theory Enum to more appropriate places
haftmann
parents:
49808
diff
changeset
|
3998 |
|
744934b818c7
moved quite generic material from theory Enum to more appropriate places
haftmann
parents:
49808
diff
changeset
|
3999 |
lemma sublists_powset: |
744934b818c7
moved quite generic material from theory Enum to more appropriate places
haftmann
parents:
49808
diff
changeset
|
4000 |
"set ` set (sublists xs) = Pow (set xs)" |
744934b818c7
moved quite generic material from theory Enum to more appropriate places
haftmann
parents:
49808
diff
changeset
|
4001 |
proof - |
744934b818c7
moved quite generic material from theory Enum to more appropriate places
haftmann
parents:
49808
diff
changeset
|
4002 |
have aux: "\<And>x A. set ` Cons x ` A = insert x ` set ` A" |
744934b818c7
moved quite generic material from theory Enum to more appropriate places
haftmann
parents:
49808
diff
changeset
|
4003 |
by (auto simp add: image_def) |
744934b818c7
moved quite generic material from theory Enum to more appropriate places
haftmann
parents:
49808
diff
changeset
|
4004 |
have "set (map set (sublists xs)) = Pow (set xs)" |
744934b818c7
moved quite generic material from theory Enum to more appropriate places
haftmann
parents:
49808
diff
changeset
|
4005 |
by (induct xs) |
744934b818c7
moved quite generic material from theory Enum to more appropriate places
haftmann
parents:
49808
diff
changeset
|
4006 |
(simp_all add: aux Let_def Pow_insert Un_commute comp_def del: map_map) |
744934b818c7
moved quite generic material from theory Enum to more appropriate places
haftmann
parents:
49808
diff
changeset
|
4007 |
then show ?thesis by simp |
744934b818c7
moved quite generic material from theory Enum to more appropriate places
haftmann
parents:
49808
diff
changeset
|
4008 |
qed |
744934b818c7
moved quite generic material from theory Enum to more appropriate places
haftmann
parents:
49808
diff
changeset
|
4009 |
|
744934b818c7
moved quite generic material from theory Enum to more appropriate places
haftmann
parents:
49808
diff
changeset
|
4010 |
lemma distinct_set_sublists: |
744934b818c7
moved quite generic material from theory Enum to more appropriate places
haftmann
parents:
49808
diff
changeset
|
4011 |
assumes "distinct xs" |
744934b818c7
moved quite generic material from theory Enum to more appropriate places
haftmann
parents:
49808
diff
changeset
|
4012 |
shows "distinct (map set (sublists xs))" |
744934b818c7
moved quite generic material from theory Enum to more appropriate places
haftmann
parents:
49808
diff
changeset
|
4013 |
proof (rule card_distinct) |
744934b818c7
moved quite generic material from theory Enum to more appropriate places
haftmann
parents:
49808
diff
changeset
|
4014 |
have "finite (set xs)" by rule |
744934b818c7
moved quite generic material from theory Enum to more appropriate places
haftmann
parents:
49808
diff
changeset
|
4015 |
then have "card (Pow (set xs)) = 2 ^ card (set xs)" by (rule card_Pow) |
744934b818c7
moved quite generic material from theory Enum to more appropriate places
haftmann
parents:
49808
diff
changeset
|
4016 |
with assms distinct_card [of xs] |
744934b818c7
moved quite generic material from theory Enum to more appropriate places
haftmann
parents:
49808
diff
changeset
|
4017 |
have "card (Pow (set xs)) = 2 ^ length xs" by simp |
744934b818c7
moved quite generic material from theory Enum to more appropriate places
haftmann
parents:
49808
diff
changeset
|
4018 |
then show "card (set (map set (sublists xs))) = length (map set (sublists xs))" |
744934b818c7
moved quite generic material from theory Enum to more appropriate places
haftmann
parents:
49808
diff
changeset
|
4019 |
by (simp add: sublists_powset length_sublists) |
744934b818c7
moved quite generic material from theory Enum to more appropriate places
haftmann
parents:
49808
diff
changeset
|
4020 |
qed |
744934b818c7
moved quite generic material from theory Enum to more appropriate places
haftmann
parents:
49808
diff
changeset
|
4021 |
|
744934b818c7
moved quite generic material from theory Enum to more appropriate places
haftmann
parents:
49808
diff
changeset
|
4022 |
lemma n_lists_Nil [simp]: "List.n_lists n [] = (if n = 0 then [[]] else [])" |
744934b818c7
moved quite generic material from theory Enum to more appropriate places
haftmann
parents:
49808
diff
changeset
|
4023 |
by (induct n) simp_all |
744934b818c7
moved quite generic material from theory Enum to more appropriate places
haftmann
parents:
49808
diff
changeset
|
4024 |
|
744934b818c7
moved quite generic material from theory Enum to more appropriate places
haftmann
parents:
49808
diff
changeset
|
4025 |
lemma length_n_lists: "length (List.n_lists n xs) = length xs ^ n" |
744934b818c7
moved quite generic material from theory Enum to more appropriate places
haftmann
parents:
49808
diff
changeset
|
4026 |
by (induct n) (auto simp add: length_concat o_def listsum_triv) |
744934b818c7
moved quite generic material from theory Enum to more appropriate places
haftmann
parents:
49808
diff
changeset
|
4027 |
|
744934b818c7
moved quite generic material from theory Enum to more appropriate places
haftmann
parents:
49808
diff
changeset
|
4028 |
lemma length_n_lists_elem: "ys \<in> set (List.n_lists n xs) \<Longrightarrow> length ys = n" |
744934b818c7
moved quite generic material from theory Enum to more appropriate places
haftmann
parents:
49808
diff
changeset
|
4029 |
by (induct n arbitrary: ys) auto |
744934b818c7
moved quite generic material from theory Enum to more appropriate places
haftmann
parents:
49808
diff
changeset
|
4030 |
|
744934b818c7
moved quite generic material from theory Enum to more appropriate places
haftmann
parents:
49808
diff
changeset
|
4031 |
lemma set_n_lists: "set (List.n_lists n xs) = {ys. length ys = n \<and> set ys \<subseteq> set xs}" |
744934b818c7
moved quite generic material from theory Enum to more appropriate places
haftmann
parents:
49808
diff
changeset
|
4032 |
proof (rule set_eqI) |
744934b818c7
moved quite generic material from theory Enum to more appropriate places
haftmann
parents:
49808
diff
changeset
|
4033 |
fix ys :: "'a list" |
744934b818c7
moved quite generic material from theory Enum to more appropriate places
haftmann
parents:
49808
diff
changeset
|
4034 |
show "ys \<in> set (List.n_lists n xs) \<longleftrightarrow> ys \<in> {ys. length ys = n \<and> set ys \<subseteq> set xs}" |
744934b818c7
moved quite generic material from theory Enum to more appropriate places
haftmann
parents:
49808
diff
changeset
|
4035 |
proof - |
744934b818c7
moved quite generic material from theory Enum to more appropriate places
haftmann
parents:
49808
diff
changeset
|
4036 |
have "ys \<in> set (List.n_lists n xs) \<Longrightarrow> length ys = n" |
744934b818c7
moved quite generic material from theory Enum to more appropriate places
haftmann
parents:
49808
diff
changeset
|
4037 |
by (induct n arbitrary: ys) auto |
744934b818c7
moved quite generic material from theory Enum to more appropriate places
haftmann
parents:
49808
diff
changeset
|
4038 |
moreover have "\<And>x. ys \<in> set (List.n_lists n xs) \<Longrightarrow> x \<in> set ys \<Longrightarrow> x \<in> set xs" |
744934b818c7
moved quite generic material from theory Enum to more appropriate places
haftmann
parents:
49808
diff
changeset
|
4039 |
by (induct n arbitrary: ys) auto |
744934b818c7
moved quite generic material from theory Enum to more appropriate places
haftmann
parents:
49808
diff
changeset
|
4040 |
moreover have "set ys \<subseteq> set xs \<Longrightarrow> ys \<in> set (List.n_lists (length ys) xs)" |
744934b818c7
moved quite generic material from theory Enum to more appropriate places
haftmann
parents:
49808
diff
changeset
|
4041 |
by (induct ys) auto |
744934b818c7
moved quite generic material from theory Enum to more appropriate places
haftmann
parents:
49808
diff
changeset
|
4042 |
ultimately show ?thesis by auto |
744934b818c7
moved quite generic material from theory Enum to more appropriate places
haftmann
parents:
49808
diff
changeset
|
4043 |
qed |
744934b818c7
moved quite generic material from theory Enum to more appropriate places
haftmann
parents:
49808
diff
changeset
|
4044 |
qed |
744934b818c7
moved quite generic material from theory Enum to more appropriate places
haftmann
parents:
49808
diff
changeset
|
4045 |
|
744934b818c7
moved quite generic material from theory Enum to more appropriate places
haftmann
parents:
49808
diff
changeset
|
4046 |
lemma distinct_n_lists: |
744934b818c7
moved quite generic material from theory Enum to more appropriate places
haftmann
parents:
49808
diff
changeset
|
4047 |
assumes "distinct xs" |
744934b818c7
moved quite generic material from theory Enum to more appropriate places
haftmann
parents:
49808
diff
changeset
|
4048 |
shows "distinct (List.n_lists n xs)" |
744934b818c7
moved quite generic material from theory Enum to more appropriate places
haftmann
parents:
49808
diff
changeset
|
4049 |
proof (rule card_distinct) |
744934b818c7
moved quite generic material from theory Enum to more appropriate places
haftmann
parents:
49808
diff
changeset
|
4050 |
from assms have card_length: "card (set xs) = length xs" by (rule distinct_card) |
744934b818c7
moved quite generic material from theory Enum to more appropriate places
haftmann
parents:
49808
diff
changeset
|
4051 |
have "card (set (List.n_lists n xs)) = card (set xs) ^ n" |
744934b818c7
moved quite generic material from theory Enum to more appropriate places
haftmann
parents:
49808
diff
changeset
|
4052 |
proof (induct n) |
744934b818c7
moved quite generic material from theory Enum to more appropriate places
haftmann
parents:
49808
diff
changeset
|
4053 |
case 0 then show ?case by simp |
744934b818c7
moved quite generic material from theory Enum to more appropriate places
haftmann
parents:
49808
diff
changeset
|
4054 |
next |
744934b818c7
moved quite generic material from theory Enum to more appropriate places
haftmann
parents:
49808
diff
changeset
|
4055 |
case (Suc n) |
744934b818c7
moved quite generic material from theory Enum to more appropriate places
haftmann
parents:
49808
diff
changeset
|
4056 |
moreover have "card (\<Union>ys\<in>set (List.n_lists n xs). (\<lambda>y. y # ys) ` set xs) |
744934b818c7
moved quite generic material from theory Enum to more appropriate places
haftmann
parents:
49808
diff
changeset
|
4057 |
= (\<Sum>ys\<in>set (List.n_lists n xs). card ((\<lambda>y. y # ys) ` set xs))" |
744934b818c7
moved quite generic material from theory Enum to more appropriate places
haftmann
parents:
49808
diff
changeset
|
4058 |
by (rule card_UN_disjoint) auto |
744934b818c7
moved quite generic material from theory Enum to more appropriate places
haftmann
parents:
49808
diff
changeset
|
4059 |
moreover have "\<And>ys. card ((\<lambda>y. y # ys) ` set xs) = card (set xs)" |
744934b818c7
moved quite generic material from theory Enum to more appropriate places
haftmann
parents:
49808
diff
changeset
|
4060 |
by (rule card_image) (simp add: inj_on_def) |
744934b818c7
moved quite generic material from theory Enum to more appropriate places
haftmann
parents:
49808
diff
changeset
|
4061 |
ultimately show ?case by auto |
744934b818c7
moved quite generic material from theory Enum to more appropriate places
haftmann
parents:
49808
diff
changeset
|
4062 |
qed |
744934b818c7
moved quite generic material from theory Enum to more appropriate places
haftmann
parents:
49808
diff
changeset
|
4063 |
also have "\<dots> = length xs ^ n" by (simp add: card_length) |
744934b818c7
moved quite generic material from theory Enum to more appropriate places
haftmann
parents:
49808
diff
changeset
|
4064 |
finally show "card (set (List.n_lists n xs)) = length (List.n_lists n xs)" |
744934b818c7
moved quite generic material from theory Enum to more appropriate places
haftmann
parents:
49808
diff
changeset
|
4065 |
by (simp add: length_n_lists) |
744934b818c7
moved quite generic material from theory Enum to more appropriate places
haftmann
parents:
49808
diff
changeset
|
4066 |
qed |
744934b818c7
moved quite generic material from theory Enum to more appropriate places
haftmann
parents:
49808
diff
changeset
|
4067 |
|
744934b818c7
moved quite generic material from theory Enum to more appropriate places
haftmann
parents:
49808
diff
changeset
|
4068 |
|
19390 | 4069 |
subsubsection {* @{const splice} *} |
4070 |
||
40593
1e57b18d27b1
code eqn for slice was missing; redefined splice with fun
nipkow
parents:
40365
diff
changeset
|
4071 |
lemma splice_Nil2 [simp, code]: "splice xs [] = xs" |
19390 | 4072 |
by (cases xs) simp_all |
4073 |
||
40593
1e57b18d27b1
code eqn for slice was missing; redefined splice with fun
nipkow
parents:
40365
diff
changeset
|
4074 |
declare splice.simps(1,3)[code] |
1e57b18d27b1
code eqn for slice was missing; redefined splice with fun
nipkow
parents:
40365
diff
changeset
|
4075 |
declare splice.simps(2)[simp del] |
19390 | 4076 |
|
24526 | 4077 |
lemma length_splice[simp]: "length(splice xs ys) = length xs + length ys" |
40593
1e57b18d27b1
code eqn for slice was missing; redefined splice with fun
nipkow
parents:
40365
diff
changeset
|
4078 |
by (induct xs ys rule: splice.induct) auto |
22793 | 4079 |
|
35115 | 4080 |
|
4081 |
subsubsection {* Transpose *} |
|
34933 | 4082 |
|
4083 |
function transpose where |
|
4084 |
"transpose [] = []" | |
|
4085 |
"transpose ([] # xss) = transpose xss" | |
|
4086 |
"transpose ((x#xs) # xss) = |
|
4087 |
(x # [h. (h#t) \<leftarrow> xss]) # transpose (xs # [t. (h#t) \<leftarrow> xss])" |
|
4088 |
by pat_completeness auto |
|
4089 |
||
4090 |
lemma transpose_aux_filter_head: |
|
4091 |
"concat (map (list_case [] (\<lambda>h t. [h])) xss) = |
|
4092 |
map (\<lambda>xs. hd xs) [ys\<leftarrow>xss . ys \<noteq> []]" |
|
4093 |
by (induct xss) (auto split: list.split) |
|
4094 |
||
4095 |
lemma transpose_aux_filter_tail: |
|
4096 |
"concat (map (list_case [] (\<lambda>h t. [t])) xss) = |
|
4097 |
map (\<lambda>xs. tl xs) [ys\<leftarrow>xss . ys \<noteq> []]" |
|
4098 |
by (induct xss) (auto split: list.split) |
|
4099 |
||
4100 |
lemma transpose_aux_max: |
|
4101 |
"max (Suc (length xs)) (foldr (\<lambda>xs. max (length xs)) xss 0) = |
|
4102 |
Suc (max (length xs) (foldr (\<lambda>x. max (length x - Suc 0)) [ys\<leftarrow>xss . ys\<noteq>[]] 0))" |
|
4103 |
(is "max _ ?foldB = Suc (max _ ?foldA)") |
|
4104 |
proof (cases "[ys\<leftarrow>xss . ys\<noteq>[]] = []") |
|
4105 |
case True |
|
4106 |
hence "foldr (\<lambda>xs. max (length xs)) xss 0 = 0" |
|
4107 |
proof (induct xss) |
|
4108 |
case (Cons x xs) |
|
4109 |
moreover hence "x = []" by (cases x) auto |
|
4110 |
ultimately show ?case by auto |
|
4111 |
qed simp |
|
4112 |
thus ?thesis using True by simp |
|
4113 |
next |
|
4114 |
case False |
|
4115 |
||
4116 |
have foldA: "?foldA = foldr (\<lambda>x. max (length x)) [ys\<leftarrow>xss . ys \<noteq> []] 0 - 1" |
|
4117 |
by (induct xss) auto |
|
4118 |
have foldB: "?foldB = foldr (\<lambda>x. max (length x)) [ys\<leftarrow>xss . ys \<noteq> []] 0" |
|
4119 |
by (induct xss) auto |
|
4120 |
||
4121 |
have "0 < ?foldB" |
|
4122 |
proof - |
|
4123 |
from False |
|
4124 |
obtain z zs where zs: "[ys\<leftarrow>xss . ys \<noteq> []] = z#zs" by (auto simp: neq_Nil_conv) |
|
4125 |
hence "z \<in> set ([ys\<leftarrow>xss . ys \<noteq> []])" by auto |
|
4126 |
hence "z \<noteq> []" by auto |
|
4127 |
thus ?thesis |
|
4128 |
unfolding foldB zs |
|
4129 |
by (auto simp: max_def intro: less_le_trans) |
|
4130 |
qed |
|
4131 |
thus ?thesis |
|
4132 |
unfolding foldA foldB max_Suc_Suc[symmetric] |
|
4133 |
by simp |
|
4134 |
qed |
|
4135 |
||
4136 |
termination transpose |
|
4137 |
by (relation "measure (\<lambda>xs. foldr (\<lambda>xs. max (length xs)) xs 0 + length xs)") |
|
4138 |
(auto simp: transpose_aux_filter_tail foldr_map comp_def transpose_aux_max less_Suc_eq_le) |
|
4139 |
||
4140 |
lemma transpose_empty: "(transpose xs = []) \<longleftrightarrow> (\<forall>x \<in> set xs. x = [])" |
|
4141 |
by (induct rule: transpose.induct) simp_all |
|
4142 |
||
4143 |
lemma length_transpose: |
|
4144 |
fixes xs :: "'a list list" |
|
4145 |
shows "length (transpose xs) = foldr (\<lambda>xs. max (length xs)) xs 0" |
|
4146 |
by (induct rule: transpose.induct) |
|
4147 |
(auto simp: transpose_aux_filter_tail foldr_map comp_def transpose_aux_max |
|
4148 |
max_Suc_Suc[symmetric] simp del: max_Suc_Suc) |
|
4149 |
||
4150 |
lemma nth_transpose: |
|
4151 |
fixes xs :: "'a list list" |
|
4152 |
assumes "i < length (transpose xs)" |
|
4153 |
shows "transpose xs ! i = map (\<lambda>xs. xs ! i) [ys \<leftarrow> xs. i < length ys]" |
|
4154 |
using assms proof (induct arbitrary: i rule: transpose.induct) |
|
4155 |
case (3 x xs xss) |
|
4156 |
def XS == "(x # xs) # xss" |
|
4157 |
hence [simp]: "XS \<noteq> []" by auto |
|
4158 |
thus ?case |
|
4159 |
proof (cases i) |
|
4160 |
case 0 |
|
4161 |
thus ?thesis by (simp add: transpose_aux_filter_head hd_conv_nth) |
|
4162 |
next |
|
4163 |
case (Suc j) |
|
4164 |
have *: "\<And>xss. xs # map tl xss = map tl ((x#xs)#xss)" by simp |
|
4165 |
have **: "\<And>xss. (x#xs) # filter (\<lambda>ys. ys \<noteq> []) xss = filter (\<lambda>ys. ys \<noteq> []) ((x#xs)#xss)" by simp |
|
4166 |
{ fix x have "Suc j < length x \<longleftrightarrow> x \<noteq> [] \<and> j < length x - Suc 0" |
|
4167 |
by (cases x) simp_all |
|
4168 |
} note *** = this |
|
4169 |
||
4170 |
have j_less: "j < length (transpose (xs # concat (map (list_case [] (\<lambda>h t. [t])) xss)))" |
|
4171 |
using "3.prems" by (simp add: transpose_aux_filter_tail length_transpose Suc) |
|
4172 |
||
4173 |
show ?thesis |
|
4174 |
unfolding transpose.simps `i = Suc j` nth_Cons_Suc "3.hyps"[OF j_less] |
|
4175 |
apply (auto simp: transpose_aux_filter_tail filter_map comp_def length_transpose * ** *** XS_def[symmetric]) |
|
4176 |
apply (rule_tac y=x in list.exhaust) |
|
4177 |
by auto |
|
4178 |
qed |
|
4179 |
qed simp_all |
|
4180 |
||
4181 |
lemma transpose_map_map: |
|
4182 |
"transpose (map (map f) xs) = map (map f) (transpose xs)" |
|
4183 |
proof (rule nth_equalityI, safe) |
|
4184 |
have [simp]: "length (transpose (map (map f) xs)) = length (transpose xs)" |
|
4185 |
by (simp add: length_transpose foldr_map comp_def) |
|
4186 |
show "length (transpose (map (map f) xs)) = length (map (map f) (transpose xs))" by simp |
|
4187 |
||
4188 |
fix i assume "i < length (transpose (map (map f) xs))" |
|
4189 |
thus "transpose (map (map f) xs) ! i = map (map f) (transpose xs) ! i" |
|
4190 |
by (simp add: nth_transpose filter_map comp_def) |
|
4191 |
qed |
|
24616 | 4192 |
|
35115 | 4193 |
|
31557 | 4194 |
subsubsection {* (In)finiteness *} |
28642 | 4195 |
|
4196 |
lemma finite_maxlen: |
|
4197 |
"finite (M::'a list set) ==> EX n. ALL s:M. size s < n" |
|
4198 |
proof (induct rule: finite.induct) |
|
4199 |
case emptyI show ?case by simp |
|
4200 |
next |
|
4201 |
case (insertI M xs) |
|
4202 |
then obtain n where "\<forall>s\<in>M. length s < n" by blast |
|
4203 |
hence "ALL s:insert xs M. size s < max n (size xs) + 1" by auto |
|
4204 |
thus ?case .. |
|
4205 |
qed |
|
4206 |
||
45714 | 4207 |
lemma lists_length_Suc_eq: |
4208 |
"{xs. set xs \<subseteq> A \<and> length xs = Suc n} = |
|
4209 |
(\<lambda>(xs, n). n#xs) ` ({xs. set xs \<subseteq> A \<and> length xs = n} \<times> A)" |
|
4210 |
by (auto simp: length_Suc_conv) |
|
4211 |
||
4212 |
lemma |
|
4213 |
assumes "finite A" |
|
4214 |
shows finite_lists_length_eq: "finite {xs. set xs \<subseteq> A \<and> length xs = n}" |
|
4215 |
and card_lists_length_eq: "card {xs. set xs \<subseteq> A \<and> length xs = n} = (card A)^n" |
|
4216 |
using `finite A` |
|
4217 |
by (induct n) |
|
4218 |
(auto simp: card_image inj_split_Cons lists_length_Suc_eq cong: conj_cong) |
|
31557 | 4219 |
|
4220 |
lemma finite_lists_length_le: |
|
4221 |
assumes "finite A" shows "finite {xs. set xs \<subseteq> A \<and> length xs \<le> n}" |
|
4222 |
(is "finite ?S") |
|
4223 |
proof- |
|
4224 |
have "?S = (\<Union>n\<in>{0..n}. {xs. set xs \<subseteq> A \<and> length xs = n})" by auto |
|
50027
7747a9f4c358
adjusting proofs as the set_comprehension_pointfree simproc breaks some existing proofs
bulwahn
parents:
49963
diff
changeset
|
4225 |
thus ?thesis by (auto intro!: finite_lists_length_eq[OF `finite A`] simp only:) |
31557 | 4226 |
qed |
4227 |
||
45714 | 4228 |
lemma card_lists_length_le: |
4229 |
assumes "finite A" shows "card {xs. set xs \<subseteq> A \<and> length xs \<le> n} = (\<Sum>i\<le>n. card A^i)" |
|
4230 |
proof - |
|
4231 |
have "(\<Sum>i\<le>n. card A^i) = card (\<Union>i\<le>n. {xs. set xs \<subseteq> A \<and> length xs = i})" |
|
4232 |
using `finite A` |
|
4233 |
by (subst card_UN_disjoint) |
|
4234 |
(auto simp add: card_lists_length_eq finite_lists_length_eq) |
|
4235 |
also have "(\<Union>i\<le>n. {xs. set xs \<subseteq> A \<and> length xs = i}) = {xs. set xs \<subseteq> A \<and> length xs \<le> n}" |
|
4236 |
by auto |
|
4237 |
finally show ?thesis by simp |
|
4238 |
qed |
|
4239 |
||
45932 | 4240 |
lemma card_lists_distinct_length_eq: |
4241 |
assumes "k < card A" |
|
4242 |
shows "card {xs. length xs = k \<and> distinct xs \<and> set xs \<subseteq> A} = \<Prod>{card A - k + 1 .. card A}" |
|
4243 |
using assms |
|
4244 |
proof (induct k) |
|
4245 |
case 0 |
|
4246 |
then have "{xs. length xs = 0 \<and> distinct xs \<and> set xs \<subseteq> A} = {[]}" by auto |
|
4247 |
then show ?case by simp |
|
4248 |
next |
|
4249 |
case (Suc k) |
|
4250 |
let "?k_list" = "\<lambda>k xs. length xs = k \<and> distinct xs \<and> set xs \<subseteq> A" |
|
4251 |
have inj_Cons: "\<And>A. inj_on (\<lambda>(xs, n). n # xs) A" by (rule inj_onI) auto |
|
4252 |
||
4253 |
from Suc have "k < card A" by simp |
|
4254 |
moreover have "finite A" using assms by (simp add: card_ge_0_finite) |
|
4255 |
moreover have "finite {xs. ?k_list k xs}" |
|
4256 |
using finite_lists_length_eq[OF `finite A`, of k] |
|
4257 |
by - (rule finite_subset, auto) |
|
4258 |
moreover have "\<And>i j. i \<noteq> j \<longrightarrow> {i} \<times> (A - set i) \<inter> {j} \<times> (A - set j) = {}" |
|
4259 |
by auto |
|
4260 |
moreover have "\<And>i. i \<in>Collect (?k_list k) \<Longrightarrow> card (A - set i) = card A - k" |
|
4261 |
by (simp add: card_Diff_subset distinct_card) |
|
4262 |
moreover have "{xs. ?k_list (Suc k) xs} = |
|
4263 |
(\<lambda>(xs, n). n#xs) ` \<Union>(\<lambda>xs. {xs} \<times> (A - set xs)) ` {xs. ?k_list k xs}" |
|
4264 |
by (auto simp: length_Suc_conv) |
|
4265 |
moreover |
|
4266 |
have "Suc (card A - Suc k) = card A - k" using Suc.prems by simp |
|
4267 |
then have "(card A - k) * \<Prod>{Suc (card A - k)..card A} = \<Prod>{Suc (card A - Suc k)..card A}" |
|
4268 |
by (subst setprod_insert[symmetric]) (simp add: atLeastAtMost_insertL)+ |
|
4269 |
ultimately show ?case |
|
4270 |
by (simp add: card_image inj_Cons card_UN_disjoint Suc.hyps algebra_simps) |
|
4271 |
qed |
|
4272 |
||
28642 | 4273 |
lemma infinite_UNIV_listI: "~ finite(UNIV::'a list set)" |
4274 |
apply(rule notI) |
|
4275 |
apply(drule finite_maxlen) |
|
4276 |
apply (metis UNIV_I length_replicate less_not_refl) |
|
4277 |
done |
|
4278 |
||
4279 |
||
35115 | 4280 |
subsection {* Sorting *} |
24616 | 4281 |
|
24617 | 4282 |
text{* Currently it is not shown that @{const sort} returns a |
4283 |
permutation of its input because the nicest proof is via multisets, |
|
4284 |
which are not yet available. Alternatively one could define a function |
|
4285 |
that counts the number of occurrences of an element in a list and use |
|
4286 |
that instead of multisets to state the correctness property. *} |
|
4287 |
||
24616 | 4288 |
context linorder |
4289 |
begin |
|
4290 |
||
40210
aee7ef725330
sorting: avoid _key suffix if lemma applies both to simple and generalized variant; generalized insort_insert to insort_insert_key; additional lemmas
haftmann
parents:
40195
diff
changeset
|
4291 |
lemma length_insort [simp]: |
aee7ef725330
sorting: avoid _key suffix if lemma applies both to simple and generalized variant; generalized insort_insert to insort_insert_key; additional lemmas
haftmann
parents:
40195
diff
changeset
|
4292 |
"length (insort_key f x xs) = Suc (length xs)" |
aee7ef725330
sorting: avoid _key suffix if lemma applies both to simple and generalized variant; generalized insort_insert to insort_insert_key; additional lemmas
haftmann
parents:
40195
diff
changeset
|
4293 |
by (induct xs) simp_all |
aee7ef725330
sorting: avoid _key suffix if lemma applies both to simple and generalized variant; generalized insort_insert to insort_insert_key; additional lemmas
haftmann
parents:
40195
diff
changeset
|
4294 |
|
aee7ef725330
sorting: avoid _key suffix if lemma applies both to simple and generalized variant; generalized insort_insert to insort_insert_key; additional lemmas
haftmann
parents:
40195
diff
changeset
|
4295 |
lemma insort_key_left_comm: |
aee7ef725330
sorting: avoid _key suffix if lemma applies both to simple and generalized variant; generalized insort_insert to insort_insert_key; additional lemmas
haftmann
parents:
40195
diff
changeset
|
4296 |
assumes "f x \<noteq> f y" |
aee7ef725330
sorting: avoid _key suffix if lemma applies both to simple and generalized variant; generalized insort_insert to insort_insert_key; additional lemmas
haftmann
parents:
40195
diff
changeset
|
4297 |
shows "insort_key f y (insort_key f x xs) = insort_key f x (insort_key f y xs)" |
aee7ef725330
sorting: avoid _key suffix if lemma applies both to simple and generalized variant; generalized insort_insert to insort_insert_key; additional lemmas
haftmann
parents:
40195
diff
changeset
|
4298 |
by (induct xs) (auto simp add: assms dest: antisym) |
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
|
4299 |
|
35195 | 4300 |
lemma insort_left_comm: |
4301 |
"insort x (insort y xs) = insort y (insort x xs)" |
|
40210
aee7ef725330
sorting: avoid _key suffix if lemma applies both to simple and generalized variant; generalized insort_insert to insort_insert_key; additional lemmas
haftmann
parents:
40195
diff
changeset
|
4302 |
by (cases "x = y") (auto intro: insort_key_left_comm) |
35195 | 4303 |
|
42871
1c0b99f950d9
names of fold_set locales resemble name of characteristic property more closely
haftmann
parents:
42809
diff
changeset
|
4304 |
lemma comp_fun_commute_insort: |
1c0b99f950d9
names of fold_set locales resemble name of characteristic property more closely
haftmann
parents:
42809
diff
changeset
|
4305 |
"comp_fun_commute insort" |
35195 | 4306 |
proof |
42809
5b45125b15ba
use pointfree characterisation for fold_set locale
haftmann
parents:
42714
diff
changeset
|
4307 |
qed (simp add: insort_left_comm fun_eq_iff) |
35195 | 4308 |
|
4309 |
lemma sort_key_simps [simp]: |
|
4310 |
"sort_key f [] = []" |
|
4311 |
"sort_key f (x#xs) = insort_key f x (sort_key f xs)" |
|
4312 |
by (simp_all add: sort_key_def) |
|
4313 |
||
46133
d9fe85d3d2cd
incorporated canonical fold combinator on lists into body of List theory; refactored passages on List.fold(l/r)
haftmann
parents:
46125
diff
changeset
|
4314 |
lemma (in linorder) sort_key_conv_fold: |
d9fe85d3d2cd
incorporated canonical fold combinator on lists into body of List theory; refactored passages on List.fold(l/r)
haftmann
parents:
46125
diff
changeset
|
4315 |
assumes "inj_on f (set xs)" |
d9fe85d3d2cd
incorporated canonical fold combinator on lists into body of List theory; refactored passages on List.fold(l/r)
haftmann
parents:
46125
diff
changeset
|
4316 |
shows "sort_key f xs = fold (insort_key f) xs []" |
d9fe85d3d2cd
incorporated canonical fold combinator on lists into body of List theory; refactored passages on List.fold(l/r)
haftmann
parents:
46125
diff
changeset
|
4317 |
proof - |
d9fe85d3d2cd
incorporated canonical fold combinator on lists into body of List theory; refactored passages on List.fold(l/r)
haftmann
parents:
46125
diff
changeset
|
4318 |
have "fold (insort_key f) (rev xs) = fold (insort_key f) xs" |
d9fe85d3d2cd
incorporated canonical fold combinator on lists into body of List theory; refactored passages on List.fold(l/r)
haftmann
parents:
46125
diff
changeset
|
4319 |
proof (rule fold_rev, rule ext) |
d9fe85d3d2cd
incorporated canonical fold combinator on lists into body of List theory; refactored passages on List.fold(l/r)
haftmann
parents:
46125
diff
changeset
|
4320 |
fix zs |
d9fe85d3d2cd
incorporated canonical fold combinator on lists into body of List theory; refactored passages on List.fold(l/r)
haftmann
parents:
46125
diff
changeset
|
4321 |
fix x y |
d9fe85d3d2cd
incorporated canonical fold combinator on lists into body of List theory; refactored passages on List.fold(l/r)
haftmann
parents:
46125
diff
changeset
|
4322 |
assume "x \<in> set xs" "y \<in> set xs" |
d9fe85d3d2cd
incorporated canonical fold combinator on lists into body of List theory; refactored passages on List.fold(l/r)
haftmann
parents:
46125
diff
changeset
|
4323 |
with assms have *: "f y = f x \<Longrightarrow> y = x" by (auto dest: inj_onD) |
d9fe85d3d2cd
incorporated canonical fold combinator on lists into body of List theory; refactored passages on List.fold(l/r)
haftmann
parents:
46125
diff
changeset
|
4324 |
have **: "x = y \<longleftrightarrow> y = x" by auto |
d9fe85d3d2cd
incorporated canonical fold combinator on lists into body of List theory; refactored passages on List.fold(l/r)
haftmann
parents:
46125
diff
changeset
|
4325 |
show "(insort_key f y \<circ> insort_key f x) zs = (insort_key f x \<circ> insort_key f y) zs" |
d9fe85d3d2cd
incorporated canonical fold combinator on lists into body of List theory; refactored passages on List.fold(l/r)
haftmann
parents:
46125
diff
changeset
|
4326 |
by (induct zs) (auto intro: * simp add: **) |
d9fe85d3d2cd
incorporated canonical fold combinator on lists into body of List theory; refactored passages on List.fold(l/r)
haftmann
parents:
46125
diff
changeset
|
4327 |
qed |
47397
d654c73e4b12
no preference wrt. fold(l/r); prefer fold rather than foldr for iterating over lists in generated code
haftmann
parents:
47131
diff
changeset
|
4328 |
then show ?thesis by (simp add: sort_key_def foldr_conv_fold) |
46133
d9fe85d3d2cd
incorporated canonical fold combinator on lists into body of List theory; refactored passages on List.fold(l/r)
haftmann
parents:
46125
diff
changeset
|
4329 |
qed |
d9fe85d3d2cd
incorporated canonical fold combinator on lists into body of List theory; refactored passages on List.fold(l/r)
haftmann
parents:
46125
diff
changeset
|
4330 |
|
d9fe85d3d2cd
incorporated canonical fold combinator on lists into body of List theory; refactored passages on List.fold(l/r)
haftmann
parents:
46125
diff
changeset
|
4331 |
lemma (in linorder) sort_conv_fold: |
d9fe85d3d2cd
incorporated canonical fold combinator on lists into body of List theory; refactored passages on List.fold(l/r)
haftmann
parents:
46125
diff
changeset
|
4332 |
"sort xs = fold insort xs []" |
d9fe85d3d2cd
incorporated canonical fold combinator on lists into body of List theory; refactored passages on List.fold(l/r)
haftmann
parents:
46125
diff
changeset
|
4333 |
by (rule sort_key_conv_fold) simp |
35195 | 4334 |
|
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
|
4335 |
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
|
4336 |
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
|
4337 |
|
25062 | 4338 |
lemma sorted_Cons: "sorted (x#xs) = (sorted xs & (ALL y:set xs. x <= y))" |
24616 | 4339 |
apply(induct xs arbitrary: x) apply simp |
4340 |
by simp (blast intro: order_trans) |
|
4341 |
||
40210
aee7ef725330
sorting: avoid _key suffix if lemma applies both to simple and generalized variant; generalized insort_insert to insort_insert_key; additional lemmas
haftmann
parents:
40195
diff
changeset
|
4342 |
lemma sorted_tl: |
aee7ef725330
sorting: avoid _key suffix if lemma applies both to simple and generalized variant; generalized insort_insert to insort_insert_key; additional lemmas
haftmann
parents:
40195
diff
changeset
|
4343 |
"sorted xs \<Longrightarrow> sorted (tl xs)" |
aee7ef725330
sorting: avoid _key suffix if lemma applies both to simple and generalized variant; generalized insort_insert to insort_insert_key; additional lemmas
haftmann
parents:
40195
diff
changeset
|
4344 |
by (cases xs) (simp_all add: sorted_Cons) |
aee7ef725330
sorting: avoid _key suffix if lemma applies both to simple and generalized variant; generalized insort_insert to insort_insert_key; additional lemmas
haftmann
parents:
40195
diff
changeset
|
4345 |
|
24616 | 4346 |
lemma sorted_append: |
25062 | 4347 |
"sorted (xs@ys) = (sorted xs & sorted ys & (\<forall>x \<in> set xs. \<forall>y \<in> set ys. x\<le>y))" |
24616 | 4348 |
by (induct xs) (auto simp add:sorted_Cons) |
4349 |
||
31201 | 4350 |
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
|
4351 |
"sorted xs \<Longrightarrow> i \<le> j \<Longrightarrow> j < length xs \<Longrightarrow> xs!i \<le> xs!j" |
31201 | 4352 |
by (induct xs arbitrary: i j) (auto simp:nth_Cons' sorted_Cons) |
4353 |
||
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
|
4354 |
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
|
4355 |
"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
|
4356 |
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
|
4357 |
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
|
4358 |
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
|
4359 |
|
603320b93668
New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents:
33593
diff
changeset
|
4360 |
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
|
4361 |
"(\<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
|
4362 |
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
|
4363 |
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
|
4364 |
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
|
4365 |
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
|
4366 |
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
|
4367 |
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
|
4368 |
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
|
4369 |
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
|
4370 |
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
|
4371 |
{ |
603320b93668
New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents:
33593
diff
changeset
|
4372 |
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
|
4373 |
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
|
4374 |
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
|
4375 |
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
|
4376 |
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
|
4377 |
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
|
4378 |
} |
603320b93668
New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents:
33593
diff
changeset
|
4379 |
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
|
4380 |
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
|
4381 |
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
|
4382 |
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
|
4383 |
|
603320b93668
New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents:
33593
diff
changeset
|
4384 |
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
|
4385 |
"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
|
4386 |
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
|
4387 |
|
603320b93668
New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents:
33593
diff
changeset
|
4388 |
lemma set_insort: "set(insort_key f x xs) = insert x (set xs)" |
24616 | 4389 |
by (induct xs) auto |
4390 |
||
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
|
4391 |
lemma set_sort[simp]: "set(sort_key f xs) = set xs" |
24616 | 4392 |
by (induct xs) (simp_all add:set_insort) |
4393 |
||
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
|
4394 |
lemma distinct_insort: "distinct (insort_key f x xs) = (x \<notin> set xs \<and> distinct xs)" |
24616 | 4395 |
by(induct xs)(auto simp:set_insort) |
4396 |
||
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
|
4397 |
lemma distinct_sort[simp]: "distinct (sort_key f xs) = distinct xs" |
44921 | 4398 |
by (induct xs) (simp_all add: distinct_insort) |
24616 | 4399 |
|
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
|
4400 |
lemma sorted_insort_key: "sorted (map f (insort_key f x xs)) = sorted (map f xs)" |
40210
aee7ef725330
sorting: avoid _key suffix if lemma applies both to simple and generalized variant; generalized insort_insert to insort_insert_key; additional lemmas
haftmann
parents:
40195
diff
changeset
|
4401 |
by (induct xs) (auto simp:sorted_Cons set_insort) |
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
|
4402 |
|
24616 | 4403 |
lemma sorted_insort: "sorted (insort x xs) = sorted xs" |
40210
aee7ef725330
sorting: avoid _key suffix if lemma applies both to simple and generalized variant; generalized insort_insert to insort_insert_key; additional lemmas
haftmann
parents:
40195
diff
changeset
|
4404 |
using sorted_insort_key [where f="\<lambda>x. x"] by simp |
aee7ef725330
sorting: avoid _key suffix if lemma applies both to simple and generalized variant; generalized insort_insert to insort_insert_key; additional lemmas
haftmann
parents:
40195
diff
changeset
|
4405 |
|
aee7ef725330
sorting: avoid _key suffix if lemma applies both to simple and generalized variant; generalized insort_insert to insort_insert_key; additional lemmas
haftmann
parents:
40195
diff
changeset
|
4406 |
theorem sorted_sort_key [simp]: "sorted (map f (sort_key f xs))" |
aee7ef725330
sorting: avoid _key suffix if lemma applies both to simple and generalized variant; generalized insort_insert to insort_insert_key; additional lemmas
haftmann
parents:
40195
diff
changeset
|
4407 |
by (induct xs) (auto simp:sorted_insort_key) |
aee7ef725330
sorting: avoid _key suffix if lemma applies both to simple and generalized variant; generalized insort_insert to insort_insert_key; additional lemmas
haftmann
parents:
40195
diff
changeset
|
4408 |
|
aee7ef725330
sorting: avoid _key suffix if lemma applies both to simple and generalized variant; generalized insort_insert to insort_insert_key; additional lemmas
haftmann
parents:
40195
diff
changeset
|
4409 |
theorem sorted_sort [simp]: "sorted (sort xs)" |
aee7ef725330
sorting: avoid _key suffix if lemma applies both to simple and generalized variant; generalized insort_insert to insort_insert_key; additional lemmas
haftmann
parents:
40195
diff
changeset
|
4410 |
using sorted_sort_key [where f="\<lambda>x. x"] by simp |
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
|
4411 |
|
36851 | 4412 |
lemma sorted_butlast: |
4413 |
assumes "xs \<noteq> []" and "sorted xs" |
|
4414 |
shows "sorted (butlast xs)" |
|
4415 |
proof - |
|
4416 |
from `xs \<noteq> []` obtain ys y where "xs = ys @ [y]" by (cases xs rule: rev_cases) auto |
|
4417 |
with `sorted xs` show ?thesis by (simp add: sorted_append) |
|
4418 |
qed |
|
4419 |
||
4420 |
lemma insort_not_Nil [simp]: |
|
4421 |
"insort_key f a xs \<noteq> []" |
|
4422 |
by (induct xs) simp_all |
|
4423 |
||
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
|
4424 |
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
|
4425 |
by (cases xs) auto |
314c0bcb7df7
Added useful general lemmas from the work with the HeapMonad
bulwahn
parents:
26073
diff
changeset
|
4426 |
|
44916
840d8c3d9113
added lemma motivated by a more specific lemma in the AFP-KBPs theories
bulwahn
parents:
44890
diff
changeset
|
4427 |
lemma sorted_sort_id: "sorted xs \<Longrightarrow> sort xs = xs" |
840d8c3d9113
added lemma motivated by a more specific lemma in the AFP-KBPs theories
bulwahn
parents:
44890
diff
changeset
|
4428 |
by (induct xs) (auto simp add: sorted_Cons insort_is_Cons) |
840d8c3d9113
added lemma motivated by a more specific lemma in the AFP-KBPs theories
bulwahn
parents:
44890
diff
changeset
|
4429 |
|
39534
c798d4f1b682
generalized lemma insort_remove1 to insort_key_remove1
haftmann
parents:
39302
diff
changeset
|
4430 |
lemma sorted_map_remove1: |
c798d4f1b682
generalized lemma insort_remove1 to insort_key_remove1
haftmann
parents:
39302
diff
changeset
|
4431 |
"sorted (map f xs) \<Longrightarrow> sorted (map f (remove1 x xs))" |
c798d4f1b682
generalized lemma insort_remove1 to insort_key_remove1
haftmann
parents:
39302
diff
changeset
|
4432 |
by (induct xs) (auto simp add: sorted_Cons) |
c798d4f1b682
generalized lemma insort_remove1 to insort_key_remove1
haftmann
parents:
39302
diff
changeset
|
4433 |
|
26143
314c0bcb7df7
Added useful general lemmas from the work with the HeapMonad
bulwahn
parents:
26073
diff
changeset
|
4434 |
lemma sorted_remove1: "sorted xs \<Longrightarrow> sorted (remove1 a xs)" |
39534
c798d4f1b682
generalized lemma insort_remove1 to insort_key_remove1
haftmann
parents:
39302
diff
changeset
|
4435 |
using sorted_map_remove1 [of "\<lambda>x. x"] by simp |
c798d4f1b682
generalized lemma insort_remove1 to insort_key_remove1
haftmann
parents:
39302
diff
changeset
|
4436 |
|
c798d4f1b682
generalized lemma insort_remove1 to insort_key_remove1
haftmann
parents:
39302
diff
changeset
|
4437 |
lemma insort_key_remove1: |
c798d4f1b682
generalized lemma insort_remove1 to insort_key_remove1
haftmann
parents:
39302
diff
changeset
|
4438 |
assumes "a \<in> set xs" and "sorted (map f xs)" and "hd (filter (\<lambda>x. f a = f x) xs) = a" |
c798d4f1b682
generalized lemma insort_remove1 to insort_key_remove1
haftmann
parents:
39302
diff
changeset
|
4439 |
shows "insort_key f a (remove1 a xs) = xs" |
c798d4f1b682
generalized lemma insort_remove1 to insort_key_remove1
haftmann
parents:
39302
diff
changeset
|
4440 |
using assms proof (induct 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
|
4441 |
case (Cons x xs) |
39534
c798d4f1b682
generalized lemma insort_remove1 to insort_key_remove1
haftmann
parents:
39302
diff
changeset
|
4442 |
then show ?case |
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
|
4443 |
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
|
4444 |
case False |
39534
c798d4f1b682
generalized lemma insort_remove1 to insort_key_remove1
haftmann
parents:
39302
diff
changeset
|
4445 |
then have "f x \<noteq> f a" using Cons.prems by auto |
c798d4f1b682
generalized lemma insort_remove1 to insort_key_remove1
haftmann
parents:
39302
diff
changeset
|
4446 |
then have "f x < f a" using Cons.prems by (auto simp: sorted_Cons) |
c798d4f1b682
generalized lemma insort_remove1 to insort_key_remove1
haftmann
parents:
39302
diff
changeset
|
4447 |
with `f x \<noteq> f a` show ?thesis using Cons by (auto simp: sorted_Cons insort_is_Cons) |
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
|
4448 |
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
|
4449 |
qed simp |
26143
314c0bcb7df7
Added useful general lemmas from the work with the HeapMonad
bulwahn
parents:
26073
diff
changeset
|
4450 |
|
39534
c798d4f1b682
generalized lemma insort_remove1 to insort_key_remove1
haftmann
parents:
39302
diff
changeset
|
4451 |
lemma insort_remove1: |
c798d4f1b682
generalized lemma insort_remove1 to insort_key_remove1
haftmann
parents:
39302
diff
changeset
|
4452 |
assumes "a \<in> set xs" and "sorted xs" |
c798d4f1b682
generalized lemma insort_remove1 to insort_key_remove1
haftmann
parents:
39302
diff
changeset
|
4453 |
shows "insort a (remove1 a xs) = xs" |
c798d4f1b682
generalized lemma insort_remove1 to insort_key_remove1
haftmann
parents:
39302
diff
changeset
|
4454 |
proof (rule insort_key_remove1) |
c798d4f1b682
generalized lemma insort_remove1 to insort_key_remove1
haftmann
parents:
39302
diff
changeset
|
4455 |
from `a \<in> set xs` show "a \<in> set xs" . |
c798d4f1b682
generalized lemma insort_remove1 to insort_key_remove1
haftmann
parents:
39302
diff
changeset
|
4456 |
from `sorted xs` show "sorted (map (\<lambda>x. x) xs)" by simp |
c798d4f1b682
generalized lemma insort_remove1 to insort_key_remove1
haftmann
parents:
39302
diff
changeset
|
4457 |
from `a \<in> set xs` have "a \<in> set (filter (op = a) xs)" by auto |
c798d4f1b682
generalized lemma insort_remove1 to insort_key_remove1
haftmann
parents:
39302
diff
changeset
|
4458 |
then have "set (filter (op = a) xs) \<noteq> {}" by auto |
c798d4f1b682
generalized lemma insort_remove1 to insort_key_remove1
haftmann
parents:
39302
diff
changeset
|
4459 |
then have "filter (op = a) xs \<noteq> []" by (auto simp only: set_empty) |
c798d4f1b682
generalized lemma insort_remove1 to insort_key_remove1
haftmann
parents:
39302
diff
changeset
|
4460 |
then have "length (filter (op = a) xs) > 0" by simp |
c798d4f1b682
generalized lemma insort_remove1 to insort_key_remove1
haftmann
parents:
39302
diff
changeset
|
4461 |
then obtain n where n: "Suc n = length (filter (op = a) xs)" |
c798d4f1b682
generalized lemma insort_remove1 to insort_key_remove1
haftmann
parents:
39302
diff
changeset
|
4462 |
by (cases "length (filter (op = a) xs)") simp_all |
c798d4f1b682
generalized lemma insort_remove1 to insort_key_remove1
haftmann
parents:
39302
diff
changeset
|
4463 |
moreover have "replicate (Suc n) a = a # replicate n a" |
c798d4f1b682
generalized lemma insort_remove1 to insort_key_remove1
haftmann
parents:
39302
diff
changeset
|
4464 |
by simp |
c798d4f1b682
generalized lemma insort_remove1 to insort_key_remove1
haftmann
parents:
39302
diff
changeset
|
4465 |
ultimately show "hd (filter (op = a) xs) = a" by (simp add: replicate_length_filter) |
c798d4f1b682
generalized lemma insort_remove1 to insort_key_remove1
haftmann
parents:
39302
diff
changeset
|
4466 |
qed |
26143
314c0bcb7df7
Added useful general lemmas from the work with the HeapMonad
bulwahn
parents:
26073
diff
changeset
|
4467 |
|
314c0bcb7df7
Added useful general lemmas from the work with the HeapMonad
bulwahn
parents:
26073
diff
changeset
|
4468 |
lemma sorted_remdups[simp]: |
314c0bcb7df7
Added useful general lemmas from the work with the HeapMonad
bulwahn
parents:
26073
diff
changeset
|
4469 |
"sorted l \<Longrightarrow> sorted (remdups l)" |
314c0bcb7df7
Added useful general lemmas from the work with the HeapMonad
bulwahn
parents:
26073
diff
changeset
|
4470 |
by (induct l) (auto simp: sorted_Cons) |
314c0bcb7df7
Added useful general lemmas from the work with the HeapMonad
bulwahn
parents:
26073
diff
changeset
|
4471 |
|
24645 | 4472 |
lemma sorted_distinct_set_unique: |
4473 |
assumes "sorted xs" "distinct xs" "sorted ys" "distinct ys" "set xs = set ys" |
|
4474 |
shows "xs = ys" |
|
4475 |
proof - |
|
26734 | 4476 |
from assms have 1: "length xs = length ys" by (auto dest!: distinct_card) |
24645 | 4477 |
from assms show ?thesis |
4478 |
proof(induct rule:list_induct2[OF 1]) |
|
4479 |
case 1 show ?case by simp |
|
4480 |
next |
|
4481 |
case 2 thus ?case by (simp add:sorted_Cons) |
|
4482 |
(metis Diff_insert_absorb antisym insertE insert_iff) |
|
4483 |
qed |
|
4484 |
qed |
|
4485 |
||
35603 | 4486 |
lemma map_sorted_distinct_set_unique: |
4487 |
assumes "inj_on f (set xs \<union> set ys)" |
|
4488 |
assumes "sorted (map f xs)" "distinct (map f xs)" |
|
4489 |
"sorted (map f ys)" "distinct (map f ys)" |
|
4490 |
assumes "set xs = set ys" |
|
4491 |
shows "xs = ys" |
|
4492 |
proof - |
|
4493 |
from assms have "map f xs = map f ys" |
|
4494 |
by (simp add: sorted_distinct_set_unique) |
|
4495 |
moreover with `inj_on f (set xs \<union> set ys)` show "xs = ys" |
|
4496 |
by (blast intro: map_inj_on) |
|
4497 |
qed |
|
4498 |
||
24645 | 4499 |
lemma finite_sorted_distinct_unique: |
4500 |
shows "finite A \<Longrightarrow> EX! xs. set xs = A & sorted xs & distinct xs" |
|
4501 |
apply(drule finite_distinct_list) |
|
4502 |
apply clarify |
|
4503 |
apply(rule_tac a="sort xs" in ex1I) |
|
4504 |
apply (auto simp: sorted_distinct_set_unique) |
|
4505 |
done |
|
4506 |
||
39915
ecf97cf3d248
turned distinct and sorted into inductive predicates: yields nice induction principles for free; more elegant proofs
haftmann
parents:
39774
diff
changeset
|
4507 |
lemma |
ecf97cf3d248
turned distinct and sorted into inductive predicates: yields nice induction principles for free; more elegant proofs
haftmann
parents:
39774
diff
changeset
|
4508 |
assumes "sorted xs" |
ecf97cf3d248
turned distinct and sorted into inductive predicates: yields nice induction principles for free; more elegant proofs
haftmann
parents:
39774
diff
changeset
|
4509 |
shows sorted_take: "sorted (take n xs)" |
ecf97cf3d248
turned distinct and sorted into inductive predicates: yields nice induction principles for free; more elegant proofs
haftmann
parents:
39774
diff
changeset
|
4510 |
and sorted_drop: "sorted (drop n xs)" |
ecf97cf3d248
turned distinct and sorted into inductive predicates: yields nice induction principles for free; more elegant proofs
haftmann
parents:
39774
diff
changeset
|
4511 |
proof - |
ecf97cf3d248
turned distinct and sorted into inductive predicates: yields nice induction principles for free; more elegant proofs
haftmann
parents:
39774
diff
changeset
|
4512 |
from assms have "sorted (take n xs @ drop n xs)" by simp |
ecf97cf3d248
turned distinct and sorted into inductive predicates: yields nice induction principles for free; more elegant proofs
haftmann
parents:
39774
diff
changeset
|
4513 |
then show "sorted (take n xs)" and "sorted (drop n xs)" |
ecf97cf3d248
turned distinct and sorted into inductive predicates: yields nice induction principles for free; more elegant proofs
haftmann
parents:
39774
diff
changeset
|
4514 |
unfolding sorted_append by simp_all |
29626 | 4515 |
qed |
4516 |
||
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
|
4517 |
lemma sorted_dropWhile: "sorted xs \<Longrightarrow> sorted (dropWhile P xs)" |
39915
ecf97cf3d248
turned distinct and sorted into inductive predicates: yields nice induction principles for free; more elegant proofs
haftmann
parents:
39774
diff
changeset
|
4518 |
by (auto dest: sorted_drop simp add: dropWhile_eq_drop) |
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
|
4519 |
|
603320b93668
New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents:
33593
diff
changeset
|
4520 |
lemma sorted_takeWhile: "sorted xs \<Longrightarrow> sorted (takeWhile P xs)" |
39915
ecf97cf3d248
turned distinct and sorted into inductive predicates: yields nice induction principles for free; more elegant proofs
haftmann
parents:
39774
diff
changeset
|
4521 |
by (subst takeWhile_eq_take) (auto dest: sorted_take) |
29626 | 4522 |
|
34933 | 4523 |
lemma sorted_filter: |
4524 |
"sorted (map f xs) \<Longrightarrow> sorted (map f (filter P xs))" |
|
4525 |
by (induct xs) (simp_all add: sorted_Cons) |
|
4526 |
||
4527 |
lemma foldr_max_sorted: |
|
4528 |
assumes "sorted (rev xs)" |
|
4529 |
shows "foldr max xs y = (if xs = [] then y else max (xs ! 0) y)" |
|
4530 |
using assms proof (induct xs) |
|
4531 |
case (Cons x xs) |
|
4532 |
moreover hence "sorted (rev xs)" using sorted_append by auto |
|
4533 |
ultimately show ?case |
|
4534 |
by (cases xs, auto simp add: sorted_append max_def) |
|
4535 |
qed simp |
|
4536 |
||
4537 |
lemma filter_equals_takeWhile_sorted_rev: |
|
4538 |
assumes sorted: "sorted (rev (map f xs))" |
|
4539 |
shows "[x \<leftarrow> xs. t < f x] = takeWhile (\<lambda> x. t < f x) xs" |
|
4540 |
(is "filter ?P xs = ?tW") |
|
4541 |
proof (rule takeWhile_eq_filter[symmetric]) |
|
4542 |
let "?dW" = "dropWhile ?P xs" |
|
4543 |
fix x assume "x \<in> set ?dW" |
|
4544 |
then obtain i where i: "i < length ?dW" and nth_i: "x = ?dW ! i" |
|
4545 |
unfolding in_set_conv_nth by auto |
|
4546 |
hence "length ?tW + i < length (?tW @ ?dW)" |
|
4547 |
unfolding length_append by simp |
|
4548 |
hence i': "length (map f ?tW) + i < length (map f xs)" by simp |
|
4549 |
have "(map f ?tW @ map f ?dW) ! (length (map f ?tW) + i) \<le> |
|
4550 |
(map f ?tW @ map f ?dW) ! (length (map f ?tW) + 0)" |
|
4551 |
using sorted_rev_nth_mono[OF sorted _ i', of "length ?tW"] |
|
4552 |
unfolding map_append[symmetric] by simp |
|
4553 |
hence "f x \<le> f (?dW ! 0)" |
|
4554 |
unfolding nth_append_length_plus nth_i |
|
4555 |
using i preorder_class.le_less_trans[OF le0 i] by simp |
|
4556 |
also have "... \<le> t" |
|
4557 |
using hd_dropWhile[of "?P" xs] le0[THEN preorder_class.le_less_trans, OF i] |
|
4558 |
using hd_conv_nth[of "?dW"] by simp |
|
4559 |
finally show "\<not> t < f x" by simp |
|
4560 |
qed |
|
4561 |
||
40210
aee7ef725330
sorting: avoid _key suffix if lemma applies both to simple and generalized variant; generalized insort_insert to insort_insert_key; additional lemmas
haftmann
parents:
40195
diff
changeset
|
4562 |
lemma insort_insert_key_triv: |
aee7ef725330
sorting: avoid _key suffix if lemma applies both to simple and generalized variant; generalized insort_insert to insort_insert_key; additional lemmas
haftmann
parents:
40195
diff
changeset
|
4563 |
"f x \<in> f ` set xs \<Longrightarrow> insort_insert_key f x xs = xs" |
aee7ef725330
sorting: avoid _key suffix if lemma applies both to simple and generalized variant; generalized insort_insert to insort_insert_key; additional lemmas
haftmann
parents:
40195
diff
changeset
|
4564 |
by (simp add: insort_insert_key_def) |
aee7ef725330
sorting: avoid _key suffix if lemma applies both to simple and generalized variant; generalized insort_insert to insort_insert_key; additional lemmas
haftmann
parents:
40195
diff
changeset
|
4565 |
|
aee7ef725330
sorting: avoid _key suffix if lemma applies both to simple and generalized variant; generalized insort_insert to insort_insert_key; additional lemmas
haftmann
parents:
40195
diff
changeset
|
4566 |
lemma insort_insert_triv: |
aee7ef725330
sorting: avoid _key suffix if lemma applies both to simple and generalized variant; generalized insort_insert to insort_insert_key; additional lemmas
haftmann
parents:
40195
diff
changeset
|
4567 |
"x \<in> set xs \<Longrightarrow> insort_insert x xs = xs" |
aee7ef725330
sorting: avoid _key suffix if lemma applies both to simple and generalized variant; generalized insort_insert to insort_insert_key; additional lemmas
haftmann
parents:
40195
diff
changeset
|
4568 |
using insort_insert_key_triv [of "\<lambda>x. x"] by simp |
aee7ef725330
sorting: avoid _key suffix if lemma applies both to simple and generalized variant; generalized insort_insert to insort_insert_key; additional lemmas
haftmann
parents:
40195
diff
changeset
|
4569 |
|
aee7ef725330
sorting: avoid _key suffix if lemma applies both to simple and generalized variant; generalized insort_insert to insort_insert_key; additional lemmas
haftmann
parents:
40195
diff
changeset
|
4570 |
lemma insort_insert_insort_key: |
aee7ef725330
sorting: avoid _key suffix if lemma applies both to simple and generalized variant; generalized insort_insert to insort_insert_key; additional lemmas
haftmann
parents:
40195
diff
changeset
|
4571 |
"f x \<notin> f ` set xs \<Longrightarrow> insort_insert_key f x xs = insort_key f x xs" |
aee7ef725330
sorting: avoid _key suffix if lemma applies both to simple and generalized variant; generalized insort_insert to insort_insert_key; additional lemmas
haftmann
parents:
40195
diff
changeset
|
4572 |
by (simp add: insort_insert_key_def) |
aee7ef725330
sorting: avoid _key suffix if lemma applies both to simple and generalized variant; generalized insort_insert to insort_insert_key; additional lemmas
haftmann
parents:
40195
diff
changeset
|
4573 |
|
aee7ef725330
sorting: avoid _key suffix if lemma applies both to simple and generalized variant; generalized insort_insert to insort_insert_key; additional lemmas
haftmann
parents:
40195
diff
changeset
|
4574 |
lemma insort_insert_insort: |
aee7ef725330
sorting: avoid _key suffix if lemma applies both to simple and generalized variant; generalized insort_insert to insort_insert_key; additional lemmas
haftmann
parents:
40195
diff
changeset
|
4575 |
"x \<notin> set xs \<Longrightarrow> insort_insert x xs = insort x xs" |
aee7ef725330
sorting: avoid _key suffix if lemma applies both to simple and generalized variant; generalized insort_insert to insort_insert_key; additional lemmas
haftmann
parents:
40195
diff
changeset
|
4576 |
using insort_insert_insort_key [of "\<lambda>x. x"] by simp |
aee7ef725330
sorting: avoid _key suffix if lemma applies both to simple and generalized variant; generalized insort_insert to insort_insert_key; additional lemmas
haftmann
parents:
40195
diff
changeset
|
4577 |
|
35608 | 4578 |
lemma set_insort_insert: |
4579 |
"set (insort_insert x xs) = insert x (set xs)" |
|
40210
aee7ef725330
sorting: avoid _key suffix if lemma applies both to simple and generalized variant; generalized insort_insert to insort_insert_key; additional lemmas
haftmann
parents:
40195
diff
changeset
|
4580 |
by (auto simp add: insort_insert_key_def set_insort) |
35608 | 4581 |
|
4582 |
lemma distinct_insort_insert: |
|
4583 |
assumes "distinct xs" |
|
40210
aee7ef725330
sorting: avoid _key suffix if lemma applies both to simple and generalized variant; generalized insort_insert to insort_insert_key; additional lemmas
haftmann
parents:
40195
diff
changeset
|
4584 |
shows "distinct (insort_insert_key f x xs)" |
aee7ef725330
sorting: avoid _key suffix if lemma applies both to simple and generalized variant; generalized insort_insert to insort_insert_key; additional lemmas
haftmann
parents:
40195
diff
changeset
|
4585 |
using assms by (induct xs) (auto simp add: insort_insert_key_def set_insort) |
aee7ef725330
sorting: avoid _key suffix if lemma applies both to simple and generalized variant; generalized insort_insert to insort_insert_key; additional lemmas
haftmann
parents:
40195
diff
changeset
|
4586 |
|
aee7ef725330
sorting: avoid _key suffix if lemma applies both to simple and generalized variant; generalized insort_insert to insort_insert_key; additional lemmas
haftmann
parents:
40195
diff
changeset
|
4587 |
lemma sorted_insort_insert_key: |
aee7ef725330
sorting: avoid _key suffix if lemma applies both to simple and generalized variant; generalized insort_insert to insort_insert_key; additional lemmas
haftmann
parents:
40195
diff
changeset
|
4588 |
assumes "sorted (map f xs)" |
aee7ef725330
sorting: avoid _key suffix if lemma applies both to simple and generalized variant; generalized insort_insert to insort_insert_key; additional lemmas
haftmann
parents:
40195
diff
changeset
|
4589 |
shows "sorted (map f (insort_insert_key f x xs))" |
aee7ef725330
sorting: avoid _key suffix if lemma applies both to simple and generalized variant; generalized insort_insert to insort_insert_key; additional lemmas
haftmann
parents:
40195
diff
changeset
|
4590 |
using assms by (simp add: insort_insert_key_def sorted_insort_key) |
35608 | 4591 |
|
4592 |
lemma sorted_insort_insert: |
|
4593 |
assumes "sorted xs" |
|
4594 |
shows "sorted (insort_insert x xs)" |
|
40210
aee7ef725330
sorting: avoid _key suffix if lemma applies both to simple and generalized variant; generalized insort_insert to insort_insert_key; additional lemmas
haftmann
parents:
40195
diff
changeset
|
4595 |
using assms sorted_insort_insert_key [of "\<lambda>x. x"] by simp |
aee7ef725330
sorting: avoid _key suffix if lemma applies both to simple and generalized variant; generalized insort_insert to insort_insert_key; additional lemmas
haftmann
parents:
40195
diff
changeset
|
4596 |
|
aee7ef725330
sorting: avoid _key suffix if lemma applies both to simple and generalized variant; generalized insort_insert to insort_insert_key; additional lemmas
haftmann
parents:
40195
diff
changeset
|
4597 |
lemma filter_insort_triv: |
37107 | 4598 |
"\<not> P x \<Longrightarrow> filter P (insort_key f x xs) = filter P xs" |
4599 |
by (induct xs) simp_all |
|
4600 |
||
40210
aee7ef725330
sorting: avoid _key suffix if lemma applies both to simple and generalized variant; generalized insort_insert to insort_insert_key; additional lemmas
haftmann
parents:
40195
diff
changeset
|
4601 |
lemma filter_insort: |
37107 | 4602 |
"sorted (map f xs) \<Longrightarrow> P x \<Longrightarrow> filter P (insort_key f x xs) = insort_key f x (filter P xs)" |
4603 |
using assms by (induct xs) |
|
4604 |
(auto simp add: sorted_Cons, subst insort_is_Cons, auto) |
|
4605 |
||
40210
aee7ef725330
sorting: avoid _key suffix if lemma applies both to simple and generalized variant; generalized insort_insert to insort_insert_key; additional lemmas
haftmann
parents:
40195
diff
changeset
|
4606 |
lemma filter_sort: |
37107 | 4607 |
"filter P (sort_key f xs) = sort_key f (filter P xs)" |
40210
aee7ef725330
sorting: avoid _key suffix if lemma applies both to simple and generalized variant; generalized insort_insert to insort_insert_key; additional lemmas
haftmann
parents:
40195
diff
changeset
|
4608 |
by (induct xs) (simp_all add: filter_insort_triv filter_insort) |
37107 | 4609 |
|
40304 | 4610 |
lemma sorted_map_same: |
4611 |
"sorted (map f [x\<leftarrow>xs. f x = g xs])" |
|
4612 |
proof (induct xs arbitrary: g) |
|
37107 | 4613 |
case Nil then show ?case by simp |
4614 |
next |
|
4615 |
case (Cons x xs) |
|
40304 | 4616 |
then have "sorted (map f [y\<leftarrow>xs . f y = (\<lambda>xs. f x) xs])" . |
4617 |
moreover from Cons have "sorted (map f [y\<leftarrow>xs . f y = (g \<circ> Cons x) xs])" . |
|
37107 | 4618 |
ultimately show ?case by (simp_all add: sorted_Cons) |
4619 |
qed |
|
4620 |
||
40304 | 4621 |
lemma sorted_same: |
4622 |
"sorted [x\<leftarrow>xs. x = g xs]" |
|
4623 |
using sorted_map_same [of "\<lambda>x. x"] by simp |
|
4624 |
||
37107 | 4625 |
lemma remove1_insort [simp]: |
4626 |
"remove1 x (insort x xs) = xs" |
|
4627 |
by (induct xs) simp_all |
|
4628 |
||
24616 | 4629 |
end |
4630 |
||
25277 | 4631 |
lemma sorted_upt[simp]: "sorted[i..<j]" |
4632 |
by (induct j) (simp_all add:sorted_append) |
|
4633 |
||
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
|
4634 |
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
|
4635 |
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
|
4636 |
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
|
4637 |
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
|
4638 |
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
|
4639 |
|
35115 | 4640 |
|
4641 |
subsubsection {* @{const transpose} on sorted lists *} |
|
34933 | 4642 |
|
4643 |
lemma sorted_transpose[simp]: |
|
4644 |
shows "sorted (rev (map length (transpose xs)))" |
|
4645 |
by (auto simp: sorted_equals_nth_mono rev_nth nth_transpose |
|
4646 |
length_filter_conv_card intro: card_mono) |
|
4647 |
||
4648 |
lemma transpose_max_length: |
|
4649 |
"foldr (\<lambda>xs. max (length xs)) (transpose xs) 0 = length [x \<leftarrow> xs. x \<noteq> []]" |
|
4650 |
(is "?L = ?R") |
|
4651 |
proof (cases "transpose xs = []") |
|
4652 |
case False |
|
4653 |
have "?L = foldr max (map length (transpose xs)) 0" |
|
4654 |
by (simp add: foldr_map comp_def) |
|
4655 |
also have "... = length (transpose xs ! 0)" |
|
4656 |
using False sorted_transpose by (simp add: foldr_max_sorted) |
|
4657 |
finally show ?thesis |
|
4658 |
using False by (simp add: nth_transpose) |
|
4659 |
next |
|
4660 |
case True |
|
4661 |
hence "[x \<leftarrow> xs. x \<noteq> []] = []" |
|
4662 |
by (auto intro!: filter_False simp: transpose_empty) |
|
4663 |
thus ?thesis by (simp add: transpose_empty True) |
|
4664 |
qed |
|
4665 |
||
4666 |
lemma length_transpose_sorted: |
|
4667 |
fixes xs :: "'a list list" |
|
4668 |
assumes sorted: "sorted (rev (map length xs))" |
|
4669 |
shows "length (transpose xs) = (if xs = [] then 0 else length (xs ! 0))" |
|
4670 |
proof (cases "xs = []") |
|
4671 |
case False |
|
4672 |
thus ?thesis |
|
4673 |
using foldr_max_sorted[OF sorted] False |
|
4674 |
unfolding length_transpose foldr_map comp_def |
|
4675 |
by simp |
|
4676 |
qed simp |
|
4677 |
||
4678 |
lemma nth_nth_transpose_sorted[simp]: |
|
4679 |
fixes xs :: "'a list list" |
|
4680 |
assumes sorted: "sorted (rev (map length xs))" |
|
4681 |
and i: "i < length (transpose xs)" |
|
4682 |
and j: "j < length [ys \<leftarrow> xs. i < length ys]" |
|
4683 |
shows "transpose xs ! i ! j = xs ! j ! i" |
|
4684 |
using j filter_equals_takeWhile_sorted_rev[OF sorted, of i] |
|
4685 |
nth_transpose[OF i] nth_map[OF j] |
|
4686 |
by (simp add: takeWhile_nth) |
|
4687 |
||
4688 |
lemma transpose_column_length: |
|
4689 |
fixes xs :: "'a list list" |
|
4690 |
assumes sorted: "sorted (rev (map length xs))" and "i < length xs" |
|
4691 |
shows "length (filter (\<lambda>ys. i < length ys) (transpose xs)) = length (xs ! i)" |
|
4692 |
proof - |
|
4693 |
have "xs \<noteq> []" using `i < length xs` by auto |
|
4694 |
note filter_equals_takeWhile_sorted_rev[OF sorted, simp] |
|
4695 |
{ fix j assume "j \<le> i" |
|
4696 |
note sorted_rev_nth_mono[OF sorted, of j i, simplified, OF this `i < length xs`] |
|
4697 |
} note sortedE = this[consumes 1] |
|
4698 |
||
4699 |
have "{j. j < length (transpose xs) \<and> i < length (transpose xs ! j)} |
|
4700 |
= {..< length (xs ! i)}" |
|
4701 |
proof safe |
|
4702 |
fix j |
|
4703 |
assume "j < length (transpose xs)" and "i < length (transpose xs ! j)" |
|
4704 |
with this(2) nth_transpose[OF this(1)] |
|
4705 |
have "i < length (takeWhile (\<lambda>ys. j < length ys) xs)" by simp |
|
4706 |
from nth_mem[OF this] takeWhile_nth[OF this] |
|
4707 |
show "j < length (xs ! i)" by (auto dest: set_takeWhileD) |
|
4708 |
next |
|
4709 |
fix j assume "j < length (xs ! i)" |
|
4710 |
thus "j < length (transpose xs)" |
|
4711 |
using foldr_max_sorted[OF sorted] `xs \<noteq> []` sortedE[OF le0] |
|
4712 |
by (auto simp: length_transpose comp_def foldr_map) |
|
4713 |
||
4714 |
have "Suc i \<le> length (takeWhile (\<lambda>ys. j < length ys) xs)" |
|
4715 |
using `i < length xs` `j < length (xs ! i)` less_Suc_eq_le |
|
4716 |
by (auto intro!: length_takeWhile_less_P_nth dest!: sortedE) |
|
4717 |
with nth_transpose[OF `j < length (transpose xs)`] |
|
4718 |
show "i < length (transpose xs ! j)" by simp |
|
4719 |
qed |
|
4720 |
thus ?thesis by (simp add: length_filter_conv_card) |
|
4721 |
qed |
|
4722 |
||
4723 |
lemma transpose_column: |
|
4724 |
fixes xs :: "'a list list" |
|
4725 |
assumes sorted: "sorted (rev (map length xs))" and "i < length xs" |
|
4726 |
shows "map (\<lambda>ys. ys ! i) (filter (\<lambda>ys. i < length ys) (transpose xs)) |
|
4727 |
= xs ! i" (is "?R = _") |
|
4728 |
proof (rule nth_equalityI, safe) |
|
4729 |
show length: "length ?R = length (xs ! i)" |
|
4730 |
using transpose_column_length[OF assms] by simp |
|
4731 |
||
4732 |
fix j assume j: "j < length ?R" |
|
4733 |
note * = less_le_trans[OF this, unfolded length_map, OF length_filter_le] |
|
4734 |
from j have j_less: "j < length (xs ! i)" using length by simp |
|
4735 |
have i_less_tW: "Suc i \<le> length (takeWhile (\<lambda>ys. Suc j \<le> length ys) xs)" |
|
4736 |
proof (rule length_takeWhile_less_P_nth) |
|
4737 |
show "Suc i \<le> length xs" using `i < length xs` by simp |
|
4738 |
fix k assume "k < Suc i" |
|
4739 |
hence "k \<le> i" by auto |
|
4740 |
with sorted_rev_nth_mono[OF sorted this] `i < length xs` |
|
4741 |
have "length (xs ! i) \<le> length (xs ! k)" by simp |
|
4742 |
thus "Suc j \<le> length (xs ! k)" using j_less by simp |
|
4743 |
qed |
|
4744 |
have i_less_filter: "i < length [ys\<leftarrow>xs . j < length ys]" |
|
4745 |
unfolding filter_equals_takeWhile_sorted_rev[OF sorted, of j] |
|
4746 |
using i_less_tW by (simp_all add: Suc_le_eq) |
|
4747 |
from j show "?R ! j = xs ! i ! j" |
|
4748 |
unfolding filter_equals_takeWhile_sorted_rev[OF sorted_transpose, of i] |
|
4749 |
by (simp add: takeWhile_nth nth_nth_transpose_sorted[OF sorted * i_less_filter]) |
|
4750 |
qed |
|
4751 |
||
4752 |
lemma transpose_transpose: |
|
4753 |
fixes xs :: "'a list list" |
|
4754 |
assumes sorted: "sorted (rev (map length xs))" |
|
4755 |
shows "transpose (transpose xs) = takeWhile (\<lambda>x. x \<noteq> []) xs" (is "?L = ?R") |
|
4756 |
proof - |
|
4757 |
have len: "length ?L = length ?R" |
|
4758 |
unfolding length_transpose transpose_max_length |
|
4759 |
using filter_equals_takeWhile_sorted_rev[OF sorted, of 0] |
|
4760 |
by simp |
|
4761 |
||
4762 |
{ fix i assume "i < length ?R" |
|
4763 |
with less_le_trans[OF _ length_takeWhile_le[of _ xs]] |
|
4764 |
have "i < length xs" by simp |
|
4765 |
} note * = this |
|
4766 |
show ?thesis |
|
4767 |
by (rule nth_equalityI) |
|
4768 |
(simp_all add: len nth_transpose transpose_column[OF sorted] * takeWhile_nth) |
|
4769 |
qed |
|
24616 | 4770 |
|
34934
440605046777
Added transpose_rectangle, when the input list is rectangular.
hoelzl
parents:
34933
diff
changeset
|
4771 |
theorem transpose_rectangle: |
440605046777
Added transpose_rectangle, when the input list is rectangular.
hoelzl
parents:
34933
diff
changeset
|
4772 |
assumes "xs = [] \<Longrightarrow> n = 0" |
440605046777
Added transpose_rectangle, when the input list is rectangular.
hoelzl
parents:
34933
diff
changeset
|
4773 |
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
|
4774 |
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
|
4775 |
(is "?trans = ?map") |
440605046777
Added transpose_rectangle, when the input list is rectangular.
hoelzl
parents:
34933
diff
changeset
|
4776 |
proof (rule nth_equalityI) |
440605046777
Added transpose_rectangle, when the input list is rectangular.
hoelzl
parents:
34933
diff
changeset
|
4777 |
have "sorted (rev (map length xs))" |
440605046777
Added transpose_rectangle, when the input list is rectangular.
hoelzl
parents:
34933
diff
changeset
|
4778 |
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
|
4779 |
from foldr_max_sorted[OF this] assms |
440605046777
Added transpose_rectangle, when the input list is rectangular.
hoelzl
parents:
34933
diff
changeset
|
4780 |
show len: "length ?trans = length ?map" |
440605046777
Added transpose_rectangle, when the input list is rectangular.
hoelzl
parents:
34933
diff
changeset
|
4781 |
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
|
4782 |
moreover |
440605046777
Added transpose_rectangle, when the input list is rectangular.
hoelzl
parents:
34933
diff
changeset
|
4783 |
{ 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
|
4784 |
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
|
4785 |
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
|
4786 |
by (auto simp: nth_transpose intro: nth_equalityI) |
440605046777
Added transpose_rectangle, when the input list is rectangular.
hoelzl
parents:
34933
diff
changeset
|
4787 |
qed |
24616 | 4788 |
|
35115 | 4789 |
|
25069 | 4790 |
subsubsection {* @{text sorted_list_of_set} *} |
4791 |
||
4792 |
text{* This function maps (finite) linearly ordered sets to sorted |
|
4793 |
lists. Warning: in most cases it is not a good idea to convert from |
|
4794 |
sets to lists but one should convert in the other direction (via |
|
4795 |
@{const set}). *} |
|
4796 |
||
4797 |
context linorder |
|
4798 |
begin |
|
4799 |
||
35195 | 4800 |
definition sorted_list_of_set :: "'a set \<Rightarrow> 'a list" where |
50548 | 4801 |
"sorted_list_of_set = Finite_Set.fold insort []" |
35195 | 4802 |
|
4803 |
lemma sorted_list_of_set_empty [simp]: |
|
4804 |
"sorted_list_of_set {} = []" |
|
4805 |
by (simp add: sorted_list_of_set_def) |
|
4806 |
||
4807 |
lemma sorted_list_of_set_insert [simp]: |
|
4808 |
assumes "finite A" |
|
4809 |
shows "sorted_list_of_set (insert x A) = insort x (sorted_list_of_set (A - {x}))" |
|
4810 |
proof - |
|
42871
1c0b99f950d9
names of fold_set locales resemble name of characteristic property more closely
haftmann
parents:
42809
diff
changeset
|
4811 |
interpret comp_fun_commute insort by (fact comp_fun_commute_insort) |
46898
1570b30ee040
tuned proofs -- eliminated pointless chaining of facts after 'interpret';
wenzelm
parents:
46884
diff
changeset
|
4812 |
from assms show ?thesis |
1570b30ee040
tuned proofs -- eliminated pointless chaining of facts after 'interpret';
wenzelm
parents:
46884
diff
changeset
|
4813 |
by (simp add: sorted_list_of_set_def fold_insert_remove) |
35195 | 4814 |
qed |
4815 |
||
4816 |
lemma sorted_list_of_set [simp]: |
|
4817 |
"finite A \<Longrightarrow> set (sorted_list_of_set A) = A \<and> sorted (sorted_list_of_set A) |
|
4818 |
\<and> distinct (sorted_list_of_set A)" |
|
4819 |
by (induct A rule: finite_induct) (simp_all add: set_insort sorted_insort distinct_insort) |
|
4820 |
||
47841 | 4821 |
lemma sorted_list_of_set_sort_remdups [code]: |
35195 | 4822 |
"sorted_list_of_set (set xs) = sort (remdups xs)" |
4823 |
proof - |
|
42871
1c0b99f950d9
names of fold_set locales resemble name of characteristic property more closely
haftmann
parents:
42809
diff
changeset
|
4824 |
interpret comp_fun_commute insort by (fact comp_fun_commute_insort) |
46133
d9fe85d3d2cd
incorporated canonical fold combinator on lists into body of List theory; refactored passages on List.fold(l/r)
haftmann
parents:
46125
diff
changeset
|
4825 |
show ?thesis by (simp add: sorted_list_of_set_def sort_conv_fold fold_set_fold_remdups) |
35195 | 4826 |
qed |
25069 | 4827 |
|
37107 | 4828 |
lemma sorted_list_of_set_remove: |
4829 |
assumes "finite A" |
|
4830 |
shows "sorted_list_of_set (A - {x}) = remove1 x (sorted_list_of_set A)" |
|
4831 |
proof (cases "x \<in> A") |
|
4832 |
case False with assms have "x \<notin> set (sorted_list_of_set A)" by simp |
|
4833 |
with False show ?thesis by (simp add: remove1_idem) |
|
4834 |
next |
|
4835 |
case True then obtain B where A: "A = insert x B" by (rule Set.set_insert) |
|
4836 |
with assms show ?thesis by simp |
|
4837 |
qed |
|
4838 |
||
25069 | 4839 |
end |
4840 |
||
37107 | 4841 |
lemma sorted_list_of_set_range [simp]: |
4842 |
"sorted_list_of_set {m..<n} = [m..<n]" |
|
4843 |
by (rule sorted_distinct_set_unique) simp_all |
|
4844 |
||
4845 |
||
15392 | 4846 |
subsubsection {* @{text lists}: the list-forming operator over sets *} |
15302 | 4847 |
|
23740 | 4848 |
inductive_set |
22262 | 4849 |
lists :: "'a set => 'a list set" |
23740 | 4850 |
for A :: "'a set" |
4851 |
where |
|
39613 | 4852 |
Nil [intro!, simp]: "[]: lists A" |
4853 |
| Cons [intro!, simp, no_atp]: "[| a: A; l: lists A|] ==> a#l : lists A" |
|
35828
46cfc4b8112e
now use "Named_Thms" for "noatp", and renamed "noatp" to "no_atp"
blanchet
parents:
35827
diff
changeset
|
4854 |
|
46cfc4b8112e
now use "Named_Thms" for "noatp", and renamed "noatp" to "no_atp"
blanchet
parents:
35827
diff
changeset
|
4855 |
inductive_cases listsE [elim!,no_atp]: "x#l : lists A" |
46cfc4b8112e
now use "Named_Thms" for "noatp", and renamed "noatp" to "no_atp"
blanchet
parents:
35827
diff
changeset
|
4856 |
inductive_cases listspE [elim!,no_atp]: "listsp A (x # l)" |
23740 | 4857 |
|
46313 | 4858 |
inductive_simps listsp_simps[code]: |
4859 |
"listsp A []" |
|
4860 |
"listsp A (x # xs)" |
|
4861 |
||
23740 | 4862 |
lemma listsp_mono [mono]: "A \<le> B ==> listsp A \<le> listsp B" |
46884 | 4863 |
by (rule predicate1I, erule listsp.induct, blast+) |
26795
a27607030a1c
- Explicitely applied predicate1I in a few proofs, because it is no longer
berghofe
parents:
26771
diff
changeset
|
4864 |
|
46176
1898e61e89c4
pred_subset/equals_eq are now standard pred_set_conv rules
berghofe
parents:
46156
diff
changeset
|
4865 |
lemmas lists_mono = listsp_mono [to_set] |
22262 | 4866 |
|
22422
ee19cdb07528
stepping towards uniform lattice theory development in HOL
haftmann
parents:
22262
diff
changeset
|
4867 |
lemma listsp_infI: |
ee19cdb07528
stepping towards uniform lattice theory development in HOL
haftmann
parents:
22262
diff
changeset
|
4868 |
assumes l: "listsp A l" shows "listsp B l ==> listsp (inf A B) l" using l |
24349 | 4869 |
by induct blast+ |
15302 | 4870 |
|
22422
ee19cdb07528
stepping towards uniform lattice theory development in HOL
haftmann
parents:
22262
diff
changeset
|
4871 |
lemmas lists_IntI = listsp_infI [to_set] |
ee19cdb07528
stepping towards uniform lattice theory development in HOL
haftmann
parents:
22262
diff
changeset
|
4872 |
|
ee19cdb07528
stepping towards uniform lattice theory development in HOL
haftmann
parents:
22262
diff
changeset
|
4873 |
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
|
4874 |
proof (rule mono_inf [where f=listsp, THEN order_antisym]) |
22262 | 4875 |
show "mono listsp" by (simp add: mono_def listsp_mono) |
47397
d654c73e4b12
no preference wrt. fold(l/r); prefer fold rather than foldr for iterating over lists in generated code
haftmann
parents:
47131
diff
changeset
|
4876 |
show "inf (listsp A) (listsp B) \<le> listsp (inf A B)" by (blast intro!: listsp_infI) |
14388 | 4877 |
qed |
4878 |
||
41075
4bed56dc95fb
primitive definitions of bot/top/inf/sup for bool and fun are named with canonical suffix `_def` rather than `_eq`
haftmann
parents:
40968
diff
changeset
|
4879 |
lemmas listsp_conj_eq [simp] = listsp_inf_eq [simplified inf_fun_def inf_bool_def] |
22422
ee19cdb07528
stepping towards uniform lattice theory development in HOL
haftmann
parents:
22262
diff
changeset
|
4880 |
|
46176
1898e61e89c4
pred_subset/equals_eq are now standard pred_set_conv rules
berghofe
parents:
46156
diff
changeset
|
4881 |
lemmas lists_Int_eq [simp] = listsp_inf_eq [to_set] |
22262 | 4882 |
|
39613 | 4883 |
lemma Cons_in_lists_iff[simp]: "x#xs : lists A \<longleftrightarrow> x:A \<and> xs : lists A" |
4884 |
by auto |
|
4885 |
||
22262 | 4886 |
lemma append_in_listsp_conv [iff]: |
4887 |
"(listsp A (xs @ ys)) = (listsp A xs \<and> listsp A ys)" |
|
15302 | 4888 |
by (induct xs) auto |
4889 |
||
22262 | 4890 |
lemmas append_in_lists_conv [iff] = append_in_listsp_conv [to_set] |
4891 |
||
4892 |
lemma in_listsp_conv_set: "(listsp A xs) = (\<forall>x \<in> set xs. A x)" |
|
4893 |
-- {* eliminate @{text listsp} in favour of @{text set} *} |
|
15302 | 4894 |
by (induct xs) auto |
4895 |
||
46313 | 4896 |
lemmas in_lists_conv_set [code_unfold] = in_listsp_conv_set [to_set] |
22262 | 4897 |
|
35828
46cfc4b8112e
now use "Named_Thms" for "noatp", and renamed "noatp" to "no_atp"
blanchet
parents:
35827
diff
changeset
|
4898 |
lemma in_listspD [dest!,no_atp]: "listsp A xs ==> \<forall>x\<in>set xs. A x" |
22262 | 4899 |
by (rule in_listsp_conv_set [THEN iffD1]) |
4900 |
||
35828
46cfc4b8112e
now use "Named_Thms" for "noatp", and renamed "noatp" to "no_atp"
blanchet
parents:
35827
diff
changeset
|
4901 |
lemmas in_listsD [dest!,no_atp] = in_listspD [to_set] |
46cfc4b8112e
now use "Named_Thms" for "noatp", and renamed "noatp" to "no_atp"
blanchet
parents:
35827
diff
changeset
|
4902 |
|
46cfc4b8112e
now use "Named_Thms" for "noatp", and renamed "noatp" to "no_atp"
blanchet
parents:
35827
diff
changeset
|
4903 |
lemma in_listspI [intro!,no_atp]: "\<forall>x\<in>set xs. A x ==> listsp A xs" |
22262 | 4904 |
by (rule in_listsp_conv_set [THEN iffD2]) |
4905 |
||
35828
46cfc4b8112e
now use "Named_Thms" for "noatp", and renamed "noatp" to "no_atp"
blanchet
parents:
35827
diff
changeset
|
4906 |
lemmas in_listsI [intro!,no_atp] = in_listspI [to_set] |
15302 | 4907 |
|
39597 | 4908 |
lemma lists_eq_set: "lists A = {xs. set xs <= A}" |
4909 |
by auto |
|
4910 |
||
39613 | 4911 |
lemma lists_empty [simp]: "lists {} = {[]}" |
4912 |
by auto |
|
4913 |
||
15302 | 4914 |
lemma lists_UNIV [simp]: "lists UNIV = UNIV" |
4915 |
by auto |
|
4916 |
||
50134 | 4917 |
lemma lists_image: "lists (f`A) = map f ` lists A" |
4918 |
proof - |
|
4919 |
{ fix xs have "\<forall>x\<in>set xs. x \<in> f ` A \<Longrightarrow> xs \<in> map f ` lists A" |
|
4920 |
by (induct xs) (auto simp del: map.simps simp add: map.simps[symmetric] intro!: imageI) } |
|
4921 |
then show ?thesis by auto |
|
4922 |
qed |
|
17086 | 4923 |
|
35115 | 4924 |
subsubsection {* Inductive definition for membership *} |
17086 | 4925 |
|
23740 | 4926 |
inductive ListMem :: "'a \<Rightarrow> 'a list \<Rightarrow> bool" |
22262 | 4927 |
where |
4928 |
elem: "ListMem x (x # xs)" |
|
4929 |
| insert: "ListMem x xs \<Longrightarrow> ListMem x (y # xs)" |
|
4930 |
||
4931 |
lemma ListMem_iff: "(ListMem x xs) = (x \<in> set xs)" |
|
17086 | 4932 |
apply (rule iffI) |
4933 |
apply (induct set: ListMem) |
|
4934 |
apply auto |
|
4935 |
apply (induct xs) |
|
4936 |
apply (auto intro: ListMem.intros) |
|
4937 |
done |
|
4938 |
||
4939 |
||
35115 | 4940 |
subsubsection {* Lists as Cartesian products *} |
15302 | 4941 |
|
4942 |
text{*@{text"set_Cons A Xs"}: the set of lists with head drawn from |
|
4943 |
@{term A} and tail drawn from @{term Xs}.*} |
|
4944 |
||
50548 | 4945 |
definition set_Cons :: "'a set \<Rightarrow> 'a list set \<Rightarrow> 'a list set" where |
4946 |
"set_Cons A XS = {z. \<exists>x xs. z = x # xs \<and> x \<in> A \<and> xs \<in> XS}" |
|
15302 | 4947 |
|
17724 | 4948 |
lemma set_Cons_sing_Nil [simp]: "set_Cons A {[]} = (%x. [x])`A" |
15302 | 4949 |
by (auto simp add: set_Cons_def) |
4950 |
||
4951 |
text{*Yields the set of lists, all of the same length as the argument and |
|
4952 |
with elements drawn from the corresponding element of the argument.*} |
|
4953 |
||
50548 | 4954 |
primrec listset :: "'a set list \<Rightarrow> 'a list set" where |
4955 |
"listset [] = {[]}" | |
|
4956 |
"listset (A # As) = set_Cons A (listset As)" |
|
15302 | 4957 |
|
4958 |
||
35115 | 4959 |
subsection {* Relations on Lists *} |
15656 | 4960 |
|
4961 |
subsubsection {* Length Lexicographic Ordering *} |
|
4962 |
||
4963 |
text{*These orderings preserve well-foundedness: shorter lists |
|
4964 |
precede longer lists. These ordering are not used in dictionaries.*} |
|
34941 | 4965 |
|
4966 |
primrec -- {*The lexicographic ordering for lists of the specified length*} |
|
4967 |
lexn :: "('a \<times> 'a) set \<Rightarrow> nat \<Rightarrow> ('a list \<times> 'a list) set" where |
|
50548 | 4968 |
"lexn r 0 = {}" | |
4969 |
"lexn r (Suc n) = |
|
4970 |
(map_pair (%(x, xs). x#xs) (%(x, xs). x#xs) ` (r <*lex*> lexn r n)) Int |
|
4971 |
{(xs, ys). length xs = Suc n \<and> length ys = Suc n}" |
|
4972 |
||
4973 |
definition lex :: "('a \<times> 'a) set \<Rightarrow> ('a list \<times> 'a list) set" where |
|
4974 |
"lex r = (\<Union>n. lexn r n)" -- {*Holds only between lists of the same length*} |
|
4975 |
||
4976 |
definition lenlex :: "('a \<times> 'a) set => ('a list \<times> 'a list) set" where |
|
4977 |
"lenlex r = inv_image (less_than <*lex*> lex r) (\<lambda>xs. (length xs, xs))" |
|
34941 | 4978 |
-- {*Compares lists by their length and then lexicographically*} |
15302 | 4979 |
|
4980 |
lemma wf_lexn: "wf r ==> wf (lexn r n)" |
|
4981 |
apply (induct n, simp, simp) |
|
4982 |
apply(rule wf_subset) |
|
4983 |
prefer 2 apply (rule Int_lower1) |
|
40608
6c28ab8b8166
mapper for list type; map_pair replaces prod_fun
haftmann
parents:
40593
diff
changeset
|
4984 |
apply(rule wf_map_pair_image) |
15302 | 4985 |
prefer 2 apply (rule inj_onI, auto) |
4986 |
done |
|
4987 |
||
4988 |
lemma lexn_length: |
|
24526 | 4989 |
"(xs, ys) : lexn r n ==> length xs = n \<and> length ys = n" |
4990 |
by (induct n arbitrary: xs ys) auto |
|
15302 | 4991 |
|
4992 |
lemma wf_lex [intro!]: "wf r ==> wf (lex r)" |
|
4993 |
apply (unfold lex_def) |
|
4994 |
apply (rule wf_UN) |
|
4995 |
apply (blast intro: wf_lexn, clarify) |
|
4996 |
apply (rename_tac m n) |
|
4997 |
apply (subgoal_tac "m \<noteq> n") |
|
4998 |
prefer 2 apply blast |
|
4999 |
apply (blast dest: lexn_length not_sym) |
|
5000 |
done |
|
5001 |
||
5002 |
lemma lexn_conv: |
|
15656 | 5003 |
"lexn r n = |
5004 |
{(xs,ys). length xs = n \<and> length ys = n \<and> |
|
5005 |
(\<exists>xys x y xs' ys'. xs= xys @ x#xs' \<and> ys= xys @ y # ys' \<and> (x, y):r)}" |
|
18423 | 5006 |
apply (induct n, simp) |
15302 | 5007 |
apply (simp add: image_Collect lex_prod_def, safe, blast) |
5008 |
apply (rule_tac x = "ab # xys" in exI, simp) |
|
5009 |
apply (case_tac xys, simp_all, blast) |
|
5010 |
done |
|
5011 |
||
5012 |
lemma lex_conv: |
|
15656 | 5013 |
"lex r = |
5014 |
{(xs,ys). length xs = length ys \<and> |
|
5015 |
(\<exists>xys x y xs' ys'. xs = xys @ x # xs' \<and> ys = xys @ y # ys' \<and> (x, y):r)}" |
|
15302 | 5016 |
by (force simp add: lex_def lexn_conv) |
5017 |
||
15693 | 5018 |
lemma wf_lenlex [intro!]: "wf r ==> wf (lenlex r)" |
5019 |
by (unfold lenlex_def) blast |
|
5020 |
||
5021 |
lemma lenlex_conv: |
|
5022 |
"lenlex r = {(xs,ys). length xs < length ys | |
|
15656 | 5023 |
length xs = length ys \<and> (xs, ys) : lex r}" |
30198 | 5024 |
by (simp add: lenlex_def Id_on_def lex_prod_def inv_image_def) |
15302 | 5025 |
|
5026 |
lemma Nil_notin_lex [iff]: "([], ys) \<notin> lex r" |
|
5027 |
by (simp add: lex_conv) |
|
5028 |
||
5029 |
lemma Nil2_notin_lex [iff]: "(xs, []) \<notin> lex r" |
|
5030 |
by (simp add:lex_conv) |
|
5031 |
||
18447 | 5032 |
lemma Cons_in_lex [simp]: |
15656 | 5033 |
"((x # xs, y # ys) : lex r) = |
5034 |
((x, y) : r \<and> length xs = length ys | x = y \<and> (xs, ys) : lex r)" |
|
15302 | 5035 |
apply (simp add: lex_conv) |
5036 |
apply (rule iffI) |
|
5037 |
prefer 2 apply (blast intro: Cons_eq_appendI, clarify) |
|
5038 |
apply (case_tac xys, simp, simp) |
|
5039 |
apply blast |
|
5040 |
done |
|
5041 |
||
5042 |
||
15656 | 5043 |
subsubsection {* Lexicographic Ordering *} |
5044 |
||
5045 |
text {* Classical lexicographic ordering on lists, ie. "a" < "ab" < "b". |
|
5046 |
This ordering does \emph{not} preserve well-foundedness. |
|
17090 | 5047 |
Author: N. Voelker, March 2005. *} |
15656 | 5048 |
|
50548 | 5049 |
definition lexord :: "('a \<times> 'a) set \<Rightarrow> ('a list \<times> 'a list) set" where |
5050 |
"lexord r = {(x,y). \<exists> a v. y = x @ a # v \<or> |
|
15656 | 5051 |
(\<exists> u a b v w. (a,b) \<in> r \<and> x = u @ (a # v) \<and> y = u @ (b # w))}" |
5052 |
||
5053 |
lemma lexord_Nil_left[simp]: "([],y) \<in> lexord r = (\<exists> a x. y = a # x)" |
|
24349 | 5054 |
by (unfold lexord_def, induct_tac y, auto) |
15656 | 5055 |
|
5056 |
lemma lexord_Nil_right[simp]: "(x,[]) \<notin> lexord r" |
|
24349 | 5057 |
by (unfold lexord_def, induct_tac x, auto) |
15656 | 5058 |
|
5059 |
lemma lexord_cons_cons[simp]: |
|
5060 |
"((a # x, b # y) \<in> lexord r) = ((a,b)\<in> r | (a = b & (x,y)\<in> lexord r))" |
|
5061 |
apply (unfold lexord_def, safe, simp_all) |
|
5062 |
apply (case_tac u, simp, simp) |
|
5063 |
apply (case_tac u, simp, clarsimp, blast, blast, clarsimp) |
|
5064 |
apply (erule_tac x="b # u" in allE) |
|
5065 |
by force |
|
5066 |
||
5067 |
lemmas lexord_simps = lexord_Nil_left lexord_Nil_right lexord_cons_cons |
|
5068 |
||
5069 |
lemma lexord_append_rightI: "\<exists> b z. y = b # z \<Longrightarrow> (x, x @ y) \<in> lexord r" |
|
24349 | 5070 |
by (induct_tac x, auto) |
15656 | 5071 |
|
5072 |
lemma lexord_append_left_rightI: |
|
5073 |
"(a,b) \<in> r \<Longrightarrow> (u @ a # x, u @ b # y) \<in> lexord r" |
|
24349 | 5074 |
by (induct_tac u, auto) |
15656 | 5075 |
|
5076 |
lemma lexord_append_leftI: " (u,v) \<in> lexord r \<Longrightarrow> (x @ u, x @ v) \<in> lexord r" |
|
24349 | 5077 |
by (induct x, auto) |
15656 | 5078 |
|
5079 |
lemma lexord_append_leftD: |
|
5080 |
"\<lbrakk> (x @ u, x @ v) \<in> lexord r; (! a. (a,a) \<notin> r) \<rbrakk> \<Longrightarrow> (u,v) \<in> lexord r" |
|
24349 | 5081 |
by (erule rev_mp, induct_tac x, auto) |
15656 | 5082 |
|
5083 |
lemma lexord_take_index_conv: |
|
5084 |
"((x,y) : lexord r) = |
|
5085 |
((length x < length y \<and> take (length x) y = x) \<or> |
|
5086 |
(\<exists>i. i < min(length x)(length y) & take i x = take i y & (x!i,y!i) \<in> r))" |
|
5087 |
apply (unfold lexord_def Let_def, clarsimp) |
|
5088 |
apply (rule_tac f = "(% a b. a \<or> b)" in arg_cong2) |
|
5089 |
apply auto |
|
5090 |
apply (rule_tac x="hd (drop (length x) y)" in exI) |
|
5091 |
apply (rule_tac x="tl (drop (length x) y)" in exI) |
|
5092 |
apply (erule subst, simp add: min_def) |
|
5093 |
apply (rule_tac x ="length u" in exI, simp) |
|
5094 |
apply (rule_tac x ="take i x" in exI) |
|
5095 |
apply (rule_tac x ="x ! i" in exI) |
|
5096 |
apply (rule_tac x ="y ! i" in exI, safe) |
|
5097 |
apply (rule_tac x="drop (Suc i) x" in exI) |
|
5098 |
apply (drule sym, simp add: drop_Suc_conv_tl) |
|
5099 |
apply (rule_tac x="drop (Suc i) y" in exI) |
|
5100 |
by (simp add: drop_Suc_conv_tl) |
|
5101 |
||
5102 |
-- {* lexord is extension of partial ordering List.lex *} |
|
41986 | 5103 |
lemma lexord_lex: "(x,y) \<in> lex r = ((x,y) \<in> lexord r \<and> length x = length y)" |
15656 | 5104 |
apply (rule_tac x = y in spec) |
5105 |
apply (induct_tac x, clarsimp) |
|
5106 |
by (clarify, case_tac x, simp, force) |
|
5107 |
||
41986 | 5108 |
lemma lexord_irreflexive: "ALL x. (x,x) \<notin> r \<Longrightarrow> (xs,xs) \<notin> lexord r" |
5109 |
by (induct xs) auto |
|
5110 |
||
5111 |
text{* By Ren\'e Thiemann: *} |
|
5112 |
lemma lexord_partial_trans: |
|
5113 |
"(\<And>x y z. x \<in> set xs \<Longrightarrow> (x,y) \<in> r \<Longrightarrow> (y,z) \<in> r \<Longrightarrow> (x,z) \<in> r) |
|
5114 |
\<Longrightarrow> (xs,ys) \<in> lexord r \<Longrightarrow> (ys,zs) \<in> lexord r \<Longrightarrow> (xs,zs) \<in> lexord r" |
|
5115 |
proof (induct xs arbitrary: ys zs) |
|
5116 |
case Nil |
|
5117 |
from Nil(3) show ?case unfolding lexord_def by (cases zs, auto) |
|
5118 |
next |
|
5119 |
case (Cons x xs yys zzs) |
|
5120 |
from Cons(3) obtain y ys where yys: "yys = y # ys" unfolding lexord_def |
|
5121 |
by (cases yys, auto) |
|
5122 |
note Cons = Cons[unfolded yys] |
|
5123 |
from Cons(3) have one: "(x,y) \<in> r \<or> x = y \<and> (xs,ys) \<in> lexord r" by auto |
|
5124 |
from Cons(4) obtain z zs where zzs: "zzs = z # zs" unfolding lexord_def |
|
5125 |
by (cases zzs, auto) |
|
5126 |
note Cons = Cons[unfolded zzs] |
|
5127 |
from Cons(4) have two: "(y,z) \<in> r \<or> y = z \<and> (ys,zs) \<in> lexord r" by auto |
|
5128 |
{ |
|
5129 |
assume "(xs,ys) \<in> lexord r" and "(ys,zs) \<in> lexord r" |
|
5130 |
from Cons(1)[OF _ this] Cons(2) |
|
5131 |
have "(xs,zs) \<in> lexord r" by auto |
|
5132 |
} note ind1 = this |
|
5133 |
{ |
|
5134 |
assume "(x,y) \<in> r" and "(y,z) \<in> r" |
|
5135 |
from Cons(2)[OF _ this] have "(x,z) \<in> r" by auto |
|
5136 |
} note ind2 = this |
|
5137 |
from one two ind1 ind2 |
|
5138 |
have "(x,z) \<in> r \<or> x = z \<and> (xs,zs) \<in> lexord r" by blast |
|
5139 |
thus ?case unfolding zzs by auto |
|
5140 |
qed |
|
15656 | 5141 |
|
5142 |
lemma lexord_trans: |
|
5143 |
"\<lbrakk> (x, y) \<in> lexord r; (y, z) \<in> lexord r; trans r \<rbrakk> \<Longrightarrow> (x, z) \<in> lexord r" |
|
41986 | 5144 |
by(auto simp: trans_def intro:lexord_partial_trans) |
15656 | 5145 |
|
5146 |
lemma lexord_transI: "trans r \<Longrightarrow> trans (lexord r)" |
|
24349 | 5147 |
by (rule transI, drule lexord_trans, blast) |
15656 | 5148 |
|
5149 |
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" |
|
5150 |
apply (rule_tac x = y in spec) |
|
5151 |
apply (induct_tac x, rule allI) |
|
5152 |
apply (case_tac x, simp, simp) |
|
5153 |
apply (rule allI, case_tac x, simp, simp) |
|
5154 |
by blast |
|
5155 |
||
5156 |
||
40230 | 5157 |
subsubsection {* Lexicographic combination of measure functions *} |
21103
367b4ad7c7cc
Added "measures" combinator for lexicographic combinations of multiple measures.
krauss
parents:
21079
diff
changeset
|
5158 |
|
367b4ad7c7cc
Added "measures" combinator for lexicographic combinations of multiple measures.
krauss
parents:
21079
diff
changeset
|
5159 |
text {* These are useful for termination proofs *} |
367b4ad7c7cc
Added "measures" combinator for lexicographic combinations of multiple measures.
krauss
parents:
21079
diff
changeset
|
5160 |
|
50548 | 5161 |
definition "measures fs = inv_image (lex less_than) (%a. map (%f. f a) fs)" |
21103
367b4ad7c7cc
Added "measures" combinator for lexicographic combinations of multiple measures.
krauss
parents:
21079
diff
changeset
|
5162 |
|
44013
5cfc1c36ae97
moved recdef package to HOL/Library/Old_Recdef.thy
krauss
parents:
43594
diff
changeset
|
5163 |
lemma wf_measures[simp]: "wf (measures fs)" |
24349 | 5164 |
unfolding measures_def |
5165 |
by blast |
|
21103
367b4ad7c7cc
Added "measures" combinator for lexicographic combinations of multiple measures.
krauss
parents:
21079
diff
changeset
|
5166 |
|
367b4ad7c7cc
Added "measures" combinator for lexicographic combinations of multiple measures.
krauss
parents:
21079
diff
changeset
|
5167 |
lemma in_measures[simp]: |
367b4ad7c7cc
Added "measures" combinator for lexicographic combinations of multiple measures.
krauss
parents:
21079
diff
changeset
|
5168 |
"(x, y) \<in> measures [] = False" |
367b4ad7c7cc
Added "measures" combinator for lexicographic combinations of multiple measures.
krauss
parents:
21079
diff
changeset
|
5169 |
"(x, y) \<in> measures (f # fs) |
367b4ad7c7cc
Added "measures" combinator for lexicographic combinations of multiple measures.
krauss
parents:
21079
diff
changeset
|
5170 |
= (f x < f y \<or> (f x = f y \<and> (x, y) \<in> measures fs))" |
24349 | 5171 |
unfolding measures_def |
5172 |
by auto |
|
21103
367b4ad7c7cc
Added "measures" combinator for lexicographic combinations of multiple measures.
krauss
parents:
21079
diff
changeset
|
5173 |
|
367b4ad7c7cc
Added "measures" combinator for lexicographic combinations of multiple measures.
krauss
parents:
21079
diff
changeset
|
5174 |
lemma measures_less: "f x < f y ==> (x, y) \<in> measures (f#fs)" |
24349 | 5175 |
by simp |
21103
367b4ad7c7cc
Added "measures" combinator for lexicographic combinations of multiple measures.
krauss
parents:
21079
diff
changeset
|
5176 |
|
367b4ad7c7cc
Added "measures" combinator for lexicographic combinations of multiple measures.
krauss
parents:
21079
diff
changeset
|
5177 |
lemma measures_lesseq: "f x <= f y ==> (x, y) \<in> measures fs ==> (x, y) \<in> measures (f#fs)" |
24349 | 5178 |
by auto |
21103
367b4ad7c7cc
Added "measures" combinator for lexicographic combinations of multiple measures.
krauss
parents:
21079
diff
changeset
|
5179 |
|
367b4ad7c7cc
Added "measures" combinator for lexicographic combinations of multiple measures.
krauss
parents:
21079
diff
changeset
|
5180 |
|
40230 | 5181 |
subsubsection {* Lifting Relations to Lists: one element *} |
5182 |
||
5183 |
definition listrel1 :: "('a \<times> 'a) set \<Rightarrow> ('a list \<times> 'a list) set" where |
|
5184 |
"listrel1 r = {(xs,ys). |
|
5185 |
\<exists>us z z' vs. xs = us @ z # vs \<and> (z,z') \<in> r \<and> ys = us @ z' # vs}" |
|
5186 |
||
5187 |
lemma listrel1I: |
|
5188 |
"\<lbrakk> (x, y) \<in> r; xs = us @ x # vs; ys = us @ y # vs \<rbrakk> \<Longrightarrow> |
|
5189 |
(xs, ys) \<in> listrel1 r" |
|
5190 |
unfolding listrel1_def by auto |
|
5191 |
||
5192 |
lemma listrel1E: |
|
5193 |
"\<lbrakk> (xs, ys) \<in> listrel1 r; |
|
5194 |
!!x y us vs. \<lbrakk> (x, y) \<in> r; xs = us @ x # vs; ys = us @ y # vs \<rbrakk> \<Longrightarrow> P |
|
5195 |
\<rbrakk> \<Longrightarrow> P" |
|
5196 |
unfolding listrel1_def by auto |
|
5197 |
||
5198 |
lemma not_Nil_listrel1 [iff]: "([], xs) \<notin> listrel1 r" |
|
5199 |
unfolding listrel1_def by blast |
|
5200 |
||
5201 |
lemma not_listrel1_Nil [iff]: "(xs, []) \<notin> listrel1 r" |
|
5202 |
unfolding listrel1_def by blast |
|
5203 |
||
5204 |
lemma Cons_listrel1_Cons [iff]: |
|
5205 |
"(x # xs, y # ys) \<in> listrel1 r \<longleftrightarrow> |
|
5206 |
(x,y) \<in> r \<and> xs = ys \<or> x = y \<and> (xs, ys) \<in> listrel1 r" |
|
5207 |
by (simp add: listrel1_def Cons_eq_append_conv) (blast) |
|
5208 |
||
5209 |
lemma listrel1I1: "(x,y) \<in> r \<Longrightarrow> (x # xs, y # xs) \<in> listrel1 r" |
|
5210 |
by (metis Cons_listrel1_Cons) |
|
5211 |
||
5212 |
lemma listrel1I2: "(xs, ys) \<in> listrel1 r \<Longrightarrow> (x # xs, x # ys) \<in> listrel1 r" |
|
5213 |
by (metis Cons_listrel1_Cons) |
|
5214 |
||
5215 |
lemma append_listrel1I: |
|
5216 |
"(xs, ys) \<in> listrel1 r \<and> us = vs \<or> xs = ys \<and> (us, vs) \<in> listrel1 r |
|
5217 |
\<Longrightarrow> (xs @ us, ys @ vs) \<in> listrel1 r" |
|
5218 |
unfolding listrel1_def |
|
5219 |
by auto (blast intro: append_eq_appendI)+ |
|
5220 |
||
5221 |
lemma Cons_listrel1E1[elim!]: |
|
5222 |
assumes "(x # xs, ys) \<in> listrel1 r" |
|
5223 |
and "\<And>y. ys = y # xs \<Longrightarrow> (x, y) \<in> r \<Longrightarrow> R" |
|
5224 |
and "\<And>zs. ys = x # zs \<Longrightarrow> (xs, zs) \<in> listrel1 r \<Longrightarrow> R" |
|
5225 |
shows R |
|
5226 |
using assms by (cases ys) blast+ |
|
5227 |
||
5228 |
lemma Cons_listrel1E2[elim!]: |
|
5229 |
assumes "(xs, y # ys) \<in> listrel1 r" |
|
5230 |
and "\<And>x. xs = x # ys \<Longrightarrow> (x, y) \<in> r \<Longrightarrow> R" |
|
5231 |
and "\<And>zs. xs = y # zs \<Longrightarrow> (zs, ys) \<in> listrel1 r \<Longrightarrow> R" |
|
5232 |
shows R |
|
5233 |
using assms by (cases xs) blast+ |
|
5234 |
||
5235 |
lemma snoc_listrel1_snoc_iff: |
|
5236 |
"(xs @ [x], ys @ [y]) \<in> listrel1 r |
|
5237 |
\<longleftrightarrow> (xs, ys) \<in> listrel1 r \<and> x = y \<or> xs = ys \<and> (x,y) \<in> r" (is "?L \<longleftrightarrow> ?R") |
|
5238 |
proof |
|
5239 |
assume ?L thus ?R |
|
44890
22f665a2e91c
new fastforce replacing fastsimp - less confusing name
nipkow
parents:
44635
diff
changeset
|
5240 |
by (fastforce simp: listrel1_def snoc_eq_iff_butlast butlast_append) |
40230 | 5241 |
next |
5242 |
assume ?R then show ?L unfolding listrel1_def by force |
|
5243 |
qed |
|
5244 |
||
5245 |
lemma listrel1_eq_len: "(xs,ys) \<in> listrel1 r \<Longrightarrow> length xs = length ys" |
|
5246 |
unfolding listrel1_def by auto |
|
5247 |
||
5248 |
lemma listrel1_mono: |
|
5249 |
"r \<subseteq> s \<Longrightarrow> listrel1 r \<subseteq> listrel1 s" |
|
5250 |
unfolding listrel1_def by blast |
|
5251 |
||
5252 |
||
5253 |
lemma listrel1_converse: "listrel1 (r^-1) = (listrel1 r)^-1" |
|
5254 |
unfolding listrel1_def by blast |
|
5255 |
||
5256 |
lemma in_listrel1_converse: |
|
5257 |
"(x,y) : listrel1 (r^-1) \<longleftrightarrow> (x,y) : (listrel1 r)^-1" |
|
5258 |
unfolding listrel1_def by blast |
|
5259 |
||
5260 |
lemma listrel1_iff_update: |
|
5261 |
"(xs,ys) \<in> (listrel1 r) |
|
5262 |
\<longleftrightarrow> (\<exists>y n. (xs ! n, y) \<in> r \<and> n < length xs \<and> ys = xs[n:=y])" (is "?L \<longleftrightarrow> ?R") |
|
5263 |
proof |
|
5264 |
assume "?L" |
|
5265 |
then obtain x y u v where "xs = u @ x # v" "ys = u @ y # v" "(x,y) \<in> r" |
|
5266 |
unfolding listrel1_def by auto |
|
5267 |
then have "ys = xs[length u := y]" and "length u < length xs" |
|
5268 |
and "(xs ! length u, y) \<in> r" by auto |
|
5269 |
then show "?R" by auto |
|
5270 |
next |
|
5271 |
assume "?R" |
|
5272 |
then obtain x y n where "(xs!n, y) \<in> r" "n < size xs" "ys = xs[n:=y]" "x = xs!n" |
|
5273 |
by auto |
|
5274 |
then obtain u v where "xs = u @ x # v" and "ys = u @ y # v" and "(x, y) \<in> r" |
|
5275 |
by (auto intro: upd_conv_take_nth_drop id_take_nth_drop) |
|
5276 |
then show "?L" by (auto simp: listrel1_def) |
|
5277 |
qed |
|
5278 |
||
5279 |
||
44510 | 5280 |
text{* Accessible part and wellfoundedness: *} |
40230 | 5281 |
|
5282 |
lemma Cons_acc_listrel1I [intro!]: |
|
5283 |
"x \<in> acc r \<Longrightarrow> xs \<in> acc (listrel1 r) \<Longrightarrow> (x # xs) \<in> acc (listrel1 r)" |
|
5284 |
apply (induct arbitrary: xs set: acc) |
|
5285 |
apply (erule thin_rl) |
|
5286 |
apply (erule acc_induct) |
|
5287 |
apply (rule accI) |
|
5288 |
apply (blast) |
|
5289 |
done |
|
5290 |
||
5291 |
lemma lists_accD: "xs \<in> lists (acc r) \<Longrightarrow> xs \<in> acc (listrel1 r)" |
|
5292 |
apply (induct set: lists) |
|
5293 |
apply (rule accI) |
|
5294 |
apply simp |
|
5295 |
apply (rule accI) |
|
5296 |
apply (fast dest: acc_downward) |
|
5297 |
done |
|
5298 |
||
5299 |
lemma lists_accI: "xs \<in> acc (listrel1 r) \<Longrightarrow> xs \<in> lists (acc r)" |
|
5300 |
apply (induct set: acc) |
|
5301 |
apply clarify |
|
5302 |
apply (rule accI) |
|
44890
22f665a2e91c
new fastforce replacing fastsimp - less confusing name
nipkow
parents:
44635
diff
changeset
|
5303 |
apply (fastforce dest!: in_set_conv_decomp[THEN iffD1] simp: listrel1_def) |
40230 | 5304 |
done |
5305 |
||
44510 | 5306 |
lemma wf_listrel1_iff[simp]: "wf(listrel1 r) = wf r" |
5307 |
by(metis wf_acc_iff in_lists_conv_set lists_accI lists_accD Cons_in_lists_iff) |
|
5308 |
||
40230 | 5309 |
|
5310 |
subsubsection {* Lifting Relations to Lists: all elements *} |
|
15302 | 5311 |
|
23740 | 5312 |
inductive_set |
46317 | 5313 |
listrel :: "('a \<times> 'b) set \<Rightarrow> ('a list \<times> 'b list) set" |
5314 |
for r :: "('a \<times> 'b) set" |
|
22262 | 5315 |
where |
23740 | 5316 |
Nil: "([],[]) \<in> listrel r" |
5317 |
| Cons: "[| (x,y) \<in> r; (xs,ys) \<in> listrel r |] ==> (x#xs, y#ys) \<in> listrel r" |
|
5318 |
||
5319 |
inductive_cases listrel_Nil1 [elim!]: "([],xs) \<in> listrel r" |
|
5320 |
inductive_cases listrel_Nil2 [elim!]: "(xs,[]) \<in> listrel r" |
|
5321 |
inductive_cases listrel_Cons1 [elim!]: "(y#ys,xs) \<in> listrel r" |
|
5322 |
inductive_cases listrel_Cons2 [elim!]: "(xs,y#ys) \<in> listrel r" |
|
15302 | 5323 |
|
5324 |
||
40230 | 5325 |
lemma listrel_eq_len: "(xs, ys) \<in> listrel r \<Longrightarrow> length xs = length ys" |
5326 |
by(induct rule: listrel.induct) auto |
|
5327 |
||
46313 | 5328 |
lemma listrel_iff_zip [code_unfold]: "(xs,ys) : listrel r \<longleftrightarrow> |
40230 | 5329 |
length xs = length ys & (\<forall>(x,y) \<in> set(zip xs ys). (x,y) \<in> r)" (is "?L \<longleftrightarrow> ?R") |
5330 |
proof |
|
5331 |
assume ?L thus ?R by induct (auto intro: listrel_eq_len) |
|
5332 |
next |
|
5333 |
assume ?R thus ?L |
|
5334 |
apply (clarify) |
|
5335 |
by (induct rule: list_induct2) (auto intro: listrel.intros) |
|
5336 |
qed |
|
5337 |
||
5338 |
lemma listrel_iff_nth: "(xs,ys) : listrel r \<longleftrightarrow> |
|
5339 |
length xs = length ys & (\<forall>n < length xs. (xs!n, ys!n) \<in> r)" (is "?L \<longleftrightarrow> ?R") |
|
5340 |
by (auto simp add: all_set_conv_all_nth listrel_iff_zip) |
|
5341 |
||
5342 |
||
15302 | 5343 |
lemma listrel_mono: "r \<subseteq> s \<Longrightarrow> listrel r \<subseteq> listrel s" |
5344 |
apply clarify |
|
23740 | 5345 |
apply (erule listrel.induct) |
5346 |
apply (blast intro: listrel.intros)+ |
|
15302 | 5347 |
done |
5348 |
||
5349 |
lemma listrel_subset: "r \<subseteq> A \<times> A \<Longrightarrow> listrel r \<subseteq> lists A \<times> lists A" |
|
5350 |
apply clarify |
|
23740 | 5351 |
apply (erule listrel.induct, auto) |
15302 | 5352 |
done |
5353 |
||
30198 | 5354 |
lemma listrel_refl_on: "refl_on A r \<Longrightarrow> refl_on (lists A) (listrel r)" |
5355 |
apply (simp add: refl_on_def listrel_subset Ball_def) |
|
15302 | 5356 |
apply (rule allI) |
5357 |
apply (induct_tac x) |
|
23740 | 5358 |
apply (auto intro: listrel.intros) |
15302 | 5359 |
done |
5360 |
||
5361 |
lemma listrel_sym: "sym r \<Longrightarrow> sym (listrel r)" |
|
5362 |
apply (auto simp add: sym_def) |
|
23740 | 5363 |
apply (erule listrel.induct) |
5364 |
apply (blast intro: listrel.intros)+ |
|
15302 | 5365 |
done |
5366 |
||
5367 |
lemma listrel_trans: "trans r \<Longrightarrow> trans (listrel r)" |
|
5368 |
apply (simp add: trans_def) |
|
5369 |
apply (intro allI) |
|
5370 |
apply (rule impI) |
|
23740 | 5371 |
apply (erule listrel.induct) |
5372 |
apply (blast intro: listrel.intros)+ |
|
15302 | 5373 |
done |
5374 |
||
5375 |
theorem equiv_listrel: "equiv A r \<Longrightarrow> equiv (lists A) (listrel r)" |
|
30198 | 5376 |
by (simp add: equiv_def listrel_refl_on listrel_sym listrel_trans) |
15302 | 5377 |
|
40230 | 5378 |
lemma listrel_rtrancl_refl[iff]: "(xs,xs) : listrel(r^*)" |
5379 |
using listrel_refl_on[of UNIV, OF refl_rtrancl] |
|
5380 |
by(auto simp: refl_on_def) |
|
5381 |
||
5382 |
lemma listrel_rtrancl_trans: |
|
5383 |
"\<lbrakk> (xs,ys) : listrel(r^*); (ys,zs) : listrel(r^*) \<rbrakk> |
|
5384 |
\<Longrightarrow> (xs,zs) : listrel(r^*)" |
|
5385 |
by (metis listrel_trans trans_def trans_rtrancl) |
|
5386 |
||
5387 |
||
15302 | 5388 |
lemma listrel_Nil [simp]: "listrel r `` {[]} = {[]}" |
23740 | 5389 |
by (blast intro: listrel.intros) |
15302 | 5390 |
|
5391 |
lemma listrel_Cons: |
|
33318
ddd97d9dfbfb
moved Nat_Transfer before Divides; distributed Nat_Transfer setup accordingly
haftmann
parents:
32960
diff
changeset
|
5392 |
"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
|
5393 |
by (auto simp add: set_Cons_def intro: listrel.intros) |
15302 | 5394 |
|
40230 | 5395 |
text {* Relating @{term listrel1}, @{term listrel} and closures: *} |
5396 |
||
5397 |
lemma listrel1_rtrancl_subset_rtrancl_listrel1: |
|
5398 |
"listrel1 (r^*) \<subseteq> (listrel1 r)^*" |
|
5399 |
proof (rule subrelI) |
|
5400 |
fix xs ys assume 1: "(xs,ys) \<in> listrel1 (r^*)" |
|
5401 |
{ fix x y us vs |
|
5402 |
have "(x,y) : r^* \<Longrightarrow> (us @ x # vs, us @ y # vs) : (listrel1 r)^*" |
|
5403 |
proof(induct rule: rtrancl.induct) |
|
5404 |
case rtrancl_refl show ?case by simp |
|
5405 |
next |
|
5406 |
case rtrancl_into_rtrancl thus ?case |
|
5407 |
by (metis listrel1I rtrancl.rtrancl_into_rtrancl) |
|
5408 |
qed } |
|
5409 |
thus "(xs,ys) \<in> (listrel1 r)^*" using 1 by(blast elim: listrel1E) |
|
5410 |
qed |
|
5411 |
||
5412 |
lemma rtrancl_listrel1_eq_len: "(x,y) \<in> (listrel1 r)^* \<Longrightarrow> length x = length y" |
|
5413 |
by (induct rule: rtrancl.induct) (auto intro: listrel1_eq_len) |
|
5414 |
||
5415 |
lemma rtrancl_listrel1_ConsI1: |
|
5416 |
"(xs,ys) : (listrel1 r)^* \<Longrightarrow> (x#xs,x#ys) : (listrel1 r)^*" |
|
5417 |
apply(induct rule: rtrancl.induct) |
|
5418 |
apply simp |
|
5419 |
by (metis listrel1I2 rtrancl.rtrancl_into_rtrancl) |
|
5420 |
||
5421 |
lemma rtrancl_listrel1_ConsI2: |
|
5422 |
"(x,y) \<in> r^* \<Longrightarrow> (xs, ys) \<in> (listrel1 r)^* |
|
5423 |
\<Longrightarrow> (x # xs, y # ys) \<in> (listrel1 r)^*" |
|
5424 |
by (blast intro: rtrancl_trans rtrancl_listrel1_ConsI1 |
|
5425 |
subsetD[OF listrel1_rtrancl_subset_rtrancl_listrel1 listrel1I1]) |
|
5426 |
||
5427 |
lemma listrel1_subset_listrel: |
|
5428 |
"r \<subseteq> r' \<Longrightarrow> refl r' \<Longrightarrow> listrel1 r \<subseteq> listrel(r')" |
|
5429 |
by(auto elim!: listrel1E simp add: listrel_iff_zip set_zip refl_on_def) |
|
5430 |
||
5431 |
lemma listrel_reflcl_if_listrel1: |
|
5432 |
"(xs,ys) : listrel1 r \<Longrightarrow> (xs,ys) : listrel(r^*)" |
|
5433 |
by(erule listrel1E)(auto simp add: listrel_iff_zip set_zip) |
|
5434 |
||
5435 |
lemma listrel_rtrancl_eq_rtrancl_listrel1: "listrel (r^*) = (listrel1 r)^*" |
|
5436 |
proof |
|
5437 |
{ fix x y assume "(x,y) \<in> listrel (r^*)" |
|
5438 |
then have "(x,y) \<in> (listrel1 r)^*" |
|
5439 |
by induct (auto intro: rtrancl_listrel1_ConsI2) } |
|
5440 |
then show "listrel (r^*) \<subseteq> (listrel1 r)^*" |
|
5441 |
by (rule subrelI) |
|
5442 |
next |
|
5443 |
show "listrel (r^*) \<supseteq> (listrel1 r)^*" |
|
5444 |
proof(rule subrelI) |
|
5445 |
fix xs ys assume "(xs,ys) \<in> (listrel1 r)^*" |
|
5446 |
then show "(xs,ys) \<in> listrel (r^*)" |
|
5447 |
proof induct |
|
5448 |
case base show ?case by(auto simp add: listrel_iff_zip set_zip) |
|
5449 |
next |
|
5450 |
case (step ys zs) |
|
5451 |
thus ?case by (metis listrel_reflcl_if_listrel1 listrel_rtrancl_trans) |
|
5452 |
qed |
|
5453 |
qed |
|
5454 |
qed |
|
5455 |
||
5456 |
lemma rtrancl_listrel1_if_listrel: |
|
5457 |
"(xs,ys) : listrel r \<Longrightarrow> (xs,ys) : (listrel1 r)^*" |
|
5458 |
by(metis listrel_rtrancl_eq_rtrancl_listrel1 subsetD[OF listrel_mono] r_into_rtrancl subsetI) |
|
5459 |
||
5460 |
lemma listrel_subset_rtrancl_listrel1: "listrel r \<subseteq> (listrel1 r)^*" |
|
5461 |
by(fast intro:rtrancl_listrel1_if_listrel) |
|
5462 |
||
15302 | 5463 |
|
26749
397a1aeede7d
* New attribute "termination_simp": Simp rules for termination proofs
krauss
parents:
26734
diff
changeset
|
5464 |
subsection {* Size function *} |
397a1aeede7d
* New attribute "termination_simp": Simp rules for termination proofs
krauss
parents:
26734
diff
changeset
|
5465 |
|
26875
e18574413bc4
Measure functions can now be declared via special rules, allowing for a
krauss
parents:
26795
diff
changeset
|
5466 |
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
|
5467 |
by (rule is_measure_trivial) |
e18574413bc4
Measure functions can now be declared via special rules, allowing for a
krauss
parents:
26795
diff
changeset
|
5468 |
|
e18574413bc4
Measure functions can now be declared via special rules, allowing for a
krauss
parents:
26795
diff
changeset
|
5469 |
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
|
5470 |
by (rule is_measure_trivial) |
e18574413bc4
Measure functions can now be declared via special rules, allowing for a
krauss
parents:
26795
diff
changeset
|
5471 |
|
e18574413bc4
Measure functions can now be declared via special rules, allowing for a
krauss
parents:
26795
diff
changeset
|
5472 |
lemma list_size_estimation[termination_simp]: |
e18574413bc4
Measure functions can now be declared via special rules, allowing for a
krauss
parents:
26795
diff
changeset
|
5473 |
"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
|
5474 |
by (induct xs) auto |
397a1aeede7d
* New attribute "termination_simp": Simp rules for termination proofs
krauss
parents:
26734
diff
changeset
|
5475 |
|
26875
e18574413bc4
Measure functions can now be declared via special rules, allowing for a
krauss
parents:
26795
diff
changeset
|
5476 |
lemma list_size_estimation'[termination_simp]: |
e18574413bc4
Measure functions can now be declared via special rules, allowing for a
krauss
parents:
26795
diff
changeset
|
5477 |
"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
|
5478 |
by (induct xs) auto |
e18574413bc4
Measure functions can now be declared via special rules, allowing for a
krauss
parents:
26795
diff
changeset
|
5479 |
|
e18574413bc4
Measure functions can now be declared via special rules, allowing for a
krauss
parents:
26795
diff
changeset
|
5480 |
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
|
5481 |
by (induct xs) auto |
e18574413bc4
Measure functions can now be declared via special rules, allowing for a
krauss
parents:
26795
diff
changeset
|
5482 |
|
44619
fd520fa2fb09
adding list_size_append (thanks to Rene Thiemann)
bulwahn
parents:
44618
diff
changeset
|
5483 |
lemma list_size_append[simp]: "list_size f (xs @ ys) = list_size f xs + list_size f ys" |
fd520fa2fb09
adding list_size_append (thanks to Rene Thiemann)
bulwahn
parents:
44618
diff
changeset
|
5484 |
by (induct xs, auto) |
fd520fa2fb09
adding list_size_append (thanks to Rene Thiemann)
bulwahn
parents:
44618
diff
changeset
|
5485 |
|
26875
e18574413bc4
Measure functions can now be declared via special rules, allowing for a
krauss
parents:
26795
diff
changeset
|
5486 |
lemma list_size_pointwise[termination_simp]: |
44618
f3635643a376
strengthening list_size_pointwise (thanks to Rene Thiemann)
bulwahn
parents:
44510
diff
changeset
|
5487 |
"(\<And>x. x \<in> set xs \<Longrightarrow> f x \<le> g x) \<Longrightarrow> list_size f xs \<le> list_size g xs" |
26875
e18574413bc4
Measure functions can now be declared via special rules, allowing for a
krauss
parents:
26795
diff
changeset
|
5488 |
by (induct xs) force+ |
26749
397a1aeede7d
* New attribute "termination_simp": Simp rules for termination proofs
krauss
parents:
26734
diff
changeset
|
5489 |
|
31048
ac146fc38b51
refined HOL string theories and corresponding ML fragments
haftmann
parents:
31022
diff
changeset
|
5490 |
|
46143 | 5491 |
subsection {* Monad operation *} |
5492 |
||
5493 |
definition bind :: "'a list \<Rightarrow> ('a \<Rightarrow> 'b list) \<Rightarrow> 'b list" where |
|
50548 | 5494 |
"bind xs f = concat (map f xs)" |
46143 | 5495 |
|
5496 |
hide_const (open) bind |
|
5497 |
||
5498 |
lemma bind_simps [simp]: |
|
5499 |
"List.bind [] f = []" |
|
5500 |
"List.bind (x # xs) f = f x @ List.bind xs f" |
|
5501 |
by (simp_all add: bind_def) |
|
5502 |
||
5503 |
||
33318
ddd97d9dfbfb
moved Nat_Transfer before Divides; distributed Nat_Transfer setup accordingly
haftmann
parents:
32960
diff
changeset
|
5504 |
subsection {* Transfer *} |
ddd97d9dfbfb
moved Nat_Transfer before Divides; distributed Nat_Transfer setup accordingly
haftmann
parents:
32960
diff
changeset
|
5505 |
|
50548 | 5506 |
definition embed_list :: "nat list \<Rightarrow> int list" where |
5507 |
"embed_list l = map int l" |
|
5508 |
||
5509 |
definition nat_list :: "int list \<Rightarrow> bool" where |
|
5510 |
"nat_list l = nat_set (set l)" |
|
5511 |
||
5512 |
definition return_list :: "int list \<Rightarrow> nat list" where |
|
5513 |
"return_list l = map nat l" |
|
33318
ddd97d9dfbfb
moved Nat_Transfer before Divides; distributed Nat_Transfer setup accordingly
haftmann
parents:
32960
diff
changeset
|
5514 |
|
ddd97d9dfbfb
moved Nat_Transfer before Divides; distributed Nat_Transfer setup accordingly
haftmann
parents:
32960
diff
changeset
|
5515 |
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
|
5516 |
embed_list (return_list l) = l" |
ddd97d9dfbfb
moved Nat_Transfer before Divides; distributed Nat_Transfer setup accordingly
haftmann
parents:
32960
diff
changeset
|
5517 |
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
|
5518 |
apply (induct l) |
ddd97d9dfbfb
moved Nat_Transfer before Divides; distributed Nat_Transfer setup accordingly
haftmann
parents:
32960
diff
changeset
|
5519 |
apply auto |
ddd97d9dfbfb
moved Nat_Transfer before Divides; distributed Nat_Transfer setup accordingly
haftmann
parents:
32960
diff
changeset
|
5520 |
done |
ddd97d9dfbfb
moved Nat_Transfer before Divides; distributed Nat_Transfer setup accordingly
haftmann
parents:
32960
diff
changeset
|
5521 |
|
ddd97d9dfbfb
moved Nat_Transfer before Divides; distributed Nat_Transfer setup accordingly
haftmann
parents:
32960
diff
changeset
|
5522 |
lemma transfer_nat_int_list_functions: |
ddd97d9dfbfb
moved Nat_Transfer before Divides; distributed Nat_Transfer setup accordingly
haftmann
parents:
32960
diff
changeset
|
5523 |
"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
|
5524 |
"[] = return_list []" |
ddd97d9dfbfb
moved Nat_Transfer before Divides; distributed Nat_Transfer setup accordingly
haftmann
parents:
32960
diff
changeset
|
5525 |
unfolding return_list_def embed_list_def |
ddd97d9dfbfb
moved Nat_Transfer before Divides; distributed Nat_Transfer setup accordingly
haftmann
parents:
32960
diff
changeset
|
5526 |
apply auto |
ddd97d9dfbfb
moved Nat_Transfer before Divides; distributed Nat_Transfer setup accordingly
haftmann
parents:
32960
diff
changeset
|
5527 |
apply (induct l, auto) |
ddd97d9dfbfb
moved Nat_Transfer before Divides; distributed Nat_Transfer setup accordingly
haftmann
parents:
32960
diff
changeset
|
5528 |
apply (induct m, auto) |
ddd97d9dfbfb
moved Nat_Transfer before Divides; distributed Nat_Transfer setup accordingly
haftmann
parents:
32960
diff
changeset
|
5529 |
done |
ddd97d9dfbfb
moved Nat_Transfer before Divides; distributed Nat_Transfer setup accordingly
haftmann
parents:
32960
diff
changeset
|
5530 |
|
ddd97d9dfbfb
moved Nat_Transfer before Divides; distributed Nat_Transfer setup accordingly
haftmann
parents:
32960
diff
changeset
|
5531 |
(* |
ddd97d9dfbfb
moved Nat_Transfer before Divides; distributed Nat_Transfer setup accordingly
haftmann
parents:
32960
diff
changeset
|
5532 |
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
|
5533 |
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
|
5534 |
*) |
ddd97d9dfbfb
moved Nat_Transfer before Divides; distributed Nat_Transfer setup accordingly
haftmann
parents:
32960
diff
changeset
|
5535 |
|
ddd97d9dfbfb
moved Nat_Transfer before Divides; distributed Nat_Transfer setup accordingly
haftmann
parents:
32960
diff
changeset
|
5536 |
|
37605
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
5537 |
subsection {* Code generation *} |
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
5538 |
|
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
5539 |
subsubsection {* Counterparts for set-related operations *} |
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
5540 |
|
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
5541 |
definition member :: "'a list \<Rightarrow> 'a \<Rightarrow> bool" where |
50548 | 5542 |
[code_abbrev]: "member xs x \<longleftrightarrow> x \<in> set xs" |
37605
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
5543 |
|
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
5544 |
text {* |
46030
51b2f3412a03
attribute code_abbrev superseedes code_unfold_post; tuned text
haftmann
parents:
45993
diff
changeset
|
5545 |
Use @{text member} only for generating executable code. Otherwise use |
37605
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
5546 |
@{prop "x \<in> set xs"} instead --- it is much easier to reason about. |
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
5547 |
*} |
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
5548 |
|
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
5549 |
lemma member_rec [code]: |
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
5550 |
"member (x # xs) y \<longleftrightarrow> x = y \<or> member xs y" |
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
5551 |
"member [] y \<longleftrightarrow> False" |
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
5552 |
by (auto simp add: member_def) |
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
5553 |
|
46030
51b2f3412a03
attribute code_abbrev superseedes code_unfold_post; tuned text
haftmann
parents:
45993
diff
changeset
|
5554 |
lemma in_set_member (* FIXME delete candidate *): |
37605
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
5555 |
"x \<in> set xs \<longleftrightarrow> member xs x" |
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
5556 |
by (simp add: member_def) |
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
5557 |
|
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
5558 |
definition list_all :: "('a \<Rightarrow> bool) \<Rightarrow> 'a list \<Rightarrow> bool" where |
50548 | 5559 |
list_all_iff [code_abbrev]: "list_all P xs \<longleftrightarrow> Ball (set xs) P" |
37605
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
5560 |
|
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
5561 |
definition list_ex :: "('a \<Rightarrow> bool) \<Rightarrow> 'a list \<Rightarrow> bool" where |
50548 | 5562 |
list_ex_iff [code_abbrev]: "list_ex P xs \<longleftrightarrow> Bex (set xs) P" |
46030
51b2f3412a03
attribute code_abbrev superseedes code_unfold_post; tuned text
haftmann
parents:
45993
diff
changeset
|
5563 |
|
51b2f3412a03
attribute code_abbrev superseedes code_unfold_post; tuned text
haftmann
parents:
45993
diff
changeset
|
5564 |
definition list_ex1 :: "('a \<Rightarrow> bool) \<Rightarrow> 'a list \<Rightarrow> bool" where |
50548 | 5565 |
list_ex1_iff [code_abbrev]: "list_ex1 P xs \<longleftrightarrow> (\<exists>! x. x \<in> set xs \<and> P x)" |
40652 | 5566 |
|
37605
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
5567 |
text {* |
46030
51b2f3412a03
attribute code_abbrev superseedes code_unfold_post; tuned text
haftmann
parents:
45993
diff
changeset
|
5568 |
Usually you should prefer @{text "\<forall>x\<in>set xs"}, @{text "\<exists>x\<in>set xs"} |
51b2f3412a03
attribute code_abbrev superseedes code_unfold_post; tuned text
haftmann
parents:
45993
diff
changeset
|
5569 |
and @{text "\<exists>!x. x\<in>set xs \<and> _"} over @{const list_all}, @{const list_ex} |
51b2f3412a03
attribute code_abbrev superseedes code_unfold_post; tuned text
haftmann
parents:
45993
diff
changeset
|
5570 |
and @{const list_ex1} in specifications. |
37605
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
5571 |
*} |
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
5572 |
|
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
5573 |
lemma list_all_simps [simp, code]: |
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
5574 |
"list_all P (x # xs) \<longleftrightarrow> P x \<and> list_all P xs" |
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
5575 |
"list_all P [] \<longleftrightarrow> True" |
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
5576 |
by (simp_all add: list_all_iff) |
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
5577 |
|
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
5578 |
lemma list_ex_simps [simp, code]: |
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
5579 |
"list_ex P (x # xs) \<longleftrightarrow> P x \<or> list_ex P xs" |
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
5580 |
"list_ex P [] \<longleftrightarrow> False" |
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
5581 |
by (simp_all add: list_ex_iff) |
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
5582 |
|
40652 | 5583 |
lemma list_ex1_simps [simp, code]: |
5584 |
"list_ex1 P [] = False" |
|
5585 |
"list_ex1 P (x # xs) = (if P x then list_all (\<lambda>y. \<not> P y \<or> x = y) xs else list_ex1 P xs)" |
|
46030
51b2f3412a03
attribute code_abbrev superseedes code_unfold_post; tuned text
haftmann
parents:
45993
diff
changeset
|
5586 |
by (auto simp add: list_ex1_iff list_all_iff) |
51b2f3412a03
attribute code_abbrev superseedes code_unfold_post; tuned text
haftmann
parents:
45993
diff
changeset
|
5587 |
|
51b2f3412a03
attribute code_abbrev superseedes code_unfold_post; tuned text
haftmann
parents:
45993
diff
changeset
|
5588 |
lemma Ball_set_list_all: (* FIXME delete candidate *) |
37605
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
5589 |
"Ball (set xs) P \<longleftrightarrow> list_all P xs" |
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
5590 |
by (simp add: list_all_iff) |
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
5591 |
|
46030
51b2f3412a03
attribute code_abbrev superseedes code_unfold_post; tuned text
haftmann
parents:
45993
diff
changeset
|
5592 |
lemma Bex_set_list_ex: (* FIXME delete candidate *) |
37605
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
5593 |
"Bex (set xs) P \<longleftrightarrow> list_ex P xs" |
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
5594 |
by (simp add: list_ex_iff) |
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
5595 |
|
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
5596 |
lemma list_all_append [simp]: |
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
5597 |
"list_all P (xs @ ys) \<longleftrightarrow> list_all P xs \<and> list_all P ys" |
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
5598 |
by (auto simp add: list_all_iff) |
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
5599 |
|
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
5600 |
lemma list_ex_append [simp]: |
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
5601 |
"list_ex P (xs @ ys) \<longleftrightarrow> list_ex P xs \<or> list_ex P ys" |
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
5602 |
by (auto simp add: list_ex_iff) |
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
5603 |
|
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
5604 |
lemma list_all_rev [simp]: |
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
5605 |
"list_all P (rev xs) \<longleftrightarrow> list_all P xs" |
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
5606 |
by (simp add: list_all_iff) |
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
5607 |
|
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
5608 |
lemma list_ex_rev [simp]: |
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
5609 |
"list_ex P (rev xs) \<longleftrightarrow> list_ex P xs" |
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
5610 |
by (simp add: list_ex_iff) |
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
5611 |
|
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
5612 |
lemma list_all_length: |
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
5613 |
"list_all P xs \<longleftrightarrow> (\<forall>n < length xs. P (xs ! n))" |
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
5614 |
by (auto simp add: list_all_iff set_conv_nth) |
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
5615 |
|
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
5616 |
lemma list_ex_length: |
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
5617 |
"list_ex P xs \<longleftrightarrow> (\<exists>n < length xs. P (xs ! n))" |
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
5618 |
by (auto simp add: list_ex_iff set_conv_nth) |
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
5619 |
|
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
5620 |
lemma list_all_cong [fundef_cong]: |
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
5621 |
"xs = ys \<Longrightarrow> (\<And>x. x \<in> set ys \<Longrightarrow> f x = g x) \<Longrightarrow> list_all f xs = list_all g ys" |
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
5622 |
by (simp add: list_all_iff) |
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
5623 |
|
47131 | 5624 |
lemma list_ex_cong [fundef_cong]: |
37605
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
5625 |
"xs = ys \<Longrightarrow> (\<And>x. x \<in> set ys \<Longrightarrow> f x = g x) \<Longrightarrow> list_ex f xs = list_ex g ys" |
47131 | 5626 |
by (simp add: list_ex_iff) |
37605
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
5627 |
|
50548 | 5628 |
definition can_select :: "('a \<Rightarrow> bool) \<Rightarrow> 'a set \<Rightarrow> bool" where |
5629 |
[code_abbrev]: "can_select P A = (\<exists>!x\<in>A. P x)" |
|
49948
744934b818c7
moved quite generic material from theory Enum to more appropriate places
haftmann
parents:
49808
diff
changeset
|
5630 |
|
744934b818c7
moved quite generic material from theory Enum to more appropriate places
haftmann
parents:
49808
diff
changeset
|
5631 |
lemma can_select_set_list_ex1 [code]: |
744934b818c7
moved quite generic material from theory Enum to more appropriate places
haftmann
parents:
49808
diff
changeset
|
5632 |
"can_select P (set A) = list_ex1 P A" |
744934b818c7
moved quite generic material from theory Enum to more appropriate places
haftmann
parents:
49808
diff
changeset
|
5633 |
by (simp add: list_ex1_iff can_select_def) |
744934b818c7
moved quite generic material from theory Enum to more appropriate places
haftmann
parents:
49808
diff
changeset
|
5634 |
|
744934b818c7
moved quite generic material from theory Enum to more appropriate places
haftmann
parents:
49808
diff
changeset
|
5635 |
|
46313 | 5636 |
text {* Executable checks for relations on sets *} |
5637 |
||
5638 |
definition listrel1p :: "('a \<Rightarrow> 'a \<Rightarrow> bool) \<Rightarrow> 'a list \<Rightarrow> 'a list \<Rightarrow> bool" where |
|
5639 |
"listrel1p r xs ys = ((xs, ys) \<in> listrel1 {(x, y). r x y})" |
|
5640 |
||
5641 |
lemma [code_unfold]: |
|
5642 |
"(xs, ys) \<in> listrel1 r = listrel1p (\<lambda>x y. (x, y) \<in> r) xs ys" |
|
5643 |
unfolding listrel1p_def by auto |
|
5644 |
||
5645 |
lemma [code]: |
|
5646 |
"listrel1p r [] xs = False" |
|
5647 |
"listrel1p r xs [] = False" |
|
5648 |
"listrel1p r (x # xs) (y # ys) \<longleftrightarrow> |
|
5649 |
r x y \<and> xs = ys \<or> x = y \<and> listrel1p r xs ys" |
|
5650 |
by (simp add: listrel1p_def)+ |
|
5651 |
||
5652 |
definition |
|
5653 |
lexordp :: "('a \<Rightarrow> 'a \<Rightarrow> bool) \<Rightarrow> 'a list \<Rightarrow> 'a list \<Rightarrow> bool" where |
|
5654 |
"lexordp r xs ys = ((xs, ys) \<in> lexord {(x, y). r x y})" |
|
5655 |
||
5656 |
lemma [code_unfold]: |
|
5657 |
"(xs, ys) \<in> lexord r = lexordp (\<lambda>x y. (x, y) \<in> r) xs ys" |
|
5658 |
unfolding lexordp_def by auto |
|
5659 |
||
5660 |
lemma [code]: |
|
5661 |
"lexordp r xs [] = False" |
|
5662 |
"lexordp r [] (y#ys) = True" |
|
5663 |
"lexordp r (x # xs) (y # ys) = (r x y | (x = y & lexordp r xs ys))" |
|
5664 |
unfolding lexordp_def by auto |
|
5665 |
||
37605
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
5666 |
text {* Bounded quantification and summation over nats. *} |
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
5667 |
|
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
5668 |
lemma atMost_upto [code_unfold]: |
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
5669 |
"{..n} = set [0..<Suc n]" |
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
5670 |
by auto |
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
5671 |
|
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
5672 |
lemma atLeast_upt [code_unfold]: |
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
5673 |
"{..<n} = set [0..<n]" |
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
5674 |
by auto |
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
5675 |
|
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
5676 |
lemma greaterThanLessThan_upt [code_unfold]: |
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
5677 |
"{n<..<m} = set [Suc n..<m]" |
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
5678 |
by auto |
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
5679 |
|
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
5680 |
lemmas atLeastLessThan_upt [code_unfold] = set_upt [symmetric] |
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
5681 |
|
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
5682 |
lemma greaterThanAtMost_upt [code_unfold]: |
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
5683 |
"{n<..m} = set [Suc n..<Suc m]" |
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
5684 |
by auto |
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
5685 |
|
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
5686 |
lemma atLeastAtMost_upt [code_unfold]: |
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
5687 |
"{n..m} = set [n..<Suc m]" |
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
5688 |
by auto |
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
5689 |
|
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
5690 |
lemma all_nat_less_eq [code_unfold]: |
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
5691 |
"(\<forall>m<n\<Colon>nat. P m) \<longleftrightarrow> (\<forall>m \<in> {0..<n}. P m)" |
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
5692 |
by auto |
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
5693 |
|
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
5694 |
lemma ex_nat_less_eq [code_unfold]: |
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
5695 |
"(\<exists>m<n\<Colon>nat. P m) \<longleftrightarrow> (\<exists>m \<in> {0..<n}. P m)" |
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
5696 |
by auto |
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
5697 |
|
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
5698 |
lemma all_nat_less [code_unfold]: |
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
5699 |
"(\<forall>m\<le>n\<Colon>nat. P m) \<longleftrightarrow> (\<forall>m \<in> {0..n}. P m)" |
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
5700 |
by auto |
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
5701 |
|
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
5702 |
lemma ex_nat_less [code_unfold]: |
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
5703 |
"(\<exists>m\<le>n\<Colon>nat. P m) \<longleftrightarrow> (\<exists>m \<in> {0..n}. P m)" |
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
5704 |
by auto |
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
5705 |
|
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
5706 |
lemma setsum_set_upt_conv_listsum_nat [code_unfold]: |
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
5707 |
"setsum f (set [m..<n]) = listsum (map f [m..<n])" |
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
5708 |
by (simp add: interv_listsum_conv_setsum_set_nat) |
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
5709 |
|
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
5710 |
text {* Summation over ints. *} |
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
5711 |
|
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
5712 |
lemma greaterThanLessThan_upto [code_unfold]: |
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
5713 |
"{i<..<j::int} = set [i+1..j - 1]" |
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
5714 |
by auto |
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
5715 |
|
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
5716 |
lemma atLeastLessThan_upto [code_unfold]: |
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
5717 |
"{i..<j::int} = set [i..j - 1]" |
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
5718 |
by auto |
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
5719 |
|
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
5720 |
lemma greaterThanAtMost_upto [code_unfold]: |
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
5721 |
"{i<..j::int} = set [i+1..j]" |
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
5722 |
by auto |
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
5723 |
|
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
5724 |
lemmas atLeastAtMost_upto [code_unfold] = set_upto [symmetric] |
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
5725 |
|
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
5726 |
lemma setsum_set_upto_conv_listsum_int [code_unfold]: |
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
5727 |
"setsum f (set [i..j::int]) = listsum (map f [i..j])" |
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
5728 |
by (simp add: interv_listsum_conv_setsum_set_int) |
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
5729 |
|
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
5730 |
|
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
5731 |
subsubsection {* Optimizing by rewriting *} |
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
5732 |
|
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
5733 |
definition null :: "'a list \<Rightarrow> bool" where |
46030
51b2f3412a03
attribute code_abbrev superseedes code_unfold_post; tuned text
haftmann
parents:
45993
diff
changeset
|
5734 |
[code_abbrev]: "null xs \<longleftrightarrow> xs = []" |
37605
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
5735 |
|
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
5736 |
text {* |
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
5737 |
Efficient emptyness check is implemented by @{const null}. |
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
5738 |
*} |
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
5739 |
|
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
5740 |
lemma null_rec [code]: |
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
5741 |
"null (x # xs) \<longleftrightarrow> False" |
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
5742 |
"null [] \<longleftrightarrow> True" |
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
5743 |
by (simp_all add: null_def) |
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
5744 |
|
46030
51b2f3412a03
attribute code_abbrev superseedes code_unfold_post; tuned text
haftmann
parents:
45993
diff
changeset
|
5745 |
lemma eq_Nil_null: (* FIXME delete candidate *) |
37605
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
5746 |
"xs = [] \<longleftrightarrow> null xs" |
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
5747 |
by (simp add: null_def) |
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
5748 |
|
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
5749 |
lemma equal_Nil_null [code_unfold]: |
38857
97775f3e8722
renamed class/constant eq to equal; tuned some instantiations
haftmann
parents:
38715
diff
changeset
|
5750 |
"HOL.equal xs [] \<longleftrightarrow> null xs" |
97775f3e8722
renamed class/constant eq to equal; tuned some instantiations
haftmann
parents:
38715
diff
changeset
|
5751 |
by (simp add: equal eq_Nil_null) |
37605
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
5752 |
|
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
5753 |
definition maps :: "('a \<Rightarrow> 'b list) \<Rightarrow> 'a list \<Rightarrow> 'b list" where |
46030
51b2f3412a03
attribute code_abbrev superseedes code_unfold_post; tuned text
haftmann
parents:
45993
diff
changeset
|
5754 |
[code_abbrev]: "maps f xs = concat (map f xs)" |
37605
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
5755 |
|
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
5756 |
definition map_filter :: "('a \<Rightarrow> 'b option) \<Rightarrow> 'a list \<Rightarrow> 'b list" where |
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
5757 |
[code_post]: "map_filter f xs = map (the \<circ> f) (filter (\<lambda>x. f x \<noteq> None) xs)" |
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
5758 |
|
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
5759 |
text {* |
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
5760 |
Operations @{const maps} and @{const map_filter} avoid |
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
5761 |
intermediate lists on execution -- do not use for proving. |
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
5762 |
*} |
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
5763 |
|
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
5764 |
lemma maps_simps [code]: |
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
5765 |
"maps f (x # xs) = f x @ maps f xs" |
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
5766 |
"maps f [] = []" |
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
5767 |
by (simp_all add: maps_def) |
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
5768 |
|
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
5769 |
lemma map_filter_simps [code]: |
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
5770 |
"map_filter f (x # xs) = (case f x of None \<Rightarrow> map_filter f xs | Some y \<Rightarrow> y # map_filter f xs)" |
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
5771 |
"map_filter f [] = []" |
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
5772 |
by (simp_all add: map_filter_def split: option.split) |
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
5773 |
|
46030
51b2f3412a03
attribute code_abbrev superseedes code_unfold_post; tuned text
haftmann
parents:
45993
diff
changeset
|
5774 |
lemma concat_map_maps: (* FIXME delete candidate *) |
37605
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
5775 |
"concat (map f xs) = maps f xs" |
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
5776 |
by (simp add: maps_def) |
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
5777 |
|
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
5778 |
lemma map_filter_map_filter [code_unfold]: |
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
5779 |
"map f (filter P xs) = map_filter (\<lambda>x. if P x then Some (f x) else None) xs" |
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
5780 |
by (simp add: map_filter_def) |
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
5781 |
|
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
5782 |
text {* Optimized code for @{text"\<forall>i\<in>{a..b::int}"} and @{text"\<forall>n:{a..<b::nat}"} |
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
5783 |
and similiarly for @{text"\<exists>"}. *} |
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
5784 |
|
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
5785 |
definition all_interval_nat :: "(nat \<Rightarrow> bool) \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> bool" where |
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
5786 |
"all_interval_nat P i j \<longleftrightarrow> (\<forall>n \<in> {i..<j}. P n)" |
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
5787 |
|
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
5788 |
lemma [code]: |
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
5789 |
"all_interval_nat P i j \<longleftrightarrow> i \<ge> j \<or> P i \<and> all_interval_nat P (Suc i) j" |
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
5790 |
proof - |
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
5791 |
have *: "\<And>n. P i \<Longrightarrow> \<forall>n\<in>{Suc i..<j}. P n \<Longrightarrow> i \<le> n \<Longrightarrow> n < j \<Longrightarrow> P n" |
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
5792 |
proof - |
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
5793 |
fix n |
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
5794 |
assume "P i" "\<forall>n\<in>{Suc i..<j}. P n" "i \<le> n" "n < j" |
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
5795 |
then show "P n" by (cases "n = i") simp_all |
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
5796 |
qed |
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
5797 |
show ?thesis by (auto simp add: all_interval_nat_def intro: *) |
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
5798 |
qed |
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
5799 |
|
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
5800 |
lemma list_all_iff_all_interval_nat [code_unfold]: |
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
5801 |
"list_all P [i..<j] \<longleftrightarrow> all_interval_nat P i j" |
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
5802 |
by (simp add: list_all_iff all_interval_nat_def) |
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
5803 |
|
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
5804 |
lemma list_ex_iff_not_all_inverval_nat [code_unfold]: |
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
5805 |
"list_ex P [i..<j] \<longleftrightarrow> \<not> (all_interval_nat (Not \<circ> P) i j)" |
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
5806 |
by (simp add: list_ex_iff all_interval_nat_def) |
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
5807 |
|
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
5808 |
definition all_interval_int :: "(int \<Rightarrow> bool) \<Rightarrow> int \<Rightarrow> int \<Rightarrow> bool" where |
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
5809 |
"all_interval_int P i j \<longleftrightarrow> (\<forall>k \<in> {i..j}. P k)" |
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
5810 |
|
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
5811 |
lemma [code]: |
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
5812 |
"all_interval_int P i j \<longleftrightarrow> i > j \<or> P i \<and> all_interval_int P (i + 1) j" |
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
5813 |
proof - |
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
5814 |
have *: "\<And>k. P i \<Longrightarrow> \<forall>k\<in>{i+1..j}. P k \<Longrightarrow> i \<le> k \<Longrightarrow> k \<le> j \<Longrightarrow> P k" |
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
5815 |
proof - |
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
5816 |
fix k |
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
5817 |
assume "P i" "\<forall>k\<in>{i+1..j}. P k" "i \<le> k" "k \<le> j" |
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
5818 |
then show "P k" by (cases "k = i") simp_all |
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
5819 |
qed |
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
5820 |
show ?thesis by (auto simp add: all_interval_int_def intro: *) |
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
5821 |
qed |
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
5822 |
|
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
5823 |
lemma list_all_iff_all_interval_int [code_unfold]: |
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
5824 |
"list_all P [i..j] \<longleftrightarrow> all_interval_int P i j" |
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
5825 |
by (simp add: list_all_iff all_interval_int_def) |
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
5826 |
|
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
5827 |
lemma list_ex_iff_not_all_inverval_int [code_unfold]: |
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
5828 |
"list_ex P [i..j] \<longleftrightarrow> \<not> (all_interval_int (Not \<circ> P) i j)" |
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
5829 |
by (simp add: list_ex_iff all_interval_int_def) |
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
5830 |
|
49808
418991ce7567
tail-recursive implementation for length
Andreas Lochbihler
parents:
49757
diff
changeset
|
5831 |
text {* optimized code (tail-recursive) for @{term length} *} |
418991ce7567
tail-recursive implementation for length
Andreas Lochbihler
parents:
49757
diff
changeset
|
5832 |
|
418991ce7567
tail-recursive implementation for length
Andreas Lochbihler
parents:
49757
diff
changeset
|
5833 |
definition gen_length :: "nat \<Rightarrow> 'a list \<Rightarrow> nat" |
418991ce7567
tail-recursive implementation for length
Andreas Lochbihler
parents:
49757
diff
changeset
|
5834 |
where "gen_length n xs = n + length xs" |
418991ce7567
tail-recursive implementation for length
Andreas Lochbihler
parents:
49757
diff
changeset
|
5835 |
|
418991ce7567
tail-recursive implementation for length
Andreas Lochbihler
parents:
49757
diff
changeset
|
5836 |
lemma gen_length_code [code]: |
418991ce7567
tail-recursive implementation for length
Andreas Lochbihler
parents:
49757
diff
changeset
|
5837 |
"gen_length n [] = n" |
418991ce7567
tail-recursive implementation for length
Andreas Lochbihler
parents:
49757
diff
changeset
|
5838 |
"gen_length n (x # xs) = gen_length (Suc n) xs" |
418991ce7567
tail-recursive implementation for length
Andreas Lochbihler
parents:
49757
diff
changeset
|
5839 |
by(simp_all add: gen_length_def) |
418991ce7567
tail-recursive implementation for length
Andreas Lochbihler
parents:
49757
diff
changeset
|
5840 |
|
418991ce7567
tail-recursive implementation for length
Andreas Lochbihler
parents:
49757
diff
changeset
|
5841 |
declare list.size(3-4)[code del] |
418991ce7567
tail-recursive implementation for length
Andreas Lochbihler
parents:
49757
diff
changeset
|
5842 |
|
418991ce7567
tail-recursive implementation for length
Andreas Lochbihler
parents:
49757
diff
changeset
|
5843 |
lemma length_code [code]: "length = gen_length 0" |
418991ce7567
tail-recursive implementation for length
Andreas Lochbihler
parents:
49757
diff
changeset
|
5844 |
by(simp add: gen_length_def fun_eq_iff) |
418991ce7567
tail-recursive implementation for length
Andreas Lochbihler
parents:
49757
diff
changeset
|
5845 |
|
418991ce7567
tail-recursive implementation for length
Andreas Lochbihler
parents:
49757
diff
changeset
|
5846 |
hide_const (open) member null maps map_filter all_interval_nat all_interval_int gen_length |
37605
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
5847 |
|
49948
744934b818c7
moved quite generic material from theory Enum to more appropriate places
haftmann
parents:
49808
diff
changeset
|
5848 |
|
37605
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
5849 |
subsubsection {* Pretty lists *} |
15064
4f3102b50197
- Moved code generator setup for lists from Main.thy to List.thy
berghofe
parents:
15045
diff
changeset
|
5850 |
|
50422
ee729dbd1b7f
avoid ML_file in large theory files to improve performance of dependency discovery of main HOL (approx. 1s CPU time) -- relevant for any application using it, e.g. small paper sessions;
wenzelm
parents:
50134
diff
changeset
|
5851 |
ML {* |
ee729dbd1b7f
avoid ML_file in large theory files to improve performance of dependency discovery of main HOL (approx. 1s CPU time) -- relevant for any application using it, e.g. small paper sessions;
wenzelm
parents:
50134
diff
changeset
|
5852 |
(* Code generation for list literals. *) |
ee729dbd1b7f
avoid ML_file in large theory files to improve performance of dependency discovery of main HOL (approx. 1s CPU time) -- relevant for any application using it, e.g. small paper sessions;
wenzelm
parents:
50134
diff
changeset
|
5853 |
|
ee729dbd1b7f
avoid ML_file in large theory files to improve performance of dependency discovery of main HOL (approx. 1s CPU time) -- relevant for any application using it, e.g. small paper sessions;
wenzelm
parents:
50134
diff
changeset
|
5854 |
signature LIST_CODE = |
ee729dbd1b7f
avoid ML_file in large theory files to improve performance of dependency discovery of main HOL (approx. 1s CPU time) -- relevant for any application using it, e.g. small paper sessions;
wenzelm
parents:
50134
diff
changeset
|
5855 |
sig |
ee729dbd1b7f
avoid ML_file in large theory files to improve performance of dependency discovery of main HOL (approx. 1s CPU time) -- relevant for any application using it, e.g. small paper sessions;
wenzelm
parents:
50134
diff
changeset
|
5856 |
val implode_list: string -> string -> Code_Thingol.iterm -> Code_Thingol.iterm list option |
ee729dbd1b7f
avoid ML_file in large theory files to improve performance of dependency discovery of main HOL (approx. 1s CPU time) -- relevant for any application using it, e.g. small paper sessions;
wenzelm
parents:
50134
diff
changeset
|
5857 |
val default_list: int * string |
ee729dbd1b7f
avoid ML_file in large theory files to improve performance of dependency discovery of main HOL (approx. 1s CPU time) -- relevant for any application using it, e.g. small paper sessions;
wenzelm
parents:
50134
diff
changeset
|
5858 |
-> (Code_Printer.fixity -> Code_Thingol.iterm -> Pretty.T) |
ee729dbd1b7f
avoid ML_file in large theory files to improve performance of dependency discovery of main HOL (approx. 1s CPU time) -- relevant for any application using it, e.g. small paper sessions;
wenzelm
parents:
50134
diff
changeset
|
5859 |
-> Code_Printer.fixity -> Code_Thingol.iterm -> Code_Thingol.iterm -> Pretty.T |
ee729dbd1b7f
avoid ML_file in large theory files to improve performance of dependency discovery of main HOL (approx. 1s CPU time) -- relevant for any application using it, e.g. small paper sessions;
wenzelm
parents:
50134
diff
changeset
|
5860 |
val add_literal_list: string -> theory -> theory |
ee729dbd1b7f
avoid ML_file in large theory files to improve performance of dependency discovery of main HOL (approx. 1s CPU time) -- relevant for any application using it, e.g. small paper sessions;
wenzelm
parents:
50134
diff
changeset
|
5861 |
end; |
ee729dbd1b7f
avoid ML_file in large theory files to improve performance of dependency discovery of main HOL (approx. 1s CPU time) -- relevant for any application using it, e.g. small paper sessions;
wenzelm
parents:
50134
diff
changeset
|
5862 |
|
ee729dbd1b7f
avoid ML_file in large theory files to improve performance of dependency discovery of main HOL (approx. 1s CPU time) -- relevant for any application using it, e.g. small paper sessions;
wenzelm
parents:
50134
diff
changeset
|
5863 |
structure List_Code : LIST_CODE = |
ee729dbd1b7f
avoid ML_file in large theory files to improve performance of dependency discovery of main HOL (approx. 1s CPU time) -- relevant for any application using it, e.g. small paper sessions;
wenzelm
parents:
50134
diff
changeset
|
5864 |
struct |
ee729dbd1b7f
avoid ML_file in large theory files to improve performance of dependency discovery of main HOL (approx. 1s CPU time) -- relevant for any application using it, e.g. small paper sessions;
wenzelm
parents:
50134
diff
changeset
|
5865 |
|
ee729dbd1b7f
avoid ML_file in large theory files to improve performance of dependency discovery of main HOL (approx. 1s CPU time) -- relevant for any application using it, e.g. small paper sessions;
wenzelm
parents:
50134
diff
changeset
|
5866 |
open Basic_Code_Thingol; |
ee729dbd1b7f
avoid ML_file in large theory files to improve performance of dependency discovery of main HOL (approx. 1s CPU time) -- relevant for any application using it, e.g. small paper sessions;
wenzelm
parents:
50134
diff
changeset
|
5867 |
|
ee729dbd1b7f
avoid ML_file in large theory files to improve performance of dependency discovery of main HOL (approx. 1s CPU time) -- relevant for any application using it, e.g. small paper sessions;
wenzelm
parents:
50134
diff
changeset
|
5868 |
fun implode_list nil' cons' t = |
ee729dbd1b7f
avoid ML_file in large theory files to improve performance of dependency discovery of main HOL (approx. 1s CPU time) -- relevant for any application using it, e.g. small paper sessions;
wenzelm
parents:
50134
diff
changeset
|
5869 |
let |
ee729dbd1b7f
avoid ML_file in large theory files to improve performance of dependency discovery of main HOL (approx. 1s CPU time) -- relevant for any application using it, e.g. small paper sessions;
wenzelm
parents:
50134
diff
changeset
|
5870 |
fun dest_cons (IConst { name = c, ... } `$ t1 `$ t2) = |
ee729dbd1b7f
avoid ML_file in large theory files to improve performance of dependency discovery of main HOL (approx. 1s CPU time) -- relevant for any application using it, e.g. small paper sessions;
wenzelm
parents:
50134
diff
changeset
|
5871 |
if c = cons' |
ee729dbd1b7f
avoid ML_file in large theory files to improve performance of dependency discovery of main HOL (approx. 1s CPU time) -- relevant for any application using it, e.g. small paper sessions;
wenzelm
parents:
50134
diff
changeset
|
5872 |
then SOME (t1, t2) |
ee729dbd1b7f
avoid ML_file in large theory files to improve performance of dependency discovery of main HOL (approx. 1s CPU time) -- relevant for any application using it, e.g. small paper sessions;
wenzelm
parents:
50134
diff
changeset
|
5873 |
else NONE |
ee729dbd1b7f
avoid ML_file in large theory files to improve performance of dependency discovery of main HOL (approx. 1s CPU time) -- relevant for any application using it, e.g. small paper sessions;
wenzelm
parents:
50134
diff
changeset
|
5874 |
| dest_cons _ = NONE; |
ee729dbd1b7f
avoid ML_file in large theory files to improve performance of dependency discovery of main HOL (approx. 1s CPU time) -- relevant for any application using it, e.g. small paper sessions;
wenzelm
parents:
50134
diff
changeset
|
5875 |
val (ts, t') = Code_Thingol.unfoldr dest_cons t; |
ee729dbd1b7f
avoid ML_file in large theory files to improve performance of dependency discovery of main HOL (approx. 1s CPU time) -- relevant for any application using it, e.g. small paper sessions;
wenzelm
parents:
50134
diff
changeset
|
5876 |
in case t' |
ee729dbd1b7f
avoid ML_file in large theory files to improve performance of dependency discovery of main HOL (approx. 1s CPU time) -- relevant for any application using it, e.g. small paper sessions;
wenzelm
parents:
50134
diff
changeset
|
5877 |
of IConst { name = c, ... } => if c = nil' then SOME ts else NONE |
ee729dbd1b7f
avoid ML_file in large theory files to improve performance of dependency discovery of main HOL (approx. 1s CPU time) -- relevant for any application using it, e.g. small paper sessions;
wenzelm
parents:
50134
diff
changeset
|
5878 |
| _ => NONE |
ee729dbd1b7f
avoid ML_file in large theory files to improve performance of dependency discovery of main HOL (approx. 1s CPU time) -- relevant for any application using it, e.g. small paper sessions;
wenzelm
parents:
50134
diff
changeset
|
5879 |
end; |
ee729dbd1b7f
avoid ML_file in large theory files to improve performance of dependency discovery of main HOL (approx. 1s CPU time) -- relevant for any application using it, e.g. small paper sessions;
wenzelm
parents:
50134
diff
changeset
|
5880 |
|
ee729dbd1b7f
avoid ML_file in large theory files to improve performance of dependency discovery of main HOL (approx. 1s CPU time) -- relevant for any application using it, e.g. small paper sessions;
wenzelm
parents:
50134
diff
changeset
|
5881 |
fun default_list (target_fxy, target_cons) pr fxy t1 t2 = |
ee729dbd1b7f
avoid ML_file in large theory files to improve performance of dependency discovery of main HOL (approx. 1s CPU time) -- relevant for any application using it, e.g. small paper sessions;
wenzelm
parents:
50134
diff
changeset
|
5882 |
Code_Printer.brackify_infix (target_fxy, Code_Printer.R) fxy ( |
ee729dbd1b7f
avoid ML_file in large theory files to improve performance of dependency discovery of main HOL (approx. 1s CPU time) -- relevant for any application using it, e.g. small paper sessions;
wenzelm
parents:
50134
diff
changeset
|
5883 |
pr (Code_Printer.INFX (target_fxy, Code_Printer.X)) t1, |
ee729dbd1b7f
avoid ML_file in large theory files to improve performance of dependency discovery of main HOL (approx. 1s CPU time) -- relevant for any application using it, e.g. small paper sessions;
wenzelm
parents:
50134
diff
changeset
|
5884 |
Code_Printer.str target_cons, |
ee729dbd1b7f
avoid ML_file in large theory files to improve performance of dependency discovery of main HOL (approx. 1s CPU time) -- relevant for any application using it, e.g. small paper sessions;
wenzelm
parents:
50134
diff
changeset
|
5885 |
pr (Code_Printer.INFX (target_fxy, Code_Printer.R)) t2 |
ee729dbd1b7f
avoid ML_file in large theory files to improve performance of dependency discovery of main HOL (approx. 1s CPU time) -- relevant for any application using it, e.g. small paper sessions;
wenzelm
parents:
50134
diff
changeset
|
5886 |
); |
ee729dbd1b7f
avoid ML_file in large theory files to improve performance of dependency discovery of main HOL (approx. 1s CPU time) -- relevant for any application using it, e.g. small paper sessions;
wenzelm
parents:
50134
diff
changeset
|
5887 |
|
ee729dbd1b7f
avoid ML_file in large theory files to improve performance of dependency discovery of main HOL (approx. 1s CPU time) -- relevant for any application using it, e.g. small paper sessions;
wenzelm
parents:
50134
diff
changeset
|
5888 |
fun add_literal_list target = |
ee729dbd1b7f
avoid ML_file in large theory files to improve performance of dependency discovery of main HOL (approx. 1s CPU time) -- relevant for any application using it, e.g. small paper sessions;
wenzelm
parents:
50134
diff
changeset
|
5889 |
let |
ee729dbd1b7f
avoid ML_file in large theory files to improve performance of dependency discovery of main HOL (approx. 1s CPU time) -- relevant for any application using it, e.g. small paper sessions;
wenzelm
parents:
50134
diff
changeset
|
5890 |
fun pretty literals [nil', cons'] pr thm vars fxy [(t1, _), (t2, _)] = |
ee729dbd1b7f
avoid ML_file in large theory files to improve performance of dependency discovery of main HOL (approx. 1s CPU time) -- relevant for any application using it, e.g. small paper sessions;
wenzelm
parents:
50134
diff
changeset
|
5891 |
case Option.map (cons t1) (implode_list nil' cons' t2) |
ee729dbd1b7f
avoid ML_file in large theory files to improve performance of dependency discovery of main HOL (approx. 1s CPU time) -- relevant for any application using it, e.g. small paper sessions;
wenzelm
parents:
50134
diff
changeset
|
5892 |
of SOME ts => |
ee729dbd1b7f
avoid ML_file in large theory files to improve performance of dependency discovery of main HOL (approx. 1s CPU time) -- relevant for any application using it, e.g. small paper sessions;
wenzelm
parents:
50134
diff
changeset
|
5893 |
Code_Printer.literal_list literals (map (pr vars Code_Printer.NOBR) ts) |
ee729dbd1b7f
avoid ML_file in large theory files to improve performance of dependency discovery of main HOL (approx. 1s CPU time) -- relevant for any application using it, e.g. small paper sessions;
wenzelm
parents:
50134
diff
changeset
|
5894 |
| NONE => |
ee729dbd1b7f
avoid ML_file in large theory files to improve performance of dependency discovery of main HOL (approx. 1s CPU time) -- relevant for any application using it, e.g. small paper sessions;
wenzelm
parents:
50134
diff
changeset
|
5895 |
default_list (Code_Printer.infix_cons literals) (pr vars) fxy t1 t2; |
ee729dbd1b7f
avoid ML_file in large theory files to improve performance of dependency discovery of main HOL (approx. 1s CPU time) -- relevant for any application using it, e.g. small paper sessions;
wenzelm
parents:
50134
diff
changeset
|
5896 |
in Code_Target.add_const_syntax target @{const_name Cons} |
ee729dbd1b7f
avoid ML_file in large theory files to improve performance of dependency discovery of main HOL (approx. 1s CPU time) -- relevant for any application using it, e.g. small paper sessions;
wenzelm
parents:
50134
diff
changeset
|
5897 |
(SOME (Code_Printer.complex_const_syntax (2, ([@{const_name Nil}, @{const_name Cons}], pretty)))) |
ee729dbd1b7f
avoid ML_file in large theory files to improve performance of dependency discovery of main HOL (approx. 1s CPU time) -- relevant for any application using it, e.g. small paper sessions;
wenzelm
parents:
50134
diff
changeset
|
5898 |
end |
ee729dbd1b7f
avoid ML_file in large theory files to improve performance of dependency discovery of main HOL (approx. 1s CPU time) -- relevant for any application using it, e.g. small paper sessions;
wenzelm
parents:
50134
diff
changeset
|
5899 |
|
ee729dbd1b7f
avoid ML_file in large theory files to improve performance of dependency discovery of main HOL (approx. 1s CPU time) -- relevant for any application using it, e.g. small paper sessions;
wenzelm
parents:
50134
diff
changeset
|
5900 |
end; |
ee729dbd1b7f
avoid ML_file in large theory files to improve performance of dependency discovery of main HOL (approx. 1s CPU time) -- relevant for any application using it, e.g. small paper sessions;
wenzelm
parents:
50134
diff
changeset
|
5901 |
*} |
31055
2cf6efca6c71
proper structures for list and string code generation stuff
haftmann
parents:
31048
diff
changeset
|
5902 |
|
31048
ac146fc38b51
refined HOL string theories and corresponding ML fragments
haftmann
parents:
31022
diff
changeset
|
5903 |
code_type list |
ac146fc38b51
refined HOL string theories and corresponding ML fragments
haftmann
parents:
31022
diff
changeset
|
5904 |
(SML "_ list") |
ac146fc38b51
refined HOL string theories and corresponding ML fragments
haftmann
parents:
31022
diff
changeset
|
5905 |
(OCaml "_ list") |
34886 | 5906 |
(Haskell "![(_)]") |
5907 |
(Scala "List[(_)]") |
|
31048
ac146fc38b51
refined HOL string theories and corresponding ML fragments
haftmann
parents:
31022
diff
changeset
|
5908 |
|
ac146fc38b51
refined HOL string theories and corresponding ML fragments
haftmann
parents:
31022
diff
changeset
|
5909 |
code_const Nil |
ac146fc38b51
refined HOL string theories and corresponding ML fragments
haftmann
parents:
31022
diff
changeset
|
5910 |
(SML "[]") |
ac146fc38b51
refined HOL string theories and corresponding ML fragments
haftmann
parents:
31022
diff
changeset
|
5911 |
(OCaml "[]") |
ac146fc38b51
refined HOL string theories and corresponding ML fragments
haftmann
parents:
31022
diff
changeset
|
5912 |
(Haskell "[]") |
37880
3b9ca8d2c5fb
Scala: subtle difference in printing strings vs. complex mixfix syntax
haftmann
parents:
37767
diff
changeset
|
5913 |
(Scala "!Nil") |
31048
ac146fc38b51
refined HOL string theories and corresponding ML fragments
haftmann
parents:
31022
diff
changeset
|
5914 |
|
38857
97775f3e8722
renamed class/constant eq to equal; tuned some instantiations
haftmann
parents:
38715
diff
changeset
|
5915 |
code_instance list :: equal |
31048
ac146fc38b51
refined HOL string theories and corresponding ML fragments
haftmann
parents:
31022
diff
changeset
|
5916 |
(Haskell -) |
ac146fc38b51
refined HOL string theories and corresponding ML fragments
haftmann
parents:
31022
diff
changeset
|
5917 |
|
38857
97775f3e8722
renamed class/constant eq to equal; tuned some instantiations
haftmann
parents:
38715
diff
changeset
|
5918 |
code_const "HOL.equal \<Colon> 'a list \<Rightarrow> 'a list \<Rightarrow> bool" |
39272 | 5919 |
(Haskell infix 4 "==") |
31048
ac146fc38b51
refined HOL string theories and corresponding ML fragments
haftmann
parents:
31022
diff
changeset
|
5920 |
|
ac146fc38b51
refined HOL string theories and corresponding ML fragments
haftmann
parents:
31022
diff
changeset
|
5921 |
code_reserved SML |
ac146fc38b51
refined HOL string theories and corresponding ML fragments
haftmann
parents:
31022
diff
changeset
|
5922 |
list |
ac146fc38b51
refined HOL string theories and corresponding ML fragments
haftmann
parents:
31022
diff
changeset
|
5923 |
|
ac146fc38b51
refined HOL string theories and corresponding ML fragments
haftmann
parents:
31022
diff
changeset
|
5924 |
code_reserved OCaml |
ac146fc38b51
refined HOL string theories and corresponding ML fragments
haftmann
parents:
31022
diff
changeset
|
5925 |
list |
ac146fc38b51
refined HOL string theories and corresponding ML fragments
haftmann
parents:
31022
diff
changeset
|
5926 |
|
45181 | 5927 |
setup {* fold (List_Code.add_literal_list) ["SML", "OCaml", "Haskell", "Scala"] *} |
15064
4f3102b50197
- Moved code generator setup for lists from Main.thy to List.thy
berghofe
parents:
15045
diff
changeset
|
5928 |
|
21061
580dfc999ef6
added normal post setup; cleaned up "execution" constants
haftmann
parents:
21046
diff
changeset
|
5929 |
|
37424
ed431cc99f17
use various predefined Haskell operations when generating code
haftmann
parents:
37408
diff
changeset
|
5930 |
subsubsection {* Use convenient predefined operations *} |
ed431cc99f17
use various predefined Haskell operations when generating code
haftmann
parents:
37408
diff
changeset
|
5931 |
|
ed431cc99f17
use various predefined Haskell operations when generating code
haftmann
parents:
37408
diff
changeset
|
5932 |
code_const "op @" |
ed431cc99f17
use various predefined Haskell operations when generating code
haftmann
parents:
37408
diff
changeset
|
5933 |
(SML infixr 7 "@") |
ed431cc99f17
use various predefined Haskell operations when generating code
haftmann
parents:
37408
diff
changeset
|
5934 |
(OCaml infixr 6 "@") |
ed431cc99f17
use various predefined Haskell operations when generating code
haftmann
parents:
37408
diff
changeset
|
5935 |
(Haskell infixr 5 "++") |
ed431cc99f17
use various predefined Haskell operations when generating code
haftmann
parents:
37408
diff
changeset
|
5936 |
(Scala infixl 7 "++") |
ed431cc99f17
use various predefined Haskell operations when generating code
haftmann
parents:
37408
diff
changeset
|
5937 |
|
ed431cc99f17
use various predefined Haskell operations when generating code
haftmann
parents:
37408
diff
changeset
|
5938 |
code_const map |
ed431cc99f17
use various predefined Haskell operations when generating code
haftmann
parents:
37408
diff
changeset
|
5939 |
(Haskell "map") |
ed431cc99f17
use various predefined Haskell operations when generating code
haftmann
parents:
37408
diff
changeset
|
5940 |
|
ed431cc99f17
use various predefined Haskell operations when generating code
haftmann
parents:
37408
diff
changeset
|
5941 |
code_const filter |
ed431cc99f17
use various predefined Haskell operations when generating code
haftmann
parents:
37408
diff
changeset
|
5942 |
(Haskell "filter") |
ed431cc99f17
use various predefined Haskell operations when generating code
haftmann
parents:
37408
diff
changeset
|
5943 |
|
ed431cc99f17
use various predefined Haskell operations when generating code
haftmann
parents:
37408
diff
changeset
|
5944 |
code_const concat |
ed431cc99f17
use various predefined Haskell operations when generating code
haftmann
parents:
37408
diff
changeset
|
5945 |
(Haskell "concat") |
ed431cc99f17
use various predefined Haskell operations when generating code
haftmann
parents:
37408
diff
changeset
|
5946 |
|
37605
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
5947 |
code_const List.maps |
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
5948 |
(Haskell "concatMap") |
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
5949 |
|
37424
ed431cc99f17
use various predefined Haskell operations when generating code
haftmann
parents:
37408
diff
changeset
|
5950 |
code_const rev |
37451 | 5951 |
(Haskell "reverse") |
37424
ed431cc99f17
use various predefined Haskell operations when generating code
haftmann
parents:
37408
diff
changeset
|
5952 |
|
ed431cc99f17
use various predefined Haskell operations when generating code
haftmann
parents:
37408
diff
changeset
|
5953 |
code_const zip |
ed431cc99f17
use various predefined Haskell operations when generating code
haftmann
parents:
37408
diff
changeset
|
5954 |
(Haskell "zip") |
ed431cc99f17
use various predefined Haskell operations when generating code
haftmann
parents:
37408
diff
changeset
|
5955 |
|
37605
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
5956 |
code_const List.null |
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
5957 |
(Haskell "null") |
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
5958 |
|
37424
ed431cc99f17
use various predefined Haskell operations when generating code
haftmann
parents:
37408
diff
changeset
|
5959 |
code_const takeWhile |
ed431cc99f17
use various predefined Haskell operations when generating code
haftmann
parents:
37408
diff
changeset
|
5960 |
(Haskell "takeWhile") |
ed431cc99f17
use various predefined Haskell operations when generating code
haftmann
parents:
37408
diff
changeset
|
5961 |
|
ed431cc99f17
use various predefined Haskell operations when generating code
haftmann
parents:
37408
diff
changeset
|
5962 |
code_const dropWhile |
ed431cc99f17
use various predefined Haskell operations when generating code
haftmann
parents:
37408
diff
changeset
|
5963 |
(Haskell "dropWhile") |
ed431cc99f17
use various predefined Haskell operations when generating code
haftmann
parents:
37408
diff
changeset
|
5964 |
|
37605
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
5965 |
code_const list_all |
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
5966 |
(Haskell "all") |
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
5967 |
|
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
5968 |
code_const list_ex |
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
5969 |
(Haskell "any") |
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
5970 |
|
46147
2c4d8de91c4c
moved lemmas about List.set and set operations to List theory
haftmann
parents:
46143
diff
changeset
|
5971 |
|
2c4d8de91c4c
moved lemmas about List.set and set operations to List theory
haftmann
parents:
46143
diff
changeset
|
5972 |
subsubsection {* Implementation of sets by lists *} |
2c4d8de91c4c
moved lemmas about List.set and set operations to List theory
haftmann
parents:
46143
diff
changeset
|
5973 |
|
2c4d8de91c4c
moved lemmas about List.set and set operations to List theory
haftmann
parents:
46143
diff
changeset
|
5974 |
lemma is_empty_set [code]: |
2c4d8de91c4c
moved lemmas about List.set and set operations to List theory
haftmann
parents:
46143
diff
changeset
|
5975 |
"Set.is_empty (set xs) \<longleftrightarrow> List.null xs" |
2c4d8de91c4c
moved lemmas about List.set and set operations to List theory
haftmann
parents:
46143
diff
changeset
|
5976 |
by (simp add: Set.is_empty_def null_def) |
2c4d8de91c4c
moved lemmas about List.set and set operations to List theory
haftmann
parents:
46143
diff
changeset
|
5977 |
|
2c4d8de91c4c
moved lemmas about List.set and set operations to List theory
haftmann
parents:
46143
diff
changeset
|
5978 |
lemma empty_set [code]: |
2c4d8de91c4c
moved lemmas about List.set and set operations to List theory
haftmann
parents:
46143
diff
changeset
|
5979 |
"{} = set []" |
2c4d8de91c4c
moved lemmas about List.set and set operations to List theory
haftmann
parents:
46143
diff
changeset
|
5980 |
by simp |
2c4d8de91c4c
moved lemmas about List.set and set operations to List theory
haftmann
parents:
46143
diff
changeset
|
5981 |
|
46156 | 5982 |
lemma UNIV_coset [code]: |
5983 |
"UNIV = List.coset []" |
|
5984 |
by simp |
|
5985 |
||
5986 |
lemma compl_set [code]: |
|
5987 |
"- set xs = List.coset xs" |
|
5988 |
by simp |
|
5989 |
||
5990 |
lemma compl_coset [code]: |
|
5991 |
"- List.coset xs = set xs" |
|
5992 |
by simp |
|
5993 |
||
46147
2c4d8de91c4c
moved lemmas about List.set and set operations to List theory
haftmann
parents:
46143
diff
changeset
|
5994 |
lemma [code]: |
2c4d8de91c4c
moved lemmas about List.set and set operations to List theory
haftmann
parents:
46143
diff
changeset
|
5995 |
"x \<in> set xs \<longleftrightarrow> List.member xs x" |
2c4d8de91c4c
moved lemmas about List.set and set operations to List theory
haftmann
parents:
46143
diff
changeset
|
5996 |
"x \<in> List.coset xs \<longleftrightarrow> \<not> List.member xs x" |
2c4d8de91c4c
moved lemmas about List.set and set operations to List theory
haftmann
parents:
46143
diff
changeset
|
5997 |
by (simp_all add: member_def) |
2c4d8de91c4c
moved lemmas about List.set and set operations to List theory
haftmann
parents:
46143
diff
changeset
|
5998 |
|
2c4d8de91c4c
moved lemmas about List.set and set operations to List theory
haftmann
parents:
46143
diff
changeset
|
5999 |
lemma insert_code [code]: |
2c4d8de91c4c
moved lemmas about List.set and set operations to List theory
haftmann
parents:
46143
diff
changeset
|
6000 |
"insert x (set xs) = set (List.insert x xs)" |
2c4d8de91c4c
moved lemmas about List.set and set operations to List theory
haftmann
parents:
46143
diff
changeset
|
6001 |
"insert x (List.coset xs) = List.coset (removeAll x xs)" |
2c4d8de91c4c
moved lemmas about List.set and set operations to List theory
haftmann
parents:
46143
diff
changeset
|
6002 |
by simp_all |
2c4d8de91c4c
moved lemmas about List.set and set operations to List theory
haftmann
parents:
46143
diff
changeset
|
6003 |
|
2c4d8de91c4c
moved lemmas about List.set and set operations to List theory
haftmann
parents:
46143
diff
changeset
|
6004 |
lemma remove_code [code]: |
2c4d8de91c4c
moved lemmas about List.set and set operations to List theory
haftmann
parents:
46143
diff
changeset
|
6005 |
"Set.remove x (set xs) = set (removeAll x xs)" |
2c4d8de91c4c
moved lemmas about List.set and set operations to List theory
haftmann
parents:
46143
diff
changeset
|
6006 |
"Set.remove x (List.coset xs) = List.coset (List.insert x xs)" |
2c4d8de91c4c
moved lemmas about List.set and set operations to List theory
haftmann
parents:
46143
diff
changeset
|
6007 |
by (simp_all add: remove_def Compl_insert) |
2c4d8de91c4c
moved lemmas about List.set and set operations to List theory
haftmann
parents:
46143
diff
changeset
|
6008 |
|
49757
73ab6d4a9236
rename Set.project to Set.filter - more appropriate name
kuncar
parents:
49739
diff
changeset
|
6009 |
lemma filter_set [code]: |
73ab6d4a9236
rename Set.project to Set.filter - more appropriate name
kuncar
parents:
49739
diff
changeset
|
6010 |
"Set.filter P (set xs) = set (filter P xs)" |
46156 | 6011 |
by auto |
6012 |
||
6013 |
lemma image_set [code]: |
|
6014 |
"image f (set xs) = set (map f xs)" |
|
6015 |
by simp |
|
6016 |
||
47398 | 6017 |
lemma subset_code [code]: |
6018 |
"set xs \<le> B \<longleftrightarrow> (\<forall>x\<in>set xs. x \<in> B)" |
|
6019 |
"A \<le> List.coset ys \<longleftrightarrow> (\<forall>y\<in>set ys. y \<notin> A)" |
|
6020 |
"List.coset [] \<le> set [] \<longleftrightarrow> False" |
|
6021 |
by auto |
|
6022 |
||
6023 |
text {* A frequent case – avoid intermediate sets *} |
|
6024 |
lemma [code_unfold]: |
|
6025 |
"set xs \<subseteq> set ys \<longleftrightarrow> list_all (\<lambda>x. x \<in> set ys) xs" |
|
6026 |
by (auto simp: list_all_iff) |
|
6027 |
||
46147
2c4d8de91c4c
moved lemmas about List.set and set operations to List theory
haftmann
parents:
46143
diff
changeset
|
6028 |
lemma Ball_set [code]: |
2c4d8de91c4c
moved lemmas about List.set and set operations to List theory
haftmann
parents:
46143
diff
changeset
|
6029 |
"Ball (set xs) P \<longleftrightarrow> list_all P xs" |
2c4d8de91c4c
moved lemmas about List.set and set operations to List theory
haftmann
parents:
46143
diff
changeset
|
6030 |
by (simp add: list_all_iff) |
2c4d8de91c4c
moved lemmas about List.set and set operations to List theory
haftmann
parents:
46143
diff
changeset
|
6031 |
|
2c4d8de91c4c
moved lemmas about List.set and set operations to List theory
haftmann
parents:
46143
diff
changeset
|
6032 |
lemma Bex_set [code]: |
2c4d8de91c4c
moved lemmas about List.set and set operations to List theory
haftmann
parents:
46143
diff
changeset
|
6033 |
"Bex (set xs) P \<longleftrightarrow> list_ex P xs" |
2c4d8de91c4c
moved lemmas about List.set and set operations to List theory
haftmann
parents:
46143
diff
changeset
|
6034 |
by (simp add: list_ex_iff) |
2c4d8de91c4c
moved lemmas about List.set and set operations to List theory
haftmann
parents:
46143
diff
changeset
|
6035 |
|
2c4d8de91c4c
moved lemmas about List.set and set operations to List theory
haftmann
parents:
46143
diff
changeset
|
6036 |
lemma card_set [code]: |
2c4d8de91c4c
moved lemmas about List.set and set operations to List theory
haftmann
parents:
46143
diff
changeset
|
6037 |
"card (set xs) = length (remdups xs)" |
2c4d8de91c4c
moved lemmas about List.set and set operations to List theory
haftmann
parents:
46143
diff
changeset
|
6038 |
proof - |
2c4d8de91c4c
moved lemmas about List.set and set operations to List theory
haftmann
parents:
46143
diff
changeset
|
6039 |
have "card (set (remdups xs)) = length (remdups xs)" |
2c4d8de91c4c
moved lemmas about List.set and set operations to List theory
haftmann
parents:
46143
diff
changeset
|
6040 |
by (rule distinct_card) simp |
2c4d8de91c4c
moved lemmas about List.set and set operations to List theory
haftmann
parents:
46143
diff
changeset
|
6041 |
then show ?thesis by simp |
2c4d8de91c4c
moved lemmas about List.set and set operations to List theory
haftmann
parents:
46143
diff
changeset
|
6042 |
qed |
2c4d8de91c4c
moved lemmas about List.set and set operations to List theory
haftmann
parents:
46143
diff
changeset
|
6043 |
|
46156 | 6044 |
lemma the_elem_set [code]: |
6045 |
"the_elem (set [x]) = x" |
|
6046 |
by simp |
|
6047 |
||
6048 |
lemma Pow_set [code]: |
|
6049 |
"Pow (set []) = {{}}" |
|
6050 |
"Pow (set (x # xs)) = (let A = Pow (set xs) in A \<union> insert x ` A)" |
|
6051 |
by (simp_all add: Pow_insert Let_def) |
|
6052 |
||
46383 | 6053 |
lemma setsum_code [code]: |
6054 |
"setsum f (set xs) = listsum (map f (remdups xs))" |
|
6055 |
by (simp add: listsum_distinct_conv_setsum_set) |
|
46147
2c4d8de91c4c
moved lemmas about List.set and set operations to List theory
haftmann
parents:
46143
diff
changeset
|
6056 |
|
46424
b447318e5e1a
adding code equation for Relation.image; adding map_project as correspondence to map_filter on lists
bulwahn
parents:
46418
diff
changeset
|
6057 |
definition map_project :: "('a \<Rightarrow> 'b option) \<Rightarrow> 'a set \<Rightarrow> 'b set" where |
b447318e5e1a
adding code equation for Relation.image; adding map_project as correspondence to map_filter on lists
bulwahn
parents:
46418
diff
changeset
|
6058 |
"map_project f A = {b. \<exists> a \<in> A. f a = Some b}" |
b447318e5e1a
adding code equation for Relation.image; adding map_project as correspondence to map_filter on lists
bulwahn
parents:
46418
diff
changeset
|
6059 |
|
b447318e5e1a
adding code equation for Relation.image; adding map_project as correspondence to map_filter on lists
bulwahn
parents:
46418
diff
changeset
|
6060 |
lemma [code]: |
b447318e5e1a
adding code equation for Relation.image; adding map_project as correspondence to map_filter on lists
bulwahn
parents:
46418
diff
changeset
|
6061 |
"map_project f (set xs) = set (List.map_filter f xs)" |
47398 | 6062 |
by (auto simp add: map_project_def map_filter_def image_def) |
46424
b447318e5e1a
adding code equation for Relation.image; adding map_project as correspondence to map_filter on lists
bulwahn
parents:
46418
diff
changeset
|
6063 |
|
b447318e5e1a
adding code equation for Relation.image; adding map_project as correspondence to map_filter on lists
bulwahn
parents:
46418
diff
changeset
|
6064 |
hide_const (open) map_project |
b447318e5e1a
adding code equation for Relation.image; adding map_project as correspondence to map_filter on lists
bulwahn
parents:
46418
diff
changeset
|
6065 |
|
49948
744934b818c7
moved quite generic material from theory Enum to more appropriate places
haftmann
parents:
49808
diff
changeset
|
6066 |
|
46147
2c4d8de91c4c
moved lemmas about List.set and set operations to List theory
haftmann
parents:
46143
diff
changeset
|
6067 |
text {* Operations on relations *} |
2c4d8de91c4c
moved lemmas about List.set and set operations to List theory
haftmann
parents:
46143
diff
changeset
|
6068 |
|
2c4d8de91c4c
moved lemmas about List.set and set operations to List theory
haftmann
parents:
46143
diff
changeset
|
6069 |
lemma product_code [code]: |
2c4d8de91c4c
moved lemmas about List.set and set operations to List theory
haftmann
parents:
46143
diff
changeset
|
6070 |
"Product_Type.product (set xs) (set ys) = set [(x, y). x \<leftarrow> xs, y \<leftarrow> ys]" |
2c4d8de91c4c
moved lemmas about List.set and set operations to List theory
haftmann
parents:
46143
diff
changeset
|
6071 |
by (auto simp add: Product_Type.product_def) |
2c4d8de91c4c
moved lemmas about List.set and set operations to List theory
haftmann
parents:
46143
diff
changeset
|
6072 |
|
2c4d8de91c4c
moved lemmas about List.set and set operations to List theory
haftmann
parents:
46143
diff
changeset
|
6073 |
lemma Id_on_set [code]: |
2c4d8de91c4c
moved lemmas about List.set and set operations to List theory
haftmann
parents:
46143
diff
changeset
|
6074 |
"Id_on (set xs) = set [(x, x). x \<leftarrow> xs]" |
2c4d8de91c4c
moved lemmas about List.set and set operations to List theory
haftmann
parents:
46143
diff
changeset
|
6075 |
by (auto simp add: Id_on_def) |
2c4d8de91c4c
moved lemmas about List.set and set operations to List theory
haftmann
parents:
46143
diff
changeset
|
6076 |
|
46424
b447318e5e1a
adding code equation for Relation.image; adding map_project as correspondence to map_filter on lists
bulwahn
parents:
46418
diff
changeset
|
6077 |
lemma [code]: |
b447318e5e1a
adding code equation for Relation.image; adding map_project as correspondence to map_filter on lists
bulwahn
parents:
46418
diff
changeset
|
6078 |
"R `` S = List.map_project (%(x, y). if x : S then Some y else None) R" |
b447318e5e1a
adding code equation for Relation.image; adding map_project as correspondence to map_filter on lists
bulwahn
parents:
46418
diff
changeset
|
6079 |
unfolding map_project_def by (auto split: prod.split split_if_asm) |
b447318e5e1a
adding code equation for Relation.image; adding map_project as correspondence to map_filter on lists
bulwahn
parents:
46418
diff
changeset
|
6080 |
|
46147
2c4d8de91c4c
moved lemmas about List.set and set operations to List theory
haftmann
parents:
46143
diff
changeset
|
6081 |
lemma trancl_set_ntrancl [code]: |
2c4d8de91c4c
moved lemmas about List.set and set operations to List theory
haftmann
parents:
46143
diff
changeset
|
6082 |
"trancl (set xs) = ntrancl (card (set xs) - 1) (set xs)" |
2c4d8de91c4c
moved lemmas about List.set and set operations to List theory
haftmann
parents:
46143
diff
changeset
|
6083 |
by (simp add: finite_trancl_ntranl) |
2c4d8de91c4c
moved lemmas about List.set and set operations to List theory
haftmann
parents:
46143
diff
changeset
|
6084 |
|
47433
07f4bf913230
renamed "rel_comp" to "relcomp" (to be consistent with, e.g., "relpow")
griff
parents:
47131
diff
changeset
|
6085 |
lemma set_relcomp [code]: |
46147
2c4d8de91c4c
moved lemmas about List.set and set operations to List theory
haftmann
parents:
46143
diff
changeset
|
6086 |
"set xys O set yzs = set ([(fst xy, snd yz). xy \<leftarrow> xys, yz \<leftarrow> yzs, snd xy = fst yz])" |
2c4d8de91c4c
moved lemmas about List.set and set operations to List theory
haftmann
parents:
46143
diff
changeset
|
6087 |
by (auto simp add: Bex_def) |
2c4d8de91c4c
moved lemmas about List.set and set operations to List theory
haftmann
parents:
46143
diff
changeset
|
6088 |
|
2c4d8de91c4c
moved lemmas about List.set and set operations to List theory
haftmann
parents:
46143
diff
changeset
|
6089 |
lemma wf_set [code]: |
2c4d8de91c4c
moved lemmas about List.set and set operations to List theory
haftmann
parents:
46143
diff
changeset
|
6090 |
"wf (set xs) = acyclic (set xs)" |
2c4d8de91c4c
moved lemmas about List.set and set operations to List theory
haftmann
parents:
46143
diff
changeset
|
6091 |
by (simp add: wf_iff_acyclic_if_finite) |
2c4d8de91c4c
moved lemmas about List.set and set operations to List theory
haftmann
parents:
46143
diff
changeset
|
6092 |
|
23388 | 6093 |
end |
47397
d654c73e4b12
no preference wrt. fold(l/r); prefer fold rather than foldr for iterating over lists in generated code
haftmann
parents:
47131
diff
changeset
|
6094 |