author | blanchet |
Thu, 21 Nov 2013 21:33:34 +0100 | |
changeset 54555 | e8c5e95d338b |
parent 54498 | f7fef6b00bfe |
child 54598 | 33a68b7f2736 |
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 |
54555 | 8 |
imports Presburger Code_Numeral Quotient Lifting_Set Lifting_Option Lifting_Product |
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 |
|
53721
ccaceea6c768
added two functions to List (one contributed by Manuel Eberl)
traytel
parents:
53689
diff
changeset
|
149 |
primrec product_lists :: "'a list list \<Rightarrow> 'a list list" where |
ccaceea6c768
added two functions to List (one contributed by Manuel Eberl)
traytel
parents:
53689
diff
changeset
|
150 |
"product_lists [] = [[]]" | |
ccaceea6c768
added two functions to List (one contributed by Manuel Eberl)
traytel
parents:
53689
diff
changeset
|
151 |
"product_lists (xs # xss) = concat (map (\<lambda>x. map (Cons x) (product_lists xss)) xs)" |
ccaceea6c768
added two functions to List (one contributed by Manuel Eberl)
traytel
parents:
53689
diff
changeset
|
152 |
|
50548 | 153 |
primrec upt :: "nat \<Rightarrow> nat \<Rightarrow> nat list" ("(1[_..</_'])") where |
154 |
upt_0: "[i..<0] = []" | |
|
155 |
upt_Suc: "[i..<(Suc j)] = (if i <= j then [i..<j] @ [j] else [])" |
|
156 |
||
157 |
definition insert :: "'a \<Rightarrow> 'a list \<Rightarrow> 'a list" where |
|
158 |
"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
|
159 |
|
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
|
160 |
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
|
161 |
hide_fact (open) insert_def |
34978
874150ddd50a
canonical insert operation; generalized lemma foldl_apply_inv to foldl_apply
haftmann
parents:
34942
diff
changeset
|
162 |
|
47122 | 163 |
primrec find :: "('a \<Rightarrow> bool) \<Rightarrow> 'a list \<Rightarrow> 'a option" where |
50548 | 164 |
"find _ [] = None" | |
165 |
"find P (x#xs) = (if P x then Some x else find P xs)" |
|
47122 | 166 |
|
167 |
hide_const (open) find |
|
168 |
||
51096 | 169 |
primrec those :: "'a option list \<Rightarrow> 'a list option" |
170 |
where |
|
171 |
"those [] = Some []" | |
|
172 |
"those (x # xs) = (case x of |
|
173 |
None \<Rightarrow> None |
|
174 |
| Some y \<Rightarrow> Option.map (Cons y) (those xs))" |
|
175 |
||
50548 | 176 |
primrec remove1 :: "'a \<Rightarrow> 'a list \<Rightarrow> 'a list" where |
177 |
"remove1 x [] = []" | |
|
178 |
"remove1 x (y # xs) = (if x = y then xs else y # remove1 x xs)" |
|
179 |
||
180 |
primrec removeAll :: "'a \<Rightarrow> 'a list \<Rightarrow> 'a list" where |
|
181 |
"removeAll x [] = []" | |
|
182 |
"removeAll x (y # xs) = (if x = y then removeAll x xs else y # removeAll x xs)" |
|
183 |
||
184 |
primrec distinct :: "'a list \<Rightarrow> bool" where |
|
185 |
"distinct [] \<longleftrightarrow> True" | |
|
186 |
"distinct (x # xs) \<longleftrightarrow> x \<notin> set xs \<and> distinct xs" |
|
187 |
||
188 |
primrec remdups :: "'a list \<Rightarrow> 'a list" where |
|
189 |
"remdups [] = []" | |
|
190 |
"remdups (x # xs) = (if x \<in> set xs then remdups xs else x # remdups xs)" |
|
191 |
||
53721
ccaceea6c768
added two functions to List (one contributed by Manuel Eberl)
traytel
parents:
53689
diff
changeset
|
192 |
fun remdups_adj :: "'a list \<Rightarrow> 'a list" where |
ccaceea6c768
added two functions to List (one contributed by Manuel Eberl)
traytel
parents:
53689
diff
changeset
|
193 |
"remdups_adj [] = []" | |
ccaceea6c768
added two functions to List (one contributed by Manuel Eberl)
traytel
parents:
53689
diff
changeset
|
194 |
"remdups_adj [x] = [x]" | |
ccaceea6c768
added two functions to List (one contributed by Manuel Eberl)
traytel
parents:
53689
diff
changeset
|
195 |
"remdups_adj (x # y # xs) = (if x = y then remdups_adj (x # xs) else x # remdups_adj (y # xs))" |
ccaceea6c768
added two functions to List (one contributed by Manuel Eberl)
traytel
parents:
53689
diff
changeset
|
196 |
|
50548 | 197 |
primrec replicate :: "nat \<Rightarrow> 'a \<Rightarrow> 'a list" where |
198 |
replicate_0: "replicate 0 x = []" | |
|
199 |
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
|
200 |
|
13142 | 201 |
text {* |
14589 | 202 |
Function @{text size} is overloaded for all datatypes. Users may |
13366 | 203 |
refer to the list version as @{text length}. *} |
13142 | 204 |
|
50548 | 205 |
abbreviation length :: "'a list \<Rightarrow> nat" where |
206 |
"length \<equiv> size" |
|
15307 | 207 |
|
51173 | 208 |
definition enumerate :: "nat \<Rightarrow> 'a list \<Rightarrow> (nat \<times> 'a) list" where |
209 |
enumerate_eq_zip: "enumerate n xs = zip [n..<n + length xs] xs" |
|
210 |
||
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
|
211 |
primrec rotate1 :: "'a list \<Rightarrow> 'a list" where |
50548 | 212 |
"rotate1 [] = []" | |
213 |
"rotate1 (x # xs) = xs @ [x]" |
|
214 |
||
215 |
definition rotate :: "nat \<Rightarrow> 'a list \<Rightarrow> 'a list" where |
|
216 |
"rotate n = rotate1 ^^ n" |
|
217 |
||
218 |
definition list_all2 :: "('a \<Rightarrow> 'b \<Rightarrow> bool) \<Rightarrow> 'a list \<Rightarrow> 'b list \<Rightarrow> bool" where |
|
219 |
"list_all2 P xs ys = |
|
220 |
(length xs = length ys \<and> (\<forall>(x, y) \<in> set (zip xs ys). P x y))" |
|
221 |
||
222 |
definition sublist :: "'a list => nat set => 'a list" where |
|
223 |
"sublist xs A = map fst (filter (\<lambda>p. snd p \<in> A) (zip xs [0..<size xs]))" |
|
224 |
||
225 |
primrec sublists :: "'a list \<Rightarrow> 'a list list" where |
|
226 |
"sublists [] = [[]]" | |
|
227 |
"sublists (x#xs) = (let xss = sublists xs in map (Cons x) xss @ xss)" |
|
228 |
||
229 |
primrec n_lists :: "nat \<Rightarrow> 'a list \<Rightarrow> 'a list list" where |
|
230 |
"n_lists 0 xs = [[]]" | |
|
231 |
"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
|
232 |
|
744934b818c7
moved quite generic material from theory Enum to more appropriate places
haftmann
parents:
49808
diff
changeset
|
233 |
hide_const (open) n_lists |
744934b818c7
moved quite generic material from theory Enum to more appropriate places
haftmann
parents:
49808
diff
changeset
|
234 |
|
40593
1e57b18d27b1
code eqn for slice was missing; redefined splice with fun
nipkow
parents:
40365
diff
changeset
|
235 |
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
|
236 |
"splice [] ys = ys" | |
1e57b18d27b1
code eqn for slice was missing; redefined splice with fun
nipkow
parents:
40365
diff
changeset
|
237 |
"splice xs [] = xs" | |
1e57b18d27b1
code eqn for slice was missing; redefined splice with fun
nipkow
parents:
40365
diff
changeset
|
238 |
"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
|
239 |
|
26771 | 240 |
text{* |
241 |
\begin{figure}[htbp] |
|
242 |
\fbox{ |
|
243 |
\begin{tabular}{l} |
|
27381 | 244 |
@{lemma "[a,b]@[c,d] = [a,b,c,d]" by simp}\\ |
245 |
@{lemma "length [a,b,c] = 3" by simp}\\ |
|
246 |
@{lemma "set [a,b,c] = {a,b,c}" by simp}\\ |
|
247 |
@{lemma "map f [a,b,c] = [f a, f b, f c]" by simp}\\ |
|
248 |
@{lemma "rev [a,b,c] = [c,b,a]" by simp}\\ |
|
249 |
@{lemma "hd [a,b,c,d] = a" by simp}\\ |
|
250 |
@{lemma "tl [a,b,c,d] = [b,c,d]" by simp}\\ |
|
251 |
@{lemma "last [a,b,c,d] = d" by simp}\\ |
|
252 |
@{lemma "butlast [a,b,c,d] = [a,b,c]" by simp}\\ |
|
253 |
@{lemma[source] "filter (\<lambda>n::nat. n<2) [0,2,1] = [0,1]" by simp}\\ |
|
254 |
@{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
|
255 |
@{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
|
256 |
@{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
|
257 |
@{lemma "foldl f x [a,b,c] = f (f (f x a) b) c" by simp}\\ |
27381 | 258 |
@{lemma "zip [a,b,c] [x,y,z] = [(a,x),(b,y),(c,z)]" by simp}\\ |
259 |
@{lemma "zip [a,b] [x,y,z] = [(a,x),(b,y)]" by simp}\\ |
|
51173 | 260 |
@{lemma "enumerate 3 [a,b,c] = [(3,a),(4,b),(5,c)]" by normalization}\\ |
49948
744934b818c7
moved quite generic material from theory Enum to more appropriate places
haftmann
parents:
49808
diff
changeset
|
261 |
@{lemma "List.product [a,b] [c,d] = [(a, c), (a, d), (b, c), (b, d)]" by simp}\\ |
53721
ccaceea6c768
added two functions to List (one contributed by Manuel Eberl)
traytel
parents:
53689
diff
changeset
|
262 |
@{lemma "product_lists [[a,b], [c], [d,e]] = [[a,c,d], [a,c,e], [b,c,d], [b,c,e]]" by simp}\\ |
27381 | 263 |
@{lemma "splice [a,b,c] [x,y,z] = [a,x,b,y,c,z]" by simp}\\ |
264 |
@{lemma "splice [a,b,c,d] [x,y] = [a,x,b,y,c,d]" by simp}\\ |
|
265 |
@{lemma "take 2 [a,b,c,d] = [a,b]" by simp}\\ |
|
266 |
@{lemma "take 6 [a,b,c,d] = [a,b,c,d]" by simp}\\ |
|
267 |
@{lemma "drop 2 [a,b,c,d] = [c,d]" by simp}\\ |
|
268 |
@{lemma "drop 6 [a,b,c,d] = []" by simp}\\ |
|
269 |
@{lemma "takeWhile (%n::nat. n<3) [1,2,3,0] = [1,2]" by simp}\\ |
|
270 |
@{lemma "dropWhile (%n::nat. n<3) [1,2,3,0] = [3,0]" by simp}\\ |
|
271 |
@{lemma "distinct [2,0,1::nat]" by simp}\\ |
|
272 |
@{lemma "remdups [2,0,2,1::nat,2] = [0,1,2]" by simp}\\ |
|
53721
ccaceea6c768
added two functions to List (one contributed by Manuel Eberl)
traytel
parents:
53689
diff
changeset
|
273 |
@{lemma "remdups_adj [2,2,3,1,1::nat,2,1] = [2,3,1,2,1]" by simp}\\ |
34978
874150ddd50a
canonical insert operation; generalized lemma foldl_apply_inv to foldl_apply
haftmann
parents:
34942
diff
changeset
|
274 |
@{lemma "List.insert 2 [0::nat,1,2] = [0,1,2]" by (simp add: List.insert_def)}\\ |
35295 | 275 |
@{lemma "List.insert 3 [0::nat,1,2] = [3,0,1,2]" by (simp add: List.insert_def)}\\ |
47122 | 276 |
@{lemma "List.find (%i::int. i>0) [0,0] = None" by simp}\\ |
277 |
@{lemma "List.find (%i::int. i>0) [0,1,0,2] = Some 1" by simp}\\ |
|
27381 | 278 |
@{lemma "remove1 2 [2,0,2,1::nat,2] = [0,2,1,2]" by simp}\\ |
27693 | 279 |
@{lemma "removeAll 2 [2,0,2,1::nat,2] = [0,1]" by simp}\\ |
27381 | 280 |
@{lemma "nth [a,b,c,d] 2 = c" by simp}\\ |
281 |
@{lemma "[a,b,c,d][2 := x] = [a,b,x,d]" by simp}\\ |
|
282 |
@{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
|
283 |
@{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
|
284 |
@{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
|
285 |
@{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
|
286 |
@{lemma "rotate 3 [a,b,c,d] = [d,a,b,c]" by (simp add:rotate_def eval_nat_numeral)}\\ |
40077 | 287 |
@{lemma "replicate 4 a = [a,a,a,a]" by (simp add:eval_nat_numeral)}\\ |
288 |
@{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
|
289 |
@{lemma "listsum [1,2,3::nat] = 6" by (simp add: listsum_def)} |
26771 | 290 |
\end{tabular}} |
291 |
\caption{Characteristic examples} |
|
292 |
\label{fig:Characteristic} |
|
293 |
\end{figure} |
|
29927 | 294 |
Figure~\ref{fig:Characteristic} shows characteristic examples |
26771 | 295 |
that should give an intuitive understanding of the above functions. |
296 |
*} |
|
297 |
||
24616 | 298 |
text{* The following simple sort functions are intended for proofs, |
299 |
not for efficient implementations. *} |
|
300 |
||
25221
5ded95dda5df
append/member: more light-weight way to declare authentic syntax;
wenzelm
parents:
25215
diff
changeset
|
301 |
context linorder |
5ded95dda5df
append/member: more light-weight way to declare authentic syntax;
wenzelm
parents:
25215
diff
changeset
|
302 |
begin |
5ded95dda5df
append/member: more light-weight way to declare authentic syntax;
wenzelm
parents:
25215
diff
changeset
|
303 |
|
39915
ecf97cf3d248
turned distinct and sorted into inductive predicates: yields nice induction principles for free; more elegant proofs
haftmann
parents:
39774
diff
changeset
|
304 |
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
|
305 |
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
|
306 |
| 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
|
307 |
|
ecf97cf3d248
turned distinct and sorted into inductive predicates: yields nice induction principles for free; more elegant proofs
haftmann
parents:
39774
diff
changeset
|
308 |
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
|
309 |
"sorted [x]" |
ecf97cf3d248
turned distinct and sorted into inductive predicates: yields nice induction principles for free; more elegant proofs
haftmann
parents:
39774
diff
changeset
|
310 |
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
|
311 |
|
ecf97cf3d248
turned distinct and sorted into inductive predicates: yields nice induction principles for free; more elegant proofs
haftmann
parents:
39774
diff
changeset
|
312 |
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
|
313 |
"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
|
314 |
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
|
315 |
|
ecf97cf3d248
turned distinct and sorted into inductive predicates: yields nice induction principles for free; more elegant proofs
haftmann
parents:
39774
diff
changeset
|
316 |
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
|
317 |
"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
|
318 |
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
|
319 |
|
ecf97cf3d248
turned distinct and sorted into inductive predicates: yields nice induction principles for free; more elegant proofs
haftmann
parents:
39774
diff
changeset
|
320 |
lemma [code]: |
ecf97cf3d248
turned distinct and sorted into inductive predicates: yields nice induction principles for free; more elegant proofs
haftmann
parents:
39774
diff
changeset
|
321 |
"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
|
322 |
"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
|
323 |
by simp_all |
24697 | 324 |
|
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
|
325 |
primrec insort_key :: "('b \<Rightarrow> 'a) \<Rightarrow> 'b \<Rightarrow> 'b list \<Rightarrow> 'b list" where |
50548 | 326 |
"insort_key f x [] = [x]" | |
327 |
"insort_key f x (y#ys) = |
|
328 |
(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
|
329 |
|
35195 | 330 |
definition sort_key :: "('b \<Rightarrow> 'a) \<Rightarrow> 'b list \<Rightarrow> 'b list" where |
50548 | 331 |
"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
|
332 |
|
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
|
333 |
definition insort_insert_key :: "('b \<Rightarrow> 'a) \<Rightarrow> 'b \<Rightarrow> 'b list \<Rightarrow> 'b list" where |
50548 | 334 |
"insort_insert_key f x xs = |
335 |
(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
|
336 |
|
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
|
337 |
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
|
338 |
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
|
339 |
abbreviation "insort_insert \<equiv> insort_insert_key (\<lambda>x. x)" |
35608 | 340 |
|
25221
5ded95dda5df
append/member: more light-weight way to declare authentic syntax;
wenzelm
parents:
25215
diff
changeset
|
341 |
end |
5ded95dda5df
append/member: more light-weight way to declare authentic syntax;
wenzelm
parents:
25215
diff
changeset
|
342 |
|
24616 | 343 |
|
23388 | 344 |
subsubsection {* List comprehension *} |
23192 | 345 |
|
24349 | 346 |
text{* Input syntax for Haskell-like list comprehension notation. |
347 |
Typical example: @{text"[(x,y). x \<leftarrow> xs, y \<leftarrow> ys, x \<noteq> y]"}, |
|
348 |
the list of all pairs of distinct elements from @{text xs} and @{text ys}. |
|
349 |
The syntax is as in Haskell, except that @{text"|"} becomes a dot |
|
350 |
(like in Isabelle's set comprehension): @{text"[e. x \<leftarrow> xs, \<dots>]"} rather than |
|
351 |
\verb![e| x <- xs, ...]!. |
|
352 |
||
353 |
The qualifiers after the dot are |
|
354 |
\begin{description} |
|
355 |
\item[generators] @{text"p \<leftarrow> xs"}, |
|
24476
f7ad9fbbeeaa
turned list comprehension translations into ML to optimize base case
nipkow
parents:
24471
diff
changeset
|
356 |
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
|
357 |
\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
|
358 |
%\item[local bindings] @ {text"let x = e"}. |
24349 | 359 |
\end{description} |
23240 | 360 |
|
24476
f7ad9fbbeeaa
turned list comprehension translations into ML to optimize base case
nipkow
parents:
24471
diff
changeset
|
361 |
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
|
362 |
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
|
363 |
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
|
364 |
optmized to @{term"map (%x. e) xs"}. |
23240 | 365 |
|
24349 | 366 |
It is easy to write short list comprehensions which stand for complex |
367 |
expressions. During proofs, they may become unreadable (and |
|
368 |
mangled). In such cases it can be advisable to introduce separate |
|
369 |
definitions for the list comprehensions in question. *} |
|
370 |
||
46138
85f8d8a8c711
improved list comprehension syntax: more careful treatment of position constraints, which enables PIDE markup;
wenzelm
parents:
46133
diff
changeset
|
371 |
nonterminal lc_qual and lc_quals |
23192 | 372 |
|
373 |
syntax |
|
46138
85f8d8a8c711
improved list comprehension syntax: more careful treatment of position constraints, which enables PIDE markup;
wenzelm
parents:
46133
diff
changeset
|
374 |
"_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
|
375 |
"_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
|
376 |
"_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
|
377 |
(*"_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
|
378 |
"_lc_end" :: "lc_quals" ("]") |
85f8d8a8c711
improved list comprehension syntax: more careful treatment of position constraints, which enables PIDE markup;
wenzelm
parents:
46133
diff
changeset
|
379 |
"_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
|
380 |
"_lc_abs" :: "'a => 'b list => 'b list" |
23192 | 381 |
|
24476
f7ad9fbbeeaa
turned list comprehension translations into ML to optimize base case
nipkow
parents:
24471
diff
changeset
|
382 |
(* 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
|
383 |
translation of [e. p<-xs] |
23192 | 384 |
translations |
46138
85f8d8a8c711
improved list comprehension syntax: more careful treatment of position constraints, which enables PIDE markup;
wenzelm
parents:
46133
diff
changeset
|
385 |
"[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
|
386 |
"_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
|
387 |
=> "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
|
388 |
"[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
|
389 |
"_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
|
390 |
=> "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
|
391 |
"_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
|
392 |
=> "_Let b (_listcompr e Q Qs)" |
24476
f7ad9fbbeeaa
turned list comprehension translations into ML to optimize base case
nipkow
parents:
24471
diff
changeset
|
393 |
*) |
23240 | 394 |
|
23279
e39dd93161d9
tuned list comprehension, changed filter syntax from : to <-
nipkow
parents:
23246
diff
changeset
|
395 |
syntax (xsymbols) |
46138
85f8d8a8c711
improved list comprehension syntax: more careful treatment of position constraints, which enables PIDE markup;
wenzelm
parents:
46133
diff
changeset
|
396 |
"_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
|
397 |
syntax (HTML output) |
46138
85f8d8a8c711
improved list comprehension syntax: more careful treatment of position constraints, which enables PIDE markup;
wenzelm
parents:
46133
diff
changeset
|
398 |
"_lc_gen" :: "'a \<Rightarrow> 'a list \<Rightarrow> lc_qual" ("_ \<leftarrow> _") |
24349 | 399 |
|
52143 | 400 |
parse_translation {* |
46138
85f8d8a8c711
improved list comprehension syntax: more careful treatment of position constraints, which enables PIDE markup;
wenzelm
parents:
46133
diff
changeset
|
401 |
let |
85f8d8a8c711
improved list comprehension syntax: more careful treatment of position constraints, which enables PIDE markup;
wenzelm
parents:
46133
diff
changeset
|
402 |
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
|
403 |
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
|
404 |
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
|
405 |
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
|
406 |
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
|
407 |
|
85f8d8a8c711
improved list comprehension syntax: more careful treatment of position constraints, which enables PIDE markup;
wenzelm
parents:
46133
diff
changeset
|
408 |
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
|
409 |
|
85f8d8a8c711
improved list comprehension syntax: more careful treatment of position constraints, which enables PIDE markup;
wenzelm
parents:
46133
diff
changeset
|
410 |
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
|
411 |
let |
85f8d8a8c711
improved list comprehension syntax: more careful treatment of position constraints, which enables PIDE markup;
wenzelm
parents:
46133
diff
changeset
|
412 |
(* FIXME proper name context!? *) |
85f8d8a8c711
improved list comprehension syntax: more careful treatment of position constraints, which enables PIDE markup;
wenzelm
parents:
46133
diff
changeset
|
413 |
val x = |
85f8d8a8c711
improved list comprehension syntax: more careful treatment of position constraints, which enables PIDE markup;
wenzelm
parents:
46133
diff
changeset
|
414 |
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
|
415 |
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
|
416 |
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
|
417 |
val case2 = |
85f8d8a8c711
improved list comprehension syntax: more careful treatment of position constraints, which enables PIDE markup;
wenzelm
parents:
46133
diff
changeset
|
418 |
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
|
419 |
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
|
420 |
val cs = Syntax.const @{syntax_const "_case2"} $ case1 $ case2; |
51678
1e33b81c328a
allow redundant cases in the list comprehension translation
traytel
parents:
51673
diff
changeset
|
421 |
in Syntax_Trans.abs_tr [x, Case_Translation.case_tr false ctxt [x, cs]] end; |
46138
85f8d8a8c711
improved list comprehension syntax: more careful treatment of position constraints, which enables PIDE markup;
wenzelm
parents:
46133
diff
changeset
|
422 |
|
85f8d8a8c711
improved list comprehension syntax: more careful treatment of position constraints, which enables PIDE markup;
wenzelm
parents:
46133
diff
changeset
|
423 |
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
|
424 |
(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
|
425 |
Free (s, T) => |
85f8d8a8c711
improved list comprehension syntax: more careful treatment of position constraints, which enables PIDE markup;
wenzelm
parents:
46133
diff
changeset
|
426 |
let |
85f8d8a8c711
improved list comprehension syntax: more careful treatment of position constraints, which enables PIDE markup;
wenzelm
parents:
46133
diff
changeset
|
427 |
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
|
428 |
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
|
429 |
in |
85f8d8a8c711
improved list comprehension syntax: more careful treatment of position constraints, which enables PIDE markup;
wenzelm
parents:
46133
diff
changeset
|
430 |
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
|
431 |
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
|
432 |
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
|
433 |
end |
85f8d8a8c711
improved list comprehension syntax: more careful treatment of position constraints, which enables PIDE markup;
wenzelm
parents:
46133
diff
changeset
|
434 |
| _ => (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
|
435 |
|
85f8d8a8c711
improved list comprehension syntax: more careful treatment of position constraints, which enables PIDE markup;
wenzelm
parents:
46133
diff
changeset
|
436 |
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
|
437 |
let |
85f8d8a8c711
improved list comprehension syntax: more careful treatment of position constraints, which enables PIDE markup;
wenzelm
parents:
46133
diff
changeset
|
438 |
val res = |
85f8d8a8c711
improved list comprehension syntax: more careful treatment of position constraints, which enables PIDE markup;
wenzelm
parents:
46133
diff
changeset
|
439 |
(case qs of |
85f8d8a8c711
improved list comprehension syntax: more careful treatment of position constraints, which enables PIDE markup;
wenzelm
parents:
46133
diff
changeset
|
440 |
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
|
441 |
| 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
|
442 |
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
|
443 |
| lc_tr ctxt |
85f8d8a8c711
improved list comprehension syntax: more careful treatment of position constraints, which enables PIDE markup;
wenzelm
parents:
46133
diff
changeset
|
444 |
[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
|
445 |
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
|
446 |
(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
|
447 |
(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
|
448 |
| (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
|
449 |
| lc_tr ctxt |
85f8d8a8c711
improved list comprehension syntax: more careful treatment of position constraints, which enables PIDE markup;
wenzelm
parents:
46133
diff
changeset
|
450 |
[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
|
451 |
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
|
452 |
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
|
453 |
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
|
454 |
|
85f8d8a8c711
improved list comprehension syntax: more careful treatment of position constraints, which enables PIDE markup;
wenzelm
parents:
46133
diff
changeset
|
455 |
in [(@{syntax_const "_listcompr"}, lc_tr)] end |
24349 | 456 |
*} |
23279
e39dd93161d9
tuned list comprehension, changed filter syntax from : to <-
nipkow
parents:
23246
diff
changeset
|
457 |
|
51272 | 458 |
ML_val {* |
42167 | 459 |
let |
460 |
val read = Syntax.read_term @{context}; |
|
461 |
fun check s1 s2 = read s1 aconv read s2 orelse error ("Check failed: " ^ quote s1); |
|
462 |
in |
|
463 |
check "[(x,y,z). b]" "if b then [(x, y, z)] else []"; |
|
464 |
check "[(x,y,z). x\<leftarrow>xs]" "map (\<lambda>x. (x, y, z)) xs"; |
|
465 |
check "[e x y. x\<leftarrow>xs, y\<leftarrow>ys]" "concat (map (\<lambda>x. map (\<lambda>y. e x y) ys) xs)"; |
|
466 |
check "[(x,y,z). x<a, x>b]" "if x < a then if b < x then [(x, y, z)] else [] else []"; |
|
467 |
check "[(x,y,z). x\<leftarrow>xs, x>b]" "concat (map (\<lambda>x. if b < x then [(x, y, z)] else []) xs)"; |
|
468 |
check "[(x,y,z). x<a, x\<leftarrow>xs]" "if x < a then map (\<lambda>x. (x, y, z)) xs else []"; |
|
469 |
check "[(x,y). Cons True x \<leftarrow> xs]" |
|
470 |
"concat (map (\<lambda>xa. case xa of [] \<Rightarrow> [] | True # x \<Rightarrow> [(x, y)] | False # x \<Rightarrow> []) xs)"; |
|
471 |
check "[(x,y,z). Cons x [] \<leftarrow> xs]" |
|
472 |
"concat (map (\<lambda>xa. case xa of [] \<Rightarrow> [] | [x] \<Rightarrow> [(x, y, z)] | x # aa # lista \<Rightarrow> []) xs)"; |
|
473 |
check "[(x,y,z). x<a, x>b, x=d]" |
|
474 |
"if x < a then if b < x then if x = d then [(x, y, z)] else [] else [] else []"; |
|
475 |
check "[(x,y,z). x<a, x>b, y\<leftarrow>ys]" |
|
476 |
"if x < a then if b < x then map (\<lambda>y. (x, y, z)) ys else [] else []"; |
|
477 |
check "[(x,y,z). x<a, x\<leftarrow>xs,y>b]" |
|
478 |
"if x < a then concat (map (\<lambda>x. if b < y then [(x, y, z)] else []) xs) else []"; |
|
479 |
check "[(x,y,z). x<a, x\<leftarrow>xs, y\<leftarrow>ys]" |
|
480 |
"if x < a then concat (map (\<lambda>x. map (\<lambda>y. (x, y, z)) ys) xs) else []"; |
|
481 |
check "[(x,y,z). x\<leftarrow>xs, x>b, y<a]" |
|
482 |
"concat (map (\<lambda>x. if b < x then if y < a then [(x, y, z)] else [] else []) xs)"; |
|
483 |
check "[(x,y,z). x\<leftarrow>xs, x>b, y\<leftarrow>ys]" |
|
484 |
"concat (map (\<lambda>x. if b < x then map (\<lambda>y. (x, y, z)) ys else []) xs)"; |
|
485 |
check "[(x,y,z). x\<leftarrow>xs, y\<leftarrow>ys,y>x]" |
|
486 |
"concat (map (\<lambda>x. concat (map (\<lambda>y. if x < y then [(x, y, z)] else []) ys)) xs)"; |
|
487 |
check "[(x,y,z). x\<leftarrow>xs, y\<leftarrow>ys,z\<leftarrow>zs]" |
|
488 |
"concat (map (\<lambda>x. concat (map (\<lambda>y. map (\<lambda>z. (x, y, z)) zs) ys)) xs)" |
|
489 |
end; |
|
490 |
*} |
|
491 |
||
35115 | 492 |
(* |
24349 | 493 |
term "[(x,y). x\<leftarrow>xs, let xx = x+x, y\<leftarrow>ys, y \<noteq> xx]" |
23192 | 494 |
*) |
495 |
||
42167 | 496 |
|
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
|
497 |
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
|
498 |
(* 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
|
499 |
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
|
500 |
|
ee729dbd1b7f
avoid ML_file in large theory files to improve performance of dependency 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 |
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
|
502 |
sig |
51717
9e7d1c139569
simplifier uses proper Proof.context instead of historic type simpset;
wenzelm
parents:
51678
diff
changeset
|
503 |
val simproc : Proof.context -> cterm -> thm option |
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
|
504 |
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
|
505 |
|
ee729dbd1b7f
avoid ML_file in large theory files to improve performance of dependency 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 |
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
|
507 |
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
|
508 |
|
ee729dbd1b7f
avoid ML_file in large theory files to improve performance of dependency 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 |
(* 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
|
510 |
|
ee729dbd1b7f
avoid ML_file in large theory files to improve performance of dependency 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 |
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
|
512 |
(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
|
513 |
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
|
514 |
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
|
515 |
| _ => 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
|
516 |
|
ee729dbd1b7f
avoid ML_file in large theory files to improve performance of dependency 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 |
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
|
518 |
(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
|
519 |
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
|
520 |
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
|
521 |
| _ => 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
|
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 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
|
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 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
|
526 |
| _ => 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
|
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 |
51315
536a5603a138
provide common HOLogic.conj_conv and HOLogic.eq_conv;
wenzelm
parents:
51314
diff
changeset
|
532 |
(rewr_conv' @{thm conj_assoc} then_conv HOLogic.conj_conv Conv.all_conv conjunct_assoc_conv) ct |
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
|
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 = |
51315
536a5603a138
provide common HOLogic.conj_conv and HOLogic.eq_conv;
wenzelm
parents:
51314
diff
changeset
|
535 |
HOLogic.Trueprop_conv (HOLogic.eq_conv Conv.all_conv |
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
|
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 |
|
51717
9e7d1c139569
simplifier uses proper Proof.context instead of historic type simpset;
wenzelm
parents:
51678
diff
changeset
|
543 |
fun simproc ctxt redex = |
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
|
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 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
|
546 |
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
|
547 |
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
|
548 |
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
|
549 |
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
|
550 |
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
|
551 |
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
|
552 |
$ 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
|
553 |
| 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
|
554 |
(* 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
|
555 |
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
|
556 |
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
|
557 |
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
|
558 |
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
|
559 |
(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
|
560 |
(Const (@{const_name List.Nil}, _)) => s |
53412
01b804df0a30
list_to_set_comprehension: don't crash in case distinctions on datatypes with even number of constructors
traytel
parents:
53374
diff
changeset
|
561 |
| _ => (case s of SOME NONE => SOME (SOME i) | _ => NONE)) |
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
|
562 |
in |
53412
01b804df0a30
list_to_set_comprehension: don't crash in case distinctions on datatypes with even number of constructors
traytel
parents:
53374
diff
changeset
|
563 |
fold_index check cases (SOME NONE) |> the_default NONE |
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
|
564 |
end |
54404
9f0f1152c875
port list comprehension simproc to 'Ctr_Sugar' abstraction
blanchet
parents:
54295
diff
changeset
|
565 |
(* returns (case_expr type index chosen_case constr_name) option *) |
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
|
566 |
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
|
567 |
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
|
568 |
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
|
569 |
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
|
570 |
(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
|
571 |
SOME (c, T) => |
54404
9f0f1152c875
port list comprehension simproc to 'Ctr_Sugar' abstraction
blanchet
parents:
54295
diff
changeset
|
572 |
(case Ctr_Sugar.ctr_sugar_of_case ctxt c of |
9f0f1152c875
port list comprehension simproc to 'Ctr_Sugar' abstraction
blanchet
parents:
54295
diff
changeset
|
573 |
SOME {ctrs, ...} => |
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
|
574 |
(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
|
575 |
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
|
576 |
let |
54404
9f0f1152c875
port list comprehension simproc to 'Ctr_Sugar' abstraction
blanchet
parents:
54295
diff
changeset
|
577 |
val constr_names = map (fst o dest_Const) ctrs |
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
|
578 |
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
|
579 |
val T' = List.last Ts |
54404
9f0f1152c875
port list comprehension simproc to 'Ctr_Sugar' abstraction
blanchet
parents:
54295
diff
changeset
|
580 |
in SOME (List.last args, T', i, nth args i, nth constr_names i) end |
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
|
581 |
| 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
|
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 |
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
|
585 |
(* 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
|
586 |
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
|
587 |
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
|
588 |
| 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
|
589 |
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
|
590 |
| 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
|
591 |
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
|
592 |
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
|
593 |
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
|
594 |
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
|
595 |
CONVERSION (right_hand_set_comprehension_conv (K |
51315
536a5603a138
provide common HOLogic.conj_conv and HOLogic.eq_conv;
wenzelm
parents:
51314
diff
changeset
|
596 |
(HOLogic.conj_conv (Conv.rewr_conv (List.last prems RS @{thm Eq_TrueI})) Conv.all_conv |
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
|
597 |
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
|
598 |
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
|
599 |
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
|
600 |
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
|
601 |
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
|
602 |
CONVERSION (right_hand_set_comprehension_conv (K |
51315
536a5603a138
provide common HOLogic.conj_conv and HOLogic.eq_conv;
wenzelm
parents:
51314
diff
changeset
|
603 |
(HOLogic.conj_conv (Conv.rewr_conv (List.last prems RS @{thm Eq_FalseI})) Conv.all_conv |
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
|
604 |
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
|
605 |
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
|
606 |
| 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
|
607 |
let |
54404
9f0f1152c875
port list comprehension simproc to 'Ctr_Sugar' abstraction
blanchet
parents:
54295
diff
changeset
|
608 |
val SOME {injects, distincts, case_thms, split, ...} = |
9f0f1152c875
port list comprehension simproc to 'Ctr_Sugar' abstraction
blanchet
parents:
54295
diff
changeset
|
609 |
Ctr_Sugar.ctr_sugar_of ctxt (fst (dest_Type T)) |
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
|
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 *) |
54404
9f0f1152c875
port list comprehension simproc to 'Ctr_Sugar' abstraction
blanchet
parents:
54295
diff
changeset
|
612 |
Splitter.split_tac [split] 1 |
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
|
613 |
THEN EVERY (map_index (fn (i', _) => |
54404
9f0f1152c875
port list comprehension simproc to 'Ctr_Sugar' abstraction
blanchet
parents:
54295
diff
changeset
|
614 |
(if i' < length case_thms - 1 then rtac @{thm conjI} 1 else all_tac) |
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
|
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 |
51315
536a5603a138
provide common HOLogic.conj_conv and HOLogic.eq_conv;
wenzelm
parents:
51314
diff
changeset
|
621 |
((HOLogic.conj_conv |
536a5603a138
provide common HOLogic.conj_conv and HOLogic.eq_conv;
wenzelm
parents:
51314
diff
changeset
|
622 |
(HOLogic.eq_conv Conv.all_conv (rewr_conv' (List.last prems)) then_conv |
54404
9f0f1152c875
port list comprehension simproc to 'Ctr_Sugar' abstraction
blanchet
parents:
54295
diff
changeset
|
623 |
(Conv.try_conv (Conv.rewrs_conv (map mk_meta_eq injects)))) |
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
|
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 |
51315
536a5603a138
provide common HOLogic.conj_conv and HOLogic.eq_conv;
wenzelm
parents:
51314
diff
changeset
|
627 |
then_conv (HOLogic.Trueprop_conv (HOLogic.eq_conv Conv.all_conv (Collect_conv (fn (_, ctxt) => |
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
|
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 |
51315
536a5603a138
provide common HOLogic.conj_conv and HOLogic.eq_conv;
wenzelm
parents:
51314
diff
changeset
|
637 |
(HOLogic.conj_conv |
536a5603a138
provide common HOLogic.conj_conv and HOLogic.eq_conv;
wenzelm
parents:
51314
diff
changeset
|
638 |
((HOLogic.eq_conv Conv.all_conv |
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
|
639 |
(rewr_conv' (List.last prems))) then_conv |
54404
9f0f1152c875
port list comprehension simproc to 'Ctr_Sugar' abstraction
blanchet
parents:
54295
diff
changeset
|
640 |
(Conv.rewrs_conv (map (fn th => th RS @{thm Eq_FalseI}) distincts))) |
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
|
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 |
51314
eac4bb5adbf9
just one HOLogic.Trueprop_conv, with regular exception CTERM;
wenzelm
parents:
51272
diff
changeset
|
643 |
HOLogic.Trueprop_conv |
51315
536a5603a138
provide common HOLogic.conj_conv and HOLogic.eq_conv;
wenzelm
parents:
51314
diff
changeset
|
644 |
(HOLogic.eq_conv Conv.all_conv |
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
|
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 |
54404
9f0f1152c875
port list comprehension simproc to 'Ctr_Sugar' abstraction
blanchet
parents:
54295
diff
changeset
|
650 |
THEN rtac set_Nil_I 1)) case_thms) |
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
|
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 |
54404
9f0f1152c875
port list comprehension simproc to 'Ctr_Sugar' abstraction
blanchet
parents:
54295
diff
changeset
|
654 |
SOME (x, T, i, cont, constr_name) => |
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
|
655 |
let |
52131 | 656 |
val (vs, body) = strip_abs (Envir.eta_long (map snd bound_vs) cont) |
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
|
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_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
|
660 |
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
|
661 |
(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
|
662 |
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
|
663 |
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
|
664 |
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
|
665 |
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
|
666 |
| 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
|
667 |
(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
|
668 |
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
|
669 |
| 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
|
670 |
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
|
671 |
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
|
672 |
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
|
673 |
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
|
674 |
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
|
675 |
(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
|
676 |
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
|
677 |
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
|
678 |
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
|
679 |
| 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
|
680 |
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
|
681 |
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
|
682 |
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
|
683 |
((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
|
684 |
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
|
685 |
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
|
686 |
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
|
687 |
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
|
688 |
(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
|
689 |
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
|
690 |
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
|
691 |
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
|
692 |
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
|
693 |
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
|
694 |
((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
|
695 |
(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
|
696 |
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
|
697 |
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
|
698 |
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
|
699 |
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
|
700 |
|
ee729dbd1b7f
avoid ML_file in large theory files to improve performance of dependency 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 |
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
|
702 |
*} |
41463
edbf0a86fb1c
adding simproc to rewrite list comprehensions to set comprehensions; adopting proofs
bulwahn
parents:
41372
diff
changeset
|
703 |
|
edbf0a86fb1c
adding simproc to rewrite list comprehensions to set comprehensions; adopting proofs
bulwahn
parents:
41372
diff
changeset
|
704 |
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
|
705 |
|
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
|
706 |
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
|
707 |
|
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 |
hide_const (open) coset |
35115 | 709 |
|
49948
744934b818c7
moved quite generic material from theory Enum to more appropriate places
haftmann
parents:
49808
diff
changeset
|
710 |
|
21061
580dfc999ef6
added normal post setup; cleaned up "execution" constants
haftmann
parents:
21046
diff
changeset
|
711 |
subsubsection {* @{const Nil} and @{const Cons} *} |
580dfc999ef6
added normal post setup; cleaned up "execution" constants
haftmann
parents:
21046
diff
changeset
|
712 |
|
580dfc999ef6
added normal post setup; cleaned up "execution" constants
haftmann
parents:
21046
diff
changeset
|
713 |
lemma not_Cons_self [simp]: |
580dfc999ef6
added normal post setup; cleaned up "execution" constants
haftmann
parents:
21046
diff
changeset
|
714 |
"xs \<noteq> x # xs" |
13145 | 715 |
by (induct xs) auto |
13114 | 716 |
|
41697 | 717 |
lemma not_Cons_self2 [simp]: |
718 |
"x # xs \<noteq> xs" |
|
719 |
by (rule not_Cons_self [symmetric]) |
|
13114 | 720 |
|
13142 | 721 |
lemma neq_Nil_conv: "(xs \<noteq> []) = (\<exists>y ys. xs = y # ys)" |
13145 | 722 |
by (induct xs) auto |
13114 | 723 |
|
53689 | 724 |
lemma tl_Nil: "tl xs = [] \<longleftrightarrow> xs = [] \<or> (EX x. xs = [x])" |
725 |
by (cases xs) auto |
|
726 |
||
727 |
lemma Nil_tl: "[] = tl xs \<longleftrightarrow> xs = [] \<or> (EX x. xs = [x])" |
|
728 |
by (cases xs) auto |
|
729 |
||
13142 | 730 |
lemma length_induct: |
21061
580dfc999ef6
added normal post setup; cleaned up "execution" constants
haftmann
parents:
21046
diff
changeset
|
731 |
"(\<And>xs. \<forall>ys. length ys < length xs \<longrightarrow> P ys \<Longrightarrow> P xs) \<Longrightarrow> P xs" |
53689 | 732 |
by (fact measure_induct) |
13114 | 733 |
|
37289 | 734 |
lemma list_nonempty_induct [consumes 1, case_names single cons]: |
735 |
assumes "xs \<noteq> []" |
|
736 |
assumes single: "\<And>x. P [x]" |
|
737 |
assumes cons: "\<And>x xs. xs \<noteq> [] \<Longrightarrow> P xs \<Longrightarrow> P (x # xs)" |
|
738 |
shows "P xs" |
|
739 |
using `xs \<noteq> []` proof (induct xs) |
|
740 |
case Nil then show ?case by simp |
|
741 |
next |
|
53374
a14d2a854c02
tuned proofs -- clarified flow of facts wrt. calculation;
wenzelm
parents:
53017
diff
changeset
|
742 |
case (Cons x xs) |
a14d2a854c02
tuned proofs -- clarified flow of facts wrt. calculation;
wenzelm
parents:
53017
diff
changeset
|
743 |
show ?case |
a14d2a854c02
tuned proofs -- clarified flow of facts wrt. calculation;
wenzelm
parents:
53017
diff
changeset
|
744 |
proof (cases xs) |
a14d2a854c02
tuned proofs -- clarified flow of facts wrt. calculation;
wenzelm
parents:
53017
diff
changeset
|
745 |
case Nil |
a14d2a854c02
tuned proofs -- clarified flow of facts wrt. calculation;
wenzelm
parents:
53017
diff
changeset
|
746 |
with single show ?thesis by simp |
37289 | 747 |
next |
53374
a14d2a854c02
tuned proofs -- clarified flow of facts wrt. calculation;
wenzelm
parents:
53017
diff
changeset
|
748 |
case Cons |
a14d2a854c02
tuned proofs -- clarified flow of facts wrt. calculation;
wenzelm
parents:
53017
diff
changeset
|
749 |
show ?thesis |
a14d2a854c02
tuned proofs -- clarified flow of facts wrt. calculation;
wenzelm
parents:
53017
diff
changeset
|
750 |
proof (rule cons) |
a14d2a854c02
tuned proofs -- clarified flow of facts wrt. calculation;
wenzelm
parents:
53017
diff
changeset
|
751 |
from Cons show "xs \<noteq> []" by simp |
a14d2a854c02
tuned proofs -- clarified flow of facts wrt. calculation;
wenzelm
parents:
53017
diff
changeset
|
752 |
with Cons.hyps show "P xs" . |
a14d2a854c02
tuned proofs -- clarified flow of facts wrt. calculation;
wenzelm
parents:
53017
diff
changeset
|
753 |
qed |
37289 | 754 |
qed |
755 |
qed |
|
756 |
||
45714 | 757 |
lemma inj_split_Cons: "inj_on (\<lambda>(xs, n). n#xs) X" |
758 |
by (auto intro!: inj_onI) |
|
13114 | 759 |
|
49948
744934b818c7
moved quite generic material from theory Enum to more appropriate places
haftmann
parents:
49808
diff
changeset
|
760 |
|
21061
580dfc999ef6
added normal post setup; cleaned up "execution" constants
haftmann
parents:
21046
diff
changeset
|
761 |
subsubsection {* @{const length} *} |
13114 | 762 |
|
13142 | 763 |
text {* |
21061
580dfc999ef6
added normal post setup; cleaned up "execution" constants
haftmann
parents:
21046
diff
changeset
|
764 |
Needs to come before @{text "@"} because of theorem @{text |
580dfc999ef6
added normal post setup; cleaned up "execution" constants
haftmann
parents:
21046
diff
changeset
|
765 |
append_eq_append_conv}. |
13142 | 766 |
*} |
13114 | 767 |
|
13142 | 768 |
lemma length_append [simp]: "length (xs @ ys) = length xs + length ys" |
13145 | 769 |
by (induct xs) auto |
13114 | 770 |
|
13142 | 771 |
lemma length_map [simp]: "length (map f xs) = length xs" |
13145 | 772 |
by (induct xs) auto |
13114 | 773 |
|
13142 | 774 |
lemma length_rev [simp]: "length (rev xs) = length xs" |
13145 | 775 |
by (induct xs) auto |
13114 | 776 |
|
13142 | 777 |
lemma length_tl [simp]: "length (tl xs) = length xs - 1" |
13145 | 778 |
by (cases xs) auto |
13114 | 779 |
|
13142 | 780 |
lemma length_0_conv [iff]: "(length xs = 0) = (xs = [])" |
13145 | 781 |
by (induct xs) auto |
13114 | 782 |
|
13142 | 783 |
lemma length_greater_0_conv [iff]: "(0 < length xs) = (xs \<noteq> [])" |
13145 | 784 |
by (induct xs) auto |
13114 | 785 |
|
23479 | 786 |
lemma length_pos_if_in_set: "x : set xs \<Longrightarrow> length xs > 0" |
787 |
by auto |
|
788 |
||
13114 | 789 |
lemma length_Suc_conv: |
13145 | 790 |
"(length xs = Suc n) = (\<exists>y ys. xs = y # ys \<and> length ys = n)" |
791 |
by (induct xs) auto |
|
13142 | 792 |
|
14025 | 793 |
lemma Suc_length_conv: |
794 |
"(Suc n = length xs) = (\<exists>y ys. xs = y # ys \<and> length ys = n)" |
|
14208 | 795 |
apply (induct xs, simp, simp) |
14025 | 796 |
apply blast |
797 |
done |
|
798 |
||
25221
5ded95dda5df
append/member: more light-weight way to declare authentic syntax;
wenzelm
parents:
25215
diff
changeset
|
799 |
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
|
800 |
by (induct xs) auto |
5ded95dda5df
append/member: more light-weight way to declare authentic syntax;
wenzelm
parents:
25215
diff
changeset
|
801 |
|
26442
57fb6a8b099e
restructuring; explicit case names for rule list_induct2
haftmann
parents:
26300
diff
changeset
|
802 |
lemma list_induct2 [consumes 1, case_names Nil Cons]: |
57fb6a8b099e
restructuring; explicit case names for rule list_induct2
haftmann
parents:
26300
diff
changeset
|
803 |
"length xs = length ys \<Longrightarrow> P [] [] \<Longrightarrow> |
57fb6a8b099e
restructuring; explicit case names for rule list_induct2
haftmann
parents:
26300
diff
changeset
|
804 |
(\<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
|
805 |
\<Longrightarrow> P xs ys" |
57fb6a8b099e
restructuring; explicit case names for rule list_induct2
haftmann
parents:
26300
diff
changeset
|
806 |
proof (induct xs arbitrary: ys) |
57fb6a8b099e
restructuring; explicit case names for rule list_induct2
haftmann
parents:
26300
diff
changeset
|
807 |
case Nil then show ?case by simp |
57fb6a8b099e
restructuring; explicit case names for rule list_induct2
haftmann
parents:
26300
diff
changeset
|
808 |
next |
57fb6a8b099e
restructuring; explicit case names for rule list_induct2
haftmann
parents:
26300
diff
changeset
|
809 |
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
|
810 |
qed |
57fb6a8b099e
restructuring; explicit case names for rule list_induct2
haftmann
parents:
26300
diff
changeset
|
811 |
|
57fb6a8b099e
restructuring; explicit case names for rule list_induct2
haftmann
parents:
26300
diff
changeset
|
812 |
lemma list_induct3 [consumes 2, case_names Nil Cons]: |
57fb6a8b099e
restructuring; explicit case names for rule list_induct2
haftmann
parents:
26300
diff
changeset
|
813 |
"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
|
814 |
(\<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
|
815 |
\<Longrightarrow> P xs ys zs" |
57fb6a8b099e
restructuring; explicit case names for rule list_induct2
haftmann
parents:
26300
diff
changeset
|
816 |
proof (induct xs arbitrary: ys zs) |
57fb6a8b099e
restructuring; explicit case names for rule list_induct2
haftmann
parents:
26300
diff
changeset
|
817 |
case Nil then show ?case by simp |
57fb6a8b099e
restructuring; explicit case names for rule list_induct2
haftmann
parents:
26300
diff
changeset
|
818 |
next |
57fb6a8b099e
restructuring; explicit case names for rule list_induct2
haftmann
parents:
26300
diff
changeset
|
819 |
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
|
820 |
(cases zs, simp_all) |
57fb6a8b099e
restructuring; explicit case names for rule list_induct2
haftmann
parents:
26300
diff
changeset
|
821 |
qed |
13114 | 822 |
|
36154
11c6106d7787
Respectfullness and preservation of list_rel
Cezary Kaliszyk <kaliszyk@in.tum.de>
parents:
35828
diff
changeset
|
823 |
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
|
824 |
"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
|
825 |
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
|
826 |
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
|
827 |
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
|
828 |
proof (induct xs arbitrary: ys zs ws) |
11c6106d7787
Respectfullness and preservation of list_rel
Cezary Kaliszyk <kaliszyk@in.tum.de>
parents:
35828
diff
changeset
|
829 |
case Nil then show ?case by simp |
11c6106d7787
Respectfullness and preservation of list_rel
Cezary Kaliszyk <kaliszyk@in.tum.de>
parents:
35828
diff
changeset
|
830 |
next |
11c6106d7787
Respectfullness and preservation of list_rel
Cezary Kaliszyk <kaliszyk@in.tum.de>
parents:
35828
diff
changeset
|
831 |
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
|
832 |
qed |
11c6106d7787
Respectfullness and preservation of list_rel
Cezary Kaliszyk <kaliszyk@in.tum.de>
parents:
35828
diff
changeset
|
833 |
|
22493
db930e490fe5
added another rule for simultaneous induction, and lemmas for zip
krauss
parents:
22422
diff
changeset
|
834 |
lemma list_induct2': |
db930e490fe5
added another rule for simultaneous induction, and lemmas for zip
krauss
parents:
22422
diff
changeset
|
835 |
"\<lbrakk> P [] []; |
db930e490fe5
added another rule for simultaneous induction, and lemmas for zip
krauss
parents:
22422
diff
changeset
|
836 |
\<And>x xs. P (x#xs) []; |
db930e490fe5
added another rule for simultaneous induction, and lemmas for zip
krauss
parents:
22422
diff
changeset
|
837 |
\<And>y ys. P [] (y#ys); |
db930e490fe5
added another rule for simultaneous induction, and lemmas for zip
krauss
parents:
22422
diff
changeset
|
838 |
\<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
|
839 |
\<Longrightarrow> P xs ys" |
db930e490fe5
added another rule for simultaneous induction, and lemmas for zip
krauss
parents:
22422
diff
changeset
|
840 |
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
|
841 |
|
22143
cf58486ca11b
Added simproc list_neq (prompted by an application)
nipkow
parents:
21911
diff
changeset
|
842 |
lemma neq_if_length_neq: "length xs \<noteq> length ys \<Longrightarrow> (xs = ys) == False" |
24349 | 843 |
by (rule Eq_FalseI) auto |
24037 | 844 |
|
845 |
simproc_setup list_neq ("(xs::'a list) = ys") = {* |
|
22143
cf58486ca11b
Added simproc list_neq (prompted by an application)
nipkow
parents:
21911
diff
changeset
|
846 |
(* |
cf58486ca11b
Added simproc list_neq (prompted by an application)
nipkow
parents:
21911
diff
changeset
|
847 |
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
|
848 |
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
|
849 |
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
|
850 |
*) |
24037 | 851 |
|
852 |
let |
|
22143
cf58486ca11b
Added simproc list_neq (prompted by an application)
nipkow
parents:
21911
diff
changeset
|
853 |
|
29856 | 854 |
fun len (Const(@{const_name Nil},_)) acc = acc |
855 |
| len (Const(@{const_name Cons},_) $ _ $ xs) (ts,n) = len xs (ts,n+1) |
|
856 |
| len (Const(@{const_name append},_) $ xs $ ys) acc = len xs (len ys acc) |
|
857 |
| len (Const(@{const_name rev},_) $ xs) acc = len xs acc |
|
858 |
| 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
|
859 |
| len t (ts,n) = (t::ts,n); |
cf58486ca11b
Added simproc list_neq (prompted by an application)
nipkow
parents:
21911
diff
changeset
|
860 |
|
51717
9e7d1c139569
simplifier uses proper Proof.context instead of historic type simpset;
wenzelm
parents:
51678
diff
changeset
|
861 |
val ss = simpset_of @{context}; |
9e7d1c139569
simplifier uses proper Proof.context instead of historic type simpset;
wenzelm
parents:
51678
diff
changeset
|
862 |
|
9e7d1c139569
simplifier uses proper Proof.context instead of historic type simpset;
wenzelm
parents:
51678
diff
changeset
|
863 |
fun list_neq ctxt ct = |
22143
cf58486ca11b
Added simproc list_neq (prompted by an application)
nipkow
parents:
21911
diff
changeset
|
864 |
let |
24037 | 865 |
val (Const(_,eqT) $ lhs $ rhs) = Thm.term_of ct; |
22143
cf58486ca11b
Added simproc list_neq (prompted by an application)
nipkow
parents:
21911
diff
changeset
|
866 |
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
|
867 |
fun prove_neq() = |
cf58486ca11b
Added simproc list_neq (prompted by an application)
nipkow
parents:
21911
diff
changeset
|
868 |
let |
cf58486ca11b
Added simproc list_neq (prompted by an application)
nipkow
parents:
21911
diff
changeset
|
869 |
val Type(_,listT::_) = eqT; |
22994 | 870 |
val size = HOLogic.size_const listT; |
22143
cf58486ca11b
Added simproc list_neq (prompted by an application)
nipkow
parents:
21911
diff
changeset
|
871 |
val eq_len = HOLogic.mk_eq (size $ lhs, size $ rhs); |
cf58486ca11b
Added simproc list_neq (prompted by an application)
nipkow
parents:
21911
diff
changeset
|
872 |
val neq_len = HOLogic.mk_Trueprop (HOLogic.Not $ eq_len); |
51717
9e7d1c139569
simplifier uses proper Proof.context instead of historic type simpset;
wenzelm
parents:
51678
diff
changeset
|
873 |
val thm = Goal.prove ctxt [] [] neq_len |
9e7d1c139569
simplifier uses proper Proof.context instead of historic type simpset;
wenzelm
parents:
51678
diff
changeset
|
874 |
(K (simp_tac (put_simpset ss ctxt) 1)); |
22633 | 875 |
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
|
876 |
in |
23214 | 877 |
if m < n andalso submultiset (op aconv) (ls,rs) orelse |
878 |
n < m andalso submultiset (op aconv) (rs,ls) |
|
22143
cf58486ca11b
Added simproc list_neq (prompted by an application)
nipkow
parents:
21911
diff
changeset
|
879 |
then prove_neq() else NONE |
cf58486ca11b
Added simproc list_neq (prompted by an application)
nipkow
parents:
21911
diff
changeset
|
880 |
end; |
51717
9e7d1c139569
simplifier uses proper Proof.context instead of historic type simpset;
wenzelm
parents:
51678
diff
changeset
|
881 |
in K list_neq end; |
22143
cf58486ca11b
Added simproc list_neq (prompted by an application)
nipkow
parents:
21911
diff
changeset
|
882 |
*} |
cf58486ca11b
Added simproc list_neq (prompted by an application)
nipkow
parents:
21911
diff
changeset
|
883 |
|
cf58486ca11b
Added simproc list_neq (prompted by an application)
nipkow
parents:
21911
diff
changeset
|
884 |
|
15392 | 885 |
subsubsection {* @{text "@"} -- append *} |
13114 | 886 |
|
13142 | 887 |
lemma append_assoc [simp]: "(xs @ ys) @ zs = xs @ (ys @ zs)" |
13145 | 888 |
by (induct xs) auto |
13114 | 889 |
|
13142 | 890 |
lemma append_Nil2 [simp]: "xs @ [] = xs" |
13145 | 891 |
by (induct xs) auto |
3507 | 892 |
|
13142 | 893 |
lemma append_is_Nil_conv [iff]: "(xs @ ys = []) = (xs = [] \<and> ys = [])" |
13145 | 894 |
by (induct xs) auto |
13114 | 895 |
|
13142 | 896 |
lemma Nil_is_append_conv [iff]: "([] = xs @ ys) = (xs = [] \<and> ys = [])" |
13145 | 897 |
by (induct xs) auto |
13114 | 898 |
|
13142 | 899 |
lemma append_self_conv [iff]: "(xs @ ys = xs) = (ys = [])" |
13145 | 900 |
by (induct xs) auto |
13114 | 901 |
|
13142 | 902 |
lemma self_append_conv [iff]: "(xs = xs @ ys) = (ys = [])" |
13145 | 903 |
by (induct xs) auto |
13114 | 904 |
|
54147
97a8ff4e4ac9
killed most "no_atp", to make Sledgehammer more complete
blanchet
parents:
53954
diff
changeset
|
905 |
lemma append_eq_append_conv [simp]: |
24526 | 906 |
"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
|
907 |
==> (xs@us = ys@vs) = (xs=ys \<and> us=vs)" |
24526 | 908 |
apply (induct xs arbitrary: ys) |
14208 | 909 |
apply (case_tac ys, simp, force) |
910 |
apply (case_tac ys, force, simp) |
|
13145 | 911 |
done |
13142 | 912 |
|
24526 | 913 |
lemma append_eq_append_conv2: "(xs @ ys = zs @ ts) = |
914 |
(EX us. xs = zs @ us & us @ ys = ts | xs @ us = zs & ys = us@ ts)" |
|
915 |
apply (induct xs arbitrary: ys zs ts) |
|
44890
22f665a2e91c
new fastforce replacing fastsimp - less confusing name
nipkow
parents:
44635
diff
changeset
|
916 |
apply fastforce |
14495 | 917 |
apply(case_tac zs) |
918 |
apply simp |
|
44890
22f665a2e91c
new fastforce replacing fastsimp - less confusing name
nipkow
parents:
44635
diff
changeset
|
919 |
apply fastforce |
14495 | 920 |
done |
921 |
||
34910
b23bd3ee4813
same_append_eq / append_same_eq are now used for simplifying induction rules.
berghofe
parents:
34064
diff
changeset
|
922 |
lemma same_append_eq [iff, induct_simp]: "(xs @ ys = xs @ zs) = (ys = zs)" |
13145 | 923 |
by simp |
13142 | 924 |
|
925 |
lemma append1_eq_conv [iff]: "(xs @ [x] = ys @ [y]) = (xs = ys \<and> x = y)" |
|
13145 | 926 |
by simp |
13114 | 927 |
|
34910
b23bd3ee4813
same_append_eq / append_same_eq are now used for simplifying induction rules.
berghofe
parents:
34064
diff
changeset
|
928 |
lemma append_same_eq [iff, induct_simp]: "(ys @ xs = zs @ xs) = (ys = zs)" |
13145 | 929 |
by simp |
13114 | 930 |
|
13142 | 931 |
lemma append_self_conv2 [iff]: "(xs @ ys = ys) = (xs = [])" |
13145 | 932 |
using append_same_eq [of _ _ "[]"] by auto |
3507 | 933 |
|
13142 | 934 |
lemma self_append_conv2 [iff]: "(ys = xs @ ys) = (xs = [])" |
13145 | 935 |
using append_same_eq [of "[]"] by auto |
13114 | 936 |
|
54147
97a8ff4e4ac9
killed most "no_atp", to make Sledgehammer more complete
blanchet
parents:
53954
diff
changeset
|
937 |
lemma hd_Cons_tl [simp]: "xs \<noteq> [] ==> hd xs # tl xs = xs" |
13145 | 938 |
by (induct xs) auto |
13114 | 939 |
|
13142 | 940 |
lemma hd_append: "hd (xs @ ys) = (if xs = [] then hd ys else hd xs)" |
13145 | 941 |
by (induct xs) auto |
13114 | 942 |
|
13142 | 943 |
lemma hd_append2 [simp]: "xs \<noteq> [] ==> hd (xs @ ys) = hd xs" |
13145 | 944 |
by (simp add: hd_append split: list.split) |
13114 | 945 |
|
13142 | 946 |
lemma tl_append: "tl (xs @ ys) = (case xs of [] => tl ys | z#zs => zs @ ys)" |
13145 | 947 |
by (simp split: list.split) |
13114 | 948 |
|
13142 | 949 |
lemma tl_append2 [simp]: "xs \<noteq> [] ==> tl (xs @ ys) = tl xs @ ys" |
13145 | 950 |
by (simp add: tl_append split: list.split) |
13114 | 951 |
|
952 |
||
14300 | 953 |
lemma Cons_eq_append_conv: "x#xs = ys@zs = |
954 |
(ys = [] & x#xs = zs | (EX ys'. x#ys' = ys & xs = ys'@zs))" |
|
955 |
by(cases ys) auto |
|
956 |
||
15281 | 957 |
lemma append_eq_Cons_conv: "(ys@zs = x#xs) = |
958 |
(ys = [] & zs = x#xs | (EX ys'. ys = x#ys' & ys'@zs = xs))" |
|
959 |
by(cases ys) auto |
|
960 |
||
14300 | 961 |
|
13142 | 962 |
text {* Trivial rules for solving @{text "@"}-equations automatically. *} |
13114 | 963 |
|
964 |
lemma eq_Nil_appendI: "xs = ys ==> xs = [] @ ys" |
|
13145 | 965 |
by simp |
13114 | 966 |
|
13142 | 967 |
lemma Cons_eq_appendI: |
13145 | 968 |
"[| x # xs1 = ys; xs = xs1 @ zs |] ==> x # xs = ys @ zs" |
969 |
by (drule sym) simp |
|
13114 | 970 |
|
13142 | 971 |
lemma append_eq_appendI: |
13145 | 972 |
"[| xs @ xs1 = zs; ys = xs1 @ us |] ==> xs @ ys = zs @ us" |
973 |
by (drule sym) simp |
|
13114 | 974 |
|
975 |
||
13142 | 976 |
text {* |
13145 | 977 |
Simplification procedure for all list equalities. |
978 |
Currently only tries to rearrange @{text "@"} to see if |
|
979 |
- both lists end in a singleton list, |
|
980 |
- or both lists end in the same list. |
|
13142 | 981 |
*} |
982 |
||
43594 | 983 |
simproc_setup list_eq ("(xs::'a list) = ys") = {* |
13462 | 984 |
let |
43594 | 985 |
fun last (cons as Const (@{const_name Cons}, _) $ _ $ xs) = |
986 |
(case xs of Const (@{const_name Nil}, _) => cons | _ => last xs) |
|
987 |
| last (Const(@{const_name append},_) $ _ $ ys) = last ys |
|
988 |
| last t = t; |
|
989 |
||
990 |
fun list1 (Const(@{const_name Cons},_) $ _ $ Const(@{const_name Nil},_)) = true |
|
991 |
| list1 _ = false; |
|
992 |
||
993 |
fun butlast ((cons as Const(@{const_name Cons},_) $ x) $ xs) = |
|
994 |
(case xs of Const (@{const_name Nil}, _) => xs | _ => cons $ butlast xs) |
|
995 |
| butlast ((app as Const (@{const_name append}, _) $ xs) $ ys) = app $ butlast ys |
|
996 |
| butlast xs = Const(@{const_name Nil}, fastype_of xs); |
|
997 |
||
998 |
val rearr_ss = |
|
51717
9e7d1c139569
simplifier uses proper Proof.context instead of historic type simpset;
wenzelm
parents:
51678
diff
changeset
|
999 |
simpset_of (put_simpset HOL_basic_ss @{context} |
9e7d1c139569
simplifier uses proper Proof.context instead of historic type simpset;
wenzelm
parents:
51678
diff
changeset
|
1000 |
addsimps [@{thm append_assoc}, @{thm append_Nil}, @{thm append_Cons}]); |
43594 | 1001 |
|
51717
9e7d1c139569
simplifier uses proper Proof.context instead of historic type simpset;
wenzelm
parents:
51678
diff
changeset
|
1002 |
fun list_eq ctxt (F as (eq as Const(_,eqT)) $ lhs $ rhs) = |
13462 | 1003 |
let |
43594 | 1004 |
val lastl = last lhs and lastr = last rhs; |
1005 |
fun rearr conv = |
|
1006 |
let |
|
1007 |
val lhs1 = butlast lhs and rhs1 = butlast rhs; |
|
1008 |
val Type(_,listT::_) = eqT |
|
1009 |
val appT = [listT,listT] ---> listT |
|
1010 |
val app = Const(@{const_name append},appT) |
|
1011 |
val F2 = eq $ (app$lhs1$lastl) $ (app$rhs1$lastr) |
|
1012 |
val eq = HOLogic.mk_Trueprop (HOLogic.mk_eq (F,F2)); |
|
51717
9e7d1c139569
simplifier uses proper Proof.context instead of historic type simpset;
wenzelm
parents:
51678
diff
changeset
|
1013 |
val thm = Goal.prove ctxt [] [] eq |
9e7d1c139569
simplifier uses proper Proof.context instead of historic type simpset;
wenzelm
parents:
51678
diff
changeset
|
1014 |
(K (simp_tac (put_simpset rearr_ss ctxt) 1)); |
43594 | 1015 |
in SOME ((conv RS (thm RS trans)) RS eq_reflection) end; |
1016 |
in |
|
1017 |
if list1 lastl andalso list1 lastr then rearr @{thm append1_eq_conv} |
|
1018 |
else if lastl aconv lastr then rearr @{thm append_same_eq} |
|
1019 |
else NONE |
|
1020 |
end; |
|
51717
9e7d1c139569
simplifier uses proper Proof.context instead of historic type simpset;
wenzelm
parents:
51678
diff
changeset
|
1021 |
in fn _ => fn ctxt => fn ct => list_eq ctxt (term_of ct) end; |
13114 | 1022 |
*} |
1023 |
||
1024 |
||
49948
744934b818c7
moved quite generic material from theory Enum to more appropriate places
haftmann
parents:
49808
diff
changeset
|
1025 |
subsubsection {* @{const map} *} |
13114 | 1026 |
|
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
|
1027 |
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
|
1028 |
"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
|
1029 |
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
|
1030 |
|
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
|
1031 |
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
|
1032 |
"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
|
1033 |
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
|
1034 |
|
13142 | 1035 |
lemma map_ext: "(!!x. x : set xs --> f x = g x) ==> map f xs = map g xs" |
13145 | 1036 |
by (induct xs) simp_all |
13114 | 1037 |
|
13142 | 1038 |
lemma map_ident [simp]: "map (\<lambda>x. x) = (\<lambda>xs. xs)" |
13145 | 1039 |
by (rule ext, induct_tac xs) auto |
13114 | 1040 |
|
13142 | 1041 |
lemma map_append [simp]: "map f (xs @ ys) = map f xs @ map f ys" |
13145 | 1042 |
by (induct xs) auto |
13114 | 1043 |
|
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
|
1044 |
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
|
1045 |
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
|
1046 |
|
35208 | 1047 |
lemma map_comp_map[simp]: "((map f) o (map g)) = map(f o g)" |
1048 |
apply(rule ext) |
|
1049 |
apply(simp) |
|
1050 |
done |
|
1051 |
||
13142 | 1052 |
lemma rev_map: "rev (map f xs) = map f (rev xs)" |
13145 | 1053 |
by (induct xs) auto |
13114 | 1054 |
|
13737 | 1055 |
lemma map_eq_conv[simp]: "(map f xs = map g xs) = (!x : set xs. f x = g x)" |
1056 |
by (induct xs) auto |
|
1057 |
||
44013
5cfc1c36ae97
moved recdef package to HOL/Library/Old_Recdef.thy
krauss
parents:
43594
diff
changeset
|
1058 |
lemma map_cong [fundef_cong]: |
40122
1d8ad2ff3e01
dropped (almost) redundant distinct.induct rule; distinct_simps again named distinct.simps
haftmann
parents:
40077
diff
changeset
|
1059 |
"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
|
1060 |
by simp |
13114 | 1061 |
|
13142 | 1062 |
lemma map_is_Nil_conv [iff]: "(map f xs = []) = (xs = [])" |
13145 | 1063 |
by (cases xs) auto |
13114 | 1064 |
|
13142 | 1065 |
lemma Nil_is_map_conv [iff]: "([] = map f xs) = (xs = [])" |
13145 | 1066 |
by (cases xs) auto |
13114 | 1067 |
|
18447 | 1068 |
lemma map_eq_Cons_conv: |
14025 | 1069 |
"(map f xs = y#ys) = (\<exists>z zs. xs = z#zs \<and> f z = y \<and> map f zs = ys)" |
13145 | 1070 |
by (cases xs) auto |
13114 | 1071 |
|
18447 | 1072 |
lemma Cons_eq_map_conv: |
14025 | 1073 |
"(x#xs = map f ys) = (\<exists>z zs. ys = z#zs \<and> x = f z \<and> xs = map f zs)" |
1074 |
by (cases ys) auto |
|
1075 |
||
18447 | 1076 |
lemmas map_eq_Cons_D = map_eq_Cons_conv [THEN iffD1] |
1077 |
lemmas Cons_eq_map_D = Cons_eq_map_conv [THEN iffD1] |
|
1078 |
declare map_eq_Cons_D [dest!] Cons_eq_map_D [dest!] |
|
1079 |
||
14111 | 1080 |
lemma ex_map_conv: |
1081 |
"(EX xs. ys = map f xs) = (ALL y : set ys. EX x. y = f x)" |
|
18447 | 1082 |
by(induct ys, auto simp add: Cons_eq_map_conv) |
14111 | 1083 |
|
15110
78b5636eabc7
Added a number of new thms and the new function remove1
nipkow
parents:
15072
diff
changeset
|
1084 |
lemma map_eq_imp_length_eq: |
35510 | 1085 |
assumes "map f xs = map g ys" |
26734 | 1086 |
shows "length xs = length ys" |
53374
a14d2a854c02
tuned proofs -- clarified flow of facts wrt. calculation;
wenzelm
parents:
53017
diff
changeset
|
1087 |
using assms |
a14d2a854c02
tuned proofs -- clarified flow of facts wrt. calculation;
wenzelm
parents:
53017
diff
changeset
|
1088 |
proof (induct ys arbitrary: xs) |
26734 | 1089 |
case Nil then show ?case by simp |
1090 |
next |
|
1091 |
case (Cons y ys) then obtain z zs where xs: "xs = z # zs" by auto |
|
35510 | 1092 |
from Cons xs have "map f zs = map g ys" by simp |
53374
a14d2a854c02
tuned proofs -- clarified flow of facts wrt. calculation;
wenzelm
parents:
53017
diff
changeset
|
1093 |
with Cons have "length zs = length ys" by blast |
26734 | 1094 |
with xs show ?case by simp |
1095 |
qed |
|
1096 |
||
15110
78b5636eabc7
Added a number of new thms and the new function remove1
nipkow
parents:
15072
diff
changeset
|
1097 |
lemma map_inj_on: |
78b5636eabc7
Added a number of new thms and the new function remove1
nipkow
parents:
15072
diff
changeset
|
1098 |
"[| 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
|
1099 |
==> xs = ys" |
78b5636eabc7
Added a number of new thms and the new function remove1
nipkow
parents:
15072
diff
changeset
|
1100 |
apply(frule map_eq_imp_length_eq) |
78b5636eabc7
Added a number of new thms and the new function remove1
nipkow
parents:
15072
diff
changeset
|
1101 |
apply(rotate_tac -1) |
78b5636eabc7
Added a number of new thms and the new function remove1
nipkow
parents:
15072
diff
changeset
|
1102 |
apply(induct rule:list_induct2) |
78b5636eabc7
Added a number of new thms and the new function remove1
nipkow
parents:
15072
diff
changeset
|
1103 |
apply simp |
78b5636eabc7
Added a number of new thms and the new function remove1
nipkow
parents:
15072
diff
changeset
|
1104 |
apply(simp) |
78b5636eabc7
Added a number of new thms and the new function remove1
nipkow
parents:
15072
diff
changeset
|
1105 |
apply (blast intro:sym) |
78b5636eabc7
Added a number of new thms and the new function remove1
nipkow
parents:
15072
diff
changeset
|
1106 |
done |
78b5636eabc7
Added a number of new thms and the new function remove1
nipkow
parents:
15072
diff
changeset
|
1107 |
|
78b5636eabc7
Added a number of new thms and the new function remove1
nipkow
parents:
15072
diff
changeset
|
1108 |
lemma inj_on_map_eq_map: |
78b5636eabc7
Added a number of new thms and the new function remove1
nipkow
parents:
15072
diff
changeset
|
1109 |
"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
|
1110 |
by(blast dest:map_inj_on) |
78b5636eabc7
Added a number of new thms and the new function remove1
nipkow
parents:
15072
diff
changeset
|
1111 |
|
13114 | 1112 |
lemma map_injective: |
24526 | 1113 |
"map f xs = map f ys ==> inj f ==> xs = ys" |
1114 |
by (induct ys arbitrary: xs) (auto dest!:injD) |
|
13114 | 1115 |
|
14339 | 1116 |
lemma inj_map_eq_map[simp]: "inj f \<Longrightarrow> (map f xs = map f ys) = (xs = ys)" |
1117 |
by(blast dest:map_injective) |
|
1118 |
||
13114 | 1119 |
lemma inj_mapI: "inj f ==> inj (map f)" |
17589 | 1120 |
by (iprover dest: map_injective injD intro: inj_onI) |
13114 | 1121 |
|
1122 |
lemma inj_mapD: "inj (map f) ==> inj f" |
|
14208 | 1123 |
apply (unfold inj_on_def, clarify) |
13145 | 1124 |
apply (erule_tac x = "[x]" in ballE) |
14208 | 1125 |
apply (erule_tac x = "[y]" in ballE, simp, blast) |
13145 | 1126 |
apply blast |
1127 |
done |
|
13114 | 1128 |
|
14339 | 1129 |
lemma inj_map[iff]: "inj (map f) = inj f" |
13145 | 1130 |
by (blast dest: inj_mapD intro: inj_mapI) |
13114 | 1131 |
|
15303 | 1132 |
lemma inj_on_mapI: "inj_on f (\<Union>(set ` A)) \<Longrightarrow> inj_on (map f) A" |
1133 |
apply(rule inj_onI) |
|
1134 |
apply(erule map_inj_on) |
|
1135 |
apply(blast intro:inj_onI dest:inj_onD) |
|
1136 |
done |
|
1137 |
||
14343 | 1138 |
lemma map_idI: "(\<And>x. x \<in> set xs \<Longrightarrow> f x = x) \<Longrightarrow> map f xs = xs" |
1139 |
by (induct xs, auto) |
|
13114 | 1140 |
|
14402
4201e1916482
moved lemmas from MicroJava/Comp/AuxLemmas.thy to List.thy
nipkow
parents:
14395
diff
changeset
|
1141 |
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
|
1142 |
by (induct xs) auto |
4201e1916482
moved lemmas from MicroJava/Comp/AuxLemmas.thy to List.thy
nipkow
parents:
14395
diff
changeset
|
1143 |
|
15110
78b5636eabc7
Added a number of new thms and the new function remove1
nipkow
parents:
15072
diff
changeset
|
1144 |
lemma map_fst_zip[simp]: |
78b5636eabc7
Added a number of new thms and the new function remove1
nipkow
parents:
15072
diff
changeset
|
1145 |
"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
|
1146 |
by (induct rule:list_induct2, simp_all) |
78b5636eabc7
Added a number of new thms and the new function remove1
nipkow
parents:
15072
diff
changeset
|
1147 |
|
78b5636eabc7
Added a number of new thms and the new function remove1
nipkow
parents:
15072
diff
changeset
|
1148 |
lemma map_snd_zip[simp]: |
78b5636eabc7
Added a number of new thms and the new function remove1
nipkow
parents:
15072
diff
changeset
|
1149 |
"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
|
1150 |
by (induct rule:list_induct2, simp_all) |
78b5636eabc7
Added a number of new thms and the new function remove1
nipkow
parents:
15072
diff
changeset
|
1151 |
|
41505
6d19301074cf
"enriched_type" replaces less specific "type_lifting"
haftmann
parents:
41463
diff
changeset
|
1152 |
enriched_type map: map |
47122 | 1153 |
by (simp_all add: id_def) |
1154 |
||
49948
744934b818c7
moved quite generic material from theory Enum to more appropriate places
haftmann
parents:
49808
diff
changeset
|
1155 |
declare map.id [simp] |
744934b818c7
moved quite generic material from theory Enum to more appropriate places
haftmann
parents:
49808
diff
changeset
|
1156 |
|
744934b818c7
moved quite generic material from theory Enum to more appropriate places
haftmann
parents:
49808
diff
changeset
|
1157 |
|
744934b818c7
moved quite generic material from theory Enum to more appropriate places
haftmann
parents:
49808
diff
changeset
|
1158 |
subsubsection {* @{const rev} *} |
13114 | 1159 |
|
13142 | 1160 |
lemma rev_append [simp]: "rev (xs @ ys) = rev ys @ rev xs" |
13145 | 1161 |
by (induct xs) auto |
13114 | 1162 |
|
13142 | 1163 |
lemma rev_rev_ident [simp]: "rev (rev xs) = xs" |
13145 | 1164 |
by (induct xs) auto |
13114 | 1165 |
|
15870 | 1166 |
lemma rev_swap: "(rev xs = ys) = (xs = rev ys)" |
1167 |
by auto |
|
1168 |
||
13142 | 1169 |
lemma rev_is_Nil_conv [iff]: "(rev xs = []) = (xs = [])" |
13145 | 1170 |
by (induct xs) auto |
13114 | 1171 |
|
13142 | 1172 |
lemma Nil_is_rev_conv [iff]: "([] = rev xs) = (xs = [])" |
13145 | 1173 |
by (induct xs) auto |
13114 | 1174 |
|
15870 | 1175 |
lemma rev_singleton_conv [simp]: "(rev xs = [x]) = (xs = [x])" |
1176 |
by (cases xs) auto |
|
1177 |
||
1178 |
lemma singleton_rev_conv [simp]: "([x] = rev xs) = (xs = [x])" |
|
1179 |
by (cases xs) auto |
|
1180 |
||
54147
97a8ff4e4ac9
killed most "no_atp", to make Sledgehammer more complete
blanchet
parents:
53954
diff
changeset
|
1181 |
lemma rev_is_rev_conv [iff]: "(rev xs = rev ys) = (xs = ys)" |
21061
580dfc999ef6
added normal post setup; cleaned up "execution" constants
haftmann
parents:
21046
diff
changeset
|
1182 |
apply (induct xs arbitrary: ys, force) |
14208 | 1183 |
apply (case_tac ys, simp, force) |
13145 | 1184 |
done |
13114 | 1185 |
|
15439 | 1186 |
lemma inj_on_rev[iff]: "inj_on rev A" |
1187 |
by(simp add:inj_on_def) |
|
1188 |
||
13366 | 1189 |
lemma rev_induct [case_names Nil snoc]: |
1190 |
"[| 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
|
1191 |
apply(simplesubst rev_rev_ident[symmetric]) |
13145 | 1192 |
apply(rule_tac list = "rev xs" in list.induct, simp_all) |
1193 |
done |
|
13114 | 1194 |
|
13366 | 1195 |
lemma rev_exhaust [case_names Nil snoc]: |
1196 |
"(xs = [] ==> P) ==>(!!ys y. xs = ys @ [y] ==> P) ==> P" |
|
13145 | 1197 |
by (induct xs rule: rev_induct) auto |
13114 | 1198 |
|
13366 | 1199 |
lemmas rev_cases = rev_exhaust |
1200 |
||
18423 | 1201 |
lemma rev_eq_Cons_iff[iff]: "(rev xs = y#ys) = (xs = rev ys @ [y])" |
1202 |
by(rule rev_cases[of xs]) auto |
|
1203 |
||
13114 | 1204 |
|
49948
744934b818c7
moved quite generic material from theory Enum to more appropriate places
haftmann
parents:
49808
diff
changeset
|
1205 |
subsubsection {* @{const set} *} |
13114 | 1206 |
|
46698
f1dfcf8be88d
converting "set [...]" to "{...}" in evaluation results
nipkow
parents:
46669
diff
changeset
|
1207 |
declare set.simps [code_post] --"pretty output" |
f1dfcf8be88d
converting "set [...]" to "{...}" in evaluation results
nipkow
parents:
46669
diff
changeset
|
1208 |
|
13142 | 1209 |
lemma finite_set [iff]: "finite (set xs)" |
13145 | 1210 |
by (induct xs) auto |
13114 | 1211 |
|
13142 | 1212 |
lemma set_append [simp]: "set (xs @ ys) = (set xs \<union> set ys)" |
13145 | 1213 |
by (induct xs) auto |
13114 | 1214 |
|
17830 | 1215 |
lemma hd_in_set[simp]: "xs \<noteq> [] \<Longrightarrow> hd xs : set xs" |
1216 |
by(cases xs) auto |
|
14099 | 1217 |
|
13142 | 1218 |
lemma set_subset_Cons: "set xs \<subseteq> set (x # xs)" |
13145 | 1219 |
by auto |
13114 | 1220 |
|
14099 | 1221 |
lemma set_ConsD: "y \<in> set (x # xs) \<Longrightarrow> y=x \<or> y \<in> set xs" |
1222 |
by auto |
|
1223 |
||
13142 | 1224 |
lemma set_empty [iff]: "(set xs = {}) = (xs = [])" |
13145 | 1225 |
by (induct xs) auto |
13114 | 1226 |
|
15245 | 1227 |
lemma set_empty2[iff]: "({} = set xs) = (xs = [])" |
1228 |
by(induct xs) auto |
|
1229 |
||
13142 | 1230 |
lemma set_rev [simp]: "set (rev xs) = set xs" |
13145 | 1231 |
by (induct xs) auto |
13114 | 1232 |
|
13142 | 1233 |
lemma set_map [simp]: "set (map f xs) = f`(set xs)" |
13145 | 1234 |
by (induct xs) auto |
13114 | 1235 |
|
13142 | 1236 |
lemma set_filter [simp]: "set (filter P xs) = {x. x : set xs \<and> P x}" |
13145 | 1237 |
by (induct xs) auto |
13114 | 1238 |
|
32417 | 1239 |
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
|
1240 |
by (induct j) auto |
13114 | 1241 |
|
13142 | 1242 |
|
25221
5ded95dda5df
append/member: more light-weight way to declare authentic syntax;
wenzelm
parents:
25215
diff
changeset
|
1243 |
lemma split_list: "x : set xs \<Longrightarrow> \<exists>ys zs. xs = ys @ x # zs" |
18049 | 1244 |
proof (induct xs) |
26073 | 1245 |
case Nil thus ?case by simp |
1246 |
next |
|
1247 |
case Cons thus ?case by (auto intro: Cons_eq_appendI) |
|
1248 |
qed |
|
1249 |
||
26734 | 1250 |
lemma in_set_conv_decomp: "x \<in> set xs \<longleftrightarrow> (\<exists>ys zs. xs = ys @ x # zs)" |
1251 |
by (auto elim: split_list) |
|
26073 | 1252 |
|
1253 |
lemma split_list_first: "x : set xs \<Longrightarrow> \<exists>ys zs. xs = ys @ x # zs \<and> x \<notin> set ys" |
|
1254 |
proof (induct xs) |
|
1255 |
case Nil thus ?case by simp |
|
18049 | 1256 |
next |
1257 |
case (Cons a xs) |
|
1258 |
show ?case |
|
1259 |
proof cases |
|
44890
22f665a2e91c
new fastforce replacing fastsimp - less confusing name
nipkow
parents:
44635
diff
changeset
|
1260 |
assume "x = a" thus ?case using Cons by fastforce |
18049 | 1261 |
next |
44890
22f665a2e91c
new fastforce replacing fastsimp - less confusing name
nipkow
parents:
44635
diff
changeset
|
1262 |
assume "x \<noteq> a" thus ?case using Cons by(fastforce intro!: Cons_eq_appendI) |
26073 | 1263 |
qed |
1264 |
qed |
|
1265 |
||
1266 |
lemma in_set_conv_decomp_first: |
|
1267 |
"(x : set xs) = (\<exists>ys zs. xs = ys @ x # zs \<and> x \<notin> set ys)" |
|
26734 | 1268 |
by (auto dest!: split_list_first) |
26073 | 1269 |
|
40122
1d8ad2ff3e01
dropped (almost) redundant distinct.induct rule; distinct_simps again named distinct.simps
haftmann
parents:
40077
diff
changeset
|
1270 |
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
|
1271 |
proof (induct xs rule: rev_induct) |
26073 | 1272 |
case Nil thus ?case by simp |
1273 |
next |
|
1274 |
case (snoc a xs) |
|
1275 |
show ?case |
|
1276 |
proof cases |
|
40122
1d8ad2ff3e01
dropped (almost) redundant distinct.induct rule; distinct_simps again named distinct.simps
haftmann
parents:
40077
diff
changeset
|
1277 |
assume "x = a" thus ?case using snoc by (metis List.set.simps(1) emptyE) |
26073 | 1278 |
next |
44890
22f665a2e91c
new fastforce replacing fastsimp - less confusing name
nipkow
parents:
44635
diff
changeset
|
1279 |
assume "x \<noteq> a" thus ?case using snoc by fastforce |
18049 | 1280 |
qed |
1281 |
qed |
|
1282 |
||
26073 | 1283 |
lemma in_set_conv_decomp_last: |
1284 |
"(x : set xs) = (\<exists>ys zs. xs = ys @ x # zs \<and> x \<notin> set zs)" |
|
26734 | 1285 |
by (auto dest!: split_list_last) |
26073 | 1286 |
|
1287 |
lemma split_list_prop: "\<exists>x \<in> set xs. P x \<Longrightarrow> \<exists>ys x zs. xs = ys @ x # zs & P x" |
|
1288 |
proof (induct xs) |
|
1289 |
case Nil thus ?case by simp |
|
1290 |
next |
|
1291 |
case Cons thus ?case |
|
1292 |
by(simp add:Bex_def)(metis append_Cons append.simps(1)) |
|
1293 |
qed |
|
1294 |
||
1295 |
lemma split_list_propE: |
|
26734 | 1296 |
assumes "\<exists>x \<in> set xs. P x" |
1297 |
obtains ys x zs where "xs = ys @ x # zs" and "P x" |
|
1298 |
using split_list_prop [OF assms] by blast |
|
26073 | 1299 |
|
1300 |
lemma split_list_first_prop: |
|
1301 |
"\<exists>x \<in> set xs. P x \<Longrightarrow> |
|
1302 |
\<exists>ys x zs. xs = ys@x#zs \<and> P x \<and> (\<forall>y \<in> set ys. \<not> P y)" |
|
26734 | 1303 |
proof (induct xs) |
26073 | 1304 |
case Nil thus ?case by simp |
1305 |
next |
|
1306 |
case (Cons x xs) |
|
1307 |
show ?case |
|
1308 |
proof cases |
|
1309 |
assume "P x" |
|
40122
1d8ad2ff3e01
dropped (almost) redundant distinct.induct rule; distinct_simps again named distinct.simps
haftmann
parents:
40077
diff
changeset
|
1310 |
thus ?thesis by simp (metis Un_upper1 contra_subsetD in_set_conv_decomp_first self_append_conv2 set_append) |
26073 | 1311 |
next |
1312 |
assume "\<not> P x" |
|
1313 |
hence "\<exists>x\<in>set xs. P x" using Cons(2) by simp |
|
1314 |
thus ?thesis using `\<not> P x` Cons(1) by (metis append_Cons set_ConsD) |
|
1315 |
qed |
|
1316 |
qed |
|
1317 |
||
1318 |
lemma split_list_first_propE: |
|
26734 | 1319 |
assumes "\<exists>x \<in> set xs. P x" |
1320 |
obtains ys x zs where "xs = ys @ x # zs" and "P x" and "\<forall>y \<in> set ys. \<not> P y" |
|
1321 |
using split_list_first_prop [OF assms] by blast |
|
26073 | 1322 |
|
1323 |
lemma split_list_first_prop_iff: |
|
1324 |
"(\<exists>x \<in> set xs. P x) \<longleftrightarrow> |
|
1325 |
(\<exists>ys x zs. xs = ys@x#zs \<and> P x \<and> (\<forall>y \<in> set ys. \<not> P y))" |
|
26734 | 1326 |
by (rule, erule split_list_first_prop) auto |
26073 | 1327 |
|
1328 |
lemma split_list_last_prop: |
|
1329 |
"\<exists>x \<in> set xs. P x \<Longrightarrow> |
|
1330 |
\<exists>ys x zs. xs = ys@x#zs \<and> P x \<and> (\<forall>z \<in> set zs. \<not> P z)" |
|
1331 |
proof(induct xs rule:rev_induct) |
|
1332 |
case Nil thus ?case by simp |
|
1333 |
next |
|
1334 |
case (snoc x xs) |
|
1335 |
show ?case |
|
1336 |
proof cases |
|
1337 |
assume "P x" thus ?thesis by (metis emptyE set_empty) |
|
1338 |
next |
|
1339 |
assume "\<not> P x" |
|
1340 |
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
|
1341 |
thus ?thesis using `\<not> P x` snoc(1) by fastforce |
26073 | 1342 |
qed |
1343 |
qed |
|
1344 |
||
1345 |
lemma split_list_last_propE: |
|
26734 | 1346 |
assumes "\<exists>x \<in> set xs. P x" |
1347 |
obtains ys x zs where "xs = ys @ x # zs" and "P x" and "\<forall>z \<in> set zs. \<not> P z" |
|
1348 |
using split_list_last_prop [OF assms] by blast |
|
26073 | 1349 |
|
1350 |
lemma split_list_last_prop_iff: |
|
1351 |
"(\<exists>x \<in> set xs. P x) \<longleftrightarrow> |
|
1352 |
(\<exists>ys x zs. xs = ys@x#zs \<and> P x \<and> (\<forall>z \<in> set zs. \<not> P z))" |
|
26734 | 1353 |
by (metis split_list_last_prop [where P=P] in_set_conv_decomp) |
26073 | 1354 |
|
1355 |
lemma finite_list: "finite A ==> EX xs. set xs = A" |
|
26734 | 1356 |
by (erule finite_induct) |
1357 |
(auto simp add: set.simps(2) [symmetric] simp del: set.simps(2)) |
|
13508 | 1358 |
|
14388 | 1359 |
lemma card_length: "card (set xs) \<le> length xs" |
1360 |
by (induct xs) (auto simp add: card_insert_if) |
|
13114 | 1361 |
|
26442
57fb6a8b099e
restructuring; explicit case names for rule list_induct2
haftmann
parents:
26300
diff
changeset
|
1362 |
lemma set_minus_filter_out: |
57fb6a8b099e
restructuring; explicit case names for rule list_induct2
haftmann
parents:
26300
diff
changeset
|
1363 |
"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
|
1364 |
by (induct xs) auto |
15168 | 1365 |
|
35115 | 1366 |
|
49948
744934b818c7
moved quite generic material from theory Enum to more appropriate places
haftmann
parents:
49808
diff
changeset
|
1367 |
subsubsection {* @{const filter} *} |
13114 | 1368 |
|
13142 | 1369 |
lemma filter_append [simp]: "filter P (xs @ ys) = filter P xs @ filter P ys" |
13145 | 1370 |
by (induct xs) auto |
13114 | 1371 |
|
15305 | 1372 |
lemma rev_filter: "rev (filter P xs) = filter P (rev xs)" |
1373 |
by (induct xs) simp_all |
|
1374 |
||
13142 | 1375 |
lemma filter_filter [simp]: "filter P (filter Q xs) = filter (\<lambda>x. Q x \<and> P x) xs" |
13145 | 1376 |
by (induct xs) auto |
13114 | 1377 |
|
16998 | 1378 |
lemma length_filter_le [simp]: "length (filter P xs) \<le> length xs" |
1379 |
by (induct xs) (auto simp add: le_SucI) |
|
1380 |
||
18423 | 1381 |
lemma sum_length_filter_compl: |
1382 |
"length(filter P xs) + length(filter (%x. ~P x) xs) = length xs" |
|
1383 |
by(induct xs) simp_all |
|
1384 |
||
13142 | 1385 |
lemma filter_True [simp]: "\<forall>x \<in> set xs. P x ==> filter P xs = xs" |
13145 | 1386 |
by (induct xs) auto |
13114 | 1387 |
|
13142 | 1388 |
lemma filter_False [simp]: "\<forall>x \<in> set xs. \<not> P x ==> filter P xs = []" |
13145 | 1389 |
by (induct xs) auto |
13114 | 1390 |
|
16998 | 1391 |
lemma filter_empty_conv: "(filter P xs = []) = (\<forall>x\<in>set xs. \<not> P x)" |
24349 | 1392 |
by (induct xs) simp_all |
16998 | 1393 |
|
1394 |
lemma filter_id_conv: "(filter P xs = xs) = (\<forall>x\<in>set xs. P x)" |
|
1395 |
apply (induct xs) |
|
1396 |
apply auto |
|
1397 |
apply(cut_tac P=P and xs=xs in length_filter_le) |
|
1398 |
apply simp |
|
1399 |
done |
|
13114 | 1400 |
|
16965 | 1401 |
lemma filter_map: |
1402 |
"filter P (map f xs) = map f (filter (P o f) xs)" |
|
1403 |
by (induct xs) simp_all |
|
1404 |
||
1405 |
lemma length_filter_map[simp]: |
|
1406 |
"length (filter P (map f xs)) = length(filter (P o f) xs)" |
|
1407 |
by (simp add:filter_map) |
|
1408 |
||
13142 | 1409 |
lemma filter_is_subset [simp]: "set (filter P xs) \<le> set xs" |
13145 | 1410 |
by auto |
13114 | 1411 |
|
15246 | 1412 |
lemma length_filter_less: |
1413 |
"\<lbrakk> x : set xs; ~ P x \<rbrakk> \<Longrightarrow> length(filter P xs) < length xs" |
|
1414 |
proof (induct xs) |
|
1415 |
case Nil thus ?case by simp |
|
1416 |
next |
|
1417 |
case (Cons x xs) thus ?case |
|
1418 |
apply (auto split:split_if_asm) |
|
1419 |
using length_filter_le[of P xs] apply arith |
|
1420 |
done |
|
1421 |
qed |
|
13114 | 1422 |
|
15281 | 1423 |
lemma length_filter_conv_card: |
1424 |
"length(filter p xs) = card{i. i < length xs & p(xs!i)}" |
|
1425 |
proof (induct xs) |
|
1426 |
case Nil thus ?case by simp |
|
1427 |
next |
|
1428 |
case (Cons x xs) |
|
1429 |
let ?S = "{i. i < length xs & p(xs!i)}" |
|
1430 |
have fin: "finite ?S" by(fast intro: bounded_nat_set_is_finite) |
|
1431 |
show ?case (is "?l = card ?S'") |
|
1432 |
proof (cases) |
|
1433 |
assume "p x" |
|
1434 |
hence eq: "?S' = insert 0 (Suc ` ?S)" |
|
25162 | 1435 |
by(auto simp: image_def split:nat.split dest:gr0_implies_Suc) |
15281 | 1436 |
have "length (filter p (x # xs)) = Suc(card ?S)" |
23388 | 1437 |
using Cons `p x` by simp |
15281 | 1438 |
also have "\<dots> = Suc(card(Suc ` ?S))" using fin |
44921 | 1439 |
by (simp add: card_image) |
15281 | 1440 |
also have "\<dots> = card ?S'" using eq fin |
1441 |
by (simp add:card_insert_if) (simp add:image_def) |
|
1442 |
finally show ?thesis . |
|
1443 |
next |
|
1444 |
assume "\<not> p x" |
|
1445 |
hence eq: "?S' = Suc ` ?S" |
|
25162 | 1446 |
by(auto simp add: image_def split:nat.split elim:lessE) |
15281 | 1447 |
have "length (filter p (x # xs)) = card ?S" |
23388 | 1448 |
using Cons `\<not> p x` by simp |
15281 | 1449 |
also have "\<dots> = card(Suc ` ?S)" using fin |
44921 | 1450 |
by (simp add: card_image) |
15281 | 1451 |
also have "\<dots> = card ?S'" using eq fin |
1452 |
by (simp add:card_insert_if) |
|
1453 |
finally show ?thesis . |
|
1454 |
qed |
|
1455 |
qed |
|
1456 |
||
17629 | 1457 |
lemma Cons_eq_filterD: |
1458 |
"x#xs = filter P ys \<Longrightarrow> |
|
1459 |
\<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 | 1460 |
(is "_ \<Longrightarrow> \<exists>us vs. ?P ys us vs") |
17629 | 1461 |
proof(induct ys) |
1462 |
case Nil thus ?case by simp |
|
1463 |
next |
|
1464 |
case (Cons y ys) |
|
1465 |
show ?case (is "\<exists>x. ?Q x") |
|
1466 |
proof cases |
|
1467 |
assume Py: "P y" |
|
1468 |
show ?thesis |
|
1469 |
proof cases |
|
25221
5ded95dda5df
append/member: more light-weight way to declare authentic syntax;
wenzelm
parents:
25215
diff
changeset
|
1470 |
assume "x = y" |
5ded95dda5df
append/member: more light-weight way to declare authentic syntax;
wenzelm
parents:
25215
diff
changeset
|
1471 |
with Py Cons.prems have "?Q []" by simp |
5ded95dda5df
append/member: more light-weight way to declare authentic syntax;
wenzelm
parents:
25215
diff
changeset
|
1472 |
then show ?thesis .. |
17629 | 1473 |
next |
25221
5ded95dda5df
append/member: more light-weight way to declare authentic syntax;
wenzelm
parents:
25215
diff
changeset
|
1474 |
assume "x \<noteq> y" |
5ded95dda5df
append/member: more light-weight way to declare authentic syntax;
wenzelm
parents:
25215
diff
changeset
|
1475 |
with Py Cons.prems show ?thesis by simp |
17629 | 1476 |
qed |
1477 |
next |
|
25221
5ded95dda5df
append/member: more light-weight way to declare authentic syntax;
wenzelm
parents:
25215
diff
changeset
|
1478 |
assume "\<not> P y" |
44890
22f665a2e91c
new fastforce replacing fastsimp - less confusing name
nipkow
parents:
44635
diff
changeset
|
1479 |
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
|
1480 |
then have "?Q (y#us)" by simp |
5ded95dda5df
append/member: more light-weight way to declare authentic syntax;
wenzelm
parents:
25215
diff
changeset
|
1481 |
then show ?thesis .. |
17629 | 1482 |
qed |
1483 |
qed |
|
1484 |
||
1485 |
lemma filter_eq_ConsD: |
|
1486 |
"filter P ys = x#xs \<Longrightarrow> |
|
1487 |
\<exists>us vs. ys = us @ x # vs \<and> (\<forall>u\<in>set us. \<not> P u) \<and> P x \<and> xs = filter P vs" |
|
1488 |
by(rule Cons_eq_filterD) simp |
|
1489 |
||
1490 |
lemma filter_eq_Cons_iff: |
|
1491 |
"(filter P ys = x#xs) = |
|
1492 |
(\<exists>us vs. ys = us @ x # vs \<and> (\<forall>u\<in>set us. \<not> P u) \<and> P x \<and> xs = filter P vs)" |
|
1493 |
by(auto dest:filter_eq_ConsD) |
|
1494 |
||
1495 |
lemma Cons_eq_filter_iff: |
|
1496 |
"(x#xs = filter P ys) = |
|
1497 |
(\<exists>us vs. ys = us @ x # vs \<and> (\<forall>u\<in>set us. \<not> P u) \<and> P x \<and> xs = filter P vs)" |
|
1498 |
by(auto dest:Cons_eq_filterD) |
|
1499 |
||
44013
5cfc1c36ae97
moved recdef package to HOL/Library/Old_Recdef.thy
krauss
parents:
43594
diff
changeset
|
1500 |
lemma filter_cong[fundef_cong]: |
17501 | 1501 |
"xs = ys \<Longrightarrow> (\<And>x. x \<in> set ys \<Longrightarrow> P x = Q x) \<Longrightarrow> filter P xs = filter Q ys" |
1502 |
apply simp |
|
1503 |
apply(erule thin_rl) |
|
1504 |
by (induct ys) simp_all |
|
1505 |
||
15281 | 1506 |
|
26442
57fb6a8b099e
restructuring; explicit case names for rule list_induct2
haftmann
parents:
26300
diff
changeset
|
1507 |
subsubsection {* List partitioning *} |
57fb6a8b099e
restructuring; explicit case names for rule list_induct2
haftmann
parents:
26300
diff
changeset
|
1508 |
|
57fb6a8b099e
restructuring; explicit case names for rule list_induct2
haftmann
parents:
26300
diff
changeset
|
1509 |
primrec partition :: "('a \<Rightarrow> bool) \<Rightarrow>'a list \<Rightarrow> 'a list \<times> 'a list" where |
50548 | 1510 |
"partition P [] = ([], [])" | |
1511 |
"partition P (x # xs) = |
|
1512 |
(let (yes, no) = partition P xs |
|
1513 |
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
|
1514 |
|
57fb6a8b099e
restructuring; explicit case names for rule list_induct2
haftmann
parents:
26300
diff
changeset
|
1515 |
lemma partition_filter1: |
57fb6a8b099e
restructuring; explicit case names for rule list_induct2
haftmann
parents:
26300
diff
changeset
|
1516 |
"fst (partition P xs) = filter P xs" |
57fb6a8b099e
restructuring; explicit case names for rule list_induct2
haftmann
parents:
26300
diff
changeset
|
1517 |
by (induct xs) (auto simp add: Let_def split_def) |
57fb6a8b099e
restructuring; explicit case names for rule list_induct2
haftmann
parents:
26300
diff
changeset
|
1518 |
|
57fb6a8b099e
restructuring; explicit case names for rule list_induct2
haftmann
parents:
26300
diff
changeset
|
1519 |
lemma partition_filter2: |
57fb6a8b099e
restructuring; explicit case names for rule list_induct2
haftmann
parents:
26300
diff
changeset
|
1520 |
"snd (partition P xs) = filter (Not o P) xs" |
57fb6a8b099e
restructuring; explicit case names for rule list_induct2
haftmann
parents:
26300
diff
changeset
|
1521 |
by (induct xs) (auto simp add: Let_def split_def) |
57fb6a8b099e
restructuring; explicit case names for rule list_induct2
haftmann
parents:
26300
diff
changeset
|
1522 |
|
57fb6a8b099e
restructuring; explicit case names for rule list_induct2
haftmann
parents:
26300
diff
changeset
|
1523 |
lemma partition_P: |
57fb6a8b099e
restructuring; explicit case names for rule list_induct2
haftmann
parents:
26300
diff
changeset
|
1524 |
assumes "partition P xs = (yes, no)" |
57fb6a8b099e
restructuring; explicit case names for rule list_induct2
haftmann
parents:
26300
diff
changeset
|
1525 |
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
|
1526 |
proof - |
57fb6a8b099e
restructuring; explicit case names for rule list_induct2
haftmann
parents:
26300
diff
changeset
|
1527 |
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
|
1528 |
by simp_all |
57fb6a8b099e
restructuring; explicit case names for rule list_induct2
haftmann
parents:
26300
diff
changeset
|
1529 |
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
|
1530 |
qed |
57fb6a8b099e
restructuring; explicit case names for rule list_induct2
haftmann
parents:
26300
diff
changeset
|
1531 |
|
57fb6a8b099e
restructuring; explicit case names for rule list_induct2
haftmann
parents:
26300
diff
changeset
|
1532 |
lemma partition_set: |
57fb6a8b099e
restructuring; explicit case names for rule list_induct2
haftmann
parents:
26300
diff
changeset
|
1533 |
assumes "partition P xs = (yes, no)" |
57fb6a8b099e
restructuring; explicit case names for rule list_induct2
haftmann
parents:
26300
diff
changeset
|
1534 |
shows "set yes \<union> set no = set xs" |
57fb6a8b099e
restructuring; explicit case names for rule list_induct2
haftmann
parents:
26300
diff
changeset
|
1535 |
proof - |
57fb6a8b099e
restructuring; explicit case names for rule list_induct2
haftmann
parents:
26300
diff
changeset
|
1536 |
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
|
1537 |
by simp_all |
57fb6a8b099e
restructuring; explicit case names for rule list_induct2
haftmann
parents:
26300
diff
changeset
|
1538 |
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
|
1539 |
qed |
57fb6a8b099e
restructuring; explicit case names for rule list_induct2
haftmann
parents:
26300
diff
changeset
|
1540 |
|
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
|
1541 |
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
|
1542 |
"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
|
1543 |
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
|
1544 |
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
|
1545 |
|
603320b93668
New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents:
33593
diff
changeset
|
1546 |
declare partition.simps[simp del] |
26442
57fb6a8b099e
restructuring; explicit case names for rule list_induct2
haftmann
parents:
26300
diff
changeset
|
1547 |
|
35115 | 1548 |
|
49948
744934b818c7
moved quite generic material from theory Enum to more appropriate places
haftmann
parents:
49808
diff
changeset
|
1549 |
subsubsection {* @{const concat} *} |
13114 | 1550 |
|
13142 | 1551 |
lemma concat_append [simp]: "concat (xs @ ys) = concat xs @ concat ys" |
13145 | 1552 |
by (induct xs) auto |
13114 | 1553 |
|
18447 | 1554 |
lemma concat_eq_Nil_conv [simp]: "(concat xss = []) = (\<forall>xs \<in> set xss. xs = [])" |
13145 | 1555 |
by (induct xss) auto |
13114 | 1556 |
|
18447 | 1557 |
lemma Nil_eq_concat_conv [simp]: "([] = concat xss) = (\<forall>xs \<in> set xss. xs = [])" |
13145 | 1558 |
by (induct xss) auto |
13114 | 1559 |
|
24308 | 1560 |
lemma set_concat [simp]: "set (concat xs) = (UN x:set xs. set x)" |
13145 | 1561 |
by (induct xs) auto |
13114 | 1562 |
|
24476
f7ad9fbbeeaa
turned list comprehension translations into ML to optimize base case
nipkow
parents:
24471
diff
changeset
|
1563 |
lemma concat_map_singleton[simp]: "concat(map (%x. [f x]) xs) = map f xs" |
24349 | 1564 |
by (induct xs) auto |
1565 |
||
13142 | 1566 |
lemma map_concat: "map f (concat xs) = concat (map (map f) xs)" |
13145 | 1567 |
by (induct xs) auto |
13114 | 1568 |
|
13142 | 1569 |
lemma filter_concat: "filter p (concat xs) = concat (map (filter p) xs)" |
13145 | 1570 |
by (induct xs) auto |
13114 | 1571 |
|
13142 | 1572 |
lemma rev_concat: "rev (concat xs) = concat (map rev (rev xs))" |
13145 | 1573 |
by (induct xs) auto |
13114 | 1574 |
|
40365
a1456f2e1c9d
added two lemmas about injectivity of concat to the list theory
bulwahn
parents:
40304
diff
changeset
|
1575 |
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
|
1576 |
proof (induct xs arbitrary: ys) |
a1456f2e1c9d
added two lemmas about injectivity of concat to the list theory
bulwahn
parents:
40304
diff
changeset
|
1577 |
case (Cons x xs ys) |
a1456f2e1c9d
added two lemmas about injectivity of concat to the list theory
bulwahn
parents:
40304
diff
changeset
|
1578 |
thus ?case by (cases ys) auto |
a1456f2e1c9d
added two lemmas about injectivity of concat to the list theory
bulwahn
parents:
40304
diff
changeset
|
1579 |
qed (auto) |
a1456f2e1c9d
added two lemmas about injectivity of concat to the list theory
bulwahn
parents:
40304
diff
changeset
|
1580 |
|
a1456f2e1c9d
added two lemmas about injectivity of concat to the list theory
bulwahn
parents:
40304
diff
changeset
|
1581 |
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
|
1582 |
by (simp add: concat_eq_concat_iff) |
a1456f2e1c9d
added two lemmas about injectivity of concat to the list theory
bulwahn
parents:
40304
diff
changeset
|
1583 |
|
13114 | 1584 |
|
49948
744934b818c7
moved quite generic material from theory Enum to more appropriate places
haftmann
parents:
49808
diff
changeset
|
1585 |
subsubsection {* @{const nth} *} |
13114 | 1586 |
|
29827 | 1587 |
lemma nth_Cons_0 [simp, code]: "(x # xs)!0 = x" |
13145 | 1588 |
by auto |
13114 | 1589 |
|
29827 | 1590 |
lemma nth_Cons_Suc [simp, code]: "(x # xs)!(Suc n) = xs!n" |
13145 | 1591 |
by auto |
13114 | 1592 |
|
13142 | 1593 |
declare nth.simps [simp del] |
13114 | 1594 |
|
41842 | 1595 |
lemma nth_Cons_pos[simp]: "0 < n \<Longrightarrow> (x#xs) ! n = xs ! (n - 1)" |
1596 |
by(auto simp: Nat.gr0_conv_Suc) |
|
1597 |
||
13114 | 1598 |
lemma nth_append: |
24526 | 1599 |
"(xs @ ys)!n = (if n < length xs then xs!n else ys!(n - length xs))" |
1600 |
apply (induct xs arbitrary: n, simp) |
|
14208 | 1601 |
apply (case_tac n, auto) |
13145 | 1602 |
done |
13114 | 1603 |
|
14402
4201e1916482
moved lemmas from MicroJava/Comp/AuxLemmas.thy to List.thy
nipkow
parents:
14395
diff
changeset
|
1604 |
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
|
1605 |
by (induct xs) auto |
14402
4201e1916482
moved lemmas from MicroJava/Comp/AuxLemmas.thy to List.thy
nipkow
parents:
14395
diff
changeset
|
1606 |
|
4201e1916482
moved lemmas from MicroJava/Comp/AuxLemmas.thy to List.thy
nipkow
parents:
14395
diff
changeset
|
1607 |
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
|
1608 |
by (induct xs) auto |
14402
4201e1916482
moved lemmas from MicroJava/Comp/AuxLemmas.thy to List.thy
nipkow
parents:
14395
diff
changeset
|
1609 |
|
24526 | 1610 |
lemma nth_map [simp]: "n < length xs ==> (map f xs)!n = f(xs!n)" |
1611 |
apply (induct xs arbitrary: n, simp) |
|
14208 | 1612 |
apply (case_tac n, auto) |
13145 | 1613 |
done |
13114 | 1614 |
|
45841 | 1615 |
lemma nth_tl: |
1616 |
assumes "n < length (tl x)" shows "tl x ! n = x ! Suc n" |
|
1617 |
using assms by (induct x) auto |
|
1618 |
||
18423 | 1619 |
lemma hd_conv_nth: "xs \<noteq> [] \<Longrightarrow> hd xs = xs!0" |
1620 |
by(cases xs) simp_all |
|
1621 |
||
18049 | 1622 |
|
1623 |
lemma list_eq_iff_nth_eq: |
|
24526 | 1624 |
"(xs = ys) = (length xs = length ys \<and> (ALL i<length xs. xs!i = ys!i))" |
1625 |
apply(induct xs arbitrary: ys) |
|
24632 | 1626 |
apply force |
18049 | 1627 |
apply(case_tac ys) |
1628 |
apply simp |
|
1629 |
apply(simp add:nth_Cons split:nat.split)apply blast |
|
1630 |
done |
|
1631 |
||
13142 | 1632 |
lemma set_conv_nth: "set xs = {xs!i | i. i < length xs}" |
15251 | 1633 |
apply (induct xs, simp, simp) |
13145 | 1634 |
apply safe |
24632 | 1635 |
apply (metis nat_case_0 nth.simps zero_less_Suc) |
1636 |
apply (metis less_Suc_eq_0_disj nth_Cons_Suc) |
|
14208 | 1637 |
apply (case_tac i, simp) |
24632 | 1638 |
apply (metis diff_Suc_Suc nat_case_Suc nth.simps zero_less_diff) |
13145 | 1639 |
done |
13114 | 1640 |
|
17501 | 1641 |
lemma in_set_conv_nth: "(x \<in> set xs) = (\<exists>i < length xs. xs!i = x)" |
1642 |
by(auto simp:set_conv_nth) |
|
1643 |
||
51160
599ff65b85e2
systematic conversions between nat and nibble/char;
haftmann
parents:
51112
diff
changeset
|
1644 |
lemma nth_equal_first_eq: |
599ff65b85e2
systematic conversions between nat and nibble/char;
haftmann
parents:
51112
diff
changeset
|
1645 |
assumes "x \<notin> set xs" |
599ff65b85e2
systematic conversions between nat and nibble/char;
haftmann
parents:
51112
diff
changeset
|
1646 |
assumes "n \<le> length xs" |
599ff65b85e2
systematic conversions between nat and nibble/char;
haftmann
parents:
51112
diff
changeset
|
1647 |
shows "(x # xs) ! n = x \<longleftrightarrow> n = 0" (is "?lhs \<longleftrightarrow> ?rhs") |
599ff65b85e2
systematic conversions between nat and nibble/char;
haftmann
parents:
51112
diff
changeset
|
1648 |
proof |
599ff65b85e2
systematic conversions between nat and nibble/char;
haftmann
parents:
51112
diff
changeset
|
1649 |
assume ?lhs |
599ff65b85e2
systematic conversions between nat and nibble/char;
haftmann
parents:
51112
diff
changeset
|
1650 |
show ?rhs |
599ff65b85e2
systematic conversions between nat and nibble/char;
haftmann
parents:
51112
diff
changeset
|
1651 |
proof (rule ccontr) |
599ff65b85e2
systematic conversions between nat and nibble/char;
haftmann
parents:
51112
diff
changeset
|
1652 |
assume "n \<noteq> 0" |
599ff65b85e2
systematic conversions between nat and nibble/char;
haftmann
parents:
51112
diff
changeset
|
1653 |
then have "n > 0" by simp |
599ff65b85e2
systematic conversions between nat and nibble/char;
haftmann
parents:
51112
diff
changeset
|
1654 |
with `?lhs` have "xs ! (n - 1) = x" by simp |
599ff65b85e2
systematic conversions between nat and nibble/char;
haftmann
parents:
51112
diff
changeset
|
1655 |
moreover from `n > 0` `n \<le> length xs` have "n - 1 < length xs" by simp |
599ff65b85e2
systematic conversions between nat and nibble/char;
haftmann
parents:
51112
diff
changeset
|
1656 |
ultimately have "\<exists>i<length xs. xs ! i = x" by auto |
599ff65b85e2
systematic conversions between nat and nibble/char;
haftmann
parents:
51112
diff
changeset
|
1657 |
with `x \<notin> set xs` in_set_conv_nth [of x xs] show False by simp |
599ff65b85e2
systematic conversions between nat and nibble/char;
haftmann
parents:
51112
diff
changeset
|
1658 |
qed |
599ff65b85e2
systematic conversions between nat and nibble/char;
haftmann
parents:
51112
diff
changeset
|
1659 |
next |
599ff65b85e2
systematic conversions between nat and nibble/char;
haftmann
parents:
51112
diff
changeset
|
1660 |
assume ?rhs then show ?lhs by simp |
599ff65b85e2
systematic conversions between nat and nibble/char;
haftmann
parents:
51112
diff
changeset
|
1661 |
qed |
599ff65b85e2
systematic conversions between nat and nibble/char;
haftmann
parents:
51112
diff
changeset
|
1662 |
|
599ff65b85e2
systematic conversions between nat and nibble/char;
haftmann
parents:
51112
diff
changeset
|
1663 |
lemma nth_non_equal_first_eq: |
599ff65b85e2
systematic conversions between nat and nibble/char;
haftmann
parents:
51112
diff
changeset
|
1664 |
assumes "x \<noteq> y" |
599ff65b85e2
systematic conversions between nat and nibble/char;
haftmann
parents:
51112
diff
changeset
|
1665 |
shows "(x # xs) ! n = y \<longleftrightarrow> xs ! (n - 1) = y \<and> n > 0" (is "?lhs \<longleftrightarrow> ?rhs") |
599ff65b85e2
systematic conversions between nat and nibble/char;
haftmann
parents:
51112
diff
changeset
|
1666 |
proof |
599ff65b85e2
systematic conversions between nat and nibble/char;
haftmann
parents:
51112
diff
changeset
|
1667 |
assume "?lhs" with assms have "n > 0" by (cases n) simp_all |
599ff65b85e2
systematic conversions between nat and nibble/char;
haftmann
parents:
51112
diff
changeset
|
1668 |
with `?lhs` show ?rhs by simp |
599ff65b85e2
systematic conversions between nat and nibble/char;
haftmann
parents:
51112
diff
changeset
|
1669 |
next |
599ff65b85e2
systematic conversions between nat and nibble/char;
haftmann
parents:
51112
diff
changeset
|
1670 |
assume "?rhs" then show "?lhs" by simp |
599ff65b85e2
systematic conversions between nat and nibble/char;
haftmann
parents:
51112
diff
changeset
|
1671 |
qed |
599ff65b85e2
systematic conversions between nat and nibble/char;
haftmann
parents:
51112
diff
changeset
|
1672 |
|
13145 | 1673 |
lemma list_ball_nth: "[| n < length xs; !x : set xs. P x|] ==> P(xs!n)" |
1674 |
by (auto simp add: set_conv_nth) |
|
13114 | 1675 |
|
13142 | 1676 |
lemma nth_mem [simp]: "n < length xs ==> xs!n : set xs" |
13145 | 1677 |
by (auto simp add: set_conv_nth) |
13114 | 1678 |
|
1679 |
lemma all_nth_imp_all_set: |
|
13145 | 1680 |
"[| !i < length xs. P(xs!i); x : set xs|] ==> P x" |
1681 |
by (auto simp add: set_conv_nth) |
|
13114 | 1682 |
|
1683 |
lemma all_set_conv_all_nth: |
|
13145 | 1684 |
"(\<forall>x \<in> set xs. P x) = (\<forall>i. i < length xs --> P (xs ! i))" |
1685 |
by (auto simp add: set_conv_nth) |
|
13114 | 1686 |
|
25296 | 1687 |
lemma rev_nth: |
1688 |
"n < size xs \<Longrightarrow> rev xs ! n = xs ! (length xs - Suc n)" |
|
1689 |
proof (induct xs arbitrary: n) |
|
1690 |
case Nil thus ?case by simp |
|
1691 |
next |
|
1692 |
case (Cons x xs) |
|
1693 |
hence n: "n < Suc (length xs)" by simp |
|
1694 |
moreover |
|
1695 |
{ assume "n < length xs" |
|
53374
a14d2a854c02
tuned proofs -- clarified flow of facts wrt. calculation;
wenzelm
parents:
53017
diff
changeset
|
1696 |
with n obtain n' where n': "length xs - n = Suc n'" |
25296 | 1697 |
by (cases "length xs - n", auto) |
1698 |
moreover |
|
53374
a14d2a854c02
tuned proofs -- clarified flow of facts wrt. calculation;
wenzelm
parents:
53017
diff
changeset
|
1699 |
from n' have "length xs - Suc n = n'" by simp |
25296 | 1700 |
ultimately |
1701 |
have "xs ! (length xs - Suc n) = (x # xs) ! (length xs - n)" by simp |
|
1702 |
} |
|
1703 |
ultimately |
|
1704 |
show ?case by (clarsimp simp add: Cons nth_append) |
|
1705 |
qed |
|
13114 | 1706 |
|
31159 | 1707 |
lemma Skolem_list_nth: |
1708 |
"(ALL i<k. EX x. P i x) = (EX xs. size xs = k & (ALL i<k. P i (xs!i)))" |
|
1709 |
(is "_ = (EX xs. ?P k xs)") |
|
1710 |
proof(induct k) |
|
1711 |
case 0 show ?case by simp |
|
1712 |
next |
|
1713 |
case (Suc k) |
|
1714 |
show ?case (is "?L = ?R" is "_ = (EX xs. ?P' xs)") |
|
1715 |
proof |
|
1716 |
assume "?R" thus "?L" using Suc by auto |
|
1717 |
next |
|
1718 |
assume "?L" |
|
1719 |
with Suc obtain x xs where "?P k xs & P k x" by (metis less_Suc_eq) |
|
1720 |
hence "?P'(xs@[x])" by(simp add:nth_append less_Suc_eq) |
|
1721 |
thus "?R" .. |
|
1722 |
qed |
|
1723 |
qed |
|
1724 |
||
1725 |
||
49948
744934b818c7
moved quite generic material from theory Enum to more appropriate places
haftmann
parents:
49808
diff
changeset
|
1726 |
subsubsection {* @{const list_update} *} |
13114 | 1727 |
|
24526 | 1728 |
lemma length_list_update [simp]: "length(xs[i:=x]) = length xs" |
1729 |
by (induct xs arbitrary: i) (auto split: nat.split) |
|
13114 | 1730 |
|
1731 |
lemma nth_list_update: |
|
24526 | 1732 |
"i < length xs==> (xs[i:=x])!j = (if i = j then x else xs!j)" |
1733 |
by (induct xs arbitrary: i j) (auto simp add: nth_Cons split: nat.split) |
|
13114 | 1734 |
|
13142 | 1735 |
lemma nth_list_update_eq [simp]: "i < length xs ==> (xs[i:=x])!i = x" |
13145 | 1736 |
by (simp add: nth_list_update) |
13114 | 1737 |
|
24526 | 1738 |
lemma nth_list_update_neq [simp]: "i \<noteq> j ==> xs[i:=x]!j = xs!j" |
1739 |
by (induct xs arbitrary: i j) (auto simp add: nth_Cons split: nat.split) |
|
13114 | 1740 |
|
24526 | 1741 |
lemma list_update_id[simp]: "xs[i := xs!i] = xs" |
1742 |
by (induct xs arbitrary: i) (simp_all split:nat.splits) |
|
1743 |
||
1744 |
lemma list_update_beyond[simp]: "length xs \<le> i \<Longrightarrow> xs[i:=x] = xs" |
|
1745 |
apply (induct xs arbitrary: i) |
|
17501 | 1746 |
apply simp |
1747 |
apply (case_tac i) |
|
1748 |
apply simp_all |
|
1749 |
done |
|
1750 |
||
31077 | 1751 |
lemma list_update_nonempty[simp]: "xs[k:=x] = [] \<longleftrightarrow> xs=[]" |
1752 |
by(metis length_0_conv length_list_update) |
|
1753 |
||
13114 | 1754 |
lemma list_update_same_conv: |
24526 | 1755 |
"i < length xs ==> (xs[i := x] = xs) = (xs!i = x)" |
1756 |
by (induct xs arbitrary: i) (auto split: nat.split) |
|
13114 | 1757 |
|
14187 | 1758 |
lemma list_update_append1: |
24526 | 1759 |
"i < size xs \<Longrightarrow> (xs @ ys)[i:=x] = xs[i:=x] @ ys" |
1760 |
apply (induct xs arbitrary: i, simp) |
|
14187 | 1761 |
apply(simp split:nat.split) |
1762 |
done |
|
1763 |
||
15868 | 1764 |
lemma list_update_append: |
24526 | 1765 |
"(xs @ ys) [n:= x] = |
15868 | 1766 |
(if n < length xs then xs[n:= x] @ ys else xs @ (ys [n-length xs:= x]))" |
24526 | 1767 |
by (induct xs arbitrary: n) (auto split:nat.splits) |
15868 | 1768 |
|
14402
4201e1916482
moved lemmas from MicroJava/Comp/AuxLemmas.thy to List.thy
nipkow
parents:
14395
diff
changeset
|
1769 |
lemma list_update_length [simp]: |
4201e1916482
moved lemmas from MicroJava/Comp/AuxLemmas.thy to List.thy
nipkow
parents:
14395
diff
changeset
|
1770 |
"(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
|
1771 |
by (induct xs, auto) |
4201e1916482
moved lemmas from MicroJava/Comp/AuxLemmas.thy to List.thy
nipkow
parents:
14395
diff
changeset
|
1772 |
|
31264 | 1773 |
lemma map_update: "map f (xs[k:= y]) = (map f xs)[k := f y]" |
1774 |
by(induct xs arbitrary: k)(auto split:nat.splits) |
|
1775 |
||
1776 |
lemma rev_update: |
|
1777 |
"k < length xs \<Longrightarrow> rev (xs[k:= y]) = (rev xs)[length xs - k - 1 := y]" |
|
1778 |
by (induct xs arbitrary: k) (auto simp: list_update_append split:nat.splits) |
|
1779 |
||
13114 | 1780 |
lemma update_zip: |
31080 | 1781 |
"(zip xs ys)[i:=xy] = zip (xs[i:=fst xy]) (ys[i:=snd xy])" |
24526 | 1782 |
by (induct ys arbitrary: i xy xs) (auto, case_tac xs, auto split: nat.split) |
1783 |
||
1784 |
lemma set_update_subset_insert: "set(xs[i:=x]) <= insert x (set xs)" |
|
1785 |
by (induct xs arbitrary: i) (auto split: nat.split) |
|
13114 | 1786 |
|
1787 |
lemma set_update_subsetI: "[| set xs <= A; x:A |] ==> set(xs[i := x]) <= A" |
|
13145 | 1788 |
by (blast dest!: set_update_subset_insert [THEN subsetD]) |
13114 | 1789 |
|
24526 | 1790 |
lemma set_update_memI: "n < length xs \<Longrightarrow> x \<in> set (xs[n := x])" |
1791 |
by (induct xs arbitrary: n) (auto split:nat.splits) |
|
15868 | 1792 |
|
31077 | 1793 |
lemma list_update_overwrite[simp]: |
24796 | 1794 |
"xs [i := x, i := y] = xs [i := y]" |
31077 | 1795 |
apply (induct xs arbitrary: i) apply simp |
1796 |
apply (case_tac i, simp_all) |
|
24796 | 1797 |
done |
1798 |
||
1799 |
lemma list_update_swap: |
|
1800 |
"i \<noteq> i' \<Longrightarrow> xs [i := x, i' := x'] = xs [i' := x', i := x]" |
|
1801 |
apply (induct xs arbitrary: i i') |
|
1802 |
apply simp |
|
1803 |
apply (case_tac i, case_tac i') |
|
1804 |
apply auto |
|
1805 |
apply (case_tac i') |
|
1806 |
apply auto |
|
1807 |
done |
|
1808 |
||
29827 | 1809 |
lemma list_update_code [code]: |
1810 |
"[][i := y] = []" |
|
1811 |
"(x # xs)[0 := y] = y # xs" |
|
1812 |
"(x # xs)[Suc i := y] = x # xs[i := y]" |
|
1813 |
by simp_all |
|
1814 |
||
13114 | 1815 |
|
49948
744934b818c7
moved quite generic material from theory Enum to more appropriate places
haftmann
parents:
49808
diff
changeset
|
1816 |
subsubsection {* @{const last} and @{const butlast} *} |
13114 | 1817 |
|
13142 | 1818 |
lemma last_snoc [simp]: "last (xs @ [x]) = x" |
13145 | 1819 |
by (induct xs) auto |
13114 | 1820 |
|
13142 | 1821 |
lemma butlast_snoc [simp]: "butlast (xs @ [x]) = xs" |
13145 | 1822 |
by (induct xs) auto |
13114 | 1823 |
|
14302 | 1824 |
lemma last_ConsL: "xs = [] \<Longrightarrow> last(x#xs) = x" |
44921 | 1825 |
by simp |
14302 | 1826 |
|
1827 |
lemma last_ConsR: "xs \<noteq> [] \<Longrightarrow> last(x#xs) = last xs" |
|
44921 | 1828 |
by simp |
14302 | 1829 |
|
1830 |
lemma last_append: "last(xs @ ys) = (if ys = [] then last xs else last ys)" |
|
1831 |
by (induct xs) (auto) |
|
1832 |
||
1833 |
lemma last_appendL[simp]: "ys = [] \<Longrightarrow> last(xs @ ys) = last xs" |
|
1834 |
by(simp add:last_append) |
|
1835 |
||
1836 |
lemma last_appendR[simp]: "ys \<noteq> [] \<Longrightarrow> last(xs @ ys) = last ys" |
|
1837 |
by(simp add:last_append) |
|
1838 |
||
45841 | 1839 |
lemma last_tl: "xs = [] \<or> tl xs \<noteq> [] \<Longrightarrow>last (tl xs) = last xs" |
1840 |
by (induct xs) simp_all |
|
1841 |
||
1842 |
lemma butlast_tl: "butlast (tl xs) = tl (butlast xs)" |
|
1843 |
by (induct xs) simp_all |
|
1844 |
||
17762 | 1845 |
lemma hd_rev: "xs \<noteq> [] \<Longrightarrow> hd(rev xs) = last xs" |
1846 |
by(rule rev_exhaust[of xs]) simp_all |
|
1847 |
||
1848 |
lemma last_rev: "xs \<noteq> [] \<Longrightarrow> last(rev xs) = hd xs" |
|
1849 |
by(cases xs) simp_all |
|
1850 |
||
17765 | 1851 |
lemma last_in_set[simp]: "as \<noteq> [] \<Longrightarrow> last as \<in> set as" |
1852 |
by (induct as) auto |
|
17762 | 1853 |
|
13142 | 1854 |
lemma length_butlast [simp]: "length (butlast xs) = length xs - 1" |
13145 | 1855 |
by (induct xs rule: rev_induct) auto |
13114 | 1856 |
|
1857 |
lemma butlast_append: |
|
24526 | 1858 |
"butlast (xs @ ys) = (if ys = [] then butlast xs else xs @ butlast ys)" |
1859 |
by (induct xs arbitrary: ys) auto |
|
13114 | 1860 |
|
13142 | 1861 |
lemma append_butlast_last_id [simp]: |
13145 | 1862 |
"xs \<noteq> [] ==> butlast xs @ [last xs] = xs" |
1863 |
by (induct xs) auto |
|
13114 | 1864 |
|
13142 | 1865 |
lemma in_set_butlastD: "x : set (butlast xs) ==> x : set xs" |
13145 | 1866 |
by (induct xs) (auto split: split_if_asm) |
13114 | 1867 |
|
1868 |
lemma in_set_butlast_appendI: |
|
13145 | 1869 |
"x : set (butlast xs) | x : set (butlast ys) ==> x : set (butlast (xs @ ys))" |
1870 |
by (auto dest: in_set_butlastD simp add: butlast_append) |
|
13114 | 1871 |
|
24526 | 1872 |
lemma last_drop[simp]: "n < length xs \<Longrightarrow> last (drop n xs) = last xs" |
1873 |
apply (induct xs arbitrary: n) |
|
17501 | 1874 |
apply simp |
1875 |
apply (auto split:nat.split) |
|
1876 |
done |
|
1877 |
||
45841 | 1878 |
lemma nth_butlast: |
1879 |
assumes "n < length (butlast xs)" shows "butlast xs ! n = xs ! n" |
|
1880 |
proof (cases xs) |
|
1881 |
case (Cons y ys) |
|
1882 |
moreover from assms have "butlast xs ! n = (butlast xs @ [last xs]) ! n" |
|
1883 |
by (simp add: nth_append) |
|
1884 |
ultimately show ?thesis using append_butlast_last_id by simp |
|
1885 |
qed simp |
|
1886 |
||
30128
365ee7319b86
revert some Suc 0 lemmas back to their original forms; added some simp rules for (1::nat)
huffman
parents:
30079
diff
changeset
|
1887 |
lemma last_conv_nth: "xs\<noteq>[] \<Longrightarrow> last xs = xs!(length xs - 1)" |
17589 | 1888 |
by(induct xs)(auto simp:neq_Nil_conv) |
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 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
|
1891 |
by (induct xs, simp, case_tac xs, simp_all) |
46f3b89b2445
move lemmas from Word/BinBoolList.thy to List.thy
huffman
parents:
26480
diff
changeset
|
1892 |
|
31077 | 1893 |
lemma last_list_update: |
1894 |
"xs \<noteq> [] \<Longrightarrow> last(xs[k:=x]) = (if k = size xs - 1 then x else last xs)" |
|
1895 |
by (auto simp: last_conv_nth) |
|
1896 |
||
1897 |
lemma butlast_list_update: |
|
1898 |
"butlast(xs[k:=x]) = |
|
1899 |
(if k = size xs - 1 then butlast xs else (butlast xs)[k:=x])" |
|
1900 |
apply(cases xs rule:rev_cases) |
|
1901 |
apply simp |
|
1902 |
apply(simp add:list_update_append split:nat.splits) |
|
1903 |
done |
|
1904 |
||
36851 | 1905 |
lemma last_map: |
1906 |
"xs \<noteq> [] \<Longrightarrow> last (map f xs) = f (last xs)" |
|
1907 |
by (cases xs rule: rev_cases) simp_all |
|
1908 |
||
1909 |
lemma map_butlast: |
|
1910 |
"map f (butlast xs) = butlast (map f xs)" |
|
1911 |
by (induct xs) simp_all |
|
1912 |
||
40230 | 1913 |
lemma snoc_eq_iff_butlast: |
1914 |
"xs @ [x] = ys \<longleftrightarrow> (ys \<noteq> [] & butlast ys = xs & last ys = x)" |
|
1915 |
by (metis append_butlast_last_id append_is_Nil_conv butlast_snoc last_snoc not_Cons_self) |
|
1916 |
||
24796 | 1917 |
|
49948
744934b818c7
moved quite generic material from theory Enum to more appropriate places
haftmann
parents:
49808
diff
changeset
|
1918 |
subsubsection {* @{const take} and @{const drop} *} |
13114 | 1919 |
|
13142 | 1920 |
lemma take_0 [simp]: "take 0 xs = []" |
13145 | 1921 |
by (induct xs) auto |
13114 | 1922 |
|
13142 | 1923 |
lemma drop_0 [simp]: "drop 0 xs = xs" |
13145 | 1924 |
by (induct xs) auto |
13114 | 1925 |
|
13142 | 1926 |
lemma take_Suc_Cons [simp]: "take (Suc n) (x # xs) = x # take n xs" |
13145 | 1927 |
by simp |
13114 | 1928 |
|
13142 | 1929 |
lemma drop_Suc_Cons [simp]: "drop (Suc n) (x # xs) = drop n xs" |
13145 | 1930 |
by simp |
13114 | 1931 |
|
13142 | 1932 |
declare take_Cons [simp del] and drop_Cons [simp del] |
13114 | 1933 |
|
30128
365ee7319b86
revert some Suc 0 lemmas back to their original forms; added some simp rules for (1::nat)
huffman
parents:
30079
diff
changeset
|
1934 |
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
|
1935 |
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
|
1936 |
|
365ee7319b86
revert some Suc 0 lemmas back to their original forms; added some simp rules for (1::nat)
huffman
parents:
30079
diff
changeset
|
1937 |
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
|
1938 |
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
|
1939 |
|
15110
78b5636eabc7
Added a number of new thms and the new function remove1
nipkow
parents:
15072
diff
changeset
|
1940 |
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
|
1941 |
by(clarsimp simp add:neq_Nil_conv) |
78b5636eabc7
Added a number of new thms and the new function remove1
nipkow
parents:
15072
diff
changeset
|
1942 |
|
14187 | 1943 |
lemma drop_Suc: "drop (Suc n) xs = drop n (tl xs)" |
1944 |
by(cases xs, simp_all) |
|
1945 |
||
26584
46f3b89b2445
move lemmas from Word/BinBoolList.thy to List.thy
huffman
parents:
26480
diff
changeset
|
1946 |
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
|
1947 |
by (induct xs arbitrary: n) simp_all |
46f3b89b2445
move lemmas from Word/BinBoolList.thy to List.thy
huffman
parents:
26480
diff
changeset
|
1948 |
|
24526 | 1949 |
lemma drop_tl: "drop n (tl xs) = tl(drop n xs)" |
1950 |
by(induct xs arbitrary: n, simp_all add:drop_Cons drop_Suc split:nat.split) |
|
1951 |
||
26584
46f3b89b2445
move lemmas from Word/BinBoolList.thy to List.thy
huffman
parents:
26480
diff
changeset
|
1952 |
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
|
1953 |
by (cases n, simp, cases xs, auto) |
46f3b89b2445
move lemmas from Word/BinBoolList.thy to List.thy
huffman
parents:
26480
diff
changeset
|
1954 |
|
46f3b89b2445
move lemmas from Word/BinBoolList.thy to List.thy
huffman
parents:
26480
diff
changeset
|
1955 |
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
|
1956 |
by (simp only: drop_tl) |
46f3b89b2445
move lemmas from Word/BinBoolList.thy to List.thy
huffman
parents:
26480
diff
changeset
|
1957 |
|
24526 | 1958 |
lemma nth_via_drop: "drop n xs = y#ys \<Longrightarrow> xs!n = y" |
1959 |
apply (induct xs arbitrary: n, simp) |
|
14187 | 1960 |
apply(simp add:drop_Cons nth_Cons split:nat.splits) |
1961 |
done |
|
1962 |
||
13913 | 1963 |
lemma take_Suc_conv_app_nth: |
24526 | 1964 |
"i < length xs \<Longrightarrow> take (Suc i) xs = take i xs @ [xs!i]" |
1965 |
apply (induct xs arbitrary: i, simp) |
|
14208 | 1966 |
apply (case_tac i, auto) |
13913 | 1967 |
done |
1968 |
||
14591 | 1969 |
lemma drop_Suc_conv_tl: |
24526 | 1970 |
"i < length xs \<Longrightarrow> (xs!i) # (drop (Suc i) xs) = drop i xs" |
1971 |
apply (induct xs arbitrary: i, simp) |
|
14591 | 1972 |
apply (case_tac i, auto) |
1973 |
done |
|
1974 |
||
24526 | 1975 |
lemma length_take [simp]: "length (take n xs) = min (length xs) n" |
1976 |
by (induct n arbitrary: xs) (auto, case_tac xs, auto) |
|
1977 |
||
1978 |
lemma length_drop [simp]: "length (drop n xs) = (length xs - n)" |
|
1979 |
by (induct n arbitrary: xs) (auto, case_tac xs, auto) |
|
1980 |
||
1981 |
lemma take_all [simp]: "length xs <= n ==> take n xs = xs" |
|
1982 |
by (induct n arbitrary: xs) (auto, case_tac xs, auto) |
|
1983 |
||
1984 |
lemma drop_all [simp]: "length xs <= n ==> drop n xs = []" |
|
1985 |
by (induct n arbitrary: xs) (auto, case_tac xs, auto) |
|
13114 | 1986 |
|
13142 | 1987 |
lemma take_append [simp]: |
24526 | 1988 |
"take n (xs @ ys) = (take n xs @ take (n - length xs) ys)" |
1989 |
by (induct n arbitrary: xs) (auto, case_tac xs, auto) |
|
13114 | 1990 |
|
13142 | 1991 |
lemma drop_append [simp]: |
24526 | 1992 |
"drop n (xs @ ys) = drop n xs @ drop (n - length xs) ys" |
1993 |
by (induct n arbitrary: xs) (auto, case_tac xs, auto) |
|
1994 |
||
1995 |
lemma take_take [simp]: "take n (take m xs) = take (min n m) xs" |
|
1996 |
apply (induct m arbitrary: xs n, auto) |
|
14208 | 1997 |
apply (case_tac xs, auto) |
15236
f289e8ba2bb3
Proofs needed to be updated because induction now preserves name of
nipkow
parents:
15176
diff
changeset
|
1998 |
apply (case_tac n, auto) |
13145 | 1999 |
done |
13114 | 2000 |
|
24526 | 2001 |
lemma drop_drop [simp]: "drop n (drop m xs) = drop (n + m) xs" |
2002 |
apply (induct m arbitrary: xs, auto) |
|
14208 | 2003 |
apply (case_tac xs, auto) |
13145 | 2004 |
done |
13114 | 2005 |
|
24526 | 2006 |
lemma take_drop: "take n (drop m xs) = drop m (take (n + m) xs)" |
2007 |
apply (induct m arbitrary: xs n, auto) |
|
14208 | 2008 |
apply (case_tac xs, auto) |
13145 | 2009 |
done |
13114 | 2010 |
|
24526 | 2011 |
lemma drop_take: "drop n (take m xs) = take (m-n) (drop n xs)" |
2012 |
apply(induct xs arbitrary: m n) |
|
14802 | 2013 |
apply simp |
2014 |
apply(simp add: take_Cons drop_Cons split:nat.split) |
|
2015 |
done |
|
2016 |
||
24526 | 2017 |
lemma append_take_drop_id [simp]: "take n xs @ drop n xs = xs" |
2018 |
apply (induct n arbitrary: xs, auto) |
|
14208 | 2019 |
apply (case_tac xs, auto) |
13145 | 2020 |
done |
13114 | 2021 |
|
24526 | 2022 |
lemma take_eq_Nil[simp]: "(take n xs = []) = (n = 0 \<or> xs = [])" |
2023 |
apply(induct xs arbitrary: n) |
|
15110
78b5636eabc7
Added a number of new thms and the new function remove1
nipkow
parents:
15072
diff
changeset
|
2024 |
apply simp |
78b5636eabc7
Added a number of new thms and the new function remove1
nipkow
parents:
15072
diff
changeset
|
2025 |
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
|
2026 |
done |
78b5636eabc7
Added a number of new thms and the new function remove1
nipkow
parents:
15072
diff
changeset
|
2027 |
|
24526 | 2028 |
lemma drop_eq_Nil[simp]: "(drop n xs = []) = (length xs <= n)" |
2029 |
apply(induct xs arbitrary: n) |
|
15110
78b5636eabc7
Added a number of new thms and the new function remove1
nipkow
parents:
15072
diff
changeset
|
2030 |
apply simp |
78b5636eabc7
Added a number of new thms and the new function remove1
nipkow
parents:
15072
diff
changeset
|
2031 |
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
|
2032 |
done |
78b5636eabc7
Added a number of new thms and the new function remove1
nipkow
parents:
15072
diff
changeset
|
2033 |
|
24526 | 2034 |
lemma take_map: "take n (map f xs) = map f (take n xs)" |
2035 |
apply (induct n arbitrary: xs, auto) |
|
14208 | 2036 |
apply (case_tac xs, auto) |
13145 | 2037 |
done |
13114 | 2038 |
|
24526 | 2039 |
lemma drop_map: "drop n (map f xs) = map f (drop n xs)" |
2040 |
apply (induct n arbitrary: xs, auto) |
|
14208 | 2041 |
apply (case_tac xs, auto) |
13145 | 2042 |
done |
13114 | 2043 |
|
24526 | 2044 |
lemma rev_take: "rev (take i xs) = drop (length xs - i) (rev xs)" |
2045 |
apply (induct xs arbitrary: i, auto) |
|
14208 | 2046 |
apply (case_tac i, auto) |
13145 | 2047 |
done |
13114 | 2048 |
|
24526 | 2049 |
lemma rev_drop: "rev (drop i xs) = take (length xs - i) (rev xs)" |
2050 |
apply (induct xs arbitrary: i, auto) |
|
14208 | 2051 |
apply (case_tac i, auto) |
13145 | 2052 |
done |
13114 | 2053 |
|
24526 | 2054 |
lemma nth_take [simp]: "i < n ==> (take n xs)!i = xs!i" |
2055 |
apply (induct xs arbitrary: i n, auto) |
|
14208 | 2056 |
apply (case_tac n, blast) |
2057 |
apply (case_tac i, auto) |
|
13145 | 2058 |
done |
13114 | 2059 |
|
13142 | 2060 |
lemma nth_drop [simp]: |
24526 | 2061 |
"n + i <= length xs ==> (drop n xs)!i = xs!(n + i)" |
2062 |
apply (induct n arbitrary: xs i, auto) |
|
14208 | 2063 |
apply (case_tac xs, auto) |
13145 | 2064 |
done |
3507 | 2065 |
|
26584
46f3b89b2445
move lemmas from Word/BinBoolList.thy to List.thy
huffman
parents:
26480
diff
changeset
|
2066 |
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
|
2067 |
"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
|
2068 |
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
|
2069 |
|
46f3b89b2445
move lemmas from Word/BinBoolList.thy to List.thy
huffman
parents:
26480
diff
changeset
|
2070 |
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
|
2071 |
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
|
2072 |
|
46f3b89b2445
move lemmas from Word/BinBoolList.thy to List.thy
huffman
parents:
26480
diff
changeset
|
2073 |
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
|
2074 |
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
|
2075 |
|
46f3b89b2445
move lemmas from Word/BinBoolList.thy to List.thy
huffman
parents:
26480
diff
changeset
|
2076 |
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
|
2077 |
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
|
2078 |
|
46500
0196966d6d2d
removing unnecessary premises in theorems of List theory
bulwahn
parents:
46448
diff
changeset
|
2079 |
lemma hd_drop_conv_nth: "n < length xs \<Longrightarrow> hd(drop n xs) = xs!n" |
18423 | 2080 |
by(simp add: hd_conv_nth) |
2081 |
||
35248 | 2082 |
lemma set_take_subset_set_take: |
2083 |
"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
|
2084 |
apply (induct xs arbitrary: m n) |
edbf0a86fb1c
adding simproc to rewrite list comprehensions to set comprehensions; adopting proofs
bulwahn
parents:
41372
diff
changeset
|
2085 |
apply simp |
edbf0a86fb1c
adding simproc to rewrite list comprehensions to set comprehensions; adopting proofs
bulwahn
parents:
41372
diff
changeset
|
2086 |
apply (case_tac n) |
edbf0a86fb1c
adding simproc to rewrite list comprehensions to set comprehensions; adopting proofs
bulwahn
parents:
41372
diff
changeset
|
2087 |
apply (auto simp: take_Cons) |
edbf0a86fb1c
adding simproc to rewrite list comprehensions to set comprehensions; adopting proofs
bulwahn
parents:
41372
diff
changeset
|
2088 |
done |
35248 | 2089 |
|
24526 | 2090 |
lemma set_take_subset: "set(take n xs) \<subseteq> set xs" |
2091 |
by(induct xs arbitrary: n)(auto simp:take_Cons split:nat.split) |
|
2092 |
||
2093 |
lemma set_drop_subset: "set(drop n xs) \<subseteq> set xs" |
|
2094 |
by(induct xs arbitrary: n)(auto simp:drop_Cons split:nat.split) |
|
14025 | 2095 |
|
35248 | 2096 |
lemma set_drop_subset_set_drop: |
2097 |
"m >= n \<Longrightarrow> set(drop m xs) <= set(drop n xs)" |
|
2098 |
apply(induct xs arbitrary: m n) |
|
2099 |
apply(auto simp:drop_Cons split:nat.split) |
|
2100 |
apply (metis set_drop_subset subset_iff) |
|
2101 |
done |
|
2102 |
||
14187 | 2103 |
lemma in_set_takeD: "x : set(take n xs) \<Longrightarrow> x : set xs" |
2104 |
using set_take_subset by fast |
|
2105 |
||
2106 |
lemma in_set_dropD: "x : set(drop n xs) \<Longrightarrow> x : set xs" |
|
2107 |
using set_drop_subset by fast |
|
2108 |
||
13114 | 2109 |
lemma append_eq_conv_conj: |
24526 | 2110 |
"(xs @ ys = zs) = (xs = take (length xs) zs \<and> ys = drop (length xs) zs)" |
2111 |
apply (induct xs arbitrary: zs, simp, clarsimp) |
|
14208 | 2112 |
apply (case_tac zs, auto) |
13145 | 2113 |
done |
13142 | 2114 |
|
24526 | 2115 |
lemma take_add: |
42713 | 2116 |
"take (i+j) xs = take i xs @ take j (drop i xs)" |
24526 | 2117 |
apply (induct xs arbitrary: i, auto) |
2118 |
apply (case_tac i, simp_all) |
|
14050 | 2119 |
done |
2120 |
||
14300 | 2121 |
lemma append_eq_append_conv_if: |
53015
a1119cf551e8
standardized symbols via "isabelle update_sub_sup", excluding src/Pure and src/Tools/WWW_Find;
wenzelm
parents:
52435
diff
changeset
|
2122 |
"(xs\<^sub>1 @ xs\<^sub>2 = ys\<^sub>1 @ ys\<^sub>2) = |
a1119cf551e8
standardized symbols via "isabelle update_sub_sup", excluding src/Pure and src/Tools/WWW_Find;
wenzelm
parents:
52435
diff
changeset
|
2123 |
(if size xs\<^sub>1 \<le> size ys\<^sub>1 |
a1119cf551e8
standardized symbols via "isabelle update_sub_sup", excluding src/Pure and src/Tools/WWW_Find;
wenzelm
parents:
52435
diff
changeset
|
2124 |
then xs\<^sub>1 = take (size xs\<^sub>1) ys\<^sub>1 \<and> xs\<^sub>2 = drop (size xs\<^sub>1) ys\<^sub>1 @ ys\<^sub>2 |
a1119cf551e8
standardized symbols via "isabelle update_sub_sup", excluding src/Pure and src/Tools/WWW_Find;
wenzelm
parents:
52435
diff
changeset
|
2125 |
else take (size ys\<^sub>1) xs\<^sub>1 = ys\<^sub>1 \<and> drop (size ys\<^sub>1) xs\<^sub>1 @ xs\<^sub>2 = ys\<^sub>2)" |
a1119cf551e8
standardized symbols via "isabelle update_sub_sup", excluding src/Pure and src/Tools/WWW_Find;
wenzelm
parents:
52435
diff
changeset
|
2126 |
apply(induct xs\<^sub>1 arbitrary: ys\<^sub>1) |
14300 | 2127 |
apply simp |
53015
a1119cf551e8
standardized symbols via "isabelle update_sub_sup", excluding src/Pure and src/Tools/WWW_Find;
wenzelm
parents:
52435
diff
changeset
|
2128 |
apply(case_tac ys\<^sub>1) |
14300 | 2129 |
apply simp_all |
2130 |
done |
|
2131 |
||
15110
78b5636eabc7
Added a number of new thms and the new function remove1
nipkow
parents:
15072
diff
changeset
|
2132 |
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
|
2133 |
"n < length xs \<Longrightarrow> take n xs @ [hd (drop n xs)] = take (Suc n) xs" |
24526 | 2134 |
apply(induct xs arbitrary: n) |
15110
78b5636eabc7
Added a number of new thms and the new function remove1
nipkow
parents:
15072
diff
changeset
|
2135 |
apply simp |
78b5636eabc7
Added a number of new thms and the new function remove1
nipkow
parents:
15072
diff
changeset
|
2136 |
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
|
2137 |
done |
78b5636eabc7
Added a number of new thms and the new function remove1
nipkow
parents:
15072
diff
changeset
|
2138 |
|
17501 | 2139 |
lemma id_take_nth_drop: |
2140 |
"i < length xs \<Longrightarrow> xs = take i xs @ xs!i # drop (Suc i) xs" |
|
2141 |
proof - |
|
2142 |
assume si: "i < length xs" |
|
2143 |
hence "xs = take (Suc i) xs @ drop (Suc i) xs" by auto |
|
2144 |
moreover |
|
2145 |
from si have "take (Suc i) xs = take i xs @ [xs!i]" |
|
2146 |
apply (rule_tac take_Suc_conv_app_nth) by arith |
|
2147 |
ultimately show ?thesis by auto |
|
2148 |
qed |
|
2149 |
||
2150 |
lemma upd_conv_take_nth_drop: |
|
2151 |
"i < length xs \<Longrightarrow> xs[i:=a] = take i xs @ a # drop (Suc i) xs" |
|
2152 |
proof - |
|
2153 |
assume i: "i < length xs" |
|
2154 |
have "xs[i:=a] = (take i xs @ xs!i # drop (Suc i) xs)[i:=a]" |
|
2155 |
by(rule arg_cong[OF id_take_nth_drop[OF i]]) |
|
2156 |
also have "\<dots> = take i xs @ a # drop (Suc i) xs" |
|
2157 |
using i by (simp add: list_update_append) |
|
2158 |
finally show ?thesis . |
|
2159 |
qed |
|
2160 |
||
24796 | 2161 |
lemma nth_drop': |
2162 |
"i < length xs \<Longrightarrow> xs ! i # drop (Suc i) xs = drop i xs" |
|
2163 |
apply (induct i arbitrary: xs) |
|
2164 |
apply (simp add: neq_Nil_conv) |
|
2165 |
apply (erule exE)+ |
|
2166 |
apply simp |
|
2167 |
apply (case_tac xs) |
|
2168 |
apply simp_all |
|
2169 |
done |
|
2170 |
||
13114 | 2171 |
|
49948
744934b818c7
moved quite generic material from theory Enum to more appropriate places
haftmann
parents:
49808
diff
changeset
|
2172 |
subsubsection {* @{const takeWhile} and @{const dropWhile} *} |
13114 | 2173 |
|
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
|
2174 |
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
|
2175 |
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
|
2176 |
|
13142 | 2177 |
lemma takeWhile_dropWhile_id [simp]: "takeWhile P xs @ dropWhile P xs = xs" |
13145 | 2178 |
by (induct xs) auto |
13114 | 2179 |
|
13142 | 2180 |
lemma takeWhile_append1 [simp]: |
13145 | 2181 |
"[| x:set xs; ~P(x)|] ==> takeWhile P (xs @ ys) = takeWhile P xs" |
2182 |
by (induct xs) auto |
|
13114 | 2183 |
|
13142 | 2184 |
lemma takeWhile_append2 [simp]: |
13145 | 2185 |
"(!!x. x : set xs ==> P x) ==> takeWhile P (xs @ ys) = xs @ takeWhile P ys" |
2186 |
by (induct xs) auto |
|
13114 | 2187 |
|
13142 | 2188 |
lemma takeWhile_tail: "\<not> P x ==> takeWhile P (xs @ (x#l)) = takeWhile P xs" |
13145 | 2189 |
by (induct xs) auto |
13114 | 2190 |
|
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
|
2191 |
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
|
2192 |
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
|
2193 |
|
603320b93668
New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents:
33593
diff
changeset
|
2194 |
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
|
2195 |
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
|
2196 |
|
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 |
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
|
2198 |
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
|
2199 |
|
13142 | 2200 |
lemma dropWhile_append1 [simp]: |
13145 | 2201 |
"[| x : set xs; ~P(x)|] ==> dropWhile P (xs @ ys) = (dropWhile P xs)@ys" |
2202 |
by (induct xs) auto |
|
13114 | 2203 |
|
13142 | 2204 |
lemma dropWhile_append2 [simp]: |
13145 | 2205 |
"(!!x. x:set xs ==> P(x)) ==> dropWhile P (xs @ ys) = dropWhile P ys" |
2206 |
by (induct xs) auto |
|
13114 | 2207 |
|
45841 | 2208 |
lemma dropWhile_append3: |
2209 |
"\<not> P y \<Longrightarrow>dropWhile P (xs @ y # ys) = dropWhile P xs @ y # ys" |
|
2210 |
by (induct xs) auto |
|
2211 |
||
2212 |
lemma dropWhile_last: |
|
2213 |
"x \<in> set xs \<Longrightarrow> \<not> P x \<Longrightarrow> last (dropWhile P xs) = last xs" |
|
2214 |
by (auto simp add: dropWhile_append3 in_set_conv_decomp) |
|
2215 |
||
2216 |
lemma set_dropWhileD: "x \<in> set (dropWhile P xs) \<Longrightarrow> x \<in> set xs" |
|
2217 |
by (induct xs) (auto split: split_if_asm) |
|
2218 |
||
23971
e6d505d5b03d
renamed lemma "set_take_whileD" to "set_takeWhileD"
krauss
parents:
23740
diff
changeset
|
2219 |
lemma set_takeWhileD: "x : set (takeWhile P xs) ==> x : set xs \<and> P x" |
13145 | 2220 |
by (induct xs) (auto split: split_if_asm) |
13114 | 2221 |
|
13913 | 2222 |
lemma takeWhile_eq_all_conv[simp]: |
2223 |
"(takeWhile P xs = xs) = (\<forall>x \<in> set xs. P x)" |
|
2224 |
by(induct xs, auto) |
|
2225 |
||
2226 |
lemma dropWhile_eq_Nil_conv[simp]: |
|
2227 |
"(dropWhile P xs = []) = (\<forall>x \<in> set xs. P x)" |
|
2228 |
by(induct xs, auto) |
|
2229 |
||
2230 |
lemma dropWhile_eq_Cons_conv: |
|
2231 |
"(dropWhile P xs = y#ys) = (xs = takeWhile P xs @ y # ys & \<not> P y)" |
|
2232 |
by(induct xs, auto) |
|
2233 |
||
31077 | 2234 |
lemma distinct_takeWhile[simp]: "distinct xs ==> distinct (takeWhile P xs)" |
2235 |
by (induct xs) (auto dest: set_takeWhileD) |
|
2236 |
||
2237 |
lemma distinct_dropWhile[simp]: "distinct xs ==> distinct (dropWhile P xs)" |
|
2238 |
by (induct xs) auto |
|
2239 |
||
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
|
2240 |
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
|
2241 |
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
|
2242 |
|
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 |
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
|
2244 |
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
|
2245 |
|
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 |
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
|
2247 |
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
|
2248 |
|
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 |
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
|
2250 |
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
|
2251 |
|
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 |
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
|
2253 |
"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
|
2254 |
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
|
2255 |
|
603320b93668
New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents:
33593
diff
changeset
|
2256 |
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
|
2257 |
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
|
2258 |
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
|
2259 |
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
|
2260 |
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
|
2261 |
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
|
2262 |
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
|
2263 |
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
|
2264 |
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
|
2265 |
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
|
2266 |
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
|
2267 |
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
|
2268 |
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
|
2269 |
|
603320b93668
New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents:
33593
diff
changeset
|
2270 |
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
|
2271 |
"\<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
|
2272 |
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
|
2273 |
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
|
2274 |
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
|
2275 |
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
|
2276 |
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
|
2277 |
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
|
2278 |
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
|
2279 |
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
|
2280 |
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
|
2281 |
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
|
2282 |
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
|
2283 |
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
|
2284 |
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
|
2285 |
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
|
2286 |
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
|
2287 |
|
603320b93668
New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents:
33593
diff
changeset
|
2288 |
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
|
2289 |
"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
|
2290 |
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
|
2291 |
|
603320b93668
New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents:
33593
diff
changeset
|
2292 |
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
|
2293 |
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
|
2294 |
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
|
2295 |
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
|
2296 |
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
|
2297 |
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
|
2298 |
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
|
2299 |
qed |
31077 | 2300 |
|
17501 | 2301 |
text{* The following two lemmmas could be generalized to an arbitrary |
2302 |
property. *} |
|
2303 |
||
2304 |
lemma takeWhile_neq_rev: "\<lbrakk>distinct xs; x \<in> set xs\<rbrakk> \<Longrightarrow> |
|
2305 |
takeWhile (\<lambda>y. y \<noteq> x) (rev xs) = rev (tl (dropWhile (\<lambda>y. y \<noteq> x) xs))" |
|
2306 |
by(induct xs) (auto simp: takeWhile_tail[where l="[]"]) |
|
2307 |
||
2308 |
lemma dropWhile_neq_rev: "\<lbrakk>distinct xs; x \<in> set xs\<rbrakk> \<Longrightarrow> |
|
2309 |
dropWhile (\<lambda>y. y \<noteq> x) (rev xs) = x # rev (takeWhile (\<lambda>y. y \<noteq> x) xs)" |
|
2310 |
apply(induct xs) |
|
2311 |
apply simp |
|
2312 |
apply auto |
|
2313 |
apply(subst dropWhile_append2) |
|
2314 |
apply auto |
|
2315 |
done |
|
2316 |
||
18423 | 2317 |
lemma takeWhile_not_last: |
46500
0196966d6d2d
removing unnecessary premises in theorems of List theory
bulwahn
parents:
46448
diff
changeset
|
2318 |
"distinct xs \<Longrightarrow> takeWhile (\<lambda>y. y \<noteq> last xs) xs = butlast xs" |
18423 | 2319 |
apply(induct xs) |
2320 |
apply simp |
|
2321 |
apply(case_tac xs) |
|
2322 |
apply(auto) |
|
2323 |
done |
|
2324 |
||
44013
5cfc1c36ae97
moved recdef package to HOL/Library/Old_Recdef.thy
krauss
parents:
43594
diff
changeset
|
2325 |
lemma takeWhile_cong [fundef_cong]: |
18336
1a2e30b37ed3
Added recdef congruence rules for bounded quantifiers and commonly used
krauss
parents:
18049
diff
changeset
|
2326 |
"[| 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
|
2327 |
==> takeWhile P l = takeWhile Q k" |
24349 | 2328 |
by (induct k arbitrary: l) (simp_all) |
18336
1a2e30b37ed3
Added recdef congruence rules for bounded quantifiers and commonly used
krauss
parents:
18049
diff
changeset
|
2329 |
|
44013
5cfc1c36ae97
moved recdef package to HOL/Library/Old_Recdef.thy
krauss
parents:
43594
diff
changeset
|
2330 |
lemma dropWhile_cong [fundef_cong]: |
18336
1a2e30b37ed3
Added recdef congruence rules for bounded quantifiers and commonly used
krauss
parents:
18049
diff
changeset
|
2331 |
"[| 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
|
2332 |
==> dropWhile P l = dropWhile Q k" |
24349 | 2333 |
by (induct k arbitrary: l, simp_all) |
18336
1a2e30b37ed3
Added recdef congruence rules for bounded quantifiers and commonly used
krauss
parents:
18049
diff
changeset
|
2334 |
|
52380 | 2335 |
lemma takeWhile_idem [simp]: |
2336 |
"takeWhile P (takeWhile P xs) = takeWhile P xs" |
|
2337 |
by (induct xs) auto |
|
2338 |
||
2339 |
lemma dropWhile_idem [simp]: |
|
2340 |
"dropWhile P (dropWhile P xs) = dropWhile P xs" |
|
2341 |
by (induct xs) auto |
|
2342 |
||
13114 | 2343 |
|
49948
744934b818c7
moved quite generic material from theory Enum to more appropriate places
haftmann
parents:
49808
diff
changeset
|
2344 |
subsubsection {* @{const zip} *} |
13114 | 2345 |
|
13142 | 2346 |
lemma zip_Nil [simp]: "zip [] ys = []" |
13145 | 2347 |
by (induct ys) auto |
13114 | 2348 |
|
13142 | 2349 |
lemma zip_Cons_Cons [simp]: "zip (x # xs) (y # ys) = (x, y) # zip xs ys" |
13145 | 2350 |
by simp |
13114 | 2351 |
|
13142 | 2352 |
declare zip_Cons [simp del] |
13114 | 2353 |
|
36198 | 2354 |
lemma [code]: |
2355 |
"zip [] ys = []" |
|
2356 |
"zip xs [] = []" |
|
2357 |
"zip (x # xs) (y # ys) = (x, y) # zip xs ys" |
|
2358 |
by (fact zip_Nil zip.simps(1) zip_Cons_Cons)+ |
|
2359 |
||
15281 | 2360 |
lemma zip_Cons1: |
2361 |
"zip (x#xs) ys = (case ys of [] \<Rightarrow> [] | y#ys \<Rightarrow> (x,y)#zip xs ys)" |
|
2362 |
by(auto split:list.split) |
|
2363 |
||
13142 | 2364 |
lemma length_zip [simp]: |
22493
db930e490fe5
added another rule for simultaneous induction, and lemmas for zip
krauss
parents:
22422
diff
changeset
|
2365 |
"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
|
2366 |
by (induct xs ys rule:list_induct2') auto |
13114 | 2367 |
|
34978
874150ddd50a
canonical insert operation; generalized lemma foldl_apply_inv to foldl_apply
haftmann
parents:
34942
diff
changeset
|
2368 |
lemma zip_obtain_same_length: |
874150ddd50a
canonical insert operation; generalized lemma foldl_apply_inv to foldl_apply
haftmann
parents:
34942
diff
changeset
|
2369 |
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
|
2370 |
\<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
|
2371 |
shows "P (zip xs ys)" |
874150ddd50a
canonical insert operation; generalized lemma foldl_apply_inv to foldl_apply
haftmann
parents:
34942
diff
changeset
|
2372 |
proof - |
874150ddd50a
canonical insert operation; generalized lemma foldl_apply_inv to foldl_apply
haftmann
parents:
34942
diff
changeset
|
2373 |
let ?n = "min (length xs) (length ys)" |
874150ddd50a
canonical insert operation; generalized lemma foldl_apply_inv to foldl_apply
haftmann
parents:
34942
diff
changeset
|
2374 |
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
|
2375 |
by (rule assms) simp_all |
874150ddd50a
canonical insert operation; generalized lemma foldl_apply_inv to foldl_apply
haftmann
parents:
34942
diff
changeset
|
2376 |
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
|
2377 |
proof (induct xs arbitrary: ys) |
874150ddd50a
canonical insert operation; generalized lemma foldl_apply_inv to foldl_apply
haftmann
parents:
34942
diff
changeset
|
2378 |
case Nil then show ?case by simp |
874150ddd50a
canonical insert operation; generalized lemma foldl_apply_inv to foldl_apply
haftmann
parents:
34942
diff
changeset
|
2379 |
next |
874150ddd50a
canonical insert operation; generalized lemma foldl_apply_inv to foldl_apply
haftmann
parents:
34942
diff
changeset
|
2380 |
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
|
2381 |
qed |
874150ddd50a
canonical insert operation; generalized lemma foldl_apply_inv to foldl_apply
haftmann
parents:
34942
diff
changeset
|
2382 |
ultimately show ?thesis by simp |
874150ddd50a
canonical insert operation; generalized lemma foldl_apply_inv to foldl_apply
haftmann
parents:
34942
diff
changeset
|
2383 |
qed |
874150ddd50a
canonical insert operation; generalized lemma foldl_apply_inv to foldl_apply
haftmann
parents:
34942
diff
changeset
|
2384 |
|
13114 | 2385 |
lemma zip_append1: |
22493
db930e490fe5
added another rule for simultaneous induction, and lemmas for zip
krauss
parents:
22422
diff
changeset
|
2386 |
"zip (xs @ ys) zs = |
13145 | 2387 |
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
|
2388 |
by (induct xs zs rule:list_induct2') auto |
13114 | 2389 |
|
2390 |
lemma zip_append2: |
|
22493
db930e490fe5
added another rule for simultaneous induction, and lemmas for zip
krauss
parents:
22422
diff
changeset
|
2391 |
"zip xs (ys @ zs) = |
13145 | 2392 |
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
|
2393 |
by (induct xs ys rule:list_induct2') auto |
13114 | 2394 |
|
13142 | 2395 |
lemma zip_append [simp]: |
46500
0196966d6d2d
removing unnecessary premises in theorems of List theory
bulwahn
parents:
46448
diff
changeset
|
2396 |
"[| length xs = length us |] ==> |
13145 | 2397 |
zip (xs@ys) (us@vs) = zip xs us @ zip ys vs" |
2398 |
by (simp add: zip_append1) |
|
13114 | 2399 |
|
2400 |
lemma zip_rev: |
|
14247 | 2401 |
"length xs = length ys ==> zip (rev xs) (rev ys) = rev (zip xs ys)" |
2402 |
by (induct rule:list_induct2, simp_all) |
|
13114 | 2403 |
|
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
|
2404 |
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
|
2405 |
"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
|
2406 |
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
|
2407 |
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
|
2408 |
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
|
2409 |
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
|
2410 |
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
|
2411 |
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
|
2412 |
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
|
2413 |
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
|
2414 |
|
603320b93668
New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents:
33593
diff
changeset
|
2415 |
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
|
2416 |
"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
|
2417 |
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
|
2418 |
|
603320b93668
New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents:
33593
diff
changeset
|
2419 |
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
|
2420 |
"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
|
2421 |
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
|
2422 |
|
23096 | 2423 |
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
|
2424 |
"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
|
2425 |
unfolding zip_map1 by auto |
23096 | 2426 |
|
2427 |
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
|
2428 |
"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
|
2429 |
unfolding zip_map2 by auto |
23096 | 2430 |
|
31080 | 2431 |
text{* Courtesy of Andreas Lochbihler: *} |
2432 |
lemma zip_same_conv_map: "zip xs xs = map (\<lambda>x. (x, x)) xs" |
|
2433 |
by(induct xs) auto |
|
2434 |
||
13142 | 2435 |
lemma nth_zip [simp]: |
24526 | 2436 |
"[| i < length xs; i < length ys|] ==> (zip xs ys)!i = (xs!i, ys!i)" |
2437 |
apply (induct ys arbitrary: i xs, simp) |
|
13145 | 2438 |
apply (case_tac xs) |
2439 |
apply (simp_all add: nth.simps split: nat.split) |
|
2440 |
done |
|
13114 | 2441 |
|
2442 |
lemma set_zip: |
|
13145 | 2443 |
"set (zip xs ys) = {(xs!i, ys!i) | i. i < min (length xs) (length ys)}" |
31080 | 2444 |
by(simp add: set_conv_nth cong: rev_conj_cong) |
13114 | 2445 |
|
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
|
2446 |
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
|
2447 |
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
|
2448 |
|
13114 | 2449 |
lemma zip_update: |
31080 | 2450 |
"zip (xs[i:=x]) (ys[i:=y]) = (zip xs ys)[i:=(x,y)]" |
2451 |
by(rule sym, simp add: update_zip) |
|
13114 | 2452 |
|
13142 | 2453 |
lemma zip_replicate [simp]: |
24526 | 2454 |
"zip (replicate i x) (replicate j y) = replicate (min i j) (x,y)" |
2455 |
apply (induct i arbitrary: j, auto) |
|
14208 | 2456 |
apply (case_tac j, auto) |
13145 | 2457 |
done |
13114 | 2458 |
|
19487 | 2459 |
lemma take_zip: |
24526 | 2460 |
"take n (zip xs ys) = zip (take n xs) (take n ys)" |
2461 |
apply (induct n arbitrary: xs ys) |
|
19487 | 2462 |
apply simp |
2463 |
apply (case_tac xs, simp) |
|
2464 |
apply (case_tac ys, simp_all) |
|
2465 |
done |
|
2466 |
||
2467 |
lemma drop_zip: |
|
24526 | 2468 |
"drop n (zip xs ys) = zip (drop n xs) (drop n ys)" |
2469 |
apply (induct n arbitrary: xs ys) |
|
19487 | 2470 |
apply simp |
2471 |
apply (case_tac xs, simp) |
|
2472 |
apply (case_tac ys, simp_all) |
|
2473 |
done |
|
2474 |
||
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
|
2475 |
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
|
2476 |
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
|
2477 |
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
|
2478 |
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
|
2479 |
|
603320b93668
New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents:
33593
diff
changeset
|
2480 |
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
|
2481 |
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
|
2482 |
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
|
2483 |
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
|
2484 |
|
22493
db930e490fe5
added another rule for simultaneous induction, and lemmas for zip
krauss
parents:
22422
diff
changeset
|
2485 |
lemma set_zip_leftD: |
db930e490fe5
added another rule for simultaneous induction, and lemmas for zip
krauss
parents:
22422
diff
changeset
|
2486 |
"(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
|
2487 |
by (induct xs ys rule:list_induct2') auto |
db930e490fe5
added another rule for simultaneous induction, and lemmas for zip
krauss
parents:
22422
diff
changeset
|
2488 |
|
db930e490fe5
added another rule for simultaneous induction, and lemmas for zip
krauss
parents:
22422
diff
changeset
|
2489 |
lemma set_zip_rightD: |
db930e490fe5
added another rule for simultaneous induction, and lemmas for zip
krauss
parents:
22422
diff
changeset
|
2490 |
"(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
|
2491 |
by (induct xs ys rule:list_induct2') auto |
13142 | 2492 |
|
23983 | 2493 |
lemma in_set_zipE: |
2494 |
"(x,y) : set(zip xs ys) \<Longrightarrow> (\<lbrakk> x : set xs; y : set ys \<rbrakk> \<Longrightarrow> R) \<Longrightarrow> R" |
|
2495 |
by(blast dest: set_zip_leftD set_zip_rightD) |
|
2496 |
||
29829 | 2497 |
lemma zip_map_fst_snd: |
2498 |
"zip (map fst zs) (map snd zs) = zs" |
|
2499 |
by (induct zs) simp_all |
|
2500 |
||
2501 |
lemma zip_eq_conv: |
|
2502 |
"length xs = length ys \<Longrightarrow> zip xs ys = zs \<longleftrightarrow> map fst zs = xs \<and> map snd zs = ys" |
|
2503 |
by (auto simp add: zip_map_fst_snd) |
|
2504 |
||
51173 | 2505 |
lemma in_set_zip: |
2506 |
"p \<in> set (zip xs ys) \<longleftrightarrow> (\<exists>n. xs ! n = fst p \<and> ys ! n = snd p |
|
2507 |
\<and> n < length xs \<and> n < length ys)" |
|
2508 |
by (cases p) (auto simp add: set_zip) |
|
2509 |
||
2510 |
lemma pair_list_eqI: |
|
2511 |
assumes "map fst xs = map fst ys" and "map snd xs = map snd ys" |
|
2512 |
shows "xs = ys" |
|
2513 |
proof - |
|
2514 |
from assms(1) have "length xs = length ys" by (rule map_eq_imp_length_eq) |
|
2515 |
from this assms show ?thesis |
|
2516 |
by (induct xs ys rule: list_induct2) (simp_all add: prod_eqI) |
|
2517 |
qed |
|
2518 |
||
35115 | 2519 |
|
49948
744934b818c7
moved quite generic material from theory Enum to more appropriate places
haftmann
parents:
49808
diff
changeset
|
2520 |
subsubsection {* @{const list_all2} *} |
13114 | 2521 |
|
14316
91b897b9a2dc
added some [intro?] and [trans] for list_all2 lemmas
kleing
parents:
14302
diff
changeset
|
2522 |
lemma list_all2_lengthD [intro?]: |
91b897b9a2dc
added some [intro?] and [trans] for list_all2 lemmas
kleing
parents:
14302
diff
changeset
|
2523 |
"list_all2 P xs ys ==> length xs = length ys" |
24349 | 2524 |
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
|
2525 |
|
19787 | 2526 |
lemma list_all2_Nil [iff, code]: "list_all2 P [] ys = (ys = [])" |
24349 | 2527 |
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
|
2528 |
|
19787 | 2529 |
lemma list_all2_Nil2 [iff, code]: "list_all2 P xs [] = (xs = [])" |
24349 | 2530 |
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
|
2531 |
|
07eeb832f28d
introduced characters for code generator; some improved code lemmas for some list functions
haftmann
parents:
19585
diff
changeset
|
2532 |
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
|
2533 |
"list_all2 P (x # xs) (y # ys) = (P x y \<and> list_all2 P xs ys)" |
24349 | 2534 |
by (auto simp add: list_all2_def) |
13114 | 2535 |
|
2536 |
lemma list_all2_Cons1: |
|
13145 | 2537 |
"list_all2 P (x # xs) ys = (\<exists>z zs. ys = z # zs \<and> P x z \<and> list_all2 P xs zs)" |
2538 |
by (cases ys) auto |
|
13114 | 2539 |
|
2540 |
lemma list_all2_Cons2: |
|
13145 | 2541 |
"list_all2 P xs (y # ys) = (\<exists>z zs. xs = z # zs \<and> P z y \<and> list_all2 P zs ys)" |
2542 |
by (cases xs) auto |
|
13114 | 2543 |
|
45794 | 2544 |
lemma list_all2_induct |
2545 |
[consumes 1, case_names Nil Cons, induct set: list_all2]: |
|
2546 |
assumes P: "list_all2 P xs ys" |
|
2547 |
assumes Nil: "R [] []" |
|
47640 | 2548 |
assumes Cons: "\<And>x xs y ys. |
2549 |
\<lbrakk>P x y; list_all2 P xs ys; R xs ys\<rbrakk> \<Longrightarrow> R (x # xs) (y # ys)" |
|
45794 | 2550 |
shows "R xs ys" |
2551 |
using P |
|
2552 |
by (induct xs arbitrary: ys) (auto simp add: list_all2_Cons1 Nil Cons) |
|
2553 |
||
13142 | 2554 |
lemma list_all2_rev [iff]: |
13145 | 2555 |
"list_all2 P (rev xs) (rev ys) = list_all2 P xs ys" |
2556 |
by (simp add: list_all2_def zip_rev cong: conj_cong) |
|
13114 | 2557 |
|
13863 | 2558 |
lemma list_all2_rev1: |
2559 |
"list_all2 P (rev xs) ys = list_all2 P xs (rev ys)" |
|
2560 |
by (subst list_all2_rev [symmetric]) simp |
|
2561 |
||
13114 | 2562 |
lemma list_all2_append1: |
13145 | 2563 |
"list_all2 P (xs @ ys) zs = |
2564 |
(EX us vs. zs = us @ vs \<and> length us = length xs \<and> length vs = length ys \<and> |
|
2565 |
list_all2 P xs us \<and> list_all2 P ys vs)" |
|
2566 |
apply (simp add: list_all2_def zip_append1) |
|
2567 |
apply (rule iffI) |
|
2568 |
apply (rule_tac x = "take (length xs) zs" in exI) |
|
2569 |
apply (rule_tac x = "drop (length xs) zs" in exI) |
|
14208 | 2570 |
apply (force split: nat_diff_split simp add: min_def, clarify) |
13145 | 2571 |
apply (simp add: ball_Un) |
2572 |
done |
|
13114 | 2573 |
|
2574 |
lemma list_all2_append2: |
|
13145 | 2575 |
"list_all2 P xs (ys @ zs) = |
2576 |
(EX us vs. xs = us @ vs \<and> length us = length ys \<and> length vs = length zs \<and> |
|
2577 |
list_all2 P us ys \<and> list_all2 P vs zs)" |
|
2578 |
apply (simp add: list_all2_def zip_append2) |
|
2579 |
apply (rule iffI) |
|
2580 |
apply (rule_tac x = "take (length ys) xs" in exI) |
|
2581 |
apply (rule_tac x = "drop (length ys) xs" in exI) |
|
14208 | 2582 |
apply (force split: nat_diff_split simp add: min_def, clarify) |
13145 | 2583 |
apply (simp add: ball_Un) |
2584 |
done |
|
13114 | 2585 |
|
13863 | 2586 |
lemma list_all2_append: |
14247 | 2587 |
"length xs = length ys \<Longrightarrow> |
2588 |
list_all2 P (xs@us) (ys@vs) = (list_all2 P xs ys \<and> list_all2 P us vs)" |
|
2589 |
by (induct rule:list_induct2, simp_all) |
|
13863 | 2590 |
|
2591 |
lemma list_all2_appendI [intro?, trans]: |
|
2592 |
"\<lbrakk> list_all2 P a b; list_all2 P c d \<rbrakk> \<Longrightarrow> list_all2 P (a@c) (b@d)" |
|
24349 | 2593 |
by (simp add: list_all2_append list_all2_lengthD) |
13863 | 2594 |
|
13114 | 2595 |
lemma list_all2_conv_all_nth: |
13145 | 2596 |
"list_all2 P xs ys = |
2597 |
(length xs = length ys \<and> (\<forall>i < length xs. P (xs!i) (ys!i)))" |
|
2598 |
by (force simp add: list_all2_def set_zip) |
|
13114 | 2599 |
|
13883
0451e0fb3f22
Re-structured some proofs in order to get rid of rule_format attribute.
berghofe
parents:
13863
diff
changeset
|
2600 |
lemma list_all2_trans: |
0451e0fb3f22
Re-structured some proofs in order to get rid of rule_format attribute.
berghofe
parents:
13863
diff
changeset
|
2601 |
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
|
2602 |
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
|
2603 |
(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
|
2604 |
proof (induct as) |
0451e0fb3f22
Re-structured some proofs in order to get rid of rule_format attribute.
berghofe
parents:
13863
diff
changeset
|
2605 |
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
|
2606 |
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
|
2607 |
proof (induct bs) |
0451e0fb3f22
Re-structured some proofs in order to get rid of rule_format attribute.
berghofe
parents:
13863
diff
changeset
|
2608 |
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
|
2609 |
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
|
2610 |
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
|
2611 |
qed simp |
0451e0fb3f22
Re-structured some proofs in order to get rid of rule_format attribute.
berghofe
parents:
13863
diff
changeset
|
2612 |
qed simp |
0451e0fb3f22
Re-structured some proofs in order to get rid of rule_format attribute.
berghofe
parents:
13863
diff
changeset
|
2613 |
|
13863 | 2614 |
lemma list_all2_all_nthI [intro?]: |
2615 |
"length a = length b \<Longrightarrow> (\<And>n. n < length a \<Longrightarrow> P (a!n) (b!n)) \<Longrightarrow> list_all2 P a b" |
|
24349 | 2616 |
by (simp add: list_all2_conv_all_nth) |
13863 | 2617 |
|
14395 | 2618 |
lemma list_all2I: |
2619 |
"\<forall>x \<in> set (zip a b). split P x \<Longrightarrow> length a = length b \<Longrightarrow> list_all2 P a b" |
|
24349 | 2620 |
by (simp add: list_all2_def) |
14395 | 2621 |
|
14328 | 2622 |
lemma list_all2_nthD: |
13863 | 2623 |
"\<lbrakk> list_all2 P xs ys; p < size xs \<rbrakk> \<Longrightarrow> P (xs!p) (ys!p)" |
24349 | 2624 |
by (simp add: list_all2_conv_all_nth) |
13863 | 2625 |
|
14302 | 2626 |
lemma list_all2_nthD2: |
2627 |
"\<lbrakk>list_all2 P xs ys; p < size ys\<rbrakk> \<Longrightarrow> P (xs!p) (ys!p)" |
|
24349 | 2628 |
by (frule list_all2_lengthD) (auto intro: list_all2_nthD) |
14302 | 2629 |
|
13863 | 2630 |
lemma list_all2_map1: |
2631 |
"list_all2 P (map f as) bs = list_all2 (\<lambda>x y. P (f x) y) as bs" |
|
24349 | 2632 |
by (simp add: list_all2_conv_all_nth) |
13863 | 2633 |
|
2634 |
lemma list_all2_map2: |
|
2635 |
"list_all2 P as (map f bs) = list_all2 (\<lambda>x y. P x (f y)) as bs" |
|
24349 | 2636 |
by (auto simp add: list_all2_conv_all_nth) |
13863 | 2637 |
|
14316
91b897b9a2dc
added some [intro?] and [trans] for list_all2 lemmas
kleing
parents:
14302
diff
changeset
|
2638 |
lemma list_all2_refl [intro?]: |
13863 | 2639 |
"(\<And>x. P x x) \<Longrightarrow> list_all2 P xs xs" |
24349 | 2640 |
by (simp add: list_all2_conv_all_nth) |
13863 | 2641 |
|
2642 |
lemma list_all2_update_cong: |
|
46669
c1d2ab32174a
one general list_all2_update_cong instead of two special ones
bulwahn
parents:
46664
diff
changeset
|
2643 |
"\<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
|
2644 |
by (cases "i < length ys") (auto simp add: list_all2_conv_all_nth nth_list_update) |
13863 | 2645 |
|
14302 | 2646 |
lemma list_all2_takeI [simp,intro?]: |
24526 | 2647 |
"list_all2 P xs ys \<Longrightarrow> list_all2 P (take n xs) (take n ys)" |
2648 |
apply (induct xs arbitrary: n ys) |
|
2649 |
apply simp |
|
2650 |
apply (clarsimp simp add: list_all2_Cons1) |
|
2651 |
apply (case_tac n) |
|
2652 |
apply auto |
|
2653 |
done |
|
14302 | 2654 |
|
2655 |
lemma list_all2_dropI [simp,intro?]: |
|
24526 | 2656 |
"list_all2 P as bs \<Longrightarrow> list_all2 P (drop n as) (drop n bs)" |
2657 |
apply (induct as arbitrary: n bs, simp) |
|
2658 |
apply (clarsimp simp add: list_all2_Cons1) |
|
2659 |
apply (case_tac n, simp, simp) |
|
2660 |
done |
|
13863 | 2661 |
|
14327 | 2662 |
lemma list_all2_mono [intro?]: |
24526 | 2663 |
"list_all2 P xs ys \<Longrightarrow> (\<And>xs ys. P xs ys \<Longrightarrow> Q xs ys) \<Longrightarrow> list_all2 Q xs ys" |
2664 |
apply (induct xs arbitrary: ys, simp) |
|
2665 |
apply (case_tac ys, auto) |
|
2666 |
done |
|
13863 | 2667 |
|
22551 | 2668 |
lemma list_all2_eq: |
2669 |
"xs = ys \<longleftrightarrow> list_all2 (op =) xs ys" |
|
24349 | 2670 |
by (induct xs ys rule: list_induct2') auto |
22551 | 2671 |
|
40230 | 2672 |
lemma list_eq_iff_zip_eq: |
2673 |
"xs = ys \<longleftrightarrow> length xs = length ys \<and> (\<forall>(x,y) \<in> set (zip xs ys). x = y)" |
|
2674 |
by(auto simp add: set_zip list_all2_eq list_all2_conv_all_nth cong: conj_cong) |
|
2675 |
||
13142 | 2676 |
|
53721
ccaceea6c768
added two functions to List (one contributed by Manuel Eberl)
traytel
parents:
53689
diff
changeset
|
2677 |
subsubsection {* @{const List.product} and @{const product_lists} *} |
49948
744934b818c7
moved quite generic material from theory Enum to more appropriate places
haftmann
parents:
49808
diff
changeset
|
2678 |
|
744934b818c7
moved quite generic material from theory Enum to more appropriate places
haftmann
parents:
49808
diff
changeset
|
2679 |
lemma product_list_set: |
744934b818c7
moved quite generic material from theory Enum to more appropriate places
haftmann
parents:
49808
diff
changeset
|
2680 |
"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
|
2681 |
by (induct xs) auto |
744934b818c7
moved quite generic material from theory Enum to more appropriate places
haftmann
parents:
49808
diff
changeset
|
2682 |
|
51160
599ff65b85e2
systematic conversions between nat and nibble/char;
haftmann
parents:
51112
diff
changeset
|
2683 |
lemma length_product [simp]: |
599ff65b85e2
systematic conversions between nat and nibble/char;
haftmann
parents:
51112
diff
changeset
|
2684 |
"length (List.product xs ys) = length xs * length ys" |
599ff65b85e2
systematic conversions between nat and nibble/char;
haftmann
parents:
51112
diff
changeset
|
2685 |
by (induct xs) simp_all |
599ff65b85e2
systematic conversions between nat and nibble/char;
haftmann
parents:
51112
diff
changeset
|
2686 |
|
599ff65b85e2
systematic conversions between nat and nibble/char;
haftmann
parents:
51112
diff
changeset
|
2687 |
lemma product_nth: |
599ff65b85e2
systematic conversions between nat and nibble/char;
haftmann
parents:
51112
diff
changeset
|
2688 |
assumes "n < length xs * length ys" |
599ff65b85e2
systematic conversions between nat and nibble/char;
haftmann
parents:
51112
diff
changeset
|
2689 |
shows "List.product xs ys ! n = (xs ! (n div length ys), ys ! (n mod length ys))" |
599ff65b85e2
systematic conversions between nat and nibble/char;
haftmann
parents:
51112
diff
changeset
|
2690 |
using assms proof (induct xs arbitrary: n) |
599ff65b85e2
systematic conversions between nat and nibble/char;
haftmann
parents:
51112
diff
changeset
|
2691 |
case Nil then show ?case by simp |
599ff65b85e2
systematic conversions between nat and nibble/char;
haftmann
parents:
51112
diff
changeset
|
2692 |
next |
599ff65b85e2
systematic conversions between nat and nibble/char;
haftmann
parents:
51112
diff
changeset
|
2693 |
case (Cons x xs n) |
599ff65b85e2
systematic conversions between nat and nibble/char;
haftmann
parents:
51112
diff
changeset
|
2694 |
then have "length ys > 0" by auto |
599ff65b85e2
systematic conversions between nat and nibble/char;
haftmann
parents:
51112
diff
changeset
|
2695 |
with Cons show ?case |
599ff65b85e2
systematic conversions between nat and nibble/char;
haftmann
parents:
51112
diff
changeset
|
2696 |
by (auto simp add: nth_append not_less le_mod_geq le_div_geq) |
599ff65b85e2
systematic conversions between nat and nibble/char;
haftmann
parents:
51112
diff
changeset
|
2697 |
qed |
599ff65b85e2
systematic conversions between nat and nibble/char;
haftmann
parents:
51112
diff
changeset
|
2698 |
|
53721
ccaceea6c768
added two functions to List (one contributed by Manuel Eberl)
traytel
parents:
53689
diff
changeset
|
2699 |
lemma in_set_product_lists_length: |
ccaceea6c768
added two functions to List (one contributed by Manuel Eberl)
traytel
parents:
53689
diff
changeset
|
2700 |
"xs \<in> set (product_lists xss) \<Longrightarrow> length xs = length xss" |
ccaceea6c768
added two functions to List (one contributed by Manuel Eberl)
traytel
parents:
53689
diff
changeset
|
2701 |
by (induct xss arbitrary: xs) auto |
ccaceea6c768
added two functions to List (one contributed by Manuel Eberl)
traytel
parents:
53689
diff
changeset
|
2702 |
|
ccaceea6c768
added two functions to List (one contributed by Manuel Eberl)
traytel
parents:
53689
diff
changeset
|
2703 |
lemma product_lists_set: |
ccaceea6c768
added two functions to List (one contributed by Manuel Eberl)
traytel
parents:
53689
diff
changeset
|
2704 |
"set (product_lists xss) = {xs. list_all2 (\<lambda>x ys. x \<in> set ys) xs xss}" (is "?L = Collect ?R") |
ccaceea6c768
added two functions to List (one contributed by Manuel Eberl)
traytel
parents:
53689
diff
changeset
|
2705 |
proof (intro equalityI subsetI, unfold mem_Collect_eq) |
ccaceea6c768
added two functions to List (one contributed by Manuel Eberl)
traytel
parents:
53689
diff
changeset
|
2706 |
fix xs assume "xs \<in> ?L" |
ccaceea6c768
added two functions to List (one contributed by Manuel Eberl)
traytel
parents:
53689
diff
changeset
|
2707 |
then have "length xs = length xss" by (rule in_set_product_lists_length) |
ccaceea6c768
added two functions to List (one contributed by Manuel Eberl)
traytel
parents:
53689
diff
changeset
|
2708 |
from this `xs \<in> ?L` show "?R xs" by (induct xs xss rule: list_induct2) auto |
ccaceea6c768
added two functions to List (one contributed by Manuel Eberl)
traytel
parents:
53689
diff
changeset
|
2709 |
next |
ccaceea6c768
added two functions to List (one contributed by Manuel Eberl)
traytel
parents:
53689
diff
changeset
|
2710 |
fix xs assume "?R xs" |
ccaceea6c768
added two functions to List (one contributed by Manuel Eberl)
traytel
parents:
53689
diff
changeset
|
2711 |
then show "xs \<in> ?L" by induct auto |
ccaceea6c768
added two functions to List (one contributed by Manuel Eberl)
traytel
parents:
53689
diff
changeset
|
2712 |
qed |
ccaceea6c768
added two functions to List (one contributed by Manuel Eberl)
traytel
parents:
53689
diff
changeset
|
2713 |
|
49948
744934b818c7
moved quite generic material from theory Enum to more appropriate places
haftmann
parents:
49808
diff
changeset
|
2714 |
|
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
|
2715 |
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
|
2716 |
|
48828
441a4eed7823
prefer eta-expanded code equations for fold, to accomodate tail recursion optimisation in Scala
haftmann
parents:
48619
diff
changeset
|
2717 |
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
|
2718 |
"fold f [] s = s" |
441a4eed7823
prefer eta-expanded code equations for fold, to accomodate tail recursion optimisation in Scala
haftmann
parents:
48619
diff
changeset
|
2719 |
"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
|
2720 |
by simp_all |
441a4eed7823
prefer eta-expanded code equations for fold, to accomodate tail recursion optimisation in Scala
haftmann
parents:
48619
diff
changeset
|
2721 |
|
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
|
2722 |
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
|
2723 |
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
|
2724 |
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
|
2725 |
shows "fold f xs = fold f (remove1 x xs) \<circ> f x" |
49739 | 2726 |
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
|
2727 |
|
d9fe85d3d2cd
incorporated canonical fold combinator on lists into body of List theory; refactored passages on List.fold(l/r)
haftmann
parents:
46125
diff
changeset
|
2728 |
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
|
2729 |
"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
|
2730 |
\<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
|
2731 |
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
|
2732 |
|
d9fe85d3d2cd
incorporated canonical fold combinator on lists into body of List theory; refactored passages on List.fold(l/r)
haftmann
parents:
46125
diff
changeset
|
2733 |
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
|
2734 |
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
|
2735 |
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
|
2736 |
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
|
2737 |
|
d9fe85d3d2cd
incorporated canonical fold combinator on lists into body of List theory; refactored passages on List.fold(l/r)
haftmann
parents:
46125
diff
changeset
|
2738 |
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
|
2739 |
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
|
2740 |
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
|
2741 |
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
|
2742 |
|
d9fe85d3d2cd
incorporated canonical fold combinator on lists into body of List theory; refactored passages on List.fold(l/r)
haftmann
parents:
46125
diff
changeset
|
2743 |
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
|
2744 |
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
|
2745 |
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
|
2746 |
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
|
2747 |
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
|
2748 |
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
|
2749 |
qed |
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
2750 |
|
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
|
2751 |
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
|
2752 |
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
|
2753 |
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
|
2754 |
shows "P (fold f xs s)" |
34978
874150ddd50a
canonical insert operation; generalized lemma foldl_apply_inv to foldl_apply
haftmann
parents:
34942
diff
changeset
|
2755 |
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
|
2756 |
|
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
|
2757 |
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
|
2758 |
"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
|
2759 |
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
|
2760 |
|
d9fe85d3d2cd
incorporated canonical fold combinator on lists into body of List theory; refactored passages on List.fold(l/r)
haftmann
parents:
46125
diff
changeset
|
2761 |
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
|
2762 |
"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
|
2763 |
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
|
2764 |
|
d9fe85d3d2cd
incorporated canonical fold combinator on lists into body of List theory; refactored passages on List.fold(l/r)
haftmann
parents:
46125
diff
changeset
|
2765 |
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
|
2766 |
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
|
2767 |
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
|
2768 |
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
|
2769 |
|
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 |
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
|
2771 |
"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
|
2772 |
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
|
2773 |
|
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 |
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
|
2775 |
"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
|
2776 |
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
|
2777 |
|
d9fe85d3d2cd
incorporated canonical fold combinator on lists into body of List theory; refactored passages on List.fold(l/r)
haftmann
parents:
46125
diff
changeset
|
2778 |
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
|
2779 |
"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
|
2780 |
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
|
2781 |
|
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 |
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
|
2783 |
|
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 |
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
|
2785 |
"Finite_Set.fold f y (set xs) = fold f (remdups xs) y" |
51489 | 2786 |
by (rule sym, induct xs arbitrary: y) (simp_all add: fold_fun_left_comm insert_absorb) |
48619 | 2787 |
|
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
|
2788 |
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
|
2789 |
"Finite_Set.fold f y (set xs) = fold f xs y" |
51489 | 2790 |
by (rule sym, induct xs arbitrary: y) (simp_all add: fold_fun_left_comm) |
32681
adeac3cbb659
lemma relating fold1 and foldl; code_unfold rules for Inf_fin, Sup_fin, Min, Max, Inf, Sup
haftmann
parents:
32422
diff
changeset
|
2791 |
|
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
|
2792 |
lemma union_set_fold [code]: |
46147
2c4d8de91c4c
moved lemmas about List.set and set operations to List theory
haftmann
parents:
46143
diff
changeset
|
2793 |
"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
|
2794 |
proof - |
2c4d8de91c4c
moved lemmas about List.set and set operations to List theory
haftmann
parents:
46143
diff
changeset
|
2795 |
interpret comp_fun_idem Set.insert |
2c4d8de91c4c
moved lemmas about List.set and set operations to List theory
haftmann
parents:
46143
diff
changeset
|
2796 |
by (fact comp_fun_idem_insert) |
2c4d8de91c4c
moved lemmas about List.set and set operations to List theory
haftmann
parents:
46143
diff
changeset
|
2797 |
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
|
2798 |
qed |
2c4d8de91c4c
moved lemmas about List.set and set operations to List theory
haftmann
parents:
46143
diff
changeset
|
2799 |
|
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
|
2800 |
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
|
2801 |
"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
|
2802 |
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
|
2803 |
|
d654c73e4b12
no preference wrt. fold(l/r); prefer fold rather than foldr for iterating over lists in generated code
haftmann
parents:
47131
diff
changeset
|
2804 |
lemma minus_set_fold [code]: |
46147
2c4d8de91c4c
moved lemmas about List.set and set operations to List theory
haftmann
parents:
46143
diff
changeset
|
2805 |
"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
|
2806 |
proof - |
2c4d8de91c4c
moved lemmas about List.set and set operations to List theory
haftmann
parents:
46143
diff
changeset
|
2807 |
interpret comp_fun_idem Set.remove |
2c4d8de91c4c
moved lemmas about List.set and set operations to List theory
haftmann
parents:
46143
diff
changeset
|
2808 |
by (fact comp_fun_idem_remove) |
2c4d8de91c4c
moved lemmas about List.set and set operations to List theory
haftmann
parents:
46143
diff
changeset
|
2809 |
show ?thesis |
2c4d8de91c4c
moved lemmas about List.set and set operations to List theory
haftmann
parents:
46143
diff
changeset
|
2810 |
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
|
2811 |
qed |
2c4d8de91c4c
moved lemmas about List.set and set operations to List theory
haftmann
parents:
46143
diff
changeset
|
2812 |
|
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
|
2813 |
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
|
2814 |
"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
|
2815 |
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
|
2816 |
|
d654c73e4b12
no preference wrt. fold(l/r); prefer fold rather than foldr for iterating over lists in generated code
haftmann
parents:
47131
diff
changeset
|
2817 |
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
|
2818 |
"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
|
2819 |
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
|
2820 |
|
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 |
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
|
2822 |
"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
|
2823 |
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
|
2824 |
|
51489 | 2825 |
lemma (in semilattice_set) set_eq_fold: |
2826 |
"F (set (x # xs)) = fold f xs x" |
|
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
|
2827 |
proof - |
51489 | 2828 |
interpret comp_fun_idem f |
2829 |
by default (simp_all add: fun_eq_iff left_commute) |
|
2830 |
show ?thesis by (simp add: eq_fold fold_set_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
|
2831 |
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
|
2832 |
|
51489 | 2833 |
declare Inf_fin.set_eq_fold [code] |
2834 |
declare Sup_fin.set_eq_fold [code] |
|
51540
eea5c4ca4a0e
explicit sublocale dependency for Min/Max yields more appropriate Min/Max prefix for a couple of facts
haftmann
parents:
51489
diff
changeset
|
2835 |
declare Min.set_eq_fold [code] |
eea5c4ca4a0e
explicit sublocale dependency for Min/Max yields more appropriate Min/Max prefix for a couple of facts
haftmann
parents:
51489
diff
changeset
|
2836 |
declare Max.set_eq_fold [code] |
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
|
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) 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
|
2839 |
"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
|
2840 |
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
|
2841 |
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
|
2842 |
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
|
2843 |
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
|
2844 |
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
|
2845 |
|
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
|
2846 |
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
|
2847 |
|
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
|
2848 |
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
|
2849 |
"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
|
2850 |
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
|
2851 |
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
|
2852 |
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
|
2853 |
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
|
2854 |
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
|
2855 |
|
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
|
2856 |
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
|
2857 |
|
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 |
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
|
2859 |
"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
|
2860 |
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
|
2861 |
|
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
|
2862 |
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
|
2863 |
|
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 |
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
|
2865 |
"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
|
2866 |
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
|
2867 |
|
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 |
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
|
2869 |
|
49948
744934b818c7
moved quite generic material from theory Enum to more appropriate places
haftmann
parents:
49808
diff
changeset
|
2870 |
|
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
|
2871 |
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
|
2872 |
|
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 |
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
|
2874 |
|
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
|
2875 |
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
|
2876 |
"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
|
2877 |
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
|
2878 |
|
d654c73e4b12
no preference wrt. fold(l/r); prefer fold rather than foldr for iterating over lists in generated code
haftmann
parents:
47131
diff
changeset
|
2879 |
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
|
2880 |
"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
|
2881 |
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
|
2882 |
|
d654c73e4b12
no preference wrt. fold(l/r); prefer fold rather than foldr for iterating over lists in generated code
haftmann
parents:
47131
diff
changeset
|
2883 |
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
|
2884 |
"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
|
2885 |
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
|
2886 |
|
d654c73e4b12
no preference wrt. fold(l/r); prefer fold rather than foldr for iterating over lists in generated code
haftmann
parents:
47131
diff
changeset
|
2887 |
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
|
2888 |
"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
|
2889 |
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
|
2890 |
|
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 |
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
|
2892 |
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
|
2893 |
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
|
2894 |
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
|
2895 |
|
d9fe85d3d2cd
incorporated canonical fold combinator on lists into body of List theory; refactored passages on List.fold(l/r)
haftmann
parents:
46125
diff
changeset
|
2896 |
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
|
2897 |
"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
|
2898 |
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
|
2899 |
|
d9fe85d3d2cd
incorporated canonical fold combinator on lists into body of List theory; refactored passages on List.fold(l/r)
haftmann
parents:
46125
diff
changeset
|
2900 |
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
|
2901 |
"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
|
2902 |
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
|
2903 |
|
d9fe85d3d2cd
incorporated canonical fold combinator on lists into body of List theory; refactored passages on List.fold(l/r)
haftmann
parents:
46125
diff
changeset
|
2904 |
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
|
2905 |
"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
|
2906 |
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
|
2907 |
|
d9fe85d3d2cd
incorporated canonical fold combinator on lists into body of List theory; refactored passages on List.fold(l/r)
haftmann
parents:
46125
diff
changeset
|
2908 |
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
|
2909 |
"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
|
2910 |
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
|
2911 |
|
d9fe85d3d2cd
incorporated canonical fold combinator on lists into body of List theory; refactored passages on List.fold(l/r)
haftmann
parents:
46125
diff
changeset
|
2912 |
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
|
2913 |
"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
|
2914 |
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
|
2915 |
|
d9fe85d3d2cd
incorporated canonical fold combinator on lists into body of List theory; refactored passages on List.fold(l/r)
haftmann
parents:
46125
diff
changeset
|
2916 |
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
|
2917 |
"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
|
2918 |
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
|
2919 |
|
d9fe85d3d2cd
incorporated canonical fold combinator on lists into body of List theory; refactored passages on List.fold(l/r)
haftmann
parents:
46125
diff
changeset
|
2920 |
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
|
2921 |
"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
|
2922 |
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
|
2923 |
|
35115 | 2924 |
|
49948
744934b818c7
moved quite generic material from theory Enum to more appropriate places
haftmann
parents:
49808
diff
changeset
|
2925 |
subsubsection {* @{const upt} *} |
13114 | 2926 |
|
17090 | 2927 |
lemma upt_rec[code]: "[i..<j] = (if i<j then i#[Suc i..<j] else [])" |
2928 |
-- {* simp does not terminate! *} |
|
13145 | 2929 |
by (induct j) auto |
13142 | 2930 |
|
47108
2a1953f0d20d
merged fork with new numeral representation (see NEWS)
huffman
parents:
46898
diff
changeset
|
2931 |
lemmas upt_rec_numeral[simp] = upt_rec[of "numeral m" "numeral n"] for m n |
32005 | 2932 |
|
15425 | 2933 |
lemma upt_conv_Nil [simp]: "j <= i ==> [i..<j] = []" |
13145 | 2934 |
by (subst upt_rec) simp |
13114 | 2935 |
|
15425 | 2936 |
lemma upt_eq_Nil_conv[simp]: "([i..<j] = []) = (j = 0 \<or> j <= i)" |
15281 | 2937 |
by(induct j)simp_all |
2938 |
||
2939 |
lemma upt_eq_Cons_conv: |
|
24526 | 2940 |
"([i..<j] = x#xs) = (i < j & i = x & [i+1..<j] = xs)" |
2941 |
apply(induct j arbitrary: x xs) |
|
15281 | 2942 |
apply simp |
2943 |
apply(clarsimp simp add: append_eq_Cons_conv) |
|
2944 |
apply arith |
|
2945 |
done |
|
2946 |
||
15425 | 2947 |
lemma upt_Suc_append: "i <= j ==> [i..<(Suc j)] = [i..<j]@[j]" |
13145 | 2948 |
-- {* Only needed if @{text upt_Suc} is deleted from the simpset. *} |
2949 |
by simp |
|
13114 | 2950 |
|
15425 | 2951 |
lemma upt_conv_Cons: "i < j ==> [i..<j] = i # [Suc i..<j]" |
26734 | 2952 |
by (simp add: upt_rec) |
13114 | 2953 |
|
15425 | 2954 |
lemma upt_add_eq_append: "i<=j ==> [i..<j+k] = [i..<j]@[j..<j+k]" |
13145 | 2955 |
-- {* LOOPS as a simprule, since @{text "j <= j"}. *} |
2956 |
by (induct k) auto |
|
13114 | 2957 |
|
15425 | 2958 |
lemma length_upt [simp]: "length [i..<j] = j - i" |
13145 | 2959 |
by (induct j) (auto simp add: Suc_diff_le) |
13114 | 2960 |
|
15425 | 2961 |
lemma nth_upt [simp]: "i + k < j ==> [i..<j] ! k = i + k" |
13145 | 2962 |
apply (induct j) |
2963 |
apply (auto simp add: less_Suc_eq nth_append split: nat_diff_split) |
|
2964 |
done |
|
13114 | 2965 |
|
17906 | 2966 |
|
2967 |
lemma hd_upt[simp]: "i < j \<Longrightarrow> hd[i..<j] = i" |
|
2968 |
by(simp add:upt_conv_Cons) |
|
2969 |
||
2970 |
lemma last_upt[simp]: "i < j \<Longrightarrow> last[i..<j] = j - 1" |
|
2971 |
apply(cases j) |
|
2972 |
apply simp |
|
2973 |
by(simp add:upt_Suc_append) |
|
2974 |
||
24526 | 2975 |
lemma take_upt [simp]: "i+m <= n ==> take m [i..<n] = [i..<i+m]" |
2976 |
apply (induct m arbitrary: i, simp) |
|
13145 | 2977 |
apply (subst upt_rec) |
2978 |
apply (rule sym) |
|
2979 |
apply (subst upt_rec) |
|
2980 |
apply (simp del: upt.simps) |
|
2981 |
done |
|
3507 | 2982 |
|
17501 | 2983 |
lemma drop_upt[simp]: "drop m [i..<j] = [i+m..<j]" |
2984 |
apply(induct j) |
|
2985 |
apply auto |
|
2986 |
done |
|
2987 |
||
24645 | 2988 |
lemma map_Suc_upt: "map Suc [m..<n] = [Suc m..<Suc n]" |
13145 | 2989 |
by (induct n) auto |
13114 | 2990 |
|
54496
178922b63b58
add lemmas Suc_funpow and id_funpow to simpset; add lemma map_add_upt
hoelzl
parents:
54404
diff
changeset
|
2991 |
lemma map_add_upt: "map (\<lambda>i. i + n) [0..<m] = [n..<m + n]" |
178922b63b58
add lemmas Suc_funpow and id_funpow to simpset; add lemma map_add_upt
hoelzl
parents:
54404
diff
changeset
|
2992 |
by (induct m) simp_all |
178922b63b58
add lemmas Suc_funpow and id_funpow to simpset; add lemma map_add_upt
hoelzl
parents:
54404
diff
changeset
|
2993 |
|
24526 | 2994 |
lemma nth_map_upt: "i < n-m ==> (map f [m..<n]) ! i = f(m+i)" |
2995 |
apply (induct n m arbitrary: i rule: diff_induct) |
|
13145 | 2996 |
prefer 3 apply (subst map_Suc_upt[symmetric]) |
44921 | 2997 |
apply (auto simp add: less_diff_conv) |
13145 | 2998 |
done |
13114 | 2999 |
|
52380 | 3000 |
lemma map_decr_upt: |
3001 |
"map (\<lambda>n. n - Suc 0) [Suc m..<Suc n] = [m..<n]" |
|
3002 |
by (induct n) simp_all |
|
3003 |
||
13883
0451e0fb3f22
Re-structured some proofs in order to get rid of rule_format attribute.
berghofe
parents:
13863
diff
changeset
|
3004 |
lemma nth_take_lemma: |
24526 | 3005 |
"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
|
3006 |
(!!i. i < k --> xs!i = ys!i) ==> take k xs = take k ys" |
24526 | 3007 |
apply (atomize, induct k arbitrary: xs ys) |
14208 | 3008 |
apply (simp_all add: less_Suc_eq_0_disj all_conj_distrib, clarify) |
13145 | 3009 |
txt {* Both lists must be non-empty *} |
14208 | 3010 |
apply (case_tac xs, simp) |
3011 |
apply (case_tac ys, clarify) |
|
13145 | 3012 |
apply (simp (no_asm_use)) |
3013 |
apply clarify |
|
3014 |
txt {* prenexing's needed, not miniscoping *} |
|
3015 |
apply (simp (no_asm_use) add: all_simps [symmetric] del: all_simps) |
|
3016 |
apply blast |
|
3017 |
done |
|
13114 | 3018 |
|
3019 |
lemma nth_equalityI: |
|
3020 |
"[| length xs = length ys; ALL i < length xs. xs!i = ys!i |] ==> xs = ys" |
|
44921 | 3021 |
by (frule nth_take_lemma [OF le_refl eq_imp_le]) simp_all |
13142 | 3022 |
|
24796 | 3023 |
lemma map_nth: |
3024 |
"map (\<lambda>i. xs ! i) [0..<length xs] = xs" |
|
3025 |
by (rule nth_equalityI, auto) |
|
3026 |
||
13863 | 3027 |
(* needs nth_equalityI *) |
3028 |
lemma list_all2_antisym: |
|
3029 |
"\<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> |
|
3030 |
\<Longrightarrow> xs = ys" |
|
3031 |
apply (simp add: list_all2_conv_all_nth) |
|
14208 | 3032 |
apply (rule nth_equalityI, blast, simp) |
13863 | 3033 |
done |
3034 |
||
13142 | 3035 |
lemma take_equalityI: "(\<forall>i. take i xs = take i ys) ==> xs = ys" |
13145 | 3036 |
-- {* The famous take-lemma. *} |
3037 |
apply (drule_tac x = "max (length xs) (length ys)" in spec) |
|
44921 | 3038 |
apply (simp add: le_max_iff_disj) |
13145 | 3039 |
done |
13142 | 3040 |
|
3041 |
||
15302 | 3042 |
lemma take_Cons': |
3043 |
"take n (x # xs) = (if n = 0 then [] else x # take (n - 1) xs)" |
|
3044 |
by (cases n) simp_all |
|
3045 |
||
3046 |
lemma drop_Cons': |
|
3047 |
"drop n (x # xs) = (if n = 0 then x # xs else drop (n - 1) xs)" |
|
3048 |
by (cases n) simp_all |
|
3049 |
||
3050 |
lemma nth_Cons': "(x # xs)!n = (if n = 0 then x else xs!(n - 1))" |
|
3051 |
by (cases n) simp_all |
|
3052 |
||
47108
2a1953f0d20d
merged fork with new numeral representation (see NEWS)
huffman
parents:
46898
diff
changeset
|
3053 |
lemma take_Cons_numeral [simp]: |
2a1953f0d20d
merged fork with new numeral representation (see NEWS)
huffman
parents:
46898
diff
changeset
|
3054 |
"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
|
3055 |
by (simp add: take_Cons') |
2a1953f0d20d
merged fork with new numeral representation (see NEWS)
huffman
parents:
46898
diff
changeset
|
3056 |
|
2a1953f0d20d
merged fork with new numeral representation (see NEWS)
huffman
parents:
46898
diff
changeset
|
3057 |
lemma drop_Cons_numeral [simp]: |
2a1953f0d20d
merged fork with new numeral representation (see NEWS)
huffman
parents:
46898
diff
changeset
|
3058 |
"drop (numeral v) (x # xs) = drop (numeral v - 1) xs" |
2a1953f0d20d
merged fork with new numeral representation (see NEWS)
huffman
parents:
46898
diff
changeset
|
3059 |
by (simp add: drop_Cons') |
2a1953f0d20d
merged fork with new numeral representation (see NEWS)
huffman
parents:
46898
diff
changeset
|
3060 |
|
2a1953f0d20d
merged fork with new numeral representation (see NEWS)
huffman
parents:
46898
diff
changeset
|
3061 |
lemma nth_Cons_numeral [simp]: |
2a1953f0d20d
merged fork with new numeral representation (see NEWS)
huffman
parents:
46898
diff
changeset
|
3062 |
"(x # xs) ! numeral v = xs ! (numeral v - 1)" |
2a1953f0d20d
merged fork with new numeral representation (see NEWS)
huffman
parents:
46898
diff
changeset
|
3063 |
by (simp add: nth_Cons') |
15302 | 3064 |
|
3065 |
||
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
|
3066 |
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
|
3067 |
|
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
|
3068 |
function upto :: "int \<Rightarrow> int \<Rightarrow> int list" ("(1[_../_])") where |
51166 | 3069 |
"upto i j = (if i \<le> j then i # [i+1..j] else [])" |
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
|
3070 |
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
|
3071 |
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
|
3072 |
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
|
3073 |
|
51166 | 3074 |
declare upto.simps[simp del] |
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
|
3075 |
|
47108
2a1953f0d20d
merged fork with new numeral representation (see NEWS)
huffman
parents:
46898
diff
changeset
|
3076 |
lemmas upto_rec_numeral [simp] = |
2a1953f0d20d
merged fork with new numeral representation (see NEWS)
huffman
parents:
46898
diff
changeset
|
3077 |
upto.simps[of "numeral m" "numeral n"] |
54489
03ff4d1e6784
eliminiated neg_numeral in favour of - (numeral _)
haftmann
parents:
54404
diff
changeset
|
3078 |
upto.simps[of "numeral m" "- numeral n"] |
03ff4d1e6784
eliminiated neg_numeral in favour of - (numeral _)
haftmann
parents:
54404
diff
changeset
|
3079 |
upto.simps[of "- numeral m" "numeral n"] |
03ff4d1e6784
eliminiated neg_numeral in favour of - (numeral _)
haftmann
parents:
54404
diff
changeset
|
3080 |
upto.simps[of "- numeral m" "- 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
|
3081 |
|
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
|
3082 |
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
|
3083 |
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
|
3084 |
|
51166 | 3085 |
lemma upto_rec1: "i \<le> j \<Longrightarrow> [i..j] = i#[i+1..j]" |
3086 |
by(simp add: upto.simps) |
|
3087 |
||
3088 |
lemma upto_rec2: "i \<le> j \<Longrightarrow> [i..j] = [i..j - 1]@[j]" |
|
3089 |
proof(induct "nat(j-i)" arbitrary: i j) |
|
3090 |
case 0 thus ?case by(simp add: upto.simps) |
|
3091 |
next |
|
3092 |
case (Suc n) |
|
3093 |
hence "n = nat (j - (i + 1))" "i < j" by linarith+ |
|
3094 |
from this(2) Suc.hyps(1)[OF this(1)] Suc(2,3) upto_rec1 show ?case by simp |
|
3095 |
qed |
|
3096 |
||
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
|
3097 |
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
|
3098 |
proof(induct i j rule:upto.induct) |
edbf0a86fb1c
adding simproc to rewrite list comprehensions to set comprehensions; adopting proofs
bulwahn
parents:
41372
diff
changeset
|
3099 |
case (1 i j) |
edbf0a86fb1c
adding simproc to rewrite list comprehensions to set comprehensions; adopting proofs
bulwahn
parents:
41372
diff
changeset
|
3100 |
from this show ?case |
edbf0a86fb1c
adding simproc to rewrite list comprehensions to set comprehensions; adopting proofs
bulwahn
parents:
41372
diff
changeset
|
3101 |
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
|
3102 |
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
|
3103 |
|
51166 | 3104 |
text{* Tail recursive version for code generation: *} |
3105 |
||
51170 | 3106 |
definition upto_aux :: "int \<Rightarrow> int \<Rightarrow> int list \<Rightarrow> int list" where |
3107 |
"upto_aux i j js = [i..j] @ js" |
|
3108 |
||
3109 |
lemma upto_aux_rec [code]: |
|
51166 | 3110 |
"upto_aux i j js = (if j<i then js else upto_aux i (j - 1) (j#js))" |
51170 | 3111 |
by (simp add: upto_aux_def upto_rec2) |
51166 | 3112 |
|
3113 |
lemma upto_code[code]: "[i..j] = upto_aux i j []" |
|
51170 | 3114 |
by(simp add: upto_aux_def) |
51166 | 3115 |
|
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
|
3116 |
|
53721
ccaceea6c768
added two functions to List (one contributed by Manuel Eberl)
traytel
parents:
53689
diff
changeset
|
3117 |
subsubsection {* @{const distinct} and @{const remdups} and @{const remdups_adj} *} |
13142 | 3118 |
|
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
|
3119 |
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
|
3120 |
"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
|
3121 |
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
|
3122 |
|
13142 | 3123 |
lemma distinct_append [simp]: |
13145 | 3124 |
"distinct (xs @ ys) = (distinct xs \<and> distinct ys \<and> set xs \<inter> set ys = {})" |
3125 |
by (induct xs) auto |
|
13142 | 3126 |
|
15305 | 3127 |
lemma distinct_rev[simp]: "distinct(rev xs) = distinct xs" |
3128 |
by(induct xs) auto |
|
3129 |
||
13142 | 3130 |
lemma set_remdups [simp]: "set (remdups xs) = set xs" |
13145 | 3131 |
by (induct xs) (auto simp add: insert_absorb) |
13142 | 3132 |
|
3133 |
lemma distinct_remdups [iff]: "distinct (remdups xs)" |
|
13145 | 3134 |
by (induct xs) auto |
13142 | 3135 |
|
25287 | 3136 |
lemma distinct_remdups_id: "distinct xs ==> remdups xs = xs" |
3137 |
by (induct xs, auto) |
|
3138 |
||
26734 | 3139 |
lemma remdups_id_iff_distinct [simp]: "remdups xs = xs \<longleftrightarrow> distinct xs" |
3140 |
by (metis distinct_remdups distinct_remdups_id) |
|
25287 | 3141 |
|
24566 | 3142 |
lemma finite_distinct_list: "finite A \<Longrightarrow> EX xs. set xs = A & distinct xs" |
24632 | 3143 |
by (metis distinct_remdups finite_list set_remdups) |
24566 | 3144 |
|
15072 | 3145 |
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
|
3146 |
by (induct x, auto) |
15072 | 3147 |
|
3148 |
lemma remdups_eq_nil_right_iff [simp]: "([] = remdups x) = (x = [])" |
|
24349 | 3149 |
by (induct x, auto) |
15072 | 3150 |
|
15245 | 3151 |
lemma length_remdups_leq[iff]: "length(remdups xs) <= length xs" |
3152 |
by (induct xs) auto |
|
3153 |
||
3154 |
lemma length_remdups_eq[iff]: |
|
3155 |
"(length (remdups xs) = length xs) = (remdups xs = xs)" |
|
3156 |
apply(induct xs) |
|
3157 |
apply auto |
|
3158 |
apply(subgoal_tac "length (remdups xs) <= length xs") |
|
3159 |
apply arith |
|
3160 |
apply(rule length_remdups_leq) |
|
3161 |
done |
|
3162 |
||
33945 | 3163 |
lemma remdups_filter: "remdups(filter P xs) = filter P (remdups xs)" |
3164 |
apply(induct xs) |
|
3165 |
apply auto |
|
3166 |
done |
|
18490 | 3167 |
|
3168 |
lemma distinct_map: |
|
3169 |
"distinct(map f xs) = (distinct xs & inj_on f (set xs))" |
|
3170 |
by (induct xs) auto |
|
3171 |
||
13142 | 3172 |
lemma distinct_filter [simp]: "distinct xs ==> distinct (filter P xs)" |
13145 | 3173 |
by (induct xs) auto |
13114 | 3174 |
|
17501 | 3175 |
lemma distinct_upt[simp]: "distinct[i..<j]" |
3176 |
by (induct j) auto |
|
3177 |
||
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
|
3178 |
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
|
3179 |
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
|
3180 |
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
|
3181 |
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
|
3182 |
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
|
3183 |
|
24526 | 3184 |
lemma distinct_take[simp]: "distinct xs \<Longrightarrow> distinct (take i xs)" |
3185 |
apply(induct xs arbitrary: i) |
|
17501 | 3186 |
apply simp |
3187 |
apply (case_tac i) |
|
3188 |
apply simp_all |
|
3189 |
apply(blast dest:in_set_takeD) |
|
3190 |
done |
|
3191 |
||
24526 | 3192 |
lemma distinct_drop[simp]: "distinct xs \<Longrightarrow> distinct (drop i xs)" |
3193 |
apply(induct xs arbitrary: i) |
|
17501 | 3194 |
apply simp |
3195 |
apply (case_tac i) |
|
3196 |
apply simp_all |
|
3197 |
done |
|
3198 |
||
3199 |
lemma distinct_list_update: |
|
3200 |
assumes d: "distinct xs" and a: "a \<notin> set xs - {xs!i}" |
|
3201 |
shows "distinct (xs[i:=a])" |
|
3202 |
proof (cases "i < length xs") |
|
3203 |
case True |
|
3204 |
with a have "a \<notin> set (take i xs @ xs ! i # drop (Suc i) xs) - {xs!i}" |
|
3205 |
apply (drule_tac id_take_nth_drop) by simp |
|
3206 |
with d True show ?thesis |
|
3207 |
apply (simp add: upd_conv_take_nth_drop) |
|
3208 |
apply (drule subst [OF id_take_nth_drop]) apply assumption |
|
3209 |
apply simp apply (cases "a = xs!i") apply simp by blast |
|
3210 |
next |
|
3211 |
case False with d show ?thesis by auto |
|
3212 |
qed |
|
3213 |
||
31363
7493b571b37d
Added theorems about distinct & concat, map & replicate and concat & replicate
hoelzl
parents:
31264
diff
changeset
|
3214 |
lemma distinct_concat: |
7493b571b37d
Added theorems about distinct & concat, map & replicate and concat & replicate
hoelzl
parents:
31264
diff
changeset
|
3215 |
assumes "distinct xs" |
7493b571b37d
Added theorems about distinct & concat, map & replicate and concat & replicate
hoelzl
parents:
31264
diff
changeset
|
3216 |
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
|
3217 |
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
|
3218 |
shows "distinct (concat xs)" |
7493b571b37d
Added theorems about distinct & concat, map & replicate and concat & replicate
hoelzl
parents:
31264
diff
changeset
|
3219 |
using assms by (induct xs) auto |
17501 | 3220 |
|
3221 |
text {* It is best to avoid this indexed version of distinct, but |
|
3222 |
sometimes it is useful. *} |
|
3223 |
||
13142 | 3224 |
lemma distinct_conv_nth: |
17501 | 3225 |
"distinct xs = (\<forall>i < size xs. \<forall>j < size xs. i \<noteq> j --> xs!i \<noteq> xs!j)" |
15251 | 3226 |
apply (induct xs, simp, simp) |
14208 | 3227 |
apply (rule iffI, clarsimp) |
13145 | 3228 |
apply (case_tac i) |
14208 | 3229 |
apply (case_tac j, simp) |
13145 | 3230 |
apply (simp add: set_conv_nth) |
3231 |
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
|
3232 |
apply (clarsimp simp add: set_conv_nth, simp) |
13145 | 3233 |
apply (rule conjI) |
24648 | 3234 |
(*TOO SLOW |
24632 | 3235 |
apply (metis Zero_neq_Suc gr0_conv_Suc in_set_conv_nth lessI less_trans_Suc nth_Cons' nth_Cons_Suc) |
24648 | 3236 |
*) |
3237 |
apply (clarsimp simp add: set_conv_nth) |
|
3238 |
apply (erule_tac x = 0 in allE, simp) |
|
3239 |
apply (erule_tac x = "Suc i" in allE, simp, clarsimp) |
|
25130 | 3240 |
(*TOO SLOW |
24632 | 3241 |
apply (metis Suc_Suc_eq lessI less_trans_Suc nth_Cons_Suc) |
25130 | 3242 |
*) |
3243 |
apply (erule_tac x = "Suc i" in allE, simp) |
|
3244 |
apply (erule_tac x = "Suc j" in allE, simp) |
|
13145 | 3245 |
done |
13114 | 3246 |
|
18490 | 3247 |
lemma nth_eq_iff_index_eq: |
3248 |
"\<lbrakk> distinct xs; i < length xs; j < length xs \<rbrakk> \<Longrightarrow> (xs!i = xs!j) = (i = j)" |
|
3249 |
by(auto simp: distinct_conv_nth) |
|
3250 |
||
15110
78b5636eabc7
Added a number of new thms and the new function remove1
nipkow
parents:
15072
diff
changeset
|
3251 |
lemma distinct_card: "distinct xs ==> card (set xs) = size xs" |
24349 | 3252 |
by (induct xs) auto |
14388 | 3253 |
|
15110
78b5636eabc7
Added a number of new thms and the new function remove1
nipkow
parents:
15072
diff
changeset
|
3254 |
lemma card_distinct: "card (set xs) = size xs ==> distinct xs" |
14388 | 3255 |
proof (induct xs) |
3256 |
case Nil thus ?case by simp |
|
3257 |
next |
|
3258 |
case (Cons x xs) |
|
3259 |
show ?case |
|
3260 |
proof (cases "x \<in> set xs") |
|
3261 |
case False with Cons show ?thesis by simp |
|
3262 |
next |
|
3263 |
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
|
3264 |
have "card (set xs) = Suc (length xs)" |
14388 | 3265 |
by (simp add: card_insert_if split: split_if_asm) |
3266 |
moreover have "card (set xs) \<le> length xs" by (rule card_length) |
|
3267 |
ultimately have False by simp |
|
3268 |
thus ?thesis .. |
|
3269 |
qed |
|
3270 |
qed |
|
3271 |
||
45115
93c1ac6727a3
adding lemma to List library for executable equation of the (refl) transitive closure
bulwahn
parents:
44928
diff
changeset
|
3272 |
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
|
3273 |
by (induct xs) (auto) |
93c1ac6727a3
adding lemma to List library for executable equation of the (refl) transitive closure
bulwahn
parents:
44928
diff
changeset
|
3274 |
|
25287 | 3275 |
lemma not_distinct_decomp: "~ distinct ws ==> EX xs ys zs y. ws = xs@[y]@ys@[y]@zs" |
3276 |
apply (induct n == "length ws" arbitrary:ws) apply simp |
|
3277 |
apply(case_tac ws) apply simp |
|
3278 |
apply (simp split:split_if_asm) |
|
3279 |
apply (metis Cons_eq_appendI eq_Nil_appendI split_list) |
|
3280 |
done |
|
18490 | 3281 |
|
45841 | 3282 |
lemma not_distinct_conv_prefix: |
3283 |
defines "dec as xs y ys \<equiv> y \<in> set xs \<and> distinct xs \<and> as = xs @ y # ys" |
|
3284 |
shows "\<not>distinct as \<longleftrightarrow> (\<exists>xs y ys. dec as xs y ys)" (is "?L = ?R") |
|
3285 |
proof |
|
3286 |
assume "?L" then show "?R" |
|
3287 |
proof (induct "length as" arbitrary: as rule: less_induct) |
|
3288 |
case less |
|
3289 |
obtain xs ys zs y where decomp: "as = (xs @ y # ys) @ y # zs" |
|
3290 |
using not_distinct_decomp[OF less.prems] by auto |
|
3291 |
show ?case |
|
3292 |
proof (cases "distinct (xs @ y # ys)") |
|
3293 |
case True |
|
3294 |
with decomp have "dec as (xs @ y # ys) y zs" by (simp add: dec_def) |
|
3295 |
then show ?thesis by blast |
|
3296 |
next |
|
3297 |
case False |
|
3298 |
with less decomp obtain xs' y' ys' where "dec (xs @ y # ys) xs' y' ys'" |
|
3299 |
by atomize_elim auto |
|
3300 |
with decomp have "dec as xs' y' (ys' @ y # zs)" by (simp add: dec_def) |
|
3301 |
then show ?thesis by blast |
|
3302 |
qed |
|
3303 |
qed |
|
3304 |
qed (auto simp: dec_def) |
|
3305 |
||
49948
744934b818c7
moved quite generic material from theory Enum to more appropriate places
haftmann
parents:
49808
diff
changeset
|
3306 |
lemma distinct_product: |
744934b818c7
moved quite generic material from theory Enum to more appropriate places
haftmann
parents:
49808
diff
changeset
|
3307 |
assumes "distinct xs" and "distinct ys" |
744934b818c7
moved quite generic material from theory Enum to more appropriate places
haftmann
parents:
49808
diff
changeset
|
3308 |
shows "distinct (List.product xs ys)" |
744934b818c7
moved quite generic material from theory Enum to more appropriate places
haftmann
parents:
49808
diff
changeset
|
3309 |
using assms by (induct xs) |
744934b818c7
moved quite generic material from theory Enum to more appropriate places
haftmann
parents:
49808
diff
changeset
|
3310 |
(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
|
3311 |
|
53721
ccaceea6c768
added two functions to List (one contributed by Manuel Eberl)
traytel
parents:
53689
diff
changeset
|
3312 |
lemma distinct_product_lists: |
ccaceea6c768
added two functions to List (one contributed by Manuel Eberl)
traytel
parents:
53689
diff
changeset
|
3313 |
assumes "\<forall>xs \<in> set xss. distinct xs" |
ccaceea6c768
added two functions to List (one contributed by Manuel Eberl)
traytel
parents:
53689
diff
changeset
|
3314 |
shows "distinct (product_lists xss)" |
ccaceea6c768
added two functions to List (one contributed by Manuel Eberl)
traytel
parents:
53689
diff
changeset
|
3315 |
using assms proof (induction xss) |
ccaceea6c768
added two functions to List (one contributed by Manuel Eberl)
traytel
parents:
53689
diff
changeset
|
3316 |
case (Cons xs xss) note * = this |
ccaceea6c768
added two functions to List (one contributed by Manuel Eberl)
traytel
parents:
53689
diff
changeset
|
3317 |
then show ?case |
ccaceea6c768
added two functions to List (one contributed by Manuel Eberl)
traytel
parents:
53689
diff
changeset
|
3318 |
proof (cases "product_lists xss") |
ccaceea6c768
added two functions to List (one contributed by Manuel Eberl)
traytel
parents:
53689
diff
changeset
|
3319 |
case Nil then show ?thesis by (induct xs) simp_all |
ccaceea6c768
added two functions to List (one contributed by Manuel Eberl)
traytel
parents:
53689
diff
changeset
|
3320 |
next |
ccaceea6c768
added two functions to List (one contributed by Manuel Eberl)
traytel
parents:
53689
diff
changeset
|
3321 |
case (Cons ps pss) with * show ?thesis |
ccaceea6c768
added two functions to List (one contributed by Manuel Eberl)
traytel
parents:
53689
diff
changeset
|
3322 |
by (auto intro!: inj_onI distinct_concat simp add: distinct_map) |
ccaceea6c768
added two functions to List (one contributed by Manuel Eberl)
traytel
parents:
53689
diff
changeset
|
3323 |
qed |
ccaceea6c768
added two functions to List (one contributed by Manuel Eberl)
traytel
parents:
53689
diff
changeset
|
3324 |
qed simp |
ccaceea6c768
added two functions to List (one contributed by Manuel Eberl)
traytel
parents:
53689
diff
changeset
|
3325 |
|
18490 | 3326 |
lemma length_remdups_concat: |
44921 | 3327 |
"length (remdups (concat xss)) = card (\<Union>xs\<in>set xss. set xs)" |
3328 |
by (simp add: distinct_card [symmetric]) |
|
17906 | 3329 |
|
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
|
3330 |
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
|
3331 |
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
|
3332 |
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
|
3333 |
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
|
3334 |
qed |
17906 | 3335 |
|
36275 | 3336 |
lemma remdups_remdups: |
3337 |
"remdups (remdups xs) = remdups xs" |
|
3338 |
by (induct xs) simp_all |
|
3339 |
||
36851 | 3340 |
lemma distinct_butlast: |
46500
0196966d6d2d
removing unnecessary premises in theorems of List theory
bulwahn
parents:
46448
diff
changeset
|
3341 |
assumes "distinct xs" |
36851 | 3342 |
shows "distinct (butlast xs)" |
46500
0196966d6d2d
removing unnecessary premises in theorems of List theory
bulwahn
parents:
46448
diff
changeset
|
3343 |
proof (cases "xs = []") |
0196966d6d2d
removing unnecessary premises in theorems of List theory
bulwahn
parents:
46448
diff
changeset
|
3344 |
case False |
0196966d6d2d
removing unnecessary premises in theorems of List theory
bulwahn
parents:
46448
diff
changeset
|
3345 |
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
|
3346 |
with `distinct xs` show ?thesis by simp |
0196966d6d2d
removing unnecessary premises in theorems of List theory
bulwahn
parents:
46448
diff
changeset
|
3347 |
qed (auto) |
36851 | 3348 |
|
39728 | 3349 |
lemma remdups_map_remdups: |
3350 |
"remdups (map f (remdups xs)) = remdups (map f xs)" |
|
3351 |
by (induct xs) simp_all |
|
3352 |
||
39915
ecf97cf3d248
turned distinct and sorted into inductive predicates: yields nice induction principles for free; more elegant proofs
haftmann
parents:
39774
diff
changeset
|
3353 |
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
|
3354 |
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
|
3355 |
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
|
3356 |
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
|
3357 |
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
|
3358 |
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
|
3359 |
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
|
3360 |
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
|
3361 |
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
|
3362 |
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
|
3363 |
qed |
ecf97cf3d248
turned distinct and sorted into inductive predicates: yields nice induction principles for free; more elegant proofs
haftmann
parents:
39774
diff
changeset
|
3364 |
|
ecf97cf3d248
turned distinct and sorted into inductive predicates: yields nice induction principles for free; more elegant proofs
haftmann
parents:
39774
diff
changeset
|
3365 |
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
|
3366 |
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
|
3367 |
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
|
3368 |
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
|
3369 |
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
|
3370 |
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
|
3371 |
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
|
3372 |
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
|
3373 |
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
|
3374 |
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
|
3375 |
qed |
ecf97cf3d248
turned distinct and sorted into inductive predicates: yields nice induction principles for free; more elegant proofs
haftmann
parents:
39774
diff
changeset
|
3376 |
|
47122 | 3377 |
lemma set_take_disj_set_drop_if_distinct: |
3378 |
"distinct vs \<Longrightarrow> i \<le> j \<Longrightarrow> set (take i vs) \<inter> set (drop j vs) = {}" |
|
3379 |
by (auto simp: in_set_conv_nth distinct_conv_nth) |
|
3380 |
||
44635
3d046864ebe6
added two lemmas about "distinct" to help Sledgehammer
blanchet
parents:
44619
diff
changeset
|
3381 |
(* The next two lemmas help Sledgehammer. *) |
3d046864ebe6
added two lemmas about "distinct" to help Sledgehammer
blanchet
parents:
44619
diff
changeset
|
3382 |
|
3d046864ebe6
added two lemmas about "distinct" to help Sledgehammer
blanchet
parents:
44619
diff
changeset
|
3383 |
lemma distinct_singleton: "distinct [x]" by simp |
3d046864ebe6
added two lemmas about "distinct" to help Sledgehammer
blanchet
parents:
44619
diff
changeset
|
3384 |
|
3d046864ebe6
added two lemmas about "distinct" to help Sledgehammer
blanchet
parents:
44619
diff
changeset
|
3385 |
lemma distinct_length_2_or_more: |
3d046864ebe6
added two lemmas about "distinct" to help Sledgehammer
blanchet
parents:
44619
diff
changeset
|
3386 |
"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
|
3387 |
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
|
3388 |
|
53721
ccaceea6c768
added two functions to List (one contributed by Manuel Eberl)
traytel
parents:
53689
diff
changeset
|
3389 |
lemma remdups_adj_Cons: "remdups_adj (x # xs) = |
ccaceea6c768
added two functions to List (one contributed by Manuel Eberl)
traytel
parents:
53689
diff
changeset
|
3390 |
(case remdups_adj xs of [] \<Rightarrow> [x] | y # xs \<Rightarrow> if x = y then y # xs else x # y # xs)" |
ccaceea6c768
added two functions to List (one contributed by Manuel Eberl)
traytel
parents:
53689
diff
changeset
|
3391 |
by (induct xs arbitrary: x) (auto split: list.splits) |
ccaceea6c768
added two functions to List (one contributed by Manuel Eberl)
traytel
parents:
53689
diff
changeset
|
3392 |
|
ccaceea6c768
added two functions to List (one contributed by Manuel Eberl)
traytel
parents:
53689
diff
changeset
|
3393 |
lemma remdups_adj_append_two: |
ccaceea6c768
added two functions to List (one contributed by Manuel Eberl)
traytel
parents:
53689
diff
changeset
|
3394 |
"remdups_adj (xs @ [x,y]) = remdups_adj (xs @ [x]) @ (if x = y then [] else [y])" |
ccaceea6c768
added two functions to List (one contributed by Manuel Eberl)
traytel
parents:
53689
diff
changeset
|
3395 |
by (induct xs rule: remdups_adj.induct, simp_all) |
ccaceea6c768
added two functions to List (one contributed by Manuel Eberl)
traytel
parents:
53689
diff
changeset
|
3396 |
|
ccaceea6c768
added two functions to List (one contributed by Manuel Eberl)
traytel
parents:
53689
diff
changeset
|
3397 |
lemma remdups_adj_rev[simp]: "remdups_adj (rev xs) = rev (remdups_adj xs)" |
ccaceea6c768
added two functions to List (one contributed by Manuel Eberl)
traytel
parents:
53689
diff
changeset
|
3398 |
by (induct xs rule: remdups_adj.induct, simp_all add: remdups_adj_append_two) |
ccaceea6c768
added two functions to List (one contributed by Manuel Eberl)
traytel
parents:
53689
diff
changeset
|
3399 |
|
ccaceea6c768
added two functions to List (one contributed by Manuel Eberl)
traytel
parents:
53689
diff
changeset
|
3400 |
lemma remdups_adj_length[simp]: "length (remdups_adj xs) \<le> length xs" |
ccaceea6c768
added two functions to List (one contributed by Manuel Eberl)
traytel
parents:
53689
diff
changeset
|
3401 |
by (induct xs rule: remdups_adj.induct, auto) |
ccaceea6c768
added two functions to List (one contributed by Manuel Eberl)
traytel
parents:
53689
diff
changeset
|
3402 |
|
ccaceea6c768
added two functions to List (one contributed by Manuel Eberl)
traytel
parents:
53689
diff
changeset
|
3403 |
lemma remdups_adj_length_ge1[simp]: "xs \<noteq> [] \<Longrightarrow> length (remdups_adj xs) \<ge> Suc 0" |
ccaceea6c768
added two functions to List (one contributed by Manuel Eberl)
traytel
parents:
53689
diff
changeset
|
3404 |
by (induct xs rule: remdups_adj.induct, simp_all) |
ccaceea6c768
added two functions to List (one contributed by Manuel Eberl)
traytel
parents:
53689
diff
changeset
|
3405 |
|
ccaceea6c768
added two functions to List (one contributed by Manuel Eberl)
traytel
parents:
53689
diff
changeset
|
3406 |
lemma remdups_adj_Nil_iff[simp]: "remdups_adj xs = [] \<longleftrightarrow> xs = []" |
ccaceea6c768
added two functions to List (one contributed by Manuel Eberl)
traytel
parents:
53689
diff
changeset
|
3407 |
by (induct xs rule: remdups_adj.induct, simp_all) |
ccaceea6c768
added two functions to List (one contributed by Manuel Eberl)
traytel
parents:
53689
diff
changeset
|
3408 |
|
ccaceea6c768
added two functions to List (one contributed by Manuel Eberl)
traytel
parents:
53689
diff
changeset
|
3409 |
lemma remdups_adj_set[simp]: "set (remdups_adj xs) = set xs" |
ccaceea6c768
added two functions to List (one contributed by Manuel Eberl)
traytel
parents:
53689
diff
changeset
|
3410 |
by (induct xs rule: remdups_adj.induct, simp_all) |
ccaceea6c768
added two functions to List (one contributed by Manuel Eberl)
traytel
parents:
53689
diff
changeset
|
3411 |
|
ccaceea6c768
added two functions to List (one contributed by Manuel Eberl)
traytel
parents:
53689
diff
changeset
|
3412 |
lemma remdups_adj_Cons_alt[simp]: "x # tl (remdups_adj (x # xs)) = remdups_adj (x # xs)" |
ccaceea6c768
added two functions to List (one contributed by Manuel Eberl)
traytel
parents:
53689
diff
changeset
|
3413 |
by (induct xs rule: remdups_adj.induct, auto) |
ccaceea6c768
added two functions to List (one contributed by Manuel Eberl)
traytel
parents:
53689
diff
changeset
|
3414 |
|
ccaceea6c768
added two functions to List (one contributed by Manuel Eberl)
traytel
parents:
53689
diff
changeset
|
3415 |
lemma remdups_adj_distinct: "distinct xs \<Longrightarrow> remdups_adj xs = xs" |
ccaceea6c768
added two functions to List (one contributed by Manuel Eberl)
traytel
parents:
53689
diff
changeset
|
3416 |
by (induct xs rule: remdups_adj.induct, simp_all) |
ccaceea6c768
added two functions to List (one contributed by Manuel Eberl)
traytel
parents:
53689
diff
changeset
|
3417 |
|
ccaceea6c768
added two functions to List (one contributed by Manuel Eberl)
traytel
parents:
53689
diff
changeset
|
3418 |
lemma remdups_adj_append: |
ccaceea6c768
added two functions to List (one contributed by Manuel Eberl)
traytel
parents:
53689
diff
changeset
|
3419 |
"remdups_adj (xs\<^sub>1 @ x # xs\<^sub>2) = remdups_adj (xs\<^sub>1 @ [x]) @ tl (remdups_adj (x # xs\<^sub>2))" |
ccaceea6c768
added two functions to List (one contributed by Manuel Eberl)
traytel
parents:
53689
diff
changeset
|
3420 |
by (induct xs\<^sub>1 rule: remdups_adj.induct, simp_all) |
ccaceea6c768
added two functions to List (one contributed by Manuel Eberl)
traytel
parents:
53689
diff
changeset
|
3421 |
|
ccaceea6c768
added two functions to List (one contributed by Manuel Eberl)
traytel
parents:
53689
diff
changeset
|
3422 |
lemma remdups_adj_singleton: |
ccaceea6c768
added two functions to List (one contributed by Manuel Eberl)
traytel
parents:
53689
diff
changeset
|
3423 |
"remdups_adj xs = [x] \<Longrightarrow> xs = replicate (length xs) x" |
ccaceea6c768
added two functions to List (one contributed by Manuel Eberl)
traytel
parents:
53689
diff
changeset
|
3424 |
by (induct xs rule: remdups_adj.induct, auto split: split_if_asm) |
ccaceea6c768
added two functions to List (one contributed by Manuel Eberl)
traytel
parents:
53689
diff
changeset
|
3425 |
|
ccaceea6c768
added two functions to List (one contributed by Manuel Eberl)
traytel
parents:
53689
diff
changeset
|
3426 |
lemma remdups_adj_map_injective: |
ccaceea6c768
added two functions to List (one contributed by Manuel Eberl)
traytel
parents:
53689
diff
changeset
|
3427 |
assumes "inj f" |
ccaceea6c768
added two functions to List (one contributed by Manuel Eberl)
traytel
parents:
53689
diff
changeset
|
3428 |
shows "remdups_adj (map f xs) = map f (remdups_adj xs)" |
ccaceea6c768
added two functions to List (one contributed by Manuel Eberl)
traytel
parents:
53689
diff
changeset
|
3429 |
by (induct xs rule: remdups_adj.induct, |
ccaceea6c768
added two functions to List (one contributed by Manuel Eberl)
traytel
parents:
53689
diff
changeset
|
3430 |
auto simp add: injD[OF assms]) |
ccaceea6c768
added two functions to List (one contributed by Manuel Eberl)
traytel
parents:
53689
diff
changeset
|
3431 |
|
49948
744934b818c7
moved quite generic material from theory Enum to more appropriate places
haftmann
parents:
49808
diff
changeset
|
3432 |
|
37605
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
3433 |
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
|
3434 |
|
39774 | 3435 |
lemma (in monoid_add) listsum_simps [simp]: |
3436 |
"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
|
3437 |
"listsum (x # xs) = x + listsum xs" |
39774 | 3438 |
by (simp_all add: listsum_def) |
3439 |
||
3440 |
lemma (in monoid_add) listsum_append [simp]: |
|
3441 |
"listsum (xs @ ys) = listsum xs + listsum ys" |
|
3442 |
by (induct xs) (simp_all add: add.assoc) |
|
3443 |
||
3444 |
lemma (in comm_monoid_add) listsum_rev [simp]: |
|
3445 |
"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
|
3446 |
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
|
3447 |
|
d9fe85d3d2cd
incorporated canonical fold combinator on lists into body of List theory; refactored passages on List.fold(l/r)
haftmann
parents:
46125
diff
changeset
|
3448 |
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
|
3449 |
"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
|
3450 |
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
|
3451 |
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
|
3452 |
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
|
3453 |
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
|
3454 |
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
|
3455 |
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
|
3456 |
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
|
3457 |
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
|
3458 |
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
|
3459 |
|
d9fe85d3d2cd
incorporated canonical fold combinator on lists into body of List theory; refactored passages on List.fold(l/r)
haftmann
parents:
46125
diff
changeset
|
3460 |
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
|
3461 |
|
d9fe85d3d2cd
incorporated canonical fold combinator on lists into body of List theory; refactored passages on List.fold(l/r)
haftmann
parents:
46125
diff
changeset
|
3462 |
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
|
3463 |
"_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
|
3464 |
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
|
3465 |
"_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
|
3466 |
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
|
3467 |
"_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
|
3468 |
|
d9fe85d3d2cd
incorporated canonical fold combinator on lists into body of List theory; refactored passages on List.fold(l/r)
haftmann
parents:
46125
diff
changeset
|
3469 |
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
|
3470 |
"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
|
3471 |
"\<Sum>x\<leftarrow>xs. b" == "CONST listsum (CONST map (%x. b) xs)" |
39774 | 3472 |
|
3473 |
lemma (in comm_monoid_add) listsum_map_remove1: |
|
3474 |
"x \<in> set xs \<Longrightarrow> listsum (map f xs) = f x + listsum (map f (remove1 x xs))" |
|
3475 |
by (induct xs) (auto simp add: ac_simps) |
|
3476 |
||
3477 |
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
|
3478 |
"list_size f xs = listsum (map f xs) + size xs" |
39774 | 3479 |
by (induct xs) auto |
3480 |
||
3481 |
lemma (in monoid_add) length_concat: |
|
3482 |
"length (concat xss) = listsum (map length xss)" |
|
3483 |
by (induct xss) simp_all |
|
3484 |
||
53721
ccaceea6c768
added two functions to List (one contributed by Manuel Eberl)
traytel
parents:
53689
diff
changeset
|
3485 |
lemma (in monoid_add) length_product_lists: |
ccaceea6c768
added two functions to List (one contributed by Manuel Eberl)
traytel
parents:
53689
diff
changeset
|
3486 |
"length (product_lists xss) = foldr op * (map length xss) 1" |
ccaceea6c768
added two functions to List (one contributed by Manuel Eberl)
traytel
parents:
53689
diff
changeset
|
3487 |
proof (induct xss) |
ccaceea6c768
added two functions to List (one contributed by Manuel Eberl)
traytel
parents:
53689
diff
changeset
|
3488 |
case (Cons xs xss) then show ?case by (induct xs) (auto simp: length_concat o_def) |
ccaceea6c768
added two functions to List (one contributed by Manuel Eberl)
traytel
parents:
53689
diff
changeset
|
3489 |
qed simp |
ccaceea6c768
added two functions to List (one contributed by Manuel Eberl)
traytel
parents:
53689
diff
changeset
|
3490 |
|
39774 | 3491 |
lemma (in monoid_add) listsum_map_filter: |
3492 |
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
|
3493 |
shows "listsum (map f (filter P xs)) = listsum (map f xs)" |
39774 | 3494 |
using assms by (induct xs) auto |
3495 |
||
51738
9e4220605179
tuned: unnamed contexts, interpretation and sublocale in locale target;
haftmann
parents:
51717
diff
changeset
|
3496 |
lemma (in comm_monoid_add) distinct_listsum_conv_Setsum: |
39774 | 3497 |
"distinct xs \<Longrightarrow> listsum xs = Setsum (set xs)" |
3498 |
by (induct xs) simp_all |
|
3499 |
||
3500 |
lemma listsum_eq_0_nat_iff_nat [simp]: |
|
3501 |
"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
|
3502 |
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
|
3503 |
|
d654c73e4b12
no preference wrt. fold(l/r); prefer fold rather than foldr for iterating over lists in generated code
haftmann
parents:
47131
diff
changeset
|
3504 |
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
|
3505 |
"(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
|
3506 |
by (induct ns) auto |
39774 | 3507 |
|
3508 |
lemma elem_le_listsum_nat: |
|
3509 |
"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
|
3510 |
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
|
3511 |
|
39774 | 3512 |
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
|
3513 |
"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
|
3514 |
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
|
3515 |
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
|
3516 |
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
|
3517 |
apply arith |
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
3518 |
done |
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
3519 |
|
39774 | 3520 |
lemma (in monoid_add) listsum_triv: |
3521 |
"(\<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
|
3522 |
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
|
3523 |
|
39774 | 3524 |
lemma (in monoid_add) listsum_0 [simp]: |
3525 |
"(\<Sum>x\<leftarrow>xs. 0) = 0" |
|
49962
a8cc904a6820
Renamed {left,right}_distrib to distrib_{right,left}.
webertj
parents:
49808
diff
changeset
|
3526 |
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
|
3527 |
|
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
3528 |
text{* For non-Abelian groups @{text xs} needs to be reversed on one side: *} |
39774 | 3529 |
lemma (in ab_group_add) uminus_listsum_map: |
3530 |
"- listsum (map f xs) = listsum (map (uminus \<circ> f) xs)" |
|
3531 |
by (induct xs) simp_all |
|
3532 |
||
3533 |
lemma (in comm_monoid_add) listsum_addf: |
|
3534 |
"(\<Sum>x\<leftarrow>xs. f x + g x) = listsum (map f xs) + listsum (map g xs)" |
|
3535 |
by (induct xs) (simp_all add: algebra_simps) |
|
3536 |
||
3537 |
lemma (in ab_group_add) listsum_subtractf: |
|
3538 |
"(\<Sum>x\<leftarrow>xs. f x - g x) = listsum (map f xs) - listsum (map g xs)" |
|
3539 |
by (induct xs) (simp_all add: algebra_simps) |
|
3540 |
||
3541 |
lemma (in semiring_0) listsum_const_mult: |
|
3542 |
"(\<Sum>x\<leftarrow>xs. c * f x) = c * (\<Sum>x\<leftarrow>xs. f x)" |
|
3543 |
by (induct xs) (simp_all add: algebra_simps) |
|
3544 |
||
3545 |
lemma (in semiring_0) listsum_mult_const: |
|
3546 |
"(\<Sum>x\<leftarrow>xs. f x * c) = (\<Sum>x\<leftarrow>xs. f x) * c" |
|
3547 |
by (induct xs) (simp_all add: algebra_simps) |
|
3548 |
||
3549 |
lemma (in ordered_ab_group_add_abs) listsum_abs: |
|
3550 |
"\<bar>listsum xs\<bar> \<le> listsum (map abs xs)" |
|
3551 |
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
|
3552 |
|
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
3553 |
lemma listsum_mono: |
39774 | 3554 |
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
|
3555 |
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 | 3556 |
by (induct xs) (simp, simp add: add_mono) |
3557 |
||
3558 |
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
|
3559 |
"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
|
3560 |
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
|
3561 |
|
39774 | 3562 |
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
|
3563 |
"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
|
3564 |
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
|
3565 |
|
39774 | 3566 |
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
|
3567 |
"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
|
3568 |
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
|
3569 |
|
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
3570 |
text {* General equivalence between @{const listsum} and @{const setsum} *} |
39774 | 3571 |
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
|
3572 |
"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
|
3573 |
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
|
3574 |
|
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
3575 |
|
34978
874150ddd50a
canonical insert operation; generalized lemma foldl_apply_inv to foldl_apply
haftmann
parents:
34942
diff
changeset
|
3576 |
subsubsection {* @{const insert} *} |
874150ddd50a
canonical insert operation; generalized lemma foldl_apply_inv to foldl_apply
haftmann
parents:
34942
diff
changeset
|
3577 |
|
874150ddd50a
canonical insert operation; generalized lemma foldl_apply_inv to foldl_apply
haftmann
parents:
34942
diff
changeset
|
3578 |
lemma in_set_insert [simp]: |
874150ddd50a
canonical insert operation; generalized lemma foldl_apply_inv to foldl_apply
haftmann
parents:
34942
diff
changeset
|
3579 |
"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
|
3580 |
by (simp add: List.insert_def) |
874150ddd50a
canonical insert operation; generalized lemma foldl_apply_inv to foldl_apply
haftmann
parents:
34942
diff
changeset
|
3581 |
|
874150ddd50a
canonical insert operation; generalized lemma foldl_apply_inv to foldl_apply
haftmann
parents:
34942
diff
changeset
|
3582 |
lemma not_in_set_insert [simp]: |
874150ddd50a
canonical insert operation; generalized lemma foldl_apply_inv to foldl_apply
haftmann
parents:
34942
diff
changeset
|
3583 |
"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
|
3584 |
by (simp add: List.insert_def) |
874150ddd50a
canonical insert operation; generalized lemma foldl_apply_inv to foldl_apply
haftmann
parents:
34942
diff
changeset
|
3585 |
|
874150ddd50a
canonical insert operation; generalized lemma foldl_apply_inv to foldl_apply
haftmann
parents:
34942
diff
changeset
|
3586 |
lemma insert_Nil [simp]: |
874150ddd50a
canonical insert operation; generalized lemma foldl_apply_inv to foldl_apply
haftmann
parents:
34942
diff
changeset
|
3587 |
"List.insert x [] = [x]" |
874150ddd50a
canonical insert operation; generalized lemma foldl_apply_inv to foldl_apply
haftmann
parents:
34942
diff
changeset
|
3588 |
by simp |
874150ddd50a
canonical insert operation; generalized lemma foldl_apply_inv to foldl_apply
haftmann
parents:
34942
diff
changeset
|
3589 |
|
35295 | 3590 |
lemma set_insert [simp]: |
34978
874150ddd50a
canonical insert operation; generalized lemma foldl_apply_inv to foldl_apply
haftmann
parents:
34942
diff
changeset
|
3591 |
"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
|
3592 |
by (auto simp add: List.insert_def) |
874150ddd50a
canonical insert operation; generalized lemma foldl_apply_inv to foldl_apply
haftmann
parents:
34942
diff
changeset
|
3593 |
|
35295 | 3594 |
lemma distinct_insert [simp]: |
3595 |
"distinct xs \<Longrightarrow> distinct (List.insert x xs)" |
|
3596 |
by (simp add: List.insert_def) |
|
3597 |
||
36275 | 3598 |
lemma insert_remdups: |
3599 |
"List.insert x (remdups xs) = remdups (List.insert x xs)" |
|
3600 |
by (simp add: List.insert_def) |
|
3601 |
||
34978
874150ddd50a
canonical insert operation; generalized lemma foldl_apply_inv to foldl_apply
haftmann
parents:
34942
diff
changeset
|
3602 |
|
47122 | 3603 |
subsubsection {* @{const List.find} *} |
3604 |
||
3605 |
lemma find_None_iff: "List.find P xs = None \<longleftrightarrow> \<not> (\<exists>x. x \<in> set xs \<and> P x)" |
|
3606 |
proof (induction xs) |
|
3607 |
case Nil thus ?case by simp |
|
3608 |
next |
|
3609 |
case (Cons x xs) thus ?case by (fastforce split: if_splits) |
|
3610 |
qed |
|
3611 |
||
3612 |
lemma find_Some_iff: |
|
3613 |
"List.find P xs = Some x \<longleftrightarrow> |
|
3614 |
(\<exists>i<length xs. P (xs!i) \<and> x = xs!i \<and> (\<forall>j<i. \<not> P (xs!j)))" |
|
3615 |
proof (induction xs) |
|
3616 |
case Nil thus ?case by simp |
|
3617 |
next |
|
3618 |
case (Cons x xs) thus ?case |
|
3619 |
by(auto simp: nth_Cons' split: if_splits) |
|
3620 |
(metis One_nat_def diff_Suc_1 less_Suc_eq_0_disj) |
|
3621 |
qed |
|
3622 |
||
3623 |
lemma find_cong[fundef_cong]: |
|
3624 |
assumes "xs = ys" and "\<And>x. x \<in> set ys \<Longrightarrow> P x = Q x" |
|
3625 |
shows "List.find P xs = List.find Q ys" |
|
3626 |
proof (cases "List.find P xs") |
|
3627 |
case None thus ?thesis by (metis find_None_iff assms) |
|
3628 |
next |
|
3629 |
case (Some x) |
|
3630 |
hence "List.find Q ys = Some x" using assms |
|
3631 |
by (auto simp add: find_Some_iff) |
|
3632 |
thus ?thesis using Some by auto |
|
3633 |
qed |
|
3634 |
||
52379 | 3635 |
lemma find_dropWhile: |
3636 |
"List.find P xs = (case dropWhile (Not \<circ> P) xs |
|
3637 |
of [] \<Rightarrow> None |
|
3638 |
| x # _ \<Rightarrow> Some x)" |
|
3639 |
by (induct xs) simp_all |
|
3640 |
||
47122 | 3641 |
|
3642 |
subsubsection {* @{const remove1} *} |
|
15110
78b5636eabc7
Added a number of new thms and the new function remove1
nipkow
parents:
15072
diff
changeset
|
3643 |
|
18049 | 3644 |
lemma remove1_append: |
3645 |
"remove1 x (xs @ ys) = |
|
3646 |
(if x \<in> set xs then remove1 x xs @ ys else xs @ remove1 x ys)" |
|
3647 |
by (induct xs) auto |
|
3648 |
||
36903 | 3649 |
lemma remove1_commute: "remove1 x (remove1 y zs) = remove1 y (remove1 x zs)" |
3650 |
by (induct zs) auto |
|
3651 |
||
23479 | 3652 |
lemma in_set_remove1[simp]: |
3653 |
"a \<noteq> b \<Longrightarrow> a : set(remove1 b xs) = (a : set xs)" |
|
3654 |
apply (induct xs) |
|
3655 |
apply auto |
|
3656 |
done |
|
3657 |
||
15110
78b5636eabc7
Added a number of new thms and the new function remove1
nipkow
parents:
15072
diff
changeset
|
3658 |
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
|
3659 |
apply(induct xs) |
78b5636eabc7
Added a number of new thms and the new function remove1
nipkow
parents:
15072
diff
changeset
|
3660 |
apply simp |
78b5636eabc7
Added a number of new thms and the new function remove1
nipkow
parents:
15072
diff
changeset
|
3661 |
apply simp |
78b5636eabc7
Added a number of new thms and the new function remove1
nipkow
parents:
15072
diff
changeset
|
3662 |
apply blast |
78b5636eabc7
Added a number of new thms and the new function remove1
nipkow
parents:
15072
diff
changeset
|
3663 |
done |
78b5636eabc7
Added a number of new thms and the new function remove1
nipkow
parents:
15072
diff
changeset
|
3664 |
|
17724 | 3665 |
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
|
3666 |
apply(induct xs) |
78b5636eabc7
Added a number of new thms and the new function remove1
nipkow
parents:
15072
diff
changeset
|
3667 |
apply simp |
78b5636eabc7
Added a number of new thms and the new function remove1
nipkow
parents:
15072
diff
changeset
|
3668 |
apply simp |
78b5636eabc7
Added a number of new thms and the new function remove1
nipkow
parents:
15072
diff
changeset
|
3669 |
apply blast |
78b5636eabc7
Added a number of new thms and the new function remove1
nipkow
parents:
15072
diff
changeset
|
3670 |
done |
78b5636eabc7
Added a number of new thms and the new function remove1
nipkow
parents:
15072
diff
changeset
|
3671 |
|
23479 | 3672 |
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
|
3673 |
"length(remove1 x xs) = (if x : set xs then length xs - 1 else length xs)" |
23479 | 3674 |
apply (induct xs) |
3675 |
apply (auto dest!:length_pos_if_in_set) |
|
3676 |
done |
|
3677 |
||
18049 | 3678 |
lemma remove1_filter_not[simp]: |
3679 |
"\<not> P x \<Longrightarrow> remove1 x (filter P xs) = filter P xs" |
|
3680 |
by(induct xs) auto |
|
3681 |
||
39073 | 3682 |
lemma filter_remove1: |
3683 |
"filter Q (remove1 x xs) = remove1 x (filter Q xs)" |
|
3684 |
by (induct xs) auto |
|
3685 |
||
15110
78b5636eabc7
Added a number of new thms and the new function remove1
nipkow
parents:
15072
diff
changeset
|
3686 |
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
|
3687 |
apply(insert set_remove1_subset) |
78b5636eabc7
Added a number of new thms and the new function remove1
nipkow
parents:
15072
diff
changeset
|
3688 |
apply fast |
78b5636eabc7
Added a number of new thms and the new function remove1
nipkow
parents:
15072
diff
changeset
|
3689 |
done |
78b5636eabc7
Added a number of new thms and the new function remove1
nipkow
parents:
15072
diff
changeset
|
3690 |
|
78b5636eabc7
Added a number of new thms and the new function remove1
nipkow
parents:
15072
diff
changeset
|
3691 |
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
|
3692 |
by (induct xs) simp_all |
78b5636eabc7
Added a number of new thms and the new function remove1
nipkow
parents:
15072
diff
changeset
|
3693 |
|
36275 | 3694 |
lemma remove1_remdups: |
3695 |
"distinct xs \<Longrightarrow> remove1 x (remdups xs) = remdups (remove1 x xs)" |
|
3696 |
by (induct xs) simp_all |
|
3697 |
||
37107 | 3698 |
lemma remove1_idem: |
3699 |
assumes "x \<notin> set xs" |
|
3700 |
shows "remove1 x xs = xs" |
|
3701 |
using assms by (induct xs) simp_all |
|
3702 |
||
13114 | 3703 |
|
49948
744934b818c7
moved quite generic material from theory Enum to more appropriate places
haftmann
parents:
49808
diff
changeset
|
3704 |
subsubsection {* @{const removeAll} *} |
27693 | 3705 |
|
34978
874150ddd50a
canonical insert operation; generalized lemma foldl_apply_inv to foldl_apply
haftmann
parents:
34942
diff
changeset
|
3706 |
lemma removeAll_filter_not_eq: |
874150ddd50a
canonical insert operation; generalized lemma foldl_apply_inv to foldl_apply
haftmann
parents:
34942
diff
changeset
|
3707 |
"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
|
3708 |
proof |
874150ddd50a
canonical insert operation; generalized lemma foldl_apply_inv to foldl_apply
haftmann
parents:
34942
diff
changeset
|
3709 |
fix xs |
874150ddd50a
canonical insert operation; generalized lemma foldl_apply_inv to foldl_apply
haftmann
parents:
34942
diff
changeset
|
3710 |
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
|
3711 |
by (induct xs) auto |
874150ddd50a
canonical insert operation; generalized lemma foldl_apply_inv to foldl_apply
haftmann
parents:
34942
diff
changeset
|
3712 |
qed |
874150ddd50a
canonical insert operation; generalized lemma foldl_apply_inv to foldl_apply
haftmann
parents:
34942
diff
changeset
|
3713 |
|
27693 | 3714 |
lemma removeAll_append[simp]: |
3715 |
"removeAll x (xs @ ys) = removeAll x xs @ removeAll x ys" |
|
3716 |
by (induct xs) auto |
|
3717 |
||
3718 |
lemma set_removeAll[simp]: "set(removeAll x xs) = set xs - {x}" |
|
3719 |
by (induct xs) auto |
|
3720 |
||
3721 |
lemma removeAll_id[simp]: "x \<notin> set xs \<Longrightarrow> removeAll x xs = xs" |
|
3722 |
by (induct xs) auto |
|
3723 |
||
46448
f1201fac7398
more specification of the quotient package in IsarRef
Cezary Kaliszyk <cezarykaliszyk@gmail.com>
parents:
46440
diff
changeset
|
3724 |
(* Needs count:: 'a \<Rightarrow> 'a list \<Rightarrow> nat |
27693 | 3725 |
lemma length_removeAll: |
3726 |
"length(removeAll x xs) = length xs - count x xs" |
|
3727 |
*) |
|
3728 |
||
3729 |
lemma removeAll_filter_not[simp]: |
|
3730 |
"\<not> P x \<Longrightarrow> removeAll x (filter P xs) = filter P xs" |
|
3731 |
by(induct xs) auto |
|
3732 |
||
34978
874150ddd50a
canonical insert operation; generalized lemma foldl_apply_inv to foldl_apply
haftmann
parents:
34942
diff
changeset
|
3733 |
lemma distinct_removeAll: |
874150ddd50a
canonical insert operation; generalized lemma foldl_apply_inv to foldl_apply
haftmann
parents:
34942
diff
changeset
|
3734 |
"distinct xs \<Longrightarrow> distinct (removeAll x xs)" |
874150ddd50a
canonical insert operation; generalized lemma foldl_apply_inv to foldl_apply
haftmann
parents:
34942
diff
changeset
|
3735 |
by (simp add: removeAll_filter_not_eq) |
27693 | 3736 |
|
3737 |
lemma distinct_remove1_removeAll: |
|
3738 |
"distinct xs ==> remove1 x xs = removeAll x xs" |
|
3739 |
by (induct xs) simp_all |
|
3740 |
||
3741 |
lemma map_removeAll_inj_on: "inj_on f (insert x (set xs)) \<Longrightarrow> |
|
3742 |
map f (removeAll x xs) = removeAll (f x) (map f xs)" |
|
3743 |
by (induct xs) (simp_all add:inj_on_def) |
|
3744 |
||
3745 |
lemma map_removeAll_inj: "inj f \<Longrightarrow> |
|
3746 |
map f (removeAll x xs) = removeAll (f x) (map f xs)" |
|
3747 |
by(metis map_removeAll_inj_on subset_inj_on subset_UNIV) |
|
3748 |
||
3749 |
||
49948
744934b818c7
moved quite generic material from theory Enum to more appropriate places
haftmann
parents:
49808
diff
changeset
|
3750 |
subsubsection {* @{const replicate} *} |
13114 | 3751 |
|
13142 | 3752 |
lemma length_replicate [simp]: "length (replicate n x) = n" |
13145 | 3753 |
by (induct n) auto |
13124 | 3754 |
|
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
|
3755 |
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
|
3756 |
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
|
3757 |
|
13142 | 3758 |
lemma map_replicate [simp]: "map f (replicate n x) = replicate n (f x)" |
13145 | 3759 |
by (induct n) auto |
13114 | 3760 |
|
31363
7493b571b37d
Added theorems about distinct & concat, map & replicate and concat & replicate
hoelzl
parents:
31264
diff
changeset
|
3761 |
lemma map_replicate_const: |
7493b571b37d
Added theorems about distinct & concat, map & replicate and concat & replicate
hoelzl
parents:
31264
diff
changeset
|
3762 |
"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
|
3763 |
by (induct lst) auto |
7493b571b37d
Added theorems about distinct & concat, map & replicate and concat & replicate
hoelzl
parents:
31264
diff
changeset
|
3764 |
|
13114 | 3765 |
lemma replicate_app_Cons_same: |
13145 | 3766 |
"(replicate n x) @ (x # xs) = x # replicate n x @ xs" |
3767 |
by (induct n) auto |
|
13114 | 3768 |
|
13142 | 3769 |
lemma rev_replicate [simp]: "rev (replicate n x) = replicate n x" |
14208 | 3770 |
apply (induct n, simp) |
13145 | 3771 |
apply (simp add: replicate_app_Cons_same) |
3772 |
done |
|
13114 | 3773 |
|
13142 | 3774 |
lemma replicate_add: "replicate (n + m) x = replicate n x @ replicate m x" |
13145 | 3775 |
by (induct n) auto |
13114 | 3776 |
|
16397 | 3777 |
text{* Courtesy of Matthias Daum: *} |
3778 |
lemma append_replicate_commute: |
|
3779 |
"replicate n x @ replicate k x = replicate k x @ replicate n x" |
|
3780 |
apply (simp add: replicate_add [THEN sym]) |
|
3781 |
apply (simp add: add_commute) |
|
3782 |
done |
|
3783 |
||
31080 | 3784 |
text{* Courtesy of Andreas Lochbihler: *} |
3785 |
lemma filter_replicate: |
|
3786 |
"filter P (replicate n x) = (if P x then replicate n x else [])" |
|
3787 |
by(induct n) auto |
|
3788 |
||
13142 | 3789 |
lemma hd_replicate [simp]: "n \<noteq> 0 ==> hd (replicate n x) = x" |
13145 | 3790 |
by (induct n) auto |
13114 | 3791 |
|
46500
0196966d6d2d
removing unnecessary premises in theorems of List theory
bulwahn
parents:
46448
diff
changeset
|
3792 |
lemma tl_replicate [simp]: "tl (replicate n x) = replicate (n - 1) x" |
13145 | 3793 |
by (induct n) auto |
13114 | 3794 |
|
13142 | 3795 |
lemma last_replicate [simp]: "n \<noteq> 0 ==> last (replicate n x) = x" |
13145 | 3796 |
by (atomize (full), induct n) auto |
13114 | 3797 |
|
24526 | 3798 |
lemma nth_replicate[simp]: "i < n ==> (replicate n x)!i = x" |
3799 |
apply (induct n arbitrary: i, simp) |
|
13145 | 3800 |
apply (simp add: nth_Cons split: nat.split) |
3801 |
done |
|
13114 | 3802 |
|
16397 | 3803 |
text{* Courtesy of Matthias Daum (2 lemmas): *} |
3804 |
lemma take_replicate[simp]: "take i (replicate k x) = replicate (min i k) x" |
|
3805 |
apply (case_tac "k \<le> i") |
|
3806 |
apply (simp add: min_def) |
|
3807 |
apply (drule not_leE) |
|
3808 |
apply (simp add: min_def) |
|
3809 |
apply (subgoal_tac "replicate k x = replicate i x @ replicate (k - i) x") |
|
3810 |
apply simp |
|
3811 |
apply (simp add: replicate_add [symmetric]) |
|
3812 |
done |
|
3813 |
||
24526 | 3814 |
lemma drop_replicate[simp]: "drop i (replicate k x) = replicate (k-i) x" |
3815 |
apply (induct k arbitrary: i) |
|
16397 | 3816 |
apply simp |
3817 |
apply clarsimp |
|
3818 |
apply (case_tac i) |
|
3819 |
apply simp |
|
3820 |
apply clarsimp |
|
3821 |
done |
|
3822 |
||
13142 | 3823 |
lemma set_replicate_Suc: "set (replicate (Suc n) x) = {x}" |
13145 | 3824 |
by (induct n) auto |
13114 | 3825 |
|
13142 | 3826 |
lemma set_replicate [simp]: "n \<noteq> 0 ==> set (replicate n x) = {x}" |
13145 | 3827 |
by (fast dest!: not0_implies_Suc intro!: set_replicate_Suc) |
13114 | 3828 |
|
13142 | 3829 |
lemma set_replicate_conv_if: "set (replicate n x) = (if n = 0 then {} else {x})" |
13145 | 3830 |
by auto |
13114 | 3831 |
|
37456 | 3832 |
lemma in_set_replicate[simp]: "(x : set (replicate n y)) = (x = y & n \<noteq> 0)" |
3833 |
by (simp add: set_replicate_conv_if) |
|
3834 |
||
37454 | 3835 |
lemma Ball_set_replicate[simp]: |
3836 |
"(ALL x : set(replicate n a). P x) = (P a | n=0)" |
|
3837 |
by(simp add: set_replicate_conv_if) |
|
3838 |
||
3839 |
lemma Bex_set_replicate[simp]: |
|
3840 |
"(EX x : set(replicate n a). P x) = (P a & n\<noteq>0)" |
|
3841 |
by(simp add: set_replicate_conv_if) |
|
13114 | 3842 |
|
24796 | 3843 |
lemma replicate_append_same: |
3844 |
"replicate i x @ [x] = x # replicate i x" |
|
3845 |
by (induct i) simp_all |
|
3846 |
||
3847 |
lemma map_replicate_trivial: |
|
3848 |
"map (\<lambda>i. x) [0..<i] = replicate i x" |
|
3849 |
by (induct i) (simp_all add: replicate_append_same) |
|
3850 |
||
31363
7493b571b37d
Added theorems about distinct & concat, map & replicate and concat & replicate
hoelzl
parents:
31264
diff
changeset
|
3851 |
lemma concat_replicate_trivial[simp]: |
7493b571b37d
Added theorems about distinct & concat, map & replicate and concat & replicate
hoelzl
parents:
31264
diff
changeset
|
3852 |
"concat (replicate i []) = []" |
7493b571b37d
Added theorems about distinct & concat, map & replicate and concat & replicate
hoelzl
parents:
31264
diff
changeset
|
3853 |
by (induct i) (auto simp add: map_replicate_const) |
13114 | 3854 |
|
28642 | 3855 |
lemma replicate_empty[simp]: "(replicate n x = []) \<longleftrightarrow> n=0" |
3856 |
by (induct n) auto |
|
3857 |
||
3858 |
lemma empty_replicate[simp]: "([] = replicate n x) \<longleftrightarrow> n=0" |
|
3859 |
by (induct n) auto |
|
3860 |
||
3861 |
lemma replicate_eq_replicate[simp]: |
|
3862 |
"(replicate m x = replicate n y) \<longleftrightarrow> (m=n & (m\<noteq>0 \<longrightarrow> x=y))" |
|
3863 |
apply(induct m arbitrary: n) |
|
3864 |
apply simp |
|
3865 |
apply(induct_tac n) |
|
3866 |
apply auto |
|
3867 |
done |
|
3868 |
||
39534
c798d4f1b682
generalized lemma insort_remove1 to insort_key_remove1
haftmann
parents:
39302
diff
changeset
|
3869 |
lemma replicate_length_filter: |
c798d4f1b682
generalized lemma insort_remove1 to insort_key_remove1
haftmann
parents:
39302
diff
changeset
|
3870 |
"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
|
3871 |
by (induct xs) auto |
c798d4f1b682
generalized lemma insort_remove1 to insort_key_remove1
haftmann
parents:
39302
diff
changeset
|
3872 |
|
42714
fcba668b0839
add a lemma about commutative append to List.thy
noschinl
parents:
42713
diff
changeset
|
3873 |
lemma comm_append_are_replicate: |
fcba668b0839
add a lemma about commutative append to List.thy
noschinl
parents:
42713
diff
changeset
|
3874 |
fixes xs ys :: "'a list" |
fcba668b0839
add a lemma about commutative append to List.thy
noschinl
parents:
42713
diff
changeset
|
3875 |
assumes "xs \<noteq> []" "ys \<noteq> []" |
fcba668b0839
add a lemma about commutative append to List.thy
noschinl
parents:
42713
diff
changeset
|
3876 |
assumes "xs @ ys = ys @ xs" |
fcba668b0839
add a lemma about commutative append to List.thy
noschinl
parents:
42713
diff
changeset
|
3877 |
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
|
3878 |
using assms |
fcba668b0839
add a lemma about commutative append to List.thy
noschinl
parents:
42713
diff
changeset
|
3879 |
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
|
3880 |
case less |
fcba668b0839
add a lemma about commutative append to List.thy
noschinl
parents:
42713
diff
changeset
|
3881 |
|
fcba668b0839
add a lemma about commutative append to List.thy
noschinl
parents:
42713
diff
changeset
|
3882 |
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
|
3883 |
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
|
3884 |
then have |
fcba668b0839
add a lemma about commutative append to List.thy
noschinl
parents:
42713
diff
changeset
|
3885 |
prems': "length xs' \<le> length ys'" |
fcba668b0839
add a lemma about commutative append to List.thy
noschinl
parents:
42713
diff
changeset
|
3886 |
"xs' @ ys' = ys' @ xs'" |
fcba668b0839
add a lemma about commutative append to List.thy
noschinl
parents:
42713
diff
changeset
|
3887 |
and "xs' \<noteq> []" |
fcba668b0839
add a lemma about commutative append to List.thy
noschinl
parents:
42713
diff
changeset
|
3888 |
and len: "length (xs @ ys) = length (xs' @ ys')" |
fcba668b0839
add a lemma about commutative append to List.thy
noschinl
parents:
42713
diff
changeset
|
3889 |
using less by (auto intro: less.hyps) |
fcba668b0839
add a lemma about commutative append to List.thy
noschinl
parents:
42713
diff
changeset
|
3890 |
|
fcba668b0839
add a lemma about commutative append to List.thy
noschinl
parents:
42713
diff
changeset
|
3891 |
from prems' |
fcba668b0839
add a lemma about commutative append to List.thy
noschinl
parents:
42713
diff
changeset
|
3892 |
obtain ws where "ys' = xs' @ ws" |
fcba668b0839
add a lemma about commutative append to List.thy
noschinl
parents:
42713
diff
changeset
|
3893 |
by (auto simp: append_eq_append_conv2) |
fcba668b0839
add a lemma about commutative append to List.thy
noschinl
parents:
42713
diff
changeset
|
3894 |
|
fcba668b0839
add a lemma about commutative append to List.thy
noschinl
parents:
42713
diff
changeset
|
3895 |
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
|
3896 |
proof (cases "ws = []") |
fcba668b0839
add a lemma about commutative append to List.thy
noschinl
parents:
42713
diff
changeset
|
3897 |
case True |
fcba668b0839
add a lemma about commutative append to List.thy
noschinl
parents:
42713
diff
changeset
|
3898 |
then have "concat (replicate 1 xs') = xs'" |
fcba668b0839
add a lemma about commutative append to List.thy
noschinl
parents:
42713
diff
changeset
|
3899 |
and "concat (replicate 1 xs') = ys'" |
fcba668b0839
add a lemma about commutative append to List.thy
noschinl
parents:
42713
diff
changeset
|
3900 |
using `ys' = xs' @ ws` by auto |
fcba668b0839
add a lemma about commutative append to List.thy
noschinl
parents:
42713
diff
changeset
|
3901 |
then show ?thesis by blast |
fcba668b0839
add a lemma about commutative append to List.thy
noschinl
parents:
42713
diff
changeset
|
3902 |
next |
fcba668b0839
add a lemma about commutative append to List.thy
noschinl
parents:
42713
diff
changeset
|
3903 |
case False |
fcba668b0839
add a lemma about commutative append to List.thy
noschinl
parents:
42713
diff
changeset
|
3904 |
from `ys' = xs' @ ws` and `xs' @ ys' = ys' @ xs'` |
fcba668b0839
add a lemma about commutative append to List.thy
noschinl
parents:
42713
diff
changeset
|
3905 |
have "xs' @ ws = ws @ xs'" by simp |
fcba668b0839
add a lemma about commutative append to List.thy
noschinl
parents:
42713
diff
changeset
|
3906 |
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
|
3907 |
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
|
3908 |
by (intro less.hyps) auto |
53374
a14d2a854c02
tuned proofs -- clarified flow of facts wrt. calculation;
wenzelm
parents:
53017
diff
changeset
|
3909 |
then obtain m n zs where *: "concat (replicate m zs) = xs'" |
42714
fcba668b0839
add a lemma about commutative append to List.thy
noschinl
parents:
42713
diff
changeset
|
3910 |
and "concat (replicate n zs) = ws" by blast |
fcba668b0839
add a lemma about commutative append to List.thy
noschinl
parents:
42713
diff
changeset
|
3911 |
then have "concat (replicate (m + n) zs) = ys'" |
fcba668b0839
add a lemma about commutative append to List.thy
noschinl
parents:
42713
diff
changeset
|
3912 |
using `ys' = xs' @ ws` |
fcba668b0839
add a lemma about commutative append to List.thy
noschinl
parents:
42713
diff
changeset
|
3913 |
by (simp add: replicate_add) |
53374
a14d2a854c02
tuned proofs -- clarified flow of facts wrt. calculation;
wenzelm
parents:
53017
diff
changeset
|
3914 |
with * show ?thesis by blast |
42714
fcba668b0839
add a lemma about commutative append to List.thy
noschinl
parents:
42713
diff
changeset
|
3915 |
qed |
fcba668b0839
add a lemma about commutative append to List.thy
noschinl
parents:
42713
diff
changeset
|
3916 |
then show ?case |
fcba668b0839
add a lemma about commutative append to List.thy
noschinl
parents:
42713
diff
changeset
|
3917 |
using xs'_def ys'_def by metis |
fcba668b0839
add a lemma about commutative append to List.thy
noschinl
parents:
42713
diff
changeset
|
3918 |
qed |
fcba668b0839
add a lemma about commutative append to List.thy
noschinl
parents:
42713
diff
changeset
|
3919 |
|
fcba668b0839
add a lemma about commutative append to List.thy
noschinl
parents:
42713
diff
changeset
|
3920 |
lemma comm_append_is_replicate: |
fcba668b0839
add a lemma about commutative append to List.thy
noschinl
parents:
42713
diff
changeset
|
3921 |
fixes xs ys :: "'a list" |
fcba668b0839
add a lemma about commutative append to List.thy
noschinl
parents:
42713
diff
changeset
|
3922 |
assumes "xs \<noteq> []" "ys \<noteq> []" |
fcba668b0839
add a lemma about commutative append to List.thy
noschinl
parents:
42713
diff
changeset
|
3923 |
assumes "xs @ ys = ys @ xs" |
fcba668b0839
add a lemma about commutative append to List.thy
noschinl
parents:
42713
diff
changeset
|
3924 |
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
|
3925 |
|
fcba668b0839
add a lemma about commutative append to List.thy
noschinl
parents:
42713
diff
changeset
|
3926 |
proof - |
fcba668b0839
add a lemma about commutative append to List.thy
noschinl
parents:
42713
diff
changeset
|
3927 |
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
|
3928 |
and "concat (replicate n zs) = ys" |
fcba668b0839
add a lemma about commutative append to List.thy
noschinl
parents:
42713
diff
changeset
|
3929 |
using assms by (metis comm_append_are_replicate) |
fcba668b0839
add a lemma about commutative append to List.thy
noschinl
parents:
42713
diff
changeset
|
3930 |
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
|
3931 |
using `xs \<noteq> []` and `ys \<noteq> []` |
fcba668b0839
add a lemma about commutative append to List.thy
noschinl
parents:
42713
diff
changeset
|
3932 |
by (auto simp: replicate_add) |
fcba668b0839
add a lemma about commutative append to List.thy
noschinl
parents:
42713
diff
changeset
|
3933 |
then show ?thesis by blast |
fcba668b0839
add a lemma about commutative append to List.thy
noschinl
parents:
42713
diff
changeset
|
3934 |
qed |
fcba668b0839
add a lemma about commutative append to List.thy
noschinl
parents:
42713
diff
changeset
|
3935 |
|
52380 | 3936 |
lemma Cons_replicate_eq: |
3937 |
"x # xs = replicate n y \<longleftrightarrow> x = y \<and> n > 0 \<and> xs = replicate (n - 1) x" |
|
3938 |
by (induct n) auto |
|
3939 |
||
3940 |
lemma replicate_length_same: |
|
3941 |
"(\<forall>y\<in>set xs. y = x) \<Longrightarrow> replicate (length xs) x = xs" |
|
3942 |
by (induct xs) simp_all |
|
3943 |
||
3944 |
lemma foldr_replicate [simp]: |
|
3945 |
"foldr f (replicate n x) = f x ^^ n" |
|
3946 |
by (induct n) (simp_all) |
|
3947 |
||
3948 |
lemma fold_replicate [simp]: |
|
3949 |
"fold f (replicate n x) = f x ^^ n" |
|
3950 |
by (subst foldr_fold [symmetric]) simp_all |
|
3951 |
||
28642 | 3952 |
|
51173 | 3953 |
subsubsection {* @{const enumerate} *} |
3954 |
||
3955 |
lemma enumerate_simps [simp, code]: |
|
3956 |
"enumerate n [] = []" |
|
3957 |
"enumerate n (x # xs) = (n, x) # enumerate (Suc n) xs" |
|
3958 |
apply (auto simp add: enumerate_eq_zip not_le) |
|
3959 |
apply (cases "n < n + length xs") |
|
3960 |
apply (auto simp add: upt_conv_Cons) |
|
3961 |
done |
|
3962 |
||
3963 |
lemma length_enumerate [simp]: |
|
3964 |
"length (enumerate n xs) = length xs" |
|
3965 |
by (simp add: enumerate_eq_zip) |
|
3966 |
||
3967 |
lemma map_fst_enumerate [simp]: |
|
3968 |
"map fst (enumerate n xs) = [n..<n + length xs]" |
|
3969 |
by (simp add: enumerate_eq_zip) |
|
3970 |
||
3971 |
lemma map_snd_enumerate [simp]: |
|
3972 |
"map snd (enumerate n xs) = xs" |
|
3973 |
by (simp add: enumerate_eq_zip) |
|
3974 |
||
3975 |
lemma in_set_enumerate_eq: |
|
3976 |
"p \<in> set (enumerate n xs) \<longleftrightarrow> n \<le> fst p \<and> fst p < length xs + n \<and> nth xs (fst p - n) = snd p" |
|
3977 |
proof - |
|
3978 |
{ fix m |
|
3979 |
assume "n \<le> m" |
|
3980 |
moreover assume "m < length xs + n" |
|
3981 |
ultimately have "[n..<n + length xs] ! (m - n) = m \<and> |
|
3982 |
xs ! (m - n) = xs ! (m - n) \<and> m - n < length xs" by auto |
|
3983 |
then have "\<exists>q. [n..<n + length xs] ! q = m \<and> |
|
3984 |
xs ! q = xs ! (m - n) \<and> q < length xs" .. |
|
3985 |
} then show ?thesis by (cases p) (auto simp add: enumerate_eq_zip in_set_zip) |
|
3986 |
qed |
|
3987 |
||
3988 |
lemma nth_enumerate_eq: |
|
3989 |
assumes "m < length xs" |
|
3990 |
shows "enumerate n xs ! m = (n + m, xs ! m)" |
|
3991 |
using assms by (simp add: enumerate_eq_zip) |
|
3992 |
||
3993 |
lemma enumerate_replicate_eq: |
|
3994 |
"enumerate n (replicate m a) = map (\<lambda>q. (q, a)) [n..<n + m]" |
|
3995 |
by (rule pair_list_eqI) |
|
3996 |
(simp_all add: enumerate_eq_zip comp_def map_replicate_const) |
|
3997 |
||
3998 |
lemma enumerate_Suc_eq: |
|
3999 |
"enumerate (Suc n) xs = map (apfst Suc) (enumerate n xs)" |
|
4000 |
by (rule pair_list_eqI) |
|
4001 |
(simp_all add: not_le, simp del: map_map [simp del] add: map_Suc_upt map_map [symmetric]) |
|
4002 |
||
52379 | 4003 |
lemma distinct_enumerate [simp]: |
4004 |
"distinct (enumerate n xs)" |
|
4005 |
by (simp add: enumerate_eq_zip distinct_zipI1) |
|
4006 |
||
51173 | 4007 |
|
49948
744934b818c7
moved quite generic material from theory Enum to more appropriate places
haftmann
parents:
49808
diff
changeset
|
4008 |
subsubsection {* @{const rotate1} and @{const rotate} *} |
15302 | 4009 |
|
4010 |
lemma rotate0[simp]: "rotate 0 = id" |
|
4011 |
by(simp add:rotate_def) |
|
4012 |
||
4013 |
lemma rotate_Suc[simp]: "rotate (Suc n) xs = rotate1(rotate n xs)" |
|
4014 |
by(simp add:rotate_def) |
|
4015 |
||
4016 |
lemma rotate_add: |
|
4017 |
"rotate (m+n) = rotate m o rotate n" |
|
4018 |
by(simp add:rotate_def funpow_add) |
|
4019 |
||
4020 |
lemma rotate_rotate: "rotate m (rotate n xs) = rotate (m+n) xs" |
|
4021 |
by(simp add:rotate_add) |
|
4022 |
||
18049 | 4023 |
lemma rotate1_rotate_swap: "rotate1 (rotate n xs) = rotate n (rotate1 xs)" |
4024 |
by(simp add:rotate_def funpow_swap1) |
|
4025 |
||
15302 | 4026 |
lemma rotate1_length01[simp]: "length xs <= 1 \<Longrightarrow> rotate1 xs = xs" |
4027 |
by(cases xs) simp_all |
|
4028 |
||
4029 |
lemma rotate_length01[simp]: "length xs <= 1 \<Longrightarrow> rotate n xs = xs" |
|
4030 |
apply(induct n) |
|
4031 |
apply simp |
|
4032 |
apply (simp add:rotate_def) |
|
13145 | 4033 |
done |
13114 | 4034 |
|
15302 | 4035 |
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
|
4036 |
by (cases xs) simp_all |
15302 | 4037 |
|
4038 |
lemma rotate_drop_take: |
|
4039 |
"rotate n xs = drop (n mod length xs) xs @ take (n mod length xs) xs" |
|
4040 |
apply(induct n) |
|
4041 |
apply simp |
|
4042 |
apply(simp add:rotate_def) |
|
4043 |
apply(cases "xs = []") |
|
4044 |
apply (simp) |
|
4045 |
apply(case_tac "n mod length xs = 0") |
|
4046 |
apply(simp add:mod_Suc) |
|
4047 |
apply(simp add: rotate1_hd_tl drop_Suc take_Suc) |
|
4048 |
apply(simp add:mod_Suc rotate1_hd_tl drop_Suc[symmetric] drop_tl[symmetric] |
|
4049 |
take_hd_drop linorder_not_le) |
|
13145 | 4050 |
done |
13114 | 4051 |
|
15302 | 4052 |
lemma rotate_conv_mod: "rotate n xs = rotate (n mod length xs) xs" |
4053 |
by(simp add:rotate_drop_take) |
|
4054 |
||
4055 |
lemma rotate_id[simp]: "n mod length xs = 0 \<Longrightarrow> rotate n xs = xs" |
|
4056 |
by(simp add:rotate_drop_take) |
|
4057 |
||
4058 |
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
|
4059 |
by (cases xs) simp_all |
15302 | 4060 |
|
24526 | 4061 |
lemma length_rotate[simp]: "length(rotate n xs) = length xs" |
4062 |
by (induct n arbitrary: xs) (simp_all add:rotate_def) |
|
15302 | 4063 |
|
4064 |
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
|
4065 |
by (cases xs) auto |
15302 | 4066 |
|
4067 |
lemma distinct_rotate[simp]: "distinct(rotate n xs) = distinct xs" |
|
4068 |
by (induct n) (simp_all add:rotate_def) |
|
4069 |
||
4070 |
lemma rotate_map: "rotate n (map f xs) = map f (rotate n xs)" |
|
4071 |
by(simp add:rotate_drop_take take_map drop_map) |
|
4072 |
||
4073 |
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
|
4074 |
by (cases xs) auto |
15302 | 4075 |
|
4076 |
lemma set_rotate[simp]: "set(rotate n xs) = set xs" |
|
4077 |
by (induct n) (simp_all add:rotate_def) |
|
4078 |
||
4079 |
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
|
4080 |
by (cases xs) auto |
15302 | 4081 |
|
4082 |
lemma rotate_is_Nil_conv[simp]: "(rotate n xs = []) = (xs = [])" |
|
4083 |
by (induct n) (simp_all add:rotate_def) |
|
13114 | 4084 |
|
15439 | 4085 |
lemma rotate_rev: |
4086 |
"rotate n (rev xs) = rev(rotate (length xs - (n mod length xs)) xs)" |
|
4087 |
apply(simp add:rotate_drop_take rev_drop rev_take) |
|
4088 |
apply(cases "length xs = 0") |
|
4089 |
apply simp |
|
4090 |
apply(cases "n mod length xs = 0") |
|
4091 |
apply simp |
|
4092 |
apply(simp add:rotate_drop_take rev_drop rev_take) |
|
4093 |
done |
|
4094 |
||
18423 | 4095 |
lemma hd_rotate_conv_nth: "xs \<noteq> [] \<Longrightarrow> hd(rotate n xs) = xs!(n mod length xs)" |
4096 |
apply(simp add:rotate_drop_take hd_append hd_drop_conv_nth hd_conv_nth) |
|
4097 |
apply(subgoal_tac "length xs \<noteq> 0") |
|
4098 |
prefer 2 apply simp |
|
4099 |
using mod_less_divisor[of "length xs" n] by arith |
|
4100 |
||
13114 | 4101 |
|
49948
744934b818c7
moved quite generic material from theory Enum to more appropriate places
haftmann
parents:
49808
diff
changeset
|
4102 |
subsubsection {* @{const sublist} --- a generalization of @{const nth} to sets *} |
13114 | 4103 |
|
13142 | 4104 |
lemma sublist_empty [simp]: "sublist xs {} = []" |
13145 | 4105 |
by (auto simp add: sublist_def) |
13114 | 4106 |
|
13142 | 4107 |
lemma sublist_nil [simp]: "sublist [] A = []" |
13145 | 4108 |
by (auto simp add: sublist_def) |
13114 | 4109 |
|
15281 | 4110 |
lemma length_sublist: |
4111 |
"length(sublist xs I) = card{i. i < length xs \<and> i : I}" |
|
4112 |
by(simp add: sublist_def length_filter_conv_card cong:conj_cong) |
|
4113 |
||
4114 |
lemma sublist_shift_lemma_Suc: |
|
24526 | 4115 |
"map fst (filter (%p. P(Suc(snd p))) (zip xs is)) = |
4116 |
map fst (filter (%p. P(snd p)) (zip xs (map Suc is)))" |
|
4117 |
apply(induct xs arbitrary: "is") |
|
15281 | 4118 |
apply simp |
4119 |
apply (case_tac "is") |
|
4120 |
apply simp |
|
4121 |
apply simp |
|
4122 |
done |
|
4123 |
||
13114 | 4124 |
lemma sublist_shift_lemma: |
23279
e39dd93161d9
tuned list comprehension, changed filter syntax from : to <-
nipkow
parents:
23246
diff
changeset
|
4125 |
"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
|
4126 |
map fst [p<-zip xs [0..<length xs] . snd p + i : A]" |
13145 | 4127 |
by (induct xs rule: rev_induct) (simp_all add: add_commute) |
13114 | 4128 |
|
4129 |
lemma sublist_append: |
|
15168 | 4130 |
"sublist (l @ l') A = sublist l A @ sublist l' {j. j + length l : A}" |
13145 | 4131 |
apply (unfold sublist_def) |
14208 | 4132 |
apply (induct l' rule: rev_induct, simp) |
44921 | 4133 |
apply (simp add: upt_add_eq_append[of 0] sublist_shift_lemma) |
13145 | 4134 |
apply (simp add: add_commute) |
4135 |
done |
|
13114 | 4136 |
|
4137 |
lemma sublist_Cons: |
|
13145 | 4138 |
"sublist (x # l) A = (if 0:A then [x] else []) @ sublist l {j. Suc j : A}" |
4139 |
apply (induct l rule: rev_induct) |
|
4140 |
apply (simp add: sublist_def) |
|
4141 |
apply (simp del: append_Cons add: append_Cons[symmetric] sublist_append) |
|
4142 |
done |
|
13114 | 4143 |
|
24526 | 4144 |
lemma set_sublist: "set(sublist xs I) = {xs!i|i. i<size xs \<and> i \<in> I}" |
4145 |
apply(induct xs arbitrary: I) |
|
25162 | 4146 |
apply(auto simp: sublist_Cons nth_Cons split:nat.split dest!: gr0_implies_Suc) |
15281 | 4147 |
done |
4148 |
||
4149 |
lemma set_sublist_subset: "set(sublist xs I) \<subseteq> set xs" |
|
4150 |
by(auto simp add:set_sublist) |
|
4151 |
||
4152 |
lemma notin_set_sublistI[simp]: "x \<notin> set xs \<Longrightarrow> x \<notin> set(sublist xs I)" |
|
4153 |
by(auto simp add:set_sublist) |
|
4154 |
||
4155 |
lemma in_set_sublistD: "x \<in> set(sublist xs I) \<Longrightarrow> x \<in> set xs" |
|
4156 |
by(auto simp add:set_sublist) |
|
4157 |
||
13142 | 4158 |
lemma sublist_singleton [simp]: "sublist [x] A = (if 0 : A then [x] else [])" |
13145 | 4159 |
by (simp add: sublist_Cons) |
13114 | 4160 |
|
15281 | 4161 |
|
24526 | 4162 |
lemma distinct_sublistI[simp]: "distinct xs \<Longrightarrow> distinct(sublist xs I)" |
4163 |
apply(induct xs arbitrary: I) |
|
15281 | 4164 |
apply simp |
4165 |
apply(auto simp add:sublist_Cons) |
|
4166 |
done |
|
4167 |
||
4168 |
||
15045 | 4169 |
lemma sublist_upt_eq_take [simp]: "sublist l {..<n} = take n l" |
14208 | 4170 |
apply (induct l rule: rev_induct, simp) |
13145 | 4171 |
apply (simp split: nat_diff_split add: sublist_append) |
4172 |
done |
|
13114 | 4173 |
|
24526 | 4174 |
lemma filter_in_sublist: |
4175 |
"distinct xs \<Longrightarrow> filter (%x. x \<in> set(sublist xs s)) xs = sublist xs s" |
|
4176 |
proof (induct xs arbitrary: s) |
|
17501 | 4177 |
case Nil thus ?case by simp |
4178 |
next |
|
4179 |
case (Cons a xs) |
|
53374
a14d2a854c02
tuned proofs -- clarified flow of facts wrt. calculation;
wenzelm
parents:
53017
diff
changeset
|
4180 |
then have "!x. x: set xs \<longrightarrow> x \<noteq> a" by auto |
a14d2a854c02
tuned proofs -- clarified flow of facts wrt. calculation;
wenzelm
parents:
53017
diff
changeset
|
4181 |
with Cons show ?case by(simp add: sublist_Cons cong:filter_cong) |
17501 | 4182 |
qed |
4183 |
||
13114 | 4184 |
|
49948
744934b818c7
moved quite generic material from theory Enum to more appropriate places
haftmann
parents:
49808
diff
changeset
|
4185 |
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
|
4186 |
|
744934b818c7
moved quite generic material from theory Enum to more appropriate places
haftmann
parents:
49808
diff
changeset
|
4187 |
lemma length_sublists: |
744934b818c7
moved quite generic material from theory Enum to more appropriate places
haftmann
parents:
49808
diff
changeset
|
4188 |
"length (sublists xs) = 2 ^ length xs" |
744934b818c7
moved quite generic material from theory Enum to more appropriate places
haftmann
parents:
49808
diff
changeset
|
4189 |
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
|
4190 |
|
744934b818c7
moved quite generic material from theory Enum to more appropriate places
haftmann
parents:
49808
diff
changeset
|
4191 |
lemma sublists_powset: |
744934b818c7
moved quite generic material from theory Enum to more appropriate places
haftmann
parents:
49808
diff
changeset
|
4192 |
"set ` set (sublists xs) = Pow (set xs)" |
744934b818c7
moved quite generic material from theory Enum to more appropriate places
haftmann
parents:
49808
diff
changeset
|
4193 |
proof - |
744934b818c7
moved quite generic material from theory Enum to more appropriate places
haftmann
parents:
49808
diff
changeset
|
4194 |
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
|
4195 |
by (auto simp add: image_def) |
744934b818c7
moved quite generic material from theory Enum to more appropriate places
haftmann
parents:
49808
diff
changeset
|
4196 |
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
|
4197 |
by (induct xs) |
744934b818c7
moved quite generic material from theory Enum to more appropriate places
haftmann
parents:
49808
diff
changeset
|
4198 |
(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
|
4199 |
then show ?thesis by simp |
744934b818c7
moved quite generic material from theory Enum to more appropriate places
haftmann
parents:
49808
diff
changeset
|
4200 |
qed |
744934b818c7
moved quite generic material from theory Enum to more appropriate places
haftmann
parents:
49808
diff
changeset
|
4201 |
|
744934b818c7
moved quite generic material from theory Enum to more appropriate places
haftmann
parents:
49808
diff
changeset
|
4202 |
lemma distinct_set_sublists: |
744934b818c7
moved quite generic material from theory Enum to more appropriate places
haftmann
parents:
49808
diff
changeset
|
4203 |
assumes "distinct xs" |
744934b818c7
moved quite generic material from theory Enum to more appropriate places
haftmann
parents:
49808
diff
changeset
|
4204 |
shows "distinct (map set (sublists xs))" |
744934b818c7
moved quite generic material from theory Enum to more appropriate places
haftmann
parents:
49808
diff
changeset
|
4205 |
proof (rule card_distinct) |
744934b818c7
moved quite generic material from theory Enum to more appropriate places
haftmann
parents:
49808
diff
changeset
|
4206 |
have "finite (set xs)" by rule |
744934b818c7
moved quite generic material from theory Enum to more appropriate places
haftmann
parents:
49808
diff
changeset
|
4207 |
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
|
4208 |
with assms distinct_card [of xs] |
744934b818c7
moved quite generic material from theory Enum to more appropriate places
haftmann
parents:
49808
diff
changeset
|
4209 |
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
|
4210 |
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
|
4211 |
by (simp add: sublists_powset length_sublists) |
744934b818c7
moved quite generic material from theory Enum to more appropriate places
haftmann
parents:
49808
diff
changeset
|
4212 |
qed |
744934b818c7
moved quite generic material from theory Enum to more appropriate places
haftmann
parents:
49808
diff
changeset
|
4213 |
|
744934b818c7
moved quite generic material from theory Enum to more appropriate places
haftmann
parents:
49808
diff
changeset
|
4214 |
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
|
4215 |
by (induct n) simp_all |
744934b818c7
moved quite generic material from theory Enum to more appropriate places
haftmann
parents:
49808
diff
changeset
|
4216 |
|
744934b818c7
moved quite generic material from theory Enum to more appropriate places
haftmann
parents:
49808
diff
changeset
|
4217 |
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
|
4218 |
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
|
4219 |
|
744934b818c7
moved quite generic material from theory Enum to more appropriate places
haftmann
parents:
49808
diff
changeset
|
4220 |
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
|
4221 |
by (induct n arbitrary: ys) auto |
744934b818c7
moved quite generic material from theory Enum to more appropriate places
haftmann
parents:
49808
diff
changeset
|
4222 |
|
744934b818c7
moved quite generic material from theory Enum to more appropriate places
haftmann
parents:
49808
diff
changeset
|
4223 |
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
|
4224 |
proof (rule set_eqI) |
744934b818c7
moved quite generic material from theory Enum to more appropriate places
haftmann
parents:
49808
diff
changeset
|
4225 |
fix ys :: "'a list" |
744934b818c7
moved quite generic material from theory Enum to more appropriate places
haftmann
parents:
49808
diff
changeset
|
4226 |
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
|
4227 |
proof - |
744934b818c7
moved quite generic material from theory Enum to more appropriate places
haftmann
parents:
49808
diff
changeset
|
4228 |
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
|
4229 |
by (induct n arbitrary: ys) auto |
744934b818c7
moved quite generic material from theory Enum to more appropriate places
haftmann
parents:
49808
diff
changeset
|
4230 |
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
|
4231 |
by (induct n arbitrary: ys) auto |
744934b818c7
moved quite generic material from theory Enum to more appropriate places
haftmann
parents:
49808
diff
changeset
|
4232 |
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
|
4233 |
by (induct ys) auto |
744934b818c7
moved quite generic material from theory Enum to more appropriate places
haftmann
parents:
49808
diff
changeset
|
4234 |
ultimately show ?thesis by auto |
744934b818c7
moved quite generic material from theory Enum to more appropriate places
haftmann
parents:
49808
diff
changeset
|
4235 |
qed |
744934b818c7
moved quite generic material from theory Enum to more appropriate places
haftmann
parents:
49808
diff
changeset
|
4236 |
qed |
744934b818c7
moved quite generic material from theory Enum to more appropriate places
haftmann
parents:
49808
diff
changeset
|
4237 |
|
744934b818c7
moved quite generic material from theory Enum to more appropriate places
haftmann
parents:
49808
diff
changeset
|
4238 |
lemma distinct_n_lists: |
744934b818c7
moved quite generic material from theory Enum to more appropriate places
haftmann
parents:
49808
diff
changeset
|
4239 |
assumes "distinct xs" |
744934b818c7
moved quite generic material from theory Enum to more appropriate places
haftmann
parents:
49808
diff
changeset
|
4240 |
shows "distinct (List.n_lists n xs)" |
744934b818c7
moved quite generic material from theory Enum to more appropriate places
haftmann
parents:
49808
diff
changeset
|
4241 |
proof (rule card_distinct) |
744934b818c7
moved quite generic material from theory Enum to more appropriate places
haftmann
parents:
49808
diff
changeset
|
4242 |
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
|
4243 |
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
|
4244 |
proof (induct n) |
744934b818c7
moved quite generic material from theory Enum to more appropriate places
haftmann
parents:
49808
diff
changeset
|
4245 |
case 0 then show ?case by simp |
744934b818c7
moved quite generic material from theory Enum to more appropriate places
haftmann
parents:
49808
diff
changeset
|
4246 |
next |
744934b818c7
moved quite generic material from theory Enum to more appropriate places
haftmann
parents:
49808
diff
changeset
|
4247 |
case (Suc n) |
744934b818c7
moved quite generic material from theory Enum to more appropriate places
haftmann
parents:
49808
diff
changeset
|
4248 |
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
|
4249 |
= (\<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
|
4250 |
by (rule card_UN_disjoint) auto |
744934b818c7
moved quite generic material from theory Enum to more appropriate places
haftmann
parents:
49808
diff
changeset
|
4251 |
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
|
4252 |
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
|
4253 |
ultimately show ?case by auto |
744934b818c7
moved quite generic material from theory Enum to more appropriate places
haftmann
parents:
49808
diff
changeset
|
4254 |
qed |
744934b818c7
moved quite generic material from theory Enum to more appropriate places
haftmann
parents:
49808
diff
changeset
|
4255 |
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
|
4256 |
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
|
4257 |
by (simp add: length_n_lists) |
744934b818c7
moved quite generic material from theory Enum to more appropriate places
haftmann
parents:
49808
diff
changeset
|
4258 |
qed |
744934b818c7
moved quite generic material from theory Enum to more appropriate places
haftmann
parents:
49808
diff
changeset
|
4259 |
|
744934b818c7
moved quite generic material from theory Enum to more appropriate places
haftmann
parents:
49808
diff
changeset
|
4260 |
|
19390 | 4261 |
subsubsection {* @{const splice} *} |
4262 |
||
40593
1e57b18d27b1
code eqn for slice was missing; redefined splice with fun
nipkow
parents:
40365
diff
changeset
|
4263 |
lemma splice_Nil2 [simp, code]: "splice xs [] = xs" |
19390 | 4264 |
by (cases xs) simp_all |
4265 |
||
40593
1e57b18d27b1
code eqn for slice was missing; redefined splice with fun
nipkow
parents:
40365
diff
changeset
|
4266 |
declare splice.simps(1,3)[code] |
1e57b18d27b1
code eqn for slice was missing; redefined splice with fun
nipkow
parents:
40365
diff
changeset
|
4267 |
declare splice.simps(2)[simp del] |
19390 | 4268 |
|
24526 | 4269 |
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
|
4270 |
by (induct xs ys rule: splice.induct) auto |
22793 | 4271 |
|
35115 | 4272 |
|
4273 |
subsubsection {* Transpose *} |
|
34933 | 4274 |
|
4275 |
function transpose where |
|
4276 |
"transpose [] = []" | |
|
4277 |
"transpose ([] # xss) = transpose xss" | |
|
4278 |
"transpose ((x#xs) # xss) = |
|
4279 |
(x # [h. (h#t) \<leftarrow> xss]) # transpose (xs # [t. (h#t) \<leftarrow> xss])" |
|
4280 |
by pat_completeness auto |
|
4281 |
||
4282 |
lemma transpose_aux_filter_head: |
|
4283 |
"concat (map (list_case [] (\<lambda>h t. [h])) xss) = |
|
4284 |
map (\<lambda>xs. hd xs) [ys\<leftarrow>xss . ys \<noteq> []]" |
|
4285 |
by (induct xss) (auto split: list.split) |
|
4286 |
||
4287 |
lemma transpose_aux_filter_tail: |
|
4288 |
"concat (map (list_case [] (\<lambda>h t. [t])) xss) = |
|
4289 |
map (\<lambda>xs. tl xs) [ys\<leftarrow>xss . ys \<noteq> []]" |
|
4290 |
by (induct xss) (auto split: list.split) |
|
4291 |
||
4292 |
lemma transpose_aux_max: |
|
4293 |
"max (Suc (length xs)) (foldr (\<lambda>xs. max (length xs)) xss 0) = |
|
4294 |
Suc (max (length xs) (foldr (\<lambda>x. max (length x - Suc 0)) [ys\<leftarrow>xss . ys\<noteq>[]] 0))" |
|
4295 |
(is "max _ ?foldB = Suc (max _ ?foldA)") |
|
4296 |
proof (cases "[ys\<leftarrow>xss . ys\<noteq>[]] = []") |
|
4297 |
case True |
|
4298 |
hence "foldr (\<lambda>xs. max (length xs)) xss 0 = 0" |
|
4299 |
proof (induct xss) |
|
4300 |
case (Cons x xs) |
|
53374
a14d2a854c02
tuned proofs -- clarified flow of facts wrt. calculation;
wenzelm
parents:
53017
diff
changeset
|
4301 |
then have "x = []" by (cases x) auto |
a14d2a854c02
tuned proofs -- clarified flow of facts wrt. calculation;
wenzelm
parents:
53017
diff
changeset
|
4302 |
with Cons show ?case by auto |
34933 | 4303 |
qed simp |
4304 |
thus ?thesis using True by simp |
|
4305 |
next |
|
4306 |
case False |
|
4307 |
||
4308 |
have foldA: "?foldA = foldr (\<lambda>x. max (length x)) [ys\<leftarrow>xss . ys \<noteq> []] 0 - 1" |
|
4309 |
by (induct xss) auto |
|
4310 |
have foldB: "?foldB = foldr (\<lambda>x. max (length x)) [ys\<leftarrow>xss . ys \<noteq> []] 0" |
|
4311 |
by (induct xss) auto |
|
4312 |
||
4313 |
have "0 < ?foldB" |
|
4314 |
proof - |
|
4315 |
from False |
|
4316 |
obtain z zs where zs: "[ys\<leftarrow>xss . ys \<noteq> []] = z#zs" by (auto simp: neq_Nil_conv) |
|
4317 |
hence "z \<in> set ([ys\<leftarrow>xss . ys \<noteq> []])" by auto |
|
4318 |
hence "z \<noteq> []" by auto |
|
4319 |
thus ?thesis |
|
4320 |
unfolding foldB zs |
|
4321 |
by (auto simp: max_def intro: less_le_trans) |
|
4322 |
qed |
|
4323 |
thus ?thesis |
|
4324 |
unfolding foldA foldB max_Suc_Suc[symmetric] |
|
4325 |
by simp |
|
4326 |
qed |
|
4327 |
||
4328 |
termination transpose |
|
4329 |
by (relation "measure (\<lambda>xs. foldr (\<lambda>xs. max (length xs)) xs 0 + length xs)") |
|
4330 |
(auto simp: transpose_aux_filter_tail foldr_map comp_def transpose_aux_max less_Suc_eq_le) |
|
4331 |
||
4332 |
lemma transpose_empty: "(transpose xs = []) \<longleftrightarrow> (\<forall>x \<in> set xs. x = [])" |
|
4333 |
by (induct rule: transpose.induct) simp_all |
|
4334 |
||
4335 |
lemma length_transpose: |
|
4336 |
fixes xs :: "'a list list" |
|
4337 |
shows "length (transpose xs) = foldr (\<lambda>xs. max (length xs)) xs 0" |
|
4338 |
by (induct rule: transpose.induct) |
|
4339 |
(auto simp: transpose_aux_filter_tail foldr_map comp_def transpose_aux_max |
|
4340 |
max_Suc_Suc[symmetric] simp del: max_Suc_Suc) |
|
4341 |
||
4342 |
lemma nth_transpose: |
|
4343 |
fixes xs :: "'a list list" |
|
4344 |
assumes "i < length (transpose xs)" |
|
4345 |
shows "transpose xs ! i = map (\<lambda>xs. xs ! i) [ys \<leftarrow> xs. i < length ys]" |
|
4346 |
using assms proof (induct arbitrary: i rule: transpose.induct) |
|
4347 |
case (3 x xs xss) |
|
4348 |
def XS == "(x # xs) # xss" |
|
4349 |
hence [simp]: "XS \<noteq> []" by auto |
|
4350 |
thus ?case |
|
4351 |
proof (cases i) |
|
4352 |
case 0 |
|
4353 |
thus ?thesis by (simp add: transpose_aux_filter_head hd_conv_nth) |
|
4354 |
next |
|
4355 |
case (Suc j) |
|
4356 |
have *: "\<And>xss. xs # map tl xss = map tl ((x#xs)#xss)" by simp |
|
4357 |
have **: "\<And>xss. (x#xs) # filter (\<lambda>ys. ys \<noteq> []) xss = filter (\<lambda>ys. ys \<noteq> []) ((x#xs)#xss)" by simp |
|
4358 |
{ fix x have "Suc j < length x \<longleftrightarrow> x \<noteq> [] \<and> j < length x - Suc 0" |
|
4359 |
by (cases x) simp_all |
|
4360 |
} note *** = this |
|
4361 |
||
4362 |
have j_less: "j < length (transpose (xs # concat (map (list_case [] (\<lambda>h t. [t])) xss)))" |
|
4363 |
using "3.prems" by (simp add: transpose_aux_filter_tail length_transpose Suc) |
|
4364 |
||
4365 |
show ?thesis |
|
4366 |
unfolding transpose.simps `i = Suc j` nth_Cons_Suc "3.hyps"[OF j_less] |
|
4367 |
apply (auto simp: transpose_aux_filter_tail filter_map comp_def length_transpose * ** *** XS_def[symmetric]) |
|
4368 |
apply (rule_tac y=x in list.exhaust) |
|
4369 |
by auto |
|
4370 |
qed |
|
4371 |
qed simp_all |
|
4372 |
||
4373 |
lemma transpose_map_map: |
|
4374 |
"transpose (map (map f) xs) = map (map f) (transpose xs)" |
|
4375 |
proof (rule nth_equalityI, safe) |
|
4376 |
have [simp]: "length (transpose (map (map f) xs)) = length (transpose xs)" |
|
4377 |
by (simp add: length_transpose foldr_map comp_def) |
|
4378 |
show "length (transpose (map (map f) xs)) = length (map (map f) (transpose xs))" by simp |
|
4379 |
||
4380 |
fix i assume "i < length (transpose (map (map f) xs))" |
|
4381 |
thus "transpose (map (map f) xs) ! i = map (map f) (transpose xs) ! i" |
|
4382 |
by (simp add: nth_transpose filter_map comp_def) |
|
4383 |
qed |
|
24616 | 4384 |
|
35115 | 4385 |
|
31557 | 4386 |
subsubsection {* (In)finiteness *} |
28642 | 4387 |
|
4388 |
lemma finite_maxlen: |
|
4389 |
"finite (M::'a list set) ==> EX n. ALL s:M. size s < n" |
|
4390 |
proof (induct rule: finite.induct) |
|
4391 |
case emptyI show ?case by simp |
|
4392 |
next |
|
4393 |
case (insertI M xs) |
|
4394 |
then obtain n where "\<forall>s\<in>M. length s < n" by blast |
|
4395 |
hence "ALL s:insert xs M. size s < max n (size xs) + 1" by auto |
|
4396 |
thus ?case .. |
|
4397 |
qed |
|
4398 |
||
45714 | 4399 |
lemma lists_length_Suc_eq: |
4400 |
"{xs. set xs \<subseteq> A \<and> length xs = Suc n} = |
|
4401 |
(\<lambda>(xs, n). n#xs) ` ({xs. set xs \<subseteq> A \<and> length xs = n} \<times> A)" |
|
4402 |
by (auto simp: length_Suc_conv) |
|
4403 |
||
4404 |
lemma |
|
4405 |
assumes "finite A" |
|
4406 |
shows finite_lists_length_eq: "finite {xs. set xs \<subseteq> A \<and> length xs = n}" |
|
4407 |
and card_lists_length_eq: "card {xs. set xs \<subseteq> A \<and> length xs = n} = (card A)^n" |
|
4408 |
using `finite A` |
|
4409 |
by (induct n) |
|
4410 |
(auto simp: card_image inj_split_Cons lists_length_Suc_eq cong: conj_cong) |
|
31557 | 4411 |
|
4412 |
lemma finite_lists_length_le: |
|
4413 |
assumes "finite A" shows "finite {xs. set xs \<subseteq> A \<and> length xs \<le> n}" |
|
4414 |
(is "finite ?S") |
|
4415 |
proof- |
|
4416 |
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
|
4417 |
thus ?thesis by (auto intro!: finite_lists_length_eq[OF `finite A`] simp only:) |
31557 | 4418 |
qed |
4419 |
||
45714 | 4420 |
lemma card_lists_length_le: |
4421 |
assumes "finite A" shows "card {xs. set xs \<subseteq> A \<and> length xs \<le> n} = (\<Sum>i\<le>n. card A^i)" |
|
4422 |
proof - |
|
4423 |
have "(\<Sum>i\<le>n. card A^i) = card (\<Union>i\<le>n. {xs. set xs \<subseteq> A \<and> length xs = i})" |
|
4424 |
using `finite A` |
|
4425 |
by (subst card_UN_disjoint) |
|
4426 |
(auto simp add: card_lists_length_eq finite_lists_length_eq) |
|
4427 |
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}" |
|
4428 |
by auto |
|
4429 |
finally show ?thesis by simp |
|
4430 |
qed |
|
4431 |
||
45932 | 4432 |
lemma card_lists_distinct_length_eq: |
4433 |
assumes "k < card A" |
|
4434 |
shows "card {xs. length xs = k \<and> distinct xs \<and> set xs \<subseteq> A} = \<Prod>{card A - k + 1 .. card A}" |
|
4435 |
using assms |
|
4436 |
proof (induct k) |
|
4437 |
case 0 |
|
4438 |
then have "{xs. length xs = 0 \<and> distinct xs \<and> set xs \<subseteq> A} = {[]}" by auto |
|
4439 |
then show ?case by simp |
|
4440 |
next |
|
4441 |
case (Suc k) |
|
4442 |
let "?k_list" = "\<lambda>k xs. length xs = k \<and> distinct xs \<and> set xs \<subseteq> A" |
|
4443 |
have inj_Cons: "\<And>A. inj_on (\<lambda>(xs, n). n # xs) A" by (rule inj_onI) auto |
|
4444 |
||
4445 |
from Suc have "k < card A" by simp |
|
4446 |
moreover have "finite A" using assms by (simp add: card_ge_0_finite) |
|
4447 |
moreover have "finite {xs. ?k_list k xs}" |
|
4448 |
using finite_lists_length_eq[OF `finite A`, of k] |
|
4449 |
by - (rule finite_subset, auto) |
|
4450 |
moreover have "\<And>i j. i \<noteq> j \<longrightarrow> {i} \<times> (A - set i) \<inter> {j} \<times> (A - set j) = {}" |
|
4451 |
by auto |
|
4452 |
moreover have "\<And>i. i \<in>Collect (?k_list k) \<Longrightarrow> card (A - set i) = card A - k" |
|
4453 |
by (simp add: card_Diff_subset distinct_card) |
|
4454 |
moreover have "{xs. ?k_list (Suc k) xs} = |
|
52141
eff000cab70f
weaker precendence of syntax for big intersection and union on sets
haftmann
parents:
52131
diff
changeset
|
4455 |
(\<lambda>(xs, n). n#xs) ` \<Union>((\<lambda>xs. {xs} \<times> (A - set xs)) ` {xs. ?k_list k xs})" |
45932 | 4456 |
by (auto simp: length_Suc_conv) |
4457 |
moreover |
|
4458 |
have "Suc (card A - Suc k) = card A - k" using Suc.prems by simp |
|
4459 |
then have "(card A - k) * \<Prod>{Suc (card A - k)..card A} = \<Prod>{Suc (card A - Suc k)..card A}" |
|
4460 |
by (subst setprod_insert[symmetric]) (simp add: atLeastAtMost_insertL)+ |
|
4461 |
ultimately show ?case |
|
4462 |
by (simp add: card_image inj_Cons card_UN_disjoint Suc.hyps algebra_simps) |
|
4463 |
qed |
|
4464 |
||
28642 | 4465 |
lemma infinite_UNIV_listI: "~ finite(UNIV::'a list set)" |
4466 |
apply(rule notI) |
|
4467 |
apply(drule finite_maxlen) |
|
4468 |
apply (metis UNIV_I length_replicate less_not_refl) |
|
4469 |
done |
|
4470 |
||
4471 |
||
35115 | 4472 |
subsection {* Sorting *} |
24616 | 4473 |
|
24617 | 4474 |
text{* Currently it is not shown that @{const sort} returns a |
4475 |
permutation of its input because the nicest proof is via multisets, |
|
4476 |
which are not yet available. Alternatively one could define a function |
|
4477 |
that counts the number of occurrences of an element in a list and use |
|
4478 |
that instead of multisets to state the correctness property. *} |
|
4479 |
||
24616 | 4480 |
context linorder |
4481 |
begin |
|
4482 |
||
51548
757fa47af981
centralized various multiset operations in theory multiset;
haftmann
parents:
51540
diff
changeset
|
4483 |
lemma set_insort_key: |
757fa47af981
centralized various multiset operations in theory multiset;
haftmann
parents:
51540
diff
changeset
|
4484 |
"set (insort_key f x xs) = insert x (set xs)" |
757fa47af981
centralized various multiset operations in theory multiset;
haftmann
parents:
51540
diff
changeset
|
4485 |
by (induct xs) auto |
757fa47af981
centralized various multiset operations in theory multiset;
haftmann
parents:
51540
diff
changeset
|
4486 |
|
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
|
4487 |
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
|
4488 |
"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
|
4489 |
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
|
4490 |
|
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
|
4491 |
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
|
4492 |
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
|
4493 |
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
|
4494 |
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
|
4495 |
|
35195 | 4496 |
lemma insort_left_comm: |
4497 |
"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
|
4498 |
by (cases "x = y") (auto intro: insort_key_left_comm) |
35195 | 4499 |
|
42871
1c0b99f950d9
names of fold_set locales resemble name of characteristic property more closely
haftmann
parents:
42809
diff
changeset
|
4500 |
lemma comp_fun_commute_insort: |
1c0b99f950d9
names of fold_set locales resemble name of characteristic property more closely
haftmann
parents:
42809
diff
changeset
|
4501 |
"comp_fun_commute insort" |
35195 | 4502 |
proof |
42809
5b45125b15ba
use pointfree characterisation for fold_set locale
haftmann
parents:
42714
diff
changeset
|
4503 |
qed (simp add: insort_left_comm fun_eq_iff) |
35195 | 4504 |
|
4505 |
lemma sort_key_simps [simp]: |
|
4506 |
"sort_key f [] = []" |
|
4507 |
"sort_key f (x#xs) = insort_key f x (sort_key f xs)" |
|
4508 |
by (simp_all add: sort_key_def) |
|
4509 |
||
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
|
4510 |
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
|
4511 |
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
|
4512 |
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
|
4513 |
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
|
4514 |
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
|
4515 |
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
|
4516 |
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
|
4517 |
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
|
4518 |
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
|
4519 |
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
|
4520 |
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
|
4521 |
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
|
4522 |
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
|
4523 |
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
|
4524 |
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
|
4525 |
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
|
4526 |
|
d9fe85d3d2cd
incorporated canonical fold combinator on lists into body of List theory; refactored passages on List.fold(l/r)
haftmann
parents:
46125
diff
changeset
|
4527 |
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
|
4528 |
"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
|
4529 |
by (rule sort_key_conv_fold) simp |
35195 | 4530 |
|
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
|
4531 |
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
|
4532 |
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
|
4533 |
|
25062 | 4534 |
lemma sorted_Cons: "sorted (x#xs) = (sorted xs & (ALL y:set xs. x <= y))" |
24616 | 4535 |
apply(induct xs arbitrary: x) apply simp |
4536 |
by simp (blast intro: order_trans) |
|
4537 |
||
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
|
4538 |
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
|
4539 |
"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
|
4540 |
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
|
4541 |
|
24616 | 4542 |
lemma sorted_append: |
25062 | 4543 |
"sorted (xs@ys) = (sorted xs & sorted ys & (\<forall>x \<in> set xs. \<forall>y \<in> set ys. x\<le>y))" |
24616 | 4544 |
by (induct xs) (auto simp add:sorted_Cons) |
4545 |
||
31201 | 4546 |
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
|
4547 |
"sorted xs \<Longrightarrow> i \<le> j \<Longrightarrow> j < length xs \<Longrightarrow> xs!i \<le> xs!j" |
31201 | 4548 |
by (induct xs arbitrary: i j) (auto simp:nth_Cons' sorted_Cons) |
4549 |
||
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
|
4550 |
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
|
4551 |
"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
|
4552 |
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
|
4553 |
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
|
4554 |
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
|
4555 |
|
603320b93668
New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents:
33593
diff
changeset
|
4556 |
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
|
4557 |
"(\<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
|
4558 |
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
|
4559 |
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
|
4560 |
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
|
4561 |
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
|
4562 |
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
|
4563 |
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
|
4564 |
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
|
4565 |
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
|
4566 |
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
|
4567 |
{ |
603320b93668
New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents:
33593
diff
changeset
|
4568 |
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
|
4569 |
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
|
4570 |
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
|
4571 |
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
|
4572 |
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
|
4573 |
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
|
4574 |
} |
603320b93668
New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents:
33593
diff
changeset
|
4575 |
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
|
4576 |
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
|
4577 |
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
|
4578 |
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
|
4579 |
|
603320b93668
New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents:
33593
diff
changeset
|
4580 |
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
|
4581 |
"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
|
4582 |
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
|
4583 |
|
603320b93668
New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents:
33593
diff
changeset
|
4584 |
lemma set_insort: "set(insort_key f x xs) = insert x (set xs)" |
24616 | 4585 |
by (induct xs) auto |
4586 |
||
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
|
4587 |
lemma set_sort[simp]: "set(sort_key f xs) = set xs" |
24616 | 4588 |
by (induct xs) (simp_all add:set_insort) |
4589 |
||
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
|
4590 |
lemma distinct_insort: "distinct (insort_key f x xs) = (x \<notin> set xs \<and> distinct xs)" |
24616 | 4591 |
by(induct xs)(auto simp:set_insort) |
4592 |
||
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
|
4593 |
lemma distinct_sort[simp]: "distinct (sort_key f xs) = distinct xs" |
44921 | 4594 |
by (induct xs) (simp_all add: distinct_insort) |
24616 | 4595 |
|
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
|
4596 |
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
|
4597 |
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
|
4598 |
|
24616 | 4599 |
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
|
4600 |
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
|
4601 |
|
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
|
4602 |
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
|
4603 |
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
|
4604 |
|
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
|
4605 |
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
|
4606 |
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
|
4607 |
|
36851 | 4608 |
lemma sorted_butlast: |
4609 |
assumes "xs \<noteq> []" and "sorted xs" |
|
4610 |
shows "sorted (butlast xs)" |
|
4611 |
proof - |
|
4612 |
from `xs \<noteq> []` obtain ys y where "xs = ys @ [y]" by (cases xs rule: rev_cases) auto |
|
4613 |
with `sorted xs` show ?thesis by (simp add: sorted_append) |
|
4614 |
qed |
|
4615 |
||
4616 |
lemma insort_not_Nil [simp]: |
|
4617 |
"insort_key f a xs \<noteq> []" |
|
4618 |
by (induct xs) simp_all |
|
4619 |
||
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
|
4620 |
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
|
4621 |
by (cases xs) auto |
314c0bcb7df7
Added useful general lemmas from the work with the HeapMonad
bulwahn
parents:
26073
diff
changeset
|
4622 |
|
44916
840d8c3d9113
added lemma motivated by a more specific lemma in the AFP-KBPs theories
bulwahn
parents:
44890
diff
changeset
|
4623 |
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
|
4624 |
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
|
4625 |
|
39534
c798d4f1b682
generalized lemma insort_remove1 to insort_key_remove1
haftmann
parents:
39302
diff
changeset
|
4626 |
lemma sorted_map_remove1: |
c798d4f1b682
generalized lemma insort_remove1 to insort_key_remove1
haftmann
parents:
39302
diff
changeset
|
4627 |
"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
|
4628 |
by (induct xs) (auto simp add: sorted_Cons) |
c798d4f1b682
generalized lemma insort_remove1 to insort_key_remove1
haftmann
parents:
39302
diff
changeset
|
4629 |
|
26143
314c0bcb7df7
Added useful general lemmas from the work with the HeapMonad
bulwahn
parents:
26073
diff
changeset
|
4630 |
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
|
4631 |
using sorted_map_remove1 [of "\<lambda>x. x"] by simp |
c798d4f1b682
generalized lemma insort_remove1 to insort_key_remove1
haftmann
parents:
39302
diff
changeset
|
4632 |
|
c798d4f1b682
generalized lemma insort_remove1 to insort_key_remove1
haftmann
parents:
39302
diff
changeset
|
4633 |
lemma insort_key_remove1: |
c798d4f1b682
generalized lemma insort_remove1 to insort_key_remove1
haftmann
parents:
39302
diff
changeset
|
4634 |
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
|
4635 |
shows "insort_key f a (remove1 a xs) = xs" |
c798d4f1b682
generalized lemma insort_remove1 to insort_key_remove1
haftmann
parents:
39302
diff
changeset
|
4636 |
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
|
4637 |
case (Cons x xs) |
39534
c798d4f1b682
generalized lemma insort_remove1 to insort_key_remove1
haftmann
parents:
39302
diff
changeset
|
4638 |
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
|
4639 |
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
|
4640 |
case False |
39534
c798d4f1b682
generalized lemma insort_remove1 to insort_key_remove1
haftmann
parents:
39302
diff
changeset
|
4641 |
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
|
4642 |
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
|
4643 |
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
|
4644 |
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
|
4645 |
qed simp |
26143
314c0bcb7df7
Added useful general lemmas from the work with the HeapMonad
bulwahn
parents:
26073
diff
changeset
|
4646 |
|
39534
c798d4f1b682
generalized lemma insort_remove1 to insort_key_remove1
haftmann
parents:
39302
diff
changeset
|
4647 |
lemma insort_remove1: |
c798d4f1b682
generalized lemma insort_remove1 to insort_key_remove1
haftmann
parents:
39302
diff
changeset
|
4648 |
assumes "a \<in> set xs" and "sorted xs" |
c798d4f1b682
generalized lemma insort_remove1 to insort_key_remove1
haftmann
parents:
39302
diff
changeset
|
4649 |
shows "insort a (remove1 a xs) = xs" |
c798d4f1b682
generalized lemma insort_remove1 to insort_key_remove1
haftmann
parents:
39302
diff
changeset
|
4650 |
proof (rule insort_key_remove1) |
c798d4f1b682
generalized lemma insort_remove1 to insort_key_remove1
haftmann
parents:
39302
diff
changeset
|
4651 |
from `a \<in> set xs` show "a \<in> set xs" . |
c798d4f1b682
generalized lemma insort_remove1 to insort_key_remove1
haftmann
parents:
39302
diff
changeset
|
4652 |
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
|
4653 |
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
|
4654 |
then have "set (filter (op = a) xs) \<noteq> {}" by auto |
c798d4f1b682
generalized lemma insort_remove1 to insort_key_remove1
haftmann
parents:
39302
diff
changeset
|
4655 |
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
|
4656 |
then have "length (filter (op = a) xs) > 0" by simp |
c798d4f1b682
generalized lemma insort_remove1 to insort_key_remove1
haftmann
parents:
39302
diff
changeset
|
4657 |
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
|
4658 |
by (cases "length (filter (op = a) xs)") simp_all |
c798d4f1b682
generalized lemma insort_remove1 to insort_key_remove1
haftmann
parents:
39302
diff
changeset
|
4659 |
moreover have "replicate (Suc n) a = a # replicate n a" |
c798d4f1b682
generalized lemma insort_remove1 to insort_key_remove1
haftmann
parents:
39302
diff
changeset
|
4660 |
by simp |
c798d4f1b682
generalized lemma insort_remove1 to insort_key_remove1
haftmann
parents:
39302
diff
changeset
|
4661 |
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
|
4662 |
qed |
26143
314c0bcb7df7
Added useful general lemmas from the work with the HeapMonad
bulwahn
parents:
26073
diff
changeset
|
4663 |
|
314c0bcb7df7
Added useful general lemmas from the work with the HeapMonad
bulwahn
parents:
26073
diff
changeset
|
4664 |
lemma sorted_remdups[simp]: |
314c0bcb7df7
Added useful general lemmas from the work with the HeapMonad
bulwahn
parents:
26073
diff
changeset
|
4665 |
"sorted l \<Longrightarrow> sorted (remdups l)" |
314c0bcb7df7
Added useful general lemmas from the work with the HeapMonad
bulwahn
parents:
26073
diff
changeset
|
4666 |
by (induct l) (auto simp: sorted_Cons) |
314c0bcb7df7
Added useful general lemmas from the work with the HeapMonad
bulwahn
parents:
26073
diff
changeset
|
4667 |
|
53721
ccaceea6c768
added two functions to List (one contributed by Manuel Eberl)
traytel
parents:
53689
diff
changeset
|
4668 |
lemma sorted_remdups_adj[simp]: |
ccaceea6c768
added two functions to List (one contributed by Manuel Eberl)
traytel
parents:
53689
diff
changeset
|
4669 |
"sorted xs \<Longrightarrow> sorted (remdups_adj xs)" |
ccaceea6c768
added two functions to List (one contributed by Manuel Eberl)
traytel
parents:
53689
diff
changeset
|
4670 |
by (induct xs rule: remdups_adj.induct, simp_all split: split_if_asm add: sorted_Cons) |
ccaceea6c768
added two functions to List (one contributed by Manuel Eberl)
traytel
parents:
53689
diff
changeset
|
4671 |
|
24645 | 4672 |
lemma sorted_distinct_set_unique: |
4673 |
assumes "sorted xs" "distinct xs" "sorted ys" "distinct ys" "set xs = set ys" |
|
4674 |
shows "xs = ys" |
|
4675 |
proof - |
|
26734 | 4676 |
from assms have 1: "length xs = length ys" by (auto dest!: distinct_card) |
24645 | 4677 |
from assms show ?thesis |
4678 |
proof(induct rule:list_induct2[OF 1]) |
|
4679 |
case 1 show ?case by simp |
|
4680 |
next |
|
4681 |
case 2 thus ?case by (simp add:sorted_Cons) |
|
4682 |
(metis Diff_insert_absorb antisym insertE insert_iff) |
|
4683 |
qed |
|
4684 |
qed |
|
4685 |
||
35603 | 4686 |
lemma map_sorted_distinct_set_unique: |
4687 |
assumes "inj_on f (set xs \<union> set ys)" |
|
4688 |
assumes "sorted (map f xs)" "distinct (map f xs)" |
|
4689 |
"sorted (map f ys)" "distinct (map f ys)" |
|
4690 |
assumes "set xs = set ys" |
|
4691 |
shows "xs = ys" |
|
4692 |
proof - |
|
4693 |
from assms have "map f xs = map f ys" |
|
4694 |
by (simp add: sorted_distinct_set_unique) |
|
53374
a14d2a854c02
tuned proofs -- clarified flow of facts wrt. calculation;
wenzelm
parents:
53017
diff
changeset
|
4695 |
with `inj_on f (set xs \<union> set ys)` show "xs = ys" |
35603 | 4696 |
by (blast intro: map_inj_on) |
4697 |
qed |
|
4698 |
||
24645 | 4699 |
lemma finite_sorted_distinct_unique: |
4700 |
shows "finite A \<Longrightarrow> EX! xs. set xs = A & sorted xs & distinct xs" |
|
4701 |
apply(drule finite_distinct_list) |
|
4702 |
apply clarify |
|
4703 |
apply(rule_tac a="sort xs" in ex1I) |
|
4704 |
apply (auto simp: sorted_distinct_set_unique) |
|
4705 |
done |
|
4706 |
||
39915
ecf97cf3d248
turned distinct and sorted into inductive predicates: yields nice induction principles for free; more elegant proofs
haftmann
parents:
39774
diff
changeset
|
4707 |
lemma |
ecf97cf3d248
turned distinct and sorted into inductive predicates: yields nice induction principles for free; more elegant proofs
haftmann
parents:
39774
diff
changeset
|
4708 |
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
|
4709 |
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
|
4710 |
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
|
4711 |
proof - |
ecf97cf3d248
turned distinct and sorted into inductive predicates: yields nice induction principles for free; more elegant proofs
haftmann
parents:
39774
diff
changeset
|
4712 |
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
|
4713 |
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
|
4714 |
unfolding sorted_append by simp_all |
29626 | 4715 |
qed |
4716 |
||
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
|
4717 |
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
|
4718 |
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
|
4719 |
|
603320b93668
New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents:
33593
diff
changeset
|
4720 |
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
|
4721 |
by (subst takeWhile_eq_take) (auto dest: sorted_take) |
29626 | 4722 |
|
34933 | 4723 |
lemma sorted_filter: |
4724 |
"sorted (map f xs) \<Longrightarrow> sorted (map f (filter P xs))" |
|
4725 |
by (induct xs) (simp_all add: sorted_Cons) |
|
4726 |
||
4727 |
lemma foldr_max_sorted: |
|
4728 |
assumes "sorted (rev xs)" |
|
4729 |
shows "foldr max xs y = (if xs = [] then y else max (xs ! 0) y)" |
|
53374
a14d2a854c02
tuned proofs -- clarified flow of facts wrt. calculation;
wenzelm
parents:
53017
diff
changeset
|
4730 |
using assms |
a14d2a854c02
tuned proofs -- clarified flow of facts wrt. calculation;
wenzelm
parents:
53017
diff
changeset
|
4731 |
proof (induct xs) |
34933 | 4732 |
case (Cons x xs) |
53374
a14d2a854c02
tuned proofs -- clarified flow of facts wrt. calculation;
wenzelm
parents:
53017
diff
changeset
|
4733 |
then have "sorted (rev xs)" using sorted_append by auto |
a14d2a854c02
tuned proofs -- clarified flow of facts wrt. calculation;
wenzelm
parents:
53017
diff
changeset
|
4734 |
with Cons show ?case |
a14d2a854c02
tuned proofs -- clarified flow of facts wrt. calculation;
wenzelm
parents:
53017
diff
changeset
|
4735 |
by (cases xs) (auto simp add: sorted_append max_def) |
34933 | 4736 |
qed simp |
4737 |
||
4738 |
lemma filter_equals_takeWhile_sorted_rev: |
|
4739 |
assumes sorted: "sorted (rev (map f xs))" |
|
4740 |
shows "[x \<leftarrow> xs. t < f x] = takeWhile (\<lambda> x. t < f x) xs" |
|
4741 |
(is "filter ?P xs = ?tW") |
|
4742 |
proof (rule takeWhile_eq_filter[symmetric]) |
|
4743 |
let "?dW" = "dropWhile ?P xs" |
|
4744 |
fix x assume "x \<in> set ?dW" |
|
4745 |
then obtain i where i: "i < length ?dW" and nth_i: "x = ?dW ! i" |
|
4746 |
unfolding in_set_conv_nth by auto |
|
4747 |
hence "length ?tW + i < length (?tW @ ?dW)" |
|
4748 |
unfolding length_append by simp |
|
4749 |
hence i': "length (map f ?tW) + i < length (map f xs)" by simp |
|
4750 |
have "(map f ?tW @ map f ?dW) ! (length (map f ?tW) + i) \<le> |
|
4751 |
(map f ?tW @ map f ?dW) ! (length (map f ?tW) + 0)" |
|
4752 |
using sorted_rev_nth_mono[OF sorted _ i', of "length ?tW"] |
|
4753 |
unfolding map_append[symmetric] by simp |
|
4754 |
hence "f x \<le> f (?dW ! 0)" |
|
4755 |
unfolding nth_append_length_plus nth_i |
|
4756 |
using i preorder_class.le_less_trans[OF le0 i] by simp |
|
4757 |
also have "... \<le> t" |
|
4758 |
using hd_dropWhile[of "?P" xs] le0[THEN preorder_class.le_less_trans, OF i] |
|
4759 |
using hd_conv_nth[of "?dW"] by simp |
|
4760 |
finally show "\<not> t < f x" by simp |
|
4761 |
qed |
|
4762 |
||
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
|
4763 |
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
|
4764 |
"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
|
4765 |
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
|
4766 |
|
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
|
4767 |
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
|
4768 |
"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
|
4769 |
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
|
4770 |
|
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
|
4771 |
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
|
4772 |
"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
|
4773 |
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
|
4774 |
|
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
|
4775 |
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
|
4776 |
"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
|
4777 |
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
|
4778 |
|
35608 | 4779 |
lemma set_insort_insert: |
4780 |
"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
|
4781 |
by (auto simp add: insort_insert_key_def set_insort) |
35608 | 4782 |
|
4783 |
lemma distinct_insort_insert: |
|
4784 |
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
|
4785 |
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
|
4786 |
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
|
4787 |
|
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
|
4788 |
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
|
4789 |
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
|
4790 |
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
|
4791 |
using assms by (simp add: insort_insert_key_def sorted_insort_key) |
35608 | 4792 |
|
4793 |
lemma sorted_insort_insert: |
|
4794 |
assumes "sorted xs" |
|
4795 |
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
|
4796 |
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
|
4797 |
|
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
|
4798 |
lemma filter_insort_triv: |
37107 | 4799 |
"\<not> P x \<Longrightarrow> filter P (insort_key f x xs) = filter P xs" |
4800 |
by (induct xs) simp_all |
|
4801 |
||
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
|
4802 |
lemma filter_insort: |
37107 | 4803 |
"sorted (map f xs) \<Longrightarrow> P x \<Longrightarrow> filter P (insort_key f x xs) = insort_key f x (filter P xs)" |
4804 |
using assms by (induct xs) |
|
4805 |
(auto simp add: sorted_Cons, subst insort_is_Cons, auto) |
|
4806 |
||
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
|
4807 |
lemma filter_sort: |
37107 | 4808 |
"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
|
4809 |
by (induct xs) (simp_all add: filter_insort_triv filter_insort) |
37107 | 4810 |
|
40304 | 4811 |
lemma sorted_map_same: |
4812 |
"sorted (map f [x\<leftarrow>xs. f x = g xs])" |
|
4813 |
proof (induct xs arbitrary: g) |
|
37107 | 4814 |
case Nil then show ?case by simp |
4815 |
next |
|
4816 |
case (Cons x xs) |
|
40304 | 4817 |
then have "sorted (map f [y\<leftarrow>xs . f y = (\<lambda>xs. f x) xs])" . |
4818 |
moreover from Cons have "sorted (map f [y\<leftarrow>xs . f y = (g \<circ> Cons x) xs])" . |
|
37107 | 4819 |
ultimately show ?case by (simp_all add: sorted_Cons) |
4820 |
qed |
|
4821 |
||
40304 | 4822 |
lemma sorted_same: |
4823 |
"sorted [x\<leftarrow>xs. x = g xs]" |
|
4824 |
using sorted_map_same [of "\<lambda>x. x"] by simp |
|
4825 |
||
37107 | 4826 |
lemma remove1_insort [simp]: |
4827 |
"remove1 x (insort x xs) = xs" |
|
4828 |
by (induct xs) simp_all |
|
4829 |
||
24616 | 4830 |
end |
4831 |
||
25277 | 4832 |
lemma sorted_upt[simp]: "sorted[i..<j]" |
4833 |
by (induct j) (simp_all add:sorted_append) |
|
4834 |
||
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
|
4835 |
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
|
4836 |
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
|
4837 |
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
|
4838 |
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
|
4839 |
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
|
4840 |
|
52379 | 4841 |
lemma sorted_find_Min: |
4842 |
assumes "sorted xs" |
|
4843 |
assumes "\<exists>x \<in> set xs. P x" |
|
4844 |
shows "List.find P xs = Some (Min {x\<in>set xs. P x})" |
|
4845 |
using assms proof (induct xs rule: sorted.induct) |
|
4846 |
case Nil then show ?case by simp |
|
4847 |
next |
|
4848 |
case (Cons xs x) show ?case proof (cases "P x") |
|
4849 |
case True with Cons show ?thesis by (auto intro: Min_eqI [symmetric]) |
|
4850 |
next |
|
4851 |
case False then have "{y. (y = x \<or> y \<in> set xs) \<and> P y} = {y \<in> set xs. P y}" |
|
4852 |
by auto |
|
4853 |
with Cons False show ?thesis by simp_all |
|
4854 |
qed |
|
4855 |
qed |
|
4856 |
||
35115 | 4857 |
|
4858 |
subsubsection {* @{const transpose} on sorted lists *} |
|
34933 | 4859 |
|
4860 |
lemma sorted_transpose[simp]: |
|
4861 |
shows "sorted (rev (map length (transpose xs)))" |
|
4862 |
by (auto simp: sorted_equals_nth_mono rev_nth nth_transpose |
|
4863 |
length_filter_conv_card intro: card_mono) |
|
4864 |
||
4865 |
lemma transpose_max_length: |
|
4866 |
"foldr (\<lambda>xs. max (length xs)) (transpose xs) 0 = length [x \<leftarrow> xs. x \<noteq> []]" |
|
4867 |
(is "?L = ?R") |
|
4868 |
proof (cases "transpose xs = []") |
|
4869 |
case False |
|
4870 |
have "?L = foldr max (map length (transpose xs)) 0" |
|
4871 |
by (simp add: foldr_map comp_def) |
|
4872 |
also have "... = length (transpose xs ! 0)" |
|
4873 |
using False sorted_transpose by (simp add: foldr_max_sorted) |
|
4874 |
finally show ?thesis |
|
4875 |
using False by (simp add: nth_transpose) |
|
4876 |
next |
|
4877 |
case True |
|
4878 |
hence "[x \<leftarrow> xs. x \<noteq> []] = []" |
|
4879 |
by (auto intro!: filter_False simp: transpose_empty) |
|
4880 |
thus ?thesis by (simp add: transpose_empty True) |
|
4881 |
qed |
|
4882 |
||
4883 |
lemma length_transpose_sorted: |
|
4884 |
fixes xs :: "'a list list" |
|
4885 |
assumes sorted: "sorted (rev (map length xs))" |
|
4886 |
shows "length (transpose xs) = (if xs = [] then 0 else length (xs ! 0))" |
|
4887 |
proof (cases "xs = []") |
|
4888 |
case False |
|
4889 |
thus ?thesis |
|
4890 |
using foldr_max_sorted[OF sorted] False |
|
4891 |
unfolding length_transpose foldr_map comp_def |
|
4892 |
by simp |
|
4893 |
qed simp |
|
4894 |
||
4895 |
lemma nth_nth_transpose_sorted[simp]: |
|
4896 |
fixes xs :: "'a list list" |
|
4897 |
assumes sorted: "sorted (rev (map length xs))" |
|
4898 |
and i: "i < length (transpose xs)" |
|
4899 |
and j: "j < length [ys \<leftarrow> xs. i < length ys]" |
|
4900 |
shows "transpose xs ! i ! j = xs ! j ! i" |
|
4901 |
using j filter_equals_takeWhile_sorted_rev[OF sorted, of i] |
|
4902 |
nth_transpose[OF i] nth_map[OF j] |
|
4903 |
by (simp add: takeWhile_nth) |
|
4904 |
||
4905 |
lemma transpose_column_length: |
|
4906 |
fixes xs :: "'a list list" |
|
4907 |
assumes sorted: "sorted (rev (map length xs))" and "i < length xs" |
|
4908 |
shows "length (filter (\<lambda>ys. i < length ys) (transpose xs)) = length (xs ! i)" |
|
4909 |
proof - |
|
4910 |
have "xs \<noteq> []" using `i < length xs` by auto |
|
4911 |
note filter_equals_takeWhile_sorted_rev[OF sorted, simp] |
|
4912 |
{ fix j assume "j \<le> i" |
|
4913 |
note sorted_rev_nth_mono[OF sorted, of j i, simplified, OF this `i < length xs`] |
|
4914 |
} note sortedE = this[consumes 1] |
|
4915 |
||
4916 |
have "{j. j < length (transpose xs) \<and> i < length (transpose xs ! j)} |
|
4917 |
= {..< length (xs ! i)}" |
|
4918 |
proof safe |
|
4919 |
fix j |
|
4920 |
assume "j < length (transpose xs)" and "i < length (transpose xs ! j)" |
|
4921 |
with this(2) nth_transpose[OF this(1)] |
|
4922 |
have "i < length (takeWhile (\<lambda>ys. j < length ys) xs)" by simp |
|
4923 |
from nth_mem[OF this] takeWhile_nth[OF this] |
|
4924 |
show "j < length (xs ! i)" by (auto dest: set_takeWhileD) |
|
4925 |
next |
|
4926 |
fix j assume "j < length (xs ! i)" |
|
4927 |
thus "j < length (transpose xs)" |
|
4928 |
using foldr_max_sorted[OF sorted] `xs \<noteq> []` sortedE[OF le0] |
|
4929 |
by (auto simp: length_transpose comp_def foldr_map) |
|
4930 |
||
4931 |
have "Suc i \<le> length (takeWhile (\<lambda>ys. j < length ys) xs)" |
|
4932 |
using `i < length xs` `j < length (xs ! i)` less_Suc_eq_le |
|
4933 |
by (auto intro!: length_takeWhile_less_P_nth dest!: sortedE) |
|
4934 |
with nth_transpose[OF `j < length (transpose xs)`] |
|
4935 |
show "i < length (transpose xs ! j)" by simp |
|
4936 |
qed |
|
4937 |
thus ?thesis by (simp add: length_filter_conv_card) |
|
4938 |
qed |
|
4939 |
||
4940 |
lemma transpose_column: |
|
4941 |
fixes xs :: "'a list list" |
|
4942 |
assumes sorted: "sorted (rev (map length xs))" and "i < length xs" |
|
4943 |
shows "map (\<lambda>ys. ys ! i) (filter (\<lambda>ys. i < length ys) (transpose xs)) |
|
4944 |
= xs ! i" (is "?R = _") |
|
4945 |
proof (rule nth_equalityI, safe) |
|
4946 |
show length: "length ?R = length (xs ! i)" |
|
4947 |
using transpose_column_length[OF assms] by simp |
|
4948 |
||
4949 |
fix j assume j: "j < length ?R" |
|
4950 |
note * = less_le_trans[OF this, unfolded length_map, OF length_filter_le] |
|
4951 |
from j have j_less: "j < length (xs ! i)" using length by simp |
|
4952 |
have i_less_tW: "Suc i \<le> length (takeWhile (\<lambda>ys. Suc j \<le> length ys) xs)" |
|
4953 |
proof (rule length_takeWhile_less_P_nth) |
|
4954 |
show "Suc i \<le> length xs" using `i < length xs` by simp |
|
4955 |
fix k assume "k < Suc i" |
|
4956 |
hence "k \<le> i" by auto |
|
4957 |
with sorted_rev_nth_mono[OF sorted this] `i < length xs` |
|
4958 |
have "length (xs ! i) \<le> length (xs ! k)" by simp |
|
4959 |
thus "Suc j \<le> length (xs ! k)" using j_less by simp |
|
4960 |
qed |
|
4961 |
have i_less_filter: "i < length [ys\<leftarrow>xs . j < length ys]" |
|
4962 |
unfolding filter_equals_takeWhile_sorted_rev[OF sorted, of j] |
|
4963 |
using i_less_tW by (simp_all add: Suc_le_eq) |
|
4964 |
from j show "?R ! j = xs ! i ! j" |
|
4965 |
unfolding filter_equals_takeWhile_sorted_rev[OF sorted_transpose, of i] |
|
4966 |
by (simp add: takeWhile_nth nth_nth_transpose_sorted[OF sorted * i_less_filter]) |
|
4967 |
qed |
|
4968 |
||
4969 |
lemma transpose_transpose: |
|
4970 |
fixes xs :: "'a list list" |
|
4971 |
assumes sorted: "sorted (rev (map length xs))" |
|
4972 |
shows "transpose (transpose xs) = takeWhile (\<lambda>x. x \<noteq> []) xs" (is "?L = ?R") |
|
4973 |
proof - |
|
4974 |
have len: "length ?L = length ?R" |
|
4975 |
unfolding length_transpose transpose_max_length |
|
4976 |
using filter_equals_takeWhile_sorted_rev[OF sorted, of 0] |
|
4977 |
by simp |
|
4978 |
||
4979 |
{ fix i assume "i < length ?R" |
|
4980 |
with less_le_trans[OF _ length_takeWhile_le[of _ xs]] |
|
4981 |
have "i < length xs" by simp |
|
4982 |
} note * = this |
|
4983 |
show ?thesis |
|
4984 |
by (rule nth_equalityI) |
|
4985 |
(simp_all add: len nth_transpose transpose_column[OF sorted] * takeWhile_nth) |
|
4986 |
qed |
|
24616 | 4987 |
|
34934
440605046777
Added transpose_rectangle, when the input list is rectangular.
hoelzl
parents:
34933
diff
changeset
|
4988 |
theorem transpose_rectangle: |
440605046777
Added transpose_rectangle, when the input list is rectangular.
hoelzl
parents:
34933
diff
changeset
|
4989 |
assumes "xs = [] \<Longrightarrow> n = 0" |
440605046777
Added transpose_rectangle, when the input list is rectangular.
hoelzl
parents:
34933
diff
changeset
|
4990 |
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
|
4991 |
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
|
4992 |
(is "?trans = ?map") |
440605046777
Added transpose_rectangle, when the input list is rectangular.
hoelzl
parents:
34933
diff
changeset
|
4993 |
proof (rule nth_equalityI) |
440605046777
Added transpose_rectangle, when the input list is rectangular.
hoelzl
parents:
34933
diff
changeset
|
4994 |
have "sorted (rev (map length xs))" |
440605046777
Added transpose_rectangle, when the input list is rectangular.
hoelzl
parents:
34933
diff
changeset
|
4995 |
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
|
4996 |
from foldr_max_sorted[OF this] assms |
440605046777
Added transpose_rectangle, when the input list is rectangular.
hoelzl
parents:
34933
diff
changeset
|
4997 |
show len: "length ?trans = length ?map" |
440605046777
Added transpose_rectangle, when the input list is rectangular.
hoelzl
parents:
34933
diff
changeset
|
4998 |
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
|
4999 |
moreover |
440605046777
Added transpose_rectangle, when the input list is rectangular.
hoelzl
parents:
34933
diff
changeset
|
5000 |
{ 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
|
5001 |
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
|
5002 |
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
|
5003 |
by (auto simp: nth_transpose intro: nth_equalityI) |
440605046777
Added transpose_rectangle, when the input list is rectangular.
hoelzl
parents:
34933
diff
changeset
|
5004 |
qed |
24616 | 5005 |
|
35115 | 5006 |
|
25069 | 5007 |
subsubsection {* @{text sorted_list_of_set} *} |
5008 |
||
5009 |
text{* This function maps (finite) linearly ordered sets to sorted |
|
5010 |
lists. Warning: in most cases it is not a good idea to convert from |
|
5011 |
sets to lists but one should convert in the other direction (via |
|
5012 |
@{const set}). *} |
|
5013 |
||
51489 | 5014 |
subsubsection {* @{text sorted_list_of_set} *} |
5015 |
||
5016 |
text{* This function maps (finite) linearly ordered sets to sorted |
|
5017 |
lists. Warning: in most cases it is not a good idea to convert from |
|
5018 |
sets to lists but one should convert in the other direction (via |
|
5019 |
@{const set}). *} |
|
5020 |
||
5021 |
definition (in linorder) sorted_list_of_set :: "'a set \<Rightarrow> 'a list" where |
|
5022 |
"sorted_list_of_set = folding.F insort []" |
|
5023 |
||
5024 |
sublocale linorder < sorted_list_of_set!: folding insort Nil |
|
5025 |
where |
|
5026 |
"folding.F insort [] = sorted_list_of_set" |
|
5027 |
proof - |
|
5028 |
interpret comp_fun_commute insort by (fact comp_fun_commute_insort) |
|
5029 |
show "folding insort" by default (fact comp_fun_commute) |
|
5030 |
show "folding.F insort [] = sorted_list_of_set" by (simp only: sorted_list_of_set_def) |
|
5031 |
qed |
|
5032 |
||
25069 | 5033 |
context linorder |
5034 |
begin |
|
5035 |
||
51489 | 5036 |
lemma sorted_list_of_set_empty: |
35195 | 5037 |
"sorted_list_of_set {} = []" |
51489 | 5038 |
by (fact sorted_list_of_set.empty) |
35195 | 5039 |
|
5040 |
lemma sorted_list_of_set_insert [simp]: |
|
5041 |
assumes "finite A" |
|
5042 |
shows "sorted_list_of_set (insert x A) = insort x (sorted_list_of_set (A - {x}))" |
|
51489 | 5043 |
using assms by (fact sorted_list_of_set.insert_remove) |
35195 | 5044 |
|
52122 | 5045 |
lemma sorted_list_of_set_eq_Nil_iff [simp]: |
5046 |
"finite A \<Longrightarrow> sorted_list_of_set A = [] \<longleftrightarrow> A = {}" |
|
5047 |
using assms by (auto simp: sorted_list_of_set.remove) |
|
5048 |
||
35195 | 5049 |
lemma sorted_list_of_set [simp]: |
5050 |
"finite A \<Longrightarrow> set (sorted_list_of_set A) = A \<and> sorted (sorted_list_of_set A) |
|
5051 |
\<and> distinct (sorted_list_of_set A)" |
|
5052 |
by (induct A rule: finite_induct) (simp_all add: set_insort sorted_insort distinct_insort) |
|
5053 |
||
52122 | 5054 |
lemma distinct_sorted_list_of_set: |
5055 |
"distinct (sorted_list_of_set A)" |
|
5056 |
using sorted_list_of_set by (cases "finite A") auto |
|
5057 |
||
47841 | 5058 |
lemma sorted_list_of_set_sort_remdups [code]: |
35195 | 5059 |
"sorted_list_of_set (set xs) = sort (remdups xs)" |
5060 |
proof - |
|
42871
1c0b99f950d9
names of fold_set locales resemble name of characteristic property more closely
haftmann
parents:
42809
diff
changeset
|
5061 |
interpret comp_fun_commute insort by (fact comp_fun_commute_insort) |
51489 | 5062 |
show ?thesis by (simp add: sorted_list_of_set.eq_fold sort_conv_fold fold_set_fold_remdups) |
35195 | 5063 |
qed |
25069 | 5064 |
|
37107 | 5065 |
lemma sorted_list_of_set_remove: |
5066 |
assumes "finite A" |
|
5067 |
shows "sorted_list_of_set (A - {x}) = remove1 x (sorted_list_of_set A)" |
|
5068 |
proof (cases "x \<in> A") |
|
5069 |
case False with assms have "x \<notin> set (sorted_list_of_set A)" by simp |
|
5070 |
with False show ?thesis by (simp add: remove1_idem) |
|
5071 |
next |
|
5072 |
case True then obtain B where A: "A = insert x B" by (rule Set.set_insert) |
|
5073 |
with assms show ?thesis by simp |
|
5074 |
qed |
|
5075 |
||
25069 | 5076 |
end |
5077 |
||
37107 | 5078 |
lemma sorted_list_of_set_range [simp]: |
5079 |
"sorted_list_of_set {m..<n} = [m..<n]" |
|
5080 |
by (rule sorted_distinct_set_unique) simp_all |
|
5081 |
||
5082 |
||
15392 | 5083 |
subsubsection {* @{text lists}: the list-forming operator over sets *} |
15302 | 5084 |
|
23740 | 5085 |
inductive_set |
22262 | 5086 |
lists :: "'a set => 'a list set" |
23740 | 5087 |
for A :: "'a set" |
5088 |
where |
|
39613 | 5089 |
Nil [intro!, simp]: "[]: lists A" |
54147
97a8ff4e4ac9
killed most "no_atp", to make Sledgehammer more complete
blanchet
parents:
53954
diff
changeset
|
5090 |
| Cons [intro!, simp]: "[| a: A; l: lists A|] ==> a#l : lists A" |
97a8ff4e4ac9
killed most "no_atp", to make Sledgehammer more complete
blanchet
parents:
53954
diff
changeset
|
5091 |
|
97a8ff4e4ac9
killed most "no_atp", to make Sledgehammer more complete
blanchet
parents:
53954
diff
changeset
|
5092 |
inductive_cases listsE [elim!]: "x#l : lists A" |
97a8ff4e4ac9
killed most "no_atp", to make Sledgehammer more complete
blanchet
parents:
53954
diff
changeset
|
5093 |
inductive_cases listspE [elim!]: "listsp A (x # l)" |
23740 | 5094 |
|
46313 | 5095 |
inductive_simps listsp_simps[code]: |
5096 |
"listsp A []" |
|
5097 |
"listsp A (x # xs)" |
|
5098 |
||
23740 | 5099 |
lemma listsp_mono [mono]: "A \<le> B ==> listsp A \<le> listsp B" |
46884 | 5100 |
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
|
5101 |
|
46176
1898e61e89c4
pred_subset/equals_eq are now standard pred_set_conv rules
berghofe
parents:
46156
diff
changeset
|
5102 |
lemmas lists_mono = listsp_mono [to_set] |
22262 | 5103 |
|
22422
ee19cdb07528
stepping towards uniform lattice theory development in HOL
haftmann
parents:
22262
diff
changeset
|
5104 |
lemma listsp_infI: |
ee19cdb07528
stepping towards uniform lattice theory development in HOL
haftmann
parents:
22262
diff
changeset
|
5105 |
assumes l: "listsp A l" shows "listsp B l ==> listsp (inf A B) l" using l |
24349 | 5106 |
by induct blast+ |
15302 | 5107 |
|
22422
ee19cdb07528
stepping towards uniform lattice theory development in HOL
haftmann
parents:
22262
diff
changeset
|
5108 |
lemmas lists_IntI = listsp_infI [to_set] |
ee19cdb07528
stepping towards uniform lattice theory development in HOL
haftmann
parents:
22262
diff
changeset
|
5109 |
|
ee19cdb07528
stepping towards uniform lattice theory development in HOL
haftmann
parents:
22262
diff
changeset
|
5110 |
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
|
5111 |
proof (rule mono_inf [where f=listsp, THEN order_antisym]) |
22262 | 5112 |
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
|
5113 |
show "inf (listsp A) (listsp B) \<le> listsp (inf A B)" by (blast intro!: listsp_infI) |
14388 | 5114 |
qed |
5115 |
||
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
|
5116 |
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
|
5117 |
|
46176
1898e61e89c4
pred_subset/equals_eq are now standard pred_set_conv rules
berghofe
parents:
46156
diff
changeset
|
5118 |
lemmas lists_Int_eq [simp] = listsp_inf_eq [to_set] |
22262 | 5119 |
|
39613 | 5120 |
lemma Cons_in_lists_iff[simp]: "x#xs : lists A \<longleftrightarrow> x:A \<and> xs : lists A" |
5121 |
by auto |
|
5122 |
||
22262 | 5123 |
lemma append_in_listsp_conv [iff]: |
5124 |
"(listsp A (xs @ ys)) = (listsp A xs \<and> listsp A ys)" |
|
15302 | 5125 |
by (induct xs) auto |
5126 |
||
22262 | 5127 |
lemmas append_in_lists_conv [iff] = append_in_listsp_conv [to_set] |
5128 |
||
5129 |
lemma in_listsp_conv_set: "(listsp A xs) = (\<forall>x \<in> set xs. A x)" |
|
5130 |
-- {* eliminate @{text listsp} in favour of @{text set} *} |
|
15302 | 5131 |
by (induct xs) auto |
5132 |
||
46313 | 5133 |
lemmas in_lists_conv_set [code_unfold] = in_listsp_conv_set [to_set] |
22262 | 5134 |
|
54147
97a8ff4e4ac9
killed most "no_atp", to make Sledgehammer more complete
blanchet
parents:
53954
diff
changeset
|
5135 |
lemma in_listspD [dest!]: "listsp A xs ==> \<forall>x\<in>set xs. A x" |
22262 | 5136 |
by (rule in_listsp_conv_set [THEN iffD1]) |
5137 |
||
54147
97a8ff4e4ac9
killed most "no_atp", to make Sledgehammer more complete
blanchet
parents:
53954
diff
changeset
|
5138 |
lemmas in_listsD [dest!] = in_listspD [to_set] |
97a8ff4e4ac9
killed most "no_atp", to make Sledgehammer more complete
blanchet
parents:
53954
diff
changeset
|
5139 |
|
97a8ff4e4ac9
killed most "no_atp", to make Sledgehammer more complete
blanchet
parents:
53954
diff
changeset
|
5140 |
lemma in_listspI [intro!]: "\<forall>x\<in>set xs. A x ==> listsp A xs" |
22262 | 5141 |
by (rule in_listsp_conv_set [THEN iffD2]) |
5142 |
||
54147
97a8ff4e4ac9
killed most "no_atp", to make Sledgehammer more complete
blanchet
parents:
53954
diff
changeset
|
5143 |
lemmas in_listsI [intro!] = in_listspI [to_set] |
15302 | 5144 |
|
39597 | 5145 |
lemma lists_eq_set: "lists A = {xs. set xs <= A}" |
5146 |
by auto |
|
5147 |
||
39613 | 5148 |
lemma lists_empty [simp]: "lists {} = {[]}" |
5149 |
by auto |
|
5150 |
||
15302 | 5151 |
lemma lists_UNIV [simp]: "lists UNIV = UNIV" |
5152 |
by auto |
|
5153 |
||
50134 | 5154 |
lemma lists_image: "lists (f`A) = map f ` lists A" |
5155 |
proof - |
|
5156 |
{ fix xs have "\<forall>x\<in>set xs. x \<in> f ` A \<Longrightarrow> xs \<in> map f ` lists A" |
|
5157 |
by (induct xs) (auto simp del: map.simps simp add: map.simps[symmetric] intro!: imageI) } |
|
5158 |
then show ?thesis by auto |
|
5159 |
qed |
|
17086 | 5160 |
|
35115 | 5161 |
subsubsection {* Inductive definition for membership *} |
17086 | 5162 |
|
23740 | 5163 |
inductive ListMem :: "'a \<Rightarrow> 'a list \<Rightarrow> bool" |
22262 | 5164 |
where |
5165 |
elem: "ListMem x (x # xs)" |
|
5166 |
| insert: "ListMem x xs \<Longrightarrow> ListMem x (y # xs)" |
|
5167 |
||
5168 |
lemma ListMem_iff: "(ListMem x xs) = (x \<in> set xs)" |
|
17086 | 5169 |
apply (rule iffI) |
5170 |
apply (induct set: ListMem) |
|
5171 |
apply auto |
|
5172 |
apply (induct xs) |
|
5173 |
apply (auto intro: ListMem.intros) |
|
5174 |
done |
|
5175 |
||
5176 |
||
35115 | 5177 |
subsubsection {* Lists as Cartesian products *} |
15302 | 5178 |
|
5179 |
text{*@{text"set_Cons A Xs"}: the set of lists with head drawn from |
|
5180 |
@{term A} and tail drawn from @{term Xs}.*} |
|
5181 |
||
50548 | 5182 |
definition set_Cons :: "'a set \<Rightarrow> 'a list set \<Rightarrow> 'a list set" where |
5183 |
"set_Cons A XS = {z. \<exists>x xs. z = x # xs \<and> x \<in> A \<and> xs \<in> XS}" |
|
15302 | 5184 |
|
17724 | 5185 |
lemma set_Cons_sing_Nil [simp]: "set_Cons A {[]} = (%x. [x])`A" |
15302 | 5186 |
by (auto simp add: set_Cons_def) |
5187 |
||
5188 |
text{*Yields the set of lists, all of the same length as the argument and |
|
5189 |
with elements drawn from the corresponding element of the argument.*} |
|
5190 |
||
50548 | 5191 |
primrec listset :: "'a set list \<Rightarrow> 'a list set" where |
5192 |
"listset [] = {[]}" | |
|
5193 |
"listset (A # As) = set_Cons A (listset As)" |
|
15302 | 5194 |
|
5195 |
||
35115 | 5196 |
subsection {* Relations on Lists *} |
15656 | 5197 |
|
5198 |
subsubsection {* Length Lexicographic Ordering *} |
|
5199 |
||
5200 |
text{*These orderings preserve well-foundedness: shorter lists |
|
5201 |
precede longer lists. These ordering are not used in dictionaries.*} |
|
34941 | 5202 |
|
5203 |
primrec -- {*The lexicographic ordering for lists of the specified length*} |
|
5204 |
lexn :: "('a \<times> 'a) set \<Rightarrow> nat \<Rightarrow> ('a list \<times> 'a list) set" where |
|
50548 | 5205 |
"lexn r 0 = {}" | |
5206 |
"lexn r (Suc n) = |
|
5207 |
(map_pair (%(x, xs). x#xs) (%(x, xs). x#xs) ` (r <*lex*> lexn r n)) Int |
|
5208 |
{(xs, ys). length xs = Suc n \<and> length ys = Suc n}" |
|
5209 |
||
5210 |
definition lex :: "('a \<times> 'a) set \<Rightarrow> ('a list \<times> 'a list) set" where |
|
5211 |
"lex r = (\<Union>n. lexn r n)" -- {*Holds only between lists of the same length*} |
|
5212 |
||
5213 |
definition lenlex :: "('a \<times> 'a) set => ('a list \<times> 'a list) set" where |
|
5214 |
"lenlex r = inv_image (less_than <*lex*> lex r) (\<lambda>xs. (length xs, xs))" |
|
34941 | 5215 |
-- {*Compares lists by their length and then lexicographically*} |
15302 | 5216 |
|
5217 |
lemma wf_lexn: "wf r ==> wf (lexn r n)" |
|
5218 |
apply (induct n, simp, simp) |
|
5219 |
apply(rule wf_subset) |
|
5220 |
prefer 2 apply (rule Int_lower1) |
|
40608
6c28ab8b8166
mapper for list type; map_pair replaces prod_fun
haftmann
parents:
40593
diff
changeset
|
5221 |
apply(rule wf_map_pair_image) |
15302 | 5222 |
prefer 2 apply (rule inj_onI, auto) |
5223 |
done |
|
5224 |
||
5225 |
lemma lexn_length: |
|
24526 | 5226 |
"(xs, ys) : lexn r n ==> length xs = n \<and> length ys = n" |
5227 |
by (induct n arbitrary: xs ys) auto |
|
15302 | 5228 |
|
5229 |
lemma wf_lex [intro!]: "wf r ==> wf (lex r)" |
|
5230 |
apply (unfold lex_def) |
|
5231 |
apply (rule wf_UN) |
|
5232 |
apply (blast intro: wf_lexn, clarify) |
|
5233 |
apply (rename_tac m n) |
|
5234 |
apply (subgoal_tac "m \<noteq> n") |
|
5235 |
prefer 2 apply blast |
|
5236 |
apply (blast dest: lexn_length not_sym) |
|
5237 |
done |
|
5238 |
||
5239 |
lemma lexn_conv: |
|
15656 | 5240 |
"lexn r n = |
5241 |
{(xs,ys). length xs = n \<and> length ys = n \<and> |
|
5242 |
(\<exists>xys x y xs' ys'. xs= xys @ x#xs' \<and> ys= xys @ y # ys' \<and> (x, y):r)}" |
|
18423 | 5243 |
apply (induct n, simp) |
15302 | 5244 |
apply (simp add: image_Collect lex_prod_def, safe, blast) |
5245 |
apply (rule_tac x = "ab # xys" in exI, simp) |
|
5246 |
apply (case_tac xys, simp_all, blast) |
|
5247 |
done |
|
5248 |
||
5249 |
lemma lex_conv: |
|
15656 | 5250 |
"lex r = |
5251 |
{(xs,ys). length xs = length ys \<and> |
|
5252 |
(\<exists>xys x y xs' ys'. xs = xys @ x # xs' \<and> ys = xys @ y # ys' \<and> (x, y):r)}" |
|
15302 | 5253 |
by (force simp add: lex_def lexn_conv) |
5254 |
||
15693 | 5255 |
lemma wf_lenlex [intro!]: "wf r ==> wf (lenlex r)" |
5256 |
by (unfold lenlex_def) blast |
|
5257 |
||
5258 |
lemma lenlex_conv: |
|
5259 |
"lenlex r = {(xs,ys). length xs < length ys | |
|
15656 | 5260 |
length xs = length ys \<and> (xs, ys) : lex r}" |
30198 | 5261 |
by (simp add: lenlex_def Id_on_def lex_prod_def inv_image_def) |
15302 | 5262 |
|
5263 |
lemma Nil_notin_lex [iff]: "([], ys) \<notin> lex r" |
|
5264 |
by (simp add: lex_conv) |
|
5265 |
||
5266 |
lemma Nil2_notin_lex [iff]: "(xs, []) \<notin> lex r" |
|
5267 |
by (simp add:lex_conv) |
|
5268 |
||
18447 | 5269 |
lemma Cons_in_lex [simp]: |
15656 | 5270 |
"((x # xs, y # ys) : lex r) = |
5271 |
((x, y) : r \<and> length xs = length ys | x = y \<and> (xs, ys) : lex r)" |
|
15302 | 5272 |
apply (simp add: lex_conv) |
5273 |
apply (rule iffI) |
|
5274 |
prefer 2 apply (blast intro: Cons_eq_appendI, clarify) |
|
5275 |
apply (case_tac xys, simp, simp) |
|
5276 |
apply blast |
|
5277 |
done |
|
5278 |
||
5279 |
||
15656 | 5280 |
subsubsection {* Lexicographic Ordering *} |
5281 |
||
5282 |
text {* Classical lexicographic ordering on lists, ie. "a" < "ab" < "b". |
|
5283 |
This ordering does \emph{not} preserve well-foundedness. |
|
17090 | 5284 |
Author: N. Voelker, March 2005. *} |
15656 | 5285 |
|
50548 | 5286 |
definition lexord :: "('a \<times> 'a) set \<Rightarrow> ('a list \<times> 'a list) set" where |
5287 |
"lexord r = {(x,y). \<exists> a v. y = x @ a # v \<or> |
|
15656 | 5288 |
(\<exists> u a b v w. (a,b) \<in> r \<and> x = u @ (a # v) \<and> y = u @ (b # w))}" |
5289 |
||
5290 |
lemma lexord_Nil_left[simp]: "([],y) \<in> lexord r = (\<exists> a x. y = a # x)" |
|
24349 | 5291 |
by (unfold lexord_def, induct_tac y, auto) |
15656 | 5292 |
|
5293 |
lemma lexord_Nil_right[simp]: "(x,[]) \<notin> lexord r" |
|
24349 | 5294 |
by (unfold lexord_def, induct_tac x, auto) |
15656 | 5295 |
|
5296 |
lemma lexord_cons_cons[simp]: |
|
5297 |
"((a # x, b # y) \<in> lexord r) = ((a,b)\<in> r | (a = b & (x,y)\<in> lexord r))" |
|
5298 |
apply (unfold lexord_def, safe, simp_all) |
|
5299 |
apply (case_tac u, simp, simp) |
|
5300 |
apply (case_tac u, simp, clarsimp, blast, blast, clarsimp) |
|
5301 |
apply (erule_tac x="b # u" in allE) |
|
5302 |
by force |
|
5303 |
||
5304 |
lemmas lexord_simps = lexord_Nil_left lexord_Nil_right lexord_cons_cons |
|
5305 |
||
5306 |
lemma lexord_append_rightI: "\<exists> b z. y = b # z \<Longrightarrow> (x, x @ y) \<in> lexord r" |
|
24349 | 5307 |
by (induct_tac x, auto) |
15656 | 5308 |
|
5309 |
lemma lexord_append_left_rightI: |
|
5310 |
"(a,b) \<in> r \<Longrightarrow> (u @ a # x, u @ b # y) \<in> lexord r" |
|
24349 | 5311 |
by (induct_tac u, auto) |
15656 | 5312 |
|
5313 |
lemma lexord_append_leftI: " (u,v) \<in> lexord r \<Longrightarrow> (x @ u, x @ v) \<in> lexord r" |
|
24349 | 5314 |
by (induct x, auto) |
15656 | 5315 |
|
5316 |
lemma lexord_append_leftD: |
|
5317 |
"\<lbrakk> (x @ u, x @ v) \<in> lexord r; (! a. (a,a) \<notin> r) \<rbrakk> \<Longrightarrow> (u,v) \<in> lexord r" |
|
24349 | 5318 |
by (erule rev_mp, induct_tac x, auto) |
15656 | 5319 |
|
5320 |
lemma lexord_take_index_conv: |
|
5321 |
"((x,y) : lexord r) = |
|
5322 |
((length x < length y \<and> take (length x) y = x) \<or> |
|
5323 |
(\<exists>i. i < min(length x)(length y) & take i x = take i y & (x!i,y!i) \<in> r))" |
|
5324 |
apply (unfold lexord_def Let_def, clarsimp) |
|
5325 |
apply (rule_tac f = "(% a b. a \<or> b)" in arg_cong2) |
|
5326 |
apply auto |
|
5327 |
apply (rule_tac x="hd (drop (length x) y)" in exI) |
|
5328 |
apply (rule_tac x="tl (drop (length x) y)" in exI) |
|
5329 |
apply (erule subst, simp add: min_def) |
|
5330 |
apply (rule_tac x ="length u" in exI, simp) |
|
5331 |
apply (rule_tac x ="take i x" in exI) |
|
5332 |
apply (rule_tac x ="x ! i" in exI) |
|
5333 |
apply (rule_tac x ="y ! i" in exI, safe) |
|
5334 |
apply (rule_tac x="drop (Suc i) x" in exI) |
|
5335 |
apply (drule sym, simp add: drop_Suc_conv_tl) |
|
5336 |
apply (rule_tac x="drop (Suc i) y" in exI) |
|
5337 |
by (simp add: drop_Suc_conv_tl) |
|
5338 |
||
5339 |
-- {* lexord is extension of partial ordering List.lex *} |
|
41986 | 5340 |
lemma lexord_lex: "(x,y) \<in> lex r = ((x,y) \<in> lexord r \<and> length x = length y)" |
15656 | 5341 |
apply (rule_tac x = y in spec) |
5342 |
apply (induct_tac x, clarsimp) |
|
5343 |
by (clarify, case_tac x, simp, force) |
|
5344 |
||
41986 | 5345 |
lemma lexord_irreflexive: "ALL x. (x,x) \<notin> r \<Longrightarrow> (xs,xs) \<notin> lexord r" |
5346 |
by (induct xs) auto |
|
5347 |
||
5348 |
text{* By Ren\'e Thiemann: *} |
|
5349 |
lemma lexord_partial_trans: |
|
5350 |
"(\<And>x y z. x \<in> set xs \<Longrightarrow> (x,y) \<in> r \<Longrightarrow> (y,z) \<in> r \<Longrightarrow> (x,z) \<in> r) |
|
5351 |
\<Longrightarrow> (xs,ys) \<in> lexord r \<Longrightarrow> (ys,zs) \<in> lexord r \<Longrightarrow> (xs,zs) \<in> lexord r" |
|
5352 |
proof (induct xs arbitrary: ys zs) |
|
5353 |
case Nil |
|
5354 |
from Nil(3) show ?case unfolding lexord_def by (cases zs, auto) |
|
5355 |
next |
|
5356 |
case (Cons x xs yys zzs) |
|
5357 |
from Cons(3) obtain y ys where yys: "yys = y # ys" unfolding lexord_def |
|
5358 |
by (cases yys, auto) |
|
5359 |
note Cons = Cons[unfolded yys] |
|
5360 |
from Cons(3) have one: "(x,y) \<in> r \<or> x = y \<and> (xs,ys) \<in> lexord r" by auto |
|
5361 |
from Cons(4) obtain z zs where zzs: "zzs = z # zs" unfolding lexord_def |
|
5362 |
by (cases zzs, auto) |
|
5363 |
note Cons = Cons[unfolded zzs] |
|
5364 |
from Cons(4) have two: "(y,z) \<in> r \<or> y = z \<and> (ys,zs) \<in> lexord r" by auto |
|
5365 |
{ |
|
5366 |
assume "(xs,ys) \<in> lexord r" and "(ys,zs) \<in> lexord r" |
|
5367 |
from Cons(1)[OF _ this] Cons(2) |
|
5368 |
have "(xs,zs) \<in> lexord r" by auto |
|
5369 |
} note ind1 = this |
|
5370 |
{ |
|
5371 |
assume "(x,y) \<in> r" and "(y,z) \<in> r" |
|
5372 |
from Cons(2)[OF _ this] have "(x,z) \<in> r" by auto |
|
5373 |
} note ind2 = this |
|
5374 |
from one two ind1 ind2 |
|
5375 |
have "(x,z) \<in> r \<or> x = z \<and> (xs,zs) \<in> lexord r" by blast |
|
5376 |
thus ?case unfolding zzs by auto |
|
5377 |
qed |
|
15656 | 5378 |
|
5379 |
lemma lexord_trans: |
|
5380 |
"\<lbrakk> (x, y) \<in> lexord r; (y, z) \<in> lexord r; trans r \<rbrakk> \<Longrightarrow> (x, z) \<in> lexord r" |
|
41986 | 5381 |
by(auto simp: trans_def intro:lexord_partial_trans) |
15656 | 5382 |
|
5383 |
lemma lexord_transI: "trans r \<Longrightarrow> trans (lexord r)" |
|
24349 | 5384 |
by (rule transI, drule lexord_trans, blast) |
15656 | 5385 |
|
5386 |
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" |
|
5387 |
apply (rule_tac x = y in spec) |
|
5388 |
apply (induct_tac x, rule allI) |
|
5389 |
apply (case_tac x, simp, simp) |
|
5390 |
apply (rule allI, case_tac x, simp, simp) |
|
5391 |
by blast |
|
5392 |
||
5393 |
||
40230 | 5394 |
subsubsection {* Lexicographic combination of measure functions *} |
21103
367b4ad7c7cc
Added "measures" combinator for lexicographic combinations of multiple measures.
krauss
parents:
21079
diff
changeset
|
5395 |
|
367b4ad7c7cc
Added "measures" combinator for lexicographic combinations of multiple measures.
krauss
parents:
21079
diff
changeset
|
5396 |
text {* These are useful for termination proofs *} |
367b4ad7c7cc
Added "measures" combinator for lexicographic combinations of multiple measures.
krauss
parents:
21079
diff
changeset
|
5397 |
|
50548 | 5398 |
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
|
5399 |
|
44013
5cfc1c36ae97
moved recdef package to HOL/Library/Old_Recdef.thy
krauss
parents:
43594
diff
changeset
|
5400 |
lemma wf_measures[simp]: "wf (measures fs)" |
24349 | 5401 |
unfolding measures_def |
5402 |
by blast |
|
21103
367b4ad7c7cc
Added "measures" combinator for lexicographic combinations of multiple measures.
krauss
parents:
21079
diff
changeset
|
5403 |
|
367b4ad7c7cc
Added "measures" combinator for lexicographic combinations of multiple measures.
krauss
parents:
21079
diff
changeset
|
5404 |
lemma in_measures[simp]: |
367b4ad7c7cc
Added "measures" combinator for lexicographic combinations of multiple measures.
krauss
parents:
21079
diff
changeset
|
5405 |
"(x, y) \<in> measures [] = False" |
367b4ad7c7cc
Added "measures" combinator for lexicographic combinations of multiple measures.
krauss
parents:
21079
diff
changeset
|
5406 |
"(x, y) \<in> measures (f # fs) |
367b4ad7c7cc
Added "measures" combinator for lexicographic combinations of multiple measures.
krauss
parents:
21079
diff
changeset
|
5407 |
= (f x < f y \<or> (f x = f y \<and> (x, y) \<in> measures fs))" |
24349 | 5408 |
unfolding measures_def |
5409 |
by auto |
|
21103
367b4ad7c7cc
Added "measures" combinator for lexicographic combinations of multiple measures.
krauss
parents:
21079
diff
changeset
|
5410 |
|
367b4ad7c7cc
Added "measures" combinator for lexicographic combinations of multiple measures.
krauss
parents:
21079
diff
changeset
|
5411 |
lemma measures_less: "f x < f y ==> (x, y) \<in> measures (f#fs)" |
24349 | 5412 |
by simp |
21103
367b4ad7c7cc
Added "measures" combinator for lexicographic combinations of multiple measures.
krauss
parents:
21079
diff
changeset
|
5413 |
|
367b4ad7c7cc
Added "measures" combinator for lexicographic combinations of multiple measures.
krauss
parents:
21079
diff
changeset
|
5414 |
lemma measures_lesseq: "f x <= f y ==> (x, y) \<in> measures fs ==> (x, y) \<in> measures (f#fs)" |
24349 | 5415 |
by auto |
21103
367b4ad7c7cc
Added "measures" combinator for lexicographic combinations of multiple measures.
krauss
parents:
21079
diff
changeset
|
5416 |
|
367b4ad7c7cc
Added "measures" combinator for lexicographic combinations of multiple measures.
krauss
parents:
21079
diff
changeset
|
5417 |
|
40230 | 5418 |
subsubsection {* Lifting Relations to Lists: one element *} |
5419 |
||
5420 |
definition listrel1 :: "('a \<times> 'a) set \<Rightarrow> ('a list \<times> 'a list) set" where |
|
5421 |
"listrel1 r = {(xs,ys). |
|
5422 |
\<exists>us z z' vs. xs = us @ z # vs \<and> (z,z') \<in> r \<and> ys = us @ z' # vs}" |
|
5423 |
||
5424 |
lemma listrel1I: |
|
5425 |
"\<lbrakk> (x, y) \<in> r; xs = us @ x # vs; ys = us @ y # vs \<rbrakk> \<Longrightarrow> |
|
5426 |
(xs, ys) \<in> listrel1 r" |
|
5427 |
unfolding listrel1_def by auto |
|
5428 |
||
5429 |
lemma listrel1E: |
|
5430 |
"\<lbrakk> (xs, ys) \<in> listrel1 r; |
|
5431 |
!!x y us vs. \<lbrakk> (x, y) \<in> r; xs = us @ x # vs; ys = us @ y # vs \<rbrakk> \<Longrightarrow> P |
|
5432 |
\<rbrakk> \<Longrightarrow> P" |
|
5433 |
unfolding listrel1_def by auto |
|
5434 |
||
5435 |
lemma not_Nil_listrel1 [iff]: "([], xs) \<notin> listrel1 r" |
|
5436 |
unfolding listrel1_def by blast |
|
5437 |
||
5438 |
lemma not_listrel1_Nil [iff]: "(xs, []) \<notin> listrel1 r" |
|
5439 |
unfolding listrel1_def by blast |
|
5440 |
||
5441 |
lemma Cons_listrel1_Cons [iff]: |
|
5442 |
"(x # xs, y # ys) \<in> listrel1 r \<longleftrightarrow> |
|
5443 |
(x,y) \<in> r \<and> xs = ys \<or> x = y \<and> (xs, ys) \<in> listrel1 r" |
|
5444 |
by (simp add: listrel1_def Cons_eq_append_conv) (blast) |
|
5445 |
||
5446 |
lemma listrel1I1: "(x,y) \<in> r \<Longrightarrow> (x # xs, y # xs) \<in> listrel1 r" |
|
5447 |
by (metis Cons_listrel1_Cons) |
|
5448 |
||
5449 |
lemma listrel1I2: "(xs, ys) \<in> listrel1 r \<Longrightarrow> (x # xs, x # ys) \<in> listrel1 r" |
|
5450 |
by (metis Cons_listrel1_Cons) |
|
5451 |
||
5452 |
lemma append_listrel1I: |
|
5453 |
"(xs, ys) \<in> listrel1 r \<and> us = vs \<or> xs = ys \<and> (us, vs) \<in> listrel1 r |
|
5454 |
\<Longrightarrow> (xs @ us, ys @ vs) \<in> listrel1 r" |
|
5455 |
unfolding listrel1_def |
|
5456 |
by auto (blast intro: append_eq_appendI)+ |
|
5457 |
||
5458 |
lemma Cons_listrel1E1[elim!]: |
|
5459 |
assumes "(x # xs, ys) \<in> listrel1 r" |
|
5460 |
and "\<And>y. ys = y # xs \<Longrightarrow> (x, y) \<in> r \<Longrightarrow> R" |
|
5461 |
and "\<And>zs. ys = x # zs \<Longrightarrow> (xs, zs) \<in> listrel1 r \<Longrightarrow> R" |
|
5462 |
shows R |
|
5463 |
using assms by (cases ys) blast+ |
|
5464 |
||
5465 |
lemma Cons_listrel1E2[elim!]: |
|
5466 |
assumes "(xs, y # ys) \<in> listrel1 r" |
|
5467 |
and "\<And>x. xs = x # ys \<Longrightarrow> (x, y) \<in> r \<Longrightarrow> R" |
|
5468 |
and "\<And>zs. xs = y # zs \<Longrightarrow> (zs, ys) \<in> listrel1 r \<Longrightarrow> R" |
|
5469 |
shows R |
|
5470 |
using assms by (cases xs) blast+ |
|
5471 |
||
5472 |
lemma snoc_listrel1_snoc_iff: |
|
5473 |
"(xs @ [x], ys @ [y]) \<in> listrel1 r |
|
5474 |
\<longleftrightarrow> (xs, ys) \<in> listrel1 r \<and> x = y \<or> xs = ys \<and> (x,y) \<in> r" (is "?L \<longleftrightarrow> ?R") |
|
5475 |
proof |
|
5476 |
assume ?L thus ?R |
|
44890
22f665a2e91c
new fastforce replacing fastsimp - less confusing name
nipkow
parents:
44635
diff
changeset
|
5477 |
by (fastforce simp: listrel1_def snoc_eq_iff_butlast butlast_append) |
40230 | 5478 |
next |
5479 |
assume ?R then show ?L unfolding listrel1_def by force |
|
5480 |
qed |
|
5481 |
||
5482 |
lemma listrel1_eq_len: "(xs,ys) \<in> listrel1 r \<Longrightarrow> length xs = length ys" |
|
5483 |
unfolding listrel1_def by auto |
|
5484 |
||
5485 |
lemma listrel1_mono: |
|
5486 |
"r \<subseteq> s \<Longrightarrow> listrel1 r \<subseteq> listrel1 s" |
|
5487 |
unfolding listrel1_def by blast |
|
5488 |
||
5489 |
||
5490 |
lemma listrel1_converse: "listrel1 (r^-1) = (listrel1 r)^-1" |
|
5491 |
unfolding listrel1_def by blast |
|
5492 |
||
5493 |
lemma in_listrel1_converse: |
|
5494 |
"(x,y) : listrel1 (r^-1) \<longleftrightarrow> (x,y) : (listrel1 r)^-1" |
|
5495 |
unfolding listrel1_def by blast |
|
5496 |
||
5497 |
lemma listrel1_iff_update: |
|
5498 |
"(xs,ys) \<in> (listrel1 r) |
|
5499 |
\<longleftrightarrow> (\<exists>y n. (xs ! n, y) \<in> r \<and> n < length xs \<and> ys = xs[n:=y])" (is "?L \<longleftrightarrow> ?R") |
|
5500 |
proof |
|
5501 |
assume "?L" |
|
5502 |
then obtain x y u v where "xs = u @ x # v" "ys = u @ y # v" "(x,y) \<in> r" |
|
5503 |
unfolding listrel1_def by auto |
|
5504 |
then have "ys = xs[length u := y]" and "length u < length xs" |
|
5505 |
and "(xs ! length u, y) \<in> r" by auto |
|
5506 |
then show "?R" by auto |
|
5507 |
next |
|
5508 |
assume "?R" |
|
5509 |
then obtain x y n where "(xs!n, y) \<in> r" "n < size xs" "ys = xs[n:=y]" "x = xs!n" |
|
5510 |
by auto |
|
5511 |
then obtain u v where "xs = u @ x # v" and "ys = u @ y # v" and "(x, y) \<in> r" |
|
5512 |
by (auto intro: upd_conv_take_nth_drop id_take_nth_drop) |
|
5513 |
then show "?L" by (auto simp: listrel1_def) |
|
5514 |
qed |
|
5515 |
||
5516 |
||
44510 | 5517 |
text{* Accessible part and wellfoundedness: *} |
40230 | 5518 |
|
5519 |
lemma Cons_acc_listrel1I [intro!]: |
|
54295 | 5520 |
"x \<in> Wellfounded.acc r \<Longrightarrow> xs \<in> Wellfounded.acc (listrel1 r) \<Longrightarrow> (x # xs) \<in> Wellfounded.acc (listrel1 r)" |
5521 |
apply (induct arbitrary: xs set: Wellfounded.acc) |
|
40230 | 5522 |
apply (erule thin_rl) |
5523 |
apply (erule acc_induct) |
|
5524 |
apply (rule accI) |
|
5525 |
apply (blast) |
|
5526 |
done |
|
5527 |
||
54295 | 5528 |
lemma lists_accD: "xs \<in> lists (Wellfounded.acc r) \<Longrightarrow> xs \<in> Wellfounded.acc (listrel1 r)" |
40230 | 5529 |
apply (induct set: lists) |
5530 |
apply (rule accI) |
|
5531 |
apply simp |
|
5532 |
apply (rule accI) |
|
5533 |
apply (fast dest: acc_downward) |
|
5534 |
done |
|
5535 |
||
54295 | 5536 |
lemma lists_accI: "xs \<in> Wellfounded.acc (listrel1 r) \<Longrightarrow> xs \<in> lists (Wellfounded.acc r)" |
5537 |
apply (induct set: Wellfounded.acc) |
|
40230 | 5538 |
apply clarify |
5539 |
apply (rule accI) |
|
44890
22f665a2e91c
new fastforce replacing fastsimp - less confusing name
nipkow
parents:
44635
diff
changeset
|
5540 |
apply (fastforce dest!: in_set_conv_decomp[THEN iffD1] simp: listrel1_def) |
40230 | 5541 |
done |
5542 |
||
44510 | 5543 |
lemma wf_listrel1_iff[simp]: "wf(listrel1 r) = wf r" |
5544 |
by(metis wf_acc_iff in_lists_conv_set lists_accI lists_accD Cons_in_lists_iff) |
|
5545 |
||
40230 | 5546 |
|
5547 |
subsubsection {* Lifting Relations to Lists: all elements *} |
|
15302 | 5548 |
|
23740 | 5549 |
inductive_set |
46317 | 5550 |
listrel :: "('a \<times> 'b) set \<Rightarrow> ('a list \<times> 'b list) set" |
5551 |
for r :: "('a \<times> 'b) set" |
|
22262 | 5552 |
where |
23740 | 5553 |
Nil: "([],[]) \<in> listrel r" |
5554 |
| Cons: "[| (x,y) \<in> r; (xs,ys) \<in> listrel r |] ==> (x#xs, y#ys) \<in> listrel r" |
|
5555 |
||
5556 |
inductive_cases listrel_Nil1 [elim!]: "([],xs) \<in> listrel r" |
|
5557 |
inductive_cases listrel_Nil2 [elim!]: "(xs,[]) \<in> listrel r" |
|
5558 |
inductive_cases listrel_Cons1 [elim!]: "(y#ys,xs) \<in> listrel r" |
|
5559 |
inductive_cases listrel_Cons2 [elim!]: "(xs,y#ys) \<in> listrel r" |
|
15302 | 5560 |
|
5561 |
||
40230 | 5562 |
lemma listrel_eq_len: "(xs, ys) \<in> listrel r \<Longrightarrow> length xs = length ys" |
5563 |
by(induct rule: listrel.induct) auto |
|
5564 |
||
46313 | 5565 |
lemma listrel_iff_zip [code_unfold]: "(xs,ys) : listrel r \<longleftrightarrow> |
40230 | 5566 |
length xs = length ys & (\<forall>(x,y) \<in> set(zip xs ys). (x,y) \<in> r)" (is "?L \<longleftrightarrow> ?R") |
5567 |
proof |
|
5568 |
assume ?L thus ?R by induct (auto intro: listrel_eq_len) |
|
5569 |
next |
|
5570 |
assume ?R thus ?L |
|
5571 |
apply (clarify) |
|
5572 |
by (induct rule: list_induct2) (auto intro: listrel.intros) |
|
5573 |
qed |
|
5574 |
||
5575 |
lemma listrel_iff_nth: "(xs,ys) : listrel r \<longleftrightarrow> |
|
5576 |
length xs = length ys & (\<forall>n < length xs. (xs!n, ys!n) \<in> r)" (is "?L \<longleftrightarrow> ?R") |
|
5577 |
by (auto simp add: all_set_conv_all_nth listrel_iff_zip) |
|
5578 |
||
5579 |
||
15302 | 5580 |
lemma listrel_mono: "r \<subseteq> s \<Longrightarrow> listrel r \<subseteq> listrel s" |
5581 |
apply clarify |
|
23740 | 5582 |
apply (erule listrel.induct) |
5583 |
apply (blast intro: listrel.intros)+ |
|
15302 | 5584 |
done |
5585 |
||
5586 |
lemma listrel_subset: "r \<subseteq> A \<times> A \<Longrightarrow> listrel r \<subseteq> lists A \<times> lists A" |
|
5587 |
apply clarify |
|
23740 | 5588 |
apply (erule listrel.induct, auto) |
15302 | 5589 |
done |
5590 |
||
30198 | 5591 |
lemma listrel_refl_on: "refl_on A r \<Longrightarrow> refl_on (lists A) (listrel r)" |
5592 |
apply (simp add: refl_on_def listrel_subset Ball_def) |
|
15302 | 5593 |
apply (rule allI) |
5594 |
apply (induct_tac x) |
|
23740 | 5595 |
apply (auto intro: listrel.intros) |
15302 | 5596 |
done |
5597 |
||
5598 |
lemma listrel_sym: "sym r \<Longrightarrow> sym (listrel r)" |
|
5599 |
apply (auto simp add: sym_def) |
|
23740 | 5600 |
apply (erule listrel.induct) |
5601 |
apply (blast intro: listrel.intros)+ |
|
15302 | 5602 |
done |
5603 |
||
5604 |
lemma listrel_trans: "trans r \<Longrightarrow> trans (listrel r)" |
|
5605 |
apply (simp add: trans_def) |
|
5606 |
apply (intro allI) |
|
5607 |
apply (rule impI) |
|
23740 | 5608 |
apply (erule listrel.induct) |
5609 |
apply (blast intro: listrel.intros)+ |
|
15302 | 5610 |
done |
5611 |
||
5612 |
theorem equiv_listrel: "equiv A r \<Longrightarrow> equiv (lists A) (listrel r)" |
|
30198 | 5613 |
by (simp add: equiv_def listrel_refl_on listrel_sym listrel_trans) |
15302 | 5614 |
|
40230 | 5615 |
lemma listrel_rtrancl_refl[iff]: "(xs,xs) : listrel(r^*)" |
5616 |
using listrel_refl_on[of UNIV, OF refl_rtrancl] |
|
5617 |
by(auto simp: refl_on_def) |
|
5618 |
||
5619 |
lemma listrel_rtrancl_trans: |
|
5620 |
"\<lbrakk> (xs,ys) : listrel(r^*); (ys,zs) : listrel(r^*) \<rbrakk> |
|
5621 |
\<Longrightarrow> (xs,zs) : listrel(r^*)" |
|
5622 |
by (metis listrel_trans trans_def trans_rtrancl) |
|
5623 |
||
5624 |
||
15302 | 5625 |
lemma listrel_Nil [simp]: "listrel r `` {[]} = {[]}" |
23740 | 5626 |
by (blast intro: listrel.intros) |
15302 | 5627 |
|
5628 |
lemma listrel_Cons: |
|
33318
ddd97d9dfbfb
moved Nat_Transfer before Divides; distributed Nat_Transfer setup accordingly
haftmann
parents:
32960
diff
changeset
|
5629 |
"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
|
5630 |
by (auto simp add: set_Cons_def intro: listrel.intros) |
15302 | 5631 |
|
40230 | 5632 |
text {* Relating @{term listrel1}, @{term listrel} and closures: *} |
5633 |
||
5634 |
lemma listrel1_rtrancl_subset_rtrancl_listrel1: |
|
5635 |
"listrel1 (r^*) \<subseteq> (listrel1 r)^*" |
|
5636 |
proof (rule subrelI) |
|
5637 |
fix xs ys assume 1: "(xs,ys) \<in> listrel1 (r^*)" |
|
5638 |
{ fix x y us vs |
|
5639 |
have "(x,y) : r^* \<Longrightarrow> (us @ x # vs, us @ y # vs) : (listrel1 r)^*" |
|
5640 |
proof(induct rule: rtrancl.induct) |
|
5641 |
case rtrancl_refl show ?case by simp |
|
5642 |
next |
|
5643 |
case rtrancl_into_rtrancl thus ?case |
|
5644 |
by (metis listrel1I rtrancl.rtrancl_into_rtrancl) |
|
5645 |
qed } |
|
5646 |
thus "(xs,ys) \<in> (listrel1 r)^*" using 1 by(blast elim: listrel1E) |
|
5647 |
qed |
|
5648 |
||
5649 |
lemma rtrancl_listrel1_eq_len: "(x,y) \<in> (listrel1 r)^* \<Longrightarrow> length x = length y" |
|
5650 |
by (induct rule: rtrancl.induct) (auto intro: listrel1_eq_len) |
|
5651 |
||
5652 |
lemma rtrancl_listrel1_ConsI1: |
|
5653 |
"(xs,ys) : (listrel1 r)^* \<Longrightarrow> (x#xs,x#ys) : (listrel1 r)^*" |
|
5654 |
apply(induct rule: rtrancl.induct) |
|
5655 |
apply simp |
|
5656 |
by (metis listrel1I2 rtrancl.rtrancl_into_rtrancl) |
|
5657 |
||
5658 |
lemma rtrancl_listrel1_ConsI2: |
|
5659 |
"(x,y) \<in> r^* \<Longrightarrow> (xs, ys) \<in> (listrel1 r)^* |
|
5660 |
\<Longrightarrow> (x # xs, y # ys) \<in> (listrel1 r)^*" |
|
5661 |
by (blast intro: rtrancl_trans rtrancl_listrel1_ConsI1 |
|
5662 |
subsetD[OF listrel1_rtrancl_subset_rtrancl_listrel1 listrel1I1]) |
|
5663 |
||
5664 |
lemma listrel1_subset_listrel: |
|
5665 |
"r \<subseteq> r' \<Longrightarrow> refl r' \<Longrightarrow> listrel1 r \<subseteq> listrel(r')" |
|
5666 |
by(auto elim!: listrel1E simp add: listrel_iff_zip set_zip refl_on_def) |
|
5667 |
||
5668 |
lemma listrel_reflcl_if_listrel1: |
|
5669 |
"(xs,ys) : listrel1 r \<Longrightarrow> (xs,ys) : listrel(r^*)" |
|
5670 |
by(erule listrel1E)(auto simp add: listrel_iff_zip set_zip) |
|
5671 |
||
5672 |
lemma listrel_rtrancl_eq_rtrancl_listrel1: "listrel (r^*) = (listrel1 r)^*" |
|
5673 |
proof |
|
5674 |
{ fix x y assume "(x,y) \<in> listrel (r^*)" |
|
5675 |
then have "(x,y) \<in> (listrel1 r)^*" |
|
5676 |
by induct (auto intro: rtrancl_listrel1_ConsI2) } |
|
5677 |
then show "listrel (r^*) \<subseteq> (listrel1 r)^*" |
|
5678 |
by (rule subrelI) |
|
5679 |
next |
|
5680 |
show "listrel (r^*) \<supseteq> (listrel1 r)^*" |
|
5681 |
proof(rule subrelI) |
|
5682 |
fix xs ys assume "(xs,ys) \<in> (listrel1 r)^*" |
|
5683 |
then show "(xs,ys) \<in> listrel (r^*)" |
|
5684 |
proof induct |
|
5685 |
case base show ?case by(auto simp add: listrel_iff_zip set_zip) |
|
5686 |
next |
|
5687 |
case (step ys zs) |
|
5688 |
thus ?case by (metis listrel_reflcl_if_listrel1 listrel_rtrancl_trans) |
|
5689 |
qed |
|
5690 |
qed |
|
5691 |
qed |
|
5692 |
||
5693 |
lemma rtrancl_listrel1_if_listrel: |
|
5694 |
"(xs,ys) : listrel r \<Longrightarrow> (xs,ys) : (listrel1 r)^*" |
|
5695 |
by(metis listrel_rtrancl_eq_rtrancl_listrel1 subsetD[OF listrel_mono] r_into_rtrancl subsetI) |
|
5696 |
||
5697 |
lemma listrel_subset_rtrancl_listrel1: "listrel r \<subseteq> (listrel1 r)^*" |
|
5698 |
by(fast intro:rtrancl_listrel1_if_listrel) |
|
5699 |
||
15302 | 5700 |
|
26749
397a1aeede7d
* New attribute "termination_simp": Simp rules for termination proofs
krauss
parents:
26734
diff
changeset
|
5701 |
subsection {* Size function *} |
397a1aeede7d
* New attribute "termination_simp": Simp rules for termination proofs
krauss
parents:
26734
diff
changeset
|
5702 |
|
26875
e18574413bc4
Measure functions can now be declared via special rules, allowing for a
krauss
parents:
26795
diff
changeset
|
5703 |
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
|
5704 |
by (rule is_measure_trivial) |
e18574413bc4
Measure functions can now be declared via special rules, allowing for a
krauss
parents:
26795
diff
changeset
|
5705 |
|
e18574413bc4
Measure functions can now be declared via special rules, allowing for a
krauss
parents:
26795
diff
changeset
|
5706 |
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
|
5707 |
by (rule is_measure_trivial) |
e18574413bc4
Measure functions can now be declared via special rules, allowing for a
krauss
parents:
26795
diff
changeset
|
5708 |
|
e18574413bc4
Measure functions can now be declared via special rules, allowing for a
krauss
parents:
26795
diff
changeset
|
5709 |
lemma list_size_estimation[termination_simp]: |
e18574413bc4
Measure functions can now be declared via special rules, allowing for a
krauss
parents:
26795
diff
changeset
|
5710 |
"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
|
5711 |
by (induct xs) auto |
397a1aeede7d
* New attribute "termination_simp": Simp rules for termination proofs
krauss
parents:
26734
diff
changeset
|
5712 |
|
26875
e18574413bc4
Measure functions can now be declared via special rules, allowing for a
krauss
parents:
26795
diff
changeset
|
5713 |
lemma list_size_estimation'[termination_simp]: |
e18574413bc4
Measure functions can now be declared via special rules, allowing for a
krauss
parents:
26795
diff
changeset
|
5714 |
"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
|
5715 |
by (induct xs) auto |
e18574413bc4
Measure functions can now be declared via special rules, allowing for a
krauss
parents:
26795
diff
changeset
|
5716 |
|
e18574413bc4
Measure functions can now be declared via special rules, allowing for a
krauss
parents:
26795
diff
changeset
|
5717 |
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
|
5718 |
by (induct xs) auto |
e18574413bc4
Measure functions can now be declared via special rules, allowing for a
krauss
parents:
26795
diff
changeset
|
5719 |
|
44619
fd520fa2fb09
adding list_size_append (thanks to Rene Thiemann)
bulwahn
parents:
44618
diff
changeset
|
5720 |
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
|
5721 |
by (induct xs, auto) |
fd520fa2fb09
adding list_size_append (thanks to Rene Thiemann)
bulwahn
parents:
44618
diff
changeset
|
5722 |
|
26875
e18574413bc4
Measure functions can now be declared via special rules, allowing for a
krauss
parents:
26795
diff
changeset
|
5723 |
lemma list_size_pointwise[termination_simp]: |
44618
f3635643a376
strengthening list_size_pointwise (thanks to Rene Thiemann)
bulwahn
parents:
44510
diff
changeset
|
5724 |
"(\<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
|
5725 |
by (induct xs) force+ |
26749
397a1aeede7d
* New attribute "termination_simp": Simp rules for termination proofs
krauss
parents:
26734
diff
changeset
|
5726 |
|
31048
ac146fc38b51
refined HOL string theories and corresponding ML fragments
haftmann
parents:
31022
diff
changeset
|
5727 |
|
46143 | 5728 |
subsection {* Monad operation *} |
5729 |
||
5730 |
definition bind :: "'a list \<Rightarrow> ('a \<Rightarrow> 'b list) \<Rightarrow> 'b list" where |
|
50548 | 5731 |
"bind xs f = concat (map f xs)" |
46143 | 5732 |
|
5733 |
hide_const (open) bind |
|
5734 |
||
5735 |
lemma bind_simps [simp]: |
|
5736 |
"List.bind [] f = []" |
|
5737 |
"List.bind (x # xs) f = f x @ List.bind xs f" |
|
5738 |
by (simp_all add: bind_def) |
|
5739 |
||
5740 |
||
33318
ddd97d9dfbfb
moved Nat_Transfer before Divides; distributed Nat_Transfer setup accordingly
haftmann
parents:
32960
diff
changeset
|
5741 |
subsection {* Transfer *} |
ddd97d9dfbfb
moved Nat_Transfer before Divides; distributed Nat_Transfer setup accordingly
haftmann
parents:
32960
diff
changeset
|
5742 |
|
50548 | 5743 |
definition embed_list :: "nat list \<Rightarrow> int list" where |
5744 |
"embed_list l = map int l" |
|
5745 |
||
5746 |
definition nat_list :: "int list \<Rightarrow> bool" where |
|
5747 |
"nat_list l = nat_set (set l)" |
|
5748 |
||
5749 |
definition return_list :: "int list \<Rightarrow> nat list" where |
|
5750 |
"return_list l = map nat l" |
|
33318
ddd97d9dfbfb
moved Nat_Transfer before Divides; distributed Nat_Transfer setup accordingly
haftmann
parents:
32960
diff
changeset
|
5751 |
|
ddd97d9dfbfb
moved Nat_Transfer before Divides; distributed Nat_Transfer setup accordingly
haftmann
parents:
32960
diff
changeset
|
5752 |
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
|
5753 |
embed_list (return_list l) = l" |
ddd97d9dfbfb
moved Nat_Transfer before Divides; distributed Nat_Transfer setup accordingly
haftmann
parents:
32960
diff
changeset
|
5754 |
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
|
5755 |
apply (induct l) |
ddd97d9dfbfb
moved Nat_Transfer before Divides; distributed Nat_Transfer setup accordingly
haftmann
parents:
32960
diff
changeset
|
5756 |
apply auto |
ddd97d9dfbfb
moved Nat_Transfer before Divides; distributed Nat_Transfer setup accordingly
haftmann
parents:
32960
diff
changeset
|
5757 |
done |
ddd97d9dfbfb
moved Nat_Transfer before Divides; distributed Nat_Transfer setup accordingly
haftmann
parents:
32960
diff
changeset
|
5758 |
|
ddd97d9dfbfb
moved Nat_Transfer before Divides; distributed Nat_Transfer setup accordingly
haftmann
parents:
32960
diff
changeset
|
5759 |
lemma transfer_nat_int_list_functions: |
ddd97d9dfbfb
moved Nat_Transfer before Divides; distributed Nat_Transfer setup accordingly
haftmann
parents:
32960
diff
changeset
|
5760 |
"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
|
5761 |
"[] = return_list []" |
ddd97d9dfbfb
moved Nat_Transfer before Divides; distributed Nat_Transfer setup accordingly
haftmann
parents:
32960
diff
changeset
|
5762 |
unfolding return_list_def embed_list_def |
ddd97d9dfbfb
moved Nat_Transfer before Divides; distributed Nat_Transfer setup accordingly
haftmann
parents:
32960
diff
changeset
|
5763 |
apply auto |
ddd97d9dfbfb
moved Nat_Transfer before Divides; distributed Nat_Transfer setup accordingly
haftmann
parents:
32960
diff
changeset
|
5764 |
apply (induct l, auto) |
ddd97d9dfbfb
moved Nat_Transfer before Divides; distributed Nat_Transfer setup accordingly
haftmann
parents:
32960
diff
changeset
|
5765 |
apply (induct m, auto) |
ddd97d9dfbfb
moved Nat_Transfer before Divides; distributed Nat_Transfer setup accordingly
haftmann
parents:
32960
diff
changeset
|
5766 |
done |
ddd97d9dfbfb
moved Nat_Transfer before Divides; distributed Nat_Transfer setup accordingly
haftmann
parents:
32960
diff
changeset
|
5767 |
|
ddd97d9dfbfb
moved Nat_Transfer before Divides; distributed Nat_Transfer setup accordingly
haftmann
parents:
32960
diff
changeset
|
5768 |
(* |
ddd97d9dfbfb
moved Nat_Transfer before Divides; distributed Nat_Transfer setup accordingly
haftmann
parents:
32960
diff
changeset
|
5769 |
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
|
5770 |
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
|
5771 |
*) |
ddd97d9dfbfb
moved Nat_Transfer before Divides; distributed Nat_Transfer setup accordingly
haftmann
parents:
32960
diff
changeset
|
5772 |
|
ddd97d9dfbfb
moved Nat_Transfer before Divides; distributed Nat_Transfer setup accordingly
haftmann
parents:
32960
diff
changeset
|
5773 |
|
37605
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
5774 |
subsection {* Code generation *} |
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
5775 |
|
51875
dafd097dd1f4
tail recursive version of map, for code generation, optionally
nipkow
parents:
51738
diff
changeset
|
5776 |
|
dafd097dd1f4
tail recursive version of map, for code generation, optionally
nipkow
parents:
51738
diff
changeset
|
5777 |
text{* Optional tail recursive version of @{const map}. Can avoid |
dafd097dd1f4
tail recursive version of map, for code generation, optionally
nipkow
parents:
51738
diff
changeset
|
5778 |
stack overflow in some target languages. *} |
dafd097dd1f4
tail recursive version of map, for code generation, optionally
nipkow
parents:
51738
diff
changeset
|
5779 |
|
dafd097dd1f4
tail recursive version of map, for code generation, optionally
nipkow
parents:
51738
diff
changeset
|
5780 |
fun map_tailrec_rev :: "('a \<Rightarrow> 'b) \<Rightarrow> 'a list \<Rightarrow> 'b list \<Rightarrow> 'b list" where |
dafd097dd1f4
tail recursive version of map, for code generation, optionally
nipkow
parents:
51738
diff
changeset
|
5781 |
"map_tailrec_rev f [] bs = bs" | |
dafd097dd1f4
tail recursive version of map, for code generation, optionally
nipkow
parents:
51738
diff
changeset
|
5782 |
"map_tailrec_rev f (a#as) bs = map_tailrec_rev f as (f a # bs)" |
dafd097dd1f4
tail recursive version of map, for code generation, optionally
nipkow
parents:
51738
diff
changeset
|
5783 |
|
dafd097dd1f4
tail recursive version of map, for code generation, optionally
nipkow
parents:
51738
diff
changeset
|
5784 |
lemma map_tailrec_rev: |
dafd097dd1f4
tail recursive version of map, for code generation, optionally
nipkow
parents:
51738
diff
changeset
|
5785 |
"map_tailrec_rev f as bs = rev(map f as) @ bs" |
dafd097dd1f4
tail recursive version of map, for code generation, optionally
nipkow
parents:
51738
diff
changeset
|
5786 |
by(induction as arbitrary: bs) simp_all |
dafd097dd1f4
tail recursive version of map, for code generation, optionally
nipkow
parents:
51738
diff
changeset
|
5787 |
|
dafd097dd1f4
tail recursive version of map, for code generation, optionally
nipkow
parents:
51738
diff
changeset
|
5788 |
definition map_tailrec :: "('a \<Rightarrow> 'b) \<Rightarrow> 'a list \<Rightarrow> 'b list" where |
dafd097dd1f4
tail recursive version of map, for code generation, optionally
nipkow
parents:
51738
diff
changeset
|
5789 |
"map_tailrec f as = rev (map_tailrec_rev f as [])" |
dafd097dd1f4
tail recursive version of map, for code generation, optionally
nipkow
parents:
51738
diff
changeset
|
5790 |
|
dafd097dd1f4
tail recursive version of map, for code generation, optionally
nipkow
parents:
51738
diff
changeset
|
5791 |
text{* Code equation: *} |
dafd097dd1f4
tail recursive version of map, for code generation, optionally
nipkow
parents:
51738
diff
changeset
|
5792 |
lemma map_eq_map_tailrec: "map = map_tailrec" |
dafd097dd1f4
tail recursive version of map, for code generation, optionally
nipkow
parents:
51738
diff
changeset
|
5793 |
by(simp add: fun_eq_iff map_tailrec_def map_tailrec_rev) |
dafd097dd1f4
tail recursive version of map, for code generation, optionally
nipkow
parents:
51738
diff
changeset
|
5794 |
|
dafd097dd1f4
tail recursive version of map, for code generation, optionally
nipkow
parents:
51738
diff
changeset
|
5795 |
|
37605
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
5796 |
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
|
5797 |
|
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
5798 |
definition member :: "'a list \<Rightarrow> 'a \<Rightarrow> bool" where |
50548 | 5799 |
[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
|
5800 |
|
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
5801 |
text {* |
46030
51b2f3412a03
attribute code_abbrev superseedes code_unfold_post; tuned text
haftmann
parents:
45993
diff
changeset
|
5802 |
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
|
5803 |
@{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
|
5804 |
*} |
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
5805 |
|
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
5806 |
lemma member_rec [code]: |
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
5807 |
"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
|
5808 |
"member [] y \<longleftrightarrow> False" |
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
5809 |
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
|
5810 |
|
46030
51b2f3412a03
attribute code_abbrev superseedes code_unfold_post; tuned text
haftmann
parents:
45993
diff
changeset
|
5811 |
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
|
5812 |
"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
|
5813 |
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
|
5814 |
|
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
5815 |
definition list_all :: "('a \<Rightarrow> bool) \<Rightarrow> 'a list \<Rightarrow> bool" where |
50548 | 5816 |
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
|
5817 |
|
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
5818 |
definition list_ex :: "('a \<Rightarrow> bool) \<Rightarrow> 'a list \<Rightarrow> bool" where |
50548 | 5819 |
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
|
5820 |
|
51b2f3412a03
attribute code_abbrev superseedes code_unfold_post; tuned text
haftmann
parents:
45993
diff
changeset
|
5821 |
definition list_ex1 :: "('a \<Rightarrow> bool) \<Rightarrow> 'a list \<Rightarrow> bool" where |
50548 | 5822 |
list_ex1_iff [code_abbrev]: "list_ex1 P xs \<longleftrightarrow> (\<exists>! x. x \<in> set xs \<and> P x)" |
40652 | 5823 |
|
37605
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
5824 |
text {* |
46030
51b2f3412a03
attribute code_abbrev superseedes code_unfold_post; tuned text
haftmann
parents:
45993
diff
changeset
|
5825 |
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
|
5826 |
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
|
5827 |
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
|
5828 |
*} |
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
5829 |
|
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
5830 |
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
|
5831 |
"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
|
5832 |
"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
|
5833 |
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
|
5834 |
|
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
5835 |
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
|
5836 |
"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
|
5837 |
"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
|
5838 |
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
|
5839 |
|
40652 | 5840 |
lemma list_ex1_simps [simp, code]: |
5841 |
"list_ex1 P [] = False" |
|
5842 |
"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
|
5843 |
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
|
5844 |
|
51b2f3412a03
attribute code_abbrev superseedes code_unfold_post; tuned text
haftmann
parents:
45993
diff
changeset
|
5845 |
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
|
5846 |
"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
|
5847 |
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
|
5848 |
|
46030
51b2f3412a03
attribute code_abbrev superseedes code_unfold_post; tuned text
haftmann
parents:
45993
diff
changeset
|
5849 |
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
|
5850 |
"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
|
5851 |
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
|
5852 |
|
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
5853 |
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
|
5854 |
"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
|
5855 |
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
|
5856 |
|
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
5857 |
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
|
5858 |
"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
|
5859 |
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
|
5860 |
|
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
5861 |
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
|
5862 |
"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
|
5863 |
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
|
5864 |
|
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
5865 |
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
|
5866 |
"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
|
5867 |
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
|
5868 |
|
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
5869 |
lemma list_all_length: |
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
5870 |
"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
|
5871 |
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
|
5872 |
|
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
5873 |
lemma list_ex_length: |
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
5874 |
"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
|
5875 |
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
|
5876 |
|
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
5877 |
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
|
5878 |
"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
|
5879 |
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
|
5880 |
|
47131 | 5881 |
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
|
5882 |
"xs = ys \<Longrightarrow> (\<And>x. x \<in> set ys \<Longrightarrow> f x = g x) \<Longrightarrow> list_ex f xs = list_ex g ys" |
47131 | 5883 |
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
|
5884 |
|
50548 | 5885 |
definition can_select :: "('a \<Rightarrow> bool) \<Rightarrow> 'a set \<Rightarrow> bool" where |
5886 |
[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
|
5887 |
|
744934b818c7
moved quite generic material from theory Enum to more appropriate places
haftmann
parents:
49808
diff
changeset
|
5888 |
lemma can_select_set_list_ex1 [code]: |
744934b818c7
moved quite generic material from theory Enum to more appropriate places
haftmann
parents:
49808
diff
changeset
|
5889 |
"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
|
5890 |
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
|
5891 |
|
744934b818c7
moved quite generic material from theory Enum to more appropriate places
haftmann
parents:
49808
diff
changeset
|
5892 |
|
46313 | 5893 |
text {* Executable checks for relations on sets *} |
5894 |
||
5895 |
definition listrel1p :: "('a \<Rightarrow> 'a \<Rightarrow> bool) \<Rightarrow> 'a list \<Rightarrow> 'a list \<Rightarrow> bool" where |
|
5896 |
"listrel1p r xs ys = ((xs, ys) \<in> listrel1 {(x, y). r x y})" |
|
5897 |
||
5898 |
lemma [code_unfold]: |
|
5899 |
"(xs, ys) \<in> listrel1 r = listrel1p (\<lambda>x y. (x, y) \<in> r) xs ys" |
|
5900 |
unfolding listrel1p_def by auto |
|
5901 |
||
5902 |
lemma [code]: |
|
5903 |
"listrel1p r [] xs = False" |
|
5904 |
"listrel1p r xs [] = False" |
|
5905 |
"listrel1p r (x # xs) (y # ys) \<longleftrightarrow> |
|
5906 |
r x y \<and> xs = ys \<or> x = y \<and> listrel1p r xs ys" |
|
5907 |
by (simp add: listrel1p_def)+ |
|
5908 |
||
5909 |
definition |
|
5910 |
lexordp :: "('a \<Rightarrow> 'a \<Rightarrow> bool) \<Rightarrow> 'a list \<Rightarrow> 'a list \<Rightarrow> bool" where |
|
5911 |
"lexordp r xs ys = ((xs, ys) \<in> lexord {(x, y). r x y})" |
|
5912 |
||
5913 |
lemma [code_unfold]: |
|
5914 |
"(xs, ys) \<in> lexord r = lexordp (\<lambda>x y. (x, y) \<in> r) xs ys" |
|
5915 |
unfolding lexordp_def by auto |
|
5916 |
||
5917 |
lemma [code]: |
|
5918 |
"lexordp r xs [] = False" |
|
5919 |
"lexordp r [] (y#ys) = True" |
|
5920 |
"lexordp r (x # xs) (y # ys) = (r x y | (x = y & lexordp r xs ys))" |
|
5921 |
unfolding lexordp_def by auto |
|
5922 |
||
37605
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
5923 |
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
|
5924 |
|
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
5925 |
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
|
5926 |
"{..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
|
5927 |
by auto |
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
5928 |
|
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
5929 |
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
|
5930 |
"{..<n} = set [0..<n]" |
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
5931 |
by auto |
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
5932 |
|
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
5933 |
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
|
5934 |
"{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
|
5935 |
by auto |
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
5936 |
|
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
5937 |
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
|
5938 |
|
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
5939 |
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
|
5940 |
"{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
|
5941 |
by auto |
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
5942 |
|
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
5943 |
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
|
5944 |
"{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
|
5945 |
by auto |
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
5946 |
|
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
5947 |
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
|
5948 |
"(\<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
|
5949 |
by auto |
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
5950 |
|
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
5951 |
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
|
5952 |
"(\<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
|
5953 |
by auto |
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
5954 |
|
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
5955 |
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
|
5956 |
"(\<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
|
5957 |
by auto |
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
5958 |
|
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
5959 |
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
|
5960 |
"(\<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
|
5961 |
by auto |
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
5962 |
|
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
5963 |
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
|
5964 |
"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
|
5965 |
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
|
5966 |
|
53954 | 5967 |
text{* Bounded @{text LEAST} operator: *} |
5968 |
||
5969 |
definition "Bleast S P = (LEAST x. x \<in> S \<and> P x)" |
|
5970 |
||
5971 |
definition "abort_Bleast S P = (LEAST x. x \<in> S \<and> P x)" |
|
5972 |
||
5973 |
code_abort abort_Bleast |
|
5974 |
||
5975 |
lemma Bleast_code [code]: |
|
5976 |
"Bleast (set xs) P = (case filter P (sort xs) of |
|
5977 |
x#xs \<Rightarrow> x | |
|
5978 |
[] \<Rightarrow> abort_Bleast (set xs) P)" |
|
5979 |
proof (cases "filter P (sort xs)") |
|
5980 |
case Nil thus ?thesis by (simp add: Bleast_def abort_Bleast_def) |
|
5981 |
next |
|
5982 |
case (Cons x ys) |
|
5983 |
have "(LEAST x. x \<in> set xs \<and> P x) = x" |
|
5984 |
proof (rule Least_equality) |
|
5985 |
show "x \<in> set xs \<and> P x" |
|
5986 |
by (metis Cons Cons_eq_filter_iff in_set_conv_decomp set_sort) |
|
5987 |
next |
|
5988 |
fix y assume "y : set xs \<and> P y" |
|
5989 |
hence "y : set (filter P xs)" by auto |
|
5990 |
thus "x \<le> y" |
|
5991 |
by (metis Cons eq_iff filter_sort set_ConsD set_sort sorted_Cons sorted_sort) |
|
5992 |
qed |
|
5993 |
thus ?thesis using Cons by (simp add: Bleast_def) |
|
5994 |
qed |
|
5995 |
||
5996 |
declare Bleast_def[symmetric, code_unfold] |
|
5997 |
||
37605
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
5998 |
text {* Summation over ints. *} |
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
5999 |
|
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
6000 |
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
|
6001 |
"{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
|
6002 |
by auto |
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
6003 |
|
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
6004 |
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
|
6005 |
"{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
|
6006 |
by auto |
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
6007 |
|
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
6008 |
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
|
6009 |
"{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
|
6010 |
by auto |
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
6011 |
|
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
6012 |
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
|
6013 |
|
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
6014 |
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
|
6015 |
"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
|
6016 |
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
|
6017 |
|
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
6018 |
|
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
6019 |
subsubsection {* Optimizing by rewriting *} |
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
6020 |
|
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
6021 |
definition null :: "'a list \<Rightarrow> bool" where |
46030
51b2f3412a03
attribute code_abbrev superseedes code_unfold_post; tuned text
haftmann
parents:
45993
diff
changeset
|
6022 |
[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
|
6023 |
|
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
6024 |
text {* |
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
6025 |
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
|
6026 |
*} |
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
6027 |
|
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
6028 |
lemma null_rec [code]: |
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
6029 |
"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
|
6030 |
"null [] \<longleftrightarrow> True" |
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
6031 |
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
|
6032 |
|
46030
51b2f3412a03
attribute code_abbrev superseedes code_unfold_post; tuned text
haftmann
parents:
45993
diff
changeset
|
6033 |
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
|
6034 |
"xs = [] \<longleftrightarrow> null xs" |
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
6035 |
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
|
6036 |
|
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
6037 |
lemma equal_Nil_null [code_unfold]: |
38857
97775f3e8722
renamed class/constant eq to equal; tuned some instantiations
haftmann
parents:
38715
diff
changeset
|
6038 |
"HOL.equal xs [] \<longleftrightarrow> null xs" |
53940
36cf426cb1c6
Added symmetric code_unfold-lemmas for null and is_none
lammich <lammich@in.tum.de>
parents:
53721
diff
changeset
|
6039 |
"HOL.equal [] = null" |
36cf426cb1c6
Added symmetric code_unfold-lemmas for null and is_none
lammich <lammich@in.tum.de>
parents:
53721
diff
changeset
|
6040 |
by (auto simp add: equal null_def) |
37605
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
6041 |
|
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
6042 |
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
|
6043 |
[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
|
6044 |
|
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
6045 |
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
|
6046 |
[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
|
6047 |
|
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
6048 |
text {* |
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
6049 |
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
|
6050 |
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
|
6051 |
*} |
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
6052 |
|
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
6053 |
lemma maps_simps [code]: |
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
6054 |
"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
|
6055 |
"maps f [] = []" |
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
6056 |
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
|
6057 |
|
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
6058 |
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
|
6059 |
"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
|
6060 |
"map_filter f [] = []" |
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
6061 |
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
|
6062 |
|
46030
51b2f3412a03
attribute code_abbrev superseedes code_unfold_post; tuned text
haftmann
parents:
45993
diff
changeset
|
6063 |
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
|
6064 |
"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
|
6065 |
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
|
6066 |
|
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
6067 |
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
|
6068 |
"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
|
6069 |
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
|
6070 |
|
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
6071 |
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
|
6072 |
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
|
6073 |
|
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
6074 |
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
|
6075 |
"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
|
6076 |
|
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
6077 |
lemma [code]: |
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
6078 |
"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
|
6079 |
proof - |
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
6080 |
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
|
6081 |
proof - |
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
6082 |
fix n |
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
6083 |
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
|
6084 |
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
|
6085 |
qed |
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
6086 |
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
|
6087 |
qed |
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
6088 |
|
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
6089 |
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
|
6090 |
"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
|
6091 |
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
|
6092 |
|
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
6093 |
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
|
6094 |
"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
|
6095 |
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
|
6096 |
|
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
6097 |
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
|
6098 |
"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
|
6099 |
|
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
6100 |
lemma [code]: |
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
6101 |
"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
|
6102 |
proof - |
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
6103 |
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
|
6104 |
proof - |
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
6105 |
fix k |
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
6106 |
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
|
6107 |
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
|
6108 |
qed |
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
6109 |
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
|
6110 |
qed |
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
6111 |
|
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
6112 |
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
|
6113 |
"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
|
6114 |
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
|
6115 |
|
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
6116 |
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
|
6117 |
"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
|
6118 |
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
|
6119 |
|
49808
418991ce7567
tail-recursive implementation for length
Andreas Lochbihler
parents:
49757
diff
changeset
|
6120 |
text {* optimized code (tail-recursive) for @{term length} *} |
418991ce7567
tail-recursive implementation for length
Andreas Lochbihler
parents:
49757
diff
changeset
|
6121 |
|
418991ce7567
tail-recursive implementation for length
Andreas Lochbihler
parents:
49757
diff
changeset
|
6122 |
definition gen_length :: "nat \<Rightarrow> 'a list \<Rightarrow> nat" |
418991ce7567
tail-recursive implementation for length
Andreas Lochbihler
parents:
49757
diff
changeset
|
6123 |
where "gen_length n xs = n + length xs" |
418991ce7567
tail-recursive implementation for length
Andreas Lochbihler
parents:
49757
diff
changeset
|
6124 |
|
418991ce7567
tail-recursive implementation for length
Andreas Lochbihler
parents:
49757
diff
changeset
|
6125 |
lemma gen_length_code [code]: |
418991ce7567
tail-recursive implementation for length
Andreas Lochbihler
parents:
49757
diff
changeset
|
6126 |
"gen_length n [] = n" |
418991ce7567
tail-recursive implementation for length
Andreas Lochbihler
parents:
49757
diff
changeset
|
6127 |
"gen_length n (x # xs) = gen_length (Suc n) xs" |
418991ce7567
tail-recursive implementation for length
Andreas Lochbihler
parents:
49757
diff
changeset
|
6128 |
by(simp_all add: gen_length_def) |
418991ce7567
tail-recursive implementation for length
Andreas Lochbihler
parents:
49757
diff
changeset
|
6129 |
|
418991ce7567
tail-recursive implementation for length
Andreas Lochbihler
parents:
49757
diff
changeset
|
6130 |
declare list.size(3-4)[code del] |
418991ce7567
tail-recursive implementation for length
Andreas Lochbihler
parents:
49757
diff
changeset
|
6131 |
|
418991ce7567
tail-recursive implementation for length
Andreas Lochbihler
parents:
49757
diff
changeset
|
6132 |
lemma length_code [code]: "length = gen_length 0" |
418991ce7567
tail-recursive implementation for length
Andreas Lochbihler
parents:
49757
diff
changeset
|
6133 |
by(simp add: gen_length_def fun_eq_iff) |
418991ce7567
tail-recursive implementation for length
Andreas Lochbihler
parents:
49757
diff
changeset
|
6134 |
|
418991ce7567
tail-recursive implementation for length
Andreas Lochbihler
parents:
49757
diff
changeset
|
6135 |
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
|
6136 |
|
49948
744934b818c7
moved quite generic material from theory Enum to more appropriate places
haftmann
parents:
49808
diff
changeset
|
6137 |
|
37605
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
6138 |
subsubsection {* Pretty lists *} |
15064
4f3102b50197
- Moved code generator setup for lists from Main.thy to List.thy
berghofe
parents:
15045
diff
changeset
|
6139 |
|
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
|
6140 |
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
|
6141 |
(* 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
|
6142 |
|
ee729dbd1b7f
avoid ML_file in large theory files to improve performance of dependency discovery of main HOL (approx. 1s CPU time) -- relevant for any application using it, e.g. small paper sessions;
wenzelm
parents:
50134
diff
changeset
|
6143 |
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
|
6144 |
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
|
6145 |
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
|
6146 |
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
|
6147 |
-> (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
|
6148 |
-> 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
|
6149 |
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
|
6150 |
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
|
6151 |
|
ee729dbd1b7f
avoid ML_file in large theory files to improve performance of dependency discovery of main HOL (approx. 1s CPU time) -- relevant for any application using it, e.g. small paper sessions;
wenzelm
parents:
50134
diff
changeset
|
6152 |
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
|
6153 |
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
|
6154 |
|
ee729dbd1b7f
avoid ML_file in large theory files to improve performance of dependency discovery of main HOL (approx. 1s CPU time) -- relevant for any application using it, e.g. small paper sessions;
wenzelm
parents:
50134
diff
changeset
|
6155 |
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
|
6156 |
|
ee729dbd1b7f
avoid ML_file in large theory files to improve performance of dependency discovery of main HOL (approx. 1s CPU time) -- relevant for any application using it, e.g. small paper sessions;
wenzelm
parents:
50134
diff
changeset
|
6157 |
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
|
6158 |
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
|
6159 |
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
|
6160 |
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
|
6161 |
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
|
6162 |
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
|
6163 |
| 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
|
6164 |
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
|
6165 |
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
|
6166 |
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
|
6167 |
| _ => 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
|
6168 |
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
|
6169 |
|
ee729dbd1b7f
avoid ML_file in large theory files to improve performance of dependency discovery of main HOL (approx. 1s CPU time) -- relevant for any application using it, e.g. small paper sessions;
wenzelm
parents:
50134
diff
changeset
|
6170 |
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
|
6171 |
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
|
6172 |
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
|
6173 |
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
|
6174 |
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
|
6175 |
); |
ee729dbd1b7f
avoid ML_file in large theory files to improve performance of dependency discovery of main HOL (approx. 1s CPU time) -- relevant for any application using it, e.g. small paper sessions;
wenzelm
parents:
50134
diff
changeset
|
6176 |
|
ee729dbd1b7f
avoid ML_file in large theory files to improve performance of dependency discovery of main HOL (approx. 1s CPU time) -- relevant for any application using it, e.g. small paper sessions;
wenzelm
parents:
50134
diff
changeset
|
6177 |
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
|
6178 |
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
|
6179 |
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
|
6180 |
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
|
6181 |
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
|
6182 |
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
|
6183 |
| 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
|
6184 |
default_list (Code_Printer.infix_cons literals) (pr vars) fxy t1 t2; |
52435
6646bb548c6b
migration from code_(const|type|class|instance) to code_printing and from code_module to code_identifier
haftmann
parents:
52380
diff
changeset
|
6185 |
in |
6646bb548c6b
migration from code_(const|type|class|instance) to code_printing and from code_module to code_identifier
haftmann
parents:
52380
diff
changeset
|
6186 |
Code_Target.set_printings (Code_Symbol.Constant (@{const_name Cons}, |
6646bb548c6b
migration from code_(const|type|class|instance) to code_printing and from code_module to code_identifier
haftmann
parents:
52380
diff
changeset
|
6187 |
[(target, SOME (Code_Printer.complex_const_syntax (2, ([@{const_name Nil}, @{const_name Cons}], pretty))))])) |
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
|
6188 |
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
|
6189 |
|
ee729dbd1b7f
avoid ML_file in large theory files to improve performance of dependency discovery of main HOL (approx. 1s CPU time) -- relevant for any application using it, e.g. small paper sessions;
wenzelm
parents:
50134
diff
changeset
|
6190 |
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
|
6191 |
*} |
31055
2cf6efca6c71
proper structures for list and string code generation stuff
haftmann
parents:
31048
diff
changeset
|
6192 |
|
52435
6646bb548c6b
migration from code_(const|type|class|instance) to code_printing and from code_module to code_identifier
haftmann
parents:
52380
diff
changeset
|
6193 |
code_printing |
6646bb548c6b
migration from code_(const|type|class|instance) to code_printing and from code_module to code_identifier
haftmann
parents:
52380
diff
changeset
|
6194 |
type_constructor list \<rightharpoonup> |
6646bb548c6b
migration from code_(const|type|class|instance) to code_printing and from code_module to code_identifier
haftmann
parents:
52380
diff
changeset
|
6195 |
(SML) "_ list" |
6646bb548c6b
migration from code_(const|type|class|instance) to code_printing and from code_module to code_identifier
haftmann
parents:
52380
diff
changeset
|
6196 |
and (OCaml) "_ list" |
6646bb548c6b
migration from code_(const|type|class|instance) to code_printing and from code_module to code_identifier
haftmann
parents:
52380
diff
changeset
|
6197 |
and (Haskell) "![(_)]" |
6646bb548c6b
migration from code_(const|type|class|instance) to code_printing and from code_module to code_identifier
haftmann
parents:
52380
diff
changeset
|
6198 |
and (Scala) "List[(_)]" |
6646bb548c6b
migration from code_(const|type|class|instance) to code_printing and from code_module to code_identifier
haftmann
parents:
52380
diff
changeset
|
6199 |
| constant Nil \<rightharpoonup> |
6646bb548c6b
migration from code_(const|type|class|instance) to code_printing and from code_module to code_identifier
haftmann
parents:
52380
diff
changeset
|
6200 |
(SML) "[]" |
6646bb548c6b
migration from code_(const|type|class|instance) to code_printing and from code_module to code_identifier
haftmann
parents:
52380
diff
changeset
|
6201 |
and (OCaml) "[]" |
6646bb548c6b
migration from code_(const|type|class|instance) to code_printing and from code_module to code_identifier
haftmann
parents:
52380
diff
changeset
|
6202 |
and (Haskell) "[]" |
6646bb548c6b
migration from code_(const|type|class|instance) to code_printing and from code_module to code_identifier
haftmann
parents:
52380
diff
changeset
|
6203 |
and (Scala) "!Nil" |
6646bb548c6b
migration from code_(const|type|class|instance) to code_printing and from code_module to code_identifier
haftmann
parents:
52380
diff
changeset
|
6204 |
| class_instance list :: equal \<rightharpoonup> |
6646bb548c6b
migration from code_(const|type|class|instance) to code_printing and from code_module to code_identifier
haftmann
parents:
52380
diff
changeset
|
6205 |
(Haskell) - |
6646bb548c6b
migration from code_(const|type|class|instance) to code_printing and from code_module to code_identifier
haftmann
parents:
52380
diff
changeset
|
6206 |
| constant "HOL.equal :: 'a list \<Rightarrow> 'a list \<Rightarrow> bool" \<rightharpoonup> |
6646bb548c6b
migration from code_(const|type|class|instance) to code_printing and from code_module to code_identifier
haftmann
parents:
52380
diff
changeset
|
6207 |
(Haskell) infix 4 "==" |
6646bb548c6b
migration from code_(const|type|class|instance) to code_printing and from code_module to code_identifier
haftmann
parents:
52380
diff
changeset
|
6208 |
|
6646bb548c6b
migration from code_(const|type|class|instance) to code_printing and from code_module to code_identifier
haftmann
parents:
52380
diff
changeset
|
6209 |
setup {* fold (List_Code.add_literal_list) ["SML", "OCaml", "Haskell", "Scala"] *} |
31048
ac146fc38b51
refined HOL string theories and corresponding ML fragments
haftmann
parents:
31022
diff
changeset
|
6210 |
|
ac146fc38b51
refined HOL string theories and corresponding ML fragments
haftmann
parents:
31022
diff
changeset
|
6211 |
code_reserved SML |
ac146fc38b51
refined HOL string theories and corresponding ML fragments
haftmann
parents:
31022
diff
changeset
|
6212 |
list |
ac146fc38b51
refined HOL string theories and corresponding ML fragments
haftmann
parents:
31022
diff
changeset
|
6213 |
|
ac146fc38b51
refined HOL string theories and corresponding ML fragments
haftmann
parents:
31022
diff
changeset
|
6214 |
code_reserved OCaml |
ac146fc38b51
refined HOL string theories and corresponding ML fragments
haftmann
parents:
31022
diff
changeset
|
6215 |
list |
ac146fc38b51
refined HOL string theories and corresponding ML fragments
haftmann
parents:
31022
diff
changeset
|
6216 |
|
21061
580dfc999ef6
added normal post setup; cleaned up "execution" constants
haftmann
parents:
21046
diff
changeset
|
6217 |
|
37424
ed431cc99f17
use various predefined Haskell operations when generating code
haftmann
parents:
37408
diff
changeset
|
6218 |
subsubsection {* Use convenient predefined operations *} |
ed431cc99f17
use various predefined Haskell operations when generating code
haftmann
parents:
37408
diff
changeset
|
6219 |
|
52435
6646bb548c6b
migration from code_(const|type|class|instance) to code_printing and from code_module to code_identifier
haftmann
parents:
52380
diff
changeset
|
6220 |
code_printing |
6646bb548c6b
migration from code_(const|type|class|instance) to code_printing and from code_module to code_identifier
haftmann
parents:
52380
diff
changeset
|
6221 |
constant "op @" \<rightharpoonup> |
6646bb548c6b
migration from code_(const|type|class|instance) to code_printing and from code_module to code_identifier
haftmann
parents:
52380
diff
changeset
|
6222 |
(SML) infixr 7 "@" |
6646bb548c6b
migration from code_(const|type|class|instance) to code_printing and from code_module to code_identifier
haftmann
parents:
52380
diff
changeset
|
6223 |
and (OCaml) infixr 6 "@" |
6646bb548c6b
migration from code_(const|type|class|instance) to code_printing and from code_module to code_identifier
haftmann
parents:
52380
diff
changeset
|
6224 |
and (Haskell) infixr 5 "++" |
6646bb548c6b
migration from code_(const|type|class|instance) to code_printing and from code_module to code_identifier
haftmann
parents:
52380
diff
changeset
|
6225 |
and (Scala) infixl 7 "++" |
6646bb548c6b
migration from code_(const|type|class|instance) to code_printing and from code_module to code_identifier
haftmann
parents:
52380
diff
changeset
|
6226 |
| constant map \<rightharpoonup> |
6646bb548c6b
migration from code_(const|type|class|instance) to code_printing and from code_module to code_identifier
haftmann
parents:
52380
diff
changeset
|
6227 |
(Haskell) "map" |
6646bb548c6b
migration from code_(const|type|class|instance) to code_printing and from code_module to code_identifier
haftmann
parents:
52380
diff
changeset
|
6228 |
| constant filter \<rightharpoonup> |
6646bb548c6b
migration from code_(const|type|class|instance) to code_printing and from code_module to code_identifier
haftmann
parents:
52380
diff
changeset
|
6229 |
(Haskell) "filter" |
6646bb548c6b
migration from code_(const|type|class|instance) to code_printing and from code_module to code_identifier
haftmann
parents:
52380
diff
changeset
|
6230 |
| constant concat \<rightharpoonup> |
6646bb548c6b
migration from code_(const|type|class|instance) to code_printing and from code_module to code_identifier
haftmann
parents:
52380
diff
changeset
|
6231 |
(Haskell) "concat" |
6646bb548c6b
migration from code_(const|type|class|instance) to code_printing and from code_module to code_identifier
haftmann
parents:
52380
diff
changeset
|
6232 |
| constant List.maps \<rightharpoonup> |
6646bb548c6b
migration from code_(const|type|class|instance) to code_printing and from code_module to code_identifier
haftmann
parents:
52380
diff
changeset
|
6233 |
(Haskell) "concatMap" |
6646bb548c6b
migration from code_(const|type|class|instance) to code_printing and from code_module to code_identifier
haftmann
parents:
52380
diff
changeset
|
6234 |
| constant rev \<rightharpoonup> |
6646bb548c6b
migration from code_(const|type|class|instance) to code_printing and from code_module to code_identifier
haftmann
parents:
52380
diff
changeset
|
6235 |
(Haskell) "reverse" |
6646bb548c6b
migration from code_(const|type|class|instance) to code_printing and from code_module to code_identifier
haftmann
parents:
52380
diff
changeset
|
6236 |
| constant zip \<rightharpoonup> |
6646bb548c6b
migration from code_(const|type|class|instance) to code_printing and from code_module to code_identifier
haftmann
parents:
52380
diff
changeset
|
6237 |
(Haskell) "zip" |
6646bb548c6b
migration from code_(const|type|class|instance) to code_printing and from code_module to code_identifier
haftmann
parents:
52380
diff
changeset
|
6238 |
| constant List.null \<rightharpoonup> |
6646bb548c6b
migration from code_(const|type|class|instance) to code_printing and from code_module to code_identifier
haftmann
parents:
52380
diff
changeset
|
6239 |
(Haskell) "null" |
6646bb548c6b
migration from code_(const|type|class|instance) to code_printing and from code_module to code_identifier
haftmann
parents:
52380
diff
changeset
|
6240 |
| constant takeWhile \<rightharpoonup> |
6646bb548c6b
migration from code_(const|type|class|instance) to code_printing and from code_module to code_identifier
haftmann
parents:
52380
diff
changeset
|
6241 |
(Haskell) "takeWhile" |
6646bb548c6b
migration from code_(const|type|class|instance) to code_printing and from code_module to code_identifier
haftmann
parents:
52380
diff
changeset
|
6242 |
| constant dropWhile \<rightharpoonup> |
6646bb548c6b
migration from code_(const|type|class|instance) to code_printing and from code_module to code_identifier
haftmann
parents:
52380
diff
changeset
|
6243 |
(Haskell) "dropWhile" |
6646bb548c6b
migration from code_(const|type|class|instance) to code_printing and from code_module to code_identifier
haftmann
parents:
52380
diff
changeset
|
6244 |
| constant list_all \<rightharpoonup> |
6646bb548c6b
migration from code_(const|type|class|instance) to code_printing and from code_module to code_identifier
haftmann
parents:
52380
diff
changeset
|
6245 |
(Haskell) "all" |
6646bb548c6b
migration from code_(const|type|class|instance) to code_printing and from code_module to code_identifier
haftmann
parents:
52380
diff
changeset
|
6246 |
| constant list_ex \<rightharpoonup> |
6646bb548c6b
migration from code_(const|type|class|instance) to code_printing and from code_module to code_identifier
haftmann
parents:
52380
diff
changeset
|
6247 |
(Haskell) "any" |
37605
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
6248 |
|
46147
2c4d8de91c4c
moved lemmas about List.set and set operations to List theory
haftmann
parents:
46143
diff
changeset
|
6249 |
|
2c4d8de91c4c
moved lemmas about List.set and set operations to List theory
haftmann
parents:
46143
diff
changeset
|
6250 |
subsubsection {* Implementation of sets by lists *} |
2c4d8de91c4c
moved lemmas about List.set and set operations to List theory
haftmann
parents:
46143
diff
changeset
|
6251 |
|
2c4d8de91c4c
moved lemmas about List.set and set operations to List theory
haftmann
parents:
46143
diff
changeset
|
6252 |
lemma is_empty_set [code]: |
2c4d8de91c4c
moved lemmas about List.set and set operations to List theory
haftmann
parents:
46143
diff
changeset
|
6253 |
"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
|
6254 |
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
|
6255 |
|
2c4d8de91c4c
moved lemmas about List.set and set operations to List theory
haftmann
parents:
46143
diff
changeset
|
6256 |
lemma empty_set [code]: |
2c4d8de91c4c
moved lemmas about List.set and set operations to List theory
haftmann
parents:
46143
diff
changeset
|
6257 |
"{} = set []" |
2c4d8de91c4c
moved lemmas about List.set and set operations to List theory
haftmann
parents:
46143
diff
changeset
|
6258 |
by simp |
2c4d8de91c4c
moved lemmas about List.set and set operations to List theory
haftmann
parents:
46143
diff
changeset
|
6259 |
|
46156 | 6260 |
lemma UNIV_coset [code]: |
6261 |
"UNIV = List.coset []" |
|
6262 |
by simp |
|
6263 |
||
6264 |
lemma compl_set [code]: |
|
6265 |
"- set xs = List.coset xs" |
|
6266 |
by simp |
|
6267 |
||
6268 |
lemma compl_coset [code]: |
|
6269 |
"- List.coset xs = set xs" |
|
6270 |
by simp |
|
6271 |
||
46147
2c4d8de91c4c
moved lemmas about List.set and set operations to List theory
haftmann
parents:
46143
diff
changeset
|
6272 |
lemma [code]: |
2c4d8de91c4c
moved lemmas about List.set and set operations to List theory
haftmann
parents:
46143
diff
changeset
|
6273 |
"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
|
6274 |
"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
|
6275 |
by (simp_all add: member_def) |
2c4d8de91c4c
moved lemmas about List.set and set operations to List theory
haftmann
parents:
46143
diff
changeset
|
6276 |
|
2c4d8de91c4c
moved lemmas about List.set and set operations to List theory
haftmann
parents:
46143
diff
changeset
|
6277 |
lemma insert_code [code]: |
2c4d8de91c4c
moved lemmas about List.set and set operations to List theory
haftmann
parents:
46143
diff
changeset
|
6278 |
"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
|
6279 |
"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
|
6280 |
by simp_all |
2c4d8de91c4c
moved lemmas about List.set and set operations to List theory
haftmann
parents:
46143
diff
changeset
|
6281 |
|
2c4d8de91c4c
moved lemmas about List.set and set operations to List theory
haftmann
parents:
46143
diff
changeset
|
6282 |
lemma remove_code [code]: |
2c4d8de91c4c
moved lemmas about List.set and set operations to List theory
haftmann
parents:
46143
diff
changeset
|
6283 |
"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
|
6284 |
"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
|
6285 |
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
|
6286 |
|
49757
73ab6d4a9236
rename Set.project to Set.filter - more appropriate name
kuncar
parents:
49739
diff
changeset
|
6287 |
lemma filter_set [code]: |
73ab6d4a9236
rename Set.project to Set.filter - more appropriate name
kuncar
parents:
49739
diff
changeset
|
6288 |
"Set.filter P (set xs) = set (filter P xs)" |
46156 | 6289 |
by auto |
6290 |
||
6291 |
lemma image_set [code]: |
|
6292 |
"image f (set xs) = set (map f xs)" |
|
6293 |
by simp |
|
6294 |
||
47398 | 6295 |
lemma subset_code [code]: |
6296 |
"set xs \<le> B \<longleftrightarrow> (\<forall>x\<in>set xs. x \<in> B)" |
|
6297 |
"A \<le> List.coset ys \<longleftrightarrow> (\<forall>y\<in>set ys. y \<notin> A)" |
|
6298 |
"List.coset [] \<le> set [] \<longleftrightarrow> False" |
|
6299 |
by auto |
|
6300 |
||
6301 |
text {* A frequent case – avoid intermediate sets *} |
|
6302 |
lemma [code_unfold]: |
|
6303 |
"set xs \<subseteq> set ys \<longleftrightarrow> list_all (\<lambda>x. x \<in> set ys) xs" |
|
6304 |
by (auto simp: list_all_iff) |
|
6305 |
||
46147
2c4d8de91c4c
moved lemmas about List.set and set operations to List theory
haftmann
parents:
46143
diff
changeset
|
6306 |
lemma Ball_set [code]: |
2c4d8de91c4c
moved lemmas about List.set and set operations to List theory
haftmann
parents:
46143
diff
changeset
|
6307 |
"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
|
6308 |
by (simp add: list_all_iff) |
2c4d8de91c4c
moved lemmas about List.set and set operations to List theory
haftmann
parents:
46143
diff
changeset
|
6309 |
|
2c4d8de91c4c
moved lemmas about List.set and set operations to List theory
haftmann
parents:
46143
diff
changeset
|
6310 |
lemma Bex_set [code]: |
2c4d8de91c4c
moved lemmas about List.set and set operations to List theory
haftmann
parents:
46143
diff
changeset
|
6311 |
"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
|
6312 |
by (simp add: list_ex_iff) |
2c4d8de91c4c
moved lemmas about List.set and set operations to List theory
haftmann
parents:
46143
diff
changeset
|
6313 |
|
2c4d8de91c4c
moved lemmas about List.set and set operations to List theory
haftmann
parents:
46143
diff
changeset
|
6314 |
lemma card_set [code]: |
2c4d8de91c4c
moved lemmas about List.set and set operations to List theory
haftmann
parents:
46143
diff
changeset
|
6315 |
"card (set xs) = length (remdups xs)" |
2c4d8de91c4c
moved lemmas about List.set and set operations to List theory
haftmann
parents:
46143
diff
changeset
|
6316 |
proof - |
2c4d8de91c4c
moved lemmas about List.set and set operations to List theory
haftmann
parents:
46143
diff
changeset
|
6317 |
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
|
6318 |
by (rule distinct_card) simp |
2c4d8de91c4c
moved lemmas about List.set and set operations to List theory
haftmann
parents:
46143
diff
changeset
|
6319 |
then show ?thesis by simp |
2c4d8de91c4c
moved lemmas about List.set and set operations to List theory
haftmann
parents:
46143
diff
changeset
|
6320 |
qed |
2c4d8de91c4c
moved lemmas about List.set and set operations to List theory
haftmann
parents:
46143
diff
changeset
|
6321 |
|
46156 | 6322 |
lemma the_elem_set [code]: |
6323 |
"the_elem (set [x]) = x" |
|
6324 |
by simp |
|
6325 |
||
6326 |
lemma Pow_set [code]: |
|
6327 |
"Pow (set []) = {{}}" |
|
6328 |
"Pow (set (x # xs)) = (let A = Pow (set xs) in A \<union> insert x ` A)" |
|
6329 |
by (simp_all add: Pow_insert Let_def) |
|
6330 |
||
46383 | 6331 |
lemma setsum_code [code]: |
6332 |
"setsum f (set xs) = listsum (map f (remdups xs))" |
|
6333 |
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
|
6334 |
|
46424
b447318e5e1a
adding code equation for Relation.image; adding map_project as correspondence to map_filter on lists
bulwahn
parents:
46418
diff
changeset
|
6335 |
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
|
6336 |
"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
|
6337 |
|
b447318e5e1a
adding code equation for Relation.image; adding map_project as correspondence to map_filter on lists
bulwahn
parents:
46418
diff
changeset
|
6338 |
lemma [code]: |
b447318e5e1a
adding code equation for Relation.image; adding map_project as correspondence to map_filter on lists
bulwahn
parents:
46418
diff
changeset
|
6339 |
"map_project f (set xs) = set (List.map_filter f xs)" |
47398 | 6340 |
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
|
6341 |
|
b447318e5e1a
adding code equation for Relation.image; adding map_project as correspondence to map_filter on lists
bulwahn
parents:
46418
diff
changeset
|
6342 |
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
|
6343 |
|
49948
744934b818c7
moved quite generic material from theory Enum to more appropriate places
haftmann
parents:
49808
diff
changeset
|
6344 |
|
46147
2c4d8de91c4c
moved lemmas about List.set and set operations to List theory
haftmann
parents:
46143
diff
changeset
|
6345 |
text {* Operations on relations *} |
2c4d8de91c4c
moved lemmas about List.set and set operations to List theory
haftmann
parents:
46143
diff
changeset
|
6346 |
|
2c4d8de91c4c
moved lemmas about List.set and set operations to List theory
haftmann
parents:
46143
diff
changeset
|
6347 |
lemma product_code [code]: |
2c4d8de91c4c
moved lemmas about List.set and set operations to List theory
haftmann
parents:
46143
diff
changeset
|
6348 |
"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
|
6349 |
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
|
6350 |
|
2c4d8de91c4c
moved lemmas about List.set and set operations to List theory
haftmann
parents:
46143
diff
changeset
|
6351 |
lemma Id_on_set [code]: |
2c4d8de91c4c
moved lemmas about List.set and set operations to List theory
haftmann
parents:
46143
diff
changeset
|
6352 |
"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
|
6353 |
by (auto simp add: Id_on_def) |
2c4d8de91c4c
moved lemmas about List.set and set operations to List theory
haftmann
parents:
46143
diff
changeset
|
6354 |
|
46424
b447318e5e1a
adding code equation for Relation.image; adding map_project as correspondence to map_filter on lists
bulwahn
parents:
46418
diff
changeset
|
6355 |
lemma [code]: |
b447318e5e1a
adding code equation for Relation.image; adding map_project as correspondence to map_filter on lists
bulwahn
parents:
46418
diff
changeset
|
6356 |
"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
|
6357 |
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
|
6358 |
|
46147
2c4d8de91c4c
moved lemmas about List.set and set operations to List theory
haftmann
parents:
46143
diff
changeset
|
6359 |
lemma trancl_set_ntrancl [code]: |
2c4d8de91c4c
moved lemmas about List.set and set operations to List theory
haftmann
parents:
46143
diff
changeset
|
6360 |
"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
|
6361 |
by (simp add: finite_trancl_ntranl) |
2c4d8de91c4c
moved lemmas about List.set and set operations to List theory
haftmann
parents:
46143
diff
changeset
|
6362 |
|
47433
07f4bf913230
renamed "rel_comp" to "relcomp" (to be consistent with, e.g., "relpow")
griff
parents:
47131
diff
changeset
|
6363 |
lemma set_relcomp [code]: |
46147
2c4d8de91c4c
moved lemmas about List.set and set operations to List theory
haftmann
parents:
46143
diff
changeset
|
6364 |
"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
|
6365 |
by (auto simp add: Bex_def) |
2c4d8de91c4c
moved lemmas about List.set and set operations to List theory
haftmann
parents:
46143
diff
changeset
|
6366 |
|
2c4d8de91c4c
moved lemmas about List.set and set operations to List theory
haftmann
parents:
46143
diff
changeset
|
6367 |
lemma wf_set [code]: |
2c4d8de91c4c
moved lemmas about List.set and set operations to List theory
haftmann
parents:
46143
diff
changeset
|
6368 |
"wf (set xs) = acyclic (set xs)" |
2c4d8de91c4c
moved lemmas about List.set and set operations to List theory
haftmann
parents:
46143
diff
changeset
|
6369 |
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
|
6370 |
|
53012
cb82606b8215
move Lifting/Transfer relevant parts of Library/Quotient_* to Main
kuncar
parents:
52435
diff
changeset
|
6371 |
subsection {* Setup for Lifting/Transfer *} |
cb82606b8215
move Lifting/Transfer relevant parts of Library/Quotient_* to Main
kuncar
parents:
52435
diff
changeset
|
6372 |
|
cb82606b8215
move Lifting/Transfer relevant parts of Library/Quotient_* to Main
kuncar
parents:
52435
diff
changeset
|
6373 |
subsubsection {* Relator and predicator properties *} |
cb82606b8215
move Lifting/Transfer relevant parts of Library/Quotient_* to Main
kuncar
parents:
52435
diff
changeset
|
6374 |
|
cb82606b8215
move Lifting/Transfer relevant parts of Library/Quotient_* to Main
kuncar
parents:
52435
diff
changeset
|
6375 |
lemma list_all2_eq'[relator_eq]: |
cb82606b8215
move Lifting/Transfer relevant parts of Library/Quotient_* to Main
kuncar
parents:
52435
diff
changeset
|
6376 |
"list_all2 (op =) = (op =)" |
cb82606b8215
move Lifting/Transfer relevant parts of Library/Quotient_* to Main
kuncar
parents:
52435
diff
changeset
|
6377 |
by (rule ext)+ (simp add: list_all2_eq) |
cb82606b8215
move Lifting/Transfer relevant parts of Library/Quotient_* to Main
kuncar
parents:
52435
diff
changeset
|
6378 |
|
cb82606b8215
move Lifting/Transfer relevant parts of Library/Quotient_* to Main
kuncar
parents:
52435
diff
changeset
|
6379 |
lemma list_all2_mono'[relator_mono]: |
cb82606b8215
move Lifting/Transfer relevant parts of Library/Quotient_* to Main
kuncar
parents:
52435
diff
changeset
|
6380 |
assumes "A \<le> B" |
cb82606b8215
move Lifting/Transfer relevant parts of Library/Quotient_* to Main
kuncar
parents:
52435
diff
changeset
|
6381 |
shows "(list_all2 A) \<le> (list_all2 B)" |
cb82606b8215
move Lifting/Transfer relevant parts of Library/Quotient_* to Main
kuncar
parents:
52435
diff
changeset
|
6382 |
using assms by (auto intro: list_all2_mono) |
cb82606b8215
move Lifting/Transfer relevant parts of Library/Quotient_* to Main
kuncar
parents:
52435
diff
changeset
|
6383 |
|
cb82606b8215
move Lifting/Transfer relevant parts of Library/Quotient_* to Main
kuncar
parents:
52435
diff
changeset
|
6384 |
lemma list_all2_OO[relator_distr]: "list_all2 A OO list_all2 B = list_all2 (A OO B)" |
cb82606b8215
move Lifting/Transfer relevant parts of Library/Quotient_* to Main
kuncar
parents:
52435
diff
changeset
|
6385 |
proof (intro ext iffI) |
cb82606b8215
move Lifting/Transfer relevant parts of Library/Quotient_* to Main
kuncar
parents:
52435
diff
changeset
|
6386 |
fix xs ys |
cb82606b8215
move Lifting/Transfer relevant parts of Library/Quotient_* to Main
kuncar
parents:
52435
diff
changeset
|
6387 |
assume "list_all2 (A OO B) xs ys" |
cb82606b8215
move Lifting/Transfer relevant parts of Library/Quotient_* to Main
kuncar
parents:
52435
diff
changeset
|
6388 |
thus "(list_all2 A OO list_all2 B) xs ys" |
cb82606b8215
move Lifting/Transfer relevant parts of Library/Quotient_* to Main
kuncar
parents:
52435
diff
changeset
|
6389 |
unfolding OO_def |
cb82606b8215
move Lifting/Transfer relevant parts of Library/Quotient_* to Main
kuncar
parents:
52435
diff
changeset
|
6390 |
by (induct, simp, simp add: list_all2_Cons1 list_all2_Cons2, fast) |
cb82606b8215
move Lifting/Transfer relevant parts of Library/Quotient_* to Main
kuncar
parents:
52435
diff
changeset
|
6391 |
next |
cb82606b8215
move Lifting/Transfer relevant parts of Library/Quotient_* to Main
kuncar
parents:
52435
diff
changeset
|
6392 |
fix xs ys |
cb82606b8215
move Lifting/Transfer relevant parts of Library/Quotient_* to Main
kuncar
parents:
52435
diff
changeset
|
6393 |
assume "(list_all2 A OO list_all2 B) xs ys" |
cb82606b8215
move Lifting/Transfer relevant parts of Library/Quotient_* to Main
kuncar
parents:
52435
diff
changeset
|
6394 |
then obtain zs where "list_all2 A xs zs" and "list_all2 B zs ys" .. |
cb82606b8215
move Lifting/Transfer relevant parts of Library/Quotient_* to Main
kuncar
parents:
52435
diff
changeset
|
6395 |
thus "list_all2 (A OO B) xs ys" |
cb82606b8215
move Lifting/Transfer relevant parts of Library/Quotient_* to Main
kuncar
parents:
52435
diff
changeset
|
6396 |
by (induct arbitrary: ys, simp, clarsimp simp add: list_all2_Cons1, fast) |
cb82606b8215
move Lifting/Transfer relevant parts of Library/Quotient_* to Main
kuncar
parents:
52435
diff
changeset
|
6397 |
qed |
cb82606b8215
move Lifting/Transfer relevant parts of Library/Quotient_* to Main
kuncar
parents:
52435
diff
changeset
|
6398 |
|
cb82606b8215
move Lifting/Transfer relevant parts of Library/Quotient_* to Main
kuncar
parents:
52435
diff
changeset
|
6399 |
lemma Domainp_list[relator_domain]: |
cb82606b8215
move Lifting/Transfer relevant parts of Library/Quotient_* to Main
kuncar
parents:
52435
diff
changeset
|
6400 |
assumes "Domainp A = P" |
cb82606b8215
move Lifting/Transfer relevant parts of Library/Quotient_* to Main
kuncar
parents:
52435
diff
changeset
|
6401 |
shows "Domainp (list_all2 A) = (list_all P)" |
cb82606b8215
move Lifting/Transfer relevant parts of Library/Quotient_* to Main
kuncar
parents:
52435
diff
changeset
|
6402 |
proof - |
cb82606b8215
move Lifting/Transfer relevant parts of Library/Quotient_* to Main
kuncar
parents:
52435
diff
changeset
|
6403 |
{ |
cb82606b8215
move Lifting/Transfer relevant parts of Library/Quotient_* to Main
kuncar
parents:
52435
diff
changeset
|
6404 |
fix x |
cb82606b8215
move Lifting/Transfer relevant parts of Library/Quotient_* to Main
kuncar
parents:
52435
diff
changeset
|
6405 |
have *: "\<And>x. (\<exists>y. A x y) = P x" using assms unfolding Domainp_iff by blast |
cb82606b8215
move Lifting/Transfer relevant parts of Library/Quotient_* to Main
kuncar
parents:
52435
diff
changeset
|
6406 |
have "(\<exists>y. (list_all2 A x y)) = list_all P x" |
cb82606b8215
move Lifting/Transfer relevant parts of Library/Quotient_* to Main
kuncar
parents:
52435
diff
changeset
|
6407 |
by (induction x) (simp_all add: * list_all2_Cons1) |
cb82606b8215
move Lifting/Transfer relevant parts of Library/Quotient_* to Main
kuncar
parents:
52435
diff
changeset
|
6408 |
} |
cb82606b8215
move Lifting/Transfer relevant parts of Library/Quotient_* to Main
kuncar
parents:
52435
diff
changeset
|
6409 |
then show ?thesis |
cb82606b8215
move Lifting/Transfer relevant parts of Library/Quotient_* to Main
kuncar
parents:
52435
diff
changeset
|
6410 |
unfolding Domainp_iff[abs_def] |
cb82606b8215
move Lifting/Transfer relevant parts of Library/Quotient_* to Main
kuncar
parents:
52435
diff
changeset
|
6411 |
by (auto iff: fun_eq_iff) |
cb82606b8215
move Lifting/Transfer relevant parts of Library/Quotient_* to Main
kuncar
parents:
52435
diff
changeset
|
6412 |
qed |
cb82606b8215
move Lifting/Transfer relevant parts of Library/Quotient_* to Main
kuncar
parents:
52435
diff
changeset
|
6413 |
|
cb82606b8215
move Lifting/Transfer relevant parts of Library/Quotient_* to Main
kuncar
parents:
52435
diff
changeset
|
6414 |
lemma reflp_list_all2[reflexivity_rule]: |
cb82606b8215
move Lifting/Transfer relevant parts of Library/Quotient_* to Main
kuncar
parents:
52435
diff
changeset
|
6415 |
assumes "reflp R" |
cb82606b8215
move Lifting/Transfer relevant parts of Library/Quotient_* to Main
kuncar
parents:
52435
diff
changeset
|
6416 |
shows "reflp (list_all2 R)" |
cb82606b8215
move Lifting/Transfer relevant parts of Library/Quotient_* to Main
kuncar
parents:
52435
diff
changeset
|
6417 |
proof (rule reflpI) |
cb82606b8215
move Lifting/Transfer relevant parts of Library/Quotient_* to Main
kuncar
parents:
52435
diff
changeset
|
6418 |
from assms have *: "\<And>xs. R xs xs" by (rule reflpE) |
cb82606b8215
move Lifting/Transfer relevant parts of Library/Quotient_* to Main
kuncar
parents:
52435
diff
changeset
|
6419 |
fix xs |
cb82606b8215
move Lifting/Transfer relevant parts of Library/Quotient_* to Main
kuncar
parents:
52435
diff
changeset
|
6420 |
show "list_all2 R xs xs" |
cb82606b8215
move Lifting/Transfer relevant parts of Library/Quotient_* to Main
kuncar
parents:
52435
diff
changeset
|
6421 |
by (induct xs) (simp_all add: *) |
cb82606b8215
move Lifting/Transfer relevant parts of Library/Quotient_* to Main
kuncar
parents:
52435
diff
changeset
|
6422 |
qed |
cb82606b8215
move Lifting/Transfer relevant parts of Library/Quotient_* to Main
kuncar
parents:
52435
diff
changeset
|
6423 |
|
cb82606b8215
move Lifting/Transfer relevant parts of Library/Quotient_* to Main
kuncar
parents:
52435
diff
changeset
|
6424 |
lemma left_total_list_all2[reflexivity_rule]: |
cb82606b8215
move Lifting/Transfer relevant parts of Library/Quotient_* to Main
kuncar
parents:
52435
diff
changeset
|
6425 |
"left_total R \<Longrightarrow> left_total (list_all2 R)" |
cb82606b8215
move Lifting/Transfer relevant parts of Library/Quotient_* to Main
kuncar
parents:
52435
diff
changeset
|
6426 |
unfolding left_total_def |
cb82606b8215
move Lifting/Transfer relevant parts of Library/Quotient_* to Main
kuncar
parents:
52435
diff
changeset
|
6427 |
apply safe |
cb82606b8215
move Lifting/Transfer relevant parts of Library/Quotient_* to Main
kuncar
parents:
52435
diff
changeset
|
6428 |
apply (rename_tac xs, induct_tac xs, simp, simp add: list_all2_Cons1) |
cb82606b8215
move Lifting/Transfer relevant parts of Library/Quotient_* to Main
kuncar
parents:
52435
diff
changeset
|
6429 |
done |
cb82606b8215
move Lifting/Transfer relevant parts of Library/Quotient_* to Main
kuncar
parents:
52435
diff
changeset
|
6430 |
|
cb82606b8215
move Lifting/Transfer relevant parts of Library/Quotient_* to Main
kuncar
parents:
52435
diff
changeset
|
6431 |
lemma left_unique_list_all2 [reflexivity_rule]: |
cb82606b8215
move Lifting/Transfer relevant parts of Library/Quotient_* to Main
kuncar
parents:
52435
diff
changeset
|
6432 |
"left_unique R \<Longrightarrow> left_unique (list_all2 R)" |
cb82606b8215
move Lifting/Transfer relevant parts of Library/Quotient_* to Main
kuncar
parents:
52435
diff
changeset
|
6433 |
unfolding left_unique_def |
cb82606b8215
move Lifting/Transfer relevant parts of Library/Quotient_* to Main
kuncar
parents:
52435
diff
changeset
|
6434 |
apply (subst (2) all_comm, subst (1) all_comm) |
cb82606b8215
move Lifting/Transfer relevant parts of Library/Quotient_* to Main
kuncar
parents:
52435
diff
changeset
|
6435 |
apply (rule allI, rename_tac zs, induct_tac zs) |
cb82606b8215
move Lifting/Transfer relevant parts of Library/Quotient_* to Main
kuncar
parents:
52435
diff
changeset
|
6436 |
apply (auto simp add: list_all2_Cons2) |
cb82606b8215
move Lifting/Transfer relevant parts of Library/Quotient_* to Main
kuncar
parents:
52435
diff
changeset
|
6437 |
done |
cb82606b8215
move Lifting/Transfer relevant parts of Library/Quotient_* to Main
kuncar
parents:
52435
diff
changeset
|
6438 |
|
cb82606b8215
move Lifting/Transfer relevant parts of Library/Quotient_* to Main
kuncar
parents:
52435
diff
changeset
|
6439 |
lemma right_total_list_all2 [transfer_rule]: |
cb82606b8215
move Lifting/Transfer relevant parts of Library/Quotient_* to Main
kuncar
parents:
52435
diff
changeset
|
6440 |
"right_total R \<Longrightarrow> right_total (list_all2 R)" |
cb82606b8215
move Lifting/Transfer relevant parts of Library/Quotient_* to Main
kuncar
parents:
52435
diff
changeset
|
6441 |
unfolding right_total_def |
cb82606b8215
move Lifting/Transfer relevant parts of Library/Quotient_* to Main
kuncar
parents:
52435
diff
changeset
|
6442 |
by (rule allI, induct_tac y, simp, simp add: list_all2_Cons2) |
cb82606b8215
move Lifting/Transfer relevant parts of Library/Quotient_* to Main
kuncar
parents:
52435
diff
changeset
|
6443 |
|
cb82606b8215
move Lifting/Transfer relevant parts of Library/Quotient_* to Main
kuncar
parents:
52435
diff
changeset
|
6444 |
lemma right_unique_list_all2 [transfer_rule]: |
cb82606b8215
move Lifting/Transfer relevant parts of Library/Quotient_* to Main
kuncar
parents:
52435
diff
changeset
|
6445 |
"right_unique R \<Longrightarrow> right_unique (list_all2 R)" |
cb82606b8215
move Lifting/Transfer relevant parts of Library/Quotient_* to Main
kuncar
parents:
52435
diff
changeset
|
6446 |
unfolding right_unique_def |
cb82606b8215
move Lifting/Transfer relevant parts of Library/Quotient_* to Main
kuncar
parents:
52435
diff
changeset
|
6447 |
apply (rule allI, rename_tac xs, induct_tac xs) |
cb82606b8215
move Lifting/Transfer relevant parts of Library/Quotient_* to Main
kuncar
parents:
52435
diff
changeset
|
6448 |
apply (auto simp add: list_all2_Cons1) |
cb82606b8215
move Lifting/Transfer relevant parts of Library/Quotient_* to Main
kuncar
parents:
52435
diff
changeset
|
6449 |
done |
cb82606b8215
move Lifting/Transfer relevant parts of Library/Quotient_* to Main
kuncar
parents:
52435
diff
changeset
|
6450 |
|
cb82606b8215
move Lifting/Transfer relevant parts of Library/Quotient_* to Main
kuncar
parents:
52435
diff
changeset
|
6451 |
lemma bi_total_list_all2 [transfer_rule]: |
cb82606b8215
move Lifting/Transfer relevant parts of Library/Quotient_* to Main
kuncar
parents:
52435
diff
changeset
|
6452 |
"bi_total A \<Longrightarrow> bi_total (list_all2 A)" |
cb82606b8215
move Lifting/Transfer relevant parts of Library/Quotient_* to Main
kuncar
parents:
52435
diff
changeset
|
6453 |
unfolding bi_total_def |
cb82606b8215
move Lifting/Transfer relevant parts of Library/Quotient_* to Main
kuncar
parents:
52435
diff
changeset
|
6454 |
apply safe |
cb82606b8215
move Lifting/Transfer relevant parts of Library/Quotient_* to Main
kuncar
parents:
52435
diff
changeset
|
6455 |
apply (rename_tac xs, induct_tac xs, simp, simp add: list_all2_Cons1) |
cb82606b8215
move Lifting/Transfer relevant parts of Library/Quotient_* to Main
kuncar
parents:
52435
diff
changeset
|
6456 |
apply (rename_tac ys, induct_tac ys, simp, simp add: list_all2_Cons2) |
cb82606b8215
move Lifting/Transfer relevant parts of Library/Quotient_* to Main
kuncar
parents:
52435
diff
changeset
|
6457 |
done |
cb82606b8215
move Lifting/Transfer relevant parts of Library/Quotient_* to Main
kuncar
parents:
52435
diff
changeset
|
6458 |
|
cb82606b8215
move Lifting/Transfer relevant parts of Library/Quotient_* to Main
kuncar
parents:
52435
diff
changeset
|
6459 |
lemma bi_unique_list_all2 [transfer_rule]: |
cb82606b8215
move Lifting/Transfer relevant parts of Library/Quotient_* to Main
kuncar
parents:
52435
diff
changeset
|
6460 |
"bi_unique A \<Longrightarrow> bi_unique (list_all2 A)" |
cb82606b8215
move Lifting/Transfer relevant parts of Library/Quotient_* to Main
kuncar
parents:
52435
diff
changeset
|
6461 |
unfolding bi_unique_def |
cb82606b8215
move Lifting/Transfer relevant parts of Library/Quotient_* to Main
kuncar
parents:
52435
diff
changeset
|
6462 |
apply (rule conjI) |
cb82606b8215
move Lifting/Transfer relevant parts of Library/Quotient_* to Main
kuncar
parents:
52435
diff
changeset
|
6463 |
apply (rule allI, rename_tac xs, induct_tac xs) |
cb82606b8215
move Lifting/Transfer relevant parts of Library/Quotient_* to Main
kuncar
parents:
52435
diff
changeset
|
6464 |
apply (simp, force simp add: list_all2_Cons1) |
cb82606b8215
move Lifting/Transfer relevant parts of Library/Quotient_* to Main
kuncar
parents:
52435
diff
changeset
|
6465 |
apply (subst (2) all_comm, subst (1) all_comm) |
cb82606b8215
move Lifting/Transfer relevant parts of Library/Quotient_* to Main
kuncar
parents:
52435
diff
changeset
|
6466 |
apply (rule allI, rename_tac xs, induct_tac xs) |
cb82606b8215
move Lifting/Transfer relevant parts of Library/Quotient_* to Main
kuncar
parents:
52435
diff
changeset
|
6467 |
apply (simp, force simp add: list_all2_Cons2) |
cb82606b8215
move Lifting/Transfer relevant parts of Library/Quotient_* to Main
kuncar
parents:
52435
diff
changeset
|
6468 |
done |
cb82606b8215
move Lifting/Transfer relevant parts of Library/Quotient_* to Main
kuncar
parents:
52435
diff
changeset
|
6469 |
|
cb82606b8215
move Lifting/Transfer relevant parts of Library/Quotient_* to Main
kuncar
parents:
52435
diff
changeset
|
6470 |
lemma list_invariant_commute [invariant_commute]: |
cb82606b8215
move Lifting/Transfer relevant parts of Library/Quotient_* to Main
kuncar
parents:
52435
diff
changeset
|
6471 |
"list_all2 (Lifting.invariant P) = Lifting.invariant (list_all P)" |
cb82606b8215
move Lifting/Transfer relevant parts of Library/Quotient_* to Main
kuncar
parents:
52435
diff
changeset
|
6472 |
apply (simp add: fun_eq_iff list_all2_def list_all_iff Lifting.invariant_def Ball_def) |
cb82606b8215
move Lifting/Transfer relevant parts of Library/Quotient_* to Main
kuncar
parents:
52435
diff
changeset
|
6473 |
apply (intro allI) |
cb82606b8215
move Lifting/Transfer relevant parts of Library/Quotient_* to Main
kuncar
parents:
52435
diff
changeset
|
6474 |
apply (induct_tac rule: list_induct2') |
cb82606b8215
move Lifting/Transfer relevant parts of Library/Quotient_* to Main
kuncar
parents:
52435
diff
changeset
|
6475 |
apply simp_all |
cb82606b8215
move Lifting/Transfer relevant parts of Library/Quotient_* to Main
kuncar
parents:
52435
diff
changeset
|
6476 |
apply fastforce |
cb82606b8215
move Lifting/Transfer relevant parts of Library/Quotient_* to Main
kuncar
parents:
52435
diff
changeset
|
6477 |
done |
cb82606b8215
move Lifting/Transfer relevant parts of Library/Quotient_* to Main
kuncar
parents:
52435
diff
changeset
|
6478 |
|
cb82606b8215
move Lifting/Transfer relevant parts of Library/Quotient_* to Main
kuncar
parents:
52435
diff
changeset
|
6479 |
subsubsection {* Quotient theorem for the Lifting package *} |
cb82606b8215
move Lifting/Transfer relevant parts of Library/Quotient_* to Main
kuncar
parents:
52435
diff
changeset
|
6480 |
|
cb82606b8215
move Lifting/Transfer relevant parts of Library/Quotient_* to Main
kuncar
parents:
52435
diff
changeset
|
6481 |
lemma Quotient_list[quot_map]: |
cb82606b8215
move Lifting/Transfer relevant parts of Library/Quotient_* to Main
kuncar
parents:
52435
diff
changeset
|
6482 |
assumes "Quotient R Abs Rep T" |
cb82606b8215
move Lifting/Transfer relevant parts of Library/Quotient_* to Main
kuncar
parents:
52435
diff
changeset
|
6483 |
shows "Quotient (list_all2 R) (map Abs) (map Rep) (list_all2 T)" |
cb82606b8215
move Lifting/Transfer relevant parts of Library/Quotient_* to Main
kuncar
parents:
52435
diff
changeset
|
6484 |
proof (unfold Quotient_alt_def, intro conjI allI impI) |
cb82606b8215
move Lifting/Transfer relevant parts of Library/Quotient_* to Main
kuncar
parents:
52435
diff
changeset
|
6485 |
from assms have 1: "\<And>x y. T x y \<Longrightarrow> Abs x = y" |
cb82606b8215
move Lifting/Transfer relevant parts of Library/Quotient_* to Main
kuncar
parents:
52435
diff
changeset
|
6486 |
unfolding Quotient_alt_def by simp |
cb82606b8215
move Lifting/Transfer relevant parts of Library/Quotient_* to Main
kuncar
parents:
52435
diff
changeset
|
6487 |
fix xs ys assume "list_all2 T xs ys" thus "map Abs xs = ys" |
cb82606b8215
move Lifting/Transfer relevant parts of Library/Quotient_* to Main
kuncar
parents:
52435
diff
changeset
|
6488 |
by (induct, simp, simp add: 1) |
cb82606b8215
move Lifting/Transfer relevant parts of Library/Quotient_* to Main
kuncar
parents:
52435
diff
changeset
|
6489 |
next |
cb82606b8215
move Lifting/Transfer relevant parts of Library/Quotient_* to Main
kuncar
parents:
52435
diff
changeset
|
6490 |
from assms have 2: "\<And>x. T (Rep x) x" |
cb82606b8215
move Lifting/Transfer relevant parts of Library/Quotient_* to Main
kuncar
parents:
52435
diff
changeset
|
6491 |
unfolding Quotient_alt_def by simp |
cb82606b8215
move Lifting/Transfer relevant parts of Library/Quotient_* to Main
kuncar
parents:
52435
diff
changeset
|
6492 |
fix xs show "list_all2 T (map Rep xs) xs" |
cb82606b8215
move Lifting/Transfer relevant parts of Library/Quotient_* to Main
kuncar
parents:
52435
diff
changeset
|
6493 |
by (induct xs, simp, simp add: 2) |
cb82606b8215
move Lifting/Transfer relevant parts of Library/Quotient_* to Main
kuncar
parents:
52435
diff
changeset
|
6494 |
next |
cb82606b8215
move Lifting/Transfer relevant parts of Library/Quotient_* to Main
kuncar
parents:
52435
diff
changeset
|
6495 |
from assms have 3: "\<And>x y. R x y \<longleftrightarrow> T x (Abs x) \<and> T y (Abs y) \<and> Abs x = Abs y" |
cb82606b8215
move Lifting/Transfer relevant parts of Library/Quotient_* to Main
kuncar
parents:
52435
diff
changeset
|
6496 |
unfolding Quotient_alt_def by simp |
cb82606b8215
move Lifting/Transfer relevant parts of Library/Quotient_* to Main
kuncar
parents:
52435
diff
changeset
|
6497 |
fix xs ys show "list_all2 R xs ys \<longleftrightarrow> list_all2 T xs (map Abs xs) \<and> |
cb82606b8215
move Lifting/Transfer relevant parts of Library/Quotient_* to Main
kuncar
parents:
52435
diff
changeset
|
6498 |
list_all2 T ys (map Abs ys) \<and> map Abs xs = map Abs ys" |
cb82606b8215
move Lifting/Transfer relevant parts of Library/Quotient_* to Main
kuncar
parents:
52435
diff
changeset
|
6499 |
by (induct xs ys rule: list_induct2', simp_all, metis 3) |
cb82606b8215
move Lifting/Transfer relevant parts of Library/Quotient_* to Main
kuncar
parents:
52435
diff
changeset
|
6500 |
qed |
cb82606b8215
move Lifting/Transfer relevant parts of Library/Quotient_* to Main
kuncar
parents:
52435
diff
changeset
|
6501 |
|
cb82606b8215
move Lifting/Transfer relevant parts of Library/Quotient_* to Main
kuncar
parents:
52435
diff
changeset
|
6502 |
subsubsection {* Transfer rules for the Transfer package *} |
cb82606b8215
move Lifting/Transfer relevant parts of Library/Quotient_* to Main
kuncar
parents:
52435
diff
changeset
|
6503 |
|
cb82606b8215
move Lifting/Transfer relevant parts of Library/Quotient_* to Main
kuncar
parents:
52435
diff
changeset
|
6504 |
context |
cb82606b8215
move Lifting/Transfer relevant parts of Library/Quotient_* to Main
kuncar
parents:
52435
diff
changeset
|
6505 |
begin |
cb82606b8215
move Lifting/Transfer relevant parts of Library/Quotient_* to Main
kuncar
parents:
52435
diff
changeset
|
6506 |
interpretation lifting_syntax . |
cb82606b8215
move Lifting/Transfer relevant parts of Library/Quotient_* to Main
kuncar
parents:
52435
diff
changeset
|
6507 |
|
cb82606b8215
move Lifting/Transfer relevant parts of Library/Quotient_* to Main
kuncar
parents:
52435
diff
changeset
|
6508 |
lemma Nil_transfer [transfer_rule]: "(list_all2 A) [] []" |
cb82606b8215
move Lifting/Transfer relevant parts of Library/Quotient_* to Main
kuncar
parents:
52435
diff
changeset
|
6509 |
by simp |
cb82606b8215
move Lifting/Transfer relevant parts of Library/Quotient_* to Main
kuncar
parents:
52435
diff
changeset
|
6510 |
|
cb82606b8215
move Lifting/Transfer relevant parts of Library/Quotient_* to Main
kuncar
parents:
52435
diff
changeset
|
6511 |
lemma Cons_transfer [transfer_rule]: |
cb82606b8215
move Lifting/Transfer relevant parts of Library/Quotient_* to Main
kuncar
parents:
52435
diff
changeset
|
6512 |
"(A ===> list_all2 A ===> list_all2 A) Cons Cons" |
cb82606b8215
move Lifting/Transfer relevant parts of Library/Quotient_* to Main
kuncar
parents:
52435
diff
changeset
|
6513 |
unfolding fun_rel_def by simp |
cb82606b8215
move Lifting/Transfer relevant parts of Library/Quotient_* to Main
kuncar
parents:
52435
diff
changeset
|
6514 |
|
cb82606b8215
move Lifting/Transfer relevant parts of Library/Quotient_* to Main
kuncar
parents:
52435
diff
changeset
|
6515 |
lemma list_case_transfer [transfer_rule]: |
cb82606b8215
move Lifting/Transfer relevant parts of Library/Quotient_* to Main
kuncar
parents:
52435
diff
changeset
|
6516 |
"(B ===> (A ===> list_all2 A ===> B) ===> list_all2 A ===> B) |
cb82606b8215
move Lifting/Transfer relevant parts of Library/Quotient_* to Main
kuncar
parents:
52435
diff
changeset
|
6517 |
list_case list_case" |
cb82606b8215
move Lifting/Transfer relevant parts of Library/Quotient_* to Main
kuncar
parents:
52435
diff
changeset
|
6518 |
unfolding fun_rel_def by (simp split: list.split) |
cb82606b8215
move Lifting/Transfer relevant parts of Library/Quotient_* to Main
kuncar
parents:
52435
diff
changeset
|
6519 |
|
cb82606b8215
move Lifting/Transfer relevant parts of Library/Quotient_* to Main
kuncar
parents:
52435
diff
changeset
|
6520 |
lemma list_rec_transfer [transfer_rule]: |
cb82606b8215
move Lifting/Transfer relevant parts of Library/Quotient_* to Main
kuncar
parents:
52435
diff
changeset
|
6521 |
"(B ===> (A ===> list_all2 A ===> B ===> B) ===> list_all2 A ===> B) |
cb82606b8215
move Lifting/Transfer relevant parts of Library/Quotient_* to Main
kuncar
parents:
52435
diff
changeset
|
6522 |
list_rec list_rec" |
cb82606b8215
move Lifting/Transfer relevant parts of Library/Quotient_* to Main
kuncar
parents:
52435
diff
changeset
|
6523 |
unfolding fun_rel_def by (clarify, erule list_all2_induct, simp_all) |
cb82606b8215
move Lifting/Transfer relevant parts of Library/Quotient_* to Main
kuncar
parents:
52435
diff
changeset
|
6524 |
|
cb82606b8215
move Lifting/Transfer relevant parts of Library/Quotient_* to Main
kuncar
parents:
52435
diff
changeset
|
6525 |
lemma tl_transfer [transfer_rule]: |
cb82606b8215
move Lifting/Transfer relevant parts of Library/Quotient_* to Main
kuncar
parents:
52435
diff
changeset
|
6526 |
"(list_all2 A ===> list_all2 A) tl tl" |
cb82606b8215
move Lifting/Transfer relevant parts of Library/Quotient_* to Main
kuncar
parents:
52435
diff
changeset
|
6527 |
unfolding tl_def by transfer_prover |
cb82606b8215
move Lifting/Transfer relevant parts of Library/Quotient_* to Main
kuncar
parents:
52435
diff
changeset
|
6528 |
|
cb82606b8215
move Lifting/Transfer relevant parts of Library/Quotient_* to Main
kuncar
parents:
52435
diff
changeset
|
6529 |
lemma butlast_transfer [transfer_rule]: |
cb82606b8215
move Lifting/Transfer relevant parts of Library/Quotient_* to Main
kuncar
parents:
52435
diff
changeset
|
6530 |
"(list_all2 A ===> list_all2 A) butlast butlast" |
cb82606b8215
move Lifting/Transfer relevant parts of Library/Quotient_* to Main
kuncar
parents:
52435
diff
changeset
|
6531 |
by (rule fun_relI, erule list_all2_induct, auto) |
cb82606b8215
move Lifting/Transfer relevant parts of Library/Quotient_* to Main
kuncar
parents:
52435
diff
changeset
|
6532 |
|
cb82606b8215
move Lifting/Transfer relevant parts of Library/Quotient_* to Main
kuncar
parents:
52435
diff
changeset
|
6533 |
lemma set_transfer [transfer_rule]: |
cb82606b8215
move Lifting/Transfer relevant parts of Library/Quotient_* to Main
kuncar
parents:
52435
diff
changeset
|
6534 |
"(list_all2 A ===> set_rel A) set set" |
cb82606b8215
move Lifting/Transfer relevant parts of Library/Quotient_* to Main
kuncar
parents:
52435
diff
changeset
|
6535 |
unfolding set_def by transfer_prover |
cb82606b8215
move Lifting/Transfer relevant parts of Library/Quotient_* to Main
kuncar
parents:
52435
diff
changeset
|
6536 |
|
cb82606b8215
move Lifting/Transfer relevant parts of Library/Quotient_* to Main
kuncar
parents:
52435
diff
changeset
|
6537 |
lemma map_transfer [transfer_rule]: |
cb82606b8215
move Lifting/Transfer relevant parts of Library/Quotient_* to Main
kuncar
parents:
52435
diff
changeset
|
6538 |
"((A ===> B) ===> list_all2 A ===> list_all2 B) map map" |
cb82606b8215
move Lifting/Transfer relevant parts of Library/Quotient_* to Main
kuncar
parents:
52435
diff
changeset
|
6539 |
unfolding List.map_def by transfer_prover |
cb82606b8215
move Lifting/Transfer relevant parts of Library/Quotient_* to Main
kuncar
parents:
52435
diff
changeset
|
6540 |
|
cb82606b8215
move Lifting/Transfer relevant parts of Library/Quotient_* to Main
kuncar
parents:
52435
diff
changeset
|
6541 |
lemma append_transfer [transfer_rule]: |
cb82606b8215
move Lifting/Transfer relevant parts of Library/Quotient_* to Main
kuncar
parents:
52435
diff
changeset
|
6542 |
"(list_all2 A ===> list_all2 A ===> list_all2 A) append append" |
cb82606b8215
move Lifting/Transfer relevant parts of Library/Quotient_* to Main
kuncar
parents:
52435
diff
changeset
|
6543 |
unfolding List.append_def by transfer_prover |
cb82606b8215
move Lifting/Transfer relevant parts of Library/Quotient_* to Main
kuncar
parents:
52435
diff
changeset
|
6544 |
|
cb82606b8215
move Lifting/Transfer relevant parts of Library/Quotient_* to Main
kuncar
parents:
52435
diff
changeset
|
6545 |
lemma rev_transfer [transfer_rule]: |
cb82606b8215
move Lifting/Transfer relevant parts of Library/Quotient_* to Main
kuncar
parents:
52435
diff
changeset
|
6546 |
"(list_all2 A ===> list_all2 A) rev rev" |
cb82606b8215
move Lifting/Transfer relevant parts of Library/Quotient_* to Main
kuncar
parents:
52435
diff
changeset
|
6547 |
unfolding List.rev_def by transfer_prover |
cb82606b8215
move Lifting/Transfer relevant parts of Library/Quotient_* to Main
kuncar
parents:
52435
diff
changeset
|
6548 |
|
cb82606b8215
move Lifting/Transfer relevant parts of Library/Quotient_* to Main
kuncar
parents:
52435
diff
changeset
|
6549 |
lemma filter_transfer [transfer_rule]: |
cb82606b8215
move Lifting/Transfer relevant parts of Library/Quotient_* to Main
kuncar
parents:
52435
diff
changeset
|
6550 |
"((A ===> op =) ===> list_all2 A ===> list_all2 A) filter filter" |
cb82606b8215
move Lifting/Transfer relevant parts of Library/Quotient_* to Main
kuncar
parents:
52435
diff
changeset
|
6551 |
unfolding List.filter_def by transfer_prover |
cb82606b8215
move Lifting/Transfer relevant parts of Library/Quotient_* to Main
kuncar
parents:
52435
diff
changeset
|
6552 |
|
cb82606b8215
move Lifting/Transfer relevant parts of Library/Quotient_* to Main
kuncar
parents:
52435
diff
changeset
|
6553 |
lemma fold_transfer [transfer_rule]: |
cb82606b8215
move Lifting/Transfer relevant parts of Library/Quotient_* to Main
kuncar
parents:
52435
diff
changeset
|
6554 |
"((A ===> B ===> B) ===> list_all2 A ===> B ===> B) fold fold" |
cb82606b8215
move Lifting/Transfer relevant parts of Library/Quotient_* to Main
kuncar
parents:
52435
diff
changeset
|
6555 |
unfolding List.fold_def by transfer_prover |
cb82606b8215
move Lifting/Transfer relevant parts of Library/Quotient_* to Main
kuncar
parents:
52435
diff
changeset
|
6556 |
|
cb82606b8215
move Lifting/Transfer relevant parts of Library/Quotient_* to Main
kuncar
parents:
52435
diff
changeset
|
6557 |
lemma foldr_transfer [transfer_rule]: |
cb82606b8215
move Lifting/Transfer relevant parts of Library/Quotient_* to Main
kuncar
parents:
52435
diff
changeset
|
6558 |
"((A ===> B ===> B) ===> list_all2 A ===> B ===> B) foldr foldr" |
cb82606b8215
move Lifting/Transfer relevant parts of Library/Quotient_* to Main
kuncar
parents:
52435
diff
changeset
|
6559 |
unfolding List.foldr_def by transfer_prover |
cb82606b8215
move Lifting/Transfer relevant parts of Library/Quotient_* to Main
kuncar
parents:
52435
diff
changeset
|
6560 |
|
cb82606b8215
move Lifting/Transfer relevant parts of Library/Quotient_* to Main
kuncar
parents:
52435
diff
changeset
|
6561 |
lemma foldl_transfer [transfer_rule]: |
cb82606b8215
move Lifting/Transfer relevant parts of Library/Quotient_* to Main
kuncar
parents:
52435
diff
changeset
|
6562 |
"((B ===> A ===> B) ===> B ===> list_all2 A ===> B) foldl foldl" |
cb82606b8215
move Lifting/Transfer relevant parts of Library/Quotient_* to Main
kuncar
parents:
52435
diff
changeset
|
6563 |
unfolding List.foldl_def by transfer_prover |
cb82606b8215
move Lifting/Transfer relevant parts of Library/Quotient_* to Main
kuncar
parents:
52435
diff
changeset
|
6564 |
|
cb82606b8215
move Lifting/Transfer relevant parts of Library/Quotient_* to Main
kuncar
parents:
52435
diff
changeset
|
6565 |
lemma concat_transfer [transfer_rule]: |
cb82606b8215
move Lifting/Transfer relevant parts of Library/Quotient_* to Main
kuncar
parents:
52435
diff
changeset
|
6566 |
"(list_all2 (list_all2 A) ===> list_all2 A) concat concat" |
cb82606b8215
move Lifting/Transfer relevant parts of Library/Quotient_* to Main
kuncar
parents:
52435
diff
changeset
|
6567 |
unfolding List.concat_def by transfer_prover |
cb82606b8215
move Lifting/Transfer relevant parts of Library/Quotient_* to Main
kuncar
parents:
52435
diff
changeset
|
6568 |
|
cb82606b8215
move Lifting/Transfer relevant parts of Library/Quotient_* to Main
kuncar
parents:
52435
diff
changeset
|
6569 |
lemma drop_transfer [transfer_rule]: |
cb82606b8215
move Lifting/Transfer relevant parts of Library/Quotient_* to Main
kuncar
parents:
52435
diff
changeset
|
6570 |
"(op = ===> list_all2 A ===> list_all2 A) drop drop" |
cb82606b8215
move Lifting/Transfer relevant parts of Library/Quotient_* to Main
kuncar
parents:
52435
diff
changeset
|
6571 |
unfolding List.drop_def by transfer_prover |
cb82606b8215
move Lifting/Transfer relevant parts of Library/Quotient_* to Main
kuncar
parents:
52435
diff
changeset
|
6572 |
|
cb82606b8215
move Lifting/Transfer relevant parts of Library/Quotient_* to Main
kuncar
parents:
52435
diff
changeset
|
6573 |
lemma take_transfer [transfer_rule]: |
cb82606b8215
move Lifting/Transfer relevant parts of Library/Quotient_* to Main
kuncar
parents:
52435
diff
changeset
|
6574 |
"(op = ===> list_all2 A ===> list_all2 A) take take" |
cb82606b8215
move Lifting/Transfer relevant parts of Library/Quotient_* to Main
kuncar
parents:
52435
diff
changeset
|
6575 |
unfolding List.take_def by transfer_prover |
cb82606b8215
move Lifting/Transfer relevant parts of Library/Quotient_* to Main
kuncar
parents:
52435
diff
changeset
|
6576 |
|
cb82606b8215
move Lifting/Transfer relevant parts of Library/Quotient_* to Main
kuncar
parents:
52435
diff
changeset
|
6577 |
lemma list_update_transfer [transfer_rule]: |
cb82606b8215
move Lifting/Transfer relevant parts of Library/Quotient_* to Main
kuncar
parents:
52435
diff
changeset
|
6578 |
"(list_all2 A ===> op = ===> A ===> list_all2 A) list_update list_update" |
cb82606b8215
move Lifting/Transfer relevant parts of Library/Quotient_* to Main
kuncar
parents:
52435
diff
changeset
|
6579 |
unfolding list_update_def by transfer_prover |
cb82606b8215
move Lifting/Transfer relevant parts of Library/Quotient_* to Main
kuncar
parents:
52435
diff
changeset
|
6580 |
|
cb82606b8215
move Lifting/Transfer relevant parts of Library/Quotient_* to Main
kuncar
parents:
52435
diff
changeset
|
6581 |
lemma takeWhile_transfer [transfer_rule]: |
cb82606b8215
move Lifting/Transfer relevant parts of Library/Quotient_* to Main
kuncar
parents:
52435
diff
changeset
|
6582 |
"((A ===> op =) ===> list_all2 A ===> list_all2 A) takeWhile takeWhile" |
cb82606b8215
move Lifting/Transfer relevant parts of Library/Quotient_* to Main
kuncar
parents:
52435
diff
changeset
|
6583 |
unfolding takeWhile_def by transfer_prover |
cb82606b8215
move Lifting/Transfer relevant parts of Library/Quotient_* to Main
kuncar
parents:
52435
diff
changeset
|
6584 |
|
cb82606b8215
move Lifting/Transfer relevant parts of Library/Quotient_* to Main
kuncar
parents:
52435
diff
changeset
|
6585 |
lemma dropWhile_transfer [transfer_rule]: |
cb82606b8215
move Lifting/Transfer relevant parts of Library/Quotient_* to Main
kuncar
parents:
52435
diff
changeset
|
6586 |
"((A ===> op =) ===> list_all2 A ===> list_all2 A) dropWhile dropWhile" |
cb82606b8215
move Lifting/Transfer relevant parts of Library/Quotient_* to Main
kuncar
parents:
52435
diff
changeset
|
6587 |
unfolding dropWhile_def by transfer_prover |
cb82606b8215
move Lifting/Transfer relevant parts of Library/Quotient_* to Main
kuncar
parents:
52435
diff
changeset
|
6588 |
|
cb82606b8215
move Lifting/Transfer relevant parts of Library/Quotient_* to Main
kuncar
parents:
52435
diff
changeset
|
6589 |
lemma zip_transfer [transfer_rule]: |
cb82606b8215
move Lifting/Transfer relevant parts of Library/Quotient_* to Main
kuncar
parents:
52435
diff
changeset
|
6590 |
"(list_all2 A ===> list_all2 B ===> list_all2 (prod_rel A B)) zip zip" |
cb82606b8215
move Lifting/Transfer relevant parts of Library/Quotient_* to Main
kuncar
parents:
52435
diff
changeset
|
6591 |
unfolding zip_def by transfer_prover |
cb82606b8215
move Lifting/Transfer relevant parts of Library/Quotient_* to Main
kuncar
parents:
52435
diff
changeset
|
6592 |
|
53721
ccaceea6c768
added two functions to List (one contributed by Manuel Eberl)
traytel
parents:
53689
diff
changeset
|
6593 |
lemma product_transfer [transfer_rule]: |
ccaceea6c768
added two functions to List (one contributed by Manuel Eberl)
traytel
parents:
53689
diff
changeset
|
6594 |
"(list_all2 A ===> list_all2 B ===> list_all2 (prod_rel A B)) List.product List.product" |
ccaceea6c768
added two functions to List (one contributed by Manuel Eberl)
traytel
parents:
53689
diff
changeset
|
6595 |
unfolding List.product_def by transfer_prover |
ccaceea6c768
added two functions to List (one contributed by Manuel Eberl)
traytel
parents:
53689
diff
changeset
|
6596 |
|
ccaceea6c768
added two functions to List (one contributed by Manuel Eberl)
traytel
parents:
53689
diff
changeset
|
6597 |
lemma product_lists_transfer [transfer_rule]: |
ccaceea6c768
added two functions to List (one contributed by Manuel Eberl)
traytel
parents:
53689
diff
changeset
|
6598 |
"(list_all2 (list_all2 A) ===> list_all2 (list_all2 A)) product_lists product_lists" |
ccaceea6c768
added two functions to List (one contributed by Manuel Eberl)
traytel
parents:
53689
diff
changeset
|
6599 |
unfolding product_lists_def by transfer_prover |
ccaceea6c768
added two functions to List (one contributed by Manuel Eberl)
traytel
parents:
53689
diff
changeset
|
6600 |
|
53012
cb82606b8215
move Lifting/Transfer relevant parts of Library/Quotient_* to Main
kuncar
parents:
52435
diff
changeset
|
6601 |
lemma insert_transfer [transfer_rule]: |
cb82606b8215
move Lifting/Transfer relevant parts of Library/Quotient_* to Main
kuncar
parents:
52435
diff
changeset
|
6602 |
assumes [transfer_rule]: "bi_unique A" |
cb82606b8215
move Lifting/Transfer relevant parts of Library/Quotient_* to Main
kuncar
parents:
52435
diff
changeset
|
6603 |
shows "(A ===> list_all2 A ===> list_all2 A) List.insert List.insert" |
cb82606b8215
move Lifting/Transfer relevant parts of Library/Quotient_* to Main
kuncar
parents:
52435
diff
changeset
|
6604 |
unfolding List.insert_def [abs_def] by transfer_prover |
cb82606b8215
move Lifting/Transfer relevant parts of Library/Quotient_* to Main
kuncar
parents:
52435
diff
changeset
|
6605 |
|
cb82606b8215
move Lifting/Transfer relevant parts of Library/Quotient_* to Main
kuncar
parents:
52435
diff
changeset
|
6606 |
lemma find_transfer [transfer_rule]: |
cb82606b8215
move Lifting/Transfer relevant parts of Library/Quotient_* to Main
kuncar
parents:
52435
diff
changeset
|
6607 |
"((A ===> op =) ===> list_all2 A ===> option_rel A) List.find List.find" |
cb82606b8215
move Lifting/Transfer relevant parts of Library/Quotient_* to Main
kuncar
parents:
52435
diff
changeset
|
6608 |
unfolding List.find_def by transfer_prover |
cb82606b8215
move Lifting/Transfer relevant parts of Library/Quotient_* to Main
kuncar
parents:
52435
diff
changeset
|
6609 |
|
cb82606b8215
move Lifting/Transfer relevant parts of Library/Quotient_* to Main
kuncar
parents:
52435
diff
changeset
|
6610 |
lemma remove1_transfer [transfer_rule]: |
cb82606b8215
move Lifting/Transfer relevant parts of Library/Quotient_* to Main
kuncar
parents:
52435
diff
changeset
|
6611 |
assumes [transfer_rule]: "bi_unique A" |
cb82606b8215
move Lifting/Transfer relevant parts of Library/Quotient_* to Main
kuncar
parents:
52435
diff
changeset
|
6612 |
shows "(A ===> list_all2 A ===> list_all2 A) remove1 remove1" |
cb82606b8215
move Lifting/Transfer relevant parts of Library/Quotient_* to Main
kuncar
parents:
52435
diff
changeset
|
6613 |
unfolding remove1_def by transfer_prover |
cb82606b8215
move Lifting/Transfer relevant parts of Library/Quotient_* to Main
kuncar
parents:
52435
diff
changeset
|
6614 |
|
cb82606b8215
move Lifting/Transfer relevant parts of Library/Quotient_* to Main
kuncar
parents:
52435
diff
changeset
|
6615 |
lemma removeAll_transfer [transfer_rule]: |
cb82606b8215
move Lifting/Transfer relevant parts of Library/Quotient_* to Main
kuncar
parents:
52435
diff
changeset
|
6616 |
assumes [transfer_rule]: "bi_unique A" |
cb82606b8215
move Lifting/Transfer relevant parts of Library/Quotient_* to Main
kuncar
parents:
52435
diff
changeset
|
6617 |
shows "(A ===> list_all2 A ===> list_all2 A) removeAll removeAll" |
cb82606b8215
move Lifting/Transfer relevant parts of Library/Quotient_* to Main
kuncar
parents:
52435
diff
changeset
|
6618 |
unfolding removeAll_def by transfer_prover |
cb82606b8215
move Lifting/Transfer relevant parts of Library/Quotient_* to Main
kuncar
parents:
52435
diff
changeset
|
6619 |
|
cb82606b8215
move Lifting/Transfer relevant parts of Library/Quotient_* to Main
kuncar
parents:
52435
diff
changeset
|
6620 |
lemma distinct_transfer [transfer_rule]: |
cb82606b8215
move Lifting/Transfer relevant parts of Library/Quotient_* to Main
kuncar
parents:
52435
diff
changeset
|
6621 |
assumes [transfer_rule]: "bi_unique A" |
cb82606b8215
move Lifting/Transfer relevant parts of Library/Quotient_* to Main
kuncar
parents:
52435
diff
changeset
|
6622 |
shows "(list_all2 A ===> op =) distinct distinct" |
cb82606b8215
move Lifting/Transfer relevant parts of Library/Quotient_* to Main
kuncar
parents:
52435
diff
changeset
|
6623 |
unfolding distinct_def by transfer_prover |
cb82606b8215
move Lifting/Transfer relevant parts of Library/Quotient_* to Main
kuncar
parents:
52435
diff
changeset
|
6624 |
|
cb82606b8215
move Lifting/Transfer relevant parts of Library/Quotient_* to Main
kuncar
parents:
52435
diff
changeset
|
6625 |
lemma remdups_transfer [transfer_rule]: |
cb82606b8215
move Lifting/Transfer relevant parts of Library/Quotient_* to Main
kuncar
parents:
52435
diff
changeset
|
6626 |
assumes [transfer_rule]: "bi_unique A" |
cb82606b8215
move Lifting/Transfer relevant parts of Library/Quotient_* to Main
kuncar
parents:
52435
diff
changeset
|
6627 |
shows "(list_all2 A ===> list_all2 A) remdups remdups" |
cb82606b8215
move Lifting/Transfer relevant parts of Library/Quotient_* to Main
kuncar
parents:
52435
diff
changeset
|
6628 |
unfolding remdups_def by transfer_prover |
cb82606b8215
move Lifting/Transfer relevant parts of Library/Quotient_* to Main
kuncar
parents:
52435
diff
changeset
|
6629 |
|
53721
ccaceea6c768
added two functions to List (one contributed by Manuel Eberl)
traytel
parents:
53689
diff
changeset
|
6630 |
lemma remdups_adj_transfer [transfer_rule]: |
ccaceea6c768
added two functions to List (one contributed by Manuel Eberl)
traytel
parents:
53689
diff
changeset
|
6631 |
assumes [transfer_rule]: "bi_unique A" |
ccaceea6c768
added two functions to List (one contributed by Manuel Eberl)
traytel
parents:
53689
diff
changeset
|
6632 |
shows "(list_all2 A ===> list_all2 A) remdups_adj remdups_adj" |
ccaceea6c768
added two functions to List (one contributed by Manuel Eberl)
traytel
parents:
53689
diff
changeset
|
6633 |
proof (rule fun_relI, erule list_all2_induct) |
ccaceea6c768
added two functions to List (one contributed by Manuel Eberl)
traytel
parents:
53689
diff
changeset
|
6634 |
qed (auto simp: remdups_adj_Cons assms[unfolded bi_unique_def] split: list.splits) |
ccaceea6c768
added two functions to List (one contributed by Manuel Eberl)
traytel
parents:
53689
diff
changeset
|
6635 |
|
53012
cb82606b8215
move Lifting/Transfer relevant parts of Library/Quotient_* to Main
kuncar
parents:
52435
diff
changeset
|
6636 |
lemma replicate_transfer [transfer_rule]: |
cb82606b8215
move Lifting/Transfer relevant parts of Library/Quotient_* to Main
kuncar
parents:
52435
diff
changeset
|
6637 |
"(op = ===> A ===> list_all2 A) replicate replicate" |
cb82606b8215
move Lifting/Transfer relevant parts of Library/Quotient_* to Main
kuncar
parents:
52435
diff
changeset
|
6638 |
unfolding replicate_def by transfer_prover |
cb82606b8215
move Lifting/Transfer relevant parts of Library/Quotient_* to Main
kuncar
parents:
52435
diff
changeset
|
6639 |
|
cb82606b8215
move Lifting/Transfer relevant parts of Library/Quotient_* to Main
kuncar
parents:
52435
diff
changeset
|
6640 |
lemma length_transfer [transfer_rule]: |
cb82606b8215
move Lifting/Transfer relevant parts of Library/Quotient_* to Main
kuncar
parents:
52435
diff
changeset
|
6641 |
"(list_all2 A ===> op =) length length" |
cb82606b8215
move Lifting/Transfer relevant parts of Library/Quotient_* to Main
kuncar
parents:
52435
diff
changeset
|
6642 |
unfolding list_size_overloaded_def by transfer_prover |
cb82606b8215
move Lifting/Transfer relevant parts of Library/Quotient_* to Main
kuncar
parents:
52435
diff
changeset
|
6643 |
|
cb82606b8215
move Lifting/Transfer relevant parts of Library/Quotient_* to Main
kuncar
parents:
52435
diff
changeset
|
6644 |
lemma rotate1_transfer [transfer_rule]: |
cb82606b8215
move Lifting/Transfer relevant parts of Library/Quotient_* to Main
kuncar
parents:
52435
diff
changeset
|
6645 |
"(list_all2 A ===> list_all2 A) rotate1 rotate1" |
cb82606b8215
move Lifting/Transfer relevant parts of Library/Quotient_* to Main
kuncar
parents:
52435
diff
changeset
|
6646 |
unfolding rotate1_def by transfer_prover |
cb82606b8215
move Lifting/Transfer relevant parts of Library/Quotient_* to Main
kuncar
parents:
52435
diff
changeset
|
6647 |
|
cb82606b8215
move Lifting/Transfer relevant parts of Library/Quotient_* to Main
kuncar
parents:
52435
diff
changeset
|
6648 |
lemma rotate_transfer [transfer_rule]: |
cb82606b8215
move Lifting/Transfer relevant parts of Library/Quotient_* to Main
kuncar
parents:
52435
diff
changeset
|
6649 |
"(op = ===> list_all2 A ===> list_all2 A) rotate rotate" |
cb82606b8215
move Lifting/Transfer relevant parts of Library/Quotient_* to Main
kuncar
parents:
52435
diff
changeset
|
6650 |
unfolding rotate_def [abs_def] by transfer_prover |
cb82606b8215
move Lifting/Transfer relevant parts of Library/Quotient_* to Main
kuncar
parents:
52435
diff
changeset
|
6651 |
|
cb82606b8215
move Lifting/Transfer relevant parts of Library/Quotient_* to Main
kuncar
parents:
52435
diff
changeset
|
6652 |
lemma list_all2_transfer [transfer_rule]: |
cb82606b8215
move Lifting/Transfer relevant parts of Library/Quotient_* to Main
kuncar
parents:
52435
diff
changeset
|
6653 |
"((A ===> B ===> op =) ===> list_all2 A ===> list_all2 B ===> op =) |
cb82606b8215
move Lifting/Transfer relevant parts of Library/Quotient_* to Main
kuncar
parents:
52435
diff
changeset
|
6654 |
list_all2 list_all2" |
cb82606b8215
move Lifting/Transfer relevant parts of Library/Quotient_* to Main
kuncar
parents:
52435
diff
changeset
|
6655 |
apply (subst (4) list_all2_def [abs_def]) |
cb82606b8215
move Lifting/Transfer relevant parts of Library/Quotient_* to Main
kuncar
parents:
52435
diff
changeset
|
6656 |
apply (subst (3) list_all2_def [abs_def]) |
cb82606b8215
move Lifting/Transfer relevant parts of Library/Quotient_* to Main
kuncar
parents:
52435
diff
changeset
|
6657 |
apply transfer_prover |
cb82606b8215
move Lifting/Transfer relevant parts of Library/Quotient_* to Main
kuncar
parents:
52435
diff
changeset
|
6658 |
done |
cb82606b8215
move Lifting/Transfer relevant parts of Library/Quotient_* to Main
kuncar
parents:
52435
diff
changeset
|
6659 |
|
cb82606b8215
move Lifting/Transfer relevant parts of Library/Quotient_* to Main
kuncar
parents:
52435
diff
changeset
|
6660 |
lemma sublist_transfer [transfer_rule]: |
cb82606b8215
move Lifting/Transfer relevant parts of Library/Quotient_* to Main
kuncar
parents:
52435
diff
changeset
|
6661 |
"(list_all2 A ===> set_rel (op =) ===> list_all2 A) sublist sublist" |
cb82606b8215
move Lifting/Transfer relevant parts of Library/Quotient_* to Main
kuncar
parents:
52435
diff
changeset
|
6662 |
unfolding sublist_def [abs_def] by transfer_prover |
cb82606b8215
move Lifting/Transfer relevant parts of Library/Quotient_* to Main
kuncar
parents:
52435
diff
changeset
|
6663 |
|
cb82606b8215
move Lifting/Transfer relevant parts of Library/Quotient_* to Main
kuncar
parents:
52435
diff
changeset
|
6664 |
lemma partition_transfer [transfer_rule]: |
cb82606b8215
move Lifting/Transfer relevant parts of Library/Quotient_* to Main
kuncar
parents:
52435
diff
changeset
|
6665 |
"((A ===> op =) ===> list_all2 A ===> prod_rel (list_all2 A) (list_all2 A)) |
cb82606b8215
move Lifting/Transfer relevant parts of Library/Quotient_* to Main
kuncar
parents:
52435
diff
changeset
|
6666 |
partition partition" |
cb82606b8215
move Lifting/Transfer relevant parts of Library/Quotient_* to Main
kuncar
parents:
52435
diff
changeset
|
6667 |
unfolding partition_def by transfer_prover |
cb82606b8215
move Lifting/Transfer relevant parts of Library/Quotient_* to Main
kuncar
parents:
52435
diff
changeset
|
6668 |
|
cb82606b8215
move Lifting/Transfer relevant parts of Library/Quotient_* to Main
kuncar
parents:
52435
diff
changeset
|
6669 |
lemma lists_transfer [transfer_rule]: |
cb82606b8215
move Lifting/Transfer relevant parts of Library/Quotient_* to Main
kuncar
parents:
52435
diff
changeset
|
6670 |
"(set_rel A ===> set_rel (list_all2 A)) lists lists" |
cb82606b8215
move Lifting/Transfer relevant parts of Library/Quotient_* to Main
kuncar
parents:
52435
diff
changeset
|
6671 |
apply (rule fun_relI, rule set_relI) |
cb82606b8215
move Lifting/Transfer relevant parts of Library/Quotient_* to Main
kuncar
parents:
52435
diff
changeset
|
6672 |
apply (erule lists.induct, simp) |
cb82606b8215
move Lifting/Transfer relevant parts of Library/Quotient_* to Main
kuncar
parents:
52435
diff
changeset
|
6673 |
apply (simp only: set_rel_def list_all2_Cons1, metis lists.Cons) |
cb82606b8215
move Lifting/Transfer relevant parts of Library/Quotient_* to Main
kuncar
parents:
52435
diff
changeset
|
6674 |
apply (erule lists.induct, simp) |
cb82606b8215
move Lifting/Transfer relevant parts of Library/Quotient_* to Main
kuncar
parents:
52435
diff
changeset
|
6675 |
apply (simp only: set_rel_def list_all2_Cons2, metis lists.Cons) |
cb82606b8215
move Lifting/Transfer relevant parts of Library/Quotient_* to Main
kuncar
parents:
52435
diff
changeset
|
6676 |
done |
cb82606b8215
move Lifting/Transfer relevant parts of Library/Quotient_* to Main
kuncar
parents:
52435
diff
changeset
|
6677 |
|
cb82606b8215
move Lifting/Transfer relevant parts of Library/Quotient_* to Main
kuncar
parents:
52435
diff
changeset
|
6678 |
lemma set_Cons_transfer [transfer_rule]: |
cb82606b8215
move Lifting/Transfer relevant parts of Library/Quotient_* to Main
kuncar
parents:
52435
diff
changeset
|
6679 |
"(set_rel A ===> set_rel (list_all2 A) ===> set_rel (list_all2 A)) |
cb82606b8215
move Lifting/Transfer relevant parts of Library/Quotient_* to Main
kuncar
parents:
52435
diff
changeset
|
6680 |
set_Cons set_Cons" |
cb82606b8215
move Lifting/Transfer relevant parts of Library/Quotient_* to Main
kuncar
parents:
52435
diff
changeset
|
6681 |
unfolding fun_rel_def set_rel_def set_Cons_def |
cb82606b8215
move Lifting/Transfer relevant parts of Library/Quotient_* to Main
kuncar
parents:
52435
diff
changeset
|
6682 |
apply safe |
cb82606b8215
move Lifting/Transfer relevant parts of Library/Quotient_* to Main
kuncar
parents:
52435
diff
changeset
|
6683 |
apply (simp add: list_all2_Cons1, fast) |
cb82606b8215
move Lifting/Transfer relevant parts of Library/Quotient_* to Main
kuncar
parents:
52435
diff
changeset
|
6684 |
apply (simp add: list_all2_Cons2, fast) |
cb82606b8215
move Lifting/Transfer relevant parts of Library/Quotient_* to Main
kuncar
parents:
52435
diff
changeset
|
6685 |
done |
cb82606b8215
move Lifting/Transfer relevant parts of Library/Quotient_* to Main
kuncar
parents:
52435
diff
changeset
|
6686 |
|
cb82606b8215
move Lifting/Transfer relevant parts of Library/Quotient_* to Main
kuncar
parents:
52435
diff
changeset
|
6687 |
lemma listset_transfer [transfer_rule]: |
cb82606b8215
move Lifting/Transfer relevant parts of Library/Quotient_* to Main
kuncar
parents:
52435
diff
changeset
|
6688 |
"(list_all2 (set_rel A) ===> set_rel (list_all2 A)) listset listset" |
cb82606b8215
move Lifting/Transfer relevant parts of Library/Quotient_* to Main
kuncar
parents:
52435
diff
changeset
|
6689 |
unfolding listset_def by transfer_prover |
cb82606b8215
move Lifting/Transfer relevant parts of Library/Quotient_* to Main
kuncar
parents:
52435
diff
changeset
|
6690 |
|
cb82606b8215
move Lifting/Transfer relevant parts of Library/Quotient_* to Main
kuncar
parents:
52435
diff
changeset
|
6691 |
lemma null_transfer [transfer_rule]: |
cb82606b8215
move Lifting/Transfer relevant parts of Library/Quotient_* to Main
kuncar
parents:
52435
diff
changeset
|
6692 |
"(list_all2 A ===> op =) List.null List.null" |
cb82606b8215
move Lifting/Transfer relevant parts of Library/Quotient_* to Main
kuncar
parents:
52435
diff
changeset
|
6693 |
unfolding fun_rel_def List.null_def by auto |
cb82606b8215
move Lifting/Transfer relevant parts of Library/Quotient_* to Main
kuncar
parents:
52435
diff
changeset
|
6694 |
|
cb82606b8215
move Lifting/Transfer relevant parts of Library/Quotient_* to Main
kuncar
parents:
52435
diff
changeset
|
6695 |
lemma list_all_transfer [transfer_rule]: |
cb82606b8215
move Lifting/Transfer relevant parts of Library/Quotient_* to Main
kuncar
parents:
52435
diff
changeset
|
6696 |
"((A ===> op =) ===> list_all2 A ===> op =) list_all list_all" |
cb82606b8215
move Lifting/Transfer relevant parts of Library/Quotient_* to Main
kuncar
parents:
52435
diff
changeset
|
6697 |
unfolding list_all_iff [abs_def] by transfer_prover |
cb82606b8215
move Lifting/Transfer relevant parts of Library/Quotient_* to Main
kuncar
parents:
52435
diff
changeset
|
6698 |
|
cb82606b8215
move Lifting/Transfer relevant parts of Library/Quotient_* to Main
kuncar
parents:
52435
diff
changeset
|
6699 |
lemma list_ex_transfer [transfer_rule]: |
cb82606b8215
move Lifting/Transfer relevant parts of Library/Quotient_* to Main
kuncar
parents:
52435
diff
changeset
|
6700 |
"((A ===> op =) ===> list_all2 A ===> op =) list_ex list_ex" |
cb82606b8215
move Lifting/Transfer relevant parts of Library/Quotient_* to Main
kuncar
parents:
52435
diff
changeset
|
6701 |
unfolding list_ex_iff [abs_def] by transfer_prover |
cb82606b8215
move Lifting/Transfer relevant parts of Library/Quotient_* to Main
kuncar
parents:
52435
diff
changeset
|
6702 |
|
cb82606b8215
move Lifting/Transfer relevant parts of Library/Quotient_* to Main
kuncar
parents:
52435
diff
changeset
|
6703 |
lemma splice_transfer [transfer_rule]: |
cb82606b8215
move Lifting/Transfer relevant parts of Library/Quotient_* to Main
kuncar
parents:
52435
diff
changeset
|
6704 |
"(list_all2 A ===> list_all2 A ===> list_all2 A) splice splice" |
cb82606b8215
move Lifting/Transfer relevant parts of Library/Quotient_* to Main
kuncar
parents:
52435
diff
changeset
|
6705 |
apply (rule fun_relI, erule list_all2_induct, simp add: fun_rel_def, simp) |
cb82606b8215
move Lifting/Transfer relevant parts of Library/Quotient_* to Main
kuncar
parents:
52435
diff
changeset
|
6706 |
apply (rule fun_relI) |
cb82606b8215
move Lifting/Transfer relevant parts of Library/Quotient_* to Main
kuncar
parents:
52435
diff
changeset
|
6707 |
apply (erule_tac xs=x in list_all2_induct, simp, simp add: fun_rel_def) |
cb82606b8215
move Lifting/Transfer relevant parts of Library/Quotient_* to Main
kuncar
parents:
52435
diff
changeset
|
6708 |
done |
cb82606b8215
move Lifting/Transfer relevant parts of Library/Quotient_* to Main
kuncar
parents:
52435
diff
changeset
|
6709 |
|
cb82606b8215
move Lifting/Transfer relevant parts of Library/Quotient_* to Main
kuncar
parents:
52435
diff
changeset
|
6710 |
lemma listsum_transfer[transfer_rule]: |
cb82606b8215
move Lifting/Transfer relevant parts of Library/Quotient_* to Main
kuncar
parents:
52435
diff
changeset
|
6711 |
assumes [transfer_rule]: "A 0 0" |
cb82606b8215
move Lifting/Transfer relevant parts of Library/Quotient_* to Main
kuncar
parents:
52435
diff
changeset
|
6712 |
assumes [transfer_rule]: "(A ===> A ===> A) op + op +" |
cb82606b8215
move Lifting/Transfer relevant parts of Library/Quotient_* to Main
kuncar
parents:
52435
diff
changeset
|
6713 |
shows "(list_all2 A ===> A) listsum listsum" |
cb82606b8215
move Lifting/Transfer relevant parts of Library/Quotient_* to Main
kuncar
parents:
52435
diff
changeset
|
6714 |
unfolding listsum_def[abs_def] |
cb82606b8215
move Lifting/Transfer relevant parts of Library/Quotient_* to Main
kuncar
parents:
52435
diff
changeset
|
6715 |
by transfer_prover |
cb82606b8215
move Lifting/Transfer relevant parts of Library/Quotient_* to Main
kuncar
parents:
52435
diff
changeset
|
6716 |
|
23388 | 6717 |
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
|
6718 |
|
53012
cb82606b8215
move Lifting/Transfer relevant parts of Library/Quotient_* to Main
kuncar
parents:
52435
diff
changeset
|
6719 |
end |