diff --git a/thys/ROOTS b/thys/ROOTS --- a/thys/ROOTS +++ b/thys/ROOTS @@ -1,770 +1,772 @@ ABY3_Protocols ADS_Functor AI_Planning_Languages_Semantics AODV AOT AVL-Trees AWN Abortable_Linearizable_Modules Abs_Int_ITP2012 Abstract-Hoare-Logics Abstract-Rewriting Abstract_Completeness Abstract_Soundness Ackermanns_not_PR 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 Balog_Szemeredi_Gowers Banach_Steinhaus Belief_Revision Bell_Numbers_Spivey BenOr_Kozen_Reif Berlekamp_Zassenhaus Bernoulli Bertrands_Postulate Bicategory BinarySearchTree Binary_Code_Imprimitive Binding_Syntax_Theory Binomial-Heaps Binomial-Queues BirdKMP Birkhoff_Finite_Distributive_Lattices Blue_Eyes Bondy Boolean_Expression_Checkers Boolos_Curious_Inference Boolos_Curious_Inference_Automated Bounded_Deducibility_Security Buchi_Complementation Budan_Fourier Buffons_Needle Buildings BytecodeLogicJmlTypes C2KA_DistributedSystems CAVA_Automata CAVA_LTL_Modelchecker CCS CHERI-C_Memory_Model CISC-Kernel CRDT CRYSTALS-Kyber CSP_RefTK CVP_Hardness 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 Catoids Cauchy Cayley_Hamilton Certification_Monads Ceva Chandy_Lamport Chord_Segments Circus Clean Clique_and_Monotone_Circuits ClockSynchInst Closest_Pair_Points CoCon CoSMeDis CoSMed CofGroups Coinductive Coinductive_Languages Collections Combinable_Wands Combinatorial_Enumeration_Algorithms Combinatorics_Words Combinatorics_Words_Graph_Lemma Combinatorics_Words_Lyndon CommCSL Commuting_Hermitian 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 Cook_Levin CoreC++ Core_DOM Core_SC_DOM Correctness_Algebras Cotangent_PFD_Formula Count_Complex_Roots Coupledsim_Contrasim CryptHOL CryptoBasedCompositionalProperties Crypto_Standards Cubic_Quartic_Equations DCR-ExecutionEquivalence DFS_Framework DOM_Components DPRM_Theorem DPT-SAT-Solver DataRefinementIBP Datatype_Order_Generator Decl_Sem_Fun_PL Decreasing-Diagrams Decreasing-Diagrams-II Dedekind_Real 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 DigitsInBase Digit_Expansions Dijkstra_Shortest_Path Diophantine_Eqns_Lin_Hom Directed_Sets Dirichlet_L Dirichlet_Series DiscretePricing Discrete_Summation DiskPaxos Distributed_Distinct_Elements Dominance_CHK DynamicArchitectures Dynamic_Tables E_Transcendental Earley_Parser Echelon_Form EdmondsKarp_Maxflow Edwards_Elliptic_Curves_Group Efficient-Mergesort Efficient_Weighted_Path_Order Elliptic_Curves_Group_Law Encodability_Process_Calculi Epistemic_Logic Equivalence_Relation_Enumeration Ergodic_Theory Error_Function Euler_MacLaurin Euler_Partition Euler_Polyhedron_Formula Eval_FO Example-Submission Executable_Randomized_Algorithms Expander_Graphs Extended_Finite_State_Machine_Inference Extended_Finite_State_Machines FFT FLP FOL-Fitting FOL_Axiomatic FOL_Harrison FOL_Seq_Calc1 FOL_Seq_Calc2 FOL_Seq_Calc3 FO_Theory_Rewriting FSM_Tests 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 Finite_Fields Finitely_Generated_Abelian_Groups First_Order_Terms First_Welfare_Theorem Fishburn_Impossibility Fisher_Yates Fishers_Inequality Fixed_Length_Vector Flow_Networks Floyd_Warshall Flyspeck-Tame FocusStreamsCaseStudies Forcing Formal_Puiseux_Series Formal_SSA Formula_Derivatives Foundation_of_geometry Fourier Free-Boolean-Algebra Free-Groups Frequency_Moments 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 Given_Clause_Loops GoedelGod Goedel_HFSet_Semantic Goedel_HFSet_Semanticless Goedel_Incompleteness Goodstein_Lambda GraphMarkingIBP Graph_Saturation Graph_Theory Gray_Codes Green Groebner_Bases Groebner_Macaulay Gromov_Hyperbolicity Grothendieck_Schemes Group-Ring-Module HOL-CSP HOLCF-Prelude HRB-Slicing Hahn_Jordan_Decomposition Hales_Jewett Heard_Of Hello_World HereditarilyFinite Hermite Hermite_Lindemann Hidden_Markov_Models Higher_Order_Terms HoareForDivergence Hoare_Time Hood_Melville_Queue HotelKeyCards Huffman Hybrid_Logic Hybrid_Multi_Lane_Spatial_Logic Hybrid_Systems_VCs HyperCTL HyperHoareLogic Hyperdual Hypergraph_Basics IEEE_Floating_Point IFC_Tracking IMAP-CRDT IMO2019 IMP2 IMP2_Binary_Heap IMP_Compiler IMP_Compiler_Reuse IO_Language_Conformance IP_Addresses Imperative_Insertion_Sort Implicational_Logic Impossible_Geometry Incompleteness Incredible_Proof_Machine Independence_CH Inductive_Confidentiality Inductive_Inference InfPathElimination InformationFlowSlicing InformationFlowSlicing_Inter Integration Interpolation_Polynomials_HOL_Algebra Interpreter_Optimizations Interval_Arithmetic_Word32 Intro_Dest_Elim Involutions2Squares Iptables_Semantics Irrational_Series_Erdos_Straus Irrationality_J_Hancl Irrationals_From_THEBOOK IsaGeoCoq IsaNet 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 Khovanskii_Theorem Kleene_Algebra Kneser_Cauchy_Davenport Knights_Tour Knot_Theory Knuth_Bendix_Order Knuth_Morris_Pratt Koenigsberg_Friendship Kruskal Kuratowski_Closure_Complement LLL_Basis_Reduction LLL_Factorization LOFT LP_Duality 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 Lovasz_Local Lowe_Ontological_Argument Lower_Semicontinuous Lp 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 Maximum_Segment_Sum Median_Method Median_Of_Medians_Selection Menger Mereology Mersenne_Primes Metalogic_ProofChecker MHComputation MiniML MiniSail Minimal_SSA Minkowskis_Theorem Minsky_Machines MLSS_Decision_Proc ML_Unification 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 Multirelations_Heterogeneous Multiset_Ordering_NPC Multitape_To_Singletape_TM Myhill-Nerode Name_Carrying_Type_Inference Nano_JSON Nash_Williams Nat-Interval-Logic Native_Word Nested_Multisets_Ordinals Network_Security_Policy_Verification Neumann_Morgenstern_Utility No_FTL_observers No_FTL_observers_Gen_Rel Nominal2 Noninterference_CSP Noninterference_Concurrent_Composition Noninterference_Generic_Unwinding Noninterference_Inductive_Unwinding Noninterference_Ipurge_Unwinding Noninterference_Sequential_Composition NormByEval Nullstellensatz Number_Theoretic_Transform 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 PAPP_Impossibility PCF PLM POPLmark-deBruijn PSemigroupsConvolution Package_logic Padic_Field 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 Pluennecke_Ruzsa_Inequality Poincare_Bendixson Poincare_Disc Polygonal_Number_Theorem Polynomial_Factorization Polynomial_Interpolation Polynomials Pop_Refinement Posix-Lexing Possibilistic_Noninterference Power_Sum_Polynomials Pratt_Certificate Prefix_Free_Code_Combinators 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 Probability_Inequality_Completeness Program-Conflict-Analysis Progress_Tracking Projective_Geometry Projective_Measurements Promela Proof_Strategy_Language PropResPI Propositional_Logic_Class Propositional_Proof_Systems Prpu_Maxflow PseudoHoops Psi_Calculi Ptolemys_Theorem Public_Announcement_Logic QHLProver QR_Decomposition Quantales Quantales_Converse Quantifier_Elimination_Hybrid Quasi_Borel_Spaces Quaternions Query_Optimization 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 Real_Time_Deque 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_Cardinality Relational_Disjoint_Set_Forests Relational_Forests Relational_Method Relational_Minimum_Spanning_Trees Relational_Paths Rensets Rep_Fin_Groups ResiduatedTransitionSystem Residuated_Lattices Resolution_FOL Rewrite_Properties_Reduction Rewriting_Z Ribbon_Proofs Risk_Free_Lending Robbins-Conjecture Robinson_Arithmetic Root_Balanced_Tree Roth_Arithmetic_Progressions Routing Roy_Floyd_Warshall SATSolverVerification SCC_Bloemen_Sequential SC_DOM_Components SDS_Impossibility SIFPL SIFUM_Type_Systems SPARCv8 +S_Finite_Measure_Monad Safe_Distance Safe_OCL Safe_Range_RC Saturation_Framework Saturation_Framework_Extensions Sauer_Shelah_Lemma Schutz_Spacetime Schwartz_Zippel Secondary_Sylow Security_Protocol_Refinement Selection_Heap_Sort SenSocialChoice Separata Separation_Algebra Separation_Logic_Imperative_HOL Separation_Logic_Unbounded SequentInvertibility Shadow_DOM Shadow_SC_DOM Shivers-CFA ShortestPath Show Sigma_Commit_Crypto Signature_Groebner Simpl Simple_Clause_Learning Simple_Firewall Simplex Simplicial_complexes_and_boolean_functions SimplifiedOntologicalArgument Skew_Heap Skip_Lists Slicing Sliding_Window_Algorithm Smith_Normal_Form Smooth_Manifolds Solidity Sophomores_Dream Sort_Encodings Source_Coding_Theorem SpecCheck Special_Function_Bounds Splay_Tree Sqrt_Babylonian Stable_Matching Stalnaker_Logic +Standard_Borel_Spaces 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 StrictOmegaCategories Strong_Security Sturm_Sequences Sturm_Tarski Stuttering_Equivalence Subresultants Subset_Boolean_Algebras SumSquares Sunflowers SuperCalc Suppes_Theorem Surprise_Paradox Symmetric_Polynomials Syntax_Independent_Logic Synthetic_Completeness Szemeredi_Regularity Szpilrajn TESL_Language TLA Tail_Recursive_Functions Tarskis_Geometry Taylor_Models Three_Circles Three_Squares Timed_Automata Topological_Semantics Topology TortoiseHare TsirelsonBound Transcendence_Series_Hancl_Rucki Transformer_Semantics Transition_Systems_and_Automata Transitive-Closure Transitive-Closure-II Transitive_Models Treaps Tree-Automata Tree_Decomposition Tree_Enumeration Triangle Trie Turans_Graph_Theorem Twelvefold_Way Two_Generated_Word_Monoids_Intersection Tycon Types_Tableaus_and_Goedels_God Types_To_Sets_Extension UPF UPF_Firewall UTP Undirected_Graph_Theory Universal_Hash_Families Universal_Turing_Machine UpDown_Scheme VYDRA_MDL 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 WHATandWHERE_Security WOOT_Strong_Eventual_Consistency WebAssembly Weight_Balanced_Trees Weighted_Arithmetic_Geometric_Mean Weighted_Path_Order Well_Quasi_Orders Wetzels_Problem Winding_Number_Eval Word_Lib WorkerWrapper X86_Semantics XML Youngs_Inequality ZFC_in_HOL Zeckendorf Zeta_3_Irrational Zeta_Function pGCL diff --git a/thys/S_Finite_Measure_Monad/Kernels.thy b/thys/S_Finite_Measure_Monad/Kernels.thy new file mode 100644 --- /dev/null +++ b/thys/S_Finite_Measure_Monad/Kernels.thy @@ -0,0 +1,2961 @@ +(* Title: Kernels.thy + Author: Michikazu Hirata, Tokyo Institute of Technology +*) + +section \ Kernels \ +theory Kernels + imports Lemmas_S_Finite_Measure_Monad +begin + +subsection \S-Finite Measures\ +locale s_finite_measure = + fixes M :: "'a measure" + assumes s_finite_sum: "\Mi :: nat \ 'a measure. (\i. sets (Mi i) = sets M) \ (\i. finite_measure (Mi i)) \ (\A\sets M. M A = (\i. Mi i A))" + +lemma(in sigma_finite_measure) s_finite_measure: "s_finite_measure M" +proof + obtain A :: "nat \ _" where A: "range A \ sets M" "\ (range A) = space M" "\i. emeasure M (A i) \ \" "disjoint_family A" + by(metis sigma_finite_disjoint) + define Mi where "Mi \ (\i. measure_of (space M) (sets M) (\a. M (a \ A i)))" + have emeasure_Mi:"Mi i a = M (a \ A i)" if "a \ sets M" for i a + proof - + have "positive (sets (Mi i)) (\a. M (a \ A i))" "countably_additive (sets (Mi i)) (\a. M (a \ A i))" + unfolding positive_def countably_additive_def + proof safe + fix B :: "nat \ _" + assume "range B \ sets (Mi i)" "disjoint_family B" + with A(1) have "range (\j. B j \ A i) \ sets M" "disjoint_family (\j. B j \ A i)" + by(fastforce simp: Mi_def disjoint_family_on_def)+ + thus "(\j. M (B j \ A i)) = M (\ (range B) \ A i)" + by (metis UN_extend_simps(4) suminf_emeasure) + qed simp + from emeasure_measure_of[OF _ _ this] that show ?thesis + by(auto simp add: Mi_def sets.space_closed) + qed + have sets_Mi:"sets (Mi i) = sets M" for i by(simp add: Mi_def) + show "\Mi. (\i. sets (Mi i) = sets M) \ (\i. finite_measure (Mi i)) \ (\A\sets M. emeasure M A = (\i. emeasure (Mi i) A))" + proof(safe intro!: exI[where x=Mi]) + fix i + show "finite_measure (Mi i)" + using A by(auto intro!: finite_measureI simp: sets_eq_imp_space_eq[OF sets_Mi] emeasure_Mi) + next + fix B + assume B:"B \ sets M" + with A(1,4) have "range (\i. B \ A i) \ sets M" "disjoint_family (\i. B \ A i)" + by(auto simp: disjoint_family_on_def) + then show "M B = (\i. (Mi i) B)" + by(simp add: emeasure_Mi[OF B] suminf_emeasure A(2) B) + qed(simp_all add: sets_Mi) +qed + +lemmas(in finite_measure) s_finite_measure_finite_measure = s_finite_measure + +lemmas(in subprob_space) s_finite_measure_subprob = s_finite_measure + +lemmas(in prob_space) s_finite_measure_prob = s_finite_measure + +sublocale sigma_finite_measure \ s_finite_measure + by(rule s_finite_measure) + +lemma s_finite_measureI: + assumes "\i. sets (Mi i) = sets M" "\i. finite_measure (Mi i)" "\A. A\sets M \ M A = (\i. Mi i A)" + shows "s_finite_measure M" + by standard (use assms in blast) + +lemma s_finite_measure_prodI: + assumes "\i j. sets (Mij i j) = sets M" "\i j. Mij i j (space M) < \" "\A. A \ sets M \ M A = (\i. (\j. Mij i j A))" + shows "s_finite_measure M" +proof - + define Mi' where "Mi' \ (\n. case_prod Mij (prod_decode n))" + have sets_Mi'[measurable_cong]:"\i. sets (Mi' i) = sets M" + using assms(1) by(simp add: Mi'_def split_beta') + have Mi'_finite:"\i. finite_measure (Mi' i)" + using assms(2) sets_eq_imp_space_eq[OF sets_Mi'[symmetric]] top.not_eq_extremum + by(fastforce intro!: finite_measureI simp: Mi'_def split_beta') + show ?thesis + proof(safe intro!: s_finite_measureI[where Mi=Mi'] sets_Mi' Mi'_finite) + fix A + show "A \ sets M \ M A = (\i. Mi' i A)" + by(simp add: assms(3) suminf_ennreal_2dimen[where f="\(x,y). Mij x y A", simplified,OF refl,symmetric] Mi'_def split_beta') + qed +qed + +corollary s_finite_measure_s_finite_sumI: + assumes "\i. sets (Mi i) = sets M" "\i. s_finite_measure (Mi i)" "\A. A \ sets M \ M A = (\i. Mi i A)" + shows "s_finite_measure M" +proof - + from s_finite_measure.s_finite_sum[OF assms(2)] + obtain Mij where Mij[measurable]: "\i j. sets (Mij i j) = sets M" "\i j. finite_measure (Mij i j)" "\i j A. A \ sets M \ Mi i A = (\j. Mij i j A)" + by (metis assms(1)) + show ?thesis + using finite_measure.emeasure_finite[OF Mij(2)] + by(auto intro!: s_finite_measure_prodI[where Mij = Mij] simp: assms(3) Mij top.not_eq_extremum) +qed + +lemma countable_space_s_finite_measure: + assumes "countable (space M)" "sets M = Pow (space M)" + shows "s_finite_measure M" +proof - + define Mi where "Mi \ (\i. measure_of (space M) (sets M) (\A. emeasure M (A \ {from_nat_into (space M) i})))" + have sets_Mi[measurable_cong,simp]: "sets (Mi i) = sets M" for i + by(auto simp: Mi_def) + have emeasure_Mi: "emeasure (Mi i) A = emeasure M (A \ {from_nat_into (space M) i})" if [measurable]: "A \ sets M" and i:"i \ to_nat_on (space M) ` (space M)" for i A + proof - + have "from_nat_into (space M) i \ space M" + by (simp add: from_nat_into_def i inv_into_into) + hence [measurable]: "{from_nat_into (space M) i} \ sets M" + using assms(2) by auto + have 1:"countably_additive (sets M) (\A. emeasure M (A \ {from_nat_into (space M) i}))" + unfolding countably_additive_def + proof safe + fix B :: "nat \ _" + assume "range B \ sets M" "disjoint_family B" + then have [measurable]:"\i. B i \ sets M" and "disjoint_family (\j. B j \ {from_nat_into (space M) i})" + by(auto simp: disjoint_family_on_def) + then have "(\j. emeasure M (B j \ {from_nat_into (space M) i})) = emeasure M (\ (range (\j. B j \ {from_nat_into (space M) i})))" + by(intro suminf_emeasure) auto + thus "(\j. emeasure M (B j \ {from_nat_into (space M) i})) = emeasure M (\ (range B) \ {from_nat_into (space M) i})" + by simp + qed + have 2:"positive (sets M) (\A. emeasure M (A \ {from_nat_into (space M) i}))" + by(auto simp: positive_def) + show ?thesis + by(simp add: Mi_def emeasure_measure_of_sigma[OF sets.sigma_algebra_axioms 2 1]) + qed + define Mi' where "Mi' \ (\i. if i \ to_nat_on (space M) ` (space M) then Mi i else null_measure M)" + have [measurable_cong, simp]: "sets (Mi' i) = sets M" for i + by(auto simp: Mi'_def) + show ?thesis + proof(rule s_finite_measure_s_finite_sumI[where Mi=Mi']) + fix A + assume A[measurable]: "A \ sets M" + show "emeasure M A = (\i. emeasure (Mi' i) A)" (is "?lhs = ?rhs") + proof - + have "?lhs = (\\<^sup>+ x. emeasure M {x} \count_space A)" + using sets.sets_into_space[OF A] by(auto intro!: emeasure_countable_singleton simp: assms(2) countable_subset[OF _ assms(1)]) + also have "... = (\\<^sup>+ x. emeasure (Mi (to_nat_on (space M) x)) A \count_space A)" + proof(safe intro!: nn_integral_cong) + fix x + assume "x \ space (count_space A)" + then have 1:"x \ A" by simp + hence 2:"to_nat_on (space M) x \ to_nat_on (space M) ` (space M)" + using A assms(2) by auto + have [simp]: "from_nat_into (space M) (to_nat_on (space M) x) = x" + by (metis 1 2 A assms(1) eq_from_nat_into_iff in_mono sets.sets_into_space) + show "emeasure M {x} = emeasure (Mi (to_nat_on (space M) x)) A" + using 1 by(simp add: emeasure_Mi[OF A 2]) + qed + also have "... = (\\<^sup>+ x\A. emeasure (Mi (to_nat_on (space M) x)) A \count_space UNIV)" + by (simp add: nn_integral_count_space_indicator) + also have "... = (\\<^sup>+ i\to_nat_on (space M) ` A. emeasure (Mi i) A \count_space UNIV)" + by(rule nn_integral_count_compose_inj[OF inj_on_subset[OF inj_on_to_nat_on[OF assms(1)] sets.sets_into_space[OF A]]]) + also have "... = (\\<^sup>+ i\to_nat_on (space M) ` A. emeasure (Mi' i) A \count_space UNIV)" + proof - + { + fix x + assume "x \ A" + then have "to_nat_on (space M) x \ to_nat_on (space M) ` (space M)" + using sets.sets_into_space[OF A] by auto + hence "emeasure (Mi (to_nat_on (space M) x)) A = emeasure (Mi' (to_nat_on (space M) x)) A" + by(auto simp: Mi'_def) + } + thus ?thesis + by(auto intro!: nn_integral_cong simp: indicator_def) + qed + also have "... = (\\<^sup>+ i. emeasure (Mi' i) A \count_space UNIV)" + proof - + { + fix i + assume i:"i \ to_nat_on (space M) ` A" + have "from_nat_into (space M) i \ A" if "i \ to_nat_on (space M) ` (space M)" + by (metis i image_eqI that to_nat_on_from_nat_into) + with emeasure_Mi have "emeasure (Mi' i) A = 0" + by(auto simp: Mi'_def) + } + thus ?thesis + by(auto intro!: nn_integral_cong simp: indicator_def) + qed + also have "... = ?rhs" + by(rule nn_integral_count_space_nat) + finally show ?thesis . + qed + next + fix i + show "s_finite_measure (Mi' i)" + proof - + { + fix x + assume h:"x \ space M" "i = to_nat_on (space M) x" + then have i:"i \ to_nat_on (space M) ` space M" + by blast + have x: "from_nat_into (space M) i = x" + using h by (simp add: assms(1)) + consider "M {x} = 0" | "M {x} \ 0" "M {x} < \" | "M {x} = \" + using top.not_eq_extremum by fastforce + hence "s_finite_measure (Mi (to_nat_on (space M) x))" + proof cases + case 1 + then have [simp]:"Mi i = null_measure M" + by(auto intro!: measure_eqI simp: emeasure_Mi[OF _ i] x Int_insert_right) + show ?thesis + by(auto simp: h(2)[symmetric] intro!: finite_measure.s_finite_measure_finite_measure finite_measureI) + next + case 2 + then show ?thesis + unfolding h(2)[symmetric] + by(auto intro!: finite_measure.s_finite_measure_finite_measure finite_measureI simp: sets_eq_imp_space_eq[OF sets_Mi] emeasure_Mi[OF _ i] x h(1)) + next + case 3 + show ?thesis + unfolding h(2)[symmetric] s_finite_measure_def + proof(safe intro!: exI[where x="\j. return M x"] prob_space.finite_measure prob_space_return h(1)) + fix A + assume "A \ sets (Mi i)" + then have [measurable]: "A \ sets M" + by(simp add: Mi_def) + thus "emeasure (Mi i) A = (\i. emeasure (return M x) A)" + by(simp add: emeasure_Mi[OF _ i] x) (cases "x \ A",auto simp: 3 nn_integral_count_space_nat[symmetric]) + qed(auto simp: Mi_def) + qed + } + thus ?thesis + by(auto simp: Mi'_def) (auto intro!: finite_measure.s_finite_measure_finite_measure finite_measureI) + qed + qed simp +qed + +lemma s_finite_measure_subprob_space: + "s_finite_measure M \ (\Mi :: nat \ 'a measure. (\i. sets (Mi i) = sets M) \ (\i. (Mi i) (space M) \ 1) \ (\A\sets M. M A = (\i. Mi i A)))" +proof + assume "\Mi. (\i. sets (Mi i) = sets M) \ (\i. emeasure (Mi i) (space M) \ 1) \ (\A\sets M. M A = (\i. (Mi i) A))" + then obtain Mi where 1:"\i. sets (Mi i) = sets M" "\i. emeasure (Mi i) (space M) \ 1" "(\A\sets M. M A = (\i. (Mi i) A))" + by auto + thus "s_finite_measure M" + by(auto simp: s_finite_measure_def sets_eq_imp_space_eq[OF 1(1)] intro!: finite_measureI exI[where x=Mi]) (metis ennreal_one_less_top linorder_not_le) +next + assume "s_finite_measure M" + then obtain Mi' where Mi': "\i. sets (Mi' i) = sets M" "\i. finite_measure (Mi' i)" "\A. A\sets M \ M A = (\i. Mi' i A)" + by (metis s_finite_measure.s_finite_sum) + obtain u where u:"\i. u i < \" "\i. Mi' i (space M) = u i" + using Mi'(2) finite_measure.emeasure_finite top.not_eq_extremum by fastforce + define Mmn where "Mmn \ (\(m,n). if n < nat \enn2real (u m)\ then scale_measure (1 / ennreal (real_of_int \enn2real (u m)\)) (Mi' m) else (sigma (space M) (sets M)))" + have sets_Mmn : "sets (Mmn k) = sets M" for k by(simp add: Mmn_def split_beta Mi') + have emeasure_Mmn: "(Mmn (m, n)) A = (Mi' m A) / ennreal (real_of_int \enn2real (u m)\)" if "n < nat \enn2real (u m)\" "A \ sets M" for n m A + by(auto simp: Mmn_def that ennreal_divide_times) + have emeasure_Mmn_less1: "(Mmn (m, n)) A \ 1" for m n A + proof (cases "n < nat \enn2real (u m)\ \ A \ sets M") + case h:True + have "(Mi' m) A \ ennreal (real_of_int \enn2real (u m)\)" + by(rule order.trans[OF emeasure_mono[OF sets.sets_into_space sets.top]]) (insert u(1) h, auto simp: u(2)[symmetric] enn2real_le top.not_eq_extremum sets_eq_imp_space_eq[OF Mi'(1)] Mi'(1)) + with h show ?thesis + by(simp add: emeasure_Mmn) (metis divide_le_posI_ennreal dual_order.eq_iff ennreal_zero_divide mult.right_neutral not_gr_zero zero_le) + qed(auto simp: Mmn_def emeasure_sigma emeasure_notin_sets Mi') + have Mi'_sum:"Mi' m A = (\n. Mmn (m, n) A)" if "A \ sets M" for m A + proof - + have "(\n. Mmn (m, n) A) = (\n. Mmn (m, n + nat \enn2real (u m)\) A) + (\n< nat \enn2real (u m)\. Mmn (m, n) A)" + by(simp add: suminf_offset[where f="\n. Mmn (m, n) A"]) + also have "... = (\n< nat \enn2real (u m)\. Mmn (m, n) A)" + by(simp add: emeasure_sigma Mmn_def) + also have "... = (\n< nat \enn2real (u m)\. (Mi' m A) / ennreal (real_of_int \enn2real (u m)\))" + by(rule Finite_Cartesian_Product.sum_cong_aux) (auto simp: emeasure_Mmn that) + also have "... = Mi' m A" + proof (cases "nat \enn2real (u m)\") + case 0 + with u[of m] show ?thesis + by simp (metis Mi'(1) emeasure_mono enn2real_positive_iff less_le_not_le linorder_less_linear not_less_zero sets.sets_into_space sets.top that) + next + case (Suc n') + then have "ennreal (real_of_int \enn2real (u m)\) > 0" + using ennreal_less_zero_iff by fastforce + with u(1)[of m] have "of_nat (nat \enn2real (u m)\) / ennreal (real_of_int \enn2real (u m)\) = 1" + by (simp add: ennreal_eq_0_iff ennreal_of_nat_eq_real_of_nat) + thus ?thesis + by (simp add: ennreal_divide_times[symmetric]) + qed + finally show ?thesis .. + qed + define Mi where "Mi \ (\i. Mmn (prod_decode i))" + show "\Mi. (\i. sets (Mi i) = sets M) \ (\i. emeasure (Mi i) (space M) \ 1) \ (\A\sets M. M A = (\i. (Mi i) A))" + by(auto intro!: exI[where x=Mi] simp: Mi_def sets_Mmn suminf_ennreal_2dimen[OF Mi'_sum] Mi'(3)) (metis emeasure_Mmn_less1 prod_decode_aux.cases) +qed + +lemma(in s_finite_measure) finite_measures: + obtains Mi where "\i. sets (Mi i) = sets M" "\i. (Mi i) (space M) \ 1" "\A. M A = (\i. Mi i A)" +proof - + obtain Mi where Mi:"\i. sets (Mi i) = sets M" "\i. (Mi i) (space M) \ 1" "\A. A \ sets M \ M A = (\i. Mi i A)" + using s_finite_measure_axioms by(metis s_finite_measure_subprob_space) + hence "M A = (\i. Mi i A)" for A + by(cases "A \ sets M") (auto simp: emeasure_notin_sets) + with Mi(1,2) show ?thesis + using that by blast +qed + +lemma(in s_finite_measure) finite_measures_ne: + assumes "space M \ {}" + obtains Mi where "\i. sets (Mi i) = sets M" "\i. subprob_space (Mi i)" "\A. M A = (\i. Mi i A)" + by (metis assms finite_measures sets_eq_imp_space_eq subprob_spaceI) + +lemma(in s_finite_measure) finite_measures': + obtains Mi where "\i. sets (Mi i) = sets M" "\i. finite_measure (Mi i)" "\A. M A = (\i. Mi i A)" + by (metis ennreal_top_neq_one finite_measureI finite_measures infinity_ennreal_def sets_eq_imp_space_eq top.extremum_uniqueI) + +lemma(in s_finite_measure) s_finite_measure_distr: + assumes f[measurable]:"f \ M \\<^sub>M N" + shows "s_finite_measure (distr M N f)" +proof - + obtain Mi where Mi[measurable_cong]:"\i. sets (Mi i) = sets M" "\i. finite_measure (Mi i)" "\A. M A = (\i. Mi i A)" + by(metis finite_measures') + show ?thesis + by(auto intro!: s_finite_measureI[where Mi="(\i. distr (Mi i) N f)"] finite_measure.finite_measure_distr[OF Mi(2)] simp: emeasure_distr Mi(3) sets_eq_imp_space_eq[OF Mi(1)]) +qed + +lemma nn_integral_measure_suminf: + assumes [measurable_cong]:"\i. sets (Mi i) = sets M" and "\A. A\sets M \ M A = (\i. Mi i A)" "f \ borel_measurable M" + shows "(\i. \\<^sup>+x. f x \(Mi i)) = (\\<^sup>+x. f x \M)" + using assms(3) +proof induction + case (cong f g) + then show ?case + by (metis (no_types, lifting) assms(1) nn_integral_cong sets_eq_imp_space_eq suminf_cong) +next + case (set A) + then show ?case + using assms(1,2) by simp +next + case (mult u c) + then show ?case + by(simp add: nn_integral_cmult) +next + case (add u v) + then show ?case + by(simp add: nn_integral_add suminf_add[symmetric]) +next + case ih:(seq U) + have "(\i. integral\<^sup>N (Mi i) (\ range U)) = (\i. \\<^sup>+ x. (\j. U j x) \(Mi i))" + by(auto intro!: suminf_cong) (metis SUP_apply) + also have "... = (\i. \j. \\<^sup>+ x. U j x \(Mi i))" + using ih by(auto intro!: suminf_cong nn_integral_monotone_convergence_SUP) + also have "... = (\j. (\i. \\<^sup>+ x. U j x \(Mi i)))" + using ih(3) by(auto intro!: ennreal_suminf_SUP_eq incseq_nn_integral) + also have "... = (\j. integral\<^sup>N M (U j))" + by(simp add: ih) + also have "... = (\\<^sup>+ x. (\j. U j x) \M)" + using ih by(auto intro!: nn_integral_monotone_convergence_SUP[symmetric]) + also have "... = integral\<^sup>N M (\ range U)" + by(metis SUP_apply) + finally show ?case . +qed + +text \ A @{term \density M f\} of $s$-finite measure @{term M} and @{term \f \ borel_measurable M\} is again s-finite. + We do not require additional assumption, unlike $\sigma$-finite measures.\ +lemma(in s_finite_measure) s_finite_measure_density: + assumes f[measurable]:"f \ borel_measurable M" + shows "s_finite_measure (density M f)" +proof - + obtain Mi where Mi[measurable_cong]:"\i. sets (Mi i) = sets M" "\i. finite_measure (Mi i)" "\A. M A = (\i. Mi i A)" + by(metis finite_measures') + show ?thesis + proof(rule s_finite_measure_s_finite_sumI[where Mi="\i. density (Mi i) f"]) + show "s_finite_measure (density (Mi i) f)" for i + proof - + define Mij where "Mij = (\j::nat. if j = 0 then density (Mi i) (\x. \ * indicator {x\space M. f x = \} x) + else if j = 1 then density (Mi i) (\x. f x * indicator {x\space M. f x < \} x) + else null_measure M)" + have sets_Mij[measurable_cong]: "sets (Mij j) = sets M" for j + by(auto simp: Mij_def Mi) + have emeasure_Mi:"density (Mi i) f A = (\j. Mij j A)" (is "?lhs = ?rhs") if A[measurable]: "A \ sets M" for A + proof - + have "?lhs = (\\<^sup>+x \ A. f x \Mi i)" + by(simp add: emeasure_density) + also have "... = (\\<^sup>+x. \ * indicator {x\space M. f x = \} x * indicator A x + f x * indicator {x\space M. f x < \} x * indicator A x \Mi i)" + by(auto intro!: nn_integral_cong simp: sets_eq_imp_space_eq[OF Mi(1)] indicator_def) (simp add: top.not_eq_extremum) + also have "... = density (Mi i) (\x. \ * indicator {x\space M. f x = \} x) A + density (Mi i) (\x. f x * indicator {x\space M. f x < \} x) A" + by(simp add: nn_integral_add emeasure_density) + also have "... = ?rhs" + using suminf_finite[of "{..j. Mij j A"] by(auto simp: Mij_def) + finally show ?thesis . + qed + show ?thesis + proof(rule s_finite_measure_s_finite_sumI[OF _ _ emeasure_Mi]) + fix j :: nat + consider "j = 0" | "j = 1" | "j \ 0" "j \ 1" by auto + then show "s_finite_measure (Mij j)" + proof cases + case 1 + have 2:"Mij j A = (\k. density (Mi i) (indicator {x\space M. f x = \}) A)" if A[measurable]:"A \ sets M" for A + by(auto simp: Mij_def 1 emeasure_density nn_integral_suminf[symmetric] sets_eq_imp_space_eq[OF Mi(1)] indicator_def intro!: nn_integral_cong) (simp add: nn_integral_count_space_nat[symmetric]) + show ?thesis + by(auto simp: s_finite_measure_def 2 Mi(1)[of i] sets_Mij[of j] intro!: exI[where x="\k. density (Mi i) (indicator {x\space M. f x = \})"] finite_measure.finite_measure_restricted Mi(2)) + next + case 2 + show ?thesis + by(auto intro!: sigma_finite_measure.s_finite_measure AE_mono_measure[OF Mi(1)] sum_le_suminf[where I="{i}" and f="\i. Mi i _",simplified] simp: sigma_finite_measure.sigma_finite_iff_density_finite[OF finite_measure.sigma_finite_measure[OF Mi(2)[of i]]] le_measure[OF Mi(1)] Mi indicator_def 2 Mij_def) auto + next + case 3 + then show ?thesis + by(auto simp: Mij_def intro!: finite_measure.s_finite_measure_finite_measure finite_measureI) + qed + qed(auto simp: sets_Mij Mi) + qed + qed(auto simp: emeasure_density nn_integral_measure_suminf[OF Mi(1,3)] Mi(1)) +qed + +lemma + fixes f :: "'a \ 'b::{banach, second_countable_topology}" + assumes [measurable_cong]:"\i. sets (Mi i) = sets M" and "\A. A\sets M \ M A = (\i. Mi i A)" "integrable M f" + shows lebesgue_integral_measure_suminf:"(\i. \x. f x \(Mi i)) = (\x. f x \M)" (is "?suminf") + and lebesgue_integral_measure_suminf_summable_norm: "summable (\i. norm (\x. f x \(Mi i)))" (is "?summable2") + and lebesgue_integral_measure_suminf_summable_norm_in: "summable (\i. \x. norm (f x) \(Mi i))" (is "?summable") +proof - + have Mi:"Mi i \ M" for i + using assms(2) ennreal_suminf_lessD linorder_not_le by(fastforce simp: assms(1) le_measure[OF assms(1)]) + have sum2: "summable (\i. norm (\x. g x \(Mi i)))" if "summable (\i. \x. norm (g x) \(Mi i))" for g :: "'a \ 'b" + proof(rule summable_suminf_not_top) + have "(\i. ennreal (norm (\x. g x \(Mi i)))) \ (\i. ennreal (\x. norm (g x) \(Mi i)))" + by(auto intro!: suminf_le) + thus "(\i. ennreal (norm (\x. g x \(Mi i)))) \ \" + by (metis ennreal_suminf_neq_top[OF that] Bochner_Integration.integral_nonneg neq_top_trans norm_ge_zero) + qed simp + have "?suminf \ ?summable" + using assms(3) + proof induction + case h[measurable]:(base A c) + have Mi_fin:"Mi i A < \" for i + by(rule order.strict_trans1[OF _ h(2)], auto simp: le_measureD3[OF Mi assms(1)]) + have 1: "(\x. (indicat_real A x *\<^sub>R c) \Mi i) = measure (Mi i) A *\<^sub>R c" for i + using Mi_fin by simp + have 2:"summable (\i. \x. norm (indicat_real A x *\<^sub>R c) \Mi i)" + proof(rule summable_suminf_not_top) + show "(\i. ennreal (\x. norm (indicat_real A x *\<^sub>R c) \Mi i)) \ \" (is "?l \ _") + proof - + have "?l = (\i. Mi i A ) * norm c" + using Mi_fin by(auto intro!: suminf_cong simp: measure_def enn2real_mult ennreal_mult) + also have "... = M A * norm c" + by(simp add: assms(2)) + also have "... \ \" + using h(2) by (simp add: ennreal_mult_less_top top.not_eq_extremum) + finally show ?thesis . + qed + qed simp + have 3: "(\i. \x. indicat_real A x *\<^sub>R c \Mi i) = (\x. indicat_real A x *\<^sub>R c \M)" (is "?l = ?r") + proof - + have [simp]: "summable (\i. enn2real (Mi i A))" + using Mi_fin h by(auto intro!: summable_suminf_not_top simp: assms(2)[symmetric]) + have "?l = (\i. measure (Mi i) A) *\<^sub>R c" + by(auto intro!: suminf_cong simp: 1 measure_def suminf_scaleR_left) + also have "... = ?r" + using h(2) Mi_fin by(simp add: ennreal_inj[where a="(\i. measure (Mi i) A)" and b="measure M A",OF suminf_nonneg measure_nonneg,symmetric,simplified measure_def] measure_def suminf_ennreal2[symmetric] assms(2)[symmetric]) + finally show ?thesis . + qed + from 2 3 show ?case by simp + next + case ih[measurable]:(add f g) + have 1:"summable (\i. \x. norm (f x + g x) \Mi i)" + proof(rule summable_suminf_not_top) + show "(\i. ennreal (\x. norm (f x + g x) \Mi i)) \ \" (is "?l \ _") + proof - + have "?l = (\i. (\\<^sup>+x. ennreal (norm (f x + g x)) \Mi i))" + using ih by(auto intro!: suminf_cong nn_integral_eq_integral[symmetric] integrable_mono_measure[OF assms(1) Mi]) + also have "... \ (\i. (\\<^sup>+x. ennreal (norm (f x) + norm (g x)) \Mi i))" + by(auto intro!: suminf_le nn_integral_mono norm_triangle_ineq simp del: ennreal_plus) + also have "... = (\i. (\\<^sup>+x. ennreal (norm (f x)) \Mi i)) + (\i. (\\<^sup>+x. ennreal (norm (g x)) \Mi i))" + by(auto intro!: suminf_cong simp: nn_integral_add suminf_add) + also have "... = (\i. ennreal (\x. norm (f x) \Mi i)) + (\i. ennreal (\x. norm (g x) \Mi i))" + using ih by(simp add: nn_integral_eq_integral integrable_mono_measure[OF assms(1) Mi]) + also have "... < \" + using ennreal_suminf_neq_top[OF conjunct2[OF ih(3)]] ennreal_suminf_neq_top[OF conjunct2[OF ih(4)]] + by (meson Bochner_Integration.integral_nonneg ennreal_add_eq_top norm_ge_zero top.not_eq_extremum) + finally show ?thesis + using order.strict_iff_order by blast + qed + qed simp + with ih show ?case + by(auto simp: Bochner_Integration.integral_add[OF integrable_mono_measure[OF assms(1) Mi ih(1)] integrable_mono_measure[OF assms(1) Mi ih(2)]] suminf_add[symmetric,OF summable_norm_cancel[OF sum2[OF conjunct2[OF ih(3)]]] summable_norm_cancel[OF sum2[OF conjunct2[OF ih(4)]]]]) + next + case ih[measurable]:(lim f fn) + have 1:"summable (\i. \x. norm (f x) \(Mi i))" + proof(rule summable_suminf_not_top) + show "(\i. ennreal (\x. norm (f x) \(Mi i))) \ \" (is "?lhs \ _") + proof - + have "?lhs = (\i. \\<^sup>+ x. ennreal (norm (f x)) \Mi i)" + by(auto intro!: suminf_cong nn_integral_eq_integral[symmetric] integrable_mono_measure[OF assms(1) Mi] simp: ih) + also have "... = (\\<^sup>+ x. ennreal (norm (f x)) \M)" + by(simp add: nn_integral_measure_suminf[OF assms(1,2)]) + also have "... = ennreal (\ x. norm (f x) \M)" + by(auto intro!: nn_integral_eq_integral ih(4)) + also have "... < \" by simp + finally show "?lhs \ \" + using linorder_neq_iff by blast + qed + qed simp + have "(\i. \x. f x \(Mi i)) = (\i. \x. f x \(Mi i) \(count_space UNIV))" + by(rule integral_count_space_nat[symmetric]) (simp add: integrable_count_space_nat_iff sum2[OF 1]) + also have "... = lim (\m. \i. \x. fn m x \(Mi i) \(count_space UNIV))" + proof(rule limI[OF integral_dominated_convergence[where w="\i. 2 * (\x. norm (f x) \(Mi i))"],symmetric],auto simp: AE_count_space integrable_count_space_nat_iff 1) + show "(\m. \x. fn m x \(Mi i)) \ \x. f x \(Mi i)" for i + by(rule integral_dominated_convergence[where w="\x. 2 * norm (f x)"],insert ih) (auto intro!: integrable_mono_measure[OF assms(1) Mi] simp: sets_eq_imp_space_eq[OF assms(1)]) + next + fix i j + show "norm (\x. fn j x \(Mi i)) \ 2 * (\x. norm (f x) \(Mi i))" (is "?l \ ?r") + proof - + have "?l \ (\x. norm (fn j x) \(Mi i))" + by simp + also have "... \ (\x. 2 * norm (f x) \(Mi i))" + by(rule integral_mono,insert ih) (auto intro!: integrable_mono_measure[OF assms(1) Mi] simp: sets_eq_imp_space_eq[OF assms(1)]) + finally show "?l \ ?r" by simp + qed + qed + also have "... = lim (\m. (\i. \x. fn m x \(Mi i)))" + proof - + have "(\i. \x. fn m x \(Mi i) \(count_space UNIV)) = (\i. \x. fn m x \(Mi i))" for m + by(auto intro!: integral_count_space_nat sum2 simp: integrable_count_space_nat_iff) (use ih(5) in auto) + thus ?thesis by simp + qed + also have "... = lim (\m. \x. fn m x \M)" + by(simp add: ih(5)) + also have "... = (\x. f x \M)" + using ih by(auto intro!: limI[OF integral_dominated_convergence[where w="\x. 2 * norm (f x)"]]) + finally show ?case + using 1 by auto + qed + thus ?suminf ?summable ?summable2 + by(simp_all add: sum2) +qed + +(* Ported from sigma-finite measure. + The following proof is easier than the sigma-finite measure version. *) +lemma (in s_finite_measure) measurable_emeasure_Pair': + assumes "Q \ sets (N \\<^sub>M M)" + shows "(\x. emeasure M (Pair x -` Q)) \ borel_measurable N" (is "?s Q \ _") +proof - + obtain Mi where Mi:"\i. sets (Mi i) = sets M" "\i. finite_measure (Mi i)" "\A. M A = (\i. Mi i A)" + by(metis finite_measures') + show ?thesis + using Mi(1,2) assms finite_measure.finite_measure_cut_measurable[of "Mi _" Q N] + by(simp add: Mi(3)) +qed + +lemma (in s_finite_measure) measurable_emeasure'[measurable (raw)]: + assumes space: "\x. x \ space N \ A x \ space M" + assumes A: "{x\space (N \\<^sub>M M). snd x \ A (fst x)} \ sets (N \\<^sub>M M)" + shows "(\x. emeasure M (A x)) \ borel_measurable N" +proof - + from space have "\x. x \ space N \ Pair x -` {x \ space (N \\<^sub>M M). snd x \ A (fst x)} = A x" + by (auto simp: space_pair_measure) + with measurable_emeasure_Pair'[OF A] show ?thesis + by (auto cong: measurable_cong) +qed + + +lemma(in s_finite_measure) emeasure_pair_measure': + assumes "X \ sets (N \\<^sub>M M)" + shows "emeasure (N \\<^sub>M M) X = (\\<^sup>+ x. \\<^sup>+ y. indicator X (x, y) \M \N)" (is "_ = ?\ X") +proof (rule emeasure_measure_of[OF pair_measure_def]) + show "positive (sets (N \\<^sub>M M)) ?\" + by (auto simp: positive_def) + have eq[simp]: "\A x y. indicator A (x, y) = indicator (Pair x -` A) y" + by (auto simp: indicator_def) + show "countably_additive (sets (N \\<^sub>M M)) ?\" + proof (rule countably_additiveI) + fix F :: "nat \ ('b \ 'a) set" assume F: "range F \ sets (N \\<^sub>M M)" "disjoint_family F" + from F have *: "\i. F i \ sets (N \\<^sub>M M)" by auto + moreover have "\x. disjoint_family (\i. Pair x -` F i)" + by (intro disjoint_family_on_bisimulation[OF F(2)]) auto + moreover have "\x. range (\i. Pair x -` F i) \ sets M" + using F by (auto simp: sets_Pair1) + ultimately show "(\n. ?\ (F n)) = ?\ (\i. F i)" + by (auto simp add: nn_integral_suminf[symmetric] vimage_UN suminf_emeasure + intro!: nn_integral_cong nn_integral_indicator[symmetric]) + qed + show "{a \ b |a b. a \ sets N \ b \ sets M} \ Pow (space N \ space M)" + using sets.space_closed[of N] sets.space_closed[of M] by auto +qed fact + +lemma (in s_finite_measure) emeasure_pair_measure_alt': + assumes X: "X \ sets (N \\<^sub>M M)" + shows "emeasure (N \\<^sub>M M) X = (\\<^sup>+x. emeasure M (Pair x -` X) \N)" +proof - + have [simp]: "\x y. indicator X (x, y) = indicator (Pair x -` X) y" + by (auto simp: indicator_def) + show ?thesis + using X by (auto intro!: nn_integral_cong simp: emeasure_pair_measure' sets_Pair1) +qed + +proposition (in s_finite_measure) emeasure_pair_measure_Times': + assumes A: "A \ sets N" and B: "B \ sets M" + shows "emeasure (N \\<^sub>M M) (A \ B) = emeasure N A * emeasure M B" +proof - + have "emeasure (N \\<^sub>M M) (A \ B) = (\\<^sup>+x. emeasure M B * indicator A x \N)" + using A B by (auto intro!: nn_integral_cong simp: emeasure_pair_measure_alt') + also have "\ = emeasure M B * emeasure N A" + using A by (simp add: nn_integral_cmult_indicator) + finally show ?thesis + by (simp add: ac_simps) +qed + +lemma(in s_finite_measure) measure_times: + assumes[measurable]: "A \ sets N" "B \ sets M" + shows "measure (N \\<^sub>M M) (A \ B) = measure N A * measure M B" + by(auto simp: measure_def emeasure_pair_measure_Times' enn2real_mult) + +lemma pair_measure_s_finite_measure_suminf: + assumes Mi[measurable_cong]:"\i. sets (Mi i) = sets M" "\i. finite_measure (Mi i)" "\A. M A = (\i. Mi i A)" + and Ni[measurable_cong]:"\i. sets (Ni i) = sets N" "\i. finite_measure (Ni i)" "\A. N A = (\i. Ni i A)" + shows "(M \\<^sub>M N) A = (\i j. (Mi i \\<^sub>M Ni j) A)" (is "?lhs = ?rhs") +proof - + interpret N: s_finite_measure N + by(auto intro!: s_finite_measureI[where Mi=Mi] s_finite_measureI[where Mi=Ni] assms) + show ?thesis + proof(cases "A \ sets (M \\<^sub>M N)") + case [measurable]:True + show ?thesis + proof - + have "?lhs = (\\<^sup>+x. N (Pair x -` A) \M)" + by(simp add: N.emeasure_pair_measure_alt') + also have "... = (\i. \\<^sup>+x. N (Pair x -` A) \Mi i)" + using N.measurable_emeasure_Pair'[of A] + by(auto intro!: nn_integral_measure_suminf[OF Mi(1,3),symmetric]) + also have "... = (\i. \\<^sup>+x. (\j. Ni j (Pair x -` A)) \Mi i)" + by(simp add: Ni(3)) + also have "... = (\i j. \\<^sup>+x. Ni j (Pair x -` A) \Mi i)" + using s_finite_measure.measurable_emeasure_Pair'[OF finite_measure.s_finite_measure_finite_measure[OF Ni(2)],of A] + by(auto simp: nn_integral_suminf intro!: suminf_cong) + also have "... = ?rhs" + by(auto intro!: suminf_cong simp: s_finite_measure.emeasure_pair_measure_alt'[OF finite_measure.s_finite_measure_finite_measure[OF Ni(2)]]) + finally show ?thesis . + qed + next + case False + with Mi(1) Ni(1) show ?thesis + by(simp add: emeasure_notin_sets) + qed +qed + +lemma pair_measure_s_finite_measure_suminf': + assumes Mi[measurable_cong]:"\i. sets (Mi i) = sets M" "\i. finite_measure (Mi i)" "\A. M A = (\i. Mi i A)" + and Ni[measurable_cong]:"\i. sets (Ni i) = sets N" "\i. finite_measure (Ni i)" "\A. N A = (\i. Ni i A)" + shows "(M \\<^sub>M N) A = (\i j. (Mi j \\<^sub>M Ni i) A)" (is "?lhs = ?rhs") +proof - + interpret N: s_finite_measure N + by(auto intro!: s_finite_measureI[where Mi=Mi] s_finite_measureI[where Mi=Ni] assms) + show ?thesis + proof(cases "A \ sets (M \\<^sub>M N)") + case [measurable]:True + show ?thesis + proof - + have "?lhs = (\\<^sup>+x. N (Pair x -` A) \M)" + by(simp add: N.emeasure_pair_measure_alt') + also have "... = (\\<^sup>+x. (\i. Ni i (Pair x -` A)) \M)" + by(auto intro!: nn_integral_cong simp: Ni) + also have "... = (\i. (\\<^sup>+x. Ni i (Pair x -` A) \M))" + by(auto intro!: nn_integral_suminf simp: finite_measure.finite_measure_cut_measurable[OF Ni(2)]) + also have "... = (\i j. \\<^sup>+x. Ni i (Pair x -` A) \Mi j)" + by(auto intro!: suminf_cong nn_integral_measure_suminf[symmetric] simp: finite_measure.finite_measure_cut_measurable[OF Ni(2)] Mi) + also have "... = ?rhs" + by(auto intro!: suminf_cong simp: s_finite_measure.emeasure_pair_measure_alt'[OF finite_measure.s_finite_measure_finite_measure[OF Ni(2)]]) + finally show ?thesis . + qed + next + case False + with Mi(1) Ni(1) show ?thesis + by(simp add: emeasure_notin_sets) + qed +qed + +lemma pair_measure_s_finite_measure: + assumes "s_finite_measure M" and "s_finite_measure N" + shows "s_finite_measure (M \\<^sub>M N)" +proof - + obtain Mi where Mi[measurable_cong]:"\i. sets (Mi i) = sets M" "\i. finite_measure (Mi i)" "\A. M A = (\i. Mi i A)" + by(metis s_finite_measure.finite_measures'[OF assms(1)]) + obtain Ni where Ni[measurable_cong]:"\i. sets (Ni i) = sets N" "\i. finite_measure (Ni i)" "\A. N A = (\i. Ni i A)" + by(metis s_finite_measure.finite_measures'[OF assms(2)]) + show ?thesis + proof(rule s_finite_measure_prodI[where Mij="\i j. Mi i \\<^sub>M Ni j"]) + show "emeasure (Mi i \\<^sub>M Ni j) (space (M \\<^sub>M N)) < \" for i j + using finite_measure.emeasure_finite[OF Mi(2)[of i]] finite_measure.emeasure_finite[OF Ni(2)[of j]] + by(auto simp: sets_eq_imp_space_eq[OF Mi(1)[of i],symmetric] sets_eq_imp_space_eq[OF Ni(1)[of j],symmetric] space_pair_measure s_finite_measure.emeasure_pair_measure_Times'[OF finite_measure.s_finite_measure_finite_measure[OF Ni(2)[of j]]] ennreal_mult_less_top top.not_eq_extremum) + qed(auto simp: pair_measure_s_finite_measure_suminf Mi Ni) +qed + +lemma(in s_finite_measure) borel_measurable_nn_integral_fst': + assumes [measurable]: "f \ borel_measurable (N \\<^sub>M M)" + shows "(\x. \\<^sup>+ y. f (x, y) \M) \ borel_measurable N" +proof - + obtain Mi where Mi[measurable_cong]:"\i. sets (Mi i) = sets M" "\i. finite_measure (Mi i)" "\A. M A = (\i. Mi i A)" + by(metis finite_measures') + show ?thesis + by(rule measurable_cong[where g="\x. \i. \\<^sup>+ y. f (x, y) \Mi i",THEN iffD2]) + (auto simp: nn_integral_measure_suminf[OF Mi(1,3)] intro!: borel_measurable_suminf_order sigma_finite_measure.borel_measurable_nn_integral_fst[OF finite_measure.sigma_finite_measure[OF Mi(2)]]) +qed + +lemma (in s_finite_measure) nn_integral_fst': + assumes f: "f \ borel_measurable (M1 \\<^sub>M M)" + shows "(\\<^sup>+ x. \\<^sup>+ y. f (x, y) \M \M1) = integral\<^sup>N (M1 \\<^sub>M M) f" (is "?I f = _") + using f proof induct + case (cong u v) + then have "?I u = ?I v" + by (intro nn_integral_cong) (auto simp: space_pair_measure) + with cong show ?case + by (simp cong: nn_integral_cong) +qed (simp_all add: emeasure_pair_measure' nn_integral_cmult nn_integral_add + nn_integral_monotone_convergence_SUP measurable_compose_Pair1 + borel_measurable_nn_integral_fst' nn_integral_mono incseq_def le_fun_def image_comp + cong: nn_integral_cong) + +lemma (in s_finite_measure) borel_measurable_nn_integral'[measurable (raw)]: + "case_prod f \ borel_measurable (N \\<^sub>M M) \ (\x. \\<^sup>+ y. f x y \M) \ borel_measurable N" + using borel_measurable_nn_integral_fst'[of "case_prod f" N] by simp + +lemma distr_pair_swap_s_finite: + assumes "s_finite_measure M1" and "s_finite_measure M2" + shows "M1 \\<^sub>M M2 = distr (M2 \\<^sub>M M1) (M1 \\<^sub>M M2) (\(x, y). (y, x))" (is "?P = ?D") +proof - + { + from s_finite_measure.finite_measures'[OF assms(1)] s_finite_measure.finite_measures'[OF assms(2)] + obtain Mi1 Mi2 + where Mi1:"\i. sets (Mi1 i) = sets M1" "\i. finite_measure (Mi1 i)" "\A. M1 A = (\i. Mi1 i A)" + and Mi2:"\i. sets (Mi2 i) = sets M2" "\i. finite_measure (Mi2 i)" "\A. M2 A = (\i. Mi2 i A)" + by metis + fix A + assume A[measurable]:"A \ sets (M1 \\<^sub>M M2)" + have "emeasure (M1 \\<^sub>M M2) A = emeasure (M2 \\<^sub>M M1) ((\(x, y). (y, x)) -` A \ space (M2 \\<^sub>M M1))" + proof - + { + fix i j + interpret pair_sigma_finite "Mi1 i" "Mi2 j" + by(auto simp: pair_sigma_finite_def Mi1(2) Mi2(2) finite_measure.sigma_finite_measure) + have "emeasure (Mi1 i \\<^sub>M Mi2 j) A = emeasure (Mi2 j \\<^sub>M Mi1 i) ((\(x, y). (y, x)) -` A \ space (M2 \\<^sub>M M1))" + using Mi1(1) Mi2(1) by(simp add: arg_cong[OF distr_pair_swap,of emeasure] emeasure_distr sets_eq_imp_space_eq[OF sets_pair_measure_cong[OF Mi2(1) Mi1(1)]]) + } + thus ?thesis + by(auto simp: pair_measure_s_finite_measure_suminf'[OF Mi2 Mi1] pair_measure_s_finite_measure_suminf[OF Mi1 Mi2] intro!: suminf_cong) + qed + } + thus ?thesis + by(auto intro!: measure_eqI simp: emeasure_distr) +qed + +proposition nn_integral_snd': + assumes "s_finite_measure M1" "s_finite_measure M2" + and f[measurable]: "f \ borel_measurable (M1 \\<^sub>M M2)" + shows "(\\<^sup>+ y. (\\<^sup>+ x. f (x, y) \M1) \M2) = integral\<^sup>N (M1 \\<^sub>M M2) f" +proof - + interpret M1: s_finite_measure M1 by fact + interpret M2: s_finite_measure M2 by fact + note measurable_pair_swap[OF f] + from M1.nn_integral_fst'[OF this] + have "(\\<^sup>+ y. (\\<^sup>+ x. f (x, y) \M1) \M2) = (\\<^sup>+ (x, y). f (y, x) \(M2 \\<^sub>M M1))" + by simp + also have "(\\<^sup>+ (x, y). f (y, x) \(M2 \\<^sub>M M1)) = integral\<^sup>N (M1 \\<^sub>M M2) f" + by (subst distr_pair_swap_s_finite[OF assms(1,2)]) (auto simp add: nn_integral_distr intro!: nn_integral_cong) + finally show ?thesis . +qed + +lemma (in s_finite_measure) borel_measurable_lebesgue_integrable'[measurable (raw)]: + fixes f :: "_ \ _ \ _::{banach, second_countable_topology}" + assumes [measurable]: "case_prod f \ borel_measurable (N \\<^sub>M M)" + shows "Measurable.pred N (\x. integrable M (f x))" +proof - + have [simp]: "\x. x \ space N \ integrable M (f x) \ (\\<^sup>+y. norm (f x y) \M) < \" + unfolding integrable_iff_bounded by simp + show ?thesis + by (simp cong: measurable_cong) +qed + +lemma (in s_finite_measure) measurable_measure'[measurable (raw)]: + "(\x. x \ space N \ A x \ space M) \ + {x \ space (N \\<^sub>M M). snd x \ A (fst x)} \ sets (N \\<^sub>M M) \ + (\x. measure M (A x)) \ borel_measurable N" + unfolding measure_def by (intro measurable_emeasure' borel_measurable_enn2real) auto + +proposition (in s_finite_measure) borel_measurable_lebesgue_integral'[measurable (raw)]: + fixes f :: "_ \ _ \ _::{banach, second_countable_topology}" + assumes f[measurable]: "case_prod f \ borel_measurable (N \\<^sub>M M)" + shows "(\x. \y. f x y \M) \ borel_measurable N" +proof - + from borel_measurable_implies_sequence_metric[OF f, of 0] + obtain s where s: "\i. simple_function (N \\<^sub>M M) (s i)" + and "\x\space (N \\<^sub>M M). (\i. s i x) \ (case x of (x, y) \ f x y)" + and "\i. \x\space (N \\<^sub>M M). dist (s i x) 0 \ 2 * dist (case x of (x, xa) \ f x xa) 0" + by auto + then have *: + "\x y. x \ space N \ y \ space M \ (\i. s i (x, y)) \ f x y" + "\i x y. x \ space N \ y \ space M \ norm (s i (x, y)) \ 2 * norm (f x y)" + by (auto simp: space_pair_measure) + + have [measurable]: "\i. s i \ borel_measurable (N \\<^sub>M M)" + by (rule borel_measurable_simple_function) fact + + have "\i. s i \ measurable (N \\<^sub>M M) (count_space UNIV)" + by (rule measurable_simple_function) fact + + define f' where [abs_def]: "f' i x = + (if integrable M (f x) then Bochner_Integration.simple_bochner_integral M (\y. s i (x, y)) else 0)" for i x + + { fix i x assume "x \ space N" + then have "Bochner_Integration.simple_bochner_integral M (\y. s i (x, y)) = + (\z\s i ` (space N \ space M). measure M {y \ space M. s i (x, y) = z} *\<^sub>R z)" + using s[THEN simple_functionD(1)] + unfolding simple_bochner_integral_def + by (intro sum.mono_neutral_cong_left) + (auto simp: eq_commute space_pair_measure image_iff cong: conj_cong) } + note eq = this + + show ?thesis + proof (rule borel_measurable_LIMSEQ_metric) + fix i show "f' i \ borel_measurable N" + unfolding f'_def by (simp_all add: eq cong: measurable_cong if_cong) + next + fix x assume x: "x \ space N" + { assume int_f: "integrable M (f x)" + have int_2f: "integrable M (\y. 2 * norm (f x y))" + by (intro integrable_norm integrable_mult_right int_f) + have "(\i. integral\<^sup>L M (\y. s i (x, y))) \ integral\<^sup>L M (f x)" + proof (rule integral_dominated_convergence) + from int_f show "f x \ borel_measurable M" by auto + show "\i. (\y. s i (x, y)) \ borel_measurable M" + using x by simp + show "AE xa in M. (\i. s i (x, xa)) \ f x xa" + using x * by auto + show "\i. AE xa in M. norm (s i (x, xa)) \ 2 * norm (f x xa)" + using x * by auto + qed fact + moreover + { fix i + have "Bochner_Integration.simple_bochner_integrable M (\y. s i (x, y))" + proof (rule simple_bochner_integrableI_bounded) + have "(\y. s i (x, y)) ` space M \ s i ` (space N \ space M)" + using x by auto + then show "simple_function M (\y. s i (x, y))" + using simple_functionD(1)[OF s(1), of i] x + by (intro simple_function_borel_measurable) + (auto simp: space_pair_measure dest: finite_subset) + have "(\\<^sup>+ y. ennreal (norm (s i (x, y))) \M) \ (\\<^sup>+ y. 2 * norm (f x y) \M)" + using x * by (intro nn_integral_mono) auto + also have "(\\<^sup>+ y. 2 * norm (f x y) \M) < \" + using int_2f unfolding integrable_iff_bounded by simp + finally show "(\\<^sup>+ xa. ennreal (norm (s i (x, xa))) \M) < \" . + qed + then have "integral\<^sup>L M (\y. s i (x, y)) = Bochner_Integration.simple_bochner_integral M (\y. s i (x, y))" + by (rule simple_bochner_integrable_eq_integral[symmetric]) } + ultimately have "(\i. Bochner_Integration.simple_bochner_integral M (\y. s i (x, y))) \ integral\<^sup>L M (f x)" + by simp } + then + show "(\i. f' i x) \ integral\<^sup>L M (f x)" + unfolding f'_def + by (cases "integrable M (f x)") (simp_all add: not_integrable_integral_eq) + qed +qed + +lemma integrable_product_swap_s_finite: + fixes f :: "_ \ _::{banach, second_countable_topology}" + assumes M1:"s_finite_measure M1" and M2:"s_finite_measure M2" + and "integrable (M1 \\<^sub>M M2) f" + shows "integrable (M2 \\<^sub>M M1) (\(x,y). f (y,x))" +proof - + have *: "(\(x,y). f (y,x)) = (\x. f (case x of (x,y)\(y,x)))" by (auto simp: fun_eq_iff) + show ?thesis unfolding * + by (rule integrable_distr[OF measurable_pair_swap']) + (simp add: distr_pair_swap_s_finite[OF M1 M2,symmetric] assms) +qed + +lemma integrable_product_swap_iff_s_finite: + fixes f :: "_ \ _::{banach, second_countable_topology}" + assumes M1:"s_finite_measure M1" and M2:"s_finite_measure M2" + shows "integrable (M2 \\<^sub>M M1) (\(x,y). f (y,x)) \ integrable (M1 \\<^sub>M M2) f" +proof - + from integrable_product_swap_s_finite[OF M2 M1,of "\(x,y). f (y,x)"] integrable_product_swap_s_finite[OF M1 M2,of f] + show ?thesis by auto +qed + +lemma integral_product_swap_s_finite: + fixes f :: "_ \ _::{banach, second_countable_topology}" + assumes M1:"s_finite_measure M1" and M2:"s_finite_measure M2" + and f: "f \ borel_measurable (M1 \\<^sub>M M2)" + shows "(\(x,y). f (y,x) \(M2 \\<^sub>M M1)) = integral\<^sup>L (M1 \\<^sub>M M2) f" +proof - + have *: "(\(x,y). f (y,x)) = (\x. f (case x of (x,y)\(y,x)))" by (auto simp: fun_eq_iff) + show ?thesis unfolding * + by (simp add: integral_distr[symmetric, OF measurable_pair_swap' f] distr_pair_swap_s_finite[OF M1 M2,symmetric]) +qed + +theorem(in s_finite_measure) Fubini_integrable': + fixes f :: "_ \ _::{banach, second_countable_topology}" + assumes f[measurable]: "f \ borel_measurable (M1 \\<^sub>M M)" + and integ1: "integrable M1 (\x. \ y. norm (f (x, y)) \M)" + and integ2: "AE x in M1. integrable M (\y. f (x, y))" + shows "integrable (M1 \\<^sub>M M) f" +proof (rule integrableI_bounded) + have "(\\<^sup>+ p. norm (f p) \(M1 \\<^sub>M M)) = (\\<^sup>+ x. (\\<^sup>+ y. norm (f (x, y)) \M) \M1)" + by (simp add: nn_integral_fst'[symmetric]) + also have "\ = (\\<^sup>+ x. \\y. norm (f (x, y)) \M\ \M1)" + proof(rule nn_integral_cong_AE) + show "AE x in M1. (\\<^sup>+ y. ennreal (norm (f (x, y))) \M) = ennreal \LINT y|M. norm (f (x, y))\" + using integ2 + proof eventually_elim + fix x assume "integrable M (\y. f (x, y))" + then have f: "integrable M (\y. norm (f (x, y)))" + by simp + then have "(\\<^sup>+y. ennreal (norm (f (x, y))) \M) = ennreal (LINT y|M. norm (f (x, y)))" + by (rule nn_integral_eq_integral) simp + also have "\ = ennreal \LINT y|M. norm (f (x, y))\" + using f by simp + finally show "(\\<^sup>+y. ennreal (norm (f (x, y))) \M) = ennreal \LINT y|M. norm (f (x, y))\" . + qed + qed + also have "\ < \" + using integ1 by (simp add: integrable_iff_bounded integral_nonneg_AE) + finally show "(\\<^sup>+ p. norm (f p) \(M1 \\<^sub>M M)) < \" . +qed fact + +lemma(in s_finite_measure) emeasure_pair_measure_finite': + assumes A: "A \ sets (M1 \\<^sub>M M)" and finite: "emeasure (M1 \\<^sub>M M) A < \" + shows "AE x in M1. emeasure M {y\space M. (x, y) \ A} < \" +proof - + from emeasure_pair_measure_alt'[OF A] finite + have "(\\<^sup>+ x. emeasure M (Pair x -` A) \M1) \ \" + by simp + then have "AE x in M1. emeasure M (Pair x -` A) \ \" + by (rule nn_integral_PInf_AE[rotated]) (intro measurable_emeasure_Pair' A) + moreover have "\x. x \ space M1 \ Pair x -` A = {y\space M. (x, y) \ A}" + using sets.sets_into_space[OF A] by (auto simp: space_pair_measure) + ultimately show ?thesis by (auto simp: less_top) +qed + +lemma(in s_finite_measure) AE_integrable_fst''': + fixes f :: "_ \ _::{banach, second_countable_topology}" + assumes f[measurable]: "integrable (M1 \\<^sub>M M) f" + shows "AE x in M1. integrable M (\y. f (x, y))" +proof - + have "(\\<^sup>+x. (\\<^sup>+y. norm (f (x, y)) \M) \M1) = (\\<^sup>+x. norm (f x) \(M1 \\<^sub>M M))" + by (rule nn_integral_fst') simp + also have "(\\<^sup>+x. norm (f x) \(M1 \\<^sub>M M)) \ \" + using f unfolding integrable_iff_bounded by simp + finally have "AE x in M1. (\\<^sup>+y. norm (f (x, y)) \M) \ \" + by (intro nn_integral_PInf_AE borel_measurable_nn_integral') + (auto simp: measurable_split_conv) + with AE_space show ?thesis + by eventually_elim + (auto simp: integrable_iff_bounded measurable_compose[OF _ borel_measurable_integrable[OF f]] less_top) +qed + +lemma(in s_finite_measure) integrable_fst_norm': + fixes f :: "_ \ _::{banach, second_countable_topology}" + assumes f[measurable]: "integrable (M1 \\<^sub>M M) f" + shows "integrable M1 (\x. \y. norm (f (x, y)) \M)" + unfolding integrable_iff_bounded +proof + show "(\x. \ y. norm (f (x, y)) \M) \ borel_measurable M1" + by (rule borel_measurable_lebesgue_integral') simp + have "(\\<^sup>+ x. ennreal (norm (\y. norm (f (x, y)) \M)) \M1) = (\\<^sup>+x. (\\<^sup>+y. norm (f (x, y)) \M) \M1)" + using AE_integrable_fst'''[OF f] by (auto intro!: nn_integral_cong_AE simp: nn_integral_eq_integral) + also have "(\\<^sup>+x. (\\<^sup>+y. norm (f (x, y)) \M) \M1) = (\\<^sup>+x. norm (f x) \(M1 \\<^sub>M M))" + by (rule nn_integral_fst') simp + also have "(\\<^sup>+x. norm (f x) \(M1 \\<^sub>M M)) < \" + using f unfolding integrable_iff_bounded by simp + finally show "(\\<^sup>+ x. ennreal (norm (\y. norm (f (x, y)) \M)) \M1) < \" . +qed + +lemma(in s_finite_measure) integrable_fst''': + fixes f :: "_ \ _::{banach, second_countable_topology}" + assumes f[measurable]: "integrable (M1 \\<^sub>M M) f" + shows "integrable M1 (\x. \y. f (x, y) \M)" + by(auto intro!: Bochner_Integration.integrable_bound[OF integrable_fst_norm'[OF f]]) + +proposition(in s_finite_measure) integral_fst''': + fixes f :: "_ \ _::{banach, second_countable_topology}" + assumes f: "integrable (M1 \\<^sub>M M) f" + shows "(\x. (\y. f (x, y) \M) \M1) = integral\<^sup>L (M1 \\<^sub>M M) f" +using f proof induct + case (base A c) + have A[measurable]: "A \ sets (M1 \\<^sub>M M)" by fact + + have eq: "\x y. x \ space M1 \ indicator A (x, y) = indicator {y\space M. (x, y) \ A} y" + using sets.sets_into_space[OF A] by (auto split: split_indicator simp: space_pair_measure) + + have int_A: "integrable (M1 \\<^sub>M M) (indicator A :: _ \ real)" + using base by (rule integrable_real_indicator) + have "(\ x. \ y. indicator A (x, y) *\<^sub>R c \M \M1) = (\x. measure M {y\space M. (x, y) \ A} *\<^sub>R c \M1)" + proof (intro integral_cong_AE) + from AE_integrable_fst'''[OF int_A] AE_space + show "AE x in M1. (\y. indicator A (x, y) *\<^sub>R c \M) = measure M {y\space M. (x, y) \ A} *\<^sub>R c" + by eventually_elim (simp add: eq integrable_indicator_iff) + qed simp_all + also have "\ = measure (M1 \\<^sub>M M) A *\<^sub>R c" + proof (subst integral_scaleR_left) + have "(\\<^sup>+x. ennreal (measure M {y \ space M. (x, y) \ A}) \M1) = + (\\<^sup>+x. emeasure M {y \ space M. (x, y) \ A} \M1)" + using emeasure_pair_measure_finite'[OF base] + by (intro nn_integral_cong_AE, eventually_elim) (simp add: emeasure_eq_ennreal_measure) + also have "\ = emeasure (M1 \\<^sub>M M) A" + using sets.sets_into_space[OF A] + by (subst emeasure_pair_measure_alt') + (auto intro!: nn_integral_cong arg_cong[where f="emeasure M"] simp: space_pair_measure) + finally have *: "(\\<^sup>+x. ennreal (measure M {y \ space M. (x, y) \ A}) \M1) = emeasure (M1 \\<^sub>M M) A" . + + from base * show "integrable M1 (\x. measure M {y \ space M. (x, y) \ A})" + by (simp add: integrable_iff_bounded) + then have "(\x. measure M {y \ space M. (x, y) \ A} \M1) = + (\\<^sup>+x. ennreal (measure M {y \ space M. (x, y) \ A}) \M1)" + by (rule nn_integral_eq_integral[symmetric]) simp + also note * + finally show "(\x. measure M {y \ space M. (x, y) \ A} \M1) *\<^sub>R c = measure (M1 \\<^sub>M M) A *\<^sub>R c" + using base by (simp add: emeasure_eq_ennreal_measure) + qed + also have "\ = (\ a. indicator A a *\<^sub>R c \(M1 \\<^sub>M M))" + using base by simp + finally show ?case . +next + case (add f g) + then have [measurable]: "f \ borel_measurable (M1 \\<^sub>M M)" "g \ borel_measurable (M1 \\<^sub>M M)" + by auto + have "(\ x. \ y. f (x, y) + g (x, y) \M \M1) = + (\ x. (\ y. f (x, y) \M) + (\ y. g (x, y) \M) \M1)" + apply (rule integral_cong_AE) + apply simp_all + using AE_integrable_fst'''[OF add(1)] AE_integrable_fst'''[OF add(3)] + apply eventually_elim + apply simp + done + also have "\ = (\ x. f x \(M1 \\<^sub>M M)) + (\ x. g x \(M1 \\<^sub>M M))" + using integrable_fst'''[OF add(1)] integrable_fst'''[OF add(3)] add(2,4) by simp + finally show ?case + using add by simp +next + case (lim f s) + then have [measurable]: "f \ borel_measurable (M1 \\<^sub>M M)" "\i. s i \ borel_measurable (M1 \\<^sub>M M)" + by auto + + show ?case + proof (rule LIMSEQ_unique) + show "(\i. integral\<^sup>L (M1 \\<^sub>M M) (s i)) \ integral\<^sup>L (M1 \\<^sub>M M) f" + proof (rule integral_dominated_convergence) + show "integrable (M1 \\<^sub>M M) (\x. 2 * norm (f x))" + using lim(5) by auto + qed (insert lim, auto) + have "(\i. \ x. \ y. s i (x, y) \M \M1) \ \ x. \ y. f (x, y) \M \M1" + proof (rule integral_dominated_convergence) + have "AE x in M1. \i. integrable M (\y. s i (x, y))" + unfolding AE_all_countable using AE_integrable_fst'''[OF lim(1)] .. + with AE_space AE_integrable_fst'''[OF lim(5)] + show "AE x in M1. (\i. \ y. s i (x, y) \M) \ \ y. f (x, y) \M" + proof eventually_elim + fix x assume x: "x \ space M1" and + s: "\i. integrable M (\y. s i (x, y))" and f: "integrable M (\y. f (x, y))" + show "(\i. \ y. s i (x, y) \M) \ \ y. f (x, y) \M" + proof (rule integral_dominated_convergence) + show "integrable M (\y. 2 * norm (f (x, y)))" + using f by auto + show "AE xa in M. (\i. s i (x, xa)) \ f (x, xa)" + using x lim(3) by (auto simp: space_pair_measure) + show "\i. AE xa in M. norm (s i (x, xa)) \ 2 * norm (f (x, xa))" + using x lim(4) by (auto simp: space_pair_measure) + qed (insert x, measurable) + qed + show "integrable M1 (\x. (\ y. 2 * norm (f (x, y)) \M))" + by (intro integrable_mult_right integrable_norm integrable_fst''' lim) + fix i show "AE x in M1. norm (\ y. s i (x, y) \M) \ (\ y. 2 * norm (f (x, y)) \M)" + using AE_space AE_integrable_fst'''[OF lim(1), of i] AE_integrable_fst'''[OF lim(5)] + proof eventually_elim + fix x assume x: "x \ space M1" + and s: "integrable M (\y. s i (x, y))" and f: "integrable M (\y. f (x, y))" + from s have "norm (\ y. s i (x, y) \M) \ (\\<^sup>+y. norm (s i (x, y)) \M)" + by (rule integral_norm_bound_ennreal) + also have "\ \ (\\<^sup>+y. 2 * norm (f (x, y)) \M)" + using x lim by (auto intro!: nn_integral_mono simp: space_pair_measure) + also have "\ = (\y. 2 * norm (f (x, y)) \M)" + using f by (intro nn_integral_eq_integral) auto + finally show "norm (\ y. s i (x, y) \M) \ (\ y. 2 * norm (f (x, y)) \M)" + by simp + qed + qed simp_all + then show "(\i. integral\<^sup>L (M1 \\<^sub>M M) (s i)) \ \ x. \ y. f (x, y) \M \M1" + using lim by simp + qed +qed + +lemma (in s_finite_measure) + fixes f :: "_ \ _ \ _::{banach, second_countable_topology}" + assumes f: "integrable (M1 \\<^sub>M M) (case_prod f)" + shows AE_integrable_fst'': "AE x in M1. integrable M (\y. f x y)" + and integrable_fst'': "integrable M1 (\x. \y. f x y \M)" + and integrable_fst_norm: "integrable M1 (\x. \y. norm (f x y) \M)" + and integral_fst'': "(\x. (\y. f x y \M) \M1) = integral\<^sup>L (M1 \\<^sub>M M) (\(x, y). f x y)" + using AE_integrable_fst'''[OF f] integrable_fst'''[OF f] integral_fst'''[OF f] integrable_fst_norm'[OF f] by auto + +lemma + fixes f :: "_ \ _ \ _::{banach, second_countable_topology}" + assumes M1:"s_finite_measure M1" and M2:"s_finite_measure M2" + and f[measurable]: "integrable (M1 \\<^sub>M M2) (case_prod f)" + shows AE_integrable_snd_s_finite: "AE y in M2. integrable M1 (\x. f x y)" (is "?AE") + and integrable_snd_s_finite: "integrable M2 (\y. \x. f x y \M1)" (is "?INT") + and integrable_snd_norm_s_finite: "integrable M2 (\y. \x. norm (f x y) \M1)" (is "?INT2") + and integral_snd_s_finite: "(\y. (\x. f x y \M1) \M2) = integral\<^sup>L (M1 \\<^sub>M M2) (case_prod f)" (is "?EQ") +proof - + interpret Q: s_finite_measure M1 by fact + have Q_int: "integrable (M2 \\<^sub>M M1) (\(x, y). f y x)" + using f unfolding integrable_product_swap_iff_s_finite[OF M1 M2,symmetric] by simp + show ?AE using Q.AE_integrable_fst'''[OF Q_int] by simp + show ?INT using Q.integrable_fst'''[OF Q_int] by simp + show ?INT2 using Q.integrable_fst_norm[OF Q_int] by simp + show ?EQ using Q.integral_fst'''[OF Q_int] + using integral_product_swap_s_finite[OF M1 M2,of "case_prod f"] by simp +qed + +proposition Fubini_integral': + fixes f :: "_ \ _ \ _ :: {banach, second_countable_topology}" + assumes M1:"s_finite_measure M1" and M2:"s_finite_measure M2" + and f: "integrable (M1 \\<^sub>M M2) (case_prod f)" + shows "(\y. (\x. f x y \M1) \M2) = (\x. (\y. f x y \M2) \M1)" + unfolding integral_snd_s_finite[OF assms] s_finite_measure.integral_fst''[OF assms(2,3)] .. + +locale product_s_finite = + fixes M :: "'i \ 'a measure" + assumes s_finite_measures: "\i. s_finite_measure (M i)" + +sublocale product_s_finite \ M?: s_finite_measure "M i" for i + by (rule s_finite_measures) + +locale finite_product_s_finite = product_s_finite M for M :: "'i \ 'a measure" + + fixes I :: "'i set" + assumes finite_index: "finite I" + +lemma (in product_s_finite) emeasure_PiM: + "finite I \ (\i. i\I \ A i \ sets (M i)) \ emeasure (PiM I M) (Pi\<^sub>E I A) = (\i\I. emeasure (M i) (A i))" +proof (induct I arbitrary: A rule: finite_induct) + case (insert i I) + interpret finite_product_s_finite M I by standard fact + have "finite (insert i I)" using \finite I\ by auto + interpret I': finite_product_s_finite M "insert i I" by standard fact + let ?h = "(\(f, y). f(i := y))" + + let ?P = "distr (Pi\<^sub>M I M \\<^sub>M M i) (Pi\<^sub>M (insert i I) M) ?h" + let ?\ = "emeasure ?P" + let ?I = "{j \ insert i I. emeasure (M j) (space (M j)) \ 1}" + let ?f = "\J E j. if j \ J then emeasure (M j) (E j) else emeasure (M j) (space (M j))" + + have "emeasure (Pi\<^sub>M (insert i I) M) (prod_emb (insert i I) M (insert i I) (Pi\<^sub>E (insert i I) A)) = + (\i\insert i I. emeasure (M i) (A i))" + proof (subst emeasure_extend_measure_Pair[OF PiM_def]) + fix J E assume "(J \ {} \ insert i I = {}) \ finite J \ J \ insert i I \ E \ (\ j\J. sets (M j))" + then have J: "J \ {}" "finite J" "J \ insert i I" and E: "\j\J. E j \ sets (M j)" by auto + let ?p = "prod_emb (insert i I) M J (Pi\<^sub>E J E)" + let ?p' = "prod_emb I M (J - {i}) (\\<^sub>E j\J-{i}. E j)" + have "?\ ?p = + emeasure (Pi\<^sub>M I M \\<^sub>M (M i)) (?h -` ?p \ space (Pi\<^sub>M I M \\<^sub>M M i))" + by (intro emeasure_distr measurable_add_dim sets_PiM_I) fact+ + also have "?h -` ?p \ space (Pi\<^sub>M I M \\<^sub>M M i) = ?p' \ (if i \ J then E i else space (M i))" + using J E[rule_format, THEN sets.sets_into_space] + by (force simp: space_pair_measure space_PiM prod_emb_iff PiE_def Pi_iff split: if_split_asm) + also have "emeasure (Pi\<^sub>M I M \\<^sub>M (M i)) (?p' \ (if i \ J then E i else space (M i))) = + emeasure (Pi\<^sub>M I M) ?p' * emeasure (M i) (if i \ J then (E i) else space (M i))" + using J E by (intro M.emeasure_pair_measure_Times' sets_PiM_I) auto + also have "?p' = (\\<^sub>E j\I. if j \ J-{i} then E j else space (M j))" + using J E[rule_format, THEN sets.sets_into_space] + by (auto simp: prod_emb_iff PiE_def Pi_iff split: if_split_asm) blast+ + also have "emeasure (Pi\<^sub>M I M) (\\<^sub>E j\I. if j \ J-{i} then E j else space (M j)) = + (\ j\I. if j \ J-{i} then emeasure (M j) (E j) else emeasure (M j) (space (M j)))" + using E by (subst insert) (auto intro!: prod.cong) + also have "(\j\I. if j \ J - {i} then emeasure (M j) (E j) else emeasure (M j) (space (M j))) * + emeasure (M i) (if i \ J then E i else space (M i)) = (\j\insert i I. ?f J E j)" + using insert by (auto simp: mult.commute intro!: arg_cong2[where f="(*)"] prod.cong) + also have "\ = (\j\J \ ?I. ?f J E j)" + using insert(1,2) J E by (intro prod.mono_neutral_right) auto + finally show "?\ ?p = \" . + + show "prod_emb (insert i I) M J (Pi\<^sub>E J E) \ Pow (\\<^sub>E i\insert i I. space (M i))" + using J E[rule_format, THEN sets.sets_into_space] by (auto simp: prod_emb_iff PiE_def) + next + show "positive (sets (Pi\<^sub>M (insert i I) M)) ?\" "countably_additive (sets (Pi\<^sub>M (insert i I) M)) ?\" + using emeasure_positive[of ?P] emeasure_countably_additive[of ?P] by simp_all + next + show "(insert i I \ {} \ insert i I = {}) \ finite (insert i I) \ + insert i I \ insert i I \ A \ (\ j\insert i I. sets (M j))" + using insert by auto + qed (auto intro!: prod.cong) + with insert show ?case + by (subst (asm) prod_emb_PiE_same_index) (auto intro!: sets.sets_into_space) +qed simp + + +lemma (in finite_product_s_finite) measure_times: + "(\i. i \ I \ A i \ sets (M i)) \ emeasure (Pi\<^sub>M I M) (Pi\<^sub>E I A) = (\i\I. emeasure (M i) (A i))" + using emeasure_PiM[OF finite_index] by auto + +lemma (in product_s_finite) nn_integral_empty: + "0 \ f (\k. undefined) \ integral\<^sup>N (Pi\<^sub>M {} M) f = f (\k. undefined)" + by (simp add: PiM_empty nn_integral_count_space_finite) + +text \ Every s-finite measure is represented as the push-forward measure of a $\sigma$-finite measure.\ +definition Mi_to_NM :: "(nat \ 'a measure) \ 'a measure \ (nat \ 'a) measure" where +"Mi_to_NM Mi M \ measure_of (space (count_space UNIV \\<^sub>M M)) (sets (count_space UNIV \\<^sub>M M)) (\A. \i. distr (Mi i) (count_space UNIV \\<^sub>M M) (\x. (i,x)) A)" + +lemma + shows sets_Mi_to_NM[measurable_cong,simp]: "sets (Mi_to_NM Mi M) = sets (count_space UNIV \\<^sub>M M)" + and space_Mi_to_NM[simp]: "space (Mi_to_NM Mi M) = space (count_space UNIV \\<^sub>M M)" + by(simp_all add: Mi_to_NM_def) + +context + fixes M :: "'a measure" and Mi :: "nat \ 'a measure" + assumes sets_Mi[measurable_cong,simp]: "\i. sets (Mi i) = sets M" + and emeasure_Mi: "\A. A \ sets M \ M A = (\i. Mi i A)" +begin + +lemma emeasure_Mi_to_NM: + assumes [measurable]: "A \ sets (count_space UNIV \\<^sub>M M)" + shows "emeasure (Mi_to_NM Mi M) A = (\i. distr (Mi i) (count_space UNIV \\<^sub>M M) (\x. (i,x)) A)" +proof(rule emeasure_measure_of[where \="space (count_space UNIV \\<^sub>M M)" and A="sets (count_space UNIV \\<^sub>M M)"]) + show "countably_additive (sets (Mi_to_NM Mi M)) (\A. \i. emeasure (distr (Mi i) (count_space UNIV \\<^sub>M M) (Pair i)) A)" + unfolding countably_additive_def + proof safe + fix A :: "nat \ (nat \ _) set" + assume "range A \ sets (Mi_to_NM Mi M)" and dA:"disjoint_family A" + hence [measurable]: "\i. A i \ sets (count_space UNIV \\<^sub>M M)" + by auto + show "(\j i. emeasure (distr (Mi i) (count_space UNIV \\<^sub>M M) (Pair i)) (A j)) = (\i. emeasure (distr (Mi i) (count_space UNIV \\<^sub>M M) (Pair i)) (\ (range A)))" (is "?lhs = ?rhs") + proof - + have "?lhs = (\i j. emeasure (distr (Mi i) (count_space UNIV \\<^sub>M M) (Pair i)) (A j))" + by(auto simp: nn_integral_count_space_nat[symmetric] pair_sigma_finite_def sigma_finite_measure_count_space intro!: pair_sigma_finite.Fubini') + also have "... = ?rhs" + proof(rule suminf_cong) + fix n + have [simp]:"Pair n -` \ (range A) = (\ (range (\j. Pair n -` A j)))" + by auto + show " (\j. emeasure (distr (Mi n) (count_space UNIV \\<^sub>M M) (Pair n)) (A j)) = emeasure (distr (Mi n) (count_space UNIV \\<^sub>M M) (Pair n)) (\ (range A))" + using dA by(fastforce intro!: suminf_emeasure simp: disjoint_family_on_def emeasure_distr) + qed + finally show ?thesis . + qed + qed +qed(auto simp: positive_def sets.space_closed Mi_to_NM_def) + +lemma sigma_finite_Mi_to_NM_measure: + assumes "\i. finite_measure (Mi i)" + shows "sigma_finite_measure (Mi_to_NM Mi M)" +proof - + { + fix n + assume "emeasure (Mi_to_NM Mi M) ({n} \ space M) = \" + moreover have "emeasure (Mi_to_NM Mi M) ({n} \ space M) = emeasure (Mi n) (space M)" + by(simp add: emeasure_Mi_to_NM emeasure_distr suminf_offset[of _ "Suc n"]) + ultimately have False + using finite_measure.finite_emeasure_space[OF assms[of n]] by(auto simp: sets_eq_imp_space_eq[OF sets_Mi]) + } + thus ?thesis + by(auto intro!: exI[where x="\i. {{i} \ space M}"] simp: space_pair_measure sigma_finite_measure_def) +qed + + +lemma distr_Mi_to_NM_M: "distr (Mi_to_NM Mi M) M snd = M" +proof - + have [simp]:"Pair i -` snd -` A \ Pair i -` space (count_space UNIV \\<^sub>M M) = A" if "A \ sets M" for A and i :: nat + using sets.sets_into_space[OF that] by(auto simp: space_pair_measure) + show ?thesis + by(auto intro!: measure_eqI simp: emeasure_distr emeasure_Mi_to_NM emeasure_Mi) +qed + +end + +context + fixes \ :: "'a measure" + assumes standard_borel_ne: "standard_borel_ne \" + and s_finite: "s_finite_measure \" +begin + +interpretation \ : s_finite_measure \ by fact + +interpretation n_\: standard_borel_ne "count_space (UNIV :: nat set) \\<^sub>M \" + by (simp add: pair_standard_borel_ne standard_borel_ne) + +lemma exists_push_forward: + "\(\' :: real measure) f. f \ borel \\<^sub>M \ \ sets \' = sets borel \ sigma_finite_measure \' + \ distr \' \ f = \" +proof - + obtain \i where \i: "\i. sets (\i i) = sets \" "\i. finite_measure (\i i)" "\A. \ A = (\i. \i i A)" + by(metis \.finite_measures') + show ?thesis + proof(safe intro!: exI[where x="distr (Mi_to_NM \i \) borel n_\.to_real"] exI[where x="snd \ n_\.from_real"]) + have [simp]:"distr (distr (Mi_to_NM \i \) borel n_\.to_real) (count_space UNIV \\<^sub>M \) n_\.from_real = Mi_to_NM \i \" + by(auto simp: distr_distr comp_def intro!:distr_id') + show "sigma_finite_measure (distr (Mi_to_NM \i \) borel n_\.to_real)" + by(rule sigma_finite_measure_distr[where N="count_space UNIV \\<^sub>M \" and f=n_\.from_real]) (auto intro!: sigma_finite_Mi_to_NM_measure \i) + next + have [simp]: "distr (Mi_to_NM \i \) \ (snd \ n_\.from_real \ n_\.to_real) = distr (Mi_to_NM \i \) \ snd" + by(auto intro!: distr_cong[OF refl]) + show "distr (distr (Mi_to_NM \i \) borel n_\.to_real) \ (snd \ n_\.from_real) = \" + by(auto simp: distr_distr distr_Mi_to_NM_M[OF \i(1,3)]) + qed auto +qed + +abbreviation "\'_and_f \ (SOME (\'::real measure,f). f \ borel \\<^sub>M \ \ sets \' = sets borel \ sigma_finite_measure \' \ distr \' \ f = \)" + +definition "sigma_pair_\ \ fst \'_and_f" +definition "sigma_pair_f \ snd \'_and_f" + +lemma + shows sigma_pair_f_measurable : "sigma_pair_f \ borel \\<^sub>M \" (is ?g1) + and sets_sigma_pair_\: "sets sigma_pair_\ = sets borel" (is ?g2) + and sigma_finite_sigma_pair_\: "sigma_finite_measure sigma_pair_\" (is ?g3) + and distr_sigma_pair: "distr sigma_pair_\ \ sigma_pair_f = \" (is ?g4) +proof - + have "case \'_and_f of (\',f) \ f \ borel \\<^sub>M \ \ sets \' = sets borel \ sigma_finite_measure \' \ distr \' \ f = \" + by(rule someI_ex) (use exists_push_forward in auto) + then show ?g1 ?g2 ?g3 ?g4 + by(auto simp: sigma_pair_\_def sigma_pair_f_def split_beta) +qed + +end + +definition s_finite_measure_algebra :: "'a measure \ 'a measure measure" where + "s_finite_measure_algebra K = + (SUP A \ sets K. vimage_algebra {M. s_finite_measure M \ sets M = sets K} (\M. emeasure M A) borel)" + +lemma space_s_finite_measure_algebra: + "space (s_finite_measure_algebra K) = {M. s_finite_measure M \ sets M = sets K}" + by (auto simp add: s_finite_measure_algebra_def space_Sup_eq_UN) + +lemma s_finite_measure_algebra_cong: "sets M = sets N \ s_finite_measure_algebra M = s_finite_measure_algebra N" + by (simp add: s_finite_measure_algebra_def) + +lemma measurable_emeasure_s_finite_measure_algebra[measurable]: + "a \ sets A \ (\M. emeasure M a) \ borel_measurable (s_finite_measure_algebra A)" + by (auto intro!: measurable_Sup1 measurable_vimage_algebra1 simp: s_finite_measure_algebra_def) + +lemma measurable_measure_s_finite_measure_algebra[measurable]: + "a \ sets A \ (\M. measure M a) \ borel_measurable (s_finite_measure_algebra A)" + unfolding measure_def by measurable + +lemma s_finite_measure_algebra_measurableD: + assumes N: "N \ measurable M (s_finite_measure_algebra S)" and x: "x \ space M" + shows "space (N x) = space S" + and "sets (N x) = sets S" + and "measurable (N x) K = measurable S K" + and "measurable K (N x) = measurable K S" + using measurable_space[OF N x] + by (auto simp: space_s_finite_measure_algebra intro!: measurable_cong_sets dest: sets_eq_imp_space_eq) + +context + fixes K M N assumes K: "K \ measurable M (s_finite_measure_algebra N)" +begin + +lemma s_finite_measure_algebra_kernel: "a \ space M \ s_finite_measure (K a)" + using measurable_space[OF K] by (simp add: space_s_finite_measure_algebra) + +lemma s_finite_measure_algebra_sets_kernel: "a \ space M \ sets (K a) = sets N" + using measurable_space[OF K] by (simp add: space_s_finite_measure_algebra) + +lemma measurable_emeasure_kernel_s_finite_measure_algebra[measurable]: + "A \ sets N \ (\a. emeasure (K a) A) \ borel_measurable M" + using measurable_compose[OF K measurable_emeasure_s_finite_measure_algebra] . + +end + +lemma measurable_s_finite_measure_algebra: + "(\a. a \ space M \ s_finite_measure (K a)) \ + (\a. a \ space M \ sets (K a) = sets N) \ + (\A. A \ sets N \ (\a. emeasure (K a) A) \ borel_measurable M) \ + K \ measurable M (s_finite_measure_algebra N)" + by (auto intro!: measurable_Sup2 measurable_vimage_algebra2 simp: s_finite_measure_algebra_def) + +definition bind_kernel :: "'a measure \ ('a \ 'b measure) \ 'b measure" (infixl "\\<^sub>k" 54) where +"bind_kernel M k = (if space M = {} then count_space {} else + let Y = k (SOME x. x \ space M) in + measure_of (space Y) (sets Y) (\B. \\<^sup>+x. (k x B) \M))" + +lemma bind_kernel_cong_All: + assumes "\x. x \ space M \ f x = g x" + shows "M \\<^sub>k f = M \\<^sub>k g" +proof(cases "space M = {}") + case 1:False + have "(SOME x. x \ space M) \ space M" + by (rule someI_ex) (use 1 in blast) + with assms have [simp]:"f (SOME x. x \ space M) = g (SOME x. x \ space M)" by simp + have "(\B. \\<^sup>+ x. emeasure (f x) B \M) = (\B. \\<^sup>+ x. emeasure (g x) B \M)" + by standard (auto intro!: nn_integral_cong simp: assms) + thus ?thesis + by(auto simp: bind_kernel_def 1) +qed(simp add: bind_kernel_def) + +lemma sets_bind_kernel: + assumes "\x. x \ space M \ sets (k x) = sets N" "space M \ {}" + shows "sets (M \\<^sub>k k) = sets N" +proof - + have "sets (k (SOME x. x \ space M)) = sets N" + by(rule someI2_ex) (use assms in auto) + with sets_eq_imp_space_eq[OF this] show ?thesis + by(simp add: bind_kernel_def assms(2)) +qed + +subsection \ Measure Kernel \ +locale measure_kernel = + fixes X :: "'a measure" and Y :: "'b measure" and \ :: "'a \ 'b measure" + assumes kernel_sets[measurable_cong]: "\x. x \ space X \ sets (\ x) = sets Y" + and emeasure_measurable[measurable]: "\B. B \ sets Y \ (\x. emeasure (\ x) B) \ borel_measurable X" + and Y_not_empty: "space X \ {} \ space Y \ {}" +begin + +lemma kernel_space :"\x. x \ space X \ space (\ x) = space Y" + by (meson kernel_sets sets_eq_imp_space_eq) + +lemma measure_measurable: + assumes "B \ sets Y" + shows "(\x. measure (\ x) B) \ borel_measurable X" + using emeasure_measurable[OF assms] by (simp add: Sigma_Algebra.measure_def) + +lemma set_nn_integral_measure: + assumes [measurable_cong]: "sets \ = sets X" and [measurable]: "A \ sets X" "B \ sets Y" + defines "\ \ measure_of (space Y) (sets Y) (\B. \\<^sup>+x\A. (\ x B) \\)" + shows "\ B = (\\<^sup>+x\A. (\ x B) \\)" +proof - + have nu_sets[measurable_cong]: "sets \ = sets Y" + by(simp add: \_def) + have "positive (sets Y) (\B. \\<^sup>+x\A. (\ x B) \\)" + by(simp add: positive_def) + moreover have "countably_additive (sets Y) (\B. \\<^sup>+x\A. (\ x B) \\)" + unfolding countably_additive_def + proof safe + fix C :: "nat \ _" + assume h:"range C \ sets Y" "disjoint_family C" + thus "(\i. \\<^sup>+x\A. (\ x) (C i)\\) = (\\<^sup>+x\A. (\ x) (\ (range C))\\)" + by(auto intro!: nn_integral_cong simp: sets_eq_imp_space_eq[OF assms(1)] kernel_sets suminf_emeasure nn_integral_suminf[symmetric]) + qed + ultimately show ?thesis + using \_def assms(3) emeasure_measure_of_sigma sets.sigma_algebra_axioms by blast +qed + +corollary nn_integral_measure: + assumes "sets \ = sets X" "B \ sets Y" + defines "\ \ measure_of (space Y) (sets Y) (\B. \\<^sup>+x. (\ x B) \\)" + shows "\ B = (\\<^sup>+x. (\ x B) \\)" + using set_nn_integral_measure[OF assms(1) sets.top assms(2)] + by(simp add: \_def sets_eq_imp_space_eq[OF assms(1),symmetric]) + +lemma distr_measure_kernel: + assumes [measurable]:"f \ Y \\<^sub>M Z" + shows "measure_kernel X Z (\x. distr (\ x) Z f)" + unfolding measure_kernel_def +proof safe + fix B + assume B[measurable]: "B \ sets Z" + show "(\x. emeasure (distr (\ x) Z f) B) \ borel_measurable X" + by(rule measurable_cong[where g= "(\x. \ x (f -` B \ space Y))",THEN iffD2]) (auto simp: emeasure_distr sets_eq_imp_space_eq[OF kernel_sets]) +next + show "\x. space Z = {} \ x \ space X \ x \ {}" + by (metis Y_not_empty assms measurable_empty_iff) +qed auto + +lemma measure_kernel_comp: + assumes [measurable]: "f \ W \\<^sub>M X" + shows "measure_kernel W Y (\x. \ (f x))" + using measurable_space[OF assms] kernel_sets Y_not_empty + by(auto simp: measure_kernel_def) + +lemma emeasure_bind_kernel: + assumes "sets \ = sets X" "B \ sets Y" "space X \ {}" + shows "(\ \\<^sub>k \) B = (\\<^sup>+x. (\ x B) \\)" +proof - + have "sets (\ (SOME x. x \ space \)) = sets Y" + by(rule someI2_ex) (use assms(3) kernel_sets sets_eq_imp_space_eq[OF assms(1)] in auto) + with sets_eq_imp_space_eq[OF this] show ?thesis + by(simp add: bind_kernel_def sets_eq_imp_space_eq[OF assms(1) ]assms(3) nn_integral_measure[OF assms(1,2)]) +qed + +lemma measure_bind_kernel: + assumes [measurable_cong]:"sets \ = sets X" and [measurable]:"B \ sets Y" "space X \ {}" "AE x in \. \ x B < \" + shows "measure (\ \\<^sub>k \) B = (\x. measure (\ x) B \\)" + using assms(4) by(auto simp: emeasure_bind_kernel[OF assms(1-3)] measure_def integral_eq_nn_integral intro!: arg_cong[of _ _ enn2real] nn_integral_cong_AE) + +lemma sets_bind_kernel: + assumes "space X \ {}" "sets \ = sets X" + shows "sets (\ \\<^sub>k \) = sets Y" + using sets_bind_kernel[of \ \, OF kernel_sets,simplified sets_eq_imp_space_eq[OF assms(2)]] + by(auto simp: assms(1)) + +lemma distr_bind_kernel: + assumes "space X \ {}" and [measurable_cong]:"sets \ = sets X" and [measurable]: "f \ Y \\<^sub>M Z" + shows "distr (\ \\<^sub>k \) Z f = \ \\<^sub>k (\x. distr (\ x) Z f)" +proof - + { + fix A + assume A[measurable]:"A \ sets Z" + have sets[measurable_cong]:"sets (\ \\<^sub>k \) = sets Y" + by(rule sets_bind_kernel[OF assms(1,2)]) + have "emeasure (distr (\ \\<^sub>k \) Z f) A = emeasure (\ \\<^sub>k (\x. distr (\ x) Z f)) A" (is "?lhs = ?rhs") + proof - + have "?lhs = (\\<^sup>+ x. emeasure (\ x) (f -` A \ space Y) \\)" + by(simp add: emeasure_distr sets_eq_imp_space_eq[OF sets] emeasure_bind_kernel[OF assms(2) _ assms(1)]) + also have "... = (\\<^sup>+ x. emeasure (distr (\ x) Z f) A \\)" + by(auto simp: emeasure_distr sets_eq_imp_space_eq[OF assms(2)] sets_eq_imp_space_eq[OF kernel_sets] intro!: nn_integral_cong) + also have "... = ?rhs" + by(simp add: measure_kernel.emeasure_bind_kernel[OF distr_measure_kernel[OF assms(3)] assms(2) _ assms(1)]) + finally show ?thesis . + qed + } + thus ?thesis + by(auto intro!: measure_eqI simp: measure_kernel.sets_bind_kernel[OF distr_measure_kernel[OF assms(3)] assms(1,2)]) +qed + +lemma bind_kernel_distr: + assumes [measurable]: "f \ W \\<^sub>M X" and "space W \ {}" + shows "distr W X f \\<^sub>k \ = W \\<^sub>k (\x. \ (f x))" +proof - + have X: "space X \ {}" + using measurable_space[OF assms(1)] assms(2) by auto + show ?thesis + by(rule measure_eqI, insert X) (auto simp: sets_bind_kernel[OF X] measure_kernel.sets_bind_kernel[OF measure_kernel_comp[OF assms(1)] assms(2) refl] emeasure_bind_kernel nn_integral_distr measure_kernel.emeasure_bind_kernel[OF measure_kernel_comp[OF assms(1)] refl _ assms(2)]) +qed + +lemma bind_kernel_return: + assumes "x \ space X" + shows "return X x \\<^sub>k \ = \ x" +proof - + have X: "space X \ {}" + using assms by auto + show ?thesis + by(rule measure_eqI) (auto simp: sets_bind_kernel[OF X sets_return] kernel_sets[OF assms] emeasure_bind_kernel[OF sets_return,simplified,OF _ X] nn_integral_return[OF assms]) +qed + +lemma kernel_nn_integral_measurable: + assumes "f \ borel_measurable Y" + shows "(\x. \\<^sup>+ y. f y \(\ x)) \ borel_measurable X" + using assms +proof induction + case (cong f g) + then show ?case + by(auto intro!: measurable_cong[where f="\x. \\<^sup>+ y. f y \(\ x)" and g= "\x. \\<^sup>+ y. g y \(\ x)",THEN iffD2] nn_integral_cong simp: sets_eq_imp_space_eq[OF kernel_sets]) +next + case (set A) + then show ?case + by(auto intro!: measurable_cong[where f="\x. integral\<^sup>N (\ x) (indicator A)" and g="\x. \ x A",THEN iffD2]) +next + case (mult u c) + then show ?case + by(auto intro!: measurable_cong[where f="\x. \\<^sup>+ y. c * u y \\ x" and g="\x. c * \\<^sup>+ y. u y \\ x",THEN iffD2] simp: nn_integral_cmult) +next + case (add u v) + then show ?case + by(auto intro!: measurable_cong[where f="\x. \\<^sup>+ y. v y + u y \\ x" and g="\x. (\\<^sup>+ y. v y \\ x) + (\\<^sup>+ y. u y \\ x)",THEN iffD2] simp: nn_integral_add) +next + case (seq U) + then show ?case + by(intro measurable_cong[where f="\x. integral\<^sup>N (\ x) (\ range U)" and g="\x. \i. integral\<^sup>N (\ x) (U i)",THEN iffD2]) + (auto simp: nn_integral_monotone_convergence_SUP[of U,simplified SUP_apply[symmetric]]) +qed + +lemma bind_kernel_measure_kernel: + assumes "measure_kernel Y Z k'" + shows "measure_kernel X Z (\x. \ x \\<^sub>k k')" +proof(cases "space X = {}") + case True + then show ?thesis + by(auto simp: measure_kernel_def measurable_def) +next + case X:False + then have Y: "space Y \ {}" + by(simp add: Y_not_empty) + interpret k': measure_kernel Y Z k' by fact + show ?thesis + proof + fix B + assume "B \ sets Z" + with k'.emeasure_bind_kernel[OF kernel_sets,of _ B] show "(\x. emeasure (\ x \\<^sub>k k') B) \ borel_measurable X" + by(auto intro!: measurable_cong[where f="\x. emeasure (\ x \\<^sub>k k') B" and g="\x. \\<^sup>+ y. emeasure (k' y) B \\ x",THEN iffD2] kernel_nn_integral_measurable simp: sets_eq_imp_space_eq[OF kernel_sets] Y) + qed(use k'.Y_not_empty Y k'.sets_bind_kernel[OF Y kernel_sets] in auto) +qed + +lemma restrict_measure_kernel: "measure_kernel (restrict_space X A) Y \" +proof + fix B + assume "B \ sets Y" + from emeasure_measurable[OF this] show "(\x. emeasure (\ x) B) \ borel_measurable (restrict_space X A)" + using measurable_restrict_space1 by blast +qed(insert Y_not_empty,auto simp add: space_restrict_space kernel_sets) + +end + +lemma measure_kernel_cong_sets: + assumes "sets X = sets X'" "sets Y = sets Y'" + shows "measure_kernel X Y = measure_kernel X' Y'" + by standard (simp add: measure_kernel_def measurable_cong_sets[OF assms(1) refl] sets_eq_imp_space_eq[OF assms(1)] assms(2) sets_eq_imp_space_eq[OF assms(2)]) + +lemma measure_kernel_pair_countble1: + assumes "countable A" "\i. i \ A \ measure_kernel X Y (\x. k (i,x))" + shows "measure_kernel (count_space A \\<^sub>M X) Y k" + using assms by(auto simp: measure_kernel_def space_pair_measure intro!: measurable_pair_measure_countable1) + +lemma measure_kernel_empty_trivial: + assumes "space X = {}" + shows "measure_kernel X Y k" + using assms by(auto simp: measure_kernel_def measurable_def) + +subsection \ Finite Kernel \ +locale finite_kernel = measure_kernel + + assumes finite_measure_spaces: "\r<\. \x\ space X. \ x (space Y) < r" +begin + +lemma finite_measures: + assumes "x \ space X" + shows "finite_measure (\ x)" +proof- + obtain r where "\ x (space Y) < r" + using finite_measure_spaces assms by metis + then show ?thesis + by(auto intro!: finite_measureI simp: sets_eq_imp_space_eq[OF kernel_sets[OF assms]]) +qed + +end + +lemma finite_kernel_empty_trivial: "space X = {} \ finite_kernel X Y f" + by(auto simp: finite_kernel_def finite_kernel_axioms_def measure_kernel_empty_trivial intro!: exI[where x=1]) + +lemma finite_kernel_cong_sets: + assumes "sets X = sets X'" "sets Y = sets Y'" + shows "finite_kernel X Y = finite_kernel X' Y'" + by standard (auto simp: measure_kernel_cong_sets[OF assms] finite_kernel_def finite_kernel_axioms_def sets_eq_imp_space_eq[OF assms(1)] sets_eq_imp_space_eq[OF assms(2)]) + +subsection \ Sub-Probability Kernel\ +locale subprob_kernel = measure_kernel + + assumes subprob_spaces: "\x. x \ space X \ subprob_space (\ x)" +begin +lemma subprob_space: + "\x. x \ space X \ \ x (space Y) \ 1" + by (simp add: subprob_space.subprob_emeasure_le_1 subprob_spaces) + +lemma subprob_measurable[measurable]: + "\ \ X \\<^sub>M subprob_algebra Y" + by(auto intro!: measurable_subprob_algebra_generated[OF sets.sigma_sets_eq[symmetric] sets.Int_stable sets.space_closed] simp: subprob_spaces kernel_sets emeasure_measurable) + +lemma finite_kernel: "finite_kernel X Y \" + by(auto simp: finite_kernel_def finite_kernel_axioms_def intro!: measure_kernel_axioms exI[where x=2] order.strict_trans1[OF subprob_space.subprob_emeasure_le_1[OF subprob_spaces]]) + +sublocale finite_kernel + by (rule finite_kernel) + +end + +lemma subprob_kernel_def': + "subprob_kernel X Y \ \ \ \ X \\<^sub>M subprob_algebra Y" + by(auto simp: subprob_kernel.subprob_measurable subprob_kernel_def subprob_kernel_axioms_def measure_kernel_def measurable_subprob_algebra measurable_empty_iff space_subprob_algebra_empty_iff) + (auto simp: subprob_measurableD(2) subprob_space_kernel) + +lemmas subprob_kernelI = measurable_subprob_algebra[simplified subprob_kernel_def'[symmetric]] + +lemma subprob_kernel_cong_sets: + assumes "sets X = sets X'" "sets Y = sets Y'" + shows "subprob_kernel X Y = subprob_kernel X' Y'" + by standard (auto simp: subprob_kernel_def' subprob_algebra_cong[OF assms(2)] measurable_cong_sets[OF assms(1) refl]) + +lemma subprob_kernel_empty_trivial: + assumes "space X = {}" + shows "subprob_kernel X Y k" + using assms by(auto simp: subprob_kernel_def subprob_kernel_axioms_def intro!: measure_kernel_empty_trivial) + +lemma bind_kernel_bind: + assumes "f \ M \\<^sub>M subprob_algebra N" + shows "M \\<^sub>k f = M \ f" +proof(cases "space M = {}") + case True + then show ?thesis + by(simp add: bind_kernel_def bind_def) +next + case h:False + interpret subprob_kernel M N f + using assms(1) by(simp add: subprob_kernel_def') + show ?thesis + by(rule measure_eqI,insert sets_kernel[OF assms]) (auto simp: h sets_bind_kernel emeasure_bind_kernel[OF refl _ h] emeasure_bind[OF h assms]) +qed + +lemma(in measure_kernel) subprob_kernel_sum: + assumes "\x. x \ space X \ finite_measure (\ x)" + obtains ki where "\i. subprob_kernel X Y (ki i)" "\A x. x \ space X \ \ x A = (\i. ki i x A)" +proof - + obtain u where u: "\x. x \ space X \ u x < \" "\x. x \ space X \ u x = \ x (space Y)" + using finite_measure.emeasure_finite[OF assms] + by (simp add: top.not_eq_extremum) + have [measurable]: "u \ borel_measurable X" + by(simp cong: measurable_cong add: u(2)) + define ki where "ki \ (\i x. if i < nat \enn2real (u x)\ then scale_measure (1 / ennreal (real_of_int \enn2real (u x)\)) (\ x) else (sigma (space Y) (sets Y)))" + have 1:"\i x. x \ space X \ sets (ki i x) = sets Y" + by(auto simp: ki_def kernel_sets) + have "subprob_kernel X Y (ki i)" for i + proof - + { + fix i B + assume [measurable]: "B \ sets Y" + have "(\x. emeasure (ki i x) B) = (\x. if i < nat \enn2real (u x)\ then (1 / ennreal (real_of_int \enn2real (u x)\)) * emeasure (\ x) B else 0)" + by(auto simp: ki_def emeasure_sigma) + also have "... \ borel_measurable X" + by simp + finally have "(\x. emeasure (ki i x) B) \ borel_measurable X" . + } + moreover { + fix i x + assume x:"x \ space X" + have "emeasure (ki i x) (space Y) \ 1" + by(cases "u x = 0",auto simp: ki_def emeasure_sigma u(2)[OF x,symmetric]) (metis u(1)[OF x,simplified] divide_ennreal_def divide_le_posI_ennreal enn2real_le le_of_int_ceiling mult.commute mult.right_neutral not_gr_zero order.strict_iff_not) + hence "subprob_space (ki i x)" + using x Y_not_empty by(fastforce intro!: subprob_spaceI simp: sets_eq_imp_space_eq[OF 1[OF x]]) + } + ultimately show ?thesis + by(auto simp: subprob_kernel_def measure_kernel_def 1 Y_not_empty subprob_kernel_axioms_def) + qed + moreover have "\ x A = (\i. ki i x A)" if x:"x \ space X" for x A + proof (cases "A \ sets Y") + case A[measurable]:True + have "emeasure (\ x) A = (\ienn2real (u x)\. emeasure (ki i x) A)" + proof(cases "u x = 0") + case True + then show ?thesis + using u(2)[OF that] by simp (metis A emeasure_eq_0 kernel_sets sets.sets_into_space sets.top x) + next + case u0:False + hence "real_of_int \enn2real (u x)\ > 0" + by (metis enn2real_nonneg ennreal_0 ennreal_enn2real_if infinity_ennreal_def linorder_not_le nat_0_iff nle_le of_int_le_0_iff of_nat_eq_0_iff real_nat_ceiling_ge u(1) x) + with u(1)[OF x] have "of_nat (nat \enn2real (u x)\) / ennreal (real_of_int \enn2real (u x)\) = 1" + by(simp add: ennreal_eq_0_iff ennreal_of_nat_eq_real_of_nat) + thus ?thesis + by(simp add: ki_def ennreal_divide_times[symmetric] mult.assoc[symmetric]) + qed + then show ?thesis + by(auto simp: suminf_offset[of "\i. emeasure (ki i x) A" "nat \enn2real (u x)\"]) (simp add: ki_def emeasure_sigma) + next + case False + then show ?thesis + using kernel_sets[OF x] 1[OF x] + by(simp add: emeasure_notin_sets) + qed + ultimately show ?thesis + using that by blast +qed + +subsection \ Probability Kernel \ +locale prob_kernel = measure_kernel + + assumes prob_spaces: "\x. x \ space X \ prob_space (\ x)" +begin + +lemma prob_space: + "\x. x \ space X \ \ x (space Y) = 1" + using kernel_space prob_space.emeasure_space_1 prob_spaces by fastforce + +lemma prob_measurable[measurable]: + "\ \ X \\<^sub>M prob_algebra Y" + by(auto intro!: measurable_prob_algebra_generated[OF sets.sigma_sets_eq[symmetric] sets.Int_stable sets.space_closed] simp: prob_spaces kernel_sets emeasure_measurable) + +lemma subprob_kernel: "subprob_kernel X Y \" + by (simp add: measurable_prob_algebraD subprob_kernel_def') + +sublocale subprob_kernel + by (simp add: subprob_kernel) + +lemma restrict_probability_kernel: + "prob_kernel (restrict_space X A) Y \" + by(auto simp: prob_kernel_def restrict_measure_kernel prob_kernel_axioms_def space_restrict_space prob_spaces) + +end + +lemma prob_kernel_def': + "prob_kernel X Y \ \ \ \ X \\<^sub>M prob_algebra Y" +proof + assume h:"\ \ X \\<^sub>M prob_algebra Y" + show "prob_kernel X Y \" + using subprob_measurableD(2)[OF measurable_prob_algebraD[OF h]] measurable_space[OF h] measurable_emeasure_kernel[OF measurable_prob_algebraD[OF h]] + by(auto simp: prob_kernel_def measure_kernel_def prob_kernel_axioms_def space_prob_algebra ) (metis prob_space.not_empty sets_eq_imp_space_eq) +qed(auto simp: prob_kernel.prob_measurable prob_kernel_def prob_kernel_axioms_def measure_kernel_def) + + +lemma bind_kernel_return'': + assumes "sets M = sets N" + shows "M \\<^sub>k return N = M" +proof(cases "space M = {}") + case True + then show ?thesis + by(simp add: bind_kernel_def space_empty[symmetric]) +next + case False + then have 1: "space N \ {}" + by(simp add: sets_eq_imp_space_eq[OF assms]) + interpret prob_kernel N N "return N" + by(simp add: prob_kernel_def') + show ?thesis + by(rule measure_eqI) (auto simp: emeasure_bind_kernel[OF assms _ 1] sets_bind_kernel[OF 1 assms] assms) +qed + +subsection\ S-Finite Kernel \ +locale s_finite_kernel = measure_kernel + + assumes s_finite_kernel_sum: "\ki. (\i. finite_kernel X Y (ki i) \ (\x\space X. \A\sets Y. \ x A = (\i. ki i x A)))" + +lemma s_finite_kernel_subI: + assumes "\x. x \ space X \ sets (\ x) = sets Y" "\i. subprob_kernel X Y (ki i)" "\x A. x \ space X \ A \ sets Y \ emeasure (\ x) A = (\i. ki i x A)" + shows "s_finite_kernel X Y \" +proof - + interpret measure_kernel X Y \ + proof + show "B \ sets Y \ (\x. emeasure (\ x) B) \ borel_measurable X" for B + using assms(2) by(simp add: assms(3) subprob_kernel_def' cong: measurable_cong) + next + show "space X \ {} \ space Y \ {}" + using assms(2)[of 0] by(auto simp: subprob_kernel_def measure_kernel_def) + qed fact + show ?thesis + by (auto simp: s_finite_kernel_def measure_kernel_axioms s_finite_kernel_axioms_def assms(2,3) intro!: exI[where x=ki] subprob_kernel.finite_kernel) +qed + +context s_finite_kernel +begin + +lemma s_finite_kernels_fin: + obtains ki where "\i. finite_kernel X Y (ki i)" "\x A. x \ space X \ \ x A = (\i. ki i x A)" +proof - + obtain ki where ki:"\i. finite_kernel X Y (ki i)" "\x A. x \ space X \ A \ sets Y \ \ x A = (\i. ki i x A)" + by(metis s_finite_kernel_sum) + hence "\ x A = (\i. ki i x A)" if "x \ space X " for x A + by(cases "A \ sets Y", insert that kernel_sets[OF that]) (auto simp: finite_kernel_def measure_kernel_def emeasure_notin_sets) + with ki show ?thesis + using that by auto +qed + +lemma s_finite_kernels: + obtains ki where "\i. subprob_kernel X Y (ki i)" "\x A. x \ space X \ \ x A = (\i. ki i x A)" +proof - + obtain ki where ki:"\i. finite_kernel X Y (ki i)" "\x A. x \ space X \ \ x A = (\i. ki i x A)" + by(metis s_finite_kernels_fin) + have "\kij. (\j. subprob_kernel X Y (kij j)) \ (\x A. x \ space X \ ki i x A = (\j. kij j x A))" for i + using measure_kernel.subprob_kernel_sum[of X Y "ki i", OF _ finite_kernel.finite_measures[OF ki(1)[of i]]] ki(1)[of i] by(metis finite_kernel_def) + then obtain kij where kij: "\i j. subprob_kernel X Y (kij i j)" "\x A i. x \ space X \ ki i x A = (\j. kij i j x A)" + by metis + have "\i. subprob_kernel X Y (case_prod kij (prod_decode i))" + using kij(1) by(auto simp: split_beta) + moreover have "x \ space X \ \ x A = (\i. case_prod kij (prod_decode i) x A)" for x A + using suminf_ennreal_2dimen[of "\i. ki i x A" "\(i,j). kij i j x A"] + by(auto simp: ki(2) kij(2) split_beta') + ultimately show ?thesis + using that by fastforce +qed + +lemma image_s_finite_measure: + assumes "x \ space X" + shows "s_finite_measure (\ x)" +proof - + obtain ki where ki:"\i. subprob_kernel X Y (ki i)" "\x A. x \ space X \ \ x A = (\i. ki i x A)" + by(metis s_finite_kernels) + show ?thesis + using ki(1)[simplified subprob_kernel_def'] measurable_space[OF ki(1)[simplified subprob_kernel_def'] assms] + by(auto intro!: s_finite_measureI[where Mi="\i. ki i x"] subprob_space.axioms(1) simp: kernel_sets[OF assms] space_subprob_algebra ki(2)[OF assms]) +qed + +corollary kernel_measurable_s_finite[measurable]:"\ \ X \\<^sub>M s_finite_measure_algebra Y" + by(auto intro!: measurable_s_finite_measure_algebra simp: kernel_sets image_s_finite_measure) + +lemma comp_measurable: + assumes f[measurable]:"f \ M \\<^sub>M X" + shows "s_finite_kernel M Y (\x. \ (f x))" +proof - + obtain ki where ki:"\i. subprob_kernel X Y (ki i)" "\x A. x \ space X \ \ x A = (\i. ki i x A)" + by(metis s_finite_kernels) + show ?thesis + using ki(1) measurable_space[OF f] by(auto intro!: s_finite_kernel_subI[where ki="\i x. ki i (f x)"] simp: subprob_kernel_def' ki(2) kernel_sets) +qed + +lemma distr_s_finite_kernel: + assumes f[measurable]: "f \ Y \\<^sub>M Z" + shows "s_finite_kernel X Z (\x. distr (\ x) Z f)" +proof - + obtain ki where ki:"\i. subprob_kernel X Y (ki i)" "\x A. x \ space X \ \ x A = (\i. ki i x A)" + by(metis s_finite_kernels) + hence 1:"x \ space X \ space (ki i x) = space Y" for x i + by(auto simp: subprob_kernel_def' intro!: subprob_measurableD(1)[of _ X Y]) + have [measurable]:"B \ sets Z \ (\x. emeasure (distr (\ x) Z f) B) \ borel_measurable X" for B + by(rule measurable_cong[where g="\x. \ x (f -` B \ space Y)", THEN iffD2]) (auto simp: emeasure_distr sets_eq_imp_space_eq[OF kernel_sets]) + show ?thesis + using ki(1) measurable_distr[OF f] by(auto intro!: s_finite_kernel_subI[where ki="\i x. distr (ki i x) Z f"] simp: subprob_kernel_def' emeasure_distr ki(2) sets_eq_imp_space_eq[OF kernel_sets] 1) +qed + +lemma comp_s_finite_measure: + assumes "s_finite_measure \" and [measurable_cong]: "sets \ = sets X" + shows "s_finite_measure (\ \\<^sub>k \)" +proof(cases "space X = {}") + case 1:True + show ?thesis + by(auto simp: sets_eq_imp_space_eq[OF assms(2)] 1 bind_kernel_def intro!: finite_measure.s_finite_measure_finite_measure finite_measureI) +next + case 0:False + then have 1: "space \ \ {}" + by(simp add: sets_eq_imp_space_eq[OF assms(2)]) + have 2: "sets (\ (SOME x. x \ space \)) = sets Y" + by(rule someI2_ex, insert 1 kernel_sets) (auto simp: sets_eq_imp_space_eq[OF assms(2)]) + have sets_bind[measurable_cong]: "sets (\ \\<^sub>k \) = sets Y" + by(simp add: bind_kernel_def 1 sets_eq_imp_space_eq[OF 2] 2) + obtain \i where mui[measurable_cong]: "\i. sets (\i i) = sets X" "\i. (\i i) (space X) \ 1" "\A. \ A = (\i. \i i A)" + using s_finite_measure.finite_measures[OF assms(1)] assms(2) sets_eq_imp_space_eq[OF assms(2)] by metis + obtain ki where ki:"\i. subprob_kernel X Y (ki i)" "\x A. x \ space X \ \ x A = (\i. ki i x A)" + by(metis s_finite_kernels) + define Mi where "Mi \ (\n. (\(i,j). measure_of (space Y) (sets Y) (\A. \\<^sup>+x. (ki i x A) \(\i j))) (prod_decode n))" + have emeasure:"(\ \\<^sub>k \) A = (\i. (Mi i) A)" (is "?lhs = ?rhs") if "A \ sets Y" for A + proof - + have "?lhs = (\\<^sup>+x. (\ x A) \\)" + by(simp add: emeasure_bind_kernel[OF assms(2) that 0]) + also have "... = (\\<^sup>+x. (\i. (ki i x A)) \\)" + by(auto intro!: nn_integral_cong simp: ki sets_eq_imp_space_eq[OF assms(2)]) + also have "... = (\i. \\<^sup>+x. (ki i x A) \\)" + by(auto intro!: nn_integral_suminf) (metis ki(1) assms(2) measurable_cong_sets measure_kernel.emeasure_measurable subprob_kernel_def that) + also have "... = ?rhs" + unfolding Mi_def + proof(rule suminf_ennreal_2dimen[symmetric]) + fix m + interpret kim: subprob_kernel X Y "ki m" + by(simp add: ki) + show "(\\<^sup>+ x. (ki m x) A \\) = (\n. emeasure (case (m, n) of (i, j) \ measure_of (space Y) (sets Y) (\A. \\<^sup>+ x. emeasure (ki i x) A \\i j)) A)" + using kim.emeasure_measurable[OF that] by(simp add: kim.nn_integral_measure[OF mui(1) that] nn_integral_measure_suminf[OF mui(1)[simplified assms(2)[symmetric]] mui(3)]) + qed + finally show ?thesis . + qed + have fin:"finite_measure (Mi i)" for i + proof(rule prod.exhaust[where y="prod_decode i"]) + fix j1 j2 + interpret kij: subprob_kernel X Y "ki j1" + by(simp add: ki) + assume pd:"prod_decode i = (j1, j2)" + have "Mi i (space (Mi i)) = (\\<^sup>+x. (ki j1 x (space Y)) \\i j2)" + by(auto simp: Mi_def pd kij.nn_integral_measure[OF mui(1) sets.top]) + also have "... \ (\\<^sup>+x. 1 \\i j2)" + by(intro nn_integral_mono) (metis kij.subprob_space mui(1) sets_eq_imp_space_eq) + also have "... \ 1" + using mui by (simp add: sets_eq_imp_space_eq[OF mui(1)]) + finally show "finite_measure (Mi i)" + by (metis ennreal_one_less_top finite_measureI infinity_ennreal_def less_le_not_le) + qed + have 3: "sets (Mi i) = sets (\ \\<^sub>k \)" for i + by(simp add: Mi_def split_beta sets_bind) + show "s_finite_measure (\ \\<^sub>k \)" + using emeasure fin 3 by (auto intro!: exI[where x=Mi] simp: s_finite_measure_def sets_bind) +qed + +end + +lemma s_finite_kernel_empty_trivial: + assumes "space X = {}" + shows "s_finite_kernel X Y k" + using assms by(auto simp: s_finite_kernel_def s_finite_kernel_axioms_def intro!: measure_kernel_empty_trivial finite_kernel_empty_trivial) + +lemma s_finite_kernel_def': "s_finite_kernel X Y \ \ ((\x. x \ space X \ sets (\ x) = sets Y) \ (\ki. (\i. subprob_kernel X Y (ki i)) \ (\x A. x \ space X \ A \ sets Y \ emeasure (\ x) A = (\i. ki i x A))))" (is "?l \ ?r") +proof + assume ?l + then interpret s_finite_kernel X Y \ . + from s_finite_kernels obtain ki where ki:"\i. subprob_kernel X Y (ki i)" "\x A. x \ space X \ emeasure (\ x) A = (\i. emeasure (ki i x) A)" + by metis + thus ?r + by(auto simp: kernel_sets) +qed(auto intro!: s_finite_kernel_subI) + +lemma(in finite_kernel) s_finite_kernel_finite_kernel: "s_finite_kernel X Y \" +proof + consider "space X = {}" | "space X \ {}" by auto + then show "\ki. \i. finite_kernel X Y (ki i) \ (\x\space X. \A\sets Y. (\ x) A = (\i. (ki i x) A))" + proof cases + case 1 + then show ?thesis + by(auto simp: finite_kernel_def measure_kernel_def finite_kernel_axioms_def measurable_def intro!: exI[where x=0]) + next + case 2 + then have y:"space Y \ {}" by(simp add: Y_not_empty) + define ki where "ki i \ case i of 0 \ \ | Suc _ \ (\_. sigma (space Y) (sets Y))" for i + have "finite_kernel X Y (ki i)" for i + by (cases i, auto simp: ki_def finite_kernel_axioms) (auto simp: emeasure_sigma finite_kernel_def measure_kernel_def finite_kernel_axioms_def y intro!: finite_measureI exI[where x=1]) + moreover have "(\ x) A = (\i. (ki i x) A)" for x A + by(simp add: suminf_offset[where i="Suc 0" and f="\i. ki i x A",simplified],simp add: ki_def emeasure_sigma) + ultimately show ?thesis by auto + qed +qed + +lemmas(in subprob_kernel) s_finite_kernel_subprob_kernel = s_finite_kernel_finite_kernel +lemmas(in prob_kernel) s_finite_kernel_prob_kernel = s_finite_kernel_subprob_kernel + +sublocale finite_kernel \ s_finite_kernel + by(rule s_finite_kernel_finite_kernel) + +lemma s_finite_kernel_cong_sets: + assumes "sets X = sets X'" "sets Y = sets Y'" + shows "s_finite_kernel X Y = s_finite_kernel X' Y'" + by standard (simp add: s_finite_kernel_def measurable_cong_sets[OF assms(1) refl] sets_eq_imp_space_eq[OF assms(1)] assms(2) measure_kernel_cong_sets[OF assms] s_finite_kernel_axioms_def finite_kernel_cong_sets[OF assms]) + +lemma(in s_finite_kernel) s_finite_kernel_cong: + assumes "\x. x \ space X \ \ x = g x" + shows "s_finite_kernel X Y g" + using assms s_finite_kernel_axioms by(auto simp: s_finite_kernel_def s_finite_kernel_axioms_def measure_kernel_def cong: measurable_cong) + +lemma(in s_finite_measure) s_finite_kernel_const: + assumes "space M \ {}" + shows "s_finite_kernel X M (\x. M)" +proof + obtain Mi where Mi:"\i. sets (Mi i) = sets M" "\i. (Mi i) (space M) \ 1" "\A. M A = (\i. Mi i A)" + by(metis finite_measures) + hence "\i. subprob_kernel X M (\x. Mi i)" + by(auto simp: subprob_kernel_def' space_subprob_algebra sets_eq_imp_space_eq[OF Mi(1)] assms intro!:measurable_const subprob_spaceI) + thus "\ki. \i. finite_kernel X M (ki i) \ (\x\space X. \A\sets M. M A = (\i. (ki i x) A))" + by(auto intro!: exI[where x="\i x. Mi i"] Mi(3) subprob_kernel.finite_kernel) +qed (auto simp: assms) + +lemma s_finite_kernel_pair_countble1: + assumes "countable A" "\i. i \ A \ s_finite_kernel X Y (\x. k (i,x))" + shows "s_finite_kernel (count_space A \\<^sub>M X) Y k" +proof - + have "\ki. (\j. subprob_kernel X Y (ki j)) \ (\x B. x \ space X \ B \ sets Y \ k (i,x) B = (\j. ki j x B))" if "i \ A" for i + using s_finite_kernel.s_finite_kernels[OF assms(2)[OF that]] by metis + then obtain ki where ki:"\i j. i \ A \ subprob_kernel X Y (ki i j)" "\i x B. i \ A \ x \ space X \ B \ sets Y \ k (i,x) B = (\j. ki i j x B)" + by metis + then show ?thesis + using assms(2) by(auto simp: s_finite_kernel_def' measure_kernel_pair_countble1[OF assms(1)] subprob_kernel_def' space_pair_measure intro!: exI[where x="\j (i,x). ki i j x"] measurable_pair_measure_countable1 assms(1)) +qed + +lemma s_finite_kernel_s_finite_kernel: + assumes "\i. s_finite_kernel X Y (ki i)" "\x. x \ space X \ sets (k x) = sets Y" "\x A. x \ space X \ A \ sets Y \ emeasure (k x) A = (\i. (ki i) x A)" + shows "s_finite_kernel X Y k" +proof - + have "\kij. (\j. subprob_kernel X Y (kij j)) \ (\x A. x \ space X \ ki i x A = (\j. kij j x A))" for i + using s_finite_kernel.s_finite_kernels[OF assms(1)[of i]] by metis + then obtain kij where kij:"\i j. subprob_kernel X Y (kij i j)" "\i x A. x \ space X \ ki i x A = (\j. kij i j x A)" + by metis + define ki' where "ki' \ (\n. case_prod kij (prod_decode n))" + have emeasure_sumk':"emeasure (k x) A = (\i. emeasure (ki' i x) A)" if x:"x \ space X" and A: "A \ sets Y" for x A + by(auto simp: assms(3)[OF that] kij(2)[OF x] ki'_def intro!: suminf_ennreal_2dimen[symmetric]) + have "subprob_kernel X Y (ki' i)" for i + using kij(1) by(auto simp: ki'_def split_beta') + thus ?thesis + by(auto simp: s_finite_kernel_def' measure_kernel_def assms(2) s_finite_kernel_axioms_def emeasure_sumk' intro!: exI[where x=ki']) +qed + +lemma s_finite_kernel_finite_sumI: + assumes [measurable_cong]: "\x. x \ space X \ sets (\ x) = sets Y" + and "\i. i \ I \ subprob_kernel X Y (ki i)" "\x A. x \ space X \ A \ sets Y \ emeasure (\ x) A = (\i\I. ki i x A)" "finite I" "I \ {}" + shows "s_finite_kernel X Y \" +proof - + consider "space X = {}" | "space X \ {}" by auto + then show ?thesis + proof cases + case 1 + then show ?thesis + by(rule s_finite_kernel_empty_trivial) + next + case 2 + then have Y:"space Y \ {}" + using assms measure_kernel.Y_not_empty by (fastforce simp: subprob_kernel_def) + define ki' where "ki' \ (\i x. if i < card I then ki (from_nat_into I i) x else null_measure Y)" + have [simp]:"subprob_kernel X Y (ki' i)" for i + by(cases "i < card I") (simp add: ki'_def from_nat_into assms, auto simp: ki'_def subprob_kernel_def measure_kernel_def subprob_kernel_axioms_def Y intro!: subprob_spaceI) + have [simp]: "(\i. emeasure (ki' i x) A) = (\i\I. ki i x A)" for x A + using suminf_finite[of "{..i. (if i < card I then ki (from_nat_into I i) x else null_measure Y) A"] + by(auto simp: sum.reindex_bij_betw[OF bij_betw_from_nat_into_finite[OF assms(4)],symmetric] ki'_def) + have [measurable]:"B \ sets Y \ (\x. emeasure (\ x) B) \ borel_measurable X" for B + using assms(2) by(auto simp: assms(3) subprob_kernel_def' cong: measurable_cong) + show ?thesis + by (auto simp: s_finite_kernel_def' intro!: exI[where x=ki'] assms) + qed +qed + +text \ Each kernel does not need to be bounded by a uniform upper-bound in the definition of @{term s_finite_kernel} \ +lemma s_finite_kernel_finite_bounded_sum: + assumes [measurable_cong]: "\x. x \ space X \ sets (\ x) = sets Y" + and "\i. measure_kernel X Y (ki i)" "\x A. x \ space X \ A \ sets Y \ \ x A = (\i. ki i x A)" "\i x. x \ space X \ ki i x (space Y) < \" + shows "s_finite_kernel X Y \" +proof(cases "space X = {}") + case True + then show ?thesis + by(simp add: s_finite_kernel_empty_trivial) +next + case X:False + then have Y: "space Y \ {}" + using assms(2)[of 0] by(simp add: measure_kernel_def) + show ?thesis + proof(rule s_finite_kernel_s_finite_kernel[where ki=ki,OF _ assms(1) assms(3)]) + fix i + interpret m: measure_kernel X Y "ki i" by fact + define kij where "kij \ (\(j :: nat) x. if j < nat \enn2real (ki i x (space Y))\ then scale_measure (1 / ennreal \enn2real (ki i x (space Y))\) (ki i x) else sigma (space Y) (sets Y))" + have sets_kij: "sets (kij j x) = sets Y" if "x \ space X" for j x + by(auto simp: m.kernel_sets[OF that] kij_def) + have emeasure_kij: "ki i x A = (\j. kij j x A)" if "x \ space X" "A \ sets Y" for x A + proof - + have "(\j. kij j x A) = (\j< nat \enn2real (ki i x (space Y))\. scale_measure (1 / ennreal \enn2real (ki i x (space Y))\) (ki i x) A)" + by(simp add: suminf_offset[where i="nat \enn2real (ki i x (space Y))\" and f="\j. kij j x A"], simp add: kij_def emeasure_sigma) + also have "... = ki i x A" + proof(cases "nat \enn2real (ki i x (space Y))\") + case 0 + then show ?thesis + by simp (metis assms(4) emeasure_eq_0 enn2real_le ennreal_0 infinity_ennreal_def le_zero_eq linorder_not_le m.kernel_space nle_le sets.sets_into_space sets.top that) + next + case (Suc n') + then have "ennreal (real_of_int \enn2real (emeasure (ki i x) (space Y))\) > 0" + using ennreal_less_zero_iff by fastforce + with assms(4)[OF that(1),of i] have [simp]: "of_nat (nat \enn2real (emeasure (ki i x) (space Y))\) / ennreal (real_of_int \enn2real (emeasure (ki i x) (space Y))\) = 1" + by (simp add: ennreal_eq_0_iff ennreal_of_nat_eq_real_of_nat) + show ?thesis + by(simp add: mult.assoc[symmetric] ennreal_times_divide) + qed + finally show ?thesis by simp + qed + have sk: "subprob_kernel X Y (kij j)" for j + proof - + { + fix B + assume [measurable]:"B \ sets Y" + have "emeasure (kij j x) B = (if j < nat \enn2real (ki i x (space Y))\ then (ki i x) B / ennreal (real_of_int \enn2real (ki i x (space Y))\) else 0)" if "x \ space X" for x + by(auto simp: kij_def emeasure_sigma divide_ennreal_def mult.commute) + hence " (\x. emeasure (kij j x) B) \ borel_measurable X" + by(auto simp: kij_def cong: measurable_cong) + } + moreover { + fix x + assume x:"x \ space X" + have "subprob_space (kij j x)" + proof - + have "emeasure (kij j x) (space Y) \ 1" + proof - + { + assume 1:"j < nat \enn2real (emeasure (ki i x) (space Y))\" + then have "emeasure (ki i x) (space Y) > 0" + by (metis ceiling_zero enn2real_0 nat_zero_as_int not_gr_zero not_less_zero) + with assms(4)[OF x] have [simp]:"emeasure (ki i x) (space Y) / emeasure (ki i x) (space Y) = 1" + by simp + have [simp]:"emeasure (ki i x) (space Y) / ennreal (real_of_int \enn2real (ki i x (space Y))\) \ 1" + proof(rule order.trans[where b="emeasure (ki i x) (space Y) / ki i x (space Y)",OF divide_le_posI_ennreal]) + show "0 < ennreal (real_of_int \enn2real (ki i x (space Y))\)" + using 1 assms(4)[OF x] enn2real_positive_iff top.not_eq_extremum by fastforce + next + have 1:"ennreal (real_of_int \enn2real (ki i x (space Y))\) \ ki i x (space Y)" + using assms(4)[OF x] enn2real_le by (simp add: linorder_neq_iff) + have "ennreal (real_of_int \enn2real (ki i x (space Y))\) / ki i x (space Y) \ 1" + by(rule order.trans[OF _ divide_right_mono_ennreal[OF 1,of "ki i x (space Y)"]]) simp + thus "emeasure (ki i x) (space Y) \ ennreal (real_of_int \enn2real (ki i x (space Y))\) * (emeasure (ki i x) (space Y) / ki i x (space Y))" + by (simp add: "1") + qed simp + have "1 / ennreal (real_of_int \enn2real (emeasure (ki i x) (space Y))\) * emeasure (ki i x) (space Y) \ 1" + by (simp add: ennreal_divide_times) + } + thus ?thesis + by(auto simp: kij_def emeasure_sigma) + qed + thus ?thesis + by(auto intro!: subprob_spaceI simp: sets_eq_imp_space_eq[OF sets_kij[OF x,of j]] Y) + qed + } + ultimately show ?thesis + by(auto simp: subprob_kernel_def measure_kernel_def sets_kij m.Y_not_empty subprob_kernel_axioms_def) + qed + show "s_finite_kernel X Y (ki i)" + by(auto intro!: s_finite_kernel_subI simp: emeasure_kij sk m.kernel_sets) + qed simp_all +qed + +lemma(in measure_kernel) s_finite_kernel_finite_bounded: + assumes "\x. x \ space X \ \ x (space Y) < \" + shows "s_finite_kernel X Y \" +proof(cases "space X = {}") + case True + then show ?thesis + by(simp add: s_finite_kernel_empty_trivial) +next + case False + then have Y:"space Y \ {}" by(simp add: Y_not_empty) + have "measure_kernel X Y (case i of 0 \ \ | Suc x \ \x. null_measure Y)" for i + by(cases i,auto simp: measure_kernel_axioms) (auto simp: measure_kernel_def Y) + moreover have "\ x A = (\i. emeasure ((case i of 0 \ \ | Suc x \ \x. null_measure Y) x) A)" for x A + by(simp add: suminf_offset[where i="Suc 0"]) + moreover have "x \ space X \ emeasure ((case i of 0 \ \ | Suc x \ \x. null_measure Y) x) (space Y) < \" for x i + by(cases i) (use assms in auto) + ultimately show ?thesis + by(auto intro!: s_finite_kernel_finite_bounded_sum[where ki="\i. case i of 0 \ \ | Suc _ \ (\x. null_measure Y)" and X=X and Y=Y] simp: kernel_sets) +qed + +lemma(in s_finite_kernel) density_s_finite_kernel: + assumes f[measurable]: "case_prod f \ X \\<^sub>M Y \\<^sub>M borel" + shows "s_finite_kernel X Y (\x. density (\ x) (f x))" +proof(cases "space X = {}") + case True + then show ?thesis + by(simp add: s_finite_kernel_empty_trivial) +next + case False + note Y = Y_not_empty[OF this] + obtain ki' where ki': "\i. subprob_kernel X Y (ki' i)" "\x A. x \ space X \ \ x A = (\i. ki' i x A)" + by(metis s_finite_kernels) + hence sets_ki'[measurable_cong]:"\x i. x \ space X \ sets (ki' i x) = sets Y" + by(auto simp: subprob_kernel_def measure_kernel_def) + define ki where "ki \ (\i x. density (ki' i x) (f x))" + have sets_ki: "x \ space X \ sets (ki i x) = sets Y" for i x + using ki'(1) by(auto simp: subprob_kernel_def measure_kernel_def ki_def) + have emeasure_k:"density (\ x) (f x) A = (\i. ki i x A)" if x:"x \ space X" and A[measurable]:"A \ sets Y" for x A + using kernel_sets[OF x] x ki'(1) sets_ki'[OF x] by(auto simp: emeasure_density nn_integral_measure_suminf[OF _ ki'(2),of x] ki_def) + show ?thesis + proof(rule s_finite_kernel_s_finite_kernel[where ki="ki",OF _ _ emeasure_k]) + fix i + note nn_integral_measurable_subprob_algebra2[OF _ ki'(1)[of i,simplified subprob_kernel_def'],measurable] + define kij where "kij \ (\j x. if j = 0 then density (ki' i x) (\y. \ * indicator {y\space Y. f x y = \} y) + else if j = (Suc 0) then density (ki' i x) (\y. f x y * indicator {y\space Y. f x y < \} y) + else null_measure Y)" + have emeasure_kij: "ki i x A = (\j. kij j x A)" (is "?lhs = ?rhs") if x:"x \ space X" and [measurable]: "A \ sets Y" for x A + proof - + have "?lhs = (\\<^sup>+y\A. f x y \ki' i x)" + using sets_ki[OF x,of i] x by(auto simp: ki_def emeasure_density) + also have "... = (\\<^sup>+y. (\ * indicator {y \ space Y. f x y = \} y * indicator A y + f x y * indicator {y \ space Y. f x y < \} y * indicator A y) \ki' i x)" + by(auto intro!: nn_integral_cong simp: sets_eq_imp_space_eq[OF sets_ki'[OF x]] indicator_def) (simp add: top.not_eq_extremum) + also have "... = density (ki' i x) (\y. \ * indicator {y\space Y. f x y = \} y) A + density (ki' i x) (\y. f x y * indicator {y\space Y. f x y < \} y) A" + using sets_ki[OF x,of i] x by(auto simp: ki_def emeasure_density nn_integral_add) + also have "... = ?rhs" + using suminf_finite[of "{..j. kij j x A"] by(simp add: kij_def) + finally show ?thesis . + qed + have sets_kij[measurable_cong]:"x \ space X \ sets (kij j x) = sets Y" for j x + by(auto simp: kij_def sets_ki') + show "s_finite_kernel X Y (ki i)" + proof(rule s_finite_kernel_s_finite_kernel[where ki=kij,OF _ _ emeasure_kij]) + fix j + consider "j = 0" | "j = Suc 0" | "j \ 0" "j \ Suc 0" by auto + then show "s_finite_kernel X Y (kij j)" + proof cases + case 1 + have emeasure_ki: "emeasure (kij j x) A = (\j. emeasure (density (ki' i x) (indicator {y \ space Y. f x y = \})) A)" if x:"x \ space X" and [measurable]: "A \ sets Y" for x A + using sets_ki'[OF x] x by(auto simp: 1 kij_def emeasure_density nn_integral_suminf[symmetric] indicator_def intro!: nn_integral_cong) (simp add: nn_integral_count_space_nat[symmetric]) + have [simp]:"subprob_kernel X Y (\x. density (ki' i x) (indicator {y \ space Y. f x y = \}))" + proof - + have [simp]:"x \ space X \ set_nn_integral (ki' i x) (space Y) (indicator {y \ space Y. f x y = \}) \ 1" for x + by(rule order.trans[OF nn_integral_mono[where v="\x. 1"]],insert ki'(1)[of i]) (auto simp: indicator_def subprob_kernel_def subprob_kernel_axioms_def intro!: subprob_space.emeasure_space_le_1) + show ?thesis + by(auto simp: subprob_kernel_def measure_kernel_def emeasure_density subprob_kernel_axioms_def sets_ki' sets_eq_imp_space_eq[OF sets_ki'] Y cong: measurable_cong intro!: subprob_spaceI) + qed + show ?thesis + by (auto simp: s_finite_kernel_def' sets_kij intro!: exI[where x="\k x. density (ki' i x) (indicator {y \ space Y. f x y = \})"] simp: emeasure_ki ) + next + case j:2 + have emeasure_ki: "emeasure (kij j x) A = (\k. density (ki' i x) (\y. f x y * indicator {y \ space Y. of_nat k \ f x y \ f x y < 1 + of_nat k} y) A)" if x:"x \ space X" and [measurable]:"A \ sets Y" for x A + proof - + have [simp]: "f x y * indicator {y \ space Y. f x y < \} y * indicator A y = f x y * (\k. indicator {y \ space Y. of_nat k \ f x y \ f x y < 1 + of_nat k} y) * indicator A y" if y:"y \ space Y" for y + proof(cases "f x y < \") + case f:True + define l where "l \ floor (enn2real (f x y))" + have "nat l \ enn2real (f x y)" "enn2real (f x y) < 1 + nat l" + by (simp_all add: l_def) linarith + with y have l:"of_nat (nat l) \ f x y" "f x y < 1 + of_nat (nat l)" + using Orderings.order_eq_iff enn2real_positive_iff ennreal_enn2real_if ennreal_of_nat_eq_real_of_nat linorder_not_le of_nat_0_le_iff f by fastforce+ + then have "(\j. indicator {y \ space Y. of_nat j \ f x y \ f x y < 1 + of_nat j} y :: ennreal) = (\j. if j = nat l then 1 else 0)" + by(auto intro!: suminf_cong simp: indicator_def y) (metis Suc_leI linorder_neqE_nat linorder_not_less of_nat_Suc of_nat_le_iff order_trans) + also have "... = 1" + using suminf_finite[where N="{nat l}" and f="\j. if j = nat l then 1 else (0 :: ennreal)"] by simp + finally show ?thesis + by(auto, insert f) (auto simp: indicator_def) + qed(use top.not_eq_extremum in fastforce) + show ?thesis + using sets_ki[OF x] sets_ki'[OF x] x by(auto simp: kij_def j emeasure_density nn_integral_suminf[symmetric] sets_eq_imp_space_eq[OF sets_ki'[OF x]] intro!: nn_integral_cong) + qed + show ?thesis + proof(rule s_finite_kernel_finite_bounded_sum[OF sets_kij _ emeasure_ki]) + fix k + show "measure_kernel X Y (\x. density (ki' i x) (\y. f x y * indicator {y \ space Y. of_nat k \ f x y \ f x y < 1 + of_nat k} y))" + using sets_ki'[of _ i] by(auto simp: measure_kernel_def emeasure_density Y cong: measurable_cong) + next + fix k x + assume x:"x \space X" + have "emeasure (density (ki' i x) (\y. f x y * indicator {y \ space Y. of_nat k \ f x y \ f x y < 1 + of_nat k} y)) (space Y) \ 1 + of_nat k" + by(auto simp: emeasure_density x,rule order.trans[OF nn_integral_mono[where v="\x. 1 + of_nat k"]]) (insert subprob_kernel.subprob_space[OF ki'(1)[of i] x], auto simp: indicator_def subprob_kernel_def subprob_kernel_axioms_def sets_eq_imp_space_eq[OF sets_ki'[OF x]] intro!: mult_mono[where d="1 :: ennreal",OF order.refl,simplified]) + also have "... < \" + by (simp add: of_nat_less_top) + finally show "emeasure (density (ki' i x) (\y. f x y * indicator {y \ space Y. of_nat k \ f x y \ f x y < 1 + of_nat k} y)) (space Y) < \" . + qed auto + next + case 3 + then show ?thesis + by(auto simp: kij_def s_finite_kernel_cong_sets[of X X Y,OF _ sets_null_measure[symmetric]] Y intro!: s_finite_measure.s_finite_kernel_const finite_measure.s_finite_measure_finite_measure finite_measureI) + qed + qed(auto simp: sets_ki) + qed(auto simp: kernel_sets) +qed + +lemma(in s_finite_kernel) nn_integral_measurable_f: + assumes [measurable]:"(\(x,y). f x y) \ borel_measurable (X \\<^sub>M Y)" + shows "(\x. \\<^sup>+y. f x y \(\ x)) \ borel_measurable X" +proof - + obtain \i where \i:"\i. subprob_kernel X Y (\i i)" "\x A. x \ space X \ \ x A = (\i. \i i x A)" + by(metis s_finite_kernels) + show ?thesis + proof(rule measurable_cong[THEN iffD2]) + fix x + assume "x \ space X" + with \i show "(\\<^sup>+ y. f x y \\ x) = (\i. \\<^sup>+ y. f x y \\i i x)" + by(auto intro!: nn_integral_measure_suminf[symmetric] simp: subprob_kernel_def kernel_sets measure_kernel_def) + next + show "(\x. \i. \\<^sup>+ y. f x y \\i i x) \ borel_measurable X" + using \i(1) nn_integral_measurable_subprob_algebra2[OF assms] by(simp add: subprob_kernel_def' ) + qed +qed + +lemma(in s_finite_kernel) nn_integral_measurable_f': + assumes "f \ borel_measurable (X \\<^sub>M Y)" + shows "(\x. \\<^sup>+y. f (x, y) \(\ x)) \ borel_measurable X" + using nn_integral_measurable_f[where f="curry f",simplified,OF assms] by simp + +lemma(in s_finite_kernel) bind_kernel_s_finite_kernel': + assumes "s_finite_kernel (X \\<^sub>M Y) Z (case_prod g)" + shows "s_finite_kernel X Z (\x. \ x \\<^sub>k g x)" +proof(cases "space X = {}") + case True + then show ?thesis + by (simp add: s_finite_kernel_empty_trivial) +next + case X:False + then have Y:"space Y \ {}" + by(simp add: Y_not_empty) + from s_finite_kernels obtain ki where ki: + "\i. subprob_kernel X Y (ki i)" "\x A. x \ space X \ \ x A = (\i. ki i x A)" + by metis + interpret g:s_finite_kernel "X \\<^sub>M Y" Z "case_prod g" by fact + from g.s_finite_kernels[simplified space_pair_measure] obtain gi where gi: + "\i. subprob_kernel (X \\<^sub>M Y) Z (gi i)" "\x y A. x \ space X \ y \ space Y \ g x y A = (\i. gi i (x,y) A)" + by auto metis + define kgi where "kgi = (\i x. case prod_decode i of (i,j) \ (ki j x \ curry (gi i) x))" + have emeasure:"emeasure (\ x \\<^sub>k g x) A = (\i. emeasure (kgi i x) A)" (is "?lhs = ?rhs") if x:"x \ space X" and A:"A \ sets Z" for x A + proof - + interpret gx: s_finite_kernel Y Z "g x" + using g.comp_measurable[OF measurable_Pair1'[OF x]] by auto + have "?lhs = (\\<^sup>+ y. g x y A \\ x)" + using gx.emeasure_bind_kernel[OF kernel_sets[OF x] A] + by(auto simp: sets_eq_imp_space_eq[OF kernel_sets[OF x]] Y) + also have "... = (\\<^sup>+ y. (\i. gi i (x, y) A) \\ x)" + by(auto intro!: nn_integral_cong simp: sets_eq_imp_space_eq[OF kernel_sets[OF x]] gi(2)[OF x]) + also have "... = (\i. \\<^sup>+ y. gi i (x, y) A \\ x)" + using gi(1) x A by(auto intro!: nn_integral_suminf simp: subprob_kernel_def') + also have "... = (\i. (\j. \\<^sup>+ y. gi i (x, y) A \ki j x))" + by(rule suminf_cong, rule nn_integral_measure_suminf[symmetric], insert kernel_sets[OF x] ki gi(1) x A) + (auto simp: subprob_kernel_def measure_kernel_def measurable_cong_sets[OF sets_pair_measure_cong[OF refl kernel_sets[OF x]]] intro!: measurable_Pair2[OF _ x]) + also have "... = (\i. (\j. emeasure (ki j x \ (curry (gi i) x)) A))" + using sets_eq_imp_space_eq[of "ki _ x" Y] ki(1) x gi(1) measurable_cong_sets[of _ _ "subprob_algebra Z" "subprob_algebra Z", OF sets_pair_measure_cong[of X X Y "ki _ x"]] + by(auto intro!: suminf_cong emeasure_bind[OF _ _ A,symmetric] measurable_Pair2[OF _ x] simp: curry_def subprob_kernel_def[of X] subprob_kernel_def'[of "X \\<^sub>M Y"] measure_kernel_def Y) + also have "... = ?rhs" + unfolding kgi_def by(rule suminf_ennreal_2dimen[symmetric]) (simp add: curry_def) + finally show ?thesis . + qed + have sets: "sets (\ x \\<^sub>k g x) = sets Z" if x:"x \ space X" for x + proof - + interpret gx: s_finite_kernel Y Z "g x" + using g.comp_measurable[OF measurable_Pair1'[OF x]] by auto + show ?thesis + by(simp add: gx.sets_bind_kernel[OF _ kernel_sets[OF x]] Y) + qed + have sk:"subprob_kernel X Z (kgi i)" for i + using ki(1)[of "snd (prod_decode i)"] gi(1)[of "fst (prod_decode i)"] + by(auto simp: subprob_kernel_def' kgi_def split_beta' curry_def) + show ?thesis + using sk by(auto simp: s_finite_kernel_def' emeasure sets subprob_kernel_def' intro!: exI[where x=kgi] measurable_cong[where g="\x. \i. emeasure (kgi i x) _" and f="\x. emeasure (\ x \\<^sub>k g x) _",THEN iffD2]) +qed + +corollary(in s_finite_kernel) bind_kernel_s_finite_kernel: + assumes "s_finite_kernel Y Z k'" + shows "s_finite_kernel X Z (\x. \ x \\<^sub>k k')" + by(auto intro!: bind_kernel_s_finite_kernel' s_finite_kernel.comp_measurable[OF assms measurable_snd] simp: split_beta') + +lemma(in s_finite_kernel) nn_integral_bind_kernel: + assumes "f \ borel_measurable Y" "sets \ = sets X" + shows "(\\<^sup>+ y. f y \(\ \\<^sub>k \)) = (\\<^sup>+x. (\\<^sup>+ y. f y \(\ x)) \\)" +proof(cases "space X = {}") + case True + then show ?thesis + by(simp add: sets_eq_imp_space_eq[OF assms(2)] bind_kernel_def nn_integral_empty) +next + case X:False + then have \:"space \ \ {}" by(simp add: sets_eq_imp_space_eq[OF assms(2)]) + note 1[measurable_cong] = assms(2) sets_bind_kernel[OF X assms(2)] + from assms(1) show ?thesis + proof induction + case ih:(cong f g) + have "(\\<^sup>+ y. f y \(\ \\<^sub>k \)) = (\\<^sup>+ y. g y \(\ \\<^sub>k \))" "(\\<^sup>+ x. integral\<^sup>N (\ x) f \\) = (\\<^sup>+ x. integral\<^sup>N (\ x) g \\)" + by(auto intro!: nn_integral_cong simp: sets_eq_imp_space_eq[OF 1(2)] sets_eq_imp_space_eq[OF assms(2)] sets_eq_imp_space_eq[OF kernel_sets] ih(3)) + then show ?case + by(simp add: ih) + next + case (set A) + then show ?case + by(auto simp: emeasure_bind_kernel[OF 1(1) _ X] sets_eq_imp_space_eq[OF 1(1)] intro!: nn_integral_cong) + next + case ih:(mult u c) + then have "(\\<^sup>+ x. \\<^sup>+ y. c * u y \\ x \\) = (\\<^sup>+ x. c * \\<^sup>+ y. u y \\ x \\)" + by(auto intro!: nn_integral_cong nn_integral_cmult simp: sets_eq_imp_space_eq[OF 1(1)]) + with ih nn_integral_measurable_f[of "\_ y. u y"] show ?case + by(auto simp: nn_integral_cmult intro!: nn_integral_cong) + next + case ih:(add u v) + then have "(\\<^sup>+ x. \\<^sup>+ y. v y + u y \\ x \\) = (\\<^sup>+ x. (\\<^sup>+ y. v y \\ x) + (\\<^sup>+ y. u y \\ x) \\)" + by(auto intro!: nn_integral_cong simp: nn_integral_add sets_eq_imp_space_eq[OF 1(1)]) + with ih nn_integral_measurable_f[of "\_ y. u y"] nn_integral_measurable_f[of "\_ y. v y"] show ?case + by(simp add: nn_integral_add) + next + case ih[measurable]:(seq U) + show ?case (is "?lhs = ?rhs") + proof - + have "?lhs = ((\i. integral\<^sup>N (\ \\<^sub>k \) (U i)))" + by(rule nn_integral_monotone_convergence_SUP[of U,simplified SUP_apply[of U UNIV,symmetric]]) (use ih in auto) + also have "... = (\i. \\<^sup>+ x. (\\<^sup>+ y. U i y \\ x) \\)" + by(simp add: ih) + also have "... = (\\<^sup>+ x. (\i. (\\<^sup>+ y. U i y \\ x)) \\)" + proof(rule nn_integral_monotone_convergence_SUP[symmetric]) + show "incseq (\i x. \\<^sup>+ y. U i y \\ x)" + by standard+ (auto intro!: le_funI nn_integral_mono simp:le_funD[OF incseqD[OF ih(3)]]) + qed(use nn_integral_measurable_f[of "\_ y. U _ y"] in simp) + also have "... = ?rhs" + by(rule nn_integral_cong, rule nn_integral_monotone_convergence_SUP[of U,simplified SUP_apply[of U UNIV,symmetric],OF ih(3),symmetric]) (auto simp: sets_eq_imp_space_eq[OF 1(1)]) + finally show ?thesis . + qed + qed +qed + +lemma(in s_finite_kernel) bind_kernel_assoc: + assumes "s_finite_kernel Y Z k'" "sets \ = sets X" + shows "\ \\<^sub>k (\x. \ x \\<^sub>k k') = \ \\<^sub>k \ \\<^sub>k k'" +proof(cases "space X = {}") + case X:False + then have \: "space \ \ {}" and Y:"space Y \ {}" + by(simp_all add: Y_not_empty sets_eq_imp_space_eq[OF assms(2)]) + interpret k':s_finite_kernel Y Z k' by fact + interpret k'': s_finite_kernel X Z "\x. \ x \\<^sub>k k'" + by(rule bind_kernel_s_finite_kernel[OF assms(1)]) + show ?thesis + proof(rule measure_eqI) + fix A + assume "A \ sets (\ \\<^sub>k (\x. \ x \\<^sub>k k'))" + then have A[measurable]: "A \ sets Z" + by(simp add: k''.sets_bind_kernel[OF X assms(2)]) + show "emeasure (\ \\<^sub>k (\x. \ x \\<^sub>k k')) A = emeasure (\ \\<^sub>k \ \\<^sub>k k') A" (is "?lhs = ?rhs") + proof - + have "?lhs = (\\<^sup>+ x. emeasure (\ x \\<^sub>k k') A \\)" + by(rule k''.emeasure_bind_kernel[OF assms(2) A X]) + also have "... = (\\<^sup>+ x. \\<^sup>+ y. k' y A \\ x \\)" + using k'.emeasure_bind_kernel[OF kernel_sets A] + by(auto intro!: nn_integral_cong simp: sets_eq_imp_space_eq[OF assms(2)] sets_eq_imp_space_eq[OF kernel_sets] Y) + also have "... = (\\<^sup>+ y. k' y A \(\ \\<^sub>k \))" + by(simp add: nn_integral_bind_kernel[OF k'.emeasure_measurable[OF A] assms(2)]) + also have "... = ?rhs" + by(simp add: k'.emeasure_bind_kernel[OF sets_bind_kernel[OF X assms(2)] A] sets_eq_imp_space_eq[OF sets_bind_kernel[OF X assms(2)]] Y) + finally show ?thesis . + qed + qed(auto simp: k'.sets_bind_kernel[OF Y sets_bind_kernel[OF X assms(2)]] k''.sets_bind_kernel[OF X assms(2)]) +qed(simp add: bind_kernel_def sets_eq_imp_space_eq[OF assms(2)]) + +lemma s_finite_kernel_pair_measure: + assumes "s_finite_kernel X Y k" and "s_finite_kernel X Z k'" + shows "s_finite_kernel X (Y \\<^sub>M Z) (\x. k x \\<^sub>M k' x)" +proof - + interpret k: s_finite_kernel X Y k by fact + interpret k': s_finite_kernel X Z k' by fact + from k.s_finite_kernels k'.s_finite_kernels obtain ki ki' + where ki:"\i. subprob_kernel X Y (ki i)" "\x A. x \ space X \ k x A = (\i. ki i x A)" + and ki':"\i. subprob_kernel X Z (ki' i)" "\x A. x \ space X \ k' x A = (\i. ki' i x A)" + by metis + then have 1[measurable_cong]: "\x i. x \ space X \ sets (ki i x) = sets Y" "\x i. x \ space X \ sets (ki' i x) = sets Z" + by(auto simp: subprob_kernel_def measure_kernel_def) + define kki where "kki \ (\i x. (\(j,i). ki i x \\<^sub>M ki' j x) (prod_decode i))" + have kki1: "\i. subprob_kernel X (Y \\<^sub>M Z) (kki i)" + using ki(1) ki'(1) by(auto simp: subprob_kernel_def' kki_def split_beta intro!: measurable_pair_measure) + have kki2: "(k x \\<^sub>M k' x) A = (\i. (kki i x) A)" (is "?lhs = ?rhs") if x:"x \ space X" and A[measurable]: "A \ sets (Y \\<^sub>M Z)" for x A + proof - + have "?lhs = (\\<^sup>+ y. \\<^sup>+ z. indicator A (y, z) \k' x \k x)" + using x by(simp add: s_finite_measure.emeasure_pair_measure'[OF k'.image_s_finite_measure]) + also have "... = (\\<^sup>+ y. (\j. \\<^sup>+ z. indicator A (y, z) \ki' j x) \k x)" + using ki' x by(auto intro!: nn_integral_cong nn_integral_measure_suminf[symmetric] simp: sets_eq_imp_space_eq[OF k.kernel_sets[OF x]] subprob_kernel_def measure_kernel_def k'.kernel_sets) + also have "... = (\j. \\<^sup>+ y. \\<^sup>+ z. indicator A (y, z) \ki' j x \k x)" + using x by(auto intro!: nn_integral_suminf s_finite_measure.borel_measurable_nn_integral_fst' s_finite_kernel.image_s_finite_measure[OF subprob_kernel.s_finite_kernel_subprob_kernel[OF ki'(1)]]) + also have "... = (\j. (\i. (\\<^sup>+ y. \\<^sup>+ z. indicator A (y, z) \ki' j x \ki i x)))" + using x ki by(auto intro!: suminf_cong nn_integral_measure_suminf[symmetric] s_finite_measure.borel_measurable_nn_integral_fst' simp: k.kernel_sets[OF x] subprob_kernel_def measure_kernel_def s_finite_kernel.image_s_finite_measure[OF subprob_kernel.s_finite_kernel_subprob_kernel[OF ki'(1)]]) + also have "... = (\j. (\i. (ki i x \\<^sub>M ki' j x) A))" + using x by(auto simp: s_finite_measure.emeasure_pair_measure'[OF s_finite_kernel.image_s_finite_measure[OF subprob_kernel.s_finite_kernel_subprob_kernel[OF ki'(1)]]]) + also have "... = ?rhs" + unfolding kki_def by(rule suminf_ennreal_2dimen[symmetric]) auto + finally show ?thesis . + qed + show ?thesis + proof + fix B + assume [measurable]:"B \ sets (Y \\<^sub>M Z)" + show "(\x. emeasure (k x \\<^sub>M k' x) B) \ borel_measurable X" + by(rule measurable_cong[where g="\x. \i. (kki i x) B",THEN iffD2], insert kki1) (auto simp: subprob_kernel_def' kki2) + qed(auto intro!: exI[where x=kki] simp: subprob_kernel.finite_kernel kki1 kki2 k.kernel_sets k'.kernel_sets space_pair_measure k.Y_not_empty k'.Y_not_empty) +qed + +lemma pair_measure_eq_bind_s_finite: + assumes "s_finite_measure \" "s_finite_measure \" + shows "\ \\<^sub>M \ = \ \\<^sub>k (\x. \ \\<^sub>k (\y. return (\ \\<^sub>M \) (x,y)))" +proof - + consider "space \ = {}" | "space \ = {}" | "space \ \ {}" "space \ \ {}" + by auto + then show ?thesis + proof cases + case 1 + then show ?thesis + by(auto simp: bind_kernel_def space_pair_measure intro!: space_empty) + next + case 2 + then have "\ \\<^sub>k (\x. \ \\<^sub>k (\y. return (\ \\<^sub>M \) (x, y))) = count_space {}" + by(auto simp: bind_kernel_def space_empty) + with 2 show ?thesis + by(auto simp: space_pair_measure intro!: space_empty) + next + case 3 + show ?thesis + proof(intro measure_eqI sets_bind_kernel[OF _ 3(1),symmetric] sets_bind_kernel[OF _ 3(2)]) + fix A + assume A[measurable]: "A \ sets (\ \\<^sub>M \)" + show "emeasure (\ \\<^sub>M \) A = emeasure (\ \\<^sub>k (\x. \ \\<^sub>k (\y. return (\ \\<^sub>M \) (x, y)))) A" (is "?lhs = ?rhs") + proof - + have "?lhs = (\\<^sup>+ x. \\<^sup>+ y. return (\ \\<^sub>M \) (x, y) A \\ \\)" + by(simp add: s_finite_measure.emeasure_pair_measure'[OF assms(2)]) + also have "... = (\\<^sup>+ x. (\ \\<^sub>k (\y. return (\ \\<^sub>M \) (x,y))) A \\)" + by(auto intro!: nn_integral_cong measure_kernel.emeasure_bind_kernel[OF _ _ A 3(2),symmetric] prob_kernel.axioms(1) simp: prob_kernel_def' simp del: emeasure_return) + also have "... = ?rhs" + by(auto intro!: measure_kernel.emeasure_bind_kernel[OF _ _ A 3(1),symmetric] s_finite_kernel.axioms(1) s_finite_kernel.bind_kernel_s_finite_kernel'[where Y=\] s_finite_measure.s_finite_kernel_const[OF assms(2) 3(2)] prob_kernel.s_finite_kernel_prob_kernel[of "\ \\<^sub>M \"] simp: prob_kernel_def') + finally show ?thesis . + qed + qed simp + qed +qed + +lemma bind_kernel_rotate_return: + assumes "s_finite_measure \" "s_finite_measure \" + shows "\ \\<^sub>k (\x. \ \\<^sub>k (\y. return (\ \\<^sub>M \) (x,y))) = \ \\<^sub>k (\y. \ \\<^sub>k (\x. return (\ \\<^sub>M \) (x,y)))" +proof - + consider "space \ = {}" | "space \ = {}" | "space \ \ {}" "space \ \ {}" + by auto + then show ?thesis + proof cases + case 1 + then have "\ \\<^sub>k (\y. \ \\<^sub>k (\x. return (\ \\<^sub>M \) (x,y))) = count_space {}" + by(auto simp: bind_kernel_def space_empty) + then show ?thesis + by(auto simp: bind_kernel_def space_pair_measure 1 intro!: space_empty) + next + case 2 + then have "\ \\<^sub>k (\x. \ \\<^sub>k (\y. return (\ \\<^sub>M \) (x, y))) = count_space {}" + by(auto simp: bind_kernel_def space_empty) + with 2 show ?thesis + by(auto simp: space_pair_measure bind_kernel_def intro!: space_empty) + next + case 3 + show ?thesis + unfolding pair_measure_eq_bind_s_finite[OF assms,symmetric] + proof(intro measure_eqI) + fix A + assume A[measurable]:"A \ sets (\ \\<^sub>M \)" + show "emeasure (\ \\<^sub>M \) A = emeasure (\ \\<^sub>k (\y. \ \\<^sub>k (\x. return (\ \\<^sub>M \) (x, y)))) A" (is "?lhs = ?rhs") + proof - + have "?lhs = (\\<^sup>+ x. \\<^sup>+ y. indicator A (x, y) \\ \\)" + by(rule s_finite_measure.emeasure_pair_measure'[OF assms(2) A]) + also have "... = (\\<^sup>+ y. \\<^sup>+ x. return (\ \\<^sub>M \) (x, y) A \\ \\)" + by(simp add: nn_integral_snd'[OF assms] s_finite_measure.nn_integral_fst'[OF assms(2)]) + also have "... = (\\<^sup>+ y. (\ \\<^sub>k (\x. return (\ \\<^sub>M \) (x, y))) A \\)" + by(auto intro!: nn_integral_cong measure_kernel.emeasure_bind_kernel[OF _ _ A 3(1),symmetric] prob_kernel.axioms(1) simp add: prob_kernel_def' simp del: emeasure_return) + also have "... = ?rhs" + by(auto intro!: measure_kernel.emeasure_bind_kernel[OF _ _ A 3(2),symmetric] s_finite_kernel.axioms(1) s_finite_kernel.bind_kernel_s_finite_kernel'[where Y=\] s_finite_measure.s_finite_kernel_const[OF assms(1) 3(1)] prob_kernel.s_finite_kernel_prob_kernel[of "\ \\<^sub>M \"] simp: prob_kernel_def') + finally show ?thesis . + qed + qed(auto intro!: sets_bind_kernel[OF _ 3(2),symmetric] sets_bind_kernel[OF _ 3(1)]) + qed +qed + +lemma bind_kernel_rotate': + assumes "s_finite_measure \" "s_finite_measure \" "s_finite_kernel (\ \\<^sub>M \) Z (case_prod f)" + shows "\ \\<^sub>k (\x. \ \\<^sub>k (\y. f x y)) = \ \\<^sub>k (\y. \ \\<^sub>k (\x. f x y))" (is "?lhs = ?rhs") +proof - + interpret sk: s_finite_kernel "\ \\<^sub>M \" Z "case_prod f" by fact + consider "space \ = {}" | "space \ = {}" | "space \ \ {}" "space \ \ {}" + by auto + then show ?thesis + proof cases + case 1 + then have "?rhs = count_space {}" + by(auto simp: bind_kernel_def space_empty) + then show ?thesis + by(auto simp: bind_kernel_def space_pair_measure 1 intro!: space_empty) + next + case 2 + then show ?thesis + by(auto simp: space_pair_measure bind_kernel_def intro!: space_empty) + next + case 3 + show ?thesis + proof - + have "?lhs = \ \\<^sub>k (\x. \ \\<^sub>k (\y. return (\ \\<^sub>M \) (x, y)) \\<^sub>k case_prod f)" + by(auto intro!: bind_kernel_cong_All simp: s_finite_kernel.bind_kernel_assoc[OF prob_kernel.s_finite_kernel_prob_kernel assms(3) refl,of \ "\y. return (\ \\<^sub>M \) (_, y)",simplified prob_kernel_def',symmetric] sk.bind_kernel_return space_pair_measure) + also have "... = \ \\<^sub>k (\x. \ \\<^sub>k (\y. return (\ \\<^sub>M \) (x,y))) \\<^sub>k (case_prod f)" + by(auto simp: s_finite_kernel.bind_kernel_assoc[OF s_finite_kernel.bind_kernel_s_finite_kernel'[OF s_finite_measure.s_finite_kernel_const[OF assms(2) 3(2),of \] prob_kernel.s_finite_kernel_prob_kernel,of "\ \\<^sub>M \" "\x y. return (\ \\<^sub>M \) (x,y)",simplified] assms(3) refl, simplified prob_kernel_def',symmetric]) + also have "... = \ \\<^sub>k (\y. \ \\<^sub>k (\x. return (\ \\<^sub>M \) (x,y))) \\<^sub>k (case_prod f)" + by(simp add: bind_kernel_rotate_return assms) + also have "... = \ \\<^sub>k (\y. \ \\<^sub>k (\x. return (\ \\<^sub>M \) (x, y)) \\<^sub>k case_prod f)" + by(auto intro!: s_finite_kernel.bind_kernel_assoc[OF _ assms(3),symmetric] s_finite_kernel.bind_kernel_s_finite_kernel'[OF s_finite_measure.s_finite_kernel_const[OF assms(1) 3(1)]] prob_kernel.s_finite_kernel_prob_kernel[of "\ \\<^sub>M \"] simp: prob_kernel_def') + also have "... = ?rhs" + by(auto intro!: bind_kernel_cong_All simp: s_finite_kernel.bind_kernel_assoc[OF prob_kernel.s_finite_kernel_prob_kernel assms(3) refl,of \ "\x. return (\ \\<^sub>M \) (x, _)",simplified prob_kernel_def',symmetric] sk.bind_kernel_return space_pair_measure) + finally show ?thesis . + qed + qed +qed + +lemma bind_kernel_rotate: + assumes "sets \ = sets X" and "sets \ = sets Y" + and "s_finite_measure \" "s_finite_measure \" "s_finite_kernel (X \\<^sub>M Y) Z (\(x,y). f x y)" + shows "\ \\<^sub>k (\x. \ \\<^sub>k (\y. f x y)) = \ \\<^sub>k (\y. \ \\<^sub>k (\x. f x y))" + by(auto intro!: bind_kernel_rotate' assms simp: s_finite_kernel_cong_sets[OF sets_pair_measure_cong[OF assms(1,2)]]) + +lemma(in s_finite_kernel) emeasure_measurable': + assumes A[measurable]: "(SIGMA x:space X. A x) \ sets (X \\<^sub>M Y)" + shows "(\x. emeasure (\ x) (A x)) \ borel_measurable X" +proof - + have **: "A x \ sets Y" if "x \ space X" for x + proof - + have "Pair x -` Sigma (space X) A = A x" + using that by auto + with sets_Pair1[OF A, of x] show "A x \ sets Y" + by auto + qed + + have *: "\x. fst x \ space X \ snd x \ A (fst x) \ x \ (SIGMA x:space X. A x)" + by (auto simp: fun_eq_iff) + have "(\(x, y). indicator (A x) y::ennreal) \ borel_measurable (X \\<^sub>M Y)" + by (measurable,subst measurable_cong[OF *]) (auto simp: space_pair_measure) + then have "(\x. integral\<^sup>N (\ x) (indicator (A x))) \ borel_measurable X" + by(rule nn_integral_measurable_f) + moreover have "integral\<^sup>N (\ x) (indicator (A x)) = emeasure (\ x) (A x)" if "x \ space X" for x + using **[OF that] kernel_sets[OF that] by(auto intro!: nn_integral_indicator) + ultimately show "(\x. emeasure (\ x) (A x)) \ borel_measurable X" + by(auto cong: measurable_cong) +qed + +lemma(in s_finite_kernel) measure_measurable': + assumes "(SIGMA x:space X. A x) \ sets (X \\<^sub>M Y)" + shows "(\x. measure (\ x) (A x)) \ borel_measurable X" + using emeasure_measurable'[OF assms] by(simp add: measure_def) + +lemma(in s_finite_kernel) AE_pred: + assumes P[measurable]:"Measurable.pred (X \\<^sub>M Y) (case_prod P)" + shows "Measurable.pred X (\x. AE y in \ x. P x y)" +proof - + have [measurable]:"Measurable.pred X (\x. emeasure (\ x) {y \ space Y. \ P x y} = 0)" + proof(rule pred_eq_const1[where N=borel],rule emeasure_measurable') + have "(SIGMA x:space X. {y \ space Y. \ P x y}) = {xy\space (X \\<^sub>M Y). \ P (fst xy) (snd xy)}" + by (auto simp: space_pair_measure) + also have "... \ sets (X \\<^sub>M Y)" + by simp + finally show "(SIGMA x:space X. {y \ space Y. \ P x y}) \ sets (X \\<^sub>M Y)" . + qed simp + have "{x \ space X. almost_everywhere (\ x) (P x)} = {x \ space X. emeasure (\ x) {y\space Y. \ P x y} = 0}" + proof safe + fix x + assume x:"x \ space X" + show "(AE y in \ x. P x y) \ emeasure (\ x) {y \ space Y. \ P x y} = 0" + using emeasure_eq_0_AE[of "\y. \ P x y" "\ x"] + by(simp add: sets_eq_imp_space_eq[OF kernel_sets[OF x]]) + show "emeasure (\ x) {y \ space Y. \ P x y} = 0 \ almost_everywhere (\ x) (P x)" + using x by(auto intro!: AE_I[where N="{y \ space Y. \ P x y}"] simp: sets_eq_imp_space_eq[OF kernel_sets[OF x]] kernel_sets[OF x]) + qed + also have "... \ sets X" + by(simp add: pred_def) + finally show ?thesis + by(simp add: pred_def) +qed + +lemma(in subprob_kernel) integrable_probability_kernel_pred: + fixes f :: "_ \ _ \ _::{banach, second_countable_topology}" + assumes [measurable]:"(\(x,y). f x y) \ borel_measurable (X \\<^sub>M Y)" + shows "Measurable.pred X (\x. integrable (\ x) (f x))" +proof(rule measurable_cong[THEN iffD2]) + show "x \ space X \ integrable (\ x) (f x) \ (\\<^sup>+y. norm (f x y) \(\ x)) < \" for x + by(auto simp: integrable_iff_bounded) +next + have "(\(x,y). ennreal (norm (f x y))) \ borel_measurable (X \\<^sub>M Y)" + by measurable + from nn_integral_measurable_f[OF this] + show "Measurable.pred X (\x. (\\<^sup>+ y. ennreal (norm (f x y)) \\ x) < \)" + by simp +qed + +corollary integrable_measurable_subprob': + fixes f :: "_ \ _ \ _::{banach, second_countable_topology}" + assumes [measurable]:"(\(x,y). f x y) \ borel_measurable (X \\<^sub>M Y)" "k \ X \\<^sub>M subprob_algebra Y" + shows "Measurable.pred X (\x. integrable (k x) (f x))" + by(auto intro!: subprob_kernel.integrable_probability_kernel_pred[where Y=Y] simp: subprob_kernel_def') + +lemma(in subprob_kernel) integrable_probability_kernel_pred': + fixes f :: "_ \ _::{banach, second_countable_topology}" + assumes "f \ borel_measurable (X \\<^sub>M Y)" + shows "Measurable.pred X (\x. integrable (\ x) (curry f x))" + using integrable_probability_kernel_pred[of "curry f"] assms by auto + +lemma(in subprob_kernel) lebesgue_integral_measurable_f_subprob: + fixes f :: "_ \ _::{banach, second_countable_topology}" + assumes [measurable]:"f \ borel_measurable (X \\<^sub>M Y)" + shows "(\x. \y. f (x,y) \(\ x)) \ borel_measurable X" +proof - + from borel_measurable_implies_sequence_metric[OF assms, of 0] + obtain s where s: "\i. simple_function (X \\<^sub>M Y) (s i)" + and "\x\space (X \\<^sub>M Y). (\i. s i x) \ f x" + and "\i. \x\space (X \\<^sub>M Y). dist (s i x) 0 \ 2 * dist (f x) 0" + by auto + then have *: + "\x y. x \ space X \ y \ space Y \ (\i. s i (x, y)) \ f (x,y)" + "\i x y. x \ space X \ y \ space Y \ norm (s i (x, y)) \ 2 * norm (f (x, y))" + by (auto simp: space_pair_measure) + + have [measurable]: "\i. s i \ borel_measurable (X \\<^sub>M Y)" + by (rule borel_measurable_simple_function) fact + + have s':"\i. s i \ X \\<^sub>M Y \\<^sub>M count_space UNIV" + by (rule measurable_simple_function) fact + + define f' where [abs_def]: "f' i x = + (if integrable (\ x) (curry f x) then Bochner_Integration.simple_bochner_integral (\ x) (\y. s i (x, y)) else 0)" for i x + + have eq: "Bochner_Integration.simple_bochner_integral (\ x) (\y. s i (x, y)) = + (\z\s i ` (space X \ space Y). measure (\ x) {y \ space (\ x). s i (x, y) = z} *\<^sub>R z)" if "x \ space X" for x i + proof - + have [measurable_cong]: "sets (\ x) = sets Y" and [simp]: "space (\ x) = space Y" + using that by (simp_all add: kernel_sets kernel_space) + with that show ?thesis + using s[THEN simple_functionD(1)] + unfolding simple_bochner_integral_def + by (intro sum.mono_neutral_cong_left) + (auto simp: eq_commute space_pair_measure image_iff cong: conj_cong) + qed + + show ?thesis + proof (rule borel_measurable_LIMSEQ_metric) + fix i + note [measurable] = integrable_probability_kernel_pred'[OF assms] + have [measurable]:"(SIGMA x:space X. {y \ space Y. s i (x, y) = s i (a, b)}) \ sets (X \\<^sub>M Y)" for a b + proof - + have "(SIGMA x:space X. {y \ space Y. s i (x, y) = s i (a, b)}) = space (X \\<^sub>M Y) \ s i -` {s i (a,b)}" + by(auto simp: space_pair_measure) + thus ?thesis + using s'[of i] by simp + qed + show "f' i \ borel_measurable X" + by (auto simp : eq kernel_space f'_def cong: measurable_cong if_cong intro!: borel_measurable_sum measurable_If borel_measurable_scaleR measure_measurable') + next + fix x + assume x:"x \ space X" + have "(\i. Bochner_Integration.simple_bochner_integral (\ x) (\y. s i (x, y))) \ (\y. f (x,y) \(\ x))" if int_f:"integrable (\ x) (curry f x)" + proof - + have int_2f: "integrable (\ x) (\y. 2 * norm (f (x,y)))" + using int_f by(auto simp: curry_def) + have "(\i. integral\<^sup>L (\ x) (\y. s i (x, y))) \ integral\<^sup>L (\ x) (curry f x)" + proof (rule integral_dominated_convergence) + show "curry f x \ borel_measurable (\ x)" + using int_f by auto + next + show "\i. (\y. s i (x, y)) \ borel_measurable (\ x)" + using x kernel_sets by auto + next + show "AE xa in \ x. (\i. s i (x, xa)) \ curry f x xa" + using x *(1) kernel_space by(auto simp: curry_def) + next + show "\i. AE xa in \ x. norm (s i (x, xa)) \ 2 * norm (f (x,xa))" + using x * (2) kernel_space by auto + qed fact + moreover have "integral\<^sup>L (\ x) (\y. s i (x, y)) = Bochner_Integration.simple_bochner_integral (\ x) (\y. s i (x, y))" for i + proof - + have "Bochner_Integration.simple_bochner_integrable (\ x) (\y. s i (x, y))" + proof (rule simple_bochner_integrableI_bounded) + have "(\y. s i (x, y)) ` space Y \ s i ` (space X \ space Y)" + using x by auto + then show "simple_function (\ x) (\y. s i (x, y))" + using simple_functionD(1)[OF s(1), of i] x kernel_space + by (intro simple_function_borel_measurable) (auto simp: space_pair_measure dest: finite_subset) + next + have "(\\<^sup>+ y. ennreal (norm (s i (x, y))) \\ x) \ (\\<^sup>+ y. 2 * norm (f (x,y)) \\ x)" + using x *(2) kernel_space by (intro nn_integral_mono) auto + also have "... < \" + using int_2f unfolding integrable_iff_bounded by simp + finally show "(\\<^sup>+ y. ennreal (norm (s i (x, y))) \\ x) < \" . + qed + then show ?thesis + by (rule simple_bochner_integrable_eq_integral[symmetric]) + qed + ultimately show ?thesis + by(simp add: curry_def) + qed + thus "(\i. f' i x) \ (\y. f (x,y) \(\ x))" + by (cases "integrable (\ x) (curry f x)") (simp_all add: f'_def not_integrable_integral_eq curry_def) + qed +qed + +lemma(in s_finite_kernel) integrable_measurable_pred[measurable (raw)]: + fixes f :: "_ \ _ \ _::{banach, second_countable_topology}" + assumes [measurable]:"case_prod f \ borel_measurable (X \\<^sub>M Y)" + shows "Measurable.pred X (\x. integrable (\ x) (f x))" +proof(cases "space X = {}") + case True + from space_empty[OF this] show ?thesis + by simp +next + case h:False + obtain ki where ki:"\i. subprob_kernel X Y (ki i)" "\x A. x \ space X \ \ x A = (\i. ki i x A)" + using s_finite_kernels by metis + have [simp]:"integrable (\ x) (f x) = ((\i. \\<^sup>+ y. ennreal (norm (f x y)) \ki i x) < \)" if "x \ space X" for x + using ki(1) nn_integral_measure_suminf[of "\i. ki i x" "\ x",OF _ ki(2)] that kernel_sets + by(auto simp: integrable_iff_bounded subprob_kernel_def measure_kernel_def) + note [measurable] = nn_integral_measurable_subprob_algebra2 + show ?thesis + by(rule measurable_cong[where g="\x. (\i. \\<^sup>+y. ennreal (norm (f x y)) \(ki i x)) < \",THEN iffD2]) (insert ki(1), auto simp: subprob_kernel_def') +qed + +lemma(in s_finite_kernel) integral_measurable_f: + fixes f :: "_ \ _ \ _::{banach, second_countable_topology}" + assumes [measurable]:"case_prod f \ borel_measurable (X \\<^sub>M Y)" + shows "(\x. \y. f x y \(\ x)) \ borel_measurable X" +proof - + obtain ki where ki:"\i. subprob_kernel X Y (ki i)" "\x A. x \ space X \ \ x A = (\i. ki i x A)" + using s_finite_kernels by metis + note [measurable] = integral_measurable_subprob_algebra2 + + show ?thesis + proof(rule measurable_cong[where f="(\x. if integrable (\ x) (f x) then (\i. \y. f x y \(ki i x)) else 0)",THEN iffD1]) + fix x + assume h:"x \ space X" + { + assume h':"integrable (\ x) (f x)" + have "(\i. \y. f x y \(ki i x)) = (\y. f x y \(\ x))" + using lebesgue_integral_measure_suminf[of "\i. ki i x" "\ x",OF _ ki(2) h'] ki(1) kernel_sets[OF h] h + by(auto simp: subprob_kernel_def measure_kernel_def) + } + thus "(if integrable (\ x) (f x) then (\i. \y. f x y \(ki i x)) else 0) = (\y. f x y \(\ x))" + using not_integrable_integral_eq by auto + qed(insert ki(1), auto simp: subprob_kernel_def') +qed + +lemma(in s_finite_kernel) integral_measurable_f': + fixes f :: "_ \ _::{banach, second_countable_topology}" + assumes [measurable]:"f \ borel_measurable (X \\<^sub>M Y)" + shows "(\x. \y. f (x,y) \(\ x)) \ borel_measurable X" + using integral_measurable_f[of "curry f"] by simp + +lemma(in s_finite_kernel) + fixes f :: "_ \ _::{banach, second_countable_topology}" + assumes [measurable_cong]: "sets \ = sets X" + and "integrable (\ \\<^sub>k \) f" + shows integrable_bind_kernelD1: "integrable \ (\x. \y. norm (f y) \\ x)" (is ?g1) + and integrable_bind_kernelD1': "integrable \ (\x. \y. f y \\ x)" (is ?g1') + and integrable_bind_kernelD2: "AE x in \. integrable (\ x) f" (is ?g2) + and integrable_bind_kernelD3: "space X \ {} \ f \ borel_measurable Y" (is "_ \ ?g3") +proof - + show 1:"space X \ {} \ ?g3" + using assms(2) sets_bind_kernel[OF _ assms(1)] by(simp add: integrable_iff_bounded cong: measurable_cong_sets) + have "integrable \ (\x. \y. norm (f y) \\ x) \ integrable \ (\x. \y. f y \\ x) \ (AE x in \. integrable (\ x) f)" + proof(cases "space X = {}") + assume ne: "space X \ {}" + then have "space \ \ {}" by(simp add: sets_eq_imp_space_eq[OF assms(1)]) + note h = integral_measurable_f[measurable] sets_bind_kernel[OF ne assms(1),measurable_cong] + have g2: ?g2 + unfolding integrable_iff_bounded AE_conj_iff + proof safe + show "AE x in \. f \ borel_measurable (\ x)" + using assms(2) by(auto simp: sets_eq_imp_space_eq[OF assms(1)] measurable_cong_sets[OF kernel_sets]) + next + note nn_integral_measurable_f[measurable] + have "AE x in \. (\\<^sup>+ x. ennreal (norm (f x)) \\ x) \ \" + by(rule nn_integral_PInf_AE,insert assms(2)) (auto simp: integrable_iff_bounded nn_integral_bind_kernel[OF _ assms(1)] intro!: ) + thus "AE x in \. (\\<^sup>+ x. ennreal (norm (f x)) \\ x) < \" + by (simp add: top.not_eq_extremum) + qed + have [simp]:"(\\<^sup>+ x. \\<^sup>+ x. ennreal (norm (f x)) \\ x \\) = (\\<^sup>+ x. ennreal (\y. norm (f y) \\ x)\\)" + using g2 by(auto intro!: nn_integral_cong_AE simp: nn_integral_eq_integral) + have g1: ?g1 + using assms(2) by(auto simp: integrable_iff_bounded measurable_cong_sets[OF h(2)] measurable_cong_sets[OF assms(1)] nn_integral_bind_kernel[OF _ assms(1)]) + have ?g1' + using assms(2) by(auto intro!: Bochner_Integration.integrable_bound[OF g1]) + with g2 g1 show ?thesis + by auto + qed(auto simp: space_empty[of \] sets_eq_imp_space_eq[OF assms(1)] integrable_iff_bounded nn_integral_empty) + thus ?g1 ?g1' ?g2 + by auto +qed + +lemma(in s_finite_kernel) + fixes f :: "_ \ _::{banach, second_countable_topology}" + assumes [measurable_cong]: "sets \ = sets X" + and [measurable]:"AE x in \. integrable (\ x) f" "integrable \ (\x. \y. norm (f y) \\ x)" "f \ borel_measurable Y" + shows integrable_bind_kernel: "integrable (\ \\<^sub>k \) f" + and integral_bind_kernel: "(\y. f y \(\ \\<^sub>k \)) = (\x. (\y. f y\\ x)\ \)" (is ?eq) +proof - + have "integrable (\ \\<^sub>k \) f \ (\y. f y \(\ \\<^sub>k \)) = (\x. (\y. f y\\ x)\ \)" + proof(cases "space X = {}") + assume ne: "space X \ {}" + note sets_bind[measurable_cong] = sets_bind_kernel[OF ne assms(1)] + note h = integral_measurable_f[measurable] + have 1:"integrable (\ \\<^sub>k \) f" + unfolding integrable_iff_bounded + proof + show "(\\<^sup>+ x. ennreal (norm (f x)) \(\ \\<^sub>k \)) < \" (is "?l < _") + proof - + have "?l = (\\<^sup>+ x. ennreal (\y. norm (f y) \\ x)\\)" + using assms(2) by(auto intro!: nn_integral_cong_AE simp: nn_integral_eq_integral simp: nn_integral_bind_kernel[OF _ assms(1)]) + also have "... < \" + using assms(3) by(auto simp: integrable_iff_bounded) + finally show ?thesis . + qed + qed simp + then have ?eq + proof induction + case h[measurable]:(base A c) + hence 1:"integrable (\ \\<^sub>k \) (indicat_real A)" + by simp + have 2:"integrable \ (\x. measure (\ x) A)" + by(rule Bochner_Integration.integrable_cong[where f="\x. Sigma_Algebra.measure (\ x) (A \ space (\ x))",THEN iffD1,OF refl]) + (insert h integrable_bind_kernelD1[OF assms(1) 1] sets_eq_imp_space_eq[OF kernel_sets], auto simp: sets_eq_imp_space_eq[OF assms(1)] sets_eq_imp_space_eq[OF kernel_sets] sets_bind) + have "AE x in \. emeasure (\ x) A \ \" + by(rule nn_integral_PInf_AE,insert h) (auto simp: emeasure_bind_kernel[OF assms(1) _ ne] sets_bind) + hence 0:"AE x in \. emeasure (\ x) A < \" + by (simp add: top.not_eq_extremum) + have "(\x. (\y. indicat_real A y *\<^sub>R c \\ x)\ \) = (\x. measure (\ x) A *\<^sub>R c\\)" + using h integrable_bind_kernelD2[OF assms(1) integrable_real_indicator,of A] + by(auto intro!: integral_cong_AE simp: sets_eq_imp_space_eq[OF kernel_sets] sets_bind sets_eq_imp_space_eq[OF assms(1)]) + also have "... = (\x. measure (\ x) A \\) *\<^sub>R c" + using 2 by(auto intro!: integral_scaleR_left) + finally show ?case + using h by(auto simp: measure_bind_kernel[OF assms(1) _ ne 0] sets_bind) + next + case ih:(add f g) + show ?case + using ih(1,2) integrable_bind_kernelD2[OF assms(1) ih(1)] integrable_bind_kernelD2[OF assms(1) ih(2)] + by(auto simp: ih(3,4) Bochner_Integration.integral_add[OF integrable_bind_kernelD1'[OF assms(1) ih(1)] integrable_bind_kernelD1'[OF assms(1) ih(2)],symmetric] intro!: integral_cong_AE) + next + case ih:(lim f fn) + show ?case (is "?lhs = ?rhs") + proof - + have conv: "AE x in \. (\n. \y. fn n y\\ x) \ (\y. f y \\ x)" + proof - + have conv:"AE x in \. integrable (\ x) f \ (\n. \y. fn n y\\ x) \ (\y. f y \\ x)" + proof + fix x + assume h:"x \ space \" + then show "integrable (\ x) f \ (\n. \y. fn n y\\ x) \ (\y. f y \\ x)" + using ih by(auto intro!: integral_dominated_convergence[where w="\x. 2 * norm (f x)"] simp: sets_eq_imp_space_eq[OF sets_bind] sets_eq_imp_space_eq[OF kernel_sets[OF h[simplified sets_eq_imp_space_eq[OF assms(1)]]]] sets_eq_imp_space_eq[OF assms(1)]) + qed + with conv integrable_bind_kernelD2[OF assms(1) ih(4)] + show ?thesis by fastforce + qed + have "?lhs = lim (\n. \y. fn n y \(\ \\<^sub>k \))" + by(rule limI[OF integral_dominated_convergence[where w="\x. 2 * norm (f x)"],symmetric]) (use ih in auto) + also have "... = lim (\n. (\x. (\y. fn n y\\ x)\ \))" + by(simp add: ih) + also have "... = (\x. lim (\n. \y. fn n y\\ x)\ \)" + proof(rule limI[OF integral_dominated_convergence[where w="\x. \y. 2 * norm (f y) \\ x"]]) + fix n + show "AE x in \. norm (\y. fn n y\\ x) \ (\y. 2 * norm (f y) \\ x)" + by(rule AE_mp[OF integrable_bind_kernelD2[OF assms(1) ih(1),of n] AE_mp[OF integrable_bind_kernelD2[OF assms(1) ih(4)]]],standard+,rule order.trans[OF integral_norm_bound integral_mono[of "\ _" "\y. norm (fn n y)" _,OF _ _ ih(3)[simplified sets_eq_imp_space_eq[OF sets_bind]]]]) + (auto simp: sets_eq_imp_space_eq[OF assms(1)] sets_eq_imp_space_eq[OF kernel_sets]) + qed(use ih integrable_bind_kernelD1[OF assms(1) ih(4)] conv limI in auto,fastforce) + also have "... = ?rhs" + using ih conv limI by(auto intro!: integral_cong_AE, blast) + finally show ?thesis . + qed + qed + with 1 show ?thesis + by auto + qed(auto simp: bind_kernel_def space_empty[of \] sets_eq_imp_space_eq[OF assms(1)] integrable_iff_bounded nn_integral_empty Bochner_Integration.integral_empty) + thus "integrable (\ \\<^sub>k \) f" ?eq + by auto +qed + +end \ No newline at end of file diff --git a/thys/S_Finite_Measure_Monad/Lemmas_S_Finite_Measure_Monad.thy b/thys/S_Finite_Measure_Monad/Lemmas_S_Finite_Measure_Monad.thy new file mode 100644 --- /dev/null +++ b/thys/S_Finite_Measure_Monad/Lemmas_S_Finite_Measure_Monad.thy @@ -0,0 +1,266 @@ +(* Title: Lemmas_S_Finite_Measure_Monad.thy + Author: Michikazu Hirata, Tokyo Institute of Technology +*) + +text \For the terminology of s-finite measures/kernels, we refer to the work by Staton~\cite{staton_2017}. + For the definition of the s-finite measure monad, we refer to the lecture note by Yang~\cite{HongseokLecture2017}. + The construction of the s-finite measure monad is based on the detailed pencil-and-paper proof by Tetsuya Sato. + \ + +section \ Lemmas \ +theory Lemmas_S_Finite_Measure_Monad + imports "HOL-Probability.Probability" "Standard_Borel_Spaces.StandardBorel" +begin + +lemma integrable_mono_measure: + fixes f :: "'a \ 'b::{banach, second_countable_topology}" + assumes [measurable_cong,measurable]:"sets M = sets N" "M \ N" "integrable N f" + shows "integrable M f" + using assms(3) nn_integral_mono_measure[OF assms(1,2),of "\x. ennreal (norm (f x))"] + by(auto simp: integrable_iff_bounded) + +lemma AE_mono_measure: + assumes "sets M = sets N" "M \ N" "AE x in N. P x" + shows "AE x in M. P x" + by (metis (no_types, lifting) AE_E Collect_cong assms eventually_ae_filter le_measure le_zero_eq null_setsI sets_eq_imp_space_eq) + +lemma finite_measure_return:"finite_measure (return M x)" + by(auto intro!: finite_measureI) (metis ennreal_top_neq_one ennreal_zero_neq_top indicator_eq_0_iff indicator_eq_1_iff) + +lemma nn_integral_return': + assumes "x \ space M" + shows "(\\<^sup>+ x. g x \return M x) = 0" +proof - + have "emeasure (return M x) A = 0" for A + by(cases "A \ sets M",insert assms) (auto simp: indicator_def emeasure_notin_sets dest: sets.sets_into_space) + thus ?thesis + by(auto simp: nn_integral_def simple_integral_def) (meson SUP_least le_zero_eq) +qed + +lemma pair_measure_return: "return M l \\<^sub>M return N r = return (M \\<^sub>M N) (l,r)" +proof(safe intro!: measure_eqI) + fix A + assume "A \ sets (return M l \\<^sub>M return N r)" + then have A[measurable]:"A \ sets (M \\<^sub>M N)" by simp + note [measurable_cong] = sets_return[of M] sets_return[of N] + interpret finite_measure "return N r" by(simp add: finite_measure_return) + consider "l \ space M" | "r \ space N" | "l \ space M" "r \ space N" by auto + then show "emeasure (return M l \\<^sub>M return N r) A = emeasure (return (M \\<^sub>M N) (l, r)) A" (is "?lhs = ?rhs") + by(cases, insert sets.sets_into_space[OF A]) (auto simp: emeasure_pair_measure nn_integral_return' space_pair_measure nn_integral_return, auto simp: indicator_def) +qed simp_all + +lemma null_measure_distr: "distr (null_measure M) N f = null_measure N" + by(auto intro!: measure_eqI simp: distr_def emeasure_sigma) + +lemma distr_id': + assumes "sets N = sets M" + and "\x. x \ space N \ f x = x" + shows "distr N M f = N" + by(simp add: distr_cong[OF refl refl,of N f id,simplified,OF assms(2),simplified] distr_id2[OF assms(1)[symmetric]] id_def) + +lemma measure_density_times: + assumes [measurable]:"S \ sets M" "X \ sets M" "r \ \" + shows "measure (density M (\x. indicator S x * r)) X = enn2real r * measure M (S \ X)" +proof - + have [simp]:"density M (\x. indicator S x * r) = density (density M (indicator S)) (\_. r)" + by(simp add: density_density_eq) + show ?thesis + by(simp add: measure_density_const[OF _ assms(3)] measure_restricted) +qed + +lemma complete_the_square: + fixes a b c x :: real + assumes "a \ 0" + shows "a*x\<^sup>2 + b * x + c = a * (x + (b / (2*a)))\<^sup>2 - ((b\<^sup>2 - 4* a * c)/(4*a))" + using assms by(simp add: comm_semiring_1_class.power2_sum power2_eq_square[of "b / (2 * a)"] ring_class.ring_distribs(1) division_ring_class.diff_divide_distrib power2_eq_square[of b]) + +lemma complete_the_square2': + fixes a b c x :: real + assumes "a \ 0" + shows "a*x\<^sup>2 - 2 * b * x + c = a * (x - (b / a))\<^sup>2 - ((b\<^sup>2 - a*c)/a)" + using complete_the_square[OF assms,where b="-2 * b" and x=x and c=c] + by(simp add: division_ring_class.diff_divide_distrib assms) + +lemma normal_density_mu_x_swap: + "normal_density \ \ x = normal_density x \ \" + by(simp add: normal_density_def power2_commute) + +lemma normal_density_plus_shift: "normal_density \ \ (x + y) = normal_density (\ - x) \ y" + by(simp add: normal_density_def add.commute diff_diff_eq2) + +lemma normal_density_times: + assumes "\ > 0" "\' > 0" + shows "normal_density \ \ x * normal_density \' \' x = (1 / sqrt (2 * pi * (\\<^sup>2 + \'\<^sup>2))) * exp (- (\ - \')\<^sup>2 / (2 * (\\<^sup>2 + \'\<^sup>2))) * normal_density ((\*\'\<^sup>2 + \'*\\<^sup>2)/(\\<^sup>2 + \'\<^sup>2)) (\ * \' / sqrt (\\<^sup>2 + \'\<^sup>2)) x" + (is "?lhs = ?rhs") +proof - + have non0: "2*\\<^sup>2 \ 0" "2*\'\<^sup>2 \ 0" "\\<^sup>2 + \'\<^sup>2 \ 0" + using assms by auto + have "?lhs = exp (- ((x - \)\<^sup>2 / (2 * \\<^sup>2))) * exp (- ((x - \')\<^sup>2 / (2 * \'\<^sup>2))) / (sqrt (2 * pi * \\<^sup>2) * sqrt (2 * pi * \'\<^sup>2)) " + by(simp add: normal_density_def) + also have "... = exp (- ((x - \)\<^sup>2 / (2 * \\<^sup>2)) - ((x - \')\<^sup>2 / (2 * \'\<^sup>2))) / (sqrt (2 * pi * \\<^sup>2) * sqrt (2 * pi * \'\<^sup>2))" + by(simp add: exp_add[of "- ((x - \)\<^sup>2 / (2 * \\<^sup>2))" "- ((x - \')\<^sup>2 / (2 * \'\<^sup>2))",simplified add_uminus_conv_diff]) + also have "... = exp (- (x - (\ * \'\<^sup>2 + \' * \\<^sup>2) / (\\<^sup>2 + \'\<^sup>2))\<^sup>2 / (2 * (\ * \' / sqrt (\\<^sup>2 + \'\<^sup>2))\<^sup>2) - (\ - \')\<^sup>2 / (2 * (\\<^sup>2 + \'\<^sup>2))) / (sqrt (2 * pi * \\<^sup>2) * sqrt (2 * pi * \'\<^sup>2))" + proof - + have "((x - \)\<^sup>2 / (2 * \\<^sup>2)) + ((x - \')\<^sup>2 / (2 * \'\<^sup>2)) = (x - (\ * \'\<^sup>2 + \' * \\<^sup>2) / (\\<^sup>2 + \'\<^sup>2))\<^sup>2 / (2 * (\ * \' / sqrt (\\<^sup>2 + \'\<^sup>2))\<^sup>2) + (\ - \')\<^sup>2 / (2 * (\\<^sup>2 + \'\<^sup>2))" + (is "?lhs' = ?rhs'") + proof - + have "?lhs' = (2 * ((x - \)\<^sup>2 * \'\<^sup>2) + 2 * ((x - \')\<^sup>2 * \\<^sup>2)) / (4 * (\\<^sup>2 * \'\<^sup>2))" + by(simp add: field_class.add_frac_eq[OF non0(1,2)]) + also have "... = ((x - \)\<^sup>2 * \'\<^sup>2 + (x - \')\<^sup>2 * \\<^sup>2) / (2 * (\\<^sup>2 * \'\<^sup>2))" + by(simp add: power2_eq_square division_ring_class.add_divide_distrib) + also have "... = ((\\<^sup>2 + \'\<^sup>2) * x\<^sup>2 - 2 * (\ * \'\<^sup>2 + \' * \\<^sup>2) * x + (\'\<^sup>2 * \\<^sup>2 + \\<^sup>2 * \'\<^sup>2)) / (2 * (\\<^sup>2 * \'\<^sup>2))" + by(simp add: comm_ring_1_class.power2_diff ring_class.left_diff_distrib semiring_class.distrib_right) + also have "... = ((\\<^sup>2 + \'\<^sup>2) * (x - (\ * \'\<^sup>2 + \' * \\<^sup>2) / (\\<^sup>2 + \'\<^sup>2))\<^sup>2 - ((\ * \'\<^sup>2 + \' * \\<^sup>2)\<^sup>2 - (\\<^sup>2 + \'\<^sup>2) * (\'\<^sup>2 * \\<^sup>2 + \\<^sup>2 * \'\<^sup>2)) / (\\<^sup>2 + \'\<^sup>2)) / (2 * (\\<^sup>2 * \'\<^sup>2))" + by(simp only: complete_the_square2'[OF non0(3),of x "(\ * \'\<^sup>2 + \' * \\<^sup>2)" "(\'\<^sup>2 * \\<^sup>2 + \\<^sup>2 * \'\<^sup>2)"]) + also have "... = ((\\<^sup>2 + \'\<^sup>2) * (x - (\ * \'\<^sup>2 + \' * \\<^sup>2) / (\\<^sup>2 + \'\<^sup>2))\<^sup>2) / (2 * (\\<^sup>2 * \'\<^sup>2)) - (((\ * \'\<^sup>2 + \' * \\<^sup>2)\<^sup>2 - (\\<^sup>2 + \'\<^sup>2) * (\'\<^sup>2 * \\<^sup>2 + \\<^sup>2 * \'\<^sup>2)) / (\\<^sup>2 + \'\<^sup>2)) / (2 * (\\<^sup>2 * \'\<^sup>2))" + by(simp add: division_ring_class.diff_divide_distrib) + also have "... = (x - (\ * \'\<^sup>2 + \' * \\<^sup>2) / (\\<^sup>2 + \'\<^sup>2))\<^sup>2 / (2 * ((\ * \') / sqrt (\\<^sup>2 + \'\<^sup>2))\<^sup>2) - (((\ * \'\<^sup>2 + \' * \\<^sup>2)\<^sup>2 - (\\<^sup>2 + \'\<^sup>2) * (\'\<^sup>2 * \\<^sup>2 + \\<^sup>2 * \'\<^sup>2)) / (\\<^sup>2 + \'\<^sup>2)) / (2 * (\\<^sup>2 * \'\<^sup>2))" + by(simp add: monoid_mult_class.power2_eq_square[of "(\ * \') / sqrt (\\<^sup>2 + \'\<^sup>2)"] ab_semigroup_mult_class.mult.commute[of "\\<^sup>2 + \'\<^sup>2"] ) + (simp add: monoid_mult_class.power2_eq_square[of \] monoid_mult_class.power2_eq_square[of \']) + also have "... = (x - (\ * \'\<^sup>2 + \' * \\<^sup>2) / (\\<^sup>2 + \'\<^sup>2))\<^sup>2 / (2 * (\ * \' / sqrt (\\<^sup>2 + \'\<^sup>2))\<^sup>2) - ((\ * \'\<^sup>2)\<^sup>2 + (\' * \\<^sup>2)\<^sup>2 + 2 * (\ * \'\<^sup>2) * (\' * \\<^sup>2) - (\\<^sup>2 * (\'\<^sup>2 * \\<^sup>2) + \\<^sup>2 * (\\<^sup>2 * \'\<^sup>2) + (\'\<^sup>2 * (\'\<^sup>2 * \\<^sup>2) + \'\<^sup>2 * (\\<^sup>2 * \'\<^sup>2)))) / ((\\<^sup>2 + \'\<^sup>2) * (2 * (\\<^sup>2 * \'\<^sup>2)))" + by(simp add: comm_semiring_1_class.power2_sum[of "\ * \'\<^sup>2" "\' * \\<^sup>2"] semiring_class.distrib_right[of "\\<^sup>2" "\'\<^sup>2" "\'\<^sup>2 * \\<^sup>2 + \\<^sup>2 * \'\<^sup>2"] ) + (simp add: semiring_class.distrib_left[of _ "\'\<^sup>2 * \\<^sup>2 " "\\<^sup>2 * \'\<^sup>2"]) + also have "... = (x - (\ * \'\<^sup>2 + \' * \\<^sup>2) / (\\<^sup>2 + \'\<^sup>2))\<^sup>2 / (2 * (\ * \' / sqrt (\\<^sup>2 + \'\<^sup>2))\<^sup>2) + ((\\<^sup>2 * \'\<^sup>2)*\\<^sup>2 + (\\<^sup>2 * \'\<^sup>2)*\'\<^sup>2 - (\\<^sup>2 * \'\<^sup>2) * 2 * (\*\')) / ((\\<^sup>2 + \'\<^sup>2) * (2 * (\\<^sup>2 * \'\<^sup>2)))" + by(simp add: monoid_mult_class.power2_eq_square division_ring_class.minus_divide_left) + also have "... = (x - (\ * \'\<^sup>2 + \' * \\<^sup>2) / (\\<^sup>2 + \'\<^sup>2))\<^sup>2 / (2 * (\ * \' / sqrt (\\<^sup>2 + \'\<^sup>2))\<^sup>2) + (\\<^sup>2 + \'\<^sup>2 - 2 * (\*\')) / ((\\<^sup>2 + \'\<^sup>2) * 2)" + using assms by(simp add: division_ring_class.add_divide_distrib division_ring_class.diff_divide_distrib) + also have "... = ?rhs'" + by(simp add: comm_ring_1_class.power2_diff ab_semigroup_mult_class.mult.commute[of 2]) + finally show ?thesis . + qed + thus ?thesis + by simp + qed + also have "... = (exp (- (\ - \')\<^sup>2 / (2 * (\\<^sup>2 + \'\<^sup>2))) / (sqrt (2 * pi * \\<^sup>2) * sqrt (2 * pi * \'\<^sup>2))) * sqrt (2 * pi * (\ * \' / sqrt (\\<^sup>2 + \'\<^sup>2))\<^sup>2) * normal_density ((\ * \'\<^sup>2 + \' * \\<^sup>2) / (\\<^sup>2 + \'\<^sup>2)) (\ * \' / sqrt (\\<^sup>2 + \'\<^sup>2)) x" + by(simp add: exp_add[of "- (x - (\ * \'\<^sup>2 + \' * \\<^sup>2) / (\\<^sup>2 + \'\<^sup>2))\<^sup>2 / (2 * (\ * \' / sqrt (\\<^sup>2 + \'\<^sup>2))\<^sup>2)" "- (\ - \')\<^sup>2 / (2 * (\\<^sup>2 + \'\<^sup>2))",simplified] normal_density_def) + also have "... = ?rhs" + proof - + have "exp (- (\ - \')\<^sup>2 / (2 * (\\<^sup>2 + \'\<^sup>2))) / (sqrt (2 * pi * \\<^sup>2) * sqrt (2 * pi * \'\<^sup>2)) * sqrt (2 * pi * (\ * \' / sqrt (\\<^sup>2 + \'\<^sup>2))\<^sup>2) = 1 / sqrt (2 * pi * (\\<^sup>2 + \'\<^sup>2)) * exp (- (\ - \')\<^sup>2 / (2 * (\\<^sup>2 + \'\<^sup>2)))" + using assms by(simp add: real_sqrt_mult) + thus ?thesis + by simp + qed + finally show ?thesis . +qed + +lemma KL_normal_density: + assumes [arith]: "b > 0" "d > 0" + shows "KL_divergence (exp 1) (density lborel (normal_density a b)) (density lborel (normal_density c d)) = ln (b / d) + (d\<^sup>2 + (c - a)\<^sup>2) / (2 * b\<^sup>2) - 1 / 2" (is "?lhs = ?rhs") +proof - + have "?lhs = (\x. normal_density c d x * ln (normal_density c d x / normal_density a b x) \lborel)" + by(unfold log_ln,rule lborel.KL_density_density) (use order.strict_implies_not_eq[OF normal_density_pos[of b a]] in auto) + also have "... = (\x. normal_density c d x * ln (normal_density c d x) - normal_density c d x * ln (normal_density a b x) \lborel)" + by(simp add: ln_div[OF normal_density_pos[OF assms(2)] normal_density_pos[OF assms(1)]] right_diff_distrib) + also have "... = (\x. normal_density c d x * ln (exp (- (x - c)\<^sup>2 / (2 * d\<^sup>2)) / sqrt (2 * pi * d\<^sup>2)) - normal_density c d x * ln (exp (- (x - a)\<^sup>2 / (2 * b\<^sup>2)) / sqrt (2 * pi * b\<^sup>2)) \lborel)" + by(simp add: normal_density_def) + also have "... = (\x. normal_density c d x * (- (x - c)\<^sup>2 / (2 * d\<^sup>2) - ln (sqrt (2 * pi * d\<^sup>2))) - (normal_density c d x * (- (x - a)\<^sup>2 / (2 * b\<^sup>2) - ln (sqrt (2 * pi * b\<^sup>2)))) \lborel)" + by(simp add: ln_div) + also have "... = (\x. normal_density c d x * (ln (sqrt (2 * pi * b\<^sup>2)) - ln (sqrt (2 * pi * d\<^sup>2))) + (normal_density c d x * ((x - a)\<^sup>2 / (2 * b\<^sup>2)) - normal_density c d x * ((x - c)\<^sup>2 / (2 * d\<^sup>2))) \lborel)" + by(auto intro!: Bochner_Integration.integral_cong simp: right_diff_distrib) + also have "... = (\x. normal_density c d x * (ln (sqrt (2 * pi * b\<^sup>2)) - ln (sqrt (2 * pi * d\<^sup>2))) + (normal_density c d x * ((x - c)\<^sup>2 / (2 * b\<^sup>2) + (2 * x * (c - a) + a^2 - c^2) / (2 * b\<^sup>2)) - normal_density c d x * ((x - c)\<^sup>2 / (2 * d\<^sup>2))) \lborel)" + by(auto intro!: Bochner_Integration.integral_cong simp: add_divide_distrib[symmetric] power2_diff) (simp add: right_diff_distrib) + also have "... = (\x. (ln (sqrt (2 * pi * b\<^sup>2)) - ln (sqrt (2 * pi * d\<^sup>2))) * normal_density c d x + ((1 / (2 * b\<^sup>2) * (normal_density c d x * (x - c)\<^sup>2) + (2 * (c - a)) / (2 * b\<^sup>2) * (normal_density c d x * x) + (a^2 - c^2) / (2 * b\<^sup>2) * (normal_density c d x)) - 1 / (2 * d\<^sup>2) * (normal_density c d x * (x - c)\<^sup>2)) \lborel)" + by(auto intro!: Bochner_Integration.integral_cong simp: add_divide_distrib[symmetric] ring_distribs) + also have "... = (\x. (ln (sqrt (2 * pi * b\<^sup>2)) - ln (sqrt (2 * pi * d\<^sup>2))) * normal_density c d x \lborel) + (((\x. 1 / (2 * b\<^sup>2) * (normal_density c d x * (x - c)\<^sup>2) \lborel) + (\x. (2 * (c - a)) / (2 * b\<^sup>2) * (normal_density c d x * x) \lborel) + (\x. (a^2 - c^2) / (2 * b\<^sup>2) * (normal_density c d x) \lborel)) - (\x. 1 / (2 * d\<^sup>2) * (normal_density c d x * (x - c)\<^sup>2) \lborel))" + using integrable_normal_moment_nz_1[OF assms(2)] integrable_normal_moment[OF assms(2),where k=2] by simp + also have "... = ln (sqrt (2 * pi * b\<^sup>2)) - ln (sqrt (2 * pi * d\<^sup>2)) + 1 / (2 * b\<^sup>2) * d\<^sup>2 + (2 * c - 2 * a) / (2 * b\<^sup>2) * c + (a\<^sup>2 - c\<^sup>2) / (2 * b\<^sup>2) - 1 / (2 * d\<^sup>2) * d\<^sup>2" + by(simp add: integral_normal_moment_even[OF assms(2),of _ 1,simplified] integral_normal_moment_nz_1[OF assms(2)] del: times_divide_eq_left) + also have "... = ln (b / d) + 1 / (2 * b\<^sup>2) * d\<^sup>2 + (2 * c - 2 * a) / (2 * b\<^sup>2) * c + (a\<^sup>2 - c\<^sup>2) / (2 * b\<^sup>2) - 1 / (2 * d\<^sup>2) * d\<^sup>2" + by(simp add: ln_sqrt ln_mult power2_eq_square diff_divide_distrib[symmetric] ln_div) + also have "... = ?rhs" + by(auto simp: add_divide_distrib[symmetric] power2_diff left_diff_distrib) (simp add: power2_eq_square) + finally show ?thesis . +qed + +lemma count_space_prod:"count_space (UNIV :: ('a :: countable) set) \\<^sub>M count_space (UNIV :: ('b :: countable) set) = count_space UNIV" + by(auto simp: pair_measure_countable) + +lemma measure_pair_pmf: + fixes p :: "('a :: countable) pmf" and q :: "('b :: countable) pmf" + shows "measure_pmf p \\<^sub>M measure_pmf q = measure_pmf (pair_pmf p q)" (is "?lhs = ?rhs") +proof - + interpret pair_prob_space "measure_pmf p" "measure_pmf q" + by standard + have "?lhs = measure_pmf p \ (\x. measure_pmf q \ (\y. return (measure_pmf p \\<^sub>M measure_pmf q) (x, y)))" + by(rule pair_measure_eq_bind) + also have "... = ?rhs" + by(simp add: measure_pmf_bind pair_pmf_def return_pmf.rep_eq cong: return_cong[OF sets_pair_measure_cong[OF sets_measure_pmf_count_space[of p] sets_measure_pmf_count_space[of q],simplified count_space_prod]]) + finally show ?thesis . +qed + +lemma distr_PiM_distr: + assumes "finite I" "\i. i \ I \ sigma_finite_measure (distr (M i) (N i) (f i))" + and "\i. i \ I \ f i \ M i \\<^sub>M N i" + shows "distr (\\<^sub>M i\I. M i) (\\<^sub>M i\I. N i) (\xi. \i\I. f i (xi i)) = (\\<^sub>M i\I. distr (M i) (N i) (f i))" +proof - + define M' where "M' \ (\i. if i \ I then M i else null_measure (M i))" + have f[measurable]: "\i. i \ I \ f i \ M' i \\<^sub>M N i" and [measurable_cong]: "\i. sets (M' i) = sets (M i)" and [simp]: "\i. i \ I \ M' i = M i" + by(auto simp: M'_def assms) + interpret product_sigma_finite "\i. distr (M' i) (N i) (f i)" + by(auto simp: product_sigma_finite_def M'_def assms(2)) (auto intro!: finite_measure.sigma_finite_measure finite_measureI simp: null_measure_distr) + interpret ps: product_sigma_finite M' + by(auto simp: product_sigma_finite_def M'_def intro!: finite_measure.sigma_finite_measure[of "null_measure _"] finite_measureI sigma_finite_measure_distr[OF assms(2)]) + have "distr (\\<^sub>M i\I. M i) (\\<^sub>M i\I. N i) (\xi. \i\I. f i (xi i)) = distr (\\<^sub>M i\I. M' i) (\\<^sub>M i\I. N i) (\xi. \i\I. f i (xi i))" + by(simp cong: PiM_cong) + also have "... = (\\<^sub>M i\I. distr (M' i) (N i) (f i))" + proof(rule PiM_eqI[OF assms(1)]) + fix A + assume "\i. i \ I \ A i \ sets (distr (M' i) (N i) (f i))" + hence h[measurable]:"\i. i \ I \ A i \ sets (N i)" + by simp + have [simp]:"(\xi. \i\I. f i (xi i)) -` (Pi\<^sub>E I A) \ space (Pi\<^sub>M I M') = (\\<^sub>E i\I. f i -` A i \ space (M' i))" + by(auto simp: space_PiM) + show "emeasure (distr (Pi\<^sub>M I M') (Pi\<^sub>M I N) (\xi. \i\I. f i (xi i))) (Pi\<^sub>E I A) = (\i\I. emeasure (distr (M' i) (N i) (f i)) (A i))" + by(auto simp: emeasure_distr assms(1) ps.emeasure_PiM[OF assms(1)]) + qed(simp_all cong: sets_PiM_cong) + also have "... = (\\<^sub>M i\I. distr (M i) (N i) (f i))" + by(auto cong: PiM_cong) + finally show ?thesis . +qed + +lemma distr_PiM_distr_prob: + assumes "\i. i \ I \ prob_space (M i)" + and "\i. i \ I \ f i \ M i \\<^sub>M N i" + shows "distr (\\<^sub>M i\I. M i) (\\<^sub>M i\I. N i) (\xi. \i\I. f i (xi i)) = (\\<^sub>M i\I. distr (M i) (N i) (f i))" +proof - + define M' where "M' \ (\i. if i \ I then M i else return (count_space UNIV) undefined)" + define N' where "N' \ (\i. if i \ I then N i else return (count_space UNIV) undefined)" + interpret p: product_prob_space "\i. distr (M' i) (N' i) (f i)" + by(auto simp: product_prob_space_def product_prob_space_axioms_def product_sigma_finite_def M'_def prob_space_return N'_def assms intro!: prob_space_imp_sigma_finite prob_space.prob_space_distr) + interpret p': product_prob_space M' + by(auto simp: product_prob_space_def product_prob_space_axioms_def product_sigma_finite_def M'_def prob_space_return assms intro!: prob_space_imp_sigma_finite) + have f[measurable]: "\i. i \ I \ f i \ M' i \\<^sub>M N' i" + by(auto simp: assms M'_def N'_def) + have [simp]: "p.emb I = prod_emb I N'" + by standard (auto simp: prod_emb_def) + have "distr (\\<^sub>M i\I. M i) (\\<^sub>M i\I. N i) (\xi. \i\I. f i (xi i)) = distr (\\<^sub>M i\I. M' i) (\\<^sub>M i\I. N' i) (\xi. \i\I. f i (xi i))" + by(simp add: M'_def N'_def cong: PiM_cong) + also have "... = (\\<^sub>M i\I. distr (M' i) (N' i) (f i))" + proof(rule p.PiM_eq) + fix J F + assume h[measurable]: "finite J" "J \ I" "\j. j \ J \ F j \ p.M.events j" + then have [measurable]: "\j. j \ J \ F j \ sets (N' j)" by simp + show " emeasure (distr (Pi\<^sub>M I M') (Pi\<^sub>M I N') (\xi. \i\I. f i (xi i))) (p.emb I J (Pi\<^sub>E J F)) = (\j\J. emeasure (distr (M' j) (N' j) (f j)) (F j))" (is "?lhs = ?rhs") + proof - + have "?lhs = emeasure (Pi\<^sub>M I M') ((\xi. \i\I. f i (xi i)) -` (prod_emb I N' J (Pi\<^sub>E J F)) \ space (Pi\<^sub>M I M'))" + by(simp add: emeasure_distr h) + also have "... = emeasure (Pi\<^sub>M I M') (prod_emb I M' J (\\<^sub>E i\J. f i -` (F i) \ space (M' i)))" + proof - + have [simp]:"(\xi. \i\I. f i (xi i)) -` (prod_emb I N' J (Pi\<^sub>E J F)) \ space (Pi\<^sub>M I M') = prod_emb I M' J (\\<^sub>E i\J. f i -` (F i) \ space (M' i))" + using measurable_space[OF f] h(1,2,3) + by(fastforce simp: space_PiM prod_emb_def PiE_def extensional_def Pi_def M'_def N'_def) + show ?thesis by simp + qed + also have "... = (\i\J. emeasure (M' i) (f i -` (F i) \ space (M' i)))" + by(rule p'.emeasure_PiM_emb,insert h(2)) (auto simp: h(1)) + also have "... = ?rhs" + using h(2) by(auto simp: emeasure_distr intro!: comm_monoid_mult_class.prod.cong) + finally show ?thesis . + qed + qed (simp cong: sets_PiM_cong) + also have "... = (\\<^sub>M i\I. distr (M i) (N i) (f i))" + by(simp add: M'_def N'_def cong: distr_cong PiM_cong) + finally show ?thesis . +qed + +end \ No newline at end of file diff --git a/thys/S_Finite_Measure_Monad/Measure_QuasiBorel_Adjunction.thy b/thys/S_Finite_Measure_Monad/Measure_QuasiBorel_Adjunction.thy new file mode 100644 --- /dev/null +++ b/thys/S_Finite_Measure_Monad/Measure_QuasiBorel_Adjunction.thy @@ -0,0 +1,1532 @@ +(* Title: Measure_QuasiBorel_Adjunction.thy + Author: Michikazu Hirata, Tokyo Institute of Technology +*) + +subsection \Relation to Measurable Spaces\ + +theory Measure_QuasiBorel_Adjunction + imports "QuasiBorel" "QBS_Morphism" Lemmas_S_Finite_Measure_Monad +begin + +text \ We construct the adjunction between \textbf{Meas} and \textbf{QBS}, + where \textbf{Meas} is the category of measurable spaces and measurable functions, + and \textbf{QBS} is the category of quasi-Borel spaces and morphisms.\ + +subsubsection \ The Functor $R$ \ +definition measure_to_qbs :: "'a measure \ 'a quasi_borel" where +"measure_to_qbs X \ Abs_quasi_borel (space X, borel \\<^sub>M X)" + +lemma + shows qbs_space_R: "qbs_space (measure_to_qbs X) = space X" (is ?goal1) + and qbs_Mx_R: "qbs_Mx (measure_to_qbs X) = borel \\<^sub>M X" (is ?goal2) +proof - + have "Rep_quasi_borel (measure_to_qbs X) = (space X, borel \\<^sub>M X)" + by(auto intro!: Abs_quasi_borel_inverse is_quasi_borel_intro qbs_closed1I qbs_closed2I simp: measure_to_qbs_def dest:measurable_space) (rule qbs_closed3I, auto) + thus ?goal1 ?goal2 + by (simp_all add: qbs_space_def qbs_Mx_def) +qed + +text \ The following lemma says that @{term measure_to_qbs} is a functor from \textbf{Meas} to \textbf{QBS}. \ +lemma r_preserves_morphisms: + "X \\<^sub>M Y \ (measure_to_qbs X) \\<^sub>Q (measure_to_qbs Y)" + by(auto intro!: qbs_morphismI simp: qbs_Mx_R) + +subsubsection \ The Functor $L$ \ +definition sigma_Mx :: "'a quasi_borel \ 'a set set" where +"sigma_Mx X \ {U \ qbs_space X |U. \\\qbs_Mx X. \ -` U \ sets borel}" + +definition qbs_to_measure :: "'a quasi_borel \ 'a measure" where +"qbs_to_measure X \ Abs_measure (qbs_space X, sigma_Mx X, \A. (if A = {} then 0 else if A \ - sigma_Mx X then 0 else \))" + +lemma measure_space_L: "measure_space (qbs_space X) (sigma_Mx X) (\A. (if A = {} then 0 else if A \ - sigma_Mx X then 0 else \))" + unfolding measure_space_def +proof safe + + show "sigma_algebra (qbs_space X) (sigma_Mx X)" + proof(rule sigma_algebra.intro) + show "algebra (qbs_space X) (sigma_Mx X)" + proof + have "\ U \ sigma_Mx X. U \ qbs_space X" + using sigma_Mx_def subset_iff by fastforce + thus "sigma_Mx X \ Pow (qbs_space X)" by auto + next + show "{} \ sigma_Mx X" + unfolding sigma_Mx_def by auto + next + fix A + fix B + assume "A \ sigma_Mx X" + "B \ sigma_Mx X" + then have "\ Ua. A = Ua \ qbs_space X \ (\\\qbs_Mx X. \ -` Ua \ sets borel)" + by (simp add: sigma_Mx_def) + then obtain Ua where pa:"A = Ua \ qbs_space X \ (\\\qbs_Mx X. \ -` Ua \ sets borel)" by auto + have "\ Ub. B = Ub \ qbs_space X \ (\\\qbs_Mx X. \ -` Ub \ sets borel)" + using \B \ sigma_Mx X\ sigma_Mx_def by auto + then obtain Ub where pb:"B = Ub \ qbs_space X \ (\\\qbs_Mx X. \ -` Ub \ sets borel)" by auto + from pa pb have [simp]:"\\\qbs_Mx X. \ -` (Ua \ Ub) \ sets borel" + by auto + from this pa pb sigma_Mx_def have [simp]:"(Ua \ Ub) \ qbs_space X \ sigma_Mx X" by blast + from pa pb have [simp]:"A \ B = (Ua \ Ub) \ qbs_space X" by auto + thus "A \ B \ sigma_Mx X" by simp + next + fix A + fix B + assume "A \ sigma_Mx X" + "B \ sigma_Mx X" + then have "\ Ua. A = Ua \ qbs_space X \ (\\\qbs_Mx X. \ -` Ua \ sets borel)" + by (simp add: sigma_Mx_def) + then obtain Ua where pa:"A = Ua \ qbs_space X \ (\\\qbs_Mx X. \ -` Ua \ sets borel)" by auto + have "\ Ub. B = Ub \ qbs_space X \ (\\\qbs_Mx X. \ -` Ub \ sets borel)" + using \B \ sigma_Mx X\ sigma_Mx_def by auto + then obtain Ub where pb:"B = Ub \ qbs_space X \ (\\\qbs_Mx X. \ -` Ub \ sets borel)" by auto + from pa pb have [simp]:"A - B = (Ua \ -Ub) \ qbs_space X" by auto + from pa pb have "\\\qbs_Mx X. \ -`(Ua \ -Ub) \ sets borel" + by (metis Diff_Compl double_compl sets.Diff vimage_Compl vimage_Int) + hence 1:"A - B \ sigma_Mx X" + using sigma_Mx_def \A - B = Ua \ - Ub \ qbs_space X\ by blast + show "\C\sigma_Mx X. finite C \ disjoint C \ A - B = \ C" + proof + show "{A - B} \sigma_Mx X \ finite {A-B} \ disjoint {A-B} \ A - B = \ {A-B}" + using 1 by auto + qed + next + fix A + fix B + assume "A \ sigma_Mx X" + "B \ sigma_Mx X" + then have "\ Ua. A = Ua \ qbs_space X \ (\\\qbs_Mx X. \ -` Ua \ sets borel)" + by (simp add: sigma_Mx_def) + then obtain Ua where pa:"A = Ua \ qbs_space X \ (\\\qbs_Mx X. \ -` Ua \ sets borel)" by auto + have "\ Ub. B = Ub \ qbs_space X \ (\\\qbs_Mx X. \ -` Ub \ sets borel)" + using \B \ sigma_Mx X\ sigma_Mx_def by auto + then obtain Ub where pb:"B = Ub \ qbs_space X \ (\\\qbs_Mx X. \ -` Ub \ sets borel)" by auto + from pa pb have "A \ B = (Ua \ Ub) \ qbs_space X" by auto + from pa pb have "\\\qbs_Mx X. \ -`(Ua \ Ub) \ sets borel" by auto + then show "A \ B \ sigma_Mx X" + unfolding sigma_Mx_def + using \A \ B = (Ua \ Ub) \ qbs_space X\ by blast + next + have "\\\qbs_Mx X. \ -` (UNIV) \ sets borel" + by simp + thus "qbs_space X \ sigma_Mx X" + unfolding sigma_Mx_def + by blast + qed + next + show "sigma_algebra_axioms (sigma_Mx X)" + unfolding sigma_algebra_axioms_def + proof safe + fix A :: "nat \ _" + assume 1:"range A \ sigma_Mx X" + then have 2:"\i. \Ui. A i = Ui \ qbs_space X \ (\\\qbs_Mx X. \ -` Ui \ sets borel)" + unfolding sigma_Mx_def by auto + then have "\ U :: nat \ _. \i. A i = U i \ qbs_space X \ (\\\qbs_Mx X. \ -` (U i) \ sets borel)" + by (rule choice) + from this obtain U where pu:"\i. A i = U i \ qbs_space X \ (\\\qbs_Mx X. \ -` (U i) \ sets borel)" + by auto + hence "\\\qbs_Mx X. \ -` (\ (range U)) \ sets borel" + by (simp add: countable_Un_Int(1) vimage_UN) + from pu have "\ (range A) = (\i::nat. (U i \ qbs_space X))" by blast + hence "\ (range A) = \ (range U) \ qbs_space X" by auto + thus "\ (range A) \ sigma_Mx X" + using sigma_Mx_def \\\\qbs_Mx X. \ -` \ (range U) \ sets borel\ by blast + qed + qed +next + show "countably_additive (sigma_Mx X) (\A. if A = {} then 0 else if A \ - sigma_Mx X then 0 else \)" + proof(rule countably_additiveI) + fix A :: "nat \ _" + assume h:"range A \ sigma_Mx X" + "\ (range A) \ sigma_Mx X" + consider "\ (range A) = {}" | "\ (range A) \ {}" + by auto + then show "(\i. if A i = {} then 0 else if A i \ - sigma_Mx X then 0 else \) = + (if \ (range A) = {} then 0 else if \ (range A) \ - sigma_Mx X then 0 else (\ :: ennreal))" + proof cases + case 1 + then have "\i. A i = {}" + by simp + thus ?thesis + by(simp add: 1) + next + case 2 + then obtain j where hj:"A j \ {}" + by auto + have "(\i. if A i = {} then 0 else if A i \ - sigma_Mx X then 0 else \) = (\ :: ennreal)" + proof - + have hsum:"\N f. sum f {.. (\n. (f n :: ennreal))" + by (simp add: sum_le_suminf) + have hsum':"\P f. (\j. j \ P \ f j = (\ :: ennreal)) \ finite P \ sum f P = \" + by auto + have h1:"(\i - sigma_Mx X then 0 else \) = (\ :: ennreal)" + proof(rule hsum') + show "\ja. ja \ {.. (if A ja = {} then 0 else if A ja \ - sigma_Mx X then 0 else \) = (\ :: ennreal)" + proof(rule exI[where x=j],rule conjI) + have "A j \ sigma_Mx X" + using h(1) by auto + then show "(if A j = {} then 0 else if A j \ - sigma_Mx X then 0 else \) = (\ :: ennreal)" + using hj by simp + qed simp + qed simp + have "(\i - sigma_Mx X then 0 else \) \ (\i. if A i = {} then 0 else if A i \ - sigma_Mx X then 0 else (\ :: ennreal))" + by(rule hsum) + thus ?thesis + by(simp only: h1) (simp add: top.extremum_unique) + qed + moreover have "(if \ (range A) = {} then 0 else if \ (range A) \ - sigma_Mx X then 0 else \) = (\ :: ennreal)" + using 2 h(2) by simp + ultimately show ?thesis + by simp + qed + qed +qed(simp add: positive_def) + +lemma + shows space_L: "space (qbs_to_measure X) = qbs_space X" (is ?goal1) + and sets_L: "sets (qbs_to_measure X) = sigma_Mx X" (is ?goal2) + and emeasure_L: "emeasure (qbs_to_measure X) = (\A. if A = {} \ A \ sigma_Mx X then 0 else \)" (is ?goal3) +proof - + have "Rep_measure (qbs_to_measure X) = (qbs_space X, sigma_Mx X, \A. (if A = {} then 0 else if A \ - sigma_Mx X then 0 else \))" + unfolding qbs_to_measure_def by(auto intro!: Abs_measure_inverse simp: measure_space_L) + thus ?goal1 ?goal2 ?goal3 + by(auto simp: sets_def space_def emeasure_def) +qed + +lemma qbs_Mx_sigma_Mx_contra: + assumes "qbs_space X = qbs_space Y" + and "qbs_Mx X \ qbs_Mx Y" + shows "sigma_Mx Y \ sigma_Mx X" + using assms by(auto simp: sigma_Mx_def) + + +text \ The following lemma says that @{term qbs_to_measure} is a functor from \textbf{QBS} to \textbf{Meas}. \ +lemma l_preserves_morphisms: + "X \\<^sub>Q Y \ (qbs_to_measure X) \\<^sub>M (qbs_to_measure Y)" +proof safe + fix f + assume h:"f \ X \\<^sub>Q Y" + show "f \ (qbs_to_measure X) \\<^sub>M (qbs_to_measure Y)" + proof(rule measurableI) + fix A + assume "A \ sets (qbs_to_measure Y)" + then obtain Ua where pa:"A = Ua \ qbs_space Y \ (\\\qbs_Mx Y. \ -` Ua \ sets borel)" + by (auto simp: sigma_Mx_def sets_L) + have "\\\qbs_Mx X. f \ \ \ qbs_Mx Y" + "\\\ qbs_Mx X. \ -` (f -` (qbs_space Y)) = UNIV" + using qbs_morphism_space[OF h] qbs_morphism_Mx[OF h] by (auto simp: qbs_Mx_to_X) + hence "\\\qbs_Mx X. \ -` (f -` A) = \ -` (f -` Ua)" + by (simp add: pa) + from pa this qbs_morphism_def have "\\\qbs_Mx X. \ -` (f -` A) \ sets borel" + by (simp add: vimage_comp \\\\qbs_Mx X. f \ \ \ qbs_Mx Y\) + thus "f -` A \ space (qbs_to_measure X) \ sets (qbs_to_measure X)" + using sigma_Mx_def by(auto simp: sets_L space_L) + qed (insert qbs_morphism_space[OF h], auto simp: space_L) +qed + + +abbreviation qbs_borel ("borel\<^sub>Q") where "borel\<^sub>Q \ measure_to_qbs borel" +abbreviation qbs_count_space ("count'_space\<^sub>Q") where "qbs_count_space I \ measure_to_qbs (count_space I)" + +declare [[coercion measure_to_qbs]] + +lemma + shows qbs_space_qbs_borel[simp]: "qbs_space borel\<^sub>Q = UNIV" + and qbs_space_count_space[simp]: "qbs_space (qbs_count_space I) = I" + and qbs_Mx_qbs_borel: "qbs_Mx borel\<^sub>Q = borel_measurable borel" + and qbs_Mx_count_space: "qbs_Mx (qbs_count_space I) = borel \\<^sub>M count_space I" + by(simp_all add: qbs_space_R qbs_Mx_R) + +(* Want to remove the following *) +lemma + shows qbs_space_qbs_borel'[qbs]: "r \ qbs_space borel\<^sub>Q" + and qbs_space_count_space_UNIV'[qbs]: "x \ qbs_space (qbs_count_space (UNIV :: (_ :: countable) set))" + by simp_all + +lemma qbs_Mx_is_morphisms: "qbs_Mx X = borel\<^sub>Q \\<^sub>Q X" +proof safe + fix \ :: "real \ _" + assume "\ \ borel\<^sub>Q \\<^sub>Q X" + have "id \ qbs_Mx borel\<^sub>Q" by (simp add: qbs_Mx_R) + then have "\ \ id \ qbs_Mx X" + using qbs_morphism_Mx[OF \\ \ borel\<^sub>Q \\<^sub>Q X\] + by blast + then show "\ \ qbs_Mx X" by simp +qed(auto intro!: qbs_morphismI simp: qbs_Mx_qbs_borel) + +lemma exp_qbs_Mx': "qbs_Mx (exp_qbs X Y) = {g. case_prod g \ borel\<^sub>Q \\<^sub>Q X \\<^sub>Q Y}" + by(auto simp: qbs_Mx_qbs_borel comp_def qbs_Mx_is_morphisms split_beta' intro!:curry_preserves_morphisms) + +lemma arg_swap_morphism': + assumes "(\g. f (\w x. g x w)) \ exp_qbs X (exp_qbs W Y) \\<^sub>Q Z" + shows "f \ exp_qbs W (exp_qbs X Y) \\<^sub>Q Z" +proof(rule qbs_morphismI) + fix \ + assume "\ \ qbs_Mx (exp_qbs W (exp_qbs X Y))" + then have "(\((r,w),x). \ r w x) \ (borel\<^sub>Q \\<^sub>Q W) \\<^sub>Q X \\<^sub>Q Y" + by(auto simp: qbs_Mx_is_morphisms dest: uncurry_preserves_morphisms) + hence "(\(r,w,x). \ r w x) \ borel\<^sub>Q \\<^sub>Q W \\<^sub>Q X \\<^sub>Q Y" + by(auto intro!: qbs_morphism_cong'[where f="(\((r,w),x). \ r w x) \ (\(x, y, z). ((x, y), z))" and g="\(r,w,x). \ r w x"] qbs_morphism_comp[OF qbs_morphism_pair_assoc2]) + hence "(\(r,x,w). \ r w x) \ borel\<^sub>Q \\<^sub>Q X \\<^sub>Q W \\<^sub>Q Y" + by(auto intro!: qbs_morphism_cong'[where f="(\(r,w,x). \ r w x) \ map_prod id (\(x,y). (y,x))" and g="(\(r,x,w). \ r w x)"] qbs_morphism_comp qbs_morphism_map_prod qbs_morphism_pair_swap) + hence "(\((r,x),w). \ r w x) \ (borel\<^sub>Q \\<^sub>Q X) \\<^sub>Q W \\<^sub>Q Y" + by(auto intro!: qbs_morphism_cong'[where f="(\(r,x,w). \ r w x) \ (\((x, y), z). (x, y, z))" and g="\((r,x),w). \ r w x"] qbs_morphism_comp[OF qbs_morphism_pair_assoc1]) + hence "(\r x w. \ r w x) \ qbs_Mx (exp_qbs X (exp_qbs W Y))" + by(auto simp: qbs_Mx_is_morphisms split_beta') + from qbs_morphism_Mx[OF assms this] show "f \ \ \ qbs_Mx Z" + by(auto simp: comp_def) +qed + +lemma qbs_Mx_subset_of_measurable: "qbs_Mx X \ borel \\<^sub>M qbs_to_measure X" +proof + fix \ + assume "\ \ qbs_Mx X" + show "\ \ borel \\<^sub>M qbs_to_measure X" + proof(rule measurableI) + fix x + show "\ x \ space (qbs_to_measure X)" + using qbs_Mx_to_X \\ \ qbs_Mx X\ by(simp add: space_L) + next + fix A + assume "A \ sets (qbs_to_measure X)" + then have "\ -`(qbs_space X) = UNIV" + using \\ \ qbs_Mx X\ qbs_Mx_to_X by(auto simp: sets_L) + then show "\ -` A \ space borel \ sets borel" + using \\ \ qbs_Mx X\ \A \ sets (qbs_to_measure X)\ + by(auto simp add: sigma_Mx_def sets_L) + qed +qed + +lemma L_max_of_measurables: + assumes "space M = qbs_space X" + and "qbs_Mx X \ borel \\<^sub>M M" + shows "sets M \ sets (qbs_to_measure X)" +proof + fix U + assume "U \ sets M" + from sets.sets_into_space[OF this] in_mono[OF assms(2)] measurable_sets_borel[OF _ this] + show "U \ sets (qbs_to_measure X)" + using assms(1) + by(auto intro!: exI[where x=U] simp: sigma_Mx_def sets_L) +qed + + +lemma qbs_Mx_are_measurable[simp,measurable]: + assumes "\ \ qbs_Mx X" + shows "\ \ borel \\<^sub>M qbs_to_measure X" + using assms qbs_Mx_subset_of_measurable by auto + +lemma measure_to_qbs_cong_sets: + assumes "sets M = sets N" + shows "measure_to_qbs M = measure_to_qbs N" + by(rule qbs_eqI) (simp add: qbs_Mx_R measurable_cong_sets[OF _ assms]) + +lemma lr_sets[simp]: + "sets X \ sets (qbs_to_measure (measure_to_qbs X))" + unfolding sets_L +proof safe + fix U + assume "U \ sets X" + then have "U \ space X = U" by simp + moreover have "\\\borel \\<^sub>M X. \ -` U \ sets borel" + using \U \ sets X\ by(auto simp add: measurable_def) + ultimately show "U \ sigma_Mx (measure_to_qbs X)" + by(auto simp add: sigma_Mx_def qbs_Mx_R qbs_space_R) +qed + +lemma(in standard_borel) lr_sets_ident[simp, measurable_cong]: + "sets (qbs_to_measure (measure_to_qbs M)) = sets M" + unfolding sets_L +proof safe + fix V + assume "V \ sigma_Mx (measure_to_qbs M)" + then obtain U where H2: "V = U \ space M" "\\::real \ _. \\borel \\<^sub>M M \ \ -` U \ sets borel" + by(auto simp: sigma_Mx_def qbs_Mx_R qbs_space_R) + consider "space M = {}" | "space M \ {}" by auto + then show "V \ sets M" + proof cases + case 1 + then show ?thesis + by(simp add: H2) + next + case 2 + have "from_real -` V = from_real -` (U \ space M)" using H2 by auto + also have "... = from_real -` U" using from_real_measurable'[OF 2] by(auto simp add: measurable_def) + finally have "to_real -` from_real -` U \ space M \ sets M" + by (meson "2" H2(2) from_real_measurable' measurable_sets to_real_measurable) + moreover have "to_real -` from_real -` U \ space M = U \ space M" + by auto + ultimately show ?thesis using H2 by simp + qed +qed(insert lr_sets, auto simp: sets_L) + +corollary sets_lr_polish_borel[simp, measurable_cong]: "sets (qbs_to_measure qbs_borel) = sets (borel :: (_ :: polish_space) measure)" + by(auto intro!: standard_borel.lr_sets_ident standard_borel_ne.standard_borel) + +corollary sets_lr_count_space[simp, measurable_cong]: "sets (qbs_to_measure (qbs_count_space (UNIV :: (_ :: countable) set))) = sets (count_space UNIV)" + by(rule standard_borel.lr_sets_ident) (auto intro!: standard_borel_ne.standard_borel) + +subsubsection \ The Adjunction \ +lemma lr_adjunction_correspondence : + "X \\<^sub>Q (measure_to_qbs Y) = (qbs_to_measure X) \\<^sub>M Y" +proof safe +(* \ *) + fix f + assume "f \ X \\<^sub>Q (measure_to_qbs Y)" + show "f \ qbs_to_measure X \\<^sub>M Y" + proof(rule measurableI) + fix x + assume "x \ space (qbs_to_measure X)" + thus "f x \ space Y" + using qbs_morphism_space[OF \f \ X \\<^sub>Q (measure_to_qbs Y)\] + by (auto simp: qbs_space_R space_L) + next + fix A + assume "A \ sets Y" + have "\\ \ qbs_Mx X. f \ \ \ qbs_Mx (measure_to_qbs Y)" + using qbs_morphism_Mx[OF \f \ X \\<^sub>Q (measure_to_qbs Y)\] by auto + hence "\\ \ qbs_Mx X. f \ \ \ borel \\<^sub>M Y" by (simp add: qbs_Mx_R) + hence "\\ \ qbs_Mx X. \ -` (f -` A) \ sets borel" + using \A\ sets Y\ measurable_sets_borel vimage_comp by metis + thus "f -` A \ space (qbs_to_measure X) \ sets (qbs_to_measure X)" + using sigma_Mx_def by (auto simp: space_L sets_L) + qed + +(* \ *) +next + fix f + assume "f \ qbs_to_measure X \\<^sub>M Y" + show "f \ X \\<^sub>Q measure_to_qbs Y" + proof(rule qbs_morphismI) + fix \ + assume "\ \ qbs_Mx X" + have "f \ \ \ borel \\<^sub>M Y" + proof(rule measurableI) + fix x :: real + from \\ \ qbs_Mx X\ qbs_Mx_to_X have "\ x \ qbs_space X" by auto + hence "\ x \ space (qbs_to_measure X)" by (simp add: space_L) + thus "(f \ \) x \ space Y" + using \f \ qbs_to_measure X \\<^sub>M Y\ + by (metis comp_def measurable_space) + next + fix A + assume "A \ sets Y" + from \f \ qbs_to_measure X \\<^sub>M Y\ measurable_sets this measurable_def + have "f -` A \ space (qbs_to_measure X) \ sets (qbs_to_measure X)" + by blast + hence "f -` A \ qbs_space X \ sigma_Mx X" by (simp add: sets_L space_L) + then have "\V. f -` A \ qbs_space X = V \ qbs_space X \ (\\\ qbs_Mx X. \ -` V \ sets borel)" + by (simp add: sigma_Mx_def) + then obtain V where h:"f -` A \ qbs_space X = V \ qbs_space X \ (\\\ qbs_Mx X. \ -` V \ sets borel)" by auto + have 1:"\ -` (f -` A) = \ -` (f -` A \ qbs_space X)" + using \\ \ qbs_Mx X\ qbs_Mx_to_X by blast + have 2:"\ -` (V \ qbs_space X) = \ -` V" + using \\ \ qbs_Mx X\ qbs_Mx_to_X by blast + from 1 2 h have "(f \ \) -` A = \ -` V" by (simp add: vimage_comp) + from this h \\ \ qbs_Mx X \show "(f \ \) -` A \ space borel \ sets borel" by simp + qed + thus "f \ \ \ qbs_Mx (measure_to_qbs Y)" + by(simp add:qbs_Mx_R) + qed +qed + +lemma(in standard_borel) standard_borel_r_full_faithful: + "M \\<^sub>M Y = measure_to_qbs M \\<^sub>Q measure_to_qbs Y" +proof + have "measure_to_qbs M \\<^sub>Q measure_to_qbs Y \ qbs_to_measure (measure_to_qbs M) \\<^sub>M qbs_to_measure (measure_to_qbs Y)" + by (simp add: l_preserves_morphisms) + also have "... = M \\<^sub>M qbs_to_measure (measure_to_qbs Y)" + using measurable_cong_sets by auto + also have "... \ M \\<^sub>M Y" + by(rule measurable_mono[OF lr_sets]) (simp_all add: qbs_space_R space_L) + finally show "measure_to_qbs M \\<^sub>Q measure_to_qbs Y \ M \\<^sub>M Y" . +qed(rule r_preserves_morphisms) + +lemma qbs_morphism_dest: + assumes "f \ X \\<^sub>Q measure_to_qbs Y" + shows "f \ qbs_to_measure X \\<^sub>M Y" + using assms lr_adjunction_correspondence by auto + +lemma(in standard_borel) qbs_morphism_dest: + assumes "k \ measure_to_qbs M \\<^sub>Q measure_to_qbs Y" + shows "k \ M \\<^sub>M Y" + using standard_borel_r_full_faithful assms by auto + +lemma qbs_morphism_measurable_intro: + assumes "f \ qbs_to_measure X \\<^sub>M Y" + shows "f \ X \\<^sub>Q measure_to_qbs Y" + using assms lr_adjunction_correspondence by auto + +lemma(in standard_borel) qbs_morphism_measurable_intro: + assumes "k \ M \\<^sub>M Y" + shows "k \ measure_to_qbs M \\<^sub>Q measure_to_qbs Y" + using standard_borel_r_full_faithful assms by auto + +lemma r_preserves_product : + "measure_to_qbs (X \\<^sub>M Y) = measure_to_qbs X \\<^sub>Q measure_to_qbs Y" + by(auto intro!: qbs_eqI simp: measurable_pair_iff pair_qbs_Mx qbs_Mx_R) + +lemma l_product_sets: + "sets (qbs_to_measure X \\<^sub>M qbs_to_measure Y) \ sets (qbs_to_measure (X \\<^sub>Q Y))" +proof(rule sets_pair_in_sets) + fix A B + assume h:"A \ sets (qbs_to_measure X)" "B \ sets (qbs_to_measure Y)" + then obtain Ua Ub where hu: + "A = Ua \ qbs_space X" "\\\qbs_Mx X. \ -` Ua \ sets borel" + "B = Ub \ qbs_space Y" "\\\qbs_Mx Y. \ -` Ub \ sets borel" + by(auto simp add: sigma_Mx_def sets_L) + show "A \ B \ sets (qbs_to_measure (X \\<^sub>Q Y))" + proof - + have "A \ B = Ua \ Ub \ qbs_space (X \\<^sub>Q Y) \ (\\\qbs_Mx (X \\<^sub>Q Y). \ -` (Ua \ Ub) \ sets borel)" + using hu by(auto simp add: vimage_Times pair_qbs_space pair_qbs_Mx) + thus ?thesis + by(auto simp add: sigma_Mx_def sets_L intro!: exI[where x="Ua \ Ub"]) + qed +qed + +corollary qbs_borel_prod: "qbs_borel \\<^sub>Q qbs_borel = (qbs_borel :: ('a::second_countable_topology \ 'b::second_countable_topology) quasi_borel)" + by(simp add: r_preserves_product[symmetric] borel_prod) + +corollary qbs_count_space_prod: "qbs_count_space (UNIV :: ('a :: countable) set) \\<^sub>Q qbs_count_space (UNIV :: ('b :: countable) set) = qbs_count_space UNIV" + by(auto simp: r_preserves_product[symmetric] count_space_prod) + +lemma r_preserves_product': "measure_to_qbs (\\<^sub>M i\I. M i) = (\\<^sub>Q i\I. measure_to_qbs (M i))" +proof(rule qbs_eqI) + show "qbs_Mx (measure_to_qbs (Pi\<^sub>M I M)) = qbs_Mx (\\<^sub>Q i\I. measure_to_qbs (M i))" + proof safe + fix f :: "real \ _" + assume "f \ qbs_Mx (measure_to_qbs (Pi\<^sub>M I M))" + with measurable_space[of f borel "Pi\<^sub>M I M"] show "f \ qbs_Mx (\\<^sub>Q i\I. measure_to_qbs (M i))" + by(auto simp: qbs_Mx_R PiQ_Mx space_PiM intro!:ext[of "\r. f r _"]) + next + fix f :: "real \ _" + assume "f \ qbs_Mx (\\<^sub>Q i\I. measure_to_qbs (M i))" + then have "\i. i \ I \ (\r. f r i) \ borel \\<^sub>M M i" "\i. i \ I \ (\r. f r i) = (\r. undefined)" + by (auto simp: qbs_Mx_R PiQ_Mx) + with measurable_space[OF this(1)] fun_cong[OF this(2)] show "f \ qbs_Mx (measure_to_qbs (Pi\<^sub>M I M))" + by(auto intro!: measurable_PiM_single' simp: qbs_Mx_R) + qed +qed + +lemma PiQ_qbs_borel: + "(\\<^sub>Q i::('a:: countable)\UNIV. (qbs_borel :: ('b::second_countable_topology quasi_borel))) = qbs_borel" + by(simp add: r_preserves_product'[symmetric] measure_to_qbs_cong_sets[OF sets_PiM_equal_borel]) + +lemma qbs_morphism_from_countable: + fixes X :: "'a quasi_borel" + assumes "countable (qbs_space X)" + "qbs_Mx X \ borel \\<^sub>M count_space (qbs_space X)" + and "\i. i \ qbs_space X \ f i \ qbs_space Y" + shows "f \ X \\<^sub>Q Y" +proof(rule qbs_morphismI) + fix \ + assume "\ \ qbs_Mx X" + then have [measurable]: "\ \ borel \\<^sub>M count_space (qbs_space X)" + using assms(2) .. + define k :: "'a \ real \ _" + where "k \ (\i _. f i)" + have "f \ \ = (\r. k (\ r) r)" + by(auto simp add: k_def) + also have "... \ qbs_Mx Y" + by(rule qbs_closed3_dest2[OF assms(1)]) (use assms(3) k_def in simp_all) + finally show "f \ \ \ qbs_Mx Y" . +qed + +corollary qbs_morphism_count_space': + assumes "\i. i \ I \ f i \ qbs_space Y" "countable I" + shows "f \ qbs_count_space I \\<^sub>Q Y" + using assms by(auto intro!: qbs_morphism_from_countable simp: qbs_Mx_R) + +corollary qbs_morphism_count_space: + assumes "\i. f i \ qbs_space Y" + shows "f \ qbs_count_space (UNIV :: (_ :: countable) set) \\<^sub>Q Y" + using assms by(auto intro!: qbs_morphism_from_countable simp: qbs_Mx_R) + +lemma [qbs]: + shows not_qbs_pred: "Not \ qbs_count_space UNIV \\<^sub>Q qbs_count_space UNIV" + and or_qbs_pred: "(\) \ qbs_count_space UNIV \\<^sub>Q exp_qbs (qbs_count_space UNIV) (qbs_count_space UNIV)" + and and_qbs_pred: "(\) \ qbs_count_space UNIV \\<^sub>Q exp_qbs (qbs_count_space UNIV) (qbs_count_space UNIV)" + and implies_qbs_pred: "(\) \ qbs_count_space UNIV \\<^sub>Q exp_qbs (qbs_count_space UNIV) (qbs_count_space UNIV)" + and iff_qbs_pred: "(\) \ qbs_count_space UNIV \\<^sub>Q exp_qbs (qbs_count_space UNIV) (qbs_count_space UNIV)" + by(auto intro!: qbs_morphism_count_space) + +lemma [qbs]: + shows less_count_qbs_pred: "(<) \ qbs_count_space (UNIV :: (_ :: countable) set) \\<^sub>Q exp_qbs (qbs_count_space UNIV) (qbs_count_space UNIV)" + and le_count_qbs_pred: "(\) \ qbs_count_space (UNIV :: (_ :: countable) set) \\<^sub>Q exp_qbs (qbs_count_space UNIV) (qbs_count_space UNIV)" + and eq_count_qbs_pred: "(=) \ qbs_count_space (UNIV :: (_ :: countable) set) \\<^sub>Q exp_qbs (qbs_count_space UNIV) (qbs_count_space UNIV)" + and plus_count_qbs_morphism: "(+) \ qbs_count_space (UNIV :: (_ :: countable) set) \\<^sub>Q exp_qbs (qbs_count_space UNIV) (qbs_count_space UNIV)" + and minus_count_qbs_morphism: "(-) \ qbs_count_space (UNIV :: (_ :: countable) set) \\<^sub>Q exp_qbs (qbs_count_space UNIV) (qbs_count_space UNIV)" + and mult_count_qbs_morphism: "(*) \ qbs_count_space (UNIV :: (_ :: countable) set) \\<^sub>Q exp_qbs (qbs_count_space UNIV) (qbs_count_space UNIV)" + and Suc_qbs_morphism: "Suc \ qbs_count_space UNIV \\<^sub>Q qbs_count_space UNIV" + by(auto intro!: qbs_morphism_count_space) + +lemma qbs_morphism_product_iff: + "f \ X \\<^sub>Q (\\<^sub>Q i :: (_ :: countable)\UNIV. Y) \ f \ X \\<^sub>Q qbs_count_space UNIV \\<^sub>Q Y" +proof + assume h:"f \ X \\<^sub>Q (\\<^sub>Q i\UNIV. Y)" + show "f \ X \\<^sub>Q qbs_count_space UNIV \\<^sub>Q Y" + by(rule arg_swap_morphism, rule qbs_morphism_count_space) (simp add: qbs_morphism_component_singleton'[OF h qbs_morphism_ident']) +next + assume "f \ X \\<^sub>Q qbs_count_space UNIV \\<^sub>Q Y" + from qbs_morphism_space[OF arg_swap_morphism[OF this]] + show "f \ X \\<^sub>Q (\\<^sub>Q i\UNIV. Y)" + by(auto intro!: product_qbs_canonical1[where f="(\i x. f x i)"]) +qed + +lemma qbs_morphism_pair_countable1: + assumes "countable (qbs_space X)" + "qbs_Mx X \ borel \\<^sub>M count_space (qbs_space X)" + and "\i. i \ qbs_space X \ f i \ Y \\<^sub>Q Z" + shows "(\(x,y). f x y) \ X \\<^sub>Q Y \\<^sub>Q Z" + by(auto intro!: uncurry_preserves_morphisms qbs_morphism_from_countable[OF assms(1,2)] assms(3)) + +lemma qbs_morphism_pair_countable2: + assumes "countable (qbs_space Y)" + "qbs_Mx Y \ borel \\<^sub>M count_space (qbs_space Y)" + and "\i. i \ qbs_space Y \ (\x. f x i) \ X \\<^sub>Q Z" + shows "(\(x,y). f x y) \ X \\<^sub>Q Y \\<^sub>Q Z" + by(auto intro!: qbs_morphism_pair_swap[of "case_prod (\x y. f y x)",simplified] qbs_morphism_pair_countable1 assms) + +corollary qbs_morphism_pair_count_space1: + assumes "\i. f i \ Y \\<^sub>Q Z" + shows "(\(x,y). f x y) \ qbs_count_space (UNIV :: ('a :: countable) set) \\<^sub>Q Y \\<^sub>Q Z" + by(auto intro!: qbs_morphism_pair_countable1 simp: qbs_Mx_R assms) + +corollary qbs_morphism_pair_count_space2: + assumes "\i. (\x. f x i) \ X \\<^sub>Q Z" + shows "(\(x,y). f x y) \ X \\<^sub>Q qbs_count_space (UNIV :: ('a :: countable) set) \\<^sub>Q Z" + by(auto intro!: qbs_morphism_pair_countable2 simp: qbs_Mx_R assms) + +lemma qbs_morphism_compose_countable': + assumes [qbs]:"\i. i \ I \ (\x. f i x) \ X \\<^sub>Q Y" "g \ X \\<^sub>Q qbs_count_space I" "countable I" + shows "(\x. f (g x) x) \ X \\<^sub>Q Y" +proof - + have [qbs]:"f \ qbs_count_space I \\<^sub>Q X \\<^sub>Q Y" + by(auto intro!: qbs_morphism_count_space' simp: assms(3)) + show ?thesis + by simp +qed + +lemma qbs_morphism_compose_countable: + assumes [simp]:"\i::'i::countable. (\x. f i x) \ X \\<^sub>Q Y" "g \ X \\<^sub>Q (qbs_count_space UNIV)" + shows "(\x. f (g x) x) \ X \\<^sub>Q Y" + by(rule qbs_morphism_compose_countable'[of UNIV f]) simp_all + +lemma qbs_morphism_op: + assumes "case_prod f \ X \\<^sub>M Y \\<^sub>M Z" + shows "f \ measure_to_qbs X \\<^sub>Q measure_to_qbs Y \\<^sub>Q measure_to_qbs Z" + using r_preserves_morphisms assms + by(fastforce simp: r_preserves_product[symmetric] intro!: curry_preserves_morphisms) + +lemma [qbs]: + shows plus_qbs_morphism: "(+) \ (qbs_borel :: (_::{second_countable_topology, topological_monoid_add}) quasi_borel) \\<^sub>Q qbs_borel \\<^sub>Q qbs_borel" + and plus_ereal_qbs_morphism: "(+) \ (qbs_borel :: ereal quasi_borel) \\<^sub>Q qbs_borel \\<^sub>Q qbs_borel" + and diff_qbs_morphism: "(-) \ (qbs_borel :: (_::{second_countable_topology, real_normed_vector}) quasi_borel) \\<^sub>Q qbs_borel \\<^sub>Q qbs_borel" + and diff_ennreal_qbs_morphism: "(-) \ (qbs_borel :: ennreal quasi_borel) \\<^sub>Q qbs_borel \\<^sub>Q qbs_borel" + and diff_ereal_qbs_morphism: "(-) \ (qbs_borel :: ereal quasi_borel) \\<^sub>Q qbs_borel \\<^sub>Q qbs_borel" + and times_qbs_morphism: "(*) \ (qbs_borel :: (_::{second_countable_topology, real_normed_algebra}) quasi_borel) \\<^sub>Q qbs_borel \\<^sub>Q qbs_borel" + and times_ennreal_qbs_morphism: "(*) \ (qbs_borel :: ennreal quasi_borel) \\<^sub>Q qbs_borel \\<^sub>Q qbs_borel" + and times_ereal_qbs_morphism: "(*) \ (qbs_borel :: ereal quasi_borel) \\<^sub>Q qbs_borel \\<^sub>Q qbs_borel" + and divide_qbs_morphism: "(/) \ (qbs_borel :: (_::{second_countable_topology, real_normed_div_algebra}) quasi_borel) \\<^sub>Q qbs_borel \\<^sub>Q qbs_borel" + and divide_ennreal_qbs_morphism: "(/) \ (qbs_borel :: ennreal quasi_borel) \\<^sub>Q qbs_borel \\<^sub>Q qbs_borel" + and divide_ereal_qbs_morphism: "(/) \ (qbs_borel :: ereal quasi_borel) \\<^sub>Q qbs_borel \\<^sub>Q qbs_borel" + and log_qbs_morphism: "log \ qbs_borel \\<^sub>Q qbs_borel \\<^sub>Q qbs_borel" + and root_qbs_morphism: "root \ qbs_count_space UNIV \\<^sub>Q qbs_borel \\<^sub>Q qbs_borel" + and scaleR_qbs_morphism: "(*\<^sub>R) \ qbs_borel \\<^sub>Q (qbs_borel :: (_::{second_countable_topology, real_normed_vector}) quasi_borel) \\<^sub>Q qbs_borel" + and qbs_morphism_inner: "(\) \ qbs_borel \\<^sub>Q (qbs_borel :: (_::{second_countable_topology, real_inner}) quasi_borel) \\<^sub>Q qbs_borel" + and dist_qbs_morphism: "dist \ (qbs_borel :: (_::{second_countable_topology, metric_space}) quasi_borel) \\<^sub>Q qbs_borel \\<^sub>Q qbs_borel" + and powr_qbs_morphism: "(powr) \ qbs_borel \\<^sub>Q qbs_borel \\<^sub>Q (qbs_borel :: real quasi_borel)" + and max_qbs_morphism: "(max :: (_ :: {second_countable_topology, linorder_topology}) \ _ \ _) \ qbs_borel \\<^sub>Q qbs_borel \\<^sub>Q qbs_borel" + and min_qbs_morphism: "(min :: (_ :: {second_countable_topology, linorder_topology}) \ _ \ _) \ qbs_borel \\<^sub>Q qbs_borel \\<^sub>Q qbs_borel" + and sup_qbs_morphism: "(sup :: (_ :: {lattice,second_countable_topology, linorder_topology}) \ _ \ _) \ qbs_borel \\<^sub>Q qbs_borel \\<^sub>Q qbs_borel" + and inf_qbs_morphism: "(inf :: (_ :: {lattice,second_countable_topology, linorder_topology}) \ _ \ _) \ qbs_borel \\<^sub>Q qbs_borel \\<^sub>Q qbs_borel" + and less_qbs_pred: "(<) \ (qbs_borel :: _ ::{second_countable_topology, linorder_topology} quasi_borel) \\<^sub>Q qbs_borel \\<^sub>Q qbs_count_space UNIV" + and eq_qbs_pred: "(=) \ (qbs_borel :: _ ::{second_countable_topology, linorder_topology} quasi_borel) \\<^sub>Q qbs_borel \\<^sub>Q qbs_count_space UNIV" + and le_qbs_pred: "(\) \ (qbs_borel :: _ ::{second_countable_topology, linorder_topology} quasi_borel) \\<^sub>Q qbs_borel \\<^sub>Q qbs_count_space UNIV" + by(auto intro!: qbs_morphism_op) + +lemma [qbs]: + shows abs_real_qbs_morphism: "abs \ (qbs_borel :: real quasi_borel) \\<^sub>Q qbs_borel" + and abs_ereal_qbs_morphism: "abs \ (qbs_borel :: ereal quasi_borel) \\<^sub>Q qbs_borel" + and real_floor_qbs_morphism: "(floor :: real \ int) \ qbs_borel \\<^sub>Q qbs_count_space UNIV" + and real_ceiling_qbs_morphism: "(ceiling :: real \ int) \ qbs_borel \\<^sub>Q qbs_count_space UNIV" + and exp_qbs_morphism: "(exp::'a::{real_normed_field,banach}\'a) \ qbs_borel \\<^sub>Q qbs_borel" + and ln_qbs_morphism: "ln \ (qbs_borel :: real quasi_borel) \\<^sub>Q qbs_borel" + and sqrt_qbs_morphism: "sqrt \ qbs_borel \\<^sub>Q qbs_borel" + and of_real_qbs_morphism: "(of_real :: _ \ (_::real_normed_algebra)) \ qbs_borel \\<^sub>Q qbs_borel" + and sin_qbs_morphism: "(sin :: _ \ (_::{real_normed_field,banach})) \ qbs_borel \\<^sub>Q qbs_borel" + and cos_qbs_morphism: "(cos :: _ \ (_::{real_normed_field,banach})) \ qbs_borel \\<^sub>Q qbs_borel" + and arctan_qbs_morphism: "arctan \ qbs_borel \\<^sub>Q qbs_borel" + and Re_qbs_morphism: "Re \ qbs_borel \\<^sub>Q qbs_borel" + and Im_qbs_morphism: "Im \ qbs_borel \\<^sub>Q qbs_borel" + and sgn_qbs_morphism: "(sgn::_::real_normed_vector \ _) \ qbs_borel \\<^sub>Q qbs_borel" + and norm_qbs_morphism: "norm \ qbs_borel \\<^sub>Q qbs_borel" + and invers_qbs_morphism: "(inverse :: _ \ (_ ::real_normed_div_algebra)) \ qbs_borel \\<^sub>Q qbs_borel" + and invers_ennreal_qbs_morphism: "(inverse :: _ \ ennreal) \ qbs_borel \\<^sub>Q qbs_borel" + and invers_ereal_qbs_morphism: "(inverse :: _ \ ereal) \ qbs_borel \\<^sub>Q qbs_borel" + and uminus_qbs_morphism: "(uminus :: _ \ (_::{second_countable_topology, real_normed_vector})) \ qbs_borel \\<^sub>Q qbs_borel" + and ereal_qbs_morphism: "ereal \ qbs_borel \\<^sub>Q qbs_borel" + and real_of_ereal_qbs_morphism: "real_of_ereal \ qbs_borel \\<^sub>Q qbs_borel" + and enn2ereal_qbs_morphism: "enn2ereal \ qbs_borel \\<^sub>Q qbs_borel" + and e2ennreal_qbs_morphism: "e2ennreal \ qbs_borel \\<^sub>Q qbs_borel" + and ennreal_qbs_morphism: "ennreal \ qbs_borel \\<^sub>Q qbs_borel" + and qbs_morphism_nth: "(\x::real^'n. x $ i) \ qbs_borel \\<^sub>Q qbs_borel" + and qbs_morphism_product_candidate: "\i. (\x. x i) \ qbs_borel \\<^sub>Q qbs_borel" + and uminus_ereal_qbs_morphism: "(uminus :: _ \ ereal) \ qbs_borel \\<^sub>Q qbs_borel" + by(auto intro!: set_mp[OF r_preserves_morphisms]) + +lemma qbs_morphism_sum: + fixes f :: "'c \ 'a \ 'b::{second_countable_topology, topological_comm_monoid_add}" + assumes "\i. i \ S \ f i \ X \\<^sub>Q qbs_borel" + shows "(\x. \i\S. f i x) \ X \\<^sub>Q qbs_borel" + using assms by(simp add: lr_adjunction_correspondence) + +lemma qbs_morphism_suminf_order: + fixes f :: "nat \ 'a \ 'b::{complete_linorder, second_countable_topology, linorder_topology, topological_comm_monoid_add}" + assumes "\i. f i \ X \\<^sub>Q qbs_borel" + shows " (\x. \i. f i x) \ X \\<^sub>Q qbs_borel" + using assms by(simp add: lr_adjunction_correspondence) + +lemma qbs_morphism_prod: + fixes f :: "'c \ 'a \ 'b::{second_countable_topology, real_normed_field}" + assumes "\i. i \ S \ f i \ X \\<^sub>Q qbs_borel" + shows "(\x. \i\S. f i x) \ X \\<^sub>Q qbs_borel" + using assms by(simp add: lr_adjunction_correspondence) + +lemma qbs_morphism_Min: + "finite I \ (\i. i \ I \ f i \ X \\<^sub>Q qbs_borel) \ (\x. Min ((\i. f i x)`I) :: 'b::{second_countable_topology, linorder_topology}) \ X \\<^sub>Q qbs_borel" + by(simp add: lr_adjunction_correspondence) + +lemma qbs_morphism_Max: + "finite I \ (\i. i \ I \ f i \ X \\<^sub>Q qbs_borel) \ (\x. Max ((\i. f i x)`I) :: 'b::{second_countable_topology, linorder_topology}) \ X \\<^sub>Q qbs_borel" + by(simp add: lr_adjunction_correspondence) + +lemma qbs_morphism_Max2: + fixes f::"_ \ _ \ 'a::{second_countable_topology, dense_linorder, linorder_topology}" + shows "finite I \ (\i. f i \ X \\<^sub>Q qbs_borel) \ (\x. Max{f i x |i. i \ I}) \ X \\<^sub>Q qbs_borel" + by(simp add: lr_adjunction_correspondence) + +lemma [qbs]: + shows qbs_morphism_liminf: "liminf \ (qbs_count_space UNIV \\<^sub>Q qbs_borel) \\<^sub>Q (qbs_borel :: 'a :: {complete_linorder, second_countable_topology, linorder_topology} quasi_borel)" + and qbs_morphism_limsup: "limsup \ (qbs_count_space UNIV \\<^sub>Q qbs_borel) \\<^sub>Q (qbs_borel :: 'a :: {complete_linorder, second_countable_topology, linorder_topology} quasi_borel)" + and qbs_morphism_lim: "lim \ (qbs_count_space UNIV \\<^sub>Q qbs_borel) \\<^sub>Q (qbs_borel :: 'a :: {complete_linorder, second_countable_topology, linorder_topology} quasi_borel)" +proof(safe intro!: qbs_morphismI) + fix f :: "real \ nat \ 'a" + assume "f \ qbs_Mx (count_space\<^sub>Q UNIV \\<^sub>Q borel\<^sub>Q)" + then have [measurable]:"\i. (\r. f r i) \ borel_measurable borel" + by(auto simp: qbs_Mx_is_morphisms) (metis PiQ_qbs_borel measurable_product_then_coordinatewise qbs_Mx_is_morphisms qbs_Mx_qbs_borel qbs_morphism_product_iff) + show "liminf \ f \ qbs_Mx borel\<^sub>Q" "limsup \ f \ qbs_Mx borel\<^sub>Q" "lim \ f \ qbs_Mx borel\<^sub>Q" + by(auto simp: qbs_Mx_is_morphisms lr_adjunction_correspondence comp_def) +qed + +lemma qbs_morphism_SUP: + fixes F :: "_ \ _ \ _::{complete_linorder, linorder_topology, second_countable_topology}" + assumes "countable I" "\i. i \ I \ F i \ X \\<^sub>Q qbs_borel" + shows "(\x. \ i\I. F i x) \ X \\<^sub>Q qbs_borel" + using assms by(simp add: lr_adjunction_correspondence) + +lemma qbs_morphism_INF: + fixes F :: "_ \ _ \ _::{complete_linorder, linorder_topology, second_countable_topology}" + assumes "countable I" "\i. i \ I \ F i \ X \\<^sub>Q qbs_borel" + shows "(\x. \ i\I. F i x) \ X \\<^sub>Q qbs_borel" + using assms by(simp add: lr_adjunction_correspondence) + +lemma qbs_morphism_cSUP: + fixes F :: "_ \ _ \ 'a::{conditionally_complete_linorder, linorder_topology, second_countable_topology}" + assumes "countable I" "\i. i \ I \ F i \ X \\<^sub>Q qbs_borel" "\x. x \ qbs_space X \ bdd_above ((\i. F i x) ` I)" + shows "(\x. \ i\I. F i x) \ X \\<^sub>Q qbs_borel" + using assms by(simp add: lr_adjunction_correspondence space_L) + +lemma qbs_morphism_cINF: + fixes F :: "_ \ _ \ 'a::{conditionally_complete_linorder, linorder_topology, second_countable_topology}" + assumes "countable I" "\i. i \ I \ F i \ X \\<^sub>Q qbs_borel" "\x. x \ qbs_space X \ bdd_below ((\i. F i x) ` I)" + shows "(\x. \ i\I. F i x) \ X \\<^sub>Q qbs_borel" + using assms by(simp add: lr_adjunction_correspondence space_L) + +lemma qbs_morphism_lim_metric: + fixes f :: "nat \ 'a \ 'b::{banach, second_countable_topology}" + assumes "\i. f i \ X \\<^sub>Q qbs_borel" + shows "(\x. lim (\i. f i x)) \ X \\<^sub>Q qbs_borel" + using assms by(simp add: lr_adjunction_correspondence) + +lemma qbs_morphism_LIMSEQ_metric: + fixes f :: "nat \ 'a \ 'b :: metric_space" + assumes "\i. f i \ X \\<^sub>Q qbs_borel" "\x. x \ qbs_space X \ (\i. f i x) \ g x" + shows "g \ X \\<^sub>Q qbs_borel" + using borel_measurable_LIMSEQ_metric[where M="qbs_to_measure X"] assms + by(auto simp add: lr_adjunction_correspondence space_L) + +lemma power_qbs_morphism[qbs]: + "(power :: (_ ::{power,real_normed_algebra}) \ nat \ _) \ qbs_borel \\<^sub>Q qbs_count_space UNIV \\<^sub>Q qbs_borel" + by(rule arg_swap_morphism) (auto intro!: qbs_morphism_count_space set_mp[OF r_preserves_morphisms]) + +lemma power_ennreal_qbs_morphism[qbs]: + "(power :: ennreal \ nat \ _) \ qbs_borel \\<^sub>Q qbs_count_space UNIV \\<^sub>Q qbs_borel" + by(rule arg_swap_morphism) (auto intro!: qbs_morphism_count_space set_mp[OF r_preserves_morphisms]) + +lemma qbs_morphism_compw: "(^^) \ (X \\<^sub>Q X) \\<^sub>Q qbs_count_space UNIV \\<^sub>Q (X \\<^sub>Q X)" +proof(rule arg_swap_morphism,rule qbs_morphism_count_space) + fix n + show "(\y. y ^^ n) \ X \\<^sub>Q X \\<^sub>Q X \\<^sub>Q X" + by(induction n) simp_all +qed + +lemma qbs_morphism_compose_n[qbs]: + assumes [qbs]: "f \ X \\<^sub>Q X" + shows "(\n. f^^n) \ qbs_count_space UNIV \\<^sub>Q X \\<^sub>Q X" +proof(intro qbs_morphism_count_space) + fix n + show "f ^^ n \ X \\<^sub>Q X" + by (induction n) simp_all +qed + +lemma qbs_morphism_compose_n': + assumes "f \ X \\<^sub>Q X" + shows "f^^n \ X \\<^sub>Q X" + using qbs_morphism_space[OF qbs_morphism_compose_n[OF assms]] by(simp add: exp_qbs_space qbs_space_R) + +lemma qbs_morphism_uminus_eq_ereal[simp]: + "(\x. - f x :: ereal) \ X \\<^sub>Q qbs_borel \ f \ X \\<^sub>Q qbs_borel" (is "?l = ?r") + by(simp add: lr_adjunction_correspondence) + +lemma qbs_morphism_ereal_iff: + shows "(\x. ereal (f x)) \ X \\<^sub>Q qbs_borel\ f \ X \\<^sub>Q qbs_borel" + by(simp add: borel_measurable_ereal_iff lr_adjunction_correspondence) + +lemma qbs_morphism_ereal_sum: + fixes f :: "'c \ 'a \ ereal" + assumes "\i. i \ S \ f i \ X \\<^sub>Q qbs_borel" + shows "(\x. \i\S. f i x) \ X \\<^sub>Q qbs_borel" + using assms by(simp add: lr_adjunction_correspondence) + +lemma qbs_morphism_ereal_prod: + fixes f :: "'c \ 'a \ ereal" + assumes "\i. i \ S \ f i \ X \\<^sub>Q qbs_borel" + shows "(\x. \i\S. f i x) \ X \\<^sub>Q qbs_borel" + using assms by(simp add: lr_adjunction_correspondence) + +lemma qbs_morphism_extreal_suminf: + fixes f :: "nat \ 'a \ ereal" + assumes "\i. f i \ X \\<^sub>Q qbs_borel" + shows "(\x. (\i. f i x)) \ X \\<^sub>Q qbs_borel" + using assms by(simp add: lr_adjunction_correspondence) + +lemma qbs_morphism_ennreal_iff: + assumes "\x. x \ qbs_space X \ 0 \ f x" + shows "(\x. ennreal (f x)) \ X \\<^sub>Q qbs_borel \ f \ X \\<^sub>Q qbs_borel" + using borel_measurable_ennreal_iff[where M="qbs_to_measure X"] assms + by(simp add: space_L lr_adjunction_correspondence) + +lemma qbs_morphism_prod_ennreal: + fixes f :: "'c \ 'a \ ennreal" + assumes "\i. i \ S \ f i \ X \\<^sub>Q qbs_borel" + shows "(\x. \i\S. f i x) \ X \\<^sub>Q qbs_borel" + using assms by(simp add: space_L lr_adjunction_correspondence) + +lemma count_space_qbs_morphism: + "f \ qbs_count_space (UNIV :: 'a set) \\<^sub>Q qbs_borel" + by(auto intro!: set_mp[OF r_preserves_morphisms]) + +declare count_space_qbs_morphism[where 'a="_ :: countable",qbs] + +lemma count_space_count_space_qbs_morphism: + "f \ qbs_count_space (UNIV :: (_ :: countable) set) \\<^sub>Q qbs_count_space (UNIV :: (_ :: countable) set)" + by(auto intro!: set_mp[OF r_preserves_morphisms]) + +lemma qbs_morphism_case_nat': + assumes [qbs]: "i = 0 \ f \ X \\<^sub>Q Y" + "\j. i = Suc j \ (\x. g x j) \ X \\<^sub>Q Y" + shows "(\x. case_nat (f x) (g x) i) \ X \\<^sub>Q Y" + by (cases i) simp_all + +lemma qbs_morphism_case_nat[qbs]: + "case_nat \ X \\<^sub>Q (qbs_count_space UNIV \\<^sub>Q X) \\<^sub>Q qbs_count_space UNIV \\<^sub>Q X" + by(rule curry_preserves_morphisms, rule arg_swap_morphism) (auto intro!: qbs_morphism_count_space qbs_morphism_case_nat') + + +lemma qbs_morphism_case_nat'': + assumes "f \ X \\<^sub>Q Y" "g \ X \\<^sub>Q (\\<^sub>Q i\UNIV. Y)" + shows "(\x. case_nat (f x) (g x)) \ X \\<^sub>Q (\\<^sub>Q i\UNIV. Y)" + using assms by (simp add: qbs_morphism_product_iff) + +lemma qbs_morphism_rec_nat[qbs]: "rec_nat \ X \\<^sub>Q (count_space UNIV \\<^sub>Q X \\<^sub>Q X) \\<^sub>Q count_space UNIV \\<^sub>Q X" +proof(rule curry_preserves_morphisms,rule arg_swap_morphism,rule qbs_morphism_count_space) + fix n + show "(\y. rec_nat (fst y) (snd y) n) \ X \\<^sub>Q (qbs_count_space UNIV \\<^sub>Q X \\<^sub>Q X) \\<^sub>Q X" + by (induction n) simp_all +qed + +lemma qbs_morphism_Max_nat: + fixes P :: "nat \ 'a \ bool" + assumes "\i. P i \ X \\<^sub>Q qbs_count_space UNIV" + shows "(\x. Max {i. P i x}) \ X \\<^sub>Q qbs_count_space UNIV" + using assms by(simp add: lr_adjunction_correspondence) + +lemma qbs_morphism_Min_nat: + fixes P :: "nat \ 'a \ bool" + assumes "\i. P i \ X \\<^sub>Q qbs_count_space UNIV" + shows "(\x. Min {i. P i x}) \ X \\<^sub>Q qbs_count_space UNIV" + using assms by(simp add: lr_adjunction_correspondence) + +lemma qbs_morphism_sum_nat: + fixes f :: "'c \ 'a \ nat" + assumes "\i. i \ S \ f i \X \\<^sub>Q qbs_count_space UNIV" + shows "(\x. \i\S. f i x) \ X \\<^sub>Q qbs_count_space UNIV" + using assms by(simp add: lr_adjunction_correspondence) + + +lemma qbs_morphism_case_enat': + assumes f[qbs]: "f \ X \\<^sub>Q qbs_count_space UNIV" and [qbs]: "\i. g i \ X \\<^sub>Q Y" "h \ X \\<^sub>Q Y" + shows "(\x. case f x of enat i \ g i x | \ \ h x) \ X \\<^sub>Q Y" +proof (rule qbs_morphism_compose_countable[OF _ f]) + fix i + show "(\x. case i of enat i \ g i x | \ \ h x) \ X \\<^sub>Q Y" + by (cases i) simp_all +qed + +lemma qbs_morphism_case_enat[qbs]: "case_enat \ qbs_space ((qbs_count_space UNIV \\<^sub>Q X) \\<^sub>Q X \\<^sub>Q qbs_count_space UNIV \\<^sub>Q X)" +proof - + note qbs_morphism_case_enat'[qbs] + show ?thesis + by(auto intro!: curry_preserves_morphisms,rule qbs_morphismI) (simp add: qbs_Mx_is_morphisms comp_def, qbs, simp_all) +qed + +lemma qbs_morphism_restrict[qbs]: + assumes X: "\i. i \ I \ f i \ X \\<^sub>Q (Y i)" + shows "(\x. \i\I. f i x) \ X \\<^sub>Q (\\<^sub>Q i\I. Y i)" + using assms by(auto intro!: product_qbs_canonical1) + +lemma If_qbs_morphism[qbs]: "If \ qbs_count_space UNIV \\<^sub>Q X \\<^sub>Q X \\<^sub>Q X" +proof(rule qbs_morphismI) + show "\ \ qbs_Mx (count_space\<^sub>Q UNIV) \ If \ \ \ qbs_Mx (X \\<^sub>Q X \\<^sub>Q X)" for \ + by(auto intro!: qbs_Mx_indicat[where S="{r. \ (_ (_ r))}",simplified] simp: qbs_Mx_count_space exp_qbs_Mx) +qed + +lemma normal_density_qbs[qbs]: "normal_density \ qbs_borel \\<^sub>Q qbs_borel \\<^sub>Q qbs_borel \\<^sub>Q qbs_borel" +proof - + have [simp]:"normal_density = (\\ \ x. 1 / sqrt (2 * pi * \\<^sup>2) * exp (-(x - \)\<^sup>2/ (2 * \\<^sup>2)))" + by standard+ (auto simp: normal_density_def) + show ?thesis + by simp +qed + +lemma erlang_density_qbs[qbs]: "erlang_density \ qbs_count_space UNIV \\<^sub>Q qbs_borel \\<^sub>Q qbs_borel \\<^sub>Q qbs_borel" +proof - + have [simp]: "erlang_density = (\k l x. (if x < 0 then 0 else (l^(Suc k) * x^k * exp (- l * x)) / fact k))" + by standard+ (auto simp: erlang_density_def) + show ?thesis + by simp +qed + +lemma list_nil_qbs[qbs]: "[] \ qbs_space (list_qbs X)" + by(simp add: list_qbs_space) + +lemma list_cons_qbs_morphism: "list_cons \ X \\<^sub>Q (list_of X) \\<^sub>Q (list_of X)" +proof(intro curry_preserves_morphisms pair_qbs_morphismI) + fix \ \ + assume h:"\ \ qbs_Mx X" + "\ \ qbs_Mx (list_of X)" + then obtain \ f where hf: + "\ = (\r. (f r, \ (f r) r))" "f \ borel \\<^sub>M count_space UNIV" "\i. i \ range f \ \ i \ qbs_Mx (\\<^sub>Q j\{..' + where "f' \ (\r. Suc (f r))" "\' \ (\i r n. if n = 0 then \ r else \ (i - 1) r (n - 1))" + then have "(\r. list_cons (fst (\ r, \ r)) (snd (\ r, \ r))) = (\r. (f' r, \' (f' r) r))" + by(auto simp: comp_def hf(1) ext list_cons_def) + also have "... \ qbs_Mx (list_of X)" + unfolding list_of_def + proof(rule coprod_qbs_MxI) + show "f' \ borel \\<^sub>M count_space UNIV" + using hf by(simp add: f'_\'_def(1)) + next + fix j + assume hj:"j \ range f'" + then have hj':"j - 1 \ range f" + by(auto simp: f'_\'_def(1)) + show "\' j \ qbs_Mx (\\<^sub>Q i\{.. {..r. \' j r i) \ qbs_Mx X" + proof cases + case 1 + then show ?thesis by(simp add: h(1) f'_\'_def(2)) + next + case 2 + then have "i - 1 \ {..'_def(2)) + qed + next + fix i + assume hi:"i \ {.. 0" "i - Suc 0 \ {..'_def(1) hj by fastforce+ + with prod_qbs_MxD(2)[OF hf(3)[OF hj']] + show "(\r. \' j r i) = (\r. undefined)" + by(simp add: f'_\'_def(2)) + qed + qed + finally show "(\r. list_cons (fst (\ r, \ r)) (snd (\ r, \ r))) \ qbs_Mx (list_of X)" . +qed + +corollary cons_qbs_morphism[qbs]: "Cons \ X \\<^sub>Q (list_qbs X) \\<^sub>Q list_qbs X" +proof(rule arg_swap_morphism) + show "(\x y. y # x) \ list_qbs X \\<^sub>Q X \\<^sub>Q list_qbs X" + proof(rule qbs_morphism_cong'[where f="(\l x. x # (to_list l)) \ from_list"]) + show " (\l x. x # to_list l) \ from_list \ list_qbs X \\<^sub>Q X \\<^sub>Q list_qbs X" + proof(rule qbs_morphism_comp[where Y="list_of X"]) + show " (\l x. x # to_list l) \ list_of X \\<^sub>Q X \\<^sub>Q list_qbs X" + proof(rule curry_preserves_morphisms) + show "(\lx. snd lx # to_list (fst lx)) \ list_of X \\<^sub>Q X \\<^sub>Q list_qbs X" + proof(rule qbs_morphism_cong'[where f="to_list \ (\(l,x). from_list (x # to_list l))"]) + show "to_list \ (\(l, x). from_list (x # to_list l)) \ list_of X \\<^sub>Q X \\<^sub>Q list_qbs X" + proof(rule qbs_morphism_comp[where Y="list_of X"]) + show "(\(l, x). from_list (x # to_list l)) \ list_of X \\<^sub>Q X \\<^sub>Q list_of X" + by(rule qbs_morphism_cong'[where f="(\(l,x). list_cons x l)",OF _ uncurry_preserves_morphisms[of "\(l,x). list_cons x l",simplified,OF arg_swap_morphism[OF list_cons_qbs_morphism]]]) (auto simp: pair_qbs_space to_list_from_list_ident) + qed(simp add: list_qbs_def map_qbs_morphism_f) + qed(auto simp: pair_qbs_space to_list_from_list_ident to_list_simp2) + qed + qed(auto simp: list_qbs_def to_list_from_list_ident intro!: map_qbs_morphism_inverse_f) + qed(simp add: from_list_to_list_ident) +qed + +lemma rec_list_morphism': + "rec_list' \ qbs_space (Y \\<^sub>Q (X \\<^sub>Q list_of X \\<^sub>Q Y \\<^sub>Q Y) \\<^sub>Q list_of X \\<^sub>Q Y)" + unfolding list_of_def +proof(intro curry_preserves_morphisms[OF arg_swap_morphism] coprod_qbs_canonical1') + fix n + show "(\x y. rec_list' (fst y) (snd y) (n, x)) \ (\\<^sub>Q i\{..\<^sub>Q exp_qbs (Y \\<^sub>Q exp_qbs X (exp_qbs (\\<^sub>Q n\UNIV. \\<^sub>Q i\{.. + assume h:"\ \ qbs_Mx ((\\<^sub>Q i\{..<0::nat}. X) \\<^sub>Q Y \\<^sub>Q exp_qbs X (exp_qbs (\\<^sub>Q n\UNIV. \\<^sub>Q i\{..r. fst (\ r) = (\n. undefined)" + proof - + fix r + have "\i. (\r. fst (\ r) i) = (\r. undefined)" + using h by(auto simp: exp_qbs_Mx PiQ_Mx pair_qbs_Mx comp_def split_beta') + thus "fst (\ r) = (\n. undefined)" + by(fastforce dest: fun_cong) + qed + hence "(\xy. rec_list' (fst (snd xy)) (snd (snd xy)) (0, fst xy)) \ \ = (\x. fst (snd (\ x)))" + by(auto simp: rec_list'_simp1[simplified list_nil_def] comp_def split_beta') + also have "... \ qbs_Mx Y" + using h by(auto simp: pair_qbs_Mx comp_def) + finally show "(\xy. rec_list' (fst (snd xy)) (snd (snd xy)) (0, fst xy)) \ \ \ qbs_Mx Y" . + qed + next + case ih:(Suc n) + show ?case + proof(rule qbs_morphismI) + fix \ + assume h:"\ \ qbs_Mx (\\<^sub>Q i\{..' where "\' \ (\r. snd (list_tail (Suc n, \ r)))" + define a where "a \ (\r. \ r 0)" + then have ha:"a \ qbs_Mx X" + using h by(auto simp: PiQ_Mx) + have 1:"\' \ qbs_Mx (\\<^sub>Q i\{..'_def) + hence 2: "\r. (n, \' r) \ qbs_space (list_of X)" + using qbs_Mx_to_X[of \'] by (fastforce simp: PiQ_space coprod_qbs_space list_of_def) + have 3: "\r. (Suc n, \ r) \ qbs_space (list_of X)" + using qbs_Mx_to_X[of \] h by (fastforce simp: PiQ_space coprod_qbs_space list_of_def) + have 4: "\r. (n, \' r) = list_tail (Suc n, \ r)" + by(simp add: list_tail_def \'_def) + have 5: "\r. (Suc n, \ r) = list_cons (a r) (n, \' r)" + unfolding a_def by(simp add: list_simp5[OF 3,simplified 4[symmetric],simplified list_head_def list_cons_def list_nil_def] list_cons_def) auto + have 6: "(\r. (n, \' r)) \ qbs_Mx (list_of X)" + using 1 by(auto intro!: coprod_qbs_MxI simp: PiQ_space coprod_qbs_space list_of_def) + + have "(\x y. rec_list' (fst y) (snd y) (Suc n, x)) \ \ = (\r y. rec_list' (fst y) (snd y) (Suc n, \ r))" + by auto + also have "... = (\r y. snd y (a r) (n, \' r) (rec_list' (fst y) (snd y) (n, \' r)))" + by(simp only: 5 rec_list'_simp2[OF 2]) + also have "... \ qbs_Mx (exp_qbs (Y \\<^sub>Q exp_qbs X (exp_qbs (list_of X) (exp_qbs Y Y))) Y)" + proof - + have "(\(r,y). snd y (a r) (n, \' r) (rec_list' (fst y) (snd y) (n, \' r))) = (\(y,x1,x2,x3). y x1 x2 x3) \ (\(r,y). (snd y, a r, (n, \' r), rec_list' (fst y) (snd y) (n, \' r)))" + by auto + also have "... \ qbs_borel \\<^sub>Q (Y \\<^sub>Q exp_qbs X (exp_qbs (list_of X) (exp_qbs Y Y))) \\<^sub>Q Y" + proof(rule qbs_morphism_comp[where Y="exp_qbs X (exp_qbs (list_of X) (exp_qbs Y Y)) \\<^sub>Q X \\<^sub>Q list_of X \\<^sub>Q Y"]) + show "(\(r, y). (snd y, a r, (n, \' r), rec_list' (fst y) (snd y) (n, \' r))) \ qbs_borel \\<^sub>Q Y \\<^sub>Q exp_qbs X (exp_qbs (list_of X) (exp_qbs Y Y)) \\<^sub>Q exp_qbs X (exp_qbs (list_of X) (exp_qbs Y Y)) \\<^sub>Q X \\<^sub>Q list_of X \\<^sub>Q Y" + unfolding split_beta' + proof(safe intro!: qbs_morphism_Pair) + show "(\x. a (fst x)) \ qbs_borel \\<^sub>Q Y \\<^sub>Q exp_qbs X (exp_qbs (list_of X) (exp_qbs Y Y)) \\<^sub>Q X" + using ha qbs_Mx_is_morphisms[of X] ha by auto + next + show "(\x. (n, \' (fst x))) \ qbs_borel \\<^sub>Q Y \\<^sub>Q exp_qbs X (exp_qbs (list_of X) (exp_qbs Y Y)) \\<^sub>Q list_of X" + using 6 by(simp add: qbs_Mx_is_morphisms) (use fst_qbs_morphism qbs_morphism_compose in blast) + next + show "(\x. rec_list' (fst (snd x)) (snd (snd x)) (n, \' (fst x))) \ qbs_borel \\<^sub>Q Y \\<^sub>Q exp_qbs X (exp_qbs (list_of X) (exp_qbs Y Y)) \\<^sub>Q Y" + using qbs_morphism_Mx[OF ih 1, simplified comp_def] uncurry_preserves_morphisms[of "(\(x,y). rec_list' (fst y) (snd y) (n, \' x))" qbs_borel "Y \\<^sub>Q exp_qbs X (exp_qbs (list_of X) (exp_qbs Y Y))" Y] qbs_Mx_is_morphisms[of "exp_qbs (Y \\<^sub>Q exp_qbs X (exp_qbs (list_of X) (exp_qbs Y Y))) Y"] + by(fastforce simp: split_beta' list_of_def) + qed qbs + next + show "(\(y, x1, x2, x3). y x1 x2 x3) \ exp_qbs X (exp_qbs (list_of X) (exp_qbs Y Y)) \\<^sub>Q X \\<^sub>Q list_of X \\<^sub>Q Y \\<^sub>Q Y" + by simp + qed + finally show ?thesis + by(simp add: exp_qbs_Mx') + qed + finally show "(\x y. rec_list' (fst y) (snd y) (Suc n, x)) \ \ \ qbs_Mx (exp_qbs (Y \\<^sub>Q exp_qbs X (exp_qbs (\\<^sub>Q n\UNIV. \\<^sub>Q i\{.. qbs_space (Y \\<^sub>Q (X \\<^sub>Q list_qbs X \\<^sub>Q Y \\<^sub>Q Y) \\<^sub>Q list_qbs X \\<^sub>Q Y)" +proof(rule curry_preserves_morphisms[OF arg_swap_morphism]) + show "(\l yf. rec_list (fst yf) (snd yf) l) \ list_qbs X \\<^sub>Q Y \\<^sub>Q (X \\<^sub>Q list_qbs X \\<^sub>Q Y \\<^sub>Q Y) \\<^sub>Q Y" + proof(rule qbs_morphism_cong'[where f="(\l' (y,f). rec_list y f (to_list l')) \ from_list",OF _ qbs_morphism_comp[where Y="list_of X"]]) + show "(\l' (y,f). rec_list y f (to_list l')) \ list_of X \\<^sub>Q Y \\<^sub>Q (X \\<^sub>Q list_qbs X \\<^sub>Q Y \\<^sub>Q Y) \\<^sub>Q Y" + apply(rule arg_swap_morphism,simp only: split_beta' list_qbs_def) + apply(rule uncurry_preserves_morphisms) + apply(rule arg_swap_morphism) + apply(rule arg_swap_morphism') + apply(rule qbs_morphism_cong'[OF _ arg_swap_morphism_map_qbs1[OF arg_swap_morphism'[OF arg_swap_morphism[OF rec_list_morphism']]]]) + apply(auto simp: rec_list'_def from_list_to_list_ident) + done + qed(auto simp: from_list_to_list_ident list_qbs_def to_list_from_list_ident intro!: map_qbs_morphism_inverse_f) +qed + +hide_const (open) list_nil list_cons list_head list_tail from_list rec_list' to_list' + +hide_fact (open) list_simp1 list_simp2 list_simp3 list_simp4 list_simp5 list_simp6 list_simp7 from_list_in_list_of' list_cons_qbs_morphism rec_list'_simp1 + to_list_from_list_ident from_list_in_list_of to_list_set to_list_simp1 to_list_simp2 list_head_def list_tail_def from_list_length + list_cons_in_list_of rec_list_morphism' rec_list'_simp2 list_decomp1 list_destruct_rule list_induct_rule from_list_to_list_ident + +corollary case_list_morphism[qbs]: "case_list \ qbs_space ((Y :: 'b quasi_borel) \\<^sub>Q ((X :: 'a quasi_borel) \\<^sub>Q list_qbs X \\<^sub>Q Y) \\<^sub>Q list_qbs X \\<^sub>Q Y)" +proof - + have [simp]:"case_list = (\y (f :: 'a \ 'a list \ 'b) l. rec_list y (\x l' y. f x l') l)" + proof standard+ + fix y :: 'b and f :: "'a \ 'a list \ 'b" and l :: "'a list" + show "(case l of [] \ y | x # xa \ f x xa) = rec_list y (\x l' y. f x l') l" + by (cases l) auto + qed + show ?thesis + by simp +qed + +lemma fold_qbs_morphism[qbs]: "fold \ qbs_space ((X \\<^sub>Q Y \\<^sub>Q Y) \\<^sub>Q list_qbs X \\<^sub>Q Y \\<^sub>Q Y)" +proof - + have [simp]:"fold = (\f l. rec_list id (\x xs l. l \ f x) l)" + apply standard+ + subgoal for f l x + by(induction l arbitrary: x) simp_all + done + show ?thesis + by simp +qed + +lemma [qbs]: + shows foldr_qbs_morphism: "foldr \ qbs_space ((X \\<^sub>Q Y \\<^sub>Q Y) \\<^sub>Q list_qbs X \\<^sub>Q Y \\<^sub>Q Y)" + and foldl_qbs_morphism: "foldl \ qbs_space ((X \\<^sub>Q Y \\<^sub>Q X) \\<^sub>Q X \\<^sub>Q list_qbs Y \\<^sub>Q X)" + and zip_qbs_morphism: "zip \ qbs_space (list_qbs X \\<^sub>Q list_qbs Y \\<^sub>Q list_qbs (pair_qbs X Y))" + and append_qbs_morphism: "append \ qbs_space (list_qbs X \\<^sub>Q list_qbs X \\<^sub>Q list_qbs X)" + and concat_qbs_morphism: "concat \ qbs_space (list_qbs (list_qbs X) \\<^sub>Q list_qbs X)" + and drop_qbs_morphism: "drop \ qbs_space (qbs_count_space UNIV \\<^sub>Q list_qbs X \\<^sub>Q list_qbs X)" + and take_qbs_morphism: "take \ qbs_space (qbs_count_space UNIV \\<^sub>Q list_qbs X \\<^sub>Q list_qbs X)" + and rev_qbs_morphism: "rev \ qbs_space (list_qbs X \\<^sub>Q list_qbs X)" + by(auto simp: foldr_def foldl_def zip_def append_def concat_def drop_def take_def rev_def) + +lemma [qbs]: + fixes X :: "'a quasi_borel" and Y :: "'b quasi_borel" + shows map_qbs_morphism: "map \ qbs_space ((X \\<^sub>Q Y) \\<^sub>Q list_qbs X \\<^sub>Q list_qbs Y)" (is ?map) + and fileter_qbs_morphism: "filter \ qbs_space ((X \\<^sub>Q count_space\<^sub>Q UNIV) \\<^sub>Q list_qbs X \\<^sub>Q list_qbs X)" (is ?filter) + and length_qbs_morphism: "length \ qbs_space (list_qbs X \\<^sub>Q qbs_count_space UNIV)" (is ?length) + and tl_qbs_morphism: "tl \ qbs_space (list_qbs X \\<^sub>Q list_qbs X)" (is ?tl) + and list_all_qbs_morphism: "list_all \ qbs_space ((X \\<^sub>Q qbs_count_space UNIV) \\<^sub>Q list_qbs X \\<^sub>Q qbs_count_space UNIV)" (is ?list_all) + and bind_list_qbs_morphism: "(\) \ qbs_space (list_qbs X \\<^sub>Q (X \\<^sub>Q list_qbs Y) \\<^sub>Q list_qbs Y)" (is ?bind) +proof - + have [simp]: "map = (\f. rec_list [] (\x xs l. f x # l))" + apply standard+ + subgoal for f l + by(induction l) simp_all + done + have [simp]: "filter = (\P. rec_list [] (\x xs l. if P x then x # l else l))" + apply standard+ + subgoal for f l + by(induction l) simp_all + done + have [simp]: "length = (\l. foldr (\_ n. Suc n) l 0)" + apply standard + subgoal for l + by (induction l) simp_all + done + have [simp]: "tl = (\l. case l of [] \ [] | _ # xs \ xs)" + by standard (simp add: tl_def) + have [simp]: "list_all = (\P xs. foldr (\x b. b \ P x) xs True)" + apply (standard,standard) + subgoal for P xs + by(induction xs arbitrary: P) auto + done + have [simp]: "List.bind = (\xs f. concat (map f xs))" + by standard+ (simp add: List.bind_def) + show ?map ?filter ?length ?tl ?list_all ?bind + by simp_all +qed + +lemma list_eq_qbs_morphism[qbs]: + assumes [qbs]: "(=) \ qbs_space (X \\<^sub>Q X \\<^sub>Q count_space UNIV)" + shows "(=) \ qbs_space (list_qbs X \\<^sub>Q list_qbs X \\<^sub>Q count_space UNIV)" +proof - + have [simp]:"(=) = (\xs ys. length xs = length ys \ list_all (case_prod (=)) (zip xs ys))" + using Ball_set list_eq_iff_zip_eq by fastforce + show ?thesis + by simp +qed + +lemma insort_key_qbs_morphism[qbs]: + shows "insort_key \ qbs_space ((X \\<^sub>Q (borel\<^sub>Q ::'b :: {second_countable_topology, linorder_topology} quasi_borel)) \\<^sub>Q X \\<^sub>Q list_qbs X \\<^sub>Q list_qbs X)" (is ?g1) + and "insort_key \ qbs_space ((X \\<^sub>Q count_space\<^sub>Q (UNIV :: (_ :: countable) set)) \\<^sub>Q X \\<^sub>Q list_qbs X \\<^sub>Q list_qbs X)" (is ?g2) +proof - + have [simp]:"insort_key = (\f x. rec_list [x] (\y ys l. if f x \ f y then x#y#ys else y#l))" + apply standard+ + subgoal for f x l + by(induction l) simp_all + done + show ?g1 ?g2 + by simp_all +qed + +lemma sort_key_qbs_morphism[qbs]: + shows "sort_key \ qbs_space ((X \\<^sub>Q (borel\<^sub>Q ::'b :: {second_countable_topology, linorder_topology} quasi_borel)) \\<^sub>Q list_qbs X \\<^sub>Q list_qbs X)" + and "sort_key \ qbs_space ((X \\<^sub>Q count_space\<^sub>Q (UNIV :: (_ :: countable) set)) \\<^sub>Q list_qbs X \\<^sub>Q list_qbs X)" + unfolding sort_key_def by simp_all + +lemma sort_qbs_morphism[qbs]: + shows "sort \ list_qbs (borel\<^sub>Q ::'b :: {second_countable_topology, linorder_topology} quasi_borel) \\<^sub>Q list_qbs borel\<^sub>Q" + and "sort \ list_qbs (count_space\<^sub>Q (UNIV :: (_ :: countable) set)) \\<^sub>Q list_qbs (count_space\<^sub>Q UNIV)" + by simp_all + +subsubsection \ Morphism Pred\ +abbreviation "qbs_pred X P \ P \ X \\<^sub>Q qbs_count_space (UNIV :: bool set)" + +lemma qbs_pred_iff_measurable_pred: + "qbs_pred X P = Measurable.pred (qbs_to_measure X) P" + by(simp add: lr_adjunction_correspondence) + +lemma(in standard_borel) qbs_pred_iff_measurable_pred: + "qbs_pred (measure_to_qbs M) P = Measurable.pred M P" + by(simp add: qbs_pred_iff_measurable_pred measurable_cong_sets[OF lr_sets_ident refl]) + +lemma qbs_pred_iff_sets: +"{x \space (qbs_to_measure X). P x} \ sets (qbs_to_measure X) \ qbs_pred X P" + by (simp add: Measurable.pred_def lr_adjunction_correspondence space_L) + +lemma + assumes [qbs]:"P \ X \\<^sub>Q Y \\<^sub>Q qbs_count_space UNIV" "f \ X \\<^sub>Q Y" + shows indicator_qbs_morphism''': "(\x. indicator {y. P x y} (f x)) \ X \\<^sub>Q qbs_borel" (is ?g1) + and indicator_qbs_morphism'': "(\x. indicator {y\qbs_space Y. P x y} (f x)) \ X \\<^sub>Q qbs_borel" (is ?g2) +proof - + have [simp]:"{x \ qbs_space X. P x (f x)} = {x \ qbs_space X. f x \ qbs_space Y \ P x (f x)}" + using qbs_morphism_space[OF assms(2)] by blast + show ?g1 ?g2 + using qbs_morphism_app[OF assms,simplified qbs_pred_iff_sets[symmetric]] qbs_morphism_space[OF assms(2)] + by(auto intro!: borel_measurable_indicator' simp: lr_adjunction_correspondence space_L) +qed + +lemma + assumes [qbs]:"P \ X \\<^sub>Q Y \\<^sub>Q qbs_count_space UNIV" + shows indicator_qbs_morphism[qbs]:"(\x. indicator {y \ qbs_space Y. P x y}) \ X \\<^sub>Q Y \\<^sub>Q qbs_borel" (is ?g1) + and indicator_qbs_morphism':"(\x. indicator {y. P x y}) \ X \\<^sub>Q Y \\<^sub>Q qbs_borel" (is ?g2) +proof - + note indicator_qbs_morphism''[qbs] indicator_qbs_morphism'''[qbs] + show ?g1 ?g2 + by(auto intro!: curry_preserves_morphisms[OF pair_qbs_morphismI] simp: qbs_Mx_is_morphisms) +qed + +lemma indicator_qbs[qbs]: + assumes "qbs_pred X P" + shows "indicator {x. P x} \ X \\<^sub>Q qbs_borel" + using assms by(auto simp: lr_adjunction_correspondence) + +lemma All_qbs_pred[qbs]: "qbs_pred (count_space\<^sub>Q (UNIV :: ('a :: countable) set) \\<^sub>Q count_space\<^sub>Q UNIV) All" +proof(rule qbs_morphismI) + fix a :: "real \ 'a \ bool" + assume "a \ qbs_Mx (count_space\<^sub>Q UNIV \\<^sub>Q count_space\<^sub>Q UNIV)" + hence [measurable]: "\f g. f \ borel_measurable borel \ g \ borel \\<^sub>M count_space UNIV \ (\x::real. a (f x) (g x)) \ borel \\<^sub>M count_space UNIV" + by(auto simp add: exp_qbs_Mx qbs_Mx_R) + show " All \ a \ qbs_Mx (count_space\<^sub>Q UNIV)" + by(simp add: comp_def qbs_Mx_R) +qed + +lemma Ex_qbs_pred[qbs]: "qbs_pred (count_space\<^sub>Q (UNIV :: ('a :: countable) set) \\<^sub>Q count_space\<^sub>Q UNIV) Ex" +proof(rule qbs_morphismI) + fix a :: "real \ 'a \ bool" + assume "a \ qbs_Mx (count_space\<^sub>Q UNIV \\<^sub>Q count_space\<^sub>Q UNIV)" + hence [measurable]: "\f g. f \ borel_measurable borel \ g \ borel \\<^sub>M count_space UNIV \ (\x::real. a (f x) (g x)) \ borel \\<^sub>M count_space UNIV" + by(auto simp add: exp_qbs_Mx qbs_Mx_R) + show "Ex \ a \ qbs_Mx (count_space\<^sub>Q UNIV)" + by(simp add: comp_def qbs_Mx_R) +qed + +lemma Ball_qbs_pred_countable: + assumes "\i::'a :: countable. i \ I \ qbs_pred X (P i)" + shows "qbs_pred X (\x. \x\I. P i x)" + using assms by(simp add: qbs_pred_iff_measurable_pred) + +lemma Ball_qbs_pred: + assumes "finite I" "\i. i \ I \ qbs_pred X (P i)" + shows "qbs_pred X (\x. \x\I. P i x)" + using assms by(simp add: qbs_pred_iff_measurable_pred) + +lemma Bex_qbs_pred_countable: + assumes "\i::'a :: countable. i \ I \ qbs_pred X (P i)" + shows "qbs_pred X (\x. \x\I. P i x)" + using assms by(simp add: qbs_pred_iff_measurable_pred) + +lemma Bex_qbs_pred: + assumes "finite I" "\i. i \ I \ qbs_pred X (P i)" + shows "qbs_pred X (\x. \x\I. P i x)" + using assms by(simp add: qbs_pred_iff_measurable_pred) + +lemma qbs_morphism_If_sub_qbs: + assumes [qbs]: "qbs_pred X P" + and [qbs]: "f \ sub_qbs X {x\qbs_space X. P x} \\<^sub>Q Y" "g \ sub_qbs X {x\qbs_space X. \ P x} \\<^sub>Q Y" + shows "(\x. if P x then f x else g x) \ X \\<^sub>Q Y" +proof(rule qbs_morphismI) + fix \ + assume h:"\ \ qbs_Mx X" + interpret standard_borel_ne "borel :: real measure" by simp + have [measurable]: "Measurable.pred borel (\x. P (\ x))" + using h by(simp add: qbs_pred_iff_measurable_pred[symmetric] qbs_Mx_is_morphisms) + consider "qbs_space X = {}" + | "{x\qbs_space X. \ P x} = qbs_space X" + | "{x\qbs_space X. P x} = qbs_space X" + | "{x\qbs_space X. P x} \ {}" "{x\qbs_space X. \ P x} \ {}" by blast + then show "(\x. if P x then f x else g x) \ \ \ qbs_Mx Y" (is "?f \ _") + proof cases + case 1 + with h show ?thesis + by(simp add: qbs_empty_equiv) + next + case 2 + have [simp]:"(\x. if P x then f x else g x) \ \ = g \ \" + by standard (use qbs_Mx_to_X[OF h] 2 in auto) + show ?thesis + using 2 qbs_morphism_Mx[OF assms(3)] h by(simp add: sub_qbs_ident) + next + case 3 + have [simp]:"(\x. if P x then f x else g x) \ \ = f \ \" + by standard (use qbs_Mx_to_X[OF h] 3 in auto) + show ?thesis + using 3 qbs_morphism_Mx[OF assms(2)] h by(simp add: sub_qbs_ident) + next + case 4 + then obtain x0 x1 where + x0:"x0 \ qbs_space X" "P x0" and x1:"x1 \ qbs_space X" "\ P x1" + by blast + define a0 where "a0 = (\r. if P (\ r) then \ r else x0)" + define a1 where "a1 = (\r. if \ P (\ r) then \ r else x1)" + have "a0 \ qbs_Mx (sub_qbs X {x\qbs_space X. P x})" "a1 \ qbs_Mx (sub_qbs X {x\qbs_space X. \ P x})" + using x0 x1 qbs_Mx_to_X[OF h] h + by(auto simp: sub_qbs_Mx a0_def a1_def intro!: qbs_closed3_dest2'[of UNIV "\r. P (\ r)" "\b r. if b then \ r else x0"]) (simp_all add: qbs_Mx_is_morphisms) + from qbs_morphism_Mx[OF assms(2) this(1)] qbs_morphism_Mx[OF assms(3) this(2)] + have h0:"(\r. f (a0 r)) \ qbs_Mx Y" "(\r. g (a1 r)) \ qbs_Mx Y" + by (simp_all add: comp_def) + have [simp]:"(\x. if P x then f x else g x) \ \ = (\r. if P (\ r) then f (a0 r) else g (a1 r))" + by standard (auto simp: comp_def a0_def a1_def) + show "(\x. if P x then f x else g x) \ \ \ qbs_Mx Y" + using h h0 by(simp add: qbs_Mx_is_morphisms) + qed +qed + +subsubsection \ The Adjunction w.r.t. Ordering\ +lemma l_mono: "mono qbs_to_measure" +proof + fix X Y :: "'a quasi_borel" + show "X \ Y \ qbs_to_measure X \ qbs_to_measure Y" + proof(induction rule: less_eq_quasi_borel.induct) + case (1 X Y) + then show ?case + by(simp add: less_eq_measure.intros(1) space_L) + next + case (2 X Y) + then have "sigma_Mx X \ sigma_Mx Y" + by(auto simp add: sigma_Mx_def) + then consider "sigma_Mx X \ sigma_Mx Y" | "sigma_Mx X = sigma_Mx Y" + by auto + then show ?case + apply(cases) + apply(rule less_eq_measure.intros(2)) + apply(simp_all add: 2 space_L sets_L) + by(rule less_eq_measure.intros(3),simp_all add: 2 sets_L space_L emeasure_L) + qed +qed + +lemma r_mono: "mono measure_to_qbs" +proof + fix M N :: "'a measure" + show "M \ N \ measure_to_qbs M \ measure_to_qbs N" + proof(induction rule: less_eq_measure.inducts) + case (1 M N) + then show ?case + by(simp add: less_eq_quasi_borel.intros(1) qbs_space_R) + next + case (2 M N) + then have "(borel :: real measure) \\<^sub>M N \ borel \\<^sub>M M" + by(simp add: measurable_mono) + then consider "(borel :: real measure) \\<^sub>M N \ borel \\<^sub>M M" | "(borel :: real measure) \\<^sub>M N = borel \\<^sub>M M" + by auto + then show ?case + by cases (rule less_eq_quasi_borel.intros(2),simp_all add: 2 qbs_space_R qbs_Mx_R)+ + next + case (3 M N) + then show ?case + apply - + by(rule less_eq_quasi_borel.intros(2)) (simp_all add: measurable_mono qbs_space_R qbs_Mx_R) + qed +qed + +lemma rl_order_adjunction: + "X \ qbs_to_measure Y \ measure_to_qbs X \ Y" +proof + assume 1: "X \ qbs_to_measure Y" + then show "measure_to_qbs X \ Y" + proof(induction rule: less_eq_measure.cases) + case (1 M N) + then have [simp]:"qbs_space Y = space N" + by(simp add: 1(2)[symmetric] space_L) + show ?case + by(rule less_eq_quasi_borel.intros(1),simp add: 1 qbs_space_R) + next + case (2 M N) + then have [simp]:"qbs_space Y = space N" + by(simp add: 2(2)[symmetric] space_L) + show ?case + proof(rule less_eq_quasi_borel.intros(2)) + show "qbs_Mx Y \ qbs_Mx (measure_to_qbs X)" + unfolding qbs_Mx_R + proof + fix \ + assume h:"\ \ qbs_Mx Y" + show "\ \ borel \\<^sub>M X" + proof(rule measurableI) + show "\x. \ x \ space X" + using qbs_Mx_to_X[OF h] by (auto simp add: 2) + next + fix A + assume "A \ sets X" + then have "A \ sets (qbs_to_measure Y)" + using 2 by auto + then obtain U where + hu:"A = U \ space N" "(\\\qbs_Mx Y. \ -` U \ sets borel)" + by(auto simp add: sigma_Mx_def sets_L) + have "\ -` A = \ -` U" + using qbs_Mx_to_X[OF h] by(auto simp add: hu) + thus "\ -` A \ space borel \ sets borel" + using h hu(2) by simp + qed + qed + qed(auto simp: 2 qbs_space_R) + next + case (3 M N) + then have [simp]:"qbs_space Y = space N" + by(simp add: 3(2)[symmetric] space_L) + show ?case + proof(rule less_eq_quasi_borel.intros(2)) + show "qbs_Mx Y \ qbs_Mx (measure_to_qbs X)" + unfolding qbs_Mx_R + proof + fix \ + assume h:"\ \ qbs_Mx Y" + show "\ \ borel \\<^sub>M X" + proof(rule measurableI) + show "\x. \ x \ space X" + using qbs_Mx_to_X[OF h] by(auto simp: 3) + next + fix A + assume "A \ sets X" + then have "A \ sets (qbs_to_measure Y)" + using 3 by auto + then obtain U where + hu:"A = U \ space N" "(\\\qbs_Mx Y. \ -` U \ sets borel)" + by(auto simp add: sigma_Mx_def sets_L) + have "\ -` A = \ -` U" + using qbs_Mx_to_X[OF h] by(auto simp add: hu) + thus "\ -` A \ space borel \ sets borel" + using h hu(2) by simp + qed + qed + qed(auto simp: 3 qbs_space_R) + qed +next + assume "measure_to_qbs X \ Y" + then show "X \ qbs_to_measure Y" + proof(induction rule: less_eq_quasi_borel.cases) + case (1 A B) + have [simp]: "space X = qbs_space A" + by(simp add: 1(1)[symmetric] qbs_space_R) + show ?case + by(rule less_eq_measure.intros(1)) (simp add: 1 space_L) + next + case (2 A B) + then have hmy:"qbs_Mx Y \ borel \\<^sub>M X" + using qbs_Mx_R by blast + have [simp]: "space X = qbs_space A" + by(simp add: 2(1)[symmetric] qbs_space_R) + have "sets X \ sigma_Mx Y" + proof + fix U + assume hu:"U \ sets X" + show "U \ sigma_Mx Y" + unfolding sigma_Mx_def + proof(safe intro!: exI[where x=U]) + show "\x. x \ U \ x \ qbs_space Y" + using sets.sets_into_space[OF hu] + by(auto simp add: 2) + next + fix \ + assume "\ \ qbs_Mx Y" + then have "\ \ borel \\<^sub>M X" + using hmy by(auto) + thus "\ -` U \ sets borel" + using hu by(simp add: measurable_sets_borel) + qed + qed + then consider "sets X = sigma_Mx Y" | "sets X \ sigma_Mx Y" + by auto + then show ?case + proof cases + case 1 + show ?thesis + proof(rule less_eq_measure.intros(3)) + show "emeasure X \ emeasure (qbs_to_measure Y)" + unfolding emeasure_L + proof(rule le_funI) + fix U + consider "U = {}" | "U \ sigma_Mx Y" | "U \ {} \ U \ sigma_Mx Y" + by auto + then show "emeasure X U \ (if U = {} \ U \ sigma_Mx Y then 0 else \)" + proof cases + case 1 + then show ?thesis by simp + next + case h:2 + then have "U \ sigma_Mx A" + using qbs_Mx_sigma_Mx_contra[OF 2(3)[symmetric] 2(4)] 2(2) by auto + hence "U \ sets X" + using lr_sets 2(1) sets_L by blast + thus ?thesis + by(simp add: h emeasure_notin_sets) + next + case 3 + then show ?thesis + by simp + qed + qed + qed(simp_all add: 1 2 space_L sets_L) + next + case h2:2 + show ?thesis + by(rule less_eq_measure.intros(2)) (simp add: space_L 2, simp add: h2 sets_L) + qed + qed +qed + +end \ No newline at end of file diff --git a/thys/S_Finite_Measure_Monad/Monad_QuasiBorel.thy b/thys/S_Finite_Measure_Monad/Monad_QuasiBorel.thy new file mode 100644 --- /dev/null +++ b/thys/S_Finite_Measure_Monad/Monad_QuasiBorel.thy @@ -0,0 +1,3501 @@ +(* Title: Monad_QuasiBorel.thy + Author: Michikazu Hirata, Tokyo Institute of Technology +*) + + +section \The S-Finite Measure Monad\ + +theory Monad_QuasiBorel + imports + "Measure_QuasiBorel_Adjunction" + "Kernels" + +begin +subsection \ The S-Finite Measure Monad\ +subsubsection \ Space of S-Finite Measures\ +locale in_Mx = + fixes X :: "'a quasi_borel" + and \ :: "real \ 'a" + assumes in_Mx[simp]:"\ \ qbs_Mx X" +begin + +lemma \_measurable[measurable]: "\ \ borel \\<^sub>M qbs_to_measure X" + using in_Mx qbs_Mx_subset_of_measurable by blast + +lemma \_qbs_morphism[qbs]: "\ \ qbs_borel \\<^sub>Q X" + using in_Mx by(simp only: qbs_Mx_is_morphisms) + +lemma X_not_empty: "qbs_space X \ {}" + using in_Mx by(auto simp: qbs_empty_equiv simp del: in_Mx) + +lemma inverse_UNIV[simp]: "\ -` (qbs_space X) = UNIV" + by fastforce + +end + +locale qbs_s_finite = in_Mx X \ + s_finite_measure \ + for X :: "'a quasi_borel" and \ and \ :: "real measure" + + assumes mu_sets[measurable_cong]: "sets \ = sets borel" +begin + +lemma mu_not_empty: "space \ \ {}" + by(simp add: sets_eq_imp_space_eq[OF mu_sets]) + +end + +lemma qbs_s_finite_All: + assumes "\ \ qbs_Mx X" "s_finite_kernel M borel k" "x \ space M" + shows "qbs_s_finite X \ (k x)" +proof - + interpret s_finite_kernel M borel k by fact + show ?thesis + using assms(1,3) image_s_finite_measure[OF assms(3)] by(auto simp: qbs_s_finite_def in_Mx_def qbs_s_finite_axioms_def kernel_sets) +qed + +locale qbs_prob = in_Mx X \ + real_distribution \ + for X :: "'a quasi_borel" and \ \ +begin + +lemma qbs_s_finite: "qbs_s_finite X \ \" + by(auto simp: qbs_s_finite_def qbs_s_finite_axioms_def in_Mx_def s_finite_measure_prob) + +sublocale qbs_s_finite by(rule qbs_s_finite) + +end + +lemma(in qbs_s_finite) qbs_probI: "prob_space \ \ qbs_prob X \ \" + by(auto simp: qbs_prob_def in_Mx_def real_distribution_def real_distribution_axioms_def mu_sets) + +locale pair_qbs_s_finites = pq1: qbs_s_finite X \ \ + pq2: qbs_s_finite Y \ \ + for X :: "'a quasi_borel" and \ \ and Y :: "'b quasi_borel" and \ \ +begin + +lemma ab_measurable[measurable]: "map_prod \ \ \ borel \\<^sub>M borel \\<^sub>M qbs_to_measure (X \\<^sub>Q Y)" +proof - + have "map_prod \ \ \ qbs_to_measure (measure_to_qbs (borel \\<^sub>M borel)) \\<^sub>M qbs_to_measure (X \\<^sub>Q Y)" + by(auto intro!: set_mp[OF l_preserves_morphisms] simp: r_preserves_product) + moreover have "sets (qbs_to_measure (measure_to_qbs (borel \\<^sub>M borel))) = sets ((borel \\<^sub>M borel) :: (real \ real) measure)" + by(auto intro!: standard_borel.lr_sets_ident pair_standard_borel_ne standard_borel_ne.standard_borel) + ultimately show ?thesis by simp +qed + +end + +locale pair_qbs_probs = pq1: qbs_prob X \ \ + pq2: qbs_prob Y \ \ + for X :: "'a quasi_borel" and \ \ and Y :: "'b quasi_borel" and \ \ +begin +sublocale pair_qbs_s_finites + by standard +end + +locale pair_qbs_s_finite = pq1: qbs_s_finite X \ \ + pq2: qbs_s_finite X \ \ + for X :: "'a quasi_borel" and \ \ and \ \ +begin +sublocale pair_qbs_s_finites X \ \ X \ \ + by standard +end + +locale pair_qbs_prob = pq1: qbs_prob X \ \ + pq2: qbs_prob X \ \ + for X :: "'a quasi_borel" and \ \ and \ \ +begin + +sublocale pair_qbs_s_finite X \ \ \ \ + by standard + +sublocale pair_qbs_probs X \ \ X \ \ + by standard + +end + +type_synonym 'a qbs_s_finite_t = "'a quasi_borel * (real \ 'a) * real measure" +definition qbs_s_finite_eq :: "['a qbs_s_finite_t, 'a qbs_s_finite_t] \ bool" where + "qbs_s_finite_eq p1 p2 \ + (let (X, \, \) = p1; + (Y, \, \) = p2 in + qbs_s_finite X \ \ \ qbs_s_finite Y \ \ \ X = Y \ + distr \ (qbs_to_measure X) \ = distr \ (qbs_to_measure Y) \)" + +definition qbs_s_finite_eq' :: "['a qbs_s_finite_t, 'a qbs_s_finite_t] \ bool" where + "qbs_s_finite_eq' p1 p2 \ + (let (X, \, \) = p1; + (Y, \, \) = p2 in + qbs_s_finite X \ \ \ qbs_s_finite Y \ \ \ X = Y \ + (\f\X \\<^sub>Q (qbs_borel :: ennreal quasi_borel). (\\<^sup>+x. f (\ x) \\) = (\\<^sup>+x. f (\ x) \\)))" + +lemma(in qbs_s_finite) + shows qbs_s_finite_eq_refl[simp]: "qbs_s_finite_eq (X,\,\) (X,\,\)" + and qbs_s_finite_eq'_refl[simp]: "qbs_s_finite_eq' (X,\,\) (X,\,\)" + by(simp_all add: qbs_s_finite_eq_def qbs_s_finite_eq'_def qbs_s_finite_axioms) + +lemma(in pair_qbs_s_finite) + shows qbs_s_finite_eq_intro: "distr \ (qbs_to_measure X) \ = distr \ (qbs_to_measure X) \ \ qbs_s_finite_eq (X,\,\) (X,\,\)" + and qbs_s_finite_eq'_intro: "(\f. f \ X \\<^sub>Q qbs_borel \ (\\<^sup>+x. f (\ x) \ \) = (\\<^sup>+x. f (\ x) \ \)) \ qbs_s_finite_eq' (X,\,\) (X,\,\)" + by(simp_all add: qbs_s_finite_eq_def qbs_s_finite_eq'_def pq1.qbs_s_finite_axioms pq2.qbs_s_finite_axioms) + +lemma qbs_s_finite_eq_dest: + assumes "qbs_s_finite_eq (X,\,\) (Y,\,\)" + shows "qbs_s_finite X \ \" "qbs_s_finite Y \ \" "Y = X" "distr \ (qbs_to_measure X) \ = distr \ (qbs_to_measure X) \" + using assms by(auto simp: qbs_s_finite_eq_def) + +lemma qbs_s_finite_eq'_dest: + assumes "qbs_s_finite_eq' (X,\,\) (Y,\,\)" + shows "qbs_s_finite X \ \" "qbs_s_finite Y \ \" "Y = X" "\f. f \ X \\<^sub>Q qbs_borel \ (\\<^sup>+x. f (\ x) \ \) = (\\<^sup>+x. f (\ x) \ \)" + using assms by(auto simp: qbs_s_finite_eq'_def) + +lemma(in qbs_prob) qbs_s_finite_eq_qbs_prob_cong: + assumes "qbs_s_finite_eq (X,\,\) (Y,\,\)" + shows "qbs_prob Y \ \" +proof - + interpret qs: pair_qbs_s_finites X \ \ Y \ \ + using assms(1) by(auto simp: qbs_s_finite_eq_def pair_qbs_s_finites_def) + show ?thesis + by(auto intro!: qs.pq2.qbs_probI prob_space_distrD[of \ _ "qbs_to_measure Y"]) (auto simp: qbs_s_finite_eq_dest(3)[OF assms] qbs_s_finite_eq_dest(4)[OF assms,symmetric] intro!: prob_space_distr) +qed + +lemma + shows qbs_s_finite_eq_symp: "symp qbs_s_finite_eq" + and qbs_s_finite_eq_transp: "transp qbs_s_finite_eq" + by(simp_all add: qbs_s_finite_eq_def transp_def symp_def) + +quotient_type 'a qbs_measure = "'a qbs_s_finite_t" / partial: qbs_s_finite_eq + morphisms rep_qbs_measure qbs_measure +proof(rule part_equivpI) + let ?U = "UNIV :: 'a set" + let ?Uf = "UNIV :: (real \ 'a) set" + let ?f = "(\_. undefined) :: real \ 'a" + have "qbs_s_finite (Abs_quasi_borel (?U, ?Uf)) ?f (return borel 0)" + unfolding qbs_s_finite_def in_Mx_def qbs_s_finite_axioms_def + proof safe + have "Rep_quasi_borel (Abs_quasi_borel (?U,?Uf)) = (?U, ?Uf)" + using Abs_quasi_borel_inverse by (auto simp add: qbs_closed1_def qbs_closed2_def qbs_closed3_def is_quasi_borel_def) + thus "(\_. undefined) \ qbs_Mx (Abs_quasi_borel (?U, ?Uf))" + by(simp add: qbs_Mx_def) + next + show "s_finite_measure (return borel 0)" + by(auto intro!: sigma_finite_measure.s_finite_measure prob_space_imp_sigma_finite prob_space_return) + qed simp_all + thus "\x :: 'a qbs_s_finite_t. qbs_s_finite_eq x x" + by(auto simp: qbs_s_finite_eq_def intro!: exI[where x="(Abs_quasi_borel (?U,?Uf), ?f, return borel 0)"]) +qed(simp_all add: qbs_s_finite_eq_symp qbs_s_finite_eq_transp) + +interpretation qbs_measure : quot_type "qbs_s_finite_eq" "Abs_qbs_measure" "Rep_qbs_measure" + using Abs_qbs_measure_inverse Rep_qbs_measure + by(simp add: quot_type_def equivp_implies_part_equivp qbs_measure_equivp Rep_qbs_measure_inverse Rep_qbs_measure_inject) blast + +syntax + "_qbs_measure" :: "'a quasi_borel \ (real \ 'a) \ real measure \ 'a qbs_measure" ("\_,/ _,/ _\\<^sub>s\<^sub>f\<^sub>i\<^sub>n") +translations + "\X, \, \\\<^sub>s\<^sub>f\<^sub>i\<^sub>n" \ "CONST qbs_measure (X, \, \)" + +lemma rep_qbs_s_finite_measure': "\X \ \. p = \X, \, \\\<^sub>s\<^sub>f\<^sub>i\<^sub>n \ qbs_s_finite X \ \" + by(rule qbs_measure.abs_induct,auto simp add: qbs_s_finite_eq_def) + +lemma rep_qbs_s_finite_measure: + obtains X \ \ where "p = \X, \, \\\<^sub>s\<^sub>f\<^sub>i\<^sub>n" "qbs_s_finite X \ \" + using that rep_qbs_s_finite_measure' by blast + +definition qbs_null_measure :: "'a quasi_borel \ 'a qbs_measure" where +"qbs_null_measure X \ \X, SOME a. a \ qbs_Mx X, null_measure borel\\<^sub>s\<^sub>f\<^sub>i\<^sub>n" + +lemma qbs_null_measure_s_finite: "qbs_space X \ {} \ qbs_s_finite X (SOME a. a \ qbs_Mx X) (null_measure borel)" + by(auto simp: qbs_empty_equiv qbs_s_finite_def in_Mx_def qbs_s_finite_axioms_def some_in_eq intro!: finite_measure.s_finite_measure_finite_measure finite_measureI) + +lemma(in qbs_s_finite) in_Rep_qbs_measure': + assumes "qbs_s_finite_eq (X,\,\) (X',\',\')" + shows "(X',\',\') \ Rep_qbs_measure \X, \, \\\<^sub>s\<^sub>f\<^sub>i\<^sub>n" + by (metis assms mem_Collect_eq qbs_s_finite_eq_refl qbs_measure_def qbs_measure.abs_def qbs_measure.abs_inverse) + +lemmas(in qbs_s_finite) in_Rep_qbs_measure = in_Rep_qbs_measure'[OF qbs_s_finite_eq_refl] + +lemma(in qbs_s_finite) if_in_Rep_qbs_measure: + assumes "(X',\',\') \ Rep_qbs_measure \X, \, \\\<^sub>s\<^sub>f\<^sub>i\<^sub>n" + shows "X' = X" + "qbs_s_finite X' \' \'" + "qbs_s_finite_eq (X,\,\) (X',\',\')" +proof - + show h:"X' = X" + using assms qbs_measure.Rep_qbs_measure[of "\X, \, \\\<^sub>s\<^sub>f\<^sub>i\<^sub>n"] + by auto (metis mem_Collect_eq qbs_s_finite_eq_dest(3) qbs_s_finite_eq_refl qbs_measure_def qbs_measure.abs_def qbs_measure.abs_inverse) +next + show "qbs_s_finite X' \' \'" + using assms qbs_measure.Rep_qbs_measure[of "\X, \, \\\<^sub>s\<^sub>f\<^sub>i\<^sub>n"] + by (auto simp: qbs_s_finite_eq_dest(2)) +next + show "qbs_s_finite_eq (X,\,\) (X',\',\')" + using assms qbs_measure.Rep_qbs_measure[of "\X, \, \\\<^sub>s\<^sub>f\<^sub>i\<^sub>n"] + by auto (metis mem_Collect_eq qbs_s_finite_eq_dest(3) qbs_s_finite_eq_refl qbs_measure_def qbs_measure.abs_def qbs_measure.abs_inverse) +qed + +lemma qbs_s_finite_eq_1_imp_2: + assumes "qbs_s_finite_eq (X,\,\) (Y,\,\)" "f \ X \\<^sub>Q (qbs_borel :: (_ :: {banach}) quasi_borel)" + shows "(\x. f (\ x) \\) = (\x. f (\ x) \\)" (is "?lhs = ?rhs") +proof - + interpret pq : pair_qbs_s_finite X \ \ \ \ + using assms by(auto intro!: pair_qbs_s_finite.intro simp: qbs_s_finite_eq_def) + have [measurable]: "f \ qbs_to_measure X \\<^sub>M borel" + using assms by(simp add: lr_adjunction_correspondence) + have "?lhs = (\x. f x \(distr \ (qbs_to_measure X) \))" + by(simp add: integral_distr) + also have "... = (\x. f x \(distr \ (qbs_to_measure X) \))" + by(simp add: qbs_s_finite_eq_dest(4)[OF assms(1)]) + also have "... = ?rhs" + by(simp add: integral_distr) + finally show ?thesis . +qed + +lemma qbs_s_finite_eq_equiv: "qbs_s_finite_eq = qbs_s_finite_eq'" +proof(rule ext[OF ext]) + show "\a b :: 'a qbs_s_finite_t. qbs_s_finite_eq a b = qbs_s_finite_eq' a b" + proof safe + fix X Y :: "'a quasi_borel" and \ \ \ \ + { + assume h:"qbs_s_finite_eq (X,\,\) (Y,\,\)" + then interpret pq : pair_qbs_s_finite X \ \ \ \ + by(auto intro!: pair_qbs_s_finite.intro simp: qbs_s_finite_eq_def) + show "qbs_s_finite_eq' (X,\,\) (Y,\,\)" + unfolding qbs_s_finite_eq_dest(3)[OF h] + proof(rule pq.qbs_s_finite_eq'_intro) + fix f :: "'a \ ennreal" + assume f:"f \ X \\<^sub>Q qbs_borel" + show "(\\<^sup>+ x. f (\ x) \\) = (\\<^sup>+ x. f (\ x) \\)" (is "?lhs = ?rhs") + proof - + have "?lhs = (\\<^sup>+ x. f x \(distr \ (qbs_to_measure X) \))" + by(rule nn_integral_distr[symmetric]) (use f lr_adjunction_correspondence in auto) + also have "... = (\\<^sup>+ x. f x \(distr \ (qbs_to_measure X) \))" + by(simp add: qbs_s_finite_eq_dest(4)[OF h]) + also have "... = ?rhs" + by(rule nn_integral_distr) (use f lr_adjunction_correspondence in auto) + finally show ?thesis . + qed + qed + } + { + assume h:"qbs_s_finite_eq' (X,\,\) (Y,\,\)" + then interpret pq : pair_qbs_s_finite X \ \ \ \ + by(auto intro!: pair_qbs_s_finite.intro simp: qbs_s_finite_eq'_def) + show "qbs_s_finite_eq (X,\,\) (Y,\,\)" + unfolding qbs_s_finite_eq'_dest(3)[OF h] + proof(rule pq.qbs_s_finite_eq_intro[OF measure_eqI]) + fix U + assume hu[measurable]:"U \ sets (distr \ (qbs_to_measure X) \)" + show "emeasure (distr \ (qbs_to_measure X) \) U = emeasure (distr \ (qbs_to_measure X) \) U" + (is "?lhs = ?rhs") + proof - + have "?lhs = (\\<^sup>+ x. indicator U x \ (distr \ (qbs_to_measure X) \))" + using hu by simp + also have "... = (\\<^sup>+ x. indicator U (\ x) \\)" + by(rule nn_integral_distr) (use hu in auto) + also have "... = (\\<^sup>+ x. indicator U (\ x) \\)" + by(auto intro!: qbs_s_finite_eq'_dest(4)[OF h] simp: lr_adjunction_correspondence) + also have "... = (\\<^sup>+ x. indicator U x \ (distr \ (qbs_to_measure X) \))" + by(rule nn_integral_distr[symmetric]) (use hu in auto) + also have "... = ?rhs" + using hu by simp + finally show ?thesis . + qed + qed simp + } + qed +qed + +lemma qbs_s_finite_measure_eq: "qbs_s_finite_eq (X,\,\) (Y,\,\) \ \X, \, \\\<^sub>s\<^sub>f\<^sub>i\<^sub>n = \Y, \, \\\<^sub>s\<^sub>f\<^sub>i\<^sub>n" + using Quotient3_rel[OF Quotient3_qbs_measure] by blast + +lemma(in pair_qbs_s_finite) qbs_s_finite_measure_eq: + "distr \ (qbs_to_measure X) \ = distr \ (qbs_to_measure X) \ \ \X, \, \\\<^sub>s\<^sub>f\<^sub>i\<^sub>n = \X, \, \\\<^sub>s\<^sub>f\<^sub>i\<^sub>n" + by(auto intro!: qbs_s_finite_measure_eq qbs_s_finite_eq_intro) + +lemma(in pair_qbs_s_finite) qbs_s_finite_measure_eq': + "(\f. f \ X \\<^sub>Q qbs_borel \ (\\<^sup>+x. f (\ x) \ \) = (\\<^sup>+x. f (\ x) \ \)) \ \X, \, \\\<^sub>s\<^sub>f\<^sub>i\<^sub>n = \X, \, \\\<^sub>s\<^sub>f\<^sub>i\<^sub>n" + using qbs_s_finite_eq'_intro[simplified qbs_s_finite_eq_equiv[symmetric]] by(auto intro!: qbs_s_finite_measure_eq simp: qbs_s_finite_eq_def) + +lemma(in pair_qbs_s_finite) qbs_s_finite_measure_eq_inverse: + assumes "\X, \, \\\<^sub>s\<^sub>f\<^sub>i\<^sub>n = \X, \, \\\<^sub>s\<^sub>f\<^sub>i\<^sub>n" + shows "qbs_s_finite_eq (X,\,\) (X,\,\)" "qbs_s_finite_eq' (X,\,\) (X,\,\)" + using Quotient3_rel[OF Quotient3_qbs_measure,of "(X,\,\)" "(X,\,\)",simplified] + by(simp_all add: assms qbs_s_finite_eq_equiv) + +lift_definition qbs_space_of :: "'a qbs_measure \ 'a quasi_borel" +is fst by(auto simp: qbs_s_finite_eq_def) + +lemma(in qbs_s_finite) qbs_space_of[simp]: + "qbs_space_of \X, \, \\\<^sub>s\<^sub>f\<^sub>i\<^sub>n = X" by(simp add: qbs_space_of.abs_eq) + +lemma rep_qbs_space_of: + assumes "qbs_space_of s = X" + shows "\\ \. s = \X, \, \\\<^sub>s\<^sub>f\<^sub>i\<^sub>n \ qbs_s_finite X \ \" +proof - + obtain X' \ \ where hs: + "s = \X', \, \\\<^sub>s\<^sub>f\<^sub>i\<^sub>n" "qbs_s_finite X' \ \" + using rep_qbs_s_finite_measure'[of s] by auto + then interpret qs:qbs_s_finite X' \ \ + by simp + show ?thesis + using assms hs(2) by(auto simp add: hs(1)) +qed + +corollary qbs_s_space_of_not_empty: "qbs_space (qbs_space_of X) \ {}" + by transfer (auto simp: qbs_s_finite_eq_def qbs_s_finite_def in_Mx_def qbs_empty_equiv) + + +subsubsection \ The S-Finite Measure Monad\ +definition monadM_qbs :: "'a quasi_borel \ 'a qbs_measure quasi_borel" where +"monadM_qbs X \ Abs_quasi_borel ({s. qbs_space_of s = X}, {\r. \X, \, k r\\<^sub>s\<^sub>f\<^sub>i\<^sub>n |\ k. \ \ qbs_Mx X \ s_finite_kernel borel borel k})" + +lemma + shows monadM_qbs_space: "qbs_space (monadM_qbs X) = {s. qbs_space_of s = X}" + and monadM_qbs_Mx: "qbs_Mx (monadM_qbs X) = {\r. \X, \, k r\\<^sub>s\<^sub>f\<^sub>i\<^sub>n |\ k. \ \ qbs_Mx X \ s_finite_kernel borel borel k}" +proof - + have "{\r::real. \X, \, k r\\<^sub>s\<^sub>f\<^sub>i\<^sub>n |\ k. \ \ qbs_Mx X \ s_finite_kernel borel borel k} \ UNIV \ {s. qbs_space_of s = X}" + proof safe + fix x \ and k :: "real \ real measure" + assume h:"\ \ qbs_Mx X" "s_finite_kernel borel borel k" + interpret k:s_finite_kernel borel borel k by fact + interpret qbs_s_finite X \ "k x" + using k.image_s_finite_measure h(1) by(auto simp: qbs_s_finite_def in_Mx_def qbs_s_finite_axioms_def k.kernel_sets) + show "qbs_space_of \X, \, k x\\<^sub>s\<^sub>f\<^sub>i\<^sub>n = X" + by simp + qed + moreover have "qbs_closed1 {\r. \X, \, k r\\<^sub>s\<^sub>f\<^sub>i\<^sub>n |\ k. \ \ qbs_Mx X \ s_finite_kernel borel borel k}" + proof(safe intro!: qbs_closed1I) + fix \ and f :: "real \ real" and k :: "real\ real measure" + assume h:"f \ borel_measurable borel" "\ \ qbs_Mx X" "s_finite_kernel borel borel k" + then show "\\' ka. (\r. \X, \, k r\\<^sub>s\<^sub>f\<^sub>i\<^sub>n) \ f = (\r. \X, \', ka r\\<^sub>s\<^sub>f\<^sub>i\<^sub>n) \ \' \ qbs_Mx X \ s_finite_kernel borel borel ka" + by(auto intro!: exI[where x=\] exI[where x="\x. k (f x)"] simp: s_finite_kernel.comp_measurable[OF h(3,1)]) + qed + moreover have "qbs_closed2 {s. qbs_space_of s = X} {\r. \X, \, k r\\<^sub>s\<^sub>f\<^sub>i\<^sub>n |\ k. \ \ qbs_Mx X \ s_finite_kernel borel borel k}" + proof(safe intro!: qbs_closed2I) + fix s + assume h:"X = qbs_space_of s" + from rep_qbs_space_of[OF this[symmetric]] obtain \ \ where s:"s = \X, \, \\\<^sub>s\<^sub>f\<^sub>i\<^sub>n" "qbs_s_finite X \ \" + by auto + then interpret qbs_s_finite X \ \ by simp + show "\\ k. (\r. s) = (\r. \qbs_space_of s, \, k r\\<^sub>s\<^sub>f\<^sub>i\<^sub>n) \ \ \ qbs_Mx (qbs_space_of s) \ s_finite_kernel borel borel k" + by(auto intro!: exI[where x=\] exI[where x="\r. \"] s_finite_kernel_const simp: s(1) s_finite_kernel_cong_sets[OF _ mu_sets[symmetric]] sets_eq_imp_space_eq[OF mu_sets]) + qed + moreover have "qbs_closed3 {\r. \X, \, k r\\<^sub>s\<^sub>f\<^sub>i\<^sub>n |\ k. \ \ qbs_Mx X \ s_finite_kernel borel borel k}" + proof(safe intro!: qbs_closed3I) + fix P :: "real \ nat" and Fi :: "nat \ _" + assume P[measurable]: "P \ borel \\<^sub>M count_space UNIV" + and "\i. Fi i \ {\r::real. \X, \, k r\\<^sub>s\<^sub>f\<^sub>i\<^sub>n |\ k. \ \ qbs_Mx X \ s_finite_kernel borel borel k}" + then obtain \i ki where Fi: "\i. Fi i = (\r. \X, \i i, ki i r\\<^sub>s\<^sub>f\<^sub>i\<^sub>n)" "\i. \i i \ qbs_Mx X" "\i. s_finite_kernel borel borel (ki i)" + by auto metis + interpret nat_real: standard_borel_ne "count_space (UNIV :: nat set) \\<^sub>M (borel :: real measure)" + by(auto intro!: pair_standard_borel_ne) + note [simp] = nat_real.from_real_to_real[simplified space_pair_measure, simplified] + define \ where "\ \ (\r. case_prod \i (nat_real.from_real r))" + define k where "k \ (\r. distr (distr (ki (P r) r) (count_space UNIV \\<^sub>M borel) (\r'. (P r, r'))) borel nat_real.to_real)" + have \: "\ \ qbs_Mx X" + unfolding \_def qbs_Mx_is_morphisms + proof(rule qbs_morphism_compose[where g=nat_real.from_real and Y="qbs_count_space UNIV \\<^sub>Q qbs_borel"]) + show "nat_real.from_real \ qbs_borel \\<^sub>Q qbs_count_space UNIV \\<^sub>Q qbs_borel" + by(simp add: r_preserves_product[symmetric] standard_borel.standard_borel_r_full_faithful[of "borel :: real measure",simplified,symmetric] standard_borel_ne.standard_borel) + next + show "case_prod \i \ qbs_count_space UNIV \\<^sub>Q qbs_borel \\<^sub>Q X" + using Fi(2) by(auto intro!: qbs_morphism_pair_count_space1 simp: qbs_Mx_is_morphisms) + qed + have sets_ki[measurable_cong]: "sets (ki i r) = sets borel" "sets (k r) = sets borel" for i r + using Fi(3) by(auto simp: s_finite_kernel_def measure_kernel_def k_def) + interpret k:s_finite_kernel borel borel k + proof - + have 1:"k = (\(i,r). distr (ki i r) borel (\r'. nat_real.to_real (i, r'))) \ (\r. (P r, r))" + by standard (auto simp: k_def distr_distr comp_def) + have "s_finite_kernel borel borel ..." + unfolding comp_def + by(rule s_finite_kernel.comp_measurable[where X="count_space UNIV \\<^sub>M borel"],rule s_finite_kernel_pair_countble1, auto intro!: s_finite_kernel.distr_s_finite_kernel[OF Fi(3)]) + thus "s_finite_kernel borel borel k" by(simp add: 1) + qed + have "(\r. Fi (P r) r) = (\r. \X, \, k r \\<^sub>s\<^sub>f\<^sub>i\<^sub>n)" + unfolding Fi(1) + proof + fix r + interpret pq:pair_qbs_s_finite X "\i (P r)" "ki (P r) r" \ "k r" + by(auto simp: pair_qbs_s_finite_def qbs_s_finite_def in_Mx_def qbs_s_finite_axioms_def k.image_s_finite_measure s_finite_kernel.image_s_finite_measure[OF Fi(3)] sets_ki \ Fi(2)) + show "\X, \i (P r), ki (P r) r\\<^sub>s\<^sub>f\<^sub>i\<^sub>n = \X, \, k r\\<^sub>s\<^sub>f\<^sub>i\<^sub>n" + by(rule pq.qbs_s_finite_measure_eq, simp add: k_def distr_distr comp_def,simp add: \_def) + qed + thus "\\ k. (\r. Fi (P r) r) = (\r. \X, \, k r\\<^sub>s\<^sub>f\<^sub>i\<^sub>n) \ \ \ qbs_Mx X \ s_finite_kernel borel borel k" + by(auto intro!: exI[where x=\] exI[where x=k] simp: \ k.s_finite_kernel_axioms) + qed + ultimately have "Rep_quasi_borel (monadM_qbs X) = ({s. qbs_space_of s = X}, {\r. \X, \, k r\\<^sub>s\<^sub>f\<^sub>i\<^sub>n |\ k. \ \ qbs_Mx X \ s_finite_kernel borel borel k})" + by(auto intro!: Abs_quasi_borel_inverse simp: monadM_qbs_def is_quasi_borel_def) + thus "qbs_space (monadM_qbs X) = {s. qbs_space_of s = X}" "qbs_Mx (monadM_qbs X) = {\r. \X, \, k r\\<^sub>s\<^sub>f\<^sub>i\<^sub>n |\ k. \ \ qbs_Mx X \ s_finite_kernel borel borel k}" + by(simp_all add: qbs_space_def qbs_Mx_def) +qed + +lemma monadM_qbs_empty_iff: "qbs_space X = {} \ qbs_space (monadM_qbs X) = {}" + by(auto simp: monadM_qbs_space qbs_s_space_of_not_empty) (meson in_Mx.intro qbs_closed2_dest qbs_s_finite.qbs_space_of qbs_s_finite_def rep_qbs_s_finite_measure') + +lemma(in qbs_s_finite) in_space_monadM[qbs]: "\X, \, \\\<^sub>s\<^sub>f\<^sub>i\<^sub>n \ qbs_space (monadM_qbs X)" + by(simp add: monadM_qbs_space) + +lemma rep_qbs_space_monadM: + assumes "s \ qbs_space (monadM_qbs X)" + obtains \ \ where "s = \X, \, \\\<^sub>s\<^sub>f\<^sub>i\<^sub>n" "qbs_s_finite X \ \" + using rep_qbs_space_of assms that by(auto simp: monadM_qbs_space) + +lemma rep_qbs_space_monadM_sigma_finite: + assumes "s \ qbs_space (monadM_qbs X)" + obtains \ \ where "s = \X, \, \\\<^sub>s\<^sub>f\<^sub>i\<^sub>n" "qbs_s_finite X \ \" "sigma_finite_measure \" +proof - + obtain \ \ where s:"s = \X, \, \\\<^sub>s\<^sub>f\<^sub>i\<^sub>n" "qbs_s_finite X \ \" + by(metis rep_qbs_space_monadM assms) + hence "standard_borel_ne \""s_finite_measure \" + by(auto intro!: standard_borel_ne_sets[of borel \] simp: qbs_s_finite_def qbs_s_finite_axioms_def) + from exists_push_forward[OF this] obtain \' f where f: + "f \ (borel :: real measure) \\<^sub>M \" "sets \' = sets borel" "sigma_finite_measure \'" "distr \' \ f = \" + by metis + hence [measurable]: "f \ borel_measurable borel" + using s(2) by(auto simp: qbs_s_finite_def qbs_s_finite_axioms_def cong: measurable_cong_sets) + interpret pair_qbs_s_finite X \ \ "\ \ f" \' + proof - + have "qbs_s_finite X (\ \ f) \'" + using s(2) by(auto simp: qbs_s_finite_def in_Mx_def qbs_s_finite_axioms_def[of \'] f(2,3) sigma_finite_measure.s_finite_measure) + thus "pair_qbs_s_finite X \ \ (\ \ f) \'" + by(auto simp: pair_qbs_s_finite_def s(2)) + qed + have "\X, \, \\\<^sub>s\<^sub>f\<^sub>i\<^sub>n = \X, \ \ f, \'\\<^sub>s\<^sub>f\<^sub>i\<^sub>n" + proof - + have [simp]:" distr \ (qbs_to_measure X) \ = distr (distr \' \ f) (qbs_to_measure X) \" + by(simp add: f(4)) + show ?thesis + by(auto intro!: qbs_s_finite_measure_eq simp: distr_distr) + qed + with s(1) pq2.qbs_s_finite_axioms f(3) that + show ?thesis by metis +qed + +lemma qbs_space_of_in: "s \ qbs_space (monadM_qbs X) \ qbs_space_of s = X" + by(simp add: monadM_qbs_space) + +lemma in_qbs_space_of: "s \ qbs_space (monadM_qbs (qbs_space_of s))" + by(simp add: monadM_qbs_space) + +subsubsection \ $l$ \ +lift_definition qbs_l :: "'a qbs_measure \ 'a measure" +is "\p. distr (snd (snd p)) (qbs_to_measure (fst p)) (fst (snd p))" + by(auto simp: qbs_s_finite_eq_def) + +lemma(in qbs_s_finite) qbs_l: "qbs_l \X, \, \\\<^sub>s\<^sub>f\<^sub>i\<^sub>n = distr \ (qbs_to_measure X) \" + by(simp add: qbs_l.abs_eq) + +interpretation qbs_l_s_finite: s_finite_measure "qbs_l (s :: 'a qbs_measure)" +proof(transfer) + show "\s:: 'a qbs_s_finite_t. qbs_s_finite_eq s s \ s_finite_measure (distr (snd (snd s)) (qbs_to_measure (fst s)) (fst (snd s)))" + proof safe + fix X :: "'a quasi_borel" + fix \ \ + assume "qbs_s_finite_eq (X,\,\) (X,\,\)" + then interpret qbs_s_finite X \ \ + by(simp add: qbs_s_finite_eq_def) + show "s_finite_measure (distr (snd (snd (X,\,\))) (qbs_to_measure (fst (X,\,\))) (fst (snd (X,\,\))))" + by(auto intro!: s_finite_measure.s_finite_measure_distr simp: s_finite_measure_axioms) + qed +qed + +lemma space_qbs_l: "qbs_space (qbs_space_of s) = space (qbs_l s)" + by(transfer, auto simp: space_L) + +lemma space_qbs_l_ne: "space (qbs_l s) \ {}" + by transfer (auto simp: qbs_s_finite_eq_def qbs_s_finite_def in_Mx_def space_L qbs_empty_equiv) + +lemma qbs_l_sets: "sets (qbs_to_measure (qbs_space_of s)) = sets (qbs_l s)" + by(transfer,simp) + +lemma qbs_null_measure_in_Mx: "qbs_space X \ {} \ qbs_null_measure X \ qbs_space (monadM_qbs X)" + by(simp add: qbs_s_finite.in_space_monadM[OF qbs_null_measure_s_finite] qbs_null_measure_def) + +lemma qbs_null_measure_null_measure:"qbs_space X \ {} \ qbs_l (qbs_null_measure X) = null_measure (qbs_to_measure X)" + by(auto simp: qbs_null_measure_def qbs_s_finite.qbs_l[OF qbs_null_measure_s_finite] null_measure_distr) + +lemma space_qbs_l_in: + assumes "s \ qbs_space (monadM_qbs X)" + shows "space (qbs_l s) = qbs_space X" + by (metis assms qbs_s_finite.qbs_space_of rep_qbs_space_monadM space_qbs_l) + +lemma sets_qbs_l: + assumes "s \ qbs_space (monadM_qbs X)" + shows "sets (qbs_l s) = sets (qbs_to_measure X)" + using assms qbs_l_sets qbs_space_of_in by blast + +lemma measurable_qbs_l: + assumes "s \ qbs_space (monadM_qbs X)" + shows "qbs_l s \\<^sub>M M = X \\<^sub>Q measure_to_qbs M" + by(auto simp: measurable_cong_sets[OF qbs_l_sets[of s,simplified qbs_space_of_in[OF assms(1)],symmetric] refl] lr_adjunction_correspondence) + +lemma measurable_qbs_l': + assumes "s \ qbs_space (monadM_qbs X)" + shows "qbs_l s \\<^sub>M M = qbs_to_measure X \\<^sub>M M" + by(simp add: measurable_qbs_l[OF assms] lr_adjunction_correspondence) + +lemma rep_qbs_Mx_monadM: + assumes "\ \ qbs_Mx (monadM_qbs X)" + obtains \ k where "\ = (\r. \X, \, k r\\<^sub>s\<^sub>f\<^sub>i\<^sub>n)" "\ \ qbs_Mx X" "s_finite_kernel borel borel k" "\r. qbs_s_finite X \ (k r)" +proof - + have "\\ r k. \ \ qbs_Mx X \ s_finite_kernel borel borel k \ qbs_s_finite X \ (k r)" + by(auto simp: qbs_s_finite_def in_Mx_def qbs_s_finite_axioms_def s_finite_kernel.image_s_finite_measure) (auto simp: s_finite_kernel_def measure_kernel_def) + thus ?thesis + using that assms by(fastforce simp: monadM_qbs_Mx) +qed + +lemma qbs_l_measurable[measurable]:"qbs_l \ qbs_to_measure (monadM_qbs X) \\<^sub>M s_finite_measure_algebra (qbs_to_measure X)" +proof(rule qbs_morphism_dest[OF qbs_morphismI]) + fix \ + assume "\ \ qbs_Mx (monadM_qbs X)" + from rep_qbs_Mx_monadM[OF this] obtain \ k where h: + "\ = (\r. \X, \, k r\\<^sub>s\<^sub>f\<^sub>i\<^sub>n)" "\ \ qbs_Mx X" "s_finite_kernel borel borel k" "\r. qbs_s_finite X \ (k r)" + by metis + show "qbs_l \ \ \ qbs_Mx (measure_to_qbs (s_finite_measure_algebra (qbs_to_measure X)))" + by(auto simp add: qbs_Mx_R comp_def h(1) qbs_s_finite.qbs_l[OF h(4)] h(2,3) intro!: s_finite_kernel.kernel_measurable_s_finite s_finite_kernel.distr_s_finite_kernel[where Y=borel]) +qed + +lemma qbs_l_measure_kernel: "measure_kernel (qbs_to_measure (monadM_qbs X)) (qbs_to_measure X) qbs_l" +proof(cases "qbs_space X = {}") + case True + with monadM_qbs_empty_iff[of X,simplified this] show ?thesis + by(auto intro!: measure_kernel_empty_trivial simp: space_L) +next + case 1:False + show ?thesis + proof + show "\x. x \ space (qbs_to_measure (monadM_qbs X)) \ sets (qbs_l x) = sets (qbs_to_measure X)" + using qbs_l_sets by(auto simp: space_L monadM_qbs_space) + next + show "space (qbs_to_measure X) \ {}" + by(simp add: space_L 1) + qed (rule measurable_emeasure_kernel_s_finite_measure_algebra[OF qbs_l_measurable]) +qed + +lemma qbs_l_inj: "inj_on qbs_l (qbs_space (monadM_qbs X))" + by standard (auto simp: monadM_qbs_space, transfer,auto simp: qbs_s_finite_eq_def) + +lemma qbs_l_morphism: + assumes [measurable]:"A \ sets (qbs_to_measure X)" + shows "(\s. qbs_l s A) \ monadM_qbs X \\<^sub>Q qbs_borel" +proof(rule qbs_morphismI) + fix \ + assume h:"\ \ qbs_Mx (monadM_qbs X)" + hence [qbs]: "\ \ qbs_borel \\<^sub>Q monadM_qbs X" + by(simp_all add: qbs_Mx_is_morphisms) + from rep_qbs_Mx_monadM[OF h(1)] obtain \ k where hk: + "\ = (\r. \X, \, k r\\<^sub>s\<^sub>f\<^sub>i\<^sub>n)" "\ \ qbs_Mx X" "s_finite_kernel borel borel k" "\r. qbs_s_finite X \ (k r)" + by metis + then interpret a: in_Mx X \ by(simp add: in_Mx_def) + have k[measurable_cong]:"sets (k r) = sets borel" for r + using hk(3) by(auto simp: s_finite_kernel_def measure_kernel_def) + show "(\s. emeasure (qbs_l s) A) \ \ \ qbs_Mx qbs_borel" + by(auto simp: hk(1) qbs_s_finite.qbs_l[OF hk(4)] comp_def qbs_Mx_qbs_borel emeasure_distr sets_eq_imp_space_eq[OF k] intro!: s_finite_kernel.emeasure_measurable'[OF hk(3)] measurable_sets_borel[OF _ assms]) +qed + +lemma qbs_l_finite_pred: "qbs_pred (monadM_qbs X) (\s. finite_measure (qbs_l s))" +proof - + have "qbs_space X \ sets (qbs_to_measure X)" + by (metis sets.top space_L) + note qbs_l_morphism[OF this,qbs] + have [simp]:"finite_measure (qbs_l s) \ qbs_l s X \ \" if "s \ monadM_qbs X" for s + by(auto intro!: finite_measureI dest: finite_measure.emeasure_finite simp: space_qbs_l_in[OF that]) + show ?thesis + by(simp cong: qbs_morphism_cong) +qed + +lemma qbs_l_subprob_pred: "qbs_pred (monadM_qbs X) (\s. subprob_space (qbs_l s))" +proof - + have "qbs_space X \ sets (qbs_to_measure X)" + by (metis sets.top space_L) + note qbs_l_morphism[OF this,qbs] + have [simp]:"subprob_space (qbs_l s) \ qbs_l s X \ 1" if "s \ monadM_qbs X" for s + by(auto intro!: subprob_spaceI dest: subprob_space.subprob_emeasure_le_1 simp: space_qbs_l_ne) (simp add: space_qbs_l_in[OF that]) + show ?thesis + by(simp cong: qbs_morphism_cong) +qed + +lemma qbs_l_prob_pred: "qbs_pred (monadM_qbs X) (\s. prob_space (qbs_l s))" +proof - + have "qbs_space X \ sets (qbs_to_measure X)" + by (metis sets.top space_L) + note qbs_l_morphism[OF this,qbs] + have [simp]:"prob_space (qbs_l s) \ qbs_l s X = 1" if "s \ monadM_qbs X" for s + by(auto intro!: prob_spaceI simp: space_qbs_l_ne) (auto simp add: space_qbs_l_in[OF that] dest: prob_space.emeasure_space_1) + show ?thesis + by(simp cong: qbs_morphism_cong) +qed + +subsubsection \ Return \ +definition return_qbs :: "'a quasi_borel \ 'a \ 'a qbs_measure" where +"return_qbs X x \ \X, \r. x, SOME \. real_distribution \\\<^sub>s\<^sub>f\<^sub>i\<^sub>n" + +lemma(in real_distribution) + assumes "x \ qbs_space X" + shows return_qbs:"return_qbs X x = \X, \r. x, M\\<^sub>s\<^sub>f\<^sub>i\<^sub>n" + and return_qbs_prob:"qbs_prob X (\r. x) M" + and return_qbs_s_finite:"qbs_s_finite X (\r. x) M" +proof - + interpret qs1: qbs_prob X "\r. x" M + by(auto simp: qbs_prob_def in_Mx_def real_distribution_axioms intro!: qbs_closed2_dest assms) + show "return_qbs X x = \X, \r. x, M\\<^sub>s\<^sub>f\<^sub>i\<^sub>n" + unfolding return_qbs_def + proof(rule someI2) + show "real_distribution (return borel 0)" by (auto simp: real_distribution_def real_distribution_axioms_def,rule prob_space_return) simp + next + fix N + assume "real_distribution N" + then interpret qs2: qbs_s_finite X "\r. x" N + by(auto simp: qbs_s_finite_def in_Mx_def qbs_s_finite_axioms_def real_distribution_def real_distribution_axioms_def intro!: qbs_closed2_dest assms sigma_finite_measure.s_finite_measure prob_space_imp_sigma_finite) + interpret pair_qbs_s_finite X "\r. x" N "\r. x" M + by standard + show "\X, \r. x, N\\<^sub>s\<^sub>f\<^sub>i\<^sub>n = \X, \r. x, M\\<^sub>s\<^sub>f\<^sub>i\<^sub>n" + by(auto intro!: qbs_s_finite_measure_eq measure_eqI simp: emeasure_distr) (metis \real_distribution N\ emeasure_space_1 prob_space.emeasure_space_1 qs2.mu_sets real_distribution.axioms(1) sets_eq_imp_space_eq space_borel space_eq_univ) + qed + show "qbs_prob X (\r. x) M" "qbs_s_finite X (\r. x) M" + by(simp_all add: qs1.qbs_prob_axioms qs1.qbs_s_finite_axioms) +qed + +lemma return_qbs_comp: + assumes "\ \ qbs_Mx X" + shows "(return_qbs X \ \) = (\r. \X, \, return borel r\\<^sub>s\<^sub>f\<^sub>i\<^sub>n)" +proof + fix r + interpret pqp: pair_qbs_prob X "\k. \ r" "return borel 0" \ "return borel r" + by(simp add: assms qbs_Mx_to_X[OF assms] pair_qbs_prob_def qbs_prob_def in_Mx_def real_distribution_def real_distribution_axioms_def prob_space_return) + show "(return_qbs X \ \) r = \X, \, return borel r\\<^sub>s\<^sub>f\<^sub>i\<^sub>n" + by(auto simp: pqp.pq1.return_qbs[OF qbs_Mx_to_X[OF assms]] distr_return intro!: pqp.qbs_s_finite_measure_eq) +qed + +corollary return_qbs_morphism[qbs]: "return_qbs X \ X \\<^sub>Q monadM_qbs X" +proof(rule qbs_morphismI) + interpret rr : real_distribution "return borel 0" + by(simp add: real_distribution_def real_distribution_axioms_def prob_space_return) + fix \ + assume h:"\ \ qbs_Mx X" + then have 1:"return_qbs X \ \ = (\r. \X, \, return borel r\\<^sub>s\<^sub>f\<^sub>i\<^sub>n)" + by(rule return_qbs_comp) + show "return_qbs X \ \ \ qbs_Mx (monadM_qbs X)" + by(auto simp: 1 monadM_qbs_Mx h prob_kernel_def' intro!: exI[where x=\] exI[where x="return borel"] prob_kernel.s_finite_kernel_prob_kernel) +qed + +subsubsection \Bind\ +definition bind_qbs :: "['a qbs_measure, 'a \ 'b qbs_measure] \ 'b qbs_measure" where +"bind_qbs s f \ (let (X, \, \) = rep_qbs_measure s; + Y = qbs_space_of (f (\ undefined)); + (\, k) = (SOME (\, k). f \ \ = (\r. \Y, \, k r\\<^sub>s\<^sub>f\<^sub>i\<^sub>n) \ \ \ qbs_Mx Y \ s_finite_kernel borel borel k) in + \Y, \, \ \\<^sub>k k\\<^sub>s\<^sub>f\<^sub>i\<^sub>n)" + +adhoc_overloading Monad_Syntax.bind bind_qbs + +lemma(in qbs_s_finite) + assumes "s = \X, \, \\\<^sub>s\<^sub>f\<^sub>i\<^sub>n" + "f \ X \\<^sub>Q monadM_qbs Y" + "\ \ qbs_Mx Y" + "s_finite_kernel borel borel k" + and "(f \ \) = (\r. \Y, \, k r\\<^sub>s\<^sub>f\<^sub>i\<^sub>n)" + shows bind_qbs_s_finite:"qbs_s_finite Y \ (\ \\<^sub>k k)" + and bind_qbs: "s \ f = \Y, \, \ \\<^sub>k k\\<^sub>s\<^sub>f\<^sub>i\<^sub>n" +proof - + interpret k: s_finite_kernel borel borel k by fact + interpret s_fin: qbs_s_finite Y \ "\ \\<^sub>k k" + by(auto simp: qbs_s_finite_def in_Mx_def assms(3) mu_sets qbs_s_finite_axioms_def k.sets_bind_kernel[OF _ mu_sets] intro!:k.comp_s_finite_measure s_finite_measure_axioms) + show "s \ f = \Y, \, \ \\<^sub>k k\\<^sub>s\<^sub>f\<^sub>i\<^sub>n" + proof - + { + fix X' \' \' + assume "(X',\',\') \ Rep_qbs_measure \X, \, \\\<^sub>s\<^sub>f\<^sub>i\<^sub>n" + then have h: "X' = X" "qbs_s_finite X' \' \'" "qbs_s_finite_eq (X,\,\) (X',\',\')" + by(simp_all add: if_in_Rep_qbs_measure) + then interpret s_fin_pq1: pair_qbs_s_finite X \ \ \' \' + by(auto simp: pair_qbs_s_finite_def qbs_s_finite_axioms) + have [simp]: "qbs_space_of (f (\' r)) = Y" for r + using qbs_Mx_to_X[OF qbs_morphism_Mx[OF assms(2) s_fin_pq1.pq2.in_Mx],of r] + by(auto simp: monadM_qbs_space) + have "(let Y = qbs_space_of (f (\' undefined)) in case SOME (\, k). (\r. f (\' r)) = (\r. \Y, \, k r\\<^sub>s\<^sub>f\<^sub>i\<^sub>n) \ \ \ qbs_Mx Y \ s_finite_kernel borel borel k of + (\, k) \ \Y, \, \' \\<^sub>k k\\<^sub>s\<^sub>f\<^sub>i\<^sub>n) = \Y, \, \ \\<^sub>k k\\<^sub>s\<^sub>f\<^sub>i\<^sub>n" + proof - + have "(case SOME (\, k). (\r. f (\' r)) = (\r. \Y, \, k r\\<^sub>s\<^sub>f\<^sub>i\<^sub>n) \ \ \ qbs_Mx Y \ s_finite_kernel borel borel k of (\, k) \ \Y, \, \' \\<^sub>k k\\<^sub>s\<^sub>f\<^sub>i\<^sub>n) = \Y, \, \ \\<^sub>k k\\<^sub>s\<^sub>f\<^sub>i\<^sub>n" + proof(rule someI2_ex) + show "\a. case a of (\, k) \ (\r. f (\' r)) = (\r. \Y, \, k r\\<^sub>s\<^sub>f\<^sub>i\<^sub>n) \ \ \ qbs_Mx Y \ s_finite_kernel borel borel k" + using qbs_morphism_Mx[OF assms(2) s_fin_pq1.pq2.in_Mx] + by(auto simp: comp_def monadM_qbs_Mx) + next + show "\x. (case x of (\, k) \ (\r. f (\' r)) = (\r. \Y, \, k r\\<^sub>s\<^sub>f\<^sub>i\<^sub>n) \ \ \ qbs_Mx Y \ s_finite_kernel borel borel k) \ (case x of (\, k) \ \Y, \, \' \\<^sub>k k\\<^sub>s\<^sub>f\<^sub>i\<^sub>n) = \Y, \, \ \\<^sub>k k\\<^sub>s\<^sub>f\<^sub>i\<^sub>n" + proof safe + fix \' k' + assume h':"(\r. f (\' r)) = (\r. \Y, \', k' r\\<^sub>s\<^sub>f\<^sub>i\<^sub>n)" "\' \ qbs_Mx Y" "s_finite_kernel borel borel k'" + interpret k': s_finite_kernel borel borel k' by fact + have "qbs_s_finite Y \' (\' \\<^sub>k k')" + by(auto simp: qbs_s_finite_def in_Mx_def qbs_s_finite_axioms_def h'(2) k'.sets_bind_kernel[OF _ s_fin_pq1.pq2.mu_sets] s_fin_pq1.pq2.mu_sets intro!:k'.comp_s_finite_measure s_fin_pq1.pq2.s_finite_measure_axioms) + then interpret s_fin_pq2: pair_qbs_s_finite Y \' "\' \\<^sub>k k'" \ "\ \\<^sub>k k" + by(auto simp: pair_qbs_s_finite_def s_fin.qbs_s_finite_axioms) + show "\Y, \', \' \\<^sub>k k'\\<^sub>s\<^sub>f\<^sub>i\<^sub>n = \Y, \, \ \\<^sub>k k\\<^sub>s\<^sub>f\<^sub>i\<^sub>n" + proof(rule s_fin_pq2.qbs_s_finite_measure_eq) + show "distr (\' \\<^sub>k k') (qbs_to_measure Y) \' = distr (\ \\<^sub>k k) (qbs_to_measure Y) \" (is "?lhs = ?rhs") + proof - + have "?lhs = \' \\<^sub>k (\r. distr (k' r) (qbs_to_measure Y) \')" + by(simp add: k'.distr_bind_kernel[OF _ s_fin_pq1.pq2.mu_sets]) + also have "... = \' \\<^sub>k (\r. qbs_l \Y, \', k' r\\<^sub>s\<^sub>f\<^sub>i\<^sub>n)" + by(rule bind_kernel_cong_All,rule qbs_s_finite.qbs_l[symmetric,OF qbs_s_finite_All[where k=k' and M=borel]]) (auto simp: k'.s_finite_kernel_axioms) + also have "... = \' \\<^sub>k (\r. qbs_l (f (\' r)))" + by(auto simp: fun_cong[OF h'(1)]) + also have "... = distr \' (qbs_to_measure X) \' \\<^sub>k (\x. qbs_l (f x))" + by(simp add: measure_kernel.bind_kernel_distr[OF measure_kernel.measure_kernel_comp[OF qbs_l_measure_kernel set_mp[OF l_preserves_morphisms assms(2)]]] sets_eq_imp_space_eq[OF s_fin_pq1.pq2.mu_sets]) + also have "... = distr \ (qbs_to_measure X) \ \\<^sub>k (\x. qbs_l (f x))" + by(simp add: qbs_s_finite_eq_dest(4)[OF h(3)]) + also have "... = \ \\<^sub>k (\r. qbs_l (f (\ r)))" + by(simp add: measure_kernel.bind_kernel_distr[OF measure_kernel.measure_kernel_comp[OF qbs_l_measure_kernel set_mp[OF l_preserves_morphisms assms(2)]]] sets_eq_imp_space_eq[OF mu_sets]) + also have "... = \ \\<^sub>k (\r. qbs_l \Y, \, k r\\<^sub>s\<^sub>f\<^sub>i\<^sub>n)" + by(simp add: fun_cong[OF assms(5),simplified comp_def]) + also have "... = \ \\<^sub>k (\r. distr (k r) (qbs_to_measure Y) \)" + by(rule bind_kernel_cong_All,rule qbs_s_finite.qbs_l[OF qbs_s_finite_All[where k=k and M=borel]]) (auto simp: k.s_finite_kernel_axioms) + also have "... = ?rhs" + by(simp add: k.distr_bind_kernel[OF _ mu_sets]) + finally show ?thesis . + qed + qed + qed + qed + thus ?thesis by simp + qed + } + show ?thesis + unfolding bind_qbs_def rep_qbs_measure_def qbs_measure.rep_def assms(1) + by(rule someI2, rule in_Rep_qbs_measure, auto) fact + qed + show "qbs_s_finite Y \ (\ \\<^sub>k k)" + by(rule s_fin.qbs_s_finite_axioms) +qed + + +lemma bind_qbs_morphism': + assumes "f \ X \\<^sub>Q monadM_qbs Y" + shows "(\x. x \ f) \ monadM_qbs X \\<^sub>Q monadM_qbs Y" +proof(rule qbs_morphismI) + fix \ + assume "\ \ qbs_Mx (monadM_qbs X)" + from rep_qbs_Mx_monadM[OF this] obtain \ k where h: + "\ = (\r. \X, \, k r\\<^sub>s\<^sub>f\<^sub>i\<^sub>n)" "\ \ qbs_Mx X" "s_finite_kernel borel borel k" "\r. qbs_s_finite X \ (k r)" + by metis + from rep_qbs_Mx_monadM[OF qbs_morphism_Mx[OF assms this(2)]] obtain \' k' where h': + "f \ \ = (\r. \Y, \', k' r\\<^sub>s\<^sub>f\<^sub>i\<^sub>n)" "\' \ qbs_Mx Y" "s_finite_kernel borel borel k'" "\r. qbs_s_finite Y \' (k' r)" + by metis + have [simp]:"(\x. x \ f) \ \ = (\r. \Y, \', k r \\<^sub>k k'\\<^sub>s\<^sub>f\<^sub>i\<^sub>n)" + by standard (simp add: h(1) qbs_s_finite.bind_qbs[OF h(4) _ assms h'(2,3,1)]) + show "(\x. x \ f) \ \ \ qbs_Mx (monadM_qbs Y)" + using h'(2) by(auto simp: s_finite_kernel.bind_kernel_s_finite_kernel[OF h(3) h'(3)] monadM_qbs_Mx intro!: exI[where x=\']) +qed + +lemma bind_qbs_return': + assumes "x \ qbs_space (monadM_qbs X)" + shows "x \ return_qbs X = x" +proof - + obtain \ \ where h:"qbs_s_finite X \ \" "x = \X, \, \\\<^sub>s\<^sub>f\<^sub>i\<^sub>n" + using rep_qbs_space_monadM[OF assms] by blast + then interpret qs: qbs_s_finite X \ \ by simp + interpret prob_kernel borel borel "return borel" + by(simp add: prob_kernel_def') + show ?thesis + by(simp add: qs.bind_qbs[OF h(2) return_qbs_morphism _ _ return_qbs_comp] s_finite_kernel_axioms bind_kernel_return''[OF qs.mu_sets] h(2)[symmetric]) +qed + +lemma bind_qbs_return: + assumes "f \ X \\<^sub>Q monadM_qbs Y" + and "x \ qbs_space X" + shows "return_qbs X x \ f = f x" +proof - + from rep_qbs_space_monadM[OF qbs_morphism_space[OF assms]] obtain \ \ where h: + "f x = \Y, \, \\\<^sub>s\<^sub>f\<^sub>i\<^sub>n" "qbs_s_finite Y \ \" by auto + then interpret qs:qbs_s_finite Y \ \ by simp + interpret sk: s_finite_kernel borel borel "\r. \" + by(auto intro!: s_finite_measure.s_finite_kernel_const simp: s_finite_kernel_cong_sets[OF refl qs.mu_sets[symmetric]] qs.s_finite_measure_axioms qs.mu_not_empty) + interpret rd: real_distribution "return borel 0" + by(simp add: real_distribution_def prob_space_return real_distribution_axioms_def) + interpret qbs_prob X "\r. x" "return borel 0" + by(rule rd.return_qbs_prob[OF assms(2)]) + show ?thesis + using bind_qbs[OF rd.return_qbs[OF assms(2)] assms(1) qs.in_Mx sk.s_finite_kernel_axioms] + by(simp add: h(1) sk.bind_kernel_return) +qed + +lemma bind_qbs_assoc: + assumes "s \ qbs_space (monadM_qbs X)" + "f \ X \\<^sub>Q monadM_qbs Y" + and "g \ Y \\<^sub>Q monadM_qbs Z" + shows "s \ (\x. f x \ g) = (s \ f) \ g" (is "?lhs = ?rhs") +proof - + obtain \ \ where h:"s = \X, \, \\\<^sub>s\<^sub>f\<^sub>i\<^sub>n" "qbs_s_finite X \ \" + using rep_qbs_space_monadM[OF assms(1)] by blast + then interpret qs: qbs_s_finite X \ \ by simp + from rep_qbs_Mx_monadM[OF qbs_morphism_Mx[OF assms(2) qs.in_Mx]] obtain \ k where h': + "f \ \ = (\r. \Y, \, k r\\<^sub>s\<^sub>f\<^sub>i\<^sub>n)" "\ \ qbs_Mx Y" "s_finite_kernel borel borel k" "\r. qbs_s_finite Y \ (k r)" + by metis + from rep_qbs_Mx_monadM[OF qbs_morphism_Mx[OF assms(3) h'(2)]] obtain \ k' where h'': + "g \ \ = (\r. \Z, \, k' r\\<^sub>s\<^sub>f\<^sub>i\<^sub>n)" "\ \ qbs_Mx Z" "s_finite_kernel borel borel k'" "\r. qbs_s_finite Z \ (k' r)" + by metis + have 1:"(\x. f x \ g) \ \ = (\r. \Z, \, k r \\<^sub>k k'\\<^sub>s\<^sub>f\<^sub>i\<^sub>n)" + by standard (simp add: qbs_s_finite.bind_qbs[OF h'(4) fun_cong[OF h'(1),simplified] assms(3) h''(2,3,1)]) + + have "?lhs = \Z, \, \ \\<^sub>k (\r. k r \\<^sub>k k')\\<^sub>s\<^sub>f\<^sub>i\<^sub>n" + by(rule qs.bind_qbs[OF h(1) qbs_morphism_compose[OF assms(2) bind_qbs_morphism'[OF assms(3)]] h''(2) s_finite_kernel.bind_kernel_s_finite_kernel[OF h'(3) h''(3)] 1]) + also have "... = \Z, \, \ \\<^sub>k k \\<^sub>k k'\\<^sub>s\<^sub>f\<^sub>i\<^sub>n" + by(simp add: s_finite_kernel.bind_kernel_assoc[OF h'(3) h''(3) qs.mu_sets]) + also have "... = ?rhs" + by(simp add: qbs_s_finite.bind_qbs[OF qs.bind_qbs_s_finite[OF h(1) assms(2) h'(2,3,1)] qs.bind_qbs[OF h(1) assms(2) h'(2,3,1)] assms(3) h''(2,3,1)]) + finally show ?thesis . +qed + +lemma bind_qbs_cong: + assumes [qbs]:"s \ qbs_space (monadM_qbs X)" + "\x. x \ qbs_space X \ f x = g x" + and [qbs]:"f \ X \\<^sub>Q monadM_qbs Y" + shows "s \ f = s \ g" +proof - + from rep_qbs_space_monadM[OF assms(1)] obtain \ \ where h: + "s = \X, \, \\\<^sub>s\<^sub>f\<^sub>i\<^sub>n" "qbs_s_finite X \ \" by auto + interpret qbs_s_finite X \ \ by fact + from rep_qbs_Mx_monadM[OF qbs_morphism_Mx[OF assms(3) in_Mx]] obtain \ k where h': + "f \ \ = (\r. \Y, \, k r\\<^sub>s\<^sub>f\<^sub>i\<^sub>n)" "\ \ qbs_Mx Y" "s_finite_kernel borel borel k" by metis + have g: "g \ X \\<^sub>Q monadM_qbs Y" "g \ \ = (\r. \Y, \, k r\\<^sub>s\<^sub>f\<^sub>i\<^sub>n)" + using qbs_Mx_to_X[OF in_Mx] assms(2) fun_cong[OF h'(1)] + by(auto simp: assms(2)[symmetric] cong: qbs_morphism_cong) + show ?thesis + by(simp add: bind_qbs[OF h(1) assms(3) h'(2,3,1)] bind_qbs[OF h(1) g(1) h'(2,3) g(2)]) +qed + +subsubsection \ The Functorial Action \ +definition distr_qbs :: "['a quasi_borel, 'b quasi_borel,'a \ 'b,'a qbs_measure] \ 'b qbs_measure" where +"distr_qbs _ Y f sx \ sx \ return_qbs Y \ f" + +lemma distr_qbs_morphism': + assumes "f \ X \\<^sub>Q Y" + shows "distr_qbs X Y f \ monadM_qbs X \\<^sub>Q monadM_qbs Y" + unfolding distr_qbs_def + by(rule bind_qbs_morphism'[OF qbs_morphism_comp[OF assms return_qbs_morphism]]) + +lemma(in qbs_s_finite) + assumes "s = \X, \, \\\<^sub>s\<^sub>f\<^sub>i\<^sub>n" + and "f \ X \\<^sub>Q Y" + shows distr_qbs_s_finite:"qbs_s_finite Y (f \ \) \" + and distr_qbs: "distr_qbs X Y f s = \Y, f \ \, \\\<^sub>s\<^sub>f\<^sub>i\<^sub>n" + by(auto intro!: bind_qbs[OF assms(1) qbs_morphism_comp[OF assms(2) return_qbs_morphism],of "f \ \" "return borel" ,simplified bind_kernel_return''[OF mu_sets]] bind_qbs_s_finite[OF assms(1) qbs_morphism_comp[OF assms(2) return_qbs_morphism],of "f \ \" "return borel" ,simplified bind_kernel_return''[OF mu_sets]] + simp: distr_qbs_def return_qbs_comp[OF qbs_morphism_Mx[OF assms(2) in_Mx],simplified comp_assoc[symmetric]] qbs_morphism_Mx[OF assms(2) in_Mx] prob_kernel.s_finite_kernel_prob_kernel[of borel borel "return borel",simplified prob_kernel_def']) + +lemma(in qbs_prob) + assumes "s = \X, \, \\\<^sub>s\<^sub>f\<^sub>i\<^sub>n" + and "f \ X \\<^sub>Q Y" + shows distr_qbs_prob:"qbs_prob Y (f \ \) \" + by(auto simp: distr_qbs_def prob_space_axioms intro!: qbs_s_finite.qbs_probI[OF distr_qbs_s_finite[OF assms]]) + +text \ We show that $M$ is a functor i.e. $M$ preserve identity and composition.\ +lemma distr_qbs_id: + assumes "s \ qbs_space (monadM_qbs X)" + shows "distr_qbs X X id s = s" + using bind_qbs_return'[OF assms] by(simp add: distr_qbs_def) + +lemma distr_qbs_comp: + assumes "s \ qbs_space (monadM_qbs X)" + "f \ X \\<^sub>Q Y" + and "g \ Y \\<^sub>Q Z" + shows "((distr_qbs Y Z g) \ (distr_qbs X Y f)) s = distr_qbs X Z (g \ f) s" +proof - + from rep_qbs_space_monadM[OF assms(1)] obtain \ \ where h: + "qbs_s_finite X \ \" "s = \X, \, \\\<^sub>s\<^sub>f\<^sub>i\<^sub>n" by metis + have "qbs_s_finite Y (f \ \) \" "distr_qbs X Y f s = \Y, f \ \, \\\<^sub>s\<^sub>f\<^sub>i\<^sub>n" + by(simp_all add: qbs_s_finite.distr_qbs_s_finite[OF h assms(2)] qbs_s_finite.distr_qbs[OF h assms(2)]) + from qbs_s_finite.distr_qbs[OF this assms(3)] qbs_s_finite.distr_qbs[OF h qbs_morphism_comp[OF assms(2,3)]] + show ?thesis + by(simp add: comp_assoc) +qed + +subsubsection \ Join \ +definition join_qbs :: "'a qbs_measure qbs_measure \ 'a qbs_measure" where +"join_qbs \ (\sst. sst \ id)" + +lemma join_qbs_morphism[qbs]: "join_qbs \ monadM_qbs (monadM_qbs X) \\<^sub>Q monadM_qbs X" + by(simp add: join_qbs_def bind_qbs_morphism'[OF qbs_morphism_ident]) + +lemma + assumes "qbs_s_finite (monadM_qbs X) \ \" + "ssx = \monadM_qbs X, \, \\\<^sub>s\<^sub>f\<^sub>i\<^sub>n" + "\ \ qbs_Mx X" + "s_finite_kernel borel borel k" + and "\ =(\r. \X, \, k r\\<^sub>s\<^sub>f\<^sub>i\<^sub>n)" + shows qbs_s_finite_join_qbs_s_finite: "qbs_s_finite X \ (\ \\<^sub>k k)" + and qbs_s_finite_join_qbs: "join_qbs ssx = \X, \, \ \\<^sub>k k\\<^sub>s\<^sub>f\<^sub>i\<^sub>n" + using qbs_s_finite.bind_qbs[OF assms(1,2) qbs_morphism_ident assms(3,4)] qbs_s_finite.bind_qbs_s_finite[OF assms(1,2) qbs_morphism_ident assms(3,4)] + by(auto simp: assms(5) join_qbs_def) + +subsubsection \ Strength \ +definition strength_qbs :: "['a quasi_borel,'b quasi_borel,'a \ 'b qbs_measure] \ ('a \ 'b) qbs_measure" where +"strength_qbs W X = (\(w,sx). let (_,\,\) = rep_qbs_measure sx + in \W \\<^sub>Q X, \r. (w,\ r), \\\<^sub>s\<^sub>f\<^sub>i\<^sub>n)" + +lemma(in qbs_s_finite) + assumes "w \ qbs_space W" + and "sx = \X, \, \\\<^sub>s\<^sub>f\<^sub>i\<^sub>n" + shows strength_qbs_s_finite: "qbs_s_finite (W \\<^sub>Q X) (\r. (w,\ r)) \" + and strength_qbs: "strength_qbs W X (w,sx) = \W \\<^sub>Q X, \r. (w,\ r), \\\<^sub>s\<^sub>f\<^sub>i\<^sub>n" +proof - + interpret qs: qbs_s_finite "W \\<^sub>Q X" "\r. (w,\ r)" \ + by(auto simp: qbs_s_finite_def s_finite_measure_axioms qbs_s_finite_axioms_def mu_sets in_Mx_def assms(1) intro!: pair_qbs_MxI) + show "qbs_s_finite (W \\<^sub>Q X) (\r. (w,\ r)) \" by (rule qs.qbs_s_finite_axioms) + show "strength_qbs W X (w,sx) = \W \\<^sub>Q X, \r. (w,\ r), \\\<^sub>s\<^sub>f\<^sub>i\<^sub>n" + proof - + { + fix X' \' \' + assume "(X',\',\') \ Rep_qbs_measure \X, \, \\\<^sub>s\<^sub>f\<^sub>i\<^sub>n" + then have h: "X' = X" "qbs_s_finite X' \' \'" "qbs_s_finite_eq (X,\,\) (X',\',\')" + by(simp_all add: if_in_Rep_qbs_measure) + then interpret qs': qbs_s_finite "W \\<^sub>Q X" "\r. (w,\' r)" \' + by(auto simp: qbs_s_finite_def in_Mx_def assms(1) intro!: pair_qbs_MxI) + interpret pq: pair_qbs_s_finite "W \\<^sub>Q X" "\r. (w,\ r)" \ "\r. (w,\' r)" \' + by(auto simp: qs.qbs_s_finite_axioms qs'.qbs_s_finite_axioms pair_qbs_s_finite_def) + have "\W \\<^sub>Q X, \r. (w, \' r), \'\\<^sub>s\<^sub>f\<^sub>i\<^sub>n = \W \\<^sub>Q X, \r. (w, \ r), \\\<^sub>s\<^sub>f\<^sub>i\<^sub>n" + proof(rule pq.qbs_s_finite_measure_eq'[symmetric]) + fix f :: "_ \ ennreal" + assume "f \ W \\<^sub>Q X \\<^sub>Q qbs_borel" + then have f: "curry f w \ X \\<^sub>Q qbs_borel" + by (metis assms(1) qbs_morphism_curry qbs_morphism_space) + show "(\\<^sup>+ x. f (w, \ x) \\) = (\\<^sup>+ x. f (w, \' x) \\')" (is "?lhs = ?rhs") + proof - + have "?lhs = (\\<^sup>+ x. curry f w (\ x) \\)" by simp + also have "... = (\\<^sup>+ x. curry f w (\' x) \\')" + using h(3) f by(auto simp: qbs_s_finite_eq_equiv qbs_s_finite_eq'_def h(1)) + also have "... = ?rhs" by simp + finally show ?thesis . + qed + qed + } + show ?thesis + by(simp add: strength_qbs_def rep_qbs_measure_def qbs_measure.rep_def assms(2)) (rule someI2, rule in_Rep_qbs_measure, auto, fact) + qed +qed + +lemma(in qbs_prob) + assumes "w \ qbs_space W" + and "sx = \X, \, \\\<^sub>s\<^sub>f\<^sub>i\<^sub>n" + shows strength_qbs_prob: "qbs_prob (W \\<^sub>Q X) (\r. (w,\ r)) \" + by(auto intro!: qbs_s_finite.qbs_probI[OF strength_qbs_s_finite[OF assms]] prob_space_axioms) + +lemma strength_qbs_natural: + assumes "f \ X \\<^sub>Q X'" + "g \ Y \\<^sub>Q Y'" + "x \ qbs_space X" + and "sy \ qbs_space (monadM_qbs Y)" + shows "(distr_qbs (X \\<^sub>Q Y) (X' \\<^sub>Q Y') (map_prod f g) \ strength_qbs X Y) (x,sy) = (strength_qbs X' Y' \ map_prod f (distr_qbs Y Y' g)) (x,sy)" + (is "?lhs = ?rhs") +proof - + from rep_qbs_space_monadM[OF assms(4)] obtain \ \ + where h:"sy = \Y, \, \\\<^sub>s\<^sub>f\<^sub>i\<^sub>n" "qbs_s_finite Y \ \" by metis + have "?lhs = (distr_qbs (X \\<^sub>Q Y) (X' \\<^sub>Q Y') (map_prod f g)) (\X \\<^sub>Q Y, \r. (x,\ r), \\\<^sub>s\<^sub>f\<^sub>i\<^sub>n)" + by(simp add: qbs_s_finite.strength_qbs[OF h(2) assms(3) h(1)]) + also have "... = \X' \\<^sub>Q Y', map_prod f g \ (\r. (x, \ r)), \\\<^sub>s\<^sub>f\<^sub>i\<^sub>n" + using assms by(simp add: qbs_s_finite.distr_qbs[OF qbs_s_finite.strength_qbs_s_finite[OF h(2) assms(3) h(1)] refl ]) + also have "... = \X' \\<^sub>Q Y',\r. (f x, (g \ \) r), \\\<^sub>s\<^sub>f\<^sub>i\<^sub>n" by (simp add: comp_def) + also have "... = ?rhs" + by(simp add: qbs_s_finite.strength_qbs[OF qbs_s_finite.distr_qbs_s_finite[OF h(2,1) assms(2)] qbs_morphism_space[OF assms(1,3)] qbs_s_finite.distr_qbs[OF h(2,1) assms(2)]]) + finally show ?thesis . +qed + +context +begin + +interpretation rr : standard_borel_ne "borel \\<^sub>M borel :: (real \ real) measure" + by(auto intro!: pair_standard_borel_ne) + +declare rr.from_real_to_real[simplified space_pair_measure,simplified,simp] + +lemma rr_from_real_to_real_id[simp]: "rr.from_real \ rr.to_real = id" + by(auto simp: comp_def) + +lemma + assumes "\ \ qbs_Mx X" + "\ \ qbs_Mx (monadM_qbs Y)" + "\ \ qbs_Mx Y" + "s_finite_kernel borel borel k" + and "\ = (\r. \Y, \, k r\\<^sub>s\<^sub>f\<^sub>i\<^sub>n)" + shows strength_qbs_ab_r_s_finite: "qbs_s_finite (X \\<^sub>Q Y) (map_prod \ \ \ rr.from_real) (distr (return borel r \\<^sub>M k r) borel rr.to_real)" + and strength_qbs_ab_r: "strength_qbs X Y (\ r, \ r) = \X \\<^sub>Q Y, map_prod \ \ \ rr.from_real, distr (return borel r \\<^sub>M k r) borel rr.to_real\\<^sub>s\<^sub>f\<^sub>i\<^sub>n" (is ?goal2) +proof - + interpret k: s_finite_kernel borel borel k by fact + note 1[measurable_cong] = sets_return[of borel r] k.kernel_sets[of r,simplified] + show "qbs_s_finite (X \\<^sub>Q Y) (map_prod \ \ \ rr.from_real) (distr (return borel r \\<^sub>M k r) borel rr.to_real)" + using assms(1,3) by(auto simp: qbs_s_finite_def in_Mx_def qbs_s_finite_axioms_def qbs_Mx_is_morphisms r_preserves_product[symmetric] standard_borel_ne.standard_borel intro!: s_finite_measure.s_finite_measure_distr[OF pair_measure_s_finite_measure[OF prob_space.s_finite_measure_prob[OF prob_space_return[of r borel]] k.image_s_finite_measure[of r]]] qbs_morphism_comp[where Y="qbs_borel \\<^sub>Q qbs_borel"] qbs_morphism_space[OF qbs_morphism_space[OF qbs_morphism_map_prod]] standard_borel.qbs_morphism_measurable_intro[of "borel :: real measure"]) + then interpret qs: qbs_s_finite "X \\<^sub>Q Y" "map_prod \ \ \ rr.from_real" "distr (return borel r \\<^sub>M k r) borel rr.to_real" . + interpret qs2: qbs_s_finite Y \ "k r" + by(auto simp: qbs_s_finite_def k.image_s_finite_measure in_Mx_def assms qbs_s_finite_axioms_def k.kernel_sets) + interpret pq: pair_qbs_s_finite "X \\<^sub>Q Y" "\l. (\ r, \ l)" "k r" "map_prod \ \ \ rr.from_real" "distr (return borel r \\<^sub>M k r) borel rr.to_real" + by (auto simp: pair_qbs_s_finite_def qs.qbs_s_finite_axioms qs2.strength_qbs_s_finite[OF qbs_Mx_to_X[OF assms(1),of r] fun_cong[OF assms(5)]]) + have [measurable]: "map_prod \ \ \ borel \\<^sub>M borel \\<^sub>M qbs_to_measure (X \\<^sub>Q Y)" + proof - + have "map_prod \ \ \ qbs_borel \\<^sub>Q qbs_borel \\<^sub>Q X \\<^sub>Q Y" + using assms by(auto intro!: qbs_morphism_map_prod simp: qbs_Mx_is_morphisms) + also have "... \ qbs_to_measure (qbs_borel \\<^sub>Q qbs_borel) \\<^sub>M qbs_to_measure (X \\<^sub>Q Y)" + by(rule l_preserves_morphisms) + also have "... = borel \\<^sub>M borel \\<^sub>M qbs_to_measure (X \\<^sub>Q Y)" + using rr.lr_sets_ident l_preserves_morphisms by(auto simp add: r_preserves_product[symmetric]) + finally show ?thesis . + qed + show ?goal2 + unfolding qs2.strength_qbs[OF qbs_Mx_to_X[OF assms(1),of r] fun_cong[OF assms(5)]] + proof(rule pq.qbs_s_finite_measure_eq) + show "distr (k r) (qbs_to_measure (X \\<^sub>Q Y)) (\l. (\ r, \ l)) = distr (distr (return borel r \\<^sub>M k r) borel rr.to_real) (qbs_to_measure (X \\<^sub>Q Y)) (map_prod \ \ \ rr.from_real)" + (is "?lhs = ?rhs") + proof - + have "?lhs = distr (k r) (qbs_to_measure (X \\<^sub>Q Y)) (map_prod \ \ \ Pair r)" + by(simp add: comp_def) + also have "... = distr (distr (k r) (borel \\<^sub>M borel) (Pair r)) (qbs_to_measure (X \\<^sub>Q Y)) (map_prod \ \)" + by(auto intro!: distr_distr[symmetric]) + also have "... = distr (return borel r \\<^sub>M k r) (qbs_to_measure (X \\<^sub>Q Y)) (map_prod \ \)" + proof - + have "return borel r \\<^sub>M k r = distr (k r) (borel \\<^sub>M borel) (\l. (r,l))" + by(auto intro!: measure_eqI simp: sets_pair_measure_cong[OF refl 1(2)] qs2.emeasure_pair_measure_alt' emeasure_distr nn_integral_return[OF _ qs2.measurable_emeasure_Pair']) + thus ?thesis by simp + qed + also have "... = ?rhs" + by(simp add: distr_distr comp_def) + finally show ?thesis . + qed + qed +qed + +lemma strength_qbs_morphism[qbs]: "strength_qbs X Y \ X \\<^sub>Q monadM_qbs Y \\<^sub>Q monadM_qbs (X \\<^sub>Q Y)" +proof(rule pair_qbs_morphismI) + fix \ \ + assume h:"\ \ qbs_Mx X" + "\ \ qbs_Mx (monadM_qbs Y)" + from rep_qbs_Mx_monadM[OF this(2)] obtain \ k where hb: + "\ = (\r. \Y, \, k r\\<^sub>s\<^sub>f\<^sub>i\<^sub>n)" "\ \ qbs_Mx Y" "s_finite_kernel borel borel k" + by metis + have "s_finite_kernel borel borel (\r. distr (return borel r \\<^sub>M k r) borel rr.to_real)" + by(auto intro!: s_finite_kernel.distr_s_finite_kernel[where Y="borel \\<^sub>M borel"] s_finite_kernel_pair_measure[OF prob_kernel.s_finite_kernel_prob_kernel] simp:hb prob_kernel_def') + thus "(\r. strength_qbs X Y (\ r, \ r)) \ qbs_Mx (monadM_qbs (X \\<^sub>Q Y))" + using strength_qbs_ab_r[OF h hb(2,3,1)] strength_qbs_ab_r_s_finite[OF h hb(2,3,1)] + by(auto simp: monadM_qbs_Mx qbs_s_finite_def in_Mx_def intro!: exI[where x="map_prod \ \ \ rr.from_real"] exI[where x="\r. distr (return borel r \\<^sub>M k r) borel rr.to_real"]) +qed + +lemma bind_qbs_morphism[qbs]: "(\) \ monadM_qbs X \\<^sub>Q (X \\<^sub>Q monadM_qbs Y) \\<^sub>Q monadM_qbs Y" +proof - + { + fix f s + assume h:"f \ X \\<^sub>Q monadM_qbs Y" "s \ qbs_space (monadM_qbs X)" + from rep_qbs_space_monadM[OF this(2)] obtain \ \ where h': + "s = \X, \, \\\<^sub>s\<^sub>f\<^sub>i\<^sub>n" "qbs_s_finite X \ \" by metis + then interpret qbs_s_finite X \ \ by simp + from rep_qbs_Mx_monadM[OF qbs_morphism_Mx[OF h(1) in_Mx]] obtain \ k + where hb:"f \ \ = (\r. \Y, \, k r\\<^sub>s\<^sub>f\<^sub>i\<^sub>n)" "\ \ qbs_Mx Y" "s_finite_kernel borel borel k" by metis + have "join_qbs (distr_qbs ((X \\<^sub>Q monadM_qbs Y) \\<^sub>Q X) (monadM_qbs Y) (\fx. fst fx (snd fx)) (strength_qbs (X \\<^sub>Q monadM_qbs Y) X (f, s))) = s \ f" + using qbs_s_finite_join_qbs[OF qbs_s_finite.distr_qbs_s_finite[OF strength_qbs_s_finite[of f "X \\<^sub>Q monadM_qbs Y",OF h(1) h'(1)] strength_qbs[of f "X \\<^sub>Q monadM_qbs Y",OF h(1) h'(1)] qbs_morphism_eval] qbs_s_finite.distr_qbs[OF strength_qbs_s_finite[of f "X \\<^sub>Q monadM_qbs Y",OF h(1) h'(1)] strength_qbs[of f "X \\<^sub>Q monadM_qbs Y",OF h(1) h'(1)] qbs_morphism_eval] hb(2,3)] hb(1) + by(simp add: bind_qbs[OF h'(1) h(1) hb(2,3,1)] comp_def) + } + thus ?thesis + by(auto intro!: arg_swap_morphism[OF curry_preserves_morphisms[OF qbs_morphism_cong'[of _ "join_qbs \ (distr_qbs (exp_qbs X (monadM_qbs Y) \\<^sub>Q X) (monadM_qbs Y) (\fx. (fst fx) (snd fx))) \ (strength_qbs (exp_qbs X (monadM_qbs Y)) X)"]]] qbs_morphism_comp distr_qbs_morphism' strength_qbs_morphism join_qbs_morphism qbs_morphism_eval simp: pair_qbs_space) +qed + +lemma strength_qbs_law1: + assumes "x \ qbs_space (unit_quasi_borel \\<^sub>Q monadM_qbs X)" + shows "snd x = (distr_qbs (unit_quasi_borel \\<^sub>Q X) X snd \ strength_qbs unit_quasi_borel X) x" +proof - + obtain \ \ where h: + "qbs_s_finite X \ \" "(snd x) = \X, \, \\\<^sub>s\<^sub>f\<^sub>i\<^sub>n" + using rep_qbs_space_monadM[of "snd x" X] assms by (auto simp: pair_qbs_space) metis + have [simp]: "((),snd x) = x" + using SigmaE assms by (auto simp: pair_qbs_space) + show ?thesis + using qbs_s_finite.distr_qbs[OF qbs_s_finite.strength_qbs_s_finite[OF h(1) _ h(2),of "fst x" unit_quasi_borel] qbs_s_finite.strength_qbs[OF h(1) _ h(2)] snd_qbs_morphism] + by(auto simp: comp_def,simp add: h(2)) +qed + +lemma strength_qbs_law2: + assumes "x \ qbs_space ((X \\<^sub>Q Y) \\<^sub>Q monadM_qbs Z)" + shows "(strength_qbs X (Y \\<^sub>Q Z) \ (map_prod id (strength_qbs Y Z)) \ (\((x,y),z). (x,(y,z)))) x = + (distr_qbs ((X \\<^sub>Q Y) \\<^sub>Q Z) (X \\<^sub>Q (Y \\<^sub>Q Z)) (\((x,y),z). (x,(y,z))) \ strength_qbs (X \\<^sub>Q Y) Z) x" + (is "?lhs = ?rhs") +proof - + obtain \ \ where h: + "qbs_s_finite Z \ \" "snd x = \Z, \, \\\<^sub>s\<^sub>f\<^sub>i\<^sub>n" + using rep_qbs_space_monadM[of "snd x" Z] assms by (auto simp: pair_qbs_space) metis + then have "?lhs = \X \\<^sub>Q Y \\<^sub>Q Z, \r. (fst (fst x), snd (fst x), \ r), \\\<^sub>s\<^sub>f\<^sub>i\<^sub>n" + using assms qbs_s_finite.strength_qbs_s_finite[OF h(1) _ h(2),of "snd (fst x)" Y] + by(auto intro!: qbs_s_finite.strength_qbs simp: pair_qbs_space) + also have "... = ?rhs" + using qbs_s_finite.distr_qbs[OF qbs_s_finite.strength_qbs_s_finite[OF h(1) _ h(2),of "fst x" "X \\<^sub>Q Y"] qbs_s_finite.strength_qbs[OF h(1) _ h(2),of "fst x" "X \\<^sub>Q Y"] qbs_morphism_pair_assoc1] assms + by(auto simp: comp_def pair_qbs_space) + finally show ?thesis . +qed + +lemma strength_qbs_law3: + assumes "x \ qbs_space (X \\<^sub>Q Y)" + shows "return_qbs (X \\<^sub>Q Y) x = (strength_qbs X Y \ (map_prod id (return_qbs Y))) x" +proof - + interpret qp: qbs_prob Y "\r. snd x" "return borel 0" + using assms by(auto simp: prob_space_return pair_qbs_space qbs_prob_def in_Mx_def real_distribution_def real_distribution_axioms_def) + show ?thesis + using qp.strength_qbs[OF _ qp.return_qbs[of "snd x" Y],of "fst x" X] qp.return_qbs[OF assms] assms + by(auto simp: pair_qbs_space) +qed + +lemma strength_qbs_law4: + assumes "x \ qbs_space (X \\<^sub>Q monadM_qbs (monadM_qbs Y))" + shows "(strength_qbs X Y \ map_prod id join_qbs) x = (join_qbs \ distr_qbs (X \\<^sub>Q monadM_qbs Y) (monadM_qbs (X \\<^sub>Q Y)) (strength_qbs X Y) \ strength_qbs X (monadM_qbs Y)) x" + (is "?lhs = ?rhs") +proof - + from assms rep_qbs_space_monadM[of "snd x" "monadM_qbs Y"] obtain \ \ + where h:"qbs_s_finite (monadM_qbs Y) \ \" "snd x = \monadM_qbs Y, \, \\\<^sub>s\<^sub>f\<^sub>i\<^sub>n" + by (auto simp: pair_qbs_space) metis + with rep_qbs_Mx_monadM[of \ Y] obtain \ k + where h': "\ \ qbs_Mx Y" "s_finite_kernel borel borel k" "\ = (\r. \Y, \, k r\\<^sub>s\<^sub>f\<^sub>i\<^sub>n)" + and h'': "\r. qbs_s_finite Y \ (k r)" + by(auto simp: qbs_s_finite_def in_Mx_def) metis + have "?lhs = \X \\<^sub>Q Y, \r. (fst x, \ r), \ \\<^sub>k k\\<^sub>s\<^sub>f\<^sub>i\<^sub>n" + using qbs_s_finite.strength_qbs[OF qbs_s_finite_join_qbs_s_finite[OF h h'] _ qbs_s_finite_join_qbs[OF h h'],of "fst x" X] assms + by(auto simp: pair_qbs_space) + also have "... = ?rhs" + using qbs_s_finite_join_qbs[OF qbs_s_finite.distr_qbs_s_finite[OF qbs_s_finite.strength_qbs_s_finite[OF h(1) _ h(2),of "fst x" X] qbs_s_finite.strength_qbs[OF h(1) _ h(2),of "fst x"] strength_qbs_morphism] qbs_s_finite.distr_qbs[OF qbs_s_finite.strength_qbs_s_finite[OF h(1) _ h(2),of "fst x" X] qbs_s_finite.strength_qbs[OF h(1) _ h(2),of "fst x"] strength_qbs_morphism] pair_qbs_MxI h'(2),of "\r. (fst x, \ r)",simplified comp_def qbs_s_finite.strength_qbs[OF h'' _ fun_cong[OF h'(3)],of "fst x" X]] assms h'(1) + by(auto simp: pair_qbs_space qbs_s_finite_def in_Mx_def) + finally show ?thesis . +qed + +lemma distr_qbs_morphism[qbs]: "distr_qbs X Y \ (X \\<^sub>Q Y) \\<^sub>Q (monadM_qbs X \\<^sub>Q monadM_qbs Y)" +proof - + have [simp]: "distr_qbs X Y = (\f sx. sx \ return_qbs Y \ f)" + by standard+ (auto simp: distr_qbs_def) + show ?thesis + by simp +qed + +lemma + assumes "\ \ qbs_Mx X" "\ \ qbs_Mx Y" + shows return_qbs_pair_Mx: "return_qbs (X \\<^sub>Q Y) (\ r, \ k) = \X \\<^sub>Q Y,map_prod \ \ \ rr.from_real, distr (return borel r \\<^sub>M return borel k) borel rr.to_real\\<^sub>s\<^sub>f\<^sub>i\<^sub>n" + and return_qbs_pair_Mx_prob: "qbs_prob (X \\<^sub>Q Y) (map_prod \ \ \ rr.from_real) (distr (return borel r \\<^sub>M return borel k) borel rr.to_real)" +proof - + note [measurable_cong] = sets_return[of borel] + interpret qp: qbs_prob "X \\<^sub>Q Y" "map_prod \ \ \ rr.from_real" "distr (return borel r \\<^sub>M return borel k) borel rr.to_real" + using qbs_closed1_dest[OF assms(1)] qbs_closed1_dest[OF assms(2)] + by(auto intro!: prob_space.prob_space_distr prob_space_pair simp: comp_def prob_space_return pair_qbs_Mx qbs_prob_def in_Mx_def real_distribution_def real_distribution_axioms_def) + show "qbs_prob (X \\<^sub>Q Y) (map_prod \ \ \ rr.from_real) (distr (return borel r \\<^sub>M return borel k) borel rr.to_real)" + by standard + show "return_qbs (X \\<^sub>Q Y) (\ r, \ k) = \X \\<^sub>Q Y,map_prod \ \ \ rr.from_real, distr (return borel r \\<^sub>M return borel k) borel rr.to_real\\<^sub>s\<^sub>f\<^sub>i\<^sub>n" (is "?lhs = ?rhs") + proof - + have "?lhs = (strength_qbs X Y \ map_prod id (return_qbs Y)) (\ r, \ k)" + by(rule strength_qbs_law3[of "(\ r, \ k)" X Y], insert assms) (auto simp: qbs_Mx_to_X pair_qbs_space) + also have "... = strength_qbs X Y (\ r, \Y, \, return borel k\\<^sub>s\<^sub>f\<^sub>i\<^sub>n)" + using fun_cong[OF return_qbs_comp[OF assms(2)]] by simp + also have "... = ?rhs" + by(rule strength_qbs_ab_r[OF assms(1) _ assms(2)]) (auto intro!: qbs_closed2_dest qbs_s_finite.in_space_monadM s_finite_measure.s_finite_kernel_const[of "return borel k",simplified s_finite_kernel_cong_sets[OF _ sets_return]] prob_space.s_finite_measure_prob simp: qbs_s_finite_def in_Mx_def qbs_s_finite_axioms_def assms(2) prob_space_return) + finally show ?thesis . + qed +qed + +lemma bind_bind_return_distr: + assumes "s_finite_measure \" + and "s_finite_measure \" + and [measurable_cong]: "sets \ = sets borel" "sets \ = sets borel" + shows "\ \\<^sub>k (\r. \ \\<^sub>k (\l. distr (return borel r \\<^sub>M return borel l) borel rr.to_real)) + = distr (\ \\<^sub>M \) borel rr.to_real" + (is "?lhs = ?rhs") +proof - + interpret rd1: s_finite_measure \ by fact + interpret rd2: s_finite_measure \ by fact + have ne: "space \ \ {}" "space \ \ {}" + by(auto simp: sets_eq_imp_space_eq assms(3,4)) + + have "?lhs = \ \\<^sub>k (\r. \ \\<^sub>k (\l. distr (return (borel \\<^sub>M borel) (r,l)) borel rr.to_real))" + by(simp add: pair_measure_return) + also have "... = \ \\<^sub>k (\r. \ \\<^sub>k (\l. distr (return (\ \\<^sub>M \) (r, l)) borel rr.to_real))" + proof - + have "return (borel \\<^sub>M borel) = return (\ \\<^sub>M \)" + by(auto intro!: return_sets_cong sets_pair_measure_cong simp: assms(3,4)) + thus ?thesis by simp + qed + also have "... = \ \\<^sub>k (\r. distr (\ \\<^sub>k (\l. (return (\ \\<^sub>M \) (r, l)))) borel rr.to_real)" + by(auto intro!: bind_kernel_cong_All measure_kernel.distr_bind_kernel[of \ "\ \\<^sub>M \",symmetric] simp: ne measure_kernel_def space_pair_measure) + also have "... = distr (\ \\<^sub>k (\r. \ \\<^sub>k (\l. return (\ \\<^sub>M \) (r, l)))) borel rr.to_real" + by(auto intro!: measure_kernel.distr_bind_kernel[of \ "\ \\<^sub>M \",symmetric] s_finite_kernel.axioms(1) s_finite_kernel.bind_kernel_s_finite_kernel'[where Y=\] s_finite_measure.s_finite_kernel_const[OF assms(2)] prob_kernel.s_finite_kernel_prob_kernel[of "\ \\<^sub>M \"] simp: ne prob_kernel_def') + also have "... = ?rhs" + by(simp add: pair_measure_eq_bind_s_finite[OF assms(1,2),symmetric]) + finally show ?thesis . +qed + +end + +context +begin +interpretation rr : standard_borel_ne "borel \\<^sub>M borel :: (real \ real) measure" + by(auto intro!: pair_standard_borel_ne) + +lemma from_real_rr_qbs_morphism[qbs]: "rr.from_real \ qbs_borel \\<^sub>Q qbs_borel \\<^sub>Q qbs_borel" + by (metis borel_prod qbs_Mx_R qbs_Mx_is_morphisms qbs_borel_prod rr.from_real_measurable) + +end + +context pair_qbs_s_finites +begin + +interpretation rr : standard_borel_ne "borel \\<^sub>M borel :: (real \ real) measure" + by(auto intro!: pair_standard_borel_ne) + +sublocale qbs_s_finite "X \\<^sub>Q Y" "map_prod \ \ \ rr.from_real" "distr (\ \\<^sub>M \) borel rr.to_real" + by(auto simp: qbs_s_finite_def in_Mx_def qbs_s_finite_axioms_def qbs_Mx_is_morphisms pq1.s_finite_measure_axioms pq2.s_finite_measure_axioms intro!: s_finite_measure.s_finite_measure_distr[OF pair_measure_s_finite_measure]) + +lemma qbs_bind_bind_return_qp: + "\Y,\,\\\<^sub>s\<^sub>f\<^sub>i\<^sub>n \ (\y. \X,\,\\\<^sub>s\<^sub>f\<^sub>i\<^sub>n \ (\x. return_qbs (X \\<^sub>Q Y) (x,y))) = \X \\<^sub>Q Y, map_prod \ \ \ rr.from_real, distr (\ \\<^sub>M \) borel rr.to_real\\<^sub>s\<^sub>f\<^sub>i\<^sub>n" (is "?lhs = ?rhs") +proof - + have "?lhs = \X \\<^sub>Q Y, map_prod \ \ \ rr.from_real, \ \\<^sub>k (\l. \ \\<^sub>k (\r. distr (return borel r \\<^sub>M return borel l) borel rr.to_real))\\<^sub>s\<^sub>f\<^sub>i\<^sub>n" + by(auto intro!: pq2.bind_qbs[OF refl] s_finite_kernel.bind_kernel_s_finite_kernel'[where Y=\] s_finite_measure.s_finite_kernel_const s_finite_kernel.distr_s_finite_kernel[where Y="borel \\<^sub>M borel"] prob_kernel.s_finite_kernel_prob_kernel[of "borel \\<^sub>M \"] simp: sets_eq_imp_space_eq[OF pq1.mu_sets] pq1.s_finite_measure_axioms split_beta' pair_measure_return[of _ "snd _"] prob_kernel_def') + (auto intro!: pq1.bind_qbs prob_kernel.s_finite_kernel_prob_kernel simp: comp_def return_qbs_pair_Mx qbs_Mx_is_morphisms prob_kernel_def') + also have "... = ?rhs" + proof - + have "\ \\<^sub>k (\l. \ \\<^sub>k (\r. distr (return borel r \\<^sub>M return borel l) borel rr.to_real)) = distr (\ \\<^sub>M \) borel rr.to_real" + by(auto simp: bind_bind_return_distr[OF pq1.s_finite_measure_axioms pq2.s_finite_measure_axioms pq1.mu_sets pq2.mu_sets,symmetric] pq1.s_finite_measure_axioms pq2.s_finite_measure_axioms prob_kernel_def' intro!: bind_kernel_rotate[where Z=borel] prob_kernel.s_finite_kernel_prob_kernel) + thus ?thesis by simp + qed + finally show ?thesis . +qed + +lemma qbs_bind_bind_return_pq: + "\X,\,\\\<^sub>s\<^sub>f\<^sub>i\<^sub>n \ (\x. \Y,\,\\\<^sub>s\<^sub>f\<^sub>i\<^sub>n \ (\y. return_qbs (X \\<^sub>Q Y) (x,y))) = \X \\<^sub>Q Y, map_prod \ \ \ rr.from_real, distr (\ \\<^sub>M \) borel rr.to_real\\<^sub>s\<^sub>f\<^sub>i\<^sub>n" (is "?lhs = ?rhs") +proof - + have "?lhs = \X \\<^sub>Q Y, map_prod \ \ \ rr.from_real, \ \\<^sub>k (\r. \ \\<^sub>k (\l. distr (return borel r \\<^sub>M return borel l) borel rr.to_real))\\<^sub>s\<^sub>f\<^sub>i\<^sub>n" + by(auto intro!: pq1.bind_qbs[OF refl]s_finite_kernel.bind_kernel_s_finite_kernel'[where Y=\] s_finite_measure.s_finite_kernel_const s_finite_kernel.distr_s_finite_kernel[where Y="borel \\<^sub>M borel"] prob_kernel.s_finite_kernel_prob_kernel[of "borel \\<^sub>M \"] simp: sets_eq_imp_space_eq[OF pq2.mu_sets] pq2.s_finite_measure_axioms split_beta' pair_measure_return[of _ "fst _"] prob_kernel_def') + (auto intro!: pq2.bind_qbs prob_kernel.s_finite_kernel_prob_kernel simp: comp_def return_qbs_pair_Mx qbs_Mx_is_morphisms prob_kernel_def') + also have "... = ?rhs" + by(simp add: bind_bind_return_distr[OF pq1.s_finite_measure_axioms pq2.s_finite_measure_axioms pq1.mu_sets pq2.mu_sets]) + finally show ?thesis . +qed + +end + +lemma bind_qbs_return_rotate: + assumes "p \ qbs_space (monadM_qbs X)" + and "q \ qbs_space (monadM_qbs Y)" + shows "q \ (\y. p \ (\x. return_qbs (X \\<^sub>Q Y) (x,y))) = p \ (\x. q \ (\y. return_qbs (X \\<^sub>Q Y) (x,y)))" +proof - + from rep_qbs_space_monadM[OF assms(1)] rep_qbs_space_monadM[OF assms(2)] + obtain \ \ \ \ where h: "p = \X, \, \\\<^sub>s\<^sub>f\<^sub>i\<^sub>n" "q = \Y, \, \\\<^sub>s\<^sub>f\<^sub>i\<^sub>n" "qbs_s_finite X \ \" "qbs_s_finite Y \ \" + by metis + then interpret pair_qbs_s_finites X \ \ Y \ \ + by(simp add: pair_qbs_s_finites_def) + show ?thesis + by(simp add: h(1,2) qbs_bind_bind_return_pq qbs_bind_bind_return_qp) +qed + +lemma qbs_bind_bind_return1: + assumes [qbs]: "f \ X \\<^sub>Q Y \\<^sub>Q monadM_qbs Z" + "p \ qbs_space (monadM_qbs X)" + "q \ qbs_space (monadM_qbs Y)" + shows "q \ (\y. p \ (\x. f (x,y))) = (q \ (\y. p \ (\x. return_qbs (X \\<^sub>Q Y) (x,y)))) \ f" + (is "?lhs = ?rhs") +proof - + have "?lhs = q \ (\y. p \ (\x. return_qbs (X \\<^sub>Q Y) (x,y) \ f))" + by(auto intro!: bind_qbs_cong[OF assms(3),where Y=Z] bind_qbs_cong[OF assms(2),where Y=Z] simp: bind_qbs_return[OF assms(1),simplified pair_qbs_space]) + also have "... = q \ (\y. (p \ (\x. return_qbs (X \\<^sub>Q Y) (x,y))) \ f)" + by(auto intro!: bind_qbs_cong[OF assms(3),where Y=Z] bind_qbs_assoc[OF assms(2) _ assms(1)] simp: ) + also have "... = ?rhs" + by(simp add: bind_qbs_assoc[OF assms(3) _ assms(1)]) + finally show ?thesis . +qed + +lemma qbs_bind_bind_return2: + assumes [qbs]:"f \ X \\<^sub>Q Y \\<^sub>Q monadM_qbs Z" + "p \ qbs_space (monadM_qbs X)" "q \ qbs_space (monadM_qbs Y)" + shows "p \ (\x. q \ (\y. f (x,y))) = (p \ (\x. q \ (\y. return_qbs (X \\<^sub>Q Y) (x,y)))) \ f" + (is "?lhs = ?rhs") +proof - + have "?lhs = p \ (\x. q \ (\y. return_qbs (X \\<^sub>Q Y) (x,y) \ f))" + by(auto intro!: bind_qbs_cong[OF assms(2),where Y=Z] bind_qbs_cong[OF assms(3),where Y=Z] simp: bind_qbs_return[OF assms(1),simplified pair_qbs_space]) + also have "... = p \ (\x. (q \ (\y. return_qbs (X \\<^sub>Q Y) (x,y))) \ f)" + by(auto intro!: bind_qbs_cong[OF assms(2),where Y=Z] bind_qbs_assoc[OF assms(3) _ assms(1)]) + also have "... = ?rhs" + by(simp add: bind_qbs_assoc[OF assms(2) _ assms(1)]) + finally show ?thesis . +qed + +corollary bind_qbs_rotate: + assumes "f \ X \\<^sub>Q Y \\<^sub>Q monadM_qbs Z" + "p \ qbs_space (monadM_qbs X)" + and "q \ qbs_space (monadM_qbs Y)" + shows "q \ (\y. p \ (\x. f (x,y))) = p \ (\x. q \ (\y. f (x,y)))" + by(simp add: qbs_bind_bind_return1[OF assms] qbs_bind_bind_return2[OF assms] bind_qbs_return_rotate assms) + +context pair_qbs_s_finites +begin + +interpretation rr : standard_borel_ne "borel \\<^sub>M borel :: (real \ real) measure" + by(auto intro!: pair_standard_borel_ne) + +lemma + assumes [qbs]:"f \ X \\<^sub>Q Y \\<^sub>Q Z" + shows qbs_bind_bind_return:"\X,\,\\\<^sub>s\<^sub>f\<^sub>i\<^sub>n \ (\x. \Y,\,\\\<^sub>s\<^sub>f\<^sub>i\<^sub>n \ (\y. return_qbs Z (f (x,y)))) = \Z, f \ (map_prod \ \ \ rr.from_real), distr (\ \\<^sub>M \) borel rr.to_real\\<^sub>s\<^sub>f\<^sub>i\<^sub>n" (is "?lhs = ?rhs") + and qbs_bind_bind_return_s_finite: "qbs_s_finite Z (f \ (map_prod \ \ \ rr.from_real)) (distr (\ \\<^sub>M \) borel rr.to_real)" +proof - + show "qbs_s_finite Z (f \ (map_prod \ \ \ rr.from_real)) (distr (\ \\<^sub>M \) borel rr.to_real)" + using qbs_s_finite_axioms by(auto simp: qbs_s_finite_def in_Mx_def qbs_Mx_is_morphisms) + have "?lhs = \X,\,\\\<^sub>s\<^sub>f\<^sub>i\<^sub>n \ (\x. \Y,\,\\\<^sub>s\<^sub>f\<^sub>i\<^sub>n \ (\y. return_qbs (X \\<^sub>Q Y) (x,y))) \ return_qbs Z \ f" + by(auto simp: comp_def intro!: qbs_bind_bind_return2[of "return_qbs Z \ f" _ _ Z,simplified comp_def]) + also have "... = \X \\<^sub>Q Y, map_prod \ \ \ rr.from_real, distr (\ \\<^sub>M \) borel rr.to_real\\<^sub>s\<^sub>f\<^sub>i\<^sub>n \ return_qbs Z \ f" + by(simp add: qbs_bind_bind_return_pq) + also have "... = ?rhs" + by(rule distr_qbs[OF refl assms,simplified distr_qbs_def]) + finally show "?lhs = ?rhs" . +qed + +end + +subsubsection \The Probability Monad\ + +definition "monadP_qbs X \ sub_qbs (monadM_qbs X) {s. prob_space (qbs_l s)}" + +lemma + shows qbs_space_monadPM: "s \ qbs_space (monadP_qbs X) \ s \ qbs_space (monadM_qbs X)" + and qbs_Mx_monadPM: "f \ qbs_Mx (monadP_qbs X) \ f \ qbs_Mx (monadM_qbs X)" + by(simp_all add: monadP_qbs_def sub_qbs_space sub_qbs_Mx) + +lemma monadP_qbs_space: "qbs_space (monadP_qbs X) = {s. qbs_space_of s = X \ prob_space (qbs_l s)}" + by(auto simp: monadP_qbs_def sub_qbs_space monadM_qbs_space) + +lemma rep_qbs_space_monadP: + assumes "s \ qbs_space (monadP_qbs X)" + obtains \ \ where "s = \X, \, \\\<^sub>s\<^sub>f\<^sub>i\<^sub>n" "qbs_prob X \ \" +proof - + obtain \ \ where h:"s = \X, \, \\\<^sub>s\<^sub>f\<^sub>i\<^sub>n" "qbs_s_finite X \ \" + using assms rep_qbs_space_monadM[of s X] by(auto simp: monadP_qbs_def sub_qbs_space) + interpret qbs_s_finite X \ \ by fact + have "prob_space \" + by(rule prob_space_distrD[of \ _ "qbs_to_measure X"]) (insert assms, auto simp: qbs_l[symmetric] h(1)[symmetric] monadP_qbs_space) + thus ?thesis + by (simp add: h(1) in_Mx_axioms mu_sets qbs_prob.intro real_distribution_axioms_def real_distribution_def that) +qed + +lemma qbs_l_prob_space: + "s \ qbs_space (monadP_qbs X) \ prob_space (qbs_l s)" + by(auto simp: monadP_qbs_space) + +lemma monadP_qbs_empty_iff: + "(qbs_space X = {}) = (qbs_space (monadP_qbs X) = {})" +proof + show "qbs_space X = {} \ qbs_space (monadP_qbs X) = {}" + using qbs_s_space_of_not_empty by(auto simp add: monadP_qbs_space) +next + assume "qbs_space (monadP_qbs X) = {}" + then have h:"\s. qbs_space_of s = X \ \ prob_space (qbs_l s)" + by(simp add: monadP_qbs_space) + show "qbs_space X = {}" + proof(rule ccontr) + assume "qbs_space X \ {}" + then obtain a where a:"a \ qbs_Mx X" by (auto simp: qbs_empty_equiv) + then interpret qbs_prob X a "return borel 0" + by(auto simp: qbs_prob_def in_Mx_def real_distribution_axioms_def real_distribution_def prob_space_return) + have "qbs_space_of \X, a, return borel 0\\<^sub>s\<^sub>f\<^sub>i\<^sub>n = X" "prob_space (qbs_l \X, a, return borel 0\\<^sub>s\<^sub>f\<^sub>i\<^sub>n)" + by(auto simp: qbs_l intro!: prob_space_distr) + with h show False by simp + qed +qed + +lemma in_space_monadP_qbs_pred: "qbs_pred (monadM_qbs X) (\s. s \ monadP_qbs X)" + by(rule qbs_morphism_cong'[where f="\s. prob_space (qbs_l s)"],auto simp: qbs_l_prob_pred) + (auto simp: monadP_qbs_def sub_qbs_space) + +lemma(in qbs_prob) in_space_monadP[qbs]: "\X, \, \\\<^sub>s\<^sub>f\<^sub>i\<^sub>n \ qbs_space (monadP_qbs X)" + by(auto simp: monadP_qbs_space qbs_l prob_space_distr) + +lemma qbs_morphism_monadPD: "f \ X \\<^sub>Q monadP_qbs Y \ f \ X \\<^sub>Q monadM_qbs Y" + unfolding monadP_qbs_def by(rule qbs_morphism_subD) + +lemma qbs_morphism_monadPD': "f \ monadM_qbs X \\<^sub>Q Y \ f \ monadP_qbs X \\<^sub>Q Y" + unfolding monadP_qbs_def by(rule qbs_morphism_subI2) + +lemma qbs_morphism_monadPI: + assumes "\x. x \ qbs_space X \ prob_space (qbs_l (f x))" "f \ X \\<^sub>Q monadM_qbs Y" + shows "f \ X \\<^sub>Q monadP_qbs Y" + using assms by(auto simp: monadP_qbs_def intro!:qbs_morphism_subI1) + +lemma qbs_morphism_monadPI': + assumes "\x. x \ qbs_space X \ f x \ qbs_space (monadP_qbs Y)" "f \ X \\<^sub>Q monadM_qbs Y" + shows "f \ X \\<^sub>Q monadP_qbs Y" + using assms by(auto intro!: qbs_morphism_monadPI simp: monadP_qbs_space) + +lemma qbs_morphism_monadPI'': + assumes "f \ monadM_qbs X \\<^sub>Q monadM_qbs Y" "\s. s \ qbs_space (monadP_qbs X) \ f s \ qbs_space (monadP_qbs Y)" + shows "f \ monadP_qbs X \\<^sub>Q monadP_qbs Y" +proof - + have 1:"\X. monadP_qbs X = sub_qbs (monadM_qbs X) {s. qbs_space_of s = X \ prob_space (qbs_l s)}" (is "\X. ?l X = ?r X") + proof - + fix X + have "?l X = sub_qbs (sub_qbs (monadM_qbs X) (qbs_space (monadM_qbs X))) {s. prob_space (qbs_l s)}" + by(simp add: sub_qbs_ident monadP_qbs_def) + also have "... = ?r X" + by(auto simp: sub_qbs_sub_qbs monadM_qbs_space Collect_conj_eq) + finally show "?l X = ?r X" . + qed + show ?thesis + unfolding 1 using assms(2) by(auto intro!: qbs_morphism_subsubI[OF assms(1),of " {s. qbs_space_of s = X \ prob_space (qbs_l s)}" " {s. qbs_space_of s = Y \ prob_space (qbs_l s)}"] simp: 1 sub_qbs_space monadM_qbs_space) +qed + +lemma monadP_qbs_Mx: "qbs_Mx (monadP_qbs X) = {\r. \X, \, k r\\<^sub>s\<^sub>f\<^sub>i\<^sub>n |\ k. \ \ qbs_Mx X \ k \ borel \\<^sub>M prob_algebra borel}" +proof safe + fix \ + assume h:"\ \ qbs_Mx (monadP_qbs X)" + then obtain \ k where h1: + "\ = (\r. \X, \, k r\\<^sub>s\<^sub>f\<^sub>i\<^sub>n)" "\ \ qbs_Mx X" "s_finite_kernel borel borel k" "\r. qbs_s_finite X \ (k r)" + using rep_qbs_Mx_monadM[of \ X] by(simp add: monadP_qbs_def sub_qbs_Mx) metis + interpret s_finite_kernel borel borel k by fact + have "\ \ UNIV \ {s. qbs_space_of s = X \ prob_space (qbs_l s)}" + using h qbs_Mx_to_X[OF h] by(auto simp: monadP_qbs_def sub_qbs_Mx monadM_qbs_space sub_qbs_space) + hence "\r. prob_space (k r)" + using h1(2) by(auto simp add: h1(1) Pi_iff qbs_s_finite.qbs_l[OF h1(4)] intro!: prob_space_distrD[of \ _ "qbs_to_measure X"]) + hence "prob_kernel borel borel k" + by(auto simp: prob_kernel_def prob_kernel_axioms_def measure_kernel_axioms) + with h1(1,2) show "\\ k. \ = (\r. \X, \, k r\\<^sub>s\<^sub>f\<^sub>i\<^sub>n) \ \ \ qbs_Mx X \ k \ borel \\<^sub>M prob_algebra borel" + by(auto intro!: exI[where x=\] exI[where x=k] simp: prob_kernel_def') +next + fix \ and k :: "real \ real measure" + assume h:"\ \ qbs_Mx X" "k \ borel \\<^sub>M prob_algebra borel" + then interpret pk: prob_kernel borel borel k + by(simp add: prob_kernel_def'[symmetric]) + have qp: "qbs_prob X \ (k r)" for r + using h by(auto simp: qbs_prob_def in_Mx_def pk.kernel_sets pk.prob_spaces real_distribution_axioms_def real_distribution_def) + show "(\r. \X, \, k r\\<^sub>s\<^sub>f\<^sub>i\<^sub>n) \ qbs_Mx (monadP_qbs X)" + using h(1) qp by(auto simp: monadP_qbs_def sub_qbs_Mx monadM_qbs_space qbs_s_finite.qbs_l[OF qbs_prob.qbs_s_finite[OF qp]] qbs_s_finite.qbs_space_of[OF qbs_prob.qbs_s_finite[OF qp]] monadM_qbs_Mx qbs_prob_def real_distribution_def intro!: exI[where x=\] exI[where x=k] h pk.s_finite_kernel_axioms prob_space.prob_space_distr) +qed + +lemma rep_qbs_Mx_monadP: + assumes "\ \ qbs_Mx (monadP_qbs X)" + obtains \ k where "\ = (\r. \X, \, k r\\<^sub>s\<^sub>f\<^sub>i\<^sub>n)" "\ \ qbs_Mx X" "k \ borel \\<^sub>M prob_algebra borel" "\r. qbs_prob X \ (k r)" +proof - + have "\\ r k. \ \ qbs_Mx X \ k \ borel \\<^sub>M prob_algebra borel \ qbs_prob X \ (k r)" + by(auto simp: qbs_prob_def in_Mx_def real_distribution_def real_distribution_axioms_def prob_kernel_def'[symmetric] prob_kernel_def prob_kernel_axioms_def measure_kernel_def) + thus ?thesis + using assms that by(fastforce simp: monadP_qbs_Mx) +qed + +lemma qbs_l_monadP_le1:"s \ qbs_space (monadP_qbs X) \ qbs_l s A \ 1" + by(auto simp: monadP_qbs_space intro!: prob_space.emeasure_le_1) + +lemma qbs_l_inj_P: "inj_on qbs_l (qbs_space (monadP_qbs X))" + by(auto intro!: inj_on_subset[OF qbs_l_inj] simp: monadP_qbs_def sub_qbs_space) + +lemma qbs_l_measurable_prob[measurable]:"qbs_l \ qbs_to_measure (monadP_qbs X) \\<^sub>M prob_algebra (qbs_to_measure X)" +proof(rule qbs_morphism_dest[OF qbs_morphismI]) + fix \ + assume "\ \ qbs_Mx (monadP_qbs X)" + from rep_qbs_Mx_monadP[OF this] obtain \ k where h[measurable]: + "\ = (\r. \X, \, k r\\<^sub>s\<^sub>f\<^sub>i\<^sub>n)" "\ \ qbs_Mx X" "k \ borel \\<^sub>M prob_algebra borel" "\r. qbs_prob X \ (k r)" + by metis + show "qbs_l \ \ \ qbs_Mx (measure_to_qbs (prob_algebra (qbs_to_measure X)))" + by(auto simp: qbs_Mx_R comp_def h(1) qbs_s_finite.qbs_l[OF qbs_prob.qbs_s_finite[OF h(4)]]) +qed + +lemma return_qbs_morphismP: "return_qbs X \ X \\<^sub>Q monadP_qbs X" +proof(rule qbs_morphismI) + interpret rr : real_distribution "return borel 0" + by(simp add: real_distribution_def real_distribution_axioms_def prob_space_return) + fix \ + assume h:"\ \ qbs_Mx X" + then have 1:"return_qbs X \ \ = (\r. \X, \, return borel r\\<^sub>s\<^sub>f\<^sub>i\<^sub>n)" + by(rule return_qbs_comp) + show "return_qbs X \ \ \ qbs_Mx (monadP_qbs X)" + by(auto simp: 1 monadP_qbs_Mx h intro!: exI[where x=\] exI[where x="return borel"]) +qed + +lemma(in qbs_prob) + assumes "s = \X, \, \\\<^sub>s\<^sub>f\<^sub>i\<^sub>n" + "f \ X \\<^sub>Q monadP_qbs Y" + "\ \ qbs_Mx Y" + and g[measurable]:"g \ borel \\<^sub>M prob_algebra borel" + and "(f \ \) = (\r. \Y, \, g r\\<^sub>s\<^sub>f\<^sub>i\<^sub>n)" + shows bind_qbs_prob:"qbs_prob Y \ (\ \ g)" + and bind_qbs': "s \ f = \Y, \, \ \ g\\<^sub>s\<^sub>f\<^sub>i\<^sub>n" +proof - + interpret prob_kernel borel borel g + using assms(4) by(simp add: prob_kernel_def') + have "prob_space (\ \ g)" + by(auto intro!: prob_space_bind'[OF _ g] simp: space_prob_algebra prob_space_axioms) + thus "qbs_prob Y \ (\ \ g)" "s \ f = \Y, \, \ \ g\\<^sub>s\<^sub>f\<^sub>i\<^sub>n" + using qbs_s_finite.qbs_probI[OF bind_qbs_s_finite[OF assms(1) qbs_morphism_monadPD[OF assms(2)] assms(3) s_finite_kernel_axioms assms(5)]] + by(simp_all add: bind_qbs[OF assms(1) qbs_morphism_monadPD[OF assms(2)] assms(3) s_finite_kernel_axioms assms(5)] bind_kernel_bind[of g \ borel]) +qed + +lemma bind_qbs_morphism'P: + assumes "f \ X \\<^sub>Q monadP_qbs Y" + shows "(\x. x \ f) \ monadP_qbs X \\<^sub>Q monadP_qbs Y" +proof(safe intro!: qbs_morphism_monadPI') + fix x + assume "x \ qbs_space (monadP_qbs X)" + from rep_qbs_space_monadP[OF this] obtain \ \ where h:"x = \X, \, \\\<^sub>s\<^sub>f\<^sub>i\<^sub>n" "qbs_prob X \ \" + by metis + then interpret qbs_prob X \ \ by simp + from rep_qbs_Mx_monadP[OF qbs_morphism_Mx[OF assms in_Mx]] obtain \ g where h'[measurable]: + "f \ \ = (\r. \Y, \, g r\\<^sub>s\<^sub>f\<^sub>i\<^sub>n)" "\ \ qbs_Mx Y" "g \ borel \\<^sub>M prob_algebra borel" by metis + show "x \ f \ qbs_space (monadP_qbs Y)" + using sets_bind[of \ g] measurable_space[OF h'(3),simplified space_prob_algebra] + by(auto simp: qbs_prob.bind_qbs'[OF h(2,1) assms h'(2,3,1)] qbs_prob_def in_Mx_def h'(2) real_distribution_def real_distribution_axioms_def intro!: qbs_prob.in_space_monadP prob_space_bind[where S=borel] measurable_prob_algebraD) +qed(auto intro!: qbs_morphism_monadPD' bind_qbs_morphism'[OF qbs_morphism_monadPD[OF assms]]) + +lemma distr_qbs_morphismP': + assumes "f \ X \\<^sub>Q Y" + shows "distr_qbs X Y f \ monadP_qbs X \\<^sub>Q monadP_qbs Y" + unfolding distr_qbs_def + by(rule bind_qbs_morphism'P[OF qbs_morphism_comp[OF assms return_qbs_morphismP]]) + +lemma join_qbs_morphismP: "join_qbs \ monadP_qbs (monadP_qbs X) \\<^sub>Q monadP_qbs X" + by(simp add: join_qbs_def bind_qbs_morphism'P[OF qbs_morphism_ident]) + +lemma + assumes "qbs_prob (monadP_qbs X) \ \" + "ssx = \monadP_qbs X, \, \\\<^sub>s\<^sub>f\<^sub>i\<^sub>n" + "\ \ qbs_Mx X" + "g \ borel \\<^sub>M prob_algebra borel" + and "\ =(\r. \X, \, g r\\<^sub>s\<^sub>f\<^sub>i\<^sub>n)" + shows qbs_prob_join_qbs_s_finite: "qbs_prob X \ (\ \ g)" + and qbs_prob_join_qbs: "join_qbs ssx = \X, \, \ \ g\\<^sub>s\<^sub>f\<^sub>i\<^sub>n" + using qbs_prob.bind_qbs'[OF assms(1,2) qbs_morphism_ident assms(3,4)] qbs_prob.bind_qbs_prob[OF assms(1,2) qbs_morphism_ident assms(3,4)] + by(auto simp: assms(5) join_qbs_def) + +context +begin + +interpretation rr : standard_borel_ne "borel \\<^sub>M borel :: (real \ real) measure" + by(auto intro!: pair_standard_borel_ne) + +lemma strength_qbs_ab_r_prob: + assumes "\ \ qbs_Mx X" + "\ \ qbs_Mx (monadP_qbs Y)" + "\ \ qbs_Mx Y" + and [measurable]:"g \ borel \\<^sub>M prob_algebra borel" + and "\ = (\r. \Y, \, g r\\<^sub>s\<^sub>f\<^sub>i\<^sub>n)" + shows "qbs_prob (X \\<^sub>Q Y) (map_prod \ \ \ rr.from_real) (distr (return borel r \\<^sub>M g r) borel rr.to_real)" + using measurable_space[OF assms(4),of r] sets_return[of borel r] + by(auto intro!: qbs_s_finite.qbs_probI strength_qbs_ab_r_s_finite[OF assms(1) qbs_Mx_monadPM[OF assms(2)] assms(3) prob_kernel.s_finite_kernel_prob_kernel assms(5),simplified prob_kernel_def',OF assms(4)] prob_space.prob_space_distr prob_space_pair prob_space_return simp: space_prob_algebra simp del: sets_return) + +lemma strength_qbs_morphismP: "strength_qbs X Y \ X \\<^sub>Q monadP_qbs Y \\<^sub>Q monadP_qbs (X \\<^sub>Q Y)" +proof(rule pair_qbs_morphismI) + fix \ \ + assume h:"\ \ qbs_Mx X" + "\ \ qbs_Mx (monadP_qbs Y)" + from rep_qbs_Mx_monadP[OF this(2)] obtain \ g where hb[measurable]: + "\ = (\r. \Y, \, g r\\<^sub>s\<^sub>f\<^sub>i\<^sub>n)" "\ \ qbs_Mx Y" "g \ borel \\<^sub>M prob_algebra borel" + by metis + show "(\r. strength_qbs X Y (\ r, \ r)) \ qbs_Mx (monadP_qbs (X \\<^sub>Q Y))" + using strength_qbs_ab_r_prob[OF h hb(2,3,1)] strength_qbs_ab_r[OF h(1) qbs_Mx_monadPM[OF h(2)] hb(2) prob_kernel.s_finite_kernel_prob_kernel hb(1),simplified prob_kernel_def',OF hb(3)] + by(auto simp: monadP_qbs_Mx qbs_prob_def in_Mx_def intro!: exI[where x="map_prod \ \ \ rr.from_real"] exI[where x="\r. distr (return borel r \\<^sub>M g r) borel rr.to_real"]) +qed + +end + +lemma bind_qbs_morphismP: "(\) \ monadP_qbs X \\<^sub>Q (X \\<^sub>Q monadP_qbs Y) \\<^sub>Q monadP_qbs Y" +proof - + { + fix f s + assume h:"f \ X \\<^sub>Q monadP_qbs Y" "s \ qbs_space (monadP_qbs X)" + from rep_qbs_space_monadP[OF this(2)] obtain \ \ where h': + "s = \X, \, \\\<^sub>s\<^sub>f\<^sub>i\<^sub>n" "qbs_prob X \ \" by metis + then interpret qbs_prob X \ \ by simp + from rep_qbs_Mx_monadP[OF qbs_morphism_Mx[OF h(1) in_Mx]] obtain \ g + where hb[measurable]:"f \ \ = (\r. \Y, \, g r\\<^sub>s\<^sub>f\<^sub>i\<^sub>n)" "\ \ qbs_Mx Y" "g \ borel \\<^sub>M prob_algebra borel" by metis + have "join_qbs (distr_qbs ((X \\<^sub>Q monadP_qbs Y) \\<^sub>Q X) (monadP_qbs Y) (\fx. fst fx (snd fx)) (strength_qbs (X \\<^sub>Q monadP_qbs Y) X (f, s))) = s \ f" + using qbs_prob_join_qbs[OF qbs_prob.distr_qbs_prob[OF strength_qbs_prob[of f "X \\<^sub>Q monadP_qbs Y",OF h(1) h'(1)] strength_qbs[of f "X \\<^sub>Q monadP_qbs Y",OF h(1) h'(1)] qbs_morphism_eval] qbs_s_finite.distr_qbs[OF strength_qbs_s_finite[of f "X \\<^sub>Q monadP_qbs Y",OF h(1) h'(1)] strength_qbs[of f "X \\<^sub>Q monadP_qbs Y",OF h(1) h'(1)] qbs_morphism_eval] hb(2,3)] hb(1) + by(simp add: bind_qbs[OF h'(1) qbs_morphism_monadPD[OF h(1)] hb(2) prob_kernel.s_finite_kernel_prob_kernel hb(1),simplified prob_kernel_def',OF hb(3)] comp_def bind_kernel_bind[of g \ borel,OF measurable_prob_algebraD]) + } + thus ?thesis + by(auto intro!: arg_swap_morphism[OF curry_preserves_morphisms [OF qbs_morphism_cong'[of _ "join_qbs \ (distr_qbs (exp_qbs X (monadP_qbs Y) \\<^sub>Q X) (monadP_qbs Y) (\fx. (fst fx) (snd fx))) \ (strength_qbs (exp_qbs X (monadP_qbs Y)) X)"]]] qbs_morphism_comp distr_qbs_morphismP' strength_qbs_morphismP join_qbs_morphismP qbs_morphism_eval simp: pair_qbs_space) +qed + +corollary strength_qbs_law1P: + assumes "x \ qbs_space (unit_quasi_borel \\<^sub>Q monadP_qbs X)" + shows "snd x = (distr_qbs (unit_quasi_borel \\<^sub>Q X) X snd \ strength_qbs unit_quasi_borel X) x" + by(rule strength_qbs_law1, insert assms) (auto simp: pair_qbs_space qbs_space_monadPM) + +corollary strength_qbs_law2P: + assumes "x \ qbs_space ((X \\<^sub>Q Y) \\<^sub>Q monadP_qbs Z)" + shows "(strength_qbs X (Y \\<^sub>Q Z) \ (map_prod id (strength_qbs Y Z)) \ (\((x,y),z). (x,(y,z)))) x = + (distr_qbs ((X \\<^sub>Q Y) \\<^sub>Q Z) (X \\<^sub>Q (Y \\<^sub>Q Z)) (\((x,y),z). (x,(y,z))) \ strength_qbs (X \\<^sub>Q Y) Z) x" + by(rule strength_qbs_law2, insert assms) (auto simp: pair_qbs_space qbs_space_monadPM) + +lemma strength_qbs_law4P: + assumes "x \ qbs_space (X \\<^sub>Q monadP_qbs (monadP_qbs Y))" + shows "(strength_qbs X Y \ map_prod id join_qbs) x = (join_qbs \ distr_qbs (X \\<^sub>Q monadP_qbs Y) (monadP_qbs (X \\<^sub>Q Y)) (strength_qbs X Y) \ strength_qbs X (monadP_qbs Y)) x" + (is "?lhs = ?rhs") +proof - + from assms rep_qbs_space_monadP[of "snd x" "monadP_qbs Y"] obtain \ \ + where h:"qbs_prob (monadP_qbs Y) \ \" "snd x = \monadP_qbs Y, \, \\\<^sub>s\<^sub>f\<^sub>i\<^sub>n" + by (auto simp: pair_qbs_space) metis + then interpret qp: qbs_prob "monadP_qbs Y" \ \ by simp + from rep_qbs_Mx_monadP[OF qp.in_Mx] obtain \ g + where h': "\ \ qbs_Mx Y" "g \ borel \\<^sub>M prob_algebra borel" "\ = (\r. \Y, \, g r\\<^sub>s\<^sub>f\<^sub>i\<^sub>n)" + and h'': "\r. qbs_prob Y \ (g r)" + by metis + have "?lhs = \X \\<^sub>Q Y, \r. (fst x, \ r), \ \ g\\<^sub>s\<^sub>f\<^sub>i\<^sub>n" + using qbs_s_finite.strength_qbs[OF qbs_prob.qbs_s_finite[OF qbs_prob_join_qbs_s_finite[OF h h']] _ qbs_prob_join_qbs[OF h h'],of "fst x" X] assms + by (auto simp: pair_qbs_space) + also have "... = ?rhs" + using qbs_prob_join_qbs[OF qbs_prob.distr_qbs_prob[OF qp.strength_qbs_prob[OF _ h(2),of "fst x" X] qp.strength_qbs[OF _ h(2)] strength_qbs_morphismP] qbs_s_finite.distr_qbs[OF qp.strength_qbs_s_finite[OF _ h(2),of "fst x" X] qp.strength_qbs[OF _ h(2)] strength_qbs_morphismP] pair_qbs_MxI h'(2),of "\r. (fst x, \ r)",simplified comp_def qbs_s_finite.strength_qbs[OF qbs_prob.qbs_s_finite[OF h''] _ fun_cong[OF h'(3)]]] assms + by(auto simp: pair_qbs_space h') + finally show ?thesis . +qed + +lemma distr_qbs_morphismP: "distr_qbs X Y \ X \\<^sub>Q Y \\<^sub>Q monadP_qbs X \\<^sub>Q monadP_qbs Y" +proof - + note [qbs] = bind_qbs_morphismP return_qbs_morphismP + have [simp]: "distr_qbs X Y = (\f sx. sx \ return_qbs Y \ f)" + by standard+ (auto simp: distr_qbs_def) + show ?thesis + by simp +qed + +lemma bind_qbs_return_rotateP: + assumes "p \ qbs_space (monadP_qbs X)" + and "q \ qbs_space (monadP_qbs Y)" + shows "q \ (\y. p \ (\x. return_qbs (X \\<^sub>Q Y) (x,y))) = p \ (\x. q \ (\y. return_qbs (X \\<^sub>Q Y) (x,y)))" + by(auto intro!: bind_qbs_return_rotate qbs_space_monadPM assms) + +lemma qbs_bind_bind_return1P: + assumes "f \ X \\<^sub>Q Y \\<^sub>Q monadP_qbs Z" + "p \ qbs_space (monadP_qbs X)" + "q \ qbs_space (monadP_qbs Y)" + shows "q \ (\y. p \ (\x. f (x,y))) = (q \ (\y. p \ (\x. return_qbs (X \\<^sub>Q Y) (x,y)))) \ f" + by(auto intro!: qbs_bind_bind_return1 assms qbs_space_monadPM qbs_morphism_monadPD) + +corollary qbs_bind_bind_return1P': + assumes [qbs]:"f \ qbs_space (X \\<^sub>Q Y \\<^sub>Q monadP_qbs Z)" + "p \ qbs_space (monadP_qbs X)" + "q \ qbs_space (monadP_qbs Y)" + shows "q \ (\y. p \ (\x. f x y)) = (q \ (\y. p \ (\x. return_qbs (X \\<^sub>Q Y) (x,y)))) \ (case_prod f)" + by(auto intro!: qbs_bind_bind_return1P[where f="case_prod f" and Z=Z,simplified]) + +lemma qbs_bind_bind_return2P: + assumes "f \ X \\<^sub>Q Y \\<^sub>Q monadP_qbs Z" + "p \ qbs_space (monadP_qbs X)" "q \ qbs_space (monadP_qbs Y)" + shows "p \ (\x. q \ (\y. f (x,y))) = (p \ (\x. q \ (\y. return_qbs (X \\<^sub>Q Y) (x,y)))) \ f" + by(auto intro!: qbs_bind_bind_return2 assms qbs_space_monadPM qbs_morphism_monadPD) + +corollary qbs_bind_bind_return2P': + assumes [qbs]:"f \ qbs_space (X \\<^sub>Q Y \\<^sub>Q monadP_qbs Z)" + "p \ qbs_space (monadP_qbs X)" + "q \ qbs_space (monadP_qbs Y)" + shows "p \ (\x. q \ (\y. f x y)) = (p \ (\x. q \ (\y. return_qbs (X \\<^sub>Q Y) (x,y)))) \ (case_prod f)" + by(auto intro!: qbs_bind_bind_return2P[where f="case_prod f" and Z=Z,simplified]) + +corollary bind_qbs_rotateP: + assumes "f \ X \\<^sub>Q Y \\<^sub>Q monadP_qbs Z" + "p \ qbs_space (monadP_qbs X)" + and "q \ qbs_space (monadP_qbs Y)" + shows "q \ (\y. p \ (\x. f (x,y))) = p \ (\x. q \ (\y. f (x,y)))" + by(auto intro!: bind_qbs_rotate assms qbs_space_monadPM qbs_morphism_monadPD) + +context pair_qbs_probs +begin + +interpretation rr : standard_borel_ne "borel \\<^sub>M borel :: (real \ real) measure" + by(auto intro!: pair_standard_borel_ne) + +sublocale qbs_prob "X \\<^sub>Q Y" "map_prod \ \ \ rr.from_real" "distr (\ \\<^sub>M \) borel rr.to_real" + by(auto simp: qbs_prob_def in_Mx_def real_distribution_def qbs_Mx_is_morphisms real_distribution_axioms_def pq1.prob_space_axioms pq2.prob_space_axioms intro!: prob_space.prob_space_distr prob_space_pair) + +lemma qbs_bind_bind_return_prob: + assumes [qbs]:"f \ X \\<^sub>Q Y \\<^sub>Q Z" + shows "qbs_prob Z (f \ (map_prod \ \ \ rr.from_real)) (distr (\ \\<^sub>M \) borel rr.to_real)" + using qbs_prob_axioms by(auto simp: qbs_prob_def in_Mx_def qbs_Mx_is_morphisms) + +end + +subsubsection \ Almost Everywhere \ +lift_definition qbs_almost_everywhere :: "['a qbs_measure, 'a \ bool] \ bool" +is "\(X,\,\). almost_everywhere (distr \ (qbs_to_measure X) \)" + by(auto simp: qbs_s_finite_eq_def) metis + +syntax + "_qbs_almost_everywhere" :: "pttrn \ 'a \ bool \ bool" ("AE\<^sub>Q _ in _. _" [0,0,10] 10) + +translations + "AE\<^sub>Q x in p. P" \ "CONST qbs_almost_everywhere p (\x. P)" + +lemma AEq_qbs_l: "(AE\<^sub>Q x in p. P x) = (AE x in qbs_l p. P x)" + by transfer (simp add: case_prod_beta') + +lemma(in qbs_s_finite) AEq_def: + "(AE\<^sub>Q x in \X, \, \\\<^sub>s\<^sub>f\<^sub>i\<^sub>n . P x) = (AE x in (distr \ (qbs_to_measure X) \). P x)" + by(simp add: qbs_almost_everywhere.abs_eq) + +lemma(in qbs_s_finite) AEq_AE: "(AE\<^sub>Q x in \X, \, \\\<^sub>s\<^sub>f\<^sub>i\<^sub>n . P x) \ (AE x in \. P (\ x))" + by(auto simp: AEq_def intro!:AE_distrD[of \]) + +lemma(in qbs_s_finite) AEq_AE_iff: + assumes [qbs]:"qbs_pred X P" + shows "(AE\<^sub>Q x in \X, \, \\\<^sub>s\<^sub>f\<^sub>i\<^sub>n . P x) \ (AE x in \. P (\ x))" + by(auto simp: AEq_AE AEq_def qbs_pred_iff_sets intro!: AE_distr_iff[THEN iffD2]) + +lemma AEq_qbs_pred[qbs]: "qbs_almost_everywhere \ monadM_qbs X \\<^sub>Q (X \\<^sub>Q qbs_count_space UNIV) \\<^sub>Q qbs_count_space UNIV" +proof(rule curry_preserves_morphisms[OF pair_qbs_morphismI]) + fix \ \ + assume h:"\ \ qbs_Mx (monadM_qbs X)" "\ \ qbs_Mx (X \\<^sub>Q qbs_count_space (UNIV :: bool set))" + from rep_qbs_Mx_monadM[OF h(1)] obtain \ k where hk: + "\ = (\r. \X, \, k r\\<^sub>s\<^sub>f\<^sub>i\<^sub>n)" "\ \ qbs_Mx X" "s_finite_kernel borel borel k" "\r. qbs_s_finite X \ (k r)" + by metis + interpret s:standard_borel_ne "borel :: real measure" by simp + interpret s2: standard_borel_ne "borel \\<^sub>M borel :: (real \ real) measure" by(simp add: borel_prod) + have [measurable]:"Measurable.pred (borel \\<^sub>M borel) (\(x, y). \ x (\ y))" + using h(2) hk(2) by(simp add: s2.qbs_pred_iff_measurable_pred[symmetric] r_preserves_product qbs_Mx_is_morphisms) + show "(\r. qbs_almost_everywhere (fst (\ r, \ r)) (snd (\ r, \ r))) \ qbs_Mx (qbs_count_space UNIV)" + using h(2) hk(2) by(simp add: hk(1) qbs_Mx_is_morphisms qbs_s_finite.AEq_AE_iff[OF hk(4)]) + (auto simp add: s.qbs_pred_iff_measurable_pred intro!: s_finite_kernel.AE_pred[OF hk(3)]) +qed + +lemma AEq_I2[simp]: + assumes "p \ qbs_space (monadM_qbs X)" "\x. x \ qbs_space X \ P x" + shows "AE\<^sub>Q x in p. P x" + by(auto simp: space_qbs_l_in[OF assms(1)] assms(2) AEq_qbs_l) + +lemma AEq_mp[elim!]: + assumes "AE\<^sub>Q x in s. P x" "AE\<^sub>Q x in s. P x \ Q x" + shows "AE\<^sub>Q x in s. Q x" + using assms by(auto simp: AEq_qbs_l) + +lemma + shows AEq_iffI: "AE\<^sub>Q x in s. P x \ AE\<^sub>Q x in s. P x \ Q x \ AE\<^sub>Q x in s. Q x" + and AEq_disjI1: "AE\<^sub>Q x in s. P x \ AE\<^sub>Q x in s. P x \ Q x" + and AEq_disjI2: "AE\<^sub>Q x in s. Q x \ AE\<^sub>Q x in s. P x \ Q x" + and AEq_conjI: "AE\<^sub>Q x in s. P x \ AE\<^sub>Q x in s. Q x \ AE\<^sub>Q x in s. P x \ Q x" + and AEq_conj_iff[simp]: "(AE\<^sub>Q x in s. P x \ Q x) \ (AE\<^sub>Q x in s. P x) \ (AE\<^sub>Q x in s. Q x)" + by(auto simp: AEq_qbs_l) + +lemma AEq_symmetric: + assumes "AE\<^sub>Q x in s. P x = Q x" + shows "AE\<^sub>Q x in s. Q x = P x" + using assms by(auto simp: AEq_qbs_l) + +lemma AEq_impI: "(P \ AE\<^sub>Q x in M. Q x) \ AE\<^sub>Q x in M. P \ Q x" + by(auto simp: AEq_qbs_l AE_impI) + +lemma AEq_Ball_mp: + "s \ qbs_space (monadM_qbs X) \ (\x. x\qbs_space X \ P x) \ AE\<^sub>Q x in s. P x \ Q x \ AE\<^sub>Q x in s. Q x" + by auto + +lemma AEq_cong: + "s \ qbs_space (monadM_qbs X) \ (\x. x \ qbs_space X \ P x \ Q x) \ (AE\<^sub>Q x in s. P x) \ (AE\<^sub>Q x in s. Q x)" + by auto + +lemma AEq_cong_simp: "s \ qbs_space (monadM_qbs X) \ (\x. x \ qbs_space X =simp=> P x = Q x) \ (AE\<^sub>Q x in s. P x) \ (AE\<^sub>Q x in s. Q x)" + by (auto simp: simp_implies_def) + +lemma AEq_all_countable: "(AE\<^sub>Q x in s. \i. P i x) \ (\i::'i::countable. AE\<^sub>Q x in s. P i x)" + by(simp add: AEq_qbs_l AE_all_countable) + +lemma AEq_ball_countable: "countable X \ (AE\<^sub>Q x in s. \y\X. P x y) \ (\y\X. AE\<^sub>Q x in s. P x y)" + by(simp add: AEq_qbs_l AE_ball_countable) + +lemma AEq_ball_countable': "(\N. N \ I \ AE\<^sub>Q x in s. P N x) \ countable I \ AE\<^sub>Q x in s. \N \ I. P N x" + unfolding AEq_ball_countable by simp + +lemma AEq_pairwise: "countable F \ pairwise (\A B. AE\<^sub>Q x in s. R x A B) F \ (AE\<^sub>Q x in s. pairwise (R x) F)" + unfolding pairwise_alt by (simp add: AEq_ball_countable) + +lemma AEq_finite_all: "finite S \ (AE\<^sub>Q x in s. \i\S. P i x) \ (\i\S. AE\<^sub>Q x in s. P i x)" + by(simp add: AEq_qbs_l AE_finite_all) + +lemma AE_finite_allI:"finite S \ (\s. s \ S \ AE\<^sub>Q x in M. Q s x) \ AE\<^sub>Q x in M. \s\S. Q s x" + by(simp add: AEq_qbs_l AE_finite_all) + +subsubsection \ Integral \ +lift_definition qbs_nn_integral :: "['a qbs_measure, 'a \ ennreal] \ ennreal" +is "\(X,\,\) f.(\\<^sup>+x. f x \distr \ (qbs_to_measure X) \)" + by(auto simp: qbs_s_finite_eq_def) + +lift_definition qbs_integral :: "['a qbs_measure, 'a \ ('b :: {banach,second_countable_topology})] \ 'b" +is "\p f. if f \ (fst p) \\<^sub>Q qbs_borel then (\x. f (fst (snd p) x) \ (snd (snd p))) else 0" + using qbs_s_finite_eq_dest(3) qbs_s_finite_eq_1_imp_2 by fastforce + +syntax + "_qbs_nn_integral" :: "pttrn \ ennreal \ 'a qbs_measure \ ennreal" ("\\<^sup>+\<^sub>Q((2 _./ _)/ \_)" [60,61] 110) + +translations + "\\<^sup>+\<^sub>Q x. f \p" \ "CONST qbs_nn_integral p (\x. f)" + +syntax + "_qbs_integral" :: "pttrn \ _ \ 'a qbs_measure \ _" ("\\<^sub>Q((2 _./ _)/ \_)" [60,61] 110) + +translations + "\\<^sub>Q x. f \p" \ "CONST qbs_integral p (\x. f)" + +lemma(in qbs_s_finite) + shows qbs_nn_integral_def: "f \ X \\<^sub>Q qbs_borel \ (\\<^sup>+\<^sub>Q x. f x \\X, \, \\\<^sub>s\<^sub>f\<^sub>i\<^sub>n) = (\\<^sup>+x. f (\ x) \ \)" + and qbs_nn_integral_def2:"(\\<^sup>+\<^sub>Q x. f x \\X, \, \\\<^sub>s\<^sub>f\<^sub>i\<^sub>n) = (\\<^sup>+x. f x \(distr \ (qbs_to_measure X) \))" + by(simp_all add: qbs_nn_integral.abs_eq nn_integral_distr lr_adjunction_correspondence) + +lemma(in qbs_s_finite) qbs_integral_def: + "f \ X \\<^sub>Q qbs_borel \ (\\<^sub>Q x. f x \\X, \, \\\<^sub>s\<^sub>f\<^sub>i\<^sub>n) = (\x. f (\ x) \ \)" + by(simp add: qbs_integral.abs_eq) + +lemma(in qbs_s_finite) qbs_integral_def2: "(\\<^sub>Q x. f x \\X, \, \\\<^sub>s\<^sub>f\<^sub>i\<^sub>n) = (\x. f x \(distr \ (qbs_to_measure X) \))" +proof - + consider "f \ X \\<^sub>Q qbs_borel" | "f \ X \\<^sub>Q qbs_borel" by auto + thus ?thesis + proof cases + case h:2 + then have "\ integrable (qbs_l \X, \, \\\<^sub>s\<^sub>f\<^sub>i\<^sub>n) f" + by (metis borel_measurable_integrable measurable_distr_eq1 qbs_l qbs_morphism_measurable_intro) + thus ?thesis + using h by(simp add: qbs_l qbs_integral.abs_eq lr_adjunction_correspondence not_integrable_integral_eq) + qed(simp add: qbs_integral.abs_eq lr_adjunction_correspondence integral_distr) +qed + +lemma qbs_measure_eqI: + assumes [qbs]:"p \ qbs_space (monadM_qbs X)" "q \ qbs_space (monadM_qbs X)" + and "\f. f \ X \\<^sub>Q qbs_borel \ (\\<^sup>+\<^sub>Q x. f x \p) = (\\<^sup>+\<^sub>Q x. f x \q)" + shows "p = q" +proof - + obtain \ \ \ \ where h:"p = \X, \, \\\<^sub>s\<^sub>f\<^sub>i\<^sub>n" "q = \X, \, \\\<^sub>s\<^sub>f\<^sub>i\<^sub>n" "qbs_s_finite X \ \" "qbs_s_finite X \ \" + by (metis rep_qbs_space_monadM assms(1,2)) + then interpret pq:pair_qbs_s_finite X \ \ \ \ + by(auto simp: pair_qbs_s_finite_def) + show ?thesis + using assms(3) by(auto simp: h(1,2) pq.pq1.qbs_nn_integral_def pq.pq2.qbs_nn_integral_def intro!: pq.qbs_s_finite_measure_eq') +qed + +lemma qbs_nn_integral_def2_l: "qbs_nn_integral s f = integral\<^sup>N (qbs_l s) f" + by transfer auto + +lemma qbs_integral_def2_l: "qbs_integral s f = integral\<^sup>L (qbs_l s) f" + by (metis in_qbs_space_of qbs_s_finite.qbs_integral_def2 qbs_s_finite.qbs_l rep_qbs_space_monadM) + +lift_definition qbs_integrable :: "'a qbs_measure \ ('a \ 'b::{second_countable_topology,banach}) \ bool" +is "\p f. f \ fst p \\<^sub>Q qbs_borel \ integrable (snd (snd p)) (f \ (fst (snd p)))" +proof safe + have 0:"f \ Y \\<^sub>Q qbs_borel" "integrable \ (\x. f (\ x))" if "qbs_s_finite_eq (X,\,\) (Y,\,\)" "f \ X \\<^sub>Q qbs_borel" "integrable \ (\x. f (\ x))" for X :: "'a quasi_borel" and Y \ \ \ \ and f :: "_ \ 'b" + proof - + interpret pair_qbs_s_finite X \ \ \ \ + using qbs_s_finite_eq_dest[OF that(1)] by(auto simp: pair_qbs_s_finite_def) + show "f \ Y \\<^sub>Q qbs_borel" "integrable \ (\x. f (\ x))" + using that qbs_s_finite_eq_dest(3)[OF that(1)] by(simp_all add: integrable_distr_eq[symmetric,of \ \ "qbs_to_measure X" f] integrable_distr_eq[symmetric,of \ \ "qbs_to_measure X" f] lr_adjunction_correspondence qbs_s_finite_eq_dest(4)[OF that(1)]) + qed + { + fix X Y :: "'a quasi_borel" + fix \ \ \ \ and f :: "_ \ 'b" + assume 1:"qbs_s_finite_eq (X, \, \) (Y, \, \)" + then have 2:"qbs_s_finite_eq (Y, \, \) (X, \, \)" by(auto simp: qbs_s_finite_eq_def) + have "f \ X \\<^sub>Q qbs_borel \ integrable \ (f \ \) \ f \ Y \\<^sub>Q qbs_borel \ integrable \ (f \ \)" + unfolding comp_def using 0[OF 1,of f] 0[OF 2,of f] by blast + } + thus "\prod1 prod2 :: 'a qbs_s_finite_t. qbs_s_finite_eq prod1 prod2 \ (\f:: _ \ 'b. f \ fst prod1 \\<^sub>Q borel\<^sub>Q \ integrable (snd (snd prod1)) (f \ fst (snd prod1))) = (\f. f \ fst prod2 \\<^sub>Q borel\<^sub>Q \ integrable (snd (snd prod2)) (f \ fst (snd prod2)))" + by fastforce +qed + +lemma(in qbs_s_finite) qbs_integrable_def: + "qbs_integrable \X, \, \\\<^sub>s\<^sub>f\<^sub>i\<^sub>n f \ f \ X \\<^sub>Q qbs_borel \ integrable \ (\x. f (\ x))" + by(simp add: qbs_integrable.abs_eq comp_def) + +lemma qbs_integrable_morphism_dest: + assumes "s \ qbs_space (monadM_qbs X)" + and "qbs_integrable s f" + shows "f \ X \\<^sub>Q qbs_borel" + by (metis assms qbs_s_finite.qbs_integrable_def rep_qbs_space_monadM) + +lemma qbs_integrable_morphismP: + assumes "s \ qbs_space (monadP_qbs X)" + and "qbs_integrable s f" + shows "f \ X \\<^sub>Q qbs_borel" + by(auto intro!: qbs_integrable_morphism_dest assms qbs_space_monadPM) + +lemma(in qbs_s_finite) qbs_integrable_measurable[simp]: + assumes "qbs_integrable \X,\,\\\<^sub>s\<^sub>f\<^sub>i\<^sub>n f" + shows "f \ qbs_to_measure X \\<^sub>M borel" + by(auto intro!: qbs_integrable_morphism_dest assms simp: lr_adjunction_correspondence[symmetric]) + +lemma qbs_integrable_iff_integrable: + "(qbs_integrable (s::'a qbs_measure) (f :: 'a \ 'b::{second_countable_topology,banach})) = (integrable (qbs_l s) f)" +proof transfer + fix f ::" 'a \ 'b::{second_countable_topology,banach}" + show "qbs_s_finite_eq s s \ (f \ fst s \\<^sub>Q borel\<^sub>Q \ integrable (snd (snd s)) (f \ fst (snd s))) = integrable (distr (snd (snd s)) (qbs_to_measure (fst s)) (fst (snd s))) f" for s + proof(rule prod_cases3[of s]) + fix X :: "'a quasi_borel" + fix \ \ + assume "qbs_s_finite_eq s s" and s: "s = (X,\,\)" + then interpret qbs_s_finite X \ \ by(simp add: qbs_s_finite_eq_def) + show "f \ fst s \\<^sub>Q qbs_borel \ integrable (snd (snd s)) (\x. (f \ fst (snd s)) x) \ integrable (distr (snd (snd s)) (qbs_to_measure (fst s)) (fst (snd s))) f" + using integrable_distr_eq[of \ \ "qbs_to_measure X" f,simplified] + by(auto simp add: lr_adjunction_correspondence s) + qed +qed + +corollary(in qbs_s_finite) qbs_integrable_distr: "qbs_integrable \X, \, \\\<^sub>s\<^sub>f\<^sub>i\<^sub>n f = integrable (distr \ (qbs_to_measure X) \) f" + by(simp add: qbs_integrable_iff_integrable qbs_l) + +lemma qbs_integrable_morphism[qbs]: "qbs_integrable \ monadM_qbs X \\<^sub>Q (X \\<^sub>Q (qbs_borel :: ('a :: {banach, second_countable_topology}) quasi_borel)) \\<^sub>Q qbs_count_space UNIV" +proof(rule curry_preserves_morphisms[OF pair_qbs_morphismI]) + fix \ \ + assume h:"\ \ qbs_Mx (monadM_qbs X)" "\ \ qbs_Mx (X \\<^sub>Q (qbs_borel :: 'a quasi_borel))" + from rep_qbs_Mx_monadM[OF this(1)] obtain \ k + where hk:"\ = (\r. \X, \, k r\\<^sub>s\<^sub>f\<^sub>i\<^sub>n)" "\ \ qbs_Mx X" "s_finite_kernel borel borel k" "\r. qbs_s_finite X \ (k r)" + by metis + then interpret ina: in_Mx X \ by (simp add: in_Mx_def) + interpret standard_borel_ne "borel :: real measure" by simp + have [measurable]: "\ r \ qbs_to_measure X \\<^sub>M borel" for r + using h(2) by(simp add: qbs_Mx_is_morphisms lr_adjunction_correspondence[symmetric]) + have [measurable_cong]: "sets (k r) = sets borel" for r + using hk(4) qbs_s_finite.mu_sets by blast + have 1: "borel_measurable (borel \\<^sub>M borel) = (qbs_borel \\<^sub>Q qbs_borel \\<^sub>Q qbs_borel :: (real \ real \ 'a) set)" + by (metis borel_prod pair_standard_borel qbs_borel_prod standard_borel.standard_borel_r_full_faithful standard_borel_axioms) + show "(\r. qbs_integrable (fst (\ r, \ r)) (snd (\ r, \ r))) \ qbs_Mx (qbs_count_space UNIV)" + by(auto simp: fun_cong[OF hk(1)] qbs_s_finite.qbs_integrable_distr[OF hk(4)] integrable_distr_eq qbs_Mx_is_morphisms qbs_pred_iff_measurable_pred intro!: s_finite_kernel.integrable_measurable_pred[OF hk(3)]) (insert h(2), simp add: 1 qbs_Mx_is_morphisms split_beta') +qed + +lemma(in qbs_s_finite) qbs_integrable_iff_integrable: + assumes "f \ qbs_to_measure X \\<^sub>M borel" + shows "qbs_integrable \X, \, \\\<^sub>s\<^sub>f\<^sub>i\<^sub>n f = integrable \ (\x. f (\ x))" + by(auto intro!: integrable_distr_eq[of \ \ "qbs_to_measure X" f] simp: assms qbs_integrable_distr) + +lemma qbs_integrable_iff_bounded: + assumes "s \ qbs_space (monadM_qbs X)" + shows "qbs_integrable s f \ f \ X \\<^sub>Q qbs_borel \ (\\<^sup>+\<^sub>Q x. ennreal (norm (f x)) \s) < \" + (is "?lhs = ?rhs") +proof - + from rep_qbs_space_monadM[OF assms] obtain \ \ where hs: + "qbs_s_finite X \ \" "s = \X, \, \\\<^sub>s\<^sub>f\<^sub>i\<^sub>n" + by metis + then interpret qs:qbs_s_finite X \ \ by simp + have "?lhs = integrable (distr \ (qbs_to_measure X) \) f" + by (simp add: hs(2) qbs_integrable_iff_integrable qs.qbs_l) + also have "... = (f \ borel_measurable (distr \ (qbs_to_measure X) \) \ ((\\<^sup>+ x. ennreal (norm (f x)) \(distr \ (qbs_to_measure X) \)) < \))" + by(rule integrable_iff_bounded) + also have "... = ?rhs" + by(auto simp add: hs(2) qs.qbs_nn_integral_def2 lr_adjunction_correspondence) + finally show ?thesis . +qed + +lemma not_qbs_integrable_qbs_integral: "\ qbs_integrable s f \ qbs_integral s f = 0" + by(simp add: qbs_integral_def2_l qbs_integrable_iff_integrable not_integrable_integral_eq) + +lemma qbs_integrable_cong_AE: + assumes "s \ qbs_space (monadM_qbs X)" + "AE\<^sub>Q x in s. f x = g x" + and "qbs_integrable s f" "g \ X \\<^sub>Q qbs_borel" + shows "qbs_integrable s g" + using assms(2,4) by(auto intro!: qbs_integrable_iff_integrable[THEN iffD2] Bochner_Integration.integrable_cong_AE[of g _ f,THEN iffD2] qbs_integrable_iff_integrable[THEN iffD1,OF assms(3)] qbs_integrable_morphism_dest[OF assms(1),of f] simp: AEq_qbs_l measurable_qbs_l[OF assms(1)]) + +lemma qbs_integrable_cong: + assumes "s \ qbs_space (monadM_qbs X)" + "\x. x \ qbs_space X \ f x = g x" + and "qbs_integrable s f" + shows "qbs_integrable s g" + by(auto intro!: qbs_integrable_iff_integrable[THEN iffD2] Bochner_Integration.integrable_cong[OF refl,of _ g f,THEN iffD2] qbs_integrable_iff_integrable[THEN iffD1,OF assms(3)] simp: space_qbs_l_in[OF assms(1)] assms(2)) + +lemma qbs_integrable_zero[simp, intro]: "qbs_integrable s (\x. 0)" + by(simp add: qbs_integrable_iff_integrable) + +lemma qbs_integrable_const: + assumes "s \ qbs_space (monadP_qbs X)" + shows "qbs_integrable s (\x. c)" + using assms by(auto intro!: qbs_integrable_iff_integrable[THEN iffD2] finite_measure.integrable_const simp: monadP_qbs_space prob_space_def) + +lemma qbs_integrable_add[simp,intro!]: + assumes "qbs_integrable s f" + and "qbs_integrable s g" + shows "qbs_integrable s (\x. f x + g x)" + by(rule qbs_integrable_iff_integrable[THEN iffD2,OF Bochner_Integration.integrable_add[OF qbs_integrable_iff_integrable[THEN iffD1,OF assms(1)] qbs_integrable_iff_integrable[THEN iffD1,OF assms(2)]]]) + +lemma qbs_integrable_diff[simp,intro!]: + assumes "qbs_integrable s f" + and "qbs_integrable s g" + shows "qbs_integrable s (\x. f x - g x)" + by(rule qbs_integrable_iff_integrable[THEN iffD2,OF Bochner_Integration.integrable_diff[OF qbs_integrable_iff_integrable[THEN iffD1,OF assms(1)] qbs_integrable_iff_integrable[THEN iffD1,OF assms(2)]]]) + +lemma qbs_integrable_sum[simp, intro!]: "(\i. i \ I \ qbs_integrable s (f i)) \ qbs_integrable s (\x. \i\I. f i x)" + by(simp add: qbs_integrable_iff_integrable) + +lemma qbs_integrable_scaleR_left[simp, intro!]: "qbs_integrable s f \ qbs_integrable s (\x. f x *\<^sub>R (c :: 'a :: {second_countable_topology,banach}))" + by(simp add: qbs_integrable_iff_integrable) + +lemma qbs_integrable_scaleR_right[simp, intro!]: "qbs_integrable s f \ qbs_integrable s (\x. c *\<^sub>R (f x :: 'a :: {second_countable_topology,banach}) )" + by(simp add: qbs_integrable_iff_integrable) + +lemma qbs_integrable_mult_iff: + fixes f :: "'a \ real" + shows "(qbs_integrable s (\x. c * f x)) = (c = 0 \ qbs_integrable s f)" + using qbs_integrable_iff_integrable[of s "\x. c * f x"] integrable_mult_left_iff[of _ c f] qbs_integrable_iff_integrable[of s f] + by simp + +lemma + fixes c :: "_::{real_normed_algebra,second_countable_topology}" + assumes "qbs_integrable s f" + shows qbs_integrable_mult_right:"qbs_integrable s (\x. c * f x)" + and qbs_integrable_mult_left: "qbs_integrable s (\x. f x * c)" + using assms by(auto simp: qbs_integrable_iff_integrable) + +lemma qbs_integrable_divide_zero[simp, intro!]: + fixes c :: "_::{real_normed_field, field, second_countable_topology}" + shows "qbs_integrable s f \ qbs_integrable s (\x. f x / c)" + by(simp add: qbs_integrable_iff_integrable) + +lemma qbs_integrable_inner_left[simp, intro!]: + "qbs_integrable s f \ qbs_integrable s (\x. f x \ c)" + by(simp add: qbs_integrable_iff_integrable) + +lemma qbs_integrable_inner_right[simp, intro!]: + "qbs_integrable s f \ qbs_integrable s (\x. c \ f x)" + by(simp add: qbs_integrable_iff_integrable) + +lemma qbs_integrable_minus[simp, intro!]: + "qbs_integrable s f \ qbs_integrable s (\x. - f x)" + by(simp add: qbs_integrable_iff_integrable) + +lemma [simp, intro]: + assumes "qbs_integrable s f" + shows qbs_integrable_Re: "qbs_integrable s (\x. Re (f x))" + and qbs_integrable_Im: "qbs_integrable s (\x. Im (f x))" + and qbs_integrable_cnj: "qbs_integrable s (\x. cnj (f x))" + using assms by(simp_all add: qbs_integrable_iff_integrable) + +lemma qbs_integrable_of_real[simp, intro!]: + "qbs_integrable s f \ qbs_integrable s (\x. of_real (f x))" + by(simp_all add: qbs_integrable_iff_integrable) + +lemma [simp, intro]: + assumes "qbs_integrable s f" + shows qbs_integrable_fst: "qbs_integrable s (\x. fst (f x))" + and qbs_integrable_snd: "qbs_integrable s (\x. snd (f x))" + using assms by(simp_all add: qbs_integrable_iff_integrable) + +lemma qbs_integrable_norm: + assumes "qbs_integrable s f" + shows "qbs_integrable s (\x. norm (f x))" + by(rule qbs_integrable_iff_integrable[THEN iffD2,OF integrable_norm[OF qbs_integrable_iff_integrable[THEN iffD1,OF assms]]]) + +lemma qbs_integrable_abs: + fixes f :: "_ \ real" + assumes "qbs_integrable s f" + shows "qbs_integrable s (\x. \f x\)" + by(rule qbs_integrable_iff_integrable[THEN iffD2,OF integrable_abs[OF qbs_integrable_iff_integrable[THEN iffD1,OF assms]]]) + +lemma qbs_integrable_sq: + fixes c :: "_::{real_normed_field,second_countable_topology}" + assumes "qbs_integrable s (\x. c)" "qbs_integrable s f" + and "qbs_integrable s (\x. (f x)\<^sup>2)" + shows "qbs_integrable s (\x. (f x - c)\<^sup>2)" + by(simp add: comm_ring_1_class.power2_diff,rule qbs_integrable_diff,rule qbs_integrable_add) + (simp_all add: comm_semiring_1_class.semiring_normalization_rules(16)[of 2] assms qbs_integrable_mult_right power2_eq_square[of c]) + +lemma qbs_nn_integral_eq_integral_AEq: + assumes "qbs_integrable s f" "AE\<^sub>Q x in s. 0 \ f x" + shows "(\\<^sup>+\<^sub>Q x. ennreal (f x) \s) = ennreal (\\<^sub>Q x. f x \s)" + using nn_integral_eq_integral[OF qbs_integrable_iff_integrable[THEN iffD1,OF assms(1)] ] qbs_integrable_morphism_dest[OF in_qbs_space_of assms(1)] assms(2) + by(simp add: qbs_integral_def2_l qbs_nn_integral_def2_l AEq_qbs_l) + +lemma qbs_nn_integral_eq_integral: + assumes "s \ qbs_space (monadM_qbs X)" "qbs_integrable s f" + and "\x. x \ qbs_space X \ 0 \ f x" + shows "(\\<^sup>+\<^sub>Q x. ennreal (f x) \s) = ennreal (\\<^sub>Q x. f x \s)" + using qbs_nn_integral_eq_integral_AEq[OF assms(2) AEq_I2[OF assms(1,3)]] by simp + +lemma qbs_nn_integral_cong_AEq: + assumes "s \ qbs_space (monadM_qbs X)" "AE\<^sub>Q x in s. f x = g x" + shows "qbs_nn_integral s f = qbs_nn_integral s g" +proof - + from rep_qbs_space_monadM[OF assms(1)] obtain \ \ + where hs: "s = \X, \, \\\<^sub>s\<^sub>f\<^sub>i\<^sub>n" "qbs_s_finite X \ \" by metis + then interpret qs: qbs_s_finite X \ \ by simp + show ?thesis + using assms(2) by(auto simp: qs.qbs_nn_integral_def2 hs(1) qs.AEq_def intro!: nn_integral_cong_AE) +qed + +lemma qbs_nn_integral_cong: + assumes "s \ qbs_space (monadM_qbs X)" "\x. x \ qbs_space X \ f x = g x" + shows "qbs_nn_integral s f = qbs_nn_integral s g" + using qbs_nn_integral_cong_AEq[OF assms(1) AEq_I2[OF assms]] by simp + +lemma qbs_nn_integral_const: + "(\\<^sup>+\<^sub>Q x. c \s) = c * qbs_l s (qbs_space (qbs_space_of s))" + by(simp add: qbs_nn_integral_def2_l space_qbs_l) + +lemma qbs_nn_integral_const_prob: + assumes "s \ qbs_space (monadP_qbs X)" + shows "(\\<^sup>+\<^sub>Q x. c \s) = c" + using assms by(simp add: qbs_nn_integral_const prob_space.emeasure_space_1 qbs_l_prob_space space_qbs_l) + +lemma qbs_nn_integral_add: + assumes "s \ qbs_space (monadM_qbs X)" + and [qbs]:"f \ X \\<^sub>Q qbs_borel" "g \ X \\<^sub>Q qbs_borel" + shows "(\\<^sup>+\<^sub>Q x. f x + g x \s) = (\\<^sup>+\<^sub>Q x. f x \s) + (\\<^sup>+\<^sub>Q x. g x \s)" + by(auto simp: qbs_nn_integral_def2_l measurable_qbs_l[OF assms(1)] intro!: nn_integral_add measurable_qbs_l) + +lemma qbs_nn_integral_cmult: + assumes "s \ qbs_space (monadM_qbs X)" and [qbs]:"f \ X \\<^sub>Q qbs_borel" + shows "(\\<^sup>+\<^sub>Q x. c * f x \s) = c * (\\<^sup>+\<^sub>Q x. f x \s)" + by(auto simp: qbs_nn_integral_def2_l measurable_qbs_l[OF assms(1)] intro!: nn_integral_cmult) + +lemma qbs_integral_cong_AEq: + assumes [qbs]:"s \ qbs_space (monadM_qbs X)" "f \ X \\<^sub>Q qbs_borel" "g \ X \\<^sub>Q qbs_borel" + and "AE\<^sub>Q x in s. f x = g x" + shows "qbs_integral s f = qbs_integral s g" + using assms(4) by(auto simp: qbs_integral_def2_l AEq_qbs_l measurable_qbs_l[OF assms(1)] intro!: integral_cong_AE ) + +lemma qbs_integral_cong: + assumes "s \ qbs_space (monadM_qbs X)" "\x. x \ qbs_space X \ f x = g x" + shows "qbs_integral s f = qbs_integral s g" + by(auto simp: qbs_integral_def2_l space_qbs_l_in[OF assms(1)] assms(2) intro!: Bochner_Integration.integral_cong) + +lemma qbs_integral_nonneg_AEq: + fixes f :: "_ \ real" + shows "AE\<^sub>Q x in s. 0 \ f x \ 0 \ qbs_integral s f" + by(auto simp: qbs_integral_def2_l AEq_qbs_l intro!: integral_nonneg_AE ) + +lemma qbs_integral_nonneg: + fixes f :: "_ \ real" + assumes "s \ qbs_space (monadM_qbs X)" "\x. x \ qbs_space X \ 0 \ f x" + shows "0 \ qbs_integral s f" + by(auto simp: qbs_integral_def2_l space_qbs_l_in[OF assms(1)] assms(2) intro!: Bochner_Integration.integral_nonneg) + +lemma qbs_integral_mono_AEq: + fixes f :: "_ \ real" + assumes "qbs_integrable s f" "qbs_integrable s g" "AE\<^sub>Q x in s. f x \ g x" + shows "qbs_integral s f \ qbs_integral s g" + using assms by(auto simp: qbs_integral_def2_l AEq_qbs_l qbs_integrable_iff_integrable intro!: integral_mono_AE) + +lemma qbs_integral_mono: + fixes f :: "_ \ real" + assumes "s \ qbs_space (monadM_qbs X)" + and "qbs_integrable s f" "qbs_integrable s g" "\x. x \ qbs_space X \ f x \ g x" + shows "qbs_integral s f \ qbs_integral s g" + by(auto simp: qbs_integral_def2_l space_qbs_l_in[OF assms(1)] qbs_integrable_iff_integrable[symmetric] assms intro!: integral_mono) + +lemma qbs_integral_const_prob: + assumes "s \ qbs_space (monadP_qbs X)" + shows "(\\<^sub>Q x. c \s) = c" + using assms by(simp add: qbs_integral_def2_l monadP_qbs_space prob_space.prob_space) + +lemma + assumes "qbs_integrable s f" "qbs_integrable s g" + shows qbs_integral_add:"(\\<^sub>Q x. f x + g x \s) = (\\<^sub>Q x. f x \s) + (\\<^sub>Q x. g x \s)" + and qbs_integral_diff: "(\\<^sub>Q x. f x - g x \s) = (\\<^sub>Q x. f x \s) - (\\<^sub>Q x. g x \s)" + using assms by(auto simp: qbs_integral_def2_l qbs_integrable_iff_integrable[symmetric] intro!: Bochner_Integration.integral_add Bochner_Integration.integral_diff) + +lemma [simp]: + fixes c :: "_::{real_normed_field,second_countable_topology}" + shows qbs_integral_mult_right_zero:"(\\<^sub>Q x. c * f x \s) = c * (\\<^sub>Q x. f x \s)" + and qbs_integral_mult_left_zero:"(\\<^sub>Q x. f x * c \s) = (\\<^sub>Q x. f x \s) * c" + and qbs_integral_divide_zero: "(\\<^sub>Q x. f x / c \s) = (\\<^sub>Q x. f x \s) / c" + by(auto simp: qbs_integral_def2_l) + +lemma qbs_integral_minus[simp]: "(\\<^sub>Q x. - f x \s) = - (\\<^sub>Q x. f x \s)" + by(auto simp: qbs_integral_def2_l) + +lemma [simp]: + shows qbs_integral_scaleR_right:"(\\<^sub>Q x. c *\<^sub>R f x \s) = c *\<^sub>R (\\<^sub>Q x. f x \s)" + and qbs_integral_scaleR_left: "(\\<^sub>Q x. f x *\<^sub>R c \s) = (\\<^sub>Q x. f x \s) *\<^sub>R c" + by(auto simp: qbs_integral_def2_l) + +lemma [simp]: + shows qbs_integral_inner_left: "qbs_integrable s f \ (\\<^sub>Q x. f x \ c \s) = (\\<^sub>Q x. f x \s) \ c" + and qbs_integral_inner_right: "qbs_integrable s f \ (\\<^sub>Q x. c \ f x \s) = c \ (\\<^sub>Q x. f x \s) " + by(auto simp: qbs_integral_def2_l qbs_integrable_iff_integrable) + +lemma integral_complex_of_real[simp]: "(\\<^sub>Q x. complex_of_real (f x) \s)= of_real (\\<^sub>Q x. f x \s)" + by(simp add: qbs_integral_def2_l) + +lemma integral_cnj[simp]: "(\\<^sub>Q x. cnj (f x) \s) = cnj (\\<^sub>Q x. f x \s)" + by(simp add: qbs_integral_def2_l) + +lemma [simp]: + assumes "qbs_integrable s f" + shows qbs_integral_Im: "(\\<^sub>Q x. Im (f x) \s) = Im (\\<^sub>Q x. f x \s)" + and qbs_integral_Re: "(\\<^sub>Q x. Re (f x) \s) = Re (\\<^sub>Q x. f x \s)" + using assms by(auto simp: qbs_integral_def2_l qbs_integrable_iff_integrable) + +lemma qbs_integral_of_real[simp]:"qbs_integrable s f \ (\\<^sub>Q x. of_real (f x) \s) = of_real (\\<^sub>Q x. f x \s)" + by(auto simp: qbs_integral_def2_l qbs_integrable_iff_integrable) + +lemma [simp]: + assumes "qbs_integrable s f" + shows qbs_integral_fst: "(\\<^sub>Q x. fst (f x) \s) = fst (\\<^sub>Q x. f x \s)" + and qbs_integral_snd: "(\\<^sub>Q x. snd (f x) \s) = snd (\\<^sub>Q x. f x \s)" + using assms by(auto simp: qbs_integral_def2_l qbs_integrable_iff_integrable) + +lemma real_qbs_integral_def: + assumes "qbs_integrable s f" + shows "qbs_integral s f = enn2real (\\<^sup>+\<^sub>Q x. ennreal (f x) \s) - enn2real (\\<^sup>+\<^sub>Q x. ennreal (- f x) \s)" + using qbs_integrable_morphism_dest[OF in_qbs_space_of assms] assms + by(auto simp: qbs_integral_def2_l qbs_nn_integral_def2_l qbs_integrable_iff_integrable[symmetric] intro!: real_lebesgue_integral_def) + +lemma Markov_inequality_qbs_prob: + "qbs_integrable s f \ AE\<^sub>Q x in s. 0 \ f x \ 0 < c \ \

(x in qbs_l s. c \ f x) \ (\\<^sub>Q x. f x \s) / c" + by(auto simp: qbs_integral_def2_l AEq_qbs_l qbs_integrable_iff_integrable intro!: integral_Markov_inequality_measure[where A="{}"]) + +lemma Chebyshev_inequality_qbs_prob: + assumes "s \ qbs_space (monadP_qbs X)" + and "f \ X \\<^sub>Q qbs_borel" "qbs_integrable s (\x. (f x)\<^sup>2)" + and "0 < e" + shows "\

(x in qbs_l s. e \ \f x - (\\<^sub>Q x. f x \s)\) \ (\\<^sub>Q x. (f x - (\\<^sub>Q x. f x \s))\<^sup>2 \s) / e\<^sup>2" + using prob_space.Chebyshev_inequality[OF qbs_l_prob_space[OF assms(1)] _ _ assms(4),of f] assms(2,3) + by(simp add: qbs_integral_def2_l qbs_integrable_iff_integrable lr_adjunction_correspondence measurable_qbs_l'[OF qbs_space_monadPM[OF assms(1)]]) + +lemma qbs_l_return_qbs: + assumes "x \ qbs_space X" + shows "qbs_l (return_qbs X x) = return (qbs_to_measure X) x" +proof - + interpret qp: qbs_prob X "\r. x" "return borel 0" + by(auto simp: qbs_prob_def prob_space_return assms in_Mx_def real_distribution_def real_distribution_axioms_def) + show ?thesis + by(simp add: qp.return_qbs[OF assms] distr_return qp.qbs_l) +qed + +lemma qbs_l_bind_qbs: + assumes [qbs]: "s \ qbs_space (monadM_qbs X)" "f \ X \\<^sub>Q monadM_qbs Y" + shows "qbs_l (s \ f) = qbs_l s \\<^sub>k qbs_l \ f" (is "?lhs = ?rhs") +proof - + from rep_qbs_space_monadM[OF assms(1)] obtain \ \ + where hs: "s = \X, \, \\\<^sub>s\<^sub>f\<^sub>i\<^sub>n" "qbs_s_finite X \ \" by metis + then interpret qs: qbs_s_finite X \ \ by simp + from rep_qbs_Mx_monadM[OF qbs_morphism_Mx[OF assms(2) qs.in_Mx]] obtain \ k where + hk: "f \ \ = (\r. \Y, \, k r\\<^sub>s\<^sub>f\<^sub>i\<^sub>n)" "\ \ qbs_Mx Y" "s_finite_kernel borel borel k" "\r. qbs_s_finite Y \ (k r )" + by metis + then interpret sk: s_finite_kernel borel borel k by simp + interpret im: in_Mx Y \ using hk(2) by(simp add: in_Mx_def) + + have "?lhs = distr (\ \\<^sub>k k) (qbs_to_measure Y) \" + by(simp add: qs.bind_qbs[OF hs(1) assms(2) hk(2,3,1)] qbs_s_finite.qbs_l[OF qs.bind_qbs_s_finite[OF hs(1) assms(2) hk(2,3,1)]]) + also have "... = \ \\<^sub>k (\x. distr (k x) (qbs_to_measure Y) \)" + by(auto intro!: sk.distr_bind_kernel simp: qs.mu_sets) + also have "... = \ \\<^sub>k (\r. qbs_l ((f \ \) r))" + by(simp add: qbs_s_finite.qbs_l[OF hk(4)] hk(1)) + also have "... = \ \\<^sub>k (\r. (\x. qbs_l (f x)) (\ r))" by simp + also have "... = distr \ (qbs_to_measure X) \ \\<^sub>k (\x. qbs_l (f x))" + using l_preserves_morphisms[of X "monadM_qbs Y"] assms(2) + by(auto intro!: measure_kernel.bind_kernel_distr[OF measure_kernel.measure_kernel_comp[OF qbs_l_measure_kernel],symmetric] simp: sets_eq_imp_space_eq[OF qs.mu_sets]) + also have "... = ?rhs" + by(simp add: hs(1) qs.qbs_l comp_def) + finally show ?thesis . +qed + +lemma qbs_integrable_return[simp, intro]: + assumes "x \ qbs_space X" "f \ X \\<^sub>Q qbs_borel" + shows "qbs_integrable (return_qbs X x) f" + using assms by(auto simp: qbs_integrable_iff_integrable qbs_l_return_qbs[OF assms(1)] lr_adjunction_correspondence nn_integral_return space_L intro!: integrableI_bounded) + +lemma qbs_integrable_bind_return: + assumes [qbs]:"s \ qbs_space (monadM_qbs X)" "f \ Y \\<^sub>Q qbs_borel" "g \ X \\<^sub>Q Y" + shows "qbs_integrable (s \ (\x. return_qbs Y (g x))) f = qbs_integrable s (f \ g)" (is "?lhs = ?rhs") +proof - + from rep_qbs_space_monadM[OF assms(1)] obtain \ \ + where hs: "s = \X, \, \\\<^sub>s\<^sub>f\<^sub>i\<^sub>n" "qbs_s_finite X \ \" by metis + then interpret qs: qbs_s_finite X \ \ by simp + + have 1:"return_qbs Y \ (g \ \) = (\r. \Y, g \ \, return borel r\\<^sub>s\<^sub>f\<^sub>i\<^sub>n)" + by(auto intro!: return_qbs_comp qbs_morphism_Mx[OF assms(3)]) + have hb: "qbs_s_finite Y (g \ \) \" "s \ (\x. return_qbs Y (g x)) = \Y, g \ \, \\\<^sub>s\<^sub>f\<^sub>i\<^sub>n" + using qbs_s_finite.bind_qbs[OF hs(2,1) qbs_morphism_comp[OF assms(3) return_qbs_morphism] qbs_morphism_Mx[OF assms(3)] prob_kernel.s_finite_kernel_prob_kernel 1[simplified comp_assoc[symmetric]]] + qbs_s_finite.bind_qbs_s_finite[OF hs(2,1) qbs_morphism_comp[OF assms(3) return_qbs_morphism] qbs_morphism_Mx[OF assms(3)] prob_kernel.s_finite_kernel_prob_kernel 1[simplified comp_assoc[symmetric]]] + by(auto simp: prob_kernel_def' comp_def bind_kernel_return''[OF qs.mu_sets]) + have "?lhs = integrable \ (f \ (g \ \))" + by(auto simp: hb(2) intro!: qbs_s_finite.qbs_integrable_iff_integrable[OF hb(1),simplified comp_def] simp: comp_def lr_adjunction_correspondence[symmetric]) + also have "... = ?rhs" + by(auto simp: hs(1) comp_def lr_adjunction_correspondence[symmetric] intro!: qs.qbs_integrable_iff_integrable[symmetric]) + finally show ?thesis . +qed + +lemma qbs_nn_integral_morphism[qbs]: "qbs_nn_integral \ monadM_qbs X \\<^sub>Q (X \\<^sub>Q qbs_borel) \\<^sub>Q qbs_borel" +proof(rule curry_preserves_morphisms[OF pair_qbs_morphismI]) + fix \ \ + assume h:"\ \ qbs_Mx (monadM_qbs X)" "\ \ qbs_Mx (X \\<^sub>Q (qbs_borel :: ennreal quasi_borel))" + from rep_qbs_Mx_monadM[OF h(1)] obtain a k + where ak: "\ = (\r. \X, a, k r\\<^sub>s\<^sub>f\<^sub>i\<^sub>n)" "a \ qbs_Mx X" "s_finite_kernel borel borel k" "\r. qbs_s_finite X a (k r)" + by metis + have 1:"borel_measurable ((borel :: real measure) \\<^sub>M (borel :: real measure)) = qbs_borel \\<^sub>Q qbs_borel \\<^sub>Q (qbs_borel :: ennreal quasi_borel)" + by (metis borel_prod qbs_borel_prod standard_borel.standard_borel_r_full_faithful standard_borel_ne_borel standard_borel_ne_def) + show "(\r. qbs_nn_integral (fst (\ r, \ r)) (snd (\ r, \ r))) \ qbs_Mx qbs_borel" + unfolding qbs_Mx_qbs_borel + by(rule measurable_cong[where f="\r. \\<^sup>+ x. \ r (a x) \k r",THEN iffD1], insert h ak(2)) + (auto simp: qbs_s_finite.qbs_nn_integral_def[OF ak(4)] qbs_Mx_is_morphisms ak(1) 1 intro!: s_finite_kernel.nn_integral_measurable_f[OF ak(3)]) +qed + +lemma qbs_nn_integral_return: + assumes "f \ X \\<^sub>Q qbs_borel" + and "x \ qbs_space X" + shows "qbs_nn_integral (return_qbs X x) f = f x" + using assms by(auto intro!: nn_integral_return simp: qbs_nn_integral_def2_l qbs_l_return_qbs space_L lr_adjunction_correspondence) + +lemma qbs_nn_integral_bind: + assumes [qbs]:"s \ qbs_space (monadM_qbs X)" + "f \ X \\<^sub>Q monadM_qbs Y" "g \ Y \\<^sub>Q qbs_borel" + shows "qbs_nn_integral (s \ f) g = qbs_nn_integral s (\y. (qbs_nn_integral (f y) g))" (is "?lhs = ?rhs") +proof - + from rep_qbs_space_monadM[OF assms(1)] obtain \ \ + where hs: "s = \X, \, \\\<^sub>s\<^sub>f\<^sub>i\<^sub>n" "qbs_s_finite X \ \" by metis + then interpret qs: qbs_s_finite X \ \ by simp + from rep_qbs_Mx_monadM[OF qbs_morphism_Mx[OF assms(2) qs.in_Mx]] obtain \ k + where hk: "f \ \ = (\r. \Y, \, k r\\<^sub>s\<^sub>f\<^sub>i\<^sub>n)" "\ \ qbs_Mx Y" "s_finite_kernel borel borel k" "\r. qbs_s_finite Y \ (k r)" + by metis + note sf = qs.bind_qbs[OF hs(1) assms(2) hk(2,3,1)] qs.bind_qbs_s_finite[OF hs(1) assms(2) hk(2,3,1)] + have "?lhs = (\\<^sup>+ x. g (\ x) \(\ \\<^sub>k k))" + by(simp add: sf(1) qbs_s_finite.qbs_nn_integral_def[OF sf(2)]) + also have "... = (\\<^sup>+ r. (\\<^sup>+ y. g (\ y) \(k r)) \\)" + using assms(3) hk(2) by(auto intro!: s_finite_kernel.nn_integral_bind_kernel[OF hk(3)] qs.mu_sets simp: s_finite_kernel_cong_sets[OF qs.mu_sets] lr_adjunction_correspondence) + also have "... = ?rhs" + using fun_cong[OF hk(1)] by(auto simp: hs(1) qs.qbs_nn_integral_def qbs_s_finite.qbs_nn_integral_def[OF hk(4),symmetric] intro!: nn_integral_cong) + finally show ?thesis . +qed + +lemma qbs_nn_integral_bind_return: + assumes [qbs]:"s \ qbs_space (monadM_qbs Y)" "f \ Z \\<^sub>Q qbs_borel" "g \ Y \\<^sub>Q Z" + shows "qbs_nn_integral (s \ (\y. return_qbs Z (g y))) f = qbs_nn_integral s (f \ g)" + by(auto simp: qbs_nn_integral_bind[OF assms(1) _ assms(2)] qbs_nn_integral_return intro!: qbs_nn_integral_cong[OF assms(1)]) + +lemma qbs_integral_morphism[qbs]: + "qbs_integral \ monadM_qbs X \\<^sub>Q (X \\<^sub>Q qbs_borel) \\<^sub>Q (qbs_borel :: ('b :: {second_countable_topology,banach}) quasi_borel)" +proof(rule curry_preserves_morphisms[OF pair_qbs_morphismI]) + fix \ and \ :: "_ \ _ \ 'b" + assume h:"\ \ qbs_Mx (monadM_qbs X)" "\ \ qbs_Mx (X \\<^sub>Q qbs_borel)" + from rep_qbs_Mx_monadM[OF this(1)] obtain \ k + where hk: "\ = (\r. \X, \, k r\\<^sub>s\<^sub>f\<^sub>i\<^sub>n)" "\ \ qbs_Mx X" "s_finite_kernel borel borel k" "\r. qbs_s_finite X \ (k r)" + by metis + have 1:"borel_measurable ((borel :: real measure) \\<^sub>M (borel :: real measure)) = qbs_borel \\<^sub>Q qbs_borel \\<^sub>Q (qbs_borel :: (_ :: {second_countable_topology,banach}) quasi_borel)" + by (metis borel_prod qbs_borel_prod standard_borel.standard_borel_r_full_faithful standard_borel_ne_borel standard_borel_ne_def) + show "(\r. qbs_integral (fst (\ r,\ r)) (snd (\ r,\ r))) \ qbs_Mx borel\<^sub>Q" + unfolding qbs_Mx_R + by(rule measurable_cong[where f="\r. \ x. \ r (\ x) \k r",THEN iffD1], insert h hk(2)) + (auto simp: qbs_s_finite.qbs_integral_def[OF hk(4)] qbs_Mx_is_morphisms hk(1) 1 intro!: s_finite_kernel.integral_measurable_f[OF hk(3)]) +qed + +lemma qbs_integral_return: + assumes [qbs]:"f \ X \\<^sub>Q qbs_borel" "x \ qbs_space X" + shows "qbs_integral (return_qbs X x) f = f x" + by(auto simp: qbs_integral_def2_l qbs_l_return_qbs lr_adjunction_correspondence[symmetric] space_L integral_return) + +lemma + assumes [qbs]: "s \ qbs_space (monadM_qbs X)" "f \ X \\<^sub>Q monadM_qbs Y" "g \ Y \\<^sub>Q qbs_borel" + and "qbs_integrable s (\x. \\<^sub>Q y. norm (g y) \f x)" "AE\<^sub>Q x in s. qbs_integrable (f x) g" + shows qbs_integrable_bind: "qbs_integrable (s \ f) g" (is ?goal1) + and qbs_integral_bind:"(\\<^sub>Q y. g y \(s \ f)) = (\\<^sub>Q x. \\<^sub>Q y. g y \f x \s)" (is "?lhs = ?rhs") +proof - + from rep_qbs_space_monadM[OF assms(1)] obtain \ \ + where hs: "s = \X, \, \\\<^sub>s\<^sub>f\<^sub>i\<^sub>n" "qbs_s_finite X \ \" by metis + then interpret qs: qbs_s_finite X \ \ by simp + from rep_qbs_Mx_monadM[OF qbs_morphism_Mx[OF assms(2) qs.in_Mx]] obtain \ k + where hk: "f \ \ = (\r. \Y, \, k r\\<^sub>s\<^sub>f\<^sub>i\<^sub>n)" "\ \ qbs_Mx Y" "s_finite_kernel borel borel k" "\r. qbs_s_finite Y \ (k r)" + by metis + note sf = qs.bind_qbs[OF hs(1) assms(2) hk(2,3,1)] + have g[measurable]: "\h M. h \ M \\<^sub>M qbs_to_measure Y \ (\x. g (h x)) \ M \\<^sub>M borel" + using assms(3) by(auto simp: lr_adjunction_correspondence) + interpret qs2: qbs_s_finite Y \ "\ \\<^sub>k k" + by(rule qs.bind_qbs_s_finite[OF hs(1) assms(2) hk(2,3,1)]) + show ?goal1 + by(auto simp: sf qs2.qbs_integrable_def intro!: s_finite_kernel.integrable_bind_kernel[OF hk(3) qs.mu_sets]) + (insert qs.AEq_AE[OF assms(5)[simplified hs(1)],simplified fun_cong[OF hk(1),simplified] qbs_s_finite.qbs_integrable_def[OF hk(4)]] assms(4)[simplified hs(1) qs.qbs_integrable_def fun_cong[OF hk(1),simplified]],auto simp: hs(1) qs.qbs_integrable_def qbs_s_finite.qbs_integral_def[OF hk(4)]) + have "?lhs = (\r. g (\ r) \(\ \\<^sub>k k))" + by(simp add: sf qs2.qbs_integral_def) + also have "... = (\r. (\l. g (\ l)\k r) \\)" + using qs.AEq_AE[OF assms(5)[simplified hs(1)],simplified fun_cong[OF hk(1),simplified] qbs_s_finite.qbs_integrable_def[OF hk(4)]] assms(4)[simplified hs(1) qs.qbs_integrable_def fun_cong[OF hk(1),simplified]] + by(auto intro!: s_finite_kernel.integral_bind_kernel[OF hk(3) qs.mu_sets] simp: qbs_s_finite.qbs_integral_def[OF hk(4)]) + also have "... = (\r. (\\<^sub>Q y. g y\\Y, \, k r\\<^sub>s\<^sub>f\<^sub>i\<^sub>n) \\)" + by(auto intro!: Bochner_Integration.integral_cong simp: qbs_s_finite.qbs_integral_def[OF hk(4)]) + also have "... = ?rhs" + by(auto simp: hs(1) qs.qbs_integral_def fun_cong[OF hk(1),simplified comp_def]) + finally show "?lhs = ?rhs" . +qed + +lemma qbs_integral_bind_return: + assumes [qbs]:"s \ qbs_space (monadM_qbs Y)" "f \ Z \\<^sub>Q qbs_borel" "g \ Y \\<^sub>Q Z" + shows "qbs_integral (s \ (\y. return_qbs Z (g y))) f = qbs_integral s (f \ g)" +proof - + from rep_qbs_space_monadM[OF assms(1)] obtain \ \ + where hs: "s = \Y, \, \\\<^sub>s\<^sub>f\<^sub>i\<^sub>n" "qbs_s_finite Y \ \" by metis + then interpret qs: qbs_s_finite Y \ \ by simp + + have hb: "qbs_s_finite Z (g \ \) \" "s \ (\y. return_qbs Z (g y)) = \Z, g \ \, \\\<^sub>s\<^sub>f\<^sub>i\<^sub>n" + using qs.bind_qbs_s_finite[OF hs(1) _ qbs_morphism_Mx[OF assms(3) qs.in_Mx] prob_kernel.s_finite_kernel_prob_kernel return_qbs_comp[OF qbs_morphism_Mx[OF assms(3) qs.in_Mx],simplified comp_assoc[symmetric] comp_def[of _ g]],simplified prob_kernel_def'] + by(auto simp: qs.bind_qbs[OF hs(1) _ qbs_morphism_Mx[OF assms(3) qs.in_Mx] prob_kernel.s_finite_kernel_prob_kernel return_qbs_comp[OF qbs_morphism_Mx[OF assms(3) qs.in_Mx],simplified comp_assoc[symmetric] comp_def[of _ g]],simplified prob_kernel_def'] bind_kernel_return''[OF qs.mu_sets]) + show ?thesis + by(simp add: hb(2) qbs_s_finite.qbs_integral_def[OF hb(1)] qs.qbs_integral_def[simplified hs(1)[symmetric]]) +qed + +subsubsection \ Binary Product Measures\ +definition qbs_pair_measure :: "['a qbs_measure, 'b qbs_measure] \ ('a \ 'b) qbs_measure" (infix "\\<^sub>Q\<^sub>m\<^sub>e\<^sub>s" 80) where +qbs_pair_measure_def':"qbs_pair_measure p q \ (p \ (\x. q \ (\y. return_qbs (qbs_space_of p \\<^sub>Q qbs_space_of q) (x, y))))" + + +context pair_qbs_s_finites +begin + +interpretation rr : standard_borel_ne "borel \\<^sub>M borel :: (real \ real) measure" + by(auto intro!: pair_standard_borel_ne) + +lemma + shows qbs_pair_measure: "\X, \, \\\<^sub>s\<^sub>f\<^sub>i\<^sub>n \\<^sub>Q\<^sub>m\<^sub>e\<^sub>s \Y, \, \\\<^sub>s\<^sub>f\<^sub>i\<^sub>n = \X \\<^sub>Q Y, map_prod \ \ \ rr.from_real, distr (\ \\<^sub>M \) borel rr.to_real\\<^sub>s\<^sub>f\<^sub>i\<^sub>n" + and qbs_pair_measure_s_finite: "qbs_s_finite (X \\<^sub>Q Y) (map_prod \ \ \ rr.from_real) (distr (\ \\<^sub>M \) borel rr.to_real)" + by(simp_all add: qbs_pair_measure_def' pq1.qbs_l pq2.qbs_l qbs_bind_bind_return_pq qbs_s_finite_axioms) + +lemma qbs_l_qbs_pair_measure: + "qbs_l (\X, \, \\\<^sub>s\<^sub>f\<^sub>i\<^sub>n \\<^sub>Q\<^sub>m\<^sub>e\<^sub>s \Y, \, \\\<^sub>s\<^sub>f\<^sub>i\<^sub>n) = distr (\ \\<^sub>M \) (qbs_to_measure (X \\<^sub>Q Y)) (map_prod \ \)" + by(simp add: qbs_pair_measure qbs_s_finite.qbs_l[OF qbs_pair_measure_s_finite] distr_distr comp_assoc) + +lemma qbs_nn_integral_pair_measure: + assumes [qbs]:"f \ X \\<^sub>Q Y \\<^sub>Q qbs_borel" + shows "(\\<^sup>+\<^sub>Q z. f z \(\X, \, \\\<^sub>s\<^sub>f\<^sub>i\<^sub>n \\<^sub>Q\<^sub>m\<^sub>e\<^sub>s \Y, \, \\\<^sub>s\<^sub>f\<^sub>i\<^sub>n)) = (\\<^sup>+ z. (f \ map_prod \ \) z \(\ \\<^sub>M \))" + using assms by(simp add: qbs_nn_integral_def2 qbs_pair_measure distr_distr comp_assoc nn_integral_distr lr_adjunction_correspondence) + +lemma qbs_integral_pair_measure: + assumes [qbs]:"f \ X \\<^sub>Q Y \\<^sub>Q qbs_borel" + shows "(\\<^sub>Q z. f z \(\X, \, \\\<^sub>s\<^sub>f\<^sub>i\<^sub>n \\<^sub>Q\<^sub>m\<^sub>e\<^sub>s \Y, \, \\\<^sub>s\<^sub>f\<^sub>i\<^sub>n)) = (\ z. (f \ map_prod \ \) z \(\ \\<^sub>M \))" + using assms by(simp add: qbs_integral_def2 qbs_pair_measure distr_distr comp_assoc integral_distr lr_adjunction_correspondence) + +lemma qbs_pair_measure_integrable_eq: + "qbs_integrable (\X, \, \\\<^sub>s\<^sub>f\<^sub>i\<^sub>n \\<^sub>Q\<^sub>m\<^sub>e\<^sub>s \Y, \, \\\<^sub>s\<^sub>f\<^sub>i\<^sub>n) f \ f \ X \\<^sub>Q Y \\<^sub>Q qbs_borel \ integrable (\ \\<^sub>M \) (f \ (map_prod \ \))" (is "?h \ ?h1 \ ?h2") +proof safe + assume h: ?h + show ?h1 + by(auto intro!: qbs_integrable_morphism_dest[OF _ h] simp: qbs_pair_measure_def') + have 1:"integrable (distr (\ \\<^sub>M \) borel (to_real_on (borel \\<^sub>M borel))) (f \ (map_prod \ \ \ from_real_into (borel \\<^sub>M borel)))" + using h[simplified qbs_pair_measure] by(simp add: qbs_integrable_def[of f] comp_def[of f]) + have "integrable (\ \\<^sub>M \) (\x. (f \ (map_prod \ \ \ from_real_into (borel \\<^sub>M borel))) (to_real_on (borel \\<^sub>M borel) x))" + by(intro integrable_distr[OF _ 1]) simp + thus ?h2 + by(simp add: comp_def) +next + assume h: ?h1 ?h2 + then show ?h + by(simp add: qbs_pair_measure qbs_integrable_def) (simp add: lr_adjunction_correspondence integrable_distr_eq[of rr.to_real "\ \\<^sub>M \" borel "\x. f (map_prod \ \ (rr.from_real x))"] comp_def) +qed + +end + +lemmas(in pair_qbs_probs) qbs_pair_measure_prob = qbs_prob_axioms + +context + fixes X Y p q + assumes p[qbs]:"p \ qbs_space (monadM_qbs X)" and q[qbs]:"q \ qbs_space (monadM_qbs Y)" +begin + +lemma qbs_pair_measure_def: "p \\<^sub>Q\<^sub>m\<^sub>e\<^sub>s q = p \ (\x. q \ (\y. return_qbs (X \\<^sub>Q Y) (x,y)))" + by(simp add: qbs_space_of_in[OF p] qbs_space_of_in[OF q] qbs_pair_measure_def') + +lemma qbs_pair_measure_def2: "p \\<^sub>Q\<^sub>m\<^sub>e\<^sub>s q = q \ (\y. p \ (\x. return_qbs (X \\<^sub>Q Y) (x,y)))" + by(simp add: bind_qbs_return_rotate qbs_pair_measure_def) + +lemma + assumes "f \ X \\<^sub>Q Y \\<^sub>Q monadM_qbs Z" + shows qbs_pair_bind_bind_return1':"q \ (\y. p \ (\x. f (x,y))) = p \\<^sub>Q\<^sub>m\<^sub>e\<^sub>s q \ f" + and qbs_pair_bind_bind_return2':"p \ (\x. q \ (\y. f (x,y))) = p \\<^sub>Q\<^sub>m\<^sub>e\<^sub>s q \ f" + by(simp_all add: qbs_bind_bind_return1[OF assms] qbs_bind_bind_return2[OF assms] bind_qbs_return_rotate qbs_pair_measure_def) + +lemma + assumes [qbs]:"f \ X \\<^sub>Q exp_qbs Y (monadM_qbs Z)" + shows qbs_pair_bind_bind_return1'': "q \ (\y. p \ (\x. f x y)) = p \\<^sub>Q\<^sub>m\<^sub>e\<^sub>s q \ (\x. f (fst x) (snd x))" + and qbs_pair_bind_bind_return2'': "p \ (\x. q \ (\y. f x y)) = p \\<^sub>Q\<^sub>m\<^sub>e\<^sub>s q \ (\x. f (fst x) (snd x))" + by(auto intro!: qbs_pair_bind_bind_return1'[where f="\x. f (fst x) (snd x)",simplified] qbs_pair_bind_bind_return2'[where f="\x. f (fst x) (snd x)",simplified] uncurry_preserves_morphisms) qbs + +lemma qbs_nn_integral_Fubini_fst: + assumes [qbs]:"f \ X \\<^sub>Q Y \\<^sub>Q qbs_borel" + shows "(\\<^sup>+\<^sub>Q x. \\<^sup>+\<^sub>Q y. f (x,y) \q \p) = (\\<^sup>+\<^sub>Q z. f z \(p \\<^sub>Q\<^sub>m\<^sub>e\<^sub>s q))" + (is "?lhs = ?rhs") +proof - + have "?lhs = (\\<^sup>+\<^sub>Q x. \\<^sup>+\<^sub>Q y. qbs_nn_integral (return_qbs (X \\<^sub>Q Y) (x, y)) f \q \p)" + by(auto intro!: qbs_nn_integral_cong p q simp: qbs_nn_integral_return) + also have "... = ?rhs" + by(auto intro!: qbs_nn_integral_cong[OF p] simp:qbs_nn_integral_bind[OF q _ assms] qbs_nn_integral_bind[OF p _ assms] qbs_pair_measure_def) + finally show ?thesis . +qed + +lemma qbs_nn_integral_Fubini_snd: + assumes [qbs]:"f \ X \\<^sub>Q Y \\<^sub>Q qbs_borel" + shows "(\\<^sup>+\<^sub>Q y. \\<^sup>+\<^sub>Q x. f (x,y) \p \q) = (\\<^sup>+\<^sub>Q z. f z \(p \\<^sub>Q\<^sub>m\<^sub>e\<^sub>s q))" (is "?lhs = ?rhs") +proof - + have "?lhs = (\\<^sup>+\<^sub>Q y. \\<^sup>+\<^sub>Q x. qbs_nn_integral (return_qbs (X \\<^sub>Q Y) (x, y)) f \p \q)" + by(auto intro!: qbs_nn_integral_cong p q simp: qbs_nn_integral_return) + also have "... = ?rhs" + by(auto intro!: qbs_nn_integral_cong[OF q] simp:qbs_nn_integral_bind[OF q _ assms] qbs_nn_integral_bind[OF p _ assms] qbs_pair_measure_def2) + finally show ?thesis . +qed + +lemma qbs_ennintegral_indep_mult: + assumes [qbs]: "f \ X \\<^sub>Q qbs_borel" "g \ Y \\<^sub>Q qbs_borel" + shows "(\\<^sup>+\<^sub>Q z. f (fst z) * g (snd z) \(p \\<^sub>Q\<^sub>m\<^sub>e\<^sub>s q)) = (\\<^sup>+\<^sub>Q x. f x \p) * (\\<^sup>+\<^sub>Q y. g y \q)" (is "?lhs = ?rhs") +proof - + have "?lhs = (\\<^sup>+\<^sub>Q x. \\<^sup>+\<^sub>Q y .f x * g y \q \p)" + using qbs_nn_integral_Fubini_fst[where f="\z. f (fst z) * g (snd z)"] by simp + also have "... = (\\<^sup>+\<^sub>Q x. f x * \\<^sup>+\<^sub>Q y . g y \q \p)" + by(simp add: qbs_nn_integral_cmult[OF q]) + also have "... = ?rhs" + by(simp add: qbs_nn_integral_cmult[OF p] ab_semigroup_mult_class.mult.commute[where b="qbs_nn_integral q g"]) + finally show ?thesis . +qed + +end + +lemma qbs_l_qbs_pair_measure: + assumes "standard_borel M" "standard_borel N" + defines "X \ measure_to_qbs M" and "Y \ measure_to_qbs N" + assumes [qbs]: "p \ qbs_space (monadM_qbs X)" "q \ qbs_space (monadM_qbs Y)" + shows "qbs_l (p \\<^sub>Q\<^sub>m\<^sub>e\<^sub>s q) = qbs_l p \\<^sub>M qbs_l q" +proof - + obtain \ \ \ \ + where hp: "p = \X, \, \\\<^sub>s\<^sub>f\<^sub>i\<^sub>n" "qbs_s_finite X \ \" + and hq: "q = \Y, \, \\\<^sub>s\<^sub>f\<^sub>i\<^sub>n" "qbs_s_finite Y \ \" + using rep_qbs_space_monadM assms(5,6) by meson + have 1:"sets (qbs_to_measure (X \\<^sub>Q Y)) = sets (M \\<^sub>M N)" + by(auto simp: r_preserves_product[symmetric] X_def Y_def intro!: standard_borel.lr_sets_ident pair_standard_borel assms) + have "qbs_l (p \\<^sub>Q\<^sub>m\<^sub>e\<^sub>s q) = qbs_l p \\<^sub>k qbs_l \ (\x. q \ (\y. return_qbs (X \\<^sub>Q Y) (x,y)))" + by(auto simp: qbs_pair_measure_def[of p X q Y] intro!: qbs_l_bind_qbs[of _ X _ "X \\<^sub>Q Y"]) + also have "... = qbs_l p \\<^sub>k (\x. qbs_l (q \ (\y. return_qbs (X \\<^sub>Q Y) (x, y))))" + by(simp add: comp_def) + also have "... = qbs_l p \\<^sub>k (\x. qbs_l q \\<^sub>k qbs_l \ (\y. return_qbs (X \\<^sub>Q Y) (x, y)))" + by(auto intro!: bind_kernel_cong_All qbs_l_bind_qbs[of _ "Y" _ "X \\<^sub>Q Y"] simp: space_qbs_l_in[OF assms(5)]) + also have "... = qbs_l p \\<^sub>k (\x. qbs_l q \\<^sub>k (\y. return (qbs_to_measure (X \\<^sub>Q Y)) (x, y)))" + by(auto simp: comp_def space_qbs_l_in[OF assms(6)] space_qbs_l_in[OF assms(5)] qbs_l_return_qbs intro!: bind_kernel_cong_All) + also have "... = qbs_l p \\<^sub>k (\x. qbs_l q \\<^sub>k (\y. return (M \\<^sub>M N) (x, y)))" + by(simp add: return_cong[OF 1]) + also have "... = qbs_l p \\<^sub>k (\x. qbs_l q \\<^sub>k (\y. return (qbs_l p \\<^sub>M qbs_l q) (x, y)))" + by(auto cong: return_cong sets_pair_measure_cong simp: sets_qbs_l[OF assms(5)] standard_borel.lr_sets_ident[OF assms(1)] sets_qbs_l[OF assms(6)] standard_borel.lr_sets_ident[OF assms(2)] X_def Y_def) + also have "... = qbs_l p \\<^sub>M qbs_l q" + by(auto intro!: pair_measure_eq_bind_s_finite[symmetric] qbs_l_s_finite.s_finite_measure_axioms) + finally show ?thesis . +qed + +lemma qbs_pair_measure_morphism[qbs]: "qbs_pair_measure \ monadM_qbs X \\<^sub>Q monadM_qbs Y \\<^sub>Q monadM_qbs (X \\<^sub>Q Y)" + by(rule curry_preserves_morphisms,rule qbs_morphism_cong'[where f="(\(p,q). (p \ (\x. q \ (\y. return_qbs (X \\<^sub>Q Y) (x, y)))))"]) (auto simp: pair_qbs_space qbs_pair_measure_def) + +lemma qbs_pair_measure_morphismP: + "qbs_pair_measure \ monadP_qbs X \\<^sub>Q monadP_qbs Y \\<^sub>Q monadP_qbs (X \\<^sub>Q Y)" +proof - + note [qbs] = return_qbs_morphismP bind_qbs_morphismP + show ?thesis + by(rule curry_preserves_morphisms,rule qbs_morphism_cong'[where f="(\(p,q). (p \ (\x. q \ (\y. return_qbs (X \\<^sub>Q Y) (x, y)))))"]) (auto simp: pair_qbs_space qbs_pair_measure_def[OF qbs_space_monadPM qbs_space_monadPM]) +qed + +lemma qbs_nn_integral_indep1: + assumes [qbs]:"p \ qbs_space (monadM_qbs X)" "q \ qbs_space (monadP_qbs X)" "f \ X \\<^sub>Q qbs_borel" + shows "(\\<^sup>+\<^sub>Q z. f (fst z) \(p \\<^sub>Q\<^sub>m\<^sub>e\<^sub>s q)) = (\\<^sup>+\<^sub>Q x. f x \p)" +proof - + obtain Y \ \ where hq: + "q = \Y, \, \\\<^sub>s\<^sub>f\<^sub>i\<^sub>n" "qbs_prob Y \ \" + using rep_qbs_space_monadP[OF assms(2)] by blast + then interpret qbs_prob Y \ \ by simp + show ?thesis + by(simp add: qbs_nn_integral_const_prob[OF in_space_monadP] qbs_nn_integral_Fubini_snd[OF assms(1) in_space_monadM,symmetric] hq(1)) +qed + +lemma qbs_nn_integral_indep2: + assumes [qbs]:"q \ qbs_space (monadM_qbs Y)" "p \ qbs_space (monadP_qbs X)" "f \ Y \\<^sub>Q qbs_borel" + shows "(\\<^sup>+\<^sub>Q z. f (snd z) \(p \\<^sub>Q\<^sub>m\<^sub>e\<^sub>s q)) = (\\<^sup>+\<^sub>Q y. f y \q)" +proof - + obtain X \ \ where hp: + "p = \X, \, \\\<^sub>s\<^sub>f\<^sub>i\<^sub>n" "qbs_prob X \ \" + using rep_qbs_space_monadP[OF assms(2)] by metis + then interpret qbs_prob X \ \ by simp + show ?thesis + by(simp add: qbs_nn_integral_const_prob[OF in_space_monadP] qbs_nn_integral_Fubini_snd[OF in_space_monadM assms(1),symmetric] hp(1)) +qed + + +context +begin + +interpretation rr : standard_borel_ne "borel \\<^sub>M borel :: (real \ real) measure" + by(auto intro!: pair_standard_borel_ne) + +lemma qbs_integrable_pair_swap: + assumes "qbs_integrable (p \\<^sub>Q\<^sub>m\<^sub>e\<^sub>s q) f" + shows "qbs_integrable (q \\<^sub>Q\<^sub>m\<^sub>e\<^sub>s p) (\(x,y). f (y,x))" +proof - + obtain X \ \ Y \ \ + where hp: "p = \X, \, \\\<^sub>s\<^sub>f\<^sub>i\<^sub>n" "qbs_s_finite X \ \" + and hq: "q = \Y, \, \\\<^sub>s\<^sub>f\<^sub>i\<^sub>n" "qbs_s_finite Y \ \" + using rep_qbs_s_finite_measure by meson + interpret p1: pair_qbs_s_finites X \ \ Y \ \ + by(simp add: pair_qbs_s_finites_def hq hp) + interpret p2: pair_qbs_s_finites Y \ \ X \ \ + by(simp add: pair_qbs_s_finites_def hq hp) + show ?thesis + using assms by(auto simp: hp(1) hq(1) p1.qbs_pair_measure p2.qbs_pair_measure p1.qbs_integrable_def p2.qbs_integrable_def) + (auto simp add: integrable_distr_eq lr_adjunction_correspondence qbs_Mx_is_morphisms map_prod_def split_beta' intro!:integrable_product_swap_iff_s_finite[OF p1.pq2.s_finite_measure_axioms p1.pq1.s_finite_measure_axioms,THEN iffD1]) +qed + +lemma qbs_integrable_pair1': + assumes [qbs]:"p \ qbs_space (monadM_qbs X)" + "q \ qbs_space (monadM_qbs Y)" + "f \ X \\<^sub>Q Y \\<^sub>Q qbs_borel" + "qbs_integrable p (\x. \\<^sub>Q y. norm (f (x,y)) \q)" + and "AE\<^sub>Q x in p. qbs_integrable q (\y. f (x,y))" + shows "qbs_integrable (p \\<^sub>Q\<^sub>m\<^sub>e\<^sub>s q) f" +proof - + obtain \ \ \ \ + where hp: "p = \X, \, \\\<^sub>s\<^sub>f\<^sub>i\<^sub>n" "qbs_s_finite X \ \" + and hq: "q = \Y, \, \\\<^sub>s\<^sub>f\<^sub>i\<^sub>n" "qbs_s_finite Y \ \" + using rep_qbs_space_monadM assms(1,2) by meson + then interpret pqs: pair_qbs_s_finites X \ \ Y \ \ + by(simp add: pair_qbs_s_finites_def) + have [measurable]: "f \ borel_measurable (qbs_to_measure (X \\<^sub>Q Y))" + by(simp add: lr_adjunction_correspondence[symmetric]) + show ?thesis + using assms(4) pqs.pq1.AEq_AE[OF assms(5)[simplified hp(1)]] + by(auto simp add: pqs.qbs_integrable_def pqs.qbs_pair_measure hp(1) hq(1) integrable_distr_eq pqs.pq2.qbs_integrable_def pqs.pq1.qbs_integrable_def pqs.pq2.qbs_integral_def intro!: s_finite_measure.Fubini_integrable' pqs.pq2.s_finite_measure_axioms) +qed + +lemma + assumes "qbs_integrable (p \\<^sub>Q\<^sub>m\<^sub>e\<^sub>s q) f" + shows qbs_integrable_pair1D1': "qbs_integrable p (\x. \\<^sub>Q y. f (x,y) \q)" (is ?g1) + and qbs_integrable_pair1D1_norm': "qbs_integrable p (\x. \\<^sub>Q y. norm (f (x,y)) \q)" (is ?g2) + and qbs_integrable_pair1D2': "AE\<^sub>Q x in p. qbs_integrable q (\y. f (x,y))" (is ?g3) + and qbs_integrable_pair2D1': "qbs_integrable q (\y. \\<^sub>Q x. f (x,y) \p)" (is ?g4) + and qbs_integrable_pair2D1_norm': "qbs_integrable q (\y. \\<^sub>Q x. norm (f (x,y)) \p)" (is ?g5) + and qbs_integrable_pair2D2': "AE\<^sub>Q y in q. qbs_integrable p (\x. f (x,y))" (is ?g6) + and qbs_integral_Fubini_fst': "(\\<^sub>Q x. \\<^sub>Q y. f (x,y) \q \p) = (\\<^sub>Q z. f z \(p \\<^sub>Q\<^sub>m\<^sub>e\<^sub>s q))" (is ?g7) + and qbs_integral_Fubini_snd': "(\\<^sub>Q y. \\<^sub>Q x. f (x,y) \p \q) = (\\<^sub>Q z. f z \(p \\<^sub>Q\<^sub>m\<^sub>e\<^sub>s q))" (is ?g8) +proof - + obtain X \ \ Y \ \ + where hp: "p = \X, \, \\\<^sub>s\<^sub>f\<^sub>i\<^sub>n" "qbs_s_finite X \ \" + and hq: "q = \Y, \, \\\<^sub>s\<^sub>f\<^sub>i\<^sub>n" "qbs_s_finite Y \ \" + by (meson rep_qbs_space_of) + then interpret pqs: pair_qbs_s_finites X \ \ Y \ \ + by(simp add: pair_qbs_s_finites_def) + have [qbs]:"p \ qbs_space (monadM_qbs X)" "q \ qbs_space (monadM_qbs Y)" + by(simp_all add: hp hq) + note qbs_pair_measure_morphism[qbs] + have f[qbs]:"f \ X \\<^sub>Q Y \\<^sub>Q qbs_borel" + by(auto intro!: qbs_integrable_morphism_dest[OF _ assms]) + have [measurable]: "f \ borel_measurable (qbs_to_measure (X \\<^sub>Q Y))" + by(simp add: lr_adjunction_correspondence[symmetric]) + show ?g1 ?g2 ?g4 ?g5 + using assms + by(auto simp: hp(1) hq(1) pqs.qbs_integrable_def pqs.qbs_pair_measure integrable_distr_eq pqs.pq1.qbs_integrable_def pqs.pq2.qbs_integrable_def pqs.pq2.qbs_integral_def pqs.pq1.qbs_integral_def intro!: Bochner_Integration.integrable_cong[where g="\r. \\<^sub>Q y. f (\ r, y) \\Y, \, \\\<^sub>s\<^sub>f\<^sub>i\<^sub>n" and f="\x. \ y. f (\ x, \ y) \\" and N0=\,THEN iffD1] Bochner_Integration.integrable_cong[where g="\r. \\<^sub>Q x. f (x, \ r) \\X, \, \\\<^sub>s\<^sub>f\<^sub>i\<^sub>n" and f="\y. \ x. f (\ x, \ y) \\" and N0=\,THEN iffD1]) + (auto intro!: pqs.pq2.integrable_fst''[of \] integrable_snd_s_finite[OF pqs.pq1.s_finite_measure_axioms pqs.pq2.s_finite_measure_axioms] simp: map_prod_def split_beta') + show ?g3 ?g6 + using assms + by(auto simp: hp(1) pqs.pq1.AEq_AE_iff hq(1) pqs.pq2.AEq_AE_iff pqs.qbs_integrable_def pqs.qbs_pair_measure integrable_distr_eq) + (auto simp: pqs.pq1.qbs_integrable_def pqs.pq2.qbs_integrable_def map_prod_def split_beta' intro!: pqs.pq2.AE_integrable_fst'' AE_integrable_snd_s_finite[OF pqs.pq1.s_finite_measure_axioms pqs.pq2.s_finite_measure_axioms]) + show ?g7 ?g8 + using assms + by(auto simp: hp(1) hq(1) pqs.qbs_integrable_def pqs.qbs_pair_measure pqs.qbs_integral_def pqs.pq1.qbs_integral_def pqs.pq2.qbs_integral_def integral_distr integrable_distr_eq) + (auto simp: map_prod_def split_beta' intro!: pqs.pq2.integral_fst'''[of \ "\x. f (\ (fst x),\ (snd x))",simplified] integral_snd_s_finite[OF pqs.pq1.s_finite_measure_axioms pqs.pq2.s_finite_measure_axioms,of "\x y. f (\ x, \ y)",simplified split_beta']) +qed + +end + +lemma + assumes h:"qbs_integrable (p \\<^sub>Q\<^sub>m\<^sub>e\<^sub>s q) (case_prod f)" + shows qbs_integrable_pair1D1: "qbs_integrable p (\x. \\<^sub>Q y. f x y \q)" + and qbs_integrable_pair1D1_norm: "qbs_integrable p (\x. \\<^sub>Q y. norm (f x y) \q)" + and qbs_integrable_pair1D2: "AE\<^sub>Q x in p. qbs_integrable q (\y. f x y)" + and qbs_integrable_pair2D1: "qbs_integrable q (\y. \\<^sub>Q x. f x y \p)" + and qbs_integrable_pair2D1_norm: "qbs_integrable q (\y. \\<^sub>Q x. norm (f x y) \p)" + and qbs_integrable_pair2D2: "AE\<^sub>Q y in q. qbs_integrable p (\x. f x y)" + and qbs_integral_Fubini_fst: "(\\<^sub>Q x. \\<^sub>Q y. f x y \q \p) = (\\<^sub>Q (x,y). f x y \(p \\<^sub>Q\<^sub>m\<^sub>e\<^sub>s q))" (is ?g7) + and qbs_integral_Fubini_snd: "(\\<^sub>Q y. \\<^sub>Q x. f x y \p \q) = (\\<^sub>Q (x,y). f x y \(p \\<^sub>Q\<^sub>m\<^sub>e\<^sub>s q))" (is ?g8) + using qbs_integrable_pair1D1'[OF h] qbs_integrable_pair1D1_norm'[OF h] qbs_integrable_pair1D2'[OF h] qbs_integral_Fubini_fst'[OF h] + qbs_integrable_pair2D1'[OF h] qbs_integrable_pair2D1_norm'[OF h] qbs_integrable_pair2D2'[OF h] qbs_integral_Fubini_snd'[OF h] + by simp_all + +lemma qbs_integrable_pair2': + assumes "p \ qbs_space (monadM_qbs X)" + "q \ qbs_space (monadM_qbs Y)" + "f \ X \\<^sub>Q Y \\<^sub>Q qbs_borel" + "qbs_integrable q (\y. \\<^sub>Q x. norm (f (x,y)) \p)" + and "AE\<^sub>Q y in q. qbs_integrable p (\x. f (x,y))" + shows "qbs_integrable (p \\<^sub>Q\<^sub>m\<^sub>e\<^sub>s q) f" + using qbs_integrable_pair_swap[OF qbs_integrable_pair1'[OF assms(2,1) qbs_morphism_pair_swap[OF assms(3)],simplified],OF assms(4,5)] + by simp + +lemma qbs_integrable_indep_mult: + fixes f :: "_ \ _::{real_normed_div_algebra,second_countable_topology}" + assumes "qbs_integrable p f" "qbs_integrable q g" + shows "qbs_integrable (p \\<^sub>Q\<^sub>m\<^sub>e\<^sub>s q) (\x. f (fst x) * g (snd x))" +proof - + obtain X \ \ Y \ \ + where hp: "p = \X, \, \\\<^sub>s\<^sub>f\<^sub>i\<^sub>n" "qbs_s_finite X \ \" + and hq: "q = \Y, \, \\\<^sub>s\<^sub>f\<^sub>i\<^sub>n" "qbs_s_finite Y \ \" + by (meson rep_qbs_space_of) + then interpret pqs: pair_qbs_s_finites X \ \ Y \ \ + by(simp add: pair_qbs_s_finites_def) + have [qbs]:"f \ X \\<^sub>Q qbs_borel" "g \ Y \\<^sub>Q qbs_borel" "p \ qbs_space (monadM_qbs X)" "q \ qbs_space (monadM_qbs Y)" + by(auto intro!: qbs_integrable_morphism_dest assms simp:hp hq) + show ?thesis + by(auto intro!: qbs_integrable_pair1'[of _ X _ Y] qbs_integrable_mult_left qbs_integrable_norm assms(1) AEq_I2[of _ X] simp: norm_mult qbs_integrable_mult_right[OF assms(2)]) +qed + +lemma qbs_integrable_indep1: + fixes f :: "_ \ _::{real_normed_div_algebra,second_countable_topology}" + assumes "qbs_integrable p f" "q \ qbs_space (monadP_qbs Y)" + shows "qbs_integrable (p \\<^sub>Q\<^sub>m\<^sub>e\<^sub>s q) (\x. f (fst x))" + using qbs_integrable_indep_mult[OF assms(1) qbs_integrable_const[OF assms(2),of 1]] by simp + +lemma qbs_integral_indep1: + fixes f :: "_ \ _::{real_normed_div_algebra,second_countable_topology}" + assumes "qbs_integrable p f" "q \ qbs_space (monadP_qbs Y)" + shows "(\\<^sub>Q z. f (fst z) \(p \\<^sub>Q\<^sub>m\<^sub>e\<^sub>s q)) = (\\<^sub>Q x. f x \p)" + using qbs_integral_Fubini_snd'[OF qbs_integrable_indep1[OF assms]] + by(simp add: qbs_integral_const_prob[OF assms(2)]) + +lemma qbs_integrable_indep2: + fixes g :: "_ \ _::{real_normed_div_algebra,second_countable_topology}" + assumes "qbs_integrable q g" "p \ qbs_space (monadP_qbs X)" + shows "qbs_integrable (p \\<^sub>Q\<^sub>m\<^sub>e\<^sub>s q) (\x. g (snd x))" + using qbs_integrable_pair_swap[OF qbs_integrable_indep1[OF assms]] + by(simp add: split_beta') + +lemma qbs_integral_indep2: + fixes g :: "_ \ _::{real_normed_div_algebra,second_countable_topology}" + assumes "qbs_integrable q g" "p \ qbs_space (monadP_qbs X)" + shows "(\\<^sub>Q z. g (snd z) \(p \\<^sub>Q\<^sub>m\<^sub>e\<^sub>s q)) = (\\<^sub>Q y. g y \q)" + using qbs_integral_Fubini_fst'[OF qbs_integrable_indep2[OF assms]] + by(simp add: qbs_integral_const_prob[OF assms(2)]) + +lemma qbs_integral_indep_mult1: + fixes f and g:: "_ \ _::{real_normed_field,second_countable_topology}" + assumes "p \ qbs_space (monadP_qbs X)" "q \ qbs_space (monadP_qbs Y)" + and "qbs_integrable p f" "qbs_integrable q g" + shows "(\\<^sub>Q z. f (fst z) * g (snd z) \(p \\<^sub>Q\<^sub>m\<^sub>e\<^sub>s q)) = (\\<^sub>Q x. f x \p) * (\\<^sub>Q y. g y \q)" + using qbs_integral_Fubini_fst'[OF qbs_integrable_indep_mult[OF assms(3,4)]] + by simp + +lemma qbs_integral_indep_mult2: + fixes f and g:: "_ \ _::{real_normed_field,second_countable_topology}" + assumes "p \ qbs_space (monadP_qbs X)" "q \ qbs_space (monadP_qbs Y)" + and "qbs_integrable p f" "qbs_integrable q g" + shows "(\\<^sub>Q z. g (snd z) * f (fst z) \(p \\<^sub>Q\<^sub>m\<^sub>e\<^sub>s q)) = (\\<^sub>Q y. g y \q) * (\\<^sub>Q x. f x \p)" + using qbs_integral_indep_mult1[OF assms] by(simp add: mult.commute) + +subsubsection \ The Inverse Function of $l$\ +definition qbs_l_inverse :: "'a measure \ 'a qbs_measure" where + "qbs_l_inverse M \ \measure_to_qbs M, from_real_into M, distr M borel (to_real_on M)\\<^sub>s\<^sub>f\<^sub>i\<^sub>n" + +context standard_borel_ne +begin + +lemma qbs_l_inverse_def2: + assumes [measurable_cong]: "sets \ = sets M" + and "s_finite_measure \" + shows "qbs_l_inverse \ = \measure_to_qbs M, from_real, distr \ borel to_real\\<^sub>s\<^sub>f\<^sub>i\<^sub>n" +proof - + interpret s: standard_borel_ne \ + using assms standard_borel_ne_axioms standard_borel_ne_sets by blast + have [measurable]: "s.from_real \ borel \\<^sub>M M" + using assms(1) measurable_cong_sets s.from_real_measurable by blast + show ?thesis + by(auto simp: distr_distr qbs_l_inverse_def qbs_s_finite_eq_def qbs_s_finite_def in_Mx_def qbs_Mx_R qbs_s_finite_axioms_def intro!: qbs_s_finite_measure_eq s_finite_measure.s_finite_measure_distr assms cong: measure_to_qbs_cong_sets[OF assms(1)]) (auto intro!: distr_cong simp: sets_eq_imp_space_eq[OF assms(1)]) +qed + +lemma + assumes [measurable_cong]:"sets \ = sets M" + shows qbs_l_inverse_s_finite: "s_finite_measure \ \ qbs_s_finite (measure_to_qbs M) from_real (distr \ borel to_real)" + and qbs_l_inverse_qbs_prob: "prob_space \ \ qbs_prob (measure_to_qbs M) from_real (distr \ borel to_real)" + by(auto simp: qbs_s_finite_def qbs_prob_def in_Mx_def qbs_s_finite_axioms_def real_distribution_def real_distribution_axioms_def qbs_Mx_R intro!: s_finite_measure.s_finite_measure_distr prob_space.prob_space_distr) + +corollary + assumes [measurable_cong]:"sets \ = sets M" + shows qbs_l_inverse_in_space_monadM: "s_finite_measure \ \ qbs_l_inverse \ \ qbs_space (monadM_qbs M)" + and qbs_l_inverse_in_space_monadP: "prob_space \ \ qbs_l_inverse \ \ qbs_space (monadP_qbs M)" + by(auto simp: qbs_l_inverse_def2[OF assms(1)] qbs_l_inverse_def2[OF assms(1) prob_space.s_finite_measure_prob] assms intro!: qbs_s_finite.in_space_monadM[OF qbs_l_inverse_s_finite] qbs_prob.in_space_monadP[OF qbs_l_inverse_qbs_prob]) + +lemma qbs_l_qbs_l_inverse: + assumes [measurable_cong]: "sets \ = sets M" "s_finite_measure \" + shows "qbs_l (qbs_l_inverse \) = \" +proof - + interpret qbs_s_finite "measure_to_qbs M" from_real "distr \ borel to_real" + by(auto intro!: qbs_l_inverse_s_finite assms) + show ?thesis + using distr_id'[OF assms(1),simplified sets_eq_imp_space_eq[OF assms(1)]] + by(auto simp: qbs_l qbs_l_inverse_def2[OF assms] distr_distr cong: distr_cong) +qed + +corollary qbs_l_qbs_l_inverse_prob: + "sets \ = sets M \ prob_space \ \ qbs_l (qbs_l_inverse \) = \" + by(auto intro!: qbs_l_qbs_l_inverse prob_space.s_finite_measure_prob) + +lemma qbs_l_inverse_qbs_l: + assumes "s \ qbs_space (monadM_qbs (measure_to_qbs M))" + shows "qbs_l_inverse (qbs_l s) = s" +proof - + from rep_qbs_space_monadM[OF assms] obtain \ \ where h: + "s = \measure_to_qbs M, \, \\\<^sub>s\<^sub>f\<^sub>i\<^sub>n" "qbs_s_finite (measure_to_qbs M) \ \" + by metis + then interpret qs:qbs_s_finite "measure_to_qbs M" \ \ by simp + have [simp]: "distr \ (qbs_to_measure (measure_to_qbs M)) \ = distr \ M \" + by(simp cong: distr_cong) + interpret s: standard_borel_ne "distr \ M \" + by(rule standard_borel_ne_sets[of M]) (auto simp: standard_borel_ne_axioms) + have [measurable]: "s.from_real \ borel \\<^sub>M M" "\ \ \ \\<^sub>M M" + using qs.\_measurable[simplified measurable_cong_sets[OF refl lr_sets_ident]] + by(auto simp: s.from_real_measurable[simplified measurable_cong_sets[OF refl sets_distr]]) + interpret pqs:pair_qbs_s_finite "measure_to_qbs M" s.from_real "distr \ borel (s.to_real \ \)" \ \ + by(auto simp: pair_qbs_s_finite_def h) (auto simp: qbs_s_finite_def in_Mx_def qs.s_finite_measure_axioms qbs_s_finite_axioms_def qbs_Mx_R intro!: s_finite_measure.s_finite_measure_distr) + show ?thesis + by(auto simp add: h(1) qs.qbs_l qbs_l_inverse_def distr_distr cong: measure_to_qbs_cong_sets intro!: pqs.qbs_s_finite_measure_eq) + (insert qbs_Mx_to_X[of _ "measure_to_qbs M"], auto simp: comp_def qbs_space_R) +qed + +corollary qbs_l_inverse_qbs_l_prob: + assumes "s \ qbs_space (monadP_qbs (measure_to_qbs M))" + shows "qbs_l_inverse (qbs_l s) = s" + by(auto intro!: qbs_l_inverse_qbs_l qbs_space_monadPM assms) + +lemma s_finite_kernel_qbs_morphism: + assumes "s_finite_kernel N M k" + shows "(\x. qbs_l_inverse (k x)) \ measure_to_qbs N \\<^sub>Q monadM_qbs (measure_to_qbs M)" +proof - + interpret sfin: s_finite_kernel N M k by fact + have "\measure_to_qbs M, from_real, distr (k x) borel to_real\\<^sub>s\<^sub>f\<^sub>i\<^sub>n = qbs_l_inverse (k x)" if x:"x \ space N" for x + proof - + note sfin.kernel_sets[OF x,simp, measurable_cong] + then interpret skx: standard_borel_ne "k x" + using standard_borel_ne_axioms standard_borel_ne_sets by blast + interpret pqs: pair_qbs_s_finite "measure_to_qbs M" from_real "distr (k x) borel to_real" skx.from_real "distr (k x) borel skx.to_real" + using skx.from_real_measurable[simplified measurable_cong_sets[OF refl sfin.kernel_sets[OF x]]] + by(auto simp: pair_qbs_s_finite_def qbs_s_finite_def in_Mx_def qbs_Mx_R qbs_s_finite_axioms_def sfin.image_s_finite_measure[OF x] intro!: s_finite_measure.s_finite_measure_distr) + show ?thesis + by(auto simp: qbs_l_inverse_def distr_distr cong: measure_to_qbs_cong_sets intro!: pqs.qbs_s_finite_measure_eq) (auto intro!: distr_cong simp: sfin.kernel_space[OF x]) + qed + moreover have "(\x. \measure_to_qbs M, from_real, distr (k x) borel to_real\\<^sub>s\<^sub>f\<^sub>i\<^sub>n) \ measure_to_qbs N \\<^sub>Q monadM_qbs (measure_to_qbs M)" + proof(rule qbs_morphismI) + fix \ :: "real \ _" + assume "\ \ qbs_Mx (measure_to_qbs N)" + then have [measurable]: "\ \ borel \\<^sub>M N" + by(simp add: qbs_Mx_R) + show "(\x. \measure_to_qbs M, from_real, distr (k x) borel to_real\\<^sub>s\<^sub>f\<^sub>i\<^sub>n) \ \ \ qbs_Mx (monadM_qbs (measure_to_qbs M))" + by(auto simp: monadM_qbs_Mx qbs_Mx_R intro!: exI[where x=from_real] exI[where x="\x. distr (k (\ x)) borel to_real"] s_finite_kernel.comp_measurable[OF sfin.distr_s_finite_kernel]) + qed + ultimately show ?thesis + by(rule qbs_morphism_cong'[of "measure_to_qbs N",simplified qbs_space_R]) +qed + +lemma prob_kernel_qbs_morphism: + assumes [measurable]:"k \ N \\<^sub>M prob_algebra M" + shows "(\x. qbs_l_inverse (k x)) \ measure_to_qbs N \\<^sub>Q monadP_qbs (measure_to_qbs M)" +proof(safe intro!: qbs_morphism_monadPI' s_finite_kernel_qbs_morphism prob_kernel.s_finite_kernel_prob_kernel) + fix x + assume "x \ qbs_space (measure_to_qbs N)" + then have "x \ space N" by(simp add: qbs_space_R) + from measurable_space[OF assms this] + have [measurable_cong, simp]: "sets (k x) = sets M" and p:"prob_space (k x)" + by(auto simp: space_prob_algebra) + then interpret s: standard_borel_ne "k x" + using standard_borel_ne_axioms standard_borel_ne_sets by blast + show "qbs_l_inverse (k x) \ qbs_space (monadP_qbs (measure_to_qbs M))" + using s.qbs_l_inverse_in_space_monadP[OF refl p] by(simp cong: measure_to_qbs_cong_sets) +qed(simp add: prob_kernel_def') + +lemma qbs_l_inverse_return: + assumes "x \ space M" + shows "qbs_l_inverse (return M x) = return_qbs (measure_to_qbs M) x" +proof - + interpret s: standard_borel_ne "return M x" + by(rule standard_borel_ne_sets[of M]) (auto simp: standard_borel_ne_axioms) + show ?thesis + using s.qbs_l_inverse_in_space_monadP[OF refl prob_space_return[OF assms]] + by(auto intro!: inj_onD[OF qbs_l_inj_P[of "measure_to_qbs M"]] return_cong qbs_l_inverse_in_space_monadP qbs_morphism_space[OF return_qbs_morphismP[of "measure_to_qbs M"]] assms simp: s.qbs_l_qbs_l_inverse_prob[OF refl prob_space_return[OF assms]] qbs_l_return_qbs[of _ M,simplified qbs_space_R,OF assms] qbs_space_R cong: measure_to_qbs_cong_sets) +qed + +lemma qbs_l_inverse_bind_kernel: + assumes "standard_borel_ne N" "s_finite_measure M" "s_finite_kernel M N k" + shows "qbs_l_inverse (M \\<^sub>k k) = qbs_l_inverse M \ (\x. qbs_l_inverse (k x))" (is "?lhs = ?rhs") +proof - + interpret sfin: s_finite_kernel M N k by fact + interpret s: standard_borel_ne N by fact + have sets[simp,measurable_cong]:"sets (M \\<^sub>k k) = sets N" + by(auto intro!: sets_bind_kernel[OF _ space_ne] simp: sfin.kernel_sets) + then interpret s2: standard_borel_ne "M \\<^sub>k k" + using s.standard_borel_ne_axioms standard_borel_ne_sets by blast + have [measurable]: "s2.from_real \ borel \\<^sub>M N" + using measurable_cong_sets s2.from_real_measurable sets by blast + have comp1:"(\x. qbs_l_inverse (k x)) \ from_real = (\r. \measure_to_qbs N, s.from_real, distr (k (from_real r)) borel s.to_real\\<^sub>s\<^sub>f\<^sub>i\<^sub>n)" + proof + fix r + have setskfr[measurable_cong, simp]: "sets (k (from_real r)) = sets N" + by(auto intro!: sfin.kernel_sets measurable_space[OF from_real_measurable]) + then interpret s3: standard_borel_ne "k (from_real r)" + using s.standard_borel_ne_axioms standard_borel_ne_sets by blast + have [measurable]: "s3.from_real \ borel \\<^sub>M N" + using measurable_cong_sets s3.from_real_measurable setskfr by blast + show "((\x. qbs_l_inverse (k x)) \ from_real) r = \measure_to_qbs N, s.from_real, distr (k (from_real r)) borel s.to_real\\<^sub>s\<^sub>f\<^sub>i\<^sub>n " + by(auto simp: qbs_l_inverse_def qbs_s_finite_eq_def qbs_s_finite_def in_Mx_def qbs_s_finite_axioms_def qbs_Mx_R distr_distr measurable_space[OF from_real_measurable] cong: measure_to_qbs_cong_sets intro!: sfin.image_s_finite_measure s_finite_measure.s_finite_measure_distr qbs_s_finite_measure_eq) (auto intro!: distr_cong simp: sets_eq_imp_space_eq[OF setskfr]) + qed + have "?lhs = \measure_to_qbs (M \\<^sub>k k), s2.from_real, distr (M \\<^sub>k k) borel s2.to_real\\<^sub>s\<^sub>f\<^sub>i\<^sub>n" + by(simp add: qbs_l_inverse_def) + also have "... = \measure_to_qbs N, s.from_real, distr (M \\<^sub>k k) borel s.to_real\\<^sub>s\<^sub>f\<^sub>i\<^sub>n" + by(auto cong: measure_to_qbs_cong_sets intro!: qbs_s_finite_measure_eq distr_cong s_finite_measure.s_finite_measure_distr sfin.comp_s_finite_measure assms(2) simp: qbs_s_finite_eq_def qbs_s_finite_def qbs_s_finite_axioms_def in_Mx_def qbs_Mx_R distr_distr sets_eq_imp_space_eq[OF sets]) + also have "... = \measure_to_qbs N, s.from_real, M \\<^sub>k (\x. distr (k x) borel s.to_real)\\<^sub>s\<^sub>f\<^sub>i\<^sub>n" + by(simp add: sfin.distr_bind_kernel[OF space_ne refl]) + also have "... = \measure_to_qbs N, s.from_real, distr M borel to_real \\<^sub>k (\r. distr (k (from_real r)) borel s.to_real)\\<^sub>s\<^sub>f\<^sub>i\<^sub>n" + proof - + have "M \\<^sub>k (\x. distr (k x) borel s.to_real) = M \\<^sub>k (\x. distr (k (from_real (to_real x))) borel s.to_real)" + by(auto intro!: bind_kernel_cong_All) + also have "... = distr M borel to_real \\<^sub>k (\r. distr (k (from_real r)) borel s.to_real)" + by(auto intro!: measure_kernel.bind_kernel_distr[symmetric,where Y=borel] space_ne measure_kernel.distr_measure_kernel[where Y=N] sfin.measure_kernel_comp) + finally show ?thesis by simp + qed + also have "... = ?rhs" + by(auto intro!: qbs_s_finite.bind_qbs[OF qbs_l_inverse_s_finite[OF refl assms(2)] _ s.s_finite_kernel_qbs_morphism[OF assms(3)] _ _ comp1,symmetric] s_finite_kernel.distr_s_finite_kernel[OF sfin.comp_measurable] simp: qbs_Mx_R) (simp add: qbs_l_inverse_def) + finally show ?thesis . +qed + +lemma qbs_l_inverse_bind: + assumes "standard_borel_ne N" "s_finite_measure M" "k \ M \\<^sub>M prob_algebra N" + shows "qbs_l_inverse (M \ k) = qbs_l_inverse M \ (\x. qbs_l_inverse (k x))" + by(auto simp: bind_kernel_bind[OF measurable_prob_algebraD[OF assms(3)],symmetric] prob_kernel_def' intro!: qbs_l_inverse_bind_kernel assms prob_kernel.s_finite_kernel_prob_kernel) + +end + +subsubsection \ PMF and SPMF \ +definition "qbs_pmf \ (\p. qbs_l_inverse (measure_pmf p))" +definition "qbs_spmf \ (\p. qbs_l_inverse (measure_spmf p))" + +declare [[coercion qbs_pmf]] + +lemma qbs_pmf_qbsP: + fixes p :: "(_ :: countable) pmf" + shows "qbs_pmf p \ qbs_space (monadP_qbs (count_space\<^sub>Q UNIV))" + by(auto simp: qbs_pmf_def measure_to_qbs_cong_sets[of "count_space UNIV" "measure_pmf p",simplified] intro!: standard_borel_ne.qbs_l_inverse_in_space_monadP measure_pmf.prob_space_axioms) + +lemma qbs_pmf_qbs[qbs]: + fixes p :: "(_ :: countable) pmf" + shows "qbs_pmf p \ qbs_space (monadM_qbs (count_space\<^sub>Q UNIV))" + by (simp add: qbs_pmf_qbsP qbs_space_monadPM) + +lemma qbs_spmf_qbs[qbs]: + fixes q :: "(_ :: countable) spmf" + shows "qbs_spmf q \ qbs_space (monadM_qbs (count_space\<^sub>Q UNIV))" + by(auto simp: qbs_spmf_def measure_to_qbs_cong_sets[of "count_space UNIV" "measure_spmf q",simplified] intro!: standard_borel_ne.qbs_l_inverse_in_space_monadM subprob_space.s_finite_measure_subprob) + +lemma [simp]: + fixes p :: "(_ :: countable) pmf" and q :: "(_ :: countable) spmf" + shows qbs_l_qbs_pmf: "qbs_l (qbs_pmf p) = measure_pmf p" + and qbs_l_qbs_spmf: "qbs_l (qbs_spmf q) = measure_spmf q" + by(auto simp: qbs_pmf_def qbs_spmf_def intro!: standard_borel_ne.qbs_l_qbs_l_inverse subprob_space.s_finite_measure_subprob measure_pmf.subprob_space_axioms) + +lemma qbs_pmf_return_pmf: + fixes x :: "_ :: countable" + shows "qbs_pmf (return_pmf x) = return_qbs (count_space\<^sub>Q UNIV) x" +proof - + note return_qbs_morphismP[qbs] + show ?thesis + by(auto intro!: inj_onD[OF qbs_l_inj_P[where X="count_space\<^sub>Q UNIV"]] return_cong qbs_pmf_qbsP simp: qbs_l_return_qbs return_pmf.rep_eq) +qed + +lemma qbs_pmf_bind_pmf: + fixes p :: "('a :: countable) pmf" and f :: "'a \ ('b :: countable) pmf" + shows "qbs_pmf (p \ f) = qbs_pmf p \ (\x. qbs_pmf (f x))" + by(auto simp: measure_pmf_bind qbs_pmf_def space_prob_algebra measure_pmf.prob_space_axioms intro!: standard_borel_ne.qbs_l_inverse_bind[where N="count_space UNIV"] prob_space.s_finite_measure_prob) + +lemma qbs_pair_pmf: + fixes p :: "('a :: countable) pmf" and q :: "('b :: countable) pmf" + shows "qbs_pmf p \\<^sub>Q\<^sub>m\<^sub>e\<^sub>s qbs_pmf q = qbs_pmf (pair_pmf p q)" +proof(rule inj_onD[OF qbs_l_inj_P[of "count_space\<^sub>Q UNIV \\<^sub>Q count_space\<^sub>Q UNIV"]]) + show "qbs_l (qbs_pmf p \\<^sub>Q\<^sub>m\<^sub>e\<^sub>s qbs_pmf q) = qbs_l (qbs_pmf (pair_pmf p q))" + by(simp add: measure_pair_pmf qbs_l_qbs_pair_measure[OF standard_borel_ne.standard_borel standard_borel_ne.standard_borel,of "count_space UNIV" "count_space UNIV"]) +next + note [qbs] = qbs_pmf_qbsP qbs_pair_measure_morphismP + show "qbs_pmf p \\<^sub>Q\<^sub>m\<^sub>e\<^sub>s qbs_pmf q \ qbs_space (monadP_qbs (count_space\<^sub>Q UNIV \\<^sub>Q count_space\<^sub>Q UNIV))" "qbs_pmf (pair_pmf p q) \ qbs_space (monadP_qbs (count_space\<^sub>Q UNIV \\<^sub>Q count_space\<^sub>Q UNIV))" + by auto (simp add: qbs_count_space_prod) +qed + +subsubsection \ Density \ +lift_definition density_qbs :: "['a qbs_measure, 'a \ ennreal] \ 'a qbs_measure" +is "\(X,\,\) f. if f \ X \\<^sub>Q qbs_borel then (X, \, density \ (f \ \)) else (X, SOME a. a \ qbs_Mx X, null_measure borel)" +proof safe + fix X Y :: "'a quasi_borel" + fix \ \ \ \ and f :: "_ \ ennreal" + assume 1:"qbs_s_finite_eq (X, \, \) (Y, \, \)" + then interpret qs: pair_qbs_s_finite X \ \ \ \ + using qbs_s_finite_eq_dest[OF 1] by(simp add: pair_qbs_s_finite_def) + have [simp]:"(SOME a. a \ qbs_Mx X) \ qbs_Mx X" "(SOME a. a \ qbs_Mx Y) \ qbs_Mx X" + using qs.pq1.in_Mx by(simp_all only: some_in_eq qbs_s_finite_eq_dest[OF 1]) blast+ + { + assume "f \ X \\<^sub>Q qbs_borel" + then have "qbs_s_finite_eq (X, \, density \ (f \ \)) (Y, \, density \ (f \ \))" + by(auto simp: qbs_s_finite_eq_def lr_adjunction_correspondence density_distr[symmetric] comp_def qbs_s_finite_eq_dest[OF 1] qbs_s_finite_def in_Mx_def qbs_s_finite_axioms_def qs.pq1.mu_sets qs.pq2.mu_sets AE_distr_iff intro!: qs.pq1.s_finite_measure_density qs.pq2.s_finite_measure_density) + } + moreover have "f \ X \\<^sub>Q qbs_borel \ f \ Y \\<^sub>Q qbs_borel \ qbs_s_finite_eq (X, \, density \ (f \ \)) (Y, (SOME a. a \ qbs_Mx Y), null_measure borel)" + "f \ X \\<^sub>Q qbs_borel \ f \ Y \\<^sub>Q qbs_borel \ qbs_s_finite_eq (X, (SOME a. a \ qbs_Mx X), null_measure borel) (Y, \, density \ (f \ \))" + "f \ X \\<^sub>Q qbs_borel \ f \ Y \\<^sub>Q qbs_borel \ qbs_s_finite_eq (X, (SOME a. a \ qbs_Mx X), null_measure borel) (Y, (SOME a. a \ qbs_Mx Y), null_measure borel)" + by(auto simp: qbs_s_finite_eq_dest[OF 1] qbs_s_finite_eq_def qbs_s_finite_def in_Mx_def qbs_s_finite_axioms_def distr_return null_measure_distr intro!: subprob_space.s_finite_measure_subprob subprob_spaceI) + ultimately show "qbs_s_finite_eq (if f \ X \\<^sub>Q borel\<^sub>Q then (X, \, density \ (f \ \)) else (X, SOME aa. aa \ qbs_Mx X, null_measure borel)) (if f \ Y \\<^sub>Q borel\<^sub>Q then (Y, \, density \ (f \ \)) else (Y, SOME a. a \ qbs_Mx Y, null_measure borel))" + by auto +qed + +lemma(in qbs_s_finite) + assumes "f \ X \\<^sub>Q qbs_borel" + shows density_qbs:"density_qbs \X,\, \\\<^sub>s\<^sub>f\<^sub>i\<^sub>n f = \X, \, density \ (f \ \)\\<^sub>s\<^sub>f\<^sub>i\<^sub>n" + and density_qbs_s_finite: "qbs_s_finite X \ (density \ (f \ \))" + using assms by(auto simp: density_qbs.abs_eq qbs_s_finite_def in_Mx_def lr_adjunction_correspondence qbs_s_finite_axioms_def mu_sets AE_distr_iff intro!: s_finite_measure_density) + +lemma density_qbs_density_qbs_eq: + assumes [qbs]:"s \ qbs_space (monadM_qbs X)" "f \ X \\<^sub>Q qbs_borel" "g \ X \\<^sub>Q qbs_borel" + shows "density_qbs (density_qbs s f) g = density_qbs s (\x. f x * g x)" +proof - + from rep_qbs_space_monadM[OF assms(1)] obtain \ \ + where hs: "s = \X, \, \\\<^sub>s\<^sub>f\<^sub>i\<^sub>n" "qbs_s_finite X \ \" by metis + then interpret qbs_s_finite X \ \ by simp + show ?thesis + using assms(2,3) by(simp add: hs(1) density_qbs[OF assms(2)] qbs_s_finite.density_qbs[OF density_qbs_s_finite[OF assms(2)] assms(3)] density_qbs lr_adjunction_correspondence density_density_eq) (simp add: comp_def) +qed + +lemma qbs_l_density_qbs: + assumes "s \ qbs_space (monadM_qbs X)" "f \ X \\<^sub>Q qbs_borel" + shows "qbs_l (density_qbs s f) = density (qbs_l s) f" +proof - + from rep_qbs_space_monadM[OF assms(1)] + obtain \ \ where s: "s = \X, \, \\\<^sub>s\<^sub>f\<^sub>i\<^sub>n" "qbs_s_finite X \ \" + by metis + then interpret qbs_s_finite X \ \ by simp + show ?thesis + using assms(2) by(simp add: s(1) qbs_l qbs_s_finite.density_qbs[OF s(2) assms(2)] qbs_s_finite.qbs_l[OF qbs_s_finite.density_qbs_s_finite[OF s(2) assms(2)]] density_distr lr_adjunction_correspondence) (simp add: comp_def) +qed + +corollary qbs_l_density_qbs_indicator: + assumes [qbs]:"s \ qbs_space (monadM_qbs X)" "qbs_pred X P" + shows "qbs_l (density_qbs s (indicator {x\qbs_space X. P x})) (qbs_space X) = qbs_l s {x\qbs_space X. P x} " +proof - + have 1[measurable]: "{x \ qbs_space X. P x} \ sets (qbs_to_measure X)" + by (metis qbs_pred_iff_sets space_L assms(2)) + have 2[qbs]: "indicator {x \ qbs_space X. P x} \ X \\<^sub>Q qbs_borel" + by(rule indicator_qbs_morphism'') qbs + show ?thesis + using assms(2) by(auto simp: qbs_l_density_qbs[of _ X] emeasure_density[of "indicator {x\space (qbs_to_measure X). P x}" "qbs_l s",OF _ sets.top,simplified measurable_qbs_l'[OF assms(1)],OF borel_measurable_indicator[OF predE],simplified space_L space_qbs_l_in[OF assms(1)]] qbs_pred_iff_measurable_pred nn_set_integral_space[of "qbs_l s",simplified space_qbs_l_in[OF assms(1)]] nn_integral_indicator[of _ "qbs_l s",simplified sets_qbs_l[OF assms(1)]]) +qed + +lemma qbs_nn_integral_density_qbs: + assumes [qbs]:"s \ qbs_space (monadM_qbs X)" "f \ X \\<^sub>Q qbs_borel" "g \ X \\<^sub>Q qbs_borel" + shows "(\\<^sup>+\<^sub>Q x. g x \(density_qbs s f)) = (\\<^sup>+\<^sub>Q x. f x * g x \s)" + by(auto simp: qbs_nn_integral_def2_l qbs_l_density_qbs[of _ X] measurable_qbs_l'[OF assms(1)] lr_adjunction_correspondence[symmetric] intro!:nn_integral_density) + +lemma qbs_integral_density_qbs: + fixes g :: "'a \ 'b::{banach, second_countable_topology}" and f :: "'a \ real" + assumes [qbs]:"s \ qbs_space (monadM_qbs X)" "f \ X \\<^sub>Q qbs_borel" "g \ X \\<^sub>Q qbs_borel" + and "AE\<^sub>Q x in s. f x \ 0" + shows "(\\<^sub>Q x. g x \(density_qbs s f)) = (\\<^sub>Q x. f x *\<^sub>R g x \s)" + using assms(4) by(auto simp: qbs_integral_def2_l qbs_l_density_qbs[of _ X] measurable_qbs_l'[OF assms(1)] lr_adjunction_correspondence[symmetric] AEq_qbs_l intro!: integral_density) + +lemma density_qbs_morphism[qbs]: "density_qbs \ monadM_qbs X \\<^sub>Q (X \\<^sub>Q qbs_borel) \\<^sub>Q monadM_qbs X" +proof(rule curry_preserves_morphisms[OF pair_qbs_morphismI]) + fix \ and \ :: "_ \ _ \ ennreal" + assume h:"\ \ qbs_Mx (monadM_qbs X)" "\ \ qbs_Mx (X \\<^sub>Q qbs_borel)" + hence [qbs]: "\ \ qbs_borel \\<^sub>Q monadM_qbs X" "\ \ qbs_borel \\<^sub>Q X \\<^sub>Q qbs_borel" + by(simp_all add: qbs_Mx_is_morphisms) + from rep_qbs_Mx_monadM[OF h(1)] obtain \ k where hk: + "\ = (\r. \X, \, k r\\<^sub>s\<^sub>f\<^sub>i\<^sub>n)" "\ \ qbs_Mx X" "s_finite_kernel borel borel k" "\r. qbs_s_finite X \ (k r)" + by metis + then interpret a: in_Mx X \ by(simp add: in_Mx_def) + have [measurable]: "(\(x, y). \ x (\ y)) \ borel_measurable (borel \\<^sub>M borel)" + proof - + have "(\(x, y). \ x (\ y)) \ qbs_borel \\<^sub>Q qbs_borel \\<^sub>Q qbs_borel" + by simp + thus ?thesis + by(simp add: lr_adjunction_correspondence qbs_borel_prod borel_prod) + qed + have [simp]:"density_qbs (\ r) (\ r) = \X, \, density (k r) (\ r \ \)\\<^sub>s\<^sub>f\<^sub>i\<^sub>n " for r + using hk(4) by(auto simp add: hk(1) density_qbs.abs_eq[OF qbs_s_finite.qbs_s_finite_eq_refl[OF hk(4)]]) + show "(\r. density_qbs (fst (\ r,\ r)) (snd (\ r,\ r))) \ qbs_Mx (monadM_qbs X)" + by(auto simp: monadM_qbs_Mx comp_def intro!: exI[where x=\] exI[where x="\r. density (k r) (\ r \ \)"] s_finite_kernel.density_s_finite_kernel[OF hk(3)]) +qed + +lemma density_qbs_cong_AE: + assumes [qbs]: "s \ qbs_space (monadM_qbs X)" "f \ X \\<^sub>Q qbs_borel" "g \ X \\<^sub>Q qbs_borel" + and "AE\<^sub>Q x in s. f x = g x" + shows "density_qbs s f = density_qbs s g" +proof(rule inj_onD[OF qbs_l_inj[of X]]) + show "qbs_l (density_qbs s f) = qbs_l (density_qbs s g)" + using assms(4) by(auto simp: qbs_l_density_qbs[of _ X] measurable_qbs_l'[OF assms(1)] AEq_qbs_l lr_adjunction_correspondence[symmetric] intro!: density_cong) +qed simp_all + +corollary density_qbs_cong: + assumes [qbs]: "s \ qbs_space (monadM_qbs X)" "f \ X \\<^sub>Q qbs_borel" "g \ X \\<^sub>Q qbs_borel" + and "\x. x \ qbs_space X \ f x = g x" + shows "density_qbs s f = density_qbs s g" + by(auto intro!: density_qbs_cong_AE[of _ X] AEq_I2[of _ X] assms(4)) + +lemma density_qbs_1[simp]: "density_qbs s (\x. 1) = s" +proof - + obtain X where s[qbs]: "s \ qbs_space (monadM_qbs X)" + using in_qbs_space_of by blast + show ?thesis + by(auto intro!: inj_onD[OF qbs_l_inj _ _ s] simp: qbs_l_density_qbs[of _ X] density_1) +qed + +lemma pair_density_qbs: + assumes [qbs]: "p \ qbs_space (monadM_qbs X)" "q \ qbs_space (monadM_qbs Y)" + and [qbs]: "f \ X \\<^sub>Q qbs_borel" "g \ Y \\<^sub>Q qbs_borel" + shows "density_qbs p f \\<^sub>Q\<^sub>m\<^sub>e\<^sub>s density_qbs q g = density_qbs (p \\<^sub>Q\<^sub>m\<^sub>e\<^sub>s q) (\(x,y). f x * g y)" +proof(safe intro!: qbs_measure_eqI[of _ "X \\<^sub>Q Y"]) + fix h :: "_ \ ennreal" + assume h[qbs]:"h \ X \\<^sub>Q Y \\<^sub>Q borel\<^sub>Q" + show "(\\<^sup>+\<^sub>Q z. h z \(density_qbs p f \\<^sub>Q\<^sub>m\<^sub>e\<^sub>s density_qbs q g)) = (\\<^sup>+\<^sub>Q z. h z \(density_qbs (p \\<^sub>Q\<^sub>m\<^sub>e\<^sub>s q) (\(x, y). f x * g y)))" (is "?lhs = ?rhs") + proof - + have "?lhs = (\\<^sup>+\<^sub>Q x. \\<^sup>+\<^sub>Q y. h (x, y) \density_qbs q g \density_qbs p f)" + by(simp add: qbs_nn_integral_Fubini_fst[of _ X _ Y]) + also have "... = (\\<^sup>+\<^sub>Q x. \\<^sup>+\<^sub>Q y. g y * h (x, y) \q \density_qbs p f)" + by(auto intro!: qbs_nn_integral_cong[of _ X] simp: qbs_nn_integral_density_qbs[of _ Y]) + also have "... = ?rhs" + by(auto simp add: qbs_nn_integral_density_qbs[of _ X] qbs_nn_integral_density_qbs[of _ "X \\<^sub>Q Y"] split_beta' qbs_nn_integral_Fubini_fst[of _ X _ Y,symmetric] qbs_nn_integral_cmult[of _ Y] mult.assoc intro!: qbs_nn_integral_cong[of _ X]) + finally show ?thesis . + qed +qed simp_all + +subsubsection \ Normalization \ +definition normalize_qbs :: "'a qbs_measure \ 'a qbs_measure" where +"normalize_qbs s \ (let X = qbs_space_of s; + r = qbs_l s (qbs_space X) in + if r \ 0 \ r \ \ then density_qbs s (\x. 1 / r) + else qbs_null_measure X)" + +lemma + assumes "s \ qbs_space (monadM_qbs X)" + shows normalize_qbs: "qbs_l s (qbs_space X) \ 0 \ qbs_l s (qbs_space X) \ \ \ normalize_qbs s = density_qbs s (\x. 1 / emeasure (qbs_l s) (qbs_space X))" + and normalize_qbs0: "qbs_l s (qbs_space X) = 0 \ normalize_qbs s = qbs_null_measure X" + and normalize_qbsinfty: "qbs_l s (qbs_space X) = \ \ normalize_qbs s = qbs_null_measure X" + by(auto simp: qbs_space_of_in[OF assms(1)] normalize_qbs_def) + +lemma normalize_qbs_prob: + assumes "s \ qbs_space (monadM_qbs X)" "qbs_l s (qbs_space X) \ 0" "qbs_l s (qbs_space X) \ \" + shows "normalize_qbs s \ qbs_space (monadP_qbs X)" + unfolding normalize_qbs[OF assms] +proof - + obtain \ \ + where hs: "s = \X, \, \\\<^sub>s\<^sub>f\<^sub>i\<^sub>n" "qbs_s_finite X \ \" + using rep_qbs_space_monadM assms(1) by meson + interpret qs: qbs_s_finite X \ \ by fact + have "density_qbs s (\x. 1 / emeasure (qbs_l s) (qbs_space X)) = density_qbs \X, \, \\\<^sub>s\<^sub>f\<^sub>i\<^sub>n (\x. 1 / emeasure (qbs_l s) (qbs_space X))" + by(simp add: hs) + also have "... \ qbs_space (monadP_qbs X)" + by(auto simp add: qs.density_qbs monadP_qbs_space qbs_s_finite.qbs_l[OF qs.density_qbs_s_finite,of "\x. 1 / emeasure (qbs_l s) (qbs_space X)",simplified] qbs_s_finite.qbs_space_of[OF qs.density_qbs_s_finite,of "\x. 1 / emeasure (qbs_l s) (qbs_space X)",simplified] intro!: prob_space.prob_space_distr, auto intro!: prob_spaceI simp: emeasure_density) + (insert assms(2,3),auto simp: hs qs.qbs_l emeasure_distr emeasure_distr[of _ _ "qbs_to_measure X",OF _ sets.top,simplified space_L] divide_eq_1_ennreal ennreal_divide_times) + finally show "density_qbs s (\x. 1 / emeasure (qbs_l s) (qbs_space X)) \ qbs_space (monadP_qbs X)" . +qed + +lemma normalize_qbs_morphism[qbs]: "normalize_qbs \ monadM_qbs X \\<^sub>Q monadM_qbs X" +proof - + have "(if emeasure (qbs_l s) (qbs_space X) \ 0 \ emeasure (qbs_l s) (qbs_space X) \ \ then density_qbs s (\x. 1 / emeasure (qbs_l s) (qbs_space X)) else qbs_null_measure X) = normalize_qbs s" (is "?f s = _") if s:"s \ qbs_space (monadM_qbs X)" for s + by(simp add: qbs_space_of_in[OF s] normalize_qbs_def) + moreover have "(\s. ?f s) \ monadM_qbs X \\<^sub>Q monadM_qbs X" + proof(cases "qbs_space X = {}") + case True + then show ?thesis + by(simp add: qbs_morphism_from_empty monadM_qbs_empty_iff[of X]) + next + case X:False + have [qbs]:"(\s. emeasure (qbs_l s) (qbs_space X)) \ monadM_qbs X \\<^sub>Q qbs_borel" + by(rule qbs_l_morphism[OF sets.top[of "qbs_to_measure X",simplified space_L]]) + have [qbs]: "qbs_null_measure X \ qbs_space (monadM_qbs X)" + by(auto intro!: qbs_null_measure_in_Mx X) + have [qbs]: "(\s x. 1 / emeasure (qbs_l s) (qbs_space X)) \ monadM_qbs X \\<^sub>Q X \\<^sub>Q qbs_borel" + by(rule arg_swap_morphism) simp + show ?thesis + by qbs + qed + ultimately show ?thesis + by(simp cong: qbs_morphism_cong) +qed + +lemma normalize_qbs_morphismP: + assumes [qbs]:"s \ X \\<^sub>Q monadM_qbs Y" + and "\x. x \ qbs_space X \ qbs_l (s x) (qbs_space Y) \ 0" "\x. x \ qbs_space X \ qbs_l (s x) (qbs_space Y) \ \" + shows "(\x. normalize_qbs (s x)) \ X \\<^sub>Q monadP_qbs Y" + by(rule qbs_morphism_monadPI'[OF normalize_qbs_prob]) (use assms(2,3) qbs_morphism_space[OF assms(1)] in auto) + +lemma normalize_qbs_monadP_ident: + assumes "s \ qbs_space (monadP_qbs X)" + shows "normalize_qbs s = s" + using normalize_qbs[OF qbs_space_monadPM[OF assms]] prob_space.emeasure_space_1[OF qbs_l_prob_space[OF assms]] + by(auto simp: space_qbs_l_in[OF qbs_space_monadPM[OF assms]] intro!: inj_onD[OF qbs_l_inj_P _ _ assms]) + +corollary normalize_qbs_idenpotent: "normalize_qbs (normalize_qbs s) = normalize_qbs s" +proof - + obtain X where s[qbs]: "s \ qbs_space (monadM_qbs X)" + using in_qbs_space_of by blast + then have X: "qbs_space X \ {}" + by (metis qbs_s_space_of_not_empty qbs_space_of_in) + then obtain x where x:"x \ qbs_space X" by auto + consider "qbs_l s (qbs_space X) = 0" | "qbs_l s (qbs_space X) = \" | "qbs_l s (qbs_space X) \ 0" "qbs_l s (qbs_space X) \ \" + by auto + then show ?thesis + proof cases + case 1 + then show ?thesis + using normalize_qbs0[OF qbs_null_measure_in_Mx[OF X]] + by(simp add: normalize_qbs0[OF s] qbs_null_measure_null_measure[OF X]) + next + case 2 + then show ?thesis + using normalize_qbs0[OF qbs_null_measure_in_Mx[OF X]] + by(simp add: normalize_qbsinfty[OF s] qbs_null_measure_null_measure[OF X]) + next + case 3 + have "normalize_qbs s \ qbs_space (monadP_qbs X)" + by(rule qbs_morphism_space[OF normalize_qbs_morphismP[of "\x. s"],of X X x]) (auto simp: 3 x) + then show ?thesis + by(simp add: normalize_qbs_monadP_ident) + qed +qed + +subsubsection \ Product Measures \ +definition PiQ_measure :: "['a set, 'a \ 'b qbs_measure] \ ('a \ 'b) qbs_measure" where +"PiQ_measure \ (\I si. if (\i\I. \Mi. standard_borel_ne Mi \ si i \ qbs_space (monadM_qbs (measure_to_qbs Mi))) + then if countable I \ (\i\I. prob_space (qbs_l (si i))) then qbs_l_inverse (\\<^sub>M i\I. qbs_l (si i)) + else if finite I \ (\i\I. sigma_finite_measure (qbs_l (si i))) then qbs_l_inverse (\\<^sub>M i\I. qbs_l (si i)) + else qbs_null_measure (\\<^sub>Q i\I. qbs_space_of (si i)) + else qbs_null_measure (\\<^sub>Q i\I. qbs_space_of (si i)))" + +syntax + "_PiQ_measure" :: "pttrn \ 'i set \ 'a qbs_measure \ ('i => 'a) qbs_measure" ("(3\\<^sub>Q\<^sub>m\<^sub>e\<^sub>a\<^sub>s _\_./ _)" 10) +translations + "\\<^sub>Q\<^sub>m\<^sub>e\<^sub>a\<^sub>s x\I. X" == "CONST PiQ_measure I (\x. X)" + +context + fixes I and Mi + assumes standard_borel_ne:"\i. i \ I \ standard_borel_ne (Mi i)" +begin + +context + assumes countableI:"countable I" +begin + +interpretation sb:standard_borel_ne "\\<^sub>M i\I. (borel :: real measure)" + by (simp add: countableI product_standard_borel_ne) + +interpretation sbM: standard_borel_ne "\\<^sub>M i\I. Mi i" + by (simp add: countableI standard_borel_ne product_standard_borel_ne) + +lemma + assumes "\i. i \ I \ si i \ qbs_space (monadP_qbs (measure_to_qbs (Mi i)))" + and "\i. i \ I \ si i = \measure_to_qbs (Mi i), \ i, \ i\\<^sub>s\<^sub>f\<^sub>i\<^sub>n" "\i. i \ I \ qbs_prob (measure_to_qbs (Mi i)) (\ i) (\ i)" + shows PiQ_measure_prob_eq: "(\\<^sub>Q\<^sub>m\<^sub>e\<^sub>a\<^sub>s i\I. si i) = \measure_to_qbs (\\<^sub>M i\I. Mi i), sbM.from_real, distr (\\<^sub>M i\I. qbs_l (si i)) borel sbM.to_real\\<^sub>s\<^sub>f\<^sub>i\<^sub>n" (is "_ = ?rhs") + and PiQ_measure_qbs_prob: "qbs_prob (measure_to_qbs (\\<^sub>M i\I. Mi i)) sbM.from_real (distr (\\<^sub>M i\I. qbs_l (si i)) borel sbM.to_real)" (is "?qbsprob") +proof - + have [measurable_cong,simp]: "prob_space (\\<^sub>M i\I. qbs_l (si i))" "sets (\\<^sub>M i\I. qbs_l (si i)) = sets (\\<^sub>M i\I. Mi i)" + using sets_qbs_l[OF assms(1)[THEN qbs_space_monadPM]] standard_borel.lr_sets_ident[OF standard_borel_ne.standard_borel[OF standard_borel_ne]] + by(auto cong: sets_PiM_cong intro!: prob_space_PiM qbs_l_prob_space assms(1)) + show ?qbsprob + by(auto simp: pair_qbs_s_finite_def intro!: qbs_prob.qbs_s_finite sbM.qbs_l_inverse_qbs_prob) + have "(\\<^sub>Q\<^sub>m\<^sub>e\<^sub>a\<^sub>s i\I. si i) = qbs_l_inverse (\\<^sub>M i\I. qbs_l (si i))" + using countableI assms(1)[THEN qbs_space_monadPM] qbs_l_prob_space[OF assms(1)] standard_borel_ne by(auto simp: PiQ_measure_def) + also have "... = ?rhs" + by(auto intro!: sbM.qbs_l_inverse_def2 prob_space.s_finite_measure_prob cong: sets_PiM_cong[OF refl]) + finally show "(\\<^sub>Q\<^sub>m\<^sub>e\<^sub>a\<^sub>s i\I. si i) = ?rhs" . +qed + +lemma qbs_l_PiQ_measure_prob: + assumes "\i. i \ I \ si i \ qbs_space (monadP_qbs (measure_to_qbs (Mi i)))" + shows "qbs_l (\\<^sub>Q\<^sub>m\<^sub>e\<^sub>a\<^sub>s i\I. si i) = (\\<^sub>M i\I. qbs_l (si i))" +proof - + have "qbs_l (\\<^sub>Q\<^sub>m\<^sub>e\<^sub>a\<^sub>s i\I. si i) = qbs_l (qbs_l_inverse (\\<^sub>M i\I. qbs_l (si i)))" + using countableI assms(1)[THEN qbs_space_monadPM] qbs_l_prob_space[OF assms(1)] standard_borel_ne by(auto simp: PiQ_measure_def) + also have "... = (\\<^sub>M i\I. qbs_l (si i))" + using sets_qbs_l[OF assms(1)[THEN qbs_space_monadPM]] standard_borel.lr_sets_ident[OF standard_borel_ne.standard_borel[OF standard_borel_ne]] + by(auto intro!: sbM.qbs_l_qbs_l_inverse_prob prob_space_PiM qbs_l_prob_space[OF assms(1)] cong: sets_PiM_cong) + finally show ?thesis . +qed + +end + +context + assumes finI: "finite I" +begin + +interpretation sb:standard_borel_ne "\\<^sub>M i\I. (borel :: real measure)" + by (simp add: finI product_standard_borel_ne countable_finite) + +interpretation sbM: standard_borel_ne "\\<^sub>M i\I. Mi i" + by (simp add: countable_finite finI standard_borel_ne product_standard_borel_ne) + +lemma qbs_l_PiQ_measure: + assumes "\i. i \ I \ si i \ qbs_space (monadM_qbs (measure_to_qbs (Mi i)))" + and "\i. i \ I \ sigma_finite_measure (qbs_l (si i))" + shows "qbs_l (\\<^sub>Q\<^sub>m\<^sub>e\<^sub>a\<^sub>s i\I. si i) = (\\<^sub>M i\I. qbs_l (si i))" +proof - + have [simp]: "s_finite_measure (\\<^sub>M i\I. qbs_l (si i))" + proof - + have "(\\<^sub>M i\I. qbs_l (si i)) = (\\<^sub>M i\I. if i \ I then qbs_l (si i) else null_measure (count_space UNIV))" + by(simp cong: PiM_cong) + also have "s_finite_measure ..." + by(auto intro!: sigma_finite_measure.s_finite_measure product_sigma_finite.sigma_finite finI simp: product_sigma_finite_def assms(2)) (auto intro!: finite_measure.sigma_finite_measure finite_measureI) + finally show ?thesis . + qed + have "qbs_l (\\<^sub>Q\<^sub>m\<^sub>e\<^sub>a\<^sub>s i\I. si i) = qbs_l (qbs_l_inverse (\\<^sub>M i\I. qbs_l (si i)))" + using finI assms(1) assms(2) standard_borel_ne by(fastforce simp: PiQ_measure_def) + also have "... = (\\<^sub>M i\I. qbs_l (si i))" + using sets_qbs_l[OF assms(1)] standard_borel.lr_sets_ident[OF standard_borel_ne.standard_borel[OF standard_borel_ne]] + by(auto intro!: sbM.qbs_l_qbs_l_inverse prob_space_PiM cong: sets_PiM_cong) + finally show ?thesis . +qed + + +end + +end +subsection \Measures\ +subsubsection \ The Lebesgue Measure \ +definition lborel_qbs ("lborel\<^sub>Q") where "lborel_qbs \ qbs_l_inverse lborel" + +lemma lborel_qbs_qbs[qbs]: "lborel_qbs \ qbs_space (monadM_qbs qbs_borel)" + by(auto simp: lborel_qbs_def measure_to_qbs_cong_sets[OF sets_lborel,symmetric] intro!: standard_borel_ne.qbs_l_inverse_in_space_monadM lborel.s_finite_measure_axioms) + +lemma qbs_l_lborel_qbs[simp]: "qbs_l lborel\<^sub>Q = lborel" + by(auto intro!: standard_borel_ne.qbs_l_qbs_l_inverse lborel.s_finite_measure_axioms simp: lborel_qbs_def) + +corollary + shows qbs_integral_lborel: "(\\<^sub>Q x. f x \lborel_qbs) = (\x. f x \lborel)" + and qbs_nn_integral_lborel: "(\\<^sup>+\<^sub>Q x. f x \lborel_qbs) = (\\<^sup>+x. f x \lborel)" + by(simp_all add: qbs_integral_def2_l qbs_nn_integral_def2_l) + + +lemma(in standard_borel_ne) measure_with_args_morphism: + assumes "s_finite_kernel X M k" + shows "qbs_l_inverse \ k \ measure_to_qbs X \\<^sub>Q monadM_qbs (measure_to_qbs M)" +proof(safe intro!: qbs_morphismI) + fix \ :: "real \ _" + assume "\ \ qbs_Mx (measure_to_qbs X)" + then have h[measurable]:"\ \ borel \\<^sub>M X" + by(simp add: qbs_Mx_R) + interpret s:s_finite_kernel X M k by fact + have 1: "\r. sets (k (\ r)) = sets M" "\r. s_finite_measure (k (\ r))" + using measurable_space[OF h] s.kernel_sets by(auto intro!: s.image_s_finite_measure) + show "qbs_l_inverse \ k \ \ \ qbs_Mx (monadM_qbs (measure_to_qbs M))" + by(auto intro!: exI[where x=from_real] exI[where x="(\r. distr (k (\ r)) borel to_real)"] s_finite_kernel.comp_measurable[OF s_finite_kernel.distr_s_finite_kernel[OF assms]] simp: monadM_qbs_Mx qbs_Mx_R qbs_l_inverse_def2[OF 1] comp_def) +qed + +lemma(in standard_borel_ne) measure_with_args_morphismP: + assumes [measurable]:"\ \ X \\<^sub>M prob_algebra M" + shows "qbs_l_inverse \ \ \ measure_to_qbs X \\<^sub>Q monadP_qbs (measure_to_qbs M)" + by(rule qbs_morphism_monadPI'[OF _ measure_with_args_morphism]) + (insert measurable_space[OF assms], auto simp: qbs_space_R space_prob_algebra prob_kernel_def' intro!: qbs_l_inverse_in_space_monadP prob_kernel.s_finite_kernel_prob_kernel) + +subsubsection \ Counting Measure \ +abbreviation "counting_measure_qbs A \ qbs_l_inverse (count_space A)" + +lemma qbs_nn_integral_count_space_nat: + fixes f :: "nat \ ennreal" + shows "(\\<^sup>+\<^sub>Q i. f i \counting_measure_qbs UNIV) = (\i. f i)" + by(simp add: standard_borel_ne.qbs_l_qbs_l_inverse[OF _ refl sigma_finite_measure.s_finite_measure[OF sigma_finite_measure_count_space]] qbs_nn_integral_def2_l nn_integral_count_space_nat) + +subsubsection \ Normal Distribution \ +lemma qbs_normal_distribution_qbs: "(\\ \. density_qbs lborel\<^sub>Q (normal_density \ \)) \ qbs_borel \\<^sub>Q qbs_borel \\<^sub>Q monadM_qbs qbs_borel" + by simp + +lemma qbs_l_qbs_normal_distribution[simp]: "qbs_l (density_qbs lborel\<^sub>Q (normal_density \ \)) = density lborel (normal_density \ \)" + by(auto simp: qbs_l_density_qbs[of _ qbs_borel]) + +lemma qbs_normal_distribution_P: "\ > 0 \ density_qbs lborel\<^sub>Q (normal_density \ \) \ qbs_space (monadP_qbs qbs_borel)" + by(auto simp: monadP_qbs_def sub_qbs_space prob_space_normal_density) + +lemma qbs_normal_distribution_integral: + "(\\<^sub>Q x. f x \ (density_qbs lborel\<^sub>Q (normal_density \ \))) = (\ x. f x \ (density lborel (\x. ennreal (normal_density \ \ x))))" + by(auto simp: qbs_integral_def2_l) + +lemma qbs_normal_distribution_expectation: + assumes [measurable]:"f \ borel_measurable borel" and [arith]: "\ > 0" + shows "(\\<^sub>Q x. f x \ (density_qbs lborel\<^sub>Q (normal_density \ \))) = (\ x. normal_density \ \ x * f x \ lborel)" + by(simp add: qbs_normal_distribution_integral integral_real_density integral_density) + +lemma qbs_normal_posterior: + assumes [arith]: "\ > 0" "\' > 0" + shows "normalize_qbs (density_qbs (density_qbs lborel\<^sub>Q (normal_density \ \)) (normal_density \' \')) = density_qbs lborel\<^sub>Q (normal_density ((\ * \'\<^sup>2 + \' * \\<^sup>2) / (\\<^sup>2 + \'\<^sup>2)) (\ * \' / sqrt (\\<^sup>2 + \'\<^sup>2)))" (is "?lhs = ?rhs") +proof - + have 0: "\ * \' / sqrt (\\<^sup>2 + \'\<^sup>2) > 0" "sqrt (2 * pi * (\\<^sup>2 + \'\<^sup>2)) > 0" + by (simp_all add: power2_eq_square sum_squares_gt_zero_iff) + have 1:"qbs_l (density_qbs lborel\<^sub>Q (\x. ennreal (1 / sqrt (2 * pi * (\\<^sup>2 + \'\<^sup>2)) * exp (- ((\ - \')\<^sup>2 / (2 * \\<^sup>2 + 2 * \'\<^sup>2))) * normal_density ((\ * \'\<^sup>2 + \' * \\<^sup>2) / (\\<^sup>2 + \'\<^sup>2)) (\ * \' / sqrt (\\<^sup>2 + \'\<^sup>2)) x))) UNIV = ennreal (exp (- ((\ - \')\<^sup>2 / (2 * \\<^sup>2 + 2 * \'\<^sup>2))) / sqrt (2 * pi * (\\<^sup>2 + \'\<^sup>2)))" + using prob_space.emeasure_space_1[OF prob_space_normal_density[OF 0(1)]] by(auto simp add: qbs_l_density_qbs[of _ qbs_borel] emeasure_density ennreal_mult' nn_integral_cmult simp del: times_divide_eq_left) (simp add: ennreal_mult'[symmetric]) + have "?lhs = normalize_qbs (density_qbs lborel\<^sub>Q (\x. ennreal (1 / sqrt (2 * pi * (\\<^sup>2 + \'\<^sup>2)) * exp (- ((\ - \')\<^sup>2 / (2 * \\<^sup>2 + 2 * \'\<^sup>2))) * normal_density ((\ * \'\<^sup>2 + \' * \\<^sup>2) / (\\<^sup>2 + \'\<^sup>2)) (\ * \' / sqrt (\\<^sup>2 + \'\<^sup>2)) x)))" + by(simp add: density_qbs_density_qbs_eq[of _ qbs_borel] ennreal_mult'[symmetric] normal_density_times del: times_divide_eq_left) + also have "... = density_qbs (density_qbs lborel\<^sub>Q (\x. ennreal (1 / sqrt (2 * pi * (\\<^sup>2 + \'\<^sup>2)) * exp (- ((\ - \')\<^sup>2 / (2 * \\<^sup>2 + 2 * \'\<^sup>2))) * normal_density ((\ * \'\<^sup>2 + \' * \\<^sup>2) / (\\<^sup>2 + \'\<^sup>2)) (\ * \' / sqrt (\\<^sup>2 + \'\<^sup>2)) x))) (\x. 1 / emeasure (qbs_l (density_qbs lborel\<^sub>Q (\x. ennreal (1 / sqrt (2 * pi * (\\<^sup>2 + \'\<^sup>2)) * exp (- ((\ - \')\<^sup>2 / (2 * \\<^sup>2 + 2 * \'\<^sup>2))) * normal_density ((\ * \'\<^sup>2 + \' * \\<^sup>2) / (\\<^sup>2 + \'\<^sup>2)) (\ * \' / sqrt (\\<^sup>2 + \'\<^sup>2)) x)))) (qbs_space borel\<^sub>Q))" + by(rule normalize_qbs) (simp_all add: 1 del: times_divide_eq_left) + also have "... = ?rhs" + by(simp add: 1 density_qbs_density_qbs_eq[of _ qbs_borel] del: times_divide_eq_left, auto intro!: density_qbs_cong[of _ qbs_borel]) + (insert 0, auto simp: ennreal_1[symmetric] ennreal_mult'[symmetric] divide_ennreal normal_density_def simp del: ennreal_1) + finally show ?thesis . +qed + +subsubsection \ Uniform Distribution \ +definition uniform_qbs :: "'a qbs_measure \ 'a set \ 'a qbs_measure" where +"uniform_qbs \ (\s A. qbs_l_inverse (uniform_measure (qbs_l s) A))" + +lemma(in standard_borel_ne) qbs_l_uniform_qbs': + assumes "sets \ = sets M" "s_finite_measure \" "\ A \ 0" + shows "qbs_l (uniform_qbs (qbs_l_inverse \) A) = uniform_measure \ A" (is "?lhs = ?rhs") +proof - + have "?lhs = qbs_l (qbs_l_inverse (uniform_measure \ A))" + by(simp add: qbs_l_qbs_l_inverse[OF assms(1,2)] uniform_qbs_def) + also have "... = ?rhs" + proof(rule qbs_l_qbs_l_inverse) + consider "\ A = \" | "\ A \ \" by auto + then show "s_finite_measure (uniform_measure \ A)" + proof cases + case 1 + have A[measurable]: "A \ sets \" + using assms(3) emeasure_notin_sets by blast + have "uniform_measure \ A = density \ (\x. 0)" + by(auto simp: uniform_measure_def 1 intro!: density_cong) + also have "... = null_measure \" + by(simp add: null_measure_eq_density) + finally show ?thesis + by(auto intro!: finite_measure.s_finite_measure_finite_measure finite_measureI) + next + case 2 + show ?thesis + by(rule prob_space.s_finite_measure_prob[OF prob_space_uniform_measure[OF assms(3) 2]]) + qed + qed(simp add: assms) + finally show ?thesis . +qed + +corollary(in standard_borel_ne) qbs_l_uniform_qbs: + assumes "s \ qbs_space (monadM_qbs (measure_to_qbs M))" "qbs_l s A \ 0" + shows "qbs_l (uniform_qbs s A) = uniform_measure (qbs_l s) A" + by(simp add: qbs_l_uniform_qbs'[OF sets_qbs_l[OF assms(1),simplified lr_sets_ident] qbs_l_s_finite.s_finite_measure_axioms assms(2),symmetric] qbs_l_inverse_qbs_l[OF assms(1)]) + +lemma interval_uniform_qbs: "(\a b. uniform_qbs lborel\<^sub>Q {a<.. borel\<^sub>Q \\<^sub>Q borel\<^sub>Q \\<^sub>Q monadM_qbs borel\<^sub>Q" +proof(rule curry_preserves_morphisms) + have "(\xy. uniform_qbs lborel\<^sub>Q {fst xy<.. (\xy. uniform_measure lborel {fst xy<.. measure_to_qbs (borel \\<^sub>M borel) \\<^sub>Q monadM_qbs borel\<^sub>Q" + proof(safe intro!: standard_borel_ne.measure_with_args_morphism measure_kernel.s_finite_kernel_finite_bounded) + show "measure_kernel (borel \\<^sub>M borel) borel (\xy. uniform_measure lborel {fst xy<.. sets borel" + have [simp]:"emeasure lborel ({fst x<.. B) / emeasure lborel {fst x<.. snd x then emeasure lborel ({fst x<.. B) / ennreal (snd x - fst x) else 0)" for x + by auto + show "(\x. emeasure (uniform_measure lborel {fst x<.. borel_measurable (borel \\<^sub>M borel)" + by (simp, measurable) auto + qed auto + next + show "(a, b) \ space (borel \\<^sub>M borel) \ emeasure (uniform_measure lborel {fst (a, b)<.." for a b :: real + by(cases "a \ b") (use ennreal_divide_eq_top_iff top.not_eq_extremum in auto) + qed simp + finally show "(\xy. uniform_qbs lborel\<^sub>Q {fst xy<.. borel\<^sub>Q \\<^sub>Q borel\<^sub>Q \\<^sub>Q monadM_qbs borel\<^sub>Q" + by (simp add: borel_prod qbs_borel_prod) +qed + +context + fixes a b :: real + assumes [arith]:"a < b" +begin + +lemma qbs_uniform_distribution_expectation: + assumes "f \ qbs_borel \\<^sub>Q qbs_borel" + shows "(\\<^sup>+\<^sub>Q x. f x \uniform_qbs lborel\<^sub>Q {a<..\<^sup>+x \ {a<..lborel) / (b - a)" +proof - + have [measurable]: "f \ borel_measurable borel" + using assms qbs_Mx_is_morphisms qbs_Mx_qbs_borel by blast + show ?thesis + by(auto simp: qbs_nn_integral_def2_l standard_borel_ne.qbs_l_uniform_qbs[of borel lborel_qbs] nn_integral_uniform_measure) +qed + +end + +subsubsection \ Bernoulli Distribution \ +abbreviation qbs_bernoulli :: "real \ bool qbs_measure" where +"qbs_bernoulli \ (\x. qbs_pmf (bernoulli_pmf x))" + +lemma bernoulli_measurable: + "(\x. measure_pmf (bernoulli_pmf x)) \ borel \\<^sub>M prob_algebra (count_space UNIV)" +proof(rule measurable_prob_algebra_generated[where \=UNIV and G=UNIV]) + fix A :: "bool set" + have "A \ {True,False}" + by auto + then consider "A = {}" | "A = {True}" | "A = {False}" | "A = {False,True}" + by auto + thus "(\a. emeasure (measure_pmf (bernoulli_pmf a)) A) \ borel_measurable borel" + by(cases,simp_all add: emeasure_measure_pmf_finite bernoulli_pmf.rep_eq UNIV_bool[symmetric]) +qed (auto simp add: sets_borel_eq_count_space Int_stable_def measure_pmf.prob_space_axioms) + +lemma qbs_bernoulli_morphism: "qbs_bernoulli \ qbs_borel \\<^sub>Q monadP_qbs (qbs_count_space UNIV)" + using standard_borel_ne.measure_with_args_morphismP[OF _ bernoulli_measurable] + by (simp add: qbs_pmf_def comp_def) + +lemma qbs_bernoulli_expectation: + assumes [simp]: "0 \ p" "p \ 1" + shows "(\\<^sub>Q x. f x \qbs_bernoulli p) = f True * p + f False * (1 - p)" + by(simp add: qbs_integral_def2_l) + +end \ No newline at end of file diff --git a/thys/S_Finite_Measure_Monad/Montecarlo.thy b/thys/S_Finite_Measure_Monad/Montecarlo.thy new file mode 100644 --- /dev/null +++ b/thys/S_Finite_Measure_Monad/Montecarlo.thy @@ -0,0 +1,182 @@ +(* Title: Montecarlo.thy + Author: Michikazu Hirata, Tokyo Institute of Technology +*) + +section \ Examples\ +subsection \Montecarlo Approximation\ + +theory Montecarlo + imports "Monad_QuasiBorel" +begin + +declare [[coercion qbs_l]] + +abbreviation real_quasi_borel :: "real quasi_borel" ("\\<^sub>Q") where +"real_quasi_borel \ qbs_borel" +abbreviation nat_quasi_borel :: "nat quasi_borel" ("\\<^sub>Q") where +"nat_quasi_borel \ qbs_count_space UNIV" + + +primrec montecarlo :: "'a qbs_measure \ ('a \ real) \ nat \ real qbs_measure" where +"montecarlo _ _ 0 = return_qbs \\<^sub>Q 0" | +"montecarlo d h (Suc n) = do { m \ montecarlo d h n; + x \ d; + return_qbs \\<^sub>Q ((h x + m * (real n)) / (real (Suc n)))}" + +declare + bind_qbs_morphismP[qbs] + return_qbs_morphismP[qbs] + qbs_pair_measure_morphismP[qbs] + +lemma montecarlo_qbs_morphism[qbs]: "montecarlo \ qbs_space (monadP_qbs X \\<^sub>Q (X \\<^sub>Q \\<^sub>Q) \\<^sub>Q \\<^sub>Q \\<^sub>Q monadP_qbs \\<^sub>Q)" + by(simp add: montecarlo_def) + +(* integrability *) +lemma qbs_integrable_indep_mult2[simp, intro!]: + fixes f :: "_ \ real" + assumes "qbs_integrable p f" + and "qbs_integrable q g" + shows "qbs_integrable (p \\<^sub>Q\<^sub>m\<^sub>e\<^sub>s q) (\x. g (snd x) * f (fst x))" + using qbs_integrable_indep_mult[OF assms] by (simp add: mult.commute) + + +lemma montecarlo_integrable: + assumes [qbs]:"p \ qbs_space (monadP_qbs X)" "h \ X \\<^sub>Q \\<^sub>Q" "qbs_integrable p h" "qbs_integrable p (\x. h x * h x)" + shows "qbs_integrable (montecarlo p h n) (\x. x)" "qbs_integrable (montecarlo p h n) (\x. x * x)" +proof - + have "qbs_integrable (montecarlo p h n) (\x. x) \ qbs_integrable (montecarlo p h n) (\x. x * x)" + proof(induction n) + case 0 + then show ?case + by simp + next + case (Suc n) + hence 1[intro,simp]:"qbs_integrable (montecarlo p h n) (\x. x)" "qbs_integrable (montecarlo p h n) (\x. x * x)" + by simp_all + have 2[intro,simp]: "\q f. qbs_integrable q (\x. f x * f x) \ qbs_integrable q (\x. f x * a * (f x * b))" for a b :: real + by(auto simp: mult.commute[of _ a] mult.assoc intro!: qbs_integrable_scaleR_left[where 'a=real,simplified] qbs_integrable_scaleR_right[where 'a=real,simplified]) (auto simp: mult.assoc[of _ _ b,symmetric] intro!: qbs_integrable_scaleR_left[where 'a=real,simplified]) + show ?case + by(auto simp add: qbs_bind_bind_return2P'[of _ "\\<^sub>Q" X "\\<^sub>Q"] split_beta' qbs_pair_measure_def[OF qbs_space_monadPM qbs_space_monadPM,symmetric] qbs_integrable_bind_return[OF qbs_space_monadPM,of _ "\\<^sub>Q \\<^sub>Q X" _ "\\<^sub>Q"] comp_def distrib_right distrib_left intro!: qbs_integrable_indep_mult qbs_integrable_indep1[OF 1(1),of _ X] qbs_integrable_indep2[OF assms(3),of _ "\\<^sub>Q"] qbs_integrable_indep1[OF 1(2),of _ X] qbs_integrable_indep2[OF assms(4),of _ "\\<^sub>Q"] qbs_integrable_const[OF assms(1)] qbs_integrable_scaleR_left[where 'a=real,simplified] assms(3,4)) + qed + thus "qbs_integrable (montecarlo p h n) (\x. x)" "qbs_integrable (montecarlo p h n) (\x. x * x)" + by simp_all +qed + +lemma + fixes n :: nat + assumes [qbs]:"p \ qbs_space (monadP_qbs X)" "h \ X \\<^sub>Q \\<^sub>Q" "qbs_integrable p h" "qbs_integrable p (\x. h x * h x)" + and e:"e > 0" + and "(\\<^sub>Q x. h x \p) = \" "(\\<^sub>Q x. (h x - \)\<^sup>2 \p) = \\<^sup>2" + and n:"n > 0" + shows "\

(y in montecarlo p h n. \y - \\ \ e) \ \\<^sup>2 / (real n * e\<^sup>2)" (is "?P \ _") +proof - + note [intro!] = montecarlo_integrable[OF assms(1-4)] qbs_integrable_indep_mult qbs_integrable_indep1[OF montecarlo_integrable(1)[OF assms(1-4)],of _ X] qbs_integrable_indep2[OF assms(3),of _ "\\<^sub>Q"] qbs_integrable_indep1[OF montecarlo_integrable(2)[OF assms(1-4)],of _ X] qbs_integrable_indep2[OF assms(4),of _ "\\<^sub>Q"] qbs_integrable_const[OF assms(1)] qbs_integrable_scaleR_right[where 'a=real,simplified] qbs_integrable_scaleR_left[where 'a=real,simplified] assms(3,4) qbs_integrable_sq qbs_integrable_const[of "montecarlo p h _ \\<^sub>Q\<^sub>m\<^sub>e\<^sub>s p" "\\<^sub>Q \\<^sub>Q X"] qbs_integrable_const[of "montecarlo p h _" "\\<^sub>Q"] + have integrable[intro,simp]: "\q f. qbs_integrable q (\x. f x * f x) \ qbs_integrable q (\x. f x * a * (f x * b))" for a b :: real + by(auto simp: mult.commute[of _ a] mult.assoc) (auto simp: mult.assoc[of _ _ b,symmetric]) + have exp:"(\\<^sub>Q y. y \(montecarlo p h n)) = \" (is "?e n") and var:"(\\<^sub>Q y. (y - \)\<^sup>2 \(montecarlo p h n)) = \\<^sup>2 / n" (is "?v n") + proof - + have "?e n \ ?v n" + using n + proof(induction n) + case 0 + then show ?case + by simp + next + case ih:(Suc n) + consider "n = 0" | "n > 0" by auto + then show ?case + proof cases + case 1 + then show ?thesis + by(auto simp: qbs_integral_indep2[OF qbs_integrable_sq[OF qbs_integrable_const[OF assms(1)] assms(3)],simplified power2_eq_square,OF assms(4),of _ qbs_borel] power2_eq_square qbs_bind_bind_return2P'[of _ "\\<^sub>Q" X "\\<^sub>Q"] split_beta' qbs_pair_measure_def[OF qbs_space_monadPM qbs_space_monadPM,symmetric] qbs_integral_bind_return[OF qbs_space_monadPM,of _ "\\<^sub>Q \\<^sub>Q X" _ "\\<^sub>Q"] comp_def qbs_integral_indep2[OF assms(3),of _ "\\<^sub>Q"] qbs_integral_indep2[OF assms(4),of _ "\\<^sub>Q"] assms(6,7)[simplified power2_eq_square]) + next + case n[arith]:2 + with ih have eq: "(\\<^sub>Q y. y \montecarlo p h n) = \ " "(\\<^sub>Q y. (y - \)\<^sup>2 \montecarlo p h n) = \\<^sup>2 / real n" + by simp_all + + have 1:"?e (Suc n)" + proof - + have "(\\<^sub>Q x. h (snd x) + fst x * real n \(montecarlo p h n \\<^sub>Q\<^sub>m\<^sub>e\<^sub>s p)) = ((\\<^sub>Q x. h (snd x) \(montecarlo p h n \\<^sub>Q\<^sub>m\<^sub>e\<^sub>s p)) + (\\<^sub>Q x. fst x * real n \(montecarlo p h n \\<^sub>Q\<^sub>m\<^sub>e\<^sub>s p)))" + by(rule qbs_integral_add) auto + also have "... = \ + \ * n" + proof - + have "(\\<^sub>Q x. h (snd x) \(montecarlo p h n \\<^sub>Q\<^sub>m\<^sub>e\<^sub>s p)) = (\\<^sub>Q x. h x \p)" + by(auto intro!: qbs_integral_indep2[of _ _ _ "\\<^sub>Q"]) + moreover have "(\\<^sub>Q x. fst x \(montecarlo p h n \\<^sub>Q\<^sub>m\<^sub>e\<^sub>s p)) = (\\<^sub>Q y. y \montecarlo p h n)" + by(auto intro!: qbs_integral_indep1[of _ _ _ X]) + ultimately show ?thesis + by(simp add: eq assms) + qed + finally have "( \\<^sub>Q y. y \montecarlo p h (Suc n)) = 1 / (Suc n) * (\ + \ * n)" + by(auto simp: qbs_bind_bind_return2P'[of _ "\\<^sub>Q" X "\\<^sub>Q"] split_beta' qbs_pair_measure_def[OF qbs_space_monadPM qbs_space_monadPM,symmetric] qbs_integral_bind_return[OF qbs_space_monadPM,of _ "\\<^sub>Q \\<^sub>Q X" _ "\\<^sub>Q"] comp_def) + also have "... = 1 / (Suc n) * (\ * (1 + real n))" + by(simp add: distrib_left) + also have "... = \" + by simp + finally show ?thesis . + qed + have 2: "?v (Suc n)" + proof - + have "(\\<^sub>Q y. (y - \)\<^sup>2 \montecarlo p h (Suc n)) = (\\<^sub>Q x. ((h (snd x) + fst x * real n) / real (Suc n) - \)\<^sup>2 \(montecarlo p h n \\<^sub>Q\<^sub>m\<^sub>e\<^sub>s p))" + by(auto simp: qbs_bind_bind_return2P'[of _ "\\<^sub>Q" X "\\<^sub>Q"] split_beta' qbs_pair_measure_def[OF qbs_space_monadPM qbs_space_monadPM,symmetric] qbs_integral_bind_return[OF qbs_space_monadPM,of _ "\\<^sub>Q \\<^sub>Q X" _ "\\<^sub>Q"] comp_def) + also have "... = (\\<^sub>Q x. ((h (snd x) + fst x * real n) / real (Suc n) - (Suc n) * \ / Suc n)\<^sup>2 \(montecarlo p h n \\<^sub>Q\<^sub>m\<^sub>e\<^sub>s p))" + by simp + also have "... = (\\<^sub>Q x. ((h (snd x) + fst x * real n - (Suc n) * \) / Suc n)\<^sup>2 \(montecarlo p h n \\<^sub>Q\<^sub>m\<^sub>e\<^sub>s p))" + by(simp only: diff_divide_distrib[symmetric]) + also have "... = (\\<^sub>Q x. ((h (snd x) - \ + (fst x * real n - real n * \)) / Suc n)\<^sup>2 \(montecarlo p h n \\<^sub>Q\<^sub>m\<^sub>e\<^sub>s p))" + by (simp add: add_diff_add distrib_left mult.commute) + also have "... = (\\<^sub>Q x. (1 / real (Suc n) * (h (snd x) - \) + n / real (Suc n) * (fst x - \))\<^sup>2 \(montecarlo p h n \\<^sub>Q\<^sub>m\<^sub>e\<^sub>s p))" + by(auto simp: add_divide_distrib[symmetric] pair_qbs_space mult.commute[of _ "real n"]) (simp add: right_diff_distrib) + also have "... = (\\<^sub>Q x. (1 / real (Suc n) * (h (snd x) - \))\<^sup>2 + (n / real (Suc n) * (fst x - \))\<^sup>2 + 2 * (1 / real (Suc n) * (h (snd x) - \)) * (n / real (Suc n) * (fst x - \)) \(montecarlo p h n \\<^sub>Q\<^sub>m\<^sub>e\<^sub>s p))" + by(simp add: power2_sum) + also have "... = (\\<^sub>Q x. 1 / (real (Suc n))\<^sup>2 * ((h (snd x) - \))\<^sup>2 + (n / real (Suc n))\<^sup>2 * ((fst x - \))\<^sup>2 + 2 * (1 / real (Suc n) * (h (snd x) - \)) * (n / real (Suc n) * (fst x - \)) \(montecarlo p h n \\<^sub>Q\<^sub>m\<^sub>e\<^sub>s p))" + by(simp only: power_mult_distrib) (simp add: power2_eq_square) + also have "... = (\\<^sub>Q x. 1 / (real (Suc n))\<^sup>2 * ((h (snd x) - \))\<^sup>2 + (n / real (Suc n))\<^sup>2 * ((fst x - \))\<^sup>2 \(montecarlo p h n \\<^sub>Q\<^sub>m\<^sub>e\<^sub>s p)) + (\\<^sub>Q x. 2 * (1 / real (Suc n) * (h (snd x) - \)) * (n / real (Suc n) * (fst x - \)) \(montecarlo p h n \\<^sub>Q\<^sub>m\<^sub>e\<^sub>s p))" + by(rule qbs_integral_add, auto) (auto simp: power2_eq_square) + also have "... = (\\<^sub>Q x. 1 / (real (Suc n))\<^sup>2 * ((h (snd x) - \))\<^sup>2 \(montecarlo p h n \\<^sub>Q\<^sub>m\<^sub>e\<^sub>s p)) + (\\<^sub>Q x. (n / real (Suc n))\<^sup>2 * ((fst x - \))\<^sup>2 \(montecarlo p h n \\<^sub>Q\<^sub>m\<^sub>e\<^sub>s p)) + (\\<^sub>Q x. 2 * (1 / real (Suc n) * (h (snd x) - \)) * (n / real (Suc n) * (fst x - \)) \(montecarlo p h n \\<^sub>Q\<^sub>m\<^sub>e\<^sub>s p))" + proof - + have "(\\<^sub>Q x. 1 / (real (Suc n))\<^sup>2 * ((h (snd x) - \))\<^sup>2 + (n / real (Suc n))\<^sup>2 * ((fst x - \))\<^sup>2 \(montecarlo p h n \\<^sub>Q\<^sub>m\<^sub>e\<^sub>s p)) = (\\<^sub>Q x. 1 / (real (Suc n))\<^sup>2 * ((h (snd x) - \))\<^sup>2 \(montecarlo p h n \\<^sub>Q\<^sub>m\<^sub>e\<^sub>s p)) + (\\<^sub>Q x. (n / real (Suc n))\<^sup>2 * ((fst x - \))\<^sup>2 \(montecarlo p h n \\<^sub>Q\<^sub>m\<^sub>e\<^sub>s p))" + by(rule qbs_integral_add, auto) (auto simp: power2_eq_square) + thus ?thesis by simp + qed + also have "... = 1 / (real (Suc n))\<^sup>2 * \\<^sup>2 + (n / real (Suc n))\<^sup>2 * (\\<^sup>2 / n)" + proof - + have 1: "(\\<^sub>Q x. ((h (snd x) - \))\<^sup>2 \(montecarlo p h n \\<^sub>Q\<^sub>m\<^sub>e\<^sub>s p)) = (\\<^sub>Q x. (h x - \)\<^sup>2 \p)" + by(auto intro!: qbs_integral_indep2[of _ _ _ "\\<^sub>Q"]) (auto simp: power2_eq_square) + have 2: "(\\<^sub>Q x. ((fst x - \))\<^sup>2 \(montecarlo p h n \\<^sub>Q\<^sub>m\<^sub>e\<^sub>s p)) = (\\<^sub>Q y. (y - \)\<^sup>2 \montecarlo p h n)" + by(auto intro!: qbs_integral_indep1[of _ _ _ X]) (auto simp: power2_eq_square) + have 3: "(\\<^sub>Q x. 2 * (1 / real (Suc n) * (h (snd x) - \)) * (n / real (Suc n) * (fst x - \)) \(montecarlo p h n \\<^sub>Q\<^sub>m\<^sub>e\<^sub>s p)) = 0" (is "?l = _") + proof - + have "?l = (\\<^sub>Q x. 2 * (1 / real (Suc n) * (h x - \)) \p) * (\\<^sub>Q x. (n / real (Suc n) * (x - \)) \montecarlo p h n)" + by(rule qbs_integral_indep_mult2[of _ "\\<^sub>Q" _ X]) auto + also have "... = 0" + by(simp add: qbs_integral_diff[OF montecarlo_integrable(1)[OF assms(1-4)] qbs_integrable_const[of _ "\\<^sub>Q"]] eq qbs_integral_const_prob[of _ "\\<^sub>Q"]) + finally show ?thesis . + qed + show ?thesis + unfolding 3 by(simp add: 1 2 eq assms) + qed + also have "... = 1 / (real (Suc n))\<^sup>2 * \\<^sup>2 + real n / (real (Suc n))\<^sup>2 * \\<^sup>2" + by(auto simp: power2_eq_square) + also have "... = (1 + real n) * \\<^sup>2 / (real (Suc n))\<^sup>2" + by (simp add: add_divide_distrib ring_class.ring_distribs(2)) + also have "... = \\<^sup>2 / real (Suc n)" + by(auto simp: power2_eq_square) + finally show ?thesis . + qed + show ?thesis + by(simp only: 1 2) + qed + qed + thus "?e n" "?v n" by simp_all + qed + + + have "?P \ (\\<^sub>Q x. (x - \)\<^sup>2 \montecarlo p h n) / e\<^sup>2" + unfolding exp[symmetric] by(rule Chebyshev_inequality_qbs_prob[of "montecarlo p h n" qbs_borel "\x. x"]) (auto simp: power2_eq_square e) + also have "... = \\<^sup>2 / (real n * e\<^sup>2)" + by(simp add: var) + finally show ?thesis . +qed + +end \ No newline at end of file diff --git a/thys/S_Finite_Measure_Monad/QBS_Morphism.thy b/thys/S_Finite_Measure_Monad/QBS_Morphism.thy new file mode 100644 --- /dev/null +++ b/thys/S_Finite_Measure_Monad/QBS_Morphism.thy @@ -0,0 +1,427 @@ +(* Title: QBS_Morphism.thy + Author: Michikazu Hirata, Tokyo Institute of Technology +*) +subsection \ Morphisms of Quasi-Borel Spaces \ +theory QBS_Morphism + +imports + "QuasiBorel" + +begin + +abbreviation qbs_morphism :: "['a quasi_borel, 'b quasi_borel] \ ('a \ 'b) set" (infixr "\\<^sub>Q" 60) where + "X \\<^sub>Q Y \ qbs_space (X \\<^sub>Q Y)" + +lemma qbs_morphismI: "(\\. \ \ qbs_Mx X \ f \ \ \ qbs_Mx Y) \ f \ X \\<^sub>Q Y" + by(auto simp: exp_qbs_space) + +lemma qbs_morphism_def: "X \\<^sub>Q Y = {f\qbs_space X \ qbs_space Y. \\ \ qbs_Mx X. f \ \ \ qbs_Mx Y}" + unfolding exp_qbs_space +proof safe + fix f x + assume h:"x \ qbs_space X " "\\\qbs_Mx X. f \ \ \ qbs_Mx Y" + then have "(\r. x) \ qbs_Mx X" + by simp + hence "f \ (\r. x) \ qbs_Mx Y" + using h by blast + with qbs_Mx_to_X show "f x \ qbs_space Y" + by auto +qed auto + +lemma qbs_morphism_Mx: + assumes "f \ X \\<^sub>Q Y" "\ \ qbs_Mx X" + shows "f \ \ \ qbs_Mx Y" + using assms by(auto simp: qbs_morphism_def) + +lemma qbs_morphism_space: + assumes "f \ X \\<^sub>Q Y" "x \ qbs_space X" + shows "f x \ qbs_space Y" + using assms by(auto simp: qbs_morphism_def) + +lemma qbs_morphism_ident[simp]: + "id \ X \\<^sub>Q X" + by(auto intro: qbs_morphismI) + +lemma qbs_morphism_ident'[simp]: + "(\x. x) \ X \\<^sub>Q X" + using qbs_morphism_ident by(simp add: id_def) + +lemma qbs_morphism_comp: + assumes "f \ X \\<^sub>Q Y" "g \ Y \\<^sub>Q Z" + shows "g \ f \ X \\<^sub>Q Z" + using assms by (simp add: comp_assoc Pi_def qbs_morphism_def) + +lemma qbs_morphism_compose_rev: + assumes "f \ Y \\<^sub>Q Z" and "g \ X \\<^sub>Q Y" + shows "(\x. f (g x)) \ X \\<^sub>Q Z" + using qbs_morphism_comp[OF assms(2,1)] by(simp add: comp_def) + +lemma qbs_morphism_compose: + assumes "g \ X \\<^sub>Q Y" and "f \ Y \\<^sub>Q Z" + shows "(\x. f (g x)) \ X \\<^sub>Q Z" + using qbs_morphism_compose_rev[OF assms(2,1)] . + +lemma qbs_morphism_cong': + assumes "\x. x \ qbs_space X \ f x = g x" + and "f \ X \\<^sub>Q Y" + shows "g \ X \\<^sub>Q Y" +proof(rule qbs_morphismI) + fix \ + assume 1:"\ \ qbs_Mx X" + have "g \ \ = f \ \" + proof + fix x + have "\ x \ qbs_space X" + using 1 qbs_decomp[of X] qbs_Mx_to_X by auto + thus "(g \ \) x = (f \ \) x" + using assms(1) by simp + qed + thus "g \ \ \ qbs_Mx Y" + using 1 assms(2) by(simp add: qbs_morphism_def) +qed + +lemma qbs_morphism_cong: + assumes "\x. x \ qbs_space X \ f x = g x" + shows "f \ X \\<^sub>Q Y \ g \ X \\<^sub>Q Y" + using assms by(auto simp: qbs_morphism_cong'[of _ f g] qbs_morphism_cong'[of _ g f]) + +lemma qbs_morphism_const: + assumes "y \ qbs_space Y" + shows "(\x. y) \ X \\<^sub>Q Y" + using assms by (auto intro: qbs_morphismI) + +lemma qbs_morphism_from_empty: "qbs_space X = {} \ f \ X \\<^sub>Q Y" + by(auto intro!: qbs_morphismI simp: qbs_empty_equiv) + +lemma unit_quasi_borel_terminal: "\! f. f \ X \\<^sub>Q unit_quasi_borel" + by(fastforce simp: qbs_morphism_def) + +definition to_unit_quasi_borel :: "'a \ unit" ("!\<^sub>Q") where +"to_unit_quasi_borel \ (\r.())" + +lemma to_unit_quasi_borel_morphism: + "!\<^sub>Q \ X \\<^sub>Q unit_quasi_borel" + by(auto simp add: to_unit_quasi_borel_def qbs_morphism_def) + +lemma qbs_morphism_subD: + assumes "f \ X \\<^sub>Q sub_qbs Y A" + shows "f \ X \\<^sub>Q Y" + using qbs_morphism_Mx[OF assms] by(auto intro!: qbs_morphismI simp: sub_qbs_Mx) + +lemma qbs_morphism_subI1: + assumes "f \ X \\<^sub>Q Y" "\x. x \ qbs_space X \ f x \ A" + shows "f \ X \\<^sub>Q sub_qbs Y A" + using qbs_morphism_space[OF assms(1)] qbs_morphism_Mx[OF assms(1)] assms(2) qbs_Mx_to_X[of _ X] + by(auto intro!: qbs_morphismI simp: sub_qbs_Mx) + +lemma qbs_morphism_subI2: + assumes "f \ X \\<^sub>Q Y" + shows "f \ sub_qbs X A \\<^sub>Q Y" + using qbs_morphism_Mx[OF assms] by(auto intro!: qbs_morphismI simp: sub_qbs_Mx) + +corollary qbs_morphism_subsubI: + assumes "f \ X \\<^sub>Q Y" "\x. x \ A \ f x \ B" + shows "f \ sub_qbs X A \\<^sub>Q sub_qbs Y B" + by(rule qbs_morphism_subI1) (auto intro!: qbs_morphism_subI2 assms simp: sub_qbs_space) + +lemma map_qbs_morphism_f: "f \ X \\<^sub>Q map_qbs f X" + by(auto intro!: qbs_morphismI simp: map_qbs_Mx) + +lemma map_qbs_morphism_inverse_f: + assumes "\x. x \ qbs_space X \ g (f x) = x" + shows "g \ map_qbs f X \\<^sub>Q X" +proof - + { + fix \ + assume h:"\ \ qbs_Mx X" + from qbs_Mx_to_X[OF this] assms have "g \ (f \ \) = \" + by auto + with h have "g \ (f \ \) \ qbs_Mx X" by simp + } + thus ?thesis + by(auto intro!: qbs_morphismI simp: map_qbs_Mx) +qed + +lemma pair_qbs_morphismI: + assumes "\\ \. \ \ qbs_Mx X \ \ \ qbs_Mx Y + \ (\r. f (\ r, \ r)) \ qbs_Mx Z" + shows "f \ (X \\<^sub>Q Y) \\<^sub>Q Z" + using assms by(fastforce intro!: qbs_morphismI simp: pair_qbs_Mx comp_def) + +lemma pair_qbs_MxD: + assumes "\ \ qbs_Mx (X \\<^sub>Q Y)" + obtains \ \ where "\ \ qbs_Mx X" "\ \ qbs_Mx Y" "\ = (\x. (\ x, \ x))" + using assms by(auto simp: pair_qbs_Mx) + +lemma pair_qbs_MxI: + assumes "(\x. fst (\ x)) \ qbs_Mx X" and "(\x. snd (\ x)) \ qbs_Mx Y" + shows "\ \ qbs_Mx (X \\<^sub>Q Y)" + using assms by(auto simp: pair_qbs_Mx comp_def) + +lemma + shows fst_qbs_morphism: "fst \ X \\<^sub>Q Y \\<^sub>Q X" + and snd_qbs_morphism: "snd \ X \\<^sub>Q Y \\<^sub>Q Y" + by(auto intro!: pair_qbs_morphismI simp: comp_def) + +lemma qbs_morphism_pair_iff: + "f \ X \\<^sub>Q Y \\<^sub>Q Z \ fst \ f \ X \\<^sub>Q Y \ snd \ f \ X \\<^sub>Q Z" + by(auto intro!: qbs_morphism_comp fst_qbs_morphism snd_qbs_morphism) + (auto dest: qbs_morphism_Mx intro!: qbs_morphismI simp: pair_qbs_Mx comp_assoc[symmetric]) + +lemma qbs_morphism_Pair: + assumes "f \ Z \\<^sub>Q X" + and "g \ Z \\<^sub>Q Y" + shows "(\z. (f z, g z)) \ Z \\<^sub>Q X \\<^sub>Q Y" + unfolding qbs_morphism_pair_iff + using assms by (auto simp: comp_def) + +lemma qbs_morphism_curry: "curry \ exp_qbs (X \\<^sub>Q Y) Z \\<^sub>Q exp_qbs X (exp_qbs Y Z)" + by(auto intro!: qbs_morphismI simp: pair_qbs_Mx exp_qbs_Mx comp_def) + +corollary curry_preserves_morphisms: + assumes "(\xy. f (fst xy) (snd xy)) \ X \\<^sub>Q Y \\<^sub>Q Z" + shows "f \ X \\<^sub>Q Y \\<^sub>Q Z" + using qbs_morphism_space[OF qbs_morphism_curry assms] by (auto simp: curry_def) + +lemma qbs_morphism_eval: + "(\fx. (fst fx) (snd fx)) \ (X \\<^sub>Q Y) \\<^sub>Q X \\<^sub>Q Y" + by(auto intro!: qbs_morphismI simp: pair_qbs_Mx exp_qbs_Mx comp_def) + +corollary qbs_morphism_app: + assumes "f \ X \\<^sub>Q (Y \\<^sub>Q Z)" "g \ X \\<^sub>Q Y" + shows "(\x. (f x) (g x)) \ X \\<^sub>Q Z" + by(rule qbs_morphism_cong'[where f="(\fx. (fst fx) (snd fx)) \ (\x. (f x, g x))",OF _ qbs_morphism_comp[OF qbs_morphism_Pair[OF assms] qbs_morphism_eval]]) auto + +ML_file \qbs.ML\ + +attribute_setup qbs = \ + Attrib.add_del Qbs.qbs_add Qbs.qbs_del\ + "declaration of qbs rule" + +method_setup qbs = \ Scan.lift (Scan.succeed (METHOD o Qbs.qbs_tac))\ + +simproc_setup qbs ("x \ qbs_space X") = \K Qbs.simproc\ + +declare + fst_qbs_morphism[qbs] + snd_qbs_morphism[qbs] + qbs_morphism_const[qbs] + qbs_morphism_ident[qbs] + qbs_morphism_ident'[qbs] + qbs_morphism_curry[qbs] + +lemma [qbs]: + shows qbs_morphism_Pair1: "Pair \ X \\<^sub>Q Y \\<^sub>Q (X \\<^sub>Q Y)" + by(auto intro!: qbs_morphismI simp: exp_qbs_Mx pair_qbs_Mx comp_def) + +lemma qbs_morphism_case_prod[qbs]: "case_prod \ exp_qbs X (exp_qbs Y Z) \\<^sub>Q exp_qbs (X \\<^sub>Q Y) Z" + by(fastforce intro!: qbs_morphismI simp: exp_qbs_Mx pair_qbs_Mx comp_def split_beta') + +lemma uncurry_preserves_morphisms: + assumes [qbs]:"(\x y. f (x,y)) \ X \\<^sub>Q Y \\<^sub>Q Z" + shows "f \ X \\<^sub>Q Y \\<^sub>Q Z" + by(rule qbs_morphism_cong'[where f="case_prod (\x y. f (x,y))"],simp) qbs + +lemma qbs_morphism_comp'[qbs]:"comp \ Y \\<^sub>Q Z \\<^sub>Q (X \\<^sub>Q Y) \\<^sub>Q X \\<^sub>Q Z" + by(auto intro!: qbs_morphismI simp: exp_qbs_Mx) + +lemma arg_swap_morphism: + assumes "f \ X \\<^sub>Q exp_qbs Y Z" + shows "(\y x. f x y) \ Y \\<^sub>Q exp_qbs X Z" + using assms by simp + +lemma exp_qbs_comp_morphism: + assumes "f \ W \\<^sub>Q exp_qbs X Y" + and "g \ W \\<^sub>Q exp_qbs Y Z" + shows "(\w. g w \ f w) \ W \\<^sub>Q exp_qbs X Z" + using assms by qbs + +lemma arg_swap_morphism_map_qbs1: + assumes "g \ exp_qbs W (exp_qbs X Y) \\<^sub>Q Z" + shows "(\k. g (k \ f)) \ exp_qbs (map_qbs f W) (exp_qbs X Y) \\<^sub>Q Z" + using assms map_qbs_morphism_f by qbs + +lemma qbs_morphism_map_prod[qbs]: "map_prod \ X \\<^sub>Q Y \\<^sub>Q (W \\<^sub>Q Z) \\<^sub>Q (X \\<^sub>Q W) \\<^sub>Q (Y \\<^sub>Q Z)" + by(auto intro!: qbs_morphismI simp: exp_qbs_Mx pair_qbs_Mx map_prod_def comp_def case_prod_beta') + +lemma qbs_morphism_pair_swap: + assumes "f \ X \\<^sub>Q Y \\<^sub>Q Z" + shows "(\(x,y). f (y,x)) \ Y \\<^sub>Q X \\<^sub>Q Z" + using assms by simp + +lemma + shows qbs_morphism_pair_assoc1: "(\((x,y),z). (x,(y,z))) \ (X \\<^sub>Q Y) \\<^sub>Q Z \\<^sub>Q X \\<^sub>Q (Y \\<^sub>Q Z)" + and qbs_morphism_pair_assoc2: "(\(x,(y,z)). ((x,y),z)) \ X \\<^sub>Q (Y \\<^sub>Q Z) \\<^sub>Q (X \\<^sub>Q Y) \\<^sub>Q Z" + by simp_all + +lemma Inl_qbs_morphism[qbs]: "Inl \ X \\<^sub>Q X \\<^sub>Q Y" + by(auto intro!: qbs_morphismI bexI[where x="{}"] simp: copair_qbs_Mx copair_qbs_Mx_def comp_def) + +lemma Inr_qbs_morphism[qbs]: "Inr \ Y \\<^sub>Q X \\<^sub>Q Y" + by(auto intro!: qbs_morphismI bexI[where x="UNIV"] simp: copair_qbs_Mx copair_qbs_Mx_def comp_def) + +lemma case_sum_qbs_morphism[qbs]: "case_sum \ X \\<^sub>Q Z \\<^sub>Q (Y \\<^sub>Q Z) \\<^sub>Q (X \\<^sub>Q Y \\<^sub>Q Z)" + by(auto intro!: qbs_morphismI qbs_Mx_indicat simp: copair_qbs_Mx copair_qbs_Mx_def exp_qbs_Mx case_sum_if) + +lemma map_sum_qbs_morphism[qbs]: "map_sum \ X \\<^sub>Q Y \\<^sub>Q (X' \\<^sub>Q Y') \\<^sub>Q (X \\<^sub>Q X' \\<^sub>Q Y \\<^sub>Q Y')" +proof(rule qbs_morphismI) + fix \ + assume "\ \ qbs_Mx (X \\<^sub>Q Y)" + then have ha[measurable]: "\(k :: real \ real)\borel_measurable borel. \a\qbs_Mx X. (\r. \ (k r) (a r)) \ qbs_Mx Y" + by (auto simp: exp_qbs_Mx) + show "map_sum \ \ \ qbs_Mx ((X' \\<^sub>Q Y') \\<^sub>Q X \\<^sub>Q X' \\<^sub>Q Y \\<^sub>Q Y')" + unfolding exp_qbs_Mx + proof safe + fix \ b and f g :: "real \ real" + assume h[measurable]: "\(k :: real \ real)\borel_measurable borel. \b\qbs_Mx X'. (\r. \ (k r) (b r)) \ qbs_Mx Y'" + "f \ borel_measurable borel" "g \ borel_measurable borel" + and b: "b \ qbs_Mx (X \\<^sub>Q X')" + show "(\r. (map_sum \ \) (f (g r)) (\ (g r)) (b r)) \ qbs_Mx (Y \\<^sub>Q Y')" + proof(rule copair_qbs_MxD[OF b]) + fix a + assume "a \ qbs_Mx X" "b = (\r. Inl (a r))" + with ha show "(\r. (map_sum \ \) (f (g r)) (\ (g r)) (b r)) \ qbs_Mx (Y \\<^sub>Q Y')" + by(auto simp: copair_qbs_Mx copair_qbs_Mx_def intro!: bexI[where x="{}"]) + next + fix a + assume "a \ qbs_Mx X'" "b = (\r. Inr (a r))" + with h(1) show "(\r. (map_sum \ \) (f (g r)) (\ (g r)) (b r)) \ qbs_Mx (Y \\<^sub>Q Y')" + by(auto simp: copair_qbs_Mx copair_qbs_Mx_def intro!: bexI[where x="UNIV"]) + next + fix S a a' + assume "S \ sets borel" "S \ {}" "S \ UNIV" "a \ qbs_Mx X" "a' \ qbs_Mx X'" "b = (\r. if r \ S then Inl (a r) else Inr (a' r))" + with h ha show "(\r. (map_sum \ \) (f (g r)) (\ (g r)) (b r)) \ qbs_Mx (Y \\<^sub>Q Y')" + by simp (fastforce simp: copair_qbs_Mx copair_qbs_Mx_def intro!: bexI[where x=S]) + qed + qed +qed + +lemma qbs_morphism_component_singleton[qbs]: + assumes "i \ I" + shows "(\x. x i) \ (\\<^sub>Q i\I. (M i)) \\<^sub>Q M i" + by(auto intro!: qbs_morphismI simp: comp_def assms PiQ_Mx) + +lemma qbs_morphism_component_singleton': + assumes "f \ Y \\<^sub>Q (\\<^sub>Q i\I. X i)" "g \ Z \\<^sub>Q Y" "i \ I" + shows "(\x. f (g x) i) \ Z \\<^sub>Q X i" + by(auto intro!: qbs_morphism_compose[OF assms(2)] qbs_morphism_compose[OF assms(1)] qbs_morphism_component_singleton assms) + +lemma product_qbs_canonical1: + assumes "\i. i \ I \ f i \ Y \\<^sub>Q X i" + and "\i. i \ I \ f i = (\y. undefined)" + shows "(\y i. f i y) \ Y \\<^sub>Q (\\<^sub>Q i\I. X i)" + using assms qbs_morphism_Mx[OF assms(1)] by(auto intro!: qbs_morphismI simp: PiQ_Mx comp_def) + +lemma product_qbs_canonical2: + assumes "\i. i \ I \ f i \ Y \\<^sub>Q X i" + "\i. i \ I \ f i = (\y. undefined)" + "g \ Y \\<^sub>Q (\\<^sub>Q i\I. X i)" + "\i. i \ I \ f i = (\x. x i) \ g" + and "y \ qbs_space Y" + shows "g y = (\i. f i y)" +proof(intro ext) + fix i + show "g y i = f i y" + proof(cases "i \ I") + case True + then show ?thesis + using assms(4)[of i] by simp + next + case False + with qbs_morphism_space[OF assms(3)] assms(2,3,5) show ?thesis + by(auto simp: PiQ_Mx PiQ_space) + qed +qed + +lemma merge_qbs_morphism: + "merge I J \ (\\<^sub>Q i\I. (M i)) \\<^sub>Q (\\<^sub>Q j\J. (M j)) \\<^sub>Q (\\<^sub>Q i\I\J. (M i))" +proof(rule qbs_morphismI) + fix \ + assume h:"\ \ qbs_Mx ((\\<^sub>Q i\I. (M i)) \\<^sub>Q (\\<^sub>Q j\J. (M j)))" + show "merge I J \ \ \ qbs_Mx (\\<^sub>Q i\I\J. (M i))" + proof - + { + fix i + assume "i \ I \ J" + then consider "i \ I" | "i \ I \ i \ J" | "i \ I \ i \ J" + by auto + hence "(\r. (merge I J \ \) r i) \ qbs_Mx (M i)" + by cases (insert h, auto simp: merge_def split_beta' pair_qbs_Mx PiQ_Mx) + } + thus ?thesis + by(auto simp: PiQ_Mx) (auto simp: merge_def split_beta') + qed +qed + +lemma ini_morphism[qbs]: + assumes "j \ I" + shows "(\x. (j,x)) \ X j \\<^sub>Q (\\<^sub>Q i\I. X i)" + by(fastforce intro!: qbs_morphismI exI[where x="\r. j"] simp: coprod_qbs_Mx_def comp_def assms coprod_qbs_Mx) + +lemma coprod_qbs_canonical1: + assumes "countable I" + and "\i. i \ I \ f i \ X i \\<^sub>Q Y" + shows "(\(i,x). f i x) \ (\\<^sub>Q i \I. X i) \\<^sub>Q Y" +proof(rule qbs_morphismI) + fix \ + assume "\ \ qbs_Mx (coprod_qbs I X)" + then obtain \ g where ha: + "\i. i \ range g \ \ i \ qbs_Mx (X i)" "\ = (\r. (g r, \ (g r) r))" and hg[measurable]:"g \ borel \\<^sub>M count_space I" + by(fastforce simp: coprod_qbs_Mx_def coprod_qbs_Mx) + define f' where "f' \ (\i r. f i (\ i r))" + have "range g \ I" + using measurable_space[OF hg] by auto + hence 1:"(\i. i \ range g \ f' i \ qbs_Mx Y)" + using qbs_morphism_Mx[OF assms(2) ha(1),simplified comp_def] + by(auto simp: f'_def) + have "(\(i, x). f i x) \ \ = (\r. f' (g r) r)" + by(auto simp: ha(2) f'_def) + also have "... \ qbs_Mx Y" + by(auto intro!: qbs_closed3_dest2'[OF assms(1) hg,of f',OF 1]) + finally show "(\(i, x). f i x) \ \ \ qbs_Mx Y " . +qed + +lemma coprod_qbs_canonical1': + assumes "countable I" + and "\i. i \ I \ (\x. f (i,x)) \ X i \\<^sub>Q Y" + shows "f \ (\\<^sub>Q i \I. X i) \\<^sub>Q Y" + using coprod_qbs_canonical1[where f="curry f"] assms by(auto simp: curry_def) + +lemma None_qbs[qbs]: "None \ qbs_space (option_qbs X)" + by(simp add: option_qbs_space) + +lemma Some_qbs[qbs]: "Some \ X \\<^sub>Q option_qbs X" +proof - + have 1: "Some = (\x. case x of Inl y \ Some y | Inr y \ None) \ Inl" + by standard auto + show ?thesis + unfolding option_qbs_def + by(rule qbs_morphism_cong'[OF _ qbs_morphism_comp[OF Inl_qbs_morphism map_qbs_morphism_f]]) (simp add: 1) +qed + +lemma case_option_qbs_morphism[qbs]: "case_option \ qbs_space (Y \\<^sub>Q (X \\<^sub>Q Y) \\<^sub>Q option_qbs X \\<^sub>Q Y)" +proof(rule curry_preserves_morphisms[OF arg_swap_morphism]) + have "(\x y. case x of None \ fst y | Some z \ snd y z) = (\x y. case x of Inr _ \ fst y | Inl z \ snd y z) \ (\z. case z of Some x \ Inl x | None \ Inr ())" + by standard+ (simp add: option.case_eq_if) + also have "... \ option_qbs X \\<^sub>Q Y \\<^sub>Q (X \\<^sub>Q Y) \\<^sub>Q Y" + unfolding option_qbs_def by(rule qbs_morphism_comp[OF map_qbs_morphism_inverse_f]) (auto simp: copair_qbs_space) + finally show " (\x y. case x of None \ fst y | Some x \ snd y x) \ option_qbs X \\<^sub>Q Y \\<^sub>Q (X \\<^sub>Q Y) \\<^sub>Q Y" . +qed + +lemma rec_option_qbs_morphism[qbs]: "rec_option \ qbs_space (Y \\<^sub>Q (X \\<^sub>Q Y) \\<^sub>Q option_qbs X \\<^sub>Q Y)" +proof - + have [simp]: "rec_option = case_option" + by standard+ (metis option.case_eq_if option.exhaust_sel option.simps(6) option.simps(7)) + show ?thesis by simp +qed + +lemma bind_option_qbs_morphism[qbs]: "(\) \ qbs_space (option_qbs X \\<^sub>Q (X \\<^sub>Q option_qbs Y) \\<^sub>Q option_qbs Y)" + by(simp add: Option.bind_def) + +lemma Let_qbs_morphism[qbs]: "Let \ X \\<^sub>Q (X \\<^sub>Q Y) \\<^sub>Q Y" +proof - + have [simp]:"Let = (\x f. f x)" by standard+ auto + show ?thesis by simp +qed + +end \ No newline at end of file diff --git a/thys/S_Finite_Measure_Monad/QuasiBorel.thy b/thys/S_Finite_Measure_Monad/QuasiBorel.thy new file mode 100644 --- /dev/null +++ b/thys/S_Finite_Measure_Monad/QuasiBorel.thy @@ -0,0 +1,1465 @@ +(* Title: QuasiBorel.thy + Author: Michikazu Hirata, Yasuhiko Minamide Tokyo Institute of Technology +*) + +section \Quasi-Borel Spaces\ +theory QuasiBorel +imports "HOL-Probability.Probability" +begin + +subsection \ Definitions \ + +subsubsection \ Quasi-Borel Spaces\ +definition qbs_closed1 :: "(real \ 'a) set \ bool" + where "qbs_closed1 Mx \ (\a \ Mx. \f \ (borel :: real measure) \\<^sub>M (borel :: real measure). a \ f \ Mx)" + +definition qbs_closed2 :: "['a set, (real \ 'a) set] \ bool" + where "qbs_closed2 X Mx \ (\x \ X. (\r. x) \ Mx)" + +definition qbs_closed3 :: "(real \ 'a) set \ bool" + where "qbs_closed3 Mx \ (\P::real \ nat. \Fi::nat \ real \ 'a. + (P \ borel \\<^sub>M count_space UNIV) \ (\i. Fi i \ Mx) \ (\r. Fi (P r) r) \ Mx)" + +lemma separate_measurable: + fixes P :: "real \ nat" + assumes "\i. P -` {i} \ sets borel" + shows "P \ borel \\<^sub>M count_space UNIV" + by (auto simp add: assms measurable_count_space_eq_countable) + +lemma measurable_separate: + fixes P :: "real \ nat" + assumes "P \ borel \\<^sub>M count_space UNIV" + shows "P -` {i} \ sets borel" + by (metis assms borel_singleton measurable_sets_borel sets.empty_sets sets_borel_eq_count_space) + +definition "is_quasi_borel X Mx \ Mx \ UNIV \ X \ qbs_closed1 Mx \ qbs_closed2 X Mx \ qbs_closed3 Mx" + +lemma is_quasi_borel_intro[simp]: + assumes "Mx \ UNIV \ X" + and "qbs_closed1 Mx" "qbs_closed2 X Mx" "qbs_closed3 Mx" + shows "is_quasi_borel X Mx" + using assms by(simp add: is_quasi_borel_def) + +typedef 'a quasi_borel = "{(X::'a set, Mx). is_quasi_borel X Mx}" +proof + show "(UNIV, UNIV) \ {(X::'a set, Mx). is_quasi_borel X Mx}" + by (simp add: is_quasi_borel_def qbs_closed1_def qbs_closed2_def qbs_closed3_def) +qed + +definition qbs_space :: "'a quasi_borel \ 'a set" where + "qbs_space X \ fst (Rep_quasi_borel X)" + +definition qbs_Mx :: "'a quasi_borel \ (real \ 'a) set" where + "qbs_Mx X \ snd (Rep_quasi_borel X)" + +declare [[coercion qbs_space]] + +lemma qbs_decomp : "(qbs_space X,qbs_Mx X) \ {(X::'a set, Mx). is_quasi_borel X Mx}" + by (simp add: qbs_space_def qbs_Mx_def Rep_quasi_borel[simplified]) + +lemma qbs_Mx_to_X: + assumes "\ \ qbs_Mx X" + shows "\ r \ qbs_space X" + using qbs_decomp assms by(auto simp: is_quasi_borel_def) + +lemma qbs_closed1I: + assumes "\\ f. \ \ Mx \ f \ borel \\<^sub>M borel \ \ \ f \ Mx" + shows "qbs_closed1 Mx" + using assms by(simp add: qbs_closed1_def) + +lemma qbs_closed1_dest[simp]: + assumes "\ \ qbs_Mx X" + and "f \ borel \\<^sub>M borel" + shows "\ \ f \ qbs_Mx X" + using assms qbs_decomp by (auto simp add: is_quasi_borel_def qbs_closed1_def) + +lemma qbs_closed1_dest'[simp]: + assumes "\ \ qbs_Mx X" + and "f \ borel \\<^sub>M borel" + shows "(\r. \ (f r)) \ qbs_Mx X" + using qbs_closed1_dest[OF assms] by (simp add: comp_def) + +lemma qbs_closed2I: + assumes "\x. x \ X \ (\r. x) \ Mx" + shows "qbs_closed2 X Mx" + using assms by(simp add: qbs_closed2_def) + +lemma qbs_closed2_dest[simp]: + assumes "x \ qbs_space X" + shows "(\r. x) \ qbs_Mx X" + using assms qbs_decomp[of X] by (auto simp add: is_quasi_borel_def qbs_closed2_def) + +lemma qbs_closed3I: + assumes "\(P :: real \ nat) Fi. P \ borel \\<^sub>M count_space UNIV \ (\i. Fi i \ Mx) + \ (\r. Fi (P r) r) \ Mx" + shows "qbs_closed3 Mx" + using assms by(auto simp: qbs_closed3_def) + +lemma qbs_closed3I': + assumes "\(P :: real \ nat) Fi. (\i. P -` {i} \ sets borel) \ (\i. Fi i \ Mx) + \ (\r. Fi (P r) r) \ Mx" + shows "qbs_closed3 Mx" + using assms by(auto intro!: qbs_closed3I dest: measurable_separate) + +lemma qbs_closed3_dest[simp]: + fixes P::"real \ nat" and Fi :: "nat \ real \ _" + assumes "P \ borel \\<^sub>M count_space UNIV" + and "\i. Fi i \ qbs_Mx X" + shows "(\r. Fi (P r) r) \ qbs_Mx X" + using assms qbs_decomp[of X] by (auto simp add: is_quasi_borel_def qbs_closed3_def) + +lemma qbs_closed3_dest': + fixes P::"real \ nat" and Fi :: "nat \ real \ _" + assumes "\i. P -` {i} \ sets borel" + and "\i. Fi i \ qbs_Mx X" + shows "(\r. Fi (P r) r) \ qbs_Mx X" + using qbs_closed3_dest[OF separate_measurable[OF assms(1)] assms(2)] . + +lemma qbs_closed3_dest2: + assumes "countable I" + and [measurable]: "P \ borel \\<^sub>M count_space I" + and "\i. i \ I \ Fi i \ qbs_Mx X" + shows "(\r. Fi (P r) r) \ qbs_Mx X" +proof - + have 0:"I \ {}" + using measurable_empty_iff[of "count_space I" P borel] assms(2) + by fastforce + define P' where "P' \ to_nat_on I \ P" + define Fi' where "Fi' \ Fi \ (from_nat_into I)" + have 1:"P' \ borel \\<^sub>M count_space UNIV" + by(simp add: P'_def) + have 2:"\i. Fi' i \ qbs_Mx X" + using assms(3) from_nat_into[OF 0] by(simp add: Fi'_def) + have "(\r. Fi' (P' r) r) \ qbs_Mx X" + using 1 2 measurable_separate by auto + thus ?thesis + using from_nat_into_to_nat_on[OF assms(1)] measurable_space[OF assms(2)] + by(auto simp: Fi'_def P'_def) +qed + +lemma qbs_closed3_dest2': + assumes "countable I" + and [measurable]: "P \ borel \\<^sub>M count_space I" + and "\i. i \ range P \ Fi i \ qbs_Mx X" + shows "(\r. Fi (P r) r) \ qbs_Mx X" +proof - + have 0:"range P \ I = range P" + using measurable_space[OF assms(2)] by auto + have 1:"P \ borel \\<^sub>M count_space (range P)" + using restrict_count_space[of I "range P"] measurable_restrict_space2[OF _ assms(2),of "range P"] + by(simp add: 0) + have 2:"countable (range P)" + using countable_Int2[OF assms(1),of "range P"] + by(simp add: 0) + show ?thesis + by(auto intro!: qbs_closed3_dest2[OF 2 1 assms(3)]) +qed + +lemma qbs_Mx_indicat: + assumes "S \ sets borel" "\ \ qbs_Mx X" "\ \ qbs_Mx X" + shows "(\r. if r \ S then \ r else \ r) \ qbs_Mx X" +proof - + have "(\r::real. if r \ S then \ r else \ r) = (\r. (\b. if b then \ else \) (r \ S) r)" + by(auto simp: indicator_def) + also have "... \ qbs_Mx X" + by(rule qbs_closed3_dest2[where I=UNIV and Fi="\b. if b then \ else \"]) (use assms in auto) + finally show ?thesis . +qed + +lemma qbs_space_Mx: "qbs_space X = {\ x |x \. \ \ qbs_Mx X}" +proof safe + fix x + assume 1:"x \ qbs_space X" + show "\xa \. x = \ xa \ \ \ qbs_Mx X" + by(auto intro!: exI[where x=0] exI[where x="(\r. x)"] simp: 1) +qed(simp add: qbs_Mx_to_X) + +lemma qbs_space_eq_Mx: + assumes "qbs_Mx X = qbs_Mx Y" + shows "qbs_space X = qbs_space Y" + by(simp add: qbs_space_Mx assms) + +lemma qbs_eqI: + assumes "qbs_Mx X = qbs_Mx Y" + shows "X = Y" + by (metis Rep_quasi_borel_inverse prod.exhaust_sel qbs_Mx_def qbs_space_def assms qbs_space_eq_Mx[OF assms]) + +subsubsection \ Empty Space \ +definition empty_quasi_borel :: "'a quasi_borel" where +"empty_quasi_borel \ Abs_quasi_borel ({},{})" + +lemma + shows eqb_space[simp]: "qbs_space empty_quasi_borel = ({} :: 'a set)" + and eqb_Mx[simp]: "qbs_Mx empty_quasi_borel = ({} :: (real \ 'a) set)" +proof - + have "Rep_quasi_borel empty_quasi_borel = ({} :: 'a set, {})" + using Abs_quasi_borel_inverse by(auto simp add: Abs_quasi_borel_inverse empty_quasi_borel_def qbs_closed1_def qbs_closed2_def qbs_closed3_def is_quasi_borel_def) + thus "qbs_space empty_quasi_borel = ({} :: 'a set)" "qbs_Mx empty_quasi_borel = ({} :: (real \ 'a) set)" + by(auto simp add: qbs_space_def qbs_Mx_def) +qed + +lemma qbs_empty_equiv :"qbs_space X = {} \ qbs_Mx X = {}" +proof safe + fix x + assume "qbs_Mx X = {}" + and h:"x \ qbs_space X" + have "(\r. x) \ qbs_Mx X" + using h by simp + thus "x \ {}" using \qbs_Mx X = {}\ by simp +qed(use qbs_Mx_to_X in blast) + +lemma empty_quasi_borel_iff: + "qbs_space X = {} \ X = empty_quasi_borel" + by(auto intro!: qbs_eqI simp: qbs_empty_equiv) + +subsubsection \ Unit Space \ +definition unit_quasi_borel :: "unit quasi_borel" ("1\<^sub>Q") where +"unit_quasi_borel \ Abs_quasi_borel (UNIV,UNIV)" + +lemma + shows unit_qbs_space[simp]: "qbs_space unit_quasi_borel = {()}" + and unit_qbs_Mx[simp]: "qbs_Mx unit_quasi_borel = {\r. ()}" +proof - + have "Rep_quasi_borel unit_quasi_borel = (UNIV,UNIV)" + using Abs_quasi_borel_inverse by(auto simp add: unit_quasi_borel_def qbs_closed1_def qbs_closed2_def qbs_closed3_def is_quasi_borel_def) + thus "qbs_space unit_quasi_borel = {()}" "qbs_Mx unit_quasi_borel = {\r. ()}" + by(auto simp add: qbs_space_def qbs_Mx_def UNIV_unit) +qed + +subsubsection \ Sub-Spaces \ +definition sub_qbs :: "['a quasi_borel, 'a set] \ 'a quasi_borel" where +"sub_qbs X U \ Abs_quasi_borel (qbs_space X \ U,{\. \ \ qbs_Mx X \ (\r. \ r \ U)})" + +lemma + shows sub_qbs_space: "qbs_space (sub_qbs X U) = qbs_space X \ U" + and sub_qbs_Mx: "qbs_Mx (sub_qbs X U) = {\. \ \ qbs_Mx X \ (\r. \ r \ U)}" +proof - + have "qbs_closed1 {\. \ \ qbs_Mx X \ (\r. \ r \ U)}" "qbs_closed2 (qbs_space X \ U) {\. \ \ qbs_Mx X \ (\r. \ r \ U)}" + "qbs_closed3 {\. \ \ qbs_Mx X \ (\r. \ r \ U)}" + unfolding qbs_closed1_def qbs_closed2_def qbs_closed3_def by auto + hence "Rep_quasi_borel (sub_qbs X U) = (qbs_space X \ U,{\. \ \ qbs_Mx X \ (\r. \ r \ U)})" + by(auto simp: sub_qbs_def is_quasi_borel_def qbs_Mx_to_X intro!: Abs_quasi_borel_inverse) + thus "qbs_space (sub_qbs X U) = qbs_space X \ U" "qbs_Mx (sub_qbs X U) = {\. \ \ qbs_Mx X \ (\r. \ r \ U)}" + by(simp_all add: qbs_Mx_def qbs_space_def) +qed + +lemma sub_qbs: + assumes "U \ qbs_space X" + shows "(qbs_space (sub_qbs X U), qbs_Mx (sub_qbs X U)) = (U, {f \ UNIV \ U. f \ qbs_Mx X})" + using assms by (auto simp: sub_qbs_space sub_qbs_Mx) + +lemma sub_qbs_ident: "sub_qbs X (qbs_space X) = X" + by(auto intro!: qbs_eqI simp: sub_qbs_Mx qbs_Mx_to_X) + +lemma sub_qbs_sub_qbs: "sub_qbs (sub_qbs X A) B = sub_qbs X (A \ B)" + by(auto intro!: qbs_eqI simp: sub_qbs_Mx sub_qbs_space) + +subsubsection \ Image Spaces \ +definition map_qbs :: "['a \ 'b] \ 'a quasi_borel \ 'b quasi_borel" where +"map_qbs f X = Abs_quasi_borel (f ` (qbs_space X),{f \ \ |\. \\ qbs_Mx X})" + +lemma + shows map_qbs_space: "qbs_space (map_qbs f X) = f ` (qbs_space X)" + and map_qbs_Mx: "qbs_Mx (map_qbs f X) = {f \ \ |\. \\ qbs_Mx X}" +proof - + have "{f \ \ |\. \\ qbs_Mx X} \ UNIV \ f ` (qbs_space X)" + using qbs_Mx_to_X by fastforce + moreover have "qbs_closed1 {f \ \ |\. \\ qbs_Mx X}" + unfolding qbs_closed1_def using qbs_closed1_dest by(fastforce simp: comp_def) + moreover have "qbs_closed2 (f ` (qbs_space X)) {f \ \ |\. \\ qbs_Mx X}" + unfolding qbs_closed2_def by fastforce + moreover have "qbs_closed3 {f \ \ |\. \\ qbs_Mx X}" + proof(rule qbs_closed3I') + fix P :: "real \ nat" and Fi + assume h:"\i::nat. P -` {i} \ sets borel" + "\i::nat. Fi i \ {f \ \ |\. \\ qbs_Mx X}" + then obtain \i where ha: "\i::nat. \i i \ qbs_Mx X" "\i. Fi i = f \ (\i i)" + by auto metis + hence 1:"(\r. \i (P r) r) \ qbs_Mx X" + using h(1) qbs_closed3_dest' by blast + show "(\r. Fi (P r) r) \ {f \ \ |\. \\ qbs_Mx X}" + by(auto intro!: bexI[where x="(\r. \i (P r) r)"] simp add: 1 ha comp_def) + qed + ultimately have "Rep_quasi_borel (map_qbs f X) = (f ` (qbs_space X),{f \ \ |\. \\ qbs_Mx X})" + unfolding map_qbs_def by(auto intro!: Abs_quasi_borel_inverse) + thus "qbs_space (map_qbs f X) = f ` (qbs_space X)" "qbs_Mx (map_qbs f X) = {f \ \ |\. \\ qbs_Mx X}" + by(simp_all add: qbs_space_def qbs_Mx_def) +qed + +subsubsection \ Binary Product Spaces \ +definition pair_qbs :: "['a quasi_borel, 'b quasi_borel] \ ('a \ 'b) quasi_borel" (infixr "\\<^sub>Q" 80) where +"pair_qbs X Y = Abs_quasi_borel (qbs_space X \ qbs_space Y, {f. fst \ f \ qbs_Mx X \ snd \ f \ qbs_Mx Y})" + +lemma + shows pair_qbs_space: "qbs_space (X \\<^sub>Q Y) = qbs_space X \ qbs_space Y" + and pair_qbs_Mx: "qbs_Mx (X \\<^sub>Q Y) = {f. fst \ f \ qbs_Mx X \ snd \ f \ qbs_Mx Y}" +proof - + have "{f. fst \ f \ qbs_Mx X \ snd \ f \ qbs_Mx Y} \ UNIV \ qbs_space X \ qbs_space Y" + by (auto simp: mem_Times_iff[of _ "qbs_space X" "qbs_space Y"]; use qbs_Mx_to_X in fastforce) + moreover have "qbs_closed1 {f. fst \ f \ qbs_Mx X \ snd \ f \ qbs_Mx Y}" + unfolding qbs_closed1_def by (metis (no_types, lifting) comp_assoc mem_Collect_eq qbs_closed1_dest) + moreover have "qbs_closed2 (qbs_space X \ qbs_space Y) {f. fst \ f \ qbs_Mx X \ snd \ f \ qbs_Mx Y}" + unfolding qbs_closed2_def by auto + moreover have "qbs_closed3 {f. fst \ f \ qbs_Mx X \ snd \ f \ qbs_Mx Y}" + proof(safe intro!: qbs_closed3I) + fix P :: "real \ nat" + fix Fi :: "nat \ real \ 'a \ 'b" + define Fj :: "nat \ real \ 'a" where "Fj \ \j.(fst \ Fi j)" + assume "\i. Fi i \ {f. fst \ f \ qbs_Mx X \ snd \ f \ qbs_Mx Y}" + then have "\i. Fj i \ qbs_Mx X" by (simp add: Fj_def) + moreover assume "P \ borel \\<^sub>M count_space UNIV" + ultimately have "(\r. Fj (P r) r) \ qbs_Mx X" + by auto + moreover have "fst \ (\r. Fi (P r) r) = (\r. Fj (P r) r)" by (auto simp add: Fj_def) + ultimately show "fst \ (\r. Fi (P r) r) \ qbs_Mx X" by simp + next + fix P :: "real \ nat" + fix Fi :: "nat \ real \ 'a \ 'b" + define Fj :: "nat \ real \ 'b" where "Fj \ \j.(snd \ Fi j)" + assume "\i. Fi i \ {f. fst \ f \ qbs_Mx X \ snd \ f \ qbs_Mx Y}" + then have "\i. Fj i \ qbs_Mx Y" by (simp add: Fj_def) + moreover assume "P \ borel \\<^sub>M count_space UNIV" + ultimately have "(\r. Fj (P r) r) \ qbs_Mx Y" + by auto + moreover have "snd \ (\r. Fi (P r) r) = (\r. Fj (P r) r)" by (auto simp add: Fj_def) + ultimately show "snd \ (\r. Fi (P r) r) \ qbs_Mx Y" by simp + qed + ultimately have "Rep_quasi_borel (X \\<^sub>Q Y) = (qbs_space X \ qbs_space Y, {f. fst \ f \ qbs_Mx X \ snd \ f \ qbs_Mx Y})" + unfolding pair_qbs_def by(auto intro!: Abs_quasi_borel_inverse is_quasi_borel_intro) + thus "qbs_space (X \\<^sub>Q Y) = qbs_space X \ qbs_space Y" "qbs_Mx (X \\<^sub>Q Y) = {f. fst \ f \ qbs_Mx X \ snd \ f \ qbs_Mx Y}" + by(simp_all add: qbs_space_def qbs_Mx_def) +qed + +lemma pair_qbs_fst: + assumes "qbs_space Y \ {}" + shows "map_qbs fst (X \\<^sub>Q Y) = X" +proof(rule qbs_eqI) + obtain \y where hy:"\y \ qbs_Mx Y" + using qbs_empty_equiv[of Y] assms by auto + show "qbs_Mx (map_qbs fst (X \\<^sub>Q Y)) = qbs_Mx X" + by(auto simp: map_qbs_Mx pair_qbs_Mx hy comp_def intro!: exI[where x="\r. (_ r, \y r)"]) +qed + +lemma pair_qbs_snd: + assumes "qbs_space X \ {}" + shows "map_qbs snd (X \\<^sub>Q Y) = Y" +proof(rule qbs_eqI) + obtain \x where hx:"\x \ qbs_Mx X" + using qbs_empty_equiv[of X] assms by auto + show "qbs_Mx (map_qbs snd (X \\<^sub>Q Y)) = qbs_Mx Y" + by(auto simp: map_qbs_Mx pair_qbs_Mx hx comp_def intro!: exI[where x="\r. (\x r, _ r)"]) +qed + +subsubsection \ Binary Coproduct Spaces \ +definition copair_qbs_Mx :: "['a quasi_borel, 'b quasi_borel] \ (real => 'a + 'b) set" where +"copair_qbs_Mx X Y \ + {g. \ S \ sets borel. + (S = {} \ (\ \1\ qbs_Mx X. g = (\r. Inl (\1 r)))) \ + (S = UNIV \ (\ \2\ qbs_Mx Y. g = (\r. Inr (\2 r)))) \ + ((S \ {} \ S \ UNIV) \ + (\ \1\ qbs_Mx X. \ \2\ qbs_Mx Y. + g = (\r::real. (if (r \ S) then Inl (\1 r) else Inr (\2 r)))))}" + + +definition copair_qbs :: "['a quasi_borel, 'b quasi_borel] \ ('a + 'b) quasi_borel" (infixr "\\<^sub>Q" 65) where +"copair_qbs X Y \ Abs_quasi_borel (qbs_space X <+> qbs_space Y, copair_qbs_Mx X Y)" + + +text \ The following is an equivalent definition of @{term copair_qbs_Mx}. \ +definition copair_qbs_Mx2 :: "['a quasi_borel, 'b quasi_borel] \ (real => 'a + 'b) set" where +"copair_qbs_Mx2 X Y \ + {g. (if qbs_space X = {} \ qbs_space Y = {} then False + else if qbs_space X \ {} \ qbs_space Y = {} then + (\\1\ qbs_Mx X. g = (\r. Inl (\1 r))) + else if qbs_space X = {} \ qbs_space Y \ {} then + (\\2\ qbs_Mx Y. g = (\r. Inr (\2 r))) + else + (\S \ sets borel. \\1\ qbs_Mx X. \\2\ qbs_Mx Y. + g = (\r::real. (if (r \ S) then Inl (\1 r) else Inr (\2 r))))) }" + +lemma copair_qbs_Mx_equiv :"copair_qbs_Mx (X :: 'a quasi_borel) (Y :: 'b quasi_borel) = copair_qbs_Mx2 X Y" +proof safe +(* \ *) + fix g :: "real \ 'a + 'b" + assume "g \ copair_qbs_Mx X Y" + then obtain S where hs:"S\ sets borel \ + (S = {} \ (\ \1\ qbs_Mx X. g = (\r. Inl (\1 r)))) \ + (S = UNIV \ (\ \2\ qbs_Mx Y. g = (\r. Inr (\2 r)))) \ + ((S \ {} \ S \ UNIV) \ + (\ \1\ qbs_Mx X. + \ \2\ qbs_Mx Y. + g = (\r::real. (if (r \ S) then Inl (\1 r) else Inr (\2 r)))))" + by (auto simp add: copair_qbs_Mx_def) + consider "S = {}" | "S = UNIV" | "S \ {} \ S \ UNIV" by auto + then show "g \ copair_qbs_Mx2 X Y" + proof cases + assume "S = {}" + from hs this have "\ \1\ qbs_Mx X. g = (\r. Inl (\1 r))" by simp + then obtain \1 where h1:"\1\ qbs_Mx X \ g = (\r. Inl (\1 r))" by auto + have "qbs_space X \ {}" + using qbs_empty_equiv h1 + by auto + then have "(qbs_space X \ {} \ qbs_space Y = {}) \ (qbs_space X \ {} \ qbs_space Y \ {})" + by simp + then show "g \ copair_qbs_Mx2 X Y" + proof + assume "qbs_space X \ {} \ qbs_space Y = {}" + then show "g \ copair_qbs_Mx2 X Y" + by(simp add: copair_qbs_Mx2_def \\ \1\ qbs_Mx X. g = (\r. Inl (\1 r))\) + next + assume "qbs_space X \ {} \ qbs_space Y \ {}" + then obtain \2 where "\2 \ qbs_Mx Y" using qbs_empty_equiv by force + define S' :: "real set" + where "S' \ UNIV" + define g' :: "real \ 'a + 'b" + where "g' \ (\r::real. (if (r \ S') then Inl (\1 r) else Inr (\2 r)))" + from \qbs_space X \ {} \ qbs_space Y \ {}\ h1 \\2 \ qbs_Mx Y\ + have "g' \ copair_qbs_Mx2 X Y" + by(force simp add: S'_def g'_def copair_qbs_Mx2_def) + moreover have "g = g'" + using h1 by(simp add: g'_def S'_def) + ultimately show ?thesis + by simp + qed + next + assume "S = UNIV" + from hs this have "\ \2\ qbs_Mx Y. g = (\r. Inr (\2 r))" by simp + then obtain \2 where h2:"\2\ qbs_Mx Y \ g = (\r. Inr (\2 r))" by auto + have "qbs_space Y \ {}" + using qbs_empty_equiv h2 + by auto + then have "(qbs_space X = {} \ qbs_space Y \ {}) \ (qbs_space X \ {} \ qbs_space Y \ {})" + by simp + then show "g \ copair_qbs_Mx2 X Y" + proof + assume "qbs_space X = {} \ qbs_space Y \ {}" + then show ?thesis + by(simp add: copair_qbs_Mx2_def \\ \2\ qbs_Mx Y. g = (\r. Inr (\2 r))\) + next + assume "qbs_space X \ {} \ qbs_space Y \ {}" + then obtain \1 where "\1 \ qbs_Mx X" using qbs_empty_equiv by force + define S' :: "real set" + where "S' \ {}" + define g' :: "real \ 'a + 'b" + where "g' \ (\r::real. (if (r \ S') then Inl (\1 r) else Inr (\2 r)))" + from \qbs_space X \ {} \ qbs_space Y \ {}\ h2 \\1 \ qbs_Mx X\ + have "g' \ copair_qbs_Mx2 X Y" + by(force simp add: S'_def g'_def copair_qbs_Mx2_def) + moreover have "g = g'" + using h2 by(simp add: g'_def S'_def) + ultimately show ?thesis + by simp + qed + next + assume "S \ {} \ S \ UNIV" + then have + h: "\ \1\ qbs_Mx X. + \ \2\ qbs_Mx Y. + g = (\r::real. (if (r \ S) then Inl (\1 r) else Inr (\2 r)))" + using hs by simp + then have "qbs_space X \ {} \ qbs_space Y \ {}" + by (metis empty_iff qbs_empty_equiv) + thus ?thesis + using hs h by(auto simp add: copair_qbs_Mx2_def) + qed + +(* \ *) +next + fix g :: "real \ 'a + 'b" + assume "g \ copair_qbs_Mx2 X Y" + then have + h: "if qbs_space X = {} \ qbs_space Y = {} then False + else if qbs_space X \ {} \ qbs_space Y = {} then + (\\1\ qbs_Mx X. g = (\r. Inl (\1 r))) + else if qbs_space X = {} \ qbs_space Y \ {} then + (\\2\ qbs_Mx Y. g = (\r. Inr (\2 r))) + else + (\S \ sets borel. \\1\ qbs_Mx X. \\2\ qbs_Mx Y. + g = (\r::real. (if (r \ S) then Inl (\1 r) else Inr (\2 r))))" + by(simp add: copair_qbs_Mx2_def) + consider "(qbs_space X = {} \ qbs_space Y = {})" | + "(qbs_space X \ {} \ qbs_space Y = {})" | + "(qbs_space X = {} \ qbs_space Y \ {})" | + "(qbs_space X \ {} \ qbs_space Y \ {})" by auto + then show "g \ copair_qbs_Mx X Y" + proof cases + assume "qbs_space X = {} \ qbs_space Y = {}" + then show ?thesis + using \g \ copair_qbs_Mx2 X Y\ by(simp add: copair_qbs_Mx2_def) + next + assume "qbs_space X \ {} \ qbs_space Y = {}" + from h this have "\\1\ qbs_Mx X. g = (\r. Inl (\1 r))" by simp + thus ?thesis + by(auto simp add: copair_qbs_Mx_def) + next + assume "qbs_space X = {} \ qbs_space Y \ {}" + from h this have "\\2\ qbs_Mx Y. g = (\r. Inr (\2 r))" by simp + thus ?thesis + unfolding copair_qbs_Mx_def + by(force simp add: copair_qbs_Mx_def) + next + assume "qbs_space X \ {} \ qbs_space Y \ {}" + from h this obtain S \1 \2 where Sag: + "S \ sets borel" "\1 \ qbs_Mx X" "\2 \ qbs_Mx Y" "g = (\r. if r \ S then Inl (\1 r) else Inr (\2 r))" + by auto + consider "S = {}" | "S = UNIV" | "S \ {}" "S \ UNIV" by auto + then show "g \ copair_qbs_Mx X Y" + proof cases + assume "S = {}" + then have [simp]: "(\r. if r \ S then Inl (\1 r) else Inr (\2 r)) = (\r. Inr (\2 r))" + by simp + show ?thesis + using \\2 \ qbs_Mx Y\ unfolding copair_qbs_Mx_def + by(auto intro! : bexI[where x=UNIV] simp: Sag) + next + assume "S = UNIV" + then have "(\r. if r \ S then Inl (\1 r) else Inr (\2 r)) = (\r. Inl (\1 r))" + by simp + then show ?thesis + using Sag by(auto simp add: copair_qbs_Mx_def) + next + assume "S \ {}" "S \ UNIV" + then show ?thesis + using Sag by(auto simp add: copair_qbs_Mx_def) + qed + qed +qed + +lemma + shows copair_qbs_space: "qbs_space (X \\<^sub>Q Y) = qbs_space X <+> qbs_space Y" (is ?goal1) + and copair_qbs_Mx: "qbs_Mx (X \\<^sub>Q Y) = copair_qbs_Mx X Y" (is ?goal2) +proof - + have "copair_qbs_Mx X Y \ UNIV \ qbs_space X <+> qbs_space Y" + proof + fix g + assume "g \ copair_qbs_Mx X Y" + then obtain S where hs:"S\ sets borel \ + (S = {} \ (\ \1\ qbs_Mx X. g = (\r. Inl (\1 r)))) \ + (S = UNIV \ (\ \2\ qbs_Mx Y. g = (\r. Inr (\2 r)))) \ + ((S \ {} \ S \ UNIV) \ + (\ \1\ qbs_Mx X. + \ \2\ qbs_Mx Y. + g = (\r::real. (if (r \ S) then Inl (\1 r) else Inr (\2 r)))))" + by (auto simp add: copair_qbs_Mx_def) + consider "S = {}" | "S = UNIV" | "S \ {} \ S \ UNIV" by auto + then show "g \ UNIV \ qbs_space X <+> qbs_space Y" + proof cases + assume "S = {}" + then show ?thesis + using hs qbs_Mx_to_X by auto + next + assume "S = UNIV" + then show ?thesis + using hs qbs_Mx_to_X by auto + next + assume "S \ {} \ S \ UNIV" + then have "\ \1\ qbs_Mx X. \ \2\ qbs_Mx Y. + g = (\r::real. (if (r \ S) then Inl (\1 r) else Inr (\2 r)))" using hs by simp + then show ?thesis + by(auto dest: qbs_Mx_to_X) + qed + qed + moreover have "qbs_closed1 (copair_qbs_Mx X Y)" + proof(rule qbs_closed1I) + fix g and f :: "real \ real" + assume "g \ copair_qbs_Mx X Y" and [measurable]: "f \ borel \\<^sub>M borel" + then have "g \ copair_qbs_Mx2 X Y" using copair_qbs_Mx_equiv by auto + consider "(qbs_space X = {} \ qbs_space Y = {})" | + "(qbs_space X \ {} \ qbs_space Y = {})" | + "(qbs_space X = {} \ qbs_space Y \ {})" | + "(qbs_space X \ {} \ qbs_space Y \ {})" by auto + then have "g \ f \ copair_qbs_Mx2 X Y" + proof cases + assume "qbs_space X = {} \ qbs_space Y = {}" + then show ?thesis + using \g \ copair_qbs_Mx2 X Y\ qbs_empty_equiv by(simp add: copair_qbs_Mx2_def) + next + assume "qbs_space X \ {} \ qbs_space Y = {}" + then obtain \1 where h1:"\1\ qbs_Mx X \ g = (\r. Inl (\1 r))" + using \g \ copair_qbs_Mx2 X Y\ by(auto simp add: copair_qbs_Mx2_def) + then have "\1 \ f \ qbs_Mx X" + by auto + moreover have "g \ f = (\r. Inl ((\1 \ f) r))" + using h1 by auto + ultimately show ?thesis + using \qbs_space X \ {} \ qbs_space Y = {}\ by(force simp add: copair_qbs_Mx2_def) + next + assume "(qbs_space X = {} \ qbs_space Y \ {})" + then obtain \2 where h2:"\2\ qbs_Mx Y \ g = (\r. Inr (\2 r))" + using \g \ copair_qbs_Mx2 X Y\ by(auto simp add: copair_qbs_Mx2_def) + then have "\2 \ f \ qbs_Mx Y" + by auto + moreover have "g \ f = (\r. Inr ((\2 \ f) r))" + using h2 by auto + ultimately show ?thesis + using \(qbs_space X = {} \ qbs_space Y \ {})\ by(force simp add: copair_qbs_Mx2_def) + next + assume "qbs_space X \ {} \ qbs_space Y \ {}" + then have "\S \ sets borel. \\1\ qbs_Mx X. \\2\ qbs_Mx Y. + g = (\r::real. (if (r \ S) then Inl (\1 r) else Inr (\2 r)))" + using \g \ copair_qbs_Mx2 X Y\ by(simp add: copair_qbs_Mx2_def) + then show ?thesis + proof safe + fix S \1 \2 + assume [measurable]:"S \ sets borel" and "\1\ qbs_Mx X" "\2 \ qbs_Mx Y" + "g = (\r. if r \ S then Inl (\1 r) else Inr (\2 r))" + have "f -` S \ sets borel" + using \S \ sets borel\ \f \ borel_measurable borel\ measurable_sets_borel by blast + moreover have "\1 \ f \ qbs_Mx X" + using \\1\ qbs_Mx X\ by(auto simp add: qbs_closed1_def) + moreover have "\2 \ f \ qbs_Mx Y" + using \\2\ qbs_Mx Y\ by(auto simp add: qbs_closed1_def) + moreover have "(\r. if r \ S then Inl (\1 r) else Inr (\2 r)) \ f = (\r. if r \ f -` S then Inl ((\1 \ f) r) else Inr ((\2 \ f) r))" + by auto + ultimately show "(\r. if r \ S then Inl (\1 r) else Inr (\2 r)) \ f \ copair_qbs_Mx2 X Y" + using \qbs_space X \ {} \ qbs_space Y \ {}\ by(force simp add: copair_qbs_Mx2_def) + qed + qed + thus "g \ f \ copair_qbs_Mx X Y" + using copair_qbs_Mx_equiv by auto + qed + moreover have "qbs_closed2 (qbs_space X <+> qbs_space Y) (copair_qbs_Mx X Y)" + proof(rule qbs_closed2I) + fix y + assume "y \ qbs_space X <+> qbs_space Y" + then consider "y \ Inl ` (qbs_space X)" | "y \ Inr ` (qbs_space Y)" + by auto + thus "(\r. y) \ copair_qbs_Mx X Y" + proof cases + case 1 + then obtain x where x: "y = Inl x" "x \ qbs_space X" + by auto + define \1 :: "real \ _" where "\1 \ (\r. x)" + have "\1 \ qbs_Mx X" using \x \ qbs_space X\ qbs_decomp + by(force simp add: qbs_closed2_def \1_def) + moreover have "(\r. Inl x) = (\l. Inl (\1 l))" by (simp add: \1_def) + moreover have "{} \ sets borel" by auto + ultimately show "(\r. y) \ copair_qbs_Mx X Y" + by(auto simp add: copair_qbs_Mx_def x) + next + case 2 + then obtain x where x: "y = Inr x" "x \ qbs_space Y" + by auto + define \2 :: "real \ _" where "\2 \ (\r. x)" + have "\2 \ qbs_Mx Y" using \x \ qbs_space Y\ qbs_decomp + by(force simp add: qbs_closed2_def \2_def) + moreover have "(\r. Inr x) = (\l. Inr (\2 l))" by (simp add: \2_def) + moreover have "UNIV \ sets borel" by auto + ultimately show "(\r. y) \ copair_qbs_Mx X Y" + unfolding copair_qbs_Mx_def + by(auto intro!: bexI[where x=UNIV] simp: x) + qed + qed + moreover have "qbs_closed3 (copair_qbs_Mx X Y)" + proof(safe intro!: qbs_closed3I) + fix P :: "real \ nat" + fix Fi :: "nat \ real \_ + _" + assume "P \ borel \\<^sub>M count_space UNIV" + "\i. Fi i \ copair_qbs_Mx X Y" + then have "\i. Fi i \ copair_qbs_Mx2 X Y" using copair_qbs_Mx_equiv by blast + consider "(qbs_space X = {} \ qbs_space Y = {})" | + "(qbs_space X \ {} \ qbs_space Y = {})" | + "(qbs_space X = {} \ qbs_space Y \ {})" | + "(qbs_space X \ {} \ qbs_space Y \ {})" by auto + then have "(\r. Fi (P r) r) \ copair_qbs_Mx2 X Y" + proof cases + assume "qbs_space X = {} \ qbs_space Y = {}" + then show ?thesis + using \\i. Fi i \ copair_qbs_Mx2 X Y\ qbs_empty_equiv + by(simp add: copair_qbs_Mx2_def) + next + assume "qbs_space X \ {} \ qbs_space Y = {}" + then have "\i. \\i. \i \ qbs_Mx X \ Fi i = (\r. Inl (\i r))" + using \\i. Fi i \ copair_qbs_Mx2 X Y\ by(auto simp add: copair_qbs_Mx2_def) + then have "\\1. \i. \1 i \ qbs_Mx X \ Fi i = (\r. Inl (\1 i r))" + by(rule choice) + then obtain \1 :: "nat \ real \ _" + where h1: "\i. \1 i \ qbs_Mx X \ Fi i = (\r. Inl (\1 i r))" by auto + define \ :: "real \ _" where "\ \ (\r. \1 (P r) r)" + from \P \ borel \\<^sub>M count_space UNIV\ h1 + have "\ \ qbs_Mx X" by (simp add: \_def) + moreover have "(\r. Fi (P r) r) = (\r. Inl (\ r))" + using h1 by(simp add: \_def) + ultimately show ?thesis + using \qbs_space X \ {} \ qbs_space Y = {}\ by (auto simp add: copair_qbs_Mx2_def) + next + assume "qbs_space X = {} \ qbs_space Y \ {}" + then have "\i. \\i. \i \ qbs_Mx Y \ Fi i = (\r. Inr (\i r))" + using \\i. Fi i \ copair_qbs_Mx2 X Y\ by(auto simp add: copair_qbs_Mx2_def) + then have "\\2. \i. \2 i \ qbs_Mx Y \ Fi i = (\r. Inr (\2 i r))" + by(rule choice) + then obtain \2 :: "nat \ real \ _" + where h2: "\i. \2 i \ qbs_Mx Y \ Fi i = (\r. Inr (\2 i r))" by auto + define \ :: "real \ _" where "\ \ (\r. \2 (P r) r)" + from \P \ borel \\<^sub>M count_space UNIV\ h2 + have "\ \ qbs_Mx Y" by(simp add: \_def) + moreover have "(\r. Fi (P r) r) = (\r. Inr (\ r))" + using h2 by(simp add: \_def) + ultimately show ?thesis + using \qbs_space X = {} \ qbs_space Y \ {}\ by (auto simp add: copair_qbs_Mx2_def) + next + assume "qbs_space X \ {} \ qbs_space Y \ {}" + then have "\i. \Si. Si \ sets borel \ (\\1i\ qbs_Mx X. \\2i\ qbs_Mx Y. + Fi i = (\r::real. (if (r \ Si) then Inl (\1i r) else Inr (\2i r))))" + using \\i. Fi i \ copair_qbs_Mx2 X Y\ by (auto simp add: copair_qbs_Mx2_def) + then have "\S. \i. S i \ sets borel \ (\\1i\ qbs_Mx X. \\2i\ qbs_Mx Y. + Fi i = (\r::real. (if (r \ S i) then Inl (\1i r) else Inr (\2i r))))" + by(rule choice) + then obtain S :: "nat \ real set" + where hs :"\i. S i \ sets borel \ (\\1i\ qbs_Mx X. \\2i\ qbs_Mx Y. + Fi i = (\r::real. (if (r \ S i) then Inl (\1i r) else Inr (\2i r))))" + by auto + then have "\i. \\1i. \1i \ qbs_Mx X \ (\\2i\ qbs_Mx Y. + Fi i = (\r::real. (if (r \ S i) then Inl (\1i r) else Inr (\2i r))))" + by blast + then have "\\1. \i. \1 i \ qbs_Mx X \ (\\2i\ qbs_Mx Y. + Fi i = (\r::real. (if (r \ S i) then Inl (\1 i r) else Inr (\2i r))))" + by(rule choice) + then obtain \1 where h1: "\i. \1 i \ qbs_Mx X \ (\\2i\ qbs_Mx Y. + Fi i = (\r::real. (if (r \ S i) then Inl (\1 i r) else Inr (\2i r))))" + by auto + define \1 :: "real \ _" where "\1 \ (\r. \1 (P r) r)" + from \P \ borel \\<^sub>M count_space UNIV\ h1 + have "\1 \ qbs_Mx X" by(simp add: \1_def) + from h1 have "\i. \\2i. \2i\ qbs_Mx Y \ + Fi i = (\r::real. (if (r \ S i) then Inl (\1 i r) else Inr (\2i r)))" + by auto + then have "\\2. \i. \2 i\ qbs_Mx Y \ + Fi i = (\r::real. (if (r \ S i) then Inl (\1 i r) else Inr (\2 i r)))" + by(rule choice) + then obtain \2 + where h2: "\i. \2 i\ qbs_Mx Y \ + Fi i = (\r::real. (if (r \ S i) then Inl (\1 i r) else Inr (\2 i r)))" + by auto + define \2 :: "real \ _" where "\2 \ (\r. \2 (P r) r)" + from \P \ borel \\<^sub>M count_space UNIV\ h2 + have "\2 \ qbs_Mx Y" by(simp add: \2_def) + define A :: "nat \ real set" where "A \ (\i. S i \ P -` {i})" + have [measurable]:"\i. A i \ sets borel" + using A_def hs measurable_separate[OF \P \ borel \\<^sub>M count_space UNIV\] by blast + define S' :: "real set" where "S' \ {r. r \ S (P r)}" + have "S' = (\i::nat. A i)" + by(auto simp add: S'_def A_def) + hence "S' \ sets borel" by auto + from h2 have "(\r. Fi (P r) r) = (\r. (if r \ S' then Inl (\1 r) + else Inr (\2 r)))" + by(auto simp add: \1_def \2_def S'_def) + thus "(\r. Fi (P r) r) \ copair_qbs_Mx2 X Y" + using \qbs_space X \ {} \ qbs_space Y \ {}\ \S' \ sets borel\ \\1 \ qbs_Mx X\ \\2 \ qbs_Mx Y\ + by(auto simp add: copair_qbs_Mx2_def) + qed + thus "(\r. Fi (P r) r) \ copair_qbs_Mx X Y" + using copair_qbs_Mx_equiv by auto + qed + ultimately have "Rep_quasi_borel (copair_qbs X Y) = (qbs_space X <+> qbs_space Y, copair_qbs_Mx X Y)" + unfolding copair_qbs_def by(auto intro!: Abs_quasi_borel_inverse) + thus ?goal1 ?goal2 + by(simp_all add: qbs_space_def qbs_Mx_def) +qed + +lemma copair_qbs_MxD: + assumes "g \ qbs_Mx (X \\<^sub>Q Y)" + and "\\. \ \ qbs_Mx X \ g = (\r. Inl (\ r)) \ P g" + and "\\. \ \ qbs_Mx Y \ g = (\r. Inr (\ r)) \ P g" + and "\S \ \. (S :: real set) \ sets borel \ S \ {} \ S \ UNIV \ \ \ qbs_Mx X \ \ \ qbs_Mx Y \ g = (\r. if r \ S then Inl (\ r) else Inr (\ r)) \ P g" + shows "P g" + using assms by(fastforce simp: copair_qbs_Mx copair_qbs_Mx_def) + +subsubsection \ Product Spaces \ +definition PiQ :: "'a set \ ('a \ 'b quasi_borel) \ ('a \ 'b) quasi_borel" where +"PiQ I X \ Abs_quasi_borel (\\<^sub>E i\I. qbs_space (X i), {\. \i. (i \ I \ (\r. \ r i) \ qbs_Mx (X i)) \ (i \ I \ (\r. \ r i) = (\r. undefined))})" + +syntax + "_PiQ" :: "pttrn \ 'i set \ 'a quasi_borel \ ('i => 'a) quasi_borel" ("(3\\<^sub>Q _\_./ _)" 10) +translations + "\\<^sub>Q x\I. X" == "CONST PiQ I (\x. X)" + +lemma + shows PiQ_space: "qbs_space (PiQ I X) = (\\<^sub>E i\I. qbs_space (X i))" (is ?goal1) + and PiQ_Mx: "qbs_Mx (PiQ I X) = {\. \i. (i \ I \ (\r. \ r i) \ qbs_Mx (X i)) \ (i \ I \ (\r. \ r i) = (\r. undefined))}" (is "_ = ?Mx") +proof - + have "?Mx \ UNIV \ (\\<^sub>E i\I. qbs_space (X i))" + using qbs_Mx_to_X[of _ "X _"] by auto metis + moreover have "qbs_closed1 ?Mx" + proof(safe intro!: qbs_closed1I) + fix \ i and f :: "real \ real" + assume h[measurable]:"\i. (i \ I \ (\r. \ r i) \ qbs_Mx (X i)) \ (i \ I \ (\r. \ r i) = (\r. undefined))" + "f \ borel \\<^sub>M borel" + show "(\r. (\ \ f) r i) \ qbs_Mx (X i)" if i:"i \ I" + proof - + have "(\r. \ r i) \ f \ qbs_Mx (X i)" + using h i by auto + thus "(\r. (\ \ f) r i) \ qbs_Mx (X i)" + by(simp add: comp_def) + qed + show "i \ I \ (\r. (\ \ f) r i) = (\r. undefined)" + by (metis comp_apply h(1)) + qed + moreover have "qbs_closed2 (\\<^sub>E i\I. qbs_space (X i)) ?Mx" + by(rule qbs_closed2I) (auto simp: PiE_def extensional_def Pi_def) + moreover have "qbs_closed3 ?Mx" + proof(rule qbs_closed3I) + fix P :: "real \ nat" and Fi + assume h:"P \ borel \\<^sub>M count_space UNIV" + "\i::nat. Fi i \ ?Mx" + show "(\r. Fi (P r) r) \ ?Mx" + proof safe + fix i + assume hi:"i \ I" + then show "(\r. Fi (P r) r i) \ qbs_Mx (X i)" + using h qbs_closed3_dest[OF h(1),of "\j r. Fi j r i"] + by auto + next + show "\i. i \ I \ (\r. Fi (P r) r i) = (\r. undefined)" + using h by auto meson + qed + qed + ultimately have "Rep_quasi_borel (PiQ I X) = (\\<^sub>E i\I. qbs_space (X i), ?Mx)" + by(auto intro!: Abs_quasi_borel_inverse is_quasi_borel_intro simp: PiQ_def) + thus ?goal1 "qbs_Mx (PiQ I X) = ?Mx" + by(simp_all add: qbs_space_def qbs_Mx_def) +qed + +lemma prod_qbs_MxI: + assumes "\i. i \ I \ (\r. \ r i) \ qbs_Mx (X i)" + and "\i. i \ I \ (\r. \ r i) = (\r. undefined)" + shows "\ \ qbs_Mx (PiQ I X)" + using assms by(auto simp: PiQ_Mx) + +lemma prod_qbs_MxD: + assumes "\ \ qbs_Mx (PiQ I X)" + shows "\i. i \ I \ (\r. \ r i) \ qbs_Mx (X i)" + and "\i. i \ I \ (\r. \ r i) = (\r. undefined)" + and "\i r. i \ I \ \ r i = undefined" + using assms by(auto simp: PiQ_Mx dest: fun_cong[where g="(\r. undefined)"]) + +lemma PiQ_eqI: + assumes "\i. i \ I \ X i = Y i" + shows "PiQ I X = PiQ I Y" + by(auto intro!: qbs_eqI simp: PiQ_Mx assms) + +lemma PiQ_empty: "qbs_space (PiQ {} X) = {\i. undefined}" + by(auto simp: PiQ_space) + +lemma PiQ_empty_Mx: "qbs_Mx (PiQ {} X) = {\r i. undefined}" + by(auto simp: PiQ_Mx) meson + +subsubsection \ Coproduct Spaces \ +definition coprod_qbs_Mx :: "['a set, 'a \ 'b quasi_borel] \ (real \ 'a \ 'b) set" where +"coprod_qbs_Mx I X \ { \r. (f r, \ (f r) r) |f \. f \ borel \\<^sub>M count_space I \ (\i\range f. \ i \ qbs_Mx (X i))}" + +definition coprod_qbs_Mx' :: "['a set, 'a \ 'b quasi_borel] \ (real \ 'a \ 'b) set" where +"coprod_qbs_Mx' I X \ { \r. (f r, \ (f r) r) |f \. f \ borel \\<^sub>M count_space I \ (\i. (i \ range f \ qbs_space (X i) \ {}) \ \ i \ qbs_Mx (X i))}" + +lemma coproduct_qbs_Mx_eq: + "coprod_qbs_Mx I X = coprod_qbs_Mx' I X" +proof safe + fix \ + assume "\ \ coprod_qbs_Mx I X" + then obtain f \ where hfb: + "f \ borel \\<^sub>M count_space I" "\i. i \ range f \ \ i \ qbs_Mx (X i)" "\ = (\r. (f r, \ (f r) r))" + unfolding coprod_qbs_Mx_def by blast + define \' where "\' \ (\i. if i \ range f then \ i + else if qbs_space (X i) \ {} then (SOME \. \ \ qbs_Mx (X i)) + else \ i)" + have 1:"\ = (\r. (f r, \' (f r) r))" + by(simp add: hfb(3) \'_def) + have 2:"\i. qbs_space (X i) \ {} \ \' i \ qbs_Mx (X i)" + proof - + fix i + assume hne:"qbs_space (X i) \ {}" + then obtain x where "x \ qbs_space (X i)" by auto + hence "(\r. x) \ qbs_Mx (X i)" by auto + thus "\' i \ qbs_Mx (X i)" + by(cases "i \ range f") (auto simp: \'_def hfb(2) hne intro!: someI2[where a="\r. x"]) + qed + show "\ \ coprod_qbs_Mx' I X" + using hfb(1,2) 1 2 \'_def by(auto simp: coprod_qbs_Mx'_def intro!: exI[where x=f] exI[where x=\']) +next + fix \ + assume "\ \ coprod_qbs_Mx' I X" + then obtain f \ where hfb: + "f \ borel \\<^sub>M count_space I" "\i. qbs_space (X i) \ {} \ \ i \ qbs_Mx (X i)" + "\i. i \ range f \ \ i \ qbs_Mx (X i)" "\ = (\r. (f r, \ (f r) r))" + unfolding coprod_qbs_Mx'_def by blast + show "\ \ coprod_qbs_Mx I X" + by(auto simp: hfb(4) coprod_qbs_Mx_def intro!: hfb(1) hfb(3)) +qed + +definition coprod_qbs :: "['a set, 'a \ 'b quasi_borel] \ ('a \ 'b) quasi_borel" where +"coprod_qbs I X \ Abs_quasi_borel (SIGMA i:I. qbs_space (X i), coprod_qbs_Mx I X)" + +syntax + "_coprod_qbs" :: "pttrn \ 'i set \ 'a quasi_borel \ ('i \ 'a) quasi_borel" ("(3\\<^sub>Q _\_./ _)" 10) +translations + "\\<^sub>Q x\I. X" \ "CONST coprod_qbs I (\x. X)" + +lemma + shows coprod_qbs_space: "qbs_space (coprod_qbs I X) = (SIGMA i:I. qbs_space (X i))" (is ?goal1) + and coprod_qbs_Mx: "qbs_Mx (coprod_qbs I X) = coprod_qbs_Mx I X" (is ?goal2) +proof - + have "coprod_qbs_Mx I X \ UNIV \ (SIGMA i:I. qbs_space (X i))" + by(fastforce simp: coprod_qbs_Mx_def dest: measurable_space qbs_Mx_to_X) + moreover have "qbs_closed1 (coprod_qbs_Mx I X)" + proof(rule qbs_closed1I) + fix \ and f :: "real \ real" + assume "\ \ coprod_qbs_Mx I X" + and 1[measurable]: "f \ borel \\<^sub>M borel" + then obtain \ g where ha: + "\i. i \ range g \ \ i \ qbs_Mx (X i)" "\ = (\r. (g r, \ (g r) r))" and [measurable]:"g \ borel \\<^sub>M count_space I" + by(fastforce simp: coprod_qbs_Mx_def) + then have "\i. i \ range g \ \ i \ f \ qbs_Mx (X i)" + by simp + thus "\ \ f \ coprod_qbs_Mx I X" + unfolding coprod_qbs_Mx_def by (auto intro!: exI[where x="g \ f"] exI[where x="\i. \ i \ f"] simp: ha(2)) + qed + moreover have "qbs_closed2 (SIGMA i:I. qbs_space (X i)) (coprod_qbs_Mx I X)" + proof(safe intro!: qbs_closed2I) + fix i x + assume "i \ I" "x \ qbs_space (X i)" + then show "(\r. (i,x)) \ coprod_qbs_Mx I X" + by(auto simp: coprod_qbs_Mx_def intro!: exI[where x="\r. i"]) + qed + moreover have "qbs_closed3 (coprod_qbs_Mx I X)" + proof(rule qbs_closed3I) + fix P :: "real \ nat" and Fi + assume h[measurable]:"P \ borel \\<^sub>M count_space UNIV" + "\i :: nat. Fi i \ coprod_qbs_Mx I X" + then have "\i. \fi \i. Fi i = (\r. (fi r, \i (fi r) r)) \ fi \ borel \\<^sub>M count_space I \ (\j. (j \ range fi \ qbs_space (X j) \ {}) \ \i j \ qbs_Mx (X j))" + by(auto simp: coproduct_qbs_Mx_eq coprod_qbs_Mx'_def) + then obtain fi where + "\i. \\i. Fi i = (\r. (fi i r, \i (fi i r) r)) \ fi i \ borel \\<^sub>M count_space I \ (\j. (j \ range (fi i) \ qbs_space (X j) \ {}) \ \i j \ qbs_Mx (X j))" + by(fastforce intro!: choice) + then obtain \i where + "\i. Fi i = (\r. (fi i r, \i i (fi i r) r)) \ fi i \ borel \\<^sub>M count_space I \ (\j. (j \ range (fi i) \ qbs_space (X j) \ {}) \ \i i j \ qbs_Mx (X j))" + by(fastforce intro!: choice) + then have hf[measurable]: + "\i. Fi i = (\r. (fi i r, \i i (fi i r) r))" "\i. fi i \ borel \\<^sub>M count_space I" "\i j. j \ range (fi i) \ \i i j \ qbs_Mx (X j)" "\i j. qbs_space (X j) \ {} \ \i i j \ qbs_Mx (X j)" + by auto + + define f' where "f' \ (\r. fi (P r) r)" + define \' where "\' \ (\i r. \i (P r) i r)" + have 1:"(\r. Fi (P r) r) = (\r. (f' r, \' (f' r) r))" + by(simp add: \'_def f'_def hf) + have "f' \ borel \\<^sub>M count_space I" + by(simp add: f'_def) + moreover have "\i. i \ range f' \ \' i \ qbs_Mx (X i)" + proof - + fix i + assume hi:"i \ range f'" + then obtain r where hr: "i = fi (P r) r" by(auto simp: f'_def) + hence "i \ range (fi (P r))" by simp + hence "\i (P r) i \ qbs_Mx (X i)" by(simp add: hf) + hence "qbs_space (X i) \ {}" + by(auto simp: qbs_empty_equiv) + hence "\j. \i j i \ qbs_Mx (X i)" + by(simp add: hf(4)) + then show "\' i \ qbs_Mx (X i)" + by(auto simp: \'_def h(1) intro!: qbs_closed3_dest[of P "\j. \i j i"]) + qed + ultimately show "(\r. Fi (P r) r) \ coprod_qbs_Mx I X" + by(auto simp: 1 coprod_qbs_Mx_def intro!: exI[where x=f']) + qed + ultimately have "Rep_quasi_borel (coprod_qbs I X) = (SIGMA i:I. qbs_space (X i), coprod_qbs_Mx I X)" + unfolding coprod_qbs_def by(fastforce intro!: Abs_quasi_borel_inverse) + thus ?goal1 ?goal2 + by(simp_all add: qbs_space_def qbs_Mx_def) +qed + +lemma coprod_qbs_MxI: + assumes "f \ borel \\<^sub>M count_space I" + and "\i. i \ range f \ \ i \ qbs_Mx (X i)" + shows "(\r. (f r, \ (f r) r)) \ qbs_Mx (coprod_qbs I X)" + using assms unfolding coprod_qbs_Mx_def coprod_qbs_Mx by blast + +lemma coprod_qbs_eqI: + assumes "\i. i \ I \ X i = Y i" + shows "coprod_qbs I X = coprod_qbs I Y" + using assms by(auto intro!: qbs_eqI simp: coprod_qbs_Mx coprod_qbs_Mx_def) (metis UNIV_I measurable_space space_borel space_count_space)+ + +subsubsection \ List Spaces \ +text \ We define the quasi-Borel spaces on list using the following isomorphism. + \begin{align*} + List(X) \cong \coprod_{n\in \mathbb{N}} \prod_{0\leq i < n} X + \end{align*}\ +definition "list_of X \ \\<^sub>Q n\(UNIV :: nat set).\\<^sub>Q i\{.. (nat \ 'a)" where +"list_nil \ (0, \n. undefined)" +definition list_cons :: "['a, nat \ (nat \ 'a)] \ nat \ (nat \ 'a)" where +"list_cons x l \ (Suc (fst l), (\n. if n = 0 then x else (snd l) (n - 1)))" + +fun from_list :: "'a list \ nat \ (nat \ 'a)" where + "from_list [] = list_nil" | + "from_list (a#l) = list_cons a (from_list l)" + +fun to_list' :: "nat \ (nat \ 'a) \ 'a list" where + "to_list' 0 _ = []" | + "to_list' (Suc n) f = f 0 # to_list' n (\n. f (Suc n))" + +definition to_list :: "nat \ (nat \ 'a) \ 'a list" where +"to_list \ case_prod to_list'" + +text \ Definition \ +definition list_qbs :: "'a quasi_borel \ 'a list quasi_borel" where +"list_qbs X \ map_qbs to_list (list_of X)" + +definition list_head :: "nat \ (nat \ 'a) \ 'a" where +"list_head l = snd l 0" +definition list_tail :: "nat \ (nat \ 'a) \ nat \ (nat \ 'a)" where +"list_tail l = (fst l - 1, \m. (snd l) (Suc m))" + +lemma list_simp1: "list_nil \ list_cons x l" + by (simp add: list_nil_def list_cons_def) + +lemma list_simp2: + assumes "list_cons a al = list_cons b bl" + shows "a = b" "al = bl" +proof - + have "a = snd (list_cons a al) 0" "b = snd (list_cons b bl) 0" + by (auto simp: list_cons_def) + thus "a = b" + by(simp add: assms) +next + have "fst al = fst bl" + using assms by (simp add: list_cons_def) + moreover have "snd al = snd bl" + proof + fix n + have "snd al n = snd (list_cons a al) (Suc n)" + by (simp add: list_cons_def) + also have "... = snd (list_cons b bl) (Suc n)" + by (simp add: assms) + also have "... = snd bl n" + by (simp add: list_cons_def) + finally show "snd al n = snd bl n" . + qed + ultimately show "al = bl" + by (simp add: prod.expand) +qed + +lemma + shows list_simp3:"list_head (list_cons a l) = a" + and list_simp4:"list_tail (list_cons a l) = l" + by(simp_all add: list_head_def list_cons_def list_tail_def) + +lemma list_decomp1: + assumes "l \ qbs_space (list_of X)" + shows "l = list_nil \ + (\a l'. a \ qbs_space X \ l' \ qbs_space (list_of X) \ l = list_cons a l')" +proof(cases l) + case hl:(Pair n f) + show ?thesis + proof(cases n) + case 0 + then show ?thesis + using assms hl by (simp add: list_of_def list_nil_def coprod_qbs_space PiQ_space) + next + case hn:(Suc n') + define f' where "f' \ \m. f (Suc m)" + have "l = list_cons (f 0) (n',f')" + unfolding hl hn list_cons_def + proof safe + fix m + show "f = (\m. if m = 0 then f 0 else snd (n', f') (m - 1))" + proof + fix m + show "f m = (if m = 0 then f 0 else snd (n', f') (m - 1))" + using assms hl by(cases m; fastforce simp: f'_def) + qed + qed simp + moreover have "(n', f') \ qbs_space (list_of X)" + proof - + have "\x. x \ {.. f' x \ qbs_space X" + using assms hl hn by(fastforce simp: f'_def list_of_def coprod_qbs_space PiQ_space) + moreover { + fix x + assume 1:"x \ {.. qbs_space (list_of X)" + and "l \ list_nil" + shows "l = list_cons (list_head l) (list_tail l)" +proof - + obtain a l' where hl: + "a \ qbs_space X" "l' \ qbs_space (list_of X)" "l = list_cons a l'" + using list_decomp1[OF assms(1)] assms(2) by blast + hence "list_head l = a" "list_tail l = l'" + by(simp_all add: list_simp3 list_simp4) + thus ?thesis + using hl(3) list_simp2 by auto +qed + +lemma list_simp6: + "list_nil \ qbs_space (list_of X)" + by (simp add: list_nil_def list_of_def coprod_qbs_space PiQ_space) + +lemma list_simp7: + assumes "a \ qbs_space X" + and "l \ qbs_space (list_of X)" + shows "list_cons a l \ qbs_space (list_of X)" + using assms by(fastforce simp: PiE_def extensional_def list_cons_def list_of_def coprod_qbs_space PiQ_space) + +lemma list_destruct_rule: + assumes "l \ qbs_space (list_of X)" + "P list_nil" + and "\a l'. a \ qbs_space X \ l' \ qbs_space (list_of X) \ P (list_cons a l')" + shows "P l" + by(rule disjE[OF list_decomp1[OF assms(1)]]) (use assms in auto) + +lemma list_induct_rule: + assumes "l \ qbs_space (list_of X)" + "P list_nil" + and "\a l'. a \ qbs_space X \ l' \ qbs_space (list_of X) \ P l' \ P (list_cons a l')" + shows "P l" +proof(cases l) + case hl:(Pair n f) + then show ?thesis + using assms(1) + proof(induction n arbitrary: f l) + case 0 + then show ?case + using assms(2) by (simp add: list_of_def coprod_qbs_space PiQ_space list_nil_def) + next + case ih:(Suc n) + then obtain a l' where hl: + "a \ qbs_space X" "l' \ qbs_space (list_of X)" "l = list_cons a l'" + using list_decomp1 by(simp add: list_nil_def) blast + have "P l'" + using ih hl(3) + by(auto intro!: ih(1)[OF _ hl(2),of "snd l'"] simp: list_of_def coprod_qbs_space PiQ_space list_cons_def) + from assms(3)[OF hl(1,2) this] + show ?case + by(simp add: hl(3)) + qed +qed + +lemma to_list_simp1: "to_list list_nil = []" + by(simp add: to_list_def list_nil_def) + +lemma to_list_simp2: + assumes "l \ qbs_space (list_of X)" + shows "to_list (list_cons a l) = a # to_list l" + using assms by(auto simp:PiE_def to_list_def list_cons_def list_of_def coprod_qbs_space PiQ_space) + +lemma to_list_set: + assumes "l \ qbs_space (list_of X)" + shows "set (to_list l) \ qbs_space X" + by(rule list_induct_rule[OF assms]) (auto simp: to_list_simp1 to_list_simp2) + +lemma from_list_length: "fst (from_list l) = length l" + by(induction l, simp_all add: list_cons_def list_nil_def) + +lemma from_list_in_list_of: + assumes "set l \ qbs_space X" + shows "from_list l \ qbs_space (list_of X)" + using assms by(induction l) (auto simp: PiE_def extensional_def Pi_def list_of_def coprod_qbs_space PiQ_space list_nil_def list_cons_def) + +lemma from_list_in_list_of': "from_list l \ qbs_space (list_of (Abs_quasi_borel (UNIV,UNIV)))" +proof - + have "set l \ qbs_space (Abs_quasi_borel (UNIV,UNIV))" + by(simp add: qbs_space_def Abs_quasi_borel_inverse[of "(UNIV,UNIV)",simplified is_quasi_borel_def qbs_closed1_def qbs_closed2_def qbs_closed3_def,simplified]) + thus ?thesis + using from_list_in_list_of by blast +qed + +lemma list_cons_in_list_of: + assumes "set (a#l) \ qbs_space X" + shows "list_cons a (from_list l) \ qbs_space (list_of X)" + using from_list_in_list_of[OF assms] by simp + +lemma from_list_to_list_ident: + "to_list (from_list l) = l" + by(induction l) (simp add: to_list_def list_nil_def,simp add: to_list_simp2[OF from_list_in_list_of']) + +lemma to_list_from_list_ident: + assumes "l \ qbs_space (list_of X)" + shows "from_list (to_list l) = l" +proof(rule list_induct_rule[OF assms]) + fix a l' + assume h: "l' \ qbs_space (list_of X)" + and ih:"from_list (to_list l') = l'" + show "from_list (to_list (list_cons a l')) = list_cons a l'" + by(auto simp add: to_list_simp2[OF h] ih[simplified]) +qed (simp add: to_list_simp1) + +definition rec_list' :: "'b \ ('a \ (nat \ (nat \ 'a)) \ 'b \ 'b) \ (nat \ (nat \ 'a)) \ 'b" where +"rec_list' t0 f l \ (rec_list t0 (\x l'. f x (from_list l')) (to_list l))" + +lemma rec_list'_simp1: + "rec_list' t f list_nil = t" + by(simp add: rec_list'_def to_list_simp1) + +lemma rec_list'_simp2: + assumes "l \ qbs_space (list_of X)" + shows "rec_list' t f (list_cons x l) = f x l (rec_list' t f l)" + by(simp add: rec_list'_def to_list_simp2[OF assms] to_list_from_list_ident[OF assms,simplified]) + +lemma list_qbs_space: "qbs_space (list_qbs X) = {l. set l \ qbs_space X}" + using to_list_set by(auto simp: list_qbs_def map_qbs_space image_def from_list_to_list_ident from_list_in_list_of intro!: bexI[where x="from_list _"]) + +subsubsection \ Option Spaces \ +text \ The option spaces is defined using the following isomorphism. + \begin{align*} + Option(X) \cong X + 1 + \end{align*}\ +definition option_qbs :: "'a quasi_borel \ 'a option quasi_borel" where +"option_qbs X = map_qbs (\x. case x of Inl y \ Some y | Inr y \ None) (X \\<^sub>Q 1\<^sub>Q)" + +lemma option_qbs_space: "qbs_space (option_qbs X) = {Some x|x. x \ qbs_space X} \ {None}" + by(auto simp: option_qbs_def map_qbs_space copair_qbs_space) (metis InrI image_eqI insert_iff old.sum.simps(6), metis InlI image_iff sum.case(1)) + +subsubsection \ Function Spaces \ +definition exp_qbs :: "['a quasi_borel, 'b quasi_borel] \ ('a \ 'b) quasi_borel" (infixr "\\<^sub>Q" 61) where +"X \\<^sub>Q Y \ Abs_quasi_borel ({f. \\ \ qbs_Mx X. f \ \ \ qbs_Mx Y}, {g. \\\ borel_measurable borel. \\\ qbs_Mx X. (\r. g (\ r) (\ r)) \ qbs_Mx Y})" + +lemma + shows exp_qbs_space: "qbs_space (exp_qbs X Y) = {f. \\ \ qbs_Mx X. f \ \ \ qbs_Mx Y}" + and exp_qbs_Mx: "qbs_Mx (exp_qbs X Y) = {g. \\\ borel_measurable borel. \\\ qbs_Mx X. (\r. g (\ r) (\ r)) \ qbs_Mx Y}" +proof - + have "{g:: real \ _. \\\ borel_measurable borel. \\\ qbs_Mx X. (\r. g (\ r) (\ r)) \ qbs_Mx Y} \ UNIV \ {f. \\ \ qbs_Mx X. f \ \ \ qbs_Mx Y}" + proof safe + fix g :: "real \ _" and r :: real and \ + assume h:"\\\borel_measurable borel. \\\qbs_Mx X. (\r. g (\ r) (\ r)) \ qbs_Mx Y" "\ \ qbs_Mx X" + have [simp]: "g r \ \ = (\l. g r (\ l))" by (auto simp: comp_def) + thus "g r \ \ \ qbs_Mx Y" + using h by auto + qed + moreover have "qbs_closed3 {g. \\\ borel_measurable borel. \\\ qbs_Mx X. (\r. g (\ r) (\ r)) \ qbs_Mx Y}" + by(rule qbs_closed3I, auto) (rule qbs_closed3_dest,auto) + ultimately have "Rep_quasi_borel (exp_qbs X Y) = ({f. \\ \ qbs_Mx X. f \ \ \ qbs_Mx Y}, {g. \\\ borel_measurable borel. \\\ qbs_Mx X. (\r. g (\ r) (\ r)) \ qbs_Mx Y})" + unfolding exp_qbs_def by(auto intro!: Abs_quasi_borel_inverse is_quasi_borel_intro qbs_closed1I qbs_closed2I simp: comp_def) + thus "qbs_space (exp_qbs X Y) = {f. \\ \ qbs_Mx X. f \ \ \ qbs_Mx Y}" + "qbs_Mx (exp_qbs X Y) = {g. \\\ borel_measurable borel. \\\ qbs_Mx X. (\r. g (\ r) (\ r)) \ qbs_Mx Y}" + by(simp_all add: qbs_space_def qbs_Mx_def) +qed + +subsubsection \ Ordering on Quasi-Borel Spaces \ + +inductive_set generating_Mx :: "'a set \ (real \ 'a) set \ (real \ 'a) set" + for X :: "'a set" and Mx :: "(real \ 'a) set" + where + Basic: "\ \ Mx \ \ \ generating_Mx X Mx" + | Const: "x \ X \ (\r. x) \ generating_Mx X Mx" + | Comp : "f \ (borel :: real measure) \\<^sub>M (borel :: real measure) \ \ \ generating_Mx X Mx \ \ \ f \ generating_Mx X Mx" + | Part : "(\i. Fi i \ generating_Mx X Mx) \ P \ borel \\<^sub>M count_space (UNIV :: nat set) \ (\r. Fi (P r) r) \ generating_Mx X Mx" + +lemma generating_Mx_to_space: + assumes "Mx \ UNIV \ X" + shows "generating_Mx X Mx \ UNIV \ X" +proof + fix \ + assume "\ \ generating_Mx X Mx" + then show "\ \ UNIV \ X" + by(induct rule: generating_Mx.induct) (use assms in auto) +qed + +lemma generating_Mx_closed1: + "qbs_closed1 (generating_Mx X Mx)" + by (simp add: generating_Mx.Comp qbs_closed1I) + +lemma generating_Mx_closed2: + "qbs_closed2 X (generating_Mx X Mx)" + by (simp add: generating_Mx.Const qbs_closed2I) + +lemma generating_Mx_closed3: + "qbs_closed3 (generating_Mx X Mx)" + by(simp add: qbs_closed3I generating_Mx.Part) + +lemma generating_Mx_Mx: + "generating_Mx (qbs_space X) (qbs_Mx X) = qbs_Mx X" +proof safe + fix \ + assume "\ \ generating_Mx (qbs_space X) (qbs_Mx X)" + then show "\ \ qbs_Mx X" + by(rule generating_Mx.induct) (auto intro!: qbs_closed1_dest[simplified comp_def] simp: qbs_closed3_dest') +next + fix \ + assume "\ \ qbs_Mx X" + then show "\ \ generating_Mx (qbs_space X) (qbs_Mx X)" .. +qed + +instantiation quasi_borel :: (type) order_bot +begin + +inductive less_eq_quasi_borel :: "'a quasi_borel \ 'a quasi_borel \ bool" where + "qbs_space X \ qbs_space Y \ less_eq_quasi_borel X Y" +| "qbs_space X = qbs_space Y \ qbs_Mx Y \ qbs_Mx X \ less_eq_quasi_borel X Y" + +lemma le_quasi_borel_iff: + "X \ Y \ (if qbs_space X = qbs_space Y then qbs_Mx Y \ qbs_Mx X else qbs_space X \ qbs_space Y)" + by(auto elim: less_eq_quasi_borel.cases intro: less_eq_quasi_borel.intros) + +definition less_quasi_borel :: "'a quasi_borel \ 'a quasi_borel \ bool" where + "less_quasi_borel X Y \ (X \ Y \ \ Y \ X)" + +definition bot_quasi_borel :: "'a quasi_borel" where + "bot_quasi_borel = empty_quasi_borel" + +instance +proof + show "bot \ a" for a :: "'a quasi_borel" + using qbs_empty_equiv + by(auto simp add: le_quasi_borel_iff bot_quasi_borel_def) +qed (auto simp: le_quasi_borel_iff less_quasi_borel_def split: if_split_asm intro: qbs_eqI) +end + +definition inf_quasi_borel :: "['a quasi_borel, 'a quasi_borel] \ 'a quasi_borel" where +"inf_quasi_borel X X' = Abs_quasi_borel (qbs_space X \ qbs_space X', qbs_Mx X \ qbs_Mx X')" + +lemma inf_quasi_borel_correct: "Rep_quasi_borel (inf_quasi_borel X X') = (qbs_space X \ qbs_space X', qbs_Mx X \ qbs_Mx X')" + by(auto intro!: Abs_quasi_borel_inverse simp: inf_quasi_borel_def is_quasi_borel_def qbs_closed1_def qbs_closed2_def qbs_closed3_def dest: qbs_Mx_to_X) + +lemma inf_qbs_space[simp]: "qbs_space (inf_quasi_borel X X') = qbs_space X \ qbs_space X'" + by (simp add: qbs_space_def inf_quasi_borel_correct) + +lemma inf_qbs_Mx[simp]: "qbs_Mx (inf_quasi_borel X X') = qbs_Mx X \ qbs_Mx X'" + by(simp add: qbs_Mx_def inf_quasi_borel_correct) + +definition max_quasi_borel :: "'a set \ 'a quasi_borel" where +"max_quasi_borel X = Abs_quasi_borel (X, UNIV \ X)" + +lemma max_quasi_borel_correct: "Rep_quasi_borel (max_quasi_borel X) = (X, UNIV \ X)" + by(fastforce intro!: Abs_quasi_borel_inverse + simp: max_quasi_borel_def qbs_closed1_def qbs_closed2_def qbs_closed3_def is_quasi_borel_def) + +lemma max_qbs_space[simp]: "qbs_space (max_quasi_borel X) = X" + by(simp add: qbs_space_def max_quasi_borel_correct) + +lemma max_qbs_Mx[simp]: "qbs_Mx (max_quasi_borel X) = UNIV \ X" + by(simp add: qbs_Mx_def max_quasi_borel_correct) + +instantiation quasi_borel :: (type) semilattice_sup +begin + +definition sup_quasi_borel :: "'a quasi_borel \ 'a quasi_borel \ 'a quasi_borel" where +"sup_quasi_borel X Y \ (if qbs_space X = qbs_space Y then inf_quasi_borel X Y + else if qbs_space X \ qbs_space Y then Y + else if qbs_space Y \ qbs_space X then X + else max_quasi_borel (qbs_space X \ qbs_space Y))" + + +instance +proof + fix X Y :: "'a quasi_borel" + let ?X = "qbs_space X" + let ?Y = "qbs_space Y" + consider "?X = ?Y" | "?X \ ?Y" | "?Y \ ?X" | "?X \ ?X \ ?Y \ ?Y \ ?X \ ?Y" + by auto + then show "X \ X \ Y" + proof(cases) + case 1 + show ?thesis + unfolding sup_quasi_borel_def + by(rule less_eq_quasi_borel.intros(2),simp_all add: 1) + next + case 2 + then show ?thesis + unfolding sup_quasi_borel_def + by (simp add: less_eq_quasi_borel.intros(1)) + next + case 3 + then show ?thesis + unfolding sup_quasi_borel_def + by auto + next + case 4 + then show ?thesis + unfolding sup_quasi_borel_def + by(auto simp: less_eq_quasi_borel.intros(1)) + qed +next + fix X Y :: "'a quasi_borel" + let ?X = "qbs_space X" + let ?Y = "qbs_space Y" + consider "?X = ?Y" | "?X \ ?Y" | "?Y \ ?X" | "?X \ ?X \ ?Y \ ?Y \ ?X \ ?Y" + by auto + then show "Y \ X \ Y" + proof(cases) + case 1 + show ?thesis + unfolding sup_quasi_borel_def + by(rule less_eq_quasi_borel.intros(2)) (simp_all add: 1) + next + case 2 + then show ?thesis + unfolding sup_quasi_borel_def + by auto + next + case 3 + then show ?thesis + unfolding sup_quasi_borel_def + by (auto simp add: less_eq_quasi_borel.intros(1)) + next + case 4 + then show ?thesis + unfolding sup_quasi_borel_def + by(auto simp: less_eq_quasi_borel.intros(1)) + qed +next + fix X Y Z :: "'a quasi_borel" + assume h:"X \ Z" "Y \ Z" + let ?X = "qbs_space X" + let ?Y = "qbs_space Y" + let ?Z = "qbs_space Z" + consider "?X = ?Y" | "?X \ ?Y" | "?Y \ ?X" | "?X \ ?X \ ?Y \ ?Y \ ?X \ ?Y" + by auto + then show "sup X Y \ Z" + proof cases + case 1 + show ?thesis + unfolding sup_quasi_borel_def + apply(simp add: 1,rule less_eq_quasi_borel.cases[OF h(1)]) + apply(rule less_eq_quasi_borel.intros(1)) + apply auto[1] + apply simp + apply(rule less_eq_quasi_borel.intros(2)) + apply(simp add: 1) + apply(rule less_eq_quasi_borel.cases[OF h(2)]) + using 1 + apply fastforce + apply simp + by (metis "1" h(2) inf_qbs_Mx le_inf_iff le_quasi_borel_iff) + + next + case 2 + then show ?thesis + unfolding sup_quasi_borel_def + using h(2) by auto + next + case 3 + then show ?thesis + unfolding sup_quasi_borel_def + using h(1) by auto + next + case 4 + then have [simp]:"?X \ ?Y" "~ (?X \ ?Y)" "~ (?Y \ ?X)" + by auto + have [simp]:"?X \ ?Z" "?Y \ ?Z" + by (metis h(1) dual_order.order_iff_strict less_eq_quasi_borel.cases) + (metis h(2) dual_order.order_iff_strict less_eq_quasi_borel.cases) + then consider "?X \ ?Y = ?Z" | "?X \ ?Y \ ?Z" + by blast + then show ?thesis + unfolding sup_quasi_borel_def + apply cases + apply simp + apply(rule less_eq_quasi_borel.intros(2)) + apply simp + using qbs_Mx_to_X apply auto[1] + by(simp add: less_eq_quasi_borel.intros(1)) + qed +qed + +end + +end \ No newline at end of file diff --git a/thys/S_Finite_Measure_Monad/Query.thy b/thys/S_Finite_Measure_Monad/Query.thy new file mode 100644 --- /dev/null +++ b/thys/S_Finite_Measure_Monad/Query.thy @@ -0,0 +1,1367 @@ +(* Title: Query.thy + Author: Michikazu Hirata, Tokyo Institute of Technology +*) + +subsection \Query\ + +theory Query + imports "Monad_QuasiBorel" +begin + +declare [[coercion qbs_l]] +abbreviation qbs_real :: "real quasi_borel" ("\\<^sub>Q") where "\\<^sub>Q \ qbs_borel" +abbreviation qbs_ennreal :: "ennreal quasi_borel" ("\\<^sub>Q\<^sub>\\<^sub>0") where "\\<^sub>Q\<^sub>\\<^sub>0 \ qbs_borel" +abbreviation qbs_nat :: "nat quasi_borel" ("\\<^sub>Q") where "\\<^sub>Q \ qbs_count_space UNIV" +abbreviation qbs_bool :: "bool quasi_borel" ("\\<^sub>Q") where "\\<^sub>Q \ count_space\<^sub>Q UNIV" + + +definition query :: "['a qbs_measure, 'a \ ennreal] \ 'a qbs_measure" where +"query \ (\s f. normalize_qbs (density_qbs s f))" + +lemma query_qbs_morphism[qbs]: "query \ monadM_qbs X \\<^sub>Q (X \\<^sub>Q qbs_borel) \\<^sub>Q monadM_qbs X" + by(simp add: query_def) + +definition "condition \ (\s P. query s (\x. if P x then 1 else 0))" + +lemma condition_qbs_morphism[qbs]: "condition \ monadM_qbs X \\<^sub>Q (X \\<^sub>Q \\<^sub>Q) \\<^sub>Q monadM_qbs X" + by(simp add: condition_def) + +lemma condition_morphismP: + assumes "\x. x \ qbs_space X \ \

(y in qbs_l (s x). P x y) \ 0" + and [qbs]: "s \ X \\<^sub>Q monadP_qbs Y" "P \ X \\<^sub>Q Y \\<^sub>Q qbs_count_space UNIV" + shows "(\x. condition (s x) (P x)) \ X \\<^sub>Q monadP_qbs Y" +proof(rule qbs_morphism_cong'[where f="\x. normalize_qbs (density_qbs (s x) (indicator {y\qbs_space Y. P x y}))"]) + fix x + assume x[qbs]:"x \ qbs_space X" + have "density_qbs (s x) (indicator {y \ qbs_space Y. P x y}) = density_qbs (s x) (\y. if P x y then 1 else 0)" + by(auto intro!: density_qbs_cong[OF qbs_space_monadPM[OF qbs_morphism_space[OF assms(2) x]]] indicator_qbs_morphism'') + thus "normalize_qbs (density_qbs (s x) (indicator {y \ qbs_space Y. P x y})) = condition (s x) (P x)" + unfolding condition_def query_def by simp +next + show "(\x. normalize_qbs (density_qbs (s x) (indicator {y \ qbs_space Y. P x y}))) \ X \\<^sub>Q monadP_qbs Y" + proof(rule normalize_qbs_morphismP[of "\x. density_qbs (s x) (indicator {y \ qbs_space Y. P x y})"]) + show "(\x. density_qbs (s x) (indicator {y \ qbs_space Y. P x y})) \ X \\<^sub>Q monadM_qbs Y" + using qbs_morphism_monadPD[OF assms(2)] by simp + next + fix x + assume x:"x \ qbs_space X" + show "emeasure (qbs_l (density_qbs (s x) (indicator {y \ qbs_space Y. P x y}))) (qbs_space Y) \ 0" + "emeasure (qbs_l (density_qbs (s x) (indicator {y \ qbs_space Y. P x y}))) (qbs_space Y) \ \" + using assms(1)[OF x] qbs_l_monadP_le1[OF qbs_morphism_space[OF assms(2) x]] + by(auto simp add: qbs_l_density_qbs_indicator[OF qbs_space_monadPM[OF qbs_morphism_space[OF assms(2) x]] qbs_morphism_space[OF assms(3) x]] measure_def space_qbs_l_in[OF qbs_space_monadPM[OF qbs_morphism_space[OF assms(2) x]]]) + qed +qed + +lemma query_Bayes: + assumes [qbs]: "s \ qbs_space (monadP_qbs X)" "qbs_pred X P" "qbs_pred X Q" + shows "\

(x in condition s P. Q x) = \

(x in s. Q x \ P x)" (is "?lhs = ?pq") +proof - + have X: "qbs_space X \ {}" + using assms(1) by(simp only: monadP_qbs_empty_iff[of X]) blast + note s[qbs] = qbs_space_monadPM[OF assms(1)] + have density_eq: "density_qbs s (\x. if P x then 1 else 0) = density_qbs s (indicator {x\qbs_space X. P x})" + by(auto intro!: density_qbs_cong[of _ X] indicator_qbs_morphism'') + consider "emeasure (qbs_l (density_qbs s (\x. if P x then 1 else 0))) (qbs_space X) = 0" | "emeasure (qbs_l (density_qbs s (\x. if P x then 1 else 0))) (qbs_space X) \ 0" by auto + then show ?thesis + proof cases + case 1 + have 2:"normalize_qbs (density_qbs s (\x. if P x then 1 else 0)) = qbs_null_measure X" + by(rule normalize_qbs0) (auto simp: 1) + have "\

(\ in qbs_l s. P \) = measure (qbs_l (density_qbs s (\x. if P x then 1 else 0))) (qbs_space X)" + by(simp add: space_qbs_l_in[OF s] measure_def density_eq qbs_l_density_qbs_indicator[OF s]) + also have "... = 0" + by(simp add: measure_def 1) + finally show ?thesis + by(auto simp: condition_def query_def cond_prob_def 2 1 qbs_null_measure_null_measure[OF X]) + next + case 1[simp]:2 + from rep_qbs_space_monadP[OF assms(1)] + obtain \ \ where hs: "s = \X, \, \\\<^sub>s\<^sub>f\<^sub>i\<^sub>n" "qbs_prob X \ \" by auto + then interpret qp: qbs_prob X \ \ by simp + have [measurable]:"Measurable.pred (qbs_to_measure X) P" "Measurable.pred (qbs_to_measure X) Q" + using assms(2,3) by(simp_all add: lr_adjunction_correspondence) + have 2[simp]: "emeasure (qbs_l (density_qbs s (\x. if P x then 1 else 0))) (qbs_space X) \ \" + by(simp add: hs(1) qp.density_qbs qbs_s_finite.qbs_l[OF qp.density_qbs_s_finite] emeasure_distr emeasure_distr[where N="qbs_to_measure X",OF _ sets.top,simplified space_L] emeasure_density,rule order.strict_implies_not_eq[OF order.strict_trans1[OF qp.nn_integral_le_const[of 1] ennreal_one_less_top]]) auto + have 3: "measure (qbs_l (density_qbs s (\x. if P x then 1 else 0))) (qbs_space X) > 0" + using 2 emeasure_eq_ennreal_measure zero_less_measure_iff by fastforce + have "query s (\x. if P x then 1 else 0) = density_qbs (density_qbs s (\x. if P x then 1 else 0)) (\x. 1 / emeasure (qbs_l (density_qbs s (\x. if P x then 1 else 0))) (qbs_space X))" + unfolding query_def by(rule normalize_qbs) auto + also have "... = density_qbs s (\x. (if P x then 1 else 0) * (1 / emeasure (qbs_l (density_qbs s (\x. if P x then 1 else 0))) (qbs_space X)))" + by(simp add: density_qbs_density_qbs_eq[OF qbs_space_monadPM[OF assms(1)]]) + finally have query:"query s (\x. if P x then 1 else 0) = ..." . + have "?lhs = measure (density (qbs_l s) (\x. (if P x then 1 else 0) * (1 / emeasure (qbs_l (density_qbs s (\x. if P x then 1 else 0))) (qbs_space X)))) {x \ space (qbs_l s). Q x}" + by(simp add: condition_def query qbs_l_density_qbs[OF qbs_space_monadPM[OF assms(1)]]) + also have "... = measure (density \ (\x. (if P (\ x) then 1 else 0) * (1 / emeasure (qbs_l (density_qbs s (\x. if P x then 1 else 0))) (qbs_space X)))) {y. \ y \ space (qbs_to_measure X) \ Q (\ y)}" + by(simp add: hs(1) qp.qbs_l density_distr measure_def emeasure_distr) + also have "... = measure (density \ (\x. indicator {r. P (\ r)} x * (1 / emeasure (qbs_l (density_qbs s (\x. if P x then 1 else 0))) (qbs_space X)))) {y. Q (\ y)}" + proof - + have [simp]:"(if P (\ r) then 1 else 0) = indicator {r. P (\ r)} r " for r + by auto + thus ?thesis by(simp add: space_L) + qed + also have "... = enn2real (1 / emeasure (qbs_l (density_qbs s (\x. if P x then 1 else 0))) (qbs_space X)) * measure \ {r. P (\ r) \ Q (\ r)}" + proof - + have n_inf: "1 / emeasure (qbs_l (density_qbs s (\x. if P x then 1 else 0))) (qbs_space X) \ \" + using 1 by(auto simp: ennreal_divide_eq_top_iff) + show ?thesis + by(simp add: measure_density_times[OF _ _ n_inf] Collect_conj_eq) + qed + also have "... = (1 / measure (qbs_l (density_qbs s (\x. if P x then 1 else 0))) (qbs_space X)) * qp.prob {r. P (\ r) \ Q (\ r)}" + proof - + have "1 / emeasure (qbs_l (density_qbs s (\x. if P x then 1 else 0))) (qbs_space X) = ennreal (1 / measure (qbs_l (density_qbs s (\x. if P x then 1 else 0))) (qbs_space X))" + by(auto simp add: emeasure_eq_ennreal_measure[OF 2] ennreal_1[symmetric] simp del: ennreal_1 intro!: divide_ennreal) (simp_all add: 3) + thus ?thesis by simp + qed also have "... = ?pq" + proof - + have qp:"\

(x in s. Q x \ P x) = qp.prob {r. P (\ r) \ Q (\ r)}" + by(auto simp: hs(1) qp.qbs_l measure_def emeasure_distr, simp add: space_L) meson + note sets = sets_qbs_l[OF qbs_space_monadPM[OF assms(1)],measurable_cong] + have [simp]: "density (qbs_l s) (\x. if P x then 1 else 0) = density (qbs_l s) (indicator {x\space (qbs_to_measure X). P x})" + by(auto intro!: density_cong) (auto simp: indicator_def space_L sets_eq_imp_space_eq[OF sets]) + have p: "\

(x in s. P x) = measure (qbs_l (density_qbs s (\x. if P x then 1 else 0))) (qbs_space X)" + by(auto simp: qbs_l_density_qbs[OF qbs_space_monadPM[OF assms(1),qbs]]) (auto simp: measure_restricted[of "{x \ space (qbs_to_measure X). P x}" "qbs_l s",simplified sets,OF _ sets.top,simplified,simplified space_L] space_L sets_eq_imp_space_eq[OF sets]) + thus ?thesis + by(simp add: qp p cond_prob_def) + qed + finally show ?thesis . + qed +qed + +lemma qbs_pmf_cond_pmf: + fixes p :: "'a :: countable pmf" + assumes "set_pmf p \ {x. P x} \ {}" + shows "condition (qbs_pmf p) P = qbs_pmf (cond_pmf p {x. P x})" +proof(rule inj_onD[OF qbs_l_inj[of "count_space UNIV"]]) + note count_space_count_space_qbs_morphism[of P,qbs] + show g1:"condition (qbs_pmf p) P \ qbs_space (monadM_qbs (count_space\<^sub>Q UNIV))" "qbs_pmf (cond_pmf p {x. P x}) \ qbs_space (monadM_qbs (count_space\<^sub>Q UNIV))" + by auto + show "qbs_l (condition (qbs_pmf p) P) = qbs_l (qbs_pmf (cond_pmf p {x. P x}))" + proof(safe intro!: measure_eqI_countable) + fix a + have "condition (qbs_pmf p) P = normalize_qbs (density_qbs (qbs_pmf p) (\x. if P x then 1 else 0))" + by(auto simp: condition_def query_def) + also have "... = density_qbs (density_qbs (qbs_pmf p) (\x. if P x then 1 else 0)) (\x. 1 / emeasure (qbs_l (density_qbs (qbs_pmf p) (\x. if P x then 1 else 0))) (qbs_space (count_space\<^sub>Q UNIV)))" + proof - + have 1:"(\\<^sup>+ x. ennreal (pmf p x) * (if P x then 1 else 0) \count_space UNIV) = (\\<^sup>+ x\{x. P x}. ennreal (pmf p x) \count_space UNIV)" + by(auto intro!: nn_integral_cong) + have "... > 0" + using assms(1) by(force intro!: nn_integral_less[of "\x. 0",simplified] simp: AE_count_space set_pmf_eq' indicator_def) + hence 2:"(\\<^sup>+x\{x. P x}. ennreal (pmf p x) \count_space UNIV) \ 0" + by auto + have 3:"(\\<^sup>+ x\{x. P x}. ennreal (pmf p x) \count_space UNIV) \ \" + proof - + have "(\\<^sup>+ x\{x. P x}. ennreal (pmf p x) \count_space UNIV) \ (\\<^sup>+ x. ennreal (pmf p x) \count_space UNIV)" + by(auto intro!: nn_integral_mono simp: indicator_def) + also have "... = 1" + by (simp add: nn_integral_pmf_eq_1) + finally show ?thesis + using ennreal_one_neq_top neq_top_trans by fastforce + qed + show ?thesis + by(rule normalize_qbs) (auto simp: qbs_l_density_qbs[of _ "count_space UNIV"] emeasure_density nn_integral_measure_pmf 1 2 3) + qed + also have "... = density_qbs (qbs_pmf p) (\x. (if P x then 1 else 0) * (1 / (\\<^sup>+ x. ennreal (pmf p x) * (if P x then 1 else 0) \count_space UNIV)))" + by(simp add: density_qbs_density_qbs_eq[of _ "count_space UNIV"] qbs_l_density_qbs[of _ "count_space UNIV"] emeasure_density nn_integral_measure_pmf) + also have "... = density_qbs (qbs_pmf p) (\x. (if P x then 1 else 0) * (1 / (emeasure (measure_pmf p) (Collect P))))" + proof - + have [simp]: "(\\<^sup>+ x. ennreal (pmf p x) * (if P x then 1 else 0) \count_space UNIV) = emeasure (measure_pmf p) (Collect P)" (is "?l = ?r") + proof - + have "?l = (\\<^sup>+ x. ennreal (pmf p x) * (if P x then 1 else 0) \count_space {x. P x})" + by(rule nn_integral_count_space_eq) auto + also have "... = ?r" + by(auto simp: nn_integral_pmf[symmetric] intro!: nn_integral_cong) + finally show ?thesis . + qed + show ?thesis by simp + qed + finally show "emeasure (qbs_l (condition (qbs_pmf p) P)) {a} = emeasure (qbs_l (qbs_pmf (cond_pmf p {x. P x}))) {a}" + by(simp add: ennreal_divide_times qbs_l_density_qbs[of _ "count_space UNIV"] emeasure_density cond_pmf.rep_eq[OF assms(1)]) + qed(auto simp: sets_qbs_l[OF g1(1)]) +qed + +subsubsection \\texttt{twoUs}\ +text \ Example from Section~2 in @{cite Sato_2019}.\ +definition "Uniform \ (\a b::real. uniform_qbs lborel_qbs {a<.. \\<^sub>Q \\<^sub>Q \\<^sub>Q \\<^sub>Q monadM_qbs \\<^sub>Q" + unfolding Uniform_def by (rule interval_uniform_qbs) + +definition twoUs :: "(real \ real) qbs_measure" where +"twoUs \ do { + let u1 = Uniform 0 1; + let u2 = Uniform 0 1; + let y = u1 \\<^sub>Q\<^sub>m\<^sub>e\<^sub>s u2; + condition y (\(x,y). x < 0.5 \ y > 0.5) + }" + +lemma twoUs_qbs: "twoUs \ monadM_qbs (\\<^sub>Q \\<^sub>Q \\<^sub>Q)" + by(simp add: twoUs_def) + +interpretation rr: standard_borel_ne "borel \\<^sub>M borel :: (real \ real) measure" + by(simp add: borel_prod) + +lemma qbs_l_Uniform[simp]: "a < b \ qbs_l (Uniform a b) = uniform_measure lborel {a<.. monadP_qbs \\<^sub>Q" + by(auto simp: monadP_qbs_def sub_qbs_space intro!: prob_space_uniform_measure) + +interpretation UniformP_pair: pair_prob_space "uniform_measure lborel {0<..<1::real}" "uniform_measure lborel {0<..<1::real}" + by(auto simp: pair_prob_space_def pair_sigma_finite_def intro!: prob_space_imp_sigma_finite prob_space_uniform_measure) + +lemma qbs_l_Uniform_pair: "a < b \ qbs_l (Uniform a b \\<^sub>Q\<^sub>m\<^sub>e\<^sub>s Uniform a b) = uniform_measure lborel {a<..\<^sub>M uniform_measure lborel {a<..\<^sub>Q\<^sub>m\<^sub>e\<^sub>s Uniform a b \ qbs_space (monadP_qbs (\\<^sub>Q \\<^sub>Q \\<^sub>Q))" +proof - + note [qbs] = qbs_pair_measure_morphismP Uniform_qbsP[OF assms] + show ?thesis + by simp +qed + +lemma twoUs_prob1: "\

(z in Uniform 0 1 \\<^sub>Q\<^sub>m\<^sub>e\<^sub>s Uniform 0 1. fst z < 0.5 \ snd z > 0.5) = 3 / 4" +proof - + have [simp]:"{z \ space (uniform_measure lborel {0<..<1::real} \\<^sub>M uniform_measure lborel {0<..<1::real}). fst z * 2 < 1 \ 1 < snd z * 2} = UNIV \ {1/2<..} \ {..<1/2} \ UNIV" + by(auto simp: space_pair_measure) + have 1:"UniformP_pair.prob (UNIV \ {1 / 2<..}) = 1 / 2" + proof - + have [simp]:"{0<..<1} \ {1 / 2<..} = {1/2<..<1::real}" by auto + thus ?thesis + by(auto simp: UniformP_pair.M1.measure_times) + qed + have 2:"UniformP_pair.prob ({..<1 / 2} \ UNIV - UNIV \ {1 / 2<..}) = 1 / 4" + proof - + have [simp]: "{..<1/2::real} \ UNIV - UNIV \ {1/2::real<..} = {..<1/2} \ {..1/2}" "{0<..<1} \ {..<1/2} = {0<..<1/2::real}" "{0<..<1} \ {..1/2::real} = {0<..1/2}" + by auto + show ?thesis + by(auto simp: UniformP_pair.M1.measure_times) + qed + show ?thesis + by(auto simp: qbs_l_Uniform_pair UniformP_pair.P.finite_measure_Union' 1 2) +qed + +lemma twoUs_prob2:"\

(z in Uniform 0 1 \\<^sub>Q\<^sub>m\<^sub>e\<^sub>s Uniform 0 1. 1/2 < fst z \ (fst z < 1/2 \ snd z > 1/2)) = 1 / 4" +proof - + have [simp]:"{z \ space (uniform_measure lborel {0<..<1::real} \\<^sub>M uniform_measure lborel {0<..<1::real}). 1 < fst z * 2 \ (fst z * 2 < 1 \ 1 < snd z * 2)} = {1/2<..} \ {1/2<..}" + by(auto simp: space_pair_measure) + have [simp]: "{0<..<1::real} \ {1/2<..} = {1/2<..<1}" by auto + show ?thesis + by(auto simp: qbs_l_Uniform_pair UniformP_pair.M1.measure_times) +qed + +lemma twoUs_qbs_prob: "twoUs \ qbs_space (monadP_qbs (\\<^sub>Q \\<^sub>Q \\<^sub>Q))" +proof - + have "\

(z in Uniform 0 1 \\<^sub>Q\<^sub>m\<^sub>e\<^sub>s Uniform 0 1. fst z < 0.5 \ snd z > 0.5) \ 0" + unfolding twoUs_prob1 by simp + note qbs_morphism_space[OF condition_morphismP[of qbs_borel "\x. Uniform 0 1 \\<^sub>Q\<^sub>m\<^sub>e\<^sub>s Uniform 0 1" "\x z. fst z < 0.5 \ snd z > 0.5" "\\<^sub>Q \\<^sub>Q \\<^sub>Q",OF this],simplified,qbs] + note Uniform_pair_qbs[of 0 1,simplified,qbs] + show ?thesis + by(simp add: twoUs_def split_beta') +qed + +lemma "\

((x,y) in twoUs. 1/2 < x) = 1 / 3" +proof - + have "\

((x,y) in twoUs. 1/2 < x) = \

(z in twoUs. 1/2 < fst z)" + by (simp add: split_beta') + also have "... = \

(z in Uniform 0 1 \\<^sub>Q\<^sub>m\<^sub>e\<^sub>s Uniform 0 1. 1/2 < fst z \ fst z < 0.5 \ snd z > 0.5)" + by(simp add: twoUs_def split_beta',rule query_Bayes[OF Uniform_pair_qbs[of 0 1,simplified,qbs]]) auto + also have "... = \

(z in Uniform 0 1 \\<^sub>Q\<^sub>m\<^sub>e\<^sub>s Uniform 0 1. 1/2 < fst z \ (fst z < 1/2 \ snd z > 1/2)) / \

(z in Uniform 0 1 \\<^sub>Q\<^sub>m\<^sub>e\<^sub>s Uniform 0 1. fst z < 0.5 \ snd z > 0.5)" + by(simp add: cond_prob_def) + also have "... = 1 / 3" + by(simp only: twoUs_prob2 twoUs_prob1) simp + finally show ?thesis . +qed + +subsubsection \ Two Dice \ +text \ Example from Adrian~\cite[Sect.~2.3]{Adrian_PL}.\ +abbreviation "die \ qbs_pmf (pmf_of_set {Suc 0..6})" + +lemma die_qbs[qbs]: "die \ monadM_qbs \\<^sub>Q" + by simp + +definition two_dice :: "nat qbs_measure" where + "two_dice \ do { + let die1 = die; + let die2 = die; + let twodice = die1 \\<^sub>Q\<^sub>m\<^sub>e\<^sub>s die2; + (x,y) \ condition twodice + (\(x,y). x = 4 \ y = 4); + return_qbs \\<^sub>Q (x + y) + }" + +lemma two_dice_qbs: "two_dice \ monadM_qbs \\<^sub>Q" + by(simp add: two_dice_def) + +lemma prob_die2: "\

(x in qbs_l (die \\<^sub>Q\<^sub>m\<^sub>e\<^sub>s die). P x) = real (card ({x. P x} \ ({1..6} \ {1..6}))) / 36" (is "?P = ?rhs") +proof - + have "?P = measure_pmf.prob (pair_pmf (pmf_of_set {Suc 0..6}) (pmf_of_set {Suc 0..6})) {x. P x}" + by(auto simp: qbs_pair_pmf) + also have "... = measure_pmf.prob (pair_pmf (pmf_of_set {Suc 0..6}) (pmf_of_set {Suc 0..6})) ({x. P x} \ set_pmf (pair_pmf (pmf_of_set {Suc 0..6}) (pmf_of_set {Suc 0..6})))" + by(rule measure_Int_set_pmf[symmetric]) + also have "... = measure_pmf.prob (pair_pmf (pmf_of_set {Suc 0..6}) (pmf_of_set {Suc 0..6})) ({x. P x} \ ({Suc 0..6} \ {Suc 0..6}))" + by simp + also have "... = (\z\{x. P x} \ ({Suc 0..6} \ {Suc 0..6}). pmf (pair_pmf (pmf_of_set {Suc 0..6}) (pmf_of_set {Suc 0..6})) z)" + by(simp add: measure_measure_pmf_finite) + also have "... = (\z\{x. P x} \ ({Suc 0..6} \ {Suc 0..6}). 1 / 36)" + by(rule Finite_Cartesian_Product.sum_cong_aux) (auto simp: pmf_pair) + also have "... = ?rhs" + by auto + finally show ?thesis . +qed + +lemma dice_prob1: "\

(z in qbs_l (die \\<^sub>Q\<^sub>m\<^sub>e\<^sub>s die). fst z = 4 \ snd z = 4) = 11 / 36" +proof - + have 1:"Restr {z. fst z = 4 \ snd z = 4} {Suc 0..6::nat} = {Suc 0..Suc (Suc (Suc (Suc (Suc (Suc 0)))))} \ {Suc (Suc (Suc (Suc 0)))} \ {Suc (Suc (Suc (Suc 0)))} \ {Suc 0..(Suc (Suc (Suc 0)))} \ {Suc (Suc (Suc (Suc 0)))} \ {Suc (Suc (Suc (Suc (Suc 0))))..Suc (Suc (Suc (Suc (Suc (Suc 0)))))}" + by fastforce + have "card ... = card ({Suc 0..Suc (Suc (Suc (Suc (Suc (Suc 0)))))} \ {Suc (Suc (Suc (Suc 0)))} \ {Suc (Suc (Suc (Suc 0)))} \ {Suc 0..(Suc (Suc (Suc 0)))}) + card ({Suc (Suc (Suc (Suc 0)))} \ {Suc (Suc (Suc (Suc (Suc 0))))..Suc (Suc (Suc (Suc (Suc (Suc 0)))))})" + by(rule card_Un_disjnt) (auto simp: disjnt_def) + also have "... = card ({Suc 0..Suc (Suc (Suc (Suc (Suc (Suc 0)))))} \ {Suc (Suc (Suc (Suc 0)))}) + card ({Suc (Suc (Suc (Suc 0)))} \ {Suc 0..(Suc (Suc (Suc 0)))}) + card ({Suc (Suc (Suc (Suc 0)))} \ {Suc (Suc (Suc (Suc (Suc 0))))..Suc (Suc (Suc (Suc (Suc (Suc 0)))))})" + proof - + have "card ({Suc 0..Suc (Suc (Suc (Suc (Suc (Suc 0)))))} \ {Suc (Suc (Suc (Suc 0)))} \ {Suc (Suc (Suc (Suc 0)))} \ {Suc 0..(Suc (Suc (Suc 0)))}) = card ({Suc 0..Suc (Suc (Suc (Suc (Suc (Suc 0)))))} \ {Suc (Suc (Suc (Suc 0)))}) + card ({Suc (Suc (Suc (Suc 0)))} \ {Suc 0..(Suc (Suc (Suc 0)))})" + by(rule card_Un_disjnt) (auto simp: disjnt_def) + thus ?thesis by simp + qed + also have "... = 11" by auto + finally show ?thesis + by(auto simp: prob_die2 1) +qed + +lemma dice_program_prob:"\

(x in two_dice. P x) = 2 * (\n\{5,6,7,9,10}. of_bool (P n) / 11) + of_bool (P 8) / 11" (is "?P = ?rp") +proof - + have 0: "(\x\{Suc 0..6} \ {Suc 0..6} \ {(x, y). x = 4 \ y = 4}. {fst x + snd x}) = {5,6,7,8,9,10}" + proof safe + show " 5 \ (\x\{Suc 0..6} \ {Suc 0..6} \ {(x, y). x = 4 \ y = 4}. {fst x + snd x})" + by(auto intro!: bexI[where x="(1,4)"]) + show "6 \ (\x\{Suc 0..6} \ {Suc 0..6} \ {(x, y). x = 4 \ y = 4}. {fst x + snd x})" + by(auto intro!: bexI[where x="(2,4)"]) + show "7 \ (\x\{Suc 0..6} \ {Suc 0..6} \ {(x, y). x = 4 \ y = 4}. {fst x + snd x})" + by(auto intro!: bexI[where x="(3,4)"]) + show "8 \ (\x\{Suc 0..6} \ {Suc 0..6} \ {(x, y). x = 4 \ y = 4}. {fst x + snd x})" + by(auto intro!: bexI[where x="(4,4)"]) + show "9 \ (\x\{Suc 0..6} \ {Suc 0..6} \ {(x, y). x = 4 \ y = 4}. {fst x + snd x})" + by(auto intro!: bexI[where x="(5,4)"]) + show "10 \ (\x\{Suc 0..6} \ {Suc 0..6} \ {(x, y). x = 4 \ y = 4}. {fst x + snd x})" + by(auto intro!: bexI[where x="(6,4)"]) + qed auto + + have 1:"{Suc 0..6} \ {Suc 0..6} \ {x. fst x = 4 \ snd x = 4} \ {}" + proof - + have "(1,4) \ {Suc 0..6} \ {Suc 0..6} \ {x. fst x = 4 \ snd x = 4}" + by auto + thus ?thesis by blast + qed + hence 2: "set_pmf (pair_pmf (pmf_of_set {Suc 0..6}) (pmf_of_set {Suc 0..6})) \ {(x, y). x = 4 \ y = 4} \ {}" + by(auto simp: split_beta') + have ceq:"condition (die \\<^sub>Q\<^sub>m\<^sub>e\<^sub>s die) (\(x,y). x = 4 \ y = 4) = qbs_pmf (cond_pmf (pair_pmf (pmf_of_set {Suc 0..6}) (pmf_of_set {Suc 0..6})) {(x,y). x = 4 \ y = 4})" + by(auto simp: split_beta' qbs_pair_pmf 1 intro!: qbs_pmf_cond_pmf) + have "two_dice = condition (die \\<^sub>Q\<^sub>m\<^sub>e\<^sub>s die) (\(x,y). x = 4 \ y = 4) \ (\(x,y). return_qbs \\<^sub>Q (x + y))" + by(simp add: two_dice_def) + also have "... = qbs_pmf (cond_pmf (pair_pmf (pmf_of_set {Suc 0..6}) (pmf_of_set {Suc 0..6})) {(x,y). x = 4 \ y = 4}) \ (\z. qbs_pmf (return_pmf (fst z + snd z)))" + by(simp add: ceq) (simp add: qbs_pmf_return_pmf split_beta') + also have "... = qbs_pmf (cond_pmf (pair_pmf (pmf_of_set {Suc 0..6}) (pmf_of_set {Suc 0..6})) {(x,y). x = 4 \ y = 4} \ (\z. return_pmf (fst z + snd z)))" + by(rule qbs_pmf_bind_pmf[symmetric]) + finally have two_dice_eq:"two_dice = qbs_pmf (cond_pmf (pair_pmf (pmf_of_set {Suc 0..6}) (pmf_of_set {Suc 0..6})) {(x,y). x = 4 \ y = 4} \ (\z. return_pmf (fst z + snd z)))" . + + have 3:"measure_pmf.prob (pair_pmf (pmf_of_set {Suc 0..6}) (pmf_of_set {Suc 0..6})) {(x, y). x = 4 \ y = 4} = 11 / 36" + using dice_prob1 by(auto simp: split_beta' qbs_pair_pmf) + + have "?P = measure_pmf.prob (cond_pmf (pair_pmf (pmf_of_set {Suc 0..6}) (pmf_of_set {Suc 0..6})) {(x, y). x = 4 \ y = 4} \ (\z. return_pmf (fst z + snd z))) {x. P x}" (is "_ = measure_pmf.prob ?bind _") + by(simp add: two_dice_eq) + also have "... = measure_pmf.prob ?bind ({x. P x} \ set_pmf ?bind)" + by(rule measure_Int_set_pmf[symmetric]) + also have "... = sum (pmf ?bind) ({x. P x} \ set_pmf ?bind)" + by(rule measure_measure_pmf_finite) (auto simp: set_cond_pmf[OF 2]) + also have "... = sum (pmf ?bind) ({x. P x} \ {5, 6, 7, 8, 9, 10})" + by(auto simp: set_cond_pmf[OF 2] 0) + also have "... = (\n\{n. P n}\{5, 6, 7, 8, 9, 10}. measure_pmf.expectation (cond_pmf (pair_pmf (pmf_of_set {Suc 0..6}) (pmf_of_set {Suc 0..6})) {(x, y). x = 4 \ y = 4}) (\x. indicat_real {n} (fst x + snd x)))" (is "_ = (\_\_. measure_pmf.expectation ?cond _ )") + by(simp add: pmf_bind) + also have "... = (\n\{n. P n}\{5, 6, 7, 8, 9, 10}. (\m\{(1,4),(2,4),(3,4),(4,4),(5,4),(6,4),(4,1),(4,2),(4,3),(4,5),(4,6)}. indicat_real {n} (fst m + snd m) * pmf ?cond m))" + proof(intro Finite_Cartesian_Product.sum_cong_aux integral_measure_pmf_real) + fix n m + assume h:"n \ {n. P n}\{5, 6, 7, 8, 9, 10}" "m \ set_pmf ?cond" "indicat_real {n} (fst m + snd m) \ 0" + then have nm:"fst m + snd m = n" + by(auto simp: indicator_def) + have m: "fst m \ 0" "snd m \ 0" "fst m = 4 \ snd m = 4" + using h(2) by(auto simp: set_cond_pmf[OF 2]) + show "m \ {(1, 4), (2, 4), (3, 4), (4,4), (5, 4), (6, 4), (4, 1), (4, 2), (4, 3), (4, 5), (4, 6)}" + using h(1) nm m by(auto, metis prod.collapse)+ + qed simp + also have "... = (\n\{n. P n}\{5, 6, 7, 8, 9, 10}. (\m\{(1,4),(2,4),(3,4),(4,4),(5,4),(6,4),(4,1),(4,2),(4,3),(4,5),(4,6)}. indicat_real {n} (fst m + snd m) * 1 / 11))" + proof(rule Finite_Cartesian_Product.sum_cong_aux[OF Finite_Cartesian_Product.sum_cong_aux]) + fix n m + assume h:"n \ {n. P n}\{5, 6, 7, 8, 9, 10}" "m \ {(1,4),(2,4),(3,4),(4,4),(5,4),(6,4),(4,1),(4,2),(4,3),(4,5),(4::nat,6::nat)}" + have "pmf ?cond m = 1 / 11" + using h(2) by(auto simp add: pmf_cond[OF 2] 3 pmf_pair) + thus " indicat_real {n} (fst m + snd m) * pmf ?cond m = indicat_real {n} (fst m + snd m) * 1 / 11" + by simp + qed + also have "... = ?rp" + by fastforce + finally show ?thesis . +qed + +corollary + "\

(x in two_dice. x = 5) = 2 / 11" + "\

(x in two_dice. x = 6) = 2 / 11" + "\

(x in two_dice. x = 7) = 2 / 11" + "\

(x in two_dice. x = 8) = 1 / 11" + "\

(x in two_dice. x = 9) = 2 / 11" + "\

(x in two_dice. x = 10) = 2 / 11" + + unfolding dice_program_prob by simp_all + +subsubsection \ Gaussian Mean Learning \ +text \ Example from Sato et al.~Section~8.~2 in @{cite Sato_2019}.\ + +definition "Gauss \ (\\ \. density_qbs lborel\<^sub>Q (normal_density \ \))" + +lemma Gauss_qbs[qbs]: "Gauss \ \\<^sub>Q \\<^sub>Q \\<^sub>Q \\<^sub>Q monadM_qbs \\<^sub>Q" + by(simp add: Gauss_def) + +primrec GaussLearn' :: "[real, real qbs_measure, real list] + \ real qbs_measure" where + "GaussLearn' _ p [] = p" +| "GaussLearn' \ p (y#ls) = query (GaussLearn' \ p ls) + (normal_density y \)" + +lemma GaussLearn'_qbs[qbs]:"GaussLearn' \ \\<^sub>Q \\<^sub>Q monadM_qbs \\<^sub>Q \\<^sub>Q list_qbs \\<^sub>Q \\<^sub>Q monadM_qbs \\<^sub>Q" + by(simp add: GaussLearn'_def) + +context + fixes \ :: real + assumes [arith]: "\ > 0" +begin + + +abbreviation "GaussLearn \ GaussLearn' \" + +lemma GaussLearn_qbs[qbs]: "GaussLearn \ qbs_space (monadM_qbs \\<^sub>Q \\<^sub>Q list_qbs \\<^sub>Q \\<^sub>Q monadM_qbs \\<^sub>Q)" + by simp + +definition Total :: "real list \ real" where "Total = (\l. foldr (+) l 0)" + +lemma Total_simp: "Total [] = 0" "Total (y#ls) = y + Total ls" + by(simp_all add: Total_def) + +lemma Total_qbs[qbs]: "Total \ list_qbs \\<^sub>Q \\<^sub>Q \\<^sub>Q" + by(simp add: Total_def) + +lemma GaussLearn_Total: + assumes [arith]: "\ > 0" "n = length L" + shows "GaussLearn (Gauss \ \) L = Gauss ((Total L*\\<^sup>2+\*\\<^sup>2)/(n*\\<^sup>2+\\<^sup>2)) (sqrt ((\\<^sup>2*\\<^sup>2)/(n*\\<^sup>2+\\<^sup>2)))" + using assms(2) +proof(induction L arbitrary: n) + case Nil + then show ?case + by(simp add: Total_def) +next + case ih:(Cons a L) + then obtain n' where n':"n = Suc n'" "n' = length L" + by auto + have 1:"\\<^sup>2 * \\<^sup>2 / (real n' * \\<^sup>2 + \\<^sup>2) > 0" + by(auto intro!: divide_pos_pos add_nonneg_pos) + have sigma:"(sqrt (\\<^sup>2 * \\<^sup>2 / (real n' * \\<^sup>2 + \\<^sup>2)) * \ / sqrt (\\<^sup>2 * \\<^sup>2 / (real n' * \\<^sup>2 + \\<^sup>2) + \\<^sup>2)) = (sqrt (\\<^sup>2 * \\<^sup>2 / (real n * \\<^sup>2 + \\<^sup>2)))" + proof(rule power2_eq_imp_eq) + show "(sqrt (\\<^sup>2 * \\<^sup>2 / (real n' * \\<^sup>2 + \\<^sup>2)) * \ / sqrt (\\<^sup>2 * \\<^sup>2 / (real n' * \\<^sup>2 + \\<^sup>2) + \\<^sup>2))\<^sup>2 = (sqrt (\\<^sup>2 * \\<^sup>2 / (real n * \\<^sup>2 + \\<^sup>2)))\<^sup>2" (is "?lhs = ?rhs") + proof - + have "?lhs = (\\<^sup>2 * \\<^sup>2 / (real n' * \\<^sup>2 + \\<^sup>2)) * (\\<^sup>2 / (\\<^sup>2 * \\<^sup>2 / (real n' * \\<^sup>2 + \\<^sup>2) + \\<^sup>2))" + by (simp add: power_divide power_mult_distrib) + also have "... = \\<^sup>2 * \\<^sup>2 / (real n' * \\<^sup>2 + \\<^sup>2) * (\\<^sup>2 / ((\\<^sup>2 / (real n' * \\<^sup>2 + \\<^sup>2) + 1) * \\<^sup>2))" + by (simp add: distrib_left mult.commute) + also have "... = \\<^sup>2 * \\<^sup>2 / (real n' * \\<^sup>2 + \\<^sup>2) * (1 / (\\<^sup>2 / (real n' * \\<^sup>2 + \\<^sup>2) + 1))" + by simp + also have "... = \\<^sup>2 * \\<^sup>2 / (real n' * \\<^sup>2 + \\<^sup>2) * (1 / ((\\<^sup>2 + (real n' * \\<^sup>2 + \\<^sup>2)) / (real n' * \\<^sup>2 + \\<^sup>2)))" + by(simp only: add_divide_distrib[of "\\<^sup>2"]) auto + also have "... = \\<^sup>2 * \\<^sup>2 / (real n' * \\<^sup>2 + \\<^sup>2) * ((real n' * \\<^sup>2 + \\<^sup>2) / (\\<^sup>2 + (real n' * \\<^sup>2 + \\<^sup>2)))" + by simp + also have "... = \\<^sup>2 * \\<^sup>2 / (\\<^sup>2 + (real n' * \\<^sup>2 + \\<^sup>2))" + using "1" by force + also have "... = ?rhs" + by(simp add: n'(1) distrib_right) + finally show ?thesis . + qed + qed simp_all + have mu: "((Total L * \\<^sup>2 + \ * \\<^sup>2) * \\<^sup>2 / (real n' * \\<^sup>2 + \\<^sup>2) + a * (\\<^sup>2 * \\<^sup>2) / (real n' * \\<^sup>2 + \\<^sup>2)) / (\\<^sup>2 * \\<^sup>2 / (real n' * \\<^sup>2 + \\<^sup>2) + \\<^sup>2) = ((a + Total L) * \\<^sup>2 + \ * \\<^sup>2) / (real n * \\<^sup>2 + \\<^sup>2)" (is "?lhs = ?rhs") + proof - + have "?lhs = (((Total L * \\<^sup>2 + \ * \\<^sup>2) * \\<^sup>2 + a * (\\<^sup>2 * \\<^sup>2))/ (real n' * \\<^sup>2 + \\<^sup>2)) / (\\<^sup>2 * \\<^sup>2 / (real n' * \\<^sup>2 + \\<^sup>2) + \\<^sup>2)" + by(simp add: add_divide_distrib) + also have "... = (((Total L * \\<^sup>2 + \ * \\<^sup>2) + a * \\<^sup>2) * \\<^sup>2 / (real n' * \\<^sup>2 + \\<^sup>2)) / (\\<^sup>2 * \\<^sup>2 / (real n' * \\<^sup>2 + \\<^sup>2) + \\<^sup>2)" + by (simp add: distrib_left mult.commute) + also have "... = (((Total L * \\<^sup>2 + \ * \\<^sup>2) + a * \\<^sup>2) * \\<^sup>2 / (real n' * \\<^sup>2 + \\<^sup>2)) / ((\\<^sup>2 * \\<^sup>2 + (real n' * \\<^sup>2 + \\<^sup>2) * \\<^sup>2) / (real n' * \\<^sup>2 + \\<^sup>2))" + by (simp add: add_divide_distrib) + also have "... = (((Total L * \\<^sup>2 + \ * \\<^sup>2) + a * \\<^sup>2) * \\<^sup>2) / (\\<^sup>2 * \\<^sup>2 + (real n' * \\<^sup>2 + \\<^sup>2) * \\<^sup>2)" + using 1 by auto + also have "... = (((Total L * \\<^sup>2 + \ * \\<^sup>2) + a * \\<^sup>2) * \\<^sup>2) / ((\\<^sup>2 + (real n' * \\<^sup>2 + \\<^sup>2)) * \\<^sup>2)" + by(simp only: distrib_right) + also have "... = ((Total L * \\<^sup>2 + \ * \\<^sup>2) + a * \\<^sup>2) / (\\<^sup>2 + (real n' * \\<^sup>2 + \\<^sup>2))" + by simp + also have "... = ((Total L * \\<^sup>2 + \ * \\<^sup>2) + a * \\<^sup>2) / (real n * \\<^sup>2 + \\<^sup>2)" + by(simp add: n'(1) distrib_right) + also have "... = ?rhs" + by (simp add: distrib_right) + finally show ?thesis . + qed + show ?case + by(simp add: ih(1)[OF n'(2)]) (simp add: query_def qbs_normal_posterior[OF real_sqrt_gt_zero[OF 1]] Gauss_def Total_simp sigma mu) +qed + +lemma GaussLearn_KL_divergence_lem1: + fixes a :: real + assumes [arith]: "a > 0" "b > 0" "c > 0" "d > 0" + shows "(\n. ln ((b * (n * d + c)) / (d * (n * b + a)))) \ 0" +proof - + have "(\n::nat. ln ( (b * (Suc n * d + c)) / (d * (Suc n * b + a)))) = (\n. ln ( (b * (d + c / Suc n)) / (d * (b + a / Suc n))))" + proof + fix n + show "ln (b * (real (Suc n) * d + c) / (d * (real (Suc n) * b + a))) = ln (b * (d + c / real (Suc n)) / (d * (b + a / real (Suc n))))" (is "ln ?l = ln ?r") + proof - + have "?l = b * (d + c / real (Suc n)) / (d * (b + a / real (Suc n))) * (Suc n / Suc n)" + unfolding times_divide_times_eq distrib_left distrib_right by (simp add: mult.assoc mult.commute) + also have "... = ?r" by simp + finally show ?thesis by simp + qed + qed + also have "... \ 0" + apply(rule tendsto_eq_intros(32)[of _ 1]) + apply(rule Topological_Spaces.tendsto_eq_intros(25)[of _ "b * d" _ _ "b * d",OF LIMSEQ_Suc[OF Topological_Spaces.tendsto_eq_intros(18)[of _ b _ _ d]] LIMSEQ_Suc[OF Topological_Spaces.tendsto_eq_intros(18)[of _ d _ _ b]]]) + apply(intro Topological_Spaces.tendsto_eq_intros | auto)+ + done + finally show ?thesis + by(rule LIMSEQ_imp_Suc) +qed + +lemma GaussLearn_KL_divergence_lem1': + fixes b :: real + assumes [arith]: "b > 0" "d > 0" "s > 0" + shows "(\n. ln (sqrt (b\<^sup>2 * s\<^sup>2 / (real n * b\<^sup>2 + s\<^sup>2)) / sqrt (d\<^sup>2 * s\<^sup>2 / (real n * d\<^sup>2 + s\<^sup>2)))) \ 0" (is "?f \ 0") +proof - + have "?f = (\n. ln (sqrt ((b\<^sup>2 * (n * d\<^sup>2 + s\<^sup>2))/ (d\<^sup>2 * (n * b\<^sup>2 + s\<^sup>2)))))" + by(simp add: real_sqrt_divide real_sqrt_mult mult.commute) + also have "... = (\n. ln ((b\<^sup>2 * (n * d\<^sup>2 + s\<^sup>2) / (d\<^sup>2 * (n * b\<^sup>2 + s\<^sup>2)))) / 2)" + by (standard, rule ln_sqrt) (auto intro!: divide_pos_pos mult_pos_pos add_nonneg_pos) + also have "... \ 0" + using GaussLearn_KL_divergence_lem1 by auto + finally show ?thesis . +qed + +lemma GaussLearn_KL_divergence_lem2: + fixes s :: real + assumes [arith]: "s > 0" "b > 0" "d > 0" + shows "(\n. ((d * s) / (n * d + s)) / (2 * ((b * s) / (n * b + s)))) \ 1 / 2" +proof - + have "(\n::nat. ((d * s) / (Suc n * d + s)) / (2 * ((b * s) / (Suc n * b + s)))) = (\n. (d * b + d * s / Suc n) / (2 * b * d + 2 * b * s / Suc n))" + proof + fix n + show "d * s / (real (Suc n) * d + s) / (2 * (b * s / (real (Suc n) * b + s))) = (d * b + d * s / real (Suc n)) / (2 * b * d + 2 * b * s / real (Suc n))" (is "?l = ?r") + proof - + have "?l = d * (Suc n * b + s) / ((2 * b) * (Suc n * d + s))" + by(simp add: divide_divide_times_eq) + also have "... = d * (b + s / Suc n) / ((2 * b) * (d + s / Suc n)) * (Suc n / Suc n)" + proof - + have 1:"(2 * b * d * real (Suc n) + 2 * b * (s / real (Suc n)) * real (Suc n))= (2 * b) * (Suc n * d + s)" + unfolding distrib_left distrib_right by(simp add: mult.assoc mult.commute) + show ?thesis + unfolding times_divide_times_eq distrib_left distrib_right 1 + by (simp add: mult.assoc mult.commute) + qed + also have "... = ?r" + by(auto simp: distrib_right distrib_left mult.commute) + finally show ?thesis . + qed + qed + also have "... \ 1 / 2" + by(rule Topological_Spaces.tendsto_eq_intros(25)[of _ "d * b" _ _ "2 * b * d",OF LIMSEQ_Suc LIMSEQ_Suc]) (intro Topological_Spaces.tendsto_eq_intros | auto)+ + finally show ?thesis + by(rule LIMSEQ_imp_Suc) +qed + +lemma GaussLearn_KL_divergence_lem2': + fixes s :: real + assumes [arith]: "s > 0" "b > 0" "d > 0" + shows "(\n. ((d^2 * s^2) / (n * d^2 + s^2)) / (2 * ((b^2 * s^2) / (n * b^2 + s^2))) - 1 / 2) \ 0" + using GaussLearn_KL_divergence_lem2[of "s^2" "b^2" "d^2"] + by(rule LIM_zero) auto + +lemma GaussLearn_KL_divergence_lem3: + fixes a b c d s K L :: real + assumes [arith]: "b > 0" "d > 0" "s > 0" + shows "((K * d + c * s) / (n * d + s) - (L * b + a * s) / (n * b + s))^2 / (2 * ((b * s) / (n * b + s))) = ((((((K - L) * d * b * real n + c * s * b * real n + K * d * s + c * s * s) - a * s * d * real n - L * b * s - a * s * s))\<^sup>2 / (d * d * b * (real n * real n * real n) + s * s * b * real n + 2 * d * s * b * (real n * real n) + d * d * (real n * real n) * s + s * s * s + 2 * d * s * s * real n))) / (2 * (b * s))" (is "?lhs = ?rhs") +proof - + have 0:"real n * d + s > 0" "real n * b + s > 0" + by(auto intro!: add_nonneg_pos) + hence 1:"real n * d + s \ 0" "real n * b + s \ 0" by simp_all + have "?lhs = (((K * d + c * s) * (n * b + s) - (L * b + a * s) * (n * d + s)) / ((n * d + s) * (n * b + s)))\<^sup>2 / (2 * (b * s / (n * b + s)))" + unfolding diff_frac_eq[OF 1] by simp + also have "... = (((((K * d + c * s) * (n * b + s) - (L * b + a * s) * (n * d + s)))\<^sup>2 / ((n * d + s)^2 * (n * b + s)))) / (2 * (b * s))" + by(auto simp: power2_eq_square) + also have "... = (((((K * d * (n * b) + c * s * (n * b) + K * d * s + c * s * s) - ((L * b * (n * d) + a * s * (n * d) + L * b * s + a * s * s))))\<^sup>2 / ((n * d)^2 * (n * b) + s^2 * (n * b) + 2 * (n * d) * s * (n * b) + (n * d)^2 * s + s^2 * s + 2 * (n * d) * s * s))) / (2 * (b * s))" + by(simp add: power2_sum distrib_left distrib_right is_num_normalize(1)) + also have "... = (((((K * d * b * real n + c * s * b * real n + K * d * s + c * s * s) - ((L * b * d * real n + a * s * d * real n + L * b * s + a * s * s))))\<^sup>2 / (d * d * b * (real n * real n * real n) + s * s * b *real n + 2 * d * s * b * (real n * real n) + d * d * (real n * real n) * s + s * s * s + 2 * d * s * s * real n))) / (2 * (b * s))" + by (simp add: mult.commute mult.left_commute power2_eq_square) + also have "... = ((((((K - L) * d * b * real n + c * s * b * real n + K * d * s + c * s * s) - ((a * s * d * real n + L * b * s + a * s * s))))\<^sup>2 / (d * d * b * (real n * real n * real n) + s * s * b * real n + 2 * d * s * b * (real n * real n) + d * d * (real n * real n) * s + s * s * s + 2 * d * s * s * real n))) / (2 * (b * s))" + proof - + have 1:"K * d * b * real n + c * s * b * real n + K * d * s + c * s * s - (L * b * d * real n + a * s * d * real n + L * b * s + a * s * s) = (K - L) * d * b * real n + c * s * b * real n + K * d * s + c * s * s - (a * s * d * real n + L * b * s + a * s * s)" + by (simp add: left_diff_distrib) + show ?thesis + unfolding 1 .. + qed + also have "... = ?rhs" + by (simp add: diff_diff_eq) + finally show ?thesis . +qed + +lemma GaussLearn_KL_divergence_lem4: + fixes a b c d s K L :: real + assumes [arith]: "b > 0" "d > 0" "s > 0" + shows "(\n. (\c * s * b * real n\ + \K * (real n) * d * s\ + \c * s * s\ + \a * s * d * real n\ + \L * (real n) * b * s\ + \a * s * s\)\<^sup>2 / (d * d * b * (real n * real n * real n) + s * s * b * real n + 2 * d * s * b * (real n * real n) + d * d * (real n * real n) * s + s * s * s + 2 * d * s * s * real n) / (2 * (b * s))) \ 0" (is "(\n. ?f n) \ 0") +proof - + have t1: "(\n. x / (real n * real n)) \ 0" for x + proof - + have "(\n. x / (real n * real n)) = (\n. x / (real n) * (1 / real n))" + by simp + also have "... \ 0" + by (intro Topological_Spaces.tendsto_eq_intros | auto)+ + finally show ?thesis . + qed + have t4: "(\n. x / (real n * real n * real n)) \ 0" for x + proof - + have "(\n. x / (real n * real n * real n)) = (\n. x / (real n) * (1 / real n) * (1 / real n))" + by simp + also have "... \ 0" + by (intro Topological_Spaces.tendsto_eq_intros | auto)+ + finally show ?thesis . + qed + have t2[tendsto_intros]: "(\n. x / (sqrt n)) \ 0" for x + by(rule power_tendsto_0_iff[of 2,THEN iffD1],simp_all add: power2_eq_square) (intro Topological_Spaces.tendsto_eq_intros | auto)+ + have t3: "(\n. x / (sqrt n * real n)) \ 0" for x + proof - + have "(\n. x / (sqrt n * real n)) = (\n. x / sqrt n * (1 / n))" by simp + also have "... \ 0" + by (intro Topological_Spaces.tendsto_eq_intros | auto)+ + finally show ?thesis . + qed + + have "(\n. ?f (Suc n)) = (\n. ((\(c * s * b) / sqrt (real (Suc n))\ + \(K * d * s) / sqrt (real (Suc n))\ + \(c * s * s) / (sqrt (Suc n) * real (Suc n))\ + \(a * s * d) / sqrt (real (Suc n))\ + \(L * b * s) / sqrt (real (Suc n))\ + \(a * s * s) / (sqrt (Suc n) * real (Suc n))\)\<^sup>2 / ((d * d * b + (s * s * b) / (real (Suc n) * real (Suc n)) + (2 * d * s * b) / real (Suc n) + (d * d * s) / real (Suc n) + (s * s * s) / (real (Suc n) * real (Suc n) * real (Suc n)) + (2 * d * s * s) / (real (Suc n) * real (Suc n))))) / (2 * (b * s)))" (is "_ = (\n. ?g (Suc n))") + proof + fix n + show "?f (Suc n) = ?g (Suc n)" (is "?lhs = ?rhs") + proof - + have "?lhs = (\c * s * b * real (Suc n)\ + \K * d * s * real (Suc n)\ + \c * s * s\ + \a * s * d * real (Suc n)\ + \L * b * s * real (Suc n)\ + \a * s * s\)\<^sup>2 / (d * d * b * (real (Suc n) * real (Suc n) * real (Suc n)) + s * s * b * real (Suc n) + 2 * d * s * b * (real (Suc n) * real (Suc n)) + d * d * (real (Suc n) * real (Suc n)) * s + s * s * s + 2 * d * s * s * real (Suc n)) / (2 * (b * s))" + proof - + have 1:"K * real (Suc n) * d * s = K * d * s * real (Suc n)" "L * real (Suc n) * b * s = L * b * s * real (Suc n)" + by auto + show ?thesis + unfolding 1 .. + qed + also have "... = ((\c * s * b / sqrt (real (Suc n))\ + \K * d * s / sqrt (real (Suc n))\ + \(c * s * s) / (sqrt (Suc n) * real (Suc n))\ + \a * s * d / sqrt (real (Suc n))\ + \L * b * s / sqrt (real (Suc n))\ + \(a * s * s) / (sqrt (Suc n) * real (Suc n))\) * (sqrt (Suc n) * real (Suc n)) )\<^sup>2 / (d * d * b * (real (Suc n) * real (Suc n) * real (Suc n)) + s * s * b * real (Suc n) + 2 * d * s * b * (real (Suc n) * real (Suc n)) + d * d * (real (Suc n) * real (Suc n)) * s + s * s * s + 2 * d * s * s * real (Suc n)) / (2 * (b * s))" + by(simp add: distrib_right left_diff_distrib mult.assoc[symmetric] abs_mult[of _ "real (Suc n)"] del: of_nat_Suc) + also have "... = ((\c * s * b / sqrt (real (Suc n))\ + \K * d * s / sqrt (real (Suc n))\ + \(c * s * s) / (sqrt (Suc n) * real (Suc n))\ + \a * s * d / sqrt (real (Suc n))\ + \L * b * s / sqrt (real (Suc n))\ + \(a * s * s) / (sqrt (Suc n) * real (Suc n))\)^2 * (real (Suc n) * real (Suc n) * real (Suc n))) / (d * d * b * (real (Suc n) * real (Suc n) * real (Suc n)) + s * s * b * real (Suc n) + 2 * d * s * b * (real (Suc n) * real (Suc n)) + d * d * (real (Suc n) * real (Suc n)) * s + s * s * s + 2 * d * s * s * real (Suc n)) / (2 * (b * s))" + by(simp add: power2_eq_square) + also have "... = ((\c * s * b / sqrt (real (Suc n))\ + \K * d * s / sqrt (real (Suc n))\ + \(c * s * s) / (sqrt (Suc n) * real (Suc n))\ + \a * s * d / sqrt (real (Suc n))\ + \L * b * s / sqrt (real (Suc n))\ + \(a * s * s) / (sqrt (Suc n) * real (Suc n))\)^2 / ((d * d * b * (real (Suc n) * real (Suc n) * real (Suc n)) + s * s * b * real (Suc n) + 2 * d * s * b * (real (Suc n) * real (Suc n)) + d * d * (real (Suc n) * real (Suc n)) * s + s * s * s + 2 * d * s * s * real (Suc n)) / (real (Suc n) * real (Suc n) * real (Suc n)))) / (2 * (b * s))" + by simp + also have "... = ?rhs" + by(simp add: add_divide_distrib) + finally show ?thesis . + qed + qed + also have "... \ 0" + apply(rule LIMSEQ_Suc) + apply(rule Topological_Spaces.tendsto_eq_intros(25)[of _ 0 _ _ "2 * (b * s)",OF Topological_Spaces.tendsto_eq_intros(25)[of _ 0 _ _ "d * d * b"]]) + apply(intro lim_const_over_n t1 t2 t3 t4 tendsto_diff[of _ 0 _ _ 0,simplified] tendsto_add_zero tendsto_add[of _ "d * d * b" _ _ 0,simplified] | auto)+ + done + finally show ?thesis + by(rule LIMSEQ_imp_Suc) +qed + +lemma GaussLearn_KL_divergence_lem5: + fixes a b c d K :: real + assumes [arith]: "b > 0" "d > 0" "s > 0" "K > 0" "\f l\ < K * length l" + shows "\(c * s * b * real (length l) + f l * d * s + c * s * s - a * s * d * real (length l) - f l * b * s - a * s * s)\<^sup>2 / (d * d * b * (real (length l) * real (length l) * real (length l)) + s * s * b * real (length l) + 2 * d * s * b * (real (length l) * real (length l)) + d * d * (real (length l) * real (length l)) * s + s * s * s + 2 * d * s * s * real (length l)) / (2 * (b * s))\ \ \(\c * s * b * real (length l)\ + \K * real (length l) * d * s\ + \c * s * s\ + \a * s * d * real (length l)\ + \- K * real (length l) * b * s\ + \a * s * s\)\<^sup>2 / (d * d * b * (real (length l) * real (length l) * real (length l)) + s * s * b * real (length l) + 2 * d * s * b * (real (length l) * real (length l)) + d * d * (real (length l) * real (length l)) * s + s * s * s + 2 * d * s * s * real (length l)) / (2 * (b * s))\" (is "\(?l)^2 / ?c1 / ?c2\ \ \(?r)^2 / _ / _\") +proof - + have "?l^2 / ?c1 / ?c2 \ ?r^2 / ?c1 / ?c2" + proof(rule divide_right_mono[OF divide_right_mono[OF abs_le_square_iff[THEN iffD1]]]) + show "\?l\ \ \?r\" + proof - + have "\?l\ \ \c * s * b * real (length l)\ + \f l * d * s\ + \c * s * s\ + \a * s * d * real (length l)\ + \f l * b * s\ + \a * s * s\" + by linarith + also have "... \ \?r\" + by (auto simp: mult.assoc abs_mult) (auto intro!: add_mono) + finally show ?thesis . + qed + qed auto + thus ?thesis + by fastforce +qed + +lemma GaussLearn_KL_divergence_lem6: + fixes a e b c d K :: real and f :: "'a list \ real" + assumes [arith]:"e > 0" "b > 0" "d > 0" "s > 0" + shows "\N. \l. length l \ N \ \f l\ < K * length l \ \((f l * d + c * s) / (length l * d + s) - (f l * b + a * s) / (length l * b + s))^2 / (2 * ((b * s) / (length l * b + s))) \ < e" +proof(cases "K > 0") + case K[arith]:True + from GaussLearn_KL_divergence_lem4[OF assms(2-),of c K a "- K"] assms(1) obtain N where N: + "\n. n \ N \ \(\c * s * b * real n\ + \K * real n * d * s\ + \c * s * s\ + \a * s * d * real n\ + \- K * real n * b * s\ + \a * s * s\)\<^sup>2 / (d * d * b * (real n * real n * real n) + s * s * b * real n + 2 * d * s * b * (real n * real n) + d * d * (real n * real n) * s + s * s * s + 2 * d * s * s * real n) / (2 * (b * s))\ < e" + by(fastforce simp: LIMSEQ_def) + show ?thesis + proof(safe intro!: exI[where x=N]) + fix l :: "'a list" + assume l:"N \ length l" "\f l\ < K * real (length l)" + show "\((f l * d + c * s) / (real (length l) * d + s) - (f l * b + a * s) / (real (length l) * b + s))\<^sup>2 / (2 * (b * s / (real (length l) * b + s)))\ < e" (is "?l < _") + proof - + have "?l = \(c * s * b * real (length l) + f l * d * s + c * s * s - a * s * d * real (length l) - f l * b * s - a * s * s)\<^sup>2 / (d * d * b * (real (length l) * real (length l) * real (length l)) + s * s * b * real (length l) + 2 * d * s * b * (real (length l) * real (length l)) + d * d * (real (length l) * real (length l)) * s + s * s * s + 2 * d * s * s * real (length l)) / (2 * (b * s))\" + unfolding GaussLearn_KL_divergence_lem3[OF assms(2-)] by simp + also have "... \ \(\c * s * b * real (length l)\ + \K * real (length l) * d * s\ + \c * s * s\ + \a * s * d * real (length l)\ + \- K * real (length l) * b * s\ + \a * s * s\)\<^sup>2 / (d * d * b * (real (length l) * real (length l) * real (length l)) + s * s * b * real (length l) + 2 * d * s * b * (real (length l) * real (length l)) + d * d * (real (length l) * real (length l)) * s + s * s * s + 2 * d * s * s * real (length l)) / (2 * (b * s))\" + by(rule GaussLearn_KL_divergence_lem5) (use l in auto) + also have "... < e" + by(rule N) fact + finally show ?thesis . + qed + qed +next + case False + then show ?thesis + by (metis (no_types, opaque_lifting) abs_ge_zero add_le_cancel_left add_nonneg_nonneg diff_add_cancel diff_ge_0_iff_ge linorder_not_less of_nat_0_le_iff zero_less_mult_iff) +qed + +lemma GaussLearn_KL_divergence: + fixes a b c d e K :: real + assumes [arith]:"e > 0" "b > 0" "d > 0" + shows "\N. \L. length L > N \ \Total L / length L\ < K + \ KL_divergence (exp 1) (GaussLearn (Gauss a b) L) (GaussLearn (Gauss c d) L) < e" +proof - + have h:"\^2 > 0" "b^2>0" "d^2>0" + by auto + from GaussLearn_KL_divergence_lem6[of "e / 3",OF _ h(2,3,1)] obtain N1 where N1: + "\l. N1 \ length l \ \Total l\ < K * real (length l) \ \((Total l * d\<^sup>2 + c * \\<^sup>2) / (real (length l) * d\<^sup>2 + \\<^sup>2) - (Total l * b\<^sup>2 + a * \\<^sup>2) / (real (length l) * b\<^sup>2 + \\<^sup>2))\<^sup>2 / (2 *(b\<^sup>2 * \\<^sup>2 / (real (length l) * b\<^sup>2 + \\<^sup>2)))\ < e / 3" + by fastforce + from GaussLearn_KL_divergence_lem1'[OF assms(2,3) \\ > 0\] + have "\e. e > 0 \ \N. \n. n \ N \ \ln (sqrt (b\<^sup>2 * \\<^sup>2 / (real n * b\<^sup>2 + \\<^sup>2)) / sqrt (d\<^sup>2 * \\<^sup>2 / (real n * d\<^sup>2 + \\<^sup>2)))\ < e" + by(auto simp: LIMSEQ_def) + from this[of "e / 3"] obtain N2 where N2: + "\n. n \ N2 \ \ln (sqrt (b\<^sup>2 * \\<^sup>2 / (real n * b\<^sup>2 + \\<^sup>2)) / sqrt (d\<^sup>2 * \\<^sup>2 / (real n * d\<^sup>2 + \\<^sup>2)))\ < e / 3" + by auto + from GaussLearn_KL_divergence_lem2'[OF \\ > 0\ assms(2,3)] + have "\e. e > 0 \ \N. \n. n \ N \ \d\<^sup>2 * \\<^sup>2 / (real n * d\<^sup>2 + \\<^sup>2) / (2 * (b\<^sup>2 * \\<^sup>2 / (real n * b\<^sup>2 + \\<^sup>2))) - 1 / 2\ < e" + by(auto simp: LIMSEQ_def) + from this[of "e / 3"] obtain N3 where N3: + "\n. n \ N3 \ \d\<^sup>2 * \\<^sup>2 / (real n * d\<^sup>2 + \\<^sup>2) / (2 * (b\<^sup>2 * \\<^sup>2 / (real n * b\<^sup>2 + \\<^sup>2))) - 1 / 2\ < e / 3" + by auto + define N where "N = max (max N1 N2) (max N3 1)" + have N: "N \ N1" "N \ N2" "N \ N3" "N \ 1" + by(auto simp: N_def) + show ?thesis + proof(safe intro!: exI[where x=N]) + fix L :: "real list" + assume l:"N < length L" "\local.Total L / real (length L)\ < K" + then have l': "N \ length L" "\Total L\ < K * real (length L)" + using order.strict_trans1[OF N(4) l(1)] by(auto intro!: pos_divide_less_eq[THEN iffD1]) + show "KL_divergence (exp 1) (GaussLearn (Gauss a b) L) (GaussLearn (Gauss c d) L) < e" (is "?lhs < _") + proof - + have h': "sqrt (b\<^sup>2 * \\<^sup>2 / (real (length L) * b\<^sup>2 + \\<^sup>2)) > 0" "sqrt (d\<^sup>2 * \\<^sup>2 / (real (length L) * d\<^sup>2 + \\<^sup>2)) > 0" + by(auto intro!: divide_pos_pos add_nonneg_pos) + have "?lhs \ \?lhs\" + by auto + also have "... = \KL_divergence (exp 1) (Gauss ((Total L * b\<^sup>2 + a * \\<^sup>2) / (real (length L) * b\<^sup>2 + \\<^sup>2)) (sqrt (b\<^sup>2 * \\<^sup>2 / (real (length L) * b\<^sup>2 + \\<^sup>2)))) (Gauss ((Total L * d\<^sup>2 + c * \\<^sup>2) / (real (length L) * d\<^sup>2 + \\<^sup>2)) (sqrt (d\<^sup>2 * \\<^sup>2 / (real (length L) * d\<^sup>2 + \\<^sup>2))))\" + by(simp add: GaussLearn_Total[OF assms(2) refl] GaussLearn_Total[OF assms(3) refl]) + also have "... = \ln (sqrt (b\<^sup>2 * \\<^sup>2 / (real (length L) * b\<^sup>2 + \\<^sup>2)) / sqrt (d\<^sup>2 * \\<^sup>2 / (real (length L) * d\<^sup>2 + \\<^sup>2))) + ((sqrt (d\<^sup>2 * \\<^sup>2 / (real (length L) * d\<^sup>2 + \\<^sup>2)))\<^sup>2 + ((Total L * d\<^sup>2 + c * \\<^sup>2) / (real (length L) * d\<^sup>2 + \\<^sup>2) - (Total L * b\<^sup>2 + a * \\<^sup>2) / (real (length L) * b\<^sup>2 + \\<^sup>2))\<^sup>2) / (2 * (sqrt (b\<^sup>2 * \\<^sup>2 / (real (length L) * b\<^sup>2 + \\<^sup>2)))\<^sup>2) - 1 / 2\" + by(simp add: KL_normal_density[OF h'] Gauss_def) + also have "... = \ln (sqrt (b\<^sup>2 * \\<^sup>2 / (real (length L) * b\<^sup>2 + \\<^sup>2)) / sqrt (d\<^sup>2 * \\<^sup>2 / (real (length L) * d\<^sup>2 + \\<^sup>2))) + (sqrt (d\<^sup>2 * \\<^sup>2 / (real (length L) * d\<^sup>2 + \\<^sup>2)))\<^sup>2 / (2 * (sqrt (b\<^sup>2 * \\<^sup>2 / (real (length L) * b\<^sup>2 + \\<^sup>2)))\<^sup>2) + ((Total L * d\<^sup>2 + c * \\<^sup>2) / (real (length L) * d\<^sup>2 + \\<^sup>2) - (Total L * b\<^sup>2 + a * \\<^sup>2) / (real (length L) * b\<^sup>2 + \\<^sup>2))\<^sup>2 / (2 * (sqrt (b\<^sup>2 * \\<^sup>2 / (real (length L) * b\<^sup>2 + \\<^sup>2)))\<^sup>2) - 1 / 2\" + unfolding add_divide_distrib by auto + also have "... = \ln (sqrt (b\<^sup>2 * \\<^sup>2 / (real (length L) * b\<^sup>2 + \\<^sup>2)) / sqrt (d\<^sup>2 * \\<^sup>2 / (real (length L) * d\<^sup>2 + \\<^sup>2))) + (d\<^sup>2 * \\<^sup>2 / (real (length L) * d\<^sup>2 + \\<^sup>2)) / (2 * (b\<^sup>2 * \\<^sup>2 / (real (length L) * b\<^sup>2 + \\<^sup>2))) + ((Total L * d\<^sup>2 + c * \\<^sup>2) / (real (length L) * d\<^sup>2 + \\<^sup>2) - (Total L * b\<^sup>2 + a * \\<^sup>2) / (real (length L) * b\<^sup>2 + \\<^sup>2))\<^sup>2 / (2 * (b\<^sup>2 * \\<^sup>2 / (real (length L) * b\<^sup>2 + \\<^sup>2))) - 1 / 2\" + using h' by auto + also have "... \ \ln (sqrt (b\<^sup>2 * \\<^sup>2 / (real (length L) * b\<^sup>2 + \\<^sup>2)) / sqrt (d\<^sup>2 * \\<^sup>2 / (real (length L) * d\<^sup>2 + \\<^sup>2))) + ((d\<^sup>2 * \\<^sup>2 / (real (length L) * d\<^sup>2 + \\<^sup>2)) / (2 * (b\<^sup>2 * \\<^sup>2 / (real (length L) * b\<^sup>2 + \\<^sup>2))) - 1 / 2) + ((Total L * d\<^sup>2 + c * \\<^sup>2) / (real (length L) * d\<^sup>2 + \\<^sup>2) - (Total L * b\<^sup>2 + a * \\<^sup>2) / (real (length L) * b\<^sup>2 + \\<^sup>2))\<^sup>2 / (2 * (b\<^sup>2 * \\<^sup>2 / (real (length L) * b\<^sup>2 + \\<^sup>2)))\" + by auto + also have "... \ \ln (sqrt (b\<^sup>2 * \\<^sup>2 / (real (length L) * b\<^sup>2 + \\<^sup>2)) / sqrt (d\<^sup>2 * \\<^sup>2 / (real (length L) * d\<^sup>2 + \\<^sup>2)))\ + \(d\<^sup>2 * \\<^sup>2 / (real (length L) * d\<^sup>2 + \\<^sup>2)) / (2 * (b\<^sup>2 * \\<^sup>2 / (real (length L) * b\<^sup>2 + \\<^sup>2))) - 1 / 2\ + \((Total L * d\<^sup>2 + c * \\<^sup>2) / (real (length L) * d\<^sup>2 + \\<^sup>2) - (Total L * b\<^sup>2 + a * \\<^sup>2) / (real (length L) * b\<^sup>2 + \\<^sup>2))\<^sup>2 / (2 * (b\<^sup>2 * \\<^sup>2 / (real (length L) * b\<^sup>2 + \\<^sup>2)))\" + by linarith + also have "... < e" + using N1[OF order.trans[OF N(1) l'(1)] l'(2)] N2[OF order.trans[OF N(2) l'(1)]] N3[OF order.trans[OF N(3) l'(1)]] by auto + finally show ?thesis . + qed + qed +qed + +end + +subsubsection \ Continuous Distributions \ +text \ The following (highr-order) program receives a non-negative function $f$ and returns the distribution + whose density function is (noramlized) $f$ if $f$ is integrable w.r.t. the Lebesgue measure.\ +definition dens_to_dist :: "['a :: euclidean_space \ real] \ 'a qbs_measure" where +"dens_to_dist \ (\f. do { + query lborel\<^sub>Q f + })" + +lemma dens_to_dist_qbs[qbs]: "dens_to_dist \ (borel\<^sub>Q \\<^sub>Q \\<^sub>Q) \\<^sub>Q monadM_qbs borel\<^sub>Q" + by(simp add: dens_to_dist_def) + +context + fixes f :: "'a :: euclidean_space \ real" + assumes f_qbs[qbs]: "f \ qbs_borel \\<^sub>Q \\<^sub>Q" + and f_le0:"\x. f x \ 0" + and f_int_ne0:"qbs_l (density_qbs lborel_qbs f) UNIV \ 0" + and f_integrable: "qbs_integrable lborel_qbs f" +begin + +lemma f_integrable'[measurable]: "integrable lborel f" + using f_integrable by(simp add: qbs_integrable_iff_integrable) + +lemma f_int_neinfty: + "qbs_l (density_qbs lborel_qbs f) UNIV \ \" + using f_integrable' f_le0 + by(auto simp: qbs_l_density_qbs[of _ qbs_borel] emeasure_density integrable_iff_bounded) + +lemma dens_to_dist: "dens_to_dist f = density_qbs lborel_qbs (\x. ennreal (1 / measure (qbs_l (density_qbs lborel_qbs f)) UNIV * f x))" +proof - + have [simp]:"ennreal (f x) * (1 / emeasure (qbs_l (density_qbs lborel\<^sub>Q (\x. ennreal (f x)))) UNIV) = ennreal (f x / measure (qbs_l (density_qbs lborel\<^sub>Q (\x. ennreal (f x)))) UNIV)" for x + by (metis divide_ennreal emeasure_eq_ennreal_measure ennreal_0 ennreal_times_divide f_int_ne0 f_int_neinfty f_le0 infinity_ennreal_def mult.comm_neutral zero_less_measure_iff) + show ?thesis + by(auto simp: dens_to_dist_def query_def normalize_qbs[of _ qbs_borel,simplified qbs_space_qbs_borel,OF _ f_int_ne0 f_int_neinfty] density_qbs_density_qbs_eq[of _ qbs_borel]) +qed + +corollary qbs_l_dens_to_dist: "qbs_l (dens_to_dist f) = density lborel (\x. ennreal (1 / measure (qbs_l (density_qbs lborel_qbs f)) UNIV * f x))" + by(simp add: dens_to_dist qbs_l_density_qbs[of _ qbs_borel]) + +corollary qbs_integral_dens_to_dist: + assumes [qbs]: "g \ qbs_borel \\<^sub>Q \\<^sub>Q" + shows "(\\<^sub>Q x. g x \dens_to_dist f) = (\\<^sub>Q x. 1 / measure (qbs_l (density_qbs lborel_qbs f)) UNIV * f x * g x \lborel\<^sub>Q)" + using f_le0 by(simp add: qbs_integral_density_qbs[of _ qbs_borel _ g ,OF _ _ _ AEq_I2[of _ qbs_borel]] dens_to_dist) + +lemma dens_to_dist_prob[qbs]:"dens_to_dist f \ qbs_space (monadP_qbs borel\<^sub>Q)" + using f_int_neinfty f_int_ne0 by(auto simp: dens_to_dist_def query_def intro!: normalize_qbs_prob) + +end + +subsubsection \ Normal Distribution \ +context + fixes \ \ :: real + assumes sigma_pos[arith]: "\ > 0" +begin + +text \ We use an unnormalized density function. \ +definition "normal_f \ (\x. exp (-(x - \)\<^sup>2/ (2 * \\<^sup>2)))" + +lemma nc_normal_f: "qbs_l (density_qbs lborel_qbs normal_f) UNIV = ennreal (sqrt (2 * pi * \\<^sup>2))" +proof - + have "qbs_l (density_qbs lborel_qbs normal_f) UNIV = (\\<^sup>+ x. ennreal (exp (- ((x - \)\<^sup>2 / (2 * \\<^sup>2)))) \lborel)" + by(auto simp: qbs_l_density_qbs[of _ qbs_borel] normal_f_def emeasure_density) + also have "... = ennreal (sqrt (2 * pi * \\<^sup>2)) * (\\<^sup>+ x. normal_density \ \ x \lborel)" + by(auto simp: nn_integral_cmult[symmetric] normal_density_def ennreal_mult'[symmetric] intro!: nn_integral_cong) + also have "... = ennreal (sqrt (2 * pi * \\<^sup>2))" + using prob_space.emeasure_space_1[OF prob_space_normal_density] + by(simp add: emeasure_density) + finally show ?thesis . +qed + +corollary measure_qbs_l_dens_to_dist_normal_f: "measure (qbs_l (density_qbs lborel_qbs normal_f)) UNIV = sqrt (2 * pi * \\<^sup>2)" + by(simp add: measure_def nc_normal_f) + + +lemma normal_f: + shows "normal_f \ qbs_borel \\<^sub>Q \\<^sub>Q" + and "\x. normal_f x \ 0" + and "qbs_l (density_qbs lborel_qbs normal_f) UNIV \ 0" + and "qbs_integrable lborel_qbs normal_f" + using nc_normal_f by(auto simp: qbs_integrable_iff_integrable integrable_iff_bounded qbs_l_density_qbs[of _ qbs_borel] normal_f_def emeasure_density) + +lemma qbs_l_densto_dist_normal_f: "qbs_l (dens_to_dist normal_f) = density lborel (normal_density \ \)" + by(simp add: qbs_l_dens_to_dist[OF normal_f] measure_qbs_l_dens_to_dist_normal_f normal_density_def) (simp add: normal_f_def) + +end + +subsubsection \ Half Normal Distribution \ +context + fixes \ \ :: real + assumes sigma_pos[arith]:"\ > 0" +begin + +definition "hnormal_f \ (\x. if x \ \ then 0 else normal_density \ \ x)" + +lemma nc_hnormal_f: "qbs_l (density_qbs lborel_qbs hnormal_f) UNIV = ennreal (1/ 2)" +proof - + have "qbs_l (density_qbs lborel_qbs hnormal_f) UNIV = (\\<^sup>+ x. ennreal (if x \ \ then 0 else normal_density \ \ x) \lborel)" + by(auto simp: qbs_l_density_qbs[of _ qbs_borel] hnormal_f_def emeasure_density) + also have "... = (\\<^sup>+ x\{\<..}. normal_density \ \ x \lborel)" + by(auto intro!: nn_integral_cong) + also have "... = 1 / 2 * (\\<^sup>+ x. normal_density \ \ x \lborel)" + proof - + have 1:"(\\<^sup>+ x. normal_density \ \ x \lborel) = (\\<^sup>+ x\{\<..}. normal_density \ \ x \lborel) + (\\<^sup>+ x\{..\}. normal_density \ \ x \lborel)" + by(auto simp: nn_integral_add[symmetric] intro!: nn_integral_cong) (simp add: indicator_def) + have 2: "(\\<^sup>+ x\{\<..}. normal_density \ \ x \lborel) = (\\<^sup>+ x\{..\}. normal_density \ \ x \lborel)" (is "?l = ?r") + proof - + have "?l = (\\<^sup>+ x. ennreal (normal_density \ \ x * indicator {\<..} x) \lborel)" + by(auto intro!: nn_integral_cong simp add: indicator_mult_ennreal mult.commute) + also have "... = ennreal (\x. normal_density \ \ x * indicator {\<..} x \lborel)" + by(auto intro!: nn_integral_eq_integral integrable_real_mult_indicator) + also have "... = ennreal (\x. normal_density \ \ x * indicator {\<..} x \lebesgue)" + by(simp add: integral_completion) + also have "... = ennreal (\x. (if x \ {\<..} then normal_density \ \ x else 0) \lebesgue)" + by (meson indicator_times_eq_if(2)) + also have "... = ennreal (\x. normal_density \ \ x \lebesgue_on {\<..})" + by(rule ennreal_cong, rule Lebesgue_Measure.integral_restrict_UNIV) simp + also have "... = ennreal (integral {\<..} (normal_density \ \))" + by(rule ennreal_cong, rule lebesgue_integral_eq_integral) (auto simp: integrable_restrict_space integrable_completion intro!: integrable_mult_indicator[where 'b=real,simplified]) + also have "... = ennreal (integral {..<\} (\x. normal_density \ \ (- x + 2 * \)))" + proof - + have "integral {\<..} (normal_density \ \) = integral {..<\} (\x. \- 1\ *\<^sub>R normal_density \ \ (- x + 2 * \))" + proof(rule conjunct2[OF has_absolute_integral_change_of_variables_1'[where g="\x. - x + 2 * \" and S="{..<\}" and g'="\x. - 1" and f="normal_density \ \" and b="integral {\<..} (normal_density \ \)",THEN iffD2],symmetric]) + fix x :: real + show "((\x. - x + 2 * \) has_real_derivative - 1) (at x within {..<\})" + by(rule derivative_eq_intros(35)[of _ "- 1" _ _ 0]) (auto simp add: Deriv.field_differentiable_minus) + next + show "inj_on (\x. - x + 2 * \) {..<\}" + by(auto simp: inj_on_def) + next + have 1: "(\x. - x + 2 * \) ` {..<\} = {\<..}" + by(auto simp: image_def intro!: bexI[where x="2 * \ - _"]) + have [simp]: "normal_density \ \ absolutely_integrable_on {\<..}" + by(auto simp: absolutely_integrable_measurable comp_def integrable_restrict_space integrable_completion intro!: integrable_mult_indicator[where 'b=real,simplified] measurable_restrict_space1 measurable_completion) + show "normal_density \ \ absolutely_integrable_on (\x. - x + 2 * \) ` {..<\} \ integral ((\x. - x + 2 * \) ` {..<\}) (normal_density \ \) = integral {\<..} (normal_density \ \)" + unfolding 1 by simp + qed auto + thus ?thesis by simp + qed + also have "... = ennreal (integral {..<\} (normal_density \ \))" + proof - + have "(\x. normal_density \ \ (- x + 2 * \)) = normal_density \ \" + by standard (auto simp: normal_density_def power2_commute ) + thus ?thesis by simp + qed + also have "... = ennreal (\x. normal_density \ \ x \lebesgue_on {..<\})" + by(rule ennreal_cong, rule lebesgue_integral_eq_integral[symmetric]) (auto simp: integrable_restrict_space integrable_completion intro!: integrable_mult_indicator[where 'b=real,simplified]) + also have "... = ennreal (\x. (if x \ {..<\} then normal_density \ \ x else 0) \lebesgue)" + by(rule ennreal_cong, rule Lebesgue_Measure.integral_restrict_UNIV[symmetric]) simp + also have "... = ennreal (\x. normal_density \ \ x * indicator {..<\} x \lebesgue)" + by (meson indicator_times_eq_if(2)[symmetric]) + also have "... = ennreal (\x. normal_density \ \ x * indicator {..<\} x \lborel)" + by(simp add: integral_completion) + also have "... = (\\<^sup>+ x. ennreal (normal_density \ \ x * indicator {..<\} x) \lborel)" + by(auto intro!: nn_integral_eq_integral[symmetric] integrable_real_mult_indicator) + also have "... = ?r" + using AE_lborel_singleton by(fastforce intro!: nn_integral_cong_AE simp: indicator_def) + finally show ?thesis . + qed + show ?thesis + by(simp add: 1 2) (metis (no_types, lifting) ennreal_divide_times mult_2 mult_2_right mult_divide_eq_ennreal one_add_one top_neq_numeral zero_neq_numeral) + qed + also have "... = ennreal (1 / 2)" + using prob_space.emeasure_space_1[OF prob_space_normal_density] + by(simp add: emeasure_density divide_ennreal_def) + finally show ?thesis . +qed + +corollary measure_qbs_l_dens_to_dist_hnormal_f: "measure (qbs_l (density_qbs lborel_qbs hnormal_f)) UNIV = 1 / 2" + by(simp add: measure_def nc_hnormal_f del: ennreal_half) + +lemma hnormal_f: + shows "hnormal_f \ qbs_borel \\<^sub>Q \\<^sub>Q" + and "\x. hnormal_f x \ 0" + and "qbs_l (density_qbs lborel_qbs hnormal_f) UNIV \ 0" + and "qbs_integrable lborel_qbs hnormal_f" + using nc_hnormal_f by(auto simp: qbs_integrable_iff_integrable integrable_iff_bounded qbs_l_density_qbs[of _ qbs_borel] hnormal_f_def emeasure_density simp del: ennreal_half) + +lemma "qbs_l (dens_to_dist local.hnormal_f) = density lborel (\x. ennreal (2 * (if x \ \ then 0 else normal_density \ \ x)))" + by(simp add: qbs_l_dens_to_dist[OF hnormal_f] measure_qbs_l_dens_to_dist_hnormal_f) (simp add: hnormal_f_def) + +end + + +subsubsection \ Erlang Distribution \ +context + fixes k :: nat and l :: real + assumes l_pos[arith]: "l > 0" +begin + +definition "erlang_f \ (\x. if x < 0 then 0 else x^k * exp (- l * x))" + +lemma nc_erlang_f: "qbs_l (density_qbs lborel_qbs erlang_f) UNIV = ennreal (fact k / l^(Suc k))" +proof - + have "qbs_l (density_qbs lborel_qbs erlang_f) UNIV = (\\<^sup>+ x. ennreal (if x < 0 then 0 else x ^ k * exp (- l * x)) \lborel)" + by(auto simp: qbs_l_density_qbs[of _ qbs_borel] erlang_f_def emeasure_density) + also have "... = ennreal (fact k / l^(Suc k)) * (\\<^sup>+ x. erlang_density k l x \lborel)" + by(auto simp: nn_integral_cmult[symmetric] ennreal_mult'[symmetric] erlang_density_def intro!: nn_integral_cong) + also have "... = ennreal (fact k / l^(Suc k))" + using prob_space.emeasure_space_1[OF prob_space_erlang_density] + by(simp add: emeasure_density) + finally show ?thesis . +qed + +corollary measure_qbs_l_dens_to_dist_erlang_f: "measure (qbs_l (density_qbs lborel_qbs erlang_f)) UNIV = fact k / l^(Suc k)" + by(simp add: measure_def nc_erlang_f) + +lemma erlang_f: + shows "erlang_f \ qbs_borel \\<^sub>Q \\<^sub>Q" + and "\x. erlang_f x \ 0" + and "qbs_l (density_qbs lborel_qbs erlang_f) UNIV \ 0" + and "qbs_integrable lborel_qbs erlang_f" + using nc_erlang_f by(auto simp: qbs_integrable_iff_integrable integrable_iff_bounded qbs_l_density_qbs[of _ qbs_borel] erlang_f_def emeasure_density) + +lemma "qbs_l (dens_to_dist erlang_f) = density lborel (erlang_density k l)" +proof - + have [simp]: "l * l ^ k * (if x < 0 then 0 else x ^ k * exp (- l * x)) / fact k = (if x < 0 then 0 else l ^ Suc k * x ^ k * exp (- l * x) / fact k)" for x + by auto + show ?thesis + by(simp add: qbs_l_dens_to_dist[OF erlang_f] measure_qbs_l_dens_to_dist_erlang_f erlang_density_def) (simp add: erlang_f_def) +qed + +end + +subsubsection \ Uniform Distribution on $(0,1) \times (0,1)$.\ + +definition "uniform_f \ indicat_real ({0<..<1::real}\{0<..<1::real})" + +lemma + shows uniform_f_qbs'[qbs]: "uniform_f \ qbs_borel \\<^sub>Q \\<^sub>Q" + and uniform_f_qbs[qbs]: "uniform_f \ \\<^sub>Q \\<^sub>Q \\<^sub>Q \\<^sub>Q \\<^sub>Q" +proof - + have "uniform_f \ \\<^sub>Q \\<^sub>Q \\<^sub>Q \\<^sub>Q \\<^sub>Q" + by(auto simp: uniform_f_def r_preserves_product[symmetric] intro!: rr.qbs_morphism_measurable_intro) + thus "uniform_f \ \\<^sub>Q \\<^sub>Q \\<^sub>Q \\<^sub>Q \\<^sub>Q" "uniform_f \ qbs_borel \\<^sub>Q \\<^sub>Q" + by(simp_all add: qbs_borel_prod) +qed + +lemma uniform_f_measurable[measurable]: "uniform_f \ borel_measurable borel" + by (metis borel_prod rr.standard_borel_axioms standard_borel.standard_borel_r_full_faithful uniform_f_qbs') + +lemma nc_uniform_f: "qbs_l (density_qbs lborel_qbs uniform_f) UNIV = 1" +proof - + have "qbs_l (density_qbs lborel_qbs uniform_f) UNIV = (\\<^sup>+ z. ennreal (uniform_f z) \lborel)" + by(auto simp: qbs_l_density_qbs[of _ qbs_borel] emeasure_density) + also have "... = (\\<^sup>+ z. indicator {0<..<1::real} (fst z) * indicator {0<..<1::real} (snd z) \(lborel \\<^sub>M lborel))" + by(auto simp: lborel_prod intro!: nn_integral_cong) (auto simp: indicator_def uniform_f_def) + also have "... = 1" + by(auto simp: lborel.nn_integral_fst[symmetric] nn_integral_cmult) + finally show ?thesis . +qed + +corollary measure_qbs_l_dens_to_dist_uniform_f: "measure (qbs_l (density_qbs lborel_qbs uniform_f)) UNIV = 1" + by(simp add: measure_def nc_uniform_f) + +lemma uniform_f: + shows "uniform_f \ qbs_borel \\<^sub>Q \\<^sub>Q" + and "\x. uniform_f x \ 0" + and "qbs_l (density_qbs lborel_qbs uniform_f) UNIV \ 0" + and "qbs_integrable lborel_qbs uniform_f" + using nc_uniform_f by(auto simp: qbs_integrable_iff_integrable integrable_iff_bounded qbs_l_density_qbs[of _ qbs_borel] emeasure_density) (auto simp: uniform_f_def) + +lemma qbs_l_dens_to_dist_uniform_f:"qbs_l (dens_to_dist uniform_f) = density lborel (\x. ennreal (uniform_f x))" + by(simp add: qbs_l_dens_to_dist[OF uniform_f,simplified measure_qbs_l_dens_to_dist_uniform_f]) + +lemma "dens_to_dist uniform_f = Uniform 0 1 \\<^sub>Q\<^sub>m\<^sub>e\<^sub>s Uniform 0 1" +proof - + note qbs_pair_measure_morphismP[qbs] Uniform_qbsP[qbs] + have [simp]:"sets (borel :: (real \ real) measure) = sets (borel \\<^sub>M borel)" + by(metis borel_prod) + show ?thesis + proof(safe intro!: inj_onD[OF qbs_l_inj[of "\\<^sub>Q \\<^sub>Q \\<^sub>Q"]] qbs_space_monadPM measure_eqI) +(* proof(auto intro!: inj_onD[OF qbs_l_inj[of "\\<^sub>Q \\<^sub>Q \\<^sub>Q"]] qbs_space_monadPM simp: qbs_l_dens_to_dist_uniform_f qbs_l_Uniform_pair, auto intro!: measure_eqI) + *) + fix A :: "(real \ real) set" + assume "A \ sets (qbs_l (dens_to_dist uniform_f))" + then have [measurable]: "A \ sets (borel \\<^sub>M borel)" + by(auto simp: qbs_l_dens_to_dist_uniform_f) + show "emeasure (qbs_l (dens_to_dist uniform_f)) A = emeasure (qbs_l (Uniform 0 1 \\<^sub>Q\<^sub>m\<^sub>e\<^sub>s Uniform 0 1)) A" (is "?lhs = ?rhs") + proof - + have "?lhs = (\\<^sup>+x\A. ennreal (uniform_f x) \(lborel \\<^sub>M lborel))" + by(simp add: emeasure_density lborel_prod qbs_l_dens_to_dist_uniform_f) + also have "... = (\\<^sup>+x. indicator A x * indicator {0<..<1} (fst x) * indicator {0<..<1} (snd x) \(lborel \\<^sub>M lborel))" + by(auto intro!: nn_integral_cong) (auto simp: indicator_def uniform_f_def) + also have "... = (\\<^sup>+ x\{0<..<1}. (\\<^sup>+y\{0<..<1}. indicator A (x, y) \lborel) \lborel)" + by(auto simp add: lborel.nn_integral_fst[symmetric] intro!: nn_integral_cong) (auto simp: indicator_def) + also have "... = (\\<^sup>+ x. (\\<^sup>+y. indicator A (x, y) \uniform_measure lborel {0<..<1}) \uniform_measure lborel {0<..<1})" + by(auto simp: nn_integral_uniform_measure divide_ennreal_def) + also have "... = ?rhs" + by(auto simp: UniformP_pair.M1.emeasure_pair_measure' qbs_l_Uniform_pair) + finally show ?thesis . + qed + next + show "dens_to_dist uniform_f \ qbs_space (monadP_qbs (\\<^sub>Q \\<^sub>Q \\<^sub>Q))" + by(simp add: dens_to_dist_prob[OF uniform_f] qbs_borel_prod) + qed (auto simp: qbs_l_dens_to_dist_uniform_f qbs_l_Uniform_pair, qbs, simp) +qed + +subsubsection \ If then else \ + +definition gt :: "(real \ real) \ real \ bool qbs_measure" where +"gt \ (\f r. do { + x \ dens_to_dist (normal_f 0 1); + if f x > r + then return_qbs \\<^sub>Q True + else return_qbs \\<^sub>Q False + })" + +declare normal_f(1)[of 1 0,simplified] + +lemma gt_qbs[qbs]: "gt \ qbs_space ((\\<^sub>Q \\<^sub>Q \\<^sub>Q) \\<^sub>Q \\<^sub>Q \\<^sub>Q monadP_qbs \\<^sub>Q)" +proof - + note [qbs] = dens_to_dist_prob[OF normal_f[of 1 0,simplified]] bind_qbs_morphismP return_qbs_morphismP + show ?thesis + by(simp add: gt_def) +qed + +lemma + assumes [qbs]: "f \ \\<^sub>Q \\<^sub>Q \\<^sub>Q" + shows "\

(b in gt f r. b = True) = \

(x in std_normal_distribution. f x > r)" (is "?P1 = ?P2") +proof - + note [qbs] = dens_to_dist_prob[OF normal_f[of 1 0,simplified]] bind_qbs_morphismP return_qbs_morphismP + have 1[simp]: "space (qbs_l (gt f r)) = UNIV" + by(simp add: space_qbs_l_in[OF qbs_space_monadPM,of _ "\\<^sub>Q"]) + have "?P1 = (\b. indicat_real {True} b \qbs_l (gt f r))" + by simp (metis (full_types) Collect_cong singleton_conv2) + also have "... = (\\<^sub>Q b. indicat_real {True} b \(gt f r))" + by(simp add: qbs_integral_def2_l) + also have "... = (\\<^sub>Q b. indicat_real {True} b \(dens_to_dist (normal_f 0 1) \ (\x. return_qbs \\<^sub>Q (f x > r))))" + proof - + have [simp]:"gt f r = dens_to_dist (normal_f 0 1) \ (\x. return_qbs \\<^sub>Q (f x > r))" + by(auto simp: gt_def intro!: bind_qbs_cong[of _ "\\<^sub>Q" _ _ "\\<^sub>Q"] qbs_space_monadPM qbs_morphism_monadPD) + show ?thesis by simp + qed + also have "... = (\\<^sub>Q x. (indicat_real {True} \ (\x. f x > r)) x \dens_to_dist (normal_f 0 1))" + by(rule qbs_integral_bind_return[of _ "\\<^sub>Q"]) (auto intro!: qbs_space_monadPM) + also have "... = (\\<^sub>Q x. indicat_real {x. f x > r} x \dens_to_dist (normal_f 0 1))" + by(auto intro!: qbs_integral_cong[of _ "\\<^sub>Q"] qbs_space_monadPM simp: indicator_def) + also have "... = (\x. indicat_real {x. f x > r} x \dens_to_dist (normal_f 0 1))" + by(simp add: qbs_integral_def2_l) + also have "... = ?P2" + by(simp add: qbs_l_densto_dist_normal_f[of 1 0]) + finally show ?thesis . +qed + +text \Examples from Staton~\cite[Sect.~2.2]{staton_2020}.\ +subsubsection \ Weekend \ +text \ Example from Staton~\cite[Sect.~2.2.1]{staton_2020}.\ +text \ This example is formalized in Coq by Affeldt et al.~\cite{10.1145/3573105.3575691}.\ +definition weekend :: "bool qbs_measure" where +"weekend \ do { + let x = qbs_bernoulli (2 / 7); + f = (\x. let r = if x then 3 else 10 in pmf (poisson_pmf r) 4) + in query x f + }" + +lemma weekend_qbs[qbs]:"weekend \ qbs_space (monadM_qbs \\<^sub>Q)" + by(simp add: weekend_def) + +lemma weekend_nc: + defines "N \ 2 / 7 * pmf (poisson_pmf 3) 4 + 5 / 7 * pmf (poisson_pmf 10) 4" + shows "qbs_l (density_qbs (bernoulli_pmf (2/7)) (\x. (pmf (poisson_pmf (if x then 3 else 10)) 4))) UNIV = N" +proof - + have [simp]:"fact 4 = 4 * fact 3" + by (simp add: fact_numeral) + show ?thesis + by(simp add: qbs_l_density_qbs[of _ "\\<^sub>Q"] emeasure_density ennreal_plus[symmetric] ennreal_mult'[symmetric] N_def del: ennreal_plus) +qed + +lemma qbs_l_weekend: + defines "N \ 2 / 7 * pmf (poisson_pmf 3) 4 + 5 / 7 * pmf (poisson_pmf 10) 4" + shows "qbs_l weekend = qbs_l (density_qbs (qbs_bernoulli (2 / 7)) (\x. ennreal (let r = if x then 3 else 10 in r ^ 4 * exp (- r) / (fact 4 * N))))" (is "?lhs = ?rhs") +proof - + have [simp]: "N > 0" + by(auto simp: N_def intro!: add_pos_pos) + have "?lhs = qbs_l (density_qbs (density_qbs (qbs_bernoulli (2 / 7)) (\x. ennreal (let r = if x then 3 else 10 in r ^ 4 * exp (- r) / fact 4))) (\x. 1 / ennreal N))" + using normalize_qbs[of "density_qbs (qbs_bernoulli (2/7)) (\x. (pmf (poisson_pmf (if x then 3 else 10)) 4))" "\\<^sub>Q",simplified] weekend_nc + by(simp add: weekend_def query_def N_def Let_def) + also have "... = ?rhs" + by(simp add: density_qbs_density_qbs_eq[of _ "\\<^sub>Q"] ennreal_mult'[symmetric] ennreal_1[symmetric] divide_ennreal del: ennreal_1) (metis (mono_tags, opaque_lifting) divide_divide_eq_left) + finally show ?thesis . +qed + +lemma + defines "N \ 2 / 7 * pmf (poisson_pmf 3) 4 + 5 / 7 * pmf (poisson_pmf 10) 4" + shows "\

(b in weekend. b = True) = 2 / 7 * (3^4 * exp (- 3)) / fact 4 * 1 / N" + by simp (simp add: qbs_l_weekend measure_def qbs_l_density_qbs[of _ "\\<^sub>Q"] emeasure_density emeasure_measure_pmf_finite ennreal_mult'[symmetric] N_def) + + +subsubsection \ Whattime \ +text \ Example from Staton~\cite[Sect.~2.2.3]{staton_2020}\ +text \ $f$ is given as a parameter.\ +definition whattime :: "(real \ real) \ real qbs_measure" where +"whattime \ (\f. do { + let T = Uniform 0 24 in + query T (\t. let r = f t in + exponential_density r (1 / 60)) + })" + +lemma whattime_qbs[qbs]: "whattime \ (\\<^sub>Q \\<^sub>Q \\<^sub>Q) \\<^sub>Q monadM_qbs \\<^sub>Q" + by(simp add: whattime_def) + +lemma qbs_l_whattime_sub: + assumes [qbs]: "f \ \\<^sub>Q \\<^sub>Q \\<^sub>Q" + shows "qbs_l (density_qbs (Uniform 0 24) (\x. exponential_density (f x) (1 / 60))) = density lborel (\x. indicator {0<..<24} x / 24 * exponential_density (f x) (1 / 60))" +proof - + have [measurable]:"f \ borel_measurable borel" + by (simp add: standard_borel.standard_borel_r_full_faithful standard_borel_ne.standard_borel) + have [measurable]: "(\x. (exponential_density (f x) (1 / 60))) \ borel_measurable borel" + by(simp add: exponential_density_def) + have 1[measurable]: "(\x. ennreal (exponential_density (f x) (1 / 60))) \ borel_measurable (uniform_measure lborel {0<..<24})" + by(simp add: measurable_cong_sets[OF sets_uniform_measure]) + show ?thesis + by(auto simp: qbs_l_density_qbs[of _ qbs_borel] emeasure_density emeasure_density[OF 1] nn_integral_uniform_measure nn_integral_divide[symmetric] ennreal_mult' divide_ennreal[symmetric] intro!: measure_eqI nn_integral_cong simp del: times_divide_eq_left) + (simp add: ennreal_indicator ennreal_times_divide mult.commute mult.left_commute) +qed + +lemma + assumes [qbs]: "f \ \\<^sub>Q \\<^sub>Q \\<^sub>Q" and [measurable]:"U \ sets borel" + and "\r. f r \ 0" + defines "N \ (\t\{0<..<24}. (f t * exp (- 1/ 60 * f t)) \lborel)" + defines "N' \ (\\<^sup>+t\{0<..<24}. (f t * exp (- 1/ 60 * f t)) \lborel)" + assumes "N' \ 0" and "N' \ \" + shows "\

(t in whattime f. t \ U) = (\t\{0<..<24}\U. (f t * exp (- 1/ 60 * f t)) \lborel) / N" +proof - + have 1: "space (whattime f) = UNIV" + by (rule space_qbs_l_in[of "whattime f" "\\<^sub>Q",simplified qbs_space_qbs_borel]) simp + have [measurable]: "f \ borel_measurable borel" + by (simp add: standard_borel.standard_borel_r_full_faithful standard_borel_ne.standard_borel) + have [measurable]: "(\x. exponential_density (f x) (1 / 60)) \ borel_measurable borel" + by(simp add: measurable_cong_sets[OF sets_uniform_measure] exponential_density_def) + have [measurable]: "(\x. ennreal (exponential_density (f x) (1 / 60))) \ borel_measurable (uniform_measure lborel {0<..<24})" + by(simp add: measurable_cong_sets[OF sets_uniform_measure]) + have qbs_ld: "qbs_l (density_qbs (Uniform 0 24) (\x. exponential_density (f x) (1 / 60))) UNIV = (\\<^sup>+x\{0<..<24}. ennreal (f x * exp (- 1/ 60 * f x) / 24) \lborel)" + by(auto simp: qbs_l_whattime_sub emeasure_density intro!: nn_integral_cong,auto simp: ennreal_indicator[symmetric] ennreal_mult''[symmetric] exponential_density_def) (simp add: mult.commute) + have int: "integrable lborel (\x. f x * exp (- 1/ 60 * f x) * indicat_real {0<..<24} x)" + using assms(3,7) by(simp add: N'_def integrable_iff_bounded ennreal_mult'' ennreal_indicator top.not_eq_extremum) + + have ge: "(\x\{0<..<24}. (f x * exp (- (f x / 60)) / 24)\lborel) > 0" + proof - + have "(\x\{0<..<24}. (f x * exp (- (f x / 60))) \lborel) > 0" (is "?l > 0") + proof - + have "ennreal ?l = (\\<^sup>+x. (indicator {0<..<24} x * (f x * exp (- (f x / 60)))) \lborel)" + unfolding set_lebesgue_integral_def by(simp,rule nn_integral_eq_integral[symmetric]) (insert int assms(3),auto simp: mult.commute) + also have "... = (\\<^sup>+x\{0<..<24}. ennreal (f x * exp (- 1/ 60 * f x)) \lborel)" + by (simp add: indicator_mult_ennreal mult.commute) + also have "... > 0" + using assms(6) not_gr_zero N'_def by blast + finally show ?thesis + using ennreal_less_zero_iff by blast + qed + thus ?thesis by simp + qed + have ge2: "(\x\{0<..<24}\ U. (exponential_density (f x) (1 / 60)) \lborel) \ 0" + using assms(3) by(auto intro!: integral_nonneg_AE simp: set_lebesgue_integral_def) + + have "(\\<^sup>+x\{0<..<24}. ennreal (f x * exp (- 1/ 60 * f x) / 24) \lborel) \ 0 \ (\\<^sup>+x\{0<..<24}. ennreal (f x * exp (- 1/ 60 * f x) / 24) \lborel) \ \" + proof - + have "(\\<^sup>+x\{0<..<24}. ennreal (f x * exp (- 1/ 60 * f x) / 24) \lborel) = (\\<^sup>+x. ennreal (f x * exp (- 1/ 60 * f x)) * indicator {0<..<24} x / 24 \lborel)" + by(rule nn_integral_cong, insert assms(3)) (auto simp: divide_ennreal[symmetric] ennreal_times_divide mult.commute) + also have "... = (\\<^sup>+x\{0<..<24}. ennreal (f x * exp (- 1/ 60 * f x)) \lborel) / 24" + by(simp add: nn_integral_divide) + finally show ?thesis + using assms(5,6,7) by (simp add: ennreal_divide_eq_top_iff) + qed + hence "normalize_qbs (density_qbs (Uniform 0 24) (\x. (exponential_density (f x) (1 / 60)))) = density_qbs (density_qbs (Uniform 0 24) (\x. ennreal (exponential_density (f x) (1 / 60)))) (\x. 1 / (\\<^sup>+x\{0<..<24}. ennreal (f x * exp (- 1/ 60 * f x) / 24) \lborel))" + using normalize_qbs[of "density_qbs (Uniform 0 24) (\x. exponential_density (f x) (1 / 60))" qbs_borel,simplified] by(simp add: qbs_ld) + also have "... = density_qbs (Uniform 0 24) (\x. ennreal (exponential_density (f x) (1 / 60)) / (\\<^sup>+x\{0<..<24}. ennreal (f x * exp (- (f x / 60)) / 24) \lborel))" + by(simp add: density_qbs_density_qbs_eq[of _ qbs_borel] ennreal_times_divide) + + finally have "\

(x in whattime f. x \ U) = measure (density (qbs_l (Uniform 0 24)) (\x. ennreal (exponential_density (f x) (1 / 60)) / (\\<^sup>+x\{0<..<24}. ennreal (f x * exp (- (f x / 60)) / 24) \lborel))) U" + unfolding 1 by (simp add: whattime_def query_def qbs_l_density_qbs[of _ qbs_borel]) + also have "... = enn2real ((\\<^sup>+x\{0<..<24}. (ennreal (exponential_density (f x) (1 / 60)) / (\\<^sup>+x\{0<..<24}. ennreal (f x * exp (- (f x / 60)) / 24)\lborel) * indicator U x) \lborel) / 24)" + by(simp add: measure_def emeasure_density nn_integral_uniform_measure) + also have "... = enn2real ((\\<^sup>+x\{0<..<24}. (ennreal (exponential_density (f x) (1 / 60)) * indicator U x) \lborel) / (\\<^sup>+x\{0<..<24}. ennreal (f x * exp (- (f x / 60)) / 24)\lborel) / 24)" + by(simp add: ennreal_divide_times ennreal_times_divide nn_integral_divide) + also have "... = enn2real (ennreal (\x\{0<..<24}\ U. (exponential_density (f x) (1 / 60)) \lborel) / ennreal (\x\{0<..<24}. (f x * exp (- (f x / 60)) / 24)\lborel) / ennreal 24)" + proof - + have 1:"(\\<^sup>+x\{0<..<24}. ennreal (f x * exp (- (f x / 60)) / 24)\lborel) = ennreal (\x\{0<..<24}. (f x * exp (- (f x / 60)) / 24)\lborel)" (is "?l = ?r") + proof - + have "?l = (\\<^sup>+x. ennreal (f x * exp (- (f x / 60)) / 24 * indicat_real {0<..<24} x) \lborel)" + by (simp add: nn_integral_set_ennreal) + also have "... = ennreal (\x. (f x * exp (- (f x / 60)) / 24 * indicat_real {0<..<24} x)\lborel)" + by(rule nn_integral_eq_integral) (use int assms(3) in auto) + also have "... = ?r" + by(auto simp: set_lebesgue_integral_def intro!: Bochner_Integration.integral_cong ennreal_cong) + finally show ?thesis . + qed + have 2:"(\\<^sup>+x\{0<..<24}. (ennreal (exponential_density (f x) (1 / 60)) * indicator U x) \lborel) = ennreal (\x\{0<..<24}\ U. (exponential_density (f x) (1 / 60)) \lborel)" (is "?l = ?r") + proof - + have "?l = (\\<^sup>+x. ennreal (f x * exp (- (f x / 60)) * indicat_real {0<..<24} x * indicator U x) \lborel)" + by (auto intro!: nn_integral_cong simp: exponential_density_def indicator_def) + also have "... = ennreal (\x. (f x * exp (- (f x / 60)) * indicat_real {0<..<24} x * indicator U x)\lborel)" + by(rule nn_integral_eq_integral) (use integrable_real_mult_indicator[OF _ int] assms(3) in auto) + also have "... = ?r" + by(auto simp: set_lebesgue_integral_def indicator_def exponential_density_def intro!: Bochner_Integration.integral_cong ennreal_cong) + finally show ?thesis . + qed + show ?thesis + by(simp add: 1 2) + qed + also have "... = enn2real (ennreal ((\x\{0<..<24}\ U. (exponential_density (f x) (1 / 60)) \lborel) / (\x\{0<..<24}. (f x * exp (- (f x / 60)) / 24)\lborel) / 24))" + by(simp only: divide_ennreal[OF ge2 ge] divide_ennreal[OF divide_nonneg_pos[OF ge2 ge]]) + also have "... = (\x\{0<..<24}\ U. (exponential_density (f x) (1 / 60)) \lborel) / (\x\{0<..<24}. (f x * exp (- (f x / 60)) / 24)\lborel) / 24" + by(rule enn2real_ennreal) (use ge ge2 in auto) + also have "... = (\x\{0<..<24}\U. (f x * exp (- 1/ 60 * f x)) \lborel) / N" + by(auto simp: N_def exponential_density_def) + finally show ?thesis . +qed + +subsubsection \ Distributions on Functions \ +definition a_times_x :: "(real \ real) qbs_measure" where +"a_times_x \ do { + a \ Uniform (-2) 2; + return_qbs (\\<^sub>Q \\<^sub>Q \\<^sub>Q) (\x. a * x) + }" + +lemma a_times_x_qbs[qbs]: "a_times_x \ monadM_qbs (\\<^sub>Q \\<^sub>Q \\<^sub>Q)" + by(simp add: a_times_x_def) + +lemma a_times_x_qbsP: "a_times_x \ monadP_qbs (\\<^sub>Q \\<^sub>Q \\<^sub>Q)" +proof - + note [qbs] = Uniform_qbsP[of "-2" 2,simplified] return_qbs_morphismP bind_qbs_morphismP + show ?thesis + by(simp add: a_times_x_def) +qed + +definition a_times_x' :: "(real \ real) qbs_measure" where +"a_times_x' \ do { + condition a_times_x (\f. f 1 \ 0) + }" + +lemma a_times_x'_qbs[qbs]: "a_times_x' \ monadM_qbs (\\<^sub>Q \\<^sub>Q \\<^sub>Q)" + by(simp add: a_times_x'_def) + +lemma prob_a_times_x: + assumes [measurable]: "Measurable.pred borel P" + shows "\

(f in a_times_x. P (f r)) = \

(a in Uniform (-2) 2. P (a * r))" (is "?lhs = ?rhs") +proof - + have [qbs]: "qbs_pred qbs_borel P" + using r_preserves_morphisms by fastforce + have "?lhs = measure a_times_x ({f. P (f r)} \ space a_times_x)" + by (simp add: Collect_conj_eq inf_sup_aci(1)) + also have "... = (\\<^sub>Q f. indicat_real {f. P (f r)} f \a_times_x)" + by(simp add: qbs_integral_def2_l) + also have "... = qbs_integral (Uniform (- 2) 2) (indicat_real {f. P (f r)} \ (*))" + unfolding a_times_x_def by(rule qbs_integral_bind_return[of _ qbs_borel]) auto + also have "... = (\\<^sub>Q a. indicat_real {a. P (a * r)} a \Uniform (- 2) 2)" + by(auto simp: comp_def indicator_def) + also have "... = ?rhs" + by (simp add: qbs_integral_def2_l) + finally show ?thesis . +qed + +lemma "\

(f in a_times_x'. f 1 \ 1) = 1 / 2" (is "?P = _") +proof - + have "?P = \

(f in a_times_x. f 1 \ 1 \ f 1 \ 0)" + by(simp add: query_Bayes[OF a_times_x_qbsP] a_times_x'_def) + also have "... = \

(f in a_times_x. f 1 \ 1) / \

(f in a_times_x. f 1 \ 0)" + by(auto simp add: cond_prob_def) (meson dual_order.trans linordered_nonzero_semiring_class.zero_le_one) + also have "... = 1 / 2" + proof - + have [simp]: "{-2<..<2::real} \ Collect ((\) 1) = {1..<2}" "{-2<..<2::real} \ Collect ((\) 0) = {0..<2}" + by auto + show ?thesis + by(auto simp: prob_a_times_x) + qed + finally show ?thesis . +qed + + +text \ Almost everywhere, integrable, and integrations are also interpreted as programs.\ +lemma "(\g f x. if (AE\<^sub>Q y in g x. f x y \ \) then (\\<^sup>+\<^sub>Q y. f x y \(g x)) else 0) + \ (\\<^sub>Q \\<^sub>Q monadM_qbs \\<^sub>Q) \\<^sub>Q (\\<^sub>Q \\<^sub>Q \\<^sub>Q \\<^sub>Q \\<^sub>Q\<^sub>\\<^sub>0) \\<^sub>Q \\<^sub>Q \\<^sub>Q \\<^sub>Q\<^sub>\\<^sub>0" + by simp + +lemma "(\g f x. if qbs_integrable (g x) (f x) then Some (\\<^sub>Q y. f x y \(g x)) else None) + \ (\\<^sub>Q \\<^sub>Q monadM_qbs \\<^sub>Q) \\<^sub>Q (\\<^sub>Q \\<^sub>Q \\<^sub>Q \\<^sub>Q \\<^sub>Q) \\<^sub>Q \\<^sub>Q \\<^sub>Q option_qbs \\<^sub>Q" + by simp + +end \ No newline at end of file diff --git a/thys/S_Finite_Measure_Monad/ROOT b/thys/S_Finite_Measure_Monad/ROOT new file mode 100644 --- /dev/null +++ b/thys/S_Finite_Measure_Monad/ROOT @@ -0,0 +1,15 @@ +chapter AFP + +session "S_Finite_Measure_Monad" = "HOL-Probability" + + options [timeout = 600] + sessions "Standard_Borel_Spaces" + theories + "Lemmas_S_Finite_Measure_Monad" + "Kernels" + "QuasiBorel" "QBS_Morphism" + "Measure_QuasiBorel_Adjunction" + "Monad_QuasiBorel" + "Montecarlo" "Query" + document_files + "root.tex" + "root.bib" diff --git a/thys/S_Finite_Measure_Monad/document/root.bib b/thys/S_Finite_Measure_Monad/document/root.bib new file mode 100644 --- /dev/null +++ b/thys/S_Finite_Measure_Monad/document/root.bib @@ -0,0 +1,81 @@ +@inproceedings{ + Heunen_2017, + author = {Heunen, Chris and Kammar, Ohad and Staton, Sam and Yang, Hongseok}, + title = {A Convenient Category for Higher-Order Probability Theory}, + year = {2017}, + isbn = {9781509030187}, + publisher = {IEEE Press}, + booktitle = {Proceedings of the 32nd Annual ACM/IEEE Symposium on Logic in Computer Science}, + articleno = {77}, + numpages = {12}, + location = {Reykjav\'{\i}k, Iceland}, + series = {LICS '17} +} + +@article{Sato_2019, + title={Formal verification of higher-order probabilistic programs: reasoning about approximation, convergence, Bayesian inference, and optimization}, + volume={3}, + ISSN={2475-1421}, + url={http://dx.doi.org/10.1145/3290351}, + DOI={10.1145/3290351}, + number={POPL}, + journal={Proceedings of the ACM on Programming Languages}, + publisher={Association for Computing Machinery (ACM)}, + author={Sato, Tetsuya and Aguirre, Alejandro and Barthe, Gilles and Gaboardi, Marco and Garg, Deepak and Hsu, Justin}, + year={2019}, + month={Jan}, + pages={1–30} +} + +@misc{Adrian_PL, + title = {Probabilistic Programming}, + author = {Sampson, Adrian}, + key = {Probabilistic programming}, + howpublished = {\url{http://adriansampson.net/doc/ppl.html}}, + note = {Accessed: January 25. 2023} +} + +@inproceedings{10.1145/3573105.3575691, + author = {Affeldt, Reynald and Cohen, Cyril and Saito, Ayumu}, + title = {Semantics of Probabilistic Programs Using S-Finite Kernels in {Coq}}, + year = {2023}, isbn = {9798400700262}, + publisher = {Association for Computing Machinery}, + address = {New York, NY, USA}, + doi = {10.1145/3573105.3575691}, + booktitle = {Proceedings of the 12th ACM SIGPLAN International Conference on Certified Programs and Proofs}, + pages = {3–16}, + numpages = {14}, + keywords = {probabilistic programming language, measure theory, integration theory, Coq}, + location = {Boston, MA, USA}, series = {CPP 2023} +} + +@inbook{staton_2020, + place={Cambridge}, + title={Probabilistic Programs as Measures}, + DOI={10.1017/9781108770750.003}, + booktitle={Foundations of Probabilistic Programming}, + publisher={Cambridge University Press}, + author={Staton, Sam}, + year={2020}, + pages={43–74} +} + +@InProceedings{staton_2017, +author="Staton, Sam", +editor="Yang, Hongseok", +title="Commutative Semantics for Probabilistic Programming", +booktitle="Programming Languages and Systems", +year="2017", +publisher="Springer Berlin Heidelberg", +address="Berlin, Heidelberg", +pages="855--879", +abstract="We show that a measure-based denotational semantics for probabilistic programming is commutative.", +isbn="978-3-662-54434-1" +} + +@misc{HongseokLecture2017, + title={Semantics of Higher-Order Probabilistic Programs with Continuous Distributions}, + author = {Hongseok Yang}, + howpublished = {\url{https://alfa.di.uminho.pt/~nevrenato/probprogschool_slides/Hongseok.pdf}}, + note = {Accessed: February 8. 2023} +} \ No newline at end of file diff --git a/thys/S_Finite_Measure_Monad/document/root.tex b/thys/S_Finite_Measure_Monad/document/root.tex new file mode 100644 --- /dev/null +++ b/thys/S_Finite_Measure_Monad/document/root.tex @@ -0,0 +1,75 @@ +\documentclass[11pt,a4paper]{article} +\usepackage[T1]{fontenc} +\usepackage{isabelle,isabellesym} + +% further packages required for unusual symbols (see also +% isabellesym.sty), use only when needed + +\usepackage{amssymb} + %for \, \, \, \, \, \, + %\, \, \, \, \, + %\, \, \ +\usepackage{amsmath} + +%\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} + + +\begin{document} + +\title{S-Finite Measure Monad on Quasi-Borel Spaces} +\author{Michikazu Hirata, Yasuhiko Minamide} +\maketitle +\begin{abstract} + The s-finite measure monad on quasi-Borel spaces provides + a suitable denotational model for higher-order probabilistic programs + with conditioning. + This entry is a formalization of the s-finite measure monad and related notions, + including s-finite measures, s-finite kernels, and a proof automation for quasi-Borel spaces which is an + extension of our previous entry \textit{quasi-Borel spaces}. + We also implement several examples of probabilistic programs in previous works and prove their property. + + This work is a part of the work by Hirata, Minamide, and Sato, + \textit{Semantic Foundations of Higher-Order Probabilistic Programs in Isabelle/HOL} + which will be presented at the 14th Conference on Interactive Theorem Proving (ITP2023). +\end{abstract} + +\tableofcontents + +% sane default for proof documents +\parindent 0pt\parskip 0.5ex + +% generated text of all theories +\input{session} + +% optional bibliography +\bibliographystyle{abbrv} +\bibliography{root} + +\end{document} + +%%% Local Variables: +%%% mode: latex +%%% TeX-master: t +%%% End: diff --git a/thys/S_Finite_Measure_Monad/qbs.ML b/thys/S_Finite_Measure_Monad/qbs.ML new file mode 100644 --- /dev/null +++ b/thys/S_Finite_Measure_Monad/qbs.ML @@ -0,0 +1,79 @@ +(* Title: qbs.ML + Author: Yasuhiko Minamide, Michikazu Hirata, Tokyo Institute of Technology + qbs prover +*) + +signature QBS = +sig + + val get : Context.generic -> thm list + val qbs_add: attribute + val qbs_del: attribute + + val qbs_tac: Proof.context -> thm list -> tactic + val simproc : Proof.context -> cterm -> thm option +end ; + +structure Qbs : QBS = +struct + +structure Data = Generic_Data +( + type T = thm list + val empty: T = [] + val merge = Thm.merge_thms +); + +val get = Data.get + +fun add thm = Data.map (Thm.add_thm thm) + +val qbs_add = Thm.declaration_attribute add; +val qbs_del = Thm.declaration_attribute (Data.map o Thm.del_thm); + +fun instantiate ctxt (Abs (n, T, t1 $ t2)) = + let val (T1, T2) = @{Type_fn \fun A B => \(A,B)\\} (type_of1([T] ,t1)) + val t1' = Abs (n, T, t1) + val t2' = Abs (n, T, t2) + in + Thm.instantiate' + (map (Option.map (Thm.ctyp_of ctxt)) [SOME T, SOME T1, SOME T2]) + (map (Option.map (Thm.cterm_of ctxt)) [SOME t1', NONE, NONE, NONE, SOME t2']) + @{thm qbs_morphism_app} + end +| instantiate _ (Abs (_, _, Abs _)) = @{thm curry_preserves_morphisms} +| instantiate ctxt (t1 $ t2) = + let val (T1, T2) = @{Type_fn \fun A B => \(A,B)\\} (type_of1 ([], t1)) in + Thm.instantiate' + (map (Option.map (Thm.ctyp_of ctxt)) [SOME T1, SOME T2]) + (map (Option.map (Thm.cterm_of ctxt)) [SOME t1, NONE, NONE, SOME t2]) + @{thm qbs_morphism_space} + end +| instantiate _ t = raise (TERM (("instantiate"), [t])) + + +fun qbs_tac ctxt facts = + let val instantiate_tac = + SUBGOAL (fn (t,i) => + (case HOLogic.dest_Trueprop t of + \<^Const_>\Set.member _ for f \<^Const_>\qbs_space _ for _\\ => + resolve_tac ctxt [instantiate ctxt f] i + | _ => raise (TERM ("not a qbs_space predicate", [t]))) + handle TERM _ => no_tac) 1 + val thms = facts @ get (Context.Proof ctxt) + val single_step_tac = + CHANGED (asm_full_simp_tac (put_simpset HOL_basic_ss ctxt addsimps ((map (Simplifier.norm_hhf ctxt) thms))) 1) + ORELSE resolve_tac ctxt thms 1 + ORELSE instantiate_tac + in + REPEAT single_step_tac + end + +fun simproc ctxt redex = + let + val t = HOLogic.mk_Trueprop (Thm.term_of redex); + fun tac {context = ctxt, prems = _ } = + SOLVE (qbs_tac ctxt (Simplifier.prems_of ctxt)); + in \<^try>\Goal.prove ctxt [] [] t tac RS @{thm Eq_TrueI}\ end; + +end \ No newline at end of file diff --git a/thys/Standard_Borel_Spaces/Abstract_Metrizable_Topology.thy b/thys/Standard_Borel_Spaces/Abstract_Metrizable_Topology.thy new file mode 100644 --- /dev/null +++ b/thys/Standard_Borel_Spaces/Abstract_Metrizable_Topology.thy @@ -0,0 +1,2402 @@ +(* Title: Abstract_Metrizable_Topology.thy + Author: Michikazu Hirata, Tokyo Institute of Technology +*) + +section \Abstract Metrizable Topology\ +theory Abstract_Metrizable_Topology + imports "Set_Based_Metric_Product" +begin + +subsection \ Metrizable Spaces \ +locale metrizable = + fixes S :: "'a topology" + assumes ex_metric:"\\. metric_set (topspace S) \ \ S = metric_set.mtopology (topspace S) \" +begin + +lemma metric: + obtains \ where "metric_set (topspace S) \" "metric_set.mtopology (topspace S) \ = S" + using ex_metric by metis + +lemma bounded_metric: + obtains \ where "metric_set (topspace S) \" "metric_set.mtopology (topspace S) \ = S" + "\x y. \ x y < 1" +proof - + obtain \ where "metric_set (topspace S) \" "metric_set.mtopology (topspace S) \ = S" + by(rule metric) + then have "\\. metric_set (topspace S) \ \ metric_set.mtopology (topspace S) \ = S \ (\x y. \ x y < 1)" + using metric_set.bounded_dist_dist(1) metric_set.bounded_dist_dist(2) metric_set.bounded_dist_generate_same_topology + by(fastforce intro!: exI[where x="bounded_dist \"]) + thus ?thesis + using that by auto +qed + +lemma second_countable_if_separable: + assumes "separable S" + shows "second_countable S" +proof - + obtain d where hd:"metric_set (topspace S) d" "S = metric_set.mtopology (topspace S) d" + using ex_metric by(auto simp: metrizable_def) + then interpret m: separable_metric_set "topspace S" d + using metric_set.separable_iff_topological_separable[of "topspace S" d] assms + by auto + show "second_countable S" + using m.second_countable \S = m.mtopology\ by simp +qed + +corollary second_countable_iff_separable: "second_countable S \ separable S" + using second_countable_if_separable separable_if_second_countable + by auto + +lemma Hausdorff: "Hausdorff_space S" + using ex_metric metric_set.mtopology_Hausdorff by fastforce + +lemma subtopology: "metrizable (subtopology S X)" +proof - + obtain \ where h:"metric_set (topspace S) \" "metric_set.mtopology (topspace S) \ = S" + by(rule metric) + then show ?thesis + using metric_set.submetric_subtopology[OF h(1),of "topspace S \ X"] + by(auto intro!: exI[where x="submetric (topspace S \ X) \"] simp: metrizable_def subtopology_restrict metric_set.mtopology_topspace metric_set.submetric_metric_set) +qed + +lemma g_delta_of_closedin: + assumes "closedin S X" + shows "g_delta_of S X" + using assms ex_metric metric_set.g_delta_of_closed by fastforce + +lemma closedin_singleton: + assumes "s \ topspace S" + shows "closedin S {s}" +proof - + obtain \ where h:"metric_set (topspace S) \" "metric_set.mtopology (topspace S) \ = S" + by(rule metric) + then show ?thesis + using metric_set.closedin_closed_ball[OF h(1),of s 0] + by(simp add: metric_set.closed_ball_0[OF h(1) assms]) +qed + +lemma dense_of_infinite: + assumes "infinite (topspace S)" "dense_of S U" + shows "infinite U" +proof - + obtain \ where h:"metric_set (topspace S) \" "metric_set.mtopology (topspace S) \ = S" + by(rule metric) + show ?thesis + by(rule metric_set.dense_set_infinite[OF h(1),simplified h(2),OF assms]) +qed + +lemma homeomorphic_metrizable: + assumes "S homeomorphic_space S'" + shows "metrizable S'" +proof(rule metric) + fix d + assume h: "metric_set (topspace S) d" "metric_set.mtopology (topspace S) d = S" + then interpret m: metric_set "topspace S" d by simp + from assms obtain f g where fg: "homeomorphic_maps S S' f g" + by(auto simp: homeomorphic_space_def) + hence g: "g \ topspace S' \ topspace S" "inj_on g (topspace S')" "g ` (topspace S') = topspace S" + by (auto simp: homeomorphic_eq_injective_perfect_map homeomorphic_maps_map perfect_map_def) + have f: "f \ topspace S \ topspace S'" "inj_on f (topspace S)" "f ` (topspace S) = topspace S'" + using fg by (auto simp: homeomorphic_eq_injective_perfect_map homeomorphic_maps_map perfect_map_def) + interpret m': metric_set "topspace S'" "m.ed g (topspace S')" + by(simp add: m.embed_dist_dist[OF g(1,2)]) + show "metrizable S'" + unfolding metrizable_def + proof(safe intro!: exI[where x="m.ed g (topspace S')"]) + have [simp]:"m'.ed f (topspace S) = d" + by standard+ (insert f g fg m.dist_notin m.dist_notin',auto simp: m'.embed_dist_on_def m.embed_dist_on_def homeomorphic_maps_def) + have [simp]:"((`) f ` {m.open_ball a \ |a \. a \ topspace S \ 0 < \}) = {m'.open_ball a \ |a \. a \ topspace S' \ 0 < \}" + proof safe + fix a and e :: real + assume "a \ topspace S" "0 < e" + then show "\b e'. f ` m.open_ball a e = m'.open_ball b e' \ b \ topspace S' \ 0 < e'" + using f g fg by(auto simp: m.open_ball_def m'.open_ball_def m.embed_dist_on_def homeomorphic_maps_def intro!: exI[where x="f a"] exI[where x=e]) (metis (no_types, lifting) image_eqI mem_Collect_eq) + next + fix a and e :: real + assume "a \ topspace S'" "0 < e" + then show "m'.open_ball a e \ (`) f ` {m.open_ball a \ |a \. a \ topspace S \ 0 < \}" + using m'.embed_dist_open_ball[OF f(1,2),simplified,of "g a" e] f g fg m'.open_ballD'(1) + by(auto simp: m.embed_dist_on_def homeomorphic_maps_def image_def intro!: exI[where x="g a"] exI[where x=e] exI[where x="m.open_ball (g a) e"]) blast + qed + show "S' = m'.mtopology" + using topology_generated_by_homeomorphic_spaces[OF homeomorphic_maps_imp_map[OF fg] h(2)[symmetric,simplified m.mtopology_def2]] + by(simp add: m'.mtopology_def2) + qed(rule m'.metric_set_axioms) +qed + +end + +lemma euclidean_metrizable: "metrizable (euclidean :: ('a ::metric_space) topology)" + by (metis euclidean_mtopology metric_class_metric_set metrizable.intro topspace_euclidean) + +sublocale metric_set \ metrizable "mtopology" + using metric_set_axioms metrizable_def mtopology_topspace by fastforce + +lemma metrizable_prod: + assumes "metrizable X" "metrizable Y" + shows "metrizable (prod_topology X Y)" +proof + obtain dx dy where "metric_set (topspace X) dx" "metric_set.mtopology (topspace X) dx = X" "metric_set (topspace Y) dy" "metric_set.mtopology (topspace Y) dy = Y" + using metrizable.metric[OF assms(2)] metrizable.metric[OF assms(1)] by metis + then show "\\. metric_set (topspace (prod_topology X Y)) \ \ prod_topology X Y = metric_set.mtopology (topspace (prod_topology X Y)) \" + by(auto intro!: exI[where x="binary_distance (topspace X) dx (topspace Y) dy"] simp: binary_metric_set binary_distance_mtopology) +qed + +lemma metrizable_product: + assumes "countable I" "\i. i \ I \ metrizable (X i)" + shows "metrizable (product_topology X I)" +proof - + obtain d where hd:"\i. i \ I \ metric_set (topspace (X i)) (d i)" "\i. i \ I \ X i = metric_set.mtopology (topspace (X i)) (d i)" + using assms(2) by(auto simp: metrizable_def) metis + from product_metricI'[of "1/2" _ _ d,OF _ _ assms(1) this(1)] + interpret pd: product_metric "1 / 2" I "to_nat_on I" "from_nat_into I" "\i. topspace (X i)" "\i x y. if i \ I then bounded_dist (d i) x y else 0" 1 + by simp + show ?thesis + using hd(2) by(auto simp: metrizable_def pd.product_dist_distance pd.product_dist_mtopology[symmetric] hd(1) metric_set.bounded_dist_generate_same_topology intro!: exI[where x=pd.product_dist] product_topology_cong) +qed + +subsection \ Complete Metrizable Spaces \ +locale complete_metrizable = + fixes S :: "'a topology" + assumes ex_cmetric: "\\. complete_metric_set (topspace S) \ \ S = metric_set.mtopology (topspace S) \" +begin + +lemma cmetric: + obtains \ where "complete_metric_set (topspace S) \" "metric_set.mtopology (topspace S) \ = S" + using ex_cmetric by metis + +lemma bounded_cmetric: + obtains \ where "complete_metric_set (topspace S) \" "metric_set.mtopology (topspace S) \ = S" + "\x y. \ x y < 1" +proof - + obtain \ where "complete_metric_set (topspace S) \" "metric_set.mtopology (topspace S) \ = S" + by(rule cmetric) + then have "\\. complete_metric_set (topspace S) \ \ metric_set.mtopology (topspace S) \ = S \ (\x y. \ x y < 1)" + using metric_set.bounded_dist_dist(1) metric_set.bounded_dist_dist(2) metric_set.bounded_dist_generate_same_topology complete_metric_set.bounded_dist_complete complete_metric_set_def + by(fastforce intro!: exI[where x="bounded_dist \"]) + thus ?thesis + using that by auto +qed + +lemma metrizable: "metrizable S" + using complete_metric_set_def complete_metrizable_axioms complete_metrizable_def metrizable_def by blast + +sublocale metrizable + by(rule metrizable) + +lemma closedin_complete_metrizable: + assumes "closedin S A" + shows "complete_metrizable (subtopology S A)" + by (metis assms closedin_def complete_metric_set.submetric_complete_iff complete_metric_set_def complete_metrizable_axioms complete_metrizable_def metric_set.submetric_subtopology topspace_subtopology_subset) + +lemma homeomorphic_complete_metrizable: + assumes "S homeomorphic_space S'" + shows "complete_metrizable S'" +proof(rule cmetric) + fix d + assume h: "complete_metric_set (topspace S) d" "metric_set.mtopology (topspace S) d = S" + then interpret m: complete_metric_set "topspace S" d by simp + from assms obtain f g where fg: "homeomorphic_maps S S' f g" + by(auto simp: homeomorphic_space_def) + hence g: "g \ topspace S' \ topspace S" "inj_on g (topspace S')" "g ` (topspace S') = topspace S" + by (auto simp: homeomorphic_eq_injective_perfect_map homeomorphic_maps_map perfect_map_def) + have f: "f \ topspace S \ topspace S'" "inj_on f (topspace S)" "f ` (topspace S) = topspace S'" + using fg by (auto simp: homeomorphic_eq_injective_perfect_map homeomorphic_maps_map perfect_map_def) + interpret m': complete_metric_set "topspace S'" "m.ed g (topspace S')" + by(auto intro!: m.embed_dist_complete[OF g(1,2)] simp: h(2) g(3)) + show "complete_metrizable S'" + unfolding complete_metrizable_def + proof(safe intro!: exI[where x="m.ed g (topspace S')"]) + have [simp]:"m'.ed f (topspace S) = d" + by standard+ (insert f g fg m.dist_notin m.dist_notin',auto simp: m'.embed_dist_on_def m.embed_dist_on_def homeomorphic_maps_def) + have [simp]:"((`) f ` {m.open_ball a \ |a \. a \ topspace S \ 0 < \}) = {m'.open_ball a \ |a \. a \ topspace S' \ 0 < \}" + proof safe + fix a and e :: real + assume "a \ topspace S" "0 < e" + then show "\b e'. f ` m.open_ball a e = m'.open_ball b e' \ b \ topspace S' \ 0 < e'" + using f g fg by(auto simp: m.open_ball_def m'.open_ball_def m.embed_dist_on_def homeomorphic_maps_def intro!: exI[where x="f a"] exI[where x=e]) (metis (no_types, lifting) image_eqI mem_Collect_eq) + next + fix a and e :: real + assume "a \ topspace S'" "0 < e" + then show "m'.open_ball a e \ (`) f ` {m.open_ball a \ |a \. a \ topspace S \ 0 < \}" + using m'.embed_dist_open_ball[OF f(1,2),simplified,of "g a" e] f g fg m'.open_ballD'(1) + by(auto simp: m.embed_dist_on_def homeomorphic_maps_def image_def intro!: exI[where x="g a"] exI[where x=e] exI[where x="m.open_ball (g a) e"]) blast + qed + show "S' = m'.mtopology" + using topology_generated_by_homeomorphic_spaces[OF homeomorphic_maps_imp_map[OF fg] h(2)[symmetric,simplified m.mtopology_def2]] + by(simp add: m'.mtopology_def2) + qed(rule m'.complete_metric_set_axioms) +qed + +end + +lemma euclidean_complete_metrizable[simp]: + "complete_metrizable (euclidean :: ('a ::complete_space) topology)" + by (metis complete_metrizable.intro complete_space_complete_metric_set euclidean_mtopology topspace_euclidean) + +sublocale complete_metric_set \ complete_metrizable "mtopology" + using complete_metric_set_axioms complete_metrizable_def mtopology_topspace by fastforce + +lemma complete_metrizable_prod: + assumes "complete_metrizable X" "complete_metrizable Y" + shows "complete_metrizable (prod_topology X Y)" +proof + obtain dx dy where "complete_metric_set (topspace X) dx" "metric_set.mtopology (topspace X) dx = X" "complete_metric_set (topspace Y) dy" "metric_set.mtopology (topspace Y) dy = Y" + using complete_metrizable.cmetric[OF assms(2)] complete_metrizable.cmetric[OF assms(1)] by metis + then show "\\. complete_metric_set (topspace (prod_topology X Y)) \ \ prod_topology X Y = metric_set.mtopology (topspace (prod_topology X Y)) \" + using binary_distance_complete by(auto intro!: exI[where x="binary_distance (topspace X) dx (topspace Y) dy"] simp: binary_distance_mtopology complete_metric_set_def) +qed + +lemma complete_metrizable_product: + assumes "countable I" "\i. i \ I \ complete_metrizable (X i)" + shows "complete_metrizable (product_topology X I)" +proof - + obtain d where hd:"\i. i \ I \ complete_metric_set (topspace (X i)) (d i)" "\i. i \ I \ X i = metric_set.mtopology (topspace (X i)) (d i)" + using assms(2) by(auto simp: complete_metrizable_def) metis + from product_complete_metricI'[of "1/2" _ _ d,OF _ _ assms(1) this(1)] + interpret pd: product_complete_metric "1 / 2" I "to_nat_on I" "from_nat_into I" "\i. topspace (X i)" "\i x y. if i \ I then bounded_dist (d i) x y else 0" 1 + by simp + show ?thesis + using hd(2) by(auto simp: complete_metrizable_def pd.product_dist_distance pd.product_dist_mtopology[symmetric] hd(1) complete_metric_set.axioms(1) metric_set.bounded_dist_generate_same_topology pd.complete_metric_set_axioms intro!: exI[where x=pd.product_dist] product_topology_cong) +qed + +lemma(in complete_metrizable) g_delta_of_complete_metrizable: + assumes "g_delta_of S B" + shows "complete_metrizable (subtopology S B)" +proof - + obtain d where d:"complete_metric_set (topspace S) d" "metric_set.mtopology (topspace S) d = S" + by(rule cmetric) + interpret m: complete_metric_set "topspace S" d by fact + obtain U :: "nat \ _" where U: "\n. openin S (U n)" "B = \ (range U)" + using g_delta_ofD'[OF assms] by metis + consider "topspace (subtopology S B) = {}" | "topspace (subtopology S B) = topspace S" | "topspace (subtopology S B) \ {}" "topspace (subtopology S B) \ topspace S" + by (metis assms g_delta_of_subset order_le_less topspace_subtopology_subset) + then show ?thesis + proof cases + case 1 + with empty_metric_polish show ?thesis + by(auto intro!: exI[where x="\x y. 0"] simp: complete_metrizable_def polish_metric_set_def separable_metric_set_def Int_absorb1 assms empty_metric_mtopology g_delta_of_subset subtopology_eq_discrete_topology_eq) + next + case 2 + then have "B = topspace S" + using g_delta_of_subset[OF assms] by auto + thus ?thesis + by(simp add: complete_metrizable_axioms) + next + case 3 + then have h: "B \ {}" "\n. U n \ {}" by(auto simp: U(2)) + define f where "f \ (\x. (x, (\i. 1 / m.dist_set (topspace S - (U i)) x)))" + have f_inj:"inj f" + by(auto simp: inj_def f_def) + have f_inv: "\x. x \ f ` B \ f (fst x) = x" "\x. fst (f x) = x" + by(auto simp: f_def) + have "continuous_map (subtopology S B) (prod_topology S (powertop_real UNIV)) f" + unfolding continuous_map_pairwise continuous_map_componentwise_UNIV + proof safe + have [simp]:"fst \ f = id" + by(auto simp: f_def) + show "continuous_map (subtopology S B) S (fst \ f)" + by simp + next + fix k + show "continuous_map (subtopology S B) euclideanreal (\x. (snd \ f) x k)" + proof(cases "U k = topspace S") + case True + then show ?thesis + by(simp add: f_def) + next + case False + then have [simp]:"(\x. snd (f x) k) = (\x. 1 / m.dist_set (topspace S - (U k)) x)" + by(simp add: f_def) + have "continuous_map (subtopology S B) euclideanreal ..." + proof(rule continuous_map_real_divide) + show "continuous_map (subtopology S B) euclideanreal (m.dist_set (topspace S - U k))" + using m.dist_set_continuous[simplified d(2),of "topspace S - U k"] + by (simp add: continuous_map_from_subtopology) + next + fix x + assume "x \ topspace (subtopology S B)" + then have h':"x \ topspace S" "x \ B" by auto + have 1: "closedin S (topspace S - U k)" "topspace S - U k \ {}" + using U(1) d(2) m.mtopology_openin_iff2 False by auto + with h'(2) m.dist_set_closed_ge0[simplified d(2),OF 1 h'(1)] + show "m.dist_set (topspace S - U k) x \ 0" + by(auto simp: U(2)) + qed simp + thus ?thesis by simp + qed + qed + hence f_cont: "continuous_map (subtopology S B) (subtopology (prod_topology S (powertop_real UNIV)) (f ` B)) f" + using g_delta_of_subset[OF assms] by(auto simp: continuous_map_in_subtopology) + have f_invcont: "continuous_map (subtopology (prod_topology S (powertop_real UNIV)) (f ` B)) (subtopology S B) fst" + by(auto intro!: continuous_map_into_subtopology simp: continuous_map_subtopology_fst f_def) + + have homeo: "subtopology (prod_topology S (powertop_real UNIV)) (f ` B) homeomorphic_space subtopology S B" + using f_inv(2) by(auto simp: homeomorphic_space_def homeomorphic_maps_def f_cont f_invcont intro!: exI[where x=f] exI[where x=fst]) + + show ?thesis + proof(safe intro!: complete_metrizable.homeomorphic_complete_metrizable[OF _ homeo] complete_metrizable.closedin_complete_metrizable[of _ "f ` B"] complete_metrizable_prod complete_metrizable_product complete_metrizable_axioms) + interpret r: polish_metric_set UNIV "dist :: real \ _" by simp + interpret pd: product_complete_metric "1/2" UNIV id id "\n. UNIV" "\n. bounded_dist (dist :: real \ _)" 1 + by(auto intro!: product_complete_metric_natI' simp: r.complete_metric_set_axioms) + interpret bpd: complete_metric_set "topspace S \ (\\<^sub>E x\(UNIV::nat set). (UNIV::real set))" "binary_distance (topspace S) d (\\<^sub>E x\(UNIV::nat set). (UNIV::real set)) pd.product_dist" + using pd.complete_metric_set_axioms by(auto intro!: binary_distance_complete d(1)) + + have "closedin bpd.mtopology (f ` B)" + proof - + { fix a b and zn :: "nat \ _" + assume h':"zn \ UNIV \ f ` B" "m.converge_to_inS (\n. fst (zn n)) a" "\i. r.converge_to_inS (\n. snd (zn n) i) (b i)" + then obtain xn where xn: "\n. xn n \ B" "\n. zn n = f (xn n)" + by (metis PiE UNIV_I f_inv(2) imageE) + + have h: "m.converge_to_inS xn a" "\i. r.converge_to_inS (\n. 1 / m.dist_set (topspace S - U i) (xn n)) (b i)" + proof - + { + fix i + have "(\n. snd (zn n) i) = (\n. 1 / m.dist_set (topspace S - U i) (xn n))" + by standard (simp add: xn(2) f_def) + } + thus "m.converge_to_inS xn a" "\i. r.converge_to_inS (\n. 1 / m.dist_set (topspace S - U i) (xn n)) (b i)" + using h' by(auto simp: xn(2) f_def) + qed + have conv1: "r.converge_to_inS (\n. m.dist_set (topspace S - U i) (xn n)) (m.dist_set (topspace S - U i) a)" for i + using m.dist_set_continuous h(1) by(simp add: metric_set_continuous_map_eq'[OF m.metric_set_axioms r.metric_set_axioms,simplified euclidean_mtopology]) + have dista_n0:"m.dist_set (topspace S - U i) a \ 0" if "U i \ topspace S" for i + proof(rule LIMSEQ_inverse_not0[OF _ conv1[simplified converge_to_def_set[symmetric]] h(2)[simplified converge_to_def_set[symmetric]]]) + fix n + have "0 < m.dist_set (topspace S - U i) (xn n)" + using xn(1) U(1)[of i] by(auto intro!: m.dist_set_closed_ge0 simp: U(2) d(2) in_mono openin_subset) (use openin_subset that in blast)+ + thus "m.dist_set (topspace S - U i) (xn n) \ 0" by simp + qed + from tendsto_inverse_real[OF conv1[simplified converge_to_def_set[symmetric]] this] + have conv1':"r.converge_to_inS (\n. 1 / m.dist_set (topspace S - U i) (xn n)) (1 / m.dist_set (topspace S - U i) a)" if "U i \ topspace S" for i + by(simp add: that converge_to_def_set) + have "a \ U n" for n + proof(cases "U n = topspace S") + case True + then show ?thesis + using h'(2) by(auto simp: m.converge_to_inS_def) + next + case False + with m.dist_set_nzeroD(2)[OF dista_n0[OF this]] dista_n0 + show ?thesis + by fastforce + qed + hence "a \ B" + by(auto simp: U(2)) + moreover have "b n = 1 / m.dist_set (topspace S - (U n)) a" for n + proof(cases "U n = topspace S") + case True + then show ?thesis + using h(2)[of n,simplified converge_to_def_set[symmetric]] + by (simp add: LIMSEQ_const_iff) + next + case False + from conv1'[OF this] h(2)[of n] + show ?thesis + by(simp add: r.converge_to_inS_unique) + qed + ultimately have "(a, b) \ f ` B" + by(auto simp: f_def image_def) + } + thus ?thesis + unfolding bpd.mtopology_closedin_iff binary_distance_converge_to_inS_iff'[OF m.metric_set_axioms pd.metric_set_axioms] + using pd.converge_to_iff[simplified r.bounded_dist_converge_to_inS_iff[symmetric]] g_delta_of_subset[OF assms] f_def + by auto + qed + thus "closedin (prod_topology S (powertop_real UNIV)) (f ` B)" + by(simp only: binary_distance_mtopology[OF m.metric_set_axioms pd.metric_set_axioms] pd.product_dist_mtopology[symmetric] r.bounded_dist_generate_same_topology[symmetric] euclidean_mtopology d(2)) + qed simp_all + qed +qed + +corollary(in complete_metrizable) openin_complete_metrizable: + assumes "openin S u" + shows "complete_metrizable (subtopology S u)" + using assms by(auto intro!: g_delta_of_complete_metrizable ) + +subsection \ Polish Spaces \ +locale polish_topology = complete_metrizable + + assumes S_separable:"separable S" +begin + +lemma S_second_countable: "second_countable S" + by(rule second_countable_if_separable[OF S_separable]) + +lemma closedin_polish: + assumes "closedin S A" + shows "polish_topology (subtopology S A)" + by (simp add: S_second_countable assms closedin_complete_metrizable polish_topology_axioms_def polish_topology_def second_countable_subtopology separable_if_second_countable) + +lemma g_delta_of_polish: + assumes "g_delta_of S A" + shows "polish_topology (subtopology S A)" + by(simp add: polish_topology_def g_delta_of_complete_metrizable[OF assms] polish_topology_axioms_def S_second_countable second_countable_subtopology separable_if_second_countable) + +corollary openin_polish: + assumes "openin S A" + shows "polish_topology (subtopology S A)" + by (simp add: assms g_delta_of_polish) + +lemma homeomorphic_polish_topology: + assumes "S homeomorphic_space S'" + shows "polish_topology S'" + by(simp add: polish_topology_def homeomorphic_complete_metrizable[OF assms] homeomorphic_separable[OF S_separable assms] polish_topology_axioms_def) + +end + +lemma polish_topology_def2: + "polish_topology S \ (\\. polish_metric_set (topspace S) \ \ S = metric_set.mtopology (topspace S) \)" + by (metis complete_metric_set.axioms(1) complete_metrizable_def metric_set.separable_iff_topological_separable polish_metric_set.axioms(1) polish_metric_set.axioms(2) polish_metric_set.intro polish_topology_axioms_def polish_topology_def) + +lemma(in polish_topology) polish_metric: + obtains d where "polish_metric_set (topspace S) d" + and "S = metric_set.mtopology (topspace S) d" + using polish_topology_axioms by(auto simp: polish_topology_def2) + +lemma(in polish_topology) bounded_polish_metric: + obtains d where "polish_metric_set (topspace S) d" + and "S = metric_set.mtopology (topspace S) d" + and "\x y. d x y < 1" +proof - + obtain d where d:"polish_metric_set (topspace S) d" "S = metric_set.mtopology (topspace S) d" + by(rule polish_metric) + interpret d: polish_metric_set "topspace S" d by fact + have "\d'. polish_metric_set (topspace S) d' \ S = metric_set.mtopology (topspace S) d' \ (\x y. d' x y < 1)" + using d by(auto intro!: exI[where x="bounded_dist d"] polish_metric_set.bounded_dist_polish simp:d.bounded_dist_generate_same_topology d.bounded_dist_dist) + with that show ?thesis + by auto +qed + +sublocale polish_metric_set \ polish_topology mtopology + using mtopology_topspace by(auto simp: polish_topology_def2 polish_metric_set_axioms intro!: exI[where x=dist]) + +lemma polish_topology_euclidean[simp]: "polish_topology (euclidean :: ('a :: polish_space) topology)" + using polish_class_polish_set + by(auto simp: polish_topology_def2 intro!: exI[where x=dist]) (use open_openin open_openin_set topology_eq in blast) + +lemma polish_topology_countable[simp]: + "polish_topology (euclidean :: 'a :: {countable,discrete_topology} topology)" +proof - + interpret polish_metric_set "UNIV :: 'a set" "discrete_dist UNIV" + by(simp add: discrete_dist_polish_iff) + show ?thesis + unfolding polish_topology_def2 + by(auto intro!: exI[where x="discrete_dist UNIV"] simp: topology_eq polish_metric_set_axioms discrete_dist_topology[of "UNIV :: 'a set"] discrete_topology_class.open_discrete) +qed + +lemma polish_topology_prod: + assumes "polish_topology S" and "polish_topology S'" + shows "polish_topology (prod_topology S S')" +proof - + obtain \ \' where hr: + "polish_metric_set (topspace S) \" "S = metric_set.mtopology (topspace S) \" + "polish_metric_set (topspace S') \'" "S' = metric_set.mtopology (topspace S') \'" + using assms by(auto simp: polish_topology_def2) + interpret m1:polish_metric_set "topspace S" \ by fact + interpret m2:polish_metric_set "topspace S'" \' by fact + interpret m: polish_metric_set "topspace S \ topspace S'" "binary_distance (topspace S) \ (topspace S') \'" + by(auto intro!: binary_distance_polish simp: m1.polish_metric_set_axioms m2.polish_metric_set_axioms) + show ?thesis + unfolding polish_topology_def2 + using binary_distance_mtopology[OF m1.metric_set_axioms m2.metric_set_axioms,simplified space_pair_measure[symmetric]] hr(2,4) + by(auto intro!: exI[where x="binary_distance (topspace S) \ (topspace S') \'"] m.polish_metric_set_axioms) +qed + +lemma polish_topology_product: + assumes "countable I" and "\i. i \ I \ polish_topology (S i)" + shows "polish_topology (product_topology S I)" +proof - + obtain \ where hr: + "\i. i \ I \ polish_metric_set (topspace (S i)) (\ i)" "\i. i \ I \ S i = metric_set.mtopology (topspace (S i)) (\ i)" + using assms(2) by(auto simp: polish_topology_def2) metis + define \' where "\' \ (\i x y. if i \ I then bounded_dist (\ i) x y else 0)" + interpret pd: product_polish_metric "1/2" I "to_nat_on I" "from_nat_into I" "\i. topspace (S i)" \' 1 + using assms hr by(auto intro!: product_polish_metricI' simp: \'_def) + have "product_topology S I = product_topology (\i. metric_set.mtopology (topspace (S i)) (\ i)) I" + by(auto intro!: product_topology_cong hr(2)) + also have "... = product_topology (\i. metric_set.mtopology (topspace (S i)) (\' i)) I" + by(auto intro!: product_topology_cong simp: \'_def) + (use hr(1) metric_set.bounded_dist_generate_same_topology polish_metric_set.axioms(2) separable_metric_set_def in blast) + also have "... = pd.mtopology" + by(rule pd.product_dist_mtopology) + finally have "product_topology S I = pd.mtopology" . + show ?thesis + unfolding polish_topology_def2 + by(auto intro!: exI[where x="pd.product_dist"] simp: pd.polish_metric_set_axioms) fact +qed + +lemma polish_topology_closedin_polish: + assumes "polish_topology S" and "closedin S U" + shows "polish_topology (subtopology S U)" +proof - + obtain \ where *: + "polish_metric_set (topspace S) \" "S = metric_set.mtopology (topspace S) \" + using assms by(auto simp: polish_topology_def2) + interpret m:polish_metric_set "topspace S" \ by fact + interpret m':polish_metric_set U "submetric U \" + using m.submetric_complete_iff[OF closedin_subset[OF assms(2)]] m.submetric_separable[OF closedin_subset[OF assms(2)]] assms(2) * + by(simp add: polish_metric_set_def) + have "subtopology S U = m'.mtopology" + using m.submetric_subtopology[OF closedin_subset[OF assms(2)]] * by simp + thus ?thesis + using m'.mtopology_topspace + by(auto simp: polish_topology_def2 m'.polish_metric_set_axioms intro!: exI[where x="submetric U \"]) +qed + +subsection \ Compact Metrizable Spaces \ +locale compact_metrizable = metrizable + + assumes compact: "compact_space S" +begin + +sublocale polish_topology +proof - + obtain d where "compact_metric_set (topspace S) d" "metric_set.mtopology (topspace S) d = S" + using metric compact by(auto simp: compact_metric_set_def compact_metric_set_axioms.intro) + then interpret m: polish_metric_set "topspace S" d + by(simp add: compact_metric_set.polish) + show "polish_topology S" + using \m.mtopology = S\ m.polish_topology_axioms by simp +qed + +lemma compact_metric: + obtains d where "compact_metric_set (topspace S) d" "metric_set.mtopology (topspace S) d = S" + by (metis metric compact compact_metric_set.intro compact_metric_set_axioms.intro) + +end + +subsection \Continuous Embddings\ +abbreviation Hilbert_cube_as_topology :: "(nat \ real) topology" where +"Hilbert_cube_as_topology \ (product_topology (\n. top_of_set {0..1}) UNIV)" + +lemma topspace_Hilbert_cube: "topspace Hilbert_cube_as_topology = (\\<^sub>E x\UNIV. {0..1})" + by simp + +lemma Hilbert_cube_Polish_topology: "polish_topology Hilbert_cube_as_topology" + by(auto intro!: polish_topology_closedin_polish polish_topology_product) + +abbreviation Cantor_space_as_topology :: "(nat \ real) topology" where +"Cantor_space_as_topology \ (product_topology (\n. top_of_set {0,1}) UNIV)" + +lemma topspace_Cantor_space: + "topspace Cantor_space_as_topology = (\\<^sub>E x\UNIV. {0,1})" + by simp + +lemma Cantor_space_Polish_topology: + "polish_topology Cantor_space_as_topology" + by(auto intro!: polish_topology_closedin_polish polish_topology_product) + +text \ Proposition 2.2.3 in \cite{borelsets} \ +lemma continuous_map_metrizable_extension: + assumes "A \ topspace W" "metrizable W" "complete_metrizable Z" "continuous_map (subtopology W A) Z f" + shows "\h gd. g_delta_of W gd \ (\a\A. f a = h a) \ A \ gd \ continuous_map (subtopology W gd) Z h" +proof - + obtain dz where hdz: "complete_metric_set (topspace Z) dz" "metric_set.mtopology (topspace Z) dz = Z" "\x y. dz x y < 1" + using complete_metrizable.bounded_cmetric[OF assms(3)] by auto + interpret dz: complete_metric_set "topspace Z" dz by fact + obtain dw where hdw: "metric_set (topspace W) dw" "metric_set.mtopology (topspace W) dw = W" + using metrizable.metric[OF assms(2)] by auto + interpret dw: metric_set "topspace W" dw by fact + interpret subd: metric_set A "submetric A dw" + using assms by(auto intro!: dw.submetric_metric_set) + have "subd.mtopology = subtopology W A" + using assms(1) dw.submetric_subtopology hdw(2) by auto + let ?oscf = "dz.osc_on A W f" + define gd where "gd \ {x\W closure_of A. ?oscf x = 0}" + have g_delta: "g_delta_of W gd" + proof - + have *:"{x\W closure_of A. ?oscf x < t} = \ {V \ (W closure_of A)| V. openin W V \ dz.diam (f ` (A \ V)) < t}" for t + by(auto simp: dz.osc_on_less_iff) + have 1:"gd = \ {{x\W closure_of A. ?oscf x < 1 / real n}|n. n \ {0<..}}" + proof - + have "x \ gd" if h:"\n. n \ {0<..} \ x \ {x\W closure_of A. ?oscf x < 1 / real n}" for x + proof - + have "?oscf x < \" if he:"\>0" for \ + proof - + obtain n where "1 / real (Suc n) < \" + by (meson enn2real_le_iff enn2real_positive_iff ennreal_less_top ennreal_less_zero_iff he linorder_not_le nat_approx_posE order_le_less_trans) + thus ?thesis + using h[of "Suc n"] by auto + qed + hence "?oscf x = 0" + using not_gr_zero by blast + thus ?thesis + using that by(auto simp: gd_def) + qed + thus ?thesis + by (auto simp: gd_def) + qed + also have "... = \ {\ {V \ (W closure_of A)| V. openin W V \ dz.diam (f ` (A \ V)) < 1 / real n}|n. n \ {0<..}}" + using * by auto + also have "... = W closure_of A \ \ {\ {V. openin W V \ dz.diam (f ` (A \ V)) < 1 / real n}|n. n \ {0<..}}" + by blast + also have "g_delta_of W ..." + proof - + have "{\ {V. openin W V \ dz.diam (f ` (A \ V)) < ennreal (1 / real n)} | n. 0 < n} = (\n. \ {V. openin W V \ dz.diam (f ` (A \ V)) < ennreal (1 / real n)}) ` {0<..}" by auto + also have "countable ..." by auto + finally show ?thesis + by(auto intro!: dw.g_delta_of_closed[simplified hdw(2),of "W closure_of A"] g_delta_of_inter[OF _ g_delta_ofI[of "{\ {V. openin W V \ dz.diam (f ` (A \ V)) < ennreal (1 / real n)} | n. n \ {0<..}}" _ "\ {\ {V. openin W V \ dz.diam (f ` (A \ V)) < 1 / real n}|n. 0 < n}"]] ) + qed + finally show ?thesis . + qed + have oscf0: "?oscf a = 0" if "a \ A" for a + using assms that by(auto intro!: osc_on_inA_0[OF dw.metric_set_axioms dz.metric_set_axioms,simplified \dz.mtopology = Z\ \dw.mtopology = W\] simp: le_iff_inf) + hence A_subst_of_gd: "A \ gd" + using closure_of_subset[OF assms(1)] by(auto simp add: gd_def) + define h where "h x \ let xn = (SOME an. an \ UNIV \ A \ dw.converge_to_inS an x) in dz.the_limit_of (\n. f (xn n))" for x + have h_extends:"f a = h a" if "a \ A" for a + proof - + obtain an where han: "an \ UNIV \ A" "dw.converge_to_inS an a" + using dw.closure_of_mtopology_an[of a A] A_subst_of_gd \a \ A\ gd_def hdw(2) by auto + show ?thesis + unfolding h_def Let_def + proof(rule someI2[of _ an "\t. f a = dz.the_limit_of (\n. f (t n))"]) + fix bn + assume h:"bn \ UNIV \ A \ dw.converge_to_inS bn a" + hence "subd.converge_to_inS bn a" + using assms(1) dw.convergent_insubmetric that by fastforce + hence "dz.converge_to_inS (\n. f (bn n)) (f a)" + using metric_set_continuous_map_eq'[OF subd.metric_set_axioms dz.metric_set_axioms,of f,simplified \subd.mtopology = subtopology W A\ \dz.mtopology = Z\ assms(4)] + by auto + thus "f a = dz.the_limit_of (\n. f (bn n))" + by(simp add: dz.the_limit_of_eq) + qed(use han in auto) + qed + have "gd \ topspace W" + by(simp add: gd_def in_closure_of) + then interpret subd_on_gd: metric_set gd "submetric gd dw" + by(auto intro!: dw.submetric_metric_set) + have "subtopology W gd = subd_on_gd.mtopology" + using \gd \ topspace W\ dw.submetric_subtopology hdw(2) by auto + have Cauchyf:"dz.Cauchy_inS (\n. f (an n))" if "subd.Cauchy_inS an" "dw.converge_to_inS an a" "?oscf a = 0" for an a + proof - + have "{dz.diam (f ` (A \ U)) |U. a \ U \ openin W U} = (\U. dz.diam (f ` (A \ U))) ` {U. a \ U \ openin W U}" + by auto + hence "(\i\{U. a \ U \ openin W U}. dz.diam (f ` (A \ i))) = \" + using that(3) by(auto simp: dz.osc_on_def bot_ennreal) + from this[simplified INF_eq_bot_iff] + have "\\. \ > 0 \ \u\{U. a \ U \ openin W U}. dz.diam (f ` (A \ u)) < \" + by(simp add: bot_ennreal) + hence he:"\\. \ > 0 \ \u\{U. a \ U \ openin W U}. dz.diam (f ` (A \ u)) < ennreal \" + by auto + show ?thesis + unfolding dz.Cauchy_inS_def + proof safe + show "\x. f (an x) \ topspace Z" + using assms(1,4) subd.Cauchy_inS_dest1[OF that(1)] by(auto simp: continuous_map_def) + next + fix \ + assume "(0 :: real) < \" + from he[OF this] obtain U where hu:"a \ U" "openin W U" "dz.diam (f ` (A \ U)) < ennreal \" + by auto + then obtain e where he:"e > 0" "a \ dw.open_ball a e" "dw.open_ball a e \ U" + by (metis \dw.converge_to_inS an a\ dw.metric_set_axioms dw.mtopology_openin_iff dw.open_ball_ina hdw(2) metric_set.converge_to_inS_def2') + then obtain N where "\n. n \ N \ an n \ dw.open_ball a e" + using \dw.converge_to_inS an a\ dw.converge_to_inS_def2' by blast + hence hn: "\n. n \ N \ an n \ A \ U" + using he(3) that(1) by(auto simp: subd.Cauchy_inS_def) + show "\N. \n\N. \m\N. dz (f (an n)) (f (an m)) < \" + proof(safe intro!: exI[where x=N]) + fix n m + assume "N \ n" "N \ m" + then have "an n \ A \ U" "an m \ A \ U" + using hn by auto + hence "f (an n) \ f ` (A \ U)" "f (an m) \ f ` (A \ U)" + by auto + then have "ennreal (dz (f (an n)) (f (an m))) \ dz.diam (f ` (A \ U))" + using assms(4) subd.mtopology_topspace by(auto intro!: dz.diam_is_sup simp:\subd.mtopology = subtopology W A\ continuous_map_def) + also have "... < ennreal \" by fact + finally show "dz (f (an n)) (f (an m)) < \" + using dz.dist_geq0 by (simp add: ennreal_less_iff) + qed + qed + qed + have "continuous_map (subtopology W gd) Z h" + proof - + have h_image:"h \ gd \ topspace Z" + proof + fix x + assume "x \ gd" + then obtain xn where hxn: "xn \ UNIV \ A" "dw.converge_to_inS xn x" + using dw.closure_of_mtopology_an[of x A] by(auto simp: gd_def hdw(2)) + show "h x \ topspace Z" + unfolding h_def Let_def + proof(rule someI2[of _ xn "\t. dz.the_limit_of (\n. f (t n)) \ topspace Z"]) + fix an + assume "an \ subd.sequence \ dw.converge_to_inS an x" + then have h:"an \ subd.sequence" "dw.converge_to_inS an x" by auto + then have "dz.Cauchy_inS (\n. f (an n))" + using \x \ gd\ by(auto intro!: Cauchyf[OF dw.Cauchy_insub_Cauchy_inverse[OF assms(1) h(1) dw.Cauchy_if_convergent_inS] h(2)] simp: gd_def dw.convergent_inS_def) + thus "dz.the_limit_of (\n. f (an n)) \ topspace Z" + by(simp add: dz.convergence dz.the_limit_of_inS) + qed(use hxn in auto) + qed + show ?thesis + unfolding metric_set_continuous_map_eq[OF subd_on_gd.metric_set_axioms dz.metric_set_axioms,simplified \subtopology W gd = subd_on_gd.mtopology\[symmetric] \dz.mtopology = Z\] + proof safe + fix x and \ :: real + assume "x \ gd" "0 < \" + then have "?oscf x < \ / 3" + by(auto simp: gd_def) + then obtain u where hu: "openin W u" "x \ u" "dz.diam (f ` (A \ u)) < \ / 3" + by(auto simp: dz.osc_on_def Inf_less_iff) + hence "openin subd_on_gd.mtopology (u \ gd)" + by(auto simp : \subtopology W gd = subd_on_gd.mtopology\[symmetric] openin_subtopology) + then obtain \ where hd: "\ > 0" "subd_on_gd.open_ball x \ \ u \ gd" "x \ subd_on_gd.open_ball x \" + by (metis Int_iff \x \ gd\ hu(2) subd_on_gd.mtopology_openin_iff subd_on_gd.open_ball_ina) + show "\\>0. \y\gd. submetric gd dw x y < \ \ dz (h x) (h y) < \" + proof(safe intro!: exI[where x=\] \\ > 0\) + fix y + assume h':"y \ gd" "submetric gd dw x y < \" + then have "y \ subd_on_gd.open_ball x \" + by(simp add: \x \ gd\ subd_on_gd.open_ball_def) + then obtain \y where hdy: "\y > 0" "subd_on_gd.open_ball y \y \ subd_on_gd.open_ball x \" "y \ subd_on_gd.open_ball y \y" + using h'(1) subd_on_gd.mtopology_open_ball_in' subd_on_gd.open_ball_ina by blast + obtain xn' yn' where hxyn':"xn' \ UNIV \ A" "dw.converge_to_inS xn' x" "yn' \ UNIV \ A" "dw.converge_to_inS yn' y" + using dw.closure_of_mtopology_an[of _ A] \y \ gd\ \x \ gd\ by(simp add: gd_def hdw(2)) metis + show "dz (h x) (h y) < \" + proof - + { fix xn yn + assume hxyn:"xn \ subd.sequence" "dw.converge_to_inS xn x" + "yn \ subd.sequence" "dw.converge_to_inS yn y" + then have Cauchyxyn: "dz.Cauchy_inS (\n. f (xn n))" "dz.Cauchy_inS (\n. f (yn n))" + using Cauchyf[OF dw.Cauchy_insub_Cauchy_inverse[OF assms(1) hxyn(1) dw.Cauchy_if_convergent_inS] hxyn(2)] Cauchyf[OF dw.Cauchy_insub_Cauchy_inverse[OF assms(1) hxyn(3) dw.Cauchy_if_convergent_inS] hxyn(4)] \x \ gd\ \y \ gd\ + by(auto simp: gd_def dw.convergent_inS_def) + have convxyn:"subd_on_gd.converge_to_inS xn x" "subd_on_gd.converge_to_inS yn y" + using hxyn \x \ gd\ \y \ gd\ \A \ gd\ by(auto intro!: dw.convergent_insubmetric \gd \ topspace W\) + then obtain Nx Ny where hnxy: "\n. n \ Nx \ xn n \ subd_on_gd.open_ball x \" "\n. n \ Ny \ yn n \ subd_on_gd.open_ball y \y" + using hd(1) hdy(1) subd_on_gd.converge_to_inS_def2' by blast + have "0 < \ / 3" using \0 < \\ by simp + obtain Nfx Nfy where hnfxy: "\n. n \ Nfx \ dz (f (xn n)) (dz.the_limit_of (\n. f (xn n))) < \ / 3" "\n. n \ Nfy \ dz (f (yn n)) (dz.the_limit_of (\n. f (yn n))) < \ / 3" + using dz.the_limit_if_converge[OF dz.convergence[OF Cauchyxyn(1)]] dz.the_limit_if_converge[OF dz.convergence[OF Cauchyxyn(2)]] + by(auto simp: dz.converge_to_inS_def2) (meson \0 < \ / 3\ less_divide_eq_numeral1(1)) + define N where "N \ Max {Nx,Ny,Nfx,Nfy}" + have N:"N \ Nx" "N \ Ny" "N \ Nfx" "N \ Nfy" + by(simp_all add: N_def) + have "dz (dz.the_limit_of (\n. f (xn n))) (dz.the_limit_of (\n. f (yn n))) < \" + (is "?lhs < _") + proof - + have "?lhs \ dz (dz.the_limit_of (\n. f (xn n))) (f (xn N)) + dz (f (xn N)) (dz.the_limit_of (\n. f (yn n)))" + using dz.dist_tr[OF dz.the_limit_of_inS[OF dz.convergence[OF Cauchyxyn(1)]] _ dz.the_limit_of_inS[OF dz.convergence[OF Cauchyxyn(2)]],of \f (xn N)\] dz.Cauchy_inS_dest1[OF Cauchyxyn(1)] + by simp + also have "... \ dz (dz.the_limit_of (\n. f (xn n))) (f (xn N)) + dz (f (xn N)) (f (yn N)) + dz (f (yn N)) (dz.the_limit_of (\n. f (yn n)))" + using dz.dist_tr[OF _ _ dz.the_limit_of_inS[OF dz.convergence[OF Cauchyxyn(2)]],of "f (xn N)" "f (yn N)"] dz.Cauchy_inS_dest1[OF Cauchyxyn(1)] dz.Cauchy_inS_dest1[OF Cauchyxyn(2)] + by simp + also have "... < \ / 3 + dz (f (xn N)) (f (yn N)) + \ / 3" + using hnfxy[of N] N by(simp add: dz.dist_sym[of "dz.the_limit_of (\n. f (xn n))"]) + also have "... < \" + proof - + have "xn N \ A \ u" "yn N \ A \ u" + using hdy(2) hd(2) hnxy[of N] N hxyn(1,3) by auto + hence "ennreal (dz (f (xn N)) (f (yn N))) \ dz.diam (f ` (A \ u))" + by(auto intro!: dz.diam_is_sup dz.Cauchy_inS_dest1[OF Cauchyxyn(1)] dz.Cauchy_inS_dest1[OF Cauchyxyn(2)]) + also have "... < ennreal (\ / 3)" by fact + finally have "dz (f (xn N)) (f (yn N)) < \ / 3" + using dz.dist_geq0 ennreal_less_iff by blast + thus ?thesis by simp + qed + finally show ?thesis . + qed + } + note h = this + show ?thesis + apply(simp only: h_def[of x] Let_def) + apply(rule someI2[of "\k. k \ subd.sequence \ dw.converge_to_inS k x" xn',OF conjI[OF hxyn'(1,2)]]) + apply(simp only: h_def[of y] Let_def) + apply(rule someI2[of "\k. k \ subd.sequence \ dw.converge_to_inS k y" yn',OF conjI[OF hxyn'(3,4)]]) + using h by auto + qed + qed + qed(use h_image in auto) + qed + + with h_extends g_delta A_subst_of_gd + show ?thesis by auto +qed + +lemma Lavrentiev_theorem: + assumes "complete_metrizable X" "complete_metrizable Y" "A \ topspace X" "B \ topspace Y" "homeomorphic_map (subtopology X A) (subtopology Y B) f" + shows "\h gda gdb. g_delta_of X gda \ g_delta_of Y gdb \ A \ gda \ B \ gdb \ (\x\A. f x = h x) \ homeomorphic_map (subtopology X gda) (subtopology Y gdb) h" +proof - + interpret cmx: complete_metrizable X by fact + interpret cmy: complete_metrizable Y by fact + interpret mxy: metrizable "prod_topology X Y" + by(auto intro!: metrizable_prod cmx.metrizable cmy.metrizable) + obtain g where "homeomorphic_maps (subtopology X A) (subtopology Y B) f g" + using assms(5) homeomorphic_map_maps by blast + then have hfg: "continuous_map (subtopology X A) (subtopology Y B) f" "continuous_map (subtopology Y B) (subtopology X A) g" + "\x. x \ A \ g (f x) = x" "\y. y \ B \ f (g y) = y" + using assms(3,4) by(auto simp: homeomorphic_maps_def) + obtain f' g' gda gdb where h: + "g_delta_of X gda" "\a. a \ A \ f a = f' a" "A \ gda" "continuous_map (subtopology X gda) Y f'" + "g_delta_of Y gdb" "\b. b \ B \ g b = g' b" "B \ gdb" "continuous_map (subtopology Y gdb) X g'" + using continuous_map_metrizable_extension[OF assms(3) cmx.metrizable assms(2) continuous_map_into_fulltopology[OF hfg(1)]] + continuous_map_metrizable_extension[OF assms(4) cmy.metrizable assms(1) continuous_map_into_fulltopology[OF hfg(2)]] + by auto + define H where "H \ SIGMA x:gda. {f' x}" + have Heq:"H = {(x,y). x \ gda \ y \ topspace Y \ y = f' x}" + using g_delta_of_subset[OF h(1)] h(4) by(auto simp: continuous_map_def H_def) + define K where Keq:"K = {(x,y). x \ topspace X \ y \ gdb \ x = g' y}" + define A' where "A' \ fst ` (H \ K)" + define B' where "B' \ snd ` (H \ K)" + have A'eq: "A' = {x \ gda. (x, f' x) \ K}" + using h(4) by(auto simp: A'_def Keq Heq image_def continuous_map_def) (metis (mono_tags, lifting) IntI case_prod_conv fst_conv mem_Collect_eq) + have B'eq: "B' = {y \ gdb. (g' y, y) \ H}" + using h(8) by(auto simp: B'_def Keq Heq image_def continuous_map_def) (metis (mono_tags, lifting) IntI case_prod_conv snd_conv mem_Collect_eq) + have A'_gd: "g_delta_of X A'" + proof - + have K_gd:"g_delta_of (prod_topology X Y) K" + proof - + have "closedin (subtopology (prod_topology X Y) (topspace X \ gdb)) K" + proof - + have "K = ((\y. (g' y, y)) ` topspace (subtopology Y gdb))" + using h(8) g_delta_of_subset[OF h(5)] by(auto simp add: Keq continuous_map_def) + thus ?thesis + using cmx.Hausdorff continuous_map_imp_closed_graph'[OF h(8)] + by(auto simp: prod_topology_subtopology(2)) + qed + then obtain T where hT:"closedin (prod_topology X Y) T" "K = T \ (topspace X \ gdb)" + using closedin_subtopology by metis + thus ?thesis + by(auto intro!: g_delta_of_inter g_delta_of_prod simp: h(5) mxy.g_delta_of_closedin) + qed + have "A' = ((\x. (x,f' x)) -` K \ topspace (subtopology X gda))" + by(auto simp add: A'eq Keq) + also have "g_delta_of X ..." + by(rule g_delta_of_subtopology_inverse[OF g_delta_of_continuous_map[OF _ K_gd] h(1)]) (auto intro!: continuous_map_pairedI h(4)) + finally show ?thesis . + qed + have A_subst_A': "A \ A'" + proof + fix a + assume 0:"a \ A" + then have "f' a = f a" "f' a \ B" + using h(2)[OF 0,symmetric] hfg(1) assms(3) by(auto simp: continuous_map_def) + thus "a \ A'" + using h(6)[OF \f' a \ B\,symmetric] hfg(3)[OF 0] 0 assms(3) h(3) h(7) + by(auto simp: A'eq Keq) + qed + have B'_gd: "g_delta_of Y B'" + proof - + have H_gd:"g_delta_of (prod_topology X Y) H" + proof - + have "closedin (subtopology (prod_topology X Y) (gda \ topspace Y)) H" + proof - + have "H = ((\y. (y, f' y)) ` topspace (subtopology X gda))" + using h(4) g_delta_of_subset[OF h(1)] by(auto simp add: Heq continuous_map_def) + thus ?thesis + using cmy.Hausdorff continuous_map_imp_closed_graph[OF h(4)] + by(auto simp: prod_topology_subtopology(1)) + qed + then obtain T where hT:"closedin (prod_topology X Y) T" "H = T \ (gda \ topspace Y)" + using closedin_subtopology by metis + thus ?thesis + by(auto intro!: g_delta_of_inter g_delta_of_prod simp: h(1) mxy.g_delta_of_closedin) + qed + have "B' = ((\x. (g' x,x)) -` H \ topspace (subtopology Y gdb))" + by(auto simp add: B'eq Heq) + also have "g_delta_of Y ..." + by(rule g_delta_of_subtopology_inverse[OF g_delta_of_continuous_map[OF _ H_gd] h(5)]) (auto intro!: continuous_map_pairedI h(8)) + finally show ?thesis . + qed + have B_subst_B': "B \ B'" + proof + fix b + assume 0:"b \ B" + then have "g' b = g b" "g' b \ A" + using h(6)[OF 0,symmetric] hfg(2) assms(4) by(auto simp: continuous_map_def) + thus "b \ B'" + using h(2)[OF \g' b \ A\,symmetric] hfg(4)[OF 0] 0 assms(4) h(3) h(7) + by(auto simp: B'eq Heq) + qed + have "homeomorphic_map (subtopology X A') (subtopology Y B') f'" + proof(rule homeomorphic_maps_imp_map[where g=g']) + show "homeomorphic_maps (subtopology X A') (subtopology Y B') + f' g'" + unfolding homeomorphic_maps_def + proof safe + show "continuous_map (subtopology X A') (subtopology Y B') f'" + using g_delta_of_subset[OF h(5)] + by(auto intro!: continuous_map_into_subtopology continuous_map_from_subtopology_mono[OF h(4)] simp: A'eq B'eq Heq Keq) + next + show "continuous_map (subtopology Y B') (subtopology X A') g'" + using g_delta_of_subset[OF h(1)] + by(auto intro!: continuous_map_into_subtopology continuous_map_from_subtopology_mono[OF h(8)] simp: A'eq B'eq Heq Keq) + qed(auto simp: A'eq B'eq Keq Heq) + qed + + with A'_gd B'_gd A_subst_A' B_subst_B' h(2) + show ?thesis by auto +qed + +corollary(in complete_metrizable) complete_metrizable_subtopology_is_g_delta: + assumes "A \ topspace S" "complete_metrizable (subtopology S A)" + shows "g_delta_of S A" +proof - + obtain h gda gdb where h: + "g_delta_of S gda" "g_delta_of (subtopology S A) gdb" "A \ gda" "A \ gdb" "\x\A. x = h x" "homeomorphic_map (subtopology (subtopology S A) gdb) (subtopology S gda) h" + using Lavrentiev_theorem[OF assms(2) complete_metrizable_axioms _ assms(1),of A id] assms(1) + by simp (metis subtopology_topspace topspace_subtopology_subset) + have "gdb = A" + using g_delta_of_subset[OF h(2)] h(4) assms(1) by auto + hence "homeomorphic_map (subtopology S A) (subtopology S gda) h" + using h(6) by (simp add: subtopology_subtopology) + hence "homeomorphic_map (subtopology S A) (subtopology S gda) id" + by(rule homeomorphic_map_eq) (use assms(1) h(5) in auto) + hence "subtopology S A = subtopology S gda" by simp + hence "A = gda" + by (metis assms(1) g_delta_of_subset h(1) topspace_subtopology_subset) + thus ?thesis + by(simp add: h(1)) +qed + +corollary(in complete_metrizable) subtopology_complete_metrizable_iff: + assumes "A \ topspace S" + shows "complete_metrizable (subtopology S A) \ g_delta_of S A" + by(auto simp : g_delta_of_complete_metrizable complete_metrizable_subtopology_is_g_delta[OF assms]) + +corollary complete_metrizable_homeo_image_g_delta: + assumes "complete_metrizable X" "complete_metrizable Y" "B \ topspace Y" "X homeomorphic_space subtopology Y B" + shows "g_delta_of Y B" +proof - + obtain f where f:"homeomorphic_map X (subtopology Y B) f" + using assms(4) homeomorphic_space by blast + obtain h gda gdb where h: + "g_delta_of X gda" "g_delta_of Y gdb" "topspace X \ gda" "B \ gdb" "\x\topspace X. f x = h x" "homeomorphic_map (subtopology X gda) (subtopology Y gdb) h" + using Lavrentiev_theorem[OF assms(1,2) subset_refl assms(3),simplified,OF f] by metis + hence [simp]: "gda = topspace X" + using g_delta_of_subset by blast + have "homeomorphic_map X (subtopology Y gdb) f" + using h(5,6) by(auto intro!: homeomorphic_map_eq[where f=h]) + hence "f ` topspace X = B" "f ` topspace X = gdb" + using homeomorphic_imp_surjective_map[OF f] assms(3) g_delta_of_subset[OF h(2)] h(4) homeomorphic_imp_surjective_map[OF \homeomorphic_map X (subtopology Y gdb) f\] + by auto + with h(2) show ?thesis by auto +qed + +lemma(in metrizable) embedding_into_Hilbert_cube: + assumes "separable S" + shows "\A \ topspace Hilbert_cube_as_topology. S homeomorphic_space (subtopology Hilbert_cube_as_topology A)" +proof - + consider "topspace S = {}" | "topspace S \ {}" by auto + then show ?thesis + proof cases + case 1 + then show ?thesis + by(auto intro!: exI[where x="{}"] simp: homeomorphic_empty_space_eq) + next + case S_ne:2 + then obtain U where U:"countable U" "dense_of S U" "U \ {}" + using assms(1) by(auto simp: separable_def dense_of_nonempty) + obtain xn where xn:"\n::nat. xn n \ U" "U = range xn" + by (metis U(1) U(3) from_nat_into range_from_nat_into) + then have xns:"xn n \ topspace S" for n + using dense_of_subset[OF U(2)] by auto + obtain d where d:"metric_set (topspace S) d" "metric_set.mtopology (topspace S) d = S" "\x y. d x y < 1" + using bounded_metric by auto + interpret ms: metric_set "topspace S" d by fact + define f where "f \ (\x n. d x (xn n))" + have f_inj:"inj_on f (topspace S)" + proof + fix x y + assume xy:"x \ topspace S" "y \ topspace S" "f x = f y" + then have "\n. d x (xn n) = d y (xn n)" by(auto simp: f_def dest: fun_cong) + hence d2:"d x y \ 2 * d x (xn n)" for n + using ms.dist_tr[OF xy(1) _ xy(2),of "xn n",simplified ms.dist_sym[of "xn n" y]] dense_of_subset[OF U(2)] xn(1)[of n] + by auto + have "d x y < \" if "\ > 0" for \ + proof - + have "0 < \ / 2" using that by simp + then obtain n where "d x (xn n) < \ / 2" + using ms.dense_set_def2[of U,simplified d(2)] U(2) xy(1) xn(2) by blast + with d2[of n] show ?thesis by simp + qed + hence "d x y = 0" + using ms.dist_geq0[of x y] + by (metis dual_order.irrefl order_neq_le_trans) + thus "x = y" + using ms.dist_0[OF xy(1,2)] by simp + qed + have f_img: "f ` topspace S \ topspace Hilbert_cube_as_topology" + using d(3) ms.dist_geq0 by(auto simp: topspace_Hilbert_cube f_def less_le_not_le) + have f_cont: "continuous_map S Hilbert_cube_as_topology f" + unfolding continuous_map_componentwise_UNIV f_def continuous_map_in_subtopology + proof safe + show "continuous_map S euclideanreal (\x. d x (xn k))" for k + using ms.dist_set_continuous[of "{xn k}"] by(simp add: d(2)) + next + show "d x (xn k) \ {0..1}" for x k + using d(3) ms.dist_geq0 by(auto simp: less_le_not_le) + qed + hence f_cont': "continuous_map S (subtopology Hilbert_cube_as_topology (f ` topspace S)) f" + using continuous_map_into_subtopology by blast + obtain g where g: "g ` (f ` topspace S) = topspace S" "\x. x \ topspace S \ g (f x) = x" "\x. x \ f ` topspace S \ f (g x) = x" + by (meson f_inj f_the_inv_into_f the_inv_into_f_eq the_inv_into_onto) + have g_cont: "continuous_map (subtopology Hilbert_cube_as_topology (f ` topspace S)) S g" + proof - + interpret m01: polish_metric_set "{0..1::real}" "submetric {0..1} dist" + by (metis closed_atLeastAtMost closed_closedin euclidean_mtopology polish_class_polish_set polish_metric_set.submetric_polish subset_UNIV) + have m01_eq: "m01.mtopology = top_of_set {0..1}" + by(rule submetric_of_euclidean(2)[of "{0..1::real}"]) + have "submetric {0..1::real} dist x y \ 1" "submetric {0..1::real} dist x y \ 0" for x y + using dist_real_def by(auto simp: submetric_def) + then interpret ppm: product_polish_metric "1/2" "UNIV :: nat set" id id "\_. {0..1}" "\_. submetric {0..1::real} dist" 1 + by(auto intro!: product_polish_metric_natI m01.polish_metric_set_axioms) + have Hilbert_cube_eq: "ppm.mtopology = Hilbert_cube_as_topology" + by(simp add: ppm.product_dist_mtopology[symmetric] m01_eq) + interpret f_S: metric_set "f ` topspace S" "submetric (f ` topspace S) ppm.product_dist" + using f_img by(auto intro!: ppm.submetric_metric_set) + have 1:"subtopology Hilbert_cube_as_topology (f ` topspace S) = f_S.mtopology" + using ppm.submetric_subtopology[of "f ` topspace S"] f_img by(simp add: Hilbert_cube_eq) + have "continuous_map f_S.mtopology ms.mtopology g" + unfolding metric_set_continuous_map_eq'[OF f_S.metric_set_axioms ms.metric_set_axioms] + proof safe + show "x \ topspace S \ g (f x) \ topspace S" for x + by(simp add: g(2)) + next + fix yn y + assume h:"f_S.converge_to_inS yn y" + have "ppm.converge_to_inS yn y" + using ppm.converge_to_insub_converge_to_inS[OF _ h] f_img by auto + hence m01_conv:"\n. m01.converge_to_inS (\i. yn i n) (y n)" + using ppm.converge_to_iff[of yn y] by(auto simp: ppm.converge_to_inS_def) + have "\n. \zn. yn n = f zn \ zn \ topspace S" + using h by(auto simp: f_S.converge_to_inS_def) + then obtain zn where zn:"\n. f (zn n) = yn n" "\n. zn n \ topspace S" + by metis + obtain z where z:"f z = y" "z \ topspace S" + using h by(auto simp: f_S.converge_to_inS_def) + show "ms.converge_to_inS (\n. g (yn n)) (g y)" + unfolding ms.converge_to_inS_def2 + proof safe + show "g (yn n) \ topspace S" "g y \ topspace S" for n + using g(2)[of z] g(2)[of "zn n"] zn[of n] z by simp_all + next + fix \ :: real + assume he: "0 < \" + then have "0 < \ / 3" by simp + then obtain m where m:"d z (xn m) < \ / 3" + using ms.dense_set_def2[of U,simplified d(2)] U(2) z(2) xn(2) by blast + obtain N where "\n. n \ N \ \yn n m - y m \ < \ / 3" + using m01_conv[of m,simplified m01.converge_to_inS_def2] \0 < \ / 3\ + by(simp only: submetric_def dist_real_def) (metis (full_types, lifting) PiE UNIV_I) + hence N:"\n. n \ N \ yn n m < \ / 3 + y m" + by (metis abs_diff_less_iff add.commute) + have "\N. \n\N. d (zn n) z < \" + proof(safe intro!: exI[where x=N]) + fix n + assume "N \ n" + have "d (zn n) z \ f (zn n) m + d z (xn m)" + using ms.dist_tr[OF zn(2)[of n] xns[of m] z(2),simplified ms.dist_sym[of "xn m" z]] + by(auto simp: f_def) + also have "... < \ / 3 + y m + d z (xn m)" + using N[OF \N\n\] zn(1)[of n] by simp + also have "... = \ / 3 + d z (xn m) + d z (xn m)" + by(simp add: z(1)[symmetric] f_def) + also have "... < \" + using m by auto + finally show "d (zn n) z < \" . + qed + thus "\N. \n\N. d (g (yn n)) (g y) < \" + using zn(1) z(1) g(2)[OF z(2)] g(2)[OF zn(2)] by auto + qed + qed + thus ?thesis + by(simp add: d(2) 1) + qed + show ?thesis + using f_img g(2,3) f_cont' g_cont + by(auto intro!: exI[where x="f ` topspace S"] homeomorphic_maps_imp_homeomorphic_space[where f=f and g=g] simp: homeomorphic_maps_def) + qed +qed + +corollary(in complete_metrizable) embedding_into_Hilbert_cube_g_delta_of: + assumes "separable S" + shows "\A. g_delta_of Hilbert_cube_as_topology A \ S homeomorphic_space (subtopology Hilbert_cube_as_topology A)" +proof - + obtain A where h:"A \ topspace Hilbert_cube_as_topology" "S homeomorphic_space subtopology Hilbert_cube_as_topology A" + using embedding_into_Hilbert_cube[OF assms(1)] by blast + with complete_metrizable_homeo_image_g_delta[OF complete_metrizable_axioms polish_topology.axioms(1)[OF Hilbert_cube_Polish_topology] h(1,2)] + show ?thesis + by(auto intro!: exI[where x=A]) +qed + +corollary(in polish_topology) embedding_into_Hilbert_cube_g_delta_of: + "\A. g_delta_of Hilbert_cube_as_topology A \ S homeomorphic_space (subtopology Hilbert_cube_as_topology A)" + by(rule embedding_into_Hilbert_cube_g_delta_of[OF S_separable]) + +lemma(in polish_topology) uncountable_contains_Cantor_space': + assumes "uncountable (topspace S)" + shows "\A\ topspace S. Cantor_space_as_topology homeomorphic_space (subtopology S A)" +proof - + obtain U P where up: "countable U" "openin S U" "perfect_set S P""U \ P = topspace S" "U \ P = {}" "\a. a \ {} \ openin (subtopology S P) a \ uncountable a" + using Cantor_Bendixon[OF S_second_countable] by auto + have P: "closedin S P" "P \ topspace S" "uncountable P" + using countable_Un_iff[of U P] up(1) assms up(4) + by(simp_all add: perfect_setD[OF up(3)]) + then interpret pp: polish_topology "subtopology S P" + by(simp add: closedin_polish) + have Ptop: "topspace (subtopology S P) = P" + using P(2) by auto + obtain U where U: "countable U" "dense_of (subtopology S P) U" + using pp.S_separable separable_def by blast + with uncountable_infinite[OF P(3)] pp.dense_of_infinite P(2) + have "infinite U" by (metis topspace_subtopology_subset) + obtain d where "complete_metric_set P d" and d:"metric_set.mtopology P d = subtopology S P" + using pp.cmetric by(simp only: Ptop,auto) + interpret md: complete_metric_set P d by fact + define xn where "xn \ from_nat_into U" + have xn: "bij_betw xn UNIV U" "\n m. n \ m \ xn n \ xn m" "\n. xn n \ U" "\n. xn n \ P" "md.dense_set (range xn)" + using bij_betw_from_nat_into[OF U(1) \infinite U\] dense_of_subset[OF U(2)] d U(2) range_from_nat_into[OF infinite_imp_nonempty[OF \infinite U\] U(1)] + by(auto simp add: xn_def U(1) \infinite U\ from_nat_into[OF infinite_imp_nonempty[OF \infinite U\]]) + have [simp]:"topspace md.mtopology = P" + using Ptop by(simp add: md.mtopology_topspace) + have perfect:"perfect_space md.mtopology" + using d perfect_set_subtopology up(3) by simp + define jn where "jn \ (\n. LEAST i. i > n \ md.closed_ball (xn i) ((1/2)^i) \ md.open_ball (xn n) ((1/2)^n) - md.open_ball (xn n) ((1/2)^i))" + define kn where "kn \ (\n. LEAST k. k > jn n \ md.closed_ball (xn k) ((1/2)^k) \ md.open_ball (xn n) ((1/2)^jn n))" + have dxmxn: "\n n'. \m. m > n \ m > n' \ (1/2)^(m-1) < d (xn n) (xn m) \ d (xn n) (xn m) < (1/2)^(Suc n')" + proof safe + fix n n' + have hinfin':"infinite (md.open_ball x e \ (range xn))" if "x \ P" "e > 0" for x e + proof + assume h_fin:"finite (md.open_ball x e \ range xn)" + have h_nen:"md.open_ball x e \ range xn \ {}" + using xn(5) that by(auto simp: md.dense_set_def) + have infin: "infinite (md.open_ball x e)" + using md.perfect_set_open_ball_infinite[OF perfect] that by simp + then obtain y where y:"y \ md.open_ball x e" "y \ range xn" + using h_fin by(metis inf.absorb_iff2 inf_commute subsetI) + define e' where "e' = Min {d y xk |xk. xk \ md.open_ball x e \ range xn}" + have fin: "finite {d y xk |xk. xk \ md.open_ball x e \ range xn}" + using finite_imageI[OF h_fin,of "d y"] by (metis Setcompr_eq_image) + have nen: "{d y xk |xk. xk \ md.open_ball x e \ range xn} \ {}" + using h_nen by auto + have "e' > 0" + unfolding e'_def Min_gr_iff[OF fin nen] + proof safe + fix l + assume "xn l \ md.open_ball x e" + from y(2) md.dist_0[OF md.open_ballD'(1)[OF y(1)] md.open_ballD'(1)[OF this]] md.dist_geq0[of y "xn l"] + show "0 < d y (xn l)" + by auto + qed + obtain e'' where e'': "e'' > 0" "md.open_ball y e'' \ md.open_ball x e" "y \ md.open_ball y e''" + by (meson md.mtopology_open_ball_in' md.open_ballD'(1) md.open_ball_ina y(1)) + define \ where "\ \ min e' e''" + have "\ > 0" + using e''(1) \e' > 0\ by(simp add: \_def) + then obtain m where m: "d y (xn m) < \" + using md.dense_set_def2[of "range xn"] xn(5) md.open_ballD'(1)[OF y(1)] by blast + consider "xn m \ md.open_ball x e" | "xn m \ P - md.open_ball x e" + using xn(4) by auto + then show False + proof cases + case 1 + then have "e' \ d y (xn m)" + using Min_le_iff[OF fin nen] by(auto simp: e'_def) + thus ?thesis + using m by(simp add: \_def) + next + case 2 + then have "xn m \ md.open_ball y e''" + using e''(2) by auto + hence "e'' \ d y (xn m)" + by(rule md.open_ball_nin_le[OF md.open_ballD'(1)[OF y(1)] e''(1) xn(4)[of m]]) + thus ?thesis + using m by(simp add: \_def) + qed + qed + have hinfin:"infinite (md.open_ball x e \ (xn ` {l<..}))" if "x \ P" "e > 0" for x e l + proof + assume "finite (md.open_ball x e \ xn ` {l<..})" + moreover have "finite (md.open_ball x e \ xn ` {..l})" by simp + moreover have "(md.open_ball x e \ (range xn)) = (md.open_ball x e \ xn ` {l<..}) \ (md.open_ball x e \ xn ` {..l})" + by fastforce + ultimately have "finite (md.open_ball x e \ (range xn))" + by auto + with hinfin'[OF that] show False .. + qed + have "infinite (md.open_ball (xn n) ((1/2)^Suc n'))" + using md.perfect_set_open_ball_infinite[OF perfect] xn(4)[of n] by simp + then obtain x where x: "x \ md.open_ball (xn n) ((1/2)^Suc n')" "x \ xn n" + by (metis finite_insert finite_subset infinite_imp_nonempty singletonI subsetI) + then obtain e where e: "e > 0" "md.open_ball x e \ md.open_ball (xn n) ((1/2)^Suc n')" "x \ md.open_ball x e" + by (meson md.mtopology_open_ball_in' md.open_ballD'(1) md.open_ball_ina) + have "d (xn n) x > 0" + using md.dist_geq0[of "xn n" x] md.dist_0[OF xn(4)[of n] md.open_ballD'(1)[OF x(1)]] x(2) by simp + then obtain m' where m': "m' - 1 > 0" "(1/2)^(m' - 1) < d (xn n) x" + by (metis One_nat_def diff_Suc_Suc diff_zero one_less_numeral_iff reals_power_lt_ex semiring_norm(76)) + define m where "m \ max m' (max n' (Suc n))" + then have "m \ m'" "m \ n'" "m \ Suc n" by simp_all + hence m: "m - 1 > 0" "(1/2)^(m - 1) < d (xn n) x" "m > n" + using m' less_trans[OF _ m'(2),of "(1 / 2) ^ (m - 1)"] + by auto (metis diff_less_mono le_eq_less_or_eq) + define \ where "\ \ min e (d (xn n) x - (1/2)^(m - 1))" + have "\ > 0" + using e m by(simp add: \_def) + have ball_le:"md.open_ball x \ \ md.open_ball (xn n) ((1 / 2) ^ Suc n')" + using md.open_ball_le[of \ e x] e(2) by(simp add: \_def) + obtain k where k: "xn k \ md.open_ball x \" "k > m" + using infinite_imp_nonempty[OF hinfin[OF md.open_ballD'(1)[OF x(1)] \\ > 0\,of m]] by auto + show "\m>n. n' < m \ (1 / 2) ^ (m - 1) < d (xn n) (xn m) \ d (xn n) (xn m) < (1 / 2) ^ Suc n'" + proof(intro exI[where x=k] conjI) + have "(1 / 2) ^ (k - 1) < (1 / (2 :: real)) ^ (m - 1)" + using k(2) m(3) by simp + also have "... = d (xn n) x + ((1/2)^ (m - 1) - d (xn n) x)" by simp + also have "... < d (xn n) x - d (xn k) x" + using md.open_ballD[OF k(1)] by(simp add: \_def md.dist_sym[of x _]) + also have "... \ d (xn n) (xn k)" + using md.dist_tr[OF xn(4)[of n] xn(4)[of k] md.open_ballD'(1)[OF x(1)]] by simp + finally show "(1 / 2) ^ (k - 1) < d (xn n) (xn k)" . + qed(use \m \ n'\ k ball_le md.open_ballD[of "xn k" "xn n" "(1 / 2) ^ Suc n'"] m(3) in auto) + qed + have "jn n > n \ md.closed_ball (xn (jn n)) ((1/2)^(jn n)) \ md.open_ball (xn n) ((1/2)^n) - md.open_ball (xn n) ((1/2)^(jn n))" for n + unfolding jn_def + proof(rule LeastI_ex) + obtain m where m:"m > n" "(1 / 2) ^ (m - 1) < d (xn n) (xn m)" "d (xn n) (xn m) < (1 / 2) ^ Suc n" + using dxmxn by auto + show "\x>n. md.closed_ball (xn x) ((1 / 2) ^ x) \ md.open_ball (xn n) ((1 / 2) ^ n) - md.open_ball (xn n) ((1 / 2) ^ x)" + proof(safe intro!: exI[where x=m] m(1)) + fix x + assume h:"x \ md.closed_ball (xn m) ((1 / 2) ^ m)" + have 1:"d (xn n) x < (1 / 2) ^ n" + proof - + have "d (xn n) x < (1 / 2) ^ Suc n + (1 / 2) ^ m" + using m(3) md.dist_tr[OF xn(4)[of n] xn(4)[of m] md.closed_ballD'(1)[OF h]] md.closed_ballD[OF h] + by simp + also have "... \ (1 / 2) ^ Suc n + (1 / 2) ^ Suc n" + by (metis Suc_lessI add_mono divide_less_eq_1_pos divide_pos_pos less_eq_real_def m(1) one_less_numeral_iff power_strict_decreasing_iff semiring_norm(76) zero_less_numeral zero_less_one) + finally show ?thesis by simp + qed + have 2:"(1 / 2) ^ m \ d (xn n) x" + proof - + have "(1 / 2) ^ (m - 1) < d (xn n) x + (1 / 2) ^ m" + using order.strict_trans2[OF m(2) md.dist_tr[OF xn(4)[of n] md.closed_ballD'(1)[OF h] xn(4)[of m]]] md.closed_ballD(1)[OF h] + by(simp add: md.dist_sym) + hence "(1 / 2) ^ (m - 1) - (1 / 2) ^ m \ d (xn n) x" + by simp + thus ?thesis + using not0_implies_Suc[OF gr_implies_not0[OF m(1)]] by auto + qed + show "x \ md.open_ball (xn n) ((1 / 2) ^ n)" + "x \ md.open_ball (xn n) ((1 / 2) ^ m) \ False" + using xn(4)[of n] md.closed_ballD'(1)[OF h] 1 2 by(auto simp: md.open_ball_def) + qed + qed + hence jn: "\n. jn n > n" "\n. md.closed_ball (xn (jn n)) ((1/2)^(jn n)) \ md.open_ball (xn n) ((1/2)^n) - md.open_ball (xn n) ((1/2)^(jn n))" + by simp_all + have "kn n > jn n \ md.closed_ball (xn (kn n)) ((1/2)^(kn n)) \ md.open_ball (xn n) ((1/2)^jn n)" for n + unfolding kn_def + proof(rule LeastI_ex) + obtain m where m:"m > jn n" "d (xn n) (xn m) < (1 / 2) ^ Suc (jn n)" + using dxmxn by blast + show "\x>jn n. md.closed_ball (xn x) ((1 / 2) ^ x) \ md.open_ball (xn n) ((1 / 2) ^ jn n)" + proof(intro exI[where x=m] conjI) + show "md.closed_ball (xn m) ((1 / 2) ^ m) \ md.open_ball (xn n) ((1 / 2) ^ jn n)" + proof + fix x + assume h:"x \ md.closed_ball (xn m) ((1 / 2) ^ m)" + have "d (xn n) x < (1 / 2)^ Suc (jn n) + (1 / 2) ^ m" + using md.dist_tr[OF xn(4)[of n] xn(4)[of m] md.closed_ballD'(1)[OF h]] m(2) md.closed_ballD[OF h] + by simp + also have "... \ (1 / 2)^ Suc (jn n) + (1 / 2)^ Suc (jn n)" + by (metis Suc_le_eq add_mono dual_order.refl less_divide_eq_1_pos linorder_not_less m(1) not_numeral_less_one power_decreasing zero_le_divide_1_iff zero_le_numeral zero_less_numeral) + finally show "x \ md.open_ball (xn n) ((1 / 2) ^ jn n)" + by(simp add: xn(4)[of n] md.closed_ballD'(1)[OF h] md.open_ball_def) + qed + qed(use m(1) in auto) + qed + hence kn: "\n. kn n > jn n" "\n. md.closed_ball (xn (kn n)) ((1/2)^(kn n)) \ md.open_ball (xn n) ((1/2)^(jn n))" + by simp_all + have jnkn_pos: "jn n > 0" "kn n > 0" for n + using not0_implies_Suc[OF gr_implies_not0[OF jn(1)[of n]]] kn(1)[of n] by auto + + define bn :: "real list \ nat" + where "bn \ rec_list 1 (\a l t. if a = 0 then jn t else kn t)" + have bn_simp: "bn [] = 1" "bn (a # l) = (if a = 0 then jn (bn l) else kn (bn l))" for a l + by(simp_all add: bn_def) + define to_listn :: "(nat \ real) \ nat \ real list" + where "to_listn \ (\x . rec_nat [] (\n t. x n # t))" + have to_listn_simp: "to_listn x 0 = []" "to_listn x (Suc n) = x n # to_listn x n" for x n + by(simp_all add: to_listn_def) + have to_listn_eq: "(\m. m < n \ x m = y m) \ to_listn x n = to_listn y n" for x y n + by(induction n) (auto simp: to_listn_simp) + have bn_gtn: "bn (to_listn x n) > n" for x n + apply(induction n arbitrary: x) + using jn(1) kn(1) by(auto simp: bn_simp to_listn_simp) (meson Suc_le_eq le_less less_trans_Suc)+ + define rn where "rn \ (\n. Min (range (\x. (1 / 2 :: real) ^ bn (to_listn x n))))" + have rn_fin: "finite (range (\x. (1 / 2 :: real) ^ bn (to_listn x n)))" for n + proof - + have "finite (range (\x. bn (to_listn x n)))" + proof(induction n) + case ih:(Suc n) + have "(range (\x. bn (to_listn x (Suc n)))) \ (range (\x. jn (bn (to_listn x n)))) \ (range (\x. kn (bn (to_listn x n))))" + by(auto simp: to_listn_simp bn_simp) + moreover have "finite ..." + using ih finite_range_imageI by auto + ultimately show ?case by(rule finite_subset) + qed(simp add: to_listn_simp) + thus ?thesis + using finite_range_imageI by blast + qed + have rn_nen: "(range (\x. (1 / 2 :: real) ^ bn (to_listn x n))) \ {}" for n + by simp + have rn_pos: "0 < rn n" for n + by(simp add: Min_gr_iff[OF rn_fin rn_nen] rn_def) + have rn_less: "rn n < (1/2)^n" for n + using bn_gtn[of n] by(auto simp: rn_def Min_less_iff[OF rn_fin rn_nen]) + have cball_le_ball:"md.closed_ball (xn (bn (a#l))) ((1/2)^(bn (a#l))) \ md.open_ball (xn (bn l)) ((1/2) ^ (bn l))" for a l + using kn(2)[of "bn l"] md.open_ball_le[of "(1 / 2) ^ jn (bn l)" "(1 / 2) ^ bn l" "xn (bn l)"] less_imp_le [OF jn(1)] jn(2) + by(simp add: bn_simp) blast + hence cball_le:"md.closed_ball (xn (bn (a#l))) ((1/2)^(bn (a#l))) \ md.closed_ball (xn (bn l)) ((1/2) ^ (bn l))" for a l + using md.open_ball_closed_ball by blast + have cball_disj: "md.closed_ball (xn (bn (0#l))) ((1/2)^(bn (0#l))) \ md.closed_ball (xn (bn (1#l))) ((1/2)^(bn (1#l))) = {}" for l + using jn(2) kn(2) by(auto simp: bn_simp) + have "\x. \xa\P. (\n. md.closed_ball (xn (bn (to_listn x n))) ((1 / 2) ^ bn (to_listn x n))) = {xa}" + proof + fix x + show "\xa\P. (\n. md.closed_ball (xn (bn (to_listn x n))) ((1 / 2) ^ bn (to_listn x n))) = {xa}" + proof(rule md.closed_decseq_Inter) + show "md.closed_ball (xn (bn (to_listn x n))) ((1 / 2) ^ bn (to_listn x n)) \ {}" for n + using md.closed_ball_ina[OF xn(4)[of "bn (to_listn x n)"],of "(1 / 2) ^ bn (to_listn x n)"] by auto + next + show "decseq (\n. md.closed_ball (xn (bn (to_listn x n))) ((1 / 2) ^ bn (to_listn x n)))" + by(intro decseq_SucI,simp add: to_listn_simp cball_le) + next + fix \ :: real + assume "0 < \" + then obtain N where N: "(1 / 2) ^ N < (1/2) * \" + by (metis divide_pos_pos mult.commute mult.right_neutral one_less_numeral_iff reals_power_lt_ex semiring_norm(76) times_divide_eq_right zero_less_numeral) + show "\N. \n\N. md.diam (md.closed_ball (xn (bn (to_listn x n))) ((1 / 2) ^ bn (to_listn x n))) < \" + proof(safe intro!: exI[where x=N]) + fix n + assume "N \ n" + have "md.diam (md.closed_ball (xn (bn (to_listn x n))) ((1 / 2) ^ bn (to_listn x n))) \ md.diam (md.closed_ball (xn (bn (to_listn x n))) ((1 / 2) ^ n))" + using bn_gtn[of n x] by(auto intro!: md.diam_subset md.closed_ball_le) + also have "... \ ennreal (2 * (1 / 2) ^ n)" + by(simp add: md.diam_cball_leq) + also have "... \ ennreal (2 * (1 / 2) ^ N)" + using \N \ n\ by (simp add: numeral_mult_ennreal) + also have "... < ennreal (2 *(1/2) * \)" + using N by (simp add: \0 < \\ ennreal_lessI le_less numeral_mult_ennreal) + also have "... = ennreal \" + by (simp add: \0 < \\ le_less numeral_mult_ennreal) + finally show "md.diam (md.closed_ball (xn (bn (to_listn x n))) ((1 / 2) ^ bn (to_listn x n))) < ennreal \" . + qed + qed(rule md.closedin_closed_ball) + qed + then obtain f where f:"\x. f x \ P" "\x. (\n. md.closed_ball (xn (bn (to_listn x n))) ((1 / 2) ^ bn (to_listn x n))) = {f x}" + by metis + hence f': "\n x. f x \ md.closed_ball (xn (bn (to_listn x n))) ((1 / 2) ^ bn (to_listn x n))" + by blast + have f'': "f x \ md.open_ball (xn (bn (to_listn x n))) ((1 / 2) ^ bn (to_listn x n))" for n x + using f'[of x "Suc n"] cball_le_ball[of _ "to_listn x n"] by(auto simp: to_listn_simp) + from f interpret bdmd: metric_set "f ` (\\<^sub>E i\UNIV. {0,1})" "submetric (f ` (\\<^sub>E i\UNIV. {0,1})) d" + by(auto intro!: md.submetric_metric_set) + have bdmd_top: "bdmd.mtopology = subtopology md.mtopology (f ` (\\<^sub>E i\UNIV. {0,1}))" + by (simp add: f(1) image_subset_iff md.submetric_subtopology) + have bdmd_sub: "bdmd.mtopology = subtopology S (f ` (\\<^sub>E i\UNIV. {0,1}))" + using f(1) Int_absorb1[of "f ` (UNIV \\<^sub>E {0, 1})" P] by(fastforce simp: bdmd_top d subtopology_subtopology) + interpret d01: polish_metric_set "{0,1::real}" "submetric {0,1::real} dist" + by(auto intro!: polish_metric_set.submetric_polish[OF polish_class_polish_set] simp: euclidean_mtopology) + interpret pd: product_polish_metric "1/2" UNIV id id "\_. {0,1::real}" "\_. submetric {0,1::real} dist" 1 + by(auto intro!: product_polish_metric_natI simp: d01.polish_metric_set_axioms) (auto simp: submetric_def) + have mpd_top: "pd.mtopology = Cantor_space_as_topology" + by(auto simp: pd.product_dist_mtopology[symmetric] submetric_of_euclidean(2) intro!: product_topology_cong) + + define def_at where "def_at x y \ LEAST n. x n \ y n" for x y :: "nat \ real" + have def_atxy: "\n. n < def_at x y \ x n = y n" "x (def_at x y) \ y (def_at x y)" if "x \ y" for x y + proof - + have "\n. x n \ y n" + using that by auto + from LeastI_ex[OF this] + show "\n. n < def_at x y \ x n = y n" "x (def_at x y) \ y (def_at x y)" + using not_less_Least by(auto simp: def_at_def) + qed + have def_at_le_if: "pd.product_dist x y \ (1/2)^n \ n \ def_at x y" if assm:"x \ y" "x \ (\\<^sub>E i\UNIV. {0,1})" "y \ (\\<^sub>E i\UNIV. {0,1})" for x y n + proof - + assume h:"pd.product_dist x y \ (1 / 2) ^ n" + have "x m = y m" if m_less_n: "m < n" for m + proof(rule ccontr) + assume nen: "x m \ y m" + then have "submetric {0, 1} dist (x m) (y m) = 1" + using assm(2,3) by(auto simp: submetric_def) + hence "1 \ 2 ^ m * pd.product_dist x y" + using pd.product_dist_geq[of m m,simplified,OF assm(2,3)] by simp + hence "(1/2)^m \ 2^m * (1/2)^m * pd.product_dist x y" by simp + hence "(1/2)^m \ pd.product_dist x y" by (simp add: power_one_over) + also have "... \ (1 / 2) ^ n" + by(simp add: h) + finally show False + using that by auto + qed + thus "n \ def_at x y" + by (meson def_atxy(2) linorder_not_le that(1)) + qed + have def_at_le_then: "pd.product_dist x y \ 2 * (1/2)^n" if assm:"x \ y" "x \ (\\<^sub>E i\UNIV. {0,1})" "y \ (\\<^sub>E i\UNIV. {0,1})" "n \ def_at x y" for x y n + proof - + have "\m. m < n \ x m = y m" + by (metis def_atxy(1) order_less_le_trans that(4)) + hence 1:"\m. m < n \ submetric {0, 1} dist (x m) (y m) = 0" + by (simp add: submetric_def) + have "pd.product_dist x y = (\i. (1/2)^(i + n) * (submetric {0, 1} dist (x (i + n)) (y (i + n)))) + (\ii. (1/2)^(i + n) * (submetric {0, 1} dist (x (i + n)) (y (i + n))))" + by(simp add: 1) + also have "... \ (\i. (1/2)^(i + n))" + using pd.product_dist_summable'[simplified] pd.d_bound by(auto intro!: suminf_le summable_ignore_initial_segment) + finally show ?thesis + using pd.nsum_of_rK[of n] by simp + qed + have d_le_def: "d (f x) (f y) \ (1/2)^(def_at x y)" if assm:"x \ y" "x \ (\\<^sub>E i\UNIV. {0,1})" "y \ (\\<^sub>E i\UNIV. {0,1})" for x y + proof - + have 1:"to_listn x n = to_listn y n" if "n \ def_at x y" for n + proof - + have "\m. m < n \ x m = y m" + by (metis def_atxy(1) order_less_le_trans that) + then show ?thesis + by(auto intro!: to_listn_eq) + qed + have "f x \ md.closed_ball (xn (bn (to_listn x (def_at x y)))) ((1 / 2) ^ bn (to_listn x (def_at x y)))" + "f y \ md.closed_ball (xn (bn (to_listn x (def_at x y)))) ((1 / 2) ^ bn (to_listn x (def_at x y)))" + using f'[of x "def_at x y"] f'[of y "def_at x y"] by(auto simp: 1[OF order_refl]) + hence "d (f x) (f y) \ 2 * (1 / 2) ^ bn (to_listn x (def_at x y))" + using f(1) by(auto intro!: md.diam_is_sup'[OF _ _ md.diam_cball_leq]) + also have "... \ (1/2)^(def_at x y)" + proof - + have "Suc (def_at x y) \ bn (to_listn x (def_at x y))" + using bn_gtn[of "def_at x y" x] by simp + hence "(1 / 2) ^ bn (to_listn x (def_at x y)) \ (1 / 2 :: real) ^ Suc (def_at x y)" + using power_decreasing_iff[OF pd.r] by blast + thus ?thesis + by simp + qed + finally show "d (f x) (f y) \ (1/2)^(def_at x y)" . + qed + have fy_in:"f y \ md.closed_ball (xn (bn (to_listn x m))) ((1/2)^bn (to_listn x m)) \ \l (\\<^sub>E i\UNIV. {0,1})" "y \ (\\<^sub>E i\UNIV. {0,1})" for x y m + proof(induction m) + case ih:(Suc m) + have "f y \ md.closed_ball (xn (bn (to_listn x m))) ((1 / 2) ^ bn (to_listn x m))" + using ih(2) cball_le by(auto simp: to_listn_simp) + with ih(1) have k:"k < m \ x k = y k" for k by simp + show ?case + proof safe + fix l + assume "l < Suc m" + then consider "l < m" | "l = m" + using \l < Suc m\ by fastforce + thus "x l = y l" + proof cases + case 2 + have 3:"f y \ md.closed_ball (xn (bn (y l # to_listn y l))) ((1 / 2) ^ bn (y l # to_listn y l))" + using f'[of y "Suc l"] by(simp add: to_listn_simp) + have 4:"f y \ md.closed_ball (xn (bn (x l # to_listn y l))) ((1 / 2) ^ bn (x l # to_listn y l))" + using ih(2) to_listn_eq[of m x y,OF k] by(simp add: to_listn_simp 2) + show ?thesis + proof(rule ccontr) + assume "x l \ y l" + then consider "x l = 0" "y l = 1" | "x l = 1" "y l = 0" + using assm(1,2) by(auto simp: PiE_def Pi_def) metis + thus False + by cases (use cball_disj[of "to_listn y l"] 3 4 in auto) + qed + qed(simp add: k) + qed + qed simp + have d_le_rn_then: "\e>0. \y \ (\\<^sub>E i\UNIV. {0,1}). x \ y \ d (f x) (f y) < e \ n \ def_at x y" if assm: "x \ (\\<^sub>E i\UNIV. {0,1})" for x n + proof(safe intro!: exI[where x="(1/2)^bn (to_listn x n) - d (xn (bn (to_listn x n))) (f x)"]) + show "0 < (1 / 2) ^ bn (to_listn x n) - d (xn (bn (to_listn x n))) (f x)" + using md.open_ballD[OF f''] by auto + next + fix y + assume h:"y \ (\\<^sub>E i\UNIV. {0,1})" "d (f x) (f y) < (1 / 2) ^ bn (to_listn x n) - d (xn (bn (to_listn x n))) (f x)" "x \ y" + then have "f y \ md.closed_ball (xn (bn (to_listn x n))) ((1/2)^bn (to_listn x n))" + using md.dist_tr[OF xn(4)[of "bn (to_listn x n)"] f(1)[of x] f(1)[of y]] + by(simp add: xn(4)[of "bn (to_listn x n)"] f(1)[of y] md.closed_ball_def) + with fy_in[OF assm h(1)] have "\m < n. x m = y m" + by simp + thus "n \ def_at x y" + by (meson def_atxy(2) linorder_not_le h(3)) + qed + have 0: "f ` (\\<^sub>E i\UNIV. {0,1}) \ topspace S" + using f(1) P(2) by auto + have 1: "continuous_map pd.mtopology bdmd.mtopology f" + unfolding metric_set_continuous_map_eq[OF pd.metric_set_axioms bdmd.metric_set_axioms] + proof safe + fix x :: "nat \ real" and \ :: real + assume h:"x \ (\\<^sub>E i\UNIV. {0,1})" "0 < \" + then obtain n where n:"(1/2)^n < \" + using real_arch_pow_inv[OF _ pd.r(2)] by auto + show "\\>0. \y\UNIV \\<^sub>E {0, 1}. pd.product_dist x y < \ \ submetric (f ` (UNIV \\<^sub>E {0, 1})) d (f x) (f y) < \" + proof(safe intro!: exI[where x="(1/2)^n"]) + fix y + assume y:"y \ (\\<^sub>E i\UNIV. {0,1})" "pd.product_dist x y < (1 / 2) ^ n" + consider "x = y" | "x \ y" by auto + thus "submetric (f ` (UNIV \\<^sub>E {0, 1})) d (f x) (f y) < \" + proof cases + case 1 + with y(1) h md.dist_0[OF f(1)[of y] f(1)[of y]] + show ?thesis by(auto simp add: submetric_def) + next + case 2 + then have "n \ def_at x y" + using h(1) y by(auto intro!: def_at_le_if) + have "submetric (f ` (UNIV \\<^sub>E {0, 1})) d (f x) (f y) \ (1/2)^(def_at x y)" + using h(1) y(1) by(auto simp: d_le_def[OF 2 h(1) y(1)] submetric_def) + also have "... \ (1/2)^n" + using \n \ def_at x y\ by simp + finally show ?thesis + using n by simp + qed + qed simp + qed simp + have 2: "open_map pd.mtopology bdmd.mtopology f" + proof(rule metric_set_opem_map_from_dist[OF pd.metric_set_axioms bdmd.metric_set_axioms,of f,simplified subtopology_topspace[of bdmd.mtopology,simplified bdmd.mtopology_topspace]]) + fix x :: "nat \ real" and \ :: real + assume h:"x \ (\\<^sub>E i\UNIV. {0,1})" "0 < \" + then obtain n where n: "(1/2)^n < \" + using real_arch_pow_inv[OF _ pd.r(2)] by auto + obtain e where e: "e > 0" "\y. y \ (\\<^sub>E i\UNIV. {0,1}) \ x \ y \ d (f x) (f y) < e \ Suc n \ def_at x y" + using d_le_rn_then[OF h(1),of "Suc n"] by auto + show "\\>0. \y\UNIV \\<^sub>E {0, 1}. submetric (f ` (UNIV \\<^sub>E {0, 1})) d (f x) (f y) < \ \ pd.product_dist x y < \" + proof(safe intro!: exI[where x=e]) + fix y + assume y:"y \ (\\<^sub>E i\UNIV. {0,1})" and "submetric (f ` (UNIV \\<^sub>E {0, 1})) d (f x) (f y) < e" + then have d':"d (f x) (f y) < e" + using h(1) by(simp add: submetric_def) + consider "x = y" | "x \ y" by auto + thus "pd.product_dist x y < \" + by cases (use pd.dist_0[OF y y] h(2) def_at_le_then[OF _ h(1) y e(2)[OF y _ d']] n in auto) + qed(use e(1) in auto) + qed simp + have 3: "f ` (topspace pd.mtopology) = topspace bdmd.mtopology" + by(simp add: bdmd.mtopology_topspace pd.mtopology_topspace) + have 4: "inj_on f (topspace pd.mtopology)" + unfolding pd.mtopology_topspace + proof + fix x y + assume h:"x \ (\\<^sub>E i\UNIV. {0,1})" "y \ (\\<^sub>E i\UNIV. {0,1})" "f x = f y" + show "x = y" + proof + fix n + have "f y \ md.closed_ball (xn (bn (to_listn x (Suc n)))) ((1/2)^bn (to_listn x (Suc n)))" + using f'[of x "Suc n"] by(simp add: h) + thus "x n = y n" + using fy_in[OF h(1,2),of "Suc n"] by simp + qed + qed + show ?thesis + using homeomorphic_map_imp_homeomorphic_space[OF bijective_open_imp_homeomorphic_map[OF 1 2 3 4]] 0 + by(auto simp: bdmd_sub mpd_top) +qed + +lemma(in polish_topology) uncountable_contains_Cantor_space: + assumes "uncountable (topspace S)" + shows "\A. g_delta_of S A \ Cantor_space_as_topology homeomorphic_space (subtopology S A)" +proof - + obtain A where A:"A \ topspace S" "Cantor_space_as_topology homeomorphic_space (subtopology S A)" + using uncountable_contains_Cantor_space'[OF assms] by auto + then have "g_delta_of S A" + using Cantor_space_Polish_topology + by(auto intro!: complete_metrizable_homeo_image_g_delta simp: polish_topology_def complete_metrizable_axioms) + thus ?thesis + by(auto intro!: exI[where x=A] A(2)) +qed + +subsection \Borel Spaces\ +text \ Borel spaces generated from abstract topology \ +definition borel_of :: "'a topology \ 'a measure" where +"borel_of S \ sigma (topspace S) {U. openin S U}" + +lemma emeasure_borel_of: "emeasure (borel_of S) A = 0" + by (simp add: borel_of_def emeasure_sigma) + +lemma borel_of_euclidean: "borel_of euclidean = borel" + by(simp add: borel_of_def borel_def) + +lemma space_borel_of: "space (borel_of S) = topspace S" + by(simp add: space_measure_of_conv borel_of_def) + +lemma sets_borel_of: "sets (borel_of S) = sigma_sets (topspace S) {U. openin S U}" + by (simp add: subset_Pow_Union topspace_def borel_of_def) + +lemma sets_borel_of_closed: "sets (borel_of S) = sigma_sets (topspace S) {U. closedin S U}" + unfolding sets_borel_of +proof(safe intro!: sigma_sets_eqI) + fix a + assume a:"openin S a" + have "topspace S - (topspace S - a) \ sigma_sets (topspace S) {U. closedin S U}" + by(rule sigma_sets.Compl) (use a in auto) + thus "a \ sigma_sets (topspace S) {U. closedin S U}" + using openin_subset[OF a] by (simp add: Diff_Diff_Int inf.absorb_iff2) +next + fix b + assume b:"closedin S b" + have "topspace S - (topspace S - b) \ sigma_sets (topspace S) {U. openin S U}" + by(rule sigma_sets.Compl) (use b in auto) + thus "b \ sigma_sets (topspace S) {U. openin S U}" + using closedin_subset[OF b] by (simp add: Diff_Diff_Int inf.absorb_iff2) +qed + +lemma borel_of_open: + assumes "openin S U" + shows "U \ sets (borel_of S)" + using assms by (simp add: subset_Pow_Union topspace_def borel_of_def) + +lemma borel_of_closed: + assumes "closedin S U" + shows "U \ sets (borel_of S)" + using assms sigma_sets.Compl[of "topspace S - U" "topspace S"] + by (simp add: closedin_def double_diff sets_borel_of) + +lemma(in metric_set) nbh_sets[measurable]: "(\a\A. open_ball a e) \ sets (borel_of mtopology)" + by(auto intro!: borel_of_open openin_clauses(3) openin_open_ball) + +lemma borel_of_g_delta_of: + assumes "g_delta_of S U" + shows "U \ sets (borel_of S)" + using g_delta_ofD[OF assms] borel_of_open + by(auto intro!: sets.countable_INT'[of _ id,simplified]) + +lemma borel_of_subtopology: + "borel_of (subtopology S U) = restrict_space (borel_of S) U" +proof(rule measure_eqI) + show "sets (borel_of (subtopology S U)) = sets (restrict_space (borel_of S) U)" + unfolding restrict_space_eq_vimage_algebra' sets_vimage_algebra sets_borel_of topspace_subtopology space_borel_of Int_commute[of U] + proof(rule sigma_sets_eqI) + fix a + assume "a \ Collect (openin (subtopology S U))" + then obtain T where "openin S T" "a = T \ U" + by(auto simp: openin_subtopology) + show "a \ sigma_sets (topspace S \ U) {(\x. x) -` A \ (topspace S \ U) |A. A \ sigma_sets (topspace S) (Collect (openin S))}" + using openin_subset[OF \openin S T\] \a = T \ U\ by(auto intro!: exI[where x=T] \openin S T\) + next + fix b + assume "b \ {(\x. x) -` A \ (topspace S \ U) |A. A \ sigma_sets (topspace S) (Collect (openin S))}" + then obtain T where ht:"b = T \ (topspace S \ U)" "T \ sigma_sets (topspace S) (Collect (openin S))" + by auto + hence "b = T \ U" + proof - + have "T \ topspace S" + by(rule sigma_sets_into_sp[OF _ ht(2)]) (simp add: subset_Pow_Union topspace_def) + thus ?thesis + by(auto simp: ht(1)) + qed + with ht(2) show "b \ sigma_sets (topspace S \ U) (Collect (openin (subtopology S U)))" + proof(induction arbitrary: b U) + case (Basic a) + then show ?case + by(auto simp: openin_subtopology) + next + case Empty + then show ?case by simp + next + case ih:(Compl a) + then show ?case + by (simp add: Diff_Int_distrib2 sigma_sets.Compl) + next + case (Union a) + then show ?case + by (metis UN_extend_simps(4) sigma_sets.Union) + qed + qed +qed(simp add: emeasure_borel_of restrict_space_def emeasure_measure_of_conv) + + +lemma(in metrizable) sigma_sets_eq_cinter_dunion: + "sigma_sets (topspace S) {U. openin S U} = sigma_sets_cinter_dunion (topspace S) {U. openin S U}" +proof safe + fix a + interpret sa: sigma_algebra "topspace S" "sigma_sets (topspace S) {U. openin S U}" + by(auto intro!: sigma_algebra_sigma_sets openin_subset) + assume "a \ sigma_sets_cinter_dunion (topspace S) {U. openin S U}" + then show "a \ sigma_sets (topspace S) {U. openin S U}" + by induction auto +next + have c:"sigma_sets_cinter_dunion (topspace S) {U. openin S U} \ {U\sigma_sets_cinter_dunion (topspace S) {U. openin S U}. topspace S - U \ sigma_sets_cinter_dunion (topspace S) {U. openin S U}}" + proof + fix a + assume a: "a \ sigma_sets_cinter_dunion (topspace S) {U. openin S U}" + then show "a \ {U \ sigma_sets_cinter_dunion (topspace S) {U. openin S U}. topspace S - U \ sigma_sets_cinter_dunion (topspace S) {U. openin S U}}" + proof induction + case a:(Basic_cd a) + then have "g_delta_of S (topspace S - a)" + by(auto intro!: g_delta_of_closedin) + from g_delta_ofD'[OF this] obtain U where U: + "\n :: nat. openin S (U n)" "topspace S - a = \ (range U)" by auto + show ?case + using a U(1) by(auto simp: U(2) intro!: Inter_cd) + next + case Top_cd + then show ?case by auto + next + case ca:(Inter_cd a) + define b where "b \ (\n. (topspace S - a n) \ (\i. if i < n then a i else topspace S))" + have bd:"disjoint_family b" + using nat_neq_iff by(fastforce simp: disjoint_family_on_def b_def) + have bin:"b i \ sigma_sets_cinter_dunion (topspace S) {U. openin S U}" for i + unfolding b_def + apply(rule sigma_sets_cinter_dunion_int) + using ca(2)[of i] + apply auto[1] + apply(rule Inter_cd) using ca by auto + have bun:"topspace S - (\ (range a)) = (\i. b i)" (is "?lhs = ?rhs") + proof - + { fix x + have "x \ ?lhs \ x \ topspace S \ x \ (\i. topspace S - a i)" + by auto + also have "... \ x \ topspace S \ (\n. x \ topspace S - a n)" + by auto + also have "... \ x \ topspace S \ (\n. x \ topspace S - a n \ (\i a i))" + proof safe + fix n + assume 1:"x \ a n" "x \ topspace S" + define N where "N \ Min {m. m \ n \ x \ a m}" + have N:"x \ a N" "N \ n" + using linorder_class.Min_in[of "{m. m \ n \ x \ a m}"] 1 + by(auto simp: N_def) + have N':"x \ a i" if "i < N" for i + proof(rule ccontr) + assume "x \ a i" + then have "N \ i" + using linorder_class.Min_le[of "{m. m \ n \ x \ a m}" i] that N(2) + by(auto simp: N_def) + with that show False by auto + qed + show "\n. x \ topspace S - a n \ (\i a i)" + using N N' by(auto intro!: exI[where x=N] 1) + qed auto + also have "... \ x \ ?rhs" + by(auto simp: b_def) + finally have "x \ ?lhs \ x \ ?rhs" . } + thus ?thesis by auto + qed + have "... \ sigma_sets_cinter_dunion (topspace S) {U. openin S U}" + by(rule Union_cd) (use bin bd in auto) + thus ?case + using Inter_cd[of a,OF ca(1)] by(auto simp: bun) + next + case ca:(Union_cd a) + have "topspace S - (\ (range a)) = (\i. (topspace S - a i))" + by simp + have "... \ sigma_sets_cinter_dunion (topspace S) {U. openin S U}" + by(rule Inter_cd) (use ca in auto) + then show ?case + using Union_cd[of a,OF ca(1,2)] by auto + qed + qed + fix a + assume "a \ sigma_sets (topspace S) {U. openin S U}" + then show "a \ sigma_sets_cinter_dunion (topspace S) {U. openin S U}" + proof induction + case a:(Union a) + define b where "b \ (\n. a n \ (\i. if i < n then topspace S - a i else topspace S))" + have bd:"disjoint_family b" + by(auto simp: disjoint_family_on_def b_def) (metis Diff_iff UnCI image_eqI linorder_neqE_nat mem_Collect_eq) + have bin:"b i \ sigma_sets_cinter_dunion (topspace S) {U. openin S U}" for i + unfolding b_def + apply(rule sigma_sets_cinter_dunion_int) + using a(2)[of i] + apply auto[1] + apply(rule Inter_cd) using c a by auto + have bun:"(\i. a i) = (\i. b i)" (is "?lhs = ?rhs") + proof - + { + fix x + have "x \ ?lhs \ x \ topspace S \ x \ ?lhs" + using sigma_sets_cinter_dunion_into_sp[OF _ a(2)] + by (metis UN_iff subsetD subset_Pow_Union topspace_def) + also have "... \ x \ topspace S \ (\n. x \ a n)" by auto + also have "... \ x \ topspace S \ (\n. x \ a n \ (\i topspace S - a i))" + proof safe + fix n + assume 1:"x \ topspace S" "x \ a n" + define N where "N \ Min {m. m \ n \ x \ a m}" + have N:"x \ a N" "N \ n" + using linorder_class.Min_in[of "{m. m \ n \ x \ a m}"] 1 + by(auto simp: N_def) + have N':"x \ a i" if "i < N" for i + proof(rule ccontr) + assume "\ x \ a i" + then have "N \ i" + using linorder_class.Min_le[of "{m. m \ n \ x \ a m}" i] that N(2) + by(auto simp: N_def) + with that show False by auto + qed + show "\n. x \ a n \ (\i topspace S - a i)" + using N N' 1 by(auto intro!: exI[where x=N]) + qed auto + also have "... \ x \ ?rhs" + proof safe + fix m + assume "x \ b m" + then show "x \ topspace S" "\n. x \ a n \ (\i topspace S - a i)" + by(auto intro!: exI[where x=m] simp: b_def) + qed(auto simp: b_def) + finally have "x \ ?lhs \ x \ ?rhs" . } + thus ?thesis by auto + qed + have "... \ sigma_sets_cinter_dunion (topspace S) {U. openin S U}" + by(rule Union_cd) (use bin bd in auto) + thus ?case + by(auto simp: bun) + qed(use c in auto) +qed + +lemma(in metrizable) sigma_sets_eq_cinter: + "sigma_sets (topspace S) {U. openin S U} = sigma_sets_cinter (topspace S) {U. openin S U}" +proof safe + fix a + interpret sa: sigma_algebra "topspace S" "sigma_sets (topspace S) {U. openin S U}" + by(auto intro!: sigma_algebra_sigma_sets openin_subset) + assume "a \ sigma_sets_cinter (topspace S) {U. openin S U}" + then show "a \ sigma_sets (topspace S) {U. openin S U}" + by induction auto +qed (use sigma_sets_cinter_dunion_subset sigma_sets_eq_cinter_dunion in auto) + + +lemma continuous_map_measurable: + assumes "continuous_map X Y f" + shows "f \ borel_of X \\<^sub>M borel_of Y" +proof(rule measurable_sigma_sets[OF sets_borel_of[of Y]]) + show "{U. openin Y U} \ Pow (topspace Y)" + by (simp add: subset_Pow_Union topspace_def) +next + show "f \ space (borel_of X) \ topspace Y" + using continuous_map_image_subset_topspace[OF assms] + by(auto simp: space_borel_of) +next + fix U + assume "U \ {U. openin Y U}" + then have "openin X (f -` U \ topspace X)" + using continuous_map[of X Y f] assms by auto + thus "f -` U \ space (borel_of X) \ sets (borel_of X)" + by(simp add: space_borel_of sets_borel_of) +qed + +lemma open_map_preserves_sets: + assumes "open_map S T f" "inj_on f (topspace S)" "A \ sets (borel_of S)" + shows "f ` A \ sets (borel_of T)" + using assms(3)[simplified sets_borel_of] +proof(induction) + case (Basic a) + with assms(1) show ?case + by(auto simp: sets_borel_of open_map_def) +next + case Empty + show ?case by simp +next + case (Compl a) + moreover have "f ` (topspace S - a) = f ` (topspace S) - f ` a" + by (metis Diff_subset assms(2) calculation(1) inj_on_image_set_diff sigma_sets_into_sp subset_Pow_Union topspace_def) + moreover have "f ` (topspace S) \ sets (borel_of T)" + by (meson assms(1) borel_of_open open_map_def openin_topspace) + ultimately show ?case + by auto +next + case (Union a) + then show ?case + by (simp add: image_UN) +qed + +lemma open_map_preserves_sets': + assumes "open_map S (subtopology T (f ` (topspace S))) f" "inj_on f (topspace S)" "f ` (topspace S) \ sets (borel_of T)" "A \ sets (borel_of S)" + shows "f ` A \ sets (borel_of T)" + using assms(4)[simplified sets_borel_of] +proof(induction) + case (Basic a) + then have "openin (subtopology T (f ` (topspace S))) (f ` a)" + using assms(1) by(auto simp: open_map_def) + hence "f ` a \ sets (borel_of (subtopology T (f ` (topspace S))))" + by(simp add: sets_borel_of) + hence "f ` a \ sets (restrict_space (borel_of T) (f ` (topspace S)))" + by(simp add: borel_of_subtopology) + thus ?case + by (metis sets_restrict_space_iff assms(3) sets.Int_space_eq2) +next + case Empty + show ?case by simp +next + case (Compl a) + moreover have "f ` (topspace S - a) = f ` (topspace S) - f ` a" + by (metis Diff_subset assms(2) calculation(1) inj_on_image_set_diff sigma_sets_into_sp subset_Pow_Union topspace_def) + ultimately show ?case + using assms(3) by auto +next + case (Union a) + then show ?case + by (simp add: image_UN) +qed + + +text \ Abstract topology version of @{thm second_countable_borel_measurable}. \ +lemma borel_of_second_countable': + assumes "second_countable S" and "subbase_of S \" + shows "borel_of S = sigma (topspace S) \" + unfolding borel_of_def +proof(rule sigma_eqI) + show "{U. openin S U} \ Pow (topspace S)" + by (simp add: subset_Pow_Union topspace_def) +next + show "\ \ Pow (topspace S)" + using subbase_of_subset[OF assms(2)] by auto +next + interpret s: sigma_algebra "topspace S" "sigma_sets (topspace S) \" + using subbase_of_subset[OF assms(2)] by(auto intro!: sigma_algebra_sigma_sets) + obtain \ where ho: "countable \" "base_of S \" + using assms(1) by(auto simp: second_countable_def) + show "sigma_sets (topspace S) {U. openin S U} = sigma_sets (topspace S) \" + proof(rule sigma_sets_eqI) + fix U + assume "U \ {U. openin S U}" + then have "generate_topology_on \ U" + using assms(2) by(simp add: subbase_of_def openin_topology_generated_by_iff) + thus "U \ sigma_sets (topspace S) \" + proof induction + case (UN K) + with ho(2) obtain V where hv: + "\k. k \ K \ V k \ \" "\k. k \ K \ \ (V k) = k" + by(simp add: base_of_def openin_topology_generated_by_iff[symmetric] assms(2)[simplified subbase_of_def,symmetric]) metis + define \k where "\k = (\k\K. V k)" + have 0:"countable \k" + using hv by(auto intro!: countable_subset[OF _ ho(1)] simp: \k_def) + have "\ \k = (\A\\k. A)" by auto + also have "... = \ K" + unfolding \k_def UN_simps by(simp add: hv(2)) + finally have 1:"\ \k = \ K" . + have "\b\\k. \k\K. b \ k" + using hv by (auto simp: \k_def) + then obtain V' where hv': "\b. b \ \k \ V' b \ K" and "\b. b \ \k \ b \ V' b" + by metis + then have "(\b\\k. V' b) \ \K" "\\k \ (\b\\k. V' b)" + by auto + then have "\K = (\b\\k. V' b)" + unfolding 1 by auto + also have "\ \ sigma_sets (topspace S) \" + using hv' UN by(auto intro!: s.countable_UN' simp: 0) + finally show "\K \ sigma_sets (topspace S) \" . + qed auto + next + fix U + assume "U \ \" + from assms(2)[simplified subbase_of_def] openin_topology_generated_by_iff generate_topology_on.Basis[OF this] + show "U \ sigma_sets (topspace S) {U. openin S U}" + by auto + qed +qed + +text \ Abstract topology version @{thm borel_prod}.\ +lemma borel_of_prod: + assumes "second_countable S" and "second_countable S'" + shows "borel_of S \\<^sub>M borel_of S' = borel_of (prod_topology S S')" +proof - + have "borel_of S \\<^sub>M borel_of S' = sigma (topspace S \ topspace S') {a \ b |a b. a \ {a. openin S a} \ b \ {b. openin S' b}}" + proof - + obtain \ \' where ho: + "countable \" "base_of S \" "countable \'" "base_of S' \'" + using assms by(auto simp: second_countable_def) + show ?thesis + unfolding borel_of_def + apply(rule sigma_prod) + using topology_generated_by_topspace[of \,simplified base_is_subbase[OF ho(2),simplified subbase_of_def,symmetric]] topology_generated_by_topspace[of \',simplified base_is_subbase[OF ho(4),simplified subbase_of_def,symmetric]] + base_of_openin[OF ho(2)] base_of_openin[OF ho(4)] + by(auto intro!: exI[where x=\] exI[where x=\'] simp: ho subset_Pow_Union topspace_def) + qed + also have "... = borel_of (prod_topology S S')" + using borel_of_second_countable'[OF prod_topology_second_countable[OF assms],simplified subbase_of_def,OF prod_topology_generated_by_open] + by simp + finally show ?thesis . +qed + +lemma product_borel_of_measurable: + assumes "i \ I" + shows "(\x. x i) \ (borel_of (product_topology S I)) \\<^sub>M borel_of (S i)" + by(auto intro!: continuous_map_measurable simp: assms) + + +text \ Abstract topology version of @{thm sets_PiM_subset_borel} \ +lemma sets_PiM_subset_borel_of: + "sets (\\<^sub>M i\I. borel_of (S i)) \ sets (borel_of (product_topology S I))" +proof - + have *: "(\\<^sub>E i\I. X i) \ sets (borel_of (product_topology S I))" if [measurable]:"\i. X i \ sets (borel_of (S i))" "finite {i. X i \ topspace (S i)}" for X + proof - + note [measurable] = product_borel_of_measurable + define I' where "I' = {i. X i \ topspace (S i)} \ I" + have "finite I'" unfolding I'_def using that by simp + have "(\\<^sub>E i\I. X i) = (\i\I'. (\x. x i)-`(X i) \ space (borel_of (product_topology S I))) \ space (borel_of (product_topology S I))" + proof(standard;standard) + fix x + assume "x \ Pi\<^sub>E I X" + then show "x \ (\i\I'. (\x. x i) -` X i \ space (borel_of (product_topology S I))) \ space (borel_of (product_topology S I))" + using sets.sets_into_space[OF that(1)] by(auto simp: PiE_def I'_def Pi_def space_borel_of) + next + fix x + assume 1:"x \ (\i\I'. (\x. x i) -` X i \ space (borel_of (product_topology S I))) \ space (borel_of (product_topology S I))" + have "x i \ X i" if hi:"i \ I" for i + proof - + consider "i \ I' \ I' \ {}" | "i \ I' \ I' = {}" | "i \ I' \ I' \ {}" by auto + then show ?thesis + apply cases + using sets.sets_into_space[OF \\i. X i \ sets (borel_of (S i))\] 1 that + by(auto simp: space_borel_of I'_def) + qed + then show "x \ Pi\<^sub>E I X" + using 1 by(auto simp: space_borel_of) + qed + also have "... \ sets (borel_of (product_topology S I))" + using that \finite I'\ by(auto simp: I'_def) + finally show ?thesis . + qed + then have "{Pi\<^sub>E I X |X. (\i. X i \ sets (borel_of (S i))) \ finite {i. X i \ space (borel_of (S i))}} \ sets (borel_of (product_topology S I))" + by(auto simp: space_borel_of) + show ?thesis unfolding sets_PiM_finite + by(rule sets.sigma_sets_subset',fact) (simp add: borel_of_open[OF openin_topspace, of "product_topology S I",simplified] space_borel_of) +qed + +text \ Abstract topology version of @{thm sets_PiM_equal_borel}.\ +lemma sets_PiM_equal_borel_of: + assumes "countable I" and "\i. i \ I \ second_countable (S i)" + shows "sets (\\<^sub>M i\I. borel_of (S i)) = sets (borel_of (product_topology S I))" +proof + obtain K where hk: + "countable K" "base_of (product_topology S I) K" + "\k. k \ K \ \X. (k = (\\<^sub>E i\I. X i)) \ (\i. openin (S i) (X i)) \ finite {i. X i \ topspace (S i)} \ {i. X i \ topspace (S i)} \ I" + using product_topology_countable_base_of[OF assms(1)] assms(2) + by force + have *:"k \ sets (\\<^sub>M i\I. borel_of (S i))" if "k \ K" for k + proof - + obtain X where H: "k = (\\<^sub>E i\I. X i)" "\i. openin (S i) (X i)" "finite {i. X i \ topspace (S i)}" "{i. X i \ topspace (S i)} \ I" + using hk(3)[OF \k \ K\] by blast + show ?thesis unfolding H(1) sets_PiM_finite + using borel_of_open[OF H(2)] H(3) by(auto simp: space_borel_of) + qed + have **: "U \ sets (\\<^sub>M i\I. borel_of (S i))" if "openin (product_topology S I) U" for U + proof - + obtain B where "B \ K" "U = (\B)" + using \openin (product_topology S I) U\ \base_of (product_topology S I) K\ by (metis base_of_def) + have "countable B" using \B \ K\ \countable K\ countable_subset by blast + moreover have "k \ sets (\\<^sub>M i\I. borel_of (S i))" if "k \ B" for k + using \B \ K\ * that by auto + ultimately show ?thesis unfolding \U = (\B)\ by auto + qed + have "sigma_sets (topspace (product_topology S I)) {U. openin (product_topology S I) U} \ sets (\\<^sub>M i\I. borel_of (S i))" + apply (rule sets.sigma_sets_subset') using ** by(auto intro!: sets_PiM_I_countable[OF assms(1)] simp: borel_of_open[OF openin_topspace]) + thus " sets (borel_of (product_topology S I)) \ sets (\\<^sub>M i\I. borel_of (S i))" + by (simp add: subset_Pow_Union topspace_def borel_of_def) +qed(rule sets_PiM_subset_borel_of) + + + +lemma homeomorphic_map_borel_isomorphic: + assumes "homeomorphic_map X Y f" + shows "measurable_isomorphic_map (borel_of X) (borel_of Y) f" +proof - + obtain g where "homeomorphic_maps X Y f g" + using assms by(auto simp: homeomorphic_map_maps) + hence "continuous_map X Y f" "continuous_map Y X g" + "\x. x \ topspace X \ g (f x) = x" + "\y. y \ topspace Y \ f (g y) = y" + by(auto simp: homeomorphic_maps_def) + thus ?thesis + by(auto intro!: measurable_isomorphic_map_byWitness dest: continuous_map_measurable simp: space_borel_of) +qed + +lemma homeomorphic_space_measurable_isomorphic: + assumes "S homeomorphic_space T" + shows "borel_of S measurable_isomorphic borel_of T" + using homeomorphic_map_borel_isomorphic[of S T] assms by(auto simp: measurable_isomorphic_def homeomorphic_space) + + +lemma measurable_isomorphic_borel_map: + assumes "sets M = sets (borel_of S)" and f: "measurable_isomorphic_map M N f" + shows "\S'. homeomorphic_map S S' f \ sets N = sets (borel_of S')" +proof - + obtain g where fg:"f \ M \\<^sub>M N" "g \ N \\<^sub>M M" "\x. x\space M \ g (f x) = x" "\y. y\space N \ f (g y) = y" "\A. A\sets M \ f ` A \ sets N" "\A. A\sets N \ g ` A \ sets M" "bij_betw g (space N) (space M)" + using measurable_isomorphic_mapD'[OF f] by metis + have g:"measurable_isomorphic_map N M g" + by(auto intro!: measurable_isomorphic_map_byWitness fg) + have g':"bij_betw g (space N) (topspace S)" + using fg(7) sets_eq_imp_space_eq[OF assms(1)] by(auto simp: space_borel_of) + show ?thesis + proof(intro exI[where x="pullback_topology (space N) g S"] conjI) + have [simp]: "{U. openin (pullback_topology (space N) g S) U} = (`) f ` {U. openin S U}" + unfolding openin_pullback_topology'[OF g'] + proof safe + fix u + assume u:"openin S u" + then have 1:"u \ space M" + by(simp add: sets_eq_imp_space_eq[OF assms(1)] space_borel_of openin_subset) + with fg(3) have "g ` f ` u = u" + by(fastforce simp: image_def) + with u show "openin S (g ` f ` u)" by simp + fix x + assume "x \ u" + with 1 fg(1) show "f x \ space N" by(auto simp: measurable_space) + next + fix u + assume "openin S (g ` u)" "u \ space N" + with fg(4) show "u \ (`) f ` {U. openin S U}" + by(auto simp: image_def intro!: exI[where x="g ` u"]) (metis in_mono) + qed + have [simp]:"g -` topspace S \ space N = space N" + using bij_betw_imp_surj_on g' by blast + show "sets N = sets (borel_of (pullback_topology (space N) g S))" + by(auto simp: sets_borel_of topspace_pullback_topology intro!: measurable_isomorphic_map_sigma_sets[OF assms(1)[simplified sets_borel_of space_borel_of[symmetric] sets_eq_imp_space_eq[OF assms(1),symmetric]] f]) + next + show "homeomorphic_map S (pullback_topology (space N) g S) f" + proof(rule homeomorphic_maps_imp_map[where g=g]) + obtain f' where f':"homeomorphic_maps (pullback_topology (space N) g S) S g f'" + using topology_from_bij(1)[OF g'] homeomorphic_map_maps by blast + have f'2:"f' y = f y" if y:"y \ topspace S" for y + proof - + have [simp]:"g -` topspace S \ space N = space N" + using bij_betw_imp_surj_on g' by blast + obtain x where "x \ space N" "y = g x" + using g' y by(auto simp: bij_betw_def image_def) + thus ?thesis + using fg(4) f' by(auto simp: homeomorphic_maps_def topspace_pullback_topology) + qed + thus "homeomorphic_maps S (pullback_topology (space N) g S) f g" + by(auto intro!: homeomorphic_maps_eq[OF f'] simp: homeomorphic_maps_sym[of S]) + qed + qed +qed + +lemma measurable_isomorphic_borels: + assumes "sets M = sets (borel_of S)" "M measurable_isomorphic N" + shows "\S'. S homeomorphic_space S' \ sets N = sets (borel_of S')" + using measurable_isomorphic_borel_map[OF assms(1)] assms(2) homeomorphic_map_maps + by(fastforce simp: measurable_isomorphic_def homeomorphic_space_def ) + +lemma(in polish_topology) closedin_clopen_topology: + assumes "closedin S a" + shows "\S'. polish_topology S' \ (\u. openin S u \ openin S' u) \ topspace S = topspace S' \ sets (borel_of S) = sets (borel_of S') \ openin S' a \ closedin S' a" +proof - + have "polish_topology (subtopology S a)" + by(rule closedin_polish[OF assms]) + from polish_topology.bounded_polish_metric[OF this] obtain da where da: + "polish_metric_set a da" "subtopology S a = metric_set.mtopology a da" "\x y. da x y < 1" + by (metis topspace_subtopology_subset closedin_subset[OF assms]) + interpret pa: polish_metric_set a da by fact + have "polish_topology (subtopology S (topspace S - a))" + using assms by(auto intro!: openin_polish) + from polish_topology.bounded_polish_metric[OF this] + obtain db where db: "polish_metric_set (topspace S - a) db" "subtopology S (topspace S - a) = metric_set.mtopology (topspace S - a) db" "\x y. db x y < 1" + by (metis Diff_subset topspace_subtopology_subset) + interpret pb: polish_metric_set "topspace S - a" db by fact + interpret p: sum_polish_metric UNIV "\b. if b then a else topspace S - a" "\b. if b then da else db" + using da db by(auto intro!: sum_polish_metricI simp: disjoint_family_on_def) + have 0: "(\i. if i then a else topspace S - a) = topspace S" + using closedin_subset assms by auto + + have 1: "sets (borel_of S) = sets (borel_of p.mtopology)" + proof - + have "sigma_sets (topspace S) (Collect (openin S)) = sigma_sets (topspace S) (Collect (openin p.mtopology))" + proof(rule sigma_sets_eqI) + fix a + assume "a \ Collect (openin S)" + then have "openin p.mtopology a" + by(simp only: p.openin_sum_mtopology_iff) (auto simp: 0 da(2)[symmetric] db(2)[symmetric] openin_subtopology dest:openin_subset) + thus "a \ sigma_sets (topspace S) (Collect (openin p.mtopology))" + by auto + next + interpret s: sigma_algebra "topspace S" "sigma_sets (topspace S) (Collect (openin S))" + by(auto intro!: sigma_algebra_sigma_sets openin_subset) + fix b + assume "b \ Collect (openin p.mtopology)" + then have "openin p.mtopology b" by auto + then have b:"b \ topspace S" "openin (subtopology S a) (b \ a)" "openin (subtopology S (topspace S - a)) (b \ (topspace S - a))" + by(simp_all only: p.openin_sum_mtopology_iff,insert 0 da(2) db(2)) (auto simp: all_bool_eq) + have [simp]: "(b \ a) \ (b \ (topspace S - a)) = b" + using Diff_partition b(1) by blast + have "(b \ a) \ (b \ (topspace S - a)) \ sigma_sets (topspace S) (Collect (openin S))" + proof(rule sigma_sets_Un) + have [simp]:"a \ sigma_sets (topspace S) (Collect (openin S))" + proof - + have "topspace S - (topspace S - a) \ sigma_sets (topspace S) (Collect (openin S))" + by(rule sigma_sets.Compl) (use assms in auto) + thus ?thesis + using double_diff[OF closedin_subset[OF assms]] by simp + qed + from b(2,3) obtain T T' where T:"openin S T" "openin S T'" and [simp]:"b \ a = T \ a" "b \ (topspace S - a) = T' \ (topspace S - a)" + by(auto simp: openin_subtopology) + show "b \ a \ sigma_sets (topspace S) (Collect (openin S))" + "b \ (topspace S - a) \ sigma_sets (topspace S) (Collect (openin S))" + using T assms by auto + qed + thus "b \ sigma_sets (topspace S) (Collect (openin S))" + by simp + qed + thus ?thesis + by(simp only: sets_borel_of p.mtopology_topspace) (use 0 in auto) + qed + have 2:"\u. openin S u \ openin p.mtopology u" + by(simp only: p.openin_sum_mtopology_iff) (auto simp: all_bool_eq da(2)[symmetric] db(2)[symmetric] openin_subtopology dest:openin_subset) + have 3:"openin p.mtopology a" + by(simp only: p.openin_sum_mtopology_iff) (auto simp: all_bool_eq) + have 4:"closedin p.mtopology a" + by (metis 0 2 assms closedin_def p.mtopology_topspace) + have 5: "topspace S = topspace p.mtopology" + by(simp only: p.mtopology_topspace) (simp only: 0) + have 6: "polish_topology p.mtopology" + using p.polish_topology_axioms by blast + show ?thesis + by(rule exI[where x=p.mtopology]) (insert 5 2 6, simp only: 1 3 4 ,auto) +qed + +lemma polish_topology_union_polish: + fixes X :: "nat \ 'a topology" + assumes "\n. polish_topology (X n)" "\n. topspace (X n) = Xt" "\x y. x \ Xt \ y \ Xt \ x \ y \ \Ox Oy. (\n. openin (X n) Ox) \ (\n. openin (X n) Oy) \ x \ Ox \ y \ Oy \ disjnt Ox Oy" + defines "Xun \ topology_generated_by (\n. {u. openin (X n) u})" + shows "polish_topology Xun" +proof - + have topsXun:"topspace Xun = Xt" + using assms(2) by(auto simp: Xun_def dest:openin_subset) + define f :: "'a \ nat \ 'a" where "f \ (\x n. x)" + have "continuous_map Xun (product_topology X UNIV) f" + by(auto simp: assms(2) topsXun f_def continuous_map_componentwise, auto simp: Xun_def openin_topology_generated_by_iff continuous_map_def assms(2) dest:openin_subset[of "X _",simplified assms(2)] ) + (insert openin_subopen, fastforce intro!: generate_topology_on.Basis) + hence 1: "continuous_map Xun (subtopology (product_topology X UNIV) (f ` (topspace Xun))) f" + by(auto simp: continuous_map_in_subtopology) + have 2: "inj_on f (topspace Xun)" + by(auto simp: inj_on_def f_def dest:fun_cong) + have 3: "f ` (topspace Xun) = topspace (subtopology (product_topology X UNIV) (f ` (topspace Xun)))" + by(auto simp: topsXun assms(2) f_def) + have 4: "open_map Xun (subtopology (product_topology X UNIV) (f ` (topspace Xun))) f" + proof(safe intro!: open_map_generated_topo[OF _ 2[simplified Xun_def],simplified Xun_def[symmetric]]) + fix u n + assume u:"openin (X n) u" + show "openin (subtopology (product_topology X UNIV) (f ` topspace Xun)) (f ` u)" + unfolding openin_subtopology + proof(safe intro!: exI[where x="{ \i. if i = n then a else b i |a b. a \u \ b \ UNIV \ Xt}"]) + show "openin (product_topology X UNIV) {\i. if i = n then a else b i |a b. a \u \ b \ UNIV \ Xt}" + by(auto simp: openin_product_topology_alt u assms(2) openin_topspace[of "X _",simplified assms(2)] intro!: exI[where x="\i. if i = n then u else Xt"]) + (auto simp: PiE_def Pi_def, metis openin_subset[OF u,simplified assms(2)] in_mono) + next + show "\y. y \ u \ \a b. f y = (\i. if i = n then a else b i) \ a \ u \ b \ UNIV \ Xt" + using assms(2) f_def openin_subset u by fastforce + next + show "\y. y \ u \ f y \ f ` topspace Xun" + using openin_subset[OF u] by(auto simp: assms(2) topsXun) + next + show "\x xa a b. xa \ topspace Xun \ f xa = (\i. if i = n then a else b i) \ a \ u \ b \ UNIV \ Xt \ f xa \ f ` u" + using openin_subset[OF u] by(auto simp: topsXun assms(2)) (metis f_def imageI) + qed + qed + have 5:"(subtopology (product_topology X UNIV) (f ` topspace Xun)) homeomorphic_space Xun" + using homeomorphic_map_imp_homeomorphic_space[OF bijective_open_imp_homeomorphic_map[OF 1 4 3 2]] + by(simp add: homeomorphic_space_sym[of Xun]) + show ?thesis + proof(safe intro!: polish_topology.homeomorphic_polish_topology[OF polish_topology.closedin_polish[OF polish_topology_product] 5] assms) + show "closedin (product_topology X UNIV) (f ` topspace Xun)" + proof - + have 1: "openin (product_topology X UNIV) ((UNIV \\<^sub>E Xt) - f ` Xt)" + proof(rule openin_subopen[THEN iffD2]) + show "\x\(UNIV \\<^sub>E Xt) - f ` Xt. \T. openin (product_topology X UNIV) T \ x \ T \ T \ (UNIV \\<^sub>E Xt) - f ` Xt" + proof safe + fix x + assume x:"x \ UNIV \\<^sub>E Xt" "x \ f ` Xt" + have "\n. x n \ x 0" + proof(rule ccontr) + assume " \n. x n \ x 0" + then have "\n. x n = x 0" by auto + hence "x = (\_. x 0)" by auto + thus False + using x by(auto simp: f_def topsXun assms(2)) + qed + then obtain n where n: "n \ 0" "x n \ x 0" + by metis + from assms(3)[OF _ _ this(2)] x + obtain On O0 where h:"\n. openin (X n) On" "\n. openin (X n) O0" "x n \ On" "x 0 \ O0" "disjnt On O0" + by fastforce + have "openin (product_topology X UNIV) ((\x. x 0) -` O0 \ topspace (product_topology X UNIV))" + using continuous_map_product_coordinates[of 0 UNIV X] h(2)[of 0] by blast + moreover have "openin (product_topology X UNIV) ((\x. x n) -` On \ topspace (product_topology X UNIV))" + using continuous_map_product_coordinates[of n UNIV X] h(1)[of n] by blast + ultimately have op: "openin (product_topology X UNIV) ((\T. T 0) -` O0 \ topspace (product_topology X UNIV) \ ((\T. T n) -` On \ topspace (product_topology X UNIV)))" + by auto + have xin:"x \ (\T. T 0) -` O0 \ topspace (product_topology X UNIV) \ ((\T. T n) -` On \ topspace (product_topology X UNIV))" + using x h(3,4) by(auto simp: assms(2)) + have subset:"(\T. T 0) -` O0 \ topspace (product_topology X UNIV) \ ((\T. T n) -` On \ topspace (product_topology X UNIV)) \ (UNIV \\<^sub>E Xt) - f ` Xt" + using h(5) by(auto simp: assms(2) disjnt_def f_def) + + show "\T. openin (product_topology X UNIV) T \ x \ T \ T \ (UNIV \\<^sub>E Xt) - f ` Xt" + by(rule exI[where x="((\x. x 0) -` O0 \ topspace (product_topology X UNIV)) \ ((\x. x n) -` On \ topspace (product_topology X UNIV))"]) (use op xin subset in auto) + qed + qed + + thus ?thesis + by(auto simp: closedin_def assms(2) topsXun f_def) + qed + qed(simp add: f_def) +qed + +lemma(in polish_topology) sets_clopen_topology: + assumes "a \ sets (borel_of S)" + shows "\S'. polish_topology S' \ (\u. openin S u \ openin S' u) \ topspace S = topspace S' \ sets (borel_of S) = sets (borel_of S') \ openin S' a \ closedin S' a" +proof - + have "a \ sigma_sets (topspace S) {U. closedin S U}" + using assms by(simp add: sets_borel_of_closed) + thus ?thesis + proof induction + case (Basic a) + then show ?case + by(simp add: closedin_clopen_topology) + next + case Empty + with polish_topology_axioms show ?case + by auto + next + case (Compl a) + then obtain S' where S':"polish_topology S'" "(\u. openin S u \ openin S' u)" "topspace S = topspace S'" "sets (borel_of S) = sets (borel_of S')" "openin S' a" "closedin S' a" + by auto + from polish_topology.closedin_clopen_topology[OF S'(1) S'(6)] S' + show ?case by auto + next + case ih:(Union a) + then obtain Si where Si: + "\i. polish_topology (Si i)" "\u i. openin S u \ openin (Si i) u" "\i::nat. topspace S = topspace (Si i)" "\i. sets (borel_of S) = sets (borel_of (Si i))" "\i. openin (Si i) (a i)" "\i. closedin (Si i) (a i)" + by metis + define Sun where "Sun \ topology_generated_by (\n. {u. openin (Si n) u})" + have Sun1: "polish_topology Sun" + unfolding Sun_def + proof(safe intro!: polish_topology_union_polish[where Xt="topspace S"]) + fix x y + assume xy:"x \ topspace S" "y \ topspace S" "x \ y" + then obtain Ox Oy where Oxy: "x \ Ox" "y \ Oy" "openin S Ox" "openin S Oy" "disjnt Ox Oy" + using Hausdorff by(auto simp: Hausdorff_space_def) metis + show "\Ox Oy. (\x. openin (Si x) Ox) \ (\x. openin (Si x) Oy) \ x \ Ox \ y \ Oy \ disjnt Ox Oy" + by(rule exI[where x=Ox],insert Si(2) Oxy, auto intro!: exI[where x=Oy]) + qed (use Si in auto) + have Suntop:"topspace S = topspace Sun" + using Si(3) by(auto simp: Sun_def dest: openin_subset) + have Sunsets: "sets (borel_of S) = sets (borel_of Sun)" (is "?lhs = ?rhs") + proof - + have "?lhs = sigma_sets (topspace S) (\n. {u. openin (Si n) u})" + proof + show "sets (borel_of S) \ sigma_sets (topspace S) (\n. {u. openin (Si n) u})" + using Si(2) by(auto simp: sets_borel_of intro!: sigma_sets_mono') + next + show "sigma_sets (topspace S) (\n. {u. openin (Si n) u}) \ sets (borel_of S)" + by(simp add: sigma_sets_le_sets_iff[of "borel_of S" "\n. {u. openin (Si n) u}",simplified space_borel_of]) (use Si(4) sets_borel_of in fastforce) + qed + also have "... = ?rhs" + using borel_of_second_countable'[OF polish_topology.S_second_countable[OF Sun1],of "\n. {u. openin (Si n) u}"] + by (simp add: Sun_def Suntop subbase_of_def subset_Pow_Union) + finally show ?thesis . + qed + have Sun_open: "\u i. openin (Si i) u \ openin Sun u" + by(auto simp: Sun_def openin_topology_generated_by_iff intro!: generate_topology_on.Basis) + have Sun_opena: "openin Sun (\i. a i)" + using Sun_open[OF Si(5),simplified Sun_def] by(auto simp: Sun_def openin_topology_generated_by_iff intro!: generate_topology_on.UN) + hence "closedin Sun (topspace Sun - (\i. a i))" + by auto + from polish_topology.closedin_clopen_topology[OF Sun1 this] + show ?case + using Suntop Sunsets Sun_open[OF Si(2)] Sun_opena + by (metis closedin_def openin_closedin_eq) + qed +qed + +end \ No newline at end of file diff --git a/thys/Standard_Borel_Spaces/Lemmas_StandardBorel.thy b/thys/Standard_Borel_Spaces/Lemmas_StandardBorel.thy new file mode 100644 --- /dev/null +++ b/thys/Standard_Borel_Spaces/Lemmas_StandardBorel.thy @@ -0,0 +1,2323 @@ +(* Title: Lemmas_StandardBorel.thy + Author: Michikazu Hirata, Tokyo Institute of Technology +*) + +text \ We refer to the HOL-Analysis library, + the textbooks by Matsuzaka~\cite{topology} and Srivastava~\cite{borelsets}, + and the lecture note by Biskup~\cite{standardborel}.\ + +section \Lemmas\ +theory Lemmas_StandardBorel + imports "HOL-Probability.Probability" +begin + +subsection \Lemmas for Abstract Topology\ + +subsubsection \ Generated By \ +lemma topology_generated_by_sub: + assumes "\U. U \ \ \ (openin X U)" + and "openin (topology_generated_by \) U" + shows "openin X U" +proof - + have "generate_topology_on \ U" + by (simp add: assms(2) openin_topology_generated_by) + then show ?thesis + by induction (use assms(1) in auto) +qed + +lemma topology_generated_by_open: + "S = topology_generated_by {U | U . openin S U}" + unfolding topology_eq +proof standard+ + fix U + assume "openin (topology_generated_by {U |U. openin S U}) U" + note this[simplified openin_topology_generated_by_iff] + then show "openin S U" + by induction auto +qed(simp add: openin_topology_generated_by_iff generate_topology_on.Basis) + +lemma topology_generated_by_eq: + assumes "\U. U \ \ \ (openin (topology_generated_by \) U)" + and "\U. U \ \ \ (openin (topology_generated_by \) U)" + shows "topology_generated_by \ = topology_generated_by \" + using topology_generated_by_sub[of \, OF assms(1)] topology_generated_by_sub[of \,OF assms(2)] + by(auto simp: topology_eq) + +lemma topology_generated_by_homeomorphic_spaces: + assumes "homeomorphic_map X Y f" "X = topology_generated_by \" + shows "Y = topology_generated_by ((`) f ` \)" + unfolding topology_eq +proof + have f:"open_map X Y f" "inj_on f (topspace X)" + using assms(1) by (simp_all add: homeomorphic_imp_open_map perfect_injective_eq_homeomorphic_map[symmetric]) + obtain g where g: "\x. x \ topspace X \ g (f x) = x" "\y. y \ topspace Y \ f (g y) = y" "open_map Y X g" "inj_on g (topspace Y)" + using homeomorphic_map_maps[of X Y f,simplified assms(1)] homeomorphic_imp_open_map homeomorphic_maps_map[of X Y f] homeomorphic_imp_injective_map[of Y X] by blast + show "\S. openin Y S = openin (topology_generated_by ((`) f ` \)) S" + proof safe + fix S + assume "openin Y S" + then have "openin X (g ` S)" + using g(3) by (simp add: open_map_def) + hence h:"generate_topology_on \ (g ` S)" + by(simp add: assms(2) openin_topology_generated_by_iff) + have "S = f ` (g ` S)" + using openin_subset[OF \openin Y S\] g(2) by(fastforce simp: image_def) + also have "openin (topology_generated_by ((`) f ` \)) ..." + using h + proof induction + case Empty + then show ?case by simp + next + case (Int a b) + with inj_on_image_Int[OF f(2),of a b] show ?case + by (metis assms(2) openin_Int openin_subset openin_topology_generated_by_iff) + next + case (UN K) + then show ?case + by(auto simp: image_Union) + next + case (Basis s) + then show ?case + by(auto intro!: generate_topology_on.Basis simp: openin_topology_generated_by_iff) + qed + finally show "openin (topology_generated_by ((`) f ` \)) S" . + next + fix S + assume "openin (topology_generated_by ((`) f ` \)) S" + then have "generate_topology_on ((`) f ` \) S" + by(simp add: openin_topology_generated_by_iff) + thus "openin Y S" + proof induction + case (Basis s) + then obtain U where u:"U \ \" "s = f ` U" by auto + then show ?case + using assms(1) assms(2) homeomorphic_map_openness_eq topology_generated_by_Basis by blast + qed auto + qed +qed + +lemma open_map_generated_topo: + assumes "\u. u \ U \ openin S (f ` u)" "inj_on f (topspace (topology_generated_by U))" + shows "open_map (topology_generated_by U) S f" + unfolding open_map_def +proof safe + fix u + assume "openin (topology_generated_by U) u" + then have "generate_topology_on U u" + by(simp add: openin_topology_generated_by_iff) + thus "openin S (f ` u)" + proof induction + case (Int a b) + then have [simp]:"f ` (a \ b) = f ` a \ f ` b" + by (meson assms(2) inj_on_image_Int openin_subset openin_topology_generated_by_iff) + from Int show ?case by auto + qed (simp_all add: image_Union openin_clauses(3) assms) +qed + +lemma subtopology_generated_by: + "subtopology (topology_generated_by \) T = topology_generated_by {T \ U | U. U \ \}" + unfolding topology_eq openin_subtopology openin_topology_generated_by_iff +proof safe + fix A + assume "generate_topology_on \ A" + then show "generate_topology_on {T \ U |U. U \ \} (A \ T)" + proof induction + case Empty + then show ?case + by (simp add: generate_topology_on.Empty) + next + case (Int a b) + moreover have "a \ b \ T = (a \ T) \ (b \ T)" by auto + ultimately show ?case + by(auto intro!: generate_topology_on.Int) + next + case (UN K) + moreover have "(\ K \ T) = (\ { k \ T | k. k \ K})" by auto + ultimately show ?case + by(auto intro!: generate_topology_on.UN) + next + case (Basis s) + then show ?case + by(auto intro!: generate_topology_on.Basis) + qed +next + fix A + assume "generate_topology_on {T \ U |U. U \ \} A" + then show "\L. generate_topology_on \ L \ A = L \ T" + proof induction + case Empty + show ?case + by(auto intro!: exI[where x="{}"] generate_topology_on.Empty) + next + case ih:(Int a b) + then obtain La Lb where + "generate_topology_on \ La" "a = La \ T" "generate_topology_on \ Lb" "b = Lb \ T" + by auto + thus ?case + using ih by(auto intro!: exI[where x="La \ Lb"] generate_topology_on.Int) + next + case ih:(UN K) + then obtain L where + "\k. k \ K \ generate_topology_on \ (L k) " "\k. k \ K \ k = (L k) \ T" + by metis + thus ?case + using ih by(auto intro!: exI[where x="\k\K. L k"] generate_topology_on.UN) + next + case (Basis s) + then show ?case + using generate_topology_on.Basis by fastforce + qed +qed + +lemma prod_topology_generated_by: + "topology_generated_by { U \ V | U V. U \ \ \ V \ \} = prod_topology (topology_generated_by \) (topology_generated_by \)" + unfolding topology_eq +proof safe + fix U + assume h:"openin (topology_generated_by {U \ V |U V. U \ \ \ V \ \}) U" + show "openin (prod_topology (topology_generated_by \) (topology_generated_by \)) U" + by(auto simp: openin_prod_Times_iff[of "topology_generated_by \" "topology_generated_by \"] + intro!: topology_generated_by_Basis topology_generated_by_sub[OF _ h]) +next + fix U + assume "openin (prod_topology (topology_generated_by \) (topology_generated_by \)) U" + then have "\z\U. \V1 V2. openin (topology_generated_by \) V1 \ openin (topology_generated_by \) V2 \ fst z \ V1 \ snd z \ V2 \ V1 \ V2 \ U" + by(auto simp: openin_prod_topology_alt) + hence "\V1. \z\U. \V2. openin (topology_generated_by \) (V1 z) \ openin (topology_generated_by \) V2 \ fst z \ (V1 z) \ snd z \ V2 \ (V1 z) \ V2 \ U" + by(rule bchoice) + then obtain V1 where "\z\U. \V2. openin (topology_generated_by \) (V1 z) \ openin (topology_generated_by \) V2 \ fst z \ (V1 z) \ snd z \ V2 \ (V1 z) \ V2 \ U" + by auto + hence "\V2. \z\U. openin (topology_generated_by \) (V1 z) \ openin (topology_generated_by \) (V2 z) \ fst z \ (V1 z) \ snd z \ (V2 z) \ (V1 z) \ (V2 z) \ U" + by(rule bchoice) + then obtain V2 where hv12:"\z. z\U \ openin (topology_generated_by \) (V1 z) \ openin (topology_generated_by \) (V2 z) \ fst z \ (V1 z) \ snd z \ (V2 z) \ (V1 z) \ (V2 z) \ U" + by auto + hence 1:"U = (\z\U. (V1 z) \ (V2 z))" + by auto + have "openin (topology_generated_by {U \ V |U V. U \ \ \ V \ \}) (\z\U. (V1 z) \ (V2 z))" + proof(rule openin_Union) + show "\S. S \ (\z. V1 z \ V2 z) ` U \ openin (topology_generated_by {U \ V |U V. U \ \ \ V \ \}) S" + proof safe + fix x y + assume h:"(x,y) \ U" + then have "generate_topology_on \ (V1 (x,y))" + using hv12 by(auto simp: openin_topology_generated_by_iff) + thus "openin (topology_generated_by {U \ V |U V. U \ \ \ V \ \}) (V1 (x, y) \ V2 (x, y))" + proof induction + case Empty + then show ?case by auto + next + case (Int a b) + thus ?case + by (auto simp: Sigma_Int_distrib1) + next + case (UN K) + then have "openin (topology_generated_by {U \ V |U V. U \ \ \ V \ \}) (\{ k \ V2 (x, y) | k. k \ K})" + by auto + moreover have "(\ {k \ V2 (x, y) |k. k \ K}) = (\ K \ V2 (x, y))" + by blast + ultimately show ?case by simp + next + case ho:(Basis s) + have "generate_topology_on \ (V2 (x,y))" + using h hv12 by(auto simp: openin_topology_generated_by_iff) + thus ?case + proof induction + case Empty + then show ?case by auto + next + case (Int a b) + then show ?case + by (auto simp: Sigma_Int_distrib2) + next + case (UN K) + then have "openin (topology_generated_by {U \ V |U V. U \ \ \ V \ \}) (\ { s \ k | k. k \K})" + by auto + moreover have "(\ { s \ k | k. k \K}) = s \ \K" + by blast + ultimately show ?case by simp + next + case (Basis s') + then show ?case + using ho by(auto intro!: topology_generated_by_Basis) + qed + qed + qed + qed + thus "openin (topology_generated_by {U \ V |U V. U \ \ \ V \ \}) U" + using 1 by auto +qed + +lemma prod_topology_generated_by_open: + "prod_topology S S' = topology_generated_by {U \ V | U V. openin S U \ openin S' V}" + using prod_topology_generated_by[of " {U |U. openin S U}" "{U |U. openin S' U}"] topology_generated_by_open[of S,symmetric] topology_generated_by_open[of S'] + by auto + +lemma product_topology_cong: + assumes "\i. i \ I \ S i = K i" + shows "product_topology S I = product_topology K I" +proof - + have 1:"{\\<^sub>E i\I. X i |X. (\i. openin (S i) (X i)) \ finite {i. X i \ topspace (S i)}} \ {\\<^sub>E i\I. X i |X. (\i. openin (K i) (X i)) \ finite {i. X i \ topspace (K i)}}" if "\i. i \ I \ S i = K i" for S K :: "_ \ 'b topology" + proof + fix x + assume hx:"x \ {\\<^sub>E i\I. X i |X. (\i. openin (S i) (X i)) \ finite {i. X i \ topspace (S i)}}" + then obtain X where hX: + "x = (\\<^sub>E i\I. X i)" "\i. openin (S i) (X i)" "finite {i. X i \ topspace (S i)}" + by auto + define X' where "X' \ (\i. if i \ I then X i else topspace (K i))" + have "x = (\\<^sub>E i\I. X' i)" + by(auto simp: hX(1) X'_def PiE_def Pi_def) + moreover have "finite {i. X' i \ topspace (K i)}" + using that by(auto intro!: finite_subset[OF _ hX(3)] simp: X'_def) + moreover have "openin (K i) (X' i)" for i + using hX(2)[of i] that[of i] by(auto simp: X'_def) + ultimately show "x \ {\\<^sub>E i\I. X i |X. (\i. openin (K i) (X i)) \ finite {i. X i \ topspace (K i)}}" + by(auto intro!: exI[where x="X'"]) + qed + have "{\\<^sub>E i\I. X i |X. (\i. openin (S i) (X i)) \ finite {i. X i \ topspace (S i)}} = {\\<^sub>E i\I. X i |X. (\i. openin (K i) (X i)) \ finite {i. X i \ topspace (K i)}}" + using 1[of S K] 1[of K S] assms by auto + thus ?thesis + by(simp add: product_topology_def) +qed + +lemma topology_generated_by_without_empty: + "topology_generated_by \ = topology_generated_by { U \ \. U \ {}}" +proof(rule topology_generated_by_eq) + fix U + show "U \ \ \ openin (topology_generated_by { U \ \. U \ {}}) U" + by(cases "U = {}") (simp_all add: topology_generated_by_Basis) +qed (simp add: topology_generated_by_Basis) + +lemma topology_from_bij: + assumes "bij_betw f A (topspace S)" + shows "homeomorphic_map (pullback_topology A f S) S f" "topspace (pullback_topology A f S) = A" +proof - + note h = bij_betw_imp_surj_on[OF assms] bij_betw_inv_into_left[OF assms] bij_betw_inv_into_right[OF assms] + then show [simp]:"topspace (pullback_topology A f S) = A" + by(auto simp: topspace_pullback_topology) + show "homeomorphic_map (pullback_topology A f S) S f" + by(auto simp: homeomorphic_map_maps homeomorphic_maps_def h continuous_map_pullback[OF continuous_map_id,simplified] inv_into_into intro!: exI[where x="inv_into A f"] continuous_map_pullback'[where f=f]) (metis (mono_tags, opaque_lifting) comp_apply continuous_map_eq continuous_map_id h(3) id_apply) +qed + +lemma openin_pullback_topology': + assumes "bij_betw f A (topspace S)" + shows "openin (pullback_topology A f S) u \ (openin S (f ` u)) \ u \ A" + unfolding openin_pullback_topology +proof safe + fix U + assume h:"openin S U" "u = f -` U \ A" + from openin_subset[OF this(1)] assms + have [simp]:"f ` (f -` U \ A) = U" + by(auto simp: image_def vimage_def bij_betw_def) + show "openin S (f ` (f -` U \ A))" + by(simp add: h) +next + assume "openin S (f ` u)" "u \ A" + with assms show "\U. openin S U \ u = f -` U \ A" + by(auto intro!: exI[where x="f ` u"] simp: bij_betw_def inj_on_def) +qed + +subsubsection \ Isolated Point \ +definition isolated_points_of :: "'a topology \ 'a set \ 'a set" (infixr "isolated'_points'_of" 80) where +"X isolated_points_of A \ {x\topspace X \ A. x \ X derived_set_of A}" + +lemma isolated_points_of_eq: + "X isolated_points_of A = {x\topspace X \ A. \U. x \ U \ openin X U \ U \ (A - {x}) = {}}" + unfolding isolated_points_of_def by(auto simp: in_derived_set_of) + +lemma in_isolated_points_of: + "x \ X isolated_points_of A \ x \ topspace X \ x \ A \ (\U. x \ U \ openin X U \ U \ (A - {x}) = {})" + by(simp add: isolated_points_of_eq) + +lemma derived_set_of_eq: + "x \ X derived_set_of A \ x \ X closure_of (A - {x})" + by(auto simp: in_derived_set_of in_closure_of) + +subsubsection \ Perfect Set \ +definition perfect_set :: "'a topology \ 'a set \ bool" where +"perfect_set X A \ closedin X A \ X isolated_points_of A = {}" + +abbreviation "perfect_space X \ perfect_set X (topspace X)" + +lemma perfect_setI: + assumes "closedin X A" + and "\x T. \x \ A; x \ T; openin X T\ \ \y\x. y \ T \ y \ A" + shows "perfect_set X A" + using assms by(simp add: perfect_set_def isolated_points_of_def in_derived_set_of) blast + +lemma perfect_spaceI: + assumes "\x T. \x \ T; openin X T\ \ \y\x. y \ T" + shows "perfect_space X" + using assms by(auto intro!: perfect_setI) (meson in_mono openin_subset) + +lemma perfect_setD: + assumes "perfect_set X A" + shows "closedin X A" "A \ topspace X" "\x T. \x \ A; x \ T; openin X T\ \ \y\x. y \ T \ y \ A" + using assms closedin_subset[of X A] by(simp_all add: perfect_set_def isolated_points_of_def in_derived_set_of) blast + +lemma perfect_space_perfect: + "perfect_set euclidean (UNIV :: 'a :: perfect_space set)" + by(auto simp: perfect_set_def in_isolated_points_of) (metis Int_Diff inf_top.right_neutral insert_Diff not_open_singleton) + +lemma perfect_set_subtopology: + assumes "perfect_set X A" + shows "perfect_space (subtopology X A)" + using perfect_setD[OF assms] by(auto intro!: perfect_setI simp: inf.absorb_iff2 openin_subtopology) + +subsubsection \ Bases and Sub-Bases in Abstract Topology\ +definition subbase_of :: "['a topology, 'a set set] \ bool" where +"subbase_of S \ \ S = topology_generated_by \" + +definition base_of :: "['a topology, 'a set set] \ bool" where +"base_of S \ \ (\U. openin S U \ (\\. U = \\ \ \ \ \))" + +definition second_countable :: "'a topology \ bool" where +"second_countable S \ (\\. countable \ \ base_of S \)" + +definition zero_dimensional :: "'a topology \ bool" where +"zero_dimensional S \ (\\. base_of S \ \ (\u\\. openin S u \ closedin S u))" + +lemma openin_base: + assumes "base_of S \ " "U = \\" and "\ \ \" + shows "openin S U" + using assms by(auto simp: base_of_def) + +lemma base_is_subbase: + assumes "base_of S \" + shows "subbase_of S \" + unfolding subbase_of_def topology_eq openin_topology_generated_by_iff +proof safe + fix U + assume "openin S U" + then obtain \ where hu:"U = \\" "\ \ \" + using assms by(auto simp: base_of_def) + thus "generate_topology_on \ U" + by(auto intro!: generate_topology_on.UN) (auto intro!: generate_topology_on.Basis) +next + fix U + assume "generate_topology_on \ U" + then show "openin S U" + proof induction + case (Basis s) + then show ?case + using openin_base[OF assms,of s "{s}"] + by auto + qed auto +qed + +lemma subbase_of_subset: + assumes "subbase_of S \" and "U \ \" + shows "U \ topspace S" + using assms(1)[simplified subbase_of_def] topology_generated_by_topspace assms + by auto + +lemma subbase_of_openin: + assumes "subbase_of S \" and "U \ \" + shows "openin S U" + using assms by(simp add: subbase_of_def openin_topology_generated_by_iff generate_topology_on.Basis) + +lemma base_of_subset: + assumes "base_of S \" and "U \ \" + shows "U \ topspace S" + using subbase_of_subset[OF base_is_subbase[OF assms(1)] assms(2)] . + +lemma base_of_openin: + assumes "base_of S \" and "U \ \" + shows "openin S U" + using subbase_of_openin[OF base_is_subbase[OF assms(1)] assms(2)] . + +lemma base_of_def2: + assumes "\U. U \ \ \ openin S U" + shows "base_of S \ \ (\U. openin S U \ (\x\U. \W\\. x \ W \ W \ U))" +proof + assume h:"base_of S \" + show "\U. openin S U \ (\x\U. \W\\. x \ W \ W \ U)" + proof safe + fix U x + assume h':"openin S U" "x \ U" + then obtain \ where hu: "U = \\" "\ \ \" + using h by(auto simp: base_of_def) + then obtain W where "x \ W" "W \ \" + using h'(2) by blast + thus "\W\\. x \ W \ W \ U" + using hu by(auto intro!: bexI[where x=W]) + qed +next + assume h:"\U. openin S U \ (\x\U. \W\\. x \ W \ W \ U)" + show "base_of S \" + unfolding base_of_def + proof safe + fix U + assume "openin S U" + then have "\x\U. \W. W\\ \ x \ W \ W \ U" + using h by blast + hence "\W. \x\U. W x \ \ \ x \ W x \ W x \ U" + by(rule bchoice) + then obtain W where hw: + "\x\U. W x \ \ \ x \ W x \ W x \ U" by auto + thus "\\. U = \ \ \ \ \ \" + by(auto intro!: exI[where x="W ` U"]) + next + fix U \ + show "\ \ \ \ openin S (\ \)" + using assms by auto + qed +qed + +lemma base_of_def2': + "base_of S \ \ (\b\\. openin S b) \ (\x. openin S x \ (\B'\\. \ B' = x))" +proof + assume h:"base_of S \" + show "(\b\\. openin S b) \ (\x. openin S x \ (\B'\\. \ B' = x))" + proof(rule conjI) + show "\b\\. openin S b" + using openin_base[OF h,of _ "{_}"] by auto + next + show "\x. openin S x \ (\B'\\. \ B' = x)" + using h by(auto simp: base_of_def) + qed +next + assume h:"(\b\\. openin S b) \ (\x. openin S x \ (\B'\\. \ B' = x))" + show "base_of S \" + unfolding base_of_def + proof safe + fix U + assume "openin S U" + then obtain B' where "B'\\" "\ B' = U" + using h by blast + thus "\\. U = \ \ \ \ \ \" + by(auto intro!: exI[where x=B']) + next + fix U \ + show "\ \ \ \ openin S (\ \)" + using h by auto + qed +qed + +corollary base_of_in_subset: + assumes "base_of S \" "openin S u" "x \ u" + shows "\v\\. x \ v \ v \ u" + using assms base_of_def2 base_of_def2' by fastforce + +lemma base_of_without_empty: + assumes "base_of S \" + shows "base_of S {U \ \. U \ {}}" + unfolding base_of_def2' +proof safe + fix x + assume "x \ \" " \ openin S x" + thus "\y. y \ {}" + using base_of_openin[OF assms \x \ \\] by simp +next + fix x + assume "openin S x" + then obtain B' where "B' \\" "\ B' = x" + using assms by(simp add: base_of_def2') metis + thus "\B'\{U \ \. U \ {}}. \ B' = x" + by(auto intro!: exI[where x="{y \ B'. y \ {}}"]) +qed + +lemma second_countable_ex_without_empty: + assumes "second_countable S" + shows "\\. countable \ \ base_of S \ \ (\U\\. U \ {})" +proof - + obtain \ where "countable \" "base_of S \" + using assms second_countable_def by blast + thus ?thesis + by(auto intro!: exI[where x="{U \ \. U \ {}}"] base_of_without_empty) +qed + +lemma subtopology_subbase_of: + assumes "subbase_of S \" + shows "subbase_of (subtopology S T) {T \ U | U. U \ \}" + using assms subtopology_generated_by + by(auto simp: subbase_of_def) + +lemma subtopology_base_of: + assumes "base_of S \" + shows "base_of (subtopology S T) {T \ U | U. U \ \}" + unfolding base_of_def +proof + fix L + show "openin (subtopology S T) L = (\\. L = \ \ \ \ \ {T \ U |U. U \ \})" + proof + assume "openin (subtopology S T) L " + then obtain T' where ht: + "openin S T'" "L = T' \ T" + by(auto simp: openin_subtopology) + then obtain \ where hu: + "T' = (\ \)" "\ \ \" + using assms by(auto simp: base_of_def) + show "\\. L = \ \ \ \ \ {T \ U |U. U \ \}" + using hu ht by(auto intro!: exI[where x="{T \ U | U. U \ \}"]) + next + assume "\\. L = \ \ \ \ \ {T \ U |U. U \ \}" + then obtain \ where hu: "L = \ \" "\ \ {T \ U |U. U \ \}" + by auto + hence "\U\\. \U'\\. U = T \ U'" by blast + then obtain k where hk:"\U. U \ \ \ k U \ \" "\U. U \ \ \ U = T \ k U" + by metis + hence "L = \ {T \ k U |U. U \ \}" + using hu by auto + also have "... = \ {k U |U. U \ \} \ T" by auto + finally have 1:"L = \ {k U |U. U \ \} \ T" . + moreover have "openin S (\ {k U |U. U \ \})" + using hu hk assms by(auto simp: base_of_def) + ultimately show "openin (subtopology S T) L" + by(auto intro!: exI[where x="\ {k U |U. U \ \}"] simp: openin_subtopology) + qed +qed + +lemma second_countable_subtopology: + assumes "second_countable S" + shows "second_countable (subtopology S T)" +proof - + obtain \ where "countable \" "base_of S \" + using assms second_countable_def by blast + thus ?thesis + by(auto intro!: exI[where x="{T \ U | U. U \ \}"] simp: second_countable_def Setcompr_eq_image dest: subtopology_base_of) +qed + +lemma Lindelof_of: + assumes "second_countable S" "\u. u \ U \ openin S u" "\ U = topspace S" + shows "\U'. countable U' \ U' \ U \ \ U' = topspace S" +proof - + from assms(1) obtain \ where h: "countable \" "base_of S \" + by(auto simp: second_countable_def) + define B' where "B' \ {v\\. \u\U. v \ u}" + have B': "countable B'" + using h(1) by(auto simp: B'_def) + have "\v. v \ B' \ (\u\U. v \ u)" by(auto simp: B'_def) + then obtain U' where U':"\v. v \ B' \ U' v \ U" "\v. v \ B' \ v \ U' v" + by metis + show ?thesis + proof(rule exI[where x="U' ` B'"]) + show "countable (U' ` B') \ U' ` B' \ U \ \ (U' ` B') = topspace S" + proof safe + fix x + assume "x \ topspace S" + then obtain u where u:"x \ u" "u \ U" + using assms(3) by auto + obtain v where v:"x \ v" "v \ \" "v \ u" + using base_of_in_subset[OF h(2) assms(2)[OF u(2)] u(1)] by auto + show "x \ \ (U' ` B')" + using u v U' by(auto intro!: bexI[where x=v]) (auto simp: B'_def intro!: exI[where x=u]) + qed(use B' U' assms(2) openin_subset in blast)+ + qed +qed + +lemma open_map_with_base: + assumes "base_of S \" "\A. A \ \ \ openin S' (f ` A)" + shows "open_map S S' f" + unfolding open_map_def +proof safe + fix U + assume "openin S U" + then obtain \ where "U = \\" "\ \ \" + using assms(1) by(auto simp: base_of_def) + hence "f ` U = \{ f ` A | A. A \ \}" by blast + also have "openin S' ..." + using assms(2) \\ \ \\ by auto + finally show "openin S' (f ` U)" . +qed + +text \ Construct a base from a subbase.\ +definition finite_intersections :: "'a set set \ 'a set set" where +"finite_intersections \ \ { \\' | \'. \' \ {} \ finite \' \ \' \ \}" + +lemma finite_intersections_inI: + assumes "U = \\'" "\' \ {}" " finite \'" and "\' \ \" + shows "U \ finite_intersections \" + using assms by(auto simp: finite_intersections_def) + +lemma finite_intersections_Uin: + assumes "U \ \" + shows "U \ finite_intersections \" + using assms by(auto intro!: finite_intersections_inI[of U "{U}"]) + +lemma finite_intersections_int: + assumes "U \ finite_intersections \" and "V \ finite_intersections \" + shows "U \ V \ finite_intersections \" +proof - + obtain \U \V where + "U = \\U" "\U \ {}" "finite \U" "\U \ \" "V = \\V" "finite \V" "\V \ \" + using assms by(auto simp: finite_intersections_def) + thus ?thesis + by(auto intro!: finite_intersections_inI[of _ "\U \ \V"]) +qed + +lemma finite_intersections_countable: + assumes "countable \" + shows "countable (finite_intersections \)" +proof - + have "finite_intersections \ = (\i\{\'. \' \ {} \ finite \' \ \' \ \}. {\ i})" + by(auto simp: finite_intersections_def) + also have "countable ..." + using countable_Collect_finite_subset[OF assms] + by(auto intro!: countable_UN[of "{ \'. \' \ {} \ finite \' \ \' \ \}" "\\'. {\\'}"]) + (auto intro!: countable_subset[of "{\'. \' \ {} \ finite \' \ \' \ \}" "{A. finite A \ A \ \}"]) + finally show ?thesis . +qed + +lemma finite_intersections_openin: + assumes "U \ finite_intersections \" + shows "openin (topology_generated_by \) U" +proof - + obtain \U where hu: + "U = \\U" "\U \ {}" "finite \U" "\U \ \" + using assms by(auto simp: finite_intersections_def) + show ?thesis + using hu by(auto intro: topology_generated_by_Basis) +qed + +lemma topology_generated_by_finite_intersections: + "topology_generated_by \ = topology_generated_by (finite_intersections \)" +proof(rule topology_generated_by_eq) + fix U + assume "U \ \" + then show "openin (topology_generated_by (finite_intersections \)) U" + by(auto intro!: topology_generated_by_Basis simp: finite_intersections_Uin) +qed (rule finite_intersections_openin) + +lemma topology_generated_by_is_union_of_finite_intersections: + "openin (topology_generated_by \) U \ (\\. U = \\ \ \ \ finite_intersections \)" +proof + assume "openin (topology_generated_by \) U" + then have "generate_topology_on \ U" + by (simp add: openin_topology_generated_by_iff) + thus "\\. U = \ \ \ \ \ finite_intersections \" + proof induction + case Empty + then show ?case + by auto + next + case (Int a b) + then obtain \a \b where hab: + "a = \ \a" "\a \ finite_intersections \" "b = \ \b" "\b \ finite_intersections \" + by auto + then have "a \ b = \{ Ua \ Ub | Ua Ub. Ua \ \a \ Ub \ \b}" + by blast + moreover have "{ Ua \ Ub | Ua Ub. Ua \ \a \ Ub \ \b} \ finite_intersections \" + using hab(2,4) finite_intersections_int by blast + ultimately show ?case by auto + next + case (UN K) + then have "\\. \k\K. k = \ (\ k) \ \ k \ finite_intersections \" + by(auto intro!: bchoice) + then obtain \ where + "\k\K. k = \ (\ k) \ \ k \ finite_intersections \" by auto + thus ?case + by(auto intro!: exI[where x="\k\K. (\ k)"]) (metis UnionE) + next + case (Basis s) + then show ?case + by(auto intro!: exI[where x="{s}"] finite_intersections_Uin) + qed +next + assume "\\. U = \ \ \ \ \ finite_intersections \" + then obtain \ where + "U = \ \" "\ \ finite_intersections \" by auto + thus "openin (topology_generated_by \) U" + using finite_intersections_openin + by(auto simp: openin_topology_generated_by_iff intro!: generate_topology_on.UN) +qed + +lemma base_from_subbase: + assumes "subbase_of S \" + shows "base_of S (finite_intersections \)" + using topology_generated_by_is_union_of_finite_intersections[of \,simplified assms[simplified subbase_of_def,symmetric]] + by(simp add: base_of_def) + +lemma countable_base_from_countable_subbase: + assumes "countable \" and "subbase_of S \" + shows "second_countable S" + using finite_intersections_countable[OF assms(1)] base_from_subbase[OF assms(2)] + by(auto simp: second_countable_def) + +lemma prod_topology_second_countable: + assumes "second_countable S" and "second_countable S'" + shows "second_countable (prod_topology S S')" +proof - + obtain \ \' where ho: + "countable \" "base_of S \" "countable \'" "base_of S' \'" + using assms by(auto simp: second_countable_def) + show ?thesis + proof(rule countable_base_from_countable_subbase[where \="{ U \ V | U V. U \ \ \ V \ \'}"]) + have "{U \ V |U V. U \ \ \ V \ \'} = (\(U,V). U \ V) ` (\ \ \')" + by auto + also have "countable ..." + using ho(1,3) by auto + finally show "countable {U \ V |U V. U \ \ \ V \ \'}" . + next + show "subbase_of (prod_topology S S') {U \ V |U V. U \ \ \ V \ \'}" + using base_is_subbase[OF ho(2)] base_is_subbase[OF ho(4)] + by(simp add: subbase_of_def prod_topology_generated_by) + qed +qed + +text \ Abstract version of the theorem @{thm product_topology_countable_basis}.\ +lemma product_topology_countable_base_of: + assumes "countable I" and "\i. i \ I \ second_countable (S i)" + shows "\\'. countable \' \ base_of (product_topology S I) \' \ + (\k \ \'. \X. k = (\\<^sub>E i\I. X i) \ (\i. openin (S i) (X i)) \ finite {i. X i \ topspace (S i)} \ {i. X i \ topspace (S i)} \ I)" +proof - + obtain \ where ho: + "\i. i \ I \ countable (\ i)" "\i. i \ I \ base_of (S i) (\ i)" + using assms(2)[simplified second_countable_def] by metis + show ?thesis + unfolding second_countable_def + proof(intro exI[where x="{\\<^sub>E i\I. U i | U. finite {i\I. U i \ topspace (S i)} \ (\i\{i\I. U i \ topspace (S i)}. U i \ \ i)}"] conjI) + show "countable {\\<^sub>E i\I. U i | U. finite {i\I. U i \ topspace (S i)} \ (\i\{i\I. U i \ topspace (S i)}. U i \ \ i)}" + (is "countable ?X") + proof - + have "?X = {\\<^sub>E i\I. U i | U. finite {i\I. U i \ topspace (S i)} \ (\i\{i\I. U i \ topspace (S i)}. U i \ \ i) \ (\i \(UNIV- I). U i = {undefined})}" + (is "_ = ?Y") + proof (rule set_eqI) + show "\x. x \ ?X \ x \ ?Y" + proof + fix x + assume "x \ ?X" + then obtain U where hu: + "x = (\\<^sub>E i\I. U i)" "finite {i\I. U i \ topspace (S i)}" "(\i\{i\I. U i \ topspace (S i)}. U i \ \ i)" + by auto + define U' where "U' i \ (if i \ I then U i else {undefined})" for i + have "x = (\\<^sub>E i\I. U' i)" + using hu(1) by(auto simp: U'_def PiE_def extensional_def Pi_def) + moreover have "finite {i\I. U' i \ topspace (S i)}" "(\i\{i\I. U' i \ topspace (S i)}. U' i \ \ i)" "\i \(UNIV- I). U' i = {undefined}" + using hu(2,3) by(auto simp: U'_def) (metis (mono_tags, lifting) Collect_cong) + ultimately show "x \ ?Y" by auto + qed auto + qed + also have "... = (\U. \\<^sub>E i\I. U i) ` {U. finite {i\I. U i \ topspace (S i)} \ (\i\{i\I. U i \ topspace (S i)}. U i \ \ i) \ (\i \(UNIV- I). U i = {undefined})}" by auto + also have "countable ..." + proof(rule countable_image) + have "{U. finite {i \ I. U i \ topspace (S i)} \ (\i\{i \ I. U i \ topspace (S i)}. U i \ \ i) \ (\i\UNIV - I. U i = {undefined})} = {U. \I'. finite I' \ I' \ I \ (\i\I'. U i \ \ i) \ (\i\(I - I'). U i = topspace (S i)) \ (\i\UNIV - I. U i = {undefined})}" + (is "?A = ?B") + proof (rule set_eqI) + show "\x. x \ ?A \ x \ ?B" + proof + fix U + assume "U \ {U. finite {i \ I. U i \ topspace (S i)} \ (\i\{i \ I. U i \ topspace (S i)}. U i \ \ i) \ (\i\UNIV - I. U i = {undefined})}" + then show "U \ {U. \I'. finite I' \ I' \ I \ (\i\I'. U i \ \ i) \ (\i\I - I'. U i = topspace (S i)) \ (\i\UNIV - I. U i = {undefined})}" + by auto + next + fix U + assume assm:"U \ {U. \I'. finite I' \ I' \ I \ (\i\I'. U i \ \ i) \ (\i\I - I'. U i = topspace (S i)) \ (\i\UNIV - I. U i = {undefined})}" + then obtain I' where hi': + "finite I'" "I' \ I" "\i\I'. U i \ \ i" "\i\I - I'. U i = topspace (S i)" "\i\UNIV - I. U i = {undefined}" + by auto + then have "\i. i \ I \ U i \ topspace (S i) \ i \ I'" by auto + hence "{i \ I. U i \ topspace (S i)} \ I'" by auto + hence "finite {i \ I. U i \ topspace (S i)}" + using hi'(1) by (simp add: rev_finite_subset) + thus "U \ {U. finite {i \ I. U i \ topspace (S i)} \ (\i\{i \ I. U i \ topspace (S i)}. U i \ \ i) \ (\i\UNIV - I. U i = {undefined})}" + using hi' by auto + qed + qed + also have "... = (\I'\{I'. finite I' \ I' \ I}. {U. (\i\I'. U i \ \ i) \ (\i\I - I'. U i = topspace (S i)) \ (\i\UNIV - I. U i = {undefined})})" + by auto + also have "countable ..." + proof(rule countable_UN[OF countable_Collect_finite_subset[OF assms(1)]]) + fix I' + assume "I' \ {I'. finite I' \ I' \ I}" + hence hi':"finite I'" "I' \ I" by auto + have "(\U i. if i \ I' then U i else undefined) ` {U. (\i\I'. U i \ \ i) \ (\i\I - I'. U i = topspace (S i)) \ (\i\UNIV - I. U i = {undefined})} \ (\\<^sub>E i\I'. \ i)" + by auto + moreover have "countable ..." + using hi' by(auto intro!: countable_PiE ho) + ultimately have "countable ((\U i. if i \ I' then U i else undefined) ` {U. (\i\I'. U i \ \ i) \ (\i\I - I'. U i = topspace (S i)) \ (\i\UNIV - I. U i = {undefined})})" + by(simp add: countable_subset) + moreover have "inj_on (\U i. if i \ I' then U i else undefined) {U. (\i\I'. U i \ \ i) \ (\i\I - I'. U i = topspace (S i)) \ (\i\UNIV - I. U i = {undefined})}" + (is "inj_on ?f ?X") + proof + fix x y + assume hxy: "x \ ?X" "y \ ?X" "?f x = ?f y" + show "x = y" + proof + fix i + consider "i \ I'" | "i \ I - I'" | "i \ UNIV - I" + using hi'(2) by blast + then show "x i = y i" + proof cases + case i:1 + then show ?thesis + using fun_cong[OF hxy(3),of i] by auto + next + case i:2 + then show ?thesis + using hxy(1,2) by auto + next + case i:3 + then show ?thesis + using hxy(1,2) by auto + qed + qed + qed + ultimately show "countable {U. (\i\I'. U i \ \ i) \ (\i\I - I'. U i = topspace (S i)) \ (\i\UNIV - I. U i = {undefined})}" + using countable_image_inj_on by auto + qed + finally show "countable {U. finite {i \ I. U i \ topspace (S i)} \ (\i\{i \ I. U i \ topspace (S i)}. U i \ \ i) \ (\i\UNIV - I. U i = {undefined})}" . + qed + finally show ?thesis . + qed + next + show "base_of (product_topology S I) {\\<^sub>E i\I. U i |U. finite {i \ I. U i \ topspace (S i)} \ (\i\{i \ I. U i \ topspace (S i)}. U i \ \ i)}" + (is "base_of (product_topology S I) ?X") + unfolding base_of_def + proof safe + fix U + assume "openin (product_topology S I) U" + then have "\x\U. \Ux. finite {i \ I. Ux i \ topspace (S i)} \ (\i\I. openin (S i) (Ux i)) \ x \ Pi\<^sub>E I Ux \ Pi\<^sub>E I Ux \ U" + by(simp add: openin_product_topology_alt) + hence "\Ux. \x\U. finite {i \ I. Ux x i \ topspace (S i)} \ (\i\I. openin (S i) (Ux x i)) \ x \ Pi\<^sub>E I (Ux x) \ Pi\<^sub>E I (Ux x) \ U" + by(rule bchoice) + then obtain Ux where hui: + "\x. x \ U \ finite {i \ I. Ux x i \ topspace (S i)}" "\x i. x \ U \ i \ I \ openin (S i) (Ux x i)" "\x. x \ U \ x \ Pi\<^sub>E I (Ux x)" "\x. x \ U \ Pi\<^sub>E I (Ux x) \ U" + by fastforce + then have 1:"\x\U. \i\{i \ I. Ux x i \ topspace (S i)}. \\xj. \xj \ \ i \ Ux x i = \ \xj" + using ho[simplified base_of_def] by (metis (no_types, lifting) mem_Collect_eq) + have "\x\U. \\xj. \i\{i \ I. Ux x i \ topspace (S i)}. \xj i \ \ i \ Ux x i = \ (\xj i)" + by(standard, rule bchoice) (use 1 in simp) + hence "\\xj. \x\U. \i\{i \ I. Ux x i \ topspace (S i)}. \xj x i \ \ i \ Ux x i = \ (\xj x i)" + by(rule bchoice) + then obtain \xj where + "\x\U. \i\{i \ I. Ux x i \ topspace (S i)}. \xj x i \ \ i \ Ux x i = \ (\xj x i)" + by auto + hence huxj: "\x i. x \ U \ i \ {i \ I. Ux x i \ topspace (S i)} \ \xj x i \ \ i" + "\x i. x \ U \ i \ {i \ I. Ux x i \ topspace (S i)} \ Ux x i = \ (\xj x i)" + by blast+ + show "\\. U = \ \ \ \ \ ?X" + proof(intro exI[where x="{\\<^sub>E i\I. K i | K. \x\U. finite {i \ I. Ux x i \ topspace (S i)} \ (\i\{i \ I. Ux x i \ topspace (S i)}. K i \ \xj x i) \ (\i\UNIV -{i \ I. Ux x i \ topspace (S i)}. K i = topspace (S i))}"] conjI) + show "U = \ {\\<^sub>E i\I. K i | K. \x\U. finite {i \ I. Ux x i \ topspace (S i)} \ (\i\{i \ I. Ux x i \ topspace (S i)}. K i \ \xj x i) \ (\i\UNIV -{i \ I. Ux x i \ topspace (S i)}. K i = topspace (S i))}" + proof safe + fix x + assume hxu:"x \ U" + have "\i\{i \ I. Ux x i \ topspace (S i)}. Ux x i = \ (\xj x i)" + using huxj[OF hxu] by blast + hence "\i\{i \ I. Ux x i \ topspace (S i)}. \Uxj. Uxj \ \xj x i \ x i \ Uxj" + using hui(3)[OF hxu] by auto + hence "\Uxj. \i\{i \ I. Ux x i \ topspace (S i)}. Uxj i \ \xj x i \ x i \ Uxj i" + by(rule bchoice) + then obtain Uxj where huxj': + "\i. i \ {i \ I. Ux x i \ topspace (S i)} \ Uxj i \ \xj x i" + "\i. i \ {i \ I. Ux x i \ topspace (S i)} \ x i \ Uxj i" + by auto + define K where "K \ (\i. if i \ {i \ I. Ux x i \ topspace (S i)} then Uxj i else topspace (S i))" + have "x \ (\\<^sub>E i\I. K i)" + using huxj'(2) hui(3,4)[OF hxu] openin_subset[OF hui(2)[OF hxu]] + by(auto simp: K_def PiE_def Pi_def) + moreover have "\x\U. finite {i \ I. Ux x i \ topspace (S i)} \ (\i\{i \ I. Ux x i \ topspace (S i)}. K i \ \xj x i) \ (\i\UNIV -{i \ I. Ux x i \ topspace (S i)}. K i = topspace (S i))" + by(rule bexI[OF _ hxu], rule conjI,simp add: hui(1)[OF hxu]) (use hui(2) hxu openin_subset huxj'(1) K_def in auto) + ultimately show "x \ \ {\\<^sub>E i\I. K i | K. \x\U. finite {i \ I. Ux x i \ topspace (S i)} \ (\i\{i \ I. Ux x i \ topspace (S i)}. K i \ \xj x i) \ (\i\UNIV -{i \ I. Ux x i \ topspace (S i)}. K i = topspace (S i))}" + by auto + next + fix x X K u + assume hu: "x \ (\\<^sub>E i\I. K i)" "u \ U" "finite {i \ I. Ux u i \ topspace (S i)}" "\i\{i \ I. Ux u i \ topspace (S i)}. K i \ \xj u i" "\i\UNIV -{i \ I. Ux u i \ topspace (S i)}. K i = topspace (S i)" + have "\i. i \ {i \ I. Ux u i \ topspace (S i)} \ K i \ Ux u i" + using huxj[OF hu(2)] hu(4) by blast + moreover have "\i. i \ I - {i \ I. Ux u i \ topspace (S i)} \ K i = Ux u i" + using hu(5) by auto + ultimately have "\i. i \ I \ K i \ Ux u i" + by blast + thus "x \ U" + using hui(4)[OF hu(2)] hu(1) by blast + qed + next + show "{\\<^sub>E i\I. K i | K. \x\U. finite {i \ I. Ux x i \ topspace (S i)} \ (\i\{i \ I. Ux x i \ topspace (S i)}. K i \ \xj x i) \ (\i\UNIV -{i \ I. Ux x i \ topspace (S i)}. K i = topspace (S i))} \ ?X" + proof + fix x + assume "x \ {\\<^sub>E i\I. K i | K. \x\U. finite {i \ I. Ux x i \ topspace (S i)} \ (\i\{i \ I. Ux x i \ topspace (S i)}. K i \ \xj x i) \ (\i\UNIV -{i \ I. Ux x i \ topspace (S i)}. K i = topspace (S i))}" + then obtain u K where hu: + "x = (\\<^sub>E i\I. K i)" "u \ U" "finite {i \ I. Ux u i \ topspace (S i)}" "\i\{i \ I. Ux u i \ topspace (S i)}. K i \ \xj u i" "\i\UNIV -{i \ I. Ux u i \ topspace (S i)}. K i = topspace (S i)" + by auto + have hksubst:"{i \ I. K i \ topspace (S i)} \ {i \ I. Ux u i \ topspace (S i)}" + using hu(5) by fastforce + hence "finite {i \ I. K i \ topspace (S i)}" + using hu(3) by (simp add: finite_subset) + moreover have "\i\{i \ I. K i \ topspace (S i)}. K i \ \ i" + using huxj(1)[OF hu(2)] hu(4) hksubst + by (meson subsetD) + ultimately show "x \ ?X" + using hu(1) by auto + qed + qed + next + fix \ + assume "\ \ ?X" + have "openin (product_topology S I) u" if hu:"u \ \" for u + proof - + have hu': "u \ ?X" + using \\ \ ?X\ hu by auto + then obtain U where hU: + "u = (\\<^sub>E i\I. U i)" "finite {i \ I. U i \ topspace (S i)}" "\i\{i \ I. U i \ topspace (S i)}. U i \ \ i" + by auto + define U' where "U' \ (\i. if i \ {i \ I. U i \ topspace (S i)} then U i else topspace (S i))" + have hU': "u = (\\<^sub>E i\I. U' i)" + by(auto simp: hU(1) U'_def PiE_def Pi_def) + have hUfinite : "finite {i. U' i \ topspace (S i)}" + using hU(2) by(auto simp: U'_def) + have hUoi: "\i\{i. U' i \ topspace (S i)}. U' i \ \ i" + using hU(3) by(auto simp: U'_def) + have hUi: "\i\{i. U' i \ topspace (S i)}. i \ I" + using hU(2) by(auto simp: U'_def) + have hallopen:"openin (S i) (U' i)" for i + proof - + consider "i \ {i. U' i \ topspace (S i)}" | "i \ {i. U' i \ topspace (S i)}" by auto + then show ?thesis + proof cases + case 1 + then show ?thesis + using hUoi ho(2)[of i] base_of_openin[of "S i" "\ i" "U' i"] hUi + by auto + next + case 2 + then have "U' i = topspace (S i)" by auto + thus ?thesis by auto + qed + qed + show "openin (product_topology S I) u" + using hallopen hUfinite by(auto intro!: product_topology_basis simp: hU') + qed + thus "openin (product_topology S I) (\ \)" + by auto + qed + next + show "\k\{Pi\<^sub>E I U |U. finite {i \ I. U i \ topspace (S i)} \ (\i\{i \ I. U i \ topspace (S i)}. U i \ \ i)}. \X. k = Pi\<^sub>E I X \ (\i. openin (S i) (X i)) \ finite {i. X i \ topspace (S i)} \ {i. X i \ topspace (S i)} \ I" + proof + fix k + assume "k \ {Pi\<^sub>E I U |U. finite {i \ I. U i \ topspace (S i)} \ (\i\{i \ I. U i \ topspace (S i)}. U i \ \ i)}" + then obtain U where hu: + "k = (\\<^sub>E i\I. U i)" "finite {i \ I. U i \ topspace (S i)}" "\i\{i \ I. U i \ topspace (S i)}. U i \ \ i" + by auto + define X where "X \ (\i. if i \ {i \ I. U i \ topspace (S i)} then U i else topspace (S i))" + have hX1: "k = (\\<^sub>E i\I. X i)" + using hu(1) by(auto simp: X_def PiE_def Pi_def) + have hX2: "openin (S i) (X i)" for i + using hu(3) base_of_openin[of "S i" _ "U i",OF ho(2)] + by(auto simp: X_def) + have hX3: "finite {i. X i \ topspace (S i)}" + using hu(2) by(auto simp: X_def) + have hX4: "{i. X i \ topspace (S i)} \ I" + by(auto simp: X_def) + show "\X. k = (\\<^sub>E i\I. X i) \ (\i. openin (S i) (X i)) \ finite {i. X i \ topspace (S i)} \ {i. X i \ topspace (S i)} \ I" + using hX1 hX2 hX3 hX4 by(auto intro!: exI[where x=X]) + qed + qed +qed + +lemma product_topology_second_countable: + assumes "countable I" and "\i. i \ I \ second_countable (S i)" + shows "second_countable (product_topology S I)" + using product_topology_countable_base_of[OF assms(1)] assms(2) + by(fastforce simp: second_countable_def) + +lemma Cantor_Bendixon: + assumes "second_countable X" + shows "\U P. countable U \ openin X U \ perfect_set X P \ U \ P = topspace X \ U \ P = {} \ (\a\{}. openin (subtopology X P) a \ uncountable a)" +proof - + obtain \ where o: "countable \" "base_of X \" + using assms by(auto simp: second_countable_def) + define U where "U \ \ {u\\. countable u}" + define P where "P \ topspace X - U" + have 1: "countable U" + using o(1) by(auto simp: U_def intro!: countable_UN[of _ id,simplified]) + have 2: "openin X U" + using base_of_openin[OF o(2)] by(auto simp: U_def) + have openin_c:"countable v \ v \ U" if "openin X v" for v + proof + assume "countable v" + obtain \ where "v = \\" "\ \ \" + using \openin X v\ o(2) by(auto simp: base_of_def) + with \countable v\ have "\u. u \ \ \ countable u" + by (meson Sup_upper countable_subset) + thus "v \ U" + using \\ \ \\ by(auto simp: \v = \\\ U_def) + qed(rule countable_subset[OF _ 1]) + have 3: "perfect_set X P" + proof(rule perfect_setI) + fix x T + assume h:"x \ P" "x \ T" "openin X T" + have T_unc:"uncountable T" + using openin_c[OF h(3)] h(1,2) by(auto simp: P_def) + obtain \ where U:"T = \\" "\ \ \" + using h(3) o(2) by(auto simp: base_of_def) + then obtain u where u:"u \ \" "uncountable u" + using T_unc U_def h(3) openin_c by auto + hence "uncountable (u - {x})" by simp + hence "\ (u - {x} \ U)" + using 1 by (metis countable_subset) + then obtain y where "y \ u - {x}" "y \ U" + by blast + thus "\y. y \ x \ y \ T \ y \ P" + using U u base_of_subset[OF o(2),of u] by(auto intro!: exI[where x=y] simp:P_def) + qed(use 2 P_def in auto) + have 4 : "uncountable a" if "openin (subtopology X P) a" "a \ {}" for a + proof + assume contable:"countable a" + obtain b where b: "openin X b" "a = P \ b" + using \openin (subtopology X P) a\ by(auto simp: openin_subtopology) + hence "uncountable b" + using P_def openin_c that(2) by auto + thus False + by (metis 1 Diff_Int_distrib2 Int_absorb1 P_def b(1) b(2) contable countable_Int1 openin_subset uncountable_minus_countable) + qed + show ?thesis + using 1 2 3 4 by(auto simp: P_def) +qed + +subsubsection \ Dense and Separable in Abstract Topology\ +definition dense_of :: "['a topology, 'a set] \ bool" where +"dense_of S U \ (U \ topspace S \ (\V. openin S V \ V \ {} \ U \ V \ {}))" + +lemma dense_of_def2: + "dense_of S U \ (U \ topspace S \ (S closure_of U) = topspace S)" + using dense_intersects_open by(auto simp: dense_of_def closure_of_subset_topspace in_closure_of) auto + +lemma dense_of_subset: + assumes "dense_of S U" + shows "U \ topspace S" + using assms by(simp add: dense_of_def) + +lemma dense_of_nonempty: + assumes "topspace S \ {}" "dense_of S U" + shows "U \ {}" + using assms by(auto simp: dense_of_def) + +definition separable :: "'a topology \ bool" where +"separable S \ (\U. countable U \ dense_of S U)" + +lemma dense_ofI: + assumes "U \ topspace S" + and "\V. openin S V \ V \ {} \ U \ V \ {}" + shows "dense_of S U" + using assms by(auto simp: dense_of_def) + +lemma separable_if_second_countable: + assumes "second_countable S" + shows "separable S" +proof - + obtain \ where ho: + "countable \" "base_of S \" "\u. u \ \ \ u \ {}" + using second_countable_ex_without_empty[OF assms] by auto + then obtain x where hx: "\u. u \ \ \ x u \ u" + by (metis all_not_in_conv) + show ?thesis + unfolding separable_def + proof(intro exI[where x="{x u|u. u \ \}"] conjI) + show "countable {x u |u. u \ \}" + using ho(1) by (simp add: Setcompr_eq_image) + next + show "dense_of S {x u |u. u \ \}" + proof(rule dense_ofI) + show "{x u |u. u \ \} \ topspace S" + using hx base_of_subset[OF ho(2)] by auto + next + fix V + assume "openin S V" "V \ {}" + then obtain B where hb:"B \ \" "V = \ B" + using base_of_def2' ho(2) by metis + with \V \ {}\ obtain b where "b \ B" + by auto + hence "{x u |u. u \ \} \ b \ {x u |u. u \ \} \ V" + using hb(2) by auto + moreover have "x b \ {x u |u. u \ \} \ b" + using hb(1) \b \ B\ hx[of b] by auto + ultimately show "{x u |u. u \ \} \ V \ {}" + by auto + qed + qed +qed + +lemma dense_of_prod: + assumes "dense_of S U" and "dense_of S' U'" + shows "dense_of (prod_topology S S') (U \ U')" +proof(rule dense_ofI) + fix V + assume h:"openin (prod_topology S S') V" "V \ {}" + then obtain x y where hxy:"(x,y) \ V" by auto + then obtain V1 V2 where hv12: + "openin S V1" "openin S' V2" "x \ V1" "y \ V2" "V1 \ V2 \ V" + using h(1) openin_prod_topology_alt[of S S' V] by blast + hence "V1 \ {}" "V2 \ {}" by auto + hence "U \ V1 \ {}" "U' \ V2 \ {}" + using assms hv12 by(auto simp: dense_of_def) + thus "U \ U' \ V \ {}" + using hv12 by auto +next + show "U \ U' \ topspace (prod_topology S S')" + using assms by(auto simp add: dense_of_def) +qed + +lemma separable_prod: + assumes "separable S" and "separable S'" + shows "separable (prod_topology S S')" +proof - + obtain U U' where + "countable U" "dense_of S U" "countable U'" "dense_of S' U'" + using assms by(auto simp: separable_def) + thus ?thesis + by(auto intro!: exI[where x="U\U'"] dense_of_prod simp: separable_def) +qed + +lemma dense_of_product: + assumes "\i. i \ I \ dense_of (T i) (U i)" + shows "dense_of (product_topology T I) (\\<^sub>E i\I. U i)" +proof(rule dense_ofI) + fix V + assume h:"openin (product_topology T I) V" "V \ {}" + then obtain x where hx:"x \ V" by auto + then obtain K where hk: + "finite {i \ I. K i \ topspace (T i)}" "\i\I. openin (T i) (K i)" "x \ (\\<^sub>E i\I. K i)" "(\\<^sub>E i\I. K i) \ V" + using h(1) openin_product_topology_alt[of T I V] by auto + hence "\i. i \ I \ K i \ {}" by auto + hence "\i. i \ I \ U i \ K i \ {}" + using assms hk by(auto simp: dense_of_def) + hence "(\\<^sub>E i\I. U i) \ (\\<^sub>E i\I. K i) \ {}" + by (simp add: PiE_Int PiE_eq_empty_iff) + thus "(\\<^sub>E i\I. U i) \ V \ {}" + using hk by auto +next + show "(\\<^sub>E i\I. U i) \ topspace (product_topology T I)" + using assms by(auto simp: dense_of_def) +qed + +lemma separable_countable_product: + assumes "countable I" and "\i. i \ I \ separable (T i)" + shows "separable (product_topology T I)" +proof - + consider "\i\I. topspace (T i) = {}" | "\i. i \ I \ topspace (T i) \ {}" + by auto + thus ?thesis + proof cases + case 1 + then obtain i where i:"i \ I" "topspace (T i) = {}" + by auto + show ?thesis + unfolding separable_def dense_of_def + proof(intro exI[where x="{}"] conjI) + show " \V. openin (product_topology T I) V \ V \ {} \ {} \ V \ {}" + proof safe + fix V x + assume h: "openin (product_topology T I) V" "x \ V" + from i have "topspace (product_topology T I) = {}" + by auto + with h(1) have "V = {}" + by(simp add: open_in_topspace_empty) + thus "x \ {}" + using h(2) by auto + qed + qed auto + next + case 2 + then have "\x. \i\I. x i \ topspace (T i)" "\U. \i\I. countable (U i) \ dense_of (T i) (U i)" + using assms(2) by(auto intro!: bchoice simp: separable_def) + then obtain x U where hxu: + "\i. i \ I \ x i \ topspace (T i)" "\i. i \ I \ countable (U i)" "\i. i \ I \ dense_of (T i) (U i)" + by auto + define U' where "U' \ (\J i. if i \ J then U i else {x i})" + show ?thesis + unfolding separable_def + proof(intro exI[where x="\{ \\<^sub>E i\I. U' J i | J. finite J \ J \ I}"] conjI) + have "(\{ \\<^sub>E i\I. U' J i | J. finite J \ J \ I}) = (\ ((\J. \\<^sub>E i\I. U' J i) ` {J. finite J \ J \ I}))" + by auto + also have "countable ..." + proof(rule countable_UN) + fix J + assume hj:"J \ {J. finite J \ J \ I}" + have "inj_on (\f. (\i\J. f i, \i\(I-J). f i)) (\\<^sub>E i\I. U' J i)" + proof(rule inj_onI) + fix f g + assume h:"f \ Pi\<^sub>E I (U' J)" "g \ Pi\<^sub>E I (U' J)" + "(restrict f J, restrict f (I - J)) = (restrict g J, restrict g (I - J))" + then have "\i. i \ J \ f i = g i" "\i. i \(I-J) \ f i = g i" + by(auto simp: restrict_def) meson+ + thus "f = g" + using h(1,2) by(auto simp: U'_def) (meson PiE_ext) + qed + moreover have "countable ((\f. (\i\J. f i, \i\(I-J). f i)) ` (\\<^sub>E i\I. U' J i))" (is "countable ?K") + proof - + have 1:"?K \ (\\<^sub>E i\J. U i) \ (\\<^sub>E i\(I-J). {x i})" + using hj by(auto simp: U'_def PiE_def Pi_def) + have 2:"countable ..." + proof(rule countable_SIGMA) + show "countable (Pi\<^sub>E J U)" + using hj hxu(2) by(auto intro!: countable_PiE) + next + have "(\\<^sub>E i\I - J. {x i}) = { \i\I-J. x i }" + by(auto simp: PiE_def extensional_def restrict_def Pi_def) + thus "countable (\\<^sub>E i\I - J. {x i})" + by simp + qed + show ?thesis + by(rule countable_subset[OF 1 2]) + qed + ultimately show "countable (\\<^sub>E i\I. U' J i)" + by(simp add: countable_image_inj_eq) + qed(rule countable_Collect_finite_subset[OF assms(1)]) + finally show "countable (\{ \\<^sub>E i\I. U' J i | J. finite J \ J \ I})" . + next + show "dense_of (product_topology T I) (\ {\\<^sub>E i\I. U' J i |J. finite J \ J \ I})" + proof(rule dense_ofI) + fix V + assume h:"openin (product_topology T I) V" "V \ {}" + then obtain y where hx:"y \ V" by auto + then obtain K where hk: + "finite {i \ I. K i \ topspace (T i)}" "\i. i\I \ openin (T i) (K i)" "y \ (\\<^sub>E i\I. K i)" "(\\<^sub>E i\I. K i) \ V" + using h(1) openin_product_topology_alt[of T I V] by auto + hence 3:"\i. i \ I \ K i \ {}" by auto + hence 4:"i \ {i \ I. K i \ topspace (T i)} \ K i \ U' {i \ I. K i \ topspace (T i)} i \ {}" for i + using hxu(3)[of i] hk(2)[of i] by(auto simp: U'_def dense_of_def) + have "\z. \i\{i \ I. K i \ topspace (T i)}. z i \ K i \ U' {i \ I. K i \ topspace (T i)} i" + by(rule bchoice) (use 4 in auto) + then obtain z where hz: "\i\{i \ I. K i \ topspace (T i)}. z i \ K i \ U' {i \ I. K i \ topspace (T i)} i" + by auto + have 5: "i \ {i \ I. K i \ topspace (T i)} \ i \ I \ x i \ K i" for i + using hxu(1)[of i] by auto + have "(\i. if i \ {i \ I. K i \ topspace (T i)} then z i else if i \ I then x i else undefined) \ (\\<^sub>E i\I. U' {i \ I. K i \ topspace (T i)} i) \ (\\<^sub>E i\I. K i)" + using 4 5 hz by(auto simp: U'_def) + thus "\ {Pi\<^sub>E I (U' J) |J. finite J \ J \ I} \ V \ {}" + using hk(1,4) by blast + next + have "\J. J \ I \ (\\<^sub>E i\I. U' J i) \ topspace (product_topology T I)" + using hxu by(auto simp: dense_of_def U'_def PiE_def Pi_def) (metis subsetD) + thus "(\ {\\<^sub>E i\I. U' J i |J. finite J \ J \ I}) \ topspace (product_topology T I)" + by auto + qed + qed + qed +qed + +lemma separable_finite_product: + assumes "finite I" and "\i. i \ I \ separable (T i)" + shows "separable (product_topology T I)" + using separable_countable_product[OF countable_finite[OF assms(1)]] assms by auto + +lemma homeomorphic_separable: + assumes "separable X" "X homeomorphic_space Y" + shows "separable Y" +proof - + obtain f g where "homeomorphic_maps X Y f g" + using assms(2) by(auto simp: homeomorphic_space_def) + hence fg:"continuous_map X Y f" "continuous_map Y X g" "\x. x \ topspace X \ g(f x) = x" "\y. y \ topspace Y \ f(g y) = y" + by(auto simp: homeomorphic_maps_def) + obtain U where U: "countable U" "dense_of X U" + using assms(1) by(auto simp: separable_def) + show ?thesis + unfolding separable_def dense_of_def countable_image[OF U(1)] + proof(intro exI[where x="f ` U"] conjI) + show "f ` U \ topspace Y" + using U(2) fg(1) by(auto simp: dense_of_def continuous_map_def) + next + show "\V. openin Y V \ V \ {} \ f ` U \ V \ {}" + proof safe + fix V x + assume h:"openin Y V" "f ` U \ V = {}" "x \ V" + then have "U \ (f -` V \ topspace X) = {}" + by blast + moreover have "f -` V \ topspace X \ {}" + using h(3) openin_subset[OF h(1)] by (metis (no_types, lifting) continuous_map_def disjoint_iff fg(2) fg(4) subsetD vimageI) + moreover have "openin X (f -` V \ topspace X)" + using h(1) fg(1) by auto + ultimately show "x \ {}" + using U(2) by(auto simp: dense_of_def) + qed + qed(rule countable_image[OF U(1)]) +qed + +subsubsection \ $G_{\delta}$ Set in Abstract Topology\ +definition g_delta_of :: "['a topology, 'a set] \ bool" where +"g_delta_of S A \ (\\. \ \ {} \ countable \ \ (\b\\. openin S b) \ A = \ \)" + +lemma g_delta_ofI: + assumes "U \ {}" "countable U" "\b. b \ U \ openin S b" "A = \ U" + shows "g_delta_of S A" + using assms by(auto simp: g_delta_of_def) + +lemma g_delta_ofD: + assumes "g_delta_of S A" + shows "\\. \ \ {} \ countable \ \ (\b\\. openin S b) \ A = \ \" + using assms by(simp add: g_delta_of_def) + +lemma g_delta_ofD': + assumes "g_delta_of S A" + shows "\U. (\n::nat. openin S (U n)) \ A = \ (range U)" +proof- + obtain \ where h:"\ \ {}" "countable \" "\b. b\\ \ openin S b" "A = \ \" + using g_delta_ofD[OF assms] by metis + show ?thesis + using range_from_nat_into[OF h(1,2)] h(3,4) + by(auto intro!: exI[where x="from_nat_into \"]) +qed + +lemma g_delta_of_subset: + assumes "g_delta_of S A" + shows "A \ topspace S" + using assms openin_subset by(auto simp: g_delta_of_def) + +lemma g_delta_of_open_set[simp]: + assumes "openin S A" + shows "g_delta_of S A" + using assms by(auto simp: g_delta_of_def intro!: exI[where x="{A}"]) + +lemma g_delta_of_empty[simp]: "g_delta_of S {}" + by simp + +lemma g_delta_of_topspace[simp]: "g_delta_of S (topspace S)" + by simp + +lemma g_delta_of_inter: + assumes "g_delta_of S A" and "g_delta_of S B" + shows "g_delta_of S (A \ B)" +proof - + obtain Ua Ub where hu: + "Ua \ {}" "countable Ua" "\b. b \ Ua \ openin S b" "A = \ Ua" + "countable Ub" "\b. b \ Ub \ openin S b" "B = \ Ub" + using assms by(auto simp: g_delta_of_def) + thus ?thesis + by(auto intro!: g_delta_ofI[where U="Ua \ Ub"]) +qed + +lemma g_delta_of_Int: + assumes "\a. a \ \ \ g_delta_of X a" "countable \" "\ \ {}" + shows "g_delta_of X (\ \)" +proof - + obtain Ua where u: + "\a. a \ \ \ Ua a \ {}" "\a. a \ \ \ countable (Ua a)" "\a b. a \ \ \ b \ Ua a \ openin X b" "\a. a \ \ \ a = \ (Ua a)" + using g_delta_ofD[OF assms(1)] by metis + have 1: "\ {Ua a |a. a \ \} \ {}" + using assms(3) u(1) by auto + have 2: "countable (\ {Ua a |a. a \ \})" + by (simp add: Setcompr_eq_image assms(2) u(2)) + have 3: "\b. b \ \ {Ua a |a. a \ \} \ openin X b" + using u(3) by auto + show ?thesis + using u(4) by(fastforce intro!: g_delta_ofI[OF 1 2 3]) +qed + +lemma g_delta_of_continuous_map: + assumes "continuous_map X Y f" "g_delta_of Y a" + shows "g_delta_of X (f -` a \ topspace X)" +proof - + obtain Ua where u: + "Ua \ {}" "countable Ua" "\b. b \ Ua \ openin Y b" "a = \ Ua" + using g_delta_ofD[OF assms(2)] by metis + then have 0:"f -` a \ topspace X = \ {f -` b \ topspace X|b. b \ Ua}" + by auto + have 1: "{f -` b \ topspace X |b. b \ Ua} \ {}" + using u(1) by simp + have 2:"countable {f -` b \ topspace X|b. b \ Ua}" + using u by (simp add: Setcompr_eq_image) + have 3:"\c. c \ {f -` b \ topspace X|b. b \ Ua} \ openin X c" + using assms u(3) by blast + show ?thesis + using g_delta_ofI[OF 1 2 3] by(simp add: 0) +qed + +lemma g_delta_of_inj_open_map: + assumes "open_map X Y f" "inj_on f (topspace X)" "g_delta_of X a" + shows "g_delta_of Y (f ` a)" +proof - + obtain Ua where u: + "Ua \ {}" "countable Ua" "\b. b \ Ua \ openin X b" "a = \ Ua" + using g_delta_ofD[OF assms(3)] by metis + then obtain j where "j \ Ua" by auto + have "f ` a = f ` \ Ua" by(simp add: u(4)) + also have "... = \ ((`) f ` Ua)" + using u openin_subset by(auto intro!: image_INT[OF assms(2) _ \j \ Ua\,of id,simplified]) + also have "... = \ {f ` u|u. u \ Ua}" by auto + finally have 0: "f ` a = \ {f ` u |u. u \ Ua}" . + have 1:"{f ` u |u. u \ Ua} \ {}" + using u(1) by auto + have 2:"countable {f ` u |u. u \ Ua}" + using u(2) by (simp add: Setcompr_eq_image) + have 3: "\c. c \ {f ` u |u. u \ Ua} \ openin Y c" + using assms(1) u(3) by(auto simp: open_map_def) + show ?thesis + using g_delta_ofI[OF 1 2 3] by(simp add: 0) +qed + +lemma g_delta_of_homeo_morphic: + assumes "g_delta_of X a" "homeomorphic_map X Y f" + shows "g_delta_of Y (f ` a)" + by(auto intro!: g_delta_of_inj_open_map[of X Y f] simp: assms(1) homeomorphic_imp_injective_map[OF assms(2)] homeomorphic_imp_open_map[OF assms(2)]) + +lemma g_delta_of_prod: + assumes "g_delta_of X A" "g_delta_of Y B" + shows "g_delta_of (prod_topology X Y) (A \ B)" +proof - + obtain Ua Ub where hu: + "Ua \ {}" "countable Ua" "\b. b \ Ua \ openin X b" "A = \ Ua" + "Ub \ {}" "countable Ub" "\b. b \ Ub \ openin Y b" "B = \ Ub" + using assms by(auto simp: g_delta_of_def) + then have 0:"A \ B = \ {a \ b | a b. a \ Ua \ b \ Ub}" by blast + have 1: "{a \ b | a b. a \ Ua \ b \ Ub} \ {}" + using hu(1,5) by auto + have 2: "countable {a \ b | a b. a \ Ua \ b \ Ub}" + proof - + have "countable ((\(x, y). x \ y) ` (Ua \ Ub))" + using hu(2,6) by(auto intro!: countable_image[of "Ua \ Ub" "\(x,y). x \ y"]) + moreover have "... = {a \ b | a b. a \ Ua \ b \ Ub}" by auto + ultimately show ?thesis by simp + qed + have 3: "\c. c \ {a \ b | a b. a \ Ua \ b \ Ub} \ openin (prod_topology X Y) c" + using hu(3,7) by(auto simp: openin_prod_Times_iff) + show ?thesis + using g_delta_ofI[OF 1 2 3] by(simp add: 0) +qed + +lemma g_delta_of_prod1: + assumes "g_delta_of X A" + shows "g_delta_of (prod_topology X Y) (A \ topspace Y)" + by(auto intro!: g_delta_of_prod assms) + +lemma g_delta_of_prod2: + assumes "g_delta_of Y B" + shows "g_delta_of (prod_topology X Y) (topspace X \ B)" + by(auto intro!: g_delta_of_prod assms) + +lemma g_delta_of_subtopology: + assumes "g_delta_of X A" "A \ S" + shows "g_delta_of (subtopology X S) A" +proof - + obtain Ua where u: + "Ua \ {}" "countable Ua" "\b. b \ Ua \ openin X b" "A = \ Ua" + using g_delta_ofD[OF assms(1)] by metis + have 0: "\ Ua = \ {ua \ S | ua. ua \ Ua } " + using assms(2) u(4) by auto + have 1: "{ua \ S | ua. ua \ Ua } \ {}" + using u(1) by auto + have 2: "countable {ua \ S | ua. ua \ Ua }" + using u(2) by (simp add: Setcompr_eq_image) + have 3: "\b. b \ {ua \ S | ua. ua \ Ua } \ openin (subtopology X S) b" + using u(3) by(auto simp: openin_subtopology) + show ?thesis + using g_delta_ofI[OF 1 2 3 0] by(simp add: u(4)) +qed + +lemma g_delta_of_subtopology_inverse: + assumes "g_delta_of (subtopology X S) A" "g_delta_of X S" + shows "g_delta_of X A" +proof - + obtain Ua where ua: + "Ua \ {}" "countable Ua" "\b. b \ Ua \ openin (subtopology X S) b" "A = \ Ua" + using g_delta_ofD[OF assms(1)] by metis + then obtain T where t: "\b. b \ Ua \ openin X (T b)" "\b. b \ Ua \ b = T b \ S" + by(auto simp: openin_subtopology) metis + have 0: "A = \ {T b|b. b \ Ua} \ S" + using ua(1,4) t(2) by blast + have "{T b |b. b \ Ua} \ {}" "countable {T b |b. b \ Ua}" + using ua(1,2) by(simp_all add: Setcompr_eq_image) + from g_delta_ofI[OF this] t(1) show ?thesis + by(auto intro!: g_delta_of_inter[OF _ assms(2)] simp: 0) +qed + +lemma continuous_map_imp_closed_graph': + assumes "continuous_map X Y f" "Hausdorff_space Y" + shows "closedin (prod_topology Y X) ((\x. (f x,x)) ` topspace X)" + using assms closed_map_def closed_map_paired_continuous_map_left by blast + +subsubsection \ Upper-Semicontinuous \ +definition upper_semicontinuous_map :: "['a topology, 'a \ 'b :: linorder_topology] \ bool" where +"upper_semicontinuous_map X f \ (\a. openin X {x\topspace X. f x < a})" + +lemma continuous_upper_semicontinuous: + assumes "continuous_map X (euclidean :: ('b :: linorder_topology) topology) f" + shows "upper_semicontinuous_map X f" + unfolding upper_semicontinuous_map_def +proof safe + fix a :: 'b + have *:"openin euclidean U \ openin X {x \ topspace X. f x \ U}" for U + using assms by(simp add: continuous_map) + have "openin euclidean {.. topspace X. f x < a}" by auto +qed + +lemma upper_semicontinuous_map_iff_closed: + "upper_semicontinuous_map X f \ (\a. closedin X {x\topspace X. f x \ a})" +proof - + have "{x \ topspace X. f x < a} = topspace X - {x \ topspace X. f x \ a}" for a + by auto + thus ?thesis + by (simp add: closedin_def upper_semicontinuous_map_def) +qed + +lemma upper_semicontinuous_map_real_iff: + fixes f :: "'a \ real" + shows "upper_semicontinuous_map X f \ upper_semicontinuous_map X (\x. ereal (f x))" + unfolding upper_semicontinuous_map_def +proof safe + fix a :: ereal + assume h:"\a::real. openin X {x \ topspace X. f x < a}" + consider "a = - \" | "a = \" | "a \ - \ \ a \ \" by auto + then show "openin X {x \ topspace X. ereal (f x) < a}" + proof cases + case 3 + then have "ereal (f x) < a \ f x < real_of_ereal a" for x + by (metis ereal_less_eq(3) linorder_not_less real_of_ereal.elims) + thus ?thesis + using h by simp + qed simp_all +next + fix a :: real + assume h:"\a::ereal. openin X {x \ topspace X. ereal (f x) < a}" + then have "openin X {x \ topspace X. ereal (f x) < ereal a}" + by blast + moreover have"ereal (f x) < real_of_ereal a \ f x < a" for x + by auto + ultimately show "openin X {x \ topspace X. f x < a}" by auto +qed + +subsection \ Lemmas for Limits\ +lemma qlim_eq_lim_mono_at_bot: + fixes g :: "rat \ 'a :: linorder_topology" + assumes "mono f" "(g \ a) at_bot" "\r::rat. f (real_of_rat r) = g r" + shows "(f \ a) at_bot" +proof - + have "mono g" + by(metis assms(1,3) mono_def of_rat_less_eq) + have ga:"\r. g r \ a" + proof(rule ccontr) + fix r + assume "\ a \ g r" + then have "g r < a" by simp + from order_topology_class.order_tendstoD(1)[OF assms(2) this] + obtain Q :: rat where q: "\q. q \ Q \ g r < g q" + by(auto simp: eventually_at_bot_linorder) + define q where "q \ min r Q" + show False + using q[of q] \mono g\ + by(auto simp: q_def mono_def) (meson linorder_not_less min.cobounded1) + qed + show ?thesis + proof(rule decreasing_tendsto) + show "\\<^sub>F n in at_bot. a \ f n" + unfolding eventually_at_bot_linorder + by(rule exI[where x=undefined],auto) (metis Ratreal_def assms(1,3) dual_order.trans ga less_eq_real_def lt_ex monoD of_rat_dense) (*metis assms(1) assms(3) ga less_eq_real_def lfp.leq_trans lt_ex monoD of_rat_dense*) + next + fix x + assume "a < x" + with topological_space_class.topological_tendstoD[OF assms(2),of "{..q. q \ Q \ g q < x" + by(auto simp: eventually_at_bot_linorder) + show "\\<^sub>F n in at_bot. f n < x" + using q assms(1,3) by(auto intro!: exI[where x="real_of_rat Q"] simp: eventually_at_bot_linorder) (metis dual_order.refl monoD order_le_less_trans) + qed +qed + +lemma qlim_eq_lim_mono_at_top: + fixes g :: "rat \ 'a :: linorder_topology" + assumes "mono f" "(g \ a) at_top" "\r::rat. f (real_of_rat r) = g r" + shows "(f \ a) at_top" +proof - + have "mono g" + by(metis assms(1,3) mono_def of_rat_less_eq) + have ga:"\r. g r \ a" + proof(rule ccontr) + fix r + assume "\ g r \ a" + then have "a < g r" by simp + from order_topology_class.order_tendstoD(2)[OF assms(2) this] + obtain Q :: rat where q: "\q. Q \ q \ g q < g r" + by(auto simp: eventually_at_top_linorder) + define q where "q \ max r Q" + show False + using q[of q] \mono g\ by(auto simp: q_def mono_def leD) + qed + show ?thesis + proof(rule increasing_tendsto) + show "\\<^sub>F n in at_top. f n \ a" + unfolding eventually_at_top_linorder + by(rule exI[where x=undefined],auto) (metis (no_types, opaque_lifting) assms(1) assms(3) dual_order.trans ga gt_ex monoD of_rat_dense order_le_less) + next + fix x + assume "x < a" + with topological_space_class.topological_tendstoD[OF assms(2),of "{x<..}"] + obtain Q :: rat where q: "\q. Q \ q \ x < g q" + by(auto simp: eventually_at_top_linorder) + show "\\<^sub>F n in at_top. x < f n" + using q assms(1,3) by(auto simp: eventually_at_top_linorder intro!: exI[where x="real_of_rat Q"]) (metis dual_order.refl monoD order_less_le_trans) + qed +qed + +lemma tendsto_enn2real: + assumes "k < top" and "(f \ k) F" + shows "((\n. enn2real (f n)) \ enn2real k) F" +proof - + have 1:"ennreal (enn2real k) = k" "enn2real k \ 0" + using assms(1) by auto + show ?thesis + using assms tendsto_enn2real[OF _ 1(2),of f] + by(simp add: 1(1)) +qed + +lemma LIMSEQ_inverse_not0: + fixes xn :: "nat \ real" + assumes "\n. xn n \ 0" "xn \ x" "(\n. 1 / (xn n)) \ b" + shows "x \ 0" +proof + assume x:"x = 0" + then have xn:"\e. e > 0 \ \N. \n\N. \xn n\ < e" + using LIMSEQ_D[OF assms(2)] by simp + have "\N. \n\N. \1 / (xn n) - b\ \ r" if r:"r > 0" for r + proof - + have "0 < 1 / (r + \b\)" + using that by auto + with xn[OF this] obtain N where N':"\n. n \ N \ \xn n\ < 1 / (r + \b\)" + by auto + show ?thesis + proof(rule exI[where x=N]) + show "\n\N. r \ \1 / xn n - b\" + proof safe + fix n + assume "n \ N" + note N'[OF this] + hence "(r + \b\) * \xn n\ < 1" + by (metis \0 < 1 / (r + \b\)\ mult.commute pos_less_divide_eq zero_less_divide_1_iff) + hence "1 / \xn n\ > r + \b\" + using assms(1)[of n] by (simp add: less_divide_eq) + hence "r + \b\ - \b\ < 1 / \xn n\ - \b\" + by simp + also have "... = \1 / xn n\ - \b\" by simp + also have "... \ \1 / xn n - b\" by simp + finally show "r \ \1 / xn n - b\" + by simp + qed + qed + qed + with LIMSEQ_D[OF assms(3)] show False + by (metis less_le_not_le linorder_le_cases real_norm_def zero_less_one) +qed + +lemma obtain_subsequence: + fixes xn :: "nat \ _" + assumes "infinite {n. P n (xn n)}" + obtains a :: "nat \ nat" where "strict_mono a" "\n. P (a n) (xn (a n))" +proof - + have inf: "infinite {n. n > m \ P n (xn n)}" for m + proof + assume "finite {n. n > m \ P n (xn n)}" + then have "finite ({..m} \ {n. n > m \ P n (xn n)})" by auto + hence "finite {n. P n (xn n)}" + by(auto intro!: finite_subset[where B="{..m} \ {n. n > m \ P n (xn n)}"]) + with assms show False by simp + qed + define an where "an \ rec_nat (SOME n. P n (xn n)) (\n an. SOME m. m > an \ P m (xn m))" + have anSome: "an (Suc n) = (SOME m. m > an n \ P m (xn m))" for n + by(auto simp: an_def) + have an1: "P (an n) (xn (an n))" for n + proof(cases n) + case 0 + obtain m where m:"P m (xn m)" + using assms not_finite_existsD by blast + show ?thesis + by(simp add: an_def 0,rule someI,rule m) + next + case (Suc n') + obtain m where m:"m > an n'" "P m (xn m)" + using inf not_finite_existsD by blast + show ?thesis + by(simp add: Suc anSome, rule someI2[where a=m],auto simp: m) + qed + have an2: "strict_mono an" + unfolding strict_mono_Suc_iff anSome + proof safe + fix n + obtain m where m:"m > an n" "P m (xn m)" + using inf not_finite_existsD by blast + show "an n < (SOME m. an n < m \ P m (xn m))" + by (rule someI2[where a=m],auto simp: m) + qed + show ?thesis + using an1 that[OF an2] by auto +qed + +subsection \Lemmas for Measure Theory\ +lemma measurable_preserve_sigma_sets: + assumes "sets M = sigma_sets \ S" "S \ Pow \" + "\a. a \ S \ f ` a \ sets N" "inj_on f (space M)" "f ` space M \ sets N" + and "b \ sets M" + shows "f ` b \ sets N" +proof - + have "b \ sigma_sets \ S" + using assms(1,6) by simp + thus ?thesis + proof induction + case (Basic a) + then show ?case by(rule assms(3)) + next + case Empty + then show ?case by simp + next + case (Compl a) + moreover have " \ = space M" + by (metis assms(1) assms(2) sets.sets_into_space sets.top sigma_sets_into_sp sigma_sets_top subset_antisym) + ultimately show ?case + by (metis Diff_subset assms(2) assms(4) assms(5) inj_on_image_set_diff sets.Diff sigma_sets_into_sp) + next + case (Union a) + then show ?case + by (simp add: image_UN) + qed +qed + +lemma integral_measurable_subprob_algebra2: + fixes f :: "_ \ _ \ _::{banach,second_countable_topology}" + assumes [measurable]: "(\(x, y). f x y) \ borel_measurable (M \\<^sub>M N)" "L \ measurable M (subprob_algebra N)" + shows "(\x. integral\<^sup>L (L x) (f x)) \ borel_measurable M" +proof - + note integral_measurable_subprob_algebra[measurable] + note measurable_distr2[measurable] + have "(\x. integral\<^sup>L (distr (L x) (M \\<^sub>M N) (\y. (x, y))) (\(x, y). f x y)) \ borel_measurable M" + by measurable + then show "(\x. integral\<^sup>L (L x) (f x)) \ borel_measurable M" + by (rule measurable_cong[THEN iffD1, rotated]) + (simp add: integral_distr) +qed + +inductive_set sigma_sets_cinter :: "'a set \ 'a set set \ 'a set set" + for sp :: "'a set" and A :: "'a set set" + where + Basic_c[intro, simp]: "a \ A \ a \ sigma_sets_cinter sp A" + | Top_c[simp]: "sp \ sigma_sets_cinter sp A" + | Inter_c: "(\i::nat. a i \ sigma_sets_cinter sp A) \ (\i. a i) \ sigma_sets_cinter sp A" + | Union_c: "(\i::nat. a i \ sigma_sets_cinter sp A) \ (\i. a i) \ sigma_sets_cinter sp A" + +inductive_set sigma_sets_cinter_dunion :: "'a set \ 'a set set \ 'a set set" + for sp :: "'a set" and A :: "'a set set" + where + Basic_cd[intro, simp]: "a \ A \ a \ sigma_sets_cinter_dunion sp A" + | Top_cd[simp]: "sp \ sigma_sets_cinter_dunion sp A" + | Inter_cd: "(\i::nat. a i \ sigma_sets_cinter_dunion sp A) \ (\i. a i) \ sigma_sets_cinter_dunion sp A" + | Union_cd: "(\i::nat. a i \ sigma_sets_cinter_dunion sp A) \ disjoint_family a \ (\i. a i) \ sigma_sets_cinter_dunion sp A" + +lemma sigma_sets_cinter_dunion_subset: "sigma_sets_cinter_dunion sp A \ sigma_sets_cinter sp A" +proof safe + fix x + assume "x \ sigma_sets_cinter_dunion sp A" + then show "x \ sigma_sets_cinter sp A" + by induction (auto intro!: Union_c Inter_c) +qed + +lemma sigma_sets_cinter_into_sp: + assumes "A \ Pow sp" "x \ sigma_sets_cinter sp A" + shows "x \ sp" + using assms(2) by induction (use assms(1) subsetD in blast)+ + +lemma sigma_sets_cinter_dunion_into_sp: + assumes "A \ Pow sp" "x \ sigma_sets_cinter_dunion sp A" + shows "x \ sp" + using assms(2) by induction (use assms(1) subsetD in blast)+ + +lemma sigma_sets_cinter_int: + assumes "a \ sigma_sets_cinter sp A" "b \ sigma_sets_cinter sp A" + shows "a \ b \ sigma_sets_cinter sp A" +proof - + have 1:"a \ b = (\i::nat. if i = 0 then a else b)" by auto + show ?thesis + unfolding 1 by(rule Inter_c,use assms in auto) +qed + +lemma sigma_sets_cinter_dunion_int: + assumes "a \ sigma_sets_cinter_dunion sp A" "b \ sigma_sets_cinter_dunion sp A" + shows "a \ b \ sigma_sets_cinter_dunion sp A" +proof - + have 1:"a \ b = (\i::nat. if i = 0 then a else b)" by auto + show ?thesis + unfolding 1 by(rule Inter_cd,use assms in auto) +qed + +lemma sigma_sets_cinter_un: + assumes "a \ sigma_sets_cinter sp A" "b \ sigma_sets_cinter sp A" + shows "a \ b \ sigma_sets_cinter sp A" +proof - + have 1:"a \ b = (\i::nat. if i = 0 then a else b)" by auto + show ?thesis + unfolding 1 by(rule Union_c,use assms in auto) +qed + +text \ Measurable isomorphisms.\ +definition measurable_isomorphic_map::"['a measure, 'b measure, 'a \ 'b] \ bool" where +"measurable_isomorphic_map M N f \ bij_betw f (space M) (space N) \ f \ M \\<^sub>M N \ the_inv_into (space M) f \ N \\<^sub>M M" + +lemma measurable_isomorphic_map_sets_cong: + assumes "sets M = sets M'" "sets N = sets N'" + shows "measurable_isomorphic_map M N f \ measurable_isomorphic_map M' N' f" + by(simp add: measurable_isomorphic_map_def sets_eq_imp_space_eq[OF assms(1)] sets_eq_imp_space_eq[OF assms(2)] measurable_cong_sets[OF assms] measurable_cong_sets[OF assms(2,1)]) + +lemma measurable_isomorphic_map_surj: + assumes "measurable_isomorphic_map M N f" + shows "f ` space M = space N" + using assms by(auto simp: measurable_isomorphic_map_def bij_betw_def) + +lemma measurable_isomorphic_mapI: + assumes "bij_betw f (space M) (space N)" "f \ M \\<^sub>M N" "the_inv_into (space M) f \ N \\<^sub>M M" + shows "measurable_isomorphic_map M N f" + using assms by(simp add: measurable_isomorphic_map_def) + +lemma measurable_isomorphic_map_byWitness: + assumes "f \ M \\<^sub>M N" "g \ N \\<^sub>M M" "\x. x \ space M \ g (f x) = x" "\x. x \ space N \ f (g x) = x" + shows "measurable_isomorphic_map M N f" +proof - + have *:"bij_betw f (space M) (space N)" + using assms by(auto intro!: bij_betw_byWitness[where f'=g] dest:measurable_space) + show ?thesis + proof(rule measurable_isomorphic_mapI) + have "the_inv_into (space M) f x = g x" if "x \ space N" for x + by (metis * assms(2) assms(4) bij_betw_imp_inj_on measurable_space that the_inv_into_f_f) + thus "the_inv_into (space M) f \ N \\<^sub>M M" + using measurable_cong assms(2) by blast + qed (simp_all add: * assms(1)) +qed + +lemma measurable_isomorphic_map_restrict_space: + assumes "f \ M \\<^sub>M N" "\A. A \ sets M \ f ` A \ sets N" "inj_on f (space M)" + shows "measurable_isomorphic_map M (restrict_space N (f ` space M)) f" +proof(rule measurable_isomorphic_mapI) + show "bij_betw f (space M) (space (restrict_space N (f ` space M)))" + by (simp add: assms(2,3) inj_on_imp_bij_betw) +next + show "f \ M \\<^sub>M restrict_space N (f ` space M)" + by (simp add: assms(1) measurable_restrict_space2) +next + show "the_inv_into (space M) f \ restrict_space N (f ` space M) \\<^sub>M M" + proof(rule measurableI) + show "x \ space (restrict_space N (f ` space M)) \ the_inv_into (space M) f x \ space M" for x + by (simp add: assms(2,3) the_inv_into_into) + next + fix A + assume "A \ sets M" + have "the_inv_into (space M) f -` A \ space (restrict_space N (f ` space M)) = f ` A" + by (simp add: \A \ sets M\ assms(2,3) sets.sets_into_space the_inv_into_vimage) + also note assms(2)[OF \A \ sets M\] + finally show "the_inv_into (space M) f -` A \ space (restrict_space N (f ` space M)) \ sets (restrict_space N (f ` space M))" + by (simp add: assms(2) sets_restrict_space_iff) + qed +qed + +lemma measurable_isomorphic_mapD': + assumes "measurable_isomorphic_map M N f" + shows "\A. A \ sets M \ f ` A \ sets N" "f \ M \\<^sub>M N" + "\g. bij_betw g (space N) (space M) \ g \ N \\<^sub>M M \ (\x \ space M. g (f x) = x) \ (\x\ space N. f (g x) = x) \ (\A\sets N. g ` A \ sets M)" +proof - + have h:"bij_betw f (space M) (space N)" "f \ M \\<^sub>M N" "the_inv_into (space M) f \ N \\<^sub>M M" + using assms by(simp_all add: measurable_isomorphic_map_def) + show "f ` A \ sets N" if "A \ sets M" for A + proof - + have "f ` A = the_inv_into (space M) f -` A \ space N" + using the_inv_into_vimage[OF bij_betw_imp_inj_on[OF h(1)] sets.sets_into_space[OF that]] + by(simp add: bij_betw_imp_surj_on[OF h(1)]) + also have "... \ sets N" + using that h(3) by auto + finally show ?thesis . + qed + show "f \ M \\<^sub>M N" + using assms by(simp add: measurable_isomorphic_map_def) + + show "\g. bij_betw g (space N) (space M) \ g \ N \\<^sub>M M \ (\x \ space M. g (f x) = x) \ (\x\ space N. f (g x) = x) \ (\A\sets N. g ` A \ sets M)" + proof(rule exI[where x="the_inv_into (space M) f"]) + have *:"the_inv_into (space M) f ` A \ sets M" if "A \ sets N" for A + proof - + have "\x. x \ space M \ the_inv_into (space N) (the_inv_into (space M) f) x = f x" + by (metis bij_betw_imp_inj_on bij_betw_the_inv_into h(1) h(2) measurable_space the_inv_into_f_f) + from vimage_inter_cong[of "space M" _ f A,OF this] the_inv_into_vimage[OF bij_betw_imp_inj_on[OF bij_betw_the_inv_into[OF h(1)]] sets.sets_into_space[OF that]] + bij_betw_imp_surj_on[OF bij_betw_the_inv_into[OF h(1)]] measurable_sets[OF h(2) that] + show ?thesis + by fastforce + qed + show "bij_betw (the_inv_into (space M) f) (space N) (space M) \ the_inv_into (space M) f \ N \\<^sub>M M \ (\x\space M. the_inv_into (space M) f (f x) = x) \ (\x\space N. f (the_inv_into (space M) f x) = x) \ (\A\sets N. the_inv_into (space M) f ` A \ sets M)" + using bij_betw_the_inv_into[OF h(1)] + by (meson * bij_betw_imp_inj_on f_the_inv_into_f_bij_betw h(1) h(3) the_inv_into_f_f) + qed +qed + +lemma measurable_isomorphic_map_inv: + assumes "measurable_isomorphic_map M N f" + shows "measurable_isomorphic_map N M (the_inv_into (space M) f)" + using assms[simplified measurable_isomorphic_map_def] + by(auto intro!: measurable_isomorphic_map_byWitness[where g=f] bij_betw_the_inv_into f_the_inv_into_f_bij_betw[of f] bij_betw_imp_inj_on the_inv_into_f_f) + +lemma measurable_isomorphic_map_comp: + assumes "measurable_isomorphic_map M N f" and "measurable_isomorphic_map N L g" + shows "measurable_isomorphic_map M L (g \ f)" +proof - + obtain f' g' where + [measurable]: "f' \ N \\<^sub>M M" and hf:"\x. x\space M \ f' (f x) = x" "\x. x\space N \ f (f' x) = x" + and [measurable]: "g' \ L \\<^sub>M N" and hg:"\x. x\space N \ g' (g x) = x" "\x. x\space L \ g (g' x) = x" + using measurable_isomorphic_mapD'[OF assms(1)] measurable_isomorphic_mapD'[OF assms(2)] by metis + have [measurable]: "f \ M \\<^sub>M N" "g \ N \\<^sub>M L" + using assms by(auto simp: measurable_isomorphic_map_def) + from hf hg measurable_space[OF \f \ M \\<^sub>M N\] measurable_space[OF \g' \ L \\<^sub>M N\] show ?thesis + by(auto intro!: measurable_isomorphic_map_byWitness[where g="f'\g'"]) +qed + +definition measurable_isomorphic::"['a measure, 'b measure] \ bool" (infixr "measurable'_isomorphic" 50) where +"M measurable_isomorphic N \ (\f. measurable_isomorphic_map M N f)" + +lemma measurable_isomorphic_sets_cong: + assumes "sets M = sets M'" "sets N = sets N'" + shows "M measurable_isomorphic N \ M' measurable_isomorphic N'" + using measurable_isomorphic_map_sets_cong[OF assms] + by(auto simp: measurable_isomorphic_def) + + +lemma measurable_isomorphicD: + assumes "M measurable_isomorphic N" + shows "\f g. f \ M \\<^sub>M N \ g \ N \\<^sub>M M \ (\x\space M. g (f x) = x) \ (\y\space N. f (g y) = y) \ (\A\sets M. f ` A \ sets N) \ (\A\sets N. g ` A \ sets M)" + using assms measurable_isomorphic_mapD'[of M N] + by (metis (mono_tags, lifting) measurable_isomorphic_def) + +lemma measurable_isomorphic_byWitness: + assumes "f \ M \\<^sub>M N" "\x. x\space M \ g (f x) = x" + and "g \ N \\<^sub>M M" "\y. y\space N \ f (g y) = y" + shows "M measurable_isomorphic N" + by(auto simp: measurable_isomorphic_def assms intro!: exI[where x = f] measurable_isomorphic_map_byWitness[where g=g]) + +lemma measurable_isomorphic_refl: + "M measurable_isomorphic M" + by(auto intro!: measurable_isomorphic_byWitness[where f=id and g=id]) + +lemma measurable_isomorphic_sym: + assumes "M measurable_isomorphic N" + shows "N measurable_isomorphic M" + using assms measurable_isomorphic_map_inv[of M N] + by(auto simp: measurable_isomorphic_def) + +lemma measurable_isomorphic_trans: + assumes "M measurable_isomorphic N" and "N measurable_isomorphic L" + shows "M measurable_isomorphic L" + using assms measurable_isomorphic_map_comp[of M N _ L] + by(auto simp: measurable_isomorphic_def) + +lemma measurable_isomorphic_empty: + assumes "space M = {}" "space N = {}" + shows "M measurable_isomorphic N" + using assms by(auto intro!: measurable_isomorphic_byWitness[where f=undefined and g=undefined] simp: measurable_empty_iff) + +lemma measurable_isomorphic_empty1: + assumes "space M = {}" "M measurable_isomorphic N" + shows "space N = {}" + using measurable_isomorphicD[OF assms(2)] by(auto simp: measurable_empty_iff[OF assms(1)]) + +lemma measurable_ismorphic_empty2: + assumes "space N = {}" "M measurable_isomorphic N" + shows "space M = {}" + using measurable_isomorphic_sym[OF assms(2)] assms(1) + by(simp add: measurable_isomorphic_empty1) + +lemma measurable_lift_product: + assumes "\i. i \ I \ f i \ (M i) \\<^sub>M (N i)" + shows "(\x i. if i \ I then f i (x i) else undefined) \ (\\<^sub>M i\I. M i) \\<^sub>M (\\<^sub>M i\I. N i)" + using measurable_space[OF assms] + by(auto intro!: measurable_PiM_single' simp: assms measurable_PiM_component_rev space_PiM PiE_iff) + +lemma measurable_isomorphic_map_lift_product: + assumes "\i. i \ I \ measurable_isomorphic_map (M i) (N i) (h i)" + shows "measurable_isomorphic_map (\\<^sub>M i\I. M i) (\\<^sub>M i\I. N i) (\x i. if i \ I then h i (x i) else undefined)" +proof - + obtain h' where + "\i. i \ I \ h' i \ (N i) \\<^sub>M (M i)" "\i x. i \ I \ x\space (M i) \ h' i (h i x) = x" "\i x. i \ I \ x\space (N i) \ h i (h' i x) = x" + using measurable_isomorphic_mapD'(3)[OF assms] by metis + thus ?thesis + by(auto intro!: measurable_isomorphic_map_byWitness[OF measurable_lift_product[of I h M N,OF measurable_isomorphic_mapD'(2)[OF assms]] measurable_lift_product[of I h' N M,OF \\i. i \ I \ h' i \ (N i) \\<^sub>M (M i)\]] + simp: space_PiM PiE_iff extensional_def) +qed + +lemma measurable_isomorphic_lift_product: + assumes "\i. i \ I \ (M i) measurable_isomorphic (N i)" + shows "(\\<^sub>M i\I. M i) measurable_isomorphic (\\<^sub>M i\I. N i)" +proof - + obtain h where "\i. i \ I \ measurable_isomorphic_map (M i) (N i) (h i)" + using assms by(auto simp: measurable_isomorphic_def) metis + thus ?thesis + by(auto intro!: measurable_isomorphic_map_lift_product exI[where x="\x i. if i \ I then h i (x i) else undefined"] simp: measurable_isomorphic_def) +qed + +text \\<^url>\https://math24.net/cantor-schroder-bernstein-theorem.html\\ +lemma Schroeder_Bernstein_measurable': + assumes "f ` (space M) \ sets N" "g ` (space N) \ sets M" + and "measurable_isomorphic_map M (restrict_space N (f ` (space M))) f" and "measurable_isomorphic_map N (restrict_space M (g ` (space N))) g" + shows "\h. measurable_isomorphic_map M N h" +proof - + have hset:"\A. A \ sets M \ f ` A \ sets (restrict_space N (f ` space M))" + "\A. A \ sets N \ g ` A \ sets (restrict_space M (g ` space N))" + and hfg[measurable]:"f \ M \\<^sub>M restrict_space N (f ` space M)" + "g \ N \\<^sub>M restrict_space M (g ` space N)" + using measurable_isomorphic_mapD'(1,2)[OF assms(3)] measurable_isomorphic_mapD'(1,2)[OF assms(4)] assms(1,2) + by auto + have hset2:"\A. A \ sets M \ f ` A \ sets N" "\A. A \ sets N \ g ` A \ sets M" + and hfg2[measurable]: "f \ M \\<^sub>M N" "g \ N \\<^sub>M M" + using sets.Int_space_eq2[OF assms(1)] sets.Int_space_eq2[OF assms(2)] sets_restrict_space_iff[of "f ` space M" N] sets_restrict_space_iff[of "g ` space N" M] hset + measurable_restrict_space2_iff[of f M N] measurable_restrict_space2_iff[of g N M] hfg assms(1,2) + by auto + have bij1:"bij_betw f (space M) (f ` (space M))" "bij_betw g (space N) (g ` (space N))" + using assms(3,4) by(auto simp: measurable_isomorphic_map_def space_restrict_space sets.Int_space_eq2[OF assms(1)] sets.Int_space_eq2[OF assms(2)]) + obtain f' g' where + hfg1'[measurable]: "f' \ restrict_space N (f ` (space M)) \\<^sub>M M" "g' \ restrict_space M (g ` (space N)) \\<^sub>M N" + and hfg':"\x. x\space M \ f' (f x) = x" "\x. x\f ` space M \ f (f' x) = x" + "\x. x\space N \ g' (g x) = x" "\x. x\g ` space N \ g (g' x) = x" + "bij_betw f' (f ` space M) (space M)" "bij_betw g' (g ` space N) (space N)" + using measurable_isomorphic_mapD'(3)[OF assms(3)] measurable_isomorphic_mapD'(3)[OF assms(4)] sets.Int_space_eq2[OF assms(1)] sets.Int_space_eq2[OF assms(2)] + by (metis space_restrict_space) + + have hgfA:"(g \ f) ` A \ sets M" if "A \ sets M" for A + using hset2(2)[OF hset2(1)[OF that]] by(simp add: image_comp) + define An where "An \ (\n. ((g \ f)^^n) ` (space M - g ` (space N)))" + define A where "A \ (\n\UNIV. An n)" + have "An n \ sets M" for n + proof(induction n) + case 0 + thus ?case + using hset2[OF sets.top] by(simp add: An_def) + next + case ih:(Suc n) + have "An (Suc n) = (g \ f) ` (An n)" + by(auto simp add: An_def) + thus ?case + using hgfA[OF ih] by simp + qed + hence Asets:"A \ sets M" + by(simp add: A_def) + have Acompl:"space M - A \ g ` space N" + proof - + have "space M - A \ space M - An 0" + by(auto simp: A_def) + also have "... \ g ` space N" + by(auto simp: An_def) + finally show ?thesis . + qed + define h where "h \ (\x. if x \ A \ (- space M) then f x else g' x)" + define h' where "h' \ (\x. if x \ f ` A then f' x else g x)" + have xinA_iff:"x \ A \ h x \ f ` A" if "x \ space M" for x + proof + assume "h x \ f ` A" + show "x \ A" + proof(rule ccontr) + assume "x \ A" + then have "\n. x \ An n" + by(auto simp: A_def) + from this[of 0] have "x \ g ` (space N)" + using that by(auto simp: An_def) + have "g' x \ f ` A " + using \h x \ f ` A\ \x \ A\ + by (simp add: h_def that) + hence "g (g' x) \ (g \ f) ` A" + by auto + hence "x \ (g \ f) ` A" + using \x \ g ` (space N)\ by (simp add: hfg'(4)) + then obtain n where "x \ (g \ f) ` (An n)" + by(auto simp: A_def) + hence "x \ An (Suc n)" + by(auto simp: An_def) + thus False + using \\n. x \ An n\ by simp + qed + qed(simp add: h_def) + + show ?thesis + proof(intro exI[where x=h] measurable_isomorphic_map_byWitness[where g=h']) + have "{x \ space M. x \ A \ (- space M)} \ sets M" + using sets.Int_space_eq2[OF Asets] Asets by simp + moreover have "f \ restrict_space M {x. x \ A \ - space M} \\<^sub>M N" + by (simp add: measurable_restrict_space1) + moreover have "g' \ restrict_space M {x. x \ A \ (- space M)} \\<^sub>M N" + proof - + have "sets (restrict_space (restrict_space M (g ` space N)) {x. x \ A \ - space M}) = sets (restrict_space M (g ` space N \ {x. x \ A \ - space M}))" + by(simp add: sets_restrict_restrict_space) + also have "... = sets (restrict_space M (g ` space N \ {x. x \ space M - A}))" + by (metis Compl_iff DiffE DiffI Un_iff) + also have "... = sets (restrict_space M {x. x \ space M - A})" + by (metis Acompl le_inf_iff mem_Collect_eq subsetI subset_antisym) + also have "... = sets (restrict_space M {x. x \ A \ (- space M)})" + by (metis Compl_iff DiffE DiffI Un_iff) + finally have "sets (restrict_space (restrict_space M (g ` space N)) {x. x \ A \ - space M}) = sets (restrict_space M {x. x \ A \ - space M})" . + from measurable_cong_sets[OF this refl] measurable_restrict_space1[OF hfg1'(2),of " {x. x \ A \ - space M}"] + show ?thesis by auto + qed + ultimately show "h \ M \\<^sub>M N" + by(simp add: h_def measurable_If_restrict_space_iff) + next + have "{x \ space N. x \ f ` A} \ sets N" + using sets.Int_space_eq2[OF hset2(1)[OF Asets]] hset2(1)[OF Asets] by simp + moreover have "f' \ restrict_space N {x. x \ f ` A} \\<^sub>M M" + proof - + have "sets (restrict_space (restrict_space N (f ` space M)) {x. x \ f ` A}) = sets (restrict_space N (f ` space M \ {x. x \ f ` A}))" + by(simp add: sets_restrict_restrict_space) + also have "... = sets (restrict_space N {x. x \ f ` A})" + proof - + have "f ` space M \ {x. x \ f ` A} = {x. x \ f ` A}" + using sets.sets_into_space[OF Asets] by auto + thus ?thesis by simp + qed + finally have "sets (restrict_space (restrict_space N (f ` space M)) {x. x \ f ` A}) = sets (restrict_space N {x. x \ f ` A})" . + from measurable_cong_sets[OF this refl] measurable_restrict_space1[OF hfg1'(1),of "{x. x \ f ` A}"] + show ?thesis by auto + qed + moreover have "g \ restrict_space N {x. x \ f ` A} \\<^sub>M M" + by (simp add: measurable_restrict_space1) + ultimately show "h' \ N \\<^sub>M M" + by(simp add: h'_def measurable_If_restrict_space_iff) + next + fix x + assume "x \ space M" + then consider "x \ A" | "x \ space M - A" by auto + thus "h' (h x) = x" + proof cases + case xa:2 + hence "h x \ f ` A" + using \x \ space M\ xinA_iff by blast + thus ?thesis + using Acompl hfg'(4) xa by(auto simp add: h_def h'_def) + qed(simp add: h_def h'_def \x \ space M\ hfg'(1)) + next + fix x + assume "x \ space N" + then consider "x \ f ` A" | "x \ space N - f ` A" by auto + thus "h (h' x) = x" + proof cases + case hx:1 + hence "x \ f ` (space M)" + using image_mono[OF sets.sets_into_space[OF Asets],of f] by auto + have "h' x = f' x" + using hx by(simp add: h'_def) + also have "... \ A" + using hx sets.sets_into_space[OF Asets] hfg'(1) by auto + finally show ?thesis + using hfg'(2)[OF \x \ f ` (space M)\] hx by(auto simp: h_def h'_def) + next + case hx:2 + then have "h' x = g x" + by(simp add: h'_def) + also have "... \ A" + proof(rule ccontr) + assume "\ g x \ A" + then have "g x \ A" by simp + then obtain n where hg:"g x \ An n" by(auto simp: A_def) + hence "0 < n" using hx by(auto simp: An_def) + then obtain n' where [simp]:"n = Suc n'" + using not0_implies_Suc by blast + then have "g x \ g ` f ` An n'" + using hg by(auto simp: An_def) + hence "x \ f ` An n'" + using inj_on_image_mem_iff[OF bij_betw_imp_inj_on[OF bij1(2)] \x \ space N\,of "f ` An n'"] + sets.sets_into_space[OF \An n' \ sets M\] measurable_space[OF hfg2(1)] by auto + also have "... \ f ` A" + by(auto simp: A_def) + finally show False + using hx by simp + qed + finally show ?thesis + using hx hfg'(3)[OF \x \ space N\] measurable_space[OF hfg2(2) \x \ space N\] + by(auto simp: h_def h'_def) + qed + qed +qed + +lemma Schroeder_Bernstein_measurable: + assumes "f \ M \\<^sub>M N" "\A. A \ sets M \ f ` A \ sets N" "inj_on f (space M)" + and "g \ N \\<^sub>M M" "\A. A \ sets N \ g ` A \ sets M" "inj_on g (space N)" + shows "\h. measurable_isomorphic_map M N h" + using Schroeder_Bernstein_measurable'[OF assms(2)[OF sets.top] assms(5)[OF sets.top] measurable_isomorphic_map_restrict_space[OF assms(1-3)] measurable_isomorphic_map_restrict_space[OF assms(4-6)]] + by simp + +lemma measurable_isomorphic_from_embeddings: + assumes "M measurable_isomorphic (restrict_space N B)" "N measurable_isomorphic (restrict_space M A)" + and "A \ sets M" "B \ sets N" + shows "M measurable_isomorphic N" +proof - + obtain f g where fg:"measurable_isomorphic_map M (restrict_space N B) f" "measurable_isomorphic_map N (restrict_space M A) g" + using assms(1,2) by(auto simp: measurable_isomorphic_def) + have [simp]:"f ` space M = B" "g ` space N = A" + using measurable_isomorphic_map_surj[OF fg(1)] measurable_isomorphic_map_surj[OF fg(2)] sets.sets_into_space[OF assms(3)] sets.sets_into_space[OF assms(4)] + by(auto simp: space_restrict_space) + obtain h where "measurable_isomorphic_map M N h" + using Schroeder_Bernstein_measurable'[of f M N g] assms(3,4) fg by auto + thus ?thesis + by(auto simp: measurable_isomorphic_def) +qed + +lemma measurable_isomorphic_antisym: + assumes "B measurable_isomorphic (restrict_space C c)" "A measurable_isomorphic (restrict_space B b)" + and "c \ sets C" "b \ sets B" "C measurable_isomorphic A" + shows "C measurable_isomorphic B" + by(rule measurable_isomorphic_from_embeddings[OF measurable_isomorphic_trans[OF assms(5,2)] assms(1) assms(3,4)]) + +lemma countable_infinite_isomorphisc_to_nat_index: + assumes "countable I" and "infinite I" + shows "(\\<^sub>M x\I. M) measurable_isomorphic (\\<^sub>M (x::nat)\UNIV. M)" +proof(rule measurable_isomorphic_byWitness[where f="\x n. x (from_nat_into I n)" and g="\x. \i\I. x (to_nat_on I i)"]) + show "(\x n. x (from_nat_into I n)) \ (\\<^sub>M x\I. M) \\<^sub>M (\\<^sub>M (x::nat)\UNIV. M)" + by(auto intro!: measurable_PiM_single' measurable_component_singleton[OF from_nat_into[OF infinite_imp_nonempty[OF assms(2)]]]) + (simp add: PiE_iff infinite_imp_nonempty space_PiM from_nat_into[OF infinite_imp_nonempty[OF assms(2)]]) +next + show "(\x. \i\I. x (to_nat_on I i)) \ (\\<^sub>M (x::nat)\UNIV. M) \\<^sub>M (\\<^sub>M x\I. M)" + by(auto intro!: measurable_PiM_single') +next + show "x \ space (\\<^sub>M x\I. M) \ (\i\I. x (from_nat_into I (to_nat_on I i))) = x" for x + by (simp add: assms(1) restrict_ext space_PiM) +next + show "y \ space (Pi\<^sub>M UNIV (\x. M)) \ (\n. (\i\I. y (to_nat_on I i)) (from_nat_into I n)) = y" for y + by (simp add: assms(1) assms(2) from_nat_into infinite_imp_nonempty) +qed + +lemma PiM_PiM_isomorphic_to_PiM: + "(\\<^sub>M i\I. \\<^sub>M j\J. M i j) measurable_isomorphic (\\<^sub>M (i,j)\I\J. M i j)" +proof(rule measurable_isomorphic_byWitness[where f="\x (i,j). if (i,j) \ I \ J then x i j else undefined" and g="\x i j. if i \ I then undefined j else if j \ J then undefined else x (i,j)"]) + have [simp]: "(\\. \ a b) \ (\\<^sub>M i\I. \\<^sub>M j\J. M i j) \\<^sub>M M a b" if "a \ I" "b \ J" for a b + using measurable_component_singleton[OF that(1),of "\i. \\<^sub>M j\J. M i j"] measurable_component_singleton[OF that(2),of "M a"] + by auto + show "(\x (i, j). if (i, j) \ I \ J then x i j else undefined) \ (\\<^sub>M i\I. \\<^sub>M j\J. M i j) \\<^sub>M (\\<^sub>M (i,j)\I\J. M i j)" + apply(rule measurable_PiM_single') + apply auto[1] + apply(auto simp: PiE_def Pi_def space_PiM extensional_def;meson) + done +next + have [simp]: "(\\. \ (i, j)) \ Pi\<^sub>M (I \ J) (\(i, j). M i j) \\<^sub>M M i j" if "i \ I" "j \ J" for i j + using measurable_component_singleton[of "(i,j)" "I \ J" "\(i, j). M i j"] that by auto + show "(\x i j. if i \ I then undefined j else if j \ J then undefined else x (i, j)) \ (\\<^sub>M (i,j)\I\J. M i j) \\<^sub>M (\\<^sub>M i\I. \\<^sub>M j\J. M i j)" + by(auto intro!: measurable_PiM_single') (simp_all add: PiE_iff space_PiM extensional_def) +next + show "x \ space (\\<^sub>M i\I. \\<^sub>M j\J. M i j) \ (\i j. if i \ I then undefined j else if j \ J then undefined else case (i, j) of (i, j) \ if (i, j) \ I \ J then x i j else undefined) = x" for x + by standard+ (auto simp: space_PiM PiE_def Pi_def extensional_def) +next + show "y \ space (\\<^sub>M (i,j)\I\J. M i j) \ (\(i, j). if (i, j) \ I \ J then if i \ I then undefined j else if j \ J then undefined else y (i, j) else undefined) = y" for y + by standard+ (auto simp: space_PiM PiE_def Pi_def extensional_def) +qed + +lemma measurable_isomorphic_map_sigma_sets: + assumes "sets M = sigma_sets (space M) U" "measurable_isomorphic_map M N f" + shows "sets N = sigma_sets (space N) ((`) f ` U)" +proof - + from measurable_isomorphic_mapD'[OF assms(2)] + obtain g where h: "\A. A \ sets M \ f ` A \ sets N" "f \ M \\<^sub>M N" "bij_betw g (space N) (space M)" "g \ N \\<^sub>M M" "\x. x\space M \ g (f x) = x" "\x. x\space N \ f (g x) = x" "\A. A\sets N \ g ` A \ sets M" + by metis + interpret s: sigma_algebra "space N" "sigma_sets (space N) ((`) f ` U)" + by(auto intro!: sigma_algebra_sigma_sets) (metis assms(1) h(2) measurable_space sets.sets_into_space sigma_sets_superset_generator subsetD) + show ?thesis + proof safe + fix x + assume "x \ sets N" + from h(7)[OF this] assms(1) + have "g ` x \ sigma_sets (space M) U" by simp + hence "f ` (g ` x) \ sigma_sets (space N) ((`) f ` U)" + proof induction + case h:(Compl a) + have "f ` (space M - a) = f ` (space M) - f ` a" + by(rule inj_on_image_set_diff[where C="space M"], insert assms h) (auto simp: measurable_isomorphic_map_def bij_betw_def sets.sets_into_space) + with h show ?case + by (metis assms(2) measurable_isomorphic_map_surj s.Diff s.top) + qed (auto simp: image_UN) + moreover have "f ` (g ` x) = x" + using sets.sets_into_space[OF \x \ sets N\] h(6) by(fastforce simp: image_def) + ultimately show "x \ sigma_sets (space N) ((`) f ` U)" by simp + next + interpret s': sigma_algebra "space M" "sigma_sets (space M) U" + by(simp add: assms(1)[symmetric] sets.sigma_algebra_axioms) + have 1:"\x. x \ U \ x \ space M" + by (simp add: s'.sets_into_space) + fix x + assume assm:"x \ sigma_sets (space N) ((`) f ` U)" + then show "x \ sets N" + by induction (auto simp: assms(1) h(1)) + qed +qed + +end \ No newline at end of file diff --git a/thys/Standard_Borel_Spaces/ROOT b/thys/Standard_Borel_Spaces/ROOT new file mode 100644 --- /dev/null +++ b/thys/Standard_Borel_Spaces/ROOT @@ -0,0 +1,13 @@ +chapter AFP + +session "Standard_Borel_Spaces" = "HOL-Probability" + + options [timeout = 600] + theories + "Lemmas_StandardBorel" + "Set_Based_Metric_Space" "Set_Based_Metric_Product" + "Abstract_Metrizable_Topology" + "StandardBorel" + "Space_of_Continuous_Maps" + document_files + "root.tex" + "root.bib" diff --git a/thys/Standard_Borel_Spaces/Set_Based_Metric_Product.thy b/thys/Standard_Borel_Spaces/Set_Based_Metric_Product.thy new file mode 100644 --- /dev/null +++ b/thys/Standard_Borel_Spaces/Set_Based_Metric_Product.thy @@ -0,0 +1,1433 @@ +(* Title: Set_Based_Metric_Product.thy + Author: Michikazu Hirata, Tokyo Institute of Technology +*) + +subsection \ Product Metric Spaces \ + +theory Set_Based_Metric_Product + imports Set_Based_Metric_Space +begin + +lemma nsum_of_r': + fixes r :: real + assumes r:"0 < r" "r < 1" + shows "(\n. r^(n + k) * K) = r^k / (1 - r) * K" + (is "?lhs = _") +proof - + have "?lhs = (\n. r^n * K) - (\n\{..n\{..n. r^n" "{.. real" + assumes r:"0 < r" "r < 1" + and a:"\n. 0 \ a n" "\n. a n \ K" + shows "0 \ (\n. r^(n + k) * a (n + l))" "(\n. r^(n + k) * a (n + l)) \ r^k / (1 - r) * K" +proof - + have [simp]: "summable (\n. r ^ (n + k) * a (n + l))" + apply(rule summable_comparison_test'[of "\n. r^(n+k) * K"]) + using r a by(auto intro!: summable_mult2) + show "0 \ (\n. r^(n + k) * a (n + l))" + using r a by(auto intro!: suminf_nonneg) + have "(\n. r^(n + k) * a (n + l)) \ (\n. r^(n + k) * K)" + using a r by(auto intro!: suminf_le summable_mult2) + also have "... = r^k / (1 - r) * K" + by(rule nsum_of_r'[OF r]) + finally show "(\n. r^(n + k) * a (n + l)) \ r^k / (1 - r) * K" . +qed + +lemma nsum_of_r_le: + fixes r :: real and a :: "nat \ real" + assumes r:"0 < r" "r < 1" + and a:"\n. 0 \ a n" "\n. a n \ K" "\n'\ l. a n' < K" + shows "(\n. r^(n + k) * a (n + l)) < r^k / (1 - r) * K" +proof - + obtain n' where hn': "a (n' + l) < K" + using a(3) by (metis add.commute le_iff_add) + define a' where "a' = (\n. if n = n' + l then K else a n)" + have a': "\n. 0 \ a' n" "\n. a' n \ K" + using a(1,2) le_trans order.trans[OF a(1,2)[of 0]] by(auto simp: a'_def) + have [simp]: "summable (\n. r ^ (n + k) * a (n + l))" + apply(rule summable_comparison_test'[of "\n. r^(n+k) * K"]) + using r a by(auto intro!: summable_mult2) + have [simp]: "summable (\n. r^(n + k) * a' (n + l))" + apply(rule summable_comparison_test'[of "\n. r^(n+k) * K"]) + using r a' by(auto intro!: summable_mult2) + have "(\n. r^(n + k) * a (n + l)) = (\n. r^(n + Suc n' + k) * a (n + Suc n'+ l)) + (\in. r^(n + Suc n' + k) * a (n + Suc n'+ l)) + (\in. r^(n + Suc n' + k) * a (n + Suc n'+ l)) + (\in. r^(n + Suc n' + k) * a' (n + Suc n'+ l)) + (\in. r^(n + k) * a' (n + l))" + by(rule suminf_split_initial_segment[symmetric]) simp + also have "... \ r^k / (1 - r) * K" + by(rule nsum_of_r_leq[OF r a']) + finally show ?thesis . +qed + +definition product_dist' :: "[real, 'i set, nat \ 'i, 'i \ 'a set, 'i \ 'a \ 'a \ real] \ ('i \ 'a) \ ('i \ 'a) \ real" where +product_dist_def: "product_dist' r I g S d \ (\x y. if x \ (\\<^sub>E i\I. S i) \ y \ (\\<^sub>E i\I. S i) then (\n. if g n \ I then r^n * d (g n) (x (g n)) (y (g n)) else 0) else 0)" + +text \ $d(x,y) = \sum_{n\in \mathbb{N}} r^n * d_{g_I(i)}(x_{g_I(i)},y_{g_I(i)})$.\ +locale product_metric = + fixes r :: real + and I :: "'i set" + and f :: "'i \ nat" + and g :: "nat \ 'i" + and S :: "'i \ 'a set" + and d :: "'i \ 'a \ 'a \ real" + and K :: real + assumes r: "0 < r" "r < 1" + and I: "countable I" + and gf_comp_id : "\i. i \ I \ g (f i) = i" + and gf_if_finite: "finite I \ bij_betw f I {..< card I}" + "finite I \ bij_betw g {..< card I} I" + and gf_if_infinite: "infinite I \ bij_betw f I UNIV" + "infinite I \ bij_betw g UNIV I" + "\n. infinite I \ f (g n) = n" + and sd_metric: "\i. i \ I \ metric_set (S i) (d i)" + and d_nonneg: "\i x y. 0 \ d i x y" + and d_bound: "\i x y. d i x y \ K" + and K_pos : "0 < K" + +lemma from_nat_into_to_nat_on_product_metric_pair: + assumes "countable I" + shows "\i. i \ I \ from_nat_into I (to_nat_on I i) = i" + and "finite I \ bij_betw (to_nat_on I) I {..< card I}" + and "finite I \ bij_betw (from_nat_into I) {..< card I} I" + and "infinite I \ bij_betw (to_nat_on I) I UNIV" + and "infinite I \ bij_betw (from_nat_into I) UNIV I" + and "\n. infinite I \ to_nat_on I (from_nat_into I n) = n" + by(simp_all add: assms to_nat_on_finite bij_betw_from_nat_into_finite to_nat_on_infinite bij_betw_from_nat_into) + +lemma product_metric_pair_finite_nat: + "bij_betw id {..n} {..< card {..n}}" "bij_betw id {..< card {..n}} {..n}" + by(auto simp: bij_betw_def) + +lemma product_metric_pair_finite_nat': + "bij_betw id {.. product_dist' r I g S d" + +lemma nsum_of_rK: "(\n. r^(n + k)*K) = r^k / (1 - r) * K" + by(rule nsum_of_r'[OF r]) + +lemma i_min: + assumes "i \ I" "g n = i" + shows "f i \ n" +proof(cases "finite I") + case h:True + show ?thesis + proof(rule ccontr) + assume "\ f i \ n" + then have h0:"n < f i" by simp + have "f i \ {.. {.. f i" + using h0 \f i \ {.. by auto + ultimately have "g n \ g (f i)" + using bij_betw_imp_inj_on[OF gf_if_finite(2)[OF h]] + by (simp add: inj_on_contraD) + thus False + by(simp add: gf_comp_id[OF assms(1)] assms(2)) + qed +next + show "infinite I \ f i \ n" + using assms(2) gf_if_infinite(3)[of n] by simp +qed + +lemma g_surj: + assumes "i \ I" + shows "\n. g n = i" + using gf_comp_id[of i] assms by auto + +lemma product_dist_summable'[simp]: + "summable (\n. r^n * d (g n) (x (g n)) (y (g n)))" + apply(rule summable_comparison_test'[of "\n. r^n * K"]) + using r d_nonneg d_bound K_pos by(auto intro!: summable_mult2) + +lemma product_dist_summable[simp]: + "summable (\n. if g n \ I then r^n * d (g n) (x (g n)) (y (g n)) else 0)" + by(rule summable_comparison_test'[of "\n. r^n * d (g n) (x (g n)) (y (g n))"]) (use r d_nonneg d_bound K_pos in auto) + +lemma summable_rK[simp]: "summable (\n. r^n * K)" + using r by(auto intro!: summable_mult2) + +lemma product_dist_distance: "metric_set (\\<^sub>E i\I. S i) product_dist" +proof - + have h': "\i xi yi. i \ I \ xi \ S i \ yi \ S i \ xi = yi \ d i xi yi = 0" + "\i xi yi. i \ I \ d i xi yi = d i yi xi" + "\i xi yi zi. i \ I \ xi \ S i \ yi \ S i \ zi \ S i \ d i xi zi \ d i xi yi + d i yi zi" + using sd_metric by(auto simp: metric_set_def) + show ?thesis + proof + show "\x y. 0 \ product_dist x y" + using d_nonneg r by(auto simp: product_dist_def intro!: suminf_nonneg product_dist_summable) + next + show "\x y. x \ (\\<^sub>E i\I. S i) \ product_dist x y = 0" + by(auto simp: product_dist_def) + next + fix x y + assume hxy:"x \ (\\<^sub>E i\I. S i)" "y \ (\\<^sub>E i\I. S i)" + show "(x = y) \ (product_dist x y = 0)" + proof + assume heq:"x = y" + then have "(if g n \ I then r ^ n * d (g n) (x (g n)) (y (g n)) else 0) = 0" for n + using hxy h'(1)[of "g n" "x (g n)" "y (g n)"] by(auto simp: product_dist_def) + thus "product_dist x y = 0" + by(auto simp: product_dist_def) + next + assume h0:"product_dist x y = 0" + have "(\n. if g n \ I then r ^ n * d (g n) (x (g n)) (y (g n)) else 0) = 0 + \ (\n. (if g n \ I then r^n * d (g n) (x (g n)) (y (g n)) else 0) = 0)" + apply(rule suminf_eq_zero_iff) + using d_nonneg r by(auto simp: product_dist_def intro!: product_dist_summable) + hence hn0:"\n. (if g n \ I then r^n * d (g n) (x (g n)) (y (g n)) else 0) = 0" + using h0 hxy by(auto simp: product_dist_def) + show "x = y" + proof + fix i + consider "i \ I" | "i \ I" by auto + thus "x i = y i" + proof cases + case 1 + from g_surj[OF this] obtain n where + hn: "g n = i" by auto + have "d (g n) (x (g n)) (y (g n)) = 0" + using hn h'(1)[OF 1,of "x i" "y i"] hxy hn0[of n] 1 r by simp + thus ?thesis + using hn h'(1)[OF 1,of "x i" "y i"] hxy 1 by auto + next + case 2 + then show ?thesis + by(simp add: PiE_arb[OF hxy(1) 2] hxy PiE_arb[OF hxy(2) 2]) + qed + qed + qed + next + show "product_dist x y = product_dist y x" for x y + using h'(2) by(auto simp: product_dist_def) (metis (no_types, opaque_lifting)) + next + fix x y z + assume hxyz:"x \ (\\<^sub>E i\I. S i)" "y \ (\\<^sub>E i\I. S i)" "z \ (\\<^sub>E i\I. S i)" + have "(if g n \ I then r ^ n * d (g n) (x (g n)) (z (g n)) else 0) + \ (if g n \ I then r ^ n * d (g n) (x (g n)) (y (g n)) else 0) + (if g n \ I then r ^ n * d (g n) (y (g n)) (z (g n)) else 0)" for n + using h'(3)[of "g n" "x (g n)" "y (g n)" "z (g n)"] hxyz r + by(auto simp: distrib_left[of "r ^ n",symmetric]) + thus "product_dist x z \ product_dist x y + product_dist y z" + by(auto simp add: product_dist_def suminf_add[OF product_dist_summable[of x y] product_dist_summable[of y z]] hxyz intro!: suminf_le summable_add) + qed +qed + +sublocale metric_set "\\<^sub>E i\I. S i" "product_dist" + by(rule product_dist_distance) + +lemma product_dist_leqr: "product_dist x y \ 1 / (1 - r) * K" +proof - + have "product_dist x y \ (\n. if g n \ I then r^n * d (g n) (x (g n)) (y (g n)) else 0)" + proof - + consider "x \ (\\<^sub>E i\I. S i) \ y \ (\\<^sub>E i\I. S i)" | "\ (x \ (\\<^sub>E i\I. S i) \ y \ (\\<^sub>E i\I. S i))" by auto + then show ?thesis + proof cases + case 1 + then show ?thesis by(auto simp: product_dist_def) + next + case 2 + then have "product_dist x y = 0" + by(auto simp: product_dist_def) + also have "... \ (\n. if g n \ I then r^n * d (g n) (x (g n)) (y (g n)) else 0)" + using d_nonneg r by(auto intro!: suminf_nonneg product_dist_summable) + finally show ?thesis . + qed + qed + also have "... \ (\n. r^n * d (g n) (x (g n)) (y (g n)))" + using r d_nonneg d_bound by(auto intro!: suminf_le) + also have "... \ (\n. r^n * K)" + using r d_bound d_nonneg by(auto intro!: suminf_le) + also have "... = 1 / (1 - r) * K" + using r nsum_of_rK[of 0] by simp + finally show ?thesis . +qed + +lemma product_dist_geq: + assumes "i \ I" and "g n = i" "x \ (\\<^sub>E i\I. S i)" "y \ (\\<^sub>E i\I. S i)" + shows "d i (x i) (y i) \ (1/r)^n * product_dist x y" + (is "?lhs \ ?rhs") +proof - + interpret mi: metric_set "S i" "d i" + by(rule sd_metric[OF assms(1)]) + have "(\m. if m = f i then d (g m) (x (g m)) (y (g m)) else 0) sums d (g (f i)) (x (g (f i))) (y (g (f i)))" + by(rule sums_single) + also have "... = ?lhs" + by(simp add: gf_comp_id[OF assms(1)]) + finally have 1:"summable (\m. if m = f i then d (g m) (x (g m)) (y (g m)) else 0)" + "?lhs = (\m. (if m = f i then d (g m) (x (g m)) (y (g m)) else 0))" + by(auto simp: sums_iff) + note 1(2) + also have "... \ (\m. (1/r)^n * (if g m \ I then r^m * d (g m) (x (g m)) (y (g m)) else 0))" + proof(rule suminf_le) + show "summable (\m. (1/r)^n * (if g m \ I then r^m * d (g m) (x (g m)) (y (g m)) else 0))" + by(auto intro!: product_dist_summable) + next + fix k + have **:"1 \ (1/r) ^ n * r ^ f i" + proof - + have "(1/r) ^ n * (r ^ f i) = (1/r)^(n-f i) * (1/r)^(f i) * r ^ f i" + using r by(simp add: power_diff[OF _ i_min[OF assms(1,2)],of "1/r",simplified]) + also have "... = (1/r) ^ (n-f i)" + using r by (simp add: power_one_over) + finally show ?thesis + using r by auto + qed + have *:"g k \ I" if "k = f i" + using gf_comp_id[OF assms(1)] assms(1) that by auto + show "(if k = f i then d (g k) (x (g k)) (y (g k)) else 0) \ (1/r) ^ n * (if g k \ I then r ^ k * d (g k) (x (g k)) (y (g k)) else 0)" + using * d_nonneg r ** mult_right_mono[OF **] by(auto simp: vector_space_over_itself.scale_scale[of "(1 / r) ^ n"]) + qed(simp add: 1) + also have "... = ?rhs" + unfolding product_dist_def + using assms by(auto intro!: suminf_mult product_dist_summable) + finally show ?thesis . +qed + +lemma converge_to_iff: + assumes "xn \ sequence" "x \ (\\<^sub>E i\I. S i)" + shows "converge_to_inS xn x \ (\i\I. metric_set.converge_to_inS (S i) (d i) (\n. xn n i) (x i))" +proof safe + fix i + assume h:"converge_to_inS xn x" "i \ I" + then interpret m: metric_set "S i" "d i" + using sd_metric by blast + show "m.converge_to_inS (\n. xn n i) (x i)" + unfolding m.converge_to_inS_def2 + proof safe + show 1:"\x. xn x i \ S i" "x i \ S i" + using h by(auto simp: converge_to_inS_def) + next + fix \ :: real + assume "0 < \" + then obtain "r^ f i * \ > 0" using r by auto + then obtain N where N:"\n. n \ N \ product_dist (xn n) x < r^ f i * \" + using h(1) by(auto simp: converge_to_inS_def2) metis + show "\N. \n\N. d i (xn n i) (x i) < \" + proof(safe intro!: exI[where x=N]) + fix n + assume "N \ n" + have "d i (xn n i) (x i) \ (1 / r) ^ f i * product_dist (xn n) x" + using h by(auto intro!: product_dist_geq[OF h(2) gf_comp_id[OF h(2)]] simp: converge_to_inS_def) + also have "... < (1 / r) ^ f i * r^ f i * \" + using N[OF \N \ n\] r by auto + also have "... \ \" + by (simp add: \0 < \\ power_one_over) + finally show " d i (xn n i) (x i) < \" . + qed + qed +next + assume h:"\i\I. metric_set.converge_to_inS (S i) (d i) (\n. xn n i) (x i)" + show "converge_to_inS xn x" + unfolding converge_to_inS_def2 + proof safe + fix \ + assume he:"(0::real) < \" + then have "0 < \*((1-r)/K)" using r K_pos by auto + hence "\k. r^k < \*((1-r)/K)" + using r(2) real_arch_pow_inv by blast + then obtain l where "r^l < \*((1-r)/K)" by auto + hence hk:"r^l/(1-r)*K < \" + using mult_imp_div_pos_less[OF divide_pos_pos[OF _ K_pos,of "1-r"]] r(2) by simp + hence hke: "0 < \ - r^l/(1-r)*K" by auto + consider "l = 0" | "0 < l" by auto + then show "\N. \n\N. product_dist (xn n) x < \" + proof cases + case 1 + then have he2:"1 / (1 - r)*K < \" using hk by auto + show ?thesis + using order.strict_trans1[OF product_dist_leqr he2] + by(auto simp: complete_metric_set_def intro!: exI[where x=0]) + next + case 2 + with hke have "0 < 1 / real l * (\ - r^l/(1-r)*K)" by auto + hence "\i\I. \N. \n\N. d i (xn n i) (x i) < 1 / real l * (\ - r^l/(1-r)*K)" + using h metric_set.converge_to_inS_def2[OF sd_metric] by auto + then obtain N where hn: + "\i n. i \ I \ n \ N i \ d i (xn n i) (x i) < 1 / real l * (\ - r^l/(1-r)*K)" + by metis + show ?thesis + proof(safe intro!: exI[where x="Sup {N (g n) | n. n < l}"]) + fix n + assume hsup:"\ {N (g n) |n. n < l} \ n" + have "product_dist (xn n) x = (\m. if g m \ I then r ^ m * d (g m) (xn n (g m)) (x (g m)) else 0)" + using assms by(auto simp: product_dist_def) + also have "... = (\m. if g (m + l) \ I then r ^ (m + l)* d (g (m + l)) (xn n (g (m + l))) (x (g (m + l))) else 0) + (\m I then r ^ m * d (g m) (xn n (g m)) (x (g m)) else 0)" + by(auto intro!: suminf_split_initial_segment) + also have "... \ r^l/(1-r)*K + (\m I then r ^ m * d (g m) (xn n (g m)) (x(g m)) else 0)" + proof - + have "(\m. if g (m + l) \ I then r ^ (m + l)* d (g (m + l)) (xn n (g (m + l))) (x (g (m + l))) else 0) \ (\m. r^(m + l)*K)" + using d_bound assms r K_pos by(auto intro!: suminf_le summable_ignore_initial_segment) + also have "... = r^l/(1-r)*K" + by(rule nsum_of_rK) + finally show ?thesis by auto + qed + also have "... \ r^l / (1 - r)*K + (\m I then d (g m) (xn n (g m)) (x (g m)) else 0)" + proof - + have " (\m I then r ^ m * d (g m) (xn n (g m)) (x (g m)) else 0) \ (\m I then d (g m) (xn n (g m)) (x (g m)) else 0)" + using d_bound d_nonneg r by(auto intro!: sum_mono simp: mult_left_le_one_le power_le_one) + thus ?thesis by simp + qed + also have "... < r^l / (1 - r)*K + (\m - r^l/(1-r)*K))" + proof - + have "(\m I then d (g m) (xn n (g m)) (x (g m)) else 0) < (\m - r^l/(1-r)*K))" + proof(rule sum_strict_mono_ex1) + show "\p\{.. I then d (g p) (xn n (g p)) (x (g p)) else 0) \ 1 / real l * (\ - r ^ l / (1 - r)*K)" + proof - + have "0 \ (\ - r ^ l * K / (1 - r)) / real l" + using hke by auto + moreover { + fix p + assume "p < l" "g p \ I" + then have "N (g p) \ {N (g n) |n. n < l}" + by auto + from le_cSup_finite[OF _ this] hsup have "N (g p) \ n" + by auto + hence "d (g p) (xn n (g p)) (x (g p)) \ (\ - r ^ l *K/ (1 - r)) / real l" + using hn[OF \g p \ I\,of n] by simp + } + ultimately show ?thesis + by auto + qed + next + show "\a\{.. I then d (g a) (xn n (g a)) (x (g a)) else 0) < 1 / real l * (\ - r ^ l / (1 - r)*K)" + proof - + have "0 < (\ - r ^ l * K / (1 - r)) / real l" + using hke 2 by auto + moreover { + assume "g 0 \ I" + have "N (g 0) \ {N (g n) |n. n < l}" + using 2 by auto + from le_cSup_finite[OF _ this] hsup have "N (g 0) \ n" + by auto + hence "d (g 0) (xn n (g 0)) (x (g 0)) < (\ - r ^ l * K/ (1 - r)) / real l" + using hn[OF \g 0 \ I\,of n] by simp + } + ultimately show ?thesis + by(auto intro!: bexI[where x=0] simp: 2) + qed + qed simp + thus ?thesis by simp + qed + also have "... = \" + using 2 by auto + finally show "product_dist (xn n) x < \" . + qed + qed + qed (use assms in auto) +qed + +lemma product_dist_mtopology: "product_topology (\i. metric_set.mtopology (S i) (d i)) I = mtopology" +proof - + have htopspace:"\i. i \ I \ topspace (metric_set.mtopology (S i) (d i)) = S i" + by (simp add: sd_metric metric_set.mtopology_topspace) + hence htopspace':"(\\<^sub>E i\I. topspace (metric_set.mtopology (S i) (d i))) = (\\<^sub>E i\I. S i)" by auto + consider "I = {}" | "I \ {}" by auto + then show ?thesis + proof cases + case 1 + then have "product_dist = (\x y. 0)" + using metric_set_axioms by(simp add: singleton_metric_unique) + thus ?thesis + by(simp add: product_topology_empty_discrete 1 singleton_metric_mtopology) + next + case I':2 + show ?thesis + unfolding mtopology_def2 product_topology_def + proof(rule topology_generated_by_eq) + fix U + assume "U \ {open_ball a \ |a \. a \ (\\<^sub>E i\I. S i) \ 0 < \}" + then obtain a \ where hu: + "U = open_ball a \" "a \ (\\<^sub>E i\I. S i)" "0 < \" by auto + have "\X. x \ (\\<^sub>E i\I. X i) \ (\\<^sub>E i\I. X i) \ U \ (\i. openin (metric_set.mtopology (S i) (d i)) (X i)) \ finite {i. X i \ topspace (metric_set.mtopology (S i) (d i))}" if "x \ U" for x + proof - + consider "\ \ 1 / (1 - r) * K" | "1 / (1 - r) * K < \" by fastforce + then show "\X. x \ (\\<^sub>E i\I. X i) \ (\\<^sub>E i\I. X i) \ U \ (\i. openin (metric_set.mtopology (S i) (d i)) (X i)) \ finite {i. X i \ topspace (metric_set.mtopology (S i) (d i))}" + proof cases + case he2:1 + note hx = open_ballD[OF that[simplified hu(1)]] open_ballD'(1)[OF that[simplified hu(1)]] + + then have "0 < (\ - product_dist a x)*((1-r)/ K)" using r hu K_pos by auto + hence "\k. r^k < (\ - product_dist a x)*((1-r)/ K)" + using r(2) real_arch_pow_inv by blast + then obtain k where "r^k < (\ - product_dist a x)*((1-r)/ K)" by auto + hence hk:"r^k / (1-r) * K < (\ - product_dist a x)" + using mult_imp_div_pos_less[OF divide_pos_pos[OF _ K_pos,of "1-r"]] r(2) by auto + have hk': "0 < k" apply(rule ccontr) using hk he2 dist_geq0[of a x] by auto + define \' where "\' \ (1/(real k))*(\ - product_dist a x - r^k / (1-r) * K)" + have h\' : "0 < \'" using hk by(auto simp: \'_def hk') + define X where "X \ (if finite I then (\i. if i \ I then metric_set.open_ball (S i) (d i) (x i) \' else topspace (metric_set.mtopology (S i) (d i))) else (\i. if i \ I \ f i < k then metric_set.open_ball (S i) (d i) (x i) \' else topspace (metric_set.mtopology (S i) (d i))))" + show ?thesis + proof(intro exI[where x=X] conjI) + have "x i \ metric_set.open_ball (S i) (d i) (x i) \'" if "i \ I" for i + using hx(2) by (simp add: PiE_mem h\' metric_set.open_ball_ina sd_metric that) + thus "x \ (\\<^sub>E i\I. X i)" + using hx(2) htopspace by(auto simp: X_def) + next + show "(\\<^sub>E i\I. X i) \ U" + proof + fix y + assume "y \ (\\<^sub>E i\I. X i)" + have "\i. X i \ topspace (metric_set.mtopology (S i) (d i))" + by (simp add: X_def sd_metric htopspace metric_set.open_ball_subset_ofS) + hence "y \ (\\<^sub>E i\I. S i)" + using htopspace' \y \ (\\<^sub>E i\I. X i)\ by blast + have "product_dist a y < \" + proof - + have "product_dist a y \ product_dist a x + product_dist x y" + by(rule dist_tr[OF hu(2) hx(2) \y \ (\\<^sub>E i\I. S i)\]) + also have "... < product_dist a x + (\ - product_dist a x)" + proof - + have "product_dist x y < (\ - product_dist a x)" + proof - + have "product_dist x y = (\n. if g n \ I then r ^ n * d (g n) (x (g n)) (y (g n)) else 0)" + by(simp add: product_dist_def hx \y \ (\\<^sub>E i\I. S i)\) + also have "... = (\n. if g (n + k) \ I then r ^ (n + k)* d (g (n + k)) (x (g (n + k))) (y (g (n + k))) else 0) + (\n I then r ^ n * d (g n) (x (g n)) (y (g n)) else 0)" + by(rule suminf_split_initial_segment) simp + also have "... \ r^k / (1 - r) * K + (\n I then r ^ n * d (g n) (x (g n)) (y (g n)) else 0)" + proof - + have "(\n. if g (n + k) \ I then r ^ (n + k)* d (g (n + k)) (x (g (n + k))) (y (g (n + k))) else 0) \ (\n. r ^ (n + k) * K)" + using d_bound d_nonneg r K_pos by(auto intro!: suminf_le summable_ignore_initial_segment) + also have "... = r^k / (1 - r) * K" + by(rule nsum_of_rK) + finally show ?thesis by simp + qed + also have "... < r^k / (1 - r) * K + (\ - product_dist a x - r^k / (1 - r) * K)" + proof - + have "(\n I then r ^ n * d (g n) (x (g n)) (y (g n)) else 0) < (\n')" + proof(rule sum_strict_mono_ex1) + show "\l\{.. I then r ^ l * d (g l) (x (g l)) (y (g l)) else 0) \ \'" + proof - + { + fix l + assume "g l \ I" "l < k" + then interpret mbd: metric_set "S (g l)" "d (g l)" + by(auto intro!: sd_metric) + have "r ^ l * d (g l) (x (g l)) (y (g l)) \ d (g l) (x (g l)) (y (g l))" + using r by(auto intro!: mult_right_mono[of "r ^ l" 1,OF _ mbd.dist_geq0[of "x (g l)" "y (g l)"],simplified] simp: power_le_one) + also have "... < \'" + proof - + have "y (g l) \ mbd.open_ball (x (g l)) \'" + proof(cases "finite I") + case True + then show ?thesis + using PiE_mem[OF \y \ (\\<^sub>E i\I. X i)\ \g l \ I\] + by(simp add: X_def \g l \ I\) + next + case False + then show ?thesis + using PiE_mem[OF \y \ (\\<^sub>E i\I. X i)\ \g l \ I\] gf_if_infinite(3) + by(simp add: X_def \g l \ I\ \l < k\) + qed + thus ?thesis + by(auto dest: mbd.open_ballD) + qed + finally have "r ^ l * d (g l) (x (g l)) (y (g l)) \ \'" by simp + } + thus ?thesis + by(auto simp: order.strict_implies_order[OF h\']) + qed + next + show "\a\{.. I then r ^ a * d (g a) (x (g a)) (y (g a)) else 0) < \'" + proof(rule bexI[where x=0]) + { + assume "g 0 \ I" + then interpret mbd: metric_set "S (g 0)" "d (g 0)" + by(auto intro!: sd_metric) + have "y (g 0) \ mbd.open_ball (x (g 0)) \'" + proof(cases "finite I") + case True + then show ?thesis + using PiE_mem[OF \y \ (\\<^sub>E i\I. X i)\ \g 0 \ I\] + by(simp add: X_def \g 0 \ I\) + next + case False + then show ?thesis + using PiE_mem[OF \y \ (\\<^sub>E i\I. X i)\ \g 0 \ I\] gf_if_infinite(3) + by(simp add: X_def \g 0 \ I\ \0 < k\) + qed + hence "r ^ 0 * d (g 0) (x (g 0)) (y (g 0)) < \'" + by(auto dest: mbd.open_ballD) + } + thus "(if g 0 \ I then r ^ 0 * d (g 0) (x (g 0)) (y (g 0)) else 0) < \'" + using h\' by auto + qed(use hk' in auto) + qed simp + also have "... = (\ - product_dist a x - r ^ k / (1 - r) * K)" + by(simp add: \'_def hk') + finally show ?thesis by simp + qed + finally show ?thesis by simp + qed + thus ?thesis by simp + qed + finally show ?thesis by auto + qed + thus "y \ U" + by(simp add: hu(1) open_ball_def hu(2) \y \ (\\<^sub>E i\I. S i)\) + qed + next + have "openin (metric_set.mtopology (S i) (d i)) (metric_set.open_ball (S i) (d i) (x i) \')" if "i \ I" for i + by (meson PiE_E h\' hx(2) metric_set.mtopology_open_ball_in sd_metric that) + moreover have "openin (metric_set.mtopology (S i) (d i)) (topspace (metric_set.mtopology (S i) (d i)))" for i + by auto + ultimately show "\i. openin (metric_set.mtopology (S i) (d i)) (X i)" + by(auto simp: X_def) + next + show "finite {i. X i \ topspace (metric_set.mtopology (S i) (d i))}" + proof(cases "finite I") + case True + then show ?thesis + by(simp add: X_def) + next + case Iinf:False + have "finite {i \ I. f i < k}" + proof - + have "{i \ I. f i < k} = inv_into I f ` {..i. i \ I \ inv_into I f (f i) = i" + "\n. f (inv_into I f n) = n" + using bij_betw_inv_into_left[OF gf_if_infinite(1)[OF Iinf]] + bij_betw_inv_into_right[OF gf_if_infinite(1)[OF Iinf]] + by auto + show ?thesis + proof + show "{i \ I. f i < k} \ inv_into I f ` {.. {i \ I. f i < k} \ p \ inv_into I f ` {.. {i \ I. f i < k} " + using *(2) bij_betw_inv_into[OF gf_if_infinite(1)[OF Iinf]] + by (auto simp: bij_betw_def) + qed + qed + also have "finite ..." by auto + finally show ?thesis . + qed + thus ?thesis + by(simp add: X_def Iinf) + qed + qed + next + case 2 + then have "U = (\\<^sub>E i\I. S i)" + unfolding hu(1) using order.strict_trans1[OF product_dist_leqr,of \] hu(2) + by(simp add: open_ball_def) + also have "... = (\\<^sub>E i\I. topspace (metric_set.mtopology (S i) (d i)))" + using htopspace by auto + finally have "U = (\\<^sub>E i\I. topspace (metric_set.mtopology (S i) (d i)))" . + thus ?thesis + using open_ballD'(1)[OF that[simplified hu(1)]] htopspace by(auto intro!: exI[where x="\i. topspace (metric_set.mtopology (S i) (d i))"]) + qed + qed + hence "\X. \x\U. x \ (\\<^sub>E i\I. X x i) \ (\\<^sub>E i\I. X x i) \ U \ (\i. openin (metric_set.mtopology (S i) (d i)) (X x i)) \ finite {i. X x i \ topspace (metric_set.mtopology (S i) (d i))}" + by(auto intro!: bchoice) + then obtain X where "\x\U. x \ (\\<^sub>E i\I. X x i) \ (\\<^sub>E i\I. X x i) \ U \ (\i. openin (metric_set.mtopology (S i) (d i)) (X x i)) \ finite {i. X x i \ topspace (metric_set.mtopology (S i) (d i))}" + by auto + hence hX: "\x. x \ U \ x \ (\\<^sub>E i\I. X x i)" "\x. x \ U \ (\\<^sub>E i\I. X x i) \ U" "\x. x \ U \ (\i. openin (metric_set.mtopology (S i) (d i)) (X x i))" "\x. x \ U \ finite {i. X x i \ topspace (metric_set.mtopology (S i) (d i))}" + by auto + hence hXopen: "\x. x \ U \ (\\<^sub>E i\I. X x i) \ {\\<^sub>E i\I. X i |X. (\i. openin (metric_set.mtopology (S i) (d i)) (X i)) \ finite {i. X i \ topspace (metric_set.mtopology (S i) (d i))}}" + by blast + have "U = (\ {(\\<^sub>E i\I. X x i) | x. x \ U})" + using hX(1,2) by blast + have "openin (topology_generated_by {\\<^sub>E i\I. X i |X. (\i. openin (metric_set.mtopology (S i) (d i)) (X i)) \ finite {i. X i \ topspace (metric_set.mtopology (S i) (d i))}}) (\ {(\\<^sub>E i\I. X x i) | x. x \ U})" + apply(rule openin_Union) + using hXopen by(auto simp: openin_topology_generated_by_iff intro!: generate_topology_on.Basis) + thus "openin (topology_generated_by {\\<^sub>E i\I. X i |X. (\i. openin (metric_set.mtopology (S i) (d i)) (X i)) \ finite {i. X i \ topspace (metric_set.mtopology (S i) (d i))}}) U" + using \U = (\ {(\\<^sub>E i\I. X x i) | x. x \ U})\ by simp + next + fix U + assume "U \ {\\<^sub>E i\I. X i |X. (\i. openin (metric_set.mtopology (S i) (d i)) (X i)) \ finite {i. X i \ topspace (metric_set.mtopology (S i) (d i))}}" + then obtain X where hX: + "U = (\\<^sub>E i\I. X i)" "\i. openin (metric_set.mtopology (S i) (d i)) (X i)" "finite {i. X i \ topspace (metric_set.mtopology (S i) (d i))}" + by auto + have "\a \. x \ open_ball a \ \ open_ball a \ \ U" if "x \ U" for x + proof - + have x_intop:"x \ (\\<^sub>E i\I. S i)" + unfolding htopspace'[symmetric] using that hX(1) openin_subset[OF hX(2)] by auto + define I' where "I' \ {i. X i \ topspace (metric_set.mtopology (S i) (d i))} \ I" + then have I':"finite I'" "I' \ I" using hX(3) by auto + consider "I' = {}" | "I' \ {}" by auto + then show ?thesis + proof cases + case 1 + then have "\i. i \ I \ X i = topspace (metric_set.mtopology (S i) (d i))" + by(auto simp: I'_def) + then have "U = (\\<^sub>E i\I. S i)" + by (simp add: PiE_eq hX(1) htopspace) + thus ?thesis + using open_ball_subset_ofS[of x 1] that + by(auto intro!: exI[where x=x] exI[where x=1]) + next + case I'_nonempty:2 + hence "\i. i \ I' \ openin (metric_set.mtopology (S i) (d i)) (X i)" + using hX(2) by(simp add: I'_def) + hence "\\>0. metric_set.open_ball (S i) (d i) (x i) \ \ (X i)" if "i \ I'" for i + using metric_set.mtopology_openin_iff[of "S i" "d i" "X i"] sd_metric[of i] hX(1,2) \x \ U\ that + using I'_def by blast + then obtain \i' where hei:"\i. i \ I' \ \i' i > 0" "\i. i \ I' \ metric_set.open_ball (S i) (d i) (x i) (\i' i) \ (X i)" + by metis + define \ where "\ \ Min {\i' i |i. i \ I'}" + have \min: "\i. i \ I' \ \ \ \i' i" + using I' by(auto simp: \_def intro!: Min.coboundedI) + have h\: "\ > 0" + using I' I'_nonempty Min_gr_iff[of "{\i' i |i. i \ I'}" 0] hei(1) + by(auto simp: \_def) + define n where "n \ Max {f i | i. i \ I'}" + have "\i. i \ I' \f i \ n" + using I' by(auto intro!: Max.coboundedI[of "{f i | i. i \ I'}"] simp: n_def) + hence hn2:"\i. i \ I' \ (1 / r) ^ f i \ (1 / r)^n" + using r by auto + have h\' : "0 < \*(r^n)" using h\ r by auto + show ?thesis + proof(safe intro!: exI[where x=x] exI[where x="\*(r^n)"]) + fix y + assume "y \ open_ball x (\ * r ^ n)" + have "y i \ X i" if "i \ I'" for i + proof - + interpret mi: metric_set "S i" "d i" + using sd_metric that by(simp add: I'_def) + have "d i (x i) (y i) < \i' i" + proof - + have "d i (x i) (y i) \ (1 / r) ^ f i * product_dist x y" + using that by(auto intro!: product_dist_geq[of i,OF _ gf_comp_id x_intop open_ballD'(1)[OF \y \ open_ball x (\ * r ^ n)\]] simp: I'_def) + also have "... \ (1 / r)^n * product_dist x y" + by(rule mult_right_mono[OF hn2[OF that] dist_geq0]) + also have "... < \" + using open_ballD[OF \y \ open_ball x (\ * r ^ n)\] r + by (simp add: pos_divide_less_eq power_one_over) + also have "... \ \i' i" + by(rule \min[OF that]) + finally show ?thesis . + qed + hence "(y i) \ mi.open_ball (x i) (\i' i)" + using open_ballD'(1)[OF \y \ open_ball x (\ * r ^ n)\] x_intop that + by(auto simp: mi.open_ball_def I'_def) + thus ?thesis + using hei[OF that] by auto + qed + moreover have "y i \ X i" if "i \ I - I'" for i + using that htopspace open_ballD'(1)[OF \y \ open_ball x (\ * r ^ n)\] + by(auto simp: I'_def) + ultimately show "y \ U" + using open_ballD'(1)[OF \y \ open_ball x (\ * r ^ n)\] + by(auto simp: hX(1)) + qed(use open_ball_ina[OF x_intop h\'] in auto) + qed + qed + then obtain a where "\x\U. \\. x \ open_ball (a x) \ \ open_ball (a x) \ \ U" + by metis + then obtain \ where hae: "\x. x \ U \ x \ open_ball (a x) (\ x)" "\x. x \ U \ open_ball (a x) (\ x) \ U" + by metis + hence hae': "\x. x \ U \ a x \ (\\<^sub>E i\I. S i)" "\x. x \ U \ 0 < \ x" + using open_ballD'(2) by meson (use open_ballD'(2,3) hae in meson) + have "openin (topology_generated_by {open_ball a \ |a \. a \ (\\<^sub>E i\I. S i) \ 0 < \}) (\ { open_ball (a x) (\ x) |x. x \ U})" + by(auto intro!: openin_Union[of _ mtopology] simp: mtopology_def2[symmetric] hae' metric_set_axioms metric_set.mtopology_open_ball_in) + moreover have "U = (\ {open_ball (a x) (\ x) |x. x \ U})" + using hae by auto + ultimately show "openin (topology_generated_by {open_ball a \ |a \. a \ (\\<^sub>E i\I. S i) \ 0 < \}) U" + by simp + qed + qed +qed + +end + +lemma product_metricI: + assumes "0 < r" "r < 1" "countable I" "\i. i \ I \ metric_set (S i) (d i)" + and "\i x y. 0 \ d i x y" "\i x y. d i x y \ K" "0 < K" + shows "product_metric r I (to_nat_on I) (from_nat_into I) S d K" + using from_nat_into_to_nat_on_product_metric_pair[OF assms(3)] assms + by(simp add: product_metric_def metric_set_def) + +(* TODO add lemmas for above metric *) + +text \ Case: all $(S_i,d_i)$ are separable metric spaces.\ +locale product_separable_metric = product_metric + + assumes sd_separable_metric: "\i. i \ I \ separable_metric_set (S i) (d i)" +begin + +sublocale separable_metric_set "\\<^sub>E i\I. S i" product_dist +proof - + have "\i. i \ I \ second_countable (metric_set.mtopology (S i) (d i))" + by (simp add: sd_separable_metric separable_metric_set.second_countable) + hence "second_countable (product_topology (\i. metric_set.mtopology (S i) (d i)) I)" + by(rule product_topology_second_countable[OF I]) + hence "second_countable (metric_set.mtopology (Pi\<^sub>E I S) product_dist)" + using product_dist_mtopology sd_metric + by(simp add: separable_metric_set_def) + thus "separable_metric_set (\\<^sub>E i\I. S i) product_dist" + by (meson I d_bound d_nonneg metric_set.separable_if_second_countable product_dist_distance r(1) r(2) sd_metric second_countable_def separable_metric_set.axioms(1)) +qed + +end + +text \ Case: all $(S_i,d_i)$ are complete metric spaces.\ +locale product_complete_metric = product_metric + + assumes sd_complete_metric: "\i. i \ I \ complete_metric_set (S i) (d i)" +begin + +lemma product_dist_complete': + assumes "I \ {}" + shows "complete_metric_set (\\<^sub>E i\I. S i) product_dist" +proof - + show ?thesis + proof + fix k + assume h:"Cauchy_inS k" + have *:"i \ I \ metric_set.Cauchy_inS (S i) (d i) (\n. k n i)" for i + proof - + assume hi:"i \ I" + then interpret mi: complete_metric_set "S i" "d i" + by(simp add: sd_complete_metric) + show "mi.Cauchy_inS (\n. k n i)" + unfolding mi.Cauchy_inS_def2'' + proof + show "(\n. k n i) \ mi.sequence" + using h hi by(auto simp: Cauchy_inS_def) + next + show "\\>0. \x\S i. \N. \n\N. d i x (k n i) < \" + proof safe + fix \ + assume he:"(0::real) < \" + then have "0 < \ * r^(f i)" using r by auto + then obtain x N where hxn: + "x\(\\<^sub>E i\I. S i)" "\n. n\N \ product_dist x (k n) < \ * r^(f i)" + using h[simplified Cauchy_inS_def2''] by blast + hence hxn':"\n. n\N \ (1/r)^(f i) * product_dist x (k n) < \" + by (simp add: pos_divide_less_eq power_divide r(1)) + show "\x\S i. \N. \n\N. d i x (k n i) < \" + proof(safe intro!: bexI[where x="x i"] exI[where x=N]) + show "x i \ S i" + using hi hxn by auto + next + fix n + assume hnn:"N \ n" + have hf:"k n \ (\\<^sub>E i\I. S i)" + using h by(auto simp: Cauchy_inS_def) + have "d i (x i) (k n i) \ (1/r)^(f i) * product_dist x (k n)" + using product_dist_geq[OF hi gf_comp_id[OF hi] hxn(1) hf] + by simp + also have "... < \" + using hxn'[OF hnn] . + finally show "d i (x i) (k n i) < \" . + qed + qed + qed + qed + have "\x. metric_set.converge_to_inS (S i) (d i) (\n. k n i) x" if "i \ I" for i + using complete_metric_set.convergence[OF sd_complete_metric[OF that] *[OF that]] metric_set.convergent_inS_def[OF sd_metric[OF that]] + by auto + then obtain x where hx:"\i. i \ I \ metric_set.converge_to_inS (S i) (d i) (\n. k n i) (x i)" + by metis + have hx':"(\i\I. x i) \ (\\<^sub>E i\I. S i)" + using hx metric_set.converge_to_inS_def[OF sd_metric] by auto + show "convergent_inS k" + using converge_to_iff[OF _ hx',of k] + by(auto intro!: exI[where x="\i\I. x i"] simp: h[simplified Cauchy_inS_def] hx convergent_inS_def) + qed +qed + +sublocale complete_metric_set "\\<^sub>E i\I. S i" product_dist +proof - + consider "I = {}" | "I \ {}" by auto + then show "complete_metric_set (\\<^sub>E i\I. S i) product_dist" + proof cases + case 1 + then have "product_dist = (\x y. 0)" + using metric_set_axioms singleton_metric_unique[of "\x. undefined"] by auto + with 1 singleton_metric_polish[of "\x. undefined"] + show ?thesis by(auto simp: polish_metric_set_def) + next + case 2 + with product_dist_complete' show ?thesis by simp + qed +qed + +end + +lemma product_complete_metricI: + assumes "0 < r" "r < 1" "countable I" "\i. i \ I \ complete_metric_set (S i) (d i)" + and "\i x y. 0 \ d i x y" "\i x y. d i x y \ K" "0 < K" + shows "product_complete_metric r I (to_nat_on I) (from_nat_into I) S d K" + using from_nat_into_to_nat_on_product_metric_pair[OF assms(3)] assms + by(simp add: product_complete_metric_def product_metric_def product_complete_metric_axioms_def complete_metric_set_def) + +lemma product_complete_metric_natI: + assumes "0 < r" "r < 1" "\n. complete_metric_set (S n) (d n)" + and "\i x y. 0 \ d i x y" "\i x y. d i x y \ K" "0 < K" + shows "product_complete_metric r UNIV id id S d K" + using assms by(simp add: product_complete_metric_def product_metric_def product_complete_metric_axioms_def polish_metric_set_def complete_metric_set_def) + +locale product_polish_metric = product_complete_metric + product_separable_metric +begin + +sublocale polish_metric_set "\\<^sub>E i\I. S i" product_dist + by (simp add: complete_metric_set_axioms polish_metric_set_def separable_metric_set_axioms) + +end + +lemma product_polish_metricI: + assumes "0 < r" "r < 1" "countable I" "\i. i \ I \ polish_metric_set (S i) (d i)" + and "\i x y. 0 \ d i x y" "\i x y. d i x y \ K" "0 < K" + shows "product_polish_metric r I (to_nat_on I) (from_nat_into I) S d K" + using from_nat_into_to_nat_on_product_metric_pair[OF assms(3)] assms + by(simp add: product_polish_metric_def product_complete_metric_def product_separable_metric_def product_metric_def product_complete_metric_axioms_def product_separable_metric_axioms_def polish_metric_set_def complete_metric_set_def) + +lemma product_polish_metric_natI: + assumes "0 < r" "r < 1" "\n. polish_metric_set (S n) (d n)" + and "\i x y. 0 \ d i x y" "\i x y. d i x y \ K" "0 < K" + shows "product_polish_metric r UNIV id id S d K" + using assms by(simp add: product_polish_metric_def product_complete_metric_def product_separable_metric_def product_metric_def product_complete_metric_axioms_def product_separable_metric_axioms_def polish_metric_set_def complete_metric_set_def) + +text \ Define a bounded distance function from a distance function \ +definition bounded_dist :: "('a \ 'a \ real) \ 'a \ 'a \ real" where +"bounded_dist d \ (\a b. d a b / (1 + d a b))" + +lemma bounded_dist_mono: + fixes r l :: real + assumes "0 \ r" "0 \ l" and "r \ l" + shows "r / (1 + r) \ l / (1 + l)" +proof - + have "(1 + l) * r \ l* (1 + r)" + using assms by (simp add: distrib_left distrib_right) + hence "((1 + l) * r) * (1 / (1 + r)) \ (l * (1 + r)) * (1 / (1 + r))" + using linordered_ring_strict_class.mult_le_cancel_right[of "(1 + l) * r" "1 / (1 + r)" "l * (1 + r)"] assms(1) + by auto + hence "(1 / (1 + l)) * (((1 + l) * r) * (1 / (1 + r))) \ (1 / (1 + l)) * ((l * (1 + r)) * (1 / (1 + r)))" + using linordered_ring_strict_class.mult_le_cancel_left[of "1 / (1 + l)" "((1 + l) * r) * (1 / (1 + r))" "(l * (1 + r)) * (1 / (1 + r))"] assms(2) + by auto + thus ?thesis + using assms by auto +qed + +lemma bounded_dist_mono_strict: + fixes r l :: real + assumes "0 \ r" "0 \ l" and "r < l" + shows "r / (1 + r) < l / (1 + l)" +proof - + have "(1 + l) * r < l* (1 + r)" + using assms by (simp add: distrib_left distrib_right) + hence "((1 + l) * r) * (1 / (1 + r)) < (l * (1 + r)) * (1 / (1 + r))" + using linordered_ring_strict_class.mult_less_cancel_right[of "(1 + l) * r" "1 / (1 + r)" "l * (1 + r)"] assms(1) + by auto + hence "(1 / (1 + l)) * (((1 + l) * r) * (1 / (1 + r))) < (1 / (1 + l)) * ((l * (1 + r)) * (1 / (1 + r)))" + using linordered_ring_strict_class.mult_less_cancel_left[of "1 / (1 + l)" "((1 + l) * r) * (1 / (1 + r))" "(l * (1 + r)) * (1 / (1 + r))"] assms(2) + by auto + thus ?thesis + using assms by auto +qed + +lemma bounded_dist_mono_inverse: + fixes r l :: real + assumes "0 \ r" "0 \ l" and "r / (1 + r) \ l / (1 + l)" + shows "r \ l" +proof - + have "(1 / (1 + l)) * (((1 + l) * r) * (1 / (1 + r))) \ (1 / (1 + l)) * ((l * (1 + r)) * (1 / (1 + r)))" + using assms by auto + hence "((1 + l) * r) * (1 / (1 + r)) \ (l * (1 + r)) * (1 / (1 + r))" + using linordered_ring_strict_class.mult_le_cancel_left[of "1 / (1 + l)" "((1 + l) * r) * (1 / (1 + r))" "(l * (1 + r)) * (1 / (1 + r))"] assms(2) + by auto + hence "(1 + l) * r \ l* (1 + r)" + using linordered_ring_strict_class.mult_le_cancel_right[of "(1 + l) * r" "1 / (1 + r)" "l * (1 + r)"] assms(1) + by auto + thus ?thesis + using assms by (simp add: distrib_left distrib_right) +qed + +lemma bounded_dist_mono_strict_inverse: + fixes r l :: real + assumes "0 \ r" "0 \ l" and "r / (1 + r) < l / (1 + l)" + shows "r < l" +proof - + have "(1 / (1 + l)) * (((1 + l) * r) * (1 / (1 + r))) < (1 / (1 + l)) * ((l * (1 + r)) * (1 / (1 + r)))" + using assms by auto + hence "((1 + l) * r) * (1 / (1 + r)) < (l * (1 + r)) * (1 / (1 + r))" + using linordered_ring_strict_class.mult_less_cancel_left[of "1 / (1 + l)" "((1 + l) * r) * (1 / (1 + r))" "(l * (1 + r)) * (1 / (1 + r))"] assms(2) + by auto + hence "(1 + l) * r < l* (1 + r)" + using linordered_ring_strict_class.mult_less_cancel_right[of "(1 + l) * r" "1 / (1 + r)" "l * (1 + r)"] assms(1) + by auto + thus ?thesis + using assms by (simp add: distrib_left distrib_right) +qed + +lemma bounded_dist_inverse_comp: + fixes \ :: real + assumes "0 < \" and "\ < 1" + shows "\ = (\ / (1 - \)) / (1 + (\ / (1 - \)))" + (is "_ = ?\' / (1 + ?\')") +proof - + have "1 + \ / (1 - \) = (1 - \) / (1 - \) + \ / (1 - \)" + using assms by auto + also have "... = 1 / (1 - \)" + by(simp only: division_ring_class.add_divide_distrib[symmetric], simp) + finally show "\ = ?\' / (1 + ?\')" + using assms by simp +qed + +lemma(in metric_set) bounded_dist_dist: + shows "metric_set S (bounded_dist dist)" + and "bounded_dist dist a b < 1" +proof - + show "metric_set S (bounded_dist dist)" + proof + show "\x y. 0 \ bounded_dist dist x y" + "\x y. x \ S \ bounded_dist dist x y = 0" + "\x y. bounded_dist dist x y = bounded_dist dist y x" + using dist_geq0 dist_notin dist_sym + by(auto simp: bounded_dist_def) + next + fix x y + assume hxy:"x \ S" "y \ S" + show "x = y \ (bounded_dist dist x y = 0)" + proof + assume "bounded_dist dist x y = 0" + then have "dist x y / (1 + dist x y) = 0" + by(simp add: bounded_dist_def) + hence "dist x y = 0" + using field_class.divide_eq_0_iff[of "d x y"] dist_geq0 + by (simp add: add_nonneg_eq_0_iff) + thus "x = y" + using dist_0[OF hxy] by simp + qed (simp add: bounded_dist_def dist_0[OF hxy]) + next + fix x y z + assume hxyz:"x \ S" "y \ S" "z \ S" + have "bounded_dist dist x z \ (dist x y + dist y z) / (1 + dist x y + dist y z)" + using bounded_dist_mono[OF _ _ dist_tr[OF hxyz],simplified semigroup_add_class.add.assoc[symmetric]] dist_geq0 + by(simp add: bounded_dist_def) + also have "... = dist x y / (1 + dist x y + dist y z) + dist y z / (1 + dist x y + dist y z)" + using add_divide_distrib by auto + also have "... \ bounded_dist dist x y + bounded_dist dist y z" + apply(rule add_mono_thms_linordered_semiring(1)) + unfolding bounded_dist_def + using dist_geq0 + by(auto intro!: linordered_field_class.divide_left_mono linordered_semiring_strict_class.mult_pos_pos add_pos_nonneg ) + finally show "bounded_dist dist x z \ bounded_dist dist x y + bounded_dist dist y z" . + qed + show "bounded_dist dist a b < 1" + using dist_geq0[of a b] by(auto simp: bounded_dist_def) +qed + +lemma(in metric_set) bounded_dist_ball_eq: + assumes "x \ S" and "\ > 0" + shows "open_ball x \ = metric_set.open_ball S (bounded_dist dist) x (\ / (1 + \))" +proof(rule set_eqI) + interpret m2: metric_set S "bounded_dist dist" + by(rule bounded_dist_dist) + fix y + have "y \ open_ball x \ \ y \ S \ dist x y < \" + using assms by(simp add: open_ball_def) + also have "... \ y \ S \ dist x y / (1 + dist x y) < \ / (1 + \)" + using bounded_dist_mono_strict[of "dist x y" \] bounded_dist_mono_strict_inverse[of "dist x y" \] dist_geq0 assms(2) + by auto + also have "... \ y \ m2.open_ball x (\ / (1 + \))" + using assms by(simp add: m2.open_ball_def,simp add: bounded_dist_def) + finally show "y \ open_ball x \ \ y \ m2.open_ball x (\ / (1 + \))" . +qed + +lemma(in metric_set) bounded_dist_ball_ge1: + assumes "x \ S" and "1 \ \" + shows "metric_set.open_ball S (bounded_dist dist) x \ = S" +proof - + interpret m2: metric_set S "bounded_dist dist" + by(rule bounded_dist_dist) + show ?thesis + using order.strict_trans2[OF bounded_dist_dist(2)[of x] assms(2)] assms(1) + by(auto simp: m2.open_ball_def) +qed + +lemma(in metric_set) bounded_dist_generate_same_topology: + "mtopology = metric_set.mtopology S (bounded_dist dist)" +proof - + interpret m2: metric_set S "bounded_dist dist" + by(rule bounded_dist_dist) + show ?thesis + proof(rule metric_generates_same_topology[OF metric_set_axioms bounded_dist_dist(1)]) + fix x U + assume h: "U \ S" "\x\U. \\>0. open_ball x \ \ U" "x \ U" + then obtain \ where he: + "\ > 0" "open_ball x \ \ U" by auto + show "\\>0. m2.open_ball x \ \ U" + using he bounded_dist_ball_eq[of x \] h + by(auto intro!: exI[where x="\ / (1 + \)"]) + next + fix x U + assume h: "U \ S" "\x\U. \\>0. m2.open_ball x \ \ U" "x \ U" + then obtain \ where he: + "\ > 0" "m2.open_ball x \ \ U" by auto + consider "\ < 1" | "1 \ \" by fastforce + then show "\\>0. open_ball x \ \ U" + proof cases + case 1 + let ?\' = "\ / (1 - \)" + note 2 = bounded_dist_inverse_comp[OF he(1) 1] + have 3:"0 < ?\'" + using he 1 by auto + show ?thesis + using h(1,3) he(2) 3 bounded_dist_ball_eq[of x ?\',simplified 2[symmetric]] + by(auto intro!: exI[where x="?\'"]) + next + case 2 + have "U = S" + using bounded_dist_ball_ge1[of x,OF _ 2] h(1,3) he(2) + by auto + thus ?thesis + using open_ball_subset_ofS + by(auto intro!: exI[where x=1]) + qed + qed +qed + +lemma(in metric_set) bounded_dist_converge_to_inS_iff: + "converge_to_inS xn x \ metric_set.converge_to_inS S (bounded_dist dist) xn x" + by(simp add: metric_generates_same_topology_converges[OF metric_set_axioms bounded_dist_dist(1) bounded_dist_generate_same_topology]) + +lemma(in metric_set) bounded_dist_Cauchy_eq: + "Cauchy_inS f \ metric_set.Cauchy_inS S (bounded_dist dist) f" +proof - + interpret m2: metric_set S "bounded_dist dist" + by(rule bounded_dist_dist) + show ?thesis + proof + assume h:"Cauchy_inS f" + show "m2.Cauchy_inS f" + unfolding m2.Cauchy_inS_def2' + proof safe + fix \ :: real + assume he: "0 < \" + consider "\ < 1" | "1 \ \" by fastforce + then show "\x\S. \N. \n\N. f n \ m2.open_ball x \" + proof cases + case 1 + let ?\ = "\ / (1 - \)" + note 2 = bounded_dist_inverse_comp[OF he(1) 1] + have 3:"0 < ?\" + using he 1 by auto + then obtain x N where hxn: + "x \ S" "\n. n\N \ f n \ open_ball x ?\" + using Cauchy_inS_def2'[of f] h by blast + show ?thesis + using hxn bounded_dist_ball_eq[OF hxn(1) 3,simplified 2[symmetric]] + by(auto intro!: bexI[where x=x] exI[where x=N]) + next + case 2 + then show ?thesis + using bounded_dist_ball_ge1[of "f 0" \] Cauchy_inS_def2'[of f] h + by(auto intro!: bexI[where x="f 0"] exI[where x=0]) + qed + qed(rule Cauchy_inS_dest1[OF h]) + next + assume h:"m2.Cauchy_inS f" + show "Cauchy_inS f" + unfolding Cauchy_inS_def2' + proof safe + fix \ :: real + assume he:"0 < \" + then have "0 < \ / (1 + \)" by simp + then obtain x N where + "x \ S" "\n. n \N \ f n \ m2.open_ball x (\ / (1 + \))" + using h[simplified m2.Cauchy_inS_def2'] by blast + thus "\x\S. \N. \n\N. f n \ open_ball x \" + using he bounded_dist_ball_eq[of x \] + by(auto intro!: bexI[where x=x] exI[where x=N]) + qed(rule m2.Cauchy_inS_dest1[OF h]) + qed +qed + +lemma(in complete_metric_set) bounded_dist_complete: + "complete_metric_set S (bounded_dist dist)" + unfolding complete_metric_set_def complete_metric_set_axioms_def + by(auto intro!: bounded_dist_dist convergence simp: bounded_dist_Cauchy_eq[symmetric] metric_generates_same_topology_convergent[OF metric_set_axioms bounded_dist_dist(1) bounded_dist_generate_same_topology,symmetric]) + +lemma(in polish_metric_set) bounded_dist_polish: + "polish_metric_set S (bounded_dist dist)" + unfolding polish_metric_set_def + using metric_generates_same_topology_separable[OF metric_set_axioms bounded_dist_dist(1) bounded_dist_generate_same_topology] + by(auto intro!: bounded_dist_complete separable_metric_set_axioms) + +lemma(in metric_set) uniform_continuous_map_bounded_dist_equiv: + assumes "metric_set T f" + shows "uniform_continuous_map S dist T f = uniform_continuous_map S (bounded_dist dist) T f" +proof + fix g + interpret bS: metric_set S "bounded_dist dist" + by (rule bounded_dist_dist(1)) + interpret T: metric_set T f by fact + show "uniform_continuous_map S dist T f g = uniform_continuous_map S (bounded_dist dist) T f g" + unfolding uniform_continuous_map_def[OF metric_set_axioms T.metric_set_axioms] uniform_continuous_map_def[OF bS.metric_set_axioms T.metric_set_axioms] + proof safe + fix e :: real + assume h: "e > 0" "g \ S \ T" "\\>0. \\>0. \x\S. \y\S. dist x y < \ \ f (g x) (g y) < \" + with h(3) obtain d where d: "d > 0" "\x y. x \ S \ y \ S \ dist x y < d \ f (g x) (g y) < e" + by metis + consider "d \ 1" | "d < 1" by fastforce + show "\\>0. \x\S. \y\S. bounded_dist dist x y < \ \ f (g x) (g y) < e" + proof(safe intro!: exI[where x="d / (1 + d)"]) + fix x y + assume xy:"x \ S" "y \ S" " bounded_dist dist x y < d / (1 + d)" + then have "dist x y < d" + using d(1) dist_geq0 bounded_dist_mono_strict_inverse[of "dist x y" d] by(auto simp: bounded_dist_def) + thus "f (g x) (g y) < e" + by(auto intro!: d xy) + qed(use d in auto) + next + fix e :: real + assume h: "e > 0" "g \ S \ T" "\\>0. \\>0. \x\S. \y\S. bounded_dist dist x y < \ \ f (g x) (g y) < \" + with h(3) obtain d where d: "d > 0" "\x y. x \ S \ y \ S \ bounded_dist dist x y < d \ f (g x) (g y) < e" + by metis + show "\\>0. \x\S. \y\S. dist x y < \ \ f (g x) (g y) < e" + proof(safe intro!: exI[where x=d]) + fix x y + assume xy: "x \ S" "y \ S" "dist x y < d" + then have "bounded_dist dist x y < d" + using dist_geq0[of x y] by(auto intro!: order.strict_trans1[OF divide_left_mono[OF le_add_same_cancel1[THEN iffD2,OF dist_geq0,of 1] dist_geq0],simplified] simp: bounded_dist_def) + from d(2)[OF xy(1,2) this] show "f (g x) (g y) < e" . + qed(use d in auto) + qed +qed + +lemma(in metric_set) uniform_continuous_map_bounded_dist_equiv': + assumes "metric_set T f" + shows "uniform_continuous_map S dist T f = uniform_continuous_map S (bounded_dist dist) T (bounded_dist f)" +proof + fix g + interpret bS: metric_set S "bounded_dist dist" + by (rule bounded_dist_dist(1)) + interpret T: metric_set T f by fact + interpret bT: metric_set T "bounded_dist f" + by(rule T.bounded_dist_dist(1)) + show "uniform_continuous_map S dist T f g = uniform_continuous_map S (bounded_dist dist) T (bounded_dist f) g" + unfolding uniform_continuous_map_def[OF metric_set_axioms T.metric_set_axioms] uniform_continuous_map_def[OF bS.metric_set_axioms bT.metric_set_axioms] + proof safe + fix e :: real + assume h: "e > 0" "g \ S \ T" "\\>0. \\>0. \x\S. \y\S. dist x y < \ \ f (g x) (g y) < \" + with h(3) obtain d where d: "d > 0" "\x y. x \ S \ y \ S \ dist x y < d \ f (g x) (g y) < e" + by metis + consider "d \ 1" | "d < 1" by fastforce + show "\\>0. \x\S. \y\S. bounded_dist dist x y < \ \ bounded_dist f (g x) (g y) < e" + proof(safe intro!: exI[where x="d / (1 + d)"]) + fix x y + assume xy:"x \ S" "y \ S" " bounded_dist dist x y < d / (1 + d)" + then have "dist x y < d" + using d(1) dist_geq0 bounded_dist_mono_strict_inverse[of "dist x y" d] by(auto simp: bounded_dist_def) + then have "f (g x) (g y) < e" + by(auto intro!: d xy) + thus "bounded_dist f (g x) (g y) < e" + using T.dist_geq0[of "g x" "g y"] by(auto intro!: order.strict_trans1[OF divide_left_mono[OF le_add_same_cancel1[THEN iffD2,OF T.dist_geq0,of 1] T.dist_geq0],simplified] simp: bounded_dist_def ) + qed(use d in auto) + next + fix e :: real + assume h: "e > 0" "g \ S \ T" "\\>0. \\>0. \x\S. \y\S. bounded_dist dist x y < \ \ bounded_dist f (g x) (g y) < \" + then have "e / (1 + e) > 0" by auto + with h(3) obtain d where d: "d > 0" "\x y. x \ S \ y \ S \ bounded_dist dist x y < d \ bounded_dist f (g x) (g y) < e / (1 + e)" + by metis + show "\\>0. \x\S. \y\S. dist x y < \ \ f (g x) (g y) < e" + proof(safe intro!: exI[where x=d]) + fix x y + assume xy: "x \ S" "y \ S" "dist x y < d" + then have "bounded_dist dist x y < d" + using dist_geq0[of x y] by(auto intro!: order.strict_trans1[OF divide_left_mono[OF le_add_same_cancel1[THEN iffD2,OF dist_geq0,of 1] dist_geq0],simplified] simp: bounded_dist_def) + from d(2)[OF xy(1,2) this] show "f (g x) (g y) < e" + using h(1) T.dist_geq0 by(auto intro!: bounded_dist_mono_strict_inverse[of "f (g x) (g y)" e] simp: bounded_dist_def) + qed(use d in auto) + qed +qed + +lemma(in metric_set) Urysohn_uniform: + assumes "closedin mtopology T" "closedin mtopology U" "T \ U = {}" "\x y. x \ T \ y \ U \ dist x y \ e" "e > 0" + obtains f :: "'a \ real" + where "uniform_continuous_map S dist UNIV dist_typeclass f" + "\x. f x \ 0" "\x. f x \ 1" "\x. x \ T \ f x = 1" "\x. x \ U \ f x = 0" +proof - + consider "T = {}" | "U = {}" | "T \ {}" "U \ {}" by auto + then show ?thesis + proof cases + case 1 + define f where "f \ (\x::'a. 0::real)" + with 1 have "uniform_continuous_map S dist UNIV dist_typeclass f" "\x. f x \{0..1}" "\x. x \ T \ f x = 1" "\x. x \ U \ f x = 0" + by(auto intro!: uniform_continuous_map_const[OF metric_set_axioms metric_class_metric_set] simp: f_def) + then show ?thesis + using that by auto + next + case 2 + define f where "f \ (\x::'a. 1::real)" + with 2 have "uniform_continuous_map S dist UNIV dist_typeclass f" "\x. f x \{0..1}" "\x. x \ T \ f x = 1" "\x. x \ U \ f x = 0" + by(auto intro!: uniform_continuous_map_const[OF metric_set_axioms metric_class_metric_set] simp: f_def) + then show ?thesis + using that by auto + next + case TU:3 + then have STU:"S \ {}" "T \ S" "U \ S" + using assms(1,2) closedin_topspace_empty mtopology_topspace closedin_subset by fastforce+ + interpret bd: metric_set S "bounded_dist dist" + by (rule bounded_dist_dist(1)) + have e:"\x y. x \ T \ y \ U \ bounded_dist dist x y \ e / (1 + e)" + using assms by(auto intro!: bounded_dist_mono simp: bounded_dist_def dist_geq0) + define f where "f \ (\x. bd.dist_set U x / (bd.dist_set U x + bd.dist_set T x))" + have "uniform_continuous_map S dist UNIV dist_typeclass f" + unfolding f_def + proof(rule uniform_continuous_map_real_devide[where Kf=1 and Kg=2]) + show "uniform_continuous_map S dist UNIV dist_typeclass (bd.dist_set U)" + "uniform_continuous_map S dist UNIV dist_typeclass (\x. bd.dist_set U x + bd.dist_set T x)" + by(auto simp: uniform_continuous_map_bounded_dist_equiv[OF metric_class_metric_set] bd.dist_set_uniform_continuous intro!: bd.uniform_continuous_map_add) + next + fix x + assume x:"x \ S" + consider "x \ (\a\U. bd.open_ball a ((e / (1 + e)) / 2))" | "x \ (\a\U. bd.open_ball a ((e / (1 + e)) / 2))" by auto + then show "(e / (1 + e)) / 2 \ \bd.dist_set U x + bd.dist_set T x\" + proof cases + case 1 + have "bd.open_ball x ((e / (1 + e)) / 2) \ T = {}" + proof(rule ccontr) + assume "bd.open_ball x ((e / (1 + e)) / 2) \ T \ {}" + then obtain y where y:"y \ bd.open_ball x ((e / (1 + e)) / 2)" "y \ T" + by auto + obtain u where u:"u \ U" "x \ bd.open_ball u ((e / (1 + e)) / 2)" + using 1 by auto + have "bounded_dist dist y u \ bounded_dist dist y x + bounded_dist dist x u" + using STU u y x by(auto intro!: bd.dist_tr) + also have "... < (e / (1 + e)) / 2 + (e / (1 + e)) / 2" + using bd.open_ballD[OF u(2)] bd.open_ballD[OF y(1)] by(simp add: bd.dist_sym) + also have "... = e / (1 + e)" using assms(5) by linarith + finally show False + using e[OF y(2) u(1)] by simp + qed + from bd.dist_set_ball_empty[OF TU(1) STU(2) _ x this] assms + have "e / (1 + e) / 2 \ bd.dist_set T x" by auto + also have "... \ \bd.dist_set U x + bd.dist_set T x\" + using bd.dist_set_geq0 by auto + finally show ?thesis . + next + case 2 + then have "bd.open_ball x ((e / (1 + e)) / 2) \ U = {}" + by(auto simp: bd.open_ball_inverse[of x]) + from bd.dist_set_ball_empty[OF TU(2) STU(3) _ x this] assms + have "e / (1 + e) / 2 \ bd.dist_set U x" by auto + also have "... \ \bd.dist_set U x + bd.dist_set T x\" + using bd.dist_set_geq0 by auto + finally show ?thesis . + qed + thus "bd.dist_set U x + bd.dist_set T x \ 0" + using bd.dist_set_geq0 assms(5) order_antisym_conv by fastforce + next + show "0 < e / (1 + e) / 2" + using assms by auto + next + fix x + have "\bd.dist_set U x + bd.dist_set T x\ = bd.dist_set U x + bd.dist_set T x" + using bd.dist_set_geq0 by auto + also have "... < 2" + by (metis add_mono_thms_linordered_field(5) one_add_one bd.dist_set_bounded[OF bounded_dist_dist(2),simplified]) + finally show "\bd.dist_set U x + bd.dist_set T x\ < 2" . + show "\bd.dist_set U x\ < 1" + using bd.dist_set_geq0 bd.dist_set_bounded[OF bounded_dist_dist(2)] by auto + qed + moreover have "\x. f x \{0..1}" + unfolding f_def + proof - + fix x + have "bd.dist_set U x / (bd.dist_set U x + bd.dist_set T x) \ bd.dist_set U x / bd.dist_set U x" + proof - + consider "bd.dist_set U x = 0" | "bd.dist_set U x > 0" + using bd.dist_set_geq0 by (auto simp: less_eq_real_def) + thus ?thesis + proof cases + case 2 + show ?thesis + by(rule divide_left_mono[OF _ _ mult_pos_pos]) (insert 2 bd.dist_set_geq0,simp_all add: add.commute add_nonneg_pos) + qed simp + qed + also have "... \ 1" by simp + finally show "bd.dist_set U x / (bd.dist_set U x + bd.dist_set T x) \ {0..1}" + using bd.dist_set_geq0 by auto + qed + moreover have "f x = 1" if x:"x \ T" for x + proof - + { assume h:"bd.dist_set U x = 0" + then have "x \ U" using assms STU x by blast + hence False + using bd.dist_set_closed_ge0[simplified bounded_dist_generate_same_topology[symmetric],OF assms(2) TU(2),of x] STU h x + by auto + } + thus ?thesis + by(auto simp: f_def bd.dist_set_inA x) + qed + moreover have "\x. x \ U \ f x = 0" + by (auto simp: f_def bd.dist_set_inA) + ultimately show ?thesis + using that by auto + qed +qed + +lemma product_metricI': + assumes "0 < r" "r < 1" "countable I" "\i. i \ I \ metric_set (S i) (d i)" + shows "product_metric r I (to_nat_on I) (from_nat_into I) S (\i x y. if i \ I then bounded_dist (d i) x y else 0) 1" +proof - + have "\i. i \ I \ metric_set (S i) (bounded_dist (d i))" + "\i x y. i \ I \ bounded_dist (d i) x y \ 1" + using assms(4) by(auto intro!: metric_set.bounded_dist_dist(1) less_imp_le[OF metric_set.bounded_dist_dist(2)]) + thus ?thesis + by(auto intro!: product_metricI[OF assms(1-3)] simp: metric_set_def) +qed + +lemma product_complete_metricI': + assumes "0 < r" "r < 1" "countable I" "\i. i \ I \ complete_metric_set (S i) (d i)" + shows "product_complete_metric r I (to_nat_on I) (from_nat_into I) S (\i x y. if i \ I then bounded_dist (d i) x y else 0) 1" +proof - + have "\i. i \ I \ complete_metric_set (S i) (bounded_dist (d i))" + "\i x y. i \ I \ bounded_dist (d i) x y \ 1" + using assms(4) by(auto intro!: metric_set.bounded_dist_dist(1) less_imp_le[OF metric_set.bounded_dist_dist(2)] simp: complete_metric_set_def) (simp add: assms(4) complete_metric_set.axioms(2) complete_metric_set.bounded_dist_complete) + thus ?thesis + by(auto intro!: product_complete_metricI[OF assms(1-3)] simp: complete_metric_set_def) (metis metric_set.dist_geq0) +qed + +lemma product_complete_metric_natI': + assumes "0 < r" "r < 1" "\n. complete_metric_set (S n) (d n)" + shows "product_complete_metric r UNIV id id S (\n. bounded_dist (d n)) 1" +proof - + have "\n. complete_metric_set (S n) (bounded_dist (d n))" + "\n x y. bounded_dist (d n) x y \ 1" + using assms(3) by(auto intro!: metric_set.bounded_dist_dist(1) less_imp_le[OF metric_set.bounded_dist_dist(2)] simp: complete_metric_set_def) (simp add: assms(3) complete_metric_set.axioms(2) complete_metric_set.bounded_dist_complete) + thus ?thesis + by(auto intro!: product_complete_metric_natI[OF assms(1,2)]) (meson complete_metric_set_def metric_set.dist_geq0) +qed + +lemma product_polish_metricI': + assumes "0 < r" "r < 1" "countable I" "\i. i \ I \ polish_metric_set (S i) (d i)" + shows "product_polish_metric r I (to_nat_on I) (from_nat_into I) S (\i x y. if i \ I then bounded_dist (d i) x y else 0) 1" +proof - + have "\i. i \ I \ metric_set (S i) (bounded_dist (d i))" + "\i x y. i \ I \ bounded_dist (d i) x y \ 1" + using assms(4) by(auto intro!: metric_set.bounded_dist_dist(1) less_imp_le[OF metric_set.bounded_dist_dist(2)] simp: polish_metric_set_def complete_metric_set_def) + thus ?thesis + using assms(4) by(auto intro!: product_polish_metricI[OF assms(1-3)] polish_metric_set.bounded_dist_polish simp: metric_set_def) +qed + +end \ No newline at end of file diff --git a/thys/Standard_Borel_Spaces/Set_Based_Metric_Space.thy b/thys/Standard_Borel_Spaces/Set_Based_Metric_Space.thy new file mode 100644 --- /dev/null +++ b/thys/Standard_Borel_Spaces/Set_Based_Metric_Space.thy @@ -0,0 +1,5283 @@ +(* Title: Set_Based_Metric_Space.thy + Author: Michikazu Hirata, Tokyo Institute of Technology +*) + +section \Set-Based Metric Spaces\ +theory Set_Based_Metric_Space + imports Lemmas_StandardBorel +begin + +subsection \Set-Based Metric Spaces \ +locale metric_set = + fixes S :: "'a set" + and dist :: "'a \ 'a \ real" + assumes dist_geq0: "\x y. dist x y \ 0" + and dist_notin: "\x y. x \ S \ dist x y = 0" + and dist_0: "\x y. x \ S \ y \ S \ (x = y) = (dist x y = 0)" + and dist_sym: "\x y. dist x y = dist y x" + and dist_tr: "\x y z. x \ S \ y \ S \ z \ S \ dist x z \ dist x y + dist y z" + +lemma metric_class_metric_set[simp]: "metric_set UNIV dist" + by standard (auto simp: dist_commute dist_triangle) + +context metric_set +begin + +abbreviation "dist_typeclass \ Real_Vector_Spaces.dist" + +lemma dist_notin': + assumes "y \ S" + shows "dist x y = 0" + by(auto simp: dist_sym[of x y] intro!: dist_notin assms) + +lemma dist_ge0: + assumes "x \ S" "y \ S" + shows "x \ y \ dist x y > 0" + using dist_0[OF assms] dist_geq0[of x y] by auto + +lemma dist_0'[simp]: "dist x x = 0" + by(cases "x \ S") (use dist_notin dist_0 in auto) + +lemma dist_tr_abs: + assumes "x \ S" "y \ S" "z \ S" + shows "\dist x y - dist y z\ \ dist x z" + using dist_tr[OF assms(1,3,2),simplified dist_sym[of z]] dist_tr[OF assms(2,1,3),simplified dist_sym[of _ x]] + by auto + +text \ Ball \ +definition open_ball :: "'a \ real \ 'a set" where +"open_ball a r \ if a \ S then {x \ S. dist a x < r} else {}" + +lemma open_ball_subset_ofS: "open_ball a \ \ S" + by(auto simp: open_ball_def) + +lemma open_ballD: + assumes "x \ open_ball a \" + shows "dist a x < \" +proof - + have [simp]:"a \ S" + apply(rule ccontr) using assms by(simp add: open_ball_def) + show ?thesis + using assms by(simp add: open_ball_def) +qed + +lemma open_ballD': + assumes "x \ open_ball a \" + shows "x \ S" "a \ S" "\ > 0" +proof - + have 1:"a \ S" + apply(rule ccontr) + using assms by(auto simp: open_ball_def) + have 2:"x \ S" + apply(rule ccontr) + using assms 1 by(auto simp: open_ball_def) + have 3: "dist a x < \" + using assms by(simp add: 1 2 open_ball_def) + show "\ > 0" + apply(rule ccontr) + using 3 dist_geq0[of a x] by auto + show "x \ S" "a \ S" + by fact+ +qed + +lemma open_ball_inverse: + "x \ open_ball y \ \ y \ open_ball x \" +proof - + have 0:"\x y. x \ open_ball y \ \ y \ open_ball x \" + proof - + fix x y + assume 1:"x \ open_ball y \" + show "y \ open_ball x \" + using open_ballD'[OF 1] dist_sym[of y x] 1 by(simp add: open_ball_def) + qed + show ?thesis + using 0[of x y] 0[of y x] by auto +qed + +lemma open_ball_ina[simp]: + assumes "a \ S" and "\ > 0" + shows "a \ open_ball a \" + using assms dist_0[of a a] by(simp add: open_ball_def) + +lemma open_ball_nin_le: + assumes "a \ S" "\ > 0" "b \ S" "b \ open_ball a \" + shows "\ \ dist a b" + using assms by(simp add: open_ball_def) + +lemma open_ball_le: + assumes "r \ l" + shows "open_ball a r \ open_ball a l" + using assms by(auto simp: open_ball_def) + +lemma open_ball_le_0: + assumes "\ \ 0" + shows "open_ball a \ = {}" + using assms dist_geq0[of a] + by(auto simp: open_ball_def) (meson linorder_not_less order_trans) + +lemma open_ball_nin: + assumes "a \ S" + shows "open_ball a \ = {}" + by(simp add: open_ball_def assms) + +definition closed_ball :: "'a \ real \ 'a set" where +"closed_ball a r \ if a \ S then {x \ S. dist a x \ r} else {}" + +lemma closed_ball_subset_ofS: + "closed_ball a \ \ S" + by(auto simp: closed_ball_def) + +lemma closed_ballD: + assumes "x \ closed_ball a \" + shows "dist a x \ \" +proof - + have [simp]:"a \ S" + apply(rule ccontr) using assms by(simp add: closed_ball_def) + show ?thesis + using assms by(simp add: closed_ball_def) +qed + +lemma closed_ballD': + assumes "x \ closed_ball a \" + shows "x \ S" "a \ S" "\ \ 0" +proof - + have 1:"a \ S" + apply(rule ccontr) + using assms by(auto simp: closed_ball_def) + have 2:"x \ S" + apply(rule ccontr) + using assms 1 by(auto simp: closed_ball_def) + have 3: "dist a x \ \" + using assms by(simp add: 1 2 closed_ball_def) + show "\ \ 0" + apply(rule ccontr) + using 3 dist_geq0[of a x] by auto + show "x \ S" "a \ S" + by fact+ +qed + +lemma closed_ball_ina[simp]: + assumes "a \ S" and "\ \ 0" + shows "a \ closed_ball a \" + using assms dist_0[of a a] by(simp add: closed_ball_def) + +lemma closed_ball_le: + assumes "r \ l" + shows "closed_ball a r \ closed_ball a l" + using closed_ballD'[of _ a r] closed_ballD[of _ a r] assms + by(fastforce simp: closed_ball_def[of _ l]) + +lemma closed_ball_le_0: + assumes "\ < 0" + shows "closed_ball a \ = {}" + using assms dist_geq0[of a] + by(auto simp: closed_ball_def) (meson linorder_not_less order_trans) + +lemma closed_ball_0: + assumes "a \ S" + shows "closed_ball a 0 = {a}" + using assms dist_0[OF assms assms] dist_0[OF assms] dist_geq0[of a] order_antisym_conv + by(auto simp: closed_ball_def) + +lemma closed_ball_nin: + assumes "a \ S" + shows "closed_ball a \ = {}" + by(simp add: closed_ball_def assms) + +lemma open_ball_closed_ball: + "open_ball a \ \ closed_ball a \" + using open_ballD'[of _ a \] open_ballD[of _ a \] + by(fastforce simp: closed_ball_def) + +lemma closed_ball_open_ball: + assumes "e < f" + shows "closed_ball a e \ open_ball a f" + using closed_ballD'[of _ a e] closed_ballD[of _ a e] assms + by(fastforce simp: open_ball_def) + +lemma closed_ball_open_ball_un1: + assumes "e > 0" + shows "open_ball a e \ {x\S. dist a x = e} = closed_ball a e" + using assms dist_notin by(auto simp: open_ball_def closed_ball_def) + +lemma closed_ball_open_ball_un2: + assumes "a \ S" + shows "open_ball a e \ {x\S. dist a x = e} = closed_ball a e" + using assms by(auto simp: open_ball_def closed_ball_def) + +definition mtopology :: "'a topology" where +"mtopology = topology (\U. U \ S \ (\x\U. \\>0. open_ball x \ \ U))" + +lemma mtopology_istopology: + "istopology (\U. U \ S \ (\x\U. \\>0. open_ball x \ \ U))" + unfolding istopology_def +proof safe + fix U1 U2 x + assume h1: "U1 \ S" "\y\U1. \\>0. open_ball y \ \ U1" + and h2: "U2 \ S" "\y\U2. \\>0. open_ball y \ \ U2" + and hx: "x \ U1" "x \ U2" + obtain \1 \2 where + "\1 > 0" "\2 > 0""open_ball x \1 \ U1" "open_ball x \2 \ U2" + using h1 h2 hx by blast + thus "\\>0. open_ball x \ \ U1 \ U2" + using open_ball_le[of "min \1 \2" \1 x] open_ball_le[of "min \1 \2" \2 x] + by(auto intro!: exI[where x="min \1 \2"]) +next + fix \ U x + assume h:"\K\\. K \ S \ (\x\K. \\>0. open_ball x \ \ K)" + "U \ \" "x \ U" + then obtain \ where + "\ > 0" "open_ball x \ \ U" + by blast + thus "\\>0. open_ball x \ \ \ \" + using h(2) by(auto intro!: exI[where x=\]) +qed auto + +lemma mtopology_openin_iff: + "openin mtopology U \ U \ S \ (\x\U. \\>0. open_ball x \ \ U)" + by (simp add: mtopology_def mtopology_istopology) + +lemma mtopology_topspace: "topspace mtopology = S" + unfolding topspace_def mtopology_def topology_inverse'[OF mtopology_istopology] +proof - + have "\x\S. \\>0. open_ball x \ \ S" + by(auto intro!: exI[where x=1] simp: open_ball_def) + thus "\ {U. U \ S \ (\x\U. \\>0. open_ball x \ \ U)} = S" + by auto +qed + +lemma openin_S[simp]: "openin mtopology S" + by (metis openin_topspace mtopology_topspace) + +lemma mtopology_open_ball_in': + assumes "x \ open_ball a \" + shows "\\'>0. open_ball x \' \ open_ball a \" +proof - + show "\\'>0. open_ball x \' \ open_ball a \" + proof(intro exI[where x="\ - dist a x"] conjI) + show "0 < \ - dist a x" + using open_ballD'[OF assms] open_ballD[OF assms] by auto + next + show "open_ball x (\ - dist a x) \ open_ball a \" + proof + fix y + assume hy:"y \ open_ball x (\ - dist a x)" + show "y \ open_ball a \" + using open_ballD[OF hy] open_ballD[OF assms] open_ballD'(2)[OF assms] dist_tr[OF open_ballD'(2)[OF assms] open_ballD'(1)[OF assms] open_ballD'(1)[OF hy]] + by(auto simp: open_ball_def assms(1) open_ballD'[OF hy]) + qed + qed +qed + +lemma mtopology_open_ball_in: + assumes "a \ S" and "\ > 0" + shows "openin mtopology (open_ball a \)" + using mtopology_open_ball_in' topology_inverse'[OF mtopology_istopology] open_ball_subset_ofS mtopology_def + by auto + +lemma openin_open_ball: "openin mtopology (open_ball a \)" +proof - + consider "a \ S \ \ > 0" | "a \ S" | "\ \ 0" by fastforce + thus ?thesis + by cases (simp_all add: mtopology_open_ball_in open_ball_le_0 open_ball_nin) +qed + +lemma closedin_closed_ball: "closedin mtopology (closed_ball a \)" + unfolding closedin_def mtopology_topspace mtopology_openin_iff +proof safe + fix x + assume h:"x \ S" "x \ closed_ball a \" + consider "a \ S" | "\ < 0" | "a \ S" "\ \ 0" by fastforce + thus "\\'>0. open_ball x \' \ S - closed_ball a \" + proof cases + case 3 + then have "dist a x > \" + using h by(auto simp: closed_ball_def) + show ?thesis + proof(intro exI[where x="dist a x - \"] conjI) + show "open_ball x (dist a x - \) \ S - closed_ball a \" + proof safe + fix z + assume h':"z \ open_ball x (dist a x - \)" "z \ closed_ball a \" + have "dist a x \ dist a z + dist z x" + by(auto intro!: dist_tr 3 open_ballD'[OF h'(1)]) + also have "... \ \ + dist z x" + using closed_ballD[OF h'(2)] by simp + also have "... < dist a x" + using open_ballD[OF h'(1),simplified dist_sym[of x]] by auto + finally show False .. + qed(use open_ball_subset_ofS \dist a x > \\ in auto) + qed(use open_ball_subset_ofS \dist a x > \\ in auto) + qed(auto simp: closed_ball_nin closed_ball_le_0 open_ball_subset_ofS intro!: exI[where x=1]) +qed(use closed_ball_subset_ofS in auto) + +lemma mtopology_def2: + "mtopology = topology_generated_by {open_ball a \ | a \. a \ S \ \ > 0}" + (is "?lhs = ?rhs") +proof - + have "\U. openin ?lhs U = openin ?rhs U" + proof + fix U + assume h:"openin mtopology U" + then have "\x\ U. \\ > 0. open_ball x \ \ U" + using topology_inverse'[OF mtopology_istopology] + by(simp add: mtopology_def) + then obtain \ where he: + "\x. x \ U \ \ x > 0 \ open_ball x (\ x) \ U" + using bchoice[of U "\x \. \ > 0 \ open_ball x \ \ U"] + by blast + have "U = \{open_ball x (\ x)|x. x\ U}" + proof + show "\ {open_ball x (\ x) |x. x \ U} \ U" + using he by auto + next + show "U \ \ {open_ball x (\ x) |x. x \ U}" + proof + fix a + assume ha:"a \ U" + then have "a \ open_ball a (\ a)" + using he[of a] open_ball_ina[of a "\ a"] openin_subset[OF h,simplified] + by(auto simp: mtopology_topspace) + thus "a \ \ {open_ball x (\ x) |x. x \ U}" + using ha by auto + qed + qed + also have "generate_topology_on {open_ball a \ |a \. a \ S \ 0 < \} ..." + apply(rule generate_topology_on.UN) + apply(rule generate_topology_on.Basis) + using he openin_subset[OF h,simplified] + by(fastforce simp: mtopology_topspace) + finally show "openin (topology_generated_by {open_ball a \ |a \. a \ S \ 0 < \}) U" + by (simp add: openin_topology_generated_by_iff) + next + fix U + assume "openin (topology_generated_by {open_ball a \ |a \. a \ S \ 0 < \}) U" + then have "generate_topology_on {open_ball a \ |a \. a \ S \ 0 < \} U" + by (simp add: openin_topology_generated_by_iff) + thus "openin mtopology U" + apply induction + using mtopology_open_ball_in + by auto + qed + thus ?thesis + by(simp add: topology_eq) +qed + +abbreviation mtopology_subbasis :: "'a set set \ bool" where +"mtopology_subbasis \ \ subbase_of mtopology \" + +lemma mtopology_subbasis1: + "mtopology_subbasis {open_ball a \ | a \. a \ S \ \ > 0}" + by(simp add: mtopology_def2 subbase_of_def) + +abbreviation mtopology_basis :: "'a set set \ bool" where +"mtopology_basis \ \ base_of mtopology \" + +lemma mtopology_basis_ball: + "mtopology_basis {open_ball a \ | a \. a \ S \ \ > 0}" + unfolding base_of_def +proof - + show "\U. openin mtopology U = (\\. U = \ \ \ \ \ {open_ball a \ |a \. a \ S \ 0 < \})" + proof safe + fix U + assume "openin mtopology U" + then have "U \ S" "\x. x\U \ \\>0. open_ball x \ \ U" + by(auto simp: mtopology_openin_iff) + then obtain \ where he: + "\x. x \ U \ \ x > 0" "\x. x \ U \ open_ball x (\ x) \ U" + by metis + hence "(\ { open_ball x (\ x) | x. x \ U}) = U" + using \U \ S\ open_ball_ina[of _ "\ _"] by fastforce + thus "\\. U = \ \ \ \ \ {open_ball a \ |a \. a \ S \ 0 < \}" + using he(1) \U \ S\ by(fastforce intro!: exI[where x="{ open_ball x (\ x) | x. x \ U}"]) + qed(use mtopology_open_ball_in in blast) +qed + +abbreviation sequence :: "(nat \ 'a) set" where +"sequence \ UNIV \ S" + +lemma sequence_comp: + "xn \ sequence \ (\n. (xn (a n))) \ sequence" + "xn \ sequence \ xn \ an \ sequence" + by auto + +definition converge_to_inS :: "[nat \ 'a, 'a] \ bool" where +"converge_to_inS f s \ f \ sequence \ s \ S \ (\n. dist (f n) s) \ 0" + +lemma converge_to_inS_const: + assumes "x \ S" + shows "converge_to_inS (\n. x) x" + using assms dist_0[of x x] by(simp add: converge_to_inS_def) + +lemma converge_to_inS_subseq: + assumes "strict_mono a" "converge_to_inS f s" + shows "converge_to_inS (f \ a) s" +proof - + have "((\n. dist (f n) s) \ a) \ 0" + using assms by(auto intro!: LIMSEQ_subseq_LIMSEQ simp: converge_to_inS_def) + thus ?thesis + using assms by(auto simp: converge_to_inS_def comp_def) +qed + +lemma converge_to_inS_ignore_initial: + assumes "converge_to_inS xn x" + shows "converge_to_inS (\n. xn (n + k)) x" + using LIMSEQ_ignore_initial_segment[of "\n. dist (xn n) x" 0 k] assms + by(auto simp: converge_to_inS_def) + +lemma converge_to_inS_offset: + assumes "converge_to_inS (\n. xn (n + k)) x" "xn \ sequence" + shows "converge_to_inS xn x" + using LIMSEQ_offset[of "\n. dist (xn n) x" k] assms + by(auto simp: converge_to_inS_def) + +lemma converge_to_inS_def2: + "converge_to_inS f s \ (f \ sequence \ s \ S \ (\\>0. \N. \n\N. dist (f n) s < \))" +proof + assume h:"converge_to_inS f s " + show "f \ sequence \ s \ S \ (\\>0. \N. \n\N. dist (f n) s < \)" + proof safe + fix \ :: real + assume he:"0 < \" + have hs:"\S. open S \ 0 \ S \ (\N. \n\N. dist (f n) s \ S)" + using h lim_explicit[of "\n. dist (f n) s" 0] + by(simp add: converge_to_inS_def) + then obtain N where + "\n\N. dist (f n) s \ {-1<..<\}" + using hs[of "{-1<..<\}"] he by fastforce + thus "\N. \n\N. dist (f n) s < \" + by(auto intro!: exI[where x=N]) + qed(use h[simplified converge_to_inS_def] in auto) +next + assume h:"f \ sequence \ s \ S \ (\\>0. \N. \n\N. dist (f n) s < \)" + have "\S. open S \ 0 \ S \ (\N. \n\N. dist (f n) s \ S)" + proof safe + fix S :: "real set" + assume hs:"open S" "0 \ S" + then obtain \ where he: + "\ > 0" "ball 0 \ \ S" + using open_contains_ball[of S] by fastforce + then obtain N where + "\n\N. dist (f n) s < \" + using h by auto + thus "\N. \n\N. dist (f n) s \ S" + using he dist_geq0 by(auto intro!: exI[where x=N]) + qed + thus "converge_to_inS f s " + using lim_explicit[of "\n. dist (f n) s" 0] h + by(simp add: converge_to_inS_def) +qed + +lemma converge_to_inS_def2': + "converge_to_inS f s \ (f \ sequence \ s \ S \ (\\>0. \N. \n\N. (f n) \ open_ball s \))" + unfolding converge_to_inS_def2 open_ball_def dist_sym[of s] + by fastforce + +lemma converge_to_inS_unique: + assumes "converge_to_inS f x" "converge_to_inS f y" + shows "x = y" +proof - + have inS:"\n. f n \ S" "x \ S" "y \ S" + using assms by(auto simp: converge_to_inS_def) + have "\dist x y\ < \" if "\ > 0" for \ + proof - + have "0 < \ / 2" using that by simp + then obtain N1 N2 where hn: + "\n. n \ N1 \ dist (f n) x < \ / 2" "\n. n \ N2 \ dist (f n) y < \ / 2" + using assms converge_to_inS_def2 by blast + have "dist x y \ dist (f (max N1 N2)) x + dist (f (max N1 N2)) y" + unfolding dist_sym[of "f (max N1 N2)" x] by(rule dist_tr[OF inS(2) inS(1)[of "max N1 N2"] inS(3)]) + also have "... < \ / 2 + \ / 2" + by(rule add_strict_mono) (use hn[of "max N1 N2"] in auto) + finally show ?thesis + using dist_geq0[of x y] by simp + qed + hence "dist x y = 0" + using zero_less_abs_iff by blast + thus ?thesis + using dist_0[OF inS(2,3)] by simp +qed + +lemma mtopology_closedin_iff: "closedin mtopology M \ M \ S \ (\f\(UNIV \ M). \s. converge_to_inS f s \ s \ M)" +proof + assume "closedin mtopology M" + then have h:"\x\S - M. \\>0. open_ball x \ \ S - M" + by (simp add: closedin_def mtopology_openin_iff mtopology_topspace) + show "M \ S \ (\f\UNIV \ M. \s. converge_to_inS f s \ s \ M)" + proof safe + fix f :: "nat \ 'a" and s + assume hf:"f \ UNIV \ M" "converge_to_inS f s" + show "s \ M" + proof(rule ccontr) + assume "s \ M" + then have "s \ S - M" + using hf(2) by(auto simp: converge_to_inS_def) + then obtain \ where "\ > 0" "open_ball s \ \ S - M" + using h by auto + then obtain N where "\n. n \ N \ f n \ open_ball s \" + using hf(2) by(auto simp: converge_to_inS_def2') metis + from \open_ball s \ \ S - M\ this[of N] hf(1) + show False by auto + qed + qed(rule subsetD[OF closedin_subset[OF \closedin mtopology M\,simplified mtopology_topspace]]) +next + assume h:"M \ S \ (\f\UNIV \ M. \s. converge_to_inS f s \ s \ M)" + show "closedin mtopology M" + unfolding closedin_def mtopology_openin_iff mtopology_topspace + proof safe + fix x + assume "x \ S" "x \ M" + show "\\>0. open_ball x \ \ S - M" + proof(rule ccontr) + assume "\ (\\>0. open_ball x \ \ S - M)" + then have "\\>0. open_ball x \ \ M \ {}" + by (metis Diff_mono Diff_triv open_ball_subset_ofS subset_refl) + hence "\n. \a. a \ open_ball x (1 / real (Suc n)) \ M" + by (meson of_nat_0_less_iff subsetI subset_empty zero_less_Suc zero_less_divide_1_iff) + then obtain f where hf:"\n. f n \ open_ball x (1 / (Suc n)) \ M" by metis + hence "f \ UNIV \ M" by auto + moreover have "converge_to_inS f x" + unfolding converge_to_inS_def2' + proof safe + show "f x \ S" for x + using h hf by auto + next + fix \ + assume "(0::real) < \" + then obtain N where "1 / real (Suc N) < \" + using nat_approx_posE by blast + show "\N. \n\N. f n \ open_ball x \" + proof(rule exI[where x=N]) + show "\n\N. f n \ open_ball x \" + proof safe + fix n + assume "N \ n" + then have "1 / real (Suc n) \ 1 / real (Suc N)" + by (simp add: frac_le) + also have "... \ \" + using \1 / real (Suc N) < \\ by simp + finally show "f n \ open_ball x \" + using open_ball_le[of "1 / real (Suc n)" \ x] hf by auto + qed + qed + qed fact + ultimately show False + using h \x \ M\ by blast + qed + qed(use h in auto) +qed + +lemma mtopology_closedin_iff2: "closedin mtopology M \ M \ S \ (\x. x \ M \ (\\>0. open_ball x \ \ M \ {}))" +proof + assume h:"closedin mtopology M" + have 1: "M \ S" + using h by(auto simp add: mtopology_closedin_iff) + show "M \ S \ (\x. (x \ M) = (\\>0. open_ball x \ \ M \ {}))" + proof safe + fix \ x + assume "x \ M" "(0 :: real) < \" "open_ball x \ \ M = {}" + thus False + using open_ball_ina[of x \] 1 by blast + next + fix x + assume "\\>0. open_ball x \ \ M \ {}" + hence "\f. f \ open_ball x (1 / real (Suc n)) \ M" for n + by (meson all_not_in_conv divide_pos_pos of_nat_0_less_iff zero_less_Suc zero_less_one) + then obtain f where hf:"\n. f n \ open_ball x (1 / real (Suc n)) \ M" + by metis + hence "x \ S" "f \ UNIV \ M" + using open_ballD'(2)[of "f 0" x] by auto + have "converge_to_inS f x" + unfolding converge_to_inS_def2' + proof safe + show "\x. f x \ S" + using 1 \f \ UNIV \ M\ by auto + next + fix \ + assume "(0 :: real) < \" + then obtain N where hN: "1 / real (Suc N) < \" + using nat_approx_posE by blast + show "\N. \n\N. f n \ open_ball x \" + proof(rule exI[where x="N"]) + show "\n\N. f n \ open_ball x \" + proof safe + fix n + assume "N \ n" + then have "1 / real (Suc n) \ 1 / real (Suc N)" + using inverse_of_nat_le by blast + thus "f n \ open_ball x \ " + using hf[of n] open_ball_le[of "1 / real (Suc n)" "\" x] hN + by auto + qed + qed + qed fact + with \f \ UNIV \ M\ show "x \ M" + using h[simplified mtopology_closedin_iff] by simp + qed(use 1 in auto) +next + assume"M \ S \ (\x. (x \ M) \ (\\>0. open_ball x \ \ M \ {}))" + hence h:"M \ S" "\x. (x \ M) \ (\\>0. open_ball x \ \ M \ {})" + by simp_all + show "closedin mtopology M" + unfolding mtopology_closedin_iff + proof safe + fix f s + assume h':"f \ UNIV \ M" "converge_to_inS f s" + hence "s \ S" by(simp add: converge_to_inS_def) + have "open_ball s \ \ M \ {}" if "\ > 0" for \ + proof - + obtain N where hN:"\n. n \ N \ dist (f n) s < \" + using h'(2) \\ > 0\ by(auto simp: converge_to_inS_def2) metis + have "f N \ open_ball s \ \ M" + using \f \ UNIV \ M\ \s \ S\ hN[of N] that open_ball_def[of s \] h(1) dist_sym[of s] + by auto + thus "open_ball s \ \ M \ {}" by auto + qed + with h(2)[of s] show "s \ M" by simp + qed(use h(1) in auto) +qed + +lemma mtopology_openin_iff2: + "openin mtopology A \ A \ S \ (\f x. converge_to_inS f x \ x \ A \ (\N. \n\N. f n \ A))" +proof + show "openin mtopology A \ A \ S \ (\f x. converge_to_inS f x \ x \ A \ (\N. \n\N. f n \ A))" + unfolding mtopology_openin_iff + proof safe + fix f x + assume "\x\A. \\>0. open_ball x \ \ A" "converge_to_inS f x" "x \ A" + then obtain \ where "\ > 0" "open_ball x \ \ A" + by auto + then obtain N where "\n. n \ N \ dist (f n) x < \" + using \converge_to_inS f x\ by(fastforce simp: converge_to_inS_def2) + hence "\n. n \ N \ f n \ open_ball x \" + using \converge_to_inS f x\ by(auto simp: dist_sym[of _ x] open_ball_def converge_to_inS_def) + with \open_ball x \ \ A\ show "\N. \n\N. f n \ A" + by(auto intro!: exI[where x=N]) + qed +next + assume "A \ S \ (\f x. converge_to_inS f x \ x \ A \ (\N. \n\N. f n \ A))" + hence h:"A \ S" "\f x. converge_to_inS f x \ x \ A \ \N. \n\N. f n \ A" + by auto + have "closedin mtopology (S - A)" + unfolding mtopology_closedin_iff + proof safe + fix f s + assume hf:"f \ UNIV \ S - A" + "converge_to_inS f s" + have False if "s \ A" + proof - + from h(2)[OF hf(2) that] + obtain N where "\n. n \ N \ f n \ A" by auto + from hf (1) this[of N] show False by auto + qed + thus "s \ S" "s \ A \ False" + using hf(2) by (auto simp: converge_to_inS_def) + qed + thus "openin mtopology A" + using h(1) mtopology_topspace by(simp add: openin_closedin_eq) +qed + +lemma closure_of_mtopology: "mtopology closure_of A = {a. \\>0. open_ball a \ \ A \ {}}" +proof safe + fix x \ + assume "x \ mtopology closure_of A" "(0 :: real) < \" "open_ball x \ \ A = {}" + then show False + using mtopology_closedin_iff2[of "mtopology closure_of A",simplified] + by (simp add: mtopology_open_ball_in' mtopology_openin_iff open_ball_subset_ofS openin_Int_closure_of_eq_empty) +next + fix x + assume "\\>0. open_ball x \ \ A \ {}" + then have "\\>0. open_ball x \ \ mtopology closure_of A \ {}" + by (simp add: mtopology_open_ball_in' mtopology_openin_iff open_ball_subset_ofS openin_Int_closure_of_eq_empty) + thus "x \ mtopology closure_of A" + using mtopology_closedin_iff2[of "mtopology closure_of A",simplified] + by auto +qed + +lemma closure_of_mtopology': + "mtopology closure_of A = {a. \an\UNIV \ A. converge_to_inS an a}" +proof safe + fix a + assume "a \ mtopology closure_of A" + then have "\\>0. open_ball a \ \ A \ {}" + by(simp add: closure_of_mtopology) + hence "\n. \an. an \ open_ball a (1/real (Suc n)) \ A" + by (meson all_not_in_conv divide_pos_pos of_nat_0_less_iff zero_less_Suc zero_less_one) + then obtain an where han:"\n. an n \ open_ball a (1/real (Suc n)) \ A" by metis + hence "an \ UNIV \ A" by auto + show "\an\UNIV \ A. converge_to_inS an a" + proof(safe intro!: bexI[where x=an] \an \ UNIV \ A\) + show "converge_to_inS an a" + unfolding converge_to_inS_def2' + proof safe + show "an n \ S" "a \ S" for n + using open_ballD'(2)[of "an 0" a] open_ballD'(1)[of "an n"] han by auto + next + fix \ + assume "(0 :: real) < \" + then obtain N where "1 / real (Suc N) \ \" + by (meson less_eq_real_def nat_approx_posE) + show "\N. \n\N. an n \ open_ball a \" + proof(safe intro!: exI[where x=N]) + fix n + assume "N \ n" + then have "1 / real (Suc n) \ 1 / real (Suc N)" + by (simp add: frac_le) + from open_ball_le[OF order_trans[OF this \1 / real (Suc N) \ \\]] + show "an n \ open_ball a \" + using han by auto + qed + qed + qed +next + fix a an + assume h:"an \ UNIV \ A" "converge_to_inS an a" + have "\\>0. open_ball a \ \ A \ {}" + proof safe + fix \ + assume "(0 :: real) < \" "open_ball a \ \ A = {}" + then obtain N where "an N \ open_ball a \" + using h(2) converge_to_inS_def2' by blast + with \open_ball a \ \ A = {}\ h(1) show False by auto + qed + thus "a \ mtopology closure_of A" + by(simp add: closure_of_mtopology) +qed + +lemma closure_of_mtopology_an: + assumes "a \ mtopology closure_of A" + obtains an where "an\UNIV \ A" "converge_to_inS an a" + using assms by(auto simp: closure_of_mtopology') + +lemma closure_of_open_ball: "mtopology closure_of open_ball a \ \ closed_ball a \" + by(rule closure_of_minimal_eq[THEN iffD2]) (auto simp: open_ball_subset_ofS mtopology_topspace closedin_closed_ball open_ball_closed_ball) + +lemma interior_of_closed_ball: "open_ball a e \ mtopology interior_of closed_ball a e" + by(auto simp: interior_of_maximal_eq openin_open_ball open_ball_closed_ball) + +lemma derived_set_of_mtopology: + "mtopology derived_set_of A = {a. \an\UNIV \ A. (\n. an n \ a) \ converge_to_inS an a}" +proof safe + fix a + assume "a \ mtopology derived_set_of A" + then have h:"a \ S" "\v. a \ v \ openin mtopology v \ \y. y \ a \ y \ v \ y \ A" + by(auto simp: in_derived_set_of mtopology_topspace) + hence "a \ open_ball a (1 / real (Suc n))" for n + by(auto intro!: open_ball_ina) + from h(2)[OF this openin_open_ball[of a]] + obtain an where an:"\n. an n \ a" "\n. an n \ open_ball a (1 / real (Suc n))" "\n. an n \ A" + by metis + show "\an\UNIV \ A. (\n. an n \ a) \ converge_to_inS an a" + proof(safe intro!: bexI[where x=an] an(1)) + show "converge_to_inS an a" + unfolding converge_to_inS_def2' + proof safe + show "\x. an x \ S" + using an(2) open_ball_subset_ofS by auto + next + fix \ + assume "(0 :: real) < \" + then obtain N where hN:"1 / real (Suc N) < \" + using nat_approx_posE by blast + show "\N. \n\N. an n \ open_ball a \" + proof(safe intro!: exI[where x=N]) + fix n + assume "N \ n" + then have "1 / real (Suc n) \ 1 / real (Suc N)" + by (simp add: frac_le) + from order.strict_trans1[OF this hN] open_ball_le[of _ \ a] an(2)[of n] + show "an n \ open_ball a \" by(auto simp: less_le) + qed + qed(use h in auto) + qed(use an in auto) +next + fix a an + assume h:"an \ UNIV \ A" "\n. an n \ a" "converge_to_inS an a" + have "\y. y \ a \ y \ v \ y \ A" if "a \ v" "openin mtopology v" for v + proof - + obtain \ where he:"\ > 0" "a \ open_ball a \" "open_ball a \ \ v" + by (meson \a \ v\ \openin mtopology v\ converge_to_inS_def2 h(3) mtopology_openin_iff open_ball_ina) + then obtain N where hn:"\n. n \ N \ an n \ open_ball a \" + using h(3) by(fastforce simp: converge_to_inS_def2') + show " \y. y \ a \ y \ v \ y \ A" + using h(1,2) he hn by(auto intro!: exI[where x="an N"]) + qed + thus "a \ mtopology derived_set_of A" + using h(3) by(auto simp: in_derived_set_of converge_to_inS_def mtopology_topspace) +qed + +lemma isolated_points_of_mtopology: + "mtopology isolated_points_of A = {a\S\A. \an\UNIV \ A. converge_to_inS an a \ (\no. \n\no. an n = a)}" +proof safe + fix a an + assume h:"a \ mtopology isolated_points_of A" "converge_to_inS an a" "an \ UNIV \ A" + then have ha:"a \ topspace mtopology" "a \ A" "\U. a \ U \ openin mtopology U \ U \ (A - {a}) = {}" + by(simp_all add: in_isolated_points_of) + then obtain U where u:"a \ U" "openin mtopology U" "U \ (A - {a}) = {}" + by auto + then obtain \ where e: "\ > 0" "open_ball a \ \ U" + by(auto simp: mtopology_openin_iff) + then obtain N where "\n. n \ N \ an n \ open_ball a \" + using h(2) by(fastforce simp: converge_to_inS_def2') + thus "\no. \n\no. an n = a" + using h(3) e(2) u(3) by(auto intro!: exI[where x=N]) +qed (auto simp: derived_set_of_mtopology isolated_points_of_def mtopology_topspace) + +lemma perfect_set_open_ball_infinite: + assumes "perfect_set mtopology A" + shows "closedin mtopology A \ (\a\A. \\>0. infinite (open_ball a \))" +proof safe + fix a \ + assume h: "a \ A" "0 < \" "finite (open_ball a \)" + then have "a \ S" + using open_ball_ina[OF _ \0 < \\,of a] perfect_setD(2)[OF assms] + by(auto simp: mtopology_topspace) + have "\e > 0. open_ball a e = {a}" + proof - + consider "open_ball a \ = {a}" | "{a} \ open_ball a \" + using open_ball_ina[OF \a \ S\ h(2)] by blast + thus ?thesis + proof cases + case 1 + with h(2) show ?thesis by auto + next + case 2 + then have nen:"{dist a b |b. b \ open_ball a \ \ a \ b} \ {}" + by auto + have fin: "finite {dist a b |b. b \ open_ball a \ \ a \ b}" + using h(3) by auto + define e where "e \ Min {dist a b |b. b \ open_ball a \ \ a \ b}" + have "e > 0" + using dist_0[OF \a \ S\ open_ballD'(1)[of _ a \]] dist_geq0[of a] + by(auto simp: e_def Min_gr_iff[OF fin nen] order_neq_le_trans) + have bd:"\b. b \ open_ball a \ \ a \ b \ e \ dist a b" + by(auto simp: e_def Min_le_iff[OF fin nen]) + have "e \ \" + using nen open_ballD[of _ a \] + by(fastforce simp add: e_def Min_le_iff[OF fin nen]) + show ?thesis + proof(safe intro!: exI[where x=e]) + fix x + assume x:"x \ open_ball a e" + then show "x = a" + using open_ball_le[OF \e \ \\,of a] open_ballD[OF x] bd[of x] + by auto + qed (simp_all add: open_ball_ina[OF \a \ S\ \e > 0\] \0 < e\) + qed + qed + then obtain e where e:"e > 0" "open_ball a e = {a}" by auto + show False + using perfect_setD(3)[OF assms h(1) open_ball_ina[OF \a \ S\ \e > 0\]] + by(auto simp: openin_open_ball) (use e(2) in auto) +qed(use perfect_setD[OF assms] in simp) + +lemma nbh_subset: + assumes A: "A \ S" and e: "e > 0" + shows "A \ (\a\A. open_ball a e)" + using A open_ball_ina[OF _ e] by auto + +lemma nbh_decseq: + assumes "decseq an" + shows "decseq (\n. \a\A. open_ball a (an n))" +proof(safe intro!: decseq_SucI) + fix n a b + assume "a \ A" "b \ open_ball a (an (Suc n))" + with open_ball_le[OF decseq_SucD[OF assms]] show "b \ (\c\A. open_ball c (an n))" + by(auto intro!: bexI[where x=a] simp: frac_le) +qed + +lemma nbh_Int: + assumes A: "A \ {}" "A \ S" + and an:"\n. an n > 0" "decseq an" "an \ 0" + shows "(\n. \a\A. open_ball a (an n)) = mtopology closure_of A" +proof safe + fix x + assume "x \ (\n. \a\A. open_ball a (an n))" + then have h:"\n. \a\A. x \ open_ball a (an n)" + by auto + hence x:"x \ S" + using open_ball_subset_ofS by auto + show "x \ mtopology closure_of A" + unfolding closure_of_mtopology + proof safe + fix e :: real + assume h':"e > 0" "open_ball x e \ A = {}" + then obtain n where n:"an n < e" + using an(1,3) by(auto simp: LIMSEQ_def abs_of_pos) (metis dual_order.refl) + from h obtain a where "a \ A" "x \ open_ball a (an n)" + by auto + with h'(2) open_ball_le[of "an n" e x] n + show False + by(auto simp: open_ball_inverse[of x]) + qed +next + fix x n + assume "x \ mtopology closure_of A" + with an(1) have "open_ball x (an n) \ A \ {}" + by(auto simp: closure_of_mtopology) + thus "x \ (\a\A. open_ball a (an n))" + by(auto simp: open_ball_inverse[of x]) +qed + +lemma nbh_add: "(\b\(\a\A. open_ball a e). open_ball b f) \ (\a\A. open_ball a (e + f))" +proof safe + fix a x b + assume h:"a \ A" "b \ open_ball a e" "x \ open_ball b f" + show "x \ (\a\A. open_ball a (e + f))" + proof(rule UN_I[OF h(1)]) + have "dist a x \ dist a b + dist b x" + by(auto intro!: dist_tr open_ballD'(2)[OF h(2)] open_ballD'[OF h(3)]) + also have "... < e + f" + using open_ballD[OF h(2)] open_ballD[OF h(3)] by auto + finally show "x \ open_ball a (e + f)" + using open_ballD'[OF h(2)] open_ballD'[OF h(3)] + by(auto simp: open_ball_def) + qed +qed + +definition convergent_inS :: "(nat \ 'a) \ bool" where +"convergent_inS f \ \s. converge_to_inS f s" + +lemma convergent_inS_const: + assumes "x \ S" + shows "convergent_inS (\n. x)" + using converge_to_inS_const[OF assms] by(auto simp: convergent_inS_def) + +lemma convergent_inS_ignore_initial: + assumes "convergent_inS xn" + shows "convergent_inS (\n. xn (n + k))" + using converge_to_inS_ignore_initial[of xn] assms + by(auto simp: convergent_inS_def) + +lemma convergent_inS_offset: + assumes "convergent_inS (\n. xn (n + k))" "xn \ sequence" + shows "convergent_inS xn" + using converge_to_inS_offset[of xn k] assms + by(auto simp: convergent_inS_def) + +definition the_limit_of :: "(nat \ 'a) \ 'a" where +"the_limit_of xn \ THE x. converge_to_inS xn x" + +lemma the_limit_if_converge: + assumes "convergent_inS xn" + shows "converge_to_inS xn (the_limit_of xn)" + unfolding the_limit_of_def + by(rule theI') (auto simp: assms[simplified convergent_inS_def] converge_to_inS_unique) + +lemma the_limit_of_eq: + assumes "converge_to_inS xn x" + shows "the_limit_of xn = x" + using assms converge_to_inS_unique the_limit_of_def by auto + +lemma the_limit_of_inS: + assumes "convergent_inS xn" + shows "the_limit_of xn \ S" + using the_limit_if_converge[OF assms] by(simp add:converge_to_inS_def) + +lemma the_limit_of_const: + assumes "x \ S" + shows "the_limit_of (\n. x) = x" + by(rule the_limit_of_eq[OF converge_to_inS_const[OF assms]]) + +lemma convergent_inS_dest1: + assumes "convergent_inS f" + shows "f n \ S" + using assms by(auto simp: convergent_inS_def converge_to_inS_def2) + +definition Cauchy_inS:: "(nat \ 'a) \ bool" where +"Cauchy_inS f \ f \ sequence \ (\\>0. \N. \n\N. \m\N. dist (f n) (f m) < \)" + +lemma Cauchy_inS_def2: + "Cauchy_inS f \ f \ sequence \ (\\>0. \N. \n\N. f n \ open_ball (f N) \)" + unfolding Cauchy_inS_def +proof safe + fix \ :: real + assume h:"f \ sequence" " \\>0. \N. \n\N. \m\N. dist (f n) (f m) < \" "0 < \" + then obtain N where hn: + "\n m. n \ N \ m\N \ dist (f n) (f m) < \" + by fastforce + show "\N. \n\N. f n \ open_ball (f N) \" + proof(safe intro!: exI[where x=N]) + fix n + assume "N \ n" + then show "f n \ open_ball (f N) \" + using h(1) hn[of N n] by(auto simp: open_ball_def) + qed +next + fix \ :: real + assume h:"f \ sequence" "\\>0. \N. \n\N. f n \ open_ball (f N) \" "0 < \" + then obtain N where hn: + "\n. n \ N \ f n \ open_ball (f N) (\/2)" + using linordered_field_class.half_gt_zero[OF h(3)] by blast + show "\N. \n\N. \m\N. dist (f n) (f m) < \" + proof(safe intro!: exI[where x=N]) + fix n m + assume "N \ n" "N \ m" + from order.strict_trans1[OF dist_tr [of "f n" "f N" "f m"] strict_ordered_ab_semigroup_add_class.add_strict_mono[OF open_ballD[OF hn[OF this(1)],simplified dist_sym[of _ "f n"]] open_ballD[OF hn[OF this(2)]],simplified]] + show "dist (f n) (f m) < \" + using h(1) by auto + qed +qed + +lemma Cauchy_inS_def2': + "Cauchy_inS f \ f \ sequence \ (\\>0. \x\S. \N. \n\N. f n \ open_ball x \)" + unfolding Cauchy_inS_def2 +proof safe + fix \ :: real + assume h:"f \ sequence" "\\>0. \N. \n\N. f n \ open_ball (f N) \" "0 < \" + then obtain N where "\n\N. f n \ open_ball (f N) \" by auto + thus "\x\S. \N. \n\N. f n \ open_ball x \" + using h(1) by(auto intro!: exI[where x=N] bexI[where x="f N"]) +next + fix \ :: real + assume h:"f \ sequence" "\\>0. \x\S. \N. \n\N. f n \ open_ball x \" "0 < \" + then obtain x N where hxn: + "x \ S" "\n. n \ N \ f n \ open_ball x (\/2)" + using linordered_field_class.half_gt_zero[OF h(3)] by blast + show "\N. \n\N. f n \ open_ball (f N) \" + proof(safe intro!: exI[where x=N]) + fix n + assume "N \ n" + from order.strict_trans1[OF dist_tr strict_ordered_ab_semigroup_add_class.add_strict_mono[OF open_ballD[OF hxn(2)[OF order.refl],simplified dist_sym[of x]] open_ballD[OF hxn(2)[OF this]],simplified]] + show "f n \ open_ball (f N) \" + using hxn(1) h(1) by(auto simp: open_ball_def) + qed +qed + +lemma Cauchy_inS_def2'': + "Cauchy_inS f \ f \ sequence \ (\\>0. \x\S. \N. \n\N. dist x (f n) < \)" + unfolding Cauchy_inS_def2' +proof safe + fix \ :: real + assume h:"f \ sequence" "\\>0. \x\S. \N. \n\N. f n \ open_ball x \" "0 < \" + then obtain x N where + "x \ S" "\n. n \ N \ f n \ open_ball x \" + by blast + then show "\x\S. \N. \n\N. dist x (f n) < \" + by(auto intro!: bexI[where x=x] exI[where x=N] simp: open_ballD[of _ x \]) +next + fix \ :: real + assume h:"f \ sequence" "\\>0. \x\S. \N. \n\N. dist x (f n) < \" "0 < \" + then obtain x N where + "x \ S" "\n. n \ N \ dist x (f n) < \" by blast + then show "\x\S. \N. \n\N. f n \ open_ball x \" + using h(1) by(auto intro!: bexI[where x=x] exI[where x=N] simp: open_ball_def) +qed + +lemma Cauchy_inS_dest1: + assumes "Cauchy_inS f" + shows "f n \ S" + using assms by(auto simp: Cauchy_inS_def) + +lemma Cauchy_if_convergent_inS: + assumes "convergent_inS f" + shows "Cauchy_inS f" + unfolding Cauchy_inS_def +proof safe + fix \ :: real + assume h:"0 < \" + obtain s where hs: + "s \ S" "\\>0. \N. \n\N. dist (f n) s < \" + using assms by(auto simp: convergent_inS_def converge_to_inS_def2) + then obtain N where hn: + "\n. n\N \ dist (f n) s < \/2" + using half_gt_zero[OF h] by blast + show "\N. \n\N. \m\N. dist (f n) (f m) < \" + proof(safe intro!: exI[where x=N]) + fix n m + assume hnm:"N \ n" "N \ m" + have "dist (f n) (f m) \ dist (f n) s + dist s (f m)" + using convergent_inS_dest1[OF assms] hs + by(auto intro!: dist_tr) + also have "... = dist (f n) s + dist (f m) s" + by(simp add: dist_sym[of s]) + also have "... < \" + using hn[OF hnm(1)] hn[OF hnm(2)] by auto + finally show "dist (f n) (f m) < \" . + qed +next + show "\x. f x \ S" + using assms[simplified convergent_inS_def converge_to_inS_def] + by auto +qed + +corollary Cauchy_inS_const: "a \ S \ Cauchy_inS (\n. a)" + by(auto intro!: Cauchy_if_convergent_inS convergent_inS_const) + +lemma converge_if_Cauchy_and_subconverge: + assumes "strict_mono a" "converge_to_inS (f \ a) s" "Cauchy_inS f" + shows "converge_to_inS f s" + unfolding converge_to_inS_def2 +proof safe + fix \ + assume "(0 :: real) < \" + then have 1:"0 < \/2" by auto + then obtain N where hn:"\n. n \ N \ dist (f (a n)) s < \/2" + using assms(2) by(simp only: comp_def converge_to_inS_def2) metis + obtain N' where hn':"\n m. n \ N' \ m \ N' \ dist (f n) (f m) < \/2" + using assms(3) 1 by(simp only: Cauchy_inS_def) metis + show "\N. \n\N. dist (f n) s < \" + proof(safe intro!: exI[where x="max N N'"]) + fix n + assume "max N N' \ n" + then have "N \ n" "N' \ n" by auto + show "dist (f n) s < \" + using add_strict_mono[OF hn'[OF \N' \ n\ order_trans[OF \N' \ n\ seq_suble[OF assms(1),of n]]] hn[OF \N \ n\]] assms(2) + by(auto simp: converge_to_inS_def intro!: order.strict_trans1[OF dist_tr[OF Cauchy_inS_dest1[OF assms(3),of n] Cauchy_inS_dest1[OF assms(3),of "a n"],of s],of \]) + qed +qed(auto simp: Cauchy_inS_dest1[OF assms(3)] assms(2)[simplified converge_to_inS_def]) + +lemma subCauchy_Cahcuy: + assumes "Cauchy_inS xn" "strict_mono a" + shows "Cauchy_inS (xn \ a)" + unfolding Cauchy_inS_def +proof safe + show "\x. (xn \ a) x \ S" + using assms(1) by(simp add: Cauchy_inS_dest1) +next + fix \ + assume "(0 :: real) < \" + then obtain N where "\n m. n \ N \ m \ N \ dist (xn n) (xn m) < \" + using assms(1) by(auto simp: Cauchy_inS_def) metis + thus "\N. \n\N. \m\N. dist ((xn \ a) n) ((xn \ a) m) < \" + by(auto intro!: exI[where x=N] dest: order_trans[OF seq_suble[OF assms(2)] strict_mono_leD[OF assms(2)]]) +qed + +corollary Cauchy_inS_ignore_initial: + assumes "Cauchy_inS xn" + shows "Cauchy_inS (\n. xn (n + k))" + using subCauchy_Cahcuy[OF assms,of "\n. n + k"] + by(auto simp: comp_def strict_monoI) + +(* TODO: offset *) + +lemma Cauchy_inS_dist_Cauchy: + assumes "Cauchy_inS xn" "Cauchy_inS yn" + shows "Cauchy (\n. dist (xn n) (yn n))" + unfolding metric_space_class.Cauchy_altdef2 dist_real_def +proof safe + have h:"\n. xn n \ S" "\n. yn n \ S" + using assms by(auto simp: Cauchy_inS_dest1) + fix e :: real + assume e:"0 < e" + with assms obtain N1 N2 where N: "\n m. n \ N1 \ m \ N1 \ dist (xn n) (xn m) < e / 2" "\n m. n \ N2 \ m \ N2 \ dist (yn n) (yn m) < e / 2" + by (metis Cauchy_inS_def zero_less_divide_iff zero_less_numeral) + define N where "N \ max N1 N2" + then have N': "N \ N1" "N \ N2" by auto + show "\N. \n\N. \dist (xn n) (yn n) - dist (xn N) (yn N)\ < e" + proof(safe intro!: exI[where x=N]) + fix n + assume n:"N \ n" + have "dist (xn n) (yn n) \ dist (xn n) (xn N) + dist (xn N) (yn N) + dist (yn N) (yn n)" + "dist (xn N) (yn N) \ dist (xn N) (xn n) + dist (xn n) (yn n) + dist (yn n) (yn N)" + using dist_tr[OF h(1)[of n] h(1)[of N] h(2)[of n]] dist_tr[OF h(1)[of N] h(2)[of N] h(2)[of n]] + dist_tr[OF h(1)[of N] h(2)[of n] h(2)[of N]] dist_tr[OF h(1)[of N] h(1)[of n] h(2)[of n]] by auto + thus "\dist (xn n) (yn n) - dist (xn N) (yn N)\ < e" + using N(1)[OF N'(1) order.trans[OF N'(1) n]] N(2)[OF N'(2) order.trans[OF N'(2) n]] N(1)[OF order.trans[OF N'(1) n] N'(1)] N(2)[OF order.trans[OF N'(2) n] N'(2)] + by auto + qed +qed + +corollary Cauchy_inS_dist_convergent: + assumes "Cauchy_inS xn" "Cauchy_inS yn" + shows "convergent (\n. dist (xn n) (yn n))" + using Cauchy_inS_dist_Cauchy[OF assms] Cauchy_convergent_iff by blast + +text \\<^url>\https://people.bath.ac.uk/mw2319/ma30252/sec-dense.html.\\ +abbreviation "dense_set \ dense_of mtopology" + +lemma dense_set_def: + "dense_set U \ U \ S \ (\x\S. \\>0. open_ball x \ \ U \ {})" +proof + assume h:" U \ S \(\x\S. \\>0. open_ball x \ \ U \ {})" + show "dense_of mtopology U" + proof(rule dense_ofI) + fix V + assume h':"openin mtopology V" "V \ {}" + then obtain x where 1:"x \ V" by auto + then obtain \ where 2:"\>0" "open_ball x \ \ V" + using h' mtopology_openin_iff[of V] by blast + have "open_ball x \ \ U \ {}" + using h 1 2 openin_subset[OF h'(1), simplified mtopology_topspace] + by auto + thus "U \ V \ {}" using 2 by auto + next + show "U \ topspace mtopology" + using h mtopology_topspace by auto + qed +next + assume h:"dense_of mtopology U" + have "\x\S. \\>0. open_ball x \ \ U \ {}" + proof safe + fix x \ + assume "x \ S" "(0 :: real) < \" "open_ball x \ \ U = {}" + then have "open_ball x \ \ {}" "openin mtopology (open_ball x \)" + using open_ball_ina[of x \] mtopology_open_ball_in[of x \] + by blast+ + thus False + using h \open_ball x \ \ U = {}\ by(auto simp: dense_of_def) + qed + thus "U \ S \ (\x\S. \\>0. open_ball x \ \ U \ {})" + using h mtopology_topspace by(auto simp: dense_of_def) +qed + +corollary dense_set_balls_cover: + assumes "dense_set U" and "e > 0" + shows "(\u\U. open_ball u e) = S" + using assms open_ball_subset_ofS by(auto simp: dense_set_def) (meson Int_emptyI open_ball_inverse) + +lemma dense_set_empty_iff: "dense_set {} \ S = {}" + by(auto simp: dense_set_def ) (use zero_less_one in blast) + +lemma dense_set_S: "dense_set S" + using open_ball_ina dense_set_def by blast + +lemma dense_set_def2: + "dense_set U \ U \ S \ (\x\S. \\>0.\y\U. dist x y < \)" +proof + assume h: "dense_set U" + show "U \ S \ (\x\S. \\>0. \y\U. dist x y < \)" + proof safe + fix x \ + assume hxe: "x \ S" "(0 :: real) < \" + then obtain z where + "z \ open_ball x \ \ U" + using h by(fastforce simp: dense_set_def) + thus "\y\U. dist x y < \" + by(auto intro!: bexI[where x=z] simp: open_ball_def hxe) + qed(use h[simplified dense_set_def] in auto) +next + assume h:"U \ S \ (\x\S. \\>0. \y\U. dist x y < \)" + show "dense_set U" + unfolding dense_set_def + proof safe + fix x \ + assume hxe: "x \ S" "(0 :: real) < \" "open_ball x \ \ U = {}" + then obtain y where + "y \ U" "y \ S" "dist x y < \" + using h by blast + hence "y \ open_ball x \ \ U" + by(auto simp: open_ball_def hxe) + thus False + using hxe(3) by auto + qed(use h in auto) +qed + +lemma dense_set_def2': + "dense_set U \ U \ S \ (\x\S. \f\UNIV \ U. converge_to_inS f x)" + unfolding dense_set_def +proof + show "U \ S \ (\x\S. \\>0. open_ball x \ \ U \ {}) \ U \ S \ (\x\S. \f\UNIV \ U. converge_to_inS f x)" + proof safe + fix x + assume h: "U \ S" "\x\S. \\>0. open_ball x \ \ U \ {}" "x \ S" + then have "\n::nat. open_ball x (1 / (real n + 1)) \ U \ {}" + by auto + hence "\n. \k. k \ open_ball x (1 / (real n + 1)) \ U" by auto + hence "\a. \n. a n \ open_ball x (1 / (real n + 1)) \ U" by(rule choice) + then obtain a where hf: "\n :: nat. a n \ open_ball x (1 / (real n + 1)) \ U" + by auto + show "\f\UNIV \ U. converge_to_inS f x" + unfolding converge_to_inS_def2' + proof(safe intro!: bexI[where x=a]) + fix \ :: real + assume he:"0 < \" + then obtain N where hn: "1 / \ < real N" + using reals_Archimedean2 by blast + have hn': "0 < real N" + by(rule ccontr) (use hn he in fastforce) + hence "1 / real N < \" + using he hn by (metis divide_less_eq mult.commute) + hence hn'':"1 / (real N + 1) < \" + using hn' by(auto intro!: order.strict_trans[OF linordered_field_class.divide_strict_left_mono[of "real N" "real N + 1" 1]]) + show "\N. \n\N. a n \ open_ball x \" + proof(safe intro!: exI[where x="N"]) + fix n + assume "N \ n" + then have 1:"1 / (real n + 1) \ 1 / (real N + 1)" + using hn' by(auto intro!: linordered_field_class.divide_left_mono) + show "a n \ open_ball x \" + using open_ball_le[OF 1,of x] open_ball_le[OF order.strict_implies_order[OF hn''],of x] hf[of n] + by auto + qed + next + show "\x. a x \ S" "x \ S" "\x. a x \ U" + using h(1,3) hf by auto + qed + qed +next + assume h:"U \ S \ (\x\S. \f\UNIV \ U. converge_to_inS f x)" + have "\x\S. \\>0. open_ball x \ \ U \ {}" + proof safe + fix x \ + assume hxe:"x \ S" "(0 :: real) < \" "open_ball x \ \ U = {}" + then obtain f N where + "f\UNIV \ U" "\n\N :: nat. f n \ open_ball x \" + using h[simplified converge_to_inS_def2'] by blast + hence "f N \ open_ball x \ \ U" + by auto + thus False using hxe by auto + qed + thus "U \ S \ (\x\S. \\>0. open_ball x \ \ U \ {})" + using h by auto +qed + +lemma dense_set_infinite: + assumes "infinite S" "dense_set U" + shows "infinite U" +proof + assume finu:"finite U" + with assms(1) obtain x where x:"x \ S" "x \ U" + by (meson finite_subset subset_iff) + define e where "e \ Min {dist x y |y. y \ U}" + have nen: "{dist x y |y. y \ U} \ {}" + using dense_set_empty_iff assms by auto + have fin: "finite {dist x y |y. y \ U}" + using finu by auto + have epos: "0 < e" + unfolding Min_gr_iff[OF fin nen] e_def + proof safe + fix y + assume "y \ U" + then have "y \ S" "x \ y" + using assms(2) x(2) by(auto simp: dense_set_def) + thus "0 < dist x y" + using dist_0[OF x(1),of y] dist_geq0[of x y] by auto + qed + then obtain y where y:"y\U" "dist x y < e" + using assms(2) x(1) by(fastforce simp: dense_set_def2) + thus False + using Min_le[OF fin,of "dist x y"] by(auto simp: e_def) +qed + +lemma mtopology_Hausdorff: "Hausdorff_space mtopology" + unfolding Hausdorff_space_def +proof safe + fix x y + assume "x \ topspace mtopology" "y \ topspace mtopology" "x \ y" + then have [simp]:"x \ S" "y \ S" + using mtopology_topspace by auto + with \x \ y\ have 1:"dist x y > 0" + using dist_0[of x y] dist_geq0[of x y] by auto + show "\U V. openin mtopology U \ openin mtopology V \ x \ U \ y \ V \ disjnt U V" + proof(rule exI[where x="open_ball x (dist x y/2)"]) + show "\V. openin mtopology (open_ball x (dist x y / 2)) \ openin mtopology V \ x \ open_ball x (dist x y / 2) \ y \ V \ disjnt (open_ball x (dist x y / 2)) V" + proof(safe intro!: exI[where x="open_ball y (dist x y/2)"]) + show "disjnt (open_ball x (dist x y / 2)) (open_ball y (dist x y / 2))" + unfolding disjnt_iff + proof safe + fix z + assume h:"z \ open_ball x (dist x y / 2)" "z \ open_ball y (dist x y / 2)" + show False + using dist_tr[OF \x \ S\ open_ballD'(1)[OF h(1)] \y \ S\] open_ballD[OF h(1)] open_ballD[OF h(2)] + by (simp add: dist_sym) + qed + qed(auto intro!: mtopology_open_ball_in 1 open_ball_ina) + qed +qed + +text \ Diameter\ +definition diam :: "'a set \ ennreal" where +"diam A \ \ {ennreal (dist x y) | x y. x \ A \ S \ y \ A \ S}" + +lemma diam_empty[simp]: + "diam {} = 0" + by(simp add: diam_def bot_ennreal) + +lemma diam_def2: + assumes "A \ S" + shows "diam A = \ {ennreal (dist x y) | x y. x \ A \ y \ A}" + using assms by(auto simp: diam_def) (meson subset_eq) + +lemma diam_subset: + assumes "A \ B" + shows "diam A \ diam B" + unfolding diam_def using assms by(auto intro!: Sup_subset_mono) + +lemma diam_cball_leq: "diam (closed_ball a \) \ ennreal (2 * \)" + unfolding Sup_le_iff diam_def +proof safe + fix x y + assume h:"x \ closed_ball a \" "y \ closed_ball a \" "x \ S" "y \ S" + have "dist x y \ 2 * \" + using dist_tr[OF h(3) closed_ballD'(2)[OF h(1)] h(4)] closed_ballD[OF h(1),simplified dist_sym[of a x]] closed_ballD[OF h(2)] + by auto + thus "ennreal (dist x y) \ ennreal (2 * \)" + using dist_geq0[of x y] ennreal_leI[of _ "2*\"] by simp +qed + +lemma diam_ball_leq: + "diam (open_ball a \) \ ennreal (2 * \)" + using diam_subset[OF open_ball_closed_ball[of a \]] diam_cball_leq[of a \] + by auto + +lemma diam_is_sup: + assumes "x \ A \ S" "y \ A \ S" + shows "dist x y \ diam A" + using assms by(auto simp: diam_def intro!:Sup_upper) + +lemma diam_is_sup': + assumes "x \ A \ S" "y \ A \ S" "diam A \ ennreal r" "r \ 0" + shows "dist x y \ r" + using order.trans[OF diam_is_sup[OF assms(1,2)] assms(3)] assms(4) by simp + +lemma diam_le: + assumes "\x y. x \ A \ y \ A \ dist x y \ r" + shows "diam A \ r" + using assms by(auto simp: diam_def Sup_le_iff ennreal_leI) + +lemma diam_eq_closure: "diam (mtopology closure_of A) = diam A" +proof(rule antisym) + show "diam A \ diam (mtopology closure_of A)" + by(auto intro!: Sup_subset_mono simp: diam_def) (metis in_closure_of mtopology_topspace) +next + have "{ennreal (dist x y) |x y. x \ A \ S \ y \ A \ S} = ennreal ` {dist x y |x y. x \ A \ S \ y \ A \ S}" + by auto + also have "diam (mtopology closure_of A) \ \ ..." + unfolding le_Sup_iff_less + proof safe + fix r + assume "r < diam (mtopology closure_of A)" + then obtain x y where xy:"x \ mtopology closure_of A" "x \ S" "y \ mtopology closure_of A" "y \ S" "r < ennreal (dist x y)" + by(auto simp: diam_def less_Sup_iff) + hence "r < \" + using dual_order.strict_trans ennreal_less_top by blast + define e where "e \ (dist x y - enn2real r)/2" + have "e > 0" + using xy(5) \r < \\ by(simp add: e_def) + then obtain x' y' where xy':"x' \ open_ball x e" "x'\ A" "y' \ open_ball y e" "y'\ A" + using xy by(fastforce simp: closure_of_mtopology) + show "\i\{dist x y |x y. x \ A \ S \ y \ A \ S}. r \ ennreal i" + proof(safe intro!: bexI[where x="dist x' y'"]) + have "dist x y \ dist x x' + dist x' y' + dist y y'" + using dist_tr[OF xy(2) open_ballD'(1)[OF xy'(1)] xy(4)] dist_tr[OF open_ballD'(1)[OF xy'(1)] open_ballD'(1)[OF xy'(3)] xy(4)] + by(simp add: dist_sym) + also have "... < dist x y - enn2real r + dist x' y'" + using open_ballD[OF xy'(1)] open_ballD[OF xy'(3)] + by(simp add: e_def) + finally have "enn2real r < dist x' y'" by simp + thus "r \ ennreal (dist x' y')" + by (simp add: \r < \\) + qed(use open_ballD'(1)[OF xy'(1)] open_ballD'(1)[OF xy'(3)] xy'(2,4) in auto) + qed + finally show "diam (mtopology closure_of A) \ diam A" + by(simp add: diam_def) +qed + +definition bounded_set :: "'a set \ bool" where +"bounded_set A \ diam A < \" + +lemma bounded_set_def2': "bounded_set A \ (\e. \x\A\S. \y\A\S. dist x y < e)" +proof + assume "bounded_set A" + consider "A \ S = {}" | "A \ S \ {}" by auto + then show " \e. \x\A \ S. \y\A \ S. dist x y < e" + proof cases + case h:2 + then have 1:"{dist x y |x y. x \ A \ S \ y \ A \ S} \ {}" by auto + have eq:"{ennreal (dist x y) | x y. x \ A \ S \ y \ A \ S} = ennreal ` {dist x y | x y. x \ A \ S \ y \ A \ S}" + by auto + hence 2:"diam A = \ (ennreal ` {dist x y | x y. x \ A \ S \ y \ A \ S})" + by(simp add: diam_def) + obtain x y where hxy: + "x \ A \ S" "y \ A \ S" "diam A < ennreal (dist x y) + ennreal 1" + using SUP_approx_ennreal[OF _ 1 2,of 1] \bounded_set A\ + by(fastforce simp: bounded_set_def) + hence "diam A < ennreal (dist x y + 1)" + using dist_geq0 by simp + from SUP_lessD[OF this[simplified 2]] + have "\w z. w \ A \ S \ z \ A \ S \ ennreal (dist w z) < ennreal (dist x y + 1)" + by blast + thus "\e. \x\A \ S. \y\A \ S. dist x y < e" + by(auto intro!: exI[where x="dist x y + 1"] simp: ennreal_less_iff[OF dist_geq0]) + qed simp +next + assume "\e. \x\A\S. \y\A\S. dist x y < e" + then obtain e where he: "\x y. x \ A \ S \ y \ A \ S \ dist x y < e" + by auto + hence "\z. z \ {ennreal (dist x y) | x y. x \ A \ S \ y \ A \ S} \ z < ennreal e" + using ennreal_less_iff[OF dist_geq0] by auto + hence "\ {ennreal (dist x y) | x y. x \ A \ S \ y \ A \ S} \ ennreal e" + by (meson Sup_least order_less_le) + thus "bounded_set A" + by(simp add: bounded_set_def diam_def order_le_less_trans[OF _ ennreal_less_top]) +qed + +lemma bounded_set_def2: + assumes "A \ S" + shows "bounded_set A \ (\e. \x\A. \y\A. dist x y < e)" + using assms by(fastforce simp: bounded_set_def2') + +lemma bounded_set_def3': + assumes "S \ {}" + shows "bounded_set A \ (\e. \x\S. \y\A\S. dist x y < e)" + unfolding bounded_set_def2' +proof + assume h:"\e. \x\A \ S. \y\A \ S. dist x y < e" + obtain s where [simp]:"s \ S" using assms by auto + consider "A \ S = {}" | "A \ S \ {}" by auto + then show "\e. \x\S. \y\A \ S. dist x y < e" + proof cases + case 1 + then show ?thesis + by(auto intro!: exI[where x=0] exI[where x=s]) + next + case 2 + then obtain sa where [simp]:"sa \ A" "sa \ S" by auto + obtain e where "\x\A \ S. \y\A \ S. dist x y < e" + using h by auto + then show ?thesis + by(auto intro!: exI[where x=e] bexI[where x=sa]) + qed +next + assume "\e. \x\S. \y\A \ S. dist x y < e" + then obtain e a where + [simp]:"a \ S" and hea:"\y. y \ A \ y \ S \ dist a y < e" by auto + show "\e. \x\A \ S. \y\A \ S. dist x y < e" + proof(safe intro!: exI[where x="2*e"]) + fix x y + assume [simp]:"x \ A" "x \ S" "y \ A" "y \ S" + show "dist x y < 2 * e" + using dist_tr[of x a y] hea[of x] hea[of y] + by(simp add: dist_sym[of x a]) + qed +qed + +lemma bounded_set_def4': + "bounded_set A \ (\x e. A \ S \ open_ball x e)" +proof + assume h:"bounded_set A" + consider "A \ S = {}" | "A \ S \ {}" by auto + then show "\x e. A \ S \ open_ball x e" + proof cases + case 1 + then show ?thesis by auto + next + case 2 + then have "\e. \x\S. \y\A\S. dist x y < e" + using bounded_set_def3' h by blast + then obtain e x where + [simp]: "x \ S" and hex: "\y. y \ A \ y \ S \ dist x y < e" + by auto + thus ?thesis + by(auto intro!: exI[where x=x] exI[where x=e] simp:open_ball_def) + qed +next + assume "\x e. A \ S \ open_ball x e" + then obtain a e where hxe:"A \ S \ open_ball a e" by auto + show "bounded_set A" + unfolding bounded_set_def2' + proof(safe intro!: exI[where x="2*e"]) + fix x y + assume [simp]:"x \ A" "x \ S" "y \ A" "y \ S" + then have "x \ open_ball a e" "y \ open_ball a e" + using hxe by auto + hence "dist a x < e" "dist a y < e" "a \ S" + by(auto dest: open_ballD open_ballD') + thus "dist x y < 2 * e" + using dist_tr[of x a y] by(simp add: dist_sym[of x a]) + qed +qed + +lemma bounded_set_def4: + assumes "A \ S" + shows "bounded_set A \ (\x e. A \ open_ball x e)" + using bounded_set_def4'[of A] assms by blast + + +text \ Distance between a point and a set. \ +definition dist_set :: "'a set \ 'a \ real" where +"dist_set A \ (\x. if A = {} then 0 else Inf {dist x y |y. y \ A})" + +lemma dist_set_geq0: + "dist_set A x \ 0" +proof - + have "{dist x y |y. y \ A} = dist x ` A" by auto + thus ?thesis + using dist_geq0[of x] by(auto simp: dist_set_def intro!: cINF_greatest[of _ _ "dist x"]) +qed + +lemma dist_set_bdd_below[simp]: + "bdd_below {dist x y |y. y \ A}" + by(auto simp: bdd_below_def dist_geq0 intro!: exI[where x=0]) + +lemma dist_set_singleton[simp]: + "dist_set {y} x = dist x y" + by(auto simp: dist_set_def) + +lemma dist_set_singleton'[simp]: + "dist_set {y} = (\x. dist x y)" + by auto + +lemma dist_set_empty[simp]: + "dist_set {} x = 0" + by(simp add: dist_set_def) + +lemma dist_set_nsubset0[simp]: + assumes "\ (A \ S)" + shows "dist_set A x = 0" +proof - + obtain a where "a \ A" "a \ S" + using assms by auto + hence "A \ {}" "0 \ {dist x y |y. y \ A}" + using dist_notin'[of a x] by auto + thus ?thesis + using \A \ {}\ dist_set_geq0[of A x] cInf_lower[OF \0 \ {dist x y |y. y \ A}\] + by(auto simp: dist_set_def) +qed + +lemma dist_set_notin[simp]: + assumes "x \ S" + shows "dist_set A x = 0" +proof - + have "A \ {} \ {dist x y |y. y \ A} = {0}" + using dist_notin[OF \x \ S\] by auto + thus ?thesis + by(simp add: dist_set_def) +qed + +lemma dist_set_inA: + assumes "x \ A" + shows "dist_set A x = 0" +proof(cases "A \ S") + case h:True + hence "A \ {}" "0 \ {dist x y |y. y \ A}" + using dist_0[of x x] assms by force+ + thus ?thesis + using cInf_lower[OF \0 \ {dist x y |y. y \ A}\] dist_set_geq0[of A x] + by(auto simp: dist_set_def) +qed (simp add: dist_geq0) + +lemma dist_set_nzeroD: + assumes "dist_set A x \ 0" + shows "A \ S" "x \ A" + by(rule ccontr, use assms dist_set_inA in auto) + +lemma dist_set_antimono: + assumes "A \ B" "A \ {}" + shows "dist_set B x \ dist_set A x" +proof(cases "B = {}") + case h:False + with assms have "{dist x y |y. y \ B} \ {}" "{dist x y |y. y \ A} \ {dist x y |y. y \ B}" + by auto + thus ?thesis + by(simp add: dist_set_def cInf_superset_mono assms(2)) +qed(use assms in simp) + +lemma dist_set_bounded: + assumes "\y. y \ A \ dist x y < K" "K > 0" + shows "dist_set A x < K" +proof(cases "A = {}") + case True + then show ?thesis + by(simp add: assms) +next + case 1:False + then have 2:"{dist x y |y. y \ A} \ {}" by auto + show ?thesis + using assms by (auto simp add: dist_set_def cInf_lessD[OF 2] cInf_less_iff[OF 2]) +qed + +lemma dist_set_tr: + assumes "x \ S" "y \ S" + shows "dist_set A x \ dist x y + dist_set A y" +proof(cases "A \ S") + case h:True + consider "A = {}" | "A \ {}" by auto + then show ?thesis + proof cases + case 1 + then show ?thesis + by(simp add: dist_set_def dist_geq0) + next + case 2 + have "dist_set A x \ Inf {dist x y + dist y a |a. a\A}" + proof - + have "\ {dist x y |y. y \ A} \ \ {dist x y + dist y a |a. a \ A}" + proof(rule cInf_mono) + fix b + assume "b \ {dist x y + dist y a |a. a \ A}" + then obtain a where "a \ A" "b = dist x y + dist y a" + by auto + thus "\a\{dist x y |y. y \ A}. a \ b" + using h assms by(auto intro!: exI[where x="dist x a"] dist_tr) + qed(simp_all add: 2) + thus ?thesis + by(simp add: dist_set_def 2) + qed + also have "... = dist x y + Inf {dist y a |a. a\A}" + proof - + have "ereal (Inf {dist x y + dist y a |a. a\A}) = ereal (dist x y + Inf {dist y a |a. a\A})" + (is "?lhs = ?rhs") + proof - + have "?lhs = Inf (ereal ` {(dist x y + dist y a) |a. a\A})" + using dist_geq0 by(auto intro!: ereal_Inf' bdd_belowI[where m=0] simp: 2) + also have "... = Inf {ereal (dist x y + dist y a) |a. a\A}" + proof - + have "ereal ` {(dist x y + dist y a) |a. a\A} = {ereal (dist x y + dist y a) |a. a\A}" + by auto + thus ?thesis by simp + qed + also have "... = (\a\A. ereal (dist x y) + ereal (dist y a))" + by (simp add: Setcompr_eq_image) + also have "... = ereal (dist x y) + (\a\A. ereal (dist y a))" + by(rule INF_ereal_add_right) (use 2 dist_geq0 in auto) + also have "... = ereal (dist x y) + (\ (ereal ` {dist y a | a. a \ A}))" + by (simp add: Setcompr_eq_image image_image) + also have "... = ereal (dist x y) + ereal (Inf {dist y a |a. a\A})" + proof - + have "ereal (Inf {dist y a |a. a\A}) = (\ (ereal ` {dist y a | a. a \ A}))" + using dist_geq0 by(auto intro!: ereal_Inf' simp: 2) + thus ?thesis by simp + qed + also have "... = ?rhs" by simp + finally show ?thesis . + qed + thus ?thesis by simp + qed + also have "... = dist x y + dist_set A y" + by(simp add: 2 dist_set_def) + finally show ?thesis . + qed +qed (simp add: dist_geq0) + +lemma dist_set_abs_le: + assumes "x \ S" "y \ S" + shows "\dist_set A x - dist_set A y\ \ dist x y" + using dist_set_tr[OF assms,of A] dist_set_tr[OF assms(2,1),of A,simplified dist_sym[of y x]] + by auto + +lemma dist_set_inA_le: + assumes "y \ A" + shows "dist_set A x \ dist x y" +proof - + consider "x \ S \ y \ S" | "x \ S \ y \ S" by auto + thus ?thesis + proof cases + case 1 + have "y \ S \ \ (A \ S)" + using assms by auto + with 1 dist_geq0 show ?thesis + by auto + next + case 2 + with dist_set_tr[of x y A] dist_set_inA[OF assms] + show ?thesis by simp + qed +qed + +lemma dist_set_ball_open: + "openin mtopology {x\S. dist_set A x < \}" + unfolding mtopology_openin_iff +proof safe + fix x + assume h:"x \ S" "dist_set A x < \" + show "\\'>0. open_ball x \' \ {x \ S. dist_set A x < \}" + proof(safe intro!: exI[where x="\ - dist_set A x"]) + fix y + assume h':"y \ open_ball x (\ - dist_set A x)" + have "dist_set A y \ dist x y + dist_set A x" + by(rule dist_set_tr[OF open_ballD'(1)[OF h'] h(1),simplified dist_sym[of y x]]) + also have "... < \" + using open_ballD[OF h'] by auto + finally show "dist_set A y < \" . + qed(use h open_ballD'(1) in auto) +qed + +lemma dist_set_ball_empty: + assumes "A \ {}" "A \ S" "e > 0" "x \ S" "open_ball x e \ A = {}" + shows "dist_set A x \ e" + using assms by(auto simp: dist_set_def assms(1) le_cInf_iff intro!: open_ball_nin_le[OF assms(4,3)]) + +lemma dist_set_closed_ge0: + assumes "closedin mtopology A" "A \ {}" "x \ S" "x \ A" + shows "dist_set A x > 0" +proof - + have a:"A \ S" "openin mtopology (S - A)" + using closedin_subset[OF assms(1)] assms(1) + by(auto simp: closedin_def mtopology_topspace) + with assms(3,4) obtain e where e: "e > 0" "open_ball x e \ S - A" + by(auto simp: mtopology_openin_iff) (meson Diff_iff) + thus ?thesis + by(auto intro!: order.strict_trans2[OF e(1) dist_set_ball_empty[OF assms(2) a(1) e(1) assms(3)]]) +qed + +lemma g_delta_of_closed: + assumes "closedin mtopology M" + shows "g_delta_of mtopology M" +proof(cases "M = {}") + case True + then show ?thesis by simp +next + case M_ne:False + have "M \ S" + using assms mtopology_topspace by (simp add: closedin_def) + define U where "U \ (\n. {x\S. dist_set M x < 1 / real n})" + define \ where "\ \ {U n| n. n > 0}" + have mun:"M \ U n" if "n > 0" for n + using dist_set_inA[of _ M] that \M \ S\ by(auto simp: U_def) + show ?thesis + proof(rule g_delta_ofI[of "\"]) + show "\ \ {}" + by(auto simp: \_def) + next + have "\ = U ` {0<..}" by(auto simp: \_def) + thus "countable \" by simp + next + fix b + assume "b \ \" + then show "openin mtopology b" + using dist_set_ball_open by(auto simp: \_def U_def) + next + show "M = \ \" + proof(standard;standard) + fix x + assume "x \ M" + with mun + show "x \ \ \" + by(auto simp: \_def) + next + fix x + assume "x \ \ \" + then have "Inf {dist x m|m. m\M} < 1 / real n" if "n > 0" for n + using that by(auto simp: \_def U_def M_ne dist_set_def) + hence 1:"Inf {dist x m|m. m\M} < 1 / real (Suc n)" for n + by blast + have "\m\M. dist x m < 1 / real (Suc n)" for n + using 1[of n] cInf_less_iff[of "{dist x m |m. m \ M}" "1 / real (Suc n)"] M_ne + by auto + then obtain m where hm: "\n. m n \ M" "\n. dist x (m n) < 1 / real (Suc n)" + by metis + hence "m \ UNIV \ M" by auto + have "converge_to_inS m x" + unfolding converge_to_inS_def2 + proof safe + show "\x. m x \ S" "x \ S" + using \x \ \ \\ \m \ UNIV \ M\ \M \ S\ + by(auto simp: \_def U_def) + next + fix \ + assume "(0 :: real) < \" + then obtain N where hN: "1 / real (Suc N) < \" + using nat_approx_posE by blast + show "\N. \n\N. dist (m n) x < \" + proof(safe intro!: exI[where x=N]) + fix n + assume "N \ n" + then have "1 / real (Suc n) \ 1 / real (Suc N)" + by (simp add: frac_le) + from order.strict_trans1[OF this hN] hm(2)[of n] + show "dist (m n) x < \" + by(simp add: dist_sym[of x]) + qed + qed + thus "x \ M" + using assms[simplified mtopology_closedin_iff] \m \ UNIV \ M\ + by simp + qed + qed +qed + +text \ Oscillation\ +definition osc_on :: "['b set, 'b topology, 'b \ 'a, 'b] \ ennreal" where +"osc_on A X f \ (\y. \ {diam (f ` (A \ U)) |U. y \ U \ openin X U})" + +abbreviation "osc X \ osc_on (topspace X) X" + +lemma osc_def: "osc X f = (\y. \ {diam (f ` U) |U. y \ U \ openin X U})" + by(standard,auto simp: osc_on_def) (metis (no_types, opaque_lifting) inf.absorb2 openin_subset) + +lemma osc_on_less_iff: + "osc_on A X f x < t \ (\v. x \ v \ openin X v \ diam (f ` (A \ v)) < t)" + by(auto simp add: osc_on_def Inf_less_iff) + +lemma osc_less_iff: + "osc X f x < t \ (\v. x \ v \ openin X v \ diam (f ` v) < t)" + by(auto simp add: osc_def Inf_less_iff) + +definition sequentially_compact :: bool where +"sequentially_compact \ (\xn\sequence. \a. strict_mono a \ convergent_inS (xn \ a))" + +definition eps_net_on :: "'a set \ real \ 'a set \ bool" where +"eps_net_on B \ A \ \ > 0 \ finite A \ A \ S \ B \ (\a\A. open_ball a \)" + +abbreviation "eps_net \ eps_net_on S" + +lemma eps_net_def: "eps_net \ A \ \ > 0 \ finite A \ A \ S \ S = \ ((\a. open_ball a \) ` A)" + using open_ball_subset_ofS by(auto simp: eps_net_on_def) + +lemma eps_net_onD: + assumes "eps_net_on B e A" + shows "e > 0" "finite A" "A \ S" "B \ (\a\A. open_ball a e)" "B \ S" + using assms open_ball_subset_ofS by(auto simp: eps_net_on_def) blast + +lemma eps_netD: + assumes "eps_net \ A" + shows "\ > 0" "finite A" "A \ S" "S = \ ((\a. open_ball a \) ` A)" + using assms by(auto simp: eps_net_def) + +lemma eps_net_le: + assumes "eps_net e A" "e \ e'" + shows "eps_net e' A" + using assms open_ball_le[OF assms(2)] open_ballD'(1) + by(auto simp: eps_net_def) blast + +definition totally_bounded_on :: "'a set \ bool" where +"totally_bounded_on B \ (\e>0. \A. eps_net_on B e A)" + +abbreviation "totally_boundedS \ totally_bounded_on S" + +lemma totally_boundedS_def: "totally_boundedS \ (\e>0. \A. eps_net e A)" + by(auto simp: totally_bounded_on_def) + +lemma totally_bounded_onD_sub: + assumes "totally_bounded_on B" + shows "B \ S" + by (meson assms eps_net_onD(5) gt_ex totally_bounded_on_def) + +lemma totally_bounded_onD: + assumes "totally_bounded_on B" "e > 0" + obtains A where "finite A" "A \ S" "B \ (\a\A. open_ball a e)" + by (metis assms that eps_net_on_def totally_bounded_on_def) + +lemma totally_boundedSD: + assumes totally_boundedS "e > 0" + obtains A where "finite A" "A \ S" "S = (\a\A. open_ball a e)" + by (metis assms that eps_net_def totally_boundedS_def) + +lemma totally_bounded_on_iff: +"totally_bounded_on B \ B \ S \ (\xn\(UNIV :: nat set) \ B. \a. strict_mono a \ Cauchy_inS (xn \ a))" +proof safe + fix xn :: "nat \ 'a" + assume h:"totally_bounded_on B" "xn \ UNIV \ B" + then have h': "B \ S" + by (auto dest: totally_bounded_onD_sub) + have 1: "\b::nat \ nat. strict_mono b \ (\n m. dist (yn (b n)) (yn (b m)) < e)" if "yn \ UNIV \ B" "e > 0" for e yn + proof - + obtain A where A: "finite A" "A \ S" "B \ (\a\A. open_ball a (e/2))" + using totally_bounded_onD[OF h(1) half_gt_zero[OF \e > 0\]] by metis + have "\ (\a\A. finite {n. yn n \ open_ball a (e/2)})" + proof + assume "\a\A. finite {n. yn n \ open_ball a (e/2)}" + then have "finite (\a\A. {n. yn n \ open_ball a (e/2)})" + using A by auto + moreover have "UNIV = (\a\A. {n. yn n \ open_ball a (e/2)})" + using that(1) A(3) by auto + ultimately show False by simp + qed + then obtain a where a:"a \ A" "infinite {n. yn n \ open_ball a (e/2)}" + by auto + then obtain b where b:"strict_mono b" "\n::nat. yn (b n) \ open_ball a (e/2)" + using obtain_subsequence[of "\_ ynn. ynn \ open_ball a (e/2)" yn] by auto + show ?thesis + using a A by(auto intro!: exI[where x=b] b order.strict_trans1[OF dist_tr[OF open_ballD'(1)[OF b(2)] _ open_ballD'(1)[OF b(2)],of a] add_strict_mono[OF open_ballD[OF b(2),simplified dist_sym[of a]] open_ballD[OF b(2)]],simplified]) + qed + + define anm where "anm \ rec_nat (xn \ (SOME b::nat \ nat. strict_mono b \ (\n m. dist (xn (b n)) (xn (b m)) < 1))) (\n an. an \ (SOME b. strict_mono b \ (\l k. dist (an (b l)) (an (b k)) < 1 / Suc (Suc n))))" + have anm_Suc:"anm (Suc n) = anm n \ (SOME b. strict_mono b \ (\l k. dist (anm n (b l)) (anm n (b k)) < 1 / Suc (Suc n)))" for n + by(simp add: anm_def) + have anm1:"anm n \ UNIV \ B \ (\l k. dist (anm n l) (anm n k) < 1 / Suc n)" for n + proof(induction n) + case 0 + obtain b ::"nat \ nat" where b:"strict_mono b" "\l k. dist (xn (b l)) (xn (b k)) < 1" + using 1[OF h(2),of 1] by auto + show ?case + by(simp add: anm_def,rule someI2[where a=b]) (use b h(2) in auto) + next + case ih:(Suc n') + obtain b ::"nat \ nat" where b:"strict_mono b" "\l k. dist (anm n' (b l)) (anm n' (b k)) < 1 / real (Suc (Suc n'))" + using 1[of "anm n'" "1 / Suc (Suc n')"] ih by auto + show ?case + by(simp only: anm_Suc,rule someI2[where a=b]) (use ih b in auto) + qed + + define bnm :: "nat \ nat \ nat" where "bnm \ rec_nat (SOME b. strict_mono b \ anm 0 = xn \ b) (\n bn. SOME b. strict_mono b \ anm (Suc n) = anm n \ b)" + have bnm_Suc:"bnm (Suc n) = (SOME b. strict_mono b \ anm (Suc n) = anm n \ b)" for n + by(simp add: bnm_def) + have bnm0:"strict_mono (bnm 0) \ anm 0 = xn \ (bnm 0)" + proof - + have b0:"\b::nat \ nat. strict_mono b \ anm 0 = xn \ b" + proof - + obtain b ::"nat \ nat" where b:"strict_mono b" "\l k. dist (xn (b l)) (xn (b k)) < 1" + using 1[OF h(2),of 1] by auto + show ?thesis + by(simp add: anm_def,rule someI2[where a=b],auto simp: b) + qed + thus ?thesis + unfolding bnm_def by(simp,rule someI_ex) + qed + have bnm_S: "strict_mono (bnm (Suc n)) \ anm (Suc n) = anm n \ (bnm (Suc n))" for n + proof - + have bn:"\b::nat \ nat. strict_mono b \ anm (Suc m) = anm m \ b" for m + proof - + obtain b ::"nat \ nat" where b:"strict_mono b" "\l k. dist (anm m (b l)) (anm m (b k)) < 1 / real (Suc (Suc m))" + using 1[of "anm m" "1 / Suc (Suc m)"] anm1 by auto + show ?thesis + by(simp only: anm_Suc,rule someI2[where a=b]) (auto simp: b[simplified]) + qed + thus ?thesis + by(simp add: bnm_Suc, rule someI_ex) + qed + define bnm_r where "bnm_r \ rec_nat (bnm 0) (\n bn. bn \ (bnm (Suc n)))" + have bnm_r_Suc: "bnm_r (Suc n) = bnm_r n \ (bnm (Suc n))" for n + by(simp add: bnm_r_def) + have anm_bnm_r:"anm n = xn \ (bnm_r n)" for n + by(induction n,simp add: bnm0 bnm_r_def) (auto simp: bnm_S bnm_r_Suc) + have bnm_r_sm:"strict_mono (bnm_r n)" for n + by(induction n, simp add: bnm0 bnm_r_def) (insert bnm_S, auto simp: bnm_r_Suc strict_mono_def) + have bnm_r_Suc_le:"bnm_r n l \ bnm_r (Suc n) l" for l n + using bnm_S bnm_r_sm by(auto simp: bnm_r_Suc strict_mono_imp_increasing strict_mono_leD) + have sm:"strict_mono (\n. bnm_r n n)" + by(auto simp add: strict_mono_Suc_iff) (meson lessI order_le_less_trans strict_monoD bnm_r_sm bnm_r_Suc_le) + have bnm_r_de:"\l. bnm_r (n + k) = bnm_r n \ l" for n k + by(induction k) (auto simp: bnm_r_Suc) + show "\a::nat \ nat. strict_mono a \ Cauchy_inS (xn \ a)" + unfolding Cauchy_inS_def + proof(safe intro!: exI[where x="\n. bnm_r n n"] sm) + fix e :: real + assume "e > 0" + then obtain N where N:"1 / Suc N < e" + using nat_approx_posE by blast + show "\N. \n\N. \m\N. dist ((xn \ (\n. bnm_r n n)) n) ((xn \ (\n. bnm_r n n)) m) < e" + proof(safe intro!: exI[where x=N]) + fix n m + assume "N \ n" "N \ m" + then have "n = N + (n - N)" "m = N + (m - N)" by auto + then obtain l1 l2 where l:"bnm_r n = bnm_r N \ l1" "bnm_r m = bnm_r N \ l2" + by (metis bnm_r_de) + have "dist (xn (bnm_r n n)) (xn (bnm_r m m)) = dist (anm N (l1 n)) (anm N (l2 m))" + by(simp add: l anm_bnm_r) + also have "... < 1 / Suc N" + using anm1 by auto + finally show "dist ((xn \ (\n. bnm_r n n)) n) ((xn \ (\n. bnm_r n n)) m) < e" + using N by simp + qed + qed(use h h' in auto) +next + assume h:"\xn\(UNIV :: nat set) \ B. \a. strict_mono a \ Cauchy_inS (xn \ a)" "B \ S" + show "totally_bounded_on B" + proof(rule ccontr) + assume "\ totally_bounded_on B" + then obtain e where e:"e > 0" "\A. \ eps_net_on B e A" + by(auto simp: totally_bounded_on_def) + have A:"\ B \ (\a\A. open_ball a e)" if "finite A" for A + proof - + have [simp]:"(\a\A. open_ball a e) = (\a\A\ S. open_ball a e)" + using Collect_cong IntD1 IntI Sup_set_def UN_iff open_ballD'(2) by auto + have "finite (A \ S)" using that by auto + thus ?thesis + using e by(auto simp: eps_net_on_def) + qed + obtain a0 where a0:"a0 \ B" + using A by fastforce + define xnl where "xnl \ rec_nat [a0] (\n ln. (SOME x. x \ B \ x \ (\a\set ln. open_ball a e)) # ln)" + have xnl_Suc:"xnl (Suc n) = (SOME x. x \ B \ x \ (\a\set (xnl n). open_ball a e)) # xnl n" for n + by(simp add: xnl_def) + define xn where "xn = (\n. (xnl n) ! 0)" + have xn:"xn (Suc n) \ B \ xn (Suc n) \ (\a\set (xnl n). open_ball a e)" for n + proof - + have "\y. y \ B \ (\x\set (xnl n). y \ open_ball x e)" + using A[OF finite_set] by fastforce + thus ?thesis + by(simp add: xn_def xnl_Suc,rule someI_ex) + qed + have xn0:"xn 0 \ B" + by(auto simp: xnl_def xn_def a0) + with xn have xns:"xn \ UNIV \ B" + by auto (metis old.nat.exhaust) + have xnll:"length (xnl n) = Suc n" for n + by(induction n) (simp add: xnl_def, auto simp: xnl_Suc) + have xnin:"xn m \ set (xnl (m + k))" for m k + by(induction k) (auto simp: xn_def xnl_Suc xnll intro!: nth_mem) + obtain a where a:"strict_mono a" "Cauchy_inS (xn \ a)" + using h xns by auto + then obtain N where "\n m. n \ N \ m \ N \ dist (xn (a n)) (xn (a m)) < e" + using e Cauchy_inS_def by fastforce + hence e1:"dist (xn (a N)) (xn (a (Suc N))) < e" + by auto + have "xn (a (Suc N)) \ (\a\set (xnl (a (Suc N) - 1)). open_ball a e)" + by (metis a(1) diff_Suc_1 le_0_eq not0_implies_Suc strict_mono_less_eq xn zero_le) + moreover have "xn (a N) \ set (xnl (a (Suc N) - 1))" + using a(1)[simplified strict_mono_Suc_iff] xnin[of "a N" "a (Suc N) - a N - 1"] + by (simp add: Suc_leI) + ultimately have "xn (a (Suc N)) \ open_ball (xn (a N)) e" + by auto + from open_ball_nin_le[OF _ e(1) _ this] xns e1 h(2) + show False by auto + qed +qed(auto dest: totally_bounded_onD_sub) + +corollary totally_boundedS_iff: "totally_boundedS \ (\xn\sequence. \a. strict_mono a \ Cauchy_inS (xn \ a))" + by(auto simp: totally_bounded_on_iff) + +text \ Metric embedding\ +definition embed_dist_on :: "['b set, 'b \ 'a, 'b, 'b] \ real" where +"embed_dist_on B f a b \ (if a \ B \ b \ B then dist (f a) (f b) else 0)" + +context + fixes f B + assumes f: "f \ B \ S" "inj_on f B" +begin + +abbreviation "ed \ embed_dist_on B f" + +lemma embed_dist_dist: "metric_set B (embed_dist_on B f)" +proof + fix x y + assume "x \ B" "y \ B" + then show "x = y \ embed_dist_on B f x y = 0" + using inj_onD[OF f(2)] dist_0[of "f x" "f y"] f(1) + by(auto simp: embed_dist_on_def) +next + fix x y + show "embed_dist_on B f x y = embed_dist_on B f y x" + by(simp add: embed_dist_on_def dist_sym[of "f x" "f y"]) +next + fix x y z + assume "x \ B" "y \ B" "z \ B" + then show "embed_dist_on B f x z \ embed_dist_on B f x y + embed_dist_on B f y z" + using dist_tr[of "f x" "f y" "f z"] f(1) by(auto simp: embed_dist_on_def) +qed(simp_all add: embed_dist_on_def dist_geq0) + +interpretation ed : metric_set B ed + by(rule embed_dist_dist) + +lemma embed_dist_open_ball: + assumes "a \ B" + shows"f ` (ed.open_ball a e) = open_ball (f a) e \ f ` B" + using assms f by(auto simp: ed.open_ball_def open_ball_def embed_dist_on_def) + +lemma embed_dist_closed_ball: + assumes "a \ B" + shows"f ` (ed.closed_ball a e) = closed_ball (f a) e \ f ` B" + using assms f by(auto simp: ed.closed_ball_def closed_ball_def embed_dist_on_def) + +lemma embed_dist_topology_homeomorphic_maps: + assumes g1:"\x. x \ B \ g (f x) = x" + shows "homeomorphic_maps ed.mtopology (subtopology mtopology (f ` B)) f g" +proof - + have g2: "\x. x \ f ` B \ f (g x) = x" "g \ (f ` B) \ B" + by(auto simp: g1) + show ?thesis + unfolding homeomorphic_maps_def mtopology_topspace ed.mtopology_topspace + proof safe + show "continuous_map ed.mtopology (subtopology mtopology (f ` B)) f" + unfolding mtopology_def2 subtopology_generated_by + proof(rule continuous_on_generated_topo) + show "\U. U \ {f ` B \ U |U. U \ {open_ball a \ |a \. a \ S \ 0 < \}} \ openin ed.mtopology (f -` U \ topspace ed.mtopology)" + unfolding ed.mtopology_topspace + proof safe + fix a and e :: real + assume h:"a \ S" "0 < e" + have 1:"(f -` (f ` B \ open_ball a e) \ B) = f -` open_ball a e \ B" by blast + show "openin ed.mtopology (f -` (f ` B \ open_ball a e) \ B)" + unfolding 1 ed.mtopology_openin_iff + proof safe + fix x + assume h':"x \ B" "f x \ open_ball a e" + then obtain e' where e':"e' > 0" "open_ball (f x) e' \ open_ball a e" + using mtopology_open_ball_in' by blast + show "\\>0. ed.open_ball x \ \ f -` open_ball a e \ B" + proof(safe intro!: exI[where x=e']) + fix y + assume "y \ ed.open_ball x e'" + with e'(2) show "y \ f -` open_ball a e" + using embed_dist_open_ball[OF h'(1),of e'] by blast + qed(use e' ed.open_ball_subset_ofS in auto) + qed + qed + next + show "f ` topspace ed.mtopology \ \ {f ` B \ U |U. U \ {open_ball a \ |a \. a \ S \ 0 < \}} " + by(auto simp: ed.mtopology_topspace) (metis (mono_tags, opaque_lifting) IntE IntI closed_ball_def ed.closed_ball_ina ed.dist_set_geq0 ed.dist_set_inA embed_dist_closed_ball ennreal_le_epsilon ennreal_zero_less_top image_eqI le_zero_eq not_gr_zero open_ballD'(2) open_ball_ina open_ball_le_0) + qed + next + show "continuous_map (subtopology mtopology (f ` B)) ed.mtopology g" + unfolding ed.mtopology_def2 + proof(rule continuous_on_generated_topo) + show "\U. U \ {ed.open_ball a \ |a \. a \ B \ 0 < \} \ openin (subtopology mtopology (f ` B)) (g -` U \ topspace (subtopology mtopology (f ` B)))" + proof safe + fix a and e :: real + assume h: "a \ B" "0 < e" + then have 1: "g -` ed.open_ball a e \ (S \ f ` B) = open_ball (f a) e \ f ` B" + using f(1) g1 g2 by(auto simp: ed.open_ball_def open_ball_def embed_dist_on_def) + show "openin (subtopology mtopology (f ` B)) (g -` ed.open_ball a e \ (topspace (subtopology mtopology (f ` B))))" + by(auto simp: 1 openin_subtopology openin_open_ball mtopology_topspace intro!: exI[where x="open_ball (f a) e"]) + qed + show "g ` topspace (subtopology mtopology (f ` B)) \ \ {ed.open_ball a \ |a \. a \ B \ 0 < \}" + by(auto simp: mtopology_topspace) (metis ed.mtopology_openin_iff ed.open_ball_ina ed.openin_S g1) + qed + qed(use g1 g2 in auto) +qed + +lemma embed_dist_topology_homeomorphic_map: + "homeomorphic_map ed.mtopology (subtopology mtopology (f ` B)) f" +proof - + define g where "g \ (\y. THE x. x \ B \ f x = y)" + have g1: "g (f b) = b" if "b \ B" for b + unfolding g_def by(rule theI2[of _ b]) (insert that f(2), auto simp: inj_on_def) + thus ?thesis + using embed_dist_topology_homeomorphic_maps homeomorphic_map_maps by blast +qed + +corollary embed_dist_topology_homeomorphic: + "ed.mtopology homeomorphic_space (subtopology mtopology (f ` B))" + using embed_dist_topology_homeomorphic_map + by(rule homeomorphic_map_imp_homeomorphic_space) + +corollary embed_dist_topology_homeomorphic_map': + assumes "f ` B = S" + shows "homeomorphic_map ed.mtopology mtopology f" + using embed_dist_topology_homeomorphic_map[simplified assms] + by(simp add:subtopology_topspace[of mtopology, simplified mtopology_topspace]) + +corollary embed_dist_topology_homeomorphic': + assumes "f ` B = S" + shows "ed.mtopology homeomorphic_space mtopology" + using embed_dist_topology_homeomorphic_map'[OF assms] + by(rule homeomorphic_map_imp_homeomorphic_space) + +lemma embed_dist_converge_to_inS_iff: + "ed.converge_to_inS xn x \ xn \ ed.sequence \ x \ B \ converge_to_inS (\n. f (xn n)) (f x)" +proof safe + assume h:"ed.converge_to_inS xn x" + then show h':"x \ B" "\n. xn n \ B" + by(auto simp: ed.converge_to_inS_def) + thus "converge_to_inS (\n. f (xn n)) (f x)" + using h f by(auto simp: converge_to_inS_def2 ed.converge_to_inS_def2 embed_dist_on_def) +next + assume h:"xn \ ed.sequence" "x \ B" "converge_to_inS (\n. f (xn n)) (f x)" + show "ed.converge_to_inS xn x" + using h f by(fastforce simp: ed.converge_to_inS_def2 h embed_dist_on_def converge_to_inS_def2) +qed + +lemma embed_dist_convergent_inS_iff: + assumes "closedin mtopology (f ` B)" + shows "ed.convergent_inS xn \ xn \ ed.sequence \ convergent_inS (\n. f (xn n))" +proof - + { + fix s + assume h:"xn \ ed.sequence" "converge_to_inS (\n. f (xn n)) s" + with f have "(\n. f (xn n)) \ UNIV \ f ` B" by auto + hence "s \ f ` B" + using assms h(2) by(auto simp: mtopology_closedin_iff) + hence "\b \ B. s = f b" by auto + } + thus ?thesis + using embed_dist_converge_to_inS_iff[of xn] f(1) + by(fastforce simp: ed.convergent_inS_def convergent_inS_def) +qed + +lemma embed_dist_Cauchy_inS_iff: + "ed.Cauchy_inS xn \ xn \ ed.sequence \ Cauchy_inS (\n. f (xn n))" + using f(1) by(auto simp: ed.Cauchy_inS_def Cauchy_inS_def embed_dist_on_def; meson PiE UNIV_I) + +end + +end + +text \ Relations to elementary topology. \ +lemma ball_def_set: "ball a \ = metric_set.open_ball UNIV dist a \" + using metric_set.open_ball_def metric_class_metric_set + by fastforce + +lemma converge_to_def_set: + fixes xn :: "nat \ ('a::metric_space)" + shows "xn \ x \ metric_set.converge_to_inS UNIV dist xn x" +proof - + interpret m: metric_set UNIV dist + by simp + show ?thesis + by(simp add: lim_sequentially m.converge_to_inS_def) +qed + +lemma the_limit_of_limit: + fixes xn :: "nat \ ('a::metric_space)" + shows "metric_set.the_limit_of UNIV dist xn = lim xn" + by(simp add: metric_set.the_limit_of_def lim_def converge_to_def_set) + +lemma convergent_def_set: + fixes f :: "nat \ ('a::metric_space)" + shows "convergent f \ metric_set.convergent_inS UNIV dist f" +proof - + interpret m: metric_set UNIV dist + by(rule metric_class_metric_set) + show "convergent f \ m.convergent_inS f" + using converge_to_def_set[of f] + by(auto simp: convergent_def m.convergent_inS_def) +qed + +lemma Cahuchy_def_set: "Cauchy f \ metric_set.Cauchy_inS UNIV dist f" +proof - + interpret m: metric_set UNIV dist + by(rule metric_class_metric_set) + show "Cauchy f = m.Cauchy_inS f" + by(simp add: Cauchy_def m.Cauchy_inS_def dist_real_def) +qed + +lemma open_openin_set: "open U \ openin (metric_set.mtopology UNIV dist) U" + (is "?LHS \ ?RHS") +proof - + interpret m: metric_set UNIV dist + by(rule metric_class_metric_set) + have "?LHS \ (\x\U. \e>0. ball x e \ U)" + by(simp add: open_contains_ball) + also have "... \ (\x\U. \e>0. m.open_ball x e \ U)" + by(simp add: ball_def_set) + also have "... \ ?RHS" + by(simp add: m.mtopology_openin_iff[of U]) + finally show ?thesis . +qed + +lemma topological_basis_set: "topological_basis \ \ metric_set.mtopology_basis UNIV dist \" + (is "?LHS = ?RHS") +proof - + interpret m: metric_set UNIV dist + by(rule metric_class_metric_set) + have "?LHS \ (\b\\. open b) \ (\x. open x \ (\B'\\. \ B' = x))" + by(simp add: topological_basis_def) + also have "... \ (\b\\. openin m.mtopology b) \ (\x. openin m.mtopology x \ (\B'\\. \ B' = x))" + by(simp add: open_openin_set) + also have "... \ ?RHS" + by(simp add: base_of_def2') + finally show ?thesis . +qed + +lemma euclidean_mtopology: "metric_set.mtopology UNIV dist = euclidean" + using open_openin open_openin_set topology_eq by blast + +text \ Distances generate the same topological space.\ +lemma metric_generates_same_topology: + assumes "metric_set S d" "metric_set S d'" + "\x U. U \ S \ (\y\U. \\>0. metric_set.open_ball S d y \ \ U) \ x \ U \ \\>0. metric_set.open_ball S d' x \ \ U" + and "\x U. U \ S \ (\y\U. \\>0. metric_set.open_ball S d' y \ \ U) \ x \ U \ \\>0. metric_set.open_ball S d x \ \ U" + shows "metric_set.mtopology S d = metric_set.mtopology S d'" +proof - + interpret m1: metric_set S d by fact + interpret m2: metric_set S d' by fact + have "(\U. U \ S \ (\x\U. \\>0. m1.open_ball x \ \ U)) = (\U. U \ S \ (\x\U. \\>0. m2.open_ball x \ \ U))" + by standard (use assms(3,4) in auto) + thus ?thesis + using topology.topology_inject m1.mtopology_istopology m2.mtopology_istopology + by(simp add: m2.mtopology_def m1.mtopology_def) +qed + +lemma metric_generates_same_topology_inverse: + assumes "metric_set S d" "metric_set S d'" + and "metric_set.mtopology S d = metric_set.mtopology S d'" + shows "U \ S \ (\y\U. \\>0. metric_set.open_ball S d y \ \ U) \ x \ U \ \\>0. metric_set.open_ball S d' x \ \ U" + and "U \ S \ (\y\U. \\>0. metric_set.open_ball S d' y \ \ U) \ x \ U \ \\>0. metric_set.open_ball S d x \ \ U" +proof - + interpret m1: metric_set S d by fact + interpret m2: metric_set S d' by fact + have "(\U. U \ S \ (\x\U. \\>0. m1.open_ball x \ \ U)) = (\U. U \ S \ (\x\U. \\>0. m2.open_ball x \ \ U))" + using topology.topology_inject[of "\U. U \ S \ (\x\U. \\>0. m1.open_ball x \ \ U)" "\U. U \ S \ (\x\U. \\>0. m2.open_ball x \ \ U)"] m1.mtopology_istopology m2.mtopology_istopology assms(3) + by(auto simp: m2.mtopology_def m1.mtopology_def) + thus "U \ S \ \y\U. \\>0. m1.open_ball y \ \ U \ x \ U \ \\>0. m2.open_ball x \ \ U" + "U \ S \ \y\U. \\>0. m2.open_ball y \ \ U \ x \ U \ \\>0. m1.open_ball x \ \ U" + by(auto dest: fun_cong[where x=U]) +qed + +lemma metric_generates_same_topology_converges': + assumes "metric_set S d" "metric_set S d'" + "metric_set.mtopology S d = metric_set.mtopology S d'" + and "metric_set.converge_to_inS S d f x" + shows "metric_set.converge_to_inS S d' f x" +proof - + interpret m1: metric_set S d by fact + interpret m2: metric_set S d' by fact + show ?thesis + unfolding m2.converge_to_inS_def2' + proof safe + fix \ :: real + assume h:"0 < \" + obtain \' where he: + "\'>0" "m1.open_ball x \' \ m2.open_ball x \" + using m2.mtopology_open_ball_in'[of _ x] assms(4)[simplified m1.converge_to_inS_def2'] metric_generates_same_topology_inverse(2)[OF assms(1-3) m2.open_ball_subset_ofS, of x \,OF _ m2.open_ball_ina[OF _ h,of x]] + by auto + then obtain N where hn: + "\n\N. f n \ m1.open_ball x \'" + using assms(4)[simplified m1.converge_to_inS_def2'] by auto + show "\N. \n\N. f n \ m2.open_ball x \" + using hn he(2) by(auto intro!: exI[where x=N]) + next + show "\x. f x \ S" "x \ S" + using assms(4)[simplified m1.converge_to_inS_def2'] by auto + qed +qed + +lemma metric_generates_same_topology_converges: + assumes "metric_set S d" "metric_set S d'" + and "metric_set.mtopology S d = metric_set.mtopology S d'" + shows "metric_set.converge_to_inS S d f x \ metric_set.converge_to_inS S d' f x" + using metric_generates_same_topology_converges'[OF assms(2,1) assms(3)[symmetric]] metric_generates_same_topology_converges'[OF assms(1-3)] + by auto + +lemma metric_generates_same_topology_convergent: + assumes "metric_set S d" "metric_set S d'" + and "metric_set.mtopology S d = metric_set.mtopology S d'" + shows "metric_set.convergent_inS S d f \ metric_set.convergent_inS S d' f" + using metric_generates_same_topology_converges[OF assms,of f] + by (simp add: assms(1) assms(2) metric_set.convergent_inS_def) + +subsubsection \ Sub-Metric Spaces\ +definition submetric :: "['a set, 'a \ 'a \ real] \ 'a \ 'a \ real" where +"submetric S' d \ (\x y. if x \ S' \ y \ S' then d x y else 0)" + +lemma(in metric_set) submetric_metric_set: + assumes "S' \ S" + shows "metric_set S' (submetric S' dist)" +proof + show "\x y. 0 \ submetric S' dist x y" + "\x y. x \ S' \ submetric S' dist x y = 0" + "\x y. x \ S' \ y \ S' \ (x = y) = (submetric S' dist x y = 0)" + "\x y. submetric S' dist x y = submetric S' dist y x" + using assms dist_geq0 dist_tr dist_0 dist_sym + by(fastforce simp: submetric_def)+ +next + show "\x y z. x \ S' \ y \ S' \ z \ S' \ submetric S' dist x z \ submetric S' dist x y + submetric S' dist y z" + by (metis assms dist_tr submetric_def subset_iff) +qed + +lemma(in metric_set) submetric_open_ball: + assumes "S' \ S" and "a \ S'" + shows "open_ball a \ \ S' = metric_set.open_ball S' (submetric S' dist) a \" +proof - + interpret m: metric_set S' "submetric S' dist" + by(rule submetric_metric_set[OF assms(1)]) + show ?thesis + using assms by(auto simp: open_ball_def m.open_ball_def,simp_all add: submetric_def) +qed + +lemma(in metric_set) submetric_open_ball_subset: + assumes "S' \ S" + shows "metric_set.open_ball S' (submetric S' dist) a \ \ open_ball a \" +proof - + interpret m: metric_set S' "submetric S' dist" + by(rule submetric_metric_set[OF assms(1)]) + show ?thesis + by (metis assms empty_subsetI inf_commute inf_sup_ord(2) m.open_ball_nin submetric_open_ball) +qed + +lemma(in metric_set) submetric_subtopology: + assumes "S' \ S" + shows "subtopology mtopology S' = metric_set.mtopology S' (submetric S' dist)" +proof - + interpret m: metric_set S' "submetric S' dist" + by(rule submetric_metric_set[OF assms(1)]) + show ?thesis + unfolding topology_eq + proof safe + fix U + assume "openin (subtopology mtopology S') U" + then obtain T where ht: "openin mtopology T" "U = T \ S'" + by(auto simp: openin_subtopology) + have "U \ S'" + by (simp add: ht(2)) + show "openin m.mtopology U" + unfolding m.mtopology_openin_iff + proof safe + fix x + assume "x \ U" + then obtain \ where he: "\ > 0" "open_ball x \ \ T" + using ht by(auto simp: mtopology_openin_iff) + thus "\\>0. m.open_ball x \ \ U" + using ht(2) \x \ U\ submetric_open_ball[OF assms(1),of x \] + by(auto intro!: exI[where x=\]) + qed(use \U \ S'\ in auto) + next + fix U + assume "openin m.mtopology U" + then have "\x\U. \\>0. m.open_ball x \ \ U" + by(simp add: m.mtopology_openin_iff) + then obtain \ where he: + "\x. x \ U \ \ x > 0" "\x. x \ U \ m.open_ball x (\ x) \ U" + by metis + have "U \ S'" + using \openin m.mtopology U\ m.mtopology_openin_iff by auto + + show "openin (subtopology mtopology S') U" + unfolding openin_subtopology + proof(intro exI[where x="\ { open_ball x (\ x) | x. x\U}"] conjI) + show "openin mtopology (\ { open_ball x (\ x) | x. x\U})" + by(rule openin_Union) (use he(1) open_ball_def mtopology_open_ball_in in fastforce) + next + have *:"U = (\ { m.open_ball x (\ x) | x. x\U})" + using he m.open_ball_ina \U \ S'\ by fastforce + also have "... = (\ { open_ball x (\ x) \ S' | x. x\U})" + using submetric_open_ball[OF assms(1)] \U \ S'\ by auto + also have "... = (\ { open_ball x (\ x) | x. x\U}) \ S'" + by auto + finally show "U = \ {open_ball x (\ x) |x. x \ U} \ S' " . + qed + qed +qed + +lemma(in metric_set) converge_to_insub_converge_to_inS: + assumes "S' \ S" and "metric_set.converge_to_inS S' (submetric S' dist) f x" + shows "converge_to_inS f x" +proof - + interpret m: metric_set S' "submetric S' dist" + by(rule submetric_metric_set[OF assms(1)]) + have *:"f \ m.sequence" "x \ S'" + using assms(2) by(auto simp: m.converge_to_inS_def) + show ?thesis + unfolding converge_to_inS_def2 using * assms[simplified m.converge_to_inS_def2] + by(auto simp: submetric_def funcset_mem) +qed + +lemma(in metric_set) convergent_insub_convergent_inS: + assumes "S' \ S" and "metric_set.convergent_inS S' (submetric S' dist) f" + shows "convergent_inS f" + by (meson assms(1) assms(2) converge_to_insub_converge_to_inS convergent_inS_def in_mono metric_set.convergent_inS_def submetric_metric_set) + +lemma(in metric_set) Cauchy_insub_Cauchy: + assumes "S' \ S" and "metric_set.Cauchy_inS S' (submetric S' dist) f" + shows "Cauchy_inS f" +proof - + interpret m: metric_set S' "submetric S' dist" + by(rule submetric_metric_set[OF assms(1)]) + have *:"f \ m.sequence" + using assms(2) by(auto simp: m.Cauchy_inS_def) + show ?thesis + unfolding Cauchy_inS_def using * assms[simplified m.Cauchy_inS_def] + by(auto simp: submetric_def funcset_mem[OF *]) +qed + +lemma(in metric_set) Cauchy_insub_Cauchy_inverse: + assumes "S' \ S" "f \ UNIV \ S'" "Cauchy_inS f" + shows "metric_set.Cauchy_inS S' (submetric S' dist) f" +proof - + interpret m: metric_set S' "submetric S' dist" + by(rule submetric_metric_set[OF assms(1)]) + show ?thesis + using assms by(auto simp: m.Cauchy_inS_def Cauchy_inS_def,simp add: submetric_def) metis +qed + +lemma(in metric_set) convergent_insubmetric: + assumes "S' \ S" "f \ UNIV \ S'" "x \ S'" "converge_to_inS f x" + shows "metric_set.converge_to_inS S' (submetric S' dist) f x" +proof - + interpret m: metric_set S' "submetric S' dist" + by(rule submetric_metric_set[OF assms(1)]) + show ?thesis + unfolding m.converge_to_inS_def using assms + by(auto simp: converge_to_inS_def funcset_mem[OF assms(2)] submetric_def) +qed + +lemma(in metric_set) the_limit_of_submetric_eq: + assumes "S' \ S" "metric_set.convergent_inS S' (submetric S' dist) f" + shows "metric_set.the_limit_of S' (submetric S' dist) f = the_limit_of f" + by (meson assms(1) assms(2) converge_to_insub_converge_to_inS convergent_insub_convergent_inS metric_set.converge_to_inS_unique metric_set.the_limit_if_converge metric_set_axioms submetric_metric_set) + +lemma submetric_of_euclidean: + "metric_set A (submetric A dist)" "metric_set.mtopology A (submetric A dist) = top_of_set A" + using metric_set.submetric_metric_set[OF metric_class_metric_set,of A] metric_set.submetric_subtopology[OF metric_class_metric_set,of A] + by(auto simp: euclidean_mtopology) + +lemma(in metric_set) + assumes "B \ S" + shows totally_bounded_on_submetric: "totally_bounded_on B \ metric_set.totally_boundedS B (submetric B dist)" +proof - + interpret m: metric_set B "submetric B dist" + by(rule submetric_metric_set[OF assms(1)]) + show ?thesis + unfolding totally_bounded_on_def m.totally_boundedS_def + proof safe + fix e :: real + assume h:"\e>0. \A. eps_net_on B e A" "e > 0" + then obtain A where A:"eps_net_on B (e / 2) A" + by fastforce + define A' where "A' \ A \ {z. open_ball z (e / 2) \ B \ {}}" + have A': "eps_net_on B (e / 2) A'" + unfolding eps_net_on_def + proof safe + fix x + assume x:"x \ B" + then obtain a where a:"a \ A" "x \ open_ball a (e / 2)" + using A by(auto dest: eps_net_onD) + with x have "a \ A'" + by(auto simp: A'_def) + with a show "x \ (\a\A'. open_ball a (e / 2))" by auto + qed(use h eps_net_on_def A'_def A in auto) + define b where "b \ (\a. SOME b. b \ B \ b \ open_ball a (e / 2))" + have b:"b a \ B" "b a \ open_ball a (e / 2)" if a: "a \ A'" for a + proof - + have "b a \ B \ b a \ open_ball a (e / 2)" + unfolding b_def by(rule someI_ex) (insert that, auto simp: A'_def) + thus "b a \ B" "b a \ open_ball a (e / 2)" by auto + qed + show "\A. m.eps_net e A" + unfolding m.eps_net_on_def + proof(safe intro!: exI[where x="b ` A'"]) + fix x + assume "x \ B" + then obtain a where a: "a \ A'" "x \ open_ball a (e / 2)" + using A' by(auto simp: eps_net_on_def) + show "x \ (\a\b ` A'. m.open_ball a e)" + proof + show "b a \ b ` A'" + using a by auto + next + have [simp]: "b a \ S" "x \ S" "b a \ B" "x \ B" "a \ S" + using b(1)[OF a(1)] assms \x \ B\ a A' by (auto simp: eps_net_on_def) + note order.strict_trans1[OF dist_tr add_strict_mono[OF open_ballD[OF a(2),simplified dist_sym[of a]] open_ballD[OF b(2)[OF a(1)]]],simplified] + hence "submetric B dist x (b a) < e" + by(auto simp: submetric_def) + thus "x \ m.open_ball (b a) e" + by(auto simp: m.open_ball_def m.dist_sym) + qed + qed(insert h(2) A' b, auto simp: eps_net_on_def) + next + fix e :: real + assume "\e>0. \A. m.eps_net e A" "e > 0" + then obtain A where A: "m.eps_net e A" by auto + thus "\A. eps_net_on B e A" + using assms submetric_open_ball_subset[OF assms] by(auto intro!: exI[where x=A] simp: eps_net_on_def m.eps_net_def) blast + qed +qed + +text \ Continuous functions \ +context + fixes S :: "'a set" and d + and S':: "'b set" and d' + assumes "metric_set S d" "metric_set S' d'" +begin + +interpretation m1: metric_set S d by fact +interpretation m2: metric_set S' d' by fact + +lemma metric_set_continuous_map_eq: + shows "continuous_map m1.mtopology m2.mtopology f + \ f \ S \ S' \ (\x\S. \\>0. \\>0. \y\S. d x y < \ \ d' (f x) (f y) < \)" +proof safe + show "\x. continuous_map m1.mtopology m2.mtopology f \ x \ S \ f x \ S'" + using m1.mtopology_topspace m2.mtopology_topspace by(auto dest: continuous_map_image_subset_topspace) +next + fix x \ + assume "continuous_map m1.mtopology m2.mtopology f" + "x \ S" "(0 :: real) < \" + then have "openin m1.mtopology {z \ S. f z \ m2.open_ball (f x) \}" "f x \ S'" + using openin_continuous_map_preimage[OF \continuous_map m1.mtopology m2.mtopology f\] m2.mtopology_open_ball_in[of "f x",OF _ \0 < \\] continuous_map_image_subset_topspace[OF \continuous_map m1.mtopology m2.mtopology f\] m1.mtopology_topspace m2.mtopology_topspace + by auto + moreover have "x \ {z \ S. f z \ m2.open_ball (f x) \}" + using \x \ S\ \0 < \\ continuous_map_image_subset_topspace[OF \continuous_map m1.mtopology m2.mtopology f\] m1.mtopology_topspace m2.mtopology_topspace m2.dist_0[of "f x" "f x"] + by(auto simp: m2.open_ball_def) + ultimately obtain \ where + "\>0" "m1.open_ball x \ \ {z \ S. f z \ m2.open_ball (f x) \}" + by (auto simp: m1.mtopology_openin_iff) + thus "\\>0. \y\S. d x y < \ \ d' (f x) (f y) < \" + using \x \ S\ \f x \ S'\ by(auto intro!: exI[where x=\] simp: m1.open_ball_def m2.open_ball_def) +next + assume "f \ S \ S'" + and h:"\x\S. \\>0. \\>0. \y\S. d x y < \ \ d' (f x) (f y) < \" + show "continuous_map m1.mtopology m2.mtopology f" + unfolding continuous_map + proof safe + show "\x. x \ topspace m1.mtopology \ f x \ topspace m2.mtopology" + using \f \ S \ S'\ m1.mtopology_topspace m2.mtopology_topspace by auto + next + fix U + assume "openin m2.mtopology U" + show "openin m1.mtopology {x \ topspace m1.mtopology. f x \ U}" + unfolding m1.mtopology_openin_iff + proof safe + show "\x. x \ topspace m1.mtopology \ f x \ U \ x \ S" + using \f \ S \ S'\ m1.mtopology_topspace m2.mtopology_topspace by auto + next + fix x + assume "x \ topspace m1.mtopology" "f x \ U" + then obtain \ where he: + "\ > 0" "m2.open_ball (f x) \ \ U" + using \openin m2.mtopology U\ by(auto simp: m2.mtopology_openin_iff) + then obtain \ where hd: + "\ > 0" "\y. y \ S \ d x y < \ \ d' (f x) (f y) < \" + using \x \ topspace m1.mtopology\ m1.mtopology_topspace h by metis + thus "\\>0. m1.open_ball x \ \ {x \ topspace m1.mtopology. f x \ U}" + using m1.open_ballD m1.open_ballD' m1.mtopology_topspace he(2) \f \ S \ S'\ + by(auto intro!: exI[where x=\] simp: m2.open_ball_def) fastforce + qed + qed +qed + +lemma metric_set_continuous_map_eq': + shows "continuous_map m1.mtopology m2.mtopology f + \ f \ S \ S' \ (\x z. m1.converge_to_inS x z \ m2.converge_to_inS (\n. f (x n)) (f z))" +proof + show "continuous_map m1.mtopology m2.mtopology f \ f \ S \ S' \ (\x z. m1.converge_to_inS x z \ m2.converge_to_inS (\n. f (x n)) (f z))" + unfolding metric_set_continuous_map_eq + proof safe + fix x z + assume h:"f \ S \ S'" "\x\S. \\>0. \\>0. \y\S. d x y < \ \ d' (f x) (f y) < \" "m1.converge_to_inS x z" + hence h':"x \ m1.sequence" "z \ S" "\\. \ > 0 \ \N. \n\N. d (x n) z < \" + by(auto simp: m1.converge_to_inS_def2) + show "m2.converge_to_inS (\n. f (x n)) (f z)" + unfolding m2.converge_to_inS_def2 + proof safe + show "f (x n) \ S'" "f z \ S'" for n + using h'(1,2) h(1) by auto + next + fix \ + assume he:"(0 :: real) < \" + then obtain \ where hd:"\ > 0" "\y. y \ S \ d z y < \ \ d' (f z) (f y) < \" + using h(2) h'(2) by metis + obtain N where hn: "\n. n \ N \ d z (x n) < \" + using h'(3)[OF hd(1),simplified m1.dist_sym[of _ z]] by auto + show "\N. \n\N. d' (f (x n)) (f z) < \" + proof(safe intro!: exI[where x=N]) + fix n + assume "n \ N" + then have "x n \ S" "d z (x n) < \" + using hn[OF \n \ N\] h'(1) by auto + thus "d' (f (x n)) (f z) < \" + by(auto intro!: hd(2) simp: m2.dist_sym[of _ "f z"]) + qed + qed + qed +next + assume "f \ S \ S' \ (\x z. m1.converge_to_inS x z \ m2.converge_to_inS (\n. f (x n)) (f z))" + hence h:"f \ S \ S'" "\x z. m1.converge_to_inS x z \ m2.converge_to_inS (\n. f (x n)) (f z)" by auto + show "continuous_map m1.mtopology m2.mtopology f" + unfolding continuous_map_closedin + proof safe + show "x \ topspace m1.mtopology \ f x \ topspace m2.mtopology" for x + using m1.mtopology_topspace m2.mtopology_topspace h(1) by auto + next + fix C + assume hcl:"closedin m2.mtopology C" + show "closedin m1.mtopology {x \ topspace m1.mtopology. f x \ C}" + unfolding m1.mtopology_closedin_iff + proof safe + fix y s + assume hg:"y \ UNIV \ {x \ topspace m1.mtopology. f x \ C}" " m1.converge_to_inS y s" + hence "(\n. f (y n)) \ UNIV \ C" + by auto + thus "f s \ C" "s \ topspace m1.mtopology" + using h(2)[OF hg(2)] hcl[simplified m2.mtopology_closedin_iff] hg(2)[simplified m1.converge_to_inS_def] m1.mtopology_topspace + by auto + qed(simp add: m1.mtopology_topspace) + qed +qed + +lemma continuous_map_limit_of: + assumes "continuous_map m1.mtopology m2.mtopology f" "m1.convergent_inS xn" + shows "m2.the_limit_of (\n. f (xn n)) = f (m1.the_limit_of xn)" + using assms m1.the_limit_if_converge m2.the_limit_of_eq + by(simp add: metric_set_continuous_map_eq') + +text \ Uniform continuous functions. \ +definition uniform_continuous_map :: "('a \ 'b) \ bool" where +"uniform_continuous_map f \ f \ S \ S' \ (\\>0. \\>0. \x\S. \y\S. d x y < \ \ d' (f x) (f y) < \)" + +lemma uniform_continuous_map_const: + assumes "y \ S'" + shows "uniform_continuous_map (\x. y)" + using assms by(auto simp: uniform_continuous_map_def) + +lemma continuous_if_uniform_continuous: + assumes "uniform_continuous_map f" + shows "continuous_map m1.mtopology m2.mtopology f" + unfolding metric_set_continuous_map_eq +proof safe + show "x \ S \ f x \ S'" for x + using assms by(auto simp: uniform_continuous_map_def) +next + fix x \ + assume [simp]:"x \ S" and "(0 :: real) < \" + then obtain \ where "\ > 0" "\x y. x \ S \ y \ S \ d x y < \ \ d' (f x) (f y) < \" + using assms by(auto simp: uniform_continuous_map_def) + thus "\\>0. \y\S. d x y < \ \ d' (f x) (f y) < \" + by(auto intro!: exI[where x=\]) +qed + +definition converges_uniformly :: "[nat \ 'a \ 'b, 'a \ 'b] \ bool" where +"converges_uniformly fn f \ (\n. fn n \ S \ S') \ (f \ S \ S') \ (\e>0. \N. \n\N. \x\S. d' (fn n x) (f x) < e)" + +lemma converges_uniformly_continuous: + assumes "\n. continuous_map m1.mtopology m2.mtopology (fn n)" + and "converges_uniformly fn f" + shows "continuous_map m1.mtopology m2.mtopology f" + unfolding metric_set_continuous_map_eq +proof safe + fix x e + assume h:"x \ S" "e > (0 :: real)" + then obtain N where N: "\z n. n \ N \ z \ S \ d' (fn n z) (f z) < e / 3" + using assms(2) by(simp only: converges_uniformly_def) (meson zero_less_divide_iff zero_less_numeral) + have f: "\n x. x \ S \ fn n x \ S'" "\x. x \ S \ f x \ S'" + using assms(2) by(auto simp: converges_uniformly_def) + from assms(1)[of N] h obtain \ where h': "\ > 0" "\y. y \ S \ d x y < \ \ d' (fn N x) (fn N y) < e / 3" + by (metis metric_set_continuous_map_eq zero_less_divide_iff zero_less_numeral) + show "\\>0. \y\S. d x y < \ \ d' (f x) (f y) < e" + proof(safe intro!: exI[where x=\]) + fix y + assume y:"y \ S" "d x y < \" + have "d' (f x) (f y) \ d' (f x) (fn N x) + d' (fn N x) (fn N y) + d' (fn N y) (f y)" + using m2.dist_tr[of "f x" "fn N x" "f y"] m2.dist_tr[of "fn N x" "fn N y" "f y"] f[OF y(1)] f[OF h(1)] + by auto + also have "... < e" + using N[OF order_refl h(1),simplified m2.dist_sym] N[OF order_refl y(1)] h'(2)[OF y] + by auto + finally show "d' (f x) (f y) < e" . + qed(use h' in auto) +qed(use assms(2) converges_uniformly_def in auto) + +text \ Lemma related @{term osc_on}.\ +lemma osc_on_inA_0: + assumes "x \ A \ S" "continuous_map (subtopology m1.mtopology (A \ S)) m2.mtopology f" + shows "m2.osc_on A m1.mtopology f x = 0" +proof - + interpret subm1: metric_set "A \ S" "submetric (A \ S) d" + by(auto intro!: m1.submetric_metric_set) + have cont: "continuous_map subm1.mtopology m2.mtopology f" + using assms(2) by (simp add: m1.submetric_subtopology) + have "m2.osc_on A m1.mtopology f x < ennreal \" if e:"\ > 0" for \ + unfolding m2.osc_on_less_iff + proof - + obtain \' where "\' > 0" "2*\' < \" + using e field_lbound_gt_zero[of "\/2" "\/2"] by auto + then obtain \ where hd:"\>0" "\y. y \ A \ y\S \ d x y < \ \ d' (f x) (f y) < \'" + using assms(1) cont[simplified Set_Based_Metric_Space.metric_set_continuous_map_eq[OF subm1.metric_set_axioms m2.metric_set_axioms]] + by(fastforce simp: submetric_def) + show "\v. x \ v \ openin m1.mtopology v \ m2.diam (f ` (A \ v)) < ennreal \" + proof(safe intro!: exI[where x="m1.open_ball x \"] m1.open_ball_ina m1.mtopology_open_ball_in) + have "m2.diam (f ` (A \ m1.open_ball x \)) \ ennreal (2*\')" + unfolding m2.diam_def Sup_le_iff + proof safe + fix a1 a2 + assume h:"a1 \ A" "a1 \ m1.open_ball x \" "f a1 \ S'" + "a2 \ A" "a2 \ m1.open_ball x \" "f a2 \ S'" + have "f x \ S'" + using cont assms(1) by(auto simp: Set_Based_Metric_Space.metric_set_continuous_map_eq[OF subm1.metric_set_axioms m2.metric_set_axioms]) + have "d' (f a1) (f a2) < 2*\'" + using hd(2)[OF \a1 \ A\ m1.open_ballD'(1)[OF h(2)] m1.open_ballD[OF h(2)]] hd(2)[OF \a2 \ A\ m1.open_ballD'(1)[OF h(5)] m1.open_ballD[OF h(5)]] m2.dist_tr[OF \f a1 \ S'\ \f x \ S'\ \f a2 \ S'\,simplified m2.dist_sym[of "f a1" "f x"]] + by auto + thus "ennreal (d' (f a1) (f a2)) \ ennreal (2*\')" + by (simp add: ennreal_leI) + qed + also have "... < ennreal \" + using \2*\' < \\ ennreal_lessI e by presburger + finally show "m2.diam (f ` (A \ m1.open_ball x \)) < ennreal \" . + qed(use hd(1) IntD2[OF assms(1)] in auto) + qed + hence "m2.osc_on A m1.mtopology f x < \" if "\ > 0" for \ + by (metis ennreal_enn2real ennreal_le_epsilon ennreal_less_zero_iff linorder_not_le order_le_less_trans that) + thus ?thesis + by fastforce +qed + +end + +context metric_set +begin + +interpretation rnv: metric_set "UNIV :: ('b :: real_normed_vector) set" dist_typeclass + by simp + +lemma dist_set_uniform_continuous: + "uniform_continuous_map S dist UNIV dist_typeclass (dist_set A)" + unfolding uniform_continuous_map_def[OF metric_set_axioms rnv.metric_set_axioms] dist_real_def +proof safe + fix \ :: real + assume "0 < \" + then show "\\>0. \x\S. \y\S. dist x y < \ \ \dist_set A x - dist_set A y\ < \" + using order.strict_trans1[OF dist_set_abs_le] by(auto intro!: exI[where x=\]) +qed simp + +lemma dist_set_continuous: "continuous_map mtopology euclideanreal (dist_set A)" + unfolding euclidean_mtopology[symmetric] + by(auto intro!: continuous_if_uniform_continuous simp: dist_set_uniform_continuous metric_set_axioms) + + +lemma uniform_continuous_map_add: + fixes f :: "'a \ 'b::real_normed_vector" + assumes "uniform_continuous_map S dist UNIV dist_typeclass f" "uniform_continuous_map S dist UNIV dist_typeclass g" + shows "uniform_continuous_map S dist UNIV dist_typeclass (\x. f x + g x)" + unfolding uniform_continuous_map_def[OF metric_set_axioms rnv.metric_set_axioms] +proof safe + fix e :: real + assume "e > 0" + from half_gt_zero[OF this] assms obtain d1 d2 where d: "d1 > 0" "d2 > 0" + "\x y. x \ S \ y \ S \ dist x y < d1 \ dist_typeclass (f x) (f y) < e / 2" "\x y. x \ S \ y \ S \ dist x y < d2 \ dist_typeclass (g x) (g y) < e / 2" + by(simp only: uniform_continuous_map_def[OF metric_set_axioms rnv.metric_set_axioms]) metis + show "\\>0. \x\S. \y\S. dist x y < \ \ dist_typeclass (f x + g x) (f y + g y) < e" + using d by(fastforce intro!: exI[where x="min d1 d2"] order.strict_trans1[OF dist_triangle_add]) +qed simp + +lemma uniform_continuous_map_real_devide: + fixes f :: "'a \ real" + assumes "uniform_continuous_map S dist UNIV dist_typeclass f" "uniform_continuous_map S dist UNIV dist_typeclass g" + and "\x. x \ S \ g x \ 0" "\x. x \ S \ \g x\ \ a" "a > 0" "\x. x \ S \ \g x\ < Kg" + and "\x. x \ S \ \f x\ < Kf" + shows "uniform_continuous_map S dist UNIV dist_typeclass (\x. f x / g x)" + unfolding uniform_continuous_map_def[OF metric_set_axioms rnv.metric_set_axioms] +proof safe + fix e :: real + assume e[arith]:"e > 0" + consider "S = {}" | "S \ {}" by auto + then show "\\>0. \x\S. \y\S. dist x y < \ \ dist_typeclass (f x / g x) (f y / g y) < e" + proof cases + case 1 + then show ?thesis by (auto intro!: exI[where x=1]) + next + case S:2 + then have Kfg_pos[arith]: "Kg > 0" "Kf \ 0" + using assms(4-7) by auto fastforce+ + define e' where "e' \ a^2 / (Kf + Kg) * e" + have e':"e' > 0" + using assms(5) by(auto simp: e'_def) + with assms obtain d1 d2 where d: "d1 > 0" "d2 > 0" + "\x y. x \ S \ y \ S \ dist x y < d1 \ \f x - f y\ < e'" "\x y. x \ S \ y \ S \ dist x y < d2 \ \g x - g y\ < e'" + by(auto simp: uniform_continuous_map_def[OF metric_set_axioms rnv.metric_set_axioms] dist_real_def) metis + show ?thesis + unfolding dist_real_def + proof(safe intro!: exI[where x="min d1 d2"]) + fix x y + assume x:"x \ S" and y:"y \ S" and "dist x y < min d1 d2" + then have dist[arith]: "dist x y < d1" "dist x y < d2" by auto + note [arith] = assms(3,4,6,7)[OF x] assms(3,4,6,7)[OF y] + have "\f x / g x - f y / g y\ = \(f x * g y - f y * g x) / (g x * g y)\" + by(simp add: diff_frac_eq) + also have "... = \(f x * g y - f x * g x + (f x * g x - f y * g x)) / (g x * g y)\" + by simp + also have "... = \(f x - f y) * g x - f x * (g x - g y)\ / (\g x\ * \g y\)" + by(simp add: left_diff_distrib right_diff_distrib abs_mult) + also have "... \ (\f x - f y\ * \g x\ + \f x\ * \g x - g y\) / (\g x\ * \g y\)" + by(rule divide_right_mono) (use abs_triangle_ineq4 abs_mult in metis,auto) + also have "... < (e' * Kg + Kf * e') / (\g x\ * \g y\)" + by(rule divide_strict_right_mono[OF add_less_le_mono]) (auto intro!: mult_mono' mult_strict_mono, use d(3,4)[OF x y] in auto) + also have "... \ (e' * Kg + Kf * e') / a^2" + by(auto intro!: divide_left_mono simp: power2_eq_square) (insert assms(5) e', auto simp: \a \ \g x\\ mult_mono') + also have "... = (Kf + Kg) / a^2 * e'" + by (simp add: distrib_left mult.commute) + also have "... = e" + using assms(5) by(auto simp: e'_def) + finally show " \f x / g x - f y / g y\ < e" . + qed(use d in auto) + qed +qed simp + +lemma the_limit_of_dist_converge: + assumes "converge_to_inS xn x" + shows "(\n. dist (xn n) y) \ dist (the_limit_of xn) y" +proof - + have "continuous_map mtopology euclideanreal (\z. dist z y)" + using dist_set_continuous[of "{y}"] by simp + hence "(\n. dist (xn n) y) \ dist x y" + using assms + by(auto simp: metric_set_continuous_map_eq'[OF metric_set_axioms rnv.metric_set_axioms,simplified euclidean_mtopology] converge_to_def_set) + thus ?thesis + by(simp add: the_limit_of_eq[OF assms]) +qed + +lemma the_limit_of_dist_converge': + assumes "converge_to_inS xn x" "\ > 0" + shows "\N. \n\N. \ dist (xn n) y - dist (the_limit_of xn) y \ < \" + using the_limit_of_dist_converge[OF assms(1)] assms(2) by(simp add: LIMSEQ_iff) + +lemma the_limit_of_dist: + assumes "converge_to_inS xn x" + shows "lim (\n. dist (xn n) y) = dist (the_limit_of xn) y" + using the_limit_of_dist_converge[OF assms] limI by blast + +text \ Upper-semicontinuous functions.\ +lemma upper_semicontinuous_map_def2: + fixes f :: "'a \ ('b :: {complete_linorder,linorder_topology})" + shows "upper_semicontinuous_map mtopology f \ (\x y. converge_to_inS x y \ limsup (\n. f (x n)) \ f y)" +proof + show "upper_semicontinuous_map mtopology f \ \x y. converge_to_inS x y \ limsup (\n. f (x n)) \ f y" + unfolding upper_semicontinuous_map_def + proof safe + fix x y + assume h:"\a. openin mtopology {x \ topspace mtopology. f x < a}" "converge_to_inS x y" + show "limsup (\n. f (x n)) \ f y" + unfolding Limsup_le_iff eventually_sequentially + proof safe + fix c + assume "f y < c" + show "\N. \n\N. f (x n) < c" + proof(rule ccontr) + assume "\N. \n\N. f (x n) < c" + then have hc:"\N. \n\N. f (x n) \ c" + using linorder_not_less by blast + define a :: "nat \ nat" where "a \ rec_nat (SOME n. f (x n) \ c) (\n an. SOME m. m > an \ f (x m) \ c)" + have "strict_mono a" + proof(rule strict_monoI_Suc) + fix n + have [simp]:"a (Suc n) = (SOME m. m > a n \ f (x m) \ c)" + by(auto simp: a_def) + show "a n < a (Suc n)" + by simp (metis (mono_tags, lifting) Suc_le_lessD hc someI) + qed + have *:"f (x (a n)) \ c" for n + proof(cases n) + case 0 + then show ?thesis + using hc[of 0] by(auto simp: a_def intro!: someI_ex) + next + case (Suc n') + then show ?thesis + by(simp add: a_def) (metis (mono_tags, lifting) Suc_le_lessD hc someI_ex) + qed + obtain N where "\n. n \ N \ x (a n) \ {x \ S. f x < c}" + using converge_to_inS_subseq[OF \strict_mono a\ h(2)] mtopology_openin_iff2[of "{x \ S. f x < c}"] h(2)[simplified converge_to_inS_def] mtopology_topspace \f y < c\ h + by fastforce + from *[of N] this[of N] show False by auto + qed + qed + qed +next + assume h:"\x y. converge_to_inS x y \ limsup (\n. f (x n)) \ f y" + show "upper_semicontinuous_map mtopology f" + unfolding upper_semicontinuous_map_def mtopology_openin_iff2 mtopology_topspace + proof safe + fix a y s + assume "converge_to_inS y s" "s \ S" "f s < a" + then have "limsup (\n. f (y n)) \ f s" + using h by auto + with \f s < a\ obtain N where "\n. n\N \ f (y n) < a" + by(auto simp: Limsup_le_iff eventually_sequentially) + thus "\N. \n\N. y n \ {x \ S. f x < a}" + using \converge_to_inS y s\ by(auto intro!: exI[where x=N] simp: converge_to_inS_def) + qed +qed + +lemma upper_semicontinuous_map_def2real: + fixes f :: "'a \ real" + shows "upper_semicontinuous_map mtopology f \ (\x y. converge_to_inS x y \ limsup (\n. f (x n)) \ f y)" + unfolding upper_semicontinuous_map_real_iff upper_semicontinuous_map_def2 + by auto + +lemma osc_upper_semicontinuous_map: + "upper_semicontinuous_map X (osc X f)" +proof - + have "{x \ topspace X. osc X f x < a} = \ {V. openin X V \ diam (f ` V) < a}" for a + using openin_subset by(auto simp add: osc_less_iff) + thus ?thesis + by(auto simp: upper_semicontinuous_map_def) +qed + +end + +text \ Open maps.\ +lemma metric_set_opem_map_from_dist: + assumes "metric_set S d" "metric_set S' d'" "f \ S \ S'" + and "\x \. x \ S \ \ > 0 \ \\>0. \y\S. d' (f x) (f y) < \ \ d x y < \" + shows "open_map (metric_set.mtopology S d) (subtopology (metric_set.mtopology S' d') (f ` S)) f" +proof - + interpret m1: metric_set S d by fact + interpret m2: metric_set S' d' by fact + interpret m2': metric_set "f ` S" "submetric (f ` S) d'" + using assms(3) by(auto intro!: m2.submetric_metric_set) + show ?thesis + proof(rule open_map_with_base[OF m1.mtopology_basis_ball]) + fix A + assume "A \ {m1.open_ball a \ |a \. a \ S \ 0 < \}" + then obtain a \ where hae: + "a \ S" "0 < \" "A = m1.open_ball a \" by auto + show "openin (subtopology m2.mtopology (f ` S)) (f ` A)" + unfolding m2.submetric_subtopology[OF funcset_image[OF assms(3)]] m2'.mtopology_openin_iff + proof + show "f ` A \ f ` S" + using m1.open_ball_subset_ofS[of a \] by(auto simp: hae(3)) + next + show "\x\f ` A. \\>0. m2'.open_ball x \ \ f ` A" + proof safe + fix x + assume "x \ A" + hence "x \ S" + using m1.open_ball_subset_ofS[of a \] by(auto simp: hae(3)) + moreover have "0 < \ - d a x" + using \x \ A\ m1.open_ballD[of x a \] by(auto simp: hae(3)) + ultimately obtain \ where hd:"\ > 0" "\y. y\S \ d' (f x) (f y) < \ \ d x y < \ - d a x" + using assms(4) by metis + show "\\>0. m2'.open_ball (f x) \ \ f ` A" + proof(safe intro!: exI[where x=\]) + fix z + assume "z \ m2'.open_ball (f x) \" + note hz = m2'.open_ballD'[OF this] + then obtain y where "y \ S" "z = f y" by auto + hence "d' (f x) (f y) < \" + using m2'.open_ballD[OF \z \ m2'.open_ball (f x) \\] \x \ A\ m1.open_ball_subset_ofS[of a \] + by(auto simp: submetric_def hae(3)) + hence "d x y < \ - d a x" + by(auto intro!: hd(2)[OF \y \ S\]) + hence "d a y < \" + using m1.dist_tr[OF \a \ S\ \x \ S\ \y \ S\] by auto + thus "z \ f ` A" + by (simp add: \y \ S\ \z = f y\ hae(1) hae(3) m1.open_ball_def) + qed(use hd in auto) + qed + qed + qed +qed + +subsubsection \ Complete Metric Spaces\ +locale complete_metric_set = metric_set + + assumes convergence: "\f. Cauchy_inS f \ convergent_inS f" + +lemma complete_space_complete_metric_set: + "complete_metric_set (UNIV :: 'a :: complete_space set) dist" +proof - + interpret m: metric_set UNIV dist + by(rule metric_class_metric_set) + show ?thesis + by standard (simp add: Cahuchy_def_set[symmetric] convergent_def_set[symmetric] Cauchy_convergent_iff) +qed + +lemma(in complete_metric_set) submetric_complete_iff: + assumes "M \ S" + shows "complete_metric_set M (submetric M dist) \ closedin mtopology M" +proof + assume "complete_metric_set M (submetric M dist)" + then interpret m: complete_metric_set M "submetric M dist" . + show "closedin mtopology M" + proof(rule ccontr) + assume "\ closedin mtopology M" + then have "\f\m.sequence. \s. converge_to_inS f s \ s \ M" + using assms mtopology_closedin_iff by auto + then obtain f s where hfs:"f \ m.sequence" "converge_to_inS f s" "s \ M" + by auto + hence "convergent_inS f" + by(auto simp: convergent_inS_def converge_to_inS_def) + have "m.Cauchy_inS f" + using Cauchy_if_convergent_inS[OF \convergent_inS f\] hfs(1) + by(auto simp: m.Cauchy_inS_def Cauchy_inS_def) (fastforce simp: submetric_def) + then obtain s' where "s' \ M" "m.converge_to_inS f s'" + using m.convergence by(auto simp: m.convergent_inS_def m.converge_to_inS_def) + from converge_to_insub_converge_to_inS[OF assms this(2)] hfs(2) + have "s' = s" + by(rule converge_to_inS_unique) + thus False + using \s' \ M\ \s \ M\ by simp + qed +next + interpret m: metric_set M "submetric M dist" + by(rule submetric_metric_set[OF assms]) + assume cls:"closedin mtopology M" + show "complete_metric_set M (submetric M dist)" + proof + fix f + assume "m.Cauchy_inS f" + then have "f \ m.sequence" by(simp add: m.Cauchy_inS_def) + have "Cauchy_inS f" + by(rule Cauchy_insub_Cauchy[OF assms \m.Cauchy_inS f\]) + then obtain x where hx:"x \ S" "converge_to_inS f x" + using convergence by(auto simp: convergent_inS_def converge_to_inS_def) + hence "x \ M" + using cls[simplified mtopology_closedin_iff] \f \ m.sequence\ assms + by auto + hence "m.converge_to_inS f x" + using convergent_insubmetric[OF assms \f \ m.sequence\] hx by auto + thus "m.convergent_inS f" + using \x \ M\ by(auto simp: m.convergent_inS_def) + qed +qed + +lemma(in complete_metric_set) embed_dist_complete: + assumes "f \ B \ S" "inj_on f B" "closedin mtopology (f ` B)" + shows "complete_metric_set B (embed_dist_on B f)" +proof - + interpret m: metric_set B "embed_dist_on B f" + by(rule embed_dist_dist[OF assms(1,2)]) + show ?thesis + proof + fix xn + assume "m.Cauchy_inS xn" + hence h:"xn \ m.sequence" "Cauchy_inS (\n. f (xn n))" + by(auto simp add: embed_dist_Cauchy_inS_iff[OF assms(1,2)]) + with convergence obtain x where x: "converge_to_inS (\n. f (xn n)) x" + by(auto simp: convergent_inS_def) + have x': "x \ f ` B" + proof - + have "(\n. f (xn n)) \ UNIV \ f ` B" + using assms(1) h(1) by auto + thus ?thesis + using assms(3) x by(auto simp: mtopology_closedin_iff) + qed + then obtain b where b: "b \ B" "f b = x" by auto + show "m.convergent_inS xn" + by(auto simp: m.convergent_inS_def embed_dist_converge_to_inS_iff[OF assms(1,2)] b x h intro!: exI[where x=b]) + qed +qed + +lemma(in metric_set) Cantor_intersection_theorem: + "complete_metric_set S dist \ (\Fn. (\n. Fn n \ {}) \ (\n. closedin mtopology (Fn n)) \ decseq Fn \ (\\ > 0. \N. \n\N. diam (Fn n) < \) \ (\x\S. \ (range Fn) = {x}))" +proof safe + fix Fn + assume "complete_metric_set S dist" + interpret complete_metric_set S dist by fact + assume h: "\n. Fn n \ {}" " \n. closedin mtopology (Fn n)" "decseq Fn" "\\ > 0. \N. \n\N. diam (Fn n) < \" + then obtain xn where xn1: "\n. xn n \ Fn n" + by (meson all_not_in_conv) + hence xn2: "xn \ sequence" + using closedin_subset[of mtopology] h(2) by(auto simp: mtopology_topspace) + have "Cauchy_inS xn" + unfolding Cauchy_inS_def + proof safe + fix \ :: real + assume "0 < \" + then obtain N where N:"\n. n\N \ diam (Fn n) < ennreal \" + using h(4) ennreal_less_zero_iff by blast + show "\N. \n\N. \m\N. dist (xn n) (xn m) < \" + proof(safe intro!: exI[where x=N]) + fix n m + assume "n \ N" "m \ N" + define nm where "nm = min m n" + have "nm \ N" "nm \ n" "nm \ m" + using \n \ N\ \m \ N\ by(auto simp: nm_def) + hence "xn n \ Fn nm" "xn m \ Fn nm" + using decseqD[OF h(3)] xn1[of n] xn1[of m] by auto + hence "ennreal (dist (xn n) (xn m)) \ diam (Fn nm)" + using xn2 by(auto intro!: diam_is_sup mtopology_topspace) + also have "... < ennreal \" + by(rule N[OF \nm \ N\]) + finally show "dist (xn n) (xn m) < \" + by (simp add: dist_geq0 ennreal_less_iff) + qed + qed(use xn2 in auto) + then obtain x where x:"x \ S" "converge_to_inS xn x" + using convergence[of xn] by(auto simp: convergent_inS_def converge_to_inS_def) + show "\x\S. \ (range Fn) = {x}" + proof(safe intro!: bexI[where x=x]) + fix n + show "x \ Fn n" + proof(rule ccontr) + assume "x \ Fn n" + moreover have "openin mtopology (S - Fn n)" + using h(2) by (simp add: openin_diff) + ultimately obtain \ where e: "\ > 0" "open_ball x \ \ S - Fn n" + using x(1) by(auto simp: mtopology_openin_iff) + then have "\N. \n\N. xn n \ open_ball x \" + using mtopology_openin_iff2[of "open_ball x \"] open_ball_ina[OF x(1) e(1)] x(2) + by(auto simp: openin_open_ball) + then obtain N where N:"\m. m \ N \ xn m \ open_ball x \" + by auto + hence "xn m \ S - Fn m" if "m \ N" "m \ n" for m + using e(2) decseqD[OF h(3) that(2)] using that(1) by blast + from xn1[of "max N n"] this[of "max N n"] + show False by auto + qed + next + fix y + assume "y \ \ (range Fn)" + then have hy:"\n. y \ Fn n" by auto + have "y \ S" + using closedin_subset[of mtopology] h(2) hy mtopology_topspace by auto + have "converge_to_inS xn y" + unfolding converge_to_inS_def2 + proof safe + fix \ :: real + assume "0 < \" + then obtain N where N:"\n. n \ N \ diam (Fn n) < ennreal \" + using ennreal_less_zero_iff h(4) by presburger + show "\N. \n\N. dist (xn n) y < \" + proof(safe intro!: exI[where x=N]) + fix n + assume "n \ N" + then have "ennreal (dist (xn n) y) < ennreal \" + using \y \ S\ hy xn1[of n] xn2 + by(auto intro!: order.strict_trans1[OF diam_is_sup[of "xn n" "Fn n" y] N[of n]]) + thus "dist (xn n) y < \" + by (simp add: dist_geq0 ennreal_less_iff) + qed + qed(use xn2 \y \ S\ in auto) + with converge_to_inS_unique[OF x(2)] + show "y = x" by simp + qed(use x in auto) +next + assume h:"\Fn. (\n. Fn n \ {}) \ (\n. closedin mtopology (Fn n)) \ decseq Fn \ (\\>0. \N. \n\N. diam (Fn n) < \) \ (\x\S. \ (range Fn) = {x})" + show "complete_metric_set S dist" + proof + fix xn + assume cauchy:"Cauchy_inS xn" + hence xn: "xn \ sequence" + by (simp add: Cauchy_inS_dest1) + define Fn where "Fn \ (\n. mtopology closure_of {xn m|m. m \ n})" + have Fn0': "{xn m|m. m \ n} \ Fn n" for n + using xn by(auto intro!: closure_of_subset simp: Fn_def mtopology_topspace) + have Fn0: "\n. Fn n \ S" + using xn by(auto simp: Fn_def in_closure_of metric_set.mtopology_topspace metric_set_axioms) + have Fn1: "Fn n \ {}" for n + using xn closure_of_eq_empty[of "{xn m|m. m \ n}" mtopology,simplified mtopology_topspace] + by(auto simp: Fn_def) + have Fn2:"\n. closedin mtopology (Fn n)" + by(simp add: Fn_def) + have Fn3: "decseq Fn" + by standard (auto simp: Fn_def intro!: closure_of_mono) + have Fn4:"\\>0. \N. \n\N. diam (Fn n) < \" + proof safe + fix \ :: ennreal + assume "0 < \" + define e where "e \ min 1 \" + have he: "e \ \" "enn2real e > 0" "ennreal (enn2real e) = e" + using \0 < \\ by(auto simp: e_def enn2real_positive_iff min_less_iff_disj) + then obtain e' where e':"e' > 0" "e' < enn2real e" + using field_lbound_gt_zero by auto + then obtain N where N:"\n m. n \ N \ m \ N \ dist (xn n) (xn m) \ e'" + using cauchy by(fastforce simp: Cauchy_inS_def) + show "\N. \n\N. diam (Fn n) < \" + proof(safe intro!: exI[where x=N]) + fix n + assume "N \ n" + then have "diam (Fn n) \ ennreal e'" + by(auto intro!: diam_le N simp: Fn_def diam_eq_closure) + also have "... < e" + using e'(2) ennreal_lessI he(2) he(3) by fastforce + finally show "diam (Fn n) < \" + using he(1) by auto + qed + qed + obtain x where x:"x\S" "\ (range Fn) = {x}" + using h Fn1 Fn2 Fn3 Fn4 by metis + show "convergent_inS xn" + unfolding convergent_inS_def converge_to_inS_def2 + proof(safe intro!: exI[where x=x]) + fix \ :: real + assume he:"0 < \" + then have "0 < ennreal \" by simp + then obtain N where N: "\n. n \ N \ diam (Fn n) < ennreal \" + using Fn4 by metis + show "\N. \n\N. dist (xn n) x < \" + proof(safe intro!: exI[where x=N]) + fix n + assume "N \ n" + then have "xn n \ Fn N" "x \ Fn N" + using x(2) Fn0'[of N] by auto + hence "ennreal (dist (xn n) x) \ diam (Fn N)" + using Fn0 by(auto intro!: diam_is_sup) + also have "... < ennreal \" + by(auto intro!: N) + finally show "dist (xn n) x < \" + by (simp add: dist_geq0 ennreal_less_iff) + qed + qed(use xn x in auto) + qed +qed + +lemma(in complete_metric_set) closed_decseq_Inter': + assumes "\n. Fn n \ {}" "\n. closedin mtopology (Fn n)" "decseq Fn" + and "\\. \ > 0 \ \N. \n\N. diam (Fn n) < \" + shows "\x\S. \ (range Fn) = {x}" + using assms Cantor_intersection_theorem by(simp add: complete_metric_set_axioms) + +lemma(in complete_metric_set) closed_decseq_Inter: + assumes "\n. Fn n \ {}" "\n. closedin mtopology (Fn n)" "decseq Fn" + and "\\. \ > 0 \ \N. \n\N. diam (Fn n) < ennreal \" + shows "\x\S. \ (range Fn) = {x}" +proof - + have "\N. \n\N. diam (Fn n) < \" if "\ > 0" for \ + proof - + consider "\ < \" | "\ = \" + using top.not_eq_extremum by fastforce + then show ?thesis + proof cases + case 1 + with that have 2:"ennreal (enn2real \) = \" + by simp + have "0 < enn2real \" + using 1 that by(simp add: enn2real_positive_iff) + from assms(4)[OF this] show ?thesis + by(simp add: 2) + next + case 2 + then show ?thesis + by (metis assms(4) ennreal_less_top gt_ex infinity_ennreal_def order_less_imp_not_less top.not_eq_extremum) + qed + qed + thus ?thesis + using closed_decseq_Inter'[OF assms(1-3)] by simp +qed + +subsubsection \ Separable Metric Spaces \ +locale separable_metric_set = metric_set + + assumes separable: "\U. countable U \ dense_set U" + +lemma(in metric_set) separable_if_countable: + assumes "countable S" + shows "separable_metric_set S dist" + apply standard + using assms by(auto intro!: exI[where x=S] simp: dense_set_S) + +lemma(in metric_set) separable_iff_topological_separable: + "separable_metric_set S dist \ separable mtopology" + by(simp add: separable_metric_set_def separable_metric_set_axioms_def separable_def metric_set_axioms) + +lemma(in separable_metric_set) topological_separable_if_separable: + "separable mtopology" + using separable_iff_topological_separable + by (simp add: separable_metric_set_axioms) + +lemma separable_metric_setI: + assumes "metric_set S d" "separable (metric_set.mtopology S d)" + shows "separable_metric_set S d" + by (simp add: assms(1) assms(2) metric_set.separable_iff_topological_separable) + +text \ For a metric space $X$, $X$ is separable iff $X$ is second countable.\ +lemma(in metric_set) generated_by_countable_balls: + assumes "countable U" and "dense_set U" + shows "mtopology = topology_generated_by {open_ball y (1 / real n) | y n. y \ U}" +proof - + have hu: "U \ S" "\x \. x \ S \ \ > 0 \ open_ball x \ \ U \ {}" + using assms by(auto simp: dense_set_def) + show ?thesis + unfolding mtopology_def2 + proof(rule topology_generated_by_eq) + fix K + assume "K \ {open_ball y (1 / real n) |y n. y \ U}" + then obtain y n where hyn: + "y \ U" "y \ S" "K = open_ball y (1 / real n)" + using hu(1) by auto + consider "n = 0" | "n > 0" by auto + then show "openin (topology_generated_by {open_ball a \ |a \. a \ S \ 0 < \}) K" + proof cases + case 1 + then have "K = {}" + using hyn dist_geq0[of y] not_less by(auto simp: open_ball_def) + thus ?thesis + by auto + next + case 2 + then have "1 / real n > 0" by auto + thus ?thesis + using hyn mtopology_open_ball_in[simplified mtopology_def2] by auto + qed + next + have h0:"\x \. x \ S \ \ > 0 \ \y\U. \n. x \ open_ball y (1 / real n) \ open_ball y (1 / real n) \ open_ball x \" + proof - + fix x \ + assume h: "x \ S" "(0 :: real) < \" + then obtain N where hn: "1 / \ < real N" + using reals_Archimedean2 by blast + have hn0: "0 < real N" + by(rule ccontr) (use hn h in fastforce) + hence hn':"1 / real N < \" + using h hn by (metis divide_less_eq mult.commute) + have "open_ball x (1 / (2 * real N)) \ U \ {}" + using dense_set_def[of U] assms(2) h(1) hn0 by fastforce + then obtain y where hy: + "y\U" "y \ S" "y \ open_ball x (1 / (real (2 * N)))" + using hu by auto + show "\y\U. \n. x \ open_ball y (1 / real n) \ open_ball y (1 / real n) \ open_ball x \" + proof(intro bexI[where x=y] exI[where x="2 * N"] conjI) + show "x \ open_ball y (1 / real (2 * N))" + using hy(3) by(simp add: open_ball_inverse[of x y]) + next + show "open_ball y (1 / real (2 * N)) \ open_ball x \" + proof + fix y' + assume hy':"y' \ open_ball y (1 / real (2 * N))" + have "dist x y' < \" (is "?lhs < ?rhs") + proof - + have "?lhs \ dist x y + dist y y'" + using hy(2) open_ballD'(1)[OF hy'] h(1) by(auto intro!: dist_tr) + also have "... < 1 / real (2 * N) + 1 / real (2 * N)" + apply(rule strict_ordered_ab_semigroup_add_class.add_strict_mono) + using hy(3) hy(2) open_ballD'(1)[OF hy'] h(1) hy' by(simp_all add: open_ball_def dist_sym[of x y]) + finally show ?thesis + using hn' by auto + qed + thus "y' \ open_ball x \" + using open_ballD'(1)[OF hy'] h(1) by(simp add: open_ball_def) + qed + qed fact + qed + fix K + assume hk: "K \ {open_ball a \ |a \. a \ S \ 0 < \}" + then obtain x \x where hxe: + "x \ S" "0 < \x" "K = open_ball x \x" by auto + have gh:"K = (\{open_ball y (1 / real n) | y n. y \ U \ open_ball y (1 / real n) \ K})" + proof + show "K \ (\ {open_ball y (1 / real n) |y n. y \ U \ open_ball y (1 / real n) \ K})" + proof + fix k + assume hkink:"k \ K" + then have hkinS:"k \ S" + using open_ballD'(1)[of k] by(simp add: hxe) + obtain \k where hek: + "\k > 0" "open_ball k \k \ K" + using mtopology_open_ball_in'[of k x] hkink + by(auto simp: hxe) + obtain y n where hyey: + "y \ U" "k \ open_ball y (1 / real n)" "open_ball y (1 / real n) \ open_ball k \k" + using h0[OF hkinS hek(1)] by auto + show "k \ \ {open_ball y (1 / real n) |y n. y \ U \ open_ball y (1 / real n) \ K}" + using hek(2) hyey by blast + qed + qed auto + show "openin (topology_generated_by {open_ball y (1 / real n) |y n. y \ U}) K" + unfolding openin_topology_generated_by_iff + apply(rule generate_topology_on.UN[of "{open_ball y (1 / real n) |y n. y \ U \ open_ball y (1 / real n) \ K}", simplified gh[symmetric]]) + apply(rule generate_topology_on.Basis) by auto + qed +qed + +lemma(in separable_metric_set) second_countable': + "\\. countable \ \ mtopology_basis \" +proof - + obtain U where hu: + "countable U" "dense_set U" + using separable by auto + show ?thesis + proof(rule countable_base_from_countable_subbase[where \="{open_ball y (1 / real n) | y n. y \ U}",simplified second_countable_def]) + have "{open_ball y (1 / real n) |y n. y \ U} = (\(y,n). open_ball y (1 / real n)) ` (U \ UNIV)" + by auto + also have "countable ..." + using hu by auto + finally show "countable {open_ball y (1 / real n) |y n. y \ U}" . + qed (simp add: generated_by_countable_balls[OF hu] subbase_of_def) +qed + +lemma(in separable_metric_set) second_countable: "second_countable mtopology" + by(simp add: second_countable_def second_countable') + +lemma(in metric_set) separable_if_second_countable: + assumes "countable \" and "mtopology_basis \" + shows "separable_metric_set S dist" +proof + have 1:"mtopology = topology_generated_by {U \ \. U \ {}}" + by(simp add: topology_generated_by_without_empty[symmetric] base_is_subbase[OF assms(2),simplified subbase_of_def]) + have "\U \ {U \\. U \ {} }. \x. x \ U" + by auto + then have "\x. \U \ { U \ \. U \ {} }. x U \ U" + by(rule bchoice) + then obtain x where hx: + "\U \ { U \ \. U \ {} }. x U \ U" + by auto + show "\U. countable U \ dense_set U" + proof(intro exI[where x="{ x U | U. U \ \ \ U \ {}}"] conjI) + have "{x U |U. U \ \ \ U \ {}} = (\U. x U) ` { U \ \. U \ {} }" + by auto + also have "countable ..." + using assms(1) by auto + finally show "countable {x U |U. U \ \ \ U \ {}}" . + next + show "dense_set {x U |U. U \ \ \ U \ {}}" + unfolding dense_set_def + proof + have "\U. U \ \ \ U \ topspace mtopology" + using assms(2)[simplified base_of_def2'] + by(auto intro!: openin_subset) + then show "{x U |U. U \ \ \ U \ {}} \ S" + using hx by(auto simp add: mtopology_topspace) + next + show "\xa\S. \\>0. open_ball xa \ \ {x U |U. U \ \ \ U \ {}} \ {}" + proof safe + fix s \ + assume h:"s \ S" "(0::real) < \" "open_ball s \ \ {x U |U. U \ \ \ U \ {}} = {}" + then have "openin mtopology (open_ball s \)" + by(auto intro!: mtopology_open_ball_in) + moreover have "open_ball s \ \ {}" + using h open_ball_ina by blast + ultimately obtain U' where + "U'\\" "U' \ {}" "U' \ open_ball s \" + using assms(2)[simplified base_of_def] by fastforce + then have "x U' \ open_ball s \ \ {x U |U. U \ \ \ U \ {}}" + using hx by blast + with h show False + by auto + qed + qed + qed +qed + +lemma metric_generates_same_topology_separable_if: + assumes "metric_set S d" "metric_set S d'" + and "metric_set.mtopology S d = metric_set.mtopology S d'" + and "separable_metric_set S d" + shows "separable_metric_set S d'" +proof - + interpret m1: separable_metric_set S d by fact + interpret m2: metric_set S d' by fact + obtain \ where "countable \" "m1.mtopology_basis \" + using m1.second_countable' by auto + thus ?thesis + by(auto intro!: m2.separable_if_second_countable simp: assms(3)[symmetric]) +qed + +lemma metric_generates_same_topology_separable: + assumes "metric_set S d" "metric_set S d'" + and "metric_set.mtopology S d = metric_set.mtopology S d'" + shows "separable_metric_set S d \ separable_metric_set S d'" + using metric_generates_same_topology_separable_if[OF assms] metric_generates_same_topology_separable_if[OF assms(2,1) assms(3)[symmetric]] + by auto + +lemma(in metric_set) separable_if_totally_bounded: + assumes totally_boundedS + shows "separable_metric_set S dist" + unfolding separable_iff_topological_separable +proof - + have "\A. finite A \ A \ S \ S = \ ((\a. open_ball a (1 / real (Suc n))) ` A)" for n + using totally_boundedSD[OF assms,of "1 / Suc n"] by fastforce + then obtain A where A:"\n. finite (A n)" "\n. A n \ S" "\n. S = \ ((\a. open_ball a (1 / real (Suc n))) ` (A n))" + by metis + define K where "K \ \ (range A)" + have 1: "countable K" + using A(1) by(auto intro!: countable_UN[of _ id,simplified] simp: K_def countable_finite) + show "separable mtopology" + unfolding dense_set_def2 separable_def + proof(safe intro!: exI[where x=K] 1) + fix x and \ :: real + assume h: "x \ S" "0 < \" + then obtain n where n:"1 / real (Suc n) \ \" + by (meson nat_approx_posE order.strict_iff_not) + then obtain y where y: "y \ A n" "x \ open_ball y (1 / real (Suc n))" + using h(1) A(3)[of n] by auto + then show "\y\K. dist x y < \" + using open_ballD[OF y(2)] n by(auto intro!: bexI[where x=y] simp: dist_sym[of y x] K_def) + qed(use K_def A(2) in auto) +qed + +lemma second_countable_metric_class_separable_set: + "separable_metric_set (UNIV :: 'a ::{metric_space,second_countable_topology} set) dist" +proof - + interpret m: metric_set UNIV dist + by(rule metric_class_metric_set) + obtain B :: "'a set set" where "countable B \ topological_basis B" + using second_countable_topology_class.ex_countable_basis by auto + then show ?thesis + by(auto intro!: m.separable_if_second_countable[where \=B] simp: topological_basis_set) +qed + +lemma second_countable_euclidean[simp]: + "second_countable (euclidean :: 'a :: {metric_space,second_countable_topology} topology)" + by (metis euclidean_mtopology second_countable_metric_class_separable_set separable_metric_set.second_countable) + +lemma separable_euclidean[simp]: + "separable (euclidean :: 'a :: {metric_space,second_countable_topology} topology)" + by(auto intro!: separable_if_second_countable) + +lemma(in separable_metric_set) submetric_separable: + assumes "S' \ S" + shows "separable_metric_set S' (submetric S' dist)" +proof - + interpret m: metric_set S' "submetric S' dist" + by(rule submetric_metric_set[OF assms]) + obtain \ where ho:"countable \" "mtopology_basis \" + using second_countable' by auto + show ?thesis + proof(rule m.separable_if_second_countable[where \="{S' \ U | U. U\\}"]) + show "countable {S' \ U |U. U \ \}" + using countable_image[where f="(\) S'",OF ho(1)] + by (simp add: Setcompr_eq_image) + next + show "m.mtopology_basis {S' \ U |U. U \ \}" + by(auto simp: submetric_subtopology[OF assms,symmetric] intro!: subtopology_base_of ho(2)) + qed +qed + +lemma(in separable_metric_set) Lindelof_diam: + assumes "0 < e" + shows "\U. countable U \ \ U = S \ (\u\U. diam u < ennreal e)" +proof - + have "(\u. u \ {open_ball x (e / 3) |x. x \ S} \ openin mtopology u)" + by(auto simp: openin_open_ball) + moreover have "\ {open_ball x (e / 3) |x. x \ S} = S" + using open_ball_ina open_ball_subset_ofS assms by auto + ultimately have "\U'. countable U' \ U' \ {open_ball x (e / 3) |x. x \ S} \ \ U' = S" + by(rule Lindelof_of[OF second_countable,simplified mtopology_topspace]) auto + then obtain U' where U': "countable U'" "U' \ {open_ball x (e / 3) |x. x \ S}" "\ U' = S" + by auto + show ?thesis + proof(safe intro!: exI[where x=U']) + fix u + assume "u \ U'" + then obtain x where u:"u = open_ball x (e / 3)" + using U' by auto + have "diam u \ ennreal (2 * (e / 3))" + by(simp only: u diam_ball_leq) + also have "... < ennreal e" + by(auto intro!: ennreal_lessI assms) + finally show "diam u < ennreal e" . + qed(use U' in auto) +qed + +subsubsection \ Polish Metric Spaces \ +locale polish_metric_set = complete_metric_set + separable_metric_set + +lemma polish_class_polish_set[simp]: + "polish_metric_set (UNIV :: 'a :: polish_space set) dist" + using second_countable_metric_class_separable_set complete_space_complete_metric_set + by(simp add: polish_metric_set_def) + +lemma(in polish_metric_set) submetric_polish: + assumes "M \ S" and "closedin mtopology M" + shows "polish_metric_set M (submetric M dist)" + using submetric_separable[OF assms(1)] submetric_complete_iff[OF assms(1)] + by(simp add: polish_metric_set_def assms(2)) + +lemma polish_metric_setI: + assumes "complete_metric_set S d" "separable (metric_set.mtopology S d)" + shows "polish_metric_set S d" + using assms by(auto intro!: separable_metric_setI simp: polish_metric_set_def complete_metric_set_def) + +subsubsection \ Compact Metric Spaces\ +locale compact_metric_set = metric_set + + assumes mtopology_compact:"compact_space mtopology" +begin + +context + fixes S' :: "'b set" and dist' + assumes S'_dist: "metric_set S' dist'" +begin + +interpretation m': metric_set S' dist' by fact + +lemma continuous_map_is_uniform: + assumes "continuous_map mtopology m'.mtopology f" + shows "uniform_continuous_map S dist S' dist' f" + unfolding uniform_continuous_map_def[OF metric_set_axioms m'.metric_set_axioms] +proof safe + show goal1:"\x. x \ S \ f x \ S'" + using assms by(auto simp: continuous_map_def mtopology_topspace m'.mtopology_topspace) + fix e :: real + assume e:"0 < e" + { fix x + assume x:"x \ S" + then have "\\>0. \y\S. dist x y < \ \ dist' (f x) (f y) < e / 2" + using assms(1)[simplified metric_set_continuous_map_eq[OF metric_set_axioms m'.metric_set_axioms]] half_gt_zero[OF e] + by metis + } + then obtain \ where delta:"\x. x \ S \ \ x > 0" "\x y. x \ S \ y \ S \ dist x y < \ x \ dist' (f x) (f y) < e / 2" + by metis + show "\\>0. \x\S. \y\S. dist x y < \ \ dist' (f x) (f y) < e" + proof(cases "S = {}") + case True + then show ?thesis + by (auto intro!: exI[where x=1]) + next + case nem:False + have "\\. finite \ \ \ \ {open_ball x (\ x / 2)|x. x \ S} \ S \ \ \" + using open_ball_ina[OF _ half_gt_zero[OF delta(1)]] mtopology_compact + by(auto intro!: compactinD simp: compact_space_def mtopology_topspace openin_open_ball) + then obtain F where F: "finite F" "F \ {open_ball x (\ x / 2)|x. x \ S}" "S \ \ F" + by auto + have F_nem:"F \ {}" + using nem F by auto + have "a \ F \ (\x\S. a = open_ball x (\ x / 2))" for a + using F(2) by auto + then obtain xa where xa:"\a. a \ F \ xa a \ S" "\a. a \ F \ a = open_ball (xa a) (\ (xa a) / 2)" + by metis + define \' where "\' \ (MIN a\F. \ (xa a) / 2)" + have fin:"finite ((\a. \ (xa a)/ 2) ` F)" + using F by auto + have nemd: "((\a. \ (xa a)/ 2) ` F) \ {}" + using F_nem by auto + have d_pos: "\' > 0" + by(auto simp: \'_def linorder_class.Min_gr_iff[OF fin nemd] intro!: delta(1) xa) + show ?thesis + proof(safe intro!: exI[where x=\']) + fix x y + assume h:"x \ S" "y \ S" "dist x y < \'" + then obtain a where a:"x \ a" "a \ F" + using F(3) by auto + have "dist (xa a) y \ dist (xa a) x + dist x y" + by(auto intro!: dist_tr xa a simp: h) + also have "... < \' + \ (xa a) / 2" + using h xa(2)[OF a(2)] a(1) open_ballD[of x "xa a"] by fastforce + also have "... \ \ (xa a) / 2 + \ (xa a) / 2" + proof - + have "\' \ \ (xa a) / 2" + by(simp only: \'_def,rule Min.coboundedI[OF fin]) (use a in auto) + thus ?thesis by simp + qed + finally have 2:"dist (xa a) y < \ (xa a)" by simp + have "dist' (f x) (f y) \ dist' (f x) (f (xa a)) + dist' (f (xa a)) (f y)" + by(auto intro!: m'.dist_tr goal1 h xa a) + also have "... < e" + proof - + have [simp]:"dist (xa a) x < \ (xa a)" + using a(1) xa[OF a(2)] delta(1) open_ballD by fastforce + have "dist' (f x) (f (xa a)) < e / 2" + by(simp only: m'.dist_sym[where x="f x"],rule delta(2)) (auto intro!: xa a h) + moreover have "dist' (f (xa a)) (f y) < e / 2" + by(rule delta(2)[OF _ _ 2]) (auto intro!: h xa a) + ultimately show ?thesis by simp + qed + finally show "dist' (f x) (f y) < e" . + qed(rule d_pos) + qed +qed + +end + + +lemma totally_bounded: totally_boundedS + unfolding totally_boundedS_def +proof safe + fix \ :: real + assume "0 < \" + define \ where "\ \ (\a. open_ball a \) ` S" + have 1: "\U. U \ \ \ openin mtopology U" + by(auto simp: \_def openin_open_ball) + have 2:"\ \ = S" + using open_ball_ina[OF _ \0 < \\] open_ball_subset_ofS + by(auto simp: \_def) + obtain \ where "\ \ \" "finite \" "\ \ = S" + using 1 2 compact_space[of mtopology,simplified mtopology_compact mtopology_topspace] by metis + then obtain A where "A \ S" "finite A" "\ ((\a. open_ball a \) ` A) = S" + by(simp add: \_def) (metis finite_subset_image) + thus "\A. eps_net \ A" + by(auto intro!: exI[where x=A] simp: eps_net_def \0 < \\) +qed + +lemma sequentially_compact: sequentially_compact + unfolding sequentially_compact_def +proof safe + fix xn + assume "xn \ sequence" + then have xn:"\n. xn n \ S" by auto + have "\ (\x\S. \e>0. finite {n. xn n \ open_ball x e})" + proof + assume contr:"\x\S. \e>0. finite {n. xn n \ open_ball x e}" + then obtain e where e: "\x. x \ S \ e x > 0" "\x. x \ S \ finite {n. xn n \ open_ball x (e x)}" + by metis + define U where "U \ {open_ball x (e x)|x. x \ S}" + have "\u. u \ U \ openin mtopology u" "topspace mtopology \ \U" + by(auto simp: U_def openin_open_ball mtopology_topspace open_ball_ina[OF _ e(1)]) + then obtain F where F: "finite F" "F \ U" "S \ \ F" + using mtopology_compact compactinD by (metis compact_space_def mtopology_topspace) + then have "finite (\f\F. {n. xn n \ f})" + using e(2) by(auto simp: U_def) + moreover have "UNIV = (\f\F. {n. xn n \ f})" + using F(3) xn by auto + ultimately show False by simp + qed + then obtain x where x:"x \ S" "\e. e > 0 \ infinite {n. xn n \ open_ball x e}" + by metis + have inf:"infinite {n. n > m \ xn n \ open_ball x e}" if "e > 0" for e m + proof + assume "finite {n. m < n \ xn n \ open_ball x e}" + then have "finite ({..m} \ {n. m < n \ xn n \ open_ball x e})" + by auto + moreover have "{n. xn n \ open_ball x e} \ {..m} \ {n. m < n \ xn n \ open_ball x e}" + by auto + ultimately show False + using x(2)[OF that] finite_subset by blast + qed + define a where "a \ rec_nat (SOME n. xn n \ open_ball x 1) (\n an. SOME m. m > an \ xn m \ open_ball x (1 / Suc n))" + have an: "xn (a n) \ open_ball x (1 / n)" if "n > 0" for n + proof(cases n) + case 0 + with that show ?thesis by simp + next + case (Suc n) + have [simp]:"a (Suc n) = (SOME m. m > a n \ xn m \ open_ball x (1 / Suc n))" + by(auto simp: a_def) + obtain m where m:"a n < m" "xn m \ open_ball x (1 / (Suc n))" + using inf[of "1 / (real (Suc n))" "a n"] not_finite_existsD by auto + have "a (Suc n) > a n \ xn (a (Suc n)) \ open_ball x (1 / (Suc n))" + by(simp,rule someI2[of _ m]) (use m in auto) + then show ?thesis + by(simp only: Suc) + qed + have as:"strict_mono a" + unfolding strict_mono_Suc_iff + proof safe + fix n + have [simp]:"a (Suc n) = (SOME m. m > a n \ xn m \ open_ball x (1 / Suc n))" + by(auto simp: a_def) + obtain m where m:"a n < m" "xn m \ open_ball x (1 / (Suc n))" + using inf[of "1 / (real (Suc n))" "a n"] not_finite_existsD by auto + have "a (Suc n) > a n \ xn (a (Suc n)) \ open_ball x (1 / (Suc n))" + by(simp,rule someI2[of _ m]) (use m in auto) + thus "a n < a (Suc n)" by simp + qed + show "\a. strict_mono a \ convergent_inS (xn \ a)" + unfolding convergent_inS_def converge_to_inS_def2' + proof(safe intro!: exI[where x=a] exI[where x=x]) + fix e :: real + assume "0 < e" + then obtain N ::nat where N: "N > 0" "1 / N < e" + by (meson nat_approx_posE zero_less_Suc) + show "\N. \n\N. (xn \ a) n \ open_ball x e" + proof(safe intro!: exI[where x=N]) + fix n + assume n:"n \ N" + show "(xn \ a) n \ open_ball x e" + using order.trans[OF open_ball_le[of "1 / n"] open_ball_le[of "1 / N" e]] N n an[of n] inverse_of_nat_le + by auto + qed + qed(auto simp: simp: as x xn) +qed + +lemma polish: "polish_metric_set S dist" + using separable_if_totally_bounded[OF totally_bounded] + by(simp add: polish_metric_set_def complete_metric_set_def complete_metric_set_axioms_def separable_metric_set_def) + (meson Cauchy_inS_def converge_if_Cauchy_and_subconverge convergent_inS_def sequentially_compact sequentially_compact_def) + +sublocale polish_metric_set + by(rule polish) + +end + +lemma(in metric_set) ex_lebesgue_number: + assumes "S \ {}" sequentially_compact "\u. u \ U \ openin mtopology u" "S \ \ U" + shows "\d>0. \a\S. diam a < ennreal d \ (\u\U. a \ u)" +proof(rule ccontr) + assume "\ (\d>0. \a\S. diam a < ennreal d \ (\u\U. a \ u))" + then have "\n. \a\S. diam a < ennreal (1 / Suc n) \ (\x\U. \ a \ x)" by auto + then obtain An where an: "\n. An n \ S" "\n. diam (An n) < ennreal (1 / Suc n)" "\n u. u \ U \ \ (An n) \ u" + by metis + have "An n \ {}" for n + proof + assume "An n = {}" + then have "U = {} \ (\u\U. u = {})" + using an(3)[of _ n] by auto + thus False + using assms(1,4) by blast + qed + then obtain xn where xn:"\n. xn n \ An n" + by (meson ex_in_conv) + then have xn':"\n. xn n \ S" using an by auto + then obtain a x where ax:"strict_mono a" "converge_to_inS (xn \ a) x" + using assms(2) by(fastforce simp: sequentially_compact_def convergent_inS_def) + then have x: "x \ S" by(auto simp: converge_to_inS_def) + then obtain u where u:"x \ u" "u \ U" + using assms(4) by auto + obtain e where e:"e > 0" "open_ball x e \ u" + using assms(3)[OF u(2)] u(1) mtopology_openin_iff by fastforce + obtain n ::nat where n: "1 / Suc n < e / 2" + using e(1) half_gt_zero nat_approx_posE by blast + obtain n' where n':"\n. n \ n' \ xn (a n) \ open_ball x (e / 2)" + using e(1) ax(2) by(auto simp: converge_to_inS_def2') (meson half_gt_zero) + define n0 where "n0 \ max (a (Suc n)) (a n')" + have n0:"1 / Suc n0 < e / 2" "xn n0 \ open_ball x (e / 2)" + proof - + have "Suc n0 \ Suc n" + using seq_suble[OF ax(1),of "Suc n"] by (simp add: n0_def) + hence "1 / Suc n0 \ 1 / Suc n" + using inverse_of_nat_le by blast + thus "1 / Suc n0 < e / 2" + using n by auto + show "xn n0 \ open_ball x (e / 2)" + by (cases "a (Suc n) \ a n'") (auto intro!: n' simp: n0_def ax(1) strict_mono_less_eq) + qed + have "An n0 \ open_ball x e" + unfolding open_ball_def + proof safe + fix y + assume y:"y \ An n0" + have "dist x y \ dist x (xn n0) + dist (xn n0) y" + using y xn' an by(auto intro!: dist_tr simp: x) + also have "... < e / 2 + dist (xn n0) y" + using open_ballD[OF n0(2)] by auto + also have "... \ e / 2 + 1 / Suc n0" + using xn[of n0] xn' y an by(auto intro!: diam_is_sup'[OF _ _ order.strict_implies_order[OF an(2)[of n0]],simplified]) + also have "... < e" + using n0(1) by auto + finally show "y \ (if x \ S then {xa \ S. dist x xa < e} else {})" + using an(1) x y by auto + qed + hence "An n0 \ u" + using e by auto + with an(3)[OF u(2)] show False by auto +qed + +lemma(in metric_set) sequentially_compact_iff1: + "sequentially_compact \ totally_boundedS \ complete_metric_set S dist" +proof safe + assume h:sequentially_compact + then show totally_boundedS + using Cauchy_if_convergent_inS by(fastforce simp: totally_boundedS_iff sequentially_compact_def) + show "complete_metric_set S dist" + proof + fix xn + assume 1:"Cauchy_inS xn" + with h obtain a x where 2:"strict_mono a" "converge_to_inS (xn \ a) x" + by(fastforce dest: Cauchy_inS_dest1 simp: sequentially_compact_def convergent_inS_def) + thus "convergent_inS xn" + by(auto simp: convergent_inS_def converge_if_Cauchy_and_subconverge[OF 2 1] intro!: exI[where x=x]) + qed +next + assume h:"totally_boundedS" "complete_metric_set S dist" + show sequentially_compact + unfolding sequentially_compact_def + proof safe + fix xn + assume "xn \ sequence" + then obtain a where a:"strict_mono a" "Cauchy_inS (xn \ a)" + using h by(auto simp: totally_boundedS_iff) + thus "\a. strict_mono a \ convergent_inS (xn \ a)" + using h by(auto intro!: exI[where x=a] simp: complete_metric_set_def complete_metric_set_axioms_def) + qed +qed + +lemma(in metric_set) sequentially_compact_compact: + assumes sequentially_compact + shows "compact_metric_set S dist" +proof + show "compact_space mtopology" + proof(cases "S = {}") + case True + have [simp]:"topspace mtopology = {}" + by(simp add: mtopology_topspace,fact) + show ?thesis + by(auto simp: compact_space intro!: exI[where x="{}"]) + next + case 1:False + { + fix U + assume h:"\u. u \ U \ openin mtopology u" "S \ \ U" + obtain d where d:"d > 0" "\a. a \ S \ diam a < ennreal d \ \u\U. a \ u" + using ex_lebesgue_number[OF 1 assms h] by metis + obtain B where B:"finite B" "B \ S" "S = (\a\B. open_ball a (d / 3))" + using totally_boundedSD[of "d / 3"] d(1) assms + by(auto simp: sequentially_compact_iff1) + have "\u\U. open_ball b (d / 3) \ u" if "b \ B" for b + using open_ballD' d(1) by(auto intro!: d(2) order.strict_trans1[OF diam_ball_leq[of b "d / 3"]] simp: ennreal_less_iff) + then obtain u where u:"\b. b \ B \ u b \ U" "\b. b \ B \ open_ball b (d / 3) \ u b" + by metis + have "\F. finite F \ F \ U \ S \ (\ F)" + using B u by(fastforce intro!: exI[where x="u ` B"]) + } + thus ?thesis + by (simp add: compact_space_alt mtopology_topspace) + qed +qed + +corollary(in metric_set) compact_iff_sequentially_compact: +"compact_space mtopology \ sequentially_compact" + using compact_metric_set.sequentially_compact sequentially_compact_compact compact_metric_set_axioms_def compact_metric_set_def metric_set_axioms + by blast + +corollary(in metric_set) compact_iff2: +"compact_space mtopology \ totally_boundedS \ complete_metric_set S dist" + by(simp add: compact_iff_sequentially_compact sequentially_compact_iff1) + +corollary(in complete_metric_set) compactin_closed_iff: + assumes "closedin mtopology C" + shows "compactin mtopology C \ totally_bounded_on C" +proof - + from assms have C:"C \ S" + using mtopology_closedin_iff by blast + then interpret C: complete_metric_set C "submetric C dist" + by(auto simp: submetric_complete_iff assms) + show ?thesis + by(simp add: compactin_subspace submetric_subtopology[OF C] totally_bounded_on_submetric[OF C] mtopology_topspace C C.compact_iff2 C.complete_metric_set_axioms) +qed + +subsubsection \ Completion \ +context metric_set +begin + +abbreviation "Cauchys \ Collect Cauchy_inS" + +definition Cauchy_r :: "((nat \ 'a) \ (nat \ 'a)) set" where +"Cauchy_r \ {(xn,yn)|xn yn. Cauchy_inS xn \ Cauchy_inS yn \ (\n. dist (xn n) (yn n)) \ 0}" + +lemma Cauchy_r_equiv[simp]: "equiv Cauchys Cauchy_r" +proof(rule equivI) + show "refl_on Cauchys Cauchy_r" + by(auto simp: refl_on_def Cauchy_r_def) +next + show "sym Cauchy_r" + using dist_sym by(auto simp: sym_def Cauchy_r_def) +next + show "trans Cauchy_r" + proof(rule transI) + show "\x y z. (x, y) \ Cauchy_r \ (y, z) \ Cauchy_r \ (x, z) \ Cauchy_r" + unfolding Cauchy_r_def + proof safe + fix xn yn zn + assume h:"Cauchy_inS xn" "Cauchy_inS yn" "Cauchy_inS zn" + "(\n. dist (xn n) (yn n)) \ 0" "(\n. dist (yn n) (zn n)) \ 0" + then show "\xn' yn'. (xn, zn) = (xn', yn') \ Cauchy_inS xn' \ Cauchy_inS yn' \ (\n. dist (xn' n) (yn' n)) \ 0" + by(auto intro!: tendsto_0_le[OF tendsto_add_zero[OF h(4,5)],of _ 1] dist_tr eventuallyI simp: dist_geq0 Cauchy_inS_dest1) + qed + qed +qed + +abbreviation S_completion :: "(nat \ 'a) set set" ("S\<^sup>*") where +"S_completion \ Cauchys // Cauchy_r" + +lemma S_c_represent: + assumes "X \ S\<^sup>*" + obtains xn where "xn \ X" "Cauchy_inS xn" + using equiv_Eps_in[OF _ assms] equiv_Eps_preserves[OF _ assms] by auto + +lemma Cauchy_inS_ignore_initial_eq: + assumes "Cauchy_inS xn" + shows "(xn, (\n. xn (n + k))) \ Cauchy_r" + by(auto simp: Cauchy_r_def Cauchy_inS_ignore_initial[OF assms] assms,insert assms) + (auto simp: LIMSEQ_def dist_real_def dist_geq0 Cauchy_inS_def,metis add.commute trans_le_add2) + +corollary Cauchy_inS_r: "a \ S \ (\n. a, \n. a) \ Cauchy_r" + by(auto intro!: Cauchy_inS_ignore_initial_eq Cauchy_inS_const) + +abbreviation dist_completion' :: "[nat \ 'a, nat \ 'a] \ real" where +"dist_completion' xn yn \ lim (\n. dist (xn n) (yn n))" + +lemma dist_of_completion_congruent2: "dist_completion' respects2 Cauchy_r" +proof(safe intro!: congruent2_commuteI[OF Cauchy_r_equiv]) + fix xn yn zn + assume h:"(xn,yn) \ Cauchy_r" "Cauchy_inS zn" + then have h':"Cauchy_inS xn" "Cauchy_inS yn" "(\n. dist (xn n) (yn n)) \ 0" + by(auto simp: Cauchy_r_def) + have 1:"(\n. dist (zn n) (xn n)) \ lim (\n. dist (zn n) (xn n))" + using Cauchy_inS_dist_convergent[OF h(2) h'(1)] by(simp add: convergent_LIMSEQ_iff) + have 2:"(\n. dist (zn n) (yn n)) \ lim (\n. dist (zn n) (xn n))" + using h(2) h'(1,2) dist_tr_abs[of "zn _" "xn _" "yn _",simplified abs_diff_le_iff] + by(auto intro!: real_tendsto_sandwich[OF _ _ tendsto_diff[OF 1 h'(3),simplified] tendsto_add[OF 1 h'(3),simplified]] eventuallyI dist_tr dest: Cauchy_inS_dest1) (simp add: Cauchy_inS_dest1 add.commute diff_le_eq) + show "dist_completion' zn xn = dist_completion' zn yn" + using 1 2 by(auto dest: limI) +qed(auto simp: dist_sym) + +definition dist_completion :: "[(nat \ 'a) set, (nat \ 'a) set] \ real" ("dist\<^sup>*") where +"dist\<^sup>* X Y \ (if X \ S\<^sup>* \ Y \ S\<^sup>* then dist_completion' (SOME xn. xn \ X) (SOME yn. yn \ Y) else 0)" + +lemma dist_c_def: + assumes "xn \ X" "yn \ Y" "X \ S\<^sup>*" "Y \ S\<^sup>*" + shows "dist\<^sup>* X Y = dist_completion' xn yn" + by(auto simp: assms dist_completion_def,rule someI2[of "\x. x \ X",OF assms(1)],rule someI2[of "\x. x \ Y",OF assms(2)]) + (auto simp: congruent2D[OF dist_of_completion_congruent2 quotient_eq_iff[OF _ assms(3,3,1),simplified] quotient_eq_iff[OF _ assms(4,4,2),simplified]]) + + +lemma completion_metric_set: "metric_set S\<^sup>* dist\<^sup>*" +proof + fix X Y + consider "X \ S\<^sup>*" "Y \ S\<^sup>*" | "X \ S\<^sup>*" | "Y \ S\<^sup>*" by blast + then show "0 \ dist\<^sup>* X Y" + proof cases + case 1 + then obtain xn yn where h: "xn \ X" "yn \ Y" "Cauchy_inS xn" "Cauchy_inS yn" + by (meson S_c_represent) + with 1 show ?thesis + by(auto simp: dist_c_def intro!: Lim_bounded2[OF Cauchy_inS_dist_convergent[OF h(3,4),simplified convergent_LIMSEQ_iff]] dist_geq0) + qed(auto simp: dist_completion_def) +next + fix X Y + show "dist\<^sup>* X Y = dist\<^sup>* Y X" + by(auto simp: dist_completion_def dist_sym) +next + fix X Y + assume h:"X \ S\<^sup>*" "Y \ S\<^sup>*" + then obtain xn yn where h': "xn \ X" "yn \ Y" "Cauchy_inS xn" "Cauchy_inS yn" + by (meson S_c_represent) + show "X = Y \ dist\<^sup>* X Y = 0" + proof + assume "X = Y" + then show "dist\<^sup>* X Y = 0" + using h' h by(auto simp: dist_c_def) + next + assume "dist\<^sup>* X Y = 0" + then have "(xn, yn) \ Cauchy_r" + using h h' convergent_LIMSEQ_iff[THEN iffD1,OF Cauchy_inS_dist_convergent[OF h'(3,4)]] + by(auto simp: dist_c_def Cauchy_r_def) + thus "X = Y" + by(simp add: quotient_eq_iff[OF _ h h'(1,2)]) + qed +next + fix X Y Z + assume h:"X \ S\<^sup>*" "Y \ S\<^sup>*" "Z \ S\<^sup>*" + then obtain xn yn zn where h': "xn \ X" "yn \ Y" "zn \ Z" "Cauchy_inS xn" "Cauchy_inS yn" "Cauchy_inS zn" + by (meson S_c_represent) + have "dist\<^sup>* X Z = dist_completion' xn zn" + using h h' by(simp add: dist_c_def) + also have "... \ lim (\n. dist (xn n) (yn n) + dist (yn n) (zn n))" + using h' by(auto intro!: lim_mono[OF _ convergent_LIMSEQ_iff[THEN iffD1,OF Cauchy_inS_dist_convergent[OF h'(4,6)]] convergent_LIMSEQ_iff[THEN iffD1,OF convergent_add[OF Cauchy_inS_dist_convergent[OF h'(4,5)] Cauchy_inS_dist_convergent[OF h'(5,6)]]]] dist_tr dest: Cauchy_inS_dest1) + also have "... = dist_completion' xn yn + dist_completion' yn zn" + using tendsto_add[OF convergent_LIMSEQ_iff[THEN iffD1,OF Cauchy_inS_dist_convergent[OF h'(4,5)]] convergent_LIMSEQ_iff[THEN iffD1,OF Cauchy_inS_dist_convergent[OF h'(5,6)]]] + by(simp add: limI) + also have "... = dist\<^sup>* X Y + dist\<^sup>* Y Z" + using h h' by(simp add: dist_c_def) + finally show "dist\<^sup>* X Z \ dist\<^sup>* X Y + dist\<^sup>* Y Z" . +qed(simp add: dist_completion_def) + +interpretation c:metric_set "S\<^sup>*" "dist\<^sup>*" + by(rule completion_metric_set) + +definition into_S_c :: "'a \ (nat \ 'a) set" where +"into_S_c a \ Cauchy_r `` {(\n. a)}" + +lemma into_S_c_in: + assumes "a \ S" + shows "(\n. a) \ into_S_c a" + using Cauchy_inS_const[OF assms] Cauchy_inS_r[OF assms] + by(auto simp: into_S_c_def) + +lemma into_S_c_into: + assumes "a \ S" + shows "into_S_c a \ S\<^sup>*" + by(auto simp: into_S_c_def intro!: quotientI Cauchy_if_convergent_inS convergent_inS_const assms) + +lemma into_S_inj: "inj_on into_S_c S" +proof + fix x y + assume "x \ S" "y \ S" "into_S_c x = into_S_c y" + with eq_equiv_class_iff[THEN iffD1,OF Cauchy_r_equiv _ _ this(3)[simplified into_S_c_def]] + have "(\n. x, \n. y) \ Cauchy_r" + by(auto simp: Cauchy_if_convergent_inS convergent_inS_const) + thus "x = y" + using dist_0[OF \x \ S\ \y \ S\] + by(auto simp: Cauchy_r_def LIMSEQ_const_iff) +qed + +lemma dist_into_S_c: + assumes "x \ S" "y \ S" + shows "dist\<^sup>* (into_S_c x) (into_S_c y) = dist x y" + using into_S_c_in[OF assms(1)] into_S_c_in[OF assms(2)] into_S_c_into[OF assms(1)] into_S_c_into[OF assms(2)] + by(simp add: dist_c_def) + +lemma S_c_isometry: + "c.ed into_S_c S = dist" + by standard+ (auto simp: c.embed_dist_on_def dist_into_S_c dist_notin dist_notin') + +corollary mtopology_embedding_S_c_map: + "homeomorphic_map mtopology (subtopology c.mtopology (into_S_c ` S)) into_S_c" + using into_S_c_into by(auto intro!: c.embed_dist_topology_homeomorphic_map[OF _ into_S_inj,simplified S_c_isometry]) + +corollary mtopology_embedding_S_c: + "mtopology homeomorphic_space subtopology c.mtopology (into_S_c ` S)" + using mtopology_embedding_S_c_map homeomorphic_space by blast + +lemma into_S_c_image_dense: "c.dense_set (into_S_c ` S)" + unfolding c.dense_set_def2' +proof safe + fix X + assume X:"X \ S\<^sup>*" + from S_c_represent[OF this] obtain xn where xn:"xn \ X" "Cauchy_inS xn" + by auto + show "\f\UNIV \ into_S_c ` S. c.converge_to_inS f X" + proof(safe intro!: bexI[where x="\n. into_S_c (xn n)"]) + show "c.converge_to_inS (\n. into_S_c (xn n)) X" + unfolding c.converge_to_inS_def2 + proof safe + fix e :: real + assume e:"e > 0" + then obtain N where N:"\n m. n \ N \ m \ N \ dist (xn n) (xn m) < e / 2" + using xn(2) by (meson Cauchy_inS_def half_gt_zero) + show "\N. \n\N. dist\<^sup>* (into_S_c (xn n)) X < e" + proof(safe intro!: exI[where x=N]) + fix n + assume n:"N \ n" + have "dist\<^sup>* (into_S_c (xn n)) X = dist_completion' (\na. xn n) xn" + by(rule dist_c_def[OF into_S_c_in[OF Cauchy_inS_dest1[OF xn(2),of n]] xn(1) into_S_c_into[OF Cauchy_inS_dest1[OF xn(2),of n]] X]) + also have "... \ e / 2" + by(rule Lim_bounded[OF Cauchy_inS_dist_convergent[OF Cauchy_inS_const[OF Cauchy_inS_dest1[OF xn(2),of n]] xn(2),simplified convergent_LIMSEQ_iff],of N "e/2"],auto dest: N[OF n]) + also have "... < e" + using e by auto + finally show "dist\<^sup>* (into_S_c (xn n)) X < e" . + qed + qed(auto simp: Cauchy_inS_dest1[OF xn(2)] into_S_c_into X) + qed(auto simp: Cauchy_inS_dest1[OF xn(2)] into_S_c_into) +qed (use into_S_c_into in auto) + +lemma completion_complete:"complete_metric_set S\<^sup>* dist\<^sup>*" +proof + fix Xn + assume h:"c.Cauchy_inS Xn" + have "\n. \xn\S. dist\<^sup>* (Xn n) (into_S_c xn) < 1 / (Suc n)" + using into_S_c_image_dense c.Cauchy_inS_dest1[OF h] + by(auto simp: c.dense_set_def2) + then obtain xn where xn: "\n. xn n \ S" "\n. dist\<^sup>* (Xn n) (into_S_c (xn n)) < 1 / (Suc n)" + by metis + have xnC:"Cauchy_inS xn" + unfolding Cauchy_inS_def + proof safe + fix e :: real + assume e:"0 < e" + then obtain N1 where N1: "1 / Suc N1 < e / 3" + by (meson nat_approx_posE zero_less_divide_iff zero_less_numeral) + obtain N2 where N2: "\n m. n \ N2 \ m \ N2 \ dist\<^sup>* (Xn n) (Xn m) < e / 3" + using e h by(simp only: c.Cauchy_inS_def) (meson zero_less_divide_iff zero_less_numeral) + show "\N. \n\N. \m\N. dist (xn n) (xn m) < e" + proof(safe intro!: exI[where x="max N1 N2"]) + fix n m + assume "max N1 N2 \ n" "max N1 N2 \ m" + hence n: "N1 \ n" "N2 \ n" + and m: "N1 \ m" "N2 \ m" by auto + have "dist (xn n) (xn m) = c.ed into_S_c S (xn n) (xn m)" + by(simp add: S_c_isometry) + also have "... = dist\<^sup>* (into_S_c (xn n)) (into_S_c (xn m))" + using xn by(simp add: c.embed_dist_on_def) + also have "... \ dist\<^sup>* (into_S_c (xn n)) (Xn n) + dist\<^sup>* (Xn n) (Xn m) + dist\<^sup>* (Xn m) (into_S_c (xn m))" + using c.dist_tr[OF into_S_c_into[OF xn(1)[of n]] c.Cauchy_inS_dest1[OF h,of m] into_S_c_into[OF xn(1)[of m]]] c.dist_tr[OF into_S_c_into[OF xn(1)[of n]] c.Cauchy_inS_dest1[OF h,of n] c.Cauchy_inS_dest1[OF h,of m]] + by simp + also have "... < 1 / Suc n + e / 3 + 1 / Suc m" + using N2[OF n(2) m(2)] xn(2)[of m] xn(2)[of n,simplified c.dist_sym[of "Xn n"]] by auto + also have "... < e" + proof - + have "1 / Suc n \ 1 / Suc N1" "1 / Suc m \ 1 / Suc N1" + using n m inverse_of_nat_le by blast+ + thus ?thesis + using N1 by linarith + qed + finally show "dist (xn n) (xn m) < e" . + qed + qed(simp add: xn) + show "c.convergent_inS Xn" + unfolding c.convergent_inS_def c.converge_to_inS_def2 + proof(safe intro!: exI[where x="Cauchy_r `` {xn}"] quotientI xnC) + fix e :: real + assume e:"0 < e" + then obtain N1 where N1: "1 / Suc N1 < e / 2" + by (meson nat_approx_posE zero_less_divide_iff zero_less_numeral) + hence 1:"dist\<^sup>* (Xn n) (into_S_c (xn n)) < e / 2" if "n \ N1" for n + proof - + have "1 / Suc n \ 1 / Suc N1" + using that inverse_of_nat_le by blast + thus ?thesis + using xn(2)[of n] N1 by linarith + qed + then obtain N2 where N2:"\n m. n \ N2 \ m \ N2 \ dist (xn n) (xn m) < e / 3" + using xnC e by (meson Cauchy_inS_def zero_less_divide_iff zero_less_numeral) + have 2:"dist\<^sup>* (into_S_c (xn n)) (Cauchy_r `` {xn}) < e / 2" if "n \ N2" for n + proof - + have "dist\<^sup>* (into_S_c (xn n)) (Cauchy_r `` {xn}) = dist_completion' (\m. xn n) xn" + using dist_c_def[OF into_S_c_in[OF Cauchy_inS_dest1[OF xnC,of n]] equiv_class_self[OF Cauchy_r_equiv,of xn] into_S_c_into[OF Cauchy_inS_dest1[OF xnC,of n]]] xnC + by (simp add: quotientI) + also have "... \ e / 3" + by(rule Lim_bounded[OF Cauchy_inS_dist_convergent[OF Cauchy_inS_const[OF Cauchy_inS_dest1[OF xnC,of n]] xnC,simplified convergent_LIMSEQ_iff],of N2 "e/3"], auto dest: N2[OF that]) + also have "... < e / 2" using e by simp + finally show "dist\<^sup>* (into_S_c (xn n)) (Cauchy_r `` {xn}) < e / 2" . + qed + show "\N. \n\N. dist\<^sup>* (Xn n) (Cauchy_r `` {xn}) < e" + proof(safe intro!: exI[where x="max N1 N2"]) + fix n + assume "max N1 N2 \ n" + then have n:"n \ N1" "n \ N2" by auto + show "dist\<^sup>* (Xn n) (Cauchy_r `` {xn}) < e" + using c.dist_tr[OF c.Cauchy_inS_dest1[OF h,of n] into_S_c_into[OF Cauchy_inS_dest1[OF xnC],of n] quotientI[of xn]] xnC 1[OF n(1)] 2[OF n(2)] + by auto + qed + qed(use c.Cauchy_inS_dest1[OF h] in auto) +qed + +lemma dense_set_c_dense: + assumes "dense_set U" + shows "c.dense_set (into_S_c ` U)" + unfolding c.dense_set_def2 +proof safe + fix X and e :: real + assume h:"X \ S\<^sup>*" "0 < e" + then obtain xn where xn:"xn \ X" "Cauchy_inS xn" + by(auto dest: S_c_represent) + obtain y where y:"y \ S" "dist\<^sup>* X (into_S_c y) < e / 2" + using h into_S_c_image_dense half_gt_zero[OF h(2)] by(simp only: c.dense_set_def2) blast + obtain z where z:"z \ U" "dist y z < e / 2" + using half_gt_zero[OF h(2)] y(1) assms by(simp only: dense_set_def2) blast + show "\y\into_S_c ` U. dist\<^sup>* X y < e" + proof(rule bexI[OF _ imageI[OF z(1)]]) + have "dist\<^sup>* X (into_S_c z) \ dist\<^sup>* X (into_S_c y) + dist\<^sup>* (into_S_c y) (into_S_c z)" + using z(1) assms by(auto intro!: c.dist_tr h into_S_c_into y simp: dense_set_def) + also have "... = dist\<^sup>* X (into_S_c y) + dist y z" + using z(1) assms y(1) dist_into_S_c[of y z] by(auto simp: dense_set_def) + also have "... < e" + using y(2) z(2) by simp + finally show "dist\<^sup>* X (into_S_c z) < e" . + qed +qed(insert assms, auto simp: dense_set_def intro!: into_S_c_into) + +end + +lemma(in separable_metric_set) completion_polish: "polish_metric_set S\<^sup>* dist\<^sup>*" +proof - + interpret c:complete_metric_set "S\<^sup>*" "dist\<^sup>*" + by(rule completion_complete) + show ?thesis + proof + obtain U where U: "countable U" "dense_set U" + using separable by blast + show "\U. countable U \ c.dense_set U" + using U by(auto intro!: exI[where x="into_S_c ` U"] dense_set_c_dense) + qed +qed + +subsection \Discrete Distance\ +definition discrete_dist :: "'a set \ 'a \ 'a \ real" where +"discrete_dist S \ (\a b. if a \ S \ b \ S \ a \ b then 1 else 0)" + +lemma + assumes "a \ S" and "b \ S" + shows discrete_dist_iff_1: "discrete_dist S a b = 1 \ a \ b" + and discrete_dist_iff_0: "discrete_dist S a b = 0 \ a = b" + using assms by(auto simp: discrete_dist_def) + +lemma discrete_dist_metric: + "metric_set S (discrete_dist S)" + by(auto simp: discrete_dist_def metric_set_def) + +lemma + shows discrete_dist_ball_ge1: "x \ S \ 1 < \ \ metric_set.open_ball S (discrete_dist S) x \ = S" + and discrete_dist_ball_leq1: "x \ S \ 0 < \ \ \ \ 1 \ metric_set.open_ball S (discrete_dist S) x \ = {x}" + apply(auto simp: metric_set.open_ball_def[OF discrete_dist_metric],simp_all add: discrete_dist_def) + using less_le_not_le by fastforce + + +lemma discrete_dist_complete_metric: + "complete_metric_set S (discrete_dist S)" +proof - + interpret m: metric_set S "discrete_dist S" + by(rule discrete_dist_metric) + show ?thesis + proof + fix f + assume h:"m.Cauchy_inS f" + then have "\\. \>0 \ \x\S. \N. \n\N. f n \ m.open_ball x \" + by(auto simp: m.Cauchy_inS_def2') + from this[of 1] obtain x N where hxn: + "x \ S" "\n\N. f n \ m.open_ball x 1" + by auto + hence "\n. n \ N \ f n = x" + using discrete_dist_ball_leq1[of x S 1] by auto + thus "m.convergent_inS f" + unfolding m.convergent_inS_def using h hxn(1) + by(auto intro!: bexI[where x=x] exI[where x=N] simp:m.converge_to_inS_def2' m.Cauchy_inS_def) + qed +qed + +lemma discrete_dist_dense_set: + "metric_set.dense_set S (discrete_dist S) U \ S = U" +proof - + interpret m: metric_set S "discrete_dist S" + by(rule discrete_dist_metric) + show ?thesis + proof + assume h:"m.dense_set U" + show "S = U" + proof safe + fix x + assume hx:"x \ S" + then have "\\. \>0 \ m.open_ball x \ \ U \ {}" + using h by(simp add: m.dense_set_def) + hence "m.open_ball x 1 \ U \ {}" by auto + thus "x \ U" + using discrete_dist_ball_leq1[OF hx,of 1] + by auto + next + show "\x. x \ U \ x \ S" + using h by(auto simp: m.dense_set_def) + qed + next + show "S = U \ m.dense_set U " + using m.dense_set_S by auto + qed +qed + +lemma discrete_dist_separable_iff: + "separable_metric_set S (discrete_dist S) \ countable S" +proof - + interpret m: metric_set S "discrete_dist S" + by(rule discrete_dist_metric) + show ?thesis + proof + assume "separable_metric_set S (discrete_dist S)" + then obtain U where "countable U" "m.dense_set U" + by(auto simp: separable_metric_set_def separable_metric_set_axioms_def) + thus "countable S" + using discrete_dist_dense_set[of S] by auto + next + assume "countable S" + then show "separable_metric_set S (discrete_dist S)" + by(auto simp: separable_metric_set_def separable_metric_set_axioms_def intro!:exI[where x=S] m.dense_set_S discrete_dist_metric) + qed +qed + +lemma discrete_dist_polish_iff: "polish_metric_set S (discrete_dist S) \ countable S" + using discrete_dist_separable_iff[of S] discrete_dist_complete_metric[of S] + by(auto simp: polish_metric_set_def) + + +lemma discrete_dist_topology_x: + assumes "x \ S" + shows "openin (metric_set.mtopology S (discrete_dist S)) {x}" +proof - + interpret m: metric_set S "discrete_dist S" + by(rule discrete_dist_metric) + show ?thesis + by(auto simp: m.mtopology_open_ball_in[OF assms,of 1, simplified discrete_dist_ball_leq1[OF assms]]) +qed + +lemma discrete_dist_topology: + "openin (metric_set.mtopology S (discrete_dist S)) U \ U \ S" +proof - + interpret m: metric_set S "discrete_dist S" + by(rule discrete_dist_metric) + show ?thesis + proof + show "openin m.mtopology U \ U \ S" + using m.mtopology_topspace + by(auto simp: topspace_def) + next + assume "U \ S" + then have "\x. x \ U \ openin m.mtopology {x}" + by(auto simp: discrete_dist_topology_x) + hence "openin m.mtopology (\{{x} | x. x \ U})" + by auto + moreover have "\{{x} | x. x \ U} = U" by blast + ultimately show "openin m.mtopology U" + by simp + qed +qed + +lemma discrete_dist_topology': + "metric_set.mtopology S (discrete_dist S) = discrete_topology S" + by (simp add: discrete_dist_topology topology_eq) + +text \ Empty space. \ +lemma empty_metric_compact: "compact_metric_set {} (\x y. 0)" +proof - + interpret metric_set "{}" "\x y. 0" + by(auto simp: metric_set_def) + show ?thesis + by standard (use Hausdorff_space_finite_topspace[OF mtopology_Hausdorff,simplified mtopology_topspace] in blast) +qed + +corollary + shows empty_metric_polish: "polish_metric_set {} (\x y. 0)" + and empty_metric_complete: "complete_metric_set {} (\x y. 0)" + and empty_metric_separable: "separable_metric_set {} (\x y. 0)" + and empty_metric: "metric_set {} (\x y. 0)" +proof - + interpret compact_metric_set "{}" "\x y. 0" + by(rule empty_metric_compact) + show "polish_metric_set {} (\x y. 0)" "complete_metric_set {} (\x y. 0)" + "separable_metric_set {} (\x y. 0)" "metric_set {} (\x y. 0)" + using polish_metric_set_axioms complete_metric_set_axioms separable_metric_set_axioms metric_set_axioms + by blast+ +qed + +lemma empty_metric_unique: + assumes "metric_set {} d" + shows "d = (\x y. 0)" + apply standard+ + using assms by(auto simp: metric_set_def) + +lemma empty_metric_mtopology: + "metric_set.mtopology {} (\x y. 0) = discrete_topology {}" +proof - + have 1:"(\U. U = {} \ (\x\U. \\>0. metric_set.open_ball {} (\x y. 0) x \ \ U)) = (\U. U = {})" + by standard auto + thus ?thesis + using metric_set.mtopology_def[of "{}" "\x y. 0"] + by(simp add: metric_set_def discrete_topology_def 1) +qed + +text \ Singleton space \ +lemma singleton_metric_compact: + "compact_metric_set {a} (\x y. 0)" +proof - + interpret metric_set "{a}" "\x y. 0" + by(auto simp: metric_set_def) + show ?thesis + by standard (use Hausdorff_space_finite_topspace[OF mtopology_Hausdorff,simplified mtopology_topspace] in blast) +qed + +corollary + shows singleton_metric_polish: "polish_metric_set {a} (\x y. 0)" + and singleton_metric_complete: "complete_metric_set {a} (\x y. 0)" + and singleton_metric_separable: "separable_metric_set {a} (\x y. 0)" + and singleton_metric: "metric_set {a} (\x y. 0)" +proof - + interpret compact_metric_set "{a}" "\x y. 0" + by(rule singleton_metric_compact) + show "polish_metric_set {a} (\x y. 0)" "complete_metric_set {a} (\x y. 0)" + "separable_metric_set {a} (\x y. 0)" "metric_set {a} (\x y. 0)" + using polish_metric_set_axioms complete_metric_set_axioms separable_metric_set_axioms metric_set_axioms + by blast+ +qed + +lemma singleton_metric_unique: + assumes "metric_set {a} d" + shows "d = (\x y. 0)" + by standard+ (insert assms,auto simp: metric_set_def, metis) + +lemma singleton_metric_mtopology: + "metric_set.mtopology {a} (\x y. 0) = discrete_topology {a}" +proof - + have "(\U. U \ {a} \ (\x\U. \\>0. metric_set.open_ball {a} (\x y. 0) x \ \ U)) = (\U. U \ {a})" + proof + fix U + have "(U \ {a} \ (\x\U. \\>0. metric_set.open_ball {a} (\x y. 0) x \ \ U))" if "U \ {a}" + proof safe + fix x + assume "x \ U" + then have "x = a" using that by auto + thus "\\>0. metric_set.open_ball {a} (\x y. 0) x \ \ U" + by(auto intro!: exI[where x=1]) (metis \x \ U\ complete_metric_set_def empty_iff metric_set.open_ballD'(1) polish_metric_set_def singleton_metric_polish subset_singletonD that) + qed(use that in auto) + thus "(U \ {a} \ (\x\U. \\>0. metric_set.open_ball {a} (\x y. 0) x \ \ U)) = (U \ {a})" + by auto + qed + thus ?thesis + using metric_set.mtopology_def[of "{a}" "\x y. 0"] + by(simp add: metric_set_def discrete_topology_def ) +qed + +subsection \Binary Product Metric Spaces\ +text \ We define the $L^{1}$-distance. $L^{1}$-distance and $L^{2}$ distance (Euclid distance) + generate the same topological space.\ + +definition binary_distance :: "['a set, 'a \ 'a \ real, 'b set, 'b \ 'b \ real] \ 'a \ 'b \ 'a \ 'b \ real" where +"binary_distance S d S' d' \ (\(x,x') (y,y'). if (x,x') \ S \ S' \ (y,y') \ S \ S' then d x y + d' x' y' else 0)" + + +context + fixes S S' d d' + assumes "metric_set S d" "metric_set S' d'" +begin + +interpretation m1: metric_set S d by fact +interpretation m2: metric_set S' d' by fact + +lemma binary_metric_set: + "metric_set (S \ S') (binary_distance S d S' d')" +proof + fix x y z + assume "x \ S \ S'" "y \ S \ S'" "z \ S \ S'" + then show "binary_distance S d S' d' x z \ binary_distance S d S' d' x y + binary_distance S d S' d' y z" + using m1.dist_tr[of "fst x" "fst y" "fst z"] m2.dist_tr[of "snd x" "snd y" "snd z"] + by(fastforce simp: binary_distance_def split_beta') +next + show "\x y. 0 \ binary_distance S d S' d' x y" + "\x y. x \ S \ S' \ binary_distance S d S' d' x y = 0" + using m1.dist_geq0 m2.dist_geq0 m1.dist_notin m2.dist_notin by(auto simp: binary_distance_def split_beta') +next + fix x y + assume "x \ S \ S'" "y \ S \ S'" + then show "(x = y) = (binary_distance S d S' d' x y = 0)" + using m1.dist_0[of "fst x" "fst y"] m2.dist_0[of "snd x" "snd y"] m1.dist_geq0[of "fst x" "fst y"] m2.dist_geq0[of "snd x" "snd y"] + by(auto simp: binary_distance_def split_beta) +next + show "\x y. binary_distance S d S' d' x y = binary_distance S d S' d' y x" + using m1.dist_sym m2.dist_sym by(auto simp: binary_distance_def split_beta') +qed + +interpretation m: metric_set "S \ S'" "binary_distance S d S' d'" + by (rule binary_metric_set) + +lemma binary_distance_geq: + assumes "x \ S" "y \ S" "x' \ S'" "y' \ S'" + shows "d x y \ binary_distance S d S' d' (x,x') (y,y')" + "d' x' y' \ binary_distance S d S' d' (x,x') (y,y')" + using m1.dist_geq0 m2.dist_geq0 assms by(auto simp: binary_distance_def) + + +lemma binary_distance_ball: + assumes "(x,x') \ m.open_ball (a,a') \" + shows "x \ m1.open_ball a \" + and "x' \ m2.open_ball a' \" +proof - + have 1:"x \ S" "x' \ S'" "\ > 0" "a \ S" "a' \ S'" + using m.open_ballD'[OF assms(1)] by auto + thus "x \ metric_set.open_ball S d a \" + and "x' \ metric_set.open_ball S' d' a' \" + using m.open_ballD[OF assms(1)] binary_distance_geq[OF 1(4,1,5,2)] 1 + by(auto simp: m1.open_ball_def m2.open_ball_def) +qed + +lemma binary_distance_ball': + assumes "z \ m.open_ball a \" + shows "fst z \ m1.open_ball (fst a) \" + and "snd z \ m2.open_ball (snd a) \" + using binary_distance_ball[of "fst z" "snd z" "fst a" "snd a" \] assms by auto + +lemma binary_distance_ball1': + assumes "a \ S" "\ > 0" "a'\ S'" "\' > 0" + shows "\\''>0. m.open_ball (a,a') \'' \ m1.open_ball a \ \ m2.open_ball a' \'" +proof(rule exI[where x="min \ \'"]) + show "0 < min \ \' \ m.open_ball (a, a') (min \ \') \ m1.open_ball a \ \ m2.open_ball a' \'" + proof + show "0 < min \ \'" + using assms by auto + next + show "m.open_ball (a, a') (min \ \') \ m1.open_ball a \ \ m2.open_ball a' \'" + proof safe + fix x x' + assume h:"(x,x') \ m.open_ball (a, a') (min \ \')" + then have hx:"x \ S" "x' \ S'" + using m.open_ballD'(1)[of "(x,x')" "(a, a')" "min \ \'"] by auto + hence "d a x + d' a' x' < min \ \'" + using h assms by(auto simp: m.open_ball_def,auto simp: binary_distance_def) + thus "x \ m1.open_ball a \" "x' \ m2.open_ball a' \'" + using m1.dist_geq0[of a x] m2.dist_geq0[of a' x'] assms hx + by(auto simp: m1.open_ball_def m2.open_ball_def) + qed + qed +qed + +lemma binary_distance_ball1: + assumes "b \ m1.open_ball a \" "b' \ m2.open_ball a' \'" + shows "\\''>0. m.open_ball (b,b') \'' \ m1.open_ball a \ \ m2.open_ball a' \'" +proof - + obtain \a \a' where he: + "\a > 0" "\a' > 0" "m1.open_ball b \a \ m1.open_ball a \" "m2.open_ball b' \a' \ m2.open_ball a' \'" + using m1.mtopology_open_ball_in'[OF assms(1)] m2.mtopology_open_ball_in'[OF assms(2)] by auto + thus ?thesis + using binary_distance_ball1'[OF m1.open_ballD'(1)[OF assms(1)] he(1) m2.open_ballD'(1)[OF assms(2)] he(2)] + by blast +qed + + +lemma binary_distance_ball2': + assumes "a \ S" "\'' > 0" "a'\ S'" + shows "\\>0. \\'>0. m1.open_ball a \ \ m2.open_ball a' \' \ m.open_ball (a,a') \''" +proof(safe intro!: exI[where x="\''/2"]) + fix x x' + assume "x \ m1.open_ball a (\'' / 2)" "x' \ m2.open_ball a' (\'' / 2)" + then have "x \ S" "x' \ S'" "d a x < \'' / 2" "d' a' x' < \'' / 2" + using assms by(auto simp: m1.open_ball_def m2.open_ball_def) + thus "(x,x') \ m.open_ball (a, a') \''" + using assms by(auto simp: m.open_ball_def,auto simp: binary_distance_def) +qed (use assms in auto) + +lemma binary_distance_ball2: + assumes "(b,b') \ m.open_ball (a,a') \''" + shows "\\>0. \\'>0. m1.open_ball b \ \ m2.open_ball b' \' \ m.open_ball (a,a') \''" +proof - + obtain \''' where "\''' > 0" "m.open_ball (b,b') \''' \ m.open_ball (a,a') \''" + using m.mtopology_open_ball_in'[OF assms(1)] by blast + thus ?thesis + using binary_distance_ball2'[of b \''' b'] m.open_ballD'[OF assms(1),simplified] + by blast +qed + +lemma binary_distance_mtopology: + "m.mtopology = prod_topology m1.mtopology m2.mtopology" +proof - + have "m.mtopology = topology_generated_by { m1.open_ball a \ \ m2.open_ball a' \' | a a' \ \'. a \ S \ a' \ S' \ \ > 0 \ \' > 0}" + unfolding m.mtopology_def2 + proof(rule topology_generated_by_eq) + fix U + assume "U \ {m1.open_ball a \ \ m2.open_ball a' \' |a a' \ \'. a \ S \ a' \ S' \ 0 < \ \ 0 < \'}" + then obtain a \ a' \' where hae: + "U = m1.open_ball a \ \ m2.open_ball a' \'" "a \ S" "a' \ S'" "0 < \" "0 < \'" + by auto + show "openin (topology_generated_by {m.open_ball a \ |a \. a \ S \ S' \ 0 < \}) U" + unfolding m.mtopology_def2[symmetric] m.mtopology_openin_iff hae(1) + using binary_distance_ball1[of _ a \ _ a' \'] m1.open_ball_subset_ofS m2.open_ball_subset_ofS + by fastforce + next + fix U + assume "U \ {m.open_ball a \ |a \. a \ S \ S' \ 0 < \}" + then obtain a a' \ where hae: + "U = m.open_ball (a,a') \" "a \ S" "a' \ S'" "0 < \" + by auto + show "openin (topology_generated_by {m1.open_ball a \ \ m2.open_ball a' \' |a a' \ \'. a \ S \ a' \ S' \ 0 < \ \ 0 < \'}) U" + unfolding openin_subopen[of _ " m.open_ball (a,a') \"] hae(1) + proof + fix x + assume h:"x \ m.open_ball (a, a') \" + with binary_distance_ball2[of "fst x" "snd x" a a' \] + obtain \' \'' where he: + "\' > 0" "\'' > 0" "m1.open_ball (fst x) \' \ m2.open_ball (snd x) \'' \ m.open_ball (a, a') \" + by auto + show "\T. openin (topology_generated_by {m1.open_ball a \ \ m2.open_ball a' \' |a a' \ \'. a \ S \ a' \ S' \ 0 < \ \ 0 < \'}) T \ x \ T \ T \ m.open_ball (a, a') \" + unfolding openin_topology_generated_by_iff + using he m1.open_ball_ina[of "fst x",OF _ he(1)] m.open_ballD'(1,2)[OF h] m2.open_ball_ina[of "snd x",OF _ he(2)] + by(fastforce intro!: generate_topology_on.Basis exI[where x="m1.open_ball (fst x) \' \ m2.open_ball (snd x) \''"] exI[where x="fst x"] exI[where x="snd x"]) + qed + qed + also have "... = prod_topology m1.mtopology m2.mtopology" + proof - + have "{m1.open_ball a \ \ m2.open_ball a' \' |a a' \ \'. a \ S \ a' \ S' \ 0 < \ \ 0 < \'} = {U \ V |U V. U \ {m1.open_ball a \ |a \. a \ S \ 0 < \} \ V \ {m2.open_ball a \ |a \. a \ S' \ 0 < \}}" + by blast + thus ?thesis + unfolding m1.mtopology_def2 m2.mtopology_def2 + by(simp only: prod_topology_generated_by[symmetric]) + qed + finally show ?thesis . +qed + +lemma binary_distance_converge_to_inS_iff: + "m.converge_to_inS zn (x,y) \ m1.converge_to_inS (\n. fst (zn n)) x \ m2.converge_to_inS (\n. snd (zn n)) y" +proof safe + assume "m.converge_to_inS zn (x, y)" + then have h:"zn \ UNIV \ S \ S'" "x \ S" "y \ S'" "\e. e>0 \ \N. \n\N. zn n \ m.open_ball (x, y) e" + by(auto simp: m.converge_to_inS_def2') + show "m1.converge_to_inS (\n. fst (zn n)) x" + "m2.converge_to_inS (\n. snd (zn n)) y" + unfolding m1.converge_to_inS_def2' m2.converge_to_inS_def2' + proof safe + fix e :: real + assume "e > 0" + then obtain N where "\n. n \ N \ zn n \ m.open_ball (x, y) e" + using h(4) by auto + thus "\N. \n\N. fst (zn n) \ m1.open_ball x e" + "\N. \n\N. snd (zn n) \ m2.open_ball y e" + using binary_distance_ball'[of "zn _" "(x,y)"] + by(auto intro!: exI[where x=N]) + qed(insert h(1-3),simp_all add: Pi_iff mem_Times_iff) +next + assume h:"m1.converge_to_inS (\n. fst (zn n)) x" "m2.converge_to_inS (\n. snd (zn n)) y" + show "m.converge_to_inS zn (x, y)" + unfolding m.converge_to_inS_def2' + proof safe + show goal1:"x \ S" "y \ S'" "zn n \ S \ S'" for n + using h by(auto simp: m1.converge_to_inS_def m2.converge_to_inS_def Pi_iff mem_Times_iff) + fix e :: real + assume "e > 0" + from binary_distance_ball2'[OF goal1(1) this goal1(2)] + obtain e1 e2 where e12:"e1 > 0" "e2 > 0" "m1.open_ball x e1 \ m2.open_ball y e2 \ m.open_ball (x, y) e " by auto + then obtain N1 N2 where N12: "\n. n \ N1 \ fst (zn n) \ m1.open_ball x e1" "\n. n \ N2 \ snd (zn n) \ m2.open_ball y e2" + using h by(auto simp: m1.converge_to_inS_def2' m2.converge_to_inS_def2') metis + with e12 have "\n. n \ max N1 N2 \ zn n \ m1.open_ball x e1 \ m2.open_ball y e2" + by (simp add: mem_Times_iff) + with e12(3) show "\N. \n\N. zn n \ m.open_ball (x, y) e" + by(auto intro!: exI[where x="max N1 N2"]) + qed +qed + +lemma binary_distance_converge_to_inS_iff': + "m.converge_to_inS zn z \ m1.converge_to_inS (\n. fst (zn n)) (fst z) \ m2.converge_to_inS (\n. snd (zn n)) (snd z)" + using binary_distance_converge_to_inS_iff[of _ "fst z" "snd z"] by simp + +corollary binary_distance_convergent_inS_iff: + "m.convergent_inS zn \ m1.convergent_inS (\n. fst (zn n)) \ m2.convergent_inS (\n. snd (zn n))" + by(auto simp: m.convergent_inS_def m1.convergent_inS_def m2.convergent_inS_def binary_distance_converge_to_inS_iff) + +lemma binary_distance_Cauchy_inS_iff: + "m.Cauchy_inS zn \ m1.Cauchy_inS (\n. fst (zn n)) \ m2.Cauchy_inS (\n. snd (zn n))" +proof safe + assume h:"m.Cauchy_inS zn" + show "m1.Cauchy_inS (\n. fst (zn n))" "m2.Cauchy_inS (\n. snd (zn n))" + unfolding m1.Cauchy_inS_def2' m2.Cauchy_inS_def2' + proof safe + fix e :: real + assume "e > 0" + then obtain x y N where "x \ S" "y \ S'" "\n. n \ N \ zn n \ m.open_ball (x,y) e" + using h by(auto simp: m.Cauchy_inS_def2') metis + thus "\x\S. \N. \n\N. fst (zn n) \ m1.open_ball x e" + "\y\S'. \N. \n\N. snd (zn n) \ m2.open_ball y e" + using binary_distance_ball'[of "zn _" "(x,y)"] + by(auto intro!: exI[where x=x] exI[where x=y] exI[where x=N]) blast + qed(insert h, simp_all add: m.Cauchy_inS_def Pi_iff mem_Times_iff) +next + assume h: "m1.Cauchy_inS (\n. fst (zn n))" "m2.Cauchy_inS (\n. snd (zn n))" + show "m.Cauchy_inS zn" + unfolding m.Cauchy_inS_def + proof safe + show 1:"zn n \ S \ S'" for n + using h(1,2) m1.Cauchy_inS_dest1 m2.Cauchy_inS_dest1 mem_Times_iff by blast + fix e :: real + assume "e > 0" + then obtain N1 N2 where N:"\n m. n \ N1 \ m \ N1 \ d (fst (zn n)) (fst (zn m)) < e / 2" "\n m. n \ N2 \ m \ N2 \ d' (snd (zn n)) (snd (zn m)) < e / 2" + by (metis h(1) h(2) less_divide_eq_numeral1(1) m1.Cauchy_inS_def m2.Cauchy_inS_def mult_zero_left) + show "\N. \n\N. \m\N. binary_distance S d S' d' (zn n) (zn m) < e" + proof(safe intro!: exI[where x="max N1 N2"]) + fix n m + assume "max N1 N2 \ n" "max N1 N2 \ m" + then have le:"N1 \ n" "N1 \ m" "N2 \ n" "N2 \ m" by auto + show "binary_distance S d S' d' (zn n) (zn m) < e" + using N(1)[OF le(1,2)] N(2)[OF le(3,4)] \e > 0\ + by(auto simp: binary_distance_def split_beta') + qed + qed +qed + +end + +lemma binary_distance_separable: + assumes "separable_metric_set S d" "separable_metric_set S' d'" + shows "separable_metric_set (S \ S') (binary_distance S d S' d')" +proof - + interpret m1:separable_metric_set S d by fact + interpret m2:separable_metric_set S' d' by fact + interpret m : metric_set "S \ S'" "binary_distance S d S' d'" + by(auto intro!: binary_metric_set m1.metric_set_axioms m2.metric_set_axioms) + show ?thesis + using m.separable_iff_topological_separable separable_prod[OF m1.topological_separable_if_separable m2.topological_separable_if_separable] binary_distance_mtopology[OF m1.metric_set_axioms m2.metric_set_axioms] + by auto +qed + +lemma binary_distance_complete: + assumes "complete_metric_set S d" "complete_metric_set S' d'" + shows "complete_metric_set (S \ S') (binary_distance S d S' d')" +proof - + interpret m1:complete_metric_set S d by fact + interpret m2:complete_metric_set S' d' by fact + interpret m : metric_set "S \ S'" "binary_distance S d S' d'" + by(auto intro!: binary_metric_set m1.metric_set_axioms m2.metric_set_axioms) + show ?thesis + by standard (simp add: binary_distance_Cauchy_inS_iff[OF m1.metric_set_axioms m2.metric_set_axioms] binary_distance_convergent_inS_iff[OF m1.metric_set_axioms m2.metric_set_axioms] m1.convergence m2.convergence) +qed + +lemma binary_distance_polish: + assumes "polish_metric_set S d" and "polish_metric_set S' d'" + shows "polish_metric_set (S\S') (binary_distance S d S' d')" + using assms by(simp add: polish_metric_set_def binary_distance_separable binary_distance_complete) + +subsection \Sum Metric Spaces\ + +locale sum_metric = + fixes I :: "'i set" + and Si :: "'i \ 'a set" + and di :: "'i \ 'a \ 'a \ real" + assumes disj_fam: "disjoint_family_on Si I" + and d_nonneg: "\i x y. 0 \ di i x y" + and d_bounded: "\i x y. di i x y < 1" + and sd_metric: "\i. i \ I \ metric_set (Si i) (di i)" +begin + +abbreviation "S \ \i\I. Si i" + +lemma Si_inj_on: + assumes "i \ I" "j \ I" "a \ Si i" "a \ Si j" + shows "i = j" + using disj_fam assms by(auto simp: disjoint_family_on_def) + +definition sum_dist :: "['a, 'a] \ real" where +"sum_dist x y \ (if x \ S \ y \ S then (if \i\I. x \ Si i \ y \ Si i then di (THE i. i \ I \ x \ Si i \ y \ Si i) x y else 1) else 0)" + +lemma sum_dist_simps: + shows "\i. \i \ I; x \ Si i; y \ Si i\ \ sum_dist x y = di i x y" + and "\i j. \i \ I; j \ I; i \ j; x \ Si i; y \ Si j\ \ sum_dist x y = 1" + and "\i. \i \ I; y \ S; x \ Si i; y \ Si i\ \ sum_dist x y = 1" + and "\i. \i \ I; x \ S; y \ Si i; x \ Si i\ \ sum_dist x y = 1" + and "x \ S \ sum_dist x y = 0" +proof - + { fix i + assume h:"i \ I" "x \ Si i" "y \ Si i" + then have "sum_dist x y = di (THE i. i \ I \ x \ Si i \ y \ Si i) x y" + by(auto simp: sum_dist_def) + also have "... = di i x y" + proof - + have "(THE i. i \ I \ x \ Si i \ y \ Si i) = i" + using disj_fam h by(auto intro!: the1_equality simp: disjoint_family_on_def) + thus ?thesis by simp + qed + finally show "sum_dist x y = di i x y" . } + show "\i j. \i \ I; j \ I; i \ j; x \ Si i; y \ Si j\ \ sum_dist x y = 1" + "\i. \i \ I; y \ S; x \ Si i; y \ Si i\ \ sum_dist x y = 1" "\i. \i \ I; x \ S; y \ Si i; x \ Si i\ \ sum_dist x y = 1" + "x \ S \ sum_dist x y = 0" + using disj_fam by(auto simp: sum_dist_def disjoint_family_on_def dest:Si_inj_on) +qed + +lemma sum_dist_if_less1: + assumes "i \ I" "x \ Si i" "y \ S" "sum_dist x y < 1" + shows "y \ Si i" + using assms sum_dist_simps(3) by fastforce + +lemma inS_cases: + assumes "x \ S" "y \ S" + and "\i. \i \ I; x \ Si i; y \ Si i\ \ P x y" + and "\i j. \i \ I; j \ I; i \ j; x \ Si i; y \ Si j; x \ y\ \ P x y" + shows "P x y" using assms by auto + +sublocale metric_set S sum_dist +proof + fix x y + assume "x \ S" "y \ S" + then show "x = y \ sum_dist x y = 0" + by(rule inS_cases, insert sd_metric) (auto simp: sum_dist_simps metric_set_def) +next + { fix i x y + assume h: "i \ I" "x \ Si i" "y \ Si i" + then have "sum_dist x y = di i x y" + "sum_dist y x = di i x y" + using sd_metric by(auto simp: sum_dist_simps metric_set_def) } + thus "\x y. sum_dist x y = sum_dist y x" + by (metis (no_types, lifting) sum_dist_def) +next + show 1:"\x y. 0 \ sum_dist x y" + using d_nonneg by(simp add: sum_dist_def) + fix x y z + assume h: "x \ S" "y \ S" "z \ S" + show "sum_dist x z \ sum_dist x y + sum_dist y z" (is "?lhs \ ?rhs") + proof(rule inS_cases[OF h(1,3)]) + fix i + assume h':"i \ I" "x \ Si i" "z \ Si i" + consider "y \ Si i" | "y \ Si i" by auto + thus "?lhs \ ?rhs" + proof cases + case 1 + with h' sd_metric [OF h'(1)]show ?thesis + by(simp add: sum_dist_simps metric_set_def) + next + case 2 + with h' h(2) d_bounded[of i x z] 1[of y z] + show ?thesis + by(auto simp: sum_dist_simps) + qed + next + fix i j + assume h': "i \ I" "j \ I" "i \ j" "x \ Si i" "z \ Si j" + consider "y \ Si i" | "y \ Si j" + using h' h(2) disj_fam by(auto simp: disjoint_family_on_def) + thus "?lhs \ ?rhs" + by (cases, insert 1[of x y] 1[of y z] h' h(2)) (auto simp: sum_dist_simps) + qed +qed(simp add: sum_dist_simps) + +lemma sum_dist_le1: "sum_dist x y \ 1" + using d_bounded[of _ x y] by(auto simp: sum_dist_def less_eq_real_def) + + +lemma sum_dist_ball_eq_ball: + assumes "i \ I" "e \ 1" "x \ Si i" + shows "metric_set.open_ball (Si i) (di i) x e = open_ball x e" +proof - + interpret m: metric_set "Si i" "di i" + by(simp add: assms sd_metric) + show ?thesis + using assms sum_dist_simps(1)[OF assms(1) assms(3)] sum_dist_if_less1[OF assms(1,3)] + by(auto simp: m.open_ball_def open_ball_def) fastforce+ +qed + +lemma ball_le_sum_dist_ball: + assumes "i \ I" + shows "metric_set.open_ball (Si i) (di i) x e \ open_ball x e" +proof - + interpret m: metric_set "Si i" "di i" + by(simp add: assms sd_metric) + show ?thesis + proof safe + fix y + assume y: "y \ m.open_ball x e" + show "y \ open_ball x e" + using m.open_ballD[OF y] m.open_ballD'[OF y] assms + by(auto simp: open_ball_def sum_dist_simps) + qed +qed + +lemma openin_sum_mtopology_iff: + "openin mtopology U \ U \ S \ (\i\I. openin (metric_set.mtopology (Si i) (di i)) (U \ Si i))" +proof safe + fix i + assume h:"openin mtopology U" "i \ I" + then interpret m: metric_set "Si i" "di i" + using sd_metric by simp + show "openin m.mtopology (U \ Si i)" + unfolding m.mtopology_openin_iff + proof safe + fix x + assume x:"x \ U" "x \ Si i" + with h obtain e where e: "e > 0" "open_ball x e \ U" + by(auto simp: mtopology_openin_iff) + show "\\>0. m.open_ball x \ \ U \ Si i" + proof(safe intro!: exI[where x=e]) + fix y + assume "y \ m.open_ball x e" + from m.open_ballD[OF this] x(2) m.open_ballD'(1)[OF this] h(2) + have "y \ open_ball x e" + by(auto simp: open_ball_def sum_dist_simps) + with e show "y \ U" by auto + qed(use e m.open_ball_subset_ofS in auto) + qed +next + show "\x. openin mtopology U \ x \ U \ x \ S" + by(auto simp: mtopology_openin_iff) +next + assume h: "U \ S" "\i\I. openin (metric_set.mtopology (Si i) (di i)) (U \ Si i)" + show "openin mtopology U" + unfolding mtopology_openin_iff + proof safe + fix x + assume x: "x \ U" + then obtain i where i: "i \ I" "x \ Si i" + using h(1) by auto + then interpret m: metric_set "Si i" "di i" + using sd_metric by simp + obtain e where e: "e > 0" "m.open_ball x e \ U \ Si i" + using i h(2) by (meson IntI m.mtopology_openin_iff x) + show "\\>0. open_ball x \ \ U" + proof(safe intro!: exI[where x="min e 1"]) + fix y + assume y:"y \ open_ball x (min e 1)" + then show "y \ U" + using sum_dist_ball_eq_ball[OF i(1) _ i(2),of "min e 1"] e m.open_ball_le[of "min e 1" e x] + by auto + qed(simp add: e) + qed(use h(1) in auto) +qed + +corollary openin_sum_mtopology_Si: + assumes "i \ I" + shows "openin mtopology (Si i)" + unfolding openin_sum_mtopology_iff +proof safe + fix j + assume j:"j \ I" + then interpret m: metric_set "Si j" "di j" + by(simp add: sd_metric) + show "openin m.mtopology (Si i \ Si j)" + by (cases "i = j", insert assms disj_fam j) (auto simp: disjoint_family_on_def) +qed(use assms in auto) + +lemma converge_to_inSi_converge_to_inS: + assumes "i \ I" "metric_set.converge_to_inS (Si i) (di i) xn x" + shows "converge_to_inS xn x" +proof - + interpret m: metric_set "Si i" "di i" + by(simp add: assms sd_metric) + { + fix e :: real + assume "e > 0" + then obtain N where "\n. n \ N \ xn n \ m.open_ball x e" + using assms(2) by(auto simp: m.converge_to_inS_def2') metis + hence "\N. \n\N. xn n \ open_ball x e" + using ball_le_sum_dist_ball[OF assms(1),of x e] + by(auto intro!: exI[where x=N]) } + thus ?thesis + using assms by(auto simp: m.converge_to_inS_def2' converge_to_inS_def2') +qed + +corollary convergent_inSi_convergent_inS: + assumes "i \ I" "metric_set.convergent_inS (Si i) (di i) xn" + shows "convergent_inS xn" + using converge_to_inSi_converge_to_inS[OF assms(1)] assms(1) assms(2) convergent_inS_def metric_set.the_limit_if_converge sd_metric + by blast + +lemma converge_to_inS_converge_to_inSi_off_set: + assumes "converge_to_inS xn x" + shows "\n. \j\I. metric_set.converge_to_inS (Si j) (di j) (\i. xn (i + n)) x" +proof - + obtain i where i: "i \ I" "x \ Si i" + using assms by(auto simp: converge_to_inS_def) + then interpret m: metric_set "Si i" "di i" + by(simp add: sd_metric) + obtain N where N: "\n. n \ N \ sum_dist (xn n) x < 1" + using assms by(fastforce simp: converge_to_inS_def2) + hence N': "n \ N \ xn n \ Si i" for n + using assms by(auto intro!: sum_dist_if_less1[OF i,of "xn n"] simp: dist_sym[of _ x] converge_to_inS_def) + show ?thesis + proof(safe intro!: exI[where x=N] bexI[OF _ i(1)]) + show "m.converge_to_inS (\i. xn (i + N)) x" + unfolding m.converge_to_inS_def2 + proof(safe intro!: N' i(2)) + fix e :: real + assume "0 < e" + then obtain M where M: "\n. n \ M \ sum_dist (xn n) x < e" + using assms by(fastforce simp: converge_to_inS_def2) + hence "n \ max N M \ di i (xn n) x < e" for n + using sum_dist_simps(1)[OF i(1) N'[of n] i(2),symmetric] by auto + thus "\M. \n\M. di i (xn (n + N)) x < e" + by(auto intro!: exI[where x=M]) + qed simp + qed +qed + +corollary convergent_inS_convergent_inSi_off_set: + assumes "convergent_inS xn" + shows "\n. \j\I. metric_set.convergent_inS (Si j) (di j) (\i. xn (i + n))" + using converge_to_inS_converge_to_inSi_off_set + by (meson assms metric_set.convergent_inS_def metric_set_axioms sd_metric) + + +lemma Cauchy_inSi_Cauchy_inS: + assumes "i \ I" "metric_set.Cauchy_inS (Si i) (di i)xn" + shows "Cauchy_inS xn" +proof - + interpret m: metric_set "Si i" "di i" + by(simp add: assms sd_metric) + have [simp]:"sum_dist (xn n) (xn m) = di i (xn n) (xn m)" for n m + using assms sum_dist_simps(1)[OF assms(1)] + by(auto simp: m.Cauchy_inS_def Cauchy_inS_def) + show ?thesis + using assms by(auto simp: m.Cauchy_inS_def Cauchy_inS_def) +qed + +lemma Cauchy_inS_Cauchy_inSi: + assumes "Cauchy_inS xn" + shows "\n. \j\I. metric_set.Cauchy_inS (Si j) (di j) (\i. xn (i + n))" +proof - + obtain x i N where xiN: "i \ I" "x \ Si i" "\n. n \ N \ xn n \ open_ball x 1" + using assms by(auto simp: Cauchy_inS_def2') (metis UNION_empty_conv(2) d_bounded d_nonneg dist_0 empty_subsetI less_eq_real_def open_ball_le_0 subsetI subset_antisym sum_dist_le1) + then interpret m: metric_set "Si i" "di i" + by(simp add: sd_metric) + have xn: "n \ N \ xn n \ Si i" for n + using xiN(3)[of n] by(auto simp: sum_dist_ball_eq_ball[OF xiN(1) order_refl xiN(2),symmetric] dest: m.open_ballD') + show ?thesis + proof(safe intro!: exI[where x=N] bexI[OF _ xiN(1)]) + show "m.Cauchy_inS (\i. xn (i + N))" + unfolding m.Cauchy_inS_def + proof safe + fix e :: real + assume "0 < e" + then obtain M where M: "\n m. n \ M \ m \ M \ sum_dist (xn n) (xn m) < e" + using assms by(auto simp: Cauchy_inS_def) metis + have [simp]: "n \ N \ m \ N \ di i (xn n) (xn m) = sum_dist (xn n) (xn m)" for n m + using xn sum_dist_simps(1)[OF xiN(1) xn[of n] xn[of m]] by simp + show "\N'. \n\N'. \m\N'. di i (xn (n + N)) (xn (m + N)) < e" + using M by(auto intro!: exI[where x="max N M"]) + qed(use xn in auto) + qed +qed + +end + +lemma sum_metricI: + fixes Si + assumes "disjoint_family_on Si I" + and "\i x y. i \ I \ 0 \ di i x y" + and "\i x y. di i x y < 1" + and "\i. i \ I \ metric_set (Si i) (di i)" + shows "sum_metric I Si di" + using assms by(auto simp: sum_metric_def) (meson metric_set.dist_geq0) + +locale sum_separable_metric = sum_metric + + assumes I: "countable I" + and sd_separable_metric: "\i. i \ I \ separable_metric_set (Si i) (di i)" +begin + +sublocale separable_metric_set S sum_dist +proof + obtain Ui where Ui: "\i. i \ I \ countable (Ui i)" "\i. i \ I \ metric_set.dense_set (Si i) (di i) (Ui i)" + using sd_separable_metric by(auto simp: separable_metric_set_def separable_metric_set_axioms_def) metis + define U where "U \ \i\I. Ui i" + show "\U. countable U \ dense_set U" + proof(safe intro!: exI[where x=U]) + show "countable U" + using Ui(1) I by(auto simp: U_def) + next + show "dense_set U" + unfolding dense_set_def U_def + proof safe + fix i x + assume "i \ I" "x \ Ui i" + then show "x \ S" + using sd_separable_metric Ui by(auto intro!: bexI[where x=i] simp: separable_metric_set_def metric_set.dense_set_def) + next + fix i x e + assume h:"i \ I" "x \ Si i" "(0 :: real) < e" "open_ball x e \ \ (Ui ` I) = {}" + then interpret sd: separable_metric_set "Si i" "di i" + by(simp add: sd_separable_metric) + have "sd.open_ball x e \ Ui i \ {}" + using Ui(2)[OF h(1)] h(1-3) by(auto simp: U_def sd.dense_set_def) + hence "sd.open_ball x e \ \ (Ui ` I) \ {}" + using h(1) by blast + thus False + using ball_le_sum_dist_ball[OF \i \ I\,of x e] h(4) by blast + qed + qed +qed + +end + +locale sum_complete_metric = sum_metric + + assumes sd_complete_metric: "\i. i \ I \ complete_metric_set (Si i) (di i)" +begin + +sublocale complete_metric_set S sum_dist +proof + fix xn + assume 1:"Cauchy_inS xn" + from Cauchy_inS_Cauchy_inSi[OF this] obtain n j where h: "j \ I" "metric_set.Cauchy_inS (Si j) (di j) (\i. xn (i + n))" + by auto + then have "metric_set.convergent_inS (Si j) (di j) (\i. xn (i + n))" + by (simp add: complete_metric_set.convergence sd_complete_metric) + from convergent_inS_offset[OF convergent_inSi_convergent_inS[OF h(1) this]] 1 + show "convergent_inS xn" + by(simp add: Cauchy_inS_def) +qed + +end + +locale sum_polish_metric = sum_complete_metric + sum_separable_metric +begin + +sublocale polish_metric_set S sum_dist + by (simp add: complete_metric_set_axioms polish_metric_set_def separable_metric_set_axioms) + +end + +lemma sum_polish_metricI: + fixes Si + assumes "countable I" + and "disjoint_family_on Si I" + and "\i x y. i \ I \ 0 \ di i x y" + and "\i x y. di i x y < 1" + and "\i. i \ I \ polish_metric_set (Si i) (di i)" + shows "sum_polish_metric I Si di" + using assms by(auto simp: sum_polish_metric_def sum_complete_metric_def sum_separable_metric_def sum_complete_metric_axioms_def sum_separable_metric_axioms_def polish_metric_set_def complete_metric_set_def sum_metricI) + +end \ No newline at end of file diff --git a/thys/Standard_Borel_Spaces/Space_of_Continuous_Maps.thy b/thys/Standard_Borel_Spaces/Space_of_Continuous_Maps.thy new file mode 100644 --- /dev/null +++ b/thys/Standard_Borel_Spaces/Space_of_Continuous_Maps.thy @@ -0,0 +1,444 @@ +(* Title: Space_of_Continuous_Maps.thy + Author: Michikazu Hirata, Tokyo Institute of Technology +*) + +subsection \Example: The Metric Space of Continuous Functions\ +theory Space_of_Continuous_Maps + imports "StandardBorel" +begin + +definition cmaps :: "['a topology, 'b topology] \ ('a \ 'b) set" where +"cmaps X Y \ {f. f \ extensional (topspace X) \ continuous_map X Y f}" + +definition cmaps_dist :: "['a topology, 'b topology, 'b \ 'b \ real, 'a \ 'b, 'a \ 'b] \ real" where +"cmaps_dist X Y d f g \ if f \ cmaps X Y \ g \ cmaps X Y \ topspace X \ {} then (\ {d (f x) (g x) |x. x \ topspace X}) else 0" + +lemma cmaps_X_empty: + assumes "topspace X = {}" + shows "cmaps X Y = {\x. undefined}" + by(auto simp: cmaps_def assms) + +lemma cmaps_Y_empty: + assumes "topspace X \ {}" "topspace Y = {}" + shows "cmaps X Y = {}" + by(auto simp: cmaps_def assms continuous_map_def) + +lemma cmaps_dist_X_empty: + assumes "topspace X = {}" + shows "cmaps_dist X = (\Y d f g. 0)" + by standard+ (auto simp: cmaps_dist_def assms) + +lemma cmaps_dist_Y_empty: + assumes "topspace X \ {}" "topspace Y = {}" + shows "cmaps_dist X Y = (\d f g. 0)" + by standard+ (auto simp: cmaps_dist_def assms cmaps_Y_empty) + +subsubsection \Definition\ +context metric_set +begin + +context + fixes K and X :: "'b topology" + assumes m_bounded :"\x y. dist x y \ K" +begin + +lemma cm_dest: + shows "\f x. f \ (cmaps X mtopology) \ x \ topspace X \ f x \ S" + and "\f x. f \ (cmaps X mtopology) \ x \ topspace X \ f x = undefined" + and "\f. f \ (cmaps X mtopology) \ continuous_map X mtopology f" + using continuous_map_image_subset_topspace[of X mtopology,simplified mtopology_topspace] + by(auto simp: cmaps_def extensional_def) + +lemma cmaps_dist_bdd_above[simp]: "bdd_above {dist (f x) (g x) |x. x \ A}" + using m_bounded by(auto intro!: bdd_aboveI[where M=K]) + +lemma cmaps_metric_set: "metric_set (cmaps X mtopology) (cmaps_dist X mtopology dist)" +proof(cases "topspace X = {}") + case True + then show ?thesis + by(simp add: singleton_metric cmaps_X_empty cmaps_dist_X_empty) +next + case h:False + then have nen[simp]:"{dist (f x) (g x)|x. x \ topspace X} \ {}" for f g + by auto + show ?thesis + proof + show "(cmaps_dist X mtopology dist) f g \ 0" for f g + by(auto simp: cmaps_dist_def dist_geq0 intro!: cSup_upper2[where x="dist _ _"]) + next + fix f g + assume "f \ (cmaps X mtopology)" + then show "(cmaps_dist X mtopology dist) f g = 0" + by(simp add: cmaps_dist_def) + next + show "(cmaps_dist X mtopology dist) f g = (cmaps_dist X mtopology dist) g f" for f g + by(simp add: cmaps_dist_def dist_sym) + next + fix f g + assume fg:"f \ (cmaps X mtopology)" "g \ (cmaps X mtopology)" + show "f = g \ (cmaps_dist X mtopology dist) f g = 0" + proof safe + have "{dist (g x) (g x) |x. x \ topspace X} = {0}" + using h by fastforce + thus "(cmaps_dist X mtopology dist) g g = 0" + by(simp add: cmaps_dist_def) + next + assume "(cmaps_dist X mtopology dist) f g = 0" + with fg h have "\ {dist (f x) (g x)|x. x \ topspace X} \ 0" + by(auto simp: cmaps_dist_def) + hence "\x. x \ topspace X \ dist (f x) (g x) \ 0" + by(auto simp: cSup_le_iff[OF nen]) + from antisym[OF this dist_geq0] have fgeq:"\x. x \ topspace X \ f x = g x" + using dist_0[OF cm_dest(1)[OF fg(1)] cm_dest(1)[OF fg(2)]] by auto + show "f = g" + proof + fix x + show "f x = g x" + by(cases "x \ topspace X",insert fg) (auto simp: cm_dest fgeq) + qed + qed + next + fix f g h + assume fgh: "f \ (cmaps X mtopology)" "g \ (cmaps X mtopology)" "h \ (cmaps X mtopology)" + show "(cmaps_dist X mtopology dist) f h \ (cmaps_dist X mtopology dist) f g + (cmaps_dist X mtopology dist) g h" (is "?lhs \ ?rhs") + proof - + have bdd1:"bdd_above {dist (f x) (g x) + dist (g x) (h x) | x. x \ topspace X}" + using add_mono[OF m_bounded m_bounded] by(auto simp: bdd_above_def intro!: exI[where x="K + K"]) + have nen1:"{dist (f x) (g x) + dist (g x) (h x) |x. x \ topspace X} \ {}" + using h by auto + have "?lhs \ (\ {dist (f x) (g x) + dist (g x) (h x)|x. x \ topspace X})" + proof - + { + fix x + assume "x \ topspace X" + hence "\z. (\x. z = dist (f x) (g x) + dist (g x) (h x) \ x \ topspace X) \ dist (f x) (h x) \ z" + by(auto intro!: exI[where x="dist (f x) (g x) + dist (g x) (h x)"] exI[where x=x] dist_tr cm_dest fgh) + } + thus ?thesis + by(auto simp: cmaps_dist_def fgh h intro!: cSup_mono bdd1) + qed + also have "... \ ?rhs" + by(auto simp: cSup_le_iff[OF nen1 bdd1] cmaps_dist_def fgh h intro!: add_mono cSup_upper) + finally show ?thesis . + qed + qed +qed + +end + +end + +subsubsection \Topology of Uniform Convergence\ +locale topology_of_uniform_convergence_c = complete_metric_set + compact_metrizable X for X + + fixes K +assumes d_bounded: "\x y. dist x y \ K" +begin + +lemmas cm_dist_bdd_above[simp] = cmaps_dist_bdd_above[OF d_bounded] + +abbreviation "cm \ cmaps X mtopology" +abbreviation "cm_dist \ cmaps_dist X mtopology dist" + +lemma cm_complete_metric_set: "complete_metric_set cm cm_dist" +proof - + interpret m: metric_set cm cm_dist + by(auto intro!: cmaps_metric_set d_bounded) + show ?thesis + proof + obtain dx where dx: "compact_metric_set (topspace X) dx" "metric_set.mtopology (topspace X) dx = X" + by(rule compact_metric) + interpret dx: compact_metric_set "topspace X" dx + by fact + fix fn + assume h:"m.Cauchy_inS fn" + note fn_cm = m.Cauchy_inS_dest1[OF this] + have c:"\N. \n\N. \m\N. \x\topspace X. dist (fn n x) (fn m x) < e" if e:"e > 0" for e + proof - + obtain N where N:"\n m. n \ N \ m \ N \ cm_dist (fn n) (fn m) < e" + by(metis e h m.Cauchy_inS_def) + show ?thesis + proof(safe intro!: exI[where x=N]) + fix n m x + assume nmx: "n \ N" "m \ N" "x \ topspace X" + then have "dist (fn n x) (fn m x) \ cm_dist (fn n) (fn m)" + using fn_cm by(auto simp: cmaps_dist_def intro!: cSup_upper) + also have "... < e" + by(auto intro!: N nmx) + finally show "dist (fn n x) (fn m x) < e" . + qed + qed + have "convergent_inS (\n. fn n x)" if x:"x \ topspace X" for x + by(rule convergence,auto simp: Cauchy_inS_def,insert c x fn_cm) (auto simp: cmaps_def continuous_map_def mtopology_topspace, meson) + then obtain f where f:"\x. x \ topspace X \ converge_to_inS (\n. fn n x) (f x)" + by(auto simp: convergent_inS_def) metis + define f' where "f' \ (\x\topspace X. f x)" + have f':"\x. x \ topspace X \ converge_to_inS (\n. fn n x) (f' x)" + using f by(auto simp: f'_def) + have cu:"converges_uniformly (topspace X) S dist fn f'" + unfolding converges_uniformly_def[OF dx.metric_set_axioms metric_set_axioms] + proof safe + fix e :: real + assume e:"0 < e" + obtain N where N: "\n m x. n\N \ m\N \ x\topspace X \ dist (fn n x) (fn m x) < e / 2" + by(metis c[OF half_gt_zero[OF e]]) + show "\N. \n\N. \x\topspace X. dist (fn n x) (f' x) < e" + proof(rule ccontr) + assume "\N. \n\N. \x\topspace X. dist (fn n x) (f' x) < e" + with N obtain n x where nx: "n \ N" "x \ topspace X" "e \ dist (fn n x) (f' x)" + by (meson linorder_le_less_linear) + from f'[OF this(2)] half_gt_zero[OF e] + obtain N' where N':"\n. n \ N' \ dist (fn n x) (f' x) < e / 2" + by(metis converge_to_inS_def2) + define N0 where "N0 \ max N N'" + have N0 : "N0 \ N" "N0 \ N'" by(auto simp: N0_def) + have "e \ dist (fn n x) (f' x)" by fact + also have "... \ dist (fn n x) (fn N0 x) + dist (fn N0 x) (f' x)" + using f'[OF nx(2)] by(auto intro!: dist_tr simp: converge_to_inS_def) + also have "... < e" + using N[OF nx(1) N0(1) nx(2)] N'[OF N0(2)] by auto + finally show False .. + qed + qed(use f' converge_to_inS_def in auto) + show "m.convergent_inS fn" + unfolding m.convergent_inS_def m.converge_to_inS_def2 + proof(safe intro!: exI[where x=f']) + have "continuous_map dx.mtopology mtopology f'" + using fn_cm by(auto intro!: converges_uniformly_continuous[OF dx.metric_set_axioms metric_set_axioms _ cu] simp: cmaps_def,auto simp: dx) + thus f'_cm:"f' \ cm" + by(auto simp: cmaps_def dx f'_def) + fix e :: real + assume e:"0 < e" + obtain N where N:"\n x. n \ N \ x \ topspace X \ dist (fn n x) (f' x) < e / 2" + by(metis half_gt_zero[OF e] cu[simplified converges_uniformly_def[OF dx.metric_set_axioms metric_set_axioms]]) + show "\N. \n\N. cm_dist (fn n) f' < e" + proof(safe intro!: exI[where x=N]) + fix n + assume n:"N \ n" + have "cm_dist (fn n) f' \ e / 2" + proof(cases "topspace X = {}") + case True + then show ?thesis + by(auto simp: order.strict_implies_order[OF e] cmaps_X_empty cmaps_dist_X_empty) + next + case False + then have 1:"{dist (fn n x) (f' x) |x. x \ topspace X} \ {}" by auto + hence "cm_dist (fn n) f' = (\ {dist (fn n x) (f' x) |x. x \ topspace X})" + by(auto simp: f'_cm fn_cm cmaps_dist_def) + also have "... \ e / 2" + by(simp only: cSup_le_iff[OF 1,simplified]) (insert N[OF n], auto intro!: order.strict_implies_order) + finally show ?thesis . + qed + also have "... < e" + using e by simp + finally show "cm_dist (fn n) f' < e" . + qed + qed(use fn_cm in auto) + qed +qed + +end + +locale topology_of_uniform_convergence = polish_metric_set + compact_metrizable X for X + + fixes K +assumes d_bounded: "\x y. dist x y \ K" +begin + +sublocale topology_of_uniform_convergence_c + by (simp add: compact_metrizable_axioms complete_metric_set_axioms d_bounded topology_of_uniform_convergence_c_axioms_def topology_of_uniform_convergence_c_def) + +lemma cm_polish_metric_set: "polish_metric_set cm cm_dist" +proof - + consider "topspace X = {}" | "topspace X \ {}" "S = {}" | "topspace X \ {}" "S \ {}" by auto + thus ?thesis + proof cases + case 1 + then show ?thesis + by(simp add: singleton_metric_polish cmaps_X_empty cmaps_dist_X_empty) + next + case 2 + then show ?thesis + by(simp add: empty_metric_polish cmaps_Y_empty[of _ mtopology,simplified mtopology_topspace] cmaps_dist_Y_empty[of _ mtopology,simplified mtopology_topspace]) + next + case XS_nem:3 + interpret m: complete_metric_set cm cm_dist + by(rule cm_complete_metric_set) + show ?thesis + proof + obtain dx where dx: "compact_metric_set (topspace X) dx" "metric_set.mtopology (topspace X) dx = X" + by(rule compact_metric) + interpret dx: compact_metric_set "topspace X" dx + by fact + have "\B. finite B \ B \ topspace X \ topspace X = (\a\B. dx.open_ball a (1 / Suc m))" for m + using dx.totally_boundedSD[OF dx.totally_bounded,of "1 / Suc m"] by fastforce + then obtain Xm where Xm: "\m. finite (Xm m)" "\m. (Xm m) \ topspace X" "\m. topspace X = (\a\Xm m. dx.open_ball a (1 / Suc m))" + by metis + have Xm_nem:"\m. (Xm m) \ {}" + using XS_nem Xm(3) by auto + define xmk where "xmk \ (\m. from_nat_into (Xm m))" + define km where "km \ (\m. card (Xm m))" + have km_pos:"km m > 0" for m + by(simp add: km_def card_gt_0_iff Xm Xm_nem) + have xmk_bij: "bij_betw (xmk m) {.. Xm m" for m i + by (simp add: Xm_nem from_nat_into xmk_def) + have "\U. countable U \ \ U = S \ (\u\U. diam u < 1 / (Suc l))" for l + by(rule Lindelof_diam) auto + then obtain U where U: "\l. countable (U l)" "\l. (\ (U l)) = S" "\l u. u \ U l \ diam u < 1 / Suc l" + by metis + have Ul_nem: "U l \ {}" for l + using XS_nem U(2) by auto + define uli where "uli \ (\l. from_nat_into (U l))" + have uli_into:"uli l i \ U l" for l i + by (simp add: Ul_nem from_nat_into uli_def) + hence uli_diam: "diam (uli l i) < 1 / Suc l" for l i + using U(3) by auto + have uli_un:"S = (\i. uli l i)" for l + by(auto simp: range_from_nat_into[OF Ul_nem[of l] U(1)] uli_def U) + define Cmn where "Cmn \ (\m n. {f \ cm. \x\topspace X. \y\topspace X. dx x y < 1 / (Suc m) \ dist (f x) (f y) < 1 / Suc n})" + define fmnls where "fmnls \ (\m n l s. SOME f. f \ Cmn m n \ (\j uli l (s j)))" + define Dmnl where "Dmnl \ (\m n l. {fmnls m n l s |s. s \ {..\<^sub>E UNIV \ (\f \ Cmn m n. (\j uli l (s j))) })" + have in_Dmnl: "fmnls m n l s \ Dmnl m n l" if "s\{..\<^sub>E UNIV" "f\ Cmn m n" "\j uli l (s j)"for m n l s f + using Dmnl_def that by blast + define Dmn where "Dmn \ (\m n. \l. Dmnl m n l)" + have Dmn_subset: "Dmn m n \ Cmn m n" for m n + proof - + have "Dmnl m n l \ Cmn m n" for l + by(auto simp: Dmnl_def fmnls_def someI[of "\f. f \ Cmn m n \ (\j uli l (_ j))"]) + thus ?thesis by(auto simp: Dmn_def) + qed + have c_Dmn: "countable (Dmn m n)" for m n + proof - + have "countable (Dmnl m n l)" for l + proof - + have 1:"Dmnl m n l \ (\s. fmnls m n l s) ` ({..\<^sub>E UNIV)" + by(auto simp: Dmnl_def) + have "countable ..." + by(auto intro!: countable_PiE) + with 1 show ?thesis + using countable_subset by blast + qed + thus ?thesis + by(auto simp: Dmn_def) + qed + have claim: "\g\Dmn m n. \y\Xm m. dist (f y) (g y) < e" if f:"f \ Cmn m n" and e:"e > 0" for f m n e + proof - + obtain l where l:"1 / Suc l < e" + using e nat_approx_posE by blast + define s where "s \ (\i\{.. uli l j)" + have s1:"s\{..\<^sub>E UNIV" by(simp add: s_def) + have s2:"\i uli l (s i)" + proof - + fix i + have "f (xmk m i) \ uli l (SOME j. f (xmk m i) \ uli l j)" for i + proof(rule someI_ex) + have "xmk m i \ topspace X" + using Xm(2) xmk_into by auto + hence "f (xmk m i) \ S" + using f by(auto simp: Cmn_def cmaps_def continuous_map_def mtopology_topspace) + thus "\x. f (xmk m i) \ uli l x" + using uli_un by auto + qed + thus ?thesis + by (auto simp: s_def) + qed + have fmnls:"fmnls m n l s \ Cmn m n \ (\j uli l (s j))" + by(simp add: fmnls_def,rule someI[where x=f],auto simp: s2 f) + show "\g\Dmn m n. \y\Xm m. dist (f y) (g y) < e" + proof(safe intro!: bexI[where x="fmnls m n l s"]) + fix y + assume y:"y \ Xm m" + then obtain i where i:"i < km m" "xmk m i = y" + by (meson xmk_bij[of m] bij_betw_iff_bijections lessThan_iff) + have "f y \ uli l (s i)" "fmnls m n l s y \ uli l (s i)" + using i(1) s2 fmnls by(auto simp: i(2)[symmetric]) + moreover have "f y \ S" "fmnls m n l s y \ S" + using f fmnls y Xm(2)[of m] by(auto simp: Cmn_def cmaps_def continuous_map_def mtopology_topspace) + ultimately have "ennreal (dist (f y) (fmnls m n l s y)) \ diam (uli l (s i))" + by(auto intro!: diam_is_sup) + also have "... < ennreal (1 / Suc l)" + by(rule uli_diam) + also have "... < ennreal e" + using l e by(auto intro!: ennreal_lessI) + finally show "dist (f y) (fmnls m n l s y) < e" + by(simp add: ennreal_less_iff[OF dist_geq0]) + qed(use in_Dmnl[OF s1 f s2] Dmn_def in auto) + qed + + show "\U. countable U \ m.dense_set U" + unfolding m.dense_set_def2 + proof(safe intro!: exI[where x="\n. (\m. Dmn m n)"]) + fix f and e :: real + assume h:"f \ cm" "0 < e" + then obtain n where n:"1 / Suc n < e / 4" + by (metis zero_less_divide_iff zero_less_numeral nat_approx_posE) + have "\m. \l\ m. f \ Cmn l n" + proof - + have "uniform_continuous_map (topspace X) dx S dist f" + using h by(auto intro!: dx.continuous_map_is_uniform[OF metric_set_axioms] simp: cmaps_def dx) + then obtain d where d:"d > 0" "\x y. x\topspace X \ y\topspace X \ dx x y < d \ dist (f x) (f y) < 1 / (Suc n)" + by(auto simp: uniform_continuous_map_def[OF dx.metric_set_axioms metric_set_axioms]) (metis less_add_same_cancel2 linorder_neqE_linordered_idom of_nat_Suc of_nat_less_0_iff zero_less_divide_1_iff zero_less_one) + then obtain m where m:"1 / Suc m < d" + using nat_approx_posE by blast + have l: "l \ m \ 1 / Suc l \ 1 / Suc m" for l + by (simp add: frac_le) + show ?thesis + using d(2)[OF _ _ order.strict_trans[OF _ order.strict_trans1[OF l m]]] by(auto simp: Cmn_def h) + qed + then obtain m where m:"f \ Cmn m n" by auto + obtain g where g:"g\Dmn m n" "\y. y\Xm m \ dist (f y) (g y) < e / 4" + by (metis claim[OF m] h(2) zero_less_divide_iff zero_less_numeral) + have "\n m. \g\Dmn m n. cm_dist f g < e" + proof(rule exI[where x=n]) + show "\m. \g\Dmn m n. cm_dist f g < e" + proof(intro exI[where x=m] bexI[OF _ g(1)]) + have g_cm:"g \ cm" + using g(1) Dmn_subset[of m n] by(auto simp: Cmn_def) + hence "cm_dist f g = (\ {dist (f x) (g x) |x. x \ topspace X})" + by(auto simp: cmaps_dist_def h XS_nem) + also have "... \ 3 * e / 4" + proof - + have 1:"{dist (f x) (g x) |x. x \ topspace X} \ {}" + using XS_nem by auto + have 2:"dist (f x) (g x) \ 3 * e / 4" if x:"x \ topspace X" for x + proof - + obtain y where y:"y \ Xm m" "x \ dx.open_ball y (1 / real (Suc m))" + using Xm(3) x by auto + hence ytop:"y \ topspace X" + using Xm(2) by auto + have "dist (f x) (g x) \ dist (f x) (f y) + dist (f y) (g x)" + using x g_cm h(1) ytop by(auto intro!: dist_tr simp: cmaps_def continuous_map_def mtopology_topspace) + also have "... \ dist (f x) (f y) + dist (f y) (g y) + dist (g y) (g x)" + using x g_cm h(1) ytop by(auto intro!: dist_tr simp: cmaps_def continuous_map_def mtopology_topspace) + also have "... \ e / 4 + e / 4 + e / 4" + proof - + have dxy: "dx x y < 1 / Suc m" "dx y x < 1 / Suc m" + using dx.open_ballD[OF y(2)] by(auto simp: dx.dist_sym) + hence "dist (f x) (f y) < 1 / (Suc n)" "dist (g y) (g x) < 1 / (Suc n)" + using m x ytop g Dmn_subset[of m n] by(auto simp: Cmn_def) + hence "dist (f x) (f y) < e / 4" "dist (g y) (g x) < e / 4" + using n by auto + thus ?thesis + using g(2)[OF y(1)] by auto + qed + finally show "dist (f x) (g x) \ 3 * e / 4" by simp + qed + show ?thesis + using 2 by(auto simp only: cSup_le_iff[OF 1,simplified]) + qed + also have "... < e" + using h by auto + finally show "cm_dist f g < e" . + qed + qed + thus "\y\\n m. Dmn m n. cm_dist f y < e" + by auto + qed(use Dmn_subset c_Dmn Cmn_def in auto) + qed + qed +qed + +end + + +end \ No newline at end of file diff --git a/thys/Standard_Borel_Spaces/StandardBorel.thy b/thys/Standard_Borel_Spaces/StandardBorel.thy new file mode 100644 --- /dev/null +++ b/thys/Standard_Borel_Spaces/StandardBorel.thy @@ -0,0 +1,1546 @@ +(* Title: StandardBorel.thy + Author: Michikazu Hirata, Tokyo Institute of Technology +*) + +section \Standard Borel Spaces\ +subsection \Standard Borel Spaces\ +theory StandardBorel + imports Abstract_Metrizable_Topology +begin + +locale standard_borel = + fixes M :: "'a measure" + assumes polish_topology: "\S. polish_topology S \ sets M = sets (borel_of S)" +begin + +lemma singleton_sets: + assumes "x \ space M" + shows "{x} \ sets M" +proof - + obtain S where s:"polish_topology S" "sets M = sets (borel_of S)" + using polish_topology by blast + interpret s:polish_topology S by fact + have "closedin S {x}" + using s.closedin_singleton[of x] assms sets_eq_imp_space_eq[OF s(2)] + by(simp add: space_borel_of) + thus ?thesis + using borel_of_closed s by simp +qed + +corollary countable_sets: + assumes "A \ space M" "countable A" + shows "A \ sets M" + using sets.countable[OF singleton_sets assms(2)] assms(1) + by auto + +lemma standard_borel_restrict_space: + assumes "A \ sets M" + shows "standard_borel (restrict_space M A)" +proof - + obtain S where s:"polish_topology S" "sets M = sets (borel_of S)" + using polish_topology by blast + obtain S' where S':"polish_topology S'" "sets M = sets (borel_of S')" "openin S' A" + using polish_topology.sets_clopen_topology[OF s(1),simplified s(2)[symmetric],OF assms] by auto + show ?thesis + using polish_topology.openin_polish[OF S'(1,3)] S'(2) + by(auto simp: standard_borel_def borel_of_subtopology sets_restrict_space intro!: exI[where x="subtopology S' A"] ) +qed + +end + +locale standard_borel_ne = standard_borel + + assumes space_ne: "space M \ {}" +begin + +lemma standard_borel_ne_restrict_space: + assumes "A \ sets M" "A \ {}" + shows "standard_borel_ne (restrict_space M A)" + using assms by(auto simp: standard_borel_ne_def standard_borel_ne_axioms_def standard_borel_restrict_space) + +lemma standard_borel: "standard_borel M" + by(rule standard_borel_axioms) + +end + +lemma standard_borel_sets: + assumes "standard_borel M" and "sets M = sets N" + shows "standard_borel N" + using assms by(simp add: standard_borel_def) + +lemma standard_borel_ne_sets: + assumes "standard_borel_ne M" and "sets M = sets N" + shows "standard_borel_ne N" + using assms by(simp add: standard_borel_def standard_borel_ne_def sets_eq_imp_space_eq[OF assms(2)] standard_borel_ne_axioms_def) + +lemma pair_standard_borel: + assumes "standard_borel M" "standard_borel N" + shows "standard_borel (M \\<^sub>M N)" +proof - + obtain S S' where hs: + "polish_topology S" "sets M = sets (borel_of S)" "polish_topology S'" "sets N = sets (borel_of S')" + using assms by(auto simp: standard_borel_def) + have "sets (M \\<^sub>M N) = sets (borel_of (prod_topology S S'))" + unfolding borel_of_prod[OF polish_topology.S_second_countable[OF hs(1)] polish_topology.S_second_countable[OF hs(3)],symmetric] + using sets_pair_measure_cong[OF hs(2,4)] . + thus ?thesis + unfolding standard_borel_def by(auto intro!: exI[where x="prod_topology S S'"] simp: polish_topology_prod[OF hs(1,3)]) +qed + +lemma pair_standard_borel_ne: + assumes "standard_borel_ne M" "standard_borel_ne N" + shows "standard_borel_ne (M \\<^sub>M N)" + using assms by(auto simp: pair_standard_borel standard_borel_ne_def standard_borel_ne_axioms_def space_pair_measure) + +lemma product_standard_borel: + assumes "countable I" + and "\i. i \ I \ standard_borel (M i)" + shows "standard_borel (\\<^sub>M i\I. M i)" +proof - + obtain S where hs: + "\i. i \ I \ polish_topology (S i)" "\i. i \ I \ sets (M i) = sets (borel_of (S i))" + using assms(2) by(auto simp: standard_borel_def) metis + have "sets (\\<^sub>M i\I. M i) = sets (\\<^sub>M i\I. borel_of (S i))" + using hs(2) by(auto intro!: sets_PiM_cong) + also have "... = sets (borel_of (product_topology S I))" + using assms(1) polish_topology.S_second_countable[OF hs(1)] by(auto intro!: sets_PiM_equal_borel_of) + finally have 1:"sets (\\<^sub>M i\I. M i) = sets (borel_of (product_topology S I))". + show ?thesis + unfolding standard_borel_def + using assms(1) hs(1) by(auto intro!: exI[where x="product_topology S I"] polish_topology_product simp: 1) +qed + +lemma product_standard_borel_ne: + assumes "countable I" + and "\i. i \ I \ standard_borel_ne (M i)" + shows "standard_borel_ne (\\<^sub>M i\I. M i)" + using assms by(auto simp: standard_borel_ne_def standard_borel_ne_axioms_def product_standard_borel) + +lemma closed_set_standard_borel[simp]: + fixes U :: "'a :: topological_space set" + assumes "polish_topology (euclidean :: 'a topology)" "closed U" + shows "standard_borel (restrict_space borel U)" + by(auto simp: standard_borel_def borel_of_euclidean borel_of_subtopology assms intro!: exI[where x="subtopology euclidean U"] polish_topology_closedin_polish) + +lemma closed_set_standard_borel_ne[simp]: + fixes U :: "'a :: topological_space set" + assumes "polish_topology (euclidean :: 'a topology)" "closed U" "U \ {}" + shows "standard_borel_ne (restrict_space borel U)" + using assms by(simp add: standard_borel_ne_def standard_borel_ne_axioms_def) + +lemma open_set_standard_borel[simp]: + fixes U :: "'a :: topological_space set" + assumes "polish_topology (euclidean :: 'a topology)" "open U" + shows "standard_borel (restrict_space borel U)" + by(auto simp: standard_borel_def borel_of_euclidean borel_of_subtopology assms intro!: exI[where x="subtopology euclidean U"] polish_topology.openin_polish) + +lemma open_set_standard_borel_ne[simp]: + fixes U :: "'a :: topological_space set" + assumes "polish_topology (euclidean :: 'a topology)" "open U" "U \ {}" + shows "standard_borel_ne (restrict_space borel U)" + using assms by(simp add: standard_borel_ne_def standard_borel_ne_axioms_def) + + +lemma standard_borel_ne_borel[simp]: "standard_borel_ne (borel :: ('a :: polish_space) measure)" + and standard_borel_ne_lborel[simp]: "standard_borel_ne lborel" + unfolding standard_borel_def standard_borel_ne_def standard_borel_ne_axioms_def + by(auto intro!: exI[where x=euclidean] simp: borel_of_euclidean) + +lemma count_space_standard'[simp]: + assumes "countable I" + shows "standard_borel (count_space I)" +proof - + interpret polish_metric_set I "discrete_dist I" + by(simp add: discrete_dist_polish_iff assms) + show ?thesis + unfolding standard_borel_def + proof(intro exI[where x="mtopology"] conjI) + have "\x. x \ I \ {x} \ sets (borel_of mtopology)" + unfolding sets_borel_of by(rule sigma_sets.Basic) (simp add: discrete_dist_topology) + hence "sets (borel_of mtopology) = Pow I" + by(auto intro!: sets_eq_countable[OF assms] simp: space_borel_of mtopology_topspace) + thus "sets (count_space I) = sets (borel_of mtopology)" + by simp + qed (rule polish_topology_axioms) +qed + +lemma count_space_standard_ne[simp]: "standard_borel_ne (count_space (UNIV :: (_ :: countable) set))" + by (simp add: standard_borel_ne_def standard_borel_ne_axioms_def) + +corollary measure_pmf_standard_borel_ne[simp]: "standard_borel_ne (measure_pmf (p :: (_ :: countable) pmf))" + using count_space_standard_ne sets_measure_pmf_count_space standard_borel_ne_sets by blast + +corollary measure_spmf_standard_borel_ne[simp]: "standard_borel_ne (measure_spmf (p :: (_ :: countable) spmf))" + using count_space_standard_ne sets_measure_spmf standard_borel_ne_sets by blast + +corollary countable_standard_ne[simp]: + "standard_borel_ne (borel :: 'a :: {countable,t2_space} measure)" + by(simp add: standard_borel_sets[OF _ sets_borel_eq_count_space[symmetric]] standard_borel_ne_def standard_borel_ne_axioms_def) + +lemma(in standard_borel) countable_discrete_space: + assumes "countable (space M)" + shows "sets M = Pow (space M)" +proof safe + fix A + assume "A \ space M" + with assms have "countable A" + by(simp add: countable_subset) + thus "A \ sets M" + using \A \ space M\ singleton_sets + by(auto intro!: sets.countable[of A]) +qed(use sets.sets_into_space in auto) + +lemma(in standard_borel) measurable_isomorphic_standard: + assumes "M measurable_isomorphic N" + shows "standard_borel N" +proof - + obtain S where S:"polish_topology S" "sets M = sets (borel_of S)" + using polish_topology by auto + from measurable_isomorphic_borels[OF S(2) assms] + obtain S' where S': "S homeomorphic_space S' \ sets N = sets (borel_of S')" + by auto + thus ?thesis + by(auto simp: standard_borel_def polish_topology.homeomorphic_polish_topology[OF S(1)] intro!:exI[where x=S']) +qed + +lemma(in standard_borel_ne) measurable_isomorphic_standard_ne: + assumes "M measurable_isomorphic N" + shows "standard_borel_ne N" + using measurable_ismorphic_empty2[OF _ assms] by(auto simp: measurable_isomorphic_standard[OF assms] standard_borel_ne_def standard_borel_ne_axioms_def space_ne) + +lemma ereal_standard_ne: "standard_borel_ne (borel :: ereal measure)" +proof - + interpret s: standard_borel_ne "restrict_space borel {0..1::real}" + by auto + define f :: "real \ ereal" + where "f \ (\r. if r = 0 then bot else if r = 1 then top else tan (pi * r - (pi / 2)))" + define g :: "ereal \ real" + where "g \ (\r. if r = top then 1 else if r = bot then 0 else arctan (real_of_ereal r) / pi + 1 / 2)" + show ?thesis + proof(rule s.measurable_isomorphic_standard_ne[OF measurable_isomorphic_byWitness[where f=f and g = g]]) + show "f \ borel_measurable (restrict_space borel {0..1})" + proof - + have 1:"{0..1} \ {r. r \ 0} \ {x. x \ 1} = {0<..<1::real}" by auto + have 2:"(\x. ereal (tan (pi * x - pi / 2))) \ borel_measurable (restrict_space borel ({0..1} \ {r. r \ 0} \ {x. x \ 1}))" + unfolding 1 + proof(safe intro!: borel_measurable_continuous_on_restrict continuous_on_ereal Transcendental.continuous_on_tan) + show "continuous_on {0<..<1} (\x::real. pi * x - pi / 2)" + by(auto intro!: continuous_at_imp_continuous_on) + next + fix x :: real + assume h:"cos (pi * x - pi / 2) = 0" "x \ {0<..<1}" + hence "- (pi / 2) < pi * x - pi / 2" "pi * x - pi / 2 < pi / 2" + by simp_all + from cos_gt_zero_pi[OF this] h(1) + show False by simp + qed + have "{r:: real. r = 0 \ 0 \ r \ r \ 1} \ sets (restrict_space borel {0..1})" "{x::real. x = 1 \ 0 \ x \ x \ 1 \ x \ 0} \ sets (restrict_space borel ({0..1} \ {r. r \ 0}))" + by(auto simp: sets_restrict_space) + with 2 show ?thesis + by(auto intro!: measurable_If_restrict_space_iff[THEN iffD2] simp: restrict_restrict_space f_def) + qed + next + show "g \ borel \\<^sub>M restrict_space borel {0..1}" + unfolding g_def measurable_restrict_space2_iff + proof safe + fix x :: ereal + have "-1 / 2 < arctan (real_of_ereal x) / pi" "arctan (real_of_ereal x) / pi < 1 / 2" + using arctan_lbound[of "real_of_ereal x"] arctan_ubound[of "real_of_ereal x"] + by (simp_all add: mult_imp_less_div_pos) + hence "0 \ arctan (real_of_ereal x) / pi + 1 / 2" "arctan (real_of_ereal x) / pi + 1 / 2 \ 1" + by linarith+ + thus "(if x = \ then 1 else if x = \ then 0 else arctan (real_of_ereal x) / pi + 1 / 2) \ {0..1}" + by auto + qed measurable + next + fix r ::real + assume "r \ space (restrict_space borel {0..1})" + then consider "r = 0" | "r = 1" | "0 < r" "r < 1" by auto linarith + then show " g (f r) = r" + proof cases + case 3 + then have 1:"- (pi / 2) < pi * r - pi / 2" "pi * r - pi / 2 < pi / 2" + by simp_all + have "arctan (tan (pi * r - pi / 2)) / pi + 1 / 2 = r" + by(simp add: arctan_tan[OF 1] diff_divide_distrib) + thus ?thesis + by(auto simp: f_def g_def top_ereal_def bot_ereal_def) + qed(auto simp: g_def f_def top_ereal_def bot_ereal_def) + next + fix y :: ereal + consider "y = top" | "y = bot" | "y \ bot" "y \ top" by auto + then show "f (g y) = y" + proof cases + case 3 + hence [simp]: "\y\ \ \" by(auto simp: top_ereal_def bot_ereal_def) + have "-1 / 2 < arctan (real_of_ereal y) / pi" "arctan (real_of_ereal y) / pi < 1 / 2" + using arctan_lbound[of "real_of_ereal y"] arctan_ubound[of "real_of_ereal y"] + by (simp_all add: mult_imp_less_div_pos) + hence "arctan (real_of_ereal y) / pi + 1 / 2 < 1" "arctan (real_of_ereal y) / pi + 1 / 2 > 0" + by linarith+ + thus ?thesis + using arctan_lbound[of "real_of_ereal y"] arctan_ubound[of "real_of_ereal y"] + by(auto simp: f_def g_def distrib_left tan_arctan ereal_real') + qed(auto simp: f_def g_def) + qed +qed + +corollary ennreal_stanndard_ne: "standard_borel_ne (borel :: ennreal measure)" + by(auto intro!: standard_borel_ne.measurable_isomorphic_standard_ne[OF standard_borel_ne.standard_borel_ne_restrict_space[OF ereal_standard_ne,of "{0..}",simplified]] measurable_isomorphic_byWitness[where f=e2ennreal and g=enn2ereal] measurable_restrict_space1 measurable_restrict_space2 enn2ereal_e2ennreal) + +text \ Cantor space $\mathscr{C}$ \ +definition Cantor_space :: "(nat \ real) measure" where +"Cantor_space \ (\\<^sub>M i\ UNIV. restrict_space borel {0,1})" + +lemma Cantor_space_standard_ne: "standard_borel_ne Cantor_space" + by(auto simp: Cantor_space_def intro!: product_standard_borel_ne) + +lemma Cantor_space_borel: + "sets (borel_of Cantor_space_as_topology) = sets Cantor_space" + (is "?lhs = _") +proof - + have "?lhs = sets (\\<^sub>M i\ UNIV. borel_of (top_of_set {0,1}))" + by(auto intro!: sets_PiM_equal_borel_of[symmetric] second_countable_subtopology) + thus ?thesis + by(simp add: borel_of_subtopology Cantor_space_def borel_of_euclidean) +qed + +text \ Baire space \ +definition Baire_space :: "(nat \ nat) measure" where +"Baire_space \ (\\<^sub>M i\ UNIV. borel)" + +lemma Baire_space_standard: "standard_borel_ne Baire_space" + by(auto simp: Baire_space_def intro!: product_standard_borel_ne) + +text \ Hilbert cube $\mathscr{H}$ \ +definition Hilbert_cube :: "(nat \ real) measure" where +"Hilbert_cube \ (\\<^sub>M i\ UNIV. restrict_space borel {0..1})" + +lemma Hilbert_cube_standard_ne: "standard_borel_ne Hilbert_cube" + by(auto simp: Hilbert_cube_def intro!: product_standard_borel_ne) + +lemma Hilbert_cube_borel: + "sets (borel_of Hilbert_cube_as_topology) = sets Hilbert_cube" (is "?lhs = _") +proof - + have "?lhs = sets (\\<^sub>M i\ UNIV. borel_of (top_of_set {0..1}))" + by(auto intro!: sets_PiM_equal_borel_of[symmetric] second_countable_subtopology) + thus ?thesis + by(simp add: borel_of_subtopology Hilbert_cube_def borel_of_euclidean) +qed + +subsection \ Isomorphism between $\mathscr{C}$ and $\mathscr{H}$\ +lemma space_Cantor_space: "space Cantor_space = (\\<^sub>E i\ UNIV. {0,1})" + by(simp add: Cantor_space_def space_PiM) + +lemma space_Cantor_space_01[simp]: + assumes "x \ space Cantor_space" + shows "0 \ x n" "x n \ 1" "x n \ {0,1}" + using PiE_mem[OF assms[simplified space_Cantor_space],of n] + by auto + +lemma Cantor_minus_abs_cantor: + assumes "x \ space Cantor_space" "y \ space Cantor_space" + shows "(\n. \x n - y n\) \ space Cantor_space" + unfolding space_Cantor_space +proof safe + fix n + assume "\x n - y n\ \ 0" + then consider "x n = 0 \ y n = 1" | "x n = 1 \ y n = 0" + using space_Cantor_space_01[OF assms(1),of n] space_Cantor_space_01[OF assms(2),of n] + by auto + thus "\x n - y n\ = 1" + by cases auto +qed simp + +text \ Isomorphism between $\mathscr{C}$ and $[0,1]$\ +definition Cantor_to_01 :: "(nat \ real) \ real" where +"Cantor_to_01 \ (\x. (\n. (1/3)^(Suc n)* x n))" +text \ @{term Cantor_to_01} is a measurable injective embedding.\ + + +lemma Cantor_to_01_summable'[simp]: + assumes "x \ space Cantor_space" + shows "summable (\n. (1/3)^(Suc n)* x n)" +proof(rule summable_comparison_test'[where g="\n. (1/3)^ n" and N=0]) + show "norm ((1 / 3) ^ Suc n * x n) \ (1 / 3) ^ n" for n + using space_Cantor_space_01[OF assms,of n] by auto +qed simp + +lemma Cantor_to_01_summable[simp]: + assumes "x \ space Cantor_space" + shows "summable (\n. (1/3)^ n* x n)" + using Cantor_to_01_summable'[OF assms] by simp + +lemma Cantor_to_01_subst_summable[simp]: + assumes "x \ space Cantor_space" "y \ space Cantor_space" + shows "summable (\n. (1/3)^ n* (x n - y n))" +proof(rule summable_comparison_test'[where g="\n. (1/3)^ n" and N=0]) + show " norm ((1 / 3) ^ n * (x n - y n)) \ (1 / 3) ^ n" for n + using space_Cantor_space_01[OF Cantor_minus_abs_cantor[OF assms],of n] + by(auto simp: idom_abs_sgn_class.abs_mult) +qed simp + +lemma Cantor_to_01_image: "Cantor_to_01 \ space Cantor_space \ {0..1}" +proof + fix x + assume h:"x \ space Cantor_space" + have "Cantor_to_01 x \ (\n. (1/3)^(Suc n))" + unfolding Cantor_to_01_def + by(rule suminf_le) (use h Cantor_to_01_summable[OF h] in auto) + also have "... = (\n. (1 / 3) ^ n) - (1::real)" + using suminf_minus_initial_segment[OF complete_algebra_summable_geometric[of "1/3::real"],of 1] + by auto + finally have "Cantor_to_01 x \ 1" + by(simp add: suminf_geometric[of "1/3"]) + moreover have "0 \ Cantor_to_01 x" + unfolding Cantor_to_01_def + by(rule suminf_nonneg) (use Cantor_to_01_summable[OF h] h in auto) + ultimately show "Cantor_to_01 x \ {0..1}" + by simp +qed + +lemma Cantor_to_01_measurable: "Cantor_to_01 \ Cantor_space \\<^sub>M restrict_space borel {0..1}" +proof(rule measurable_restrict_space2) + show "Cantor_to_01 \ borel_measurable Cantor_space" + unfolding Cantor_to_01_def + proof(rule borel_measurable_suminf) + fix n + have "(\x. x n) \ Cantor_space \\<^sub>M restrict_space borel {0, 1}" + by(simp add: Cantor_space_def) + hence "(\x. x n) \ borel_measurable Cantor_space" + by(simp add: measurable_restrict_space2_iff) + thus "(\x. (1 / 3) ^ Suc n * x n) \ borel_measurable Cantor_space" + by simp + qed +qed(rule Cantor_to_01_image) + + +lemma + shows Cantor_to_01_inj: "inj_on Cantor_to_01 (space Cantor_space)" + and Cantor_to_01_preserves_sets: "A \ sets Cantor_space \ Cantor_to_01 ` A \ sets (restrict_space borel {0..1})" +proof - + have sets_Cantor: "sets Cantor_space = sets (borel_of (product_topology (\_. subtopology euclidean {0,1}) UNIV))" + (is "?lhs = _") + proof - + have "?lhs = sets (\\<^sub>M i\ UNIV. borel_of (subtopology euclidean {0,1}))" + by (simp add: Cantor_space_def borel_of_euclidean borel_of_subtopology) + thus ?thesis + by(auto intro!: sets_PiM_equal_borel_of second_countable_subtopology polish_topology.S_second_countable[of "euclideanreal"]) + qed + have s:"space Cantor_space = topspace (product_topology (\_. subtopology euclidean {0,1}) UNIV)" + by(simp add: space_Cantor_space) + + interpret m01: polish_metric_set "{0, 1::real}" "\x y. if (x = 0 \ x = 1) \ (y = 0 \ y = 1) then \x - y\ else 0" + proof - + have "(\x y. if x \ {0,1} \ y \ {0,1} then \x - y\ else 0) = discrete_dist {0,1::real}" + by standard+ (auto simp: discrete_dist_def) + moreover have "polish_metric_set {0, 1} ..." + by(simp add: discrete_dist_polish_iff) + ultimately show "polish_metric_set {0, 1::real} (\x y. if (x = 0 \ x = 1) \ (y = 0 \ y = 1) then \x - y\ else 0)" by simp + qed + interpret pm: product_polish_metric "1/3" "UNIV :: nat set" id id "\i. {0, 1::real}" "\i x y. if (x = 0 \ x = 1) \ (y = 0 \ y = 1) then \x - y\ else 0" 1 + by(auto intro!: product_polish_metric_natI simp: m01.polish_metric_set_axioms) + have "product_topology (\_. top_of_set {0, 1}) UNIV = pm.mtopology" + proof - + have "top_of_set {0, 1} = m01.mtopology" + proof - + have "openin (top_of_set {0,1}) A \ A \ {0,1}" for A :: "real set" + proof + assume "A \ {0, 1}" + then consider "A = {}" | "A = {0}" | "A = {1}" | "A = {0,1}" + by auto + thus "openin (top_of_set {0, 1}) A" + by cases (auto simp: openin_subtopology) + qed (rule openin_subset[of "top_of_set {0, 1}",simplified]) + moreover have "openin m01.mtopology A \ A \ {0,1}" for A + proof + assume "A \ {0, 1}" + then consider "A = {}" | "A = {0}" | "A = {1}" | "A = {0,1}" + by auto + thus "openin m01.mtopology A" + by cases (auto simp: m01.mtopology_openin_iff m01.open_ball_def intro!: exI[where x=1]) + next + show "openin m01.mtopology A \ A \ {0, 1}" + using m01.mtopology_topspace by(auto dest: openin_subset) + qed + ultimately show ?thesis + by(simp add: topology_eq) + qed + thus ?thesis + using pm.product_dist_mtopology by simp + qed + + interpret real : polish_metric_set "UNIV :: real set" dist + by simp + have [simp]: "real.mtopology = euclideanreal" + by (simp add: euclidean_mtopology) + interpret m01': polish_metric_set "{0..1::real}" "submetric {0..1} dist" + by(auto intro!: real.submetric_polish) + have "restrict_space borel {0..1} = borel_of m01'.mtopology" + by (metis borel_of_euclidean borel_of_subtopology open_openin open_openin_set real.submetric_subtopology subset_UNIV topology_eq) + + (* 1 / 9 * d x y \ \Cantor_to_01 x - Cantor_to_01 y\ \ d x y *) + have pd_def: "pm.product_dist x y = (\n. (1/3)^n * \x n - y n\)" if "x \ space Cantor_space" "y \ space Cantor_space" for x y + using space_Cantor_space_01[OF that(1)] space_Cantor_space_01[OF that(2)] that by(auto simp: product_dist_def) + have sd_def: "submetric {0..1} (\x y. \x - y\) (Cantor_to_01 x) (Cantor_to_01 y) = \Cantor_to_01 x - Cantor_to_01 y\" if "x \ space Cantor_space" "y \ space Cantor_space" for x y + using Cantor_to_01_image that by(auto simp: submetric_def) + have 1:"\Cantor_to_01 x - Cantor_to_01 y\ \ pm.product_dist x y" (is "?lhs \ ?rhs") if "x \ space Cantor_space" "y \ space Cantor_space" for x y + proof - + have "?lhs = \(\n. (1/3)^(Suc n)* x n - (1/3)^(Suc n)* y n)\" + using that by(simp add: suminf_diff Cantor_to_01_def) + also have "... = \\n. (1/3)^(Suc n) * (x n - y n) \" + by (simp add: right_diff_distrib) + also have "... \ (\n. \(1/3)^(Suc n) * (x n - y n)\)" + proof(rule summable_rabs) + have "(\n. \(1 / 3) ^ Suc n * (x n - y n)\) = (\n. (1 / 3) ^ Suc n * \(x n - y n)\)" + by (simp add: abs_mult_pos mult.commute) + moreover have "summable ..." + using Cantor_minus_abs_cantor[OF that] by simp + ultimately show "summable (\n. \(1 / 3) ^ Suc n * (x n - y n)\)" by simp + qed + also have "... = (\n. (1/3)^(Suc n) * \x n - y n\)" + by (simp add: abs_mult_pos mult.commute) + also have "... \ pm.product_dist x y" + unfolding pd_def[OF that] + apply(rule suminf_le) + using Cantor_minus_abs_cantor[OF that] by auto + finally show ?thesis . + qed + + have 2:"\Cantor_to_01 x - Cantor_to_01 y\ \ 1 / 9 *pm.product_dist x y" (is "?lhs \ ?rhs") if "x \ space Cantor_space" "y \ space Cantor_space" for x y + proof(cases "x = y") + case True + then show ?thesis + using pm.dist_0[of x y] that by(simp add: space_Cantor_space) + next + case False + then obtain n' where "x n' \ y n'" by auto + define n where "n \ Min {n. n \ n' \ x n \ y n}" + have "n \ n'" + using \x n' \ y n'\ n_def by fastforce + have "x n \ y n" + using \x n' \ y n'\ linorder_class.Min_in[of "{n. n \ n' \ x n \ y n}"] + by(auto simp: n_def) + have "\i y i" + then have "i \ {n. n \ n' \ x n \ y n}" + using \n \ n'\ \i < n\ by auto + thus False + using \i < n\ linorder_class.Min_gr_iff[of "{n. n \ n' \ x n \ y n}" i] \x n' \ y n'\ + by(auto simp: n_def) + qed + qed + + have u1: "(1/3) ^ (Suc n) * (1/2) \ \Cantor_to_01 x - Cantor_to_01 y\" + proof - + have "(1/3) ^ (Suc n) * (1/2) \ \(\m. (1/3)^(Suc (m + Suc n)) * (x (m + Suc n) - y (m + Suc n))) + (1 / 3) ^ Suc n * (x n - y n)\" + proof - + have "(1 / 3) ^ Suc n - (1/3)^(n + 2) * 3/2 \ (1 / 3) ^ Suc n - \(\m. (1 / 3) ^ Suc (m + Suc n) * (y (m + Suc n) - x (m + Suc n)))\" + proof - + have "\(\m. (1 / 3) ^ Suc (m + Suc n) * (y (m + Suc n) - x (m + Suc n)))\ \ (1/3)^(n + 2) * 3/2" + (is "?lhs \ _") + proof - + have "?lhs \ (\m. \(1 / 3) ^ Suc (m + Suc n) * (y (m + Suc n) - x (m + Suc n))\)" + apply(rule summable_rabs,rule summable_ignore_initial_segment[of _ "Suc n"]) + using Cantor_minus_abs_cantor[OF that(2,1)] by(simp add: abs_mult) + also have "... = (\m. (1 / 3) ^ Suc (m + Suc n) * \y (m + Suc n) - x (m + Suc n)\)" + by(simp add: abs_mult) + also have "... \ (\m. (1 / 3) ^ Suc (m + Suc n))" + apply(rule suminf_le) + using space_Cantor_space_01[OF Cantor_minus_abs_cantor[OF that(2,1)]] + apply simp + apply(rule summable_ignore_initial_segment[of _ "Suc n"]) + using Cantor_minus_abs_cantor[OF that(2,1)] by auto + also have "... = (\m. (1 / 3) ^ (m + Suc (Suc n)) * 1)" by simp + also have "... = (1/3)^(n + 2) * 3/(2::real)" + by(simp only: pm.nsum_of_rK[of "Suc (Suc n)"],simp) + finally show ?thesis . + qed + thus ?thesis by simp + qed + also have "... = \(1 / 3) ^ Suc n * (x n - y n)\ - \\m. (1 / 3) ^ Suc (m + Suc n) * (y (m + Suc n) - x (m + Suc n))\" + using \x n \ y n\ space_Cantor_space_01[OF Cantor_minus_abs_cantor[OF that],of n] by(simp add: abs_mult) + also have "... \ \(1 / 3) ^ Suc n * (x n - y n) - (\m. (1 / 3) ^ Suc (m + Suc n) * (y (m + Suc n) - x (m + Suc n)))\" + by simp + also have "... = \(1 / 3) ^ Suc n * (x n - y n) + (\m. (1 / 3) ^ Suc (m + Suc n) * (x (m + Suc n) - y (m + Suc n)))\" + proof - + have "(\m. (1 / 3) ^ Suc (m + Suc n) * (x (m + Suc n) - y (m + Suc n))) = (\m. - ((1 / 3) ^ Suc (m + Suc n) * (y (m + Suc n) - x (m + Suc n))))" + proof - + { fix nn :: nat + have "\r ra rb. - ((- (r::real) + ra) / (1 / rb)) = (- ra + r) / (1 / rb)" + by (simp add: left_diff_distrib) + then have "- ((y (Suc (n + nn)) + - x (Suc (n + nn))) * (1 / 3) ^ Suc (Suc (n + nn))) = (x (Suc (n + nn)) + - y (Suc (n + nn))) * (1 / 3) ^ Suc (Suc (n + nn))" + by fastforce + then have "- ((1 / 3) ^ Suc (nn + Suc n) * (y (nn + Suc n) - x (nn + Suc n))) = (1 / 3) ^ Suc (nn + Suc n) * (x (nn + Suc n) - y (nn + Suc n))" + by (simp add: add.commute mult.commute) } + then show ?thesis + by presburger + qed + also have "... = - (\m. (1 / 3) ^ Suc (m + Suc n) * (y (m + Suc n) - x (m + Suc n)))" + apply(rule suminf_minus) + apply(rule summable_ignore_initial_segment[of _ "Suc n"]) + using that by simp + finally show ?thesis by simp + qed + also have "... = \(\m. (1 / 3) ^ Suc (m + Suc n) * (x (m + Suc n) - y (m + Suc n))) + (1 / 3) ^ Suc n * (x n - y n)\" + using 1 by simp + finally show ?thesis by simp + qed + also have "... = \(\m. (1/3)^(Suc (m + Suc n)) * (x (m + Suc n) - y (m + Suc n))) + (\m" + using \\i by auto + also have "... = \\n. (1/3)^(Suc n) * (x n - y n)\" + proof - + have "(\n. (1 / 3) ^ Suc n * (x n - y n)) = (\m. (1 / 3) ^ Suc (m + Suc n) * (x (m + Suc n) - y (m + Suc n))) + (\m(\n. (1/3)^(Suc n)* x n - (1/3)^(Suc n)* y n)\" + by (simp add: right_diff_distrib) + also have "... = \Cantor_to_01 x - Cantor_to_01 y\" + using that by(simp add: suminf_diff Cantor_to_01_def) + finally show ?thesis . + qed + have u2: "(1/9) * pm.product_dist x y \ (1/3) ^ (Suc n) * (1/2)" + proof - + have "pm.product_dist x y = (\m. (1/3)^m * \x m - y m\)" + by(simp add: that pd_def) + also have "... = (\m. (1/3)^(m + n) * \x (m + n) - y (m + n)\) + (\mx m - y m\)" + using Cantor_minus_abs_cantor[OF that] by(auto intro!: suminf_split_initial_segment) + also have "... = (\m. (1/3)^(m + n) * \x (m + n) - y (m + n)\)" + using \\i by simp + also have "... \ (\m. (1/3)^(m + n))" + using space_Cantor_space_01[OF Cantor_minus_abs_cantor[OF that]] Cantor_minus_abs_cantor[OF that] + by(auto intro!: suminf_le summable_ignore_initial_segment[of _ n]) + also have "... = (1 / 3) ^ n * (3 / 2)" + using pm.nsum_of_rK[of n] by auto + finally show ?thesis + by auto + qed + from u1 u2 show ?thesis by simp + qed + + have inj: "inj_on Cantor_to_01 (space Cantor_space)" + proof + fix x y + assume h:"x \ space Cantor_space" "y \ space Cantor_space" + "Cantor_to_01 x = Cantor_to_01 y" + then have "pm.product_dist x y = 0" + using 2[OF h(1,2)] pm.dist_geq0[of x y] + by simp + thus "x = y" + using pm.dist_0[of x y] h(1,2) + by(simp add: space_Cantor_space) + qed + + have closed: "closedin m01'.mtopology (Cantor_to_01 ` (space Cantor_space))" + unfolding m01'.mtopology_closedin_iff + proof safe + show "a \ space Cantor_space \ Cantor_to_01 a \ {0..1}" for a + using Cantor_to_01_image by auto + next + fix f s + assume h:"f \ UNIV \ Cantor_to_01 ` space Cantor_space" "m01'.converge_to_inS f s" + then have "m01'.Cauchy_inS f" + using m01'.Cauchy_if_convergent_inS by(auto simp: m01'.convergent_inS_def) + have "\n. \x\space Cantor_space. f n = Cantor_to_01 x" using h(1) by auto + then obtain x where hx:"\n. x n \ space Cantor_space" "\n. f n = Cantor_to_01 (x n)" by metis + have "pm.Cauchy_inS x" + unfolding pm.Cauchy_inS_def2'' + proof + show "x \ UNIV \ (\\<^sub>E i\ UNIV. {0,1})" + using hx(1) by(auto simp: space_Cantor_space) + next + show "\\>0. \y\UNIV \\<^sub>E {0, 1}. \N. \n\N. pm.product_dist y (x n) < \" + proof safe + fix \ + assume "(0 :: real) < \" + hence "0 < \ / 9" by auto + then obtain N' where "\n\N'. f n \ m01'.open_ball (f N') (\ / 9)" + using \m01'.Cauchy_inS f\ m01'.Cauchy_inS_def2[of f] by blast + hence "\n. n \ N' \ \f N' - f n\ < (\ / 9)" + using m01'.Cauchy_inS_dest1[OF \m01'.Cauchy_inS f\] + by(auto simp: m01'.open_ball_def) (auto simp: submetric_def dist_real_def) + thus "\y\(\\<^sub>E i\ UNIV. {0,1}). \N. \n\N. pm.product_dist y (x n) < \" + using order.strict_trans1[OF 2[OF hx(1)[of N'] hx(1)],of _ "\/9"] hx(1) + by(auto intro!: exI[where x=N'] bexI[where x="x N'"] simp: hx(2) space_Cantor_space) + qed + qed + then obtain y where "pm.converge_to_inS x y" + using pm.convergence by(auto simp: pm.convergent_inS_def) + hence "y \ space Cantor_space" + by(auto simp: pm.converge_to_inS_def space_Cantor_space) + have "m01'.converge_to_inS f (Cantor_to_01 y)" + unfolding m01'.converge_to_inS_def2 + proof safe + show "f a \ {0..1}" "Cantor_to_01 y \ {0..1}" for a + using h(1) funcset_image[OF Cantor_to_01_image] + by (simp_all add: hx(1) hx(2) image_subset_iff pm.converge_to_inS_def \y \ space Cantor_space\) + next + fix \ + assume "(0 :: real) < \" + then obtain N where "\n. n \ N \ pm.product_dist (x n) y < \" + using \pm.converge_to_inS x y\ by(auto simp: pm.converge_to_inS_def2) meson + thus "\N. \n\N. submetric {0..1} dist (f n) (Cantor_to_01 y) < \" + by(auto intro!: exI[where x=N] order.strict_trans1[OF 1[OF hx(1) \y \ space Cantor_space\]] simp: submetric_def \0 < \\ hx(2) dist_real_def) + qed + hence "Cantor_to_01 y = s" + using h(2) m01'.converge_to_inS_unique by blast + with \y \ space Cantor_space\ show "s \ Cantor_to_01 ` space Cantor_space" + by auto + qed + + have open_map:"open_map pm.mtopology (subtopology m01'.mtopology (Cantor_to_01 ` (space Cantor_space))) Cantor_to_01" + unfolding space_Cantor_space + proof(rule metric_set_opem_map_from_dist[OF pm.metric_set_axioms m01'.metric_set_axioms Cantor_to_01_image[simplified space_Cantor_space]]) + fix x \ + assume "x \ (UNIV :: nat set) \\<^sub>E {0, 1::real}" "(0 :: real) < \" + show "\\>0. \y\UNIV \\<^sub>E {0, 1}. submetric {0..1} dist (Cantor_to_01 x) (Cantor_to_01 y) < \ \ pm.product_dist x y < \" + proof(safe intro!: exI[where x="\/9"]) + fix y + assume h:"y \ (UNIV :: nat set) \\<^sub>E {0, 1::real}" + "submetric {0..1} dist (Cantor_to_01 x) (Cantor_to_01 y) < \ / 9" + then have sc:"x \ space Cantor_space" "y \ space Cantor_space" + using \x \ UNIV \\<^sub>E {0, 1}\ by(simp_all add: space_Cantor_space) + have "\Cantor_to_01 x - Cantor_to_01 y\ < \ / 9" + using sd_def[OF sc] h(2) by (metis dist_real_def submetric_def) + with 2[OF sc] show "pm.product_dist x y < \ " + by simp + qed (use \\ > 0\ in auto) + qed + + have "Cantor_to_01 ` A \ sets (restrict_space borel {0..1})" if "A \ sets Cantor_space" for A + using open_map_preserves_sets'[of pm.mtopology m01'.mtopology Cantor_to_01 A] borel_of_closed[OF closed] \product_topology (\_. top_of_set {0, 1}) UNIV = pm.mtopology\ \restrict_space borel {0..1} = borel_of m01'.mtopology\ inj pm.mtopology_topspace that space_Cantor_space open_map sets_Cantor + by auto + + with inj show "inj_on Cantor_to_01 (space Cantor_space)" + and"A \ sets Cantor_space \ Cantor_to_01 ` A \ sets (restrict_space borel {0..1})" + by simp_all + +qed + +text \ Next, we construct measurable embedding from $[0,1]$ to ${0,1}^{\mathbb{N}}$.\ +definition to_Cantor_from_01 :: "real \ nat \ real" where +"to_Cantor_from_01 \ (\r n. if r = 1 then 1 else real_of_int (\2^(Suc n) * r\ mod 2))" + +text \ @{term to_Cantor_from_01} is a measurable injective embedding into Cantor space.\ + +lemma to_Cantor_from_01_image': "to_Cantor_from_01 r n \ {0,1}" + unfolding to_Cantor_from_01_def by auto + +lemma to_Cantor_from_01_image'': "0 \ to_Cantor_from_01 r n" "to_Cantor_from_01 r n \ 1" + using to_Cantor_from_01_image'[of r n] by auto + +lemma to_Cantor_from_01_image: "to_Cantor_from_01 \ {0..1} \ space Cantor_space" + using to_Cantor_from_01_image' by(auto simp: space_Cantor_space) + +lemma to_Cantor_from_01_measurable: + "to_Cantor_from_01 \ restrict_space borel {0..1} \\<^sub>M Cantor_space" + unfolding to_Cantor_from_01_def Cantor_space_def + by(auto intro!: measurable_restrict_space3 measurable_abs_UNIV) + +lemma to_Cantor_from_01_summable[simp]: + "summable (\n. (1/2)^n * to_Cantor_from_01 r n)" +proof(rule summable_comparison_test'[where g="\n. (1/2)^ n"]) + show "norm ((1 / 2) ^ n * to_Cantor_from_01 r n) \ (1 / 2) ^ n" for n + using to_Cantor_from_01_image'[of r n] by auto +qed simp + +lemma to_Cantor_from_sumn': + assumes "r \ {0..<1}" + shows "(\i r" + and "r - (\i (1/2)^(Suc n) \ r - (\i r - (\i 2^(Suc l) * r\ mod 2)" for l + using assms by(simp add: to_Cantor_from_01_def) + define S where "S = (\n. \i2^(Suc m) * (l - S m)\ mod 2 = \2^(Suc m) * l\ mod 2" for l m + proof - + have "\z. 2^(Suc m) * ((1/2)^(Suc k) * ?f k) = 2*real_of_int z" if "k < m" for k + proof - + have 0:"(2::real) ^ m * (1 / 2) ^ k = 2 * 2^(m-k-1)" + using that by (simp add: power_diff_conv_inverse) + consider "?f k = 0" | "?f k = 1" + using to_Cantor_from_01_image'[of r k] by auto + thus ?thesis + apply cases using that 0 by auto + qed + then obtain z where "\k. k < m \ 2^(Suc m) * ((1/2)^(Suc k) * ?f k) = 2*real_of_int (z k)" + by metis + hence Sm: "2^(Suc m) * S m = real_of_int (2 * (\k2^(Suc m) * (l - S m)\ mod 2 = \2^(Suc m) * l - 2^(Suc m) * S m\ mod 2" + by (simp add: right_diff_distrib) + also have "... = \2^(Suc m) * l\ mod 2" + unfolding Sm + by(simp only: floor_diff_of_int) presburger + finally show ?thesis . + qed + + have "S n \ r \ r - S n < (1/2)^n \ (?f n = 1 \ (1/2)^(Suc n) \ r - S n) \ (?f n = 0 \ r - S n < (1/2)^(Suc n))" + proof(induction n) + case 0 + then show ?case + using assms by(auto simp: S_def to_Cantor_from_01_def) linarith+ + next + case (Suc n) + hence ih: "S n \ r" "r - S n < (1 / 2) ^ n" + "?f n = 1 \ (1 / 2) ^ Suc n \ r - S n" + "?f n = 0 \ r - S n < (1 / 2) ^ Suc n" + by simp_all + have SSuc':"?f n = 0 \ S (Suc n) = S n \ ?f n = 1 \ S (Suc n) = S n + (1/2)^(Suc n)" + using to_Cantor_from_01_image'[of r n] by(simp add: SSuc) + have goal1:"S (Suc n) \ r" + using SSuc' ih(1) ih(3) by auto + have goal2: "r - S (Suc n) < (1 / 2) ^ Suc n" + using SSuc' ih(4) ih(2) by auto + have goal3_1: "(1 / 2) ^ Suc (Suc n) \ r - S (Suc n)" if "?f (Suc n) = 1" + proof(rule ccontr) + assume "\ (1 / 2) ^ Suc (Suc n) \ r - S (Suc n)" + then have "r - S (Suc n) < (1 / 2) ^ Suc (Suc n)" by simp + hence h:"2 ^ Suc (Suc n) * (r - S (Suc n)) < 1" + using mult_less_cancel_left_pos[of "2 ^ Suc (Suc n)" "r - S (Suc n)" "(1 / 2) ^ Suc (Suc n)"] + by (simp add: power_one_over) + moreover have "0 \ 2 ^ Suc (Suc n) * (r - S (Suc n))" + using goal1 by simp + ultimately have "\2 ^ Suc (Suc n) * (r - S (Suc n))\ = 0" + by linarith + thus False + using that[simplified f_simp] Sfloor[of "Suc n" r] + by fastforce + qed + have goal3_2: "?f (Suc n) = 1" if "(1 / 2) ^ Suc (Suc n) \ r - S (Suc n)" + proof - + have "1 \ 2 ^ Suc (Suc n) * (r - S (Suc n))" + using that[simplified f_simp] mult_le_cancel_left_pos[of "2 ^ Suc (Suc n)" "(1 / 2) ^ Suc (Suc n)" "r - S (Suc n)"] + by (simp add: power_one_over) + moreover have "2 ^ Suc (Suc n) * (r - S (Suc n)) < 2" + using mult_less_cancel_left_pos[of "2 ^ Suc (Suc n)" "r - S (Suc n)" "(1 / 2) ^ Suc n"] goal2 + by (simp add: power_one_over) + ultimately have "\2 ^ Suc (Suc n) * (r - S (Suc n))\ = 1" + by linarith + thus ?thesis + using Sfloor[of "Suc n" r] by(auto simp: f_simp) + qed + have goal4_1: "r - S (Suc n) < (1 / 2) ^ Suc (Suc n)" if "?f (Suc n) = 0" + proof(rule ccontr) + assume "\ r - S (Suc n) < (1 / 2) ^ Suc (Suc n)" + then have "(1 / 2) ^ Suc (Suc n) \ r - S (Suc n)" by simp + hence "1 \ 2 ^ Suc (Suc n) * (r - S (Suc n))" + using mult_le_cancel_left_pos[of "2 ^ Suc (Suc n)" "(1 / 2) ^ Suc (Suc n)" "r - S (Suc n)"] + by (simp add: power_one_over) + moreover have "2 ^ Suc (Suc n) * (r - S (Suc n)) < 2" + using mult_less_cancel_left_pos[of "2 ^ Suc (Suc n)" "r - S (Suc n)" "(1 / 2) ^ Suc n"] goal2 + by (simp add: power_one_over) + ultimately have "\2 ^ Suc (Suc n) * (r - S (Suc n))\ = 1" + by linarith + thus False + using that Sfloor[of "Suc n" r] by(auto simp: f_simp) + qed + have goal4_2: "?f (Suc n) = 0" if "r - S (Suc n) < (1 / 2) ^ Suc (Suc n)" + proof - + have h:"2 ^ Suc (Suc n) * (r - S (Suc n)) < 1" + using mult_less_cancel_left_pos[of "2 ^ Suc (Suc n)" "r - S (Suc n)" "(1 / 2) ^ Suc (Suc n)"] that + by (simp add: power_one_over) + moreover have "0 \ 2 ^ Suc (Suc n) * (r - S (Suc n))" + using goal1 by simp + ultimately have "\2 ^ Suc (Suc n) * (r - S (Suc n))\ = 0" + by linarith + thus ?thesis + using Sfloor[of "Suc n" r] by(auto simp: f_simp) + qed + show ?case + using goal1 goal2 goal3_1 goal3_2 goal4_1 goal4_2 by blast + qed + thus "(\i r" + and "r - (\i (1/2)^(Suc n) \ r - (\i r - (\i {0..1}" + shows "(\i r" + and "r - (\i (1/2)^n" + and "to_Cantor_from_01 r n = 1 \ (1/2)^(Suc n) \ r - (\i r - (\ii{0..<1}" using assms by fastforce + hence "(\i r \ r - (\i (1/2)^n \ (to_Cantor_from_01 r n = 1 \ (1/2)^(Suc n) \ r - (\i (to_Cantor_from_01 r n = 0 \ r - (\ii r" + and "r - (\i (1/2)^n" + and "to_Cantor_from_01 r n = 1 \ (1/2)^(Suc n) \ r - (\i r - (\i {0..1}" + shows "(\n. (1/2)^(Suc n)*to_Cantor_from_01 r n) = r" +proof - + have 1:"r \ (\n. (1/2)^(Suc n)*to_Cantor_from_01 r n)" + proof - + have 0:"r \ (1 / 2) ^ n + (\n. (1/2)^(Suc n)*to_Cantor_from_01 r n)" for n + proof - + have "r \ (1 / 2) ^ n + (\i (1 / 2) ^ n + (\n. (1/2)^(Suc n)*to_Cantor_from_01 r n)" + using to_Cantor_from_01_image''[of r] by(auto intro!: sum_le_suminf) + finally show ?thesis . + qed + have 00:"\no. \n\no. (1 / 2) ^ n < r" if "r>0" for r :: real + proof - + obtain n0 where "(1 / 2) ^ n0 < r" + using reals_power_lt_ex[of _ "2 :: real",OF \r>0\] by auto + thus ?thesis + using order.strict_trans1[OF power_decreasing[of n0 _ "1/2::real"]] + by(auto intro!: exI[where x=n0]) + qed + show ?thesis + apply(rule Lim_bounded2[where f="\n. (1 / 2) ^ n + (\n. (1/2)^(Suc n)*to_Cantor_from_01 r n)" and N=0]) + using 0 00 by(auto simp: LIMSEQ_iff) + qed + have 2:"(\n. (1/2)^(Suc n)*to_Cantor_from_01 r n) \ r" + using to_Cantor_from_sumn[OF assms] by(auto intro!: suminf_le_const) + show ?thesis + using 1 2 by simp +qed + +lemma to_Cantor_from_sum': + assumes "r \ {0..1}" + shows "(\im. (1/2)^(Suc (m + n))*to_Cantor_from_01 r (m + n))" + using suminf_minus_initial_segment[of "\n. (1 / 2) ^ Suc n * to_Cantor_from_01 r n" n] to_Cantor_from_sum[OF assms] + by auto + +lemma to_Cantor_from_01_exist0: + assumes "r \ {0..<1}" + shows "\n.\k\n. to_Cantor_from_01 r k = 0" +proof(rule ccontr) + assume "\ (\n.\k\n. to_Cantor_from_01 r k = 0)" + then obtain n0 where hn0: + "\k. k \ n0 \ to_Cantor_from_01 r k = 1" + using to_Cantor_from_01_image'[of r] by auto + define n where "n = Min {i. i \ n0 \ (\k\i. to_Cantor_from_01 r k = 1)}" + have n0in: "n0 \ {i. i \ n0 \ (\k\i. to_Cantor_from_01 r k = 1)}" + using hn0 by auto + have hn:"n \ n0" "\k. k \ n \ to_Cantor_from_01 r k = 1" + using n0in Min_in[of "{i. i \ n0 \ (\k\i. to_Cantor_from_01 r k = 1)}"] + by(auto simp: n_def) + show False + proof(cases n) + case 0 + then have "r = (\n. (1 / 2) ^ Suc n)" + using to_Cantor_from_sum[of r] assms hn(2) by simp + also have "... = 1" + using nsum_of_r'[of "1/2" 1 1] by auto + finally show ?thesis + using assms by auto + next + case eqn:(Suc n') + have "to_Cantor_from_01 r n' = 0" + proof(rule ccontr) + assume "to_Cantor_from_01 r n' \ 0" + then have "to_Cantor_from_01 r n' = 1" + using to_Cantor_from_01_image'[of r n'] by auto + hence "n' \ {i. i \ n0 \ (\k\i. to_Cantor_from_01 r k = 1)}" + using hn eqn not_less_eq_eq order_antisym_conv by fastforce + hence "n \ n'" + using Min.coboundedI[of "{i. i \ n0 \ (\k\i. to_Cantor_from_01 r k = 1)}" n'] + by(simp add: n_def) + thus False + using eqn by simp + qed + hence le1:"r - (\iim. (1/2)^(m + Suc n')*to_Cantor_from_01 r (m + n'))" + using to_Cantor_from_sum'[of r n'] assms by simp + also have "... = (\m. (1/2)^(m + Suc n)*to_Cantor_from_01 r (m + n))" + proof - + have "(\n. (1 / 2) ^ (Suc n + Suc n') * to_Cantor_from_01 r (Suc n + n')) = (\m. (1 / 2) ^ (m + Suc n') * to_Cantor_from_01 r (m + n')) - (1 / 2) ^ (0 + Suc n') * to_Cantor_from_01 r (0 + n')" + by(rule suminf_split_head) (auto intro!: summable_ignore_initial_segment) + thus ?thesis + using \to_Cantor_from_01 r n' = 0\ by(simp add: eqn) + qed + also have "... = (\m. (1/2)^(m + Suc n))" + using hn by simp + also have "... = (1 / 2) ^ n" + using nsum_of_r'[of "1/2" "Suc n" 1,simplified] by simp + finally show ?thesis . + qed + with le1 show False + by simp + qed +qed + +lemma to_Cantor_from_01_if_exist0: + assumes "\n. a n \ {0,1}" "\n.\k\n. a k = 0" + shows "to_Cantor_from_01 (\n. (1 / 2) ^ Suc n * a n) = a" +proof + fix n + have [simp]: "summable (\n. (1 / 2) ^ n * a n)" + proof(rule summable_comparison_test'[where g="\n. (1/2)^ n"]) + show "norm ((1 / 2) ^ n * a n) \ (1 / 2) ^ n" for n + using assms(1)[of n] by auto + qed simp + let ?r = "\n. (1 / 2) ^ Suc n * a n" + have "?r \ {0..1}" + using assms(1) space_Cantor_space_01[of a,simplified space_Cantor_space] nsum_of_r_leq[of "1/2" a 1 1 0] + by auto + show "to_Cantor_from_01 ?r n = a n" + proof(rule less_induct) + fix x + assume ih:"y < x \ to_Cantor_from_01 ?r y = a y" for y + have eq1:"?r - (\in. (1/2)^(Suc (n + x))* a (n + x))" + (is "?lhs = ?rhs") + proof - + have "?lhs = (\n. (1 / 2) ^ Suc (n + x) * a (n + x)) + (\iin. (1 / 2) ^ (Suc n) * a n" x] by simp + also have "... = (\n. (1 / 2) ^ Suc (n + x) * a (n + x)) + (\iin. (1/2)^(Suc (n + x))* a (n + x))" + define Sn' where "Sn' = (\n. (1/2)^(Suc (n + (Suc x)))* a (n + (Suc x)))" + have SnSn':"Sn = (1/2)^(Suc x) * a x + Sn'" + using suminf_split_head[of "\n. (1/2)^(Suc (n + x))* a (n + x)",OF summable_ignore_initial_segment] + by(auto simp: Sn_def Sn'_def) + have hsn:"0 \ Sn'" "Sn' < (1/2)^(Suc x)" + proof - + show "0 \ Sn'" + unfolding Sn'_def + apply(rule suminf_nonneg,rule summable_ignore_initial_segment) + using assms(1) space_Cantor_space_01[of a,simplified space_Cantor_space] + by fastforce+ + next + have "\n'\Suc x. a n' < 1" + using assms by fastforce + thus "Sn' < (1/2)^(Suc x)" + using nsum_of_r_le[of "1/2" a 1 "Suc x" "Suc (Suc x)"] assms(1) space_Cantor_space_01[of a,simplified space_Cantor_space] + by(auto simp: Sn'_def) + qed + have goal1: "to_Cantor_from_01 ?r x = 1 \ a x = 1" + proof - + have "to_Cantor_from_01 ?r x = 1 \ (1 / 2) ^ Suc x \ Sn" + using to_Cantor_from_sumn(3)[OF \?r \ {0..1}\] eq1 + by(fastforce simp: Sn_def) + also have "... \ (1 / 2) ^ Suc x \ (1/2)^(Suc x) * a x + Sn'" + by(simp add: SnSn') + also have "... \ a x = 1" + proof - + have "a x = 1" if "(1 / 2) ^ Suc x \ (1/2)^(Suc x) * a x + Sn'" + proof(rule ccontr) + assume "a x \ 1" + then have "a x = 0" + using assms(1) by auto + hence "(1 / 2) ^ Suc x \ Sn'" + using that by simp + thus False + using hsn by auto + qed + thus ?thesis + by(auto simp: hsn) + qed + finally show ?thesis . + qed + have goal2: "to_Cantor_from_01 ?r x = 0 \ a x = 0" + proof - + have "to_Cantor_from_01 ?r x = 0 \ Sn < (1 / 2) ^ Suc x" + using to_Cantor_from_sumn(4)[OF \?r \ {0..1}\] eq1 + by(fastforce simp: Sn_def) + also have "... \ (1/2)^(Suc x) * a x + Sn' < (1 / 2) ^ Suc x" + by(simp add: SnSn') + also have "... \ a x = 0" + proof - + have "a x = 0" if "(1/2)^(Suc x) * a x + Sn' < (1 / 2) ^ Suc x" + proof(rule ccontr) + assume "a x \ 0" + then have "a x = 1" + using assms(1) by auto + thus False + using that hsn by auto + qed + thus ?thesis + using hsn by auto + qed + finally show ?thesis . + qed + show "to_Cantor_from_01 ?r x = a x" + using goal1 goal2 to_Cantor_from_01_image'[of ?r x] by auto + qed +qed + +lemma to_Cantor_from_01_sum_of_to_Cantor_from_01: + assumes "r \ {0..1}" + shows "to_Cantor_from_01 (\n. (1 / 2) ^ Suc n * to_Cantor_from_01 r n) = to_Cantor_from_01 r" +proof - + consider "r = 1" | "r \ {0..<1}" + using assms by fastforce + then show ?thesis + proof cases + case 1 + then show ?thesis + using nsum_of_r'[of "1/2" 1 1] + by(auto simp: to_Cantor_from_01_def) + next + case 2 + from to_Cantor_from_01_if_exist0[OF to_Cantor_from_01_image' to_Cantor_from_01_exist0[OF this]] + show ?thesis . + qed +qed + +lemma to_Cantor_from_01_inj: "inj_on to_Cantor_from_01 (space (restrict_space borel {0..1}))" +proof + fix x y :: real + assume "x \ space (restrict_space borel {0..1})" "y \ space (restrict_space borel {0..1})" + and h:"to_Cantor_from_01 x = to_Cantor_from_01 y" + then have xyin:"x \ {0..1}" "y \ {0..1}" + by simp_all + show "x = y" + using to_Cantor_from_sum[OF xyin(1)] to_Cantor_from_sum[OF xyin(2)] h + by simp +qed + +lemma to_Cantor_from_01_preserves_sets: + assumes "A \ sets (restrict_space borel {0..1})" + shows "to_Cantor_from_01 ` A \ sets Cantor_space" +proof - + define f :: "(nat \ real) \ real" where "f \ (\x. \n. (1/2)^(Suc n)* x n)" + have f_meas:"f \ Cantor_space \\<^sub>M restrict_space borel {0..1}" + proof - + have "f \ borel_measurable Cantor_space" + unfolding Cantor_to_01_def f_def + proof(rule borel_measurable_suminf) + fix n + have "(\x. x n) \ Cantor_space \\<^sub>M restrict_space borel {0, 1}" + by(simp add: Cantor_space_def) + hence "(\x. x n) \ borel_measurable Cantor_space" + by(simp add: measurable_restrict_space2_iff) + thus "(\x. (1 / 2) ^ Suc n * x n) \ borel_measurable Cantor_space" + by simp + qed + moreover have "0 \ f x" "f x \ 1" if "x \ space Cantor_space" for x + proof - + have [simp]:"summable (\n. (1/2)^n* x n)" + proof(rule summable_comparison_test'[where g="\n. (1/2)^ n"]) + show "norm ((1 / 2) ^ n * x n) \ (1 / 2) ^ n" for n + using that by simp + qed simp + show "0 \ f x" + using that by(auto intro!: suminf_nonneg simp: f_def) + show "f x \ 1" + proof - + have "f x \ (\n. (1/2)^(Suc n))" + using that by(auto intro!: suminf_le simp: f_def) + also have "... = 1" + using nsum_of_r'[of "1/2" 1 1] by simp + finally show ?thesis . + qed + qed + ultimately show ?thesis + by(auto intro!: measurable_restrict_space2) + qed + have image_sets:"to_Cantor_from_01 ` (space (restrict_space borel {0..1})) \ sets Cantor_space" + (is "?A \ _") + proof - + have "?A \ space Cantor_space" + using to_Cantor_from_01_image by auto + have comple_sets:"(\\<^sub>E i\ UNIV. {0,1}) - ?A \ sets Cantor_space" + proof - + have eq1:"?A = {\n. 1} \ {x. (\n. x n \ {0,1}) \ (\n. \k\n. x k = 0)}" + proof + show "?A \ {\n. 1} \ {x. (\n. x n \ {0, 1}) \ (\n. \k\n. x k = 0)}" + proof + fix x + assume "x \ ?A" + then obtain r where hr:"r \ {0..1}" "x = to_Cantor_from_01 r" + by auto + then consider "r = 1" | "r \ {0..<1}" by fastforce + thus "x \ {\n. 1} \ {x. (\n. x n \ {0,1}) \ (\n. \k\n. x k = 0)}" + proof cases + case 1 + then show ?thesis + by(simp add: hr(2) to_Cantor_from_01_def) + next + case 2 + from to_Cantor_from_01_exist0[OF this] to_Cantor_from_01_image' + show ?thesis by(auto simp: hr(2)) + qed + qed + next + show "{\n. 1} \ {x. (\n. x n \ {0, 1}) \ (\n. \k\n. x k = 0)} \ ?A" + proof + fix x :: "nat \ real" + assume "x \ {\n. 1} \ {x. (\n. x n \ {0,1}) \ (\n. \k\n. x k = 0)}" + then consider "x = (\n. 1)" | "(\n. x n \ {0,1}) \ (\n. \k\n. x k = 0)" + by auto + thus "x \ ?A" + proof cases + case 1 + then show ?thesis + by(auto intro!: image_eqI[where x=1] simp: to_Cantor_from_01_def) + next + case 2 + hence "\n. 0 \ x n" "\n. x n \ 1" + by (metis dual_order.refl empty_iff insert_iff zero_less_one_class.zero_le_one)+ + with 2 to_Cantor_from_01_if_exist0[of x] nsum_of_r_leq[of "1/2" x 1 1 0] + show ?thesis + by(auto intro!: image_eqI[where x="\n. (1 / 2) ^ Suc n * x n"]) + qed + qed + qed + have "(\\<^sub>E i\ UNIV. {0,1}) - ?A = {x. (\n. x n \ {0,1}) \ (\n. \k\n. x k = 1)} - {\n. 1}" + proof + show "(\\<^sub>E i\ UNIV. {0,1}) - ?A \ {x. (\n. x n \ {0,1}) \ (\n. \k\n. x k = 1)} - {\n. 1}" + proof + fix x :: "nat \ real" + assume "x \ (\\<^sub>E i\ UNIV. {0,1}) - ?A" + then have "\n. x n \ {0,1}" "\ (\n. \k\n. x k = 0)" "x \ (\n. 1)" + using eq1 by blast+ + thus "x \ {x. (\n. x n \ {0,1}) \ (\n. \k\n. x k = 1)} - {\n. 1}" + by blast + qed + next + show "(\\<^sub>E i\ UNIV. {0,1}) - ?A \ {x. (\n. x n \ {0,1}) \ (\n. \k\n. x k = 1)} - {\n. 1}" + proof + fix x :: "nat \ real" + assume h:"x \ {x. (\n. x n \ {0,1}) \ (\n. \k\n. x k = 1)} - {\n. 1}" + then have "\n. x n \ {0,1}" "\n. \k\n. x k = 1" "x \ (\n. 1)" + by blast+ + hence "\ (\n. \k\n. x k = 0)" + by fastforce + with \\n. x n \ {0,1}\ \x \ (\n. 1)\ + show "x \ (\\<^sub>E i\ UNIV. {0,1}) - ?A" + using eq1 by blast + qed + qed + also have "... = (\ ((\n. {x. (\n. x n \ {0,1}) \ (\k\n. x k = 1)}) ` UNIV)) - {\n. 1}" + by blast + also have "... \ sets Cantor_space" (is "?B \ _") + proof - + have "countable ?B" + proof - + have "countable {x :: nat \ real. (\n. x n = 0 \ x n = 1) \ (\k\m. x k = 1)}" for m :: nat + proof - + let ?C = "{x::nat \ real. (\n. x n = 0 \ x n = 1) \ (\k\m. x k = 1)}" + define g where "g = (\(x::nat \ real) n. if n < m then x n else undefined)" + have 1:"g ` ?C = (\\<^sub>E i \{.. g ` ?C" + then show "x \ (\\<^sub>E i \{.. (\\<^sub>E i \{..n. if n < m then x n else 1)" + by(auto simp add: g_def PiE_def extensional_def) + moreover have "(\n. if n < m then x n else 1) \ ?C" + using h by auto + ultimately show "x \ g ` ?C" + by auto + qed + have 2:"inj_on g ?C" + proof + fix x y + assume hxyg:"x \ ?C" "y : ?C" "g x = g y" + show "x = y" + proof + fix n + consider "n < m" | "m \ n" by fastforce + thus "x n = y n" + proof cases + case 1 + then show ?thesis + using fun_cong[OF hxyg(3),of n] by(simp add: g_def) + next + case 2 + then show ?thesis + using hxyg(1,2) by auto + qed + qed + qed + show "countable {x::nat \ real. (\n. x n = 0 \ x n = 1) \ (\k\m. x k = 1)}" + by(rule countable_image_inj_on[OF _ 2]) (auto intro!: countable_PiE simp: 1) + qed + thus ?thesis + by auto + qed + moreover have "?B \ space Cantor_space" + by(auto simp: space_Cantor_space) + ultimately show ?thesis + using Cantor_space_standard_ne by(simp add: standard_borel.countable_sets standard_borel_ne_def) + qed + finally show ?thesis . + qed + moreover have "space Cantor_space - ((\\<^sub>E i\ UNIV. {0,1}) - ?A) = ?A" + using \?A \ space Cantor_space\ space_Cantor_space by blast + ultimately show ?thesis + using sets.compl_sets[OF comple_sets] by auto + qed + have "to_Cantor_from_01 ` A = f -` A \ to_Cantor_from_01 ` (space (restrict_space borel {0..1}))" + proof + show "to_Cantor_from_01 ` A \ f -` A \ to_Cantor_from_01 ` space (restrict_space borel {0..1})" + proof + fix x + assume "x \ to_Cantor_from_01 ` A" + then obtain a where ha:"a \ A" "x = to_Cantor_from_01 a" by auto + hence "a \ {0..1}" + using sets.sets_into_space[OF assms] by auto + have "f x = a" + using to_Cantor_from_sum[OF \a \ {0..1}\] by(simp add: f_def ha(2)) + thus " x \ f -` A \ to_Cantor_from_01 ` space (restrict_space borel {0..1})" + using sets.sets_into_space[OF assms] ha by auto + qed + next + show "to_Cantor_from_01 ` A \ f -` A \ to_Cantor_from_01 ` space (restrict_space borel {0..1})" + proof + fix x + assume h:"x \ f -` A \ to_Cantor_from_01 ` space (restrict_space borel {0..1})" + then obtain r where "r \ {0..1}" "x = to_Cantor_from_01 r" + by auto + from h have "f x \ A" + by simp + hence "to_Cantor_from_01 (f x) = x" + using to_Cantor_from_01_sum_of_to_Cantor_from_01[OF \r \ {0..1}\] + by(simp add: f_def \x = to_Cantor_from_01 r\) + with \f x \ A\ + show "x \ to_Cantor_from_01 ` A" + by (simp add: rev_image_eqI) + qed + qed + also have "... \ sets Cantor_space" + proof - + have " f -` A \ space Cantor_space \ to_Cantor_from_01 ` space (restrict_space borel {0..1}) = f -` A \ to_Cantor_from_01 ` (space (restrict_space borel {0..1}))" + using to_Cantor_from_01_image sets.sets_into_space[OF assms,simplified] by auto + thus ?thesis + using sets.Int[OF measurable_sets[OF f_meas assms] image_sets] + by fastforce + qed + finally show ?thesis . +qed + +lemma Cantor_space_isomorphic_to_01closed: + "Cantor_space measurable_isomorphic (restrict_space borel {0..1::real})" + using Schroeder_Bernstein_measurable[OF Cantor_to_01_measurable Cantor_to_01_preserves_sets Cantor_to_01_inj to_Cantor_from_01_measurable to_Cantor_from_01_preserves_sets to_Cantor_from_01_inj] + by(simp add: measurable_isomorphic_def) + +lemma Cantor_space_isomorphic_to_Hilbert_cube: + "Cantor_space measurable_isomorphic Hilbert_cube" +proof - + have 1:"Cantor_space measurable_isomorphic (\\<^sub>M (i::nat,j::nat)\ UNIV \ UNIV. restrict_space borel {0,1::real})" + unfolding Cantor_space_def + by(auto intro!: measurable_isomorphic_sym[OF countable_infinite_isomorphisc_to_nat_index] simp: split_beta' finite_prod) + have 2:"(\\<^sub>M (i::nat,j::nat)\ UNIV \ UNIV. restrict_space borel {0,1::real}) measurable_isomorphic (\\<^sub>M (i::nat)\ UNIV. Cantor_space)" + unfolding Cantor_space_def by(rule measurable_isomorphic_sym[OF PiM_PiM_isomorphic_to_PiM]) + have 3:"(\\<^sub>M (i::nat)\ UNIV. Cantor_space) measurable_isomorphic Hilbert_cube" + unfolding Hilbert_cube_def by(rule measurable_isomorphic_lift_product[OF Cantor_space_isomorphic_to_01closed]) + show ?thesis + by(rule measurable_isomorphic_trans[OF measurable_isomorphic_trans[OF 1 2] 3]) +qed + +lemma(in standard_borel) embedding_into_Hilbert_cube: + "\A \ sets Hilbert_cube. M measurable_isomorphic (restrict_space Hilbert_cube A)" +proof - + obtain S where S:"polish_topology S" "sets (borel_of S) = sets M" + using polish_topology by blast + obtain A where A:"g_delta_of Hilbert_cube_as_topology A" "S homeomorphic_space subtopology Hilbert_cube_as_topology A" + using polish_topology.embedding_into_Hilbert_cube_g_delta_of[OF S(1)] by blast + show ?thesis + using borel_of_g_delta_of[OF A(1)] homeomorphic_space_measurable_isomorphic[OF A(2)] measurable_isomorphic_sets_cong[OF S(2),of "borel_of (subtopology Hilbert_cube_as_topology A)" "restrict_space Hilbert_cube A"] Hilbert_cube_borel sets_restrict_space_cong[OF Hilbert_cube_borel] + by(auto intro!: bexI[where x=A] simp: borel_of_subtopology) +qed + +lemma(in standard_borel) uncountable_contains_Cantor_space: + assumes "uncountable (space M)" + shows "\A \ sets M. Cantor_space measurable_isomorphic (restrict_space M A)" +proof - + obtain S where S:"polish_topology S" "sets (borel_of S) = sets M" + using polish_topology by blast + then obtain A where A:"g_delta_of S A" "Cantor_space_as_topology homeomorphic_space subtopology S A" + using polish_topology.uncountable_contains_Cantor_space[of S] assms sets_eq_imp_space_eq[OF S(2)] + by(auto simp: space_borel_of) + show ?thesis + using borel_of_g_delta_of[OF A(1)] S(2) homeomorphic_space_measurable_isomorphic[OF A(2)] measurable_isomorphic_sets_cong[OF Cantor_space_borel restrict_space_sets_cong[OF refl S(2)],of A] + by(auto intro!: bexI[where x=A] simp: borel_of_subtopology) +qed + +lemma(in standard_borel) uncountable_isomorphic_to_Hilbert_cube: + assumes "uncountable (space M)" + shows "Hilbert_cube measurable_isomorphic M" +proof - + obtain A B where AB: + "M measurable_isomorphic (restrict_space Hilbert_cube A)" "Cantor_space measurable_isomorphic (restrict_space M B)" + "A \ sets Hilbert_cube""B \ sets M" + using embedding_into_Hilbert_cube uncountable_contains_Cantor_space[OF assms] by auto + show ?thesis + by(rule measurable_isomorphic_antisym[OF AB measurable_isomorphic_sym[OF Cantor_space_isomorphic_to_Hilbert_cube]]) +qed + +lemma(in standard_borel) uncountable_isomorphic_to_real: + assumes "uncountable (space M)" + shows "M measurable_isomorphic (borel :: real measure)" +proof - + interpret r: standard_borel_ne "borel :: real measure" + by simp + show ?thesis + by(auto intro!: measurable_isomorphic_trans[OF measurable_isomorphic_sym[OF uncountable_isomorphic_to_Hilbert_cube[OF assms]] r.uncountable_isomorphic_to_Hilbert_cube] simp: uncountable_UNIV_real) +qed + +definition to_real_on :: "'a measure \ 'a \ real" where +"to_real_on M \ (if uncountable (space M) then (SOME f. measurable_isomorphic_map M (borel :: real measure) f) else (real \ to_nat_on (space M)))" + +definition from_real_into :: "'a measure \ real \ 'a" where +"from_real_into M \ (if uncountable (space M) then the_inv_into (space M) (to_real_on M) else (\r. from_nat_into (space M) (nat \r\)))" + +context standard_borel +begin + +abbreviation "to_real \ to_real_on M" +abbreviation "from_real \ from_real_into M" + +lemma to_real_def_countable: + assumes "countable (space M)" + shows "to_real = (\r. real (to_nat_on (space M) r))" + using assms by(auto simp: to_real_on_def) + +lemma from_real_def_countable: + assumes "countable (space M)" + shows "from_real = (\r. from_nat_into (space M) (nat \r\))" + using assms by(simp add: from_real_into_def) + +lemma from_real_to_real[simp]: + assumes "x \ space M" + shows "from_real (to_real x) = x" +proof - + have [simp]: "space M \ {}" + using assms by auto + consider "countable (space M)" | "uncountable (space M)" by auto + then show ?thesis + proof cases + case 1 + then show ?thesis + by(simp add: to_real_def_countable from_real_def_countable assms) + next + case 2 + then obtain f where f: "measurable_isomorphic_map M (borel :: real measure) f" + using uncountable_isomorphic_to_real by(auto simp: measurable_isomorphic_def) + have 1:"to_real = Eps (measurable_isomorphic_map M borel)" "from_real = the_inv_into (space M) (Eps (measurable_isomorphic_map M borel))" + by(simp_all add: to_real_on_def 2 from_real_into_def) + show ?thesis + unfolding 1 + by(rule someI2[of "measurable_isomorphic_map M (borel :: real measure)" f,OF f]) + (meson assms bij_betw_imp_inj_on measurable_isomorphic_map_def the_inv_into_f_f) + qed +qed + +lemma to_real_measurable[measurable]: + "to_real \ M \\<^sub>M borel" +proof(cases "countable (space M)") + case 1:True + then have "sets M = Pow (space M)" + by(rule countable_discrete_space) + then show ?thesis + by(simp add: to_real_def_countable 1 borel_measurableI_le) +next + case 1:False + then obtain f where f: "measurable_isomorphic_map M (borel :: real measure) f" + using uncountable_isomorphic_to_real by(auto simp: measurable_isomorphic_def) + have 2:"to_real = Eps (measurable_isomorphic_map M borel)" + by(simp add: to_real_on_def 1 from_real_into_def) + show ?thesis + unfolding 2 + by(rule someI2[of "measurable_isomorphic_map M (borel :: real measure)" f,OF f],simp add: measurable_isomorphic_map_def) +qed + +lemma from_real_measurable': + assumes "space M \ {}" + shows "from_real \ borel \\<^sub>M M" +proof(cases "countable (space M)") + case 1:True + then have 2:"sets M = Pow (space M)" + by(rule countable_discrete_space) + have [measurable]:"from_nat_into (space M) \ count_space UNIV \\<^sub>M M" + using from_nat_into[OF assms] by auto + show ?thesis + by(simp add: from_real_def_countable 1 borel_measurableI_le) +next + case 2:False + then obtain f where f: "measurable_isomorphic_map M (borel :: real measure) f" + using uncountable_isomorphic_to_real by(auto simp: measurable_isomorphic_def) + have 1: "from_real = the_inv_into (space M) (Eps (measurable_isomorphic_map M borel))" + by(simp add: to_real_on_def 2 from_real_into_def) + show ?thesis + unfolding 1 + by(rule someI2[of "measurable_isomorphic_map M (borel :: real measure)" f,OF f],simp add: measurable_isomorphic_map_def) +qed + +lemma countable_isomorphic_to_subset_real: + assumes "countable (space M)" + obtains A :: "real set" + where "countable A" "A \ sets borel" "M measurable_isomorphic (restrict_space borel A)" +proof(cases "space M = {}") + case True + then show ?thesis + by (meson countable_empty measurable_isomorphic_empty sets.empty_sets space_restrict_space2 that) +next + case nin:False + define A where "A \ to_real ` (space M)" + have "countable A" "A \ sets borel" "M measurable_isomorphic (restrict_space borel A)" + proof - + show "countable A" "A \ sets borel" + using assms(1) standard_borel.countable_sets[of borel A] standard_borel_ne_borel by(auto simp: A_def standard_borel_ne_def) + show "M measurable_isomorphic restrict_space borel A" + using from_real_to_real A_def \A \ sets borel\ + by(auto intro!: measurable_isomorphic_byWitness[OF measurable_restrict_space2[OF _ to_real_measurable] _ measurable_restrict_space1[OF from_real_measurable'[OF nin]]]) + qed + with that show ?thesis + by auto +qed + +lemma to_real_from_real: + assumes "uncountable (space M)" + shows "to_real (from_real r) = r" +proof - + obtain f where f: "measurable_isomorphic_map M (borel :: real measure) f" + using assms uncountable_isomorphic_to_real by(auto simp: measurable_isomorphic_def) + have 1:"to_real = Eps (measurable_isomorphic_map M borel)" "from_real = the_inv_into (space M) (Eps (measurable_isomorphic_map M borel))" + by(simp_all add: to_real_on_def assms from_real_into_def) + show ?thesis + unfolding 1 + by(rule someI2[of "measurable_isomorphic_map M (borel :: real measure)" f,OF f]) + (metis UNIV_I f_the_inv_into_f_bij_betw measurable_isomorphic_map_def space_borel) +qed + +end + +lemma(in standard_borel_ne) from_real_measurable[measurable]: "from_real \ borel \\<^sub>M M" + by(simp add: from_real_measurable' space_ne) + +end \ No newline at end of file diff --git a/thys/Standard_Borel_Spaces/document/root.bib b/thys/Standard_Borel_Spaces/document/root.bib new file mode 100644 --- /dev/null +++ b/thys/Standard_Borel_Spaces/document/root.bib @@ -0,0 +1,24 @@ +@book{topology, + author = {Matsuzaka, Kazuo}, + publisher = {Iwanami Shoten}, + year = {1968}, + title={集合・位相入門 }, + note = {written in Japanese} + } + +@misc{standardborel, + title = {Lecture Note of MATH245B in {UCLA}}, + key = {Lecture Note of MATH245B}, + howpublished = {\url{https://web.archive.org/web/20210506130459/https://www.math.ucla.edu/~biskup/245b.1.20w/}}, + year = {2020}, + note = {Accessed: June 27. 2023} +} + +@book{borelsets, + title = {A Course on Borel Sets}, + author = {Shashi Mohan Srivastava}, + doi = {10.1007/b98956}, + publisher = {Springer}, + year = {1998} +} + diff --git a/thys/Standard_Borel_Spaces/document/root.tex b/thys/Standard_Borel_Spaces/document/root.tex new file mode 100644 --- /dev/null +++ b/thys/Standard_Borel_Spaces/document/root.tex @@ -0,0 +1,78 @@ +\documentclass[11pt,a4paper]{article} +\usepackage[T1]{fontenc} +\usepackage{isabelle,isabellesym} + +% further packages required for unusual symbols (see also +% isabellesym.sty), use only when needed + +\usepackage{amssymb} + %for \, \, \, \, \, \, + %\, \, \, \, \, + %\, \, \ +\usepackage{amsmath} +\usepackage{mathrsfs} +\usepackage{mathpartir} + +%\usepackage{eurosym} + %for \ + +\usepackage[only,bigsqcap]{stmaryrd} +%for \ + +%% For Japanese languages in reference. +\usepackage{luatexja} + +%\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} + + +\begin{document} + +\title{Standard Borel Spaces} +\author{Michikazu Hirata} +\maketitle +\begin{abstract} + This entry includes a formalization of standard Borel spaces + and (a variant of) the Borel isomorphism theorem. + A separable complete metrizable topological space is called a polish space + and a measurable space generated from a polish space is called a standard Borel space. + We formalize the notion of standard Borel spaces by establishing + set-based metric spaces, + and then prove (a variant of) the Borel isomorphism theorem. + The theorem states that a standard Borel spaces is either a countable discrete space + or isomorphic to $\mathbb{R}$. +\end{abstract} + +\tableofcontents + +% sane default for proof documents +\parindent 0pt\parskip 0.5ex + +% generated text of all theories +\input{session} + +% optional bibliography +\bibliographystyle{abbrv} +\bibliography{root} + +\end{document} + +%%% Local Variables: +%%% mode: latex +%%% TeX-master: t +%%% End: