author | paulson <lp15@cam.ac.uk> |
Fri, 21 Aug 2020 12:42:57 +0100 | |
changeset 72184 | 881bd98bddee |
parent 72170 | 7fa9605b226c |
child 72302 | d7d90ed4c74e |
permissions | -rw-r--r-- |
13462 | 1 |
(* Title: HOL/List.thy |
68709 | 2 |
Author: Tobias Nipkow; proofs tidied by LCP |
923 | 3 |
*) |
4 |
||
60758 | 5 |
section \<open>The datatype of finite lists\<close> |
13122 | 6 |
|
15131 | 7 |
theory List |
58916 | 8 |
imports Sledgehammer Code_Numeral Lifting_Set |
15131 | 9 |
begin |
923 | 10 |
|
58310 | 11 |
datatype (set: 'a) list = |
57200
aab87ffa60cc
use 'where' clause for selector default value syntax
blanchet
parents:
57198
diff
changeset
|
12 |
Nil ("[]") |
55405
0a155051bd9d
use new selector support to define 'the', 'hd', 'tl'
blanchet
parents:
55404
diff
changeset
|
13 |
| Cons (hd: 'a) (tl: "'a list") (infixr "#" 65) |
57206
d9be905d6283
changed syntax of map: and rel: arguments to BNF-based datatypes
blanchet
parents:
57200
diff
changeset
|
14 |
for |
d9be905d6283
changed syntax of map: and rel: arguments to BNF-based datatypes
blanchet
parents:
57200
diff
changeset
|
15 |
map: map |
d9be905d6283
changed syntax of map: and rel: arguments to BNF-based datatypes
blanchet
parents:
57200
diff
changeset
|
16 |
rel: list_all2 |
62328 | 17 |
pred: list_all |
57200
aab87ffa60cc
use 'where' clause for selector default value syntax
blanchet
parents:
57198
diff
changeset
|
18 |
where |
aab87ffa60cc
use 'where' clause for selector default value syntax
blanchet
parents:
57198
diff
changeset
|
19 |
"tl [] = []" |
57123
b5324647e0f1
tuned whitespace, to make datatype definitions slightly less intimidating
blanchet
parents:
57091
diff
changeset
|
20 |
|
55531
601ca8efa000
renamed 'datatype_new_compat' to 'datatype_compat'
blanchet
parents:
55525
diff
changeset
|
21 |
datatype_compat list |
55404
5cb95b79a51f
transformed 'option' and 'list' into new-style datatypes (but register them as old-style as well)
blanchet
parents:
55148
diff
changeset
|
22 |
|
55406 | 23 |
lemma [case_names Nil Cons, cases type: list]: |
61799 | 24 |
\<comment> \<open>for backward compatibility -- names of variables differ\<close> |
55406 | 25 |
"(y = [] \<Longrightarrow> P) \<Longrightarrow> (\<And>a list. y = a # list \<Longrightarrow> P) \<Longrightarrow> P" |
26 |
by (rule list.exhaust) |
|
27 |
||
28 |
lemma [case_names Nil Cons, induct type: list]: |
|
61799 | 29 |
\<comment> \<open>for backward compatibility -- names of variables differ\<close> |
55406 | 30 |
"P [] \<Longrightarrow> (\<And>a list. P list \<Longrightarrow> P (a # list)) \<Longrightarrow> P list" |
31 |
by (rule list.induct) |
|
32 |
||
60758 | 33 |
text \<open>Compatibility:\<close> |
34 |
||
35 |
setup \<open>Sign.mandatory_path "list"\<close> |
|
55404
5cb95b79a51f
transformed 'option' and 'list' into new-style datatypes (but register them as old-style as well)
blanchet
parents:
55148
diff
changeset
|
36 |
|
5cb95b79a51f
transformed 'option' and 'list' into new-style datatypes (but register them as old-style as well)
blanchet
parents:
55148
diff
changeset
|
37 |
lemmas inducts = list.induct |
5cb95b79a51f
transformed 'option' and 'list' into new-style datatypes (but register them as old-style as well)
blanchet
parents:
55148
diff
changeset
|
38 |
lemmas recs = list.rec |
5cb95b79a51f
transformed 'option' and 'list' into new-style datatypes (but register them as old-style as well)
blanchet
parents:
55148
diff
changeset
|
39 |
lemmas cases = list.case |
5cb95b79a51f
transformed 'option' and 'list' into new-style datatypes (but register them as old-style as well)
blanchet
parents:
55148
diff
changeset
|
40 |
|
60758 | 41 |
setup \<open>Sign.parent_path\<close> |
55404
5cb95b79a51f
transformed 'option' and 'list' into new-style datatypes (but register them as old-style as well)
blanchet
parents:
55148
diff
changeset
|
42 |
|
57816
d8bbb97689d3
no need for 'set_simps' now that 'datatype_new' generates the desired 'set' property
blanchet
parents:
57599
diff
changeset
|
43 |
lemmas set_simps = list.set (* legacy *) |
d8bbb97689d3
no need for 'set_simps' now that 'datatype_new' generates the desired 'set' property
blanchet
parents:
57599
diff
changeset
|
44 |
|
34941 | 45 |
syntax |
61799 | 46 |
\<comment> \<open>list Enumeration\<close> |
35115 | 47 |
"_list" :: "args => 'a list" ("[(_)]") |
34941 | 48 |
|
49 |
translations |
|
50 |
"[x, xs]" == "x#[xs]" |
|
51 |
"[x]" == "x#[]" |
|
52 |
||
35115 | 53 |
|
60758 | 54 |
subsection \<open>Basic list processing functions\<close> |
15302 | 55 |
|
58135 | 56 |
primrec (nonexhaustive) last :: "'a list \<Rightarrow> 'a" where |
50548 | 57 |
"last (x # xs) = (if xs = [] then x else last xs)" |
58 |
||
59 |
primrec butlast :: "'a list \<Rightarrow> 'a list" where |
|
57816
d8bbb97689d3
no need for 'set_simps' now that 'datatype_new' generates the desired 'set' property
blanchet
parents:
57599
diff
changeset
|
60 |
"butlast [] = []" | |
50548 | 61 |
"butlast (x # xs) = (if xs = [] then [] else x # butlast xs)" |
62 |
||
55584 | 63 |
lemma set_rec: "set xs = rec_list {} (\<lambda>x _. insert x) xs" |
64 |
by (induct xs) auto |
|
50548 | 65 |
|
66 |
definition coset :: "'a list \<Rightarrow> 'a set" where |
|
67 |
[simp]: "coset xs = - set xs" |
|
68 |
||
69 |
primrec append :: "'a list \<Rightarrow> 'a list \<Rightarrow> 'a list" (infixr "@" 65) where |
|
70 |
append_Nil: "[] @ ys = ys" | |
|
71 |
append_Cons: "(x#xs) @ ys = x # xs @ ys" |
|
72 |
||
73 |
primrec rev :: "'a list \<Rightarrow> 'a list" where |
|
74 |
"rev [] = []" | |
|
75 |
"rev (x # xs) = rev xs @ [x]" |
|
76 |
||
77 |
primrec filter:: "('a \<Rightarrow> bool) \<Rightarrow> 'a list \<Rightarrow> 'a list" where |
|
78 |
"filter P [] = []" | |
|
79 |
"filter P (x # xs) = (if P x then x # filter P xs else filter P xs)" |
|
34941 | 80 |
|
68249
949d93804740
First step to remove nonstandard "[x <- xs. P]" syntax: only input
nipkow
parents:
68215
diff
changeset
|
81 |
text \<open>Special input syntax for filter:\<close> |
61955
e96292f32c3c
former "xsymbols" syntax is used by default, and ASCII replacement syntax with print mode "ASCII";
wenzelm
parents:
61941
diff
changeset
|
82 |
syntax (ASCII) |
e96292f32c3c
former "xsymbols" syntax is used by default, and ASCII replacement syntax with print mode "ASCII";
wenzelm
parents:
61941
diff
changeset
|
83 |
"_filter" :: "[pttrn, 'a list, bool] => 'a list" ("(1[_<-_./ _])") |
34941 | 84 |
syntax |
61955
e96292f32c3c
former "xsymbols" syntax is used by default, and ASCII replacement syntax with print mode "ASCII";
wenzelm
parents:
61941
diff
changeset
|
85 |
"_filter" :: "[pttrn, 'a list, bool] => 'a list" ("(1[_\<leftarrow>_ ./ _])") |
34941 | 86 |
translations |
68249
949d93804740
First step to remove nonstandard "[x <- xs. P]" syntax: only input
nipkow
parents:
68215
diff
changeset
|
87 |
"[x<-xs . P]" \<rightharpoonup> "CONST filter (\<lambda>x. P) xs" |
34941 | 88 |
|
50548 | 89 |
primrec fold :: "('a \<Rightarrow> 'b \<Rightarrow> 'b) \<Rightarrow> 'a list \<Rightarrow> 'b \<Rightarrow> 'b" where |
90 |
fold_Nil: "fold f [] = id" | |
|
91 |
fold_Cons: "fold f (x # xs) = fold f xs \<circ> f x" |
|
92 |
||
93 |
primrec foldr :: "('a \<Rightarrow> 'b \<Rightarrow> 'b) \<Rightarrow> 'a list \<Rightarrow> 'b \<Rightarrow> 'b" where |
|
94 |
foldr_Nil: "foldr f [] = id" | |
|
95 |
foldr_Cons: "foldr f (x # xs) = f x \<circ> foldr f xs" |
|
96 |
||
97 |
primrec foldl :: "('b \<Rightarrow> 'a \<Rightarrow> 'b) \<Rightarrow> 'b \<Rightarrow> 'a list \<Rightarrow> 'b" where |
|
98 |
foldl_Nil: "foldl f a [] = a" | |
|
99 |
foldl_Cons: "foldl f a (x # xs) = foldl f (f a x) xs" |
|
100 |
||
101 |
primrec concat:: "'a list list \<Rightarrow> 'a list" where |
|
102 |
"concat [] = []" | |
|
103 |
"concat (x # xs) = x @ concat xs" |
|
104 |
||
105 |
primrec drop:: "nat \<Rightarrow> 'a list \<Rightarrow> 'a list" where |
|
106 |
drop_Nil: "drop n [] = []" | |
|
107 |
drop_Cons: "drop n (x # xs) = (case n of 0 \<Rightarrow> x # xs | Suc m \<Rightarrow> drop m xs)" |
|
61799 | 108 |
\<comment> \<open>Warning: simpset does not contain this definition, but separate |
109 |
theorems for \<open>n = 0\<close> and \<open>n = Suc k\<close>\<close> |
|
34941 | 110 |
|
50548 | 111 |
primrec take:: "nat \<Rightarrow> 'a list \<Rightarrow> 'a list" where |
112 |
take_Nil:"take n [] = []" | |
|
113 |
take_Cons: "take n (x # xs) = (case n of 0 \<Rightarrow> [] | Suc m \<Rightarrow> x # take m xs)" |
|
61799 | 114 |
\<comment> \<open>Warning: simpset does not contain this definition, but separate |
115 |
theorems for \<open>n = 0\<close> and \<open>n = Suc k\<close>\<close> |
|
34941 | 116 |
|
58135 | 117 |
primrec (nonexhaustive) nth :: "'a list => nat => 'a" (infixl "!" 100) where |
50548 | 118 |
nth_Cons: "(x # xs) ! n = (case n of 0 \<Rightarrow> x | Suc k \<Rightarrow> xs ! k)" |
61799 | 119 |
\<comment> \<open>Warning: simpset does not contain this definition, but separate |
120 |
theorems for \<open>n = 0\<close> and \<open>n = Suc k\<close>\<close> |
|
34941 | 121 |
|
50548 | 122 |
primrec list_update :: "'a list \<Rightarrow> nat \<Rightarrow> 'a \<Rightarrow> 'a list" where |
123 |
"list_update [] i v = []" | |
|
124 |
"list_update (x # xs) i v = |
|
125 |
(case i of 0 \<Rightarrow> v # xs | Suc j \<Rightarrow> x # list_update xs j v)" |
|
923 | 126 |
|
41229
d797baa3d57c
replaced command 'nonterminals' by slightly modernized version 'nonterminal';
wenzelm
parents:
41075
diff
changeset
|
127 |
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
|
128 |
|
923 | 129 |
syntax |
13366 | 130 |
"_lupdbind":: "['a, 'a] => lupdbind" ("(2_ :=/ _)") |
131 |
"" :: "lupdbind => lupdbinds" ("_") |
|
132 |
"_lupdbinds" :: "[lupdbind, lupdbinds] => lupdbinds" ("_,/ _") |
|
69084 | 133 |
"_LUpdate" :: "['a, lupdbinds] => 'a" ("_/[(_)]" [1000,0] 900) |
5077
71043526295f
* HOL/List: new function list_update written xs[i:=v] that updates the i-th
nipkow
parents:
4643
diff
changeset
|
134 |
|
923 | 135 |
translations |
35115 | 136 |
"_LUpdate xs (_lupdbinds b bs)" == "_LUpdate (_LUpdate xs b) bs" |
34941 | 137 |
"xs[i:=x]" == "CONST list_update xs i x" |
138 |
||
50548 | 139 |
primrec takeWhile :: "('a \<Rightarrow> bool) \<Rightarrow> 'a list \<Rightarrow> 'a list" where |
140 |
"takeWhile P [] = []" | |
|
141 |
"takeWhile P (x # xs) = (if P x then x # takeWhile P xs else [])" |
|
142 |
||
143 |
primrec dropWhile :: "('a \<Rightarrow> bool) \<Rightarrow> 'a list \<Rightarrow> 'a list" where |
|
144 |
"dropWhile P [] = []" | |
|
145 |
"dropWhile P (x # xs) = (if P x then dropWhile P xs else x # xs)" |
|
146 |
||
147 |
primrec zip :: "'a list \<Rightarrow> 'b list \<Rightarrow> ('a \<times> 'b) list" where |
|
148 |
"zip xs [] = []" | |
|
149 |
zip_Cons: "zip xs (y # ys) = |
|
67091 | 150 |
(case xs of [] \<Rightarrow> [] | z # zs \<Rightarrow> (z, y) # zip zs ys)" |
61799 | 151 |
\<comment> \<open>Warning: simpset does not contain this definition, but separate |
152 |
theorems for \<open>xs = []\<close> and \<open>xs = z # zs\<close>\<close> |
|
34941 | 153 |
|
66656 | 154 |
abbreviation map2 :: "('a \<Rightarrow> 'b \<Rightarrow> 'c) \<Rightarrow> 'a list \<Rightarrow> 'b list \<Rightarrow> 'c list" where |
155 |
"map2 f xs ys \<equiv> map (\<lambda>(x,y). f x y) (zip xs ys)" |
|
66655 | 156 |
|
50548 | 157 |
primrec product :: "'a list \<Rightarrow> 'b list \<Rightarrow> ('a \<times> 'b) list" where |
158 |
"product [] _ = []" | |
|
159 |
"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
|
160 |
|
744934b818c7
moved quite generic material from theory Enum to more appropriate places
haftmann
parents:
49808
diff
changeset
|
161 |
hide_const (open) product |
744934b818c7
moved quite generic material from theory Enum to more appropriate places
haftmann
parents:
49808
diff
changeset
|
162 |
|
53721
ccaceea6c768
added two functions to List (one contributed by Manuel Eberl)
traytel
parents:
53689
diff
changeset
|
163 |
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
|
164 |
"product_lists [] = [[]]" | |
ccaceea6c768
added two functions to List (one contributed by Manuel Eberl)
traytel
parents:
53689
diff
changeset
|
165 |
"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
|
166 |
|
50548 | 167 |
primrec upt :: "nat \<Rightarrow> nat \<Rightarrow> nat list" ("(1[_..</_'])") where |
168 |
upt_0: "[i..<0] = []" | |
|
68709 | 169 |
upt_Suc: "[i..<(Suc j)] = (if i \<le> j then [i..<j] @ [j] else [])" |
50548 | 170 |
|
171 |
definition insert :: "'a \<Rightarrow> 'a list \<Rightarrow> 'a list" where |
|
172 |
"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
|
173 |
|
57198 | 174 |
definition union :: "'a list \<Rightarrow> 'a list \<Rightarrow> 'a list" where |
175 |
"union = fold insert" |
|
176 |
||
177 |
hide_const (open) insert union |
|
178 |
hide_fact (open) insert_def union_def |
|
34978
874150ddd50a
canonical insert operation; generalized lemma foldl_apply_inv to foldl_apply
haftmann
parents:
34942
diff
changeset
|
179 |
|
47122 | 180 |
primrec find :: "('a \<Rightarrow> bool) \<Rightarrow> 'a list \<Rightarrow> 'a option" where |
50548 | 181 |
"find _ [] = None" | |
182 |
"find P (x#xs) = (if P x then Some x else find P xs)" |
|
47122 | 183 |
|
61799 | 184 |
text \<open>In the context of multisets, \<open>count_list\<close> is equivalent to |
69593 | 185 |
\<^term>\<open>count \<circ> mset\<close> and it it advisable to use the latter.\<close> |
60541 | 186 |
primrec count_list :: "'a list \<Rightarrow> 'a \<Rightarrow> nat" where |
187 |
"count_list [] y = 0" | |
|
188 |
"count_list (x#xs) y = (if x=y then count_list xs y + 1 else count_list xs y)" |
|
59728 | 189 |
|
55807 | 190 |
definition |
191 |
"extract" :: "('a \<Rightarrow> bool) \<Rightarrow> 'a list \<Rightarrow> ('a list * 'a * 'a list) option" |
|
192 |
where "extract P xs = |
|
67091 | 193 |
(case dropWhile (Not \<circ> P) xs of |
55807 | 194 |
[] \<Rightarrow> None | |
67091 | 195 |
y#ys \<Rightarrow> Some(takeWhile (Not \<circ> P) xs, y, ys))" |
55807 | 196 |
|
197 |
hide_const (open) "extract" |
|
198 |
||
51096 | 199 |
primrec those :: "'a option list \<Rightarrow> 'a list option" |
200 |
where |
|
201 |
"those [] = Some []" | |
|
202 |
"those (x # xs) = (case x of |
|
203 |
None \<Rightarrow> None |
|
55466 | 204 |
| Some y \<Rightarrow> map_option (Cons y) (those xs))" |
51096 | 205 |
|
50548 | 206 |
primrec remove1 :: "'a \<Rightarrow> 'a list \<Rightarrow> 'a list" where |
207 |
"remove1 x [] = []" | |
|
208 |
"remove1 x (y # xs) = (if x = y then xs else y # remove1 x xs)" |
|
209 |
||
210 |
primrec removeAll :: "'a \<Rightarrow> 'a list \<Rightarrow> 'a list" where |
|
211 |
"removeAll x [] = []" | |
|
212 |
"removeAll x (y # xs) = (if x = y then removeAll x xs else y # removeAll x xs)" |
|
213 |
||
214 |
primrec distinct :: "'a list \<Rightarrow> bool" where |
|
215 |
"distinct [] \<longleftrightarrow> True" | |
|
216 |
"distinct (x # xs) \<longleftrightarrow> x \<notin> set xs \<and> distinct xs" |
|
217 |
||
71779 | 218 |
fun successively :: "('a \<Rightarrow> 'a \<Rightarrow> bool) \<Rightarrow> 'a list \<Rightarrow> bool" where |
219 |
"successively P [] = True" | |
|
220 |
"successively P [x] = True" | |
|
221 |
"successively P (x # y # xs) = (P x y \<and> successively P (y#xs))" |
|
222 |
||
223 |
definition distinct_adj where |
|
224 |
"distinct_adj = successively (\<noteq>)" |
|
225 |
||
50548 | 226 |
primrec remdups :: "'a list \<Rightarrow> 'a list" where |
227 |
"remdups [] = []" | |
|
228 |
"remdups (x # xs) = (if x \<in> set xs then remdups xs else x # remdups xs)" |
|
229 |
||
53721
ccaceea6c768
added two functions to List (one contributed by Manuel Eberl)
traytel
parents:
53689
diff
changeset
|
230 |
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
|
231 |
"remdups_adj [] = []" | |
ccaceea6c768
added two functions to List (one contributed by Manuel Eberl)
traytel
parents:
53689
diff
changeset
|
232 |
"remdups_adj [x] = [x]" | |
ccaceea6c768
added two functions to List (one contributed by Manuel Eberl)
traytel
parents:
53689
diff
changeset
|
233 |
"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
|
234 |
|
50548 | 235 |
primrec replicate :: "nat \<Rightarrow> 'a \<Rightarrow> 'a list" where |
236 |
replicate_0: "replicate 0 x = []" | |
|
237 |
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
|
238 |
|
60758 | 239 |
text \<open> |
61799 | 240 |
Function \<open>size\<close> is overloaded for all datatypes. Users may |
241 |
refer to the list version as \<open>length\<close>.\<close> |
|
13142 | 242 |
|
50548 | 243 |
abbreviation length :: "'a list \<Rightarrow> nat" where |
244 |
"length \<equiv> size" |
|
15307 | 245 |
|
51173 | 246 |
definition enumerate :: "nat \<Rightarrow> 'a list \<Rightarrow> (nat \<times> 'a) list" where |
247 |
enumerate_eq_zip: "enumerate n xs = zip [n..<n + length xs] xs" |
|
248 |
||
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
|
249 |
primrec rotate1 :: "'a list \<Rightarrow> 'a list" where |
50548 | 250 |
"rotate1 [] = []" | |
251 |
"rotate1 (x # xs) = xs @ [x]" |
|
252 |
||
253 |
definition rotate :: "nat \<Rightarrow> 'a list \<Rightarrow> 'a list" where |
|
254 |
"rotate n = rotate1 ^^ n" |
|
255 |
||
65956
639eb3617a86
reorganised material on sublists
eberlm <eberlm@in.tum.de>
parents:
65350
diff
changeset
|
256 |
definition nths :: "'a list => nat set => 'a list" where |
639eb3617a86
reorganised material on sublists
eberlm <eberlm@in.tum.de>
parents:
65350
diff
changeset
|
257 |
"nths xs A = map fst (filter (\<lambda>p. snd p \<in> A) (zip xs [0..<size xs]))" |
639eb3617a86
reorganised material on sublists
eberlm <eberlm@in.tum.de>
parents:
65350
diff
changeset
|
258 |
|
639eb3617a86
reorganised material on sublists
eberlm <eberlm@in.tum.de>
parents:
65350
diff
changeset
|
259 |
primrec subseqs :: "'a list \<Rightarrow> 'a list list" where |
639eb3617a86
reorganised material on sublists
eberlm <eberlm@in.tum.de>
parents:
65350
diff
changeset
|
260 |
"subseqs [] = [[]]" | |
639eb3617a86
reorganised material on sublists
eberlm <eberlm@in.tum.de>
parents:
65350
diff
changeset
|
261 |
"subseqs (x#xs) = (let xss = subseqs xs in map (Cons x) xss @ xss)" |
50548 | 262 |
|
263 |
primrec n_lists :: "nat \<Rightarrow> 'a list \<Rightarrow> 'a list list" where |
|
264 |
"n_lists 0 xs = [[]]" | |
|
265 |
"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
|
266 |
|
744934b818c7
moved quite generic material from theory Enum to more appropriate places
haftmann
parents:
49808
diff
changeset
|
267 |
hide_const (open) n_lists |
744934b818c7
moved quite generic material from theory Enum to more appropriate places
haftmann
parents:
49808
diff
changeset
|
268 |
|
69075 | 269 |
function splice :: "'a list \<Rightarrow> 'a list \<Rightarrow> 'a list" where |
40593
1e57b18d27b1
code eqn for slice was missing; redefined splice with fun
nipkow
parents:
40365
diff
changeset
|
270 |
"splice [] ys = ys" | |
69075 | 271 |
"splice (x#xs) ys = x # splice ys xs" |
272 |
by pat_completeness auto |
|
273 |
||
274 |
termination |
|
275 |
by(relation "measure(\<lambda>(xs,ys). size xs + size ys)") auto |
|
21061
580dfc999ef6
added normal post setup; cleaned up "execution" constants
haftmann
parents:
21046
diff
changeset
|
276 |
|
69107 | 277 |
function shuffles where |
278 |
"shuffles [] ys = {ys}" |
|
279 |
| "shuffles xs [] = {xs}" |
|
280 |
| "shuffles (x # xs) (y # ys) = (#) x ` shuffles xs (y # ys) \<union> (#) y ` shuffles (x # xs) ys" |
|
65350
b149abe619f7
added shuffle product to HOL/List
eberlm <eberlm@in.tum.de>
parents:
64966
diff
changeset
|
281 |
by pat_completeness simp_all |
b149abe619f7
added shuffle product to HOL/List
eberlm <eberlm@in.tum.de>
parents:
64966
diff
changeset
|
282 |
termination by lexicographic_order |
b149abe619f7
added shuffle product to HOL/List
eberlm <eberlm@in.tum.de>
parents:
64966
diff
changeset
|
283 |
|
69593 | 284 |
text\<open>Use only if you cannot use \<^const>\<open>Min\<close> instead:\<close> |
67170 | 285 |
fun min_list :: "'a::ord list \<Rightarrow> 'a" where |
286 |
"min_list (x # xs) = (case xs of [] \<Rightarrow> x | _ \<Rightarrow> min x (min_list xs))" |
|
287 |
||
288 |
text\<open>Returns first minimum:\<close> |
|
289 |
fun arg_min_list :: "('a \<Rightarrow> ('b::linorder)) \<Rightarrow> 'a list \<Rightarrow> 'a" where |
|
290 |
"arg_min_list f [x] = x" | |
|
291 |
"arg_min_list f (x#y#zs) = (let m = arg_min_list f (y#zs) in if f x \<le> f m then x else m)" |
|
292 |
||
60758 | 293 |
text\<open> |
26771 | 294 |
\begin{figure}[htbp] |
295 |
\fbox{ |
|
296 |
\begin{tabular}{l} |
|
27381 | 297 |
@{lemma "[a,b]@[c,d] = [a,b,c,d]" by simp}\\ |
298 |
@{lemma "length [a,b,c] = 3" by simp}\\ |
|
299 |
@{lemma "set [a,b,c] = {a,b,c}" by simp}\\ |
|
300 |
@{lemma "map f [a,b,c] = [f a, f b, f c]" by simp}\\ |
|
301 |
@{lemma "rev [a,b,c] = [c,b,a]" by simp}\\ |
|
302 |
@{lemma "hd [a,b,c,d] = a" by simp}\\ |
|
303 |
@{lemma "tl [a,b,c,d] = [b,c,d]" by simp}\\ |
|
304 |
@{lemma "last [a,b,c,d] = d" by simp}\\ |
|
305 |
@{lemma "butlast [a,b,c,d] = [a,b,c]" by simp}\\ |
|
306 |
@{lemma[source] "filter (\<lambda>n::nat. n<2) [0,2,1] = [0,1]" by simp}\\ |
|
307 |
@{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
|
308 |
@{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
|
309 |
@{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
|
310 |
@{lemma "foldl f x [a,b,c] = f (f (f x a) b) c" by simp}\\ |
71779 | 311 |
@{lemma "successively (\<noteq>) [True,False,True,False]" by simp}\\ |
27381 | 312 |
@{lemma "zip [a,b,c] [x,y,z] = [(a,x),(b,y),(c,z)]" by simp}\\ |
313 |
@{lemma "zip [a,b] [x,y,z] = [(a,x),(b,y)]" by simp}\\ |
|
51173 | 314 |
@{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
|
315 |
@{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
|
316 |
@{lemma "product_lists [[a,b], [c], [d,e]] = [[a,c,d], [a,c,e], [b,c,d], [b,c,e]]" by simp}\\ |
27381 | 317 |
@{lemma "splice [a,b,c] [x,y,z] = [a,x,b,y,c,z]" by simp}\\ |
318 |
@{lemma "splice [a,b,c,d] [x,y] = [a,x,b,y,c,d]" by simp}\\ |
|
69107 | 319 |
@{lemma "shuffles [a,b] [c,d] = {[a,b,c,d],[a,c,b,d],[a,c,d,b],[c,a,b,d],[c,a,d,b],[c,d,a,b]}" |
65350
b149abe619f7
added shuffle product to HOL/List
eberlm <eberlm@in.tum.de>
parents:
64966
diff
changeset
|
320 |
by (simp add: insert_commute)}\\ |
27381 | 321 |
@{lemma "take 2 [a,b,c,d] = [a,b]" by simp}\\ |
322 |
@{lemma "take 6 [a,b,c,d] = [a,b,c,d]" by simp}\\ |
|
323 |
@{lemma "drop 2 [a,b,c,d] = [c,d]" by simp}\\ |
|
324 |
@{lemma "drop 6 [a,b,c,d] = []" by simp}\\ |
|
325 |
@{lemma "takeWhile (%n::nat. n<3) [1,2,3,0] = [1,2]" by simp}\\ |
|
326 |
@{lemma "dropWhile (%n::nat. n<3) [1,2,3,0] = [3,0]" by simp}\\ |
|
327 |
@{lemma "distinct [2,0,1::nat]" by simp}\\ |
|
328 |
@{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
|
329 |
@{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
|
330 |
@{lemma "List.insert 2 [0::nat,1,2] = [0,1,2]" by (simp add: List.insert_def)}\\ |
35295 | 331 |
@{lemma "List.insert 3 [0::nat,1,2] = [3,0,1,2]" by (simp add: List.insert_def)}\\ |
57198 | 332 |
@{lemma "List.union [2,3,4] [0::int,1,2] = [4,3,0,1,2]" by (simp add: List.insert_def List.union_def)}\\ |
47122 | 333 |
@{lemma "List.find (%i::int. i>0) [0,0] = None" by simp}\\ |
334 |
@{lemma "List.find (%i::int. i>0) [0,1,0,2] = Some 1" by simp}\\ |
|
60541 | 335 |
@{lemma "count_list [0,1,0,2::int] 0 = 2" by (simp)}\\ |
55807 | 336 |
@{lemma "List.extract (%i::int. i>0) [0,0] = None" by(simp add: extract_def)}\\ |
337 |
@{lemma "List.extract (%i::int. i>0) [0,1,0,2] = Some([0], 1, [0,2])" by(simp add: extract_def)}\\ |
|
27381 | 338 |
@{lemma "remove1 2 [2,0,2,1::nat,2] = [0,2,1,2]" by simp}\\ |
27693 | 339 |
@{lemma "removeAll 2 [2,0,2,1::nat,2] = [0,1]" by simp}\\ |
27381 | 340 |
@{lemma "nth [a,b,c,d] 2 = c" by simp}\\ |
341 |
@{lemma "[a,b,c,d][2 := x] = [a,b,x,d]" by simp}\\ |
|
65956
639eb3617a86
reorganised material on sublists
eberlm <eberlm@in.tum.de>
parents:
65350
diff
changeset
|
342 |
@{lemma "nths [a,b,c,d,e] {0,2,3} = [a,c,d]" by (simp add:nths_def)}\\ |
639eb3617a86
reorganised material on sublists
eberlm <eberlm@in.tum.de>
parents:
65350
diff
changeset
|
343 |
@{lemma "subseqs [a,b] = [[a, b], [a], [b], []]" by simp}\\ |
49948
744934b818c7
moved quite generic material from theory Enum to more appropriate places
haftmann
parents:
49808
diff
changeset
|
344 |
@{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
|
345 |
@{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
|
346 |
@{lemma "rotate 3 [a,b,c,d] = [d,a,b,c]" by (simp add:rotate_def eval_nat_numeral)}\\ |
40077 | 347 |
@{lemma "replicate 4 a = [a,a,a,a]" by (simp add:eval_nat_numeral)}\\ |
67170 | 348 |
@{lemma "[2..<5] = [2,3,4]" by (simp add:eval_nat_numeral)}\\ |
349 |
@{lemma "min_list [3,1,-2::int] = -2" by (simp)}\\ |
|
350 |
@{lemma "arg_min_list (\<lambda>i. i*i) [3,-1,1,-2::int] = -1" by (simp)} |
|
26771 | 351 |
\end{tabular}} |
352 |
\caption{Characteristic examples} |
|
353 |
\label{fig:Characteristic} |
|
354 |
\end{figure} |
|
29927 | 355 |
Figure~\ref{fig:Characteristic} shows characteristic examples |
26771 | 356 |
that should give an intuitive understanding of the above functions. |
60758 | 357 |
\<close> |
358 |
||
71779 | 359 |
text\<open>The following simple sort(ed) functions are intended for proofs, |
60758 | 360 |
not for efficient implementations.\<close> |
24616 | 361 |
|
66434
5d7e770c7d5d
added sorted_wrt to List; added Data_Structures/Binomial_Heap.thy
nipkow
parents:
66358
diff
changeset
|
362 |
text \<open>A sorted predicate w.r.t. a relation:\<close> |
5d7e770c7d5d
added sorted_wrt to List; added Data_Structures/Binomial_Heap.thy
nipkow
parents:
66358
diff
changeset
|
363 |
|
5d7e770c7d5d
added sorted_wrt to List; added Data_Structures/Binomial_Heap.thy
nipkow
parents:
66358
diff
changeset
|
364 |
fun sorted_wrt :: "('a \<Rightarrow> 'a \<Rightarrow> bool) \<Rightarrow> 'a list \<Rightarrow> bool" where |
5d7e770c7d5d
added sorted_wrt to List; added Data_Structures/Binomial_Heap.thy
nipkow
parents:
66358
diff
changeset
|
365 |
"sorted_wrt P [] = True" | |
68109 | 366 |
"sorted_wrt P (x # ys) = ((\<forall>y \<in> set ys. P x y) \<and> sorted_wrt P ys)" |
66434
5d7e770c7d5d
added sorted_wrt to List; added Data_Structures/Binomial_Heap.thy
nipkow
parents:
66358
diff
changeset
|
367 |
|
5d7e770c7d5d
added sorted_wrt to List; added Data_Structures/Binomial_Heap.thy
nipkow
parents:
66358
diff
changeset
|
368 |
text \<open>A class-based sorted predicate:\<close> |
5d7e770c7d5d
added sorted_wrt to List; added Data_Structures/Binomial_Heap.thy
nipkow
parents:
66358
diff
changeset
|
369 |
|
25221
5ded95dda5df
append/member: more light-weight way to declare authentic syntax;
wenzelm
parents:
25215
diff
changeset
|
370 |
context linorder |
5ded95dda5df
append/member: more light-weight way to declare authentic syntax;
wenzelm
parents:
25215
diff
changeset
|
371 |
begin |
67479 | 372 |
|
373 |
fun sorted :: "'a list \<Rightarrow> bool" where |
|
374 |
"sorted [] = True" | |
|
68109 | 375 |
"sorted (x # ys) = ((\<forall>y \<in> set ys. x \<le> y) \<and> sorted ys)" |
67479 | 376 |
|
71404
f2b783abfbe7
A few lemmas connected with orderings
paulson <lp15@cam.ac.uk>
parents:
71393
diff
changeset
|
377 |
fun strict_sorted :: "'a list \<Rightarrow> bool" where |
f2b783abfbe7
A few lemmas connected with orderings
paulson <lp15@cam.ac.uk>
parents:
71393
diff
changeset
|
378 |
"strict_sorted [] = True" | |
f2b783abfbe7
A few lemmas connected with orderings
paulson <lp15@cam.ac.uk>
parents:
71393
diff
changeset
|
379 |
"strict_sorted (x # ys) = ((\<forall>y \<in> List.set ys. x < y) \<and> strict_sorted ys)" |
f2b783abfbe7
A few lemmas connected with orderings
paulson <lp15@cam.ac.uk>
parents:
71393
diff
changeset
|
380 |
|
67479 | 381 |
lemma sorted_sorted_wrt: "sorted = sorted_wrt (\<le>)" |
382 |
proof (rule ext) |
|
383 |
fix xs show "sorted xs = sorted_wrt (\<le>) xs" |
|
384 |
by(induction xs rule: sorted.induct) auto |
|
385 |
qed |
|
24697 | 386 |
|
71404
f2b783abfbe7
A few lemmas connected with orderings
paulson <lp15@cam.ac.uk>
parents:
71393
diff
changeset
|
387 |
lemma strict_sorted_sorted_wrt: "strict_sorted = sorted_wrt (<)" |
f2b783abfbe7
A few lemmas connected with orderings
paulson <lp15@cam.ac.uk>
parents:
71393
diff
changeset
|
388 |
proof (rule ext) |
f2b783abfbe7
A few lemmas connected with orderings
paulson <lp15@cam.ac.uk>
parents:
71393
diff
changeset
|
389 |
fix xs show "strict_sorted xs = sorted_wrt (<) xs" |
f2b783abfbe7
A few lemmas connected with orderings
paulson <lp15@cam.ac.uk>
parents:
71393
diff
changeset
|
390 |
by(induction xs rule: strict_sorted.induct) auto |
f2b783abfbe7
A few lemmas connected with orderings
paulson <lp15@cam.ac.uk>
parents:
71393
diff
changeset
|
391 |
qed |
f2b783abfbe7
A few lemmas connected with orderings
paulson <lp15@cam.ac.uk>
parents:
71393
diff
changeset
|
392 |
|
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
|
393 |
primrec insort_key :: "('b \<Rightarrow> 'a) \<Rightarrow> 'b \<Rightarrow> 'b list \<Rightarrow> 'b list" where |
72095
cfb6c22a5636
lemmas about sets and the enumerate operator
paulson <lp15@cam.ac.uk>
parents:
71991
diff
changeset
|
394 |
"insort_key f x [] = [x]" | |
cfb6c22a5636
lemmas about sets and the enumerate operator
paulson <lp15@cam.ac.uk>
parents:
71991
diff
changeset
|
395 |
"insort_key f x (y#ys) = |
50548 | 396 |
(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
|
397 |
|
35195 | 398 |
definition sort_key :: "('b \<Rightarrow> 'a) \<Rightarrow> 'b list \<Rightarrow> 'b list" where |
72095
cfb6c22a5636
lemmas about sets and the enumerate operator
paulson <lp15@cam.ac.uk>
parents:
71991
diff
changeset
|
399 |
"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
|
400 |
|
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
|
401 |
definition insort_insert_key :: "('b \<Rightarrow> 'a) \<Rightarrow> 'b \<Rightarrow> 'b list \<Rightarrow> 'b list" where |
72095
cfb6c22a5636
lemmas about sets and the enumerate operator
paulson <lp15@cam.ac.uk>
parents:
71991
diff
changeset
|
402 |
"insort_insert_key f x xs = |
50548 | 403 |
(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
|
404 |
|
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
|
405 |
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
|
406 |
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
|
407 |
abbreviation "insort_insert \<equiv> insort_insert_key (\<lambda>x. x)" |
35608 | 408 |
|
67684 | 409 |
definition stable_sort_key :: "(('b \<Rightarrow> 'a) \<Rightarrow> 'b list \<Rightarrow> 'b list) \<Rightarrow> bool" where |
72095
cfb6c22a5636
lemmas about sets and the enumerate operator
paulson <lp15@cam.ac.uk>
parents:
71991
diff
changeset
|
410 |
"stable_sort_key sk = |
67684 | 411 |
(\<forall>f xs k. filter (\<lambda>y. f y = k) (sk f xs) = filter (\<lambda>y. f y = k) xs)" |
412 |
||
71860 | 413 |
lemma strict_sorted_iff: "strict_sorted l \<longleftrightarrow> sorted l \<and> distinct l" |
72095
cfb6c22a5636
lemmas about sets and the enumerate operator
paulson <lp15@cam.ac.uk>
parents:
71991
diff
changeset
|
414 |
by (induction l) (auto iff: antisym_conv1) |
cfb6c22a5636
lemmas about sets and the enumerate operator
paulson <lp15@cam.ac.uk>
parents:
71991
diff
changeset
|
415 |
|
cfb6c22a5636
lemmas about sets and the enumerate operator
paulson <lp15@cam.ac.uk>
parents:
71991
diff
changeset
|
416 |
lemma strict_sorted_imp_sorted: "strict_sorted xs \<Longrightarrow> sorted xs" |
cfb6c22a5636
lemmas about sets and the enumerate operator
paulson <lp15@cam.ac.uk>
parents:
71991
diff
changeset
|
417 |
by (auto simp: strict_sorted_iff) |
71860 | 418 |
|
25221
5ded95dda5df
append/member: more light-weight way to declare authentic syntax;
wenzelm
parents:
25215
diff
changeset
|
419 |
end |
5ded95dda5df
append/member: more light-weight way to declare authentic syntax;
wenzelm
parents:
25215
diff
changeset
|
420 |
|
24616 | 421 |
|
60758 | 422 |
subsubsection \<open>List comprehension\<close> |
423 |
||
424 |
text\<open>Input syntax for Haskell-like list comprehension notation. |
|
61799 | 425 |
Typical example: \<open>[(x,y). x \<leftarrow> xs, y \<leftarrow> ys, x \<noteq> y]\<close>, |
426 |
the list of all pairs of distinct elements from \<open>xs\<close> and \<open>ys\<close>. |
|
427 |
The syntax is as in Haskell, except that \<open>|\<close> becomes a dot |
|
428 |
(like in Isabelle's set comprehension): \<open>[e. x \<leftarrow> xs, \<dots>]\<close> rather than |
|
24349 | 429 |
\verb![e| x <- xs, ...]!. |
430 |
||
431 |
The qualifiers after the dot are |
|
432 |
\begin{description} |
|
61799 | 433 |
\item[generators] \<open>p \<leftarrow> xs\<close>, |
434 |
where \<open>p\<close> is a pattern and \<open>xs\<close> an expression of list type, or |
|
435 |
\item[guards] \<open>b\<close>, where \<open>b\<close> is a boolean expression. |
|
24476
f7ad9fbbeeaa
turned list comprehension translations into ML to optimize base case
nipkow
parents:
24471
diff
changeset
|
436 |
%\item[local bindings] @ {text"let x = e"}. |
24349 | 437 |
\end{description} |
23240 | 438 |
|
24476
f7ad9fbbeeaa
turned list comprehension translations into ML to optimize base case
nipkow
parents:
24471
diff
changeset
|
439 |
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
|
440 |
misunderstandings, the translation into desugared form is not reversed |
61799 | 441 |
upon output. Note that the translation of \<open>[e. x \<leftarrow> xs]\<close> is |
69593 | 442 |
optmized to \<^term>\<open>map (%x. e) xs\<close>. |
23240 | 443 |
|
24349 | 444 |
It is easy to write short list comprehensions which stand for complex |
445 |
expressions. During proofs, they may become unreadable (and |
|
446 |
mangled). In such cases it can be advisable to introduce separate |
|
60758 | 447 |
definitions for the list comprehensions in question.\<close> |
24349 | 448 |
|
46138
85f8d8a8c711
improved list comprehension syntax: more careful treatment of position constraints, which enables PIDE markup;
wenzelm
parents:
46133
diff
changeset
|
449 |
nonterminal lc_qual and lc_quals |
23192 | 450 |
|
451 |
syntax |
|
46138
85f8d8a8c711
improved list comprehension syntax: more careful treatment of position constraints, which enables PIDE markup;
wenzelm
parents:
46133
diff
changeset
|
452 |
"_listcompr" :: "'a \<Rightarrow> lc_qual \<Rightarrow> lc_quals \<Rightarrow> 'a list" ("[_ . __") |
61955
e96292f32c3c
former "xsymbols" syntax is used by default, and ASCII replacement syntax with print mode "ASCII";
wenzelm
parents:
61941
diff
changeset
|
453 |
"_lc_gen" :: "'a \<Rightarrow> 'a list \<Rightarrow> lc_qual" ("_ \<leftarrow> _") |
46138
85f8d8a8c711
improved list comprehension syntax: more careful treatment of position constraints, which enables PIDE markup;
wenzelm
parents:
46133
diff
changeset
|
454 |
"_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
|
455 |
(*"_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
|
456 |
"_lc_end" :: "lc_quals" ("]") |
85f8d8a8c711
improved list comprehension syntax: more careful treatment of position constraints, which enables PIDE markup;
wenzelm
parents:
46133
diff
changeset
|
457 |
"_lc_quals" :: "lc_qual \<Rightarrow> lc_quals \<Rightarrow> lc_quals" (", __") |
23192 | 458 |
|
61955
e96292f32c3c
former "xsymbols" syntax is used by default, and ASCII replacement syntax with print mode "ASCII";
wenzelm
parents:
61941
diff
changeset
|
459 |
syntax (ASCII) |
e96292f32c3c
former "xsymbols" syntax is used by default, and ASCII replacement syntax with print mode "ASCII";
wenzelm
parents:
61941
diff
changeset
|
460 |
"_lc_gen" :: "'a \<Rightarrow> 'a list \<Rightarrow> lc_qual" ("_ <- _") |
e96292f32c3c
former "xsymbols" syntax is used by default, and ASCII replacement syntax with print mode "ASCII";
wenzelm
parents:
61941
diff
changeset
|
461 |
|
60758 | 462 |
parse_translation \<open> |
68362 | 463 |
let |
69593 | 464 |
val NilC = Syntax.const \<^const_syntax>\<open>Nil\<close>; |
465 |
val ConsC = Syntax.const \<^const_syntax>\<open>Cons\<close>; |
|
466 |
val mapC = Syntax.const \<^const_syntax>\<open>map\<close>; |
|
467 |
val concatC = Syntax.const \<^const_syntax>\<open>concat\<close>; |
|
468 |
val IfC = Syntax.const \<^const_syntax>\<open>If\<close>; |
|
469 |
val dummyC = Syntax.const \<^const_syntax>\<open>Pure.dummy_pattern\<close> |
|
68362 | 470 |
|
471 |
fun single x = ConsC $ x $ NilC; |
|
472 |
||
473 |
fun pat_tr ctxt p e opti = (* %x. case x of p => e | _ => [] *) |
|
474 |
let |
|
475 |
(* FIXME proper name context!? *) |
|
476 |
val x = |
|
477 |
Free (singleton (Name.variant_list (fold Term.add_free_names [p, e] [])) "x", dummyT); |
|
478 |
val e = if opti then single e else e; |
|
69593 | 479 |
val case1 = Syntax.const \<^syntax_const>\<open>_case1\<close> $ p $ e; |
68362 | 480 |
val case2 = |
69593 | 481 |
Syntax.const \<^syntax_const>\<open>_case1\<close> $ dummyC $ NilC; |
482 |
val cs = Syntax.const \<^syntax_const>\<open>_case2\<close> $ case1 $ case2; |
|
68362 | 483 |
in Syntax_Trans.abs_tr [x, Case_Translation.case_tr false ctxt [x, cs]] end; |
484 |
||
485 |
fun pair_pat_tr (x as Free _) e = Syntax_Trans.abs_tr [x, e] |
|
486 |
| pair_pat_tr (_ $ p1 $ p2) e = |
|
69593 | 487 |
Syntax.const \<^const_syntax>\<open>case_prod\<close> $ pair_pat_tr p1 (pair_pat_tr p2 e) |
68362 | 488 |
| pair_pat_tr dummy e = Syntax_Trans.abs_tr [Syntax.const "_idtdummy", e] |
489 |
||
69593 | 490 |
fun pair_pat ctxt (Const (\<^const_syntax>\<open>Pair\<close>,_) $ s $ t) = |
68362 | 491 |
pair_pat ctxt s andalso pair_pat ctxt t |
492 |
| pair_pat ctxt (Free (s,_)) = |
|
493 |
let |
|
494 |
val thy = Proof_Context.theory_of ctxt; |
|
495 |
val s' = Proof_Context.intern_const ctxt s; |
|
496 |
in not (Sign.declared_const thy s') end |
|
497 |
| pair_pat _ t = (t = dummyC); |
|
498 |
||
499 |
fun abs_tr ctxt p e opti = |
|
500 |
let val p = Term_Position.strip_positions p |
|
501 |
in if pair_pat ctxt p |
|
502 |
then (pair_pat_tr p e, true) |
|
503 |
else (pat_tr ctxt p e opti, false) |
|
504 |
end |
|
505 |
||
69593 | 506 |
fun lc_tr ctxt [e, Const (\<^syntax_const>\<open>_lc_test\<close>, _) $ b, qs] = |
68362 | 507 |
let |
508 |
val res = |
|
509 |
(case qs of |
|
69593 | 510 |
Const (\<^syntax_const>\<open>_lc_end\<close>, _) => single e |
511 |
| Const (\<^syntax_const>\<open>_lc_quals\<close>, _) $ q $ qs => lc_tr ctxt [e, q, qs]); |
|
68362 | 512 |
in IfC $ b $ res $ NilC end |
513 |
| lc_tr ctxt |
|
69593 | 514 |
[e, Const (\<^syntax_const>\<open>_lc_gen\<close>, _) $ p $ es, |
515 |
Const(\<^syntax_const>\<open>_lc_end\<close>, _)] = |
|
68362 | 516 |
(case abs_tr ctxt p e true of |
517 |
(f, true) => mapC $ f $ es |
|
518 |
| (f, false) => concatC $ (mapC $ f $ es)) |
|
519 |
| lc_tr ctxt |
|
69593 | 520 |
[e, Const (\<^syntax_const>\<open>_lc_gen\<close>, _) $ p $ es, |
521 |
Const (\<^syntax_const>\<open>_lc_quals\<close>, _) $ q $ qs] = |
|
68362 | 522 |
let val e' = lc_tr ctxt [e, q, qs]; |
523 |
in concatC $ (mapC $ (fst (abs_tr ctxt p e' false)) $ es) end; |
|
524 |
||
69593 | 525 |
in [(\<^syntax_const>\<open>_listcompr\<close>, lc_tr)] end |
60758 | 526 |
\<close> |
527 |
||
528 |
ML_val \<open> |
|
42167 | 529 |
let |
69593 | 530 |
val read = Syntax.read_term \<^context> o Syntax.implode_input; |
60160 | 531 |
fun check s1 s2 = |
532 |
read s1 aconv read s2 orelse |
|
533 |
error ("Check failed: " ^ |
|
69349
7cef9e386ffe
more accurate positions for "name" (quoted string) and "embedded" (cartouche): refer to content without delimiters, which is e.g. relevant for systematic selection/renaming of scope groups;
wenzelm
parents:
69312
diff
changeset
|
534 |
quote (#1 (Input.source_content s1)) ^ Position.here_list [Input.pos_of s1, Input.pos_of s2]); |
42167 | 535 |
in |
60160 | 536 |
check \<open>[(x,y,z). b]\<close> \<open>if b then [(x, y, z)] else []\<close>; |
68362 | 537 |
check \<open>[(x,y,z). (x,_,y)\<leftarrow>xs]\<close> \<open>map (\<lambda>(x,_,y). (x, y, z)) xs\<close>; |
538 |
check \<open>[e x y. (x,_)\<leftarrow>xs, y\<leftarrow>ys]\<close> \<open>concat (map (\<lambda>(x,_). map (\<lambda>y. e x y) ys) xs)\<close>; |
|
60160 | 539 |
check \<open>[(x,y,z). x<a, x>b]\<close> \<open>if x < a then if b < x then [(x, y, z)] else [] else []\<close>; |
540 |
check \<open>[(x,y,z). x\<leftarrow>xs, x>b]\<close> \<open>concat (map (\<lambda>x. if b < x then [(x, y, z)] else []) xs)\<close>; |
|
541 |
check \<open>[(x,y,z). x<a, x\<leftarrow>xs]\<close> \<open>if x < a then map (\<lambda>x. (x, y, z)) xs else []\<close>; |
|
542 |
check \<open>[(x,y). Cons True x \<leftarrow> xs]\<close> |
|
543 |
\<open>concat (map (\<lambda>xa. case xa of [] \<Rightarrow> [] | True # x \<Rightarrow> [(x, y)] | False # x \<Rightarrow> []) xs)\<close>; |
|
544 |
check \<open>[(x,y,z). Cons x [] \<leftarrow> xs]\<close> |
|
545 |
\<open>concat (map (\<lambda>xa. case xa of [] \<Rightarrow> [] | [x] \<Rightarrow> [(x, y, z)] | x # aa # lista \<Rightarrow> []) xs)\<close>; |
|
546 |
check \<open>[(x,y,z). x<a, x>b, x=d]\<close> |
|
547 |
\<open>if x < a then if b < x then if x = d then [(x, y, z)] else [] else [] else []\<close>; |
|
548 |
check \<open>[(x,y,z). x<a, x>b, y\<leftarrow>ys]\<close> |
|
549 |
\<open>if x < a then if b < x then map (\<lambda>y. (x, y, z)) ys else [] else []\<close>; |
|
68362 | 550 |
check \<open>[(x,y,z). x<a, (_,x)\<leftarrow>xs,y>b]\<close> |
551 |
\<open>if x < a then concat (map (\<lambda>(_,x). if b < y then [(x, y, z)] else []) xs) else []\<close>; |
|
60160 | 552 |
check \<open>[(x,y,z). x<a, x\<leftarrow>xs, y\<leftarrow>ys]\<close> |
553 |
\<open>if x < a then concat (map (\<lambda>x. map (\<lambda>y. (x, y, z)) ys) xs) else []\<close>; |
|
554 |
check \<open>[(x,y,z). x\<leftarrow>xs, x>b, y<a]\<close> |
|
555 |
\<open>concat (map (\<lambda>x. if b < x then if y < a then [(x, y, z)] else [] else []) xs)\<close>; |
|
556 |
check \<open>[(x,y,z). x\<leftarrow>xs, x>b, y\<leftarrow>ys]\<close> |
|
557 |
\<open>concat (map (\<lambda>x. if b < x then map (\<lambda>y. (x, y, z)) ys else []) xs)\<close>; |
|
68362 | 558 |
check \<open>[(x,y,z). x\<leftarrow>xs, (y,_)\<leftarrow>ys,y>x]\<close> |
559 |
\<open>concat (map (\<lambda>x. concat (map (\<lambda>(y,_). if x < y then [(x, y, z)] else []) ys)) xs)\<close>; |
|
60160 | 560 |
check \<open>[(x,y,z). x\<leftarrow>xs, y\<leftarrow>ys,z\<leftarrow>zs]\<close> |
561 |
\<open>concat (map (\<lambda>x. concat (map (\<lambda>y. map (\<lambda>z. (x, y, z)) zs) ys)) xs)\<close> |
|
42167 | 562 |
end; |
60758 | 563 |
\<close> |
42167 | 564 |
|
60758 | 565 |
ML \<open> |
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 |
(* 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
|
567 |
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
|
568 |
|
ee729dbd1b7f
avoid ML_file in large theory files to improve performance of dependency 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 |
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
|
570 |
sig |
51717
9e7d1c139569
simplifier uses proper Proof.context instead of historic type simpset;
wenzelm
parents:
51678
diff
changeset
|
571 |
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
|
572 |
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
|
573 |
|
ee729dbd1b7f
avoid ML_file in large theory files to improve performance of dependency 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 |
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
|
575 |
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
|
576 |
|
ee729dbd1b7f
avoid ML_file in large theory files to improve performance of dependency discovery of main HOL (approx. 1s CPU time) -- relevant for any application using it, e.g. small paper sessions;
wenzelm
parents:
50134
diff
changeset
|
577 |
(* 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
|
578 |
|
ee729dbd1b7f
avoid ML_file in large theory files to improve performance of dependency 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 |
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
|
580 |
(case Thm.term_of ct of |
69593 | 581 |
Const (\<^const_name>\<open>Ex\<close>, _) $ Abs _ => |
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
|
582 |
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
|
583 |
| _ => 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
|
584 |
|
ee729dbd1b7f
avoid ML_file in large theory files to improve performance of dependency 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 |
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
|
586 |
(case Thm.term_of ct of |
69593 | 587 |
Const (\<^const_name>\<open>Ex\<close>, _) $ Abs (_, _, Const (\<^const_name>\<open>Ex\<close>, _) $ _) => |
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
|
588 |
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
|
589 |
| _ => 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
|
590 |
|
ee729dbd1b7f
avoid ML_file in large theory files to improve performance of dependency 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 |
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
|
592 |
(case Thm.term_of ct of |
69593 | 593 |
Const (\<^const_name>\<open>Collect\<close>, _) $ Abs _ => Conv.arg_conv (Conv.abs_conv cv ctxt) 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
|
594 |
| _ => 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
|
595 |
|
ee729dbd1b7f
avoid ML_file in large theory files to improve performance of dependency discovery of main HOL (approx. 1s CPU time) -- relevant for any application using it, e.g. small paper sessions;
wenzelm
parents:
50134
diff
changeset
|
596 |
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
|
597 |
|
ee729dbd1b7f
avoid ML_file in large theory files to improve performance of dependency 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 |
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
|
599 |
Conv.try_conv |
51315
536a5603a138
provide common HOLogic.conj_conv and HOLogic.eq_conv;
wenzelm
parents:
51314
diff
changeset
|
600 |
(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
|
601 |
|
ee729dbd1b7f
avoid ML_file in large theory files to improve performance of dependency 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 |
fun right_hand_set_comprehension_conv conv ctxt = |
51315
536a5603a138
provide common HOLogic.conj_conv and HOLogic.eq_conv;
wenzelm
parents:
51314
diff
changeset
|
603 |
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
|
604 |
(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
|
605 |
|
ee729dbd1b7f
avoid ML_file in large theory files to improve performance of dependency 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 |
|
ee729dbd1b7f
avoid ML_file in large theory files to improve performance of dependency 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 |
(* 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
|
608 |
|
60156 | 609 |
datatype termlets = If | Case of typ * int |
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 |
|
60158 | 611 |
local |
612 |
||
613 |
val set_Nil_I = @{lemma "set [] = {x. False}" by (simp add: empty_def [symmetric])} |
|
614 |
val set_singleton = @{lemma "set [a] = {x. x = a}" by simp} |
|
615 |
val inst_Collect_mem_eq = @{lemma "set A = {x. x \<in> set A}" by simp} |
|
616 |
val del_refl_eq = @{lemma "(t = t \<and> P) \<equiv> P" by simp} |
|
617 |
||
69593 | 618 |
fun mk_set T = Const (\<^const_name>\<open>set\<close>, HOLogic.listT T --> HOLogic.mk_setT T) |
619 |
fun dest_set (Const (\<^const_name>\<open>set\<close>, _) $ xs) = xs |
|
620 |
||
621 |
fun dest_singleton_list (Const (\<^const_name>\<open>Cons\<close>, _) $ t $ (Const (\<^const_name>\<open>Nil\<close>, _))) = t |
|
60158 | 622 |
| dest_singleton_list t = raise TERM ("dest_singleton_list", [t]) |
623 |
||
624 |
(*We check that one case returns a singleton list and all other cases |
|
625 |
return [], and return the index of the one singleton list case.*) |
|
626 |
fun possible_index_of_singleton_case cases = |
|
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
|
627 |
let |
60158 | 628 |
fun check (i, case_t) s = |
629 |
(case strip_abs_body case_t of |
|
69593 | 630 |
(Const (\<^const_name>\<open>Nil\<close>, _)) => s |
60158 | 631 |
| _ => (case s of SOME NONE => SOME (SOME i) | _ => NONE)) |
632 |
in |
|
633 |
fold_index check cases (SOME NONE) |> the_default NONE |
|
634 |
end |
|
635 |
||
636 |
(*returns condition continuing term option*) |
|
69593 | 637 |
fun dest_if (Const (\<^const_name>\<open>If\<close>, _) $ cond $ then_t $ Const (\<^const_name>\<open>Nil\<close>, _)) = |
60158 | 638 |
SOME (cond, then_t) |
639 |
| dest_if _ = NONE |
|
640 |
||
641 |
(*returns (case_expr type index chosen_case constr_name) option*) |
|
642 |
fun dest_case ctxt case_term = |
|
643 |
let |
|
644 |
val (case_const, args) = strip_comb case_term |
|
645 |
in |
|
646 |
(case try dest_Const case_const of |
|
647 |
SOME (c, T) => |
|
648 |
(case Ctr_Sugar.ctr_sugar_of_case ctxt c of |
|
649 |
SOME {ctrs, ...} => |
|
650 |
(case possible_index_of_singleton_case (fst (split_last args)) of |
|
651 |
SOME i => |
|
652 |
let |
|
653 |
val constr_names = map (fst o dest_Const) ctrs |
|
654 |
val (Ts, _) = strip_type T |
|
655 |
val T' = List.last Ts |
|
656 |
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
|
657 |
| 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
|
658 |
| NONE => NONE) |
60158 | 659 |
| NONE => NONE) |
660 |
end |
|
661 |
||
60752 | 662 |
fun tac ctxt [] = |
663 |
resolve_tac ctxt [set_singleton] 1 ORELSE |
|
664 |
resolve_tac ctxt [inst_Collect_mem_eq] 1 |
|
60158 | 665 |
| tac ctxt (If :: cont) = |
62390 | 666 |
Splitter.split_tac ctxt @{thms if_split} 1 |
60752 | 667 |
THEN resolve_tac ctxt @{thms conjI} 1 |
668 |
THEN resolve_tac ctxt @{thms impI} 1 |
|
60159
879918f4ee0f
tuned -- avoid odd rebinding of "ctxt" and "context";
wenzelm
parents:
60158
diff
changeset
|
669 |
THEN Subgoal.FOCUS (fn {prems, context = ctxt', ...} => |
60158 | 670 |
CONVERSION (right_hand_set_comprehension_conv (K |
671 |
(HOLogic.conj_conv (Conv.rewr_conv (List.last prems RS @{thm Eq_TrueI})) Conv.all_conv |
|
672 |
then_conv |
|
60159
879918f4ee0f
tuned -- avoid odd rebinding of "ctxt" and "context";
wenzelm
parents:
60158
diff
changeset
|
673 |
rewr_conv' @{lemma "(True \<and> P) = P" by simp})) ctxt') 1) ctxt 1 |
60158 | 674 |
THEN tac ctxt cont |
60752 | 675 |
THEN resolve_tac ctxt @{thms impI} 1 |
60159
879918f4ee0f
tuned -- avoid odd rebinding of "ctxt" and "context";
wenzelm
parents:
60158
diff
changeset
|
676 |
THEN Subgoal.FOCUS (fn {prems, context = ctxt', ...} => |
60158 | 677 |
CONVERSION (right_hand_set_comprehension_conv (K |
678 |
(HOLogic.conj_conv (Conv.rewr_conv (List.last prems RS @{thm Eq_FalseI})) Conv.all_conv |
|
60159
879918f4ee0f
tuned -- avoid odd rebinding of "ctxt" and "context";
wenzelm
parents:
60158
diff
changeset
|
679 |
then_conv rewr_conv' @{lemma "(False \<and> P) = False" by simp})) ctxt') 1) ctxt 1 |
60752 | 680 |
THEN resolve_tac ctxt [set_Nil_I] 1 |
60158 | 681 |
| tac ctxt (Case (T, i) :: cont) = |
682 |
let |
|
683 |
val SOME {injects, distincts, case_thms, split, ...} = |
|
684 |
Ctr_Sugar.ctr_sugar_of ctxt (fst (dest_Type T)) |
|
685 |
in |
|
686 |
(* do case distinction *) |
|
687 |
Splitter.split_tac ctxt [split] 1 |
|
688 |
THEN EVERY (map_index (fn (i', _) => |
|
60752 | 689 |
(if i' < length case_thms - 1 then resolve_tac ctxt @{thms conjI} 1 else all_tac) |
690 |
THEN REPEAT_DETERM (resolve_tac ctxt @{thms allI} 1) |
|
691 |
THEN resolve_tac ctxt @{thms impI} 1 |
|
60158 | 692 |
THEN (if i' = i then |
693 |
(* continue recursively *) |
|
60159
879918f4ee0f
tuned -- avoid odd rebinding of "ctxt" and "context";
wenzelm
parents:
60158
diff
changeset
|
694 |
Subgoal.FOCUS (fn {prems, context = ctxt', ...} => |
60158 | 695 |
CONVERSION (Thm.eta_conversion then_conv right_hand_set_comprehension_conv (K |
696 |
((HOLogic.conj_conv |
|
697 |
(HOLogic.eq_conv Conv.all_conv (rewr_conv' (List.last prems)) then_conv |
|
698 |
(Conv.try_conv (Conv.rewrs_conv (map mk_meta_eq injects)))) |
|
699 |
Conv.all_conv) |
|
700 |
then_conv (Conv.try_conv (Conv.rewr_conv del_refl_eq)) |
|
60159
879918f4ee0f
tuned -- avoid odd rebinding of "ctxt" and "context";
wenzelm
parents:
60158
diff
changeset
|
701 |
then_conv conjunct_assoc_conv)) ctxt' |
879918f4ee0f
tuned -- avoid odd rebinding of "ctxt" and "context";
wenzelm
parents:
60158
diff
changeset
|
702 |
then_conv |
879918f4ee0f
tuned -- avoid odd rebinding of "ctxt" and "context";
wenzelm
parents:
60158
diff
changeset
|
703 |
(HOLogic.Trueprop_conv |
879918f4ee0f
tuned -- avoid odd rebinding of "ctxt" and "context";
wenzelm
parents:
60158
diff
changeset
|
704 |
(HOLogic.eq_conv Conv.all_conv (Collect_conv (fn (_, ctxt'') => |
879918f4ee0f
tuned -- avoid odd rebinding of "ctxt" and "context";
wenzelm
parents:
60158
diff
changeset
|
705 |
Conv.repeat_conv |
879918f4ee0f
tuned -- avoid odd rebinding of "ctxt" and "context";
wenzelm
parents:
60158
diff
changeset
|
706 |
(all_but_last_exists_conv |
879918f4ee0f
tuned -- avoid odd rebinding of "ctxt" and "context";
wenzelm
parents:
60158
diff
changeset
|
707 |
(K (rewr_conv' |
879918f4ee0f
tuned -- avoid odd rebinding of "ctxt" and "context";
wenzelm
parents:
60158
diff
changeset
|
708 |
@{lemma "(\<exists>x. x = t \<and> P x) = P t" by simp})) ctxt'')) ctxt')))) 1) ctxt 1 |
60158 | 709 |
THEN tac ctxt cont |
710 |
else |
|
60159
879918f4ee0f
tuned -- avoid odd rebinding of "ctxt" and "context";
wenzelm
parents:
60158
diff
changeset
|
711 |
Subgoal.FOCUS (fn {prems, context = ctxt', ...} => |
60158 | 712 |
CONVERSION |
713 |
(right_hand_set_comprehension_conv (K |
|
714 |
(HOLogic.conj_conv |
|
715 |
((HOLogic.eq_conv Conv.all_conv |
|
716 |
(rewr_conv' (List.last prems))) then_conv |
|
717 |
(Conv.rewrs_conv (map (fn th => th RS @{thm Eq_FalseI}) distincts))) |
|
718 |
Conv.all_conv then_conv |
|
60159
879918f4ee0f
tuned -- avoid odd rebinding of "ctxt" and "context";
wenzelm
parents:
60158
diff
changeset
|
719 |
(rewr_conv' @{lemma "(False \<and> P) = False" by simp}))) ctxt' then_conv |
60158 | 720 |
HOLogic.Trueprop_conv |
721 |
(HOLogic.eq_conv Conv.all_conv |
|
60159
879918f4ee0f
tuned -- avoid odd rebinding of "ctxt" and "context";
wenzelm
parents:
60158
diff
changeset
|
722 |
(Collect_conv (fn (_, ctxt'') => |
60158 | 723 |
Conv.repeat_conv |
724 |
(Conv.bottom_conv |
|
60159
879918f4ee0f
tuned -- avoid odd rebinding of "ctxt" and "context";
wenzelm
parents:
60158
diff
changeset
|
725 |
(K (rewr_conv' @{lemma "(\<exists>x. P) = P" by simp})) ctxt'')) ctxt'))) 1) ctxt 1 |
60752 | 726 |
THEN resolve_tac ctxt [set_Nil_I] 1)) case_thms) |
60158 | 727 |
end |
728 |
||
729 |
in |
|
730 |
||
731 |
fun simproc ctxt redex = |
|
732 |
let |
|
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
|
733 |
fun make_inner_eqs bound_vs Tis eqs t = |
60158 | 734 |
(case dest_case ctxt t of |
54404
9f0f1152c875
port list comprehension simproc to 'Ctr_Sugar' abstraction
blanchet
parents:
54295
diff
changeset
|
735 |
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
|
736 |
let |
52131 | 737 |
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
|
738 |
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
|
739 |
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
|
740 |
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
|
741 |
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
|
742 |
(Const (constr_name, map snd vs ---> T), map Bound (((length vs) - 1) downto 0)) |
69593 | 743 |
val constr_eq = Const (\<^const_name>\<open>HOL.eq\<close>, T --> T --> \<^typ>\<open>bool\<close>) $ constr_t $ x' |
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
|
744 |
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
|
745 |
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
|
746 |
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
|
747 |
| 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
|
748 |
(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
|
749 |
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
|
750 |
| NONE => |
60158 | 751 |
if null eqs then NONE (*no rewriting, nothing to be done*) |
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
|
752 |
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
|
753 |
let |
69593 | 754 |
val Type (\<^type_name>\<open>list\<close>, [rT]) = fastype_of1 (map snd bound_vs, 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
|
755 |
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
|
756 |
(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
|
757 |
SOME t' => |
69593 | 758 |
Const (\<^const_name>\<open>HOL.eq\<close>, rT --> rT --> \<^typ>\<open>bool\<close>) $ |
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
|
759 |
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
|
760 |
| NONE => |
69593 | 761 |
Const (\<^const_name>\<open>Set.member\<close>, rT --> HOLogic.mk_setT rT --> \<^typ>\<open>bool\<close>) $ |
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
|
762 |
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
|
763 |
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
|
764 |
((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
|
765 |
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
|
766 |
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
|
767 |
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
|
768 |
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
|
769 |
(rev bound_vs) (fold (curry HOLogic.mk_conj) eqs' pat_eq') |
59582 | 770 |
val lhs = Thm.term_of 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
|
771 |
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
|
772 |
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
|
773 |
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
|
774 |
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
|
775 |
((Goal.prove ctxt [] [] rewrite_rule_t |
60159
879918f4ee0f
tuned -- avoid odd rebinding of "ctxt" and "context";
wenzelm
parents:
60158
diff
changeset
|
776 |
(fn {context = ctxt', ...} => tac ctxt' (rev Tis))) RS @{thm eq_reflection}) |
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
|
777 |
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
|
778 |
in |
59582 | 779 |
make_inner_eqs [] [] [] (dest_set (Thm.term_of 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
|
780 |
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
|
781 |
|
ee729dbd1b7f
avoid ML_file in large theory files to improve performance of dependency discovery of main HOL (approx. 1s CPU time) -- relevant for any application using it, e.g. small paper sessions;
wenzelm
parents:
50134
diff
changeset
|
782 |
end |
60158 | 783 |
|
784 |
end |
|
60758 | 785 |
\<close> |
41463
edbf0a86fb1c
adding simproc to rewrite list comprehensions to set comprehensions; adopting proofs
bulwahn
parents:
41372
diff
changeset
|
786 |
|
60159
879918f4ee0f
tuned -- avoid odd rebinding of "ctxt" and "context";
wenzelm
parents:
60158
diff
changeset
|
787 |
simproc_setup list_to_set_comprehension ("set xs") = |
60758 | 788 |
\<open>K List_to_Set_Comprehension.simproc\<close> |
41463
edbf0a86fb1c
adding simproc to rewrite list comprehensions to set comprehensions; adopting proofs
bulwahn
parents:
41372
diff
changeset
|
789 |
|
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
|
790 |
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
|
791 |
hide_const (open) coset |
35115 | 792 |
|
49948
744934b818c7
moved quite generic material from theory Enum to more appropriate places
haftmann
parents:
49808
diff
changeset
|
793 |
|
69593 | 794 |
subsubsection \<open>\<^const>\<open>Nil\<close> and \<^const>\<open>Cons\<close>\<close> |
21061
580dfc999ef6
added normal post setup; cleaned up "execution" constants
haftmann
parents:
21046
diff
changeset
|
795 |
|
580dfc999ef6
added normal post setup; cleaned up "execution" constants
haftmann
parents:
21046
diff
changeset
|
796 |
lemma not_Cons_self [simp]: |
580dfc999ef6
added normal post setup; cleaned up "execution" constants
haftmann
parents:
21046
diff
changeset
|
797 |
"xs \<noteq> x # xs" |
13145 | 798 |
by (induct xs) auto |
13114 | 799 |
|
58807 | 800 |
lemma not_Cons_self2 [simp]: "x # xs \<noteq> xs" |
41697 | 801 |
by (rule not_Cons_self [symmetric]) |
13114 | 802 |
|
13142 | 803 |
lemma neq_Nil_conv: "(xs \<noteq> []) = (\<exists>y ys. xs = y # ys)" |
13145 | 804 |
by (induct xs) auto |
13114 | 805 |
|
67091 | 806 |
lemma tl_Nil: "tl xs = [] \<longleftrightarrow> xs = [] \<or> (\<exists>x. xs = [x])" |
53689 | 807 |
by (cases xs) auto |
808 |
||
67091 | 809 |
lemma Nil_tl: "[] = tl xs \<longleftrightarrow> xs = [] \<or> (\<exists>x. xs = [x])" |
53689 | 810 |
by (cases xs) auto |
811 |
||
13142 | 812 |
lemma length_induct: |
21061
580dfc999ef6
added normal post setup; cleaned up "execution" constants
haftmann
parents:
21046
diff
changeset
|
813 |
"(\<And>xs. \<forall>ys. length ys < length xs \<longrightarrow> P ys \<Longrightarrow> P xs) \<Longrightarrow> P xs" |
53689 | 814 |
by (fact measure_induct) |
13114 | 815 |
|
67168 | 816 |
lemma induct_list012: |
70275 | 817 |
"\<lbrakk>P []; \<And>x. P [x]; \<And>x y zs. \<lbrakk> P zs; P (y # zs) \<rbrakk> \<Longrightarrow> P (x # y # zs)\<rbrakk> \<Longrightarrow> P xs" |
67168 | 818 |
by induction_schema (pat_completeness, lexicographic_order) |
819 |
||
37289 | 820 |
lemma list_nonempty_induct [consumes 1, case_names single cons]: |
67168 | 821 |
"\<lbrakk> xs \<noteq> []; \<And>x. P [x]; \<And>x xs. xs \<noteq> [] \<Longrightarrow> P xs \<Longrightarrow> P (x # xs)\<rbrakk> \<Longrightarrow> P xs" |
822 |
by(induction xs rule: induct_list012) auto |
|
37289 | 823 |
|
45714 | 824 |
lemma inj_split_Cons: "inj_on (\<lambda>(xs, n). n#xs) X" |
825 |
by (auto intro!: inj_onI) |
|
13114 | 826 |
|
67399 | 827 |
lemma inj_on_Cons1 [simp]: "inj_on ((#) x) A" |
61630 | 828 |
by(simp add: inj_on_def) |
49948
744934b818c7
moved quite generic material from theory Enum to more appropriate places
haftmann
parents:
49808
diff
changeset
|
829 |
|
69593 | 830 |
subsubsection \<open>\<^const>\<open>length\<close>\<close> |
60758 | 831 |
|
832 |
text \<open> |
|
61799 | 833 |
Needs to come before \<open>@\<close> because of theorem \<open>append_eq_append_conv\<close>. |
60758 | 834 |
\<close> |
13114 | 835 |
|
13142 | 836 |
lemma length_append [simp]: "length (xs @ ys) = length xs + length ys" |
13145 | 837 |
by (induct xs) auto |
13114 | 838 |
|
13142 | 839 |
lemma length_map [simp]: "length (map f xs) = length xs" |
13145 | 840 |
by (induct xs) auto |
13114 | 841 |
|
13142 | 842 |
lemma length_rev [simp]: "length (rev xs) = length xs" |
13145 | 843 |
by (induct xs) auto |
13114 | 844 |
|
13142 | 845 |
lemma length_tl [simp]: "length (tl xs) = length xs - 1" |
13145 | 846 |
by (cases xs) auto |
13114 | 847 |
|
13142 | 848 |
lemma length_0_conv [iff]: "(length xs = 0) = (xs = [])" |
13145 | 849 |
by (induct xs) auto |
13114 | 850 |
|
13142 | 851 |
lemma length_greater_0_conv [iff]: "(0 < length xs) = (xs \<noteq> [])" |
13145 | 852 |
by (induct xs) auto |
13114 | 853 |
|
67613 | 854 |
lemma length_pos_if_in_set: "x \<in> set xs \<Longrightarrow> length xs > 0" |
23479 | 855 |
by auto |
856 |
||
13114 | 857 |
lemma length_Suc_conv: |
13145 | 858 |
"(length xs = Suc n) = (\<exists>y ys. xs = y # ys \<and> length ys = n)" |
859 |
by (induct xs) auto |
|
13142 | 860 |
|
14025 | 861 |
lemma Suc_length_conv: |
58807 | 862 |
"(Suc n = length xs) = (\<exists>y ys. xs = y # ys \<and> length ys = n)" |
68709 | 863 |
by (induct xs; simp; blast) |
864 |
||
69312 | 865 |
lemma Suc_le_length_iff: |
866 |
"(Suc n \<le> length xs) = (\<exists>x ys. xs = x # ys \<and> n \<le> length ys)" |
|
867 |
by (metis Suc_le_D[of n] Suc_le_mono[of n] Suc_length_conv[of _ xs]) |
|
868 |
||
71585 | 869 |
lemma impossible_Cons: "length xs \<le> length ys \<Longrightarrow> xs = x # ys = False" |
58807 | 870 |
by (induct xs) auto |
25221
5ded95dda5df
append/member: more light-weight way to declare authentic syntax;
wenzelm
parents:
25215
diff
changeset
|
871 |
|
26442
57fb6a8b099e
restructuring; explicit case names for rule list_induct2
haftmann
parents:
26300
diff
changeset
|
872 |
lemma list_induct2 [consumes 1, case_names Nil Cons]: |
57fb6a8b099e
restructuring; explicit case names for rule list_induct2
haftmann
parents:
26300
diff
changeset
|
873 |
"length xs = length ys \<Longrightarrow> P [] [] \<Longrightarrow> |
57fb6a8b099e
restructuring; explicit case names for rule list_induct2
haftmann
parents:
26300
diff
changeset
|
874 |
(\<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
|
875 |
\<Longrightarrow> P xs ys" |
57fb6a8b099e
restructuring; explicit case names for rule list_induct2
haftmann
parents:
26300
diff
changeset
|
876 |
proof (induct xs arbitrary: ys) |
57fb6a8b099e
restructuring; explicit case names for rule list_induct2
haftmann
parents:
26300
diff
changeset
|
877 |
case (Cons x xs ys) then show ?case by (cases ys) simp_all |
68709 | 878 |
qed simp |
26442
57fb6a8b099e
restructuring; explicit case names for rule list_induct2
haftmann
parents:
26300
diff
changeset
|
879 |
|
57fb6a8b099e
restructuring; explicit case names for rule list_induct2
haftmann
parents:
26300
diff
changeset
|
880 |
lemma list_induct3 [consumes 2, case_names Nil Cons]: |
57fb6a8b099e
restructuring; explicit case names for rule list_induct2
haftmann
parents:
26300
diff
changeset
|
881 |
"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
|
882 |
(\<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
|
883 |
\<Longrightarrow> P xs ys zs" |
57fb6a8b099e
restructuring; explicit case names for rule list_induct2
haftmann
parents:
26300
diff
changeset
|
884 |
proof (induct xs arbitrary: ys zs) |
57fb6a8b099e
restructuring; explicit case names for rule list_induct2
haftmann
parents:
26300
diff
changeset
|
885 |
case Nil then show ?case by simp |
57fb6a8b099e
restructuring; explicit case names for rule list_induct2
haftmann
parents:
26300
diff
changeset
|
886 |
next |
57fb6a8b099e
restructuring; explicit case names for rule list_induct2
haftmann
parents:
26300
diff
changeset
|
887 |
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
|
888 |
(cases zs, simp_all) |
57fb6a8b099e
restructuring; explicit case names for rule list_induct2
haftmann
parents:
26300
diff
changeset
|
889 |
qed |
13114 | 890 |
|
36154
11c6106d7787
Respectfullness and preservation of list_rel
Cezary Kaliszyk <kaliszyk@in.tum.de>
parents:
35828
diff
changeset
|
891 |
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
|
892 |
"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
|
893 |
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
|
894 |
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
|
895 |
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
|
896 |
proof (induct xs arbitrary: ys zs ws) |
11c6106d7787
Respectfullness and preservation of list_rel
Cezary Kaliszyk <kaliszyk@in.tum.de>
parents:
35828
diff
changeset
|
897 |
case Nil then show ?case by simp |
11c6106d7787
Respectfullness and preservation of list_rel
Cezary Kaliszyk <kaliszyk@in.tum.de>
parents:
35828
diff
changeset
|
898 |
next |
11c6106d7787
Respectfullness and preservation of list_rel
Cezary Kaliszyk <kaliszyk@in.tum.de>
parents:
35828
diff
changeset
|
899 |
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
|
900 |
qed |
11c6106d7787
Respectfullness and preservation of list_rel
Cezary Kaliszyk <kaliszyk@in.tum.de>
parents:
35828
diff
changeset
|
901 |
|
64963 | 902 |
lemma list_induct2': |
22493
db930e490fe5
added another rule for simultaneous induction, and lemmas for zip
krauss
parents:
22422
diff
changeset
|
903 |
"\<lbrakk> P [] []; |
db930e490fe5
added another rule for simultaneous induction, and lemmas for zip
krauss
parents:
22422
diff
changeset
|
904 |
\<And>x xs. P (x#xs) []; |
db930e490fe5
added another rule for simultaneous induction, and lemmas for zip
krauss
parents:
22422
diff
changeset
|
905 |
\<And>y ys. P [] (y#ys); |
db930e490fe5
added another rule for simultaneous induction, and lemmas for zip
krauss
parents:
22422
diff
changeset
|
906 |
\<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
|
907 |
\<Longrightarrow> P xs ys" |
db930e490fe5
added another rule for simultaneous induction, and lemmas for zip
krauss
parents:
22422
diff
changeset
|
908 |
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
|
909 |
|
55524
f41ef840f09d
folded 'list_all2' with the relator generated by 'datatype_new'
blanchet
parents:
55473
diff
changeset
|
910 |
lemma list_all2_iff: |
f41ef840f09d
folded 'list_all2' with the relator generated by 'datatype_new'
blanchet
parents:
55473
diff
changeset
|
911 |
"list_all2 P xs ys \<longleftrightarrow> length xs = length ys \<and> (\<forall>(x, y) \<in> set (zip xs ys). P x y)" |
f41ef840f09d
folded 'list_all2' with the relator generated by 'datatype_new'
blanchet
parents:
55473
diff
changeset
|
912 |
by (induct xs ys rule: list_induct2') auto |
f41ef840f09d
folded 'list_all2' with the relator generated by 'datatype_new'
blanchet
parents:
55473
diff
changeset
|
913 |
|
22143
cf58486ca11b
Added simproc list_neq (prompted by an application)
nipkow
parents:
21911
diff
changeset
|
914 |
lemma neq_if_length_neq: "length xs \<noteq> length ys \<Longrightarrow> (xs = ys) == False" |
24349 | 915 |
by (rule Eq_FalseI) auto |
24037 | 916 |
|
60758 | 917 |
simproc_setup list_neq ("(xs::'a list) = ys") = \<open> |
22143
cf58486ca11b
Added simproc list_neq (prompted by an application)
nipkow
parents:
21911
diff
changeset
|
918 |
(* |
cf58486ca11b
Added simproc list_neq (prompted by an application)
nipkow
parents:
21911
diff
changeset
|
919 |
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
|
920 |
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
|
921 |
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
|
922 |
*) |
24037 | 923 |
|
924 |
let |
|
22143
cf58486ca11b
Added simproc list_neq (prompted by an application)
nipkow
parents:
21911
diff
changeset
|
925 |
|
69593 | 926 |
fun len (Const(\<^const_name>\<open>Nil\<close>,_)) acc = acc |
927 |
| len (Const(\<^const_name>\<open>Cons\<close>,_) $ _ $ xs) (ts,n) = len xs (ts,n+1) |
|
928 |
| len (Const(\<^const_name>\<open>append\<close>,_) $ xs $ ys) acc = len xs (len ys acc) |
|
929 |
| len (Const(\<^const_name>\<open>rev\<close>,_) $ xs) acc = len xs acc |
|
930 |
| len (Const(\<^const_name>\<open>map\<close>,_) $ _ $ xs) acc = len xs acc |
|
22143
cf58486ca11b
Added simproc list_neq (prompted by an application)
nipkow
parents:
21911
diff
changeset
|
931 |
| len t (ts,n) = (t::ts,n); |
cf58486ca11b
Added simproc list_neq (prompted by an application)
nipkow
parents:
21911
diff
changeset
|
932 |
|
69593 | 933 |
val ss = simpset_of \<^context>; |
51717
9e7d1c139569
simplifier uses proper Proof.context instead of historic type simpset;
wenzelm
parents:
51678
diff
changeset
|
934 |
|
9e7d1c139569
simplifier uses proper Proof.context instead of historic type simpset;
wenzelm
parents:
51678
diff
changeset
|
935 |
fun list_neq ctxt ct = |
22143
cf58486ca11b
Added simproc list_neq (prompted by an application)
nipkow
parents:
21911
diff
changeset
|
936 |
let |
24037 | 937 |
val (Const(_,eqT) $ lhs $ rhs) = Thm.term_of ct; |
22143
cf58486ca11b
Added simproc list_neq (prompted by an application)
nipkow
parents:
21911
diff
changeset
|
938 |
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
|
939 |
fun prove_neq() = |
cf58486ca11b
Added simproc list_neq (prompted by an application)
nipkow
parents:
21911
diff
changeset
|
940 |
let |
cf58486ca11b
Added simproc list_neq (prompted by an application)
nipkow
parents:
21911
diff
changeset
|
941 |
val Type(_,listT::_) = eqT; |
22994 | 942 |
val size = HOLogic.size_const listT; |
22143
cf58486ca11b
Added simproc list_neq (prompted by an application)
nipkow
parents:
21911
diff
changeset
|
943 |
val eq_len = HOLogic.mk_eq (size $ lhs, size $ rhs); |
cf58486ca11b
Added simproc list_neq (prompted by an application)
nipkow
parents:
21911
diff
changeset
|
944 |
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
|
945 |
val thm = Goal.prove ctxt [] [] neq_len |
9e7d1c139569
simplifier uses proper Proof.context instead of historic type simpset;
wenzelm
parents:
51678
diff
changeset
|
946 |
(K (simp_tac (put_simpset ss ctxt) 1)); |
22633 | 947 |
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
|
948 |
in |
69215 | 949 |
if m < n andalso submultiset (op aconv) (ls,rs) orelse |
950 |
n < m andalso submultiset (op aconv) (rs,ls) |
|
22143
cf58486ca11b
Added simproc list_neq (prompted by an application)
nipkow
parents:
21911
diff
changeset
|
951 |
then prove_neq() else NONE |
cf58486ca11b
Added simproc list_neq (prompted by an application)
nipkow
parents:
21911
diff
changeset
|
952 |
end; |
69215 | 953 |
in K list_neq end |
60758 | 954 |
\<close> |
955 |
||
956 |
||
61799 | 957 |
subsubsection \<open>\<open>@\<close> -- append\<close> |
13114 | 958 |
|
63662 | 959 |
global_interpretation append: monoid append Nil |
960 |
proof |
|
961 |
fix xs ys zs :: "'a list" |
|
962 |
show "(xs @ ys) @ zs = xs @ (ys @ zs)" |
|
963 |
by (induct xs) simp_all |
|
964 |
show "xs @ [] = xs" |
|
965 |
by (induct xs) simp_all |
|
966 |
qed simp |
|
967 |
||
13142 | 968 |
lemma append_assoc [simp]: "(xs @ ys) @ zs = xs @ (ys @ zs)" |
63662 | 969 |
by (fact append.assoc) |
970 |
||
971 |
lemma append_Nil2: "xs @ [] = xs" |
|
972 |
by (fact append.right_neutral) |
|
3507 | 973 |
|
13142 | 974 |
lemma append_is_Nil_conv [iff]: "(xs @ ys = []) = (xs = [] \<and> ys = [])" |
13145 | 975 |
by (induct xs) auto |
13114 | 976 |
|
13142 | 977 |
lemma Nil_is_append_conv [iff]: "([] = xs @ ys) = (xs = [] \<and> ys = [])" |
13145 | 978 |
by (induct xs) auto |
13114 | 979 |
|
13142 | 980 |
lemma append_self_conv [iff]: "(xs @ ys = xs) = (ys = [])" |
13145 | 981 |
by (induct xs) auto |
13114 | 982 |
|
13142 | 983 |
lemma self_append_conv [iff]: "(xs = xs @ ys) = (ys = [])" |
13145 | 984 |
by (induct xs) auto |
13114 | 985 |
|
54147
97a8ff4e4ac9
killed most "no_atp", to make Sledgehammer more complete
blanchet
parents:
53954
diff
changeset
|
986 |
lemma append_eq_append_conv [simp]: |
58807 | 987 |
"length xs = length ys \<or> length us = length vs |
71585 | 988 |
\<Longrightarrow> (xs@us = ys@vs) = (xs=ys \<and> us=vs)" |
68709 | 989 |
by (induct xs arbitrary: ys; case_tac ys; force) |
13142 | 990 |
|
24526 | 991 |
lemma append_eq_append_conv2: "(xs @ ys = zs @ ts) = |
67091 | 992 |
(\<exists>us. xs = zs @ us \<and> us @ ys = ts \<or> xs @ us = zs \<and> ys = us @ ts)" |
68709 | 993 |
proof (induct xs arbitrary: ys zs ts) |
994 |
case (Cons x xs) |
|
995 |
then show ?case |
|
69850 | 996 |
by (cases zs) auto |
68709 | 997 |
qed fastforce |
14495 | 998 |
|
34910
b23bd3ee4813
same_append_eq / append_same_eq are now used for simplifying induction rules.
berghofe
parents:
34064
diff
changeset
|
999 |
lemma same_append_eq [iff, induct_simp]: "(xs @ ys = xs @ zs) = (ys = zs)" |
13145 | 1000 |
by simp |
13142 | 1001 |
|
1002 |
lemma append1_eq_conv [iff]: "(xs @ [x] = ys @ [y]) = (xs = ys \<and> x = y)" |
|
13145 | 1003 |
by simp |
13114 | 1004 |
|
34910
b23bd3ee4813
same_append_eq / append_same_eq are now used for simplifying induction rules.
berghofe
parents:
34064
diff
changeset
|
1005 |
lemma append_same_eq [iff, induct_simp]: "(ys @ xs = zs @ xs) = (ys = zs)" |
13145 | 1006 |
by simp |
13114 | 1007 |
|
13142 | 1008 |
lemma append_self_conv2 [iff]: "(xs @ ys = ys) = (xs = [])" |
13145 | 1009 |
using append_same_eq [of _ _ "[]"] by auto |
3507 | 1010 |
|
13142 | 1011 |
lemma self_append_conv2 [iff]: "(ys = xs @ ys) = (xs = [])" |
13145 | 1012 |
using append_same_eq [of "[]"] by auto |
13114 | 1013 |
|
71585 | 1014 |
lemma hd_Cons_tl: "xs \<noteq> [] \<Longrightarrow> hd xs # tl xs = xs" |
63662 | 1015 |
by (fact list.collapse) |
13114 | 1016 |
|
13142 | 1017 |
lemma hd_append: "hd (xs @ ys) = (if xs = [] then hd ys else hd xs)" |
13145 | 1018 |
by (induct xs) auto |
13114 | 1019 |
|
71585 | 1020 |
lemma hd_append2 [simp]: "xs \<noteq> [] \<Longrightarrow> hd (xs @ ys) = hd xs" |
13145 | 1021 |
by (simp add: hd_append split: list.split) |
13114 | 1022 |
|
67091 | 1023 |
lemma tl_append: "tl (xs @ ys) = (case xs of [] \<Rightarrow> tl ys | z#zs \<Rightarrow> zs @ ys)" |
13145 | 1024 |
by (simp split: list.split) |
13114 | 1025 |
|
71585 | 1026 |
lemma tl_append2 [simp]: "xs \<noteq> [] \<Longrightarrow> tl (xs @ ys) = tl xs @ ys" |
13145 | 1027 |
by (simp add: tl_append split: list.split) |
13114 | 1028 |
|
1029 |
||
14300 | 1030 |
lemma Cons_eq_append_conv: "x#xs = ys@zs = |
67091 | 1031 |
(ys = [] \<and> x#xs = zs \<or> (\<exists>ys'. x#ys' = ys \<and> xs = ys'@zs))" |
14300 | 1032 |
by(cases ys) auto |
1033 |
||
15281 | 1034 |
lemma append_eq_Cons_conv: "(ys@zs = x#xs) = |
67091 | 1035 |
(ys = [] \<and> zs = x#xs \<or> (\<exists>ys'. ys = x#ys' \<and> ys'@zs = xs))" |
15281 | 1036 |
by(cases ys) auto |
1037 |
||
63173 | 1038 |
lemma longest_common_prefix: |
1039 |
"\<exists>ps xs' ys'. xs = ps @ xs' \<and> ys = ps @ ys' |
|
1040 |
\<and> (xs' = [] \<or> ys' = [] \<or> hd xs' \<noteq> hd ys')" |
|
1041 |
by (induct xs ys rule: list_induct2') |
|
1042 |
(blast, blast, blast, |
|
1043 |
metis (no_types, hide_lams) append_Cons append_Nil list.sel(1)) |
|
14300 | 1044 |
|
61799 | 1045 |
text \<open>Trivial rules for solving \<open>@\<close>-equations automatically.\<close> |
13114 | 1046 |
|
71585 | 1047 |
lemma eq_Nil_appendI: "xs = ys \<Longrightarrow> xs = [] @ ys" |
1048 |
by simp |
|
1049 |
||
1050 |
lemma Cons_eq_appendI: "\<lbrakk>x # xs1 = ys; xs = xs1 @ zs\<rbrakk> \<Longrightarrow> x # xs = ys @ zs" |
|
1051 |
by auto |
|
1052 |
||
1053 |
lemma append_eq_appendI: "\<lbrakk>xs @ xs1 = zs; ys = xs1 @ us\<rbrakk> \<Longrightarrow> xs @ ys = zs @ us" |
|
1054 |
by auto |
|
13114 | 1055 |
|
1056 |
||
60758 | 1057 |
text \<open> |
13145 | 1058 |
Simplification procedure for all list equalities. |
61799 | 1059 |
Currently only tries to rearrange \<open>@\<close> to see if |
13145 | 1060 |
- both lists end in a singleton list, |
1061 |
- or both lists end in the same list. |
|
60758 | 1062 |
\<close> |
1063 |
||
1064 |
simproc_setup list_eq ("(xs::'a list) = ys") = \<open> |
|
13462 | 1065 |
let |
69593 | 1066 |
fun last (cons as Const (\<^const_name>\<open>Cons\<close>, _) $ _ $ xs) = |
1067 |
(case xs of Const (\<^const_name>\<open>Nil\<close>, _) => cons | _ => last xs) |
|
1068 |
| last (Const(\<^const_name>\<open>append\<close>,_) $ _ $ ys) = last ys |
|
43594 | 1069 |
| last t = t; |
64963 | 1070 |
|
69593 | 1071 |
fun list1 (Const(\<^const_name>\<open>Cons\<close>,_) $ _ $ Const(\<^const_name>\<open>Nil\<close>,_)) = true |
43594 | 1072 |
| list1 _ = false; |
64963 | 1073 |
|
69593 | 1074 |
fun butlast ((cons as Const(\<^const_name>\<open>Cons\<close>,_) $ x) $ xs) = |
1075 |
(case xs of Const (\<^const_name>\<open>Nil\<close>, _) => xs | _ => cons $ butlast xs) |
|
1076 |
| butlast ((app as Const (\<^const_name>\<open>append\<close>, _) $ xs) $ ys) = app $ butlast ys |
|
1077 |
| butlast xs = Const(\<^const_name>\<open>Nil\<close>, fastype_of xs); |
|
64963 | 1078 |
|
43594 | 1079 |
val rearr_ss = |
69593 | 1080 |
simpset_of (put_simpset HOL_basic_ss \<^context> |
51717
9e7d1c139569
simplifier uses proper Proof.context instead of historic type simpset;
wenzelm
parents:
51678
diff
changeset
|
1081 |
addsimps [@{thm append_assoc}, @{thm append_Nil}, @{thm append_Cons}]); |
64963 | 1082 |
|
51717
9e7d1c139569
simplifier uses proper Proof.context instead of historic type simpset;
wenzelm
parents:
51678
diff
changeset
|
1083 |
fun list_eq ctxt (F as (eq as Const(_,eqT)) $ lhs $ rhs) = |
13462 | 1084 |
let |
43594 | 1085 |
val lastl = last lhs and lastr = last rhs; |
1086 |
fun rearr conv = |
|
1087 |
let |
|
1088 |
val lhs1 = butlast lhs and rhs1 = butlast rhs; |
|
1089 |
val Type(_,listT::_) = eqT |
|
1090 |
val appT = [listT,listT] ---> listT |
|
69593 | 1091 |
val app = Const(\<^const_name>\<open>append\<close>,appT) |
43594 | 1092 |
val F2 = eq $ (app$lhs1$lastl) $ (app$rhs1$lastr) |
1093 |
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
|
1094 |
val thm = Goal.prove ctxt [] [] eq |
9e7d1c139569
simplifier uses proper Proof.context instead of historic type simpset;
wenzelm
parents:
51678
diff
changeset
|
1095 |
(K (simp_tac (put_simpset rearr_ss ctxt) 1)); |
43594 | 1096 |
in SOME ((conv RS (thm RS trans)) RS eq_reflection) end; |
1097 |
in |
|
1098 |
if list1 lastl andalso list1 lastr then rearr @{thm append1_eq_conv} |
|
1099 |
else if lastl aconv lastr then rearr @{thm append_same_eq} |
|
1100 |
else NONE |
|
1101 |
end; |
|
69215 | 1102 |
in fn _ => fn ctxt => fn ct => list_eq ctxt (Thm.term_of ct) end |
60758 | 1103 |
\<close> |
1104 |
||
1105 |
||
69593 | 1106 |
subsubsection \<open>\<^const>\<open>map\<close>\<close> |
13114 | 1107 |
|
58807 | 1108 |
lemma hd_map: "xs \<noteq> [] \<Longrightarrow> hd (map f xs) = f (hd xs)" |
1109 |
by (cases xs) simp_all |
|
1110 |
||
1111 |
lemma map_tl: "map f (tl xs) = tl (map f xs)" |
|
1112 |
by (cases xs) simp_all |
|
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
|
1113 |
|
71585 | 1114 |
lemma map_ext: "(\<And>x. x \<in> set xs \<longrightarrow> f x = g x) \<Longrightarrow> map f xs = map g xs" |
13145 | 1115 |
by (induct xs) simp_all |
13114 | 1116 |
|
13142 | 1117 |
lemma map_ident [simp]: "map (\<lambda>x. x) = (\<lambda>xs. xs)" |
13145 | 1118 |
by (rule ext, induct_tac xs) auto |
13114 | 1119 |
|
13142 | 1120 |
lemma map_append [simp]: "map f (xs @ ys) = map f xs @ map f ys" |
13145 | 1121 |
by (induct xs) auto |
13114 | 1122 |
|
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
|
1123 |
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
|
1124 |
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
|
1125 |
|
67091 | 1126 |
lemma map_comp_map[simp]: "((map f) \<circ> (map g)) = map(f \<circ> g)" |
58807 | 1127 |
by (rule ext) simp |
35208 | 1128 |
|
13142 | 1129 |
lemma rev_map: "rev (map f xs) = map f (rev xs)" |
13145 | 1130 |
by (induct xs) auto |
13114 | 1131 |
|
67613 | 1132 |
lemma map_eq_conv[simp]: "(map f xs = map g xs) = (\<forall>x \<in> set xs. f x = g x)" |
13737 | 1133 |
by (induct xs) auto |
1134 |
||
44013
5cfc1c36ae97
moved recdef package to HOL/Library/Old_Recdef.thy
krauss
parents:
43594
diff
changeset
|
1135 |
lemma map_cong [fundef_cong]: |
40122
1d8ad2ff3e01
dropped (almost) redundant distinct.induct rule; distinct_simps again named distinct.simps
haftmann
parents:
40077
diff
changeset
|
1136 |
"xs = ys \<Longrightarrow> (\<And>x. x \<in> set ys \<Longrightarrow> f x = g x) \<Longrightarrow> map f xs = map g ys" |
58807 | 1137 |
by simp |
13114 | 1138 |
|
13142 | 1139 |
lemma map_is_Nil_conv [iff]: "(map f xs = []) = (xs = [])" |
13145 | 1140 |
by (cases xs) auto |
13114 | 1141 |
|
13142 | 1142 |
lemma Nil_is_map_conv [iff]: "([] = map f xs) = (xs = [])" |
13145 | 1143 |
by (cases xs) auto |
13114 | 1144 |
|
18447 | 1145 |
lemma map_eq_Cons_conv: |
58807 | 1146 |
"(map f xs = y#ys) = (\<exists>z zs. xs = z#zs \<and> f z = y \<and> map f zs = ys)" |
13145 | 1147 |
by (cases xs) auto |
13114 | 1148 |
|
18447 | 1149 |
lemma Cons_eq_map_conv: |
58807 | 1150 |
"(x#xs = map f ys) = (\<exists>z zs. ys = z#zs \<and> x = f z \<and> xs = map f zs)" |
14025 | 1151 |
by (cases ys) auto |
1152 |
||
18447 | 1153 |
lemmas map_eq_Cons_D = map_eq_Cons_conv [THEN iffD1] |
1154 |
lemmas Cons_eq_map_D = Cons_eq_map_conv [THEN iffD1] |
|
1155 |
declare map_eq_Cons_D [dest!] Cons_eq_map_D [dest!] |
|
1156 |
||
14111 | 1157 |
lemma ex_map_conv: |
67091 | 1158 |
"(\<exists>xs. ys = map f xs) = (\<forall>y \<in> set ys. \<exists>x. y = f x)" |
18447 | 1159 |
by(induct ys, auto simp add: Cons_eq_map_conv) |
14111 | 1160 |
|
15110
78b5636eabc7
Added a number of new thms and the new function remove1
nipkow
parents:
15072
diff
changeset
|
1161 |
lemma map_eq_imp_length_eq: |
35510 | 1162 |
assumes "map f xs = map g ys" |
26734 | 1163 |
shows "length xs = length ys" |
53374
a14d2a854c02
tuned proofs -- clarified flow of facts wrt. calculation;
wenzelm
parents:
53017
diff
changeset
|
1164 |
using assms |
a14d2a854c02
tuned proofs -- clarified flow of facts wrt. calculation;
wenzelm
parents:
53017
diff
changeset
|
1165 |
proof (induct ys arbitrary: xs) |
26734 | 1166 |
case Nil then show ?case by simp |
1167 |
next |
|
1168 |
case (Cons y ys) then obtain z zs where xs: "xs = z # zs" by auto |
|
35510 | 1169 |
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
|
1170 |
with Cons have "length zs = length ys" by blast |
26734 | 1171 |
with xs show ?case by simp |
1172 |
qed |
|
64963 | 1173 |
|
15110
78b5636eabc7
Added a number of new thms and the new function remove1
nipkow
parents:
15072
diff
changeset
|
1174 |
lemma map_inj_on: |
68709 | 1175 |
assumes map: "map f xs = map f ys" and inj: "inj_on f (set xs Un set ys)" |
1176 |
shows "xs = ys" |
|
1177 |
using map_eq_imp_length_eq [OF map] assms |
|
1178 |
proof (induct rule: list_induct2) |
|
1179 |
case (Cons x xs y ys) |
|
1180 |
then show ?case |
|
1181 |
by (auto intro: sym) |
|
1182 |
qed auto |
|
15110
78b5636eabc7
Added a number of new thms and the new function remove1
nipkow
parents:
15072
diff
changeset
|
1183 |
|
78b5636eabc7
Added a number of new thms and the new function remove1
nipkow
parents:
15072
diff
changeset
|
1184 |
lemma inj_on_map_eq_map: |
58807 | 1185 |
"inj_on f (set xs Un set ys) \<Longrightarrow> (map f xs = map f ys) = (xs = ys)" |
15110
78b5636eabc7
Added a number of new thms and the new function remove1
nipkow
parents:
15072
diff
changeset
|
1186 |
by(blast dest:map_inj_on) |
78b5636eabc7
Added a number of new thms and the new function remove1
nipkow
parents:
15072
diff
changeset
|
1187 |
|
13114 | 1188 |
lemma map_injective: |
71585 | 1189 |
"map f xs = map f ys \<Longrightarrow> inj f \<Longrightarrow> xs = ys" |
24526 | 1190 |
by (induct ys arbitrary: xs) (auto dest!:injD) |
13114 | 1191 |
|
14339 | 1192 |
lemma inj_map_eq_map[simp]: "inj f \<Longrightarrow> (map f xs = map f ys) = (xs = ys)" |
1193 |
by(blast dest:map_injective) |
|
1194 |
||
71585 | 1195 |
lemma inj_mapI: "inj f \<Longrightarrow> inj (map f)" |
17589 | 1196 |
by (iprover dest: map_injective injD intro: inj_onI) |
13114 | 1197 |
|
71585 | 1198 |
lemma inj_mapD: "inj (map f) \<Longrightarrow> inj f" |
68709 | 1199 |
by (metis (no_types, hide_lams) injI list.inject list.simps(9) the_inv_f_f) |
13114 | 1200 |
|
14339 | 1201 |
lemma inj_map[iff]: "inj (map f) = inj f" |
13145 | 1202 |
by (blast dest: inj_mapD intro: inj_mapI) |
13114 | 1203 |
|
15303 | 1204 |
lemma inj_on_mapI: "inj_on f (\<Union>(set ` A)) \<Longrightarrow> inj_on (map f) A" |
68709 | 1205 |
by (blast intro:inj_onI dest:inj_onD map_inj_on) |
15303 | 1206 |
|
14343 | 1207 |
lemma map_idI: "(\<And>x. x \<in> set xs \<Longrightarrow> f x = x) \<Longrightarrow> map f xs = xs" |
1208 |
by (induct xs, auto) |
|
13114 | 1209 |
|
14402
4201e1916482
moved lemmas from MicroJava/Comp/AuxLemmas.thy to List.thy
nipkow
parents:
14395
diff
changeset
|
1210 |
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
|
1211 |
by (induct xs) auto |
4201e1916482
moved lemmas from MicroJava/Comp/AuxLemmas.thy to List.thy
nipkow
parents:
14395
diff
changeset
|
1212 |
|
15110
78b5636eabc7
Added a number of new thms and the new function remove1
nipkow
parents:
15072
diff
changeset
|
1213 |
lemma map_fst_zip[simp]: |
78b5636eabc7
Added a number of new thms and the new function remove1
nipkow
parents:
15072
diff
changeset
|
1214 |
"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
|
1215 |
by (induct rule:list_induct2, simp_all) |
78b5636eabc7
Added a number of new thms and the new function remove1
nipkow
parents:
15072
diff
changeset
|
1216 |
|
78b5636eabc7
Added a number of new thms and the new function remove1
nipkow
parents:
15072
diff
changeset
|
1217 |
lemma map_snd_zip[simp]: |
78b5636eabc7
Added a number of new thms and the new function remove1
nipkow
parents:
15072
diff
changeset
|
1218 |
"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
|
1219 |
by (induct rule:list_induct2, simp_all) |
78b5636eabc7
Added a number of new thms and the new function remove1
nipkow
parents:
15072
diff
changeset
|
1220 |
|
68215 | 1221 |
lemma map_fst_zip_take: |
1222 |
"map fst (zip xs ys) = take (min (length xs) (length ys)) xs" |
|
1223 |
by (induct xs ys rule: list_induct2') simp_all |
|
1224 |
||
1225 |
lemma map_snd_zip_take: |
|
1226 |
"map snd (zip xs ys) = take (min (length xs) (length ys)) ys" |
|
1227 |
by (induct xs ys rule: list_induct2') simp_all |
|
1228 |
||
66853 | 1229 |
lemma map2_map_map: "map2 h (map f xs) (map g xs) = map (\<lambda>x. h (f x) (g x)) xs" |
1230 |
by (induction xs) (auto) |
|
1231 |
||
55467
a5c9002bc54d
renamed 'enriched_type' to more informative 'functor' (following the renaming of enriched type constructors to bounded natural functors)
blanchet
parents:
55466
diff
changeset
|
1232 |
functor map: map |
47122 | 1233 |
by (simp_all add: id_def) |
1234 |
||
49948
744934b818c7
moved quite generic material from theory Enum to more appropriate places
haftmann
parents:
49808
diff
changeset
|
1235 |
declare map.id [simp] |
744934b818c7
moved quite generic material from theory Enum to more appropriate places
haftmann
parents:
49808
diff
changeset
|
1236 |
|
744934b818c7
moved quite generic material from theory Enum to more appropriate places
haftmann
parents:
49808
diff
changeset
|
1237 |
|
69593 | 1238 |
subsubsection \<open>\<^const>\<open>rev\<close>\<close> |
13114 | 1239 |
|
13142 | 1240 |
lemma rev_append [simp]: "rev (xs @ ys) = rev ys @ rev xs" |
13145 | 1241 |
by (induct xs) auto |
13114 | 1242 |
|
13142 | 1243 |
lemma rev_rev_ident [simp]: "rev (rev xs) = xs" |
13145 | 1244 |
by (induct xs) auto |
13114 | 1245 |
|
15870 | 1246 |
lemma rev_swap: "(rev xs = ys) = (xs = rev ys)" |
1247 |
by auto |
|
1248 |
||
13142 | 1249 |
lemma rev_is_Nil_conv [iff]: "(rev xs = []) = (xs = [])" |
13145 | 1250 |
by (induct xs) auto |
13114 | 1251 |
|
13142 | 1252 |
lemma Nil_is_rev_conv [iff]: "([] = rev xs) = (xs = [])" |
13145 | 1253 |
by (induct xs) auto |
13114 | 1254 |
|
15870 | 1255 |
lemma rev_singleton_conv [simp]: "(rev xs = [x]) = (xs = [x])" |
1256 |
by (cases xs) auto |
|
1257 |
||
1258 |
lemma singleton_rev_conv [simp]: "([x] = rev xs) = (xs = [x])" |
|
1259 |
by (cases xs) auto |
|
1260 |
||
54147
97a8ff4e4ac9
killed most "no_atp", to make Sledgehammer more complete
blanchet
parents:
53954
diff
changeset
|
1261 |
lemma rev_is_rev_conv [iff]: "(rev xs = rev ys) = (xs = ys)" |
69850 | 1262 |
proof (induct xs arbitrary: ys) |
1263 |
case Nil |
|
1264 |
then show ?case by force |
|
1265 |
next |
|
1266 |
case Cons |
|
1267 |
then show ?case by (cases ys) auto |
|
1268 |
qed |
|
13114 | 1269 |
|
15439 | 1270 |
lemma inj_on_rev[iff]: "inj_on rev A" |
1271 |
by(simp add:inj_on_def) |
|
1272 |
||
13366 | 1273 |
lemma rev_induct [case_names Nil snoc]: |
71585 | 1274 |
assumes "P []" and "\<And>x xs. P xs \<Longrightarrow> P (xs @ [x])" |
1275 |
shows "P xs" |
|
1276 |
proof - |
|
1277 |
have "P (rev (rev xs))" |
|
1278 |
by (rule_tac list = "rev xs" in list.induct, simp_all add: assms) |
|
1279 |
then show ?thesis by simp |
|
1280 |
qed |
|
13114 | 1281 |
|
13366 | 1282 |
lemma rev_exhaust [case_names Nil snoc]: |
71585 | 1283 |
"(xs = [] \<Longrightarrow> P) \<Longrightarrow>(\<And>ys y. xs = ys @ [y] \<Longrightarrow> P) \<Longrightarrow> P" |
13145 | 1284 |
by (induct xs rule: rev_induct) auto |
13114 | 1285 |
|
13366 | 1286 |
lemmas rev_cases = rev_exhaust |
1287 |
||
57577 | 1288 |
lemma rev_nonempty_induct [consumes 1, case_names single snoc]: |
1289 |
assumes "xs \<noteq> []" |
|
1290 |
and single: "\<And>x. P [x]" |
|
1291 |
and snoc': "\<And>x xs. xs \<noteq> [] \<Longrightarrow> P xs \<Longrightarrow> P (xs@[x])" |
|
1292 |
shows "P xs" |
|
60758 | 1293 |
using \<open>xs \<noteq> []\<close> proof (induct xs rule: rev_induct) |
57577 | 1294 |
case (snoc x xs) then show ?case |
1295 |
proof (cases xs) |
|
1296 |
case Nil thus ?thesis by (simp add: single) |
|
1297 |
next |
|
1298 |
case Cons with snoc show ?thesis by (fastforce intro!: snoc') |
|
1299 |
qed |
|
1300 |
qed simp |
|
1301 |
||
18423 | 1302 |
lemma rev_eq_Cons_iff[iff]: "(rev xs = y#ys) = (xs = rev ys @ [y])" |
1303 |
by(rule rev_cases[of xs]) auto |
|
1304 |
||
13114 | 1305 |
|
69593 | 1306 |
subsubsection \<open>\<^const>\<open>set\<close>\<close> |
13114 | 1307 |
|
67443
3abf6a722518
standardized towards new-style formal comments: isabelle update_comments;
wenzelm
parents:
67399
diff
changeset
|
1308 |
declare list.set[code_post] \<comment> \<open>pretty output\<close> |
57816
d8bbb97689d3
no need for 'set_simps' now that 'datatype_new' generates the desired 'set' property
blanchet
parents:
57599
diff
changeset
|
1309 |
|
13142 | 1310 |
lemma finite_set [iff]: "finite (set xs)" |
13145 | 1311 |
by (induct xs) auto |
13114 | 1312 |
|
13142 | 1313 |
lemma set_append [simp]: "set (xs @ ys) = (set xs \<union> set ys)" |
13145 | 1314 |
by (induct xs) auto |
13114 | 1315 |
|
67613 | 1316 |
lemma hd_in_set[simp]: "xs \<noteq> [] \<Longrightarrow> hd xs \<in> set xs" |
17830 | 1317 |
by(cases xs) auto |
14099 | 1318 |
|
13142 | 1319 |
lemma set_subset_Cons: "set xs \<subseteq> set (x # xs)" |
13145 | 1320 |
by auto |
13114 | 1321 |
|
64963 | 1322 |
lemma set_ConsD: "y \<in> set (x # xs) \<Longrightarrow> y=x \<or> y \<in> set xs" |
14099 | 1323 |
by auto |
1324 |
||
13142 | 1325 |
lemma set_empty [iff]: "(set xs = {}) = (xs = [])" |
13145 | 1326 |
by (induct xs) auto |
13114 | 1327 |
|
15245 | 1328 |
lemma set_empty2[iff]: "({} = set xs) = (xs = [])" |
1329 |
by(induct xs) auto |
|
1330 |
||
13142 | 1331 |
lemma set_rev [simp]: "set (rev xs) = set xs" |
13145 | 1332 |
by (induct xs) auto |
13114 | 1333 |
|
13142 | 1334 |
lemma set_map [simp]: "set (map f xs) = f`(set xs)" |
13145 | 1335 |
by (induct xs) auto |
13114 | 1336 |
|
67613 | 1337 |
lemma set_filter [simp]: "set (filter P xs) = {x. x \<in> set xs \<and> P x}" |
13145 | 1338 |
by (induct xs) auto |
13114 | 1339 |
|
32417 | 1340 |
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
|
1341 |
by (induct j) auto |
13114 | 1342 |
|
13142 | 1343 |
|
67613 | 1344 |
lemma split_list: "x \<in> set xs \<Longrightarrow> \<exists>ys zs. xs = ys @ x # zs" |
18049 | 1345 |
proof (induct xs) |
26073 | 1346 |
case Nil thus ?case by simp |
1347 |
next |
|
1348 |
case Cons thus ?case by (auto intro: Cons_eq_appendI) |
|
1349 |
qed |
|
1350 |
||
26734 | 1351 |
lemma in_set_conv_decomp: "x \<in> set xs \<longleftrightarrow> (\<exists>ys zs. xs = ys @ x # zs)" |
1352 |
by (auto elim: split_list) |
|
26073 | 1353 |
|
67613 | 1354 |
lemma split_list_first: "x \<in> set xs \<Longrightarrow> \<exists>ys zs. xs = ys @ x # zs \<and> x \<notin> set ys" |
26073 | 1355 |
proof (induct xs) |
1356 |
case Nil thus ?case by simp |
|
18049 | 1357 |
next |
1358 |
case (Cons a xs) |
|
1359 |
show ?case |
|
1360 |
proof cases |
|
44890
22f665a2e91c
new fastforce replacing fastsimp - less confusing name
nipkow
parents:
44635
diff
changeset
|
1361 |
assume "x = a" thus ?case using Cons by fastforce |
18049 | 1362 |
next |
44890
22f665a2e91c
new fastforce replacing fastsimp - less confusing name
nipkow
parents:
44635
diff
changeset
|
1363 |
assume "x \<noteq> a" thus ?case using Cons by(fastforce intro!: Cons_eq_appendI) |
26073 | 1364 |
qed |
1365 |
qed |
|
1366 |
||
1367 |
lemma in_set_conv_decomp_first: |
|
67613 | 1368 |
"(x \<in> set xs) = (\<exists>ys zs. xs = ys @ x # zs \<and> x \<notin> set ys)" |
26734 | 1369 |
by (auto dest!: split_list_first) |
26073 | 1370 |
|
40122
1d8ad2ff3e01
dropped (almost) redundant distinct.induct rule; distinct_simps again named distinct.simps
haftmann
parents:
40077
diff
changeset
|
1371 |
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
|
1372 |
proof (induct xs rule: rev_induct) |
26073 | 1373 |
case Nil thus ?case by simp |
1374 |
next |
|
1375 |
case (snoc a xs) |
|
1376 |
show ?case |
|
1377 |
proof cases |
|
56085 | 1378 |
assume "x = a" thus ?case using snoc by (auto intro!: exI) |
26073 | 1379 |
next |
44890
22f665a2e91c
new fastforce replacing fastsimp - less confusing name
nipkow
parents:
44635
diff
changeset
|
1380 |
assume "x \<noteq> a" thus ?case using snoc by fastforce |
18049 | 1381 |
qed |
1382 |
qed |
|
1383 |
||
26073 | 1384 |
lemma in_set_conv_decomp_last: |
67613 | 1385 |
"(x \<in> set xs) = (\<exists>ys zs. xs = ys @ x # zs \<and> x \<notin> set zs)" |
26734 | 1386 |
by (auto dest!: split_list_last) |
26073 | 1387 |
|
67091 | 1388 |
lemma split_list_prop: "\<exists>x \<in> set xs. P x \<Longrightarrow> \<exists>ys x zs. xs = ys @ x # zs \<and> P x" |
26073 | 1389 |
proof (induct xs) |
1390 |
case Nil thus ?case by simp |
|
1391 |
next |
|
1392 |
case Cons thus ?case |
|
1393 |
by(simp add:Bex_def)(metis append_Cons append.simps(1)) |
|
1394 |
qed |
|
1395 |
||
1396 |
lemma split_list_propE: |
|
26734 | 1397 |
assumes "\<exists>x \<in> set xs. P x" |
1398 |
obtains ys x zs where "xs = ys @ x # zs" and "P x" |
|
1399 |
using split_list_prop [OF assms] by blast |
|
26073 | 1400 |
|
1401 |
lemma split_list_first_prop: |
|
1402 |
"\<exists>x \<in> set xs. P x \<Longrightarrow> |
|
1403 |
\<exists>ys x zs. xs = ys@x#zs \<and> P x \<and> (\<forall>y \<in> set ys. \<not> P y)" |
|
26734 | 1404 |
proof (induct xs) |
26073 | 1405 |
case Nil thus ?case by simp |
1406 |
next |
|
1407 |
case (Cons x xs) |
|
1408 |
show ?case |
|
1409 |
proof cases |
|
1410 |
assume "P x" |
|
56085 | 1411 |
hence "x # xs = [] @ x # xs \<and> P x \<and> (\<forall>y\<in>set []. \<not> P y)" by simp |
1412 |
thus ?thesis by fast |
|
26073 | 1413 |
next |
1414 |
assume "\<not> P x" |
|
1415 |
hence "\<exists>x\<in>set xs. P x" using Cons(2) by simp |
|
60758 | 1416 |
thus ?thesis using \<open>\<not> P x\<close> Cons(1) by (metis append_Cons set_ConsD) |
26073 | 1417 |
qed |
1418 |
qed |
|
1419 |
||
1420 |
lemma split_list_first_propE: |
|
26734 | 1421 |
assumes "\<exists>x \<in> set xs. P x" |
1422 |
obtains ys x zs where "xs = ys @ x # zs" and "P x" and "\<forall>y \<in> set ys. \<not> P y" |
|
1423 |
using split_list_first_prop [OF assms] by blast |
|
26073 | 1424 |
|
1425 |
lemma split_list_first_prop_iff: |
|
1426 |
"(\<exists>x \<in> set xs. P x) \<longleftrightarrow> |
|
1427 |
(\<exists>ys x zs. xs = ys@x#zs \<and> P x \<and> (\<forall>y \<in> set ys. \<not> P y))" |
|
26734 | 1428 |
by (rule, erule split_list_first_prop) auto |
26073 | 1429 |
|
1430 |
lemma split_list_last_prop: |
|
1431 |
"\<exists>x \<in> set xs. P x \<Longrightarrow> |
|
1432 |
\<exists>ys x zs. xs = ys@x#zs \<and> P x \<and> (\<forall>z \<in> set zs. \<not> P z)" |
|
1433 |
proof(induct xs rule:rev_induct) |
|
1434 |
case Nil thus ?case by simp |
|
1435 |
next |
|
1436 |
case (snoc x xs) |
|
1437 |
show ?case |
|
1438 |
proof cases |
|
56085 | 1439 |
assume "P x" thus ?thesis by (auto intro!: exI) |
26073 | 1440 |
next |
1441 |
assume "\<not> P x" |
|
1442 |
hence "\<exists>x\<in>set xs. P x" using snoc(2) by simp |
|
60758 | 1443 |
thus ?thesis using \<open>\<not> P x\<close> snoc(1) by fastforce |
26073 | 1444 |
qed |
1445 |
qed |
|
1446 |
||
1447 |
lemma split_list_last_propE: |
|
26734 | 1448 |
assumes "\<exists>x \<in> set xs. P x" |
1449 |
obtains ys x zs where "xs = ys @ x # zs" and "P x" and "\<forall>z \<in> set zs. \<not> P z" |
|
1450 |
using split_list_last_prop [OF assms] by blast |
|
26073 | 1451 |
|
1452 |
lemma split_list_last_prop_iff: |
|
1453 |
"(\<exists>x \<in> set xs. P x) \<longleftrightarrow> |
|
1454 |
(\<exists>ys x zs. xs = ys@x#zs \<and> P x \<and> (\<forall>z \<in> set zs. \<not> P z))" |
|
56085 | 1455 |
by rule (erule split_list_last_prop, auto) |
1456 |
||
26073 | 1457 |
|
67091 | 1458 |
lemma finite_list: "finite A \<Longrightarrow> \<exists>xs. set xs = A" |
57816
d8bbb97689d3
no need for 'set_simps' now that 'datatype_new' generates the desired 'set' property
blanchet
parents:
57599
diff
changeset
|
1459 |
by (erule finite_induct) (auto simp add: list.set(2)[symmetric] simp del: list.set(2)) |
13508 | 1460 |
|
14388 | 1461 |
lemma card_length: "card (set xs) \<le> length xs" |
1462 |
by (induct xs) (auto simp add: card_insert_if) |
|
13114 | 1463 |
|
26442
57fb6a8b099e
restructuring; explicit case names for rule list_induct2
haftmann
parents:
26300
diff
changeset
|
1464 |
lemma set_minus_filter_out: |
57fb6a8b099e
restructuring; explicit case names for rule list_induct2
haftmann
parents:
26300
diff
changeset
|
1465 |
"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
|
1466 |
by (induct xs) auto |
15168 | 1467 |
|
66257 | 1468 |
lemma append_Cons_eq_iff: |
1469 |
"\<lbrakk> x \<notin> set xs; x \<notin> set ys \<rbrakk> \<Longrightarrow> |
|
1470 |
xs @ x # ys = xs' @ x # ys' \<longleftrightarrow> (xs = xs' \<and> ys = ys')" |
|
1471 |
by(auto simp: append_eq_Cons_conv Cons_eq_append_conv append_eq_append_conv2) |
|
1472 |
||
35115 | 1473 |
|
69593 | 1474 |
subsubsection \<open>\<^const>\<open>filter\<close>\<close> |
13114 | 1475 |
|
13142 | 1476 |
lemma filter_append [simp]: "filter P (xs @ ys) = filter P xs @ filter P ys" |
13145 | 1477 |
by (induct xs) auto |
13114 | 1478 |
|
15305 | 1479 |
lemma rev_filter: "rev (filter P xs) = filter P (rev xs)" |
1480 |
by (induct xs) simp_all |
|
1481 |
||
13142 | 1482 |
lemma filter_filter [simp]: "filter P (filter Q xs) = filter (\<lambda>x. Q x \<and> P x) xs" |
13145 | 1483 |
by (induct xs) auto |
13114 | 1484 |
|
16998 | 1485 |
lemma length_filter_le [simp]: "length (filter P xs) \<le> length xs" |
1486 |
by (induct xs) (auto simp add: le_SucI) |
|
1487 |
||
18423 | 1488 |
lemma sum_length_filter_compl: |
67091 | 1489 |
"length(filter P xs) + length(filter (\<lambda>x. \<not>P x) xs) = length xs" |
18423 | 1490 |
by(induct xs) simp_all |
1491 |
||
71585 | 1492 |
lemma filter_True [simp]: "\<forall>x \<in> set xs. P x \<Longrightarrow> filter P xs = xs" |
13145 | 1493 |
by (induct xs) auto |
13114 | 1494 |
|
71585 | 1495 |
lemma filter_False [simp]: "\<forall>x \<in> set xs. \<not> P x \<Longrightarrow> filter P xs = []" |
13145 | 1496 |
by (induct xs) auto |
13114 | 1497 |
|
64963 | 1498 |
lemma filter_empty_conv: "(filter P xs = []) = (\<forall>x\<in>set xs. \<not> P x)" |
24349 | 1499 |
by (induct xs) simp_all |
16998 | 1500 |
|
1501 |
lemma filter_id_conv: "(filter P xs = xs) = (\<forall>x\<in>set xs. P x)" |
|
68709 | 1502 |
proof (induct xs) |
1503 |
case (Cons x xs) |
|
1504 |
then show ?case |
|
1505 |
using length_filter_le |
|
1506 |
by (simp add: impossible_Cons) |
|
1507 |
qed auto |
|
13114 | 1508 |
|
67091 | 1509 |
lemma filter_map: "filter P (map f xs) = map f (filter (P \<circ> f) xs)" |
16965 | 1510 |
by (induct xs) simp_all |
1511 |
||
1512 |
lemma length_filter_map[simp]: |
|
67091 | 1513 |
"length (filter P (map f xs)) = length(filter (P \<circ> f) xs)" |
16965 | 1514 |
by (simp add:filter_map) |
1515 |
||
13142 | 1516 |
lemma filter_is_subset [simp]: "set (filter P xs) \<le> set xs" |
13145 | 1517 |
by auto |
13114 | 1518 |
|
15246 | 1519 |
lemma length_filter_less: |
67091 | 1520 |
"\<lbrakk> x \<in> set xs; \<not> P x \<rbrakk> \<Longrightarrow> length(filter P xs) < length xs" |
15246 | 1521 |
proof (induct xs) |
1522 |
case Nil thus ?case by simp |
|
1523 |
next |
|
1524 |
case (Cons x xs) thus ?case |
|
68719 | 1525 |
using Suc_le_eq by fastforce |
15246 | 1526 |
qed |
13114 | 1527 |
|
15281 | 1528 |
lemma length_filter_conv_card: |
67091 | 1529 |
"length(filter p xs) = card{i. i < length xs \<and> p(xs!i)}" |
15281 | 1530 |
proof (induct xs) |
1531 |
case Nil thus ?case by simp |
|
1532 |
next |
|
1533 |
case (Cons x xs) |
|
67091 | 1534 |
let ?S = "{i. i < length xs \<and> p(xs!i)}" |
15281 | 1535 |
have fin: "finite ?S" by(fast intro: bounded_nat_set_is_finite) |
1536 |
show ?case (is "?l = card ?S'") |
|
1537 |
proof (cases) |
|
1538 |
assume "p x" |
|
1539 |
hence eq: "?S' = insert 0 (Suc ` ?S)" |
|
25162 | 1540 |
by(auto simp: image_def split:nat.split dest:gr0_implies_Suc) |
15281 | 1541 |
have "length (filter p (x # xs)) = Suc(card ?S)" |
60758 | 1542 |
using Cons \<open>p x\<close> by simp |
15281 | 1543 |
also have "\<dots> = Suc(card(Suc ` ?S))" using fin |
44921 | 1544 |
by (simp add: card_image) |
15281 | 1545 |
also have "\<dots> = card ?S'" using eq fin |
71393
fce780f9c9c6
new examples of BNF lifting across quotients using a new theory of confluence,
traytel
parents:
70911
diff
changeset
|
1546 |
by (simp add:card_insert_if) |
15281 | 1547 |
finally show ?thesis . |
1548 |
next |
|
1549 |
assume "\<not> p x" |
|
1550 |
hence eq: "?S' = Suc ` ?S" |
|
25162 | 1551 |
by(auto simp add: image_def split:nat.split elim:lessE) |
15281 | 1552 |
have "length (filter p (x # xs)) = card ?S" |
60758 | 1553 |
using Cons \<open>\<not> p x\<close> by simp |
15281 | 1554 |
also have "\<dots> = card(Suc ` ?S)" using fin |
44921 | 1555 |
by (simp add: card_image) |
15281 | 1556 |
also have "\<dots> = card ?S'" using eq fin |
1557 |
by (simp add:card_insert_if) |
|
1558 |
finally show ?thesis . |
|
1559 |
qed |
|
1560 |
qed |
|
1561 |
||
17629 | 1562 |
lemma Cons_eq_filterD: |
58807 | 1563 |
"x#xs = filter P ys \<Longrightarrow> |
17629 | 1564 |
\<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 | 1565 |
(is "_ \<Longrightarrow> \<exists>us vs. ?P ys us vs") |
17629 | 1566 |
proof(induct ys) |
1567 |
case Nil thus ?case by simp |
|
1568 |
next |
|
1569 |
case (Cons y ys) |
|
1570 |
show ?case (is "\<exists>x. ?Q x") |
|
1571 |
proof cases |
|
1572 |
assume Py: "P y" |
|
1573 |
show ?thesis |
|
1574 |
proof cases |
|
25221
5ded95dda5df
append/member: more light-weight way to declare authentic syntax;
wenzelm
parents:
25215
diff
changeset
|
1575 |
assume "x = y" |
5ded95dda5df
append/member: more light-weight way to declare authentic syntax;
wenzelm
parents:
25215
diff
changeset
|
1576 |
with Py Cons.prems have "?Q []" by simp |
5ded95dda5df
append/member: more light-weight way to declare authentic syntax;
wenzelm
parents:
25215
diff
changeset
|
1577 |
then show ?thesis .. |
17629 | 1578 |
next |
25221
5ded95dda5df
append/member: more light-weight way to declare authentic syntax;
wenzelm
parents:
25215
diff
changeset
|
1579 |
assume "x \<noteq> y" |
5ded95dda5df
append/member: more light-weight way to declare authentic syntax;
wenzelm
parents:
25215
diff
changeset
|
1580 |
with Py Cons.prems show ?thesis by simp |
17629 | 1581 |
qed |
1582 |
next |
|
25221
5ded95dda5df
append/member: more light-weight way to declare authentic syntax;
wenzelm
parents:
25215
diff
changeset
|
1583 |
assume "\<not> P y" |
44890
22f665a2e91c
new fastforce replacing fastsimp - less confusing name
nipkow
parents:
44635
diff
changeset
|
1584 |
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
|
1585 |
then have "?Q (y#us)" by simp |
5ded95dda5df
append/member: more light-weight way to declare authentic syntax;
wenzelm
parents:
25215
diff
changeset
|
1586 |
then show ?thesis .. |
17629 | 1587 |
qed |
1588 |
qed |
|
1589 |
||
1590 |
lemma filter_eq_ConsD: |
|
58807 | 1591 |
"filter P ys = x#xs \<Longrightarrow> |
17629 | 1592 |
\<exists>us vs. ys = us @ x # vs \<and> (\<forall>u\<in>set us. \<not> P u) \<and> P x \<and> xs = filter P vs" |
68719 | 1593 |
by(rule Cons_eq_filterD) simp |
17629 | 1594 |
|
1595 |
lemma filter_eq_Cons_iff: |
|
58807 | 1596 |
"(filter P ys = x#xs) = |
17629 | 1597 |
(\<exists>us vs. ys = us @ x # vs \<and> (\<forall>u\<in>set us. \<not> P u) \<and> P x \<and> xs = filter P vs)" |
68719 | 1598 |
by(auto dest:filter_eq_ConsD) |
17629 | 1599 |
|
1600 |
lemma Cons_eq_filter_iff: |
|
58807 | 1601 |
"(x#xs = filter P ys) = |
17629 | 1602 |
(\<exists>us vs. ys = us @ x # vs \<and> (\<forall>u\<in>set us. \<not> P u) \<and> P x \<and> xs = filter P vs)" |
68719 | 1603 |
by(auto dest:Cons_eq_filterD) |
17629 | 1604 |
|
61031
162bd20dae23
more lemmas on sorting and multisets (due to Thomas Sewell)
haftmann
parents:
60758
diff
changeset
|
1605 |
lemma inj_on_filter_key_eq: |
162bd20dae23
more lemmas on sorting and multisets (due to Thomas Sewell)
haftmann
parents:
60758
diff
changeset
|
1606 |
assumes "inj_on f (insert y (set xs))" |
68249
949d93804740
First step to remove nonstandard "[x <- xs. P]" syntax: only input
nipkow
parents:
68215
diff
changeset
|
1607 |
shows "filter (\<lambda>x. f y = f x) xs = filter (HOL.eq y) xs" |
61031
162bd20dae23
more lemmas on sorting and multisets (due to Thomas Sewell)
haftmann
parents:
60758
diff
changeset
|
1608 |
using assms by (induct xs) auto |
162bd20dae23
more lemmas on sorting and multisets (due to Thomas Sewell)
haftmann
parents:
60758
diff
changeset
|
1609 |
|
44013
5cfc1c36ae97
moved recdef package to HOL/Library/Old_Recdef.thy
krauss
parents:
43594
diff
changeset
|
1610 |
lemma filter_cong[fundef_cong]: |
58807 | 1611 |
"xs = ys \<Longrightarrow> (\<And>x. x \<in> set ys \<Longrightarrow> P x = Q x) \<Longrightarrow> filter P xs = filter Q ys" |
68709 | 1612 |
by (induct ys arbitrary: xs) auto |
17501 | 1613 |
|
15281 | 1614 |
|
60758 | 1615 |
subsubsection \<open>List partitioning\<close> |
26442
57fb6a8b099e
restructuring; explicit case names for rule list_induct2
haftmann
parents:
26300
diff
changeset
|
1616 |
|
57fb6a8b099e
restructuring; explicit case names for rule list_induct2
haftmann
parents:
26300
diff
changeset
|
1617 |
primrec partition :: "('a \<Rightarrow> bool) \<Rightarrow>'a list \<Rightarrow> 'a list \<times> 'a list" where |
68719 | 1618 |
"partition P [] = ([], [])" | |
1619 |
"partition P (x # xs) = |
|
50548 | 1620 |
(let (yes, no) = partition P xs |
1621 |
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
|
1622 |
|
58807 | 1623 |
lemma partition_filter1: "fst (partition P xs) = filter P xs" |
68719 | 1624 |
by (induct xs) (auto simp add: Let_def split_def) |
26442
57fb6a8b099e
restructuring; explicit case names for rule list_induct2
haftmann
parents:
26300
diff
changeset
|
1625 |
|
67091 | 1626 |
lemma partition_filter2: "snd (partition P xs) = filter (Not \<circ> P) xs" |
68719 | 1627 |
by (induct xs) (auto simp add: Let_def split_def) |
26442
57fb6a8b099e
restructuring; explicit case names for rule list_induct2
haftmann
parents:
26300
diff
changeset
|
1628 |
|
57fb6a8b099e
restructuring; explicit case names for rule list_induct2
haftmann
parents:
26300
diff
changeset
|
1629 |
lemma partition_P: |
57fb6a8b099e
restructuring; explicit case names for rule list_induct2
haftmann
parents:
26300
diff
changeset
|
1630 |
assumes "partition P xs = (yes, no)" |
57fb6a8b099e
restructuring; explicit case names for rule list_induct2
haftmann
parents:
26300
diff
changeset
|
1631 |
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
|
1632 |
proof - |
57fb6a8b099e
restructuring; explicit case names for rule list_induct2
haftmann
parents:
26300
diff
changeset
|
1633 |
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
|
1634 |
by simp_all |
57fb6a8b099e
restructuring; explicit case names for rule list_induct2
haftmann
parents:
26300
diff
changeset
|
1635 |
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
|
1636 |
qed |
57fb6a8b099e
restructuring; explicit case names for rule list_induct2
haftmann
parents:
26300
diff
changeset
|
1637 |
|
57fb6a8b099e
restructuring; explicit case names for rule list_induct2
haftmann
parents:
26300
diff
changeset
|
1638 |
lemma partition_set: |
57fb6a8b099e
restructuring; explicit case names for rule list_induct2
haftmann
parents:
26300
diff
changeset
|
1639 |
assumes "partition P xs = (yes, no)" |
57fb6a8b099e
restructuring; explicit case names for rule list_induct2
haftmann
parents:
26300
diff
changeset
|
1640 |
shows "set yes \<union> set no = set xs" |
57fb6a8b099e
restructuring; explicit case names for rule list_induct2
haftmann
parents:
26300
diff
changeset
|
1641 |
proof - |
57fb6a8b099e
restructuring; explicit case names for rule list_induct2
haftmann
parents:
26300
diff
changeset
|
1642 |
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
|
1643 |
by simp_all |
64963 | 1644 |
then show ?thesis by (auto simp add: partition_filter1 partition_filter2) |
26442
57fb6a8b099e
restructuring; explicit case names for rule list_induct2
haftmann
parents:
26300
diff
changeset
|
1645 |
qed |
57fb6a8b099e
restructuring; explicit case names for rule list_induct2
haftmann
parents:
26300
diff
changeset
|
1646 |
|
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
|
1647 |
lemma partition_filter_conv[simp]: |
67091 | 1648 |
"partition f xs = (filter f xs,filter (Not \<circ> f) xs)" |
68719 | 1649 |
unfolding partition_filter2[symmetric] |
1650 |
unfolding partition_filter1[symmetric] 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
|
1651 |
|
603320b93668
New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents:
33593
diff
changeset
|
1652 |
declare partition.simps[simp del] |
26442
57fb6a8b099e
restructuring; explicit case names for rule list_induct2
haftmann
parents:
26300
diff
changeset
|
1653 |
|
35115 | 1654 |
|
69593 | 1655 |
subsubsection \<open>\<^const>\<open>concat\<close>\<close> |
13114 | 1656 |
|
13142 | 1657 |
lemma concat_append [simp]: "concat (xs @ ys) = concat xs @ concat ys" |
68719 | 1658 |
by (induct xs) auto |
13114 | 1659 |
|
18447 | 1660 |
lemma concat_eq_Nil_conv [simp]: "(concat xss = []) = (\<forall>xs \<in> set xss. xs = [])" |
68719 | 1661 |
by (induct xss) auto |
13114 | 1662 |
|
18447 | 1663 |
lemma Nil_eq_concat_conv [simp]: "([] = concat xss) = (\<forall>xs \<in> set xss. xs = [])" |
68719 | 1664 |
by (induct xss) auto |
13114 | 1665 |
|
69276 | 1666 |
lemma set_concat [simp]: "set (concat xs) = (\<Union>x\<in>set xs. set x)" |
68719 | 1667 |
by (induct xs) auto |
13114 | 1668 |
|
24476
f7ad9fbbeeaa
turned list comprehension translations into ML to optimize base case
nipkow
parents:
24471
diff
changeset
|
1669 |
lemma concat_map_singleton[simp]: "concat(map (%x. [f x]) xs) = map f xs" |
68719 | 1670 |
by (induct xs) auto |
24349 | 1671 |
|
13142 | 1672 |
lemma map_concat: "map f (concat xs) = concat (map (map f) xs)" |
68719 | 1673 |
by (induct xs) auto |
13114 | 1674 |
|
13142 | 1675 |
lemma filter_concat: "filter p (concat xs) = concat (map (filter p) xs)" |
68719 | 1676 |
by (induct xs) auto |
13114 | 1677 |
|
13142 | 1678 |
lemma rev_concat: "rev (concat xs) = concat (map rev (rev xs))" |
68719 | 1679 |
by (induct xs) auto |
13114 | 1680 |
|
71585 | 1681 |
lemma concat_eq_concat_iff: "\<forall>(x, y) \<in> set (zip xs ys). length x = length y \<Longrightarrow> length xs = length ys \<Longrightarrow> (concat xs = concat ys) = (xs = ys)" |
40365
a1456f2e1c9d
added two lemmas about injectivity of concat to the list theory
bulwahn
parents:
40304
diff
changeset
|
1682 |
proof (induct xs arbitrary: ys) |
a1456f2e1c9d
added two lemmas about injectivity of concat to the list theory
bulwahn
parents:
40304
diff
changeset
|
1683 |
case (Cons x xs ys) |
a1456f2e1c9d
added two lemmas about injectivity of concat to the list theory
bulwahn
parents:
40304
diff
changeset
|
1684 |
thus ?case by (cases ys) auto |
a1456f2e1c9d
added two lemmas about injectivity of concat to the list theory
bulwahn
parents:
40304
diff
changeset
|
1685 |
qed (auto) |
a1456f2e1c9d
added two lemmas about injectivity of concat to the list theory
bulwahn
parents:
40304
diff
changeset
|
1686 |
|
71585 | 1687 |
lemma concat_injective: "concat xs = concat ys \<Longrightarrow> length xs = length ys \<Longrightarrow> \<forall>(x, y) \<in> set (zip xs ys). length x = length y \<Longrightarrow> xs = ys" |
68719 | 1688 |
by (simp add: concat_eq_concat_iff) |
40365
a1456f2e1c9d
added two lemmas about injectivity of concat to the list theory
bulwahn
parents:
40304
diff
changeset
|
1689 |
|
71393
fce780f9c9c6
new examples of BNF lifting across quotients using a new theory of confluence,
traytel
parents:
70911
diff
changeset
|
1690 |
lemma concat_eq_appendD: |
fce780f9c9c6
new examples of BNF lifting across quotients using a new theory of confluence,
traytel
parents:
70911
diff
changeset
|
1691 |
assumes "concat xss = ys @ zs" "xss \<noteq> []" |
fce780f9c9c6
new examples of BNF lifting across quotients using a new theory of confluence,
traytel
parents:
70911
diff
changeset
|
1692 |
shows "\<exists>xss1 xs xs' xss2. xss = xss1 @ (xs @ xs') # xss2 \<and> ys = concat xss1 @ xs \<and> zs = xs' @ concat xss2" |
fce780f9c9c6
new examples of BNF lifting across quotients using a new theory of confluence,
traytel
parents:
70911
diff
changeset
|
1693 |
using assms |
fce780f9c9c6
new examples of BNF lifting across quotients using a new theory of confluence,
traytel
parents:
70911
diff
changeset
|
1694 |
proof(induction xss arbitrary: ys) |
fce780f9c9c6
new examples of BNF lifting across quotients using a new theory of confluence,
traytel
parents:
70911
diff
changeset
|
1695 |
case (Cons xs xss) |
fce780f9c9c6
new examples of BNF lifting across quotients using a new theory of confluence,
traytel
parents:
70911
diff
changeset
|
1696 |
from Cons.prems consider |
fce780f9c9c6
new examples of BNF lifting across quotients using a new theory of confluence,
traytel
parents:
70911
diff
changeset
|
1697 |
us where "xs @ us = ys" "concat xss = us @ zs" | |
fce780f9c9c6
new examples of BNF lifting across quotients using a new theory of confluence,
traytel
parents:
70911
diff
changeset
|
1698 |
us where "xs = ys @ us" "us @ concat xss = zs" |
fce780f9c9c6
new examples of BNF lifting across quotients using a new theory of confluence,
traytel
parents:
70911
diff
changeset
|
1699 |
by(auto simp add: append_eq_append_conv2) |
fce780f9c9c6
new examples of BNF lifting across quotients using a new theory of confluence,
traytel
parents:
70911
diff
changeset
|
1700 |
then show ?case |
fce780f9c9c6
new examples of BNF lifting across quotients using a new theory of confluence,
traytel
parents:
70911
diff
changeset
|
1701 |
proof cases |
fce780f9c9c6
new examples of BNF lifting across quotients using a new theory of confluence,
traytel
parents:
70911
diff
changeset
|
1702 |
case 1 |
fce780f9c9c6
new examples of BNF lifting across quotients using a new theory of confluence,
traytel
parents:
70911
diff
changeset
|
1703 |
then show ?thesis using Cons.IH[OF 1(2)] |
fce780f9c9c6
new examples of BNF lifting across quotients using a new theory of confluence,
traytel
parents:
70911
diff
changeset
|
1704 |
by(cases xss)(auto intro: exI[where x="[]"], metis append.assoc append_Cons concat.simps(2)) |
fce780f9c9c6
new examples of BNF lifting across quotients using a new theory of confluence,
traytel
parents:
70911
diff
changeset
|
1705 |
qed(auto intro: exI[where x="[]"]) |
fce780f9c9c6
new examples of BNF lifting across quotients using a new theory of confluence,
traytel
parents:
70911
diff
changeset
|
1706 |
qed simp |
fce780f9c9c6
new examples of BNF lifting across quotients using a new theory of confluence,
traytel
parents:
70911
diff
changeset
|
1707 |
|
fce780f9c9c6
new examples of BNF lifting across quotients using a new theory of confluence,
traytel
parents:
70911
diff
changeset
|
1708 |
lemma concat_eq_append_conv: |
fce780f9c9c6
new examples of BNF lifting across quotients using a new theory of confluence,
traytel
parents:
70911
diff
changeset
|
1709 |
"concat xss = ys @ zs \<longleftrightarrow> |
fce780f9c9c6
new examples of BNF lifting across quotients using a new theory of confluence,
traytel
parents:
70911
diff
changeset
|
1710 |
(if xss = [] then ys = [] \<and> zs = [] |
fce780f9c9c6
new examples of BNF lifting across quotients using a new theory of confluence,
traytel
parents:
70911
diff
changeset
|
1711 |
else \<exists>xss1 xs xs' xss2. xss = xss1 @ (xs @ xs') # xss2 \<and> ys = concat xss1 @ xs \<and> zs = xs' @ concat xss2)" |
fce780f9c9c6
new examples of BNF lifting across quotients using a new theory of confluence,
traytel
parents:
70911
diff
changeset
|
1712 |
by(auto dest: concat_eq_appendD) |
fce780f9c9c6
new examples of BNF lifting across quotients using a new theory of confluence,
traytel
parents:
70911
diff
changeset
|
1713 |
|
71827 | 1714 |
lemma hd_concat: "\<lbrakk>xs \<noteq> []; hd xs \<noteq> []\<rbrakk> \<Longrightarrow> hd (concat xs) = hd (hd xs)" |
1715 |
by (metis concat.simps(2) hd_Cons_tl hd_append2) |
|
1716 |
||
13114 | 1717 |
|
69593 | 1718 |
subsubsection \<open>\<^const>\<open>nth\<close>\<close> |
13114 | 1719 |
|
29827 | 1720 |
lemma nth_Cons_0 [simp, code]: "(x # xs)!0 = x" |
68719 | 1721 |
by auto |
13114 | 1722 |
|
29827 | 1723 |
lemma nth_Cons_Suc [simp, code]: "(x # xs)!(Suc n) = xs!n" |
68719 | 1724 |
by auto |
13114 | 1725 |
|
13142 | 1726 |
declare nth.simps [simp del] |
13114 | 1727 |
|
41842 | 1728 |
lemma nth_Cons_pos[simp]: "0 < n \<Longrightarrow> (x#xs) ! n = xs ! (n - 1)" |
68719 | 1729 |
by(auto simp: Nat.gr0_conv_Suc) |
41842 | 1730 |
|
13114 | 1731 |
lemma nth_append: |
24526 | 1732 |
"(xs @ ys)!n = (if n < length xs then xs!n else ys!(n - length xs))" |
68709 | 1733 |
proof (induct xs arbitrary: n) |
1734 |
case (Cons x xs) |
|
1735 |
then show ?case |
|
1736 |
using less_Suc_eq_0_disj by auto |
|
1737 |
qed simp |
|
13114 | 1738 |
|
14402
4201e1916482
moved lemmas from MicroJava/Comp/AuxLemmas.thy to List.thy
nipkow
parents:
14395
diff
changeset
|
1739 |
lemma nth_append_length [simp]: "(xs @ x # ys) ! length xs = x" |
68719 | 1740 |
by (induct xs) auto |
14402
4201e1916482
moved lemmas from MicroJava/Comp/AuxLemmas.thy to List.thy
nipkow
parents:
14395
diff
changeset
|
1741 |
|
4201e1916482
moved lemmas from MicroJava/Comp/AuxLemmas.thy to List.thy
nipkow
parents:
14395
diff
changeset
|
1742 |
lemma nth_append_length_plus[simp]: "(xs @ ys) ! (length xs + n) = ys ! n" |
68719 | 1743 |
by (induct xs) auto |
14402
4201e1916482
moved lemmas from MicroJava/Comp/AuxLemmas.thy to List.thy
nipkow
parents:
14395
diff
changeset
|
1744 |
|
71585 | 1745 |
lemma nth_map [simp]: "n < length xs \<Longrightarrow> (map f xs)!n = f(xs!n)" |
68709 | 1746 |
proof (induct xs arbitrary: n) |
1747 |
case (Cons x xs) |
|
1748 |
then show ?case |
|
1749 |
using less_Suc_eq_0_disj by auto |
|
1750 |
qed simp |
|
13114 | 1751 |
|
66847 | 1752 |
lemma nth_tl: "n < length (tl xs) \<Longrightarrow> tl xs ! n = xs ! Suc n" |
68719 | 1753 |
by (induction xs) auto |
45841 | 1754 |
|
18423 | 1755 |
lemma hd_conv_nth: "xs \<noteq> [] \<Longrightarrow> hd xs = xs!0" |
68719 | 1756 |
by(cases xs) simp_all |
18423 | 1757 |
|
18049 | 1758 |
|
1759 |
lemma list_eq_iff_nth_eq: |
|
67717 | 1760 |
"(xs = ys) = (length xs = length ys \<and> (\<forall>i<length xs. xs!i = ys!i))" |
68709 | 1761 |
proof (induct xs arbitrary: ys) |
1762 |
case (Cons x xs ys) |
|
71393
fce780f9c9c6
new examples of BNF lifting across quotients using a new theory of confluence,
traytel
parents:
70911
diff
changeset
|
1763 |
show ?case |
68709 | 1764 |
proof (cases ys) |
1765 |
case (Cons y ys) |
|
1766 |
then show ?thesis |
|
1767 |
using Cons.hyps by fastforce |
|
1768 |
qed simp |
|
1769 |
qed force |
|
18049 | 1770 |
|
13142 | 1771 |
lemma set_conv_nth: "set xs = {xs!i | i. i < length xs}" |
68709 | 1772 |
proof (induct xs) |
1773 |
case (Cons x xs) |
|
1774 |
have "insert x {xs ! i |i. i < length xs} = {(x # xs) ! i |i. i < Suc (length xs)}" (is "?L=?R") |
|
1775 |
proof |
|
1776 |
show "?L \<subseteq> ?R" |
|
1777 |
by force |
|
1778 |
show "?R \<subseteq> ?L" |
|
1779 |
using less_Suc_eq_0_disj by auto |
|
1780 |
qed |
|
1781 |
with Cons show ?case |
|
1782 |
by simp |
|
1783 |
qed simp |
|
13114 | 1784 |
|
17501 | 1785 |
lemma in_set_conv_nth: "(x \<in> set xs) = (\<exists>i < length xs. xs!i = x)" |
68719 | 1786 |
by(auto simp:set_conv_nth) |
17501 | 1787 |
|
51160
599ff65b85e2
systematic conversions between nat and nibble/char;
haftmann
parents:
51112
diff
changeset
|
1788 |
lemma nth_equal_first_eq: |
599ff65b85e2
systematic conversions between nat and nibble/char;
haftmann
parents:
51112
diff
changeset
|
1789 |
assumes "x \<notin> set xs" |
599ff65b85e2
systematic conversions between nat and nibble/char;
haftmann
parents:
51112
diff
changeset
|
1790 |
assumes "n \<le> length xs" |
599ff65b85e2
systematic conversions between nat and nibble/char;
haftmann
parents:
51112
diff
changeset
|
1791 |
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
|
1792 |
proof |
599ff65b85e2
systematic conversions between nat and nibble/char;
haftmann
parents:
51112
diff
changeset
|
1793 |
assume ?lhs |
599ff65b85e2
systematic conversions between nat and nibble/char;
haftmann
parents:
51112
diff
changeset
|
1794 |
show ?rhs |
599ff65b85e2
systematic conversions between nat and nibble/char;
haftmann
parents:
51112
diff
changeset
|
1795 |
proof (rule ccontr) |
599ff65b85e2
systematic conversions between nat and nibble/char;
haftmann
parents:
51112
diff
changeset
|
1796 |
assume "n \<noteq> 0" |
599ff65b85e2
systematic conversions between nat and nibble/char;
haftmann
parents:
51112
diff
changeset
|
1797 |
then have "n > 0" by simp |
60758 | 1798 |
with \<open>?lhs\<close> have "xs ! (n - 1) = x" by simp |
1799 |
moreover from \<open>n > 0\<close> \<open>n \<le> length xs\<close> have "n - 1 < length xs" by simp |
|
51160
599ff65b85e2
systematic conversions between nat and nibble/char;
haftmann
parents:
51112
diff
changeset
|
1800 |
ultimately have "\<exists>i<length xs. xs ! i = x" by auto |
60758 | 1801 |
with \<open>x \<notin> set xs\<close> in_set_conv_nth [of x xs] show False by simp |
51160
599ff65b85e2
systematic conversions between nat and nibble/char;
haftmann
parents:
51112
diff
changeset
|
1802 |
qed |
599ff65b85e2
systematic conversions between nat and nibble/char;
haftmann
parents:
51112
diff
changeset
|
1803 |
next |
599ff65b85e2
systematic conversions between nat and nibble/char;
haftmann
parents:
51112
diff
changeset
|
1804 |
assume ?rhs then show ?lhs by simp |
599ff65b85e2
systematic conversions between nat and nibble/char;
haftmann
parents:
51112
diff
changeset
|
1805 |
qed |
599ff65b85e2
systematic conversions between nat and nibble/char;
haftmann
parents:
51112
diff
changeset
|
1806 |
|
599ff65b85e2
systematic conversions between nat and nibble/char;
haftmann
parents:
51112
diff
changeset
|
1807 |
lemma nth_non_equal_first_eq: |
599ff65b85e2
systematic conversions between nat and nibble/char;
haftmann
parents:
51112
diff
changeset
|
1808 |
assumes "x \<noteq> y" |
599ff65b85e2
systematic conversions between nat and nibble/char;
haftmann
parents:
51112
diff
changeset
|
1809 |
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
|
1810 |
proof |
599ff65b85e2
systematic conversions between nat and nibble/char;
haftmann
parents:
51112
diff
changeset
|
1811 |
assume "?lhs" with assms have "n > 0" by (cases n) simp_all |
60758 | 1812 |
with \<open>?lhs\<close> show ?rhs by simp |
51160
599ff65b85e2
systematic conversions between nat and nibble/char;
haftmann
parents:
51112
diff
changeset
|
1813 |
next |
599ff65b85e2
systematic conversions between nat and nibble/char;
haftmann
parents:
51112
diff
changeset
|
1814 |
assume "?rhs" then show "?lhs" by simp |
599ff65b85e2
systematic conversions between nat and nibble/char;
haftmann
parents:
51112
diff
changeset
|
1815 |
qed |
599ff65b85e2
systematic conversions between nat and nibble/char;
haftmann
parents:
51112
diff
changeset
|
1816 |
|
67613 | 1817 |
lemma list_ball_nth: "\<lbrakk>n < length xs; \<forall>x \<in> set xs. P x\<rbrakk> \<Longrightarrow> P(xs!n)" |
68719 | 1818 |
by (auto simp add: set_conv_nth) |
13114 | 1819 |
|
67613 | 1820 |
lemma nth_mem [simp]: "n < length xs \<Longrightarrow> xs!n \<in> set xs" |
68719 | 1821 |
by (auto simp add: set_conv_nth) |
13114 | 1822 |
|
1823 |
lemma all_nth_imp_all_set: |
|
67717 | 1824 |
"\<lbrakk>\<forall>i < length xs. P(xs!i); x \<in> set xs\<rbrakk> \<Longrightarrow> P x" |
68719 | 1825 |
by (auto simp add: set_conv_nth) |
13114 | 1826 |
|
1827 |
lemma all_set_conv_all_nth: |
|
67091 | 1828 |
"(\<forall>x \<in> set xs. P x) = (\<forall>i. i < length xs \<longrightarrow> P (xs ! i))" |
68719 | 1829 |
by (auto simp add: set_conv_nth) |
13114 | 1830 |
|
25296 | 1831 |
lemma rev_nth: |
1832 |
"n < size xs \<Longrightarrow> rev xs ! n = xs ! (length xs - Suc n)" |
|
1833 |
proof (induct xs arbitrary: n) |
|
1834 |
case Nil thus ?case by simp |
|
1835 |
next |
|
1836 |
case (Cons x xs) |
|
1837 |
hence n: "n < Suc (length xs)" by simp |
|
1838 |
moreover |
|
1839 |
{ assume "n < length xs" |
|
53374
a14d2a854c02
tuned proofs -- clarified flow of facts wrt. calculation;
wenzelm
parents:
53017
diff
changeset
|
1840 |
with n obtain n' where n': "length xs - n = Suc n'" |
25296 | 1841 |
by (cases "length xs - n", auto) |
1842 |
moreover |
|
53374
a14d2a854c02
tuned proofs -- clarified flow of facts wrt. calculation;
wenzelm
parents:
53017
diff
changeset
|
1843 |
from n' have "length xs - Suc n = n'" by simp |
25296 | 1844 |
ultimately |
1845 |
have "xs ! (length xs - Suc n) = (x # xs) ! (length xs - n)" by simp |
|
1846 |
} |
|
1847 |
ultimately |
|
1848 |
show ?case by (clarsimp simp add: Cons nth_append) |
|
1849 |
qed |
|
13114 | 1850 |
|
31159 | 1851 |
lemma Skolem_list_nth: |
67091 | 1852 |
"(\<forall>i<k. \<exists>x. P i x) = (\<exists>xs. size xs = k \<and> (\<forall>i<k. P i (xs!i)))" |
1853 |
(is "_ = (\<exists>xs. ?P k xs)") |
|
31159 | 1854 |
proof(induct k) |
1855 |
case 0 show ?case by simp |
|
1856 |
next |
|
1857 |
case (Suc k) |
|
67091 | 1858 |
show ?case (is "?L = ?R" is "_ = (\<exists>xs. ?P' xs)") |
31159 | 1859 |
proof |
1860 |
assume "?R" thus "?L" using Suc by auto |
|
1861 |
next |
|
1862 |
assume "?L" |
|
67091 | 1863 |
with Suc obtain x xs where "?P k xs \<and> P k x" by (metis less_Suc_eq) |
31159 | 1864 |
hence "?P'(xs@[x])" by(simp add:nth_append less_Suc_eq) |
1865 |
thus "?R" .. |
|
1866 |
qed |
|
1867 |
qed |
|
1868 |
||
1869 |
||
69593 | 1870 |
subsubsection \<open>\<^const>\<open>list_update\<close>\<close> |
13114 | 1871 |
|
24526 | 1872 |
lemma length_list_update [simp]: "length(xs[i:=x]) = length xs" |
68719 | 1873 |
by (induct xs arbitrary: i) (auto split: nat.split) |
13114 | 1874 |
|
1875 |
lemma nth_list_update: |
|
71585 | 1876 |
"i < length xs\<Longrightarrow> (xs[i:=x])!j = (if i = j then x else xs!j)" |
68719 | 1877 |
by (induct xs arbitrary: i j) (auto simp add: nth_Cons split: nat.split) |
13114 | 1878 |
|
71585 | 1879 |
lemma nth_list_update_eq [simp]: "i < length xs \<Longrightarrow> (xs[i:=x])!i = x" |
68719 | 1880 |
by (simp add: nth_list_update) |
13114 | 1881 |
|
71585 | 1882 |
lemma nth_list_update_neq [simp]: "i \<noteq> j \<Longrightarrow> xs[i:=x]!j = xs!j" |
68719 | 1883 |
by (induct xs arbitrary: i j) (auto simp add: nth_Cons split: nat.split) |
13114 | 1884 |
|
24526 | 1885 |
lemma list_update_id[simp]: "xs[i := xs!i] = xs" |
68719 | 1886 |
by (induct xs arbitrary: i) (simp_all split:nat.splits) |
24526 | 1887 |
|
1888 |
lemma list_update_beyond[simp]: "length xs \<le> i \<Longrightarrow> xs[i:=x] = xs" |
|
68709 | 1889 |
proof (induct xs arbitrary: i) |
1890 |
case (Cons x xs i) |
|
1891 |
then show ?case |
|
1892 |
by (metis leD length_list_update list_eq_iff_nth_eq nth_list_update_neq) |
|
1893 |
qed simp |
|
17501 | 1894 |
|
31077 | 1895 |
lemma list_update_nonempty[simp]: "xs[k:=x] = [] \<longleftrightarrow> xs=[]" |
68719 | 1896 |
by (simp only: length_0_conv[symmetric] length_list_update) |
31077 | 1897 |
|
13114 | 1898 |
lemma list_update_same_conv: |
71585 | 1899 |
"i < length xs \<Longrightarrow> (xs[i := x] = xs) = (xs!i = x)" |
68719 | 1900 |
by (induct xs arbitrary: i) (auto split: nat.split) |
13114 | 1901 |
|
14187 | 1902 |
lemma list_update_append1: |
58807 | 1903 |
"i < size xs \<Longrightarrow> (xs @ ys)[i:=x] = xs[i:=x] @ ys" |
68719 | 1904 |
by (induct xs arbitrary: i)(auto split:nat.split) |
14187 | 1905 |
|
15868 | 1906 |
lemma list_update_append: |
64963 | 1907 |
"(xs @ ys) [n:= x] = |
15868 | 1908 |
(if n < length xs then xs[n:= x] @ ys else xs @ (ys [n-length xs:= x]))" |
68719 | 1909 |
by (induct xs arbitrary: n) (auto split:nat.splits) |
15868 | 1910 |
|
14402
4201e1916482
moved lemmas from MicroJava/Comp/AuxLemmas.thy to List.thy
nipkow
parents:
14395
diff
changeset
|
1911 |
lemma list_update_length [simp]: |
58807 | 1912 |
"(xs @ x # ys)[length xs := y] = (xs @ y # ys)" |
68719 | 1913 |
by (induct xs, auto) |
14402
4201e1916482
moved lemmas from MicroJava/Comp/AuxLemmas.thy to List.thy
nipkow
parents:
14395
diff
changeset
|
1914 |
|
31264 | 1915 |
lemma map_update: "map f (xs[k:= y]) = (map f xs)[k := f y]" |
68719 | 1916 |
by(induct xs arbitrary: k)(auto split:nat.splits) |
31264 | 1917 |
|
1918 |
lemma rev_update: |
|
1919 |
"k < length xs \<Longrightarrow> rev (xs[k:= y]) = (rev xs)[length xs - k - 1 := y]" |
|
68719 | 1920 |
by (induct xs arbitrary: k) (auto simp: list_update_append split:nat.splits) |
31264 | 1921 |
|
13114 | 1922 |
lemma update_zip: |
31080 | 1923 |
"(zip xs ys)[i:=xy] = zip (xs[i:=fst xy]) (ys[i:=snd xy])" |
68719 | 1924 |
by (induct ys arbitrary: i xy xs) (auto, case_tac xs, auto split: nat.split) |
24526 | 1925 |
|
68709 | 1926 |
lemma set_update_subset_insert: "set(xs[i:=x]) \<le> insert x (set xs)" |
68719 | 1927 |
by (induct xs arbitrary: i) (auto split: nat.split) |
13114 | 1928 |
|
67613 | 1929 |
lemma set_update_subsetI: "\<lbrakk>set xs \<subseteq> A; x \<in> A\<rbrakk> \<Longrightarrow> set(xs[i := x]) \<subseteq> A" |
68719 | 1930 |
by (blast dest!: set_update_subset_insert [THEN subsetD]) |
13114 | 1931 |
|
24526 | 1932 |
lemma set_update_memI: "n < length xs \<Longrightarrow> x \<in> set (xs[n := x])" |
68719 | 1933 |
by (induct xs arbitrary: n) (auto split:nat.splits) |
15868 | 1934 |
|
31077 | 1935 |
lemma list_update_overwrite[simp]: |
24796 | 1936 |
"xs [i := x, i := y] = xs [i := y]" |
68709 | 1937 |
by (induct xs arbitrary: i) (simp_all split: nat.split) |
24796 | 1938 |
|
1939 |
lemma list_update_swap: |
|
1940 |
"i \<noteq> i' \<Longrightarrow> xs [i := x, i' := x'] = xs [i' := x', i := x]" |
|
68709 | 1941 |
by (induct xs arbitrary: i i') (simp_all split: nat.split) |
24796 | 1942 |
|
29827 | 1943 |
lemma list_update_code [code]: |
1944 |
"[][i := y] = []" |
|
1945 |
"(x # xs)[0 := y] = y # xs" |
|
1946 |
"(x # xs)[Suc i := y] = x # xs[i := y]" |
|
68719 | 1947 |
by simp_all |
29827 | 1948 |
|
13114 | 1949 |
|
69593 | 1950 |
subsubsection \<open>\<^const>\<open>last\<close> and \<^const>\<open>butlast\<close>\<close> |
13114 | 1951 |
|
13142 | 1952 |
lemma last_snoc [simp]: "last (xs @ [x]) = x" |
68719 | 1953 |
by (induct xs) auto |
13114 | 1954 |
|
13142 | 1955 |
lemma butlast_snoc [simp]: "butlast (xs @ [x]) = xs" |
68719 | 1956 |
by (induct xs) auto |
13114 | 1957 |
|
14302 | 1958 |
lemma last_ConsL: "xs = [] \<Longrightarrow> last(x#xs) = x" |
68719 | 1959 |
by simp |
14302 | 1960 |
|
1961 |
lemma last_ConsR: "xs \<noteq> [] \<Longrightarrow> last(x#xs) = last xs" |
|
68719 | 1962 |
by simp |
14302 | 1963 |
|
1964 |
lemma last_append: "last(xs @ ys) = (if ys = [] then last xs else last ys)" |
|
68719 | 1965 |
by (induct xs) (auto) |
14302 | 1966 |
|
1967 |
lemma last_appendL[simp]: "ys = [] \<Longrightarrow> last(xs @ ys) = last xs" |
|
68719 | 1968 |
by(simp add:last_append) |
14302 | 1969 |
|
1970 |
lemma last_appendR[simp]: "ys \<noteq> [] \<Longrightarrow> last(xs @ ys) = last ys" |
|
68719 | 1971 |
by(simp add:last_append) |
14302 | 1972 |
|
45841 | 1973 |
lemma last_tl: "xs = [] \<or> tl xs \<noteq> [] \<Longrightarrow>last (tl xs) = last xs" |
68719 | 1974 |
by (induct xs) simp_all |
45841 | 1975 |
|
1976 |
lemma butlast_tl: "butlast (tl xs) = tl (butlast xs)" |
|
68719 | 1977 |
by (induct xs) simp_all |
45841 | 1978 |
|
17762 | 1979 |
lemma hd_rev: "xs \<noteq> [] \<Longrightarrow> hd(rev xs) = last xs" |
68719 | 1980 |
by(rule rev_exhaust[of xs]) simp_all |
17762 | 1981 |
|
1982 |
lemma last_rev: "xs \<noteq> [] \<Longrightarrow> last(rev xs) = hd xs" |
|
68719 | 1983 |
by(cases xs) simp_all |
17762 | 1984 |
|
17765 | 1985 |
lemma last_in_set[simp]: "as \<noteq> [] \<Longrightarrow> last as \<in> set as" |
68719 | 1986 |
by (induct as) auto |
17762 | 1987 |
|
13142 | 1988 |
lemma length_butlast [simp]: "length (butlast xs) = length xs - 1" |
68719 | 1989 |
by (induct xs rule: rev_induct) auto |
13114 | 1990 |
|
1991 |
lemma butlast_append: |
|
24526 | 1992 |
"butlast (xs @ ys) = (if ys = [] then butlast xs else xs @ butlast ys)" |
68719 | 1993 |
by (induct xs arbitrary: ys) auto |
13114 | 1994 |
|
13142 | 1995 |
lemma append_butlast_last_id [simp]: |
67613 | 1996 |
"xs \<noteq> [] \<Longrightarrow> butlast xs @ [last xs] = xs" |
68719 | 1997 |
by (induct xs) auto |
13114 | 1998 |
|
67613 | 1999 |
lemma in_set_butlastD: "x \<in> set (butlast xs) \<Longrightarrow> x \<in> set xs" |
68719 | 2000 |
by (induct xs) (auto split: if_split_asm) |
13114 | 2001 |
|
2002 |
lemma in_set_butlast_appendI: |
|
67091 | 2003 |
"x \<in> set (butlast xs) \<or> x \<in> set (butlast ys) \<Longrightarrow> x \<in> set (butlast (xs @ ys))" |
68719 | 2004 |
by (auto dest: in_set_butlastD simp add: butlast_append) |
13114 | 2005 |
|
24526 | 2006 |
lemma last_drop[simp]: "n < length xs \<Longrightarrow> last (drop n xs) = last xs" |
68719 | 2007 |
by (induct xs arbitrary: n)(auto split:nat.split) |
17501 | 2008 |
|
45841 | 2009 |
lemma nth_butlast: |
2010 |
assumes "n < length (butlast xs)" shows "butlast xs ! n = xs ! n" |
|
2011 |
proof (cases xs) |
|
2012 |
case (Cons y ys) |
|
2013 |
moreover from assms have "butlast xs ! n = (butlast xs @ [last xs]) ! n" |
|
2014 |
by (simp add: nth_append) |
|
2015 |
ultimately show ?thesis using append_butlast_last_id by simp |
|
2016 |
qed simp |
|
2017 |
||
30128
365ee7319b86
revert some Suc 0 lemmas back to their original forms; added some simp rules for (1::nat)
huffman
parents:
30079
diff
changeset
|
2018 |
lemma last_conv_nth: "xs\<noteq>[] \<Longrightarrow> last xs = xs!(length xs - 1)" |
68719 | 2019 |
by(induct xs)(auto simp:neq_Nil_conv) |
17589 | 2020 |
|
30128
365ee7319b86
revert some Suc 0 lemmas back to their original forms; added some simp rules for (1::nat)
huffman
parents:
30079
diff
changeset
|
2021 |
lemma butlast_conv_take: "butlast xs = take (length xs - 1) xs" |
68719 | 2022 |
by (induction xs rule: induct_list012) simp_all |
26584
46f3b89b2445
move lemmas from Word/BinBoolList.thy to List.thy
huffman
parents:
26480
diff
changeset
|
2023 |
|
31077 | 2024 |
lemma last_list_update: |
2025 |
"xs \<noteq> [] \<Longrightarrow> last(xs[k:=x]) = (if k = size xs - 1 then x else last xs)" |
|
68719 | 2026 |
by (auto simp: last_conv_nth) |
31077 | 2027 |
|
2028 |
lemma butlast_list_update: |
|
2029 |
"butlast(xs[k:=x]) = |
|
58807 | 2030 |
(if k = size xs - 1 then butlast xs else (butlast xs)[k:=x])" |
68719 | 2031 |
by(cases xs rule:rev_cases)(auto simp: list_update_append split: nat.splits) |
58807 | 2032 |
|
2033 |
lemma last_map: "xs \<noteq> [] \<Longrightarrow> last (map f xs) = f (last xs)" |
|
68719 | 2034 |
by (cases xs rule: rev_cases) simp_all |
58807 | 2035 |
|
2036 |
lemma map_butlast: "map f (butlast xs) = butlast (map f xs)" |
|
68719 | 2037 |
by (induct xs) simp_all |
36851 | 2038 |
|
40230 | 2039 |
lemma snoc_eq_iff_butlast: |
67091 | 2040 |
"xs @ [x] = ys \<longleftrightarrow> (ys \<noteq> [] \<and> butlast ys = xs \<and> last ys = x)" |
68719 | 2041 |
by fastforce |
40230 | 2042 |
|
63173 | 2043 |
corollary longest_common_suffix: |
2044 |
"\<exists>ss xs' ys'. xs = xs' @ ss \<and> ys = ys' @ ss |
|
2045 |
\<and> (xs' = [] \<or> ys' = [] \<or> last xs' \<noteq> last ys')" |
|
68719 | 2046 |
using longest_common_prefix[of "rev xs" "rev ys"] |
2047 |
unfolding rev_swap rev_append by (metis last_rev rev_is_Nil_conv) |
|
63173 | 2048 |
|
70183
3ea80c950023
incorporated various material from the AFP into the distribution
haftmann
parents:
69850
diff
changeset
|
2049 |
lemma butlast_rev [simp]: "butlast (rev xs) = rev (tl xs)" |
3ea80c950023
incorporated various material from the AFP into the distribution
haftmann
parents:
69850
diff
changeset
|
2050 |
by (cases xs) simp_all |
3ea80c950023
incorporated various material from the AFP into the distribution
haftmann
parents:
69850
diff
changeset
|
2051 |
|
24796 | 2052 |
|
69593 | 2053 |
subsubsection \<open>\<^const>\<open>take\<close> and \<^const>\<open>drop\<close>\<close> |
13114 | 2054 |
|
66658 | 2055 |
lemma take_0: "take 0 xs = []" |
68719 | 2056 |
by (induct xs) auto |
66658 | 2057 |
|
2058 |
lemma drop_0: "drop 0 xs = xs" |
|
68719 | 2059 |
by (induct xs) auto |
13114 | 2060 |
|
66658 | 2061 |
lemma take0[simp]: "take 0 = (\<lambda>xs. [])" |
68719 | 2062 |
by(rule ext) (rule take_0) |
66658 | 2063 |
|
2064 |
lemma drop0[simp]: "drop 0 = (\<lambda>x. x)" |
|
68719 | 2065 |
by(rule ext) (rule drop_0) |
13114 | 2066 |
|
13142 | 2067 |
lemma take_Suc_Cons [simp]: "take (Suc n) (x # xs) = x # take n xs" |
68719 | 2068 |
by simp |
13114 | 2069 |
|
13142 | 2070 |
lemma drop_Suc_Cons [simp]: "drop (Suc n) (x # xs) = drop n xs" |
68719 | 2071 |
by simp |
13114 | 2072 |
|
13142 | 2073 |
declare take_Cons [simp del] and drop_Cons [simp del] |
13114 | 2074 |
|
67091 | 2075 |
lemma take_Suc: "xs \<noteq> [] \<Longrightarrow> take (Suc n) xs = hd xs # take n (tl xs)" |
68719 | 2076 |
by(clarsimp simp add:neq_Nil_conv) |
15110
78b5636eabc7
Added a number of new thms and the new function remove1
nipkow
parents:
15072
diff
changeset
|
2077 |
|
14187 | 2078 |
lemma drop_Suc: "drop (Suc n) xs = drop n (tl xs)" |
68719 | 2079 |
by(cases xs, simp_all) |
14187 | 2080 |
|
66870 | 2081 |
lemma hd_take[simp]: "j > 0 \<Longrightarrow> hd (take j xs) = hd xs" |
68719 | 2082 |
by (metis gr0_conv_Suc list.sel(1) take.simps(1) take_Suc) |
66657 | 2083 |
|
26584
46f3b89b2445
move lemmas from Word/BinBoolList.thy to List.thy
huffman
parents:
26480
diff
changeset
|
2084 |
lemma take_tl: "take n (tl xs) = tl (take (Suc n) xs)" |
68719 | 2085 |
by (induct xs arbitrary: n) simp_all |
26584
46f3b89b2445
move lemmas from Word/BinBoolList.thy to List.thy
huffman
parents:
26480
diff
changeset
|
2086 |
|
24526 | 2087 |
lemma drop_tl: "drop n (tl xs) = tl(drop n xs)" |
68719 | 2088 |
by(induct xs arbitrary: n, simp_all add:drop_Cons drop_Suc split:nat.split) |
24526 | 2089 |
|
26584
46f3b89b2445
move lemmas from Word/BinBoolList.thy to List.thy
huffman
parents:
26480
diff
changeset
|
2090 |
lemma tl_take: "tl (take n xs) = take (n - 1) (tl xs)" |
68719 | 2091 |
by (cases n, simp, cases xs, auto) |
26584
46f3b89b2445
move lemmas from Word/BinBoolList.thy to List.thy
huffman
parents:
26480
diff
changeset
|
2092 |
|
46f3b89b2445
move lemmas from Word/BinBoolList.thy to List.thy
huffman
parents:
26480
diff
changeset
|
2093 |
lemma tl_drop: "tl (drop n xs) = drop n (tl xs)" |
68719 | 2094 |
by (simp only: drop_tl) |
26584
46f3b89b2445
move lemmas from Word/BinBoolList.thy to List.thy
huffman
parents:
26480
diff
changeset
|
2095 |
|
24526 | 2096 |
lemma nth_via_drop: "drop n xs = y#ys \<Longrightarrow> xs!n = y" |
68719 | 2097 |
by (induct xs arbitrary: n, simp)(auto simp: drop_Cons nth_Cons split: nat.splits) |
14187 | 2098 |
|
13913 | 2099 |
lemma take_Suc_conv_app_nth: |
24526 | 2100 |
"i < length xs \<Longrightarrow> take (Suc i) xs = take i xs @ [xs!i]" |
68709 | 2101 |
proof (induct xs arbitrary: i) |
69850 | 2102 |
case Nil |
2103 |
then show ?case by simp |
|
2104 |
next |
|
2105 |
case Cons |
|
2106 |
then show ?case by (cases i) auto |
|
2107 |
qed |
|
13913 | 2108 |
|
58247
98d0f85d247f
enamed drop_Suc_conv_tl and nth_drop' to Cons_nth_drop_Suc
nipkow
parents:
58195
diff
changeset
|
2109 |
lemma Cons_nth_drop_Suc: |
24526 | 2110 |
"i < length xs \<Longrightarrow> (xs!i) # (drop (Suc i) xs) = drop i xs" |
68709 | 2111 |
proof (induct xs arbitrary: i) |
69850 | 2112 |
case Nil |
2113 |
then show ?case by simp |
|
2114 |
next |
|
2115 |
case Cons |
|
2116 |
then show ?case by (cases i) auto |
|
2117 |
qed |
|
14591 | 2118 |
|
24526 | 2119 |
lemma length_take [simp]: "length (take n xs) = min (length xs) n" |
68719 | 2120 |
by (induct n arbitrary: xs) (auto, case_tac xs, auto) |
24526 | 2121 |
|
2122 |
lemma length_drop [simp]: "length (drop n xs) = (length xs - n)" |
|
68719 | 2123 |
by (induct n arbitrary: xs) (auto, case_tac xs, auto) |
24526 | 2124 |
|
71585 | 2125 |
lemma take_all [simp]: "length xs \<le> n \<Longrightarrow> take n xs = xs" |
68719 | 2126 |
by (induct n arbitrary: xs) (auto, case_tac xs, auto) |
24526 | 2127 |
|
71585 | 2128 |
lemma drop_all [simp]: "length xs \<le> n \<Longrightarrow> drop n xs = []" |
68719 | 2129 |
by (induct n arbitrary: xs) (auto, case_tac xs, auto) |
13114 | 2130 |
|
13142 | 2131 |
lemma take_append [simp]: |
24526 | 2132 |
"take n (xs @ ys) = (take n xs @ take (n - length xs) ys)" |
68719 | 2133 |
by (induct n arbitrary: xs) (auto, case_tac xs, auto) |
13114 | 2134 |
|
13142 | 2135 |
lemma drop_append [simp]: |
24526 | 2136 |
"drop n (xs @ ys) = drop n xs @ drop (n - length xs) ys" |
68719 | 2137 |
by (induct n arbitrary: xs) (auto, case_tac xs, auto) |
24526 | 2138 |
|
2139 |
lemma take_take [simp]: "take n (take m xs) = take (min n m) xs" |
|
68709 | 2140 |
proof (induct m arbitrary: xs n) |
69850 | 2141 |
case 0 |
2142 |
then show ?case by simp |
|
2143 |
next |
|
2144 |
case Suc |
|
2145 |
then show ?case by (cases xs; cases n) simp_all |
|
2146 |
qed |
|
13114 | 2147 |
|
24526 | 2148 |
lemma drop_drop [simp]: "drop n (drop m xs) = drop (n + m) xs" |
68709 | 2149 |
proof (induct m arbitrary: xs) |
69850 | 2150 |
case 0 |
2151 |
then show ?case by simp |
|
2152 |
next |
|
2153 |
case Suc |
|
2154 |
then show ?case by (cases xs) simp_all |
|
2155 |
qed |
|
13114 | 2156 |
|
24526 | 2157 |
lemma take_drop: "take n (drop m xs) = drop m (take (n + m) xs)" |
68709 | 2158 |
proof (induct m arbitrary: xs n) |
69850 | 2159 |
case 0 |
2160 |
then show ?case by simp |
|
2161 |
next |
|
2162 |
case Suc |
|
2163 |
then show ?case by (cases xs; cases n) simp_all |
|
2164 |
qed |
|
13114 | 2165 |
|
24526 | 2166 |
lemma drop_take: "drop n (take m xs) = take (m-n) (drop n xs)" |
68719 | 2167 |
by(induct xs arbitrary: m n)(auto simp: take_Cons drop_Cons split: nat.split) |
14802 | 2168 |
|
24526 | 2169 |
lemma append_take_drop_id [simp]: "take n xs @ drop n xs = xs" |
68709 | 2170 |
proof (induct n arbitrary: xs) |
69850 | 2171 |
case 0 |
2172 |
then show ?case by simp |
|
2173 |
next |
|
2174 |
case Suc |
|
2175 |
then show ?case by (cases xs) simp_all |
|
2176 |
qed |
|
13114 | 2177 |
|
24526 | 2178 |
lemma take_eq_Nil[simp]: "(take n xs = []) = (n = 0 \<or> xs = [])" |
68719 | 2179 |
by(induct xs arbitrary: n)(auto simp: take_Cons split:nat.split) |
15110
78b5636eabc7
Added a number of new thms and the new function remove1
nipkow
parents:
15072
diff
changeset
|
2180 |
|
68709 | 2181 |
lemma drop_eq_Nil[simp]: "(drop n xs = []) = (length xs \<le> n)" |
68719 | 2182 |
by (induct xs arbitrary: n) (auto simp: drop_Cons split:nat.split) |
15110
78b5636eabc7
Added a number of new thms and the new function remove1
nipkow
parents:
15072
diff
changeset
|
2183 |
|
24526 | 2184 |
lemma take_map: "take n (map f xs) = map f (take n xs)" |
68709 | 2185 |
proof (induct n arbitrary: xs) |
69850 | 2186 |
case 0 |
2187 |
then show ?case by simp |
|
2188 |
next |
|
2189 |
case Suc |
|
2190 |
then show ?case by (cases xs) simp_all |
|
2191 |
qed |
|
13114 | 2192 |
|
24526 | 2193 |
lemma drop_map: "drop n (map f xs) = map f (drop n xs)" |
68709 | 2194 |
proof (induct n arbitrary: xs) |
69850 | 2195 |
case 0 |
2196 |
then show ?case by simp |
|
2197 |
next |
|
2198 |
case Suc |
|
2199 |
then show ?case by (cases xs) simp_all |
|
2200 |
qed |
|
13114 | 2201 |
|
24526 | 2202 |
lemma rev_take: "rev (take i xs) = drop (length xs - i) (rev xs)" |
68709 | 2203 |
proof (induct xs arbitrary: i) |
69850 | 2204 |
case Nil |
2205 |
then show ?case by simp |
|
2206 |
next |
|
2207 |
case Cons |
|
2208 |
then show ?case by (cases i) auto |
|
2209 |
qed |
|
13114 | 2210 |
|
24526 | 2211 |
lemma rev_drop: "rev (drop i xs) = take (length xs - i) (rev xs)" |
68709 | 2212 |
proof (induct xs arbitrary: i) |
69850 | 2213 |
case Nil |
2214 |
then show ?case by simp |
|
2215 |
next |
|
2216 |
case Cons |
|
2217 |
then show ?case by (cases i) auto |
|
2218 |
qed |
|
13114 | 2219 |
|
61699
a81dc5c4d6a9
New theorems mostly from Peter Gammie
paulson <lp15@cam.ac.uk>
parents:
61682
diff
changeset
|
2220 |
lemma drop_rev: "drop n (rev xs) = rev (take (length xs - n) xs)" |
a81dc5c4d6a9
New theorems mostly from Peter Gammie
paulson <lp15@cam.ac.uk>
parents:
61682
diff
changeset
|
2221 |
by (cases "length xs < n") (auto simp: rev_take) |
a81dc5c4d6a9
New theorems mostly from Peter Gammie
paulson <lp15@cam.ac.uk>
parents:
61682
diff
changeset
|
2222 |
|
a81dc5c4d6a9
New theorems mostly from Peter Gammie
paulson <lp15@cam.ac.uk>
parents:
61682
diff
changeset
|
2223 |
lemma take_rev: "take n (rev xs) = rev (drop (length xs - n) xs)" |
a81dc5c4d6a9
New theorems mostly from Peter Gammie
paulson <lp15@cam.ac.uk>
parents:
61682
diff
changeset
|
2224 |
by (cases "length xs < n") (auto simp: rev_drop) |
a81dc5c4d6a9
New theorems mostly from Peter Gammie
paulson <lp15@cam.ac.uk>
parents:
61682
diff
changeset
|
2225 |
|
71585 | 2226 |
lemma nth_take [simp]: "i < n \<Longrightarrow> (take n xs)!i = xs!i" |
68709 | 2227 |
proof (induct xs arbitrary: i n) |
69850 | 2228 |
case Nil |
2229 |
then show ?case by simp |
|
2230 |
next |
|
2231 |
case Cons |
|
2232 |
then show ?case by (cases n; cases i) simp_all |
|
2233 |
qed |
|
13114 | 2234 |
|
13142 | 2235 |
lemma nth_drop [simp]: |
71585 | 2236 |
"n \<le> length xs \<Longrightarrow> (drop n xs)!i = xs!(n + i)" |
68709 | 2237 |
proof (induct n arbitrary: xs) |
69850 | 2238 |
case 0 |
2239 |
then show ?case by simp |
|
2240 |
next |
|
2241 |
case Suc |
|
2242 |
then show ?case by (cases xs) simp_all |
|
2243 |
qed |
|
3507 | 2244 |
|
26584
46f3b89b2445
move lemmas from Word/BinBoolList.thy to List.thy
huffman
parents:
26480
diff
changeset
|
2245 |
lemma butlast_take: |
71585 | 2246 |
"n \<le> length xs \<Longrightarrow> butlast (take n xs) = take (n - 1) xs" |
68719 | 2247 |
by (simp add: butlast_conv_take min.absorb1 min.absorb2) |
26584
46f3b89b2445
move lemmas from Word/BinBoolList.thy to List.thy
huffman
parents:
26480
diff
changeset
|
2248 |
|
46f3b89b2445
move lemmas from Word/BinBoolList.thy to List.thy
huffman
parents:
26480
diff
changeset
|
2249 |
lemma butlast_drop: "butlast (drop n xs) = drop n (butlast xs)" |
68719 | 2250 |
by (simp add: butlast_conv_take drop_take ac_simps) |
26584
46f3b89b2445
move lemmas from Word/BinBoolList.thy to List.thy
huffman
parents:
26480
diff
changeset
|
2251 |
|
71585 | 2252 |
lemma take_butlast: "n < length xs \<Longrightarrow> take n (butlast xs) = take n xs" |
68719 | 2253 |
by (simp add: butlast_conv_take min.absorb1) |
26584
46f3b89b2445
move lemmas from Word/BinBoolList.thy to List.thy
huffman
parents:
26480
diff
changeset
|
2254 |
|
46f3b89b2445
move lemmas from Word/BinBoolList.thy to List.thy
huffman
parents:
26480
diff
changeset
|
2255 |
lemma drop_butlast: "drop n (butlast xs) = butlast (drop n xs)" |
68719 | 2256 |
by (simp add: butlast_conv_take drop_take ac_simps) |
26584
46f3b89b2445
move lemmas from Word/BinBoolList.thy to List.thy
huffman
parents:
26480
diff
changeset
|
2257 |
|
46500
0196966d6d2d
removing unnecessary premises in theorems of List theory
bulwahn
parents:
46448
diff
changeset
|
2258 |
lemma hd_drop_conv_nth: "n < length xs \<Longrightarrow> hd(drop n xs) = xs!n" |
68719 | 2259 |
by(simp add: hd_conv_nth) |
18423 | 2260 |
|
35248 | 2261 |
lemma set_take_subset_set_take: |
68709 | 2262 |
"m \<le> n \<Longrightarrow> set(take m xs) \<le> set(take n xs)" |
2263 |
proof (induct xs arbitrary: m n) |
|
2264 |
case (Cons x xs m n) then show ?case |
|
2265 |
by (cases n) (auto simp: take_Cons) |
|
2266 |
qed simp |
|
35248 | 2267 |
|
24526 | 2268 |
lemma set_take_subset: "set(take n xs) \<subseteq> set xs" |
68719 | 2269 |
by(induct xs arbitrary: n)(auto simp:take_Cons split:nat.split) |
24526 | 2270 |
|
2271 |
lemma set_drop_subset: "set(drop n xs) \<subseteq> set xs" |
|
68719 | 2272 |
by(induct xs arbitrary: n)(auto simp:drop_Cons split:nat.split) |
14025 | 2273 |
|
35248 | 2274 |
lemma set_drop_subset_set_drop: |
68709 | 2275 |
"m \<ge> n \<Longrightarrow> set(drop m xs) \<le> set(drop n xs)" |
2276 |
proof (induct xs arbitrary: m n) |
|
2277 |
case (Cons x xs m n) |
|
2278 |
then show ?case |
|
2279 |
by (clarsimp simp: drop_Cons split: nat.split) (metis set_drop_subset subset_iff) |
|
2280 |
qed simp |
|
35248 | 2281 |
|
67613 | 2282 |
lemma in_set_takeD: "x \<in> set(take n xs) \<Longrightarrow> x \<in> set xs" |
68719 | 2283 |
using set_take_subset by fast |
14187 | 2284 |
|
67613 | 2285 |
lemma in_set_dropD: "x \<in> set(drop n xs) \<Longrightarrow> x \<in> set xs" |
68719 | 2286 |
using set_drop_subset by fast |
14187 | 2287 |
|
13114 | 2288 |
lemma append_eq_conv_conj: |
24526 | 2289 |
"(xs @ ys = zs) = (xs = take (length xs) zs \<and> ys = drop (length xs) zs)" |
68709 | 2290 |
proof (induct xs arbitrary: zs) |
2291 |
case (Cons x xs zs) then show ?case |
|
2292 |
by (cases zs, auto) |
|
2293 |
qed auto |
|
13142 | 2294 |
|
71393
fce780f9c9c6
new examples of BNF lifting across quotients using a new theory of confluence,
traytel
parents:
70911
diff
changeset
|
2295 |
lemma map_eq_append_conv: |
fce780f9c9c6
new examples of BNF lifting across quotients using a new theory of confluence,
traytel
parents:
70911
diff
changeset
|
2296 |
"map f xs = ys @ zs \<longleftrightarrow> (\<exists>us vs. xs = us @ vs \<and> ys = map f us \<and> zs = map f vs)" |
fce780f9c9c6
new examples of BNF lifting across quotients using a new theory of confluence,
traytel
parents:
70911
diff
changeset
|
2297 |
proof - |
fce780f9c9c6
new examples of BNF lifting across quotients using a new theory of confluence,
traytel
parents:
70911
diff
changeset
|
2298 |
have "map f xs \<noteq> ys @ zs \<and> map f xs \<noteq> ys @ zs \<or> map f xs \<noteq> ys @ zs \<or> map f xs = ys @ zs \<and> |
fce780f9c9c6
new examples of BNF lifting across quotients using a new theory of confluence,
traytel
parents:
70911
diff
changeset
|
2299 |
(\<exists>bs bsa. xs = bs @ bsa \<and> ys = map f bs \<and> zs = map f bsa)" |
fce780f9c9c6
new examples of BNF lifting across quotients using a new theory of confluence,
traytel
parents:
70911
diff
changeset
|
2300 |
by (metis append_eq_conv_conj append_take_drop_id drop_map take_map) |
fce780f9c9c6
new examples of BNF lifting across quotients using a new theory of confluence,
traytel
parents:
70911
diff
changeset
|
2301 |
then show ?thesis |
fce780f9c9c6
new examples of BNF lifting across quotients using a new theory of confluence,
traytel
parents:
70911
diff
changeset
|
2302 |
using map_append by blast |
fce780f9c9c6
new examples of BNF lifting across quotients using a new theory of confluence,
traytel
parents:
70911
diff
changeset
|
2303 |
qed |
fce780f9c9c6
new examples of BNF lifting across quotients using a new theory of confluence,
traytel
parents:
70911
diff
changeset
|
2304 |
|
fce780f9c9c6
new examples of BNF lifting across quotients using a new theory of confluence,
traytel
parents:
70911
diff
changeset
|
2305 |
lemma append_eq_map_conv: |
fce780f9c9c6
new examples of BNF lifting across quotients using a new theory of confluence,
traytel
parents:
70911
diff
changeset
|
2306 |
"ys @ zs = map f xs \<longleftrightarrow> (\<exists>us vs. xs = us @ vs \<and> ys = map f us \<and> zs = map f vs)" |
fce780f9c9c6
new examples of BNF lifting across quotients using a new theory of confluence,
traytel
parents:
70911
diff
changeset
|
2307 |
by (metis map_eq_append_conv) |
fce780f9c9c6
new examples of BNF lifting across quotients using a new theory of confluence,
traytel
parents:
70911
diff
changeset
|
2308 |
|
58807 | 2309 |
lemma take_add: "take (i+j) xs = take i xs @ take j (drop i xs)" |
68709 | 2310 |
proof (induct xs arbitrary: i) |
2311 |
case (Cons x xs i) then show ?case |
|
2312 |
by (cases i, auto) |
|
2313 |
qed auto |
|
14050 | 2314 |
|
14300 | 2315 |
lemma append_eq_append_conv_if: |
58807 | 2316 |
"(xs\<^sub>1 @ xs\<^sub>2 = ys\<^sub>1 @ ys\<^sub>2) = |
53015
a1119cf551e8
standardized symbols via "isabelle update_sub_sup", excluding src/Pure and src/Tools/WWW_Find;
wenzelm
parents:
52435
diff
changeset
|
2317 |
(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
|
2318 |
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
|
2319 |
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)" |
68709 | 2320 |
proof (induct xs\<^sub>1 arbitrary: ys\<^sub>1) |
2321 |
case (Cons a xs\<^sub>1 ys\<^sub>1) then show ?case |
|
2322 |
by (cases ys\<^sub>1, auto) |
|
2323 |
qed auto |
|
14300 | 2324 |
|
15110
78b5636eabc7
Added a number of new thms and the new function remove1
nipkow
parents:
15072
diff
changeset
|
2325 |
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
|
2326 |
"n < length xs \<Longrightarrow> take n xs @ [hd (drop n xs)] = take (Suc n) xs" |
68709 | 2327 |
by (induct xs arbitrary: n) (simp_all add:drop_Cons split:nat.split) |
15110
78b5636eabc7
Added a number of new thms and the new function remove1
nipkow
parents:
15072
diff
changeset
|
2328 |
|
17501 | 2329 |
lemma id_take_nth_drop: |
64963 | 2330 |
"i < length xs \<Longrightarrow> xs = take i xs @ xs!i # drop (Suc i) xs" |
17501 | 2331 |
proof - |
2332 |
assume si: "i < length xs" |
|
2333 |
hence "xs = take (Suc i) xs @ drop (Suc i) xs" by auto |
|
2334 |
moreover |
|
2335 |
from si have "take (Suc i) xs = take i xs @ [xs!i]" |
|
68709 | 2336 |
using take_Suc_conv_app_nth by blast |
17501 | 2337 |
ultimately show ?thesis by auto |
2338 |
qed |
|
64963 | 2339 |
|
59728 | 2340 |
lemma take_update_cancel[simp]: "n \<le> m \<Longrightarrow> take n (xs[m := y]) = take n xs" |
68719 | 2341 |
by(simp add: list_eq_iff_nth_eq) |
59728 | 2342 |
|
2343 |
lemma drop_update_cancel[simp]: "n < m \<Longrightarrow> drop m (xs[n := x]) = drop m xs" |
|
68719 | 2344 |
by(simp add: list_eq_iff_nth_eq) |
59728 | 2345 |
|
17501 | 2346 |
lemma upd_conv_take_nth_drop: |
58807 | 2347 |
"i < length xs \<Longrightarrow> xs[i:=a] = take i xs @ a # drop (Suc i) xs" |
17501 | 2348 |
proof - |
2349 |
assume i: "i < length xs" |
|
2350 |
have "xs[i:=a] = (take i xs @ xs!i # drop (Suc i) xs)[i:=a]" |
|
2351 |
by(rule arg_cong[OF id_take_nth_drop[OF i]]) |
|
2352 |
also have "\<dots> = take i xs @ a # drop (Suc i) xs" |
|
2353 |
using i by (simp add: list_update_append) |
|
2354 |
finally show ?thesis . |
|
2355 |
qed |
|
2356 |
||
66891
5ec8cd4db7e2
drop a superfluous assumption that was found by the find_unused_assms command
bulwahn
parents:
66890
diff
changeset
|
2357 |
lemma take_update_swap: "take m (xs[n := x]) = (take m xs)[n := x]" |
68709 | 2358 |
proof (cases "n \<ge> length xs") |
2359 |
case False |
|
2360 |
then show ?thesis |
|
2361 |
by (simp add: upd_conv_take_nth_drop take_Cons drop_take min_def diff_Suc split: nat.split) |
|
2362 |
qed auto |
|
2363 |
||
71393
fce780f9c9c6
new examples of BNF lifting across quotients using a new theory of confluence,
traytel
parents:
70911
diff
changeset
|
2364 |
lemma drop_update_swap: |
68709 | 2365 |
assumes "m \<le> n" shows "drop m (xs[n := x]) = (drop m xs)[n-m := x]" |
2366 |
proof (cases "n \<ge> length xs") |
|
2367 |
case False |
|
2368 |
with assms show ?thesis |
|
2369 |
by (simp add: upd_conv_take_nth_drop drop_take) |
|
2370 |
qed auto |
|
59728 | 2371 |
|
2372 |
lemma nth_image: "l \<le> size xs \<Longrightarrow> nth xs ` {0..<l} = set(take l xs)" |
|
68719 | 2373 |
by(auto simp: set_conv_nth image_def) (metis Suc_le_eq nth_take order_trans) |
59728 | 2374 |
|
13114 | 2375 |
|
69593 | 2376 |
subsubsection \<open>\<^const>\<open>takeWhile\<close> and \<^const>\<open>dropWhile\<close>\<close> |
13114 | 2377 |
|
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
|
2378 |
lemma length_takeWhile_le: "length (takeWhile P xs) \<le> length xs" |
68719 | 2379 |
by (induct xs) auto |
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
|
2380 |
|
13142 | 2381 |
lemma takeWhile_dropWhile_id [simp]: "takeWhile P xs @ dropWhile P xs = xs" |
68719 | 2382 |
by (induct xs) auto |
13114 | 2383 |
|
13142 | 2384 |
lemma takeWhile_append1 [simp]: |
67091 | 2385 |
"\<lbrakk>x \<in> set xs; \<not>P(x)\<rbrakk> \<Longrightarrow> takeWhile P (xs @ ys) = takeWhile P xs" |
68719 | 2386 |
by (induct xs) auto |
13114 | 2387 |
|
13142 | 2388 |
lemma takeWhile_append2 [simp]: |
67613 | 2389 |
"(\<And>x. x \<in> set xs \<Longrightarrow> P x) \<Longrightarrow> takeWhile P (xs @ ys) = xs @ takeWhile P ys" |
68719 | 2390 |
by (induct xs) auto |
13114 | 2391 |
|
71778 | 2392 |
lemma takeWhile_append: |
2393 |
"takeWhile P (xs @ ys) = (if \<forall>x\<in>set xs. P x then xs @ takeWhile P ys else takeWhile P xs)" |
|
2394 |
using takeWhile_append1[of _ xs P ys] takeWhile_append2[of xs P ys] by auto |
|
2395 |
||
67613 | 2396 |
lemma takeWhile_tail: "\<not> P x \<Longrightarrow> takeWhile P (xs @ (x#l)) = takeWhile P xs" |
68719 | 2397 |
by (induct xs) auto |
13114 | 2398 |
|
71778 | 2399 |
lemma takeWhile_eq_Nil_iff: "takeWhile P xs = [] \<longleftrightarrow> xs = [] \<or> \<not>P (hd xs)" |
2400 |
by (cases xs) auto |
|
2401 |
||
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
|
2402 |
lemma takeWhile_nth: "j < length (takeWhile P xs) \<Longrightarrow> takeWhile P xs ! j = xs ! j" |
68709 | 2403 |
by (metis nth_append takeWhile_dropWhile_id) |
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 |
|
58807 | 2405 |
lemma dropWhile_nth: "j < length (dropWhile P xs) \<Longrightarrow> |
2406 |
dropWhile P xs ! j = xs ! (j + length (takeWhile P xs))" |
|
68709 | 2407 |
by (metis add.commute nth_append_length_plus takeWhile_dropWhile_id) |
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
|
2408 |
|
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 |
lemma length_dropWhile_le: "length (dropWhile P xs) \<le> length xs" |
68719 | 2410 |
by (induct xs) auto |
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
|
2411 |
|
13142 | 2412 |
lemma dropWhile_append1 [simp]: |
67091 | 2413 |
"\<lbrakk>x \<in> set xs; \<not>P(x)\<rbrakk> \<Longrightarrow> dropWhile P (xs @ ys) = (dropWhile P xs)@ys" |
68719 | 2414 |
by (induct xs) auto |
13114 | 2415 |
|
13142 | 2416 |
lemma dropWhile_append2 [simp]: |
71585 | 2417 |
"(\<And>x. x \<in> set xs \<Longrightarrow> P(x)) \<Longrightarrow> dropWhile P (xs @ ys) = dropWhile P ys" |
68719 | 2418 |
by (induct xs) auto |
13114 | 2419 |
|
45841 | 2420 |
lemma dropWhile_append3: |
2421 |
"\<not> P y \<Longrightarrow>dropWhile P (xs @ y # ys) = dropWhile P xs @ y # ys" |
|
68719 | 2422 |
by (induct xs) auto |
45841 | 2423 |
|
71778 | 2424 |
lemma dropWhile_append: |
2425 |
"dropWhile P (xs @ ys) = (if \<forall>x\<in>set xs. P x then dropWhile P ys else dropWhile P xs @ ys)" |
|
2426 |
using dropWhile_append1[of _ xs P ys] dropWhile_append2[of xs P ys] by auto |
|
2427 |
||
45841 | 2428 |
lemma dropWhile_last: |
2429 |
"x \<in> set xs \<Longrightarrow> \<not> P x \<Longrightarrow> last (dropWhile P xs) = last xs" |
|
68719 | 2430 |
by (auto simp add: dropWhile_append3 in_set_conv_decomp) |
45841 | 2431 |
|
2432 |
lemma set_dropWhileD: "x \<in> set (dropWhile P xs) \<Longrightarrow> x \<in> set xs" |
|
68719 | 2433 |
by (induct xs) (auto split: if_split_asm) |
45841 | 2434 |
|
67613 | 2435 |
lemma set_takeWhileD: "x \<in> set (takeWhile P xs) \<Longrightarrow> x \<in> set xs \<and> P x" |
68719 | 2436 |
by (induct xs) (auto split: if_split_asm) |
13114 | 2437 |
|
13913 | 2438 |
lemma takeWhile_eq_all_conv[simp]: |
58807 | 2439 |
"(takeWhile P xs = xs) = (\<forall>x \<in> set xs. P x)" |
68719 | 2440 |
by(induct xs, auto) |
13913 | 2441 |
|
2442 |
lemma dropWhile_eq_Nil_conv[simp]: |
|
58807 | 2443 |
"(dropWhile P xs = []) = (\<forall>x \<in> set xs. P x)" |
68719 | 2444 |
by(induct xs, auto) |
13913 | 2445 |
|
2446 |
lemma dropWhile_eq_Cons_conv: |
|
67091 | 2447 |
"(dropWhile P xs = y#ys) = (xs = takeWhile P xs @ y # ys \<and> \<not> P y)" |
68719 | 2448 |
by(induct xs, auto) |
13913 | 2449 |
|
71778 | 2450 |
lemma dropWhile_eq_self_iff: "dropWhile P xs = xs \<longleftrightarrow> xs = [] \<or> \<not>P (hd xs)" |
2451 |
by (cases xs) (auto simp: dropWhile_eq_Cons_conv) |
|
2452 |
||
71585 | 2453 |
lemma distinct_takeWhile[simp]: "distinct xs \<Longrightarrow> distinct (takeWhile P xs)" |
68719 | 2454 |
by (induct xs) (auto dest: set_takeWhileD) |
31077 | 2455 |
|
71585 | 2456 |
lemma distinct_dropWhile[simp]: "distinct xs \<Longrightarrow> distinct (dropWhile P xs)" |
68719 | 2457 |
by (induct xs) auto |
31077 | 2458 |
|
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
|
2459 |
lemma takeWhile_map: "takeWhile P (map f xs) = map f (takeWhile (P \<circ> f) xs)" |
68719 | 2460 |
by (induct xs) auto |
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
|
2461 |
|
603320b93668
New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents:
33593
diff
changeset
|
2462 |
lemma dropWhile_map: "dropWhile P (map f xs) = map f (dropWhile (P \<circ> f) xs)" |
68719 | 2463 |
by (induct xs) auto |
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
|
2464 |
|
603320b93668
New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents:
33593
diff
changeset
|
2465 |
lemma takeWhile_eq_take: "takeWhile P xs = take (length (takeWhile P xs)) xs" |
68719 | 2466 |
by (induct xs) auto |
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
|
2467 |
|
603320b93668
New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents:
33593
diff
changeset
|
2468 |
lemma dropWhile_eq_drop: "dropWhile P xs = drop (length (takeWhile P xs)) xs" |
68719 | 2469 |
by (induct xs) auto |
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
|
2470 |
|
58807 | 2471 |
lemma hd_dropWhile: "dropWhile P xs \<noteq> [] \<Longrightarrow> \<not> P (hd (dropWhile P xs))" |
68719 | 2472 |
by (induct xs) auto |
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
|
2473 |
|
603320b93668
New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents:
33593
diff
changeset
|
2474 |
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
|
2475 |
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
|
2476 |
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
|
2477 |
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
|
2478 |
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
|
2479 |
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
|
2480 |
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
|
2481 |
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
|
2482 |
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
|
2483 |
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
|
2484 |
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
|
2485 |
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
|
2486 |
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
|
2487 |
|
603320b93668
New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents:
33593
diff
changeset
|
2488 |
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
|
2489 |
"\<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
|
2490 |
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
|
2491 |
proof (induct xs arbitrary: n) |
60580 | 2492 |
case Nil |
2493 |
thus ?case by simp |
|
2494 |
next |
|
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
|
2495 |
case (Cons x xs) |
60580 | 2496 |
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
|
2497 |
proof (cases n) |
60580 | 2498 |
case 0 |
2499 |
with Cons show ?thesis by simp |
|
2500 |
next |
|
2501 |
case [simp]: (Suc n') |
|
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
|
2502 |
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
|
2503 |
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
|
2504 |
proof (rule Cons.hyps) |
60580 | 2505 |
fix i |
2506 |
assume "i < n'" "i < length xs" |
|
2507 |
thus "P (xs ! i)" using Cons.prems(1)[of "Suc i"] by simp |
|
2508 |
next |
|
2509 |
assume "n' < length xs" |
|
2510 |
thus "\<not> P (xs ! n')" using Cons by auto |
|
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
|
2511 |
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
|
2512 |
ultimately show ?thesis by simp |
68719 | 2513 |
qed |
60580 | 2514 |
qed |
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
|
2515 |
|
603320b93668
New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents:
33593
diff
changeset
|
2516 |
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
|
2517 |
"length (takeWhile P xs) < length xs \<Longrightarrow> \<not> P (xs ! length (takeWhile P xs))" |
68719 | 2518 |
by (induct xs) auto |
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
|
2519 |
|
603320b93668
New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents:
33593
diff
changeset
|
2520 |
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
|
2521 |
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
|
2522 |
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
|
2523 |
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
|
2524 |
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
|
2525 |
hence "length (takeWhile P xs) < length xs" using assms by simp |
60758 | 2526 |
thus ?thesis using all \<open>\<not> ?thesis\<close> nth_length_takeWhile[of P xs] by auto |
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
|
2527 |
qed |
31077 | 2528 |
|
17501 | 2529 |
lemma takeWhile_neq_rev: "\<lbrakk>distinct xs; x \<in> set xs\<rbrakk> \<Longrightarrow> |
58807 | 2530 |
takeWhile (\<lambda>y. y \<noteq> x) (rev xs) = rev (tl (dropWhile (\<lambda>y. y \<noteq> x) xs))" |
68719 | 2531 |
by(induct xs) (auto simp: takeWhile_tail[where l="[]"]) |
17501 | 2532 |
|
2533 |
lemma dropWhile_neq_rev: "\<lbrakk>distinct xs; x \<in> set xs\<rbrakk> \<Longrightarrow> |
|
2534 |
dropWhile (\<lambda>y. y \<noteq> x) (rev xs) = x # rev (takeWhile (\<lambda>y. y \<noteq> x) xs)" |
|
68709 | 2535 |
proof (induct xs) |
2536 |
case (Cons a xs) |
|
2537 |
then show ?case |
|
2538 |
by(auto, subst dropWhile_append2, auto) |
|
2539 |
qed simp |
|
17501 | 2540 |
|
18423 | 2541 |
lemma takeWhile_not_last: |
58807 | 2542 |
"distinct xs \<Longrightarrow> takeWhile (\<lambda>y. y \<noteq> last xs) xs = butlast xs" |
68719 | 2543 |
by(induction xs rule: induct_list012) auto |
18423 | 2544 |
|
44013
5cfc1c36ae97
moved recdef package to HOL/Library/Old_Recdef.thy
krauss
parents:
43594
diff
changeset
|
2545 |
lemma takeWhile_cong [fundef_cong]: |
67613 | 2546 |
"\<lbrakk>l = k; \<And>x. x \<in> set l \<Longrightarrow> P x = Q x\<rbrakk> |
2547 |
\<Longrightarrow> takeWhile P l = takeWhile Q k" |
|
68719 | 2548 |
by (induct k arbitrary: l) (simp_all) |
18336
1a2e30b37ed3
Added recdef congruence rules for bounded quantifiers and commonly used
krauss
parents:
18049
diff
changeset
|
2549 |
|
44013
5cfc1c36ae97
moved recdef package to HOL/Library/Old_Recdef.thy
krauss
parents:
43594
diff
changeset
|
2550 |
lemma dropWhile_cong [fundef_cong]: |
67613 | 2551 |
"\<lbrakk>l = k; \<And>x. x \<in> set l \<Longrightarrow> P x = Q x\<rbrakk> |
2552 |
\<Longrightarrow> dropWhile P l = dropWhile Q k" |
|
68719 | 2553 |
by (induct k arbitrary: l, simp_all) |
18336
1a2e30b37ed3
Added recdef congruence rules for bounded quantifiers and commonly used
krauss
parents:
18049
diff
changeset
|
2554 |
|
52380 | 2555 |
lemma takeWhile_idem [simp]: |
2556 |
"takeWhile P (takeWhile P xs) = takeWhile P xs" |
|
68719 | 2557 |
by (induct xs) auto |
52380 | 2558 |
|
2559 |
lemma dropWhile_idem [simp]: |
|
2560 |
"dropWhile P (dropWhile P xs) = dropWhile P xs" |
|
68719 | 2561 |
by (induct xs) auto |
52380 | 2562 |
|
13114 | 2563 |
|
69593 | 2564 |
subsubsection \<open>\<^const>\<open>zip\<close>\<close> |
13114 | 2565 |
|
13142 | 2566 |
lemma zip_Nil [simp]: "zip [] ys = []" |
68719 | 2567 |
by (induct ys) auto |
13114 | 2568 |
|
13142 | 2569 |
lemma zip_Cons_Cons [simp]: "zip (x # xs) (y # ys) = (x, y) # zip xs ys" |
68719 | 2570 |
by simp |
13114 | 2571 |
|
13142 | 2572 |
declare zip_Cons [simp del] |
13114 | 2573 |
|
36198 | 2574 |
lemma [code]: |
2575 |
"zip [] ys = []" |
|
2576 |
"zip xs [] = []" |
|
2577 |
"zip (x # xs) (y # ys) = (x, y) # zip xs ys" |
|
68719 | 2578 |
by (fact zip_Nil zip.simps(1) zip_Cons_Cons)+ |
36198 | 2579 |
|
15281 | 2580 |
lemma zip_Cons1: |
58807 | 2581 |
"zip (x#xs) ys = (case ys of [] \<Rightarrow> [] | y#ys \<Rightarrow> (x,y)#zip xs ys)" |
68719 | 2582 |
by(auto split:list.split) |
15281 | 2583 |
|
13142 | 2584 |
lemma length_zip [simp]: |
58807 | 2585 |
"length (zip xs ys) = min (length xs) (length ys)" |
68719 | 2586 |
by (induct xs ys rule:list_induct2') auto |
13114 | 2587 |
|
34978
874150ddd50a
canonical insert operation; generalized lemma foldl_apply_inv to foldl_apply
haftmann
parents:
34942
diff
changeset
|
2588 |
lemma zip_obtain_same_length: |
874150ddd50a
canonical insert operation; generalized lemma foldl_apply_inv to foldl_apply
haftmann
parents:
34942
diff
changeset
|
2589 |
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
|
2590 |
\<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
|
2591 |
shows "P (zip xs ys)" |
874150ddd50a
canonical insert operation; generalized lemma foldl_apply_inv to foldl_apply
haftmann
parents:
34942
diff
changeset
|
2592 |
proof - |
874150ddd50a
canonical insert operation; generalized lemma foldl_apply_inv to foldl_apply
haftmann
parents:
34942
diff
changeset
|
2593 |
let ?n = "min (length xs) (length ys)" |
874150ddd50a
canonical insert operation; generalized lemma foldl_apply_inv to foldl_apply
haftmann
parents:
34942
diff
changeset
|
2594 |
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
|
2595 |
by (rule assms) simp_all |
874150ddd50a
canonical insert operation; generalized lemma foldl_apply_inv to foldl_apply
haftmann
parents:
34942
diff
changeset
|
2596 |
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
|
2597 |
proof (induct xs arbitrary: ys) |
874150ddd50a
canonical insert operation; generalized lemma foldl_apply_inv to foldl_apply
haftmann
parents:
34942
diff
changeset
|
2598 |
case Nil then show ?case by simp |
874150ddd50a
canonical insert operation; generalized lemma foldl_apply_inv to foldl_apply
haftmann
parents:
34942
diff
changeset
|
2599 |
next |
874150ddd50a
canonical insert operation; generalized lemma foldl_apply_inv to foldl_apply
haftmann
parents:
34942
diff
changeset
|
2600 |
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
|
2601 |
qed |
874150ddd50a
canonical insert operation; generalized lemma foldl_apply_inv to foldl_apply
haftmann
parents:
34942
diff
changeset
|
2602 |
ultimately show ?thesis by simp |
874150ddd50a
canonical insert operation; generalized lemma foldl_apply_inv to foldl_apply
haftmann
parents:
34942
diff
changeset
|
2603 |
qed |
874150ddd50a
canonical insert operation; generalized lemma foldl_apply_inv to foldl_apply
haftmann
parents:
34942
diff
changeset
|
2604 |
|
13114 | 2605 |
lemma zip_append1: |
58807 | 2606 |
"zip (xs @ ys) zs = |
2607 |
zip xs (take (length xs) zs) @ zip ys (drop (length xs) zs)" |
|
68719 | 2608 |
by (induct xs zs rule:list_induct2') auto |
13114 | 2609 |
|
2610 |
lemma zip_append2: |
|
58807 | 2611 |
"zip xs (ys @ zs) = |
2612 |
zip (take (length ys) xs) ys @ zip (drop (length ys) xs) zs" |
|
68719 | 2613 |
by (induct xs ys rule:list_induct2') auto |
13114 | 2614 |
|
13142 | 2615 |
lemma zip_append [simp]: |
71585 | 2616 |
"\<lbrakk>length xs = length us\<rbrakk> \<Longrightarrow> |
58807 | 2617 |
zip (xs@ys) (us@vs) = zip xs us @ zip ys vs" |
68719 | 2618 |
by (simp add: zip_append1) |
13114 | 2619 |
|
2620 |
lemma zip_rev: |
|
71585 | 2621 |
"length xs = length ys \<Longrightarrow> zip (rev xs) (rev ys) = rev (zip xs ys)" |
68719 | 2622 |
by (induct rule:list_induct2, simp_all) |
13114 | 2623 |
|
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
|
2624 |
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
|
2625 |
"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
|
2626 |
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
|
2627 |
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
|
2628 |
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
|
2629 |
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
|
2630 |
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
|
2631 |
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
|
2632 |
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
|
2633 |
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
|
2634 |
|
603320b93668
New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents:
33593
diff
changeset
|
2635 |
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
|
2636 |
"zip (map f xs) ys = map (\<lambda>(x, y). (f x, y)) (zip xs ys)" |
68719 | 2637 |
using zip_map_map[of f xs "\<lambda>x. x" ys] 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
|
2638 |
|
603320b93668
New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents:
33593
diff
changeset
|
2639 |
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
|
2640 |
"zip xs (map f ys) = map (\<lambda>(x, y). (x, f y)) (zip xs ys)" |
68719 | 2641 |
using zip_map_map[of "\<lambda>x. x" xs f ys] 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
|
2642 |
|
23096 | 2643 |
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
|
2644 |
"map f (zip (map g xs) ys) = map (%(x,y). f(g x, y)) (zip xs ys)" |
68719 | 2645 |
by (auto simp: zip_map1) |
23096 | 2646 |
|
2647 |
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
|
2648 |
"map f (zip xs (map g ys)) = map (%(x,y). f(x, g y)) (zip xs ys)" |
68719 | 2649 |
by (auto simp: zip_map2) |
23096 | 2650 |
|
60758 | 2651 |
text\<open>Courtesy of Andreas Lochbihler:\<close> |
31080 | 2652 |
lemma zip_same_conv_map: "zip xs xs = map (\<lambda>x. (x, x)) xs" |
68719 | 2653 |
by(induct xs) auto |
31080 | 2654 |
|
13142 | 2655 |
lemma nth_zip [simp]: |
71585 | 2656 |
"\<lbrakk>i < length xs; i < length ys\<rbrakk> \<Longrightarrow> (zip xs ys)!i = (xs!i, ys!i)" |
68709 | 2657 |
proof (induct ys arbitrary: i xs) |
2658 |
case (Cons y ys) |
|
2659 |
then show ?case |
|
2660 |
by (cases xs) (simp_all add: nth.simps split: nat.split) |
|
2661 |
qed auto |
|
13114 | 2662 |
|
2663 |
lemma set_zip: |
|
58807 | 2664 |
"set (zip xs ys) = {(xs!i, ys!i) | i. i < min (length xs) (length ys)}" |
68719 | 2665 |
by(simp add: set_conv_nth cong: rev_conj_cong) |
13114 | 2666 |
|
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
|
2667 |
lemma zip_same: "((a,b) \<in> set (zip xs xs)) = (a \<in> set xs \<and> a = b)" |
68719 | 2668 |
by(induct xs) auto |
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
|
2669 |
|
68709 | 2670 |
lemma zip_update: "zip (xs[i:=x]) (ys[i:=y]) = (zip xs ys)[i:=(x,y)]" |
2671 |
by (simp add: update_zip) |
|
13114 | 2672 |
|
13142 | 2673 |
lemma zip_replicate [simp]: |
24526 | 2674 |
"zip (replicate i x) (replicate j y) = replicate (min i j) (x,y)" |
68709 | 2675 |
proof (induct i arbitrary: j) |
2676 |
case (Suc i) |
|
2677 |
then show ?case |
|
2678 |
by (cases j, auto) |
|
2679 |
qed auto |
|
13114 | 2680 |
|
61630 | 2681 |
lemma zip_replicate1: "zip (replicate n x) ys = map (Pair x) (take n ys)" |
68719 | 2682 |
by(induction ys arbitrary: n)(case_tac [2] n, simp_all) |
61630 | 2683 |
|
68709 | 2684 |
lemma take_zip: "take n (zip xs ys) = zip (take n xs) (take n ys)" |
2685 |
proof (induct n arbitrary: xs ys) |
|
69850 | 2686 |
case 0 |
2687 |
then show ?case by simp |
|
2688 |
next |
|
2689 |
case Suc |
|
2690 |
then show ?case by (cases xs; cases ys) simp_all |
|
2691 |
qed |
|
68709 | 2692 |
|
2693 |
lemma drop_zip: "drop n (zip xs ys) = zip (drop n xs) (drop n ys)" |
|
2694 |
proof (induct n arbitrary: xs ys) |
|
69850 | 2695 |
case 0 |
2696 |
then show ?case by simp |
|
2697 |
next |
|
2698 |
case Suc |
|
2699 |
then show ?case by (cases xs; cases ys) simp_all |
|
2700 |
qed |
|
19487 | 2701 |
|
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
|
2702 |
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
|
2703 |
proof (induct xs arbitrary: ys) |
69850 | 2704 |
case Nil |
2705 |
then show ?case by simp |
|
2706 |
next |
|
2707 |
case Cons |
|
2708 |
then show ?case by (cases ys) auto |
|
2709 |
qed |
|
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
|
2710 |
|
603320b93668
New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents:
33593
diff
changeset
|
2711 |
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
|
2712 |
proof (induct xs arbitrary: ys) |
69850 | 2713 |
case Nil |
2714 |
then show ?case by simp |
|
2715 |
next |
|
2716 |
case Cons |
|
2717 |
then show ?case by (cases ys) auto |
|
2718 |
qed |
|
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
|
2719 |
|
58807 | 2720 |
lemma set_zip_leftD: "(x,y)\<in> set (zip xs ys) \<Longrightarrow> x \<in> set xs" |
68719 | 2721 |
by (induct xs ys rule:list_induct2') auto |
22493
db930e490fe5
added another rule for simultaneous induction, and lemmas for zip
krauss
parents:
22422
diff
changeset
|
2722 |
|
58807 | 2723 |
lemma set_zip_rightD: "(x,y)\<in> set (zip xs ys) \<Longrightarrow> y \<in> set ys" |
68719 | 2724 |
by (induct xs ys rule:list_induct2') auto |
13142 | 2725 |
|
23983 | 2726 |
lemma in_set_zipE: |
67613 | 2727 |
"(x,y) \<in> set(zip xs ys) \<Longrightarrow> (\<lbrakk> x \<in> set xs; y \<in> set ys \<rbrakk> \<Longrightarrow> R) \<Longrightarrow> R" |
68719 | 2728 |
by(blast dest: set_zip_leftD set_zip_rightD) |
23983 | 2729 |
|
58807 | 2730 |
lemma zip_map_fst_snd: "zip (map fst zs) (map snd zs) = zs" |
68719 | 2731 |
by (induct zs) simp_all |
29829 | 2732 |
|
2733 |
lemma zip_eq_conv: |
|
2734 |
"length xs = length ys \<Longrightarrow> zip xs ys = zs \<longleftrightarrow> map fst zs = xs \<and> map snd zs = ys" |
|
68719 | 2735 |
by (auto simp add: zip_map_fst_snd) |
29829 | 2736 |
|
51173 | 2737 |
lemma in_set_zip: |
2738 |
"p \<in> set (zip xs ys) \<longleftrightarrow> (\<exists>n. xs ! n = fst p \<and> ys ! n = snd p |
|
58807 | 2739 |
\<and> n < length xs \<and> n < length ys)" |
68719 | 2740 |
by (cases p) (auto simp add: set_zip) |
51173 | 2741 |
|
66584 | 2742 |
lemma in_set_impl_in_set_zip1: |
2743 |
assumes "length xs = length ys" |
|
2744 |
assumes "x \<in> set xs" |
|
2745 |
obtains y where "(x, y) \<in> set (zip xs ys)" |
|
2746 |
proof - |
|
2747 |
from assms have "x \<in> set (map fst (zip xs ys))" by simp |
|
2748 |
from this that show ?thesis by fastforce |
|
2749 |
qed |
|
2750 |
||
2751 |
lemma in_set_impl_in_set_zip2: |
|
2752 |
assumes "length xs = length ys" |
|
2753 |
assumes "y \<in> set ys" |
|
2754 |
obtains x where "(x, y) \<in> set (zip xs ys)" |
|
2755 |
proof - |
|
2756 |
from assms have "y \<in> set (map snd (zip xs ys))" by simp |
|
2757 |
from this that show ?thesis by fastforce |
|
2758 |
qed |
|
2759 |
||
70226 | 2760 |
lemma zip_eq_Nil_iff: |
2761 |
"zip xs ys = [] \<longleftrightarrow> xs = [] \<or> ys = []" |
|
2762 |
by (cases xs; cases ys) simp_all |
|
2763 |
||
2764 |
lemma zip_eq_ConsE: |
|
2765 |
assumes "zip xs ys = xy # xys" |
|
2766 |
obtains x xs' y ys' where "xs = x # xs'" |
|
2767 |
and "ys = y # ys'" and "xy = (x, y)" |
|
2768 |
and "xys = zip xs' ys'" |
|
2769 |
proof - |
|
2770 |
from assms have "xs \<noteq> []" and "ys \<noteq> []" |
|
2771 |
using zip_eq_Nil_iff [of xs ys] by simp_all |
|
2772 |
then obtain x xs' y ys' where xs: "xs = x # xs'" |
|
2773 |
and ys: "ys = y # ys'" |
|
2774 |
by (cases xs; cases ys) auto |
|
2775 |
with assms have "xy = (x, y)" and "xys = zip xs' ys'" |
|
2776 |
by simp_all |
|
2777 |
with xs ys show ?thesis .. |
|
2778 |
qed |
|
2779 |
||
70911 | 2780 |
lemma semilattice_map2: |
2781 |
"semilattice (map2 (\<^bold>*))" if "semilattice (\<^bold>*)" |
|
2782 |
for f (infixl "\<^bold>*" 70) |
|
2783 |
proof - |
|
2784 |
from that interpret semilattice f . |
|
2785 |
show ?thesis |
|
2786 |
proof |
|
2787 |
show "map2 (\<^bold>*) (map2 (\<^bold>*) xs ys) zs = map2 (\<^bold>*) xs (map2 (\<^bold>*) ys zs)" |
|
2788 |
for xs ys zs :: "'a list" |
|
2789 |
proof (induction "zip xs (zip ys zs)" arbitrary: xs ys zs) |
|
2790 |
case Nil |
|
2791 |
from Nil [symmetric] show ?case |
|
2792 |
by (auto simp add: zip_eq_Nil_iff) |
|
2793 |
next |
|
2794 |
case (Cons xyz xyzs) |
|
2795 |
from Cons.hyps(2) [symmetric] show ?case |
|
2796 |
by (rule zip_eq_ConsE) (erule zip_eq_ConsE, |
|
2797 |
auto intro: Cons.hyps(1) simp add: ac_simps) |
|
2798 |
qed |
|
2799 |
show "map2 (\<^bold>*) xs ys = map2 (\<^bold>*) ys xs" |
|
2800 |
for xs ys :: "'a list" |
|
2801 |
proof (induction "zip xs ys" arbitrary: xs ys) |
|
2802 |
case Nil |
|
2803 |
then show ?case |
|
2804 |
by (auto simp add: zip_eq_Nil_iff dest: sym) |
|
2805 |
next |
|
2806 |
case (Cons xy xys) |
|
2807 |
from Cons.hyps(2) [symmetric] show ?case |
|
2808 |
by (rule zip_eq_ConsE) (auto intro: Cons.hyps(1) simp add: ac_simps) |
|
2809 |
qed |
|
2810 |
show "map2 (\<^bold>*) xs xs = xs" |
|
2811 |
for xs :: "'a list" |
|
2812 |
by (induction xs) simp_all |
|
2813 |
qed |
|
2814 |
qed |
|
2815 |
||
51173 | 2816 |
lemma pair_list_eqI: |
2817 |
assumes "map fst xs = map fst ys" and "map snd xs = map snd ys" |
|
2818 |
shows "xs = ys" |
|
2819 |
proof - |
|
2820 |
from assms(1) have "length xs = length ys" by (rule map_eq_imp_length_eq) |
|
2821 |
from this assms show ?thesis |
|
2822 |
by (induct xs ys rule: list_induct2) (simp_all add: prod_eqI) |
|
2823 |
qed |
|
2824 |
||
71423 | 2825 |
lemma hd_zip: |
2826 |
\<open>hd (zip xs ys) = (hd xs, hd ys)\<close> if \<open>xs \<noteq> []\<close> and \<open>ys \<noteq> []\<close> |
|
2827 |
using that by (cases xs; cases ys) simp_all |
|
2828 |
||
2829 |
lemma last_zip: |
|
2830 |
\<open>last (zip xs ys) = (last xs, last ys)\<close> if \<open>xs \<noteq> []\<close> and \<open>ys \<noteq> []\<close> |
|
2831 |
and \<open>length xs = length ys\<close> |
|
2832 |
using that by (cases xs rule: rev_cases; cases ys rule: rev_cases) simp_all |
|
2833 |
||
35115 | 2834 |
|
69593 | 2835 |
subsubsection \<open>\<^const>\<open>list_all2\<close>\<close> |
13114 | 2836 |
|
64963 | 2837 |
lemma list_all2_lengthD [intro?]: |
71585 | 2838 |
"list_all2 P xs ys \<Longrightarrow> length xs = length ys" |
68719 | 2839 |
by (simp add: list_all2_iff) |
19607
07eeb832f28d
introduced characters for code generator; some improved code lemmas for some list functions
haftmann
parents:
19585
diff
changeset
|
2840 |
|
19787 | 2841 |
lemma list_all2_Nil [iff, code]: "list_all2 P [] ys = (ys = [])" |
68719 | 2842 |
by (simp add: list_all2_iff) |
19607
07eeb832f28d
introduced characters for code generator; some improved code lemmas for some list functions
haftmann
parents:
19585
diff
changeset
|
2843 |
|
19787 | 2844 |
lemma list_all2_Nil2 [iff, code]: "list_all2 P xs [] = (xs = [])" |
68719 | 2845 |
by (simp add: list_all2_iff) |
19607
07eeb832f28d
introduced characters for code generator; some improved code lemmas for some list functions
haftmann
parents:
19585
diff
changeset
|
2846 |
|
07eeb832f28d
introduced characters for code generator; some improved code lemmas for some list functions
haftmann
parents:
19585
diff
changeset
|
2847 |
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
|
2848 |
"list_all2 P (x # xs) (y # ys) = (P x y \<and> list_all2 P xs ys)" |
68719 | 2849 |
by (auto simp add: list_all2_iff) |
13114 | 2850 |
|
2851 |
lemma list_all2_Cons1: |
|
58807 | 2852 |
"list_all2 P (x # xs) ys = (\<exists>z zs. ys = z # zs \<and> P x z \<and> list_all2 P xs zs)" |
68719 | 2853 |
by (cases ys) auto |
13114 | 2854 |
|
2855 |
lemma list_all2_Cons2: |
|
58807 | 2856 |
"list_all2 P xs (y # ys) = (\<exists>z zs. xs = z # zs \<and> P z y \<and> list_all2 P zs ys)" |
68719 | 2857 |
by (cases xs) auto |
13114 | 2858 |
|
45794 | 2859 |
lemma list_all2_induct |
2860 |
[consumes 1, case_names Nil Cons, induct set: list_all2]: |
|
2861 |
assumes P: "list_all2 P xs ys" |
|
2862 |
assumes Nil: "R [] []" |
|
47640 | 2863 |
assumes Cons: "\<And>x xs y ys. |
2864 |
\<lbrakk>P x y; list_all2 P xs ys; R xs ys\<rbrakk> \<Longrightarrow> R (x # xs) (y # ys)" |
|
45794 | 2865 |
shows "R xs ys" |
68719 | 2866 |
using P |
2867 |
by (induct xs arbitrary: ys) (auto simp add: list_all2_Cons1 Nil Cons) |
|
45794 | 2868 |
|
13142 | 2869 |
lemma list_all2_rev [iff]: |
58807 | 2870 |
"list_all2 P (rev xs) (rev ys) = list_all2 P xs ys" |
68719 | 2871 |
by (simp add: list_all2_iff zip_rev cong: conj_cong) |
13114 | 2872 |
|
13863 | 2873 |
lemma list_all2_rev1: |
58807 | 2874 |
"list_all2 P (rev xs) ys = list_all2 P xs (rev ys)" |
68719 | 2875 |
by (subst list_all2_rev [symmetric]) simp |
13863 | 2876 |
|
13114 | 2877 |
lemma list_all2_append1: |
58807 | 2878 |
"list_all2 P (xs @ ys) zs = |
67091 | 2879 |
(\<exists>us vs. zs = us @ vs \<and> length us = length xs \<and> length vs = length ys \<and> |
68709 | 2880 |
list_all2 P xs us \<and> list_all2 P ys vs)" (is "?lhs = ?rhs") |
2881 |
proof |
|
2882 |
assume ?lhs |
|
2883 |
then show ?rhs |
|
2884 |
apply (rule_tac x = "take (length xs) zs" in exI) |
|
2885 |
apply (rule_tac x = "drop (length xs) zs" in exI) |
|
2886 |
apply (force split: nat_diff_split simp add: list_all2_iff zip_append1) |
|
2887 |
done |
|
2888 |
next |
|
2889 |
assume ?rhs |
|
2890 |
then show ?lhs |
|
2891 |
by (auto simp add: list_all2_iff) |
|
2892 |
qed |
|
13114 | 2893 |
|
2894 |
lemma list_all2_append2: |
|
58807 | 2895 |
"list_all2 P xs (ys @ zs) = |
67091 | 2896 |
(\<exists>us vs. xs = us @ vs \<and> length us = length ys \<and> length vs = length zs \<and> |
68709 | 2897 |
list_all2 P us ys \<and> list_all2 P vs zs)" (is "?lhs = ?rhs") |
2898 |
proof |
|
2899 |
assume ?lhs |
|
2900 |
then show ?rhs |
|
2901 |
apply (rule_tac x = "take (length ys) xs" in exI) |
|
2902 |
apply (rule_tac x = "drop (length ys) xs" in exI) |
|
2903 |
apply (force split: nat_diff_split simp add: list_all2_iff zip_append2) |
|
2904 |
done |
|
2905 |
next |
|
2906 |
assume ?rhs |
|
2907 |
then show ?lhs |
|
2908 |
by (auto simp add: list_all2_iff) |
|
2909 |
qed |
|
13114 | 2910 |
|
13863 | 2911 |
lemma list_all2_append: |
14247 | 2912 |
"length xs = length ys \<Longrightarrow> |
2913 |
list_all2 P (xs@us) (ys@vs) = (list_all2 P xs ys \<and> list_all2 P us vs)" |
|
68719 | 2914 |
by (induct rule:list_induct2, simp_all) |
13863 | 2915 |
|
2916 |
lemma list_all2_appendI [intro?, trans]: |
|
2917 |
"\<lbrakk> list_all2 P a b; list_all2 P c d \<rbrakk> \<Longrightarrow> list_all2 P (a@c) (b@d)" |
|
68719 | 2918 |
by (simp add: list_all2_append list_all2_lengthD) |
13863 | 2919 |
|
13114 | 2920 |
lemma list_all2_conv_all_nth: |
58807 | 2921 |
"list_all2 P xs ys = |
2922 |
(length xs = length ys \<and> (\<forall>i < length xs. P (xs!i) (ys!i)))" |
|
68719 | 2923 |
by (force simp add: list_all2_iff set_zip) |
13114 | 2924 |
|
13883
0451e0fb3f22
Re-structured some proofs in order to get rid of rule_format attribute.
berghofe
parents:
13863
diff
changeset
|
2925 |
lemma list_all2_trans: |
71585 | 2926 |
assumes tr: "!!a b c. P1 a b \<Longrightarrow> P2 b c \<Longrightarrow> P3 a c" |
2927 |
shows "!!bs cs. list_all2 P1 as bs \<Longrightarrow> list_all2 P2 bs cs \<Longrightarrow> list_all2 P3 as cs" |
|
68719 | 2928 |
(is "!!bs cs. PROP ?Q as bs cs") |
13883
0451e0fb3f22
Re-structured some proofs in order to get rid of rule_format attribute.
berghofe
parents:
13863
diff
changeset
|
2929 |
proof (induct as) |
0451e0fb3f22
Re-structured some proofs in order to get rid of rule_format attribute.
berghofe
parents:
13863
diff
changeset
|
2930 |
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
|
2931 |
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
|
2932 |
proof (induct bs) |
0451e0fb3f22
Re-structured some proofs in order to get rid of rule_format attribute.
berghofe
parents:
13863
diff
changeset
|
2933 |
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
|
2934 |
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
|
2935 |
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
|
2936 |
qed simp |
0451e0fb3f22
Re-structured some proofs in order to get rid of rule_format attribute.
berghofe
parents:
13863
diff
changeset
|
2937 |
qed simp |
0451e0fb3f22
Re-structured some proofs in order to get rid of rule_format attribute.
berghofe
parents:
13863
diff
changeset
|
2938 |
|
13863 | 2939 |
lemma list_all2_all_nthI [intro?]: |
2940 |
"length a = length b \<Longrightarrow> (\<And>n. n < length a \<Longrightarrow> P (a!n) (b!n)) \<Longrightarrow> list_all2 P a b" |
|
68719 | 2941 |
by (simp add: list_all2_conv_all_nth) |
13863 | 2942 |
|
14395 | 2943 |
lemma list_all2I: |
61032
b57df8eecad6
standardized some occurences of ancient "split" alias
haftmann
parents:
61031
diff
changeset
|
2944 |
"\<forall>x \<in> set (zip a b). case_prod P x \<Longrightarrow> length a = length b \<Longrightarrow> list_all2 P a b" |
68719 | 2945 |
by (simp add: list_all2_iff) |
14395 | 2946 |
|
14328 | 2947 |
lemma list_all2_nthD: |
13863 | 2948 |
"\<lbrakk> list_all2 P xs ys; p < size xs \<rbrakk> \<Longrightarrow> P (xs!p) (ys!p)" |
68719 | 2949 |
by (simp add: list_all2_conv_all_nth) |
13863 | 2950 |
|
14302 | 2951 |
lemma list_all2_nthD2: |
2952 |
"\<lbrakk>list_all2 P xs ys; p < size ys\<rbrakk> \<Longrightarrow> P (xs!p) (ys!p)" |
|
68719 | 2953 |
by (frule list_all2_lengthD) (auto intro: list_all2_nthD) |
14302 | 2954 |
|
64963 | 2955 |
lemma list_all2_map1: |
13863 | 2956 |
"list_all2 P (map f as) bs = list_all2 (\<lambda>x y. P (f x) y) as bs" |
68719 | 2957 |
by (simp add: list_all2_conv_all_nth) |
13863 | 2958 |
|
64963 | 2959 |
lemma list_all2_map2: |
13863 | 2960 |
"list_all2 P as (map f bs) = list_all2 (\<lambda>x y. P x (f y)) as bs" |
68719 | 2961 |
by (auto simp add: list_all2_conv_all_nth) |
13863 | 2962 |
|
14316
91b897b9a2dc
added some [intro?] and [trans] for list_all2 lemmas
kleing
parents:
14302
diff
changeset
|
2963 |
lemma list_all2_refl [intro?]: |
13863 | 2964 |
"(\<And>x. P x x) \<Longrightarrow> list_all2 P xs xs" |
68719 | 2965 |
by (simp add: list_all2_conv_all_nth) |
13863 | 2966 |
|
2967 |
lemma list_all2_update_cong: |
|
46669
c1d2ab32174a
one general list_all2_update_cong instead of two special ones
bulwahn
parents:
46664
diff
changeset
|
2968 |
"\<lbrakk> list_all2 P xs ys; P x y \<rbrakk> \<Longrightarrow> list_all2 P (xs[i:=x]) (ys[i:=y])" |
68719 | 2969 |
by (cases "i < length ys") (auto simp add: list_all2_conv_all_nth nth_list_update) |
13863 | 2970 |
|
14302 | 2971 |
lemma list_all2_takeI [simp,intro?]: |
24526 | 2972 |
"list_all2 P xs ys \<Longrightarrow> list_all2 P (take n xs) (take n ys)" |
68709 | 2973 |
proof (induct xs arbitrary: n ys) |
2974 |
case (Cons x xs) |
|
2975 |
then show ?case |
|
2976 |
by (cases n) (auto simp: list_all2_Cons1) |
|
2977 |
qed auto |
|
14302 | 2978 |
|
2979 |
lemma list_all2_dropI [simp,intro?]: |
|
68709 | 2980 |
"list_all2 P xs ys \<Longrightarrow> list_all2 P (drop n xs) (drop n ys)" |
2981 |
proof (induct xs arbitrary: n ys) |
|
2982 |
case (Cons x xs) |
|
2983 |
then show ?case |
|
2984 |
by (cases n) (auto simp: list_all2_Cons1) |
|
2985 |
qed auto |
|
13863 | 2986 |
|
14327 | 2987 |
lemma list_all2_mono [intro?]: |
24526 | 2988 |
"list_all2 P xs ys \<Longrightarrow> (\<And>xs ys. P xs ys \<Longrightarrow> Q xs ys) \<Longrightarrow> list_all2 Q xs ys" |
68709 | 2989 |
by (rule list.rel_mono_strong) |
13863 | 2990 |
|
22551 | 2991 |
lemma list_all2_eq: |
67399 | 2992 |
"xs = ys \<longleftrightarrow> list_all2 (=) xs ys" |
68719 | 2993 |
by (induct xs ys rule: list_induct2') auto |
22551 | 2994 |
|
40230 | 2995 |
lemma list_eq_iff_zip_eq: |
2996 |
"xs = ys \<longleftrightarrow> length xs = length ys \<and> (\<forall>(x,y) \<in> set (zip xs ys). x = y)" |
|
68719 | 2997 |
by(auto simp add: set_zip list_all2_eq list_all2_conv_all_nth cong: conj_cong) |
40230 | 2998 |
|
57308 | 2999 |
lemma list_all2_same: "list_all2 P xs xs \<longleftrightarrow> (\<forall>x\<in>set xs. P x x)" |
68719 | 3000 |
by(auto simp add: list_all2_conv_all_nth set_conv_nth) |
13142 | 3001 |
|
61630 | 3002 |
lemma zip_assoc: |
3003 |
"zip xs (zip ys zs) = map (\<lambda>((x, y), z). (x, y, z)) (zip (zip xs ys) zs)" |
|
68719 | 3004 |
by(rule list_all2_all_nthI[where P="(=)", unfolded list.rel_eq]) simp_all |
61630 | 3005 |
|
3006 |
lemma zip_commute: "zip xs ys = map (\<lambda>(x, y). (y, x)) (zip ys xs)" |
|
68719 | 3007 |
by(rule list_all2_all_nthI[where P="(=)", unfolded list.rel_eq]) simp_all |
61630 | 3008 |
|
3009 |
lemma zip_left_commute: |
|
3010 |
"zip xs (zip ys zs) = map (\<lambda>(y, (x, z)). (x, y, z)) (zip ys (zip xs zs))" |
|
68719 | 3011 |
by(rule list_all2_all_nthI[where P="(=)", unfolded list.rel_eq]) simp_all |
61630 | 3012 |
|
3013 |
lemma zip_replicate2: "zip xs (replicate n y) = map (\<lambda>x. (x, y)) (take n xs)" |
|
68719 | 3014 |
by(subst zip_commute)(simp add: zip_replicate1) |
61630 | 3015 |
|
69593 | 3016 |
subsubsection \<open>\<^const>\<open>List.product\<close> and \<^const>\<open>product_lists\<close>\<close> |
49948
744934b818c7
moved quite generic material from theory Enum to more appropriate places
haftmann
parents:
49808
diff
changeset
|
3017 |
|
63720 | 3018 |
lemma product_concat_map: |
3019 |
"List.product xs ys = concat (map (\<lambda>x. map (\<lambda>y. (x,y)) ys) xs)" |
|
68719 | 3020 |
by(induction xs) (simp)+ |
63720 | 3021 |
|
58807 | 3022 |
lemma set_product[simp]: "set (List.product xs ys) = set xs \<times> set ys" |
68719 | 3023 |
by (induct xs) auto |
49948
744934b818c7
moved quite generic material from theory Enum to more appropriate places
haftmann
parents:
49808
diff
changeset
|
3024 |
|
51160
599ff65b85e2
systematic conversions between nat and nibble/char;
haftmann
parents:
51112
diff
changeset
|
3025 |
lemma length_product [simp]: |
599ff65b85e2
systematic conversions between nat and nibble/char;
haftmann
parents:
51112
diff
changeset
|
3026 |
"length (List.product xs ys) = length xs * length ys" |
68719 | 3027 |
by (induct xs) simp_all |
51160
599ff65b85e2
systematic conversions between nat and nibble/char;
haftmann
parents:
51112
diff
changeset
|
3028 |
|
599ff65b85e2
systematic conversions between nat and nibble/char;
haftmann
parents:
51112
diff
changeset
|
3029 |
lemma product_nth: |
599ff65b85e2
systematic conversions between nat and nibble/char;
haftmann
parents:
51112
diff
changeset
|
3030 |
assumes "n < length xs * length ys" |
599ff65b85e2
systematic conversions between nat and nibble/char;
haftmann
parents:
51112
diff
changeset
|
3031 |
shows "List.product xs ys ! n = (xs ! (n div length ys), ys ! (n mod length ys))" |
68719 | 3032 |
using assms proof (induct xs arbitrary: n) |
51160
599ff65b85e2
systematic conversions between nat and nibble/char;
haftmann
parents:
51112
diff
changeset
|
3033 |
case Nil then show ?case by simp |
599ff65b85e2
systematic conversions between nat and nibble/char;
haftmann
parents:
51112
diff
changeset
|
3034 |
next |
599ff65b85e2
systematic conversions between nat and nibble/char;
haftmann
parents:
51112
diff
changeset
|
3035 |
case (Cons x xs n) |
599ff65b85e2
systematic conversions between nat and nibble/char;
haftmann
parents:
51112
diff
changeset
|
3036 |
then have "length ys > 0" by auto |
599ff65b85e2
systematic conversions between nat and nibble/char;
haftmann
parents:
51112
diff
changeset
|
3037 |
with Cons show ?case |
599ff65b85e2
systematic conversions between nat and nibble/char;
haftmann
parents:
51112
diff
changeset
|
3038 |
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
|
3039 |
qed |
599ff65b85e2
systematic conversions between nat and nibble/char;
haftmann
parents:
51112
diff
changeset
|
3040 |
|
64963 | 3041 |
lemma in_set_product_lists_length: |
53721
ccaceea6c768
added two functions to List (one contributed by Manuel Eberl)
traytel
parents:
53689
diff
changeset
|
3042 |
"xs \<in> set (product_lists xss) \<Longrightarrow> length xs = length xss" |
68719 | 3043 |
by (induct xss arbitrary: xs) auto |
53721
ccaceea6c768
added two functions to List (one contributed by Manuel Eberl)
traytel
parents:
53689
diff
changeset
|
3044 |
|
ccaceea6c768
added two functions to List (one contributed by Manuel Eberl)
traytel
parents:
53689
diff
changeset
|
3045 |
lemma product_lists_set: |
ccaceea6c768
added two functions to List (one contributed by Manuel Eberl)
traytel
parents:
53689
diff
changeset
|
3046 |
"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
|
3047 |
proof (intro equalityI subsetI, unfold mem_Collect_eq) |
ccaceea6c768
added two functions to List (one contributed by Manuel Eberl)
traytel
parents:
53689
diff
changeset
|
3048 |
fix xs assume "xs \<in> ?L" |
ccaceea6c768
added two functions to List (one contributed by Manuel Eberl)
traytel
parents:
53689
diff
changeset
|
3049 |
then have "length xs = length xss" by (rule in_set_product_lists_length) |
60758 | 3050 |
from this \<open>xs \<in> ?L\<close> show "?R xs" by (induct xs xss rule: list_induct2) auto |
53721
ccaceea6c768
added two functions to List (one contributed by Manuel Eberl)
traytel
parents:
53689
diff
changeset
|
3051 |
next |
ccaceea6c768
added two functions to List (one contributed by Manuel Eberl)
traytel
parents:
53689
diff
changeset
|
3052 |
fix xs assume "?R xs" |
ccaceea6c768
added two functions to List (one contributed by Manuel Eberl)
traytel
parents:
53689
diff
changeset
|
3053 |
then show "xs \<in> ?L" by induct auto |
ccaceea6c768
added two functions to List (one contributed by Manuel Eberl)
traytel
parents:
53689
diff
changeset
|
3054 |
qed |
ccaceea6c768
added two functions to List (one contributed by Manuel Eberl)
traytel
parents:
53689
diff
changeset
|
3055 |
|
49948
744934b818c7
moved quite generic material from theory Enum to more appropriate places
haftmann
parents:
49808
diff
changeset
|
3056 |
|
69593 | 3057 |
subsubsection \<open>\<^const>\<open>fold\<close> with natural argument order\<close> |
60758 | 3058 |
|
61799 | 3059 |
lemma fold_simps [code]: \<comment> \<open>eta-expanded variant for generated code -- enables tail-recursion optimisation in Scala\<close> |
48828
441a4eed7823
prefer eta-expanded code equations for fold, to accomodate tail recursion optimisation in Scala
haftmann
parents:
48619
diff
changeset
|
3060 |
"fold f [] s = s" |
64963 | 3061 |
"fold f (x # xs) s = fold f xs (f x s)" |
68719 | 3062 |
by simp_all |
48828
441a4eed7823
prefer eta-expanded code equations for fold, to accomodate tail recursion optimisation in Scala
haftmann
parents:
48619
diff
changeset
|
3063 |
|
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
|
3064 |
lemma fold_remove1_split: |
58807 | 3065 |
"\<lbrakk> \<And>x y. x \<in> set xs \<Longrightarrow> y \<in> set xs \<Longrightarrow> f x \<circ> f y = f y \<circ> f x; |
3066 |
x \<in> set xs \<rbrakk> |
|
3067 |
\<Longrightarrow> fold f xs = fold f (remove1 x xs) \<circ> f x" |
|
68719 | 3068 |
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
|
3069 |
|
d9fe85d3d2cd
incorporated canonical fold combinator on lists into body of List theory; refactored passages on List.fold(l/r)
haftmann
parents:
46125
diff
changeset
|
3070 |
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
|
3071 |
"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
|
3072 |
\<Longrightarrow> fold f xs a = fold g ys b" |
68719 | 3073 |
by (induct ys arbitrary: a b xs) simp_all |
58807 | 3074 |
|
3075 |
lemma fold_id: "(\<And>x. x \<in> set xs \<Longrightarrow> f x = id) \<Longrightarrow> fold f xs = id" |
|
68719 | 3076 |
by (induct xs) simp_all |
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
|
3077 |
|
d9fe85d3d2cd
incorporated canonical fold combinator on lists into body of List theory; refactored passages on List.fold(l/r)
haftmann
parents:
46125
diff
changeset
|
3078 |
lemma fold_commute: |
58807 | 3079 |
"(\<And>x. x \<in> set xs \<Longrightarrow> h \<circ> g x = f x \<circ> h) \<Longrightarrow> h \<circ> fold g xs = fold f xs \<circ> h" |
68719 | 3080 |
by (induct xs) (simp_all add: fun_eq_iff) |
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
|
3081 |
|
d9fe85d3d2cd
incorporated canonical fold combinator on lists into body of List theory; refactored passages on List.fold(l/r)
haftmann
parents:
46125
diff
changeset
|
3082 |
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
|
3083 |
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
|
3084 |
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
|
3085 |
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
|
3086 |
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
|
3087 |
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
|
3088 |
qed |
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
3089 |
|
64963 | 3090 |
lemma fold_invariant: |
58807 | 3091 |
"\<lbrakk> \<And>x. x \<in> set xs \<Longrightarrow> Q x; P s; \<And>x s. Q x \<Longrightarrow> P s \<Longrightarrow> P (f x s) \<rbrakk> |
3092 |
\<Longrightarrow> P (fold f xs s)" |
|
68719 | 3093 |
by (induct xs arbitrary: s) simp_all |
58807 | 3094 |
|
3095 |
lemma fold_append [simp]: "fold f (xs @ ys) = fold f ys \<circ> fold f xs" |
|
68719 | 3096 |
by (induct xs) simp_all |
58807 | 3097 |
|
67091 | 3098 |
lemma fold_map [code_unfold]: "fold g (map f xs) = fold (g \<circ> f) xs" |
68719 | 3099 |
by (induct xs) simp_all |
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
|
3100 |
|
58437 | 3101 |
lemma fold_filter: |
3102 |
"fold f (filter P xs) = fold (\<lambda>x. if P x then f x else id) xs" |
|
68719 | 3103 |
by (induct xs) simp_all |
58437 | 3104 |
|
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
|
3105 |
lemma fold_rev: |
58807 | 3106 |
"(\<And>x y. x \<in> set xs \<Longrightarrow> y \<in> set xs \<Longrightarrow> f y \<circ> f x = f x \<circ> f y) |
3107 |
\<Longrightarrow> fold f (rev xs) = fold f xs" |
|
68719 | 3108 |
by (induct xs) (simp_all add: fold_commute_apply fun_eq_iff) |
58807 | 3109 |
|
3110 |
lemma fold_Cons_rev: "fold Cons xs = append (rev xs)" |
|
68719 | 3111 |
by (induct xs) simp_all |
58807 | 3112 |
|
3113 |
lemma rev_conv_fold [code]: "rev xs = fold Cons xs []" |
|
68719 | 3114 |
by (simp add: fold_Cons_rev) |
58807 | 3115 |
|
3116 |
lemma fold_append_concat_rev: "fold append xss = append (concat (rev xss))" |
|
68719 | 3117 |
by (induct xss) simp_all |
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
|
3118 |
|
69593 | 3119 |
text \<open>\<^const>\<open>Finite_Set.fold\<close> and \<^const>\<open>fold\<close>\<close> |
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
|
3120 |
|
d9fe85d3d2cd
incorporated canonical fold combinator on lists into body of List theory; refactored passages on List.fold(l/r)
haftmann
parents:
46125
diff
changeset
|
3121 |
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
|
3122 |
"Finite_Set.fold f y (set xs) = fold f (remdups xs) y" |
68719 | 3123 |
by (rule sym, induct xs arbitrary: y) (simp_all add: fold_fun_left_comm insert_absorb) |
48619 | 3124 |
|
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
|
3125 |
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
|
3126 |
"Finite_Set.fold f y (set xs) = fold f xs y" |
68719 | 3127 |
by (rule sym, induct xs arbitrary: y) (simp_all add: fold_fun_left_comm) |
58807 | 3128 |
|
3129 |
lemma union_set_fold [code]: "set xs \<union> A = fold Set.insert xs A" |
|
46147
2c4d8de91c4c
moved lemmas about List.set and set operations to List theory
haftmann
parents:
46143
diff
changeset
|
3130 |
proof - |
2c4d8de91c4c
moved lemmas about List.set and set operations to List theory
haftmann
parents:
46143
diff
changeset
|
3131 |
interpret comp_fun_idem Set.insert |
2c4d8de91c4c
moved lemmas about List.set and set operations to List theory
haftmann
parents:
46143
diff
changeset
|
3132 |
by (fact comp_fun_idem_insert) |
2c4d8de91c4c
moved lemmas about List.set and set operations to List theory
haftmann
parents:
46143
diff
changeset
|
3133 |
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
|
3134 |
qed |
2c4d8de91c4c
moved lemmas about List.set and set operations to List theory
haftmann
parents:
46143
diff
changeset
|
3135 |
|
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
|
3136 |
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
|
3137 |
"List.coset xs \<union> A = List.coset (List.filter (\<lambda>x. x \<notin> A) xs)" |
68719 | 3138 |
by auto |
58807 | 3139 |
|
3140 |
lemma minus_set_fold [code]: "A - set xs = fold Set.remove xs A" |
|
46147
2c4d8de91c4c
moved lemmas about List.set and set operations to List theory
haftmann
parents:
46143
diff
changeset
|
3141 |
proof - |
2c4d8de91c4c
moved lemmas about List.set and set operations to List theory
haftmann
parents:
46143
diff
changeset
|
3142 |
interpret comp_fun_idem Set.remove |
2c4d8de91c4c
moved lemmas about List.set and set operations to List theory
haftmann
parents:
46143
diff
changeset
|
3143 |
by (fact comp_fun_idem_remove) |
2c4d8de91c4c
moved lemmas about List.set and set operations to List theory
haftmann
parents:
46143
diff
changeset
|
3144 |
show ?thesis |
2c4d8de91c4c
moved lemmas about List.set and set operations to List theory
haftmann
parents:
46143
diff
changeset
|
3145 |
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
|
3146 |
qed |
2c4d8de91c4c
moved lemmas about List.set and set operations to List theory
haftmann
parents:
46143
diff
changeset
|
3147 |
|
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
|
3148 |
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
|
3149 |
"A - List.coset xs = set (List.filter (\<lambda>x. x \<in> A) xs)" |
68719 | 3150 |
by auto |
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
|
3151 |
|
d654c73e4b12
no preference wrt. fold(l/r); prefer fold rather than foldr for iterating over lists in generated code
haftmann
parents:
47131
diff
changeset
|
3152 |
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
|
3153 |
"A \<inter> set xs = set (List.filter (\<lambda>x. x \<in> A) xs)" |
68719 | 3154 |
by auto |
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
|
3155 |
|
d654c73e4b12
no preference wrt. fold(l/r); prefer fold rather than foldr for iterating over lists in generated code
haftmann
parents:
47131
diff
changeset
|
3156 |
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
|
3157 |
"A \<inter> List.coset xs = fold Set.remove xs A" |
68719 | 3158 |
by (simp add: Diff_eq [symmetric] minus_set_fold) |
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
|
3159 |
|
54885 | 3160 |
lemma (in semilattice_set) set_eq_fold [code]: |
51489 | 3161 |
"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
|
3162 |
proof - |
51489 | 3163 |
interpret comp_fun_idem f |
61169 | 3164 |
by standard (simp_all add: fun_eq_iff left_commute) |
51489 | 3165 |
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
|
3166 |
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
|
3167 |
|
d9fe85d3d2cd
incorporated canonical fold combinator on lists into body of List theory; refactored passages on List.fold(l/r)
haftmann
parents:
46125
diff
changeset
|
3168 |
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
|
3169 |
"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
|
3170 |
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
|
3171 |
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
|
3172 |
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
|
3173 |
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
|
3174 |
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
|
3175 |
|
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
|
3176 |
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
|
3177 |
|
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
|
3178 |
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
|
3179 |
"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
|
3180 |
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
|
3181 |
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
|
3182 |
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
|
3183 |
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
|
3184 |
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
|
3185 |
|
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
|
3186 |
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
|
3187 |
|
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
|
3188 |
lemma (in complete_lattice) INF_set_fold: |
69275 | 3189 |
"\<Sqinter>(f ` set xs) = fold (inf \<circ> f) xs top" |
68781 | 3190 |
using Inf_set_fold [of "map f xs"] by (simp add: fold_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
|
3191 |
|
d9fe85d3d2cd
incorporated canonical fold combinator on lists into body of List theory; refactored passages on List.fold(l/r)
haftmann
parents:
46125
diff
changeset
|
3192 |
lemma (in complete_lattice) SUP_set_fold: |
69275 | 3193 |
"\<Squnion>(f ` set xs) = fold (sup \<circ> f) xs bot" |
68781 | 3194 |
using Sup_set_fold [of "map f xs"] by (simp add: fold_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
|
3195 |
|
49948
744934b818c7
moved quite generic material from theory Enum to more appropriate places
haftmann
parents:
49808
diff
changeset
|
3196 |
|
69593 | 3197 |
subsubsection \<open>Fold variants: \<^const>\<open>foldr\<close> and \<^const>\<open>foldl\<close>\<close> |
60758 | 3198 |
|
3199 |
text \<open>Correspondence\<close> |
|
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
|
3200 |
|
58807 | 3201 |
lemma foldr_conv_fold [code_abbrev]: "foldr f xs = fold f (rev xs)" |
68719 | 3202 |
by (induct xs) simp_all |
58807 | 3203 |
|
3204 |
lemma foldl_conv_fold: "foldl f s xs = fold (\<lambda>x s. f s x) xs s" |
|
68719 | 3205 |
by (induct xs arbitrary: s) simp_all |
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
|
3206 |
|
61799 | 3207 |
lemma foldr_conv_foldl: \<comment> \<open>The ``Third Duality Theorem'' in Bird \& Wadler:\<close> |
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
|
3208 |
"foldr f xs a = foldl (\<lambda>x y. f y x) a (rev xs)" |
68719 | 3209 |
by (simp add: foldr_conv_fold foldl_conv_fold) |
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
|
3210 |
|
d654c73e4b12
no preference wrt. fold(l/r); prefer fold rather than foldr for iterating over lists in generated code
haftmann
parents:
47131
diff
changeset
|
3211 |
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
|
3212 |
"foldl f a xs = foldr (\<lambda>x y. f y x) (rev xs) a" |
68719 | 3213 |
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
|
3214 |
|
d9fe85d3d2cd
incorporated canonical fold combinator on lists into body of List theory; refactored passages on List.fold(l/r)
haftmann
parents:
46125
diff
changeset
|
3215 |
lemma foldr_fold: |
58807 | 3216 |
"(\<And>x y. x \<in> set xs \<Longrightarrow> y \<in> set xs \<Longrightarrow> f y \<circ> f x = f x \<circ> f y) |
3217 |
\<Longrightarrow> foldr f xs = fold f xs" |
|
68719 | 3218 |
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
|
3219 |
|
d9fe85d3d2cd
incorporated canonical fold combinator on lists into body of List theory; refactored passages on List.fold(l/r)
haftmann
parents:
46125
diff
changeset
|
3220 |
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
|
3221 |
"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" |
68719 | 3222 |
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
|
3223 |
|
d9fe85d3d2cd
incorporated canonical fold combinator on lists into body of List theory; refactored passages on List.fold(l/r)
haftmann
parents:
46125
diff
changeset
|
3224 |
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
|
3225 |
"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" |
68719 | 3226 |
by (auto simp add: foldl_conv_fold intro!: fold_cong) |
58807 | 3227 |
|
3228 |
lemma foldr_append [simp]: "foldr f (xs @ ys) a = foldr f xs (foldr f ys a)" |
|
68719 | 3229 |
by (simp add: foldr_conv_fold) |
58807 | 3230 |
|
3231 |
lemma foldl_append [simp]: "foldl f a (xs @ ys) = foldl f (foldl f a xs) ys" |
|
68719 | 3232 |
by (simp add: foldl_conv_fold) |
58807 | 3233 |
|
67091 | 3234 |
lemma foldr_map [code_unfold]: "foldr g (map f xs) a = foldr (g \<circ> f) xs a" |
68719 | 3235 |
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
|
3236 |
|
58437 | 3237 |
lemma foldr_filter: |
3238 |
"foldr f (filter P xs) = foldr (\<lambda>x. if P x then f x else id) xs" |
|
68719 | 3239 |
by (simp add: foldr_conv_fold rev_filter fold_filter) |
64963 | 3240 |
|
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
|
3241 |
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
|
3242 |
"foldl g a (map f xs) = foldl (\<lambda>a x. g a (f x)) a xs" |
68719 | 3243 |
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
|
3244 |
|
d9fe85d3d2cd
incorporated canonical fold combinator on lists into body of List theory; refactored passages on List.fold(l/r)
haftmann
parents:
46125
diff
changeset
|
3245 |
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
|
3246 |
"concat xss = foldr append xss []" |
68719 | 3247 |
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
|
3248 |
|
35115 | 3249 |
|
69593 | 3250 |
subsubsection \<open>\<^const>\<open>upt\<close>\<close> |
13114 | 3251 |
|
17090 | 3252 |
lemma upt_rec[code]: "[i..<j] = (if i<j then i#[Suc i..<j] else [])" |
68719 | 3253 |
\<comment> \<open>simp does not terminate!\<close> |
3254 |
by (induct j) auto |
|
13142 | 3255 |
|
47108
2a1953f0d20d
merged fork with new numeral representation (see NEWS)
huffman
parents:
46898
diff
changeset
|
3256 |
lemmas upt_rec_numeral[simp] = upt_rec[of "numeral m" "numeral n"] for m n |
32005 | 3257 |
|
71585 | 3258 |
lemma upt_conv_Nil [simp]: "j \<le> i \<Longrightarrow> [i..<j] = []" |
68719 | 3259 |
by (subst upt_rec) simp |
13114 | 3260 |
|
68709 | 3261 |
lemma upt_eq_Nil_conv[simp]: "([i..<j] = []) = (j = 0 \<or> j \<le> i)" |
68719 | 3262 |
by(induct j)simp_all |
15281 | 3263 |
|
3264 |
lemma upt_eq_Cons_conv: |
|
68719 | 3265 |
"([i..<j] = x#xs) = (i < j \<and> i = x \<and> [i+1..<j] = xs)" |
68709 | 3266 |
proof (induct j arbitrary: x xs) |
3267 |
case (Suc j) |
|
3268 |
then show ?case |
|
3269 |
by (simp add: upt_rec) |
|
3270 |
qed simp |
|
3271 |
||
71585 | 3272 |
lemma upt_Suc_append: "i \<le> j \<Longrightarrow> [i..<(Suc j)] = [i..<j]@[j]" |
68719 | 3273 |
\<comment> \<open>Only needed if \<open>upt_Suc\<close> is deleted from the simpset.\<close> |
3274 |
by simp |
|
13114 | 3275 |
|
71585 | 3276 |
lemma upt_conv_Cons: "i < j \<Longrightarrow> [i..<j] = i # [Suc i..<j]" |
68719 | 3277 |
by (simp add: upt_rec) |
13114 | 3278 |
|
63145 | 3279 |
lemma upt_conv_Cons_Cons: \<comment> \<open>no precondition\<close> |
62580 | 3280 |
"m # n # ns = [m..<q] \<longleftrightarrow> n # ns = [Suc m..<q]" |
3281 |
proof (cases "m < q") |
|
3282 |
case False then show ?thesis by simp |
|
3283 |
next |
|
3284 |
case True then show ?thesis by (simp add: upt_conv_Cons) |
|
3285 |
qed |
|
3286 |
||
71585 | 3287 |
lemma upt_add_eq_append: "i<=j \<Longrightarrow> [i..<j+k] = [i..<j]@[j..<j+k]" |
68719 | 3288 |
\<comment> \<open>LOOPS as a simprule, since \<open>j \<le> j\<close>.\<close> |
3289 |
by (induct k) auto |
|
13114 | 3290 |
|
15425 | 3291 |
lemma length_upt [simp]: "length [i..<j] = j - i" |
68719 | 3292 |
by (induct j) (auto simp add: Suc_diff_le) |
13114 | 3293 |
|
71585 | 3294 |
lemma nth_upt [simp]: "i + k < j \<Longrightarrow> [i..<j] ! k = i + k" |
68719 | 3295 |
by (induct j) (auto simp add: less_Suc_eq nth_append split: nat_diff_split) |
17906 | 3296 |
|
3297 |
lemma hd_upt[simp]: "i < j \<Longrightarrow> hd[i..<j] = i" |
|
68719 | 3298 |
by(simp add:upt_conv_Cons) |
17906 | 3299 |
|
70183
3ea80c950023
incorporated various material from the AFP into the distribution
haftmann
parents:
69850
diff
changeset
|
3300 |
lemma tl_upt [simp]: "tl [m..<n] = [Suc m..<n]" |
68719 | 3301 |
by (simp add: upt_rec) |
63317
ca187a9f66da
Various additions to polynomials, FPSs, Gamma function
eberlm
parents:
63173
diff
changeset
|
3302 |
|
17906 | 3303 |
lemma last_upt[simp]: "i < j \<Longrightarrow> last[i..<j] = j - 1" |
68719 | 3304 |
by(cases j)(auto simp: upt_Suc_append) |
17906 | 3305 |
|
71585 | 3306 |
lemma take_upt [simp]: "i+m \<le> n \<Longrightarrow> take m [i..<n] = [i..<i+m]" |
68709 | 3307 |
proof (induct m arbitrary: i) |
3308 |
case (Suc m) |
|
3309 |
then show ?case |
|
3310 |
by (subst take_Suc_conv_app_nth) auto |
|
3311 |
qed simp |
|
3507 | 3312 |
|
17501 | 3313 |
lemma drop_upt[simp]: "drop m [i..<j] = [i+m..<j]" |
68719 | 3314 |
by(induct j) auto |
17501 | 3315 |
|
24645 | 3316 |
lemma map_Suc_upt: "map Suc [m..<n] = [Suc m..<Suc n]" |
68719 | 3317 |
by (induct n) auto |
13114 | 3318 |
|
54496
178922b63b58
add lemmas Suc_funpow and id_funpow to simpset; add lemma map_add_upt
hoelzl
parents:
54404
diff
changeset
|
3319 |
lemma map_add_upt: "map (\<lambda>i. i + n) [0..<m] = [n..<m + n]" |
68719 | 3320 |
by (induct m) simp_all |
54496
178922b63b58
add lemmas Suc_funpow and id_funpow to simpset; add lemma map_add_upt
hoelzl
parents:
54404
diff
changeset
|
3321 |
|
71585 | 3322 |
lemma nth_map_upt: "i < n-m \<Longrightarrow> (map f [m..<n]) ! i = f(m+i)" |
68709 | 3323 |
proof (induct n m arbitrary: i rule: diff_induct) |
68719 | 3324 |
case (3 x y) |
68709 | 3325 |
then show ?case |
3326 |
by (metis add.commute length_upt less_diff_conv nth_map nth_upt) |
|
3327 |
qed auto |
|
13114 | 3328 |
|
58807 | 3329 |
lemma map_decr_upt: "map (\<lambda>n. n - Suc 0) [Suc m..<Suc n] = [m..<n]" |
68719 | 3330 |
by (induct n) simp_all |
66550
e5d82cf3c387
Some small lemmas about polynomials and FPSs
eberlm <eberlm@in.tum.de>
parents:
66502
diff
changeset
|
3331 |
|
e5d82cf3c387
Some small lemmas about polynomials and FPSs
eberlm <eberlm@in.tum.de>
parents:
66502
diff
changeset
|
3332 |
lemma map_upt_Suc: "map f [0 ..< Suc n] = f 0 # map (\<lambda>i. f (Suc i)) [0 ..< n]" |
68719 | 3333 |
by (induct n arbitrary: f) auto |
52380 | 3334 |
|
13883
0451e0fb3f22
Re-structured some proofs in order to get rid of rule_format attribute.
berghofe
parents:
13863
diff
changeset
|
3335 |
lemma nth_take_lemma: |
67091 | 3336 |
"k \<le> length xs \<Longrightarrow> k \<le> length ys \<Longrightarrow> |
3337 |
(\<And>i. i < k \<longrightarrow> xs!i = ys!i) \<Longrightarrow> take k xs = take k ys" |
|
68709 | 3338 |
proof (induct k arbitrary: xs ys) |
3339 |
case (Suc k) |
|
3340 |
then show ?case |
|
3341 |
apply (simp add: less_Suc_eq_0_disj) |
|
3342 |
by (simp add: Suc.prems(3) take_Suc_conv_app_nth) |
|
3343 |
qed simp |
|
13114 | 3344 |
|
3345 |
lemma nth_equalityI: |
|
68975
5ce4d117cea7
A few new results, elimination of duplicates and more use of "pairwise"
paulson <lp15@cam.ac.uk>
parents:
68781
diff
changeset
|
3346 |
"\<lbrakk>length xs = length ys; \<And>i. i < length xs \<Longrightarrow> xs!i = ys!i\<rbrakk> \<Longrightarrow> xs = ys" |
68719 | 3347 |
by (frule nth_take_lemma [OF le_refl eq_imp_le]) simp_all |
13142 | 3348 |
|
24796 | 3349 |
lemma map_nth: |
3350 |
"map (\<lambda>i. xs ! i) [0..<length xs] = xs" |
|
68719 | 3351 |
by (rule nth_equalityI, auto) |
58807 | 3352 |
|
13863 | 3353 |
lemma list_all2_antisym: |
64963 | 3354 |
"\<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> |
13863 | 3355 |
\<Longrightarrow> xs = ys" |
68719 | 3356 |
by (simp add: list_all2_conv_all_nth nth_equalityI) |
13863 | 3357 |
|
71585 | 3358 |
lemma take_equalityI: "(\<forall>i. take i xs = take i ys) \<Longrightarrow> xs = ys" |
61799 | 3359 |
\<comment> \<open>The famous take-lemma.\<close> |
68719 | 3360 |
by (metis length_take min.commute order_refl take_all) |
13142 | 3361 |
|
15302 | 3362 |
lemma take_Cons': |
58807 | 3363 |
"take n (x # xs) = (if n = 0 then [] else x # take (n - 1) xs)" |
15302 | 3364 |
by (cases n) simp_all |
3365 |
||
3366 |
lemma drop_Cons': |
|
58807 | 3367 |
"drop n (x # xs) = (if n = 0 then x # xs else drop (n - 1) xs)" |
15302 | 3368 |
by (cases n) simp_all |
3369 |
||
3370 |
lemma nth_Cons': "(x # xs)!n = (if n = 0 then x else xs!(n - 1))" |
|
3371 |
by (cases n) simp_all |
|
3372 |
||
47108
2a1953f0d20d
merged fork with new numeral representation (see NEWS)
huffman
parents:
46898
diff
changeset
|
3373 |
lemma take_Cons_numeral [simp]: |
2a1953f0d20d
merged fork with new numeral representation (see NEWS)
huffman
parents:
46898
diff
changeset
|
3374 |
"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
|
3375 |
by (simp add: take_Cons') |
2a1953f0d20d
merged fork with new numeral representation (see NEWS)
huffman
parents:
46898
diff
changeset
|
3376 |
|
2a1953f0d20d
merged fork with new numeral representation (see NEWS)
huffman
parents:
46898
diff
changeset
|
3377 |
lemma drop_Cons_numeral [simp]: |
2a1953f0d20d
merged fork with new numeral representation (see NEWS)
huffman
parents:
46898
diff
changeset
|
3378 |
"drop (numeral v) (x # xs) = drop (numeral v - 1) xs" |
2a1953f0d20d
merged fork with new numeral representation (see NEWS)
huffman
parents:
46898
diff
changeset
|
3379 |
by (simp add: drop_Cons') |
2a1953f0d20d
merged fork with new numeral representation (see NEWS)
huffman
parents:
46898
diff
changeset
|
3380 |
|
2a1953f0d20d
merged fork with new numeral representation (see NEWS)
huffman
parents:
46898
diff
changeset
|
3381 |
lemma nth_Cons_numeral [simp]: |
2a1953f0d20d
merged fork with new numeral representation (see NEWS)
huffman
parents:
46898
diff
changeset
|
3382 |
"(x # xs) ! numeral v = xs ! (numeral v - 1)" |
2a1953f0d20d
merged fork with new numeral representation (see NEWS)
huffman
parents:
46898
diff
changeset
|
3383 |
by (simp add: nth_Cons') |
15302 | 3384 |
|
3385 |
||
69593 | 3386 |
subsubsection \<open>\<open>upto\<close>: interval-list on \<^typ>\<open>int\<close>\<close> |
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
|
3387 |
|
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
|
3388 |
function upto :: "int \<Rightarrow> int \<Rightarrow> int list" ("(1[_../_])") where |
51166 | 3389 |
"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
|
3390 |
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
|
3391 |
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
|
3392 |
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
|
3393 |
|
51166 | 3394 |
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
|
3395 |
|
47108
2a1953f0d20d
merged fork with new numeral representation (see NEWS)
huffman
parents:
46898
diff
changeset
|
3396 |
lemmas upto_rec_numeral [simp] = |
2a1953f0d20d
merged fork with new numeral representation (see NEWS)
huffman
parents:
46898
diff
changeset
|
3397 |
upto.simps[of "numeral m" "numeral n"] |
54489
03ff4d1e6784
eliminiated neg_numeral in favour of - (numeral _)
haftmann
parents:
54404
diff
changeset
|
3398 |
upto.simps[of "numeral m" "- numeral n"] |
03ff4d1e6784
eliminiated neg_numeral in favour of - (numeral _)
haftmann
parents:
54404
diff
changeset
|
3399 |
upto.simps[of "- numeral m" "numeral n"] |
03ff4d1e6784
eliminiated neg_numeral in favour of - (numeral _)
haftmann
parents:
54404
diff
changeset
|
3400 |
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
|
3401 |
|
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
|
3402 |
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
|
3403 |
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
|
3404 |
|
67942 | 3405 |
lemma upto_single[simp]: "[i..i] = [i]" |
3406 |
by(simp add: upto.simps) |
|
3407 |
||
67124 | 3408 |
lemma upto_Nil[simp]: "[i..j] = [] \<longleftrightarrow> j < i" |
3409 |
by (simp add: upto.simps) |
|
3410 |
||
67168 | 3411 |
lemma upto_Nil2[simp]: "[] = [i..j] \<longleftrightarrow> j < i" |
3412 |
by (simp add: upto.simps) |
|
3413 |
||
51166 | 3414 |
lemma upto_rec1: "i \<le> j \<Longrightarrow> [i..j] = i#[i+1..j]" |
3415 |
by(simp add: upto.simps) |
|
3416 |
||
3417 |
lemma upto_rec2: "i \<le> j \<Longrightarrow> [i..j] = [i..j - 1]@[j]" |
|
3418 |
proof(induct "nat(j-i)" arbitrary: i j) |
|
3419 |
case 0 thus ?case by(simp add: upto.simps) |
|
3420 |
next |
|
3421 |
case (Suc n) |
|
3422 |
hence "n = nat (j - (i + 1))" "i < j" by linarith+ |
|
3423 |
from this(2) Suc.hyps(1)[OF this(1)] Suc(2,3) upto_rec1 show ?case by simp |
|
3424 |
qed |
|
3425 |
||
67949 | 3426 |
lemma length_upto[simp]: "length [i..j] = nat(j - i + 1)" |
3427 |
by(induction i j rule: upto.induct) (auto simp: upto.simps) |
|
3428 |
||
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
|
3429 |
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
|
3430 |
proof(induct i j rule:upto.induct) |
edbf0a86fb1c
adding simproc to rewrite list comprehensions to set comprehensions; adopting proofs
bulwahn
parents:
41372
diff
changeset
|
3431 |
case (1 i j) |
edbf0a86fb1c
adding simproc to rewrite list comprehensions to set comprehensions; adopting proofs
bulwahn
parents:
41372
diff
changeset
|
3432 |
from this show ?case |
55811 | 3433 |
unfolding upto.simps[of i j] by auto |
41463
edbf0a86fb1c
adding simproc to rewrite list comprehensions to set comprehensions; adopting proofs
bulwahn
parents:
41372
diff
changeset
|
3434 |
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
|
3435 |
|
69125 | 3436 |
lemma nth_upto[simp]: "i + int k \<le> j \<Longrightarrow> [i..j] ! k = i + int k" |
71585 | 3437 |
proof(induction i j arbitrary: k rule: upto.induct) |
3438 |
case (1 i j) |
|
3439 |
then show ?case |
|
3440 |
by (auto simp add: upto_rec1 [of i j] nth_Cons') |
|
3441 |
qed |
|
67949 | 3442 |
|
71393
fce780f9c9c6
new examples of BNF lifting across quotients using a new theory of confluence,
traytel
parents:
70911
diff
changeset
|
3443 |
lemma upto_split1: |
67081 | 3444 |
"i \<le> j \<Longrightarrow> j \<le> k \<Longrightarrow> [i..k] = [i..j-1] @ [j..k]" |
3445 |
proof (induction j rule: int_ge_induct) |
|
3446 |
case base thus ?case by (simp add: upto_rec1) |
|
3447 |
next |
|
3448 |
case step thus ?case using upto_rec1 upto_rec2 by simp |
|
3449 |
qed |
|
3450 |
||
71393
fce780f9c9c6
new examples of BNF lifting across quotients using a new theory of confluence,
traytel
parents:
70911
diff
changeset
|
3451 |
lemma upto_split2: |
67081 | 3452 |
"i \<le> j \<Longrightarrow> j \<le> k \<Longrightarrow> [i..k] = [i..j] @ [j+1..k]" |
3453 |
using upto_rec1 upto_rec2 upto_split1 by auto |
|
3454 |
||
67124 | 3455 |
lemma upto_split3: "\<lbrakk> i \<le> j; j \<le> k \<rbrakk> \<Longrightarrow> [i..k] = [i..j-1] @ j # [j+1..k]" |
3456 |
using upto_rec1 upto_split1 by auto |
|
3457 |
||
60758 | 3458 |
text\<open>Tail recursive version for code generation:\<close> |
51166 | 3459 |
|
51170 | 3460 |
definition upto_aux :: "int \<Rightarrow> int \<Rightarrow> int list \<Rightarrow> int list" where |
3461 |
"upto_aux i j js = [i..j] @ js" |
|
3462 |
||
3463 |
lemma upto_aux_rec [code]: |
|
51166 | 3464 |
"upto_aux i j js = (if j<i then js else upto_aux i (j - 1) (j#js))" |
58807 | 3465 |
by (simp add: upto_aux_def upto_rec2) |
51166 | 3466 |
|
3467 |
lemma upto_code[code]: "[i..j] = upto_aux i j []" |
|
51170 | 3468 |
by(simp add: upto_aux_def) |
51166 | 3469 |
|
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
|
3470 |
|
71779 | 3471 |
|
3472 |
subsubsection \<open>\<^const>\<open>successively\<close>\<close> |
|
3473 |
||
3474 |
lemma successively_Cons: |
|
3475 |
"successively P (x # xs) \<longleftrightarrow> xs = [] \<or> P x (hd xs) \<and> successively P xs" |
|
3476 |
by (cases xs) auto |
|
3477 |
||
3478 |
lemma successively_cong [cong]: |
|
3479 |
assumes "\<And>x y. x \<in> set xs \<Longrightarrow> y \<in> set xs \<Longrightarrow> P x y \<longleftrightarrow> Q x y" "xs = ys" |
|
3480 |
shows "successively P xs \<longleftrightarrow> successively Q ys" |
|
3481 |
unfolding assms(2) [symmetric] using assms(1) |
|
3482 |
by (induction xs) (auto simp: successively_Cons) |
|
3483 |
||
3484 |
||
3485 |
lemma successively_append_iff: |
|
3486 |
"successively P (xs @ ys) \<longleftrightarrow> |
|
3487 |
successively P xs \<and> successively P ys \<and> |
|
3488 |
(xs = [] \<or> ys = [] \<or> P (last xs) (hd ys))" |
|
3489 |
by (induction xs) (auto simp: successively_Cons) |
|
3490 |
||
3491 |
lemma successively_if_sorted_wrt: "sorted_wrt P xs \<Longrightarrow> successively P xs" |
|
3492 |
by (induction xs rule: induct_list012) auto |
|
3493 |
||
3494 |
||
3495 |
lemma successively_iff_sorted_wrt_strong: |
|
3496 |
assumes "\<And>x y z. x \<in> set xs \<Longrightarrow> y \<in> set xs \<Longrightarrow> z \<in> set xs \<Longrightarrow> |
|
3497 |
P x y \<Longrightarrow> P y z \<Longrightarrow> P x z" |
|
3498 |
shows "successively P xs \<longleftrightarrow> sorted_wrt P xs" |
|
3499 |
proof |
|
3500 |
assume "successively P xs" |
|
3501 |
from this and assms show "sorted_wrt P xs" |
|
3502 |
proof (induction xs rule: induct_list012) |
|
3503 |
case (3 x y xs) |
|
3504 |
from "3.prems" have "P x y" |
|
3505 |
by auto |
|
3506 |
have IH: "sorted_wrt P (y # xs)" |
|
3507 |
using "3.prems" |
|
3508 |
by(intro "3.IH"(2) list.set_intros(2))(simp, blast intro: list.set_intros(2)) |
|
3509 |
have "P x z" if asm: "z \<in> set xs" for z |
|
3510 |
proof - |
|
3511 |
from IH and asm have "P y z" |
|
3512 |
by auto |
|
3513 |
with \<open>P x y\<close> show "P x z" |
|
3514 |
using "3.prems" asm by auto |
|
3515 |
qed |
|
3516 |
with IH and \<open>P x y\<close> show ?case by auto |
|
3517 |
qed auto |
|
3518 |
qed (use successively_if_sorted_wrt in blast) |
|
3519 |
||
3520 |
lemma successively_conv_sorted_wrt: |
|
3521 |
assumes "transp P" |
|
3522 |
shows "successively P xs \<longleftrightarrow> sorted_wrt P xs" |
|
3523 |
using assms unfolding transp_def |
|
3524 |
by (intro successively_iff_sorted_wrt_strong) blast |
|
3525 |
||
3526 |
lemma successively_rev [simp]: "successively P (rev xs) \<longleftrightarrow> successively (\<lambda>x y. P y x) xs" |
|
3527 |
by (induction xs rule: remdups_adj.induct) |
|
3528 |
(auto simp: successively_append_iff successively_Cons) |
|
3529 |
||
3530 |
lemma successively_map: "successively P (map f xs) \<longleftrightarrow> successively (\<lambda>x y. P (f x) (f y)) xs" |
|
3531 |
by (induction xs rule: induct_list012) auto |
|
3532 |
||
3533 |
lemma successively_mono: |
|
3534 |
assumes "successively P xs" |
|
3535 |
assumes "\<And>x y. x \<in> set xs \<Longrightarrow> y \<in> set xs \<Longrightarrow> P x y \<Longrightarrow> Q x y" |
|
3536 |
shows "successively Q xs" |
|
3537 |
using assms by (induction Q xs rule: successively.induct) auto |
|
3538 |
||
3539 |
lemma successively_altdef: |
|
3540 |
"successively = (\<lambda>P. rec_list True (\<lambda>x xs b. case xs of [] \<Rightarrow> True | y # _ \<Rightarrow> P x y \<and> b))" |
|
3541 |
proof (intro ext) |
|
3542 |
fix P and xs :: "'a list" |
|
3543 |
show "successively P xs = rec_list True (\<lambda>x xs b. case xs of [] \<Rightarrow> True | y # _ \<Rightarrow> P x y \<and> b) xs" |
|
3544 |
by (induction xs) (auto simp: successively_Cons split: list.splits) |
|
3545 |
qed |
|
3546 |
||
3547 |
||
69593 | 3548 |
subsubsection \<open>\<^const>\<open>distinct\<close> and \<^const>\<open>remdups\<close> and \<^const>\<open>remdups_adj\<close>\<close> |
13142 | 3549 |
|
58807 | 3550 |
lemma distinct_tl: "distinct xs \<Longrightarrow> distinct (tl xs)" |
3551 |
by (cases xs) simp_all |
|
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
|
3552 |
|
13142 | 3553 |
lemma distinct_append [simp]: |
58807 | 3554 |
"distinct (xs @ ys) = (distinct xs \<and> distinct ys \<and> set xs \<inter> set ys = {})" |
13145 | 3555 |
by (induct xs) auto |
13142 | 3556 |
|
15305 | 3557 |
lemma distinct_rev[simp]: "distinct(rev xs) = distinct xs" |
3558 |
by(induct xs) auto |
|
3559 |
||
13142 | 3560 |
lemma set_remdups [simp]: "set (remdups xs) = set xs" |
13145 | 3561 |
by (induct xs) (auto simp add: insert_absorb) |
13142 | 3562 |
|
3563 |
lemma distinct_remdups [iff]: "distinct (remdups xs)" |
|
13145 | 3564 |
by (induct xs) auto |
13142 | 3565 |
|
71585 | 3566 |
lemma distinct_remdups_id: "distinct xs \<Longrightarrow> remdups xs = xs" |
25287 | 3567 |
by (induct xs, auto) |
3568 |
||
26734 | 3569 |
lemma remdups_id_iff_distinct [simp]: "remdups xs = xs \<longleftrightarrow> distinct xs" |
3570 |
by (metis distinct_remdups distinct_remdups_id) |
|
25287 | 3571 |
|
67091 | 3572 |
lemma finite_distinct_list: "finite A \<Longrightarrow> \<exists>xs. set xs = A \<and> distinct xs" |
24632 | 3573 |
by (metis distinct_remdups finite_list set_remdups) |
24566 | 3574 |
|
15072 | 3575 |
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
|
3576 |
by (induct x, auto) |
15072 | 3577 |
|
3578 |
lemma remdups_eq_nil_right_iff [simp]: "([] = remdups x) = (x = [])" |
|
24349 | 3579 |
by (induct x, auto) |
15072 | 3580 |
|
68709 | 3581 |
lemma length_remdups_leq[iff]: "length(remdups xs) \<le> length xs" |
15245 | 3582 |
by (induct xs) auto |
3583 |
||
3584 |
lemma length_remdups_eq[iff]: |
|
3585 |
"(length (remdups xs) = length xs) = (remdups xs = xs)" |
|
68719 | 3586 |
proof (induct xs) |
3587 |
case (Cons a xs) |
|
3588 |
then show ?case |
|
3589 |
by simp (metis Suc_n_not_le_n impossible_Cons length_remdups_leq) |
|
3590 |
qed auto |
|
15245 | 3591 |
|
33945 | 3592 |
lemma remdups_filter: "remdups(filter P xs) = filter P (remdups xs)" |
58807 | 3593 |
by (induct xs) auto |
18490 | 3594 |
|
3595 |
lemma distinct_map: |
|
67091 | 3596 |
"distinct(map f xs) = (distinct xs \<and> inj_on f (set xs))" |
18490 | 3597 |
by (induct xs) auto |
3598 |
||
58195 | 3599 |
lemma distinct_map_filter: |
3600 |
"distinct (map f xs) \<Longrightarrow> distinct (map f (filter P xs))" |
|
58807 | 3601 |
by (induct xs) auto |
58195 | 3602 |
|
71585 | 3603 |
lemma distinct_filter [simp]: "distinct xs \<Longrightarrow> distinct (filter P xs)" |
13145 | 3604 |
by (induct xs) auto |
13114 | 3605 |
|
17501 | 3606 |
lemma distinct_upt[simp]: "distinct[i..<j]" |
3607 |
by (induct j) auto |
|
3608 |
||
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
|
3609 |
lemma distinct_upto[simp]: "distinct[i..j]" |
71585 | 3610 |
proof (induction i j rule: upto.induct) |
3611 |
case (1 i j) |
|
3612 |
then show ?case |
|
3613 |
by (simp add: upto.simps [of i]) |
|
3614 |
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
|
3615 |
|
24526 | 3616 |
lemma distinct_take[simp]: "distinct xs \<Longrightarrow> distinct (take i xs)" |
68719 | 3617 |
proof (induct xs arbitrary: i) |
3618 |
case (Cons a xs) |
|
3619 |
then show ?case |
|
3620 |
by (metis Cons.prems append_take_drop_id distinct_append) |
|
3621 |
qed auto |
|
17501 | 3622 |
|
24526 | 3623 |
lemma distinct_drop[simp]: "distinct xs \<Longrightarrow> distinct (drop i xs)" |
68719 | 3624 |
proof (induct xs arbitrary: i) |
3625 |
case (Cons a xs) |
|
3626 |
then show ?case |
|
3627 |
by (metis Cons.prems append_take_drop_id distinct_append) |
|
3628 |
qed auto |
|
17501 | 3629 |
|
3630 |
lemma distinct_list_update: |
|
68719 | 3631 |
assumes d: "distinct xs" and a: "a \<notin> set xs - {xs!i}" |
3632 |
shows "distinct (xs[i:=a])" |
|
17501 | 3633 |
proof (cases "i < length xs") |
3634 |
case True |
|
68719 | 3635 |
with a have anot: "a \<notin> set (take i xs @ xs ! i # drop (Suc i) xs) - {xs!i}" |
3636 |
by simp (metis in_set_dropD in_set_takeD) |
|
3637 |
show ?thesis |
|
3638 |
proof (cases "a = xs!i") |
|
3639 |
case True |
|
3640 |
with d show ?thesis |
|
3641 |
by auto |
|
3642 |
next |
|
3643 |
case False |
|
71585 | 3644 |
have "set (take i xs) \<inter> set (drop (Suc i) xs) = {}" |
3645 |
by (metis True d disjoint_insert(1) distinct_append id_take_nth_drop list.set(2)) |
|
68719 | 3646 |
then show ?thesis |
71585 | 3647 |
using d False anot \<open>i < length xs\<close> by (simp add: upd_conv_take_nth_drop) |
68719 | 3648 |
qed |
17501 | 3649 |
next |
3650 |
case False with d show ?thesis by auto |
|
3651 |
qed |
|
3652 |
||
31363
7493b571b37d
Added theorems about distinct & concat, map & replicate and concat & replicate
hoelzl
parents:
31264
diff
changeset
|
3653 |
lemma distinct_concat: |
58807 | 3654 |
"\<lbrakk> distinct xs; |
3655 |
\<And> ys. ys \<in> set xs \<Longrightarrow> distinct ys; |
|
3656 |
\<And> ys zs. \<lbrakk> ys \<in> set xs ; zs \<in> set xs ; ys \<noteq> zs \<rbrakk> \<Longrightarrow> set ys \<inter> set zs = {} |
|
3657 |
\<rbrakk> \<Longrightarrow> distinct (concat xs)" |
|
3658 |
by (induct xs) auto |
|
17501 | 3659 |
|
71593 | 3660 |
text \<open>An iff-version of @{thm distinct_concat} is available further down as \<open>distinct_concat_iff\<close>.\<close> |
3661 |
||
3662 |
text \<open>It is best to avoid the following indexed version of distinct, but sometimes it is useful.\<close> |
|
17501 | 3663 |
|
68719 | 3664 |
lemma distinct_conv_nth: "distinct xs = (\<forall>i < size xs. \<forall>j < size xs. i \<noteq> j \<longrightarrow> xs!i \<noteq> xs!j)" |
3665 |
proof (induct xs) |
|
3666 |
case (Cons x xs) |
|
3667 |
show ?case |
|
3668 |
apply (auto simp add: Cons nth_Cons split: nat.split_asm) |
|
3669 |
apply (metis Suc_less_eq2 in_set_conv_nth less_not_refl zero_less_Suc)+ |
|
3670 |
done |
|
3671 |
qed auto |
|
13114 | 3672 |
|
18490 | 3673 |
lemma nth_eq_iff_index_eq: |
58807 | 3674 |
"\<lbrakk> distinct xs; i < length xs; j < length xs \<rbrakk> \<Longrightarrow> (xs!i = xs!j) = (i = j)" |
18490 | 3675 |
by(auto simp: distinct_conv_nth) |
3676 |
||
64963 | 3677 |
lemma distinct_Ex1: |
63099
af0e964aad7b
Moved material from AFP/Randomised_Social_Choice to distribution
eberlm
parents:
63092
diff
changeset
|
3678 |
"distinct xs \<Longrightarrow> x \<in> set xs \<Longrightarrow> (\<exists>!i. i < length xs \<and> xs ! i = x)" |
af0e964aad7b
Moved material from AFP/Randomised_Social_Choice to distribution
eberlm
parents:
63092
diff
changeset
|
3679 |
by (auto simp: in_set_conv_nth nth_eq_iff_index_eq) |
af0e964aad7b
Moved material from AFP/Randomised_Social_Choice to distribution
eberlm
parents:
63092
diff
changeset
|
3680 |
|
59728 | 3681 |
lemma inj_on_nth: "distinct xs \<Longrightarrow> \<forall>i \<in> I. i < length xs \<Longrightarrow> inj_on (nth xs) I" |
3682 |
by (rule inj_onI) (simp add: nth_eq_iff_index_eq) |
|
3683 |
||
63099
af0e964aad7b
Moved material from AFP/Randomised_Social_Choice to distribution
eberlm
parents:
63092
diff
changeset
|
3684 |
lemma bij_betw_nth: |
64963 | 3685 |
assumes "distinct xs" "A = {..<length xs}" "B = set xs" |
67399 | 3686 |
shows "bij_betw ((!) xs) A B" |
63099
af0e964aad7b
Moved material from AFP/Randomised_Social_Choice to distribution
eberlm
parents:
63092
diff
changeset
|
3687 |
using assms unfolding bij_betw_def |
af0e964aad7b
Moved material from AFP/Randomised_Social_Choice to distribution
eberlm
parents:
63092
diff
changeset
|
3688 |
by (auto intro!: inj_on_nth simp: set_conv_nth) |
af0e964aad7b
Moved material from AFP/Randomised_Social_Choice to distribution
eberlm
parents:
63092
diff
changeset
|
3689 |
|
56953 | 3690 |
lemma set_update_distinct: "\<lbrakk> distinct xs; n < length xs \<rbrakk> \<Longrightarrow> |
3691 |
set(xs[n := x]) = insert x (set xs - {xs!n})" |
|
3692 |
by(auto simp: set_eq_iff in_set_conv_nth nth_list_update nth_eq_iff_index_eq) |
|
3693 |
||
71585 | 3694 |
lemma distinct_swap[simp]: "\<lbrakk> i < size xs; j < size xs\<rbrakk> \<Longrightarrow> |
57537 | 3695 |
distinct(xs[i := xs!j, j := xs!i]) = distinct xs" |
68719 | 3696 |
apply (simp add: distinct_conv_nth nth_list_update) |
71585 | 3697 |
apply (safe; metis) |
3698 |
done |
|
57537 | 3699 |
|
3700 |
lemma set_swap[simp]: |
|
3701 |
"\<lbrakk> i < size xs; j < size xs \<rbrakk> \<Longrightarrow> set(xs[i := xs!j, j := xs!i]) = set xs" |
|
3702 |
by(simp add: set_conv_nth nth_list_update) metis |
|
3703 |
||
71585 | 3704 |
lemma distinct_card: "distinct xs \<Longrightarrow> card (set xs) = size xs" |
24349 | 3705 |
by (induct xs) auto |
14388 | 3706 |
|
71585 | 3707 |
lemma card_distinct: "card (set xs) = size xs \<Longrightarrow> distinct xs" |
14388 | 3708 |
proof (induct xs) |
3709 |
case (Cons x xs) |
|
3710 |
show ?case |
|
3711 |
proof (cases "x \<in> set xs") |
|
3712 |
case False with Cons show ?thesis by simp |
|
3713 |
next |
|
3714 |
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
|
3715 |
have "card (set xs) = Suc (length xs)" |
62390 | 3716 |
by (simp add: card_insert_if split: if_split_asm) |
14388 | 3717 |
moreover have "card (set xs) \<le> length xs" by (rule card_length) |
3718 |
ultimately have False by simp |
|
3719 |
thus ?thesis .. |
|
3720 |
qed |
|
68719 | 3721 |
qed simp |
14388 | 3722 |
|
45115
93c1ac6727a3
adding lemma to List library for executable equation of the (refl) transitive closure
bulwahn
parents:
44928
diff
changeset
|
3723 |
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
|
3724 |
by (induct xs) (auto) |
93c1ac6727a3
adding lemma to List library for executable equation of the (refl) transitive closure
bulwahn
parents:
44928
diff
changeset
|
3725 |
|
67091 | 3726 |
lemma not_distinct_decomp: "\<not> distinct ws \<Longrightarrow> \<exists>xs ys zs y. ws = xs@[y]@ys@[y]@zs" |
68719 | 3727 |
proof (induct n == "length ws" arbitrary:ws) |
3728 |
case (Suc n ws) |
|
3729 |
then show ?case |
|
3730 |
using length_Suc_conv [of ws n] |
|
3731 |
apply (auto simp: eq_commute) |
|
3732 |
apply (metis append_Nil in_set_conv_decomp_first) |
|
3733 |
by (metis append_Cons) |
|
3734 |
qed simp |
|
18490 | 3735 |
|
45841 | 3736 |
lemma not_distinct_conv_prefix: |
3737 |
defines "dec as xs y ys \<equiv> y \<in> set xs \<and> distinct xs \<and> as = xs @ y # ys" |
|
3738 |
shows "\<not>distinct as \<longleftrightarrow> (\<exists>xs y ys. dec as xs y ys)" (is "?L = ?R") |
|
3739 |
proof |
|
3740 |
assume "?L" then show "?R" |
|
3741 |
proof (induct "length as" arbitrary: as rule: less_induct) |
|
3742 |
case less |
|
3743 |
obtain xs ys zs y where decomp: "as = (xs @ y # ys) @ y # zs" |
|
3744 |
using not_distinct_decomp[OF less.prems] by auto |
|
3745 |
show ?case |
|
3746 |
proof (cases "distinct (xs @ y # ys)") |
|
3747 |
case True |
|
3748 |
with decomp have "dec as (xs @ y # ys) y zs" by (simp add: dec_def) |
|
3749 |
then show ?thesis by blast |
|
3750 |
next |
|
3751 |
case False |
|
3752 |
with less decomp obtain xs' y' ys' where "dec (xs @ y # ys) xs' y' ys'" |
|
3753 |
by atomize_elim auto |
|
3754 |
with decomp have "dec as xs' y' (ys' @ y # zs)" by (simp add: dec_def) |
|
3755 |
then show ?thesis by blast |
|
3756 |
qed |
|
3757 |
qed |
|
3758 |
qed (auto simp: dec_def) |
|
3759 |
||
49948
744934b818c7
moved quite generic material from theory Enum to more appropriate places
haftmann
parents:
49808
diff
changeset
|
3760 |
lemma distinct_product: |
57247 | 3761 |
"distinct xs \<Longrightarrow> distinct ys \<Longrightarrow> distinct (List.product xs ys)" |
3762 |
by (induct xs) (auto intro: inj_onI simp add: distinct_map) |
|
49948
744934b818c7
moved quite generic material from theory Enum to more appropriate places
haftmann
parents:
49808
diff
changeset
|
3763 |
|
53721
ccaceea6c768
added two functions to List (one contributed by Manuel Eberl)
traytel
parents:
53689
diff
changeset
|
3764 |
lemma distinct_product_lists: |
ccaceea6c768
added two functions to List (one contributed by Manuel Eberl)
traytel
parents:
53689
diff
changeset
|
3765 |
assumes "\<forall>xs \<in> set xss. distinct xs" |
ccaceea6c768
added two functions to List (one contributed by Manuel Eberl)
traytel
parents:
53689
diff
changeset
|
3766 |
shows "distinct (product_lists xss)" |
ccaceea6c768
added two functions to List (one contributed by Manuel Eberl)
traytel
parents:
53689
diff
changeset
|
3767 |
using assms proof (induction xss) |
ccaceea6c768
added two functions to List (one contributed by Manuel Eberl)
traytel
parents:
53689
diff
changeset
|
3768 |
case (Cons xs xss) note * = this |
ccaceea6c768
added two functions to List (one contributed by Manuel Eberl)
traytel
parents:
53689
diff
changeset
|
3769 |
then show ?case |
ccaceea6c768
added two functions to List (one contributed by Manuel Eberl)
traytel
parents:
53689
diff
changeset
|
3770 |
proof (cases "product_lists xss") |
ccaceea6c768
added two functions to List (one contributed by Manuel Eberl)
traytel
parents:
53689
diff
changeset
|
3771 |
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
|
3772 |
next |
64963 | 3773 |
case (Cons ps pss) with * show ?thesis |
53721
ccaceea6c768
added two functions to List (one contributed by Manuel Eberl)
traytel
parents:
53689
diff
changeset
|
3774 |
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
|
3775 |
qed |
ccaceea6c768
added two functions to List (one contributed by Manuel Eberl)
traytel
parents:
53689
diff
changeset
|
3776 |
qed simp |
ccaceea6c768
added two functions to List (one contributed by Manuel Eberl)
traytel
parents:
53689
diff
changeset
|
3777 |
|
18490 | 3778 |
lemma length_remdups_concat: |
44921 | 3779 |
"length (remdups (concat xss)) = card (\<Union>xs\<in>set xss. set xs)" |
58807 | 3780 |
by (simp add: distinct_card [symmetric]) |
17906 | 3781 |
|
71393
fce780f9c9c6
new examples of BNF lifting across quotients using a new theory of confluence,
traytel
parents:
70911
diff
changeset
|
3782 |
lemma remdups_append2: |
fce780f9c9c6
new examples of BNF lifting across quotients using a new theory of confluence,
traytel
parents:
70911
diff
changeset
|
3783 |
"remdups (xs @ remdups ys) = remdups (xs @ ys)" |
fce780f9c9c6
new examples of BNF lifting across quotients using a new theory of confluence,
traytel
parents:
70911
diff
changeset
|
3784 |
by(induction xs) auto |
fce780f9c9c6
new examples of BNF lifting across quotients using a new theory of confluence,
traytel
parents:
70911
diff
changeset
|
3785 |
|
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
|
3786 |
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
|
3787 |
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
|
3788 |
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
|
3789 |
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
|
3790 |
qed |
17906 | 3791 |
|
58807 | 3792 |
lemma remdups_remdups: "remdups (remdups xs) = remdups xs" |
3793 |
by (induct xs) simp_all |
|
36275 | 3794 |
|
36851 | 3795 |
lemma distinct_butlast: |
46500
0196966d6d2d
removing unnecessary premises in theorems of List theory
bulwahn
parents:
46448
diff
changeset
|
3796 |
assumes "distinct xs" |
36851 | 3797 |
shows "distinct (butlast xs)" |
46500
0196966d6d2d
removing unnecessary premises in theorems of List theory
bulwahn
parents:
46448
diff
changeset
|
3798 |
proof (cases "xs = []") |
0196966d6d2d
removing unnecessary premises in theorems of List theory
bulwahn
parents:
46448
diff
changeset
|
3799 |
case False |
60758 | 3800 |
from \<open>xs \<noteq> []\<close> obtain ys y where "xs = ys @ [y]" by (cases xs rule: rev_cases) auto |
3801 |
with \<open>distinct xs\<close> show ?thesis by simp |
|
46500
0196966d6d2d
removing unnecessary premises in theorems of List theory
bulwahn
parents:
46448
diff
changeset
|
3802 |
qed (auto) |
36851 | 3803 |
|
39728 | 3804 |
lemma remdups_map_remdups: |
3805 |
"remdups (map f (remdups xs)) = remdups (map f xs)" |
|
58807 | 3806 |
by (induct xs) simp_all |
39728 | 3807 |
|
39915
ecf97cf3d248
turned distinct and sorted into inductive predicates: yields nice induction principles for free; more elegant proofs
haftmann
parents:
39774
diff
changeset
|
3808 |
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
|
3809 |
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
|
3810 |
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
|
3811 |
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
|
3812 |
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
|
3813 |
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
|
3814 |
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
|
3815 |
with assms have "distinct xs'" by simp |
60758 | 3816 |
with \<open>length xs' = length ys'\<close> show "distinct (zip xs' ys')" |
39915
ecf97cf3d248
turned distinct and sorted into inductive predicates: yields nice induction principles for free; more elegant proofs
haftmann
parents:
39774
diff
changeset
|
3817 |
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
|
3818 |
qed |
ecf97cf3d248
turned distinct and sorted into inductive predicates: yields nice induction principles for free; more elegant proofs
haftmann
parents:
39774
diff
changeset
|
3819 |
|
ecf97cf3d248
turned distinct and sorted into inductive predicates: yields nice induction principles for free; more elegant proofs
haftmann
parents:
39774
diff
changeset
|
3820 |
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
|
3821 |
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
|
3822 |
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
|
3823 |
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
|
3824 |
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
|
3825 |
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
|
3826 |
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
|
3827 |
with assms have "distinct ys'" by simp |
60758 | 3828 |
with \<open>length xs' = length ys'\<close> show "distinct (zip xs' ys')" |
39915
ecf97cf3d248
turned distinct and sorted into inductive predicates: yields nice induction principles for free; more elegant proofs
haftmann
parents:
39774
diff
changeset
|
3829 |
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
|
3830 |
qed |
ecf97cf3d248
turned distinct and sorted into inductive predicates: yields nice induction principles for free; more elegant proofs
haftmann
parents:
39774
diff
changeset
|
3831 |
|
47122 | 3832 |
lemma set_take_disj_set_drop_if_distinct: |
3833 |
"distinct vs \<Longrightarrow> i \<le> j \<Longrightarrow> set (take i vs) \<inter> set (drop j vs) = {}" |
|
3834 |
by (auto simp: in_set_conv_nth distinct_conv_nth) |
|
3835 |
||
44635
3d046864ebe6
added two lemmas about "distinct" to help Sledgehammer
blanchet
parents:
44619
diff
changeset
|
3836 |
(* The next two lemmas help Sledgehammer. *) |
3d046864ebe6
added two lemmas about "distinct" to help Sledgehammer
blanchet
parents:
44619
diff
changeset
|
3837 |
|
3d046864ebe6
added two lemmas about "distinct" to help Sledgehammer
blanchet
parents:
44619
diff
changeset
|
3838 |
lemma distinct_singleton: "distinct [x]" by simp |
3d046864ebe6
added two lemmas about "distinct" to help Sledgehammer
blanchet
parents:
44619
diff
changeset
|
3839 |
|
3d046864ebe6
added two lemmas about "distinct" to help Sledgehammer
blanchet
parents:
44619
diff
changeset
|
3840 |
lemma distinct_length_2_or_more: |
58807 | 3841 |
"distinct (a # b # xs) \<longleftrightarrow> (a \<noteq> b \<and> distinct (a # xs) \<and> distinct (b # xs))" |
56085 | 3842 |
by force |
44635
3d046864ebe6
added two lemmas about "distinct" to help Sledgehammer
blanchet
parents:
44619
diff
changeset
|
3843 |
|
58969 | 3844 |
lemma remdups_adj_altdef: "(remdups_adj xs = ys) \<longleftrightarrow> |
67091 | 3845 |
(\<exists>f::nat => nat. mono f \<and> f ` {0 ..< size xs} = {0 ..< size ys} |
58969 | 3846 |
\<and> (\<forall>i < size xs. xs!i = ys!(f i)) |
61941 | 3847 |
\<and> (\<forall>i. i + 1 < size xs \<longrightarrow> (xs!i = xs!(i+1) \<longleftrightarrow> f i = f(i+1))))" (is "?L \<longleftrightarrow> (\<exists>f. ?p f xs ys)") |
58969 | 3848 |
proof |
3849 |
assume ?L |
|
3850 |
then show "\<exists>f. ?p f xs ys" |
|
3851 |
proof (induct xs arbitrary: ys rule: remdups_adj.induct) |
|
3852 |
case (1 ys) |
|
3853 |
thus ?case by (intro exI[of _ id]) (auto simp: mono_def) |
|
3854 |
next |
|
3855 |
case (2 x ys) |
|
3856 |
thus ?case by (intro exI[of _ id]) (auto simp: mono_def) |
|
3857 |
next |
|
3858 |
case (3 x1 x2 xs ys) |
|
3859 |
let ?xs = "x1 # x2 # xs" |
|
3860 |
let ?cond = "x1 = x2" |
|
63040 | 3861 |
define zs where "zs = remdups_adj (x2 # xs)" |
58969 | 3862 |
from 3(1-2)[of zs] |
3863 |
obtain f where p: "?p f (x2 # xs) zs" unfolding zs_def by (cases ?cond) auto |
|
3864 |
then have f0: "f 0 = 0" |
|
3865 |
by (intro mono_image_least[where f=f]) blast+ |
|
3866 |
from p have mono: "mono f" and f_xs_zs: "f ` {0..<length (x2 # xs)} = {0..<length zs}" by auto |
|
3867 |
have ys: "ys = (if x1 = x2 then zs else x1 # zs)" |
|
3868 |
unfolding 3(3)[symmetric] zs_def by auto |
|
3869 |
have zs0: "zs ! 0 = x2" unfolding zs_def by (induct xs) auto |
|
3870 |
have zsne: "zs \<noteq> []" unfolding zs_def by (induct xs) auto |
|
3871 |
let ?Succ = "if ?cond then id else Suc" |
|
3872 |
let ?x1 = "if ?cond then id else Cons x1" |
|
3873 |
let ?f = "\<lambda> i. if i = 0 then 0 else ?Succ (f (i - 1))" |
|
3874 |
have ys: "ys = ?x1 zs" unfolding ys by (cases ?cond, auto) |
|
60758 | 3875 |
have mono: "mono ?f" using \<open>mono f\<close> unfolding mono_def by auto |
58969 | 3876 |
show ?case unfolding ys |
3877 |
proof (intro exI[of _ ?f] conjI allI impI) |
|
3878 |
show "mono ?f" by fact |
|
3879 |
next |
|
3880 |
fix i assume i: "i < length ?xs" |
|
3881 |
with p show "?xs ! i = ?x1 zs ! (?f i)" using zs0 by auto |
|
3882 |
next |
|
3883 |
fix i assume i: "i + 1 < length ?xs" |
|
3884 |
with p show "(?xs ! i = ?xs ! (i + 1)) = (?f i = ?f (i + 1))" |
|
3885 |
by (cases i) (auto simp: f0) |
|
3886 |
next |
|
3887 |
have id: "{0 ..< length (?x1 zs)} = insert 0 (?Succ ` {0 ..< length zs})" |
|
3888 |
using zsne by (cases ?cond, auto) |
|
3889 |
{ fix i assume "i < Suc (length xs)" |
|
67399 | 3890 |
hence "Suc i \<in> {0..<Suc (Suc (length xs))} \<inter> Collect ((<) 0)" by auto |
58969 | 3891 |
from imageI[OF this, of "\<lambda>i. ?Succ (f (i - Suc 0))"] |
67399 | 3892 |
have "?Succ (f i) \<in> (\<lambda>i. ?Succ (f (i - Suc 0))) ` ({0..<Suc (Suc (length xs))} \<inter> Collect ((<) 0))" by auto |
58969 | 3893 |
} |
3894 |
then show "?f ` {0 ..< length ?xs} = {0 ..< length (?x1 zs)}" |
|
3895 |
unfolding id f_xs_zs[symmetric] by auto |
|
3896 |
qed |
|
3897 |
qed |
|
3898 |
next |
|
3899 |
assume "\<exists> f. ?p f xs ys" |
|
3900 |
then show ?L |
|
3901 |
proof (induct xs arbitrary: ys rule: remdups_adj.induct) |
|
3902 |
case 1 then show ?case by auto |
|
3903 |
next |
|
3904 |
case (2 x) then obtain f where f_img: "f ` {0 ..< size [x]} = {0 ..< size ys}" |
|
3905 |
and f_nth: "\<And>i. i < size [x] \<Longrightarrow> [x]!i = ys!(f i)" |
|
3906 |
by blast |
|
3907 |
||
3908 |
have "length ys = card (f ` {0 ..< size [x]})" |
|
3909 |
using f_img by auto |
|
63540 | 3910 |
then have *: "length ys = 1" by auto |
58969 | 3911 |
then have "f 0 = 0" using f_img by auto |
63540 | 3912 |
with * show ?case using f_nth by (cases ys) auto |
58969 | 3913 |
next |
3914 |
case (3 x1 x2 xs) |
|
3915 |
from "3.prems" obtain f where f_mono: "mono f" |
|
3916 |
and f_img: "f ` {0..<length (x1 # x2 # xs)} = {0..<length ys}" |
|
3917 |
and f_nth: |
|
3918 |
"\<And>i. i < length (x1 # x2 # xs) \<Longrightarrow> (x1 # x2 # xs) ! i = ys ! f i" |
|
3919 |
"\<And>i. i + 1 < length (x1 # x2 #xs) \<Longrightarrow> |
|
3920 |
((x1 # x2 # xs) ! i = (x1 # x2 # xs) ! (i + 1)) = (f i = f (i + 1))" |
|
3921 |
by blast |
|
3922 |
||
3923 |
show ?case |
|
3924 |
proof cases |
|
3925 |
assume "x1 = x2" |
|
3926 |
||
67091 | 3927 |
let ?f' = "f \<circ> Suc" |
58969 | 3928 |
|
3929 |
have "remdups_adj (x1 # xs) = ys" |
|
3930 |
proof (intro "3.hyps" exI conjI impI allI) |
|
3931 |
show "mono ?f'" |
|
3932 |
using f_mono by (simp add: mono_iff_le_Suc) |
|
3933 |
next |
|
3934 |
have "?f' ` {0 ..< length (x1 # xs)} = f ` {Suc 0 ..< length (x1 # x2 # xs)}" |
|
71585 | 3935 |
using less_Suc_eq_0_disj by auto |
58969 | 3936 |
also have "\<dots> = f ` {0 ..< length (x1 # x2 # xs)}" |
3937 |
proof - |
|
3938 |
have "f 0 = f (Suc 0)" using \<open>x1 = x2\<close> f_nth[of 0] by simp |
|
69850 | 3939 |
then show ?thesis |
71585 | 3940 |
using less_Suc_eq_0_disj by auto |
58969 | 3941 |
qed |
3942 |
also have "\<dots> = {0 ..< length ys}" by fact |
|
3943 |
finally show "?f' ` {0 ..< length (x1 # xs)} = {0 ..< length ys}" . |
|
3944 |
qed (insert f_nth[of "Suc i" for i], auto simp: \<open>x1 = x2\<close>) |
|
3945 |
then show ?thesis using \<open>x1 = x2\<close> by simp |
|
3946 |
next |
|
3947 |
assume "x1 \<noteq> x2" |
|
3948 |
||
71585 | 3949 |
have two: "Suc (Suc 0) \<le> length ys" |
58969 | 3950 |
proof - |
3951 |
have "2 = card {f 0, f 1}" using \<open>x1 \<noteq> x2\<close> f_nth[of 0] by auto |
|
3952 |
also have "\<dots> \<le> card (f ` {0..< length (x1 # x2 # xs)})" |
|
3953 |
by (rule card_mono) auto |
|
3954 |
finally show ?thesis using f_img by simp |
|
3955 |
qed |
|
3956 |
||
3957 |
have "f 0 = 0" using f_mono f_img by (rule mono_image_least) simp |
|
3958 |
||
3959 |
have "f (Suc 0) = Suc 0" |
|
3960 |
proof (rule ccontr) |
|
3961 |
assume "f (Suc 0) \<noteq> Suc 0" |
|
3962 |
then have "Suc 0 < f (Suc 0)" using f_nth[of 0] \<open>x1 \<noteq> x2\<close> \<open>f 0 = 0\<close> by auto |
|
3963 |
then have "\<And>i. Suc 0 < f (Suc i)" |
|
3964 |
using f_mono |
|
3965 |
by (meson Suc_le_mono le0 less_le_trans monoD) |
|
69850 | 3966 |
then have "Suc 0 \<noteq> f i" for i using \<open>f 0 = 0\<close> |
3967 |
by (cases i) fastforce+ |
|
58969 | 3968 |
then have "Suc 0 \<notin> f ` {0 ..< length (x1 # x2 # xs)}" by auto |
71585 | 3969 |
then show False using f_img two by auto |
58969 | 3970 |
qed |
3971 |
obtain ys' where "ys = x1 # x2 # ys'" |
|
71585 | 3972 |
using two f_nth[of 0] f_nth[of 1] |
3973 |
by (auto simp: Suc_le_length_iff \<open>f 0 = 0\<close> \<open>f (Suc 0) = Suc 0\<close>) |
|
3974 |
||
3975 |
have Suc0_le_f_Suc: "Suc 0 \<le> f (Suc i)" for i |
|
3976 |
by (metis Suc_le_mono \<open>f (Suc 0) = Suc 0\<close> f_mono le0 mono_def) |
|
58969 | 3977 |
|
63040 | 3978 |
define f' where "f' x = f (Suc x) - 1" for x |
71585 | 3979 |
have f_Suc: "f (Suc i) = Suc (f' i)" for i |
58969 | 3980 |
using Suc0_le_f_Suc[of i] by (auto simp: f'_def) |
3981 |
||
3982 |
have "remdups_adj (x2 # xs) = (x2 # ys')" |
|
3983 |
proof (intro "3.hyps" exI conjI impI allI) |
|
3984 |
show "mono f'" |
|
3985 |
using Suc0_le_f_Suc f_mono by (auto simp: f'_def mono_iff_le_Suc le_diff_iff) |
|
3986 |
next |
|
3987 |
have "f' ` {0 ..< length (x2 # xs)} = (\<lambda>x. f x - 1) ` {0 ..< length (x1 # x2 #xs)}" |
|
68719 | 3988 |
by (auto simp: f'_def \<open>f 0 = 0\<close> \<open>f (Suc 0) = Suc 0\<close> image_def Bex_def less_Suc_eq_0_disj) |
58969 | 3989 |
also have "\<dots> = (\<lambda>x. x - 1) ` f ` {0 ..< length (x1 # x2 #xs)}" |
3990 |
by (auto simp: image_comp) |
|
3991 |
also have "\<dots> = (\<lambda>x. x - 1) ` {0 ..< length ys}" |
|
3992 |
by (simp only: f_img) |
|
3993 |
also have "\<dots> = {0 ..< length (x2 # ys')}" |
|
3994 |
using \<open>ys = _\<close> by (fastforce intro: rev_image_eqI) |
|
3995 |
finally show "f' ` {0 ..< length (x2 # xs)} = {0 ..< length (x2 # ys')}" . |
|
3996 |
qed (insert f_nth[of "Suc i" for i] \<open>x1 \<noteq> x2\<close>, auto simp add: f_Suc \<open>ys = _\<close>) |
|
3997 |
then show ?case using \<open>ys = _\<close> \<open>x1 \<noteq> x2\<close> by simp |
|
3998 |
qed |
|
3999 |
qed |
|
4000 |
qed |
|
4001 |
||
58041 | 4002 |
lemma hd_remdups_adj[simp]: "hd (remdups_adj xs) = hd xs" |
71585 | 4003 |
by (induction xs rule: remdups_adj.induct) simp_all |
58041 | 4004 |
|
53721
ccaceea6c768
added two functions to List (one contributed by Manuel Eberl)
traytel
parents:
53689
diff
changeset
|
4005 |
lemma remdups_adj_Cons: "remdups_adj (x # xs) = |
ccaceea6c768
added two functions to List (one contributed by Manuel Eberl)
traytel
parents:
53689
diff
changeset
|
4006 |
(case remdups_adj xs of [] \<Rightarrow> [x] | y # xs \<Rightarrow> if x = y then y # xs else x # y # xs)" |
71585 | 4007 |
by (induct xs arbitrary: x) (auto split: list.splits) |
53721
ccaceea6c768
added two functions to List (one contributed by Manuel Eberl)
traytel
parents:
53689
diff
changeset
|
4008 |
|
64963 | 4009 |
lemma remdups_adj_append_two: |
53721
ccaceea6c768
added two functions to List (one contributed by Manuel Eberl)
traytel
parents:
53689
diff
changeset
|
4010 |
"remdups_adj (xs @ [x,y]) = remdups_adj (xs @ [x]) @ (if x = y then [] else [y])" |
71585 | 4011 |
by (induct xs rule: remdups_adj.induct, simp_all) |
53721
ccaceea6c768
added two functions to List (one contributed by Manuel Eberl)
traytel
parents:
53689
diff
changeset
|
4012 |
|
58041 | 4013 |
lemma remdups_adj_adjacent: |
4014 |
"Suc i < length (remdups_adj xs) \<Longrightarrow> remdups_adj xs ! i \<noteq> remdups_adj xs ! Suc i" |
|
4015 |
proof (induction xs arbitrary: i rule: remdups_adj.induct) |
|
4016 |
case (3 x y xs i) |
|
4017 |
thus ?case by (cases i, cases "x = y") (simp, auto simp: hd_conv_nth[symmetric]) |
|
4018 |
qed simp_all |
|
4019 |
||
53721
ccaceea6c768
added two functions to List (one contributed by Manuel Eberl)
traytel
parents:
53689
diff
changeset
|
4020 |
lemma remdups_adj_rev[simp]: "remdups_adj (rev xs) = rev (remdups_adj xs)" |
58807 | 4021 |
by (induct xs rule: remdups_adj.induct, simp_all add: remdups_adj_append_two) |
53721
ccaceea6c768
added two functions to List (one contributed by Manuel Eberl)
traytel
parents:
53689
diff
changeset
|
4022 |
|
ccaceea6c768
added two functions to List (one contributed by Manuel Eberl)
traytel
parents:
53689
diff
changeset
|
4023 |
lemma remdups_adj_length[simp]: "length (remdups_adj xs) \<le> length xs" |
58807 | 4024 |
by (induct xs rule: remdups_adj.induct, auto) |
53721
ccaceea6c768
added two functions to List (one contributed by Manuel Eberl)
traytel
parents:
53689
diff
changeset
|
4025 |
|
ccaceea6c768
added two functions to List (one contributed by Manuel Eberl)
traytel
parents:
53689
diff
changeset
|
4026 |
lemma remdups_adj_length_ge1[simp]: "xs \<noteq> [] \<Longrightarrow> length (remdups_adj xs) \<ge> Suc 0" |
58807 | 4027 |
by (induct xs rule: remdups_adj.induct, simp_all) |
53721
ccaceea6c768
added two functions to List (one contributed by Manuel Eberl)
traytel
parents:
53689
diff
changeset
|
4028 |
|
ccaceea6c768
added two functions to List (one contributed by Manuel Eberl)
traytel
parents:
53689
diff
changeset
|
4029 |
lemma remdups_adj_Nil_iff[simp]: "remdups_adj xs = [] \<longleftrightarrow> xs = []" |
58807 | 4030 |
by (induct xs rule: remdups_adj.induct, simp_all) |
53721
ccaceea6c768
added two functions to List (one contributed by Manuel Eberl)
traytel
parents:
53689
diff
changeset
|
4031 |
|
ccaceea6c768
added two functions to List (one contributed by Manuel Eberl)
traytel
parents:
53689
diff
changeset
|
4032 |
lemma remdups_adj_set[simp]: "set (remdups_adj xs) = set xs" |
58807 | 4033 |
by (induct xs rule: remdups_adj.induct, simp_all) |
53721
ccaceea6c768
added two functions to List (one contributed by Manuel Eberl)
traytel
parents:
53689
diff
changeset
|
4034 |
|
71778 | 4035 |
lemma last_remdups_adj [simp]: "last (remdups_adj xs) = last xs" |
4036 |
by (induction xs rule: remdups_adj.induct) auto |
|
4037 |
||
53721
ccaceea6c768
added two functions to List (one contributed by Manuel Eberl)
traytel
parents:
53689
diff
changeset
|
4038 |
lemma remdups_adj_Cons_alt[simp]: "x # tl (remdups_adj (x # xs)) = remdups_adj (x # xs)" |
58807 | 4039 |
by (induct xs rule: remdups_adj.induct, auto) |
53721
ccaceea6c768
added two functions to List (one contributed by Manuel Eberl)
traytel
parents:
53689
diff
changeset
|
4040 |
|
ccaceea6c768
added two functions to List (one contributed by Manuel Eberl)
traytel
parents:
53689
diff
changeset
|
4041 |
lemma remdups_adj_distinct: "distinct xs \<Longrightarrow> remdups_adj xs = xs" |
58807 | 4042 |
by (induct xs rule: remdups_adj.induct, simp_all) |
53721
ccaceea6c768
added two functions to List (one contributed by Manuel Eberl)
traytel
parents:
53689
diff
changeset
|
4043 |
|
64963 | 4044 |
lemma remdups_adj_append: |
53721
ccaceea6c768
added two functions to List (one contributed by Manuel Eberl)
traytel
parents:
53689
diff
changeset
|
4045 |
"remdups_adj (xs\<^sub>1 @ x # xs\<^sub>2) = remdups_adj (xs\<^sub>1 @ [x]) @ tl (remdups_adj (x # xs\<^sub>2))" |
58807 | 4046 |
by (induct xs\<^sub>1 rule: remdups_adj.induct, simp_all) |
53721
ccaceea6c768
added two functions to List (one contributed by Manuel Eberl)
traytel
parents:
53689
diff
changeset
|
4047 |
|
ccaceea6c768
added two functions to List (one contributed by Manuel Eberl)
traytel
parents:
53689
diff
changeset
|
4048 |
lemma remdups_adj_singleton: |
ccaceea6c768
added two functions to List (one contributed by Manuel Eberl)
traytel
parents:
53689
diff
changeset
|
4049 |
"remdups_adj xs = [x] \<Longrightarrow> xs = replicate (length xs) x" |
62390 | 4050 |
by (induct xs rule: remdups_adj.induct, auto split: if_split_asm) |
53721
ccaceea6c768
added two functions to List (one contributed by Manuel Eberl)
traytel
parents:
53689
diff
changeset
|
4051 |
|
ccaceea6c768
added two functions to List (one contributed by Manuel Eberl)
traytel
parents:
53689
diff
changeset
|
4052 |
lemma remdups_adj_map_injective: |
ccaceea6c768
added two functions to List (one contributed by Manuel Eberl)
traytel
parents:
53689
diff
changeset
|
4053 |
assumes "inj f" |
ccaceea6c768
added two functions to List (one contributed by Manuel Eberl)
traytel
parents:
53689
diff
changeset
|
4054 |
shows "remdups_adj (map f xs) = map f (remdups_adj xs)" |
58807 | 4055 |
by (induct xs rule: remdups_adj.induct) (auto simp add: injD[OF assms]) |
4056 |
||
62065 | 4057 |
lemma remdups_adj_replicate: |
4058 |
"remdups_adj (replicate n x) = (if n = 0 then [] else [x])" |
|
4059 |
by (induction n) (auto simp: remdups_adj_Cons) |
|
4060 |
||
58807 | 4061 |
lemma remdups_upt [simp]: "remdups [m..<n] = [m..<n]" |
58437 | 4062 |
proof (cases "m \<le> n") |
4063 |
case False then show ?thesis by simp |
|
4064 |
next |
|
4065 |
case True then obtain q where "n = m + q" |
|
4066 |
by (auto simp add: le_iff_add) |
|
4067 |
moreover have "remdups [m..<m + q] = [m..<m + q]" |
|
4068 |
by (induct q) simp_all |
|
4069 |
ultimately show ?thesis by simp |
|
4070 |
qed |
|
4071 |
||
71779 | 4072 |
lemma successively_remdups_adjI: |
4073 |
"successively P xs \<Longrightarrow> successively P (remdups_adj xs)" |
|
4074 |
by (induction xs rule: remdups_adj.induct) (auto simp: successively_Cons) |
|
4075 |
||
4076 |
lemma successively_remdups_adj_iff: |
|
4077 |
"(\<And>x. x \<in> set xs \<Longrightarrow> P x x) \<Longrightarrow> |
|
4078 |
successively P (remdups_adj xs) \<longleftrightarrow> successively P xs" |
|
4079 |
by (induction xs rule: remdups_adj.induct)(auto simp: successively_Cons) |
|
4080 |
||
71789 | 4081 |
lemma remdups_adj_Cons': |
4082 |
"remdups_adj (x # xs) = x # remdups_adj (dropWhile (\<lambda>y. y = x) xs)" |
|
4083 |
by (induction xs) auto |
|
4084 |
||
4085 |
lemma remdups_adj_singleton_iff: |
|
4086 |
"length (remdups_adj xs) = Suc 0 \<longleftrightarrow> xs \<noteq> [] \<and> xs = replicate (length xs) (hd xs)" |
|
4087 |
proof safe |
|
4088 |
assume *: "xs = replicate (length xs) (hd xs)" and [simp]: "xs \<noteq> []" |
|
4089 |
show "length (remdups_adj xs) = Suc 0" |
|
4090 |
by (subst *) (auto simp: remdups_adj_replicate) |
|
4091 |
next |
|
4092 |
assume "length (remdups_adj xs) = Suc 0" |
|
4093 |
thus "xs = replicate (length xs) (hd xs)" |
|
4094 |
by (induction xs rule: remdups_adj.induct) (auto split: if_splits) |
|
4095 |
qed auto |
|
4096 |
||
4097 |
lemma tl_remdups_adj: |
|
4098 |
"ys \<noteq> [] \<Longrightarrow> tl (remdups_adj ys) = remdups_adj (dropWhile (\<lambda>x. x = hd ys) (tl ys))" |
|
4099 |
by (cases ys) (simp_all add: remdups_adj_Cons') |
|
4100 |
||
4101 |
lemma remdups_adj_append_dropWhile: |
|
4102 |
"remdups_adj (xs @ y # ys) = remdups_adj (xs @ [y]) @ remdups_adj (dropWhile (\<lambda>x. x = y) ys)" |
|
4103 |
by (subst remdups_adj_append) (simp add: tl_remdups_adj) |
|
4104 |
||
4105 |
lemma remdups_adj_append': |
|
4106 |
assumes "xs = [] \<or> ys = [] \<or> last xs \<noteq> hd ys" |
|
4107 |
shows "remdups_adj (xs @ ys) = remdups_adj xs @ remdups_adj ys" |
|
4108 |
proof - |
|
4109 |
have ?thesis if [simp]: "xs \<noteq> []" "ys \<noteq> []" and "last xs \<noteq> hd ys" |
|
4110 |
proof - |
|
4111 |
obtain x xs' where xs: "xs = xs' @ [x]" |
|
4112 |
by (cases xs rule: rev_cases) auto |
|
4113 |
have "remdups_adj (xs' @ x # ys) = remdups_adj (xs' @ [x]) @ remdups_adj ys" |
|
4114 |
using \<open>last xs \<noteq> hd ys\<close> unfolding xs |
|
4115 |
by (metis (full_types) dropWhile_eq_self_iff last_snoc remdups_adj_append_dropWhile) |
|
4116 |
thus ?thesis by (simp add: xs) |
|
4117 |
qed |
|
4118 |
thus ?thesis using assms |
|
4119 |
by (cases "xs = []"; cases "ys = []") auto |
|
4120 |
qed |
|
4121 |
||
4122 |
lemma remdups_adj_append'': "xs \<noteq> [] |
|
4123 |
\<Longrightarrow> remdups_adj (xs @ ys) = remdups_adj xs @ remdups_adj (dropWhile (\<lambda>y. y = last xs) ys)" |
|
4124 |
by (induction xs rule: remdups_adj.induct) (auto simp: remdups_adj_Cons') |
|
4125 |
||
71779 | 4126 |
|
4127 |
subsection \<open>@{const distinct_adj}\<close> |
|
4128 |
||
4129 |
lemma distinct_adj_Nil [simp]: "distinct_adj []" |
|
4130 |
and distinct_adj_singleton [simp]: "distinct_adj [x]" |
|
4131 |
and distinct_adj_Cons_Cons [simp]: "distinct_adj (x # y # xs) \<longleftrightarrow> x \<noteq> y \<and> distinct_adj (y # xs)" |
|
4132 |
by (auto simp: distinct_adj_def) |
|
4133 |
||
4134 |
lemma distinct_adj_Cons: "distinct_adj (x # xs) \<longleftrightarrow> xs = [] \<or> x \<noteq> hd xs \<and> distinct_adj xs" |
|
4135 |
by (cases xs) auto |
|
4136 |
||
4137 |
lemma distinct_adj_ConsD: "distinct_adj (x # xs) \<Longrightarrow> distinct_adj xs" |
|
4138 |
by (cases xs) auto |
|
4139 |
||
4140 |
lemma distinct_adj_remdups_adj[simp]: "distinct_adj (remdups_adj xs)" |
|
4141 |
by (induction xs rule: remdups_adj.induct) (auto simp: distinct_adj_Cons) |
|
4142 |
||
4143 |
lemma distinct_adj_altdef: "distinct_adj xs \<longleftrightarrow> remdups_adj xs = xs" |
|
4144 |
proof |
|
4145 |
assume "remdups_adj xs = xs" |
|
4146 |
with distinct_adj_remdups_adj[of xs] show "distinct_adj xs" |
|
4147 |
by simp |
|
4148 |
next |
|
4149 |
assume "distinct_adj xs" |
|
4150 |
thus "remdups_adj xs = xs" |
|
4151 |
by (induction xs rule: induct_list012) auto |
|
4152 |
qed |
|
4153 |
||
4154 |
lemma distinct_adj_rev [simp]: "distinct_adj (rev xs) \<longleftrightarrow> distinct_adj xs" |
|
4155 |
by (simp add: distinct_adj_def eq_commute) |
|
4156 |
||
4157 |
lemma distinct_adj_append_iff: |
|
4158 |
"distinct_adj (xs @ ys) \<longleftrightarrow> |
|
4159 |
distinct_adj xs \<and> distinct_adj ys \<and> (xs = [] \<or> ys = [] \<or> last xs \<noteq> hd ys)" |
|
4160 |
by (auto simp: distinct_adj_def successively_append_iff) |
|
4161 |
||
4162 |
lemma distinct_adj_appendD1 [dest]: "distinct_adj (xs @ ys) \<Longrightarrow> distinct_adj xs" |
|
4163 |
and distinct_adj_appendD2 [dest]: "distinct_adj (xs @ ys) \<Longrightarrow> distinct_adj ys" |
|
4164 |
by (auto simp: distinct_adj_append_iff) |
|
4165 |
||
4166 |
lemma distinct_adj_mapI: "distinct_adj xs \<Longrightarrow> inj_on f (set xs) \<Longrightarrow> distinct_adj (map f xs)" |
|
4167 |
unfolding distinct_adj_def successively_map |
|
4168 |
by (erule successively_mono) (auto simp: inj_on_def) |
|
4169 |
||
4170 |
lemma distinct_adj_mapD: "distinct_adj (map f xs) \<Longrightarrow> distinct_adj xs" |
|
4171 |
unfolding distinct_adj_def successively_map by (erule successively_mono) auto |
|
4172 |
||
4173 |
lemma distinct_adj_map_iff: "inj_on f (set xs) \<Longrightarrow> distinct_adj (map f xs) \<longleftrightarrow> distinct_adj xs" |
|
4174 |
using distinct_adj_mapD distinct_adj_mapI by blast |
|
4175 |
||
49948
744934b818c7
moved quite generic material from theory Enum to more appropriate places
haftmann
parents:
49808
diff
changeset
|
4176 |
|
69593 | 4177 |
subsubsection \<open>\<^const>\<open>insert\<close>\<close> |
34978
874150ddd50a
canonical insert operation; generalized lemma foldl_apply_inv to foldl_apply
haftmann
parents:
34942
diff
changeset
|
4178 |
|
874150ddd50a
canonical insert operation; generalized lemma foldl_apply_inv to foldl_apply
haftmann
parents:
34942
diff
changeset
|
4179 |
lemma in_set_insert [simp]: |
874150ddd50a
canonical insert operation; generalized lemma foldl_apply_inv to foldl_apply
haftmann
parents:
34942
diff
changeset
|
4180 |
"x \<in> set xs \<Longrightarrow> List.insert x xs = xs" |
58807 | 4181 |
by (simp add: List.insert_def) |
34978
874150ddd50a
canonical insert operation; generalized lemma foldl_apply_inv to foldl_apply
haftmann
parents:
34942
diff
changeset
|
4182 |
|
874150ddd50a
canonical insert operation; generalized lemma foldl_apply_inv to foldl_apply
haftmann
parents:
34942
diff
changeset
|
4183 |
lemma not_in_set_insert [simp]: |
874150ddd50a
canonical insert operation; generalized lemma foldl_apply_inv to foldl_apply
haftmann
parents:
34942
diff
changeset
|
4184 |
"x \<notin> set xs \<Longrightarrow> List.insert x xs = x # xs" |
58807 | 4185 |
by (simp add: List.insert_def) |
4186 |
||
4187 |
lemma insert_Nil [simp]: "List.insert x [] = [x]" |
|
4188 |
by simp |
|
4189 |
||
4190 |
lemma set_insert [simp]: "set (List.insert x xs) = insert x (set xs)" |
|
4191 |
by (auto simp add: List.insert_def) |
|
4192 |
||
4193 |
lemma distinct_insert [simp]: "distinct (List.insert x xs) = distinct xs" |
|
4194 |
by (simp add: List.insert_def) |
|
35295 | 4195 |
|
36275 | 4196 |
lemma insert_remdups: |
4197 |
"List.insert x (remdups xs) = remdups (List.insert x xs)" |
|
58807 | 4198 |
by (simp add: List.insert_def) |
36275 | 4199 |
|
34978
874150ddd50a
canonical insert operation; generalized lemma foldl_apply_inv to foldl_apply
haftmann
parents:
34942
diff
changeset
|
4200 |
|
69593 | 4201 |
subsubsection \<open>\<^const>\<open>List.union\<close>\<close> |
60758 | 4202 |
|
4203 |
text\<open>This is all one should need to know about union:\<close> |
|
57198 | 4204 |
lemma set_union[simp]: "set (List.union xs ys) = set xs \<union> set ys" |
4205 |
unfolding List.union_def |
|
4206 |
by(induct xs arbitrary: ys) simp_all |
|
4207 |
||
4208 |
lemma distinct_union[simp]: "distinct(List.union xs ys) = distinct ys" |
|
4209 |
unfolding List.union_def |
|
4210 |
by(induct xs arbitrary: ys) simp_all |
|
4211 |
||
4212 |
||
69593 | 4213 |
subsubsection \<open>\<^const>\<open>List.find\<close>\<close> |
47122 | 4214 |
|
4215 |
lemma find_None_iff: "List.find P xs = None \<longleftrightarrow> \<not> (\<exists>x. x \<in> set xs \<and> P x)" |
|
4216 |
proof (induction xs) |
|
4217 |
case Nil thus ?case by simp |
|
4218 |
next |
|
4219 |
case (Cons x xs) thus ?case by (fastforce split: if_splits) |
|
4220 |
qed |
|
4221 |
||
4222 |
lemma find_Some_iff: |
|
4223 |
"List.find P xs = Some x \<longleftrightarrow> |
|
4224 |
(\<exists>i<length xs. P (xs!i) \<and> x = xs!i \<and> (\<forall>j<i. \<not> P (xs!j)))" |
|
4225 |
proof (induction xs) |
|
4226 |
case Nil thus ?case by simp |
|
4227 |
next |
|
4228 |
case (Cons x xs) thus ?case |
|
56085 | 4229 |
apply(auto simp: nth_Cons' split: if_splits) |
4230 |
using diff_Suc_1[unfolded One_nat_def] less_Suc_eq_0_disj by fastforce |
|
47122 | 4231 |
qed |
4232 |
||
4233 |
lemma find_cong[fundef_cong]: |
|
64963 | 4234 |
assumes "xs = ys" and "\<And>x. x \<in> set ys \<Longrightarrow> P x = Q x" |
47122 | 4235 |
shows "List.find P xs = List.find Q ys" |
4236 |
proof (cases "List.find P xs") |
|
4237 |
case None thus ?thesis by (metis find_None_iff assms) |
|
4238 |
next |
|
4239 |
case (Some x) |
|
4240 |
hence "List.find Q ys = Some x" using assms |
|
4241 |
by (auto simp add: find_Some_iff) |
|
4242 |
thus ?thesis using Some by auto |
|
4243 |
qed |
|
4244 |
||
52379 | 4245 |
lemma find_dropWhile: |
4246 |
"List.find P xs = (case dropWhile (Not \<circ> P) xs |
|
4247 |
of [] \<Rightarrow> None |
|
4248 |
| x # _ \<Rightarrow> Some x)" |
|
58807 | 4249 |
by (induct xs) simp_all |
52379 | 4250 |
|
47122 | 4251 |
|
69593 | 4252 |
subsubsection \<open>\<^const>\<open>count_list\<close>\<close> |
60541 | 4253 |
|
4254 |
lemma count_notin[simp]: "x \<notin> set xs \<Longrightarrow> count_list xs x = 0" |
|
59728 | 4255 |
by (induction xs) auto |
4256 |
||
60541 | 4257 |
lemma count_le_length: "count_list xs x \<le> length xs" |
59728 | 4258 |
by (induction xs) auto |
4259 |
||
64267 | 4260 |
lemma sum_count_set: |
4261 |
"set xs \<subseteq> X \<Longrightarrow> finite X \<Longrightarrow> sum (count_list xs) X = length xs" |
|
68719 | 4262 |
proof (induction xs arbitrary: X) |
4263 |
case (Cons x xs) |
|
4264 |
then show ?case |
|
71585 | 4265 |
using sum.remove [of X x "count_list xs"] |
4266 |
by (auto simp: sum.If_cases simp flip: diff_eq) |
|
68719 | 4267 |
qed simp |
59728 | 4268 |
|
4269 |
||
69593 | 4270 |
subsubsection \<open>\<^const>\<open>List.extract\<close>\<close> |
55807 | 4271 |
|
4272 |
lemma extract_None_iff: "List.extract P xs = None \<longleftrightarrow> \<not> (\<exists> x\<in>set xs. P x)" |
|
4273 |
by(auto simp: extract_def dropWhile_eq_Cons_conv split: list.splits) |
|
4274 |
(metis in_set_conv_decomp) |
|
4275 |
||
4276 |
lemma extract_SomeE: |
|
4277 |
"List.extract P xs = Some (ys, y, zs) \<Longrightarrow> |
|
64963 | 4278 |
xs = ys @ y # zs \<and> P y \<and> \<not> (\<exists> y \<in> set ys. P y)" |
55807 | 4279 |
by(auto simp: extract_def dropWhile_eq_Cons_conv split: list.splits) |
4280 |
||
4281 |
lemma extract_Some_iff: |
|
4282 |
"List.extract P xs = Some (ys, y, zs) \<longleftrightarrow> |
|
64963 | 4283 |
xs = ys @ y # zs \<and> P y \<and> \<not> (\<exists> y \<in> set ys. P y)" |
55807 | 4284 |
by(auto simp: extract_def dropWhile_eq_Cons_conv dest: set_takeWhileD split: list.splits) |
4285 |
||
4286 |
lemma extract_Nil_code[code]: "List.extract P [] = None" |
|
4287 |
by(simp add: extract_def) |
|
4288 |
||
4289 |
lemma extract_Cons_code[code]: |
|
4290 |
"List.extract P (x # xs) = (if P x then Some ([], x, xs) else |
|
4291 |
(case List.extract P xs of |
|
4292 |
None \<Rightarrow> None | |
|
4293 |
Some (ys, y, zs) \<Rightarrow> Some (x#ys, y, zs)))" |
|
56085 | 4294 |
by(auto simp add: extract_def comp_def split: list.splits) |
4295 |
(metis dropWhile_eq_Nil_conv list.distinct(1)) |
|
55807 | 4296 |
|
4297 |
||
69593 | 4298 |
subsubsection \<open>\<^const>\<open>remove1\<close>\<close> |
15110
78b5636eabc7
Added a number of new thms and the new function remove1
nipkow
parents:
15072
diff
changeset
|
4299 |
|
18049 | 4300 |
lemma remove1_append: |
4301 |
"remove1 x (xs @ ys) = |
|
4302 |
(if x \<in> set xs then remove1 x xs @ ys else xs @ remove1 x ys)" |
|
4303 |
by (induct xs) auto |
|
4304 |
||
36903 | 4305 |
lemma remove1_commute: "remove1 x (remove1 y zs) = remove1 y (remove1 x zs)" |
4306 |
by (induct zs) auto |
|
4307 |
||
23479 | 4308 |
lemma in_set_remove1[simp]: |
67613 | 4309 |
"a \<noteq> b \<Longrightarrow> a \<in> set(remove1 b xs) = (a \<in> set xs)" |
68719 | 4310 |
by (induct xs) auto |
23479 | 4311 |
|
67613 | 4312 |
lemma set_remove1_subset: "set(remove1 x xs) \<subseteq> set xs" |
68719 | 4313 |
by (induct xs) auto |
15110
78b5636eabc7
Added a number of new thms and the new function remove1
nipkow
parents:
15072
diff
changeset
|
4314 |
|
67613 | 4315 |
lemma set_remove1_eq [simp]: "distinct xs \<Longrightarrow> set(remove1 x xs) = set xs - {x}" |
68719 | 4316 |
by (induct xs) auto |
15110
78b5636eabc7
Added a number of new thms and the new function remove1
nipkow
parents:
15072
diff
changeset
|
4317 |
|
23479 | 4318 |
lemma length_remove1: |
67613 | 4319 |
"length(remove1 x xs) = (if x \<in> set xs then length xs - 1 else length xs)" |
58807 | 4320 |
by (induct xs) (auto dest!:length_pos_if_in_set) |
23479 | 4321 |
|
18049 | 4322 |
lemma remove1_filter_not[simp]: |
4323 |
"\<not> P x \<Longrightarrow> remove1 x (filter P xs) = filter P xs" |
|
4324 |
by(induct xs) auto |
|
4325 |
||
39073 | 4326 |
lemma filter_remove1: |
4327 |
"filter Q (remove1 x xs) = remove1 x (filter Q xs)" |
|
4328 |
by (induct xs) auto |
|
4329 |
||
67613 | 4330 |
lemma notin_set_remove1[simp]: "x \<notin> set xs \<Longrightarrow> x \<notin> set(remove1 y xs)" |
58807 | 4331 |
by(insert set_remove1_subset) fast |
15110
78b5636eabc7
Added a number of new thms and the new function remove1
nipkow
parents:
15072
diff
changeset
|
4332 |
|
67613 | 4333 |
lemma distinct_remove1[simp]: "distinct xs \<Longrightarrow> distinct(remove1 x xs)" |
15110
78b5636eabc7
Added a number of new thms and the new function remove1
nipkow
parents:
15072
diff
changeset
|
4334 |
by (induct xs) simp_all |
78b5636eabc7
Added a number of new thms and the new function remove1
nipkow
parents:
15072
diff
changeset
|
4335 |
|
36275 | 4336 |
lemma remove1_remdups: |
4337 |
"distinct xs \<Longrightarrow> remove1 x (remdups xs) = remdups (remove1 x xs)" |
|
58807 | 4338 |
by (induct xs) simp_all |
4339 |
||
4340 |
lemma remove1_idem: "x \<notin> set xs \<Longrightarrow> remove1 x xs = xs" |
|
4341 |
by (induct xs) simp_all |
|
37107 | 4342 |
|
13114 | 4343 |
|
69593 | 4344 |
subsubsection \<open>\<^const>\<open>removeAll\<close>\<close> |
27693 | 4345 |
|
34978
874150ddd50a
canonical insert operation; generalized lemma foldl_apply_inv to foldl_apply
haftmann
parents:
34942
diff
changeset
|
4346 |
lemma removeAll_filter_not_eq: |
874150ddd50a
canonical insert operation; generalized lemma foldl_apply_inv to foldl_apply
haftmann
parents:
34942
diff
changeset
|
4347 |
"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
|
4348 |
proof |
874150ddd50a
canonical insert operation; generalized lemma foldl_apply_inv to foldl_apply
haftmann
parents:
34942
diff
changeset
|
4349 |
fix xs |
874150ddd50a
canonical insert operation; generalized lemma foldl_apply_inv to foldl_apply
haftmann
parents:
34942
diff
changeset
|
4350 |
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
|
4351 |
by (induct xs) auto |
874150ddd50a
canonical insert operation; generalized lemma foldl_apply_inv to foldl_apply
haftmann
parents:
34942
diff
changeset
|
4352 |
qed |
874150ddd50a
canonical insert operation; generalized lemma foldl_apply_inv to foldl_apply
haftmann
parents:
34942
diff
changeset
|
4353 |
|
27693 | 4354 |
lemma removeAll_append[simp]: |
4355 |
"removeAll x (xs @ ys) = removeAll x xs @ removeAll x ys" |
|
4356 |
by (induct xs) auto |
|
4357 |
||
4358 |
lemma set_removeAll[simp]: "set(removeAll x xs) = set xs - {x}" |
|
4359 |
by (induct xs) auto |
|
4360 |
||
4361 |
lemma removeAll_id[simp]: "x \<notin> set xs \<Longrightarrow> removeAll x xs = xs" |
|
4362 |
by (induct xs) auto |
|
4363 |
||
46448
f1201fac7398
more specification of the quotient package in IsarRef
Cezary Kaliszyk <cezarykaliszyk@gmail.com>
parents:
46440
diff
changeset
|
4364 |
(* Needs count:: 'a \<Rightarrow> 'a list \<Rightarrow> nat |
27693 | 4365 |
lemma length_removeAll: |
4366 |
"length(removeAll x xs) = length xs - count x xs" |
|
4367 |
*) |
|
4368 |
||
4369 |
lemma removeAll_filter_not[simp]: |
|
4370 |
"\<not> P x \<Longrightarrow> removeAll x (filter P xs) = filter P xs" |
|
4371 |
by(induct xs) auto |
|
4372 |
||
34978
874150ddd50a
canonical insert operation; generalized lemma foldl_apply_inv to foldl_apply
haftmann
parents:
34942
diff
changeset
|
4373 |
lemma distinct_removeAll: |
874150ddd50a
canonical insert operation; generalized lemma foldl_apply_inv to foldl_apply
haftmann
parents:
34942
diff
changeset
|
4374 |
"distinct xs \<Longrightarrow> distinct (removeAll x xs)" |
58807 | 4375 |
by (simp add: removeAll_filter_not_eq) |
27693 | 4376 |
|
4377 |
lemma distinct_remove1_removeAll: |
|
67613 | 4378 |
"distinct xs \<Longrightarrow> remove1 x xs = removeAll x xs" |
27693 | 4379 |
by (induct xs) simp_all |
4380 |
||
4381 |
lemma map_removeAll_inj_on: "inj_on f (insert x (set xs)) \<Longrightarrow> |
|
4382 |
map f (removeAll x xs) = removeAll (f x) (map f xs)" |
|
4383 |
by (induct xs) (simp_all add:inj_on_def) |
|
4384 |
||
4385 |
lemma map_removeAll_inj: "inj f \<Longrightarrow> |
|
4386 |
map f (removeAll x xs) = removeAll (f x) (map f xs)" |
|
56085 | 4387 |
by (rule map_removeAll_inj_on, erule subset_inj_on, rule subset_UNIV) |
27693 | 4388 |
|
63365 | 4389 |
lemma length_removeAll_less_eq [simp]: |
4390 |
"length (removeAll x xs) \<le> length xs" |
|
4391 |
by (simp add: removeAll_filter_not_eq) |
|
4392 |
||
4393 |
lemma length_removeAll_less [termination_simp]: |
|
4394 |
"x \<in> set xs \<Longrightarrow> length (removeAll x xs) < length xs" |
|
4395 |
by (auto dest: length_filter_less simp add: removeAll_filter_not_eq) |
|
4396 |
||
71593 | 4397 |
lemma distinct_concat_iff: "distinct (concat xs) \<longleftrightarrow> |
4398 |
distinct (removeAll [] xs) \<and> |
|
4399 |
(\<forall>ys. ys \<in> set xs \<longrightarrow> distinct ys) \<and> |
|
4400 |
(\<forall>ys zs. ys \<in> set xs \<and> zs \<in> set xs \<and> ys \<noteq> zs \<longrightarrow> set ys \<inter> set zs = {})" |
|
4401 |
apply (induct xs) |
|
4402 |
apply(simp_all, safe, auto) |
|
4403 |
by (metis Int_iff UN_I empty_iff equals0I set_empty) |
|
4404 |
||
27693 | 4405 |
|
69593 | 4406 |
subsubsection \<open>\<^const>\<open>replicate\<close>\<close> |
13114 | 4407 |
|
13142 | 4408 |
lemma length_replicate [simp]: "length (replicate n x) = n" |
13145 | 4409 |
by (induct n) auto |
13124 | 4410 |
|
58437 | 4411 |
lemma replicate_eqI: |
4412 |
assumes "length xs = n" and "\<And>y. y \<in> set xs \<Longrightarrow> y = x" |
|
4413 |
shows "xs = replicate n x" |
|
67613 | 4414 |
using assms |
4415 |
proof (induct xs arbitrary: n) |
|
58437 | 4416 |
case Nil then show ?case by simp |
4417 |
next |
|
4418 |
case (Cons x xs) then show ?case by (cases n) simp_all |
|
4419 |
qed |
|
4420 |
||
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
|
4421 |
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
|
4422 |
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
|
4423 |
|
13142 | 4424 |
lemma map_replicate [simp]: "map f (replicate n x) = replicate n (f x)" |
13145 | 4425 |
by (induct n) auto |
13114 | 4426 |
|
31363
7493b571b37d
Added theorems about distinct & concat, map & replicate and concat & replicate
hoelzl
parents:
31264
diff
changeset
|
4427 |
lemma map_replicate_const: |
7493b571b37d
Added theorems about distinct & concat, map & replicate and concat & replicate
hoelzl
parents:
31264
diff
changeset
|
4428 |
"map (\<lambda> x. k) lst = replicate (length lst) k" |
66853 | 4429 |
by (induct lst) auto |
31363
7493b571b37d
Added theorems about distinct & concat, map & replicate and concat & replicate
hoelzl
parents:
31264
diff
changeset
|
4430 |
|
13114 | 4431 |
lemma replicate_app_Cons_same: |
13145 | 4432 |
"(replicate n x) @ (x # xs) = x # replicate n x @ xs" |
4433 |
by (induct n) auto |
|
13114 | 4434 |
|
13142 | 4435 |
lemma rev_replicate [simp]: "rev (replicate n x) = replicate n x" |
58807 | 4436 |
by (induct n) (auto simp: replicate_app_Cons_same) |
13114 | 4437 |
|
13142 | 4438 |
lemma replicate_add: "replicate (n + m) x = replicate n x @ replicate m x" |
13145 | 4439 |
by (induct n) auto |
13114 | 4440 |
|
60758 | 4441 |
text\<open>Courtesy of Matthias Daum:\<close> |
16397 | 4442 |
lemma append_replicate_commute: |
4443 |
"replicate n x @ replicate k x = replicate k x @ replicate n x" |
|
68719 | 4444 |
by (metis add.commute replicate_add) |
16397 | 4445 |
|
60758 | 4446 |
text\<open>Courtesy of Andreas Lochbihler:\<close> |
31080 | 4447 |
lemma filter_replicate: |
4448 |
"filter P (replicate n x) = (if P x then replicate n x else [])" |
|
4449 |
by(induct n) auto |
|
4450 |
||
71585 | 4451 |
lemma hd_replicate [simp]: "n \<noteq> 0 \<Longrightarrow> hd (replicate n x) = x" |
13145 | 4452 |
by (induct n) auto |
13114 | 4453 |
|
46500
0196966d6d2d
removing unnecessary premises in theorems of List theory
bulwahn
parents:
46448
diff
changeset
|
4454 |
lemma tl_replicate [simp]: "tl (replicate n x) = replicate (n - 1) x" |
13145 | 4455 |
by (induct n) auto |
13114 | 4456 |
|
71585 | 4457 |
lemma last_replicate [simp]: "n \<noteq> 0 \<Longrightarrow> last (replicate n x) = x" |
13145 | 4458 |
by (atomize (full), induct n) auto |
13114 | 4459 |
|
71585 | 4460 |
lemma nth_replicate[simp]: "i < n \<Longrightarrow> (replicate n x)!i = x" |
58807 | 4461 |
by (induct n arbitrary: i)(auto simp: nth_Cons split: nat.split) |
13114 | 4462 |
|
60758 | 4463 |
text\<open>Courtesy of Matthias Daum (2 lemmas):\<close> |
16397 | 4464 |
lemma take_replicate[simp]: "take i (replicate k x) = replicate (min i k) x" |
68719 | 4465 |
proof (cases "k \<le> i") |
4466 |
case True |
|
4467 |
then show ?thesis |
|
4468 |
by (simp add: min_def) |
|
4469 |
next |
|
4470 |
case False |
|
4471 |
then have "replicate k x = replicate i x @ replicate (k - i) x" |
|
4472 |
by (simp add: replicate_add [symmetric]) |
|
4473 |
then show ?thesis |
|
4474 |
by (simp add: min_def) |
|
4475 |
qed |
|
16397 | 4476 |
|
24526 | 4477 |
lemma drop_replicate[simp]: "drop i (replicate k x) = replicate (k-i) x" |
68719 | 4478 |
proof (induct k arbitrary: i) |
4479 |
case (Suc k) |
|
4480 |
then show ?case |
|
4481 |
by (simp add: drop_Cons') |
|
4482 |
qed simp |
|
16397 | 4483 |
|
13142 | 4484 |
lemma set_replicate_Suc: "set (replicate (Suc n) x) = {x}" |
13145 | 4485 |
by (induct n) auto |
13114 | 4486 |
|
71585 | 4487 |
lemma set_replicate [simp]: "n \<noteq> 0 \<Longrightarrow> set (replicate n x) = {x}" |
13145 | 4488 |
by (fast dest!: not0_implies_Suc intro!: set_replicate_Suc) |
13114 | 4489 |
|
13142 | 4490 |
lemma set_replicate_conv_if: "set (replicate n x) = (if n = 0 then {} else {x})" |
13145 | 4491 |
by auto |
13114 | 4492 |
|
67091 | 4493 |
lemma in_set_replicate[simp]: "(x \<in> set (replicate n y)) = (x = y \<and> n \<noteq> 0)" |
37456 | 4494 |
by (simp add: set_replicate_conv_if) |
4495 |
||
37454 | 4496 |
lemma Ball_set_replicate[simp]: |
67091 | 4497 |
"(\<forall>x \<in> set(replicate n a). P x) = (P a \<or> n=0)" |
37454 | 4498 |
by(simp add: set_replicate_conv_if) |
4499 |
||
4500 |
lemma Bex_set_replicate[simp]: |
|
67091 | 4501 |
"(\<exists>x \<in> set(replicate n a). P x) = (P a \<and> n\<noteq>0)" |
37454 | 4502 |
by(simp add: set_replicate_conv_if) |
13114 | 4503 |
|
24796 | 4504 |
lemma replicate_append_same: |
4505 |
"replicate i x @ [x] = x # replicate i x" |
|
4506 |
by (induct i) simp_all |
|
4507 |
||
4508 |
lemma map_replicate_trivial: |
|
4509 |
"map (\<lambda>i. x) [0..<i] = replicate i x" |
|
66853 | 4510 |
by (induct i) (simp_all add: replicate_append_same) |
24796 | 4511 |
|
31363
7493b571b37d
Added theorems about distinct & concat, map & replicate and concat & replicate
hoelzl
parents:
31264
diff
changeset
|
4512 |
lemma concat_replicate_trivial[simp]: |
7493b571b37d
Added theorems about distinct & concat, map & replicate and concat & replicate
hoelzl
parents:
31264
diff
changeset
|
4513 |
"concat (replicate i []) = []" |
7493b571b37d
Added theorems about distinct & concat, map & replicate and concat & replicate
hoelzl
parents:
31264
diff
changeset
|
4514 |
by (induct i) (auto simp add: map_replicate_const) |
13114 | 4515 |
|
28642 | 4516 |
lemma replicate_empty[simp]: "(replicate n x = []) \<longleftrightarrow> n=0" |
4517 |
by (induct n) auto |
|
4518 |
||
4519 |
lemma empty_replicate[simp]: "([] = replicate n x) \<longleftrightarrow> n=0" |
|
4520 |
by (induct n) auto |
|
4521 |
||
4522 |
lemma replicate_eq_replicate[simp]: |
|
67091 | 4523 |
"(replicate m x = replicate n y) \<longleftrightarrow> (m=n \<and> (m\<noteq>0 \<longrightarrow> x=y))" |
68719 | 4524 |
proof (induct m arbitrary: n) |
4525 |
case (Suc m n) |
|
4526 |
then show ?case |
|
4527 |
by (induct n) auto |
|
4528 |
qed simp |
|
28642 | 4529 |
|
71778 | 4530 |
lemma takeWhile_replicate[simp]: |
4531 |
"takeWhile P (replicate n x) = (if P x then replicate n x else [])" |
|
4532 |
using takeWhile_eq_Nil_iff by fastforce |
|
4533 |
||
4534 |
lemma dropWhile_replicate[simp]: |
|
4535 |
"dropWhile P (replicate n x) = (if P x then [] else replicate n x)" |
|
4536 |
using dropWhile_eq_self_iff by fastforce |
|
4537 |
||
39534
c798d4f1b682
generalized lemma insort_remove1 to insort_key_remove1
haftmann
parents:
39302
diff
changeset
|
4538 |
lemma replicate_length_filter: |
c798d4f1b682
generalized lemma insort_remove1 to insort_key_remove1
haftmann
parents:
39302
diff
changeset
|
4539 |
"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
|
4540 |
by (induct xs) auto |
c798d4f1b682
generalized lemma insort_remove1 to insort_key_remove1
haftmann
parents:
39302
diff
changeset
|
4541 |
|
42714
fcba668b0839
add a lemma about commutative append to List.thy
noschinl
parents:
42713
diff
changeset
|
4542 |
lemma comm_append_are_replicate: |
66853 | 4543 |
"\<lbrakk> xs \<noteq> []; ys \<noteq> []; xs @ ys = ys @ xs \<rbrakk> |
4544 |
\<Longrightarrow> \<exists>m n zs. concat (replicate m zs) = xs \<and> concat (replicate n zs) = ys" |
|
4545 |
proof (induction "length (xs @ ys)" arbitrary: xs ys rule: less_induct) |
|
42714
fcba668b0839
add a lemma about commutative append to List.thy
noschinl
parents:
42713
diff
changeset
|
4546 |
case less |
fcba668b0839
add a lemma about commutative append to List.thy
noschinl
parents:
42713
diff
changeset
|
4547 |
|
63040 | 4548 |
define xs' ys' where "xs' = (if (length xs \<le> length ys) then xs else ys)" |
4549 |
and "ys' = (if (length xs \<le> length ys) then ys else xs)" |
|
42714
fcba668b0839
add a lemma about commutative append to List.thy
noschinl
parents:
42713
diff
changeset
|
4550 |
then have |
fcba668b0839
add a lemma about commutative append to List.thy
noschinl
parents:
42713
diff
changeset
|
4551 |
prems': "length xs' \<le> length ys'" |
fcba668b0839
add a lemma about commutative append to List.thy
noschinl
parents:
42713
diff
changeset
|
4552 |
"xs' @ ys' = ys' @ xs'" |
fcba668b0839
add a lemma about commutative append to List.thy
noschinl
parents:
42713
diff
changeset
|
4553 |
and "xs' \<noteq> []" |
fcba668b0839
add a lemma about commutative append to List.thy
noschinl
parents:
42713
diff
changeset
|
4554 |
and len: "length (xs @ ys) = length (xs' @ ys')" |
fcba668b0839
add a lemma about commutative append to List.thy
noschinl
parents:
42713
diff
changeset
|
4555 |
using less by (auto intro: less.hyps) |
fcba668b0839
add a lemma about commutative append to List.thy
noschinl
parents:
42713
diff
changeset
|
4556 |
|
fcba668b0839
add a lemma about commutative append to List.thy
noschinl
parents:
42713
diff
changeset
|
4557 |
from prems' |
fcba668b0839
add a lemma about commutative append to List.thy
noschinl
parents:
42713
diff
changeset
|
4558 |
obtain ws where "ys' = xs' @ ws" |
fcba668b0839
add a lemma about commutative append to List.thy
noschinl
parents:
42713
diff
changeset
|
4559 |
by (auto simp: append_eq_append_conv2) |
fcba668b0839
add a lemma about commutative append to List.thy
noschinl
parents:
42713
diff
changeset
|
4560 |
|
fcba668b0839
add a lemma about commutative append to List.thy
noschinl
parents:
42713
diff
changeset
|
4561 |
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
|
4562 |
proof (cases "ws = []") |
fcba668b0839
add a lemma about commutative append to List.thy
noschinl
parents:
42713
diff
changeset
|
4563 |
case True |
fcba668b0839
add a lemma about commutative append to List.thy
noschinl
parents:
42713
diff
changeset
|
4564 |
then have "concat (replicate 1 xs') = xs'" |
fcba668b0839
add a lemma about commutative append to List.thy
noschinl
parents:
42713
diff
changeset
|
4565 |
and "concat (replicate 1 xs') = ys'" |
60758 | 4566 |
using \<open>ys' = xs' @ ws\<close> by auto |
42714
fcba668b0839
add a lemma about commutative append to List.thy
noschinl
parents:
42713
diff
changeset
|
4567 |
then show ?thesis by blast |
fcba668b0839
add a lemma about commutative append to List.thy
noschinl
parents:
42713
diff
changeset
|
4568 |
next |
fcba668b0839
add a lemma about commutative append to List.thy
noschinl
parents:
42713
diff
changeset
|
4569 |
case False |
60758 | 4570 |
from \<open>ys' = xs' @ ws\<close> and \<open>xs' @ ys' = ys' @ xs'\<close> |
42714
fcba668b0839
add a lemma about commutative append to List.thy
noschinl
parents:
42713
diff
changeset
|
4571 |
have "xs' @ ws = ws @ xs'" by simp |
fcba668b0839
add a lemma about commutative append to List.thy
noschinl
parents:
42713
diff
changeset
|
4572 |
then have "\<exists>m n zs. concat (replicate m zs) = xs' \<and> concat (replicate n zs) = ws" |
60758 | 4573 |
using False and \<open>xs' \<noteq> []\<close> and \<open>ys' = xs' @ ws\<close> and len |
42714
fcba668b0839
add a lemma about commutative append to List.thy
noschinl
parents:
42713
diff
changeset
|
4574 |
by (intro less.hyps) auto |
53374
a14d2a854c02
tuned proofs -- clarified flow of facts wrt. calculation;
wenzelm
parents:
53017
diff
changeset
|
4575 |
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
|
4576 |
and "concat (replicate n zs) = ws" by blast |
fcba668b0839
add a lemma about commutative append to List.thy
noschinl
parents:
42713
diff
changeset
|
4577 |
then have "concat (replicate (m + n) zs) = ys'" |
60758 | 4578 |
using \<open>ys' = xs' @ ws\<close> |
42714
fcba668b0839
add a lemma about commutative append to List.thy
noschinl
parents:
42713
diff
changeset
|
4579 |
by (simp add: replicate_add) |
53374
a14d2a854c02
tuned proofs -- clarified flow of facts wrt. calculation;
wenzelm
parents:
53017
diff
changeset
|
4580 |
with * show ?thesis by blast |
42714
fcba668b0839
add a lemma about commutative append to List.thy
noschinl
parents:
42713
diff
changeset
|
4581 |
qed |
fcba668b0839
add a lemma about commutative append to List.thy
noschinl
parents:
42713
diff
changeset
|
4582 |
then show ?case |
56085 | 4583 |
using xs'_def ys'_def by meson |
42714
fcba668b0839
add a lemma about commutative append to List.thy
noschinl
parents:
42713
diff
changeset
|
4584 |
qed |
fcba668b0839
add a lemma about commutative append to List.thy
noschinl
parents:
42713
diff
changeset
|
4585 |
|
fcba668b0839
add a lemma about commutative append to List.thy
noschinl
parents:
42713
diff
changeset
|
4586 |
lemma comm_append_is_replicate: |
fcba668b0839
add a lemma about commutative append to List.thy
noschinl
parents:
42713
diff
changeset
|
4587 |
fixes xs ys :: "'a list" |
fcba668b0839
add a lemma about commutative append to List.thy
noschinl
parents:
42713
diff
changeset
|
4588 |
assumes "xs \<noteq> []" "ys \<noteq> []" |
fcba668b0839
add a lemma about commutative append to List.thy
noschinl
parents:
42713
diff
changeset
|
4589 |
assumes "xs @ ys = ys @ xs" |
fcba668b0839
add a lemma about commutative append to List.thy
noschinl
parents:
42713
diff
changeset
|
4590 |
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
|
4591 |
proof - |
fcba668b0839
add a lemma about commutative append to List.thy
noschinl
parents:
42713
diff
changeset
|
4592 |
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
|
4593 |
and "concat (replicate n zs) = ys" |
56085 | 4594 |
using comm_append_are_replicate[of xs ys, OF assms] by blast |
42714
fcba668b0839
add a lemma about commutative append to List.thy
noschinl
parents:
42713
diff
changeset
|
4595 |
then have "m + n > 1" and "concat (replicate (m+n) zs) = xs @ ys" |
60758 | 4596 |
using \<open>xs \<noteq> []\<close> and \<open>ys \<noteq> []\<close> |
42714
fcba668b0839
add a lemma about commutative append to List.thy
noschinl
parents:
42713
diff
changeset
|
4597 |
by (auto simp: replicate_add) |
fcba668b0839
add a lemma about commutative append to List.thy
noschinl
parents:
42713
diff
changeset
|
4598 |
then show ?thesis by blast |
fcba668b0839
add a lemma about commutative append to List.thy
noschinl
parents:
42713
diff
changeset
|
4599 |
qed |
fcba668b0839
add a lemma about commutative append to List.thy
noschinl
parents:
42713
diff
changeset
|
4600 |
|
52380 | 4601 |
lemma Cons_replicate_eq: |
4602 |
"x # xs = replicate n y \<longleftrightarrow> x = y \<and> n > 0 \<and> xs = replicate (n - 1) x" |
|
66853 | 4603 |
by (induct n) auto |
52380 | 4604 |
|
4605 |
lemma replicate_length_same: |
|
4606 |
"(\<forall>y\<in>set xs. y = x) \<Longrightarrow> replicate (length xs) x = xs" |
|
66853 | 4607 |
by (induct xs) simp_all |
52380 | 4608 |
|
4609 |
lemma foldr_replicate [simp]: |
|
4610 |
"foldr f (replicate n x) = f x ^^ n" |
|
66853 | 4611 |
by (induct n) (simp_all) |
52380 | 4612 |
|
4613 |
lemma fold_replicate [simp]: |
|
4614 |
"fold f (replicate n x) = f x ^^ n" |
|
66853 | 4615 |
by (subst foldr_fold [symmetric]) simp_all |
52380 | 4616 |
|
28642 | 4617 |
|
69593 | 4618 |
subsubsection \<open>\<^const>\<open>enumerate\<close>\<close> |
51173 | 4619 |
|
4620 |
lemma enumerate_simps [simp, code]: |
|
4621 |
"enumerate n [] = []" |
|
4622 |
"enumerate n (x # xs) = (n, x) # enumerate (Suc n) xs" |
|
68719 | 4623 |
by (simp_all add: enumerate_eq_zip upt_rec) |
51173 | 4624 |
|
4625 |
lemma length_enumerate [simp]: |
|
4626 |
"length (enumerate n xs) = length xs" |
|
66853 | 4627 |
by (simp add: enumerate_eq_zip) |
51173 | 4628 |
|
4629 |
lemma map_fst_enumerate [simp]: |
|
4630 |
"map fst (enumerate n xs) = [n..<n + length xs]" |
|
66853 | 4631 |
by (simp add: enumerate_eq_zip) |
51173 | 4632 |
|
4633 |
lemma map_snd_enumerate [simp]: |
|
4634 |
"map snd (enumerate n xs) = xs" |
|
66853 | 4635 |
by (simp add: enumerate_eq_zip) |
64963 | 4636 |
|
51173 | 4637 |
lemma in_set_enumerate_eq: |
4638 |
"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" |
|
4639 |
proof - |
|
4640 |
{ fix m |
|
4641 |
assume "n \<le> m" |
|
4642 |
moreover assume "m < length xs + n" |
|
4643 |
ultimately have "[n..<n + length xs] ! (m - n) = m \<and> |
|
4644 |
xs ! (m - n) = xs ! (m - n) \<and> m - n < length xs" by auto |
|
4645 |
then have "\<exists>q. [n..<n + length xs] ! q = m \<and> |
|
4646 |
xs ! q = xs ! (m - n) \<and> q < length xs" .. |
|
4647 |
} then show ?thesis by (cases p) (auto simp add: enumerate_eq_zip in_set_zip) |
|
4648 |
qed |
|
4649 |
||
66853 | 4650 |
lemma nth_enumerate_eq: "m < length xs \<Longrightarrow> enumerate n xs ! m = (n + m, xs ! m)" |
4651 |
by (simp add: enumerate_eq_zip) |
|
51173 | 4652 |
|
4653 |
lemma enumerate_replicate_eq: |
|
4654 |
"enumerate n (replicate m a) = map (\<lambda>q. (q, a)) [n..<n + m]" |
|
66853 | 4655 |
by (rule pair_list_eqI) |
4656 |
(simp_all add: enumerate_eq_zip comp_def map_replicate_const) |
|
51173 | 4657 |
|
4658 |
lemma enumerate_Suc_eq: |
|
4659 |
"enumerate (Suc n) xs = map (apfst Suc) (enumerate n xs)" |
|
66853 | 4660 |
by (rule pair_list_eqI) |
4661 |
(simp_all add: not_le, simp del: map_map add: map_Suc_upt map_map [symmetric]) |
|
51173 | 4662 |
|
52379 | 4663 |
lemma distinct_enumerate [simp]: |
4664 |
"distinct (enumerate n xs)" |
|
66853 | 4665 |
by (simp add: enumerate_eq_zip distinct_zipI1) |
52379 | 4666 |
|
58437 | 4667 |
lemma enumerate_append_eq: |
4668 |
"enumerate n (xs @ ys) = enumerate n xs @ enumerate (n + length xs) ys" |
|
68719 | 4669 |
by (simp add: enumerate_eq_zip add.assoc zip_append2) |
58437 | 4670 |
|
4671 |
lemma enumerate_map_upt: |
|
4672 |
"enumerate n (map f [n..<m]) = map (\<lambda>k. (k, f k)) [n..<m]" |
|
66853 | 4673 |
by (cases "n \<le> m") (simp_all add: zip_map2 zip_same_conv_map enumerate_eq_zip) |
64963 | 4674 |
|
51173 | 4675 |
|
69593 | 4676 |
subsubsection \<open>\<^const>\<open>rotate1\<close> and \<^const>\<open>rotate\<close>\<close> |
15302 | 4677 |
|
4678 |
lemma rotate0[simp]: "rotate 0 = id" |
|
4679 |
by(simp add:rotate_def) |
|
4680 |
||
4681 |
lemma rotate_Suc[simp]: "rotate (Suc n) xs = rotate1(rotate n xs)" |
|
4682 |
by(simp add:rotate_def) |
|
4683 |
||
4684 |
lemma rotate_add: |
|
67091 | 4685 |
"rotate (m+n) = rotate m \<circ> rotate n" |
15302 | 4686 |
by(simp add:rotate_def funpow_add) |
4687 |
||
4688 |
lemma rotate_rotate: "rotate m (rotate n xs) = rotate (m+n) xs" |
|
4689 |
by(simp add:rotate_add) |
|
4690 |
||
71393
fce780f9c9c6
new examples of BNF lifting across quotients using a new theory of confluence,
traytel
parents:
70911
diff
changeset
|
4691 |
lemma rotate1_map: "rotate1 (map f xs) = map f (rotate1 xs)" |
fce780f9c9c6
new examples of BNF lifting across quotients using a new theory of confluence,
traytel
parents:
70911
diff
changeset
|
4692 |
by(cases xs) simp_all |
fce780f9c9c6
new examples of BNF lifting across quotients using a new theory of confluence,
traytel
parents:
70911
diff
changeset
|
4693 |
|
18049 | 4694 |
lemma rotate1_rotate_swap: "rotate1 (rotate n xs) = rotate n (rotate1 xs)" |
4695 |
by(simp add:rotate_def funpow_swap1) |
|
4696 |
||
68709 | 4697 |
lemma rotate1_length01[simp]: "length xs \<le> 1 \<Longrightarrow> rotate1 xs = xs" |
15302 | 4698 |
by(cases xs) simp_all |
4699 |
||
68709 | 4700 |
lemma rotate_length01[simp]: "length xs \<le> 1 \<Longrightarrow> rotate n xs = xs" |
68719 | 4701 |
by (induct n) (simp_all add:rotate_def) |
13114 | 4702 |
|
15302 | 4703 |
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
|
4704 |
by (cases xs) simp_all |
15302 | 4705 |
|
4706 |
lemma rotate_drop_take: |
|
4707 |
"rotate n xs = drop (n mod length xs) xs @ take (n mod length xs) xs" |
|
68719 | 4708 |
proof (induct n) |
4709 |
case (Suc n) |
|
4710 |
show ?case |
|
4711 |
proof (cases "xs = []") |
|
4712 |
case False |
|
4713 |
then show ?thesis |
|
4714 |
proof (cases "n mod length xs = 0") |
|
4715 |
case True |
|
4716 |
then show ?thesis |
|
71585 | 4717 |
by (auto simp add: mod_Suc False Suc.hyps drop_Suc rotate1_hd_tl take_Suc Suc_length_conv) |
68719 | 4718 |
next |
4719 |
case False |
|
4720 |
with \<open>xs \<noteq> []\<close> Suc |
|
4721 |
show ?thesis |
|
4722 |
by (simp add: rotate_def mod_Suc rotate1_hd_tl drop_Suc[symmetric] drop_tl[symmetric] |
|
4723 |
take_hd_drop linorder_not_le) |
|
4724 |
qed |
|
4725 |
qed simp |
|
4726 |
qed simp |
|
13114 | 4727 |
|
15302 | 4728 |
lemma rotate_conv_mod: "rotate n xs = rotate (n mod length xs) xs" |
71585 | 4729 |
by(simp add:rotate_drop_take) |
15302 | 4730 |
|
4731 |
lemma rotate_id[simp]: "n mod length xs = 0 \<Longrightarrow> rotate n xs = xs" |
|
71585 | 4732 |
by(simp add:rotate_drop_take) |
15302 | 4733 |
|
4734 |
lemma length_rotate1[simp]: "length(rotate1 xs) = length xs" |
|
71585 | 4735 |
by (cases xs) simp_all |
15302 | 4736 |
|
24526 | 4737 |
lemma length_rotate[simp]: "length(rotate n xs) = length xs" |
71585 | 4738 |
by (induct n arbitrary: xs) (simp_all add:rotate_def) |
15302 | 4739 |
|
4740 |
lemma distinct1_rotate[simp]: "distinct(rotate1 xs) = distinct xs" |
|
71585 | 4741 |
by (cases xs) auto |
15302 | 4742 |
|
4743 |
lemma distinct_rotate[simp]: "distinct(rotate n xs) = distinct xs" |
|
71585 | 4744 |
by (induct n) (simp_all add:rotate_def) |
15302 | 4745 |
|
4746 |
lemma rotate_map: "rotate n (map f xs) = map f (rotate n xs)" |
|
71585 | 4747 |
by(simp add:rotate_drop_take take_map drop_map) |
15302 | 4748 |
|
4749 |
lemma set_rotate1[simp]: "set(rotate1 xs) = set xs" |
|
71585 | 4750 |
by (cases xs) auto |
15302 | 4751 |
|
4752 |
lemma set_rotate[simp]: "set(rotate n xs) = set xs" |
|
71585 | 4753 |
by (induct n) (simp_all add:rotate_def) |
15302 | 4754 |
|
4755 |
lemma rotate1_is_Nil_conv[simp]: "(rotate1 xs = []) = (xs = [])" |
|
71585 | 4756 |
by (cases xs) auto |
15302 | 4757 |
|
4758 |
lemma rotate_is_Nil_conv[simp]: "(rotate n xs = []) = (xs = [])" |
|
71585 | 4759 |
by (induct n) (simp_all add:rotate_def) |
13114 | 4760 |
|
15439 | 4761 |
lemma rotate_rev: |
4762 |
"rotate n (rev xs) = rev(rotate (length xs - (n mod length xs)) xs)" |
|
68527
2f4e2aab190a
Generalising and renaming some basic results
paulson <lp15@cam.ac.uk>
parents:
68362
diff
changeset
|
4763 |
proof (cases "length xs = 0 \<or> n mod length xs = 0") |
2f4e2aab190a
Generalising and renaming some basic results
paulson <lp15@cam.ac.uk>
parents:
68362
diff
changeset
|
4764 |
case False |
2f4e2aab190a
Generalising and renaming some basic results
paulson <lp15@cam.ac.uk>
parents:
68362
diff
changeset
|
4765 |
then show ?thesis |
2f4e2aab190a
Generalising and renaming some basic results
paulson <lp15@cam.ac.uk>
parents:
68362
diff
changeset
|
4766 |
by(simp add:rotate_drop_take rev_drop rev_take) |
2f4e2aab190a
Generalising and renaming some basic results
paulson <lp15@cam.ac.uk>
parents:
68362
diff
changeset
|
4767 |
qed force |
15439 | 4768 |
|
68719 | 4769 |
lemma hd_rotate_conv_nth: |
4770 |
assumes "xs \<noteq> []" shows "hd(rotate n xs) = xs!(n mod length xs)" |
|
4771 |
proof - |
|
4772 |
have "n mod length xs < length xs" |
|
4773 |
using assms by simp |
|
4774 |
then show ?thesis |
|
4775 |
by (metis drop_eq_Nil hd_append2 hd_drop_conv_nth leD rotate_drop_take) |
|
4776 |
qed |
|
18423 | 4777 |
|
68527
2f4e2aab190a
Generalising and renaming some basic results
paulson <lp15@cam.ac.uk>
parents:
68362
diff
changeset
|
4778 |
lemma rotate_append: "rotate (length l) (l @ q) = q @ l" |
2f4e2aab190a
Generalising and renaming some basic results
paulson <lp15@cam.ac.uk>
parents:
68362
diff
changeset
|
4779 |
by (induct l arbitrary: q) (auto simp add: rotate1_rotate_swap) |
2f4e2aab190a
Generalising and renaming some basic results
paulson <lp15@cam.ac.uk>
parents:
68362
diff
changeset
|
4780 |
|
71991 | 4781 |
lemma nth_rotate: |
4782 |
\<open>rotate m xs ! n = xs ! ((m + n) mod length xs)\<close> if \<open>n < length xs\<close> |
|
4783 |
using that apply (auto simp add: rotate_drop_take nth_append not_less less_diff_conv ac_simps dest!: le_Suc_ex) |
|
4784 |
apply (metis add.commute mod_add_right_eq mod_less) |
|
4785 |
apply (metis (no_types, lifting) Nat.diff_diff_right add.commute add_diff_cancel_right' diff_le_self dual_order.strict_trans2 length_greater_0_conv less_nat_zero_code list.size(3) mod_add_right_eq mod_add_self2 mod_le_divisor mod_less) |
|
4786 |
done |
|
4787 |
||
4788 |
lemma nth_rotate1: |
|
4789 |
\<open>rotate1 xs ! n = xs ! (Suc n mod length xs)\<close> if \<open>n < length xs\<close> |
|
4790 |
using that nth_rotate [of n xs 1] by simp |
|
4791 |
||
13114 | 4792 |
|
69593 | 4793 |
subsubsection \<open>\<^const>\<open>nths\<close> --- a generalization of \<^const>\<open>nth\<close> to sets\<close> |
65956
639eb3617a86
reorganised material on sublists
eberlm <eberlm@in.tum.de>
parents:
65350
diff
changeset
|
4794 |
|
639eb3617a86
reorganised material on sublists
eberlm <eberlm@in.tum.de>
parents:
65350
diff
changeset
|
4795 |
lemma nths_empty [simp]: "nths xs {} = []" |
71585 | 4796 |
by (auto simp add: nths_def) |
65956
639eb3617a86
reorganised material on sublists
eberlm <eberlm@in.tum.de>
parents:
65350
diff
changeset
|
4797 |
|
639eb3617a86
reorganised material on sublists
eberlm <eberlm@in.tum.de>
parents:
65350
diff
changeset
|
4798 |
lemma nths_nil [simp]: "nths [] A = []" |
71585 | 4799 |
by (auto simp add: nths_def) |
65956
639eb3617a86
reorganised material on sublists
eberlm <eberlm@in.tum.de>
parents:
65350
diff
changeset
|
4800 |
|
69203 | 4801 |
lemma nths_all: "\<forall>i < length xs. i \<in> I \<Longrightarrow> nths xs I = xs" |
4802 |
apply (simp add: nths_def) |
|
4803 |
apply (subst filter_True) |
|
71585 | 4804 |
apply (auto simp: in_set_zip subset_iff) |
69203 | 4805 |
done |
4806 |
||
65956
639eb3617a86
reorganised material on sublists
eberlm <eberlm@in.tum.de>
parents:
65350
diff
changeset
|
4807 |
lemma length_nths: |
67613 | 4808 |
"length (nths xs I) = card{i. i < length xs \<and> i \<in> I}" |
71585 | 4809 |
by(simp add: nths_def length_filter_conv_card cong:conj_cong) |
65956
639eb3617a86
reorganised material on sublists
eberlm <eberlm@in.tum.de>
parents:
65350
diff
changeset
|
4810 |
|
639eb3617a86
reorganised material on sublists
eberlm <eberlm@in.tum.de>
parents:
65350
diff
changeset
|
4811 |
lemma nths_shift_lemma_Suc: |
68719 | 4812 |
"map fst (filter (\<lambda>p. P(Suc(snd p))) (zip xs is)) = |
4813 |
map fst (filter (\<lambda>p. P(snd p)) (zip xs (map Suc is)))" |
|
4814 |
proof (induct xs arbitrary: "is") |
|
4815 |
case (Cons x xs "is") |
|
4816 |
show ?case |
|
4817 |
by (cases "is") (auto simp add: Cons.hyps) |
|
4818 |
qed simp |
|
15281 | 4819 |
|
65956
639eb3617a86
reorganised material on sublists
eberlm <eberlm@in.tum.de>
parents:
65350
diff
changeset
|
4820 |
lemma nths_shift_lemma: |
68249
949d93804740
First step to remove nonstandard "[x <- xs. P]" syntax: only input
nipkow
parents:
68215
diff
changeset
|
4821 |
"map fst (filter (\<lambda>p. snd p \<in> A) (zip xs [i..<i + length xs])) = |
949d93804740
First step to remove nonstandard "[x <- xs. P]" syntax: only input
nipkow
parents:
68215
diff
changeset
|
4822 |
map fst (filter (\<lambda>p. snd p + i \<in> A) (zip xs [0..<length xs]))" |
57512
cc97b347b301
reduced name variants for assoc and commute on plus and mult
haftmann
parents:
57418
diff
changeset
|
4823 |
by (induct xs rule: rev_induct) (simp_all add: add.commute) |
13114 | 4824 |
|
65956
639eb3617a86
reorganised material on sublists
eberlm <eberlm@in.tum.de>
parents:
65350
diff
changeset
|
4825 |
lemma nths_append: |
67613 | 4826 |
"nths (l @ l') A = nths l A @ nths l' {j. j + length l \<in> A}" |
68719 | 4827 |
unfolding nths_def |
4828 |
proof (induct l' rule: rev_induct) |
|
4829 |
case (snoc x xs) |
|
4830 |
then show ?case |
|
4831 |
by (simp add: upt_add_eq_append[of 0] nths_shift_lemma add.commute) |
|
4832 |
qed auto |
|
13114 | 4833 |
|
65956
639eb3617a86
reorganised material on sublists
eberlm <eberlm@in.tum.de>
parents:
65350
diff
changeset
|
4834 |
lemma nths_Cons: |
67613 | 4835 |
"nths (x # l) A = (if 0 \<in> A then [x] else []) @ nths l {j. Suc j \<in> A}" |
68719 | 4836 |
proof (induct l rule: rev_induct) |
4837 |
case (snoc x xs) |
|
4838 |
then show ?case |
|
4839 |
by (simp flip: append_Cons add: nths_append) |
|
4840 |
qed (auto simp: nths_def) |
|
13114 | 4841 |
|
66853 | 4842 |
lemma nths_map: "nths (map f xs) I = map f (nths xs I)" |
71585 | 4843 |
by(induction xs arbitrary: I) (simp_all add: nths_Cons) |
66853 | 4844 |
|
65956
639eb3617a86
reorganised material on sublists
eberlm <eberlm@in.tum.de>
parents:
65350
diff
changeset
|
4845 |
lemma set_nths: "set(nths xs I) = {xs!i|i. i<size xs \<and> i \<in> I}" |
71585 | 4846 |
by (induct xs arbitrary: I) (auto simp: nths_Cons nth_Cons split:nat.split dest!: gr0_implies_Suc) |
15281 | 4847 |
|
65956
639eb3617a86
reorganised material on sublists
eberlm <eberlm@in.tum.de>
parents:
65350
diff
changeset
|
4848 |
lemma set_nths_subset: "set(nths xs I) \<subseteq> set xs" |
71585 | 4849 |
by(auto simp add:set_nths) |
65956
639eb3617a86
reorganised material on sublists
eberlm <eberlm@in.tum.de>
parents:
65350
diff
changeset
|
4850 |
|
639eb3617a86
reorganised material on sublists
eberlm <eberlm@in.tum.de>
parents:
65350
diff
changeset
|
4851 |
lemma notin_set_nthsI[simp]: "x \<notin> set xs \<Longrightarrow> x \<notin> set(nths xs I)" |
71585 | 4852 |
by(auto simp add:set_nths) |
65956
639eb3617a86
reorganised material on sublists
eberlm <eberlm@in.tum.de>
parents:
65350
diff
changeset
|
4853 |
|
639eb3617a86
reorganised material on sublists
eberlm <eberlm@in.tum.de>
parents:
65350
diff
changeset
|
4854 |
lemma in_set_nthsD: "x \<in> set(nths xs I) \<Longrightarrow> x \<in> set xs" |
71585 | 4855 |
by(auto simp add:set_nths) |
65956
639eb3617a86
reorganised material on sublists
eberlm <eberlm@in.tum.de>
parents:
65350
diff
changeset
|
4856 |
|
67613 | 4857 |
lemma nths_singleton [simp]: "nths [x] A = (if 0 \<in> A then [x] else [])" |
71585 | 4858 |
by (simp add: nths_Cons) |
65956
639eb3617a86
reorganised material on sublists
eberlm <eberlm@in.tum.de>
parents:
65350
diff
changeset
|
4859 |
|
639eb3617a86
reorganised material on sublists
eberlm <eberlm@in.tum.de>
parents:
65350
diff
changeset
|
4860 |
lemma distinct_nthsI[simp]: "distinct xs \<Longrightarrow> distinct (nths xs I)" |
71585 | 4861 |
by (induct xs arbitrary: I) (auto simp: nths_Cons) |
65956
639eb3617a86
reorganised material on sublists
eberlm <eberlm@in.tum.de>
parents:
65350
diff
changeset
|
4862 |
|
639eb3617a86
reorganised material on sublists
eberlm <eberlm@in.tum.de>
parents:
65350
diff
changeset
|
4863 |
lemma nths_upt_eq_take [simp]: "nths l {..<n} = take n l" |
71585 | 4864 |
by (induct l rule: rev_induct) (simp_all split: nat_diff_split add: nths_append) |
66656 | 4865 |
|
69203 | 4866 |
lemma nths_nths: "nths (nths xs A) B = nths xs {i \<in> A. \<exists>j \<in> B. card {i' \<in> A. i' < i} = j}" |
71585 | 4867 |
by (induction xs arbitrary: A B) (auto simp add: nths_Cons card_less_Suc card_less_Suc2) |
69203 | 4868 |
|
4869 |
lemma drop_eq_nths: "drop n xs = nths xs {i. i \<ge> n}" |
|
71585 | 4870 |
by (induction xs arbitrary: n) (auto simp add: nths_Cons nths_all drop_Cons' intro: arg_cong2[where f=nths, OF refl]) |
69203 | 4871 |
|
4872 |
lemma nths_drop: "nths (drop n xs) I = nths xs ((+) n ` I)" |
|
4873 |
by(force simp: drop_eq_nths nths_nths simp flip: atLeastLessThan_iff |
|
4874 |
intro: arg_cong2[where f=nths, OF refl]) |
|
4875 |
||
66656 | 4876 |
lemma filter_eq_nths: "filter P xs = nths xs {i. i<length xs \<and> P(xs!i)}" |
71585 | 4877 |
by(induction xs) (auto simp: nths_Cons) |
65956
639eb3617a86
reorganised material on sublists
eberlm <eberlm@in.tum.de>
parents:
65350
diff
changeset
|
4878 |
|
639eb3617a86
reorganised material on sublists
eberlm <eberlm@in.tum.de>
parents:
65350
diff
changeset
|
4879 |
lemma filter_in_nths: |
66656 | 4880 |
"distinct xs \<Longrightarrow> filter (%x. x \<in> set (nths xs s)) xs = nths xs s" |
24526 | 4881 |
proof (induct xs arbitrary: s) |
17501 | 4882 |
case Nil thus ?case by simp |
4883 |
next |
|
4884 |
case (Cons a xs) |
|
67091 | 4885 |
then have "\<forall>x. x \<in> set xs \<longrightarrow> x \<noteq> a" by auto |
65956
639eb3617a86
reorganised material on sublists
eberlm <eberlm@in.tum.de>
parents:
65350
diff
changeset
|
4886 |
with Cons show ?case by(simp add: nths_Cons cong:filter_cong) |
17501 | 4887 |
qed |
4888 |
||
13114 | 4889 |
|
69593 | 4890 |
subsubsection \<open>\<^const>\<open>subseqs\<close> and \<^const>\<open>List.n_lists\<close>\<close> |
65956
639eb3617a86
reorganised material on sublists
eberlm <eberlm@in.tum.de>
parents:
65350
diff
changeset
|
4891 |
|
639eb3617a86
reorganised material on sublists
eberlm <eberlm@in.tum.de>
parents:
65350
diff
changeset
|
4892 |
lemma length_subseqs: "length (subseqs xs) = 2 ^ length xs" |
49948
744934b818c7
moved quite generic material from theory Enum to more appropriate places
haftmann
parents:
49808
diff
changeset
|
4893 |
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
|
4894 |
|
65956
639eb3617a86
reorganised material on sublists
eberlm <eberlm@in.tum.de>
parents:
65350
diff
changeset
|
4895 |
lemma subseqs_powset: "set ` set (subseqs xs) = Pow (set xs)" |
49948
744934b818c7
moved quite generic material from theory Enum to more appropriate places
haftmann
parents:
49808
diff
changeset
|
4896 |
proof - |
744934b818c7
moved quite generic material from theory Enum to more appropriate places
haftmann
parents:
49808
diff
changeset
|
4897 |
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
|
4898 |
by (auto simp add: image_def) |
65956
639eb3617a86
reorganised material on sublists
eberlm <eberlm@in.tum.de>
parents:
65350
diff
changeset
|
4899 |
have "set (map set (subseqs xs)) = Pow (set xs)" |
64963 | 4900 |
by (induct xs) (simp_all add: aux Let_def Pow_insert Un_commute comp_def del: map_map) |
49948
744934b818c7
moved quite generic material from theory Enum to more appropriate places
haftmann
parents:
49808
diff
changeset
|
4901 |
then show ?thesis by simp |
744934b818c7
moved quite generic material from theory Enum to more appropriate places
haftmann
parents:
49808
diff
changeset
|
4902 |
qed |
744934b818c7
moved quite generic material from theory Enum to more appropriate places
haftmann
parents:
49808
diff
changeset
|
4903 |
|
65956
639eb3617a86
reorganised material on sublists
eberlm <eberlm@in.tum.de>
parents:
65350
diff
changeset
|
4904 |
lemma distinct_set_subseqs: |
49948
744934b818c7
moved quite generic material from theory Enum to more appropriate places
haftmann
parents:
49808
diff
changeset
|
4905 |
assumes "distinct xs" |
65956
639eb3617a86
reorganised material on sublists
eberlm <eberlm@in.tum.de>
parents:
65350
diff
changeset
|
4906 |
shows "distinct (map set (subseqs xs))" |
49948
744934b818c7
moved quite generic material from theory Enum to more appropriate places
haftmann
parents:
49808
diff
changeset
|
4907 |
proof (rule card_distinct) |
64963 | 4908 |
have "finite (set xs)" .. |
4909 |
then have "card (Pow (set xs)) = 2 ^ card (set xs)" |
|
4910 |
by (rule card_Pow) |
|
4911 |
with assms distinct_card [of xs] have "card (Pow (set xs)) = 2 ^ length xs" |
|
4912 |
by simp |
|
65956
639eb3617a86
reorganised material on sublists
eberlm <eberlm@in.tum.de>
parents:
65350
diff
changeset
|
4913 |
then show "card (set (map set (subseqs xs))) = length (map set (subseqs xs))" |
639eb3617a86
reorganised material on sublists
eberlm <eberlm@in.tum.de>
parents:
65350
diff
changeset
|
4914 |
by (simp add: subseqs_powset length_subseqs) |
49948
744934b818c7
moved quite generic material from theory Enum to more appropriate places
haftmann
parents:
49808
diff
changeset
|
4915 |
qed |
744934b818c7
moved quite generic material from theory Enum to more appropriate places
haftmann
parents:
49808
diff
changeset
|
4916 |
|
744934b818c7
moved quite generic material from theory Enum to more appropriate places
haftmann
parents:
49808
diff
changeset
|
4917 |
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
|
4918 |
by (induct n) simp_all |
744934b818c7
moved quite generic material from theory Enum to more appropriate places
haftmann
parents:
49808
diff
changeset
|
4919 |
|
744934b818c7
moved quite generic material from theory Enum to more appropriate places
haftmann
parents:
49808
diff
changeset
|
4920 |
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
|
4921 |
by (induct n arbitrary: ys) auto |
744934b818c7
moved quite generic material from theory Enum to more appropriate places
haftmann
parents:
49808
diff
changeset
|
4922 |
|
744934b818c7
moved quite generic material from theory Enum to more appropriate places
haftmann
parents:
49808
diff
changeset
|
4923 |
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
|
4924 |
proof (rule set_eqI) |
744934b818c7
moved quite generic material from theory Enum to more appropriate places
haftmann
parents:
49808
diff
changeset
|
4925 |
fix ys :: "'a list" |
744934b818c7
moved quite generic material from theory Enum to more appropriate places
haftmann
parents:
49808
diff
changeset
|
4926 |
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
|
4927 |
proof - |
744934b818c7
moved quite generic material from theory Enum to more appropriate places
haftmann
parents:
49808
diff
changeset
|
4928 |
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
|
4929 |
by (induct n arbitrary: ys) auto |
744934b818c7
moved quite generic material from theory Enum to more appropriate places
haftmann
parents:
49808
diff
changeset
|
4930 |
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
|
4931 |
by (induct n arbitrary: ys) auto |
744934b818c7
moved quite generic material from theory Enum to more appropriate places
haftmann
parents:
49808
diff
changeset
|
4932 |
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
|
4933 |
by (induct ys) auto |
744934b818c7
moved quite generic material from theory Enum to more appropriate places
haftmann
parents:
49808
diff
changeset
|
4934 |
ultimately show ?thesis by auto |
744934b818c7
moved quite generic material from theory Enum to more appropriate places
haftmann
parents:
49808
diff
changeset
|
4935 |
qed |
744934b818c7
moved quite generic material from theory Enum to more appropriate places
haftmann
parents:
49808
diff
changeset
|
4936 |
qed |
744934b818c7
moved quite generic material from theory Enum to more appropriate places
haftmann
parents:
49808
diff
changeset
|
4937 |
|
65956
639eb3617a86
reorganised material on sublists
eberlm <eberlm@in.tum.de>
parents:
65350
diff
changeset
|
4938 |
lemma subseqs_refl: "xs \<in> set (subseqs xs)" |
64963 | 4939 |
by (induct xs) (simp_all add: Let_def) |
63561
fba08009ff3e
add lemmas contributed by Peter Gammie
Andreas Lochbihler
parents:
63540
diff
changeset
|
4940 |
|
65956
639eb3617a86
reorganised material on sublists
eberlm <eberlm@in.tum.de>
parents:
65350
diff
changeset
|
4941 |
lemma subset_subseqs: "X \<subseteq> set xs \<Longrightarrow> X \<in> set ` set (subseqs xs)" |
639eb3617a86
reorganised material on sublists
eberlm <eberlm@in.tum.de>
parents:
65350
diff
changeset
|
4942 |
unfolding subseqs_powset by simp |
639eb3617a86
reorganised material on sublists
eberlm <eberlm@in.tum.de>
parents:
65350
diff
changeset
|
4943 |
|
639eb3617a86
reorganised material on sublists
eberlm <eberlm@in.tum.de>
parents:
65350
diff
changeset
|
4944 |
lemma Cons_in_subseqsD: "y # ys \<in> set (subseqs xs) \<Longrightarrow> ys \<in> set (subseqs xs)" |
64963 | 4945 |
by (induct xs) (auto simp: Let_def) |
63561
fba08009ff3e
add lemmas contributed by Peter Gammie
Andreas Lochbihler
parents:
63540
diff
changeset
|
4946 |
|
65956
639eb3617a86
reorganised material on sublists
eberlm <eberlm@in.tum.de>
parents:
65350
diff
changeset
|
4947 |
lemma subseqs_distinctD: "\<lbrakk> ys \<in> set (subseqs xs); distinct xs \<rbrakk> \<Longrightarrow> distinct ys" |
64963 | 4948 |
proof (induct xs arbitrary: ys) |
63561
fba08009ff3e
add lemmas contributed by Peter Gammie
Andreas Lochbihler
parents:
63540
diff
changeset
|
4949 |
case (Cons x xs ys) |
fba08009ff3e
add lemmas contributed by Peter Gammie
Andreas Lochbihler
parents:
63540
diff
changeset
|
4950 |
then show ?case |
65956
639eb3617a86
reorganised material on sublists
eberlm <eberlm@in.tum.de>
parents:
65350
diff
changeset
|
4951 |
by (auto simp: Let_def) (metis Pow_iff contra_subsetD image_eqI subseqs_powset) |
63561
fba08009ff3e
add lemmas contributed by Peter Gammie
Andreas Lochbihler
parents:
63540
diff
changeset
|
4952 |
qed simp |
fba08009ff3e
add lemmas contributed by Peter Gammie
Andreas Lochbihler
parents:
63540
diff
changeset
|
4953 |
|
49948
744934b818c7
moved quite generic material from theory Enum to more appropriate places
haftmann
parents:
49808
diff
changeset
|
4954 |
|
69593 | 4955 |
subsubsection \<open>\<^const>\<open>splice\<close>\<close> |
19390 | 4956 |
|
69075 | 4957 |
lemma splice_Nil2 [simp]: "splice xs [] = xs" |
71585 | 4958 |
by (cases xs) simp_all |
19390 | 4959 |
|
24526 | 4960 |
lemma length_splice[simp]: "length(splice xs ys) = length xs + length ys" |
71585 | 4961 |
by (induct xs ys rule: splice.induct) auto |
69136 | 4962 |
|
4963 |
lemma split_Nil_iff[simp]: "splice xs ys = [] \<longleftrightarrow> xs = [] \<and> ys = []" |
|
71585 | 4964 |
by (induct xs ys rule: splice.induct) auto |
65350
b149abe619f7
added shuffle product to HOL/List
eberlm <eberlm@in.tum.de>
parents:
64966
diff
changeset
|
4965 |
|
69140 | 4966 |
lemma splice_replicate[simp]: "splice (replicate m x) (replicate n x) = replicate (m+n) x" |
71585 | 4967 |
proof (induction "replicate m x" "replicate n x" arbitrary: m n rule: splice.induct) |
4968 |
case (2 x xs) |
|
4969 |
then show ?case |
|
4970 |
by (auto simp add: Cons_replicate_eq dest: gr0_implies_Suc) |
|
4971 |
qed auto |
|
65350
b149abe619f7
added shuffle product to HOL/List
eberlm <eberlm@in.tum.de>
parents:
64966
diff
changeset
|
4972 |
|
69593 | 4973 |
subsubsection \<open>\<^const>\<open>shuffles\<close>\<close> |
69107 | 4974 |
|
4975 |
lemma shuffles_commutes: "shuffles xs ys = shuffles ys xs" |
|
4976 |
by (induction xs ys rule: shuffles.induct) (simp_all add: Un_commute) |
|
4977 |
||
4978 |
lemma Nil_in_shuffles[simp]: "[] \<in> shuffles xs ys \<longleftrightarrow> xs = [] \<and> ys = []" |
|
4979 |
by (induct xs ys rule: shuffles.induct) auto |
|
4980 |
||
4981 |
lemma shufflesE: |
|
4982 |
"zs \<in> shuffles xs ys \<Longrightarrow> |
|
65350
b149abe619f7
added shuffle product to HOL/List
eberlm <eberlm@in.tum.de>
parents:
64966
diff
changeset
|
4983 |
(zs = xs \<Longrightarrow> ys = [] \<Longrightarrow> P) \<Longrightarrow> |
b149abe619f7
added shuffle product to HOL/List
eberlm <eberlm@in.tum.de>
parents:
64966
diff
changeset
|
4984 |
(zs = ys \<Longrightarrow> xs = [] \<Longrightarrow> P) \<Longrightarrow> |
69107 | 4985 |
(\<And>x xs' z zs'. xs = x # xs' \<Longrightarrow> zs = z # zs' \<Longrightarrow> x = z \<Longrightarrow> zs' \<in> shuffles xs' ys \<Longrightarrow> P) \<Longrightarrow> |
4986 |
(\<And>y ys' z zs'. ys = y # ys' \<Longrightarrow> zs = z # zs' \<Longrightarrow> y = z \<Longrightarrow> zs' \<in> shuffles xs ys' \<Longrightarrow> P) \<Longrightarrow> P" |
|
4987 |
by (induct xs ys rule: shuffles.induct) auto |
|
4988 |
||
4989 |
lemma Cons_in_shuffles_iff: |
|
4990 |
"z # zs \<in> shuffles xs ys \<longleftrightarrow> |
|
4991 |
(xs \<noteq> [] \<and> hd xs = z \<and> zs \<in> shuffles (tl xs) ys \<or> |
|
4992 |
ys \<noteq> [] \<and> hd ys = z \<and> zs \<in> shuffles xs (tl ys))" |
|
4993 |
by (induct xs ys rule: shuffles.induct) auto |
|
4994 |
||
4995 |
lemma splice_in_shuffles [simp, intro]: "splice xs ys \<in> shuffles xs ys" |
|
71585 | 4996 |
by (induction xs ys rule: splice.induct) (simp_all add: Cons_in_shuffles_iff shuffles_commutes) |
69107 | 4997 |
|
4998 |
lemma Nil_in_shufflesI: "xs = [] \<Longrightarrow> ys = [] \<Longrightarrow> [] \<in> shuffles xs ys" |
|
65350
b149abe619f7
added shuffle product to HOL/List
eberlm <eberlm@in.tum.de>
parents:
64966
diff
changeset
|
4999 |
by simp |
66892 | 5000 |
|
69107 | 5001 |
lemma Cons_in_shuffles_leftI: "zs \<in> shuffles xs ys \<Longrightarrow> z # zs \<in> shuffles (z # xs) ys" |
65350
b149abe619f7
added shuffle product to HOL/List
eberlm <eberlm@in.tum.de>
parents:
64966
diff
changeset
|
5002 |
by (cases ys) auto |
b149abe619f7
added shuffle product to HOL/List
eberlm <eberlm@in.tum.de>
parents:
64966
diff
changeset
|
5003 |
|
69107 | 5004 |
lemma Cons_in_shuffles_rightI: "zs \<in> shuffles xs ys \<Longrightarrow> z # zs \<in> shuffles xs (z # ys)" |
65350
b149abe619f7
added shuffle product to HOL/List
eberlm <eberlm@in.tum.de>
parents:
64966
diff
changeset
|
5005 |
by (cases xs) auto |
b149abe619f7
added shuffle product to HOL/List
eberlm <eberlm@in.tum.de>
parents:
64966
diff
changeset
|
5006 |
|
69107 | 5007 |
lemma finite_shuffles [simp, intro]: "finite (shuffles xs ys)" |
5008 |
by (induction xs ys rule: shuffles.induct) simp_all |
|
5009 |
||
5010 |
lemma length_shuffles: "zs \<in> shuffles xs ys \<Longrightarrow> length zs = length xs + length ys" |
|
5011 |
by (induction xs ys arbitrary: zs rule: shuffles.induct) auto |
|
5012 |
||
5013 |
lemma set_shuffles: "zs \<in> shuffles xs ys \<Longrightarrow> set zs = set xs \<union> set ys" |
|
5014 |
by (induction xs ys arbitrary: zs rule: shuffles.induct) auto |
|
5015 |
||
5016 |
lemma distinct_disjoint_shuffles: |
|
5017 |
assumes "distinct xs" "distinct ys" "set xs \<inter> set ys = {}" "zs \<in> shuffles xs ys" |
|
65350
b149abe619f7
added shuffle product to HOL/List
eberlm <eberlm@in.tum.de>
parents:
64966
diff
changeset
|
5018 |
shows "distinct zs" |
b149abe619f7
added shuffle product to HOL/List
eberlm <eberlm@in.tum.de>
parents:
64966
diff
changeset
|
5019 |
using assms |
69107 | 5020 |
proof (induction xs ys arbitrary: zs rule: shuffles.induct) |
65350
b149abe619f7
added shuffle product to HOL/List
eberlm <eberlm@in.tum.de>
parents:
64966
diff
changeset
|
5021 |
case (3 x xs y ys) |
b149abe619f7
added shuffle product to HOL/List
eberlm <eberlm@in.tum.de>
parents:
64966
diff
changeset
|
5022 |
show ?case |
b149abe619f7
added shuffle product to HOL/List
eberlm <eberlm@in.tum.de>
parents:
64966
diff
changeset
|
5023 |
proof (cases zs) |
b149abe619f7
added shuffle product to HOL/List
eberlm <eberlm@in.tum.de>
parents:
64966
diff
changeset
|
5024 |
case (Cons z zs') |
69107 | 5025 |
with "3.prems" and "3.IH"[of zs'] show ?thesis by (force dest: set_shuffles) |
65350
b149abe619f7
added shuffle product to HOL/List
eberlm <eberlm@in.tum.de>
parents:
64966
diff
changeset
|
5026 |
qed simp_all |
b149abe619f7
added shuffle product to HOL/List
eberlm <eberlm@in.tum.de>
parents:
64966
diff
changeset
|
5027 |
qed simp_all |
b149abe619f7
added shuffle product to HOL/List
eberlm <eberlm@in.tum.de>
parents:
64966
diff
changeset
|
5028 |
|
69107 | 5029 |
lemma Cons_shuffles_subset1: "(#) x ` shuffles xs ys \<subseteq> shuffles (x # xs) ys" |
65350
b149abe619f7
added shuffle product to HOL/List
eberlm <eberlm@in.tum.de>
parents:
64966
diff
changeset
|
5030 |
by (cases ys) auto |
66892 | 5031 |
|
69107 | 5032 |
lemma Cons_shuffles_subset2: "(#) y ` shuffles xs ys \<subseteq> shuffles xs (y # ys)" |
65350
b149abe619f7
added shuffle product to HOL/List
eberlm <eberlm@in.tum.de>
parents:
64966
diff
changeset
|
5033 |
by (cases xs) auto |
b149abe619f7
added shuffle product to HOL/List
eberlm <eberlm@in.tum.de>
parents:
64966
diff
changeset
|
5034 |
|
69107 | 5035 |
lemma filter_shuffles: |
5036 |
"filter P ` shuffles xs ys = shuffles (filter P xs) (filter P ys)" |
|
65350
b149abe619f7
added shuffle product to HOL/List
eberlm <eberlm@in.tum.de>
parents:
64966
diff
changeset
|
5037 |
proof - |
67399 | 5038 |
have *: "filter P ` (#) x ` A = (if P x then (#) x ` filter P ` A else filter P ` A)" for x A |
65350
b149abe619f7
added shuffle product to HOL/List
eberlm <eberlm@in.tum.de>
parents:
64966
diff
changeset
|
5039 |
by (auto simp: image_image) |
b149abe619f7
added shuffle product to HOL/List
eberlm <eberlm@in.tum.de>
parents:
64966
diff
changeset
|
5040 |
show ?thesis |
69107 | 5041 |
by (induction xs ys rule: shuffles.induct) |
66892 | 5042 |
(simp_all split: if_splits add: image_Un * Un_absorb1 Un_absorb2 |
69107 | 5043 |
Cons_shuffles_subset1 Cons_shuffles_subset2) |
65350
b149abe619f7
added shuffle product to HOL/List
eberlm <eberlm@in.tum.de>
parents:
64966
diff
changeset
|
5044 |
qed |
b149abe619f7
added shuffle product to HOL/List
eberlm <eberlm@in.tum.de>
parents:
64966
diff
changeset
|
5045 |
|
69107 | 5046 |
lemma filter_shuffles_disjoint1: |
5047 |
assumes "set xs \<inter> set ys = {}" "zs \<in> shuffles xs ys" |
|
65350
b149abe619f7
added shuffle product to HOL/List
eberlm <eberlm@in.tum.de>
parents:
64966
diff
changeset
|
5048 |
shows "filter (\<lambda>x. x \<in> set xs) zs = xs" (is "filter ?P _ = _") |
b149abe619f7
added shuffle product to HOL/List
eberlm <eberlm@in.tum.de>
parents:
64966
diff
changeset
|
5049 |
and "filter (\<lambda>x. x \<notin> set xs) zs = ys" (is "filter ?Q _ = _") |
b149abe619f7
added shuffle product to HOL/List
eberlm <eberlm@in.tum.de>
parents:
64966
diff
changeset
|
5050 |
using assms |
b149abe619f7
added shuffle product to HOL/List
eberlm <eberlm@in.tum.de>
parents:
64966
diff
changeset
|
5051 |
proof - |
69107 | 5052 |
from assms have "filter ?P zs \<in> filter ?P ` shuffles xs ys" by blast |
5053 |
also have "filter ?P ` shuffles xs ys = shuffles (filter ?P xs) (filter ?P ys)" |
|
5054 |
by (rule filter_shuffles) |
|
65350
b149abe619f7
added shuffle product to HOL/List
eberlm <eberlm@in.tum.de>
parents:
64966
diff
changeset
|
5055 |
also have "filter ?P xs = xs" by (rule filter_True) simp_all |
b149abe619f7
added shuffle product to HOL/List
eberlm <eberlm@in.tum.de>
parents:
64966
diff
changeset
|
5056 |
also have "filter ?P ys = []" by (rule filter_False) (insert assms(1), auto) |
69107 | 5057 |
also have "shuffles xs [] = {xs}" by simp |
65350
b149abe619f7
added shuffle product to HOL/List
eberlm <eberlm@in.tum.de>
parents:
64966
diff
changeset
|
5058 |
finally show "filter ?P zs = xs" by simp |
b149abe619f7
added shuffle product to HOL/List
eberlm <eberlm@in.tum.de>
parents:
64966
diff
changeset
|
5059 |
next |
69107 | 5060 |
from assms have "filter ?Q zs \<in> filter ?Q ` shuffles xs ys" by blast |
5061 |
also have "filter ?Q ` shuffles xs ys = shuffles (filter ?Q xs) (filter ?Q ys)" |
|
5062 |
by (rule filter_shuffles) |
|
65350
b149abe619f7
added shuffle product to HOL/List
eberlm <eberlm@in.tum.de>
parents:
64966
diff
changeset
|
5063 |
also have "filter ?Q ys = ys" by (rule filter_True) (insert assms(1), auto) |
b149abe619f7
added shuffle product to HOL/List
eberlm <eberlm@in.tum.de>
parents:
64966
diff
changeset
|
5064 |
also have "filter ?Q xs = []" by (rule filter_False) (insert assms(1), auto) |
69107 | 5065 |
also have "shuffles [] ys = {ys}" by simp |
65350
b149abe619f7
added shuffle product to HOL/List
eberlm <eberlm@in.tum.de>
parents:
64966
diff
changeset
|
5066 |
finally show "filter ?Q zs = ys" by simp |
b149abe619f7
added shuffle product to HOL/List
eberlm <eberlm@in.tum.de>
parents:
64966
diff
changeset
|
5067 |
qed |
b149abe619f7
added shuffle product to HOL/List
eberlm <eberlm@in.tum.de>
parents:
64966
diff
changeset
|
5068 |
|
69107 | 5069 |
lemma filter_shuffles_disjoint2: |
5070 |
assumes "set xs \<inter> set ys = {}" "zs \<in> shuffles xs ys" |
|
65350
b149abe619f7
added shuffle product to HOL/List
eberlm <eberlm@in.tum.de>
parents:
64966
diff
changeset
|
5071 |
shows "filter (\<lambda>x. x \<in> set ys) zs = ys" "filter (\<lambda>x. x \<notin> set ys) zs = xs" |
69107 | 5072 |
using filter_shuffles_disjoint1[of ys xs zs] assms |
5073 |
by (simp_all add: shuffles_commutes Int_commute) |
|
5074 |
||
5075 |
lemma partition_in_shuffles: |
|
5076 |
"xs \<in> shuffles (filter P xs) (filter (\<lambda>x. \<not>P x) xs)" |
|
65350
b149abe619f7
added shuffle product to HOL/List
eberlm <eberlm@in.tum.de>
parents:
64966
diff
changeset
|
5077 |
proof (induction xs) |
b149abe619f7
added shuffle product to HOL/List
eberlm <eberlm@in.tum.de>
parents:
64966
diff
changeset
|
5078 |
case (Cons x xs) |
b149abe619f7
added shuffle product to HOL/List
eberlm <eberlm@in.tum.de>
parents:
64966
diff
changeset
|
5079 |
show ?case |
b149abe619f7
added shuffle product to HOL/List
eberlm <eberlm@in.tum.de>
parents:
64966
diff
changeset
|
5080 |
proof (cases "P x") |
b149abe619f7
added shuffle product to HOL/List
eberlm <eberlm@in.tum.de>
parents:
64966
diff
changeset
|
5081 |
case True |
69107 | 5082 |
hence "x # xs \<in> (#) x ` shuffles (filter P xs) (filter (\<lambda>x. \<not>P x) xs)" |
65350
b149abe619f7
added shuffle product to HOL/List
eberlm <eberlm@in.tum.de>
parents:
64966
diff
changeset
|
5083 |
by (intro imageI Cons.IH) |
69107 | 5084 |
also have "\<dots> \<subseteq> shuffles (filter P (x # xs)) (filter (\<lambda>x. \<not>P x) (x # xs))" |
5085 |
by (simp add: True Cons_shuffles_subset1) |
|
65350
b149abe619f7
added shuffle product to HOL/List
eberlm <eberlm@in.tum.de>
parents:
64966
diff
changeset
|
5086 |
finally show ?thesis . |
b149abe619f7
added shuffle product to HOL/List
eberlm <eberlm@in.tum.de>
parents:
64966
diff
changeset
|
5087 |
next |
b149abe619f7
added shuffle product to HOL/List
eberlm <eberlm@in.tum.de>
parents:
64966
diff
changeset
|
5088 |
case False |
69107 | 5089 |
hence "x # xs \<in> (#) x ` shuffles (filter P xs) (filter (\<lambda>x. \<not>P x) xs)" |
65350
b149abe619f7
added shuffle product to HOL/List
eberlm <eberlm@in.tum.de>
parents:
64966
diff
changeset
|
5090 |
by (intro imageI Cons.IH) |
69107 | 5091 |
also have "\<dots> \<subseteq> shuffles (filter P (x # xs)) (filter (\<lambda>x. \<not>P x) (x # xs))" |
5092 |
by (simp add: False Cons_shuffles_subset2) |
|
65350
b149abe619f7
added shuffle product to HOL/List
eberlm <eberlm@in.tum.de>
parents:
64966
diff
changeset
|
5093 |
finally show ?thesis . |
b149abe619f7
added shuffle product to HOL/List
eberlm <eberlm@in.tum.de>
parents:
64966
diff
changeset
|
5094 |
qed |
b149abe619f7
added shuffle product to HOL/List
eberlm <eberlm@in.tum.de>
parents:
64966
diff
changeset
|
5095 |
qed auto |
b149abe619f7
added shuffle product to HOL/List
eberlm <eberlm@in.tum.de>
parents:
64966
diff
changeset
|
5096 |
|
b149abe619f7
added shuffle product to HOL/List
eberlm <eberlm@in.tum.de>
parents:
64966
diff
changeset
|
5097 |
lemma inv_image_partition: |
b149abe619f7
added shuffle product to HOL/List
eberlm <eberlm@in.tum.de>
parents:
64966
diff
changeset
|
5098 |
assumes "\<And>x. x \<in> set xs \<Longrightarrow> P x" "\<And>y. y \<in> set ys \<Longrightarrow> \<not>P y" |
69107 | 5099 |
shows "partition P -` {(xs, ys)} = shuffles xs ys" |
65350
b149abe619f7
added shuffle product to HOL/List
eberlm <eberlm@in.tum.de>
parents:
64966
diff
changeset
|
5100 |
proof (intro equalityI subsetI) |
69107 | 5101 |
fix zs assume zs: "zs \<in> shuffles xs ys" |
5102 |
hence [simp]: "set zs = set xs \<union> set ys" by (rule set_shuffles) |
|
66892 | 5103 |
from assms have "filter P zs = filter (\<lambda>x. x \<in> set xs) zs" |
65350
b149abe619f7
added shuffle product to HOL/List
eberlm <eberlm@in.tum.de>
parents:
64966
diff
changeset
|
5104 |
"filter (\<lambda>x. \<not>P x) zs = filter (\<lambda>x. x \<in> set ys) zs" |
b149abe619f7
added shuffle product to HOL/List
eberlm <eberlm@in.tum.de>
parents:
64966
diff
changeset
|
5105 |
by (intro filter_cong refl; force)+ |
b149abe619f7
added shuffle product to HOL/List
eberlm <eberlm@in.tum.de>
parents:
64966
diff
changeset
|
5106 |
moreover from assms have "set xs \<inter> set ys = {}" by auto |
b149abe619f7
added shuffle product to HOL/List
eberlm <eberlm@in.tum.de>
parents:
64966
diff
changeset
|
5107 |
ultimately show "zs \<in> partition P -` {(xs, ys)}" using zs |
69107 | 5108 |
by (simp add: o_def filter_shuffles_disjoint1 filter_shuffles_disjoint2) |
65350
b149abe619f7
added shuffle product to HOL/List
eberlm <eberlm@in.tum.de>
parents:
64966
diff
changeset
|
5109 |
next |
b149abe619f7
added shuffle product to HOL/List
eberlm <eberlm@in.tum.de>
parents:
64966
diff
changeset
|
5110 |
fix zs assume "zs \<in> partition P -` {(xs, ys)}" |
69107 | 5111 |
thus "zs \<in> shuffles xs ys" using partition_in_shuffles[of zs] by (auto simp: o_def) |
65350
b149abe619f7
added shuffle product to HOL/List
eberlm <eberlm@in.tum.de>
parents:
64966
diff
changeset
|
5112 |
qed |
22793 | 5113 |
|
35115 | 5114 |
|
60758 | 5115 |
subsubsection \<open>Transpose\<close> |
34933 | 5116 |
|
5117 |
function transpose where |
|
5118 |
"transpose [] = []" | |
|
5119 |
"transpose ([] # xss) = transpose xss" | |
|
5120 |
"transpose ((x#xs) # xss) = |
|
5121 |
(x # [h. (h#t) \<leftarrow> xss]) # transpose (xs # [t. (h#t) \<leftarrow> xss])" |
|
5122 |
by pat_completeness auto |
|
5123 |
||
5124 |
lemma transpose_aux_filter_head: |
|
55404
5cb95b79a51f
transformed 'option' and 'list' into new-style datatypes (but register them as old-style as well)
blanchet
parents:
55148
diff
changeset
|
5125 |
"concat (map (case_list [] (\<lambda>h t. [h])) xss) = |
68249
949d93804740
First step to remove nonstandard "[x <- xs. P]" syntax: only input
nipkow
parents:
68215
diff
changeset
|
5126 |
map (\<lambda>xs. hd xs) (filter (\<lambda>ys. ys \<noteq> []) xss)" |
34933 | 5127 |
by (induct xss) (auto split: list.split) |
5128 |
||
5129 |
lemma transpose_aux_filter_tail: |
|
55404
5cb95b79a51f
transformed 'option' and 'list' into new-style datatypes (but register them as old-style as well)
blanchet
parents:
55148
diff
changeset
|
5130 |
"concat (map (case_list [] (\<lambda>h t. [t])) xss) = |
68249
949d93804740
First step to remove nonstandard "[x <- xs. P]" syntax: only input
nipkow
parents:
68215
diff
changeset
|
5131 |
map (\<lambda>xs. tl xs) (filter (\<lambda>ys. ys \<noteq> []) xss)" |
34933 | 5132 |
by (induct xss) (auto split: list.split) |
5133 |
||
5134 |
lemma transpose_aux_max: |
|
5135 |
"max (Suc (length xs)) (foldr (\<lambda>xs. max (length xs)) xss 0) = |
|
68249
949d93804740
First step to remove nonstandard "[x <- xs. P]" syntax: only input
nipkow
parents:
68215
diff
changeset
|
5136 |
Suc (max (length xs) (foldr (\<lambda>x. max (length x - Suc 0)) (filter (\<lambda>ys. ys \<noteq> []) xss) 0))" |
34933 | 5137 |
(is "max _ ?foldB = Suc (max _ ?foldA)") |
68249
949d93804740
First step to remove nonstandard "[x <- xs. P]" syntax: only input
nipkow
parents:
68215
diff
changeset
|
5138 |
proof (cases "(filter (\<lambda>ys. ys \<noteq> []) xss) = []") |
34933 | 5139 |
case True |
5140 |
hence "foldr (\<lambda>xs. max (length xs)) xss 0 = 0" |
|
5141 |
proof (induct xss) |
|
5142 |
case (Cons x xs) |
|
53374
a14d2a854c02
tuned proofs -- clarified flow of facts wrt. calculation;
wenzelm
parents:
53017
diff
changeset
|
5143 |
then have "x = []" by (cases x) auto |
a14d2a854c02
tuned proofs -- clarified flow of facts wrt. calculation;
wenzelm
parents:
53017
diff
changeset
|
5144 |
with Cons show ?case by auto |
34933 | 5145 |
qed simp |
5146 |
thus ?thesis using True by simp |
|
5147 |
next |
|
5148 |
case False |
|
5149 |
||
68249
949d93804740
First step to remove nonstandard "[x <- xs. P]" syntax: only input
nipkow
parents:
68215
diff
changeset
|
5150 |
have foldA: "?foldA = foldr (\<lambda>x. max (length x)) (filter (\<lambda>ys. ys \<noteq> []) xss) 0 - 1" |
34933 | 5151 |
by (induct xss) auto |
68249
949d93804740
First step to remove nonstandard "[x <- xs. P]" syntax: only input
nipkow
parents:
68215
diff
changeset
|
5152 |
have foldB: "?foldB = foldr (\<lambda>x. max (length x)) (filter (\<lambda>ys. ys \<noteq> []) xss) 0" |
34933 | 5153 |
by (induct xss) auto |
5154 |
||
5155 |
have "0 < ?foldB" |
|
5156 |
proof - |
|
5157 |
from False |
|
68249
949d93804740
First step to remove nonstandard "[x <- xs. P]" syntax: only input
nipkow
parents:
68215
diff
changeset
|
5158 |
obtain z zs where zs: "(filter (\<lambda>ys. ys \<noteq> []) xss) = z#zs" by (auto simp: neq_Nil_conv) |
949d93804740
First step to remove nonstandard "[x <- xs. P]" syntax: only input
nipkow
parents:
68215
diff
changeset
|
5159 |
hence "z \<in> set (filter (\<lambda>ys. ys \<noteq> []) xss)" by auto |
34933 | 5160 |
hence "z \<noteq> []" by auto |
5161 |
thus ?thesis |
|
5162 |
unfolding foldB zs |
|
5163 |
by (auto simp: max_def intro: less_le_trans) |
|
5164 |
qed |
|
5165 |
thus ?thesis |
|
5166 |
unfolding foldA foldB max_Suc_Suc[symmetric] |
|
5167 |
by simp |
|
5168 |
qed |
|
5169 |
||
5170 |
termination transpose |
|
5171 |
by (relation "measure (\<lambda>xs. foldr (\<lambda>xs. max (length xs)) xs 0 + length xs)") |
|
5172 |
(auto simp: transpose_aux_filter_tail foldr_map comp_def transpose_aux_max less_Suc_eq_le) |
|
5173 |
||
5174 |
lemma transpose_empty: "(transpose xs = []) \<longleftrightarrow> (\<forall>x \<in> set xs. x = [])" |
|
5175 |
by (induct rule: transpose.induct) simp_all |
|
5176 |
||
5177 |
lemma length_transpose: |
|
5178 |
fixes xs :: "'a list list" |
|
5179 |
shows "length (transpose xs) = foldr (\<lambda>xs. max (length xs)) xs 0" |
|
5180 |
by (induct rule: transpose.induct) |
|
5181 |
(auto simp: transpose_aux_filter_tail foldr_map comp_def transpose_aux_max |
|
5182 |
max_Suc_Suc[symmetric] simp del: max_Suc_Suc) |
|
5183 |
||
5184 |
lemma nth_transpose: |
|
5185 |
fixes xs :: "'a list list" |
|
5186 |
assumes "i < length (transpose xs)" |
|
68249
949d93804740
First step to remove nonstandard "[x <- xs. P]" syntax: only input
nipkow
parents:
68215
diff
changeset
|
5187 |
shows "transpose xs ! i = map (\<lambda>xs. xs ! i) (filter (\<lambda>ys. i < length ys) xs)" |
34933 | 5188 |
using assms proof (induct arbitrary: i rule: transpose.induct) |
5189 |
case (3 x xs xss) |
|
63040 | 5190 |
define XS where "XS = (x # xs) # xss" |
34933 | 5191 |
hence [simp]: "XS \<noteq> []" by auto |
5192 |
thus ?case |
|
5193 |
proof (cases i) |
|
5194 |
case 0 |
|
5195 |
thus ?thesis by (simp add: transpose_aux_filter_head hd_conv_nth) |
|
5196 |
next |
|
5197 |
case (Suc j) |
|
5198 |
have *: "\<And>xss. xs # map tl xss = map tl ((x#xs)#xss)" by simp |
|
5199 |
have **: "\<And>xss. (x#xs) # filter (\<lambda>ys. ys \<noteq> []) xss = filter (\<lambda>ys. ys \<noteq> []) ((x#xs)#xss)" by simp |
|
5200 |
{ fix x have "Suc j < length x \<longleftrightarrow> x \<noteq> [] \<and> j < length x - Suc 0" |
|
5201 |
by (cases x) simp_all |
|
5202 |
} note *** = this |
|
5203 |
||
55404
5cb95b79a51f
transformed 'option' and 'list' into new-style datatypes (but register them as old-style as well)
blanchet
parents:
55148
diff
changeset
|
5204 |
have j_less: "j < length (transpose (xs # concat (map (case_list [] (\<lambda>h t. [t])) xss)))" |
34933 | 5205 |
using "3.prems" by (simp add: transpose_aux_filter_tail length_transpose Suc) |
5206 |
||
5207 |
show ?thesis |
|
60758 | 5208 |
unfolding transpose.simps \<open>i = Suc j\<close> nth_Cons_Suc "3.hyps"[OF j_less] |
34933 | 5209 |
apply (auto simp: transpose_aux_filter_tail filter_map comp_def length_transpose * ** *** XS_def[symmetric]) |
68719 | 5210 |
by (simp add: nth_tl) |
34933 | 5211 |
qed |
5212 |
qed simp_all |
|
5213 |
||
5214 |
lemma transpose_map_map: |
|
5215 |
"transpose (map (map f) xs) = map (map f) (transpose xs)" |
|
68975
5ce4d117cea7
A few new results, elimination of duplicates and more use of "pairwise"
paulson <lp15@cam.ac.uk>
parents:
68781
diff
changeset
|
5216 |
proof (rule nth_equalityI) |
34933 | 5217 |
have [simp]: "length (transpose (map (map f) xs)) = length (transpose xs)" |
5218 |
by (simp add: length_transpose foldr_map comp_def) |
|
5219 |
show "length (transpose (map (map f) xs)) = length (map (map f) (transpose xs))" by simp |
|
5220 |
||
5221 |
fix i assume "i < length (transpose (map (map f) xs))" |
|
5222 |
thus "transpose (map (map f) xs) ! i = map (map f) (transpose xs) ! i" |
|
5223 |
by (simp add: nth_transpose filter_map comp_def) |
|
5224 |
qed |
|
24616 | 5225 |
|
69593 | 5226 |
subsubsection \<open>\<^const>\<open>min\<close> and \<^const>\<open>arg_min\<close>\<close> |
67170 | 5227 |
|
5228 |
lemma min_list_Min: "xs \<noteq> [] \<Longrightarrow> min_list xs = Min (set xs)" |
|
71585 | 5229 |
by (induction xs rule: induct_list012)(auto) |
67170 | 5230 |
|
5231 |
lemma f_arg_min_list_f: "xs \<noteq> [] \<Longrightarrow> f (arg_min_list f xs) = Min (f ` (set xs))" |
|
71585 | 5232 |
by(induction f xs rule: arg_min_list.induct) (auto simp: min_def intro!: antisym) |
67170 | 5233 |
|
67171 | 5234 |
lemma arg_min_list_in: "xs \<noteq> [] \<Longrightarrow> arg_min_list f xs \<in> set xs" |
71585 | 5235 |
by(induction xs rule: induct_list012) (auto simp: Let_def) |
67171 | 5236 |
|
35115 | 5237 |
|
60758 | 5238 |
subsubsection \<open>(In)finiteness\<close> |
28642 | 5239 |
|
5240 |
lemma finite_maxlen: |
|
67091 | 5241 |
"finite (M::'a list set) \<Longrightarrow> \<exists>n. \<forall>s\<in>M. size s < n" |
28642 | 5242 |
proof (induct rule: finite.induct) |
5243 |
case emptyI show ?case by simp |
|
5244 |
next |
|
5245 |
case (insertI M xs) |
|
5246 |
then obtain n where "\<forall>s\<in>M. length s < n" by blast |
|
67613 | 5247 |
hence "\<forall>s\<in>insert xs M. size s < max n (size xs) + 1" by auto |
28642 | 5248 |
thus ?case .. |
5249 |
qed |
|
5250 |
||
45714 | 5251 |
lemma lists_length_Suc_eq: |
5252 |
"{xs. set xs \<subseteq> A \<and> length xs = Suc n} = |
|
5253 |
(\<lambda>(xs, n). n#xs) ` ({xs. set xs \<subseteq> A \<and> length xs = n} \<times> A)" |
|
5254 |
by (auto simp: length_Suc_conv) |
|
5255 |
||
5256 |
lemma |
|
5257 |
assumes "finite A" |
|
5258 |
shows finite_lists_length_eq: "finite {xs. set xs \<subseteq> A \<and> length xs = n}" |
|
5259 |
and card_lists_length_eq: "card {xs. set xs \<subseteq> A \<and> length xs = n} = (card A)^n" |
|
60758 | 5260 |
using \<open>finite A\<close> |
45714 | 5261 |
by (induct n) |
5262 |
(auto simp: card_image inj_split_Cons lists_length_Suc_eq cong: conj_cong) |
|
31557 | 5263 |
|
5264 |
lemma finite_lists_length_le: |
|
5265 |
assumes "finite A" shows "finite {xs. set xs \<subseteq> A \<and> length xs \<le> n}" |
|
5266 |
(is "finite ?S") |
|
5267 |
proof- |
|
5268 |
have "?S = (\<Union>n\<in>{0..n}. {xs. set xs \<subseteq> A \<and> length xs = n})" by auto |
|
60758 | 5269 |
thus ?thesis by (auto intro!: finite_lists_length_eq[OF \<open>finite A\<close>] simp only:) |
31557 | 5270 |
qed |
5271 |
||
45714 | 5272 |
lemma card_lists_length_le: |
5273 |
assumes "finite A" shows "card {xs. set xs \<subseteq> A \<and> length xs \<le> n} = (\<Sum>i\<le>n. card A^i)" |
|
5274 |
proof - |
|
5275 |
have "(\<Sum>i\<le>n. card A^i) = card (\<Union>i\<le>n. {xs. set xs \<subseteq> A \<and> length xs = i})" |
|
60758 | 5276 |
using \<open>finite A\<close> |
45714 | 5277 |
by (subst card_UN_disjoint) |
5278 |
(auto simp add: card_lists_length_eq finite_lists_length_eq) |
|
5279 |
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}" |
|
5280 |
by auto |
|
5281 |
finally show ?thesis by simp |
|
5282 |
qed |
|
5283 |
||
67478
14d3163588ae
add lemma on lists from Falling_Factorial_Sum entry
bulwahn
parents:
67443
diff
changeset
|
5284 |
lemma finite_lists_distinct_length_eq [intro]: |
14d3163588ae
add lemma on lists from Falling_Factorial_Sum entry
bulwahn
parents:
67443
diff
changeset
|
5285 |
assumes "finite A" |
14d3163588ae
add lemma on lists from Falling_Factorial_Sum entry
bulwahn
parents:
67443
diff
changeset
|
5286 |
shows "finite {xs. length xs = n \<and> distinct xs \<and> set xs \<subseteq> A}" (is "finite ?S") |
14d3163588ae
add lemma on lists from Falling_Factorial_Sum entry
bulwahn
parents:
67443
diff
changeset
|
5287 |
proof - |
14d3163588ae
add lemma on lists from Falling_Factorial_Sum entry
bulwahn
parents:
67443
diff
changeset
|
5288 |
have "finite {xs. set xs \<subseteq> A \<and> length xs = n}" |
14d3163588ae
add lemma on lists from Falling_Factorial_Sum entry
bulwahn
parents:
67443
diff
changeset
|
5289 |
using \<open>finite A\<close> by (rule finite_lists_length_eq) |
14d3163588ae
add lemma on lists from Falling_Factorial_Sum entry
bulwahn
parents:
67443
diff
changeset
|
5290 |
moreover have "?S \<subseteq> {xs. set xs \<subseteq> A \<and> length xs = n}" by auto |
14d3163588ae
add lemma on lists from Falling_Factorial_Sum entry
bulwahn
parents:
67443
diff
changeset
|
5291 |
ultimately show ?thesis using finite_subset by auto |
14d3163588ae
add lemma on lists from Falling_Factorial_Sum entry
bulwahn
parents:
67443
diff
changeset
|
5292 |
qed |
14d3163588ae
add lemma on lists from Falling_Factorial_Sum entry
bulwahn
parents:
67443
diff
changeset
|
5293 |
|
45932 | 5294 |
lemma card_lists_distinct_length_eq: |
66358
fab9a53158f8
slightly generalized card_lists_distinct_length_eq; renamed specialized card_lists_distinct_length_eq to card_lists_distinct_length_eq'; tuned
bulwahn
parents:
66257
diff
changeset
|
5295 |
assumes "finite A" "k \<le> card A" |
45932 | 5296 |
shows "card {xs. length xs = k \<and> distinct xs \<and> set xs \<subseteq> A} = \<Prod>{card A - k + 1 .. card A}" |
5297 |
using assms |
|
5298 |
proof (induct k) |
|
5299 |
case 0 |
|
5300 |
then have "{xs. length xs = 0 \<and> distinct xs \<and> set xs \<subseteq> A} = {[]}" by auto |
|
5301 |
then show ?case by simp |
|
5302 |
next |
|
5303 |
case (Suc k) |
|
5304 |
let "?k_list" = "\<lambda>k xs. length xs = k \<and> distinct xs \<and> set xs \<subseteq> A" |
|
5305 |
have inj_Cons: "\<And>A. inj_on (\<lambda>(xs, n). n # xs) A" by (rule inj_onI) auto |
|
5306 |
||
66358
fab9a53158f8
slightly generalized card_lists_distinct_length_eq; renamed specialized card_lists_distinct_length_eq to card_lists_distinct_length_eq'; tuned
bulwahn
parents:
66257
diff
changeset
|
5307 |
from Suc have "k \<le> card A" by simp |
fab9a53158f8
slightly generalized card_lists_distinct_length_eq; renamed specialized card_lists_distinct_length_eq to card_lists_distinct_length_eq'; tuned
bulwahn
parents:
66257
diff
changeset
|
5308 |
moreover note \<open>finite A\<close> |
45932 | 5309 |
moreover have "finite {xs. ?k_list k xs}" |
63834 | 5310 |
by (rule finite_subset) (use finite_lists_length_eq[OF \<open>finite A\<close>, of k] in auto) |
45932 | 5311 |
moreover have "\<And>i j. i \<noteq> j \<longrightarrow> {i} \<times> (A - set i) \<inter> {j} \<times> (A - set j) = {}" |
5312 |
by auto |
|
66358
fab9a53158f8
slightly generalized card_lists_distinct_length_eq; renamed specialized card_lists_distinct_length_eq to card_lists_distinct_length_eq'; tuned
bulwahn
parents:
66257
diff
changeset
|
5313 |
moreover have "\<And>i. i \<in> {xs. ?k_list k xs} \<Longrightarrow> card (A - set i) = card A - k" |
45932 | 5314 |
by (simp add: card_Diff_subset distinct_card) |
5315 |
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
|
5316 |
(\<lambda>(xs, n). n#xs) ` \<Union>((\<lambda>xs. {xs} \<times> (A - set xs)) ` {xs. ?k_list k xs})" |
45932 | 5317 |
by (auto simp: length_Suc_conv) |
66358
fab9a53158f8
slightly generalized card_lists_distinct_length_eq; renamed specialized card_lists_distinct_length_eq to card_lists_distinct_length_eq'; tuned
bulwahn
parents:
66257
diff
changeset
|
5318 |
moreover have "Suc (card A - Suc k) = card A - k" using Suc.prems by simp |
45932 | 5319 |
then have "(card A - k) * \<Prod>{Suc (card A - k)..card A} = \<Prod>{Suc (card A - Suc k)..card A}" |
64272 | 5320 |
by (subst prod.insert[symmetric]) (simp add: atLeastAtMost_insertL)+ |
45932 | 5321 |
ultimately show ?case |
5322 |
by (simp add: card_image inj_Cons card_UN_disjoint Suc.hyps algebra_simps) |
|
5323 |
qed |
|
5324 |
||
66358
fab9a53158f8
slightly generalized card_lists_distinct_length_eq; renamed specialized card_lists_distinct_length_eq to card_lists_distinct_length_eq'; tuned
bulwahn
parents:
66257
diff
changeset
|
5325 |
lemma card_lists_distinct_length_eq': |
fab9a53158f8
slightly generalized card_lists_distinct_length_eq; renamed specialized card_lists_distinct_length_eq to card_lists_distinct_length_eq'; tuned
bulwahn
parents:
66257
diff
changeset
|
5326 |
assumes "k < card A" |
fab9a53158f8
slightly generalized card_lists_distinct_length_eq; renamed specialized card_lists_distinct_length_eq to card_lists_distinct_length_eq'; tuned
bulwahn
parents:
66257
diff
changeset
|
5327 |
shows "card {xs. length xs = k \<and> distinct xs \<and> set xs \<subseteq> A} = \<Prod>{card A - k + 1 .. card A}" |
fab9a53158f8
slightly generalized card_lists_distinct_length_eq; renamed specialized card_lists_distinct_length_eq to card_lists_distinct_length_eq'; tuned
bulwahn
parents:
66257
diff
changeset
|
5328 |
proof - |
fab9a53158f8
slightly generalized card_lists_distinct_length_eq; renamed specialized card_lists_distinct_length_eq to card_lists_distinct_length_eq'; tuned
bulwahn
parents:
66257
diff
changeset
|
5329 |
from \<open>k < card A\<close> have "finite A" and "k \<le> card A" using card_infinite by force+ |
fab9a53158f8
slightly generalized card_lists_distinct_length_eq; renamed specialized card_lists_distinct_length_eq to card_lists_distinct_length_eq'; tuned
bulwahn
parents:
66257
diff
changeset
|
5330 |
from this show ?thesis by (rule card_lists_distinct_length_eq) |
fab9a53158f8
slightly generalized card_lists_distinct_length_eq; renamed specialized card_lists_distinct_length_eq to card_lists_distinct_length_eq'; tuned
bulwahn
parents:
66257
diff
changeset
|
5331 |
qed |
fab9a53158f8
slightly generalized card_lists_distinct_length_eq; renamed specialized card_lists_distinct_length_eq to card_lists_distinct_length_eq'; tuned
bulwahn
parents:
66257
diff
changeset
|
5332 |
|
67091 | 5333 |
lemma infinite_UNIV_listI: "\<not> finite(UNIV::'a list set)" |
68719 | 5334 |
by (metis UNIV_I finite_maxlen length_replicate less_irrefl) |
28642 | 5335 |
|
71404
f2b783abfbe7
A few lemmas connected with orderings
paulson <lp15@cam.ac.uk>
parents:
71393
diff
changeset
|
5336 |
lemma same_length_different: |
f2b783abfbe7
A few lemmas connected with orderings
paulson <lp15@cam.ac.uk>
parents:
71393
diff
changeset
|
5337 |
assumes "xs \<noteq> ys" and "length xs = length ys" |
f2b783abfbe7
A few lemmas connected with orderings
paulson <lp15@cam.ac.uk>
parents:
71393
diff
changeset
|
5338 |
shows "\<exists>pre x xs' y ys'. x\<noteq>y \<and> xs = pre @ [x] @ xs' \<and> ys = pre @ [y] @ ys'" |
f2b783abfbe7
A few lemmas connected with orderings
paulson <lp15@cam.ac.uk>
parents:
71393
diff
changeset
|
5339 |
using assms |
f2b783abfbe7
A few lemmas connected with orderings
paulson <lp15@cam.ac.uk>
parents:
71393
diff
changeset
|
5340 |
proof (induction xs arbitrary: ys) |
f2b783abfbe7
A few lemmas connected with orderings
paulson <lp15@cam.ac.uk>
parents:
71393
diff
changeset
|
5341 |
case Nil |
f2b783abfbe7
A few lemmas connected with orderings
paulson <lp15@cam.ac.uk>
parents:
71393
diff
changeset
|
5342 |
then show ?case by auto |
f2b783abfbe7
A few lemmas connected with orderings
paulson <lp15@cam.ac.uk>
parents:
71393
diff
changeset
|
5343 |
next |
f2b783abfbe7
A few lemmas connected with orderings
paulson <lp15@cam.ac.uk>
parents:
71393
diff
changeset
|
5344 |
case (Cons x xs) |
f2b783abfbe7
A few lemmas connected with orderings
paulson <lp15@cam.ac.uk>
parents:
71393
diff
changeset
|
5345 |
then obtain z zs where ys: "ys = Cons z zs" |
f2b783abfbe7
A few lemmas connected with orderings
paulson <lp15@cam.ac.uk>
parents:
71393
diff
changeset
|
5346 |
by (metis length_Suc_conv) |
f2b783abfbe7
A few lemmas connected with orderings
paulson <lp15@cam.ac.uk>
parents:
71393
diff
changeset
|
5347 |
show ?case |
f2b783abfbe7
A few lemmas connected with orderings
paulson <lp15@cam.ac.uk>
parents:
71393
diff
changeset
|
5348 |
proof (cases "x=z") |
f2b783abfbe7
A few lemmas connected with orderings
paulson <lp15@cam.ac.uk>
parents:
71393
diff
changeset
|
5349 |
case True |
f2b783abfbe7
A few lemmas connected with orderings
paulson <lp15@cam.ac.uk>
parents:
71393
diff
changeset
|
5350 |
then have "xs \<noteq> zs" "length xs = length zs" |
f2b783abfbe7
A few lemmas connected with orderings
paulson <lp15@cam.ac.uk>
parents:
71393
diff
changeset
|
5351 |
using Cons.prems ys by auto |
f2b783abfbe7
A few lemmas connected with orderings
paulson <lp15@cam.ac.uk>
parents:
71393
diff
changeset
|
5352 |
then obtain pre u xs' v ys' where "u\<noteq>v" and xs: "xs = pre @ [u] @ xs'" and zs: "zs = pre @ [v] @ys'" |
f2b783abfbe7
A few lemmas connected with orderings
paulson <lp15@cam.ac.uk>
parents:
71393
diff
changeset
|
5353 |
using Cons.IH by meson |
f2b783abfbe7
A few lemmas connected with orderings
paulson <lp15@cam.ac.uk>
parents:
71393
diff
changeset
|
5354 |
then have "x # xs = (z#pre) @ [u] @ xs' \<and> ys = (z#pre) @ [v] @ ys'" |
f2b783abfbe7
A few lemmas connected with orderings
paulson <lp15@cam.ac.uk>
parents:
71393
diff
changeset
|
5355 |
by (simp add: True ys) |
f2b783abfbe7
A few lemmas connected with orderings
paulson <lp15@cam.ac.uk>
parents:
71393
diff
changeset
|
5356 |
with \<open>u\<noteq>v\<close> show ?thesis |
f2b783abfbe7
A few lemmas connected with orderings
paulson <lp15@cam.ac.uk>
parents:
71393
diff
changeset
|
5357 |
by blast |
f2b783abfbe7
A few lemmas connected with orderings
paulson <lp15@cam.ac.uk>
parents:
71393
diff
changeset
|
5358 |
next |
f2b783abfbe7
A few lemmas connected with orderings
paulson <lp15@cam.ac.uk>
parents:
71393
diff
changeset
|
5359 |
case False |
f2b783abfbe7
A few lemmas connected with orderings
paulson <lp15@cam.ac.uk>
parents:
71393
diff
changeset
|
5360 |
then have "x # xs = [] @ [x] @ xs \<and> ys = [] @ [z] @ zs" |
f2b783abfbe7
A few lemmas connected with orderings
paulson <lp15@cam.ac.uk>
parents:
71393
diff
changeset
|
5361 |
by (simp add: ys) |
f2b783abfbe7
A few lemmas connected with orderings
paulson <lp15@cam.ac.uk>
parents:
71393
diff
changeset
|
5362 |
then show ?thesis |
f2b783abfbe7
A few lemmas connected with orderings
paulson <lp15@cam.ac.uk>
parents:
71393
diff
changeset
|
5363 |
using False by blast |
f2b783abfbe7
A few lemmas connected with orderings
paulson <lp15@cam.ac.uk>
parents:
71393
diff
changeset
|
5364 |
qed |
f2b783abfbe7
A few lemmas connected with orderings
paulson <lp15@cam.ac.uk>
parents:
71393
diff
changeset
|
5365 |
qed |
28642 | 5366 |
|
60758 | 5367 |
subsection \<open>Sorting\<close> |
5368 |
||
69593 | 5369 |
subsubsection \<open>\<^const>\<open>sorted_wrt\<close>\<close> |
5370 |
||
5371 |
text \<open>Sometimes the second equation in the definition of \<^const>\<open>sorted_wrt\<close> is too aggressive |
|
68125 | 5372 |
because it relates each list element to \emph{all} its successors. Then this equation |
5373 |
should be removed and \<open>sorted_wrt2_simps\<close> should be added instead.\<close> |
|
5374 |
||
5375 |
lemma sorted_wrt1: "sorted_wrt P [x] = True" |
|
5376 |
by(simp) |
|
5377 |
||
5378 |
lemma sorted_wrt2: "transp P \<Longrightarrow> sorted_wrt P (x # y # zs) = (P x y \<and> sorted_wrt P (y # zs))" |
|
68719 | 5379 |
proof (induction zs arbitrary: x y) |
5380 |
case (Cons z zs) |
|
5381 |
then show ?case |
|
5382 |
by simp (meson transpD)+ |
|
5383 |
qed auto |
|
68125 | 5384 |
|
5385 |
lemmas sorted_wrt2_simps = sorted_wrt1 sorted_wrt2 |
|
66434
5d7e770c7d5d
added sorted_wrt to List; added Data_Structures/Binomial_Heap.thy
nipkow
parents:
66358
diff
changeset
|
5386 |
|
68141 | 5387 |
lemma sorted_wrt_true [simp]: |
5388 |
"sorted_wrt (\<lambda>_ _. True) xs" |
|
5389 |
by (induction xs) simp_all |
|
5390 |
||
66434
5d7e770c7d5d
added sorted_wrt to List; added Data_Structures/Binomial_Heap.thy
nipkow
parents:
66358
diff
changeset
|
5391 |
lemma sorted_wrt_append: |
68109 | 5392 |
"sorted_wrt P (xs @ ys) \<longleftrightarrow> |
66892 | 5393 |
sorted_wrt P xs \<and> sorted_wrt P ys \<and> (\<forall>x\<in>set xs. \<forall>y\<in>set ys. P x y)" |
68109 | 5394 |
by (induction xs) auto |
66890
e92d48a42a01
drop a superfluous assumption that was found by the find_unused_assms command and tune proof
bulwahn
parents:
66889
diff
changeset
|
5395 |
|
68141 | 5396 |
lemma sorted_wrt_map: |
5397 |
"sorted_wrt R (map f xs) = sorted_wrt (\<lambda>x y. R (f x) (f y)) xs" |
|
5398 |
by (induction xs) simp_all |
|
5399 |
||
71444 | 5400 |
lemma |
5401 |
assumes "sorted_wrt f xs" |
|
5402 |
shows sorted_wrt_take: "sorted_wrt f (take n xs)" |
|
5403 |
and sorted_wrt_drop: "sorted_wrt f (drop n xs)" |
|
5404 |
proof - |
|
5405 |
from assms have "sorted_wrt f (take n xs @ drop n xs)" by simp |
|
5406 |
thus "sorted_wrt f (take n xs)" and "sorted_wrt f (drop n xs)" |
|
5407 |
unfolding sorted_wrt_append by simp_all |
|
5408 |
qed |
|
5409 |
||
5410 |
lemma sorted_wrt_filter: |
|
5411 |
"sorted_wrt f xs \<Longrightarrow> sorted_wrt f (filter P xs)" |
|
5412 |
by (induction xs) auto |
|
5413 |
||
66890
e92d48a42a01
drop a superfluous assumption that was found by the find_unused_assms command and tune proof
bulwahn
parents:
66889
diff
changeset
|
5414 |
lemma sorted_wrt_rev: |
e92d48a42a01
drop a superfluous assumption that was found by the find_unused_assms command and tune proof
bulwahn
parents:
66889
diff
changeset
|
5415 |
"sorted_wrt P (rev xs) = sorted_wrt (\<lambda>x y. P y x) xs" |
68109 | 5416 |
by (induction xs) (auto simp add: sorted_wrt_append) |
66434
5d7e770c7d5d
added sorted_wrt to List; added Data_Structures/Binomial_Heap.thy
nipkow
parents:
66358
diff
changeset
|
5417 |
|
68141 | 5418 |
lemma sorted_wrt_mono_rel: |
5419 |
"(\<And>x y. \<lbrakk> x \<in> set xs; y \<in> set xs; P x y \<rbrakk> \<Longrightarrow> Q x y) \<Longrightarrow> sorted_wrt P xs \<Longrightarrow> sorted_wrt Q xs" |
|
68109 | 5420 |
by(induction xs)(auto) |
66442 | 5421 |
|
67973 | 5422 |
lemma sorted_wrt01: "length xs \<le> 1 \<Longrightarrow> sorted_wrt P xs" |
5423 |
by(auto simp: le_Suc_eq length_Suc_conv) |
|
5424 |
||
68175 | 5425 |
lemma sorted_wrt_iff_nth_less: |
68156 | 5426 |
"sorted_wrt P xs = (\<forall>i j. i < j \<longrightarrow> j < length xs \<longrightarrow> P (xs ! i) (xs ! j))" |
68719 | 5427 |
by (induction xs) (auto simp add: in_set_conv_nth Ball_def nth_Cons split: nat.split) |
68156 | 5428 |
|
5429 |
lemma sorted_wrt_nth_less: |
|
5430 |
"\<lbrakk> sorted_wrt P xs; i < j; j < length xs \<rbrakk> \<Longrightarrow> P (xs ! i) (xs ! j)" |
|
68175 | 5431 |
by(auto simp: sorted_wrt_iff_nth_less) |
66434
5d7e770c7d5d
added sorted_wrt to List; added Data_Structures/Binomial_Heap.thy
nipkow
parents:
66358
diff
changeset
|
5432 |
|
68141 | 5433 |
lemma sorted_wrt_upt[simp]: "sorted_wrt (<) [m..<n]" |
66434
5d7e770c7d5d
added sorted_wrt to List; added Data_Structures/Binomial_Heap.thy
nipkow
parents:
66358
diff
changeset
|
5434 |
by(induction n) (auto simp: sorted_wrt_append) |
5d7e770c7d5d
added sorted_wrt to List; added Data_Structures/Binomial_Heap.thy
nipkow
parents:
66358
diff
changeset
|
5435 |
|
68191 | 5436 |
lemma sorted_wrt_upto[simp]: "sorted_wrt (<) [i..j]" |
68719 | 5437 |
proof(induct i j rule:upto.induct) |
5438 |
case (1 i j) |
|
5439 |
from this show ?case |
|
5440 |
unfolding upto.simps[of i j] by auto |
|
5441 |
qed |
|
68175 | 5442 |
|
66434
5d7e770c7d5d
added sorted_wrt to List; added Data_Structures/Binomial_Heap.thy
nipkow
parents:
66358
diff
changeset
|
5443 |
text \<open>Each element is greater or equal to its index:\<close> |
5d7e770c7d5d
added sorted_wrt to List; added Data_Structures/Binomial_Heap.thy
nipkow
parents:
66358
diff
changeset
|
5444 |
|
5d7e770c7d5d
added sorted_wrt to List; added Data_Structures/Binomial_Heap.thy
nipkow
parents:
66358
diff
changeset
|
5445 |
lemma sorted_wrt_less_idx: |
67399 | 5446 |
"sorted_wrt (<) ns \<Longrightarrow> i < length ns \<Longrightarrow> i \<le> ns!i" |
66434
5d7e770c7d5d
added sorted_wrt to List; added Data_Structures/Binomial_Heap.thy
nipkow
parents:
66358
diff
changeset
|
5447 |
proof (induction ns arbitrary: i rule: rev_induct) |
5d7e770c7d5d
added sorted_wrt to List; added Data_Structures/Binomial_Heap.thy
nipkow
parents:
66358
diff
changeset
|
5448 |
case Nil thus ?case by simp |
5d7e770c7d5d
added sorted_wrt to List; added Data_Structures/Binomial_Heap.thy
nipkow
parents:
66358
diff
changeset
|
5449 |
next |
5d7e770c7d5d
added sorted_wrt to List; added Data_Structures/Binomial_Heap.thy
nipkow
parents:
66358
diff
changeset
|
5450 |
case snoc |
5d7e770c7d5d
added sorted_wrt to List; added Data_Structures/Binomial_Heap.thy
nipkow
parents:
66358
diff
changeset
|
5451 |
thus ?case |
5d7e770c7d5d
added sorted_wrt to List; added Data_Structures/Binomial_Heap.thy
nipkow
parents:
66358
diff
changeset
|
5452 |
by (auto simp: nth_append sorted_wrt_append) |
66892 | 5453 |
(metis less_antisym not_less nth_mem) |
66434
5d7e770c7d5d
added sorted_wrt to List; added Data_Structures/Binomial_Heap.thy
nipkow
parents:
66358
diff
changeset
|
5454 |
qed |
5d7e770c7d5d
added sorted_wrt to List; added Data_Structures/Binomial_Heap.thy
nipkow
parents:
66358
diff
changeset
|
5455 |
|
5d7e770c7d5d
added sorted_wrt to List; added Data_Structures/Binomial_Heap.thy
nipkow
parents:
66358
diff
changeset
|
5456 |
|
69593 | 5457 |
subsubsection \<open>\<^const>\<open>sorted\<close>\<close> |
24617 | 5458 |
|
24616 | 5459 |
context linorder |
5460 |
begin |
|
5461 |
||
69593 | 5462 |
text \<open>Sometimes the second equation in the definition of \<^const>\<open>sorted\<close> is too aggressive |
68111 | 5463 |
because it relates each list element to \emph{all} its successors. Then this equation |
68118 | 5464 |
should be removed and \<open>sorted2_simps\<close> should be added instead. |
5465 |
Executable code is one such use case.\<close> |
|
5466 |
||
5467 |
lemma sorted1: "sorted [x] = True" |
|
68111 | 5468 |
by simp |
5469 |
||
5470 |
lemma sorted2: "sorted (x # y # zs) = (x \<le> y \<and> sorted (y # zs))" |
|
5471 |
by(induction zs) auto |
|
5472 |
||
5473 |
lemmas sorted2_simps = sorted1 sorted2 |
|
5474 |
||
68118 | 5475 |
lemmas [code] = sorted.simps(1) sorted2_simps |
5476 |
||
68175 | 5477 |
lemma sorted_append: |
5478 |
"sorted (xs@ys) = (sorted xs \<and> sorted ys \<and> (\<forall>x \<in> set xs. \<forall>y \<in> set ys. x\<le>y))" |
|
5479 |
by (simp add: sorted_sorted_wrt sorted_wrt_append) |
|
5480 |
||
5481 |
lemma sorted_map: |
|
5482 |
"sorted (map f xs) = sorted_wrt (\<lambda>x y. f x \<le> f y) xs" |
|
5483 |
by (simp add: sorted_sorted_wrt sorted_wrt_map) |
|
5484 |
||
68160 | 5485 |
lemma sorted01: "length xs \<le> 1 \<Longrightarrow> sorted xs" |
5486 |
by (simp add: sorted_sorted_wrt sorted_wrt01) |
|
5487 |
||
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
|
5488 |
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
|
5489 |
"sorted xs \<Longrightarrow> sorted (tl xs)" |
68109 | 5490 |
by (cases xs) (simp_all) |
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
|
5491 |
|
68186 | 5492 |
lemma sorted_iff_nth_mono_less: |
68175 | 5493 |
"sorted xs = (\<forall>i j. i < j \<longrightarrow> j < length xs \<longrightarrow> xs ! i \<le> xs ! j)" |
5494 |
by (simp add: sorted_sorted_wrt sorted_wrt_iff_nth_less) |
|
24616 | 5495 |
|
68186 | 5496 |
lemma sorted_iff_nth_mono: |
5497 |
"sorted xs = (\<forall>i j. i \<le> j \<longrightarrow> j < length xs \<longrightarrow> xs ! i \<le> xs ! j)" |
|
5498 |
by (auto simp: sorted_iff_nth_mono_less nat_less_le) |
|
5499 |
||
31201 | 5500 |
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
|
5501 |
"sorted xs \<Longrightarrow> i \<le> j \<Longrightarrow> j < length xs \<Longrightarrow> xs!i \<le> xs!j" |
68186 | 5502 |
by (auto simp: sorted_iff_nth_mono) |
31201 | 5503 |
|
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
|
5504 |
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
|
5505 |
"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
|
5506 |
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
|
5507 |
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
|
5508 |
by auto |
68176 | 5509 |
|
66434
5d7e770c7d5d
added sorted_wrt to List; added Data_Structures/Binomial_Heap.thy
nipkow
parents:
66358
diff
changeset
|
5510 |
lemma sorted_map_remove1: |
5d7e770c7d5d
added sorted_wrt to List; added Data_Structures/Binomial_Heap.thy
nipkow
parents:
66358
diff
changeset
|
5511 |
"sorted (map f xs) \<Longrightarrow> sorted (map f (remove1 x xs))" |
68109 | 5512 |
by (induct xs) (auto) |
66434
5d7e770c7d5d
added sorted_wrt to List; added Data_Structures/Binomial_Heap.thy
nipkow
parents:
66358
diff
changeset
|
5513 |
|
5d7e770c7d5d
added sorted_wrt to List; added Data_Structures/Binomial_Heap.thy
nipkow
parents:
66358
diff
changeset
|
5514 |
lemma sorted_remove1: "sorted xs \<Longrightarrow> sorted (remove1 a xs)" |
5d7e770c7d5d
added sorted_wrt to List; added Data_Structures/Binomial_Heap.thy
nipkow
parents:
66358
diff
changeset
|
5515 |
using sorted_map_remove1 [of "\<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
|
5516 |
|
36851 | 5517 |
lemma sorted_butlast: |
5518 |
assumes "xs \<noteq> []" and "sorted xs" |
|
5519 |
shows "sorted (butlast xs)" |
|
5520 |
proof - |
|
66434
5d7e770c7d5d
added sorted_wrt to List; added Data_Structures/Binomial_Heap.thy
nipkow
parents:
66358
diff
changeset
|
5521 |
from \<open>xs \<noteq> []\<close> obtain ys y where "xs = ys @ [y]" |
5d7e770c7d5d
added sorted_wrt to List; added Data_Structures/Binomial_Heap.thy
nipkow
parents:
66358
diff
changeset
|
5522 |
by (cases xs rule: rev_cases) auto |
60758 | 5523 |
with \<open>sorted xs\<close> show ?thesis by (simp add: sorted_append) |
36851 | 5524 |
qed |
64963 | 5525 |
|
66905 | 5526 |
lemma sorted_replicate [simp]: "sorted(replicate n x)" |
68109 | 5527 |
by(induction n) (auto) |
66905 | 5528 |
|
26143
314c0bcb7df7
Added useful general lemmas from the work with the HeapMonad
bulwahn
parents:
26073
diff
changeset
|
5529 |
lemma sorted_remdups[simp]: |
68109 | 5530 |
"sorted xs \<Longrightarrow> sorted (remdups xs)" |
5531 |
by (induct xs) (auto) |
|
26143
314c0bcb7df7
Added useful general lemmas from the work with the HeapMonad
bulwahn
parents:
26073
diff
changeset
|
5532 |
|
53721
ccaceea6c768
added two functions to List (one contributed by Manuel Eberl)
traytel
parents:
53689
diff
changeset
|
5533 |
lemma sorted_remdups_adj[simp]: |
ccaceea6c768
added two functions to List (one contributed by Manuel Eberl)
traytel
parents:
53689
diff
changeset
|
5534 |
"sorted xs \<Longrightarrow> sorted (remdups_adj xs)" |
68109 | 5535 |
by (induct xs rule: remdups_adj.induct, simp_all split: if_split_asm) |
53721
ccaceea6c768
added two functions to List (one contributed by Manuel Eberl)
traytel
parents:
53689
diff
changeset
|
5536 |
|
66853 | 5537 |
lemma sorted_nths: "sorted xs \<Longrightarrow> sorted (nths xs I)" |
68109 | 5538 |
by(induction xs arbitrary: I)(auto simp: nths_Cons) |
66853 | 5539 |
|
24645 | 5540 |
lemma sorted_distinct_set_unique: |
5541 |
assumes "sorted xs" "distinct xs" "sorted ys" "distinct ys" "set xs = set ys" |
|
5542 |
shows "xs = ys" |
|
5543 |
proof - |
|
26734 | 5544 |
from assms have 1: "length xs = length ys" by (auto dest!: distinct_card) |
24645 | 5545 |
from assms show ?thesis |
5546 |
proof(induct rule:list_induct2[OF 1]) |
|
5547 |
case 1 show ?case by simp |
|
5548 |
next |
|
68109 | 5549 |
case 2 thus ?case by simp (metis Diff_insert_absorb antisym insertE insert_iff) |
24645 | 5550 |
qed |
5551 |
qed |
|
5552 |
||
35603 | 5553 |
lemma map_sorted_distinct_set_unique: |
5554 |
assumes "inj_on f (set xs \<union> set ys)" |
|
5555 |
assumes "sorted (map f xs)" "distinct (map f xs)" |
|
5556 |
"sorted (map f ys)" "distinct (map f ys)" |
|
5557 |
assumes "set xs = set ys" |
|
5558 |
shows "xs = ys" |
|
5559 |
proof - |
|
5560 |
from assms have "map f xs = map f ys" |
|
5561 |
by (simp add: sorted_distinct_set_unique) |
|
60758 | 5562 |
with \<open>inj_on f (set xs \<union> set ys)\<close> show "xs = ys" |
35603 | 5563 |
by (blast intro: map_inj_on) |
5564 |
qed |
|
5565 |
||
39915
ecf97cf3d248
turned distinct and sorted into inductive predicates: yields nice induction principles for free; more elegant proofs
haftmann
parents:
39774
diff
changeset
|
5566 |
lemma |
ecf97cf3d248
turned distinct and sorted into inductive predicates: yields nice induction principles for free; more elegant proofs
haftmann
parents:
39774
diff
changeset
|
5567 |
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
|
5568 |
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
|
5569 |
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
|
5570 |
proof - |
ecf97cf3d248
turned distinct and sorted into inductive predicates: yields nice induction principles for free; more elegant proofs
haftmann
parents:
39774
diff
changeset
|
5571 |
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
|
5572 |
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
|
5573 |
unfolding sorted_append by simp_all |
29626 | 5574 |
qed |
5575 |
||
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
|
5576 |
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
|
5577 |
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
|
5578 |
|
603320b93668
New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents:
33593
diff
changeset
|
5579 |
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
|
5580 |
by (subst takeWhile_eq_take) (auto dest: sorted_take) |
29626 | 5581 |
|
34933 | 5582 |
lemma sorted_filter: |
5583 |
"sorted (map f xs) \<Longrightarrow> sorted (map f (filter P xs))" |
|
68109 | 5584 |
by (induct xs) simp_all |
34933 | 5585 |
|
5586 |
lemma foldr_max_sorted: |
|
5587 |
assumes "sorted (rev xs)" |
|
5588 |
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
|
5589 |
using assms |
a14d2a854c02
tuned proofs -- clarified flow of facts wrt. calculation;
wenzelm
parents:
53017
diff
changeset
|
5590 |
proof (induct xs) |
34933 | 5591 |
case (Cons x xs) |
53374
a14d2a854c02
tuned proofs -- clarified flow of facts wrt. calculation;
wenzelm
parents:
53017
diff
changeset
|
5592 |
then have "sorted (rev xs)" using sorted_append by auto |
a14d2a854c02
tuned proofs -- clarified flow of facts wrt. calculation;
wenzelm
parents:
53017
diff
changeset
|
5593 |
with Cons show ?case |
a14d2a854c02
tuned proofs -- clarified flow of facts wrt. calculation;
wenzelm
parents:
53017
diff
changeset
|
5594 |
by (cases xs) (auto simp add: sorted_append max_def) |
34933 | 5595 |
qed simp |
5596 |
||
5597 |
lemma filter_equals_takeWhile_sorted_rev: |
|
5598 |
assumes sorted: "sorted (rev (map f xs))" |
|
68249
949d93804740
First step to remove nonstandard "[x <- xs. P]" syntax: only input
nipkow
parents:
68215
diff
changeset
|
5599 |
shows "filter (\<lambda>x. t < f x) xs = takeWhile (\<lambda> x. t < f x) xs" |
34933 | 5600 |
(is "filter ?P xs = ?tW") |
5601 |
proof (rule takeWhile_eq_filter[symmetric]) |
|
5602 |
let "?dW" = "dropWhile ?P xs" |
|
5603 |
fix x assume "x \<in> set ?dW" |
|
5604 |
then obtain i where i: "i < length ?dW" and nth_i: "x = ?dW ! i" |
|
5605 |
unfolding in_set_conv_nth by auto |
|
5606 |
hence "length ?tW + i < length (?tW @ ?dW)" |
|
5607 |
unfolding length_append by simp |
|
5608 |
hence i': "length (map f ?tW) + i < length (map f xs)" by simp |
|
5609 |
have "(map f ?tW @ map f ?dW) ! (length (map f ?tW) + i) \<le> |
|
5610 |
(map f ?tW @ map f ?dW) ! (length (map f ?tW) + 0)" |
|
5611 |
using sorted_rev_nth_mono[OF sorted _ i', of "length ?tW"] |
|
5612 |
unfolding map_append[symmetric] by simp |
|
5613 |
hence "f x \<le> f (?dW ! 0)" |
|
5614 |
unfolding nth_append_length_plus nth_i |
|
5615 |
using i preorder_class.le_less_trans[OF le0 i] by simp |
|
5616 |
also have "... \<le> t" |
|
5617 |
using hd_dropWhile[of "?P" xs] le0[THEN preorder_class.le_less_trans, OF i] |
|
5618 |
using hd_conv_nth[of "?dW"] by simp |
|
5619 |
finally show "\<not> t < f x" by simp |
|
5620 |
qed |
|
5621 |
||
66434
5d7e770c7d5d
added sorted_wrt to List; added Data_Structures/Binomial_Heap.thy
nipkow
parents:
66358
diff
changeset
|
5622 |
lemma sorted_map_same: |
68249
949d93804740
First step to remove nonstandard "[x <- xs. P]" syntax: only input
nipkow
parents:
68215
diff
changeset
|
5623 |
"sorted (map f (filter (\<lambda>x. f x = g xs) xs))" |
66434
5d7e770c7d5d
added sorted_wrt to List; added Data_Structures/Binomial_Heap.thy
nipkow
parents:
66358
diff
changeset
|
5624 |
proof (induct xs arbitrary: g) |
5d7e770c7d5d
added sorted_wrt to List; added Data_Structures/Binomial_Heap.thy
nipkow
parents:
66358
diff
changeset
|
5625 |
case Nil then show ?case by simp |
5d7e770c7d5d
added sorted_wrt to List; added Data_Structures/Binomial_Heap.thy
nipkow
parents:
66358
diff
changeset
|
5626 |
next |
5d7e770c7d5d
added sorted_wrt to List; added Data_Structures/Binomial_Heap.thy
nipkow
parents:
66358
diff
changeset
|
5627 |
case (Cons x xs) |
68249
949d93804740
First step to remove nonstandard "[x <- xs. P]" syntax: only input
nipkow
parents:
68215
diff
changeset
|
5628 |
then have "sorted (map f (filter (\<lambda>y. f y = (\<lambda>xs. f x) xs) xs))" . |
949d93804740
First step to remove nonstandard "[x <- xs. P]" syntax: only input
nipkow
parents:
68215
diff
changeset
|
5629 |
moreover from Cons have "sorted (map f (filter (\<lambda>y. f y = (g \<circ> Cons x) xs) xs))" . |
68109 | 5630 |
ultimately show ?case by simp_all |
66434
5d7e770c7d5d
added sorted_wrt to List; added Data_Structures/Binomial_Heap.thy
nipkow
parents:
66358
diff
changeset
|
5631 |
qed |
5d7e770c7d5d
added sorted_wrt to List; added Data_Structures/Binomial_Heap.thy
nipkow
parents:
66358
diff
changeset
|
5632 |
|
5d7e770c7d5d
added sorted_wrt to List; added Data_Structures/Binomial_Heap.thy
nipkow
parents:
66358
diff
changeset
|
5633 |
lemma sorted_same: |
68249
949d93804740
First step to remove nonstandard "[x <- xs. P]" syntax: only input
nipkow
parents:
68215
diff
changeset
|
5634 |
"sorted (filter (\<lambda>x. x = g xs) xs)" |
66434
5d7e770c7d5d
added sorted_wrt to List; added Data_Structures/Binomial_Heap.thy
nipkow
parents:
66358
diff
changeset
|
5635 |
using sorted_map_same [of "\<lambda>x. x"] by simp |
5d7e770c7d5d
added sorted_wrt to List; added Data_Structures/Binomial_Heap.thy
nipkow
parents:
66358
diff
changeset
|
5636 |
|
5d7e770c7d5d
added sorted_wrt to List; added Data_Structures/Binomial_Heap.thy
nipkow
parents:
66358
diff
changeset
|
5637 |
end |
5d7e770c7d5d
added sorted_wrt to List; added Data_Structures/Binomial_Heap.thy
nipkow
parents:
66358
diff
changeset
|
5638 |
|
68190 | 5639 |
lemma sorted_upt[simp]: "sorted [m..<n]" |
5640 |
by(simp add: sorted_sorted_wrt sorted_wrt_mono_rel[OF _ sorted_wrt_upt]) |
|
5641 |
||
5642 |
lemma sorted_upto[simp]: "sorted [m..n]" |
|
5643 |
by(simp add: sorted_sorted_wrt sorted_wrt_mono_rel[OF _ sorted_wrt_upto]) |
|
5644 |
||
66434
5d7e770c7d5d
added sorted_wrt to List; added Data_Structures/Binomial_Heap.thy
nipkow
parents:
66358
diff
changeset
|
5645 |
|
5d7e770c7d5d
added sorted_wrt to List; added Data_Structures/Binomial_Heap.thy
nipkow
parents:
66358
diff
changeset
|
5646 |
subsubsection \<open>Sorting functions\<close> |
5d7e770c7d5d
added sorted_wrt to List; added Data_Structures/Binomial_Heap.thy
nipkow
parents:
66358
diff
changeset
|
5647 |
|
69593 | 5648 |
text\<open>Currently it is not shown that \<^const>\<open>sort\<close> returns a |
66434
5d7e770c7d5d
added sorted_wrt to List; added Data_Structures/Binomial_Heap.thy
nipkow
parents:
66358
diff
changeset
|
5649 |
permutation of its input because the nicest proof is via multisets, |
66654 | 5650 |
which are not part of Main. Alternatively one could define a function |
66434
5d7e770c7d5d
added sorted_wrt to List; added Data_Structures/Binomial_Heap.thy
nipkow
parents:
66358
diff
changeset
|
5651 |
that counts the number of occurrences of an element in a list and use |
5d7e770c7d5d
added sorted_wrt to List; added Data_Structures/Binomial_Heap.thy
nipkow
parents:
66358
diff
changeset
|
5652 |
that instead of multisets to state the correctness property.\<close> |
5d7e770c7d5d
added sorted_wrt to List; added Data_Structures/Binomial_Heap.thy
nipkow
parents:
66358
diff
changeset
|
5653 |
|
5d7e770c7d5d
added sorted_wrt to List; added Data_Structures/Binomial_Heap.thy
nipkow
parents:
66358
diff
changeset
|
5654 |
context linorder |
5d7e770c7d5d
added sorted_wrt to List; added Data_Structures/Binomial_Heap.thy
nipkow
parents:
66358
diff
changeset
|
5655 |
begin |
5d7e770c7d5d
added sorted_wrt to List; added Data_Structures/Binomial_Heap.thy
nipkow
parents:
66358
diff
changeset
|
5656 |
|
5d7e770c7d5d
added sorted_wrt to List; added Data_Structures/Binomial_Heap.thy
nipkow
parents:
66358
diff
changeset
|
5657 |
lemma set_insort_key: |
5d7e770c7d5d
added sorted_wrt to List; added Data_Structures/Binomial_Heap.thy
nipkow
parents:
66358
diff
changeset
|
5658 |
"set (insort_key f x xs) = insert x (set xs)" |
5d7e770c7d5d
added sorted_wrt to List; added Data_Structures/Binomial_Heap.thy
nipkow
parents:
66358
diff
changeset
|
5659 |
by (induct xs) auto |
5d7e770c7d5d
added sorted_wrt to List; added Data_Structures/Binomial_Heap.thy
nipkow
parents:
66358
diff
changeset
|
5660 |
|
5d7e770c7d5d
added sorted_wrt to List; added Data_Structures/Binomial_Heap.thy
nipkow
parents:
66358
diff
changeset
|
5661 |
lemma length_insort [simp]: |
5d7e770c7d5d
added sorted_wrt to List; added Data_Structures/Binomial_Heap.thy
nipkow
parents:
66358
diff
changeset
|
5662 |
"length (insort_key f x xs) = Suc (length xs)" |
5d7e770c7d5d
added sorted_wrt to List; added Data_Structures/Binomial_Heap.thy
nipkow
parents:
66358
diff
changeset
|
5663 |
by (induct xs) simp_all |
5d7e770c7d5d
added sorted_wrt to List; added Data_Structures/Binomial_Heap.thy
nipkow
parents:
66358
diff
changeset
|
5664 |
|
5d7e770c7d5d
added sorted_wrt to List; added Data_Structures/Binomial_Heap.thy
nipkow
parents:
66358
diff
changeset
|
5665 |
lemma insort_key_left_comm: |
5d7e770c7d5d
added sorted_wrt to List; added Data_Structures/Binomial_Heap.thy
nipkow
parents:
66358
diff
changeset
|
5666 |
assumes "f x \<noteq> f y" |
5d7e770c7d5d
added sorted_wrt to List; added Data_Structures/Binomial_Heap.thy
nipkow
parents:
66358
diff
changeset
|
5667 |
shows "insort_key f y (insort_key f x xs) = insort_key f x (insort_key f y xs)" |
5d7e770c7d5d
added sorted_wrt to List; added Data_Structures/Binomial_Heap.thy
nipkow
parents:
66358
diff
changeset
|
5668 |
by (induct xs) (auto simp add: assms dest: antisym) |
5d7e770c7d5d
added sorted_wrt to List; added Data_Structures/Binomial_Heap.thy
nipkow
parents:
66358
diff
changeset
|
5669 |
|
5d7e770c7d5d
added sorted_wrt to List; added Data_Structures/Binomial_Heap.thy
nipkow
parents:
66358
diff
changeset
|
5670 |
lemma insort_left_comm: |
5d7e770c7d5d
added sorted_wrt to List; added Data_Structures/Binomial_Heap.thy
nipkow
parents:
66358
diff
changeset
|
5671 |
"insort x (insort y xs) = insort y (insort x xs)" |
5d7e770c7d5d
added sorted_wrt to List; added Data_Structures/Binomial_Heap.thy
nipkow
parents:
66358
diff
changeset
|
5672 |
by (cases "x = y") (auto intro: insort_key_left_comm) |
5d7e770c7d5d
added sorted_wrt to List; added Data_Structures/Binomial_Heap.thy
nipkow
parents:
66358
diff
changeset
|
5673 |
|
5d7e770c7d5d
added sorted_wrt to List; added Data_Structures/Binomial_Heap.thy
nipkow
parents:
66358
diff
changeset
|
5674 |
lemma comp_fun_commute_insort: "comp_fun_commute insort" |
5d7e770c7d5d
added sorted_wrt to List; added Data_Structures/Binomial_Heap.thy
nipkow
parents:
66358
diff
changeset
|
5675 |
proof |
5d7e770c7d5d
added sorted_wrt to List; added Data_Structures/Binomial_Heap.thy
nipkow
parents:
66358
diff
changeset
|
5676 |
qed (simp add: insort_left_comm fun_eq_iff) |
5d7e770c7d5d
added sorted_wrt to List; added Data_Structures/Binomial_Heap.thy
nipkow
parents:
66358
diff
changeset
|
5677 |
|
5d7e770c7d5d
added sorted_wrt to List; added Data_Structures/Binomial_Heap.thy
nipkow
parents:
66358
diff
changeset
|
5678 |
lemma sort_key_simps [simp]: |
5d7e770c7d5d
added sorted_wrt to List; added Data_Structures/Binomial_Heap.thy
nipkow
parents:
66358
diff
changeset
|
5679 |
"sort_key f [] = []" |
5d7e770c7d5d
added sorted_wrt to List; added Data_Structures/Binomial_Heap.thy
nipkow
parents:
66358
diff
changeset
|
5680 |
"sort_key f (x#xs) = insort_key f x (sort_key f xs)" |
5d7e770c7d5d
added sorted_wrt to List; added Data_Structures/Binomial_Heap.thy
nipkow
parents:
66358
diff
changeset
|
5681 |
by (simp_all add: sort_key_def) |
5d7e770c7d5d
added sorted_wrt to List; added Data_Structures/Binomial_Heap.thy
nipkow
parents:
66358
diff
changeset
|
5682 |
|
5d7e770c7d5d
added sorted_wrt to List; added Data_Structures/Binomial_Heap.thy
nipkow
parents:
66358
diff
changeset
|
5683 |
lemma sort_key_conv_fold: |
5d7e770c7d5d
added sorted_wrt to List; added Data_Structures/Binomial_Heap.thy
nipkow
parents:
66358
diff
changeset
|
5684 |
assumes "inj_on f (set xs)" |
5d7e770c7d5d
added sorted_wrt to List; added Data_Structures/Binomial_Heap.thy
nipkow
parents:
66358
diff
changeset
|
5685 |
shows "sort_key f xs = fold (insort_key f) xs []" |
5d7e770c7d5d
added sorted_wrt to List; added Data_Structures/Binomial_Heap.thy
nipkow
parents:
66358
diff
changeset
|
5686 |
proof - |
5d7e770c7d5d
added sorted_wrt to List; added Data_Structures/Binomial_Heap.thy
nipkow
parents:
66358
diff
changeset
|
5687 |
have "fold (insort_key f) (rev xs) = fold (insort_key f) xs" |
5d7e770c7d5d
added sorted_wrt to List; added Data_Structures/Binomial_Heap.thy
nipkow
parents:
66358
diff
changeset
|
5688 |
proof (rule fold_rev, rule ext) |
5d7e770c7d5d
added sorted_wrt to List; added Data_Structures/Binomial_Heap.thy
nipkow
parents:
66358
diff
changeset
|
5689 |
fix zs |
5d7e770c7d5d
added sorted_wrt to List; added Data_Structures/Binomial_Heap.thy
nipkow
parents:
66358
diff
changeset
|
5690 |
fix x y |
5d7e770c7d5d
added sorted_wrt to List; added Data_Structures/Binomial_Heap.thy
nipkow
parents:
66358
diff
changeset
|
5691 |
assume "x \<in> set xs" "y \<in> set xs" |
5d7e770c7d5d
added sorted_wrt to List; added Data_Structures/Binomial_Heap.thy
nipkow
parents:
66358
diff
changeset
|
5692 |
with assms have *: "f y = f x \<Longrightarrow> y = x" by (auto dest: inj_onD) |
5d7e770c7d5d
added sorted_wrt to List; added Data_Structures/Binomial_Heap.thy
nipkow
parents:
66358
diff
changeset
|
5693 |
have **: "x = y \<longleftrightarrow> y = x" by auto |
5d7e770c7d5d
added sorted_wrt to List; added Data_Structures/Binomial_Heap.thy
nipkow
parents:
66358
diff
changeset
|
5694 |
show "(insort_key f y \<circ> insort_key f x) zs = (insort_key f x \<circ> insort_key f y) zs" |
5d7e770c7d5d
added sorted_wrt to List; added Data_Structures/Binomial_Heap.thy
nipkow
parents:
66358
diff
changeset
|
5695 |
by (induct zs) (auto intro: * simp add: **) |
5d7e770c7d5d
added sorted_wrt to List; added Data_Structures/Binomial_Heap.thy
nipkow
parents:
66358
diff
changeset
|
5696 |
qed |
5d7e770c7d5d
added sorted_wrt to List; added Data_Structures/Binomial_Heap.thy
nipkow
parents:
66358
diff
changeset
|
5697 |
then show ?thesis by (simp add: sort_key_def foldr_conv_fold) |
5d7e770c7d5d
added sorted_wrt to List; added Data_Structures/Binomial_Heap.thy
nipkow
parents:
66358
diff
changeset
|
5698 |
qed |
5d7e770c7d5d
added sorted_wrt to List; added Data_Structures/Binomial_Heap.thy
nipkow
parents:
66358
diff
changeset
|
5699 |
|
5d7e770c7d5d
added sorted_wrt to List; added Data_Structures/Binomial_Heap.thy
nipkow
parents:
66358
diff
changeset
|
5700 |
lemma sort_conv_fold: |
5d7e770c7d5d
added sorted_wrt to List; added Data_Structures/Binomial_Heap.thy
nipkow
parents:
66358
diff
changeset
|
5701 |
"sort xs = fold insort xs []" |
5d7e770c7d5d
added sorted_wrt to List; added Data_Structures/Binomial_Heap.thy
nipkow
parents:
66358
diff
changeset
|
5702 |
by (rule sort_key_conv_fold) simp |
5d7e770c7d5d
added sorted_wrt to List; added Data_Structures/Binomial_Heap.thy
nipkow
parents:
66358
diff
changeset
|
5703 |
|
5d7e770c7d5d
added sorted_wrt to List; added Data_Structures/Binomial_Heap.thy
nipkow
parents:
66358
diff
changeset
|
5704 |
lemma length_sort[simp]: "length (sort_key f xs) = length xs" |
5d7e770c7d5d
added sorted_wrt to List; added Data_Structures/Binomial_Heap.thy
nipkow
parents:
66358
diff
changeset
|
5705 |
by (induct xs, auto) |
5d7e770c7d5d
added sorted_wrt to List; added Data_Structures/Binomial_Heap.thy
nipkow
parents:
66358
diff
changeset
|
5706 |
|
5d7e770c7d5d
added sorted_wrt to List; added Data_Structures/Binomial_Heap.thy
nipkow
parents:
66358
diff
changeset
|
5707 |
lemma set_sort[simp]: "set(sort_key f xs) = set xs" |
5d7e770c7d5d
added sorted_wrt to List; added Data_Structures/Binomial_Heap.thy
nipkow
parents:
66358
diff
changeset
|
5708 |
by (induct xs) (simp_all add: set_insort_key) |
5d7e770c7d5d
added sorted_wrt to List; added Data_Structures/Binomial_Heap.thy
nipkow
parents:
66358
diff
changeset
|
5709 |
|
5d7e770c7d5d
added sorted_wrt to List; added Data_Structures/Binomial_Heap.thy
nipkow
parents:
66358
diff
changeset
|
5710 |
lemma distinct_insort: "distinct (insort_key f x xs) = (x \<notin> set xs \<and> distinct xs)" |
5d7e770c7d5d
added sorted_wrt to List; added Data_Structures/Binomial_Heap.thy
nipkow
parents:
66358
diff
changeset
|
5711 |
by(induct xs)(auto simp: set_insort_key) |
5d7e770c7d5d
added sorted_wrt to List; added Data_Structures/Binomial_Heap.thy
nipkow
parents:
66358
diff
changeset
|
5712 |
|
5d7e770c7d5d
added sorted_wrt to List; added Data_Structures/Binomial_Heap.thy
nipkow
parents:
66358
diff
changeset
|
5713 |
lemma distinct_sort[simp]: "distinct (sort_key f xs) = distinct xs" |
5d7e770c7d5d
added sorted_wrt to List; added Data_Structures/Binomial_Heap.thy
nipkow
parents:
66358
diff
changeset
|
5714 |
by (induct xs) (simp_all add: distinct_insort) |
5d7e770c7d5d
added sorted_wrt to List; added Data_Structures/Binomial_Heap.thy
nipkow
parents:
66358
diff
changeset
|
5715 |
|
5d7e770c7d5d
added sorted_wrt to List; added Data_Structures/Binomial_Heap.thy
nipkow
parents:
66358
diff
changeset
|
5716 |
lemma sorted_insort_key: "sorted (map f (insort_key f x xs)) = sorted (map f xs)" |
68109 | 5717 |
by (induct xs) (auto simp: set_insort_key) |
66434
5d7e770c7d5d
added sorted_wrt to List; added Data_Structures/Binomial_Heap.thy
nipkow
parents:
66358
diff
changeset
|
5718 |
|
5d7e770c7d5d
added sorted_wrt to List; added Data_Structures/Binomial_Heap.thy
nipkow
parents:
66358
diff
changeset
|
5719 |
lemma sorted_insort: "sorted (insort x xs) = sorted xs" |
5d7e770c7d5d
added sorted_wrt to List; added Data_Structures/Binomial_Heap.thy
nipkow
parents:
66358
diff
changeset
|
5720 |
using sorted_insort_key [where f="\<lambda>x. x"] by simp |
5d7e770c7d5d
added sorted_wrt to List; added Data_Structures/Binomial_Heap.thy
nipkow
parents:
66358
diff
changeset
|
5721 |
|
5d7e770c7d5d
added sorted_wrt to List; added Data_Structures/Binomial_Heap.thy
nipkow
parents:
66358
diff
changeset
|
5722 |
theorem sorted_sort_key [simp]: "sorted (map f (sort_key f xs))" |
5d7e770c7d5d
added sorted_wrt to List; added Data_Structures/Binomial_Heap.thy
nipkow
parents:
66358
diff
changeset
|
5723 |
by (induct xs) (auto simp:sorted_insort_key) |
5d7e770c7d5d
added sorted_wrt to List; added Data_Structures/Binomial_Heap.thy
nipkow
parents:
66358
diff
changeset
|
5724 |
|
5d7e770c7d5d
added sorted_wrt to List; added Data_Structures/Binomial_Heap.thy
nipkow
parents:
66358
diff
changeset
|
5725 |
theorem sorted_sort [simp]: "sorted (sort xs)" |
5d7e770c7d5d
added sorted_wrt to List; added Data_Structures/Binomial_Heap.thy
nipkow
parents:
66358
diff
changeset
|
5726 |
using sorted_sort_key [where f="\<lambda>x. x"] by simp |
5d7e770c7d5d
added sorted_wrt to List; added Data_Structures/Binomial_Heap.thy
nipkow
parents:
66358
diff
changeset
|
5727 |
|
5d7e770c7d5d
added sorted_wrt to List; added Data_Structures/Binomial_Heap.thy
nipkow
parents:
66358
diff
changeset
|
5728 |
lemma insort_not_Nil [simp]: |
5d7e770c7d5d
added sorted_wrt to List; added Data_Structures/Binomial_Heap.thy
nipkow
parents:
66358
diff
changeset
|
5729 |
"insort_key f a xs \<noteq> []" |
5d7e770c7d5d
added sorted_wrt to List; added Data_Structures/Binomial_Heap.thy
nipkow
parents:
66358
diff
changeset
|
5730 |
by (induction xs) simp_all |
5d7e770c7d5d
added sorted_wrt to List; added Data_Structures/Binomial_Heap.thy
nipkow
parents:
66358
diff
changeset
|
5731 |
|
5d7e770c7d5d
added sorted_wrt to List; added Data_Structures/Binomial_Heap.thy
nipkow
parents:
66358
diff
changeset
|
5732 |
lemma insort_is_Cons: "\<forall>x\<in>set xs. f a \<le> f x \<Longrightarrow> insort_key f a xs = a # xs" |
5d7e770c7d5d
added sorted_wrt to List; added Data_Structures/Binomial_Heap.thy
nipkow
parents:
66358
diff
changeset
|
5733 |
by (cases xs) auto |
5d7e770c7d5d
added sorted_wrt to List; added Data_Structures/Binomial_Heap.thy
nipkow
parents:
66358
diff
changeset
|
5734 |
|
5d7e770c7d5d
added sorted_wrt to List; added Data_Structures/Binomial_Heap.thy
nipkow
parents:
66358
diff
changeset
|
5735 |
lemma sorted_sort_id: "sorted xs \<Longrightarrow> sort xs = xs" |
68109 | 5736 |
by (induct xs) (auto simp add: insort_is_Cons) |
66434
5d7e770c7d5d
added sorted_wrt to List; added Data_Structures/Binomial_Heap.thy
nipkow
parents:
66358
diff
changeset
|
5737 |
|
5d7e770c7d5d
added sorted_wrt to List; added Data_Structures/Binomial_Heap.thy
nipkow
parents:
66358
diff
changeset
|
5738 |
lemma insort_key_remove1: |
5d7e770c7d5d
added sorted_wrt to List; added Data_Structures/Binomial_Heap.thy
nipkow
parents:
66358
diff
changeset
|
5739 |
assumes "a \<in> set xs" and "sorted (map f xs)" and "hd (filter (\<lambda>x. f a = f x) xs) = a" |
5d7e770c7d5d
added sorted_wrt to List; added Data_Structures/Binomial_Heap.thy
nipkow
parents:
66358
diff
changeset
|
5740 |
shows "insort_key f a (remove1 a xs) = xs" |
5d7e770c7d5d
added sorted_wrt to List; added Data_Structures/Binomial_Heap.thy
nipkow
parents:
66358
diff
changeset
|
5741 |
using assms proof (induct xs) |
5d7e770c7d5d
added sorted_wrt to List; added Data_Structures/Binomial_Heap.thy
nipkow
parents:
66358
diff
changeset
|
5742 |
case (Cons x xs) |
5d7e770c7d5d
added sorted_wrt to List; added Data_Structures/Binomial_Heap.thy
nipkow
parents:
66358
diff
changeset
|
5743 |
then show ?case |
5d7e770c7d5d
added sorted_wrt to List; added Data_Structures/Binomial_Heap.thy
nipkow
parents:
66358
diff
changeset
|
5744 |
proof (cases "x = a") |
5d7e770c7d5d
added sorted_wrt to List; added Data_Structures/Binomial_Heap.thy
nipkow
parents:
66358
diff
changeset
|
5745 |
case False |
5d7e770c7d5d
added sorted_wrt to List; added Data_Structures/Binomial_Heap.thy
nipkow
parents:
66358
diff
changeset
|
5746 |
then have "f x \<noteq> f a" using Cons.prems by auto |
68109 | 5747 |
then have "f x < f a" using Cons.prems by auto |
5748 |
with \<open>f x \<noteq> f a\<close> show ?thesis using Cons by (auto simp: insort_is_Cons) |
|
5749 |
qed (auto simp: insort_is_Cons) |
|
66434
5d7e770c7d5d
added sorted_wrt to List; added Data_Structures/Binomial_Heap.thy
nipkow
parents:
66358
diff
changeset
|
5750 |
qed simp |
5d7e770c7d5d
added sorted_wrt to List; added Data_Structures/Binomial_Heap.thy
nipkow
parents:
66358
diff
changeset
|
5751 |
|
5d7e770c7d5d
added sorted_wrt to List; added Data_Structures/Binomial_Heap.thy
nipkow
parents:
66358
diff
changeset
|
5752 |
lemma insort_remove1: |
5d7e770c7d5d
added sorted_wrt to List; added Data_Structures/Binomial_Heap.thy
nipkow
parents:
66358
diff
changeset
|
5753 |
assumes "a \<in> set xs" and "sorted xs" |
5d7e770c7d5d
added sorted_wrt to List; added Data_Structures/Binomial_Heap.thy
nipkow
parents:
66358
diff
changeset
|
5754 |
shows "insort a (remove1 a xs) = xs" |
5d7e770c7d5d
added sorted_wrt to List; added Data_Structures/Binomial_Heap.thy
nipkow
parents:
66358
diff
changeset
|
5755 |
proof (rule insort_key_remove1) |
67399 | 5756 |
define n where "n = length (filter ((=) a) xs) - 1" |
66434
5d7e770c7d5d
added sorted_wrt to List; added Data_Structures/Binomial_Heap.thy
nipkow
parents:
66358
diff
changeset
|
5757 |
from \<open>a \<in> set xs\<close> show "a \<in> set xs" . |
5d7e770c7d5d
added sorted_wrt to List; added Data_Structures/Binomial_Heap.thy
nipkow
parents:
66358
diff
changeset
|
5758 |
from \<open>sorted xs\<close> show "sorted (map (\<lambda>x. x) xs)" by simp |
67399 | 5759 |
from \<open>a \<in> set xs\<close> have "a \<in> set (filter ((=) a) xs)" by auto |
5760 |
then have "set (filter ((=) a) xs) \<noteq> {}" by auto |
|
5761 |
then have "filter ((=) a) xs \<noteq> []" by (auto simp only: set_empty) |
|
5762 |
then have "length (filter ((=) a) xs) > 0" by simp |
|
5763 |
then have n: "Suc n = length (filter ((=) a) xs)" by (simp add: n_def) |
|
66434
5d7e770c7d5d
added sorted_wrt to List; added Data_Structures/Binomial_Heap.thy
nipkow
parents:
66358
diff
changeset
|
5764 |
moreover have "replicate (Suc n) a = a # replicate n a" |
5d7e770c7d5d
added sorted_wrt to List; added Data_Structures/Binomial_Heap.thy
nipkow
parents:
66358
diff
changeset
|
5765 |
by simp |
67399 | 5766 |
ultimately show "hd (filter ((=) a) xs) = a" by (simp add: replicate_length_filter) |
66434
5d7e770c7d5d
added sorted_wrt to List; added Data_Structures/Binomial_Heap.thy
nipkow
parents:
66358
diff
changeset
|
5767 |
qed |
5d7e770c7d5d
added sorted_wrt to List; added Data_Structures/Binomial_Heap.thy
nipkow
parents:
66358
diff
changeset
|
5768 |
|
5d7e770c7d5d
added sorted_wrt to List; added Data_Structures/Binomial_Heap.thy
nipkow
parents:
66358
diff
changeset
|
5769 |
lemma finite_sorted_distinct_unique: |
68719 | 5770 |
assumes "finite A" shows "\<exists>!xs. set xs = A \<and> sorted xs \<and> distinct xs" |
5771 |
proof - |
|
5772 |
obtain xs where "distinct xs" "A = set xs" |
|
5773 |
using finite_distinct_list [OF assms] by metis |
|
5774 |
then show ?thesis |
|
5775 |
by (rule_tac a="sort xs" in ex1I) (auto simp: sorted_distinct_set_unique) |
|
5776 |
qed |
|
66434
5d7e770c7d5d
added sorted_wrt to List; added Data_Structures/Binomial_Heap.thy
nipkow
parents:
66358
diff
changeset
|
5777 |
|
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
|
5778 |
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
|
5779 |
"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
|
5780 |
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
|
5781 |
|
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
|
5782 |
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
|
5783 |
"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
|
5784 |
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
|
5785 |
|
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
|
5786 |
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
|
5787 |
"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
|
5788 |
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
|
5789 |
|
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
|
5790 |
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
|
5791 |
"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
|
5792 |
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
|
5793 |
|
35608 | 5794 |
lemma set_insort_insert: |
5795 |
"set (insort_insert x xs) = insert x (set xs)" |
|
66434
5d7e770c7d5d
added sorted_wrt to List; added Data_Structures/Binomial_Heap.thy
nipkow
parents:
66358
diff
changeset
|
5796 |
by (auto simp add: insort_insert_key_def set_insort_key) |
35608 | 5797 |
|
5798 |
lemma distinct_insort_insert: |
|
5799 |
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
|
5800 |
shows "distinct (insort_insert_key f x xs)" |
66434
5d7e770c7d5d
added sorted_wrt to List; added Data_Structures/Binomial_Heap.thy
nipkow
parents:
66358
diff
changeset
|
5801 |
using assms by (induct xs) (auto simp add: insort_insert_key_def set_insort_key) |
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
|
5802 |
|
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
|
5803 |
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
|
5804 |
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
|
5805 |
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
|
5806 |
using assms by (simp add: insort_insert_key_def sorted_insort_key) |
35608 | 5807 |
|
5808 |
lemma sorted_insort_insert: |
|
5809 |
assumes "sorted xs" |
|
5810 |
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
|
5811 |
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
|
5812 |
|
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
|
5813 |
lemma filter_insort_triv: |
37107 | 5814 |
"\<not> P x \<Longrightarrow> filter P (insort_key f x xs) = filter P xs" |
5815 |
by (induct xs) simp_all |
|
5816 |
||
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
|
5817 |
lemma filter_insort: |
37107 | 5818 |
"sorted (map f xs) \<Longrightarrow> P x \<Longrightarrow> filter P (insort_key f x xs) = insort_key f x (filter P xs)" |
68109 | 5819 |
by (induct xs) (auto, subst insort_is_Cons, auto) |
37107 | 5820 |
|
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
|
5821 |
lemma filter_sort: |
37107 | 5822 |
"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
|
5823 |
by (induct xs) (simp_all add: filter_insort_triv filter_insort) |
37107 | 5824 |
|
5825 |
lemma remove1_insort [simp]: |
|
5826 |
"remove1 x (insort x xs) = xs" |
|
5827 |
by (induct xs) simp_all |
|
5828 |
||
24616 | 5829 |
end |
5830 |
||
68191 | 5831 |
lemma sort_upt [simp]: "sort [m..<n] = [m..<n]" |
5832 |
by (rule sorted_sort_id) simp |
|
5833 |
||
5834 |
lemma sort_upto [simp]: "sort [i..j] = [i..j]" |
|
5835 |
by (rule sorted_sort_id) simp |
|
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
|
5836 |
|
52379 | 5837 |
lemma sorted_find_Min: |
67479 | 5838 |
"sorted xs \<Longrightarrow> \<exists>x \<in> set xs. P x \<Longrightarrow> List.find P xs = Some (Min {x\<in>set xs. P x})" |
5839 |
proof (induct xs) |
|
52379 | 5840 |
case Nil then show ?case by simp |
5841 |
next |
|
67479 | 5842 |
case (Cons x xs) show ?case proof (cases "P x") |
5843 |
case True |
|
68109 | 5844 |
with Cons show ?thesis by (auto intro: Min_eqI [symmetric]) |
52379 | 5845 |
next |
5846 |
case False then have "{y. (y = x \<or> y \<in> set xs) \<and> P y} = {y \<in> set xs. P y}" |
|
5847 |
by auto |
|
68109 | 5848 |
with Cons False show ?thesis by (simp_all) |
52379 | 5849 |
qed |
5850 |
qed |
|
5851 |
||
66853 | 5852 |
lemma sorted_enumerate [simp]: "sorted (map fst (enumerate n xs))" |
5853 |
by (simp add: enumerate_eq_zip) |
|
58437 | 5854 |
|
69593 | 5855 |
text \<open>Stability of \<^const>\<open>sort_key\<close>:\<close> |
67684 | 5856 |
|
68249
949d93804740
First step to remove nonstandard "[x <- xs. P]" syntax: only input
nipkow
parents:
68215
diff
changeset
|
5857 |
lemma sort_key_stable: "filter (\<lambda>y. f y = k) (sort_key f xs) = filter (\<lambda>y. f y = k) xs" |
70296 | 5858 |
by (induction xs) (auto simp: filter_insort insort_is_Cons filter_insort_triv) |
66654 | 5859 |
|
67684 | 5860 |
corollary stable_sort_key_sort_key: "stable_sort_key sort_key" |
5861 |
by(simp add: stable_sort_key_def sort_key_stable) |
|
5862 |
||
67606 | 5863 |
lemma sort_key_const: "sort_key (\<lambda>x. c) xs = xs" |
67684 | 5864 |
by (metis (mono_tags) filter_True sort_key_stable) |
67606 | 5865 |
|
35115 | 5866 |
|
69593 | 5867 |
subsubsection \<open>\<^const>\<open>transpose\<close> on sorted lists\<close> |
34933 | 5868 |
|
66853 | 5869 |
lemma sorted_transpose[simp]: "sorted (rev (map length (transpose xs)))" |
68175 | 5870 |
by (auto simp: sorted_iff_nth_mono rev_nth nth_transpose |
34933 | 5871 |
length_filter_conv_card intro: card_mono) |
5872 |
||
5873 |
lemma transpose_max_length: |
|
68249
949d93804740
First step to remove nonstandard "[x <- xs. P]" syntax: only input
nipkow
parents:
68215
diff
changeset
|
5874 |
"foldr (\<lambda>xs. max (length xs)) (transpose xs) 0 = length (filter (\<lambda>x. x \<noteq> []) xs)" |
34933 | 5875 |
(is "?L = ?R") |
5876 |
proof (cases "transpose xs = []") |
|
5877 |
case False |
|
5878 |
have "?L = foldr max (map length (transpose xs)) 0" |
|
5879 |
by (simp add: foldr_map comp_def) |
|
5880 |
also have "... = length (transpose xs ! 0)" |
|
5881 |
using False sorted_transpose by (simp add: foldr_max_sorted) |
|
5882 |
finally show ?thesis |
|
5883 |
using False by (simp add: nth_transpose) |
|
5884 |
next |
|
5885 |
case True |
|
68249
949d93804740
First step to remove nonstandard "[x <- xs. P]" syntax: only input
nipkow
parents:
68215
diff
changeset
|
5886 |
hence "filter (\<lambda>x. x \<noteq> []) xs = []" |
34933 | 5887 |
by (auto intro!: filter_False simp: transpose_empty) |
5888 |
thus ?thesis by (simp add: transpose_empty True) |
|
5889 |
qed |
|
5890 |
||
5891 |
lemma length_transpose_sorted: |
|
5892 |
fixes xs :: "'a list list" |
|
5893 |
assumes sorted: "sorted (rev (map length xs))" |
|
5894 |
shows "length (transpose xs) = (if xs = [] then 0 else length (xs ! 0))" |
|
5895 |
proof (cases "xs = []") |
|
5896 |
case False |
|
5897 |
thus ?thesis |
|
5898 |
using foldr_max_sorted[OF sorted] False |
|
5899 |
unfolding length_transpose foldr_map comp_def |
|
5900 |
by simp |
|
5901 |
qed simp |
|
5902 |
||
5903 |
lemma nth_nth_transpose_sorted[simp]: |
|
5904 |
fixes xs :: "'a list list" |
|
5905 |
assumes sorted: "sorted (rev (map length xs))" |
|
5906 |
and i: "i < length (transpose xs)" |
|
68249
949d93804740
First step to remove nonstandard "[x <- xs. P]" syntax: only input
nipkow
parents:
68215
diff
changeset
|
5907 |
and j: "j < length (filter (\<lambda>ys. i < length ys) xs)" |
34933 | 5908 |
shows "transpose xs ! i ! j = xs ! j ! i" |
66853 | 5909 |
using j filter_equals_takeWhile_sorted_rev[OF sorted, of i] |
34933 | 5910 |
nth_transpose[OF i] nth_map[OF j] |
66853 | 5911 |
by (simp add: takeWhile_nth) |
34933 | 5912 |
|
5913 |
lemma transpose_column_length: |
|
5914 |
fixes xs :: "'a list list" |
|
5915 |
assumes sorted: "sorted (rev (map length xs))" and "i < length xs" |
|
5916 |
shows "length (filter (\<lambda>ys. i < length ys) (transpose xs)) = length (xs ! i)" |
|
5917 |
proof - |
|
60758 | 5918 |
have "xs \<noteq> []" using \<open>i < length xs\<close> by auto |
34933 | 5919 |
note filter_equals_takeWhile_sorted_rev[OF sorted, simp] |
5920 |
{ fix j assume "j \<le> i" |
|
60758 | 5921 |
note sorted_rev_nth_mono[OF sorted, of j i, simplified, OF this \<open>i < length xs\<close>] |
34933 | 5922 |
} note sortedE = this[consumes 1] |
5923 |
||
5924 |
have "{j. j < length (transpose xs) \<and> i < length (transpose xs ! j)} |
|
5925 |
= {..< length (xs ! i)}" |
|
5926 |
proof safe |
|
5927 |
fix j |
|
5928 |
assume "j < length (transpose xs)" and "i < length (transpose xs ! j)" |
|
5929 |
with this(2) nth_transpose[OF this(1)] |
|
5930 |
have "i < length (takeWhile (\<lambda>ys. j < length ys) xs)" by simp |
|
5931 |
from nth_mem[OF this] takeWhile_nth[OF this] |
|
5932 |
show "j < length (xs ! i)" by (auto dest: set_takeWhileD) |
|
5933 |
next |
|
5934 |
fix j assume "j < length (xs ! i)" |
|
5935 |
thus "j < length (transpose xs)" |
|
60758 | 5936 |
using foldr_max_sorted[OF sorted] \<open>xs \<noteq> []\<close> sortedE[OF le0] |
34933 | 5937 |
by (auto simp: length_transpose comp_def foldr_map) |
5938 |
||
5939 |
have "Suc i \<le> length (takeWhile (\<lambda>ys. j < length ys) xs)" |
|
60758 | 5940 |
using \<open>i < length xs\<close> \<open>j < length (xs ! i)\<close> less_Suc_eq_le |
34933 | 5941 |
by (auto intro!: length_takeWhile_less_P_nth dest!: sortedE) |
60758 | 5942 |
with nth_transpose[OF \<open>j < length (transpose xs)\<close>] |
34933 | 5943 |
show "i < length (transpose xs ! j)" by simp |
5944 |
qed |
|
5945 |
thus ?thesis by (simp add: length_filter_conv_card) |
|
5946 |
qed |
|
5947 |
||
5948 |
lemma transpose_column: |
|
5949 |
fixes xs :: "'a list list" |
|
5950 |
assumes sorted: "sorted (rev (map length xs))" and "i < length xs" |
|
5951 |
shows "map (\<lambda>ys. ys ! i) (filter (\<lambda>ys. i < length ys) (transpose xs)) |
|
5952 |
= xs ! i" (is "?R = _") |
|
68975
5ce4d117cea7
A few new results, elimination of duplicates and more use of "pairwise"
paulson <lp15@cam.ac.uk>
parents:
68781
diff
changeset
|
5953 |
proof (rule nth_equalityI) |
34933 | 5954 |
show length: "length ?R = length (xs ! i)" |
5955 |
using transpose_column_length[OF assms] by simp |
|
5956 |
||
5957 |
fix j assume j: "j < length ?R" |
|
5958 |
note * = less_le_trans[OF this, unfolded length_map, OF length_filter_le] |
|
5959 |
from j have j_less: "j < length (xs ! i)" using length by simp |
|
5960 |
have i_less_tW: "Suc i \<le> length (takeWhile (\<lambda>ys. Suc j \<le> length ys) xs)" |
|
5961 |
proof (rule length_takeWhile_less_P_nth) |
|
60758 | 5962 |
show "Suc i \<le> length xs" using \<open>i < length xs\<close> by simp |
34933 | 5963 |
fix k assume "k < Suc i" |
5964 |
hence "k \<le> i" by auto |
|
60758 | 5965 |
with sorted_rev_nth_mono[OF sorted this] \<open>i < length xs\<close> |
34933 | 5966 |
have "length (xs ! i) \<le> length (xs ! k)" by simp |
5967 |
thus "Suc j \<le> length (xs ! k)" using j_less by simp |
|
5968 |
qed |
|
68249
949d93804740
First step to remove nonstandard "[x <- xs. P]" syntax: only input
nipkow
parents:
68215
diff
changeset
|
5969 |
have i_less_filter: "i < length (filter (\<lambda>ys. j < length ys) xs) " |
34933 | 5970 |
unfolding filter_equals_takeWhile_sorted_rev[OF sorted, of j] |
5971 |
using i_less_tW by (simp_all add: Suc_le_eq) |
|
5972 |
from j show "?R ! j = xs ! i ! j" |
|
5973 |
unfolding filter_equals_takeWhile_sorted_rev[OF sorted_transpose, of i] |
|
5974 |
by (simp add: takeWhile_nth nth_nth_transpose_sorted[OF sorted * i_less_filter]) |
|
5975 |
qed |
|
5976 |
||
5977 |
lemma transpose_transpose: |
|
5978 |
fixes xs :: "'a list list" |
|
5979 |
assumes sorted: "sorted (rev (map length xs))" |
|
5980 |
shows "transpose (transpose xs) = takeWhile (\<lambda>x. x \<noteq> []) xs" (is "?L = ?R") |
|
5981 |
proof - |
|
5982 |
have len: "length ?L = length ?R" |
|
5983 |
unfolding length_transpose transpose_max_length |
|
5984 |
using filter_equals_takeWhile_sorted_rev[OF sorted, of 0] |
|
5985 |
by simp |
|
5986 |
||
5987 |
{ fix i assume "i < length ?R" |
|
5988 |
with less_le_trans[OF _ length_takeWhile_le[of _ xs]] |
|
5989 |
have "i < length xs" by simp |
|
5990 |
} note * = this |
|
5991 |
show ?thesis |
|
5992 |
by (rule nth_equalityI) |
|
5993 |
(simp_all add: len nth_transpose transpose_column[OF sorted] * takeWhile_nth) |
|
5994 |
qed |
|
24616 | 5995 |
|
34934
440605046777
Added transpose_rectangle, when the input list is rectangular.
hoelzl
parents:
34933
diff
changeset
|
5996 |
theorem transpose_rectangle: |
440605046777
Added transpose_rectangle, when the input list is rectangular.
hoelzl
parents:
34933
diff
changeset
|
5997 |
assumes "xs = [] \<Longrightarrow> n = 0" |
440605046777
Added transpose_rectangle, when the input list is rectangular.
hoelzl
parents:
34933
diff
changeset
|
5998 |
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
|
5999 |
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
|
6000 |
(is "?trans = ?map") |
440605046777
Added transpose_rectangle, when the input list is rectangular.
hoelzl
parents:
34933
diff
changeset
|
6001 |
proof (rule nth_equalityI) |
440605046777
Added transpose_rectangle, when the input list is rectangular.
hoelzl
parents:
34933
diff
changeset
|
6002 |
have "sorted (rev (map length xs))" |
68175 | 6003 |
by (auto simp: rev_nth rect sorted_iff_nth_mono) |
34934
440605046777
Added transpose_rectangle, when the input list is rectangular.
hoelzl
parents:
34933
diff
changeset
|
6004 |
from foldr_max_sorted[OF this] assms |
440605046777
Added transpose_rectangle, when the input list is rectangular.
hoelzl
parents:
34933
diff
changeset
|
6005 |
show len: "length ?trans = length ?map" |
440605046777
Added transpose_rectangle, when the input list is rectangular.
hoelzl
parents:
34933
diff
changeset
|
6006 |
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
|
6007 |
moreover |
68249
949d93804740
First step to remove nonstandard "[x <- xs. P]" syntax: only input
nipkow
parents:
68215
diff
changeset
|
6008 |
{ fix i assume "i < n" hence "filter (\<lambda>ys. i < length ys) xs = xs" |
34934
440605046777
Added transpose_rectangle, when the input list is rectangular.
hoelzl
parents:
34933
diff
changeset
|
6009 |
using rect by (auto simp: in_set_conv_nth intro!: filter_True) } |
68975
5ce4d117cea7
A few new results, elimination of duplicates and more use of "pairwise"
paulson <lp15@cam.ac.uk>
parents:
68781
diff
changeset
|
6010 |
ultimately show "\<And>i. i < length (transpose xs) \<Longrightarrow> ?trans ! i = ?map ! i" |
34934
440605046777
Added transpose_rectangle, when the input list is rectangular.
hoelzl
parents:
34933
diff
changeset
|
6011 |
by (auto simp: nth_transpose intro: nth_equalityI) |
440605046777
Added transpose_rectangle, when the input list is rectangular.
hoelzl
parents:
34933
diff
changeset
|
6012 |
qed |
24616 | 6013 |
|
35115 | 6014 |
|
61799 | 6015 |
subsubsection \<open>\<open>sorted_list_of_set\<close>\<close> |
60758 | 6016 |
|
6017 |
text\<open>This function maps (finite) linearly ordered sets to sorted |
|
25069 | 6018 |
lists. Warning: in most cases it is not a good idea to convert from |
6019 |
sets to lists but one should convert in the other direction (via |
|
69593 | 6020 |
\<^const>\<open>set\<close>).\<close> |
60758 | 6021 |
|
54868 | 6022 |
context linorder |
6023 |
begin |
|
6024 |
||
6025 |
definition sorted_list_of_set :: "'a set \<Rightarrow> 'a list" where |
|
51489 | 6026 |
"sorted_list_of_set = folding.F insort []" |
6027 |
||
61605 | 6028 |
sublocale sorted_list_of_set: folding insort Nil |
61566
c3d6e570ccef
Keyword 'rewrites' identifies rewrite morphisms.
ballarin
parents:
61468
diff
changeset
|
6029 |
rewrites |
51489 | 6030 |
"folding.F insort [] = sorted_list_of_set" |
6031 |
proof - |
|
6032 |
interpret comp_fun_commute insort by (fact comp_fun_commute_insort) |
|
61169 | 6033 |
show "folding insort" by standard (fact comp_fun_commute) |
51489 | 6034 |
show "folding.F insort [] = sorted_list_of_set" by (simp only: sorted_list_of_set_def) |
6035 |
qed |
|
6036 |
||
6037 |
lemma sorted_list_of_set_empty: |
|
35195 | 6038 |
"sorted_list_of_set {} = []" |
71585 | 6039 |
by (fact sorted_list_of_set.empty) |
35195 | 6040 |
|
6041 |
lemma sorted_list_of_set_insert [simp]: |
|
54868 | 6042 |
"finite A \<Longrightarrow> sorted_list_of_set (insert x A) = insort x (sorted_list_of_set (A - {x}))" |
71585 | 6043 |
by (fact sorted_list_of_set.insert_remove) |
35195 | 6044 |
|
52122 | 6045 |
lemma sorted_list_of_set_eq_Nil_iff [simp]: |
6046 |
"finite A \<Longrightarrow> sorted_list_of_set A = [] \<longleftrightarrow> A = {}" |
|
71585 | 6047 |
by (auto simp: sorted_list_of_set.remove) |
52122 | 6048 |
|
68083 | 6049 |
lemma set_sorted_list_of_set [simp]: |
6050 |
"finite A \<Longrightarrow> set (sorted_list_of_set A) = A" |
|
71585 | 6051 |
by(induct A rule: finite_induct) (simp_all add: set_insort_key) |
68083 | 6052 |
|
6053 |
lemma sorted_sorted_list_of_set [simp]: "sorted (sorted_list_of_set A)" |
|
6054 |
proof (cases "finite A") |
|
6055 |
case True thus ?thesis by(induction A) (simp_all add: sorted_insort) |
|
6056 |
next |
|
6057 |
case False thus ?thesis by simp |
|
6058 |
qed |
|
6059 |
||
6060 |
lemma distinct_sorted_list_of_set [simp]: "distinct (sorted_list_of_set A)" |
|
6061 |
proof (cases "finite A") |
|
6062 |
case True thus ?thesis by(induction A) (simp_all add: distinct_insort) |
|
6063 |
next |
|
6064 |
case False thus ?thesis by simp |
|
6065 |
qed |
|
52122 | 6066 |
|
71860 | 6067 |
lemma length_sorted_list_of_set [simp]: "length (sorted_list_of_set A) = card A" |
6068 |
proof (cases "finite A") |
|
6069 |
case True |
|
6070 |
then show ?thesis |
|
6071 |
by(metis distinct_card distinct_sorted_list_of_set set_sorted_list_of_set) |
|
6072 |
qed auto |
|
71855 | 6073 |
|
68085 | 6074 |
lemmas sorted_list_of_set = set_sorted_list_of_set sorted_sorted_list_of_set distinct_sorted_list_of_set |
6075 |
||
47841 | 6076 |
lemma sorted_list_of_set_sort_remdups [code]: |
35195 | 6077 |
"sorted_list_of_set (set xs) = sort (remdups xs)" |
6078 |
proof - |
|
42871
1c0b99f950d9
names of fold_set locales resemble name of characteristic property more closely
haftmann
parents:
42809
diff
changeset
|
6079 |
interpret comp_fun_commute insort by (fact comp_fun_commute_insort) |
51489 | 6080 |
show ?thesis by (simp add: sorted_list_of_set.eq_fold sort_conv_fold fold_set_fold_remdups) |
35195 | 6081 |
qed |
25069 | 6082 |
|
37107 | 6083 |
lemma sorted_list_of_set_remove: |
6084 |
assumes "finite A" |
|
6085 |
shows "sorted_list_of_set (A - {x}) = remove1 x (sorted_list_of_set A)" |
|
6086 |
proof (cases "x \<in> A") |
|
6087 |
case False with assms have "x \<notin> set (sorted_list_of_set A)" by simp |
|
6088 |
with False show ?thesis by (simp add: remove1_idem) |
|
6089 |
next |
|
6090 |
case True then obtain B where A: "A = insert x B" by (rule Set.set_insert) |
|
6091 |
with assms show ?thesis by simp |
|
6092 |
qed |
|
6093 |
||
71404
f2b783abfbe7
A few lemmas connected with orderings
paulson <lp15@cam.ac.uk>
parents:
71393
diff
changeset
|
6094 |
lemma strict_sorted_list_of_set [simp]: "strict_sorted (sorted_list_of_set A)" |
f2b783abfbe7
A few lemmas connected with orderings
paulson <lp15@cam.ac.uk>
parents:
71393
diff
changeset
|
6095 |
by (simp add: strict_sorted_iff) |
f2b783abfbe7
A few lemmas connected with orderings
paulson <lp15@cam.ac.uk>
parents:
71393
diff
changeset
|
6096 |
|
f2b783abfbe7
A few lemmas connected with orderings
paulson <lp15@cam.ac.uk>
parents:
71393
diff
changeset
|
6097 |
lemma finite_set_strict_sorted: |
f2b783abfbe7
A few lemmas connected with orderings
paulson <lp15@cam.ac.uk>
parents:
71393
diff
changeset
|
6098 |
assumes "finite A" |
71860 | 6099 |
obtains l where "strict_sorted l" "set l = A" "length l = card A" |
71404
f2b783abfbe7
A few lemmas connected with orderings
paulson <lp15@cam.ac.uk>
parents:
71393
diff
changeset
|
6100 |
by (metis assms distinct_card distinct_sorted_list_of_set set_sorted_list_of_set strict_sorted_list_of_set) |
f2b783abfbe7
A few lemmas connected with orderings
paulson <lp15@cam.ac.uk>
parents:
71393
diff
changeset
|
6101 |
|
71827 | 6102 |
lemma strict_sorted_equal: |
6103 |
assumes "strict_sorted xs" |
|
6104 |
and "strict_sorted ys" |
|
71860 | 6105 |
and "set ys = set xs" |
71827 | 6106 |
shows "ys = xs" |
6107 |
using assms |
|
6108 |
proof (induction xs arbitrary: ys) |
|
6109 |
case (Cons x xs) |
|
6110 |
show ?case |
|
6111 |
proof (cases ys) |
|
6112 |
case Nil |
|
6113 |
then show ?thesis |
|
6114 |
using Cons.prems by auto |
|
6115 |
next |
|
6116 |
case (Cons y ys') |
|
6117 |
then have "xs = ys'" |
|
6118 |
by (metis Cons.prems list.inject sorted_distinct_set_unique strict_sorted_iff) |
|
6119 |
moreover have "x = y" |
|
6120 |
using Cons.prems \<open>xs = ys'\<close> local.Cons by fastforce |
|
6121 |
ultimately show ?thesis |
|
6122 |
using local.Cons by blast |
|
6123 |
qed |
|
6124 |
qed auto |
|
6125 |
||
71860 | 6126 |
lemma strict_sorted_equal_Uniq: "\<exists>\<^sub>\<le>\<^sub>1xs. strict_sorted xs \<and> set xs = A" |
71827 | 6127 |
by (simp add: Uniq_def strict_sorted_equal) |
6128 |
||
71857
d73955442df5
a few new lemmas about functions
paulson <lp15@cam.ac.uk>
parents:
71856
diff
changeset
|
6129 |
lemma sorted_list_of_set_inject: |
d73955442df5
a few new lemmas about functions
paulson <lp15@cam.ac.uk>
parents:
71856
diff
changeset
|
6130 |
assumes "sorted_list_of_set A = sorted_list_of_set B" "finite A" "finite B" |
d73955442df5
a few new lemmas about functions
paulson <lp15@cam.ac.uk>
parents:
71856
diff
changeset
|
6131 |
shows "A = B" |
d73955442df5
a few new lemmas about functions
paulson <lp15@cam.ac.uk>
parents:
71856
diff
changeset
|
6132 |
using assms set_sorted_list_of_set by fastforce |
d73955442df5
a few new lemmas about functions
paulson <lp15@cam.ac.uk>
parents:
71856
diff
changeset
|
6133 |
|
d73955442df5
a few new lemmas about functions
paulson <lp15@cam.ac.uk>
parents:
71856
diff
changeset
|
6134 |
lemma sorted_list_of_set_unique: |
d73955442df5
a few new lemmas about functions
paulson <lp15@cam.ac.uk>
parents:
71856
diff
changeset
|
6135 |
assumes "finite A" |
71860 | 6136 |
shows "strict_sorted l \<and> set l = A \<and> length l = card A \<longleftrightarrow> sorted_list_of_set A = l" |
71857
d73955442df5
a few new lemmas about functions
paulson <lp15@cam.ac.uk>
parents:
71856
diff
changeset
|
6137 |
using assms strict_sorted_equal by force |
d73955442df5
a few new lemmas about functions
paulson <lp15@cam.ac.uk>
parents:
71856
diff
changeset
|
6138 |
|
71860 | 6139 |
end |
6140 |
||
6141 |
lemma sorted_list_of_set_range [simp]: |
|
6142 |
"sorted_list_of_set {m..<n} = [m..<n]" |
|
6143 |
by (rule sorted_distinct_set_unique) simp_all |
|
71857
d73955442df5
a few new lemmas about functions
paulson <lp15@cam.ac.uk>
parents:
71856
diff
changeset
|
6144 |
|
d73955442df5
a few new lemmas about functions
paulson <lp15@cam.ac.uk>
parents:
71856
diff
changeset
|
6145 |
lemma sorted_list_of_set_lessThan_Suc [simp]: |
d73955442df5
a few new lemmas about functions
paulson <lp15@cam.ac.uk>
parents:
71856
diff
changeset
|
6146 |
"sorted_list_of_set {..<Suc k} = sorted_list_of_set {..<k} @ [k]" |
d73955442df5
a few new lemmas about functions
paulson <lp15@cam.ac.uk>
parents:
71856
diff
changeset
|
6147 |
proof - |
d73955442df5
a few new lemmas about functions
paulson <lp15@cam.ac.uk>
parents:
71856
diff
changeset
|
6148 |
have "sorted_wrt (<) (sorted_list_of_set {..<k} @ [k])" |
d73955442df5
a few new lemmas about functions
paulson <lp15@cam.ac.uk>
parents:
71856
diff
changeset
|
6149 |
unfolding sorted_wrt_append by (auto simp flip: strict_sorted_sorted_wrt) |
d73955442df5
a few new lemmas about functions
paulson <lp15@cam.ac.uk>
parents:
71856
diff
changeset
|
6150 |
then show ?thesis |
d73955442df5
a few new lemmas about functions
paulson <lp15@cam.ac.uk>
parents:
71856
diff
changeset
|
6151 |
by (simp add: lessThan_atLeast0) |
d73955442df5
a few new lemmas about functions
paulson <lp15@cam.ac.uk>
parents:
71856
diff
changeset
|
6152 |
qed |
d73955442df5
a few new lemmas about functions
paulson <lp15@cam.ac.uk>
parents:
71856
diff
changeset
|
6153 |
|
d73955442df5
a few new lemmas about functions
paulson <lp15@cam.ac.uk>
parents:
71856
diff
changeset
|
6154 |
lemma sorted_list_of_set_atMost_Suc [simp]: |
d73955442df5
a few new lemmas about functions
paulson <lp15@cam.ac.uk>
parents:
71856
diff
changeset
|
6155 |
"sorted_list_of_set {..Suc k} = sorted_list_of_set {..k} @ [Suc k]" |
d73955442df5
a few new lemmas about functions
paulson <lp15@cam.ac.uk>
parents:
71856
diff
changeset
|
6156 |
using lessThan_Suc_atMost sorted_list_of_set_lessThan_Suc by fastforce |
d73955442df5
a few new lemmas about functions
paulson <lp15@cam.ac.uk>
parents:
71856
diff
changeset
|
6157 |
|
72095
cfb6c22a5636
lemmas about sets and the enumerate operator
paulson <lp15@cam.ac.uk>
parents:
71991
diff
changeset
|
6158 |
lemma sorted_list_of_set_nonempty: |
cfb6c22a5636
lemmas about sets and the enumerate operator
paulson <lp15@cam.ac.uk>
parents:
71991
diff
changeset
|
6159 |
assumes "finite A" "A \<noteq> {}" |
cfb6c22a5636
lemmas about sets and the enumerate operator
paulson <lp15@cam.ac.uk>
parents:
71991
diff
changeset
|
6160 |
shows "sorted_list_of_set A = Min A # sorted_list_of_set (A - {Min A})" |
cfb6c22a5636
lemmas about sets and the enumerate operator
paulson <lp15@cam.ac.uk>
parents:
71991
diff
changeset
|
6161 |
using assms by (auto simp: less_le simp flip: sorted_list_of_set_unique intro: Min_in) |
cfb6c22a5636
lemmas about sets and the enumerate operator
paulson <lp15@cam.ac.uk>
parents:
71991
diff
changeset
|
6162 |
|
71857
d73955442df5
a few new lemmas about functions
paulson <lp15@cam.ac.uk>
parents:
71856
diff
changeset
|
6163 |
lemma sorted_list_of_set_greaterThanLessThan: |
d73955442df5
a few new lemmas about functions
paulson <lp15@cam.ac.uk>
parents:
71856
diff
changeset
|
6164 |
assumes "Suc i < j" |
d73955442df5
a few new lemmas about functions
paulson <lp15@cam.ac.uk>
parents:
71856
diff
changeset
|
6165 |
shows "sorted_list_of_set {i<..<j} = Suc i # sorted_list_of_set {Suc i<..<j}" |
d73955442df5
a few new lemmas about functions
paulson <lp15@cam.ac.uk>
parents:
71856
diff
changeset
|
6166 |
proof - |
d73955442df5
a few new lemmas about functions
paulson <lp15@cam.ac.uk>
parents:
71856
diff
changeset
|
6167 |
have "{i<..<j} = insert (Suc i) {Suc i<..<j}" |
d73955442df5
a few new lemmas about functions
paulson <lp15@cam.ac.uk>
parents:
71856
diff
changeset
|
6168 |
using assms by auto |
d73955442df5
a few new lemmas about functions
paulson <lp15@cam.ac.uk>
parents:
71856
diff
changeset
|
6169 |
then show ?thesis |
d73955442df5
a few new lemmas about functions
paulson <lp15@cam.ac.uk>
parents:
71856
diff
changeset
|
6170 |
by (metis assms atLeastSucLessThan_greaterThanLessThan sorted_list_of_set_range upt_conv_Cons) |
d73955442df5
a few new lemmas about functions
paulson <lp15@cam.ac.uk>
parents:
71856
diff
changeset
|
6171 |
qed |
d73955442df5
a few new lemmas about functions
paulson <lp15@cam.ac.uk>
parents:
71856
diff
changeset
|
6172 |
|
d73955442df5
a few new lemmas about functions
paulson <lp15@cam.ac.uk>
parents:
71856
diff
changeset
|
6173 |
lemma sorted_list_of_set_greaterThanAtMost: |
d73955442df5
a few new lemmas about functions
paulson <lp15@cam.ac.uk>
parents:
71856
diff
changeset
|
6174 |
assumes "Suc i \<le> j" |
d73955442df5
a few new lemmas about functions
paulson <lp15@cam.ac.uk>
parents:
71856
diff
changeset
|
6175 |
shows "sorted_list_of_set {i<..j} = Suc i # sorted_list_of_set {Suc i<..j}" |
d73955442df5
a few new lemmas about functions
paulson <lp15@cam.ac.uk>
parents:
71856
diff
changeset
|
6176 |
using sorted_list_of_set_greaterThanLessThan [of i "Suc j"] |
d73955442df5
a few new lemmas about functions
paulson <lp15@cam.ac.uk>
parents:
71856
diff
changeset
|
6177 |
by (metis assms greaterThanAtMost_def greaterThanLessThan_eq le_imp_less_Suc lessThan_Suc_atMost) |
d73955442df5
a few new lemmas about functions
paulson <lp15@cam.ac.uk>
parents:
71856
diff
changeset
|
6178 |
|
d73955442df5
a few new lemmas about functions
paulson <lp15@cam.ac.uk>
parents:
71856
diff
changeset
|
6179 |
lemma nth_sorted_list_of_set_greaterThanLessThan: |
d73955442df5
a few new lemmas about functions
paulson <lp15@cam.ac.uk>
parents:
71856
diff
changeset
|
6180 |
"n < j - Suc i \<Longrightarrow> sorted_list_of_set {i<..<j} ! n = Suc (i+n)" |
d73955442df5
a few new lemmas about functions
paulson <lp15@cam.ac.uk>
parents:
71856
diff
changeset
|
6181 |
by (induction n arbitrary: i) (auto simp: sorted_list_of_set_greaterThanLessThan) |
d73955442df5
a few new lemmas about functions
paulson <lp15@cam.ac.uk>
parents:
71856
diff
changeset
|
6182 |
|
d73955442df5
a few new lemmas about functions
paulson <lp15@cam.ac.uk>
parents:
71856
diff
changeset
|
6183 |
lemma nth_sorted_list_of_set_greaterThanAtMost: |
d73955442df5
a few new lemmas about functions
paulson <lp15@cam.ac.uk>
parents:
71856
diff
changeset
|
6184 |
"n < j - i \<Longrightarrow> sorted_list_of_set {i<..j} ! n = Suc (i+n)" |
d73955442df5
a few new lemmas about functions
paulson <lp15@cam.ac.uk>
parents:
71856
diff
changeset
|
6185 |
using nth_sorted_list_of_set_greaterThanLessThan [of n "Suc j" i] |
d73955442df5
a few new lemmas about functions
paulson <lp15@cam.ac.uk>
parents:
71856
diff
changeset
|
6186 |
by (simp add: greaterThanAtMost_def greaterThanLessThan_eq lessThan_Suc_atMost) |
d73955442df5
a few new lemmas about functions
paulson <lp15@cam.ac.uk>
parents:
71856
diff
changeset
|
6187 |
|
d73955442df5
a few new lemmas about functions
paulson <lp15@cam.ac.uk>
parents:
71856
diff
changeset
|
6188 |
|
61799 | 6189 |
subsubsection \<open>\<open>lists\<close>: the list-forming operator over sets\<close> |
15302 | 6190 |
|
23740 | 6191 |
inductive_set |
22262 | 6192 |
lists :: "'a set => 'a list set" |
23740 | 6193 |
for A :: "'a set" |
6194 |
where |
|
67613 | 6195 |
Nil [intro!, simp]: "[] \<in> lists A" |
6196 |
| Cons [intro!, simp]: "\<lbrakk>a \<in> A; l \<in> lists A\<rbrakk> \<Longrightarrow> a#l \<in> lists A" |
|
6197 |
||
6198 |
inductive_cases listsE [elim!]: "x#l \<in> lists A" |
|
54147
97a8ff4e4ac9
killed most "no_atp", to make Sledgehammer more complete
blanchet
parents:
53954
diff
changeset
|
6199 |
inductive_cases listspE [elim!]: "listsp A (x # l)" |
23740 | 6200 |
|
46313 | 6201 |
inductive_simps listsp_simps[code]: |
6202 |
"listsp A []" |
|
6203 |
"listsp A (x # xs)" |
|
6204 |
||
71585 | 6205 |
lemma listsp_mono [mono]: "A \<le> B \<Longrightarrow> listsp A \<le> listsp B" |
46884 | 6206 |
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
|
6207 |
|
46176
1898e61e89c4
pred_subset/equals_eq are now standard pred_set_conv rules
berghofe
parents:
46156
diff
changeset
|
6208 |
lemmas lists_mono = listsp_mono [to_set] |
22262 | 6209 |
|
22422
ee19cdb07528
stepping towards uniform lattice theory development in HOL
haftmann
parents:
22262
diff
changeset
|
6210 |
lemma listsp_infI: |
71585 | 6211 |
assumes l: "listsp A l" shows "listsp B l \<Longrightarrow> listsp (inf A B) l" using l |
24349 | 6212 |
by induct blast+ |
15302 | 6213 |
|
22422
ee19cdb07528
stepping towards uniform lattice theory development in HOL
haftmann
parents:
22262
diff
changeset
|
6214 |
lemmas lists_IntI = listsp_infI [to_set] |
ee19cdb07528
stepping towards uniform lattice theory development in HOL
haftmann
parents:
22262
diff
changeset
|
6215 |
|
ee19cdb07528
stepping towards uniform lattice theory development in HOL
haftmann
parents:
22262
diff
changeset
|
6216 |
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
|
6217 |
proof (rule mono_inf [where f=listsp, THEN order_antisym]) |
22262 | 6218 |
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
|
6219 |
show "inf (listsp A) (listsp B) \<le> listsp (inf A B)" by (blast intro!: listsp_infI) |
14388 | 6220 |
qed |
6221 |
||
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
|
6222 |
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
|
6223 |
|
46176
1898e61e89c4
pred_subset/equals_eq are now standard pred_set_conv rules
berghofe
parents:
46156
diff
changeset
|
6224 |
lemmas lists_Int_eq [simp] = listsp_inf_eq [to_set] |
22262 | 6225 |
|
67613 | 6226 |
lemma Cons_in_lists_iff[simp]: "x#xs \<in> lists A \<longleftrightarrow> x \<in> A \<and> xs \<in> lists A" |
39613 | 6227 |
by auto |
6228 |
||
22262 | 6229 |
lemma append_in_listsp_conv [iff]: |
6230 |
"(listsp A (xs @ ys)) = (listsp A xs \<and> listsp A ys)" |
|
15302 | 6231 |
by (induct xs) auto |
6232 |
||
22262 | 6233 |
lemmas append_in_lists_conv [iff] = append_in_listsp_conv [to_set] |
6234 |
||
6235 |
lemma in_listsp_conv_set: "(listsp A xs) = (\<forall>x \<in> set xs. A x)" |
|
61799 | 6236 |
\<comment> \<open>eliminate \<open>listsp\<close> in favour of \<open>set\<close>\<close> |
15302 | 6237 |
by (induct xs) auto |
6238 |
||
46313 | 6239 |
lemmas in_lists_conv_set [code_unfold] = in_listsp_conv_set [to_set] |
22262 | 6240 |
|
71585 | 6241 |
lemma in_listspD [dest!]: "listsp A xs \<Longrightarrow> \<forall>x\<in>set xs. A x" |
22262 | 6242 |
by (rule in_listsp_conv_set [THEN iffD1]) |
6243 |
||
54147
97a8ff4e4ac9
killed most "no_atp", to make Sledgehammer more complete
blanchet
parents:
53954
diff
changeset
|
6244 |
lemmas in_listsD [dest!] = in_listspD [to_set] |
97a8ff4e4ac9
killed most "no_atp", to make Sledgehammer more complete
blanchet
parents:
53954
diff
changeset
|
6245 |
|
71585 | 6246 |
lemma in_listspI [intro!]: "\<forall>x\<in>set xs. A x \<Longrightarrow> listsp A xs" |
22262 | 6247 |
by (rule in_listsp_conv_set [THEN iffD2]) |
6248 |
||
54147
97a8ff4e4ac9
killed most "no_atp", to make Sledgehammer more complete
blanchet
parents:
53954
diff
changeset
|
6249 |
lemmas in_listsI [intro!] = in_listspI [to_set] |
15302 | 6250 |
|
68709 | 6251 |
lemma lists_eq_set: "lists A = {xs. set xs \<le> A}" |
39597 | 6252 |
by auto |
6253 |
||
39613 | 6254 |
lemma lists_empty [simp]: "lists {} = {[]}" |
6255 |
by auto |
|
6256 |
||
15302 | 6257 |
lemma lists_UNIV [simp]: "lists UNIV = UNIV" |
6258 |
by auto |
|
6259 |
||
50134 | 6260 |
lemma lists_image: "lists (f`A) = map f ` lists A" |
6261 |
proof - |
|
6262 |
{ fix xs have "\<forall>x\<in>set xs. x \<in> f ` A \<Longrightarrow> xs \<in> map f ` lists A" |
|
55465 | 6263 |
by (induct xs) (auto simp del: list.map simp add: list.map[symmetric] intro!: imageI) } |
50134 | 6264 |
then show ?thesis by auto |
6265 |
qed |
|
17086 | 6266 |
|
60758 | 6267 |
subsubsection \<open>Inductive definition for membership\<close> |
17086 | 6268 |
|
23740 | 6269 |
inductive ListMem :: "'a \<Rightarrow> 'a list \<Rightarrow> bool" |
22262 | 6270 |
where |
6271 |
elem: "ListMem x (x # xs)" |
|
6272 |
| insert: "ListMem x xs \<Longrightarrow> ListMem x (y # xs)" |
|
6273 |
||
6274 |
lemma ListMem_iff: "(ListMem x xs) = (x \<in> set xs)" |
|
68719 | 6275 |
proof |
6276 |
show "ListMem x xs \<Longrightarrow> x \<in> set xs" |
|
6277 |
by (induct set: ListMem) auto |
|
6278 |
show "x \<in> set xs \<Longrightarrow> ListMem x xs" |
|
6279 |
by (induct xs) (auto intro: ListMem.intros) |
|
6280 |
qed |
|
17086 | 6281 |
|
6282 |
||
60758 | 6283 |
subsubsection \<open>Lists as Cartesian products\<close> |
6284 |
||
61799 | 6285 |
text\<open>\<open>set_Cons A Xs\<close>: the set of lists with head drawn from |
69593 | 6286 |
\<^term>\<open>A\<close> and tail drawn from \<^term>\<open>Xs\<close>.\<close> |
15302 | 6287 |
|
50548 | 6288 |
definition set_Cons :: "'a set \<Rightarrow> 'a list set \<Rightarrow> 'a list set" where |
6289 |
"set_Cons A XS = {z. \<exists>x xs. z = x # xs \<and> x \<in> A \<and> xs \<in> XS}" |
|
15302 | 6290 |
|
17724 | 6291 |
lemma set_Cons_sing_Nil [simp]: "set_Cons A {[]} = (%x. [x])`A" |
15302 | 6292 |
by (auto simp add: set_Cons_def) |
6293 |
||
60758 | 6294 |
text\<open>Yields the set of lists, all of the same length as the argument and |
6295 |
with elements drawn from the corresponding element of the argument.\<close> |
|
15302 | 6296 |
|
50548 | 6297 |
primrec listset :: "'a set list \<Rightarrow> 'a list set" where |
6298 |
"listset [] = {[]}" | |
|
6299 |
"listset (A # As) = set_Cons A (listset As)" |
|
15302 | 6300 |
|
6301 |
||
60758 | 6302 |
subsection \<open>Relations on Lists\<close> |
6303 |
||
6304 |
subsubsection \<open>Length Lexicographic Ordering\<close> |
|
6305 |
||
64963 | 6306 |
text\<open>These orderings preserve well-foundedness: shorter lists |
60758 | 6307 |
precede longer lists. These ordering are not used in dictionaries.\<close> |
64963 | 6308 |
|
61799 | 6309 |
primrec \<comment> \<open>The lexicographic ordering for lists of the specified length\<close> |
34941 | 6310 |
lexn :: "('a \<times> 'a) set \<Rightarrow> nat \<Rightarrow> ('a list \<times> 'a list) set" where |
50548 | 6311 |
"lexn r 0 = {}" | |
6312 |
"lexn r (Suc n) = |
|
55932 | 6313 |
(map_prod (%(x, xs). x#xs) (%(x, xs). x#xs) ` (r <*lex*> lexn r n)) Int |
50548 | 6314 |
{(xs, ys). length xs = Suc n \<and> length ys = Suc n}" |
6315 |
||
6316 |
definition lex :: "('a \<times> 'a) set \<Rightarrow> ('a list \<times> 'a list) set" where |
|
61799 | 6317 |
"lex r = (\<Union>n. lexn r n)" \<comment> \<open>Holds only between lists of the same length\<close> |
50548 | 6318 |
|
6319 |
definition lenlex :: "('a \<times> 'a) set => ('a list \<times> 'a list) set" where |
|
6320 |
"lenlex r = inv_image (less_than <*lex*> lex r) (\<lambda>xs. (length xs, xs))" |
|
61799 | 6321 |
\<comment> \<open>Compares lists by their length and then lexicographically\<close> |
15302 | 6322 |
|
68719 | 6323 |
lemma wf_lexn: assumes "wf r" shows "wf (lexn r n)" |
6324 |
proof (induct n) |
|
6325 |
case (Suc n) |
|
6326 |
have inj: "inj (\<lambda>(x, xs). x # xs)" |
|
6327 |
using assms by (auto simp: inj_on_def) |
|
6328 |
have wf: "wf (map_prod (\<lambda>(x, xs). x # xs) (\<lambda>(x, xs). x # xs) ` (r <*lex*> lexn r n))" |
|
6329 |
by (simp add: Suc.hyps assms wf_lex_prod wf_map_prod_image [OF _ inj]) |
|
6330 |
then show ?case |
|
6331 |
by (rule wf_subset) auto |
|
6332 |
qed auto |
|
15302 | 6333 |
|
6334 |
lemma lexn_length: |
|
67613 | 6335 |
"(xs, ys) \<in> lexn r n \<Longrightarrow> length xs = n \<and> length ys = n" |
71585 | 6336 |
by (induct n arbitrary: xs ys) auto |
6337 |
||
6338 |
lemma wf_lex [intro!]: |
|
6339 |
assumes "wf r" shows "wf (lex r)" |
|
68719 | 6340 |
unfolding lex_def |
71585 | 6341 |
proof (rule wf_UN) |
6342 |
show "wf (lexn r i)" for i |
|
6343 |
by (simp add: assms wf_lexn) |
|
6344 |
show "\<And>i j. lexn r i \<noteq> lexn r j \<Longrightarrow> Domain (lexn r i) \<inter> Range (lexn r j) = {}" |
|
6345 |
by (metis DomainE Int_emptyI RangeE lexn_length) |
|
6346 |
qed |
|
6347 |
||
15302 | 6348 |
lemma lexn_conv: |
15656 | 6349 |
"lexn r n = |
6350 |
{(xs,ys). length xs = n \<and> length ys = n \<and> |
|
72184 | 6351 |
(\<exists>xys x y xs' ys'. xs= xys @ x#xs' \<and> ys= xys @ y # ys' \<and> (x, y) \<in> r)}" |
71585 | 6352 |
proof (induction n) |
6353 |
case (Suc n) |
|
72184 | 6354 |
then show ?case |
6355 |
apply (simp add: image_Collect lex_prod_def, safe, blast) |
|
71585 | 6356 |
apply (rule_tac x = "ab # xys" in exI, simp) |
6357 |
apply (case_tac xys; force) |
|
6358 |
done |
|
6359 |
qed auto |
|
15302 | 6360 |
|
62175 | 6361 |
text\<open>By Mathias Fleury:\<close> |
71435
d8fb621fea02
some lemmas about the lex ordering on lists, etc.
paulson <lp15@cam.ac.uk>
parents:
71423
diff
changeset
|
6362 |
proposition lexn_transI: |
72184 | 6363 |
assumes "trans r" shows "trans (lexn r n)" |
62090 | 6364 |
unfolding trans_def |
6365 |
proof (intro allI impI) |
|
6366 |
fix as bs cs |
|
6367 |
assume asbs: "(as, bs) \<in> lexn r n" and bscs: "(bs, cs) \<in> lexn r n" |
|
6368 |
obtain abs a b as' bs' where |
|
6369 |
n: "length as = n" and "length bs = n" and |
|
6370 |
as: "as = abs @ a # as'" and |
|
6371 |
bs: "bs = abs @ b # bs'" and |
|
72184 | 6372 |
abr: "(a, b) \<in> r" |
62090 | 6373 |
using asbs unfolding lexn_conv by blast |
6374 |
obtain bcs b' c' cs' bs' where |
|
6375 |
n': "length cs = n" and "length bs = n" and |
|
6376 |
bs': "bs = bcs @ b' # bs'" and |
|
6377 |
cs: "cs = bcs @ c' # cs'" and |
|
72184 | 6378 |
b'c'r: "(b', c') \<in> r" |
62090 | 6379 |
using bscs unfolding lexn_conv by blast |
6380 |
consider (le) "length bcs < length abs" |
|
6381 |
| (eq) "length bcs = length abs" |
|
6382 |
| (ge) "length bcs > length abs" by linarith |
|
6383 |
thus "(as, cs) \<in> lexn r n" |
|
6384 |
proof cases |
|
6385 |
let ?k = "length bcs" |
|
6386 |
case le |
|
6387 |
hence "as ! ?k = bs ! ?k" unfolding as bs by (simp add: nth_append) |
|
72184 | 6388 |
hence "(as ! ?k, cs ! ?k) \<in> r" using b'c'r unfolding bs' cs by auto |
62090 | 6389 |
moreover |
6390 |
have "length bcs < length as" using le unfolding as by simp |
|
6391 |
from id_take_nth_drop[OF this] |
|
6392 |
have "as = take ?k as @ as ! ?k # drop (Suc ?k) as" . |
|
6393 |
moreover |
|
6394 |
have "length bcs < length cs" unfolding cs by simp |
|
6395 |
from id_take_nth_drop[OF this] |
|
6396 |
have "cs = take ?k cs @ cs ! ?k # drop (Suc ?k) cs" . |
|
6397 |
moreover have "take ?k as = take ?k cs" |
|
6398 |
using le arg_cong[OF bs, of "take (length bcs)"] |
|
6399 |
unfolding cs as bs' by auto |
|
72184 | 6400 |
ultimately show ?thesis using n n' unfolding lexn_conv by auto |
62090 | 6401 |
next |
6402 |
let ?k = "length abs" |
|
6403 |
case ge |
|
6404 |
hence "bs ! ?k = cs ! ?k" unfolding bs' cs by (simp add: nth_append) |
|
72184 | 6405 |
hence "(as ! ?k, cs ! ?k) \<in> r" using abr unfolding as bs by auto |
62090 | 6406 |
moreover |
6407 |
have "length abs < length as" using ge unfolding as by simp |
|
6408 |
from id_take_nth_drop[OF this] |
|
6409 |
have "as = take ?k as @ as ! ?k # drop (Suc ?k) as" . |
|
6410 |
moreover have "length abs < length cs" using n n' unfolding as by simp |
|
6411 |
from id_take_nth_drop[OF this] |
|
6412 |
have "cs = take ?k cs @ cs ! ?k # drop (Suc ?k) cs" . |
|
6413 |
moreover have "take ?k as = take ?k cs" |
|
6414 |
using ge arg_cong[OF bs', of "take (length abs)"] |
|
6415 |
unfolding cs as bs by auto |
|
6416 |
ultimately show ?thesis using n n' unfolding lexn_conv by auto |
|
6417 |
next |
|
6418 |
let ?k = "length abs" |
|
6419 |
case eq |
|
63540 | 6420 |
hence *: "abs = bcs" "b = b'" using bs bs' by auto |
72184 | 6421 |
hence "(a, c') \<in> r" |
6422 |
using abr b'c'r assms unfolding trans_def by blast |
|
6423 |
with * show ?thesis using n n' unfolding lexn_conv as bs cs by auto |
|
62090 | 6424 |
qed |
6425 |
qed |
|
6426 |
||
71435
d8fb621fea02
some lemmas about the lex ordering on lists, etc.
paulson <lp15@cam.ac.uk>
parents:
71423
diff
changeset
|
6427 |
corollary lex_transI: |
72184 | 6428 |
assumes "trans r" shows "trans (lex r)" |
71435
d8fb621fea02
some lemmas about the lex ordering on lists, etc.
paulson <lp15@cam.ac.uk>
parents:
71423
diff
changeset
|
6429 |
using lexn_transI [OF assms] |
d8fb621fea02
some lemmas about the lex ordering on lists, etc.
paulson <lp15@cam.ac.uk>
parents:
71423
diff
changeset
|
6430 |
by (clarsimp simp add: lex_def trans_def) (metis lexn_length) |
d8fb621fea02
some lemmas about the lex ordering on lists, etc.
paulson <lp15@cam.ac.uk>
parents:
71423
diff
changeset
|
6431 |
|
15302 | 6432 |
lemma lex_conv: |
15656 | 6433 |
"lex r = |
6434 |
{(xs,ys). length xs = length ys \<and> |
|
72184 | 6435 |
(\<exists>xys x y xs' ys'. xs = xys @ x # xs' \<and> ys = xys @ y # ys' \<and> (x, y) \<in> r)}" |
15302 | 6436 |
by (force simp add: lex_def lexn_conv) |
6437 |
||
71585 | 6438 |
lemma wf_lenlex [intro!]: "wf r \<Longrightarrow> wf (lenlex r)" |
15693 | 6439 |
by (unfold lenlex_def) blast |
6440 |
||
6441 |
lemma lenlex_conv: |
|
67091 | 6442 |
"lenlex r = {(xs,ys). length xs < length ys \<or> |
6443 |
length xs = length ys \<and> (xs, ys) \<in> lex r}" |
|
72164
b7c54ff7f2dd
S Holub's proposed generalisation of the lexicographic product of two orderings
paulson <lp15@cam.ac.uk>
parents:
72095
diff
changeset
|
6444 |
by (auto simp add: lenlex_def Id_on_def lex_prod_def inv_image_def) |
15302 | 6445 |
|
71404
f2b783abfbe7
A few lemmas connected with orderings
paulson <lp15@cam.ac.uk>
parents:
71393
diff
changeset
|
6446 |
lemma total_lenlex: |
f2b783abfbe7
A few lemmas connected with orderings
paulson <lp15@cam.ac.uk>
parents:
71393
diff
changeset
|
6447 |
assumes "total r" |
f2b783abfbe7
A few lemmas connected with orderings
paulson <lp15@cam.ac.uk>
parents:
71393
diff
changeset
|
6448 |
shows "total (lenlex r)" |
f2b783abfbe7
A few lemmas connected with orderings
paulson <lp15@cam.ac.uk>
parents:
71393
diff
changeset
|
6449 |
proof - |
f2b783abfbe7
A few lemmas connected with orderings
paulson <lp15@cam.ac.uk>
parents:
71393
diff
changeset
|
6450 |
have "(xs,ys) \<in> lexn r (length xs) \<or> (ys,xs) \<in> lexn r (length xs)" |
f2b783abfbe7
A few lemmas connected with orderings
paulson <lp15@cam.ac.uk>
parents:
71393
diff
changeset
|
6451 |
if "xs \<noteq> ys" and len: "length xs = length ys" for xs ys |
f2b783abfbe7
A few lemmas connected with orderings
paulson <lp15@cam.ac.uk>
parents:
71393
diff
changeset
|
6452 |
proof - |
f2b783abfbe7
A few lemmas connected with orderings
paulson <lp15@cam.ac.uk>
parents:
71393
diff
changeset
|
6453 |
obtain pre x xs' y ys' where "x\<noteq>y" and xs: "xs = pre @ [x] @ xs'" and ys: "ys = pre @ [y] @ys'" |
f2b783abfbe7
A few lemmas connected with orderings
paulson <lp15@cam.ac.uk>
parents:
71393
diff
changeset
|
6454 |
by (meson len \<open>xs \<noteq> ys\<close> same_length_different) |
f2b783abfbe7
A few lemmas connected with orderings
paulson <lp15@cam.ac.uk>
parents:
71393
diff
changeset
|
6455 |
then consider "(x,y) \<in> r" | "(y,x) \<in> r" |
f2b783abfbe7
A few lemmas connected with orderings
paulson <lp15@cam.ac.uk>
parents:
71393
diff
changeset
|
6456 |
by (meson UNIV_I assms total_on_def) |
f2b783abfbe7
A few lemmas connected with orderings
paulson <lp15@cam.ac.uk>
parents:
71393
diff
changeset
|
6457 |
then show ?thesis |
72184 | 6458 |
by cases (use len in \<open>(force simp add: lexn_conv xs ys)+\<close>) |
71404
f2b783abfbe7
A few lemmas connected with orderings
paulson <lp15@cam.ac.uk>
parents:
71393
diff
changeset
|
6459 |
qed |
f2b783abfbe7
A few lemmas connected with orderings
paulson <lp15@cam.ac.uk>
parents:
71393
diff
changeset
|
6460 |
then show ?thesis |
f2b783abfbe7
A few lemmas connected with orderings
paulson <lp15@cam.ac.uk>
parents:
71393
diff
changeset
|
6461 |
by (fastforce simp: lenlex_def total_on_def lex_def) |
f2b783abfbe7
A few lemmas connected with orderings
paulson <lp15@cam.ac.uk>
parents:
71393
diff
changeset
|
6462 |
qed |
f2b783abfbe7
A few lemmas connected with orderings
paulson <lp15@cam.ac.uk>
parents:
71393
diff
changeset
|
6463 |
|
72184 | 6464 |
lemma lenlex_transI [intro]: "trans r \<Longrightarrow> trans (lenlex r)" |
71435
d8fb621fea02
some lemmas about the lex ordering on lists, etc.
paulson <lp15@cam.ac.uk>
parents:
71423
diff
changeset
|
6465 |
unfolding lenlex_def |
72184 | 6466 |
by (meson lex_transI trans_inv_image trans_less_than trans_lex_prod) |
71435
d8fb621fea02
some lemmas about the lex ordering on lists, etc.
paulson <lp15@cam.ac.uk>
parents:
71423
diff
changeset
|
6467 |
|
15302 | 6468 |
lemma Nil_notin_lex [iff]: "([], ys) \<notin> lex r" |
71585 | 6469 |
by (simp add: lex_conv) |
15302 | 6470 |
|
6471 |
lemma Nil2_notin_lex [iff]: "(xs, []) \<notin> lex r" |
|
71585 | 6472 |
by (simp add:lex_conv) |
15302 | 6473 |
|
18447 | 6474 |
lemma Cons_in_lex [simp]: |
72184 | 6475 |
"(x # xs, y # ys) \<in> lex r \<longleftrightarrow> (x, y) \<in> r \<and> length xs = length ys \<or> x = y \<and> (xs, ys) \<in> lex r" |
6476 |
(is "?lhs = ?rhs") |
|
71585 | 6477 |
proof |
6478 |
assume ?lhs then show ?rhs |
|
6479 |
by (simp add: lex_conv) (metis hd_append list.sel(1) list.sel(3) tl_append2) |
|
6480 |
next |
|
6481 |
assume ?rhs then show ?lhs |
|
6482 |
by (simp add: lex_conv) (blast intro: Cons_eq_appendI) |
|
6483 |
qed |
|
66502 | 6484 |
|
71435
d8fb621fea02
some lemmas about the lex ordering on lists, etc.
paulson <lp15@cam.ac.uk>
parents:
71423
diff
changeset
|
6485 |
lemma Nil_lenlex_iff1 [simp]: "([], ns) \<in> lenlex r \<longleftrightarrow> ns \<noteq> []" |
d8fb621fea02
some lemmas about the lex ordering on lists, etc.
paulson <lp15@cam.ac.uk>
parents:
71423
diff
changeset
|
6486 |
and Nil_lenlex_iff2 [simp]: "(ns,[]) \<notin> lenlex r" |
d8fb621fea02
some lemmas about the lex ordering on lists, etc.
paulson <lp15@cam.ac.uk>
parents:
71423
diff
changeset
|
6487 |
by (auto simp: lenlex_def) |
d8fb621fea02
some lemmas about the lex ordering on lists, etc.
paulson <lp15@cam.ac.uk>
parents:
71423
diff
changeset
|
6488 |
|
d8fb621fea02
some lemmas about the lex ordering on lists, etc.
paulson <lp15@cam.ac.uk>
parents:
71423
diff
changeset
|
6489 |
lemma Cons_lenlex_iff: |
d8fb621fea02
some lemmas about the lex ordering on lists, etc.
paulson <lp15@cam.ac.uk>
parents:
71423
diff
changeset
|
6490 |
"((m # ms, n # ns) \<in> lenlex r) \<longleftrightarrow> |
d8fb621fea02
some lemmas about the lex ordering on lists, etc.
paulson <lp15@cam.ac.uk>
parents:
71423
diff
changeset
|
6491 |
length ms < length ns |
72184 | 6492 |
\<or> length ms = length ns \<and> (m,n) \<in> r |
71435
d8fb621fea02
some lemmas about the lex ordering on lists, etc.
paulson <lp15@cam.ac.uk>
parents:
71423
diff
changeset
|
6493 |
\<or> (m = n \<and> (ms,ns) \<in> lenlex r)" |
d8fb621fea02
some lemmas about the lex ordering on lists, etc.
paulson <lp15@cam.ac.uk>
parents:
71423
diff
changeset
|
6494 |
by (auto simp: lenlex_def) |
d8fb621fea02
some lemmas about the lex ordering on lists, etc.
paulson <lp15@cam.ac.uk>
parents:
71423
diff
changeset
|
6495 |
|
71766
1249b998e377
New theory Library/List_Lenlexorder.thy, a type class instantiation for well-ordering lists
paulson <lp15@cam.ac.uk>
parents:
71593
diff
changeset
|
6496 |
lemma lenlex_irreflexive: "(\<And>x. (x,x) \<notin> r) \<Longrightarrow> (xs,xs) \<notin> lenlex r" |
1249b998e377
New theory Library/List_Lenlexorder.thy, a type class instantiation for well-ordering lists
paulson <lp15@cam.ac.uk>
parents:
71593
diff
changeset
|
6497 |
by (induction xs) (auto simp add: Cons_lenlex_iff) |
1249b998e377
New theory Library/List_Lenlexorder.thy, a type class instantiation for well-ordering lists
paulson <lp15@cam.ac.uk>
parents:
71593
diff
changeset
|
6498 |
|
1249b998e377
New theory Library/List_Lenlexorder.thy, a type class instantiation for well-ordering lists
paulson <lp15@cam.ac.uk>
parents:
71593
diff
changeset
|
6499 |
lemma lenlex_trans: |
72184 | 6500 |
"\<lbrakk>(x,y) \<in> lenlex r; (y,z) \<in> lenlex r; trans r\<rbrakk> \<Longrightarrow> (x,z) \<in> lenlex r" |
71766
1249b998e377
New theory Library/List_Lenlexorder.thy, a type class instantiation for well-ordering lists
paulson <lp15@cam.ac.uk>
parents:
71593
diff
changeset
|
6501 |
by (meson lenlex_transI transD) |
1249b998e377
New theory Library/List_Lenlexorder.thy, a type class instantiation for well-ordering lists
paulson <lp15@cam.ac.uk>
parents:
71593
diff
changeset
|
6502 |
|
71435
d8fb621fea02
some lemmas about the lex ordering on lists, etc.
paulson <lp15@cam.ac.uk>
parents:
71423
diff
changeset
|
6503 |
lemma lenlex_length: "(ms, ns) \<in> lenlex r \<Longrightarrow> length ms \<le> length ns" |
d8fb621fea02
some lemmas about the lex ordering on lists, etc.
paulson <lp15@cam.ac.uk>
parents:
71423
diff
changeset
|
6504 |
by (auto simp: lenlex_def) |
d8fb621fea02
some lemmas about the lex ordering on lists, etc.
paulson <lp15@cam.ac.uk>
parents:
71423
diff
changeset
|
6505 |
|
66502 | 6506 |
lemma lex_append_rightI: |
6507 |
"(xs, ys) \<in> lex r \<Longrightarrow> length vs = length us \<Longrightarrow> (xs @ us, ys @ vs) \<in> lex r" |
|
71585 | 6508 |
by (fastforce simp: lex_def lexn_conv) |
66502 | 6509 |
|
6510 |
lemma lex_append_leftI: |
|
6511 |
"(ys, zs) \<in> lex r \<Longrightarrow> (xs @ ys, xs @ zs) \<in> lex r" |
|
71585 | 6512 |
by (induct xs) auto |
66502 | 6513 |
|
6514 |
lemma lex_append_leftD: |
|
6515 |
"\<forall>x. (x,x) \<notin> r \<Longrightarrow> (xs @ ys, xs @ zs) \<in> lex r \<Longrightarrow> (ys, zs) \<in> lex r" |
|
71585 | 6516 |
by (induct xs) auto |
66502 | 6517 |
|
6518 |
lemma lex_append_left_iff: |
|
6519 |
"\<forall>x. (x,x) \<notin> r \<Longrightarrow> (xs @ ys, xs @ zs) \<in> lex r \<longleftrightarrow> (ys, zs) \<in> lex r" |
|
71585 | 6520 |
by(metis lex_append_leftD lex_append_leftI) |
66502 | 6521 |
|
6522 |
lemma lex_take_index: |
|
6523 |
assumes "(xs, ys) \<in> lex r" |
|
71585 | 6524 |
obtains i where "i < length xs" and "i < length ys" and "take i xs = take i ys" |
66502 | 6525 |
and "(xs ! i, ys ! i) \<in> r" |
6526 |
proof - |
|
6527 |
obtain n us x xs' y ys' where "(xs, ys) \<in> lexn r n" and "length xs = n" and "length ys = n" |
|
6528 |
and "xs = us @ x # xs'" and "ys = us @ y # ys'" and "(x, y) \<in> r" |
|
6529 |
using assms by (fastforce simp: lex_def lexn_conv) |
|
6530 |
then show ?thesis by (intro that [of "length us"]) auto |
|
6531 |
qed |
|
15302 | 6532 |
|
71848
3c7852327787
A few new theorems, plus some tidying up
paulson <lp15@cam.ac.uk>
parents:
71827
diff
changeset
|
6533 |
lemma irrefl_lex: "irrefl r \<Longrightarrow> irrefl (lex r)" |
3c7852327787
A few new theorems, plus some tidying up
paulson <lp15@cam.ac.uk>
parents:
71827
diff
changeset
|
6534 |
by (meson irrefl_def lex_take_index) |
3c7852327787
A few new theorems, plus some tidying up
paulson <lp15@cam.ac.uk>
parents:
71827
diff
changeset
|
6535 |
|
72095
cfb6c22a5636
lemmas about sets and the enumerate operator
paulson <lp15@cam.ac.uk>
parents:
71991
diff
changeset
|
6536 |
lemma lexl_not_refl [simp]: "irrefl r \<Longrightarrow> (x,x) \<notin> lex r" |
cfb6c22a5636
lemmas about sets and the enumerate operator
paulson <lp15@cam.ac.uk>
parents:
71991
diff
changeset
|
6537 |
by (meson irrefl_def lex_take_index) |
cfb6c22a5636
lemmas about sets and the enumerate operator
paulson <lp15@cam.ac.uk>
parents:
71991
diff
changeset
|
6538 |
|
71848
3c7852327787
A few new theorems, plus some tidying up
paulson <lp15@cam.ac.uk>
parents:
71827
diff
changeset
|
6539 |
|
60758 | 6540 |
subsubsection \<open>Lexicographic Ordering\<close> |
6541 |
||
6542 |
text \<open>Classical lexicographic ordering on lists, ie. "a" < "ab" < "b". |
|
15656 | 6543 |
This ordering does \emph{not} preserve well-foundedness. |
64963 | 6544 |
Author: N. Voelker, March 2005.\<close> |
15656 | 6545 |
|
50548 | 6546 |
definition lexord :: "('a \<times> 'a) set \<Rightarrow> ('a list \<times> 'a list) set" where |
6547 |
"lexord r = {(x,y). \<exists> a v. y = x @ a # v \<or> |
|
72184 | 6548 |
(\<exists> u a b v w. (a,b) \<in> r \<and> x = u @ (a # v) \<and> y = u @ (b # w))}" |
15656 | 6549 |
|
6550 |
lemma lexord_Nil_left[simp]: "([],y) \<in> lexord r = (\<exists> a x. y = a # x)" |
|
72184 | 6551 |
by (unfold lexord_def, induct_tac y, auto) |
15656 | 6552 |
|
6553 |
lemma lexord_Nil_right[simp]: "(x,[]) \<notin> lexord r" |
|
72184 | 6554 |
by (unfold lexord_def, induct_tac x, auto) |
15656 | 6555 |
|
6556 |
lemma lexord_cons_cons[simp]: |
|
72184 | 6557 |
"(a # x, b # y) \<in> lexord r \<longleftrightarrow> (a,b)\<in> r \<or> (a = b \<and> (x,y)\<in> lexord r)" (is "?lhs = ?rhs") |
71585 | 6558 |
proof |
6559 |
assume ?lhs |
|
6560 |
then show ?rhs |
|
6561 |
apply (simp add: lexord_def) |
|
68719 | 6562 |
apply (metis hd_append list.sel(1) list.sel(3) tl_append2) |
71585 | 6563 |
done |
72184 | 6564 |
qed (auto simp add: lexord_def; (blast | meson Cons_eq_appendI)) |
15656 | 6565 |
|
6566 |
lemmas lexord_simps = lexord_Nil_left lexord_Nil_right lexord_cons_cons |
|
6567 |
||
6568 |
lemma lexord_append_rightI: "\<exists> b z. y = b # z \<Longrightarrow> (x, x @ y) \<in> lexord r" |
|
71585 | 6569 |
by (induct_tac x, auto) |
15656 | 6570 |
|
6571 |
lemma lexord_append_left_rightI: |
|
72184 | 6572 |
"(a,b) \<in> r \<Longrightarrow> (u @ a # x, u @ b # y) \<in> lexord r" |
71585 | 6573 |
by (induct_tac u, auto) |
15656 | 6574 |
|
6575 |
lemma lexord_append_leftI: " (u,v) \<in> lexord r \<Longrightarrow> (x @ u, x @ v) \<in> lexord r" |
|
71585 | 6576 |
by (induct x, auto) |
15656 | 6577 |
|
6578 |
lemma lexord_append_leftD: |
|
71585 | 6579 |
"\<lbrakk>(x @ u, x @ v) \<in> lexord r; (\<forall>a. (a,a) \<notin> r) \<rbrakk> \<Longrightarrow> (u,v) \<in> lexord r" |
6580 |
by (erule rev_mp, induct_tac x, auto) |
|
15656 | 6581 |
|
64963 | 6582 |
lemma lexord_take_index_conv: |
67091 | 6583 |
"((x,y) \<in> lexord r) = |
64963 | 6584 |
((length x < length y \<and> take (length x) y = x) \<or> |
72184 | 6585 |
(\<exists>i. i < min(length x)(length y) \<and> take i x = take i y \<and> (x!i,y!i) \<in> r))" |
71585 | 6586 |
proof - |
6587 |
have "(\<exists>a v. y = x @ a # v) = (length x < length y \<and> take (length x) y = x)" |
|
6588 |
by (metis Cons_nth_drop_Suc append_eq_conv_conj drop_all list.simps(3) not_le) |
|
6589 |
moreover |
|
72184 | 6590 |
have "(\<exists>u a b. (a, b) \<in> r \<and> (\<exists>v. x = u @ a # v) \<and> (\<exists>w. y = u @ b # w)) = |
6591 |
(\<exists>i<length x. i < length y \<and> take i x = take i y \<and> (x ! i, y ! i) \<in> r)" |
|
71585 | 6592 |
apply safe |
6593 |
using less_iff_Suc_add apply auto[1] |
|
6594 |
by (metis id_take_nth_drop) |
|
6595 |
ultimately show ?thesis |
|
6596 |
by (auto simp: lexord_def Let_def) |
|
6597 |
qed |
|
64963 | 6598 |
|
6599 |
\<comment> \<open>lexord is extension of partial ordering List.lex\<close> |
|
41986 | 6600 |
lemma lexord_lex: "(x,y) \<in> lex r = ((x,y) \<in> lexord r \<and> length x = length y)" |
68719 | 6601 |
proof (induction x arbitrary: y) |
6602 |
case (Cons a x y) then show ?case |
|
6603 |
by (cases y) (force+) |
|
6604 |
qed auto |
|
15656 | 6605 |
|
67091 | 6606 |
lemma lexord_irreflexive: "\<forall>x. (x,x) \<notin> r \<Longrightarrow> (xs,xs) \<notin> lexord r" |
72184 | 6607 |
by (induct xs) auto |
41986 | 6608 |
|
60758 | 6609 |
text\<open>By Ren\'e Thiemann:\<close> |
64963 | 6610 |
lemma lexord_partial_trans: |
41986 | 6611 |
"(\<And>x y z. x \<in> set xs \<Longrightarrow> (x,y) \<in> r \<Longrightarrow> (y,z) \<in> r \<Longrightarrow> (x,z) \<in> r) |
6612 |
\<Longrightarrow> (xs,ys) \<in> lexord r \<Longrightarrow> (ys,zs) \<in> lexord r \<Longrightarrow> (xs,zs) \<in> lexord r" |
|
6613 |
proof (induct xs arbitrary: ys zs) |
|
6614 |
case Nil |
|
6615 |
from Nil(3) show ?case unfolding lexord_def by (cases zs, auto) |
|
6616 |
next |
|
6617 |
case (Cons x xs yys zzs) |
|
6618 |
from Cons(3) obtain y ys where yys: "yys = y # ys" unfolding lexord_def |
|
6619 |
by (cases yys, auto) |
|
6620 |
note Cons = Cons[unfolded yys] |
|
72184 | 6621 |
from Cons(3) have one: "(x,y) \<in> r \<or> x = y \<and> (xs,ys) \<in> lexord r" by auto |
41986 | 6622 |
from Cons(4) obtain z zs where zzs: "zzs = z # zs" unfolding lexord_def |
6623 |
by (cases zzs, auto) |
|
6624 |
note Cons = Cons[unfolded zzs] |
|
72184 | 6625 |
from Cons(4) have two: "(y,z) \<in> r \<or> y = z \<and> (ys,zs) \<in> lexord r" by auto |
41986 | 6626 |
{ |
6627 |
assume "(xs,ys) \<in> lexord r" and "(ys,zs) \<in> lexord r" |
|
6628 |
from Cons(1)[OF _ this] Cons(2) |
|
6629 |
have "(xs,zs) \<in> lexord r" by auto |
|
6630 |
} note ind1 = this |
|
6631 |
{ |
|
6632 |
assume "(x,y) \<in> r" and "(y,z) \<in> r" |
|
6633 |
from Cons(2)[OF _ this] have "(x,z) \<in> r" by auto |
|
6634 |
} note ind2 = this |
|
6635 |
from one two ind1 ind2 |
|
72184 | 6636 |
have "(x,z) \<in> r \<or> x = z \<and> (xs,zs) \<in> lexord r" by blast |
6637 |
thus ?case unfolding zzs by auto |
|
41986 | 6638 |
qed |
15656 | 6639 |
|
64963 | 6640 |
lemma lexord_trans: |
72184 | 6641 |
"\<lbrakk> (x, y) \<in> lexord r; (y, z) \<in> lexord r; trans r \<rbrakk> \<Longrightarrow> (x, z) \<in> lexord r" |
6642 |
by(auto simp: trans_def intro:lexord_partial_trans) |
|
6643 |
||
6644 |
lemma lexord_transI: "trans r \<Longrightarrow> trans (lexord r)" |
|
71935
82b00b8f1871
fixed the utterly weird definitions of asym / asymp, and added many asym lemmas
paulson <lp15@cam.ac.uk>
parents:
71860
diff
changeset
|
6645 |
by (meson lexord_trans transI) |
15656 | 6646 |
|
71766
1249b998e377
New theory Library/List_Lenlexorder.thy, a type class instantiation for well-ordering lists
paulson <lp15@cam.ac.uk>
parents:
71593
diff
changeset
|
6647 |
lemma total_lexord: "total r \<Longrightarrow> total (lexord r)" |
1249b998e377
New theory Library/List_Lenlexorder.thy, a type class instantiation for well-ordering lists
paulson <lp15@cam.ac.uk>
parents:
71593
diff
changeset
|
6648 |
unfolding total_on_def |
1249b998e377
New theory Library/List_Lenlexorder.thy, a type class instantiation for well-ordering lists
paulson <lp15@cam.ac.uk>
parents:
71593
diff
changeset
|
6649 |
proof clarsimp |
1249b998e377
New theory Library/List_Lenlexorder.thy, a type class instantiation for well-ordering lists
paulson <lp15@cam.ac.uk>
parents:
71593
diff
changeset
|
6650 |
fix x y |
1249b998e377
New theory Library/List_Lenlexorder.thy, a type class instantiation for well-ordering lists
paulson <lp15@cam.ac.uk>
parents:
71593
diff
changeset
|
6651 |
assume "\<forall>x y. x \<noteq> y \<longrightarrow> (x, y) \<in> r \<or> (y, x) \<in> r" |
1249b998e377
New theory Library/List_Lenlexorder.thy, a type class instantiation for well-ordering lists
paulson <lp15@cam.ac.uk>
parents:
71593
diff
changeset
|
6652 |
and "(x::'a list) \<noteq> y" |
1249b998e377
New theory Library/List_Lenlexorder.thy, a type class instantiation for well-ordering lists
paulson <lp15@cam.ac.uk>
parents:
71593
diff
changeset
|
6653 |
and "(y, x) \<notin> lexord r" |
1249b998e377
New theory Library/List_Lenlexorder.thy, a type class instantiation for well-ordering lists
paulson <lp15@cam.ac.uk>
parents:
71593
diff
changeset
|
6654 |
then |
1249b998e377
New theory Library/List_Lenlexorder.thy, a type class instantiation for well-ordering lists
paulson <lp15@cam.ac.uk>
parents:
71593
diff
changeset
|
6655 |
show "(x, y) \<in> lexord r" |
1249b998e377
New theory Library/List_Lenlexorder.thy, a type class instantiation for well-ordering lists
paulson <lp15@cam.ac.uk>
parents:
71593
diff
changeset
|
6656 |
proof (induction x arbitrary: y) |
1249b998e377
New theory Library/List_Lenlexorder.thy, a type class instantiation for well-ordering lists
paulson <lp15@cam.ac.uk>
parents:
71593
diff
changeset
|
6657 |
case Nil |
1249b998e377
New theory Library/List_Lenlexorder.thy, a type class instantiation for well-ordering lists
paulson <lp15@cam.ac.uk>
parents:
71593
diff
changeset
|
6658 |
then show ?case |
1249b998e377
New theory Library/List_Lenlexorder.thy, a type class instantiation for well-ordering lists
paulson <lp15@cam.ac.uk>
parents:
71593
diff
changeset
|
6659 |
by (metis lexord_Nil_left list.exhaust) |
1249b998e377
New theory Library/List_Lenlexorder.thy, a type class instantiation for well-ordering lists
paulson <lp15@cam.ac.uk>
parents:
71593
diff
changeset
|
6660 |
next |
1249b998e377
New theory Library/List_Lenlexorder.thy, a type class instantiation for well-ordering lists
paulson <lp15@cam.ac.uk>
parents:
71593
diff
changeset
|
6661 |
case (Cons a x y) then show ?case |
72184 | 6662 |
by (cases y) (force+) |
71766
1249b998e377
New theory Library/List_Lenlexorder.thy, a type class instantiation for well-ordering lists
paulson <lp15@cam.ac.uk>
parents:
71593
diff
changeset
|
6663 |
qed |
1249b998e377
New theory Library/List_Lenlexorder.thy, a type class instantiation for well-ordering lists
paulson <lp15@cam.ac.uk>
parents:
71593
diff
changeset
|
6664 |
qed |
1249b998e377
New theory Library/List_Lenlexorder.thy, a type class instantiation for well-ordering lists
paulson <lp15@cam.ac.uk>
parents:
71593
diff
changeset
|
6665 |
|
1249b998e377
New theory Library/List_Lenlexorder.thy, a type class instantiation for well-ordering lists
paulson <lp15@cam.ac.uk>
parents:
71593
diff
changeset
|
6666 |
corollary lexord_linear: "(\<forall>a b. (a,b) \<in> r \<or> a = b \<or> (b,a) \<in> r) \<Longrightarrow> (x,y) \<in> lexord r \<or> x = y \<or> (y,x) \<in> lexord r" |
1249b998e377
New theory Library/List_Lenlexorder.thy, a type class instantiation for well-ordering lists
paulson <lp15@cam.ac.uk>
parents:
71593
diff
changeset
|
6667 |
using total_lexord by (metis UNIV_I total_on_def) |
15656 | 6668 |
|
56545 | 6669 |
lemma lexord_irrefl: |
6670 |
"irrefl R \<Longrightarrow> irrefl (lexord R)" |
|
68085 | 6671 |
by (simp add: irrefl_def lexord_irreflexive) |
64963 | 6672 |
|
56545 | 6673 |
lemma lexord_asym: |
6674 |
assumes "asym R" |
|
6675 |
shows "asym (lexord R)" |
|
71935
82b00b8f1871
fixed the utterly weird definitions of asym / asymp, and added many asym lemmas
paulson <lp15@cam.ac.uk>
parents:
71860
diff
changeset
|
6676 |
proof |
56545 | 6677 |
fix xs ys |
6678 |
assume "(xs, ys) \<in> lexord R" |
|
6679 |
then show "(ys, xs) \<notin> lexord R" |
|
6680 |
proof (induct xs arbitrary: ys) |
|
6681 |
case Nil |
|
6682 |
then show ?case by simp |
|
6683 |
next |
|
6684 |
case (Cons x xs) |
|
6685 |
then obtain z zs where ys: "ys = z # zs" by (cases ys) auto |
|
6686 |
with assms Cons show ?case by (auto elim: asym.cases) |
|
6687 |
qed |
|
6688 |
qed |
|
64963 | 6689 |
|
56545 | 6690 |
lemma lexord_asymmetric: |
6691 |
assumes "asym R" |
|
6692 |
assumes hyp: "(a, b) \<in> lexord R" |
|
6693 |
shows "(b, a) \<notin> lexord R" |
|
6694 |
proof - |
|
60758 | 6695 |
from \<open>asym R\<close> have "asym (lexord R)" by (rule lexord_asym) |
56545 | 6696 |
then show ?thesis by (rule asym.cases) (auto simp add: hyp) |
6697 |
qed |
|
6698 |
||
71935
82b00b8f1871
fixed the utterly weird definitions of asym / asymp, and added many asym lemmas
paulson <lp15@cam.ac.uk>
parents:
71860
diff
changeset
|
6699 |
lemma asym_lex: "asym R \<Longrightarrow> asym (lex R)" |
82b00b8f1871
fixed the utterly weird definitions of asym / asymp, and added many asym lemmas
paulson <lp15@cam.ac.uk>
parents:
71860
diff
changeset
|
6700 |
by (meson asym.simps irrefl_lex lexord_asym lexord_lex) |
82b00b8f1871
fixed the utterly weird definitions of asym / asymp, and added many asym lemmas
paulson <lp15@cam.ac.uk>
parents:
71860
diff
changeset
|
6701 |
|
82b00b8f1871
fixed the utterly weird definitions of asym / asymp, and added many asym lemmas
paulson <lp15@cam.ac.uk>
parents:
71860
diff
changeset
|
6702 |
lemma asym_lenlex: "asym R \<Longrightarrow> asym (lenlex R)" |
82b00b8f1871
fixed the utterly weird definitions of asym / asymp, and added many asym lemmas
paulson <lp15@cam.ac.uk>
parents:
71860
diff
changeset
|
6703 |
by (simp add: lenlex_def asym_inv_image asym_less_than asym_lex asym_lex_prod) |
82b00b8f1871
fixed the utterly weird definitions of asym / asymp, and added many asym lemmas
paulson <lp15@cam.ac.uk>
parents:
71860
diff
changeset
|
6704 |
|
82b00b8f1871
fixed the utterly weird definitions of asym / asymp, and added many asym lemmas
paulson <lp15@cam.ac.uk>
parents:
71860
diff
changeset
|
6705 |
lemma lenlex_append1: |
82b00b8f1871
fixed the utterly weird definitions of asym / asymp, and added many asym lemmas
paulson <lp15@cam.ac.uk>
parents:
71860
diff
changeset
|
6706 |
assumes len: "(us,xs) \<in> lenlex R" and eq: "length vs = length ys" |
82b00b8f1871
fixed the utterly weird definitions of asym / asymp, and added many asym lemmas
paulson <lp15@cam.ac.uk>
parents:
71860
diff
changeset
|
6707 |
shows "(us @ vs, xs @ ys) \<in> lenlex R" |
82b00b8f1871
fixed the utterly weird definitions of asym / asymp, and added many asym lemmas
paulson <lp15@cam.ac.uk>
parents:
71860
diff
changeset
|
6708 |
using len |
82b00b8f1871
fixed the utterly weird definitions of asym / asymp, and added many asym lemmas
paulson <lp15@cam.ac.uk>
parents:
71860
diff
changeset
|
6709 |
proof (induction us) |
82b00b8f1871
fixed the utterly weird definitions of asym / asymp, and added many asym lemmas
paulson <lp15@cam.ac.uk>
parents:
71860
diff
changeset
|
6710 |
case Nil |
82b00b8f1871
fixed the utterly weird definitions of asym / asymp, and added many asym lemmas
paulson <lp15@cam.ac.uk>
parents:
71860
diff
changeset
|
6711 |
then show ?case |
82b00b8f1871
fixed the utterly weird definitions of asym / asymp, and added many asym lemmas
paulson <lp15@cam.ac.uk>
parents:
71860
diff
changeset
|
6712 |
by (simp add: lenlex_def eq) |
82b00b8f1871
fixed the utterly weird definitions of asym / asymp, and added many asym lemmas
paulson <lp15@cam.ac.uk>
parents:
71860
diff
changeset
|
6713 |
next |
82b00b8f1871
fixed the utterly weird definitions of asym / asymp, and added many asym lemmas
paulson <lp15@cam.ac.uk>
parents:
71860
diff
changeset
|
6714 |
case (Cons u us) |
82b00b8f1871
fixed the utterly weird definitions of asym / asymp, and added many asym lemmas
paulson <lp15@cam.ac.uk>
parents:
71860
diff
changeset
|
6715 |
with lex_append_rightI show ?case |
82b00b8f1871
fixed the utterly weird definitions of asym / asymp, and added many asym lemmas
paulson <lp15@cam.ac.uk>
parents:
71860
diff
changeset
|
6716 |
by (fastforce simp add: lenlex_def eq) |
82b00b8f1871
fixed the utterly weird definitions of asym / asymp, and added many asym lemmas
paulson <lp15@cam.ac.uk>
parents:
71860
diff
changeset
|
6717 |
qed |
82b00b8f1871
fixed the utterly weird definitions of asym / asymp, and added many asym lemmas
paulson <lp15@cam.ac.uk>
parents:
71860
diff
changeset
|
6718 |
|
82b00b8f1871
fixed the utterly weird definitions of asym / asymp, and added many asym lemmas
paulson <lp15@cam.ac.uk>
parents:
71860
diff
changeset
|
6719 |
lemma lenlex_append2 [simp]: |
82b00b8f1871
fixed the utterly weird definitions of asym / asymp, and added many asym lemmas
paulson <lp15@cam.ac.uk>
parents:
71860
diff
changeset
|
6720 |
assumes "irrefl R" |
82b00b8f1871
fixed the utterly weird definitions of asym / asymp, and added many asym lemmas
paulson <lp15@cam.ac.uk>
parents:
71860
diff
changeset
|
6721 |
shows "(us @ xs, us @ ys) \<in> lenlex R \<longleftrightarrow> (xs, ys) \<in> lenlex R" |
82b00b8f1871
fixed the utterly weird definitions of asym / asymp, and added many asym lemmas
paulson <lp15@cam.ac.uk>
parents:
71860
diff
changeset
|
6722 |
proof (induction us) |
82b00b8f1871
fixed the utterly weird definitions of asym / asymp, and added many asym lemmas
paulson <lp15@cam.ac.uk>
parents:
71860
diff
changeset
|
6723 |
case Nil |
82b00b8f1871
fixed the utterly weird definitions of asym / asymp, and added many asym lemmas
paulson <lp15@cam.ac.uk>
parents:
71860
diff
changeset
|
6724 |
then show ?case |
82b00b8f1871
fixed the utterly weird definitions of asym / asymp, and added many asym lemmas
paulson <lp15@cam.ac.uk>
parents:
71860
diff
changeset
|
6725 |
by (simp add: lenlex_def) |
82b00b8f1871
fixed the utterly weird definitions of asym / asymp, and added many asym lemmas
paulson <lp15@cam.ac.uk>
parents:
71860
diff
changeset
|
6726 |
next |
82b00b8f1871
fixed the utterly weird definitions of asym / asymp, and added many asym lemmas
paulson <lp15@cam.ac.uk>
parents:
71860
diff
changeset
|
6727 |
case (Cons u us) |
82b00b8f1871
fixed the utterly weird definitions of asym / asymp, and added many asym lemmas
paulson <lp15@cam.ac.uk>
parents:
71860
diff
changeset
|
6728 |
with assms show ?case |
82b00b8f1871
fixed the utterly weird definitions of asym / asymp, and added many asym lemmas
paulson <lp15@cam.ac.uk>
parents:
71860
diff
changeset
|
6729 |
by (auto simp: lenlex_def irrefl_def) |
82b00b8f1871
fixed the utterly weird definitions of asym / asymp, and added many asym lemmas
paulson <lp15@cam.ac.uk>
parents:
71860
diff
changeset
|
6730 |
qed |
56545 | 6731 |
|
60758 | 6732 |
text \<open> |
54593
8c0a27b9c1bd
add predicate version of lexicographic order on lists
Andreas Lochbihler
parents:
54498
diff
changeset
|
6733 |
Predicate version of lexicographic order integrated with Isabelle's order type classes. |
8c0a27b9c1bd
add predicate version of lexicographic order on lists
Andreas Lochbihler
parents:
54498
diff
changeset
|
6734 |
Author: Andreas Lochbihler |
60758 | 6735 |
\<close> |
54593
8c0a27b9c1bd
add predicate version of lexicographic order on lists
Andreas Lochbihler
parents:
54498
diff
changeset
|
6736 |
|
72170
7fa9605b226c
Another go with lex: now lexordp back in class ord
paulson <lp15@cam.ac.uk>
parents:
72164
diff
changeset
|
6737 |
context ord |
61681
ca53150406c9
option "inductive_defs" controls exposure of def and mono facts;
wenzelm
parents:
61630
diff
changeset
|
6738 |
begin |
ca53150406c9
option "inductive_defs" controls exposure of def and mono facts;
wenzelm
parents:
61630
diff
changeset
|
6739 |
|
ca53150406c9
option "inductive_defs" controls exposure of def and mono facts;
wenzelm
parents:
61630
diff
changeset
|
6740 |
context |
62093 | 6741 |
notes [[inductive_internals]] |
61681
ca53150406c9
option "inductive_defs" controls exposure of def and mono facts;
wenzelm
parents:
61630
diff
changeset
|
6742 |
begin |
54593
8c0a27b9c1bd
add predicate version of lexicographic order on lists
Andreas Lochbihler
parents:
54498
diff
changeset
|
6743 |
|
8c0a27b9c1bd
add predicate version of lexicographic order on lists
Andreas Lochbihler
parents:
54498
diff
changeset
|
6744 |
inductive lexordp :: "'a list \<Rightarrow> 'a list \<Rightarrow> bool" |
8c0a27b9c1bd
add predicate version of lexicographic order on lists
Andreas Lochbihler
parents:
54498
diff
changeset
|
6745 |
where |
8c0a27b9c1bd
add predicate version of lexicographic order on lists
Andreas Lochbihler
parents:
54498
diff
changeset
|
6746 |
Nil: "lexordp [] (y # ys)" |
8c0a27b9c1bd
add predicate version of lexicographic order on lists
Andreas Lochbihler
parents:
54498
diff
changeset
|
6747 |
| Cons: "x < y \<Longrightarrow> lexordp (x # xs) (y # ys)" |
8c0a27b9c1bd
add predicate version of lexicographic order on lists
Andreas Lochbihler
parents:
54498
diff
changeset
|
6748 |
| Cons_eq: |
8c0a27b9c1bd
add predicate version of lexicographic order on lists
Andreas Lochbihler
parents:
54498
diff
changeset
|
6749 |
"\<lbrakk> \<not> x < y; \<not> y < x; lexordp xs ys \<rbrakk> \<Longrightarrow> lexordp (x # xs) (y # ys)" |
8c0a27b9c1bd
add predicate version of lexicographic order on lists
Andreas Lochbihler
parents:
54498
diff
changeset
|
6750 |
|
61681
ca53150406c9
option "inductive_defs" controls exposure of def and mono facts;
wenzelm
parents:
61630
diff
changeset
|
6751 |
end |
ca53150406c9
option "inductive_defs" controls exposure of def and mono facts;
wenzelm
parents:
61630
diff
changeset
|
6752 |
|
54593
8c0a27b9c1bd
add predicate version of lexicographic order on lists
Andreas Lochbihler
parents:
54498
diff
changeset
|
6753 |
lemma lexordp_simps [simp]: |
8c0a27b9c1bd
add predicate version of lexicographic order on lists
Andreas Lochbihler
parents:
54498
diff
changeset
|
6754 |
"lexordp [] ys = (ys \<noteq> [])" |
8c0a27b9c1bd
add predicate version of lexicographic order on lists
Andreas Lochbihler
parents:
54498
diff
changeset
|
6755 |
"lexordp xs [] = False" |
8c0a27b9c1bd
add predicate version of lexicographic order on lists
Andreas Lochbihler
parents:
54498
diff
changeset
|
6756 |
"lexordp (x # xs) (y # ys) \<longleftrightarrow> x < y \<or> \<not> y < x \<and> lexordp xs ys" |
8c0a27b9c1bd
add predicate version of lexicographic order on lists
Andreas Lochbihler
parents:
54498
diff
changeset
|
6757 |
by(subst lexordp.simps, fastforce simp add: neq_Nil_conv)+ |
8c0a27b9c1bd
add predicate version of lexicographic order on lists
Andreas Lochbihler
parents:
54498
diff
changeset
|
6758 |
|
8c0a27b9c1bd
add predicate version of lexicographic order on lists
Andreas Lochbihler
parents:
54498
diff
changeset
|
6759 |
inductive lexordp_eq :: "'a list \<Rightarrow> 'a list \<Rightarrow> bool" where |
8c0a27b9c1bd
add predicate version of lexicographic order on lists
Andreas Lochbihler
parents:
54498
diff
changeset
|
6760 |
Nil: "lexordp_eq [] ys" |
8c0a27b9c1bd
add predicate version of lexicographic order on lists
Andreas Lochbihler
parents:
54498
diff
changeset
|
6761 |
| Cons: "x < y \<Longrightarrow> lexordp_eq (x # xs) (y # ys)" |
8c0a27b9c1bd
add predicate version of lexicographic order on lists
Andreas Lochbihler
parents:
54498
diff
changeset
|
6762 |
| Cons_eq: "\<lbrakk> \<not> x < y; \<not> y < x; lexordp_eq xs ys \<rbrakk> \<Longrightarrow> lexordp_eq (x # xs) (y # ys)" |
8c0a27b9c1bd
add predicate version of lexicographic order on lists
Andreas Lochbihler
parents:
54498
diff
changeset
|
6763 |
|
8c0a27b9c1bd
add predicate version of lexicographic order on lists
Andreas Lochbihler
parents:
54498
diff
changeset
|
6764 |
lemma lexordp_eq_simps [simp]: |
8c0a27b9c1bd
add predicate version of lexicographic order on lists
Andreas Lochbihler
parents:
54498
diff
changeset
|
6765 |
"lexordp_eq [] ys = True" |
8c0a27b9c1bd
add predicate version of lexicographic order on lists
Andreas Lochbihler
parents:
54498
diff
changeset
|
6766 |
"lexordp_eq xs [] \<longleftrightarrow> xs = []" |
8c0a27b9c1bd
add predicate version of lexicographic order on lists
Andreas Lochbihler
parents:
54498
diff
changeset
|
6767 |
"lexordp_eq (x # xs) [] = False" |
8c0a27b9c1bd
add predicate version of lexicographic order on lists
Andreas Lochbihler
parents:
54498
diff
changeset
|
6768 |
"lexordp_eq (x # xs) (y # ys) \<longleftrightarrow> x < y \<or> \<not> y < x \<and> lexordp_eq xs ys" |
8c0a27b9c1bd
add predicate version of lexicographic order on lists
Andreas Lochbihler
parents:
54498
diff
changeset
|
6769 |
by(subst lexordp_eq.simps, fastforce)+ |
8c0a27b9c1bd
add predicate version of lexicographic order on lists
Andreas Lochbihler
parents:
54498
diff
changeset
|
6770 |
|
8c0a27b9c1bd
add predicate version of lexicographic order on lists
Andreas Lochbihler
parents:
54498
diff
changeset
|
6771 |
lemma lexordp_append_rightI: "ys \<noteq> Nil \<Longrightarrow> lexordp xs (xs @ ys)" |
8c0a27b9c1bd
add predicate version of lexicographic order on lists
Andreas Lochbihler
parents:
54498
diff
changeset
|
6772 |
by(induct xs)(auto simp add: neq_Nil_conv) |
8c0a27b9c1bd
add predicate version of lexicographic order on lists
Andreas Lochbihler
parents:
54498
diff
changeset
|
6773 |
|
8c0a27b9c1bd
add predicate version of lexicographic order on lists
Andreas Lochbihler
parents:
54498
diff
changeset
|
6774 |
lemma lexordp_append_left_rightI: "x < y \<Longrightarrow> lexordp (us @ x # xs) (us @ y # ys)" |
8c0a27b9c1bd
add predicate version of lexicographic order on lists
Andreas Lochbihler
parents:
54498
diff
changeset
|
6775 |
by(induct us) auto |
8c0a27b9c1bd
add predicate version of lexicographic order on lists
Andreas Lochbihler
parents:
54498
diff
changeset
|
6776 |
|
8c0a27b9c1bd
add predicate version of lexicographic order on lists
Andreas Lochbihler
parents:
54498
diff
changeset
|
6777 |
lemma lexordp_eq_refl: "lexordp_eq xs xs" |
8c0a27b9c1bd
add predicate version of lexicographic order on lists
Andreas Lochbihler
parents:
54498
diff
changeset
|
6778 |
by(induct xs) simp_all |
8c0a27b9c1bd
add predicate version of lexicographic order on lists
Andreas Lochbihler
parents:
54498
diff
changeset
|
6779 |
|
8c0a27b9c1bd
add predicate version of lexicographic order on lists
Andreas Lochbihler
parents:
54498
diff
changeset
|
6780 |
lemma lexordp_append_leftI: "lexordp us vs \<Longrightarrow> lexordp (xs @ us) (xs @ vs)" |
8c0a27b9c1bd
add predicate version of lexicographic order on lists
Andreas Lochbihler
parents:
54498
diff
changeset
|
6781 |
by(induct xs) auto |
8c0a27b9c1bd
add predicate version of lexicographic order on lists
Andreas Lochbihler
parents:
54498
diff
changeset
|
6782 |
|
8c0a27b9c1bd
add predicate version of lexicographic order on lists
Andreas Lochbihler
parents:
54498
diff
changeset
|
6783 |
lemma lexordp_append_leftD: "\<lbrakk> lexordp (xs @ us) (xs @ vs); \<forall>a. \<not> a < a \<rbrakk> \<Longrightarrow> lexordp us vs" |
8c0a27b9c1bd
add predicate version of lexicographic order on lists
Andreas Lochbihler
parents:
54498
diff
changeset
|
6784 |
by(induct xs) auto |
8c0a27b9c1bd
add predicate version of lexicographic order on lists
Andreas Lochbihler
parents:
54498
diff
changeset
|
6785 |
|
64963 | 6786 |
lemma lexordp_irreflexive: |
54593
8c0a27b9c1bd
add predicate version of lexicographic order on lists
Andreas Lochbihler
parents:
54498
diff
changeset
|
6787 |
assumes irrefl: "\<forall>x. \<not> x < x" |
8c0a27b9c1bd
add predicate version of lexicographic order on lists
Andreas Lochbihler
parents:
54498
diff
changeset
|
6788 |
shows "\<not> lexordp xs xs" |
8c0a27b9c1bd
add predicate version of lexicographic order on lists
Andreas Lochbihler
parents:
54498
diff
changeset
|
6789 |
proof |
8c0a27b9c1bd
add predicate version of lexicographic order on lists
Andreas Lochbihler
parents:
54498
diff
changeset
|
6790 |
assume "lexordp xs xs" |
8c0a27b9c1bd
add predicate version of lexicographic order on lists
Andreas Lochbihler
parents:
54498
diff
changeset
|
6791 |
thus False by(induct xs ys\<equiv>xs)(simp_all add: irrefl) |
8c0a27b9c1bd
add predicate version of lexicographic order on lists
Andreas Lochbihler
parents:
54498
diff
changeset
|
6792 |
qed |
8c0a27b9c1bd
add predicate version of lexicographic order on lists
Andreas Lochbihler
parents:
54498
diff
changeset
|
6793 |
|
8c0a27b9c1bd
add predicate version of lexicographic order on lists
Andreas Lochbihler
parents:
54498
diff
changeset
|
6794 |
lemma lexordp_into_lexordp_eq: |
8c0a27b9c1bd
add predicate version of lexicographic order on lists
Andreas Lochbihler
parents:
54498
diff
changeset
|
6795 |
assumes "lexordp xs ys" |
8c0a27b9c1bd
add predicate version of lexicographic order on lists
Andreas Lochbihler
parents:
54498
diff
changeset
|
6796 |
shows "lexordp_eq xs ys" |
8c0a27b9c1bd
add predicate version of lexicographic order on lists
Andreas Lochbihler
parents:
54498
diff
changeset
|
6797 |
using assms by induct simp_all |
8c0a27b9c1bd
add predicate version of lexicographic order on lists
Andreas Lochbihler
parents:
54498
diff
changeset
|
6798 |
|
8c0a27b9c1bd
add predicate version of lexicographic order on lists
Andreas Lochbihler
parents:
54498
diff
changeset
|
6799 |
end |
8c0a27b9c1bd
add predicate version of lexicographic order on lists
Andreas Lochbihler
parents:
54498
diff
changeset
|
6800 |
|
72170
7fa9605b226c
Another go with lex: now lexordp back in class ord
paulson <lp15@cam.ac.uk>
parents:
72164
diff
changeset
|
6801 |
declare ord.lexordp_simps [simp, code] |
7fa9605b226c
Another go with lex: now lexordp back in class ord
paulson <lp15@cam.ac.uk>
parents:
72164
diff
changeset
|
6802 |
declare ord.lexordp_eq_simps [code, simp] |
54593
8c0a27b9c1bd
add predicate version of lexicographic order on lists
Andreas Lochbihler
parents:
54498
diff
changeset
|
6803 |
|
61681
ca53150406c9
option "inductive_defs" controls exposure of def and mono facts;
wenzelm
parents:
61630
diff
changeset
|
6804 |
context order |
ca53150406c9
option "inductive_defs" controls exposure of def and mono facts;
wenzelm
parents:
61630
diff
changeset
|
6805 |
begin |
54593
8c0a27b9c1bd
add predicate version of lexicographic order on lists
Andreas Lochbihler
parents:
54498
diff
changeset
|
6806 |
|
8c0a27b9c1bd
add predicate version of lexicographic order on lists
Andreas Lochbihler
parents:
54498
diff
changeset
|
6807 |
lemma lexordp_antisym: |
8c0a27b9c1bd
add predicate version of lexicographic order on lists
Andreas Lochbihler
parents:
54498
diff
changeset
|
6808 |
assumes "lexordp xs ys" "lexordp ys xs" |
8c0a27b9c1bd
add predicate version of lexicographic order on lists
Andreas Lochbihler
parents:
54498
diff
changeset
|
6809 |
shows False |
72164
b7c54ff7f2dd
S Holub's proposed generalisation of the lexicographic product of two orderings
paulson <lp15@cam.ac.uk>
parents:
72095
diff
changeset
|
6810 |
using assms by induct auto |
54593
8c0a27b9c1bd
add predicate version of lexicographic order on lists
Andreas Lochbihler
parents:
54498
diff
changeset
|
6811 |
|
8c0a27b9c1bd
add predicate version of lexicographic order on lists
Andreas Lochbihler
parents:
54498
diff
changeset
|
6812 |
lemma lexordp_irreflexive': "\<not> lexordp xs xs" |
8c0a27b9c1bd
add predicate version of lexicographic order on lists
Andreas Lochbihler
parents:
54498
diff
changeset
|
6813 |
by(rule lexordp_irreflexive) simp |
8c0a27b9c1bd
add predicate version of lexicographic order on lists
Andreas Lochbihler
parents:
54498
diff
changeset
|
6814 |
|
8c0a27b9c1bd
add predicate version of lexicographic order on lists
Andreas Lochbihler
parents:
54498
diff
changeset
|
6815 |
end |
8c0a27b9c1bd
add predicate version of lexicographic order on lists
Andreas Lochbihler
parents:
54498
diff
changeset
|
6816 |
|
8c0a27b9c1bd
add predicate version of lexicographic order on lists
Andreas Lochbihler
parents:
54498
diff
changeset
|
6817 |
context linorder begin |
8c0a27b9c1bd
add predicate version of lexicographic order on lists
Andreas Lochbihler
parents:
54498
diff
changeset
|
6818 |
|
8c0a27b9c1bd
add predicate version of lexicographic order on lists
Andreas Lochbihler
parents:
54498
diff
changeset
|
6819 |
lemma lexordp_cases [consumes 1, case_names Nil Cons Cons_eq, cases pred: lexordp]: |
8c0a27b9c1bd
add predicate version of lexicographic order on lists
Andreas Lochbihler
parents:
54498
diff
changeset
|
6820 |
assumes "lexordp xs ys" |
8c0a27b9c1bd
add predicate version of lexicographic order on lists
Andreas Lochbihler
parents:
54498
diff
changeset
|
6821 |
obtains (Nil) y ys' where "xs = []" "ys = y # ys'" |
8c0a27b9c1bd
add predicate version of lexicographic order on lists
Andreas Lochbihler
parents:
54498
diff
changeset
|
6822 |
| (Cons) x xs' y ys' where "xs = x # xs'" "ys = y # ys'" "x < y" |
8c0a27b9c1bd
add predicate version of lexicographic order on lists
Andreas Lochbihler
parents:
54498
diff
changeset
|
6823 |
| (Cons_eq) x xs' ys' where "xs = x # xs'" "ys = x # ys'" "lexordp xs' ys'" |
8c0a27b9c1bd
add predicate version of lexicographic order on lists
Andreas Lochbihler
parents:
54498
diff
changeset
|
6824 |
using assms by cases (fastforce simp add: not_less_iff_gr_or_eq)+ |
8c0a27b9c1bd
add predicate version of lexicographic order on lists
Andreas Lochbihler
parents:
54498
diff
changeset
|
6825 |
|
8c0a27b9c1bd
add predicate version of lexicographic order on lists
Andreas Lochbihler
parents:
54498
diff
changeset
|
6826 |
lemma lexordp_induct [consumes 1, case_names Nil Cons Cons_eq, induct pred: lexordp]: |
8c0a27b9c1bd
add predicate version of lexicographic order on lists
Andreas Lochbihler
parents:
54498
diff
changeset
|
6827 |
assumes major: "lexordp xs ys" |
8c0a27b9c1bd
add predicate version of lexicographic order on lists
Andreas Lochbihler
parents:
54498
diff
changeset
|
6828 |
and Nil: "\<And>y ys. P [] (y # ys)" |
8c0a27b9c1bd
add predicate version of lexicographic order on lists
Andreas Lochbihler
parents:
54498
diff
changeset
|
6829 |
and Cons: "\<And>x xs y ys. x < y \<Longrightarrow> P (x # xs) (y # ys)" |
8c0a27b9c1bd
add predicate version of lexicographic order on lists
Andreas Lochbihler
parents:
54498
diff
changeset
|
6830 |
and Cons_eq: "\<And>x xs ys. \<lbrakk> lexordp xs ys; P xs ys \<rbrakk> \<Longrightarrow> P (x # xs) (x # ys)" |
8c0a27b9c1bd
add predicate version of lexicographic order on lists
Andreas Lochbihler
parents:
54498
diff
changeset
|
6831 |
shows "P xs ys" |
8c0a27b9c1bd
add predicate version of lexicographic order on lists
Andreas Lochbihler
parents:
54498
diff
changeset
|
6832 |
using major by induct (simp_all add: Nil Cons not_less_iff_gr_or_eq Cons_eq) |
8c0a27b9c1bd
add predicate version of lexicographic order on lists
Andreas Lochbihler
parents:
54498
diff
changeset
|
6833 |
|
8c0a27b9c1bd
add predicate version of lexicographic order on lists
Andreas Lochbihler
parents:
54498
diff
changeset
|
6834 |
lemma lexordp_iff: |
8c0a27b9c1bd
add predicate version of lexicographic order on lists
Andreas Lochbihler
parents:
54498
diff
changeset
|
6835 |
"lexordp xs ys \<longleftrightarrow> (\<exists>x vs. ys = xs @ x # vs) \<or> (\<exists>us a b vs ws. a < b \<and> xs = us @ a # vs \<and> ys = us @ b # ws)" |
8c0a27b9c1bd
add predicate version of lexicographic order on lists
Andreas Lochbihler
parents:
54498
diff
changeset
|
6836 |
(is "?lhs = ?rhs") |
8c0a27b9c1bd
add predicate version of lexicographic order on lists
Andreas Lochbihler
parents:
54498
diff
changeset
|
6837 |
proof |
8c0a27b9c1bd
add predicate version of lexicographic order on lists
Andreas Lochbihler
parents:
54498
diff
changeset
|
6838 |
assume ?lhs thus ?rhs |
8c0a27b9c1bd
add predicate version of lexicographic order on lists
Andreas Lochbihler
parents:
54498
diff
changeset
|
6839 |
proof induct |
8c0a27b9c1bd
add predicate version of lexicographic order on lists
Andreas Lochbihler
parents:
54498
diff
changeset
|
6840 |
case Cons_eq thus ?case by simp (metis append.simps(2)) |
8c0a27b9c1bd
add predicate version of lexicographic order on lists
Andreas Lochbihler
parents:
54498
diff
changeset
|
6841 |
qed(fastforce intro: disjI2 del: disjCI intro: exI[where x="[]"])+ |
8c0a27b9c1bd
add predicate version of lexicographic order on lists
Andreas Lochbihler
parents:
54498
diff
changeset
|
6842 |
next |
8c0a27b9c1bd
add predicate version of lexicographic order on lists
Andreas Lochbihler
parents:
54498
diff
changeset
|
6843 |
assume ?rhs thus ?lhs |
8c0a27b9c1bd
add predicate version of lexicographic order on lists
Andreas Lochbihler
parents:
54498
diff
changeset
|
6844 |
by(auto intro: lexordp_append_leftI[where us="[]", simplified] lexordp_append_leftI) |
8c0a27b9c1bd
add predicate version of lexicographic order on lists
Andreas Lochbihler
parents:
54498
diff
changeset
|
6845 |
qed |
8c0a27b9c1bd
add predicate version of lexicographic order on lists
Andreas Lochbihler
parents:
54498
diff
changeset
|
6846 |
|
8c0a27b9c1bd
add predicate version of lexicographic order on lists
Andreas Lochbihler
parents:
54498
diff
changeset
|
6847 |
lemma lexordp_conv_lexord: |
8c0a27b9c1bd
add predicate version of lexicographic order on lists
Andreas Lochbihler
parents:
54498
diff
changeset
|
6848 |
"lexordp xs ys \<longleftrightarrow> (xs, ys) \<in> lexord {(x, y). x < y}" |
72184 | 6849 |
by(simp add: lexordp_iff lexord_def) |
54593
8c0a27b9c1bd
add predicate version of lexicographic order on lists
Andreas Lochbihler
parents:
54498
diff
changeset
|
6850 |
|
64963 | 6851 |
lemma lexordp_eq_antisym: |
6852 |
assumes "lexordp_eq xs ys" "lexordp_eq ys xs" |
|
54593
8c0a27b9c1bd
add predicate version of lexicographic order on lists
Andreas Lochbihler
parents:
54498
diff
changeset
|
6853 |
shows "xs = ys" |
8c0a27b9c1bd
add predicate version of lexicographic order on lists
Andreas Lochbihler
parents:
54498
diff
changeset
|
6854 |
using assms by induct simp_all |
8c0a27b9c1bd
add predicate version of lexicographic order on lists
Andreas Lochbihler
parents:
54498
diff
changeset
|
6855 |
|
8c0a27b9c1bd
add predicate version of lexicographic order on lists
Andreas Lochbihler
parents:
54498
diff
changeset
|
6856 |
lemma lexordp_eq_trans: |
8c0a27b9c1bd
add predicate version of lexicographic order on lists
Andreas Lochbihler
parents:
54498
diff
changeset
|
6857 |
assumes "lexordp_eq xs ys" and "lexordp_eq ys zs" |
8c0a27b9c1bd
add predicate version of lexicographic order on lists
Andreas Lochbihler
parents:
54498
diff
changeset
|
6858 |
shows "lexordp_eq xs zs" |
68719 | 6859 |
using assms |
6860 |
by (induct arbitrary: zs) (case_tac zs; auto)+ |
|
54593
8c0a27b9c1bd
add predicate version of lexicographic order on lists
Andreas Lochbihler
parents:
54498
diff
changeset
|
6861 |
|
8c0a27b9c1bd
add predicate version of lexicographic order on lists
Andreas Lochbihler
parents:
54498
diff
changeset
|
6862 |
lemma lexordp_trans: |
8c0a27b9c1bd
add predicate version of lexicographic order on lists
Andreas Lochbihler
parents:
54498
diff
changeset
|
6863 |
assumes "lexordp xs ys" "lexordp ys zs" |
8c0a27b9c1bd
add predicate version of lexicographic order on lists
Andreas Lochbihler
parents:
54498
diff
changeset
|
6864 |
shows "lexordp xs zs" |
68719 | 6865 |
using assms |
6866 |
by (induct arbitrary: zs) (case_tac zs; auto)+ |
|
54593
8c0a27b9c1bd
add predicate version of lexicographic order on lists
Andreas Lochbihler
parents:
54498
diff
changeset
|
6867 |
|
8c0a27b9c1bd
add predicate version of lexicographic order on lists
Andreas Lochbihler
parents:
54498
diff
changeset
|
6868 |
lemma lexordp_linear: "lexordp xs ys \<or> xs = ys \<or> lexordp ys xs" |
68719 | 6869 |
by(induct xs arbitrary: ys; case_tac ys; fastforce) |
54593
8c0a27b9c1bd
add predicate version of lexicographic order on lists
Andreas Lochbihler
parents:
54498
diff
changeset
|
6870 |
|
8c0a27b9c1bd
add predicate version of lexicographic order on lists
Andreas Lochbihler
parents:
54498
diff
changeset
|
6871 |
lemma lexordp_conv_lexordp_eq: "lexordp xs ys \<longleftrightarrow> lexordp_eq xs ys \<and> \<not> lexordp_eq ys xs" |
8c0a27b9c1bd
add predicate version of lexicographic order on lists
Andreas Lochbihler
parents:
54498
diff
changeset
|
6872 |
(is "?lhs \<longleftrightarrow> ?rhs") |
8c0a27b9c1bd
add predicate version of lexicographic order on lists
Andreas Lochbihler
parents:
54498
diff
changeset
|
6873 |
proof |
8c0a27b9c1bd
add predicate version of lexicographic order on lists
Andreas Lochbihler
parents:
54498
diff
changeset
|
6874 |
assume ?lhs |
63540 | 6875 |
hence "\<not> lexordp_eq ys xs" by induct simp_all |
6876 |
with \<open>?lhs\<close> show ?rhs by (simp add: lexordp_into_lexordp_eq) |
|
54593
8c0a27b9c1bd
add predicate version of lexicographic order on lists
Andreas Lochbihler
parents:
54498
diff
changeset
|
6877 |
next |
8c0a27b9c1bd
add predicate version of lexicographic order on lists
Andreas Lochbihler
parents:
54498
diff
changeset
|
6878 |
assume ?rhs |
8c0a27b9c1bd
add predicate version of lexicographic order on lists
Andreas Lochbihler
parents:
54498
diff
changeset
|
6879 |
hence "lexordp_eq xs ys" "\<not> lexordp_eq ys xs" by simp_all |
8c0a27b9c1bd
add predicate version of lexicographic order on lists
Andreas Lochbihler
parents:
54498
diff
changeset
|
6880 |
thus ?lhs by induct simp_all |
8c0a27b9c1bd
add predicate version of lexicographic order on lists
Andreas Lochbihler
parents:
54498
diff
changeset
|
6881 |
qed |
8c0a27b9c1bd
add predicate version of lexicographic order on lists
Andreas Lochbihler
parents:
54498
diff
changeset
|
6882 |
|
8c0a27b9c1bd
add predicate version of lexicographic order on lists
Andreas Lochbihler
parents:
54498
diff
changeset
|
6883 |
lemma lexordp_eq_conv_lexord: "lexordp_eq xs ys \<longleftrightarrow> xs = ys \<or> lexordp xs ys" |
8c0a27b9c1bd
add predicate version of lexicographic order on lists
Andreas Lochbihler
parents:
54498
diff
changeset
|
6884 |
by(auto simp add: lexordp_conv_lexordp_eq lexordp_eq_refl dest: lexordp_eq_antisym) |
8c0a27b9c1bd
add predicate version of lexicographic order on lists
Andreas Lochbihler
parents:
54498
diff
changeset
|
6885 |
|
8c0a27b9c1bd
add predicate version of lexicographic order on lists
Andreas Lochbihler
parents:
54498
diff
changeset
|
6886 |
lemma lexordp_eq_linear: "lexordp_eq xs ys \<or> lexordp_eq ys xs" |
68719 | 6887 |
by (induct xs arbitrary: ys) (case_tac ys; auto)+ |
54593
8c0a27b9c1bd
add predicate version of lexicographic order on lists
Andreas Lochbihler
parents:
54498
diff
changeset
|
6888 |
|
8c0a27b9c1bd
add predicate version of lexicographic order on lists
Andreas Lochbihler
parents:
54498
diff
changeset
|
6889 |
lemma lexordp_linorder: "class.linorder lexordp_eq lexordp" |
68719 | 6890 |
by unfold_locales |
6891 |
(auto simp add: lexordp_conv_lexordp_eq lexordp_eq_refl lexordp_eq_antisym intro: lexordp_eq_trans del: disjCI intro: lexordp_eq_linear) |
|
54593
8c0a27b9c1bd
add predicate version of lexicographic order on lists
Andreas Lochbihler
parents:
54498
diff
changeset
|
6892 |
|
8c0a27b9c1bd
add predicate version of lexicographic order on lists
Andreas Lochbihler
parents:
54498
diff
changeset
|
6893 |
end |
15656 | 6894 |
|
64886 | 6895 |
lemma sorted_insort_is_snoc: "sorted xs \<Longrightarrow> \<forall>x \<in> set xs. a \<ge> x \<Longrightarrow> insort a xs = xs @ [a]" |
68109 | 6896 |
by (induct xs) (auto dest!: insort_is_Cons) |
64886 | 6897 |
|
6898 |
||
60758 | 6899 |
subsubsection \<open>Lexicographic combination of measure functions\<close> |
6900 |
||
6901 |
text \<open>These are useful for termination proofs\<close> |
|
21103
367b4ad7c7cc
Added "measures" combinator for lexicographic combinations of multiple measures.
krauss
parents:
21079
diff
changeset
|
6902 |
|
50548 | 6903 |
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
|
6904 |
|
44013
5cfc1c36ae97
moved recdef package to HOL/Library/Old_Recdef.thy
krauss
parents:
43594
diff
changeset
|
6905 |
lemma wf_measures[simp]: "wf (measures fs)" |
24349 | 6906 |
unfolding measures_def |
6907 |
by blast |
|
21103
367b4ad7c7cc
Added "measures" combinator for lexicographic combinations of multiple measures.
krauss
parents:
21079
diff
changeset
|
6908 |
|
64963 | 6909 |
lemma in_measures[simp]: |
21103
367b4ad7c7cc
Added "measures" combinator for lexicographic combinations of multiple measures.
krauss
parents:
21079
diff
changeset
|
6910 |
"(x, y) \<in> measures [] = False" |
367b4ad7c7cc
Added "measures" combinator for lexicographic combinations of multiple measures.
krauss
parents:
21079
diff
changeset
|
6911 |
"(x, y) \<in> measures (f # fs) |
64963 | 6912 |
= (f x < f y \<or> (f x = f y \<and> (x, y) \<in> measures fs))" |
24349 | 6913 |
unfolding measures_def |
6914 |
by auto |
|
21103
367b4ad7c7cc
Added "measures" combinator for lexicographic combinations of multiple measures.
krauss
parents:
21079
diff
changeset
|
6915 |
|
71585 | 6916 |
lemma measures_less: "f x < f y \<Longrightarrow> (x, y) \<in> measures (f#fs)" |
24349 | 6917 |
by simp |
21103
367b4ad7c7cc
Added "measures" combinator for lexicographic combinations of multiple measures.
krauss
parents:
21079
diff
changeset
|
6918 |
|
71585 | 6919 |
lemma measures_lesseq: "f x \<le> f y \<Longrightarrow> (x, y) \<in> measures fs \<Longrightarrow> (x, y) \<in> measures (f#fs)" |
24349 | 6920 |
by auto |
21103
367b4ad7c7cc
Added "measures" combinator for lexicographic combinations of multiple measures.
krauss
parents:
21079
diff
changeset
|
6921 |
|
367b4ad7c7cc
Added "measures" combinator for lexicographic combinations of multiple measures.
krauss
parents:
21079
diff
changeset
|
6922 |
|
60758 | 6923 |
subsubsection \<open>Lifting Relations to Lists: one element\<close> |
40230 | 6924 |
|
6925 |
definition listrel1 :: "('a \<times> 'a) set \<Rightarrow> ('a list \<times> 'a list) set" where |
|
6926 |
"listrel1 r = {(xs,ys). |
|
6927 |
\<exists>us z z' vs. xs = us @ z # vs \<and> (z,z') \<in> r \<and> ys = us @ z' # vs}" |
|
6928 |
||
6929 |
lemma listrel1I: |
|
6930 |
"\<lbrakk> (x, y) \<in> r; xs = us @ x # vs; ys = us @ y # vs \<rbrakk> \<Longrightarrow> |
|
6931 |
(xs, ys) \<in> listrel1 r" |
|
6932 |
unfolding listrel1_def by auto |
|
6933 |
||
6934 |
lemma listrel1E: |
|
6935 |
"\<lbrakk> (xs, ys) \<in> listrel1 r; |
|
6936 |
!!x y us vs. \<lbrakk> (x, y) \<in> r; xs = us @ x # vs; ys = us @ y # vs \<rbrakk> \<Longrightarrow> P |
|
6937 |
\<rbrakk> \<Longrightarrow> P" |
|
6938 |
unfolding listrel1_def by auto |
|
6939 |
||
6940 |
lemma not_Nil_listrel1 [iff]: "([], xs) \<notin> listrel1 r" |
|
6941 |
unfolding listrel1_def by blast |
|
6942 |
||
6943 |
lemma not_listrel1_Nil [iff]: "(xs, []) \<notin> listrel1 r" |
|
6944 |
unfolding listrel1_def by blast |
|
6945 |
||
6946 |
lemma Cons_listrel1_Cons [iff]: |
|
6947 |
"(x # xs, y # ys) \<in> listrel1 r \<longleftrightarrow> |
|
6948 |
(x,y) \<in> r \<and> xs = ys \<or> x = y \<and> (xs, ys) \<in> listrel1 r" |
|
6949 |
by (simp add: listrel1_def Cons_eq_append_conv) (blast) |
|
6950 |
||
6951 |
lemma listrel1I1: "(x,y) \<in> r \<Longrightarrow> (x # xs, y # xs) \<in> listrel1 r" |
|
56085 | 6952 |
by fast |
40230 | 6953 |
|
6954 |
lemma listrel1I2: "(xs, ys) \<in> listrel1 r \<Longrightarrow> (x # xs, x # ys) \<in> listrel1 r" |
|
56085 | 6955 |
by fast |
40230 | 6956 |
|
6957 |
lemma append_listrel1I: |
|
6958 |
"(xs, ys) \<in> listrel1 r \<and> us = vs \<or> xs = ys \<and> (us, vs) \<in> listrel1 r |
|
6959 |
\<Longrightarrow> (xs @ us, ys @ vs) \<in> listrel1 r" |
|
6960 |
unfolding listrel1_def |
|
6961 |
by auto (blast intro: append_eq_appendI)+ |
|
6962 |
||
6963 |
lemma Cons_listrel1E1[elim!]: |
|
6964 |
assumes "(x # xs, ys) \<in> listrel1 r" |
|
6965 |
and "\<And>y. ys = y # xs \<Longrightarrow> (x, y) \<in> r \<Longrightarrow> R" |
|
6966 |
and "\<And>zs. ys = x # zs \<Longrightarrow> (xs, zs) \<in> listrel1 r \<Longrightarrow> R" |
|
6967 |
shows R |
|
6968 |
using assms by (cases ys) blast+ |
|
6969 |
||
6970 |
lemma Cons_listrel1E2[elim!]: |
|
6971 |
assumes "(xs, y # ys) \<in> listrel1 r" |
|
6972 |
and "\<And>x. xs = x # ys \<Longrightarrow> (x, y) \<in> r \<Longrightarrow> R" |
|
6973 |
and "\<And>zs. xs = y # zs \<Longrightarrow> (zs, ys) \<in> listrel1 r \<Longrightarrow> R" |
|
6974 |
shows R |
|
6975 |
using assms by (cases xs) blast+ |
|
6976 |
||
6977 |
lemma snoc_listrel1_snoc_iff: |
|
6978 |
"(xs @ [x], ys @ [y]) \<in> listrel1 r |
|
6979 |
\<longleftrightarrow> (xs, ys) \<in> listrel1 r \<and> x = y \<or> xs = ys \<and> (x,y) \<in> r" (is "?L \<longleftrightarrow> ?R") |
|
6980 |
proof |
|
6981 |
assume ?L thus ?R |
|
44890
22f665a2e91c
new fastforce replacing fastsimp - less confusing name
nipkow
parents:
44635
diff
changeset
|
6982 |
by (fastforce simp: listrel1_def snoc_eq_iff_butlast butlast_append) |
40230 | 6983 |
next |
6984 |
assume ?R then show ?L unfolding listrel1_def by force |
|
6985 |
qed |
|
6986 |
||
6987 |
lemma listrel1_eq_len: "(xs,ys) \<in> listrel1 r \<Longrightarrow> length xs = length ys" |
|
6988 |
unfolding listrel1_def by auto |
|
6989 |
||
6990 |
lemma listrel1_mono: |
|
6991 |
"r \<subseteq> s \<Longrightarrow> listrel1 r \<subseteq> listrel1 s" |
|
6992 |
unfolding listrel1_def by blast |
|
6993 |
||
6994 |
||
67613 | 6995 |
lemma listrel1_converse: "listrel1 (r\<inverse>) = (listrel1 r)\<inverse>" |
40230 | 6996 |
unfolding listrel1_def by blast |
6997 |
||
6998 |
lemma in_listrel1_converse: |
|
67613 | 6999 |
"(x,y) \<in> listrel1 (r\<inverse>) \<longleftrightarrow> (x,y) \<in> (listrel1 r)\<inverse>" |
40230 | 7000 |
unfolding listrel1_def by blast |
7001 |
||
7002 |
lemma listrel1_iff_update: |
|
7003 |
"(xs,ys) \<in> (listrel1 r) |
|
7004 |
\<longleftrightarrow> (\<exists>y n. (xs ! n, y) \<in> r \<and> n < length xs \<and> ys = xs[n:=y])" (is "?L \<longleftrightarrow> ?R") |
|
7005 |
proof |
|
7006 |
assume "?L" |
|
7007 |
then obtain x y u v where "xs = u @ x # v" "ys = u @ y # v" "(x,y) \<in> r" |
|
7008 |
unfolding listrel1_def by auto |
|
7009 |
then have "ys = xs[length u := y]" and "length u < length xs" |
|
7010 |
and "(xs ! length u, y) \<in> r" by auto |
|
7011 |
then show "?R" by auto |
|
7012 |
next |
|
7013 |
assume "?R" |
|
7014 |
then obtain x y n where "(xs!n, y) \<in> r" "n < size xs" "ys = xs[n:=y]" "x = xs!n" |
|
7015 |
by auto |
|
7016 |
then obtain u v where "xs = u @ x # v" and "ys = u @ y # v" and "(x, y) \<in> r" |
|
7017 |
by (auto intro: upd_conv_take_nth_drop id_take_nth_drop) |
|
7018 |
then show "?L" by (auto simp: listrel1_def) |
|
7019 |
qed |
|
7020 |
||
7021 |
||
60758 | 7022 |
text\<open>Accessible part and wellfoundedness:\<close> |
40230 | 7023 |
|
7024 |
lemma Cons_acc_listrel1I [intro!]: |
|
54295 | 7025 |
"x \<in> Wellfounded.acc r \<Longrightarrow> xs \<in> Wellfounded.acc (listrel1 r) \<Longrightarrow> (x # xs) \<in> Wellfounded.acc (listrel1 r)" |
7026 |
apply (induct arbitrary: xs set: Wellfounded.acc) |
|
40230 | 7027 |
apply (erule thin_rl) |
7028 |
apply (erule acc_induct) |
|
68719 | 7029 |
apply (rule accI) |
40230 | 7030 |
apply (blast) |
7031 |
done |
|
7032 |
||
54295 | 7033 |
lemma lists_accD: "xs \<in> lists (Wellfounded.acc r) \<Longrightarrow> xs \<in> Wellfounded.acc (listrel1 r)" |
68719 | 7034 |
proof (induct set: lists) |
7035 |
case Nil |
|
7036 |
then show ?case |
|
7037 |
by (meson acc.intros not_listrel1_Nil) |
|
7038 |
next |
|
7039 |
case (Cons a l) |
|
7040 |
then show ?case |
|
7041 |
by blast |
|
7042 |
qed |
|
40230 | 7043 |
|
54295 | 7044 |
lemma lists_accI: "xs \<in> Wellfounded.acc (listrel1 r) \<Longrightarrow> xs \<in> lists (Wellfounded.acc r)" |
7045 |
apply (induct set: Wellfounded.acc) |
|
40230 | 7046 |
apply clarify |
7047 |
apply (rule accI) |
|
44890
22f665a2e91c
new fastforce replacing fastsimp - less confusing name
nipkow
parents:
44635
diff
changeset
|
7048 |
apply (fastforce dest!: in_set_conv_decomp[THEN iffD1] simp: listrel1_def) |
40230 | 7049 |
done |
7050 |
||
44510 | 7051 |
lemma wf_listrel1_iff[simp]: "wf(listrel1 r) = wf r" |
56085 | 7052 |
by (auto simp: wf_acc_iff |
7053 |
intro: lists_accD lists_accI[THEN Cons_in_lists_iff[THEN iffD1, THEN conjunct1]]) |
|
40230 | 7054 |
|
60758 | 7055 |
subsubsection \<open>Lifting Relations to Lists: all elements\<close> |
15302 | 7056 |
|
23740 | 7057 |
inductive_set |
46317 | 7058 |
listrel :: "('a \<times> 'b) set \<Rightarrow> ('a list \<times> 'b list) set" |
7059 |
for r :: "('a \<times> 'b) set" |
|
22262 | 7060 |
where |
23740 | 7061 |
Nil: "([],[]) \<in> listrel r" |
71585 | 7062 |
| Cons: "\<lbrakk>(x,y) \<in> r; (xs,ys) \<in> listrel r\<rbrakk> \<Longrightarrow> (x#xs, y#ys) \<in> listrel r" |
23740 | 7063 |
|
7064 |
inductive_cases listrel_Nil1 [elim!]: "([],xs) \<in> listrel r" |
|
7065 |
inductive_cases listrel_Nil2 [elim!]: "(xs,[]) \<in> listrel r" |
|
7066 |
inductive_cases listrel_Cons1 [elim!]: "(y#ys,xs) \<in> listrel r" |
|
7067 |
inductive_cases listrel_Cons2 [elim!]: "(xs,y#ys) \<in> listrel r" |
|
15302 | 7068 |
|
7069 |
||
40230 | 7070 |
lemma listrel_eq_len: "(xs, ys) \<in> listrel r \<Longrightarrow> length xs = length ys" |
71813 | 7071 |
by(induct rule: listrel.induct) auto |
40230 | 7072 |
|
67091 | 7073 |
lemma listrel_iff_zip [code_unfold]: "(xs,ys) \<in> listrel r \<longleftrightarrow> |
7074 |
length xs = length ys \<and> (\<forall>(x,y) \<in> set(zip xs ys). (x,y) \<in> r)" (is "?L \<longleftrightarrow> ?R") |
|
40230 | 7075 |
proof |
7076 |
assume ?L thus ?R by induct (auto intro: listrel_eq_len) |
|
7077 |
next |
|
7078 |
assume ?R thus ?L |
|
7079 |
apply (clarify) |
|
7080 |
by (induct rule: list_induct2) (auto intro: listrel.intros) |
|
7081 |
qed |
|
7082 |
||
67091 | 7083 |
lemma listrel_iff_nth: "(xs,ys) \<in> listrel r \<longleftrightarrow> |
7084 |
length xs = length ys \<and> (\<forall>n < length xs. (xs!n, ys!n) \<in> r)" (is "?L \<longleftrightarrow> ?R") |
|
71813 | 7085 |
by (auto simp add: all_set_conv_all_nth listrel_iff_zip) |
40230 | 7086 |
|
15302 | 7087 |
lemma listrel_mono: "r \<subseteq> s \<Longrightarrow> listrel r \<subseteq> listrel s" |
68719 | 7088 |
by (meson listrel_iff_nth subrelI subset_eq) |
15302 | 7089 |
|
71813 | 7090 |
lemma listrel_subset: |
7091 |
assumes "r \<subseteq> A \<times> A" shows "listrel r \<subseteq> lists A \<times> lists A" |
|
7092 |
proof clarify |
|
7093 |
show "a \<in> lists A \<and> b \<in> lists A" if "(a, b) \<in> listrel r" for a b |
|
7094 |
using that assms by (induction rule: listrel.induct, auto) |
|
7095 |
qed |
|
7096 |
||
7097 |
lemma listrel_refl_on: |
|
7098 |
assumes "refl_on A r" shows "refl_on (lists A) (listrel r)" |
|
7099 |
proof - |
|
7100 |
have "l \<in> lists A \<Longrightarrow> (l, l) \<in> listrel r" for l |
|
7101 |
using assms unfolding refl_on_def |
|
7102 |
by (induction l, auto intro: listrel.intros) |
|
7103 |
then show ?thesis |
|
7104 |
by (meson assms listrel_subset refl_on_def) |
|
7105 |
qed |
|
15302 | 7106 |
|
64963 | 7107 |
lemma listrel_sym: "sym r \<Longrightarrow> sym (listrel r)" |
68719 | 7108 |
by (simp add: listrel_iff_nth sym_def) |
15302 | 7109 |
|
71813 | 7110 |
lemma listrel_trans: |
7111 |
assumes "trans r" shows "trans (listrel r)" |
|
7112 |
proof - |
|
7113 |
have "(x, z) \<in> listrel r" if "(x, y) \<in> listrel r" "(y, z) \<in> listrel r" for x y z |
|
7114 |
using that |
|
7115 |
proof induction |
|
7116 |
case (Cons x y xs ys) |
|
7117 |
then show ?case |
|
7118 |
by clarsimp (metis assms listrel.Cons listrel_iff_nth transD) |
|
7119 |
qed auto |
|
7120 |
then show ?thesis |
|
7121 |
using transI by blast |
|
7122 |
qed |
|
15302 | 7123 |
|
7124 |
theorem equiv_listrel: "equiv A r \<Longrightarrow> equiv (lists A) (listrel r)" |
|
71813 | 7125 |
by (simp add: equiv_def listrel_refl_on listrel_sym listrel_trans) |
15302 | 7126 |
|
67613 | 7127 |
lemma listrel_rtrancl_refl[iff]: "(xs,xs) \<in> listrel(r\<^sup>*)" |
71813 | 7128 |
using listrel_refl_on[of UNIV, OF refl_rtrancl] |
7129 |
by(auto simp: refl_on_def) |
|
40230 | 7130 |
|
7131 |
lemma listrel_rtrancl_trans: |
|
71813 | 7132 |
"\<lbrakk>(xs,ys) \<in> listrel(r\<^sup>*); (ys,zs) \<in> listrel(r\<^sup>*)\<rbrakk> \<Longrightarrow> (xs,zs) \<in> listrel(r\<^sup>*)" |
7133 |
by (metis listrel_trans trans_def trans_rtrancl) |
|
40230 | 7134 |
|
15302 | 7135 |
lemma listrel_Nil [simp]: "listrel r `` {[]} = {[]}" |
71813 | 7136 |
by (blast intro: listrel.intros) |
15302 | 7137 |
|
7138 |
lemma listrel_Cons: |
|
71813 | 7139 |
"listrel r `` {x#xs} = set_Cons (r``{x}) (listrel r `` {xs})" |
7140 |
by (auto simp add: set_Cons_def intro: listrel.intros) |
|
15302 | 7141 |
|
69593 | 7142 |
text \<open>Relating \<^term>\<open>listrel1\<close>, \<^term>\<open>listrel\<close> and closures:\<close> |
40230 | 7143 |
|
71813 | 7144 |
lemma listrel1_rtrancl_subset_rtrancl_listrel1: "listrel1 (r\<^sup>*) \<subseteq> (listrel1 r)\<^sup>*" |
40230 | 7145 |
proof (rule subrelI) |
67613 | 7146 |
fix xs ys assume 1: "(xs,ys) \<in> listrel1 (r\<^sup>*)" |
40230 | 7147 |
{ fix x y us vs |
67613 | 7148 |
have "(x,y) \<in> r\<^sup>* \<Longrightarrow> (us @ x # vs, us @ y # vs) \<in> (listrel1 r)\<^sup>*" |
40230 | 7149 |
proof(induct rule: rtrancl.induct) |
7150 |
case rtrancl_refl show ?case by simp |
|
7151 |
next |
|
7152 |
case rtrancl_into_rtrancl thus ?case |
|
7153 |
by (metis listrel1I rtrancl.rtrancl_into_rtrancl) |
|
7154 |
qed } |
|
67613 | 7155 |
thus "(xs,ys) \<in> (listrel1 r)\<^sup>*" using 1 by(blast elim: listrel1E) |
40230 | 7156 |
qed |
7157 |
||
67613 | 7158 |
lemma rtrancl_listrel1_eq_len: "(x,y) \<in> (listrel1 r)\<^sup>* \<Longrightarrow> length x = length y" |
71813 | 7159 |
by (induct rule: rtrancl.induct) (auto intro: listrel1_eq_len) |
40230 | 7160 |
|
7161 |
lemma rtrancl_listrel1_ConsI1: |
|
67613 | 7162 |
"(xs,ys) \<in> (listrel1 r)\<^sup>* \<Longrightarrow> (x#xs,x#ys) \<in> (listrel1 r)\<^sup>*" |
71813 | 7163 |
proof (induction rule: rtrancl.induct) |
7164 |
case (rtrancl_into_rtrancl a b c) |
|
7165 |
then show ?case |
|
7166 |
by (metis listrel1I2 rtrancl.rtrancl_into_rtrancl) |
|
7167 |
qed auto |
|
40230 | 7168 |
|
7169 |
lemma rtrancl_listrel1_ConsI2: |
|
71813 | 7170 |
"(x,y) \<in> r\<^sup>* \<Longrightarrow> (xs, ys) \<in> (listrel1 r)\<^sup>* \<Longrightarrow> (x # xs, y # ys) \<in> (listrel1 r)\<^sup>*" |
7171 |
by (meson in_mono listrel1I1 listrel1_rtrancl_subset_rtrancl_listrel1 rtrancl_listrel1_ConsI1 rtrancl_trans) |
|
40230 | 7172 |
|
7173 |
lemma listrel1_subset_listrel: |
|
7174 |
"r \<subseteq> r' \<Longrightarrow> refl r' \<Longrightarrow> listrel1 r \<subseteq> listrel(r')" |
|
71813 | 7175 |
by(auto elim!: listrel1E simp add: listrel_iff_zip set_zip refl_on_def) |
40230 | 7176 |
|
7177 |
lemma listrel_reflcl_if_listrel1: |
|
67613 | 7178 |
"(xs,ys) \<in> listrel1 r \<Longrightarrow> (xs,ys) \<in> listrel(r\<^sup>*)" |
71813 | 7179 |
by(erule listrel1E)(auto simp add: listrel_iff_zip set_zip) |
40230 | 7180 |
|
67613 | 7181 |
lemma listrel_rtrancl_eq_rtrancl_listrel1: "listrel (r\<^sup>*) = (listrel1 r)\<^sup>*" |
40230 | 7182 |
proof |
67613 | 7183 |
{ fix x y assume "(x,y) \<in> listrel (r\<^sup>*)" |
7184 |
then have "(x,y) \<in> (listrel1 r)\<^sup>*" |
|
40230 | 7185 |
by induct (auto intro: rtrancl_listrel1_ConsI2) } |
67613 | 7186 |
then show "listrel (r\<^sup>*) \<subseteq> (listrel1 r)\<^sup>*" |
40230 | 7187 |
by (rule subrelI) |
7188 |
next |
|
67613 | 7189 |
show "listrel (r\<^sup>*) \<supseteq> (listrel1 r)\<^sup>*" |
40230 | 7190 |
proof(rule subrelI) |
67613 | 7191 |
fix xs ys assume "(xs,ys) \<in> (listrel1 r)\<^sup>*" |
7192 |
then show "(xs,ys) \<in> listrel (r\<^sup>*)" |
|
40230 | 7193 |
proof induct |
7194 |
case base show ?case by(auto simp add: listrel_iff_zip set_zip) |
|
7195 |
next |
|
7196 |
case (step ys zs) |
|
56085 | 7197 |
thus ?case by (metis listrel_reflcl_if_listrel1 listrel_rtrancl_trans) |
40230 | 7198 |
qed |
7199 |
qed |
|
7200 |
qed |
|
7201 |
||
7202 |
lemma rtrancl_listrel1_if_listrel: |
|
67613 | 7203 |
"(xs,ys) \<in> listrel r \<Longrightarrow> (xs,ys) \<in> (listrel1 r)\<^sup>*" |
71813 | 7204 |
by(metis listrel_rtrancl_eq_rtrancl_listrel1 subsetD[OF listrel_mono] r_into_rtrancl subsetI) |
40230 | 7205 |
|
67613 | 7206 |
lemma listrel_subset_rtrancl_listrel1: "listrel r \<subseteq> (listrel1 r)\<^sup>*" |
71813 | 7207 |
by(fast intro:rtrancl_listrel1_if_listrel) |
40230 | 7208 |
|
15302 | 7209 |
|
60758 | 7210 |
subsection \<open>Size function\<close> |
26749
397a1aeede7d
* New attribute "termination_simp": Simp rules for termination proofs
krauss
parents:
26734
diff
changeset
|
7211 |
|
56643
41d3596d8a64
move size hooks together, with new one preceding old one and sharing same theory data
blanchet
parents:
56545
diff
changeset
|
7212 |
lemma [measure_function]: "is_measure f \<Longrightarrow> is_measure (size_list f)" |
71813 | 7213 |
by (rule is_measure_trivial) |
26875
e18574413bc4
Measure functions can now be declared via special rules, allowing for a
krauss
parents:
26795
diff
changeset
|
7214 |
|
56643
41d3596d8a64
move size hooks together, with new one preceding old one and sharing same theory data
blanchet
parents:
56545
diff
changeset
|
7215 |
lemma [measure_function]: "is_measure f \<Longrightarrow> is_measure (size_option f)" |
71813 | 7216 |
by (rule is_measure_trivial) |
26875
e18574413bc4
Measure functions can now be declared via special rules, allowing for a
krauss
parents:
26795
diff
changeset
|
7217 |
|
64963 | 7218 |
lemma size_list_estimation[termination_simp]: |
56643
41d3596d8a64
move size hooks together, with new one preceding old one and sharing same theory data
blanchet
parents:
56545
diff
changeset
|
7219 |
"x \<in> set xs \<Longrightarrow> y < f x \<Longrightarrow> y < size_list f xs" |
71813 | 7220 |
by (induct xs) auto |
26749
397a1aeede7d
* New attribute "termination_simp": Simp rules for termination proofs
krauss
parents:
26734
diff
changeset
|
7221 |
|
64963 | 7222 |
lemma size_list_estimation'[termination_simp]: |
56643
41d3596d8a64
move size hooks together, with new one preceding old one and sharing same theory data
blanchet
parents:
56545
diff
changeset
|
7223 |
"x \<in> set xs \<Longrightarrow> y \<le> f x \<Longrightarrow> y \<le> size_list f xs" |
71813 | 7224 |
by (induct xs) auto |
26875
e18574413bc4
Measure functions can now be declared via special rules, allowing for a
krauss
parents:
26795
diff
changeset
|
7225 |
|
67091 | 7226 |
lemma size_list_map[simp]: "size_list f (map g xs) = size_list (f \<circ> g) xs" |
71813 | 7227 |
by (induct xs) auto |
26875
e18574413bc4
Measure functions can now be declared via special rules, allowing for a
krauss
parents:
26795
diff
changeset
|
7228 |
|
56643
41d3596d8a64
move size hooks together, with new one preceding old one and sharing same theory data
blanchet
parents:
56545
diff
changeset
|
7229 |
lemma size_list_append[simp]: "size_list f (xs @ ys) = size_list f xs + size_list f ys" |
71813 | 7230 |
by (induct xs, auto) |
44619
fd520fa2fb09
adding list_size_append (thanks to Rene Thiemann)
bulwahn
parents:
44618
diff
changeset
|
7231 |
|
64963 | 7232 |
lemma size_list_pointwise[termination_simp]: |
56643
41d3596d8a64
move size hooks together, with new one preceding old one and sharing same theory data
blanchet
parents:
56545
diff
changeset
|
7233 |
"(\<And>x. x \<in> set xs \<Longrightarrow> f x \<le> g x) \<Longrightarrow> size_list f xs \<le> size_list g xs" |
71813 | 7234 |
by (induct xs) force+ |
26749
397a1aeede7d
* New attribute "termination_simp": Simp rules for termination proofs
krauss
parents:
26734
diff
changeset
|
7235 |
|
31048
ac146fc38b51
refined HOL string theories and corresponding ML fragments
haftmann
parents:
31022
diff
changeset
|
7236 |
|
60758 | 7237 |
subsection \<open>Monad operation\<close> |
46143 | 7238 |
|
7239 |
definition bind :: "'a list \<Rightarrow> ('a \<Rightarrow> 'b list) \<Rightarrow> 'b list" where |
|
50548 | 7240 |
"bind xs f = concat (map f xs)" |
46143 | 7241 |
|
7242 |
hide_const (open) bind |
|
7243 |
||
7244 |
lemma bind_simps [simp]: |
|
7245 |
"List.bind [] f = []" |
|
7246 |
"List.bind (x # xs) f = f x @ List.bind xs f" |
|
7247 |
by (simp_all add: bind_def) |
|
7248 |
||
63099
af0e964aad7b
Moved material from AFP/Randomised_Social_Choice to distribution
eberlm
parents:
63092
diff
changeset
|
7249 |
lemma list_bind_cong [fundef_cong]: |
af0e964aad7b
Moved material from AFP/Randomised_Social_Choice to distribution
eberlm
parents:
63092
diff
changeset
|
7250 |
assumes "xs = ys" "(\<And>x. x \<in> set xs \<Longrightarrow> f x = g x)" |
af0e964aad7b
Moved material from AFP/Randomised_Social_Choice to distribution
eberlm
parents:
63092
diff
changeset
|
7251 |
shows "List.bind xs f = List.bind ys g" |
af0e964aad7b
Moved material from AFP/Randomised_Social_Choice to distribution
eberlm
parents:
63092
diff
changeset
|
7252 |
proof - |
af0e964aad7b
Moved material from AFP/Randomised_Social_Choice to distribution
eberlm
parents:
63092
diff
changeset
|
7253 |
from assms(2) have "List.bind xs f = List.bind xs g" |
af0e964aad7b
Moved material from AFP/Randomised_Social_Choice to distribution
eberlm
parents:
63092
diff
changeset
|
7254 |
by (induction xs) simp_all |
af0e964aad7b
Moved material from AFP/Randomised_Social_Choice to distribution
eberlm
parents:
63092
diff
changeset
|
7255 |
with assms(1) show ?thesis by simp |
af0e964aad7b
Moved material from AFP/Randomised_Social_Choice to distribution
eberlm
parents:
63092
diff
changeset
|
7256 |
qed |
af0e964aad7b
Moved material from AFP/Randomised_Social_Choice to distribution
eberlm
parents:
63092
diff
changeset
|
7257 |
|
af0e964aad7b
Moved material from AFP/Randomised_Social_Choice to distribution
eberlm
parents:
63092
diff
changeset
|
7258 |
lemma set_list_bind: "set (List.bind xs f) = (\<Union>x\<in>set xs. set (f x))" |
64963 | 7259 |
by (induction xs) simp_all |
63099
af0e964aad7b
Moved material from AFP/Randomised_Social_Choice to distribution
eberlm
parents:
63092
diff
changeset
|
7260 |
|
46143 | 7261 |
|
60758 | 7262 |
subsection \<open>Code generation\<close> |
7263 |
||
69593 | 7264 |
text\<open>Optional tail recursive version of \<^const>\<open>map\<close>. Can avoid |
60758 | 7265 |
stack overflow in some target languages.\<close> |
51875
dafd097dd1f4
tail recursive version of map, for code generation, optionally
nipkow
parents:
51738
diff
changeset
|
7266 |
|
dafd097dd1f4
tail recursive version of map, for code generation, optionally
nipkow
parents:
51738
diff
changeset
|
7267 |
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
|
7268 |
"map_tailrec_rev f [] bs = bs" | |
dafd097dd1f4
tail recursive version of map, for code generation, optionally
nipkow
parents:
51738
diff
changeset
|
7269 |
"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
|
7270 |
|
dafd097dd1f4
tail recursive version of map, for code generation, optionally
nipkow
parents:
51738
diff
changeset
|
7271 |
lemma map_tailrec_rev: |
dafd097dd1f4
tail recursive version of map, for code generation, optionally
nipkow
parents:
51738
diff
changeset
|
7272 |
"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
|
7273 |
by(induction as arbitrary: bs) simp_all |
dafd097dd1f4
tail recursive version of map, for code generation, optionally
nipkow
parents:
51738
diff
changeset
|
7274 |
|
dafd097dd1f4
tail recursive version of map, for code generation, optionally
nipkow
parents:
51738
diff
changeset
|
7275 |
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
|
7276 |
"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
|
7277 |
|
60758 | 7278 |
text\<open>Code equation:\<close> |
51875
dafd097dd1f4
tail recursive version of map, for code generation, optionally
nipkow
parents:
51738
diff
changeset
|
7279 |
lemma map_eq_map_tailrec: "map = map_tailrec" |
dafd097dd1f4
tail recursive version of map, for code generation, optionally
nipkow
parents:
51738
diff
changeset
|
7280 |
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
|
7281 |
|
dafd097dd1f4
tail recursive version of map, for code generation, optionally
nipkow
parents:
51738
diff
changeset
|
7282 |
|
60758 | 7283 |
subsubsection \<open>Counterparts for set-related operations\<close> |
37605
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
7284 |
|
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
7285 |
definition member :: "'a list \<Rightarrow> 'a \<Rightarrow> bool" where |
50548 | 7286 |
[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
|
7287 |
|
60758 | 7288 |
text \<open> |
61799 | 7289 |
Use \<open>member\<close> only for generating executable code. Otherwise use |
69593 | 7290 |
\<^prop>\<open>x \<in> set xs\<close> instead --- it is much easier to reason about. |
60758 | 7291 |
\<close> |
37605
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
7292 |
|
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
7293 |
lemma member_rec [code]: |
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
7294 |
"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
|
7295 |
"member [] y \<longleftrightarrow> False" |
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
7296 |
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
|
7297 |
|
46030
51b2f3412a03
attribute code_abbrev superseedes code_unfold_post; tuned text
haftmann
parents:
45993
diff
changeset
|
7298 |
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
|
7299 |
"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
|
7300 |
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
|
7301 |
|
62328 | 7302 |
lemmas list_all_iff [code_abbrev] = fun_cong[OF list.pred_set] |
37605
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
7303 |
|
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
7304 |
definition list_ex :: "('a \<Rightarrow> bool) \<Rightarrow> 'a list \<Rightarrow> bool" where |
50548 | 7305 |
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
|
7306 |
|
51b2f3412a03
attribute code_abbrev superseedes code_unfold_post; tuned text
haftmann
parents:
45993
diff
changeset
|
7307 |
definition list_ex1 :: "('a \<Rightarrow> bool) \<Rightarrow> 'a list \<Rightarrow> bool" where |
50548 | 7308 |
list_ex1_iff [code_abbrev]: "list_ex1 P xs \<longleftrightarrow> (\<exists>! x. x \<in> set xs \<and> P x)" |
40652 | 7309 |
|
60758 | 7310 |
text \<open> |
61799 | 7311 |
Usually you should prefer \<open>\<forall>x\<in>set xs\<close>, \<open>\<exists>x\<in>set xs\<close> |
69593 | 7312 |
and \<open>\<exists>!x. x\<in>set xs \<and> _\<close> over \<^const>\<open>list_all\<close>, \<^const>\<open>list_ex\<close> |
7313 |
and \<^const>\<open>list_ex1\<close> in specifications. |
|
60758 | 7314 |
\<close> |
37605
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
7315 |
|
56527
907f04603177
make list_all an abbreviation of pred_list - prevent duplication
kuncar
parents:
56525
diff
changeset
|
7316 |
lemma list_all_simps [code]: |
37605
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
7317 |
"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
|
7318 |
"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
|
7319 |
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
|
7320 |
|
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
7321 |
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
|
7322 |
"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
|
7323 |
"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
|
7324 |
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
|
7325 |
|
40652 | 7326 |
lemma list_ex1_simps [simp, code]: |
7327 |
"list_ex1 P [] = False" |
|
7328 |
"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
|
7329 |
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
|
7330 |
|
51b2f3412a03
attribute code_abbrev superseedes code_unfold_post; tuned text
haftmann
parents:
45993
diff
changeset
|
7331 |
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
|
7332 |
"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
|
7333 |
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
|
7334 |
|
46030
51b2f3412a03
attribute code_abbrev superseedes code_unfold_post; tuned text
haftmann
parents:
45993
diff
changeset
|
7335 |
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
|
7336 |
"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
|
7337 |
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
|
7338 |
|
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
7339 |
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
|
7340 |
"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
|
7341 |
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
|
7342 |
|
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
7343 |
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
|
7344 |
"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
|
7345 |
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
|
7346 |
|
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
7347 |
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
|
7348 |
"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
|
7349 |
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
|
7350 |
|
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
7351 |
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
|
7352 |
"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
|
7353 |
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
|
7354 |
|
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
7355 |
lemma list_all_length: |
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
7356 |
"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
|
7357 |
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
|
7358 |
|
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
7359 |
lemma list_ex_length: |
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
7360 |
"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
|
7361 |
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
|
7362 |
|
62328 | 7363 |
lemmas list_all_cong [fundef_cong] = list.pred_cong |
37605
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
7364 |
|
47131 | 7365 |
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
|
7366 |
"xs = ys \<Longrightarrow> (\<And>x. x \<in> set ys \<Longrightarrow> f x = g x) \<Longrightarrow> list_ex f xs = list_ex g ys" |
47131 | 7367 |
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
|
7368 |
|
50548 | 7369 |
definition can_select :: "('a \<Rightarrow> bool) \<Rightarrow> 'a set \<Rightarrow> bool" where |
7370 |
[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
|
7371 |
|
744934b818c7
moved quite generic material from theory Enum to more appropriate places
haftmann
parents:
49808
diff
changeset
|
7372 |
lemma can_select_set_list_ex1 [code]: |
744934b818c7
moved quite generic material from theory Enum to more appropriate places
haftmann
parents:
49808
diff
changeset
|
7373 |
"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
|
7374 |
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
|
7375 |
|
744934b818c7
moved quite generic material from theory Enum to more appropriate places
haftmann
parents:
49808
diff
changeset
|
7376 |
|
60758 | 7377 |
text \<open>Executable checks for relations on sets\<close> |
46313 | 7378 |
|
7379 |
definition listrel1p :: "('a \<Rightarrow> 'a \<Rightarrow> bool) \<Rightarrow> 'a list \<Rightarrow> 'a list \<Rightarrow> bool" where |
|
7380 |
"listrel1p r xs ys = ((xs, ys) \<in> listrel1 {(x, y). r x y})" |
|
7381 |
||
7382 |
lemma [code_unfold]: |
|
7383 |
"(xs, ys) \<in> listrel1 r = listrel1p (\<lambda>x y. (x, y) \<in> r) xs ys" |
|
7384 |
unfolding listrel1p_def by auto |
|
7385 |
||
7386 |
lemma [code]: |
|
7387 |
"listrel1p r [] xs = False" |
|
7388 |
"listrel1p r xs [] = False" |
|
7389 |
"listrel1p r (x # xs) (y # ys) \<longleftrightarrow> |
|
7390 |
r x y \<and> xs = ys \<or> x = y \<and> listrel1p r xs ys" |
|
7391 |
by (simp add: listrel1p_def)+ |
|
7392 |
||
7393 |
definition |
|
7394 |
lexordp :: "('a \<Rightarrow> 'a \<Rightarrow> bool) \<Rightarrow> 'a list \<Rightarrow> 'a list \<Rightarrow> bool" where |
|
7395 |
"lexordp r xs ys = ((xs, ys) \<in> lexord {(x, y). r x y})" |
|
7396 |
||
7397 |
lemma [code_unfold]: |
|
7398 |
"(xs, ys) \<in> lexord r = lexordp (\<lambda>x y. (x, y) \<in> r) xs ys" |
|
7399 |
unfolding lexordp_def by auto |
|
7400 |
||
7401 |
lemma [code]: |
|
7402 |
"lexordp r xs [] = False" |
|
7403 |
"lexordp r [] (y#ys) = True" |
|
72184 | 7404 |
"lexordp r (x # xs) (y # ys) = (r x y \<or> (x = y \<and> lexordp r xs ys))" |
7405 |
unfolding lexordp_def by auto |
|
46313 | 7406 |
|
60758 | 7407 |
text \<open>Bounded quantification and summation over nats.\<close> |
37605
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
7408 |
|
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
7409 |
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
|
7410 |
"{..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
|
7411 |
by auto |
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
7412 |
|
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
7413 |
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
|
7414 |
"{..<n} = set [0..<n]" |
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
7415 |
by auto |
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
7416 |
|
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
7417 |
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
|
7418 |
"{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
|
7419 |
by auto |
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
7420 |
|
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
7421 |
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
|
7422 |
|
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
7423 |
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
|
7424 |
"{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
|
7425 |
by auto |
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
7426 |
|
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
7427 |
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
|
7428 |
"{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
|
7429 |
by auto |
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
7430 |
|
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
7431 |
lemma all_nat_less_eq [code_unfold]: |
61076 | 7432 |
"(\<forall>m<n::nat. P m) \<longleftrightarrow> (\<forall>m \<in> {0..<n}. P m)" |
37605
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
7433 |
by auto |
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
7434 |
|
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
7435 |
lemma ex_nat_less_eq [code_unfold]: |
61076 | 7436 |
"(\<exists>m<n::nat. P m) \<longleftrightarrow> (\<exists>m \<in> {0..<n}. P m)" |
37605
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
7437 |
by auto |
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
7438 |
|
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
7439 |
lemma all_nat_less [code_unfold]: |
61076 | 7440 |
"(\<forall>m\<le>n::nat. P m) \<longleftrightarrow> (\<forall>m \<in> {0..n}. P m)" |
37605
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
7441 |
by auto |
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
7442 |
|
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
7443 |
lemma ex_nat_less [code_unfold]: |
61076 | 7444 |
"(\<exists>m\<le>n::nat. P m) \<longleftrightarrow> (\<exists>m \<in> {0..n}. P m)" |
37605
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
7445 |
by auto |
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
7446 |
|
61799 | 7447 |
text\<open>Bounded \<open>LEAST\<close> operator:\<close> |
53954 | 7448 |
|
7449 |
definition "Bleast S P = (LEAST x. x \<in> S \<and> P x)" |
|
7450 |
||
7451 |
definition "abort_Bleast S P = (LEAST x. x \<in> S \<and> P x)" |
|
7452 |
||
54890
cb892d835803
fundamental treatment of undefined vs. universally partial replaces code_abort
haftmann
parents:
54885
diff
changeset
|
7453 |
declare [[code abort: abort_Bleast]] |
53954 | 7454 |
|
7455 |
lemma Bleast_code [code]: |
|
7456 |
"Bleast (set xs) P = (case filter P (sort xs) of |
|
7457 |
x#xs \<Rightarrow> x | |
|
7458 |
[] \<Rightarrow> abort_Bleast (set xs) P)" |
|
7459 |
proof (cases "filter P (sort xs)") |
|
7460 |
case Nil thus ?thesis by (simp add: Bleast_def abort_Bleast_def) |
|
7461 |
next |
|
7462 |
case (Cons x ys) |
|
7463 |
have "(LEAST x. x \<in> set xs \<and> P x) = x" |
|
7464 |
proof (rule Least_equality) |
|
7465 |
show "x \<in> set xs \<and> P x" |
|
7466 |
by (metis Cons Cons_eq_filter_iff in_set_conv_decomp set_sort) |
|
7467 |
next |
|
67613 | 7468 |
fix y assume "y \<in> set xs \<and> P y" |
7469 |
hence "y \<in> set (filter P xs)" by auto |
|
53954 | 7470 |
thus "x \<le> y" |
68109 | 7471 |
by (metis Cons eq_iff filter_sort set_ConsD set_sort sorted.simps(2) sorted_sort) |
53954 | 7472 |
qed |
7473 |
thus ?thesis using Cons by (simp add: Bleast_def) |
|
7474 |
qed |
|
7475 |
||
7476 |
declare Bleast_def[symmetric, code_unfold] |
|
7477 |
||
60758 | 7478 |
text \<open>Summation over ints.\<close> |
37605
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
7479 |
|
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
7480 |
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
|
7481 |
"{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
|
7482 |
by auto |
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
7483 |
|
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
7484 |
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
|
7485 |
"{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
|
7486 |
by auto |
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
7487 |
|
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
7488 |
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
|
7489 |
"{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
|
7490 |
by auto |
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
7491 |
|
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
7492 |
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
|
7493 |
|
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
7494 |
|
60758 | 7495 |
subsubsection \<open>Optimizing by rewriting\<close> |
37605
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
7496 |
|
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
7497 |
definition null :: "'a list \<Rightarrow> bool" where |
46030
51b2f3412a03
attribute code_abbrev superseedes code_unfold_post; tuned text
haftmann
parents:
45993
diff
changeset
|
7498 |
[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
|
7499 |
|
60758 | 7500 |
text \<open> |
69593 | 7501 |
Efficient emptyness check is implemented by \<^const>\<open>null\<close>. |
60758 | 7502 |
\<close> |
37605
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
7503 |
|
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
7504 |
lemma null_rec [code]: |
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
7505 |
"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
|
7506 |
"null [] \<longleftrightarrow> True" |
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
7507 |
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
|
7508 |
|
46030
51b2f3412a03
attribute code_abbrev superseedes code_unfold_post; tuned text
haftmann
parents:
45993
diff
changeset
|
7509 |
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
|
7510 |
"xs = [] \<longleftrightarrow> null xs" |
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
7511 |
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
|
7512 |
|
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
7513 |
lemma equal_Nil_null [code_unfold]: |
38857
97775f3e8722
renamed class/constant eq to equal; tuned some instantiations
haftmann
parents:
38715
diff
changeset
|
7514 |
"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
|
7515 |
"HOL.equal [] = null" |
36cf426cb1c6
Added symmetric code_unfold-lemmas for null and is_none
lammich <lammich@in.tum.de>
parents:
53721
diff
changeset
|
7516 |
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
|
7517 |
|
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
7518 |
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
|
7519 |
[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
|
7520 |
|
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
7521 |
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
|
7522 |
[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
|
7523 |
|
60758 | 7524 |
text \<open> |
69593 | 7525 |
Operations \<^const>\<open>maps\<close> and \<^const>\<open>map_filter\<close> avoid |
37605
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
7526 |
intermediate lists on execution -- do not use for proving. |
60758 | 7527 |
\<close> |
37605
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
7528 |
|
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
7529 |
lemma maps_simps [code]: |
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
7530 |
"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
|
7531 |
"maps f [] = []" |
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
7532 |
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
|
7533 |
|
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
7534 |
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
|
7535 |
"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
|
7536 |
"map_filter f [] = []" |
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
7537 |
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
|
7538 |
|
46030
51b2f3412a03
attribute code_abbrev superseedes code_unfold_post; tuned text
haftmann
parents:
45993
diff
changeset
|
7539 |
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
|
7540 |
"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
|
7541 |
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
|
7542 |
|
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
7543 |
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
|
7544 |
"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
|
7545 |
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
|
7546 |
|
61799 | 7547 |
text \<open>Optimized code for \<open>\<forall>i\<in>{a..b::int}\<close> and \<open>\<forall>n:{a..<b::nat}\<close> |
7548 |
and similiarly for \<open>\<exists>\<close>.\<close> |
|
37605
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
7549 |
|
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
7550 |
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
|
7551 |
"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
|
7552 |
|
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
7553 |
lemma [code]: |
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
7554 |
"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
|
7555 |
proof - |
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
7556 |
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
|
7557 |
proof - |
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
7558 |
fix n |
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
7559 |
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
|
7560 |
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
|
7561 |
qed |
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
7562 |
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
|
7563 |
qed |
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
7564 |
|
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
7565 |
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
|
7566 |
"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
|
7567 |
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
|
7568 |
|
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
7569 |
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
|
7570 |
"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
|
7571 |
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
|
7572 |
|
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
7573 |
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
|
7574 |
"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
|
7575 |
|
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
7576 |
lemma [code]: |
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
7577 |
"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
|
7578 |
proof - |
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
7579 |
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
|
7580 |
proof - |
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
7581 |
fix k |
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
7582 |
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
|
7583 |
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
|
7584 |
qed |
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
7585 |
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
|
7586 |
qed |
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
7587 |
|
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
7588 |
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
|
7589 |
"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
|
7590 |
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
|
7591 |
|
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
7592 |
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
|
7593 |
"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
|
7594 |
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
|
7595 |
|
69593 | 7596 |
text \<open>optimized code (tail-recursive) for \<^term>\<open>length\<close>\<close> |
49808
418991ce7567
tail-recursive implementation for length
Andreas Lochbihler
parents:
49757
diff
changeset
|
7597 |
|
418991ce7567
tail-recursive implementation for length
Andreas Lochbihler
parents:
49757
diff
changeset
|
7598 |
definition gen_length :: "nat \<Rightarrow> 'a list \<Rightarrow> nat" |
418991ce7567
tail-recursive implementation for length
Andreas Lochbihler
parents:
49757
diff
changeset
|
7599 |
where "gen_length n xs = n + length xs" |
418991ce7567
tail-recursive implementation for length
Andreas Lochbihler
parents:
49757
diff
changeset
|
7600 |
|
418991ce7567
tail-recursive implementation for length
Andreas Lochbihler
parents:
49757
diff
changeset
|
7601 |
lemma gen_length_code [code]: |
418991ce7567
tail-recursive implementation for length
Andreas Lochbihler
parents:
49757
diff
changeset
|
7602 |
"gen_length n [] = n" |
418991ce7567
tail-recursive implementation for length
Andreas Lochbihler
parents:
49757
diff
changeset
|
7603 |
"gen_length n (x # xs) = gen_length (Suc n) xs" |
418991ce7567
tail-recursive implementation for length
Andreas Lochbihler
parents:
49757
diff
changeset
|
7604 |
by(simp_all add: gen_length_def) |
418991ce7567
tail-recursive implementation for length
Andreas Lochbihler
parents:
49757
diff
changeset
|
7605 |
|
418991ce7567
tail-recursive implementation for length
Andreas Lochbihler
parents:
49757
diff
changeset
|
7606 |
declare list.size(3-4)[code del] |
418991ce7567
tail-recursive implementation for length
Andreas Lochbihler
parents:
49757
diff
changeset
|
7607 |
|
418991ce7567
tail-recursive implementation for length
Andreas Lochbihler
parents:
49757
diff
changeset
|
7608 |
lemma length_code [code]: "length = gen_length 0" |
418991ce7567
tail-recursive implementation for length
Andreas Lochbihler
parents:
49757
diff
changeset
|
7609 |
by(simp add: gen_length_def fun_eq_iff) |
418991ce7567
tail-recursive implementation for length
Andreas Lochbihler
parents:
49757
diff
changeset
|
7610 |
|
418991ce7567
tail-recursive implementation for length
Andreas Lochbihler
parents:
49757
diff
changeset
|
7611 |
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
|
7612 |
|
49948
744934b818c7
moved quite generic material from theory Enum to more appropriate places
haftmann
parents:
49808
diff
changeset
|
7613 |
|
60758 | 7614 |
subsubsection \<open>Pretty lists\<close> |
7615 |
||
7616 |
ML \<open> |
|
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
|
7617 |
(* 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
|
7618 |
|
ee729dbd1b7f
avoid ML_file in large theory files to improve performance of dependency discovery of main HOL (approx. 1s CPU time) -- relevant for any application using it, e.g. small paper sessions;
wenzelm
parents:
50134
diff
changeset
|
7619 |
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
|
7620 |
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
|
7621 |
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
|
7622 |
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
|
7623 |
|
ee729dbd1b7f
avoid ML_file in large theory files to improve performance of dependency discovery of main HOL (approx. 1s CPU time) -- relevant for any application using it, e.g. small paper sessions;
wenzelm
parents:
50134
diff
changeset
|
7624 |
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
|
7625 |
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
|
7626 |
|
ee729dbd1b7f
avoid ML_file in large theory files to improve performance of dependency discovery of main HOL (approx. 1s CPU time) -- relevant for any application using it, e.g. small paper sessions;
wenzelm
parents:
50134
diff
changeset
|
7627 |
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
|
7628 |
|
55148
7e1b7cb54114
avoid (now superfluous) indirect passing of constant names
haftmann
parents:
55147
diff
changeset
|
7629 |
fun implode_list 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
|
7630 |
let |
69593 | 7631 |
fun dest_cons (IConst { sym = Code_Symbol.Constant \<^const_name>\<open>Cons\<close>, ... } `$ t1 `$ t2) = SOME (t1, t2) |
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
|
7632 |
| 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
|
7633 |
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
|
7634 |
in case t' |
69593 | 7635 |
of IConst { sym = Code_Symbol.Constant \<^const_name>\<open>Nil\<close>, ... } => SOME ts |
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
|
7636 |
| _ => 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
|
7637 |
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
|
7638 |
|
68028 | 7639 |
fun print_list (target_fxy, target_cons) pr fxy t1 t2 = |
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
|
7640 |
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
|
7641 |
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
|
7642 |
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
|
7643 |
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
|
7644 |
); |
ee729dbd1b7f
avoid ML_file in large theory files to improve performance of dependency discovery of main HOL (approx. 1s CPU time) -- relevant for any application using it, e.g. small paper sessions;
wenzelm
parents:
50134
diff
changeset
|
7645 |
|
ee729dbd1b7f
avoid ML_file in large theory files to improve performance of dependency discovery of main HOL (approx. 1s CPU time) -- relevant for any application using it, e.g. small paper sessions;
wenzelm
parents:
50134
diff
changeset
|
7646 |
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
|
7647 |
let |
55148
7e1b7cb54114
avoid (now superfluous) indirect passing of constant names
haftmann
parents:
55147
diff
changeset
|
7648 |
fun pretty literals pr _ vars fxy [(t1, _), (t2, _)] = |
7e1b7cb54114
avoid (now superfluous) indirect passing of constant names
haftmann
parents:
55147
diff
changeset
|
7649 |
case Option.map (cons t1) (implode_list t2) |
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
|
7650 |
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
|
7651 |
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
|
7652 |
| NONE => |
68028 | 7653 |
print_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
|
7654 |
in |
69593 | 7655 |
Code_Target.set_printings (Code_Symbol.Constant (\<^const_name>\<open>Cons\<close>, |
55148
7e1b7cb54114
avoid (now superfluous) indirect passing of constant names
haftmann
parents:
55147
diff
changeset
|
7656 |
[(target, SOME (Code_Printer.complex_const_syntax (2, 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
|
7657 |
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
|
7658 |
|
ee729dbd1b7f
avoid ML_file in large theory files to improve performance of dependency discovery of main HOL (approx. 1s CPU time) -- relevant for any application using it, e.g. small paper sessions;
wenzelm
parents:
50134
diff
changeset
|
7659 |
end; |
60758 | 7660 |
\<close> |
31055
2cf6efca6c71
proper structures for list and string code generation stuff
haftmann
parents:
31048
diff
changeset
|
7661 |
|
52435
6646bb548c6b
migration from code_(const|type|class|instance) to code_printing and from code_module to code_identifier
haftmann
parents:
52380
diff
changeset
|
7662 |
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
|
7663 |
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
|
7664 |
(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
|
7665 |
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
|
7666 |
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
|
7667 |
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
|
7668 |
| 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
|
7669 |
(SML) "[]" |
6646bb548c6b
migration from code_(const|type|class|instance) to code_printing and from code_module to code_identifier
haftmann
parents:
52380
diff
changeset
|
7670 |
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
|
7671 |
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
|
7672 |
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
|
7673 |
| 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
|
7674 |
(Haskell) - |
6646bb548c6b
migration from code_(const|type|class|instance) to code_printing and from code_module to code_identifier
haftmann
parents:
52380
diff
changeset
|
7675 |
| 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
|
7676 |
(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
|
7677 |
|
60758 | 7678 |
setup \<open>fold (List_Code.add_literal_list) ["SML", "OCaml", "Haskell", "Scala"]\<close> |
31048
ac146fc38b51
refined HOL string theories and corresponding ML fragments
haftmann
parents:
31022
diff
changeset
|
7679 |
|
ac146fc38b51
refined HOL string theories and corresponding ML fragments
haftmann
parents:
31022
diff
changeset
|
7680 |
code_reserved SML |
ac146fc38b51
refined HOL string theories and corresponding ML fragments
haftmann
parents:
31022
diff
changeset
|
7681 |
list |
ac146fc38b51
refined HOL string theories and corresponding ML fragments
haftmann
parents:
31022
diff
changeset
|
7682 |
|
ac146fc38b51
refined HOL string theories and corresponding ML fragments
haftmann
parents:
31022
diff
changeset
|
7683 |
code_reserved OCaml |
ac146fc38b51
refined HOL string theories and corresponding ML fragments
haftmann
parents:
31022
diff
changeset
|
7684 |
list |
ac146fc38b51
refined HOL string theories and corresponding ML fragments
haftmann
parents:
31022
diff
changeset
|
7685 |
|
21061
580dfc999ef6
added normal post setup; cleaned up "execution" constants
haftmann
parents:
21046
diff
changeset
|
7686 |
|
60758 | 7687 |
subsubsection \<open>Use convenient predefined operations\<close> |
37424
ed431cc99f17
use various predefined Haskell operations when generating code
haftmann
parents:
37408
diff
changeset
|
7688 |
|
52435
6646bb548c6b
migration from code_(const|type|class|instance) to code_printing and from code_module to code_identifier
haftmann
parents:
52380
diff
changeset
|
7689 |
code_printing |
67399 | 7690 |
constant "(@)" \<rightharpoonup> |
52435
6646bb548c6b
migration from code_(const|type|class|instance) to code_printing and from code_module to code_identifier
haftmann
parents:
52380
diff
changeset
|
7691 |
(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
|
7692 |
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
|
7693 |
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
|
7694 |
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
|
7695 |
| 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
|
7696 |
(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
|
7697 |
| 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
|
7698 |
(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
|
7699 |
| 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
|
7700 |
(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
|
7701 |
| 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
|
7702 |
(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
|
7703 |
| 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
|
7704 |
(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
|
7705 |
| 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
|
7706 |
(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
|
7707 |
| 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
|
7708 |
(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
|
7709 |
| 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
|
7710 |
(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
|
7711 |
| 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
|
7712 |
(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
|
7713 |
| 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
|
7714 |
(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
|
7715 |
| 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
|
7716 |
(Haskell) "any" |
37605
625bc011768a
put section on distinctness before listsum; refined code generation operations; dropped ancient infix mem
haftmann
parents:
37465
diff
changeset
|
7717 |
|
46147
2c4d8de91c4c
moved lemmas about List.set and set operations to List theory
haftmann
parents:
46143
diff
changeset
|
7718 |
|
60758 | 7719 |
subsubsection \<open>Implementation of sets by lists\<close> |
46147
2c4d8de91c4c
moved lemmas about List.set and set operations to List theory
haftmann
parents:
46143
diff
changeset
|
7720 |
|
2c4d8de91c4c
moved lemmas about List.set and set operations to List theory
haftmann
parents:
46143
diff
changeset
|
7721 |
lemma is_empty_set [code]: |
2c4d8de91c4c
moved lemmas about List.set and set operations to List theory
haftmann
parents:
46143
diff
changeset
|
7722 |
"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
|
7723 |
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
|
7724 |
|
2c4d8de91c4c
moved lemmas about List.set and set operations to List theory
haftmann
parents:
46143
diff
changeset
|
7725 |
lemma empty_set [code]: |
2c4d8de91c4c
moved lemmas about List.set and set operations to List theory
haftmann
parents:
46143
diff
changeset
|
7726 |
"{} = set []" |
2c4d8de91c4c
moved lemmas about List.set and set operations to List theory
haftmann
parents:
46143
diff
changeset
|
7727 |
by simp |
2c4d8de91c4c
moved lemmas about List.set and set operations to List theory
haftmann
parents:
46143
diff
changeset
|
7728 |
|
46156 | 7729 |
lemma UNIV_coset [code]: |
7730 |
"UNIV = List.coset []" |
|
7731 |
by simp |
|
7732 |
||
7733 |
lemma compl_set [code]: |
|
7734 |
"- set xs = List.coset xs" |
|
7735 |
by simp |
|
7736 |
||
7737 |
lemma compl_coset [code]: |
|
7738 |
"- List.coset xs = set xs" |
|
7739 |
by simp |
|
7740 |
||
46147
2c4d8de91c4c
moved lemmas about List.set and set operations to List theory
haftmann
parents:
46143
diff
changeset
|
7741 |
lemma [code]: |
2c4d8de91c4c
moved lemmas about List.set and set operations to List theory
haftmann
parents:
46143
diff
changeset
|
7742 |
"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
|
7743 |
"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
|
7744 |
by (simp_all add: member_def) |
2c4d8de91c4c
moved lemmas about List.set and set operations to List theory
haftmann
parents:
46143
diff
changeset
|
7745 |
|
2c4d8de91c4c
moved lemmas about List.set and set operations to List theory
haftmann
parents:
46143
diff
changeset
|
7746 |
lemma insert_code [code]: |
2c4d8de91c4c
moved lemmas about List.set and set operations to List theory
haftmann
parents:
46143
diff
changeset
|
7747 |
"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
|
7748 |
"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
|
7749 |
by simp_all |
2c4d8de91c4c
moved lemmas about List.set and set operations to List theory
haftmann
parents:
46143
diff
changeset
|
7750 |
|
2c4d8de91c4c
moved lemmas about List.set and set operations to List theory
haftmann
parents:
46143
diff
changeset
|
7751 |
lemma remove_code [code]: |
2c4d8de91c4c
moved lemmas about List.set and set operations to List theory
haftmann
parents:
46143
diff
changeset
|
7752 |
"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
|
7753 |
"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
|
7754 |
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
|
7755 |
|
49757
73ab6d4a9236
rename Set.project to Set.filter - more appropriate name
kuncar
parents:
49739
diff
changeset
|
7756 |
lemma filter_set [code]: |
73ab6d4a9236
rename Set.project to Set.filter - more appropriate name
kuncar
parents:
49739
diff
changeset
|
7757 |
"Set.filter P (set xs) = set (filter P xs)" |
46156 | 7758 |
by auto |
7759 |
||
7760 |
lemma image_set [code]: |
|
7761 |
"image f (set xs) = set (map f xs)" |
|
7762 |
by simp |
|
7763 |
||
47398 | 7764 |
lemma subset_code [code]: |
7765 |
"set xs \<le> B \<longleftrightarrow> (\<forall>x\<in>set xs. x \<in> B)" |
|
7766 |
"A \<le> List.coset ys \<longleftrightarrow> (\<forall>y\<in>set ys. y \<notin> A)" |
|
68709 | 7767 |
"List.coset [] \<subseteq> set [] \<longleftrightarrow> False" |
47398 | 7768 |
by auto |
7769 |
||
60758 | 7770 |
text \<open>A frequent case -- avoid intermediate sets\<close> |
47398 | 7771 |
lemma [code_unfold]: |
7772 |
"set xs \<subseteq> set ys \<longleftrightarrow> list_all (\<lambda>x. x \<in> set ys) xs" |
|
7773 |
by (auto simp: list_all_iff) |
|
7774 |
||
46147
2c4d8de91c4c
moved lemmas about List.set and set operations to List theory
haftmann
parents:
46143
diff
changeset
|
7775 |
lemma Ball_set [code]: |
2c4d8de91c4c
moved lemmas about List.set and set operations to List theory
haftmann
parents:
46143
diff
changeset
|
7776 |
"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
|
7777 |
by (simp add: list_all_iff) |
2c4d8de91c4c
moved lemmas about List.set and set operations to List theory
haftmann
parents:
46143
diff
changeset
|
7778 |
|
2c4d8de91c4c
moved lemmas about List.set and set operations to List theory
haftmann
parents:
46143
diff
changeset
|
7779 |
lemma Bex_set [code]: |
2c4d8de91c4c
moved lemmas about List.set and set operations to List theory
haftmann
parents:
46143
diff
changeset
|
7780 |
"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
|
7781 |
by (simp add: list_ex_iff) |
2c4d8de91c4c
moved lemmas about List.set and set operations to List theory
haftmann
parents:
46143
diff
changeset
|
7782 |
|
2c4d8de91c4c
moved lemmas about List.set and set operations to List theory
haftmann
parents:
46143
diff
changeset
|
7783 |
lemma card_set [code]: |
2c4d8de91c4c
moved lemmas about List.set and set operations to List theory
haftmann
parents:
46143
diff
changeset
|
7784 |
"card (set xs) = length (remdups xs)" |
2c4d8de91c4c
moved lemmas about List.set and set operations to List theory
haftmann
parents:
46143
diff
changeset
|
7785 |
proof - |
2c4d8de91c4c
moved lemmas about List.set and set operations to List theory
haftmann
parents:
46143
diff
changeset
|
7786 |
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
|
7787 |
by (rule distinct_card) simp |
2c4d8de91c4c
moved lemmas about List.set and set operations to List theory
haftmann
parents:
46143
diff
changeset
|
7788 |
then show ?thesis by simp |
2c4d8de91c4c
moved lemmas about List.set and set operations to List theory
haftmann
parents:
46143
diff
changeset
|
7789 |
qed |
2c4d8de91c4c
moved lemmas about List.set and set operations to List theory
haftmann
parents:
46143
diff
changeset
|
7790 |
|
46156 | 7791 |
lemma the_elem_set [code]: |
7792 |
"the_elem (set [x]) = x" |
|
7793 |
by simp |
|
7794 |
||
7795 |
lemma Pow_set [code]: |
|
7796 |
"Pow (set []) = {{}}" |
|
7797 |
"Pow (set (x # xs)) = (let A = Pow (set xs) in A \<union> insert x ` A)" |
|
7798 |
by (simp_all add: Pow_insert Let_def) |
|
7799 |
||
46424
b447318e5e1a
adding code equation for Relation.image; adding map_project as correspondence to map_filter on lists
bulwahn
parents:
46418
diff
changeset
|
7800 |
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
|
7801 |
"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
|
7802 |
|
b447318e5e1a
adding code equation for Relation.image; adding map_project as correspondence to map_filter on lists
bulwahn
parents:
46418
diff
changeset
|
7803 |
lemma [code]: |
b447318e5e1a
adding code equation for Relation.image; adding map_project as correspondence to map_filter on lists
bulwahn
parents:
46418
diff
changeset
|
7804 |
"map_project f (set xs) = set (List.map_filter f xs)" |
47398 | 7805 |
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
|
7806 |
|
b447318e5e1a
adding code equation for Relation.image; adding map_project as correspondence to map_filter on lists
bulwahn
parents:
46418
diff
changeset
|
7807 |
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
|
7808 |
|
49948
744934b818c7
moved quite generic material from theory Enum to more appropriate places
haftmann
parents:
49808
diff
changeset
|
7809 |
|
60758 | 7810 |
text \<open>Operations on relations\<close> |
46147
2c4d8de91c4c
moved lemmas about List.set and set operations to List theory
haftmann
parents:
46143
diff
changeset
|
7811 |
|
2c4d8de91c4c
moved lemmas about List.set and set operations to List theory
haftmann
parents:
46143
diff
changeset
|
7812 |
lemma product_code [code]: |
2c4d8de91c4c
moved lemmas about List.set and set operations to List theory
haftmann
parents:
46143
diff
changeset
|
7813 |
"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
|
7814 |
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
|
7815 |
|
2c4d8de91c4c
moved lemmas about List.set and set operations to List theory
haftmann
parents:
46143
diff
changeset
|
7816 |
lemma Id_on_set [code]: |
2c4d8de91c4c
moved lemmas about List.set and set operations to List theory
haftmann
parents:
46143
diff
changeset
|
7817 |
"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
|
7818 |
by (auto simp add: Id_on_def) |
2c4d8de91c4c
moved lemmas about List.set and set operations to List theory
haftmann
parents:
46143
diff
changeset
|
7819 |
|
46424
b447318e5e1a
adding code equation for Relation.image; adding map_project as correspondence to map_filter on lists
bulwahn
parents:
46418
diff
changeset
|
7820 |
lemma [code]: |
67613 | 7821 |
"R `` S = List.map_project (\<lambda>(x, y). if x \<in> S then Some y else None) R" |
62390 | 7822 |
unfolding map_project_def by (auto split: prod.split if_split_asm) |
46424
b447318e5e1a
adding code equation for Relation.image; adding map_project as correspondence to map_filter on lists
bulwahn
parents:
46418
diff
changeset
|
7823 |
|
46147
2c4d8de91c4c
moved lemmas about List.set and set operations to List theory
haftmann
parents:
46143
diff
changeset
|
7824 |
lemma trancl_set_ntrancl [code]: |
2c4d8de91c4c
moved lemmas about List.set and set operations to List theory
haftmann
parents:
46143
diff
changeset
|
7825 |
"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
|
7826 |
by (simp add: finite_trancl_ntranl) |
2c4d8de91c4c
moved lemmas about List.set and set operations to List theory
haftmann
parents:
46143
diff
changeset
|
7827 |
|
47433
07f4bf913230
renamed "rel_comp" to "relcomp" (to be consistent with, e.g., "relpow")
griff
parents:
47131
diff
changeset
|
7828 |
lemma set_relcomp [code]: |
46147
2c4d8de91c4c
moved lemmas about List.set and set operations to List theory
haftmann
parents:
46143
diff
changeset
|
7829 |
"set xys O set yzs = set ([(fst xy, snd yz). xy \<leftarrow> xys, yz \<leftarrow> yzs, snd xy = fst yz])" |
62343
24106dc44def
prefer abbreviations for compound operators INFIMUM and SUPREMUM
haftmann
parents:
62328
diff
changeset
|
7830 |
by auto (auto simp add: Bex_def image_def) |
46147
2c4d8de91c4c
moved lemmas about List.set and set operations to List theory
haftmann
parents:
46143
diff
changeset
|
7831 |
|
2c4d8de91c4c
moved lemmas about List.set and set operations to List theory
haftmann
parents:
46143
diff
changeset
|
7832 |
lemma wf_set [code]: |
2c4d8de91c4c
moved lemmas about List.set and set operations to List theory
haftmann
parents:
46143
diff
changeset
|
7833 |
"wf (set xs) = acyclic (set xs)" |
2c4d8de91c4c
moved lemmas about List.set and set operations to List theory
haftmann
parents:
46143
diff
changeset
|
7834 |
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
|
7835 |
|
55129
26bd1cba3ab5
killed 'More_BNFs' by moving its various bits where they (now) belong
blanchet
parents:
54890
diff
changeset
|
7836 |
|
60758 | 7837 |
subsection \<open>Setup for Lifting/Transfer\<close> |
7838 |
||
7839 |
subsubsection \<open>Transfer rules for the Transfer package\<close> |
|
53012
cb82606b8215
move Lifting/Transfer relevant parts of Library/Quotient_* to Main
kuncar
parents:
52435
diff
changeset
|
7840 |
|
63343 | 7841 |
context includes lifting_syntax |
53012
cb82606b8215
move Lifting/Transfer relevant parts of Library/Quotient_* to Main
kuncar
parents:
52435
diff
changeset
|
7842 |
begin |
cb82606b8215
move Lifting/Transfer relevant parts of Library/Quotient_* to Main
kuncar
parents:
52435
diff
changeset
|
7843 |
|
cb82606b8215
move Lifting/Transfer relevant parts of Library/Quotient_* to Main
kuncar
parents:
52435
diff
changeset
|
7844 |
lemma tl_transfer [transfer_rule]: |
cb82606b8215
move Lifting/Transfer relevant parts of Library/Quotient_* to Main
kuncar
parents:
52435
diff
changeset
|
7845 |
"(list_all2 A ===> list_all2 A) tl tl" |
55405
0a155051bd9d
use new selector support to define 'the', 'hd', 'tl'
blanchet
parents:
55404
diff
changeset
|
7846 |
unfolding tl_def[abs_def] by transfer_prover |
53012
cb82606b8215
move Lifting/Transfer relevant parts of Library/Quotient_* to Main
kuncar
parents:
52435
diff
changeset
|
7847 |
|
cb82606b8215
move Lifting/Transfer relevant parts of Library/Quotient_* to Main
kuncar
parents:
52435
diff
changeset
|
7848 |
lemma butlast_transfer [transfer_rule]: |
cb82606b8215
move Lifting/Transfer relevant parts of Library/Quotient_* to Main
kuncar
parents:
52435
diff
changeset
|
7849 |
"(list_all2 A ===> list_all2 A) butlast butlast" |
55945 | 7850 |
by (rule rel_funI, erule list_all2_induct, auto) |
53012
cb82606b8215
move Lifting/Transfer relevant parts of Library/Quotient_* to Main
kuncar
parents:
52435
diff
changeset
|
7851 |
|
55465 | 7852 |
lemma map_rec: "map f xs = rec_list Nil (%x _ y. Cons (f x) y) xs" |
7853 |
by (induct xs) auto |
|
7854 |
||
53012
cb82606b8215
move Lifting/Transfer relevant parts of Library/Quotient_* to Main
kuncar
parents:
52435
diff
changeset
|
7855 |
lemma append_transfer [transfer_rule]: |
cb82606b8215
move Lifting/Transfer relevant parts of Library/Quotient_* to Main
kuncar
parents:
52435
diff
changeset
|
7856 |
"(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
|
7857 |
unfolding List.append_def by transfer_prover |
cb82606b8215
move Lifting/Transfer relevant parts of Library/Quotient_* to Main
kuncar
parents:
52435
diff
changeset
|
7858 |
|
cb82606b8215
move Lifting/Transfer relevant parts of Library/Quotient_* to Main
kuncar
parents:
52435
diff
changeset
|
7859 |
lemma rev_transfer [transfer_rule]: |
cb82606b8215
move Lifting/Transfer relevant parts of Library/Quotient_* to Main
kuncar
parents:
52435
diff
changeset
|
7860 |
"(list_all2 A ===> list_all2 A) rev rev" |
cb82606b8215
move Lifting/Transfer relevant parts of Library/Quotient_* to Main
kuncar
parents:
52435
diff
changeset
|
7861 |
unfolding List.rev_def by transfer_prover |
cb82606b8215
move Lifting/Transfer relevant parts of Library/Quotient_* to Main
kuncar
parents:
52435
diff
changeset
|
7862 |
|
cb82606b8215
move Lifting/Transfer relevant parts of Library/Quotient_* to Main
kuncar
parents:
52435
diff
changeset
|
7863 |
lemma filter_transfer [transfer_rule]: |
67399 | 7864 |
"((A ===> (=)) ===> list_all2 A ===> list_all2 A) filter filter" |
53012
cb82606b8215
move Lifting/Transfer relevant parts of Library/Quotient_* to Main
kuncar
parents:
52435
diff
changeset
|
7865 |
unfolding List.filter_def by transfer_prover |
cb82606b8215
move Lifting/Transfer relevant parts of Library/Quotient_* to Main
kuncar
parents:
52435
diff
changeset
|
7866 |
|
cb82606b8215
move Lifting/Transfer relevant parts of Library/Quotient_* to Main
kuncar
parents:
52435
diff
changeset
|
7867 |
lemma fold_transfer [transfer_rule]: |
cb82606b8215
move Lifting/Transfer relevant parts of Library/Quotient_* to Main
kuncar
parents:
52435
diff
changeset
|
7868 |
"((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
|
7869 |
unfolding List.fold_def by transfer_prover |
cb82606b8215
move Lifting/Transfer relevant parts of Library/Quotient_* to Main
kuncar
parents:
52435
diff
changeset
|
7870 |
|
cb82606b8215
move Lifting/Transfer relevant parts of Library/Quotient_* to Main
kuncar
parents:
52435
diff
changeset
|
7871 |
lemma foldr_transfer [transfer_rule]: |
cb82606b8215
move Lifting/Transfer relevant parts of Library/Quotient_* to Main
kuncar
parents:
52435
diff
changeset
|
7872 |
"((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
|
7873 |
unfolding List.foldr_def by transfer_prover |
cb82606b8215
move Lifting/Transfer relevant parts of Library/Quotient_* to Main
kuncar
parents:
52435
diff
changeset
|
7874 |
|
cb82606b8215
move Lifting/Transfer relevant parts of Library/Quotient_* to Main
kuncar
parents:
52435
diff
changeset
|
7875 |
lemma foldl_transfer [transfer_rule]: |
cb82606b8215
move Lifting/Transfer relevant parts of Library/Quotient_* to Main
kuncar
parents:
52435
diff
changeset
|
7876 |
"((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
|
7877 |
unfolding List.foldl_def by transfer_prover |
cb82606b8215
move Lifting/Transfer relevant parts of Library/Quotient_* to Main
kuncar
parents:
52435
diff
changeset
|
7878 |
|
cb82606b8215
move Lifting/Transfer relevant parts of Library/Quotient_* to Main
kuncar
parents:
52435
diff
changeset
|
7879 |
lemma concat_transfer [transfer_rule]: |
cb82606b8215
move Lifting/Transfer relevant parts of Library/Quotient_* to Main
kuncar
parents:
52435
diff
changeset
|
7880 |
"(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
|
7881 |
unfolding List.concat_def by transfer_prover |
cb82606b8215
move Lifting/Transfer relevant parts of Library/Quotient_* to Main
kuncar
parents:
52435
diff
changeset
|
7882 |
|
cb82606b8215
move Lifting/Transfer relevant parts of Library/Quotient_* to Main
kuncar
parents:
52435
diff
changeset
|
7883 |
lemma drop_transfer [transfer_rule]: |
67399 | 7884 |
"((=) ===> list_all2 A ===> list_all2 A) drop drop" |
53012
cb82606b8215
move Lifting/Transfer relevant parts of Library/Quotient_* to Main
kuncar
parents:
52435
diff
changeset
|
7885 |
unfolding List.drop_def by transfer_prover |
cb82606b8215
move Lifting/Transfer relevant parts of Library/Quotient_* to Main
kuncar
parents:
52435
diff
changeset
|
7886 |
|
cb82606b8215
move Lifting/Transfer relevant parts of Library/Quotient_* to Main
kuncar
parents:
52435
diff
changeset
|
7887 |
lemma take_transfer [transfer_rule]: |
67399 | 7888 |
"((=) ===> list_all2 A ===> list_all2 A) take take" |
53012
cb82606b8215
move Lifting/Transfer relevant parts of Library/Quotient_* to Main
kuncar
parents:
52435
diff
changeset
|
7889 |
unfolding List.take_def by transfer_prover |
cb82606b8215
move Lifting/Transfer relevant parts of Library/Quotient_* to Main
kuncar
parents:
52435
diff
changeset
|
7890 |
|
cb82606b8215
move Lifting/Transfer relevant parts of Library/Quotient_* to Main
kuncar
parents:
52435
diff
changeset
|
7891 |
lemma list_update_transfer [transfer_rule]: |
67399 | 7892 |
"(list_all2 A ===> (=) ===> A ===> list_all2 A) list_update list_update" |
53012
cb82606b8215
move Lifting/Transfer relevant parts of Library/Quotient_* to Main
kuncar
parents:
52435
diff
changeset
|
7893 |
unfolding list_update_def by transfer_prover |
cb82606b8215
move Lifting/Transfer relevant parts of Library/Quotient_* to Main
kuncar
parents:
52435
diff
changeset
|
7894 |
|
cb82606b8215
move Lifting/Transfer relevant parts of Library/Quotient_* to Main
kuncar
parents:
52435
diff
changeset
|
7895 |
lemma takeWhile_transfer [transfer_rule]: |
67399 | 7896 |
"((A ===> (=)) ===> list_all2 A ===> list_all2 A) takeWhile takeWhile" |
53012
cb82606b8215
move Lifting/Transfer relevant parts of Library/Quotient_* to Main
kuncar
parents:
52435
diff
changeset
|
7897 |
unfolding takeWhile_def by transfer_prover |
cb82606b8215
move Lifting/Transfer relevant parts of Library/Quotient_* to Main
kuncar
parents:
52435
diff
changeset
|
7898 |
|
cb82606b8215
move Lifting/Transfer relevant parts of Library/Quotient_* to Main
kuncar
parents:
52435
diff
changeset
|
7899 |
lemma dropWhile_transfer [transfer_rule]: |
67399 | 7900 |
"((A ===> (=)) ===> list_all2 A ===> list_all2 A) dropWhile dropWhile" |
53012
cb82606b8215
move Lifting/Transfer relevant parts of Library/Quotient_* to Main
kuncar
parents:
52435
diff
changeset
|
7901 |
unfolding dropWhile_def by transfer_prover |
cb82606b8215
move Lifting/Transfer relevant parts of Library/Quotient_* to Main
kuncar
parents:
52435
diff
changeset
|
7902 |
|
cb82606b8215
move Lifting/Transfer relevant parts of Library/Quotient_* to Main
kuncar
parents:
52435
diff
changeset
|
7903 |
lemma zip_transfer [transfer_rule]: |
55944 | 7904 |
"(list_all2 A ===> list_all2 B ===> list_all2 (rel_prod A B)) zip zip" |
53012
cb82606b8215
move Lifting/Transfer relevant parts of Library/Quotient_* to Main
kuncar
parents:
52435
diff
changeset
|
7905 |
unfolding zip_def by transfer_prover |
cb82606b8215
move Lifting/Transfer relevant parts of Library/Quotient_* to Main
kuncar
parents:
52435
diff
changeset
|
7906 |
|
53721
ccaceea6c768
added two functions to List (one contributed by Manuel Eberl)
traytel
parents:
53689
diff
changeset
|
7907 |
lemma product_transfer [transfer_rule]: |
55944 | 7908 |
"(list_all2 A ===> list_all2 B ===> list_all2 (rel_prod A B)) List.product List.product" |
53721
ccaceea6c768
added two functions to List (one contributed by Manuel Eberl)
traytel
parents:
53689
diff
changeset
|
7909 |
unfolding List.product_def by transfer_prover |
ccaceea6c768
added two functions to List (one contributed by Manuel Eberl)
traytel
parents:
53689
diff
changeset
|
7910 |
|
ccaceea6c768
added two functions to List (one contributed by Manuel Eberl)
traytel
parents:
53689
diff
changeset
|
7911 |
lemma product_lists_transfer [transfer_rule]: |
ccaceea6c768
added two functions to List (one contributed by Manuel Eberl)
traytel
parents:
53689
diff
changeset
|
7912 |
"(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
|
7913 |
unfolding product_lists_def by transfer_prover |
ccaceea6c768
added two functions to List (one contributed by Manuel Eberl)
traytel
parents:
53689
diff
changeset
|
7914 |
|
53012
cb82606b8215
move Lifting/Transfer relevant parts of Library/Quotient_* to Main
kuncar
parents:
52435
diff
changeset
|
7915 |
lemma insert_transfer [transfer_rule]: |
cb82606b8215
move Lifting/Transfer relevant parts of Library/Quotient_* to Main
kuncar
parents:
52435
diff
changeset
|
7916 |
assumes [transfer_rule]: "bi_unique A" |
cb82606b8215
move Lifting/Transfer relevant parts of Library/Quotient_* to Main
kuncar
parents:
52435
diff
changeset
|
7917 |
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
|
7918 |
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
|
7919 |
|
cb82606b8215
move Lifting/Transfer relevant parts of Library/Quotient_* to Main
kuncar
parents:
52435
diff
changeset
|
7920 |
lemma find_transfer [transfer_rule]: |
67399 | 7921 |
"((A ===> (=)) ===> list_all2 A ===> rel_option A) List.find List.find" |
53012
cb82606b8215
move Lifting/Transfer relevant parts of Library/Quotient_* to Main
kuncar
parents:
52435
diff
changeset
|
7922 |
unfolding List.find_def by transfer_prover |
cb82606b8215
move Lifting/Transfer relevant parts of Library/Quotient_* to Main
kuncar
parents:
52435
diff
changeset
|
7923 |
|
63521
32da860241b8
added missing transfer rule
Lars Hupel <lars.hupel@mytum.de>
parents:
63365
diff
changeset
|
7924 |
lemma those_transfer [transfer_rule]: |
32da860241b8
added missing transfer rule
Lars Hupel <lars.hupel@mytum.de>
parents:
63365
diff
changeset
|
7925 |
"(list_all2 (rel_option P) ===> rel_option (list_all2 P)) those those" |
32da860241b8
added missing transfer rule
Lars Hupel <lars.hupel@mytum.de>
parents:
63365
diff
changeset
|
7926 |
unfolding List.those_def by transfer_prover |
32da860241b8
added missing transfer rule
Lars Hupel <lars.hupel@mytum.de>
parents:
63365
diff
changeset
|
7927 |
|
53012
cb82606b8215
move Lifting/Transfer relevant parts of Library/Quotient_* to Main
kuncar
parents:
52435
diff
changeset
|
7928 |
lemma remove1_transfer [transfer_rule]: |
cb82606b8215
move Lifting/Transfer relevant parts of Library/Quotient_* to Main
kuncar
parents:
52435
diff
changeset
|
7929 |
assumes [transfer_rule]: "bi_unique A" |
cb82606b8215
move Lifting/Transfer relevant parts of Library/Quotient_* to Main
kuncar
parents:
52435
diff
changeset
|
7930 |
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
|
7931 |
unfolding remove1_def by transfer_prover |
cb82606b8215
move Lifting/Transfer relevant parts of Library/Quotient_* to Main
kuncar
parents:
52435
diff
changeset
|
7932 |
|
cb82606b8215
move Lifting/Transfer relevant parts of Library/Quotient_* to Main
kuncar
parents:
52435
diff
changeset
|
7933 |
lemma removeAll_transfer [transfer_rule]: |
cb82606b8215
move Lifting/Transfer relevant parts of Library/Quotient_* to Main
kuncar
parents:
52435
diff
changeset
|
7934 |
assumes [transfer_rule]: "bi_unique A" |
cb82606b8215
move Lifting/Transfer relevant parts of Library/Quotient_* to Main
kuncar
parents:
52435
diff
changeset
|
7935 |
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
|
7936 |
unfolding removeAll_def by transfer_prover |
cb82606b8215
move Lifting/Transfer relevant parts of Library/Quotient_* to Main
kuncar
parents:
52435
diff
changeset
|
7937 |
|
71779 | 7938 |
lemma successively_transfer [transfer_rule]: |
7939 |
"((A ===> A ===> (=)) ===> list_all2 A ===> (=)) successively successively" |
|
7940 |
unfolding successively_altdef by transfer_prover |
|
7941 |
||
53012
cb82606b8215
move Lifting/Transfer relevant parts of Library/Quotient_* to Main
kuncar
parents:
52435
diff
changeset
|
7942 |
lemma distinct_transfer [transfer_rule]: |
cb82606b8215
move Lifting/Transfer relevant parts of Library/Quotient_* to Main
kuncar
parents:
52435
diff
changeset
|
7943 |
assumes [transfer_rule]: "bi_unique A" |
67399 | 7944 |
shows "(list_all2 A ===> (=)) distinct distinct" |
53012
cb82606b8215
move Lifting/Transfer relevant parts of Library/Quotient_* to Main
kuncar
parents:
52435
diff
changeset
|
7945 |
unfolding distinct_def by transfer_prover |
cb82606b8215
move Lifting/Transfer relevant parts of Library/Quotient_* to Main
kuncar
parents:
52435
diff
changeset
|
7946 |
|
71779 | 7947 |
lemma distinct_adj_transfer [transfer_rule]: |
7948 |
assumes "bi_unique A" |
|
7949 |
shows "(list_all2 A ===> (=)) distinct_adj distinct_adj" |
|
7950 |
unfolding rel_fun_def |
|
7951 |
proof (intro allI impI) |
|
7952 |
fix xs ys assume "list_all2 A xs ys" |
|
7953 |
thus "distinct_adj xs \<longleftrightarrow> distinct_adj ys" |
|
7954 |
proof (induction rule: list_all2_induct) |
|
7955 |
case (Cons x xs y ys) |
|
7956 |
note * = this |
|
7957 |
show ?case |
|
7958 |
proof (cases xs) |
|
7959 |
case [simp]: (Cons x' xs') |
|
7960 |
with * obtain y' ys' where [simp]: "ys = y' # ys'" |
|
7961 |
by (cases ys) auto |
|
7962 |
from * show ?thesis |
|
7963 |
using assms by (auto simp: distinct_adj_Cons bi_unique_def) |
|
7964 |
qed (use * in auto) |
|
7965 |
qed auto |
|
7966 |
qed |
|
7967 |
||
53012
cb82606b8215
move Lifting/Transfer relevant parts of Library/Quotient_* to Main
kuncar
parents:
52435
diff
changeset
|
7968 |
lemma remdups_transfer [transfer_rule]: |
cb82606b8215
move Lifting/Transfer relevant parts of Library/Quotient_* to Main
kuncar
parents:
52435
diff
changeset
|
7969 |
assumes [transfer_rule]: "bi_unique A" |
cb82606b8215
move Lifting/Transfer relevant parts of Library/Quotient_* to Main
kuncar
parents:
52435
diff
changeset
|
7970 |
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
|
7971 |
unfolding remdups_def by transfer_prover |
cb82606b8215
move Lifting/Transfer relevant parts of Library/Quotient_* to Main
kuncar
parents:
52435
diff
changeset
|
7972 |
|
53721
ccaceea6c768
added two functions to List (one contributed by Manuel Eberl)
traytel
parents:
53689
diff
changeset
|
7973 |
lemma remdups_adj_transfer [transfer_rule]: |
ccaceea6c768
added two functions to List (one contributed by Manuel Eberl)
traytel
parents:
53689
diff
changeset
|
7974 |
assumes [transfer_rule]: "bi_unique A" |
ccaceea6c768
added two functions to List (one contributed by Manuel Eberl)
traytel
parents:
53689
diff
changeset
|
7975 |
shows "(list_all2 A ===> list_all2 A) remdups_adj remdups_adj" |
55945 | 7976 |
proof (rule rel_funI, erule list_all2_induct) |
53721
ccaceea6c768
added two functions to List (one contributed by Manuel Eberl)
traytel
parents:
53689
diff
changeset
|
7977 |
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
|
7978 |
|
53012
cb82606b8215
move Lifting/Transfer relevant parts of Library/Quotient_* to Main
kuncar
parents:
52435
diff
changeset
|
7979 |
lemma replicate_transfer [transfer_rule]: |
67399 | 7980 |
"((=) ===> A ===> list_all2 A) replicate replicate" |
53012
cb82606b8215
move Lifting/Transfer relevant parts of Library/Quotient_* to Main
kuncar
parents:
52435
diff
changeset
|
7981 |
unfolding replicate_def by transfer_prover |
cb82606b8215
move Lifting/Transfer relevant parts of Library/Quotient_* to Main
kuncar
parents:
52435
diff
changeset
|
7982 |
|
cb82606b8215
move Lifting/Transfer relevant parts of Library/Quotient_* to Main
kuncar
parents:
52435
diff
changeset
|
7983 |
lemma length_transfer [transfer_rule]: |
67399 | 7984 |
"(list_all2 A ===> (=)) length length" |
56643
41d3596d8a64
move size hooks together, with new one preceding old one and sharing same theory data
blanchet
parents:
56545
diff
changeset
|
7985 |
unfolding size_list_overloaded_def size_list_def by transfer_prover |
53012
cb82606b8215
move Lifting/Transfer relevant parts of Library/Quotient_* to Main
kuncar
parents:
52435
diff
changeset
|
7986 |
|
cb82606b8215
move Lifting/Transfer relevant parts of Library/Quotient_* to Main
kuncar
parents:
52435
diff
changeset
|
7987 |
lemma rotate1_transfer [transfer_rule]: |
cb82606b8215
move Lifting/Transfer relevant parts of Library/Quotient_* to Main
kuncar
parents:
52435
diff
changeset
|
7988 |
"(list_all2 A ===> list_all2 A) rotate1 rotate1" |
cb82606b8215
move Lifting/Transfer relevant parts of Library/Quotient_* to Main
kuncar
parents:
52435
diff
changeset
|
7989 |
unfolding rotate1_def by transfer_prover |
cb82606b8215
move Lifting/Transfer relevant parts of Library/Quotient_* to Main
kuncar
parents:
52435
diff
changeset
|
7990 |
|
cb82606b8215
move Lifting/Transfer relevant parts of Library/Quotient_* to Main
kuncar
parents:
52435
diff
changeset
|
7991 |
lemma rotate_transfer [transfer_rule]: |
67399 | 7992 |
"((=) ===> list_all2 A ===> list_all2 A) rotate rotate" |
53012
cb82606b8215
move Lifting/Transfer relevant parts of Library/Quotient_* to Main
kuncar
parents:
52435
diff
changeset
|
7993 |
unfolding rotate_def [abs_def] by transfer_prover |
cb82606b8215
move Lifting/Transfer relevant parts of Library/Quotient_* to Main
kuncar
parents:
52435
diff
changeset
|
7994 |
|
65956
639eb3617a86
reorganised material on sublists
eberlm <eberlm@in.tum.de>
parents:
65350
diff
changeset
|
7995 |
lemma nths_transfer [transfer_rule]: |
67399 | 7996 |
"(list_all2 A ===> rel_set (=) ===> list_all2 A) nths nths" |
65956
639eb3617a86
reorganised material on sublists
eberlm <eberlm@in.tum.de>
parents:
65350
diff
changeset
|
7997 |
unfolding nths_def [abs_def] by transfer_prover |
66892 | 7998 |
|
65956
639eb3617a86
reorganised material on sublists
eberlm <eberlm@in.tum.de>
parents:
65350
diff
changeset
|
7999 |
lemma subseqs_transfer [transfer_rule]: |
639eb3617a86
reorganised material on sublists
eberlm <eberlm@in.tum.de>
parents:
65350
diff
changeset
|
8000 |
"(list_all2 A ===> list_all2 (list_all2 A)) subseqs subseqs" |
639eb3617a86
reorganised material on sublists
eberlm <eberlm@in.tum.de>
parents:
65350
diff
changeset
|
8001 |
unfolding subseqs_def [abs_def] by transfer_prover |
53012
cb82606b8215
move Lifting/Transfer relevant parts of Library/Quotient_* to Main
kuncar
parents:
52435
diff
changeset
|
8002 |
|
cb82606b8215
move Lifting/Transfer relevant parts of Library/Quotient_* to Main
kuncar
parents:
52435
diff
changeset
|
8003 |
lemma partition_transfer [transfer_rule]: |
67399 | 8004 |
"((A ===> (=)) ===> list_all2 A ===> rel_prod (list_all2 A) (list_all2 A)) |
53012
cb82606b8215
move Lifting/Transfer relevant parts of Library/Quotient_* to Main
kuncar
parents:
52435
diff
changeset
|
8005 |
partition partition" |
cb82606b8215
move Lifting/Transfer relevant parts of Library/Quotient_* to Main
kuncar
parents:
52435
diff
changeset
|
8006 |
unfolding partition_def by transfer_prover |
cb82606b8215
move Lifting/Transfer relevant parts of Library/Quotient_* to Main
kuncar
parents:
52435
diff
changeset
|
8007 |
|
cb82606b8215
move Lifting/Transfer relevant parts of Library/Quotient_* to Main
kuncar
parents:
52435
diff
changeset
|
8008 |
lemma lists_transfer [transfer_rule]: |
55938 | 8009 |
"(rel_set A ===> rel_set (list_all2 A)) lists lists" |
71813 | 8010 |
proof (rule rel_funI, rule rel_setI) |
8011 |
show "\<lbrakk>l \<in> lists X; rel_set A X Y\<rbrakk> \<Longrightarrow> \<exists>y\<in>lists Y. list_all2 A l y" for X Y l |
|
8012 |
proof (induction l rule: lists.induct) |
|
8013 |
case (Cons a l) |
|
8014 |
then show ?case |
|
8015 |
by (simp only: rel_set_def list_all2_Cons1, metis lists.Cons) |
|
8016 |
qed auto |
|
8017 |
show "\<lbrakk>l \<in> lists Y; rel_set A X Y\<rbrakk> \<Longrightarrow> \<exists>x\<in>lists X. list_all2 A x l" for X Y l |
|
8018 |
proof (induction l rule: lists.induct) |
|
8019 |
case (Cons a l) |
|
8020 |
then show ?case |
|
8021 |
by (simp only: rel_set_def list_all2_Cons2, metis lists.Cons) |
|
8022 |
qed auto |
|
8023 |
qed |
|
53012
cb82606b8215
move Lifting/Transfer relevant parts of Library/Quotient_* to Main
kuncar
parents:
52435
diff
changeset
|
8024 |
|
cb82606b8215
move Lifting/Transfer relevant parts of Library/Quotient_* to Main
kuncar
parents:
52435
diff
changeset
|
8025 |
lemma set_Cons_transfer [transfer_rule]: |
55938 | 8026 |
"(rel_set A ===> rel_set (list_all2 A) ===> rel_set (list_all2 A)) |
53012
cb82606b8215
move Lifting/Transfer relevant parts of Library/Quotient_* to Main
kuncar
parents:
52435
diff
changeset
|
8027 |
set_Cons set_Cons" |
55945 | 8028 |
unfolding rel_fun_def rel_set_def set_Cons_def |
68719 | 8029 |
by (fastforce simp add: list_all2_Cons1 list_all2_Cons2) |
53012
cb82606b8215
move Lifting/Transfer relevant parts of Library/Quotient_* to Main
kuncar
parents:
52435
diff
changeset
|
8030 |
|
cb82606b8215
move Lifting/Transfer relevant parts of Library/Quotient_* to Main
kuncar
parents:
52435
diff
changeset
|
8031 |
lemma listset_transfer [transfer_rule]: |
55938 | 8032 |
"(list_all2 (rel_set A) ===> rel_set (list_all2 A)) listset listset" |
53012
cb82606b8215
move Lifting/Transfer relevant parts of Library/Quotient_* to Main
kuncar
parents:
52435
diff
changeset
|
8033 |
unfolding listset_def by transfer_prover |
cb82606b8215
move Lifting/Transfer relevant parts of Library/Quotient_* to Main
kuncar
parents:
52435
diff
changeset
|
8034 |
|
cb82606b8215
move Lifting/Transfer relevant parts of Library/Quotient_* to Main
kuncar
parents:
52435
diff
changeset
|
8035 |
lemma null_transfer [transfer_rule]: |
67399 | 8036 |
"(list_all2 A ===> (=)) List.null List.null" |
55945 | 8037 |
unfolding rel_fun_def List.null_def by auto |
53012
cb82606b8215
move Lifting/Transfer relevant parts of Library/Quotient_* to Main
kuncar
parents:
52435
diff
changeset
|
8038 |
|
cb82606b8215
move Lifting/Transfer relevant parts of Library/Quotient_* to Main
kuncar
parents:
52435
diff
changeset
|
8039 |
lemma list_all_transfer [transfer_rule]: |
67399 | 8040 |
"((A ===> (=)) ===> list_all2 A ===> (=)) list_all list_all" |
53012
cb82606b8215
move Lifting/Transfer relevant parts of Library/Quotient_* to Main
kuncar
parents:
52435
diff
changeset
|
8041 |
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
|
8042 |
|
cb82606b8215
move Lifting/Transfer relevant parts of Library/Quotient_* to Main
kuncar
parents:
52435
diff
changeset
|
8043 |
lemma list_ex_transfer [transfer_rule]: |
67399 | 8044 |
"((A ===> (=)) ===> list_all2 A ===> (=)) list_ex list_ex" |
53012
cb82606b8215
move Lifting/Transfer relevant parts of Library/Quotient_* to Main
kuncar
parents:
52435
diff
changeset
|
8045 |
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
|
8046 |
|
cb82606b8215
move Lifting/Transfer relevant parts of Library/Quotient_* to Main
kuncar
parents:
52435
diff
changeset
|
8047 |
lemma splice_transfer [transfer_rule]: |
cb82606b8215
move Lifting/Transfer relevant parts of Library/Quotient_* to Main
kuncar
parents:
52435
diff
changeset
|
8048 |
"(list_all2 A ===> list_all2 A ===> list_all2 A) splice splice" |
55945 | 8049 |
apply (rule rel_funI, erule list_all2_induct, simp add: rel_fun_def, simp) |
8050 |
apply (rule rel_funI) |
|
8051 |
apply (erule_tac xs=x in list_all2_induct, simp, simp add: rel_fun_def) |
|
53012
cb82606b8215
move Lifting/Transfer relevant parts of Library/Quotient_* to Main
kuncar
parents:
52435
diff
changeset
|
8052 |
done |
66892 | 8053 |
|
69107 | 8054 |
lemma shuffles_transfer [transfer_rule]: |
8055 |
"(list_all2 A ===> list_all2 A ===> rel_set (list_all2 A)) shuffles shuffles" |
|
65350
b149abe619f7
added shuffle product to HOL/List
eberlm <eberlm@in.tum.de>
parents:
64966
diff
changeset
|
8056 |
proof (intro rel_funI, goal_cases) |
b149abe619f7
added shuffle product to HOL/List
eberlm <eberlm@in.tum.de>
parents:
64966
diff
changeset
|
8057 |
case (1 xs xs' ys ys') |
b149abe619f7
added shuffle product to HOL/List
eberlm <eberlm@in.tum.de>
parents:
64966
diff
changeset
|
8058 |
thus ?case |
69107 | 8059 |
proof (induction xs ys arbitrary: xs' ys' rule: shuffles.induct) |
65350
b149abe619f7
added shuffle product to HOL/List
eberlm <eberlm@in.tum.de>
parents:
64966
diff
changeset
|
8060 |
case (3 x xs y ys xs' ys') |
b149abe619f7
added shuffle product to HOL/List
eberlm <eberlm@in.tum.de>
parents:
64966
diff
changeset
|
8061 |
from "3.prems" obtain x' xs'' where xs': "xs' = x' # xs''" by (cases xs') auto |
b149abe619f7
added shuffle product to HOL/List
eberlm <eberlm@in.tum.de>
parents:
64966
diff
changeset
|
8062 |
from "3.prems" obtain y' ys'' where ys': "ys' = y' # ys''" by (cases ys') auto |
b149abe619f7
added shuffle product to HOL/List
eberlm <eberlm@in.tum.de>
parents:
64966
diff
changeset
|
8063 |
have [transfer_rule]: "A x x'" "A y y'" "list_all2 A xs xs''" "list_all2 A ys ys''" |
b149abe619f7
added shuffle product to HOL/List
eberlm <eberlm@in.tum.de>
parents:
64966
diff
changeset
|
8064 |
using "3.prems" by (simp_all add: xs' ys') |
69107 | 8065 |
have [transfer_rule]: "rel_set (list_all2 A) (shuffles xs (y # ys)) (shuffles xs'' ys')" and |
8066 |
[transfer_rule]: "rel_set (list_all2 A) (shuffles (x # xs) ys) (shuffles xs' ys'')" |
|
65350
b149abe619f7
added shuffle product to HOL/List
eberlm <eberlm@in.tum.de>
parents:
64966
diff
changeset
|
8067 |
using "3.prems" by (auto intro!: "3.IH" simp: xs' ys') |
69107 | 8068 |
have "rel_set (list_all2 A) ((#) x ` shuffles xs (y # ys) \<union> (#) y ` shuffles (x # xs) ys) |
8069 |
((#) x' ` shuffles xs'' ys' \<union> (#) y' ` shuffles xs' ys'')" by transfer_prover |
|
65350
b149abe619f7
added shuffle product to HOL/List
eberlm <eberlm@in.tum.de>
parents:
64966
diff
changeset
|
8070 |
thus ?case by (simp add: xs' ys') |
b149abe619f7
added shuffle product to HOL/List
eberlm <eberlm@in.tum.de>
parents:
64966
diff
changeset
|
8071 |
qed (auto simp: rel_set_def) |
66892 | 8072 |
qed |
53012
cb82606b8215
move Lifting/Transfer relevant parts of Library/Quotient_* to Main
kuncar
parents:
52435
diff
changeset
|
8073 |
|
57599 | 8074 |
lemma rtrancl_parametric [transfer_rule]: |
8075 |
assumes [transfer_rule]: "bi_unique A" "bi_total A" |
|
8076 |
shows "(rel_set (rel_prod A A) ===> rel_set (rel_prod A A)) rtrancl rtrancl" |
|
8077 |
unfolding rtrancl_def by transfer_prover |
|
8078 |
||
59516
d92b74f3f6e3
add parametricity rules for monotone, fun_lub, and fun_ord
Andreas Lochbihler
parents:
59199
diff
changeset
|
8079 |
lemma monotone_parametric [transfer_rule]: |
d92b74f3f6e3
add parametricity rules for monotone, fun_lub, and fun_ord
Andreas Lochbihler
parents:
59199
diff
changeset
|
8080 |
assumes [transfer_rule]: "bi_total A" |
67399 | 8081 |
shows "((A ===> A ===> (=)) ===> (B ===> B ===> (=)) ===> (A ===> B) ===> (=)) monotone monotone" |
59516
d92b74f3f6e3
add parametricity rules for monotone, fun_lub, and fun_ord
Andreas Lochbihler
parents:
59199
diff
changeset
|
8082 |
unfolding monotone_def[abs_def] by transfer_prover |
d92b74f3f6e3
add parametricity rules for monotone, fun_lub, and fun_ord
Andreas Lochbihler
parents:
59199
diff
changeset
|
8083 |
|
d92b74f3f6e3
add parametricity rules for monotone, fun_lub, and fun_ord
Andreas Lochbihler
parents:
59199
diff
changeset
|
8084 |
lemma fun_ord_parametric [transfer_rule]: |
d92b74f3f6e3
add parametricity rules for monotone, fun_lub, and fun_ord
Andreas Lochbihler
parents:
59199
diff
changeset
|
8085 |
assumes [transfer_rule]: "bi_total C" |
67399 | 8086 |
shows "((A ===> B ===> (=)) ===> (C ===> A) ===> (C ===> B) ===> (=)) fun_ord fun_ord" |
59516
d92b74f3f6e3
add parametricity rules for monotone, fun_lub, and fun_ord
Andreas Lochbihler
parents:
59199
diff
changeset
|
8087 |
unfolding fun_ord_def[abs_def] by transfer_prover |
d92b74f3f6e3
add parametricity rules for monotone, fun_lub, and fun_ord
Andreas Lochbihler
parents:
59199
diff
changeset
|
8088 |
|
d92b74f3f6e3
add parametricity rules for monotone, fun_lub, and fun_ord
Andreas Lochbihler
parents:
59199
diff
changeset
|
8089 |
lemma fun_lub_parametric [transfer_rule]: |
d92b74f3f6e3
add parametricity rules for monotone, fun_lub, and fun_ord
Andreas Lochbihler
parents:
59199
diff
changeset
|
8090 |
assumes [transfer_rule]: "bi_total A" "bi_unique A" |
d92b74f3f6e3
add parametricity rules for monotone, fun_lub, and fun_ord
Andreas Lochbihler
parents:
59199
diff
changeset
|
8091 |
shows "((rel_set A ===> B) ===> rel_set (C ===> A) ===> C ===> B) fun_lub fun_lub" |
d92b74f3f6e3
add parametricity rules for monotone, fun_lub, and fun_ord
Andreas Lochbihler
parents:
59199
diff
changeset
|
8092 |
unfolding fun_lub_def[abs_def] by transfer_prover |
d92b74f3f6e3
add parametricity rules for monotone, fun_lub, and fun_ord
Andreas Lochbihler
parents:
59199
diff
changeset
|
8093 |
|
23388 | 8094 |
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
|
8095 |
|
53012
cb82606b8215
move Lifting/Transfer relevant parts of Library/Quotient_* to Main
kuncar
parents:
52435
diff
changeset
|
8096 |
end |