src/ZF/Perm.ML
changeset 4091 771b1f6422a8
parent 3840 e0baea4d485a
child 4152 451104c223e2
equal deleted inserted replaced
4090:9f1eaab75e8c 4091:771b1f6422a8
    16 goalw Perm.thy [surj_def] "!!f A B. f: surj(A,B) ==> f: A->B";
    16 goalw Perm.thy [surj_def] "!!f A B. f: surj(A,B) ==> f: A->B";
    17 by (etac CollectD1 1);
    17 by (etac CollectD1 1);
    18 qed "surj_is_fun";
    18 qed "surj_is_fun";
    19 
    19 
    20 goalw Perm.thy [surj_def] "!!f A B. f : Pi(A,B) ==> f: surj(A,range(f))";
    20 goalw Perm.thy [surj_def] "!!f A B. f : Pi(A,B) ==> f: surj(A,range(f))";
    21 by (blast_tac (!claset addIs [apply_equality, range_of_fun, domain_type]) 1);
    21 by (blast_tac (claset() addIs [apply_equality, range_of_fun, domain_type]) 1);
    22 qed "fun_is_surj";
    22 qed "fun_is_surj";
    23 
    23 
    24 goalw Perm.thy [surj_def] "!!f A B. f: surj(A,B) ==> range(f)=B";
    24 goalw Perm.thy [surj_def] "!!f A B. f: surj(A,B) ==> range(f)=B";
    25 by (best_tac (!claset addIs [apply_Pair] addEs [range_type]) 1);
    25 by (best_tac (claset() addIs [apply_Pair] addEs [range_type]) 1);
    26 qed "surj_range";
    26 qed "surj_range";
    27 
    27 
    28 (** A function with a right inverse is a surjection **)
    28 (** A function with a right inverse is a surjection **)
    29 
    29 
    30 val prems = goalw Perm.thy [surj_def]
    30 val prems = goalw Perm.thy [surj_def]
    31     "[| f: A->B;  !!y. y:B ==> d(y): A;  !!y. y:B ==> f`d(y) = y \
    31     "[| f: A->B;  !!y. y:B ==> d(y): A;  !!y. y:B ==> f`d(y) = y \
    32 \    |] ==> f: surj(A,B)";
    32 \    |] ==> f: surj(A,B)";
    33 by (blast_tac (!claset addIs prems) 1);
    33 by (blast_tac (claset() addIs prems) 1);
    34 qed "f_imp_surjective";
    34 qed "f_imp_surjective";
    35 
    35 
    36 val prems = goal Perm.thy
    36 val prems = goal Perm.thy
    37     "[| !!x. x:A ==> c(x): B;           \
    37     "[| !!x. x:A ==> c(x): B;           \
    38 \       !!y. y:B ==> d(y): A;           \
    38 \       !!y. y:B ==> d(y): A;           \
    39 \       !!y. y:B ==> c(d(y)) = y        \
    39 \       !!y. y:B ==> c(d(y)) = y        \
    40 \    |] ==> (lam x:A. c(x)) : surj(A,B)";
    40 \    |] ==> (lam x:A. c(x)) : surj(A,B)";
    41 by (res_inst_tac [("d", "d")] f_imp_surjective 1);
    41 by (res_inst_tac [("d", "d")] f_imp_surjective 1);
    42 by (ALLGOALS (asm_simp_tac (!simpset addsimps ([lam_type]@prems)) ));
    42 by (ALLGOALS (asm_simp_tac (simpset() addsimps ([lam_type]@prems)) ));
    43 qed "lam_surjective";
    43 qed "lam_surjective";
    44 
    44 
    45 (*Cantor's theorem revisited*)
    45 (*Cantor's theorem revisited*)
    46 goalw Perm.thy [surj_def] "f ~: surj(A,Pow(A))";
    46 goalw Perm.thy [surj_def] "f ~: surj(A,Pow(A))";
    47 by (safe_tac (!claset));
    47 by (safe_tac (claset()));
    48 by (cut_facts_tac [cantor] 1);
    48 by (cut_facts_tac [cantor] 1);
    49 by (fast_tac subset_cs 1);
    49 by (fast_tac subset_cs 1);
    50 qed "cantor_surj";
    50 qed "cantor_surj";
    51 
    51 
    52 
    52 
    68 val inj_apply_equality = result();
    68 val inj_apply_equality = result();
    69 
    69 
    70 (** A function with a left inverse is an injection **)
    70 (** A function with a left inverse is an injection **)
    71 
    71 
    72 goal Perm.thy "!!f. [| f: A->B;  ALL x:A. d(f`x)=x |] ==> f: inj(A,B)";
    72 goal Perm.thy "!!f. [| f: A->B;  ALL x:A. d(f`x)=x |] ==> f: inj(A,B)";
    73 by (asm_simp_tac (!simpset addsimps [inj_def]) 1);
    73 by (asm_simp_tac (simpset() addsimps [inj_def]) 1);
    74 by (deepen_tac (!claset addEs [subst_context RS box_equals]) 0 1);
    74 by (deepen_tac (claset() addEs [subst_context RS box_equals]) 0 1);
    75 bind_thm ("f_imp_injective", ballI RSN (2,result()));
    75 bind_thm ("f_imp_injective", ballI RSN (2,result()));
    76 
    76 
    77 val prems = goal Perm.thy
    77 val prems = goal Perm.thy
    78     "[| !!x. x:A ==> c(x): B;           \
    78     "[| !!x. x:A ==> c(x): B;           \
    79 \       !!x. x:A ==> d(c(x)) = x        \
    79 \       !!x. x:A ==> d(c(x)) = x        \
    80 \    |] ==> (lam x:A. c(x)) : inj(A,B)";
    80 \    |] ==> (lam x:A. c(x)) : inj(A,B)";
    81 by (res_inst_tac [("d", "d")] f_imp_injective 1);
    81 by (res_inst_tac [("d", "d")] f_imp_injective 1);
    82 by (ALLGOALS (asm_simp_tac (!simpset addsimps ([lam_type]@prems)) ));
    82 by (ALLGOALS (asm_simp_tac (simpset() addsimps ([lam_type]@prems)) ));
    83 qed "lam_injective";
    83 qed "lam_injective";
    84 
    84 
    85 (** Bijections **)
    85 (** Bijections **)
    86 
    86 
    87 goalw Perm.thy [bij_def] "!!f A B. f: bij(A,B) ==> f: inj(A,B)";
    87 goalw Perm.thy [bij_def] "!!f A B. f: bij(A,B) ==> f: inj(A,B)";
   140 qed "id_subset_inj";
   140 qed "id_subset_inj";
   141 
   141 
   142 val id_inj = subset_refl RS id_subset_inj;
   142 val id_inj = subset_refl RS id_subset_inj;
   143 
   143 
   144 goalw Perm.thy [id_def,surj_def] "id(A): surj(A,A)";
   144 goalw Perm.thy [id_def,surj_def] "id(A): surj(A,A)";
   145 by (blast_tac (!claset addIs [lam_type, beta]) 1);
   145 by (blast_tac (claset() addIs [lam_type, beta]) 1);
   146 qed "id_surj";
   146 qed "id_surj";
   147 
   147 
   148 goalw Perm.thy [bij_def] "id(A): bij(A,A)";
   148 goalw Perm.thy [bij_def] "id(A): bij(A,A)";
   149 by (blast_tac (!claset addIs [id_inj, id_surj]) 1);
   149 by (blast_tac (claset() addIs [id_inj, id_surj]) 1);
   150 qed "id_bij";
   150 qed "id_bij";
   151 
   151 
   152 goalw Perm.thy [id_def] "A <= B <-> id(A) : A->B";
   152 goalw Perm.thy [id_def] "A <= B <-> id(A) : A->B";
   153 by (fast_tac (!claset addSIs [lam_type] addDs [apply_type] 
   153 by (fast_tac (claset() addSIs [lam_type] addDs [apply_type] 
   154                       addss (!simpset)) 1);
   154                       addss (simpset())) 1);
   155 qed "subset_iff_id";
   155 qed "subset_iff_id";
   156 
   156 
   157 
   157 
   158 (*** Converse of a function ***)
   158 (*** Converse of a function ***)
   159 
   159 
   160 goalw Perm.thy [inj_def] "!!f. f: inj(A,B) ==> converse(f) : range(f)->A";
   160 goalw Perm.thy [inj_def] "!!f. f: inj(A,B) ==> converse(f) : range(f)->A";
   161 by (asm_simp_tac (!simpset addsimps [Pi_iff, function_def]) 1);
   161 by (asm_simp_tac (simpset() addsimps [Pi_iff, function_def]) 1);
   162 by (etac CollectE 1);
   162 by (etac CollectE 1);
   163 by (asm_simp_tac (!simpset addsimps [apply_iff]) 1);
   163 by (asm_simp_tac (simpset() addsimps [apply_iff]) 1);
   164 by (blast_tac (!claset addDs [fun_is_rel]) 1);
   164 by (blast_tac (claset() addDs [fun_is_rel]) 1);
   165 qed "inj_converse_fun";
   165 qed "inj_converse_fun";
   166 
   166 
   167 (** Equations for converse(f) **)
   167 (** Equations for converse(f) **)
   168 
   168 
   169 (*The premises are equivalent to saying that f is injective...*) 
   169 (*The premises are equivalent to saying that f is injective...*) 
   170 goal Perm.thy
   170 goal Perm.thy
   171     "!!f. [| f: A->B;  converse(f): C->A;  a: A |] ==> converse(f)`(f`a) = a";
   171     "!!f. [| f: A->B;  converse(f): C->A;  a: A |] ==> converse(f)`(f`a) = a";
   172 by (blast_tac (!claset addIs [apply_Pair, apply_equality, converseI]) 1);
   172 by (blast_tac (claset() addIs [apply_Pair, apply_equality, converseI]) 1);
   173 qed "left_inverse_lemma";
   173 qed "left_inverse_lemma";
   174 
   174 
   175 goal Perm.thy
   175 goal Perm.thy
   176     "!!f. [| f: inj(A,B);  a: A |] ==> converse(f)`(f`a) = a";
   176     "!!f. [| f: inj(A,B);  a: A |] ==> converse(f)`(f`a) = a";
   177 by (blast_tac (!claset addIs [left_inverse_lemma, inj_converse_fun,
   177 by (blast_tac (claset() addIs [left_inverse_lemma, inj_converse_fun,
   178 			      inj_is_fun]) 1);
   178 			      inj_is_fun]) 1);
   179 qed "left_inverse";
   179 qed "left_inverse";
   180 
   180 
   181 val left_inverse_bij = bij_is_inj RS left_inverse;
   181 val left_inverse_bij = bij_is_inj RS left_inverse;
   182 
   182 
   195 
   195 
   196 (*Cannot add [left_inverse, right_inverse] to default simpset: there are too
   196 (*Cannot add [left_inverse, right_inverse] to default simpset: there are too
   197   many ways of expressing sufficient conditions.*)
   197   many ways of expressing sufficient conditions.*)
   198 
   198 
   199 goal Perm.thy "!!f. [| f: bij(A,B);  b: B |] ==> f`(converse(f)`b) = b";
   199 goal Perm.thy "!!f. [| f: bij(A,B);  b: B |] ==> f`(converse(f)`b) = b";
   200 by (fast_tac (!claset addss
   200 by (fast_tac (claset() addss
   201 	      (!simpset addsimps [bij_def, right_inverse, surj_range])) 1);
   201 	      (simpset() addsimps [bij_def, right_inverse, surj_range])) 1);
   202 qed "right_inverse_bij";
   202 qed "right_inverse_bij";
   203 
   203 
   204 (** Converses of injections, surjections, bijections **)
   204 (** Converses of injections, surjections, bijections **)
   205 
   205 
   206 goal Perm.thy "!!f A B. f: inj(A,B) ==> converse(f): inj(range(f), A)";
   206 goal Perm.thy "!!f A B. f: inj(A,B) ==> converse(f): inj(range(f), A)";
   209 by (rtac right_inverse 1);
   209 by (rtac right_inverse 1);
   210 by (REPEAT (assume_tac 1));
   210 by (REPEAT (assume_tac 1));
   211 qed "inj_converse_inj";
   211 qed "inj_converse_inj";
   212 
   212 
   213 goal Perm.thy "!!f A B. f: inj(A,B) ==> converse(f): surj(range(f), A)";
   213 goal Perm.thy "!!f A B. f: inj(A,B) ==> converse(f): surj(range(f), A)";
   214 by (blast_tac (!claset addIs [f_imp_surjective, inj_converse_fun, left_inverse,
   214 by (blast_tac (claset() addIs [f_imp_surjective, inj_converse_fun, left_inverse,
   215 			      inj_is_fun, range_of_fun RS apply_type]) 1);
   215 			      inj_is_fun, range_of_fun RS apply_type]) 1);
   216 qed "inj_converse_surj";
   216 qed "inj_converse_surj";
   217 
   217 
   218 goalw Perm.thy [bij_def] "!!f A B. f: bij(A,B) ==> converse(f): bij(B,A)";
   218 goalw Perm.thy [bij_def] "!!f A B. f: bij(A,B) ==> converse(f): bij(B,A)";
   219 by (fast_tac (!claset addEs [surj_range RS subst, inj_converse_inj,
   219 by (fast_tac (claset() addEs [surj_range RS subst, inj_converse_inj,
   220 			      inj_converse_surj]) 1);
   220 			      inj_converse_surj]) 1);
   221 qed "bij_converse_bij";
   221 qed "bij_converse_bij";
   222 (*Adding this as an SI seems to cause looping*)
   222 (*Adding this as an SI seems to cause looping*)
   223 
   223 
   224 
   224 
   311 by (Blast_tac 1);
   311 by (Blast_tac 1);
   312 qed "comp_function";
   312 qed "comp_function";
   313 
   313 
   314 goal Perm.thy "!!f g. [| g: A->B;  f: B->C |] ==> (f O g) : A->C";
   314 goal Perm.thy "!!f g. [| g: A->B;  f: B->C |] ==> (f O g) : A->C";
   315 by (asm_full_simp_tac
   315 by (asm_full_simp_tac
   316     (!simpset addsimps [Pi_def, comp_function, Pow_iff, comp_rel]
   316     (simpset() addsimps [Pi_def, comp_function, Pow_iff, comp_rel]
   317            setloop etac conjE) 1);
   317            setloop etac conjE) 1);
   318 by (stac (range_rel_subset RS domain_comp_eq) 1 THEN assume_tac 2);
   318 by (stac (range_rel_subset RS domain_comp_eq) 1 THEN assume_tac 2);
   319 by (Blast_tac 1);
   319 by (Blast_tac 1);
   320 qed "comp_fun";
   320 qed "comp_fun";
   321 
   321 
   332 \    |] ==> (lam y:B. c(y)) O (lam x:A. b(x)) = (lam x:A. c(b(x)))";
   332 \    |] ==> (lam y:B. c(y)) O (lam x:A. b(x)) = (lam x:A. c(b(x)))";
   333 by (rtac fun_extension 1);
   333 by (rtac fun_extension 1);
   334 by (rtac comp_fun 1);
   334 by (rtac comp_fun 1);
   335 by (rtac lam_funtype 2);
   335 by (rtac lam_funtype 2);
   336 by (typechk_tac (prem::ZF_typechecks));
   336 by (typechk_tac (prem::ZF_typechecks));
   337 by (asm_simp_tac (!simpset 
   337 by (asm_simp_tac (simpset() 
   338              setSolver type_auto_tac [lam_type, lam_funtype, prem]) 1);
   338              setSolver type_auto_tac [lam_type, lam_funtype, prem]) 1);
   339 qed "comp_lam";
   339 qed "comp_lam";
   340 
   340 
   341 goal Perm.thy "!!f g. [| g: inj(A,B);  f: inj(B,C) |] ==> (f O g) : inj(A,C)";
   341 goal Perm.thy "!!f g. [| g: inj(A,B);  f: inj(B,C) |] ==> (f O g) : inj(A,C)";
   342 by (res_inst_tac [("d", "%y. converse(g) ` (converse(f) ` y)")]
   342 by (res_inst_tac [("d", "%y. converse(g) ` (converse(f) ` y)")]
   343     f_imp_injective 1);
   343     f_imp_injective 1);
   344 by (REPEAT (ares_tac [comp_fun, inj_is_fun] 1));
   344 by (REPEAT (ares_tac [comp_fun, inj_is_fun] 1));
   345 by (asm_simp_tac (!simpset  addsimps [left_inverse] 
   345 by (asm_simp_tac (simpset()  addsimps [left_inverse] 
   346                         setSolver type_auto_tac [inj_is_fun, apply_type]) 1);
   346                         setSolver type_auto_tac [inj_is_fun, apply_type]) 1);
   347 qed "comp_inj";
   347 qed "comp_inj";
   348 
   348 
   349 goalw Perm.thy [surj_def]
   349 goalw Perm.thy [surj_def]
   350     "!!f g. [| g: surj(A,B);  f: surj(B,C) |] ==> (f O g) : surj(A,C)";
   350     "!!f g. [| g: surj(A,B);  f: surj(B,C) |] ==> (f O g) : surj(A,C)";
   351 by (blast_tac (!claset addSIs [comp_fun,comp_fun_apply]) 1);
   351 by (blast_tac (claset() addSIs [comp_fun,comp_fun_apply]) 1);
   352 qed "comp_surj";
   352 qed "comp_surj";
   353 
   353 
   354 goalw Perm.thy [bij_def]
   354 goalw Perm.thy [bij_def]
   355     "!!f g. [| g: bij(A,B);  f: bij(B,C) |] ==> (f O g) : bij(A,C)";
   355     "!!f g. [| g: bij(A,B);  f: bij(B,C) |] ==> (f O g) : bij(A,C)";
   356 by (blast_tac (!claset addIs [comp_inj,comp_surj]) 1);
   356 by (blast_tac (claset() addIs [comp_inj,comp_surj]) 1);
   357 qed "comp_bij";
   357 qed "comp_bij";
   358 
   358 
   359 
   359 
   360 (** Dual properties of inj and surj -- useful for proofs from
   360 (** Dual properties of inj and surj -- useful for proofs from
   361     D Pastre.  Automatic theorem proving in set theory. 
   361     D Pastre.  Automatic theorem proving in set theory. 
   362     Artificial Intelligence, 10:1--27, 1978. **)
   362     Artificial Intelligence, 10:1--27, 1978. **)
   363 
   363 
   364 goalw Perm.thy [inj_def]
   364 goalw Perm.thy [inj_def]
   365     "!!f g. [| (f O g): inj(A,C);  g: A->B;  f: B->C |] ==> g: inj(A,B)";
   365     "!!f g. [| (f O g): inj(A,C);  g: A->B;  f: B->C |] ==> g: inj(A,B)";
   366 by (safe_tac (!claset));
   366 by (safe_tac (claset()));
   367 by (REPEAT (eresolve_tac [asm_rl, bspec RS bspec RS mp] 1));
   367 by (REPEAT (eresolve_tac [asm_rl, bspec RS bspec RS mp] 1));
   368 by (asm_simp_tac (!simpset ) 1);
   368 by (asm_simp_tac (simpset() ) 1);
   369 qed "comp_mem_injD1";
   369 qed "comp_mem_injD1";
   370 
   370 
   371 goalw Perm.thy [inj_def,surj_def]
   371 goalw Perm.thy [inj_def,surj_def]
   372     "!!f g. [| (f O g): inj(A,C);  g: surj(A,B);  f: B->C |] ==> f: inj(B,C)";
   372     "!!f g. [| (f O g): inj(A,C);  g: surj(A,B);  f: B->C |] ==> f: inj(B,C)";
   373 by (safe_tac (!claset));
   373 by (safe_tac (claset()));
   374 by (res_inst_tac [("x1", "x")] (bspec RS bexE) 1);
   374 by (res_inst_tac [("x1", "x")] (bspec RS bexE) 1);
   375 by (eres_inst_tac [("x1", "w")] (bspec RS bexE) 3);
   375 by (eres_inst_tac [("x1", "w")] (bspec RS bexE) 3);
   376 by (REPEAT (assume_tac 1));
   376 by (REPEAT (assume_tac 1));
   377 by (safe_tac (!claset));
   377 by (safe_tac (claset()));
   378 by (res_inst_tac [("t", "op `(g)")] subst_context 1);
   378 by (res_inst_tac [("t", "op `(g)")] subst_context 1);
   379 by (REPEAT (eresolve_tac [asm_rl, bspec RS bspec RS mp] 1));
   379 by (REPEAT (eresolve_tac [asm_rl, bspec RS bspec RS mp] 1));
   380 by (asm_simp_tac (!simpset ) 1);
   380 by (asm_simp_tac (simpset() ) 1);
   381 qed "comp_mem_injD2";
   381 qed "comp_mem_injD2";
   382 
   382 
   383 goalw Perm.thy [surj_def]
   383 goalw Perm.thy [surj_def]
   384     "!!f g. [| (f O g): surj(A,C);  g: A->B;  f: B->C |] ==> f: surj(B,C)";
   384     "!!f g. [| (f O g): surj(A,C);  g: A->B;  f: B->C |] ==> f: surj(B,C)";
   385 by (blast_tac (!claset addSIs [comp_fun_apply RS sym, apply_funtype]) 1);
   385 by (blast_tac (claset() addSIs [comp_fun_apply RS sym, apply_funtype]) 1);
   386 qed "comp_mem_surjD1";
   386 qed "comp_mem_surjD1";
   387 
   387 
   388 goal Perm.thy
   388 goal Perm.thy
   389     "!!f g. [| (f O g)`a = c;  g: A->B;  f: B->C;  a:A |] ==> f`(g`a) = c";
   389     "!!f g. [| (f O g)`a = c;  g: A->B;  f: B->C;  a:A |] ==> f`(g`a) = c";
   390 by (REPEAT (ares_tac [comp_fun_apply RS sym RS trans] 1));
   390 by (REPEAT (ares_tac [comp_fun_apply RS sym RS trans] 1));
   391 qed "comp_fun_applyD";
   391 qed "comp_fun_applyD";
   392 
   392 
   393 goalw Perm.thy [inj_def,surj_def]
   393 goalw Perm.thy [inj_def,surj_def]
   394     "!!f g. [| (f O g): surj(A,C);  g: A->B;  f: inj(B,C) |] ==> g: surj(A,B)";
   394     "!!f g. [| (f O g): surj(A,C);  g: A->B;  f: inj(B,C) |] ==> g: surj(A,B)";
   395 by (safe_tac (!claset));
   395 by (safe_tac (claset()));
   396 by (eres_inst_tac [("x1", "f`y")] (bspec RS bexE) 1);
   396 by (eres_inst_tac [("x1", "f`y")] (bspec RS bexE) 1);
   397 by (REPEAT (ares_tac [apply_type] 1 ORELSE dtac comp_fun_applyD 1));
   397 by (REPEAT (ares_tac [apply_type] 1 ORELSE dtac comp_fun_applyD 1));
   398 by (blast_tac (!claset addSIs [apply_funtype]) 1);
   398 by (blast_tac (claset() addSIs [apply_funtype]) 1);
   399 qed "comp_mem_surjD2";
   399 qed "comp_mem_surjD2";
   400 
   400 
   401 
   401 
   402 (** inverses of composition **)
   402 (** inverses of composition **)
   403 
   403 
   404 (*left inverse of composition; one inclusion is
   404 (*left inverse of composition; one inclusion is
   405         f: A->B ==> id(A) <= converse(f) O f *)
   405         f: A->B ==> id(A) <= converse(f) O f *)
   406 goalw Perm.thy [inj_def] "!!f. f: inj(A,B) ==> converse(f) O f = id(A)";
   406 goalw Perm.thy [inj_def] "!!f. f: inj(A,B) ==> converse(f) O f = id(A)";
   407 by (fast_tac (!claset addIs [apply_Pair] 
   407 by (fast_tac (claset() addIs [apply_Pair] 
   408                       addEs [domain_type]
   408                       addEs [domain_type]
   409                addss (!simpset addsimps [apply_iff])) 1);
   409                addss (simpset() addsimps [apply_iff])) 1);
   410 qed "left_comp_inverse";
   410 qed "left_comp_inverse";
   411 
   411 
   412 (*right inverse of composition; one inclusion is
   412 (*right inverse of composition; one inclusion is
   413                 f: A->B ==> f O converse(f) <= id(B) 
   413                 f: A->B ==> f O converse(f) <= id(B) 
   414 *)
   414 *)
   415 val [prem] = goalw Perm.thy [surj_def]
   415 val [prem] = goalw Perm.thy [surj_def]
   416     "f: surj(A,B) ==> f O converse(f) = id(B)";
   416     "f: surj(A,B) ==> f O converse(f) = id(B)";
   417 val appfD = (prem RS CollectD1) RSN (3,apply_equality2);
   417 val appfD = (prem RS CollectD1) RSN (3,apply_equality2);
   418 by (cut_facts_tac [prem] 1);
   418 by (cut_facts_tac [prem] 1);
   419 by (rtac equalityI 1);
   419 by (rtac equalityI 1);
   420 by (best_tac (!claset addEs [domain_type, range_type, make_elim appfD]) 1);
   420 by (best_tac (claset() addEs [domain_type, range_type, make_elim appfD]) 1);
   421 by (blast_tac (!claset addIs [apply_Pair]) 1);
   421 by (blast_tac (claset() addIs [apply_Pair]) 1);
   422 qed "right_comp_inverse";
   422 qed "right_comp_inverse";
   423 
   423 
   424 (** Proving that a function is a bijection **)
   424 (** Proving that a function is a bijection **)
   425 
   425 
   426 goalw Perm.thy [id_def]
   426 goalw Perm.thy [id_def]
   427     "!!f A B. [| f: A->B;  g: B->A |] ==> \
   427     "!!f A B. [| f: A->B;  g: B->A |] ==> \
   428 \             f O g = id(B) <-> (ALL y:B. f`(g`y)=y)";
   428 \             f O g = id(B) <-> (ALL y:B. f`(g`y)=y)";
   429 by (safe_tac (!claset));
   429 by (safe_tac (claset()));
   430 by (dres_inst_tac [("t", "%h. h`y ")] subst_context 1);
   430 by (dres_inst_tac [("t", "%h. h`y ")] subst_context 1);
   431 by (Asm_full_simp_tac 1);
   431 by (Asm_full_simp_tac 1);
   432 by (rtac fun_extension 1);
   432 by (rtac fun_extension 1);
   433 by (REPEAT (ares_tac [comp_fun, lam_type] 1));
   433 by (REPEAT (ares_tac [comp_fun, lam_type] 1));
   434 by (Auto_tac());
   434 by (Auto_tac());
   435 qed "comp_eq_id_iff";
   435 qed "comp_eq_id_iff";
   436 
   436 
   437 goalw Perm.thy [bij_def]
   437 goalw Perm.thy [bij_def]
   438     "!!f A B. [| f: A->B;  g: B->A;  f O g = id(B);  g O f = id(A) \
   438     "!!f A B. [| f: A->B;  g: B->A;  f O g = id(B);  g O f = id(A) \
   439 \             |] ==> f : bij(A,B)";
   439 \             |] ==> f : bij(A,B)";
   440 by (asm_full_simp_tac (!simpset addsimps [comp_eq_id_iff]) 1);
   440 by (asm_full_simp_tac (simpset() addsimps [comp_eq_id_iff]) 1);
   441 by (REPEAT (ares_tac [conjI, f_imp_injective, f_imp_surjective] 1
   441 by (REPEAT (ares_tac [conjI, f_imp_injective, f_imp_surjective] 1
   442        ORELSE eresolve_tac [bspec, apply_type] 1));
   442        ORELSE eresolve_tac [bspec, apply_type] 1));
   443 qed "fg_imp_bijective";
   443 qed "fg_imp_bijective";
   444 
   444 
   445 goal Perm.thy "!!f A. [| f: A->A;  f O f = id(A) |] ==> f : bij(A,A)";
   445 goal Perm.thy "!!f A. [| f: A->A;  f O f = id(A) |] ==> f : bij(A,A)";
   446 by (REPEAT (ares_tac [fg_imp_bijective] 1));
   446 by (REPEAT (ares_tac [fg_imp_bijective] 1));
   447 qed "nilpotent_imp_bijective";
   447 qed "nilpotent_imp_bijective";
   448 
   448 
   449 goal Perm.thy "!!f A B. [| converse(f): B->A;  f: A->B |] ==> f : bij(A,B)";
   449 goal Perm.thy "!!f A B. [| converse(f): B->A;  f: A->B |] ==> f : bij(A,B)";
   450 by (asm_simp_tac (!simpset addsimps [fg_imp_bijective, comp_eq_id_iff, 
   450 by (asm_simp_tac (simpset() addsimps [fg_imp_bijective, comp_eq_id_iff, 
   451                                   left_inverse_lemma, right_inverse_lemma]) 1);
   451                                   left_inverse_lemma, right_inverse_lemma]) 1);
   452 qed "invertible_imp_bijective";
   452 qed "invertible_imp_bijective";
   453 
   453 
   454 (** Unions of functions -- cf similar theorems on func.ML **)
   454 (** Unions of functions -- cf similar theorems on func.ML **)
   455 
   455 
   458     "!!f g. [| f: inj(A,B);  g: inj(C,D);  B Int D = 0 |] ==> \
   458     "!!f g. [| f: inj(A,B);  g: inj(C,D);  B Int D = 0 |] ==> \
   459 \           (lam a: A Un C. if(a:A, f`a, g`a)) : inj(A Un C, B Un D)";
   459 \           (lam a: A Un C. if(a:A, f`a, g`a)) : inj(A Un C, B Un D)";
   460 by (res_inst_tac [("d","%z. if(z:B, converse(f)`z, converse(g)`z)")]
   460 by (res_inst_tac [("d","%z. if(z:B, converse(f)`z, converse(g)`z)")]
   461         lam_injective 1);
   461         lam_injective 1);
   462 by (ALLGOALS 
   462 by (ALLGOALS 
   463     (asm_simp_tac (!simpset addsimps [inj_is_fun RS apply_type, left_inverse] 
   463     (asm_simp_tac (simpset() addsimps [inj_is_fun RS apply_type, left_inverse] 
   464                          setloop (split_tac [expand_if] ORELSE' etac UnE))));
   464                          setloop (split_tac [expand_if] ORELSE' etac UnE))));
   465 by (blast_tac (!claset addIs [inj_is_fun RS apply_type] addDs [equals0D]) 1);
   465 by (blast_tac (claset() addIs [inj_is_fun RS apply_type] addDs [equals0D]) 1);
   466 qed "inj_disjoint_Un";
   466 qed "inj_disjoint_Un";
   467 
   467 
   468 goalw Perm.thy [surj_def]
   468 goalw Perm.thy [surj_def]
   469     "!!f g. [| f: surj(A,B);  g: surj(C,D);  A Int C = 0 |] ==> \
   469     "!!f g. [| f: surj(A,B);  g: surj(C,D);  A Int C = 0 |] ==> \
   470 \           (f Un g) : surj(A Un C, B Un D)";
   470 \           (f Un g) : surj(A Un C, B Un D)";
   471 by (blast_tac (!claset addIs [fun_disjoint_apply1, fun_disjoint_apply2,
   471 by (blast_tac (claset() addIs [fun_disjoint_apply1, fun_disjoint_apply2,
   472 			      fun_disjoint_Un, trans]) 1);
   472 			      fun_disjoint_Un, trans]) 1);
   473 qed "surj_disjoint_Un";
   473 qed "surj_disjoint_Un";
   474 
   474 
   475 (*A simple, high-level proof; the version for injections follows from it,
   475 (*A simple, high-level proof; the version for injections follows from it,
   476   using  f:inj(A,B) <-> f:bij(A,range(f))  *)
   476   using  f:inj(A,B) <-> f:bij(A,range(f))  *)
   486 (** Restrictions as surjections and bijections *)
   486 (** Restrictions as surjections and bijections *)
   487 
   487 
   488 val prems = goalw Perm.thy [surj_def]
   488 val prems = goalw Perm.thy [surj_def]
   489     "f: Pi(A,B) ==> f: surj(A, f``A)";
   489     "f: Pi(A,B) ==> f: surj(A, f``A)";
   490 val rls = apply_equality :: (prems RL [apply_Pair,Pi_type]);
   490 val rls = apply_equality :: (prems RL [apply_Pair,Pi_type]);
   491 by (fast_tac (!claset addIs rls) 1);
   491 by (fast_tac (claset() addIs rls) 1);
   492 qed "surj_image";
   492 qed "surj_image";
   493 
   493 
   494 goal Perm.thy "!!f. [| f: Pi(C,B);  A<=C |] ==> restrict(f,A)``A = f``A";
   494 goal Perm.thy "!!f. [| f: Pi(C,B);  A<=C |] ==> restrict(f,A)``A = f``A";
   495 by (rtac equalityI 1);
   495 by (rtac equalityI 1);
   496 by (SELECT_GOAL (rewtac restrict_def) 2);
   496 by (SELECT_GOAL (rewtac restrict_def) 2);
   499 by (REPEAT (ares_tac [image_mono,restrict_subset,subset_refl] 1));
   499 by (REPEAT (ares_tac [image_mono,restrict_subset,subset_refl] 1));
   500 qed "restrict_image";
   500 qed "restrict_image";
   501 
   501 
   502 goalw Perm.thy [inj_def]
   502 goalw Perm.thy [inj_def]
   503     "!!f. [| f: inj(A,B);  C<=A |] ==> restrict(f,C): inj(C,B)";
   503     "!!f. [| f: inj(A,B);  C<=A |] ==> restrict(f,C): inj(C,B)";
   504 by (safe_tac (!claset addSEs [restrict_type2]));
   504 by (safe_tac (claset() addSEs [restrict_type2]));
   505 by (REPEAT (eresolve_tac [asm_rl, bspec RS bspec RS mp, subsetD,
   505 by (REPEAT (eresolve_tac [asm_rl, bspec RS bspec RS mp, subsetD,
   506                           box_equals, restrict] 1));
   506                           box_equals, restrict] 1));
   507 qed "restrict_inj";
   507 qed "restrict_inj";
   508 
   508 
   509 val prems = goal Perm.thy 
   509 val prems = goal Perm.thy 
   513 by (REPEAT (resolve_tac prems 1));
   513 by (REPEAT (resolve_tac prems 1));
   514 qed "restrict_surj";
   514 qed "restrict_surj";
   515 
   515 
   516 goalw Perm.thy [inj_def,bij_def]
   516 goalw Perm.thy [inj_def,bij_def]
   517     "!!f. [| f: inj(A,B);  C<=A |] ==> restrict(f,C): bij(C, f``C)";
   517     "!!f. [| f: inj(A,B);  C<=A |] ==> restrict(f,C): bij(C, f``C)";
   518 by (blast_tac (!claset addSIs [restrict, restrict_surj]
   518 by (blast_tac (claset() addSIs [restrict, restrict_surj]
   519 		       addIs [box_equals, surj_is_fun]) 1);
   519 		       addIs [box_equals, surj_is_fun]) 1);
   520 qed "restrict_bij";
   520 qed "restrict_bij";
   521 
   521 
   522 
   522 
   523 (*** Lemmas for Ramsey's Theorem ***)
   523 (*** Lemmas for Ramsey's Theorem ***)
   524 
   524 
   525 goalw Perm.thy [inj_def] "!!f. [| f: inj(A,B);  B<=D |] ==> f: inj(A,D)";
   525 goalw Perm.thy [inj_def] "!!f. [| f: inj(A,B);  B<=D |] ==> f: inj(A,D)";
   526 by (blast_tac (!claset addIs [fun_weaken_type]) 1);
   526 by (blast_tac (claset() addIs [fun_weaken_type]) 1);
   527 qed "inj_weaken_type";
   527 qed "inj_weaken_type";
   528 
   528 
   529 val [major] = goal Perm.thy  
   529 val [major] = goal Perm.thy  
   530     "[| f: inj(succ(m), A) |] ==> restrict(f,m) : inj(m, A-{f`m})";
   530     "[| f: inj(succ(m), A) |] ==> restrict(f,m) : inj(m, A-{f`m})";
   531 by (rtac (major RS restrict_bij RS bij_is_inj RS inj_weaken_type) 1);
   531 by (rtac (major RS restrict_bij RS bij_is_inj RS inj_weaken_type) 1);
   532 by (Blast_tac 1);
   532 by (Blast_tac 1);
   533 by (cut_facts_tac [major] 1);
   533 by (cut_facts_tac [major] 1);
   534 by (rewtac inj_def);
   534 by (rewtac inj_def);
   535 by (fast_tac (!claset addEs [range_type, mem_irrefl] 
   535 by (fast_tac (claset() addEs [range_type, mem_irrefl] 
   536 	              addDs [apply_equality]) 1);
   536 	              addDs [apply_equality]) 1);
   537 qed "inj_succ_restrict";
   537 qed "inj_succ_restrict";
   538 
   538 
   539 goalw Perm.thy [inj_def]
   539 goalw Perm.thy [inj_def]
   540     "!!f. [| f: inj(A,B);  a~:A;  b~:B |]  ==> \
   540     "!!f. [| f: inj(A,B);  a~:A;  b~:B |]  ==> \
   541 \         cons(<a,b>,f) : inj(cons(a,A), cons(b,B))";
   541 \         cons(<a,b>,f) : inj(cons(a,A), cons(b,B))";
   542 by (fast_tac (!claset addIs [apply_type]
   542 by (fast_tac (claset() addIs [apply_type]
   543                addss (!simpset addsimps [fun_extend, fun_extend_apply2,
   543                addss (simpset() addsimps [fun_extend, fun_extend_apply2,
   544 						fun_extend_apply1])) 1);
   544 						fun_extend_apply1])) 1);
   545 qed "inj_extend";
   545 qed "inj_extend";
   546 
   546