16 lemma set_relI: |
16 lemma set_relI: |
17 assumes "\<And>x. x \<in> A \<Longrightarrow> \<exists>y\<in>B. R x y" |
17 assumes "\<And>x. x \<in> A \<Longrightarrow> \<exists>y\<in>B. R x y" |
18 assumes "\<And>y. y \<in> B \<Longrightarrow> \<exists>x\<in>A. R x y" |
18 assumes "\<And>y. y \<in> B \<Longrightarrow> \<exists>x\<in>A. R x y" |
19 shows "set_rel R A B" |
19 shows "set_rel R A B" |
20 using assms unfolding set_rel_def by simp |
20 using assms unfolding set_rel_def by simp |
|
21 |
|
22 lemma set_relD1: "\<lbrakk> set_rel R A B; x \<in> A \<rbrakk> \<Longrightarrow> \<exists>y \<in> B. R x y" |
|
23 and set_relD2: "\<lbrakk> set_rel R A B; y \<in> B \<rbrakk> \<Longrightarrow> \<exists>x \<in> A. R x y" |
|
24 by(simp_all add: set_rel_def) |
21 |
25 |
22 lemma set_rel_conversep: "set_rel (conversep R) = conversep (set_rel R)" |
26 lemma set_rel_conversep: "set_rel (conversep R) = conversep (set_rel R)" |
23 unfolding set_rel_def by auto |
27 unfolding set_rel_def by auto |
24 |
28 |
25 lemma set_rel_eq [relator_eq]: "set_rel (op =) = (op =)" |
29 lemma set_rel_eq [relator_eq]: "set_rel (op =) = (op =)" |
151 lemma set_rel_transfer [transfer_rule]: |
155 lemma set_rel_transfer [transfer_rule]: |
152 "((A ===> B ===> op =) ===> set_rel A ===> set_rel B ===> op =) |
156 "((A ===> B ===> op =) ===> set_rel A ===> set_rel B ===> op =) |
153 set_rel set_rel" |
157 set_rel set_rel" |
154 unfolding fun_rel_def set_rel_def by fast |
158 unfolding fun_rel_def set_rel_def by fast |
155 |
159 |
|
160 lemma SUPR_parametric [transfer_rule]: |
|
161 "(set_rel R ===> (R ===> op =) ===> op =) SUPR SUPR" |
|
162 proof(rule fun_relI)+ |
|
163 fix A B f and g :: "'b \<Rightarrow> 'c" |
|
164 assume AB: "set_rel R A B" |
|
165 and fg: "(R ===> op =) f g" |
|
166 show "SUPR A f = SUPR B g" |
|
167 by(rule SUPR_eq)(auto 4 4 dest: set_relD1[OF AB] set_relD2[OF AB] fun_relD[OF fg] intro: rev_bexI) |
|
168 qed |
156 |
169 |
157 subsubsection {* Rules requiring bi-unique, bi-total or right-total relations *} |
170 subsubsection {* Rules requiring bi-unique, bi-total or right-total relations *} |
158 |
171 |
159 lemma member_transfer [transfer_rule]: |
172 lemma member_transfer [transfer_rule]: |
160 assumes "bi_unique A" |
173 assumes "bi_unique A" |
266 |
279 |
267 lemma card_transfer [transfer_rule]: |
280 lemma card_transfer [transfer_rule]: |
268 "bi_unique A \<Longrightarrow> (set_rel A ===> op =) card card" |
281 "bi_unique A \<Longrightarrow> (set_rel A ===> op =) card card" |
269 by (rule fun_relI, erule (1) bi_unique_set_rel_lemma, simp add: card_image) |
282 by (rule fun_relI, erule (1) bi_unique_set_rel_lemma, simp add: card_image) |
270 |
283 |
|
284 lemma vimage_parametric [transfer_rule]: |
|
285 assumes [transfer_rule]: "bi_total A" "bi_unique B" |
|
286 shows "((A ===> B) ===> set_rel B ===> set_rel A) vimage vimage" |
|
287 unfolding vimage_def[abs_def] by transfer_prover |
|
288 |
|
289 lemma setsum_parametric [transfer_rule]: |
|
290 assumes "bi_unique A" |
|
291 shows "((A ===> op =) ===> set_rel A ===> op =) setsum setsum" |
|
292 proof(rule fun_relI)+ |
|
293 fix f :: "'a \<Rightarrow> 'c" and g S T |
|
294 assume fg: "(A ===> op =) f g" |
|
295 and ST: "set_rel A S T" |
|
296 show "setsum f S = setsum g T" |
|
297 proof(rule setsum_reindex_cong) |
|
298 let ?f = "\<lambda>t. THE s. A s t" |
|
299 show "S = ?f ` T" |
|
300 by(blast dest: set_relD1[OF ST] set_relD2[OF ST] bi_uniqueDl[OF assms] |
|
301 intro: rev_image_eqI the_equality[symmetric] subst[rotated, where P="\<lambda>x. x \<in> S"]) |
|
302 |
|
303 show "inj_on ?f T" |
|
304 proof(rule inj_onI) |
|
305 fix t1 t2 |
|
306 assume "t1 \<in> T" "t2 \<in> T" "?f t1 = ?f t2" |
|
307 from ST `t1 \<in> T` obtain s1 where "A s1 t1" "s1 \<in> S" by(auto dest: set_relD2) |
|
308 hence "?f t1 = s1" by(auto dest: bi_uniqueDl[OF assms]) |
|
309 moreover |
|
310 from ST `t2 \<in> T` obtain s2 where "A s2 t2" "s2 \<in> S" by(auto dest: set_relD2) |
|
311 hence "?f t2 = s2" by(auto dest: bi_uniqueDl[OF assms]) |
|
312 ultimately have "s1 = s2" using `?f t1 = ?f t2` by simp |
|
313 with `A s1 t1` `A s2 t2` show "t1 = t2" by(auto dest: bi_uniqueDr[OF assms]) |
|
314 qed |
|
315 |
|
316 fix t |
|
317 assume "t \<in> T" |
|
318 with ST obtain s where "A s t" "s \<in> S" by(auto dest: set_relD2) |
|
319 hence "?f t = s" by(auto dest: bi_uniqueDl[OF assms]) |
|
320 moreover from fg `A s t` have "f s = g t" by(rule fun_relD) |
|
321 ultimately show "g t = f (?f t)" by simp |
|
322 qed |
|
323 qed |
|
324 |
271 end |
325 end |
272 |
326 |
273 end |
327 end |