diff --git a/thys/ROOTS b/thys/ROOTS --- a/thys/ROOTS +++ b/thys/ROOTS @@ -1,666 +1,667 @@ ADS_Functor AI_Planning_Languages_Semantics AODV AVL-Trees AWN Abortable_Linearizable_Modules Abs_Int_ITP2012 Abstract-Hoare-Logics Abstract-Rewriting Abstract_Completeness Abstract_Soundness Actuarial_Mathematics Adaptive_State_Counting Affine_Arithmetic Aggregation_Algebras Akra_Bazzi Algebraic_Numbers Algebraic_VCs Allen_Calculus Amicable_Numbers Amortized_Complexity AnselmGod Applicative_Lifting Approximation_Algorithms Architectural_Design_Patterns Aristotles_Assertoric_Syllogistic Arith_Prog_Rel_Primes ArrowImpossibilityGS Attack_Trees Auto2_HOL Auto2_Imperative_HOL AutoFocus-Stream Automated_Stateful_Protocol_Verification Automatic_Refinement AxiomaticCategoryTheory BDD BD_Security_Compositional BNF_CC BNF_Operations BTree Banach_Steinhaus Belief_Revision Bell_Numbers_Spivey BenOr_Kozen_Reif Berlekamp_Zassenhaus Bernoulli Bertrands_Postulate Bicategory BinarySearchTree Binding_Syntax_Theory Binomial-Heaps Binomial-Queues BirdKMP Blue_Eyes Bondy Boolean_Expression_Checkers Bounded_Deducibility_Security Buchi_Complementation Budan_Fourier Buffons_Needle Buildings BytecodeLogicJmlTypes C2KA_DistributedSystems CAVA_Automata CAVA_LTL_Modelchecker CCS CISC-Kernel CRDT CSP_RefTK CYK CZH_Elementary_Categories CZH_Foundations CZH_Universal_Constructions CakeML CakeML_Codegen Call_Arity Card_Equiv_Relations Card_Multisets Card_Number_Partitions Card_Partitions Cartan_FP Case_Labeling Catalan_Numbers Category Category2 Category3 Cauchy Cayley_Hamilton Certification_Monads Chandy_Lamport Chord_Segments Circus Clean ClockSynchInst Closest_Pair_Points CoCon CoSMeDis CoSMed CofGroups Coinductive Coinductive_Languages Collections Combinatorics_Words Combinatorics_Words_Graph_Lemma Combinatorics_Words_Lyndon Comparison_Sort_Lower_Bound Compiling-Exceptions-Correctly Complete_Non_Orders Completeness Complex_Bounded_Operators Complex_Geometry Complx ComponentDependencies ConcurrentGC ConcurrentIMP Concurrent_Ref_Alg Concurrent_Revisions Conditional_Simplification Conditional_Transfer_Rule Consensus_Refined Constructive_Cryptography Constructive_Cryptography_CM Constructor_Funs Containers CoreC++ Core_DOM Core_SC_DOM Correctness_Algebras Count_Complex_Roots CryptHOL CryptoBasedCompositionalProperties Cubic_Quartic_Equations DFS_Framework DOM_Components DPT-SAT-Solver DataRefinementIBP Datatype_Order_Generator Decl_Sem_Fun_PL Decreasing-Diagrams Decreasing-Diagrams-II Deep_Learning Delta_System_Lemma Density_Compiler Dependent_SIFUM_Refinement Dependent_SIFUM_Type_Systems Depth-First-Search Derangements Deriving Descartes_Sign_Rule Design_Theory Dict_Construction Differential_Dynamic_Logic Differential_Game_Logic Dijkstra_Shortest_Path Diophantine_Eqns_Lin_Hom Dirichlet_L Dirichlet_Series DiscretePricing Discrete_Summation DiskPaxos Dominance_CHK DynamicArchitectures Dynamic_Tables E_Transcendental Echelon_Form EdmondsKarp_Maxflow Efficient-Mergesort Elliptic_Curves_Group_Law Encodability_Process_Calculi Epistemic_Logic Equivalence_Relation_Enumeration Ergodic_Theory Error_Function Euler_MacLaurin Euler_Partition Eval_FO Example-Submission Extended_Finite_State_Machine_Inference Extended_Finite_State_Machines FFT FLP FOL-Fitting FOL_Axiomatic FOL_Harrison FOL_Seq_Calc1 FOL_Seq_Calc2 Factor_Algebraic_Polynomial Factored_Transition_System_Bounding Falling_Factorial_Sum Farkas FeatherweightJava Featherweight_OCL Fermat3_4 FileRefinement FinFun Finger-Trees Finite-Map-Extras Finite_Automata_HF Finitely_Generated_Abelian_Groups First_Order_Terms First_Welfare_Theorem Fishburn_Impossibility Fisher_Yates Flow_Networks Floyd_Warshall Flyspeck-Tame FocusStreamsCaseStudies Forcing Formal_Puiseux_Series Formal_SSA Formula_Derivatives Foundation_of_geometry Fourier FO_Theory_Rewriting Free-Boolean-Algebra Free-Groups Fresh_Identifiers FunWithFunctions FunWithTilings Functional-Automata Functional_Ordered_Resolution_Prover Furstenberg_Topology GPU_Kernel_PL Gabow_SCC GaleStewart_Games Gale_Shapley Game_Based_Crypto Gauss-Jordan-Elim-Fun Gauss_Jordan Gauss_Sums Gaussian_Integers GenClock General-Triangle Generalized_Counting_Sort Generic_Deriving Generic_Join GewirthPGCProof Girth_Chromatic GoedelGod Goedel_HFSet_Semantic Goedel_HFSet_Semanticless Goedel_Incompleteness Goodstein_Lambda GraphMarkingIBP Graph_Saturation Graph_Theory Green Groebner_Bases Groebner_Macaulay Gromov_Hyperbolicity Grothendieck_Schemes Group-Ring-Module HOL-CSP HOLCF-Prelude HRB-Slicing Hahn_Jordan_Decomposition Heard_Of Hello_World HereditarilyFinite Hermite Hermite_Lindemann Hidden_Markov_Models Higher_Order_Terms Hoare_Time Hood_Melville_Queue HotelKeyCards Huffman Hybrid_Logic Hybrid_Multi_Lane_Spatial_Logic Hybrid_Systems_VCs HyperCTL Hyperdual IEEE_Floating_Point IFC_Tracking IMAP-CRDT IMO2019 IMP2 IMP2_Binary_Heap IMP_Compiler IP_Addresses Imperative_Insertion_Sort Impossible_Geometry Incompleteness Incredible_Proof_Machine Inductive_Confidentiality Inductive_Inference InfPathElimination InformationFlowSlicing InformationFlowSlicing_Inter Integration Interpolation_Polynomials_HOL_Algebra Interpreter_Optimizations Interval_Arithmetic_Word32 Intro_Dest_Elim Iptables_Semantics Irrational_Series_Erdos_Straus Irrationality_J_Hancl Irrationals_From_THEBOOK IsaGeoCoq Isabelle_C Isabelle_Marries_Dirac Isabelle_Meta_Model Jacobson_Basic_Algebra Jinja JinjaDCI JinjaThreads JiveDataStoreModel Jordan_Hoelder Jordan_Normal_Form KAD KAT_and_DRA KBPs KD_Tree Key_Agreement_Strong_Adversaries Kleene_Algebra Knights_Tour Knot_Theory Knuth_Bendix_Order Knuth_Morris_Pratt Koenigsberg_Friendship Kruskal Kuratowski_Closure_Complement LLL_Basis_Reduction LLL_Factorization LOFT LTL LTL_Master_Theorem LTL_Normal_Form LTL_to_DRA LTL_to_GBA Lam-ml-Normalization LambdaAuth LambdaMu Lambda_Free_EPO Lambda_Free_KBOs Lambda_Free_RPOs Lambert_W Landau_Symbols Laplace_Transform Latin_Square LatticeProperties Launchbury Laws_of_Large_Numbers Lazy-Lists-II Lazy_Case Lehmer Lifting_Definition_Option Lifting_the_Exponent LightweightJava LinearQuantifierElim Linear_Inequalities Linear_Programming Linear_Recurrences Liouville_Numbers List-Index List-Infinite List_Interleaving List_Inversions List_Update LocalLexing Localization_Ring Locally-Nameless-Sigma Logging_Independent_Anonymity Lowe_Ontological_Argument Lower_Semicontinuous Lp LP_Duality Lucas_Theorem MDP-Algorithms MDP-Rewards MFMC_Countable MFODL_Monitor_Optimized MFOTL_Monitor MSO_Regex_Equivalence Markov_Models Marriage Mason_Stothers Matrices_for_ODEs Matrix Matrix_Tensor Matroids Max-Card-Matching Median_Method Median_Of_Medians_Selection Menger Mereology Mersenne_Primes Metalogic_ProofChecker MiniML MiniSail Minimal_SSA Minkowskis_Theorem Minsky_Machines Modal_Logics_for_NTS Modular_Assembly_Kit_Security Modular_arithmetic_LLL_and_HNF_algorithms Monad_Memo_DP Monad_Normalisation MonoBoolTranAlgebra MonoidalCategory Monomorphic_Monad MuchAdoAboutTwo Multi_Party_Computation Multirelations Myhill-Nerode Name_Carrying_Type_Inference Nash_Williams Nat-Interval-Logic Native_Word Nested_Multisets_Ordinals Network_Security_Policy_Verification Neumann_Morgenstern_Utility No_FTL_observers Nominal2 Noninterference_CSP Noninterference_Concurrent_Composition Noninterference_Generic_Unwinding Noninterference_Inductive_Unwinding Noninterference_Ipurge_Unwinding Noninterference_Sequential_Composition NormByEval Nullstellensatz Octonions OpSets Open_Induction Optics Optimal_BST Orbit_Stabiliser Order_Lattice_Props Ordered_Resolution_Prover Ordinal Ordinal_Partitions Ordinals_and_Cardinals Ordinary_Differential_Equations PAC_Checker PAL PCF PLM POPLmark-deBruijn PSemigroupsConvolution Padic_Ints Pairing_Heap Paraconsistency Parity_Game Partial_Function_MR Partial_Order_Reduction Password_Authentication_Protocol Pell Perfect-Number-Thm Perron_Frobenius Physical_Quantities Pi_Calculus Pi_Transcendental Planarity_Certificates Poincare_Bendixson Poincare_Disc Polynomial_Factorization Polynomial_Interpolation Polynomials Pop_Refinement Posix-Lexing Possibilistic_Noninterference Power_Sum_Polynomials Pratt_Certificate Presburger-Automata Prim_Dijkstra_Simple Prime_Distribution_Elementary Prime_Harmonic_Series Prime_Number_Theorem Priority_Queue_Braun Priority_Search_Trees Probabilistic_Noninterference Probabilistic_Prime_Tests Probabilistic_System_Zoo Probabilistic_Timed_Automata Probabilistic_While Program-Conflict-Analysis Progress_Tracking Projective_Geometry Projective_Measurements Promela Proof_Strategy_Language PropResPI Propositional_Proof_Systems Prpu_Maxflow PseudoHoops Psi_Calculi Ptolemys_Theorem Public_Announcement_Logic QHLProver QR_Decomposition Quantales Quasi_Borel_Spaces Quaternions Quick_Sort_Cost RIPEMD-160-SPARK ROBDD RSAPSS Ramsey-Infinite Random_BSTs Random_Graph_Subgraph_Threshold Randomised_BSTs Randomised_Social_Choice Rank_Nullity_Theorem Real_Impl Real_Power Recursion-Addition Recursion-Theory-I Refine_Imperative_HOL Refine_Monadic RefinementReactive Regex_Equivalence Registers Regression_Test_Selection Regular-Sets Regular_Algebras Regular_Tree_Relations Relation_Algebra Relational-Incorrectness-Logic Relational_Disjoint_Set_Forests Relational_Forests Relational_Method Relational_Minimum_Spanning_Trees Relational_Paths Rep_Fin_Groups Residuated_Lattices Resolution_FOL Rewriting_Z Ribbon_Proofs Robbins-Conjecture Robinson_Arithmetic Root_Balanced_Tree Roth_Arithmetic_Progressions Routing Roy_Floyd_Warshall SATSolverVerification SC_DOM_Components SDS_Impossibility SIFPL SIFUM_Type_Systems SPARCv8 Safe_Distance Safe_OCL Saturation_Framework Saturation_Framework_Extensions Schutz_Spacetime Secondary_Sylow Security_Protocol_Refinement Selection_Heap_Sort SenSocialChoice Separata Separation_Algebra Separation_Logic_Imperative_HOL SequentInvertibility Shadow_DOM Shadow_SC_DOM Shivers-CFA ShortestPath Show Sigma_Commit_Crypto Signature_Groebner Simpl Simple_Firewall Simplex Simplicial_complexes_and_boolean_functions SimplifiedOntologicalArgument Skew_Heap Skip_Lists Slicing Sliding_Window_Algorithm Smith_Normal_Form Smooth_Manifolds Sort_Encodings Source_Coding_Theorem SpecCheck Special_Function_Bounds Splay_Tree Sqrt_Babylonian Stable_Matching Statecharts Stateful_Protocol_Composition_and_Typing Stellar_Quorums Stern_Brocot Stewart_Apollonius Stirling_Formula Stochastic_Matrices Stone_Algebras Stone_Kleene_Relation_Algebras Stone_Relation_Algebras Store_Buffer_Reduction Stream-Fusion Stream_Fusion_Code Strong_Security Sturm_Sequences Sturm_Tarski Stuttering_Equivalence Subresultants Subset_Boolean_Algebras SumSquares Sunflowers SuperCalc Surprise_Paradox Symmetric_Polynomials Syntax_Independent_Logic Szemeredi_Regularity Szpilrajn TESL_Language TLA Tail_Recursive_Functions Tarskis_Geometry Taylor_Models Three_Circles Timed_Automata Topological_Semantics Topology TortoiseHare Transcendence_Series_Hancl_Rucki Transformer_Semantics Transition_Systems_and_Automata Transitive-Closure Transitive-Closure-II +Transitive_Models Treaps Tree-Automata Tree_Decomposition Triangle Trie Twelvefold_Way Tycon Types_Tableaus_and_Goedels_God Types_To_Sets_Extension UPF UPF_Firewall UTP Universal_Hash_Families Universal_Turing_Machine UpDown_Scheme Valuation Van_Emde_Boas_Trees Van_der_Waerden VectorSpace VeriComp Verified-Prover Verified_SAT_Based_AI_Planning VerifyThis2018 VerifyThis2019 Vickrey_Clarke_Groves Virtual_Substitution VolpanoSmith VYDRA_MDL WHATandWHERE_Security WOOT_Strong_Eventual_Consistency WebAssembly Weight_Balanced_Trees Weighted_Path_Order Well_Quasi_Orders Wetzels_Problem Winding_Number_Eval Word_Lib WorkerWrapper X86_Semantics XML Youngs_Inequality ZFC_in_HOL Zeta_3_Irrational Zeta_Function pGCL diff --git a/thys/Transitive_Models/Aleph_Relative.thy b/thys/Transitive_Models/Aleph_Relative.thy new file mode 100644 --- /dev/null +++ b/thys/Transitive_Models/Aleph_Relative.thy @@ -0,0 +1,449 @@ +theory Aleph_Relative + imports + CardinalArith_Relative +begin + +definition + HAleph :: "[i,i] \ i" where + "HAleph(i,r) \ if(\(Ord(i)),i,if(i=0, nat, if(\Limit(i) \ i\0, + csucc(r`( \ i )), + \j\i. r`j)))" + +reldb_add functional "Limit" "Limit" +relationalize "Limit" "is_Limit" external +synthesize "is_Limit" from_definition +arity_theorem for "is_Limit_fm" + +relativize functional "HAleph" "HAleph_rel" +relationalize "HAleph_rel" "is_HAleph" + +synthesize "is_HAleph" from_definition assuming "nonempty" +arity_theorem intermediate for "is_HAleph_fm" + +lemma arity_is_HAleph_fm_aux: + assumes + "i \ nat" "r \ nat" + \ \NOTE: assumptions are \<^bold>\not\ used, but if omitted, next lemma fails!\ + shows + "arity(Replace_fm(8 +\<^sub>\ i, \10 +\<^sub>\ r`0 is 1\, 3)) = 9 +\<^sub>\ i \ pred(pred(11 +\<^sub>\ r))" + using arity_Replace_fm[of "\ (10+\<^sub>\r)`0 is 1\" "8+\<^sub>\i" 3 "(11+\<^sub>\r) \ 1 \ 2"] + ord_simp_union + by (auto simp:arity) + +lemma arity_is_HAleph_fm[arity]: + assumes + "i \ nat" "r \ nat" "l \ nat" + shows + "arity(is_HAleph_fm(i, r, l)) = succ(i) \ succ(l) \ succ(r)" + using assms pred_Un arity_is_HAleph_fm_aux arity_is_HAleph_fm' + by auto + +definition + Aleph' :: "i => i" where + "Aleph'(a) == transrec(a,\i r. HAleph(i,r))" + +relativize functional "Aleph'" "Aleph_rel" +relationalize "Aleph_rel" "is_Aleph" + +txt\The extra assumptions \<^term>\a < length(env)\ and \<^term>\c < length(env)\ + in this schematic goal (and the following results on synthesis that + depend on it) are imposed by @{thm is_transrec_iff_sats}.\ +schematic_goal sats_is_Aleph_fm_auto: + "a \ nat \ c \ nat \ env \ list(A) \ + a < length(env) \ c < length(env) \ 0 \ A \ + is_Aleph(##A, nth(a, env), nth(c, env)) \ A, env \ ?fm(a, c)" + unfolding is_Aleph_def +proof (rule is_transrec_iff_sats, rule_tac [1] is_HAleph_iff_sats) + fix a0 a1 a2 a3 a4 a5 a6 a7 + let ?env' = "Cons(a0, Cons(a1, Cons(a2, Cons(a3, Cons(a4, Cons(a5, Cons(a6, Cons(a7, env))))))))" + show "nth(2, ?env') = a2" + "nth(1, ?env') = a1" + "nth(0, ?env') = a0" + "nth(c, env) = nth(c, env)" + by simp_all +qed simp_all + +synthesize_notc "is_Aleph" from_schematic + +notation is_Aleph_fm (\\\'(_') is _\\) + +lemma is_Aleph_fm_type [TC]: "a \ nat \ c \ nat \ is_Aleph_fm(a, c) \ formula" + unfolding is_Aleph_fm_def by simp + +lemma sats_is_Aleph_fm: + assumes "f\nat" "r\nat" "env \ list(A)" "0\A" "f < length(env)" "r< length(env)" + shows "is_Aleph(##A, nth(f, env), nth(r, env)) \ A, env \ is_Aleph_fm(f,r)" + using assms sats_is_Aleph_fm_auto unfolding is_Aleph_def is_Aleph_fm_def by simp + +lemma is_Aleph_iff_sats [iff_sats]: + assumes + "nth(f, env) = fa" "nth(r, env) = ra" "f < length(env)" "r< length(env)" + "f \ nat" "r \ nat" "env \ list(A)" "0\A" + shows "is_Aleph(##A,fa,ra) \ A, env \ is_Aleph_fm(f,r)" + using assms sats_is_Aleph_fm[of f r env A] by simp + +arity_theorem for "is_Aleph_fm" + +lemma (in M_cardinal_arith_jump) is_Limit_iff: + assumes "M(a)" + shows "is_Limit(M,a) \ Limit(a)" + unfolding is_Limit_def Limit_def using lt_abs transM[OF ltD \M(a)\] assms + by auto + +lemma HAleph_eq_Aleph_recursive: + "Ord(i) \ HAleph(i,r) = (if i = 0 then nat + else if \j. i = succ(j) then csucc(r ` (THE j. i = succ(j))) else \j (\succ(j)) = j" for j + using Ord_Union_succ_eq by simp + moreover from \Ord(i)\ + have "(\j. i = succ(j)) \ \Limit(i) \ i \ 0" + using Ord_cases_disj by auto + ultimately + show ?thesis + unfolding HAleph_def OUnion_def + by auto +qed + +lemma Aleph'_eq_Aleph: "Ord(a) \ Aleph'(a) = Aleph(a)" + unfolding Aleph'_def Aleph_def transrec2_def + using HAleph_eq_Aleph_recursive + by (intro transrec_equal_on_Ord) auto + +reldb_rem functional "Aleph'" +reldb_rem relational "is_Aleph" +reldb_add functional "Aleph" "Aleph_rel" +reldb_add relational "Aleph" "is_Aleph" + +abbreviation + Aleph_r :: "[i,i\o] \ i" (\\\<^bsub>_\<^esub>\<^bsup>_\<^esup>\) where + "Aleph_r(a,M) \ Aleph_rel(M,a)" + +abbreviation + Aleph_r_set :: "[i,i] \ i" (\\\<^bsub>_\<^esub>\<^bsup>_\<^esup>\) where + "Aleph_r_set(a,M) \ Aleph_rel(##M,a)" + +lemma Aleph_rel_def': "Aleph_rel(M,a) \ transrec(a, \i r. HAleph_rel(M, i, r))" + unfolding Aleph_rel_def . + +lemma succ_mem_Limit: "Limit(j) \ i \ j \ succ(i) \ j" + using Limit_has_succ[THEN ltD] ltI Limit_is_Ord by auto + +locale M_pre_aleph = M_eclose + M_cardinal_arith_jump + + assumes + haleph_transrec_replacement: "M(a) \ transrec_replacement(M,is_HAleph(M),a)" + +begin + +lemma aux_ex_Replace_funapply: + assumes "M(a)" "M(f)" + shows "\x[M]. is_Replace(M, a, \j y. f ` j = y, x)" +proof - + have "{f`j . j\a} = {y . j\a , f ` j=y}" + "{y . j\a , f ` j=y} = {y . j\a , y =f ` j}" + by auto + moreover + note assms + moreover from calculation + have "x \ a \ y = f `x \ M(y)" for x y + using transM[OF _ \M(a)\] by auto + moreover from assms + have "M({f`j . j\a})" + using transM[OF _ \M(a)\] RepFun_closed[OF apply_replacement] by simp + ultimately + have 2:"is_Replace(M, a, \j y. y = f ` j, {f`j . j\a})" + using Replace_abs[of _ _ "\j y. y = f ` j",OF \M(a)\,THEN iffD2] + by auto + with \M({f`j . j\a})\ + show ?thesis + using + is_Replace_cong[of _ _ M "\j y. y = f ` j" "\j y. f ` j = y", THEN iffD1,OF _ _ _ 2] + by auto +qed + +lemma is_HAleph_zero: + assumes "M(f)" + shows "is_HAleph(M,0,f,res) \ res = nat" + unfolding is_HAleph_def + using Ord_0 If_abs is_Limit_iff is_csucc_iff assms aux_ex_Replace_funapply + by auto + +lemma is_HAleph_succ: + assumes "M(f)" "M(x)" "Ord(x)" "M(res)" + shows "is_HAleph(M,succ(x),f,res) \ res = csucc_rel(M,f`x)" + unfolding is_HAleph_def + using assms is_Limit_iff is_csucc_iff aux_ex_Replace_funapply If_abs Ord_Union_succ_eq + by simp + +lemma is_HAleph_limit: + assumes "M(f)" "M(x)" "Limit(x)" "M(res)" + shows "is_HAleph(M,x,f,res) \ res = (\{y . i\x ,M(i) \ M(y) \ y = f`i})" +proof - + from assms + have "univalent(M, x, \j y. y = f ` j )" + "(\xa y. xa \ x \ f ` xa = y \ M(y))" + "{y . x \ x, f ` x = y} = {y . i\x ,M(i) \ M(y) \ y = f`i}" + using univalent_triv[of M x "\j .f ` j"] transM[OF _ \M(x)\] + by auto + moreover + from this + have "univalent(M, x, \j y. f ` j = y )" + by (rule_tac univalent_cong[of x x M " \j y. y = f ` j" " \j y. f ` j=y",THEN iffD1], auto) + moreover + from this + have "univalent(M, x, \j y. M(j) \ M(y) \ f ` j = y )" + by auto + ultimately + show ?thesis + unfolding is_HAleph_def + using assms is_Limit_iff Limit_is_Ord zero_not_Limit If_abs is_csucc_iff + Replace_abs apply_replacement + by auto +qed + +lemma is_HAleph_iff: + assumes "M(a)" "M(f)" "M(res)" + shows "is_HAleph(M, a, f, res) \ res = HAleph_rel(M, a, f)" +proof(cases "Ord(a)") + case True + note Ord_cases[OF \Ord(a)\] + then + show ?thesis + proof(cases ) + case 1 + with True assms + show ?thesis + using is_HAleph_zero unfolding HAleph_rel_def + by simp + next + case (2 j) + with True assms + show ?thesis + using is_HAleph_succ Ord_Union_succ_eq + unfolding HAleph_rel_def + by simp + next + case 3 + with assms + show ?thesis + using is_HAleph_limit zero_not_Limit Limit_is_Ord + unfolding HAleph_rel_def + by auto + qed +next + case False + then + have "\Limit(a)" "a\0" "\ x . Ord(x) \ a\succ(x)" + using Limit_is_Ord by auto + with False + show ?thesis + unfolding is_HAleph_def HAleph_rel_def + using assms is_Limit_iff If_abs is_csucc_iff aux_ex_Replace_funapply + by auto +qed + +lemma HAleph_rel_closed [intro,simp]: + assumes "function(f)" "M(a)" "M(f)" + shows "M(HAleph_rel(M,a,f))" + unfolding HAleph_rel_def + using assms apply_replacement + by simp + +lemma Aleph_rel_closed[intro, simp]: + assumes "Ord(a)" "M(a)" + shows "M(Aleph_rel(M,a))" +proof - + have "relation2(M, is_HAleph(M), HAleph_rel(M))" + unfolding relation2_def using is_HAleph_iff assms by simp + moreover + have "\x[M]. \g[M]. function(g) \ M(HAleph_rel(M, x, g))" + using HAleph_rel_closed by simp + moreover + note assms + ultimately + show ?thesis + unfolding Aleph_rel_def + using transrec_closed[of "is_HAleph(M)" a "HAleph_rel(M)"] + haleph_transrec_replacement by simp +qed + +lemma Aleph_rel_zero: "\\<^bsub>0\<^esub>\<^bsup>M\<^esup> = nat" + using def_transrec [OF Aleph_rel_def',of _ 0] + unfolding HAleph_rel_def by simp + +lemma Aleph_rel_succ: "Ord(\) \ M(\) \ \\<^bsub>succ(\)\<^esub>\<^bsup>M\<^esup> = (\\<^bsub>\\<^esub>\<^bsup>M\<^esup>\<^sup>+)\<^bsup>M\<^esup>" + using Ord_Union_succ_eq + by (subst def_transrec [OF Aleph_rel_def']) + (simp add:HAleph_rel_def) + +lemma Aleph_rel_limit: + assumes "Limit(\)" "M(\)" + shows "\\<^bsub>\\<^esub>\<^bsup>M\<^esup> = \{\\<^bsub>j\<^esub>\<^bsup>M\<^esup> . j \ \}" +proof - + note trans=transM[OF _ \M(\)\] + from \M(\)\ + have "\\<^bsub>\\<^esub>\<^bsup>M\<^esup> = HAleph_rel(M, \, \x\\. \\<^bsub>x\<^esub>\<^bsup>M\<^esup>)" + using def_transrec [OF Aleph_rel_def',of M \] by simp + also + have "... = \{a . j \ \, M(a) \ a = \\<^bsub>j\<^esub>\<^bsup>M\<^esup>}" + unfolding HAleph_rel_def + using assms zero_not_Limit Limit_is_Ord trans by auto + also + have "... = \{\\<^bsub>j\<^esub>\<^bsup>M\<^esup> . j \ \}" + using Aleph_rel_closed[OF _ trans] Ord_in_Ord Limit_is_Ord[OF \Limit(\)\] by auto + finally + show ?thesis . +qed + +lemma is_Aleph_iff: + assumes "Ord(a)" "M(a)" "M(res)" + shows "is_Aleph(M, a, res) \ res = \\<^bsub>a\<^esub>\<^bsup>M\<^esup>" +proof - + have "relation2(M, is_HAleph(M), HAleph_rel(M))" + unfolding relation2_def using is_HAleph_iff assms by simp + moreover + have "\x[M]. \g[M]. function(g) \ M(HAleph_rel(M, x, g))" + using HAleph_rel_closed by simp + ultimately + show ?thesis + using assms transrec_abs haleph_transrec_replacement + unfolding is_Aleph_def Aleph_rel_def + by simp +qed + +end \ \\<^locale>\M_pre_aleph\\ + +locale M_aleph = M_pre_aleph + + assumes + aleph_rel_replacement: "strong_replacement(M, \x y. Ord(x) \ y = \\<^bsub>x\<^esub>\<^bsup>M\<^esup>)" +begin + +lemma Aleph_rel_cont: "Limit(l) \ M(l) \ \\<^bsub>l\<^esub>\<^bsup>M\<^esup> = (\i\<^bsub>i\<^esub>\<^bsup>M\<^esup>)" + using Limit_is_Ord Aleph_rel_limit + by (simp add:OUnion_def) + +lemma Ord_Aleph_rel: + assumes "Ord(a)" + shows "M(a) \ Ord(\\<^bsub>a\<^esub>\<^bsup>M\<^esup>)" + using \Ord(a)\ +proof(induct a rule:trans_induct3) + case 0 + show ?case using Aleph_rel_zero by simp +next + case (succ x) + with \Ord(x)\ + have "M(x)" "Ord(\\<^bsub>x\<^esub>\<^bsup>M\<^esup>)" by simp_all + with \Ord(x)\ + have "Ord(csucc_rel(M,\\<^bsub>x\<^esub>\<^bsup>M\<^esup>))" + using Card_rel_is_Ord Card_rel_csucc_rel + by simp + with \Ord(x)\ \M(x)\ + show ?case using Aleph_rel_succ by simp +next + case (limit x) + note trans=transM[OF _ \M(x)\] + from limit + have "\\<^bsub>x\<^esub>\<^bsup>M\<^esup> = (\i\x. \\<^bsub>i\<^esub>\<^bsup>M\<^esup>)" + using Aleph_rel_cont OUnion_def Limit_is_Ord + by auto + with limit + show ?case using Ord_UN trans by auto +qed + +lemma Card_rel_Aleph_rel [simp, intro]: + assumes "Ord(a)" and types: "M(a)" shows "Card\<^bsup>M\<^esup>(\\<^bsub>a\<^esub>\<^bsup>M\<^esup>)" + using assms +proof (induct rule:trans_induct3) + case 0 + then + show ?case + using Aleph_rel_zero Card_rel_nat by simp +next + case (succ x) + then + show ?case + using Card_rel_csucc_rel Ord_Aleph_rel Aleph_rel_succ + by simp +next + case (limit x) + moreover + from this + have "M({y . z \ x, M(y) \ M(z) \ Ord(z) \ y = \\<^bsub>z\<^esub>\<^bsup>M\<^esup>})" + using aleph_rel_replacement + by auto + moreover + have "{y . z \ x, M(y) \ M(z) \ y = \\<^bsub>z\<^esub>\<^bsup>M\<^esup>} = {y . z \ x, M(y) \ M(z) \ Ord(z) \ y = \\<^bsub>z\<^esub>\<^bsup>M\<^esup>}" + using Ord_in_Ord Limit_is_Ord[OF limit(1)] by simp + ultimately + show ?case + using Ord_Aleph_rel Card_nat Limit_is_Ord Card_relI + by (subst def_transrec [OF Aleph_rel_def']) + (auto simp add:HAleph_rel_def) +qed + +lemma Aleph_rel_increasing: + assumes "a < b" and types: "M(a)" "M(b)" + shows "\\<^bsub>a\<^esub>\<^bsup>M\<^esup> < \\<^bsub>b\<^esub>\<^bsup>M\<^esup>" +proof - + { fix x + from assms + have "Ord(b)" + by (blast intro: lt_Ord2) + moreover + assume "M(x)" + moreover + note \M(b)\ + ultimately + have "x < b \ \\<^bsub>x\<^esub>\<^bsup>M\<^esup> < \\<^bsub>b\<^esub>\<^bsup>M\<^esup>" + proof (induct b arbitrary: x rule: trans_induct3) + case 0 thus ?case by simp + next + case (succ b) + then + show ?case + using Card_rel_csucc_rel Ord_Aleph_rel Ord_Union_succ_eq lt_csucc_rel + lt_trans[of _ "\\<^bsub>b\<^esub>\<^bsup>M\<^esup>" "csucc\<^bsup>M\<^esup>(\\<^bsub>b\<^esub>\<^bsup>M\<^esup>)"] + by (subst (2) def_transrec[OF Aleph_rel_def']) + (auto simp add: le_iff HAleph_rel_def) + next + case (limit l) + then + have sc: "succ(x) < l" + by (blast intro: Limit_has_succ) + then + have "\\<^bsub>x\<^esub>\<^bsup>M\<^esup> < (\j\<^bsub>j\<^esub>\<^bsup>M\<^esup>)" + using limit Ord_Aleph_rel Ord_OUN + proof(rule_tac OUN_upper_lt,blast intro: Card_rel_is_Ord ltD lt_Ord) + from \x \Limit(l)\ + have "Ord(x)" + using Limit_is_Ord Ord_in_Ord + by (auto dest!:ltD) + with \M(x)\ + show "\\<^bsub>x\<^esub>\<^bsup>M\<^esup> < \\<^bsub>succ(x)\<^esub>\<^bsup>M\<^esup>" + using Card_rel_csucc_rel Ord_Aleph_rel lt_csucc_rel + ltD[THEN [2] Ord_in_Ord] succ_in_MI[OF \M(x)\] + Aleph_rel_succ[of x] + by (simp) + next + from \M(l)\ \Limit(l)\ + show "Ord(\j\<^bsub>j\<^esub>\<^bsup>M\<^esup>)" + using Ord_Aleph_rel lt_Ord Limit_is_Ord Ord_in_Ord + by (rule_tac Ord_OUN) + (auto dest:transM ltD intro!:Ord_Aleph_rel) + qed + then + show ?case using limit Aleph_rel_cont by simp + qed + } + with types assms + show ?thesis by simp +qed + +lemmas nat_subset_Aleph_rel_1 = + Ord_lt_subset[OF Ord_Aleph_rel[of 1] Aleph_rel_increasing[of 0 1,simplified],simplified] + +end \ \\<^locale>\M_aleph\\ + +end \ No newline at end of file diff --git a/thys/Transitive_Models/Arities.thy b/thys/Transitive_Models/Arities.thy new file mode 100644 --- /dev/null +++ b/thys/Transitive_Models/Arities.thy @@ -0,0 +1,254 @@ +section\Arities of internalized formulas\ +theory Arities + imports + Discipline_Base +begin + +lemmas FOL_arities [simp del, arity] = arity_And arity_Or arity_Implies arity_Iff arity_Exists + +declare pred_Un_distrib[arity_aux] + +context + notes FOL_arities[simp] +begin + +lemma arity_upair_fm [arity] : "\ t1\nat ; t2\nat ; up\nat \ \ + arity(upair_fm(t1,t2,up)) = \ {succ(t1),succ(t2),succ(up)}" + unfolding upair_fm_def + using union_abs1 union_abs2 pred_Un + by auto + +end + +lemma Un_trasposition_aux1: "r \ s \ r = r \ s" by auto + +lemma Un_trasposition_aux2: + "r \ (s \ (r \ u))= r \ (s \ u)" + "r \ (s \ (t \ (r \ u)))= r \ (s \ (t \ u))" by auto + +txt\Using the previous lemmas to guide the automatic arity calculation.\ + +context + notes Un_assoc[symmetric,simp] Un_trasposition_aux1[simp] +begin + +arity_theorem for "pair_fm" +arity_theorem for "composition_fm" +arity_theorem for "domain_fm" +arity_theorem for "range_fm" +arity_theorem for "union_fm" +arity_theorem for "image_fm" +arity_theorem for "pre_image_fm" +arity_theorem for "big_union_fm" +arity_theorem for "fun_apply_fm" +arity_theorem for "field_fm" +arity_theorem for "empty_fm" +arity_theorem for "cons_fm" +arity_theorem for "succ_fm" +arity_theorem for "number1_fm" +arity_theorem for "function_fm" +arity_theorem for "relation_fm" +arity_theorem for "restriction_fm" +arity_theorem for "typed_function_fm" +arity_theorem for "subset_fm" +arity_theorem for "transset_fm" +arity_theorem for "ordinal_fm" +arity_theorem for "limit_ordinal_fm" +arity_theorem for "finite_ordinal_fm" +arity_theorem for "omega_fm" +arity_theorem for "cartprod_fm" +arity_theorem for "singleton_fm" +arity_theorem for "Memrel_fm" +arity_theorem for "quasinat_fm" + +end \ \context\ + +context + notes FOL_arities[simp] +begin + +lemma arity_is_recfun_fm [arity]: + "\p\formula ; v\nat ; n\nat; Z\nat;i\nat\ \ arity(p) = i \ + arity(is_recfun_fm(p,v,n,Z)) = succ(v) \ succ(n) \ succ(Z) \ pred(pred(pred(pred(i))))" + unfolding is_recfun_fm_def + using arity_upair_fm arity_pair_fm arity_pre_image_fm arity_restriction_fm + union_abs2 pred_Un_distrib + by auto + +lemma arity_is_wfrec_fm [arity]: + "\p\formula ; v\nat ; n\nat; Z\nat ; i\nat\ \ arity(p) = i \ + arity(is_wfrec_fm(p,v,n,Z)) = succ(v) \ succ(n) \ succ(Z) \ pred(pred(pred(pred(pred(i)))))" + unfolding is_wfrec_fm_def + using arity_succ_fm arity_is_recfun_fm + union_abs2 pred_Un_distrib + by auto + +lemma arity_is_nat_case_fm [arity]: + "\p\formula ; v\nat ; n\nat; Z\nat; i\nat\ \ arity(p) = i \ + arity(is_nat_case_fm(v,p,n,Z)) = succ(v) \ succ(n) \ succ(Z) \ pred(pred(i))" + unfolding is_nat_case_fm_def + using arity_succ_fm arity_empty_fm arity_quasinat_fm + union_abs2 pred_Un_distrib + by auto + +lemma arity_iterates_MH_fm [arity]: + assumes "isF\formula" "v\nat" "n\nat" "g\nat" "z\nat" "i\nat" + "arity(isF) = i" + shows "arity(iterates_MH_fm(isF,v,n,g,z)) = + succ(v) \ succ(n) \ succ(g) \ succ(z) \ pred(pred(pred(pred(i))))" +proof - + let ?\ = "Exists(And(fun_apply_fm(succ(succ(succ(g))), 2, 0), Forall(Implies(Equal(0, 2), isF))))" + let ?ar = "succ(succ(succ(g))) \ pred(pred(i))" + from assms + have "arity(?\) =?ar" "?\\formula" + using arity_fun_apply_fm + union_abs1 union_abs2 pred_Un_distrib succ_Un_distrib Un_assoc[symmetric] + by simp_all + then + show ?thesis + unfolding iterates_MH_fm_def + using arity_is_nat_case_fm[OF \?\\_\ _ _ _ _ \arity(?\) = ?ar\] assms pred_succ_eq pred_Un_distrib + by auto +qed + +lemma arity_is_iterates_fm [arity]: + assumes "p\formula" "v\nat" "n\nat" "Z\nat" "i\nat" + "arity(p) = i" + shows "arity(is_iterates_fm(p,v,n,Z)) = succ(v) \ succ(n) \ succ(Z) \ + pred(pred(pred(pred(pred(pred(pred(pred(pred(pred(pred(i)))))))))))" +proof - + let ?\ = "iterates_MH_fm(p, 7+\<^sub>\v, 2, 1, 0)" + let ?\ = "is_wfrec_fm(?\, 0, succ(succ(n)),succ(succ(Z)))" + from \v\_\ + have "arity(?\) = (8+\<^sub>\v) \ pred(pred(pred(pred(i))))" "?\\formula" + using assms arity_iterates_MH_fm union_abs2 + by simp_all + then + have "arity(?\) = succ(succ(succ(n))) \ succ(succ(succ(Z))) \ (3+\<^sub>\v) \ + pred(pred(pred(pred(pred(pred(pred(pred(pred(i)))))))))" + using assms arity_is_wfrec_fm[OF \?\\_\ _ _ _ _ \arity(?\) = _\] union_abs1 pred_Un_distrib + by auto + then + show ?thesis + unfolding is_iterates_fm_def + using arity_Memrel_fm arity_succ_fm assms union_abs1 pred_Un_distrib + by auto +qed + +lemma arity_eclose_n_fm [arity]: + assumes "A\nat" "x\nat" "t\nat" + shows "arity(eclose_n_fm(A,x,t)) = succ(A) \ succ(x) \ succ(t)" +proof - + let ?\ = "big_union_fm(1,0)" + have "arity(?\) = 2" "?\\formula" + using arity_big_union_fm union_abs2 + by auto + with assms + show ?thesis + unfolding eclose_n_fm_def + using arity_is_iterates_fm[OF \?\\_\ _ _ _,of _ _ _ 2] + by auto +qed + +lemma arity_mem_eclose_fm [arity]: + assumes "x\nat" "t\nat" + shows "arity(mem_eclose_fm(x,t)) = succ(x) \ succ(t)" +proof - + let ?\="eclose_n_fm(x +\<^sub>\ 2, 1, 0)" + from \x\nat\ + have "arity(?\) = x+\<^sub>\3" + using arity_eclose_n_fm union_abs2 + by simp + with assms + show ?thesis + unfolding mem_eclose_fm_def + using arity_finite_ordinal_fm union_abs2 pred_Un_distrib + by simp +qed + +lemma arity_is_eclose_fm [arity]: + "\x\nat ; t\nat\ \ arity(is_eclose_fm(x,t)) = succ(x) \ succ(t)" + unfolding is_eclose_fm_def + using arity_mem_eclose_fm union_abs2 pred_Un_distrib + by auto + +lemma arity_Collect_fm [arity]: + assumes "x \ nat" "y \ nat" "p\formula" + shows "arity(Collect_fm(x,p,y)) = succ(x) \ succ(y) \ pred(arity(p))" + unfolding Collect_fm_def + using assms pred_Un_distrib + by auto + +schematic_goal arity_least_fm': + assumes + "i \ nat" "q \ formula" + shows + "arity(least_fm(q,i)) \ ?ar" + unfolding least_fm_def + using assms pred_Un_distrib arity_And arity_Or arity_Neg arity_Implies arity_ordinal_fm + arity_empty_fm Un_assoc[symmetric] Un_commute + by auto + +lemma arity_least_fm [arity]: + assumes + "i \ nat" "q \ formula" + shows + "arity(least_fm(q,i)) = succ(i) \ pred(arity(q))" + using assms arity_least_fm' + by auto + +lemma arity_Replace_fm [arity]: + "\p\formula ; v\nat ; n\nat; i\nat\ \ arity(p) = i \ + arity(Replace_fm(v,p,n)) = succ(n) \ succ(v) \ pred(pred(i))" + unfolding Replace_fm_def + using union_abs2 pred_Un_distrib + by auto + +lemma arity_lambda_fm [arity]: + "\p\formula; v\nat ; n\nat; i\nat\ \ arity(p) = i \ + arity(lambda_fm(p,v,n)) = succ(n) \ (succ(v) \ (pred^3(i)))" + unfolding lambda_fm_def + using arity_pair_fm pred_Un_distrib union_abs1 union_abs2 + by simp + +lemma arity_transrec_fm [arity]: + "\p\formula ; v\nat ; n\nat; i\nat\ \ arity(p) = i \ + arity(is_transrec_fm(p,v,n)) = succ(v) \ succ(n) \ (pred^8(i))" + unfolding is_transrec_fm_def + using arity Un_assoc[symmetric] pred_Un_distrib + by simp + +lemma arity_wfrec_replacement_fm : + "\p\formula ; v\nat ; n\nat; Z\nat ; i\nat\ \ arity(p) = i \ + arity(Exists(And(pair_fm(1,0,2),is_wfrec_fm(p,v,n,Z)))) + = 2 \ v \ n \ Z \ (pred^6(i))" + unfolding is_wfrec_fm_def + using arity_succ_fm arity_is_recfun_fm union_abs2 pred_Un_distrib arity_pair_fm + by auto + +end \ \@{thm [source] FOL_arities}\ + +declare arity_subset_fm [simp del] arity_ordinal_fm[simp del, arity] arity_transset_fm[simp del] + +context + notes Un_assoc[symmetric,simp] Un_trasposition_aux1[simp] +begin +arity_theorem for "rtran_closure_mem_fm" +arity_theorem for "rtran_closure_fm" +arity_theorem for "tran_closure_fm" +end + +context + notes Un_assoc[simp] Un_trasposition_aux2[simp] +begin +arity_theorem for "injection_fm" +arity_theorem for "surjection_fm" +arity_theorem for "bijection_fm" +arity_theorem for "order_isomorphism_fm" +end + +arity_theorem for "Inl_fm" +arity_theorem for "Inr_fm" +arity_theorem for "pred_set_fm" + +end \ No newline at end of file diff --git a/thys/Transitive_Models/CardinalArith_Relative.thy b/thys/Transitive_Models/CardinalArith_Relative.thy new file mode 100644 --- /dev/null +++ b/thys/Transitive_Models/CardinalArith_Relative.thy @@ -0,0 +1,1648 @@ +section\Relative, Choice-less Cardinal Arithmetic\ + +theory CardinalArith_Relative + imports + Cardinal_Relative + +begin + + +(* rvimage(?A, ?f, ?r) \ {z \ ?A \ ?A . \x y. z = \x, y\ \ \?f ` x, ?f ` y\ \ ?r} *) +relativize functional "rvimage" "rvimage_rel" external +relationalize "rvimage_rel" "is_rvimage" + +definition + csquare_lam :: "i\i" where + "csquare_lam(K) \ \\x,y\\K\K. \x \ y, x, y\" + +\ \Can't do the next thing because split is a missing HOC\ +(* relativize functional "csquare_lam" "csquare_lam_rel" *) +relativize_tm " snd(x), fst(x), snd(x)>" "is_csquare_lam_body" + +definition + is_csquare_lam :: "[i\o,i,i]\o" where + "is_csquare_lam(M,K,l) \ \K2[M]. cartprod(M,K,K,K2) \ + is_lambda(M,K2,is_csquare_lam_body(M),l)" + +definition jump_cardinal_body :: "[i\o,i] \ i" where + "jump_cardinal_body(M,X) \ + {z . r \ Pow\<^bsup>M\<^esup>(X \ X), M(z) \ M(r) \ well_ord(X, r) \ z = ordertype(X, r)} " + +lemma (in M_cardinals) csquare_lam_closed[intro,simp]: "M(K) \ M(csquare_lam(K))" + using csquare_lam_replacement unfolding csquare_lam_def + by (rule lam_closed) (auto dest:transM) + +locale M_pre_cardinal_arith = M_cardinals + + assumes + wfrec_pred_replacement:"M(A) \ M(r) \ + wfrec_replacement(M, \x f z. z = f `` Order.pred(A, x, r), r)" +begin + +lemma ord_iso_separation: "M(A) \ M(r) \ M(s) \ + separation(M, \f. \x\A. \y\A. \x, y\ \ r \ \f ` x, f ` y\ \ s)" + using + lam_replacement_Pair[THEN[5] lam_replacement_hcomp2] + lam_replacement_hcomp lam_replacement_fst lam_replacement_snd + separation_in lam_replacement_fst lam_replacement_apply2[THEN[5] lam_replacement_hcomp2] + lam_replacement_identity lam_replacement_constant + by(rule_tac separation_ball,rule_tac separation_ball,simp_all,rule_tac separation_iff',simp_all) + +end + +locale M_cardinal_arith = M_pre_cardinal_arith + + assumes + ordertype_replacement : + "M(X) \ strong_replacement(M,\ x z . M(z) \ M(x) \ x\Pow_rel(M,X\X) \ well_ord(X, x) \ z=ordertype(X,x))" + and + strong_replacement_jc_body : + "strong_replacement(M,\ x z . M(z) \ M(x) \ z = jump_cardinal_body(M,x))" + +lemmas (in M_cardinal_arith) surj_imp_inj_replacement = + surj_imp_inj_replacement1 surj_imp_inj_replacement2 surj_imp_inj_replacement4 + lam_replacement_vimage_sing_fun[THEN lam_replacement_imp_strong_replacement] + +relativize_tm "\x' y' x y. z = \\x', y'\, x, y\ \ (\x', x\ \ r \ x' = x \ \y', y\ \ s)" + "is_rmultP" + +relativize functional "rmult" "rmult_rel" external +relationalize "rmult_rel" "is_rmult" + +lemma (in M_trivial) rmultP_abs [absolut]: "\ M(r); M(s); M(z) \ \ is_rmultP(M,s,r,z) \ + (\x' y' x y. z = \\x', y'\, x, y\ \ (\x', x\ \ r \ x' = x \ \y', y\ \ s))" + unfolding is_rmultP_def by (auto dest:transM) + +definition + is_csquare_rel :: "[i\o,i,i]\o" where + "is_csquare_rel(M,K,cs) \ \K2[M]. \la[M]. \memK[M]. + \rmKK[M]. \rmKK2[M]. + cartprod(M,K,K,K2) \ is_csquare_lam(M,K,la) \ + membership(M,K,memK) \ is_rmult(M,K,memK,K,memK,rmKK) \ + is_rmult(M,K,memK,K2,rmKK,rmKK2) \ is_rvimage(M,K2,la,rmKK2,cs)" + +context M_basic +begin + +lemma rvimage_abs[absolut]: + assumes "M(A)" "M(f)" "M(r)" "M(z)" + shows "is_rvimage(M,A,f,r,z) \ z = rvimage(A,f,r)" + using assms transM[OF _ \M(A)\] + unfolding is_rvimage_def rvimage_def + by auto + +lemma rmult_abs [absolut]: "\ M(A); M(r); M(B); M(s); M(z) \ \ + is_rmult(M,A,r,B,s,z) \ z=rmult(A,r,B,s)" + using rmultP_abs transM[of _ "(A \ B) \ A \ B"] + unfolding is_rmultP_def is_rmult_def rmult_def + by (auto del: iffI) + +lemma csquare_lam_body_abs[absolut]: "M(x) \ M(z) \ + is_csquare_lam_body(M,x,z) \ z = snd(x), fst(x), snd(x)>" + unfolding is_csquare_lam_body_def by (simp add:absolut) + +lemma csquare_lam_abs[absolut]: "M(K) \ M(l) \ + is_csquare_lam(M,K,l) \ l = (\x\K\K. \fst(x) \ snd(x), fst(x), snd(x)\)" + unfolding is_csquare_lam_def + using lambda_abs2[of "K\K" "is_csquare_lam_body(M)" + "\x. \fst(x) \ snd(x), fst(x), snd(x)\"] + unfolding Relation1_def by (simp add:absolut) + +lemma csquare_lam_eq_lam:"csquare_lam(K) = (\z\K\K. snd(z), fst(z), snd(z)>)" +proof - + have "(\\x,y\\K \ K. \x \ y, x, y\)`z = + (\z\K\K. snd(z), fst(z), snd(z)>)`z" if "z\K\K" for z + using that by auto + then + show ?thesis + unfolding csquare_lam_def + by simp +qed + +end \ \\<^locale>\M_basic\\ + +context M_pre_cardinal_arith +begin + +lemma csquare_rel_closed[intro,simp]: "M(K) \ M(csquare_rel(K))" + using csquare_lam_replacement unfolding csquare_rel_def + by (intro rvimage_closed lam_closed) (auto dest:transM) + +(* Ugly proof ahead, please enhance *) +lemma csquare_rel_abs[absolut]: "\ M(K); M(cs)\ \ + is_csquare_rel(M,K,cs) \ cs = csquare_rel(K)" + unfolding is_csquare_rel_def csquare_rel_def + using csquare_lam_closed[unfolded csquare_lam_eq_lam] + by (simp add:absolut csquare_lam_eq_lam[unfolded csquare_lam_def]) + +end \ \\<^locale>\M_pre_cardinal_arith\\ + +(************* Discipline for csucc ****************) +relativize functional "csucc" "csucc_rel" external +relationalize "csucc_rel" "is_csucc" +synthesize "is_csucc" from_definition assuming "nonempty" +arity_theorem for "is_csucc_fm" + +abbreviation + csucc_r :: "[i,i\o] \ i" (\'(_\<^sup>+')\<^bsup>_\<^esup>\) where + "csucc_r(x,M) \ csucc_rel(M,x)" + +abbreviation + csucc_r_set :: "[i,i] \ i" (\'(_\<^sup>+')\<^bsup>_\<^esup>\) where + "csucc_r_set(x,M) \ csucc_rel(##M,x)" + +context M_Perm +begin + +rel_closed for "csucc" + using Least_closed'[of "\ L. M(L) \ Card\<^bsup>M\<^esup>(L) \ K < L"] + unfolding csucc_rel_def + by simp + +is_iff_rel for "csucc" + using least_abs'[of "\ L. M(L) \ Card\<^bsup>M\<^esup>(L) \ K < L" res] + is_Card_iff + unfolding is_csucc_def csucc_rel_def + by (simp add:absolut) + +end \ \\<^locale>\M_Perm\\ + +notation csucc_rel (\csucc\<^bsup>_\<^esup>'(_')\) + +(*************** end Discipline *********************) + +context M_cardinals +begin + +lemma Card_rel_Union [simp,intro,TC]: + assumes A: "\x. x\A \ Card\<^bsup>M\<^esup>(x)" and + types:"M(A)" + shows "Card\<^bsup>M\<^esup>(\(A))" +proof (rule Card_relI) + show "Ord(\A)" using A + by (simp add: Card_rel_is_Ord types transM) +next + fix j + assume j: "j < \A" + moreover from this + have "M(j)" unfolding lt_def by (auto simp add:types dest:transM) + from j + have "\c\A. j \ c \ Card\<^bsup>M\<^esup>(c)" using A types + unfolding lt_def + by (simp) + then + obtain c where c: "c\A" "j < c" "Card\<^bsup>M\<^esup>(c)" "M(c)" + using Card_rel_is_Ord types unfolding lt_def + by (auto dest:transM) + with \M(j)\ + have jls: "j \\<^bsup>M\<^esup> c" + by (simp add: lt_Card_rel_imp_lesspoll_rel types) + { assume eqp: "j \\<^bsup>M\<^esup> \A" + have "c \\<^bsup>M\<^esup> \A" using c + by (blast intro: subset_imp_lepoll_rel types) + also from types \M(j)\ + have "... \\<^bsup>M\<^esup> j" by (rule_tac eqpoll_rel_sym [OF eqp]) (simp_all add:types) + also have "... \\<^bsup>M\<^esup> c" by (rule jls) + finally have "c \\<^bsup>M\<^esup> c" by (simp_all add:\M(c)\ \M(j)\ types) + with \M(c)\ + have False + by (auto dest:lesspoll_rel_irrefl) + } thus "\ j \\<^bsup>M\<^esup> \A" by blast +qed (simp_all add:types) + +(* +lemma Card_UN: "(!!x. x \ A ==> Card(K(x))) ==> Card(\x\A. K(x))" + by blast + + +lemma Card_OUN [simp,intro,TC]: + "(!!x. x \ A ==> Card(K(x))) ==> Card(\xM\<^esup>(K); b \ K; M(K); M(b) |] ==> b \\<^bsup>M\<^esup> K" + apply (unfold lesspoll_rel_def) + apply (simp add: Card_rel_iff_initial) + apply (fast intro!: le_imp_lepoll_rel ltI leI) + done + + +subsection\Cardinal addition\ + +text\Note (Paulson): Could omit proving the algebraic laws for cardinal addition and +multiplication. On finite cardinals these operations coincide with +addition and multiplication of natural numbers; on infinite cardinals they +coincide with union (maximum). Either way we get most laws for free.\ + +subsubsection\Cardinal addition is commutative\ + +lemma sum_commute_eqpoll_rel: "M(A) \ M(B) \ A+B \\<^bsup>M\<^esup> B+A" +proof (simp add: def_eqpoll_rel, rule rexI) + show "(\z\A+B. case(Inr,Inl,z)) \ bij(A+B, B+A)" + by (auto intro: lam_bijective [where d = "case(Inr,Inl)"]) + assume "M(A)" "M(B)" + then + show "M(\z\A + B. case(Inr, Inl, z))" + using case_replacement1 + by (rule_tac lam_closed) (auto dest:transM) +qed + +lemma cadd_rel_commute: "M(i) \ M(j) \ i \\<^bsup>M\<^esup> j = j \\<^bsup>M\<^esup> i" + apply (unfold cadd_rel_def) + apply (auto intro: sum_commute_eqpoll_rel [THEN cardinal_rel_cong]) + done + +subsubsection\Cardinal addition is associative\ + +lemma sum_assoc_eqpoll_rel: "M(A) \ M(B) \ M(C) \ (A+B)+C \\<^bsup>M\<^esup> A+(B+C)" + apply (simp add: def_eqpoll_rel) + apply (rule rexI) + apply (rule sum_assoc_bij) + using case_replacement2 + by (rule_tac lam_closed) (auto dest:transM) + +text\Unconditional version requires AC\ +lemma well_ord_cadd_rel_assoc: + assumes i: "well_ord(i,ri)" and j: "well_ord(j,rj)" and k: "well_ord(k,rk)" + and + types: "M(i)" "M(ri)" "M(j)" "M(rj)" "M(k)" "M(rk)" + shows "(i \\<^bsup>M\<^esup> j) \\<^bsup>M\<^esup> k = i \\<^bsup>M\<^esup> (j \\<^bsup>M\<^esup> k)" +proof (simp add: assms cadd_rel_def, rule cardinal_rel_cong) + from types + have "|i + j|\<^bsup>M\<^esup> + k \\<^bsup>M\<^esup> (i + j) + k" + by (auto intro!: sum_eqpoll_rel_cong well_ord_cardinal_rel_eqpoll_rel eqpoll_rel_refl well_ord_radd i j) + also have "... \\<^bsup>M\<^esup> i + (j + k)" + by (rule sum_assoc_eqpoll_rel) (simp_all add:types) + also + have "... \\<^bsup>M\<^esup> i + |j + k|\<^bsup>M\<^esup>" + proof (auto intro!: sum_eqpoll_rel_cong intro:eqpoll_rel_refl simp add:types) + from types + have "|j + k|\<^bsup>M\<^esup> \\<^bsup>M\<^esup> j + k" + using well_ord_cardinal_rel_eqpoll_rel[OF well_ord_radd, OF j k] + by (simp) + with types + show "j + k \\<^bsup>M\<^esup> |j + k|\<^bsup>M\<^esup>" + using eqpoll_rel_sym by simp + qed + finally show "|i + j|\<^bsup>M\<^esup> + k \\<^bsup>M\<^esup> i + |j + k|\<^bsup>M\<^esup>" by (simp_all add:types) +qed (simp_all add:types) + + +subsubsection\0 is the identity for addition\ + +lemma case_id_eq: "x\sum(A,B) \ case(\z . z, \z. z ,x) = snd(x)" + unfolding case_def cond_def by (auto simp:Inl_def Inr_def) + +lemma lam_case_id: "(\z\0 + A. case(\x. x, \y. y, z)) = (\z\0 + A . snd(z))" + using case_id_eq by simp + +lemma sum_0_eqpoll_rel: "M(A) \ 0+A \\<^bsup>M\<^esup> A" + apply (simp add:def_eqpoll_rel) + apply (rule rexI) + apply (rule bij_0_sum,subst lam_case_id) + using lam_replacement_snd[unfolded lam_replacement_def] + by (rule lam_closed) + (auto simp add:case_def cond_def Inr_def dest:transM) + +lemma cadd_rel_0 [simp]: "Card\<^bsup>M\<^esup>(K) \ M(K) \ 0 \\<^bsup>M\<^esup> K = K" + apply (simp add: cadd_rel_def) + apply (simp add: sum_0_eqpoll_rel [THEN cardinal_rel_cong] Card_rel_cardinal_rel_eq) + done + +subsubsection\Addition by another cardinal\ + +lemma sum_lepoll_rel_self: "M(A) \ M(B) \ A \\<^bsup>M\<^esup> A+B" +proof (simp add: def_lepoll_rel, rule rexI) + show "(\x\A. Inl (x)) \ inj(A, A + B)" + by (simp add: inj_def) + assume "M(A)" "M(B)" + then + show "M(\x\A. Inl(x))" + using Inl_replacement1 transM[OF _ \M(A)\] + by (rule_tac lam_closed) (auto simp add: Inl_def) +qed + +(*Could probably weaken the premises to well_ord(K,r), or removing using AC*) + +lemma cadd_rel_le_self: + assumes K: "Card\<^bsup>M\<^esup>(K)" and L: "Ord(L)" and + types:"M(K)" "M(L)" + shows "K \ (K \\<^bsup>M\<^esup> L)" +proof (simp add:types cadd_rel_def) + have "K \ |K|\<^bsup>M\<^esup>" + by (rule Card_rel_cardinal_rel_le [OF K]) (simp add:types) + moreover have "|K|\<^bsup>M\<^esup> \ |K + L|\<^bsup>M\<^esup>" using K L + by (blast intro: well_ord_lepoll_rel_imp_cardinal_rel_le sum_lepoll_rel_self + well_ord_radd well_ord_Memrel Card_rel_is_Ord types) + ultimately show "K \ |K + L|\<^bsup>M\<^esup>" + by (blast intro: le_trans) +qed + +subsubsection\Monotonicity of addition\ + +lemma sum_lepoll_rel_mono: + "[| A \\<^bsup>M\<^esup> C; B \\<^bsup>M\<^esup> D; M(A); M(B); M(C); M(D) |] ==> A + B \\<^bsup>M\<^esup> C + D" + apply (simp add: def_lepoll_rel) + apply (elim rexE) + apply (rule_tac x = "\z\A+B. case (%w. Inl(f`w), %y. Inr(fa`y), z)" in rexI) + apply (rule_tac d = "case (%w. Inl(converse(f) `w), %y. Inr(converse(fa) ` y))" + in lam_injective) + apply (typecheck add: inj_is_fun, auto) + apply (rule_tac lam_closed, auto dest:transM intro:case_replacement4) + done + +lemma cadd_rel_le_mono: + "[| K' \ K; L' \ L;M(K');M(K);M(L');M(L) |] ==> (K' \\<^bsup>M\<^esup> L') \ (K \\<^bsup>M\<^esup> L)" + apply (unfold cadd_rel_def) + apply (safe dest!: le_subset_iff [THEN iffD1]) + apply (rule well_ord_lepoll_rel_imp_cardinal_rel_le) + apply (blast intro: well_ord_radd well_ord_Memrel) + apply (auto intro: sum_lepoll_rel_mono subset_imp_lepoll_rel) + done + +subsubsection\Addition of finite cardinals is "ordinary" addition\ + +lemma sum_succ_eqpoll_rel: "M(A) \ M(B) \ succ(A)+B \\<^bsup>M\<^esup> succ(A+B)" + apply (simp add:def_eqpoll_rel) + apply (rule rexI) + apply (rule_tac c = "%z. if z=Inl (A) then A+B else z" + and d = "%z. if z=A+B then Inl (A) else z" in lam_bijective) + apply simp_all + apply (blast dest: sym [THEN eq_imp_not_mem] elim: mem_irrefl)+ + apply(rule_tac lam_closed, auto dest:transM intro:if_then_range_replacement2) + done + +(*Pulling the succ(...) outside the |...| requires m, n \ nat *) +(*Unconditional version requires AC*) +lemma cadd_succ_lemma: + assumes "Ord(m)" "Ord(n)" and + types: "M(m)" "M(n)" + shows "succ(m) \\<^bsup>M\<^esup> n = |succ(m \\<^bsup>M\<^esup> n)|\<^bsup>M\<^esup>" + using types +proof (simp add: cadd_rel_def) + have [intro]: "m + n \\<^bsup>M\<^esup> |m + n|\<^bsup>M\<^esup>" using assms + by (blast intro: eqpoll_rel_sym well_ord_cardinal_rel_eqpoll_rel well_ord_radd well_ord_Memrel) + + have "|succ(m) + n|\<^bsup>M\<^esup> = |succ(m + n)|\<^bsup>M\<^esup>" + by (rule sum_succ_eqpoll_rel [THEN cardinal_rel_cong]) (simp_all add:types) + also have "... = |succ(|m + n|\<^bsup>M\<^esup>)|\<^bsup>M\<^esup>" + by (blast intro: succ_eqpoll_rel_cong cardinal_rel_cong types) + finally show "|succ(m) + n|\<^bsup>M\<^esup> = |succ(|m + n|\<^bsup>M\<^esup>)|\<^bsup>M\<^esup>" . +qed + +lemma nat_cadd_rel_eq_add: + assumes m: "m \ nat" and [simp]: "n \ nat" shows"m \\<^bsup>M\<^esup> n = m +\<^sub>\ n" + using m +proof (induct m) + case 0 thus ?case + using transM[OF _ M_nat] + by (auto simp add: nat_into_Card_rel) +next + case (succ m) thus ?case + using transM[OF _ M_nat] + by (simp add: cadd_succ_lemma nat_into_Card_rel Card_rel_cardinal_rel_eq) +qed + + +subsection\Cardinal multiplication\ + +subsubsection\Cardinal multiplication is commutative\ + +lemma prod_commute_eqpoll_rel: "M(A) \ M(B) \ A*B \\<^bsup>M\<^esup> B*A" + apply (simp add: def_eqpoll_rel) + apply (rule rexI) + apply (rule_tac c = "%." and d = "%." in lam_bijective, + auto) + apply(rule_tac lam_closed, auto intro:swap_replacement dest:transM) + done + +lemma cmult_rel_commute: "M(i) \ M(j) \ i \\<^bsup>M\<^esup> j = j \\<^bsup>M\<^esup> i" + apply (unfold cmult_rel_def) + apply (rule prod_commute_eqpoll_rel [THEN cardinal_rel_cong], simp_all) + done + +subsubsection\Cardinal multiplication is associative\ + +lemma prod_assoc_eqpoll_rel: "M(A) \ M(B) \ M(C) \ (A*B)*C \\<^bsup>M\<^esup> A*(B*C)" + apply (simp add: def_eqpoll_rel) + apply (rule rexI) + apply (rule prod_assoc_bij) + apply(rule_tac lam_closed, auto intro:assoc_replacement dest:transM) + done + + +text\Unconditional version requires AC\ +lemma well_ord_cmult_rel_assoc: + assumes i: "well_ord(i,ri)" and j: "well_ord(j,rj)" and k: "well_ord(k,rk)" + and + types: "M(i)" "M(ri)" "M(j)" "M(rj)" "M(k)" "M(rk)" + shows "(i \\<^bsup>M\<^esup> j) \\<^bsup>M\<^esup> k = i \\<^bsup>M\<^esup> (j \\<^bsup>M\<^esup> k)" +proof (simp add: assms cmult_rel_def, rule cardinal_rel_cong) + have "|i * j|\<^bsup>M\<^esup> * k \\<^bsup>M\<^esup> (i * j) * k" + by (auto intro!: prod_eqpoll_rel_cong + well_ord_cardinal_rel_eqpoll_rel eqpoll_rel_refl + well_ord_rmult i j simp add:types) + also have "... \\<^bsup>M\<^esup> i * (j * k)" + by (rule prod_assoc_eqpoll_rel, simp_all add:types) + also have "... \\<^bsup>M\<^esup> i * |j * k|\<^bsup>M\<^esup>" + by (blast intro: prod_eqpoll_rel_cong well_ord_cardinal_rel_eqpoll_rel + eqpoll_rel_refl well_ord_rmult j k eqpoll_rel_sym types) + finally show "|i * j|\<^bsup>M\<^esup> * k \\<^bsup>M\<^esup> i * |j * k|\<^bsup>M\<^esup>" by (simp add:types) +qed (simp_all add:types) + + +subsubsection\Cardinal multiplication distributes over addition\ + +lemma sum_prod_distrib_eqpoll_rel: "M(A) \ M(B) \ M(C) \ (A+B)*C \\<^bsup>M\<^esup> (A*C)+(B*C)" + apply (simp add: def_eqpoll_rel) + apply (rule rexI) + apply (rule sum_prod_distrib_bij) + apply(rule_tac lam_closed, auto intro:case_replacement5 dest:transM) + done + + +lemma well_ord_cadd_cmult_distrib: + assumes i: "well_ord(i,ri)" and j: "well_ord(j,rj)" and k: "well_ord(k,rk)" + and + types: "M(i)" "M(ri)" "M(j)" "M(rj)" "M(k)" "M(rk)" + shows "(i \\<^bsup>M\<^esup> j) \\<^bsup>M\<^esup> k = (i \\<^bsup>M\<^esup> k) \\<^bsup>M\<^esup> (j \\<^bsup>M\<^esup> k)" +proof (simp add: assms cadd_rel_def cmult_rel_def, rule cardinal_rel_cong) + have "|i + j|\<^bsup>M\<^esup> * k \\<^bsup>M\<^esup> (i + j) * k" + by (blast intro: prod_eqpoll_rel_cong well_ord_cardinal_rel_eqpoll_rel + eqpoll_rel_refl well_ord_radd i j types) + also have "... \\<^bsup>M\<^esup> i * k + j * k" + by (rule sum_prod_distrib_eqpoll_rel) (simp_all add:types) + also have "... \\<^bsup>M\<^esup> |i * k|\<^bsup>M\<^esup> + |j * k|\<^bsup>M\<^esup>" + by (blast intro: sum_eqpoll_rel_cong well_ord_cardinal_rel_eqpoll_rel + well_ord_rmult i j k eqpoll_rel_sym types) + finally show "|i + j|\<^bsup>M\<^esup> * k \\<^bsup>M\<^esup> |i * k|\<^bsup>M\<^esup> + |j * k|\<^bsup>M\<^esup>" by (simp add:types) +qed (simp_all add:types) + + +subsubsection\Multiplication by 0 yields 0\ + +lemma prod_0_eqpoll_rel: "M(A) \ 0*A \\<^bsup>M\<^esup> 0" + apply (simp add: def_eqpoll_rel) + apply (rule rexI) + apply (rule lam_bijective, auto) + done + +lemma cmult_rel_0 [simp]: "M(i) \ 0 \\<^bsup>M\<^esup> i = 0" + by (simp add: cmult_rel_def prod_0_eqpoll_rel [THEN cardinal_rel_cong]) + +subsubsection\1 is the identity for multiplication\ + +lemma prod_singleton_eqpoll_rel: "M(x) \ M(A) \ {x}*A \\<^bsup>M\<^esup> A" + apply (simp add: def_eqpoll_rel) + apply (rule rexI) + apply (rule singleton_prod_bij [THEN bij_converse_bij]) + apply (rule converse_closed) + apply(rule_tac lam_closed, auto intro:prepend_replacement dest:transM) + done + +lemma cmult_rel_1 [simp]: "Card\<^bsup>M\<^esup>(K) \ M(K) \ 1 \\<^bsup>M\<^esup> K = K" + apply (simp add: cmult_rel_def succ_def) + apply (simp add: prod_singleton_eqpoll_rel[THEN cardinal_rel_cong] Card_rel_cardinal_rel_eq) + done + +subsection\Some inequalities for multiplication\ + +lemma prod_square_lepoll_rel: "M(A) \ A \\<^bsup>M\<^esup> A*A" + apply (simp add:def_lepoll_rel inj_def) + apply (rule_tac x = "\x\A. " in rexI, simp) + apply(rule_tac lam_closed, auto intro:id_replacement dest:transM) + done + +(*Could probably weaken the premise to well_ord(K,r), or remove using AC*) +lemma cmult_rel_square_le: "Card\<^bsup>M\<^esup>(K) \ M(K) \ K \ K \\<^bsup>M\<^esup> K" + apply (unfold cmult_rel_def) + apply (rule le_trans) + apply (rule_tac [2] well_ord_lepoll_rel_imp_cardinal_rel_le) + apply (rule_tac [3] prod_square_lepoll_rel) + apply (simp add: le_refl Card_rel_is_Ord Card_rel_cardinal_rel_eq) + apply (blast intro: well_ord_rmult well_ord_Memrel Card_rel_is_Ord) + apply simp_all + done + +subsubsection\Multiplication by a non-zero cardinal\ + +lemma prod_lepoll_rel_self: "b \ B \ M(b) \ M(B) \ M(A) \ A \\<^bsup>M\<^esup> A*B" + apply (simp add: def_lepoll_rel inj_def) + apply (rule_tac x = "\x\A. " in rexI, simp) + apply(rule_tac lam_closed, auto intro:pospend_replacement dest:transM) + done + +(*Could probably weaken the premises to well_ord(K,r), or removing using AC*) +lemma cmult_rel_le_self: + "[| Card\<^bsup>M\<^esup>(K); Ord(L); 0 K \ (K \\<^bsup>M\<^esup> L)" + apply (unfold cmult_rel_def) + apply (rule le_trans [OF Card_rel_cardinal_rel_le well_ord_lepoll_rel_imp_cardinal_rel_le]) + apply assumption apply simp + apply (blast intro: well_ord_rmult well_ord_Memrel Card_rel_is_Ord) + apply (auto intro: prod_lepoll_rel_self ltD) + done + +subsubsection\Monotonicity of multiplication\ + +lemma prod_lepoll_rel_mono: + "[| A \\<^bsup>M\<^esup> C; B \\<^bsup>M\<^esup> D; M(A); M(B); M(C); M(D)|] ==> A * B \\<^bsup>M\<^esup> C * D" + apply (simp add:def_lepoll_rel) + apply (elim rexE) + apply (rule_tac x = "lam :A*B. " in rexI) + apply (rule_tac d = "%. " + in lam_injective) + apply (typecheck add: inj_is_fun, auto) + apply(rule_tac lam_closed, auto intro:prod_fun_replacement dest:transM) + done + +lemma cmult_rel_le_mono: + "[| K' \ K; L' \ L;M(K');M(K);M(L');M(L) |] ==> (K' \\<^bsup>M\<^esup> L') \ (K \\<^bsup>M\<^esup> L)" + apply (unfold cmult_rel_def) + apply (safe dest!: le_subset_iff [THEN iffD1]) + apply (rule well_ord_lepoll_rel_imp_cardinal_rel_le) + apply (blast intro: well_ord_rmult well_ord_Memrel) + apply (auto intro: prod_lepoll_rel_mono subset_imp_lepoll_rel) + done + +subsection\Multiplication of finite cardinals is "ordinary" multiplication\ + +lemma prod_succ_eqpoll_rel: "M(A) \ M(B) \ succ(A)*B \\<^bsup>M\<^esup> B + A*B" + apply (simp add: def_eqpoll_rel) + apply (rule rexI) + apply (rule_tac c = "\p. if fst(p)=A then Inl (snd(p)) else Inr (p)" + and d = "case (%y. , %z. z)" in lam_bijective) + apply safe + apply (simp_all add: succI2 if_type mem_imp_not_eq) + apply(rule_tac lam_closed, auto intro:Inl_replacement2 dest:transM) + done + +(*Unconditional version requires AC*) +lemma cmult_rel_succ_lemma: + "[| Ord(m); Ord(n) ; M(m); M(n) |] ==> succ(m) \\<^bsup>M\<^esup> n = n \\<^bsup>M\<^esup> (m \\<^bsup>M\<^esup> n)" + apply (simp add: cmult_rel_def cadd_rel_def) + apply (rule prod_succ_eqpoll_rel [THEN cardinal_rel_cong, THEN trans], simp_all) + apply (rule cardinal_rel_cong [symmetric], simp_all) + apply (rule sum_eqpoll_rel_cong [OF eqpoll_rel_refl well_ord_cardinal_rel_eqpoll_rel], assumption) + apply (blast intro: well_ord_rmult well_ord_Memrel) + apply simp_all + done + +lemma nat_cmult_rel_eq_mult: "[| m \ nat; n \ nat |] ==> m \\<^bsup>M\<^esup> n = m#*n" + using transM[OF _ M_nat] + apply (induct_tac m) + apply (simp_all add: cmult_rel_succ_lemma nat_cadd_rel_eq_add) + done + +lemma cmult_rel_2: "Card\<^bsup>M\<^esup>(n) \ M(n) \ 2 \\<^bsup>M\<^esup> n = n \\<^bsup>M\<^esup> n" + by (simp add: cmult_rel_succ_lemma Card_rel_is_Ord cadd_rel_commute [of _ 0]) + +lemma sum_lepoll_rel_prod: + assumes C: "2 \\<^bsup>M\<^esup> C" and + types:"M(C)" "M(B)" + shows "B+B \\<^bsup>M\<^esup> C*B" +proof - + have "B+B \\<^bsup>M\<^esup> 2*B" + by (simp add: sum_eq_2_times types) + also have "... \\<^bsup>M\<^esup> C*B" + by (blast intro: prod_lepoll_rel_mono lepoll_rel_refl C types) + finally show "B+B \\<^bsup>M\<^esup> C*B" by (simp_all add:types) +qed + +lemma lepoll_imp_sum_lepoll_prod: "[| A \\<^bsup>M\<^esup> B; 2 \\<^bsup>M\<^esup> A; M(A) ;M(B) |] ==> A+B \\<^bsup>M\<^esup> A*B" + by (blast intro: sum_lepoll_rel_mono sum_lepoll_rel_prod lepoll_rel_trans lepoll_rel_refl) + +end \ \\<^locale>\M_cardinals\\ + +subsection\Infinite Cardinals are Limit Ordinals\ + +(*This proof is modelled upon one assuming nat<=A, with injection + \z\cons(u,A). if z=u then 0 else if z \ nat then succ(z) else z + and inverse %y. if y \ nat then nat_case(u, %z. z, y) else y. \ + If f \ inj(nat,A) then range(f) behaves like the natural numbers.*) + + +context M_pre_cardinal_arith +begin + +lemma nat_cons_lepoll_rel: "nat \\<^bsup>M\<^esup> A \ M(A) \ M(u) ==> cons(u,A) \\<^bsup>M\<^esup> A" + apply (simp add: def_lepoll_rel) + apply (erule rexE) + apply (rule_tac x = + "\z\cons (u,A). + if z=u then f`0 + else if z \ range (f) then f`succ (converse (f) `z) else z" + in rexI) + apply (rule_tac d = + "%y. if y \ range(f) then nat_case (u, %z. f`z, converse(f) `y) + else y" + in lam_injective) + apply (fast intro!: if_type apply_type intro: inj_is_fun inj_converse_fun) + apply (simp add: inj_is_fun [THEN apply_rangeI] + inj_converse_fun [THEN apply_rangeI] + inj_converse_fun [THEN apply_funtype]) +proof - + fix f + assume "M(A)" "M(f)" "M(u)" + then + show "M(\z\cons(u, A). if z = u then f ` 0 else if z \ range(f) then f ` succ(converse(f) ` z) else z)" + using if_then_range_replacement transM[OF _ \M(A)\] + by (rule_tac lam_closed, auto) +qed + +lemma nat_cons_eqpoll_rel: "nat \\<^bsup>M\<^esup> A ==> M(A) \ M(u) \ cons(u,A) \\<^bsup>M\<^esup> A" + apply (erule nat_cons_lepoll_rel [THEN eqpoll_relI], assumption+) + apply (rule subset_consI [THEN subset_imp_lepoll_rel], simp_all) + done + +lemma nat_succ_eqpoll_rel: "nat \ A ==> M(A) \ succ(A) \\<^bsup>M\<^esup> A" + apply (unfold succ_def) + apply (erule subset_imp_lepoll_rel [THEN nat_cons_eqpoll_rel], simp_all) + done + +lemma InfCard_rel_nat: "InfCard\<^bsup>M\<^esup>(nat)" + apply (simp add: InfCard_rel_def) + apply (blast intro: Card_rel_nat Card_rel_is_Ord) + done + +lemma InfCard_rel_is_Card_rel: "M(K) \ InfCard\<^bsup>M\<^esup>(K) \ Card\<^bsup>M\<^esup>(K)" + apply (simp add: InfCard_rel_def) + done + +lemma InfCard_rel_Un: + "[| InfCard\<^bsup>M\<^esup>(K); Card\<^bsup>M\<^esup>(L); M(K); M(L) |] ==> InfCard\<^bsup>M\<^esup>(K \ L)" + apply (simp add: InfCard_rel_def) + apply (simp add: Card_rel_Un Un_upper1_le [THEN [2] le_trans] Card_rel_is_Ord) + done + +lemma InfCard_rel_is_Limit: "InfCard\<^bsup>M\<^esup>(K) ==> M(K) \ Limit(K)" + apply (simp add: InfCard_rel_def) + apply (erule conjE) + apply (frule Card_rel_is_Ord, assumption) + apply (rule ltI [THEN non_succ_LimitI]) + apply (erule le_imp_subset [THEN subsetD]) + apply (safe dest!: Limit_nat [THEN Limit_le_succD]) + apply (unfold Card_rel_def) + apply (drule trans) + apply (erule le_imp_subset [THEN nat_succ_eqpoll_rel, THEN cardinal_rel_cong], simp_all) + apply (erule Ord_cardinal_rel_le [THEN lt_trans2, THEN lt_irrefl], assumption) + apply (rule le_eqI) prefer 2 + apply (rule Ord_cardinal_rel, assumption+) + done + +end \ \\<^locale>\M_pre_cardinal_arith\\ + +(*** An infinite cardinal equals its square (Kunen, Thm 10.12, page 29) ***) + + +lemma (in M_ordertype) ordertype_abs[absolut]: + assumes "wellordered(M,A,r)" "M(A)" "M(r)" "M(i)" + shows "otype(M,A,r,i) \ i = ordertype(A,r)" + \ \Awful proof, it essentially repeats the same argument twice\ +proof (intro iffI) + note assms + moreover + assume "otype(M, A, r, i)" + moreover from calculation + obtain f j where "M(f)" "M(j)" "Ord(j)" "f \ \A, r\ \ \j, Memrel(j)\" + using ordertype_exists[of A r] by auto + moreover from calculation + have "\f[M]. f \ \A, r\ \ \j, Memrel(j)\" by auto + moreover + have "\f[M]. f \ \A, r\ \ \i, Memrel(i)\" + proof - + note calculation + moreover from this + obtain h where "omap(M, A, r, h)" "M(h)" + using omap_exists by auto + moreover from calculation + have "h \ \A, r\ \ \i, Memrel(i)\" + using omap_ord_iso obase_equals by simp + moreover from calculation + have "h O converse(f) \ \j, Memrel(j)\ \ \i, Memrel(i)\" + using ord_iso_sym ord_iso_trans by blast + moreover from calculation + have "i=j" + using Ord_iso_implies_eq[of j i "h O converse(f)"] + Ord_otype[OF _ well_ord_is_trans_on] by simp + ultimately + show ?thesis by simp + qed + ultimately + show "i = ordertype(A, r)" + by (force intro:ordertypes_are_absolute[of A r _ i] + simp add:Ord_otype[OF _ well_ord_is_trans_on]) +next + note assms + moreover + assume "i = ordertype(A, r)" + moreover from calculation + obtain h where "omap(M, A, r, h)" "M(h)" + using omap_exists by auto + moreover from calculation + obtain j where "otype(M,A,r,j)" "M(j)" + using otype_exists by auto + moreover from calculation + have "h \ \A, r\ \ \j, Memrel(j)\" + using omap_ord_iso_otype by simp + moreover from calculation + obtain f where "f \ \A, r\ \ \i, Memrel(i)\" + using ordertype_ord_iso by auto + moreover + have "j=i" + proof - + note calculation + moreover from this + have "h O converse(f) \ \i, Memrel(i)\ \ \j, Memrel(j)\" + using ord_iso_sym ord_iso_trans by blast + moreover from calculation + have "Ord(i)" using Ord_ordertype by simp + ultimately + show "j=i" + using Ord_iso_implies_eq[of i j "h O converse(f)"] + Ord_otype[OF _ well_ord_is_trans_on] by simp + qed + ultimately + show "otype(M, A, r, i)" by simp +qed + +lemma (in M_ordertype) ordertype_closed[intro,simp]: "\ wellordered(M,A,r);M(A);M(r)\ \ M(ordertype(A,r))" + using ordertype_exists ordertypes_are_absolute by blast + +(* +definition + jump_cardinal :: "i=>i" where + \ \This definition is more complex than Kunen's but it more easily proved to + be a cardinal\ + "jump_cardinal(K) == + \X\Pow(K). {z. r \ Pow(K*K), well_ord(X,r) & z = ordertype(X,r)}" +*) + +relationalize "transitive_rel" "is_transitive" external +synthesize "is_transitive" from_definition assuming "nonempty" +arity_theorem for "is_transitive_fm" + +lemma (in M_trivial) is_transitive_iff_transitive_rel: + "M(A)\ M(r) \ transitive_rel(M, A, r) \ is_transitive(M,A, r)" + unfolding transitive_rel_def is_transitive_def by simp + +relationalize "linear_rel" "is_linear" external +synthesize "is_linear" from_definition assuming "nonempty" +arity_theorem for "is_linear_fm" + +lemma (in M_trivial) is_linear_iff_linear_rel: + "M(A)\ M(r) \ is_linear(M,A, r) \ linear_rel(M, A, r)" + unfolding linear_rel_def is_linear_def by simp + +relationalize "wellfounded_on" "is_wellfounded_on" external +synthesize "is_wellfounded_on" from_definition assuming "nonempty" +arity_theorem for "is_wellfounded_on_fm" + +lemma (in M_trivial) is_wellfounded_on_iff_wellfounded_on: + "M(A)\ M(r) \ is_wellfounded_on(M,A, r) \ wellfounded_on(M, A, r)" + unfolding wellfounded_on_def is_wellfounded_on_def by simp + +definition + is_well_ord :: "[i=>o,i,i]=>o" where + \ \linear and wellfounded on \A\\ + "is_well_ord(M,A,r) == + is_transitive(M,A,r) \ is_linear(M,A,r) \ is_wellfounded_on(M,A,r)" + +lemma (in M_trivial) is_well_ord_iff_wellordered: + "M(A)\ M(r) \ is_well_ord(M,A, r) \ wellordered(M, A, r)" + using is_wellfounded_on_iff_wellfounded_on is_linear_iff_linear_rel + is_transitive_iff_transitive_rel + unfolding wellordered_def is_well_ord_def by simp + +reldb_add relational "well_ord" "is_well_ord" +reldb_add functional "well_ord" "well_ord" +synthesize "is_well_ord" from_definition assuming "nonempty" +arity_theorem for "is_well_ord_fm" + +\ \One keyword (functional or relational) means going + from an absolute term to that kind of term\ +reldb_add relational "Order.pred" "pred_set" + +\ \The following form (twice the same argument) is only correct + when an "\_abs" theorem is available\ +reldb_add functional "Order.pred" "Order.pred" + +(* +\ \Two keywords denote origin and destination, respectively\ +reldb_add functional relational "Ord" "ordinal" +*) + +relativize functional "ord_iso" "ord_iso_rel" external + \ \The following corresponds to "relativize functional relational"\ +relationalize "ord_iso_rel" "is_ord_iso" + +context M_pre_cardinal_arith +begin + +is_iff_rel for "ord_iso" + using bij_rel_iff + unfolding is_ord_iso_def ord_iso_rel_def + by simp + +rel_closed for "ord_iso" + using ord_iso_separation unfolding ord_iso_rel_def + by simp + +end \ \\<^locale>\M_pre_cardinal_arith\\ + +synthesize "is_ord_iso" from_definition assuming "nonempty" + +lemma is_lambda_iff_sats[iff_sats]: + assumes is_F_iff_sats: + "!!a0 a1 a2. + [|a0\Aa; a1\Aa; a2\Aa|] + ==> is_F(a1, a0) \ sats(Aa, is_F_fm, Cons(a0,Cons(a1,Cons(a2,env))))" + shows + "nth(A, env) = Ab \ + nth(r, env) = ra \ + A \ nat \ + r \ nat \ + env \ list(Aa) \ + is_lambda(##Aa, Ab, is_F, ra) \ Aa, env \ lambda_fm(is_F_fm,A, r)" + using sats_lambda_fm[OF assms, of A r] by simp + +\ \same as @{thm sats_is_wfrec_fm}, but changing length assumptions to + \<^term>\0\ being in the model\ +lemma sats_is_wfrec_fm': + assumes MH_iff_sats: + "!!a0 a1 a2 a3 a4. + [|a0\A; a1\A; a2\A; a3\A; a4\A|] + ==> MH(a2, a1, a0) \ sats(A, p, Cons(a0,Cons(a1,Cons(a2,Cons(a3,Cons(a4,env))))))" + shows + "[|x \ nat; y \ nat; z \ nat; env \ list(A); 0 \ A|] + ==> sats(A, is_wfrec_fm(p,x,y,z), env) \ + is_wfrec(##A, MH, nth(x,env), nth(y,env), nth(z,env))" + using MH_iff_sats [THEN iff_sym] nth_closed sats_is_recfun_fm + by (simp add: is_wfrec_fm_def is_wfrec_def) blast + +lemma is_wfrec_iff_sats'[iff_sats]: + assumes MH_iff_sats: + "!!a0 a1 a2 a3 a4. + [|a0\Aa; a1\Aa; a2\Aa; a3\Aa; a4\Aa|] + ==> MH(a2, a1, a0) \ sats(Aa, p, Cons(a0,Cons(a1,Cons(a2,Cons(a3,Cons(a4,env))))))" + "nth(x, env) = xx" "nth(y, env) = yy" "nth(z, env) = zz" + "x \ nat" "y \ nat" "z \ nat" "env \ list(Aa)" "0 \ Aa" + shows + "is_wfrec(##Aa, MH, xx, yy, zz) \ Aa, env \ is_wfrec_fm(p,x,y,z)" + using assms(2-4) sats_is_wfrec_fm'[OF assms(1,5-9)] by simp + +lemma is_wfrec_on_iff_sats[iff_sats]: + assumes MH_iff_sats: + "!!a0 a1 a2 a3 a4. + [|a0\Aa; a1\Aa; a2\Aa; a3\Aa; a4\Aa|] + ==> MH(a2, a1, a0) \ sats(Aa, p, Cons(a0,Cons(a1,Cons(a2,Cons(a3,Cons(a4,env))))))" + shows + "nth(x, env) = xx \ + nth(y, env) = yy \ + nth(z, env) = zz \ + x \ nat \ + y \ nat \ + z \ nat \ + env \ list(Aa) \ + 0 \ Aa \ is_wfrec_on(##Aa, MH, aa,xx, yy, zz) \ Aa, env \ is_wfrec_fm(p,x,y,z)" + using assms sats_is_wfrec_fm'[OF assms] unfolding is_wfrec_on_def by simp + +lemma trans_on_iff_trans: "trans[A](r) \ trans(r \ A\A)" + unfolding trans_on_def trans_def by auto + +lemma trans_on_subset: "trans[A](r) \ B \ A \ trans[B](r)" + unfolding trans_on_def + by auto + +lemma relation_Int: "relation(r \ B\B)" + unfolding relation_def + by auto + +text\Discipline for \<^term>\ordermap\\ +relativize functional "ordermap" "ordermap_rel" external +relationalize "ordermap_rel" "is_ordermap" + +context M_pre_cardinal_arith +begin + +lemma wfrec_on_pred_eq: + assumes "r \ Pow(A\A)" "M(A)" "M(r)" + shows "wfrec[A](r, x, \x f. f `` Order.pred(A, x, r)) = wfrec(r, x, \x f. f `` Order.pred(A, x, r))" +proof - + from \r \ Pow(A\A)\ + have "r \ A\A = r" by auto + moreover from this + show ?thesis + unfolding wfrec_on_def by simp +qed + +lemma wfrec_on_pred_closed: + assumes "wf[A](r)" "trans[A](r)" "r \ Pow(A\A)" "M(A)" "M(r)" "x \ A" + shows "M(wfrec(r, x, \x f. f `` Order.pred(A, x, r)))" +proof - + from assms + have "wfrec[A](r, x, \x f. f `` Order.pred(A, x, r)) = wfrec(r, x, \x f. f `` Order.pred(A, x, r))" + using wfrec_on_pred_eq by simp + moreover from assms + have "M(wfrec(r, x, \x f. f `` Order.pred(A, x, r)))" + using wfrec_pred_replacement wf_on_imp_wf trans_on_imp_trans subset_Sigma_imp_relation + by (rule_tac MH="\x f b. \a[M]. image(M, f, a, b) \ pred_set(M, A, x, r, a)" in trans_wfrec_closed) + (auto dest:transM simp:relation2_def) + ultimately + show ?thesis by simp +qed + +lemma wfrec_on_pred_closed': + assumes "wf[A](r)" "trans[A](r)" "r \ Pow(A\A)" "M(A)" "M(r)" "x \ A" + shows "M(wfrec[A](r, x, \x f. f `` Order.pred(A, x, r)))" + using assms wfrec_on_pred_closed wfrec_on_pred_eq by simp + + +lemma ordermap_rel_closed': + assumes "wf[A](r)" "trans[A](r)" "r \ Pow(A\A)" "M(A)" "M(r)" + shows "M(ordermap_rel(M, A, r))" +proof - + from assms + have "r \ A\A = r" by auto + with assms have "wf(r)" "trans(r)" "relation(r)" + unfolding wf_on_def using trans_on_iff_trans relation_def by auto + then + have 1:"\ x z . M(x) \ M(z) \ + (\y[M]. pair(M, x, y, z) \ is_wfrec(M, \x f z. z = f `` Order.pred(A, x, r), r, x, y)) + \ + z = x f. f `` Order.pred(A, x, r))>" + using trans_wfrec_abs[of r,where + H="\x f. f `` Order.pred(A, x, r)" and + MH="\x f z . z= f `` Order.pred(A, x, r)",simplified] assms + wfrec_pred_replacement unfolding relation2_def + by auto + then + have "strong_replacement(M,\x z. z = x f. f `` Order.pred(A, x, r))>)" + using strong_replacement_cong[of M,OF 1,THEN iffD1,OF _ _ + wfrec_pred_replacement[unfolded wfrec_replacement_def]] assms by simp + then show ?thesis + using Pow_iff assms + unfolding ordermap_rel_def + apply(subst lam_cong[OF refl wfrec_on_pred_eq],simp_all) + using wfrec_on_pred_closed lam_closed + by simp +qed + +lemma ordermap_rel_closed[intro,simp]: + assumes "wf[A](r)" "trans[A](r)" "r \ Pow(A\A)" + shows "M(A) \ M(r) \ M(ordermap_rel(M, A, r))" + using ordermap_rel_closed' assms by simp + +lemma is_ordermap_iff: + assumes "r \ Pow(A\A)" "wf[A](r)" "trans[A](r)" + "M(A)" "M(r)" "M(res)" + shows "is_ordermap(M, A, r, res) \ res = ordermap_rel(M, A, r)" +proof - + from \r \ Pow(A\A)\ + have "r \ A\A = r" by auto + with assms have 1:"wf(r)" "trans(r)" "relation(r)" + unfolding wf_on_def using trans_on_iff_trans relation_def by auto + from assms + have "r \ A\A = r" "r \ A\A" " \ r \ x\A \ y\A" for x y by auto + then + show ?thesis + using ordermap_rel_closed[of r A] assms wfrec_on_pred_closed wfrec_pred_replacement 1 + unfolding is_ordermap_def ordermap_rel_def + apply (rule_tac lambda_abs2) + apply (simp_all add:Relation1_def) + apply clarify + apply (rule trans_wfrec_on_abs) + apply (auto dest:transM simp add: relation_Int relation2_def) + by(rule_tac wfrec_on_pred_closed'[of A r],auto) +qed + +end \ \\<^locale>\M_pre_cardinal_arith\\ + +synthesize "is_ordermap" from_definition assuming "nonempty" + +text\Discipline for \<^term>\ordertype\\ +relativize functional "ordertype" "ordertype_rel" external +relationalize "ordertype_rel" "is_ordertype" + +context M_pre_cardinal_arith +begin + +lemma is_ordertype_iff: + assumes "r \ Pow(A\A)" "wf[A](r)" "trans[A](r)" + shows "M(A) \ M(r) \ M(res) \ is_ordertype(M, A, r, res) \ res = ordertype_rel(M, A, r)" + using assms is_ordermap_iff[of r A] trans_on_iff_trans + ordermap_rel_closed[of A r] + unfolding is_ordertype_def ordertype_rel_def wf_on_def by simp + +lemma is_ordertype_iff': + assumes "r \ Pow_rel(M,A\A)" "well_ord(A,r)" + shows "M(A) \ M(r) \ M(res) \ is_ordertype(M, A, r, res) \ res = ordertype_rel(M, A, r)" + using assms is_ordertype_iff Pow_rel_char + unfolding well_ord_def part_ord_def tot_ord_def by simp + +lemma is_ordertype_iff'': + assumes "well_ord(A,r)" "r\A\A" + shows "M(A) \ M(r) \ M(res) \ is_ordertype(M, A, r, res) \ res = ordertype_rel(M, A, r)" + using assms is_ordertype_iff + unfolding well_ord_def part_ord_def tot_ord_def by simp + +end \ \\<^locale>\M_pre_cardinal_arith\\ + +synthesize "is_ordertype" from_definition assuming "nonempty" + +\ \NOTE: not quite the same as \<^term>\jump_cardinal\, + note \<^term>\Pow(X*X)\.\ +definition + jump_cardinal' :: "i\i" where + "jump_cardinal'(K) \ + \X\Pow(K). {z. r \ Pow(X*X), well_ord(X,r) & z = ordertype(X,r)}" + +relativize functional "jump_cardinal'" "jump_cardinal'_rel" external +relationalize "jump_cardinal'_rel" "is_jump_cardinal'" +synthesize "is_jump_cardinal'" from_definition assuming "nonempty" +arity_theorem for "is_jump_cardinal'_fm" +definition jump_cardinal_body' where + "jump_cardinal_body'(X) \ {z . r \ Pow(X \ X), well_ord(X, r) \ z = ordertype(X, r)}" + +relativize functional "jump_cardinal_body'" "jump_cardinal_body'_rel" external +relationalize "jump_cardinal_body'_rel" "is_jump_cardinal_body'" +synthesize "is_jump_cardinal_body'" from_definition assuming "nonempty" +arity_theorem for "is_jump_cardinal_body'_fm" + +context M_pre_cardinal_arith +begin + +lemma ordertype_rel_closed': + assumes "wf[A](r)" "trans[A](r)" "r \ Pow(A\A)" "M(r)" "M(A)" + shows "M(ordertype_rel(M,A,r))" + unfolding ordertype_rel_def + using ordermap_rel_closed image_closed assms by simp + +lemma ordertype_rel_closed[intro,simp]: + assumes "well_ord(A,r)" "r \ Pow_rel(M,A\A)" "M(A)" + shows "M(ordertype_rel(M,A,r))" + using assms Pow_rel_char ordertype_rel_closed' + unfolding well_ord_def tot_ord_def part_ord_def + by simp + +lemma ordertype_rel_abs: + assumes "wellordered(M,X,r)" "M(X)" "M(r)" + shows "ordertype_rel(M,X,r) = ordertype(X,r)" + using assms ordertypes_are_absolute[of X r] + unfolding ordertype_def ordertype_rel_def ordermap_rel_def ordermap_def + by simp + +lemma univalent_aux1: "M(X) \ univalent(M,Pow_rel(M,X\X), + \r z. M(z) \ M(r) \ r\Pow_rel(M,X\X) \ is_well_ord(M, X, r) \ is_ordertype(M, X, r, z))" + using is_well_ord_iff_wellordered + is_ordertype_iff[of _ X] + trans_on_subset[OF well_ord_is_trans_on] + well_ord_is_wf[THEN wf_on_subset_A] mem_Pow_rel_abs + unfolding univalent_def + by (simp) + +lemma jump_cardinal_body_eq : + "M(X) \ jump_cardinal_body(M,X) = jump_cardinal_body'_rel(M,X)" + unfolding jump_cardinal_body_def jump_cardinal_body'_rel_def + using ordertype_rel_abs + by auto + +end \ \\<^locale>\M_pre_cardinal_arith\\ + +context M_cardinal_arith +begin +lemma jump_cardinal_closed_aux1: + assumes "M(X)" + shows + "M(jump_cardinal_body(M,X))" + unfolding jump_cardinal_body_def + using \M(X)\ ordertype_rel_abs + ordertype_replacement[OF \M(X)\] univalent_aux1[OF \M(X)\] + strong_replacement_closed[where A="Pow\<^bsup>M\<^esup>(X \ X)" and + P="\ r z . M(z) \ M(r) \ r \ Pow\<^bsup>M\<^esup>(X \ X) \ well_ord(X, r) \ z = ordertype(X, r)"] + by auto + +lemma univalent_jc_body: "M(X) \ univalent(M,X,\ x z . M(z) \ M(x) \ z = jump_cardinal_body(M,x))" + using transM[of _ X] jump_cardinal_closed_aux1 by auto + +lemma jump_cardinal_body_closed: + assumes "M(K)" + shows "M({a . X \ Pow\<^bsup>M\<^esup>(K), M(a) \ M(X) \ a = jump_cardinal_body(M,X)})" + using assms univalent_jc_body jump_cardinal_closed_aux1 strong_replacement_jc_body + by simp + +rel_closed for "jump_cardinal'" + using jump_cardinal_body_closed ordertype_rel_abs + unfolding jump_cardinal_body_def jump_cardinal'_rel_def + by simp + +is_iff_rel for "jump_cardinal'" +proof - + assume types: "M(K)" "M(res)" + have "is_Replace(M, Pow_rel(M,X\X), \r z. M(z) \ M(r) \ is_well_ord(M, X, r) \ is_ordertype(M, X, r, z), + a) \ a = {z . r \ Pow_rel(M,X\X), M(z) \ M(r) \ is_well_ord(M,X,r) \ is_ordertype(M, X, r, z)}" + if "M(X)" "M(a)" for X a + using that univalent_aux1 + by (rule_tac Replace_abs) (simp_all) + then + have "is_Replace(M, Pow_rel(M,X\X), \r z. M(z) \ M(r) \ is_well_ord(M, X, r) \ is_ordertype(M, X, r, z), + a) \ a = {z . r \ Pow_rel(M,X\X), M(z) \ M(r) \ well_ord(X, r) \ z = ordertype_rel(M, X, r)}" + if "M(X)" "M(a)" for X a + using that univalent_aux1 is_ordertype_iff' is_well_ord_iff_wellordered well_ord_abs by auto + moreover + have "is_Replace(M, d, \X a. M(a) \ M(X) \ + a = {z . r \ Pow\<^bsup>M\<^esup>(X \ X), M(z) \ M(r) \ well_ord(X, r) \ z = ordertype(X, r)}, e) + \ + e ={a . X \ d, M(a) \ M(X) \ a = jump_cardinal_body(M,X)}" + if "M(d)" "M(e)" for d e + using jump_cardinal_closed_aux1 that + unfolding jump_cardinal_body_def + by (rule_tac Replace_abs) simp_all + ultimately + show ?thesis + using Pow_rel_iff jump_cardinal_body_closed[of K] ordertype_rel_abs + unfolding is_jump_cardinal'_def jump_cardinal'_rel_def jump_cardinal_body_def + by (simp add: types) +qed + +end + +context M_cardinal_arith +begin + +lemma (in M_ordertype) ordermap_closed[intro,simp]: + assumes "wellordered(M,A,r)" and types:"M(A)" "M(r)" + shows "M(ordermap(A,r))" +proof - + note assms + moreover from this + obtain i f where "Ord(i)" "f \ ord_iso(A, r, i, Memrel(i))" + "M(i)" "M(f)" using ordertype_exists by blast + moreover from calculation + have "i = ordertype(A,r)" using ordertypes_are_absolute by force + moreover from calculation + have "ordermap(A,r) \ ord_iso(A, r, i, Memrel(i))" + using ordertype_ord_iso by simp + ultimately + have "f = ordermap(A,r)" using well_ord_iso_unique by fastforce + with \M(f)\ + show ?thesis by simp +qed + + +(*A general fact about ordermap*) +lemma ordermap_eqpoll_pred: + "[| well_ord(A,r); x \ A ; M(A);M(r);M(x)|] ==> ordermap(A,r)`x \\<^bsup>M\<^esup> Order.pred(A,x,r)" + apply (simp add: def_eqpoll_rel) + apply (rule rexI) + apply (simp add: ordermap_eq_image well_ord_is_wf) + apply (erule ordermap_bij [THEN bij_is_inj, THEN restrict_bij, + THEN bij_converse_bij]) + apply (rule pred_subset, simp) + done + +text\Kunen: "each \<^term>\\x,y\ \ K \ K\ has no more than \<^term>\z \ z\ predecessors..." (page 29)\ +lemma ordermap_csquare_le: + assumes K: "Limit(K)" and x: "x K, csquare_rel(K)) ` \x,y\|\<^bsup>M\<^esup> \ |succ(succ(x \ y))|\<^bsup>M\<^esup> \\<^bsup>M\<^esup> |succ(succ(x \ y))|\<^bsup>M\<^esup>" + using types +proof (simp add: cmult_rel_def, rule_tac well_ord_lepoll_rel_imp_cardinal_rel_le) + let ?z="succ(x \ y)" + show "well_ord(|succ(?z)|\<^bsup>M\<^esup> \ |succ(?z)|\<^bsup>M\<^esup>, + rmult(|succ(?z)|\<^bsup>M\<^esup>, Memrel(|succ(?z)|\<^bsup>M\<^esup>), |succ(?z)|\<^bsup>M\<^esup>, Memrel(|succ(?z)|\<^bsup>M\<^esup>)))" + by (blast intro: well_ord_Memrel well_ord_rmult types) +next + let ?z="succ(x \ y)" + have zK: "?z K, csquare_rel(K)))" + using well_ord_csquare Limit_is_Ord by fastforce + then + have "ordermap(K \ K, csquare_rel(K)) ` \x,y\ \\<^bsup>M\<^esup> ordermap(K \ K, csquare_rel(K)) ` \?z,?z\" + by (blast intro: ordermap_z_lt leI le_imp_lepoll_rel K x y types) + also have "... \\<^bsup>M\<^esup> Order.pred(K \ K, \?z,?z\, csquare_rel(K))" + proof (rule ordermap_eqpoll_pred) + show "well_ord(K \ K, csquare_rel(K))" using K + by (rule Limit_is_Ord [THEN well_ord_csquare]) + next + show "\?z, ?z\ \ K \ K" using zK + by (blast intro: ltD) + qed (simp_all add:types) + also have "... \\<^bsup>M\<^esup> succ(?z) \ succ(?z)" using zK + by (rule_tac pred_csquare_subset [THEN subset_imp_lepoll_rel]) (simp_all add:types) + also have "... \\<^bsup>M\<^esup> |succ(?z)|\<^bsup>M\<^esup> \ |succ(?z)|\<^bsup>M\<^esup>" using oz + by (blast intro: prod_eqpoll_rel_cong Ord_cardinal_rel_eqpoll_rel eqpoll_rel_sym types) + finally show "ordermap(K \ K, csquare_rel(K)) ` \x,y\ \\<^bsup>M\<^esup> |succ(?z)|\<^bsup>M\<^esup> \ |succ(?z)|\<^bsup>M\<^esup>" + by (simp_all add:types Mom) + from Mom + show "M(ordermap(K \ K, csquare_rel(K)) ` \x, y\)" by (simp_all add:types) +qed (simp_all add:types) + +text\Kunen: "... so the order type is \\\ K"\ +lemma ordertype_csquare_le_M: + assumes IK: "InfCard\<^bsup>M\<^esup>(K)" and eq: "\y. y\K \ InfCard\<^bsup>M\<^esup>(y) \ M(y) \ y \\<^bsup>M\<^esup> y = y" + \ \Note the weakened hypothesis @{thm eq}\ + and types: "M(K)" + shows "ordertype(K*K, csquare_rel(K)) \ K" +proof - + have CK: "Card\<^bsup>M\<^esup>(K)" using IK by (rule_tac InfCard_rel_is_Card_rel) (simp_all add:types) + hence OK: "Ord(K)" by (rule Card_rel_is_Ord) (simp_all add:types) + moreover have "Ord(ordertype(K \ K, csquare_rel(K)))" using OK + by (rule well_ord_csquare [THEN Ord_ordertype]) + ultimately show ?thesis + proof (rule all_lt_imp_le) + fix i + assume i:"i < ordertype(K \ K, csquare_rel(K))" + hence Oi: "Ord(i)" by (elim ltE) + obtain x y where x: "x \ K" and y: "y \ K" + and ieq: "i = ordermap(K \ K, csquare_rel(K)) ` \x,y\" + using i by (auto simp add: ordertype_unfold elim: ltE) + hence xy: "Ord(x)" "Ord(y)" "x < K" "y < K" using OK + by (blast intro: Ord_in_Ord ltI)+ + hence ou: "Ord(x \ y)" + by (simp) + from OK types + have "M(ordertype(K \ K, csquare_rel(K)))" + using well_ord_csquare by fastforce + with i x y types + have types': "M(K)" "M(i)" "M(x)" "M(y)" + using types by (auto dest:transM ltD) + show "i < K" + proof (rule Card_rel_lt_imp_lt [OF _ Oi CK]) + have "|i|\<^bsup>M\<^esup> \ |succ(succ(x \ y))|\<^bsup>M\<^esup> \\<^bsup>M\<^esup> |succ(succ(x \ y))|\<^bsup>M\<^esup>" using IK xy + by (auto simp add: ieq types intro: InfCard_rel_is_Limit [THEN ordermap_csquare_le] types') + moreover have "|succ(succ(x \ y))|\<^bsup>M\<^esup> \\<^bsup>M\<^esup> |succ(succ(x \ y))|\<^bsup>M\<^esup> < K" + proof (cases rule: Ord_linear2 [OF ou Ord_nat]) + assume "x \ y < nat" + hence "|succ(succ(x \ y))|\<^bsup>M\<^esup> \\<^bsup>M\<^esup> |succ(succ(x \ y))|\<^bsup>M\<^esup> \ nat" + by (simp add: lt_def nat_cmult_rel_eq_mult nat_succI + nat_into_Card_rel [THEN Card_rel_cardinal_rel_eq] types') + also have "... \ K" using IK + by (simp add: InfCard_rel_def le_imp_subset types) + finally show "|succ(succ(x \ y))|\<^bsup>M\<^esup> \\<^bsup>M\<^esup> |succ(succ(x \ y))|\<^bsup>M\<^esup> < K" + by (simp add: ltI OK) + next + assume natxy: "nat \ x \ y" + hence seq: "|succ(succ(x \ y))|\<^bsup>M\<^esup> = |x \ y|\<^bsup>M\<^esup>" using xy + by (simp add: le_imp_subset nat_succ_eqpoll_rel [THEN cardinal_rel_cong] le_succ_iff types') + also have "... < K" using xy + by (simp add: Un_least_lt Ord_cardinal_rel_le [THEN lt_trans1] types') + finally have "|succ(succ(x \ y))|\<^bsup>M\<^esup> < K" . + moreover have "InfCard\<^bsup>M\<^esup>(|succ(succ(x \ y))|\<^bsup>M\<^esup>)" using xy natxy + by (simp add: seq InfCard_rel_def nat_le_cardinal_rel types') + ultimately show ?thesis by (simp add: eq ltD types') + qed + ultimately show "|i|\<^bsup>M\<^esup> < K" by (blast intro: lt_trans1) + qed (simp_all add:types') + qed +qed + +(*Main result: Kunen's Theorem 10.12*) +lemma InfCard_rel_csquare_eq: + assumes IK: "InfCard\<^bsup>M\<^esup>(K)" and + types: "M(K)" + shows "K \\<^bsup>M\<^esup> K = K" +proof - + have OK: "Ord(K)" using IK by (simp add: Card_rel_is_Ord InfCard_rel_is_Card_rel types) + from OK assms + show "K \\<^bsup>M\<^esup> K = K" + proof (induct rule: trans_induct) + case (step i) + note types = \M(K)\ \M(i)\ + show "i \\<^bsup>M\<^esup> i = i" + proof (rule le_anti_sym) + from step types + have Mot:"M(ordertype(i \ i, csquare_rel(i)))" "M(ordermap(i \ i, csquare_rel(i)))" + using well_ord_csquare Limit_is_Ord by simp_all + then + have "|i \ i|\<^bsup>M\<^esup> = |ordertype(i \ i, csquare_rel(i))|\<^bsup>M\<^esup>" + by (rule_tac cardinal_rel_cong, + simp_all add: step.hyps well_ord_csquare [THEN ordermap_bij, THEN bij_imp_eqpoll_rel] types) + with Mot + have "i \\<^bsup>M\<^esup> i \ ordertype(i \ i, csquare_rel(i))" + by (simp add: step.hyps cmult_rel_def Ord_cardinal_rel_le well_ord_csquare [THEN Ord_ordertype] types) + moreover + have "ordertype(i \ i, csquare_rel(i)) \ i" using step + by (rule_tac ordertype_csquare_le_M) (simp add: types) + ultimately show "i \\<^bsup>M\<^esup> i \ i" by (rule le_trans) + next + show "i \ i \\<^bsup>M\<^esup> i" using step + by (blast intro: cmult_rel_square_le InfCard_rel_is_Card_rel) + qed + qed +qed + + +(*Corollary for arbitrary well-ordered sets (all sets, assuming AC)*) +lemma well_ord_InfCard_rel_square_eq: + assumes r: "well_ord(A,r)" and I: "InfCard\<^bsup>M\<^esup>(|A|\<^bsup>M\<^esup>)" and + types: "M(A)" "M(r)" + shows "A \ A \\<^bsup>M\<^esup> A" +proof - + have "A \ A \\<^bsup>M\<^esup> |A|\<^bsup>M\<^esup> \ |A|\<^bsup>M\<^esup>" + by (blast intro: prod_eqpoll_rel_cong well_ord_cardinal_rel_eqpoll_rel eqpoll_rel_sym r types) + also have "... \\<^bsup>M\<^esup> A" + proof (rule well_ord_cardinal_rel_eqE [OF _ r]) + show "well_ord(|A|\<^bsup>M\<^esup> \ |A|\<^bsup>M\<^esup>, rmult(|A|\<^bsup>M\<^esup>, Memrel(|A|\<^bsup>M\<^esup>), |A|\<^bsup>M\<^esup>, Memrel(|A|\<^bsup>M\<^esup>)))" + by (blast intro: well_ord_rmult well_ord_Memrel r types) + next + show "||A|\<^bsup>M\<^esup> \ |A|\<^bsup>M\<^esup>|\<^bsup>M\<^esup> = |A|\<^bsup>M\<^esup>" using InfCard_rel_csquare_eq I + by (simp add: cmult_rel_def types) + qed (simp_all add:types) + finally show ?thesis by (simp_all add:types) +qed + +lemma InfCard_rel_square_eqpoll: + assumes "InfCard\<^bsup>M\<^esup>(K)" and types:"M(K)" shows "K \ K \\<^bsup>M\<^esup> K" + using assms + apply (rule_tac well_ord_InfCard_rel_square_eq) + apply (erule InfCard_rel_is_Card_rel [THEN Card_rel_is_Ord, THEN well_ord_Memrel]) + apply (simp_all add: InfCard_rel_is_Card_rel [THEN Card_rel_cardinal_rel_eq] types) + done + +lemma Inf_Card_rel_is_InfCard_rel: "[| Card\<^bsup>M\<^esup>(i); ~ Finite_rel(M,i) ; M(i) |] ==> InfCard\<^bsup>M\<^esup>(i)" + by (simp add: InfCard_rel_def Card_rel_is_Ord [THEN nat_le_infinite_Ord]) + +subsubsection\Toward's Kunen's Corollary 10.13 (1)\ + +lemma InfCard_rel_le_cmult_rel_eq: "[| InfCard\<^bsup>M\<^esup>(K); L \ K; 0 K \\<^bsup>M\<^esup> L = K" + apply (rule le_anti_sym) + prefer 2 + apply (erule ltE, blast intro: cmult_rel_le_self InfCard_rel_is_Card_rel) + apply (frule InfCard_rel_is_Card_rel [THEN Card_rel_is_Ord, THEN le_refl]) prefer 3 + apply (rule cmult_rel_le_mono [THEN le_trans], assumption+) + apply (simp_all add: InfCard_rel_csquare_eq) + done + +(*Corollary 10.13 (1), for cardinal multiplication*) +lemma InfCard_rel_cmult_rel_eq: "[| InfCard\<^bsup>M\<^esup>(K); InfCard\<^bsup>M\<^esup>(L); M(K) ; M(L) |] ==> K \\<^bsup>M\<^esup> L = K \ L" + apply (rule_tac i = K and j = L in Ord_linear_le) + apply (typecheck add: InfCard_rel_is_Card_rel Card_rel_is_Ord) + apply (rule cmult_rel_commute [THEN ssubst]) prefer 3 + apply (rule Un_commute [THEN ssubst]) + apply (simp_all add: InfCard_rel_is_Limit [THEN Limit_has_0] InfCard_rel_le_cmult_rel_eq + subset_Un_iff2 [THEN iffD1] le_imp_subset) + done + +lemma InfCard_rel_cdouble_eq: "InfCard\<^bsup>M\<^esup>(K) \ M(K) \ K \\<^bsup>M\<^esup> K = K" + apply (simp add: cmult_rel_2 [symmetric] InfCard_rel_is_Card_rel cmult_rel_commute) + apply (simp add: InfCard_rel_le_cmult_rel_eq InfCard_rel_is_Limit Limit_has_0 Limit_has_succ) + done + +(*Corollary 10.13 (1), for cardinal addition*) +lemma InfCard_rel_le_cadd_rel_eq: "[| InfCard\<^bsup>M\<^esup>(K); L \ K ; M(K) ; M(L)|] ==> K \\<^bsup>M\<^esup> L = K" + apply (rule le_anti_sym) + prefer 2 + apply (erule ltE, blast intro: cadd_rel_le_self InfCard_rel_is_Card_rel) + apply (frule InfCard_rel_is_Card_rel [THEN Card_rel_is_Ord, THEN le_refl]) prefer 3 + apply (rule cadd_rel_le_mono [THEN le_trans], assumption+) + apply (simp_all add: InfCard_rel_cdouble_eq) + done + +lemma InfCard_rel_cadd_rel_eq: "[| InfCard\<^bsup>M\<^esup>(K); InfCard\<^bsup>M\<^esup>(L); M(K) ; M(L) |] ==> K \\<^bsup>M\<^esup> L = K \ L" + apply (rule_tac i = K and j = L in Ord_linear_le) + apply (typecheck add: InfCard_rel_is_Card_rel Card_rel_is_Ord) + apply (rule cadd_rel_commute [THEN ssubst]) prefer 3 + apply (rule Un_commute [THEN ssubst]) + apply (simp_all add: InfCard_rel_le_cadd_rel_eq subset_Un_iff2 [THEN iffD1] le_imp_subset) + done + +(*The other part, Corollary 10.13 (2), refers to the cardinality of the set + of all n-tuples of elements of K. A better version for the Isabelle theory + might be InfCard(K) ==> |list(K)| = K. +*) + +end \ \\<^locale>\M_cardinal_arith\\ + +subsection\For Every Cardinal Number There Exists A Greater One\ + +text\This result is Kunen's Theorem 10.16, which would be trivial using AC\ + +locale M_cardinal_arith_jump = M_cardinal_arith + M_ordertype +begin + +lemma well_ord_restr: "well_ord(X, r) \ well_ord(X, r \ X\X)" +proof - + have "r \ X\X \ X\X = r \ X\X" by auto + moreover + assume "well_ord(X, r)" + ultimately + show ?thesis + unfolding well_ord_def tot_ord_def part_ord_def linear_def + irrefl_def wf_on_def + by simp_all (simp only: trans_on_def, blast) +qed + +lemma ordertype_restr_eq : + assumes "well_ord(X,r)" + shows "ordertype(X, r) = ordertype(X, r \ X\X)" + using ordermap_restr_eq assms unfolding ordertype_def + by simp + +lemma def_jump_cardinal_rel_aux: + "X \ Pow\<^bsup>M\<^esup>(K) \ well_ord(X, w) \ M(K) \ + {z . r \ Pow\<^bsup>M\<^esup>(X \ X), M(z) \ well_ord(X, r) \ z = ordertype(X, r)} = + {z . r \ Pow\<^bsup>M\<^esup>(K \ K), M(z) \ well_ord(X, r) \ z = ordertype(X, r)}" +proof(rule,auto simp:Pow_rel_char dest:transM) + let ?L="{z . r \ Pow\<^bsup>M\<^esup>(X \ X), M(z) \ well_ord(X, r) \ z = ordertype(X, r)}" + let ?R="{z . r \ Pow\<^bsup>M\<^esup>(K \ K), M(z) \ well_ord(X, r) \ z = ordertype(X, r)}" + show "ordertype(X, r) \ {y . x \ {x \ Pow(X \ X) . M(x)}, M(y) \ well_ord(X, x) \ y = ordertype(X, x)}" + if "M(K)" "M(r)" "r\K\K" "X\K" "M(X)" "well_ord(X,r)" for r + proof - + from that + have "ordertype(X,r) = ordertype(X,r\X\X)" "(r\X\X)\X\X" "M(r\X\X)" + "well_ord(X,r\X\X)" "wellordered(M,X,r\X\X)" + using well_ord_restr ordertype_restr_eq by auto + moreover from this + have "ordertype(X,r\X\X) \ ?L" + using that Pow_rel_char + ReplaceI[of "\ z r . M(z) \ well_ord(X, r) \ z = ordertype(X, r)" "ordertype(X,r\X\X)"] + by auto + ultimately + show ?thesis using Pow_rel_char by auto + qed +qed + +lemma def_jump_cardinal_rel: + assumes "M(K)" + shows "jump_cardinal'_rel(M,K) = + (\X\Pow_rel(M,K). {z. r \ Pow_rel(M,K*K), well_ord(X,r) & z = ordertype(X,r)})" +proof - + have "M({z . r \ Pow\<^bsup>M\<^esup>(X \ X), M(z) \ well_ord(X, r) \ z = ordertype(X, r)})" + (is "M(Replace(_,?P))") + if "M(X)" for X + using that jump_cardinal_closed_aux1[of X] ordertype_rel_abs[of X] + jump_cardinal_body_def + by (subst Replace_cong[where P="?P" + and Q="\r z. M(z) \ M(r) \ well_ord(X, r) \ z = ordertype_rel(M,X,r)", + OF refl, of "Pow\<^bsup>M\<^esup>(X \ X)"]) (auto dest:transM) + then + have "M({z . r \ Pow\<^bsup>M\<^esup>(Y \ Y), M(z) \ well_ord(X, r) \ z = ordertype(X, r)})" + if "M(Y)" "M(X)" "X \ Pow\<^bsup>M\<^esup>(Y)" "well_ord(X,r)" for Y X r + using that def_jump_cardinal_rel_aux[of X Y r, symmetric] by simp + moreover from \M(K)\ + have "R \ Pow\<^bsup>M\<^esup>(X \ X) \ X \ Pow\<^bsup>M\<^esup>(K) \ R \ Pow\<^bsup>M\<^esup>(K \ K)" + for X R using mem_Pow_rel_abs transM[OF _ Pow_rel_closed, of R "X\X"] + transM[OF _ Pow_rel_closed, of X K] by auto + ultimately + show ?thesis + using assms is_ordertype_iff is_well_ord_iff_wellordered + ordertype_rel_abs transM[of _ "Pow\<^bsup>M\<^esup>(K)"] transM[of _ "Pow\<^bsup>M\<^esup>(K\K)"] + def_jump_cardinal_rel_aux + unfolding jump_cardinal'_rel_def + apply (intro equalityI) + apply (auto dest:transM) + apply (rename_tac X R) + apply (rule_tac x=X in bexI) + apply (rule_tac x=R in ReplaceI) + apply auto + apply (rule_tac x="{y . xa \ Pow\<^bsup>M\<^esup>(K \ K), M(y) \ M(xa) \ well_ord(X, xa) \ y = ordertype(X, xa)}" in bexI) + apply auto + by (rule_tac x=X in ReplaceI) auto +qed + +notation jump_cardinal'_rel (\jump'_cardinal'_rel\) + +lemma Ord_jump_cardinal_rel: "M(K) \ Ord(jump_cardinal_rel(M,K))" + apply (unfold def_jump_cardinal_rel) + apply (rule Ord_is_Transset [THEN [2] OrdI]) + prefer 2 apply (blast intro!: Ord_ordertype) + apply (unfold Transset_def) + apply (safe del: subsetI) + apply (subst ordertype_pred_unfold, simp, safe) + apply (rule UN_I) + apply (rule_tac [2] ReplaceI) + prefer 4 apply (blast intro: well_ord_subset elim!: predE, simp_all) + prefer 2 apply (blast intro: well_ord_subset elim!: predE) +proof - + fix X r xb + assume "M(K)" "X \ Pow\<^bsup>M\<^esup>(K)" "r \ Pow\<^bsup>M\<^esup>(K \ K)" "well_ord(X, r)" "xb \ X" + moreover from this + have "M(X)" "M(r)" + using cartprod_closed trans_Pow_rel_closed by auto + moreover from this + have "M(xb)" using transM[OF \xb\X\] by simp + ultimately + show "Order.pred(X, xb, r) \ Pow\<^bsup>M\<^esup>(K)" + using def_Pow_rel by (auto dest:predE) +qed + +declare conj_cong [cong del] + \ \incompatible with some of the proofs of the original theory\ + +lemma jump_cardinal_rel_iff_old: + "M(i) \ M(K) \ i \ jump_cardinal_rel(M,K) \ + (\r[M]. \X[M]. r \ K*K & X \ K & well_ord(X,r) & i = ordertype(X,r))" + apply (unfold def_jump_cardinal_rel) + apply (auto del: subsetI) + apply (rename_tac y r) + apply (rule_tac x=r in rexI, intro conjI) prefer 2 + apply (rule_tac x=y in rexI, intro conjI) + apply (auto dest:mem_Pow_rel transM) + apply (rule_tac A=r in rev_subsetD, assumption) + defer + apply (rename_tac r y) + apply (rule_tac x=y in bexI) + apply (rule_tac x=r in ReplaceI, auto) + using def_Pow_rel + apply (force+)[2] + apply (rule_tac A=r in rev_subsetD, assumption) + using mem_Pow_rel[THEN conjunct1] + apply auto + done + +(*The easy part of Theorem 10.16: jump_cardinal_rel(K) exceeds K*) +lemma K_lt_jump_cardinal_rel: "Ord(K) ==> M(K) \ K < jump_cardinal_rel(M,K)" + apply (rule Ord_jump_cardinal_rel [THEN [2] ltI]) + apply (rule jump_cardinal_rel_iff_old [THEN iffD2], assumption+) + apply (rule_tac x="Memrel(K)" in rexI) + apply (rule_tac x=K in rexI) + apply (simp add: ordertype_Memrel well_ord_Memrel) + using Memrel_closed + apply (simp_all add: Memrel_def subset_iff) + done + +(*The proof by contradiction: the bijection f yields a wellordering of X + whose ordertype is jump_cardinal_rel(K). *) +lemma Card_rel_jump_cardinal_rel_lemma: + "[| well_ord(X,r); r \ K * K; X \ K; + f \ bij(ordertype(X,r), jump_cardinal_rel(M,K)); + M(X); M(r); M(K); M(f) |] + ==> jump_cardinal_rel(M,K) \ jump_cardinal_rel(M,K)" + apply (subgoal_tac "f O ordermap (X,r) \ bij (X, jump_cardinal_rel (M,K))") + prefer 2 apply (blast intro: comp_bij ordermap_bij) + apply (rule jump_cardinal_rel_iff_old [THEN iffD2], simp+) + apply (intro rexI conjI) + apply (rule subset_trans [OF rvimage_type Sigma_mono], assumption+) + apply (erule bij_is_inj [THEN well_ord_rvimage]) + apply (rule Ord_jump_cardinal_rel [THEN well_ord_Memrel]) + apply (simp_all add: well_ord_Memrel [THEN [2] bij_ordertype_vimage] + ordertype_Memrel Ord_jump_cardinal_rel) + done + +(*The hard part of Theorem 10.16: jump_cardinal_rel(K) is itself a cardinal*) +lemma Card_rel_jump_cardinal_rel: "M(K) \ Card_rel(M,jump_cardinal_rel(M,K))" + apply (rule Ord_jump_cardinal_rel [THEN Card_relI]) + apply (simp_all add: def_eqpoll_rel) + apply (drule_tac i1=j in jump_cardinal_rel_iff_old [THEN iffD1, OF _ _ ltD, of _ K], safe) + apply (blast intro: Card_rel_jump_cardinal_rel_lemma [THEN mem_irrefl]) + done + +subsection\Basic Properties of Successor Cardinals\ + +lemma csucc_rel_basic: "Ord(K) ==> M(K) \ Card_rel(M,csucc_rel(M,K)) & K < csucc_rel(M,K)" + apply (unfold csucc_rel_def) + apply (rule LeastI[of "\i. M(i) \ Card_rel(M,i) \ K < i", THEN conjunct2]) + apply (blast intro: Card_rel_jump_cardinal_rel K_lt_jump_cardinal_rel Ord_jump_cardinal_rel)+ + done + +lemmas Card_rel_csucc_rel = csucc_rel_basic [THEN conjunct1] + +lemmas lt_csucc_rel = csucc_rel_basic [THEN conjunct2] + +lemma Ord_0_lt_csucc_rel: "Ord(K) ==> M(K) \ 0 < csucc_rel(M,K)" + by (blast intro: Ord_0_le lt_csucc_rel lt_trans1) + +lemma csucc_rel_le: "[| Card_rel(M,L); K csucc_rel(M,K) \ L" + apply (unfold csucc_rel_def) + apply (rule Least_le) + apply (blast intro: Card_rel_is_Ord)+ + done + +lemma lt_csucc_rel_iff: "[| Ord(i); Card_rel(M,K); M(K); M(i)|] ==> i < csucc_rel(M,K) \ |i|\<^bsup>M\<^esup> \ K" + apply (rule iffI) + apply (rule_tac [2] Card_rel_lt_imp_lt) + apply (erule_tac [2] lt_trans1) + apply (simp_all add: lt_csucc_rel Card_rel_csucc_rel Card_rel_is_Ord) + apply (rule notI [THEN not_lt_imp_le]) + apply (rule Card_rel_cardinal_rel [THEN csucc_rel_le, THEN lt_trans1, THEN lt_irrefl], simp_all+) + apply (rule Ord_cardinal_rel_le [THEN lt_trans1]) + apply (simp_all add: Card_rel_is_Ord) + done + +lemma Card_rel_lt_csucc_rel_iff: + "[| Card_rel(M,K'); Card_rel(M,K); M(K'); M(K) |] ==> K' < csucc_rel(M,K) \ K' \ K" + by (simp add: lt_csucc_rel_iff Card_rel_cardinal_rel_eq Card_rel_is_Ord) + +lemma InfCard_rel_csucc_rel: "InfCard_rel(M,K) \ M(K) ==> InfCard_rel(M,csucc_rel(M,K))" + by (simp add: InfCard_rel_def Card_rel_csucc_rel Card_rel_is_Ord + lt_csucc_rel [THEN leI, THEN [2] le_trans]) + + +subsubsection\Theorems by Krzysztof Grabczewski, proofs by lcp\ + +lemma nat_sum_eqpoll_rel_sum: + assumes m: "m \ nat" and n: "n \ nat" shows "m + n \\<^bsup>M\<^esup> m +\<^sub>\ n" +proof - + have "m + n \\<^bsup>M\<^esup> |m+n|\<^bsup>M\<^esup>" using m n + by (blast intro: nat_implies_well_ord well_ord_radd well_ord_cardinal_rel_eqpoll_rel eqpoll_rel_sym) + also have "... = m +\<^sub>\ n" using m n + by (simp add: nat_cadd_rel_eq_add [symmetric] cadd_rel_def transM[OF _ M_nat]) + finally show ?thesis . +qed + +lemma Ord_nat_subset_into_Card_rel: "[| Ord(i); i \ nat |] ==> Card\<^bsup>M\<^esup>(i)" + by (blast dest: Ord_subset_natD intro: Card_rel_nat nat_into_Card_rel) + +end \ \\<^locale>\M_cardinal_arith_jump\\ +end diff --git a/thys/Transitive_Models/Cardinal_AC_Relative.thy b/thys/Transitive_Models/Cardinal_AC_Relative.thy new file mode 100644 --- /dev/null +++ b/thys/Transitive_Models/Cardinal_AC_Relative.thy @@ -0,0 +1,422 @@ +section\Relative, Cardinal Arithmetic Using AC\ + +theory Cardinal_AC_Relative + imports + CardinalArith_Relative + +begin + +locale M_AC = + fixes M + assumes + choice_ax: "choice_ax(M)" + +locale M_cardinal_AC = M_cardinal_arith + M_AC +begin + +lemma well_ord_surj_imp_lepoll_rel: + assumes "well_ord(A,r)" "h \ surj(A,B)" and + types:"M(A)" "M(r)" "M(h)" "M(B)" + shows "B \\<^bsup>M\<^esup> A" +proof - + note eq=vimage_fun_sing[OF surj_is_fun[OF \h\_\]] + from assms + have "(\b\B. minimum(r, {a\A. h`a=b})) \ inj(B,A)" (is "?f\_") + using well_ord_surj_imp_inj_inverse assms(1,2) by simp + with assms + have "M(?f`b)" if "b\B" for b + using apply_type[OF inj_is_fun[OF \?f\_\]] that transM[OF _ \M(A)\] by simp + with assms + have "M(?f)" + using lam_closed surj_imp_inj_replacement4 eq by auto + with \?f\_\ assms + have "?f \ inj\<^bsup>M\<^esup>(B,A)" + using mem_inj_abs by simp + with \M(?f)\ + show ?thesis unfolding lepoll_rel_def by auto +qed + +lemma surj_imp_well_ord_M: + assumes wos: "well_ord(A,r)" "h \ surj(A,B)" + and + types: "M(A)" "M(r)" "M(h)" "M(B)" + shows "\s[M]. well_ord(B,s)" + using assms lepoll_rel_well_ord + well_ord_surj_imp_lepoll_rel by fast + + +lemma choice_ax_well_ord: "M(S) \ \r[M]. well_ord(S,r)" + using choice_ax well_ord_Memrel[THEN surj_imp_well_ord_M] + unfolding choice_ax_def by auto + +lemma Finite_cardinal_rel_Finite: + assumes "Finite(|i|\<^bsup>M\<^esup>)" "M(i)" + shows "Finite(i)" +proof - + note assms + moreover from this + obtain r where "M(r)" "well_ord(i,r)" + using choice_ax_well_ord by auto + moreover from calculation + have "|i|\<^bsup>M\<^esup> \\<^bsup>M\<^esup> i" + using well_ord_cardinal_rel_eqpoll_rel + by auto + ultimately + show ?thesis + using eqpoll_rel_imp_Finite + by auto +qed + +end \ \\<^locale>\M_cardinal_AC\\ + +locale M_Pi_assumptions_choice = M_Pi_assumptions + M_cardinal_AC + + assumes + B_replacement: "strong_replacement(M, \x y. y = B(x))" + and + \ \The next one should be derivable from (some variant) + of B\_replacement. Proving both instances each time seems + inconvenient.\ + minimum_replacement: "M(r) \ strong_replacement(M, \x y. y = \x, minimum(r, B(x))\)" +begin + +lemma AC_M: + assumes "a \ A" "\x. x \ A \ \y. y \ B(x)" + shows "\z[M]. z \ Pi\<^bsup>M\<^esup>(A, B)" +proof - + have "M(\x\A. B(x))" using assms family_union_closed Pi_assumptions B_replacement by simp + then + obtain r where "well_ord(\x\A. B(x),r)" "M(r)" + using choice_ax_well_ord by blast + let ?f="\x\A. minimum(r,B(x))" + have "M(minimum(r, B(x)))" if "x\A" for x + proof - + from \well_ord(_,r)\ \x\A\ + have "well_ord(B(x),r)" using well_ord_subset UN_upper by simp + with assms \x\A\ \M(r)\ + show ?thesis using Pi_assumptions by blast + qed + with assms and \M(r)\ + have "M(?f)" + using Pi_assumptions minimum_replacement lam_closed + by simp + moreover from assms and calculation + have "?f \ Pi\<^bsup>M\<^esup>(A,B)" + using lam_type[OF minimum_in, OF \well_ord(\x\A. B(x),r)\, of A B] + Pi_rel_char by auto + ultimately + show ?thesis by blast +qed + +lemma AC_Pi_rel: assumes "\x. x \ A \ \y. y \ B(x)" + shows "\z[M]. z \ Pi\<^bsup>M\<^esup>(A, B)" +proof (cases "A=0") + interpret Pi0:M_Pi_assumptions_0 + using Pi_assumptions by unfold_locales auto + case True + then + show ?thesis using assms by simp +next + case False + then + obtain a where "a \ A" by auto + \ \It is noteworthy that without obtaining an element of + \<^term>\A\, the final step won't work\ + with assms + show ?thesis by (blast intro!: AC_M) +qed + +end \ \\<^locale>\M_Pi_assumptions_choice\\ + + +context M_cardinal_AC +begin + +subsection\Strengthened Forms of Existing Theorems on Cardinals\ + +lemma cardinal_rel_eqpoll_rel: "M(A) \ |A|\<^bsup>M\<^esup> \\<^bsup>M\<^esup> A" + apply (rule choice_ax_well_ord [THEN rexE]) + apply (auto intro:well_ord_cardinal_rel_eqpoll_rel) + done + +lemmas cardinal_rel_idem = cardinal_rel_eqpoll_rel [THEN cardinal_rel_cong, simp] + +lemma cardinal_rel_eqE: "|X|\<^bsup>M\<^esup> = |Y|\<^bsup>M\<^esup> ==> M(X) \ M(Y) \ X \\<^bsup>M\<^esup> Y" + apply (rule choice_ax_well_ord [THEN rexE], assumption) + apply (rule choice_ax_well_ord [THEN rexE, of Y], assumption) + apply (rule well_ord_cardinal_rel_eqE, assumption+) + done + +lemma cardinal_rel_eqpoll_rel_iff: "M(X) \ M(Y) \ |X|\<^bsup>M\<^esup> = |Y|\<^bsup>M\<^esup> \ X \\<^bsup>M\<^esup> Y" + by (blast intro: cardinal_rel_cong cardinal_rel_eqE) + +lemma cardinal_rel_disjoint_Un: + "[| |A|\<^bsup>M\<^esup>=|B|\<^bsup>M\<^esup>; |C|\<^bsup>M\<^esup>=|D|\<^bsup>M\<^esup>; A \ C = 0; B \ D = 0; M(A); M(B); M(C); M(D)|] + ==> |A \ C|\<^bsup>M\<^esup> = |B \ D|\<^bsup>M\<^esup>" + by (simp add: cardinal_rel_eqpoll_rel_iff eqpoll_rel_disjoint_Un) + +lemma lepoll_rel_imp_cardinal_rel_le: "A \\<^bsup>M\<^esup> B ==> M(A) \ M(B) \ |A|\<^bsup>M\<^esup> \ |B|\<^bsup>M\<^esup>" + apply (rule choice_ax_well_ord [THEN rexE]) prefer 2 + apply (erule well_ord_lepoll_rel_imp_cardinal_rel_le, assumption+) + done + +lemma cadd_rel_assoc: "\M(i); M(j); M(k)\ \ (i \\<^bsup>M\<^esup> j) \\<^bsup>M\<^esup> k = i \\<^bsup>M\<^esup> (j \\<^bsup>M\<^esup> k)" + apply (rule choice_ax_well_ord [THEN rexE]) prefer 2 + apply (rule choice_ax_well_ord [THEN rexE]) prefer 2 + apply (rule choice_ax_well_ord [THEN rexE]) prefer 2 + apply (rule well_ord_cadd_rel_assoc, assumption+) + done + +lemma cmult_rel_assoc: "\M(i); M(j); M(k)\ \ (i \\<^bsup>M\<^esup> j) \\<^bsup>M\<^esup> k = i \\<^bsup>M\<^esup> (j \\<^bsup>M\<^esup> k)" + apply (rule choice_ax_well_ord [THEN rexE]) prefer 2 + apply (rule choice_ax_well_ord [THEN rexE]) prefer 2 + apply (rule choice_ax_well_ord [THEN rexE]) prefer 2 + apply (rule well_ord_cmult_rel_assoc, assumption+) + done + +lemma cadd_cmult_distrib: "\M(i); M(j); M(k)\ \ (i \\<^bsup>M\<^esup> j) \\<^bsup>M\<^esup> k = (i \\<^bsup>M\<^esup> k) \\<^bsup>M\<^esup> (j \\<^bsup>M\<^esup> k)" + apply (rule choice_ax_well_ord [THEN rexE]) prefer 2 + apply (rule choice_ax_well_ord [THEN rexE]) prefer 2 + apply (rule choice_ax_well_ord [THEN rexE]) prefer 2 + apply (rule well_ord_cadd_cmult_distrib, assumption+) + done + + +lemma InfCard_rel_square_eq: "InfCard\<^bsup>M\<^esup>(|A|\<^bsup>M\<^esup>) \ M(A) \ A\A \\<^bsup>M\<^esup> A" + apply (rule choice_ax_well_ord [THEN rexE]) prefer 2 + apply (erule well_ord_InfCard_rel_square_eq, assumption, simp_all) + done + +subsection \The relationship between cardinality and le-pollence\ + +lemma Card_rel_le_imp_lepoll_rel: + assumes "|A|\<^bsup>M\<^esup> \ |B|\<^bsup>M\<^esup>" + and types: "M(A)" "M(B)" + shows "A \\<^bsup>M\<^esup> B" +proof - + have "A \\<^bsup>M\<^esup> |A|\<^bsup>M\<^esup>" + by (rule cardinal_rel_eqpoll_rel [THEN eqpoll_rel_sym], simp_all add:types) + also have "... \\<^bsup>M\<^esup> |B|\<^bsup>M\<^esup>" + by (rule le_imp_subset [THEN subset_imp_lepoll_rel]) (rule assms, simp_all add:types) + also have "... \\<^bsup>M\<^esup> B" + by (rule cardinal_rel_eqpoll_rel, simp_all add:types) + finally show ?thesis by (simp_all add:types) +qed + +lemma le_Card_rel_iff: "Card\<^bsup>M\<^esup>(K) ==> M(K) \ M(A) \ |A|\<^bsup>M\<^esup> \ K \ A \\<^bsup>M\<^esup> K" + apply (erule Card_rel_cardinal_rel_eq [THEN subst], assumption, rule iffI, + erule Card_rel_le_imp_lepoll_rel, assumption+) + apply (erule lepoll_rel_imp_cardinal_rel_le, assumption+) + done + +lemma cardinal_rel_0_iff_0 [simp]: "M(A) \ |A|\<^bsup>M\<^esup> = 0 \ A = 0" + using cardinal_rel_0 eqpoll_rel_0_iff [THEN iffD1] + cardinal_rel_eqpoll_rel_iff [THEN iffD1, OF _ nonempty] + by auto + +lemma cardinal_rel_lt_iff_lesspoll_rel: + assumes i: "Ord(i)" and + types: "M(i)" "M(A)" + shows "i < |A|\<^bsup>M\<^esup> \ i \\<^bsup>M\<^esup> A" +proof + assume "i < |A|\<^bsup>M\<^esup>" + hence "i \\<^bsup>M\<^esup> |A|\<^bsup>M\<^esup>" + by (blast intro: lt_Card_rel_imp_lesspoll_rel types) + also have "... \\<^bsup>M\<^esup> A" + by (rule cardinal_rel_eqpoll_rel) (simp_all add:types) + finally show "i \\<^bsup>M\<^esup> A" by (simp_all add:types) +next + assume "i \\<^bsup>M\<^esup> A" + also have "... \\<^bsup>M\<^esup> |A|\<^bsup>M\<^esup>" + by (blast intro: cardinal_rel_eqpoll_rel eqpoll_rel_sym types) + finally have "i \\<^bsup>M\<^esup> |A|\<^bsup>M\<^esup>" by (simp_all add:types) + thus "i < |A|\<^bsup>M\<^esup>" using i types + by (force intro: cardinal_rel_lt_imp_lt lesspoll_rel_cardinal_rel_lt) +qed + +lemma cardinal_rel_le_imp_lepoll_rel: " i \ |A|\<^bsup>M\<^esup> ==> M(i) \ M(A) \i \\<^bsup>M\<^esup> A" + by (blast intro: lt_Ord Card_rel_le_imp_lepoll_rel Ord_cardinal_rel_le le_trans) + + +subsection\Other Applications of AC\ + +text\We have an example of instantiating a locale involving higher +order variables inside a proof, by using the assumptions of the +first order, active locale.\ + +lemma surj_rel_implies_inj_rel: + assumes f: "f \ surj\<^bsup>M\<^esup>(X,Y)" and + types: "M(f)" "M(X)" "M(Y)" + shows "\g[M]. g \ inj\<^bsup>M\<^esup>(Y,X)" +proof - + from types + interpret M_Pi_assumptions_choice _ Y "\y. f-``{y}" + by unfold_locales (auto intro:surj_imp_inj_replacement dest:transM) + from f AC_Pi_rel + obtain z where z: "z \ Pi\<^bsup>M\<^esup>(Y, \y. f -`` {y})" + \ \In this and the following ported result, it is not clear how + uniformly are "\_char" theorems to be used\ + using surj_rel_char + by (auto simp add: surj_def types) (fast dest: apply_Pair) + show ?thesis + proof + show "z \ inj\<^bsup>M\<^esup>(Y, X)" "M(z)" + using z surj_is_fun[of f X Y] f Pi_rel_char + by (auto dest: apply_type Pi_memberD + intro: apply_equality Pi_type f_imp_injective + simp add:types mem_surj_abs) + qed +qed + + +text\Kunen's Lemma 10.20\ +lemma surj_rel_implies_cardinal_rel_le: + assumes f: "f \ surj\<^bsup>M\<^esup>(X,Y)" and + types:"M(f)" "M(X)" "M(Y)" + shows "|Y|\<^bsup>M\<^esup> \ |X|\<^bsup>M\<^esup>" +proof (rule lepoll_rel_imp_cardinal_rel_le) + from f [THEN surj_rel_implies_inj_rel] + obtain g where "g \ inj\<^bsup>M\<^esup>(Y,X)" + by (blast intro:types) + then + show "Y \\<^bsup>M\<^esup> X" + using inj_rel_char + by (auto simp add: def_lepoll_rel types) +qed (simp_all add:types) + +end \ \\<^locale>\M_cardinal_AC\\ + +text\The set-theoretic universe.\ + +abbreviation + Universe :: "i\o" (\\\) where + "\(x) \ True" + +lemma separation_absolute: "separation(\, P)" + unfolding separation_def + by (rule rallI, rule_tac x="{x\_ . P(x)}" in rexI) auto + +lemma univalent_absolute: + assumes "univalent(\, A, P)" "P(x, b)" "x \ A" + shows "P(x, y) \ y = b" + using assms + unfolding univalent_def by force + +lemma replacement_absolute: "strong_replacement(\, P)" + unfolding strong_replacement_def +proof (intro rallI impI) + fix A + assume "univalent(\, A, P)" + then + show "\Y[\]. \b[\]. b \ Y \ (\x[\]. x \ A \ P(x, b))" + by (rule_tac x="{y. x\A , P(x,y)}" in rexI) + (auto dest:univalent_absolute[of _ P]) +qed + +lemma Union_ax_absolute: "Union_ax(\)" + unfolding Union_ax_def big_union_def + by (auto intro:rexI[of _ "\_"]) + +lemma upair_ax_absolute: "upair_ax(\)" + unfolding upair_ax_def upair_def rall_def rex_def + by (auto) + +lemma power_ax_absolute:"power_ax(\)" +proof - + { + fix x + have "\y[\]. y \ Pow(x) \ (\z[\]. z \ y \ z \ x)" + by auto + } + then + show "power_ax(\)" + unfolding power_ax_def powerset_def subset_def by blast +qed + +locale M_cardinal_UN = M_Pi_assumptions_choice _ K X for K X + + assumes + \ \The next assumption is required by @{thm Least_closed}\ + X_witness_in_M: "w \ X(x) \ M(x)" + and + lam_m_replacement:"M(f) \ strong_replacement(M, + \x y. y = \x, \ i. x \ X(i), f ` (\ i. x \ X(i)) ` x\)" + and + inj_replacement: + "M(x) \ strong_replacement(M, \y z. y \ inj\<^bsup>M\<^esup>(X(x), K) \ z = {\x, y\})" + "strong_replacement(M, \x y. y = inj\<^bsup>M\<^esup>(X(x), K))" + "strong_replacement(M, + \x z. z = Sigfun(x, \i. inj\<^bsup>M\<^esup>(X(i), K)))" + "M(r) \ strong_replacement(M, + \x y. y = \x, minimum(r, inj\<^bsup>M\<^esup>(X(x), K))\)" + +begin + +lemma UN_closed: "M(\i\K. X(i))" + using family_union_closed B_replacement Pi_assumptions by simp + +text\Kunen's Lemma 10.21\ +lemma cardinal_rel_UN_le: + assumes K: "InfCard\<^bsup>M\<^esup>(K)" + shows "(\i. i\K \ |X(i)|\<^bsup>M\<^esup> \ K) \ |\i\K. X(i)|\<^bsup>M\<^esup> \ K" +proof (simp add: K InfCard_rel_is_Card_rel le_Card_rel_iff Pi_assumptions) + have "M(f) \ M(\x\(\x\K. X(x)). \\ i. x \ X(i), f ` (\ i. x \ X(i)) ` x\)" for f + using lam_m_replacement X_witness_in_M Least_closed' Pi_assumptions UN_closed + by (rule_tac lam_closed) (auto dest:transM) + note types = this Pi_assumptions UN_closed + have [intro]: "Ord(K)" by (blast intro: InfCard_rel_is_Card_rel + Card_rel_is_Ord K types) + interpret pii:M_Pi_assumptions_choice _ K "\i. inj\<^bsup>M\<^esup>(X(i), K)" + using inj_replacement Pi_assumptions transM[of _ K] + by unfold_locales (simp_all del:mem_inj_abs) + assume asm:"\i. i\K \ X(i) \\<^bsup>M\<^esup> K" + then + have "\i. i\K \ M(inj\<^bsup>M\<^esup>(X(i), K))" + by (auto simp add: types) + interpret V:M_N_Perm M "\" + using separation_absolute replacement_absolute Union_ax_absolute + power_ax_absolute upair_ax_absolute + by unfold_locales auto + note bad_simps[simp del] = V.N.Forall_in_M_iff V.N.Equal_in_M_iff + V.N.nonempty + have abs:"inj_rel(\,x,y) = inj(x,y)" for x y + using V.N.inj_rel_char by simp + from asm + have "\i. i\K \ \f[M]. f \ inj\<^bsup>M\<^esup>(X(i), K)" + by (simp add: types def_lepoll_rel) + then + obtain f where "f \ (\i\K. inj\<^bsup>M\<^esup>(X(i), K))" "M(f)" + using pii.AC_Pi_rel pii.Pi_rel_char by auto + with abs + have f:"f \ (\i\K. inj(X(i), K))" + using Pi_weaken_type[OF _ V.inj_rel_transfer, of f K X "\_. K"] + Pi_assumptions by simp + { fix z + assume z: "z \ (\i\K. X(i))" + then obtain i where i: "i \ K" "Ord(i)" "z \ X(i)" + by (blast intro: Ord_in_Ord [of K]) + hence "(\ i. z \ X(i)) \ i" by (fast intro: Least_le) + hence "(\ i. z \ X(i)) < K" by (best intro: lt_trans1 ltI i) + hence "(\ i. z \ X(i)) \ K" and "z \ X(\ i. z \ X(i))" + by (auto intro: LeastI ltD i) + } note mems = this + have "(\i\K. X(i)) \\<^bsup>M\<^esup> K \ K" + proof (simp add:types def_lepoll_rel) + show "\f[M]. f \ inj(\x\K. X(x), K \ K)" + apply (rule rexI) + apply (rule_tac c = "\z. \\ i. z \ X(i), f ` (\ i. z \ X(i)) ` z\" + and d = "\\i,j\. converse (f`i) ` j" in lam_injective) + apply (force intro: f inj_is_fun mems apply_type Perm.left_inverse)+ + apply (simp add:types \M(f)\) + done + qed + also have "... \\<^bsup>M\<^esup> K" + by (simp add: K InfCard_rel_square_eq InfCard_rel_is_Card_rel + Card_rel_cardinal_rel_eq types) + finally have "(\i\K. X(i)) \\<^bsup>M\<^esup> K" by (simp_all add:types) + then + show ?thesis + by (simp add: K InfCard_rel_is_Card_rel le_Card_rel_iff types) +qed + +end \ \\<^locale>\M_cardinal_UN\\ + +end \ No newline at end of file diff --git a/thys/Transitive_Models/Cardinal_Library_Relative.thy b/thys/Transitive_Models/Cardinal_Library_Relative.thy new file mode 100644 --- /dev/null +++ b/thys/Transitive_Models/Cardinal_Library_Relative.thy @@ -0,0 +1,1260 @@ +section\Cardinal Arithmetic under Choice\label{sec:cardinal-lib-rel}\ + +theory Cardinal_Library_Relative + imports + Replacement_Lepoll +begin + +locale M_library = M_ZF_library + M_cardinal_AC + + assumes + separation_cardinal_rel_lesspoll_rel: "M(\) \ separation(M, \x . x \\<^bsup>M\<^esup> \)" +begin + +declare eqpoll_rel_refl [simp] + +subsection\Miscellaneous\ + +lemma cardinal_rel_RepFun_apply_le: + assumes "S \ A\B" "M(S)" "M(A)" "M(B)" + shows "|{S`a . a\A}|\<^bsup>M\<^esup> \ |A|\<^bsup>M\<^esup>" +proof - + note assms + moreover from this + have "{S ` a . a \ A} = S``A" + using image_eq_UN RepFun_def UN_iff by force + moreover from calculation + have "M(\x\A. S ` x)" "M({S ` a . a \ A})" + using lam_closed[of "\ x. S`x"] apply_type[OF \S\_\] + transM[OF _ \M(B)\] image_closed + by auto + moreover from assms this + have "(\x\A. S`x) \ surj_rel(M,A, {S`a . a\A})" + using mem_surj_abs lam_funtype[of A "\x . S`x"] + unfolding surj_def by auto + ultimately + show ?thesis + using surj_rel_char surj_rel_implies_cardinal_rel_le by simp +qed + +(* TODO: Check if we can use this lemma to prove the previous one and + not the other way around *) +lemma cardinal_rel_RepFun_le: + assumes lrf:"lam_replacement(M,f)" and f_closed:"\x[M]. M(f(x))" and "M(X)" + shows "|{f(x) . x \ X}|\<^bsup>M\<^esup> \ |X|\<^bsup>M\<^esup>" + using \M(X)\ f_closed cardinal_rel_RepFun_apply_le[OF lam_funtype, of X _, OF + lrf[THEN [2] lam_replacement_iff_lam_closed[THEN iffD1, THEN rspec]]] + lrf[THEN lam_replacement_imp_strong_replacement] + by simp (auto simp flip:setclass_iff intro!:RepFun_closed dest:transM) + +lemma subset_imp_le_cardinal_rel: "A \ B \ M(A) \ M(B) \ |A|\<^bsup>M\<^esup> \ |B|\<^bsup>M\<^esup>" + using subset_imp_lepoll_rel[THEN lepoll_rel_imp_cardinal_rel_le] . + +lemma lt_cardinal_rel_imp_not_subset: "|A|\<^bsup>M\<^esup> < |B|\<^bsup>M\<^esup> \ M(A) \ M(B) \ \ B \ A" + using subset_imp_le_cardinal_rel le_imp_not_lt by blast + +lemma cardinal_rel_lt_csucc_rel_iff: + "Card_rel(M,K) \ M(K) \ M(K') \ |K'|\<^bsup>M\<^esup> < (K\<^sup>+)\<^bsup>M\<^esup> \ |K'|\<^bsup>M\<^esup> \ K" + by (simp add: Card_rel_lt_csucc_rel_iff) + +end \ \\<^locale>\M_library\\ + +locale M_cardinal_UN_nat = M_cardinal_UN _ \ X for X +begin +lemma cardinal_rel_UN_le_nat: + assumes "\i. i\\ \ |X(i)|\<^bsup>M\<^esup> \ \" + shows "|\i\\. X(i)|\<^bsup>M\<^esup> \ \" +proof - + from assms + show ?thesis + by (simp add: cardinal_rel_UN_le InfCard_rel_nat) +qed + +end \ \\<^locale>\M_cardinal_UN_nat\\ + +locale M_cardinal_UN_inj = M_library + + j:M_cardinal_UN _ J + + y:M_cardinal_UN _ K "\k. if k\range(f) then X(converse(f)`k) else 0" for J K f + +assumes + f_inj: "f \ inj_rel(M,J,K)" +begin + +lemma inj_rel_imp_cardinal_rel_UN_le: + notes [dest] = InfCard_is_Card Card_is_Ord + fixes Y + defines "Y(k) \ if k\range(f) then X(converse(f)`k) else 0" + assumes "InfCard\<^bsup>M\<^esup>(K)" "\i. i\J \ |X(i)|\<^bsup>M\<^esup> \ K" + shows "|\i\J. X(i)|\<^bsup>M\<^esup> \ K" +proof - + have "M(K)" "M(J)" "\w x. w \ X(x) \ M(x)" + using y.Pi_assumptions j.Pi_assumptions j.X_witness_in_M by simp_all + then + have "M(f)" + using inj_rel_char f_inj by simp + note inM = \M(f)\ \M(K)\ \M(J)\ \\w x. w \ X(x) \ M(x)\ + have "i\J \ f`i \ K" for i + using inj_rel_is_fun[OF f_inj] apply_type + function_space_rel_char by (auto simp add:inM) + have "(\i\J. X(i)) \ (\i\K. Y(i))" + proof (standard, elim UN_E) + fix x i + assume "i\J" "x\X(i)" + with \i\J \ f`i \ K\ + have "x \ Y(f`i)" "f`i \ K" + unfolding Y_def + using inj_is_fun right_inverse f_inj + by (auto simp add:inM Y_def intro: apply_rangeI) + then + show "x \ (\i\K. Y(i))" by auto + qed + then + have "|\i\J. X(i)|\<^bsup>M\<^esup> \ |\i\K. Y(i)|\<^bsup>M\<^esup>" + using subset_imp_le_cardinal_rel j.UN_closed y.UN_closed + unfolding Y_def by (simp add:inM) + moreover + note assms \\i. i\J \ f`i \ K\ inM + moreover from this + have "k\range(f) \ converse(f)`k \ J" for k + using inj_rel_converse_fun[OF f_inj] + range_fun_subset_codomain function_space_rel_char by simp + ultimately + show "|\i\J. X(i)|\<^bsup>M\<^esup> \ K" + using InfCard_rel_is_Card_rel[THEN Card_rel_is_Ord,THEN Ord_0_le, of K] + by (rule_tac le_trans[OF _ y.cardinal_rel_UN_le]) + (auto intro:Ord_0_le simp:Y_def)+ +qed + +end \ \\<^locale>\M_cardinal_UN_inj\\ + +locale M_cardinal_UN_lepoll = M_library + M_replacement_lepoll _ "\_. X" + + j:M_cardinal_UN _ J for J +begin + +(* FIXME: this "LEQpoll" should be "LEPOLL"; same correction in Delta System *) +lemma leqpoll_rel_imp_cardinal_rel_UN_le: + notes [dest] = InfCard_is_Card Card_is_Ord + assumes "InfCard\<^bsup>M\<^esup>(K)" "J \\<^bsup>M\<^esup> K" "\i. i\J \ |X(i)|\<^bsup>M\<^esup> \ K" + "M(K)" + shows "|\i\J. X(i)|\<^bsup>M\<^esup> \ K" +proof - + from \J \\<^bsup>M\<^esup> K\ + obtain f where "f \ inj_rel(M,J,K)" "M(f)" by blast + moreover + let ?Y="\k. if k\range(f) then X(converse(f)`k) else 0" + note \M(K)\ + moreover from calculation + have "k \ range(f) \ converse(f)`k \ J" for k + using mem_inj_rel[THEN inj_converse_fun, THEN apply_type] + j.Pi_assumptions by blast + moreover from \M(f)\ + have "w \ ?Y(x) \ M(x)" for w x + by (cases "x\range(f)") (auto dest:transM) + moreover from calculation + interpret M_Pi_assumptions_choice _ K ?Y + using j.Pi_assumptions lepoll_assumptions + proof (unfold_locales, auto dest:transM) + show "strong_replacement(M, \y z. False)" + unfolding strong_replacement_def by auto + qed + from calculation + interpret M_cardinal_UN_inj _ _ _ _ f + using lepoll_assumptions + by unfold_locales auto + from assms + show ?thesis using inj_rel_imp_cardinal_rel_UN_le by simp +qed + +end \ \\<^locale>\M_cardinal_UN_lepoll\\ + +context M_library +begin + +lemma cardinal_rel_lt_csucc_rel_iff': + includes Ord_dests + assumes "Card_rel(M,\)" + and types:"M(\)" "M(X)" + shows "\ < |X|\<^bsup>M\<^esup> \ (\\<^sup>+)\<^bsup>M\<^esup> \ |X|\<^bsup>M\<^esup>" + using assms cardinal_rel_lt_csucc_rel_iff[of \ X] Card_rel_csucc_rel[of \] + not_le_iff_lt[of "(\\<^sup>+)\<^bsup>M\<^esup>" "|X|\<^bsup>M\<^esup>"] not_le_iff_lt[of "|X|\<^bsup>M\<^esup>" \] + by blast + +lemma lepoll_rel_imp_subset_bij_rel: + assumes "M(X)" "M(Y)" + shows "X \\<^bsup>M\<^esup> Y \ (\Z[M]. Z \ Y \ Z \\<^bsup>M\<^esup> X)" +proof + assume "X \\<^bsup>M\<^esup> Y" + then + obtain j where "j \ inj_rel(M,X,Y)" + by blast + with assms + have "range(j) \ Y" "j \ bij_rel(M,X,range(j))" "M(range(j))" "M(j)" + using inj_rel_bij_rel_range inj_rel_char + inj_rel_is_fun[THEN range_fun_subset_codomain,of j X Y] + by auto + with assms + have "range(j) \ Y" "X \\<^bsup>M\<^esup> range(j)" + unfolding eqpoll_rel_def by auto + with assms \M(j)\ + show "\Z[M]. Z \ Y \ Z \\<^bsup>M\<^esup> X" + using eqpoll_rel_sym[OF \X \\<^bsup>M\<^esup> range(j)\] + by auto +next + assume "\Z[M]. Z \ Y \ Z \\<^bsup>M\<^esup> X" + then + obtain Z f where "f \ bij_rel(M,Z,X)" "Z \ Y" "M(Z)" "M(f)" + unfolding eqpoll_rel_def by blast + with assms + have "converse(f) \ inj_rel(M,X,Y)" "M(converse(f))" + using inj_rel_weaken_type[OF bij_rel_converse_bij_rel[THEN bij_rel_is_inj_rel],of f Z X Y] + by auto + then + show "X \\<^bsup>M\<^esup> Y" + unfolding lepoll_rel_def by auto +qed + +text\The following result proves to be very useful when combining + \<^term>\cardinal_rel\ and \<^term>\eqpoll_rel\ in a calculation.\ + +lemma cardinal_rel_Card_rel_eqpoll_rel_iff: + "Card_rel(M,\) \ M(\) \ M(X) \ |X|\<^bsup>M\<^esup> = \ \ X \\<^bsup>M\<^esup> \" + using Card_rel_cardinal_rel_eq[of \] cardinal_rel_eqpoll_rel_iff[of X \] by auto + +lemma lepoll_rel_imp_lepoll_rel_cardinal_rel: + assumes"X \\<^bsup>M\<^esup> Y" "M(X)" "M(Y)" + shows "X \\<^bsup>M\<^esup> |Y|\<^bsup>M\<^esup>" + using assms cardinal_rel_Card_rel_eqpoll_rel_iff[of "|Y|\<^bsup>M\<^esup>" Y] + Card_rel_cardinal_rel + lepoll_rel_eq_trans[of _ _ "|Y|\<^bsup>M\<^esup>"] by simp + +lemma lepoll_rel_Un: + assumes "InfCard_rel(M,\)" "A \\<^bsup>M\<^esup> \" "B \\<^bsup>M\<^esup> \" "M(A)" "M(B)" "M(\)" + shows "A \ B \\<^bsup>M\<^esup> \" +proof - + from assms + have "A \ B \\<^bsup>M\<^esup> sum(A,B)" + using Un_lepoll_rel_sum by simp + moreover + note assms + moreover from this + have "|sum(A,B)|\<^bsup>M\<^esup> \ \ \\<^bsup>M\<^esup> \" + using sum_lepoll_rel_mono[of A \ B \] lepoll_rel_imp_cardinal_rel_le + unfolding cadd_rel_def by auto + ultimately + show ?thesis + using InfCard_rel_cdouble_eq Card_rel_cardinal_rel_eq + InfCard_rel_is_Card_rel Card_rel_le_imp_lepoll_rel[of "sum(A,B)" \] + lepoll_rel_trans[of "A\B"] + by auto +qed + +lemma cardinal_rel_Un_le: + assumes "InfCard_rel(M,\)" "|A|\<^bsup>M\<^esup> \ \" "|B|\<^bsup>M\<^esup> \ \" "M(\)" "M(A)" "M(B)" + shows "|A \ B|\<^bsup>M\<^esup> \ \" + using assms lepoll_rel_Un le_Card_rel_iff InfCard_rel_is_Card_rel by auto + +lemma Finite_cardinal_rel_iff': "M(i) \ Finite(|i|\<^bsup>M\<^esup>) \ Finite(i)" + using eqpoll_rel_imp_Finite_iff[OF cardinal_rel_eqpoll_rel] + by auto + +lemma cardinal_rel_subset_of_Card_rel: + assumes "Card_rel(M,\)" "a \ \" "M(a)" "M(\)" + shows "|a|\<^bsup>M\<^esup> < \ \ |a|\<^bsup>M\<^esup> = \" +proof - + from assms + have "|a|\<^bsup>M\<^esup> < |\|\<^bsup>M\<^esup> \ |a|\<^bsup>M\<^esup> = |\|\<^bsup>M\<^esup>" + using subset_imp_le_cardinal_rel[THEN le_iff[THEN iffD1]] by simp + with assms + show ?thesis + using Card_rel_cardinal_rel_eq by auto +qed + +lemma cardinal_rel_cases: + includes Ord_dests + assumes "M(\)" "M(X)" + shows "Card_rel(M,\) \ |X|\<^bsup>M\<^esup> < \ \ \ |X|\<^bsup>M\<^esup> \ \" + using assms not_le_iff_lt Card_rel_is_Ord Ord_cardinal_rel + by auto + +end \ \\<^locale>\M_library\\ + +subsection\Countable and uncountable sets\ + +definition (* FIXME: From Cardinal_Library, on the context of AC *) + countable :: "i\o" where + "countable(X) \ X \ \" + +relativize functional "countable" "countable_rel" external +relationalize "countable_rel" "is_countable" + +notation countable_rel (\countable\<^bsup>_\<^esup>'(_')\) + +abbreviation + countable_r_set :: "[i,i]\o" (\countable\<^bsup>_\<^esup>'(_')\) where + "countable\<^bsup>M\<^esup>(i) \ countable_rel(##M,i)" + +context M_library +begin + +lemma countableI[intro]: "X \\<^bsup>M\<^esup> \ \ countable_rel(M,X)" + unfolding countable_rel_def by simp + +lemma countableD[dest]: "countable_rel(M,X) \ X \\<^bsup>M\<^esup> \" + unfolding countable_rel_def by simp + +lemma countable_rel_iff_cardinal_rel_le_nat: "M(X) \ countable_rel(M,X) \ |X|\<^bsup>M\<^esup> \ \" + using le_Card_rel_iff[of \ X] Card_rel_nat + unfolding countable_rel_def by simp + +lemma lepoll_rel_countable_rel: "X \\<^bsup>M\<^esup> Y \ countable_rel(M,Y) \ M(X) \ M(Y) \ countable_rel(M,X)" + using lepoll_rel_trans[of X Y] by blast + +\ \Next lemma can be proved without using AC\ +lemma surj_rel_countable_rel: + "countable_rel(M,X) \ f \ surj_rel(M,X,Y) \ M(X) \ M(Y) \ M(f) \ countable_rel(M,Y)" + using surj_rel_implies_cardinal_rel_le[of f X Y, THEN le_trans] + countable_rel_iff_cardinal_rel_le_nat by simp + +lemma Finite_imp_countable_rel: "Finite_rel(M,X) \ M(X) \ countable_rel(M,X)" + unfolding Finite_rel_def + by (auto intro:InfCard_rel_nat nats_le_InfCard_rel[of _ \, + THEN le_imp_lepoll_rel] dest!:eq_lepoll_rel_trans[of X _ \] ) + +end \ \\<^locale>\M_library\\ + +lemma (in M_cardinal_UN_lepoll) countable_rel_imp_countable_rel_UN: + assumes "countable_rel(M,J)" "\i. i\J \ countable_rel(M,X(i))" + shows "countable_rel(M,\i\J. X(i))" + using assms leqpoll_rel_imp_cardinal_rel_UN_le[of \] InfCard_rel_nat + InfCard_rel_is_Card_rel j.UN_closed + countable_rel_iff_cardinal_rel_le_nat j.Pi_assumptions + Card_rel_le_imp_lepoll_rel[of J \] Card_rel_cardinal_rel_eq[of \] + by auto + +locale M_cardinal_library = M_library + M_replacement + + assumes + lam_replacement_inj_rel:"lam_replacement(M, \x. inj\<^bsup>M\<^esup>(fst(x),snd(x)))" + and + cdlt_assms: "M(G) \ M(Q) \ separation(M, \p. \x\G. x \ snd(p) \ (\s\fst(p). \s, x\ \ Q))" + and + cardinal_lib_assms1: + "M(A) \ M(b) \ M(f) \ + separation(M, \y. \x\A. y = \x, \ i. x \ if_range_F_else_F(\x. if M(x) then x else 0,b,f,i)\)" + and + cardinal_lib_assms2: + "M(A') \ M(G) \ M(b) \ M(f) \ + separation(M, \y. \x\A'. y = \x, \ i. x \ if_range_F_else_F(\a. if M(a) then G`a else 0,b,f,i)\)" + and + cardinal_lib_assms3: + "M(A') \ M(b) \ M(f) \ M(F) \ + separation(M, \y. \x\A'. y = \x, \ i. x \ if_range_F_else_F(\a. if M(a) then F-``{a} else 0,b,f,i)\)" + and + lam_replacement_cardinal_rel : "lam_replacement(M, cardinal_rel(M))" + and + cardinal_lib_assms6: + "M(f) \ M(\) \ Ord(\) \ + strong_replacement(M, \x y. x\\ \ y = \x, transrec(x, \a g. f ` (g `` a))\)" + +begin + +lemma cardinal_lib_assms5 : + "M(\) \ Ord(\) \ separation(M, \Z . cardinal_rel(M,Z) < \)" + unfolding lt_def + using separation_in lam_replacement_constant[of \] separation_univ lam_replacement_cardinal_rel + unfolding lt_def + by simp_all + +lemma separation_dist: "separation(M, \ x . \a. \b . x=\a,b\ \ a\b)" + using separation_pair separation_neg separation_eq lam_replacement_fst lam_replacement_snd + by simp + +lemma cdlt_assms': "M(x) \ M(Q) \ separation(M, \a . \s\x. \s, a\ \ Q)" + using separation_in[OF _ + lam_replacement_hcomp2[OF _ _ _ _ lam_replacement_Pair] _ + lam_replacement_constant] + separation_ball lam_replacement_hcomp lam_replacement_fst lam_replacement_snd + by simp_all + +lemma countable_rel_union_countable_rel: + assumes "\x. x \ C \ countable_rel(M,x)" "countable_rel(M,C)" "M(C)" + shows "countable_rel(M,\C)" +proof - + have "x \ (if M(i) then i else 0) \ M(i)" for x i + by (cases "M(i)") auto + then + interpret M_replacement_lepoll M "\_ x. if M(x) then x else 0" + using lam_replacement_if[OF lam_replacement_identity + lam_replacement_constant[OF nonempty], where b=M] lam_replacement_inj_rel + proof(unfold_locales,auto simp add: separation_def) + fix b f + assume "M(b)" "M(f)" + show "lam_replacement(M, \x. \ i. x \ if_range_F_else_F(\x. if M(x) then x else 0, b, f, i))" + proof (cases "b=0") + case True + with \M(f)\ + show ?thesis + using cardinal_lib_assms1 + by (simp_all; rule_tac lam_Least_assumption_ifM_b0)+ + next + case False + with \M(f)\ \M(b)\ + show ?thesis + using cardinal_lib_assms1 separation_Ord + by (rule_tac lam_Least_assumption_ifM_bnot0) auto + qed + qed + note \M(C)\ + moreover + have "w \ (if M(x) then x else 0) \ M(x)" for w x + by (cases "M(x)") auto + ultimately + interpret M_cardinal_UN_lepoll _ "\c. if M(c) then c else 0" C + using lepoll_assumptions + by unfold_locales simp_all + have "(if M(i) then i else 0) = i" if "i\C" for i + using transM[OF _ \M(C)\] that by simp + then + show ?thesis + using assms countable_rel_imp_countable_rel_UN by simp +qed + +end \ \\<^locale>\M_cardinal_library\\ + +abbreviation + uncountable_rel :: "[i\o,i]\o" where + "uncountable_rel(M,X) \ \ countable_rel(M,X)" + +context M_cardinal_library +begin + +lemma uncountable_rel_iff_nat_lt_cardinal_rel: + "M(X) \ uncountable_rel(M,X) \ \ < |X|\<^bsup>M\<^esup>" + using countable_rel_iff_cardinal_rel_le_nat not_le_iff_lt by simp + +lemma uncountable_rel_not_empty: "uncountable_rel(M,X) \ X \ 0" + using empty_lepoll_relI by auto + +lemma uncountable_rel_imp_Infinite: "uncountable_rel(M,X) \ M(X) \ Infinite(X)" + using uncountable_rel_iff_nat_lt_cardinal_rel[of X] lepoll_rel_nat_imp_Infinite[of X] + cardinal_rel_le_imp_lepoll_rel[of \ X] leI + by simp + +lemma uncountable_rel_not_subset_countable_rel: + assumes "countable_rel(M,X)" "uncountable_rel(M,Y)" "M(X)" "M(Y)" + shows "\ (Y \ X)" + using assms lepoll_rel_trans subset_imp_lepoll_rel[of Y X] + by blast + + +subsection\Results on Aleph\_rels\ + +lemma nat_lt_Aleph_rel1: "\ < \\<^bsub>1\<^esub>\<^bsup>M\<^esup>" + by (simp add: Aleph_rel_succ Aleph_rel_zero lt_csucc_rel) + +lemma zero_lt_Aleph_rel1: "0 < \\<^bsub>1\<^esub>\<^bsup>M\<^esup>" + by (rule lt_trans[of _ "\"], auto simp add: ltI nat_lt_Aleph_rel1) + +lemma le_Aleph_rel1_nat: "M(k) \ Card_rel(M,k) \ k<\\<^bsub>1\<^esub>\<^bsup>M\<^esup> \ k \ \" + by (simp add: Aleph_rel_succ Aleph_rel_zero Card_rel_lt_csucc_rel_iff Card_rel_nat) + +lemma lesspoll_rel_Aleph_rel_succ: + assumes "Ord(\)" + and types:"M(\)" "M(d)" + shows "d \\<^bsup>M\<^esup> \\<^bsub>succ(\)\<^esub>\<^bsup>M\<^esup> \ d \\<^bsup>M\<^esup> \\<^bsub>\\<^esub>\<^bsup>M\<^esup>" + using assms Aleph_rel_succ Card_rel_is_Ord Ord_Aleph_rel lesspoll_rel_csucc_rel + by simp + +lemma cardinal_rel_Aleph_rel [simp]: "Ord(\) \ M(\) \ |\\<^bsub>\\<^esub>\<^bsup>M\<^esup>|\<^bsup>M\<^esup> = \\<^bsub>\\<^esub>\<^bsup>M\<^esup>" + using Card_rel_cardinal_rel_eq by simp + +\ \Could be proved without using AC\ +lemma Aleph_rel_lesspoll_rel_increasing: + includes Aleph_rel_intros + assumes "M(b)" "M(a)" + shows "a < b \ \\<^bsub>a\<^esub>\<^bsup>M\<^esup> \\<^bsup>M\<^esup> \\<^bsub>b\<^esub>\<^bsup>M\<^esup>" + using assms + cardinal_rel_lt_iff_lesspoll_rel[of "\\<^bsub>a\<^esub>\<^bsup>M\<^esup>" "\\<^bsub>b\<^esub>\<^bsup>M\<^esup>"] + Aleph_rel_increasing[of a b] Card_rel_cardinal_rel_eq[of "\\<^bsub>b\<^esub>"] + lt_Ord lt_Ord2 Card_rel_Aleph_rel[THEN Card_rel_is_Ord] + by auto + +lemma uncountable_rel_iff_subset_eqpoll_rel_Aleph_rel1: + includes Ord_dests + assumes "M(X)" + notes Aleph_rel_zero[simp] Card_rel_nat[simp] Aleph_rel_succ[simp] + shows "uncountable_rel(M,X) \ (\S[M]. S \ X \ S \\<^bsup>M\<^esup> \\<^bsub>1\<^esub>\<^bsup>M\<^esup>)" +proof + assume "uncountable_rel(M,X)" + with \M(X)\ + have "\\<^bsub>1\<^esub>\<^bsup>M\<^esup> \\<^bsup>M\<^esup> X" + using uncountable_rel_iff_nat_lt_cardinal_rel cardinal_rel_lt_csucc_rel_iff' + cardinal_rel_le_imp_lepoll_rel by auto + with \M(X)\ + obtain S where "M(S)" "S \ X" "S \\<^bsup>M\<^esup> \\<^bsub>1\<^esub>\<^bsup>M\<^esup>" + using lepoll_rel_imp_subset_bij_rel by auto + then + show "\S[M]. S \ X \ S \\<^bsup>M\<^esup> \\<^bsub>1\<^esub>\<^bsup>M\<^esup>" + using cardinal_rel_cong Card_rel_csucc_rel[of \] Card_rel_cardinal_rel_eq by auto +next + note Aleph_rel_lesspoll_rel_increasing[of 1 0,simplified] + assume "\S[M]. S \ X \ S \\<^bsup>M\<^esup> \\<^bsub>1\<^esub>\<^bsup>M\<^esup>" + moreover + have eq:"\\<^bsub>1\<^esub>\<^bsup>M\<^esup> = (\\<^sup>+)\<^bsup>M\<^esup>" by auto + moreover from calculation \M(X)\ + have A:"(\\<^sup>+)\<^bsup>M\<^esup> \\<^bsup>M\<^esup> X" + using subset_imp_lepoll_rel[THEN [2] eq_lepoll_rel_trans, of "\\<^bsub>1\<^esub>\<^bsup>M\<^esup>" _ X, + OF eqpoll_rel_sym] by auto + with \M(X)\ + show "uncountable_rel(M,X)" + using + lesspoll_rel_trans1[OF lepoll_rel_trans[OF A _] \\ \\<^bsup>M\<^esup> (\\<^sup>+)\<^bsup>M\<^esup>\] + lesspoll_rel_not_refl + by auto +qed + +lemma UN_if_zero: "M(K) \ (\x\K. if M(x) then G ` x else 0) =(\x\K. G ` x)" + using transM[of _ K] by auto + +lemma mem_F_bound1: + fixes F G + defines "F \ \_ x. if M(x) then G`x else 0" + shows "x\F(A,c) \ c \ (range(f) \ domain(G) )" + using apply_0 unfolding F_def + by (cases "M(c)", auto simp:F_def drSR_Y_def dC_F_def) + +lemma lt_Aleph_rel_imp_cardinal_rel_UN_le_nat: "function(G) \ domain(G) \\<^bsup>M\<^esup> \ \ + \n\domain(G). |G`n|\<^bsup>M\<^esup><\\<^bsub>1\<^esub>\<^bsup>M\<^esup> \ M(G) \ |\n\domain(G). G`n|\<^bsup>M\<^esup>\\" +proof - + assume "M(G)" + moreover from this + have "x \ (if M(i) then G ` i else 0) \ M(i)" for x i + by (cases "M(i)") auto + moreover + have "separation(M, M)" unfolding separation_def by auto + ultimately + interpret M_replacement_lepoll M "\_ x. if M(x) then G`x else 0" + using lam_replacement_inj_rel cardinal_lib_assms2 mem_F_bound1[of _ _ G] + lam_if_then_replacement_apply + by (unfold_locales, simp_all) + (rule lam_Least_assumption_general[where U="\_. domain(G)"], auto) + note \M(G)\ + moreover + have "w \ (if M(x) then G ` x else 0) \ M(x)" for w x + by (cases "M(x)") auto + ultimately + interpret M_cardinal_UN_lepoll _ "\n. if M(n) then G`n else 0" "domain(G)" + using lepoll_assumptions1[where S="domain(G)",unfolded lepoll_assumptions1_def] + cardinal_lib_assms2 lepoll_assumptions + by (unfold_locales, auto) + assume "function(G)" + let ?N="domain(G)" and ?R="\n\domain(G). G`n" + assume "?N \\<^bsup>M\<^esup> \" + assume Eq1: "\n\?N. |G`n|\<^bsup>M\<^esup><\\<^bsub>1\<^esub>\<^bsup>M\<^esup>" + { + fix n + assume "n\?N" + with Eq1 \M(G)\ + have "|G`n|\<^bsup>M\<^esup> \ \" + using le_Aleph_rel1_nat[of "|G ` n|\<^bsup>M\<^esup>"] leqpoll_rel_imp_cardinal_rel_UN_le + UN_if_zero[of "domain(G)" G] + by (auto dest:transM) + } + then + have "n\?N \ |G`n|\<^bsup>M\<^esup> \ \" for n . + moreover + note \?N \\<^bsup>M\<^esup> \\ \M(G)\ + moreover + have "(if M(i) then G ` i else 0) \ G ` i" for i + by auto + with \M(G)\ + have "|if M(i) then G ` i else 0|\<^bsup>M\<^esup> \ |G ` i|\<^bsup>M\<^esup>" for i + proof(cases "M(i)") + case True + with \M(G)\ show ?thesis using Ord_cardinal_rel[OF apply_closed] + by simp + next + case False + then + have "i\domain(G)" + using transM[OF _ domain_closed[OF \M(G)\]] by auto + then + show ?thesis + using Ord_cardinal_rel[OF apply_closed] apply_0 by simp + qed + ultimately + show ?thesis + using InfCard_rel_nat leqpoll_rel_imp_cardinal_rel_UN_le[of \] + UN_if_zero[of "domain(G)" G] + le_trans[of "|if M(_) then G ` _ else 0|\<^bsup>M\<^esup>" "|G ` _|\<^bsup>M\<^esup>" \] + by auto blast +qed + +lemma Aleph_rel1_eq_cardinal_rel_vimage: "f:\\<^bsub>1\<^esub>\<^bsup>M\<^esup>\\<^bsup>M\<^esup>\ \ \n\\. |f-``{n}|\<^bsup>M\<^esup> = \\<^bsub>1\<^esub>\<^bsup>M\<^esup>" +proof - + assume "f:\\<^bsub>1\<^esub>\<^bsup>M\<^esup>\\<^bsup>M\<^esup>\" + then + have "function(f)" "domain(f) = \\<^bsub>1\<^esub>\<^bsup>M\<^esup>" "range(f)\\" "f\\\<^bsub>1\<^esub>\<^bsup>M\<^esup>\\" "M(f)" + using mem_function_space_rel[OF \f\_\] domain_of_fun fun_is_function range_fun_subset_codomain + function_space_rel_char + by auto + let ?G="\n\range(f). f-``{n}" + from \f:\\<^bsub>1\<^esub>\<^bsup>M\<^esup>\\\ + have "range(f) \ \" "domain(?G) = range(f)" + using range_fun_subset_codomain + by simp_all + from \f:\\<^bsub>1\<^esub>\<^bsup>M\<^esup>\\\ \M(f)\ \range(f) \ \\ + have "M(f-``{n})" if "n \ range(f)" for n + using that transM[of _ \] by auto + with \M(f)\ \range(f) \ \\ + have "domain(?G) \\<^bsup>M\<^esup> \" "M(?G)" + using subset_imp_lepoll_rel lam_closed[of "\x . f-``{x}"] cardinal_lib_assms4 + by simp_all + have "function(?G)" by (simp add:function_lam) + from \f:\\<^bsub>1\<^esub>\<^bsup>M\<^esup>\\\ + have "n\\ \ f-``{n} \ \\<^bsub>1\<^esub>\<^bsup>M\<^esup>" for n + using Pi_vimage_subset by simp + with \range(f) \ \\ + have "\\<^bsub>1\<^esub>\<^bsup>M\<^esup> = (\n\range(f). f-``{n})" + proof (intro equalityI, intro subsetI) + fix x + assume "x \ \\<^bsub>1\<^esub>\<^bsup>M\<^esup>" + with \f:\\<^bsub>1\<^esub>\<^bsup>M\<^esup>\\\ \function(f)\ \domain(f) = \\<^bsub>1\<^esub>\<^bsup>M\<^esup>\ + have "x \ f-``{f`x}" "f`x \ range(f)" + using function_apply_Pair vimage_iff apply_rangeI by simp_all + then + show "x \ (\n\range(f). f-``{n})" by auto + qed auto + { + assume "\n\range(f). |f-``{n}|\<^bsup>M\<^esup> < \\<^bsub>1\<^esub>\<^bsup>M\<^esup>" + then + have "\n\domain(?G). |?G`n|\<^bsup>M\<^esup> < \\<^bsub>1\<^esub>\<^bsup>M\<^esup>" + using zero_lt_Aleph_rel1 by (auto) + with \function(?G)\ \domain(?G) \\<^bsup>M\<^esup> \\ \M(?G)\ + have "|\n\domain(?G). ?G`n|\<^bsup>M\<^esup>\\" + using lt_Aleph_rel_imp_cardinal_rel_UN_le_nat[of ?G] + by auto + then + have "|\n\range(f). f-``{n}|\<^bsup>M\<^esup>\\" by simp + with \\\<^bsub>1\<^esub>\<^bsup>M\<^esup> = _\ + have "|\\<^bsub>1\<^esub>\<^bsup>M\<^esup>|\<^bsup>M\<^esup> \ \" by auto + then + have "\\<^bsub>1\<^esub>\<^bsup>M\<^esup> \ \" + using Card_rel_Aleph_rel Card_rel_cardinal_rel_eq + by auto + then + have "False" + using nat_lt_Aleph_rel1 by (blast dest:lt_trans2) + } + with \range(f)\\\ \M(f)\ + obtain n where "n\\" "\(|f -`` {n}|\<^bsup>M\<^esup> < \\<^bsub>1\<^esub>\<^bsup>M\<^esup>)" "M(f -`` {n})" + using nat_into_M by auto + moreover from this + have "\\<^bsub>1\<^esub>\<^bsup>M\<^esup> \ |f-``{n}|\<^bsup>M\<^esup>" + using not_lt_iff_le Card_rel_is_Ord by simp + moreover + note \n\\ \ f-``{n} \ \\<^bsub>1\<^esub>\<^bsup>M\<^esup>\ + ultimately + show ?thesis + using subset_imp_le_cardinal_rel[THEN le_anti_sym, of _ "\\<^bsub>1\<^esub>\<^bsup>M\<^esup>"] + Card_rel_Aleph_rel Card_rel_cardinal_rel_eq + by auto +qed + +\ \There is some asymmetry between assumptions and conclusion + (\<^term>\eqpoll_rel\ versus \<^term>\cardinal_rel\)\ + +lemma eqpoll_rel_Aleph_rel1_cardinal_rel_vimage: + assumes "Z \\<^bsup>M\<^esup> (\\<^bsub>1\<^esub>\<^bsup>M\<^esup>)" "f \ Z \\<^bsup>M\<^esup> \" "M(Z)" + shows "\n\\. |f-``{n}|\<^bsup>M\<^esup> = \\<^bsub>1\<^esub>\<^bsup>M\<^esup>" +proof - + have "M(1)" "M(\)" by simp_all + then + have "M(\\<^bsub>1\<^esub>\<^bsup>M\<^esup>)" by simp + with assms \M(1)\ + obtain g where A:"g\bij_rel(M,\\<^bsub>1\<^esub>\<^bsup>M\<^esup>,Z)" "M(g)" + using eqpoll_rel_sym unfolding eqpoll_rel_def by blast + with \f : Z \\<^bsup>M\<^esup> \\ assms + have "M(f)" "converse(g) \ bij_rel(M,Z, \\<^bsub>1\<^esub>\<^bsup>M\<^esup>)" "f\Z\\" "g\ \\<^bsub>1\<^esub>\<^bsup>M\<^esup>\Z" + using bij_rel_is_fun_rel bij_rel_converse_bij_rel bij_rel_char function_space_rel_char + by simp_all + with \g\bij_rel(M,\\<^bsub>1\<^esub>\<^bsup>M\<^esup>,Z)\ \M(g)\ + have "f O g : \\<^bsub>1\<^esub>\<^bsup>M\<^esup> \\<^bsup>M\<^esup> \" "M(converse(g))" + using comp_fun[OF _ \f\ Z\_\,of g] function_space_rel_char + by simp_all + then + obtain n where "n\\" "|(f O g)-``{n}|\<^bsup>M\<^esup> = \\<^bsub>1\<^esub>\<^bsup>M\<^esup>" + using Aleph_rel1_eq_cardinal_rel_vimage + by auto + with \M(f)\ \M(converse(g))\ + have "M(converse(g) `` (f -`` {n}))" "f -`` {n} \ Z" + using image_comp converse_comp Pi_iff[THEN iffD1,OF \f\Z\\\] vimage_subset + unfolding vimage_def + using transM[OF \n\\\] + by auto + from \n\\\ \|(f O g)-``{n}|\<^bsup>M\<^esup> = \\<^bsub>1\<^esub>\<^bsup>M\<^esup>\ + have "\\<^bsub>1\<^esub>\<^bsup>M\<^esup> = |converse(g) `` (f -``{n})|\<^bsup>M\<^esup>" + using image_comp converse_comp unfolding vimage_def + by auto + also from \converse(g) \ bij_rel(M,Z, \\<^bsub>1\<^esub>\<^bsup>M\<^esup>)\ \f: Z\\<^bsup>M\<^esup> \\ \M(Z)\ \M(f)\ \M(\\<^bsub>1\<^esub>\<^bsup>M\<^esup>)\ + \M(converse(g) `` (f -`` {n}))\ + have "\ = |f -``{n}|\<^bsup>M\<^esup>" + using range_of_subset_eqpoll_rel[of "converse(g)" Z _ "f -``{n}", + OF bij_rel_is_inj_rel[OF \converse(g)\_\] \f -`` {n} \ Z\] + cardinal_rel_cong vimage_closed[OF singleton_closed[OF transM[OF \n\\\]],of f] + by auto + finally + show ?thesis using \n\_\ by auto +qed + + +subsection\Applications of transfinite recursive constructions\ + +definition + rec_constr :: "[i,i] \ i" where + "rec_constr(f,\) \ transrec(\,\a g. f`(g``a))" + +text\The function \<^term>\rec_constr\ allows to perform \<^emph>\recursive + constructions\: given a choice function on the powerset of some + set, a transfinite sequence is created by successively choosing + some new element. + + The next result explains its use.\ + +lemma rec_constr_unfold: "rec_constr(f,\) = f`({rec_constr(f,\). \\\})" + using def_transrec[OF rec_constr_def, of f \] image_lam by simp + +lemma rec_constr_type: + assumes "f:Pow_rel(M,G)\\<^bsup>M\<^esup> G" "Ord(\)" "M(G)" + shows "M(\) \ rec_constr(f,\) \ G" + using assms(2) +proof(induct rule:trans_induct) + case (step \) + with assms + have "{rec_constr(f, x) . x \ \} = {y . x \ \, y=rec_constr(f, x)}" (is "_ = ?Y") + "M(f)" + using transM[OF _ \M(\)\] function_space_rel_char Ord_in_Ord + by auto + moreover from assms this step \M(\)\ \Ord(\)\ + have "M({y . x \ \, y=})" (is "M(?Z)") + using strong_replacement_closed[OF cardinal_lib_assms6(1),of f \ \,OF _ _ _ _ + univalent_conjI2[where P="\x _ . x\\",OF univalent_triv]] + transM[OF _ \M(\)\] transM[OF step(2) \M(G)\] Ord_in_Ord + unfolding rec_constr_def + by auto + moreover from assms this step \M(\)\ \Ord(\)\ + have "?Y = {snd(y) . y\?Z}" + proof(intro equalityI, auto) + fix u + assume "u\\" + with assms this step \M(\)\ \Ord(\)\ + have " \ ?Z" "rec_constr(f, u) = snd()" + by auto + then + show "\x\{y . x \ \, y = \x, rec_constr(f, x)\}. rec_constr(f, u) = snd(x)" + using bexI[of _ u] by force + qed + moreover from \M(?Z)\ \?Y = _\ + have "M(?Y)" + using + RepFun_closed[OF lam_replacement_imp_strong_replacement[OF lam_replacement_snd] \M(?Z)\] + fst_snd_closed[THEN conjunct2] transM[OF _ \M(?Z)\] + by simp + moreover from assms step + have "{rec_constr(f, x) . x \ \} \ Pow(G)" (is "?X\_") + using transM[OF _ \M(\)\] function_space_rel_char + by auto + moreover from assms calculation step + have "M(?X)" + by simp + moreover from calculation \M(G)\ + have "?X\Pow_rel(M,G)" + using Pow_rel_char by simp + ultimately + have "f`?X \ G" + using assms apply_type[OF mem_function_space_rel[of f],of "Pow_rel(M,G)" G ?X] + by auto + then + show ?case + by (subst rec_constr_unfold,simp) +qed + +lemma rec_constr_closed : + assumes "f:Pow_rel(M,G)\\<^bsup>M\<^esup> G" "Ord(\)" "M(G)" "M(\)" + shows "M(rec_constr(f,\))" + using transM[OF rec_constr_type \M(G)\] assms by auto + +lemma lambda_rec_constr_closed : + assumes "Ord(\)" "M(\)" "M(f)" "f:Pow_rel(M,G)\\<^bsup>M\<^esup> G" "M(G)" + shows "M(\\\\ . rec_constr(f,\))" + using lam_closed2[OF cardinal_lib_assms6(1),unfolded rec_constr_def[symmetric],of f \] + rec_constr_type[OF \f\_\ Ord_in_Ord[of \]] transM[OF _ \M(G)\] assms + by simp + +text\The next lemma is an application of recursive constructions. + It works under the assumption that whenever the already constructed + subsequence is small enough, another element can be added.\ + +lemma bounded_cardinal_rel_selection: + includes Ord_dests + assumes + "\Z. |Z|\<^bsup>M\<^esup> < \ \ Z \ G \ M(Z) \ \a\G. \s\Z. \Q" "b\G" "Card_rel(M,\)" + "M(G)" "M(Q)" "M(\)" + shows + "\S[M]. S : \ \\<^bsup>M\<^esup> G \ (\\ \ \. \\ \ \. \<\ \ ,S`\>\Q)" +proof - + from assms + have "M(x) \ M({a \ G . \s\x. \s, a\ \ Q})" for x + using cdlt_assms' by simp + let ?cdlt\="{Z\Pow_rel(M,G) . |Z|\<^bsup>M\<^esup><\}" \ \“cardinal\_rel less than \<^term>\\\”\ + and ?inQ="\Y.{a\G. \s\Y. \Q}" + from \M(G)\ \Card_rel(M,\)\ \M(\)\ + have "M(?cdlt\)" "Ord(\)" + using cardinal_lib_assms5[OF \M(\)\] Card_rel_is_Ord + by simp_all + from assms + have H:"\a. a \ ?inQ(Y)" if "Y\?cdlt\" for Y + proof - + { + fix Y + assume "Y\?cdlt\" + then + have A:"Y\Pow_rel(M,G)" "|Y|\<^bsup>M\<^esup><\" by simp_all + then + have "Y\G" "M(Y)" using Pow_rel_char[OF \M(G)\] by simp_all + with A + obtain a where "a\G" "\s\Y. \Q" + using assms(1) by force + with \M(G)\ + have "\a. a \ ?inQ(Y)" by auto + } + then show ?thesis using that by simp + qed + then + have "\f[M]. f \ Pi_rel(M,?cdlt\,?inQ) \ f \ Pi(?cdlt\,?inQ)" + proof - + from \\x. M(x) \ M({a \ G . \s\x. \s, a\ \ Q})\ \M(G)\ + have "x \ {Z \ Pow\<^bsup>M\<^esup>(G) . |Z|\<^bsup>M\<^esup> < \} \ M({a \ G . \s\x. \s, a\ \ Q})" for x + by (auto dest:transM) + with\M(G)\ \\x. M(x) \ M({a \ G . \s\x. \s, a\ \ Q})\ \M(Q)\ \M(?cdlt\)\ + interpret M_Pi_assumptions_choice M ?cdlt\ ?inQ + using cdlt_assms[where Q=Q] lam_replacement_Collect_ball_Pair[THEN + lam_replacement_imp_strong_replacement] surj_imp_inj_replacement3 + lam_replacement_hcomp2[OF lam_replacement_constant + lam_replacement_Collect_ball_Pair _ _ lam_replacement_minimum, + unfolded lam_replacement_def] + lam_replacement_hcomp lam_replacement_Sigfun[OF + lam_replacement_Collect_ball_Pair, of G Q, THEN + lam_replacement_imp_strong_replacement] cdlt_assms' + by unfold_locales (blast dest: transM, auto dest:transM) + show ?thesis using AC_Pi_rel Pi_rel_char H by auto + qed + then + obtain f where f_type:"f \ Pi_rel(M,?cdlt\,?inQ)" "f \ Pi(?cdlt\,?inQ)" and "M(f)" + by auto + moreover + define Cb where "Cb \ \_\Pow_rel(M,G)-?cdlt\. b" + moreover from \b\G\ \M(?cdlt\)\ \M(G)\ + have "Cb \ Pow_rel(M,G)-?cdlt\ \ G" "M(Cb)" + using lam_closed[of "\_.b" "Pow_rel(M,G)-?cdlt\"] + tag_replacement transM[OF \b\G\] + unfolding Cb_def by auto + moreover + note \Card_rel(M,\)\ + ultimately + have "f \ Cb : (\x\Pow_rel(M,G). ?inQ(x) \ G)" using + fun_Pi_disjoint_Un[ of f ?cdlt\ ?inQ Cb "Pow_rel(M,G)-?cdlt\" "\_.G"] + Diff_partition[of "{Z\Pow_rel(M,G). |Z|\<^bsup>M\<^esup><\}" "Pow_rel(M,G)", OF Collect_subset] + by auto + moreover + have "?inQ(x) \ G = G" for x by auto + moreover from calculation + have "f \ Cb : Pow_rel(M,G) \ G" + using function_space_rel_char by simp + ultimately + have "f \ Cb : Pow_rel(M,G) \\<^bsup>M\<^esup> G" + using function_space_rel_char \M(f)\ \M(Cb)\ Pow_rel_closed \M(G)\ + by auto + define S where "S\\\\\. rec_constr(f \ Cb, \)" + from \f \ Cb: Pow_rel(M,G) \\<^bsup>M\<^esup> G\ \Card_rel(M,\)\ \M(\)\ \M(G)\ + have "S : \ \ G" "M(f \ Cb)" + unfolding S_def + using Ord_in_Ord[OF Card_rel_is_Ord] rec_constr_type lam_type transM[OF _ \M(\)\] + function_space_rel_char + by auto + moreover from \f\Cb \ _\\<^bsup>M\<^esup> G\ \Card_rel(M,\)\ \M(\)\ \M(G)\ \M(f \ Cb)\ \Ord(\)\ + have "M(S)" + unfolding S_def + using lambda_rec_constr_closed + by simp + moreover + have "\\\\. \\\\. \ < \ \ , S ` \>\Q" + proof (intro ballI impI) + fix \ \ + assume "\\\" + with \Card_rel(M,\)\ \M(S)\ \M(\)\ + have "\\\" "M(S``\)" "M(\)" "{S`x . x \ \} = {restrict(S,\)`x . x \ \}" + using transM[OF \\\\\ \M(\)\] image_closed Card_rel_is_Ord OrdmemD + by auto + with \\\_\ \Card_rel(M,\)\ \M(\)\ + have "{rec_constr(f \ Cb, x) . x\\} = {S`x . x \ \}" + using Ord_trans[OF _ _ Card_rel_is_Ord, of _ \ \] + unfolding S_def + by auto + moreover from \\\\\ \S : \ \ G\ \Card_rel(M,\)\ \M(\)\ \M(S``\)\ + have "{S`x . x \ \} \ G" "M({S`x . x \ \})" + using Ord_trans[OF _ _ Card_rel_is_Ord, of _ \ \] + apply_type[of S \ "\_. G"] + by(auto,simp add:image_fun_subset[OF \S\_\ \\\_\]) + moreover from \Card_rel(M,\)\ \\\\\ \S\_\ \\\\\ \M(S)\ \M(\)\ \M(G)\ \M(\)\ + have "|{S`x . x \ \}|\<^bsup>M\<^esup> < \" + using + \{S`x . x\\} = {restrict(S,\)`x . x\\}\[symmetric] + cardinal_rel_RepFun_apply_le[of "restrict(S,\)" \ G, + OF restrict_type2[of S \ "\_.G" \] restrict_closed] + Ord_in_Ord Ord_cardinal_rel + lt_trans1[of "|{S`x . x \ \}|\<^bsup>M\<^esup>" "|\|\<^bsup>M\<^esup>" \] + Card_rel_lt_iff[THEN iffD2, of \ \, OF _ _ _ _ ltI] + Card_rel_is_Ord + by auto + moreover + have "\x\\. \}> \ Q" + proof - + from calculation and f_type + have "f ` {S`x . x \ \} \ {a\G. \x\\. \Q}" + using apply_type[of f ?cdlt\ ?inQ "{S`x . x \ \}"] + Pow_rel_char[OF \M(G)\] + by simp + then + show ?thesis by simp + qed + moreover + assume "\\\" "\ < \" + moreover from this + have "\\\" using ltD by simp + moreover + note \\\\\ \Cb \ Pow_rel(M,G)-?cdlt\ \ G\ + ultimately + show ", S ` \>\Q" + using fun_disjoint_apply1[of "{S`x . x \ \}" Cb f] + domain_of_fun[of Cb] ltD[of \ \] + by (subst (2) S_def, auto) (subst rec_constr_unfold, auto) + qed + moreover + note \M(G)\ \M(\)\ + ultimately + show ?thesis using function_space_rel_char by auto +qed + +text\The following basic result can, in turn, be proved by a + bounded-cardinal\_rel selection.\ +lemma Infinite_iff_lepoll_rel_nat: "M(Z) \ Infinite(Z) \ \ \\<^bsup>M\<^esup> Z" +proof + define Distinct where "Distinct = { \ Z\Z . x\y}" + have "Distinct = {xy \ Z\Z . \a b. xy = \a, b\ \ a \ b}" (is "_=?A") + unfolding Distinct_def by auto + moreover + assume "Infinite(Z)" "M(Z)" + moreover from calculation + have "M(Distinct)" + using cardinal_lib_assms6 separation_dist by simp + from \Infinite(Z)\ \M(Z)\ + obtain b where "b\Z" + using Infinite_not_empty by auto + { + fix Y + assume "|Y|\<^bsup>M\<^esup> < \" "M(Y)" + then + have "Finite(Y)" + using Finite_cardinal_rel_iff' ltD nat_into_Finite by auto + with \Infinite(Z)\ + have "Z \ Y" by auto + } + moreover + have "(\W. M(W) \ |W|\<^bsup>M\<^esup> < \ \ W \ Z \ \a\Z. \s\W. \Distinct)" + proof - + fix W + assume "M(W)" "|W|\<^bsup>M\<^esup> < \" "W \ Z" + moreover from this + have "Finite_rel(M,W)" + using + cardinal_rel_closed[OF \M(W)\] Card_rel_nat + lt_Card_rel_imp_lesspoll_rel[of \,simplified,OF _ \|W|\<^bsup>M\<^esup> < \\] + lesspoll_rel_nat_is_Finite_rel[of W] + eqpoll_rel_imp_lepoll_rel eqpoll_rel_sym[OF cardinal_rel_eqpoll_rel,of W] + lesspoll_rel_trans1[of W "|W|\<^bsup>M\<^esup>" \] by auto + moreover from calculation + have "\Z\W" + using equalityI \Infinite(Z)\ by auto + moreover from calculation + show "\a\Z. \s\W. \Distinct" + unfolding Distinct_def by auto + qed + moreover from \b\Z\ \M(Z)\ \M(Distinct)\ this + obtain S where "S : \ \\<^bsup>M\<^esup> Z" "M(S)" "\\\\. \\\\. \ < \ \ ,S`\> \ Distinct" + using bounded_cardinal_rel_selection[OF _ \b\Z\ Card_rel_nat,of Distinct] + by blast + moreover from this + have "\ \ \ \ \ \ \ \ \\\ \ S`\ \ S`\" for \ \ + unfolding Distinct_def + by (rule_tac lt_neq_symmetry[of "\" "\\ \. S`\ \ S`\"]) + auto + moreover from this \S\_\ \M(Z)\ + have "S\inj(\,Z)" using function_space_rel_char unfolding inj_def by auto + ultimately + show "\ \\<^bsup>M\<^esup> Z" + unfolding lepoll_rel_def using inj_rel_char \M(Z)\ by auto +next + assume "\ \\<^bsup>M\<^esup> Z" "M(Z)" + then + show "Infinite(Z)" using lepoll_rel_nat_imp_Infinite by simp +qed + +lemma Infinite_InfCard_rel_cardinal_rel: "Infinite(Z) \ M(Z) \ InfCard_rel(M,|Z|\<^bsup>M\<^esup>)" + using lepoll_rel_eq_trans eqpoll_rel_sym lepoll_rel_nat_imp_Infinite + Infinite_iff_lepoll_rel_nat Inf_Card_rel_is_InfCard_rel cardinal_rel_eqpoll_rel + by simp + +lemma (in M_trans) mem_F_bound2: + fixes F A + defines "F \ \_ x. if M(x) then A-``{x} else 0" + shows "x\F(A,c) \ c \ (range(f) \ range(A))" + using apply_0 unfolding F_def + by (cases "M(c)", auto simp:F_def drSR_Y_def dC_F_def) + +lemma Finite_to_one_rel_surj_rel_imp_cardinal_rel_eq: + assumes "F \ Finite_to_one_rel(M,Z,Y) \ surj_rel(M,Z,Y)" "Infinite(Z)" "M(Z)" "M(Y)" + shows "|Y|\<^bsup>M\<^esup> = |Z|\<^bsup>M\<^esup>" +proof - + have sep_true: "separation(M, M)" unfolding separation_def by auto + note \M(Z)\ \M(Y)\ + moreover from this assms + have "M(F)" "F \ Z \ Y" + unfolding Finite_to_one_rel_def + using function_space_rel_char by simp_all + moreover from this + have "x \ (if M(i) then F -`` {i} else 0) \ M(i)" for x i + by (cases "M(i)") auto + moreover from calculation + interpret M_replacement_lepoll M "\_ x. if M(x) then F-``{x} else 0" + using lam_replacement_inj_rel mem_F_bound2 cardinal_lib_assms3 + lam_replacement_vimage_sing_fun + lam_replacement_if[OF _ + lam_replacement_constant[OF nonempty],where b=M] sep_true + by (unfold_locales, simp_all) + (rule lam_Least_assumption_general[where U="\_. range(F)"], auto) + have "w \ (if M(y) then F-``{y} else 0) \ M(y)" for w y + by (cases "M(y)") auto + moreover from \F\_\_\ + have 0:"Finite(F-``{y})" if "y\Y" for y + unfolding Finite_to_one_rel_def + using vimage_fun_sing \F\Z\Y\ transM[OF that \M(Y)\] transM[OF _ \M(Z)\] that by simp + ultimately + interpret M_cardinal_UN_lepoll _ "\y. if M(y) then F-``{y} else 0" Y + using cardinal_lib_assms3 lepoll_assumptions + by unfold_locales (auto dest:transM simp del:mem_inj_abs) + from \F\Z\Y\ + have "Z = (\y\Y. {x\Z . F`x = y})" + using apply_type by auto + then + show ?thesis + proof (cases "Finite(Y)") + case True + with \Z = (\y\Y. {x\Z . F`x = y})\ and assms and \F\Z\Y\ + show ?thesis + using Finite_RepFun[THEN [2] Finite_Union, of Y "\y. F-``{y}"] 0 vimage_fun_sing[OF \F\Z\Y\] + by simp + next + case False + moreover from this \M(Y)\ + have "Y \\<^bsup>M\<^esup> |Y|\<^bsup>M\<^esup>" + using cardinal_rel_eqpoll_rel eqpoll_rel_sym eqpoll_rel_imp_lepoll_rel by auto + moreover + note assms + moreover from \F\_\_\ + have "Finite({x\Z . F`x = y})" "M(F-``{y})" if "y\Y" for y + unfolding Finite_to_one_rel_def + using transM[OF that \M(Y)\] transM[OF _ \M(Z)\] vimage_fun_sing[OF \F\Z\Y\] that + by simp_all + moreover from calculation + have "|{x\Z . F`x = y}|\<^bsup>M\<^esup> \ \" if "y\Y" for y + using Finite_cardinal_rel_in_nat that transM[OF that \M(Y)\] vimage_fun_sing[OF \F\Z\Y\] that + by simp + moreover from calculation + have "|{x\Z . F`x = y}|\<^bsup>M\<^esup> \ |Y|\<^bsup>M\<^esup>" if "y\Y" for y + using Infinite_imp_nats_lepoll_rel[THEN lepoll_rel_imp_cardinal_rel_le, + of _ "|{x\Z . F`x = y}|\<^bsup>M\<^esup>"] + that cardinal_rel_idem transM[OF that \M(Y)\] vimage_fun_sing[OF \F\Z\Y\] + by auto + ultimately + have "|\y\Y. {x\Z . F`x = y}|\<^bsup>M\<^esup> \ |Y|\<^bsup>M\<^esup>" + using leqpoll_rel_imp_cardinal_rel_UN_le + Infinite_InfCard_rel_cardinal_rel[of Y] vimage_fun_sing[OF \F\Z\Y\] + by(auto simp add:transM[OF _ \M(Y)\]) + moreover from \F \ Finite_to_one_rel(M,Z,Y) \ surj_rel(M,Z,Y)\ \M(Z)\ \M(F)\ \M(Y)\ + have "|Y|\<^bsup>M\<^esup> \ |Z|\<^bsup>M\<^esup>" + using surj_rel_implies_cardinal_rel_le by auto + moreover + note \Z = (\y\Y. {x\Z . F`x = y})\ + ultimately + show ?thesis + using le_anti_sym by auto + qed +qed + +lemma cardinal_rel_map_Un: + assumes "Infinite(X)" "Finite(b)" "M(X)" "M(b)" + shows "|{a \ b . a \ X}|\<^bsup>M\<^esup> = |X|\<^bsup>M\<^esup>" +proof - + have "(\a\X. a \ b) \ Finite_to_one_rel(M,X,{a \ b . a \ X})" + "(\a\X. a \ b) \ surj_rel(M,X,{a \ b . a \ X})" + "M({a \ b . a \ X})" + unfolding def_surj_rel + proof + fix d + have "Finite({a \ X . a \ b = d})" (is "Finite(?Y(b,d))") + using \Finite(b)\ + proof (induct arbitrary:d) + case 0 + have "{a \ X . a \ 0 = d} = (if d\X then {d} else 0)" + by auto + then + show ?case by simp + next + case (cons c b) + from \c \ b\ + have "?Y(cons(c,b),d) \ (if c\d then ?Y(b,d) \ ?Y(b,d-{c}) else 0)" + by auto + with cons + show ?case + using subset_Finite + by simp + qed + moreover + assume "d \ {x \ b . x \ X}" + ultimately + show "Finite({a \ X . M(a) \ (\x\X. x \ b) ` a = d})" + using subset_Finite[of "{a \ X . M(a) \ (\x\X. x \ b) ` a = d}" + "{a \ X . (\x\X. x \ b) ` a = d}"] by auto + next + note \M(X)\ \M(b)\ + moreover + show "M(\a\X. a \ b)" + using lam_closed[of "\ x . x\b",OF _ \M(X)\] Un_closed[OF transM[OF _ \M(X)\] \M(b)\] + tag_union_replacement[OF \M(b)\] + by simp + moreover from this + have "{a \ b . a \ X} = (\x\X. x \ b) `` X" + using image_lam by simp + with calculation + show "M({a \ b . a \ X})" by auto + moreover from calculation + show "(\a\X. a \ b) \ X \\<^bsup>M\<^esup> {a \ b . a \ X}" + using function_space_rel_char by (auto intro:lam_funtype) + ultimately + show "(\a\X. a \ b) \ surj\<^bsup>M\<^esup>(X,{a \ b . a \ X})" "M({a \ b . a \ X})" + using surj_rel_char function_space_rel_char + unfolding surj_def by auto + next + qed (simp add:\M(X)\) + moreover from assms this + show ?thesis + using Finite_to_one_rel_surj_rel_imp_cardinal_rel_eq by simp +qed + +subsection\Results on relative cardinal exponentiation\ + +lemma cexp_rel_eqpoll_rel_cong: + assumes + "A \\<^bsup>M\<^esup> A'" "B \\<^bsup>M\<^esup> B'" "M(A)" "M(A')" "M(B)" "M(B')" + shows + "A\<^bsup>\B,M\<^esup> = A'\<^bsup>\B',M\<^esup>" + unfolding cexp_rel_def using cardinal_rel_eqpoll_rel_iff + function_space_rel_eqpoll_rel_cong assms + by simp + +lemma cexp_rel_cexp_rel_cmult: + assumes "M(\)" "M(\1)" "M(\2)" + shows "(\\<^bsup>\\1,M\<^esup>)\<^bsup>\\2,M\<^esup> = \\<^bsup>\\2 \\<^bsup>M\<^esup> \1,M\<^esup>" +proof - + have "(\\<^bsup>\\1,M\<^esup>)\<^bsup>\\2,M\<^esup> = (\1 \\<^bsup>M\<^esup> \)\<^bsup>\\2,M\<^esup>" + using cardinal_rel_eqpoll_rel + by (intro cexp_rel_eqpoll_rel_cong) (simp_all add:assms cexp_rel_def) + also from assms + have " \ = \\<^bsup>\\2 \ \1,M\<^esup>" + unfolding cexp_rel_def using curry_eqpoll_rel[THEN cardinal_rel_cong] by blast + also + have " \ = \\<^bsup>\\2 \\<^bsup>M\<^esup> \1,M\<^esup>" + using cardinal_rel_eqpoll_rel[THEN eqpoll_rel_sym] + unfolding cmult_rel_def by (intro cexp_rel_eqpoll_rel_cong) (auto simp add:assms) + finally + show ?thesis . +qed + +lemma cardinal_rel_Pow_rel: "M(X) \ |Pow_rel(M,X)|\<^bsup>M\<^esup> = 2\<^bsup>\X,M\<^esup>" \ \Perhaps it's better with |X|\ + using cardinal_rel_eqpoll_rel_iff[THEN iffD2, + OF _ _ Pow_rel_eqpoll_rel_function_space_rel] + unfolding cexp_rel_def by simp + +lemma cantor_cexp_rel: + assumes "Card_rel(M,\)" "M(\)" + shows "\ < 2\<^bsup>\\,M\<^esup>" + using assms Card_rel_is_Ord Card_rel_cexp_rel +proof (intro not_le_iff_lt[THEN iffD1] notI) + assume "2\<^bsup>\\,M\<^esup> \ \" + with assms + have "|Pow_rel(M,\)|\<^bsup>M\<^esup> \ \" + using cardinal_rel_Pow_rel[of \] by simp + with assms + have "Pow_rel(M,\) \\<^bsup>M\<^esup> \" + using cardinal_rel_eqpoll_rel_iff Card_rel_le_imp_lepoll_rel Card_rel_cardinal_rel_eq + by auto + then + obtain g where "g \ inj_rel(M,Pow_rel(M,\), \)" + by blast + moreover + note \M(\)\ + moreover from calculation + have "M(g)" by (auto dest:transM) + ultimately + show "False" + using cantor_inj_rel by simp +qed simp + +lemma countable_iff_lesspoll_rel_Aleph_rel_one: + notes iff_trans[trans] + assumes "M(C)" + shows "countable\<^bsup>M\<^esup>(C) \ C \\<^bsup>M\<^esup> \\<^bsub>1\<^esub>\<^bsup>M\<^esup>" + using assms lesspoll_rel_csucc_rel[of \ C] Aleph_rel_succ Aleph_rel_zero + unfolding countable_rel_def by simp + + +lemma countable_iff_le_rel_Aleph_rel_one: + notes iff_trans[trans] + assumes "M(C)" + shows "countable\<^bsup>M\<^esup>(C) \ |C|\<^bsup>M\<^esup> \\<^bsup>M\<^esup> \\<^bsub>1\<^esub>\<^bsup>M\<^esup>" +proof - + from assms + have "countable\<^bsup>M\<^esup>(C) \ C \\<^bsup>M\<^esup> \\<^bsub>1\<^esub>\<^bsup>M\<^esup>" + using countable_iff_lesspoll_rel_Aleph_rel_one + by simp + also from assms + have "\ \ |C|\<^bsup>M\<^esup> \\<^bsup>M\<^esup> \\<^bsub>1\<^esub>\<^bsup>M\<^esup>" + using cardinal_rel_eqpoll_rel[THEN eqpoll_rel_sym, THEN eq_lesspoll_rel_trans] + by (auto intro:cardinal_rel_eqpoll_rel[THEN eq_lesspoll_rel_trans]) + finally + show ?thesis . +qed + +end \ \\<^locale>\M_cardinal_library\\ + +(* TODO: This can be generalized. *) +lemma (in M_cardinal_library) countable_fun_imp_countable_image: + assumes "f:C \\<^bsup>M\<^esup> B" "countable\<^bsup>M\<^esup>(C)" "\c. c\C \ countable\<^bsup>M\<^esup>(f`c)" + "M(C)" "M(B)" + shows "countable\<^bsup>M\<^esup>(\(f``C))" + using assms function_space_rel_char image_fun[of f] + cardinal_rel_RepFun_apply_le[of f C B] + countable_rel_iff_cardinal_rel_le_nat[THEN iffD1, THEN [2] le_trans, of _ ] + countable_rel_iff_cardinal_rel_le_nat + by (rule_tac countable_rel_union_countable_rel) + (auto dest:transM del:imageE) + +end \ No newline at end of file diff --git a/thys/Transitive_Models/Cardinal_Relative.thy b/thys/Transitive_Models/Cardinal_Relative.thy new file mode 100644 --- /dev/null +++ b/thys/Transitive_Models/Cardinal_Relative.thy @@ -0,0 +1,1292 @@ +section\Relative, Choice-less Cardinal Numbers\ + +theory Cardinal_Relative + imports + Lambda_Replacement + Univ_Relative +begin + +txt\The following command avoids that a commonly used one-letter variable be +captured by the definition of the constructible universe \<^term>\L\.\ +hide_const (open) L + +txt\We also return to the old notation for \<^term>\sum\ to preserve the old +Constructibility code.\ +no_notation oadd (infixl \+\ 65) +notation sum (infixr \+\ 65) + +definition + Finite_rel :: "[i\o,i]=>o" where + "Finite_rel(M,A) \ \om[M]. \n[M]. omega(M,om) \ n\om \ eqpoll_rel(M,A,n)" + +definition + banach_functor :: "[i,i,i,i,i] \ i" where + "banach_functor(X,Y,f,g,W) \ X - g``(Y - f``W)" + +definition + is_banach_functor :: "[i\o,i,i,i,i,i,i]\o" where + "is_banach_functor(M,X,Y,f,g,W,b) \ + \fW[M]. \YfW[M]. \gYfW[M]. image(M,f,W,fW) \ setdiff(M,Y,fW,YfW) \ + image(M,g,YfW,gYfW) \ setdiff(M,X,gYfW,b)" + + +lemma (in M_basic) banach_functor_abs : + assumes "M(X)" "M(Y)" "M(f)" "M(g)" + shows "relation1(M,is_banach_functor(M,X,Y,f,g),banach_functor(X,Y,f,g))" + unfolding relation1_def is_banach_functor_def banach_functor_def + using assms + by simp + +lemma (in M_basic) banach_functor_closed: + assumes "M(X)" "M(Y)" "M(f)" "M(g)" + shows "\W[M]. M(banach_functor(X,Y,f,g,W))" + unfolding banach_functor_def using assms image_closed + by simp + +locale M_cardinals = M_ordertype + M_trancl + M_Perm + M_replacement_extra + + assumes + radd_separation: "M(R) \ M(S) \ + separation(M, \z. + (\x y. z = \Inl(x), Inr(y)\) \ + (\x' x. z = \Inl(x'), Inl(x)\ \ \x', x\ \ R) \ + (\y' y. z = \Inr(y'), Inr(y)\ \ \y', y\ \ S))" + and + rmult_separation: "M(b) \ M(d) \ separation(M, + \z. \x' y' x y. z = \\x', y'\, x, y\ \ (\x', x\ \ b \ x' = x \ \y', y\ \ d))" + and + banach_repl_iter: "M(X) \ M(Y) \ M(f) \ M(g) \ + strong_replacement(M, \x y. x\nat \ y = banach_functor(X, Y, f, g)^x (0))" +begin + +lemma rvimage_separation: "M(f) \ M(r) \ + separation(M, \z. \x y. z = \x, y\ \ \f ` x, f ` y\ \ r)" + using separation_pair separation_in + lam_replacement_Pair[THEN[5] lam_replacement_hcomp2] + lam_replacement_constant lam_replacement_apply2[THEN[5] lam_replacement_hcomp2,OF lam_replacement_constant[of f]] + lam_replacement_fst lam_replacement_snd + lam_replacement_identity lam_replacement_hcomp + by(simp_all) + +lemma radd_closed[intro,simp]: "M(a) \ M(b) \ M(c) \ M(d) \ M(radd(a,b,c,d))" + using radd_separation by (auto simp add: radd_def) + +lemma rmult_closed[intro,simp]: "M(a) \ M(b) \ M(c) \ M(d) \ M(rmult(a,b,c,d))" + using rmult_separation by (auto simp add: rmult_def) + +end \ \\<^locale>\M_cardinals\\ + +lemma (in M_cardinals) is_cardinal_iff_Least: + assumes "M(A)" "M(\)" + shows "is_cardinal(M,A,\) \ \ = (\ i. M(i) \ i \\<^bsup>M\<^esup> A)" + using is_cardinal_iff assms + unfolding cardinal_rel_def by simp + +subsection\The Schroeder-Bernstein Theorem\ +text\See Davey and Priestly, page 106\ + +context M_cardinals +begin + +(** Lemma: Banach's Decomposition Theorem **) + +lemma bnd_mono_banach_functor: "bnd_mono(X, banach_functor(X,Y,f,g))" + unfolding bnd_mono_def banach_functor_def + by blast + +lemma inj_Inter: + assumes "g \ inj(Y,X)" "A\0" "\a\A. a \ Y" + shows "g``(\A) = (\a\A. g``a)" +proof (intro equalityI subsetI) + fix x + from assms + obtain a where "a\A" by blast + moreover + assume "x \ (\a\A. g `` a)" + ultimately + have x_in_im: "x \ g``y" if "y\A" for y + using that by auto + have exists: "\z \ y. x = g`z" if "y\A" for y + proof - + note that + moreover from this and x_in_im + have "x \ g``y" by simp + moreover from calculation + have "x \ g``y" by simp + moreover + note assms + ultimately + show ?thesis + using image_fun[OF inj_is_fun] by auto + qed + with \a\A\ + obtain z where "z \ a" "x = g`z" by auto + moreover + have "z \ y" if "y\A" for y + proof - + from that and exists + obtain w where "w \ y" "x = g`w" by auto + moreover from this \x = g`z\ assms that \a\A\ \z\a\ + have "z = w" unfolding inj_def by blast + ultimately + show ?thesis by simp + qed + moreover + note assms + moreover from calculation + have "z \ \A" by auto + moreover from calculation + have "z \ Y" by blast + ultimately + show "x \ g `` (\A)" + using inj_is_fun[THEN funcI, of g] by fast +qed auto + +lemma contin_banach_functor: + assumes "g \ inj(Y,X)" + shows "contin(banach_functor(X,Y,f,g))" + unfolding contin_def +proof (intro allI impI) + fix A + assume "directed(A)" + then + have "A \ 0" + unfolding directed_def .. + have "banach_functor(X, Y, f, g, \A) = X - g``(Y - f``(\A))" + unfolding banach_functor_def .. + also + have " \ = X - g``(Y - (\a\A. f``a))" + by auto + also from \A\0\ + have " \ = X - g``(\a\A. Y-f``a)" + by auto + also from \A\0\ and assms + have " \ = X - (\a\A. g``(Y-f``a))" + using inj_Inter[of g Y X "{Y-f``a. a\A}" ] by fastforce + also from \A\0\ + have " \ = (\a\A. X - g``(Y-f``a))" by simp + also + have " \ = (\a\A. banach_functor(X, Y, f, g, a))" + unfolding banach_functor_def .. + finally + show "banach_functor(X,Y,f,g,\A) = (\a\A. banach_functor(X,Y,f,g,a))" . +qed + +lemma lfp_banach_functor: + assumes "g\inj(Y,X)" + shows "lfp(X, banach_functor(X,Y,f,g)) = + (\n\nat. banach_functor(X,Y,f,g)^n (0))" + using assms lfp_eq_Union bnd_mono_banach_functor contin_banach_functor + by simp + +lemma lfp_banach_functor_closed: + assumes "M(g)" "M(X)" "M(Y)" "M(f)" "g\inj(Y,X)" + shows "M(lfp(X, banach_functor(X,Y,f,g)))" +proof - + from assms + have "M(banach_functor(X,Y,f,g)^n (0))" if "n\nat" for n + by(rule_tac nat_induct[OF that],simp_all add:banach_functor_closed) + with assms + show ?thesis + using family_union_closed'[OF banach_repl_iter M_nat] lfp_banach_functor + by simp +qed + +lemma banach_decomposition_rel: + "[| M(f); M(g); M(X); M(Y); f \ X->Y; g \ inj(Y,X) |] ==> + \XA[M]. \XB[M]. \YA[M]. \YB[M]. + (XA \ XB = 0) & (XA \ XB = X) & + (YA \ YB = 0) & (YA \ YB = Y) & + f``XA=YA & g``YB=XB" + apply (intro rexI conjI) + apply (rule_tac [6] Banach_last_equation) + apply (rule_tac [5] refl) + apply (assumption | + rule inj_is_fun Diff_disjoint Diff_partition fun_is_rel + image_subset lfp_subset)+ + using lfp_banach_functor_closed[of g X Y f] + unfolding banach_functor_def by simp_all + +lemma schroeder_bernstein_closed: + "[| M(f); M(g); M(X); M(Y); f \ inj(X,Y); g \ inj(Y,X) |] ==> \h[M]. h \ bij(X,Y)" + apply (insert banach_decomposition_rel [of f g X Y]) + apply (simp add: inj_is_fun) + apply (auto) + apply (rule_tac x="restrict(f,XA) \ converse(restrict(g,YB))" in rexI) + apply (auto intro!: restrict_bij bij_disjoint_Un intro: bij_converse_bij) + done + +(** Equipollence is an equivalence relation **) + +lemma mem_Pow_rel: "M(r) \ a \ Pow_rel(M,r) \ a \ Pow(r) \ M(a)" + using Pow_rel_char by simp + +lemma mem_bij_abs[simp]: "\M(f);M(A);M(B)\ \ f \ bij\<^bsup>M\<^esup>(A,B) \ f\bij(A,B)" + using bij_rel_char by simp + +lemma mem_inj_abs[simp]: "\M(f);M(A);M(B)\ \ f \ inj\<^bsup>M\<^esup>(A,B) \ f\inj(A,B)" + using inj_rel_char by simp + +lemma mem_surj_abs: "\M(f);M(A);M(B)\ \ f \ surj\<^bsup>M\<^esup>(A,B) \ f\surj(A,B)" + using surj_rel_char by simp + +lemma bij_imp_eqpoll_rel: + assumes "f \ bij(A,B)" "M(f)" "M(A)" "M(B)" + shows "A \\<^bsup>M\<^esup> B" + using assms by (auto simp add:def_eqpoll_rel) + +lemma eqpoll_rel_refl: "M(A) \ A \\<^bsup>M\<^esup> A" + using bij_imp_eqpoll_rel[OF id_bij, OF id_closed] . + +lemma eqpoll_rel_sym: "X \\<^bsup>M\<^esup> Y \ M(X) \ M(Y) \ Y \\<^bsup>M\<^esup> X" + unfolding def_eqpoll_rel using converse_closed + by (auto intro: bij_converse_bij) + +lemma eqpoll_rel_trans [trans]: + "[|X \\<^bsup>M\<^esup> Y; Y \\<^bsup>M\<^esup> Z; M(X); M(Y) ; M(Z) |] ==> X \\<^bsup>M\<^esup> Z" + unfolding def_eqpoll_rel by (auto intro: comp_bij) + +(** Le-pollence is a partial ordering **) + +lemma subset_imp_lepoll_rel: "X \ Y \ M(X) \ M(Y) \ X \\<^bsup>M\<^esup> Y" + unfolding def_lepoll_rel using id_subset_inj id_closed + by simp blast + +lemmas lepoll_rel_refl = subset_refl [THEN subset_imp_lepoll_rel, simp] + +lemmas le_imp_lepoll_rel = le_imp_subset [THEN subset_imp_lepoll_rel] + +lemma eqpoll_rel_imp_lepoll_rel: "X \\<^bsup>M\<^esup> Y ==> M(X) \ M(Y) \ X \\<^bsup>M\<^esup> Y" + unfolding def_eqpoll_rel bij_def def_lepoll_rel using bij_is_inj + by (auto) + +lemma lepoll_rel_trans [trans]: + assumes + "X \\<^bsup>M\<^esup> Y" "Y \\<^bsup>M\<^esup> Z" "M(X)" "M(Y)" "M(Z)" + shows + "X \\<^bsup>M\<^esup> Z" + using assms def_lepoll_rel + by (auto intro: comp_inj) + +lemma eq_lepoll_rel_trans [trans]: + assumes + "X \\<^bsup>M\<^esup> Y" "Y \\<^bsup>M\<^esup> Z" "M(X)" "M(Y)" "M(Z)" + shows + "X \\<^bsup>M\<^esup> Z" + using assms + by (blast intro: eqpoll_rel_imp_lepoll_rel lepoll_rel_trans) + +lemma lepoll_rel_eq_trans [trans]: + assumes "X \\<^bsup>M\<^esup> Y" "Y \\<^bsup>M\<^esup> Z" "M(X)" "M(Y)" "M(Z)" + shows "X \\<^bsup>M\<^esup> Z" + using assms + eqpoll_rel_imp_lepoll_rel[of Y Z] lepoll_rel_trans[of X Y Z] + by simp + +lemma eqpoll_relI: "\ X \\<^bsup>M\<^esup> Y; Y \\<^bsup>M\<^esup> X; M(X) ; M(Y) \ \ X \\<^bsup>M\<^esup> Y" + unfolding def_lepoll_rel def_eqpoll_rel using schroeder_bernstein_closed + by auto + +lemma eqpoll_relE: + "[| X \\<^bsup>M\<^esup> Y; [| X \\<^bsup>M\<^esup> Y; Y \\<^bsup>M\<^esup> X |] ==> P ; M(X) ; M(Y) |] ==> P" + by (blast intro: eqpoll_rel_imp_lepoll_rel eqpoll_rel_sym) + +lemma eqpoll_rel_iff: "M(X) \ M(Y) \ X \\<^bsup>M\<^esup> Y \ X \\<^bsup>M\<^esup> Y & Y \\<^bsup>M\<^esup> X" + by (blast intro: eqpoll_relI elim: eqpoll_relE) + +lemma lepoll_rel_0_is_0: "A \\<^bsup>M\<^esup> 0 \ M(A) \ A = 0" + using def_lepoll_rel + by (cases "A=0") (auto simp add: inj_def) + +(* \<^term>\M(Y) \ 0 \\<^bsup>M\<^esup> Y\ *) +lemmas empty_lepoll_relI = empty_subsetI [THEN subset_imp_lepoll_rel, OF nonempty] + +lemma lepoll_rel_0_iff: "M(A) \ A \\<^bsup>M\<^esup> 0 \ A=0" + by (blast intro: lepoll_rel_0_is_0 lepoll_rel_refl) + +lemma Un_lepoll_rel_Un: + "[| A \\<^bsup>M\<^esup> B; C \\<^bsup>M\<^esup> D; B \ D = 0; M(A); M(B); M(C); M(D) |] ==> A \ C \\<^bsup>M\<^esup> B \ D" + using def_lepoll_rel using inj_disjoint_Un[of _ A B _ C D] if_then_replacement + apply (auto) + apply (rule, assumption) + apply (auto intro!:lam_closed elim:transM)+ + done + +lemma eqpoll_rel_0_is_0: "A \\<^bsup>M\<^esup> 0 \ M(A) \ A = 0" + using eqpoll_rel_imp_lepoll_rel lepoll_rel_0_is_0 nonempty + by blast + +lemma eqpoll_rel_0_iff: "M(A) \ A \\<^bsup>M\<^esup> 0 \ A=0" + by (blast intro: eqpoll_rel_0_is_0 eqpoll_rel_refl) + +lemma eqpoll_rel_disjoint_Un: + "[| A \\<^bsup>M\<^esup> B; C \\<^bsup>M\<^esup> D; A \ C = 0; B \ D = 0; M(A); M(B); M(C) ; M(D) |] + ==> A \ C \\<^bsup>M\<^esup> B \ D" + by (auto intro: bij_disjoint_Un simp add:def_eqpoll_rel) + +subsection\lesspoll\_rel: contributions by Krzysztof Grabczewski\ + +lemma lesspoll_rel_not_refl: "M(i) \ ~ (i \\<^bsup>M\<^esup> i)" + by (simp add: lesspoll_rel_def eqpoll_rel_refl) + +lemma lesspoll_rel_irrefl: "i \\<^bsup>M\<^esup> i ==> M(i) \ P" + by (simp add: lesspoll_rel_def eqpoll_rel_refl) + +lemma lesspoll_rel_imp_lepoll_rel: "\A \\<^bsup>M\<^esup> B; M(A); M(B)\\ A \\<^bsup>M\<^esup> B" + by (unfold lesspoll_rel_def, blast) + +lemma rvimage_closed [intro,simp]: + assumes + "M(A)" "M(f)" "M(r)" + shows + "M(rvimage(A,f,r))" + unfolding rvimage_def using assms rvimage_separation by auto + +lemma lepoll_rel_well_ord: "[| A \\<^bsup>M\<^esup> B; well_ord(B,r); M(A); M(B); M(r) |] ==> \s[M]. well_ord(A,s)" + unfolding def_lepoll_rel by (auto intro:well_ord_rvimage) + +lemma lepoll_rel_iff_leqpoll_rel: "\M(A); M(B)\ \ A \\<^bsup>M\<^esup> B \ A \\<^bsup>M\<^esup> B | A \\<^bsup>M\<^esup> B" + apply (unfold lesspoll_rel_def) + apply (blast intro: eqpoll_relI elim: eqpoll_relE) + done + +end \ \\<^locale>\M_cardinals\\ + +context M_cardinals +begin + +lemma inj_rel_is_fun_M: "f \ inj\<^bsup>M\<^esup>(A,B) \ M(f) \ M(A) \ M(B) \ f \ A \\<^bsup>M\<^esup> B" + using inj_is_fun function_space_rel_char by simp + +\ \In porting the following theorem, I tried to follow the Discipline +strictly, though finally only an approach maximizing the use of +absoluteness results (@{thm function_space_rel_char inj_rel_char}) was + the one paying dividends.\ +lemma inj_rel_not_surj_rel_succ: + notes mem_inj_abs[simp del] + assumes fi: "f \ inj\<^bsup>M\<^esup>(A, succ(m))" and fns: "f \ surj\<^bsup>M\<^esup>(A, succ(m))" + and types: "M(f)" "M(A)" "M(m)" + shows "\f[M]. f \ inj\<^bsup>M\<^esup>(A,m)" +proof - + from fi [THEN inj_rel_is_fun_M] fns types + obtain y where y: "y \ succ(m)" "\x. x\A \ f ` x \ y" "M(y)" + by (auto simp add: def_surj_rel) + show ?thesis + proof + from types and \M(y)\ + show "M(\z\A. if f ` z = m then y else f ` z)" + using transM[OF _ \M(A)\] lam_if_then_apply_replacement2 lam_replacement_iff_lam_closed + by (auto) + with types y fi + have "(\z\A. if f`z = m then y else f`z) \ A\\<^bsup>M\<^esup> m" + using function_space_rel_char inj_rel_char inj_is_fun[of f A "succ(m)"] + by (auto intro!: if_type [THEN lam_type] dest: apply_funtype) + with types y fi + show "(\z\A. if f`z = m then y else f`z) \ inj\<^bsup>M\<^esup>(A, m)" + by (simp add: def_inj_rel) blast + qed +qed + +(** Variations on transitivity **) + +lemma lesspoll_rel_trans [trans]: + "[| X \\<^bsup>M\<^esup> Y; Y \\<^bsup>M\<^esup> Z; M(X); M(Y) ; M(Z) |] ==> X \\<^bsup>M\<^esup> Z" + apply (unfold lesspoll_rel_def) + apply (blast elim: eqpoll_relE intro: eqpoll_relI lepoll_rel_trans) + done + +lemma lesspoll_rel_trans1 [trans]: + "[| X \\<^bsup>M\<^esup> Y; Y \\<^bsup>M\<^esup> Z; M(X); M(Y) ; M(Z) |] ==> X \\<^bsup>M\<^esup> Z" + apply (unfold lesspoll_rel_def) + apply (blast elim: eqpoll_relE intro: eqpoll_relI lepoll_rel_trans) + done + +lemma lesspoll_rel_trans2 [trans]: + "[| X \\<^bsup>M\<^esup> Y; Y \\<^bsup>M\<^esup> Z; M(X); M(Y) ; M(Z)|] ==> X \\<^bsup>M\<^esup> Z" + apply (unfold lesspoll_rel_def) + apply (blast elim: eqpoll_relE intro: eqpoll_relI lepoll_rel_trans) + done + +lemma eq_lesspoll_rel_trans [trans]: + "[| X \\<^bsup>M\<^esup> Y; Y \\<^bsup>M\<^esup> Z; M(X); M(Y) ; M(Z) |] ==> X \\<^bsup>M\<^esup> Z" + by (blast intro: eqpoll_rel_imp_lepoll_rel lesspoll_rel_trans1) + +lemma lesspoll_rel_eq_trans [trans]: + "[| X \\<^bsup>M\<^esup> Y; Y \\<^bsup>M\<^esup> Z; M(X); M(Y) ; M(Z) |] ==> X \\<^bsup>M\<^esup> Z" + by (blast intro: eqpoll_rel_imp_lepoll_rel lesspoll_rel_trans2) + +lemma is_cardinal_cong: + assumes "X \\<^bsup>M\<^esup> Y" "M(X)" "M(Y)" + shows "\\[M]. is_cardinal(M,X,\) \ is_cardinal(M,Y,\)" +proof - + from assms + have "(\ i. M(i) \ i \\<^bsup>M\<^esup> X) = (\ i. M(i) \ i \\<^bsup>M\<^esup> Y)" + by (intro Least_cong) (auto intro: comp_bij bij_converse_bij simp add:def_eqpoll_rel) + moreover from assms + have "M(\ i. M(i) \ i \\<^bsup>M\<^esup> X)" + using Least_closed' by fastforce + moreover + note assms + ultimately + show ?thesis + using is_cardinal_iff_Least + by auto +qed + +\ \ported from Cardinal\ +lemma cardinal_rel_cong: "X \\<^bsup>M\<^esup> Y \ M(X) \ M(Y) \ |X|\<^bsup>M\<^esup> = |Y|\<^bsup>M\<^esup>" + apply (simp add: def_eqpoll_rel cardinal_rel_def) + apply (rule Least_cong) + apply (auto intro: comp_bij bij_converse_bij) + done + +lemma well_ord_is_cardinal_eqpoll_rel: + assumes "well_ord(A,r)" shows "is_cardinal(M,A,\) \ M(A) \ M(\) \ M(r) \ \ \\<^bsup>M\<^esup> A" +proof (subst is_cardinal_iff_Least[THEN iffD1, of A \]) + assume "M(A)" "M(\)" "M(r)" "is_cardinal(M,A,\)" + moreover from assms and calculation + obtain f i where "M(f)" "Ord(i)" "M(i)" "f \ bij(A,i)" + using ordertype_exists[of A r] ord_iso_is_bij by auto + moreover + have "M(\ i. M(i) \ i \\<^bsup>M\<^esup> A)" + using Least_closed' by fastforce + ultimately + show "(\ i. M(i) \ i \\<^bsup>M\<^esup> A) \\<^bsup>M\<^esup> A" + using assms[THEN well_ord_imp_relativized] + LeastI[of "\i. M(i) \ i \\<^bsup>M\<^esup> A" i] Ord_ordertype[OF assms] + bij_converse_bij[THEN bij_imp_eqpoll_rel, of f] by simp +qed + +lemmas Ord_is_cardinal_eqpoll_rel = well_ord_Memrel[THEN well_ord_is_cardinal_eqpoll_rel] + + +(**********************************************************************) +(****************** Results imported from Cardinal.thy ****************) +(**********************************************************************) + +section\Porting from \<^theory>\ZF.Cardinal\\ + +txt\The following results were ported more or less directly from \<^theory>\ZF.Cardinal\\ + +\ \This result relies on various closure properties and + thus cannot be translated directly\ +lemma well_ord_cardinal_rel_eqpoll_rel: + assumes r: "well_ord(A,r)" and "M(A)" "M(r)" shows "|A|\<^bsup>M\<^esup> \\<^bsup>M\<^esup> A" + using assms well_ord_is_cardinal_eqpoll_rel is_cardinal_iff + by blast + +lemmas Ord_cardinal_rel_eqpoll_rel = well_ord_Memrel[THEN well_ord_cardinal_rel_eqpoll_rel] + +lemma Ord_cardinal_rel_idem: "Ord(A) \ M(A) \ ||A|\<^bsup>M\<^esup>|\<^bsup>M\<^esup> = |A|\<^bsup>M\<^esup>" + by (rule_tac Ord_cardinal_rel_eqpoll_rel [THEN cardinal_rel_cong]) auto + +lemma well_ord_cardinal_rel_eqE: + assumes woX: "well_ord(X,r)" and woY: "well_ord(Y,s)" and eq: "|X|\<^bsup>M\<^esup> = |Y|\<^bsup>M\<^esup>" + and types: "M(X)" "M(r)" "M(Y)" "M(s)" + shows "X \\<^bsup>M\<^esup> Y" +proof - + from types + have "X \\<^bsup>M\<^esup> |X|\<^bsup>M\<^esup>" by (blast intro: well_ord_cardinal_rel_eqpoll_rel [OF woX] eqpoll_rel_sym) + also + have "... = |Y|\<^bsup>M\<^esup>" by (rule eq) + also from types + have "... \\<^bsup>M\<^esup> Y" by (rule_tac well_ord_cardinal_rel_eqpoll_rel [OF woY]) + finally show ?thesis by (simp add:types) +qed + +lemma well_ord_cardinal_rel_eqpoll_rel_iff: + "[| well_ord(X,r); well_ord(Y,s); M(X); M(r); M(Y); M(s) |] ==> |X|\<^bsup>M\<^esup> = |Y|\<^bsup>M\<^esup> \ X \\<^bsup>M\<^esup> Y" + by (blast intro: cardinal_rel_cong well_ord_cardinal_rel_eqE) + +lemma Ord_cardinal_rel_le: "Ord(i) \ M(i) ==> |i|\<^bsup>M\<^esup> \ i" + unfolding cardinal_rel_def + using eqpoll_rel_refl Least_le by simp + +lemma Card_rel_cardinal_rel_eq: "Card\<^bsup>M\<^esup>(K) ==> M(K) \ |K|\<^bsup>M\<^esup> = K" + apply (unfold Card_rel_def) + apply (erule sym) + done + +lemma Card_relI: "[| Ord(i); !!j. j M(j) ==> ~(j \\<^bsup>M\<^esup> i); M(i) |] ==> Card\<^bsup>M\<^esup>(i)" + apply (unfold Card_rel_def cardinal_rel_def) + apply (subst Least_equality) + apply (blast intro: eqpoll_rel_refl)+ + done + +lemma Card_rel_is_Ord: "Card\<^bsup>M\<^esup>(i) ==> M(i) \ Ord(i)" + apply (unfold Card_rel_def cardinal_rel_def) + apply (erule ssubst) + apply (rule Ord_Least) + done + +lemma Card_rel_cardinal_rel_le: "Card\<^bsup>M\<^esup>(K) ==> M(K) \ K \ |K|\<^bsup>M\<^esup>" + apply (simp (no_asm_simp) add: Card_rel_is_Ord Card_rel_cardinal_rel_eq) + done + +lemma Ord_cardinal_rel [simp,intro!]: "M(A) \ Ord(|A|\<^bsup>M\<^esup>)" + apply (unfold cardinal_rel_def) + apply (rule Ord_Least) + done + +lemma Card_rel_iff_initial: assumes types:"M(K)" + shows "Card\<^bsup>M\<^esup>(K) \ Ord(K) & (\j[M]. j ~ (j \\<^bsup>M\<^esup> K))" +proof - + { fix j + assume K: "Card\<^bsup>M\<^esup>(K)" "M(j) \ j \\<^bsup>M\<^esup> K" + assume "j < K" + also have "... = (\ i. M(i) \ i \\<^bsup>M\<^esup> K)" using K + by (simp add: Card_rel_def cardinal_rel_def types) + finally have "j < (\ i. M(i) \ i \\<^bsup>M\<^esup> K)" . + then have "False" using K + by (best intro: less_LeastE[of "\j. M(j) \ j \\<^bsup>M\<^esup> K"]) + } + with types + show ?thesis + by (blast intro: Card_relI Card_rel_is_Ord) +qed + +lemma lt_Card_rel_imp_lesspoll_rel: "[| Card\<^bsup>M\<^esup>(a); i i \\<^bsup>M\<^esup> a" + apply (unfold lesspoll_rel_def) + apply (frule Card_rel_iff_initial [THEN iffD1], assumption) + apply (blast intro!: leI [THEN le_imp_lepoll_rel]) + done + +lemma Card_rel_0: "Card\<^bsup>M\<^esup>(0)" + apply (rule Ord_0 [THEN Card_relI]) + apply (auto elim!: ltE) + done + +lemma Card_rel_Un: "[| Card\<^bsup>M\<^esup>(K); Card\<^bsup>M\<^esup>(L); M(K); M(L) |] ==> Card\<^bsup>M\<^esup>(K \ L)" + apply (rule Ord_linear_le [of K L]) + apply (simp_all add: subset_Un_iff [THEN iffD1] Card_rel_is_Ord le_imp_subset + subset_Un_iff2 [THEN iffD1]) + done + +lemma Card_rel_cardinal_rel [iff]: assumes types:"M(A)" shows "Card\<^bsup>M\<^esup>(|A|\<^bsup>M\<^esup>)" + using assms +proof (unfold cardinal_rel_def) + show "Card\<^bsup>M\<^esup>(\ i. M(i) \ i \\<^bsup>M\<^esup> A)" + proof (cases "\i[M]. Ord (i) \ i \\<^bsup>M\<^esup> A") + case False thus ?thesis \ \degenerate case\ + using Least_0[of "\i. M(i) \ i \\<^bsup>M\<^esup> A"] Card_rel_0 + by fastforce + next + case True \ \real case: \<^term>\A\ is isomorphic to some ordinal\ + then obtain i where i: "Ord(i)" "i \\<^bsup>M\<^esup> A" "M(i)" by blast + show ?thesis + proof (rule Card_relI [OF Ord_Least], rule notI) + fix j + assume j: "j < (\ i. M(i) \ i \\<^bsup>M\<^esup> A)" and "M(j)" + assume "j \\<^bsup>M\<^esup> (\ i. M(i) \ i \\<^bsup>M\<^esup> A)" + also have "... \\<^bsup>M\<^esup> A" using i LeastI[of "\i. M(i) \ i \\<^bsup>M\<^esup> A"] by (auto) + finally have "j \\<^bsup>M\<^esup> A" + using Least_closed'[of "\i. M(i) \ i \\<^bsup>M\<^esup> A"] by (simp add: \M(j)\ types) + thus False + using \M(j)\ by (blast intro:less_LeastE [OF _ j]) + qed (auto intro:Least_closed) + qed +qed + +lemma cardinal_rel_eq_lemma: + assumes i:"|i|\<^bsup>M\<^esup> \ j" and j: "j \ i" and types: "M(i)" "M(j)" + shows "|j|\<^bsup>M\<^esup> = |i|\<^bsup>M\<^esup>" +proof (rule eqpoll_relI [THEN cardinal_rel_cong]) + show "j \\<^bsup>M\<^esup> i" by (rule le_imp_lepoll_rel [OF j]) (simp_all add:types) +next + have Oi: "Ord(i)" using j by (rule le_Ord2) + with types + have "i \\<^bsup>M\<^esup> |i|\<^bsup>M\<^esup>" + by (blast intro: Ord_cardinal_rel_eqpoll_rel eqpoll_rel_sym) + also from types + have "... \\<^bsup>M\<^esup> j" + by (blast intro: le_imp_lepoll_rel i) + finally show "i \\<^bsup>M\<^esup> j" by (simp_all add:types) +qed (simp_all add:types) + +lemma cardinal_rel_mono: + assumes ij: "i \ j" and types:"M(i)" "M(j)" shows "|i|\<^bsup>M\<^esup> \ |j|\<^bsup>M\<^esup>" + using Ord_cardinal_rel [OF \M(i)\] Ord_cardinal_rel [OF \M(j)\] +proof (cases rule: Ord_linear_le) + case le then show ?thesis . +next + case ge + have i: "Ord(i)" using ij + by (simp add: lt_Ord) + have ci: "|i|\<^bsup>M\<^esup> \ j" + by (blast intro: Ord_cardinal_rel_le ij le_trans i types) + have "|i|\<^bsup>M\<^esup> = ||i|\<^bsup>M\<^esup>|\<^bsup>M\<^esup>" + by (auto simp add: Ord_cardinal_rel_idem i types) + also have "... = |j|\<^bsup>M\<^esup>" + by (rule cardinal_rel_eq_lemma [OF ge ci]) (simp_all add:types) + finally have "|i|\<^bsup>M\<^esup> = |j|\<^bsup>M\<^esup>" . + thus ?thesis by (simp add:types) +qed + +lemma cardinal_rel_lt_imp_lt: "[| |i|\<^bsup>M\<^esup> < |j|\<^bsup>M\<^esup>; Ord(i); Ord(j); M(i); M(j) |] ==> i < j" + apply (rule Ord_linear2 [of i j], assumption+) + apply (erule lt_trans2 [THEN lt_irrefl]) + apply (erule cardinal_rel_mono, assumption+) + done + +lemma Card_rel_lt_imp_lt: "[| |i|\<^bsup>M\<^esup> < K; Ord(i); Card\<^bsup>M\<^esup>(K); M(i); M(K)|] ==> i < K" + by (simp (no_asm_simp) add: cardinal_rel_lt_imp_lt Card_rel_is_Ord Card_rel_cardinal_rel_eq) + +lemma Card_rel_lt_iff: "[| Ord(i); Card\<^bsup>M\<^esup>(K); M(i); M(K) |] ==> (|i|\<^bsup>M\<^esup> < K) \ (i < K)" + by (blast intro: Card_rel_lt_imp_lt Ord_cardinal_rel_le [THEN lt_trans1]) + +lemma Card_rel_le_iff: "[| Ord(i); Card\<^bsup>M\<^esup>(K); M(i); M(K) |] ==> (K \ |i|\<^bsup>M\<^esup>) \ (K \ i)" + by (simp add: Card_rel_lt_iff Card_rel_is_Ord not_lt_iff_le [THEN iff_sym]) + +lemma well_ord_lepoll_rel_imp_cardinal_rel_le: + assumes wB: "well_ord(B,r)" and AB: "A \\<^bsup>M\<^esup> B" + and + types: "M(B)" "M(r)" "M(A)" + shows "|A|\<^bsup>M\<^esup> \ |B|\<^bsup>M\<^esup>" + using Ord_cardinal_rel [OF \M(A)\] Ord_cardinal_rel [OF \M(B)\] +proof (cases rule: Ord_linear_le) + case le thus ?thesis . +next + case ge + from lepoll_rel_well_ord [OF AB wB] + obtain s where s: "well_ord(A, s)" "M(s)" by (blast intro:types) + have "B \\<^bsup>M\<^esup> |B|\<^bsup>M\<^esup>" by (blast intro: wB eqpoll_rel_sym well_ord_cardinal_rel_eqpoll_rel types) + also have "... \\<^bsup>M\<^esup> |A|\<^bsup>M\<^esup>" by (rule le_imp_lepoll_rel [OF ge]) (simp_all add:types) + also have "... \\<^bsup>M\<^esup> A" by (rule well_ord_cardinal_rel_eqpoll_rel [OF s(1) _ s(2)]) (simp_all add:types) + finally have "B \\<^bsup>M\<^esup> A" by (simp_all add:types) + hence "A \\<^bsup>M\<^esup> B" by (blast intro: eqpoll_relI AB types) + hence "|A|\<^bsup>M\<^esup> = |B|\<^bsup>M\<^esup>" by (rule cardinal_rel_cong) (simp_all add:types) + thus ?thesis by (simp_all add:types) +qed + +lemma lepoll_rel_cardinal_rel_le: "[| A \\<^bsup>M\<^esup> i; Ord(i); M(A); M(i) |] ==> |A|\<^bsup>M\<^esup> \ i" + using Memrel_closed + apply (rule_tac le_trans) + apply (erule well_ord_Memrel [THEN well_ord_lepoll_rel_imp_cardinal_rel_le], assumption+) + apply (erule Ord_cardinal_rel_le, assumption) + done + +lemma lepoll_rel_Ord_imp_eqpoll_rel: "[| A \\<^bsup>M\<^esup> i; Ord(i); M(A); M(i) |] ==> |A|\<^bsup>M\<^esup> \\<^bsup>M\<^esup> A" + by (blast intro: lepoll_rel_cardinal_rel_le well_ord_Memrel well_ord_cardinal_rel_eqpoll_rel dest!: lepoll_rel_well_ord) + +lemma lesspoll_rel_imp_eqpoll_rel: "[| A \\<^bsup>M\<^esup> i; Ord(i); M(A); M(i) |] ==> |A|\<^bsup>M\<^esup> \\<^bsup>M\<^esup> A" + using lepoll_rel_Ord_imp_eqpoll_rel[OF lesspoll_rel_imp_lepoll_rel] . + +lemma lesspoll_cardinal_lt_rel: + shows "[| A \\<^bsup>M\<^esup> i; Ord(i); M(i); M(A) |] ==> |A|\<^bsup>M\<^esup> < i" +proof - + assume assms:"A \\<^bsup>M\<^esup> i" \Ord(i)\ \M(i)\ \M(A)\ + then + have A:"Ord(|A|\<^bsup>M\<^esup>)" "|A|\<^bsup>M\<^esup> \\<^bsup>M\<^esup> A" "M(|A|\<^bsup>M\<^esup>)" + using Ord_cardinal_rel lesspoll_rel_imp_eqpoll_rel + by simp_all + with assms + have "|A|\<^bsup>M\<^esup> \\<^bsup>M\<^esup> i" + using eq_lesspoll_rel_trans by auto + consider "|A|\<^bsup>M\<^esup>\i" | "|A|\<^bsup>M\<^esup>=i" | "i\|A|\<^bsup>M\<^esup>" + using Ord_linear[OF \Ord(i)\ \Ord(|A|\<^bsup>M\<^esup>)\] by auto + then + have "|A|\<^bsup>M\<^esup> < i" + proof(cases) + case 1 + then show ?thesis using ltI \Ord(i)\ by simp + next + case 2 + with \|A|\<^bsup>M\<^esup> \\<^bsup>M\<^esup> i\ \M(i)\ + show ?thesis using lesspoll_rel_irrefl by simp + next + case 3 + with \Ord(|A|\<^bsup>M\<^esup>)\ + have "i<|A|\<^bsup>M\<^esup>" using ltI by simp + with \M(A)\ A \M(i)\ + have "i \\<^bsup>M\<^esup> |A|\<^bsup>M\<^esup>" + using lt_Card_rel_imp_lesspoll_rel Card_rel_cardinal_rel by simp + with \M(|A|\<^bsup>M\<^esup>)\ \M(i)\ + show ?thesis + using lesspoll_rel_irrefl lesspoll_rel_trans[OF \|A|\<^bsup>M\<^esup> \\<^bsup>M\<^esup> i\ \i \\<^bsup>M\<^esup> _ \] + by simp + qed + then show ?thesis by simp +qed + +lemma cardinal_rel_subset_Ord: "[|A<=i; Ord(i); M(A); M(i)|] ==> |A|\<^bsup>M\<^esup> \ i" + apply (drule subset_imp_lepoll_rel [THEN lepoll_rel_cardinal_rel_le]) + apply (auto simp add: lt_def) + apply (blast intro: Ord_trans) + done + +\ \The next lemma is the first with several porting issues\ +lemma cons_lepoll_rel_consD: + "[| cons(u,A) \\<^bsup>M\<^esup> cons(v,B); u\A; v\B; M(u); M(A); M(v); M(B) |] ==> A \\<^bsup>M\<^esup> B" + apply (simp add: def_lepoll_rel, unfold inj_def, safe) + apply (rule_tac x = "\x\A. if f`x=v then f`u else f`x" in rexI) + apply (rule CollectI) + (*Proving it's in the function space A->B*) + apply (rule if_type [THEN lam_type]) + apply (blast dest: apply_funtype) + apply (blast elim!: mem_irrefl dest: apply_funtype) + (*Proving it's injective*) + apply (auto simp add:transM[of _ A]) + using lam_replacement_iff_lam_closed lam_if_then_apply_replacement + by simp + +lemma cons_eqpoll_rel_consD: "[| cons(u,A) \\<^bsup>M\<^esup> cons(v,B); u\A; v\B; M(u); M(A); M(v); M(B) |] ==> A \\<^bsup>M\<^esup> B" + apply (simp add: eqpoll_rel_iff) + apply (blast intro: cons_lepoll_rel_consD) + done + +lemma succ_lepoll_rel_succD: "succ(m) \\<^bsup>M\<^esup> succ(n) \ M(m) \ M(n) ==> m \\<^bsup>M\<^esup> n" + apply (unfold succ_def) + apply (erule cons_lepoll_rel_consD) + apply (rule mem_not_refl)+ + apply assumption+ + done + +lemma nat_lepoll_rel_imp_le: + "m \ nat ==> n \ nat \ m \\<^bsup>M\<^esup> n \ M(m) \ M(n) \ m \ n" +proof (induct m arbitrary: n rule: nat_induct) + case 0 thus ?case by (blast intro!: nat_0_le) +next + case (succ m) + show ?case using \n \ nat\ + proof (cases rule: natE) + case 0 thus ?thesis using succ + by (simp add: def_lepoll_rel inj_def) + next + case (succ n') thus ?thesis using succ.hyps \ succ(m) \\<^bsup>M\<^esup> n\ + by (blast dest!: succ_lepoll_rel_succD) + qed +qed + +lemma nat_eqpoll_rel_iff: "[| m \ nat; n \ nat; M(m); M(n) |] ==> m \\<^bsup>M\<^esup> n \ m = n" + apply (rule iffI) + apply (blast intro: nat_lepoll_rel_imp_le le_anti_sym elim!: eqpoll_relE) + apply (simp add: eqpoll_rel_refl) + done + +lemma nat_into_Card_rel: + assumes n: "n \ nat" and types: "M(n)" shows "Card\<^bsup>M\<^esup>(n)" + using types + apply (subst Card_rel_def) +proof (unfold cardinal_rel_def, rule sym) + have "Ord(n)" using n by auto + moreover + { fix i + assume "i < n" "M(i)" "i \\<^bsup>M\<^esup> n" + hence False using n + by (auto simp add: lt_nat_in_nat [THEN nat_eqpoll_rel_iff] types) + } + ultimately show "(\ i. M(i) \ i \\<^bsup>M\<^esup> n) = n" by (auto intro!: Least_equality types eqpoll_rel_refl) +qed + +lemmas cardinal_rel_0 = nat_0I [THEN nat_into_Card_rel, THEN Card_rel_cardinal_rel_eq, simplified, iff] +lemmas cardinal_rel_1 = nat_1I [THEN nat_into_Card_rel, THEN Card_rel_cardinal_rel_eq, simplified, iff] + +lemma succ_lepoll_rel_natE: "[| succ(n) \\<^bsup>M\<^esup> n; n \ nat |] ==> P" + by (rule nat_lepoll_rel_imp_le [THEN lt_irrefl], auto) + +lemma nat_lepoll_rel_imp_ex_eqpoll_rel_n: + "[| n \ nat; nat \\<^bsup>M\<^esup> X ; M(n); M(X)|] ==> \Y[M]. Y \ X & n \\<^bsup>M\<^esup> Y" + apply (simp add: def_lepoll_rel def_eqpoll_rel) + apply (fast del: subsetI subsetCE + intro!: subset_SIs + dest!: Ord_nat [THEN [2] OrdmemD, THEN [2] restrict_inj] + elim!: restrict_bij + inj_is_fun [THEN fun_is_rel, THEN image_subset]) + done + +lemma lepoll_rel_succ: "M(i) \ i \\<^bsup>M\<^esup> succ(i)" + by (blast intro: subset_imp_lepoll_rel) + +lemma lepoll_rel_imp_lesspoll_rel_succ: + assumes A: "A \\<^bsup>M\<^esup> m" and m: "m \ nat" + and types: "M(A)" "M(m)" + shows "A \\<^bsup>M\<^esup> succ(m)" +proof - + { assume "A \\<^bsup>M\<^esup> succ(m)" + hence "succ(m) \\<^bsup>M\<^esup> A" by (rule eqpoll_rel_sym) (auto simp add:types) + also have "... \\<^bsup>M\<^esup> m" by (rule A) + finally have "succ(m) \\<^bsup>M\<^esup> m" by (auto simp add:types) + hence False by (rule succ_lepoll_rel_natE) (rule m) } + moreover have "A \\<^bsup>M\<^esup> succ(m)" by (blast intro: lepoll_rel_trans A lepoll_rel_succ types) + ultimately show ?thesis by (auto simp add: types lesspoll_rel_def) +qed + +lemma lesspoll_rel_succ_imp_lepoll_rel: + "[| A \\<^bsup>M\<^esup> succ(m); m \ nat; M(A); M(m) |] ==> A \\<^bsup>M\<^esup> m" +proof - + { + assume "m \ nat" "M(A)" "M(m)" "A \\<^bsup>M\<^esup> succ(m)" + "\f\inj\<^bsup>M\<^esup>(A, succ(m)). f \ surj\<^bsup>M\<^esup>(A, succ(m))" + moreover from this + obtain f where "M(f)" "f\inj\<^bsup>M\<^esup>(A,succ(m))" + using def_lepoll_rel by auto + moreover from calculation + have "f \ surj\<^bsup>M\<^esup>(A, succ(m))" by simp + ultimately + have "\f[M]. f \ inj\<^bsup>M\<^esup>(A, m)" + using inj_rel_not_surj_rel_succ by auto + } + from this + show "\ A \\<^bsup>M\<^esup> succ(m); m \ nat; M(A); M(m) \ \ A \\<^bsup>M\<^esup> m" + unfolding lepoll_rel_def eqpoll_rel_def bij_rel_def lesspoll_rel_def + by (simp del:mem_inj_abs) +qed + +lemma lesspoll_rel_succ_iff: "m \ nat \ M(A) ==> A \\<^bsup>M\<^esup> succ(m) \ A \\<^bsup>M\<^esup> m" + by (blast intro!: lepoll_rel_imp_lesspoll_rel_succ lesspoll_rel_succ_imp_lepoll_rel) + +lemma lepoll_rel_succ_disj: "[| A \\<^bsup>M\<^esup> succ(m); m \ nat; M(A) ; M(m)|] ==> A \\<^bsup>M\<^esup> m | A \\<^bsup>M\<^esup> succ(m)" + apply (rule disjCI) + apply (rule lesspoll_rel_succ_imp_lepoll_rel) + prefer 2 apply assumption + apply (simp (no_asm_simp) add: lesspoll_rel_def, assumption+) + done + +lemma lesspoll_rel_cardinal_rel_lt: "[| A \\<^bsup>M\<^esup> i; Ord(i); M(A); M(i) |] ==> |A|\<^bsup>M\<^esup> < i" + apply (unfold lesspoll_rel_def, clarify) + apply (frule lepoll_rel_cardinal_rel_le, assumption+) \ \because of types\ + apply (blast intro: well_ord_Memrel well_ord_cardinal_rel_eqpoll_rel [THEN eqpoll_rel_sym] + dest: lepoll_rel_well_ord elim!: leE) + done + + +lemma lt_not_lepoll_rel: + assumes n: "n nat" + and types:"M(n)" "M(i)" shows "~ i \\<^bsup>M\<^esup> n" +proof - + { assume i: "i \\<^bsup>M\<^esup> n" + have "succ(n) \\<^bsup>M\<^esup> i" using n + by (elim ltE, blast intro: Ord_succ_subsetI [THEN subset_imp_lepoll_rel] types) + also have "... \\<^bsup>M\<^esup> n" by (rule i) + finally have "succ(n) \\<^bsup>M\<^esup> n" by (simp add:types) + hence False by (rule succ_lepoll_rel_natE) (rule n) } + thus ?thesis by auto +qed + +text\A slightly weaker version of \nat_eqpoll_rel_iff\\ +lemma Ord_nat_eqpoll_rel_iff: + assumes i: "Ord(i)" and n: "n \ nat" + and types: "M(i)" "M(n)" + shows "i \\<^bsup>M\<^esup> n \ i=n" + using i nat_into_Ord [OF n] +proof (cases rule: Ord_linear_lt) + case lt + hence "i \ nat" by (rule lt_nat_in_nat) (rule n) + thus ?thesis by (simp add: nat_eqpoll_rel_iff n types) +next + case eq + thus ?thesis by (simp add: eqpoll_rel_refl types) +next + case gt + hence "~ i \\<^bsup>M\<^esup> n" using n by (rule lt_not_lepoll_rel) (simp_all add: types) + hence "~ i \\<^bsup>M\<^esup> n" using n by (blast intro: eqpoll_rel_imp_lepoll_rel types) + moreover have "i \ n" using \n by auto + ultimately show ?thesis by blast +qed + +lemma Card_rel_nat: "Card\<^bsup>M\<^esup>(nat)" +proof - + { fix i + assume i: "i < nat" "i \\<^bsup>M\<^esup> nat" "M(i)" + hence "~ nat \\<^bsup>M\<^esup> i" + by (simp add: lt_def lt_not_lepoll_rel) + hence False using i + by (simp add: eqpoll_rel_iff) + } + hence "(\ i. M(i) \ i \\<^bsup>M\<^esup> nat) = nat" by (blast intro: Least_equality eqpoll_rel_refl) + thus ?thesis + by (auto simp add: Card_rel_def cardinal_rel_def) +qed + +lemma nat_le_cardinal_rel: "nat \ i \ M(i) ==> nat \ |i|\<^bsup>M\<^esup>" + apply (rule Card_rel_nat [THEN Card_rel_cardinal_rel_eq, THEN subst], simp_all) + apply (erule cardinal_rel_mono, simp_all) + done + +lemma n_lesspoll_rel_nat: "n \ nat ==> n \\<^bsup>M\<^esup> nat" + by (blast intro: Card_rel_nat ltI lt_Card_rel_imp_lesspoll_rel) + +lemma cons_lepoll_rel_cong: + "[| A \\<^bsup>M\<^esup> B; b \ B; M(A); M(B); M(b); M(a) |] ==> cons(a,A) \\<^bsup>M\<^esup> cons(b,B)" + apply (subst (asm) def_lepoll_rel, simp_all, subst def_lepoll_rel, simp_all, safe) + apply (rule_tac x = "\y\cons (a,A) . if y=a then b else f`y" in rexI) + apply (rule_tac d = "%z. if z \ B then converse (f) `z else a" in lam_injective) + apply (safe elim!: consE') + apply simp_all + apply (blast intro: inj_is_fun [THEN apply_type])+ + apply (auto intro:lam_closed lam_if_then_replacement simp add:transM[of _ A]) + done + +lemma cons_eqpoll_rel_cong: + "[| A \\<^bsup>M\<^esup> B; a \ A; b \ B; M(A); M(B); M(a) ; M(b) |] ==> cons(a,A) \\<^bsup>M\<^esup> cons(b,B)" + by (simp add: eqpoll_rel_iff cons_lepoll_rel_cong) + +lemma cons_lepoll_rel_cons_iff: + "[| a \ A; b \ B; M(a); M(A); M(b); M(B) |] ==> cons(a,A) \\<^bsup>M\<^esup> cons(b,B) \ A \\<^bsup>M\<^esup> B" + by (blast intro: cons_lepoll_rel_cong cons_lepoll_rel_consD) + +lemma cons_eqpoll_rel_cons_iff: + "[| a \ A; b \ B; M(a); M(A); M(b); M(B) |] ==> cons(a,A) \\<^bsup>M\<^esup> cons(b,B) \ A \\<^bsup>M\<^esup> B" + by (blast intro: cons_eqpoll_rel_cong cons_eqpoll_rel_consD) + +lemma singleton_eqpoll_rel_1: "M(a) \ {a} \\<^bsup>M\<^esup> 1" + apply (unfold succ_def) + apply (blast intro!: eqpoll_rel_refl [THEN cons_eqpoll_rel_cong]) + done + +lemma cardinal_rel_singleton: "M(a) \ |{a}|\<^bsup>M\<^esup> = 1" + apply (rule singleton_eqpoll_rel_1 [THEN cardinal_rel_cong, THEN trans]) + apply (simp (no_asm) add: nat_into_Card_rel [THEN Card_rel_cardinal_rel_eq]) + apply auto + done + +lemma not_0_is_lepoll_rel_1: "A \ 0 ==> M(A) \ 1 \\<^bsup>M\<^esup> A" + apply (erule not_emptyE) + apply (rule_tac a = "cons (x, A-{x}) " in subst) + apply (rule_tac [2] a = "cons(0,0)" and P= "%y. y \\<^bsup>M\<^esup> cons (x, A-{x})" in subst) + apply auto +proof - + fix x + assume "M(A)" + then + show "x \ A \ {0} \\<^bsup>M\<^esup> cons(x, A - {x})" + by (auto intro: cons_lepoll_rel_cong transM[OF _ \M(A)\] subset_imp_lepoll_rel) +qed + + +lemma succ_eqpoll_rel_cong: "A \\<^bsup>M\<^esup> B \ M(A) \ M(B) ==> succ(A) \\<^bsup>M\<^esup> succ(B)" + apply (unfold succ_def) + apply (simp add: cons_eqpoll_rel_cong mem_not_refl) + done + +text\The next result was not straightforward to port, and even a +different statement was needed.\ + +lemma sum_bij_rel: + "[| f \ bij\<^bsup>M\<^esup>(A,C); g \ bij\<^bsup>M\<^esup>(B,D); M(f); M(A); M(C); M(g); M(B); M(D)|] + ==> (\z\A+B. case(%x. Inl(f`x), %y. Inr(g`y), z)) \ bij\<^bsup>M\<^esup>(A+B, C+D)" +proof - + assume asm:"f \ bij\<^bsup>M\<^esup>(A,C)" "g \ bij\<^bsup>M\<^esup>(B,D)" "M(f)" "M(A)" "M(C)" "M(g)" "M(B)" "M(D)" + then + have "M(\z\A+B. case(%x. Inl(f`x), %y. Inr(g`y), z))" + using transM[OF _ \M(A)\] transM[OF _ \M(B)\] + by (auto intro:case_replacement4[THEN lam_closed]) + with asm + show ?thesis + apply simp + apply (rule_tac d = "case (%x. Inl (converse(f)`x), %y. Inr(converse(g)`y))" + in lam_bijective) + apply (typecheck add: bij_is_inj inj_is_fun) + apply (auto simp add: left_inverse_bij right_inverse_bij) + done +qed + +lemma sum_bij_rel': + assumes "f \ bij\<^bsup>M\<^esup>(A,C)" "g \ bij\<^bsup>M\<^esup>(B,D)" "M(f)" + "M(A)" "M(C)" "M(g)" "M(B)" "M(D)" + shows + "(\z\A+B. case(\x. Inl(f`x), \y. Inr(g`y), z)) \ bij(A+B, C+D)" + "M(\z\A+B. case(\x. Inl(f`x), \y. Inr(g`y), z))" +proof - + from assms + show "M(\z\A+B. case(\x. Inl(f`x), \y. Inr(g`y), z))" + using transM[OF _ \M(A)\] transM[OF _ \M(B)\] + by (auto intro:case_replacement4[THEN lam_closed]) + with assms + show "(\z\A+B. case(\x. Inl(f`x), \y. Inr(g`y), z)) \ bij(A+B, C+D)" + apply simp + apply (rule_tac d = "case (%x. Inl (converse(f)`x), %y. Inr(converse(g)`y))" + in lam_bijective) + apply (typecheck add: bij_is_inj inj_is_fun) + apply (auto simp add: left_inverse_bij right_inverse_bij) + done +qed + +lemma sum_eqpoll_rel_cong: + assumes "A \\<^bsup>M\<^esup> C" "B \\<^bsup>M\<^esup> D" "M(A)" "M(C)" "M(B)" "M(D)" + shows "A+B \\<^bsup>M\<^esup> C+D" + using assms +proof (simp add: def_eqpoll_rel, safe, rename_tac g) + fix f g + assume "M(f)" "f \ bij(A, C)" "M(g)" "g \ bij(B, D)" + with assms + obtain h where "h\bij(A+B, C+D)" "M(h)" + using sum_bij_rel'[of f A C g B D] by simp + then + show "\f[M]. f \ bij(A + B, C + D)" + by auto +qed + +lemma prod_bij_rel': + assumes "f \ bij\<^bsup>M\<^esup>(A,C)" "g \ bij\<^bsup>M\<^esup>(B,D)" "M(f)" + "M(A)" "M(C)" "M(g)" "M(B)" "M(D)" + shows + "(\\A*B. ) \ bij(A*B, C*D)" + "M(\\A*B. )" +proof - + from assms + show "M((\\A*B. ))" + using transM[OF _ \M(A)\] transM[OF _ \M(B)\] + transM[OF _ cartprod_closed, of _ A B] + by (auto intro:prod_fun_replacement[THEN lam_closed, of f g "A\B"]) + with assms + show "(\\A*B. ) \ bij(A*B, C*D)" + apply simp + apply (rule_tac d = "%. " + in lam_bijective) + apply (typecheck add: bij_is_inj inj_is_fun) + apply (auto simp add: left_inverse_bij right_inverse_bij) + done +qed + +lemma prod_eqpoll_rel_cong: + assumes "A \\<^bsup>M\<^esup> C" "B \\<^bsup>M\<^esup> D" "M(A)" "M(C)" "M(B)" "M(D)" + shows "A\B \\<^bsup>M\<^esup> C\D" + using assms +proof (simp add: def_eqpoll_rel, safe, rename_tac g) + fix f g + assume "M(f)" "f \ bij(A, C)" "M(g)" "g \ bij(B, D)" + with assms + obtain h where "h\bij(A\B, C\D)" "M(h)" + using prod_bij_rel'[of f A C g B D] by simp + then + show "\f[M]. f \ bij(A \ B, C \ D)" + by auto +qed + +lemma inj_rel_disjoint_eqpoll_rel: + "[| f \ inj\<^bsup>M\<^esup>(A,B); A \ B = 0;M(f); M(A);M(B) |] ==> A \ (B - range(f)) \\<^bsup>M\<^esup> B" + apply (simp add: def_eqpoll_rel) + apply (rule rexI) + apply (rule_tac c = "%x. if x \ A then f`x else x" + and d = "%y. if y \ range (f) then converse (f) `y else y" + in lam_bijective) + apply (blast intro!: if_type inj_is_fun [THEN apply_type]) + apply (simp (no_asm_simp) add: inj_converse_fun [THEN apply_funtype]) + apply (safe elim!: UnE') + apply (simp_all add: inj_is_fun [THEN apply_rangeI]) + apply (blast intro: inj_converse_fun [THEN apply_type]) +proof - + assume "f \ inj(A, B)" "A \ B = 0" "M(f)" "M(A)" "M(B)" + then + show "M(\x\A \ (B - range(f)). if x \ A then f ` x else x)" + using transM[OF _ \M(A)\] transM[OF _ \M(B)\] + lam_replacement_iff_lam_closed lam_if_then_replacement2 + by auto +qed + +lemma Diff_sing_lepoll_rel: + "[| a \ A; A \\<^bsup>M\<^esup> succ(n); M(a); M(A); M(n) |] ==> A - {a} \\<^bsup>M\<^esup> n" + apply (unfold succ_def) + apply (rule cons_lepoll_rel_consD) + apply (rule_tac [3] mem_not_refl) + apply (erule cons_Diff [THEN ssubst], simp_all) + done + +lemma lepoll_rel_Diff_sing: + assumes A: "succ(n) \\<^bsup>M\<^esup> A" + and types: "M(n)" "M(A)" "M(a)" + shows "n \\<^bsup>M\<^esup> A - {a}" +proof - + have "cons(n,n) \\<^bsup>M\<^esup> A" using A + by (unfold succ_def) + also from types + have "... \\<^bsup>M\<^esup> cons(a, A-{a})" + by (blast intro: subset_imp_lepoll_rel) + finally have "cons(n,n) \\<^bsup>M\<^esup> cons(a, A-{a})" by (simp_all add:types) + with types + show ?thesis + by (blast intro: cons_lepoll_rel_consD mem_irrefl) +qed + +lemma Diff_sing_eqpoll_rel: "[| a \ A; A \\<^bsup>M\<^esup> succ(n); M(a); M(A); M(n) |] ==> A - {a} \\<^bsup>M\<^esup> n" + by (blast intro!: eqpoll_relI + elim!: eqpoll_relE + intro: Diff_sing_lepoll_rel lepoll_rel_Diff_sing) + +lemma lepoll_rel_1_is_sing: "[| A \\<^bsup>M\<^esup> 1; a \ A ;M(a); M(A) |] ==> A = {a}" + apply (frule Diff_sing_lepoll_rel, assumption+, simp) + apply (drule lepoll_rel_0_is_0, simp) + apply (blast elim: equalityE) + done + +lemma Un_lepoll_rel_sum: "M(A) \ M(B) \ A \ B \\<^bsup>M\<^esup> A+B" + apply (simp add: def_lepoll_rel) + apply (rule_tac x = "\x\A \ B. if x\A then Inl (x) else Inr (x)" in rexI) + apply (rule_tac d = "%z. snd (z)" in lam_injective) + apply force + apply (simp add: Inl_def Inr_def) +proof - + assume "M(A)" "M(B)" + then + show "M(\x\A \ B. if x \ A then Inl(x) else Inr(x))" + using transM[OF _ \M(A)\] transM[OF _ \M(B)\] if_then_Inj_replacement + by (rule_tac lam_closed) auto +qed + +lemma well_ord_Un_M: + assumes "well_ord(X,R)" "well_ord(Y,S)" + and types: "M(X)" "M(R)" "M(Y)" "M(S)" + shows "\T[M]. well_ord(X \ Y, T)" + using assms + by (erule_tac well_ord_radd [THEN [3] Un_lepoll_rel_sum [THEN lepoll_rel_well_ord]]) + (auto simp add: types) + +lemma disj_Un_eqpoll_rel_sum: "M(A) \ M(B) \ A \ B = 0 \ A \ B \\<^bsup>M\<^esup> A + B" + apply (simp add: def_eqpoll_rel) + apply (rule_tac x = "\a\A \ B. if a \ A then Inl (a) else Inr (a)" in rexI) + apply (rule_tac d = "%z. case (%x. x, %x. x, z)" in lam_bijective) + apply auto +proof - + assume "M(A)" "M(B)" + then + show "M(\x\A \ B. if x \ A then Inl(x) else Inr(x))" + using transM[OF _ \M(A)\] transM[OF _ \M(B)\] if_then_Inj_replacement + by (rule_tac lam_closed) auto +qed + +lemma eqpoll_rel_imp_Finite_rel_iff: "A \\<^bsup>M\<^esup> B ==> M(A) \ M(B) \ Finite_rel(M,A) \ Finite_rel(M,B)" + apply (unfold Finite_rel_def) + apply (blast intro: eqpoll_rel_trans eqpoll_rel_sym) + done + +\ \It seems reasonable to have the absoluteness of \<^term>\Finite\ here, +and deduce the rest of the results from this. + +Perhaps modularize that proof to have absoluteness of injections and +bijections of finite sets (cf. @{thm lesspoll_rel_succ_imp_lepoll_rel}.\ + +lemma Finite_abs[simp]: assumes "M(A)" shows "Finite_rel(M,A) \ Finite(A)" + unfolding Finite_rel_def Finite_def +proof (simp, intro iffI) + assume "\n\nat. A \\<^bsup>M\<^esup> n" + then + obtain n where "A \\<^bsup>M\<^esup> n" "n\nat" by blast + with assms + show "\n\nat. A \ n" + unfolding eqpoll_def using nat_into_M by (auto simp add:def_eqpoll_rel) +next + fix n + assume "\n\nat. A \ n" + then + obtain n where "A \ n" "n\nat" by blast + moreover from this + obtain f where "f \ bij(A,n)" unfolding eqpoll_def by auto + moreover + note assms + moreover from calculation + have "converse(f) \ n\A" using bij_is_fun by simp + moreover from calculation + have "M(converse(f))" using transM[of _ "n\A"] by simp + moreover from calculation + have "M(f)" using bij_is_fun + fun_is_rel[of "f" A "\_. n", THEN converse_converse] + converse_closed[of "converse(f)"] by simp + ultimately + show "\n\nat. A \\<^bsup>M\<^esup> n" + by (force dest:nat_into_M simp add:def_eqpoll_rel) +qed + +(* +\ \From the next result, the relative versions of +@{thm Finite_Fin_lemma} and @{thm Fin_lemma} should follow\ +lemma nat_eqpoll_imp_eqpoll_rel: + assumes "n \ nat" "A \ n" and types:"M(n)" "M(A)" + shows "A \\<^bsup>M\<^esup> n" +*) + +lemma lepoll_rel_nat_imp_Finite_rel: + assumes A: "A \\<^bsup>M\<^esup> n" and n: "n \ nat" + and types: "M(A)" "M(n)" + shows "Finite_rel(M,A)" +proof - + have "A \\<^bsup>M\<^esup> n \ Finite_rel(M,A)" using n + proof (induct n) + case 0 + hence "A = 0" by (rule lepoll_rel_0_is_0, simp_all add:types) + thus ?case by simp + next + case (succ n) + hence "A \\<^bsup>M\<^esup> n \ A \\<^bsup>M\<^esup> succ(n)" by (blast dest: lepoll_rel_succ_disj intro:types) + thus ?case using succ by (auto simp add: Finite_rel_def types) + qed + thus ?thesis using A . +qed + +lemma lesspoll_rel_nat_is_Finite_rel: + "A \\<^bsup>M\<^esup> nat \ M(A) \ Finite_rel(M,A)" + apply (unfold Finite_rel_def) + apply (auto dest: ltD lesspoll_rel_cardinal_rel_lt + lesspoll_rel_imp_eqpoll_rel [THEN eqpoll_rel_sym]) + done + +lemma lepoll_rel_Finite_rel: + assumes Y: "Y \\<^bsup>M\<^esup> X" and X: "Finite_rel(M,X)" + and types:"M(Y)" "M(X)" + shows "Finite_rel(M,Y)" +proof - + obtain n where n: "n \ nat" "X \\<^bsup>M\<^esup> n" "M(n)" using X + by (auto simp add: Finite_rel_def) + have "Y \\<^bsup>M\<^esup> X" by (rule Y) + also have "... \\<^bsup>M\<^esup> n" by (rule n) + finally have "Y \\<^bsup>M\<^esup> n" by (simp_all add:types \M(n)\) + thus ?thesis using n + by (simp add: lepoll_rel_nat_imp_Finite_rel types \M(n)\ del:Finite_abs) +qed + +lemma succ_lepoll_rel_imp_not_empty: "succ(x) \\<^bsup>M\<^esup> y ==> M(x) \ M(y) \ y \ 0" + by (fast dest!: lepoll_rel_0_is_0) + +lemma eqpoll_rel_succ_imp_not_empty: "x \\<^bsup>M\<^esup> succ(n) ==> M(x) \ M(n) \ x \ 0" + by (fast elim!: eqpoll_rel_sym [THEN eqpoll_rel_0_is_0, THEN succ_neq_0]) + +lemma Finite_subset_closed: + assumes "Finite(B)" "B\A" "M(A)" + shows "M(B)" +proof - + from \Finite(B)\ \B\A\ + show ?thesis + proof(induct,simp) + case (cons x D) + with assms + have "M(D)" "x\A" + unfolding cons_def by auto + then + show ?case using transM[OF _ \M(A)\] by simp + qed +qed + +lemma Finite_Pow_abs: + assumes "Finite(A)" " M(A)" + shows "Pow(A) = Pow_rel(M,A)" + using Finite_subset_closed[OF subset_Finite] assms Pow_rel_char + by auto + +lemma Finite_Pow_rel: + assumes "Finite(A)" "M(A)" + shows "Finite(Pow_rel(M,A))" + using Finite_Pow Finite_Pow_abs[symmetric] assms by simp + +lemma Pow_rel_0 [simp]: "Pow_rel(M,0) = {0}" + using Finite_Pow_abs[of 0] by simp + +lemma eqpoll_rel_imp_Finite: "A \\<^bsup>M\<^esup> B \ Finite(A) \ M(A) \ M(B) \ Finite(B)" +proof - + assume "A \\<^bsup>M\<^esup> B" "Finite(A)" "M(A)" "M(B)" + then obtain f n g where "f\bij(A,B)" "n\nat" "g\bij(A,n)" + unfolding Finite_def eqpoll_def eqpoll_rel_def + using bij_rel_char + by auto + then + have "g O converse(f) \ bij(B,n)" + using bij_converse_bij comp_bij by simp + with \n\_\ + show"Finite(B)" + unfolding Finite_def eqpoll_def by auto +qed + +lemma eqpoll_rel_imp_Finite_iff: "A \\<^bsup>M\<^esup> B \ M(A) \ M(B) \ Finite(A) \ Finite(B)" + using eqpoll_rel_imp_Finite eqpoll_rel_sym by force + +end \ \\<^locale>\M_cardinals\\ + +end diff --git a/thys/Transitive_Models/Delta_System_Relative.thy b/thys/Transitive_Models/Delta_System_Relative.thy new file mode 100644 --- /dev/null +++ b/thys/Transitive_Models/Delta_System_Relative.thy @@ -0,0 +1,418 @@ +section\The Delta System Lemma, Relativized\label{sec:dsl-rel}\ + +theory Delta_System_Relative + imports + Cardinal_Library_Relative +begin + +(* FIXME: The following code (definition and 3 lemmas) is extracted + from Delta_System where it is unnecesarily under the context of AC *) +definition + delta_system :: "i \ o" where + "delta_system(D) \ \r. \A\D. \B\D. A \ B \ A \ B = r" + +lemma delta_systemI[intro]: + assumes "\A\D. \B\D. A \ B \ A \ B = r" + shows "delta_system(D)" + using assms unfolding delta_system_def by simp + +lemma delta_systemD[dest]: + "delta_system(D) \ \r. \A\D. \B\D. A \ B \ A \ B = r" + unfolding delta_system_def by simp + +lemma delta_system_root_eq_Inter: + assumes "delta_system(D)" + shows "\A\D. \B\D. A \ B \ A \ B = \D" +proof (clarify, intro equalityI, auto) + fix A' B' x C + assume hyp:"A'\D" "B'\ D" "A'\B'" "x\A'" "x\B'" "C\D" + with assms + obtain r where delta:"\A\D. \B\D. A \ B \ A \ B = r" + by auto + show "x \ C" + proof (cases "C=A'") + case True + with hyp and assms + show ?thesis by simp + next + case False + moreover + note hyp + moreover from calculation and delta + have "r = C \ A'" "A' \ B' = r" "x\r" by auto + ultimately + show ?thesis by simp + qed +qed + +relativize functional "delta_system" "delta_system_rel" external + +locale M_delta = M_cardinal_library + + assumes + countable_lepoll_assms: + "M(G) \ M(A) \ M(b) \ M(f) \ separation(M, \y. \x\A. + y = \x, \ i. x \ if_range_F_else_F(\x. {xa \ G . x \ xa}, b, f, i)\)" +begin + +lemmas cardinal_replacement = lam_replacement_cardinal_rel[unfolded lam_replacement_def] + +lemma disjoint_separation: "M(c) \ separation(M, \ x. \a. \b. x=\a,b\ \ a \ b = c)" + using separation_pair separation_eq lam_replacement_constant lam_replacement_Int + by simp + +lemma insnd_ball: "M(G) \ separation(M, \p. \x\G. x \ snd(p) \ fst(p) \ x)" + using separation_ball separation_iff' lam_replacement_fst lam_replacement_snd + separation_in lam_replacement_hcomp + by simp + +lemma (in M_trans) mem_F_bound6: + fixes F G + defines "F \ \_ x. Collect(G, (\)(x))" + shows "x\F(G,c) \ c \ (range(f) \ \G)" + using apply_0 unfolding F_def + by (cases "M(c)", auto simp:F_def) + +lemma delta_system_Aleph_rel1: + assumes "\A\F. Finite(A)" "F \\<^bsup>M\<^esup> \\<^bsub>1\<^esub>\<^bsup>M\<^esup>" "M(F)" + shows "\D[M]. D \ F \ delta_system(D) \ D \\<^bsup>M\<^esup> \\<^bsub>1\<^esub>\<^bsup>M\<^esup>" +proof - + have "M(G) \ M(p) \ M({A\G . p \ A})" for G p + proof - + assume "M(G)" "M(p)" + have "{A\G . p \ A} = G \ (Memrel({p} \ G) `` {p})" + unfolding Memrel_def by auto + with \M(G)\ \M(p)\ + show ?thesis by simp + qed + from \M(F)\ + have "M(\A\F. |A|\<^bsup>M\<^esup>)" + using cardinal_replacement + by (rule_tac lam_closed) (auto dest:transM) + text\Since all members are finite,\ + with \\A\F. Finite(A)\ \M(F)\ + have "(\A\F. |A|\<^bsup>M\<^esup>) : F \\<^bsup>M\<^esup> \" (is "?cards : _") + by (simp add:mem_function_space_rel_abs, rule_tac lam_type) + (force dest:transM) + moreover from this + have a:"?cards -`` {n} = { A\F . |A|\<^bsup>M\<^esup> = n }" for n + using vimage_lam by auto + moreover + note \F \\<^bsup>M\<^esup> \\<^bsub>1\<^esub>\<^bsup>M\<^esup>\ \M(F)\ + moreover from calculation + text\there are uncountably many have the same cardinal:\ + obtain n where "n\\" "|?cards -`` {n}|\<^bsup>M\<^esup> = \\<^bsub>1\<^esub>\<^bsup>M\<^esup>" + using eqpoll_rel_Aleph_rel1_cardinal_rel_vimage[of F ?cards] by auto + moreover + define G where "G \ ?cards -`` {n}" + moreover from calculation and \M(?cards)\ + have "M(G)" by blast + moreover from calculation + have "G \ F" by auto + ultimately + text\Therefore, without loss of generality, we can assume that all + elements of the family have cardinality \<^term>\n\\\.\ + have "A\G \ |A|\<^bsup>M\<^esup> = n" and "G \\<^bsup>M\<^esup> \\<^bsub>1\<^esub>\<^bsup>M\<^esup>" and "M(G)" for A + using cardinal_rel_Card_rel_eqpoll_rel_iff by auto + with \n\\\ + text\So we prove the result by induction on this \<^term>\n\ and + generalizing \<^term>\G\, since the argument requires changing the + family in order to apply the inductive hypothesis.\ + have "\D[M]. D \ G \ delta_system(D) \ D \\<^bsup>M\<^esup> \\<^bsub>1\<^esub>\<^bsup>M\<^esup>" + proof (induct arbitrary:G) + case 0 \ \This case is impossible\ + then + have "G \ {0}" + using cardinal_rel_0_iff_0 by (blast dest:transM) + with \G \\<^bsup>M\<^esup> \\<^bsub>1\<^esub>\<^bsup>M\<^esup>\ \M(G)\ + show ?case + using nat_lt_Aleph_rel1 subset_imp_le_cardinal_rel[of G "{0}"] + lt_trans2 cardinal_rel_Card_rel_eqpoll_rel_iff by auto + next + case (succ n) + have "\a\G. Finite(a)" + proof + fix a + assume "a \ G" + moreover + note \M(G)\ \n\\\ + moreover from calculation + have "M(a)" by (auto dest: transM) + moreover from succ and \a\G\ + have "|a|\<^bsup>M\<^esup> = succ(n)" by simp + ultimately + show "Finite(a)" + using Finite_cardinal_rel_iff' nat_into_Finite[of "succ(n)"] + by fastforce + qed + show "\D[M]. D \ G \ delta_system(D) \ D \\<^bsup>M\<^esup> \\<^bsub>1\<^esub>\<^bsup>M\<^esup>" + proof (cases "\p[M]. {A\G . p \ A} \\<^bsup>M\<^esup> \\<^bsub>1\<^esub>\<^bsup>M\<^esup>") + case True \ \the positive case, uncountably many sets with a + common element\ + then + obtain p where "{A\G . p \ A} \\<^bsup>M\<^esup> \\<^bsub>1\<^esub>\<^bsup>M\<^esup>" "M(p)" by blast + moreover + note 1=\M(G)\ \M(G) \ M(p) \ M({A\G . p \ A})\ singleton_closed[OF \M(p)\] + moreover from this + have "M({x - {p} . x \ {x \ G . p \ x}})" + using RepFun_closed[OF lam_replacement_Diff'[THEN + lam_replacement_imp_strong_replacement]] + Diff_closed[OF transM[OF _ 1(2)]] by auto + moreover from 1 + have "M(converse(\x\{x \ G . p \ x}. x - {p}))" (is "M(converse(?h))") + using converse_closed[of ?h] lam_closed[OF diff_Pair_replacement] + Diff_closed[OF transM[OF _ 1(2)]] + by auto + moreover from calculation + have "{A-{p} . A\{X\G. p\X}} \\<^bsup>M\<^esup> \\<^bsub>1\<^esub>\<^bsup>M\<^esup>" (is "?F \\<^bsup>M\<^esup> _") + using Diff_bij_rel[of "{A\G . p \ A}" "{p}", THEN + comp_bij_rel[OF bij_rel_converse_bij_rel, where C="\\<^bsub>1\<^esub>\<^bsup>M\<^esup>", + THEN bij_rel_imp_eqpoll_rel, of _ _ ?F]] + unfolding eqpoll_rel_def + by (auto simp del:mem_bij_abs) + text\Now using the hypothesis of the successor case,\ + moreover from \\A. A\G \ |A|\<^bsup>M\<^esup>=succ(n)\ \\a\G. Finite(a)\ + and this \M(G)\ + have "p\A \ A\G \ |A - {p}|\<^bsup>M\<^esup> = n" for A + using Finite_imp_succ_cardinal_rel_Diff[of _ p] by (force dest: transM) + moreover + have "\a\?F. Finite(a)" + proof (clarsimp) + fix A + assume "p\A" "A\G" + with \\A. p \ A \ A \ G \ |A - {p}|\<^bsup>M\<^esup> = n\ and \n\\\ \M(G)\ + have "Finite(|A - {p}|\<^bsup>M\<^esup>)" + using nat_into_Finite by simp + moreover from \p\A\ \A\G\ \M(G)\ + have "M(A - {p})" by (auto dest: transM) + ultimately + show "Finite(A - {p})" + using Finite_cardinal_rel_iff' by simp + qed + moreover + text\we may apply the inductive hypothesis to the new family \<^term>\?F\:\ + note \(\A. A \ ?F \ |A|\<^bsup>M\<^esup> = n) \ ?F \\<^bsup>M\<^esup> \\<^bsub>1\<^esub>\<^bsup>M\<^esup> \ M(?F) \ + \D[M]. D \ ?F \ delta_system(D) \ D \\<^bsup>M\<^esup> \\<^bsub>1\<^esub>\<^bsup>M\<^esup>\ + moreover + note 1=\M(G)\ \M(G) \ M(p) \ M({A\G . p \ A})\ singleton_closed[OF \M(p)\] + moreover from this + have "M({x - {p} . x \ {x \ G . p \ x}})" + using RepFun_closed[OF lam_replacement_Diff'[THEN + lam_replacement_imp_strong_replacement]] + Diff_closed[OF transM[OF _ 1(2)]] by auto + ultimately + obtain D where "D\{A-{p} . A\{X\G. p\X}}" "delta_system(D)" "D \\<^bsup>M\<^esup> \\<^bsub>1\<^esub>\<^bsup>M\<^esup>" "M(D)" + by auto + moreover from this + obtain r where "\A\D. \B\D. A \ B \ A \ B = r" + by fastforce + then + have "\A\D.\B\D. A\{p} \ B\{p}\(A \ {p}) \ (B \ {p}) = r\{p}" + by blast + ultimately + have "delta_system({B \ {p} . B\D})" (is "delta_system(?D)") + by fastforce + moreover from \M(D)\ \M(p)\ + have "M(?D)" + using RepFun_closed un_Pair_replacement transM[of _ D] by auto + moreover from \D \\<^bsup>M\<^esup> \\<^bsub>1\<^esub>\<^bsup>M\<^esup>\ \M(D)\ + have "Infinite(D)" "|D|\<^bsup>M\<^esup> = \\<^bsub>1\<^esub>\<^bsup>M\<^esup>" + using uncountable_rel_iff_subset_eqpoll_rel_Aleph_rel1[THEN iffD2, + THEN uncountable_rel_imp_Infinite, of D] + cardinal_rel_eqpoll_rel_iff[of D "\\<^bsub>1\<^esub>\<^bsup>M\<^esup>"] \M(D)\ \D \\<^bsup>M\<^esup> \\<^bsub>1\<^esub>\<^bsup>M\<^esup>\ + by auto + moreover from this \M(?D)\ \M(D)\ \M(p)\ + have "?D \\<^bsup>M\<^esup> \\<^bsub>1\<^esub>\<^bsup>M\<^esup>" + using cardinal_rel_map_Un[of D "{p}"] naturals_lt_nat + cardinal_rel_eqpoll_rel_iff[THEN iffD1] by simp + moreover + note \D \ {A-{p} . A\{X\G. p\X}}\ + have "?D \ G" + proof - + { + fix A + assume "A\G" "p\A" + moreover from this + have "A = A - {p} \ {p}" + by blast + ultimately + have "A -{p} \ {p} \ G" + by auto + } + with \D \ {A-{p} . A\{X\G. p\X}}\ + show ?thesis + by blast + qed + moreover + note \M(?D)\ + ultimately + show "\D[M]. D \ G \ delta_system(D) \ D \\<^bsup>M\<^esup> \\<^bsub>1\<^esub>\<^bsup>M\<^esup>" by auto + next + case False + note \\ (\p[M]. {A \ G . p \ A} \\<^bsup>M\<^esup> \\<^bsub>1\<^esub>\<^bsup>M\<^esup>)\ \ \the other case\ + \M(G)\ \\p. M(G) \ M(p) \ M({A\G . p \ A})\ + moreover from \G \\<^bsup>M\<^esup> \\<^bsub>1\<^esub>\<^bsup>M\<^esup>\ and this + have "M(p) \ {A \ G . p \ A} \\<^bsup>M\<^esup> \\<^bsub>1\<^esub>\<^bsup>M\<^esup>" (is "_ \ ?G(p) \\<^bsup>M\<^esup> _") for p + by (auto intro!:lepoll_rel_eq_trans[OF subset_imp_lepoll_rel] dest:transM) + moreover from calculation + have "M(p) \ ?G(p) \\<^bsup>M\<^esup> \\<^bsub>1\<^esub>\<^bsup>M\<^esup>" for p + using \M(G) \ M(p) \ M({A\G . p \ A})\ + unfolding lesspoll_rel_def by simp + moreover from calculation + have "M(p) \ ?G(p) \\<^bsup>M\<^esup> \" for p + using lesspoll_rel_Aleph_rel_succ[of 0] Aleph_rel_zero by auto + moreover + have "{A \ G . S \ A \ 0} = (\p\S. ?G(p))" for S + by auto + moreover from calculation + have "M(S) \ i \ S \ M({x \ G . i \ x})" for i S + by (auto dest: transM) + moreover + have "M(S) \ countable_rel(M,S) \ countable_rel(M,{A \ G . S \ A \ 0})" for S + proof - + from \M(G)\ + interpret M_replacement_lepoll M "\_ x. Collect(G, (\)(x))" + using countable_lepoll_assms lam_replacement_inj_rel separation_in_rev + lam_replacement_Collect[OF _ _ insnd_ball] mem_F_bound6[of _ G] + by unfold_locales + (auto dest:transM intro:lam_Least_assumption_general[of _ _ _ _ Union]) + fix S + assume "M(S)" + with \M(G)\ \\i. M(S) \ i \ S \ M({x \ G . i \ x})\ + interpret M_cardinal_UN_lepoll _ ?G S + using lepoll_assumptions + by unfold_locales (auto dest:transM) + assume "countable_rel(M,S)" + with \M(S)\ calculation(6) calculation(7,8)[of S] + show "countable_rel(M,{A \ G . S \ A \ 0})" + using InfCard_rel_nat Card_rel_nat + le_Card_rel_iff[THEN iffD2, THEN [3] leqpoll_rel_imp_cardinal_rel_UN_le, + THEN [4] le_Card_rel_iff[THEN iffD1], of \] j.UN_closed + unfolding countable_rel_def by (auto dest: transM) + qed + define Disjoint where "Disjoint = { \ G\G . B \ A = 0}" + have "Disjoint = {x \ G\G . \ a b. x= \ a\b=0}" + unfolding Disjoint_def by force + with \M(G)\ + have "M(Disjoint)" + using disjoint_separation by simp + text\For every countable\_rel subfamily of \<^term>\G\ there is another some + element disjoint from all of them:\ + have "\A\G. \S\X. \Disjoint" if "|X|\<^bsup>M\<^esup> < \\<^bsub>1\<^esub>\<^bsup>M\<^esup>" "X \ G" "M(X)" for X + proof - + note \n\\\ \M(G)\ + moreover from this and \\A. A\G \ |A|\<^bsup>M\<^esup> = succ(n)\ + have "|A|\<^bsup>M\<^esup>= succ(n)" "M(A)" if "A\G" for A + using that Finite_cardinal_rel_eq_cardinal[of A] Finite_cardinal_rel_iff'[of A] + nat_into_Finite transM[of A G] by (auto dest:transM) + ultimately + have "A\G \ Finite(A)" for A + using cardinal_rel_Card_rel_eqpoll_rel_iff[of "succ(n)" A] + Finite_cardinal_rel_eq_cardinal[of A] nat_into_Card_rel[of "succ(n)"] + nat_into_M[of n] unfolding Finite_def eqpoll_rel_def by (auto) + with \X\G\ \M(X)\ + have "A\X \ countable_rel(M,A)" for A + using Finite_imp_countable_rel by (auto dest: transM) + moreover from \M(X)\ + have "M(\X)" by simp + moreover + note \|X|\<^bsup>M\<^esup> < \\<^bsub>1\<^esub>\<^bsup>M\<^esup>\ \M(X)\ + ultimately + have "countable_rel(M,\X)" + using Card_rel_nat[THEN cardinal_rel_lt_csucc_rel_iff, of X] + countable_rel_union_countable_rel[of X] + countable_rel_iff_cardinal_rel_le_nat[of X] Aleph_rel_succ + Aleph_rel_zero by simp + with \M(\X)\ \M(_) \ countable_rel(M,_) \ countable_rel(M,{A \ G . _ \ A \ 0})\ + have "countable_rel(M,{A \ G . (\X) \ A \ 0})" by simp + with \G \\<^bsup>M\<^esup> \\<^bsub>1\<^esub>\<^bsup>M\<^esup>\ \M(G)\ + obtain B where "B\G" "B \ {A \ G . (\X) \ A \ 0}" + using nat_lt_Aleph_rel1 cardinal_rel_Card_rel_eqpoll_rel_iff[of "\\<^bsub>1\<^esub>\<^bsup>M\<^esup>" G] + uncountable_rel_not_subset_countable_rel + [of "{A \ G . (\X) \ A \ 0}" G] + uncountable_rel_iff_nat_lt_cardinal_rel[of G] + by force + then + have "\A\G. \S\X. A \ S = 0" by auto + with \X\G\ + show "\A\G. \S\X. \Disjoint" unfolding Disjoint_def + using subsetD by simp + qed + moreover from \G \\<^bsup>M\<^esup> \\<^bsub>1\<^esub>\<^bsup>M\<^esup>\ \M(G)\ + obtain b where "b\G" + using uncountable_rel_iff_subset_eqpoll_rel_Aleph_rel1 + uncountable_rel_not_empty by blast + ultimately + text\Hence, the hypotheses to perform a bounded-cardinal selection + are satisfied,\ + obtain S where "S:\\<^bsub>1\<^esub>\<^bsup>M\<^esup>\\<^bsup>M\<^esup>G" "\\\\<^bsub>1\<^esub>\<^bsup>M\<^esup> \ \\\\<^bsub>1\<^esub>\<^bsup>M\<^esup> \ \<\ \ , S`\> \Disjoint" + for \ \ + using bounded_cardinal_rel_selection[of "\\<^bsub>1\<^esub>\<^bsup>M\<^esup>" G Disjoint] \M(Disjoint)\ + by force + moreover from this \n\\\ \M(G)\ + have inM:"M(S)" "M(n)" "\x. x \ \\<^bsub>1\<^esub>\<^bsup>M\<^esup> \ S ` x \ G" "\x. x \ \\<^bsub>1\<^esub>\<^bsup>M\<^esup> \ M(x)" + using function_space_rel_char by (auto dest: transM) + ultimately + have "\ \ \\<^bsub>1\<^esub>\<^bsup>M\<^esup> \ \ \ \\<^bsub>1\<^esub>\<^bsup>M\<^esup> \ \\\ \ S`\ \ S`\ = 0" for \ \ + unfolding Disjoint_def + using lt_neq_symmetry[of "\\<^bsub>1\<^esub>\<^bsup>M\<^esup>" "\\ \. S`\ \ S`\ = 0"] Card_rel_is_Ord + by auto (blast) + text\and a symmetry argument shows that obtained \<^term>\S\ is + an injective \<^term>\\\<^bsub>1\<^esub>\<^bsup>M\<^esup>\-sequence of disjoint elements of \<^term>\G\.\ + moreover from this and \\A. A\G \ |A|\<^bsup>M\<^esup> = succ(n)\ inM + \S : \\<^bsub>1\<^esub>\<^bsup>M\<^esup> \\<^bsup>M\<^esup> G\ \M(G)\ + have "S \ inj_rel(M,\\<^bsub>1\<^esub>\<^bsup>M\<^esup>, G)" + using def_inj_rel[OF Aleph_rel_closed \M(G)\, of 1] + proof (clarsimp) + fix w x + from inM + have "a \ \\<^bsub>1\<^esub>\<^bsup>M\<^esup> \ b \ \\<^bsub>1\<^esub>\<^bsup>M\<^esup> \ a \ b \ S ` a \ S ` b" for a b + using \\A. A\G \ |A|\<^bsup>M\<^esup> = succ(n)\[THEN [4] cardinal_rel_succ_not_0[THEN [4] + Int_eq_zero_imp_not_eq[OF calculation, of "\\<^bsub>1\<^esub>\<^bsup>M\<^esup>" "\x. x"], + of "\_.n"], OF _ _ _ _ apply_closed] by auto + moreover + assume "w \ \\<^bsub>1\<^esub>\<^bsup>M\<^esup>" "x \ \\<^bsub>1\<^esub>\<^bsup>M\<^esup>" "S ` w = S ` x" + ultimately + show "w = x" by blast + qed + moreover from this \M(G)\ + have "range(S) \\<^bsup>M\<^esup> \\<^bsub>1\<^esub>\<^bsup>M\<^esup>" + using inj_rel_bij_rel_range eqpoll_rel_sym unfolding eqpoll_rel_def + by (blast dest: transM) + moreover + note \M(G)\ + moreover from calculation + have "range(S) \ G" + using inj_rel_is_fun range_fun_subset_codomain + by (fastforce dest: transM) + moreover + note \M(S)\ + ultimately + show "\D[M]. D \ G \ delta_system(D) \ D \\<^bsup>M\<^esup> \\<^bsub>1\<^esub>\<^bsup>M\<^esup>" + using inj_rel_is_fun ZF_Library.range_eq_image[of S "\\<^bsub>1\<^esub>\<^bsup>M\<^esup>" G] + image_function[OF fun_is_function, OF inj_rel_is_fun, of S "\\<^bsub>1\<^esub>\<^bsup>M\<^esup>" G] + domain_of_fun[OF inj_rel_is_fun, of S "\\<^bsub>1\<^esub>\<^bsup>M\<^esup>" G] apply_replacement[of S] + by (rule_tac x="S``\\<^bsub>1\<^esub>\<^bsup>M\<^esup>" in rexI) (auto dest:transM intro!:RepFun_closed) + text\This finishes the successor case and hence the proof.\ + qed + qed + with \G \ F\ + show ?thesis by blast +qed + +lemma delta_system_uncountable_rel: + assumes "\A\F. Finite(A)" "uncountable_rel(M,F)" "M(F)" + shows "\D[M]. D \ F \ delta_system(D) \ D \\<^bsup>M\<^esup> \\<^bsub>1\<^esub>\<^bsup>M\<^esup>" +proof - + from assms + obtain S where "S \ F" "S \\<^bsup>M\<^esup> \\<^bsub>1\<^esub>\<^bsup>M\<^esup>" "M(S)" + using uncountable_rel_iff_subset_eqpoll_rel_Aleph_rel1[of F] by auto + moreover from \\A\F. Finite(A)\ and this + have "\A\S. Finite(A)" by auto + ultimately + show ?thesis using delta_system_Aleph_rel1[of S] + by (auto dest:transM) +qed + +end \ \\<^locale>\M_delta\\ + +end \ No newline at end of file diff --git a/thys/Transitive_Models/Discipline_Base.thy b/thys/Transitive_Models/Discipline_Base.thy new file mode 100644 --- /dev/null +++ b/thys/Transitive_Models/Discipline_Base.thy @@ -0,0 +1,658 @@ +theory Discipline_Base + imports + "ZF-Constructible.Rank" + ZF_Miscellanea + M_Basic_No_Repl + Relativization + +begin + +declare [[syntax_ambiguity_warning = false]] + +subsection\Discipline of relativization of basic concepts\ + +definition + is_singleton :: "[i\o,i,i] \ o" where + "is_singleton(A,x,z) \ \c[A]. empty(A,c) \ is_cons(A,x,c,z)" + +lemma (in M_trivial) singleton_abs[simp] : + "\ M(x) ; M(s) \ \ is_singleton(M,x,s) \ s = {x}" + unfolding is_singleton_def using nonempty by simp + +synthesize "singleton" from_definition "is_singleton" +notation singleton_fm (\\{_} is _\\) + +(* TODO: check if the following lemmas should be here or not? *) +lemma (in M_trivial) singleton_closed [simp]: + "M(x) \ M({x})" + by simp + +lemma (in M_trivial) Upair_closed[simp]: "M(a) \ M(b) \ M(Upair(a,b))" + using Upair_eq_cons by simp + + +text\The following named theorems gather instances of transitivity +that arise from closure theorems\ +named_theorems trans_closed + +definition + is_hcomp :: "[i\o,i\i\o,i\i\o,i,i] \ o" where + "is_hcomp(M,is_f,is_g,a,w) \ \z[M]. is_g(a,z) \ is_f(z,w)" + +lemma (in M_trivial) is_hcomp_abs: + assumes + is_f_abs:"\a z. M(a) \ M(z) \ is_f(a,z) \ z = f(a)" and + is_g_abs:"\a z. M(a) \ M(z) \ is_g(a,z) \ z = g(a)" and + g_closed:"\a. M(a) \ M(g(a))" + "M(a)" "M(w)" + shows + "is_hcomp(M,is_f,is_g,a,w) \ w = f(g(a))" + unfolding is_hcomp_def using assms by simp + +definition + hcomp_fm :: "[i\i\i,i\i\i,i,i] \ i" where + "hcomp_fm(pf,pg,a,w) \ Exists(And(pg(succ(a),0),pf(0,succ(w))))" + +lemma sats_hcomp_fm: + assumes + f_iff_sats:"\a b z. a\nat \ b\nat \ z\M \ + is_f(nth(a,Cons(z,env)),nth(b,Cons(z,env))) \ sats(M,pf(a,b),Cons(z,env))" + and + g_iff_sats:"\a b z. a\nat \ b\nat \ z\M \ + is_g(nth(a,Cons(z,env)),nth(b,Cons(z,env))) \ sats(M,pg(a,b),Cons(z,env))" + and + "a\nat" "w\nat" "env\list(M)" + shows + "sats(M,hcomp_fm(pf,pg,a,w),env) \ is_hcomp(##M,is_f,is_g,nth(a,env),nth(w,env))" +proof - + have "sats(M, pf(0, succ(w)), Cons(x, env)) \ is_f(x,nth(w,env))" if "x\M" "w\nat" for x w + using f_iff_sats[of 0 "succ(w)" x] that by simp + moreover + have "sats(M, pg(succ(a), 0), Cons(x, env)) \ is_g(nth(a,env),x)" if "x\M" "a\nat" for x a + using g_iff_sats[of "succ(a)" 0 x] that by simp + ultimately + show ?thesis unfolding hcomp_fm_def is_hcomp_def using assms by simp +qed + + +definition + hcomp_r :: "[i\o,[i\o,i,i]\o,[i\o,i,i]\o,i,i] \ o" where + "hcomp_r(M,is_f,is_g,a,w) \ \z[M]. is_g(M,a,z) \ is_f(M,z,w)" + +definition + is_hcomp2_2 :: "[i\o,[i\o,i,i,i]\o,[i\o,i,i,i]\o,[i\o,i,i,i]\o,i,i,i] \ o" where + "is_hcomp2_2(M,is_f,is_g1,is_g2,a,b,w) \ \g1ab[M]. \g2ab[M]. + is_g1(M,a,b,g1ab) \ is_g2(M,a,b,g2ab) \ is_f(M,g1ab,g2ab,w)" + +lemma (in M_trivial) hcomp_abs: + assumes + is_f_abs:"\a z. M(a) \ M(z) \ is_f(M,a,z) \ z = f(a)" and + is_g_abs:"\a z. M(a) \ M(z) \ is_g(M,a,z) \ z = g(a)" and + g_closed:"\a. M(a) \ M(g(a))" + "M(a)" "M(w)" + shows + "hcomp_r(M,is_f,is_g,a,w) \ w = f(g(a))" + unfolding hcomp_r_def using assms by simp + +lemma hcomp_uniqueness: + assumes + uniq_is_f: + "\r d d'. M(r) \ M(d) \ M(d') \ is_f(M, r, d) \ is_f(M, r, d') \ + d = d'" + and + uniq_is_g: + "\r d d'. M(r) \ M(d) \ M(d') \ is_g(M, r, d) \ is_g(M, r, d') \ + d = d'" + and + "M(a)" "M(w)" "M(w')" + "hcomp_r(M,is_f,is_g,a,w)" + "hcomp_r(M,is_f,is_g,a,w')" + shows + "w=w'" +proof - + from assms + obtain z z' where "is_g(M, a, z)" "is_g(M, a, z')" + "is_f(M,z,w)" "is_f(M,z',w')" + "M(z)" "M(z')" + unfolding hcomp_r_def by blast + moreover from this and uniq_is_g and \M(a)\ + have "z=z'" by blast + moreover note uniq_is_f and \M(w)\ \M(w')\ + ultimately + show ?thesis by blast +qed + +lemma hcomp_witness: + assumes + wit_is_f: "\r. M(r) \ \d[M]. is_f(M,r,d)" and + wit_is_g: "\r. M(r) \ \d[M]. is_g(M,r,d)" and + "M(a)" + shows + "\w[M]. hcomp_r(M,is_f,is_g,a,w)" +proof - + from \M(a)\ and wit_is_g + obtain z where "is_g(M,a,z)" "M(z)" by blast + moreover from this and wit_is_f + obtain w where "is_f(M,z,w)" "M(w)" by blast + ultimately + show ?thesis + using assms unfolding hcomp_r_def by auto +qed + +lemma (in M_trivial) hcomp2_2_abs: + assumes + is_f_abs:"\r1 r2 z. M(r1) \ M(r2) \ M(z) \ is_f(M,r1,r2,z) \ z = f(r1,r2)" and + is_g1_abs:"\r1 r2 z. M(r1) \ M(r2) \ M(z) \ is_g1(M,r1,r2,z) \ z = g1(r1,r2)" and + is_g2_abs:"\r1 r2 z. M(r1) \ M(r2) \ M(z) \ is_g2(M,r1,r2,z) \ z = g2(r1,r2)" and + types: "M(a)" "M(b)" "M(w)" "M(g1(a,b))" "M(g2(a,b))" + shows + "is_hcomp2_2(M,is_f,is_g1,is_g2,a,b,w) \ w = f(g1(a,b),g2(a,b))" + unfolding is_hcomp2_2_def using assms + \ \We only need some particular cases of the abs assumptions\ + (* is_f_abs types is_g1_abs[of a b] is_g2_abs[of a b] *) + by simp + +lemma hcomp2_2_uniqueness: + assumes + uniq_is_f: + "\r1 r2 d d'. M(r1) \ M(r2) \ M(d) \ M(d') \ + is_f(M, r1, r2 , d) \ is_f(M, r1, r2, d') \ d = d'" + and + uniq_is_g1: + "\r1 r2 d d'. M(r1) \ M(r2)\ M(d) \ M(d') \ is_g1(M, r1,r2, d) \ is_g1(M, r1,r2, d') \ + d = d'" + and + uniq_is_g2: + "\r1 r2 d d'. M(r1) \ M(r2)\ M(d) \ M(d') \ is_g2(M, r1,r2, d) \ is_g2(M, r1,r2, d') \ + d = d'" + and + "M(a)" "M(b)" "M(w)" "M(w')" + "is_hcomp2_2(M,is_f,is_g1,is_g2,a,b,w)" + "is_hcomp2_2(M,is_f,is_g1,is_g2,a,b,w')" + shows + "w=w'" +proof - + from assms + obtain z z' y y' where "is_g1(M, a,b, z)" "is_g1(M, a,b, z')" + "is_g2(M, a,b, y)" "is_g2(M, a,b, y')" + "is_f(M,z,y,w)" "is_f(M,z',y',w')" + "M(z)" "M(z')" "M(y)" "M(y')" + unfolding is_hcomp2_2_def by force + moreover from this and uniq_is_g1 uniq_is_g2 and \M(a)\ \M(b)\ + have "z=z'" "y=y'" by blast+ + moreover note uniq_is_f and \M(w)\ \M(w')\ + ultimately + show ?thesis by blast +qed + +lemma hcomp2_2_witness: + assumes + wit_is_f: "\r1 r2. M(r1) \ M(r2) \ \d[M]. is_f(M,r1,r2,d)" and + wit_is_g1: "\r1 r2. M(r1) \ M(r2) \ \d[M]. is_g1(M,r1,r2,d)" and + wit_is_g2: "\r1 r2. M(r1) \ M(r2) \ \d[M]. is_g2(M,r1,r2,d)" and + "M(a)" "M(b)" + shows + "\w[M]. is_hcomp2_2(M,is_f,is_g1,is_g2,a,b,w)" +proof - + from \M(a)\ \M(b)\ and wit_is_g1 + obtain g1a where "is_g1(M,a,b,g1a)" "M(g1a)" by blast + moreover from \M(a)\ \M(b)\ and wit_is_g2 + obtain g2a where "is_g2(M,a,b,g2a)" "M(g2a)" by blast + moreover from calculation and wit_is_f + obtain w where "is_f(M,g1a,g2a,w)" "M(w)" by blast + ultimately + show ?thesis + using assms unfolding is_hcomp2_2_def by auto +qed + +lemma (in M_trivial) extensionality_trans: + assumes + "M(d) \ (\x[M]. x\d \ P(x))" + "M(d') \ (\x[M]. x\d' \ P(x))" + shows + "d=d'" +proof - + from assms + have "\x. x\d \ P(x) \ M(x)" + using transM[of _ d] by auto + moreover from assms + have "\x. x\d' \ P(x) \ M(x)" + using transM[of _ d'] by auto + ultimately + show ?thesis by auto +qed + +definition + lt_rel :: "[i\o,i,i] \ o" where + "lt_rel(M,a,b) \ a\b \ ordinal(M,b)" + +lemma (in M_trans) lt_abs[absolut]: "M(a) \ M(b) \ lt_rel(M,a,b) \ ao,i,i] \ o" where + "le_rel(M,a,b) \ \sb[M]. successor(M,b,sb) \ lt_rel(M,a,sb)" + +lemma (in M_trivial) le_abs[absolut]: "M(a) \ M(b) \ le_rel(M,a,b) \ a\b" + unfolding le_rel_def by (simp add:absolut) + +subsection\Discipline for \<^term>\Pow\\ + +definition + is_Pow :: "[i\o,i,i] \ o" where + "is_Pow(M,A,z) \ M(z) \ (\x[M]. x \ z \ subset(M,x,A))" + +definition + Pow_rel :: "[i\o,i] \ i" (\Pow\<^bsup>_\<^esup>'(_')\) where + "Pow_rel(M,r) \ THE d. is_Pow(M,r,d)" + +abbreviation + Pow_r_set :: "[i,i] \ i" (\Pow\<^bsup>_\<^esup>'(_')\) where + "Pow_r_set(M) \ Pow_rel(##M)" + +context M_basic_no_repl +begin + +lemma is_Pow_uniqueness: + assumes + "M(r)" + "is_Pow(M,r,d)" "is_Pow(M,r,d')" + shows + "d=d'" + using assms extensionality_trans + unfolding is_Pow_def + by simp + +lemma is_Pow_witness: "M(r) \ \d[M]. is_Pow(M,r,d)" + using power_ax unfolding power_ax_def powerset_def is_Pow_def + by simp \ \We have to do this by hand, using axioms\ + +lemma is_Pow_closed : "\ M(r);is_Pow(M,r,d) \ \ M(d)" + unfolding is_Pow_def by simp + +lemma Pow_rel_closed[intro,simp]: "M(r) \ M(Pow_rel(M,r))" + unfolding Pow_rel_def + using is_Pow_closed theI[OF ex1I[of "\d. is_Pow(M,r,d)"], OF _ is_Pow_uniqueness[of r]] + is_Pow_witness + by fastforce + +lemmas trans_Pow_rel_closed[trans_closed] = transM[OF _ Pow_rel_closed] + +text\The proof of \<^term>\f_rel_iff\ lemma is schematic and it can reused by copy-paste + replacing appropriately.\ + +lemma Pow_rel_iff: + assumes "M(r)" "M(d)" + shows "is_Pow(M,r,d) \ d = Pow_rel(M,r)" +proof (intro iffI) + assume "d = Pow_rel(M,r)" + with assms + show "is_Pow(M, r, d)" + using is_Pow_uniqueness[of r] is_Pow_witness + theI[OF ex1I[of "\d. is_Pow(M,r,d)"], OF _ is_Pow_uniqueness[of r]] + unfolding Pow_rel_def + by auto +next + assume "is_Pow(M, r, d)" + with assms + show "d = Pow_rel(M,r)" + using is_Pow_uniqueness unfolding Pow_rel_def + by (auto del:the_equality intro:the_equality[symmetric]) +qed + +text\The next "def\_" result really corresponds to @{thm Pow_iff}\ +lemma def_Pow_rel: "M(A) \ M(r) \ A\Pow_rel(M,r) \ A \ r" + using Pow_rel_iff[OF _ Pow_rel_closed, of r r] + unfolding is_Pow_def by simp + +lemma Pow_rel_char: "M(r) \ Pow_rel(M,r) = {A\Pow(r). M(A)}" +proof - + assume "M(r)" + moreover from this + have "x \ Pow_rel(M,r) \ x\r" "M(x) \ x \ r \ x \ Pow_rel(M,r)" for x + using def_Pow_rel by (auto intro!:trans_Pow_rel_closed) + ultimately + show ?thesis + using trans_Pow_rel_closed by blast +qed + +lemma mem_Pow_rel_abs: "M(a) \ M(r) \ a \ Pow_rel(M,r) \ a \ Pow(r)" + using Pow_rel_char by simp + +end \ \\<^locale>\M_basic_no_repl\\ + +(****************** end Discipline **********************) + + +(**********************************************************) +subsection\Discipline for \<^term>\PiP\\ + +definition + PiP_rel:: "[i\o,i,i]\o" where + "PiP_rel(M,A,f) \ \df[M]. is_domain(M,f,df) \ subset(M,A,df) \ + is_function(M,f)" + +context M_basic +begin + +lemma def_PiP_rel: + assumes + "M(A)" "M(f)" + shows + "PiP_rel(M,A,f) \ A \ domain(f) \ function(f)" + using assms unfolding PiP_rel_def by simp + +end \ \\<^locale>\M_basic\\ + +(****************** end Discipline **********************) + +(* +Sigma(A,B) == \x\A. \y\B(x). {\x,y\} + == \ { (\y\B(x). {\x,y\}) . x\A} + == \ { (\y\B(x). {\x,y\}) . x\A} + == \ { ( \ { {\x,y\} . y\B(x)} ) . x\A} + ---------------------- + Sigfun(x,B) +*) + +definition \ \FIX THIS: not completely relational. Can it be?\ + Sigfun :: "[i,i\i]\i" where + "Sigfun(x,B) \ \y\B(x). {\x,y\}" + +lemma Sigma_Sigfun: "Sigma(A,B) = \ {Sigfun(x,B) . x\A}" + unfolding Sigma_def Sigfun_def .. + +definition \ \FIX THIS: not completely relational. Can it be?\ + is_Sigfun :: "[i\o,i,i\i,i]\o" where + "is_Sigfun(M,x,B,Sd) \ M(Sd) \ (\RB[M]. is_Replace(M,B(x),\y z. z={\x,y\},RB) + \ big_union(M,RB,Sd))" + + +context M_trivial +begin + +lemma is_Sigfun_abs: + assumes + "strong_replacement(M,\y z. z={\x,y\})" + "M(x)" "M(B(x))" "M(Sd)" + shows + "is_Sigfun(M,x,B,Sd) \ Sd = Sigfun(x,B)" +proof - + have "\{z . y \ B(x), z = {\x, y\}} = (\y\B(x). {\x, y\})" by auto + then + show ?thesis + using assms transM[OF _ \M(B(x))\] Replace_abs + unfolding is_Sigfun_def Sigfun_def by auto +qed + +lemma Sigfun_closed: + assumes + "strong_replacement(M, \y z. y \ B(x) \ z = {\x, y\})" + "M(x)" "M(B(x))" + shows + "M(Sigfun(x,B))" + using assms transM[OF _ \M(B(x))\] RepFun_closed2 + unfolding Sigfun_def by simp + +lemmas trans_Sigfun_closed[trans_closed] = transM[OF _ Sigfun_closed] + +end \ \\<^locale>\M_trivial\\ + +definition + is_Sigma :: "[i\o,i,i\i,i]\o" where + "is_Sigma(M,A,B,S) \ M(S) \ (\RSf[M]. + is_Replace(M,A,\x z. z=Sigfun(x,B),RSf) \ big_union(M,RSf,S))" + +locale M_Pi = M_basic + + assumes + Pi_separation: "M(A) \ separation(M, PiP_rel(M,A))" + and + Pi_replacement: + "M(x) \ M(y) \ + strong_replacement(M, \ya z. ya \ y \ z = {\x, ya\})" + "M(y) \ + strong_replacement(M, \x z. z = (\xa\y. {\x, xa\}))" + +locale M_Pi_assumptions = M_Pi + + fixes A B + assumes + Pi_assumptions: + "M(A)" + "\x. x\A \ M(B(x))" + "\x\A. strong_replacement(M, \y z. y \ B(x) \ z = {\x, y\})" + "strong_replacement(M,\x z. z=Sigfun(x,B))" +begin + +lemma Sigma_abs[simp]: + assumes + "M(S)" + shows + "is_Sigma(M,A,B,S) \ S = Sigma(A,B)" +proof - + have "\{z . x \ A, z = Sigfun(x, B)} = (\x\A. Sigfun(x, B))" + by auto + with assms + show ?thesis + using Replace_abs[of A _ "\x z. z=Sigfun(x,B)"] + Sigfun_closed Sigma_Sigfun[of A B] transM[of _ A] + Pi_assumptions is_Sigfun_abs + unfolding is_Sigma_def by simp +qed + +lemma Sigma_closed[intro,simp]: "M(Sigma(A,B))" +proof - + have "(\x\A. Sigfun(x, B)) = \{z . x \ A, z = Sigfun(x, B)}" + by auto + then + show ?thesis + using Sigma_Sigfun[of A B] transM[of _ A] + Sigfun_closed Pi_assumptions + by simp +qed + +lemmas trans_Sigma_closed[trans_closed] = transM[OF _ Sigma_closed] + +end \ \\<^locale>\M_Pi_assumptions\\ + +(**********************************************************) +subsection\Discipline for \<^term>\Pi\\ + +definition (* completely relational *) + is_Pi :: "[i\o,i,i\i,i]\o" where + "is_Pi(M,A,B,I) \ M(I) \ (\S[M]. \PS[M]. is_Sigma(M,A,B,S) \ + is_Pow(M,S,PS) \ + is_Collect(M,PS,PiP_rel(M,A),I))" + +definition + Pi_rel :: "[i\o,i,i\i] \ i" (\Pi\<^bsup>_\<^esup>'(_,_')\) where + "Pi_rel(M,A,B) \ THE d. is_Pi(M,A,B,d)" + +abbreviation + Pi_r_set :: "[i,i,i\i] \ i" (\Pi\<^bsup>_\<^esup>'(_,_')\) where + "Pi_r_set(M,A,B) \ Pi_rel(##M,A,B)" + + +context M_basic +begin + +lemmas Pow_rel_iff = mbnr.Pow_rel_iff +lemmas Pow_rel_char = mbnr.Pow_rel_char +lemmas mem_Pow_rel_abs = mbnr.mem_Pow_rel_abs +lemmas Pow_rel_closed = mbnr.Pow_rel_closed +lemmas def_Pow_rel = mbnr.def_Pow_rel +lemmas trans_Pow_rel_closed = mbnr.trans_Pow_rel_closed + +end \ \\<^locale>\M_basic\\ + +context M_Pi_assumptions +begin + +lemma is_Pi_uniqueness: + assumes + "is_Pi(M,A,B,d)" "is_Pi(M,A,B,d')" + shows + "d=d'" + using assms Pi_assumptions extensionality_trans + Pow_rel_iff + unfolding is_Pi_def by simp + + +lemma is_Pi_witness: "\d[M]. is_Pi(M,A,B,d)" + using Pow_rel_iff Pi_separation Pi_assumptions + unfolding is_Pi_def by simp + +lemma is_Pi_closed : "is_Pi(M,A,B,d) \ M(d)" + unfolding is_Pi_def by simp + +lemma Pi_rel_closed[intro,simp]: "M(Pi_rel(M,A,B))" +proof - + have "is_Pi(M, A, B, THE xa. is_Pi(M, A, B, xa))" + using Pi_assumptions + theI[OF ex1I[of "is_Pi(M,A,B)"], OF _ is_Pi_uniqueness] + is_Pi_witness is_Pi_closed + by auto + then show ?thesis + using is_Pi_closed + unfolding Pi_rel_def + by simp +qed + +\ \From this point on, the higher order variable \<^term>\y\ must be +explicitly instantiated, and proof methods are slower\ + +lemmas trans_Pi_rel_closed[trans_closed] = transM[OF _ Pi_rel_closed] + +lemma Pi_rel_iff: + assumes "M(d)" + shows "is_Pi(M,A,B,d) \ d = Pi_rel(M,A,B)" +proof (intro iffI) + assume "d = Pi_rel(M,A,B)" + moreover + note assms + moreover from this + obtain e where "M(e)" "is_Pi(M,A,B,e)" + using is_Pi_witness by blast + ultimately + show "is_Pi(M, A, B, d)" + using is_Pi_uniqueness is_Pi_witness is_Pi_closed + theI[OF ex1I[of "is_Pi(M,A,B)"], OF _ is_Pi_uniqueness, of e] + unfolding Pi_rel_def + by simp +next + assume "is_Pi(M, A, B, d)" + with assms + show "d = Pi_rel(M,A,B)" + using is_Pi_uniqueness is_Pi_closed unfolding Pi_rel_def + by (blast del:the_equality intro:the_equality[symmetric]) +qed + +lemma def_Pi_rel: + "Pi_rel(M,A,B) = {f\Pow_rel(M,Sigma(A,B)). A\domain(f) \ function(f)}" +proof - + have "Pi_rel(M,A, B) \ Pow_rel(M,Sigma(A,B))" + using Pi_assumptions Pi_rel_iff[of "Pi_rel(M,A,B)"] Pow_rel_iff + unfolding is_Pi_def by auto + moreover + have "f \ Pi_rel(M,A, B) \ A\domain(f) \ function(f)" for f + using Pi_assumptions Pi_rel_iff[of "Pi_rel(M,A,B)"] + def_PiP_rel[of A f] trans_closed Pow_rel_iff + unfolding is_Pi_def by simp + moreover + have "f \ Pow_rel(M,Sigma(A,B)) \ A\domain(f) \ function(f) \ f \ Pi_rel(M,A, B)" for f + using Pi_rel_iff[of "Pi_rel(M,A,B)"] Pi_assumptions + def_PiP_rel[of A f] trans_closed Pow_rel_iff + unfolding is_Pi_def by simp + ultimately + show ?thesis by force +qed + +lemma Pi_rel_char: "Pi_rel(M,A,B) = {f\Pi(A,B). M(f)}" + using Pi_assumptions def_Pi_rel Pow_rel_char[OF Sigma_closed] unfolding Pi_def + by fastforce + +lemma mem_Pi_rel_abs: + assumes "M(f)" + shows "f \ Pi_rel(M,A,B) \ f \ Pi(A,B)" + using assms Pi_rel_char by simp + +end \ \\<^locale>\M_Pi_assumptions\\ + +text\The next locale (and similar ones below) are used to +show the relationship between versions of simple (i.e. +$\Sigma_1^{\mathit{ZF}}$, $\Pi_1^{\mathit{ZF}}$) concepts in two +different transitive models.\ +locale M_N_Pi_assumptions = M:M_Pi_assumptions + N:M_Pi_assumptions N for N + + assumes + M_imp_N:"M(x) \ N(x)" +begin + +lemma Pi_rel_transfer: "Pi\<^bsup>M\<^esup>(A,B) \ Pi\<^bsup>N\<^esup>(A,B)" + using M.Pi_rel_char N.Pi_rel_char M_imp_N by auto + +end \ \\<^locale>\M_N_Pi_assumptions\\ + + +(****************** end Discipline **********************) + +locale M_Pi_assumptions_0 = M_Pi_assumptions _ 0 +begin + +text\This is used in the proof of \<^term>\AC_Pi_rel\\ +lemma Pi_rel_empty1[simp]: "Pi\<^bsup>M\<^esup>(0,B) = {0}" + using Pi_assumptions Pow_rel_char + by (unfold def_Pi_rel function_def) (auto) + +end \ \\<^locale>\M_Pi_assumptions_0\\ + +context M_Pi_assumptions +begin + +subsection\Auxiliary ported results on \<^term>\Pi_rel\, now unused\ +lemma Pi_rel_iff': + assumes types:"M(f)" + shows + "f \ Pi_rel(M,A,B) \ function(f) \ f \ Sigma(A,B) \ A \ domain(f)" + using assms Pow_rel_char + by (simp add:def_Pi_rel, blast) + + +lemma lam_type_M: + assumes "M(A)" "\x. x\A \ M(B(x))" + "\x. x \ A \ b(x)\B(x)" "strong_replacement(M,\x y. y=\x, b(x)\) " + shows "(\x\A. b(x)) \ Pi_rel(M,A,B)" +proof (auto simp add: lam_def def_Pi_rel function_def) + from assms + have "M({\x, b(x)\ . x \ A})" + using Pi_assumptions transM[OF _ \M(A)\] + by (rule_tac RepFun_closed, auto intro!:transM[OF _ \\x. x\A \ M(B(x))\]) + with assms + show "{\x, b(x)\ . x \ A} \ Pow\<^bsup>M\<^esup>(Sigma(A, B))" + using Pow_rel_char by auto +qed + +end \ \\<^locale>\M_Pi_assumptions\\ + +locale M_Pi_assumptions2 = M_Pi_assumptions + + PiC: M_Pi_assumptions _ _ C for C +begin + +lemma Pi_rel_type: + assumes "f \ Pi\<^bsup>M\<^esup>(A,C)" "\x. x \ A \ f`x \ B(x)" + and types: "M(f)" + shows "f \ Pi\<^bsup>M\<^esup>(A,B)" + using assms Pi_assumptions + by (simp only: Pi_rel_iff' PiC.Pi_rel_iff') + (blast dest: function_apply_equality) + +lemma Pi_rel_weaken_type: + assumes "f \ Pi\<^bsup>M\<^esup>(A,B)" "\x. x \ A \ B(x) \ C(x)" + and types: "M(f)" + shows "f \ Pi\<^bsup>M\<^esup>(A,C)" + using assms Pi_assumptions + by (simp only: Pi_rel_iff' PiC.Pi_rel_iff') + (blast intro: Pi_rel_type dest: apply_type) + +end \ \\<^locale>\M_Pi_assumptions2\\ + + +end \ No newline at end of file diff --git a/thys/Transitive_Models/Discipline_Cardinal.thy b/thys/Transitive_Models/Discipline_Cardinal.thy new file mode 100644 --- /dev/null +++ b/thys/Transitive_Models/Discipline_Cardinal.thy @@ -0,0 +1,175 @@ +theory Discipline_Cardinal + imports + Discipline_Function +begin + +declare [[syntax_ambiguity_warning = false]] + +relativize functional "cardinal" "cardinal_rel" external +relationalize "cardinal_rel" "is_cardinal" +synthesize "is_cardinal" from_definition assuming "nonempty" + +notation is_cardinal_fm (\cardinal'(_') is _\) + +abbreviation + cardinal_r :: "[i,i\o] \ i" (\|_|\<^bsup>_\<^esup>\) where + "|x|\<^bsup>M\<^esup> \ cardinal_rel(M,x)" + +abbreviation + cardinal_r_set :: "[i,i]\i" (\|_|\<^bsup>_\<^esup>\) where + "|x|\<^bsup>M\<^esup> \ cardinal_rel(##M,x)" + +context M_trivial begin +rel_closed for "cardinal" + using Least_closed'[of "\i. M(i) \ i \\<^bsup>M\<^esup> A"] + unfolding cardinal_rel_def + by simp +end + +manual_arity intermediate for "is_Int_fm" + unfolding is_Int_fm_def + using arity pred_Un_distrib + by (simp) + +arity_theorem for "is_Int_fm" + +arity_theorem for "is_funspace_fm" + +arity_theorem for "is_function_space_fm" + +arity_theorem for "surjP_rel_fm" + +arity_theorem intermediate for "is_surj_fm" + +lemma arity_is_surj_fm [arity] : + "A \ nat \ B \ nat \ I \ nat \ arity(is_surj_fm(A, B, I)) = succ(A) \ succ(B) \ succ(I)" + using arity_is_surj_fm' pred_Un_distrib + by auto + +arity_theorem for "injP_rel_fm" + +arity_theorem intermediate for "is_inj_fm" + +lemma arity_is_inj_fm [arity]: + "A \ nat \ B \ nat \ I \ nat \ arity(is_inj_fm(A, B, I)) = succ(A) \ succ(B) \ succ(I)" + using arity_is_inj_fm' pred_Un_distrib + by auto + +arity_theorem for "is_bij_fm" + +arity_theorem for "is_eqpoll_fm" + +arity_theorem for "is_cardinal_fm" + +context M_Perm begin + +is_iff_rel for "cardinal" + using least_abs'[of "\i. M(i) \ i \\<^bsup>M\<^esup> A"] + is_eqpoll_iff + unfolding is_cardinal_def cardinal_rel_def + by simp +end + +reldb_add functional "Ord" "Ord" +reldb_add relational "Ord" "ordinal" +reldb_add functional "lt" "lt" +reldb_add relational "lt" "lt_rel" +synthesize "lt_rel" from_definition +notation lt_rel_fm (\\_ < _\\) +arity_theorem intermediate for "lt_rel_fm" + +lemma arity_lt_rel_fm[arity]: "a \ nat \ b \ nat \ arity(lt_rel_fm(a, b)) = succ(a) \ succ(b)" + using arity_lt_rel_fm' + by auto + +relativize functional "Card" "Card_rel" external +relationalize "Card_rel" "is_Card" +synthesize "is_Card" from_definition assuming "nonempty" +notation is_Card_fm (\\Card'(_')\\) +arity_theorem for "is_Card_fm" + +notation Card_rel (\Card\<^bsup>_\<^esup>'(_')\) + +lemma (in M_Perm) is_Card_iff: "M(A) \ is_Card(M, A) \ Card\<^bsup>M\<^esup>(A)" + using is_cardinal_iff + unfolding is_Card_def Card_rel_def by simp + +abbreviation + Card_r_set :: "[i,i]\o" (\Card\<^bsup>_\<^esup>'(_')\) where + "Card\<^bsup>M\<^esup>(i) \ Card_rel(##M,i)" + +relativize functional "InfCard" "InfCard_rel" external +relationalize "InfCard_rel" "is_InfCard" +synthesize "is_InfCard" from_definition assuming "nonempty" +notation is_InfCard_fm (\\InfCard'(_')\\) +arity_theorem for "is_InfCard_fm" + +notation InfCard_rel (\InfCard\<^bsup>_\<^esup>'(_')\) + +abbreviation + InfCard_r_set :: "[i,i]\o" (\InfCard\<^bsup>_\<^esup>'(_')\) where + "InfCard\<^bsup>M\<^esup>(i) \ InfCard_rel(##M,i)" + +relativize functional "cadd" "cadd_rel" external + +abbreviation + cadd_r :: "[i,i\o,i] \ i" (\_ \\<^bsup>_\<^esup> _\ [66,1,66] 65) where + "A \\<^bsup>M\<^esup> B \ cadd_rel(M,A,B)" + +context M_basic begin +rel_closed for "cadd" + using cardinal_rel_closed + unfolding cadd_rel_def + by simp +end + +(* relativization *) + +relationalize "cadd_rel" "is_cadd" + +manual_schematic for "is_cadd" assuming "nonempty" + unfolding is_cadd_def + by (rule iff_sats sum_iff_sats | simp)+ +synthesize "is_cadd" from_schematic + +arity_theorem for "sum_fm" + +arity_theorem for "is_cadd_fm" + +context M_Perm begin +is_iff_rel for "cadd" + using is_cardinal_iff + unfolding is_cadd_def cadd_rel_def + by simp +end + +relativize functional "cmult" "cmult_rel" external + +abbreviation + cmult_r :: "[i,i\o,i] \ i" (\_ \\<^bsup>_\<^esup> _\ [66,1,66] 65) where + "A \\<^bsup>M\<^esup> B \ cmult_rel(M,A,B)" + +(* relativization *) +relationalize "cmult_rel" "is_cmult" + +declare cartprod_iff_sats [iff_sats] + +synthesize "is_cmult" from_definition assuming "nonempty" + +arity_theorem for "is_cmult_fm" + +context M_Perm begin + +rel_closed for "cmult" + using cardinal_rel_closed + unfolding cmult_rel_def + by simp + +is_iff_rel for "cmult" + using is_cardinal_iff + unfolding is_cmult_def cmult_rel_def + by simp + +end + +end \ No newline at end of file diff --git a/thys/Transitive_Models/Discipline_Function.thy b/thys/Transitive_Models/Discipline_Function.thy new file mode 100644 --- /dev/null +++ b/thys/Transitive_Models/Discipline_Function.thy @@ -0,0 +1,917 @@ +theory Discipline_Function + imports + Arities +begin + +(**********************************************************) +paragraph\Discipline for \<^term>\fst\\ + + +(* ftype(p) \ THE a. \b. p = \a, b\ *) +arity_theorem for "empty_fm" +arity_theorem for "upair_fm" +arity_theorem for "pair_fm" +definition + is_fst :: "(i\o)\i\i\o" where + "is_fst(M,x,t) \ (\z[M]. pair(M,t,z,x)) \ + (\(\z[M]. \w[M]. pair(M,w,z,x)) \ empty(M,t))" +synthesize "fst" from_definition "is_fst" +notation fst_fm (\\fst'(_') is _\\) + +arity_theorem for "fst_fm" + +definition fst_rel :: "[i\o,i] \ i" where + "fst_rel(M,p) \ THE d. M(d) \ is_fst(M,p,d)" + +reldb_add relational "fst" "is_fst" +reldb_add functional "fst" "fst_rel" + +definition + is_snd :: "(i\o)\i\i\o" where + "is_snd(M,x,t) \ (\z[M]. pair(M,z,t,x)) \ + (\(\z[M]. \w[M]. pair(M,z,w,x)) \ empty(M,t))" +synthesize "snd" from_definition "is_snd" +notation snd_fm (\\snd'(_') is _\\) +arity_theorem for "snd_fm" + +definition snd_rel :: "[i\o,i] \ i" where + "snd_rel(M,p) \ THE d. M(d) \ is_snd(M,p,d)" + + +reldb_add relational "snd" "is_snd" +reldb_add functional "snd" "snd_rel" + +context M_trans +begin + +lemma fst_snd_closed: + assumes "M(p)" + shows "M(fst(p)) \ M(snd(p))" + unfolding fst_def snd_def using assms + by (cases "\a. \b. p = \a, b\";auto) + +lemma fst_closed[intro,simp]: "M(x) \ M(fst(x))" + using fst_snd_closed by auto + +lemma snd_closed[intro,simp]: "M(x) \ M(snd(x))" + using fst_snd_closed by auto + +lemma fst_abs [absolut]: + "\M(p); M(x) \ \ is_fst(M,p,x) \ x = fst(p)" + unfolding is_fst_def fst_def + by (cases "\a. \b. p = \a, b\";auto) + +lemma snd_abs [absolut]: + "\M(p); M(y) \ \ is_snd(M,p,y) \ y = snd(p)" + unfolding is_snd_def snd_def + by (cases "\a. \b. p = \a, b\";auto) + +lemma empty_rel_abs : "M(x) \ M(0) \ x = 0 \ x = (THE d. M(d) \ empty(M, d))" + unfolding the_def + using transM + by auto + +lemma fst_rel_abs: + assumes "M(p)" + shows "fst(p) = fst_rel(M,p)" + using fst_abs assms + unfolding fst_def fst_rel_def + by (cases "\a. \b. p = \a, b\";auto;rule_tac the_equality[symmetric],simp_all) + +lemma snd_rel_abs: + assumes "M(p)" + shows "snd(p) = snd_rel(M,p)" + using snd_abs assms + unfolding snd_def snd_rel_def + by (cases "\a. \b. p = \a, b\";auto;rule_tac the_equality[symmetric],simp_all) + +end \ \\<^locale>\M_trans\\ + +relativize functional "first" "first_rel" external +relativize functional "minimum" "minimum_rel" external +context M_trans +begin + +lemma minimum_closed[simp,intro]: + assumes "M(A)" + shows "M(minimum(r,A))" + using first_is_elem the_equality_if transM[OF _ \M(A)\] + by(cases "\x . first(x,A,r)",auto simp:minimum_def) + +lemma first_abs : + assumes "M(B)" + shows "first(z,B,r) \ first_rel(M,z,B,r)" + unfolding first_def first_rel_def using assms by auto + +(* TODO: find a naming convention for absoluteness results like this. +See notes/TODO.txt +*) +lemma minimum_abs: + assumes "M(B)" + shows "minimum(r,B) = minimum_rel(M,r,B)" +proof - + from assms + have "first(b, B, r) \ M(b) \ first_rel(M,b,B,r)" for b + using first_abs + proof (auto) + fix b + assume "first_rel(M,b,B,r)" + with \M(B)\ + have "b\B" using first_abs first_is_elem by simp + with \M(B)\ + show "M(b)" using transM[OF \b\B\] by simp + qed + with assms + show ?thesis unfolding minimum_rel_def minimum_def + by simp +qed + +end \ \\<^locale>\M_trans\\ + +subsection\Discipline for \<^term>\function_space\\ + +definition + is_function_space :: "[i\o,i,i,i] \ o" where + "is_function_space(M,A,B,fs) \ M(fs) \ is_funspace(M,A,B,fs)" + +definition + function_space_rel :: "[i\o,i,i] \ i" where + "function_space_rel(M,A,B) \ THE d. is_function_space(M,A,B,d)" + +reldb_rem absolute "Pi" +reldb_add relational "Pi" "is_function_space" +reldb_add functional "Pi" "function_space_rel" + +abbreviation + function_space_r :: "[i,i\o,i] \ i" (\_ \\<^bsup>_\<^esup> _\ [61,1,61] 60) where + "A \\<^bsup>M\<^esup> B \ function_space_rel(M,A,B)" + +abbreviation + function_space_r_set :: "[i,i,i] \ i" (\_ \\<^bsup>_\<^esup> _\ [61,1,61] 60) where + "function_space_r_set(A,M) \ function_space_rel(##M,A)" + +context M_Pi +begin + +lemma is_function_space_uniqueness: + assumes + "M(r)" "M(B)" + "is_function_space(M,r,B,d)" "is_function_space(M,r,B,d')" + shows + "d=d'" + using assms extensionality_trans + unfolding is_function_space_def is_funspace_def + by simp + +lemma is_function_space_witness: + assumes "M(A)" "M(B)" + shows "\d[M]. is_function_space(M,A,B,d)" +proof - + from assms + interpret M_Pi_assumptions M A "\_. B" + using Pi_replacement Pi_separation + by unfold_locales (auto dest:transM simp add:Sigfun_def) + have "\f[M]. f \ Pi_rel(M,A, \_. B) \ f \ A \ B" + using Pi_rel_char by simp + with assms + show ?thesis unfolding is_funspace_def is_function_space_def by auto +qed + +lemma is_function_space_closed : + "is_function_space(M,A,B,d) \ M(d)" + unfolding is_function_space_def by simp + +\ \adding closure to simpset and claset\ +lemma function_space_rel_closed[intro,simp]: + assumes "M(x)" "M(y)" + shows "M(function_space_rel(M,x,y))" +proof - + have "is_function_space(M, x, y, THE xa. is_function_space(M, x, y, xa))" + using assms + theI[OF ex1I[of "is_function_space(M,x,y)"], OF _ is_function_space_uniqueness[of x y]] + is_function_space_witness + by auto + then show ?thesis + using assms is_function_space_closed + unfolding function_space_rel_def + by blast +qed + +lemmas trans_function_space_rel_closed[trans_closed] = transM[OF _ function_space_rel_closed] + +lemma is_function_space_iff: + assumes "M(x)" "M(y)" "M(d)" + shows "is_function_space(M,x,y,d) \ d = function_space_rel(M,x,y)" +proof (intro iffI) + assume "d = function_space_rel(M,x,y)" + moreover + note assms + moreover from this + obtain e where "M(e)" "is_function_space(M,x,y,e)" + using is_function_space_witness by blast + ultimately + show "is_function_space(M, x, y, d)" + using is_function_space_uniqueness[of x y] is_function_space_witness + theI[OF ex1I[of "is_function_space(M,x,y)"], OF _ is_function_space_uniqueness[of x y], of e] + unfolding function_space_rel_def + by auto +next + assume "is_function_space(M, x, y, d)" + with assms + show "d = function_space_rel(M,x,y)" + using is_function_space_uniqueness unfolding function_space_rel_def + by (blast del:the_equality intro:the_equality[symmetric]) +qed + + +lemma def_function_space_rel: + assumes "M(A)" "M(y)" + shows "function_space_rel(M,A,y) = Pi_rel(M,A,\_. y)" +proof - + from assms + interpret M_Pi_assumptions M A "\_. y" + using Pi_replacement Pi_separation + by unfold_locales (auto dest:transM simp add:Sigfun_def) + from assms + have "x\function_space_rel(M,A,y) \ x\Pi_rel(M,A,\_. y)" if "M(x)" for x + using that + is_function_space_iff[of A y, OF _ _ function_space_rel_closed, of A y] + def_Pi_rel Pi_rel_char mbnr.Pow_rel_char + unfolding is_function_space_def is_funspace_def by (simp add:Pi_def) + with assms + show ?thesis \ \At this point, quoting "trans\_rules" doesn't work\ + using transM[OF _ function_space_rel_closed, OF _ \M(A)\ \M(y)\] + transM[OF _ Pi_rel_closed] by blast +qed + +lemma function_space_rel_char: + assumes "M(A)" "M(y)" + shows "function_space_rel(M,A,y) = {f \ A \ y. M(f)}" +proof - + from assms + interpret M_Pi_assumptions M A "\_. y" + using Pi_replacement Pi_separation + by unfold_locales (auto dest:transM simp add:Sigfun_def) + show ?thesis + using assms def_function_space_rel Pi_rel_char + by simp +qed + +lemma mem_function_space_rel_abs: + assumes "M(A)" "M(y)" "M(f)" + shows "f \ function_space_rel(M,A,y) \ f \ A \ y" + using assms function_space_rel_char by simp + +end \ \\<^locale>\M_Pi\\ + +locale M_N_Pi = M:M_Pi + N:M_Pi N for N + + assumes + M_imp_N:"M(x) \ N(x)" +begin + +lemma function_space_rel_transfer: "M(A) \ M(B) \ + function_space_rel(M,A,B) \ function_space_rel(N,A,B)" + using M.function_space_rel_char N.function_space_rel_char + by (auto dest!:M_imp_N) + +end \ \\<^locale>\M_N_Pi\\ + +(***************** end Discipline ***********************) + +abbreviation + "is_apply \ fun_apply" + \ \It is not necessary to perform the Discipline for \<^term>\is_apply\ + since it is absolute in this context\ + +subsection\Discipline for \<^term>\Collect\ terms.\ + +text\We have to isolate the predicate involved and apply the +Discipline to it.\ + +(*************** Discipline for injP ******************) + + +definition (* completely relational *) + injP_rel:: "[i\o,i,i]\o" where + "injP_rel(M,A,f) \ \w[M]. \x[M]. \fw[M]. \fx[M]. w\A \ x\A \ + is_apply(M,f,w,fw) \ is_apply(M,f,x,fx) \ fw=fx\ w=x" + +synthesize "injP_rel" from_definition assuming "nonempty" + +arity_theorem for "injP_rel_fm" + +context M_basic +begin + +\ \I'm undecided on keeping the relative quantifiers here. + Same with \<^term>\surjP\ below. It might relieve from changing + @{thm exI allI} to @{thm rexI rallI} in some proofs. + I wonder if this escalates well. Assuming that all terms + appearing in the "def\_" theorem are in \<^term>\M\ and using + @{thm transM}, it might do.\ +lemma def_injP_rel: + assumes + "M(A)" "M(f)" + shows + "injP_rel(M,A,f) \ (\w[M]. \x[M]. w\A \ x\A \ f`w=f`x \ w=x)" + using assms unfolding injP_rel_def by simp + +end \ \\<^locale>\M_basic\\ + +(****************** end Discipline **********************) + +(**********************************************************) +subsection\Discipline for \<^term>\inj\\ + +definition (* completely relational *) + is_inj :: "[i\o,i,i,i]\o" where + "is_inj(M,A,B,I) \ M(I) \ (\F[M]. is_function_space(M,A,B,F) \ + is_Collect(M,F,injP_rel(M,A),I))" + + +declare typed_function_iff_sats Collect_iff_sats [iff_sats] + +synthesize "is_funspace" from_definition assuming "nonempty" +arity_theorem for "is_funspace_fm" + +synthesize "is_function_space" from_definition assuming "nonempty" +notation is_function_space_fm (\\_ \ _ is _\\) + +arity_theorem for "is_function_space_fm" + +synthesize "is_inj" from_definition assuming "nonempty" +notation is_inj_fm (\\inj'(_,_') is _\\) + +arity_theorem intermediate for "is_inj_fm" + +lemma arity_is_inj_fm[arity]: + "A \ nat \ + B \ nat \ I \ nat \ arity(is_inj_fm(A, B, I)) = succ(A) \ succ(B) \ succ(I)" + using arity_is_inj_fm' by (auto simp:pred_Un_distrib arity) + +definition + inj_rel :: "[i\o,i,i] \ i" (\inj\<^bsup>_\<^esup>'(_,_')\) where + "inj_rel(M,A,B) \ THE d. is_inj(M,A,B,d)" + +abbreviation + inj_r_set :: "[i,i,i] \ i" (\inj\<^bsup>_\<^esup>'(_,_')\) where + "inj_r_set(M) \ inj_rel(##M)" + +locale M_inj = M_Pi + + assumes + injP_separation: "M(r) \ separation(M,injP_rel(M, r))" +begin + +lemma is_inj_uniqueness: + assumes + "M(r)" "M(B)" + "is_inj(M,r,B,d)" "is_inj(M,r,B,d')" + shows + "d=d'" + using assms is_function_space_iff extensionality_trans + unfolding is_inj_def by simp + +lemma is_inj_witness: "M(r) \ M(B)\ \d[M]. is_inj(M,r,B,d)" + using injP_separation is_function_space_iff + unfolding is_inj_def by simp + +lemma is_inj_closed : + "is_inj(M,x,y,d) \ M(d)" + unfolding is_inj_def by simp + +lemma inj_rel_closed[intro,simp]: + assumes "M(x)" "M(y)" + shows "M(inj_rel(M,x,y))" +proof - + have "is_inj(M, x, y, THE xa. is_inj(M, x, y, xa))" + using assms + theI[OF ex1I[of "is_inj(M,x,y)"], OF _ is_inj_uniqueness[of x y]] + is_inj_witness + by auto + then show ?thesis + using assms is_inj_closed + unfolding inj_rel_def + by blast +qed + +lemmas trans_inj_rel_closed[trans_closed] = transM[OF _ inj_rel_closed] + +lemma inj_rel_iff: + assumes "M(x)" "M(y)" "M(d)" + shows "is_inj(M,x,y,d) \ d = inj_rel(M,x,y)" +proof (intro iffI) + assume "d = inj_rel(M,x,y)" + moreover + note assms + moreover from this + obtain e where "M(e)" "is_inj(M,x,y,e)" + using is_inj_witness by blast + ultimately + show "is_inj(M, x, y, d)" + using is_inj_uniqueness[of x y] is_inj_witness + theI[OF ex1I[of "is_inj(M,x,y)"], OF _ is_inj_uniqueness[of x y], of e] + unfolding inj_rel_def + by auto +next + assume "is_inj(M, x, y, d)" + with assms + show "d = inj_rel(M,x,y)" + using is_inj_uniqueness unfolding inj_rel_def + by (blast del:the_equality intro:the_equality[symmetric]) +qed + +lemma def_inj_rel: + assumes "M(A)" "M(B)" + shows "inj_rel(M,A,B) = + {f \ function_space_rel(M,A,B). \w[M]. \x[M]. w\A \ x\A \ f`w = f`x \ w=x}" + (is "_ = Collect(_,?P)") +proof - + from assms + have "inj_rel(M,A,B) \ function_space_rel(M,A,B)" + using inj_rel_iff[of A B "inj_rel(M,A,B)"] is_function_space_iff + unfolding is_inj_def by auto + moreover from assms + have "f \ inj_rel(M,A,B) \ ?P(f)" for f + using inj_rel_iff[of A B "inj_rel(M,A,B)"] is_function_space_iff + def_injP_rel transM[OF _ function_space_rel_closed, OF _ \M(A)\ \M(B)\] + unfolding is_inj_def by auto + moreover from assms + have "f \ function_space_rel(M,A,B) \ ?P(f) \ f \ inj_rel(M,A,B)" for f + using inj_rel_iff[of A B "inj_rel(M,A,B)"] is_function_space_iff + def_injP_rel transM[OF _ function_space_rel_closed, OF _ \M(A)\ \M(B)\] + unfolding is_inj_def by auto + ultimately + show ?thesis by force +qed + +lemma inj_rel_char: + assumes "M(A)" "M(B)" + shows "inj_rel(M,A,B) = {f \ inj(A,B). M(f)}" +proof - + from assms + interpret M_Pi_assumptions M A "\_. B" + using Pi_replacement Pi_separation + by unfold_locales (auto dest:transM simp add:Sigfun_def) + from assms + show ?thesis + using def_inj_rel[OF assms] def_function_space_rel[OF assms] + transM[OF _ \M(A)\] Pi_rel_char + unfolding inj_def + by auto +qed + + +end \ \\<^locale>\M_inj\\ + +locale M_N_inj = M:M_inj + N:M_inj N for N + + assumes + M_imp_N:"M(x) \ N(x)" +begin + +lemma inj_rel_transfer: "M(A) \ M(B) \ inj_rel(M,A,B) \ inj_rel(N,A,B)" + using M.inj_rel_char N.inj_rel_char + by (auto dest!:M_imp_N) + +end \ \\<^locale>\M_N_inj\\ + + +(*************** end Discipline *********************) + +(*************** Discipline for surjP ******************) + +definition + surjP_rel:: "[i\o,i,i,i]\o" where + "surjP_rel(M,A,B,f) \ + \y[M]. \x[M]. \fx[M]. y\B \ x\A \ is_apply(M,f,x,fx) \ fx=y" + +synthesize "surjP_rel" from_definition assuming "nonempty" + +context M_basic +begin + +lemma def_surjP_rel: + assumes + "M(A)" "M(B)" "M(f)" + shows + "surjP_rel(M,A,B,f) \ (\y[M]. \x[M]. y\B \ x\A \ f`x=y)" + using assms unfolding surjP_rel_def by auto + +end \ \\<^locale>\M_basic\\ + +(****************** end Discipline **********************) + +(**********************************************************) +subsection\Discipline for \<^term>\surj\\ + +definition (* completely relational *) + is_surj :: "[i\o,i,i,i]\o" where + "is_surj(M,A,B,I) \ M(I) \ (\F[M]. is_function_space(M,A,B,F) \ + is_Collect(M,F,surjP_rel(M,A,B),I))" + +synthesize "is_surj" from_definition assuming "nonempty" +notation is_surj_fm (\\surj'(_,_') is _\\) + +definition + surj_rel :: "[i\o,i,i] \ i" (\surj\<^bsup>_\<^esup>'(_,_')\) where + "surj_rel(M,A,B) \ THE d. is_surj(M,A,B,d)" + +abbreviation + surj_r_set :: "[i,i,i] \ i" (\surj\<^bsup>_\<^esup>'(_,_')\) where + "surj_r_set(M) \ surj_rel(##M)" + +locale M_surj = M_Pi + + assumes + surjP_separation: "M(A)\M(B)\separation(M,\x. surjP_rel(M,A,B,x))" +begin + +lemma is_surj_uniqueness: + assumes + "M(r)" "M(B)" + "is_surj(M,r,B,d)" "is_surj(M,r,B,d')" + shows + "d=d'" + using assms is_function_space_iff extensionality_trans + unfolding is_surj_def by simp + +lemma is_surj_witness: "M(r) \ M(B)\ \d[M]. is_surj(M,r,B,d)" + using surjP_separation is_function_space_iff + unfolding is_surj_def by simp + +lemma is_surj_closed : + "is_surj(M,x,y,d) \ M(d)" + unfolding is_surj_def by simp + +lemma surj_rel_closed[intro,simp]: + assumes "M(x)" "M(y)" + shows "M(surj_rel(M,x,y))" +proof - + have "is_surj(M, x, y, THE xa. is_surj(M, x, y, xa))" + using assms + theI[OF ex1I[of "is_surj(M,x,y)"], OF _ is_surj_uniqueness[of x y]] + is_surj_witness + by auto + then show ?thesis + using assms is_surj_closed + unfolding surj_rel_def + by blast +qed + +lemmas trans_surj_rel_closed[trans_closed] = transM[OF _ surj_rel_closed] + +lemma surj_rel_iff: + assumes "M(x)" "M(y)" "M(d)" + shows "is_surj(M,x,y,d) \ d = surj_rel(M,x,y)" +proof (intro iffI) + assume "d = surj_rel(M,x,y)" + moreover + note assms + moreover from this + obtain e where "M(e)" "is_surj(M,x,y,e)" + using is_surj_witness by blast + ultimately + show "is_surj(M, x, y, d)" + using is_surj_uniqueness[of x y] is_surj_witness + theI[OF ex1I[of "is_surj(M,x,y)"], OF _ is_surj_uniqueness[of x y], of e] + unfolding surj_rel_def + by auto +next + assume "is_surj(M, x, y, d)" + with assms + show "d = surj_rel(M,x,y)" + using is_surj_uniqueness unfolding surj_rel_def + by (blast del:the_equality intro:the_equality[symmetric]) +qed + +lemma def_surj_rel: + assumes "M(A)" "M(B)" + shows "surj_rel(M,A,B) = + {f \ function_space_rel(M,A,B). \y[M]. \x[M]. y\B \ x\A \ f`x=y }" + (is "_ = Collect(_,?P)") +proof - + from assms + have "surj_rel(M,A,B) \ function_space_rel(M,A,B)" + using surj_rel_iff[of A B "surj_rel(M,A,B)"] is_function_space_iff + unfolding is_surj_def by auto + moreover from assms + have "f \ surj_rel(M,A,B) \ ?P(f)" for f + using surj_rel_iff[of A B "surj_rel(M,A,B)"] is_function_space_iff + def_surjP_rel transM[OF _ function_space_rel_closed, OF _ \M(A)\ \M(B)\] + unfolding is_surj_def by auto + moreover from assms + have "f \ function_space_rel(M,A,B) \ ?P(f) \ f \ surj_rel(M,A,B)" for f + using surj_rel_iff[of A B "surj_rel(M,A,B)"] is_function_space_iff + def_surjP_rel transM[OF _ function_space_rel_closed, OF _ \M(A)\ \M(B)\] + unfolding is_surj_def by auto + ultimately + show ?thesis by force +qed + +lemma surj_rel_char: + assumes "M(A)" "M(B)" + shows "surj_rel(M,A,B) = {f \ surj(A,B). M(f)}" +proof - + from assms + interpret M_Pi_assumptions M A "\_. B" + using Pi_replacement Pi_separation + by unfold_locales (auto dest:transM simp add:Sigfun_def) + from assms + show ?thesis + using def_surj_rel[OF assms] def_function_space_rel[OF assms] + transM[OF _ \M(A)\] transM[OF _ \M(B)\] Pi_rel_char + unfolding surj_def + by auto +qed + +end \ \\<^locale>\M_surj\\ + +locale M_N_surj = M:M_surj + N:M_surj N for N + + assumes + M_imp_N:"M(x) \ N(x)" +begin + +lemma surj_rel_transfer: "M(A) \ M(B) \ surj_rel(M,A,B) \ surj_rel(N,A,B)" + using M.surj_rel_char N.surj_rel_char + by (auto dest!:M_imp_N) + +end \ \\<^locale>\M_N_surj\\ + +(*************** end Discipline *********************) + +definition + is_Int :: "[i\o,i,i,i]\o" where + "is_Int(M,A,B,I) \ M(I) \ (\x[M]. x \ I \ x \ A \ x \ B)" + +reldb_rem relational "inter" +reldb_add absolute relational "ZF_Base.Int" "is_Int" + +synthesize "is_Int" from_definition assuming "nonempty" +notation is_Int_fm (\_ \ _ is _\) + +context M_basic +begin + +lemma is_Int_closed : + "is_Int(M,A,B,I) \ M(I)" + unfolding is_Int_def by simp + +lemma is_Int_abs: + assumes + "M(A)" "M(B)" "M(I)" + shows + "is_Int(M,A,B,I) \ I = A \ B" + using assms transM[OF _ \M(B)\] transM[OF _ \M(I)\] + unfolding is_Int_def by blast + +lemma is_Int_uniqueness: + assumes + "M(r)" "M(B)" + "is_Int(M,r,B,d)" "is_Int(M,r,B,d')" + shows + "d=d'" +proof - + have "M(d)" and "M(d')" + using assms is_Int_closed by simp+ + then show ?thesis + using assms is_Int_abs by simp +qed + +text\Note: @{thm Int_closed} already in \<^theory>\ZF-Constructible.Relative\.\ + +end \ \\<^locale>\M_basic\\ + +(**********************************************************) +subsection\Discipline for \<^term>\bij\\ + +reldb_add functional "inj" "inj_rel" +reldb_add functional relational "inj_rel" "is_inj" +reldb_add functional "surj" "surj_rel" +reldb_add functional relational "surj_rel" "is_surj" +relativize functional "bij" "bij_rel" external +relationalize "bij_rel" "is_bij" + +(* definition (* completely relational *) + is_bij :: "[i\o,i,i,i]\o" where + "is_bij(M,A,B,bj) \ M(bj) \ is_hcomp2_2(M,is_Int,is_inj,is_surj,A,B,bj)" + +definition + bij_rel :: "[i\o,i,i] \ i" (\bij\<^bsup>_\<^esup>'(_,_')\) where + "bij_rel(M,A,B) \ THE d. is_bij(M,A,B,d)" *) + +synthesize "is_bij" from_definition assuming "nonempty" +notation is_bij_fm (\\bij'(_,_') is _\\) + +abbreviation + bij_r_class :: "[i\o,i,i] \ i" (\bij\<^bsup>_\<^esup>'(_,_')\) where + "bij_r_class \ bij_rel" + +abbreviation + bij_r_set :: "[i,i,i] \ i" (\bij\<^bsup>_\<^esup>'(_,_')\) where + "bij_r_set(M) \ bij_rel(##M)" + +locale M_Perm = M_Pi + M_inj + M_surj +begin + +lemma is_bij_closed : "is_bij(M,f,y,d) \ M(d)" + unfolding is_bij_def using is_Int_closed is_inj_witness is_surj_witness by auto + +lemma bij_rel_closed[intro,simp]: + assumes "M(x)" "M(y)" + shows "M(bij_rel(M,x,y))" + unfolding bij_rel_def + using assms Int_closed surj_rel_closed inj_rel_closed + by auto + +lemmas trans_bij_rel_closed[trans_closed] = transM[OF _ bij_rel_closed] + +lemma bij_rel_iff: + assumes "M(x)" "M(y)" "M(d)" + shows "is_bij(M,x,y,d) \ d = bij_rel(M,x,y)" + unfolding is_bij_def bij_rel_def + using assms surj_rel_iff inj_rel_iff is_Int_abs + by auto + +lemma def_bij_rel: + assumes "M(A)" "M(B)" + shows "bij_rel(M,A,B) = inj_rel(M,A,B) \ surj_rel(M,A,B)" + using assms bij_rel_iff inj_rel_iff surj_rel_iff + is_Int_abs\ \For absolute terms, "\_abs" replaces "\_iff". + Also, in this case "\_closed" is in the simpset.\ + unfolding is_bij_def by simp + +lemma bij_rel_char: + assumes "M(A)" "M(B)" + shows "bij_rel(M,A,B) = {f \ bij(A,B). M(f)}" + using assms def_bij_rel inj_rel_char surj_rel_char + unfolding bij_def\ \Unfolding this might be a pattern already\ + by auto + +end \ \\<^locale>\M_Perm\\ + +locale M_N_Perm = M_N_Pi + M_N_inj + M_N_surj + M:M_Perm + N:M_Perm N + +begin + +lemma bij_rel_transfer: "M(A) \ M(B) \ bij_rel(M,A,B) \ bij_rel(N,A,B)" + using M.bij_rel_char N.bij_rel_char + by (auto dest!:M_imp_N) + +end \ \\<^locale>\M_N_Perm\\ + +(*************** end Discipline *********************) + +(******************************************************) +subsection\Discipline for \<^term>\eqpoll\\ + +relativize functional "eqpoll" "eqpoll_rel" external +relationalize "eqpoll_rel" "is_eqpoll" + +synthesize "is_eqpoll" from_definition assuming "nonempty" +arity_theorem for "is_eqpoll_fm" +notation is_eqpoll_fm (\\_ \ _\\) + +context M_Perm begin + +is_iff_rel for "eqpoll" + using bij_rel_iff unfolding is_eqpoll_def eqpoll_rel_def by simp + +end \ \\<^locale>\M_Perm\\ + +abbreviation + eqpoll_r :: "[i,i\o,i] => o" (\_ \\<^bsup>_\<^esup> _\ [51,1,51] 50) where + "A \\<^bsup>M\<^esup> B \ eqpoll_rel(M,A,B)" + +abbreviation + eqpoll_r_set :: "[i,i,i] \ o" (\_ \\<^bsup>_\<^esup> _\ [51,1,51] 50) where + "eqpoll_r_set(A,M) \ eqpoll_rel(##M,A)" + +context M_Perm +begin + +lemma def_eqpoll_rel: + assumes + "M(A)" "M(B)" + shows + "eqpoll_rel(M,A,B) \ (\f[M]. f \ bij_rel(M,A,B))" + using assms bij_rel_iff + unfolding eqpoll_rel_def by simp + +end \ \\<^locale>\M_Perm\\ + +context M_N_Perm +begin + +(* the next lemma is not part of the discipline *) +lemma eqpoll_rel_transfer: assumes "A \\<^bsup>M\<^esup> B" "M(A)" "M(B)" + shows "A \\<^bsup>N\<^esup> B" +proof - + note assms + moreover from this + obtain f where "f \ bij\<^bsup>M\<^esup>(A,B)" "N(f)" + using M.def_eqpoll_rel by (auto dest!:M_imp_N) + moreover from calculation + have "f \ bij\<^bsup>N\<^esup>(A,B)" + using bij_rel_transfer by (auto) + ultimately + show ?thesis + using N.def_eqpoll_rel by (blast dest!:M_imp_N) +qed + +end \ \\<^locale>\M_N_Perm\\ + +(****************** end Discipline ******************) + +(******************************************************) +subsection\Discipline for \<^term>\lepoll\\ + +relativize functional "lepoll" "lepoll_rel" external +relationalize "lepoll_rel" "is_lepoll" + +synthesize "is_lepoll" from_definition assuming "nonempty" +notation is_lepoll_fm (\\_ \ _\\) +arity_theorem for "is_lepoll_fm" + +context M_inj begin + +is_iff_rel for "lepoll" + using inj_rel_iff unfolding is_lepoll_def lepoll_rel_def by simp + +end \ \\<^locale>\M_inj\\ + +abbreviation + lepoll_r :: "[i,i\o,i] => o" (\_ \\<^bsup>_\<^esup> _\ [51,1,51] 50) where + "A \\<^bsup>M\<^esup> B \ lepoll_rel(M,A,B)" + +abbreviation + lepoll_r_set :: "[i,i,i] \ o" (\_ \\<^bsup>_\<^esup> _\ [51,1,51] 50) where + "lepoll_r_set(A,M) \ lepoll_rel(##M,A)" + +context M_Perm +begin + +lemma def_lepoll_rel: + assumes + "M(A)" "M(B)" + shows + "lepoll_rel(M,A,B) \ (\f[M]. f \ inj_rel(M,A,B))" + using assms inj_rel_iff + unfolding lepoll_rel_def by simp + +end \ \\<^locale>\M_Perm\\ + +context M_N_Perm +begin + +(* the next lemma is not part of the discipline *) +lemma lepoll_rel_transfer: assumes "A \\<^bsup>M\<^esup> B" "M(A)" "M(B)" + shows "A \\<^bsup>N\<^esup> B" +proof - + note assms + moreover from this + obtain f where "f \ inj\<^bsup>M\<^esup>(A,B)" "N(f)" + using M.def_lepoll_rel by (auto dest!:M_imp_N) + moreover from calculation + have "f \ inj\<^bsup>N\<^esup>(A,B)" + using inj_rel_transfer by (auto) + ultimately + show ?thesis + using N.def_lepoll_rel by (blast dest!:M_imp_N) +qed + +end \ \\<^locale>\M_N_Perm\\ + +(****************** end Discipline ******************) + +(******************************************************) +subsection\Discipline for \<^term>\lesspoll\\ + +relativize functional "lesspoll" "lesspoll_rel" external +relationalize "lesspoll_rel" "is_lesspoll" + +synthesize "is_lesspoll" from_definition assuming "nonempty" +notation is_lesspoll_fm (\\_ \ _\\) +arity_theorem for "is_lesspoll_fm" + +context M_Perm begin + +is_iff_rel for "lesspoll" + using is_lepoll_iff is_eqpoll_iff + unfolding is_lesspoll_def lesspoll_rel_def by simp + +end \ \\<^locale>\M_Perm\\ + +abbreviation + lesspoll_r :: "[i,i\o,i] => o" (\_ \\<^bsup>_\<^esup> _\ [51,1,51] 50) where + "A \\<^bsup>M\<^esup> B \ lesspoll_rel(M,A,B)" + +abbreviation + lesspoll_r_set :: "[i,i,i] \ o" (\_ \\<^bsup>_\<^esup> _\ [51,1,51] 50) where + "lesspoll_r_set(A,M) \ lesspoll_rel(##M,A)" + +text\Since \<^term>\lesspoll_rel\ is defined as a propositional +combination of older terms, there is no need for a separate ``def'' +theorem for it.\ + +text\Note that \<^term>\lesspoll_rel\ is neither $\Sigma_1^{\mathit{ZF}}$ nor + $\Pi_1^{\mathit{ZF}}$, so there is no ``transfer'' theorem for it.\ + +end \ No newline at end of file diff --git a/thys/Transitive_Models/FiniteFun_Relative.thy b/thys/Transitive_Models/FiniteFun_Relative.thy new file mode 100644 --- /dev/null +++ b/thys/Transitive_Models/FiniteFun_Relative.thy @@ -0,0 +1,421 @@ +section\Relativization of Finite Functions\ +theory FiniteFun_Relative + imports + Lambda_Replacement +begin + +lemma FiniteFunI : + assumes "f\Fin(A\B)" "function(f)" + shows "f \ A -||> B" + using assms +proof(induct) + case 0 + then show ?case using emptyI by simp +next + case (cons p f) + moreover + from assms this + have "fst(p)\A" "snd(p)\B" "function(f)" + using snd_type[OF \p\_\] function_subset + by auto + moreover + from \function(cons(p,f))\ \p\f\ \p\_\ + have "fst(p)\domain(f)" + unfolding function_def + by force + ultimately + show ?case + using consI[of "fst(p)" _ "snd(p)"] + by auto +qed + +subsection\The set of finite binary sequences\ + +text\We implement the poset for adding one Cohen real, the set +$2^{<\omega}$ of finite binary sequences.\ + +definition + seqspace :: "[i,i] \ i" (\_\<^bsup><_\<^esup>\ [100,1]100) where + "B\<^bsup><\\<^esup> \ \n\\. (n\B)" + +schematic_goal seqspace_fm_auto: + assumes + "i \ nat" "j \ nat" "h\nat" "env \ list(A)" + shows + "(\om\A. omega(##A,om) \ nth(i,env) \ om \ is_funspace(##A, nth(i,env), nth(h,env), nth(j,env))) \ (A, env \ (?sqsprp(i,j,h)))" + unfolding is_funspace_def + by (insert assms ; (rule iff_sats | simp)+) + +synthesize "seqspace_rel" from_schematic "seqspace_fm_auto" +arity_theorem for "seqspace_rel_fm" + +lemma seqspaceI[intro]: "n\\ \ f:n\B \ f\B\<^bsup><\\<^esup>" + unfolding seqspace_def by blast + +lemma seqspaceD[dest]: "f\B\<^bsup><\\<^esup> \ \n\\. f:n\B" + unfolding seqspace_def by blast + +locale M_seqspace = M_trancl + M_replacement + + assumes + seqspace_replacement: "M(B) \ strong_replacement(M,\n z. n\nat \ is_funspace(M,n,B,z))" +begin + +lemma seqspace_closed: + "M(B) \ M(B\<^bsup><\\<^esup>)" + unfolding seqspace_def using seqspace_replacement[of B] RepFun_closed2 + by simp +end + +subsection\Representation of finite functions\ + +text\A function $f\in A\to_{\mathit{fin}}B$ can be represented by a function +$g\in |f| \to A\times B$. It is clear that $f$ can be represented by +any $g' = g \cdot \pi$, where $\pi$ is a permutation $\pi\in dom(g)\to dom(g)$. +We use this representation of $A\to_{\mathit{fin}}B$ to prove that our model is +closed under $\_\to_{\mathit{fin}}\_$.\ + +text\A function $g\in n\to A\times B$ that is functional in the first components.\ +definition cons_like :: "i \ o" where + "cons_like(f) \ \ i\domain(f) . \j\i . fst(f`i) \ fst(f`j)" + +relativize "cons_like" "cons_like_rel" + +lemma (in M_seqspace) cons_like_abs: + "M(f) \ cons_like(f) \ cons_like_rel(M,f)" + unfolding cons_like_def cons_like_rel_def + using fst_abs + by simp + +definition FiniteFun_iso :: "[i,i,i,i,i] \ o" where + "FiniteFun_iso(A,B,n,g,f) \ (\ i\n . g`i \ f) \ (\ ab\f. (\ i\n. g`i=ab))" + +text\From a function $g\in n \to A\times B$ we obtain a finite function in \<^term>\A-||>B\.\ + +definition to_FiniteFun :: "i \ i" where + "to_FiniteFun(f) \ {f`i. i\domain(f)}" + +definition FiniteFun_Repr :: "[i,i] \ i" where + "FiniteFun_Repr(A,B) \ {f \ (A\B)\<^bsup><\\<^esup> . cons_like(f) }" + +locale M_FiniteFun = M_seqspace + + assumes + cons_like_separation : "separation(M,\f. cons_like_rel(M,f))" + and + separation_is_function : "separation(M, is_function(M))" +begin + +lemma supset_separation: "separation(M, \ x. \a. \b. x = \a,b\ \ b \ a)" + using separation_pair separation_subset lam_replacement_fst lam_replacement_snd + by simp + +lemma to_finiteFun_replacement: "strong_replacement(M, \x y. y = range(x))" + using lam_replacement_range lam_replacement_imp_strong_replacement + by simp + +lemma fun_range_eq: "f\A\B \ {f`i . i\domain(f) } = range(f)" + using ZF_Library.range_eq_image[of f] domain_of_fun image_fun func.apply_rangeI + by simp + +lemma FiniteFun_fst_type: + assumes "h\A-||>B" "p\h" + shows "fst(p)\domain(h)" + using assms + by(induct h, auto) + +lemma FinFun_closed: + "M(A) \ M(B) \ M(\{n\A\B . n\\})" + using cartprod_closed seqspace_closed + unfolding seqspace_def by simp + +lemma cons_like_lt : + assumes "n\\" "f\succ(n)\A\B" "cons_like(f)" + shows "restrict(f,n)\n\A\B" "cons_like(restrict(f,n))" + using assms +proof (auto simp add: le_imp_subset restrict_type2) + from \f\_\ + have D:"domain(restrict(f,n)) = n" "domain(f) = succ(n)" + using domain_of_fun domain_restrict by auto + { + fix i j + assume "i\domain(restrict(f,n))" (is "i\?D") "j\i" + with \n\_\ D + have "j\?D" "i\n" "j\n" using Ord_trans[of j] by simp_all + with D \cons_like(f)\ \j\n\ \i\n\ \j\i\ + have "fst(restrict(f,n)`i) \ fst(restrict(f,n)`j)" + using restrict_if unfolding cons_like_def by auto + } + then show "cons_like(restrict(f,n))" + unfolding cons_like_def by auto +qed + +text\A finite function \<^term>\f \ A -||> B\ can be represented by a +function $g \in n \to A \times B$, with $n=|f|$.\ +lemma FiniteFun_iso_intro1: + assumes "f \ (A -||> B)" + shows "\n\\ . \g\n\A\B. FiniteFun_iso(A,B,n,g,f) \ cons_like(g)" + using assms +proof(induct f,force simp add:emptyI FiniteFun_iso_def cons_like_def) + case (consI a b h) + then obtain n g where + HI: "n\\" "g\n\A\B" "FiniteFun_iso(A,B,n,g,h)" "cons_like(g)" by auto + let ?G="\ i \ succ(n) . if i=n then else g`i" + from HI \a\_\ \b\_\ + have G: "?G \ succ(n)\A\B" + by (auto intro:lam_type) + have "FiniteFun_iso(A,B,succ(n),?G,cons(,h))" + unfolding FiniteFun_iso_def + proof(intro conjI) + { + fix i + assume "i\succ(n)" + then consider "i=n" | "i\n\i\n" by auto + then have "?G ` i \ cons(,h)" + using HI + by(cases,simp;auto simp add:HI FiniteFun_iso_def) + } + then show "\i\succ(n). ?G ` i \ cons(\a, b\, h)" .. + next + { fix ab' + assume "ab' \ cons(,h)" + then + consider "ab' = " | "ab' \ h" using cons_iff by auto + then + have "\i \ succ(n) . ?G`i = ab'" unfolding FiniteFun_iso_def + proof(cases,simp) + case 2 + with HI obtain i + where "i\n" "g`i=ab'" unfolding FiniteFun_iso_def by auto + with HI show ?thesis using ltI[OF \i\_\] by auto + qed + } + then + show "\ab\cons(\a, b\, h). \i\succ(n). ?G`i = ab" .. + qed + with HI G + have 1: "?G\succ(n)\A\B" "FiniteFun_iso(A,B,succ(n),?G,cons(,h))" "succ(n)\\" by simp_all + have "cons_like(?G)" + proof - + from \?G\_\ \g\_\ + have "domain(g) = n" using domain_of_fun by simp + { + fix i j + assume "i\domain(?G)" "j\i" + with \n\_\ + have "j\n" using Ord_trans[of j _ n] by auto + from \i\_\ consider (a) "i=n \ i\n" | (b) "i\n" by auto + then + have " fst(?G`i) \ fst(?G`j)" + proof(cases) + case a + with \j\n\ HI + have "?G`i=" "?G`j=g`j" "g`j\h" + unfolding FiniteFun_iso_def by auto + with \a\_\ \h\_\ + show ?thesis using FiniteFun_fst_type by auto + next + case b + with \i\n\ \j\i\ \j\n\ HI \domain(g) = n\ + show ?thesis unfolding cons_like_def + using mem_not_refl by auto + qed + } + then show ?thesis unfolding cons_like_def by auto + qed + with 1 show ?case by auto +qed + +text\All the representations of \<^term>\f\A-||>B\ are equal.\ +lemma FiniteFun_isoD : + assumes "n\\" "g\n\A\B" "f\A-||>B" "FiniteFun_iso(A,B,n,g,f)" + shows "to_FiniteFun(g) = f" +proof + show "to_FiniteFun(g) \ f" + proof + fix ab + assume "ab\to_FiniteFun(g)" + moreover + note assms + moreover from calculation + obtain i where "i\n" "g`i=ab" "ab\A\B" + unfolding to_FiniteFun_def using domain_of_fun by auto + ultimately + show "ab\f" unfolding FiniteFun_iso_def by auto + qed +next + show "f \ to_FiniteFun(g)" + proof + fix ab + assume "ab\f" + with assms + obtain i where "i\n" "g`i=ab" "ab\A\B" + unfolding FiniteFun_iso_def by auto + with assms + show "ab \ to_FiniteFun(g)" + unfolding to_FiniteFun_def + using domain_of_fun by auto + qed +qed + +lemma to_FiniteFun_succ_eq : + assumes "n\\" "f\succ(n) \ A" + shows "to_FiniteFun(f) = cons(f`n,to_FiniteFun(restrict(f,n)))" + using assms domain_restrict domain_of_fun + unfolding to_FiniteFun_def by auto + +text\If $g \in n\to A\times B$ is \<^term>\cons_like\, then it is a representation of +\<^term>\to_FiniteFun(g)\.\ +lemma FiniteFun_iso_intro_to: + assumes "n\\" "g\n\A\B" "cons_like(g)" + shows "to_FiniteFun(g) \ (A -||> B) \ FiniteFun_iso(A,B,n,g,to_FiniteFun(g))" + using assms +proof(induct n arbitrary:g rule:nat_induct) + case 0 + fix g + assume "g\0\A\B" + then + have "g=0" by simp + then have "to_FiniteFun(g)=0" unfolding to_FiniteFun_def by simp + then show "to_FiniteFun(g) \ (A -||> B) \ FiniteFun_iso(A,B,0,g,to_FiniteFun(g))" + using emptyI unfolding FiniteFun_iso_def by simp +next + case (succ x) + fix g + let ?g'="restrict(g,x)" + assume "g\succ(x)\A\B" "cons_like(g)" + with succ.hyps \g\_\ + have "cons_like(?g')" "?g' \ x\A\B" "g`x\A\B" "domain(g) = succ(x)" + using cons_like_lt succI1 apply_funtype domain_of_fun by simp_all + with succ.hyps \?g'\_\ \x\\\ + have HI: + "to_FiniteFun(?g') \ A -||> B" (is "(?h) \ _") + "FiniteFun_iso(A,B,x,?g',to_FiniteFun(?g'))" + by simp_all + then + have "fst(g`x) \ domain(?h)" + proof - + { + assume "fst(g`x) \ domain(?h)" + with HI \x\_\ + obtain i b + where "i\x" "\?h" "icons_like(g)\ \domain(g) = _\ + have False + unfolding cons_like_def by auto + } + then show ?thesis .. + qed + with HI assms \g`x\_\ + have "cons(g`x,?h) \ A-||>B" (is "?h' \_") using consI by auto + have "FiniteFun_iso(A,B,succ(x),g,?h')" + unfolding FiniteFun_iso_def + proof + { fix i + assume "i\succ(x)" + with \x\_\ consider (a) "i=x"| (b) "i\x\i\x" by auto + then have "g`i\ ?h'" + proof(cases,simp) + case b + with \FiniteFun_iso(_,_,_,?g',?h)\ + show ?thesis unfolding FiniteFun_iso_def by simp + qed + } + then show "\i\succ(x). g ` i \ cons(g ` x, ?h)" .. + next + { + fix ab + assume "ab\?h'" + then consider "ab=g`x" | "ab \ ?h" using cons_iff by auto + then + have "\i \ succ(x) . g`i = ab" unfolding FiniteFun_iso_def + proof(cases,simp) + case 2 + with HI obtain i + where 2:"i\x" "?g'`i=ab" unfolding FiniteFun_iso_def by auto + with \x\_\ + have "i\x" "i\succ(x)" using ltI[OF \i\_\] by auto + with 2 HI show ?thesis by auto + qed + } then show "\ab\cons(g ` x, ?h). \i\succ(x). g ` i = ab" .. + qed + with \?h'\_\ + show "to_FiniteFun(g) \ A -||>B \ FiniteFun_iso(A,B,succ(x),g,to_FiniteFun(g))" + using to_FiniteFun_succ_eq[OF \x\_\ \g\_\,symmetric] by auto +qed + +lemma FiniteFun_iso_intro2: + assumes "n\\" "f\n\A\B" "cons_like(f)" + shows "\ g \ (A -||> B) . FiniteFun_iso(A,B,n,f,g)" + using assms FiniteFun_iso_intro_to by blast + +lemma FiniteFun_eq_range_Repr : + shows "{range(h) . h \ FiniteFun_Repr(A,B) } = {to_FiniteFun(h) . h \ FiniteFun_Repr(A,B) }" + unfolding FiniteFun_Repr_def to_FiniteFun_def seqspace_def + using fun_range_eq + by(intro equalityI subsetI,auto) + + +lemma FiniteFun_eq_to_FiniteFun_Repr : + shows "A-||>B = {to_FiniteFun(h) . h \ FiniteFun_Repr(A,B) } " + (is "?Y=?X") +proof + { + fix f + assume "f\A-||>B" + then obtain n g where + 1: "n\\" "g\n\A\B" "FiniteFun_iso(A,B,n,g,f)" "cons_like(g)" + using FiniteFun_iso_intro1 by blast + with \f\_\ + have "cons_like(g)" "f=to_FiniteFun(g)" "domain(g) = n" "g\FiniteFun_Repr(A,B)" + using FiniteFun_isoD domain_of_fun + unfolding FiniteFun_Repr_def + by auto + with 1 have "f\?X" + by auto + } then show "?Y\?X" .. +next + { + fix f + assume "f\?X" + then obtain g where + A:"g\FiniteFun_Repr(A,B)" "f=to_FiniteFun(g)" "cons_like(g)" + using RepFun_iff unfolding FiniteFun_Repr_def by auto + then obtain n where "n\\" "g\n\A\B" "domain(g) = n" + unfolding FiniteFun_Repr_def using domain_of_fun by force + with A + have "f\?Y" + using FiniteFun_iso_intro_to by simp + } then show "?X\?Y" .. +qed + +lemma FiniteFun_Repr_closed : + assumes "M(A)" "M(B)" + shows "M(FiniteFun_Repr(A,B))" + unfolding FiniteFun_Repr_def + using assms cartprod_closed + seqspace_closed separation_closed cons_like_abs cons_like_separation + by simp + +lemma to_FiniteFun_closed: + assumes "M(A)" "f\A" + shows "M(range(f))" + using assms transM[of _ A] by simp + +lemma To_FiniteFun_Repr_closed : + assumes "M(A)" "M(B)" + shows "M({range(h) . h \ FiniteFun_Repr(A,B) })" + using assms FiniteFun_Repr_closed + RepFun_closed to_finiteFun_replacement + to_FiniteFun_closed[OF FiniteFun_Repr_closed] + by simp + +lemma FiniteFun_closed[intro,simp] : + assumes "M(A)" "M(B)" + shows "M(A -||> B)" + using assms To_FiniteFun_Repr_closed FiniteFun_eq_to_FiniteFun_Repr + FiniteFun_eq_range_Repr + by simp + +end \ \\<^locale>\M_FiniteFun\\ + +end \ No newline at end of file diff --git a/thys/Transitive_Models/Higher_Order_Constructs.thy b/thys/Transitive_Models/Higher_Order_Constructs.thy new file mode 100644 --- /dev/null +++ b/thys/Transitive_Models/Higher_Order_Constructs.thy @@ -0,0 +1,152 @@ +section\Fully relational versions of higher order construct \ +theory Higher_Order_Constructs + imports + Recursion_Thms + Least +begin + +syntax + "_sats" :: "[i, i, i] \ o" ("(_, _ \ _)" [36,36,36] 25) +translations + "(M,env \ \)" \ "CONST sats(M,\,env)" + +definition + is_If :: "[i\o,o,i,i,i] \ o" where + "is_If(M,b,t,f,r) \ (b \ r=t) \ (\b \ r=f)" + +lemma (in M_trans) If_abs: + "is_If(M,b,t,f,r) \ r = If(b,t,f)" + by (simp add: is_If_def) + + +definition + is_If_fm :: "[i,i,i,i] \ i" where + "is_If_fm(\,t,f,r) \ Or(And(\,Equal(t,r)),And(Neg(\),Equal(f,r)))" + +lemma is_If_fm_type [TC]: "\ \ formula \ t \ nat \ f \ nat \ r \ nat \ + is_If_fm(\,t,f,r) \ formula" + unfolding is_If_fm_def by auto + +lemma sats_is_If_fm: + assumes Qsats: "Q \ A, env \ \" "env \ list(A)" + shows "is_If(##A, Q, nth(t, env), nth(f, env), nth(r, env)) \ A, env \ is_If_fm(\,t,f,r)" + using assms unfolding is_If_def is_If_fm_def by auto + +lemma is_If_fm_iff_sats [iff_sats]: + assumes Qsats: "Q \ A, env \ \" and + "nth(t, env) = ta" "nth(f, env) = fa" "nth(r, env) = ra" + "t \ nat" "f \ nat" "r \ nat" "env \ list(A)" + shows "is_If(##A,Q,ta,fa,ra) \ A, env \ is_If_fm(\,t,f,r)" + using assms sats_is_If_fm[of Q A \ env t f r] by simp + +lemma arity_is_If_fm [arity]: + "\ \ formula \ t \ nat \ f \ nat \ r \ nat \ + arity(is_If_fm(\, t, f, r)) = arity(\) \ succ(t) \ succ(r) \ succ(f)" + unfolding is_If_fm_def + by auto + +definition + is_The :: "[i\o,i\o,i] \ o" where + "is_The(M,Q,i) \ (Q(i) \ (\x[M]. Q(x) \ (\y[M]. Q(y) \ y = x))) \ + (\(\x[M]. Q(x) \ (\y[M]. Q(y) \ y = x))) \ empty(M,i) " + +(* +definition + is_The_fm :: "[i,i] \ i" where + "is_The_fm(q,i) \ Or(And(Exists(And(Equal(succ(i),0),q)), + Exists(And(q,Forall(Implies(q,Equal(1,0)))))), + And(Neg(Exists(And(q,Forall(Implies(q,Equal(1,0)))))),empty_fm(i)))" + +(* this doesn't work yet *) +lemma sats_The_fm : + assumes p_iff_sats: + "\a. a \ A \ P(a) \ sats(A, p, Cons(a, env))" + shows + "\y \ nat; env \ list(A) ; 0\A\ + \ sats(A, is_The_fm(p,y), env) \ + is_The(##A, P, nth(y,env))" + using nth_closed p_iff_sats + unfolding is_The_def is_The_fm_def + oops + +lemma The_iff_sats [iff_sats]: + assumes is_Q_iff_sats: + "\a. a \ A \ is_Q(a) \ sats(A, q, Cons(a,env))" + shows + "\nth(j,env) = y; j \ nat; env \ list(A); 0\A\ + \ is_The(##A, is_Q, y) \ sats(A, is_The_fm(q,j), env)" + using sats_The_fm [OF is_Q_iff_sats, of j , symmetric] + by simp +*) + +lemma (in M_trans) The_abs: + assumes "\x. Q(x) \ M(x)" "M(a)" + shows "is_The(M,Q,a) \ a = (THE x. Q(x))" +proof (cases "\x[M]. Q(x) \ (\y[M]. Q(y) \ y = x)") + case True + with assms + show ?thesis + unfolding is_The_def + by (intro iffI the_equality[symmetric]) + (auto, blast intro:theI) +next + case False + with \\x. Q(x) \ M(x)\ + have " \ (\x. Q(x) \ (\y. Q(y) \ y = x))" + by auto + then + have "The(Q) = 0" + by (intro the_0) auto + with assms and False + show ?thesis + unfolding is_The_def + by auto +qed + +(* +definition + recursor :: "[i, [i,i]=>i, i]=>i" where + "recursor(a,b,k) \ transrec(k, \n f. nat_case(a, \m. b(m, f`m), n))" +*) + +definition + is_recursor :: "[i\o,i,[i,i,i]\o,i,i] \o" where + "is_recursor(M,a,is_b,k,r) \ is_transrec(M, \n f ntc. is_nat_case(M,a, + \m bmfm. + \fm[M]. fun_apply(M,f,m,fm) \ is_b(m,fm,bmfm),n,ntc),k,r)" + +lemma (in M_eclose) recursor_abs: + assumes "Ord(k)" and + types: "M(a)" "M(k)" "M(r)" and + b_iff: "\m f bmf. M(m) \ M(f) \ M(bmf) \ is_b(m,f,bmf) \ bmf = b(m,f)" and + b_closed: "\m f bmf. M(m) \ M(f) \ M(b(m,f))" and + repl: "transrec_replacement(M, \n f ntc. is_nat_case(M, a, + \m bmfm. \fm[M]. fun_apply(M, f, m, fm) \ is_b( m, fm, bmfm), n, ntc), k)" + shows + "is_recursor(M,a,is_b,k,r) \ r = recursor(a,b,k)" + unfolding is_recursor_def recursor_def + using assms + apply (rule_tac transrec_abs) + apply (auto simp:relation2_def) + apply (rule nat_case_abs[THEN iffD1, where is_b1="\m bmfm. + \fm[M]. fun_apply(M,_,m,fm) \ is_b(m,fm,bmfm)"]) + apply (auto simp:relation1_def) + apply (rule nat_case_abs[THEN iffD2, where is_b1="\m bmfm. + \fm[M]. fun_apply(M,_,m,fm) \ is_b(m,fm,bmfm)"]) + apply (auto simp:relation1_def) + done + +definition + is_wfrec_on :: "[i=>o,[i,i,i]=>o,i,i,i, i] => o" where + "is_wfrec_on(M,MH,A,r,a,z) == is_wfrec(M,MH,r,a,z)" + +lemma (in M_trancl) trans_wfrec_on_abs: + "[|wf(r); trans(r); relation(r); M(r); M(a); M(z); + wfrec_replacement(M,MH,r); relation2(M,MH,H); + \x[M]. \g[M]. function(g) \ M(H(x,g)); + r-``{a}\A; a \ A|] + ==> is_wfrec_on(M,MH,A,r,a,z) \ z=wfrec[A](r,a,H)" + using trans_wfrec_abs wfrec_trans_restr + unfolding is_wfrec_on_def by simp + +end \ No newline at end of file diff --git a/thys/Transitive_Models/Internalizations.thy b/thys/Transitive_Models/Internalizations.thy new file mode 100644 --- /dev/null +++ b/thys/Transitive_Models/Internalizations.thy @@ -0,0 +1,277 @@ +section\Aids to internalize formulas\ + +theory Internalizations + imports + "ZF-Constructible.DPow_absolute" + Synthetic_Definition + Nat_Miscellanea +begin + +definition + infinity_ax :: "(i \ o) \ o" where + "infinity_ax(M) \ + (\I[M]. (\z[M]. empty(M,z) \ z\I) \ (\y[M]. y\I \ (\sy[M]. successor(M,y,sy) \ sy\I)))" + +definition + wellfounded_trancl :: "[i=>o,i,i,i] => o" where + "wellfounded_trancl(M,Z,r,p) \ + \w[M]. \wx[M]. \rp[M]. + w \ Z & pair(M,w,p,wx) & tran_closure(M,r,rp) & wx \ rp" + +lemma empty_intf : + "infinity_ax(M) \ + (\z[M]. empty(M,z))" + by (auto simp add: empty_def infinity_ax_def) + +lemma Transset_intf : + "Transset(M) \ y\x \ x \ M \ y \ M" + by (simp add: Transset_def,auto) + +definition + choice_ax :: "(i\o) \ o" where + "choice_ax(M) \ \x[M]. \a[M]. \f[M]. ordinal(M,a) \ surjection(M,a,x,f)" + +lemma (in M_basic) choice_ax_abs : + "choice_ax(M) \ (\x[M]. \a[M]. \f[M]. Ord(a) \ f \ surj(a,x))" + unfolding choice_ax_def + by simp + +txt\Setting up notation for internalized formulas\ + +abbreviation + dec10 :: i ("10") where "10 \ succ(9)" +abbreviation + dec11 :: i ("11") where "11 \ succ(10)" +abbreviation + dec12 :: i ("12") where "12 \ succ(11)" +abbreviation + dec13 :: i ("13") where "13 \ succ(12)" +abbreviation + dec14 :: i ("14") where "14 \ succ(13)" +abbreviation + dec15 :: i ("15") where "15 \ succ(14)" +abbreviation + dec16 :: i ("16") where "16 \ succ(15)" +abbreviation + dec17 :: i ("17") where "17 \ succ(16)" +abbreviation + dec18 :: i ("18") where "18 \ succ(17)" +abbreviation + dec19 :: i ("19") where "19 \ succ(18)" +abbreviation + dec20 :: i ("20") where "20 \ succ(19)" +abbreviation + dec21 :: i ("21") where "21 \ succ(20)" +abbreviation + dec22 :: i ("22") where "22 \ succ(21)" +abbreviation + dec23 :: i ("23") where "23 \ succ(22)" +abbreviation + dec24 :: i ("24") where "24 \ succ(23)" +abbreviation + dec25 :: i ("25") where "25 \ succ(24)" +abbreviation + dec26 :: i ("26") where "26 \ succ(25)" +abbreviation + dec27 :: i ("27") where "27 \ succ(26)" +abbreviation + dec28 :: i ("28") where "28 \ succ(27)" +abbreviation + dec29 :: i ("29") where "29 \ succ(28)" + +notation Member (\\_ \/ _\\) +notation Equal (\\_ =/ _\\) +notation Nand (\\\'(_ \/ _')\\) +notation And (\\_ \/ _\\) +notation Or (\\_ \/ _\\) +notation Iff (\\_ \/ _\\) +notation Implies (\\_ \/ _\\) +notation Neg (\\\_\\) +notation Forall (\'(\\(/_)\')\) +notation Exists (\'(\\(/_)\')\) + +notation subset_fm (\\_ \/ _\\) +notation succ_fm (\\succ'(_') is _\\) +notation empty_fm (\\_ is empty\\) +notation fun_apply_fm (\\_`_ is _\\) +notation big_union_fm (\\\_ is _\\) +notation upair_fm (\\{_,_} is _ \\) +notation ordinal_fm (\\_ is ordinal\\) + + +notation pair_fm (\\\_,_\ is _ \\) +notation composition_fm (\\_ \ _ is _ \\) +notation domain_fm (\\dom'(_') is _ \\) +notation range_fm (\\ran'(_') is _ \\) +notation union_fm (\\_ \ _ is _ \\) +notation image_fm (\\_ `` _ is _ \\) +notation pre_image_fm (\\_ -`` _ is _ \\) +notation field_fm (\\fld'(_') is _ \\) +notation cons_fm (\\cons'(_,_') is _ \\) +notation number1_fm (\\_ is the number one\\) +notation function_fm (\\_ is funct\\) +notation relation_fm (\\_ is relat\\) +notation restriction_fm (\\_ \ _ is _ \\) +notation transset_fm (\\_ is transitive\\) +notation limit_ordinal_fm (\\_ is limit\\) +notation finite_ordinal_fm (\\_ is finite ord\\) +notation omega_fm (\\_ is \\\) +notation cartprod_fm (\\_ \ _ is _\\) +notation Memrel_fm (\\Memrel'(_') is _\\) +notation quasinat_fm (\\_ is qnat\\) + (* notation rtran_closure_mem_fm (\\{_,_} is _ \\) +notation rtran_closure_fm (\\{_,_} is _ \\) +notation tran_closure_fm (\\_ is \\) +notation order_isomorphism_fm (\\{_,_} is _ \\) *) +notation Inl_fm (\\Inl'(_') is _ \\) +notation Inr_fm (\\Inr'(_') is _ \\) +notation pred_set_fm (\\_-predecessors of _ are _\\) + + +abbreviation + fm_typedfun :: "[i,i,i] \ i" (\\_ : _ \ _\\) where + "fm_typedfun(f,A,B) \ typed_function_fm(A,B,f)" + +abbreviation + fm_surjection :: "[i,i,i] \ i" (\\_ surjects _ to _\\) where + "fm_surjection(f,A,B) \ surjection_fm(A,B,f)" + +abbreviation + fm_injection :: "[i,i,i] \ i" (\\_ injects _ to _\\) where + "fm_injection(f,A,B) \ injection_fm(A,B,f)" + +abbreviation + fm_bijection :: "[i,i,i] \ i" (\\_ bijects _ to _\\) where + "fm_bijection(f,A,B) \ bijection_fm(A,B,f)" + +text\We found it useful to have slightly different versions of some +results in ZF-Constructible:\ +lemma nth_closed : + assumes "env\list(A)" "0\A" + shows "nth(n,env)\A" + using assms unfolding nth_def by (induct env; simp) + +lemma conj_setclass_model_iff_sats [iff_sats]: + "[| 0 \ A; nth(i,env) = x; env \ list(A); + P \ sats(A,p,env); env \ list(A) |] + ==> (P \ (##A)(x)) \ sats(A, p, env)" + "[| 0 \ A; nth(i,env) = x; env \ list(A); + P \ sats(A,p,env); env \ list(A) |] + ==> ((##A)(x) \ P) \ sats(A, p, env)" + using nth_closed[of env A i] + by auto + +lemma conj_mem_model_iff_sats [iff_sats]: + "[| 0 \ A; nth(i,env) = x; env \ list(A); + P \ sats(A,p,env); env \ list(A) |] + ==> (P \ x \ A) \ sats(A, p, env)" + "[| 0 \ A; nth(i,env) = x; env \ list(A); + P \ sats(A,p,env); env \ list(A) |] + ==> (x \ A \ P) \ sats(A, p, env)" + using nth_closed[of env A i] + by auto + +(* lemma [iff_sats]: + "[| 0 \ A; nth(i,env) = x; env \ list(A); + P \ sats(A,p,env); env \ list(A) |] + ==> (x \ A \ P) \ sats(A, p, env)" + "[| 0 \ A; nth(i,env) = x; env \ list(A); + P \ sats(A,p,env); env \ list(A) |] + ==> (P \ x \ A) \ sats(A, p, env)" + + "[| 0 \ A; nth(i,env) = x; env \ list(A); + P \ sats(A,p,env); env \ list(A) |] + ==> (x \ A \ P) \ sats(A, p, env)" + + using nth_closed[of env A i] + by auto *) + +lemma mem_model_iff_sats [iff_sats]: + "[| 0 \ A; nth(i,env) = x; env \ list(A)|] + ==> (x\A) \ sats(A, Exists(Equal(0,0)), env)" + using nth_closed[of env A i] + by auto + +lemma subset_iff_sats[iff_sats]: + "nth(i, env) = x \ nth(j, env) = y \ i\nat \ j\nat \ + env \ list(A) \ subset(##A, x, y) \ sats(A, subset_fm(i, j), env)" + using sats_subset_fm' by simp + +lemma not_mem_model_iff_sats [iff_sats]: + "[| 0 \ A; nth(i,env) = x; env \ list(A)|] + ==> (\ x . x \ A) \ sats(A, Neg(Exists(Equal(0,0))), env)" + by auto + +lemma top_iff_sats [iff_sats]: + "env \ list(A) \ 0 \ A \ sats(A, Exists(Equal(0,0)), env)" + by auto + +lemma prefix1_iff_sats[iff_sats]: + assumes + "x \ nat" "env \ list(A)" "0 \ A" "a \ A" + shows + "a = nth(x,env) \ sats(A, Equal(0,x+\<^sub>\1), Cons(a,env))" + "nth(x,env) = a \ sats(A, Equal(x+\<^sub>\1,0), Cons(a,env))" + "a \ nth(x,env) \ sats(A, Member(0,x+\<^sub>\1), Cons(a,env))" + "nth(x,env) \ a \ sats(A, Member(x+\<^sub>\1,0), Cons(a,env))" + using assms nth_closed + by simp_all + +lemma prefix2_iff_sats[iff_sats]: + assumes + "x \ nat" "env \ list(A)" "0 \ A" "a \ A" "b \ A" + shows + "b = nth(x,env) \ sats(A, Equal(1,x+\<^sub>\2), Cons(a,Cons(b,env)))" + "nth(x,env) = b \ sats(A, Equal(x+\<^sub>\2,1), Cons(a,Cons(b,env)))" + "b \ nth(x,env) \ sats(A, Member(1,x+\<^sub>\2), Cons(a,Cons(b,env)))" + "nth(x,env) \ b \ sats(A, Member(x+\<^sub>\2,1), Cons(a,Cons(b,env)))" + using assms nth_closed + by simp_all + +lemma prefix3_iff_sats[iff_sats]: + assumes + "x \ nat" "env \ list(A)" "0 \ A" "a \ A" "b \ A" "c \ A" + shows + "c = nth(x,env) \ sats(A, Equal(2,x+\<^sub>\3), Cons(a,Cons(b,Cons(c,env))))" + "nth(x,env) = c \ sats(A, Equal(x+\<^sub>\3,2), Cons(a,Cons(b,Cons(c,env))))" + "c \ nth(x,env) \ sats(A, Member(2,x+\<^sub>\3), Cons(a,Cons(b,Cons(c,env))))" + "nth(x,env) \ c \ sats(A, Member(x+\<^sub>\3,2), Cons(a,Cons(b,Cons(c,env))))" + using assms nth_closed + by simp_all + +lemmas FOL_sats_iff = sats_Nand_iff sats_Forall_iff sats_Neg_iff sats_And_iff + sats_Or_iff sats_Implies_iff sats_Iff_iff sats_Exists_iff + +lemma nth_ConsI: "\nth(n,l) = x; n \ nat\ \ nth(succ(n), Cons(a,l)) = x" + by simp + +lemmas nth_rules = nth_0 nth_ConsI nat_0I nat_succI +lemmas sep_rules = nth_0 nth_ConsI FOL_iff_sats function_iff_sats + fun_plus_iff_sats successor_iff_sats + omega_iff_sats FOL_sats_iff Replace_iff_sats + +text\Also a different compilation of lemmas (term\sep_rules\) used in formula + synthesis\ +lemmas fm_defs = + omega_fm_def limit_ordinal_fm_def empty_fm_def typed_function_fm_def + pair_fm_def upair_fm_def domain_fm_def function_fm_def succ_fm_def + cons_fm_def fun_apply_fm_def image_fm_def big_union_fm_def union_fm_def + relation_fm_def composition_fm_def field_fm_def ordinal_fm_def range_fm_def + transset_fm_def subset_fm_def Replace_fm_def + +lemmas formulas_def [fm_definitions] = fm_defs + is_iterates_fm_def iterates_MH_fm_def is_wfrec_fm_def is_recfun_fm_def is_transrec_fm_def + is_nat_case_fm_def quasinat_fm_def number1_fm_def ordinal_fm_def finite_ordinal_fm_def + cartprod_fm_def sum_fm_def Inr_fm_def Inl_fm_def + formula_functor_fm_def + Memrel_fm_def transset_fm_def subset_fm_def pre_image_fm_def restriction_fm_def + list_functor_fm_def tl_fm_def quasilist_fm_def Cons_fm_def Nil_fm_def + +lemmas sep_rules' [iff_sats] = nth_0 nth_ConsI FOL_iff_sats function_iff_sats + fun_plus_iff_sats omega_iff_sats + +lemmas more_iff_sats [iff_sats] = rtran_closure_iff_sats tran_closure_iff_sats + is_eclose_iff_sats Inl_iff_sats Inr_iff_sats fun_apply_iff_sats cartprod_iff_sats + Collect_iff_sats + +end \ No newline at end of file diff --git a/thys/Transitive_Models/Lambda_Replacement.thy b/thys/Transitive_Models/Lambda_Replacement.thy new file mode 100644 --- /dev/null +++ b/thys/Transitive_Models/Lambda_Replacement.thy @@ -0,0 +1,2128 @@ +section\Replacements using Lambdas\ + +theory Lambda_Replacement + imports + Discipline_Function +begin + +text\In this theory we prove several instances of separation and replacement +in @{locale M_basic}. Moreover we introduce a new locale assuming two instances +of separation and twelve instances of lambda replacements (ie, replacement of +the form $\lambda x y. y=\langle x, f(x) \rangle$) we prove a bunch of other +instances.\ + + +definition + lam_replacement :: "[i\o,i\i] \ o" where + "lam_replacement(M,b) \ strong_replacement(M, \x y. y = \x, b(x)\)" + +lemma separation_univ : + shows "separation(M,M)" + unfolding separation_def by auto + +context M_basic +begin + +lemma separation_iff': + assumes "separation(M,\x . P(x))" "separation(M,\x . Q(x))" + shows "separation(M,\x . P(x) \ Q(x))" + using assms separation_conj separation_imp iff_def + by auto + +lemma separation_in_constant : + assumes "M(a)" + shows "separation(M,\x . x\a)" +proof - + have "{x\A . x\a} = A \ a" for A by auto + with \M(a)\ + show ?thesis using separation_iff Collect_abs + by simp +qed + +lemma separation_equal : + shows "separation(M,\x . x=a)" +proof - + have "{x\A . x=a} = (if a\A then {a} else 0)" for A + by auto + then + have "M({x\A . x=a})" if "M(A)" for A + using transM[OF _ \M(A)\] by simp + then + show ?thesis using separation_iff Collect_abs + by simp +qed + +lemma (in M_basic) separation_in_rev: + assumes "(M)(a)" + shows "separation(M,\x . a\x)" +proof - + have eq: "{x\A. a\x} = Memrel(A\{a}) `` {a}" for A + unfolding ZF_Base.image_def + by(intro equalityI,auto simp:mem_not_refl) + moreover from assms + have "M(Memrel(A\{a}) `` {a})" if "M(A)" for A + using that by simp + ultimately + show ?thesis + using separation_iff Collect_abs + by simp +qed + +lemma lam_replacement_iff_lam_closed: + assumes "\x[M]. M(b(x))" + shows "lam_replacement(M, b) \ (\A[M]. M(\x\A. b(x)))" + using assms lam_closed lam_funtype[of _ b, THEN Pi_memberD] + unfolding lam_replacement_def strong_replacement_def + by (auto intro:lamI dest:transM) + (rule lam_closed, auto simp add:strong_replacement_def dest:transM) + +lemma lam_replacement_imp_lam_closed: + assumes "lam_replacement(M, b)" "M(A)" "\x\A. M(b(x))" + shows "M(\x\A. b(x))" + using assms unfolding lam_replacement_def + by (rule_tac lam_closed, auto simp add:strong_replacement_def dest:transM) + +lemma lam_replacement_cong: + assumes "lam_replacement(M,f)" "\x[M]. f(x) = g(x)" "\x[M]. M(f(x))" + shows "lam_replacement(M,g)" +proof - + note assms + moreover from this + have "\A[M]. M(\x\A. f(x))" + using lam_replacement_iff_lam_closed + by simp + moreover from calculation + have "(\x\A . f(x)) = (\x\A . g(x))" if "M(A)" for A + using lam_cong[OF refl,of A f g] transM[OF _ that] + by simp + ultimately + show ?thesis + using lam_replacement_iff_lam_closed + by simp +qed + +lemma converse_subset : "converse(r) \ {\snd(x),fst(x)\ . x\r}" + unfolding converse_def +proof(intro subsetI, auto) + fix u v + assume "\u,v\\r" (is "?z\r") + moreover + have "v=snd(?z)" "u=fst(?z)" by simp_all + ultimately + show "\z\r. v=snd(z) \ u = fst(z)" + using rexI[where x="\u,v\"] by force +qed + +lemma converse_eq_aux : + assumes "<0,0>\r" + shows "converse(r) = {\snd(x),fst(x)\ . x\r}" + using converse_subset +proof(intro equalityI subsetI,auto) + fix z + assume "z\r" + then show "\fst(z),snd(z)\ \ r" + proof(cases "\ a b . z =\a,b\") + case True + with \z\r\ + show ?thesis by auto + next + case False + then + have "fst(z) = 0" "snd(z)=0" + unfolding fst_def snd_def by auto + with \z\r\ assms + show ?thesis by auto + qed +qed + +lemma converse_eq_aux' : + assumes "<0,0>\r" + shows "converse(r) = {\snd(x),fst(x)\ . x\r} - {<0,0>}" + using converse_subset assms +proof(intro equalityI subsetI,auto) + fix z + assume "z\r" "snd(z)\0" + then + obtain a b where "z = \a,b\" unfolding snd_def by force + with \z\r\ + show "\fst(z),snd(z)\ \ r" + by auto +next + fix z + assume "z\r" "fst(z)\0" + then + obtain a b where "z = \a,b\" unfolding fst_def by force + with \z\r\ + show "\fst(z),snd(z)\ \ r" + by auto +qed + +lemma diff_un : "b\a \ (a-b) \ b = a" + by auto + +lemma converse_eq: "converse(r) = ({\snd(x),fst(x)\ . x\r} - {<0,0>}) \ (r\{<0,0>})" +proof(cases "<0,0>\r") + case True + then + have "converse(r) = {\snd(x),fst(x)\ . x\r}" + using converse_eq_aux by auto + moreover + from True + have "r\{<0,0>} = {<0,0>}" "{<0,0>}\{\snd(x),fst(x)\ . x\r}" + using converse_subset by auto + moreover from this True + have "{\snd(x),fst(x)\ . x\r} = ({\snd(x),fst(x)\ . x\r} - {<0,0>}) \ ({<0,0>})" + using diff_un[of "{<0,0>}",symmetric] converse_eq_aux by auto + ultimately + show ?thesis + by simp +next + case False + then + have "r\{<0,0>} = 0" by auto + then + have "({\snd(x),fst(x)\ . x\r} - {<0,0>}) \ (r\{<0,0>}) = ({\snd(x),fst(x)\ . x\r} - {<0,0>})" + by simp + with False + show ?thesis + using converse_eq_aux' by auto +qed + +lemma range_subset : "range(r) \ {snd(x). x\r}" + unfolding range_def domain_def converse_def +proof(intro subsetI, auto) + fix u v + assume "\u,v\\r" (is "?z\r") + moreover + have "v=snd(?z)" "u=fst(?z)" by simp_all + ultimately + show "\z\r. v=snd(z)" + using rexI[where x="v"] by force +qed + +lemma lam_replacement_imp_strong_replacement_aux: + assumes "lam_replacement(M, b)" "\x[M]. M(b(x))" + shows "strong_replacement(M, \x y. y = b(x))" +proof - + { + fix A + note assms + moreover + assume "M(A)" + moreover from calculation + have "M(\x\A. b(x))" using lam_replacement_iff_lam_closed by auto + ultimately + have "M((\x\A. b(x))``A)" "\z[M]. z \ (\x\A. b(x))``A \ (\x\A. z = b(x))" + by (auto simp:lam_def) + } + then + show ?thesis unfolding strong_replacement_def + by clarsimp (rule_tac x="(\x\A. b(x))``A" in rexI, auto) +qed + +lemma lam_replacement_imp_RepFun_Lam: + assumes "lam_replacement(M, f)" "M(A)" + shows "M({y . x\A , M(y) \ y=\x,f(x)\})" +proof - + from assms + obtain Y where 1:"M(Y)" "\b[M]. b \ Y \ (\x[M]. x \ A \ b = \x,f(x)\)" + unfolding lam_replacement_def strong_replacement_def + by auto + moreover from calculation + have "Y = {y . x\A , M(y) \ y = \x,f(x)\}" (is "Y=?R") + proof(intro equalityI subsetI) + fix y + assume "y\Y" + moreover from this 1 + obtain x where "x\A" "y=\x,f(x)\" "M(y)" + using transM[OF _ \M(Y)\] by auto + ultimately + show "y\?R" + by auto + next + fix z + assume "z\?R" + moreover from this + obtain a where "a\A" "z=\a,f(a)\" "M(a)" "M(f(a))" + using transM[OF _ \M(A)\] + by auto + ultimately + show "z\Y" using 1 by simp + qed + ultimately + show ?thesis by auto +qed + +lemma lam_closed_imp_closed: + assumes "\A[M]. M(\x\A. f(x))" + shows "\x[M]. M(f(x))" +proof + fix x + assume "M(x)" + moreover from this and assms + have "M(\x\{x}. f(x))" by simp + ultimately + show "M(f(x))" + using image_lam[of "{x}" "{x}" f] + image_closed[of "{x}" "(\x\{x}. f(x))"] by (auto dest:transM) +qed + +lemma lam_replacement_if: + assumes "lam_replacement(M,f)" "lam_replacement(M,g)" "separation(M,b)" + "\x[M]. M(f(x))" "\x[M]. M(g(x))" + shows "lam_replacement(M, \x. if b(x) then f(x) else g(x))" +proof - + let ?G="\x. if b(x) then f(x) else g(x)" + let ?b="\A . {x\A. b(x)}" and ?b'="\A . {x\A. \b(x)}" + have eq:"(\x\A . ?G(x)) = (\x\?b(A) . f(x)) \ (\x\?b'(A).g(x))" for A + unfolding lam_def by auto + have "?b'(A) = A - ?b(A)" for A by auto + moreover + have "M(?b(A))" if "M(A)" for A using assms that by simp + moreover from calculation + have "M(?b'(A))" if "M(A)" for A using that by simp + moreover from calculation assms + have "M(\x\?b(A). f(x))" "M(\x\?b'(A) . g(x))" if "M(A)" for A + using lam_replacement_iff_lam_closed that + by simp_all + moreover from this + have "M((\x\?b(A) . f(x)) \ (\x\?b'(A).g(x)))" if "M(A)" for A + using that by simp + ultimately + have "M(\x\A. if b(x) then f(x) else g(x))" if "M(A)" for A + using that eq by simp + with assms + show ?thesis using lam_replacement_iff_lam_closed by simp +qed + +lemma lam_replacement_constant: "M(b) \ lam_replacement(M,\_. b)" + unfolding lam_replacement_def strong_replacement_def + by safe (rule_tac x="_\{b}" in rexI; blast) + +subsection\Replacement instances obtained through Powerset\ + +txt\The next few lemmas provide bounds for certain constructions.\ + +lemma not_functional_Replace_0: + assumes "\(\y y'. P(y) \ P(y') \ y=y')" + shows "{y . x \ A, P(y)} = 0" + using assms by (blast elim!: ReplaceE) + +lemma Replace_in_Pow_rel: + assumes "\x b. x \ A \ P(x,b) \ b \ U" "\x\A. \y y'. P(x,y) \ P(x,y') \ y=y'" + "separation(M, \y. \x[M]. x \ A \ P(x, y))" + "M(U)" "M(A)" + shows "{y . x \ A, P(x, y)} \ Pow\<^bsup>M\<^esup>(U)" +proof - + from assms + have "{y . x \ A, P(x, y)} \ U" + "z \ {y . x \ A, P(x, y)} \ M(z)" for z + by (auto dest:transM) + with assms + have "{y . x \ A, P(x, y)} = {y\U . \x[M]. x\A \ P(x,y)}" + by (intro equalityI) (auto, blast) + with assms + have "M({y . x \ A, P(x, y)})" + by simp + with assms + show ?thesis + using mem_Pow_rel_abs by auto +qed + +lemma Replace_sing_0_in_Pow_rel: + assumes "\b. P(b) \ b \ U" + "separation(M, \y. P(y))" "M(U)" + shows "{y . x \ {0}, P(y)} \ Pow\<^bsup>M\<^esup>(U)" +proof (cases "\y y'. P(y) \ P(y') \ y=y'") + case True + with assms + show ?thesis by (rule_tac Replace_in_Pow_rel) auto +next + case False + with assms + show ?thesis + using nonempty not_functional_Replace_0[of P "{0}"] Pow_rel_char by auto +qed + +lemma The_in_Pow_rel_Union: + assumes "\b. P(b) \ b \ U" "separation(M, \y. P(y))" "M(U)" + shows "(THE i. P(i)) \ Pow\<^bsup>M\<^esup>(\U)" +proof - + note assms + moreover from this + have "(THE i. P(i)) \ Pow(\U)" + unfolding the_def by auto + moreover from assms + have "M(THE i. P(i))" + using Replace_sing_0_in_Pow_rel[of P U] unfolding the_def + by (auto dest:transM) + ultimately + show ?thesis + using Pow_rel_char by auto +qed + +lemma separation_least: "separation(M, \y. Ord(y) \ P(y) \ (\j. j < y \ \ P(j)))" + unfolding separation_def +proof + fix z + assume "M(z)" + have "M({x \ z . x \ z \ Ord(x) \ P(x) \ (\j. j < x \ \ P(j))})" + (is "M(?y)") + proof (cases "\x\z. Ord(x) \ P(x) \ (\j. j < x \ \ P(j))") + case True + with \M(z)\ + have "\x[M]. ?y = {x}" + by (safe, rename_tac x, rule_tac x=x in rexI) + (auto dest:transM, intro equalityI, auto elim:Ord_linear_lt) + then + show ?thesis + by auto + next + case False + then + have "{x \ z . x \ z \ Ord(x) \ P(x) \ (\j. j < x \ \ P(j))} = 0" + by auto + then + show ?thesis by auto + qed + moreover from this + have "\x[M]. x \ ?y \ x \ z \ Ord(x) \ P(x) \ (\j. j < x \ \ P(j))" by simp + ultimately + show "\y[M]. \x[M]. x \ y \ x \ z \ Ord(x) \ P(x) \ (\j. j < x \ \ P(j))" + by blast +qed + +lemma Least_in_Pow_rel_Union: + assumes "\b. P(b) \ b \ U" + "M(U)" + shows "(\ i. P(i)) \ Pow\<^bsup>M\<^esup>(\U)" + using assms separation_least unfolding Least_def + by (rule_tac The_in_Pow_rel_Union) simp + +lemma bounded_lam_replacement: + fixes U + assumes "\X[M]. \x\X. f(x) \ U(X)" + and separation_f:"\A[M]. separation(M,\y. \x[M]. x\A \ y = \x, f(x)\)" + and U_closed [intro,simp]: "\X. M(X) \ M(U(X))" + shows "lam_replacement(M, f)" +proof - + have "M(\x\A. f(x))" if "M(A)" for A + proof - + have "(\x\A. f(x)) = {y\ Pow\<^bsup>M\<^esup>(Pow\<^bsup>M\<^esup>(A \ U(A))). \x[M]. x\A \ y = \x, f(x)\}" + using \M(A)\ unfolding lam_def + proof (intro equalityI, auto) + fix x + assume "x\A" + moreover + note \M(A)\ + moreover from calculation assms + have "f(x) \ U(A)" by simp + moreover from calculation + have "{x, f(x)} \ Pow\<^bsup>M\<^esup>(A \ U(A))" "{x,x} \ Pow\<^bsup>M\<^esup>(A \ U(A))" + using Pow_rel_char[of "A \ U(A)"] by (auto dest:transM) + ultimately + show "\x, f(x)\ \ Pow\<^bsup>M\<^esup>(Pow\<^bsup>M\<^esup>(A \ U(A)))" + using Pow_rel_char[of "Pow\<^bsup>M\<^esup>(A \ U(A))"] unfolding Pair_def + by (auto dest:transM) + qed + moreover from \M(A)\ + have "M({y\ Pow\<^bsup>M\<^esup>(Pow\<^bsup>M\<^esup>(A \ U(A))). \x[M]. x\A \ y = \x, f(x)\})" + using separation_f + by (rule_tac separation_closed) simp_all + ultimately + show ?thesis + by simp + qed + moreover from this + have "\x[M]. M(f(x))" + using lam_closed_imp_closed by simp + ultimately + show ?thesis + using assms + by (rule_tac lam_replacement_iff_lam_closed[THEN iffD2]) simp_all +qed + +lemma lam_replacement_domain': + assumes "\A[M]. separation(M, \y. \x\A. y = \x, domain(x)\)" + shows "lam_replacement(M,domain)" +proof - + have "\x\X. domain(x) \ Pow\<^bsup>M\<^esup>(\\\X)" if "M(X)" for X + proof + fix x + assume "x\X" + moreover + note \M(X)\ + moreover from calculation + have "M(x)" by (auto dest:transM) + ultimately + show "domain(x) \ Pow\<^bsup>M\<^esup>(\\\X)" + by(rule_tac mem_Pow_rel_abs[of "domain(x)" "\\\X",THEN iffD2],auto simp:Pair_def,force) + qed + with assms + show ?thesis + using bounded_lam_replacement[of domain "\X. Pow\<^bsup>M\<^esup>(\\\X)"] by simp +qed + +\ \Below we assume the replacement instance for @{term fst}. Alternatively it follows from the +instance of separation assumed in this lemma.\ +lemma lam_replacement_fst': + assumes "\A[M]. separation(M, \y. \x\A. y = \x, fst(x)\)" + shows "lam_replacement(M,fst)" +proof - + have "\x\X. fst(x) \ {0} \ \\X" if "M(X)" for X + proof + fix x + assume "x\X" + moreover + note \M(X)\ + moreover from calculation + have "M(x)" by (auto dest:transM) + ultimately + show "fst(x) \ {0} \ \\X" unfolding fst_def Pair_def + by (auto, rule_tac [1] the_0) force\ \tricky! And slow. It doesn't work for \<^term>\snd\\ + qed + with assms + show ?thesis + using bounded_lam_replacement[of fst "\X. {0} \ \\X"] by simp +qed + +lemma lam_replacement_restrict: + assumes "\A[M]. separation(M, \y. \x\A. y = \x, restrict(x,B)\)" "M(B)" + shows "lam_replacement(M, \r . restrict(r,B))" +proof - + have "\r\R. restrict(r,B)\Pow\<^bsup>M\<^esup>(\R)" if "M(R)" for R + proof - + { + fix r + assume "r\R" + with \M(B)\ + have "restrict(r,B)\Pow(\R)" "M(restrict(r,B))" + using Union_upper subset_Pow_Union subset_trans[OF restrict_subset] + transM[OF _ \M(R)\] + by simp_all + } then show ?thesis + using Pow_rel_char that by simp + qed + with assms + show ?thesis + using bounded_lam_replacement[of "\r . restrict(r,B)" "\X. Pow\<^bsup>M\<^esup>(\X)"] + by simp +qed + +end \ \\<^locale>\M_basic\\ + +locale M_replacement = M_basic + + assumes + lam_replacement_domain: "lam_replacement(M,domain)" + and + lam_replacement_fst: "lam_replacement(M,fst)" + and + lam_replacement_snd: "lam_replacement(M,snd)" + and + lam_replacement_Union: "lam_replacement(M,Union)" + and + middle_del_replacement: "strong_replacement(M, \x y. y=\fst(fst(x)),snd(snd(x))\)" + and + product_replacement: + "strong_replacement(M, \x y. y=\snd(fst(x)),\fst(fst(x)),snd(snd(x))\\)" + and + lam_replacement_Upair:"lam_replacement(M, \p. Upair(fst(p),snd(p)))" + and + lam_replacement_Diff:"lam_replacement(M, \p. fst(p) - snd(p))" + and + lam_replacement_Image:"lam_replacement(M, \p. fst(p) `` snd(p))" + and + middle_separation: "separation(M, \x. snd(fst(x))=fst(snd(x)))" + and + separation_fst_in_snd: "separation(M, \y. fst(snd(y)) \ snd(snd(y)))" + and + lam_replacement_converse : "lam_replacement(M,converse)" + and + lam_replacement_comp: "lam_replacement(M, \x. fst(x) O snd(x))" +begin + +lemma lam_replacement_imp_strong_replacement: + assumes "lam_replacement(M, f)" + shows "strong_replacement(M, \x y. y = f(x))" +proof - + { + fix A + assume "M(A)" + moreover from calculation assms + obtain Y where 1:"M(Y)" "\b[M]. b \ Y \ (\x[M]. x \ A \ b = \x,f(x)\)" + unfolding lam_replacement_def strong_replacement_def + by auto + moreover from this + have "M({snd(b) . b \ Y})" + using transM[OF _ \M(Y)\] lam_replacement_snd lam_replacement_imp_strong_replacement_aux + RepFun_closed by simp + moreover + have "{snd(b) . b \ Y} = {y . x\A , M(f(x)) \ y=f(x)}" (is "?L=?R") + proof(intro equalityI subsetI) + fix x + assume "x\?L" + moreover from this + obtain b where "b\Y" "x=snd(b)" "M(b)" + using transM[OF _ \M(Y)\] by auto + moreover from this 1 + obtain a where "a\A" "b=\a,f(a)\" by auto + moreover from calculation + have "x=f(a)" by simp + ultimately show "x\?R" + by auto + next + fix z + assume "z\?R" + moreover from this + obtain a where "a\A" "z=f(a)" "M(a)" "M(f(a))" + using transM[OF _ \M(A)\] + by auto + moreover from calculation this 1 + have "z=snd(\a,f(a)\)" "\a,f(a)\ \ Y" by auto + ultimately + show "z\?L" by force + qed + ultimately + have "\Z[M]. \z[M]. z\Z \ (\a[M]. a\A \ z=f(a))" + by (rule_tac rexI[where x="{snd(b) . b \ Y}"],auto) + } + then + show ?thesis unfolding strong_replacement_def by simp +qed + +lemma Collect_middle: "{p \ (\x\A. f(x)) \ (\x\{f(x) . x\A}. g(x)) . snd(fst(p))=fst(snd(p))} + = { \\x,f(x)\,\f(x),g(f(x))\\ . x\A }" + by (intro equalityI; auto simp:lam_def) + +lemma RepFun_middle_del: "{ \fst(fst(p)),snd(snd(p))\ . p \ { \\x,f(x)\,\f(x),g(f(x))\\ . x\A }} + = { \x,g(f(x))\ . x\A }" + by auto + +lemma lam_replacement_imp_RepFun: + assumes "lam_replacement(M, f)" "M(A)" + shows "M({y . x\A , M(y) \ y=f(x)})" +proof - + from assms + obtain Y where 1:"M(Y)" "\b[M]. b \ Y \ (\x[M]. x \ A \ b = \x,f(x)\)" + unfolding lam_replacement_def strong_replacement_def + by auto + moreover from this + have "M({snd(b) . b \ Y})" + using transM[OF _ \M(Y)\] lam_replacement_snd lam_replacement_imp_strong_replacement_aux + RepFun_closed by simp + moreover + have "{snd(b) . b \ Y} = {y . x\A , M(y) \ y=f(x)}" (is "?L=?R") + proof(intro equalityI subsetI) + fix x + assume "x\?L" + moreover from this + obtain b where "b\Y" "x=snd(b)" "M(b)" + using transM[OF _ \M(Y)\] by auto + moreover from this 1 + obtain a where "a\A" "b=\a,f(a)\" by auto + moreover from calculation + have "x=f(a)" by simp + ultimately show "x\?R" + by auto + next + fix z + assume "z\?R" + moreover from this + obtain a where "a\A" "z=f(a)" "M(a)" "M(f(a))" + using transM[OF _ \M(A)\] + by auto + moreover from calculation this 1 + have "z=snd(\a,f(a)\)" "\a,f(a)\ \ Y" by auto + ultimately + show "z\?L" by force + qed + ultimately + show ?thesis by simp +qed + +lemma lam_replacement_product: + assumes "lam_replacement(M,f)" "lam_replacement(M,g)" + shows "lam_replacement(M, \x. \f(x),g(x)\)" +proof - + { + fix A + let ?Y="{y . x\A , M(y) \ y=f(x)}" + let ?Y'="{y . x\A ,M(y) \ y=\x,f(x)\}" + let ?Z="{y . x\A , M(y) \ y=g(x)}" + let ?Z'="{y . x\A ,M(y) \ y=\x,g(x)\}" + have "x\C \ y\C \ fst(x) = fst(y) \ M(fst(y)) \ M(snd(x)) \ M(snd(y))" if "M(C)" for C y x + using transM[OF _ that] by auto + moreover + note assms + moreover + assume "M(A)" + moreover from \M(A)\ assms(1) + have "M(converse(?Y'))" "M(?Y)" + using lam_replacement_imp_RepFun_Lam lam_replacement_imp_RepFun by auto + moreover from calculation + have "M(?Z)" "M(?Z')" + using lam_replacement_imp_RepFun_Lam lam_replacement_imp_RepFun by auto + moreover from calculation + have "M(converse(?Y')\?Z')" + by simp + moreover from this + have "M({p \ converse(?Y')\?Z' . snd(fst(p))=fst(snd(p))})" (is "M(?P)") + using middle_separation by simp + moreover from calculation + have "M({ \snd(fst(p)),\fst(fst(p)),snd(snd(p))\\ . p\?P })" (is "M(?R)") + using RepFun_closed[OF product_replacement \M(?P)\ ] by simp + ultimately + have "b \ ?R \ (\x[M]. x \ A \ b = \x,\f(x),g(x)\\)" if "M(b)" for b + using that + apply(intro iffI)apply(auto)[1] + proof - + assume " \x[M]. x \ A \ b = \x, f(x), g(x)\" + moreover from this + obtain x where "M(x)" "x\A" "b= \x, \f(x), g(x)\\" + by auto + moreover from calculation that + have "M(\x,f(x)\)" "M(\x,g(x)\)" by auto + moreover from calculation + have "\f(x),x\ \ converse(?Y')" "\x,g(x)\ \ ?Z'" by auto + moreover from calculation + have "\\f(x),x\,\x,g(x)\\\converse(?Y')\?Z'" by auto + moreover from calculation + have "\\f(x),x\,\x,g(x)\\ \ ?P" + (is "?p\?P") + by auto + moreover from calculation + have "b = \snd(fst(?p)),\fst(fst(?p)),snd(snd(?p))\\" by auto + moreover from calculation + have "\snd(fst(?p)),\fst(fst(?p)),snd(snd(?p))\\\?R" + by(rule_tac RepFunI[of ?p ?P], simp) + ultimately show "b\?R" by simp + qed + with \M(?R)\ + have "\Y[M]. \b[M]. b \ Y \ (\x[M]. x \ A \ b = \x,\f(x),g(x)\\)" + by (rule_tac rexI[where x="?R"],simp_all) + } + with assms + show ?thesis using lam_replacement_def strong_replacement_def by simp +qed + +lemma lam_replacement_hcomp: + assumes "lam_replacement(M,f)" "lam_replacement(M,g)" "\x[M]. M(f(x))" + shows "lam_replacement(M, \x. g(f(x)))" +proof - + { + fix A + let ?Y="{y . x\A , y=f(x)}" + let ?Y'="{y . x\A , y=\x,f(x)\}" + have "\x\C. M(\fst(fst(x)),snd(snd(x))\)" if "M(C)" for C + using transM[OF _ that] by auto + moreover + note assms + moreover + assume "M(A)" + moreover from assms + have eq:"?Y = {y . x\A ,M(y) \ y=f(x)}" "?Y' = {y . x\A ,M(y) \ y=\x,f(x)\}" + using transM[OF _ \M(A)\] by auto + moreover from \M(A)\ assms(1) + have "M(?Y')" "M(?Y)" + using lam_replacement_imp_RepFun_Lam lam_replacement_imp_RepFun eq by auto + moreover from calculation + have "M({z . y\?Y , M(z) \ z=\y,g(y)\})" (is "M(?Z)") + using lam_replacement_imp_RepFun_Lam by auto + moreover from calculation + have "M(?Y'\?Z)" + by simp + moreover from this + have "M({p \ ?Y'\?Z . snd(fst(p))=fst(snd(p))})" (is "M(?P)") + using middle_separation by simp + moreover from calculation + have "M({ \fst(fst(p)),snd(snd(p))\ . p\?P })" (is "M(?R)") + using RepFun_closed[OF middle_del_replacement \M(?P)\] by simp + ultimately + have "b \ ?R \ (\x[M]. x \ A \ b = \x,g(f(x))\)" if "M(b)" for b + using that assms(3) + apply(intro iffI) apply(auto)[1] + proof - + assume "\x[M]. x \ A \ b = \x, g(f(x))\" + moreover from this + obtain x where "M(x)" "x\A" "b= \x, g(f(x))\" + by auto + moreover from calculation that assms(3) + have "M(f(x))" "M(g(f(x)))" by auto + moreover from calculation + have "\x,f(x)\ \ ?Y'" by auto + moreover from calculation + have "\f(x),g(f(x))\\?Z" by auto + moreover from calculation + have "\\x,f(x)\,\f(x),g(f(x))\\ \ ?P" + (is "?p\?P") + by auto + moreover from calculation + have "b = \fst(fst(?p)),snd(snd(?p))\" by auto + moreover from calculation + have "\fst(fst(?p)),snd(snd(?p))\\?R" + by(rule_tac RepFunI[of ?p ?P], simp) + ultimately show "b\?R" by simp + qed + with \M(?R)\ + have "\Y[M]. \b[M]. b \ Y \ (\x[M]. x \ A \ b = \x,g(f(x))\)" + by (rule_tac rexI[where x="?R"],simp_all) + } + with assms + show ?thesis using lam_replacement_def strong_replacement_def by simp +qed + +lemma lam_replacement_Collect : + assumes "M(A)" "\x[M]. separation(M,F(x))" + "separation(M,\p . \x\A. x\snd(p) \ F(fst(p),x))" + shows "lam_replacement(M,\x. {y\A . F(x,y)})" +proof - + { + fix Z + let ?Y="\z.{x\A . F(z,x)}" + assume "M(Z)" + moreover from this + have "M(?Y(z))" if "z\Z" for z + using assms that transM[of _ Z] by simp + moreover from this + have "?Y(z)\Pow\<^bsup>M\<^esup>(A)" if "z\Z" for z + using Pow_rel_char that assms by auto + moreover from calculation \M(A)\ + have "M(Z\Pow\<^bsup>M\<^esup>(A))" by simp + moreover from this + have "M({p \ Z\Pow\<^bsup>M\<^esup>(A) . \x\A. x\snd(p) \ F(fst(p),x)})" (is "M(?P)") + using assms by simp + ultimately + have "b \ ?P \ (\z[M]. z\Z \ b=\z,?Y(z)\)" if "M(b)" for b + using assms(1) Pow_rel_char[OF \M(A)\] that + by(intro iffI,auto,intro equalityI,auto) + with \M(?P)\ + have "\Y[M]. \b[M]. b \ Y \ (\z[M]. z \ Z \ b = \z,?Y(z)\)" + by (rule_tac rexI[where x="?P"],simp_all) + } + then + show ?thesis + unfolding lam_replacement_def strong_replacement_def + by simp +qed + +lemma lam_replacement_hcomp2: + assumes "lam_replacement(M,f)" "lam_replacement(M,g)" + "\x[M]. M(f(x))" "\x[M]. M(g(x))" + "lam_replacement(M, \p. h(fst(p),snd(p)))" + "\x[M]. \y[M]. M(h(x,y))" + shows "lam_replacement(M, \x. h(f(x),g(x)))" + using assms lam_replacement_product[of f g] + lam_replacement_hcomp[of "\x. \f(x), g(x)\" "\\x,y\. h(x,y)"] + unfolding split_def by simp + +lemma lam_replacement_identity: "lam_replacement(M,\x. x)" +proof - + { + fix A + assume "M(A)" + moreover from this + have "id(A) = {\snd(fst(z)),fst(snd(z))\ . z\ {z\ (A\A)\(A\A). snd(fst(z)) = fst(snd(z))}}" + unfolding id_def lam_def + by(intro equalityI subsetI,simp_all,auto) + moreover from calculation + have "M({z\ (A\A)\(A\A). snd(fst(z)) = fst(snd(z))})" (is "M(?A')") + using middle_separation by simp + moreover from calculation + have "M({\snd(fst(z)),fst(snd(z))\ . z\ ?A'})" + using transM[of _ A] + lam_replacement_product lam_replacement_hcomp lam_replacement_fst lam_replacement_snd + lam_replacement_imp_strong_replacement[THEN RepFun_closed] + by simp_all + ultimately + have "M(id(A))" by simp + } + then + show ?thesis using lam_replacement_iff_lam_closed + unfolding id_def by simp +qed + +lemma lam_replacement_vimage : + shows "lam_replacement(M, \x. fst(x)-``snd(x))" + unfolding vimage_def using + lam_replacement_hcomp2[OF + lam_replacement_hcomp[OF lam_replacement_fst lam_replacement_converse] lam_replacement_snd + _ _ lam_replacement_Image] + by auto + +lemma strong_replacement_separation_aux : + assumes "strong_replacement(M,\ x y . y=f(x))" "separation(M,P)" + shows "strong_replacement(M, \x y . P(x) \ y=f(x))" +proof - + { + fix A + let ?Q="\X. \b[M]. b \ X \ (\x[M]. x \ A \ P(x) \ b = f(x))" + assume "M(A)" + moreover from this + have "M({x\A . P(x)})" (is "M(?B)") using assms by simp + moreover from calculation assms + obtain Y where "M(Y)" "\b[M]. b \ Y \ (\x[M]. x \ ?B \ b = f(x))" + unfolding strong_replacement_def by auto + then + have "\Y[M]. \b[M]. b \ Y \ (\x[M]. x \ A \ P(x) \ b = f(x))" + using rexI[of ?Q _ M] by simp + } + then + show ?thesis + unfolding strong_replacement_def by simp +qed + +lemma separation_in: + assumes "\x[M]. M(f(x))" "lam_replacement(M,f)" + "\x[M]. M(g(x))" "lam_replacement(M,g)" + shows "separation(M,\x . f(x)\g(x))" +proof - + let ?Z="\A. {\x,\f(x),g(x)\\. x\A}" + have "M(?Z(A))" if "M(A)" for A + using assms lam_replacement_iff_lam_closed that + lam_replacement_product[of f g] + unfolding lam_def + by auto + then + have "M({u\?Z(A) . fst(snd(u)) \snd(snd(u))})" (is "M(?W(A))") if "M(A)" for A + using that separation_fst_in_snd assms + by auto + then + have "M({fst(u) . u \ ?W(A)})" if "M(A)" for A + using that lam_replacement_imp_strong_replacement[OF lam_replacement_fst,THEN + RepFun_closed] fst_closed[OF transM] + by auto + moreover + have "{x\A. f(x)\g(x)} = {fst(u) . u\?W(A)}" for A + by auto + ultimately + show ?thesis + using separation_iff + by auto +qed + +lemma lam_replacement_swap: "lam_replacement(M, \x. \snd(x),fst(x)\)" + using lam_replacement_fst lam_replacement_snd + lam_replacement_product[of "snd" "fst"] by simp + +lemma lam_replacement_range : "lam_replacement(M,range)" + unfolding range_def + using lam_replacement_hcomp[OF lam_replacement_converse lam_replacement_domain] + by auto + +lemma separation_in_range : "M(a) \ separation(M, \x. a\range(x))" + using lam_replacement_range lam_replacement_constant separation_in + by auto + +lemma separation_in_domain : "M(a) \ separation(M, \x. a\domain(x))" + using lam_replacement_domain lam_replacement_constant separation_in + by auto + +lemma lam_replacement_separation : + assumes "lam_replacement(M,f)" "separation(M,P)" + shows "strong_replacement(M, \x y . P(x) \ y=\x,f(x)\)" + using strong_replacement_separation_aux assms + unfolding lam_replacement_def + by simp + +lemmas strong_replacement_separation = + strong_replacement_separation_aux[OF lam_replacement_imp_strong_replacement] + +lemma id_closed: "M(A) \ M(id(A))" + using lam_replacement_identity lam_replacement_iff_lam_closed + unfolding id_def by simp + +lemma relation_separation: "separation(M, \z. \x y. z = \x, y\)" + unfolding separation_def +proof (clarify) + fix A + assume "M(A)" + moreover from this + have "{z\A. \x y. z = \x, y\} = {z\A. \x\domain(A). \y\range(A). pair(M, x, y, z)}" + (is "?rel = _") + by (intro equalityI, auto dest:transM) + (intro bexI, auto dest:transM simp:Pair_def) + moreover from calculation + have "M(?rel)" + using cartprod_separation[THEN separation_closed, of "domain(A)" "range(A)" A] + by simp + ultimately + show "\y[M]. \x[M]. x \ y \ x \ A \ (\w y. x = \w, y\)" + by (rule_tac x="{z\A. \x y. z = \x, y\}" in rexI) auto +qed + +lemma separation_pair: + assumes "separation(M, \y . P(fst(y), snd(y)))" + shows "separation(M, \y. \ u v . y=\u,v\ \ P(u,v))" + unfolding separation_def +proof(clarify) + fix A + assume "M(A)" + moreover from this + have "M({z\A. \x y. z = \x, y\})" (is "M(?P)") + using relation_separation by simp + moreover from this assms + have "M({z\?P . P(fst(z),snd(z))})" + by(rule_tac separation_closed,simp_all) + moreover + have "{y\A . \ u v . y=\u,v\ \ P(u,v) } = {z\?P . P(fst(z),snd(z))}" + by(rule equalityI subsetI,auto) + moreover from calculation + have "M({y\A . \ u v . y=\u,v\ \ P(u,v) })" + by simp + ultimately + show "\y[M]. \x[M]. x \ y \ x \ A \ (\w y. x = \w, y\ \ P(w,y))" + by (rule_tac x="{z\A. \x y. z = \x, y\ \ P(x,y)}" in rexI) auto +qed + +lemma lam_replacement_Pair: + shows "lam_replacement(M, \x. \fst(x), snd(x)\)" + unfolding lam_replacement_def strong_replacement_def +proof (clarsimp) + fix A + assume "M(A)" + then + show "\Y[M]. \b[M]. b \ Y \ (\x\A. b = \x, fst(x), snd(x)\)" + unfolding lam_replacement_def strong_replacement_def + proof (cases "relation(A)") + case True + with \M(A)\ + show ?thesis + using id_closed unfolding relation_def + by (rule_tac x="id(A)" in rexI) auto + next + case False + moreover + note \M(A)\ + moreover from this + have "M({z\A. \x y. z = \x, y\})" (is "M(?rel)") + using relation_separation by auto + moreover + have "z = \fst(z), snd(z)\" if "fst(z) \ 0 \ snd(z) \ 0" for z + using that + by (cases "\a b. z=\a,b\") (auto simp add: the_0 fst_def snd_def) + ultimately + show ?thesis + using id_closed unfolding relation_def + by (rule_tac x="id(?rel) \ (A-?rel)\{0}\{0}" in rexI) + (force simp:fst_def snd_def)+ + qed +qed + +lemma lam_replacement_Un: "lam_replacement(M, \p. fst(p) \ snd(p))" + using lam_replacement_Upair lam_replacement_Union + lam_replacement_hcomp[where g=Union and f="\p. Upair(fst(p),snd(p))"] + unfolding Un_def by simp + +lemma lam_replacement_cons: "lam_replacement(M, \p. cons(fst(p),snd(p)))" + using lam_replacement_Upair + lam_replacement_hcomp2[of _ _ "(\)"] + lam_replacement_hcomp2[of fst fst "Upair"] + lam_replacement_Un lam_replacement_fst lam_replacement_snd + unfolding cons_def + by auto + +lemma lam_replacement_sing: "lam_replacement(M, \x. {x})" + using lam_replacement_constant lam_replacement_cons + lam_replacement_hcomp2[of "\x. x" "\_. 0" cons] + by (force intro: lam_replacement_identity) + +lemmas tag_replacement = lam_replacement_constant[unfolded lam_replacement_def] + +lemma lam_replacement_id2: "lam_replacement(M, \x. \x, x\)" + using lam_replacement_identity lam_replacement_product[of "\x. x" "\x. x"] + by simp + +lemmas id_replacement = lam_replacement_id2[unfolded lam_replacement_def] + +lemma lam_replacement_apply2:"lam_replacement(M, \p. fst(p) ` snd(p))" + using lam_replacement_sing lam_replacement_fst lam_replacement_snd + lam_replacement_Image lam_replacement_Union + unfolding apply_def + by (rule_tac lam_replacement_hcomp[of _ Union], + rule_tac lam_replacement_hcomp2[of _ _ "(``)"]) + (force intro:lam_replacement_hcomp)+ + +definition map_snd where + "map_snd(X) = {snd(z) . z\X}" + +lemma map_sndE: "y\map_snd(X) \ \p\X. y=snd(p)" + unfolding map_snd_def by auto + +lemma map_sndI : "\p\X. y=snd(p) \ y\map_snd(X)" + unfolding map_snd_def by auto + +lemma map_snd_closed: "M(x) \ M(map_snd(x))" + unfolding map_snd_def + using lam_replacement_imp_strong_replacement[OF lam_replacement_snd] + RepFun_closed snd_closed[OF transM[of _ x]] + by simp + +lemma lam_replacement_imp_lam_replacement_RepFun: + assumes "lam_replacement(M, f)" "\x[M]. M(f(x))" + "separation(M, \x. ((\y\snd(x). fst(y) \ fst(x)) \ (\y\fst(x). \u\snd(x). y=fst(u))))" + and + lam_replacement_RepFun_snd:"lam_replacement(M,map_snd)" + shows "lam_replacement(M, \x. {f(y) . y\x})" +proof - + have f_closed:"M(\fst(z),map_snd(snd(z))\)" if "M(z)" for z + using pair_in_M_iff fst_closed snd_closed map_snd_closed that + by simp + have p_closed:"M(\x,{f(y) . y\x}\)" if "M(x)" for x + using pair_in_M_iff RepFun_closed lam_replacement_imp_strong_replacement + transM[OF _ that] that assms by auto + { + fix A + assume "M(A)" + then + have "M({\y,f(y)\ . y\x})" if "x\A" for x + using lam_replacement_iff_lam_closed assms that transM[of _ A] + unfolding lam_def by simp + from assms \M(A)\ + have "\x\\A. M(f(x))" + using transM[of _ "\A"] by auto + with assms \M(A)\ + have "M({\y,f(y)\ . y \ \A})" (is "M(?fUnA)") + using lam_replacement_iff_lam_closed[THEN iffD1,OF assms(2) assms(1)] + unfolding lam_def + by simp + with \M(A)\ + have "M(Pow_rel(M,?fUnA))" by simp + with \M(A)\ + have "M({z\A\Pow_rel(M,?fUnA) . ((\y\snd(z). fst(y) \ fst(z)) \ (\y\fst(z). \u\snd(z). y=fst(u)))})" (is "M(?T)") + using assms(3) by simp + then + have 1:"M({\fst(z),map_snd(snd(z))\ . z\?T})" (is "M(?Y)") + using lam_replacement_product[OF lam_replacement_fst + lam_replacement_hcomp[OF lam_replacement_snd lam_replacement_RepFun_snd]] + RepFun_closed lam_replacement_imp_strong_replacement + f_closed[OF transM[OF _ \M(?T)\]] + by simp + have 2:"?Y = {\x,{f(y) . y\x}\ . x\A}" (is "_ = ?R") + proof(intro equalityI subsetI) + fix p + assume "p\?R" + with \M(A)\ + obtain x where "x\A" "p=\x,{f(y) . y \ x}\" "M(x)" + using transM[OF _ \M(A)\] + by auto + moreover from calculation + have "M({\y,f(y)\ . y\x})" (is "M(?Ux)") + using lam_replacement_iff_lam_closed assms + unfolding lam_def by auto + moreover from calculation + have "?Ux \ ?fUnA" + by auto + moreover from calculation + have "?Ux \ Pow_rel(M,?fUnA)" + using Pow_rel_char[OF \M(?fUnA)\] by simp + moreover from calculation + have "\u\x. \w\?Ux. u=fst(w)" + by force + moreover from calculation + have "\x,?Ux\ \ ?T" by auto + moreover from calculation + have "{f(y).y\x} = map_snd(?Ux)" + unfolding map_snd_def + by(intro equalityI,auto) + ultimately + show "p\?Y" + by (auto,rule_tac bexI[where x=x],simp_all,rule_tac bexI[where x="?Ux"],simp_all) + next + fix u + assume "u\?Y" + moreover from this + obtain z where "z\?T" "u=\fst(z),map_snd(snd(z))\" + by blast + moreover from calculation + obtain x U where + 1:"x\A" "U\Pow_rel(M,?fUnA)" "(\u\U. fst(u) \ x) \ (\w\x. \v\U. w=fst(v))" "z=\x,U\" + by force + moreover from this + have "fst(u)\\A" "snd(u) = f(fst(u))" if "u\U" for u + using that Pow_rel_char[OF \M(?fUnA)\] + by auto + moreover from calculation + have "map_snd(U) = {f(y) . y\x}" + unfolding map_snd_def + by(intro equalityI subsetI,auto) + moreover from calculation + have "u=\x,map_snd(U)\" + by simp + ultimately + show "u\?R" + by (auto) + qed + from 1 2 + have "M({\x,{f(y) . y\x}\ . x\A})" + by simp + } + then + have "\A[M]. M(\x\A. {f(y) . y\x})" + unfolding lam_def by auto + then + show ?thesis + using lam_replacement_iff_lam_closed[THEN iffD2] p_closed + by simp +qed + + +lemma lam_replacement_apply:"M(S) \ lam_replacement(M, \x. S ` x)" + using lam_replacement_Union lam_replacement_constant lam_replacement_identity + lam_replacement_Image lam_replacement_cons + lam_replacement_hcomp2[of _ _ Image] lam_replacement_hcomp2[of "\x. x" "\_. 0" cons] + unfolding apply_def + by (rule_tac lam_replacement_hcomp[of _ Union]) (force intro:lam_replacement_hcomp)+ + +lemma apply_replacement:"M(S) \ strong_replacement(M, \x y. y = S ` x)" + using lam_replacement_apply lam_replacement_imp_strong_replacement by simp + +lemma lam_replacement_id_const: "M(b) \ lam_replacement(M, \x. \x, b\)" + using lam_replacement_identity lam_replacement_constant + lam_replacement_product[of "\x. x" "\x. b"] by simp + +lemmas pospend_replacement = lam_replacement_id_const[unfolded lam_replacement_def] + +lemma lam_replacement_const_id: "M(b) \ lam_replacement(M, \z. \b, z\)" + using lam_replacement_identity lam_replacement_constant + lam_replacement_product[of "\x. b" "\x. x"] by simp + +lemmas prepend_replacement = lam_replacement_const_id[unfolded lam_replacement_def] + +lemma lam_replacement_apply_const_id: "M(f) \ M(z) \ + lam_replacement(M, \x. f ` \z, x\)" + using lam_replacement_const_id[of z] lam_replacement_apply[of f] + lam_replacement_hcomp[of "\x. \z, x\" "\x. f`x"] by simp + +lemmas apply_replacement2 = lam_replacement_apply_const_id[unfolded lam_replacement_def] + +lemma lam_replacement_Inl: "lam_replacement(M, Inl)" + using lam_replacement_identity lam_replacement_constant + lam_replacement_product[of "\x. 0" "\x. x"] + unfolding Inl_def by simp + +lemma lam_replacement_Inr: "lam_replacement(M, Inr)" + using lam_replacement_identity lam_replacement_constant + lam_replacement_product[of "\x. 1" "\x. x"] + unfolding Inr_def by simp + +lemmas Inl_replacement1 = lam_replacement_Inl[unfolded lam_replacement_def] + +lemma lam_replacement_Diff': "M(X) \ lam_replacement(M, \x. x - X)" + using lam_replacement_Diff + by (force intro: lam_replacement_hcomp2 lam_replacement_constant + lam_replacement_identity)+ + +lemmas Pair_diff_replacement = lam_replacement_Diff'[unfolded lam_replacement_def] + +lemma diff_Pair_replacement: "M(p) \ strong_replacement(M, \x y . y=\x,x-{p}\)" + using Pair_diff_replacement by simp + +lemma swap_replacement:"strong_replacement(M, \x y. y = \x, (\\x,y\. \y, x\)(x)\)" + using lam_replacement_swap unfolding lam_replacement_def split_def by simp + +lemma lam_replacement_Un_const:"M(b) \ lam_replacement(M, \x. x \ b)" + using lam_replacement_Un lam_replacement_hcomp2[of _ _ "(\)"] + lam_replacement_constant[of b] lam_replacement_identity by simp + +lemmas tag_union_replacement = lam_replacement_Un_const[unfolded lam_replacement_def] + +lemma lam_replacement_csquare: "lam_replacement(M,\p. \fst(p) \ snd(p), fst(p), snd(p)\)" + using lam_replacement_Un lam_replacement_fst lam_replacement_snd + by (fast intro: lam_replacement_product lam_replacement_hcomp2) + +lemma csquare_lam_replacement:"strong_replacement(M, \x y. y = \x, (\\x,y\. \x \ y, x, y\)(x)\)" + using lam_replacement_csquare unfolding split_def lam_replacement_def . + +lemma lam_replacement_assoc:"lam_replacement(M,\x. \fst(fst(x)), snd(fst(x)), snd(x)\)" + using lam_replacement_fst lam_replacement_snd + by (force intro: lam_replacement_product lam_replacement_hcomp) + +lemma assoc_replacement:"strong_replacement(M, \x y. y = \x, (\\\x,y\,z\. \x, y, z\)(x)\)" + using lam_replacement_assoc unfolding split_def lam_replacement_def . + +lemma lam_replacement_prod_fun: "M(f) \ M(g) \ lam_replacement(M,\x. \f ` fst(x), g ` snd(x)\)" + using lam_replacement_fst lam_replacement_snd + by (force intro: lam_replacement_product lam_replacement_hcomp lam_replacement_apply) + +lemma prod_fun_replacement:"M(f) \ M(g) \ + strong_replacement(M, \x y. y = \x, (\\w,y\. \f ` w, g ` y\)(x)\)" + using lam_replacement_prod_fun unfolding split_def lam_replacement_def . + +lemma lam_replacement_vimage_sing: "lam_replacement(M, \p. fst(p) -`` {snd(p)})" + using lam_replacement_hcomp[OF lam_replacement_snd lam_replacement_sing] + lam_replacement_hcomp2[OF lam_replacement_fst _ _ _ lam_replacement_vimage] + by simp + +lemma lam_replacement_vimage_sing_fun: "M(f) \ lam_replacement(M, \x. f -`` {x})" + using lam_replacement_hcomp2[OF lam_replacement_constant[of f] + lam_replacement_identity _ _ lam_replacement_vimage_sing] + by simp +lemma lam_replacement_image_sing_fun: "M(f) \ lam_replacement(M, \x. f `` {x})" + using lam_replacement_hcomp2[OF lam_replacement_constant[of f] + lam_replacement_hcomp[OF lam_replacement_identity lam_replacement_sing] + _ _ lam_replacement_Image] + by simp + +lemma converse_apply_projs: "\x[M]. \ (fst(x) -`` {snd(x)}) = converse(fst(x)) ` (snd(x))" + using converse_apply_eq by auto + +lemma lam_replacement_converse_app: "lam_replacement(M, \p. converse(fst(p)) ` snd(p))" + using lam_replacement_cong[OF _ converse_apply_projs] + lam_replacement_hcomp[OF lam_replacement_vimage_sing lam_replacement_Union] + by simp + +lemmas cardinal_lib_assms4 = lam_replacement_vimage_sing_fun[unfolded lam_replacement_def] + +lemma lam_replacement_sing_const_id: + "M(x) \ lam_replacement(M, \y. {\x, y\})" + using lam_replacement_hcomp[OF lam_replacement_const_id[of x]] + lam_replacement_sing pair_in_M_iff + by simp + +lemma tag_singleton_closed: "M(x) \ M(z) \ M({{\z, y\} . y \ x})" + using RepFun_closed[where A=x and f="\ u. {\z,u\}"] + lam_replacement_imp_strong_replacement lam_replacement_sing_const_id + transM[of _ x] + by simp + +lemma separation_eq: + assumes "\x[M]. M(f(x))" "lam_replacement(M,f)" + "\x[M]. M(g(x))" "lam_replacement(M,g)" + shows "separation(M,\x . f(x) = g(x))" +proof - + let ?Z="\A. {\x,\f(x),\g(x),x\\\. x\A}" + let ?Y="\A. {\\x,f(x)\,\g(x),x\\. x\A}" + note sndsnd = lam_replacement_hcomp[OF lam_replacement_snd lam_replacement_snd] + note fstsnd = lam_replacement_hcomp[OF lam_replacement_snd lam_replacement_fst] + note sndfst = lam_replacement_hcomp[OF lam_replacement_fst lam_replacement_snd] + have "M(?Z(A))" if "M(A)" for A + using assms lam_replacement_iff_lam_closed that + lam_replacement_product[OF assms(2) + lam_replacement_product[OF assms(4) lam_replacement_identity]] + unfolding lam_def + by auto + moreover + have "?Y(A) = {\\fst(x), fst(snd(x))\, fst(snd(snd(x))), snd(snd(snd(x)))\ . x \ ?Z(A)}" for A + by auto + moreover from calculation + have "M(?Y(A))" if "M(A)" for A + using + lam_replacement_imp_strong_replacement[OF + lam_replacement_product[OF + lam_replacement_product[OF lam_replacement_fst fstsnd] + lam_replacement_product[OF + lam_replacement_hcomp[OF sndsnd lam_replacement_fst] + lam_replacement_hcomp[OF lam_replacement_snd sndsnd] + ] + ], THEN RepFun_closed,simplified,of "?Z(A)"] + fst_closed[OF transM] snd_closed[OF transM] that + by auto + then + have "M({u\?Y(A) . snd(fst(u)) = fst(snd(u))})" (is "M(?W(A))") if "M(A)" for A + using that middle_separation assms + by auto + then + have "M({fst(fst(u)) . u \ ?W(A)})" if "M(A)" for A + using that lam_replacement_imp_strong_replacement[OF + lam_replacement_hcomp[OF lam_replacement_fst lam_replacement_fst], THEN RepFun_closed] + fst_closed[OF transM] + by auto + moreover + have "{x\A. f(x) = g(x)} = {fst(fst(u)) . u\?W(A)}" for A + by auto + ultimately + show ?thesis + using separation_iff by auto +qed + +lemma separation_subset: + assumes "\x[M]. M(f(x))" "lam_replacement(M,f)" + "\x[M]. M(g(x))" "lam_replacement(M,g)" + shows "separation(M,\x . f(x) \ g(x))" +proof - + have "f(x) \ g(x) \ f(x)\g(x) = g(x)" for x + using subset_Un_iff by simp + moreover from assms + have "separation(M,\x . f(x)\g(x) = g(x))" + using separation_eq lam_replacement_Un lam_replacement_hcomp2 + by simp + ultimately + show ?thesis + using separation_cong[THEN iffD1] by auto +qed + +lemma separation_ball: + assumes "separation(M, \y. f(fst(y),snd(y)))" "M(X)" + shows "separation(M, \y. \u\X. f(y,u))" + unfolding separation_def +proof(clarify) + fix A + assume "M(A)" + moreover + note \M(X)\ + moreover from calculation + have "M(A\X)" + by simp + then + have "M({p \ A\X . f(fst(p),snd(p))})" (is "M(?P)") + using assms(1) + by auto + moreover from calculation + have "M({a\A . ?P``{a} = X})" (is "M(?A')") + using separation_eq lam_replacement_image_sing_fun[of "?P"] lam_replacement_constant + by simp + moreover + have "f(a,x)" if "a\?A'" and "x\X" for a x + proof - + from that + have "a\A" "?P``{a}=X" + by auto + then + have "x\?P``{a}" + using that by simp + then + show ?thesis using image_singleton_iff by simp + qed + moreover from this + have "\a[M]. a \ ?A' \ a \ A \ (\x\X. f(a, x))" + using image_singleton_iff + by auto + with \M(?A')\ + show "\y[M]. \a[M]. a \ y \ a \ A \ (\x\X. f(a, x))" + by (rule_tac x="?A'" in rexI,simp_all) +qed + +lemma lam_replacement_twist: "lam_replacement(M,\\\x,y\,z\. \x,y,z\)" + using lam_replacement_fst lam_replacement_snd + lam_replacement_Pair[THEN [5] lam_replacement_hcomp2, + of "\x. snd(fst(x))" "\x. snd(x)", THEN [2] lam_replacement_Pair[ + THEN [5] lam_replacement_hcomp2, of "\x. fst(fst(x))"]] + lam_replacement_hcomp unfolding split_def by simp + +lemma twist_closed[intro,simp]: "M(x) \ M((\\\x,y\,z\. \x,y,z\)(x))" + unfolding split_def by simp + +lemma lam_replacement_Lambda: + assumes "lam_replacement(M, \y. b(fst(y), snd(y)))" + "\w[M]. \y[M]. M(b(w, y))" "M(W)" + shows "lam_replacement(M, \x. \w\W. b(x, w))" +proof (intro lam_replacement_iff_lam_closed[THEN iffD2]; clarify) + have aux_sep: "\x[M]. separation(M,\y. \fst(x), y\ \ A)" + if "M(X)" "M(A)" for X A + using separation_in lam_replacement_hcomp2[OF lam_replacement_hcomp[OF lam_replacement_constant lam_replacement_fst] + lam_replacement_identity _ _ lam_replacement_Pair] + lam_replacement_constant[of A] + that + by simp + have aux_closed: "\x[M]. M({y \ X . \fst(x), y\ \ A})" if "M(X)" "M(A)" for X A + using aux_sep that by simp + have aux_lemma: "lam_replacement(M,\p . {y \ X . \fst(p), y\ \ A})" + if "M(X)" "M(A)" for X A + proof - + note lr = lam_replacement_Collect[OF \M(X)\] + note fst3 = lam_replacement_hcomp[OF lam_replacement_fst + lam_replacement_hcomp[OF lam_replacement_fst lam_replacement_fst]] + then show ?thesis + using lam_replacement_Collect[OF \M(X)\ aux_sep separation_ball[OF separation_iff']] + separation_in[OF _ lam_replacement_snd _ lam_replacement_hcomp[OF lam_replacement_fst lam_replacement_snd]] + separation_in[OF _ lam_replacement_hcomp2[OF fst3 lam_replacement_snd _ _ lam_replacement_Pair] _ + lam_replacement_constant[of A]] that + by auto + qed + from assms + show lbc:"M(x) \ M(\w\W. b(x, w))" for x + using lam_replacement_constant lam_replacement_identity + lam_replacement_hcomp2[where h=b] + by (intro lam_replacement_iff_lam_closed[THEN iffD1, rule_format]) + simp_all + fix A + assume "M(A)" + moreover from this assms + have "M({b(fst(x),snd(x)). x \ A\W})" (is "M(?RFb)")\ \\<^term>\RepFun\ \<^term>\b\\ + using lam_replacement_imp_strong_replacement transM[of _ "A\W"] + by (rule_tac RepFun_closed) auto + moreover + have "{\\x,y\,z\ \ (A\W)\?RFb. z = b(x,y)} = (\\x,y\\A\W. b(x,y)) \ (A\W)\?RFb" + (is "{\\x,y\,z\ \ (A\W)\?B. _ } = ?lam") + unfolding lam_def by auto + moreover from calculation and assms + have "M(?lam)" + using lam_replacement_iff_lam_closed unfolding split_def by simp + moreover + have "{\\x,y\,z\ \ (X \ Y) \ Z . P(x, y, z)} \ (X \ Y) \ Z" for X Y Z P + by auto + then + have "{\x,y,z\ \ X\Y\Z. P(x,y,z) }= (\\\x,y\,z\\(X\Y)\Z. \x,y,z\) `` + {\\x,y\,z\ \ (X\Y)\Z. P(x,y,z) }" (is "?C' = Lambda(?A,?f) `` ?C") + for X Y Z P + using image_lam[of ?C ?A ?f] + by (intro equalityI) (auto) + with calculation + have "{\x,y,z\ \ A\W\?RFb. z = b(x,y) } = + (\\\x,y\,z\\(A\W)\?RFb. \x,y,z\) `` ?lam" (is "?H = ?G ") + by simp + with \M(A)\ \M(W)\ \M(?lam)\ \M(?RFb)\ + have "M(?H)" + using lam_replacement_iff_lam_closed[THEN iffD1, rule_format, OF _ lam_replacement_twist] + by simp + moreover from this and \M(A)\ + have "(\x\A. \w\W. b(x, w)) = + {\x,Z\ \ A \ Pow\<^bsup>M\<^esup>(range(?H)). Z = {y \ W\?RFb . \x, y\ \ ?H}}" + unfolding lam_def + by (intro equalityI; subst Pow_rel_char[of "range(?H)"]) + (auto dest:transM simp: lbc[unfolded lam_def], force+) + moreover from calculation and \M(A)\ and \M(W)\ + have "M(A\Pow\<^bsup>M\<^esup>(range(?H)))" "M(W\?RFb)" + by auto + moreover + note \M(W)\ + moreover from calculation + have "M({\x,Z\ \ A \ Pow\<^bsup>M\<^esup>(range(?H)). Z = {y \ W\?RFb . \x, y\ \ ?H}})" + using separation_eq[OF _ lam_replacement_snd + aux_closed[OF \M(W\?RFb)\ \M(?H)\] + aux_lemma[OF \M(W\?RFb)\ \M(?H)\]] + \M(A\Pow\<^bsup>M\<^esup>(_))\ assms + unfolding split_def + by auto + ultimately + show "M(\x\A. \w\W. b(x, w))" by simp +qed + +lemma lam_replacement_apply_Pair: + assumes "M(y)" + shows "lam_replacement(M, \x. y ` \fst(x), snd(x)\)" + using assms lam_replacement_constant lam_replacement_Pair + lam_replacement_apply2[THEN [5] lam_replacement_hcomp2] + by auto + +lemma lam_replacement_apply_fst_snd: + shows "lam_replacement(M, \w. fst(w) ` fst(snd(w)) ` snd(snd(w)))" + using lam_replacement_fst lam_replacement_snd lam_replacement_hcomp + lam_replacement_apply2[THEN [5] lam_replacement_hcomp2] + by auto + +lemma separation_snd_in_fst: "separation(M, \x. snd(x) \ fst(x))" + using separation_in lam_replacement_fst lam_replacement_snd + by auto + +lemma lam_replacement_if_mem: + "lam_replacement(M, \x. if snd(x) \ fst(x) then 1 else 0)" + using separation_snd_in_fst + lam_replacement_constant lam_replacement_if + by auto + +lemma lam_replacement_Lambda_apply_fst_snd: + assumes "M(X)" + shows "lam_replacement(M, \x. \w\X. x ` fst(w) ` snd(w))" + using assms lam_replacement_apply_fst_snd lam_replacement_Lambda + by simp + +lemma lam_replacement_Lambda_apply_Pair: + assumes "M(X)" "M(y)" + shows "lam_replacement(M, \x. \w\X. y ` \x, w\)" + using assms lam_replacement_apply_Pair lam_replacement_Lambda + by simp + +lemma lam_replacement_Lambda_if_mem: + assumes "M(X)" + shows "lam_replacement(M, \x. \xa\X. if xa \ x then 1 else 0)" + using assms lam_replacement_if_mem lam_replacement_Lambda + by simp + +lemma lam_replacement_comp': + "M(f) \ M(g) \ lam_replacement(M, \x . f O x O g)" + using lam_replacement_comp[THEN [5] lam_replacement_hcomp2, + OF lam_replacement_constant lam_replacement_comp, + THEN [5] lam_replacement_hcomp2] lam_replacement_constant + lam_replacement_identity by simp + +lemma separation_bex: + assumes "separation(M, \y. f(fst(y),snd(y)))" "M(X)" + shows "separation(M, \y. \u\X. f(y,u))" + unfolding separation_def +proof(clarify) + fix A + assume "M(A)" + moreover + note \M(X)\ + moreover from calculation + have "M(A\X)" + by simp + then + have "M({p \ A\X . f(fst(p),snd(p))})" (is "M(?P)") + using assms(1) + by auto + moreover from calculation + have "M({a\A . ?P``{a} \ 0})" (is "M(?A')") + using separation_eq lam_replacement_image_sing_fun[of "?P"] lam_replacement_constant + separation_neg + by simp + moreover from this + have "\a[M]. a \ ?A' \ a \ A \ (\x\X. f(a, x))" + using image_singleton_iff + by auto + with \M(?A')\ + show "\y[M]. \a[M]. a \ y \ a \ A \ (\x\X. f(a, x))" + by (rule_tac x="?A'" in rexI,simp_all) +qed + +lemma case_closed : + assumes "\x[M]. M(f(x))" "\x[M]. M(g(x))" + shows "\x[M]. M(case(f,g,x))" + unfolding case_def split_def cond_def + using assms by simp + +lemma separation_fst_equal : "M(a) \ separation(M,\x . fst(x)=a)" + using separation_eq lam_replacement_fst lam_replacement_constant + by auto + +lemma lam_replacement_case : + assumes "lam_replacement(M,f)" "lam_replacement(M,g)" + "\x[M]. M(f(x))" "\x[M]. M(g(x))" + shows "lam_replacement(M, \x . case(f,g,x))" + unfolding case_def split_def cond_def + using lam_replacement_if separation_fst_equal + lam_replacement_hcomp[of "snd" g] + lam_replacement_hcomp[of "snd" f] + lam_replacement_snd assms + by simp + +lemma Pi_replacement1: "M(x) \ M(y) \ strong_replacement(M, \ya z. ya \ y \ z = {\x, ya\})" + using lam_replacement_imp_strong_replacement + strong_replacement_separation[OF lam_replacement_sing_const_id[of x],where P="\x . x \y"] + separation_in_constant + by simp + +lemma surj_imp_inj_replacement1: + "M(f) \ M(x) \ strong_replacement(M, \y z. y \ f -`` {x} \ z = {\x, y\})" + using Pi_replacement1 vimage_closed singleton_closed + by simp + +lemmas domain_replacement = lam_replacement_domain[unfolded lam_replacement_def] + +lemma domain_replacement_simp: "strong_replacement(M, \x y. y=domain(x))" + using lam_replacement_domain lam_replacement_imp_strong_replacement by simp + +lemma un_Pair_replacement: "M(p) \ strong_replacement(M, \x y . y = x\{p})" + using lam_replacement_Un_const[THEN lam_replacement_imp_strong_replacement] by simp + +lemma diff_replacement: "M(X) \ strong_replacement(M, \x y. y = x - X)" + using lam_replacement_Diff'[THEN lam_replacement_imp_strong_replacement] by simp + +lemma lam_replacement_succ: + "lam_replacement(M,\z . succ(z))" + unfolding succ_def + using lam_replacement_hcomp2[of "\x. x" "\x. x" cons] + lam_replacement_cons lam_replacement_identity + by simp + +lemma lam_replacement_hcomp_Least: + assumes "lam_replacement(M, g)" "lam_replacement(M,\x. \ i. x\F(i,x))" + "\x[M]. M(g(x))" "\x i. M(x) \ i \ F(i, x) \ M(i)" + shows "lam_replacement(M,\x. \ i. g(x)\F(i,g(x)))" + using assms + by (rule_tac lam_replacement_hcomp[of _ "\x. \ i. x\F(i,x)"]) + (auto intro:Least_closed') + +lemma domain_mem_separation: "M(A) \ separation(M, \x . domain(x)\A)" + using separation_in lam_replacement_constant lam_replacement_domain + by auto + +lemma domain_eq_separation: "M(p) \ separation(M, \x . domain(x) = p)" + using separation_eq lam_replacement_domain lam_replacement_constant + by auto + +lemma lam_replacement_Int: + shows "lam_replacement(M, \x. fst(x) \ snd(x))" +proof - + have "A\B = (A\B) - ((A- B) \ (B-A))" (is "_=?f(A,B)")for A B + by auto + then + show ?thesis + using lam_replacement_cong + lam_replacement_Diff[THEN[5] lam_replacement_hcomp2] + lam_replacement_Un[THEN[5] lam_replacement_hcomp2] + lam_replacement_fst lam_replacement_snd + by simp +qed + +lemma lam_replacement_CartProd: + assumes "lam_replacement(M,f)" "lam_replacement(M,g)" + "\x[M]. M(f(x))" "\x[M]. M(g(x))" + shows "lam_replacement(M, \x. f(x) \ g(x))" +proof - + note rep_closed = lam_replacement_imp_strong_replacement[THEN RepFun_closed] + { + fix A + assume "M(A)" + moreover + note transM[OF _ \M(A)\] + moreover from calculation assms + have "M({\x,\f(x),g(x)\\ . x\A})" (is "M(?A')") + using lam_replacement_product[THEN lam_replacement_imp_lam_closed[unfolded lam_def]] + by simp + moreover from calculation + have "M(\{f(x) . x\A})" (is "M(?F)") + using rep_closed[OF assms(1)] assms(3) + by simp + moreover from calculation + have "M(\{g(x) . x\A})" (is "M(?G)") + using rep_closed[OF assms(2)] assms(4) + by simp + moreover from calculation + have "M(?A' \ (?F \ ?G))" (is "M(?T)") + by simp + moreover from this + have "M({t \ ?T . fst(snd(t)) \ fst(snd(fst(t))) \ snd(snd(t)) \ snd(snd(fst(t)))})" (is "M(?Q)") + using + lam_replacement_hcomp[OF lam_replacement_hcomp[OF lam_replacement_fst lam_replacement_snd] _ ] + lam_replacement_hcomp lam_replacement_identity lam_replacement_fst lam_replacement_snd + separation_in separation_conj + by simp + moreover from this + have "M({\fst(fst(t)),snd(t)\ . t\?Q})" (is "M(?R)") + using rep_closed lam_replacement_Pair[THEN [5] lam_replacement_hcomp2] + lam_replacement_hcomp[OF lam_replacement_fst lam_replacement_fst] lam_replacement_snd + transM[of _ ?Q] + by simp + moreover from calculation + have "M({\x,?R``{x}\ . x\A})" + using lam_replacement_imp_lam_closed[unfolded lam_def] lam_replacement_sing + lam_replacement_Image[THEN [5] lam_replacement_hcomp2] lam_replacement_constant[of ?R] + by simp + moreover + have "?R``{x} = f(x)\g(x)" if "x\A" for x + by(rule equalityI subsetI,force,rule subsetI,rule_tac a="x" in imageI) + (auto simp:that,(rule_tac rev_bexI[of x],simp_all add:that)+) + ultimately + have "M({\x,f(x) \ g(x)\ . x\A})" by auto + } + with assms + show ?thesis using lam_replacement_iff_lam_closed[THEN iffD2,unfolded lam_def] + by simp +qed + +lemma restrict_eq_separation': "M(B) \ \A[M]. separation(M, \y. \x\A. y = \x, restrict(x, B)\)" +proof(clarify) + fix A + have "restrict(r,B) = r \ (B \ range(r))" for r + unfolding restrict_def by(rule equalityI subsetI,auto) + moreover + assume "M(A)" "M(B)" + moreover from this + have "separation(M, \y. \x\A. y = \x, x \ (B \ range(x))\)" + using lam_replacement_Int[THEN[5] lam_replacement_hcomp2] + lam_replacement_Pair[THEN[5] lam_replacement_hcomp2] + using lam_replacement_fst lam_replacement_snd lam_replacement_constant + lam_replacement_hcomp lam_replacement_range lam_replacement_identity + lam_replacement_CartProd separation_bex separation_eq + by simp_all + ultimately + show "separation(M, \y. \x\A. y = \x, restrict(x, B)\)" + by simp +qed + +lemmas lam_replacement_restrict' = lam_replacement_restrict[OF restrict_eq_separation'] + +lemma restrict_strong_replacement: "M(A) \ strong_replacement(M, \x y. y=restrict(x,A))" + using lam_replacement_restrict restrict_eq_separation' + lam_replacement_imp_strong_replacement + by simp + +lemma restrict_eq_separation: "M(r) \ M(p) \ separation(M, \x . restrict(x,r) = p)" + using separation_eq lam_replacement_restrict' lam_replacement_constant + by auto + +lemma separation_equal_fst2 : "M(a) \ separation(M,\x . fst(fst(x))=a)" + using separation_eq lam_replacement_hcomp lam_replacement_fst lam_replacement_constant + by auto + +lemma separation_equal_apply: "M(f) \ M(a) \ separation(M,\x. f`x=a)" + using separation_eq lam_replacement_apply[of f] lam_replacement_constant + by auto + +lemma lam_apply_replacement: "M(A) \ M(f) \ lam_replacement(M, \x . \n\A. f ` \x, n\)" + using lam_replacement_Lambda lam_replacement_hcomp[OF _ lam_replacement_apply[of f]] lam_replacement_Pair + by simp + +lemma separation_all: + assumes "separation(M, \x .P(fst(x),snd(x)))" + shows "separation(M, \z. \x\z. P(z,x))" + unfolding separation_def +proof(clarify) + fix A + assume "M(A)" + let ?B="\A" + let ?C="A\?B" + note \M(A)\ + moreover from calculation + have "M(?C)" + by simp + moreover from calculation + have "M({p\?C . P(fst(p),snd(p)) \ snd(p)\fst(p)})" (is "M(?Prod)") + using assms separation_conj separation_in lam_replacement_fst lam_replacement_snd + by simp + moreover from calculation + have "M({z\A . z=?Prod``{z}})" (is "M(?L)") + using separation_eq lam_replacement_identity + lam_replacement_constant[of ?Prod] lam_replacement_image_sing_fun + by simp + moreover + have "?L = {z\A . \x\z. P(z,x)}" + proof - + have "P(z,x)" if "z\A" "x\z" "x\?Prod``{z}" for z x + using that + by auto + moreover + have "z = ?Prod `` {z}" if "z\A" "\x\z. P(z, x)" for z + using that + by(intro equalityI subsetI,auto) + ultimately + show ?thesis + by(intro equalityI subsetI,auto) + qed + ultimately + show " \y[M]. \z[M]. z \ y \ z \ A \ (\x\z . P(z,x))" + by (rule_tac x="?L" in rexI,simp_all) +qed + +lemma separation_Transset: "separation(M,Transset)" + unfolding Transset_def + using separation_all separation_subset lam_replacement_fst lam_replacement_snd + by auto + +lemma separation_comp : + assumes "separation(M,P)" "lam_replacement(M,f)" "\x[M]. M(f(x))" + shows "separation(M,\x. P(f(x)))" + unfolding separation_def +proof(clarify) + fix A + assume "M(A)" + let ?B="{f(a) . a \ A}" + let ?C="A\{b\?B . P(b)}" + note \M(A)\ + moreover from calculation + have "M(?C)" + using lam_replacement_imp_strong_replacement assms RepFun_closed transM[of _ A] + by simp + moreover from calculation + have "M({p\?C . f(fst(p)) = snd(p)})" (is "M(?Prod)") + using assms separation_eq lam_replacement_fst lam_replacement_snd + lam_replacement_hcomp + by simp + moreover from calculation + have "M({fst(p) . p\?Prod})" (is "M(?L)") + using lam_replacement_imp_strong_replacement lam_replacement_fst RepFun_closed + transM[of _ ?Prod] + by simp + moreover + have "?L = {z\A . P(f(z))}" + by(intro equalityI subsetI,auto) + ultimately + show " \y[M]. \z[M]. z \ y \ z \ A \ P(f(z))" + by (rule_tac x="?L" in rexI,simp_all) +qed + +lemma separation_Ord: "separation(M,Ord)" + unfolding Ord_def + using separation_conj separation_Transset separation_all + separation_comp separation_Transset lam_replacement_snd + by auto + +end \ \\<^locale>\M_replacement\\ + +locale M_replacement_extra = M_replacement + + assumes + lam_replacement_minimum:"lam_replacement(M, \p. minimum(fst(p),snd(p)))" + and + lam_replacement_RepFun_cons:"lam_replacement(M, \p. RepFun(fst(p), \x. {\snd(p),x\}))" + \ \This one is too particular: It is for \<^term>\Sigfun\. + I would like greater modularity here.\ + +begin +lemma lam_replacement_Sigfun: + assumes "lam_replacement(M,f)" "\y[M]. M(f(y))" + shows "lam_replacement(M, \x. Sigfun(x,f))" + using lam_replacement_Union lam_replacement_identity + lam_replacement_sing[THEN lam_replacement_imp_strong_replacement] + lam_replacement_hcomp[of _ Union] assms tag_singleton_closed + lam_replacement_RepFun_cons[THEN [5] lam_replacement_hcomp2] + unfolding Sigfun_def + by (rule_tac lam_replacement_hcomp[of _ Union],simp_all) + +subsection\Particular instances\ + +lemma surj_imp_inj_replacement2: + "M(f) \ strong_replacement(M, \x z. z = Sigfun(x, \y. f -`` {y}))" + using lam_replacement_imp_strong_replacement lam_replacement_Sigfun + lam_replacement_vimage_sing_fun + by simp + +lemma lam_replacement_minimum_vimage: + "M(f) \ M(r) \ lam_replacement(M, \x. minimum(r, f -`` {x}))" + using lam_replacement_minimum lam_replacement_vimage_sing_fun lam_replacement_constant + by (rule_tac lam_replacement_hcomp2[of _ _ minimum]) + (force intro: lam_replacement_identity)+ + +lemmas surj_imp_inj_replacement4 = lam_replacement_minimum_vimage[unfolded lam_replacement_def] + +lemma lam_replacement_Pi: "M(y) \ lam_replacement(M, \x. \xa\y. {\x, xa\})" + using lam_replacement_Union lam_replacement_identity lam_replacement_constant + lam_replacement_RepFun_cons[THEN [5] lam_replacement_hcomp2] tag_singleton_closed + by (rule_tac lam_replacement_hcomp[of _ Union],simp_all) + +lemma Pi_replacement2: "M(y) \ strong_replacement(M, \x z. z = (\xa\y. {\x, xa\}))" + using lam_replacement_Pi[THEN lam_replacement_imp_strong_replacement, of y] +proof - + assume "M(y)" + then + have "M(x) \ M(\xa\y. {\x, xa\})" for x + using tag_singleton_closed + by (rule_tac Union_closed RepFun_closed) + with \M(y)\ + show ?thesis + using lam_replacement_Pi[THEN lam_replacement_imp_strong_replacement, of y] + by blast +qed + +lemma if_then_Inj_replacement: + shows "M(A) \ strong_replacement(M, \x y. y = \x, if x \ A then Inl(x) else Inr(x)\)" + using lam_replacement_if lam_replacement_Inl lam_replacement_Inr separation_in_constant + unfolding lam_replacement_def + by simp + +lemma lam_if_then_replacement: + "M(b) \ + M(a) \ M(f) \ strong_replacement(M, \y ya. ya = \y, if y = a then b else f ` y\)" + using lam_replacement_if lam_replacement_apply lam_replacement_constant + separation_equal + unfolding lam_replacement_def + by simp + +lemma if_then_replacement: + "M(A) \ M(f) \ M(g) \ strong_replacement(M, \x y. y = \x, if x \ A then f ` x else g ` x\)" + using lam_replacement_if lam_replacement_apply[of f] lam_replacement_apply[of g] + separation_in_constant + unfolding lam_replacement_def + by simp + +lemma ifx_replacement: + "M(f) \ + M(b) \ strong_replacement(M, \x y. y = \x, if x \ range(f) then converse(f) ` x else b\)" + using lam_replacement_if lam_replacement_apply lam_replacement_constant + separation_in_constant + unfolding lam_replacement_def + by simp + +lemma if_then_range_replacement2: + "M(A) \ M(C) \ strong_replacement(M, \x y. y = \x, if x = Inl(A) then C else x\)" + using lam_replacement_if lam_replacement_constant lam_replacement_identity + separation_equal + unfolding lam_replacement_def + by simp + +lemma if_then_range_replacement: + "M(u) \ + M(f) \ + strong_replacement + (M, + \z y. y = \z, if z = u then f ` 0 else if z \ range(f) then f ` succ(converse(f) ` z) else z\)" + using lam_replacement_if separation_equal separation_in_constant + lam_replacement_constant lam_replacement_identity + lam_replacement_succ lam_replacement_apply + lam_replacement_hcomp[of "\x. converse(f)`x" "succ"] + lam_replacement_hcomp[of "\x. succ(converse(f)`x)" "\x . f`x"] + unfolding lam_replacement_def + by simp + +lemma Inl_replacement2: + "M(A) \ + strong_replacement(M, \x y. y = \x, if fst(x) = A then Inl(snd(x)) else Inr(x)\)" + using lam_replacement_if separation_fst_equal + lam_replacement_hcomp[of "snd" "Inl"] + lam_replacement_Inl lam_replacement_Inr lam_replacement_snd + unfolding lam_replacement_def + by simp + +lemma case_replacement1: + "strong_replacement(M, \z y. y = \z, case(Inr, Inl, z)\)" + using lam_replacement_case lam_replacement_Inl lam_replacement_Inr + unfolding lam_replacement_def + by simp + +lemma case_replacement2: + "strong_replacement(M, \z y. y = \z, case(case(Inl, \y. Inr(Inl(y))), \y. Inr(Inr(y)), z)\)" + using lam_replacement_case lam_replacement_hcomp + case_closed[of Inl "\x. Inr(Inl(x))"] + lam_replacement_Inl lam_replacement_Inr + unfolding lam_replacement_def + by simp + +lemma case_replacement4: + "M(f) \ M(g) \ strong_replacement(M, \z y. y = \z, case(\w. Inl(f ` w), \y. Inr(g ` y), z)\)" + using lam_replacement_case lam_replacement_hcomp + lam_replacement_Inl lam_replacement_Inr lam_replacement_apply + unfolding lam_replacement_def + by simp + +lemma case_replacement5: + "strong_replacement(M, \x y. y = \x, (\\x,z\. case(\y. Inl(\y, z\), \y. Inr(\y, z\), x))(x)\)" + unfolding split_def case_def cond_def + using lam_replacement_if separation_equal_fst2 + lam_replacement_snd lam_replacement_Inl lam_replacement_Inr + lam_replacement_hcomp[OF + lam_replacement_product[OF + lam_replacement_hcomp[OF lam_replacement_fst lam_replacement_snd]]] + unfolding lam_replacement_def + by simp + +end \ \\<^locale>\M_replacement_extra\\ + +\ \To be used in the relativized treatment of Cohen posets\ +definition + \ \"domain collect F"\ + dC_F :: "i \ i \ i" where + "dC_F(A,d) \ {p \ A. domain(p) = d }" + +definition + \ \"domain restrict SepReplace Y"\ + drSR_Y :: "i \ i \ i \ i \ i" where + "drSR_Y(B,D,A,x) \ {y . r\A , restrict(r,B) = x \ y = domain(r) \ domain(r) \ D}" + +lemma drSR_Y_equality: "drSR_Y(B,D,A,x) = { dr\D . (\r\A . restrict(r,B) = x \ dr=domain(r)) }" + unfolding drSR_Y_def by auto + +context M_replacement_extra +begin + +lemma separation_restrict_eq_dom_eq:"\x[M].separation(M, \dr. \r\A . restrict(r,B) = x \ dr=domain(r))" + if "M(A)" and "M(B)" for A B + using that + separation_eq[OF _ + lam_replacement_fst _ + lam_replacement_hcomp[OF lam_replacement_snd lam_replacement_domain ]] + separation_eq[OF _ + lam_replacement_hcomp[OF lam_replacement_snd lam_replacement_restrict'] _ + lam_replacement_constant] + by(clarify,rule_tac separation_bex[OF _ \M(A)\],rule_tac separation_conj,simp_all) + + +lemma separation_is_insnd_restrict_eq_dom : "separation(M, \p. \x\D. x \ snd(p) \ (\r\A. restrict(r, B) = fst(p) \ x = domain(r)))" + if "M(B)" "M(D)" "M(A)" for A B D + using that lam_replacement_fst lam_replacement_hcomp lam_replacement_snd separation_in + separation_eq[OF _ + lam_replacement_hcomp[OF lam_replacement_fst lam_replacement_snd] _ + lam_replacement_hcomp[OF lam_replacement_snd lam_replacement_domain]] + separation_eq separation_restrict_eq_dom_eq + lam_replacement_hcomp[OF lam_replacement_snd lam_replacement_restrict'] + lam_replacement_hcomp[OF lam_replacement_fst + lam_replacement_hcomp[OF lam_replacement_fst lam_replacement_fst]] + by(rule_tac separation_ball,rule_tac separation_iff',simp_all, + rule_tac separation_bex[OF _ \M(A)\],rule_tac separation_conj,simp_all) + +lemma lam_replacement_drSR_Y: + assumes + "M(B)" "M(D)" "M(A)" + shows "lam_replacement(M, drSR_Y(B,D,A))" + using lam_replacement_cong lam_replacement_Collect[OF \M(D)\ separation_restrict_eq_dom_eq[of A B]] + assms drSR_Y_equality separation_is_insnd_restrict_eq_dom separation_restrict_eq_dom_eq + by simp + +lemma drSR_Y_closed: + assumes + "M(B)" "M(D)" "M(A)" "M(f)" + shows "M(drSR_Y(B,D,A,f))" + using assms drSR_Y_equality lam_replacement_Collect[OF \M(D)\ separation_restrict_eq_dom_eq[of A B]] + assms drSR_Y_equality separation_is_insnd_restrict_eq_dom separation_restrict_eq_dom_eq + by simp + +lemma lam_if_then_apply_replacement: "M(f) \ M(v) \ M(u) \ + lam_replacement(M, \x. if f ` x = v then f ` u else f ` x)" + using lam_replacement_if separation_equal_apply lam_replacement_constant lam_replacement_apply + by simp + +lemma lam_if_then_apply_replacement2: "M(f) \ M(m) \ M(y) \ + lam_replacement(M, \z . if f ` z = m then y else f ` z)" + using lam_replacement_if separation_equal_apply lam_replacement_constant lam_replacement_apply + by simp + +lemma lam_if_then_replacement2: "M(A) \ M(f) \ + lam_replacement(M, \x . if x \ A then f ` x else x)" + using lam_replacement_if separation_in_constant lam_replacement_identity lam_replacement_apply + by simp + +lemma lam_if_then_replacement_apply: "M(G) \ lam_replacement(M, \x. if M(x) then G ` x else 0)" + using lam_replacement_if separation_in_constant lam_replacement_identity lam_replacement_apply + lam_replacement_constant[of 0] separation_univ + by simp + +lemma lam_replacement_dC_F: + assumes "M(A)" + shows "lam_replacement(M, dC_F(A))" +proof - + have "separation(M, \p. \x\A. x \ snd(p) \ domain(x) = fst(p))" if "M(A)" for A + using separation_ball separation_iff' + lam_replacement_hcomp lam_replacement_fst lam_replacement_snd lam_replacement_domain + separation_in separation_eq that + by simp_all + then + show ?thesis + unfolding dC_F_def + using assms lam_replacement_Collect[of A "\ d x . domain(x) = d"] + separation_eq[OF _ lam_replacement_domain _ lam_replacement_constant] + by simp +qed + +lemma dCF_closed: + assumes "M(A)" "M(f)" + shows "M(dC_F(A,f))" + unfolding dC_F_def + using assms lam_replacement_Collect[of A "\ d x . domain(x) = d"] + separation_eq[OF _ lam_replacement_domain _ lam_replacement_constant] + by simp + +lemma lam_replacement_min: "M(f) \ M(r) \ lam_replacement(M, \x . minimum(r, f -`` {x}))" + using lam_replacement_hcomp2[OF lam_replacement_constant[of r] lam_replacement_vimage_sing_fun] + lam_replacement_minimum + by simp + +lemma lam_replacement_Collect_ball_Pair: + assumes "separation(M, \p. \x\G. x \ snd(p) \ (\s\fst(p). \s, x\ \ Q))" "M(G)" "M(Q)" + shows "lam_replacement(M, \x . {a \ G . \s\x. \s, a\ \ Q})" +proof - + have 1:"\x[M]. separation(M, \a . \s\x. \s, a\ \ Q)" if "M(Q)" for Q + using separation_in lam_replacement_hcomp2[OF _ _ _ _ lam_replacement_Pair] + lam_replacement_constant separation_ball + lam_replacement_hcomp lam_replacement_fst lam_replacement_snd that + by simp + then + show ?thesis + using assms lam_replacement_Collect + by simp_all +qed + +lemma surj_imp_inj_replacement3: + "(\x. M(x) \ separation(M, \y. \s\x. \s, y\ \ Q)) \ M(G) \ M(Q) \ M(x) \ + strong_replacement(M, \y z. y \ {a \ G . \s\x. \s, a\ \ Q} \ z = {\x, y\})" + using lam_replacement_imp_strong_replacement + using lam_replacement_sing_const_id[THEN lam_replacement_imp_strong_replacement, of x] + unfolding strong_replacement_def + by (simp, safe, drule_tac x="A \ {a \ G . \s\x. \s, a\ \ Q}" in rspec, + simp, erule_tac rexE, rule_tac x=Y in rexI) auto + +lemmas replacements = Pair_diff_replacement id_replacement tag_replacement + pospend_replacement prepend_replacement + Inl_replacement1 diff_Pair_replacement + swap_replacement tag_union_replacement csquare_lam_replacement + assoc_replacement prod_fun_replacement + cardinal_lib_assms4 domain_replacement + apply_replacement + un_Pair_replacement restrict_strong_replacement diff_replacement + if_then_Inj_replacement lam_if_then_replacement if_then_replacement + ifx_replacement if_then_range_replacement2 if_then_range_replacement + Inl_replacement2 + case_replacement1 case_replacement2 case_replacement4 case_replacement5 + +end \ \\<^locale>\M_replacement_extra\\ + +end \ No newline at end of file diff --git a/thys/Transitive_Models/Least.thy b/thys/Transitive_Models/Least.thy new file mode 100644 --- /dev/null +++ b/thys/Transitive_Models/Least.thy @@ -0,0 +1,164 @@ +section\The binder \<^term>\Least\\ +theory Least + imports + "Internalizations" + +begin + +text\We have some basic results on the least ordinal satisfying +a predicate.\ + +lemma Least_Ord: "(\ \. R(\)) = (\ \. Ord(\) \ R(\))" + unfolding Least_def by (simp add:lt_Ord) + +lemma Ord_Least_cong: + assumes "\y. Ord(y) \ R(y) \ Q(y)" + shows "(\ \. R(\)) = (\ \. Q(\))" +proof - + from assms + have "(\ \. Ord(\) \ R(\)) = (\ \. Ord(\) \ Q(\))" + by simp + then + show ?thesis using Least_Ord by simp +qed + +definition + least :: "[i\o,i\o,i] \ o" where + "least(M,Q,i) \ ordinal(M,i) \ ( + (empty(M,i) \ (\b[M]. ordinal(M,b) \ \Q(b))) + \ (Q(i) \ (\b[M]. ordinal(M,b) \ b\i\ \Q(b))))" + +definition + least_fm :: "[i,i] \ i" where + "least_fm(q,i) \ And(ordinal_fm(i), + Or(And(empty_fm(i),Forall(Implies(ordinal_fm(0),Neg(q)))), + And(Exists(And(q,Equal(0,succ(i)))), + Forall(Implies(And(ordinal_fm(0),Member(0,succ(i))),Neg(q))))))" + +lemma least_fm_type[TC] :"i \ nat \ q\formula \ least_fm(q,i) \ formula" + unfolding least_fm_def + by simp + +(* Refactorize Formula and Relative to include the following three lemmas *) +lemmas basic_fm_simps = sats_subset_fm' sats_transset_fm' sats_ordinal_fm' + +lemma sats_least_fm : + assumes p_iff_sats: + "\a. a \ A \ P(a) \ sats(A, p, Cons(a, env))" + shows + "\y \ nat; env \ list(A) ; 0\A\ + \ sats(A, least_fm(p,y), env) \ + least(##A, P, nth(y,env))" + using nth_closed p_iff_sats unfolding least_def least_fm_def + by (simp add:basic_fm_simps) + +lemma least_iff_sats [iff_sats]: + assumes is_Q_iff_sats: + "\a. a \ A \ is_Q(a) \ sats(A, q, Cons(a,env))" + shows + "\nth(j,env) = y; j \ nat; env \ list(A); 0\A\ + \ least(##A, is_Q, y) \ sats(A, least_fm(q,j), env)" + using sats_least_fm [OF is_Q_iff_sats, of j , symmetric] + by simp + +lemma least_conj: "a\M \ least(##M, \x. x\M \ Q(x),a) \ least(##M,Q,a)" + unfolding least_def by simp + + +context M_trivial +begin + +subsection\Uniqueness, absoluteness and closure under \<^term>\Least\\ + +lemma unique_least: + assumes "M(a)" "M(b)" "least(M,Q,a)" "least(M,Q,b)" + shows "a=b" +proof - + from assms + have "Ord(a)" "Ord(b)" + unfolding least_def + by simp_all + then + consider (le) "a\b" | "a=b" | (ge) "b\a" + using Ord_linear[OF \Ord(a)\ \Ord(b)\] by auto + then + show ?thesis + proof(cases) + case le + then show ?thesis using assms unfolding least_def by auto + next + case ge + then show ?thesis using assms unfolding least_def by auto + qed +qed + +lemma least_abs: + assumes "\x. Q(x) \ Ord(x) \ \y[M]. Q(y) \ Ord(y)" "M(a)" + shows "least(M,Q,a) \ a = (\ x. Q(x))" + unfolding least_def +proof (cases "\b[M]. Ord(b) \ \ Q(b)"; intro iffI; simp add:assms) + case True + with assms + have "\ (\i. Ord(i) \ Q(i)) " by blast + then + show "0 =(\ x. Q(x))" using Least_0 by simp + then + show "ordinal(M, \ x. Q(x)) \ (empty(M, Least(Q)) \ Q(Least(Q)))" + by simp +next + assume "\b[M]. Ord(b) \ Q(b)" + then + obtain i where "M(i)" "Ord(i)" "Q(i)" by blast + assume "a = (\ x. Q(x))" + moreover + note \M(a)\ + moreover from \Q(i)\ \Ord(i)\ + have "Q(\ x. Q(x))" (is ?G) + by (blast intro:LeastI) + moreover + have "(\b[M]. Ord(b) \ b \ (\ x. Q(x)) \ \ Q(b))" (is "?H") + using less_LeastE[of Q _ False] + by (auto, drule_tac ltI, simp, blast) + ultimately + show "ordinal(M, \ x. Q(x)) \ (empty(M, \ x. Q(x)) \ (\b[M]. Ord(b) \ \ Q(b)) \ ?G \ ?H)" + by simp +next + assume 1:"\b[M]. Ord(b) \ Q(b)" + then + obtain i where "M(i)" "Ord(i)" "Q(i)" by blast + assume "Ord(a) \ (a = 0 \ (\b[M]. Ord(b) \ \ Q(b)) \ Q(a) \ (\b[M]. Ord(b) \ b \ a \ \ Q(b)))" + with 1 + have "Ord(a)" "Q(a)" "\b[M]. Ord(b) \ b \ a \ \ Q(b)" + by blast+ + moreover from this and assms + have "Ord(b) \ b \ a \ \ Q(b)" for b + by (auto dest:transM) + moreover from this and \Ord(a)\ + have "b < a \ \ Q(b)" for b + unfolding lt_def using Ord_in_Ord by blast + ultimately + show "a = (\ x. Q(x))" + using Least_equality by simp +qed + +lemma Least_closed: + assumes "\x. Q(x) \ Ord(x) \ \y[M]. Q(y) \ Ord(y)" + shows "M(\ x. Q(x))" + using assms Least_le[of Q] Least_0[of Q] + by (cases "(\i[M]. Ord(i) \ Q(i))") (force dest:transM ltD)+ + +text\Older, easier to apply versions (with a simpler assumption +on \<^term>\Q\).\ +lemma least_abs': + assumes "\x. Q(x) \ M(x)" "M(a)" + shows "least(M,Q,a) \ a = (\ x. Q(x))" + using assms least_abs[of Q] by auto + +lemma Least_closed': + assumes "\x. Q(x) \ M(x)" + shows "M(\ x. Q(x))" + using assms Least_closed[of Q] by auto + +end \ \\<^locale>\M_trivial\\ + +end \ No newline at end of file diff --git a/thys/Transitive_Models/M_Basic_No_Repl.thy b/thys/Transitive_Models/M_Basic_No_Repl.thy new file mode 100644 --- /dev/null +++ b/thys/Transitive_Models/M_Basic_No_Repl.thy @@ -0,0 +1,320 @@ +theory M_Basic_No_Repl + imports "ZF-Constructible.Relative" +begin + +txt\This locale is exactly \<^locale>\M_basic\ without its only replacement +instance.\ + +locale M_basic_no_repl = M_trivial + + assumes Inter_separation: + "M(A) ==> separation(M, \x. \y[M]. y\A \ x\y)" + and Diff_separation: + "M(B) ==> separation(M, \x. x \ B)" + and cartprod_separation: + "[| M(A); M(B) |] + ==> separation(M, \z. \x[M]. x\A & (\y[M]. y\B & pair(M,x,y,z)))" + and image_separation: + "[| M(A); M(r) |] + ==> separation(M, \y. \p[M]. p\r & (\x[M]. x\A & pair(M,x,y,p)))" + and converse_separation: + "M(r) ==> separation(M, + \z. \p[M]. p\r & (\x[M]. \y[M]. pair(M,x,y,p) & pair(M,y,x,z)))" + and restrict_separation: + "M(A) ==> separation(M, \z. \x[M]. x\A & (\y[M]. pair(M,x,y,z)))" + and comp_separation: + "[| M(r); M(s) |] + ==> separation(M, \xz. \x[M]. \y[M]. \z[M]. \xy[M]. \yz[M]. + pair(M,x,z,xz) & pair(M,x,y,xy) & pair(M,y,z,yz) & + xy\s & yz\r)" + and pred_separation: + "[| M(r); M(x) |] ==> separation(M, \y. \p[M]. p\r & pair(M,y,x,p))" + and Memrel_separation: + "separation(M, \z. \x[M]. \y[M]. pair(M,x,y,z) & x \ y)" + and is_recfun_separation: + \ \for well-founded recursion: used to prove \is_recfun_equal\\ + "[| M(r); M(f); M(g); M(a); M(b) |] + ==> separation(M, + \x. \xa[M]. \xb[M]. + pair(M,x,a,xa) & xa \ r & pair(M,x,b,xb) & xb \ r & + (\fx[M]. \gx[M]. fun_apply(M,f,x,fx) & fun_apply(M,g,x,gx) & + fx \ gx))" + and power_ax: "power_ax(M)" + +lemma (in M_basic_no_repl) cartprod_iff: + "[| M(A); M(B); M(C) |] + ==> cartprod(M,A,B,C) \ + (\p1[M]. \p2[M]. powerset(M,A \ B,p1) & powerset(M,p1,p2) & + C = {z \ p2. \x\A. \y\B. z = })" + apply (simp add: Pair_def cartprod_def, safe) + defer 1 + apply (simp add: powerset_def) + apply blast + txt\Final, difficult case: the left-to-right direction of the theorem.\ + apply (insert power_ax, simp add: power_ax_def) + apply (frule_tac x="A \ B" and P="\x. rex(M,Q(x))" for Q in rspec) + apply (blast, clarify) + apply (drule_tac x=z and P="\x. rex(M,Q(x))" for Q in rspec) + apply assumption + apply (blast intro: cartprod_iff_lemma) + done + +lemma (in M_basic_no_repl) cartprod_closed_lemma: + "[| M(A); M(B) |] ==> \C[M]. cartprod(M,A,B,C)" + apply (simp del: cartprod_abs add: cartprod_iff) + apply (insert power_ax, simp add: power_ax_def) + apply (frule_tac x="A \ B" and P="\x. rex(M,Q(x))" for Q in rspec) + apply (blast, clarify) + apply (drule_tac x=z and P="\x. rex(M,Q(x))" for Q in rspec, auto) + apply (intro rexI conjI, simp+) + apply (insert cartprod_separation [of A B], simp) + done + +text\All the lemmas above are necessary because Powerset is not absolute. + I should have used Replacement instead!\ +lemma (in M_basic_no_repl) cartprod_closed [intro,simp]: + "[| M(A); M(B) |] ==> M(A*B)" + by (frule cartprod_closed_lemma, assumption, force) + +lemma (in M_basic_no_repl) sum_closed [intro,simp]: + "[| M(A); M(B) |] ==> M(A+B)" + by (simp add: sum_def) + +lemma (in M_basic_no_repl) sum_abs [simp]: + "[| M(A); M(B); M(Z) |] ==> is_sum(M,A,B,Z) \ (Z = A+B)" + by (simp add: is_sum_def sum_def singleton_0 nat_into_M) + +lemma (in M_basic_no_repl) M_converse_iff: + "M(r) ==> + converse(r) = + {z \ \(\(r)) * \(\(r)). + \p\r. \x[M]. \y[M]. p = \x,y\ & z = \y,x\}" + apply (rule equalityI) + prefer 2 apply (blast dest: transM, clarify, simp) + apply (simp add: Pair_def) + apply (blast dest: transM) + done + +lemma (in M_basic_no_repl) converse_closed [intro,simp]: + "M(r) ==> M(converse(r))" + apply (simp add: M_converse_iff) + apply (insert converse_separation [of r], simp) + done + +lemma (in M_basic_no_repl) converse_abs [simp]: + "[| M(r); M(z) |] ==> is_converse(M,r,z) \ z = converse(r)" + apply (simp add: is_converse_def) + apply (rule iffI) + prefer 2 apply blast + apply (rule M_equalityI) + apply simp + apply (blast dest: transM)+ + done + + +subsubsection \image, preimage, domain, range\ + +lemma (in M_basic_no_repl) image_closed [intro,simp]: + "[| M(A); M(r) |] ==> M(r``A)" + apply (simp add: image_iff_Collect) + apply (insert image_separation [of A r], simp) + done + +lemma (in M_basic_no_repl) vimage_abs [simp]: + "[| M(r); M(A); M(z) |] ==> pre_image(M,r,A,z) \ z = r-``A" + apply (simp add: pre_image_def) + apply (rule iffI) + apply (blast intro!: equalityI dest: transM, blast) + done + +lemma (in M_basic_no_repl) vimage_closed [intro,simp]: + "[| M(A); M(r) |] ==> M(r-``A)" + by (simp add: vimage_def) + + +subsubsection\Domain, range and field\ + +lemma (in M_basic_no_repl) domain_closed [intro,simp]: + "M(r) ==> M(domain(r))" + apply (simp add: domain_eq_vimage) + done + +lemma (in M_basic_no_repl) range_closed [intro,simp]: + "M(r) ==> M(range(r))" + apply (simp add: range_eq_image) + done + +lemma (in M_basic_no_repl) field_abs [simp]: + "[| M(r); M(z) |] ==> is_field(M,r,z) \ z = field(r)" + by (simp add: is_field_def field_def) + +lemma (in M_basic_no_repl) field_closed [intro,simp]: + "M(r) ==> M(field(r))" + by (simp add: field_def) + + +subsubsection\Relations, functions and application\ + +lemma (in M_basic_no_repl) apply_closed [intro,simp]: + "[|M(f); M(a)|] ==> M(f`a)" + by (simp add: apply_def) + +lemma (in M_basic_no_repl) apply_abs [simp]: + "[| M(f); M(x); M(y) |] ==> fun_apply(M,f,x,y) \ f`x = y" + apply (simp add: fun_apply_def apply_def, blast) + done + +lemma (in M_basic_no_repl) injection_abs [simp]: + "[| M(A); M(f) |] ==> injection(M,A,B,f) \ f \ inj(A,B)" + apply (simp add: injection_def apply_iff inj_def) + apply (blast dest: transM [of _ A]) + done + +lemma (in M_basic_no_repl) surjection_abs [simp]: + "[| M(A); M(B); M(f) |] ==> surjection(M,A,B,f) \ f \ surj(A,B)" + by (simp add: surjection_def surj_def) + +lemma (in M_basic_no_repl) bijection_abs [simp]: + "[| M(A); M(B); M(f) |] ==> bijection(M,A,B,f) \ f \ bij(A,B)" + by (simp add: bijection_def bij_def) + + +subsubsection\Composition of relations\ + +lemma (in M_basic_no_repl) M_comp_iff: + "[| M(r); M(s) |] + ==> r O s = + {xz \ domain(s) * range(r). + \x[M]. \y[M]. \z[M]. xz = \x,z\ & \x,y\ \ s & \y,z\ \ r}" + apply (simp add: comp_def) + apply (rule equalityI) + apply clarify + apply simp + apply (blast dest: transM)+ + done + +lemma (in M_basic_no_repl) comp_closed [intro,simp]: + "[| M(r); M(s) |] ==> M(r O s)" + apply (simp add: M_comp_iff) + apply (insert comp_separation [of r s], simp) + done + +lemma (in M_basic_no_repl) composition_abs [simp]: + "[| M(r); M(s); M(t) |] ==> composition(M,r,s,t) \ t = r O s" + apply safe + txt\Proving \<^term>\composition(M, r, s, r O s)\\ + prefer 2 + apply (simp add: composition_def comp_def) + apply (blast dest: transM) + txt\Opposite implication\ + apply (rule M_equalityI) + apply (simp add: composition_def comp_def) + apply (blast del: allE dest: transM)+ + done + +text\no longer needed\ +lemma (in M_basic_no_repl) restriction_is_function: + "[| restriction(M,f,A,z); function(f); M(f); M(A); M(z) |] + ==> function(z)" + apply (simp add: restriction_def ball_iff_equiv) + apply (unfold function_def, blast) + done + +lemma (in M_basic_no_repl) restrict_closed [intro,simp]: + "[| M(A); M(r) |] ==> M(restrict(r,A))" + apply (simp add: M_restrict_iff) + apply (insert restrict_separation [of A], simp) + done + +lemma (in M_basic_no_repl) Inter_closed [intro,simp]: + "M(A) ==> M(\(A))" + by (insert Inter_separation, simp add: Inter_def) + +lemma (in M_basic_no_repl) Int_closed [intro,simp]: + "[| M(A); M(B) |] ==> M(A \ B)" + apply (subgoal_tac "M({A,B})") + apply (frule Inter_closed, force+) + done + +lemma (in M_basic_no_repl) Diff_closed [intro,simp]: + "[|M(A); M(B)|] ==> M(A-B)" + by (insert Diff_separation, simp add: Diff_def) + +subsubsection\Some Facts About Separation Axioms\ + +lemma (in M_basic_no_repl) separation_conj: + "[|separation(M,P); separation(M,Q)|] ==> separation(M, \z. P(z) & Q(z))" + by (simp del: separation_closed + add: separation_iff Collect_Int_Collect_eq [symmetric]) + +lemma (in M_basic_no_repl) separation_disj: + "[|separation(M,P); separation(M,Q)|] ==> separation(M, \z. P(z) | Q(z))" + by (simp del: separation_closed + add: separation_iff Collect_Un_Collect_eq [symmetric]) + +lemma (in M_basic_no_repl) separation_neg: + "separation(M,P) ==> separation(M, \z. ~P(z))" + by (simp del: separation_closed + add: separation_iff Diff_Collect_eq [symmetric]) + +lemma (in M_basic_no_repl) separation_imp: + "[|separation(M,P); separation(M,Q)|] + ==> separation(M, \z. P(z) \ Q(z))" + by (simp add: separation_neg separation_disj not_disj_iff_imp [symmetric]) + +text\This result is a hint of how little can be done without the Reflection + Theorem. The quantifier has to be bounded by a set. We also need another + instance of Separation!\ +lemma (in M_basic_no_repl) separation_rall: + "[|M(Y); \y[M]. separation(M, \x. P(x,y)); + \z[M]. strong_replacement(M, \x y. y = {u \ z . P(u,x)})|] + ==> separation(M, \x. \y[M]. y\Y \ P(x,y))" + apply (simp del: separation_closed rall_abs + add: separation_iff Collect_rall_eq) + apply (blast intro!: RepFun_closed dest: transM) + done + + +subsubsection\Functions and function space\ + +lemma (in M_basic_no_repl) succ_fun_eq2: + "[|M(B); M(n->B)|] ==> + succ(n) -> B = + \{z. p \ (n->B)*B, \f[M]. \b[M]. p = & z = {cons(, f)}}" + apply (simp add: succ_fun_eq) + apply (blast dest: transM) + done + +(* lemma (in M_basic_no_repl) funspace_succ: + "[|M(n); M(B); M(n->B) |] ==> M(succ(n) -> B)" +apply (insert funspace_succ_replacement [of n], simp) +apply (force simp add: succ_fun_eq2 univalent_def) +done + +text\\<^term>\M\ contains all finite function spaces. Needed to prove the +absoluteness of transitive closure. See the definition of +\rtrancl_alt\ in in \WF_absolute.thy\.\ +lemma (in M_basic_no_repl) finite_funspace_closed [intro,simp]: + "[|n\nat; M(B)|] ==> M(n->B)" +apply (induct_tac n, simp) +apply (simp add: funspace_succ nat_into_M) +done + *) + +lemma (in M_basic_no_repl) list_case'_closed [intro,simp]: + "[|M(k); M(a); \x[M]. \y[M]. M(b(x,y))|] ==> M(list_case'(a,b,k))" + apply (case_tac "quasilist(k)") + apply (simp add: quasilist_def, force) + apply (simp add: non_list_case) + done + +lemma (in M_basic_no_repl) tl'_closed: "M(x) ==> M(tl'(x))" + apply (simp add: tl'_def) + apply (force simp add: quasilist_def) + done + +sublocale M_basic \ mbnr:M_basic_no_repl + using Inter_separation Diff_separation cartprod_separation image_separation + converse_separation restrict_separation comp_separation pred_separation + Memrel_separation is_recfun_separation power_ax by unfold_locales + +end diff --git a/thys/Transitive_Models/Nat_Miscellanea.thy b/thys/Transitive_Models/Nat_Miscellanea.thy new file mode 100644 --- /dev/null +++ b/thys/Transitive_Models/Nat_Miscellanea.thy @@ -0,0 +1,282 @@ +section\Auxiliary results on arithmetic\ + +theory Nat_Miscellanea + imports + Delta_System_Lemma.ZF_Library +begin + +(* no_notation add (infixl \#+\ 65) +no_notation diff (infixl \#-\ 65) *) +notation add (infixl \+\<^sub>\\ 65) +notation diff (infixl \-\<^sub>\\ 65) + +text\Most of these results will get used at some point for the +calculation of arities.\ + +lemmas nat_succI = Ord_succ_mem_iff [THEN iffD2,OF nat_into_Ord] + +lemma nat_succD : "m \ nat \ succ(n) \ succ(m) \ n \ m" + by (drule_tac j="succ(m)" in ltI,auto elim:ltD) + +lemmas zero_in_succ = ltD [OF nat_0_le] + +lemma in_n_in_nat : "m \ nat \ n \ m \ n \ nat" + by(drule ltI[of "n"],auto simp add: lt_nat_in_nat) + +lemma ltI_neg : "x \ nat \ j \ x \ j \ x \ j < x" + by (simp add: le_iff) + +lemma succ_pred_eq : "m \ nat \ m \ 0 \ succ(pred(m)) = m" + by (auto elim: natE) + +lemma succ_ltI : "succ(j) < n \ j < n" + by (simp add: succ_leE[OF leI]) + +lemmas succ_leD = succ_leE[OF leI] + +lemma succpred_leI : "n \ nat \ n \ succ(pred(n))" + by (auto elim: natE) + +lemma succpred_n0 : "succ(n) \ p \ p\0" + by (auto) + +lemmas natEin = natE [OF lt_nat_in_nat] + +lemmas Un_least_lt_iffn = Un_least_lt_iff [OF nat_into_Ord nat_into_Ord] + +lemma pred_type : "m \ nat \ n \ m \ n\nat" + by (rule leE,auto simp:in_n_in_nat ltD) + +lemma pred_le : "m \ nat \ n \ succ(m) \ pred(n) \ m" + by(rule_tac n="n" in natE,auto simp add:pred_type[of "succ(m)"]) + +lemma pred_le2 : "n\ nat \ m \ nat \ pred(n) \ m \ n \ succ(m)" + by(subgoal_tac "n\nat",rule_tac n="n" in natE,auto) + +lemma Un_leD1 : "Ord(i)\ Ord(j)\ Ord(k)\ i \ j \ k \ i \ k" + by (rule Un_least_lt_iff[THEN iffD1[THEN conjunct1]],simp_all) + +lemma Un_leD2 : "Ord(i)\ Ord(j)\ Ord(k)\ i \ j \k \ j \ k" + by (rule Un_least_lt_iff[THEN iffD1[THEN conjunct2]],simp_all) + +lemma gt1 : "n \ nat \ i \ n \ i \ 0 \ i \ 1 \ 1 nat \ n \ m \ pred(n) \ pred(m)" + by(rule_tac n="n" in natE,auto simp add:le_in_nat,erule_tac n="m" in natE,auto) + +lemma succ_mono : "m \ nat \ n \ m \ succ(n) \ succ(m)" + by auto + +lemma union_abs1 : + "\ i \ j \ \ i \ j = j" + by (rule Un_absorb1,erule le_imp_subset) + +lemma union_abs2 : + "\ i \ j \ \ j \ i = j" + by (rule Un_absorb2,erule le_imp_subset) + +lemma ord_un_max : "Ord(i) \ Ord(j) \ i \ j = max(i,j)" + using max_def union_abs1 not_lt_iff_le leI union_abs2 + by auto + +lemma ord_max_ty : "Ord(i) \Ord(j) \ Ord(max(i,j))" + unfolding max_def by simp + +lemmas ord_simp_union = ord_un_max ord_max_ty max_def + +lemma le_succ : "x\nat \ x\succ(x)" by simp + +lemma le_pred : "x\nat \ pred(x)\x" + using pred_le[OF _ le_succ] pred_succ_eq + by simp + +lemma not_le_anti_sym : "x\nat \ y \ nat \ \ x\y \ \y\x \ y=x" + using Ord_linear not_le_iff_lt ltD lt_trans + by auto + +lemma Un_le_compat : "o \ p \ q \ r \ Ord(o) \ Ord(p) \ Ord(q) \ Ord(r) \ o \ q \ p \ r" + using le_trans[of q r "p\r",OF _ Un_upper2_le] le_trans[of o p "p\r",OF _ Un_upper1_le] + ord_simp_union + by auto + +lemma Un_le : "p \ r \ q \ r \ + Ord(p) \ Ord(q) \ Ord(r) \ + p \ q \ r" + using ord_simp_union by auto + +lemma Un_leI3 : "o \ r \ p \ r \ q \ r \ + Ord(o) \ Ord(p) \ Ord(q) \ Ord(r) \ + o \ p \ q \ r" + using ord_simp_union by auto + +lemma diff_mono : + assumes "m \ nat" "n\nat" "p \ nat" "m < n" "p\m" + shows "m#-p < n#-p" +proof - + from assms + have "m#-p \ nat" "m#-p +\<^sub>\p = m" + using add_diff_inverse2 by simp_all + with assms + show ?thesis + using less_diff_conv[of n p "m #- p",THEN iffD2] by simp +qed + +lemma pred_Un: + "x \ nat \ y \ nat \ pred(succ(x) \ y) = x \ pred(y)" + "x \ nat \ y \ nat \ pred(x \ succ(y)) = pred(x) \ y" + using pred_Un_distrib pred_succ_eq by simp_all + +lemma le_natI : "j \ n \ n \ nat \ j\nat" + by(drule ltD,rule in_n_in_nat,rule nat_succ_iff[THEN iffD2,of n],simp_all) + +lemma le_natE : "n\nat \ j < n \ j\n" + by(rule ltE[of j n],simp+) + +lemma leD : assumes "n\nat" "j \ n" + shows "j < n | j = n" + using leE[OF \j\n\,of "jnat" + shows "pred(n) = \ n" + using assms +proof(induct) + case 0 + then show ?case by simp +next + case (succ x) + then show ?case using pred_succ_eq Ord_Union_succ_eq + by simp +qed + +subsection\Some results in ordinal arithmetic\ +text\The following results are auxiliary to the proof of +wellfoundedness of the relation \<^term>\frecR\\ + +lemma max_cong : + assumes "x \ y" "Ord(y)" "Ord(z)" + shows "max(x,y) \ max(y,z)" +proof (cases "y \ z") + case True + then show ?thesis + unfolding max_def using assms by simp +next + case False + then have "z \ y" using assms not_le_iff_lt leI by simp + then show ?thesis + unfolding max_def using assms by simp +qed + +lemma max_commutes : + assumes "Ord(x)" "Ord(y)" + shows "max(x,y) = max(y,x)" + using assms Un_commute ord_simp_union(1) ord_simp_union(1)[symmetric] by auto + +lemma max_cong2 : + assumes "x \ y" "Ord(y)" "Ord(z)" "Ord(x)" + shows "max(x,z) \ max(y,z)" +proof - + from assms + have " x \ z \ y \ z" + using lt_Ord Ord_Un Un_mono[OF le_imp_subset[OF \x\y\]] subset_imp_le by auto + then show ?thesis + using ord_simp_union \Ord(x)\ \Ord(z)\ \Ord(y)\ by simp +qed + +lemma max_D1 : + assumes "x = y" "w < z" "Ord(x)" "Ord(w)" "Ord(z)" "max(x,w) = max(y,z)" + shows "z\y" +proof - + from assms + have "w < x \ w" using Un_upper2_lt[OF \w] assms ord_simp_union by simp + then + have "w < x" using assms lt_Un_iff[of x w w] lt_not_refl by auto + then + have "y = y \ z" using assms max_commutes ord_simp_union assms leI by simp + then + show ?thesis using Un_leD2 assms by simp +qed + +lemma max_D2 : + assumes "w = y \ w = z" "x < y" "Ord(x)" "Ord(w)" "Ord(y)" "Ord(z)" "max(x,w) = max(y,z)" + shows "x y" using Un_upper2_lt[OF \x] by simp + then + consider (a) "x < y" | (b) "x < w" + using assms ord_simp_union by simp + then show ?thesis proof (cases) + case a + consider (c) "w = y" | (d) "w = z" + using assms by auto + then show ?thesis proof (cases) + case c + with a show ?thesis by simp + next + case d + with a + show ?thesis + proof (cases "y x] by simp + next + case False + then + have "w \ y" + using not_lt_iff_le[OF assms(5) assms(4)] by simp + with \w=z\ + have "max(z,y) = y" unfolding max_def using assms by simp + with assms + have "... = x \ w" using ord_simp_union max_commutes by simp + then show ?thesis using le_Un_iff assms by blast + qed + qed + next + case b + then show ?thesis . + qed +qed + +lemma oadd_lt_mono2 : + assumes "Ord(n)" "Ord(\)" "Ord(\)" "\ < \" "x < n" "y < n" "0 + x < n **\ + y" +proof - + consider (0) "\=0" | (s) \ where "Ord(\)" "\ = succ(\)" | (l) "Limit(\)" + using Ord_cases[OF \Ord(\)\,of ?thesis] by force + then show ?thesis + proof cases + case 0 + then show ?thesis using \\<\\ by auto + next + case s + then + have "\\\" using \\<\\ using leI by auto + then + have "n ** \ \ n ** \" using omult_le_mono[OF _ \\\\\] \Ord(n)\ by simp + then + have "n ** \ + x < n ** \ + n" using oadd_lt_mono[OF _ \x] by simp + also + have "... = n ** \" using \\=succ(_)\ omult_succ \Ord(\)\ \Ord(n)\ by simp + finally + have "n ** \ + x < n ** \" by auto + then + show ?thesis using oadd_le_self \Ord(\)\ lt_trans2 \Ord(n)\ by auto + next + case l + have "Ord(x)" using \x lt_Ord by simp + with l + have "succ(\) < \" using Limit_has_succ \\<\\ by simp + have "n ** \ + x < n ** \ + n" + using oadd_lt_mono[OF le_refl[OF Ord_omult[OF _ \Ord(\)\]] \x] \Ord(n)\ by simp + also + have "... = n ** succ(\)" using omult_succ \Ord(\)\ \Ord(n)\ by simp + finally + have "n ** \ + x < n ** succ(\)" by simp + with \succ(\) < \\ + have "n ** \ + x < n ** \" using lt_trans omult_lt_mono \Ord(n)\ \0 by auto + then show ?thesis using oadd_le_self \Ord(\)\ lt_trans2 \Ord(n)\ by auto + qed +qed +end diff --git a/thys/Transitive_Models/Partial_Functions_Relative.thy b/thys/Transitive_Models/Partial_Functions_Relative.thy new file mode 100644 --- /dev/null +++ b/thys/Transitive_Models/Partial_Functions_Relative.thy @@ -0,0 +1,702 @@ +section\Cohen forcing notions\ + +theory Partial_Functions_Relative + imports + Cardinal_Library_Relative +begin + +text\In this theory we introduce bounded partial functions and its relative +version; for historical reasons the relative version is based on a proper +definition of partial functions. + +We note that finite partial functions are easier and are used to prove +some lemmas about finite sets in the theory +\<^theory>\Transitive_Models.ZF_Library_Relative\.\ + +definition + Fn :: "[i,i,i] \ i" where + "Fn(\,I,J) \ \{y . d \ Pow(I), y=(d\J) \ d\\}" + +lemma domain_function_lepoll : + assumes "function(r)" + shows "domain(r) \ r" +proof - + let ?f="\x\domain(r) . \ r>" + have 1:"\x. x \ domain(r) \ \!y. \ r" + using assms unfolding domain_def function_def by auto + then + have "?f \ inj(domain(r), r)" + using theI[OF 1] + by(rule_tac lam_injective,auto) + then + show ?thesis unfolding lepoll_def + by force +qed + +lemma function_lepoll: + assumes "r:d\J" + shows "r \ d" +proof - + let ?f="\x\r . fst(x)" + note assms Pi_iff[THEN iffD1,OF assms] + moreover from this + have 1:"\x. x \ domain(r) \ \!y. \ r" + unfolding function_def by auto + moreover from calculation + have "(THE u . \ r) = snd(x)" if "x\r" for x + using that subsetD[of r "d\J" x] theI[OF 1] + by(auto,rule_tac the_equality2[OF 1],auto) + moreover from calculation + have "\x. x \r \ \ r> = x" + by auto + ultimately + have "?f\inj(r,d)" + by(rule_tac d= "\u . \ r>" in lam_injective,force,simp) + then + show ?thesis + unfolding lepoll_def + by auto +qed + +lemma function_eqpoll : + assumes "r:d\J" + shows "r \ d" + using assms domain_of_fun domain_function_lepoll Pi_iff[THEN iffD1,OF assms] + eqpollI[OF function_lepoll[OF assms]] subset_imp_lepoll + by force + +lemma Fn_char : "Fn(\,I,J) = {f \ Pow(I\J) . function(f) \ f \ \}" (is "?L=?R") +proof (intro equalityI subsetI) + fix x + assume "x \ ?R" + moreover from this + have "domain(x) \ Pow(I)" "domain(x) \ x" "x\ \" + using domain_function_lepoll + by auto + ultimately + show "x \ ?L" + unfolding Fn_def + using lesspoll_trans1 Pi_iff + by (auto,rule_tac rev_bexI[of "domain(x) \ J"],auto) +next + fix x + assume "x \ ?L" + then + obtain d where "x:d\J" "d \ Pow(I)" "d\\" + unfolding Fn_def + by auto + moreover from this + have "x\\" + using function_lepoll[THEN lesspoll_trans1] by auto + moreover from calculation + have "x \ Pow(I\J)" "function(x)" + using Pi_iff by auto + ultimately + show "x \ ?R" by simp +qed + +lemma zero_in_Fn: + assumes "0 < \" + shows "0 \ Fn(\, I, J)" + using lt_Card_imp_lesspoll assms zero_lesspoll + unfolding Fn_def + by (simp,rule_tac x="0\J" in bexI,simp) + (rule ReplaceI[of _ 0],simp_all) + +lemma Fn_nat_eq_FiniteFun: "Fn(nat,I,J) = I -||> J" +proof (intro equalityI subsetI) + fix x + assume "x \ I -||> J" + then + show "x \ Fn(nat,I,J)" + proof (induct) + case emptyI + then + show ?case + using zero_in_Fn ltI + by simp + next + case (consI a b h) + then + obtain d where "h:d\J" "d\nat" "d\I" + unfolding Fn_def by auto + moreover from this + have "Finite(d)" + using lesspoll_nat_is_Finite by simp + ultimately + have "h : d -||> J" + using fun_FiniteFunI Finite_into_Fin by blast + note \h:d\J\ + moreover from this + have "domain(cons(\a, b\, h)) = cons(a,d)" (is "domain(?h) = ?d") + and "domain(h) = d" + using domain_of_fun by simp_all + moreover + note consI + moreover from calculation + have "cons(\a, b\, h) \ cons(a,d) \ J" + using fun_extend3 by simp + moreover from \Finite(d)\ + have "Finite(cons(a,d))" by simp + moreover from this + have "cons(a,d) \ nat" using Finite_imp_lesspoll_nat by simp + ultimately + show ?case + unfolding Fn_def + by (simp,rule_tac x="?d\J" in bexI) + (force dest:app_fun)+ + qed +next + fix x + assume "x \ Fn(nat,I,J)" + then + obtain d where "x:d\J" "d \ Pow(I)" "d\nat" + unfolding Fn_def + by auto + moreover from this + have "Finite(d)" + using lesspoll_nat_is_Finite by simp + moreover from calculation + have "d \ Fin(I)" + using Finite_into_Fin[of d] Fin_mono by auto + ultimately + show "x \ I -||> J" using fun_FiniteFunI FiniteFun_mono by blast +qed + +lemma Fn_nat_subset_Pow: "Fn(\,I,J) \ Pow(I\J)" + using Fn_char by auto + +lemma FnI: + assumes "p : d \ J" "d \ I" "d \ \" + shows "p \ Fn(\,I,J)" + using assms + unfolding Fn_def by auto + +lemma FnD[dest]: + assumes "p \ Fn(\,I,J)" + shows "\d. p : d \ J \ d \ I \ d \ \" + using assms + unfolding Fn_def by auto + +lemma Fn_is_function: "p \ Fn(\,I,J) \ function(p)" + unfolding Fn_def using fun_is_function by auto + +lemma Fn_csucc: + assumes "Ord(\)" + shows "Fn(csucc(\),I,J) = \{y . d \ Pow(I), y=(d\J) \ d\\}" + using assms + unfolding Fn_def using lesspoll_csucc by (simp) + +definition + FnleR :: "i \ i \ o" (infixl \\\ 50) where + "f \ g \ g \ f" + +lemma FnleR_iff_subset [iff]: "f \ g \ g \ f" + unfolding FnleR_def .. + +definition + Fnlerel :: "i \ i" where + "Fnlerel(A) \ Rrel(\x y. x \ y,A)" + +definition + Fnle :: "[i,i,i] \ i" where + "Fnle(\,I,J) \ Fnlerel(Fn(\,I,J))" + +lemma FnleI[intro]: + assumes "p \ Fn(\,I,J)" "q \ Fn(\,I,J)" "p \ q" + shows "\p,q\ \ Fnle(\,I,J)" + using assms unfolding Fnlerel_def Fnle_def FnleR_def Rrel_def + by auto + +lemma FnleD[dest]: + assumes "\p,q\ \ Fnle(\,I,J)" + shows "p \ Fn(\,I,J)" "q \ Fn(\,I,J)" "p \ q" + using assms unfolding Fnlerel_def Fnle_def FnleR_def Rrel_def + by auto + +definition PFun_Space_Rel :: "[i,i\o, i] \ i" ("_\\<^bsup>_\<^esup>_") + where "A \\<^bsup>M\<^esup> B \ {f \ Pow(A\B) . M(f) \ function(f)}" + +lemma (in M_library) PFun_Space_subset_Powrel : + assumes "M(A)" "M(B)" + shows "A \\<^bsup>M\<^esup> B = {f \ Pow\<^bsup>M\<^esup>(A\B) . function(f)}" + using Pow_rel_char assms + unfolding PFun_Space_Rel_def + by auto + +lemma (in M_library) PFun_Space_closed : + assumes "M(A)" "M(B)" + shows "M(A \\<^bsup>M\<^esup> B)" + using assms PFun_Space_subset_Powrel separation_is_function + by auto + +lemma Un_filter_fun_space_closed: + assumes "G \ I \ J" "\ f g . f\G \ g\G \ \d\I\ J . d \ f \ d \ g" + shows "\G \ Pow(I\J)" "function(\G)" +proof - + from assms + show "\G \ Pow(I\J)" + using Union_Pow_iff + unfolding Pi_def + by auto +next + show "function(\G)" + unfolding function_def + proof(auto) + fix B B' x y y' + assume "B \ G" "\x, y\ \ B" "B' \ G" "\x, y'\ \ B'" + moreover from assms this + have "B \ I \ J" "B' \ I \ J" + by auto + moreover from calculation assms(2)[of B B'] + obtain d where "d \ B" "d \ B'" "d\I \ J" "\x, y\ \ d" "\x, y'\ \ d" + using subsetD[OF \G\_\] + by auto + then + show "y=y'" + using fun_is_function[OF \d\_\] + unfolding function_def + by force + qed +qed + +lemma Un_filter_is_fun : + assumes "G \ I \ J" "\ f g . f\G \ g\G \ \d\I\ J . d\f \ d\g" "G\0" + shows "\G \ I \ J" + using assms Un_filter_fun_space_closed Pi_iff +proof(simp_all) + show "I\domain(\G)" + proof - + from \G\0\ + obtain f where "f\\G" "f\G" + by auto + with \G\_\ + have "f\I\J" by auto + then + show ?thesis + using subset_trans[OF _ domain_mono[OF \f\\G\],of I] + unfolding Pi_def by auto + qed +qed + +context M_cardinals +begin + +lemma mem_function_space_relD: + assumes "f \ function_space_rel(M,A,y)" "M(A)" "M(y)" + shows "f \ A \ y" and "M(f)" + using assms function_space_rel_char by simp_all + +lemma pfunI : + assumes "C\A" "f \ C \\<^bsup>M\<^esup> B" "M(C)" "M(B)" + shows "f\ A \\<^bsup>M\<^esup> B" +proof - + from assms + have "f \ C\B" "M(f)" + using mem_function_space_relD + by simp_all + with assms + show ?thesis + using Pi_iff + unfolding PFun_Space_Rel_def + by auto +qed + +lemma zero_in_PFun_rel: + assumes "M(I)" "M(J)" + shows "0 \ I \\<^bsup>M\<^esup> J" + using pfunI[of 0] nonempty mem_function_space_rel_abs assms + by simp + +lemma pfun_subsetI : + assumes "f \ A \\<^bsup>M\<^esup> B" "g\f" "M(g)" + shows "g\ A \\<^bsup>M\<^esup> B" + using assms function_subset + unfolding PFun_Space_Rel_def + by auto + +lemma pfun_is_function : + "f \ A\\<^bsup>M\<^esup> B \ function(f)" + unfolding PFun_Space_Rel_def by simp + +lemma pfun_Un_filter_closed: + assumes "G \I\\<^bsup>M\<^esup> J" "\ f g . f\G \ g\G \ \d\I\\<^bsup>M\<^esup> J . d\f \ d\g" + shows "\G \ Pow(I\J)" "function(\G)" +proof - + from assms + show "\G \ Pow(I\J)" + using Union_Pow_iff + unfolding PFun_Space_Rel_def + by auto +next + show "function(\G)" + unfolding function_def + proof(auto) + fix B B' x y y' + assume "B \ G" "\x, y\ \ B" "B' \ G" "\x, y'\ \ B'" + moreover from calculation assms + obtain d where "d \ I \\<^bsup>M\<^esup> J" "function(d)" "\x, y\ \ d" "\x, y'\ \ d" + using pfun_is_function + by force + ultimately + show "y=y'" + unfolding function_def + by auto + qed +qed + +lemma pfun_Un_filter_closed'': + assumes "G \I\\<^bsup>M\<^esup> J" "\ f g . f\G \ g\G \ \d\G . d\f \ d\g" + shows "\G \ Pow(I\J)" "function(\G)" +proof - + from assms + have "\ f g . f\G \ g\G \ \d\I\\<^bsup>M\<^esup> J . d\f \ d\g" + using subsetD[OF assms(1),THEN [2] bexI] + by force + then + show "\G \ Pow(I\J)" "function(\G)" + using assms pfun_Un_filter_closed + unfolding PFun_Space_Rel_def + by auto +qed + +lemma pfun_Un_filter_closed': + assumes "G \I\\<^bsup>M\<^esup> J" "\ f g . f\G \ g\G \ \d\G . d\f \ d\g" "M(G)" + shows "\G \ I\\<^bsup>M\<^esup> J" + using assms pfun_Un_filter_closed'' + unfolding PFun_Space_Rel_def + by auto + +lemma pfunD : + assumes "f \ A\\<^bsup>M\<^esup> B" + shows "\C[M]. C\A \ f \ C\B" +proof - + note assms + moreover from this + have "f\Pow(A\B)" "function(f)" "M(f)" + unfolding PFun_Space_Rel_def + by simp_all + moreover from this + have "domain(f) \ A" "f \ domain(f) \ B" "M(domain(f))" + using assms Pow_iff[of f "A\B"] domain_subset Pi_iff + by auto + ultimately + show ?thesis by auto +qed + +lemma pfunD_closed : + assumes "f \ A\\<^bsup>M\<^esup> B" + shows "M(f)" + using assms + unfolding PFun_Space_Rel_def by simp + +lemma pfun_singletonI : + assumes "x \ A" "b \ B" "M(A)" "M(B)" + shows "{\x,b\} \ A\\<^bsup>M\<^esup> B" + using assms transM[of x A] transM[of b B] + unfolding PFun_Space_Rel_def function_def + by auto + +lemma pfun_unionI : + assumes "f \ A\\<^bsup>M\<^esup> B" "g \ A\\<^bsup>M\<^esup> B" "domain(f)\domain(g)=0" + shows "f\g \ A\\<^bsup>M\<^esup> B" + using assms + unfolding PFun_Space_Rel_def function_def + by blast + +lemma (in M_library) pfun_restrict_eq_imp_compat: + assumes "f \ I\\<^bsup>M\<^esup> J" "g \ I\\<^bsup>M\<^esup> J" "M(J)" + "restrict(f, domain(f) \ domain(g)) = restrict(g, domain(f) \ domain(g))" + shows "f \ g \ I\\<^bsup>M\<^esup> J" +proof - + note assms + moreover from this + obtain C D where "f : C \ J" "C \ I" "D \ I" "M(C)" "M(D)" "g : D \ J" + using pfunD[of f] pfunD[of g] by force + moreover from calculation + have "f\g \ C\D \ J" + using restrict_eq_imp_Un_into_Pi'[OF \f\C\_\ \g\D\_\] + by auto + ultimately + show ?thesis + using pfunI[of "C\D" _ "f\g"] Un_subset_iff pfunD_closed function_space_rel_char + by auto +qed + +lemma FiniteFun_pfunI : + assumes "f \ A-||> B" "M(A)" "M(B)" + shows "f \ A \\<^bsup>M\<^esup> B" + using assms(1) +proof(induct) + case emptyI + then + show ?case + using assms nonempty mem_function_space_rel_abs pfunI[OF empty_subsetI, of 0] + by simp +next + case (consI a b h) + note consI + moreover from this + have "M(a)" "M(b)" "M(h)" "domain(h) \ A" + using transM[OF _ \M(A)\] transM[OF _ \M(B)\] + FinD + FiniteFun_domain_Fin + pfunD_closed + by simp_all + moreover from calculation + have "{a}\domain(h)\A" "M({a}\domain(h))" "M(cons(,h))" "domain(cons(,h)) = {a}\domain(h)" + by auto + moreover from calculation + have "cons(,h) \ {a}\domain(h) \ B" + using FiniteFun_is_fun[OF FiniteFun.consI, of a A b B h] + by auto + ultimately + show "cons(,h) \ A \\<^bsup>M\<^esup> B" + using assms mem_function_space_rel_abs pfunI + by simp_all +qed + +lemma PFun_FiniteFunI : + assumes "f \ A \\<^bsup>M\<^esup> B" "Finite(f)" + shows "f \ A-||> B" +proof - + from assms + have "f\Fin(A\B)" "function(f)" + using Finite_Fin Pow_iff + unfolding PFun_Space_Rel_def + by auto + then + show ?thesis + using FiniteFunI by simp +qed + +end \ \\<^locale>\M_cardinals\\ + +(* Fn_rel should be the relativization *) +definition + Fn_rel :: "[i\o,i,i,i] \ i" (\Fn\<^bsup>_\<^esup>'(_,_,_')\) where + "Fn_rel(M,\,I,J) \ {f \ I\\<^bsup>M\<^esup> J . f \\<^bsup>M\<^esup> \}" + +context M_library +begin + +lemma Fn_rel_subset_PFun_rel : "Fn\<^bsup>M\<^esup>(\,I,J) \ I\\<^bsup>M\<^esup> J" + unfolding Fn_rel_def by auto + +lemma Fn_relI[intro]: + assumes "f : d \ J" "d \ I" "f \\<^bsup>M\<^esup> \" "M(d)" "M(J)" "M(f)" + shows "f \ Fn_rel(M,\,I,J)" + using assms pfunI mem_function_space_rel_abs + unfolding Fn_rel_def + by auto + +lemma Fn_relD[dest]: + assumes "p \ Fn_rel(M,\,I,J)" + shows "\C[M]. C\I \ p : C \ J \ p \\<^bsup>M\<^esup> \" + using assms pfunD + unfolding Fn_rel_def + by simp + +lemma Fn_rel_is_function: + assumes "p \ Fn_rel(M,\,I,J)" + shows "function(p)" "M(p)" "p \\<^bsup>M\<^esup> \" "p\ I\\<^bsup>M\<^esup> J" + using assms + unfolding Fn_rel_def PFun_Space_Rel_def by simp_all + +lemma Fn_rel_mono: + assumes "p \ Fn_rel(M,\,I,J)" "\ \\<^bsup>M\<^esup> \'" "M(\)" "M(\')" + shows "p \ Fn_rel(M,\',I,J)" + using assms lesspoll_rel_trans[OF _ assms(2)] cardinal_rel_closed + Fn_rel_is_function(2)[OF assms(1)] + unfolding Fn_rel_def + by simp + +lemma Fn_rel_mono': + assumes "p \ Fn_rel(M,\,I,J)" "\ \\<^bsup>M\<^esup> \'" "M(\)" "M(\')" + shows "p \ Fn_rel(M,\',I,J)" +proof - + note assms + then + consider "\ \\<^bsup>M\<^esup> \'" | "\ \\<^bsup>M\<^esup> \'" + using lepoll_rel_iff_leqpoll_rel + by auto + then + show ?thesis + proof(cases) + case 1 + with assms show ?thesis using Fn_rel_mono by simp + next + case 2 + then show ?thesis + using assms cardinal_rel_closed Fn_rel_is_function[OF assms(1)] + lesspoll_rel_eq_trans + unfolding Fn_rel_def + by simp + qed +qed + +lemma Fn_csucc: + assumes "Ord(\)" "M(\)" + shows "Fn_rel(M,(\\<^sup>+)\<^bsup>M\<^esup>,I,J) = {p\ I\\<^bsup>M\<^esup> J . p \\<^bsup>M\<^esup> \}" (is "?L=?R") + using assms +proof(intro equalityI) + show "?L \ ?R" + proof(intro subsetI) + fix p + assume "p\?L" + then + have "p \\<^bsup>M\<^esup> csucc_rel(M,\)" "M(p)" "p\ I\\<^bsup>M\<^esup> J" + using Fn_rel_is_function by simp_all + then + show "p\?R" + using assms lesspoll_rel_csucc_rel by simp + qed +next + show "?R\?L" + proof(intro subsetI) + fix p + assume "p\?R" + then + have "p\ I\\<^bsup>M\<^esup> J" "p \\<^bsup>M\<^esup> \" + using assms lesspoll_rel_csucc_rel by simp_all + then + show "p\?L" + using assms lesspoll_rel_csucc_rel pfunD_closed + unfolding Fn_rel_def + by simp + qed +qed + +lemma Finite_imp_lesspoll_nat: + assumes "Finite(A)" + shows "A \ nat" + using assms subset_imp_lepoll[OF naturals_subset_nat] eq_lepoll_trans + n_lesspoll_nat eq_lesspoll_trans + unfolding Finite_def lesspoll_def by auto + +lemma FinD_Finite : + assumes "a\Fin(A)" + shows "Finite(a)" + using assms + by(induct,simp_all) + +lemma Fn_rel_nat_eq_FiniteFun: + assumes "M(I)" "M(J)" + shows "I -||> J = Fn_rel(M,\,I,J)" +proof(intro equalityI subsetI) + fix p + assume "p\I -||> J" + with assms + have "p\ I \\<^bsup>M\<^esup> J" "Finite(p)" + using FiniteFun_pfunI FinD_Finite[OF subsetD[OF FiniteFun.dom_subset,OF \p\_\]] + by auto + moreover from this + have "p \\<^bsup>M\<^esup> \" + using Finite_lesspoll_rel_nat pfunD_closed[of p] n_lesspoll_rel_nat + by simp + ultimately + show "p\ Fn_rel(M,\,I,J)" + unfolding Fn_rel_def by simp +next + fix p + assume "p\ Fn_rel(M,\,I,J)" + then + have "p\ I \\<^bsup>M\<^esup> J" "p \\<^bsup>M\<^esup> \" + unfolding Fn_rel_def by simp_all + moreover from this + have "Finite(p)" + using Finite_cardinal_rel_Finite lesspoll_rel_nat_is_Finite_rel pfunD_closed + cardinal_rel_closed[of p] Finite_cardinal_rel_iff'[THEN iffD1] + by simp + ultimately + show "p\I -||> J" + using PFun_FiniteFunI + by simp +qed + +lemma Fn_nat_abs: + assumes "M(I)" "M(J)" + shows "Fn(nat,I,J) = Fn_rel(M,\,I,J)" + using assms Fn_rel_nat_eq_FiniteFun Fn_nat_eq_FiniteFun + by simp + +lemma Fn_rel_singletonI: + assumes "x \ I" "j \ J" "1 \\<^bsup>M\<^esup> \" "M(\)" "M(I)" "M(J)" + shows "{\x,j\} \ Fn\<^bsup>M\<^esup>(\,I,J)" + using pfun_singletonI transM[of x] transM[of j] assms + eq_lesspoll_rel_trans[OF singleton_eqpoll_rel_1] + unfolding Fn_rel_def + by auto + +end \ \\<^locale>\M_library\\ + +definition + Fnle_rel :: "[i\o,i,i,i] \ i" (\Fnle\<^bsup>_\<^esup>'(_,_,_')\) where + "Fnle_rel(M,\,I,J) \ Fnlerel(Fn\<^bsup>M\<^esup>(\,I,J))" + +abbreviation + Fn_r_set :: "[i,i,i,i] \ i" (\Fn\<^bsup>_\<^esup>'(_,_,_')\) where + "Fn_r_set(M) \ Fn_rel(##M)" + +abbreviation + Fnle_r_set :: "[i,i,i,i] \ i" (\Fnle\<^bsup>_\<^esup>'(_,_,_')\) where + "Fnle_r_set(M) \ Fnle_rel(##M)" + + +context M_library +begin + +lemma Fnle_relI[intro]: + assumes "p \ Fn_rel(M,\,I,J)" "q \ Fn_rel(M,\,I,J)" "p \ q" + shows " \ Fnle_rel(M,\,I,J)" + using assms unfolding Fnlerel_def Fnle_rel_def FnleR_def Rrel_def + by auto + +lemma Fnle_relD[dest]: + assumes " \ Fnle_rel(M,\,I,J)" + shows "p \ Fn_rel(M,\,I,J)" "q \ Fn_rel(M,\,I,J)" "p \ q" + using assms unfolding Fnlerel_def Fnle_rel_def FnleR_def Rrel_def + by auto + +lemma Fn_rel_closed[intro,simp]: + assumes "M(\)" "M(I)" "M(J)" + shows "M(Fn\<^bsup>M\<^esup>(\,I,J))" + using assms separation_cardinal_rel_lesspoll_rel PFun_Space_closed + unfolding Fn_rel_def + by auto + +lemma Fn_rel_subset_Pow: + assumes "M(\)" "M(I)" "M(J)" + shows "Fn\<^bsup>M\<^esup>(\,I,J) \ Pow(I\J)" + unfolding Fn_rel_def PFun_Space_Rel_def + by auto + +lemma Fnle_rel_closed[intro,simp]: + assumes "M(\)" "M(I)" "M(J)" + shows "M(Fnle\<^bsup>M\<^esup>(\,I,J))" + unfolding Fnle_rel_def Fnlerel_def Rrel_def FnleR_def + using assms supset_separation Fn_rel_closed + by auto + +lemma zero_in_Fn_rel: + assumes "0<\" "M(\)" "M(I)" "M(J)" + shows "0 \ Fn\<^bsup>M\<^esup>(\, I, J)" + unfolding Fn_rel_def + using zero_in_PFun_rel zero_lesspoll_rel assms + by simp + +lemma zero_top_Fn_rel: + assumes "p\Fn\<^bsup>M\<^esup>(\, I, J)" "0<\" "M(\)" "M(I)" "M(J)" + shows "\p, 0\ \ Fnle\<^bsup>M\<^esup>(\, I, J)" + using assms zero_in_Fn_rel unfolding preorder_on_def refl_def trans_on_def + by auto + +lemma preorder_on_Fnle_rel: + assumes "M(\)" "M(I)" "M(J)" + shows "preorder_on(Fn\<^bsup>M\<^esup>(\, I, J), Fnle\<^bsup>M\<^esup>(\, I, J))" + unfolding preorder_on_def refl_def trans_on_def + by blast + +end \ \\<^locale>\M_library\\ + +end \ No newline at end of file diff --git a/thys/Transitive_Models/Pointed_DC_Relative.thy b/thys/Transitive_Models/Pointed_DC_Relative.thy new file mode 100644 --- /dev/null +++ b/thys/Transitive_Models/Pointed_DC_Relative.thy @@ -0,0 +1,477 @@ +section\Relative DC\ + +theory Pointed_DC_Relative + imports + Cardinal_Library_Relative + +begin + +consts dc_witness :: "i \ i \ i \ i \ i \ i" +primrec + wit0 : "dc_witness(0,A,a,s,R) = a" + witrec : "dc_witness(succ(n),A,a,s,R) = s`{x\A. \dc_witness(n,A,a,s,R),x\\R}" + +lemmas dc_witness_def = dc_witness_nat_def + +relativize functional "dc_witness" "dc_witness_rel" +relationalize "dc_witness_rel" "is_dc_witness" + (* definition + is_dc_witness_fm where + "is_dc_witness_fm(na, A, a, s, R, e) \ is_transrec_fm + (is_nat_case_fm + (a +\<^sub>\ 8, (\\\\4`2 is 0\ \ (\\\\s +\<^sub>\ 12`0 is 2\ \ Collect_fm(A +\<^sub>\ 12, \(\\\0 = 0\\) \ (\\\\0 \ R +\<^sub>\ 14\ \ pair_fm(3, 1, 0) \\)\, 0) \\)\\), 2, + 0), na, e)" + *) +schematic_goal sats_is_dc_witness_fm_auto: + assumes "na < length(env)" "e < length(env)" + shows + " na \ \ \ + A \ \ \ + a \ \ \ + s \ \ \ + R \ \ \ + e \ \ \ + env \ list(Aa) \ + 0 \ Aa \ + is_dc_witness(##Aa, nth(na, env), nth(A, env), nth(a, env), nth(s, env), nth(R, env), nth(e, env)) \ + Aa, env \ ?fm(nat, A, a, s, R, e)" + unfolding is_dc_witness_def is_recursor_def + by (rule is_transrec_iff_sats | simp_all) + (rule iff_sats is_nat_case_iff_sats is_eclose_iff_sats sep_rules | simp add:assms)+ + +synthesize "is_dc_witness" from_schematic + +manual_arity for "is_dc_witness_fm" + unfolding is_dc_witness_fm_def apply (subst arity_transrec_fm) + apply (simp add:arity) defer 3 + apply (simp add:arity) defer + apply (subst arity_is_nat_case_fm) + apply (simp add:arity del:arity_transrec_fm) prefer 5 + by (simp add:arity del:arity_transrec_fm)+ + +definition dcwit_body :: "[i,i,i,i,i] \ o" where + "dcwit_body(A,a,g,R) \ \p. snd(p) = dc_witness(fst(p), A, a, g, R)" + +relativize functional "dcwit_body" "dcwit_body_rel" +relationalize "dcwit_body_rel" "is_dcwit_body" + +synthesize "is_dcwit_body" from_definition assuming "nonempty" +arity_theorem for "is_dcwit_body_fm" + +context M_replacement +begin + +lemma dc_witness_closed[intro,simp]: + assumes "M(n)" "M(A)" "M(a)" "M(s)" "M(R)" "n\nat" + shows "M(dc_witness(n,A,a,s,R))" + using \n\nat\ +proof(induct) + case 0 + with \M(a)\ + show ?case + unfolding dc_witness_def by simp +next + case (succ x) + with assms + have "M(dc_witness(x,A,a,s,R))" (is "M(?b)") + by simp + moreover from this assms + have "M(({?b}\A)\R)" (is "M(?X)") by auto + moreover + have "{x\A. \?b,x\\R} = {snd(y) . y\?X}" (is "_ = ?Y") + by(intro equalityI subsetI,force,auto) + moreover from calculation + have "M(?Y)" + using lam_replacement_snd lam_replacement_imp_strong_replacement RepFun_closed + snd_closed[OF transM] + by auto + ultimately + show ?case + using \M(s)\ apply_closed + unfolding dc_witness_def by simp +qed + +lemma dc_witness_rel_char: + assumes "M(A)" + shows "dc_witness_rel(M,n,A,a,s,R) = dc_witness(n,A,a,s,R)" +proof - + from assms + have "{x \ A . \rec, x\ \ R} = {x \ A . M(x) \ \rec, x\ \ R}" for rec + by (auto dest:transM) + then + show ?thesis + unfolding dc_witness_def dc_witness_rel_def by simp +qed + +lemma (in M_basic) first_section_closed: + assumes + "M(A)" "M(a)" "M(R)" + shows "M({x \ A . \a, x\ \ R})" +proof - + have "{x \ A . \a, x\ \ R} = range({a} \ range(R) \ R) \ A" + by (intro equalityI) auto + with assms + show ?thesis + by simp +qed + +lemma witness_into_A [TC]: + assumes "a\A" + "\X[M]. X\0 \ X\A \ s`X\A" + "\y\A. {x\A. \y,x\\R } \ 0" "n\nat" + "M(A)" "M(a)" "M(s)" "M(R)" + shows "dc_witness(n, A, a, s, R)\A" + using \n\nat\ +proof(induct n) + case 0 + then show ?case using \a\A\ by simp +next + case (succ x) + with succ assms(1,3-) + show ?case + using nat_into_M first_section_closed + by (simp, rule_tac rev_subsetD, rule_tac assms(2)[rule_format]) + auto +qed + +end \ \\<^locale>\M_replacement\\ + +locale M_DC = M_trancl + M_replacement + M_eclose + + assumes + separation_is_dcwit_body: + "M(A) \ M(a) \ M(g) \ M(R) \ separation(M,is_dcwit_body(M, A, a, g, R))" + and + dcwit_replacement:"Ord(na) \ + M(na) \ + M(A) \ + M(a) \ + M(s) \ + M(R) \ + transrec_replacement + (M, \n f ntc. + is_nat_case + (M, a, + \m bmfm. + \fm[M]. \cp[M]. + is_apply(M, f, m, fm) \ + is_Collect(M, A, \x. \fmx[M]. (M(x) \ fmx \ R) \ pair(M, fm, x, fmx), cp) \ + is_apply(M, s, cp, bmfm), + n, ntc),na)" +begin + +lemma is_dc_witness_iff: + assumes "Ord(na)" "M(na)" "M(A)" "M(a)" "M(s)" "M(R)" "M(res)" + shows "is_dc_witness(M, na, A, a, s, R, res) \ res = dc_witness_rel(M, na, A, a, s, R)" +proof - + note assms + moreover from this + have "{x \ A . M(x) \ \f, x\ \ R} = {x \ A . \f, x\ \ R}" for f + by (auto dest:transM) + moreover from calculation + have "M(fm) \ M({x \ A . M(x) \ \fm, x\ \ R})" for fm + using first_section_closed by (auto dest:transM) + moreover from calculation + have "M(x) \ M(z) \ M(mesa) \ + (\ya[M]. pair(M, x, ya, z) \ + is_wfrec(M, \n f. is_nat_case(M, a, \m bmfm. \fm[M]. is_apply(M, f, m, fm) \ + is_apply(M, s, {x \ A . \fm, x\ \ R}, bmfm), n), mesa, x, ya)) + \ + (\y[M]. pair(M, x, y, z) \ + is_wfrec(M, \n f. is_nat_case(M, a, + \m bmfm. + \fm[M]. \cp[M]. is_apply(M, f, m, fm) \ + is_Collect(M, A, \x. M(x) \ \fm, x\ \ R, cp) \ is_apply(M, s, cp, bmfm),n), + mesa, x, y))" for x z mesa by simp + moreover from calculation + show ?thesis + using assms dcwit_replacement[of na A a s R] + unfolding is_dc_witness_def dc_witness_rel_def + by (rule_tac recursor_abs) (auto dest:transM) +qed + +lemma dcwit_body_abs: + "fst(x) \ \ \ M(A) \ M(a) \ M(g) \ M(R) \ M(x) \ + is_dcwit_body(M,A,a,g,R,x) \ dcwit_body(A,a,g,R,x)" + using pair_in_M_iff apply_closed transM[of _ A] + is_dc_witness_iff[of "fst(x)" "A" "a" "g" "R" "snd(x)"] + fst_snd_closed dc_witness_closed + unfolding dcwit_body_def is_dcwit_body_def + by (auto dest:transM simp:absolut dc_witness_rel_char del:bexI intro!:bexI) + +lemma separation_eq_dc_witness: + "M(A) \ + M(a) \ + M(g) \ + M(R) \ separation(M,\p. fst(p)\\ \ snd(p) = dc_witness(fst(p), A, a, g, R))" + using separation_is_dcwit_body dcwit_body_abs unfolding is_dcwit_body_def + oops + +lemma Lambda_dc_witness_closed: + assumes "g \ Pow\<^bsup>M\<^esup>(A)-{0} \ A" "a\A" "\y\A. {x \ A . \y, x\ \ R} \ 0" + "M(g)" "M(A)" "M(a)" "M(R)" + shows "M(\n\nat. dc_witness(n,A,a,g,R))" +proof - + from assms + have "(\n\nat. dc_witness(n,A,a,g,R)) = {p \ \ \ A . is_dcwit_body(M,A,a,g,R,p)}" + using witness_into_A[of a A g R] + Pow_rel_char apply_type[of g "{x \ Pow(A) . M(x)}-{0}" "\_.A"] + unfolding lam_def split_def + apply (intro equalityI subsetI) + apply (auto) (* slow *) + by (subst dcwit_body_abs, simp_all add:transM[of _ \] dcwit_body_def, + subst (asm) dcwit_body_abs, auto dest:transM simp:dcwit_body_def) + (* by (intro equalityI subsetI, auto) (* Extremely slow *) + (subst dcwit_body_abs, simp_all add:transM[of _ \] dcwit_body_def, + subst (asm) dcwit_body_abs, auto dest:transM simp:dcwit_body_def) *) + with assms + show ?thesis + using separation_is_dcwit_body dc_witness_rel_char unfolding split_def by simp +qed + +lemma witness_related: + assumes "a\A" + "\X[M]. X\0 \ X\A \ s`X\X" + "\y\A. {x\A. \y,x\\R } \ 0" "n\nat" + "M(a)" "M(A)" "M(s)" "M(R)" "M(n)" + shows "\dc_witness(n, A, a, s, R),dc_witness(succ(n), A, a, s, R)\\R" +proof - + note assms + moreover from this + have "(\X[M]. X\0 \ X\A \ s`X\A)" by auto + moreover from calculation + have "dc_witness(n, A, a, s, R)\A" (is "?x \ A") + using witness_into_A[of _ _ s R n] by simp + moreover from assms + have "M({x \ A . \dc_witness(n, A, a, s, R), x\ \ R})" + using first_section_closed[of A "dc_witness(n, A, a, s, R)"] + by simp + ultimately + show ?thesis by auto +qed + +lemma witness_funtype: + assumes "a\A" + "\X[M]. X\0 \ X\A \ s`X \ A" + "\y\A. {x\A. \y,x\\R} \ 0" + "M(A)" "M(a)" "M(s)" "M(R)" + shows "(\n\nat. dc_witness(n, A, a, s, R)) \ nat \ A" (is "?f \ _ \ _") +proof - + have "?f \ nat \ {dc_witness(n, A, a, s, R). n\nat}" (is "_ \ _ \ ?B") + using lam_funtype assms by simp + then + have "?B \ A" + using witness_into_A assms by auto + with \?f \ _\ + show ?thesis + using fun_weaken_type + by simp +qed + +lemma witness_to_fun: + assumes "a\A" + "\X[M]. X\0 \ X\A \ s`X\A" + "\y\A. {x\A. \y,x\\R } \ 0" + "M(A)" "M(a)" "M(s)" "M(R)" + shows "\f \ nat\A. \n\nat. f`n =dc_witness(n,A,a,s,R)" + using assms bexI[of _ "\n\nat. dc_witness(n,A,a,s,R)"] witness_funtype + by simp + +end \ \\<^locale>\M_DC\\ + +locale M_library_DC = M_library + M_DC +begin + +(* Should port the whole AC theory, including the absolute version + of the following theorem *) +lemma AC_M_func: + assumes "\x. x \ A \ (\y. y \ x)" "M(A)" + shows "\f \ A \\<^bsup>M\<^esup> \(A). \x \ A. f`x \ x" +proof - + from \M(A)\ + interpret mpiA:M_Pi_assumptions _ A "\x. x" + using Pi_replacement Pi_separation lam_replacement_identity + lam_replacement_Sigfun[THEN lam_replacement_imp_strong_replacement] + by unfold_locales (simp_all add:transM[of _ A]) + from \M(A)\ + interpret mpic_A:M_Pi_assumptions_choice _ A "\x. x" + apply unfold_locales + using lam_replacement_constant lam_replacement_identity + lam_replacement_identity[THEN lam_replacement_imp_strong_replacement] + lam_replacement_minimum[THEN [5] lam_replacement_hcomp2] + unfolding lam_replacement_def[symmetric] + by auto + from \M(A)\ + interpret mpi2:M_Pi_assumptions2 _ A "\_. \A" "\x. x" + using Pi_replacement Pi_separation lam_replacement_constant + lam_replacement_Sigfun[THEN lam_replacement_imp_strong_replacement, + of "\_. \A"] Pi_replacement1[of _ "\A"] transM[of _ "A"] + by unfold_locales auto + from assms + show ?thesis + using mpi2.Pi_rel_type apply_type mpiA.mem_Pi_rel_abs mpi2.mem_Pi_rel_abs + function_space_rel_char + by (rule_tac mpic_A.AC_Pi_rel[THEN rexE], simp, rule_tac x=x in bexI) + (auto, rule_tac C="\x. x" in Pi_type, auto) +qed + +lemma non_empty_family: "[| 0 \ A; x \ A |] ==> \y. y \ x" + by (subgoal_tac "x \ 0", blast+) + +lemma AC_M_func0: "0 \ A \ M(A) \ \f \ A \\<^bsup>M\<^esup> \(A). \x \ A. f`x \ x" + by (rule AC_M_func) (simp_all add: non_empty_family) + +lemma AC_M_func_Pow_rel: + assumes "M(C)" + shows "\f \ (Pow\<^bsup>M\<^esup>(C)-{0}) \\<^bsup>M\<^esup> C. \x \ Pow\<^bsup>M\<^esup>(C)-{0}. f`x \ x" +proof - + have "0\Pow\<^bsup>M\<^esup>(C)-{0}" by simp + with assms + obtain f where "f \ (Pow\<^bsup>M\<^esup>(C)-{0}) \\<^bsup>M\<^esup> \(Pow\<^bsup>M\<^esup>(C)-{0})" "\x \ Pow\<^bsup>M\<^esup>(C)-{0}. f`x \ x" + using AC_M_func0[OF \0\_\] by auto + moreover + have "x\C" if "x \ Pow\<^bsup>M\<^esup>(C) - {0}" for x + using that Pow_rel_char assms + by auto + moreover + have "\(Pow\<^bsup>M\<^esup>(C) - {0}) \ C" + using assms Pow_rel_char by auto + ultimately + show ?thesis + using assms function_space_rel_char + by (rule_tac bexI,auto,rule_tac Pi_weaken_type,simp_all) +qed + +theorem pointed_DC: + assumes "\x\A. \y\A. \x,y\\ R" "M(A)" "M(R)" + shows "\a\A. \f \ nat\\<^bsup>M\<^esup> A. f`0 = a \ (\n \ nat. \f`n,f`succ(n)\\R)" +proof - + have 0:"\y\A. {x \ A . \y, x\ \ R} \ 0" + using assms by auto + from \M(A)\ + obtain g where 1: "g \ Pow\<^bsup>M\<^esup>(A)-{0} \ A" "\X[M]. X \ 0 \ X \ A \ g ` X \ X" + "M(g)" + using AC_M_func_Pow_rel[of A] mem_Pow_rel_abs + function_space_rel_char[of "Pow\<^bsup>M\<^esup>(A)-{0}" A] by auto + then + have 2:"\X[M]. X \ 0 \ X \ A \ g ` X \ A" by auto + { + fix a + assume "a\A" + let ?f ="\n\nat. dc_witness(n,A,a,g,R)" + note \a\A\ + moreover from this + have f0: "?f`0 = a" by simp + moreover + note \a\A\ \M(g)\ \M(A)\ \M(R)\ + moreover from calculation + have "\?f ` n, ?f ` succ(n)\ \ R" if "n\nat" for n + using witness_related[OF \a\A\ _ 0, of g n] 1 that + by (auto dest:transM) + ultimately + have "\f[M]. f\nat \ A \ f ` 0 = a \ (\n\nat. \f ` n, f ` succ(n)\ \ R)" + using 0 1 \a\_\ + by (rule_tac x="(\n\\. dc_witness(n, A, a, g, R))" in rexI) + (simp_all, rule_tac witness_funtype, + auto intro!: Lambda_dc_witness_closed dest:transM) + } + with \M(A)\ + show ?thesis using function_space_rel_char by auto +qed + +lemma aux_DC_on_AxNat2 : "\x\A\nat. \y\A. \x,\y,succ(snd(x))\\ \ R \ + \x\A\nat. \y\A\nat. \x,y\ \ {\a,b\\R. snd(b) = succ(snd(a))}" + by (rule ballI, erule_tac x="x" in ballE, simp_all) + +lemma infer_snd : "c\ A\B \ snd(c) = k \ c=\fst(c),k\" + by auto + +corollary DC_on_A_x_nat : + assumes "(\x\A\nat. \y\A. \x,\y,succ(snd(x))\\ \ R)" "a\A" "M(A)" "M(R)" + shows "\f \ nat\\<^bsup>M\<^esup>A. f`0 = a \ (\n \ nat. \\f`n,n\,\f`succ(n),succ(n)\\\R)" (is "\x\_.?P(x)") +proof - + let ?R'="{\a,b\\R. snd(b) = succ(snd(a))}" + from assms(1) + have "\x\A\nat. \y\A\nat. \x,y\ \ ?R'" + using aux_DC_on_AxNat2 by simp + moreover + note \a\_\ \M(A)\ + moreover from this + have "M(A \ \)" by simp + have "lam_replacement(M, \x. succ(snd(fst(x))))" + using lam_replacement_fst lam_replacement_snd lam_replacement_hcomp + lam_replacement_hcomp[of _ "\x. succ(snd(x))"] + lam_replacement_succ by simp + with \M(R)\ + have "M(?R')" + using separation_eq lam_replacement_fst lam_replacement_snd + lam_replacement_succ lam_replacement_hcomp lam_replacement_identity + unfolding split_def by simp + ultimately + obtain f where + F:"f\nat\\<^bsup>M\<^esup> A\\" "f ` 0 = \a,0\" "\n\nat. \f ` n, f ` succ(n)\ \ ?R'" + using pointed_DC[of "A\nat" ?R'] by blast + with \M(A)\ + have "M(f)" using function_space_rel_char by simp + then + have "M(\x\nat. fst(f`x))" (is "M(?f)") + using lam_replacement_fst lam_replacement_hcomp + lam_replacement_constant lam_replacement_identity + lam_replacement_apply + by (rule_tac lam_replacement_iff_lam_closed[THEN iffD1, rule_format]) + auto + with F \M(A)\ + have "?f\nat\\<^bsup>M\<^esup> A" "?f ` 0 = a" using function_space_rel_char by auto + have 1:"n\ nat \ f`n= \?f`n, n\" for n + proof(induct n set:nat) + case 0 + then show ?case using F by simp + next + case (succ x) + with \M(A)\ + have "\f`x, f`succ(x)\ \ ?R'" "f`x \ A\nat" "f`succ(x)\A\nat" + using F function_space_rel_char[of \ "A\\"] by auto + then + have "snd(f`succ(x)) = succ(snd(f`x))" by simp + with succ \f`x\_\ + show ?case using infer_snd[OF \f`succ(_)\_\] by auto + qed + have "\\?f`n,n\,\?f`succ(n),succ(n)\\ \ R" if "n\nat" for n + using that 1[of "succ(n)"] 1[OF \n\_\] F(3) by simp + with \f`0=\a,0\\ + show ?thesis + using rev_bexI[OF \?f\_\] by simp +qed + +lemma aux_sequence_DC : + assumes "\x\A. \n\nat. \y\A. \x,y\ \ S`n" + "R={\\x,n\,\y,m\\ \ (A\nat)\(A\nat). \x,y\\S`m }" + shows "\ x\A\nat . \y\A. \x,\y,succ(snd(x))\\ \ R" + using assms Pair_fst_snd_eq by auto + +lemma aux_sequence_DC2 : "\x\A. \n\nat. \y\A. \x,y\ \ S`n \ + \x\A\nat. \y\A. \x,\y,succ(snd(x))\\ \ {\\x,n\,\y,m\\\(A\nat)\(A\nat). \x,y\\S`m }" + by auto + +lemma sequence_DC: + assumes "\x\A. \n\nat. \y\A. \x,y\ \ S`n" "M(A)" "M(S)" + shows "\a\A. (\f \ nat\\<^bsup>M\<^esup> A. f`0 = a \ (\n \ nat. \f`n,f`succ(n)\\S`succ(n)))" +proof - + from \M(S)\ + have "lam_replacement(M, \x. S ` snd(snd(x)))" + using lam_replacement_snd lam_replacement_hcomp + lam_replacement_hcomp[of _ "\x. S`snd(x)"] lam_replacement_apply by simp + with assms + have "M({x \ (A \ \) \ A \ \ . (\\\x,n\,y,m\. \x, y\ \ S ` m)(x)})" + using lam_replacement_fst lam_replacement_snd + lam_replacement_Pair[THEN [5] lam_replacement_hcomp2, + of "\x. fst(fst(x))" "\x. fst(snd(x))", THEN [2] separation_in, + of "\x. S ` snd(snd(x))"] lam_replacement_apply[of S] + lam_replacement_hcomp unfolding split_def by simp + with assms + show ?thesis + by (rule_tac ballI) (drule aux_sequence_DC2, drule DC_on_A_x_nat, auto) +qed + +end \ \\<^locale>\M_library_DC\\ + +end \ No newline at end of file diff --git a/thys/Transitive_Models/ROOT b/thys/Transitive_Models/ROOT new file mode 100644 --- /dev/null +++ b/thys/Transitive_Models/ROOT @@ -0,0 +1,23 @@ +chapter AFP + +session "Transitive_Models" (AFP) = "Delta_System_Lemma" + + description " + Transitive Models of Fragments of ZFC + + We extend the ZF-Constructibility library by relativizing theories + of the Isabelle/ZF and Delta System Lemma sessions to a transitive + class. We also relativize Paulson's work on Aleph and our former + treatment of the Axiom of Dependent Choices. This work is a + prerrequisite to our formalization of the independence of the + Continuum Hypothesis. + " + options [timeout=180] + theories + "Renaming_Auto" + "Delta_System_Relative" + "Pointed_DC_Relative" + "Partial_Functions_Relative" + document_files + "root.tex" + "root.bib" + "root.bst" diff --git a/thys/Transitive_Models/Recursion_Thms.thy b/thys/Transitive_Models/Recursion_Thms.thy new file mode 100644 --- /dev/null +++ b/thys/Transitive_Models/Recursion_Thms.thy @@ -0,0 +1,362 @@ +section\Some enhanced theorems on recursion\ + +theory Recursion_Thms + imports "ZF-Constructible.Datatype_absolute" + +begin + +\ \Removing arities from inherited simpset\ +declare arity_And [simp del] arity_Or[simp del] arity_Implies[simp del] + arity_Exists[simp del] arity_Iff[simp del] + arity_subset_fm [simp del] arity_ordinal_fm[simp del] arity_transset_fm[simp del] + +text\We prove results concerning definitions by well-founded +recursion on some relation \<^term>\R\ and its transitive closure +\<^term>\R^*\\ + (* Restrict the relation r to the field A*A *) + +lemma fld_restrict_eq : "a \ A \ (r \ A\A)-``{a} = (r-``{a} \ A)" + by(force) + +lemma fld_restrict_mono : "relation(r) \ A \ B \ r \ A\A \ r \ B\B" + by(auto) + +lemma fld_restrict_dom : + assumes "relation(r)" "domain(r) \ A" "range(r)\ A" + shows "r\ A\A = r" +proof (rule equalityI,blast,rule subsetI) + { fix x + assume xr: "x \ r" + from xr assms have "\ a b . x = \a,b\" by (simp add: relation_def) + then obtain a b where "\a,b\ \ r" "\a,b\ \ r\A\A" "x \ r\A\A" + using assms xr + by force + then have "x\ r \ A\A" by simp + } + then show "x \ r \ x\ r\A\A" for x . +qed + +definition tr_down :: "[i,i] \ i" + where "tr_down(r,a) = (r^+)-``{a}" + +lemma tr_downD : "x \ tr_down(r,a) \ \x,a\ \ r^+" + by (simp add: tr_down_def vimage_singleton_iff) + +lemma pred_down : "relation(r) \ r-``{a} \ tr_down(r,a)" + by(simp add: tr_down_def vimage_mono r_subset_trancl) + +lemma tr_down_mono : "relation(r) \ x \ r-``{a} \ tr_down(r,x) \ tr_down(r,a)" + by(rule subsetI,simp add:tr_down_def,auto dest: underD,force simp add: underI r_into_trancl trancl_trans) + +lemma rest_eq : + assumes "relation(r)" and "r-``{a} \ B" and "a \ B" + shows "r-``{a} = (r\B\B)-``{a}" +proof (intro equalityI subsetI) + fix x + assume "x \ r-``{a}" + then + have "x \ B" using assms by (simp add: subsetD) + from \x\ r-``{a}\ + have "\x,a\ \ r" using underD by simp + then + show "x \ (r\B\B)-``{a}" using \x\B\ \a\B\ underI by simp +next + from assms + show "x \ r -`` {a}" if "x \ (r \ B\B) -`` {a}" for x + using vimage_mono that by auto +qed + +lemma wfrec_restr_eq : "r' = r \ A\A \ wfrec[A](r,a,H) = wfrec(r',a,H)" + by(simp add:wfrec_on_def) + +lemma wfrec_restr : + assumes rr: "relation(r)" and wfr:"wf(r)" + shows "a \ A \ tr_down(r,a) \ A \ wfrec(r,a,H) = wfrec[A](r,a,H)" +proof (induct a arbitrary:A rule:wf_induct_raw[OF wfr] ) + case (1 a) + have wfRa : "wf[A](r)" + using wf_subset wfr wf_on_def Int_lower1 by simp + from pred_down rr + have "r -`` {a} \ tr_down(r, a)" . + with 1 + have "r-``{a} \ A" by (force simp add: subset_trans) + { + fix x + assume x_a : "x \ r-``{a}" + with \r-``{a} \ A\ + have "x \ A" .. + from pred_down rr + have b : "r -``{x} \ tr_down(r,x)" . + then + have "tr_down(r,x) \ tr_down(r,a)" + using tr_down_mono x_a rr by simp + with 1 + have "tr_down(r,x) \ A" using subset_trans by force + have "\x,a\ \ r" using x_a underD by simp + with 1 \tr_down(r,x) \ A\ \x \ A\ + have "wfrec(r,x,H) = wfrec[A](r,x,H)" by simp + } + then + have "x\ r-``{a} \ wfrec(r,x,H) = wfrec[A](r,x,H)" for x . + then + have Eq1 :"(\ x \ r-``{a} . wfrec(r,x,H)) = (\ x \ r-``{a} . wfrec[A](r,x,H))" + using lam_cong by simp + + from assms + have "wfrec(r,a,H) = H(a,\ x \ r-``{a} . wfrec(r,x,H))" by (simp add:wfrec) + also + have "... = H(a,\ x \ r-``{a} . wfrec[A](r,x,H))" + using assms Eq1 by simp + also from 1 \r-``{a} \ A\ + have "... = H(a,\ x \ (r\A\A)-``{a} . wfrec[A](r,x,H))" + using assms rest_eq by simp + also from \a\A\ + have "... = H(a,\ x \ (r-``{a})\A . wfrec[A](r,x,H))" + using fld_restrict_eq by simp + also from \a\A\ \wf[A](r)\ + have "... = wfrec[A](r,a,H)" using wfrec_on by simp + finally show ?case . +qed + +lemmas wfrec_tr_down = wfrec_restr[OF _ _ _ subset_refl] + +lemma wfrec_trans_restr : "relation(r) \ wf(r) \ trans(r) \ r-``{a}\A \ a \ A \ + wfrec(r, a, H) = wfrec[A](r, a, H)" + by(subgoal_tac "tr_down(r,a) \ A",auto simp add : wfrec_restr tr_down_def trancl_eq_r) + + +lemma field_trancl : "field(r^+) = field(r)" + by (blast intro: r_into_trancl dest!: trancl_type [THEN subsetD]) + +definition + Rrel :: "[i\i\o,i] \ i" where + "Rrel(R,A) \ {z\A\A. \x y. z = \x, y\ \ R(x,y)}" + +lemma RrelI : "x \ A \ y \ A \ R(x,y) \ \x,y\ \ Rrel(R,A)" + unfolding Rrel_def by simp + +lemma Rrel_mem: "Rrel(mem,x) = Memrel(x)" + unfolding Rrel_def Memrel_def .. + +lemma relation_Rrel: "relation(Rrel(R,d))" + unfolding Rrel_def relation_def by simp + +lemma field_Rrel: "field(Rrel(R,d)) \ d" + unfolding Rrel_def by auto + +lemma Rrel_mono : "A \ B \ Rrel(R,A) \ Rrel(R,B)" + unfolding Rrel_def by blast + +lemma Rrel_restr_eq : "Rrel(R,A) \ B\B = Rrel(R,A\B)" + unfolding Rrel_def by blast + +(* now a consequence of the previous lemmas *) +lemma field_Memrel : "field(Memrel(A)) \ A" + (* unfolding field_def using Ordinal.Memrel_type by blast *) + using Rrel_mem field_Rrel by blast + +lemma restrict_trancl_Rrel: + assumes "R(w,y)" + shows "restrict(f,Rrel(R,d)-``{y})`w + = restrict(f,(Rrel(R,d)^+)-``{y})`w" +proof (cases "y\d") + let ?r="Rrel(R,d)" and ?s="(Rrel(R,d))^+" + case True + show ?thesis + proof (cases "w\d") + case True + with \y\d\ assms + have "\w,y\\?r" + unfolding Rrel_def by blast + then + have "\w,y\\?s" + using r_subset_trancl[of ?r] relation_Rrel[of R d] by blast + with \\w,y\\?r\ + have "w\?r-``{y}" "w\?s-``{y}" + using vimage_singleton_iff by simp_all + then + show ?thesis by simp + next + case False + then + have "w\domain(restrict(f,?r-``{y}))" + using subsetD[OF field_Rrel[of R d]] by auto + moreover from \w\d\ + have "w\domain(restrict(f,?s-``{y}))" + using subsetD[OF field_Rrel[of R d], of w] field_trancl[of ?r] + fieldI1[of w y ?s] by auto + ultimately + have "restrict(f,?r-``{y})`w = 0" "restrict(f,?s-``{y})`w = 0" + unfolding apply_def by auto + then show ?thesis by simp + qed +next + let ?r="Rrel(R,d)" + let ?s="?r^+" + case False + then + have "?r-``{y}=0" + unfolding Rrel_def by blast + then + have "w\?r-``{y}" by simp + with \y\d\ assms + have "y\field(?s)" + using field_trancl subsetD[OF field_Rrel[of R d]] by force + then + have "w\?s-``{y}" + using vimage_singleton_iff by blast + with \w\?r-``{y}\ + show ?thesis by simp +qed + +lemma restrict_trans_eq: + assumes "w \ y" + shows "restrict(f,Memrel(eclose({x}))-``{y})`w + = restrict(f,(Memrel(eclose({x}))^+)-``{y})`w" + using assms restrict_trancl_Rrel[of mem ] Rrel_mem by (simp) + +lemma wf_eq_trancl: + assumes "\ f y . H(y,restrict(f,R-``{y})) = H(y,restrict(f,R^+-``{y}))" + shows "wfrec(R, x, H) = wfrec(R^+, x, H)" (is "wfrec(?r,_,_) = wfrec(?r',_,_)") +proof - + have "wfrec(R, x, H) = wftrec(?r^+, x, \y f. H(y, restrict(f,?r-``{y})))" + unfolding wfrec_def .. + also + have " ... = wftrec(?r^+, x, \y f. H(y, restrict(f,(?r^+)-``{y})))" + using assms by simp + also + have " ... = wfrec(?r^+, x, H)" + unfolding wfrec_def using trancl_eq_r[OF relation_trancl trans_trancl] by simp + finally + show ?thesis . +qed + +lemma transrec_equal_on_Ord: + assumes + "\x f . Ord(x) \ foo(x,f) = bar(x,f)" + "Ord(\)" + shows + "transrec(\, foo) = transrec(\, bar)" +proof - + have "transrec(\,foo) = transrec(\,bar)" if "Ord(\)" for \ + using that + proof (induct rule:trans_induct) + case (step \) + have "transrec(\, foo) = foo(\, \x\\. transrec(x, foo))" + using def_transrec[of "\x. transrec(x, foo)" foo] by blast + also from assms and step + have " \ = bar(\, \x\\. transrec(x, foo))" + by simp + also from step + have " \ = bar(\, \x\\. transrec(x, bar))" + by (auto) + also + have " \ = transrec(\, bar)" + using def_transrec[of "\x. transrec(x, bar)" bar, symmetric] + by blast + finally + show "transrec(\, foo) = transrec(\, bar)" . + qed + with assms + show ?thesis by simp +qed + +\ \Next theorem is very similar to @{thm transrec_equal_on_Ord}\ +lemma (in M_eclose) transrec_equal_on_M: + assumes + "\x f . M(x) \ M(f) \ foo(x,f) = bar(x,f)" + "\\. M(\) \ transrec_replacement(M,is_foo,\)" "relation2(M,is_foo,foo)" + "strong_replacement(M, \x y. y = \x, transrec(x, foo)\)" + "\x[M]. \g[M]. function(g) \ M(foo(x,g))" + "M(\)" "Ord(\)" + shows + "transrec(\, foo) = transrec(\, bar)" +proof - + have "M(transrec(x, foo))" if "Ord(x)" and "M(x)" for x + using that assms transrec_closed[of is_foo] + by simp + have "transrec(\,foo) = transrec(\,bar)" "M(transrec(\,foo))" if "Ord(\)" "M(\)" for \ + using that + proof (induct rule:trans_induct) + case (step \) + moreover + assume "M(\)" + moreover + note \Ord(\)\ M(\) \ M(transrec(\, foo))\ + ultimately + show "M(transrec(\, foo))" by blast + with step \M(\)\ \\x. Ord(x)\ M(x) \ M(transrec(x, foo))\ + \strong_replacement(M, \x y. y = \x, transrec(x, foo)\)\ + have "M(\x\\. transrec(x, foo))" + using Ord_in_Ord transM[of _ \] + by (rule_tac lam_closed) auto + have "transrec(\, foo) = foo(\, \x\\. transrec(x, foo))" + using def_transrec[of "\x. transrec(x, foo)" foo] by blast + also from assms and \M(\x\\. transrec(x, foo))\ \M(\)\ + have " \ = bar(\, \x\\. transrec(x, foo))" + by simp + also from step and \M(\)\ + have " \ = bar(\, \x\\. transrec(x, bar))" + using transM[of _ \] by (auto) + also + have " \ = transrec(\, bar)" + using def_transrec[of "\x. transrec(x, bar)" bar, symmetric] + by blast + finally + show "transrec(\, foo) = transrec(\, bar)" . + qed + with assms + show ?thesis by simp +qed + + +lemma ordermap_restr_eq: + assumes "well_ord(X,r)" + shows "ordermap(X, r) = ordermap(X, r \ X\X)" +proof - + let ?A="\x . Order.pred(X, x, r)" + let ?B="\x . Order.pred(X, x, r \ X \ X)" + let ?F="\x f. f `` ?A(x)" + let ?G="\x f. f `` ?B(x)" + let ?P="\ z. z\X \ wfrec(r \ X \ X,z,\x f. f `` ?A(x)) = wfrec(r \ X \ X,z,\x f. f `` ?B(x))" + have pred_eq: + "Order.pred(X, x, r \ X \ X) = Order.pred(X, x, r)" if "x\X" for x + unfolding Order.pred_def using that by auto + from assms + have wf_onX:"wf(r \ X \ X)" unfolding well_ord_def wf_on_def by simp + { + have "?P(z)" for z + proof(induct rule:wf_induct[where P="?P",OF wf_onX]) + case (1 x) + { + assume "x\X" + from 1 + have lam_eq: + "(\w\(r \ X \ X) -`` {x}. wfrec(r \ X \ X, w, ?F)) = + (\w\(r \ X \ X) -`` {x}. wfrec(r \ X \ X, w, ?G))" (is "?L=?R") + proof - + have "wfrec(r \ X \ X, w, ?F) = wfrec(r \ X \ X, w, ?G)" if "w\(r\X\X)-``{x}" for w + using 1 that by auto + then show ?thesis using lam_cong[OF refl] by simp + qed + then + have "wfrec(r \ X \ X, x, ?F) = ?L `` ?A(x)" + using wfrec[OF wf_onX,of x ?F] by simp + also have "... = ?R `` ?B(x)" + using lam_eq pred_eq[OF \x\_\] by simp + also + have "... = wfrec(r \ X \ X, x, ?G)" + using wfrec[OF wf_onX,of x ?G] by simp + finally + have "wfrec(r \ X \ X, x, ?F) = wfrec(r \ X \ X, x, ?G)" by simp + } + then + show ?case by simp + qed + } + then + show ?thesis + unfolding ordermap_def wfrec_on_def using Int_ac by simp +qed + +end diff --git a/thys/Transitive_Models/Relativization.thy b/thys/Transitive_Models/Relativization.thy new file mode 100644 --- /dev/null +++ b/thys/Transitive_Models/Relativization.thy @@ -0,0 +1,856 @@ +section\Automatic relativization of terms and formulas\ + +text\Relativization of terms and formulas. Relativization of formulas shares relativized terms as +far as possible; assuming that the witnesses for the relativized terms are always unique.\ + +theory Relativization + imports + "ZF-Constructible.Datatype_absolute" + Higher_Order_Constructs + keywords + "relativize" :: thy_decl % "ML" + and + "relativize_tm" :: thy_decl % "ML" + and + "reldb_add" :: thy_decl % "ML" + and + "reldb_rem" :: thy_decl % "ML" + and + "relationalize" :: thy_decl % "ML" + and + "rel_closed" :: thy_goal_stmt % "ML" + and + "is_iff_rel" :: thy_goal_stmt % "ML" + and + "univalent" :: thy_goal_stmt % "ML" + and + "absolute" + and + "functional" + and + "relational" + and + "external" + and + "for" + +begin + +ML_file\Relativization_Database.ml\ + +ML\ +structure Absoluteness = Named_Thms + (val name = @{binding "absolut"} + val description = "Theorems of absoulte terms and predicates.") +\ +setup\Absoluteness.setup\ + +lemmas relative_abs = + M_trans.empty_abs + M_trans.pair_abs + M_trivial.cartprod_abs + M_trans.union_abs + M_trans.inter_abs + M_trans.setdiff_abs + M_trans.Union_abs + M_trivial.cons_abs + (*M_trans.upair_abs*) + M_trivial.successor_abs + M_trans.Collect_abs + M_trans.Replace_abs + M_trivial.lambda_abs2 + M_trans.image_abs + (*M_trans.powerset_abs*) + M_trivial.nat_case_abs + (* + M_trans.transitive_set_abs + M_trans.ordinal_abs + M_trivial.limit_ordinal_abs + M_trivial.successor_ordinal_abs + M_trivial.finite_ordinal_abs +*) + M_trivial.omega_abs + M_basic.sum_abs + M_trivial.Inl_abs + M_trivial.Inr_abs + M_basic.converse_abs + M_basic.vimage_abs + M_trans.domain_abs + M_trans.range_abs + M_basic.field_abs + (* M_basic.apply_abs *) + (* + M_trivial.typed_function_abs + M_basic.injection_abs + M_basic.surjection_abs + M_basic.bijection_abs + *) + M_basic.composition_abs + M_trans.restriction_abs + M_trans.Inter_abs + M_trivial.bool_of_o_abs + M_trivial.not_abs + M_trivial.and_abs + M_trivial.or_abs + M_trivial.Nil_abs + M_trivial.Cons_abs + (*M_trivial.quasilist_abs*) + M_trivial.list_case_abs + M_trivial.hd_abs + M_trivial.tl_abs + M_trivial.least_abs' + M_eclose.transrec_abs + M_trans.If_abs + M_trans.The_abs + M_eclose.recursor_abs + M_trancl.trans_wfrec_abs + M_trancl.trans_wfrec_on_abs + +lemmas datatype_abs = + M_datatypes.list_N_abs + M_datatypes.list_abs + M_datatypes.formula_N_abs + M_datatypes.formula_abs + M_eclose.is_eclose_n_abs + M_eclose.eclose_abs + M_datatypes.length_abs + M_datatypes.nth_abs + M_trivial.Member_abs + M_trivial.Equal_abs + M_trivial.Nand_abs + M_trivial.Forall_abs + M_datatypes.depth_abs + M_datatypes.formula_case_abs + +declare relative_abs[absolut] +declare datatype_abs[absolut] + +ML\ +signature Relativization = + sig + structure Data: GENERIC_DATA + val Rel_add: attribute + val Rel_del: attribute + val add_rel_const : Database.mode -> term -> term -> Data.T -> Data.T + val add_constant : Database.mode -> string -> string -> Proof.context -> Proof.context + val rem_constant : (term -> Data.T -> Data.T) -> string -> Proof.context -> Proof.context + val db: Data.T + val init_db : Data.T -> theory -> theory + val get_db : Proof.context -> Data.T + val relativ_fm: bool -> bool -> term -> Data.T -> (term * (term * term)) list * Proof.context * term list * bool -> term -> term * ((term * (term * term)) list * term list * term list * Proof.context) + val relativ_tm: bool -> bool -> term option -> term -> Data.T -> (term * (term * term)) list * Proof.context -> term -> term * (term * (term * term)) list * Proof.context + val read_new_const : Proof.context -> string -> term + val relativ_tm_frm': bool -> bool -> term -> Data.T -> Proof.context -> term -> term option * term + val relativize_def: bool -> bool -> bool -> bstring -> string -> Position.T -> Proof.context -> Proof.context + val relativize_tm: bool -> bstring -> string -> Position.T -> Proof.context -> Proof.context + val rel_closed_goal : string -> Position.T -> Proof.context -> Proof.state + val iff_goal : string -> Position.T -> Proof.context -> Proof.state + val univalent_goal : string -> Position.T -> Proof.context -> Proof.state + end + +structure Relativization : Relativization = struct + +infix 6 &&& +val op &&& = Utils.&&& + +infix 6 *** +val op *** = Utils.*** + +infix 6 @@ +val op @@ = Utils.@@ + +infix 6 --- +val op --- = Utils.--- + +fun insert_abs2rel ((t, u), db) = ((t, u), Database.insert Database.abs2rel (t, t) db) + +fun insert_rel2is ((t, u), db) = Database.insert Database.rel2is (t, u) db + +(* relativization db of relation constructors *) +val db = [ (@{const relation}, @{const Relative.is_relation}) + , (@{const function}, @{const Relative.is_function}) + , (@{const mem}, @{const mem}) + , (@{const True}, @{const True}) + , (@{const False}, @{const False}) + , (@{const Memrel}, @{const membership}) + , (@{const trancl}, @{const tran_closure}) + , (@{const IFOL.eq(i)}, @{const IFOL.eq(i)}) + , (@{const Subset}, @{const Relative.subset}) + , (@{const quasinat}, @{const Relative.is_quasinat}) + , (@{const apply}, @{const Relative.fun_apply}) + , (@{const Upair}, @{const Relative.upair}) + ] + |> List.foldr (insert_rel2is o insert_abs2rel) Database.empty + |> Database.insert Database.abs2is (@{const Pi}, @{const is_funspace}) + +fun var_i v = Free (v, @{typ i}) +fun var_io v = Free (v, @{typ "i \ o"}) +val const_name = #1 o dest_Const + +val lookup_tm = AList.lookup (op aconv) +val update_tm = AList.update (op aconv) +val join_tm = AList.join (op aconv) (K #1) + +val conj_ = Utils.binop @{const "IFOL.conj"} + +(* generic data *) +structure Data = Generic_Data +( + type T = Database.db + val empty = Database.empty (* Should we initialize this outside this file? *) + val merge = Database.merge +); + +fun init_db db = Context.theory_map (Data.put db) + +fun get_db thy = Data.get (Context.Proof thy) + +val read_const = Proof_Context.read_const {proper = true, strict = true} +val read_new_const = Proof_Context.read_term_pattern + +fun add_rel_const mode c t = Database.insert mode (c, t) + +fun get_consts thm = + let val (c_rel, rhs) = Thm.concl_of thm |> Utils.dest_trueprop |> + Utils.dest_iff_tms |>> head_of + in case try Utils.dest_eq_tms rhs of + SOME tm => (c_rel, tm |> #2 |> head_of) + | NONE => (c_rel, rhs |> Utils.dest_mem_tms |> #2 |> head_of) + end + +fun add_rule thm rs = + let val (c_rel,c_abs) = get_consts thm + (* in (add_rel_const Database.rel2is c_abs c_rel o add_rel_const Database.abs2rel c_abs c_abs) rs *) + in (add_rel_const Database.abs2rel c_abs c_abs o add_rel_const Database.abs2is c_abs c_rel) rs +end + +fun get_mode is_functional relationalising = if relationalising then Database.rel2is else if is_functional then Database.abs2rel else Database.abs2is + +fun add_constant mode abs rel thy = + let + val c_abs = read_new_const thy abs + val c_rel = read_new_const thy rel + val db_map = Data.map (Database.insert mode (c_abs, c_rel)) + fun add_to_context ctxt' = Context.proof_map db_map ctxt' + fun add_to_theory ctxt' = Local_Theory.raw_theory (Context.theory_map db_map) ctxt' + in + Local_Theory.target (add_to_theory o add_to_context) thy + end + +fun rem_constant rem_op c thy = + let + val c = read_new_const thy c + val db_map = Data.map (rem_op c) + fun add_to_context ctxt' = Context.proof_map db_map ctxt' + fun add_to_theory ctxt' = Local_Theory.raw_theory (Context.theory_map db_map) ctxt' + in + Local_Theory.target (add_to_theory o add_to_context) thy + end + +val del_rel_const = Database.remove_abs + +fun del_rule thm = del_rel_const (thm |> get_consts |> #2) + +val Rel_add = + Thm.declaration_attribute (fn thm => fn context => + Data.map (add_rule (Thm.trim_context thm)) context); + +val Rel_del = + Thm.declaration_attribute (fn thm => fn context => + Data.map (del_rule (Thm.trim_context thm)) context); + +(* Conjunction of a list of terms *) +fun conjs [] = @{term IFOL.True} + | conjs (fs as _ :: _) = foldr1 (uncurry conj_) fs + +(* Produces a relativized existential quantification of the term t *) +fun rex p t (Free v) = @{const rex} $ p $ lambda (Free v) t + | rex _ t (Bound _) = t + | rex _ t tm = raise TERM ("rex shouldn't handle this.",[tm,t]) + +(* Constants that do not take the class predicate *) +val absolute_rels = [ @{const ZF_Base.mem} + , @{const IFOL.eq(i)} + , @{const Memrel} + , @{const True} + , @{const False} + ] + +(* Creates the relational term corresponding to a term of type i. If the last + argument is (SOME v) then that variable is not bound by an existential + quantifier. +*) +fun close_rel_tm pred tm tm_var rs = + let val news = filter (not o (fn x => is_Free x orelse is_Bound x) o #1) rs + val (vars, tms) = split_list (map #2 news) ||> (curry op @) (the_list tm) + val vars = case tm_var of + SOME w => filter (fn v => not (v = w)) vars + | NONE => vars + in fold (fn v => fn t => rex pred (incr_boundvars 1 t) v) vars (conjs tms) + end + +fun relativ_tms __ _ _ rs ctxt [] = ([], rs, ctxt) + | relativ_tms is_functional relationalising pred rel_db rs ctxt (u :: us) = + let val (w_u, rs_u, ctxt_u) = relativ_tm is_functional relationalising NONE pred rel_db (rs, ctxt) u + val (w_us, rs_us, ctxt_us) = relativ_tms is_functional relationalising pred rel_db rs_u ctxt_u us + in (w_u :: w_us, join_tm (rs_u , rs_us), ctxt_us) + end +and + (* The result of the relativization of a term is a triple consisting of + a. the relativized term (it can be a free or a bound variable but also a Collect) + b. a list of (term * (term, term)), taken as a map, which is used + to reuse relativization of different occurrences of the same term. The + first element is the original term, the second its relativized version, + and the last one is the predicate corresponding to it. + c. the resulting context of created variables. + *) + relativ_tm is_functional relationalising mv pred rel_db (rs,ctxt) tm = + let + (* relativization of a fully applied constant *) + fun mk_rel_const mv c (args, after) abs_args ctxt = + case Database.lookup (get_mode is_functional relationalising) c rel_db of + SOME p => + let + val args' = List.filter (not o member (op =) (Utils.frees p)) args + val (v, ctxt1) = + the_default + (Variable.variant_fixes [""] ctxt |>> var_i o hd) + (Utils.map_option (I &&& K ctxt) mv) + val args' = + (* FIXME: This special case for functional relativization of sigma should not be needed *) + if c = @{const Sigma} andalso is_functional + then + let + val t = hd args' + val t' = Abs ("uu_", @{typ "i"}, (hd o tl) args' |> incr_boundvars 1) + in + [t, t'] + end + else + args' + val arg_list = if after then abs_args @ args' else args' @ abs_args + val r_tm = + if is_functional + then list_comb (p, if p = c then arg_list else pred :: arg_list) + else list_comb (p, if (not o null) args' andalso hd args' = pred then arg_list @ [v] else pred :: arg_list @ [v]) + in + if is_functional + then (r_tm, r_tm, ctxt) + else (v, r_tm, ctxt1) + end + | NONE => raise TERM ("Constant " ^ const_name c ^ " is not present in the db." , nil) + (* relativization of a partially applied constant *) + fun relativ_app mv mctxt tm abs_args (Const c) (args, after) rs = + let + val (w_ts, rs_ts, ctxt_ts) = relativ_tms is_functional relationalising pred rel_db rs (the_default ctxt mctxt) args + val (w_tm, r_tm, ctxt_tm) = mk_rel_const mv (Const c) (w_ts, after) abs_args ctxt_ts + val rs_ts' = if is_functional then rs_ts else update_tm (tm, (w_tm, r_tm)) rs_ts + in + (w_tm, rs_ts', ctxt_tm) + end + | relativ_app _ _ _ _ t _ _ = + raise TERM ("Tried to relativize an application with a non-constant in head position",[t]) + + (* relativization of non dependent product and sum *) + fun relativ_app_no_dep mv tm c t t' rs = + if loose_bvar1 (t', 0) + then + raise TERM("A dependency was found when trying to relativize", [tm]) + else + relativ_app mv NONE tm [] c ([t, incr_boundvars ~1 t'], false) rs + + fun relativ_replace mv t body after ctxt' = + let + val (v, b) = Utils.dest_abs body |>> var_i ||> after + val (b', (rs', ctxt'')) = + relativ_fm is_functional relationalising pred rel_db (rs, ctxt', single v, false) b |>> incr_boundvars 1 ||> #1 &&& #4 + in + relativ_app mv (SOME ctxt'') tm [lambda v b'] @{const Replace} ([t], false) rs' + end + + fun get_abs_body (Abs body) = body + | get_abs_body t = raise TERM ("Term is not Abs", [t]) + + fun go _ (Var _) = raise TERM ("Var: Is this possible?",[]) + | go mv (@{const Replace} $ t $ Abs body) = relativ_replace mv t body I ctxt + (* It is easier to rewrite RepFun as Replace before relativizing, + since { f(x) . x \ t } = { y . x \ t, y = f(x) } *) + | go mv (@{const RepFun} $ t $ Abs body) = + let + val (y, ctxt') = Variable.variant_fixes [""] ctxt |>> var_i o hd + in + relativ_replace mv t body (lambda y o Utils.eq_ y o incr_boundvars 1) ctxt' + end + | go mv (@{const Collect} $ t $ pc) = + let + val (pc', (rs', ctxt')) = relativ_fm is_functional relationalising pred rel_db (rs,ctxt, [], false) pc ||> #1 &&& #4 + in + relativ_app mv (SOME ctxt') tm [pc'] @{const Collect} ([t], false) rs' + end + | go mv (@{const Least} $ pc) = + let + val (pc', (rs', ctxt')) = relativ_fm is_functional relationalising pred rel_db (rs,ctxt, [], false) pc ||> #1 &&& #4 + in + relativ_app mv (SOME ctxt') tm [pc'] @{const Least} ([], false) rs' + end + | go mv (@{const transrec} $ t $ Abs body) = + let + val (res, ctxt') = Variable.variant_fixes [if is_functional then "_aux" else ""] ctxt |>> var_i o hd + val (x, b') = Utils.dest_abs body |>> var_i + val (y, b) = get_abs_body b' |> Utils.dest_abs |>> var_i + val p = Utils.eq_ res b |> lambda res + val (p', (rs', ctxt'')) = relativ_fm is_functional relationalising pred rel_db (rs, ctxt', [x, y], true) p |>> incr_boundvars 3 ||> #1 &&& #4 + val p' = if is_functional then p' |> #2 o Utils.dest_eq_tms o #2 o Utils.dest_abs o get_abs_body else p' + in + relativ_app mv (SOME ctxt'') tm [p' |> lambda x o lambda y] @{const transrec} ([t], not is_functional) rs' + end + | go mv (tm as @{const Sigma} $ t $ Abs (_, _, t')) = + relativ_app_no_dep mv tm @{const Sigma} t t' rs + | go mv (tm as @{const Pi} $ t $ Abs (_, _, t')) = + relativ_app_no_dep mv tm @{const Pi} t t' rs + | go mv (tm as @{const bool_of_o} $ t) = + let + val (t', (rs', ctxt')) = relativ_fm is_functional relationalising pred rel_db (rs, ctxt, [], false) t ||> #1 &&& #4 + in + relativ_app mv (SOME ctxt') tm [t'] @{const bool_of_o} ([], false) rs' + end + | go mv (tm as @{const If} $ b $ t $ t') = + let + val (br, (rs', ctxt')) = relativ_fm is_functional relationalising pred rel_db (rs, ctxt, [], false) b ||> #1 &&& #4 + in + relativ_app mv (SOME ctxt') tm [br] @{const If} ([t,t'], true) rs' + end + | go mv (@{const The} $ pc) = + let + val (pc', (rs', ctxt')) = relativ_fm is_functional relationalising pred rel_db (rs,ctxt, [], false) pc ||> #1 &&& #4 + in + relativ_app mv (SOME ctxt') tm [pc'] @{const The} ([], false) rs' + end + | go mv (@{const recursor} $ t $ Abs body $ t') = + let + val (res, ctxt') = Variable.variant_fixes [if is_functional then "_aux" else ""] ctxt |>> var_i o hd + val (x, b') = Utils.dest_abs body |>> var_i + val (y, b) = get_abs_body b' |> Utils.dest_abs |>> var_i + val p = Utils.eq_ res b |> lambda res + val (p', (rs', ctxt'')) = relativ_fm is_functional relationalising pred rel_db (rs, ctxt', [x, y], true) p |>> incr_boundvars 3 ||> #1 &&& #4 + val p' = if is_functional then p' |> #2 o Utils.dest_eq_tms o #2 o Utils.dest_abs o get_abs_body else p' + val (tr, rs'', ctxt''') = relativ_tm is_functional relationalising NONE pred rel_db (rs', ctxt'') t + in + relativ_app mv (SOME ctxt''') tm [tr, p' |> lambda x o lambda y] @{const recursor} ([t'], true) rs'' + end + | go mv (@{const wfrec} $ t1 $ t2 $ Abs body) = + let + val (res, ctxt') = Variable.variant_fixes [if is_functional then "_aux" else ""] ctxt |>> var_i o hd + val (x, b') = Utils.dest_abs body |>> var_i + val (y, b) = get_abs_body b' |> Utils.dest_abs |>> var_i + val p = Utils.eq_ res b |> lambda res + val (p', (rs', ctxt'')) = relativ_fm is_functional relationalising pred rel_db (rs, ctxt', [x, y], true) p |>> incr_boundvars 3 ||> #1 &&& #4 + val p' = if is_functional then p' |> #2 o Utils.dest_eq_tms o #2 o Utils.dest_abs o get_abs_body else p' + in + relativ_app mv (SOME ctxt'') tm [p' |> lambda x o lambda y] @{const wfrec} ([t1,t2], not is_functional) rs' + end + | go mv (@{const wfrec_on} $ t1 $ t2 $ t3 $ Abs body) = + let + val (res, ctxt') = Variable.variant_fixes [if is_functional then "_aux" else ""] ctxt |>> var_i o hd + val (x, b') = Utils.dest_abs body |>> var_i + val (y, b) = get_abs_body b' |> Utils.dest_abs |>> var_i + val p = Utils.eq_ res b |> lambda res + val (p', (rs', ctxt'')) = relativ_fm is_functional relationalising pred rel_db (rs, ctxt', [x, y], true) p |>> incr_boundvars 3 ||> #1 &&& #4 + val p' = if is_functional then p' |> #2 o Utils.dest_eq_tms o #2 o Utils.dest_abs o get_abs_body else p' + in + relativ_app mv (SOME ctxt'') tm [p' |> lambda x o lambda y] @{const wfrec_on} ([t1,t2,t3], not is_functional) rs' + end + | go mv (@{const Lambda} $ t $ Abs body) = + let + val (res, ctxt') = Variable.variant_fixes [if is_functional then "_aux" else ""] ctxt |>> var_i o hd + val (x, b) = Utils.dest_abs body |>> var_i + val p = Utils.eq_ res b |> lambda res + val (p', (rs', ctxt'')) = relativ_fm is_functional relationalising pred rel_db (rs, ctxt', [x], true) p |>> incr_boundvars 2 ||> #1 &&& #4 + val p' = if is_functional then p' |> #2 o Utils.dest_eq_tms o #2 o Utils.dest_abs o get_abs_body else p' + val (tr, rs'', ctxt''') = relativ_tm is_functional relationalising NONE pred rel_db (rs', ctxt'') t + in + relativ_app mv (SOME ctxt''') tm [tr, p' |> lambda x] @{const Lambda} ([], true) rs'' + end + (* The following are the generic cases *) + | go mv (tm as Const _) = relativ_app mv NONE tm [] tm ([], false) rs + | go mv (tm as _ $ _) = (strip_comb tm ||> I &&& K false |> uncurry (relativ_app mv NONE tm [])) rs + | go _ tm = if is_functional then (tm, rs, ctxt) else (tm, update_tm (tm,(tm,tm)) rs, ctxt) + + (* we first check if the term has been already relativized as a variable *) + in case lookup_tm rs tm of + NONE => go mv tm + | SOME (w, _) => (w, rs, ctxt) + end +and + relativ_fm is_functional relationalising pred rel_db (rs, ctxt, vs, is_term) fm = + let + + (* relativization of a fully applied constant *) + fun relativ_app (ctxt, rs) c args = case Database.lookup (get_mode is_functional relationalising) c rel_db of + SOME p => + let (* flag indicates whether the relativized constant is absolute or not. *) + val flag = not (exists (curry op aconv c) absolute_rels orelse c = p) + val (args, rs_ts, ctxt') = relativ_tms is_functional relationalising pred rel_db rs ctxt args + (* TODO: Verify if next line takes care of locales' definitions *) + val args' = List.filter (not o member (op =) (Utils.frees p)) args + val args'' = if not (null args') andalso hd args' = pred then args' else pred :: args' + val tm = list_comb (p, if flag then args'' else args') + (* TODO: Verify if next line is necessary *) + val news = filter (not o (fn x => is_Free x orelse is_Bound x) o #1) rs_ts + val (vars, tms) = split_list (map #2 news) + (* val vars = filter (fn v => not (v = tm)) vars *) (* Verify if this line is necessary *) + in (tm, (rs_ts, vars, tms, ctxt')) + end + | NONE => raise TERM ("Constant " ^ const_name c ^ " is not present in the db." , nil) + + fun close_fm quantifier (f, (rs, vars, tms, ctxt)) = + let + fun contains_b0 t = loose_bvar1 (t, 0) + + fun contains_extra_var t = fold (fn v => fn acc => acc orelse fold_aterms (fn t => fn acc => t = v orelse acc) t false) vs false + + fun contains_b0_extra t = contains_b0 t orelse contains_extra_var t + + (* t1 $ v \ t2 iff v \ FV(t2) *) + fun chained_frees (_ $ v) t2 = member (op =) (Utils.frees t2) v + | chained_frees t _ = raise TERM ("Malformed term", [t]) + + val tms_to_close = filter contains_b0_extra tms |> Utils.reachable chained_frees tms + val tms_to_keep = map (incr_boundvars ~1) (tms --- tms_to_close) + val vars_to_close = inter (op =) (map (List.last o #2 o strip_comb) tms_to_close) vars + val vars_to_keep = vars --- vars_to_close + val new_rs = + rs + |> filter (fn (k, (v, rel)) => not (contains_b0_extra k orelse contains_b0_extra v orelse contains_b0_extra rel)) + |> map (fn (k, (v, rel)) => (incr_boundvars ~1 k, (incr_boundvars ~1 v, incr_boundvars ~1 rel))) + + val f' = + if not is_term andalso not quantifier andalso is_functional + then pred $ Bound 0 :: (map (curry (op $) pred) vs) @ [f] + else [f] + in + (fold (fn v => fn t => rex pred (incr_boundvars 1 t) v) vars_to_close (conjs (f' @ tms_to_close)), + (new_rs, vars_to_keep, tms_to_keep, ctxt)) + end + + (* Handling of bounded quantifiers. *) + fun bquant (ctxt, rs) quant conn dom pred = + let val (v,pred') = Utils.dest_abs pred |>> var_i + in + go (ctxt, rs, false) (quant $ (lambda v o incr_boundvars 1) (conn $ (@{const mem} $ v $ dom) $ pred')) + end + and + bind_go (ctxt, rs) const f f' = + let + val (r , (rs1, vars1, tms1, ctxt1)) = go (ctxt, rs, false) f + val (r', (rs2, vars2, tms2, ctxt2)) = go (ctxt1, rs1, false) f' + in + (const $ r $ r', (rs2, vars1 @@ vars2, tms1 @@ tms2, ctxt2)) + end + and + relativ_eq_var (ctxt, rs) v t = + let + val (_, rs', ctxt') = relativ_tm is_functional relationalising (SOME v) pred rel_db (rs, ctxt) t + val f = lookup_tm rs' t |> #2 o the + val rs'' = filter (not o (curry (op =) t) o #1) rs' + val news = filter (not o (fn x => is_Free x orelse is_Bound x) o #1) rs'' + val (vars, tms) = split_list (map #2 news) + in + (f, (rs'', vars, tms, ctxt')) + end + and + relativ_eq (ctxt, rs) t1 t2 = + if is_functional orelse ((is_Free t1 orelse is_Bound t1) andalso (is_Free t2 orelse is_Bound t2)) then + relativ_app (ctxt, rs) @{const IFOL.eq(i)} [t1, t2] + else if is_Free t1 orelse is_Bound t1 then + relativ_eq_var (ctxt, rs) t1 t2 + else if is_Free t2 orelse is_Bound t2 then + relativ_eq_var (ctxt, rs) t2 t1 + else + relativ_app (ctxt, rs) @{const IFOL.eq(i)} [t1, t2] + and + go (ctxt, rs, _ ) (@{const IFOL.conj} $ f $ f') = bind_go (ctxt, rs) @{const IFOL.conj} f f' + | go (ctxt, rs, _ ) (@{const IFOL.disj} $ f $ f') = bind_go (ctxt, rs) @{const IFOL.disj} f f' + | go (ctxt, rs, _ ) (@{const IFOL.Not} $ f) = go (ctxt, rs, false) f |>> ((curry op $) @{const IFOL.Not}) + | go (ctxt, rs, _ ) (@{const IFOL.iff} $ f $ f') = bind_go (ctxt, rs) @{const IFOL.iff} f f' + | go (ctxt, rs, _ ) (@{const IFOL.imp} $ f $ f') = bind_go (ctxt, rs) @{const IFOL.imp} f f' + | go (ctxt, rs, _ ) (@{const IFOL.All(i)} $ f) = go (ctxt, rs, true) f |>> ((curry op $) (@{const OrdQuant.rall} $ pred)) + | go (ctxt, rs, _ ) (@{const IFOL.Ex(i)} $ f) = go (ctxt, rs, true) f |>> ((curry op $) (@{const OrdQuant.rex} $ pred)) + | go (ctxt, rs, _ ) (@{const Bex} $ f $ Abs p) = bquant (ctxt, rs) @{const Ex(i)} @{const IFOL.conj} f p + | go (ctxt, rs, _ ) (@{const Ball} $ f $ Abs p) = bquant (ctxt, rs) @{const All(i)} @{const IFOL.imp} f p + | go (ctxt, rs, _ ) (@{const rall} $ _ $ p) = go (ctxt, rs, true) p |>> (curry op $) (@{const rall} $ pred) + | go (ctxt, rs, _ ) (@{const rex} $ _ $ p) = go (ctxt, rs, true) p |>> (curry op $) (@{const rex} $ pred) + | go (ctxt, rs, _ ) (@{const IFOL.eq(i)} $ t1 $ t2) = relativ_eq (ctxt, rs) t1 t2 + | go (ctxt, rs, _ ) (Const c) = relativ_app (ctxt, rs) (Const c) [] + | go (ctxt, rs, _ ) (tm as _ $ _) = strip_comb tm |> uncurry (relativ_app (ctxt, rs)) + | go (ctxt, rs, quantifier) (Abs (v, _, t)) = + let + val new_rs = map (fn (k, (v, rel)) => (incr_boundvars 1 k, (incr_boundvars 1 v, incr_boundvars 1 rel))) rs + in + go (ctxt, new_rs, false) t |> close_fm quantifier |>> lambda (var_i v) + end + | go _ t = raise TERM ("Relativization of formulas cannot handle this case.",[t]) + in + go (ctxt, rs, false) fm + end + + +fun relativ_tm_frm' is_functional relationalising cls_pred db ctxt tm = + let + fun get_bounds (l as Abs _) = op @@ (strip_abs l |>> map (op #1) ||> get_bounds) + | get_bounds (t as _$_) = strip_comb t |> op :: |> map get_bounds |> flat + | get_bounds _ = [] + + val ty = fastype_of tm + val initial_ctxt = fold Utils.add_to_context (get_bounds tm) ctxt + in + case ty of + @{typ i} => + let + val (w, rs, _) = relativ_tm is_functional relationalising NONE cls_pred db ([], initial_ctxt) tm + in + if is_functional + then (NONE, w) + else (SOME w, close_rel_tm cls_pred NONE (SOME w) rs) + end + | @{typ o} => + let + fun close_fm (f, (_, vars, tms, _)) = + fold (fn v => fn t => rex cls_pred (incr_boundvars 1 t) v) vars (conjs (f :: tms)) + in + (NONE, relativ_fm is_functional relationalising cls_pred db ([], initial_ctxt, [], false) tm |> close_fm) + end + | ty' => raise TYPE ("We can relativize only terms of types i and o", [ty'], [tm]) + end + +fun lname ctxt = Local_Theory.full_name ctxt o Binding.name + +fun destroy_first_lambdas (Abs (body as (_, ty, _))) = + Utils.dest_abs body ||> destroy_first_lambdas |> (#1 o #2) &&& ((fn v => Free (v, ty)) *** #2) ||> op :: + | destroy_first_lambdas t = (t, []) + +fun freeType (Free (_, ty)) = ty + | freeType t = raise TERM ("freeType", [t]) + +fun relativize_def is_external is_functional relationalising def_name thm_ref pos lthy = + let + val ctxt = lthy + val (vars,tm,ctxt1) = Utils.thm_concl_tm ctxt (thm_ref ^ "_def") + val db' = Data.get (Context.Proof lthy) + val (tm, lambdavars) = tm |> destroy_first_lambdas o #2 o Utils.dest_eq_tms' o Utils.dest_trueprop + val ctxt1 = fold Utils.add_to_context (map Utils.freeName lambdavars) ctxt1 + val (cls_pred, ctxt1, vars, lambdavars) = + if (not o null) vars andalso (#2 o #1 o hd) vars = @{typ "i \ o"} then + ((Thm.term_of o #2 o hd) vars, ctxt1, tl vars, lambdavars) + else if null vars andalso (not o null) lambdavars andalso (freeType o hd) lambdavars = @{typ "i \ o"} then + (hd lambdavars, ctxt1, vars, tl lambdavars) + else Variable.variant_fixes ["N"] ctxt1 |>> var_io o hd |> (fn (cls, ctxt) => (cls, ctxt, vars, lambdavars)) + val db' = db' |> Database.insert Database.abs2rel (cls_pred, cls_pred) + o Database.insert Database.rel2is (cls_pred, cls_pred) + val (v,t) = relativ_tm_frm' is_functional relationalising cls_pred db' ctxt1 tm + val t_vars = sort_strings (Term.add_free_names tm []) + val vs' = List.filter (#1 #> #1 #> #1 #> Ord_List.member String.compare t_vars) vars + val vs = cls_pred :: map (Thm.term_of o #2) vs' @ lambdavars @ the_list v + val at = List.foldr (uncurry lambda) t vs + val abs_const = read_const lthy (if is_external then thm_ref else lname lthy thm_ref) + fun new_const ctxt' = read_new_const ctxt' def_name + fun db_map ctxt' = + Data.map (add_rel_const (get_mode is_functional relationalising) abs_const (new_const ctxt')) + fun add_to_context ctxt' = Context.proof_map (db_map ctxt') ctxt' + fun add_to_theory ctxt' = Local_Theory.raw_theory (Context.theory_map (db_map ctxt')) ctxt' + in + lthy + |> Local_Theory.define ((Binding.name def_name, NoSyn), ((Binding.name (def_name ^ "_def"), []), at)) + |>> (#2 #> (fn (s,t) => (s,[t]))) + |> Utils.display "theorem" pos + |> Local_Theory.target (add_to_theory o add_to_context) + end + +fun relativize_tm is_functional def_name term pos lthy = + let + val ctxt = lthy + val (cls_pred, ctxt1) = Variable.variant_fixes ["N"] ctxt |>> var_io o hd + val tm = Syntax.read_term ctxt1 term + val db' = Data.get (Context.Proof lthy) + val db' = db' |> Database.insert Database.abs2rel (cls_pred, cls_pred) + o Database.insert Database.rel2is (cls_pred, cls_pred) + val vs' = Variable.add_frees ctxt1 tm [] + val ctxt2 = fold Utils.add_to_context (map #1 vs') ctxt1 + val (v,t) = relativ_tm_frm' is_functional false cls_pred db' ctxt2 tm + val vs = cls_pred :: map Free vs' @ the_list v + val at = List.foldr (uncurry lambda) t vs + in + lthy + |> Local_Theory.define ((Binding.name def_name, NoSyn), ((Binding.name (def_name ^ "_def"), []), at)) + |>> (#2 #> (fn (s,t) => (s,[t]))) + |> Utils.display "theorem" pos + end + +val op $` = curry ((op $) o swap) +infix $` + +fun is_free_i (Free (_, @{typ "i"})) = true + | is_free_i _ = false + +fun rel_closed_goal target pos lthy = + let + val (_, tm, _) = Utils.thm_concl_tm lthy (target ^ "_rel_def") + val (def, tm) = tm |> Utils.dest_eq_tms' + fun first_lambdas (Abs (body as (_, ty, _))) = + if ty = @{typ "i"} + then (op ::) (Utils.dest_abs body |>> Utils.var_i ||> first_lambdas) + else Utils.dest_abs body |> first_lambdas o #2 + | first_lambdas _ = [] + val (def, vars) = Term.strip_comb def ||> filter is_free_i + val vs = vars @ first_lambdas tm + val class = Free ("M", @{typ "i \ o"}) + val def = fold (op $`) (class :: vs) def + val hyps = map (fn v => class $ v |> Utils.tp) vs + val concl = class $ def + val goal = Logic.list_implies (hyps, Utils.tp concl) + val attribs = @{attributes [intro, simp]} + in + Proof.theorem NONE (fn thmss => Utils.display "theorem" pos + o Local_Theory.note ((Binding.name (target ^ "_rel_closed"), attribs), hd thmss)) + [[(goal, [])]] lthy + end + +fun iff_goal target pos lthy = + let + val (_, tm, ctxt') = Utils.thm_concl_tm lthy (target ^ "_rel_def") + val (_, is_def, ctxt) = Utils.thm_concl_tm ctxt' ("is_" ^ target ^ "_def") + val is_def = is_def |> Utils.dest_eq_tms' |> #1 |> Term.strip_comb |> #1 + val (def, tm) = tm |> Utils.dest_eq_tms' + fun first_lambdas (Abs (body as (_, ty, _))) = + if ty = @{typ "i"} + then (op ::) (Utils.dest_abs body |>> Utils.var_i ||> first_lambdas) + else Utils.dest_abs body |> first_lambdas o #2 + | first_lambdas _ = [] + val (def, vars) = Term.strip_comb def ||> filter is_free_i + val vs = vars @ first_lambdas tm + val class = Free ("M", @{typ "i \ o"}) + val def = fold (op $`) (class :: vs) def + val ty = fastype_of def + val res = if ty = @{typ "i"} + then Variable.variant_fixes ["res"] ctxt |> SOME o Utils.var_i o hd o #1 + else NONE + val is_def = fold (op $`) (class :: vs @ the_list res) is_def + val hyps = map (fn v => class $ v |> Utils.tp) (vs @ the_list res) + val concl = @{const "IFOL.iff"} $ is_def + $ (if ty = @{typ "i"} then (@{const IFOL.eq(i)} $ the res $ def) else def) + val goal = Logic.list_implies (hyps, Utils.tp concl) + in + Proof.theorem NONE (fn thmss => Utils.display "theorem" pos + o Local_Theory.note ((Binding.name ("is_" ^ target ^ "_iff"), []), hd thmss)) + [[(goal, [])]] lthy + end + +fun univalent_goal target pos lthy = + let + val (_, tm, ctxt) = Utils.thm_concl_tm lthy ("is_" ^ target ^ "_def") + val (def, tm) = tm |> Utils.dest_eq_tms' + fun first_lambdas (Abs (body as (_, ty, _))) = + if ty = @{typ "i"} + then (op ::) (Utils.dest_abs body |>> Utils.var_i ||> first_lambdas) + else Utils.dest_abs body |> first_lambdas o #2 + | first_lambdas _ = [] + val (def, vars) = Term.strip_comb def ||> filter is_free_i + val vs = vars @ first_lambdas tm + val n = length vs + val vs = List.take (vs, n - 2) + val class = Free ("M", @{typ "i \ o"}) + val def = fold (op $`) (class :: vs) def + val v = Variable.variant_fixes ["A"] ctxt |> Utils.var_i o hd o #1 + val hyps = map (fn v => class $ v |> Utils.tp) (v :: vs) + val concl = @{const "Relative.univalent"} $ class $ v $ def + val goal = Logic.list_implies (hyps, Utils.tp concl) + in + Proof.theorem NONE (fn thmss => Utils.display "theorem" pos + o Local_Theory.note ((Binding.name ("univalent_is_" ^ target), []), hd thmss)) + [[(goal, [])]] lthy + end + +end +\ + +ML\ +local + val full_mode_parser = + Scan.option (((Parse.$$$ "functional" |-- Parse.$$$ "relational") >> K Database.rel2is) + || (((Scan.option (Parse.$$$ "absolute")) |-- Parse.$$$ "functional") >> K Database.abs2rel) + || (((Scan.option (Parse.$$$ "absolute")) |-- Parse.$$$ "relational") >> K Database.abs2is)) + >> (fn mode => the_default Database.abs2is mode) + + val reldb_parser = + Parse.position (full_mode_parser -- (Parse.string -- Parse.string)); + + val singlemode_parser = (Parse.$$$ "absolute" >> K Database.remove_abs) + || (Parse.$$$ "functional" >> K Database.remove_rel) + || (Parse.$$$ "relational" >> K Database.remove_is) + + val reldb_rem_parser = Parse.position (singlemode_parser -- Parse.string) + + val mode_parser = + Scan.option ((Parse.$$$ "relational" >> K false) || (Parse.$$$ "functional" >> K true)) + >> (fn mode => if is_none mode then false else the mode) + + val relativize_parser = + Parse.position (mode_parser -- (Parse.string -- Parse.string) -- (Scan.optional (Parse.$$$ "external" >> K true) false)); + + val _ = + Outer_Syntax.local_theory \<^command_keyword>\reldb_add\ "ML setup for adding relativized/absolute pairs" + (reldb_parser >> (fn ((mode, (abs_term,rel_term)),_) => + Relativization.add_constant mode abs_term rel_term)) + + val _ = + Outer_Syntax.local_theory \<^command_keyword>\reldb_rem\ "ML setup for adding relativized/absolute pairs" + (reldb_rem_parser >> (uncurry Relativization.rem_constant o #1)) + + val _ = + Outer_Syntax.local_theory \<^command_keyword>\relativize\ "ML setup for relativizing definitions" + (relativize_parser >> (fn (((is_functional, (bndg,thm)), is_external),pos) => + Relativization.relativize_def is_external is_functional false thm bndg pos)) + + val _ = + Outer_Syntax.local_theory \<^command_keyword>\relativize_tm\ "ML setup for relativizing definitions" + (relativize_parser >> (fn (((is_functional, (bndg,term)), _),pos) => + Relativization.relativize_tm is_functional term bndg pos)) + + val _ = + Outer_Syntax.local_theory \<^command_keyword>\relationalize\ "ML setup for relativizing definitions" + (relativize_parser >> (fn (((is_functional, (bndg,thm)), is_external),pos) => + Relativization.relativize_def is_external is_functional true thm bndg pos)) + + val _ = + Outer_Syntax.local_theory_to_proof \<^command_keyword>\rel_closed\ "ML setup for rel_closed theorem" + (Parse.position (Parse.$$$ "for" |-- Parse.string) >> (fn (target,pos) => + Relativization.rel_closed_goal target pos)) + + val _ = + Outer_Syntax.local_theory_to_proof \<^command_keyword>\is_iff_rel\ "ML setup for rel_closed theorem" + (Parse.position (Parse.$$$ "for" |-- Parse.string) >> (fn (target,pos) => + Relativization.iff_goal target pos)) + + val _ = + Outer_Syntax.local_theory_to_proof \<^command_keyword>\univalent\ "ML setup for rel_closed theorem" + (Parse.position (Parse.$$$ "for" |-- Parse.string) >> (fn (target,pos) => + Relativization.univalent_goal target pos)) + +val _ = + Theory.setup + (Attrib.setup \<^binding>\Rel\ (Attrib.add_del Relativization.Rel_add Relativization.Rel_del) + "declaration of relativization rule") ; +in +end +\ +setup\Relativization.init_db Relativization.db \ + +declare relative_abs[Rel] + (*todo: check all the duplicate cases here.*) +declare datatype_abs[Rel] + +ML\ +val db = Relativization.get_db @{context} +\ + +end diff --git a/thys/Transitive_Models/Relativization_Database.ml b/thys/Transitive_Models/Relativization_Database.ml new file mode 100644 --- /dev/null +++ b/thys/Transitive_Models/Relativization_Database.ml @@ -0,0 +1,183 @@ +signature Database = + sig + type db + val empty : db + type mode + val abs2is : mode + val abs2rel : mode + val rel2is : mode + val lookup : mode -> term -> db -> term option + val insert : mode -> term * term -> db -> db + val remove_abs : term -> db -> db + val remove_rel : term -> db -> db + val remove_is : term -> db -> db + val merge : db * db -> db + + (* INVARIANTS *) + (* \ db : db, \ t, t' : term, \ m : mode, lookup m t db = lookup m t' db \ NONE \ t = t' *) + (* \ db : db, \ t, u, v : term, lookup abs2rel t db = SOME v \ lookup rel2is v db = SOME u \ lookup abs2is t db = SOME u *) + (* \ db : db, \ t, u, v : term, lookup abs2is t db = SOME u \ lookup rel2is v db = SOME u \ lookup abs2rel t db = SOME v *) + (* \ db : db, \ t, u, v : term, lookup abs2rel t db = SOME u \ lookup abs2is t db = SOME v \ lookup rel2is u db = SOME v *) + end + +structure Database : Database = struct + type db = { ar : (term * term) list + , af : (term * term) list + , fr : (term * term) list + } + + val empty = { ar = [] + , af = [] + , fr = [] + } + + datatype singlemode = Absolute | Relational | Functional + + type mode = singlemode * singlemode + + val abs2is = (Absolute, Relational) + + val abs2rel = (Absolute, Functional) + + val rel2is = (Functional, Relational) + + infix 6 &&& + val op &&& = Utils.&&& + + infix 5 ||| + fun op ||| (x, y) = fn t => + case x t of + SOME a => SOME a + | NONE => y t + + infix 5 >>= + fun op >>= (m, f) = + case m of + SOME x => f x + | NONE => NONE + + infix 6 COMP + fun op COMP (xs, ys) = fn t => AList.lookup (op aconv) ys t >>= AList.lookup (op aconv) xs + + val transpose = map (#2 &&& #1) + + fun lookup (Absolute, Relational) t db = (#fr db COMP #af db ||| AList.lookup (op aconv) (#ar db)) t + | lookup (Absolute, Functional) t db = AList.lookup (op aconv) (#af db) t + | lookup (Functional, Relational) t db = AList.lookup (op aconv) (#fr db) t + | lookup (Relational, Absolute) t db = (transpose (#af db) COMP transpose (#fr db) ||| AList.lookup (op aconv) (transpose (#ar db))) t + | lookup (Functional, Absolute) t db = AList.lookup (op aconv) (transpose (#af db)) t + | lookup (Relational, Functional) t db = AList.lookup (op aconv) (transpose (#fr db)) t + | lookup _ _ _ = error "lookup: unreachable clause" + + fun insert' warn (mode as (Absolute, Relational)) (t, u) db = + (case lookup mode t db of + SOME _ => (warn ("insert abs2is: duplicate entry for " ^ (@{make_string} t)); db) + | NONE => case lookup (Relational, Functional) u db of + SOME v => if is_none (lookup (Functional, Absolute) v db) + then { ar = #ar db + , af = AList.update (op aconv) (t, v) (#af db) + , fr = #fr db + } + else error "invariant violation, insert abs2is" + | NONE => case lookup (Absolute, Functional) t db of + SOME v => { ar = #ar db + , af = #af db + , fr = AList.update (op aconv) (v, u) (#fr db) + } + | NONE => { ar = AList.update (op aconv) (t, u) (#ar db) + , af = #af db + , fr = #fr db + } + ) + | insert' warn (mode as (Absolute, Functional)) (t, v) db = + (case lookup mode t db of + SOME _ => (warn ("insert abs2rel: duplicate entry for " ^ (@{make_string} t)); db) + | NONE => case lookup (Functional, Relational) v db of + SOME u => (case lookup (Relational, Absolute) u db of + NONE => { ar = #ar db + , af = AList.update (op aconv) (t, v) (#af db) + , fr = #fr db + } + | SOME t' => if t = t' + then { ar = AList.delete (op aconv) t (#ar db) + , af = AList.update (op aconv) (t, v) (#af db) + , fr = #fr db + } + else error "invariant violation, insert abs2rel" + ) + | NONE => case lookup (Absolute, Relational) t db of + SOME u => { ar = AList.delete (op aconv) t (#ar db) + , af = AList.update (op aconv) (t, v) (#af db) + , fr = AList.update (op aconv) (v, u) (#fr db) + } + | NONE => { ar = #ar db + , af = AList.update (op aconv) (t, v) (#af db) + , fr = #fr db + } + ) + | insert' warn (mode as (Functional, Relational)) (v, u) db = + (case lookup mode v db of + SOME _ => (warn ("insert rel2is: duplicate entry for " ^ (@{make_string} v)); db) + | NONE => case (lookup (Functional, Absolute) v db, lookup (Relational, Absolute) u db) of + (SOME t, SOME t') => if t = t' + then { ar = AList.delete (op aconv) t (#ar db) + , af = #af db + , fr = AList.update (op aconv) (v, u) (#fr db) + } + else error ("invariant violation, insert rel2is: " ^ (@{make_string} (v, u, t, t'))) + | (SOME _, NONE) => { ar = #ar db + , af = #af db + , fr = AList.update (op aconv) (v, u) (#fr db) + } + | (NONE, SOME t') => { ar = AList.delete (op aconv) t' (#ar db) + , af = AList.update (op aconv) (t', v) (#af db) + , fr = AList.update (op aconv) (v, u) (#fr db) + } + | (NONE, NONE) => { ar = #ar db + , af = #af db + , fr = AList.update (op aconv) (v, u) (#fr db) + } + ) + | insert' _ _ _ _ = error "insert: unreachable clause" + + val insert = insert' warning + + fun remove Absolute t db = { ar = AList.delete (op aconv) t (#ar db) + , af = AList.delete (op aconv) t (#af db) + , fr = #fr db + } + | remove Functional v db = + (case lookup (Functional, Absolute) v db of + SOME t => (case lookup (Functional, Relational) v db of + SOME u => { ar = AList.update (op aconv) (t, u) (#ar db) + , af = transpose (AList.delete (op aconv) v (transpose (#af db))) + , fr = AList.delete (op aconv) v (#fr db) + } + | NONE => { ar = #ar db + , af = transpose (AList.delete (op aconv) v (transpose (#af db))) + , fr = #fr db + } + ) + | NONE => { ar = #ar db + , af = #af db + , fr = AList.delete (op aconv) v (#fr db) + } + ) + | remove Relational u db = { ar = transpose (AList.delete (op aconv) u (transpose (#ar db))) + , af = #af db + , fr = transpose (AList.delete (op aconv) u (transpose (#fr db))) + } + + val remove_abs = remove Absolute + + val remove_rel = remove Functional + + val remove_is = remove Relational + + fun merge (db, db') = + let + val modes = [(abs2rel, #af db'), (rel2is, #fr db'), (abs2is, #ar db)] + in + List.foldr (fn ((m, db'), db) => List.foldr (uncurry (insert' (K ()) m)) db db') db modes + end +end (* structure Database : Database *) \ No newline at end of file diff --git a/thys/Transitive_Models/Renaming.thy b/thys/Transitive_Models/Renaming.thy new file mode 100644 --- /dev/null +++ b/thys/Transitive_Models/Renaming.thy @@ -0,0 +1,572 @@ +section\Renaming of variables in internalized formulas\ + +theory Renaming + imports + ZF_Miscellanea + "ZF-Constructible.Formula" +begin + +subsection\Renaming of free variables\ + +definition + union_fun :: "[i,i,i,i] \ i" where + "union_fun(f,g,m,p) \ \j \ m \ p . if j\m then f`j else g`j" + +lemma union_fun_type: + assumes "f \ m \ n" + "g \ p \ q" + shows "union_fun(f,g,m,p) \ m \ p \ n \ q" +proof - + let ?h="union_fun(f,g,m,p)" + have + D: "?h`x \ n \ q" if "x \ m \ p" for x + proof (cases "x \ m") + case True + then have + "x \ m \ p" by simp + with \x\m\ + have "?h`x = f`x" + unfolding union_fun_def beta by simp + with \f \ m \ n\ \x\m\ + have "?h`x \ n" by simp + then show ?thesis .. + next + case False + with \x \ m \ p\ + have "x \ p" + by auto + with \x\m\ + have "?h`x = g`x" + unfolding union_fun_def using beta by simp + with \g \ p \ q\ \x\p\ + have "?h`x \ q" by simp + then show ?thesis .. + qed + have A:"function(?h)" unfolding union_fun_def using function_lam by simp + have " x\ (m \ p) \ (n \ q)" if "x\ ?h" for x + using that lamE[of x "m \ p" _ "x \ (m \ p) \ (n \ q)"] D unfolding union_fun_def + by auto + then have B:"?h \ (m \ p) \ (n \ q)" .. + have "m \ p \ domain(?h)" + unfolding union_fun_def using domain_lam by simp + with A B + show ?thesis using Pi_iff [THEN iffD2] by simp +qed + +lemma union_fun_action : + assumes + "env \ list(M)" + "env' \ list(M)" + "length(env) = m \ p" + "\ i . i \ m \ nth(f`i,env') = nth(i,env)" + "\ j . j \ p \ nth(g`j,env') = nth(j,env)" + shows "\ i . i \ m \ p \ + nth(i,env) = nth(union_fun(f,g,m,p)`i,env')" +proof - + let ?h = "union_fun(f,g,m,p)" + have "nth(x, env) = nth(?h`x,env')" if "x \ m \ p" for x + using that + proof (cases "x\m") + case True + with \x\m\ + have "?h`x = f`x" + unfolding union_fun_def beta by simp + with assms \x\m\ + have "nth(x,env) = nth(?h`x,env')" by simp + then show ?thesis . + next + case False + with \x \ m \ p\ + have + "x \ p" "x\m" by auto + then + have "?h`x = g`x" + unfolding union_fun_def beta by simp + with assms \x\p\ + have "nth(x,env) = nth(?h`x,env')" by simp + then show ?thesis . + qed + then show ?thesis by simp +qed + + +lemma id_fn_type : + assumes "n \ nat" + shows "id(n) \ n \ n" + unfolding id_def using \n\nat\ by simp + +lemma id_fn_action: + assumes "n \ nat" "env\list(M)" + shows "\ j . j < n \ nth(j,env) = nth(id(n)`j,env)" +proof - + show "nth(j,env) = nth(id(n)`j,env)" if "j < n" for j using that \n\nat\ ltD by simp +qed + + +definition + rsum :: "[i,i,i,i,i] \ i" where + "rsum(f,g,m,n,p) \ \j \ m+\<^sub>\p . if j\n" + +lemma sum_inl: + assumes "m \ nat" "n\nat" + "f \ m\n" "x \ m" + shows "rsum(f,g,m,n,p)`x = f`x" +proof - + from \m\nat\ + have "m\m+\<^sub>\p" + using add_le_self[of m] by simp + with assms + have "x\m+\<^sub>\p" + using ltI[of x m] lt_trans2[of x m "m+\<^sub>\p"] ltD by simp + from assms + have "xx\m+\<^sub>\p\ + show ?thesis unfolding rsum_def by simp +qed + +lemma sum_inr: + assumes "m \ nat" "n\nat" "p\nat" + "g\p\q" "m \ x" "x < m+\<^sub>\p" + shows "rsum(f,g,m,n,p)`x = g`(x#-m)+\<^sub>\n" +proof - + from assms + have "x\nat" + using in_n_in_nat[of "m+\<^sub>\p"] ltD + by simp + with assms + have "\ xm+\<^sub>\p" + using ltD by simp + with \\ x + show ?thesis unfolding rsum_def by simp +qed + + +lemma sum_action : + assumes "m \ nat" "n\nat" "p\nat" "q\nat" + "f \ m\n" "g\p\q" + "env \ list(M)" + "env' \ list(M)" + "env1 \ list(M)" + "env2 \ list(M)" + "length(env) = m" + "length(env1) = p" + "length(env') = n" + "\ i . i < m \ nth(i,env) = nth(f`i,env')" + "\ j. j < p \ nth(j,env1) = nth(g`j,env2)" + shows "\ i . i < m+\<^sub>\p \ + nth(i,env@env1) = nth(rsum(f,g,m,n,p)`i,env'@env2)" +proof - + let ?h = "rsum(f,g,m,n,p)" + from \m\nat\ \n\nat\ \q\nat\ + have "m\m+\<^sub>\p" "n\n+\<^sub>\q" "q\n+\<^sub>\q" + using add_le_self[of m] add_le_self2[of n q] by simp_all + from \p\nat\ + have "p = (m+\<^sub>\p)#-m" using diff_add_inverse2 by simp + have "nth(x, env @ env1) = nth(?h`x,env'@env2)" if "x\p" for x + proof (cases "xm" "f`x \ n" "x\nat" + using assms sum_inl ltD apply_type[of f m _ x] in_n_in_nat by simp_all + with \x assms + have "f`x < n" "f`xnat" + using ltI in_n_in_nat by simp_all + with 2 \x assms + have "nth(x,env@env1) = nth(x,env)" + using nth_append[OF \env\list(M)\] \x\nat\ by simp + also + have + "... = nth(f`x,env')" + using 2 \x assms by simp + also + have "... = nth(f`x,env'@env2)" + using nth_append[OF \env'\list(M)\] \f`x \f`x \nat\ by simp + also + have "... = nth(?h`x,env'@env2)" + using 2 by simp + finally + have "nth(x, env @ env1) = nth(?h`x,env'@env2)" . + then show ?thesis . + next + case False + have "x\nat" + using that in_n_in_nat[of "m+\<^sub>\p" x] ltD \p\nat\ \m\nat\ by simp + with \length(env) = m\ + have "m\x" "length(env) \ x" + using not_lt_iff_le \m\nat\ \\x by simp_all + with \\x \length(env) = m\ + have 2 : "?h`x= g`(x#-m)+\<^sub>\n" "\ x x\nat\ \p=m+\<^sub>\p#-m\ + have "x#-m < p" + using diff_mono[OF _ _ _ \x\p\ \m\x\] by simp + then have "x#-m\p" using ltD by simp + with \g\p\q\ + have "g`(x#-m) \ q" by simp + with \q\nat\ \length(env') = n\ + have "g`(x#-m) < q" "g`(x#-m)\nat" using ltI in_n_in_nat by simp_all + with \q\nat\ \n\nat\ + have "(g`(x#-m))+\<^sub>\n \q" "n \ g`(x#-m)+\<^sub>\n" "\ g`(x#-m)+\<^sub>\n < length(env')" + using add_lt_mono1[of "g`(x#-m)" _ n,OF _ \q\nat\] + add_le_self2[of n] \length(env') = n\ + by simp_all + from assms \\ x < length(env)\ \length(env) = m\ + have "nth(x,env @ env1) = nth(x#-m,env1)" + using nth_append[OF \env\list(M)\ \x\nat\] by simp + also + have "... = nth(g`(x#-m),env2)" + using assms \x#-m < p\ by simp + also + have "... = nth((g`(x#-m)+\<^sub>\n)#-length(env'),env2)" + using \length(env') = n\ + diff_add_inverse2 \g`(x#-m)\nat\ + by simp + also + have "... = nth((g`(x#-m)+\<^sub>\n),env'@env2)" + using nth_append[OF \env'\list(M)\] \n\nat\ \\ g`(x#-m)+\<^sub>\n < length(env')\ + by simp + also + have "... = nth(?h`x,env'@env2)" + using 2 by simp + finally + have "nth(x, env @ env1) = nth(?h`x,env'@env2)" . + then show ?thesis . + qed + then show ?thesis by simp +qed + +lemma sum_type : + assumes "m \ nat" "n\nat" "p\nat" "q\nat" + "f \ m\n" "g\p\q" + shows "rsum(f,g,m,n,p) \ (m+\<^sub>\p) \ (n+\<^sub>\q)" +proof - + let ?h = "rsum(f,g,m,n,p)" + from \m\nat\ \n\nat\ \q\nat\ + have "m\m+\<^sub>\p" "n\n+\<^sub>\q" "q\n+\<^sub>\q" + using add_le_self[of m] add_le_self2[of n q] by simp_all + from \p\nat\ + have "p = (m+\<^sub>\p)#-m" using diff_add_inverse2 by simp + {fix x + assume 1: "x\m+\<^sub>\p" "xm" + using assms sum_inl ltD by simp_all + with \f\m\n\ + have "?h`x \ n" by simp + with \n\nat\ have "?h`x < n" using ltI by simp + with \n\n+\<^sub>\q\ + have "?h`x < n+\<^sub>\q" using lt_trans2 by simp + then + have "?h`x \ n+\<^sub>\q" using ltD by simp + } + then have 1:"?h`x \ n+\<^sub>\q" if "x\m+\<^sub>\p" "xm+\<^sub>\p" "m\x" + then have "x\p" "x\nat" using ltI in_n_in_nat[of "m+\<^sub>\p"] ltD by simp_all + with 1 + have 2 : "?h`x= g`(x#-m)+\<^sub>\n" + using assms sum_inr ltD by simp_all + from assms \x\nat\ \p=m+\<^sub>\p#-m\ + have "x#-m < p" using diff_mono[OF _ _ _ \x\p\ \m\x\] by simp + then have "x#-m\p" using ltD by simp + with \g\p\q\ + have "g`(x#-m) \ q" by simp + with \q\nat\ have "g`(x#-m) < q" using ltI by simp + with \q\nat\ + have "(g`(x#-m))+\<^sub>\n \q" using add_lt_mono1[of "g`(x#-m)" _ n,OF _ \q\nat\] by simp + with 2 + have "?h`x \ n+\<^sub>\q" using ltD by simp + } + then have 2:"?h`x \ n+\<^sub>\q" if "x\m+\<^sub>\p" "m\x" for x using that . + have + D: "?h`x \ n+\<^sub>\q" if "x\m+\<^sub>\p" for x + using that + proof (cases "xm\nat\ have "m\x" using not_lt_iff_le that in_n_in_nat[of "m+\<^sub>\p"] by simp + then show ?thesis using 2 that by simp + qed + have A:"function(?h)" unfolding rsum_def using function_lam by simp + have " x\ (m +\<^sub>\ p) \ (n +\<^sub>\ q)" if "x\ ?h" for x + using that lamE[of x "m+\<^sub>\p" _ "x \ (m +\<^sub>\ p) \ (n +\<^sub>\ q)"] D unfolding rsum_def + by auto + then have B:"?h \ (m +\<^sub>\ p) \ (n +\<^sub>\ q)" .. + have "m +\<^sub>\ p \ domain(?h)" + unfolding rsum_def using domain_lam by simp + with A B + show ?thesis using Pi_iff [THEN iffD2] by simp +qed + +lemma sum_type_id : + assumes + "f \ length(env)\length(env')" + "env \ list(M)" + "env' \ list(M)" + "env1 \ list(M)" + shows + "rsum(f,id(length(env1)),length(env),length(env'),length(env1)) \ + (length(env)+\<^sub>\length(env1)) \ (length(env')+\<^sub>\length(env1))" + using assms length_type id_fn_type sum_type + by simp + +lemma sum_type_id_aux2 : + assumes + "f \ m\n" + "m \ nat" "n \ nat" + "env1 \ list(M)" + shows + "rsum(f,id(length(env1)),m,n,length(env1)) \ + (m+\<^sub>\length(env1)) \ (n+\<^sub>\length(env1))" + using assms id_fn_type sum_type + by auto + +lemma sum_action_id : + assumes + "env \ list(M)" + "env' \ list(M)" + "f \ length(env)\length(env')" + "env1 \ list(M)" + "\ i . i < length(env) \ nth(i,env) = nth(f`i,env')" + shows "\ i . i < length(env)+\<^sub>\length(env1) \ + nth(i,env@env1) = nth(rsum(f,id(length(env1)),length(env),length(env'),length(env1))`i,env'@env1)" +proof - + from assms + have "length(env)\nat" (is "?m \ _") by simp + from assms have "length(env')\nat" (is "?n \ _") by simp + from assms have "length(env1)\nat" (is "?p \ _") by simp + note lenv = id_fn_action[OF \?p\nat\ \env1\list(M)\] + note lenv_ty = id_fn_type[OF \?p\nat\] + { + fix i + assume "i < length(env)+\<^sub>\length(env1)" + have "nth(i,env@env1) = nth(rsum(f,id(length(env1)),?m,?n,?p)`i,env'@env1)" + using sum_action[OF \?m\nat\ \?n\nat\ \?p\nat\ \?p\nat\ \f\?m\?n\ + lenv_ty \env\list(M)\ \env'\list(M)\ + \env1\list(M)\ \env1\list(M)\ _ + _ _ assms(5) lenv + ] \i\length(env1)\ by simp + } + then show "\ i . i < ?m+\<^sub>\length(env1) \ + nth(i,env@env1) = nth(rsum(f,id(?p),?m,?n,?p)`i,env'@env1)" by simp +qed + +lemma sum_action_id_aux : + assumes + "f \ m\n" + "env \ list(M)" + "env' \ list(M)" + "env1 \ list(M)" + "length(env) = m" + "length(env') = n" + "length(env1) = p" + "\ i . i < m \ nth(i,env) = nth(f`i,env')" + shows "\ i . i < m+\<^sub>\length(env1) \ + nth(i,env@env1) = nth(rsum(f,id(length(env1)),m,n,length(env1))`i,env'@env1)" + using assms length_type id_fn_type sum_action_id + by auto + + +definition + sum_id :: "[i,i] \ i" where + "sum_id(m,f) \ rsum(\x\1.x,f,1,1,m)" + +lemma sum_id0 : "m\nat\sum_id(m,f)`0 = 0" + by(unfold sum_id_def,subst sum_inl,auto) + +lemma sum_idS : "p\nat \ q\nat \ f\p\q \ x \ p \ sum_id(p,f)`(succ(x)) = succ(f`x)" + by(subgoal_tac "x\nat",unfold sum_id_def,subst sum_inr, + simp_all add:ltI,simp_all add: app_nm in_n_in_nat) + +lemma sum_id_tc_aux : + "p \ nat \ q \ nat \ f \ p \ q \ sum_id(p,f) \ 1+\<^sub>\p \ 1+\<^sub>\q" + by (unfold sum_id_def,rule sum_type,simp_all) + +lemma sum_id_tc : + "n \ nat \ m \ nat \ f \ n \ m \ sum_id(n,f) \ succ(n) \ succ(m)" + by(rule ssubst[of "succ(n) \ succ(m)" "1+\<^sub>\n \ 1+\<^sub>\m"], + simp,rule sum_id_tc_aux,simp_all) + +subsection\Renaming of formulas\ + +consts ren :: "i\i" +primrec + "ren(Member(x,y)) = + (\ n \ nat . \ m \ nat. \f \ n \ m. Member (f`x, f`y))" + +"ren(Equal(x,y)) = + (\ n \ nat . \ m \ nat. \f \ n \ m. Equal (f`x, f`y))" + +"ren(Nand(p,q)) = + (\ n \ nat . \ m \ nat. \f \ n \ m. Nand (ren(p)`n`m`f, ren(q)`n`m`f))" + +"ren(Forall(p)) = + (\ n \ nat . \ m \ nat. \f \ n \ m. Forall (ren(p)`succ(n)`succ(m)`sum_id(n,f)))" + +lemma arity_meml : "l \ nat \ Member(x,y) \ formula \ arity(Member(x,y)) \ l \ x \ l" + by(simp,rule subsetD,rule le_imp_subset,assumption,simp) +lemma arity_memr : "l \ nat \ Member(x,y) \ formula \ arity(Member(x,y)) \ l \ y \ l" + by(simp,rule subsetD,rule le_imp_subset,assumption,simp) +lemma arity_eql : "l \ nat \ Equal(x,y) \ formula \ arity(Equal(x,y)) \ l \ x \ l" + by(simp,rule subsetD,rule le_imp_subset,assumption,simp) +lemma arity_eqr : "l \ nat \ Equal(x,y) \ formula \ arity(Equal(x,y)) \ l \ y \ l" + by(simp,rule subsetD,rule le_imp_subset,assumption,simp) +lemma nand_ar1 : "p \ formula \ q\formula \arity(p) \ arity(Nand(p,q))" + by (simp,rule Un_upper1_le,simp+) +lemma nand_ar2 : "p \ formula \ q\formula \arity(q) \ arity(Nand(p,q))" + by (simp,rule Un_upper2_le,simp+) + +lemma nand_ar1D : "p \ formula \ q\formula \ arity(Nand(p,q)) \ n \ arity(p) \ n" + by(auto simp add: le_trans[OF Un_upper1_le[of "arity(p)" "arity(q)"]]) +lemma nand_ar2D : "p \ formula \ q\formula \ arity(Nand(p,q)) \ n \ arity(q) \ n" + by(auto simp add: le_trans[OF Un_upper2_le[of "arity(p)" "arity(q)"]]) + + +lemma ren_tc : "p \ formula \ + (\ n m f . n \ nat \ m \ nat \ f \ n\m \ ren(p)`n`m`f \ formula)" + by (induct set:formula,auto simp add: app_nm sum_id_tc) + + +lemma arity_ren : + fixes "p" + assumes "p \ formula" + shows "\ n m f . n \ nat \ m \ nat \ f \ n\m \ arity(p) \ n \ arity(ren(p)`n`m`f)\m" + using assms +proof (induct set:formula) + case (Member x y) + then have "f`x \ m" "f`y \ m" + using Member assms by (simp add: arity_meml apply_funtype,simp add:arity_memr apply_funtype) + then show ?case using Member by (simp add: Un_least_lt ltI) +next + case (Equal x y) + then have "f`x \ m" "f`y \ m" + using Equal assms by (simp add: arity_eql apply_funtype,simp add:arity_eqr apply_funtype) + then show ?case using Equal by (simp add: Un_least_lt ltI) +next + case (Nand p q) + then have "arity(p)\arity(Nand(p,q))" + "arity(q)\arity(Nand(p,q))" + by (subst nand_ar1,simp,simp,simp,subst nand_ar2,simp+) + then have "arity(p)\n" + and "arity(q)\n" using Nand + by (rule_tac j="arity(Nand(p,q))" in le_trans,simp,simp)+ + then have "arity(ren(p)`n`m`f) \ m" and "arity(ren(q)`n`m`f) \ m" + using Nand by auto + then show ?case using Nand by (simp add:Un_least_lt) +next + case (Forall p) + from Forall have "succ(n)\nat" "succ(m)\nat" by auto + from Forall have 2: "sum_id(n,f) \ succ(n)\succ(m)" by (simp add:sum_id_tc) + from Forall have 3:"arity(p) \ succ(n)" by (rule_tac n="arity(p)" in natE,simp+) + then have "arity(ren(p)`succ(n)`succ(m)`sum_id(n,f))\succ(m)" using + Forall \succ(n)\nat\ \succ(m)\nat\ 2 by force + then show ?case using Forall 2 3 ren_tc arity_type pred_le by auto +qed + +lemma arity_forallE : "p \ formula \ m \ nat \ arity(Forall(p)) \ m \ arity(p) \ succ(m)" + by(rule_tac n="arity(p)" in natE,erule arity_type,simp+) + +lemma env_coincidence_sum_id : + assumes "m \ nat" "n \ nat" + "\ \ list(A)" "\' \ list(A)" + "f \ n \ m" + "\ i . i < n \ nth(i,\) = nth(f`i,\')" + "a \ A" "j \ succ(n)" + shows "nth(j,Cons(a,\)) = nth(sum_id(n,f)`j,Cons(a,\'))" +proof - + let ?g="sum_id(n,f)" + have "succ(n) \ nat" using \n\nat\ by simp + then have "j \ nat" using \j\succ(n)\ in_n_in_nat by blast + then have "nth(j,Cons(a,\)) = nth(?g`j,Cons(a,\'))" + proof (cases rule:natE[OF \j\nat\]) + case 1 + then show ?thesis using assms sum_id0 by simp + next + case (2 i) + with \j\succ(n)\ have "succ(i)\succ(n)" by simp + with \n\nat\ have "i \ n" using nat_succD assms by simp + have "f`i\m" using \f\n\m\ apply_type \i\n\ by simp + then have "f`i \ nat" using in_n_in_nat \m\nat\ by simp + have "nth(succ(i),Cons(a,\)) = nth(i,\)" using \i\nat\ by simp + also have "... = nth(f`i,\')" using assms \i\n\ ltI by simp + also have "... = nth(succ(f`i),Cons(a,\'))" using \f`i\nat\ by simp + also have "... = nth(?g`succ(i),Cons(a,\'))" + using assms sum_idS[OF \n\nat\ \m\nat\ \f\n\m\ \i \ n\] cases by simp + finally have "nth(succ(i),Cons(a,\)) = nth(?g`succ(i),Cons(a,\'))" . + then show ?thesis using \j=succ(i)\ by simp + qed + then show ?thesis . +qed + +lemma sats_iff_sats_ren : + assumes "\ \ formula" + shows "\ n \ nat ; m \ nat ; \ \ list(M) ; \' \ list(M) ; f \ n \ m ; + arity(\) \ n ; + \ i . i < n \ nth(i,\) = nth(f`i,\') \ \ + sats(M,\,\) \ sats(M,ren(\)`n`m`f,\')" + using \\ \ formula\ +proof(induct \ arbitrary:n m \ \' f) + case (Member x y) + have "ren(Member(x,y))`n`m`f = Member(f`x,f`y)" using Member assms arity_type by force + moreover + have "x \ n" using Member arity_meml by simp + moreover + have "y \ n" using Member arity_memr by simp + ultimately + show ?case using Member ltI by simp +next + case (Equal x y) + have "ren(Equal(x,y))`n`m`f = Equal(f`x,f`y)" using Equal assms arity_type by force + moreover + have "x \ n" using Equal arity_eql by simp + moreover + have "y \ n" using Equal arity_eqr by simp + ultimately show ?case using Equal ltI by simp +next + case (Nand p q) + have "ren(Nand(p,q))`n`m`f = Nand(ren(p)`n`m`f,ren(q)`n`m`f)" using Nand by simp + moreover + have "arity(p) \ n" using Nand nand_ar1D by simp + moreover from this + have "i \ arity(p) \ i \ n" for i using subsetD[OF le_imp_subset[OF \arity(p) \ n\]] by simp + moreover from this + have "i \ arity(p) \ nth(i,\) = nth(f`i,\')" for i using Nand ltI by simp + moreover from this + have "sats(M,p,\) \ sats(M,ren(p)`n`m`f,\')" using \arity(p)\n\ Nand by simp + have "arity(q) \ n" using Nand nand_ar2D by simp + moreover from this + have "i \ arity(q) \ i \ n" for i using subsetD[OF le_imp_subset[OF \arity(q) \ n\]] by simp + moreover from this + have "i \ arity(q) \ nth(i,\) = nth(f`i,\')" for i using Nand ltI by simp + moreover from this + have "sats(M,q,\) \ sats(M,ren(q)`n`m`f,\')" using assms \arity(q)\n\ Nand by simp + ultimately + show ?case using Nand by simp +next + case (Forall p) + have 0:"ren(Forall(p))`n`m`f = Forall(ren(p)`succ(n)`succ(m)`sum_id(n,f))" + using Forall by simp + have 1:"sum_id(n,f) \ succ(n) \ succ(m)" (is "?g \ _") using sum_id_tc Forall by simp + then have 2: "arity(p) \ succ(n)" + using Forall le_trans[of _ "succ(pred(arity(p)))"] succpred_leI by simp + have "succ(n)\nat" "succ(m)\nat" using Forall by auto + then have A:"\ j .j < succ(n) \ nth(j, Cons(a, \)) = nth(?g`j, Cons(a, \'))" if "a\M" for a + using that env_coincidence_sum_id Forall ltD by force + have + "sats(M,p,Cons(a,\)) \ sats(M,ren(p)`succ(n)`succ(m)`?g,Cons(a,\'))" if "a\M" for a + proof - + have C:"Cons(a,\) \ list(M)" "Cons(a,\')\list(M)" using Forall that by auto + have "sats(M,p,Cons(a,\)) \ sats(M,ren(p)`succ(n)`succ(m)`?g,Cons(a,\'))" + using Forall(2)[OF \succ(n)\nat\ \succ(m)\nat\ C(1) C(2) 1 2 A[OF \a\M\]] by simp + then show ?thesis . + qed + then show ?case using Forall 0 1 2 by simp +qed + +end \ No newline at end of file diff --git a/thys/Transitive_Models/Renaming_Auto.thy b/thys/Transitive_Models/Renaming_Auto.thy new file mode 100644 --- /dev/null +++ b/thys/Transitive_Models/Renaming_Auto.thy @@ -0,0 +1,54 @@ +theory Renaming_Auto + imports + Renaming + Utils +keywords + "rename" :: thy_decl % "ML" +and + "simple_rename" :: thy_decl % "ML" +and + "src" +and + "tgt" +abbrevs + "simple_rename" = "" + +begin + +lemmas nat_succI = nat_succ_iff[THEN iffD2] +ML_file\Renaming_ML.ml\ +ML\ + open Renaming_ML + + fun renaming_def mk_ren name from to ctxt = + let val to = to |> Syntax.read_term ctxt + val from = from |> Syntax.read_term ctxt + val (tc_lemma,action_lemma,fvs,r) = mk_ren from to ctxt + val (tc_lemma,action_lemma) = (fix_vars tc_lemma fvs ctxt , fix_vars action_lemma fvs ctxt) + val ren_fun_name = Binding.name (name ^ "_fn") + val ren_fun_def = Binding.name (name ^ "_fn_def") + val ren_thm = Binding.name (name ^ "_thm") + in + Local_Theory.note ((ren_thm, []), [tc_lemma,action_lemma]) ctxt |> snd |> + Local_Theory.define ((ren_fun_name, NoSyn), ((ren_fun_def, []), r)) |> snd + end; +\ + +ML\ +local + + val ren_parser = Parse.position (Parse.string -- + (Parse.$$$ "src" |-- Parse.string --| Parse.$$$ "tgt" -- Parse.string)); + + val _ = + Outer_Syntax.local_theory \<^command_keyword>\rename\ "ML setup for synthetic definitions" + (ren_parser >> (fn ((name,(from,to)),_) => renaming_def sum_rename name from to )) + + val _ = + Outer_Syntax.local_theory \<^command_keyword>\simple_rename\ "ML setup for synthetic definitions" + (ren_parser >> (fn ((name,(from,to)),_) => renaming_def ren_thm name from to )) + +in +end +\ +end \ No newline at end of file diff --git a/thys/Transitive_Models/Renaming_ML.ml b/thys/Transitive_Models/Renaming_ML.ml new file mode 100644 --- /dev/null +++ b/thys/Transitive_Models/Renaming_ML.ml @@ -0,0 +1,179 @@ +structure Renaming_ML = struct +open Utils + +fun sum_ f g m n p = @{const Renaming.rsum} $ f $ g $ m $ n $ p + +(*Builds a finite mapping from rho to rho'.*) +fun mk_ren rho rho' ctxt = + let val rs = to_ML_list rho + val rs' = to_ML_list rho' + val ixs = 0 upto (length rs-1) + fun err t = "The element " ^ Syntax.string_of_term ctxt t ^ " is missing in the target environment" + fun mkp i = + case find_index (fn x => x = nth rs i) rs' of + ~1 => nth rs i |> err |> error + | j => mk_Pair (mk_ZFnat i) (mk_ZFnat j) + in map mkp ixs |> mk_FinSet + end + +fun mk_dom_lemma ren rho = + let val n = rho |> to_ML_list |> length |> mk_ZFnat + in eq_ n (@{const domain} $ ren) |> tp +end + +fun ren_tc_goal fin ren rho rho' = + let val n = rho |> to_ML_list |> length |> mk_ZFnat + val m = rho' |> to_ML_list |> length |> mk_ZFnat + val fun_ty = if fin then @{const_name "FiniteFun"} else @{const_abbrev "function_space"} + val ty = Const (fun_ty,@{typ "i \ i \ i"}) $ n $ m + in mem_ ren ty |> tp +end + +fun ren_action_goal ren rho rho' ctxt = + let val setV = Variable.variant_frees ctxt [] [("A",@{typ i})] |> hd |> Free + val j = Variable.variant_frees ctxt [] [("j",@{typ i})] |> hd |> Free + val vs = rho |> to_ML_list + val ws = rho' |> to_ML_list |> filter Term.is_Free + val h1 = subset_ (mk_FinSet vs) setV + val h2 = lt_ j (length vs |> mk_ZFnat) + val fvs = [j,setV ] @ ws |> filter Term.is_Free |> map freeName + val lhs = nth_ j rho + val rhs = nth_ (app_ ren j) rho' + val concl = eq_ lhs rhs + in (Logic.list_implies([tp h1,tp h2],tp concl),fvs) + end + + fun sum_tc_goal f m n p = + let val m_length = m |> to_ML_list |> length |> mk_ZFnat + val n_length = n |> to_ML_list |> length |> mk_ZFnat + val p_length = p |> length_ + val id_fun = @{const id} $ p_length + val sum_fun = sum_ f id_fun m_length n_length p_length + val dom = add_ m_length p_length + val codom = add_ n_length p_length + val fun_ty = @{const_abbrev "function_space"} + val ty = Const (fun_ty,@{typ "i \ i \ i"}) $ dom $ codom + in (sum_fun, mem_ sum_fun ty |> tp) + end + +fun sum_action_goal ren rho rho' ctxt = + let val setV = Variable.variant_frees ctxt [] [("A",@{typ i})] |> hd |> Free + val envV = Variable.variant_frees ctxt [] [("env",@{typ i})] |> hd |> Free + val j = Variable.variant_frees ctxt [] [("j",@{typ i})] |> hd |> Free + val vs = rho |> to_ML_list + val ws = rho' |> to_ML_list |> filter Term.is_Free + val envL = envV |> length_ + val rhoL = vs |> length |> mk_ZFnat + val h1 = subset_ (append vs ws |> mk_FinSet) setV + val h2 = lt_ j (add_ rhoL envL) + val h3 = mem_ envV (list_ setV) + val fvs = ([j,setV,envV] @ ws |> filter Term.is_Free) |> map freeName + val lhs = nth_ j (concat_ rho envV) + val rhs = nth_ (app_ ren j) (concat_ rho' envV) + val concl = eq_ lhs rhs + in (Logic.list_implies([tp h1,tp h2,tp h3],tp concl),fvs) + end + + (* Tactics *) + fun fin ctxt = + REPEAT (resolve_tac ctxt [@{thm nat_succI}] 1) + THEN resolve_tac ctxt [@{thm nat_0I}] 1 + + fun step ctxt thm = + asm_full_simp_tac ctxt 1 + THEN asm_full_simp_tac ctxt 1 + THEN EqSubst.eqsubst_tac ctxt [1] [@{thm app_fun} OF [thm]] 1 + THEN simp_tac ctxt 1 + THEN simp_tac ctxt 1 + + fun fin_fun_tac ctxt = + REPEAT ( + resolve_tac ctxt [@{thm consI}] 1 + THEN resolve_tac ctxt [@{thm ltD}] 1 + THEN simp_tac ctxt 1 + THEN resolve_tac ctxt [@{thm ltD}] 1 + THEN simp_tac ctxt 1) + THEN resolve_tac ctxt [@{thm emptyI}] 1 + THEN REPEAT (simp_tac ctxt 1) + + fun ren_thm e e' ctxt = + let + val r = mk_ren e e' ctxt + val fin_tc_goal = ren_tc_goal true r e e' + val dom_goal = mk_dom_lemma r e + val tc_goal = ren_tc_goal false r e e' + val (action_goal,fvs) = ren_action_goal r e e' ctxt + val fin_tc_lemma = Goal.prove ctxt [] [] fin_tc_goal (fn _ => fin_fun_tac ctxt) + val dom_lemma = Goal.prove ctxt [] [] dom_goal (fn _ => blast_tac ctxt 1) + val tc_lemma = Goal.prove ctxt [] [] tc_goal + (fn _ => EqSubst.eqsubst_tac ctxt [1] [dom_lemma] 1 + THEN resolve_tac ctxt [@{thm FiniteFun_is_fun}] 1 + THEN resolve_tac ctxt [fin_tc_lemma] 1) + val action_lemma = Goal.prove ctxt [] [] action_goal + (fn _ => + forward_tac ctxt [@{thm le_natI}] 1 + THEN fin ctxt + THEN REPEAT (resolve_tac ctxt [@{thm natE}] 1 + THEN step ctxt tc_lemma) + THEN (step ctxt tc_lemma) + ) + in (action_lemma, tc_lemma, fvs, r) + end + +(* +Returns the sum renaming, the goal for type_checking, and the actual lemmas +for the left part of the sum. +*) + fun sum_ren_aux e e' ctxt = + let val env = Variable.variant_frees ctxt [] [("env",@{typ i})] |> hd |> Free + val (left_action_lemma,left_tc_lemma,_,r) = ren_thm e e' ctxt + val (sum_ren,sum_goal_tc) = sum_tc_goal r e e' env + val setV = Variable.variant_frees ctxt [] [("A",@{typ i})] |> hd |> Free + fun hyp en = mem_ en (list_ setV) + in (sum_ren, + freeName env, + Logic.list_implies (map (fn e => e |> hyp |> tp) [env], sum_goal_tc), + left_tc_lemma, + left_action_lemma) +end + +fun sum_tc_lemma rho rho' ctxt = + let val (sum_ren, envVar, tc_goal, left_tc_lemma, left_action_lemma) = sum_ren_aux rho rho' ctxt + val (goal,fvs) = sum_action_goal sum_ren rho rho' ctxt + val r = mk_ren rho rho' ctxt + in (sum_ren, goal,envVar, r,left_tc_lemma, left_action_lemma ,fvs, Goal.prove ctxt [] [] tc_goal + (fn _ => + resolve_tac ctxt [@{thm sum_type_id_aux2}] 1 + THEN asm_simp_tac ctxt 4 + THEN simp_tac ctxt 1 + THEN resolve_tac ctxt [left_tc_lemma] 1 + THEN (fin ctxt) + THEN (fin ctxt) + )) + end + +fun sum_rename rho rho' ctxt = + let + val (_, goal, _, left_rename, left_tc_lemma, left_action_lemma, fvs, sum_tc_lemma) = + sum_tc_lemma rho rho' ctxt + val action_lemma = fix_vars left_action_lemma fvs ctxt + in (sum_tc_lemma, Goal.prove ctxt [] [] goal + (fn _ => resolve_tac ctxt [@{thm sum_action_id_aux}] 1 + THEN (simp_tac ctxt 4) + THEN (simp_tac ctxt 1) + THEN (resolve_tac ctxt [left_tc_lemma] 1) + THEN (asm_full_simp_tac ctxt 1) + THEN (asm_full_simp_tac ctxt 1) + THEN (simp_tac ctxt 1) + THEN (simp_tac ctxt 1) + THEN (simp_tac ctxt 1) + THEN (full_simp_tac ctxt 1) + THEN (resolve_tac ctxt [action_lemma] 1) + THEN (blast_tac ctxt 1) + THEN (full_simp_tac ctxt 1) + THEN (full_simp_tac ctxt 1) + + ), fvs, left_rename + ) +end ; +end \ No newline at end of file diff --git a/thys/Transitive_Models/Replacement_Lepoll.thy b/thys/Transitive_Models/Replacement_Lepoll.thy new file mode 100644 --- /dev/null +++ b/thys/Transitive_Models/Replacement_Lepoll.thy @@ -0,0 +1,485 @@ +section\Lambda-replacements required for cardinal inequalities\ + +theory Replacement_Lepoll + imports + ZF_Library_Relative +begin + +definition + lepoll_assumptions1 :: "[i\o,i,[i,i]\i,i,i,i,i,i,i] \ o" where + "lepoll_assumptions1(M,A,F,S,fa,K,x,f,r) \ \x\S. strong_replacement(M, \y z. y \ F(A, x) \ z = {\x, y\})" + +definition + lepoll_assumptions2 :: "[i\o,i,[i,i]\i,i,i,i,i,i,i] \ o" where + "lepoll_assumptions2(M,A,F,S,fa,K,x,f,r) \ strong_replacement(M, \x z. z = Sigfun(x, F(A)))" + +definition + lepoll_assumptions3 :: "[i\o,i,[i,i]\i,i,i,i,i,i,i] \ o" where + "lepoll_assumptions3(M,A,F,S,fa,K,x,f,r) \ strong_replacement(M, \x y. y = F(A, x))" + +definition + lepoll_assumptions4 :: "[i\o,i,[i,i]\i,i,i,i,i,i,i] \ o" where + "lepoll_assumptions4(M,A,F,S,fa,K,x,f,r) \ strong_replacement(M, \x y. y = \x, minimum(r, F(A, x))\)" + +definition + lepoll_assumptions5 :: "[i\o,i,[i,i]\i,i,i,i,i,i,i] \ o" where + "lepoll_assumptions5(M,A,F,S,fa,K,x,f,r) \ +strong_replacement(M, \x y. y = \x, \ i. x \ F(A, i), f ` (\ i. x \ F(A, i)) ` x\)" + +definition + lepoll_assumptions6 :: "[i\o,i,[i,i]\i,i,i,i,i,i,i] \ o" where + "lepoll_assumptions6(M,A,F,S,fa,K,x,f,r) \ strong_replacement(M, \y z. y \ inj\<^bsup>M\<^esup>(F(A, x),S) \ z = {\x, y\})" + +definition + lepoll_assumptions7 :: "[i\o,i,[i,i]\i,i,i,i,i,i,i] \ o" where + "lepoll_assumptions7(M,A,F,S,fa,K,x,f,r) \ strong_replacement(M, \x y. y = inj\<^bsup>M\<^esup>(F(A, x),S))" + +definition + lepoll_assumptions8 :: "[i\o,i,[i,i]\i,i,i,i,i,i,i] \ o" where + "lepoll_assumptions8(M,A,F,S,fa,K,x,f,r) \ strong_replacement(M, \x z. z = Sigfun(x, \i. inj\<^bsup>M\<^esup>(F(A, i),S)))" + +definition + lepoll_assumptions9 :: "[i\o,i,[i,i]\i,i,i,i,i,i,i] \ o" where + "lepoll_assumptions9(M,A,F,S,fa,K,x,f,r) \ strong_replacement(M, \x y. y = \x, minimum(r, inj\<^bsup>M\<^esup>(F(A, x),S))\)" + +definition + lepoll_assumptions10 :: "[i\o,i,[i,i]\i,i,i,i,i,i,i] \ o" where + "lepoll_assumptions10(M,A,F,S,fa,K,x,f,r) \ strong_replacement + (M, \x z. z = Sigfun(x, \k. if k \ range(f) then F(A, converse(f) ` k) else 0))" + +definition + lepoll_assumptions11 :: "[i\o,i,[i,i]\i,i,i,i,i,i,i] \ o" where + "lepoll_assumptions11(M,A,F,S,fa,K,x,f,r) \ strong_replacement(M, \x y. y = (if x \ range(f) then F(A, converse(f) ` x) else 0))" + +definition + lepoll_assumptions12 :: "[i\o,i,[i,i]\i,i,i,i,i,i,i] \ o" where + "lepoll_assumptions12(M,A,F,S,fa,K,x,f,r) \ strong_replacement(M, \y z. y \ F(A, converse(f) ` x) \ z = {\x, y\})" + +definition + lepoll_assumptions13 :: "[i\o,i,[i,i]\i,i,i,i,i,i,i] \ o" where + "lepoll_assumptions13(M,A,F,S,fa,K,x,f,r) \ strong_replacement + (M, \x y. y = \x, minimum(r, if x \ range(f) then F(A,converse(f) ` x) else 0)\)" + +definition + lepoll_assumptions14 :: "[i\o,i,[i,i]\i,i,i,i,i,i,i] \ o" where + "lepoll_assumptions14(M,A,F,S,fa,K,x,f,r) \ strong_replacement + (M, \x y. y = \x, \ i. x \ (if i \ range(f) then F(A, converse(f) ` i) else 0), + fa ` (\ i. x \ (if i \ range(f) then F(A, converse(f) ` i) else 0)) ` x\)" + +definition + lepoll_assumptions15 :: "[i\o,i,[i,i]\i,i,i,i,i,i,i] \ o" where + "lepoll_assumptions15(M,A,F,S,fa,K,x,f,r) \ strong_replacement + (M, \y z. y \ inj\<^bsup>M\<^esup>(if x \ range(f) then F(A, converse(f) ` x) else 0,K) \ z = {\x, y\})" + +definition + lepoll_assumptions16 :: "[i\o,i,[i,i]\i,i,i,i,i,i,i] \ o" where + "lepoll_assumptions16(M,A,F,S,fa,K,x,f,r) \ strong_replacement(M, \x y. y = inj\<^bsup>M\<^esup>(if x \ range(f) then F(A, converse(f) ` x) else 0,K))" + +definition + lepoll_assumptions17 :: "[i\o,i,[i,i]\i,i,i,i,i,i,i] \ o" where + "lepoll_assumptions17(M,A,F,S,fa,K,x,f,r) \ strong_replacement + (M, \x z. z = Sigfun(x, \i. inj\<^bsup>M\<^esup>(if i \ range(f) then F(A, converse(f) ` i) else 0,K)))" + +definition + lepoll_assumptions18 :: "[i\o,i,[i,i]\i,i,i,i,i,i,i] \ o" where + "lepoll_assumptions18(M,A,F,S,fa,K,x,f,r) \ strong_replacement + (M, \x y. y = \x, minimum(r, inj\<^bsup>M\<^esup>(if x \ range(f) then F(A, converse(f) ` x) else 0,K))\)" + +lemmas lepoll_assumptions_defs[simp] = lepoll_assumptions1_def + lepoll_assumptions2_def lepoll_assumptions3_def lepoll_assumptions4_def + lepoll_assumptions5_def lepoll_assumptions6_def lepoll_assumptions7_def + lepoll_assumptions8_def lepoll_assumptions9_def lepoll_assumptions10_def + lepoll_assumptions11_def lepoll_assumptions12_def lepoll_assumptions13_def + lepoll_assumptions14_def lepoll_assumptions15_def lepoll_assumptions16_def + lepoll_assumptions17_def lepoll_assumptions18_def + +definition if_range_F where + [simp]: "if_range_F(H,f,i) \ if i \ range(f) then H(converse(f) ` i) else 0" + +definition if_range_F_else_F where + "if_range_F_else_F(H,b,f,i) \ if b=0 then if_range_F(H,f,i) else H(i)" + +lemma (in M_basic) lam_Least_assumption_general: + assumes + separations: + "\A'[M]. separation(M, \y. \x\A'. y = \x, \ i. x \ if_range_F_else_F(F(A),b,f,i)\)" + and + mem_F_bound:"\x c. x\F(A,c) \ c \ range(f) \ U(A)" + and + types:"M(A)" "M(b)" "M(f)" "M(U(A))" + shows "lam_replacement(M,\x . \ i. x \ if_range_F_else_F(F(A),b,f,i))" +proof - + have "\x\X. (\ i. x \ if_range_F_else_F(F(A),b,f,i)) \ + Pow\<^bsup>M\<^esup>(\(X \ range(f) \ U(A)))" if "M(X)" for X + proof + fix x + assume "x\X" + moreover + note \M(X)\ + moreover from calculation + have "M(x)" by (auto dest:transM) + moreover + note assms + ultimately + show "(\ i. x \ if_range_F_else_F(F(A),b,f,i)) \ + Pow\<^bsup>M\<^esup>(\(X \ range(f) \ U(A)))" + proof (rule_tac Least_in_Pow_rel_Union, cases "b=0", simp_all) + case True + fix c + assume asm:"x \ if_range_F_else_F(F(A), 0, f, c)" + with mem_F_bound + show "c\X \ c \ range(f) \ c \ U(A)" + unfolding if_range_F_else_F_def if_range_F_def by (cases "c\range(f)") auto + next + case False + fix c + assume "x \ if_range_F_else_F(F(A), b, f, c)" + with False mem_F_bound[of x c] + show "c\X \ c \ range(f) \ c\U(A)" + unfolding if_range_F_else_F_def if_range_F_def by auto + qed + qed + with assms + show ?thesis + using bounded_lam_replacement[of "\x.(\ i. x \ if_range_F_else_F(F(A),b,f,i))" + "\X. Pow\<^bsup>M\<^esup>(\(X \ range(f) \ U(A)))"] by simp +qed + +lemma (in M_basic) lam_Least_assumption_ifM_b0: + fixes F + defines "F \ \_ x. if M(x) then x else 0" + assumes + separations: + "\A'[M]. separation(M, \y. \x\A'. y = \x, \ i. x \ if_range_F_else_F(F(A),0,f,i)\)" + and + types:"M(A)" "M(f)" + shows "lam_replacement(M,\x . \ i. x \ if_range_F_else_F(F(A),0,f,i))" + (is "lam_replacement(M,\x . Least(?P(x)))") +proof - + { + fix x X + assume "M(X)" "x\X" "(\ i. ?P(x,i)) \ 0" + moreover from this + obtain m where "Ord(m)" "?P(x,m)" + using Least_0[of "?P(_)"] by auto + moreover + note assms + moreover + have "?P(x,i) \ (M(converse(f) ` i) \ i \ range(f) \ x \ converse(f) ` i)" for i + unfolding F_def if_range_F_else_F_def if_range_F_def by auto + ultimately + have "(\ i. ?P(x,i)) \ range (f)" + unfolding F_def if_range_F_else_F_def if_range_F_def + by (rule_tac LeastI2) auto + } + with assms + show ?thesis + by (rule_tac bounded_lam_replacement[of _ "\X. range(f) \ {0}"]) auto +qed + +lemma (in M_replacement_extra) lam_Least_assumption_ifM_bnot0: + fixes F + defines "F \ \_ x. if M(x) then x else 0" + assumes + separations: + "\A'[M]. separation(M, \y. \x\A'. y = \x, \ i. x \ if_range_F_else_F(F(A),b,f,i)\)" + "separation(M,Ord)" + and + types:"M(A)" "M(f)" + and + "b\0" + shows "lam_replacement(M,\x . \ i. x \ if_range_F_else_F(F(A),b,f,i))" + (is "lam_replacement(M,\x . Least(?P(x)))") +proof - + have "M(x) \(\ i. (M(i) \ x \ i) \ M(i)) = (if Ord(x) then succ(x) else 0)" for x + using Ord_in_Ord + apply (auto intro:Least_0, rule_tac Least_equality, simp_all) + by (frule lt_Ord) (auto dest:le_imp_not_lt[of _ x] intro:ltI[of x]) + moreover + have "lam_replacement(M, \x. if Ord(x) then succ(x) else 0)" + using lam_replacement_if[OF _ _ separations(2)] lam_replacement_identity + lam_replacement_constant lam_replacement_hcomp lam_replacement_succ + by simp + moreover + note types \b\0\ + ultimately + show ?thesis + using lam_replacement_cong + unfolding F_def if_range_F_else_F_def if_range_F_def + by auto +qed + +lemma (in M_replacement_extra) lam_Least_assumption_drSR_Y: + fixes F r' D + defines "F \ drSR_Y(r',D)" + assumes "\A'[M]. separation(M, \y. \x\A'. y = \x, \ i. x \ if_range_F_else_F(F(A),b,f,i)\)" + "M(A)" "M(b)" "M(f)" "M(r')" + shows "lam_replacement(M,\x . \ i. x \ if_range_F_else_F(F(A),b,f,i))" +proof - + from assms(2-) + have [simp]: "M(X) \ M(X \ range(f) \ {domain(x) . x \ A})" + "M(r') \ M(X) \ M({restrict(x,r') . x \ A})" + for X r' + using lam_replacement_domain[THEN lam_replacement_imp_strong_replacement, + THEN RepFun_closed, of A] + lam_replacement_restrict'[THEN lam_replacement_imp_strong_replacement, + THEN RepFun_closed, of r' A] by (auto dest:transM) + have "\x\X. (\ i. x \ if_range_F_else_F(F(A),b,f,i)) \ + Pow\<^bsup>M\<^esup>(\(X \ range(f) \ {domain(x). x\A} \ {restrict(x,r'). x\A} \ domain(A) \ range(A) \ \A))" if "M(X)" for X + proof + fix x + assume "x\X" + moreover + note \M(X)\ + moreover from calculation + have "M(x)" by (auto dest:transM) + moreover + note assms(2-) + ultimately + show "(\ i. x \ if_range_F_else_F(F(A),b,f,i)) \ + Pow\<^bsup>M\<^esup>(\(X \ range(f) \ {domain(x). x\A} \ {restrict(x,r'). x\A} \ domain(A) \ range(A) \ \A))" + unfolding if_range_F_else_F_def if_range_F_def + proof (rule_tac Least_in_Pow_rel_Union, simp_all,cases "b=0", simp_all) + case True + fix c + assume asm:"x \ (if c \ range(f) then F(A, converse(f) ` c) else 0)" + then + show "c\X \ c\range(f) \ (\x\A. c = domain(x)) \ (\x\A. c = restrict(x,r')) \ c \ domain(A) \ c \ range(A) \ (\x\A. c\x)" by auto + next + case False + fix c + assume "x \ F(A, c)" + then + show "c\X \ c\range(f) \ (\x\A. c = domain(x)) \ (\x\A. c = restrict(x,r')) \ c \ domain(A) \ c \ range(A) \ (\x\A. c\x)" + using apply_0 + by (cases "M(c)", auto simp:F_def drSR_Y_def dC_F_def) + qed + qed + with assms(2-) + show ?thesis + using bounded_lam_replacement[of "\x.(\ i. x \ if_range_F_else_F(F(A),b,f,i))" + "\X. Pow\<^bsup>M\<^esup>(\(X \ range(f) \ {domain(x). x\A} \ {restrict(x,r'). x\A} \ domain(A) \ range(A) \ \A))"] by simp +qed + +locale M_replacement_lepoll = M_replacement_extra + M_inj + + fixes F + assumes + F_type[simp]: "M(A) \ \x[M]. M(F(A,x))" + and + lam_lepoll_assumption_F:"M(A) \ lam_replacement(M,F(A))" + and + \ \Here b is a Boolean.\ + lam_Least_assumption:"M(A) \ M(b) \ M(f) \ + lam_replacement(M,\x . \ i. x \ if_range_F_else_F(F(A),b,f,i))" + and + F_args_closed: "M(A) \ M(x) \ x \ F(A,i) \ M(i)" + and + lam_replacement_inj_rel:"lam_replacement(M, \p. inj\<^bsup>M\<^esup>(fst(p),snd(p)))" +begin + +declare if_range_F_else_F_def[simp] + +lemma lepoll_assumptions1: + assumes types[simp]:"M(A)" "M(S)" + shows "lepoll_assumptions1(M,A,F,S,fa,K,x,f,r)" + using strong_replacement_separation[OF lam_replacement_sing_const_id separation_in_constant] + transM[of _ S] + by simp + +lemma lepoll_assumptions2: + assumes types[simp]:"M(A)" "M(S)" + shows "lepoll_assumptions2(M,A,F,S,fa,K,x,f,r)" + using lam_replacement_Sigfun lam_replacement_imp_strong_replacement + assms lam_lepoll_assumption_F + by simp + +lemma lepoll_assumptions3: + assumes types[simp]:"M(A)" + shows "lepoll_assumptions3(M,A,F,S,fa,K,x,f,r)" + using lam_lepoll_assumption_F[THEN lam_replacement_imp_strong_replacement] + by simp + +lemma lepoll_assumptions4: + assumes types[simp]:"M(A)" "M(r)" + shows "lepoll_assumptions4(M,A,F,S,fa,K,x,f,r)" + using lam_replacement_minimum lam_replacement_constant lam_lepoll_assumption_F + unfolding lepoll_assumptions_defs + lam_replacement_def[symmetric] + by (rule_tac lam_replacement_hcomp2[of _ _ minimum]) + (force intro: lam_replacement_identity)+ + +lemma lam_Least_closed : + assumes "M(A)" "M(b)" "M(f)" + shows "\x[M]. M(\ i. x \ if_range_F_else_F(F(A),b,f,i))" +proof - + have "x \ (if i \ range(f) then F(A, converse(f) ` i) else 0) \ M(i)" for x i + proof (cases "i\range(f)") + case True + with \M(f)\ + show ?thesis by (auto dest:transM) + next + case False + moreover + assume "x \ (if i \ range(f) then F(A, converse(f) ` i) else 0)" + ultimately + show ?thesis + by auto + qed + with assms + show ?thesis + using F_args_closed[of A] unfolding if_range_F_else_F_def if_range_F_def + by (clarify, rule_tac Least_closed', cases "b=0") simp_all +qed + +lemma lepoll_assumptions5: + assumes + types[simp]:"M(A)" "M(f)" + shows "lepoll_assumptions5(M,A,F,S,fa,K,x,f,r)" + using + lam_replacement_apply2[THEN [5] lam_replacement_hcomp2] + lam_replacement_hcomp[OF _ lam_replacement_apply[of f]] + lam_replacement_identity + lam_replacement_product lam_Least_closed[where b=1] + assms lam_Least_assumption[where b=1,OF \M(A)\ _ \M(f)\] + unfolding lepoll_assumptions_defs + lam_replacement_def[symmetric] + by simp + +lemma lepoll_assumptions6: + assumes types[simp]:"M(A)" "M(S)" "M(x)" + shows "lepoll_assumptions6(M,A,F,S,fa,K,x,f,r)" + using strong_replacement_separation[OF lam_replacement_sing_const_id separation_in_constant] + lam_replacement_inj_rel + by simp + +lemma lepoll_assumptions7: + assumes types[simp]:"M(A)" "M(S)" "M(x)" + shows "lepoll_assumptions7(M,A,F,S,fa,K,x,f,r)" + using lam_replacement_constant lam_lepoll_assumption_F lam_replacement_inj_rel + unfolding lepoll_assumptions_defs + by (rule_tac lam_replacement_imp_strong_replacement) + (rule_tac lam_replacement_hcomp2[of _ _ "inj_rel(M)"], simp_all) + +lemma lepoll_assumptions8: + assumes types[simp]:"M(A)" "M(S)" + shows "lepoll_assumptions8(M,A,F,S,fa,K,x,f,r)" + using lam_replacement_Sigfun lam_replacement_imp_strong_replacement + lam_replacement_inj_rel lam_replacement_constant + lam_replacement_hcomp2[of _ _ "inj_rel(M)",OF lam_lepoll_assumption_F[of A]] + by simp + +lemma lepoll_assumptions9: + assumes types[simp]:"M(A)" "M(S)" "M(r)" + shows "lepoll_assumptions9(M,A,F,S,fa,K,x,f,r)" + using lam_replacement_minimum lam_replacement_constant lam_lepoll_assumption_F + lam_replacement_hcomp2[of _ _ "inj_rel(M)"] lam_replacement_inj_rel lepoll_assumptions4 + unfolding lepoll_assumptions_defs lam_replacement_def[symmetric] + by (rule_tac lam_replacement_hcomp2[of _ _ minimum]) + (force intro: lam_replacement_identity)+ + +lemma lepoll_assumptions10: + assumes types[simp]:"M(A)" "M(f)" + shows "lepoll_assumptions10(M,A,F,S,fa,K,x,f,r)" + using lam_replacement_Sigfun lam_replacement_imp_strong_replacement + lam_replacement_constant[OF nonempty] + lam_replacement_if[OF _ _ separation_in_constant] + lam_replacement_hcomp + lam_replacement_apply[OF converse_closed[OF \M(f)\]] + lam_lepoll_assumption_F[of A] + by simp + +lemma lepoll_assumptions11: + assumes types[simp]:"M(A)" "M(f)" + shows "lepoll_assumptions11(M, A, F, S, fa, K, x, f, r)" + using lam_replacement_imp_strong_replacement + lam_replacement_if[OF _ _ separation_in_constant[of "range(f)"]] + lam_replacement_constant + lam_replacement_hcomp lam_replacement_apply + lam_lepoll_assumption_F + by simp + +lemma lepoll_assumptions12: + assumes types[simp]:"M(A)" "M(x)" "M(f)" + shows "lepoll_assumptions12(M,A,F,S,fa,K,x,f,r)" + using strong_replacement_separation[OF lam_replacement_sing_const_id separation_in_constant] + by simp + +lemma lepoll_assumptions13: + assumes types[simp]:"M(A)" "M(r)" "M(f)" + shows "lepoll_assumptions13(M,A,F,S,fa,K,x,f,r)" + using lam_replacement_constant[OF nonempty] lam_lepoll_assumption_F + lam_replacement_hcomp lam_replacement_apply + lam_replacement_hcomp2[OF lam_replacement_constant[OF \M(r)\] + lam_replacement_if[OF _ _ separation_in_constant[of "range(f)"]] _ _ + lam_replacement_minimum] assms + unfolding lepoll_assumptions_defs + lam_replacement_def[symmetric] + by simp + +lemma lepoll_assumptions14: + assumes types[simp]:"M(A)" "M(f)" "M(fa)" + shows "lepoll_assumptions14(M,A,F,S,fa,K,x,f,r)" + using + lam_replacement_apply2[THEN [5] lam_replacement_hcomp2] + lam_replacement_hcomp[OF _ lam_replacement_apply[of fa]] + lam_replacement_identity + lam_replacement_product lam_Least_closed[where b=0] + assms lam_Least_assumption[where b=0,OF \M(A)\ _ \M(f)\] + unfolding lepoll_assumptions_defs + lam_replacement_def[symmetric] + by simp + +lemma lepoll_assumptions15: + assumes types[simp]:"M(A)" "M(x)" "M(f)" "M(K)" + shows "lepoll_assumptions15(M,A,F,S,fa,K,x,f,r)" + using strong_replacement_separation[OF lam_replacement_sing_const_id separation_in_constant] + by simp + +lemma lepoll_assumptions16: + assumes types[simp]:"M(A)" "M(f)" "M(K)" + shows "lepoll_assumptions16(M,A,F,S,fa,K,x,f,r)" + using lam_replacement_imp_strong_replacement + lam_replacement_inj_rel lam_replacement_constant + lam_replacement_hcomp2[of _ _ "inj_rel(M)"] + lam_replacement_constant[OF nonempty] + lam_replacement_if[OF _ _ separation_in_constant] + lam_replacement_hcomp + lam_replacement_apply[OF converse_closed[OF \M(f)\]] + lam_lepoll_assumption_F[of A] + by simp + +lemma lepoll_assumptions17: + assumes types[simp]:"M(A)" "M(f)" "M(K)" + shows "lepoll_assumptions17(M,A,F,S,fa,K,x,f,r)" + using lam_replacement_Sigfun lam_replacement_imp_strong_replacement + lam_replacement_inj_rel lam_replacement_constant + lam_replacement_hcomp2[of _ _ "inj_rel(M)"] + lam_replacement_constant[OF nonempty] + lam_replacement_if[OF _ _ separation_in_constant] + lam_replacement_hcomp + lam_replacement_apply[OF converse_closed[OF \M(f)\]] + lam_lepoll_assumption_F[of A] + by simp + +lemma lepoll_assumptions18: + assumes types[simp]:"M(A)" "M(K)" "M(f)" "M(r)" + shows "lepoll_assumptions18(M,A,F,S,fa,K,x,f,r)" + using lam_replacement_constant lam_replacement_inj_rel lam_lepoll_assumption_F + lam_replacement_minimum lam_replacement_identity lam_replacement_apply2 separation_in_constant + unfolding lepoll_assumptions18_def lam_replacement_def[symmetric] + by (rule_tac lam_replacement_hcomp2[of _ _ minimum], simp_all, + rule_tac lam_replacement_hcomp2[of _ _ "inj_rel(M)"], simp_all) + (rule_tac lam_replacement_if, rule_tac lam_replacement_hcomp[of _ "F(A)"], + rule_tac lam_replacement_hcomp2[of _ _ "(`)"], simp_all) + +lemmas lepoll_assumptions = lepoll_assumptions1 lepoll_assumptions2 + lepoll_assumptions3 lepoll_assumptions4 lepoll_assumptions5 + lepoll_assumptions6 lepoll_assumptions7 lepoll_assumptions8 + lepoll_assumptions9 lepoll_assumptions10 lepoll_assumptions11 + lepoll_assumptions12 lepoll_assumptions13 lepoll_assumptions14 + lepoll_assumptions15 lepoll_assumptions16 + lepoll_assumptions17 lepoll_assumptions18 + +end \ \\<^locale>\M_replacement_lepoll\\ + +end \ No newline at end of file diff --git a/thys/Transitive_Models/Synthetic_Definition.thy b/thys/Transitive_Models/Synthetic_Definition.thy new file mode 100644 --- /dev/null +++ b/thys/Transitive_Models/Synthetic_Definition.thy @@ -0,0 +1,384 @@ +section\Automatic synthesis of formulas\ +theory Synthetic_Definition + imports + Utils + keywords + "synthesize" :: thy_decl % "ML" + and + "synthesize_notc" :: thy_decl % "ML" + and + "generate_schematic" :: thy_decl % "ML" + and + "arity_theorem" :: thy_decl % "ML" + and + "manual_schematic" :: thy_goal_stmt % "ML" + and + "manual_arity" :: thy_goal_stmt % "ML" + and + "from_schematic" + and + "for" + and + "from_definition" + and + "assuming" + and + "intermediate" + +begin + +named_theorems fm_definitions "Definitions of synthetized formulas." + +named_theorems iff_sats "Theorems for synthetising formulas." + +named_theorems arity "Theorems for arity of formulas." + +named_theorems arity_aux "Auxiliary theorems for calculating arities." + +ML\ +val $` = curry ((op $) o swap) +infix $` + +infix 6 &&& +val op &&& = Utils.&&& + +infix 6 *** +val op *** = Utils.*** + +fun arity_goal intermediate def_name lthy = + let + val thm = Proof_Context.get_thm lthy (def_name ^ "_def") + val (_, tm, _) = Utils.thm_concl_tm lthy (def_name ^ "_def") + val (def, tm) = tm |> Utils.dest_eq_tms' + fun first_lambdas (Abs (body as (_, ty, _))) = + if ty = @{typ "i"} + then (op ::) (Utils.dest_abs body |>> Utils.var_i ||> first_lambdas) + else Utils.dest_abs body |> first_lambdas o #2 + | first_lambdas _ = [] + val (def, vars) = Term.strip_comb def + val vs = vars @ first_lambdas tm + val def = fold (op $`) vs def + val hyps = map (fn v => Utils.mem_ v Utils.nat_ |> Utils.tp) vs + val concl = @{const IFOL.eq(i)} $ (@{const arity} $ def) $ Var (("ar", 0), @{typ "i"}) + val g_iff = Logic.list_implies (hyps, Utils.tp concl) + val attribs = if intermediate then [] else @{attributes [arity]} + in + (g_iff, "arity_" ^ def_name ^ (if intermediate then "'" else ""), attribs, thm, vs) + end + +fun manual_arity intermediate def_name pos lthy = + let + val (goal, thm_name, attribs, _, _) = arity_goal intermediate def_name lthy + in + Proof.theorem NONE (fn thmss => Utils.display "theorem" pos + o Local_Theory.note ((Binding.name thm_name, attribs), hd thmss)) + [[(goal, [])]] lthy + end + +fun prove_arity thms goal ctxt = + let + val rules = (Named_Theorems.get ctxt \<^named_theorems>\arity\) @ + (Named_Theorems.get ctxt \<^named_theorems>\arity_aux\) + in + Goal.prove ctxt [] [] goal + (K (rewrite_goal_tac ctxt thms 1 THEN Method.insert_tac ctxt rules 1 THEN asm_simp_tac ctxt 1)) + end + +fun auto_arity intermediate def_name pos lthy = + let + val (goal, thm_name, attribs, def_thm, vs) = arity_goal intermediate def_name lthy + val intermediate_text = if intermediate then "intermediate" else "" + val help = "You can manually prove the arity_theorem by typing:\n" + ^ "manual_arity " ^ intermediate_text ^ " for \"" ^ def_name ^ "\"\n" + val thm = prove_arity [def_thm] goal lthy + handle ERROR s => help ^ "\n\n" ^ s |> Exn.reraise o ERROR + val thm = Utils.fix_vars thm (map Utils.freeName vs) lthy + in + Local_Theory.note ((Binding.name thm_name, attribs), [thm]) lthy |> Utils.display "theorem" pos + end + +fun prove_tc_form goal thms ctxt = + Goal.prove ctxt [] [] goal (K (rewrite_goal_tac ctxt thms 1 THEN auto_tac ctxt)) + +fun prove_sats_tm thm_auto thms goal ctxt = + let + val ctxt' = ctxt |> Simplifier.add_simp (hd thm_auto) + in + Goal.prove ctxt [] [] goal + (K (rewrite_goal_tac ctxt thms 1 THEN PARALLEL_ALLGOALS (asm_simp_tac ctxt'))) + end + +fun prove_sats_iff goal ctxt = Goal.prove ctxt [] [] goal (K (asm_simp_tac ctxt 1)) + +fun is_mem (@{const mem} $ _ $ _) = true + | is_mem _ = false + +fun pre_synth_thm_sats term set env vars vs lthy = + let + val (_, tm, ctxt1) = Utils.thm_concl_tm lthy term + val (thm_refs, ctxt2) = Variable.import true [Proof_Context.get_thm lthy term] ctxt1 |>> #2 + val vs' = map (Thm.term_of o #2) vs + val vars' = map (Thm.term_of o #2) vars + val r_tm = tm |> Utils.dest_lhs_def |> fold (op $`) vs' + val sats = @{const apply} $ (@{const satisfies} $ set $ r_tm) $ env + val sats' = @{const IFOL.eq(i)} $ sats $ (@{const succ} $ @{const zero}) + in + { vars = vars' + , vs = vs' + , sats = sats' + , thm_refs = thm_refs + , lthy = ctxt2 + , env = env + , set = set + } + end + +fun synth_thm_sats_gen name lhs hyps pos attribs aux_funs environment lthy = + let + val ctxt = (#prepare_ctxt aux_funs) lthy + val ctxt = Utils.add_to_context (Utils.freeName (#set environment)) ctxt + val (new_vs, ctxt') = (#create_variables aux_funs) (#vs environment, ctxt) + val new_hyps = (#create_hyps aux_funs) (#vs environment, new_vs) + val concl = (#make_concl aux_funs) (lhs, #sats environment, new_vs) + val g_iff = Logic.list_implies (new_hyps @ hyps, Utils.tp concl) + val thm = (#prover aux_funs) g_iff ctxt' + val thm = Utils.fix_vars thm (map Utils.freeName ((#vars environment) @ new_vs)) lthy + in + Local_Theory.note ((name, attribs), [thm]) lthy |> Utils.display "theorem" pos + end + +fun synth_thm_sats_iff def_name lhs hyps pos environment = + let + val subst = Utils.zip_with (I *** I) (#vs environment) + fun subst_nth (@{const "nth"} $ v $ _) new_vs = AList.lookup (op =) (subst new_vs) v |> the + | subst_nth (t1 $ t2) new_vs = (subst_nth t1 new_vs) $ (subst_nth t2 new_vs) + | subst_nth (Abs (v, ty, t)) new_vs = Abs (v, ty, subst_nth t new_vs) + | subst_nth t _ = t + val name = Binding.name (def_name ^ "_iff_sats") + val iff_sats_attrib = @{attributes [iff_sats]} + val aux_funs = { prepare_ctxt = fold Utils.add_to_context (map Utils.freeName (#vs environment)) + , create_variables = fn (vs, ctxt) => Variable.variant_fixes (map Utils.freeName vs) ctxt |>> map Utils.var_i + , create_hyps = fn (vs, new_vs) => Utils.zip_with (fn (v, nv) => Utils.eq_ (Utils.nth_ v (#env environment)) nv) vs new_vs |> map Utils.tp + , make_concl = fn (lhs, rhs, new_vs) => @{const IFOL.iff} $ (subst_nth lhs new_vs) $ rhs + , prover = prove_sats_iff + } + in + synth_thm_sats_gen name lhs hyps pos iff_sats_attrib aux_funs environment + end + +fun synth_thm_sats_fm def_name lhs hyps pos thm_auto environment = + let + val name = Binding.name ("sats_" ^ def_name ^ "_fm") + val simp_attrib = @{attributes [simp]} + val aux_funs = { prepare_ctxt = I + , create_variables = K [] *** I + , create_hyps = K [] + , make_concl = fn (rhs, lhs, _) => @{const IFOL.iff} $ lhs $ rhs + , prover = prove_sats_tm thm_auto (#thm_refs environment) + } + in + synth_thm_sats_gen name lhs hyps pos simp_attrib aux_funs environment + end + +fun synth_thm_tc def_name term hyps vars pos lthy = + let + val (_,tm,ctxt1) = Utils.thm_concl_tm lthy term + val (thm_refs,ctxt2) = Variable.import true [Proof_Context.get_thm lthy term] ctxt1 |>> #2 + val vars' = map (Thm.term_of o #2) vars + val tc_attrib = @{attributes [TC]} + val r_tm = tm |> Utils.dest_lhs_def |> fold (op $`) vars' + val concl = @{const mem} $ r_tm $ @{const formula} + val g = Logic.list_implies(hyps, Utils.tp concl) + val thm = prove_tc_form g thm_refs ctxt2 + val name = Binding.name (def_name ^ "_fm_type") + val thm = Utils.fix_vars thm (map Utils.freeName vars') ctxt2 + in + Local_Theory.note ((name, tc_attrib), [thm]) lthy |> Utils.display "theorem" pos + end + +fun synthetic_def def_name thm_ref pos tc auto thy = + let + val thm = Proof_Context.get_thm thy thm_ref + val thm_vars = rev (Term.add_vars (Thm.full_prop_of thm) []) + val (((_,inst),thm_tms),_) = Variable.import true [thm] thy + val vars = map (fn v => (v, the (Vars.lookup inst v))) thm_vars + val (tm,hyps) = thm_tms |> hd |> Thm.concl_of &&& Thm.prems_of + val (lhs,rhs) = tm |> Utils.dest_iff_tms o Utils.dest_trueprop + val ((set,t),env) = rhs |> Utils.dest_sats_frm + fun relevant ts (@{const mem} $ t $ _) = + (not (t = @{term "0"})) andalso + (not (Term.is_Free t) orelse member (op =) ts (t |> Term.dest_Free |> #1)) + | relevant _ _ = false + val t_vars = sort_strings (Term.add_free_names t []) + val vs = filter (Ord_List.member String.compare t_vars o #1 o #1 o #1) vars + val at = fold_rev (lambda o Thm.term_of o #2) vs t + val hyps' = filter (relevant t_vars o Utils.dest_trueprop) hyps + val def_attrs = @{attributes [fm_definitions]} + in + Local_Theory.define ((Binding.name (def_name ^ "_fm"), NoSyn), + ((Binding.name (def_name ^ "_fm_def"), def_attrs), at)) thy + |>> (#2 #> I *** single) |> Utils.display "theorem" pos |> + (if tc then synth_thm_tc def_name (def_name ^ "_fm_def") hyps' vs pos else I) |> + (if auto then + pre_synth_thm_sats (def_name ^ "_fm_def") set env vars vs + #> I &&& #lthy + #> #1 &&& uncurry (synth_thm_sats_fm def_name lhs hyps pos thm_tms) + #> uncurry (synth_thm_sats_iff def_name lhs hyps pos) + else I) + end + +fun prove_schematic thms goal ctxt = + let + val rules = Named_Theorems.get ctxt \<^named_theorems>\iff_sats\ + in + Goal.prove ctxt [] [] goal + (K (rewrite_goal_tac ctxt thms 1 THEN REPEAT1 (CHANGED (resolve_tac ctxt rules 1 ORELSE asm_simp_tac ctxt 1)))) + end + +val valid_assumptions = [ ("nonempty", Utils.mem_ @{term "0"}) + ] + +fun pre_schematic_def target assuming lthy = +let + val thm = Proof_Context.get_thm lthy (target ^ "_def") + val (vars, tm, ctxt1) = Utils.thm_concl_tm lthy (target ^ "_def") + val (const, tm) = tm |> Utils.dest_eq_tms' o Utils.dest_trueprop |>> #1 o strip_comb + val t_vars = sort_strings (Term.add_free_names tm []) + val vs = List.filter (#1 #> #1 #> #1 #> Ord_List.member String.compare t_vars) vars + |> List.filter ((curry op = @{typ "i"}) o #2 o #1) + |> List.map (Utils.var_i o #1 o #1 o #1) + fun first_lambdas (Abs (body as (_, ty, _))) = + if ty = @{typ "i"} + then (op ::) (Utils.dest_abs body |>> Utils.var_i ||> first_lambdas) + else Utils.dest_abs body |> first_lambdas o #2 + | first_lambdas _ = [] + val vs = vs @ (first_lambdas tm) + val ctxt1' = fold Utils.add_to_context (map Utils.freeName vs) ctxt1 + val (set, ctxt2) = Variable.variant_fixes ["A"] ctxt1' |>> Utils.var_i o hd + val class = @{const "setclass"} $ set + val (env, ctxt3) = Variable.variant_fixes ["env"] ctxt2 |>> Utils.var_i o hd + val assumptions = filter (member (op =) assuming o #1) valid_assumptions |> map #2 + val hyps = (List.map (fn v => Utils.tp (Utils.mem_ v Utils.nat_)) vs) + @ [Utils.tp (Utils.mem_ env (Utils.list_ set))] + @ Utils.zip_with (fn (f,x) => Utils.tp (f x)) assumptions (replicate (length assumptions) set) + val args = class :: map (fn v => Utils.nth_ v env) vs + val (fm_name, ctxt4) = Variable.variant_fixes ["fm"] ctxt3 |>> hd + val fm_type = fold (K (fn acc => Type ("fun", [@{typ "i"}, acc]))) vs @{typ "i"} + val fm = Var ((fm_name, 0), fm_type) + val lhs = fold (op $`) args const + val fm_app = fold (op $`) vs fm + val sats = @{const apply} $ (@{const satisfies} $ set $ fm_app) $ env + val rhs = @{const IFOL.eq(i)} $ sats $ (@{const succ} $ @{const zero}) + val concl = @{const "IFOL.iff"} $ lhs $ rhs + val schematic = Logic.list_implies (hyps, Utils.tp concl) + in + (schematic, ctxt4, thm, set, env, vs) + end + +fun str_join _ [] = "" + | str_join _ [s] = s + | str_join c (s :: ss) = s ^ c ^ (str_join c ss) + +fun schematic_def def_name target assuming pos lthy = + let + val (schematic, ctxt, thm, set, env, vs) = pre_schematic_def target assuming lthy + val assuming_text = if null assuming then "" else "assuming " ^ (map (fn s => "\"" ^ s ^ "\"") assuming |> str_join " ") + val help = "You can manually prove the schematic_goal by typing:\n" + ^ "manual_schematic [sch_name] for \"" ^ target ^ "\"" ^ assuming_text ^"\n" + ^ "And then complete the synthesis with:\n" + ^ "synthesize \"" ^ target ^ "\" from_schematic [sch_name]\n" + ^ "In both commands, \sch_name\ must be the same and, if ommited, will be defaulted to sats_" ^ target ^ "_fm_auto.\n" + ^ "You can also try adding new assumptions and/or synthetizing definitions of sub-terms." + val thm = prove_schematic [thm] schematic ctxt + handle ERROR s => help ^ "\n\n" ^ s |> Exn.reraise o ERROR + val thm = Utils.fix_vars thm (map Utils.freeName (set :: env :: vs)) lthy + in + Local_Theory.note ((Binding.name def_name, []), [thm]) lthy |> Utils.display "theorem" pos + end + +fun schematic_synthetic_def def_name target assuming pos tc auto = + (synthetic_def def_name ("sats_" ^ def_name ^ "_fm_auto") pos tc auto) + o (schematic_def ("sats_" ^ def_name ^ "_fm_auto") target assuming pos) + +fun manual_schematic def_name target assuming pos lthy = + let + val (schematic, _, _, _, _, _) = pre_schematic_def target assuming lthy + in + Proof.theorem NONE (fn thmss => Utils.display "theorem" pos + o Local_Theory.note ((Binding.name def_name, []), hd thmss)) + [[(schematic, [])]] lthy + end +\ + +ML\ +local + val simple_from_schematic_synth_constdecl = + Parse.string --| (Parse.$$$ "from_schematic") + >> (fn bndg => synthetic_def bndg ("sats_" ^ bndg ^ "_fm_auto")) + + val full_from_schematic_synth_constdecl = + Parse.string -- ((Parse.$$$ "from_schematic" |-- Parse.thm)) + >> (fn (bndg,thm) => synthetic_def bndg (#1 (thm |>> Facts.ref_name))) + + val full_from_definition_synth_constdecl = + Parse.string -- ((Parse.$$$ "from_definition" |-- Parse.string)) -- (Scan.optional (Parse.$$$ "assuming" |-- Scan.repeat Parse.string) []) + >> (fn ((bndg,target), assuming) => schematic_synthetic_def bndg target assuming) + + val simple_from_definition_synth_constdecl = + Parse.string -- (Parse.$$$ "from_definition" |-- (Scan.optional (Parse.$$$ "assuming" |-- Scan.repeat Parse.string)) []) + >> (fn (bndg, assuming) => schematic_synthetic_def bndg bndg assuming) + + val synth_constdecl = + Parse.position (full_from_schematic_synth_constdecl || simple_from_schematic_synth_constdecl + || full_from_definition_synth_constdecl + || simple_from_definition_synth_constdecl) + + val full_schematic_decl = + Parse.string -- ((Parse.$$$ "for" |-- Parse.string)) -- (Scan.optional (Parse.$$$ "assuming" |-- Scan.repeat Parse.string) []) + + val simple_schematic_decl = + (Parse.$$$ "for" |-- Parse.string >> (fn name => "sats_" ^ name ^ "_fm_auto") &&& I) -- (Scan.optional (Parse.$$$ "assuming" |-- Scan.repeat Parse.string) []) + + val schematic_decl = Parse.position (full_schematic_decl || simple_schematic_decl) + + val _ = + Outer_Syntax.local_theory \<^command_keyword>\synthesize\ "ML setup for synthetic definitions" + (synth_constdecl >> (fn (f,p) => f p true true)) + + val _ = + Outer_Syntax.local_theory \<^command_keyword>\synthesize_notc\ "ML setup for synthetic definitions" + (synth_constdecl >> (fn (f,p) => f p false false)) + + val _ = Outer_Syntax.local_theory \<^command_keyword>\generate_schematic\ "ML setup for schematic goals" + (schematic_decl >> (fn (((bndg,target), assuming),p) => schematic_def bndg target assuming p)) + + val _ = Outer_Syntax.local_theory_to_proof \<^command_keyword>\manual_schematic\ "ML setup for schematic goals" + (schematic_decl >> (fn (((bndg,target), assuming),p) => manual_schematic bndg target assuming p)) + + val arity_parser = Parse.position ((Scan.option (Parse.$$$ "intermediate") >> is_some) -- (Parse.$$$ "for" |-- Parse.string)) + + val _ = Outer_Syntax.local_theory_to_proof \<^command_keyword>\manual_arity\ "ML setup for arities" + (arity_parser >> (fn ((intermediate, target), pos) => manual_arity intermediate target pos)) + + val _ = Outer_Syntax.local_theory \<^command_keyword>\arity_theorem\ "ML setup for arities" + (arity_parser >> (fn ((intermediate, target), pos) => auto_arity intermediate target pos)) + +in + +end +\ + +text\The \<^ML>\synthetic_def\ function extracts definitions from +schematic goals. A new definition is added to the context. \ + +(* example of use *) +(* +schematic_goal mem_formula_ex : + assumes "m\nat" "n\ nat" "env \ list(M)" + shows "nth(m,env) \ nth(n,env) \ sats(M,?frm,env)" + by (insert assms ; (rule sep_rules empty_iff_sats cartprod_iff_sats | simp del:sats_cartprod_fm)+) + +synthesize "\" from_schematic mem_formula_ex +*) + +end diff --git a/thys/Transitive_Models/Univ_Relative.thy b/thys/Transitive_Models/Univ_Relative.thy new file mode 100644 --- /dev/null +++ b/thys/Transitive_Models/Univ_Relative.thy @@ -0,0 +1,450 @@ +section\Relativization of the cumulative hierarchy\ +theory Univ_Relative + imports + "ZF-Constructible.Rank" + "ZF.Univ" + Discipline_Cardinal + +begin + +declare arity_ordinal_fm[arity] + +context M_trivial +begin +declare powerset_abs[simp] + +lemma family_union_closed: "\strong_replacement(M, \x y. y = f(x)); M(A); \x\A. M(f(x))\ + \ M(\x\A. f(x))" + using RepFun_closed .. + +lemma family_union_closed': "\strong_replacement(M, \x y. x\A \ y = f(x)); M(A); \x\A. M(f(x))\ + \ M(\x\A. f(x))" + using RepFun_closed2 + by simp + +end \ \\<^locale>\M_trivial\\ + +definition + Powapply :: "[i,i] \ i" where + "Powapply(f,y) \ Pow(f`y)" + +reldb_add functional "Pow" "Pow_rel" +reldb_add relational "Pow" "is_Pow" + +declare Replace_iff_sats[iff_sats] +synthesize "is_Pow" from_definition assuming "nonempty" +arity_theorem for "is_Pow_fm" + +relativize functional "Powapply" "Powapply_rel" +relationalize "Powapply_rel" "is_Powapply" +synthesize "is_Powapply" from_definition assuming "nonempty" +arity_theorem for "is_Powapply_fm" + +notation Powapply_rel (\Powapply\<^bsup>_\<^esup>'(_,_')\) + +context M_basic +begin + +rel_closed for "Powapply" + unfolding Powapply_rel_def + by simp + +is_iff_rel for "Powapply" + using Pow_rel_iff + unfolding is_Powapply_def Powapply_rel_def + by simp + +end \\\<^locale>\M_basic\\ + +definition + HVfrom :: "[i,i,i] \ i" where + "HVfrom(A,x,f) \ A \ (\y\x. Powapply(f,y))" + +relativize functional "HVfrom" "HVfrom_rel" +relationalize "HVfrom_rel" "is_HVfrom" +synthesize "is_HVfrom" from_definition assuming "nonempty" +arity_theorem intermediate for "is_HVfrom_fm" + +lemma arity_is_HVfrom_fm: + "A \ nat \ + x \ nat \ + f \ nat \ + d \ nat \ + arity(is_HVfrom_fm(A, x, f, d)) = succ(A) \ succ(d) \ (succ(x) \ succ(f))" + using arity_is_HVfrom_fm' arity_is_Powapply_fm + by(simp,subst arity_Replace_fm[of "is_Powapply_fm(succ(succ(succ(succ(f)))), 0, 1)" "succ(succ(x))" 1]) + (simp_all, auto simp add:arity pred_Un_distrib) + +notation HVfrom_rel (\HVfrom\<^bsup>_\<^esup>'(_,_,_')\) + +locale M_HVfrom = M_eclose + + assumes + Powapply_replacement: + "M(f) \ strong_replacement(M,\y z. z = Powapply\<^bsup>M\<^esup>(f,y))" +begin + +is_iff_rel for "HVfrom" +proof - + assume assms:"M(A)" "M(x)" "M(f)" "M(res)" + then + have "is_Replace(M,x,\y z. z = Powapply\<^bsup>M\<^esup>(f,y),r) \ r = {z . y\x, z = Powapply\<^bsup>M\<^esup>(f,y)}" + if "M(r)" for r + using that Powapply_rel_closed + Replace_abs[of x r "\y z. z = Powapply\<^bsup>M\<^esup>(f,y)"] transM[of _ x] + by simp + moreover + have "is_Replace(M,x,is_Powapply(M,f),r) \ + is_Replace(M,x,\y z. z = Powapply\<^bsup>M\<^esup>(f,y),r)" if "M(r)" for r + using assms that is_Powapply_iff is_Replace_cong + by simp + ultimately + have "is_Replace(M,x,is_Powapply(M,f),r) \ r = {z . y\x, z = Powapply\<^bsup>M\<^esup>(f,y)}" + if "M(r)" for r + using that assms + by simp + moreover + have "M({z . y \ x, z = Powapply\<^bsup>M\<^esup>(f,y)})" + using assms strong_replacement_closed[OF Powapply_replacement] + Powapply_rel_closed transM[of _ x] + by simp + moreover from assms + \ \intermediate step for body of Replace\ + have "{z . y \ x, z = Powapply\<^bsup>M\<^esup>(f,y)} = {y . w \ x, M(y) \ M(w) \ y = Powapply\<^bsup>M\<^esup>(f,w)}" + by (auto dest:transM) + ultimately + show ?thesis + using assms + unfolding is_HVfrom_def HVfrom_rel_def + by (auto dest:transM) +qed + +rel_closed for "HVfrom" +proof - + assume assms:"M(A)" "M(x)" "M(f)" + have "M({z . y \ x, z = Powapply\<^bsup>M\<^esup>(f,y)})" + using assms strong_replacement_closed[OF Powapply_replacement] + Powapply_rel_closed transM[of _ x] + by simp + then + have "M(A \ \({z . y\x, z = Powapply\<^bsup>M\<^esup>(f,y)}))" + using assms + by simp + moreover from assms + \ \intermediate step for body of Replace\ + have "{z . y \ x, z = Powapply\<^bsup>M\<^esup>(f,y)} = {y . w \ x, M(y) \ M(w) \ y = Powapply\<^bsup>M\<^esup>(f,w)}" + by (auto dest:transM) + ultimately + show ?thesis + using assms + unfolding HVfrom_rel_def + by simp +qed + +end \ \\<^locale>\M_HVfrom\\ + +definition + Vfrom_rel :: "[i\o,i,i] \ i" (\Vfrom\<^bsup>_\<^esup>'(_,_')\) where + "Vfrom\<^bsup>M\<^esup>(A,i) = transrec(i, HVfrom_rel(M,A))" + +definition + is_Vfrom :: "[i\o,i,i,i] \ o" where + "is_Vfrom(M,A,i,z) \ is_transrec(M,is_HVfrom(M,A),i,z)" + +definition + Hrank :: "[i,i] \ i" where + "Hrank(x,f) \ (\y\x. succ(f`y))" + +definition + rrank :: "i \ i" where + "rrank(a) \ Memrel(eclose({a}))^+" + +relativize functional "Hrank" "Hrank_rel" +relationalize "Hrank_rel" "is_Hrank" +synthesize "is_Hrank" from_definition assuming "nonempty" + +lemma arity_is_Hrank_fm : "x \ nat \ + f \ nat \ + d \ nat \ + arity(is_Hrank_fm(x, f, d)) = + succ(d) \ succ(x) \ succ(f)" + unfolding is_Hrank_fm_def + using arity_fun_apply_fm arity_big_union_fm + arity_fun_apply_fm arity_succ_fm arity_And arity_Exists + arity_Replace_fm[of + "(\\\\succ(0) is 2\ \ \ succ(succ(succ(succ(f))))`1 is 0\\\)" + "succ(x)" 0 "4+\<^sub>\f"] + by(simp_all add:Un_assoc pred_Un,simp add:ord_simp_union) + +locale M_Vfrom = M_HVfrom + + assumes + trepl_HVfrom : "\ M(A);M(i) \ \ transrec_replacement(M,is_HVfrom(M,A),i)" + and + Hrank_replacement : "M(f) \ strong_replacement(M,\x y . y = succ(f`x))" + and + is_Hrank_replacement : "M(x) \ wfrec_replacement(M,is_Hrank(M),rrank(x))" + and + HVfrom_replacement : "\ M(i) ; M(A) \ \ + transrec_replacement(M,is_HVfrom(M,A),i)" + +begin + +lemma Vfrom_rel_iff : + assumes "M(A)" "M(i)" "M(z)" "Ord(i)" + shows "is_Vfrom(M,A,i,z) \ z = Vfrom\<^bsup>M\<^esup>(A,i)" +proof - + have "relation2(M, is_HVfrom(M, A), HVfrom_rel(M, A))" + using assms is_HVfrom_iff + unfolding relation2_def + by simp + then + show ?thesis + using assms HVfrom_rel_closed trepl_HVfrom + transrec_abs[of "is_HVfrom(M,A)" i "HVfrom_rel(M,A)" z] + unfolding is_Vfrom_def Vfrom_rel_def + by simp +qed + +lemma relation2_HVfrom: "M(A) \ relation2(M,is_HVfrom(M,A),HVfrom_rel(M,A))" + using is_HVfrom_iff + unfolding relation2_def + by auto + +lemma HVfrom_closed : + "M(A) \ \x[M]. \g[M]. function(g) \ M(HVfrom_rel(M,A,x,g))" + using HVfrom_rel_closed by simp + +lemma Vfrom_rel_closed: + assumes "M(A)" "M(i)" "Ord(i)" + shows "M(transrec(i, HVfrom_rel(M, A)))" + using is_HVfrom_iff HVfrom_closed HVfrom_replacement assms trepl_HVfrom relation2_HVfrom + transrec_closed[of "is_HVfrom(M,A)" i "HVfrom_rel(M,A)"] + by simp + +lemma transrec_HVfrom: + assumes "M(A)" + shows "Ord(i) \ M(i) \ {x\Vfrom(A,i). M(x)} = transrec(i,HVfrom_rel(M,A))" +proof (induct rule:trans_induct) + have eq:"(\x\i. {x \ Pow(transrec(x, HVfrom_rel(M, A))) . M(x)}) = \{y . x \ i, y = Pow\<^bsup>M\<^esup>(transrec(x, HVfrom_rel(M, A)))}" + if "Ord(i)" "M(i)" for i + using assms Pow_rel_char[OF Vfrom_rel_closed[OF \M(A)\ transM[of _ i]]] Ord_in_Ord' that + by auto + case (step i) + then + have 0: "M(Pow\<^bsup>M\<^esup>(transrec(x, HVfrom_rel(M, A))))" if "x\i" for x + using assms that transM[of _ i] Ord_in_Ord + transrec_closed[of "is_HVfrom(M,A)" _ "HVfrom_rel(M,A)"] trepl_HVfrom relation2_HVfrom + by auto + have "Vfrom(A,i) = A \ (\y\i. Pow((\x\i. Vfrom(A, x)) ` y))" + using def_transrec[OF Vfrom_def, of A i] by simp + then + have "Vfrom(A,i) = A \ (\y\i. Pow(Vfrom(A, y)))" + by simp + then + have "{x\Vfrom(A,i). M(x)} = {x\A. M(x)} \ (\y\i. {x\Pow(Vfrom(A, y)). M(x)})" + by auto + with \M(A)\ + have "{x\Vfrom(A,i). M(x)} = A \ (\y\i. {x\Pow(Vfrom(A, y)). M(x)})" + by (auto intro:transM) + also + have "... = A \ (\y\i. {x\Pow({z\Vfrom(A,y). M(z)}). M(x)})" + proof - + have "{x\Pow(Vfrom(A, y)). M(x)} = {x\Pow({z\Vfrom(A,y). M(z)}). M(x)}" + if "y\i" for y by (auto intro:transM) + then + show ?thesis by simp + qed + also from step + have " ... = A \ (\y\i. {x\Pow(transrec(y, HVfrom_rel(M, A))). M(x)})" + using transM[of _ i] + by auto + also + have " ... = transrec(i, HVfrom_rel(M, A))" + using 0 step assms transM[of _ i] eq + def_transrec[of "\y. transrec(y, HVfrom_rel(M, A))" "HVfrom_rel(M, A)" i] + unfolding Powapply_rel_def HVfrom_rel_def + by auto + finally + show ?case . +qed + +lemma Vfrom_abs: "\ M(A); M(i); M(V); Ord(i) \ \ is_Vfrom(M,A,i,V) \ V = {x\Vfrom(A,i). M(x)}" + unfolding is_Vfrom_def + using is_HVfrom_iff + transrec_abs[of "is_HVfrom(M,A)" i "HVfrom_rel(M,A)"] trepl_HVfrom relation2_HVfrom + transrec_HVfrom + by simp + +lemma Vfrom_closed: "\ M(A); M(i); Ord(i) \ \ M({x\Vfrom(A,i). M(x)})" + unfolding is_Vfrom_def + using is_HVfrom_iff HVfrom_closed HVfrom_replacement + transrec_closed[of "is_HVfrom(M,A)" i "HVfrom_rel(M,A)"] trepl_HVfrom relation2_HVfrom + transrec_HVfrom + by simp + +end \ \\<^locale>\M_Vfrom\\ + +subsection\Formula synthesis\ + +context M_Vfrom +begin + +rel_closed for "Hrank" + unfolding Hrank_rel_def + using Hrank_replacement + by simp + +is_iff_rel for "Hrank" +proof - + assume "M(f)" "M(x)" "M(res)" + moreover from this + have "{a . y \ x, M(a) \ M(y) \ a = succ(f ` y)} = {a . y \ x, a = succ(f ` y)}" + using transM[of _ x] + by auto + ultimately + show ?thesis + unfolding is_Hrank_def Hrank_rel_def + using Replace_abs transM[of _ x] Hrank_replacement + by auto +qed + +lemma relation2_Hrank : + "relation2(M,is_Hrank(M),Hrank)" + unfolding relation2_def +proof(clarify) + fix x f res + assume "M(x)" "M(f)" "M(res)" + moreover from this + have "{a . y \ x, M(a) \ M(y) \ a = succ(f ` y)} = {a . y \ x, a = succ(f ` y)}" + using transM[of _ x] + by auto + ultimately + show "is_Hrank(M, x, f, res) \ res = Hrank(x, f)" + unfolding Hrank_def relation2_def + using is_Hrank_iff[unfolded Hrank_rel_def] + by auto +qed + +lemma Hrank_closed : + "\x[M]. \g[M]. function(g) \ M(Hrank(x,g))" +proof(clarify) + fix x g + assume "M(x)" "M(g)" + then + show "M(Hrank(x,g))" + using RepFun_closed[OF Hrank_replacement] transM[of _ x] + unfolding Hrank_def + by auto +qed + +end \\\<^locale>\M_basic\\ + +context M_eclose +begin + +lemma wf_rrank : "M(x) \ wf(rrank(x))" + unfolding rrank_def using wf_trancl[OF wf_Memrel] . + +lemma trans_rrank : "M(x) \ trans(rrank(x))" + unfolding rrank_def using trans_trancl . + +lemma relation_rrank : "M(x) \ relation(rrank(x))" + unfolding rrank_def using relation_trancl . + +lemma rrank_in_M : "M(x) \ M(rrank(x))" + unfolding rrank_def by simp + +end \ \\<^locale>\M_eclose\\ + +lemma Hrank_trancl:"Hrank(y, restrict(f,Memrel(eclose({x}))-``{y})) + = Hrank(y, restrict(f,(Memrel(eclose({x}))^+)-``{y}))" + unfolding Hrank_def + using restrict_trans_eq by simp + +lemma rank_trancl: "rank(x) = wfrec(rrank(x), x, Hrank)" +proof - + have "rank(x) = wfrec(Memrel(eclose({x})), x, Hrank)" + (is "_ = wfrec(?r,_,_)") + unfolding rank_def transrec_def Hrank_def by simp + also + have " ... = wftrec(?r^+, x, \y f. Hrank(y, restrict(f,?r-``{y})))" + unfolding wfrec_def .. + also + have " ... = wftrec(?r^+, x, \y f. Hrank(y, restrict(f,(?r^+)-``{y})))" + using Hrank_trancl by simp + also + have " ... = wfrec(?r^+, x, Hrank)" + unfolding wfrec_def using trancl_eq_r[OF relation_trancl trans_trancl] by simp + finally + show ?thesis unfolding rrank_def . +qed + +definition + Vset' :: "[i] \ i" where + "Vset'(A) \ Vfrom(0,A)" + +reldb_add relational "Vfrom" "is_Vfrom" +reldb_add functional "Vfrom" "Vfrom_rel" +relativize functional "Vset'" "Vset_rel" +relationalize "Vset_rel" "is_Vset" +reldb_rem relational "Vset" +reldb_rem functional "Vset_rel" +reldb_add relational "Vset" "is_Vset" +reldb_add functional "Vset" "Vset_rel" + +schematic_goal sats_is_Vset_fm_auto: + assumes + "i\nat" "v\nat" "env\list(A)" "0\A" + "i < length(env)" "v < length(env)" + shows + "is_Vset(##A,nth(i, env),nth(v, env)) \ sats(A,?ivs_fm(i,v),env)" + unfolding is_Vset_def is_Vfrom_def + by (insert assms; (rule sep_rules is_HVfrom_iff_sats is_transrec_iff_sats | simp)+) + +synthesize "is_Vset" from_schematic "sats_is_Vset_fm_auto" +arity_theorem for "is_Vset_fm" +context M_Vfrom +begin + +lemma Vset_abs: "\ M(i); M(V); Ord(i) \ \ is_Vset(M,i,V) \ V = {x\Vset(i). M(x)}" + using Vfrom_abs unfolding is_Vset_def by simp + +lemma Vset_closed: "\ M(i); Ord(i) \ \ M({x\Vset(i). M(x)})" + using Vfrom_closed unfolding is_Vset_def by simp + +lemma rank_closed: "M(a) \ M(rank(a))" + unfolding rank_trancl + using Hrank_closed is_Hrank_replacement relation2_Hrank + wf_rrank relation_rrank trans_rrank rrank_in_M + trans_wfrec_closed[of "rrank(a)" a "is_Hrank(M)"] + transM[of _ a] + by auto + +lemma M_into_Vset: + assumes "M(a)" + shows "\i[M]. \V[M]. ordinal(M,i) \ is_Vset(M,i,V) \ a\V" +proof - + let ?i="succ(rank(a))" + from assms + have "a\{x\Vfrom(0,?i). M(x)}" (is "a\?V") + using Vset_Ord_rank_iff by simp + moreover from assms + have "M(?i)" + using rank_closed by simp + moreover + note \M(a)\ + moreover from calculation + have "M(?V)" + using Vfrom_closed by simp + moreover from calculation + have "ordinal(M,?i) \ is_Vfrom(M, 0, ?i, ?V) \ a \ ?V" + using Ord_rank Vfrom_abs by simp + ultimately + show ?thesis + using nonempty empty_abs + unfolding is_Vset_def + by blast +qed + +end \ \\<^locale>\M_HVfrom\\ + +end \ No newline at end of file diff --git a/thys/Transitive_Models/Utils.ml b/thys/Transitive_Models/Utils.ml new file mode 100644 --- /dev/null +++ b/thys/Transitive_Models/Utils.ml @@ -0,0 +1,193 @@ +signature Utils = + sig + val &&& : ('a -> 'b) * ('a -> 'c) -> 'a -> 'b * 'c + val *** : ('a -> 'b) * ('c -> 'd) -> 'a * 'c -> 'b * 'd + val @@ : ''a list * ''a list -> ''a list + val --- : ''a list * ''a list -> ''a list + val binop : term -> term -> term -> term + val add_: term -> term -> term + val add_to_context : string -> Proof.context -> Proof.context + val app_: term -> term -> term + val concat_: term -> term -> term + val dest_apply: term -> term * term + val dest_abs : string * typ * term -> string * term + val dest_iff_lhs: term -> term + val dest_iff_rhs: term -> term + val dest_iff_tms: term -> term * term + val dest_lhs_def: term -> term + val dest_rhs_def: term -> term + val dest_satisfies_tms: term -> term * term + val dest_satisfies_frm: term -> term + val dest_eq_tms: term -> term * term + val dest_mem_tms: term -> term * term + val dest_sats_frm: term -> (term * term) * term + val dest_eq_tms': term -> term * term + val dest_trueprop: term -> term + val display : string -> Position.T -> (string * thm list) * Proof.context -> Proof.context + val eq_: term -> term -> term + val fix_vars: thm -> string list -> Proof.context -> thm + val flat : ''a list list -> ''a list + val formula_: term + val freeName: term -> string + val frees : term -> term list + val length_: term -> term + val list_: term -> term + val lt_: term -> term -> term + val map_option : ('a -> 'b) -> 'a option -> 'b option + val mem_: term -> term -> term + val mk_FinSet: term list -> term + val mk_Pair: term -> term -> term + val mk_ZFlist: ('a -> term) -> 'a list -> term + val mk_ZFnat: int -> term + val nat_: term + val nth_: term -> term -> term + val reachable : (''a -> ''a -> bool) -> ''a list -> ''a list -> ''a list + val subset_: term -> term -> term + val thm_concl_tm : Proof.context -> xstring -> (Vars.key * cterm) list * term * Proof.context + val to_ML_list: term -> term list + val tp: term -> term + val var_i : string -> term + val zip_with : ('a * 'b -> 'c) -> 'a list -> 'b list -> 'c list + end + +structure Utils : Utils = +struct +(* Smart constructors for ZF-terms *) + +fun binop h t u = h $ t $ u + +val mk_Pair = binop @{const Pair} + +fun mk_FinSet nil = @{const zero} + | mk_FinSet (e :: es) = @{const cons} $ e $ mk_FinSet es + +fun mk_ZFnat 0 = @{const zero} + | mk_ZFnat n = @{const succ} $ mk_ZFnat (n-1) + +fun mk_ZFlist _ nil = @{const "Nil"} + | mk_ZFlist f (t :: ts) = @{const "Cons"} $ f t $ mk_ZFlist f ts + +fun to_ML_list (@{const Nil}) = nil + | to_ML_list (@{const Cons} $ t $ ts) = t :: to_ML_list ts + | to_ML_list _ = nil + +fun freeName (Free (n,_)) = n + | freeName _ = error "Not a free variable" + +val app_ = binop @{const apply} + +fun tp x = @{const Trueprop} $ x +fun length_ env = @{const length} $ env +val nth_ = binop @{const nth} +val add_ = binop @{const add} +val mem_ = binop @{const mem} +val subset_ = binop @{const Subset} +val lt_ = binop @{const lt} +val concat_ = binop @{const app} +val eq_ = binop @{const IFOL.eq(i)} + +(* Abbreviation for sets *) +fun list_ set = @{const list} $ set +val nat_ = @{const nat} +val formula_ = @{const formula} + +(** Destructors of terms **) +fun dest_eq_tms (Const (@{const_name IFOL.eq},_) $ t $ u) = (t, u) + | dest_eq_tms t = raise TERM ("dest_eq_tms", [t]) + +fun dest_mem_tms (@{const mem} $ t $ u) = (t, u) + | dest_mem_tms t = raise TERM ("dest_mem_tms", [t]) + + +fun dest_eq_tms' (Const (@{const_name Pure.eq},_) $ t $ u) = (t, u) + | dest_eq_tms' t = raise TERM ("dest_eq_tms", [t]) + +val dest_lhs_def = #1 o dest_eq_tms' +val dest_rhs_def = #2 o dest_eq_tms' + +fun dest_apply (@{const apply} $ t $ u) = (t,u) + | dest_apply t = raise TERM ("dest_applies_op", [t]) + +fun dest_satisfies_tms (@{const Formula.satisfies} $ A $ f) = (A,f) + | dest_satisfies_tms t = raise TERM ("dest_satisfies_tms", [t]); + +val dest_satisfies_frm = #2 o dest_satisfies_tms + +fun dest_sats_frm t = t |> dest_eq_tms |> #1 |> dest_apply |>> dest_satisfies_tms ; + +fun dest_trueprop (@{const IFOL.Trueprop} $ t) = t + | dest_trueprop t = t + +fun dest_iff_tms (@{const IFOL.iff} $ t $ u) = (t, u) + | dest_iff_tms t = raise TERM ("dest_iff_tms", [t]) + +val dest_iff_lhs = #1 o dest_iff_tms +val dest_iff_rhs = #2 o dest_iff_tms + +fun thm_concl_tm ctxt thm_ref = + let + val thm = Proof_Context.get_thm ctxt thm_ref + val thm_vars = rev (Term.add_vars (Thm.full_prop_of thm) []) + val (((_,inst),thm_tms),ctxt1) = Variable.import true [thm] ctxt + val vars = map (fn v => (v, the (Vars.lookup inst v))) thm_vars + in + (vars, thm_tms |> hd |> Thm.concl_of, ctxt1) +end + +fun fix_vars thm vars ctxt = let + val (_, ctxt1) = Variable.add_fixes vars ctxt + in singleton (Proof_Context.export ctxt1 ctxt) thm +end + +fun display kind pos (thms,thy) = + let val _ = Proof_Display.print_results true pos thy ((kind,""),[thms]) + in thy +end + +(* lists as sets *) + +infix 6 @@ +fun op @@ (xs, ys) = union (op =) ys xs + +fun flat xss = fold (curry op @@) xss [] + +infix 6 --- +fun op --- (xs, ys) = subtract (op =) ys xs + +(* function product *) +infix 6 &&& +fun op &&& (f, g) = fn x => (f x, g x) + +infix 6 *** +fun op *** (f, g) = fn (x, y) => (f x, g y) + +(* add variable to context *) +fun add_to_context v c = if Variable.is_fixed c v then c else #2 (Variable.add_fixes [v] c) + +(* get free variables of a term *) +fun frees t = fold_aterms (fn t => if is_Free t then cons t else I) t [] + +(* closure of a set wrt a preorder *) +(* the preorder is the reflexive-transitive closure of the given relation p *) +(* u represents the universe, and xs represents the starting points *) +(* [xs]_{p,u} = { v \ u . \ x \ xs . p*(x, v) }*) +fun reachable p u xs = + let + val step = map (fn x => filter (p x) (u --- xs)) xs |> flat + val acc = if null step then [] else reachable p (u --- xs) step + in + xs @@ acc + end + +fun zip_with _ [] _ = [] + | zip_with _ _ [] = [] + | zip_with f (x :: xs) (y :: ys) = f (x, y) :: zip_with f xs ys + +fun var_i s = Free (s, @{typ "i"}) + +fun map_option f (SOME a) = SOME (f a) + | map_option _ NONE = NONE + +fun dest_abs (v, ty, t) = (v, Term.subst_bound ((Free (v, ty)), t)) + +end diff --git a/thys/Transitive_Models/Utils.thy b/thys/Transitive_Models/Utils.thy new file mode 100644 --- /dev/null +++ b/thys/Transitive_Models/Utils.thy @@ -0,0 +1,8 @@ +theory Utils + imports "ZF-Constructible.Formula" +begin + +txt\This theory encapsulates some ML utilities\ +ML_file\Utils.ml\ + +end \ No newline at end of file diff --git a/thys/Transitive_Models/ZF_Library_Relative.thy b/thys/Transitive_Models/ZF_Library_Relative.thy new file mode 100644 --- /dev/null +++ b/thys/Transitive_Models/ZF_Library_Relative.thy @@ -0,0 +1,1081 @@ +section\Library of basic $\mathit{ZF}$ results\label{sec:zf-lib}\ + +theory ZF_Library_Relative + imports + Aleph_Relative\ \must be before Cardinal\_AC\_Relative!\ + Cardinal_AC_Relative + FiniteFun_Relative +begin + +no_notation sum (infixr \+\ 65) +notation oadd (infixl \+\ 65) + +lemma (in M_cardinal_arith_jump) csucc_rel_cardinal_rel: + assumes "Ord(\)" "M(\)" + shows "(|\|\<^bsup>M\<^esup>\<^sup>+)\<^bsup>M\<^esup> = (\\<^sup>+)\<^bsup>M\<^esup>" +proof (intro le_anti_sym)\ \show both inequalities\ + from assms + have hips:"M((\\<^sup>+)\<^bsup>M\<^esup>)" "Ord((\\<^sup>+)\<^bsup>M\<^esup>)" "\ < (\\<^sup>+)\<^bsup>M\<^esup>" + using Card_rel_csucc_rel[THEN Card_rel_is_Ord] + csucc_rel_basic by simp_all + then + show "(|\|\<^bsup>M\<^esup>\<^sup>+)\<^bsup>M\<^esup> \ (\\<^sup>+)\<^bsup>M\<^esup>" + using Ord_cardinal_rel_le[THEN lt_trans1] + Card_rel_csucc_rel + unfolding csucc_rel_def + by (rule_tac Least_antitone) (assumption, simp_all add:assms) + from assms + have "\ < L" if "Card\<^bsup>M\<^esup>(L)" "|\|\<^bsup>M\<^esup> < L" "M(L)" for L + using (* Card_rel_le_iff[THEN iffD1, THEN le_trans, of \ _ L] *) that + Card_rel_is_Ord leI Card_rel_le_iff[of \ L] + by (rule_tac ccontr, auto dest:not_lt_imp_le) (fast dest: le_imp_not_lt) + with hips + show "(\\<^sup>+)\<^bsup>M\<^esup> \ (|\|\<^bsup>M\<^esup>\<^sup>+)\<^bsup>M\<^esup>" + using Ord_cardinal_rel_le[THEN lt_trans1] Card_rel_csucc_rel + unfolding csucc_rel_def + by (rule_tac Least_antitone) (assumption, auto simp add:assms) +qed + +lemma (in M_cardinal_arith_jump) csucc_rel_le_mono: + assumes "\ \ \" "M(\)" "M(\)" + shows "(\\<^sup>+)\<^bsup>M\<^esup> \ (\\<^sup>+)\<^bsup>M\<^esup>" +proof (cases "\ = \") + case True + with assms + show ?thesis using Card_rel_csucc_rel [THEN Card_rel_is_Ord] by simp +next + case False + with assms + have "\ < \" using le_neq_imp_lt by simp + show ?thesis\ \by way of contradiction\ + proof (rule ccontr) + assume "\ (\\<^sup>+)\<^bsup>M\<^esup> \ (\\<^sup>+)\<^bsup>M\<^esup>" + with assms + have "(\\<^sup>+)\<^bsup>M\<^esup> < (\\<^sup>+)\<^bsup>M\<^esup>" + using Card_rel_csucc_rel[THEN Card_rel_is_Ord] le_Ord2 lt_Ord + by (intro not_le_iff_lt[THEN iffD1]) auto + with assms + have "(\\<^sup>+)\<^bsup>M\<^esup> \ |\|\<^bsup>M\<^esup>" + using le_Ord2[THEN Card_rel_csucc_rel, of \ \] + Card_rel_lt_csucc_rel_iff[of "(\\<^sup>+)\<^bsup>M\<^esup>" "|\|\<^bsup>M\<^esup>", THEN iffD1] + csucc_rel_cardinal_rel[OF lt_Ord] leI[of "(\\<^sup>+)\<^bsup>M\<^esup>" "(\\<^sup>+)\<^bsup>M\<^esup>"] + by simp + with assms + have "(\\<^sup>+)\<^bsup>M\<^esup> \ \" + using Ord_cardinal_rel_le[OF lt_Ord] le_trans by auto + with assms + have "\ < \" + using csucc_rel_basic le_Ord2[THEN Card_rel_csucc_rel, of \ \] Card_rel_is_Ord + le_Ord2 + by (rule_tac j="(\\<^sup>+)\<^bsup>M\<^esup>" in lt_trans2) simp_all + with \\ < \\ + show "False" using le_imp_not_lt leI by blast + qed +qed + +lemma (in M_cardinal_AC) cardinal_rel_succ_not_0: "|A|\<^bsup>M\<^esup> = succ(n) \ M(A) \ M(n) \ A \ 0" + by auto + +(* "Finite_to_one(X,Y) \ {f:X\Y. \y\Y. Finite({x\X . f`x = y})}" *) +reldb_add functional "Finite" "Finite" \ \wrongly done? Finite is absolute\ +relativize functional "Finite_to_one" "Finite_to_one_rel" external + (* reldb_add relational "Finite" "is_Finite" \ \don't have is_Finite yet\ +relationalize "Finite_to_one_rel" "is_Finite_to_one" *) + +notation Finite_to_one_rel (\Finite'_to'_one\<^bsup>_\<^esup>'(_,_')\) + +abbreviation + Finite_to_one_r_set :: "[i,i,i] \ i" (\Finite'_to'_one\<^bsup>_\<^esup>'(_,_')\) where + "Finite_to_one\<^bsup>M\<^esup>(X,Y) \ Finite_to_one_rel(##M,X,Y)" + +locale M_ZF_library = M_cardinal_arith + M_aleph + M_FiniteFun + M_replacement_extra +begin + +lemma Finite_Collect_imp: "Finite({x\X . Q(x)}) \ Finite({x\X . M(x) \ Q(x)})" + (is "Finite(?A) \ Finite(?B)") + using subset_Finite[of ?B ?A] by auto + +lemma Finite_to_one_relI[intro]: + assumes "f:X\\<^bsup>M\<^esup>Y" "\y. y\Y \ Finite({x\X . f`x = y})" + and types:"M(f)" "M(X)" "M(Y)" + shows "f \ Finite_to_one\<^bsup>M\<^esup>(X,Y)" + using assms Finite_Collect_imp unfolding Finite_to_one_rel_def + by (simp) + +lemma Finite_to_one_relI'[intro]: + assumes "f:X\\<^bsup>M\<^esup>Y" "\y. y\Y \ Finite({x\X . M(x) \ f`x = y})" + and types:"M(f)" "M(X)" "M(Y)" + shows "f \ Finite_to_one\<^bsup>M\<^esup>(X,Y)" + using assms unfolding Finite_to_one_rel_def + by (simp) + +lemma Finite_to_one_relD[dest]: + "f \ Finite_to_one\<^bsup>M\<^esup>(X,Y) \f:X\\<^bsup>M\<^esup>Y" + "f \ Finite_to_one\<^bsup>M\<^esup>(X,Y) \ y\Y \ M(Y) \ Finite({x\X . M(x) \ f`x = y})" + unfolding Finite_to_one_rel_def by simp_all + +lemma Diff_bij_rel: + assumes "\A\F. X \ A" + and types: "M(F)" "M(X)" shows "(\A\F. A-X) \ bij\<^bsup>M\<^esup>(F, {A-X. A\F})" + using assms def_inj_rel def_surj_rel unfolding bij_rel_def + apply (auto) + apply (subgoal_tac "M(\A\F. A - X)" "M({A - X . A \ F})") + apply (auto simp add:mem_function_space_rel_abs) + apply (rule_tac lam_type, auto) + prefer 4 + apply (subgoal_tac "M(\A\F. A - X)" "M({A - X . A \ F})") + apply(tactic \distinct_subgoals_tac\) + apply (auto simp add:mem_function_space_rel_abs) + apply (rule_tac lam_type, auto) prefer 3 + apply (subst subset_Diff_Un[of X]) + apply auto +proof - + from types + show "M({A - X . A \ F})" + using diff_replacement + by (rule_tac RepFun_closed) (auto dest:transM[of _ F]) + from types + show "M(\A\F. A - X)" + using Pair_diff_replacement + by (rule_tac lam_closed, auto dest:transM) +qed + +lemma function_space_rel_nonempty: + assumes "b\B" and types: "M(B)" "M(A)" + shows "(\x\A. b) : A \\<^bsup>M\<^esup> B" +proof - + note assms + moreover from this + have "M(\x\A. b)" + using tag_replacement by (rule_tac lam_closed, auto dest:transM) + ultimately + show ?thesis + by (simp add:mem_function_space_rel_abs) +qed + +lemma mem_function_space_rel: + assumes "f \ A \\<^bsup>M\<^esup> y" "M(A)" "M(y)" + shows "f \ A \ y" + using assms function_space_rel_char by simp + +lemmas range_fun_rel_subset_codomain = range_fun_subset_codomain[OF mem_function_space_rel] + +end \ \\<^locale>\M_ZF_library\\ + +context M_Pi_assumptions +begin + +lemma mem_Pi_rel: "f \ Pi\<^bsup>M\<^esup>(A,B) \ f \ Pi(A, B)" + using trans_closed mem_Pi_rel_abs + by force + +lemmas Pi_rel_rangeD = Pi_rangeD[OF mem_Pi_rel] + +lemmas rel_apply_Pair = apply_Pair[OF mem_Pi_rel] + +lemmas rel_apply_rangeI = apply_rangeI[OF mem_Pi_rel] + +lemmas Pi_rel_range_eq = Pi_range_eq[OF mem_Pi_rel] + +lemmas Pi_rel_vimage_subset = Pi_vimage_subset[OF mem_Pi_rel] + +end \ \\<^locale>\M_Pi_assumptions\\ + +context M_ZF_library +begin + +lemma mem_bij_rel: "\f \ bij\<^bsup>M\<^esup>(A,B); M(A); M(B)\ \ f\bij(A,B)" + using bij_rel_char by simp + +lemma mem_inj_rel: "\f \ inj\<^bsup>M\<^esup>(A,B); M(A); M(B)\ \ f\inj(A,B)" + using inj_rel_char by simp + +lemma mem_surj_rel: "\f \ surj\<^bsup>M\<^esup>(A,B); M(A); M(B)\ \ f\surj(A,B)" + using surj_rel_char by simp + +lemmas rel_apply_in_range = apply_in_range[OF _ _ mem_function_space_rel] + +lemmas rel_range_eq_image = ZF_Library.range_eq_image[OF mem_function_space_rel] + +lemmas rel_Image_sub_codomain = Image_sub_codomain[OF mem_function_space_rel] + +lemma rel_inj_to_Image: "\f:A\\<^bsup>M\<^esup>B; f \ inj\<^bsup>M\<^esup>(A,B); M(A); M(B)\ \ f \ inj\<^bsup>M\<^esup>(A,f``A)" + using inj_to_Image[OF mem_function_space_rel mem_inj_rel] + transM[OF _ function_space_rel_closed] by simp + +lemma inj_rel_imp_surj_rel: + fixes f b + defines [simp]: "ifx(x) \ if x\range(f) then converse(f)`x else b" + assumes "f \ inj\<^bsup>M\<^esup>(B,A)" "b\B" and types: "M(f)" "M(B)" "M(A)" + shows "(\x\A. ifx(x)) \ surj\<^bsup>M\<^esup>(A,B)" +proof - + from types and \b\B\ + have "M(\x\A. ifx(x))" + using ifx_replacement by (rule_tac lam_closed) (auto dest:transM) + with assms(2-) + show ?thesis + using inj_imp_surj mem_surj_abs by simp +qed + +lemma function_space_rel_disjoint_Un: + assumes "f \ A\\<^bsup>M\<^esup>B" "g \ C\\<^bsup>M\<^esup>D" "A \ C = 0" + and types:"M(A)" "M(B)" "M(C)" "M(D)" + shows "f \ g \ (A \ C)\\<^bsup>M\<^esup> (B \ D)" + using assms fun_Pi_disjoint_Un[OF mem_function_space_rel + mem_function_space_rel, OF assms(1) _ _ assms(2)] + function_space_rel_char by auto + +lemma restrict_eq_imp_Un_into_function_space_rel: + assumes "f \ A\\<^bsup>M\<^esup>B" "g \ C\\<^bsup>M\<^esup>D" "restrict(f, A \ C) = restrict(g, A \ C)" + and types:"M(A)" "M(B)" "M(C)" "M(D)" + shows "f \ g \ (A \ C)\\<^bsup>M\<^esup> (B \ D)" + using assms restrict_eq_imp_Un_into_Pi[OF mem_function_space_rel + mem_function_space_rel, OF assms(1) _ _ assms(2)] + function_space_rel_char by auto + +lemma lepoll_relD[dest]: "A \\<^bsup>M\<^esup> B \ \f[M]. f \ inj\<^bsup>M\<^esup>(A, B)" + unfolding lepoll_rel_def . + +\ \Should the assumptions be on \<^term>\f\ or on \<^term>\A\ and \<^term>\B\? + Should BOTH be intro rules?\ +lemma lepoll_relI[intro]: "f \ inj\<^bsup>M\<^esup>(A, B) \ M(f) \ A \\<^bsup>M\<^esup> B" + unfolding lepoll_rel_def by blast + +lemma eqpollD[dest]: "A \\<^bsup>M\<^esup> B \ \f[M]. f \ bij\<^bsup>M\<^esup>(A, B)" + unfolding eqpoll_rel_def . + +\ \Same as @{thm lepoll_relI}\ +lemma bij_rel_imp_eqpoll_rel[intro]: "f \ bij\<^bsup>M\<^esup>(A,B) \ M(f) \ A \\<^bsup>M\<^esup> B" + unfolding eqpoll_rel_def by blast + +lemma restrict_bij_rel:\ \Unused\ + assumes "f \ inj\<^bsup>M\<^esup>(A,B)" "C\A" + and types:"M(A)" "M(B)" "M(C)" + shows "restrict(f,C)\ bij\<^bsup>M\<^esup>(C, f``C)" + using assms restrict_bij inj_rel_char bij_rel_char by auto + +lemma range_of_subset_eqpoll_rel: + assumes "f \ inj\<^bsup>M\<^esup>(X,Y)" "S \ X" + and types:"M(X)" "M(Y)" "M(S)" + shows "S \\<^bsup>M\<^esup> f `` S" + using assms restrict_bij bij_rel_char + trans_inj_rel_closed[OF \f \ inj\<^bsup>M\<^esup>(X,Y)\] + unfolding eqpoll_rel_def + by (rule_tac x="restrict(f,S)" in rexI) auto + +lemmas inj_rel_is_fun = inj_is_fun[OF mem_inj_rel] + +lemma inj_rel_bij_rel_range: "f \ inj\<^bsup>M\<^esup>(A,B) \ M(A) \ M(B) \ f \ bij\<^bsup>M\<^esup>(A,range(f))" + using bij_rel_char inj_rel_char inj_bij_range by force + +lemma bij_rel_is_inj_rel: "f \ bij\<^bsup>M\<^esup>(A,B) \ M(A) \ M(B) \ f \ inj\<^bsup>M\<^esup>(A,B)" + unfolding bij_rel_def by simp + +lemma inj_rel_weaken_type: "[| f \ inj\<^bsup>M\<^esup>(A,B); B\D; M(A); M(B); M(D) |] ==> f \ inj\<^bsup>M\<^esup>(A,D)" + using inj_rel_char inj_rel_is_fun inj_weaken_type by auto + +lemma bij_rel_converse_bij_rel [TC]: "f \ bij\<^bsup>M\<^esup>(A,B) \ M(A) \ M(B) ==> converse(f): bij\<^bsup>M\<^esup>(B,A)" + using bij_rel_char by force + +lemma bij_rel_is_fun_rel: "f \ bij\<^bsup>M\<^esup>(A,B) \ M(A) \ M(B) \ f \ A\\<^bsup>M\<^esup>B" + using bij_rel_char mem_function_space_rel_abs bij_is_fun by simp + +lemmas bij_rel_is_fun = bij_rel_is_fun_rel[THEN mem_function_space_rel] + +lemma comp_bij_rel: + "g \ bij\<^bsup>M\<^esup>(A,B) \ f \ bij\<^bsup>M\<^esup>(B,C) \ M(A) \ M(B) \ M(C) \ (f O g) \ bij\<^bsup>M\<^esup>(A,C)" + using bij_rel_char comp_bij by force + +lemma inj_rel_converse_fun: "f \ inj\<^bsup>M\<^esup>(A,B) \ M(A) \ M(B) \ converse(f) \ range(f)\\<^bsup>M\<^esup>A" +proof - + assume "f \ inj\<^bsup>M\<^esup>(A,B)" "M(A)" "M(B)" + then + have "M(f)" "M(converse(f))" "M(range(f))" "f\inj(A,B)" + using inj_rel_char converse_closed range_closed + by auto + then + show ?thesis + using inj_converse_inj function_space_rel_char inj_is_fun \M(A)\ by auto +qed + +lemma fg_imp_bijective_rel: + assumes "f \ A \\<^bsup>M\<^esup>B" "g \ B\\<^bsup>M\<^esup>A" "f O g = id(B)" "g O f = id(A)" "M(A)" "M(B)" + shows "f \ bij\<^bsup>M\<^esup>(A,B)" + using assms mem_bij_abs fg_imp_bijective mem_function_space_rel_abs[THEN iffD2] function_space_rel_char + by auto + +end \ \\<^locale>\M_ZF_library\\ + +(************* Discipline for cexp ****************) +relativize functional "cexp" "cexp_rel" external +relationalize "cexp_rel" "is_cexp" + +context M_ZF_library +begin + +is_iff_rel for "cexp" + using is_cardinal_iff is_function_space_iff unfolding cexp_rel_def is_cexp_def + by (simp) + +rel_closed for "cexp" unfolding cexp_rel_def by simp + +end \ \\<^locale>\M_ZF_library\\ + +synthesize "is_cexp" from_definition assuming "nonempty" +notation is_cexp_fm (\\_\<^bsup>\_\<^esup> is _\\) +arity_theorem for "is_cexp_fm" + +abbreviation + cexp_r :: "[i,i,i\o] \ i" (\_\<^bsup>\_,_\<^esup>\) where + "cexp_r(x,y,M) \ cexp_rel(M,x,y)" + +abbreviation + cexp_r_set :: "[i,i,i] \ i" (\_\<^bsup>\_,_\<^esup>\) where + "cexp_r_set(x,y,M) \ cexp_rel(##M,x,y)" + +context M_ZF_library +begin + +lemma Card_rel_cexp_rel: "M(\) \ M(\) \ Card\<^bsup>M\<^esup>(\\<^bsup>\\,M\<^esup>)" + unfolding cexp_rel_def by simp + +\ \Restoring congruence rule, but NOTE: beware\ +declare conj_cong[cong] + +lemma eq_csucc_rel_ord: + "Ord(i) \ M(i) \ (i\<^sup>+)\<^bsup>M\<^esup> = (|i|\<^bsup>M\<^esup>\<^sup>+)\<^bsup>M\<^esup>" + using Card_rel_lt_iff Least_cong unfolding csucc_rel_def by auto + +lemma lesspoll_succ_rel: + assumes "Ord(\)" "M(\)" + shows "\ \\<^bsup>M\<^esup> (\\<^sup>+)\<^bsup>M\<^esup>" + using csucc_rel_basic assms lt_Card_rel_imp_lesspoll_rel + Card_rel_csucc_rel lepoll_rel_iff_leqpoll_rel + by auto + +lemma lesspoll_rel_csucc_rel: + assumes "Ord(\)" + and types:"M(\)" "M(d)" + shows "d \\<^bsup>M\<^esup> (\\<^sup>+)\<^bsup>M\<^esup> \ d \\<^bsup>M\<^esup> \" +proof + assume "d \\<^bsup>M\<^esup> (\\<^sup>+)\<^bsup>M\<^esup>" + moreover + note Card_rel_csucc_rel assms Card_rel_is_Ord + moreover from calculation + have "Card\<^bsup>M\<^esup>((\\<^sup>+)\<^bsup>M\<^esup>)" "M((\\<^sup>+)\<^bsup>M\<^esup>)" "Ord((\\<^sup>+)\<^bsup>M\<^esup>)" + using Card_rel_is_Ord by simp_all + moreover from calculation + have "d \\<^bsup>M\<^esup> (|\|\<^bsup>M\<^esup>\<^sup>+)\<^bsup>M\<^esup>" "d \\<^bsup>M\<^esup> |d|\<^bsup>M\<^esup>" + using eq_csucc_rel_ord[OF _ \M(\)\] + lesspoll_rel_imp_eqpoll_rel eqpoll_rel_sym by simp_all + moreover from calculation + have "|d|\<^bsup>M\<^esup> < (|\|\<^bsup>M\<^esup>\<^sup>+)\<^bsup>M\<^esup>" + using lesspoll_cardinal_lt_rel by simp + moreover from calculation + have "|d|\<^bsup>M\<^esup> \\<^bsup>M\<^esup> |\|\<^bsup>M\<^esup>" + using Card_rel_lt_csucc_rel_iff le_imp_lepoll_rel by simp + moreover from calculation + have "|d|\<^bsup>M\<^esup> \\<^bsup>M\<^esup> \" + using Ord_cardinal_rel_eqpoll_rel lepoll_rel_eq_trans + by simp + ultimately + show "d \\<^bsup>M\<^esup> \" + using eq_lepoll_rel_trans by simp +next + from \Ord(\)\ + have "\ < (\\<^sup>+)\<^bsup>M\<^esup>" "Card\<^bsup>M\<^esup>((\\<^sup>+)\<^bsup>M\<^esup>)" "M((\\<^sup>+)\<^bsup>M\<^esup>)" + using Card_rel_csucc_rel lt_csucc_rel_iff types eq_csucc_rel_ord[OF _ \M(\)\] + by simp_all + then + have "\ \\<^bsup>M\<^esup> (\\<^sup>+)\<^bsup>M\<^esup>" + using lt_Card_rel_imp_lesspoll_rel[OF _ \\ <_\] types by simp + moreover + assume "d \\<^bsup>M\<^esup> \" + ultimately + have "d \\<^bsup>M\<^esup> (\\<^sup>+)\<^bsup>M\<^esup>" + using Card_rel_csucc_rel types lesspoll_succ_rel lepoll_rel_trans \Ord(\)\ + by simp + moreover + from \d \\<^bsup>M\<^esup> \\ \Ord(\)\ + have "(\\<^sup>+)\<^bsup>M\<^esup> \\<^bsup>M\<^esup> \" if "d \\<^bsup>M\<^esup> (\\<^sup>+)\<^bsup>M\<^esup>" + using eqpoll_rel_sym[OF that] types eq_lepoll_rel_trans[OF _ \d\\<^bsup>M\<^esup>\\] + by simp + moreover from calculation \\ \\<^bsup>M\<^esup> (\\<^sup>+)\<^bsup>M\<^esup>\ + have False if "d \\<^bsup>M\<^esup> (\\<^sup>+)\<^bsup>M\<^esup>" + using lesspoll_rel_irrefl[OF _ \M((\\<^sup>+)\<^bsup>M\<^esup>)\] lesspoll_rel_trans1 types that + by auto + ultimately + show "d \\<^bsup>M\<^esup> (\\<^sup>+)\<^bsup>M\<^esup>" + unfolding lesspoll_rel_def by auto +qed + +lemma Infinite_imp_nats_lepoll: + assumes "Infinite(X)" "n \ \" + shows "n \ X" + using \n \ \\ +proof (induct) + case 0 + then + show ?case using empty_lepollI by simp +next + case (succ x) + show ?case + proof - + from \Infinite(X)\ and \x \ \\ + have "\ (x \ X)" + using eqpoll_sym unfolding Finite_def by auto + with \x \ X\ + obtain f where "f \ inj(x,X)" "f \ surj(x,X)" + unfolding bij_def eqpoll_def by auto + moreover from this + obtain b where "b \ X" "\a\x. f`a \ b" + using inj_is_fun unfolding surj_def by auto + ultimately + have "f \ inj(x,X-{b})" + unfolding inj_def by (auto intro:Pi_type) + then + have "cons(\x, b\, f) \ inj(succ(x), cons(b, X - {b}))" + using inj_extend[of f x "X-{b}" x b] unfolding succ_def + by (auto dest:mem_irrefl) + moreover from \b\X\ + have "cons(b, X - {b}) = X" by auto + ultimately + show "succ(x) \ X" by auto + qed +qed + +lemma nepoll_imp_nepoll_rel : + assumes "\ x \ X" "M(x)" "M(X)" + shows "\ (x \\<^bsup>M\<^esup> X)" + using assms unfolding eqpoll_def eqpoll_rel_def by simp + +lemma Infinite_imp_nats_lepoll_rel: + assumes "Infinite(X)" "n \ \" + and types: "M(X)" + shows "n \\<^bsup>M\<^esup> X" + using \n \ \\ +proof (induct) + case 0 + then + show ?case using empty_lepoll_relI types by simp +next + case (succ x) + show ?case + proof - + from \Infinite(X)\ and \x \ \\ + have "\ (x \ X)" "M(x)" "M(succ(x))" + using eqpoll_sym unfolding Finite_def by auto + then + have "\ (x \\<^bsup>M\<^esup> X)" + using nepoll_imp_nepoll_rel types by simp + with \x \\<^bsup>M\<^esup> X\ + obtain f where "f \ inj\<^bsup>M\<^esup>(x,X)" "f \ surj\<^bsup>M\<^esup>(x,X)" "M(f)" + unfolding bij_rel_def eqpoll_rel_def by auto + with \M(X)\ \M(x)\ + have "f\surj(x,X)" "f\inj(x,X)" + using surj_rel_char by simp_all + moreover + from this + obtain b where "b \ X" "\a\x. f`a \ b" + using inj_is_fun unfolding surj_def by auto + moreover + from this calculation \M(x)\ + have "f \ inj(x,X-{b})" "M()" + unfolding inj_def using transM[OF _ \M(X)\] + by (auto intro:Pi_type) + moreover + from this + have "cons(\x, b\, f) \ inj(succ(x), cons(b, X - {b}))" (is "?g\_") + using inj_extend[of f x "X-{b}" x b] unfolding succ_def + by (auto dest:mem_irrefl) + moreover + note \M()\ \M(f)\ \b\X\ \M(X)\ \M(succ(x))\ + moreover from this + have "M(?g)" "cons(b, X - {b}) = X" by auto + moreover from calculation + have "?g\inj_rel(M,succ(x),X)" + using mem_inj_abs by simp + with \M(?g)\ + show "succ(x) \\<^bsup>M\<^esup> X" using lepoll_relI by simp + qed +qed + +lemma lepoll_rel_imp_lepoll: "A \\<^bsup>M\<^esup> B \ M(A) \ M(B) \ A \ B" + unfolding lepoll_rel_def by auto + +lemma zero_lesspoll_rel: assumes "0<\" "M(\)" shows "0 \\<^bsup>M\<^esup> \" + using assms eqpoll_rel_0_iff[THEN iffD1, of \] eqpoll_rel_sym + unfolding lesspoll_rel_def lepoll_rel_def + by (auto simp add:inj_def) + +lemma lepoll_rel_nat_imp_Infinite: "\ \\<^bsup>M\<^esup> X \ M(X) \ Infinite(X)" + using lepoll_nat_imp_Infinite lepoll_rel_imp_lepoll by simp + +lemma InfCard_rel_imp_Infinite: "InfCard\<^bsup>M\<^esup>(\) \ M(\) \ Infinite(\)" + using le_imp_lepoll_rel[THEN lepoll_rel_nat_imp_Infinite, of \] + unfolding InfCard_rel_def by simp + +lemma lt_surj_rel_empty_imp_Card_rel: + assumes "Ord(\)" "\\. \ < \ \ surj\<^bsup>M\<^esup>(\,\) = 0" + and types:"M(\)" + shows "Card\<^bsup>M\<^esup>(\)" +proof - + { + define min where "min\\ x. \f[M]. f \ bij\<^bsup>M\<^esup>(x,\)" + moreover + note \Ord(\)\ \M(\)\ + moreover + assume "|\|\<^bsup>M\<^esup> < \" + moreover from calculation + have "\f. f \ bij\<^bsup>M\<^esup>(min,\)" + using LeastI[of "\i. i \\<^bsup>M\<^esup> \" \, OF eqpoll_rel_refl] + unfolding Card_rel_def cardinal_rel_def eqpoll_rel_def + by (auto) + moreover from calculation + have "min < \" + using lt_trans1[of min "\ i. M(i) \ (\f[M]. f \ bij\<^bsup>M\<^esup>(i, \))" \] + Least_le[of "\i. i \\<^bsup>M\<^esup> \" "|\|\<^bsup>M\<^esup>", OF Ord_cardinal_rel_eqpoll_rel] + unfolding Card_rel_def cardinal_rel_def eqpoll_rel_def + by (simp) + moreover + note \min < \ \ surj\<^bsup>M\<^esup>(min,\) = 0\ + ultimately + have "False" + unfolding bij_rel_def by simp + } + with assms + show ?thesis + using Ord_cardinal_rel_le[of \] not_lt_imp_le[of "|\|\<^bsup>M\<^esup>" \] le_anti_sym + unfolding Card_rel_def by auto +qed + +end \ \\<^locale>\M_ZF_library\\ + +relativize functional "mono_map" "mono_map_rel" external +relationalize "mono_map_rel" "is_mono_map" +synthesize "is_mono_map" from_definition assuming "nonempty" + +notation mono_map_rel (\mono'_map\<^bsup>_\<^esup>'(_,_,_,_')\) + +abbreviation + mono_map_r_set :: "[i,i,i,i,i]\i" (\mono'_map\<^bsup>_\<^esup>'(_,_,_,_')\) where + "mono_map\<^bsup>M\<^esup>(a,r,b,s) \ mono_map_rel(##M,a,r,b,s)" + +context M_ZF_library +begin + +lemma mono_map_rel_char: + assumes "M(a)" "M(b)" + shows "mono_map\<^bsup>M\<^esup>(a,r,b,s) = {f\mono_map(a,r,b,s) . M(f)}" + using assms function_space_rel_char unfolding mono_map_rel_def mono_map_def + by auto + +text\Just a sample of porting results on \<^term>\mono_map\\ +lemma mono_map_rel_mono: + assumes + "f \ mono_map\<^bsup>M\<^esup>(A,r,B,s)" "B \ C" + and types:"M(A)" "M(B)" "M(C)" + shows + "f \ mono_map\<^bsup>M\<^esup>(A,r,C,s)" + using assms mono_map_mono mono_map_rel_char by auto + +lemma nats_le_InfCard_rel: + assumes "n \ \" "InfCard\<^bsup>M\<^esup>(\)" + shows "n \ \" + using assms Ord_is_Transset + le_trans[of n \ \, OF le_subset_iff[THEN iffD2]] + unfolding InfCard_rel_def Transset_def by simp + +lemma nat_into_InfCard_rel: + assumes "n \ \" "InfCard\<^bsup>M\<^esup>(\)" + shows "n \ \" + using assms le_imp_subset[of \ \] + unfolding InfCard_rel_def by auto + +lemma Finite_lesspoll_rel_nat: + assumes "Finite(x)" "M(x)" + shows "x \\<^bsup>M\<^esup> nat" +proof - + note assms + moreover from this + obtain n where "n \ \" "M(n)" "x \ n" + unfolding Finite_def by auto + moreover from calculation + obtain f where "f \ bij(x,n)" "f: x-||>n" + using Finite_Fin[THEN fun_FiniteFunI, OF _ subset_refl] bij_is_fun + unfolding eqpoll_def by auto + ultimately + have "x\\<^bsup>M\<^esup> n" unfolding eqpoll_rel_def by (auto dest:transM) + with assms and \M(n)\ + have "n \\<^bsup>M\<^esup> x" using eqpoll_rel_sym by simp + moreover + note \n\\\ \M(n)\ + ultimately + show ?thesis + using assms eq_lesspoll_rel_trans[OF \x\\<^bsup>M\<^esup> n\ n_lesspoll_rel_nat] + by simp +qed + +lemma Finite_cardinal_rel_in_nat [simp]: + assumes "Finite(A)" "M(A)" shows "|A|\<^bsup>M\<^esup> \ \" +proof - + note assms + moreover from this + obtain n where "n \ \" "M(n)" "A \ n" + unfolding Finite_def by auto + moreover from calculation + obtain f where "f \ bij(A,n)" "f: A-||>n" + using Finite_Fin[THEN fun_FiniteFunI, OF _ subset_refl] bij_is_fun + unfolding eqpoll_def by auto + ultimately + have "A \\<^bsup>M\<^esup> n" unfolding eqpoll_rel_def by (auto dest:transM) + with assms and \M(n)\ + have "n \\<^bsup>M\<^esup> A" using eqpoll_rel_sym by simp + moreover + note \n\\\ \M(n)\ + ultimately + show ?thesis + using assms Least_le[of "\i. M(i) \ i \\<^bsup>M\<^esup> A" n] + lt_trans1[of _ n \, THEN ltD] + unfolding cardinal_rel_def Finite_def + by (auto dest!:naturals_lt_nat) +qed + +lemma Finite_cardinal_rel_eq_cardinal: + assumes "Finite(A)" "M(A)" shows "|A|\<^bsup>M\<^esup> = |A|" +proof - + \ \Copy-paste from @{thm Finite_cardinal_rel_in_nat}\ + note assms + moreover from this + obtain n where "n \ \" "M(n)" "A \ n" + unfolding Finite_def by auto + moreover from this + have "|A| = n" + using cardinal_cong[of A n] + nat_into_Card[THEN Card_cardinal_eq, of n] by simp + moreover from calculation + obtain f where "f \ bij(A,n)" "f: A-||>n" + using Finite_Fin[THEN fun_FiniteFunI, OF _ subset_refl] bij_is_fun + unfolding eqpoll_def by auto + ultimately + have "A \\<^bsup>M\<^esup> n" unfolding eqpoll_rel_def by (auto dest:transM) + with assms and \M(n)\ \n\\\ + have "|A|\<^bsup>M\<^esup> = n" + using cardinal_rel_cong[of A n] + nat_into_Card_rel[THEN Card_rel_cardinal_rel_eq, of n] + by simp + with \|A| = n\ + show ?thesis by simp +qed + +lemma Finite_imp_cardinal_rel_cons: + assumes FA: "Finite(A)" and a: "a\A" and types:"M(A)" "M(a)" + shows "|cons(a,A)|\<^bsup>M\<^esup> = succ(|A|\<^bsup>M\<^esup>)" + using assms Finite_imp_cardinal_cons Finite_cardinal_rel_eq_cardinal by simp + +lemma Finite_imp_succ_cardinal_rel_Diff: + assumes "Finite(A)" "a \ A" "M(A)" + shows "succ(|A-{a}|\<^bsup>M\<^esup>) = |A|\<^bsup>M\<^esup>" +proof - + from assms + have inM: "M(A-{a})" "M(a)" "M(A)" by (auto dest:transM) + with \Finite(A)\ + have "succ(|A-{a}|\<^bsup>M\<^esup>) = succ(|A-{a}|)" + using Diff_subset[THEN subset_Finite, + THEN Finite_cardinal_rel_eq_cardinal, of A "{a}"] by simp + also from assms + have "\ = |A|" + using Finite_imp_succ_cardinal_Diff by simp + also from assms + have "\ = |A|\<^bsup>M\<^esup>" using Finite_cardinal_rel_eq_cardinal by simp + finally + show ?thesis . +qed + +lemma InfCard_rel_Aleph_rel: + notes Aleph_rel_zero[simp] + assumes "Ord(\)" + and types: "M(\)" + shows "InfCard\<^bsup>M\<^esup>(\\<^bsub>\\<^esub>\<^bsup>M\<^esup>)" +proof - + have "\ (\\<^bsub>\\<^esub>\<^bsup>M\<^esup> \ \)" + proof (cases "\=0") + case True + then show ?thesis using mem_irrefl by auto + next + case False + with assms + have "\ \ \\<^bsub>\\<^esub>\<^bsup>M\<^esup>" using Ord_0_lt[of \] ltD by (auto dest:Aleph_rel_increasing) + then show ?thesis using foundation by blast + qed + with assms + have "\ (|\\<^bsub>\\<^esub>\<^bsup>M\<^esup>|\<^bsup>M\<^esup> \ \)" + using Card_rel_cardinal_rel_eq by auto + with assms + have "Infinite(\\<^bsub>\\<^esub>\<^bsup>M\<^esup>)" using Ord_Aleph_rel by clarsimp + with assms + show ?thesis + using Inf_Card_rel_is_InfCard_rel by simp +qed + +lemmas Limit_Aleph_rel = InfCard_rel_Aleph_rel[THEN InfCard_rel_is_Limit] + +bundle Ord_dests = Limit_is_Ord[dest] Card_rel_is_Ord[dest] +bundle Aleph_rel_dests = Aleph_rel_cont[dest] +bundle Aleph_rel_intros = Aleph_rel_increasing[intro!] +bundle Aleph_rel_mem_dests = Aleph_rel_increasing[OF ltI, THEN ltD, dest] + +lemma f_imp_injective_rel: + assumes "f \ A \\<^bsup>M\<^esup> B" "\x\A. d(f ` x) = x" "M(A)" "M(B)" + shows "f \ inj\<^bsup>M\<^esup>(A, B)" + using assms + apply (simp (no_asm_simp) add: def_inj_rel) + apply (auto intro: subst_context [THEN box_equals]) + done + +lemma lam_injective_rel: + assumes "\x. x \ A \ c(x) \ B" + "\x. x \ A \ d(c(x)) = x" + "\x[M]. M(c(x))" "lam_replacement(M,c)" + "M(A)" "M(B)" + shows "(\x\A. c(x)) \ inj\<^bsup>M\<^esup>(A, B)" + using assms function_space_rel_char lam_replacement_iff_lam_closed + by (rule_tac d = d in f_imp_injective_rel) + (auto simp add: lam_type) + +lemma f_imp_surjective_rel: + assumes "f \ A \\<^bsup>M\<^esup> B" "\y. y \ B \ d(y) \ A" "\y. y \ B \ f ` d(y) = y" + "M(A)" "M(B)" + shows "f \ surj\<^bsup>M\<^esup>(A, B)" + using assms + by (simp add: def_surj_rel, blast) + +lemma lam_surjective_rel: + assumes "\x. x \ A \ c(x) \ B" + "\y. y \ B \ d(y) \ A" + "\y. y \ B \ c(d(y)) = y" + "\x[M]. M(c(x))" "lam_replacement(M,c)" + "M(A)" "M(B)" + shows "(\x\A. c(x)) \ surj\<^bsup>M\<^esup>(A, B)" + using assms function_space_rel_char lam_replacement_iff_lam_closed + by (rule_tac d = d in f_imp_surjective_rel) + (auto simp add: lam_type) + +lemma lam_bijective_rel: + assumes "\x. x \ A \ c(x) \ B" + "\y. y \ B \ d(y) \ A" + "\x. x \ A \ d(c(x)) = x" + "\y. y \ B \ c(d(y)) = y" + "\x[M]. M(c(x))" "lam_replacement(M,c)" + "M(A)" "M(B)" + shows "(\x\A. c(x)) \ bij\<^bsup>M\<^esup>(A, B)" + using assms + apply (unfold bij_rel_def) + apply (blast intro!: lam_injective_rel lam_surjective_rel) + done + +lemma function_space_rel_eqpoll_rel_cong: + assumes + "A \\<^bsup>M\<^esup> A'" "B \\<^bsup>M\<^esup> B'" "M(A)" "M(A')" "M(B)" "M(B')" + shows + "A \\<^bsup>M\<^esup> B \\<^bsup>M\<^esup> A' \\<^bsup>M\<^esup> B'" +proof - + from assms(1)[THEN eqpoll_rel_sym] assms(2) assms lam_type + obtain f g where "f \ bij\<^bsup>M\<^esup>(A',A)" "g \ bij\<^bsup>M\<^esup>(B,B')" + by blast + with assms + have "converse(g) : bij\<^bsup>M\<^esup>(B', B)" "converse(f): bij\<^bsup>M\<^esup>(A, A')" + using bij_converse_bij by auto + let ?H="\ h \ A \\<^bsup>M\<^esup> B . g O h O f" + let ?I="\ h \ A' \\<^bsup>M\<^esup> B' . converse(g) O h O converse(f)" + have go:"g O F O f : A' \\<^bsup>M\<^esup> B'" if "F: A \\<^bsup>M\<^esup> B" for F + proof - + note assms \f\_\ \g\_\ that + moreover from this + have "g O F O f : A' \ B'" + using bij_rel_is_fun[OF \g\_\] bij_rel_is_fun[OF \f\_\] comp_fun + mem_function_space_rel[OF \F\_\] + by blast + ultimately + show "g O F O f : A' \\<^bsup>M\<^esup> B'" + using comp_closed function_space_rel_char bij_rel_char + by auto + qed + have og:"converse(g) O F O converse(f) : A \\<^bsup>M\<^esup> B" if "F: A' \\<^bsup>M\<^esup> B'" for F + proof - + note assms that \converse(f) \ _\ \converse(g) \ _\ + moreover from this + have "converse(g) O F O converse(f) : A \ B" + using bij_rel_is_fun[OF \converse(g)\_\] bij_rel_is_fun[OF \converse(f)\_\] comp_fun + mem_function_space_rel[OF \F\_\] + by blast + ultimately + show "converse(g) O F O converse(f) : A \\<^bsup>M\<^esup> B" (is "?G\_") + using comp_closed function_space_rel_char bij_rel_char + by auto + qed + with go + have tc:"?H \ (A \\<^bsup>M\<^esup> B) \ (A'\\<^bsup>M\<^esup> B')" "?I \ (A' \\<^bsup>M\<^esup> B') \ (A\\<^bsup>M\<^esup> B)" + using lam_type by auto + with assms \f\_\ \g\_\ + have "M(g O x O f)" and "M(converse(g) O x O converse(f))" if "M(x)" for x + using bij_rel_char comp_closed that by auto + with assms \f\_\ \g\_\ + have "M(?H)" "M(?I)" + using lam_replacement_iff_lam_closed[THEN iffD1,OF _ lam_replacement_comp'] + bij_rel_char by auto + show ?thesis + unfolding eqpoll_rel_def + proof (intro rexI[of _ ?H] fg_imp_bijective_rel) + from og go + have "(\x. x \ A' \\<^bsup>M\<^esup> B' \ converse(g) O x O converse(f) \ A \\<^bsup>M\<^esup> B)" + by simp + next + show "M(A \\<^bsup>M\<^esup> B)" using assms by simp + next + show "M(A' \\<^bsup>M\<^esup> B')" using assms by simp + next + from og assms + have "?H O ?I = (\x\A' \\<^bsup>M\<^esup> B' . (g O converse(g)) O x O (converse(f) O f))" + using lam_cong[OF refl[of "A' \\<^bsup>M\<^esup> B'"]] comp_assoc comp_lam + by auto + also + have "... = (\x\A' \\<^bsup>M\<^esup> B' . id(B') O x O (id(A')))" + using left_comp_inverse[OF mem_inj_rel[OF bij_rel_is_inj_rel]] \f\_\ + right_comp_inverse[OF bij_is_surj[OF mem_bij_rel]] \g\_\ assms + by auto + also + have "... = (\x\A' \\<^bsup>M\<^esup> B' . x)" + using left_comp_id[OF fun_is_rel[OF mem_function_space_rel]] + right_comp_id[OF fun_is_rel[OF mem_function_space_rel]] assms + by auto + also + have "... = id(A'\\<^bsup>M\<^esup>B')" unfolding id_def by simp + finally + show "?H O ?I = id(A' \\<^bsup>M\<^esup> B')" . + next + from go assms + have "?I O ?H = (\x\A \\<^bsup>M\<^esup> B . (converse(g) O g) O x O (f O converse(f)))" + using lam_cong[OF refl[of "A \\<^bsup>M\<^esup> B"]] comp_assoc comp_lam by auto + also + have "... = (\x\A \\<^bsup>M\<^esup> B . id(B) O x O (id(A)))" + using + left_comp_inverse[OF mem_inj_rel[OF bij_rel_is_inj_rel[OF \g\_\]]] + right_comp_inverse[OF bij_is_surj[OF mem_bij_rel[OF \f\_\]]] assms + by auto + also + have "... = (\x\A \\<^bsup>M\<^esup> B . x)" + using left_comp_id[OF fun_is_rel[OF mem_function_space_rel]] + right_comp_id[OF fun_is_rel[OF mem_function_space_rel]] + assms + by auto + also + have "... = id(A\\<^bsup>M\<^esup>B)" unfolding id_def by simp + finally + show "?I O ?H = id(A \\<^bsup>M\<^esup> B)" . + next + from assms tc \M(?H)\ \M(?I)\ + show "?H \ (A\\<^bsup>M\<^esup> B) \\<^bsup>M\<^esup> (A'\\<^bsup>M\<^esup> B')" "M(?H)" + "?I \ (A'\\<^bsup>M\<^esup> B') \\<^bsup>M\<^esup> (A\\<^bsup>M\<^esup> B)" + using mem_function_space_rel_abs by auto + qed +qed + +lemma curry_eqpoll_rel: + fixes \1 \2 \ + assumes "M(\1)" "M(\2)" "M(\)" + shows "\1 \\<^bsup>M\<^esup> (\2 \\<^bsup>M\<^esup> \) \\<^bsup>M\<^esup> \1 \ \2 \\<^bsup>M\<^esup> \" + unfolding eqpoll_rel_def +proof (intro rexI, rule lam_bijective_rel, + rule_tac [1-2] mem_function_space_rel_abs[THEN iffD2], + rule_tac [4] lam_type, rule_tac [8] lam_type, + rule_tac [8] mem_function_space_rel_abs[THEN iffD2], + rule_tac [11] lam_type, simp_all add:assms) + let ?cur="\x. \w\\1 \ \2. x ` fst(w) ` snd(w)" + fix f z + assume "f : \1 \\<^bsup>M\<^esup> (\2 \\<^bsup>M\<^esup> \)" + moreover + note assms + moreover from calculation + have "M(\2 \\<^bsup>M\<^esup> \)" + using function_space_rel_closed by simp + moreover from calculation + have "M(f)" "f : \1 \ (\2 \\<^bsup>M\<^esup> \)" + using function_space_rel_char by (auto dest:transM) + moreover from calculation + have "x \ \1 \ f`x : \2 \ \" for x + by (auto dest:transM intro!:mem_function_space_rel_abs[THEN iffD1]) + moreover from this + show "(\a\\1. \b\\2. ?cur(f) ` \a, b\) = f" + using Pi_type[OF \f \ \1 \ \2 \\<^bsup>M\<^esup> \\, of "\_.\2 \ \"] by simp + moreover + assume "z \ \1 \ \2" + moreover from calculation + have "f`fst(z): \2 \\<^bsup>M\<^esup> \" by simp + ultimately + show "f`fst(z)`snd(z) \ \" + using mem_function_space_rel_abs by (auto dest:transM) +next \ \one composition is the identity:\ + let ?cur="\x. \w\\1 \ \2. x ` fst(w) ` snd(w)" + fix f + assume "f : \1 \ \2 \\<^bsup>M\<^esup> \" + with assms + show "?cur(\x\\1. \xa\\2. f ` \x, xa\) = f" + using function_space_rel_char mem_function_space_rel_abs + by (auto dest:transM intro:fun_extension) + fix x y + assume "x\\1" "y\\2" + with assms \f : \1 \ \2 \\<^bsup>M\<^esup> \\ + show "f`\x,y\ \ \" + using function_space_rel_char mem_function_space_rel_abs + by (auto dest:transM[of _ "\1 \ \2 \\<^bsup>M\<^esup> \"]) +next + let ?cur="\x. \w\\1 \ \2. x ` fst(w) ` snd(w)" + note assms + moreover from this + show "\x[M]. M(?cur(x))" + using lam_replacement_fst lam_replacement_snd + lam_replacement_apply2[THEN [5] lam_replacement_hcomp2, + THEN [1] lam_replacement_hcomp2, where h="(`)", OF + lam_replacement_constant] lam_replacement_apply2 + by (auto intro: lam_replacement_iff_lam_closed[THEN iffD1, rule_format]) + moreover from calculation + show "x \ \1 \\<^bsup>M\<^esup> (\2 \\<^bsup>M\<^esup> \) \ M(?cur(x))" for x + by (auto dest:transM) + moreover from assms + show "lam_replacement(M, ?cur)" + using lam_replacement_Lambda_apply_fst_snd by simp + ultimately + show "M(\x\\1 \\<^bsup>M\<^esup> (\2 \\<^bsup>M\<^esup> \). ?cur(x))" + using lam_replacement_iff_lam_closed + by (auto dest:transM) + from assms + show "y \ \1 \ \2 \\<^bsup>M\<^esup> \ \ x \ \1 \ M(\xa\\2. y ` \x, xa\)" for x y + using lam_replacement_apply_const_id + by (rule_tac lam_replacement_iff_lam_closed[THEN iffD1, rule_format]) + (auto dest:transM) + from assms + show "y \ \1 \ \2 \\<^bsup>M\<^esup> \ \ M(\x\\1. \xa\\2. y ` \x, xa\)" for y + using lam_replacement_apply2[THEN [5] lam_replacement_hcomp2, + OF lam_replacement_constant lam_replacement_const_id] + lam_replacement_Lambda_apply_Pair[of \2] + by (auto dest:transM + intro!: lam_replacement_iff_lam_closed[THEN iffD1, rule_format]) +qed + +lemma Pow_rel_eqpoll_rel_function_space_rel: + fixes d X + notes bool_of_o_def [simp] + defines [simp]:"d(A) \ (\x\X. bool_of_o(x\A))" + \ \the witnessing map for the thesis:\ + assumes "M(X)" + shows "Pow\<^bsup>M\<^esup>(X) \\<^bsup>M\<^esup> X \\<^bsup>M\<^esup> 2" +proof - + from assms + interpret M_Pi_assumptions M X "\_. 2" + using Pi_replacement Pi_separation lam_replacement_identity + lam_replacement_Sigfun[THEN lam_replacement_imp_strong_replacement] + Pi_replacement1[of _ 2] transM[of _ X] lam_replacement_constant + by unfold_locales auto + have "lam_replacement(M, \x. bool_of_o(x\A))" if "M(A)" for A + using that lam_replacement_if lam_replacement_constant + separation_in_constant by simp + with assms + have "lam_replacement(M, \x. d(x))" + using separation_in_constant[THEN [3] lam_replacement_if, of "\_.1" "\_.0"] + lam_replacement_identity lam_replacement_constant lam_replacement_Lambda_if_mem + by simp + show ?thesis + unfolding eqpoll_rel_def + proof (intro rexI, rule lam_bijective_rel) + \ \We give explicit mutual inverses\ + fix A + assume "A\Pow\<^bsup>M\<^esup>(X)" + moreover + note \M(X)\ + moreover from calculation + have "M(A)" by (auto dest:transM) + moreover + note \_ \ lam_replacement(M, \x. bool_of_o(x\A))\ + ultimately + show "d(A) : X \\<^bsup>M\<^esup> 2" + using function_space_rel_char lam_replacement_iff_lam_closed[THEN iffD1] + by (simp, rule_tac lam_type[of X "\x. bool_of_o(x\A)" "\_. 2", simplified]) + auto + from \A\Pow\<^bsup>M\<^esup>(X)\ \M(X)\ + show "{y\X. d(A)`y = 1} = A" + using Pow_rel_char by auto + next + fix f + assume "f: X\\<^bsup>M\<^esup> 2" + with assms + have "f: X\ 2" "M(f)" using function_space_rel_char by simp_all + then + show "d({y \ X . f ` y = 1}) = f" + using apply_type[OF \f: X\2\] by (force intro:fun_extension) + from \M(X)\ \M(f)\ + show "{ya \ X . f ` ya = 1} \ Pow\<^bsup>M\<^esup>(X)" + using Pow_rel_char separation_equal_apply by auto + next + from assms \lam_replacement(M, \x. d(x))\ + \\A. _ \ lam_replacement(M, \x. bool_of_o(x\A))\ + show "M(\x\Pow\<^bsup>M\<^esup>(X). d(x))" "lam_replacement(M, \x. d(x))" + "\x[M]. M(d(x))" + using lam_replacement_iff_lam_closed[THEN iffD1] by auto + qed (auto simp:\M(X)\) +qed + +lemma Pow_rel_bottom: "M(B) \ 0 \ Pow\<^bsup>M\<^esup>(B)" + using Pow_rel_char by simp + +lemma cantor_surj_rel: + assumes "M(f)" "M(A)" + shows "f \ surj\<^bsup>M\<^esup>(A,Pow\<^bsup>M\<^esup>(A))" +proof + assume "f \ surj\<^bsup>M\<^esup>(A,Pow\<^bsup>M\<^esup>(A))" + with assms + have "f \ surj(A,Pow\<^bsup>M\<^esup>(A))" using surj_rel_char by simp + moreover + note assms + moreover from this + have "M({x \ A . x \ f ` x})" "{x \ A . x \ f ` x} = A - {x \ A . x \ f ` x}" + using lam_replacement_apply[THEN [4] separation_in, of "\x. x"] + lam_replacement_identity lam_replacement_constant by auto + with \M(A)\ + have "{x\A . x \ f`x} \ Pow\<^bsup>M\<^esup>(A)" + by (intro mem_Pow_rel_abs[THEN iffD2]) auto + ultimately + obtain d where "d\A" "f`d = {x\A . x \ f`x}" + unfolding surj_def by blast + show False + proof (cases "d \ f`d") + case True + note \d \ f`d\ + also + note \f`d = {x\A . x \ f`x}\ + finally + have "d \ f`d" using \d\A\ by simp + then + show False using \d \ f ` d\ by simp + next + case False + with \d\A\ + have "d \ {x\A . x \ f`x}" by simp + also from \f`d = \\ + have "\ = f`d" by simp + finally + show False using \d \ f`d\ by simp + qed +qed + +lemma cantor_inj_rel: "M(f) \ M(A) \ f \ inj\<^bsup>M\<^esup>(Pow\<^bsup>M\<^esup>(A),A)" + using inj_rel_imp_surj_rel[OF _ Pow_rel_bottom, of f A A] + cantor_surj_rel[of "\x\A. if x \ range(f) then converse(f) ` x else 0" A] + lam_replacement_if separation_in_constant[of "range(f)"] + lam_replacement_converse_app[THEN [5] lam_replacement_hcomp2] + lam_replacement_identity lam_replacement_constant + lam_replacement_iff_lam_closed by auto + +end \ \\<^locale>\M_ZF_library\\ + +end \ No newline at end of file diff --git a/thys/Transitive_Models/ZF_Miscellanea.thy b/thys/Transitive_Models/ZF_Miscellanea.thy new file mode 100644 --- /dev/null +++ b/thys/Transitive_Models/ZF_Miscellanea.thy @@ -0,0 +1,181 @@ +section\Various results missing from ZF.\ + +theory ZF_Miscellanea + imports + ZF + Nat_Miscellanea +begin + +lemma function_subset: + "function(f) \ g\f \ function(g)" + unfolding function_def subset_def by auto + +lemma converse_refl : "refl(A,r) \ refl(A,converse(r))" + unfolding refl_def by simp + +lemma Ord_lt_subset : "Ord(b) \ a a\b" + by(intro subsetI,frule ltD,rule_tac Ord_trans,simp_all) + +lemma funcI : "f \ A \ B \ a \ A \ b= f ` a \ \a, b\ \ f" + by(simp_all add: apply_Pair) + +lemma vimage_fun_sing: + assumes "f\A\B" "b\B" + shows "{a\A . f`a=b} = f-``{b}" + using assms vimage_singleton_iff function_apply_equality Pi_iff funcI by auto + +lemma image_fun_subset: "S\A\B \ C\A\ {S ` x . x\ C} = S``C" + using image_function[symmetric,of S C] domain_of_fun Pi_iff by auto + +lemma subset_Diff_Un: "X \ A \ A = (A - X) \ X " by auto + +lemma Diff_bij: + assumes "\A\F. X \ A" shows "(\A\F. A-X) \ bij(F, {A-X. A\F})" + using assms unfolding bij_def inj_def surj_def + by (auto intro:lam_type, subst subset_Diff_Un[of X]) auto + +lemma function_space_nonempty: + assumes "b\B" + shows "(\x\A. b) : A \ B" + using assms lam_type by force + +lemma vimage_lam: "(\x\A. f(x)) -`` B = { x\A . f(x) \ B }" + using lam_funtype[of A f, THEN [2] domain_type] + lam_funtype[of A f, THEN [2] apply_equality] lamI[of _ A f] + by auto blast + +lemma range_fun_subset_codomain: + assumes "h:B \ C" + shows "range(h) \ C" + unfolding range_def domain_def converse_def using range_type[OF _ assms] by auto + +lemma Pi_rangeD: + assumes "f\Pi(A,B)" "b \ range(f)" + shows "\a\A. f`a = b" + using assms apply_equality[OF _ assms(1), of _ b] + domain_type[OF _ assms(1)] by auto + +lemma Pi_range_eq: "f \ Pi(A,B) \ range(f) = {f ` x . x \ A}" + using Pi_rangeD[of f A B] apply_rangeI[of f A B] + by blast + +lemma Pi_vimage_subset : "f \ Pi(A,B) \ f-``C \ A" + unfolding Pi_def by auto + +definition + minimum :: "i \ i \ i" where + "minimum(r,B) \ THE b. first(b,B,r)" + +lemma minimum_in: "\ well_ord(A,r); B\A; B\0 \ \ minimum(r,B) \ B" + using the_first_in unfolding minimum_def by simp + +lemma well_ord_surj_imp_inj_inverse: + assumes "well_ord(A,r)" "h \ surj(A,B)" + shows "(\b\B. minimum(r, {a\A. h`a=b})) \ inj(B,A)" +proof - + let ?f="\b\B. minimum(r, {a\A. h`a=b})" + have "minimum(r, {a \ A . h ` a = b}) \ {a\A. h`a=b}" if "b\B" for b + proof - + from \h \ surj(A,B)\ that + have "{a\A. h`a=b} \ 0" + unfolding surj_def by blast + with \well_ord(A,r)\ + show "minimum(r,{a\A. h`a=b}) \ {a\A. h`a=b}" + using minimum_in by blast + qed + moreover from this + have "?f : B \ A" + using lam_type[of B _ "\_.A"] by simp + moreover + have "?f ` w = ?f ` x \ w = x" if "w\B" "x\B" for w x + proof - + from calculation that + have "w = h ` minimum(r,{a\A. h`a=w})" + "x = h ` minimum(r,{a\A. h`a=x})" + by simp_all + moreover + assume "?f ` w = ?f ` x" + moreover from this and that + have "minimum(r, {a \ A . h ` a = w}) = minimum(r, {a \ A . h ` a = x})" + unfolding minimum_def by simp_all + moreover from calculation(1,2,4) + show "w=x" by simp + qed + ultimately + show ?thesis + unfolding inj_def by blast +qed + +lemma well_ord_surj_imp_lepoll: + assumes "well_ord(A,r)" "h \ surj(A,B)" + shows "B\A" + unfolding lepoll_def using well_ord_surj_imp_inj_inverse[OF assms] + by blast + +\ \New result\ +lemma surj_imp_well_ord: + assumes "well_ord(A,r)" "h \ surj(A,B)" + shows "\s. well_ord(B,s)" + using assms lepoll_well_ord[OF well_ord_surj_imp_lepoll] + by force + +lemma Pow_sing : "Pow({a}) = {0,{a}}" +proof(intro equalityI,simp_all) + have "z \ {0,{a}}" if "z \ {a}" for z + using that by auto + then + show " Pow({a}) \ {0, {a}}" by auto +qed + +lemma Pow_cons: + shows "Pow(cons(a,A)) = Pow(A) \ {{a} \ X . X: Pow(A)}" + using Un_Pow_subset Pow_sing +proof(intro equalityI,auto simp add:Un_Pow_subset) + { + fix C D + assume "\ B . B\Pow(A) \ C \ {a} \ B" "C \ {a} \ A" "D \ C" + moreover from this + have "\x\C . x=a \ x\A" by auto + moreover from calculation + consider (a) "D=a" | (b) "D\A" by auto + from this + have "D\A" + proof(cases) + case a + with calculation show ?thesis by auto + next + case b + then show ?thesis by simp + qed + } + then show "\x xa. (\xa\Pow(A). x \ {a} \ xa) \ x \ cons(a, A) \ xa \ x \ xa \ A" + by auto +qed + +lemma app_nm : + assumes "n\nat" "m\nat" "f\n\m" "x \ nat" + shows "f`x \ nat" +proof(cases "x\n") + case True + then show ?thesis using assms in_n_in_nat apply_type by simp +next + case False + then show ?thesis using assms apply_0 domain_of_fun by simp +qed + +lemma Upair_eq_cons: "Upair(a,b) = {a,b}" + unfolding cons_def by auto + +lemma converse_apply_eq : "converse(f) ` x = \(f -`` {x})" + unfolding apply_def vimage_def by simp + +lemmas app_fun = apply_iff[THEN iffD1] + +lemma Finite_imp_lesspoll_nat: + assumes "Finite(A)" + shows "A \ nat" + using assms subset_imp_lepoll[OF naturals_subset_nat] eq_lepoll_trans + n_lesspoll_nat eq_lesspoll_trans + unfolding Finite_def lesspoll_def by auto + +end \ No newline at end of file diff --git a/thys/Transitive_Models/document/root.bib b/thys/Transitive_Models/document/root.bib new file mode 100644 --- /dev/null +++ b/thys/Transitive_Models/document/root.bib @@ -0,0 +1,92 @@ +@article{DBLP:journals/jar/PaulsonG96, + author = {Lawrence C. Paulson and + Krzysztof Grabczewski}, + title = {Mechanizing Set Theory}, + journal = {J. Autom. Reasoning}, + volume = {17}, + number = {3}, + pages = {291--323}, + year = {1996}, + xurl = {https://doi.org/10.1007/BF00283132}, + doi = {10.1007/BF00283132}, + timestamp = {Sat, 20 May 2017 00:22:31 +0200}, + biburl = {https://dblp.org/rec/bib/journals/jar/PaulsonG96}, + bibsource = {dblp computer science bibliography, https://dblp.org} +} + +@article {MR2051585, + AUTHOR = {Paulson, Lawrence C.}, + TITLE = {The relative consistency of the axiom of choice mechanized + using {I}sabelle/{ZF}}, + NOTE = {Appendix A available electronically at + \url{http://www.lms.ac.uk/jcm/6/lms2003-001/appendix-a/}}, + JOURNAL = {LMS J. Comput. Math.}, + FJOURNAL = {LMS Journal of Computation and Mathematics}, + VOLUME = {6}, + YEAR = {2003}, + PAGES = {198--248}, + ISSN = {1461-1570}, + MRCLASS = {03B35 (03E25 03E35 68T15)}, + MRNUMBER = {2051585}, + DOI = {10.1007/978-3-540-69407-6_52}, + URL = {http://dx.doi.org/10.1007/978-3-540-69407-6_52}, +} +@inproceedings{2018arXiv180705174G, + author = {Gunther, Emmanuel and Pagano, Miguel and S{\'a}nchez Terraf, Pedro}, + title = {First Steps Towards a Formalization of Forcing}, + booktitle = {Proceedings of the 13th Workshop on Logical and Semantic Frameworks + with Applications, {LSFA} 2018, Fortaleza, Brazil, September 26-28, + 2018}, + pages = {119--136}, + year = {2018}, + url = {https://doi.org/10.1016/j.entcs.2019.07.008}, + doi = {10.1016/j.entcs.2019.07.008}, + timestamp = {Wed, 05 Feb 2020 13:47:23 +0100}, + biburl = {https://dblp.org/rec/journals/entcs/GuntherPT19.bib}, + bibsource = {dblp computer science bibliography, https://dblp.org} +} + + +@ARTICLE{2019arXiv190103313G, + author = {Gunther, Emmanuel and Pagano, Miguel and S{\'a}nchez Terraf, Pedro}, + title = "{Mechanization of Separation in Generic Extensions}", + journal = {arXiv e-prints}, + keywords = {Computer Science - Logic in Computer Science, Mathematics - Logic, 03B35 (Primary) 03E40, 03B70, 68T15 (Secondary), F.4.1}, + year = 2019, + month = Jan, + eid = {arXiv:1901.03313}, + volume = {1901.03313}, +archivePrefix = {arXiv}, + eprint = {1901.03313}, + primaryClass = {cs.LO}, + adsurl = {https://ui.adsabs.harvard.edu/\#abs/2019arXiv190103313G}, + adsnote = {Provided by the SAO/NASA Astrophysics Data System}, + abstract = {We mechanize, in the proof assistant Isabelle, a proof of the axiom-scheme of Separation in generic extensions of models of set theory by using the fundamental theorems of forcing. We also formalize the satisfaction of the axioms of Extensionality, Foundation, Union, and Powerset. The axiom of Infinity is likewise treated, under additional assumptions on the ground model. In order to achieve these goals, we extended Paulson's library on constructibility with renaming of variables for internalized formulas, improved results on definitions by recursion on well-founded relations, and sharpened hypotheses in his development of relativization and absoluteness.} +} + +@inproceedings{2020arXiv200109715G, + author = {Gunther, Emmanuel and Pagano, Miguel and S{\'a}nchez Terraf, Pedro}, + title = "{Formalization of Forcing in Isabelle/ZF}", + isbn = {978-3-662-45488-6}, + booktitle = {Automated Reasoning. 10th International Joint Conference, IJCAR 2020, Paris, France, July 1--4, 2020, Proceedings, Part II}, + volume = 12167, + series = {Lecture Notes in Artificial Intelligence}, + editor = {Peltier, Nicolas and Sofronie-Stokkermans, Viorica}, + publisher = {Springer International Publishing}, + doi = {10.1007/978-3-030-51054-1}, + pages = {221--235}, + journal = {arXiv e-prints}, + keywords = {Computer Science - Logic in Computer Science, Mathematics - Logic, 03B35 (Primary) 03E40, 03B70, 68T15 (Secondary), F.4.1}, + year = 2020, + eid = {arXiv:2001.09715}, +archivePrefix = {arXiv}, + eprint = {2001.09715}, + primaryClass = {cs.LO}, + adsurl = {https://ui.adsabs.harvard.edu/abs/2020arXiv200109715G}, + abstract = {We formalize the theory of forcing in the set theory framework of +Isabelle/ZF. Under the assumption of the existence of a countable +transitive model of $\mathit{ZFC}$, we construct a proper generic extension and show +that the latter also satisfies $\mathit{ZFC}$. In doing so, we remodularized +Paulson's ZF-Constructibility library.}, + adsnote = {Provided by the SAO/NASA Astrophysics Data System} +} diff --git a/thys/Transitive_Models/document/root.bst b/thys/Transitive_Models/document/root.bst new file mode 100644 --- /dev/null +++ b/thys/Transitive_Models/document/root.bst @@ -0,0 +1,1440 @@ +%% +%% by pedro +%% Based on file `model1b-num-names.bst' +%% +%% +%% +ENTRY + { address + author + booktitle + chapter + edition + editor + howpublished + institution + journal + key + month + note + number + organization + pages + publisher + school + series + title + type + volume + year + } + {} + { label extra.label sort.label short.list } +INTEGERS { output.state before.all mid.sentence after.sentence after.block } +FUNCTION {init.state.consts} +{ #0 'before.all := + #1 'mid.sentence := + #2 'after.sentence := + #3 'after.block := +} +STRINGS { s t} +FUNCTION {output.nonnull} +{ 's := + output.state mid.sentence = + { ", " * write$ } + { output.state after.block = + { add.period$ write$ + newline$ + "\newblock " write$ + } + { output.state before.all = + 'write$ + { add.period$ " " * write$ } + if$ + } + if$ + mid.sentence 'output.state := + } + if$ + s +} +FUNCTION {output} +{ duplicate$ empty$ + 'pop$ + 'output.nonnull + if$ +} +FUNCTION {output.check} +{ 't := + duplicate$ empty$ + { pop$ "empty " t * " in " * cite$ * warning$ } + 'output.nonnull + if$ +} +FUNCTION {fin.entry} +{ add.period$ + write$ + newline$ +} + +FUNCTION {new.block} +{ output.state before.all = + 'skip$ + { after.block 'output.state := } + if$ +} +FUNCTION {new.sentence} +{ output.state after.block = + 'skip$ + { output.state before.all = + 'skip$ + { after.sentence 'output.state := } + if$ + } + if$ +} +FUNCTION {add.blank} +{ " " * before.all 'output.state := +} + +FUNCTION {date.block} +{ + skip$ +} + +FUNCTION {not} +{ { #0 } + { #1 } + if$ +} +FUNCTION {and} +{ 'skip$ + { pop$ #0 } + if$ +} +FUNCTION {or} +{ { pop$ #1 } + 'skip$ + if$ +} +FUNCTION {new.block.checkb} +{ empty$ + swap$ empty$ + and + 'skip$ + 'new.block + if$ +} +FUNCTION {field.or.null} +{ duplicate$ empty$ + { pop$ "" } + 'skip$ + if$ +} +FUNCTION {emphasize} +{ duplicate$ empty$ + { pop$ "" } + { "\textit{" swap$ * "}" * } + if$ +} +%% by pedro +FUNCTION {slanted} +{ duplicate$ empty$ + { pop$ "" } + { "\textsl{" swap$ * "}" * } + if$ +} +FUNCTION {smallcaps} +{ duplicate$ empty$ + { pop$ "" } + { "\textsc{" swap$ * "}" * } + if$ +} +FUNCTION {bold} +{ duplicate$ empty$ + { pop$ "" } + { "\textbf{" swap$ * "}" * } + if$ +} + + +FUNCTION {tie.or.space.prefix} +{ duplicate$ text.length$ #3 < + { "~" } + { " " } + if$ + swap$ +} + +FUNCTION {capitalize} +{ "u" change.case$ "t" change.case$ } + +FUNCTION {space.word} +{ " " swap$ * " " * } + % Here are the language-specific definitions for explicit words. + % Each function has a name bbl.xxx where xxx is the English word. + % The language selected here is ENGLISH +FUNCTION {bbl.and} +{ "and"} + +FUNCTION {bbl.etal} +{ "et~al." } + +FUNCTION {bbl.editors} +{ "eds." } + +FUNCTION {bbl.editor} +{ "ed." } + +FUNCTION {bbl.edby} +{ "edited by" } + +FUNCTION {bbl.edition} +{ "edition" } + +FUNCTION {bbl.volume} +{ "volume" } + +FUNCTION {bbl.of} +{ "of" } + +FUNCTION {bbl.number} +{ "number" } + +FUNCTION {bbl.nr} +{ "no." } + +FUNCTION {bbl.in} +{ "in" } + +FUNCTION {bbl.pages} +{ "pp." } + +FUNCTION {bbl.page} +{ "p." } + +FUNCTION {bbl.chapter} +{ "chapter" } + +FUNCTION {bbl.techrep} +{ "Technical Report" } + +FUNCTION {bbl.mthesis} +{ "Master's thesis" } + +FUNCTION {bbl.phdthesis} +{ "Ph.D. thesis" } + +MACRO {jan} {"January"} + +MACRO {feb} {"February"} + +MACRO {mar} {"March"} + +MACRO {apr} {"April"} + +MACRO {may} {"May"} + +MACRO {jun} {"June"} + +MACRO {jul} {"July"} + +MACRO {aug} {"August"} + +MACRO {sep} {"September"} + +MACRO {oct} {"October"} + +MACRO {nov} {"November"} + +MACRO {dec} {"December"} + +MACRO {acmcs} {"ACM Comput. Surv."} + +MACRO {acta} {"Acta Inf."} + +MACRO {cacm} {"Commun. ACM"} + +MACRO {ibmjrd} {"IBM J. Res. Dev."} + +MACRO {ibmsj} {"IBM Syst.~J."} + +MACRO {ieeese} {"IEEE Trans. Software Eng."} + +MACRO {ieeetc} {"IEEE Trans. Comput."} + +MACRO {ieeetcad} + {"IEEE Trans. Comput. Aid. Des."} + +MACRO {ipl} {"Inf. Process. Lett."} + +MACRO {jacm} {"J.~ACM"} + +MACRO {jcss} {"J.~Comput. Syst. Sci."} + +MACRO {scp} {"Sci. Comput. Program."} + +MACRO {sicomp} {"SIAM J. Comput."} + +MACRO {tocs} {"ACM Trans. Comput. Syst."} + +MACRO {tods} {"ACM Trans. Database Syst."} + +MACRO {tog} {"ACM Trans. Graphic."} + +MACRO {toms} {"ACM Trans. Math. Software"} + +MACRO {toois} {"ACM Trans. Office Inf. Syst."} + +MACRO {toplas} {"ACM Trans. Progr. Lang. Syst."} + +MACRO {tcs} {"Theor. Comput. Sci."} + +FUNCTION {bibinfo.check} +{ swap$ + duplicate$ missing$ + { + pop$ pop$ + "" + } + { duplicate$ empty$ + { + swap$ pop$ + } + { swap$ + "\bibinfo{" swap$ * "}{" * swap$ * "}" * + } + if$ + } + if$ +} +FUNCTION {bibinfo.warn} +{ swap$ + duplicate$ missing$ + { + swap$ "missing " swap$ * " in " * cite$ * warning$ pop$ + "" + } + { duplicate$ empty$ + { + swap$ "empty " swap$ * " in " * cite$ * warning$ + } + { swap$ + pop$ + } + if$ + } + if$ +} +STRINGS { bibinfo} +INTEGERS { nameptr namesleft numnames } + +FUNCTION {format.names} +{ 'bibinfo := + duplicate$ empty$ 'skip$ { + 's := + "" 't := + #1 'nameptr := + s num.names$ 'numnames := + numnames 'namesleft := + { namesleft #0 > } + { s nameptr + "{f{.}.~}{vv~}{ll}{, jj}" + format.name$ + bibinfo bibinfo.check + 't := + nameptr #1 > + { + namesleft #1 > + { ", " * t * } + { + "," * + s nameptr "{ll}" format.name$ duplicate$ "others" = + { 't := } + { pop$ } + if$ + t "others" = + { + " " * bbl.etal * + } + { " " * t * } + if$ + } + if$ + } + 't + if$ + nameptr #1 + 'nameptr := + namesleft #1 - 'namesleft := + } + while$ + } if$ +} +FUNCTION {format.names.ed} +{ + format.names +} +FUNCTION {format.key} +{ empty$ + { key field.or.null } + { "" } + if$ +} + +FUNCTION {format.authors} +{ author "author" format.names smallcaps +} +FUNCTION {get.bbl.editor} +{ editor num.names$ #1 > 'bbl.editors 'bbl.editor if$ } + +FUNCTION {format.editors} +{ editor "editor" format.names duplicate$ empty$ 'skip$ + { + " " * + get.bbl.editor + capitalize + "(" swap$ * ")" * + * + } + if$ +} +FUNCTION {format.note} +{ + note empty$ + { "" } + { note #1 #1 substring$ + duplicate$ "{" = + 'skip$ + { output.state mid.sentence = + { "l" } + { "u" } + if$ + change.case$ + } + if$ + note #2 global.max$ substring$ * "note" bibinfo.check + } + if$ +} + +FUNCTION {format.title} +{ title + duplicate$ empty$ 'skip$ + { "t" change.case$ } + if$ + "title" bibinfo.check +} +FUNCTION {format.full.names} +{'s := + "" 't := + #1 'nameptr := + s num.names$ 'numnames := + numnames 'namesleft := + { namesleft #0 > } + { s nameptr + "{vv~}{ll}" format.name$ + 't := + nameptr #1 > + { + namesleft #1 > + { ", " * t * } + { + s nameptr "{ll}" format.name$ duplicate$ "others" = + { 't := } + { pop$ } + if$ + t "others" = + { + " " * bbl.etal * + } + { + bbl.and + space.word * t * + } + if$ + } + if$ + } + 't + if$ + nameptr #1 + 'nameptr := + namesleft #1 - 'namesleft := + } + while$ +} + +FUNCTION {author.editor.key.full} +{ author empty$ + { editor empty$ + { key empty$ + { cite$ #1 #3 substring$ } + 'key + if$ + } + { editor format.full.names } + if$ + } + { author format.full.names } + if$ +} + +FUNCTION {author.key.full} +{ author empty$ + { key empty$ + { cite$ #1 #3 substring$ } + 'key + if$ + } + { author format.full.names } + if$ +} + +FUNCTION {editor.key.full} +{ editor empty$ + { key empty$ + { cite$ #1 #3 substring$ } + 'key + if$ + } + { editor format.full.names } + if$ +} + +FUNCTION {make.full.names} +{ type$ "book" = + type$ "inbook" = + or + 'author.editor.key.full + { type$ "proceedings" = + 'editor.key.full + 'author.key.full + if$ + } + if$ +} + +FUNCTION {output.bibitem} +{ newline$ + "\bibitem[{" write$ + label write$ + ")" make.full.names duplicate$ short.list = + { pop$ } + { * } + if$ + "}]{" * write$ + cite$ write$ + "}" write$ + newline$ + "" + before.all 'output.state := +} + +FUNCTION {n.dashify} +{ + 't := + "" + { t empty$ not } + { t #1 #1 substring$ "-" = + { t #1 #2 substring$ "--" = not + { "--" * + t #2 global.max$ substring$ 't := + } + { { t #1 #1 substring$ "-" = } + { "-" * + t #2 global.max$ substring$ 't := + } + while$ + } + if$ + } + { t #1 #1 substring$ * + t #2 global.max$ substring$ 't := + } + if$ + } + while$ +} + +FUNCTION {word.in} +{ bbl.in + ":" * + " " * } + +FUNCTION {format.date} +{ year "year" bibinfo.check duplicate$ empty$ + { + "empty year in " cite$ * "; set to ????" * warning$ + pop$ "????" + } + 'skip$ + if$ + % extra.label * + %% by pedro + " (" swap$ * ")" * +} +FUNCTION{format.year} +{ year "year" bibinfo.check duplicate$ empty$ + { "empty year in " cite$ * + "; set to ????" * + warning$ + pop$ "????" + } + { + } + if$ + % extra.label * + " (" swap$ * ")" * +} +FUNCTION {format.btitle} +{ title "title" bibinfo.check + duplicate$ empty$ 'skip$ + { + } + if$ + %% by pedro + "``" swap$ * "''" * +} +FUNCTION {either.or.check} +{ empty$ + 'pop$ + { "can't use both " swap$ * " fields in " * cite$ * warning$ } + if$ +} +FUNCTION {format.bvolume} +{ volume empty$ + { "" } + %% by pedro + { series "series" bibinfo.check + duplicate$ empty$ 'pop$ + { %slanted + } + if$ + "volume and number" number either.or.check + volume tie.or.space.prefix + "volume" bibinfo.check + bold + * * + } + if$ +} +FUNCTION {format.number.series} +{ volume empty$ + { number empty$ + { series field.or.null } + { series empty$ + { number "number" bibinfo.check } + { output.state mid.sentence = + { bbl.number } + { bbl.number capitalize } + if$ + number tie.or.space.prefix "number" bibinfo.check * * + bbl.in space.word * + series "series" bibinfo.check * + } + if$ + } + if$ + } + { "" } + if$ +} + +FUNCTION {format.edition} +{ edition duplicate$ empty$ 'skip$ + { + output.state mid.sentence = + { "l" } + { "t" } + if$ change.case$ + "edition" bibinfo.check + " " * bbl.edition * + } + if$ +} + +INTEGERS { multiresult } +FUNCTION {multi.page.check} +{ 't := + #0 'multiresult := + { multiresult not + t empty$ not + and + } + { t #1 #1 substring$ + duplicate$ "-" = + swap$ duplicate$ "," = + swap$ "+" = + or or + { #1 'multiresult := } + { t #2 global.max$ substring$ 't := } + if$ + } + while$ + multiresult +} +FUNCTION {format.pages} +{ pages duplicate$ empty$ 'skip$ + { duplicate$ multi.page.check + { + bbl.pages swap$ + n.dashify + } + { + bbl.page swap$ + } + if$ + tie.or.space.prefix + "pages" bibinfo.check + * * + } + if$ +} + +FUNCTION {format.pages.simple} +{ pages duplicate$ empty$ 'skip$ + { duplicate$ multi.page.check + { +% bbl.pages swap$ + n.dashify + } + { +% bbl.page swap$ + } + if$ + tie.or.space.prefix + "pages" bibinfo.check + * + } + if$ +} +FUNCTION {format.journal.pages} +{ pages duplicate$ empty$ 'pop$ + { swap$ duplicate$ empty$ + { pop$ pop$ format.pages } + { + ": " * + swap$ + n.dashify + "pages" bibinfo.check + * + } + if$ + } + if$ +} +FUNCTION {format.vol.num.pages} +{ volume field.or.null + duplicate$ empty$ 'skip$ + { + "volume" bibinfo.check + } + if$ + %% by pedro + bold + pages duplicate$ empty$ 'pop$ + { swap$ duplicate$ empty$ + { pop$ pop$ format.pages } + { + ": " * + swap$ + n.dashify + "pages" bibinfo.check + * + } + if$ + } + if$ + format.year * +} + +FUNCTION {format.chapter.pages} +{ chapter empty$ + { "" } + { type empty$ + { bbl.chapter } + { type "l" change.case$ + "type" bibinfo.check + } + if$ + chapter tie.or.space.prefix + "chapter" bibinfo.check + * * + } + if$ +} + +FUNCTION {format.booktitle} +{ + booktitle "booktitle" bibinfo.check +} +FUNCTION {format.in.ed.booktitle} +{ format.booktitle duplicate$ empty$ 'skip$ + { + editor "editor" format.names.ed duplicate$ empty$ 'pop$ + { + " " * + get.bbl.editor + capitalize + "(" swap$ * "), " * + * swap$ + * } + if$ + word.in swap$ * + } + if$ +} +FUNCTION {format.thesis.type} +{ type duplicate$ empty$ + 'pop$ + { swap$ pop$ + "t" change.case$ "type" bibinfo.check + } + if$ +} +FUNCTION {format.tr.number} +{ number "number" bibinfo.check + type duplicate$ empty$ + { pop$ bbl.techrep } + 'skip$ + if$ + "type" bibinfo.check + swap$ duplicate$ empty$ + { pop$ "t" change.case$ } + { tie.or.space.prefix * * } + if$ +} +FUNCTION {format.article.crossref} +{ + word.in + " \cite{" * crossref * "}" * +} +FUNCTION {format.book.crossref} +{ volume duplicate$ empty$ + { "empty volume in " cite$ * "'s crossref of " * crossref * warning$ + pop$ word.in + } + { bbl.volume + swap$ tie.or.space.prefix "volume" bibinfo.check * * bbl.of space.word * + } + if$ + " \cite{" * crossref * "}" * +} +FUNCTION {format.incoll.inproc.crossref} +{ + word.in + " \cite{" * crossref * "}" * +} +FUNCTION {format.org.or.pub} +{ 't := + "" + address empty$ t empty$ and + 'skip$ + { + t empty$ + { address "address" bibinfo.check * + } + { t * + address empty$ + 'skip$ + { ", " * address "address" bibinfo.check * } + if$ + } + if$ + } + if$ +} +FUNCTION {format.publisher.address} +{ publisher "publisher" bibinfo.check format.org.or.pub +} +FUNCTION {format.publisher.address.year} +{ publisher "publisher" bibinfo.check format.org.or.pub + format.journal.pages + format.year * +} + +FUNCTION {school.address.year} +{ school "school" bibinfo.warn + address empty$ + 'skip$ + { ", " * address "address" bibinfo.check * } + if$ + format.year * +} + +FUNCTION {format.publisher.address.pages} +{ publisher "publisher" bibinfo.check format.org.or.pub + format.year * + +} + +FUNCTION {format.organization.address} +{ organization "organization" bibinfo.check format.org.or.pub +} + +FUNCTION {format.organization.address.year} +{ organization "organization" bibinfo.check format.org.or.pub + format.journal.pages + format.year * +} + +FUNCTION {article} +{ "%Type = Article" write$ + output.bibitem + format.authors "author" output.check + author format.key output + format.title "title" output.check + crossref missing$ + { + journal + "journal" bibinfo.check + %% by pedro + emphasize + "journal" output.check + add.blank + format.vol.num.pages output + } + { format.article.crossref output.nonnull + } + if$ +% format.journal.pages + new.sentence + format.note output + fin.entry +} +FUNCTION {book} +{ "%Type = Book" write$ + output.bibitem + author empty$ + { format.editors "author and editor" output.check + editor format.key output + } + { format.authors output.nonnull + crossref missing$ + { "author and editor" editor either.or.check } + 'skip$ + if$ + } + if$ + format.btitle "title" output.check + crossref missing$ + { %% by pedro + format.bvolume output + format.number.series output + % format.bvolume output + format.publisher.address.year output + } + { + format.book.crossref output.nonnull + } + if$ + format.edition output + % format.date "year" output.check + new.sentence + format.note output + fin.entry +} +FUNCTION {booklet} +{ "%Type = Booklet" write$ + output.bibitem + format.authors output + author format.key output + format.title "title" output.check + howpublished "howpublished" bibinfo.check output + address "address" bibinfo.check output + format.date "year" output.check + new.sentence + format.note output + fin.entry +} + +FUNCTION {inbook} +{ "%Type = Inbook" write$ + output.bibitem + author empty$ + { format.editors "author and editor" output.check + editor format.key output + } + { format.authors output.nonnull + format.title "title" output.check + crossref missing$ + { "author and editor" editor either.or.check } + 'skip$ + if$ + } + if$ + format.btitle "title" output.check + crossref missing$ + { + format.bvolume output + format.number.series output + format.publisher.address output + format.pages "pages" output.check + format.edition output + format.date "year" output.check + } + { + format.book.crossref output.nonnull + } + if$ +% format.edition output +% format.pages "pages" output.check + new.sentence + format.note output + fin.entry +} + +FUNCTION {incollection} +{ "%Type = Incollection" write$ + output.bibitem + format.authors "author" output.check + author format.key output + format.title "title" output.check + crossref missing$ + { format.in.ed.booktitle "booktitle" output.check + format.bvolume output + format.number.series output + format.pages "pages" output.check + % format.publisher.address output + % format.date "year" output.check + format.publisher.address.year output + format.edition output + } + { format.incoll.inproc.crossref output.nonnull + } + if$ +% format.pages "pages" output.check + new.sentence + format.note output + fin.entry +} +FUNCTION {inproceedings} +{ "%Type = Inproceedings" write$ + output.bibitem + format.authors "author" output.check + author format.key output + format.title "title" output.check + crossref missing$ + { + journal + "journal" bibinfo.check + "journal" output.check + format.in.ed.booktitle "booktitle" output.check + format.bvolume output + format.number.series output + publisher empty$ + { %format.organization.address output + format.organization.address.year output +% format.journal.pages + } + { organization "organization" bibinfo.check output + format.publisher.address.year output + % format.date "year" output.check +% format.journal.pages + } + if$ + } + { format.incoll.inproc.crossref output.nonnull + format.journal.pages + } + if$ +% format.pages.simple "pages" output.check +%%% La que sigue la muevo adentro del "if" +% format.journal.pages + new.sentence + format.note output + fin.entry +} +FUNCTION {conference} { inproceedings } +FUNCTION {manual} +{ "%Type = Manual" write$ + output.bibitem + format.authors output + author format.key output + format.btitle "title" output.check + organization "organization" bibinfo.check output + address "address" bibinfo.check output + format.edition output + format.date "year" output.check + new.sentence + format.note output + fin.entry +} + +FUNCTION {mastersthesis} +{ "%Type = Masterthesis" write$ + output.bibitem + format.authors "author" output.check + author format.key output + format.btitle + "title" output.check + bbl.mthesis format.thesis.type output.nonnull +% school "school" bibinfo.warn output +% address "address" bibinfo.check output +% format.date "year" output.check + school.address.year output + new.sentence + format.note output + fin.entry +} + +FUNCTION {misc} +{ "%Type = Misc" write$ + output.bibitem + format.authors output + author format.key output + format.title output + howpublished "howpublished" bibinfo.check output + format.date "year" output.check + new.sentence + format.note output + fin.entry +} +FUNCTION {phdthesis} +{ "%Type = Phdthesis" write$ + output.bibitem + format.authors "author" output.check + author format.key output + format.btitle + "title" output.check + bbl.phdthesis format.thesis.type output.nonnull +% school "school" bibinfo.warn output +% address "address" bibinfo.check output +% format.date "year" output.check + school.address.year output + new.sentence + format.note output + fin.entry +} + +FUNCTION {proceedings} +{ "%Type = Proceedings" write$ + output.bibitem + format.editors output + editor format.key output + format.btitle "title" output.check + format.bvolume output + format.number.series output + publisher empty$ + { format.organization.address output } + { organization "organization" bibinfo.check output + format.publisher.address output + } + if$ + format.date "year" output.check + new.sentence + format.note output + fin.entry +} + +FUNCTION {techreport} +{ "%Type = Techreport" write$ + output.bibitem + format.authors "author" output.check + author format.key output + format.btitle + "title" output.check + format.tr.number output.nonnull + institution "institution" bibinfo.warn output + address "address" bibinfo.check output + format.date "year" output.check + new.sentence + format.note output + fin.entry +} + +FUNCTION {unpublished} +{ "%Type = Unpublished" write$ + output.bibitem + format.authors "author" output.check + author format.key output + format.title "title" output.check + format.date "year" output.check + new.sentence + format.note "note" output.check + fin.entry +} + +FUNCTION {default.type} { misc } +READ +FUNCTION {sortify} +{ purify$ + "l" change.case$ +} +INTEGERS { len } +FUNCTION {chop.word} +{ 's := + 'len := + s #1 len substring$ = + { s len #1 + global.max$ substring$ } + 's + if$ +} +FUNCTION {format.lab.names} +{ 's := + "" 't := + s #1 "{vv~}{ll}" format.name$ + s num.names$ duplicate$ + #2 > + { pop$ + " " * bbl.etal * + } + { #2 < + 'skip$ + { s #2 "{ff }{vv }{ll}{ jj}" format.name$ "others" = + { + " " * bbl.etal * + } + { bbl.and space.word * s #2 "{vv~}{ll}" format.name$ + * } + if$ + } + if$ + } + if$ +} + +FUNCTION {author.key.label} +{ author empty$ + { key empty$ + { cite$ #1 #3 substring$ } + 'key + if$ + } + { author format.lab.names } + if$ +} + +FUNCTION {author.editor.key.label} +{ author empty$ + { editor empty$ + { key empty$ + { cite$ #1 #3 substring$ } + 'key + if$ + } + { editor format.lab.names } + if$ + } + { author format.lab.names } + if$ +} + +FUNCTION {editor.key.label} +{ editor empty$ + { key empty$ + { cite$ #1 #3 substring$ } + 'key + if$ + } + { editor format.lab.names } + if$ +} + +FUNCTION {calc.short.authors} +{ type$ "book" = + type$ "inbook" = + or + 'author.editor.key.label + { type$ "proceedings" = + 'editor.key.label + 'author.key.label + if$ + } + if$ + 'short.list := +} + +FUNCTION {calc.label} +{ calc.short.authors + short.list + "(" + * + year duplicate$ empty$ + { pop$ "????" } + { purify$ #-1 #4 substring$ } + if$ + * + 'label := +} + +FUNCTION {sort.format.names} +{ 's := + #1 'nameptr := + "" + s num.names$ 'numnames := + numnames 'namesleft := + { namesleft #0 > } + { s nameptr + "{ll{ }}{ f{ }}{ jj{ }}" + format.name$ 't := + nameptr #1 > + { + " " * + namesleft #1 = t "others" = and + { "zzzzz" * } + { t sortify * } + if$ + } + { t sortify * } + if$ + nameptr #1 + 'nameptr := + namesleft #1 - 'namesleft := + } + while$ +} + +FUNCTION {sort.format.title} +{ 't := + "A " #2 + "An " #3 + "The " #4 t chop.word + chop.word + chop.word + sortify + #1 global.max$ substring$ +} +FUNCTION {author.sort} +{ author empty$ + { key empty$ + { "to sort, need author or key in " cite$ * warning$ + "" + } + { key sortify } + if$ + } + { author sort.format.names } + if$ +} +FUNCTION {author.editor.sort} +{ author empty$ + { editor empty$ + { key empty$ + { "to sort, need author, editor, or key in " cite$ * warning$ + "" + } + { key sortify } + if$ + } + { editor sort.format.names } + if$ + } + { author sort.format.names } + if$ +} +FUNCTION {editor.sort} +{ editor empty$ + { key empty$ + { "to sort, need editor or key in " cite$ * warning$ + "" + } + { key sortify } + if$ + } + { editor sort.format.names } + if$ +} +FUNCTION {presort} +{ calc.label + label sortify + " " + * + type$ "book" = + type$ "inbook" = + or + 'author.editor.sort + { type$ "proceedings" = + 'editor.sort + 'author.sort + if$ + } + if$ + #1 entry.max$ substring$ + 'sort.label := + sort.label + * + " " + * + title field.or.null + sort.format.title + * + #1 entry.max$ substring$ + 'sort.key$ := +} + +ITERATE {presort} +SORT +STRINGS { last.label next.extra } +INTEGERS { last.extra.num number.label } +FUNCTION {initialize.extra.label.stuff} +{ #0 int.to.chr$ 'last.label := + "" 'next.extra := + #0 'last.extra.num := + #0 'number.label := +} +FUNCTION {forward.pass} +{ last.label label = + { last.extra.num #1 + 'last.extra.num := + last.extra.num int.to.chr$ 'extra.label := + } + { "a" chr.to.int$ 'last.extra.num := + "" 'extra.label := + label 'last.label := + } + if$ + number.label #1 + 'number.label := +} +FUNCTION {reverse.pass} +{ next.extra "b" = + { "a" 'extra.label := } + 'skip$ + if$ + extra.label 'next.extra := + extra.label + duplicate$ empty$ + 'skip$ + { "{\natexlab{" swap$ * "}}" * } + if$ + 'extra.label := + label extra.label * 'label := +} +EXECUTE {initialize.extra.label.stuff} +ITERATE {forward.pass} +REVERSE {reverse.pass} +FUNCTION {bib.sort.order} +{ sort.label + " " + * + year field.or.null sortify + * + " " + * + title field.or.null + sort.format.title + * + #1 entry.max$ substring$ + 'sort.key$ := +} +ITERATE {bib.sort.order} +SORT +FUNCTION {begin.bib} +{ preamble$ empty$ + 'skip$ + { preamble$ write$ newline$ } + if$ + "\begin{small}\begin{thebibliography}{" number.label int.to.str$ * "}" * + write$ newline$ + "\expandafter\ifx\csname natexlab\endcsname\relax\def\natexlab#1{#1}\fi" + write$ newline$ + "\providecommand{\bibinfo}[2]{#2}" + write$ newline$ + "\ifx\xfnm\relax \def\xfnm[#1]{\unskip,\space#1}\fi" + write$ newline$ +} +EXECUTE {begin.bib} +EXECUTE {init.state.consts} +ITERATE {call.type$} +FUNCTION {end.bib} +{ newline$ + "\end{thebibliography}\end{small}" write$ newline$ +} +EXECUTE {end.bib} diff --git a/thys/Transitive_Models/document/root.tex b/thys/Transitive_Models/document/root.tex new file mode 100644 --- /dev/null +++ b/thys/Transitive_Models/document/root.tex @@ -0,0 +1,184 @@ +\documentclass[11pt,a4paper]{article} +\usepackage{isabelle,isabellesym} +\usepackage[numbers]{natbib} +\usepackage{babel} + +\usepackage{relsize} +\DeclareRobustCommand{\isactrlbsub}{\emph\bgroup\math{}\sb\bgroup\mbox\bgroup\isaspacing\itshape\smaller} +\DeclareRobustCommand{\isactrlesub}{\egroup\egroup\endmath\egroup} +\DeclareRobustCommand{\isactrlbsup}{\emph\bgroup\math{}\sp\bgroup\mbox\bgroup\isaspacing\itshape\smaller} +\DeclareRobustCommand{\isactrlesup}{\egroup\egroup\endmath\egroup} + +% further packages required for unusual symbols (see also +% isabellesym.sty), use only when needed + +\usepackage{amssymb} + %for \, \, \, \, \, \, + %\, \, \, \, \, + %\, \, \ + +%\usepackage{eurosym} + %for \ + +%\usepackage[only,bigsqcap]{stmaryrd} + %for \ + +%\usepackage{eufrak} + %for \ ... \, \ ... \ (also included in amssymb) + +%\usepackage{textcomp} + %for \, \, \, \, \, + %\ + +% this should be the last package used +\usepackage{pdfsetup} + +% urls in roman style, theory text in math-similar italics +\urlstyle{rm} +\isabellestyle{it} + +% for uniform font size +%\renewcommand{\isastyle}{\isastyleminor} +\newcommand{\forces}{\Vdash} +\newcommand{\dom}{\mathsf{dom}} +\renewcommand{\isacharunderscorekeyword}{\mbox{\_}} +\renewcommand{\isacharunderscore}{\mbox{\_}} +\renewcommand{\isasymtturnstile}{\isamath{\Vdash}} +\renewcommand{\isacharminus}{-} +\newcommand{\session}[1]{\textit{#1}} +\newcommand{\theory}[1]{\texttt{#1}} +\newcommand{\axiomas}[1]{\mathit{#1}} +\newcommand{\ZFC}{\axiomas{ZFC}} +\newcommand{\ZF}{\axiomas{ZF}} +\newcommand{\AC}{\axiomas{AC}} +\newcommand{\CH}{\axiomas{CH}} + +\begin{document} + +\title{Transitive Models of Fragments of ZF} +\author{Emmanuel Gunther\thanks{Universidad Nacional de C\'ordoba. + Facultad de Matem\'atica, Astronom\'{\i}a, F\'{\i}sica y + Computaci\'on.} + \and + Miguel Pagano\footnotemark[1] + \and + Pedro S\'anchez Terraf\footnotemark[1] \thanks{Centro de Investigaci\'on y Estudios de Matem\'atica + (CIEM-FaMAF), Conicet. C\'ordoba. Argentina. + Supported by Secyt-UNC project 33620180100465CB.} + \and + Mat\'{\i}as Steinberg\footnotemark[1] +} +\maketitle + +\begin{abstract} + We extend the ZF-Constructibility library by relativizing theories + of the Isabelle/ZF and Delta System Lemma sessions to a transitive + class. We also relativize Paulson's work on Aleph and our former + treatment of the Axiom of Dependent Choices. This work is a + prerequisite to our formalization of the independence of the + Continuum Hypothesis. +\end{abstract} + + +\tableofcontents + +% sane default for proof documents +\parindent 0pt\parskip 0.5ex + +\section{Introduction} + +Relativization of concepts is a key tool to obtain results in forcing, +as it is explained in \cite[Sect.~3]{2020arXiv200109715G} and elsewhere. + +In this session, we cast some theories in relative form, in a +way that they now refer to a fixed class $M$ as the universe of +discourse. Whenever it was possible, we tried to minimize the changes +to the structure and proof scripts of the absolute concepts. For +this reason, some comments of the original text as well as +outdated \textbf{apply} commands appear profusely in the following +theories. + +A repeated pattern that appears is that the relativized result can be +proved \emph{mutatis mutandis}, with remaining proof obligations that +the objects constructed actually belong to the model $M$. Another +aspect was that the management of higher order constructs always posed +some extra problems, already noted by Paulson \cite[Sect.~7.3]{MR2051585}. + +In the theory \theory{Lambda\_Replacement} we introduce a new locale assuming +two instances of separation and twelve instances of ``lambda replacements'' +(i.e., replacements using definable functions of the form $\lambda x y. y=\langle x, f(x) \rangle$) +that allow for having some form of compositionality of further instances +of separations and replacements. + +We proceed to enumerate the theories that were ``ported'' to relative +form, briefly commenting on each of them. Below, we refer to the +original theories as the \emph{source} and, correspondingly, call +\emph{target} the relativized version. We omit the \theory{.thy} +suffixes. + +\begin{enumerate} +\item From \session{ZF}: + \begin{enumerate} + \item \theory{Univ}. Here we decided to relativize only the term + \isatt{Vfrom} that constructs the cumulative hierarchy up to some + ordinal length and starting from an arbitrary set. + \item \theory{Cardinal}. There are two targets for this source, + \theory{Least} and \theory{Cardinal\_Relative}. Both require some + fair amount of preparation, trying to take advantage of absolute + concepts. It is not straightforward to compare source and targets + in a line-by-line fashion at this point. + \item \theory{CardinalArith}. The hardest part was to formalize the + cardinal successor function. We also disregarded the part treating + finite cardinals since it is an absolute concept. Apart from that, + the relative version closely parallels the source. + \item \theory{Cardinal\_AC}. After some boilerplate, porting was + rather straightforward, excepting cardinal arithmetic involving + the higher-order union operator. + \end{enumerate} +\item From \session{ZF-Constructible}: + \begin{enumerate} + \item \theory{Normal}. The target here is \theory{Aleph\_Relative} + since that is the only concept that we ported. Instead of porting + all the machinery of normal functions (since it involved + higher-order variables), we particularized the results for the + Aleph function. We also used an alternative definition of the + latter that worked better with our relativization discipline. + \end{enumerate} +\item From \session{Delta\_System\_Lemma}: + \begin{enumerate} + \item \theory{ZF\_Library}. The target includes a big section of + auxiliary lemmas and commands that aid the relativization. We + needed to make explicit the witnesses (mainly functions) in some of the + existential results proved in the source, since only in that way + we would be able to show that they belonged to the model. + \item \theory{Cardinal\_Library}. Porting was relatively + straightforward; most of the extra work laid in adjusting locale + assumptions to obtain an appropriate context to state and prove + the theorems. + \item \theory{Delta\_System}. Same comments as in the case of + \theory{Cardinal\_Library} apply here. + \end{enumerate} +\item From \session{Forcing}: + \begin{enumerate} + \item \theory{Pointed\_DC}. This case was similar to + \theory{Cardinal\_AC} above, although a bit of care was needed to + handle the recursive construction. Also, a fraction of the theory + \theory{AC} from \session{ZF} was ported here as it was a + prerequisite. A complete relativization of \theory{AC} would be + desirable but still missing. + \end{enumerate} +\end{enumerate} +% generated text of all theories + +\input{session} + +\bibliographystyle{root} +\bibliography{root} + +\end{document} + +%%% Local Variables: +%%% mode: latex +%%% TeX-master: t +%%% ispell-local-dictionary: "american" +%%% End: