From f18d7e62092be20ddac5b30b0b0558a27ec3a991 Mon Sep 17 00:00:00 2001 From: zstone Date: Mon, 3 Oct 2022 16:15:28 -0400 Subject: [PATCH 01/23] proving sups preserve countable ent proof going through unused proofs linting metric implies countable uniformity fixing changelog linting proving sups preserve countable ent proof going through unused proofs linting metric implies countable uniformity linting metric for products linting fixing docs moving cantor stuff to topology discrete metric building clopen set trying for xneqy trying to build inside out cluster set1 proving compact countable basis lots of helpful lemmas simplify proof with near_covering proof cleanup adding perfect stuff buildling tree for homeomorphism cantor_like space homeomorphism done starting cleanup deleting old stuff working through finitely branching trees proving sups preserve countable ent proof going through unused proofs linting metric implies countable uniformity fixing changelog linting proving sups preserve countable ent proof going through unused proofs linting metric implies countable uniformity linting metric for products linting fixing docs lots of helpful lemmas simplify proof with near_covering proof cleanup adding perfect stuff buildling tree for homeomorphism cantor_like space homeomorphism done starting cleanup working through finitely branching trees middle thirds refining tree indexed refinement of trees trying to define tree levels branch sets cauchy branches need finite upper bounds fixing target target now works correctly surjectivity done working on prefixes just tree prefix remaining alexandroff hausdorff is done (but terrible) whitespace --- CHANGELOG_UNRELEASED.md | 316 +++++++++ theories/cantor.v | 1427 +++++++++++++++++++++++++++++++++++++++ theories/topology.v | 82 +++ 3 files changed, 1825 insertions(+) create mode 100644 theories/cantor.v diff --git a/CHANGELOG_UNRELEASED.md b/CHANGELOG_UNRELEASED.md index 971b02c98..fd4376337 100644 --- a/CHANGELOG_UNRELEASED.md +++ b/CHANGELOG_UNRELEASED.md @@ -4,6 +4,322 @@ ### Added +- in `kernel.v`: + + `kseries` is now an instance of `Kernel_isSFinite_subdef` +- in `classical_sets.v`: + + lemma `setU_id2r` +- in `topology.v`: + + lemma `globally0` +- in `normedtype.v`: + + lemma `lipschitz_set0`, `lipschitz_set1` +- in `contructive_ereal.v`: + + lemmas `ereal_blatticeMixin`, `ereal_tblatticeMixin` + + canonicals `ereal_blatticeType`, `ereal_tblatticeType` +- in `lebesgue_measure.v`: + + lemma `emeasurable_itv` +- in `lebesgue_integral.v`: + + lemma `sfinite_Fubini` +- in `topology.v`: + + lemmas `continuous_subspaceT`, `subspaceT_continuous` +- in `constructive_ereal.v` + + lemmas `fine_le`, `fine_lt`, `fine_abse`, `abse_fin_num` +- in `lebesgue_integral.v` + + lemmas `integral_fune_lt_pinfty`, `integral_fune_fin_num` +- in `topology.v` + + lemma `weak_subspace_open` + + lemma `weak_ent_filter`, `weak_ent_refl`, `weak_ent_inv`, `weak_ent_split`, + `weak_ent_nbhs` + + definition `map_pair`, `weak_ent`, `weak_uniform_mixin`, `weak_uniformType` + + lemma `sup_ent_filter`, `sup_ent_refl`, `sup_ent_inv`, `sup_ent_split`, + `sup_ent_nbhs` + + definition `sup_ent`, `sup_uniform_mixin`, `sup_uniformType` + + definition `product_uniformType` + + lemma `uniform_entourage` + + definition `weak_ball`, `weak_pseudoMetricType` + + lemma `weak_ballE` + + lemma `finI_from_countable` + + definition `countable_uniformity` + + lemmas `countable_uniformityP`, `countable_sup_ent`, + `countable_uniformity_metric` +- in `cardinality.v` + + lemmas `eq_card1`, `card_set1`, `card_eqSP`, `countable_n_subset`, + `countable_finite_subset`, `eq_card_fset_subset`, `fset_subset_countable` +- in `classical_sets.v` + + lemmas `IIDn`, `IISl` +- in `mathcomp_extra.v` + + lemma `lez_abs2n` +- in `constructive_ereal.v`: + + lemmas `gte_addl`, `gte_addr` + + lemmas `gte_daddl`, `gte_daddr` + + lemma `lte_spadder`, `lte_spaddre` + + lemma `lte_spdadder` +- in `constructive_ereal.v`: + + lemma `sum_fine` +- in `topology.v` + + lemmas `entourage_invI`, `split_ent_subset` + + definition `countable_uniform_pseudoMetricType_mixin` +- in `reals.v`: + + lemma `floor0` +- in `classical_sets.v`: + + lemmas `set_compose_subset`, `compose_diag` + + notation `\;` for the composition of relations +- OPAM package `coq-mathcomp-classical` containing `boolp.v` +- file `all_classical.v` +- in file `mathcomp_extra.v`: + + lemmas `pred_oappE` and `pred_oapp_set` (from `classical_sets.v`) + + lemma `sumr_le0` +- in file `fsbigop.v`: + + lemmas `fsumr_ge0`, `fsumr_le0`, `fsumr_gt0`, `fsumr_lt0`, `pfsumr_eq0`, + `pair_fsbig`, `exchange_fsbig` +- in file `ereal.v`: + + notation `\sum_(_ \in _) _` (from `fsbigop.v`) + + lemmas `fsume_ge0`, `fsume_le0`, `fsume_gt0`, `fsume_lt0`, + `pfsume_eq0`, `lee_fsum_nneg_subset`, `lee_fsum`, + `ge0_mule_fsumr`, `ge0_mule_fsuml` (from `fsbigop.v`) + + lemmas `finite_supportNe`, `dual_fsumeE`, `dfsume_ge0`, `dfsume_le0`, + `dfsume_gt0`, `dfsume_lt0`, `pdfsume_eq0`, `le0_mule_dfsumr`, `le0_mule_dfsuml` +- file `classical/set_interval.v` +- in file `classical/set_interval.v`: + + definitions `neitv`, `set_itv_infty_set0`, `set_itvE`, + `disjoint_itv`, `conv`, `factor`, `ndconv` (from `set_interval.v`) + + lemmas `neitv_lt_bnd`, `set_itvP`, `subset_itvP`, `set_itvoo`, `set_itv_cc`, + `set_itvco`, `set_itvoc`, `set_itv1`, `set_itvoo0`, `set_itvoc0`, `set_itvco0`, + `set_itv_infty_infty`, `set_itv_o_infty`, `set_itv_c_infty`, `set_itv_infty_o`, + `set_itv_infty_c`, `set_itv_pinfty_bnd`, `set_itv_bnd_ninfty`, `setUitv1`, + `setU1itv`, `set_itvI`, `neitvE`, `neitvP`, `setitv0`, `has_lbound_itv`, + `has_ubound_itv`, `hasNlbound`, `hasNubound`, `opp_itv_bnd_infty`, + `opp_itv_infty_bnd`, `opp_itv_bnd_bnd`, `opp_itvoo`, + `setCitvl`, `setCitvr`, `set_itv_splitI`, `setCitv`, `set_itv_splitD`, + `mem_1B_itvcc`, `conv_id`, `convEl`, `convEr`, `conv10`, `conv0`, + `conv1`, `conv_sym`, `conv_flat`, `leW_conv`, `leW_factor`, + `factor_flat`, `factorl`, `ndconvE`, `factorr`, `factorK`, + `convK`, `conv_inj`, `factor_inj`, `conv_bij`, `factor_bij`, + `le_conv`, `le_factor`, `lt_conv`, `lt_factor`, `conv_itv_bij`, + `factor_itv_bij`, `mem_conv_itv`, `mem_conv_itvcc`, `range_conv`, + `range_factor`, `mem_factor_itv`, + `set_itv_ge`, `trivIset_set_itv_nth`, `disjoint_itvxx`, `lt_disjoint`, + `disjoint_neitv`, `neitv_bnd1`, `neitv_bnd2` (from `set_interval.v`) + + lemmas `setNK`, `lb_ubN`, `ub_lbN`, `mem_NE`, `nonemptyN`, `opp_set_eq0`, + `has_lb_ubN`, `has_ubPn`, `has_lbPn` (from `reals.v`) +- in `classical_sets.v`: + + canonical `unit_pointedType` +- in `measure.v`: + + definition `finite_measure` + + mixin `isProbability`, structure `Probability`, type `probability` + + lemma `probability_le1` + + definition `discrete_measurable_unit` + + structures `sigma_finite_additive_measure` and `sigma_finite_measure` + +- in file `topology.v`, + + new definition `perfect_set`. + + new lemmas `perfectTP`, `perfect_prod`, and `perfect_diagonal`. +- in `constructive_ereal.v`: + + lemmas `EFin_sum_fine`, `sumeN` + + lemmas `adde_defDr`, `adde_def_sum`, `fin_num_sumeN` + + lemma `fin_num_adde_defr`, `adde_defN` + +- in `constructive_ereal.v`: + + lemma `oppe_inj` + +- in `mathcomp_extra.v`: + + lemma `add_onemK` + + function `swap` +- in `classical_sets.v`: + + lemmas `setT0`, `set_unit`, `set_bool` + + lemmas `xsection_preimage_snd`, `ysection_preimage_fst` +- in `exp.v`: + + lemma `expR_ge0` +- in `measure.v` + + lemmas `measurable_curry`, `measurable_fun_fst`, `measurable_fun_snd`, + `measurable_fun_swap`, `measurable_fun_pair`, `measurable_fun_if_pair` + + lemmas `dirac0`, `diracT` + + lemma `finite_measure_sigma_finite` +- in `lebesgue_measure.v`: + + lemma `measurable_fun_opp` +- in `lebesgue_integral.v` + + lemmas `integral0_eq`, `fubini_tonelli` + + product measures now take `{measure _ -> _}` arguments and their + theory quantifies over a `{sigma_finite_measure _ -> _}`. +- in `topoogy.v` + + definitions `sup_pseudoMetricType`, `product_pseudoMetricType` + +- in `classical_sets.v`: + + lemma `trivIset_mkcond` +- in `numfun.v`: + + lemmas `xsection_indic`, `ysection_indic` +- in `classical_sets.v`: + + lemmas `xsectionI`, `ysectionI` +- in `lebesgue_integral.v`: + + notations `\x`, `\x^` for `product_measure1` and `product_measure2` + +- in `constructive_ereal.v`: + + lemmas `expeS`, `fin_numX` + +- in `functions.v`: + + lemma `countable_bijP` + + lemma `patchE` + + lemma `measurable_fun_bool` +- in `constructive_ereal.v`: + + lemma `lt0e` +- in `lebesgue_integral.v`: + + lemma `le_integral_comp_abse` + + + new lemma `dfwith_projK` +- in file `topology.v`, + + new lemmas `dfwith_continuous`, and `proj_open`. + +- in `topoogy.v` + + definitions `sup_pseudoMetricType`, `product_pseudoMetricType` + +- in file `topology.v`, + + new definitions `countable_uniformity`, `countable_uniformityT`, + `sup_pseudoMetric_mixin`, `sup_pseudoMetricType`, and + `product_pseudoMetricType`. + + new lemmas `countable_uniformityP`, `countable_sup_ent`, and + `countable_uniformity_metric`. + +- in `constructive_ereal.v`: + + lemmas `adde_def_doppeD`, `adde_def_doppeB` + + lemma `fin_num_sume_distrr` +- in `classical_sets.v`: + + lemma `coverE` + +- in file `topology.v`, + + new definitions `quotient_topology`, and `quotient_open`. + + new lemmas `pi_continuous`, `quotient_continuous`, and + `repr_comp_continuous`. + +- in file `boolp.v`, + + new lemma `forallp_asboolPn2`. +- in file `classical_sets.v`, + + new lemma `preimage_range`. +- in file `topology.v`, + + new definitions `hausdorff_accessible`, `separate_points_from_closed`, and + `join_product`. + + new lemmas `weak_sep_cvg`, `weak_sep_nbhsE`, `weak_sep_openE`, + `join_product_continuous`, `join_product_open`, `join_product_inj`, and + `join_product_weak`. + +- in file `topology.v`, + + new definition `clopen`. + + new lemmas `clopenI`, `clopenU`, `clopenC`, `clopen0`, `clopenT`, + `clopen_comp`, `connected_closure`, `clopen_separatedP`, and + `clopen_connectedP`. + +- in file `topology.v`, + + new lemmas `powerset_filter_fromP` and `compact_cluster_set1`. + +- file `itv.v`: + + definition `wider_itv` + + module `Itv`: + * definitions `map_itv_bound`, `map_itv` + * lemmas `le_map_itv_bound`, `subitv_map_itv` + * definition `itv_cond` + * record `def` + * notation `spec` + * record `typ` + * definitions `mk`, `from`, `fromP` + + notations `{itv R & i}`, `{i01 R}`, `%:itv`, `[itv of _]`, `inum`, `%:inum` + + definitions `itv_eqMixin`, `itv_choiceMixin`, `itv_porderMixin` + + canonical `itv_subType`, `itv_eqType`, `itv_choiceType`, `itv_porderType` + + lemma `itv_top_typ_subproof` + + canonical `itv_top_typ` + + lemma `typ_inum_subproof` + + canonical `typ_inum` + + notation `unify_itv` + + lemma `itv_intro` + + definition `empty_itv` + + lemmas `itv_bottom`, `itv_gt0`, `itv_le0F`, `itv_lt0`, `itv_ge0F`, `itv_ge0`, `lt0F`, `le0`, `gt0F`, `lt1`, + `ge1F`, `le1`, `gt1F` + + lemma `widen_itv_subproof` + + definition `widen_itv` + + lemma `widen_itvE` + + notation `%:i01` + + lemma `zero_inum_subproof` + + canonical `zero_inum` + + lemma `one_inum_subproof` + + canonical `one_inum` + + definition `opp_itv_bound_subdef` + + lemmas `opp_itv_ge0_subproof`, `opp_itv_gt0_subproof`, `opp_itv_boundr_subproof`, + `opp_itv_le0_subproof`, `opp_itv_lt0_subproof`, `opp_itv_boundl_subproof` + + definition `opp_itv_subdef` + + lemma `opp_inum_subproof ` + + canonical `opp_inum` + + definitions `add_itv_boundl_subdef`, `add_itv_boundr_subdef`, `add_itv_subdef` + + lemma `add_inum_subproof` + + canonical `add_inum` + + definitions `itv_bound_signl`, `itv_bound_signr`, `interval_sign` + + variant `interval_sign_spec` + + lemma `interval_signP` + + definitions `mul_itv_boundl_subdef`, `mul_itv_boundr_subdef` + + lemmas `mul_itv_boundl_subproof`, `mul_itv_boundrC_subproof`, `mul_itv_boundr_subproof`, + `mul_itv_boundr'_subproof` + + definition `mul_itv_subdef` + + lemmas `map_itv_bound_min`, `map_itv_bound_max`, `mul_inum_subproof` + + canonical `mul_inum` + + lemmas `inum_eq`, `inum_le`, `inum_lt` +- in `mathcomp_extra.v` + + lemma `ler_sqrt` +- in `constructive_ereal.v` + + definition `sqrte` + + lemmas `sqrte0`, `sqrte_ge0`, `lee_sqrt`, `sqrteM`, `sqr_sqrte`, + `sqrte_sqr`, `sqrte_fin_num` +- in `exp.v`: + + lemma `ln_power_pos` + + definition `powere_pos`, notation ``` _ `^ _ ``` in `ereal_scope` + + lemmas `powere_pos_EFin`, `powere_posyr`, `powere_pose0`, + `powere_pose1`, `powere_posNyr` `powere_pos0r`, `powere_pos1r`, + `powere_posNyr`, `fine_powere_pos`, `powere_pos_ge0`, + `powere_pos_gt0`, `powere_pos_eq0`, `powere_posM`, `powere12_sqrt` +- in `measure.v`: + + lemma `measurable_fun_bigcup` +- in `sequences.v`: + + lemma `eq_eseriesl` +- in `lebesgue_measure.v`: + + lemma `compact_measurable` + +- in `measure.v`: + + lemmas `outer_measure_subadditive`, `outer_measureU2` + +- in `lebesgue_measure.v`: + + declare `lebesgue_measure` as a `SigmaFinite` instance + + lemma `lebesgue_regularity_inner_sup` +- in `convex.v`: + + lemmas `conv_gt0`, `convRE` + +- in `exp.v`: + + lemmas `concave_ln`, `conjugate_powR` + +- in file `lebesgue_integral.v`, + + new lemmas `integral_le_bound`, `continuous_compact_integrable`, and + `lebesgue_differentiation_continuous`. + +- in `normedtype.v`: + + lemmas `open_itvoo_subset`, `open_itvcc_subset` + +- in `lebesgue_measure.v`: + + lemma `measurable_ball` + +- in file `normedtype.v`, + + new lemmas `normal_openP`, `uniform_regular`, + `regular_openP`, and `pseudometric_normal`. +- in file `topology.v`, + + new definition `regular_space`. + + new lemma `ent_closure`. + +- in file `lebesgue_integral.v`, + + new lemmas `simple_bounded`, `measurable_bounded_integrable`, + `compact_finite_measure`, `approximation_continuous_integrable` + +- in `sequences.v`: + + lemma `cvge_harmonic` + +- in `mathcomp_extra.v`: + + lemmas `le_bigmax_seq`, `bigmax_sup_seq` + +- in `constructive_ereal.v`: + + lemma `bigmaxe_fin_num` + ### Changed ### Renamed diff --git a/theories/cantor.v b/theories/cantor.v new file mode 100644 index 000000000..66a5c1e79 --- /dev/null +++ b/theories/cantor.v @@ -0,0 +1,1427 @@ +(* mathcomp analysis (c) 2017 Inria and AIST. License: CeCILL-C. *) +From mathcomp Require Import all_ssreflect ssralg ssrint ssrnum matrix . +From mathcomp Require Import interval rat fintype finmap. +Require Import mathcomp_extra boolp classical_sets signed functions cardinality. +Require Import fsbigop reals topology sequences real_interval normedtype. +From HB Require Import structures. + +Set Implicit Arguments. +Unset Strict Implicit. +Unset Printing Implicit Defensive. +Import Order.TTheory GRing.Theory Num.Def Num.Theory. +Import numFieldTopology.Exports. +Local Open Scope classical_set_scope. + +Lemma bool2E : [set: bool] = [set true; false]. +Proof. by rewrite eqEsubset; split => //= [[]] //= _;[left|right]. Qed. + +Lemma bool_predE (P : set bool -> Prop) : + (forall A, P A) = + [/\ P set0, P [set true], P [set false] & P [set true; false]]. +Proof. +rewrite propeqE; split; first by move=> Pa; split; exact: Pa. +move=> [? ? ? ?] A; have Atf : A `<=` [set true; false] by rewrite -bool2E => ?. +by have := (subset_set2 Atf); case => ->. +Qed. + +Canonical cantor_space := + product_uniformType (fun (_ : nat) => @discrete_uniformType _ discrete_bool). + +Definition countable_nat : countable [set: nat_countType]. +Proof. done. Qed. + +Canonical cantor_psuedoMetric {R} := + @product_pseudoMetricType R _ (fun (_ : nat) => + @discrete_pseudoMetricType R _ discrete_bool) countable_nat. + +Lemma cantor_space_compact: compact [set: cantor_space]. +Proof. +have := (@tychonoff _ (fun (_: nat) => _) _ (fun=> bool_compact)). +by congr (compact _) => //=; rewrite eqEsubset; split => b //=. +Qed. + +Lemma cantor_space_hausdorff : hausdorff_space cantor_space. +Proof. apply: hausdorff_product => ?; exact: discrete_hausdorff. Qed. + +Definition common_prefix (n : nat) (x y : cantor_space) := + (forall i, i < n -> x i == y i). + +Definition pull (x : cantor_space) : cantor_space := fun n => x (S n). + +Lemma common_prefixS (n : nat) (x y : cantor_space) : + common_prefix n.+1 x y <-> x 0 == y 0 /\ common_prefix n (pull x) (pull y). +Proof. +split; last by case=> ?? []. +by (move=> cmn; split; first exact: cmn) => i ?; apply: cmn. +Qed. + +Lemma empty_prefix (x : cantor_space) : common_prefix 0 x = setT . +Proof. by rewrite eqEsubset; split. Qed. + +Lemma prefix_of_prefix (x : cantor_space) (n : nat) : + common_prefix n x x. +Proof. by move=> ?. Qed. + +Lemma fixed_prefixW (x : cantor_space) (i j : nat) : + i < j -> + common_prefix j x `<=` common_prefix i x. +Proof. by move=> ij y + q ?; apply; apply: (ltn_trans _ ij). Qed. + +Lemma prefix_cvg (x : cantor_space) : + filter_from [set: nat] (common_prefix^~ x) --> x. +Proof. +have ? : Filter (filter_from [set: nat] (common_prefix^~ x)). + apply: filter_from_filter; first by exists 0. + move=> i j _ _; exists (i.+1 + j.+1) => //; rewrite -[x in x `<=` _]setIid. + by apply: setISS; apply: fixed_prefixW; [exact: ltn_addr| exact: ltn_addl]. +apply/cvg_sup => n; apply/cvg_image; first by (rewrite eqEsubset; split). +move=> W /=; rewrite /nbhs /= => /principal_filterP. +have [] := (@subset_set2 _ W true false). +- by rewrite -bool2E; exact: subsetT. +- by move ->. +- move => -> <-; exists (common_prefix (n.+1) x); first by exists (n.+1). + rewrite eqEsubset; split => y; first by case=> z P <-; apply/sym_equal/eqP/P. + by move=> ->; exists x => //=; exact: (prefix_of_prefix x (n.+1)). +- move => -> <-; exists (common_prefix (n.+1) x); first by exists (n.+1). + rewrite eqEsubset; split => y; first by case=> z P <-; apply/sym_equal/eqP/P. + by move=> ->; exists x => //=; exact: (prefix_of_prefix x (n.+1)). +- rewrite -bool2E => ->; exists setT; last by rewrite eqEsubset; split. + exact: filterT. +Qed. + +Lemma nbhs_prefix (x : cantor_space) (W : set cantor_space) : + nbhs x W -> exists n, common_prefix n x `<=` W. +Proof. by move=> /prefix_cvg => /=; case=> n _ ?; exists n. Qed. + +Lemma pull_projection_preimage (n : nat) (b : bool) : + pull @^-1` (proj n @^-1` [set b]) = proj (n.+1) @^-1` [set b]. +Proof. by rewrite eqEsubset; split=> x /=; rewrite /proj /pull /=. Qed. + +Lemma continuous_pull : continuous pull. +move=> x; apply/ cvg_sup; first by apply: fmap_filter; case: (nbhs_filter x). +move=> n; apply/cvg_image; first by apply: fmap_filter; case: (nbhs_filter x). + by rewrite eqEsubset; split=> u //= _; exists (fun=> u). +move=> W. +have Q: nbhs [set[set f n | f in A] | A in pull x @[x --> x]] [set pull x n]. + exists (proj n @^-1` [set (pull x n)]); first last. + rewrite eqEsubset; split => u //=; first by by case=> ? <- <-. + move->; exists (pull x) => //=. + apply: open_nbhs_nbhs; split. + rewrite pull_projection_preimage; apply: open_comp; last exact: discrete_open. + by move=> + _; apply: proj_continuous. + done. +have [] := (@subset_set2 _ W true false). +- by rewrite -bool2E; exact: subsetT. +- by move=> ->; rewrite /nbhs /= => /principal_filterP. +- by move -> => /= /nbhs_singleton <-; exact Q. +- by move -> => /= /nbhs_singleton <-; exact Q. +- rewrite -bool2E => -> _; exists setT; last by rewrite eqEsubset; split. + by rewrite /= preimage_setT; exact: filterT. +Qed. + +Lemma open_prefix (x : cantor_space) (n : nat) : + open (common_prefix n x). +Proof. +move: x; elim: n; first by move=>?; rewrite empty_prefix; exact: openT. +move=> n IH x; rewrite openE=> z /common_prefixS [/eqP x0z0] cmn; near=> y. +apply/common_prefixS; split. + apply/eqP; rewrite x0z0; apply: sym_equal; near: y; near_simpl. + have : open_nbhs (z : cantor_space) (proj 0 @^-1` [set (z 0)]). + (split; last by []); apply: open_comp => //=; last exact: discrete_open. + by move=> + _; exact: proj_continuous. + by rewrite open_nbhsE => [[_]]. +by near: y; by move: (IH (pull x)); rewrite openE => /(_ _ cmn)/continuous_pull. +Unshelve. all: end_near. Qed. + +Lemma closed_fixed (x : cantor_space) (n : nat) : closed (common_prefix n x). +Proof. +move: x; elim: n; first by move=> ?; rewrite empty_prefix; exact: closedT. +move=> n IH x. +pose B1 : set cantor_space := pull @^-1` common_prefix n (pull x). +pose B2 : set cantor_space := proj 0 @^-1` [set x 0]. +suff <- : B1 `&` B2 = common_prefix n.+1 x. + apply: closedI; apply: closed_comp. + - move=> + _; exact: continuous_pull. + - exact: IH. + - move=> + _; exact: proj_continuous. + - apply: compact_closed => //=; last exact: compact_set1. + exact: discrete_hausdorff. +rewrite eqEsubset; split => y /=; rewrite common_prefixS; case=> P Q. +(split => //; first (by apply/eqP)). +by move/eqP: P. +Qed. + +Section perfect_sets. + +Implicit Types (T : topologicalType). + +Definition perfect_set {T} (A : set T) := closed A /\ limit_point A = A. + +Lemma perfectTP {T} : perfect_set [set: T] <-> forall x : T, ~ open [set x]. +Proof. +split. + case=> _; rewrite eqEsubset; case=> _ + x Ox => /(_ x I [set x]). + by case; [by apply: open_nbhs_nbhs; split |] => y [+ _] => /[swap] -> /eqP. +move=> NOx; split; [exact: closedT |]; rewrite eqEsubset; split => x // _. +move=> U; rewrite nbhsE; case=> V [][] oV Vx VU. +have Vnx: V != [set x] by apply/eqP => M; apply: (NOx x); rewrite -M. +have /existsNP [y /existsNP [Vy Ynx]] : ~ forall y, V y -> y = x. + move/negP: Vnx; apply: contra_not => Vxy; apply/eqP; rewrite eqEsubset. + by split => // ? ->. +by exists y; split => //; [exact/eqP | exact: VU]. +Qed. + +Lemma perfectTP2 {T} : perfect_set [set: T] <-> + forall (U : set T), open U -> U!=set0 -> + exists x y, U x /\ U y /\ x != y. +Proof. +apply: iff_trans; first exact: perfectTP; split. + move=> nx1 U oU [] x Ux; exists x. + have : U <> [set x] by move=> Ux1; apply: (nx1 x); rewrite -Ux1. + apply: contra_notP; move/not_existsP/contrapT=> Uyx; rewrite eqEsubset. + (split => //; last by move=> ? ->); move=> y Uy; have /not_andP := Uyx y. + by case => // /not_andP; case => // /negP; rewrite negbK => /eqP ->. +move=> Unxy x Ox; have [] := Unxy _ Ox; first by exists x. +by move=> y [] ? [->] [->] /eqP. +Qed. + + +Lemma perfect_prod {I : Type} (i : I) (K : I -> topologicalType) : + perfect_set [set: K i] -> perfect_set [set: product_topologicalType K]. +Proof. +move=> /perfectTP KPo; apply/perfectTP => f oF; apply: (KPo (f i)). +rewrite (_ : [set f i] = proj i @` [set f]). + by apply: (@proj_open (classicType_choiceType I) _ i); exact: oF. +by rewrite eqEsubset; split => ? //; [move=> -> /=; exists f | case=> g ->]. +Qed. + +Lemma perfect_diagonal (K : nat_topologicalType -> topologicalType) : + (forall i, exists (xy: K i * K i), xy.1 != xy.2) -> + perfect_set [set: product_topologicalType K]. +Proof. +move=> npts; split; [exact: closedT|]; rewrite eqEsubset; split => f // _. +pose distincts := fun (i : nat) => projT1 (sigW (npts i)). +pose derange := fun (i : nat) (z : K i) => + if z == (distincts i).1 then (distincts i).2 else (distincts i).1. +pose g := fun N i => if (i < N)%nat then f i else derange _ (f i). +have gcvg : g @ \oo --> (f : product_topologicalType K). + apply/(@cvg_sup (product_topologicalType K)) => N U [V] [[W] oW <-] [] WfN WU. + by apply: (filterS WU); rewrite nbhs_simpl /g; exists N.+1 => // i /= ->. +move=> A /gcvg; rewrite nbhs_simpl; case=> N _ An. +exists (g N); split => //; last by apply: An; rewrite /= ?leqnn //. +apply/eqP => M; suff: g N N != f N by rewrite M; move/eqP. +rewrite /g ltnn /derange eq_sym; case: (eqVneq (f N) (distincts N).1) => //. +by move=> ->; have := projT2 (sigW (npts N)). +Qed. + +End perfect_sets. + +Section clopen. +Context {T : topologicalType}. +Definition clopen (U : set T) := open U /\ closed U. + +Lemma clopenI (U V : set T) : clopen U -> clopen V -> clopen (U `&` V). +Proof. by case=> ? ? [? ?]; split; [exact: openI | exact: closedI]. Qed. + +Lemma clopenU (U V : set T) : clopen U -> clopen V -> clopen (U `|` V). +Proof. by case=> ? ? [? ?]; split; [exact: openU | exact: closedU]. Qed. + +Lemma clopenC (U : set T) : clopen U -> clopen (~` U). +Proof. by case=> ??; split; [exact: closed_openC | exact: open_closedC]. Qed. + +Lemma clopen0 : clopen set0. +Proof. by split; [exact: open0 | exact: closed0]. Qed. + +Lemma clopenT : clopen setT. +Proof. by split; [exact: openT | exact: closedT]. Qed. +End clopen. + +Definition totally_disconnected (T : topologicalType) := + forall (x y : T), x != y -> exists A, A x /\ ~ A y /\ clopen A. + +Lemma cantor_totally_disconnected : totally_disconnected cantor_space. +Proof. +move=> x y; have := cantor_space_hausdorff; rewrite open_hausdorff => chsdf. +move=> /chsdf [[A B /=]]; rewrite ?inE => [[Ax By] [] + oB AB0]. +rewrite {1}openE => /(_ _ Ax) /nbhs_prefix [N] pfxNsubA. +exists (common_prefix N x); split => //; split. + by move=> /pfxNsubA Ay; suff : (A `&` B) y by rewrite AB0. +split; [apply: open_prefix | apply: closed_fixed]. +Qed. + +Lemma cantor_perfect : perfect_set [set: cantor_space]. +Proof. +split; [exact: closedT|]; rewrite eqEsubset; split => x // _. +move=> A /nbhs_prefix [N] pfxNsubA. +exists (fun n => if N < n then ~~ x n else x n); split => //. +- apply/eqP; rewrite funeqE; apply/existsNP; exists N.+1. + by rewrite ltnSn; exact: Bool.no_fixpoint_negb. +by apply: pfxNsubA => i /ltnW/leq_gtF ->. +Qed. + +Lemma clopen_comp {T U : topologicalType} (f : T -> U) (A : set U) : + clopen A -> continuous f -> clopen (f @^-1` A). +Proof. by case=> ? ?; split; [ exact: open_comp | exact: closed_comp]. Qed. + +Lemma totally_disconnected_prod (I : choiceType) (T : I -> topologicalType) : + (forall i, @totally_disconnected (T i)) -> + totally_disconnected (product_topologicalType T). +Proof. +move=> dctTI /= x y /eqP xneqy. +have [i /eqP /dctTI [A] [] Axi [] nAy coA] : exists i, x i <> y i. + by apply/existsNP=> W; exact/xneqy/functional_extensionality_dep. +exists (proj i @^-1` A); split;[|split] => //. +by apply: clopen_comp => //; exact: proj_continuous. +Qed. + +Lemma totally_disconnected_discrete {T} : + discrete_space T -> totally_disconnected T. +Proof. +move=> dsct x y /eqP xneqy; exists [set x]; split; [|split] => //. + by move=> W; apply: xneqy; rewrite W. +by split => //; [exact: discrete_open | exact: discrete_closed]. +Qed. + +Definition countable_basis (T : topologicalType) := exists B, + [/\ countable B, + forall A, B A -> open A & + forall (x:T) V, nbhs x V -> exists A, B A /\ nbhs x A /\ A `<=` V]. + +Definition cantor_like {R} (T : pseudoMetricType R) := + [/\ perfect_set [set: T], + compact [set: T], + hausdorff_space T + & totally_disconnected T]. + +Lemma separator_continuous {T: topologicalType} (A : set T) : + open A -> closed A -> continuous (fun x => x \in A). +Proof. +move=> oA /closed_openC oAc; apply/continuousP; rewrite bool_predE; split => _. +- by rewrite preimage_set0; exact: open0. +- suff -> : (in_mem^~ (mem A) @^-1` [set true] = A) by []. + rewrite eqEsubset; split => x //=; first by move=> /set_mem. + by move=> ?; apply/mem_set. +- suff -> : (in_mem^~ (mem A) @^-1` [set false] = ~`A) by []. + rewrite eqEsubset; split => x //=; last exact: memNset. + by move=> + /mem_set => ->. +- rewrite -bool2E preimage_setT; exact: openT. +Qed. + +Definition separates_points_from_closed {I : Type} {T : topologicalType} + {U_ : I -> topologicalType} (f_ : forall i, (T -> U_ i)) := + forall (U : set T) x, + closed U -> ~ U x -> exists i, ~ (closure (f_ i @` U)) (f_ i x). + +Lemma discrete_closed {T : topologicalType} (dsc : discrete_space T) A : + @closed T A. +Proof. rewrite -openC; exact: discrete_open. Qed. + +Lemma closure_discrete {T : topologicalType} (dsc : discrete_space T) A : + @closure T A = A. +Proof. by apply/sym_equal/closure_id; exact: discrete_closed. Qed. + +Section totally_disconnected. +Local Open Scope ring_scope. + +Lemma totally_disconnected_cvg {T : topologicalType} (x : T) : + {for x, totally_disconnected T} -> compact [set: T] -> + filter_from [set D | D x /\ clopen D] id --> x. +Proof. +pose F := filter_from [set D | D x /\ open D /\ closed D] id. +have PF : ProperFilter F. + apply: filter_from_proper; first apply: filter_from_filter. + - by exists setT; split => //; split => //; exact: openT. + - move=> A B [? [] ? ?] [? [] ? ?]; exists (A `&` B) => //. + by split => //; split; [exact: openI | exact: closedI]. + - by move=> ? [? _]; exists x. +move=> disct cmpT U Ux; rewrite nbhs_simpl -/F; wlog oU : U Ux / open U. + move: Ux; rewrite /= {1}nbhsE => [][] O [] Ox OsubU P; apply: (filterS OsubU). + by apply: P => //; [exact: open_nbhs_nbhs | case: Ox]. +have /compact_near_coveringP.1 : compact (~`U). + by apply: (subclosed_compact _ cmpT) => //; exact: open_closedC. +move=> /( _ _ _ (fun C y => ~ C y) (powerset_filter_from_filter PF)); case. + move=> y nUy; have /disct [C [Cx [] ? [] ? ?]] : x != y. + by apply/eqP => E; move: nUy; rewrite -E; apply; apply: nbhs_singleton. + exists (~`C, [set U | U `<=` C]); last by move=> [? ?] [? /subsetC]; exact. + split; first by apply: open_nbhs_nbhs; split => //; exact: closed_openC. + apply/near_powerset_filter_fromP; first by move=> ? ?; exact: subset_trans. + by exists C => //; exists C. +by move=> D [] DF Dsub [C] DC /(_ _ DC) /subsetC2/filterS; apply; exact: DF. +Qed. + +Lemma clopen_countable {T : topologicalType} : + compact [set: T] -> + countable_basis T -> + countable (@clopen T). +Proof. +move=> cmpT [B []] /fset_subset_countable cntB obase Bbase. +apply/(card_le_trans _ cntB)/pcard_surjP. +pose f := (fun (F : {fset set T}) => \bigcup_(x in [set` F]) x); exists f. +move=> D [] oD cD /=; have cmpt : cover_compact D. + by rewrite -compact_cover; exact: (subclosed_compact _ cmpT). +have h : forall (x : T), exists (V : set T), D x -> B V /\ nbhs x V /\ V `<=` D. + move=> x; case: (pselect (D x)); last by move=> ?; exists set0. + by rewrite openE in oD; move=> /oD/Bbase [A[] ? [] ? ?]; exists A. +pose h' := fun z => projT1 (cid (h z)). +have [] := @cmpt T D h'. +- by move=> z Dz; apply: obase; have [] := projT2 (cid (h z)) Dz. +- move=> z Dz; exists z => //; apply: nbhs_singleton. + by have [? []] := projT2 (cid (h z)) Dz. +move=> fs fsD DsubC; exists ([fset h' z | z in fs])%fset. + move=> U/imfsetP [z /=] /fsD /set_mem Dz ->; rewrite inE. + by have [? []] := projT2 (cid (h z)) Dz. +rewrite eqEsubset; split => z. + case=> y /imfsetP [x /= /fsD/set_mem Dx ->]; move: z. + by have [? []] := projT2 (cid (h x)) Dx. +move=> /DsubC /= [y /= yfs hyz]; exists (h' y) => //. +by rewrite set_imfset /=; exists y. +Qed. +Lemma compact_countable_base {R : realType} {T : pseudoMetricType R} : + compact [set: T] -> countable_basis T. +Proof. +have npos : forall n, ((0:R) < (n.+1%:R^-1))%R by []. +pose f : nat -> T -> (set T) := fun n z => (ball z (PosNum (npos n))%:num)^°. +move=> cmpt; have h : forall n, finSubCover [set: T] (f n) [set: T]. + move=> n; rewrite compact_cover in cmpt; apply: cmpt. + by move=> z _; rewrite /f; exact: open_interior. + move=> z _; exists z => //; rewrite /f/interior; exact: nbhsx_ballx. +pose h' := fun n => (cid (iffLR (exists2P _ _) (h n))). +pose h'' := fun n => projT1 (h' n). +pose B := \bigcup_n (f n) @` [set` (h'' n)]; exists B; split. +- apply: bigcup_countable => // n _; apply: finite_set_countable. + exact/finite_image/ finite_fset. +- by move=> z [n _ [w /= wn <-]]; exact: open_interior. +- move=> x V /nbhs_ballP [] _/posnumP[eps] ballsubV. + have [//|N] := @ltr_add_invr R 0%R (eps%:num/2) _; rewrite add0r => deleps. + have [w [wh fx]] : exists w : T, w \in h'' N /\ f N w x. + by have [_ /(_ x) [// | w ? ?]] := projT2 (h' N); exists w. + exists (f N w); split; first (by exists N); split. + by apply: open_nbhs_nbhs; split => //; exact: open_interior. + apply: (subset_trans _ ballsubV) => z bz. + rewrite [_%:num]splitr; apply: (@ball_triangle _ _ w). + by apply: (le_ball (ltW deleps)); apply/ball_sym; apply: interior_subset. + by apply: (le_ball (ltW deleps)); apply: interior_subset. +Qed. + +Section TreeStructure. +Context {T : topologicalType} (U_ : nat -> set T). +Definition clopen (U : set T) := open U /\ closed U. + +Lemma clopenI (U V : set T) : clopen U -> clopen V -> clopen (U `&` V). +Proof. by case=> ? ? [? ?]; split; [exact: openI | exact: closedI]. Qed. + +Lemma clopenU (U V : set T) : clopen U -> clopen V -> clopen (U `|` V). +Proof. by case=> ? ? [? ?]; split; [exact: openU | exact: closedU]. Qed. + +Lemma clopenC (U : set T) : clopen U -> clopen (~` U). +Proof. by case=> ??; split; [exact: closed_openC | exact: open_closedC]. Qed. + +Lemma clopen0 : clopen set0. +Proof. by split; [exact: open0 | exact: closed0]. Qed. + +Lemma clopenT : clopen setT. +Proof. by split; [exact: openT | exact: closedT]. Qed. + +Section TreeStructure. +Context {R : realType} {T : pseudoMetricType R}. +Hypothesis cantorT : cantor_like T. +Local Lemma dsctT : @totally_disconnected T. +Proof. by case: cantorT. Qed. +Local Lemma pftT : perfect_set [set: T]. +Proof. by case: cantorT. Qed. +Local Lemma cmptT : compact [set: T]. +Proof. by case: cantorT. Qed. +Local Lemma hsdfT : @hausdorff_space T. +Proof. by case: cantorT. Qed. + +Local Lemma clopen_surj : $|{surjfun [set: nat] >-> @clopen T}|. +Proof. +suff : (@clopen T = set0 \/ $|{surjfun [set: nat] >-> @clopen T}|). + by case; rewrite // eqEsubset; case=>/(_ _ clopenT). +by apply/pfcard_geP/clopen_countable/ compact_countable_base; case: cantorT. +Qed. + +Let U_ := unsquash clopen_surj. + +Local Lemma split_clopen (U : set T) : open U -> U !=set0 -> + exists V, clopen V /\ V `&` U !=set0 /\ ~`V `&` U !=set0. +Proof. +move=> oU Un0; have [x [y] [Ux] [Uy] xny] := (iffLR perfectTP2) pftT U oU Un0. +have [V [?] [?] [? ?]] := dsctT xny; exists V. +by repeat split => //; [exists x | exists y]. +Qed. + +Let split_open' (U : set T) : set T := + if pselect (open U /\ U !=set0) is left (conj oU n0) + then projT1 (cid (split_clopen oU n0)) + else set0. + +Local Lemma split_openI (U : set T) : + open U -> U !=set0 -> split_open' U `&` U !=set0. +Proof. +move=> oU Un0; rewrite /split_open'; case: pselect; last exact: absurd. +by move=> W; case: W => w1 w2; have [? []] := projT2 (cid (split_clopen w1 w2)). +Qed. + +Local Lemma split_openIC (U : set T) : + open U -> U !=set0 -> ~` (split_open' U) `&` U !=set0. +Proof. +move=> oU Un0; rewrite /split_open'; case: pselect; last exact: absurd. +by move=> W; case: W => w1 w2; have [? []] := projT2 (cid (split_clopen w1 w2)). +Qed. + +Local Lemma split_open_clopen (U : set T) : clopen (split_open' U). +Proof. +rewrite/split_open'; case: pselect; last by move=> ?; exact: clopen0. +by case=> w1 w2; have [? []] := projT2 (cid (split_clopen w1 w2)). +Qed. + +Local Fixpoint node (pfx: seq bool): set T := + match pfx with + | nil => setT + | head :: tail => + let Un := U_ (length tail) in + let Vn := node tail in + let Wn := if pselect (Un `&` Vn !=set0 /\ ~` Un `&` Vn !=set0) + then Un else split_open' Vn in + (if head then Wn else ~` Wn) `&` Vn + end. + +Local Lemma node_clopen_n0 pfx : clopen (node pfx) /\ node pfx !=set0. +Proof. +elim: pfx => /=; first (split; last by exists point). + split; [exact: openT | exact: closedT]. +move=> head tail [tail_clopen tailn0]; split; first last. + case: pselect=> UnI /=; first by case: head; case: UnI. + case head; first by apply: split_openI => //; case: tail_clopen. + by apply: split_openIC => //; case: tail_clopen. +apply: clopenI => //. +set Wn := (x in if _ then x else ~` x); suff: clopen Wn. + by move=> ?; case: head => //; exact: clopenC. +rewrite /Wn; case: pselect => P /=; last apply: split_open_clopen. +exact: funS. +Qed. + +Local Lemma node_clopen pfx : clopen (node pfx). +Proof. by have [] := node_clopen_n0 pfx. Qed. + +Local Lemma node_n0 pfx : node pfx !=set0. +Proof. by have [] := node_clopen_n0 pfx. Qed. + +Local Lemma node_subsetS b pfx : node (b :: pfx) `<=` node pfx. +Proof. by move: b; elim: pfx => //= ? ?. Qed. + +Local Lemma nodeUS pfx : node (true :: pfx) `|` node (false :: pfx) = node pfx. +rewrite eqEsubset; split; last by rewrite /= -setIUl setUv setTI. +by rewrite -[node pfx]setUid; apply: setUSS; exact: node_subsetS. +Qed. + +Local Lemma nodeIS pfx : node (true :: pfx) `&` node (false :: pfx) = set0. +Proof. +rewrite /=; set W := if _ then _ else _. +by rewrite /= -setIA [~` _ `&` _]setIC setIC -?setIA setICl ?setI0. +Qed. + +Local Lemma node_trivIset (n : nat) : trivIset [set pfx | length pfx = n] node. +Proof. +elim: n. + by move=> i j /List.length_zero_iff_nil -> /List.length_zero_iff_nil ->. +move=> n IH pfx1 pfx2 /=. +case: pfx1 => // b1 pfx1 /eq_add_S pfx1N. +case: pfx2 => // b2 pfx2 /eq_add_S pfx2N. +case=> x [] [] P1 npfx1 [] P2 npfx2; have pfxE : pfx1 = pfx2. + by apply: IH => //; exists x. +rewrite pfxE in P1, P2 *; congr (_ :: _). +have /set0P/eqP : node (b1 :: pfx2) `&` node (b2 :: pfx2) !=set0 by exists x. +by case: {P1 P2} b1; case: b2; rewrite ?nodeIS // setIC nodeIS. +Qed. + +Local Lemma nodeT (n : nat) : bigcup [set pfx | length pfx = n] node = setT. +Proof. +elim: n. + rewrite (_ : [set pfx | length pfx = 0%N] = [set [::]]) ?bigcup_set1 //. + rewrite eqEsubset; split => // ?; last by move=> ->. + by move/List.length_zero_iff_nil=> ->. +move=> N; rewrite ?eqEsubset; case=> _ IH; split => // x Tx. +have [pfx /= pfxN] := IH _ Tx; rewrite -nodeUS=> pfxX. +have [b bpfxX] : exists b, node (b :: pfx) x. + by case: pfxX=> ?; [exists true | exists false]. +by exists (b :: pfx) => //=; f_equal. +Qed. + +Local Lemma nodeUn n pfx : length pfx = S n -> + (node pfx `<=` U_ n) \/ (node pfx `&` U_ n == set0). +Proof. +case: pfx => // b pfx /= /eq_add_S pfxN; rewrite pfxN. +case: pselect => /=; case: b => //=; [left | right | |] => //=. +- by rewrite setIC setIA setICr set0I. +- case/not_andP => /set0P/negP; rewrite negbK setIC -setIA => /eqP. + by move=> ->; rewrite setI0; right. + by move/subsets_disjoint => ?; left; apply: subIset; right. +- case/not_andP => /set0P/negP; rewrite negbK setIC -setIA => /eqP. + by move=> ->; rewrite setI0; right. + by move/subsets_disjoint => ?; left; apply: subIset; right. +Qed. + +Let level (n : nat) (b : bool) : set T := + bigcup [set pfx | length pfx = n] (fun pfx => node (b :: pfx)). + +Local Lemma finite_set_seq (n : nat) : + finite_set [set pfx : seq bool | length pfx = n]. +Proof. +elim: n. + rewrite (_ : [set pfx | length pfx = 0%N] = [set [::]]) //. + rewrite eqEsubset; split => // ?; last by move=> ->. + by move/List.length_zero_iff_nil=> ->. +pose L := fun (n:nat) => [set pfx : seq bool | length pfx = n]; move=> n IH. +suff : (L n.+1 = (cons true @` L n) `|` (cons false @` L n)). + by rewrite /L => - => ->; rewrite finite_setU; split; apply: finite_image. +rewrite eqEsubset; split; rewrite /L. + by case=> // b pfx /= /eq_add_S pfxn; case: b; [left | right]; exists pfx. +by move=> pfx /= [][] ? <- <-. +Qed. + +(* A technique for encoding 'cantor_like' spaces as trees. We build a new + function 'node' which encodes the homeomorphism to the cantor space. + Other than the 'tree_map is a homeomorphism', no additinal information is + will be needed outside this context. So it's OK that the definitions are + rather unpleasant *) +Section TreeStructure. +Context {R : realType} {T : pseudoMetricType R}. +Hypothesis cantorT : cantor_like T. +Local Lemma dsctT : @totally_disconnected T. +Proof. by case: cantorT. Qed. +Local Lemma pftT : perfect_set [set: T]. +Proof. by case: cantorT. Qed. +Local Lemma cmptT : compact [set: T]. +Proof. by case: cantorT. Qed. +Local Lemma hsdfT : @hausdorff_space T. +Proof. by case: cantorT. Qed. + +Local Lemma clopen_surj : $|{surjfun [set: nat] >-> @clopen T}|. +Proof. +suff : (@clopen T = set0 \/ $|{surjfun [set: nat] >-> @clopen T}|). + by case; rewrite // eqEsubset; case=>/(_ _ clopenT). +by apply/pfcard_geP/clopen_countable/ compact_countable_base; case: cantorT. +Qed. + +Let U_ := unsquash clopen_surj. + +Local Lemma split_clopen (U : set T) : open U -> U !=set0 -> + exists V, clopen V /\ V `&` U !=set0 /\ ~`V `&` U !=set0. +Proof. +move=> oU Un0; have [x [y] [Ux] [Uy] xny] := (iffLR perfectTP2) pftT U oU Un0. +have [V [?] [?] [? ?]] := dsctT xny; exists V. +by repeat split => //; [exists x | exists y]. +Qed. + +Let split_open' (U : set T) : set T := + if pselect (open U /\ U !=set0) is left (conj oU n0) + then projT1 (cid (split_clopen oU n0)) + else set0. + +Local Lemma split_openI (U : set T) : + open U -> U !=set0 -> split_open' U `&` U !=set0. +Proof. +move=> oU Un0; rewrite /split_open'; case: pselect; last exact: absurd. +by move=> W; case: W => w1 w2; have [? []] := projT2 (cid (split_clopen w1 w2)). +Qed. + +Local Lemma split_openIC (U : set T) : + open U -> U !=set0 -> ~` (split_open' U) `&` U !=set0. +Proof. +move=> oU Un0; rewrite /split_open'; case: pselect; last exact: absurd. +by move=> W; case: W => w1 w2; have [? []] := projT2 (cid (split_clopen w1 w2)). +Qed. + +Local Lemma split_open_clopen (U : set T) : clopen (split_open' U). +Proof. +rewrite/split_open'; case: pselect; last by move=> ?; exact: clopen0. +by case=> w1 w2; have [? []] := projT2 (cid (split_clopen w1 w2)). +Qed. + +Local Fixpoint node (pfx: seq bool): set T := + match pfx with + | nil => setT + | head :: tail => + let Un := U_ (length tail) in + let Vn := node tail in + let Wn := if pselect (Un `&` Vn !=set0 /\ ~` Un `&` Vn !=set0) + then Un else split_open' Vn in + (if head then Wn else ~` Wn) `&` Vn + end. + +Local Lemma node_clopen_n0 pfx : clopen (node pfx) /\ node pfx !=set0. +Proof. +elim: pfx => /=; first (split; last by exists point). + split; [exact: openT | exact: closedT]. +move=> head tail [tail_clopen tailn0]; split; first last. + case: pselect=> UnI /=; first by case: head; case: UnI. + case head; first by apply: split_openI => //; case: tail_clopen. + by apply: split_openIC => //; case: tail_clopen. +apply: clopenI => //. +set Wn := (x in if _ then x else ~` x); suff: clopen Wn. + by move=> ?; case: head => //; exact: clopenC. +rewrite /Wn; case: pselect => P /=; last apply: split_open_clopen. +exact: funS. +Qed. + +Local Lemma node_clopen pfx : clopen (node pfx). +Proof. by have [] := node_clopen_n0 pfx. Qed. + +Local Lemma node_n0 pfx : node pfx !=set0. +Proof. by have [] := node_clopen_n0 pfx. Qed. + +Local Lemma node_subsetS b pfx : node (b :: pfx) `<=` node pfx. +Proof. by move: b; elim: pfx => //= ? ?. Qed. + +Local Lemma nodeUS pfx : node (true :: pfx) `|` node (false :: pfx) = node pfx. +rewrite eqEsubset; split; last by rewrite /= -setIUl setUv setTI. +by rewrite -[node pfx]setUid; apply: setUSS; exact: node_subsetS. +Qed. + +Local Lemma nodeIS pfx : node (true :: pfx) `&` node (false :: pfx) = set0. +Proof. +rewrite /=; set W := if _ then _ else _. +by rewrite /= -setIA [~` _ `&` _]setIC setIC -?setIA setICl ?setI0. +Qed. + +Local Lemma node_trivIset (n : nat) : trivIset [set pfx | length pfx = n] node. +Proof. +elim: n. + by move=> i j /List.length_zero_iff_nil -> /List.length_zero_iff_nil ->. +move=> n IH pfx1 pfx2 /=. +case: pfx1 => // b1 pfx1 /eq_add_S pfx1N. +case: pfx2 => // b2 pfx2 /eq_add_S pfx2N. +case=> x [] [] P1 npfx1 [] P2 npfx2; have pfxE : pfx1 = pfx2. + by apply: IH => //; exists x. +rewrite pfxE in P1, P2 *; congr (_ :: _). +have /set0P/eqP : node (b1 :: pfx2) `&` node (b2 :: pfx2) !=set0 by exists x. +by case: {P1 P2} b1; case: b2; rewrite ?nodeIS // setIC nodeIS. +Qed. + +Local Lemma nodeT (n : nat) : bigcup [set pfx | length pfx = n] node = setT. +Proof. +elim: n. + rewrite (_ : [set pfx | length pfx = 0%N] = [set [::]]) ?bigcup_set1 //. + rewrite eqEsubset; split => // ?; last by move=> ->. + by move/List.length_zero_iff_nil=> ->. +move=> N; rewrite ?eqEsubset; case=> _ IH; split => // x Tx. +have [pfx /= pfxN] := IH _ Tx; rewrite -nodeUS=> pfxX. +have [b bpfxX] : exists b, node (b :: pfx) x. + by case: pfxX=> ?; [exists true | exists false]. +by exists (b :: pfx) => //=; f_equal. +Qed. + +Local Lemma nodeUn n pfx : length pfx = S n -> + (node pfx `<=` U_ n) \/ (node pfx `&` U_ n == set0). +Proof. +case: pfx => // b pfx /= /eq_add_S pfxN; rewrite pfxN. +case: pselect => /=; case: b => //=; [left | right | |] => //=. +- by rewrite setIC setIA setICr set0I. +- case/not_andP => /set0P/negP; rewrite negbK setIC -setIA => /eqP. + by move=> ->; rewrite setI0; right. + by move/subsets_disjoint => ?; left; apply: subIset; right. +- case/not_andP => /set0P/negP; rewrite negbK setIC -setIA => /eqP. + by move=> ->; rewrite setI0; right. + by move/subsets_disjoint => ?; left; apply: subIset; right. +Qed. + +Let level (n : nat) (b : bool) : set T := + bigcup [set pfx | length pfx = n] (fun pfx => node (b :: pfx)). + +Local Lemma finite_set_seq (n : nat) : + finite_set [set pfx : seq bool | length pfx = n]. +Proof. +elim: n. + rewrite (_ : [set pfx | length pfx = 0%N] = [set [::]]) //. + rewrite eqEsubset; split => // ?; last by move=> ->. + by move/List.length_zero_iff_nil=> ->. +pose L := fun (n:nat) => [set pfx : seq bool | length pfx = n]; move=> n IH. +suff : (L n.+1 = (cons true @` L n) `|` (cons false @` L n)). + by rewrite /L => - => ->; rewrite finite_setU; split; apply: finite_image. +rewrite eqEsubset; split; rewrite /L. + by case=> // b pfx /= /eq_add_S pfxn; case: b; [left | right]; exists pfx. +by move=> pfx /= [][] ? <- <-. +Qed. + +Local Lemma lvl_clopen (n : nat) (b : bool) : clopen (level n b). +Proof. +move: b; elim: n. + move=> b; rewrite /level. + rewrite (_ : [set pfx | length pfx = 0%N] = [set [::]]) ?bigcup_set1 //. + exact: node_clopen. + rewrite eqEsubset; split => // ?; last by move=> ->. + by move/List.length_zero_iff_nil=> ->. +move=> n IH b; split. + by apply: bigcup_open => pfx _; case: (node_clopen (b :: pfx)). +rewrite /level -bigsetU_fset_set. + by apply: closed_bigsetU => pfx _; case: (node_clopen (b :: pfx)). +exact: finite_set_seq. +Qed. + +Let tree_map (x : T) : cantor_space := fun n => x \in level n true. + +Local Lemma continuous_tree_map : continuous tree_map. +move=> x; apply/cvg_sup => /= n U /=; rewrite {1}/nbhs /=; case=> ? [][M oM <-]. +case => /= Mtxn /filterS; apply; rewrite /nbhs /=. +rewrite /preimage /=; apply: separator_continuous. +- by case: (lvl_clopen n true). +- by case: (lvl_clopen n true). +- by rewrite /=/nbhs /=; apply/principal_filterP. +Qed. + +Local Lemma closed_tree_map : forall (C : set T), closed C -> closed (tree_map @` C). +move=> C clC; apply: compact_closed; first exact: cantor_space_hausdorff. +apply: continuous_compact; last exact: (subclosed_compact _ cmptT). +exact/continuous_subspaceT/continuous_tree_map. +Qed. + +Local Lemma tree_map_node b (z : T) L : node (b :: L) z -> tree_map z (length L) = b. +Proof. +rewrite /tree_map; case: b => // nbz; first by apply: asboolT; exists L. +apply: asboolF; case=> M LMN nMz. + have L13x : node L `&` node M !=set0. + exists z; split; apply: node_subsetS; [exact: nbz | exact: nMz]. + have L13E := @node_trivIset (length L) _ M erefl LMN L13x. + by (suff : set0 z by apply); rewrite -(nodeIS L); split => //; rewrite L13E. +Qed. + +Local Lemma tree_map_prefix x y pfxX pfxY : + tree_map x = tree_map y -> length pfxX = length pfxY -> + node pfxX x -> node pfxY y -> pfxX = pfxY. +Proof. +move=> tmXY; move: pfxY; elim: pfxX. + by move=> pfxy ln0 _ _; apply/sym_equal/List.length_zero_iff_nil/sym_equal. +move=> b1 L1 IH pfxY; case: pfxY => // b2 L2 /eq_add_S /[dup] LN /IH L12 nx ny. +f_equal; last by case: nx; case: ny => ? ? ? ?; apply: L12. +by rewrite -(tree_map_node nx) -(tree_map_node ny) tmXY /length LN. +Qed. + +Local Lemma inj_tree_map : set_inj [set: T] tree_map. +Proof. +move=> x y _ _; apply: contra_eq => xNy. +have [V [Vx] [nVy clV]] := dsctT xNy. +have [N UNVE] : exists N, U_ N = V. + by have [N ? <-] := (@surj _ _ _ _ U_ V clV); exists N. +rewrite -{}UNVE in clV, nVy, Vx. +have [pfX [pfXx pfXN]] : exists pfX, node pfX x /\ length pfX = N.+1. + by have := nodeT N.+1; rewrite -subTset => /(_ x I) [] pfx /= ? ?; exists pfx. +have [pfY [pfYy pfYN]] : exists pfX, node pfX y /\ length pfX = N.+1. + by have := nodeT N.+1; rewrite -subTset => /(_ y I) [] pfx /= ? ?; exists pfx. +have : pfY != pfX. + apply/eqP => pfXYE; have [] := nodeUn pfYN; first by move=> /(_ y pfYy). + by rewrite pfXYE => /eqP/disjoints_subset/(_ _ pfXx). +apply: contraNN => /eqP ?; apply/eqP; apply: (@tree_map_prefix y x) => //. +by rewrite pfXN pfYN. +Qed. + +Local Fixpoint branch_prefix (f : nat -> bool) (n : nat) : seq bool := + match n with + | 0%N => [::] + | S n => f n :: branch_prefix f n + end. + +Local Lemma branch_prefix_length f n : length (branch_prefix f n) = n. +Proof. by elim: n => // n /= ->. Qed. + +Local Lemma branch_prefix_lt_subset f (i j : nat) : + (i < j)%N -> node (branch_prefix f j) `<=` node (branch_prefix f i). +Proof. +move: i; elim: j => // j IH i /ltnSE ij1; rewrite [branch_prefix _ _]/=. +apply: subset_trans; first apply: node_subsetS. +move: ij1; rewrite leq_eqVlt => /orP; case; first by move/eqP ->. +exact: IH. +Qed. + +Local Lemma branch_prefix_le_subset f (i j : nat) : + (i <= j)%N -> node (branch_prefix f j) `<=` node (branch_prefix f i). +Proof. +rewrite leq_eqVlt => /orP []; first by move/eqP ->. +exact: branch_prefix_lt_subset. +Qed. + +Local Lemma surj_tree_map : set_surj [set: T] [set: cantor_space] tree_map. +Proof. +move=> f /= _. +suff [F [PF Ff]] : exists F : set (set T), ProperFilter F /\ tree_map @ F --> f. + have [x [_ clfFx]] := cmptT PF filterT; exists x => //. + apply: cantor_space_hausdorff => U V. + move=> /continuous_tree_map/clfFx clF /Ff; rewrite ?nbhs_simpl /= => FtV. + by move: (clF _ FtV); rewrite -preimage_setI; case=> z [? ?]; exists (tree_map z). +pose G := (filter_from [set: nat] (fun n => (node (branch_prefix f n)))). +have PG : ProperFilter G. + apply: filter_from_proper; first apply: filter_from_filter. + - by exists point. + - move=> i j _ _; exists (maxn i j) => //; rewrite subsetI. + by split; apply: branch_prefix_le_subset; rewrite ?leq_maxr ?leq_maxl. + - move=> i _; apply: node_n0. +exists G; split => //; apply/cvg_sup => i U. +rewrite /= {1}/nbhs /=; case=> ? [][M oM <-]. +case => /= Mtxn /filterS; apply; rewrite /nbhs /= nbhs_simpl. +exists i.+1 => // z fiz /=; suff -> : tree_map z i = f i by done. +rewrite /tree_map; move: fiz; rewrite [branch_prefix _ _]/=; case E: (f i). + move=> nfz. apply: asboolT; exists (branch_prefix f i) => //. + exact: branch_prefix_length. +move=> nfz; apply: asboolF; case=> L Li ntz. +have := (@node_trivIset i.+1 (false :: branch_prefix f i) (true :: L)). +have -> : (false :: _ = true :: _) = False by move=> ? ?; apply/propext; split. +apply. +- by rewrite /= branch_prefix_length. +- by rewrite /= Li. +- by exists z. +Qed. + +Local Lemma tree_map_bij : bijective tree_map. +Proof. +rewrite -setTT_bijective. +by split=> //; [exact: inj_tree_map | exact: surj_tree_map ]. +Qed. + +#[local] HB.instance Definition _ := @BijTT.Build _ _ _ tree_map_bij. + +Lemma cantor_like_homeomorphism : + exists (f : {splitbij [set: T] >-> [set: cantor_space]}), + continuous f /\ + (forall A, closed A -> closed (f@`A)). +Proof. +exists tree_map. +by split; [exact: continuous_tree_map | exact: closed_tree_map ]. +Qed. + +Lemma homeomorphism_cantor_like : + exists (f : {splitbij [set: cantor_space] >-> [set: T]}), + continuous f /\ + (forall A, closed A -> closed (f@`A)). +Proof. +case: cantor_like_homeomorphism => f [ctsf clsdf]. +exists [splitbij of (f^-1)%FUN]; split. + apply/continuous_closedP => A /clsdf /=; congr(_ _). + rewrite eqEsubset; split => // z /=. + by case => t Ax <-; rewrite invK // in_setE. + move=> ?; exists (f^-1 z)%FUN => //. + by apply: funK; rewrite in_setE. +move=> A clA /=; move/continuous_closedP/(_ _ clA): ctsf; congr(_ _). +rewrite eqEsubset; split => z. + by move=> Az; exists (f z) => //; rewrite funK // in_setE. +by case=> x Ax <-; rewrite /= invK // in_setE. +Qed. +End TreeStructure. + + +Lemma cantor_like_cantor_space {R : realType}: + cantor_like (@cantor_psuedoMetric R). +Proof. +split. +- by apply: perfect_diagonal => //= _; exists (true, false). +- exact: cantor_space_compact. +- exact: cantor_space_hausdorff. +- exact: cantor_totally_disconnected. +Qed. + +Section FinitelyBranchingTrees. +Context {R : realType}. +Definition pointedDiscrete (P : pointedType) : pseudoMetricType R := + @discrete_pseudoMetricType R + (@discrete_uniformType (TopologicalType + (FilteredType P P principal_filter) + discrete_topological_mixin) + erefl) erefl. + +Definition tree_of (T : nat -> pointedType) : pseudoMetricType R := + @product_pseudoMetricType R _ + (fun n => pointedDiscrete (T n)) + countable_nat. + +Lemma cantor_like_finite_prod (T : nat -> topologicalType) : + (forall n, finite_set [set: pointedDiscrete (T n)]) -> + (forall n, (exists xy : T n * T n, xy.1 != xy.2)) -> + cantor_like (tree_of T). +Proof. +move=> finiteT twoElems; split. +- by apply perfect_diagonal => n; apply: twoElems. +- have /= := tychonoff (fun n => finite_compact (finiteT n)). + by congr (compact _) => //=; rewrite eqEsubset; split => b. +- apply (@hausdorff_product _ (fun n => pointedDiscrete (T n))). + by move=> n; exact: discrete_hausdorff. +- apply totally_disconnected_prod => ?. + exact: totally_disconnected_discrete. +Qed. + +End FinitelyBranchingTrees. + +Section CompactEmbedding. +Context {R: realType} {T : pseudoMetricType R}. + +Hypothesis cptT : compact [set: T]. +Hypothesis hsdfT : hausdorff_space T. + +Local Definition oball eps x : set T := interior (ball x eps). + +Local Lemma refine_aux (eps : R) (B : set T) : 0 < eps -> + exists (U : set (set T)), + [/\ + finite_set U, + (forall C, U C -> C `<=` B), + B `<=` bigcup U id, + (forall C, U C -> B `&` C !=set0) & + (forall C, U C -> exists t, C `<=` ball t eps) + ]. +Proof. +move:eps=>_/posnumP[eps]; have : compact (closure B). + by apply: (subclosed_compact _ cptT) => //; exact: closed_closure. +rewrite compact_cover => /(_ T (closure B) (oball eps%:num)) []. +- by move=> i _; exact: open_interior. +- move=> t clBt; exists t => //; exact: nbhsx_ballx. +move=> C CsubB cvrBcl; exists ( + (fun i => B `&` (oball eps%:num i)) @` [set` C]); split. +- exact/finite_image/finite_fset. +- by move=> ? [?] ? <-. +- move=> z Bz; have /cvrBcl [d /= Cd odz] : closure B z by exact: subset_closure. + by exists (B `&` (oball eps%:num d)) => //; exists d. +- move=> ? /= [d] Cd <-; have : closure B d by move/CsubB/set_mem:Cd. + case/(_ (oball eps%:num d)). + apply: open_nbhs_nbhs; split; [exact: open_interior | apply: nbhsx_ballx]. + by move=> e ?; exists e; rewrite setIA setIid. +- move=> ? /= [e /CsubB/set_mem] ? <-; exists e. + by apply: subset_trans; last exact: interior_subset. +Qed. + +Local Lemma harmonic_pos (n : nat) : 0 < (n.+1%:R^-1:R). +Proof. by []. Qed. + +Local Lemma harmonicS (n : nat) : (n.+2%:R^-1) < (n.+1%:R^-1) :> R. +Proof. +rewrite ltr_pinv ?inE ?unitfE ?ltr_nat //; by apply/andP. +Qed. + +Local Lemma ltn_leq_trans (n m p : nat) : + (m < n)%N -> (n <= p)%N -> (m < p)%N. +Proof. exact: (@leq_ltn_trans n (S m) (S p)). Qed. + +Local Definition tier : Type := ((set (set T)) * (nat -> set T) * nat). + +Local Lemma refine_indexed (eps : R) (B : set T) : 0 < eps -> + exists (Ufn : tier), + forall n, (n >= Ufn.2)%N -> + [/\ + B!=set0 -> Ufn.1.2 @` `I_n = Ufn.1.1 , + (forall C, Ufn.1.1 C -> C `<=` B), + B `<=` bigcup `I_n Ufn.1.2, + (forall i, B!=set0 -> B `&` Ufn.1.2 i !=set0) & + (forall i, exists t, Ufn.1.2 i `<=` ball t eps) + ]. +Proof. +case: (pselect (B != set0)); first last. + move=>/negP; rewrite negbK=> /eqP -> epspos. + exists (set0, (fun=> interior (ball point eps)), O) => n /= ?; split. + - by move/set0P/eqP. + - by move=> ?. + - by move=> ? ?. + - by move=> ? /set0P /negP. + - move=> ?; exists point; exact: interior_subset. +case/set0P => b0 Bb0 /(@refine_aux _ B) [U]. +move=> [/finite_setP [N idx] subB cvrB BIU Ueps]. +have [U0 UU0 U0b0] := cvrB _ Bb0; case/card_esym/ppcard_eqP: idx => f. +pose g := patch (fun=> U0) `I_N f; exists (U, g, N) => // n /= Nsubn; +have Ugi : forall (i : nat), U (g i). + by move=> i; rewrite /=/g patch_pred; case E: (_<_)%N => //; exact: funS. +split. +- move=> _; rewrite eqEsubset; split; first by move=> i [] ? ? <-; exact: Ugi. + move=> C /(@surj _ _ _ _ f) [m /= mN <-]. + exists m; first exact: (ltn_leq_trans mN). + by rewrite /g patchT // in_setE /=. +- by move=> C UC; exact: subB. +- move=> ? /cvrB [C] /(@surj _ _ _ _ f) [m] ? <- ?. + by exists m; [exact: (@ltn_leq_trans N) | by rewrite /=/g patchT // in_setE]. +- by move=> i ?; exact: BIU. +- by move=> i; exact: Ueps. +Qed. + +Local Definition refine (n : nat) (B : set T) : tier := + (projT1 (cid (@refine_indexed _ B (harmonic_pos n) ))). + +Local Lemma refine_spec (N : nat) (B : set T) : + let Ufn := refine N B in + [/\ + forall n, (n >= Ufn.2)%N -> B!=set0 -> Ufn.1.2 @` `I_n = Ufn.1.1, + forall C, Ufn.1.1 C -> C `<=` B, + forall n, (n >= Ufn.2)%N -> B `<=` bigcup `I_n Ufn.1.2, + forall i, B!=set0 -> B `&` Ufn.1.2 i !=set0 & + forall i, exists t, Ufn.1.2 i `<=` ball t (N.+1%:R^-1) + ]. +Proof. +split. +- by move=> n /(projT2 (cid (refine_indexed B (harmonic_pos N))) _) []. +- by have [] := projT2 (cid (refine_indexed B (harmonic_pos N))) _ (leqnn _). +- by move=> n /(projT2 (cid (refine_indexed B (harmonic_pos N))) _) []. +- by have [] := projT2 (cid (refine_indexed B (harmonic_pos N))) _ (leqnn _). +- by have [] := projT2 (cid (refine_indexed B (harmonic_pos N))) _ (leqnn _). +Qed. + +Local Fixpoint tiers (n : nat) : set tier := + if n is S m + then refine n @` (\bigcup_(Ufn in tiers m) Ufn.1.1) + else [set ([set setT], (fun=> setT), (2)%N)]. + +Local Definition lvl_aux (n : nat) : nat := + (supremum (0)%N ((fun Ufn => Ufn.2) @` tiers n)). + +Local Lemma lt02 (n : nat) : (0 \in `I_(n.+2))%N. +Proof. by rewrite in_setE. Qed. + +Local Definition lvl (n : nat) := + PointedType (`I_(lvl_aux n).+2) (exist _ O (lt02 n)). + +Local Definition Ttree := @tree_of R lvl. + +Local Fixpoint target (branch : Ttree) (n : nat) : (set T) := + if n is S m + then (refine n (target branch m) ).1.2 (projT1 (branch n)) + else setT. + +Local Lemma targetN0 (b : Ttree) (n : nat) : target b n !=set0. +Proof. +elim: n => //=; first by exists point. +move=> n [x tbnx]. +have [_ _ _ /(_ (proj1_sig (b (S n)))) + _] := @refine_spec n.+1 (target b n). +by (case; first by exists x); move=> t [? ?]; exists t. +Qed. + +Local Lemma tierN0 n Ufn : tiers n Ufn -> + Ufn.1.1 !=set0 /\ (forall V, Ufn.1.1 V -> V!=set0). +elim: n Ufn => //. + move=> ?; rewrite /tiers=> ->; split; first by exists [set: T]. + by move=> ? /= ->; exists point. +move=> n IH Ufn /= [V [t /IH [IH1 IH2]] tV <-]. +have VN0 : V!=set0 by exact: IH2. +have [/(_ (refine n.+1 V).2.+1) img _ _ UN0 _] := refine_spec (n.+1) V; split. + rewrite -img //. + by exists ((refine n.+1 V).1.2 (refine n.+1 V).2), (refine n.+1 V).2 => //=. +move=> U /=; rewrite -img //=. +by case=> M + <-; have [z [_ ?] _] := UN0 M VN0; exists z. +Qed. + +Local Lemma tiersN0 n : tiers n !=set0. +elim: n => //=; first by exists ([set [set: T]], fun=> [set: T], 2%N). +move=> n [Ufn] Ufn_tier; have [[U UfnU] _] := tierN0 Ufn_tier. +by exists (refine n.+1 U); exists U => //; exists Ufn. +Qed. + +Local Lemma refine_finite (n : nat) (B : set T) : + B!=set0 -> finite_set (refine n B).1.1. +Proof. +move=> Bn0; have [/(_ _ (leqnn _) Bn0) <- _ _ _ _] := refine_spec n B. +exact/finite_image/finite_II. +Qed. + +Local Lemma tier_finite Ufn n : tiers n Ufn -> finite_set Ufn.1.1. +Proof. +elim: n Ufn; first by move=> ? -> /=; exact: finite_set1. +move=> n IH Ufn /= [V [tr] tier_tr trV <-]; apply: refine_finite. +by have [_ ] := (tierN0 tier_tr); exact. +Qed. + + +Local Lemma tiers_finite n : finite_set (tiers n). +Proof. +elim: n; first exact: finite_set1. +move=> n IH /=; apply: finite_image; apply: bigcup_finite => //. +by move=> ? ?; apply: (@tier_finite _ n). +Qed. + +Local Lemma cauchy_branch (b : Ttree) : + cauchy (filter_from [set: nat] (target b)). +Proof. +move=> E; rewrite /= nbhs_simpl -entourage_from_ballE; case => _/posnumP[eps]. +have [] := @cvg_harmonic R (ball (0:R) eps%:num); first exact: nbhsx_ballx. +move=> n _ /(_ n (leqnn n)) /=; rewrite /ball /= sub0r normrE ger0_norm //. +move=> neps nE; exists (target b (n*2)%N.+1, target b (n*2)%N.+1). + by split; exists (n*2)%N.+1. +case=> y z [] /= rfy rfz; apply: nE; apply: (le_ball (ltW neps)) => /=. +have [_ _ _ _] := refine_spec (n * 2)%N.+1 (target b (n*2)). +move=> /= /(_ (proj1_sig (b ((n * 2)%N.+1)))) [] t rfball. +have zball := rfball z rfz; have /ball_sym yball := rfball y rfy. +have := ball_triangle yball zball; apply: le_ball. +suff P : (n*2).+2%:R^-1 <= n.+1%:R^-1/2 :> R. + by rewrite (splitr n.+1%:R^-1) ler_add //; exact: P. +rewrite -invrM // ?unitfE // ler_pinv ?inE ?unitfE; first last. + by apply/andP. + by apply/andP. +by rewrite mulrC -natrM ler_nat ?mulSn addnC ?addnS addn0. +Qed. + +Lemma ubound_finite_set (U : set nat) : + finite_set U -> ubound U !=set0. +Proof. +case/finite_setP => n; move: U; elim: n. + by move=> ?; rewrite II0 card_eq0 => /eqP ->; exists O => ?. +move=> n IH U /eq_cardSP [N UN] /IH [/= M ubdM]; exists (maxn M N). +move=> w; case: (eqVneq w N); first by move=> -> ?; exact: leq_maxr. +by move=> /eqP wN Uw; apply: leq_trans; [exact: ubdM | exact: leq_maxl]. +Qed. + +Lemma lvl_aux_ge : forall n Ufn, tiers n Ufn -> (Ufn.2 <= lvl_aux n)%N. +Proof. +elim. + move => /= ? -> /=; rewrite /lvl_aux. + rewrite (_ : [set Ufn.2 | Ufn in tiers 0] = [set 2%N]) ?supremum1 //. + rewrite eqEsubset; split => t /=; first by (do 3 case) => ? ? ? /= + <-; case. + by move=> ->; exists ([set [set: T]], fun=> [set: T], 2%N). +move=> n IH Ufn TUfn; rewrite /lvl_aux/supremum; case: ifPn. + move=> /eqP/image_set0_set0 /= /image_set0_set0/bigcup0P. + have [Ufn2 Ufn_tier] := tiersN0 n => /(_ _ Ufn_tier). + by have [/set0P/eqP + _] := @tierN0 _ Ufn2 Ufn_tier. +move=> cands. +case: xgetP => [y yA [uAy ?]|]. + apply: (@leq_trans y) => //. + by apply: uAy => /=; exists Ufn => //. +move=> /forallNP; apply: contra_notP => _; apply: nat_supremums_neq0. +apply/ubound_finite_set/finite_image/tiers_finite. +Qed. + +Lemma refine_inje n B C : B!=set0 -> + refine n B = refine n C -> B `<=` C. +Proof. +move=> ? rfnBC t Bt. +have [img _ /(_ _ (leqnn _ ) _ Bt) + _ _] := refine_spec n B. +case => m/= msmall rfbm. +have [_ /(_ _ _ _ rfbm) + _ _ _] := refine_spec n C. +apply; rewrite -rfnBC -(img _ (leqnn _)) => //. +Qed. + +Lemma refine_inj n B C : B!=set0 -> C !=set0 -> + refine n B = refine n C -> B = C. +Proof. +by move=> ? ? rfnBC; rewrite eqEsubset; split; apply: (@refine_inje n). +Qed. + +Lemma tier_target b n : tiers n.+1 (refine n.+1 (target b n)). +Proof. +elim: n; first by exists [set: T]; rewrite // bigcup_set1. +move=> n IH /=; exists ((refine n.+1 (target b n)).1.2 (projT1 (b n.+1))) => //. +exists (refine n.+1 (target b n)) => //. +have [/(_ (lvl_aux n.+1).+2) img _ _ _ _] := refine_spec n.+1 (target b n). +rewrite -img; last exact: targetN0. + by exists (projT1 (b n.+1)) => //; have := projT2 (b n.+1); rewrite in_setE. +do 2 apply: leqW; apply: lvl_aux_ge; exists (target b n) => //. +case: IH => V [ Ufn trUfn UfnV E]; exists Ufn => //. +have := UfnV; congr (_ _); apply: (@refine_inj n.+1) => //. + by have [_ ] := tierN0 trUfn; apply. +apply: targetN0. +Qed. + + +Lemma branch_subsetS b n : target b n.+1 `<=` target b n. +Proof. +have [img + _ _ _] /= := refine_spec n.+1 (target b n). +apply; rewrite -(img (lvl_aux n.+1).+2 _ ); first last. +- exact: targetN0. +- by do 2 apply: leqW; apply: lvl_aux_ge; exact: tier_target. +by exists (projT1 (b n.+1)) => //; have := projT2 (b n.+1); rewrite in_setE. +Qed. + +Lemma branch_subset b i j : (i <= j)%N -> target b j `<=` target b i. +Proof. +elim: j i; first by move => ?; rewrite leqn0 => /eqP ->. +move=> j IH i; rewrite leq_eqVlt => /orP [/eqP -> //| /IH ji1]. +exact/(subset_trans _ ji1)/branch_subsetS. +Qed. + +Lemma filter_branch b: + ProperFilter (filter_from [set: nat] (target b)). +Proof. +apply: filter_from_proper; last by move=>? _; exact: targetN0. +apply: filter_from_filter; first by exists O. +move=> i j _ _; exists (maxn i j) => // t targetIJ. +by split; apply: (branch_subset _ targetIJ); rewrite ?leq_maxl ?leq_maxr. +Qed. + +Local Lemma target_cvg b : cvg (filter_from [set: nat] (target b)). +Proof. +apply: (@compact_cauchy_cvg _ [set: T]) => //=. +- apply: filter_branch. +- apply: cauchy_branch. +- by exists O => //. +Qed. + +Local Definition bullseye (b : Ttree) : T := + lim (filter_from [set: nat] (target b)). + + +Local Fixpoint retract_aux (t : T) (n : nat) : ((set T) * lvl n) := + if n is S m + then + let rfn := refine n (retract_aux t m).1 in + get (fun (Ui :((set T) * lvl n)) => Ui.1 t /\ rfn.1.2 (projT1 Ui.2) = Ui.1) + else (setT, point). + +Local Lemma retract_refine (t : T) (n : nat) : + (retract_aux t n).1 t /\ + exists Ufn, [/\ + if n is S m then Ufn = (refine n (retract_aux t m).1) else True, + tiers n Ufn, + Ufn.1.1 (retract_aux t n).1 & + Ufn.1.2 (projT1 (retract_aux t n).2) = (retract_aux t n).1 + ]. +Proof. +elim: n; first by split => //; exists ([set setT], (fun=> setT), (2)%N). +move=> n [rtt] [Ufn [? tn retractN] ufnT]; split; first last. + exists (refine n.+1 (retract_aux t n).1) => //=; split => //. + - exists (retract_aux t n).1 => //; exists Ufn => //. + - have rtN0 : (retract_aux t n).1 !=set0 by have [_] := (tierN0 tn); exact. + case: xgetP => [[U lvln] uAx /= [? <-]|]. + have [rsurj _ _ _ _] := refine_spec n.+1 (retract_aux t n).1. + have <- /= := rsurj (lvl_aux n.+1).+2 => //. + by exists (projT1 lvln) => //; have := projT2 lvln; rewrite in_setE. + do 2 apply: leqW; apply: lvl_aux_ge; exists (retract_aux t n).1 => //. + by exists Ufn. + move=> /forallNP; apply: contra_notP => /= _. + have [rsurj _ cvr _ _] := refine_spec n.+1 (retract_aux t n).1. + have [|N Nlt rfNt] := cvr (lvl_aux n.+1).+2 _ t rtt. + do 2 apply: leqW; apply: lvl_aux_ge; exists (retract_aux t n).1 => //. + by exists Ufn. + have Nlvl : N \in `I_(lvl_aux n.+1).+2 by rewrite in_setE. + by exists ( (refine n.+1 (retract_aux t n).1).1.2 N, exist _ N Nlvl). + - case: xgetP => [[U lvln] uAx /= [? <-]|] => //. + move=> /forallNP; apply: contra_notP => /= _. + have [rsurj _ cvr _ _] := refine_spec n.+1 (retract_aux t n).1. + have [|N Nlt rfNt] := cvr (lvl_aux n.+1).+2 _ t rtt. + do 2 apply: leqW; apply: lvl_aux_ge; exists (retract_aux t n).1 => //. + by exists Ufn. + have Nlvl : N \in `I_(lvl_aux n.+1).+2 by rewrite in_setE. + by exists ( (refine n.+1 (retract_aux t n).1).1.2 N, exist _ N Nlvl). +move=> /=; case: xgetP => [[U lvln] uAx [/= //]|]. +move=> /forallNP; apply: contra_notP => /= _. +have [rsurj _ cvr _ _] := refine_spec n.+1 (retract_aux t n).1. +have [|N Nlt rfNt] := cvr (lvl_aux n.+1).+2 _ t rtt. + do 2 apply: leqW; apply: lvl_aux_ge; exists (retract_aux t n).1 => //. + by exists Ufn. +have Nlvl : N \in `I_(lvl_aux n.+1).+2 by rewrite in_setE. +by exists ( (refine n.+1 (retract_aux t n).1).1.2 N, exist _ N Nlvl). +Qed. + +Local Definition retract (t : T) : Ttree := fun n => (retract_aux t n).2. + +Local Lemma bullseye_surj : set_surj [set: Ttree] [set: T] bullseye. +Proof. +move=> t _; suff : exists f : Ttree, forall n, target f n t. + case=> f fnt; exists f => //. + apply/close_eq/close_sym => // U /open_nbhs_nbhs Ubf W Wt; exists t. + split; last exact: nbhs_singleton. + have /= [M _] := target_cvg (Ubf); apply; exact: fnt. +exists (retract t) => n; case: n => // n /=. +suff -> : target (retract t) n = (retract_aux t n).1. + by have [rtxt [Ufn] [-> trUfn ? ->]] // := retract_refine t n.+1. +elim: n => // n IH; rewrite [LHS]/= IH. +by have [_ [?] [-> ?] ] := retract_refine t n.+1. +Qed. + +Lemma bullseye_prefixE (br1 br2 : Ttree) (n : nat) : + (forall i, (i <= n)%N -> br1 i = br2 i) -> + (forall i, (i <= n)%N -> target br1 i = target br2 i). +Proof. +elim: n; first by move=> i ?; rewrite leqn0 => /eqP ->. +move=> n IH eqSn i; rewrite leq_eqVlt => /orP []; first last. + by apply: IH => // ? /leqW; exact: eqSn. +move/eqP => -> /=; rewrite IH => //; first last. + by move=> ? /leqW; exact: eqSn. +by rewrite eqSn. +Qed. + +Lemma bullseye_target_clousre (br : Ttree) (n : nat) : + closure (target br n) (bullseye br). +Proof. +move=> B /target_cvg [N] _ NsubB; suff : target br n `&` target br N !=set0. + by case=> z [??]; exists z; split => //; exact: NsubB. +move=> {NsubB}; wlog nN : N n / (n <= N)%N. + move=> WL; case/orP: (leq_total N n); last exact: WL. + rewrite setIC; exact: WL. +have [z ?] := targetN0 br N; exists z; split => //. +by apply: (branch_subset nN). +Qed. + +Lemma closed_ball_subset (M : pseudoMetricType R) (x : M) + (r0 r1 : R) : 0 < r0 -> r0 < r1 -> closed_ball x r0 `<=` ball x r1. +Proof. +move=> r00 r01; rewrite (_ : r0 = (PosNum r00)%:num) // => y. +have r0r1 : 0 < r1 - r0 by rewrite subr_gt0. +move=> /(_ (ball y (PosNum r0r1)%:num)) []; first exact: nbhsx_ballx. +move=> z [xz /ball_sym zy]; have := ball_triangle xz zy; congr(ball _ _ _). +by rewrite /= addrC -addrA [-_ + _]addrC subrr addr0. +Qed. + +Lemma bullseye_prefix (br1 br2 : Ttree) (n : nat) : + (forall i, (i <= n.+1)%N -> br1 i = br2 i) -> + ball (bullseye br1) (2 * (n.+1%:R^-1)) (bullseye br2). +Proof. +move=> pfxE; have := @bullseye_target_clousre br1 n.+1. +rewrite (@bullseye_prefixE br1 br2 n.+1) // => /= near_br1. +have /= near_br2 := @bullseye_target_clousre br2 n.+1. +have [surj _ _ _ rball] := refine_spec n.+1 (target br2 n). +have [t /= /closure_subset rfn] := rball (proj1_sig (br2 n.+1)). +have /(closed_ball_subset (harmonic_pos n.+1) (harmonicS n)) := rfn _ near_br1. +have /(closed_ball_subset (harmonic_pos n.+1) (harmonicS n)) := rfn _ near_br2. +rewrite [_ / _]splitr mulrC mulrA mulVf // div1r => /ball_sym b1 b2. +by have /ball_sym := ball_triangle b1 b2. +Qed. + +Lemma tree_prefix (y: Ttree) (n : nat) : + \forall z \near y, forall i, (i < n)%N -> y i = z i. +Proof. +elim: n; first by near=> z => ?; rewrite ltn0. +move=> n IH. +near=> z => i; rewrite leq_eqVlt => /orP []; first last. + move=> iSn; have -> := near IH z => //. + move=> /eqP/(succn_inj) ->. +near: z. + exists ((proj n)@^-1` [set (y n)]); split; last by split. + suff : @open Ttree ((proj n)@^-1` [set (y n)]) by []. + apply: open_comp; last apply: discrete_open => //. + by move=> + _; apply: proj_continuous. +Unshelve. all: end_near. Qed. + +Lemma tree_prefix_le (y: Ttree) (n : nat) : + \forall z \near y, forall i, (i <= n)%N -> y i = z i. +Proof. exact: (tree_prefix y n.+1). Qed. + +Local Lemma bullseye_cts : continuous bullseye. +Proof. +move=> x; apply/ cvg_ballP; first exact: nbhs_filter. +move=> _/posnumP[eps]. +have [] := @cvg_harmonic R (ball (0:R) eps%:num); first exact: nbhsx_ballx. +move=> n _ /(_ n (leqnn n)); rewrite /ball [x in x -> _]/= sub0r. +rewrite normrE ger0_norm // => neps; have n2 : n.+2%:R^-1 <= n.+1%:R^-1 :> R. + by rewrite ler_pinv ?inE ?unitfE ?ler_nat //; exact/andP. +near=> z. + apply/(@le_ball _ _ _ (2 * ((2 *n).+2)%:R^-1)); last apply: bullseye_prefix. + apply: le_trans; last apply/ltW/neps. + rewrite ( _ : (2 * n).+2 = 2 * n.+1)%N ?natrM; first last. + by rewrite ?mulSn ?mul0n ?addn0 ?addnS addSn. + by rewrite -[x in x/(_ * _)]mulr1 -mulf_div divrr ?unitfE // ?mul1r. +near: z. +exact: tree_prefix_le. +Unshelve. all: end_near. Qed. + +Lemma ttree_finite : cantor_like Ttree. +Proof. +apply: cantor_like_finite_prod. + by move=> n /=; apply/ finite_setP; exists (lvl_aux n).+2; exact: card_setT. +move=> n /=. +have IO : O \in `I_(lvl_aux n).+2 by rewrite in_setE. +have I1 : 1%N \in `I_(lvl_aux n).+2 by rewrite in_setE. +by exists (exist _ O IO, exist _ 1%N I1). +Qed. + +Lemma cantor_surj : exists (f : {surj [set: cantor_space] >-> [set: T]}), + continuous f. +Proof. +have [f [ctsf _]] := homeomorphism_cantor_like (ttree_finite). +have /Psurj blz := bullseye_surj. +pose g := [surj of (projT1 blz) \o f]. +exists g => /= x; apply: (@continuous_comp cantor_space Ttree). + exact: ctsf. +have <- := projT2 blz; exact: bullseye_cts. +Qed. + +End CompactEmbedding. \ No newline at end of file diff --git a/theories/topology.v b/theories/topology.v index cacc5acc0..0302213e5 100644 --- a/theories/topology.v +++ b/theories/topology.v @@ -2985,6 +2985,12 @@ Proof. by split; [exact: compact_near_covering| exact: near_covering_compact]. Qed. +Lemma compact_near_coveringE : compact = near_covering. +Proof. +apply/predeqP => E; have [P Q] := compact_near_coveringP. +by split; [exact: P | exact: Q]. +Qed. + End near_covering. Section Tychonoff. @@ -3152,6 +3158,37 @@ split=> [i|]; first by have /getPex [] := cvpFA i. by apply/cvg_sup => i; apply/cvg_image=> //; have /getPex [] := cvpFA i. Qed. +Lemma cluster_set1 {T : topologicalType} (x : T) F V : compact V -> + nbhs x V -> ProperFilter F -> F V -> cluster F = [set x] -> F --> x. +Proof. +move=> cptV nxV PF FV clFx1 U/= nbhsU; rewrite nbhs_simpl. +wlog UsubV : U nbhsU / U `<=` V. + move=> WH; apply: (@filterS _ _ _(V `&` U)) => //. + by apply: WH => //; exact: filterI. +wlog oU : U UsubV nbhsU / open U. + rewrite nbhsE in nbhsU; case: nbhsU => O [oO OsubU] /(_ O) WH. + apply: (filterS OsubU). apply: WH => //; last by case: oO. + exact: (subset_trans _ UsubV). + exact: open_nbhs_nbhs. +apply: contrapT => nFU. +pose G := filter_from [set A `\` U | A in F] id; have PG : ProperFilter G. + apply: filter_from_proper; first apply: filter_from_filter. + - by exists (V `\` U); exists V. + - move=> i j [A fA <-] [B fB <-]. + rewrite setDE setDE -setIA [~` _ `&` _]setIC -setIA setIid setIA -setDE. + by exists (A`&`B `\` U) => //; exists (A `&` B); first exact: filterI. + - move=> A [B FB <-]; apply/set0P/eqP => M; rewrite setD_eq0 in M. + by apply: nFU; apply: (filterS M). +have [//|] := cptV G; first by exists (V `\` U) => //; exists V. +move=> w [Vw clGw]. +have wnx : w != x. + apply/eqP => E; have := clGw (V `\` U) U; rewrite setDKI ?E; case => //. + by exists (V `\` U) => //; exists V. +have clFw : cluster F w. + by move=> A B FA nbhswB; apply: clGw => //; exists (A `\` U) => //; exists A. +by move/negP: wnx; apply; apply/eqP; rewrite clFx1 in clFw. +Qed. + End Tychonoff. Lemma compact_cluster_set1 {T : topologicalType} (x : T) F V : @@ -3195,6 +3232,14 @@ Lemma bigsetU_compact I (F : I -> set X) (s : seq I) (P : pred I) : compact (\big[setU/set0]_(i <- s | P i) F i). Proof. by move=> ?; elim/big_ind : _ =>//; [exact:compact0|exact:compactU]. Qed. +Lemma finite_compact (A : set X) : finite_set A -> compact A. +Proof. +case/finite_setP=> n; elim: n A. + move=> A; rewrite II0 card_eq0 => /eqP ->; exact: compact0. +move=> n IHn A /eq_cardSP [] x Ax /IHn cAx; rewrite -(setD1K Ax). +by apply: compactU => //; exact: compact_set1. +Qed. + (* The closed condition here is neccessary to make this definition work in a *) (* non-hausdorff setting. *) Definition compact_near (F : set (set X)) := @@ -5270,9 +5315,46 @@ Qed. Definition prod_pseudoMetricType_mixin := PseudoMetric.Mixin prod_ball_center prod_ball_sym prod_ball_triangle prod_entourage. End prod_PseudoMetric. + Canonical prod_pseudoMetricType (R : numDomainType) (U V : pseudoMetricType R) := PseudoMetricType (U * V) (@prod_pseudoMetricType_mixin R U V). +Section discrete_pseudoMetric. +Context {R : numDomainType} {T : topologicalType} {dsc : discrete_space T}. +Definition discrete_ball (x : T) (eps : R) y : Prop := x = y. + +Lemma discrete_ball_center x (eps : R) : 0 < eps -> discrete_ball x eps x. +Proof. by []. Qed. + +Lemma discrete_ball_sym x y (eps : R) : + discrete_ball x eps y -> discrete_ball y eps x. +Proof. by rewrite /discrete_ball => ->. Qed. + +Lemma discrete_ball_triangle x y z (e1 e2 : R) : + discrete_ball x e1 y -> discrete_ball y e2 z -> discrete_ball x (e1 + e2) z. +Proof. by rewrite /discrete_ball => -> ->. Qed. + +Lemma discrete_entourage : + @entourage (@discrete_uniformType _ dsc) = entourage_ discrete_ball. +Proof. +rewrite predeqE => P; split; last first. + by case=> e _ subP [a b] [i _] /pair_equal_spec [-> ->]; apply: subP. +move=> entP; exists 1 => //= z z12; apply: entP; exists z.1 => //=. +by rewrite {2}z12 -surjective_pairing. +Qed. + +Definition discrete_pseudoMetricType_mixin := + PseudoMetric.Mixin discrete_ball_center discrete_ball_sym + discrete_ball_triangle discrete_entourage. + +Definition discrete_pseudoMetricType := PseudoMetricType + (@discrete_uniformType _ dsc) discrete_pseudoMetricType_mixin. + +End discrete_pseudoMetric. + +Definition pseudoMetric_bool {R : realType} := + @discrete_pseudoMetricType R [topologicalType of bool] discrete_bool. + Section Nbhs_fct2. Context {T : Type} {R : numDomainType} {U V : pseudoMetricType R}. Lemma fcvg_ball2P {F : set (set U)} {G : set (set V)} From 18c0045d919689de9908c6c22d47712541244627 Mon Sep 17 00:00:00 2001 From: zstone Date: Thu, 2 Feb 2023 23:13:43 -0500 Subject: [PATCH 02/23] resolving merge stuff --- theories/cantor.v | 178 ---------------------------------------------- 1 file changed, 178 deletions(-) diff --git a/theories/cantor.v b/theories/cantor.v index 66a5c1e79..c1af3b0b8 100644 --- a/theories/cantor.v +++ b/theories/cantor.v @@ -403,184 +403,6 @@ pose B := \bigcup_n (f n) @` [set` (h'' n)]; exists B; split. by apply: (le_ball (ltW deleps)); apply: interior_subset. Qed. -Section TreeStructure. -Context {T : topologicalType} (U_ : nat -> set T). -Definition clopen (U : set T) := open U /\ closed U. - -Lemma clopenI (U V : set T) : clopen U -> clopen V -> clopen (U `&` V). -Proof. by case=> ? ? [? ?]; split; [exact: openI | exact: closedI]. Qed. - -Lemma clopenU (U V : set T) : clopen U -> clopen V -> clopen (U `|` V). -Proof. by case=> ? ? [? ?]; split; [exact: openU | exact: closedU]. Qed. - -Lemma clopenC (U : set T) : clopen U -> clopen (~` U). -Proof. by case=> ??; split; [exact: closed_openC | exact: open_closedC]. Qed. - -Lemma clopen0 : clopen set0. -Proof. by split; [exact: open0 | exact: closed0]. Qed. - -Lemma clopenT : clopen setT. -Proof. by split; [exact: openT | exact: closedT]. Qed. - -Section TreeStructure. -Context {R : realType} {T : pseudoMetricType R}. -Hypothesis cantorT : cantor_like T. -Local Lemma dsctT : @totally_disconnected T. -Proof. by case: cantorT. Qed. -Local Lemma pftT : perfect_set [set: T]. -Proof. by case: cantorT. Qed. -Local Lemma cmptT : compact [set: T]. -Proof. by case: cantorT. Qed. -Local Lemma hsdfT : @hausdorff_space T. -Proof. by case: cantorT. Qed. - -Local Lemma clopen_surj : $|{surjfun [set: nat] >-> @clopen T}|. -Proof. -suff : (@clopen T = set0 \/ $|{surjfun [set: nat] >-> @clopen T}|). - by case; rewrite // eqEsubset; case=>/(_ _ clopenT). -by apply/pfcard_geP/clopen_countable/ compact_countable_base; case: cantorT. -Qed. - -Let U_ := unsquash clopen_surj. - -Local Lemma split_clopen (U : set T) : open U -> U !=set0 -> - exists V, clopen V /\ V `&` U !=set0 /\ ~`V `&` U !=set0. -Proof. -move=> oU Un0; have [x [y] [Ux] [Uy] xny] := (iffLR perfectTP2) pftT U oU Un0. -have [V [?] [?] [? ?]] := dsctT xny; exists V. -by repeat split => //; [exists x | exists y]. -Qed. - -Let split_open' (U : set T) : set T := - if pselect (open U /\ U !=set0) is left (conj oU n0) - then projT1 (cid (split_clopen oU n0)) - else set0. - -Local Lemma split_openI (U : set T) : - open U -> U !=set0 -> split_open' U `&` U !=set0. -Proof. -move=> oU Un0; rewrite /split_open'; case: pselect; last exact: absurd. -by move=> W; case: W => w1 w2; have [? []] := projT2 (cid (split_clopen w1 w2)). -Qed. - -Local Lemma split_openIC (U : set T) : - open U -> U !=set0 -> ~` (split_open' U) `&` U !=set0. -Proof. -move=> oU Un0; rewrite /split_open'; case: pselect; last exact: absurd. -by move=> W; case: W => w1 w2; have [? []] := projT2 (cid (split_clopen w1 w2)). -Qed. - -Local Lemma split_open_clopen (U : set T) : clopen (split_open' U). -Proof. -rewrite/split_open'; case: pselect; last by move=> ?; exact: clopen0. -by case=> w1 w2; have [? []] := projT2 (cid (split_clopen w1 w2)). -Qed. - -Local Fixpoint node (pfx: seq bool): set T := - match pfx with - | nil => setT - | head :: tail => - let Un := U_ (length tail) in - let Vn := node tail in - let Wn := if pselect (Un `&` Vn !=set0 /\ ~` Un `&` Vn !=set0) - then Un else split_open' Vn in - (if head then Wn else ~` Wn) `&` Vn - end. - -Local Lemma node_clopen_n0 pfx : clopen (node pfx) /\ node pfx !=set0. -Proof. -elim: pfx => /=; first (split; last by exists point). - split; [exact: openT | exact: closedT]. -move=> head tail [tail_clopen tailn0]; split; first last. - case: pselect=> UnI /=; first by case: head; case: UnI. - case head; first by apply: split_openI => //; case: tail_clopen. - by apply: split_openIC => //; case: tail_clopen. -apply: clopenI => //. -set Wn := (x in if _ then x else ~` x); suff: clopen Wn. - by move=> ?; case: head => //; exact: clopenC. -rewrite /Wn; case: pselect => P /=; last apply: split_open_clopen. -exact: funS. -Qed. - -Local Lemma node_clopen pfx : clopen (node pfx). -Proof. by have [] := node_clopen_n0 pfx. Qed. - -Local Lemma node_n0 pfx : node pfx !=set0. -Proof. by have [] := node_clopen_n0 pfx. Qed. - -Local Lemma node_subsetS b pfx : node (b :: pfx) `<=` node pfx. -Proof. by move: b; elim: pfx => //= ? ?. Qed. - -Local Lemma nodeUS pfx : node (true :: pfx) `|` node (false :: pfx) = node pfx. -rewrite eqEsubset; split; last by rewrite /= -setIUl setUv setTI. -by rewrite -[node pfx]setUid; apply: setUSS; exact: node_subsetS. -Qed. - -Local Lemma nodeIS pfx : node (true :: pfx) `&` node (false :: pfx) = set0. -Proof. -rewrite /=; set W := if _ then _ else _. -by rewrite /= -setIA [~` _ `&` _]setIC setIC -?setIA setICl ?setI0. -Qed. - -Local Lemma node_trivIset (n : nat) : trivIset [set pfx | length pfx = n] node. -Proof. -elim: n. - by move=> i j /List.length_zero_iff_nil -> /List.length_zero_iff_nil ->. -move=> n IH pfx1 pfx2 /=. -case: pfx1 => // b1 pfx1 /eq_add_S pfx1N. -case: pfx2 => // b2 pfx2 /eq_add_S pfx2N. -case=> x [] [] P1 npfx1 [] P2 npfx2; have pfxE : pfx1 = pfx2. - by apply: IH => //; exists x. -rewrite pfxE in P1, P2 *; congr (_ :: _). -have /set0P/eqP : node (b1 :: pfx2) `&` node (b2 :: pfx2) !=set0 by exists x. -by case: {P1 P2} b1; case: b2; rewrite ?nodeIS // setIC nodeIS. -Qed. - -Local Lemma nodeT (n : nat) : bigcup [set pfx | length pfx = n] node = setT. -Proof. -elim: n. - rewrite (_ : [set pfx | length pfx = 0%N] = [set [::]]) ?bigcup_set1 //. - rewrite eqEsubset; split => // ?; last by move=> ->. - by move/List.length_zero_iff_nil=> ->. -move=> N; rewrite ?eqEsubset; case=> _ IH; split => // x Tx. -have [pfx /= pfxN] := IH _ Tx; rewrite -nodeUS=> pfxX. -have [b bpfxX] : exists b, node (b :: pfx) x. - by case: pfxX=> ?; [exists true | exists false]. -by exists (b :: pfx) => //=; f_equal. -Qed. - -Local Lemma nodeUn n pfx : length pfx = S n -> - (node pfx `<=` U_ n) \/ (node pfx `&` U_ n == set0). -Proof. -case: pfx => // b pfx /= /eq_add_S pfxN; rewrite pfxN. -case: pselect => /=; case: b => //=; [left | right | |] => //=. -- by rewrite setIC setIA setICr set0I. -- case/not_andP => /set0P/negP; rewrite negbK setIC -setIA => /eqP. - by move=> ->; rewrite setI0; right. - by move/subsets_disjoint => ?; left; apply: subIset; right. -- case/not_andP => /set0P/negP; rewrite negbK setIC -setIA => /eqP. - by move=> ->; rewrite setI0; right. - by move/subsets_disjoint => ?; left; apply: subIset; right. -Qed. - -Let level (n : nat) (b : bool) : set T := - bigcup [set pfx | length pfx = n] (fun pfx => node (b :: pfx)). - -Local Lemma finite_set_seq (n : nat) : - finite_set [set pfx : seq bool | length pfx = n]. -Proof. -elim: n. - rewrite (_ : [set pfx | length pfx = 0%N] = [set [::]]) //. - rewrite eqEsubset; split => // ?; last by move=> ->. - by move/List.length_zero_iff_nil=> ->. -pose L := fun (n:nat) => [set pfx : seq bool | length pfx = n]; move=> n IH. -suff : (L n.+1 = (cons true @` L n) `|` (cons false @` L n)). - by rewrite /L => - => ->; rewrite finite_setU; split; apply: finite_image. -rewrite eqEsubset; split; rewrite /L. - by case=> // b pfx /= /eq_add_S pfxn; case: b; [left | right]; exists pfx. -by move=> pfx /= [][] ? <- <-. -Qed. - (* A technique for encoding 'cantor_like' spaces as trees. We build a new function 'node' which encodes the homeomorphism to the cantor space. Other than the 'tree_map is a homeomorphism', no additinal information is From 9330206ba2e36d943d0942fa28f108400bda9820 Mon Sep 17 00:00:00 2001 From: zstone Date: Fri, 3 Feb 2023 15:14:10 -0500 Subject: [PATCH 03/23] minor cleanups --- theories/cantor.v | 149 ++++------------------------------------------ 1 file changed, 13 insertions(+), 136 deletions(-) diff --git a/theories/cantor.v b/theories/cantor.v index c1af3b0b8..fdcbaba77 100644 --- a/theories/cantor.v +++ b/theories/cantor.v @@ -43,114 +43,6 @@ Qed. Lemma cantor_space_hausdorff : hausdorff_space cantor_space. Proof. apply: hausdorff_product => ?; exact: discrete_hausdorff. Qed. -Definition common_prefix (n : nat) (x y : cantor_space) := - (forall i, i < n -> x i == y i). - -Definition pull (x : cantor_space) : cantor_space := fun n => x (S n). - -Lemma common_prefixS (n : nat) (x y : cantor_space) : - common_prefix n.+1 x y <-> x 0 == y 0 /\ common_prefix n (pull x) (pull y). -Proof. -split; last by case=> ?? []. -by (move=> cmn; split; first exact: cmn) => i ?; apply: cmn. -Qed. - -Lemma empty_prefix (x : cantor_space) : common_prefix 0 x = setT . -Proof. by rewrite eqEsubset; split. Qed. - -Lemma prefix_of_prefix (x : cantor_space) (n : nat) : - common_prefix n x x. -Proof. by move=> ?. Qed. - -Lemma fixed_prefixW (x : cantor_space) (i j : nat) : - i < j -> - common_prefix j x `<=` common_prefix i x. -Proof. by move=> ij y + q ?; apply; apply: (ltn_trans _ ij). Qed. - -Lemma prefix_cvg (x : cantor_space) : - filter_from [set: nat] (common_prefix^~ x) --> x. -Proof. -have ? : Filter (filter_from [set: nat] (common_prefix^~ x)). - apply: filter_from_filter; first by exists 0. - move=> i j _ _; exists (i.+1 + j.+1) => //; rewrite -[x in x `<=` _]setIid. - by apply: setISS; apply: fixed_prefixW; [exact: ltn_addr| exact: ltn_addl]. -apply/cvg_sup => n; apply/cvg_image; first by (rewrite eqEsubset; split). -move=> W /=; rewrite /nbhs /= => /principal_filterP. -have [] := (@subset_set2 _ W true false). -- by rewrite -bool2E; exact: subsetT. -- by move ->. -- move => -> <-; exists (common_prefix (n.+1) x); first by exists (n.+1). - rewrite eqEsubset; split => y; first by case=> z P <-; apply/sym_equal/eqP/P. - by move=> ->; exists x => //=; exact: (prefix_of_prefix x (n.+1)). -- move => -> <-; exists (common_prefix (n.+1) x); first by exists (n.+1). - rewrite eqEsubset; split => y; first by case=> z P <-; apply/sym_equal/eqP/P. - by move=> ->; exists x => //=; exact: (prefix_of_prefix x (n.+1)). -- rewrite -bool2E => ->; exists setT; last by rewrite eqEsubset; split. - exact: filterT. -Qed. - -Lemma nbhs_prefix (x : cantor_space) (W : set cantor_space) : - nbhs x W -> exists n, common_prefix n x `<=` W. -Proof. by move=> /prefix_cvg => /=; case=> n _ ?; exists n. Qed. - -Lemma pull_projection_preimage (n : nat) (b : bool) : - pull @^-1` (proj n @^-1` [set b]) = proj (n.+1) @^-1` [set b]. -Proof. by rewrite eqEsubset; split=> x /=; rewrite /proj /pull /=. Qed. - -Lemma continuous_pull : continuous pull. -move=> x; apply/ cvg_sup; first by apply: fmap_filter; case: (nbhs_filter x). -move=> n; apply/cvg_image; first by apply: fmap_filter; case: (nbhs_filter x). - by rewrite eqEsubset; split=> u //= _; exists (fun=> u). -move=> W. -have Q: nbhs [set[set f n | f in A] | A in pull x @[x --> x]] [set pull x n]. - exists (proj n @^-1` [set (pull x n)]); first last. - rewrite eqEsubset; split => u //=; first by by case=> ? <- <-. - move->; exists (pull x) => //=. - apply: open_nbhs_nbhs; split. - rewrite pull_projection_preimage; apply: open_comp; last exact: discrete_open. - by move=> + _; apply: proj_continuous. - done. -have [] := (@subset_set2 _ W true false). -- by rewrite -bool2E; exact: subsetT. -- by move=> ->; rewrite /nbhs /= => /principal_filterP. -- by move -> => /= /nbhs_singleton <-; exact Q. -- by move -> => /= /nbhs_singleton <-; exact Q. -- rewrite -bool2E => -> _; exists setT; last by rewrite eqEsubset; split. - by rewrite /= preimage_setT; exact: filterT. -Qed. - -Lemma open_prefix (x : cantor_space) (n : nat) : - open (common_prefix n x). -Proof. -move: x; elim: n; first by move=>?; rewrite empty_prefix; exact: openT. -move=> n IH x; rewrite openE=> z /common_prefixS [/eqP x0z0] cmn; near=> y. -apply/common_prefixS; split. - apply/eqP; rewrite x0z0; apply: sym_equal; near: y; near_simpl. - have : open_nbhs (z : cantor_space) (proj 0 @^-1` [set (z 0)]). - (split; last by []); apply: open_comp => //=; last exact: discrete_open. - by move=> + _; exact: proj_continuous. - by rewrite open_nbhsE => [[_]]. -by near: y; by move: (IH (pull x)); rewrite openE => /(_ _ cmn)/continuous_pull. -Unshelve. all: end_near. Qed. - -Lemma closed_fixed (x : cantor_space) (n : nat) : closed (common_prefix n x). -Proof. -move: x; elim: n; first by move=> ?; rewrite empty_prefix; exact: closedT. -move=> n IH x. -pose B1 : set cantor_space := pull @^-1` common_prefix n (pull x). -pose B2 : set cantor_space := proj 0 @^-1` [set x 0]. -suff <- : B1 `&` B2 = common_prefix n.+1 x. - apply: closedI; apply: closed_comp. - - move=> + _; exact: continuous_pull. - - exact: IH. - - move=> + _; exact: proj_continuous. - - apply: compact_closed => //=; last exact: compact_set1. - exact: discrete_hausdorff. -rewrite eqEsubset; split => y /=; rewrite common_prefixS; case=> P Q. -(split => //; first (by apply/eqP)). -by move/eqP: P. -Qed. - Section perfect_sets. Implicit Types (T : topologicalType). @@ -239,25 +131,6 @@ End clopen. Definition totally_disconnected (T : topologicalType) := forall (x y : T), x != y -> exists A, A x /\ ~ A y /\ clopen A. -Lemma cantor_totally_disconnected : totally_disconnected cantor_space. -Proof. -move=> x y; have := cantor_space_hausdorff; rewrite open_hausdorff => chsdf. -move=> /chsdf [[A B /=]]; rewrite ?inE => [[Ax By] [] + oB AB0]. -rewrite {1}openE => /(_ _ Ax) /nbhs_prefix [N] pfxNsubA. -exists (common_prefix N x); split => //; split. - by move=> /pfxNsubA Ay; suff : (A `&` B) y by rewrite AB0. -split; [apply: open_prefix | apply: closed_fixed]. -Qed. - -Lemma cantor_perfect : perfect_set [set: cantor_space]. -Proof. -split; [exact: closedT|]; rewrite eqEsubset; split => x // _. -move=> A /nbhs_prefix [N] pfxNsubA. -exists (fun n => if N < n then ~~ x n else x n); split => //. -- apply/eqP; rewrite funeqE; apply/existsNP; exists N.+1. - by rewrite ltnSn; exact: Bool.no_fixpoint_negb. -by apply: pfxNsubA => i /ltnW/leq_gtF ->. -Qed. Lemma clopen_comp {T U : topologicalType} (f : T -> U) (A : set U) : clopen A -> continuous f -> clopen (f @^-1` A). @@ -282,12 +155,22 @@ move=> dsct x y /eqP xneqy; exists [set x]; split; [|split] => //. by split => //; [exact: discrete_open | exact: discrete_closed]. Qed. +Lemma cantor_totally_disconnected : totally_disconnected cantor_space. +Proof. +by apply: totally_disconnected_prod => _; apply: totally_disconnected_discrete. +Qed. + +Lemma cantor_perfect : perfect_set [set: cantor_space]. +Proof. +by apply: perfect_diagonal => _; exists (true, false). +Qed. + Definition countable_basis (T : topologicalType) := exists B, [/\ countable B, forall A, B A -> open A & forall (x:T) V, nbhs x V -> exists A, B A /\ nbhs x A /\ A `<=` V]. -Definition cantor_like {R} (T : pseudoMetricType R) := +Definition cantor_like (T : topologicalType) := [/\ perfect_set [set: T], compact [set: T], hausdorff_space T @@ -307,11 +190,6 @@ move=> oA /closed_openC oAc; apply/continuousP; rewrite bool_predE; split => _. - rewrite -bool2E preimage_setT; exact: openT. Qed. -Definition separates_points_from_closed {I : Type} {T : topologicalType} - {U_ : I -> topologicalType} (f_ : forall i, (T -> U_ i)) := - forall (U : set T) x, - closed U -> ~ U x -> exists i, ~ (closure (f_ i @` U)) (f_ i x). - Lemma discrete_closed {T : topologicalType} (dsc : discrete_space T) A : @closed T A. Proof. rewrite -openC; exact: discrete_open. Qed. @@ -349,7 +227,7 @@ move=> /( _ _ _ (fun C y => ~ C y) (powerset_filter_from_filter PF)); case. by move=> D [] DF Dsub [C] DC /(_ _ DC) /subsetC2/filterS; apply; exact: DF. Qed. -Lemma clopen_countable {T : topologicalType} : +Lemma clopen_countable {T : topologicalType}: compact [set: T] -> countable_basis T -> countable (@clopen T). @@ -731,8 +609,7 @@ Qed. End TreeStructure. -Lemma cantor_like_cantor_space {R : realType}: - cantor_like (@cantor_psuedoMetric R). +Lemma cantor_like_cantor_space: cantor_like (cantor_space). Proof. split. - by apply: perfect_diagonal => //= _; exists (true, false). From 2680306568e63fdce2c2d746ff803d893fe43afa Mon Sep 17 00:00:00 2001 From: zstone Date: Mon, 20 Feb 2023 15:48:47 -0500 Subject: [PATCH 04/23] unneeded lemma --- theories/topology.v | 31 ------------------------------- 1 file changed, 31 deletions(-) diff --git a/theories/topology.v b/theories/topology.v index 0302213e5..91a9ba4ca 100644 --- a/theories/topology.v +++ b/theories/topology.v @@ -3158,37 +3158,6 @@ split=> [i|]; first by have /getPex [] := cvpFA i. by apply/cvg_sup => i; apply/cvg_image=> //; have /getPex [] := cvpFA i. Qed. -Lemma cluster_set1 {T : topologicalType} (x : T) F V : compact V -> - nbhs x V -> ProperFilter F -> F V -> cluster F = [set x] -> F --> x. -Proof. -move=> cptV nxV PF FV clFx1 U/= nbhsU; rewrite nbhs_simpl. -wlog UsubV : U nbhsU / U `<=` V. - move=> WH; apply: (@filterS _ _ _(V `&` U)) => //. - by apply: WH => //; exact: filterI. -wlog oU : U UsubV nbhsU / open U. - rewrite nbhsE in nbhsU; case: nbhsU => O [oO OsubU] /(_ O) WH. - apply: (filterS OsubU). apply: WH => //; last by case: oO. - exact: (subset_trans _ UsubV). - exact: open_nbhs_nbhs. -apply: contrapT => nFU. -pose G := filter_from [set A `\` U | A in F] id; have PG : ProperFilter G. - apply: filter_from_proper; first apply: filter_from_filter. - - by exists (V `\` U); exists V. - - move=> i j [A fA <-] [B fB <-]. - rewrite setDE setDE -setIA [~` _ `&` _]setIC -setIA setIid setIA -setDE. - by exists (A`&`B `\` U) => //; exists (A `&` B); first exact: filterI. - - move=> A [B FB <-]; apply/set0P/eqP => M; rewrite setD_eq0 in M. - by apply: nFU; apply: (filterS M). -have [//|] := cptV G; first by exists (V `\` U) => //; exists V. -move=> w [Vw clGw]. -have wnx : w != x. - apply/eqP => E; have := clGw (V `\` U) U; rewrite setDKI ?E; case => //. - by exists (V `\` U) => //; exists V. -have clFw : cluster F w. - by move=> A B FA nbhswB; apply: clGw => //; exists (A `\` U) => //; exists A. -by move/negP: wnx; apply; apply/eqP; rewrite clFx1 in clFw. -Qed. - End Tychonoff. Lemma compact_cluster_set1 {T : topologicalType} (x : T) F V : From 7e1e57b2656740b713c3240a20b469b3de30923c Mon Sep 17 00:00:00 2001 From: zstone Date: Wed, 22 Feb 2023 17:35:03 -0500 Subject: [PATCH 05/23] fixing merge --- theories/cantor.v | 100 +++++++------------------------------------- theories/topology.v | 6 --- 2 files changed, 15 insertions(+), 91 deletions(-) diff --git a/theories/cantor.v b/theories/cantor.v index fdcbaba77..d9c35f581 100644 --- a/theories/cantor.v +++ b/theories/cantor.v @@ -46,96 +46,28 @@ Proof. apply: hausdorff_product => ?; exact: discrete_hausdorff. Qed. Section perfect_sets. Implicit Types (T : topologicalType). - -Definition perfect_set {T} (A : set T) := closed A /\ limit_point A = A. - -Lemma perfectTP {T} : perfect_set [set: T] <-> forall x : T, ~ open [set x]. -Proof. -split. - case=> _; rewrite eqEsubset; case=> _ + x Ox => /(_ x I [set x]). - by case; [by apply: open_nbhs_nbhs; split |] => y [+ _] => /[swap] -> /eqP. -move=> NOx; split; [exact: closedT |]; rewrite eqEsubset; split => x // _. -move=> U; rewrite nbhsE; case=> V [][] oV Vx VU. -have Vnx: V != [set x] by apply/eqP => M; apply: (NOx x); rewrite -M. -have /existsNP [y /existsNP [Vy Ynx]] : ~ forall y, V y -> y = x. - move/negP: Vnx; apply: contra_not => Vxy; apply/eqP; rewrite eqEsubset. - by split => // ? ->. -by exists y; split => //; [exact/eqP | exact: VU]. -Qed. - -Lemma perfectTP2 {T} : perfect_set [set: T] <-> - forall (U : set T), open U -> U!=set0 -> - exists x y, U x /\ U y /\ x != y. +Lemma perfect_set2 {T} : perfect_set [set: T] <-> + forall (U : set T), open U -> U !=set0 -> + exists x y, [/\ U x, U y & x != y] . Proof. + apply: iff_trans; first exact: perfectTP; split. move=> nx1 U oU [] x Ux; exists x. have : U <> [set x] by move=> Ux1; apply: (nx1 x); rewrite -Ux1. apply: contra_notP; move/not_existsP/contrapT=> Uyx; rewrite eqEsubset. - (split => //; last by move=> ? ->); move=> y Uy; have /not_andP := Uyx y. - by case => // /not_andP; case => // /negP; rewrite negbK => /eqP ->. + (split => //; last by move=> ? ->); move=> y Uy; have /not_and3P := Uyx y. + by case => // /negP; rewrite negbK => /eqP ->. move=> Unxy x Ox; have [] := Unxy _ Ox; first by exists x. -by move=> y [] ? [->] [->] /eqP. -Qed. - - -Lemma perfect_prod {I : Type} (i : I) (K : I -> topologicalType) : - perfect_set [set: K i] -> perfect_set [set: product_topologicalType K]. -Proof. -move=> /perfectTP KPo; apply/perfectTP => f oF; apply: (KPo (f i)). -rewrite (_ : [set f i] = proj i @` [set f]). - by apply: (@proj_open (classicType_choiceType I) _ i); exact: oF. -by rewrite eqEsubset; split => ? //; [move=> -> /=; exists f | case=> g ->]. -Qed. - -Lemma perfect_diagonal (K : nat_topologicalType -> topologicalType) : - (forall i, exists (xy: K i * K i), xy.1 != xy.2) -> - perfect_set [set: product_topologicalType K]. -Proof. -move=> npts; split; [exact: closedT|]; rewrite eqEsubset; split => f // _. -pose distincts := fun (i : nat) => projT1 (sigW (npts i)). -pose derange := fun (i : nat) (z : K i) => - if z == (distincts i).1 then (distincts i).2 else (distincts i).1. -pose g := fun N i => if (i < N)%nat then f i else derange _ (f i). -have gcvg : g @ \oo --> (f : product_topologicalType K). - apply/(@cvg_sup (product_topologicalType K)) => N U [V] [[W] oW <-] [] WfN WU. - by apply: (filterS WU); rewrite nbhs_simpl /g; exists N.+1 => // i /= ->. -move=> A /gcvg; rewrite nbhs_simpl; case=> N _ An. -exists (g N); split => //; last by apply: An; rewrite /= ?leqnn //. -apply/eqP => M; suff: g N N != f N by rewrite M; move/eqP. -rewrite /g ltnn /derange eq_sym; case: (eqVneq (f N) (distincts N).1) => //. -by move=> ->; have := projT2 (sigW (npts N)). +by move=> y [] ? [->] -> /eqP. Qed. End perfect_sets. Section clopen. -Context {T : topologicalType}. -Definition clopen (U : set T) := open U /\ closed U. - -Lemma clopenI (U V : set T) : clopen U -> clopen V -> clopen (U `&` V). -Proof. by case=> ? ? [? ?]; split; [exact: openI | exact: closedI]. Qed. - -Lemma clopenU (U V : set T) : clopen U -> clopen V -> clopen (U `|` V). -Proof. by case=> ? ? [? ?]; split; [exact: openU | exact: closedU]. Qed. - -Lemma clopenC (U : set T) : clopen U -> clopen (~` U). -Proof. by case=> ??; split; [exact: closed_openC | exact: open_closedC]. Qed. - -Lemma clopen0 : clopen set0. -Proof. by split; [exact: open0 | exact: closed0]. Qed. - -Lemma clopenT : clopen setT. -Proof. by split; [exact: openT | exact: closedT]. Qed. -End clopen. - Definition totally_disconnected (T : topologicalType) := forall (x y : T), x != y -> exists A, A x /\ ~ A y /\ clopen A. -Lemma clopen_comp {T U : topologicalType} (f : T -> U) (A : set U) : - clopen A -> continuous f -> clopen (f @^-1` A). -Proof. by case=> ? ?; split; [ exact: open_comp | exact: closed_comp]. Qed. - Lemma totally_disconnected_prod (I : choiceType) (T : I -> topologicalType) : (forall i, @totally_disconnected (T i)) -> totally_disconnected (product_topologicalType T). @@ -213,9 +145,9 @@ have PF : ProperFilter F. by split => //; split; [exact: openI | exact: closedI]. - by move=> ? [? _]; exists x. move=> disct cmpT U Ux; rewrite nbhs_simpl -/F; wlog oU : U Ux / open U. - move: Ux; rewrite /= {1}nbhsE => [][] O [] Ox OsubU P; apply: (filterS OsubU). + move: Ux; rewrite /= {1}nbhsE => [][] O Ox OsubU P; apply: (filterS OsubU). by apply: P => //; [exact: open_nbhs_nbhs | case: Ox]. -have /compact_near_coveringP.1 : compact (~`U). +have /(iffLR (compact_near_coveringP _)): compact (~`U). by apply: (subclosed_compact _ cmpT) => //; exact: open_closedC. move=> /( _ _ _ (fun C y => ~ C y) (powerset_filter_from_filter PF)); case. move=> y nUy; have /disct [C [Cx [] ? [] ? ?]] : x != y. @@ -259,7 +191,7 @@ Lemma compact_countable_base {R : realType} {T : pseudoMetricType R} : Proof. have npos : forall n, ((0:R) < (n.+1%:R^-1))%R by []. pose f : nat -> T -> (set T) := fun n z => (ball z (PosNum (npos n))%:num)^°. -move=> cmpt; have h : forall n, finSubCover [set: T] (f n) [set: T]. +move=> cmpt; have h : forall n, finite_subset_cover [set: T] (f n) [set: T]. move=> n; rewrite compact_cover in cmpt; apply: cmpt. by move=> z _; rewrite /f; exact: open_interior. move=> z _; exists z => //; rewrite /f/interior; exact: nbhsx_ballx. @@ -310,7 +242,7 @@ Let U_ := unsquash clopen_surj. Local Lemma split_clopen (U : set T) : open U -> U !=set0 -> exists V, clopen V /\ V `&` U !=set0 /\ ~`V `&` U !=set0. Proof. -move=> oU Un0; have [x [y] [Ux] [Uy] xny] := (iffLR perfectTP2) pftT U oU Un0. +move=> oU Un0; have [x [y] [Ux] Uy xny] := (iffLR perfect_set2) pftT U oU Un0. have [V [?] [?] [? ?]] := dsctT xny; exists V. by repeat split => //; [exists x | exists y]. Qed. @@ -464,8 +396,7 @@ Let tree_map (x : T) : cantor_space := fun n => x \in level n true. Local Lemma continuous_tree_map : continuous tree_map. move=> x; apply/cvg_sup => /= n U /=; rewrite {1}/nbhs /=; case=> ? [][M oM <-]. -case => /= Mtxn /filterS; apply; rewrite /nbhs /=. -rewrite /preimage /=; apply: separator_continuous. +move=> Mtxn /filterS; apply; apply: separator_continuous. - by case: (lvl_clopen n true). - by case: (lvl_clopen n true). - by rewrite /=/nbhs /=; apply/principal_filterP. @@ -558,7 +489,7 @@ have PG : ProperFilter G. - move=> i _; apply: node_n0. exists G; split => //; apply/cvg_sup => i U. rewrite /= {1}/nbhs /=; case=> ? [][M oM <-]. -case => /= Mtxn /filterS; apply; rewrite /nbhs /= nbhs_simpl. +move => /= Mtxn /filterS; apply; rewrite /nbhs /= nbhs_simpl. exists i.+1 => // z fiz /=; suff -> : tree_map z i = f i by done. rewrite /tree_map; move: fiz; rewrite [branch_prefix _ _]/=; case E: (f i). move=> nfz. apply: asboolT; exists (branch_prefix f i) => //. @@ -1072,9 +1003,8 @@ elim: n; first by near=> z => ?; rewrite ltn0. move=> n IH. near=> z => i; rewrite leq_eqVlt => /orP []; first last. move=> iSn; have -> := near IH z => //. - move=> /eqP/(succn_inj) ->. -near: z. - exists ((proj n)@^-1` [set (y n)]); split; last by split. +move=> /eqP/(succn_inj) ->; near: z. + exists ((proj n)@^-1` [set (y n)]); split => //. suff : @open Ttree ((proj n)@^-1` [set (y n)]) by []. apply: open_comp; last apply: discrete_open => //. by move=> + _; apply: proj_continuous. diff --git a/theories/topology.v b/theories/topology.v index 91a9ba4ca..b53f85af2 100644 --- a/theories/topology.v +++ b/theories/topology.v @@ -2985,12 +2985,6 @@ Proof. by split; [exact: compact_near_covering| exact: near_covering_compact]. Qed. -Lemma compact_near_coveringE : compact = near_covering. -Proof. -apply/predeqP => E; have [P Q] := compact_near_coveringP. -by split; [exact: P | exact: Q]. -Qed. - End near_covering. Section Tychonoff. From 007a4180fff22f161b5f31d2873f668c81d56d20 Mon Sep 17 00:00:00 2001 From: zstone Date: Sun, 19 Mar 2023 00:15:08 -0400 Subject: [PATCH 06/23] trying generic tree stuff --- theories/cantor.v | 71 +++++++++++++++++++++++++++++++++++++++++++++ theories/topology.v | 1 + 2 files changed, 72 insertions(+) diff --git a/theories/cantor.v b/theories/cantor.v index d9c35f581..20fe5b091 100644 --- a/theories/cantor.v +++ b/theories/cantor.v @@ -213,6 +213,77 @@ pose B := \bigcup_n (f n) @` [set` (h'' n)]; exists B; split. by apply: (le_ball (ltW deleps)); apply: interior_subset. Qed. +Section topological_trees. + +Context {K : nat -> topologicalType} {X : topologicalType}. +Context (tree_ind : forall n, set X -> K n -> set X). +Context (tree_invariant : (set X -> Prop)). + +Hypothesis compK : forall i, compact [set: (K i)]. +Hypothesis hsdfX : hausdorff_space X. +Hypothesis ind_sub : forall n U e, @tree_ind n U e `<=` U. +Hypothesis ind_invar : forall n U e, + tree_invariant U -> tree_invariant (@tree_ind n U e). +Hypothesis invar_n0 : forall U, tree_invariant U -> U !=set0. +Hypothesis invarT : tree_invariant [set: X]. + +Let T := product_topologicalType K. + +Fixpoint branch_apx (b : T) n := + if n is S m + then tree_ind (branch_apx b m) (b m) + else [set: X]. + +Definition tree_mapF (b : T) := + filter_from [set: nat] (branch_apx b). + +Lemma tree_map_invar b n : tree_invariant (branch_apx b n). +Proof. elim: n => // n ? /=; exact: ind_invar. Qed. + +Lemma tree_map_sub b i j : (i <= j)%N -> branch_apx b j `<=` branch_apx b i. +elim: j i => //=; first by move=> ?; rewrite leqn0 => /eqP ->. +move=> j IH i; rewrite leq_eqVlt => /orP; case; first by move=> /eqP ->. +by move/IH/(subset_trans _); apply; exact: ind_sub. +Qed. + +Lemma tree_map_filter b : ProperFilter (tree_mapF b). +Proof. +split. + by case => n _ brn; case: (invar_n0 (tree_map_invar b n)) => x /brn. +apply: filter_from_filter; first by exists O. +move=> i j _ _; exists (maxn i j) => //; rewrite subsetI. +by split; apply: tree_map_sub; [exact: leq_maxl | exact: leq_maxr]. +Qed. + +Definition tree_map (b : T) := lim (tree_mapF b). + +Lemma tree_map_surj : + (forall b, cvg (tree_mapF b)) -> + (forall n, \bigcap_b (branch_apx b n) = [set: X]) -> + set_surj [set: T] [set: X] tree_map. +Proof. +move=> tcvg tcvr => z _; suff : exists g, forall n, branch_apx g n z. + case=> g gnz; exists g => //; apply: close_eq => // U [oU Uz] V ngV; exists z. + split => //; have /(_ _ ngV) [n _] : tree_mapF g --> tree_map g by exact:tcvg. + by apply; exact: gnz. +apply/not_existsP => Tnz; pose G' n := + [set b | forall N, (N < n)%N -> ~ branch_apx b N z]. +pose G := filter_from [set: nat] G'; have : Filter G. + apply: filter_from_filter; first by exists O. + move=> i j _ _; exists (maxn i j) => // w /= G'w. + split=> N /leq_trans Nij; apply: G'w; apply: Nij. + exact: leq_maxl. + exact: leq_maxr. + +Search ex2 not. + +pose fix g (n : nat) := + if n is S m + then g (exists (e : K n)) + else [set: T]. +pose g := fun n -> + + (* A technique for encoding 'cantor_like' spaces as trees. We build a new function 'node' which encodes the homeomorphism to the cantor space. Other than the 'tree_map is a homeomorphism', no additinal information is diff --git a/theories/topology.v b/theories/topology.v index b53f85af2..4e1bd3dd6 100644 --- a/theories/topology.v +++ b/theories/topology.v @@ -3594,6 +3594,7 @@ Qed. Lemma close_eq x y : close x y -> x = y. Proof. by rewrite closeE. Qed. + Lemma cvg_unique {F} {FF : ProperFilter F} : is_subset1 [set x : T | F --> x]. Proof. move=> Fx Fy; rewrite -closeE //; exact: (@cvg_close F). Qed. From dc3c74edf67cfb53c91fc11f087ebc35fe86cb52 Mon Sep 17 00:00:00 2001 From: zstone Date: Mon, 20 Mar 2023 11:06:11 -0400 Subject: [PATCH 07/23] generalizing tree maps --- theories/cantor.v | 487 +++++++++++++++++++--------------------------- 1 file changed, 202 insertions(+), 285 deletions(-) diff --git a/theories/cantor.v b/theories/cantor.v index 20fe5b091..029ffbd5c 100644 --- a/theories/cantor.v +++ b/theories/cantor.v @@ -213,40 +213,74 @@ pose B := \bigcup_n (f n) @` [set` (h'' n)]; exists B; split. by apply: (le_ball (ltW deleps)); apply: interior_subset. Qed. -Section topological_trees. +Lemma compact_cluster_set1 {T : topologicalType} (x : T) F V : + hausdorff_space T -> compact V -> nbhs x V -> + ProperFilter F -> F V -> cluster F = [set x] -> F --> x. +Proof. +move=> ? cptV nxV PF FV clFx1 U nbhsU; rewrite nbhs_simpl. +wlog oU : U nbhsU / open U. + rewrite /= nbhsE in nbhsU; case: nbhsU => O oO OsubU /(_ O) WH. + by apply: (filterS OsubU); apply: WH; [exact: open_nbhs_nbhs | by case: oO]. +have /compact_near_coveringP : compact (V `\` U). + apply: (subclosed_compact _ cptV) => //. + by apply: closedI; [exact: compact_closed | exact: open_closedC]. +move=> /(_ _ (powerset_filter_from F) (fun W x => ~ W x))[]. + move=> z [Vz ?]; have zE : x <> z by move/nbhs_singleton: nbhsU => /[swap] ->. + have : ~ cluster F z by move: zE; apply: contra_not; rewrite clFx1 => ->. + case/existsNP=> C /existsPNP [D] FC /existsNP [Dz] /set0P/negP/negPn/eqP. + rewrite setIC => /disjoints_subset CD0; exists (D, [set W | F W /\ W `<=` C]). + by split; rewrite //= nbhs_simpl; exact: powerset_filter_fromP. + by case => t W [Dt] [FW] /subsetCP; apply; apply: CD0. +move=> M [MF ME2 [W] MW /(_ _ MW) VUW]. +apply: (@filterS _ _ _ (V `&` W)); last by apply: filterI => //; exact: MF. +by move=> t [Vt Wt]; apply: contrapT => Ut; exact: (VUW t). +Qed. +Section topological_trees. Context {K : nat -> topologicalType} {X : topologicalType}. Context (tree_ind : forall n, set X -> K n -> set X). Context (tree_invariant : (set X -> Prop)). -Hypothesis compK : forall i, compact [set: (K i)]. +Hypothesis cmptX : compact [set: X]. Hypothesis hsdfX : hausdorff_space X. -Hypothesis ind_sub : forall n U e, @tree_ind n U e `<=` U. +Hypothesis discreteK : forall n, discrete_space (K n). +Hypothesis ind_cover : forall n U, U = \bigcup_e @tree_ind n U e . Hypothesis ind_invar : forall n U e, tree_invariant U -> tree_invariant (@tree_ind n U e). Hypothesis invar_n0 : forall U, tree_invariant U -> U !=set0. Hypothesis invarT : tree_invariant [set: X]. +Hypothesis invar_cl : (tree_invariant `<=` closed). +Hypothesis ind_separates: forall (x y : X), + x != y -> + exists n, (forall (U : set X) e, + @tree_ind n U e x -> ~@tree_ind n U e y). + + +Local Lemma ind_sub : forall n U e, @tree_ind n U e `<=` U. +Proof. +move=> n U e; rewrite [x in _ `<=` x] (ind_cover n U); exact: bigcup_sup. +Qed. Let T := product_topologicalType K. -Fixpoint branch_apx (b : T) n := +Local Fixpoint branch_apx (b : T) n := if n is S m then tree_ind (branch_apx b m) (b m) else [set: X]. -Definition tree_mapF (b : T) := +Local Definition tree_mapF (b : T) := filter_from [set: nat] (branch_apx b). -Lemma tree_map_invar b n : tree_invariant (branch_apx b n). +Local Lemma tree_map_invar b n : tree_invariant (branch_apx b n). Proof. elim: n => // n ? /=; exact: ind_invar. Qed. -Lemma tree_map_sub b i j : (i <= j)%N -> branch_apx b j `<=` branch_apx b i. +Local Lemma tree_map_sub b i j : (i <= j)%N -> branch_apx b j `<=` branch_apx b i. elim: j i => //=; first by move=> ?; rewrite leqn0 => /eqP ->. move=> j IH i; rewrite leq_eqVlt => /orP; case; first by move=> /eqP ->. by move/IH/(subset_trans _); apply; exact: ind_sub. Qed. -Lemma tree_map_filter b : ProperFilter (tree_mapF b). +Local Lemma tree_map_filter b : ProperFilter (tree_mapF b). Proof. split. by case => n _ brn; case: (invar_n0 (tree_map_invar b n)) => x /brn. @@ -255,34 +289,119 @@ move=> i j _ _; exists (maxn i j) => //; rewrite subsetI. by split; apply: tree_map_sub; [exact: leq_maxl | exact: leq_maxr]. Qed. -Definition tree_map (b : T) := lim (tree_mapF b). +Let tree_map (b : T) := lim (tree_mapF b). -Lemma tree_map_surj : - (forall b, cvg (tree_mapF b)) -> - (forall n, \bigcap_b (branch_apx b n) = [set: X]) -> - set_surj [set: T] [set: X] tree_map. +Local Lemma cvg_tree_map b : cvg (tree_mapF b). +Proof. +have [|x [_ clx]] := cmptX (tree_map_filter b). + apply: filterT; exact: tree_map_filter. +apply/cvg_ex; exists x => /=; apply: (compact_cluster_set1 _ cmptX) => //. + exact: filterT. + exact: tree_map_filter. + by apply: filterT; exact: tree_map_filter. +rewrite eqEsubset; split; last by move=> ? ->. +move=> y cly; case: (eqVneq x y); first by move=> ->. +case/ind_separates => n sep. +have bry : branch_apx b n.+1 y. + rewrite [branch_apx _ _](iffLR (closure_id _)). + by move: cly; rewrite clusterE; apply; exists n.+1. + apply: invar_cl; apply: tree_map_invar. +suff /sep : branch_apx b n.+1 x by done. +rewrite [branch_apx _ _](iffLR (closure_id _)). + by move: clx; rewrite clusterE; apply; exists n.+1. +apply: invar_cl; apply: tree_map_invar. +Qed. + +Local Lemma tree_map_surj : set_surj [set: T] [set: X] tree_map. Proof. -move=> tcvg tcvr => z _; suff : exists g, forall n, branch_apx g n z. +move=> z _; suff : exists g, forall n, branch_apx g n z. case=> g gnz; exists g => //; apply: close_eq => // U [oU Uz] V ngV; exists z. - split => //; have /(_ _ ngV) [n _] : tree_mapF g --> tree_map g by exact:tcvg. + split => //; have /(_ _ ngV) [n _] : tree_mapF g --> tree_map g by exact:cvg_tree_map. by apply; exact: gnz. -apply/not_existsP => Tnz; pose G' n := - [set b | forall N, (N < n)%N -> ~ branch_apx b N z]. -pose G := filter_from [set: nat] G'; have : Filter G. - apply: filter_from_filter; first by exists O. - move=> i j _ _; exists (maxn i j) => // w /= G'w. - split=> N /leq_trans Nij; apply: G'w; apply: Nij. - exact: leq_maxl. - exact: leq_maxr. - -Search ex2 not. - -pose fix g (n : nat) := - if n is S m - then g (exists (e : K n)) - else [set: T]. -pose g := fun n -> +have zcov' : forall n (U : set X), exists e, U z -> @tree_ind n U e z. + move=> n U; case: (pselect (U z)); last by move => ?; exists point. + by rewrite {1}(@ind_cover n U); case => e _ ?; exists e. +pose zcov n U := projT1 (cid (zcov' n U)). +pose fix g n : (K n * set X) := + if n is S m + then (zcov m.+1 (g m).2, @tree_ind m.+1 (g m).2 (zcov m.+1 (g m).2)) + else (zcov O [set: X], @tree_ind O [set: X] (zcov O [set: X])). +pose g' n := (g n).1; have apxg : forall n, branch_apx g' n.+1 = (g n).2. + by elim => //= n ->; congr (_ _). +exists g'; elim => // n /= IH. +have /(_ IH) := projT2 (cid (zcov' n (branch_apx g' n)));move => {IH}. +by case: n => // n; rewrite apxg /=. +Qed. + +Local Lemma tree_prefix (b: T) (n : nat) : + \forall c \near b, forall i, (i < n)%N -> b i = c i. +Proof. +elim: n; first by near=> z => ?; rewrite ltn0. +move=> n IH. +near=> z => i; rewrite leq_eqVlt => /orP []; first last. + move=> iSn; have -> := near IH z => //. +move=> /eqP/(succn_inj) ->; near: z. + exists ((proj n)@^-1` [set (b n)]); split => //. + suff : @open T ((proj n)@^-1` [set (b n)]) by []. + apply: open_comp; last apply: discrete_open => //. + by move=> + _; apply: proj_continuous. +Unshelve. all: end_near. Qed. + +Local Lemma apx_prefix (b c : T) (n : nat) : + (forall i, (i < n)%N -> b i = c i) -> + branch_apx b n = branch_apx c n. +Proof. +elim: n => //= n IH inS; rewrite IH; first by congr (tree_ind _); exact: inS. +by move=> ? ?; apply: inS; apply: ltnW. +Qed. + +Local Lemma tree_map_apx b n: branch_apx b n (tree_map b). +Proof. +apply: (@closed_cvg _ _ _ (tree_map_filter b) idfun); last exact: cvg_tree_map. + by apply: invar_cl; exact: tree_map_invar. +exists n => //. +Qed. + +Local Lemma tree_map_cts : continuous tree_map. +Proof. +move=> b U /cvg_tree_map /= [n _] /filterS; apply. + by apply: fmap_filter; exact: (@nbhs_filter T). +rewrite nbhs_simpl /=; near_simpl => /=. +have := tree_prefix b n; apply: filter_app; near_simpl => /=. +by near=> z => /apx_prefix ->; apply: tree_map_apx. +Unshelve. all: end_near. Qed. + +Local Lemma tree_map_inj : + (forall n U, trivIset [set: K n] (@tree_ind n U)) -> + set_inj [set: T] tree_map. +Proof. +move=> triv x y _ _ xyE; apply: functional_extensionality_dep => n. +suff : forall n, branch_apx x n = branch_apx y n. + move=> brE; have := @triv n (branch_apx x n) (x n) (y n) I I; apply. + exists (tree_map y); split. + by rewrite -?xyE -/(branch_apx x n.+1); apply: tree_map_apx. + rewrite brE -/(branch_apx y n.+1); apply: tree_map_apx. +elim => // m /= brE. +have -> := @triv m (branch_apx x m) (x m) (y m) I I; first by rewrite brE. +exists (tree_map y); split. + by rewrite -?xyE -/(branch_apx x m.+1); apply: tree_map_apx. +rewrite brE -/(branch_apx y m.+1); apply: tree_map_apx. +Qed. + +Lemma tree_map_props : exists (f : T -> X), + [/\ continuous f, + set_surj [set: T] [set: X] f & + (forall n U, trivIset [set: K n] (@tree_ind n U)) -> + set_inj [set: T] f + ]. +Proof. +exists tree_map; split. +- exact: tree_map_cts. +- exact: tree_map_surj. +- exact: tree_map_inj. +Qed. +End topological_trees. (* A technique for encoding 'cantor_like' spaces as trees. We build a new function 'node' which encodes the homeomorphism to the cantor space. @@ -301,6 +420,8 @@ Proof. by case: cantorT. Qed. Local Lemma hsdfT : @hausdorff_space T. Proof. by case: cantorT. Qed. +Definition c_invar (U : set T) := clopen U /\ U !=set0. + Local Lemma clopen_surj : $|{surjfun [set: nat] >-> @clopen T}|. Proof. suff : (@clopen T = set0 \/ $|{surjfun [set: nat] >-> @clopen T}|). @@ -310,268 +431,64 @@ Qed. Let U_ := unsquash clopen_surj. -Local Lemma split_clopen (U : set T) : open U -> U !=set0 -> - exists V, clopen V /\ V `&` U !=set0 /\ ~`V `&` U !=set0. +Local Lemma split_clopen' (U : set T) : + exists V, open U -> U !=set0 -> clopen V /\ V `&` U !=set0 /\ ~`V `&` U !=set0. Proof. -move=> oU Un0; have [x [y] [Ux] Uy xny] := (iffLR perfect_set2) pftT U oU Un0. +case: (pselect (open U)) => oU; last by exists point. +case: (pselect (U !=set0)) => Un0; last by exists point. +have [x [y] [Ux] Uy xny] := (iffLR perfect_set2) pftT U oU Un0. have [V [?] [?] [? ?]] := dsctT xny; exists V. by repeat split => //; [exists x | exists y]. Qed. -Let split_open' (U : set T) : set T := - if pselect (open U /\ U !=set0) is left (conj oU n0) - then projT1 (cid (split_clopen oU n0)) - else set0. - -Local Lemma split_openI (U : set T) : - open U -> U !=set0 -> split_open' U `&` U !=set0. -Proof. -move=> oU Un0; rewrite /split_open'; case: pselect; last exact: absurd. -by move=> W; case: W => w1 w2; have [? []] := projT2 (cid (split_clopen w1 w2)). -Qed. - -Local Lemma split_openIC (U : set T) : - open U -> U !=set0 -> ~` (split_open' U) `&` U !=set0. -Proof. -move=> oU Un0; rewrite /split_open'; case: pselect; last exact: absurd. -by move=> W; case: W => w1 w2; have [? []] := projT2 (cid (split_clopen w1 w2)). -Qed. - -Local Lemma split_open_clopen (U : set T) : clopen (split_open' U). -Proof. -rewrite/split_open'; case: pselect; last by move=> ?; exact: clopen0. -by case=> w1 w2; have [? []] := projT2 (cid (split_clopen w1 w2)). -Qed. - -Local Fixpoint node (pfx: seq bool): set T := - match pfx with - | nil => setT - | head :: tail => - let Un := U_ (length tail) in - let Vn := node tail in - let Wn := if pselect (Un `&` Vn !=set0 /\ ~` Un `&` Vn !=set0) - then Un else split_open' Vn in - (if head then Wn else ~` Wn) `&` Vn - end. - -Local Lemma node_clopen_n0 pfx : clopen (node pfx) /\ node pfx !=set0. -Proof. -elim: pfx => /=; first (split; last by exists point). - split; [exact: openT | exact: closedT]. -move=> head tail [tail_clopen tailn0]; split; first last. - case: pselect=> UnI /=; first by case: head; case: UnI. - case head; first by apply: split_openI => //; case: tail_clopen. - by apply: split_openIC => //; case: tail_clopen. -apply: clopenI => //. -set Wn := (x in if _ then x else ~` x); suff: clopen Wn. - by move=> ?; case: head => //; exact: clopenC. -rewrite /Wn; case: pselect => P /=; last apply: split_open_clopen. -exact: funS. -Qed. - -Local Lemma node_clopen pfx : clopen (node pfx). -Proof. by have [] := node_clopen_n0 pfx. Qed. - -Local Lemma node_n0 pfx : node pfx !=set0. -Proof. by have [] := node_clopen_n0 pfx. Qed. - -Local Lemma node_subsetS b pfx : node (b :: pfx) `<=` node pfx. -Proof. by move: b; elim: pfx => //= ? ?. Qed. - -Local Lemma nodeUS pfx : node (true :: pfx) `|` node (false :: pfx) = node pfx. -rewrite eqEsubset; split; last by rewrite /= -setIUl setUv setTI. -by rewrite -[node pfx]setUid; apply: setUSS; exact: node_subsetS. -Qed. - -Local Lemma nodeIS pfx : node (true :: pfx) `&` node (false :: pfx) = set0. -Proof. -rewrite /=; set W := if _ then _ else _. -by rewrite /= -setIA [~` _ `&` _]setIC setIC -?setIA setICl ?setI0. -Qed. - -Local Lemma node_trivIset (n : nat) : trivIset [set pfx | length pfx = n] node. -Proof. -elim: n. - by move=> i j /List.length_zero_iff_nil -> /List.length_zero_iff_nil ->. -move=> n IH pfx1 pfx2 /=. -case: pfx1 => // b1 pfx1 /eq_add_S pfx1N. -case: pfx2 => // b2 pfx2 /eq_add_S pfx2N. -case=> x [] [] P1 npfx1 [] P2 npfx2; have pfxE : pfx1 = pfx2. - by apply: IH => //; exists x. -rewrite pfxE in P1, P2 *; congr (_ :: _). -have /set0P/eqP : node (b1 :: pfx2) `&` node (b2 :: pfx2) !=set0 by exists x. -by case: {P1 P2} b1; case: b2; rewrite ?nodeIS // setIC nodeIS. -Qed. - -Local Lemma nodeT (n : nat) : bigcup [set pfx | length pfx = n] node = setT. -Proof. -elim: n. - rewrite (_ : [set pfx | length pfx = 0%N] = [set [::]]) ?bigcup_set1 //. - rewrite eqEsubset; split => // ?; last by move=> ->. - by move/List.length_zero_iff_nil=> ->. -move=> N; rewrite ?eqEsubset; case=> _ IH; split => // x Tx. -have [pfx /= pfxN] := IH _ Tx; rewrite -nodeUS=> pfxX. -have [b bpfxX] : exists b, node (b :: pfx) x. - by case: pfxX=> ?; [exists true | exists false]. -by exists (b :: pfx) => //=; f_equal. -Qed. - -Local Lemma nodeUn n pfx : length pfx = S n -> - (node pfx `<=` U_ n) \/ (node pfx `&` U_ n == set0). -Proof. -case: pfx => // b pfx /= /eq_add_S pfxN; rewrite pfxN. -case: pselect => /=; case: b => //=; [left | right | |] => //=. -- by rewrite setIC setIA setICr set0I. -- case/not_andP => /set0P/negP; rewrite negbK setIC -setIA => /eqP. - by move=> ->; rewrite setI0; right. - by move/subsets_disjoint => ?; left; apply: subIset; right. -- case/not_andP => /set0P/negP; rewrite negbK setIC -setIA => /eqP. - by move=> ->; rewrite setI0; right. - by move/subsets_disjoint => ?; left; apply: subIset; right. -Qed. - -Let level (n : nat) (b : bool) : set T := - bigcup [set pfx | length pfx = n] (fun pfx => node (b :: pfx)). - -Local Lemma finite_set_seq (n : nat) : - finite_set [set pfx : seq bool | length pfx = n]. -Proof. -elim: n. - rewrite (_ : [set pfx | length pfx = 0%N] = [set [::]]) //. - rewrite eqEsubset; split => // ?; last by move=> ->. - by move/List.length_zero_iff_nil=> ->. -pose L := fun (n:nat) => [set pfx : seq bool | length pfx = n]; move=> n IH. -suff : (L n.+1 = (cons true @` L n) `|` (cons false @` L n)). - by rewrite /L => - => ->; rewrite finite_setU; split; apply: finite_image. -rewrite eqEsubset; split; rewrite /L. - by case=> // b pfx /= /eq_add_S pfxn; case: b; [left | right]; exists pfx. -by move=> pfx /= [][] ? <- <-. -Qed. - -Local Lemma lvl_clopen (n : nat) (b : bool) : clopen (level n b). -Proof. -move: b; elim: n. - move=> b; rewrite /level. - rewrite (_ : [set pfx | length pfx = 0%N] = [set [::]]) ?bigcup_set1 //. - exact: node_clopen. - rewrite eqEsubset; split => // ?; last by move=> ->. - by move/List.length_zero_iff_nil=> ->. -move=> n IH b; split. - by apply: bigcup_open => pfx _; case: (node_clopen (b :: pfx)). -rewrite /level -bigsetU_fset_set. - by apply: closed_bigsetU => pfx _; case: (node_clopen (b :: pfx)). -exact: finite_set_seq. -Qed. - -Let tree_map (x : T) : cantor_space := fun n => x \in level n true. - -Local Lemma continuous_tree_map : continuous tree_map. -move=> x; apply/cvg_sup => /= n U /=; rewrite {1}/nbhs /=; case=> ? [][M oM <-]. -move=> Mtxn /filterS; apply; apply: separator_continuous. -- by case: (lvl_clopen n true). -- by case: (lvl_clopen n true). -- by rewrite /=/nbhs /=; apply/principal_filterP. -Qed. - -Local Lemma closed_tree_map : forall (C : set T), closed C -> closed (tree_map @` C). -move=> C clC; apply: compact_closed; first exact: cantor_space_hausdorff. -apply: continuous_compact; last exact: (subclosed_compact _ cmptT). -exact/continuous_subspaceT/continuous_tree_map. -Qed. - -Local Lemma tree_map_node b (z : T) L : node (b :: L) z -> tree_map z (length L) = b. -Proof. -rewrite /tree_map; case: b => // nbz; first by apply: asboolT; exists L. -apply: asboolF; case=> M LMN nMz. - have L13x : node L `&` node M !=set0. - exists z; split; apply: node_subsetS; [exact: nbz | exact: nMz]. - have L13E := @node_trivIset (length L) _ M erefl LMN L13x. - by (suff : set0 z by apply); rewrite -(nodeIS L); split => //; rewrite L13E. -Qed. - -Local Lemma tree_map_prefix x y pfxX pfxY : - tree_map x = tree_map y -> length pfxX = length pfxY -> - node pfxX x -> node pfxY y -> pfxX = pfxY. -Proof. -move=> tmXY; move: pfxY; elim: pfxX. - by move=> pfxy ln0 _ _; apply/sym_equal/List.length_zero_iff_nil/sym_equal. -move=> b1 L1 IH pfxY; case: pfxY => // b2 L2 /eq_add_S /[dup] LN /IH L12 nx ny. -f_equal; last by case: nx; case: ny => ? ? ? ?; apply: L12. -by rewrite -(tree_map_node nx) -(tree_map_node ny) tmXY /length LN. -Qed. - -Local Lemma inj_tree_map : set_inj [set: T] tree_map. -Proof. -move=> x y _ _; apply: contra_eq => xNy. -have [V [Vx] [nVy clV]] := dsctT xNy. -have [N UNVE] : exists N, U_ N = V. - by have [N ? <-] := (@surj _ _ _ _ U_ V clV); exists N. -rewrite -{}UNVE in clV, nVy, Vx. -have [pfX [pfXx pfXN]] : exists pfX, node pfX x /\ length pfX = N.+1. - by have := nodeT N.+1; rewrite -subTset => /(_ x I) [] pfx /= ? ?; exists pfx. -have [pfY [pfYy pfYN]] : exists pfX, node pfX y /\ length pfX = N.+1. - by have := nodeT N.+1; rewrite -subTset => /(_ y I) [] pfx /= ? ?; exists pfx. -have : pfY != pfX. - apply/eqP => pfXYE; have [] := nodeUn pfYN; first by move=> /(_ y pfYy). - by rewrite pfXYE => /eqP/disjoints_subset/(_ _ pfXx). -apply: contraNN => /eqP ?; apply/eqP; apply: (@tree_map_prefix y x) => //. -by rewrite pfXN pfYN. -Qed. - -Local Fixpoint branch_prefix (f : nat -> bool) (n : nat) : seq bool := - match n with - | 0%N => [::] - | S n => f n :: branch_prefix f n - end. - -Local Lemma branch_prefix_length f n : length (branch_prefix f n) = n. -Proof. by elim: n => // n /= ->. Qed. - -Local Lemma branch_prefix_lt_subset f (i j : nat) : - (i < j)%N -> node (branch_prefix f j) `<=` node (branch_prefix f i). -Proof. -move: i; elim: j => // j IH i /ltnSE ij1; rewrite [branch_prefix _ _]/=. -apply: subset_trans; first apply: node_subsetS. -move: ij1; rewrite leq_eqVlt => /orP; case; first by move/eqP ->. -exact: IH. -Qed. +Let split_clopen (U : set T) := projT1 (cid (split_clopen' U)). -Local Lemma branch_prefix_le_subset f (i j : nat) : - (i <= j)%N -> node (branch_prefix f j) `<=` node (branch_prefix f i). -Proof. -rewrite leq_eqVlt => /orP []; first by move/eqP ->. -exact: branch_prefix_lt_subset. -Qed. +Definition c_ind (n : nat) (V : set T) (b : bool) := + let Wn := + if pselect ((U_ n) `&` V !=set0 /\ ~` (U_ n) `&` V !=set0) + then (U_ n) + else split_clopen V in + (if b then Wn else ~` Wn) `&` V. -Local Lemma surj_tree_map : set_surj [set: T] [set: cantor_space] tree_map. +Lemma cantor_map : exists (f : cantor_space -> T), + [/\ continuous f, + set_surj [set: cantor_space] [set: T] f & + set_inj [set: cantor_space] f + ]. Proof. -move=> f /= _. -suff [F [PF Ff]] : exists F : set (set T), ProperFilter F /\ tree_map @ F --> f. - have [x [_ clfFx]] := cmptT PF filterT; exists x => //. - apply: cantor_space_hausdorff => U V. - move=> /continuous_tree_map/clfFx clF /Ff; rewrite ?nbhs_simpl /= => FtV. - by move: (clF _ FtV); rewrite -preimage_setI; case=> z [? ?]; exists (tree_map z). -pose G := (filter_from [set: nat] (fun n => (node (branch_prefix f n)))). -have PG : ProperFilter G. - apply: filter_from_proper; first apply: filter_from_filter. - - by exists point. - - move=> i j _ _; exists (maxn i j) => //; rewrite subsetI. - by split; apply: branch_prefix_le_subset; rewrite ?leq_maxr ?leq_maxl. - - move=> i _; apply: node_n0. -exists G; split => //; apply/cvg_sup => i U. -rewrite /= {1}/nbhs /=; case=> ? [][M oM <-]. -move => /= Mtxn /filterS; apply; rewrite /nbhs /= nbhs_simpl. -exists i.+1 => // z fiz /=; suff -> : tree_map z i = f i by done. -rewrite /tree_map; move: fiz; rewrite [branch_prefix _ _]/=; case E: (f i). - move=> nfz. apply: asboolT; exists (branch_prefix f i) => //. - exact: branch_prefix_length. -move=> nfz; apply: asboolF; case=> L Li ntz. -have := (@node_trivIset i.+1 (false :: branch_prefix f i) (true :: L)). -have -> : (false :: _ = true :: _) = False by move=> ? ?; apply/propext; split. -apply. -- by rewrite /= branch_prefix_length. -- by rewrite /= Li. -- by exists z. +have [] := (@tree_map_props + (fun=> [topologicalType of bool]) + T (c_ind) (c_invar) cmptT hsdfT _ _ _ _ _). +- done. +- move=> n V; rewrite eqEsubset; split => t; last by case => ? ? []. + move=> Vt; case: (pselect ((U_ n) `&` V !=set0 /\ ~` (U_ n) `&` V !=set0)). + move=> ?; case: (pselect (U_ n t)). + by exists true => //; rewrite /c_ind; case pselect. + by exists false => //; rewrite /c_ind; case pselect. + move=> ?; case: (pselect (split_clopen V t)). + by exists true => //; rewrite /c_ind; case pselect. + by exists false => //; rewrite /c_ind; case pselect. +- move=> n U e [] clU Un0; rewrite /c_ind; case: pselect. + case => /= ? ?; case: e => //; split => //; apply: clopenI => //. + exact: funS. + by apply: clopenC => //; exact: funS. + have [| | ? [? ?]] := projT2 (cid (split_clopen' U)) => //; first by case: clU. + move=> ?; case: e => //=; (split; first apply: clopenI) => //. + exact: clopenC. +- by move=> ? []. +- by split;[ exact: clopenT |exists point]. +- by move=> ? [[]]. +- move=> x y /dsctT [A [Ax [Any clA]]]. + have [] := (@surj _ _ _ _ U_ _ clA) => n _ UnA; exists n => V e. + case: (pselect (V y)); last by move=> + _; apply: subsetC => ? []. + case: (pselect (V x)); last by move=> + _ []. + move=> Vx Vy; rewrite {1 2}/c_ind; case: pselect => /=; rewrite ?UnA. + by move=> _; case: e; case => // ? ?; apply/not_andP; left. + by apply: absurd; split; [exists x | exists y]. +- move=> f [ctsf surjf injf]; exists f; split => //; apply: injf. + move=> n U i j _ _ [z] [] [] + Uz [+ _]; case: pselect => /=. + by case => ? ?; case: i; case: j => //. + by move=> ?; case: i; case: j => //. Qed. Local Lemma tree_map_bij : bijective tree_map. From 1b8bf83968e3bd88d38212bf5bec022ca805a593 Mon Sep 17 00:00:00 2001 From: zstone Date: Tue, 21 Mar 2023 00:28:24 -0400 Subject: [PATCH 08/23] much better factoring --- theories/cantor.v | 656 ++++++++++++---------------------------------- 1 file changed, 166 insertions(+), 490 deletions(-) diff --git a/theories/cantor.v b/theories/cantor.v index 029ffbd5c..d61747d12 100644 --- a/theories/cantor.v +++ b/theories/cantor.v @@ -213,29 +213,6 @@ pose B := \bigcup_n (f n) @` [set` (h'' n)]; exists B; split. by apply: (le_ball (ltW deleps)); apply: interior_subset. Qed. -Lemma compact_cluster_set1 {T : topologicalType} (x : T) F V : - hausdorff_space T -> compact V -> nbhs x V -> - ProperFilter F -> F V -> cluster F = [set x] -> F --> x. -Proof. -move=> ? cptV nxV PF FV clFx1 U nbhsU; rewrite nbhs_simpl. -wlog oU : U nbhsU / open U. - rewrite /= nbhsE in nbhsU; case: nbhsU => O oO OsubU /(_ O) WH. - by apply: (filterS OsubU); apply: WH; [exact: open_nbhs_nbhs | by case: oO]. -have /compact_near_coveringP : compact (V `\` U). - apply: (subclosed_compact _ cptV) => //. - by apply: closedI; [exact: compact_closed | exact: open_closedC]. -move=> /(_ _ (powerset_filter_from F) (fun W x => ~ W x))[]. - move=> z [Vz ?]; have zE : x <> z by move/nbhs_singleton: nbhsU => /[swap] ->. - have : ~ cluster F z by move: zE; apply: contra_not; rewrite clFx1 => ->. - case/existsNP=> C /existsPNP [D] FC /existsNP [Dz] /set0P/negP/negPn/eqP. - rewrite setIC => /disjoints_subset CD0; exists (D, [set W | F W /\ W `<=` C]). - by split; rewrite //= nbhs_simpl; exact: powerset_filter_fromP. - by case => t W [Dt] [FW] /subsetCP; apply; apply: CD0. -move=> M [MF ME2 [W] MW /(_ _ MW) VUW]. -apply: (@filterS _ _ _ (V `&` W)); last by apply: filterI => //; exact: MF. -by move=> t [Vt Wt]; apply: contrapT => Ut; exact: (VUW t). -Qed. - Section topological_trees. Context {K : nat -> topologicalType} {X : topologicalType}. Context (tree_ind : forall n, set X -> K n -> set X). @@ -491,40 +468,27 @@ have [] := (@tree_map_props by move=> ?; case: i; case: j => //. Qed. +Definition tree_map := projT1 (cid (cantor_map)). + Local Lemma tree_map_bij : bijective tree_map. Proof. -rewrite -setTT_bijective. -by split=> //; [exact: inj_tree_map | exact: surj_tree_map ]. +by rewrite -setTT_bijective; have [? ? ?] := projT2 (cid cantor_map); split. Qed. #[local] HB.instance Definition _ := @BijTT.Build _ _ _ tree_map_bij. -Lemma cantor_like_homeomorphism : - exists (f : {splitbij [set: T] >-> [set: cantor_space]}), - continuous f /\ - (forall A, closed A -> closed (f@`A)). -Proof. -exists tree_map. -by split; [exact: continuous_tree_map | exact: closed_tree_map ]. -Qed. - Lemma homeomorphism_cantor_like : exists (f : {splitbij [set: cantor_space] >-> [set: T]}), continuous f /\ (forall A, closed A -> closed (f@`A)). Proof. -case: cantor_like_homeomorphism => f [ctsf clsdf]. -exists [splitbij of (f^-1)%FUN]; split. - apply/continuous_closedP => A /clsdf /=; congr(_ _). - rewrite eqEsubset; split => // z /=. - by case => t Ax <-; rewrite invK // in_setE. - move=> ?; exists (f^-1 z)%FUN => //. - by apply: funK; rewrite in_setE. -move=> A clA /=; move/continuous_closedP/(_ _ clA): ctsf; congr(_ _). -rewrite eqEsubset; split => z. - by move=> Az; exists (f z) => //; rewrite funK // in_setE. -by case=> x Ax <-; rewrite /= invK // in_setE. +exists tree_map => /=; have [? ? ?] := projT2 (cid cantor_map); split => //. +move=> A clA; apply: compact_closed; first exact: hsdfT. +apply (@continuous_compact _ _ tree_map); first exact: continuous_subspaceT. +apply: (@subclosed_compact _ _ [set: cantor_space]) => //. +exact: cantor_space_compact. Qed. + End TreeStructure. @@ -568,477 +532,189 @@ Qed. End FinitelyBranchingTrees. +Local Notation "A ^-1" := ([set xy | A (xy.2, xy.1)]) : classical_set_scope. +Lemma ent_closure {X : uniformType} (x z : X) E : entourage E -> + closure [set y | split_ent E (x, y)] z -> E (x, z). +Proof. +pose E' := ((split_ent E) `&` ((split_ent E)^-1)%classic). +move=> entE /(_ [set y | E' (z, y)]) []. + by rewrite -nbhs_entourageE; exists E' => //; apply: filterI. +by move=> y [/=] + [_]; apply: entourage_split. +Qed. + Section CompactEmbedding. Context {R: realType} {T : pseudoMetricType R}. Hypothesis cptT : compact [set: T]. Hypothesis hsdfT : hausdorff_space T. -Local Definition oball eps x : set T := interior (ball x eps). - -Local Lemma refine_aux (eps : R) (B : set T) : 0 < eps -> - exists (U : set (set T)), - [/\ - finite_set U, - (forall C, U C -> C `<=` B), - B `<=` bigcup U id, - (forall C, U C -> B `&` C !=set0) & - (forall C, U C -> exists t, C `<=` ball t eps) - ]. -Proof. -move:eps=>_/posnumP[eps]; have : compact (closure B). - by apply: (subclosed_compact _ cptT) => //; exact: closed_closure. -rewrite compact_cover => /(_ T (closure B) (oball eps%:num)) []. -- by move=> i _; exact: open_interior. -- move=> t clBt; exists t => //; exact: nbhsx_ballx. -move=> C CsubB cvrBcl; exists ( - (fun i => B `&` (oball eps%:num i)) @` [set` C]); split. -- exact/finite_image/finite_fset. -- by move=> ? [?] ? <-. -- move=> z Bz; have /cvrBcl [d /= Cd odz] : closure B z by exact: subset_closure. - by exists (B `&` (oball eps%:num d)) => //; exists d. -- move=> ? /= [d] Cd <-; have : closure B d by move/CsubB/set_mem:Cd. - case/(_ (oball eps%:num d)). - apply: open_nbhs_nbhs; split; [exact: open_interior | apply: nbhsx_ballx]. - by move=> e ?; exists e; rewrite setIA setIid. -- move=> ? /= [e /CsubB/set_mem] ? <-; exists e. - by apply: subset_trans; last exact: interior_subset. -Qed. - -Local Lemma harmonic_pos (n : nat) : 0 < (n.+1%:R^-1:R). -Proof. by []. Qed. - -Local Lemma harmonicS (n : nat) : (n.+2%:R^-1) < (n.+1%:R^-1) :> R. -Proof. -rewrite ltr_pinv ?inE ?unitfE ?ltr_nat //; by apply/andP. -Qed. - -Local Lemma ltn_leq_trans (n m p : nat) : - (m < n)%N -> (n <= p)%N -> (m < p)%N. -Proof. exact: (@leq_ltn_trans n (S m) (S p)). Qed. - -Local Definition tier : Type := ((set (set T)) * (nat -> set T) * nat). - -Local Lemma refine_indexed (eps : R) (B : set T) : 0 < eps -> - exists (Ufn : tier), - forall n, (n >= Ufn.2)%N -> - [/\ - B!=set0 -> Ufn.1.2 @` `I_n = Ufn.1.1 , - (forall C, Ufn.1.1 C -> C `<=` B), - B `<=` bigcup `I_n Ufn.1.2, - (forall i, B!=set0 -> B `&` Ufn.1.2 i !=set0) & - (forall i, exists t, Ufn.1.2 i `<=` ball t eps) - ]. -Proof. -case: (pselect (B != set0)); first last. - move=>/negP; rewrite negbK=> /eqP -> epspos. - exists (set0, (fun=> interior (ball point eps)), O) => n /= ?; split. - - by move/set0P/eqP. - - by move=> ?. - - by move=> ? ?. - - by move=> ? /set0P /negP. - - move=> ?; exists point; exact: interior_subset. -case/set0P => b0 Bb0 /(@refine_aux _ B) [U]. -move=> [/finite_setP [N idx] subB cvrB BIU Ueps]. -have [U0 UU0 U0b0] := cvrB _ Bb0; case/card_esym/ppcard_eqP: idx => f. -pose g := patch (fun=> U0) `I_N f; exists (U, g, N) => // n /= Nsubn; -have Ugi : forall (i : nat), U (g i). - by move=> i; rewrite /=/g patch_pred; case E: (_<_)%N => //; exact: funS. -split. -- move=> _; rewrite eqEsubset; split; first by move=> i [] ? ? <-; exact: Ugi. - move=> C /(@surj _ _ _ _ f) [m /= mN <-]. - exists m; first exact: (ltn_leq_trans mN). - by rewrite /g patchT // in_setE /=. -- by move=> C UC; exact: subB. -- move=> ? /cvrB [C] /(@surj _ _ _ _ f) [m] ? <- ?. - by exists m; [exact: (@ltn_leq_trans N) | by rewrite /=/g patchT // in_setE]. -- by move=> i ?; exact: BIU. -- by move=> i; exact: Ueps. -Qed. - -Local Definition refine (n : nat) (B : set T) : tier := - (projT1 (cid (@refine_indexed _ B (harmonic_pos n) ))). - -Local Lemma refine_spec (N : nat) (B : set T) : - let Ufn := refine N B in - [/\ - forall n, (n >= Ufn.2)%N -> B!=set0 -> Ufn.1.2 @` `I_n = Ufn.1.1, - forall C, Ufn.1.1 C -> C `<=` B, - forall n, (n >= Ufn.2)%N -> B `<=` bigcup `I_n Ufn.1.2, - forall i, B!=set0 -> B `&` Ufn.1.2 i !=set0 & - forall i, exists t, Ufn.1.2 i `<=` ball t (N.+1%:R^-1) - ]. -Proof. +Section two_pointed. +Context (t0 t1 : T). +Hypothesis T2e : (t0 != t1). + +Let ent_balls' (E : set (T*T)) : + exists (M : set (set T)), + entourage E -> [/\ + finite_set M, + (forall A, M A -> exists a, A a /\ + A `<=` closure [set y | split_ent E (a,y)]), + (exists (A B : set T), M A /\ M B /\ A != B), + \bigcup_(A in M) A = [set: T] & + M `<=` closed]. +Proof. +case: (pselect (entourage E)); last by move=> ?; exists point. +move=> entE; move: cptT; rewrite compact_cover. +pose fs x := interior [set y | split_ent E (x, y)]. +case/(_ T ([set: T]) fs). +- by move=> i _; apply: open_interior. +- move=> t _; exists t => //. +- by rewrite /fs /interior -nbhs_entourageE; exists (split_ent E). +move=> M' _ Mcov; exists ( + ((fun x => closure (fs x)) @` [set` M']) `|` [set [set t0];[set t1]]) => _. split. -- by move=> n /(projT2 (cid (refine_indexed B (harmonic_pos N))) _) []. -- by have [] := projT2 (cid (refine_indexed B (harmonic_pos N))) _ (leqnn _). -- by move=> n /(projT2 (cid (refine_indexed B (harmonic_pos N))) _) []. -- by have [] := projT2 (cid (refine_indexed B (harmonic_pos N))) _ (leqnn _). -- by have [] := projT2 (cid (refine_indexed B (harmonic_pos N))) _ (leqnn _). -Qed. - -Local Fixpoint tiers (n : nat) : set tier := - if n is S m - then refine n @` (\bigcup_(Ufn in tiers m) Ufn.1.1) - else [set ([set setT], (fun=> setT), (2)%N)]. - -Local Definition lvl_aux (n : nat) : nat := - (supremum (0)%N ((fun Ufn => Ufn.2) @` tiers n)). - -Local Lemma lt02 (n : nat) : (0 \in `I_(n.+2))%N. -Proof. by rewrite in_setE. Qed. - -Local Definition lvl (n : nat) := - PointedType (`I_(lvl_aux n).+2) (exist _ O (lt02 n)). - -Local Definition Ttree := @tree_of R lvl. - -Local Fixpoint target (branch : Ttree) (n : nat) : (set T) := - if n is S m - then (refine n (target branch m) ).1.2 (projT1 (branch n)) - else setT. - -Local Lemma targetN0 (b : Ttree) (n : nat) : target b n !=set0. -Proof. -elim: n => //=; first by exists point. -move=> n [x tbnx]. -have [_ _ _ /(_ (proj1_sig (b (S n)))) + _] := @refine_spec n.+1 (target b n). -by (case; first by exists x); move=> t [? ?]; exists t. -Qed. - -Local Lemma tierN0 n Ufn : tiers n Ufn -> - Ufn.1.1 !=set0 /\ (forall V, Ufn.1.1 V -> V!=set0). -elim: n Ufn => //. - move=> ?; rewrite /tiers=> ->; split; first by exists [set: T]. - by move=> ? /= ->; exists point. -move=> n IH Ufn /= [V [t /IH [IH1 IH2]] tV <-]. -have VN0 : V!=set0 by exact: IH2. -have [/(_ (refine n.+1 V).2.+1) img _ _ UN0 _] := refine_spec (n.+1) V; split. - rewrite -img //. - by exists ((refine n.+1 V).1.2 (refine n.+1 V).2), (refine n.+1 V).2 => //=. -move=> U /=; rewrite -img //=. -by case=> M + <-; have [z [_ ?] _] := UN0 M VN0; exists z. -Qed. - -Local Lemma tiersN0 n : tiers n !=set0. -elim: n => //=; first by exists ([set [set: T]], fun=> [set: T], 2%N). -move=> n [Ufn] Ufn_tier; have [[U UfnU] _] := tierN0 Ufn_tier. -by exists (refine n.+1 U); exists U => //; exists Ufn. -Qed. - -Local Lemma refine_finite (n : nat) (B : set T) : - B!=set0 -> finite_set (refine n B).1.1. -Proof. -move=> Bn0; have [/(_ _ (leqnn _) Bn0) <- _ _ _ _] := refine_spec n B. -exact/finite_image/finite_II. -Qed. - -Local Lemma tier_finite Ufn n : tiers n Ufn -> finite_set Ufn.1.1. -Proof. -elim: n Ufn; first by move=> ? -> /=; exact: finite_set1. -move=> n IH Ufn /= [V [tr] tier_tr trV <-]; apply: refine_finite. -by have [_ ] := (tierN0 tier_tr); exact. -Qed. - - -Local Lemma tiers_finite n : finite_set (tiers n). -Proof. -elim: n; first exact: finite_set1. -move=> n IH /=; apply: finite_image; apply: bigcup_finite => //. -by move=> ? ?; apply: (@tier_finite _ n). -Qed. - -Local Lemma cauchy_branch (b : Ttree) : - cauchy (filter_from [set: nat] (target b)). -Proof. -move=> E; rewrite /= nbhs_simpl -entourage_from_ballE; case => _/posnumP[eps]. -have [] := @cvg_harmonic R (ball (0:R) eps%:num); first exact: nbhsx_ballx. -move=> n _ /(_ n (leqnn n)) /=; rewrite /ball /= sub0r normrE ger0_norm //. -move=> neps nE; exists (target b (n*2)%N.+1, target b (n*2)%N.+1). - by split; exists (n*2)%N.+1. -case=> y z [] /= rfy rfz; apply: nE; apply: (le_ball (ltW neps)) => /=. -have [_ _ _ _] := refine_spec (n * 2)%N.+1 (target b (n*2)). -move=> /= /(_ (proj1_sig (b ((n * 2)%N.+1)))) [] t rfball. -have zball := rfball z rfz; have /ball_sym yball := rfball y rfy. -have := ball_triangle yball zball; apply: le_ball. -suff P : (n*2).+2%:R^-1 <= n.+1%:R^-1/2 :> R. - by rewrite (splitr n.+1%:R^-1) ler_add //; exact: P. -rewrite -invrM // ?unitfE // ler_pinv ?inE ?unitfE; first last. - by apply/andP. - by apply/andP. -by rewrite mulrC -natrM ler_nat ?mulSn addnC ?addnS addn0. -Qed. - -Lemma ubound_finite_set (U : set nat) : - finite_set U -> ubound U !=set0. -Proof. -case/finite_setP => n; move: U; elim: n. - by move=> ?; rewrite II0 card_eq0 => /eqP ->; exists O => ?. -move=> n IH U /eq_cardSP [N UN] /IH [/= M ubdM]; exists (maxn M N). -move=> w; case: (eqVneq w N); first by move=> -> ?; exact: leq_maxr. -by move=> /eqP wN Uw; apply: leq_trans; [exact: ubdM | exact: leq_maxl]. -Qed. - -Lemma lvl_aux_ge : forall n Ufn, tiers n Ufn -> (Ufn.2 <= lvl_aux n)%N. -Proof. -elim. - move => /= ? -> /=; rewrite /lvl_aux. - rewrite (_ : [set Ufn.2 | Ufn in tiers 0] = [set 2%N]) ?supremum1 //. - rewrite eqEsubset; split => t /=; first by (do 3 case) => ? ? ? /= + <-; case. - by move=> ->; exists ([set [set: T]], fun=> [set: T], 2%N). -move=> n IH Ufn TUfn; rewrite /lvl_aux/supremum; case: ifPn. - move=> /eqP/image_set0_set0 /= /image_set0_set0/bigcup0P. - have [Ufn2 Ufn_tier] := tiersN0 n => /(_ _ Ufn_tier). - by have [/set0P/eqP + _] := @tierN0 _ Ufn2 Ufn_tier. -move=> cands. -case: xgetP => [y yA [uAy ?]|]. - apply: (@leq_trans y) => //. - by apply: uAy => /=; exists Ufn => //. -move=> /forallNP; apply: contra_notP => _; apply: nat_supremums_neq0. -apply/ubound_finite_set/finite_image/tiers_finite. -Qed. - -Lemma refine_inje n B C : B!=set0 -> - refine n B = refine n C -> B `<=` C. -Proof. -move=> ? rfnBC t Bt. -have [img _ /(_ _ (leqnn _ ) _ Bt) + _ _] := refine_spec n B. -case => m/= msmall rfbm. -have [_ /(_ _ _ _ rfbm) + _ _ _] := refine_spec n C. -apply; rewrite -rfnBC -(img _ (leqnn _)) => //. -Qed. - -Lemma refine_inj n B C : B!=set0 -> C !=set0 -> - refine n B = refine n C -> B = C. -Proof. -by move=> ? ? rfnBC; rewrite eqEsubset; split; apply: (@refine_inje n). +- rewrite finite_setU; split; first by apply: finite_image; exact: finite_fset. + exact: finite_set2. +- move=> A []. + case=> z M'z <-; exists z; split. + apply: subset_closure; apply: nbhs_singleton; apply: nbhs_interior. + by rewrite -nbhs_entourageE; exists (split_ent E). + by apply:closure_subset; exact:interior_subset. + by case => ->; [exists t0 | exists t1]; split => // t ->; + apply: subset_closure; apply:entourage_refl. +- exists [set t0], [set t1]; split;[|split]. + + by right; left. + + by right; right. + + apply/eqP; rewrite eqEsubset; case=> /(_ t0) => /= /(_ erefl). + by move: T2e => /[swap] ->/eqP. +- rewrite -subTset => t /Mcov [t' M't' fsxt]; exists (closure (fs t')). + left; by exists t' => //. + by apply: subset_closure. +- move=> ? []; first by case=> ? ? <-; exact: closed_closure. + by case => ->; apply: accessible_closed_set1; apply: hausdorff_accessible. Qed. -Lemma tier_target b n : tiers n.+1 (refine n.+1 (target b n)). -Proof. -elim: n; first by exists [set: T]; rewrite // bigcup_set1. -move=> n IH /=; exists ((refine n.+1 (target b n)).1.2 (projT1 (b n.+1))) => //. -exists (refine n.+1 (target b n)) => //. -have [/(_ (lvl_aux n.+1).+2) img _ _ _ _] := refine_spec n.+1 (target b n). -rewrite -img; last exact: targetN0. - by exists (projT1 (b n.+1)) => //; have := projT2 (b n.+1); rewrite in_setE. -do 2 apply: leqW; apply: lvl_aux_ge; exists (target b n) => //. -case: IH => V [ Ufn trUfn UfnV E]; exists Ufn => //. -have := UfnV; congr (_ _); apply: (@refine_inj n.+1) => //. - by have [_ ] := tierN0 trUfn; apply. -apply: targetN0. -Qed. +Definition ent_balls E := projT1 (cid (ent_balls' E)). +Let count_unif' := (cid2 + ((iffLR countable_uniformityP) (@countable_uniformity_metric _ T))). +Let count_unif := projT1 count_unif'. -Lemma branch_subsetS b n : target b n.+1 `<=` target b n. -Proof. -have [img + _ _ _] /= := refine_spec n.+1 (target b n). -apply; rewrite -(img (lvl_aux n.+1).+2 _ ); first last. -- exact: targetN0. -- by do 2 apply: leqW; apply: lvl_aux_ge; exact: tier_target. -by exists (projT1 (b n.+1)) => //; have := projT2 (b n.+1); rewrite in_setE. -Qed. - -Lemma branch_subset b i j : (i <= j)%N -> target b j `<=` target b i. -Proof. -elim: j i; first by move => ?; rewrite leqn0 => /eqP ->. -move=> j IH i; rewrite leq_eqVlt => /orP [/eqP -> //| /IH ji1]. -exact/(subset_trans _ ji1)/branch_subsetS. -Qed. - -Lemma filter_branch b: - ProperFilter (filter_from [set: nat] (target b)). +Lemma ent_count_unif n : entourage (count_unif n). Proof. -apply: filter_from_proper; last by move=>? _; exact: targetN0. -apply: filter_from_filter; first by exists O. -move=> i j _ _; exists (maxn i j) => // t targetIJ. -by split; apply: (branch_subset _ targetIJ); rewrite ?leq_maxl ?leq_maxr. +have := projT2 (cid (ent_balls' (count_unif n))). +rewrite /count_unif; case: count_unif'. +by move=> /= f fnA fnE; case /(_ (fnE _)) => _ _ _ + _; rewrite -subTset. Qed. -Local Lemma target_cvg b : cvg (filter_from [set: nat] (target b)). +Lemma count_unif_sub E : entourage E -> exists N, count_unif N `<=` E. Proof. -apply: (@compact_cauchy_cvg _ [set: T]) => //=. -- apply: filter_branch. -- apply: cauchy_branch. -- by exists O => //. +by move=> entE; rewrite /count_unif; case: count_unif' => f + ? /=; exact. Qed. -Local Definition bullseye (b : Ttree) : T := - lim (filter_from [set: nat] (target b)). - - -Local Fixpoint retract_aux (t : T) (n : nat) : ((set T) * lvl n) := - if n is S m - then - let rfn := refine n (retract_aux t m).1 in - get (fun (Ui :((set T) * lvl n)) => Ui.1 t /\ rfn.1.2 (projT1 Ui.2) = Ui.1) - else (setT, point). - -Local Lemma retract_refine (t : T) (n : nat) : - (retract_aux t n).1 t /\ - exists Ufn, [/\ - if n is S m then Ufn = (refine n (retract_aux t m).1) else True, - tiers n Ufn, - Ufn.1.1 (retract_aux t n).1 & - Ufn.1.2 (projT1 (retract_aux t n).2) = (retract_aux t n).1 - ]. +Hint Resolve ent_count_unif : core. +Let K' (n : nat) : Type := @sigT (set T) (ent_balls (count_unif n)). +Lemma K'p n : K' n. Proof. -elim: n; first by split => //; exists ([set setT], (fun=> setT), (2)%N). -move=> n [rtt] [Ufn [? tn retractN] ufnT]; split; first last. - exists (refine n.+1 (retract_aux t n).1) => //=; split => //. - - exists (retract_aux t n).1 => //; exists Ufn => //. - - have rtN0 : (retract_aux t n).1 !=set0 by have [_] := (tierN0 tn); exact. - case: xgetP => [[U lvln] uAx /= [? <-]|]. - have [rsurj _ _ _ _] := refine_spec n.+1 (retract_aux t n).1. - have <- /= := rsurj (lvl_aux n.+1).+2 => //. - by exists (projT1 lvln) => //; have := projT2 lvln; rewrite in_setE. - do 2 apply: leqW; apply: lvl_aux_ge; exists (retract_aux t n).1 => //. - by exists Ufn. - move=> /forallNP; apply: contra_notP => /= _. - have [rsurj _ cvr _ _] := refine_spec n.+1 (retract_aux t n).1. - have [|N Nlt rfNt] := cvr (lvl_aux n.+1).+2 _ t rtt. - do 2 apply: leqW; apply: lvl_aux_ge; exists (retract_aux t n).1 => //. - by exists Ufn. - have Nlvl : N \in `I_(lvl_aux n.+1).+2 by rewrite in_setE. - by exists ( (refine n.+1 (retract_aux t n).1).1.2 N, exist _ N Nlvl). - - case: xgetP => [[U lvln] uAx /= [? <-]|] => //. - move=> /forallNP; apply: contra_notP => /= _. - have [rsurj _ cvr _ _] := refine_spec n.+1 (retract_aux t n).1. - have [|N Nlt rfNt] := cvr (lvl_aux n.+1).+2 _ t rtt. - do 2 apply: leqW; apply: lvl_aux_ge; exists (retract_aux t n).1 => //. - by exists Ufn. - have Nlvl : N \in `I_(lvl_aux n.+1).+2 by rewrite in_setE. - by exists ( (refine n.+1 (retract_aux t n).1).1.2 N, exist _ N Nlvl). -move=> /=; case: xgetP => [[U lvln] uAx [/= //]|]. -move=> /forallNP; apply: contra_notP => /= _. -have [rsurj _ cvr _ _] := refine_spec n.+1 (retract_aux t n).1. -have [|N Nlt rfNt] := cvr (lvl_aux n.+1).+2 _ t rtt. - do 2 apply: leqW; apply: lvl_aux_ge; exists (retract_aux t n).1 => //. - by exists Ufn. -have Nlvl : N \in `I_(lvl_aux n.+1).+2 by rewrite in_setE. -by exists ( (refine n.+1 (retract_aux t n).1).1.2 N, exist _ N Nlvl). +apply: cid; have [//| _ _ _ + _] := projT2 (cid (ent_balls' (count_unif n))). +by rewrite -subTset => /(_ point I) [W Q ?]; exists W; apply Q. Qed. -Local Definition retract (t : T) : Ttree := fun n => (retract_aux t n).2. - -Local Lemma bullseye_surj : set_surj [set: Ttree] [set: T] bullseye. -Proof. -move=> t _; suff : exists f : Ttree, forall n, target f n t. - case=> f fnt; exists f => //. - apply/close_eq/close_sym => // U /open_nbhs_nbhs Ubf W Wt; exists t. - split; last exact: nbhs_singleton. - have /= [M _] := target_cvg (Ubf); apply; exact: fnt. -exists (retract t) => n; case: n => // n /=. -suff -> : target (retract t) n = (retract_aux t n).1. - by have [rtxt [Ufn] [-> trUfn ? ->]] // := retract_refine t n.+1. -elim: n => // n IH; rewrite [LHS]/= IH. -by have [_ [?] [-> ?] ] := retract_refine t n.+1. -Qed. -Lemma bullseye_prefixE (br1 br2 : Ttree) (n : nat) : - (forall i, (i <= n)%N -> br1 i = br2 i) -> - (forall i, (i <= n)%N -> target br1 i = target br2 i). -Proof. -elim: n; first by move=> i ?; rewrite leqn0 => /eqP ->. -move=> n IH eqSn i; rewrite leq_eqVlt => /orP []; first last. - by apply: IH => // ? /leqW; exact: eqSn. -move/eqP => -> /=; rewrite IH => //; first last. - by move=> ? /leqW; exact: eqSn. -by rewrite eqSn. -Qed. +Canonical K n := PointedType (classicType_choiceType (K' n)) (K'p n). +Canonical Tree := (@tree_of R K). -Lemma bullseye_target_clousre (br : Ttree) (n : nat) : - closure (target br n) (bullseye br). -Proof. -move=> B /target_cvg [N] _ NsubB; suff : target br n `&` target br N !=set0. - by case=> z [??]; exists z; split => //; exact: NsubB. -move=> {NsubB}; wlog nN : N n / (n <= N)%N. - move=> WL; case/orP: (leq_total N n); last exact: WL. - rewrite setIC; exact: WL. -have [z ?] := targetN0 br N; exists z; split => //. -by apply: (branch_subset nN). -Qed. - -Lemma closed_ball_subset (M : pseudoMetricType R) (x : M) - (r0 r1 : R) : 0 < r0 -> r0 < r1 -> closed_ball x r0 `<=` ball x r1. -Proof. -move=> r00 r01; rewrite (_ : r0 = (PosNum r00)%:num) // => y. -have r0r1 : 0 < r1 - r0 by rewrite subr_gt0. -move=> /(_ (ball y (PosNum r0r1)%:num)) []; first exact: nbhsx_ballx. -move=> z [xz /ball_sym zy]; have := ball_triangle xz zy; congr(ball _ _ _). -by rewrite /= addrC -addrA [-_ + _]addrC subrr addr0. -Qed. +Let emb_ind n (U : set T) (k : K n) := + (if (pselect (projT1 k `&` U !=set0)) + then projT1 k + else if (pselect (exists e : K n , projT1 e `&` U !=set0)) is left e + then projT1 (projT1 (cid e)) + else set0) `&` U. +Let emb_invar (U : set T) := closed U /\ U!=set0. -Lemma bullseye_prefix (br1 br2 : Ttree) (n : nat) : - (forall i, (i <= n.+1)%N -> br1 i = br2 i) -> - ball (bullseye br1) (2 * (n.+1%:R^-1)) (bullseye br2). +Lemma Kn_closed n (e : K n) : closed (projT1 e). Proof. -move=> pfxE; have := @bullseye_target_clousre br1 n.+1. -rewrite (@bullseye_prefixE br1 br2 n.+1) // => /= near_br1. -have /= near_br2 := @bullseye_target_clousre br2 n.+1. -have [surj _ _ _ rball] := refine_spec n.+1 (target br2 n). -have [t /= /closure_subset rfn] := rball (proj1_sig (br2 n.+1)). -have /(closed_ball_subset (harmonic_pos n.+1) (harmonicS n)) := rfn _ near_br1. -have /(closed_ball_subset (harmonic_pos n.+1) (harmonicS n)) := rfn _ near_br2. -rewrite [_ / _]splitr mulrC mulrA mulVf // div1r => /ball_sym b1 b2. -by have /ball_sym := ball_triangle b1 b2. +case: e => //= W; have [//| _ _ _ _] := projT2 (cid (ent_balls' (count_unif n))). +exact. Qed. -Lemma tree_prefix (y: Ttree) (n : nat) : - \forall z \near y, forall i, (i < n)%N -> y i = z i. -Proof. -elim: n; first by near=> z => ?; rewrite ltn0. -move=> n IH. -near=> z => i; rewrite leq_eqVlt => /orP []; first last. - move=> iSn; have -> := near IH z => //. -move=> /eqP/(succn_inj) ->; near: z. - exists ((proj n)@^-1` [set (y n)]); split => //. - suff : @open Ttree ((proj n)@^-1` [set (y n)]) by []. - apply: open_comp; last apply: discrete_open => //. - by move=> + _; apply: proj_continuous. -Unshelve. all: end_near. Qed. - -Lemma tree_prefix_le (y: Ttree) (n : nat) : - \forall z \near y, forall i, (i <= n)%N -> y i = z i. -Proof. exact: (tree_prefix y n.+1). Qed. - -Local Lemma bullseye_cts : continuous bullseye. -Proof. -move=> x; apply/ cvg_ballP; first exact: nbhs_filter. -move=> _/posnumP[eps]. -have [] := @cvg_harmonic R (ball (0:R) eps%:num); first exact: nbhsx_ballx. -move=> n _ /(_ n (leqnn n)); rewrite /ball [x in x -> _]/= sub0r. -rewrite normrE ger0_norm // => neps; have n2 : n.+2%:R^-1 <= n.+1%:R^-1 :> R. - by rewrite ler_pinv ?inE ?unitfE ?ler_nat //; exact/andP. -near=> z. - apply/(@le_ball _ _ _ (2 * ((2 *n).+2)%:R^-1)); last apply: bullseye_prefix. - apply: le_trans; last apply/ltW/neps. - rewrite ( _ : (2 * n).+2 = 2 * n.+1)%N ?natrM; first last. - by rewrite ?mulSn ?mul0n ?addn0 ?addnS addSn. - by rewrite -[x in x/(_ * _)]mulr1 -mulf_div divrr ?unitfE // ?mul1r. -near: z. -exact: tree_prefix_le. -Unshelve. all: end_near. Qed. -Lemma ttree_finite : cantor_like Ttree. +Lemma cantor_surj_pt1 : exists (f : Tree -> T), + continuous f /\ set_surj [set: Tree] [set: T] f. Proof. +pose entn n := projT2 (cid (ent_balls' (count_unif n))). +have [] := (@tree_map_props (fun (n : nat) => @pointedDiscrete R (K n)) + T (emb_ind) (emb_invar) cptT hsdfT). +- done. +- move=> n U; rewrite eqEsubset; split; last by move => t [? ? []]. + move=> t Ut; have [//|_ _ _ + _] := entn n; rewrite -subTset. + case/(_ t I) => W cbW Wt; exists (existT _ W cbW) => //. + by rewrite /emb_ind; case: pselect => //=; apply: absurd; exists t. +- move=> n U e [clU Un0]; split. + apply: closedI => //; case: pselect => //= ?; first exact: Kn_closed. + case: pselect; last by move=> ?; exact: closed0. + move=> ?; exact: Kn_closed. + rewrite /emb_ind; case: pselect => //= ?; case: pselect. + by case => i [z [pz bz]]; set P := cid _; have := projT2 P; apply. + case: Un0 => z Uz; apply: absurd. + have [//|_ _ _ + _] := entn n; rewrite -subTset; case/(_ z I)=> i bi iz. + by exists (existT _ _ bi); exists z. +- by move => ? []. +- by split; [exact: closedT | exists point]. +- by move => ? []. +- move=> x y xny; move: hsdfT; rewrite open_hausdorff. + case/(_ _ _ xny); case => U V /= [/set_mem Ux /set_mem Vy] [oU oV UVI0]. + move: oU; rewrite openE => /(_ _ Ux); rewrite /interior -nbhs_entourageE. + case => E entE ExU. + have [//| n ctE] := @count_unif_sub ((split_ent E) `&` ((split_ent E)^-1%classic)). + exact: filterI. + exists n => B [C ebC]; have [//|_ Csub _ _ _] := entn n => embx emby. + have [[D cbD] /= [Dx Dy]] : exists (e : K n), projT1 e x /\ projT1 e y. + move: embx emby; rewrite /emb_ind; case: pselect => /=. + by move => ? [? ?] [? ?]; exists (existT _ _ ebC); split. + case: pselect ; last by move => ? ? []. + by move=> e _ [? ?] [? ?]; exists (projT1 (cid e)). + suff : E (x, y). + by move/ExU; move/eqP/disjoints_subset:UVI0 => /[apply]. + have [z [Dz DzE]] := Csub _ cbD. + have /ent_closure:= DzE _ Dx => /(_ (ent_count_unif n))/ctE [_ /= ?]. + have /ent_closure:= DzE _ Dy => /(_ (ent_count_unif n))/ctE [? _]. + exact: (@entourage_split [uniformType of T] z). +by move=> f [ctsf surjf _]; exists f. +Qed. + +Lemma cantor_surj_pt2 : + exists (f : {surj [set: cantor_space] >-> [set: Tree]}), continuous f. +Proof. +have [] := @homeomorphism_cantor_like R Tree; first last. + by move=> f [ctsf _]; exists f. apply: cantor_like_finite_prod. - by move=> n /=; apply/ finite_setP; exists (lvl_aux n).+2; exact: card_setT. -move=> n /=. -have IO : O \in `I_(lvl_aux n).+2 by rewrite in_setE. -have I1 : 1%N \in `I_(lvl_aux n).+2 by rewrite in_setE. -by exists (exist _ O IO, exist _ 1%N I1). -Qed. - -Lemma cantor_surj : exists (f : {surj [set: cantor_space] >-> [set: T]}), - continuous f. -Proof. -have [f [ctsf _]] := homeomorphism_cantor_like (ttree_finite). -have /Psurj blz := bullseye_surj. -pose g := [surj of (projT1 blz) \o f]. -exists g => /= x; apply: (@continuous_comp cantor_space Ttree). - exact: ctsf. -have <- := projT2 blz; exact: bullseye_cts. -Qed. - -End CompactEmbedding. \ No newline at end of file + move=> n /=; have [// | fs _ _ _ _] := projT2 (cid (ent_balls' (count_unif n))). + suff -> : [set: {classic K' n}] = + (@projT1 (set T) _) @^-1` (projT1 (cid (ent_balls' (count_unif n)))). + by apply: finite_preimage => //; move=> ? ? _ _; apply: eq_sigT_hprop. + by rewrite eqEsubset; split => //; case=> /= W p. +move=> n; have [// | _ _ [A [B [pA [pB AB]]]] _ _] := + projT2 (cid (ent_balls' (count_unif n))). +simpl; exists ((existT _ _ pA), (existT _ _ pB)). +by move: AB; apply: contra_neq; apply: EqdepFacts.eq_sigT_fst. +Qed. + +Lemma cantor_surj_twop : + exists (f : {surj [set: cantor_space] >-> [set: T]}), continuous f. +Proof. +case: cantor_surj_pt2 => f ctsf; case: cantor_surj_pt1. +move => g [ctsg /Psurj [sjg gsjg]]; exists [surj of sjg \o f]. +by move=> z; apply continuous_comp; [apply: ctsf|rewrite -gsjg; apply: ctsg]. +Qed. +End two_pointed. + +Lemma cantor_surj : + exists (f : {surj [set: cantor_space] >-> [set: T]}), continuous f. +Proof. +case: (pselect (exists (p : T), p != point)). + case => p ppt; apply: cantor_surj_twop; exact: ppt. +move=> /forallNP xpt. +have : set_surj [set: cantor_space] [set: T] (cst point). + by move=> q _; exists point => //; have /negP := xpt q; rewrite negbK => /eqP. +by case/Psurj => f cstf; exists f; rewrite -cstf; apply: cst_continuous. +Qed. \ No newline at end of file From 72d444032698652cbb817b1679910379e9d685fd Mon Sep 17 00:00:00 2001 From: zstone Date: Tue, 21 Mar 2023 10:52:28 -0400 Subject: [PATCH 09/23] making things local --- CHANGELOG_UNRELEASED.md | 93 ++++++++++++++++++++++------------------- theories/cantor.v | 76 ++++++++++++--------------------- 2 files changed, 76 insertions(+), 93 deletions(-) diff --git a/CHANGELOG_UNRELEASED.md b/CHANGELOG_UNRELEASED.md index fd4376337..1c91879e8 100644 --- a/CHANGELOG_UNRELEASED.md +++ b/CHANGELOG_UNRELEASED.md @@ -164,50 +164,55 @@ - in `lebesgue_integral.v`: + lemma `le_integral_comp_abse` - + new lemma `dfwith_projK` -- in file `topology.v`, - + new lemmas `dfwith_continuous`, and `proj_open`. - -- in `topoogy.v` - + definitions `sup_pseudoMetricType`, `product_pseudoMetricType` - -- in file `topology.v`, - + new definitions `countable_uniformity`, `countable_uniformityT`, - `sup_pseudoMetric_mixin`, `sup_pseudoMetricType`, and - `product_pseudoMetricType`. - + new lemmas `countable_uniformityP`, `countable_sup_ent`, and - `countable_uniformity_metric`. - -- in `constructive_ereal.v`: - + lemmas `adde_def_doppeD`, `adde_def_doppeB` - + lemma `fin_num_sume_distrr` -- in `classical_sets.v`: - + lemma `coverE` - -- in file `topology.v`, - + new definitions `quotient_topology`, and `quotient_open`. - + new lemmas `pi_continuous`, `quotient_continuous`, and - `repr_comp_continuous`. - -- in file `boolp.v`, - + new lemma `forallp_asboolPn2`. -- in file `classical_sets.v`, - + new lemma `preimage_range`. -- in file `topology.v`, - + new definitions `hausdorff_accessible`, `separate_points_from_closed`, and - `join_product`. - + new lemmas `weak_sep_cvg`, `weak_sep_nbhsE`, `weak_sep_openE`, - `join_product_continuous`, `join_product_open`, `join_product_inj`, and - `join_product_weak`. - -- in file `topology.v`, - + new definition `clopen`. - + new lemmas `clopenI`, `clopenU`, `clopenC`, `clopen0`, `clopenT`, - `clopen_comp`, `connected_closure`, `clopen_separatedP`, and - `clopen_connectedP`. - -- in file `topology.v`, - + new lemmas `powerset_filter_fromP` and `compact_cluster_set1`. +- file `itv.v`: + + definition `wider_itv` + + module `Itv`: + * definitions `map_itv_bound`, `map_itv` + * lemmas `le_map_itv_bound`, `subitv_map_itv` + * definition `itv_cond` + * record `def` + * notation `spec` + * record `typ` + * definitions `mk`, `from`, `fromP` + + notations `{itv R & i}`, `{i01 R}`, `%:itv`, `[itv of _]`, `inum`, `%:inum` + + definitions `itv_eqMixin`, `itv_choiceMixin`, `itv_porderMixin` + + canonical `itv_subType`, `itv_eqType`, `itv_choiceType`, `itv_porderType` + + lemma `itv_top_typ_subproof` + + canonical `itv_top_typ` + + lemma `typ_inum_subproof` + + canonical `typ_inum` + + notation `unify_itv` + + lemma `itv_intro` + + definition `empty_itv` + + lemmas `itv_bottom`, `itv_gt0`, `itv_le0F`, `itv_lt0`, `itv_ge0F`, `itv_ge0`, `lt0F`, `le0`, `gt0F`, `lt1`, + `ge1F`, `le1`, `gt1F` + + lemma `widen_itv_subproof` + + definition `widen_itv` + + lemma `widen_itvE` + + notation `%:i01` + + lemma `zero_inum_subproof` + + canonical `zero_inum` + + lemma `one_inum_subproof` + + canonical `one_inum` + + definition `opp_itv_bound_subdef` + + lemmas `opp_itv_ge0_subproof`, `opp_itv_gt0_subproof`, `opp_itv_boundr_subproof`, + `opp_itv_le0_subproof`, `opp_itv_lt0_subproof`, `opp_itv_boundl_subproof` + + definition `opp_itv_subdef` + + lemma `opp_inum_subproof ` + + canonical `opp_inum` + + definitions `add_itv_boundl_subdef`, `add_itv_boundr_subdef`, `add_itv_subdef` + + lemma `add_inum_subproof` + + canonical `add_inum` + + definitions `itv_bound_signl`, `itv_bound_signr`, `interval_sign` + + variant `interval_sign_spec` + + lemma `interval_signP` + + definitions `mul_itv_boundl_subdef`, `mul_itv_boundr_subdef` + + lemmas `mul_itv_boundl_subproof`, `mul_itv_boundrC_subproof`, `mul_itv_boundr_subproof`, + `mul_itv_boundr'_subproof` + + definition `mul_itv_subdef` + + lemmas `map_itv_bound_min`, `map_itv_bound_max`, `mul_inum_subproof` + + canonical `mul_inum` + + lemmas `inum_eq`, `inum_le`, `inum_lt` - file `itv.v`: + definition `wider_itv` diff --git a/theories/cantor.v b/theories/cantor.v index d61747d12..62e8bcb6e 100644 --- a/theories/cantor.v +++ b/theories/cantor.v @@ -108,27 +108,15 @@ Definition cantor_like (T : topologicalType) := hausdorff_space T & totally_disconnected T]. -Lemma separator_continuous {T: topologicalType} (A : set T) : - open A -> closed A -> continuous (fun x => x \in A). +Lemma cantor_like_cantor_space: cantor_like (cantor_space). Proof. -move=> oA /closed_openC oAc; apply/continuousP; rewrite bool_predE; split => _. -- by rewrite preimage_set0; exact: open0. -- suff -> : (in_mem^~ (mem A) @^-1` [set true] = A) by []. - rewrite eqEsubset; split => x //=; first by move=> /set_mem. - by move=> ?; apply/mem_set. -- suff -> : (in_mem^~ (mem A) @^-1` [set false] = ~`A) by []. - rewrite eqEsubset; split => x //=; last exact: memNset. - by move=> + /mem_set => ->. -- rewrite -bool2E preimage_setT; exact: openT. +split. +- by apply: perfect_diagonal => //= _; exists (true, false). +- exact: cantor_space_compact. +- exact: cantor_space_hausdorff. +- exact: cantor_totally_disconnected. Qed. -Lemma discrete_closed {T : topologicalType} (dsc : discrete_space T) A : - @closed T A. -Proof. rewrite -openC; exact: discrete_open. Qed. - -Lemma closure_discrete {T : topologicalType} (dsc : discrete_space T) A : - @closure T A = A. -Proof. by apply/sym_equal/closure_id; exact: discrete_closed. Qed. Section totally_disconnected. Local Open Scope ring_scope. @@ -186,6 +174,7 @@ rewrite eqEsubset; split => z. move=> /DsubC /= [y /= yfs hyz]; exists (h' y) => //. by rewrite set_imfset /=; exists y. Qed. + Lemma compact_countable_base {R : realType} {T : pseudoMetricType R} : compact [set: T] -> countable_basis T. Proof. @@ -348,7 +337,7 @@ have := tree_prefix b n; apply: filter_app; near_simpl => /=. by near=> z => /apx_prefix ->; apply: tree_map_apx. Unshelve. all: end_near. Qed. -Local Lemma tree_map_inj : +Local Lemma tree_map_inj: (forall n U, trivIset [set: K n] (@tree_ind n U)) -> set_inj [set: T] tree_map. Proof. @@ -379,7 +368,6 @@ exists tree_map; split. Qed. End topological_trees. - (* A technique for encoding 'cantor_like' spaces as trees. We build a new function 'node' which encodes the homeomorphism to the cantor space. Other than the 'tree_map is a homeomorphism', no additinal information is @@ -397,7 +385,7 @@ Proof. by case: cantorT. Qed. Local Lemma hsdfT : @hausdorff_space T. Proof. by case: cantorT. Qed. -Definition c_invar (U : set T) := clopen U /\ U !=set0. +Let c_invar (U : set T) := clopen U /\ U !=set0. Local Lemma clopen_surj : $|{surjfun [set: nat] >-> @clopen T}|. Proof. @@ -420,14 +408,14 @@ Qed. Let split_clopen (U : set T) := projT1 (cid (split_clopen' U)). -Definition c_ind (n : nat) (V : set T) (b : bool) := +Let c_ind (n : nat) (V : set T) (b : bool) := let Wn := if pselect ((U_ n) `&` V !=set0 /\ ~` (U_ n) `&` V !=set0) then (U_ n) else split_clopen V in (if b then Wn else ~` Wn) `&` V. -Lemma cantor_map : exists (f : cantor_space -> T), +Local Lemma cantor_map : exists (f : cantor_space -> T), [/\ continuous f, set_surj [set: cantor_space] [set: T] f & set_inj [set: cantor_space] f @@ -468,7 +456,7 @@ have [] := (@tree_map_props by move=> ?; case: i; case: j => //. Qed. -Definition tree_map := projT1 (cid (cantor_map)). +Let tree_map := projT1 (cid (cantor_map)). Local Lemma tree_map_bij : bijective tree_map. Proof. @@ -490,17 +478,6 @@ exact: cantor_space_compact. Qed. End TreeStructure. - - -Lemma cantor_like_cantor_space: cantor_like (cantor_space). -Proof. -split. -- by apply: perfect_diagonal => //= _; exists (true, false). -- exact: cantor_space_compact. -- exact: cantor_space_hausdorff. -- exact: cantor_totally_disconnected. -Qed. - Section FinitelyBranchingTrees. Context {R : realType}. Definition pointedDiscrete (P : pointedType) : pseudoMetricType R := @@ -542,7 +519,7 @@ move=> entE /(_ [set y | E' (z, y)]) []. by move=> y [/=] + [_]; apply: entourage_split. Qed. -Section CompactEmbedding. +Section alexandroff_hausdorff. Context {R: realType} {T : pseudoMetricType R}. Hypothesis cptT : compact [set: T]. @@ -593,35 +570,36 @@ split. by case => ->; apply: accessible_closed_set1; apply: hausdorff_accessible. Qed. -Definition ent_balls E := projT1 (cid (ent_balls' E)). +Let ent_balls E := projT1 (cid (ent_balls' E)). Let count_unif' := (cid2 ((iffLR countable_uniformityP) (@countable_uniformity_metric _ T))). Let count_unif := projT1 count_unif'. -Lemma ent_count_unif n : entourage (count_unif n). +Local Lemma ent_count_unif n : entourage (count_unif n). Proof. have := projT2 (cid (ent_balls' (count_unif n))). rewrite /count_unif; case: count_unif'. by move=> /= f fnA fnE; case /(_ (fnE _)) => _ _ _ + _; rewrite -subTset. Qed. -Lemma count_unif_sub E : entourage E -> exists N, count_unif N `<=` E. +Local Lemma count_unif_sub E : entourage E -> exists N, count_unif N `<=` E. Proof. by move=> entE; rewrite /count_unif; case: count_unif' => f + ? /=; exact. Qed. Hint Resolve ent_count_unif : core. + Let K' (n : nat) : Type := @sigT (set T) (ent_balls (count_unif n)). -Lemma K'p n : K' n. + +Local Lemma K'p n : K' n. Proof. apply: cid; have [//| _ _ _ + _] := projT2 (cid (ent_balls' (count_unif n))). by rewrite -subTset => /(_ point I) [W Q ?]; exists W; apply Q. Qed. - -Canonical K n := PointedType (classicType_choiceType (K' n)) (K'p n). -Canonical Tree := (@tree_of R K). +Let K n := PointedType (classicType_choiceType (K' n)) (K'p n). +Let Tree := (@tree_of R K). Let emb_ind n (U : set T) (k : K n) := (if (pselect (projT1 k `&` U !=set0)) @@ -631,14 +609,13 @@ Let emb_ind n (U : set T) (k : K n) := else set0) `&` U. Let emb_invar (U : set T) := closed U /\ U!=set0. -Lemma Kn_closed n (e : K n) : closed (projT1 e). +Local Lemma Kn_closed n (e : K n) : closed (projT1 e). Proof. case: e => //= W; have [//| _ _ _ _] := projT2 (cid (ent_balls' (count_unif n))). exact. Qed. - -Lemma cantor_surj_pt1 : exists (f : Tree -> T), +Local Lemma cantor_surj_pt1 : exists (f : Tree -> T), continuous f /\ set_surj [set: Tree] [set: T] f. Proof. pose entn n := projT2 (cid (ent_balls' (count_unif n))). @@ -682,7 +659,7 @@ have [] := (@tree_map_props (fun (n : nat) => @pointedDiscrete R (K n)) by move=> f [ctsf surjf _]; exists f. Qed. -Lemma cantor_surj_pt2 : +Local Lemma cantor_surj_pt2 : exists (f : {surj [set: cantor_space] >-> [set: Tree]}), continuous f. Proof. have [] := @homeomorphism_cantor_like R Tree; first last. @@ -699,7 +676,7 @@ simpl; exists ((existT _ _ pA), (existT _ _ pB)). by move: AB; apply: contra_neq; apply: EqdepFacts.eq_sigT_fst. Qed. -Lemma cantor_surj_twop : +Local Lemma cantor_surj_twop : exists (f : {surj [set: cantor_space] >-> [set: T]}), continuous f. Proof. case: cantor_surj_pt2 => f ctsf; case: cantor_surj_pt1. @@ -717,4 +694,5 @@ move=> /forallNP xpt. have : set_surj [set: cantor_space] [set: T] (cst point). by move=> q _; exists point => //; have /negP := xpt q; rewrite negbK => /eqP. by case/Psurj => f cstf; exists f; rewrite -cstf; apply: cst_continuous. -Qed. \ No newline at end of file +Qed. +Section alexandroff_hausdorff. \ No newline at end of file From bb82cd4e3f87c98cd8238bbbbccd50e9a0ad672a Mon Sep 17 00:00:00 2001 From: zstone Date: Tue, 21 Mar 2023 10:53:07 -0400 Subject: [PATCH 10/23] changelog --- CHANGELOG_UNRELEASED.md | 93 +++++++++++++++++++++++++++++++++++++++++ 1 file changed, 93 insertions(+) diff --git a/CHANGELOG_UNRELEASED.md b/CHANGELOG_UNRELEASED.md index 1c91879e8..7a2711906 100644 --- a/CHANGELOG_UNRELEASED.md +++ b/CHANGELOG_UNRELEASED.md @@ -324,6 +324,99 @@ - in `constructive_ereal.v`: + lemma `bigmaxe_fin_num` + + lemmas `lee_sqr`, `lte_sqr`, `lee_sqrE`, `lte_sqrE`, `sqre_ge0`, + `EFin_expe`, `sqreD`, `sqredD` +- in `probability.v` + + definition of `covariance` + + lemmas `expectation_sum`, `covarianceE`, `covarianceC`, + `covariance_fin_num`, `covariance_cst_l`, `covariance_cst_r`, + `covarianceZl`, `covarianceZr`, `covarianceNl`, `covarianceNr`, + `covarianceNN`, `covarianceDl`, `covarianceDr`, `covarianceBl`, + `covarianceBr`, `variance_fin_num`, `varianceZ`, `varianceN`, + `varianceD`, `varianceB`, `varianceD_cst_l`, `varianceD_cst_r`, + `varianceB_cst_l`, `varianceB_cst_r` +- in `functions.v`: + + lemma `sumrfctE` +- in `lebesgue_integral.v`: + + lemma `integrable_sum` +- in `probability.v` + + lemma `cantelli` +- in `classical_sets.v`: + + lemmas `preimage_mem_true`, `preimage_mem_false` +- in `measure.v`: + + definition `measure_dominates`, notation `` `<< `` + + lemma `measure_dominates_trans` +- in `measure.v`: + + defintion `mfrestr` +- in `charge.v`: + + definition `measure_of_charge` + + definition `crestr0` + + definitions `jordan_neg`, `jordan_pos` + + lemmas `jordan_decomp`, `jordan_pos_dominates`, `jordan_neg_dominates` + + lemma `radon_nikodym_finite` + + definition `Radon_Nikodym`, notation `'d nu '/d mu` + + theorems `Radon_Nikodym_integrable`, `Radon_Nikodym_integral` + +- in `measure.v`: + + lemmas `measurable_pair1`, `measurable_pair2` + + lemma `covariance_le` +- in `mathcomp_extra.v` + + definition `coefE` (will be in MC 2.1/1.18) + + lemmas `deg2_poly_canonical`, `deg2_poly_factor`, `deg2_poly_min`, + `deg2_poly_minE`, `deg2_poly_ge0`, `Real.deg2_poly_factor`, + `deg_le2_poly_delta_ge0`, `deg_le2_poly_ge0` + (will be in MC 2.1/1.18) + + lemma `deg_le2_ge0` + + new lemmas `measurable_subring`, and `semiring_sigma_additive`. + + added factory `Content_SubSigmaAdditive_isMeasure` + +- in `lebesgue_integral.v`: + + lemmas `integrableP`, `measurable_int` + + new definitions `split_sym`, `gauge`, `gauge_uniformType_mixin`, + `gauge_topologicalTypeMixin`, `gauge_filtered`, `gauge_topologicalType`, + `gauge_uniformType`, `gauge_psuedoMetric_mixin`, and + `gauge_psuedoMetricType`. + + new lemmas `iter_split_ent`, `gauge_ent`, `gauge_filter`, + `gauge_refl`, `gauge_inv`, `gauge_split`, `gauge_countable_uniformity`, and + `uniform_pseudometric_sup`. + + new definitions `discrete_ent`, `discrete_uniformType`, `discrete_ball`, + `discrete_pseudoMetricType`, and `pseudoMetric_bool`. + + new lemmas `finite_compact`, `discrete_ball_center`, `compact_cauchy_cvg` + +- in file `cantor.v`, + + new definitions `countable_nat`, `totally_disconnected`, `countable_basis`, + `cantor_like`, `pointedDiscrete`, and `tree_of`. + + new lemmas `bool2E`, `bool_predE`, `cantor_space_compact`, + `cantor_space_hausdorff`, `perfect_set2`, `totally_disconnected_prod`, + `totally_disconnected_discrete`, `cantor_totally_disconnected`, + `cantor_perfect`, `cantor_like_cantor_space`, `totally_disconnected_cvg`, + `clopen_countable`, `compact_countable_base`, `tree_map_props`, + `homeomorphism_cantor_like`, `cantor_like_finite_prod`, `ent_closure`, and + `cantor_surj`. +- in file `topology.v`, + + new definitions `discrete_ent`, `discrete_ent_filter`, + `discrete_uniform_mixin`, `discrete_uniformType`, `discrete_ball`, + `discrete_pseudoMetricType_mixin`, `discrete_pseudoMetricType`, and + `pseudoMetric_bool`. + + new lemmas `finite_compact`, `discrete_ent_refl`, `discrete_ent_inv`, + `discrete_ent_split`, `discrete_ent_nbhs`, `discrete_ball_center`, + `discrete_ball_sym`, `discrete_ball_triangle`, `discrete_entourage`, and + `compact_cauchy_cvg`. + +### Changed + +- in `mathcomp_extra.v` + + lemmas `eq_bigmax`, `eq_bigmin` changed to respect `P` in the returned type. +- in `measure.v`: + + generalize `negligible` to `semiRingOfSetsType` +- in `exp.v`: + + new lemmas `power_pos_ge0`, `power_pos0`, `power_pos_eq0`, + `power_posM`, `power_posAC`, `power12_sqrt`, `power_pos_inv1`, + `power_pos_inv`, `power_pos_intmul` +- in `lebesgue_measure.v`: + + lemmas `measurable_fun_ln`, `measurable_fun_power_pos` +- in `measure.v`: + + definition `almost_everywhere` ### Changed From bf4ca6eacd34a31fab5489e0a80c530354699270 Mon Sep 17 00:00:00 2001 From: zstone Date: Wed, 22 Mar 2023 15:37:39 -0400 Subject: [PATCH 11/23] rebase changelog --- CHANGELOG_UNRELEASED.md | 194 ---------------------------------------- 1 file changed, 194 deletions(-) diff --git a/CHANGELOG_UNRELEASED.md b/CHANGELOG_UNRELEASED.md index 7a2711906..24991b832 100644 --- a/CHANGELOG_UNRELEASED.md +++ b/CHANGELOG_UNRELEASED.md @@ -19,200 +19,6 @@ + lemma `emeasurable_itv` - in `lebesgue_integral.v`: + lemma `sfinite_Fubini` -- in `topology.v`: - + lemmas `continuous_subspaceT`, `subspaceT_continuous` -- in `constructive_ereal.v` - + lemmas `fine_le`, `fine_lt`, `fine_abse`, `abse_fin_num` -- in `lebesgue_integral.v` - + lemmas `integral_fune_lt_pinfty`, `integral_fune_fin_num` -- in `topology.v` - + lemma `weak_subspace_open` - + lemma `weak_ent_filter`, `weak_ent_refl`, `weak_ent_inv`, `weak_ent_split`, - `weak_ent_nbhs` - + definition `map_pair`, `weak_ent`, `weak_uniform_mixin`, `weak_uniformType` - + lemma `sup_ent_filter`, `sup_ent_refl`, `sup_ent_inv`, `sup_ent_split`, - `sup_ent_nbhs` - + definition `sup_ent`, `sup_uniform_mixin`, `sup_uniformType` - + definition `product_uniformType` - + lemma `uniform_entourage` - + definition `weak_ball`, `weak_pseudoMetricType` - + lemma `weak_ballE` - + lemma `finI_from_countable` - + definition `countable_uniformity` - + lemmas `countable_uniformityP`, `countable_sup_ent`, - `countable_uniformity_metric` -- in `cardinality.v` - + lemmas `eq_card1`, `card_set1`, `card_eqSP`, `countable_n_subset`, - `countable_finite_subset`, `eq_card_fset_subset`, `fset_subset_countable` -- in `classical_sets.v` - + lemmas `IIDn`, `IISl` -- in `mathcomp_extra.v` - + lemma `lez_abs2n` -- in `constructive_ereal.v`: - + lemmas `gte_addl`, `gte_addr` - + lemmas `gte_daddl`, `gte_daddr` - + lemma `lte_spadder`, `lte_spaddre` - + lemma `lte_spdadder` -- in `constructive_ereal.v`: - + lemma `sum_fine` -- in `topology.v` - + lemmas `entourage_invI`, `split_ent_subset` - + definition `countable_uniform_pseudoMetricType_mixin` -- in `reals.v`: - + lemma `floor0` -- in `classical_sets.v`: - + lemmas `set_compose_subset`, `compose_diag` - + notation `\;` for the composition of relations -- OPAM package `coq-mathcomp-classical` containing `boolp.v` -- file `all_classical.v` -- in file `mathcomp_extra.v`: - + lemmas `pred_oappE` and `pred_oapp_set` (from `classical_sets.v`) - + lemma `sumr_le0` -- in file `fsbigop.v`: - + lemmas `fsumr_ge0`, `fsumr_le0`, `fsumr_gt0`, `fsumr_lt0`, `pfsumr_eq0`, - `pair_fsbig`, `exchange_fsbig` -- in file `ereal.v`: - + notation `\sum_(_ \in _) _` (from `fsbigop.v`) - + lemmas `fsume_ge0`, `fsume_le0`, `fsume_gt0`, `fsume_lt0`, - `pfsume_eq0`, `lee_fsum_nneg_subset`, `lee_fsum`, - `ge0_mule_fsumr`, `ge0_mule_fsuml` (from `fsbigop.v`) - + lemmas `finite_supportNe`, `dual_fsumeE`, `dfsume_ge0`, `dfsume_le0`, - `dfsume_gt0`, `dfsume_lt0`, `pdfsume_eq0`, `le0_mule_dfsumr`, `le0_mule_dfsuml` -- file `classical/set_interval.v` -- in file `classical/set_interval.v`: - + definitions `neitv`, `set_itv_infty_set0`, `set_itvE`, - `disjoint_itv`, `conv`, `factor`, `ndconv` (from `set_interval.v`) - + lemmas `neitv_lt_bnd`, `set_itvP`, `subset_itvP`, `set_itvoo`, `set_itv_cc`, - `set_itvco`, `set_itvoc`, `set_itv1`, `set_itvoo0`, `set_itvoc0`, `set_itvco0`, - `set_itv_infty_infty`, `set_itv_o_infty`, `set_itv_c_infty`, `set_itv_infty_o`, - `set_itv_infty_c`, `set_itv_pinfty_bnd`, `set_itv_bnd_ninfty`, `setUitv1`, - `setU1itv`, `set_itvI`, `neitvE`, `neitvP`, `setitv0`, `has_lbound_itv`, - `has_ubound_itv`, `hasNlbound`, `hasNubound`, `opp_itv_bnd_infty`, - `opp_itv_infty_bnd`, `opp_itv_bnd_bnd`, `opp_itvoo`, - `setCitvl`, `setCitvr`, `set_itv_splitI`, `setCitv`, `set_itv_splitD`, - `mem_1B_itvcc`, `conv_id`, `convEl`, `convEr`, `conv10`, `conv0`, - `conv1`, `conv_sym`, `conv_flat`, `leW_conv`, `leW_factor`, - `factor_flat`, `factorl`, `ndconvE`, `factorr`, `factorK`, - `convK`, `conv_inj`, `factor_inj`, `conv_bij`, `factor_bij`, - `le_conv`, `le_factor`, `lt_conv`, `lt_factor`, `conv_itv_bij`, - `factor_itv_bij`, `mem_conv_itv`, `mem_conv_itvcc`, `range_conv`, - `range_factor`, `mem_factor_itv`, - `set_itv_ge`, `trivIset_set_itv_nth`, `disjoint_itvxx`, `lt_disjoint`, - `disjoint_neitv`, `neitv_bnd1`, `neitv_bnd2` (from `set_interval.v`) - + lemmas `setNK`, `lb_ubN`, `ub_lbN`, `mem_NE`, `nonemptyN`, `opp_set_eq0`, - `has_lb_ubN`, `has_ubPn`, `has_lbPn` (from `reals.v`) -- in `classical_sets.v`: - + canonical `unit_pointedType` -- in `measure.v`: - + definition `finite_measure` - + mixin `isProbability`, structure `Probability`, type `probability` - + lemma `probability_le1` - + definition `discrete_measurable_unit` - + structures `sigma_finite_additive_measure` and `sigma_finite_measure` - -- in file `topology.v`, - + new definition `perfect_set`. - + new lemmas `perfectTP`, `perfect_prod`, and `perfect_diagonal`. -- in `constructive_ereal.v`: - + lemmas `EFin_sum_fine`, `sumeN` - + lemmas `adde_defDr`, `adde_def_sum`, `fin_num_sumeN` - + lemma `fin_num_adde_defr`, `adde_defN` - -- in `constructive_ereal.v`: - + lemma `oppe_inj` - -- in `mathcomp_extra.v`: - + lemma `add_onemK` - + function `swap` -- in `classical_sets.v`: - + lemmas `setT0`, `set_unit`, `set_bool` - + lemmas `xsection_preimage_snd`, `ysection_preimage_fst` -- in `exp.v`: - + lemma `expR_ge0` -- in `measure.v` - + lemmas `measurable_curry`, `measurable_fun_fst`, `measurable_fun_snd`, - `measurable_fun_swap`, `measurable_fun_pair`, `measurable_fun_if_pair` - + lemmas `dirac0`, `diracT` - + lemma `finite_measure_sigma_finite` -- in `lebesgue_measure.v`: - + lemma `measurable_fun_opp` -- in `lebesgue_integral.v` - + lemmas `integral0_eq`, `fubini_tonelli` - + product measures now take `{measure _ -> _}` arguments and their - theory quantifies over a `{sigma_finite_measure _ -> _}`. -- in `topoogy.v` - + definitions `sup_pseudoMetricType`, `product_pseudoMetricType` - -- in `classical_sets.v`: - + lemma `trivIset_mkcond` -- in `numfun.v`: - + lemmas `xsection_indic`, `ysection_indic` -- in `classical_sets.v`: - + lemmas `xsectionI`, `ysectionI` -- in `lebesgue_integral.v`: - + notations `\x`, `\x^` for `product_measure1` and `product_measure2` - -- in `constructive_ereal.v`: - + lemmas `expeS`, `fin_numX` - -- in `functions.v`: - + lemma `countable_bijP` - + lemma `patchE` - + lemma `measurable_fun_bool` -- in `constructive_ereal.v`: - + lemma `lt0e` -- in `lebesgue_integral.v`: - + lemma `le_integral_comp_abse` - -- file `itv.v`: - + definition `wider_itv` - + module `Itv`: - * definitions `map_itv_bound`, `map_itv` - * lemmas `le_map_itv_bound`, `subitv_map_itv` - * definition `itv_cond` - * record `def` - * notation `spec` - * record `typ` - * definitions `mk`, `from`, `fromP` - + notations `{itv R & i}`, `{i01 R}`, `%:itv`, `[itv of _]`, `inum`, `%:inum` - + definitions `itv_eqMixin`, `itv_choiceMixin`, `itv_porderMixin` - + canonical `itv_subType`, `itv_eqType`, `itv_choiceType`, `itv_porderType` - + lemma `itv_top_typ_subproof` - + canonical `itv_top_typ` - + lemma `typ_inum_subproof` - + canonical `typ_inum` - + notation `unify_itv` - + lemma `itv_intro` - + definition `empty_itv` - + lemmas `itv_bottom`, `itv_gt0`, `itv_le0F`, `itv_lt0`, `itv_ge0F`, `itv_ge0`, `lt0F`, `le0`, `gt0F`, `lt1`, - `ge1F`, `le1`, `gt1F` - + lemma `widen_itv_subproof` - + definition `widen_itv` - + lemma `widen_itvE` - + notation `%:i01` - + lemma `zero_inum_subproof` - + canonical `zero_inum` - + lemma `one_inum_subproof` - + canonical `one_inum` - + definition `opp_itv_bound_subdef` - + lemmas `opp_itv_ge0_subproof`, `opp_itv_gt0_subproof`, `opp_itv_boundr_subproof`, - `opp_itv_le0_subproof`, `opp_itv_lt0_subproof`, `opp_itv_boundl_subproof` - + definition `opp_itv_subdef` - + lemma `opp_inum_subproof ` - + canonical `opp_inum` - + definitions `add_itv_boundl_subdef`, `add_itv_boundr_subdef`, `add_itv_subdef` - + lemma `add_inum_subproof` - + canonical `add_inum` - + definitions `itv_bound_signl`, `itv_bound_signr`, `interval_sign` - + variant `interval_sign_spec` - + lemma `interval_signP` - + definitions `mul_itv_boundl_subdef`, `mul_itv_boundr_subdef` - + lemmas `mul_itv_boundl_subproof`, `mul_itv_boundrC_subproof`, `mul_itv_boundr_subproof`, - `mul_itv_boundr'_subproof` - + definition `mul_itv_subdef` - + lemmas `map_itv_bound_min`, `map_itv_bound_max`, `mul_inum_subproof` - + canonical `mul_inum` - + lemmas `inum_eq`, `inum_le`, `inum_lt` - file `itv.v`: + definition `wider_itv` From 805be30808c7b08b178dbd1613f73e3fe9578c73 Mon Sep 17 00:00:00 2001 From: zstone Date: Wed, 22 Mar 2023 15:57:41 -0400 Subject: [PATCH 12/23] fixing build --- theories/cantor.v | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/theories/cantor.v b/theories/cantor.v index 62e8bcb6e..35c2ea1d1 100644 --- a/theories/cantor.v +++ b/theories/cantor.v @@ -695,4 +695,4 @@ have : set_surj [set: cantor_space] [set: T] (cst point). by move=> q _; exists point => //; have /negP := xpt q; rewrite negbK => /eqP. by case/Psurj => f cstf; exists f; rewrite -cstf; apply: cst_continuous. Qed. -Section alexandroff_hausdorff. \ No newline at end of file +End alexandroff_hausdorff. \ No newline at end of file From c0c12f0c71b3395bf02c945a3c5ad50c1cffb55e Mon Sep 17 00:00:00 2001 From: zstone Date: Wed, 3 May 2023 11:12:44 -0400 Subject: [PATCH 13/23] cleaning up cantor stuff for PRs --- theories/cantor.v | 226 ++++++++++++-------------------------------- theories/topology.v | 44 --------- 2 files changed, 61 insertions(+), 209 deletions(-) diff --git a/theories/cantor.v b/theories/cantor.v index 35c2ea1d1..6d380c190 100644 --- a/theories/cantor.v +++ b/theories/cantor.v @@ -2,7 +2,7 @@ From mathcomp Require Import all_ssreflect ssralg ssrint ssrnum matrix . From mathcomp Require Import interval rat fintype finmap. Require Import mathcomp_extra boolp classical_sets signed functions cardinality. -Require Import fsbigop reals topology sequences real_interval normedtype. +Require Import reals topology. From HB Require Import structures. Set Implicit Arguments. @@ -12,19 +12,13 @@ Import Order.TTheory GRing.Theory Num.Def Num.Theory. Import numFieldTopology.Exports. Local Open Scope classical_set_scope. -Lemma bool2E : [set: bool] = [set true; false]. -Proof. by rewrite eqEsubset; split => //= [[]] //= _;[left|right]. Qed. - -Lemma bool_predE (P : set bool -> Prop) : - (forall A, P A) = - [/\ P set0, P [set true], P [set false] & P [set true; false]]. -Proof. -rewrite propeqE; split; first by move=> Pa; split; exact: Pa. -move=> [? ? ? ?] A; have Atf : A `<=` [set true; false] by rewrite -bool2E => ?. -by have := (subset_set2 Atf); case => ->. -Qed. +Definition cantor_like (T : topologicalType) := + [/\ perfect_set [set: T], + compact [set: T], + hausdorff_space T + & zero_dimensional T]. -Canonical cantor_space := +Definition cantor_space := product_uniformType (fun (_ : nat) => @discrete_uniformType _ discrete_bool). Definition countable_nat : countable [set: nat_countType]. @@ -43,53 +37,9 @@ Qed. Lemma cantor_space_hausdorff : hausdorff_space cantor_space. Proof. apply: hausdorff_product => ?; exact: discrete_hausdorff. Qed. -Section perfect_sets. - -Implicit Types (T : topologicalType). -Lemma perfect_set2 {T} : perfect_set [set: T] <-> - forall (U : set T), open U -> U !=set0 -> - exists x y, [/\ U x, U y & x != y] . -Proof. - -apply: iff_trans; first exact: perfectTP; split. - move=> nx1 U oU [] x Ux; exists x. - have : U <> [set x] by move=> Ux1; apply: (nx1 x); rewrite -Ux1. - apply: contra_notP; move/not_existsP/contrapT=> Uyx; rewrite eqEsubset. - (split => //; last by move=> ? ->); move=> y Uy; have /not_and3P := Uyx y. - by case => // /negP; rewrite negbK => /eqP ->. -move=> Unxy x Ox; have [] := Unxy _ Ox; first by exists x. -by move=> y [] ? [->] -> /eqP. -Qed. - -End perfect_sets. - -Section clopen. -Definition totally_disconnected (T : topologicalType) := - forall (x y : T), x != y -> exists A, A x /\ ~ A y /\ clopen A. - - -Lemma totally_disconnected_prod (I : choiceType) (T : I -> topologicalType) : - (forall i, @totally_disconnected (T i)) -> - totally_disconnected (product_topologicalType T). -Proof. -move=> dctTI /= x y /eqP xneqy. -have [i /eqP /dctTI [A] [] Axi [] nAy coA] : exists i, x i <> y i. - by apply/existsNP=> W; exact/xneqy/functional_extensionality_dep. -exists (proj i @^-1` A); split;[|split] => //. -by apply: clopen_comp => //; exact: proj_continuous. -Qed. - -Lemma totally_disconnected_discrete {T} : - discrete_space T -> totally_disconnected T. -Proof. -move=> dsct x y /eqP xneqy; exists [set x]; split; [|split] => //. - by move=> W; apply: xneqy; rewrite W. -by split => //; [exact: discrete_open | exact: discrete_closed]. -Qed. - -Lemma cantor_totally_disconnected : totally_disconnected cantor_space. +Lemma cantor_zero_dimensional : zero_dimensional cantor_space. Proof. -by apply: totally_disconnected_prod => _; apply: totally_disconnected_discrete. +by apply: zero_dimension_prod => _; exact: discrete_zero_dimension. Qed. Lemma cantor_perfect : perfect_set [set: cantor_space]. @@ -97,111 +47,56 @@ Proof. by apply: perfect_diagonal => _; exists (true, false). Qed. -Definition countable_basis (T : topologicalType) := exists B, - [/\ countable B, - forall A, B A -> open A & - forall (x:T) V, nbhs x V -> exists A, B A /\ nbhs x A /\ A `<=` V]. - -Definition cantor_like (T : topologicalType) := - [/\ perfect_set [set: T], - compact [set: T], - hausdorff_space T - & totally_disconnected T]. - Lemma cantor_like_cantor_space: cantor_like (cantor_space). Proof. split. - by apply: perfect_diagonal => //= _; exists (true, false). - exact: cantor_space_compact. - exact: cantor_space_hausdorff. -- exact: cantor_totally_disconnected. +- exact: cantor_zero_dimensional. Qed. +Section perfect_sets. -Section totally_disconnected. -Local Open Scope ring_scope. - -Lemma totally_disconnected_cvg {T : topologicalType} (x : T) : - {for x, totally_disconnected T} -> compact [set: T] -> - filter_from [set D | D x /\ clopen D] id --> x. -Proof. -pose F := filter_from [set D | D x /\ open D /\ closed D] id. -have PF : ProperFilter F. - apply: filter_from_proper; first apply: filter_from_filter. - - by exists setT; split => //; split => //; exact: openT. - - move=> A B [? [] ? ?] [? [] ? ?]; exists (A `&` B) => //. - by split => //; split; [exact: openI | exact: closedI]. - - by move=> ? [? _]; exists x. -move=> disct cmpT U Ux; rewrite nbhs_simpl -/F; wlog oU : U Ux / open U. - move: Ux; rewrite /= {1}nbhsE => [][] O Ox OsubU P; apply: (filterS OsubU). - by apply: P => //; [exact: open_nbhs_nbhs | case: Ox]. -have /(iffLR (compact_near_coveringP _)): compact (~`U). - by apply: (subclosed_compact _ cmpT) => //; exact: open_closedC. -move=> /( _ _ _ (fun C y => ~ C y) (powerset_filter_from_filter PF)); case. - move=> y nUy; have /disct [C [Cx [] ? [] ? ?]] : x != y. - by apply/eqP => E; move: nUy; rewrite -E; apply; apply: nbhs_singleton. - exists (~`C, [set U | U `<=` C]); last by move=> [? ?] [? /subsetC]; exact. - split; first by apply: open_nbhs_nbhs; split => //; exact: closed_openC. - apply/near_powerset_filter_fromP; first by move=> ? ?; exact: subset_trans. - by exists C => //; exists C. -by move=> D [] DF Dsub [C] DC /(_ _ DC) /subsetC2/filterS; apply; exact: DF. -Qed. - -Lemma clopen_countable {T : topologicalType}: - compact [set: T] -> - countable_basis T -> - countable (@clopen T). +Implicit Types (T : topologicalType). +Lemma perfect_set2 {T} : perfect_set [set: T] <-> + forall (U : set T), open U -> U !=set0 -> + exists x y, [/\ U x, U y & x != y] . Proof. -move=> cmpT [B []] /fset_subset_countable cntB obase Bbase. -apply/(card_le_trans _ cntB)/pcard_surjP. -pose f := (fun (F : {fset set T}) => \bigcup_(x in [set` F]) x); exists f. -move=> D [] oD cD /=; have cmpt : cover_compact D. - by rewrite -compact_cover; exact: (subclosed_compact _ cmpT). -have h : forall (x : T), exists (V : set T), D x -> B V /\ nbhs x V /\ V `<=` D. - move=> x; case: (pselect (D x)); last by move=> ?; exists set0. - by rewrite openE in oD; move=> /oD/Bbase [A[] ? [] ? ?]; exists A. -pose h' := fun z => projT1 (cid (h z)). -have [] := @cmpt T D h'. -- by move=> z Dz; apply: obase; have [] := projT2 (cid (h z)) Dz. -- move=> z Dz; exists z => //; apply: nbhs_singleton. - by have [? []] := projT2 (cid (h z)) Dz. -move=> fs fsD DsubC; exists ([fset h' z | z in fs])%fset. - move=> U/imfsetP [z /=] /fsD /set_mem Dz ->; rewrite inE. - by have [? []] := projT2 (cid (h z)) Dz. -rewrite eqEsubset; split => z. - case=> y /imfsetP [x /= /fsD/set_mem Dx ->]; move: z. - by have [? []] := projT2 (cid (h x)) Dx. -move=> /DsubC /= [y /= yfs hyz]; exists (h' y) => //. -by rewrite set_imfset /=; exists y. +apply: iff_trans; first exact: perfectTP; split. + move=> nx1 U oU [] x Ux; exists x. + have : U <> [set x] by move=> Ux1; apply: (nx1 x); rewrite -Ux1. + apply: contra_notP; move/not_existsP/contrapT=> Uyx; rewrite eqEsubset. + (split => //; last by move=> ? ->); move=> y Uy; have /not_and3P := Uyx y. + by case => // /negP; rewrite negbK => /eqP ->. +move=> Unxy x Ox; have [] := Unxy _ Ox; first by exists x. +by move=> y [] ? [->] -> /eqP. Qed. -Lemma compact_countable_base {R : realType} {T : pseudoMetricType R} : - compact [set: T] -> countable_basis T. -Proof. -have npos : forall n, ((0:R) < (n.+1%:R^-1))%R by []. -pose f : nat -> T -> (set T) := fun n z => (ball z (PosNum (npos n))%:num)^°. -move=> cmpt; have h : forall n, finite_subset_cover [set: T] (f n) [set: T]. - move=> n; rewrite compact_cover in cmpt; apply: cmpt. - by move=> z _; rewrite /f; exact: open_interior. - move=> z _; exists z => //; rewrite /f/interior; exact: nbhsx_ballx. -pose h' := fun n => (cid (iffLR (exists2P _ _) (h n))). -pose h'' := fun n => projT1 (h' n). -pose B := \bigcup_n (f n) @` [set` (h'' n)]; exists B; split. -- apply: bigcup_countable => // n _; apply: finite_set_countable. - exact/finite_image/ finite_fset. -- by move=> z [n _ [w /= wn <-]]; exact: open_interior. -- move=> x V /nbhs_ballP [] _/posnumP[eps] ballsubV. - have [//|N] := @ltr_add_invr R 0%R (eps%:num/2) _; rewrite add0r => deleps. - have [w [wh fx]] : exists w : T, w \in h'' N /\ f N w x. - by have [_ /(_ x) [// | w ? ?]] := projT2 (h' N); exists w. - exists (f N w); split; first (by exists N); split. - by apply: open_nbhs_nbhs; split => //; exact: open_interior. - apply: (subset_trans _ ballsubV) => z bz. - rewrite [_%:num]splitr; apply: (@ball_triangle _ _ w). - by apply: (le_ball (ltW deleps)); apply/ball_sym; apply: interior_subset. - by apply: (le_ball (ltW deleps)); apply: interior_subset. -Qed. +End perfect_sets. +(* The overall goal of the next few sections is to prove that + Every compact metric space `T` is the image of the cantor space. + The overall proof will build a function + cantor space -> a bespoke tree for `T` -> `T` + The proof is in 4 parts + + Part 1: Some generic machinery about continuous functions from trees. + Part 2: All cantor-like spaces are homeomorphic to the cantor space + Part 3: Finitely branching trees are cantor-like + Part 4: Every compact metric space has a finitely branching tree with + a continuous surjection. + + Part 1: + A tree here has countable levels, and nodes of type `K n` on the nth level. + Each level is in the 'discrete' topology, so the nodes are independent. + The goal is to build a map from branches to X. + 1. Each level of the tree corresponds to an approximation of `X` + 2. Each level refines the previous approximation + 3. Then each branch has a corresponding cauchy filter + 4. The overall function from branches to X is a continuous surjection + 5. With an extra disjointness condition, this is also an injection +*) Section topological_trees. Context {K : nat -> topologicalType} {X : topologicalType}. Context (tree_ind : forall n, set X -> K n -> set X). @@ -267,8 +162,7 @@ apply/cvg_ex; exists x => /=; apply: (compact_cluster_set1 _ cmptX) => //. by apply: filterT; exact: tree_map_filter. rewrite eqEsubset; split; last by move=> ? ->. move=> y cly; case: (eqVneq x y); first by move=> ->. -case/ind_separates => n sep. -have bry : branch_apx b n.+1 y. +case/ind_separates => n sep; have bry : branch_apx b n.+1 y. rewrite [branch_apx _ _](iffLR (closure_id _)). by move: cly; rewrite clusterE; apply; exists n.+1. apply: invar_cl; apply: tree_map_invar. @@ -368,15 +262,14 @@ exists tree_map; split. Qed. End topological_trees. -(* A technique for encoding 'cantor_like' spaces as trees. We build a new - function 'node' which encodes the homeomorphism to the cantor space. - Other than the 'tree_map is a homeomorphism', no additinal information is - will be needed outside this context. So it's OK that the definitions are - rather unpleasant *) +(* + Part 2: We can use `tree_map_props` to build a homeomorphism from the + cantor_space to T by constructing. +*) Section TreeStructure. Context {R : realType} {T : pseudoMetricType R}. Hypothesis cantorT : cantor_like T. -Local Lemma dsctT : @totally_disconnected T. +Local Lemma dsctT : zero_dimensional T. Proof. by case: cantorT. Qed. Local Lemma pftT : perfect_set [set: T]. Proof. by case: cantorT. Qed. @@ -391,7 +284,7 @@ Local Lemma clopen_surj : $|{surjfun [set: nat] >-> @clopen T}|. Proof. suff : (@clopen T = set0 \/ $|{surjfun [set: nat] >-> @clopen T}|). by case; rewrite // eqEsubset; case=>/(_ _ clopenT). -by apply/pfcard_geP/clopen_countable/ compact_countable_base; case: cantorT. +by apply/pfcard_geP/clopen_countable/compact_second_countable; case: cantorT. Qed. Let U_ := unsquash clopen_surj. @@ -402,7 +295,7 @@ Proof. case: (pselect (open U)) => oU; last by exists point. case: (pselect (U !=set0)) => Un0; last by exists point. have [x [y] [Ux] Uy xny] := (iffLR perfect_set2) pftT U oU Un0. -have [V [?] [?] [? ?]] := dsctT xny; exists V. +have [V [? ? ?]] := dsctT xny; exists V. by repeat split => //; [exists x | exists y]. Qed. @@ -443,7 +336,7 @@ have [] := (@tree_map_props - by move=> ? []. - by split;[ exact: clopenT |exists point]. - by move=> ? [[]]. -- move=> x y /dsctT [A [Ax [Any clA]]]. +- move=> x y /dsctT [A [clA Ax Any]]. have [] := (@surj _ _ _ _ U_ _ clA) => n _ UnA; exists n => V e. case: (pselect (V y)); last by move=> + _; apply: subsetC => ? []. case: (pselect (V x)); last by move=> + _ []. @@ -478,6 +371,8 @@ exact: cantor_space_compact. Qed. End TreeStructure. + +(* Part 3: Finitely Branching trees are cantor-like *) Section FinitelyBranchingTrees. Context {R : realType}. Definition pointedDiscrete (P : pointedType) : pseudoMetricType R := @@ -503,8 +398,8 @@ move=> finiteT twoElems; split. by congr (compact _) => //=; rewrite eqEsubset; split => b. - apply (@hausdorff_product _ (fun n => pointedDiscrete (T n))). by move=> n; exact: discrete_hausdorff. -- apply totally_disconnected_prod => ?. - exact: totally_disconnected_discrete. +- apply zero_dimension_prod => ?. + exact: discrete_zero_dimension. Qed. End FinitelyBranchingTrees. @@ -519,6 +414,7 @@ move=> entE /(_ [set y | E' (z, y)]) []. by move=> y [/=] + [_]; apply: entourage_split. Qed. +(* Part 4: Building a finitely branching tree to cover `T` *) Section alexandroff_hausdorff. Context {R: realType} {T : pseudoMetricType R}. @@ -664,7 +560,7 @@ Local Lemma cantor_surj_pt2 : Proof. have [] := @homeomorphism_cantor_like R Tree; first last. by move=> f [ctsf _]; exists f. -apply: cantor_like_finite_prod. +apply: (@cantor_like_finite_prod _ (fun n => @pointedDiscrete R (K n))). move=> n /=; have [// | fs _ _ _ _] := projT2 (cid (ent_balls' (count_unif n))). suff -> : [set: {classic K' n}] = (@projT1 (set T) _) @^-1` (projT1 (cid (ent_balls' (count_unif n)))). diff --git a/theories/topology.v b/theories/topology.v index 4e1bd3dd6..c49f2dc99 100644 --- a/theories/topology.v +++ b/theories/topology.v @@ -3195,14 +3195,6 @@ Lemma bigsetU_compact I (F : I -> set X) (s : seq I) (P : pred I) : compact (\big[setU/set0]_(i <- s | P i) F i). Proof. by move=> ?; elim/big_ind : _ =>//; [exact:compact0|exact:compactU]. Qed. -Lemma finite_compact (A : set X) : finite_set A -> compact A. -Proof. -case/finite_setP=> n; elim: n A. - move=> A; rewrite II0 card_eq0 => /eqP ->; exact: compact0. -move=> n IHn A /eq_cardSP [] x Ax /IHn cAx; rewrite -(setD1K Ax). -by apply: compactU => //; exact: compact_set1. -Qed. - (* The closed condition here is neccessary to make this definition work in a *) (* non-hausdorff setting. *) Definition compact_near (F : set (set X)) := @@ -5283,42 +5275,6 @@ End prod_PseudoMetric. Canonical prod_pseudoMetricType (R : numDomainType) (U V : pseudoMetricType R) := PseudoMetricType (U * V) (@prod_pseudoMetricType_mixin R U V). -Section discrete_pseudoMetric. -Context {R : numDomainType} {T : topologicalType} {dsc : discrete_space T}. -Definition discrete_ball (x : T) (eps : R) y : Prop := x = y. - -Lemma discrete_ball_center x (eps : R) : 0 < eps -> discrete_ball x eps x. -Proof. by []. Qed. - -Lemma discrete_ball_sym x y (eps : R) : - discrete_ball x eps y -> discrete_ball y eps x. -Proof. by rewrite /discrete_ball => ->. Qed. - -Lemma discrete_ball_triangle x y z (e1 e2 : R) : - discrete_ball x e1 y -> discrete_ball y e2 z -> discrete_ball x (e1 + e2) z. -Proof. by rewrite /discrete_ball => -> ->. Qed. - -Lemma discrete_entourage : - @entourage (@discrete_uniformType _ dsc) = entourage_ discrete_ball. -Proof. -rewrite predeqE => P; split; last first. - by case=> e _ subP [a b] [i _] /pair_equal_spec [-> ->]; apply: subP. -move=> entP; exists 1 => //= z z12; apply: entP; exists z.1 => //=. -by rewrite {2}z12 -surjective_pairing. -Qed. - -Definition discrete_pseudoMetricType_mixin := - PseudoMetric.Mixin discrete_ball_center discrete_ball_sym - discrete_ball_triangle discrete_entourage. - -Definition discrete_pseudoMetricType := PseudoMetricType - (@discrete_uniformType _ dsc) discrete_pseudoMetricType_mixin. - -End discrete_pseudoMetric. - -Definition pseudoMetric_bool {R : realType} := - @discrete_pseudoMetricType R [topologicalType of bool] discrete_bool. - Section Nbhs_fct2. Context {T : Type} {R : numDomainType} {U V : pseudoMetricType R}. Lemma fcvg_ball2P {F : set (set U)} {G : set (set V)} From 90bb3681e422457317820ae96e64de8da4833f0a Mon Sep 17 00:00:00 2001 From: zstone Date: Wed, 3 May 2023 11:47:45 -0400 Subject: [PATCH 14/23] alexandroff hausdorff --- _CoqProject | 1 + theories/cantor.v | 314 +++++++++++++++++++------------------------- theories/topology.v | 22 ++++ 3 files changed, 159 insertions(+), 178 deletions(-) diff --git a/_CoqProject b/_CoqProject index fb6175469..fcb3ccc19 100644 --- a/_CoqProject +++ b/_CoqProject @@ -22,6 +22,7 @@ theories/reals.v theories/landau.v theories/Rstruct.v theories/topology.v +theories/cantor.v theories/prodnormedzmodule.v theories/normedtype.v theories/realfun.v diff --git a/theories/cantor.v b/theories/cantor.v index 6d380c190..80b1c90d2 100644 --- a/theories/cantor.v +++ b/theories/cantor.v @@ -12,40 +12,33 @@ Import Order.TTheory GRing.Theory Num.Def Num.Theory. Import numFieldTopology.Exports. Local Open Scope classical_set_scope. +Definition cantor_space := + product_uniformType (fun (_ : nat) => @discrete_uniformType _ discrete_bool). + Definition cantor_like (T : topologicalType) := - [/\ perfect_set [set: T], + [/\ perfect_set [set: T], compact [set: T], hausdorff_space T & zero_dimensional T]. -Definition cantor_space := - product_uniformType (fun (_ : nat) => @discrete_uniformType _ discrete_bool). - -Definition countable_nat : countable [set: nat_countType]. -Proof. done. Qed. - -Canonical cantor_psuedoMetric {R} := - @product_pseudoMetricType R _ (fun (_ : nat) => - @discrete_pseudoMetricType R _ discrete_bool) countable_nat. +Canonical cantor_psuedoMetric {R} := + @product_pseudoMetricType R _ (fun (_ : nat) => + @discrete_pseudoMetricType R _ discrete_bool) (countableP _). Lemma cantor_space_compact: compact [set: cantor_space]. Proof. -have := (@tychonoff _ (fun (_: nat) => _) _ (fun=> bool_compact)). -by congr (compact _) => //=; rewrite eqEsubset; split => b //=. +have := @tychonoff _ (fun (_: nat) => _) _ (fun=> bool_compact). +by congr (compact _); rewrite eqEsubset; split => b. Qed. Lemma cantor_space_hausdorff : hausdorff_space cantor_space. -Proof. apply: hausdorff_product => ?; exact: discrete_hausdorff. Qed. +Proof. by apply: hausdorff_product => ?; exact: discrete_hausdorff. Qed. Lemma cantor_zero_dimensional : zero_dimensional cantor_space. -Proof. -by apply: zero_dimension_prod => _; exact: discrete_zero_dimension. -Qed. +Proof. by apply: zero_dimension_prod => _; exact: discrete_zero_dimension. Qed. Lemma cantor_perfect : perfect_set [set: cantor_space]. -Proof. -by apply: perfect_diagonal => _; exists (true, false). -Qed. +Proof. by apply: perfect_diagonal => _; exists (true, false). Qed. Lemma cantor_like_cantor_space: cantor_like (cantor_space). Proof. @@ -56,25 +49,6 @@ split. - exact: cantor_zero_dimensional. Qed. -Section perfect_sets. - -Implicit Types (T : topologicalType). -Lemma perfect_set2 {T} : perfect_set [set: T] <-> - forall (U : set T), open U -> U !=set0 -> - exists x y, [/\ U x, U y & x != y] . -Proof. -apply: iff_trans; first exact: perfectTP; split. - move=> nx1 U oU [] x Ux; exists x. - have : U <> [set x] by move=> Ux1; apply: (nx1 x); rewrite -Ux1. - apply: contra_notP; move/not_existsP/contrapT=> Uyx; rewrite eqEsubset. - (split => //; last by move=> ? ->); move=> y Uy; have /not_and3P := Uyx y. - by case => // /negP; rewrite negbK => /eqP ->. -move=> Unxy x Ox; have [] := Unxy _ Ox; first by exists x. -by move=> y [] ? [->] -> /eqP. -Qed. - -End perfect_sets. - (* The overall goal of the next few sections is to prove that Every compact metric space `T` is the image of the cantor space. The overall proof will build a function @@ -84,7 +58,7 @@ End perfect_sets. Part 1: Some generic machinery about continuous functions from trees. Part 2: All cantor-like spaces are homeomorphic to the cantor space Part 3: Finitely branching trees are cantor-like - Part 4: Every compact metric space has a finitely branching tree with + Part 4: Every compact metric space has a finitely branching tree with a continuous surjection. Part 1: @@ -99,52 +73,50 @@ End perfect_sets. *) Section topological_trees. Context {K : nat -> topologicalType} {X : topologicalType}. -Context (tree_ind : forall n, set X -> K n -> set X). +Context (refine_apx : forall n, set X -> K n -> set X). Context (tree_invariant : (set X -> Prop)). Hypothesis cmptX : compact [set: X]. Hypothesis hsdfX : hausdorff_space X. Hypothesis discreteK : forall n, discrete_space (K n). -Hypothesis ind_cover : forall n U, U = \bigcup_e @tree_ind n U e . -Hypothesis ind_invar : forall n U e, - tree_invariant U -> tree_invariant (@tree_ind n U e). +Hypothesis ref_cover : forall n U, U = \bigcup_e @refine_apx n U e . +Hypothesis ref_invar : forall n U e, + tree_invariant U -> tree_invariant (@refine_apx n U e). Hypothesis invar_n0 : forall U, tree_invariant U -> U !=set0. Hypothesis invarT : tree_invariant [set: X]. Hypothesis invar_cl : (tree_invariant `<=` closed). -Hypothesis ind_separates: forall (x y : X), - x != y -> - exists n, (forall (U : set X) e, - @tree_ind n U e x -> ~@tree_ind n U e y). +Hypothesis ind_separates: forall (x y : X), x != y -> + exists n, (forall (U : set X) e, + @refine_apx n U e x -> ~@refine_apx n U e y). -Local Lemma ind_sub : forall n U e, @tree_ind n U e `<=` U. +Let refine_subset : forall n U e, @refine_apx n U e `<=` U. Proof. -move=> n U e; rewrite [x in _ `<=` x] (ind_cover n U); exact: bigcup_sup. +by move=> n U e; rewrite [x in _ `<=` x] (ref_cover n U); exact: bigcup_sup. Qed. Let T := product_topologicalType K. -Local Fixpoint branch_apx (b : T) n := - if n is S m - then tree_ind (branch_apx b m) (b m) +Local Fixpoint branch_apx (b : T) n := + if n is S m + then refine_apx (branch_apx b m) (b m) else [set: X]. -Local Definition tree_mapF (b : T) := +Let tree_mapF (b : T) := filter_from [set: nat] (branch_apx b). -Local Lemma tree_map_invar b n : tree_invariant (branch_apx b n). -Proof. elim: n => // n ? /=; exact: ind_invar. Qed. +Let tree_map_invar b n : tree_invariant (branch_apx b n). +Proof. by elim: n => // n ?; exact: ref_invar. Qed. -Local Lemma tree_map_sub b i j : (i <= j)%N -> branch_apx b j `<=` branch_apx b i. -elim: j i => //=; first by move=> ?; rewrite leqn0 => /eqP ->. +Let tree_map_sub b i j : (i <= j)%N -> branch_apx b j `<=` branch_apx b i. +elim: j i; first by move=> ?; rewrite leqn0 => /eqP ->. move=> j IH i; rewrite leq_eqVlt => /orP; case; first by move=> /eqP ->. -by move/IH/(subset_trans _); apply; exact: ind_sub. +by move/IH/(subset_trans _); apply; exact: refine_subset. Qed. -Local Lemma tree_map_filter b : ProperFilter (tree_mapF b). +Let tree_map_filter b : ProperFilter (tree_mapF b). Proof. -split. - by case => n _ brn; case: (invar_n0 (tree_map_invar b n)) => x /brn. +split; first by case => n _ P; case: (invar_n0 (tree_map_invar b n)) => x /P. apply: filter_from_filter; first by exists O. move=> i j _ _; exists (maxn i j) => //; rewrite subsetI. by split; apply: tree_map_sub; [exact: leq_maxl | exact: leq_maxr]. @@ -152,106 +124,99 @@ Qed. Let tree_map (b : T) := lim (tree_mapF b). -Local Lemma cvg_tree_map b : cvg (tree_mapF b). +Let cvg_tree_map b : cvg (tree_mapF b). Proof. have [|x [_ clx]] := cmptX (tree_map_filter b). apply: filterT; exact: tree_map_filter. apply/cvg_ex; exists x => /=; apply: (compact_cluster_set1 _ cmptX) => //. exact: filterT. - exact: tree_map_filter. by apply: filterT; exact: tree_map_filter. -rewrite eqEsubset; split; last by move=> ? ->. +rewrite eqEsubset; split; last by move=> ? ->. move=> y cly; case: (eqVneq x y); first by move=> ->. case/ind_separates => n sep; have bry : branch_apx b n.+1 y. - rewrite [branch_apx _ _](iffLR (closure_id _)). + rewrite [branch_apx _ _](iffLR (closure_id _)). by move: cly; rewrite clusterE; apply; exists n.+1. - apply: invar_cl; apply: tree_map_invar. + by apply: invar_cl; exact: tree_map_invar. suff /sep : branch_apx b n.+1 x by done. -rewrite [branch_apx _ _](iffLR (closure_id _)). +rewrite [branch_apx _ _](iffLR (closure_id _)). by move: clx; rewrite clusterE; apply; exists n.+1. apply: invar_cl; apply: tree_map_invar. Qed. -Local Lemma tree_map_surj : set_surj [set: T] [set: X] tree_map. +Let tree_map_surj : set_surj [set: T] [set: X] tree_map. Proof. move=> z _; suff : exists g, forall n, branch_apx g n z. case=> g gnz; exists g => //; apply: close_eq => // U [oU Uz] V ngV; exists z. - split => //; have /(_ _ ngV) [n _] : tree_mapF g --> tree_map g by exact:cvg_tree_map. - by apply; exact: gnz. -have zcov' : forall n (U : set X), exists e, U z -> @tree_ind n U e z. + by split => //; have [n _] := @cvg_tree_map g _ ngV; by apply; exact: gnz. +have zcov' : forall n (U : set X), exists e, U z -> @refine_apx n U e z. move=> n U; case: (pselect (U z)); last by move => ?; exists point. - by rewrite {1}(@ind_cover n U); case => e _ ?; exists e. + by rewrite {1}(@ref_cover n U); case => e _ ?; exists e. pose zcov n U := projT1 (cid (zcov' n U)). -pose fix g n : (K n * set X) := - if n is S m - then (zcov m.+1 (g m).2, @tree_ind m.+1 (g m).2 (zcov m.+1 (g m).2)) - else (zcov O [set: X], @tree_ind O [set: X] (zcov O [set: X])). +pose fix g n : (K n * set X) := + if n is S m + then (zcov m.+1 (g m).2, @refine_apx m.+1 (g m).2 (zcov m.+1 (g m).2)) + else (zcov O [set: X], @refine_apx O [set: X] (zcov O [set: X])). pose g' n := (g n).1; have apxg : forall n, branch_apx g' n.+1 = (g n).2. by elim => //= n ->; congr (_ _). exists g'; elim => // n /= IH. -have /(_ IH) := projT2 (cid (zcov' n (branch_apx g' n)));move => {IH}. -by case: n => // n; rewrite apxg /=. +have /(_ IH) := projT2 (cid (zcov' n (branch_apx g' n))). +by case: n {IH} => // n; rewrite apxg. Qed. -Local Lemma tree_prefix (b: T) (n : nat) : +Let tree_prefix (b: T) (n : nat) : \forall c \near b, forall i, (i < n)%N -> b i = c i. Proof. elim: n; first by near=> z => ?; rewrite ltn0. -move=> n IH. -near=> z => i; rewrite leq_eqVlt => /orP []; first last. - move=> iSn; have -> := near IH z => //. -move=> /eqP/(succn_inj) ->; near: z. - exists ((proj n)@^-1` [set (b n)]); split => //. - suff : @open T ((proj n)@^-1` [set (b n)]) by []. - apply: open_comp; last apply: discrete_open => //. - by move=> + _; apply: proj_continuous. +move=> n IH; near=> z => i; rewrite leq_eqVlt => /orP []; first last. + by move=> iSn; have -> := near IH z. +move=> /eqP/(succn_inj) ->; near: z; exists ((proj n)@^-1` [set (b n)]). +split => //; suff : @open T ((proj n)@^-1` [set (b n)]) by []. +by apply: open_comp; [move=> + _; exact: proj_continuous| exact: discrete_open]. Unshelve. all: end_near. Qed. -Local Lemma apx_prefix (b c : T) (n : nat) : - (forall i, (i < n)%N -> b i = c i) -> - branch_apx b n = branch_apx c n. +Let apx_prefix (b c : T) (n : nat) : + (forall i, (i < n)%N -> b i = c i) -> branch_apx b n = branch_apx c n. Proof. -elim: n => //= n IH inS; rewrite IH; first by congr (tree_ind _); exact: inS. +elim: n => //= n IH inS; rewrite IH; first by congr (refine_apx _); exact: inS. by move=> ? ?; apply: inS; apply: ltnW. Qed. -Local Lemma tree_map_apx b n: branch_apx b n (tree_map b). +Let tree_map_apx b n: branch_apx b n (tree_map b). Proof. apply: (@closed_cvg _ _ _ (tree_map_filter b) idfun); last exact: cvg_tree_map. by apply: invar_cl; exact: tree_map_invar. -exists n => //. +by exists n. Qed. -Local Lemma tree_map_cts : continuous tree_map. +Let tree_map_cts : continuous tree_map. Proof. -move=> b U /cvg_tree_map /= [n _] /filterS; apply. +move=> b U /cvg_tree_map [n _] /filterS; apply. by apply: fmap_filter; exact: (@nbhs_filter T). -rewrite nbhs_simpl /=; near_simpl => /=. -have := tree_prefix b n; apply: filter_app; near_simpl => /=. -by near=> z => /apx_prefix ->; apply: tree_map_apx. +rewrite nbhs_simpl /=; near_simpl; have := tree_prefix b n; apply: filter_app. +near=> z => /apx_prefix ->; apply: tree_map_apx. Unshelve. all: end_near. Qed. -Local Lemma tree_map_inj: - (forall n U, trivIset [set: K n] (@tree_ind n U)) -> +Let tree_map_inj: + (forall n U, trivIset [set: K n] (@refine_apx n U)) -> set_inj [set: T] tree_map. Proof. move=> triv x y _ _ xyE; apply: functional_extensionality_dep => n. suff : forall n, branch_apx x n = branch_apx y n. move=> brE; have := @triv n (branch_apx x n) (x n) (y n) I I; apply. - exists (tree_map y); split. + exists (tree_map y); split. by rewrite -?xyE -/(branch_apx x n.+1); apply: tree_map_apx. rewrite brE -/(branch_apx y n.+1); apply: tree_map_apx. -elim => // m /= brE. -have -> := @triv m (branch_apx x m) (x m) (y m) I I; first by rewrite brE. -exists (tree_map y); split. +elim => // m /= brE. +have -> := @triv m (branch_apx x m) (x m) (y m) I I; first by rewrite brE. +exists (tree_map y); split. by rewrite -?xyE -/(branch_apx x m.+1); apply: tree_map_apx. -rewrite brE -/(branch_apx y m.+1); apply: tree_map_apx. +by rewrite brE -/(branch_apx y m.+1); apply: tree_map_apx. Qed. Lemma tree_map_props : exists (f : T -> X), [/\ continuous f, set_surj [set: T] [set: X] f & - (forall n U, trivIset [set: K n] (@tree_ind n U)) -> + (forall n U, trivIset [set: K n] (@refine_apx n U)) -> set_inj [set: T] f ]. Proof. @@ -262,26 +227,28 @@ exists tree_map; split. Qed. End topological_trees. -(* + +(* Part 2: We can use `tree_map_props` to build a homeomorphism from the cantor_space to T by constructing. *) + Section TreeStructure. Context {R : realType} {T : pseudoMetricType R}. Hypothesis cantorT : cantor_like T. -Local Lemma dsctT : zero_dimensional T. +Let dsctT : zero_dimensional T. Proof. by case: cantorT. Qed. -Local Lemma pftT : perfect_set [set: T]. +Let pftT : perfect_set [set: T]. Proof. by case: cantorT. Qed. -Local Lemma cmptT : compact [set: T]. +Let cmptT : compact [set: T]. Proof. by case: cantorT. Qed. -Local Lemma hsdfT : @hausdorff_space T. +Let hsdfT : @hausdorff_space T. Proof. by case: cantorT. Qed. Let c_invar (U : set T) := clopen U /\ U !=set0. -Local Lemma clopen_surj : $|{surjfun [set: nat] >-> @clopen T}|. -Proof. +Let clopen_surj : $|{surjfun [set: nat] >-> @clopen T}|. +Proof. suff : (@clopen T = set0 \/ $|{surjfun [set: nat] >-> @clopen T}|). by case; rewrite // eqEsubset; case=>/(_ _ clopenT). by apply/pfcard_geP/clopen_countable/compact_second_countable; case: cantorT. @@ -289,54 +256,53 @@ Qed. Let U_ := unsquash clopen_surj. -Local Lemma split_clopen' (U : set T) : - exists V, open U -> U !=set0 -> clopen V /\ V `&` U !=set0 /\ ~`V `&` U !=set0. +Let split_clopen' (U : set T) : exists V, + open U -> U !=set0 -> clopen V /\ V `&` U !=set0 /\ ~`V `&` U !=set0. Proof. case: (pselect (open U)) => oU; last by exists point. case: (pselect (U !=set0)) => Un0; last by exists point. have [x [y] [Ux] Uy xny] := (iffLR perfect_set2) pftT U oU Un0. -have [V [? ? ?]] := dsctT xny; exists V. +have [V [? ? ?]] := dsctT xny; exists V. by repeat split => //; [exists x | exists y]. Qed. Let split_clopen (U : set T) := projT1 (cid (split_clopen' U)). -Let c_ind (n : nat) (V : set T) (b : bool) := - let Wn := +Let c_ind (n : nat) (V : set T) (b : bool) := + let Wn := if pselect ((U_ n) `&` V !=set0 /\ ~` (U_ n) `&` V !=set0) - then (U_ n) - else split_clopen V in + then (U_ n) + else split_clopen V in (if b then Wn else ~` Wn) `&` V. -Local Lemma cantor_map : exists (f : cantor_space -> T), +Local Lemma cantor_map : exists (f : cantor_space -> T), [/\ continuous f, set_surj [set: cantor_space] [set: T] f & set_inj [set: cantor_space] f ]. Proof. have [] := (@tree_map_props - (fun=> [topologicalType of bool]) - T (c_ind) (c_invar) cmptT hsdfT _ _ _ _ _). + (fun=> [topologicalType of bool]) T c_ind c_invar cmptT hsdfT). - done. - move=> n V; rewrite eqEsubset; split => t; last by case => ? ? []. move=> Vt; case: (pselect ((U_ n) `&` V !=set0 /\ ~` (U_ n) `&` V !=set0)). - move=> ?; case: (pselect (U_ n t)). + move=> ?; case: (pselect (U_ n t)). by exists true => //; rewrite /c_ind; case pselect. by exists false => //; rewrite /c_ind; case pselect. - move=> ?; case: (pselect (split_clopen V t)). + move=> ?; case: (pselect (split_clopen V t)). by exists true => //; rewrite /c_ind; case pselect. by exists false => //; rewrite /c_ind; case pselect. - move=> n U e [] clU Un0; rewrite /c_ind; case: pselect. case => /= ? ?; case: e => //; split => //; apply: clopenI => //. exact: funS. by apply: clopenC => //; exact: funS. - have [| | ? [? ?]] := projT2 (cid (split_clopen' U)) => //; first by case: clU. - move=> ?; case: e => //=; (split; first apply: clopenI) => //. - exact: clopenC. -- by move=> ? []. -- by split;[ exact: clopenT |exists point]. -- by move=> ? [[]]. -- move=> x y /dsctT [A [clA Ax Any]]. + have [| | ? [? ?]] := projT2 (cid (split_clopen' U)) => //. + by case: clU. + move=> ?; case: e => //=; (split; first apply: clopenI) => //; exact: clopenC. +- by move=> ? []. +- by split;[ exact: clopenT |exists point]. +- by move=> ? [[]]. +- move=> x y /dsctT [A [clA Ax Any]]. have [] := (@surj _ _ _ _ U_ _ clA) => n _ UnA; exists n => V e. case: (pselect (V y)); last by move=> + _; apply: subsetC => ? []. case: (pselect (V x)); last by move=> + _ []. @@ -344,7 +310,7 @@ have [] := (@tree_map_props by move=> _; case: e; case => // ? ?; apply/not_andP; left. by apply: absurd; split; [exists x | exists y]. - move=> f [ctsf surjf injf]; exists f; split => //; apply: injf. - move=> n U i j _ _ [z] [] [] + Uz [+ _]; case: pselect => /=. + move=> n U i j _ _ [z] [] [] + Uz [+ _]; case: pselect => /=. by case => ? ?; case: i; case: j => //. by move=> ?; case: i; case: j => //. Qed. @@ -352,14 +318,14 @@ Qed. Let tree_map := projT1 (cid (cantor_map)). Local Lemma tree_map_bij : bijective tree_map. -Proof. -by rewrite -setTT_bijective; have [? ? ?] := projT2 (cid cantor_map); split. +Proof. +by rewrite -setTT_bijective; have [? ? ?] := projT2 (cid cantor_map); split. Qed. #[local] HB.instance Definition _ := @BijTT.Build _ _ _ tree_map_bij. -Lemma homeomorphism_cantor_like : - exists (f : {splitbij [set: cantor_space] >-> [set: T]}), +Lemma homeomorphism_cantor_like : + exists (f : {splitbij [set: cantor_space] >-> [set: T]}), continuous f /\ (forall A, closed A -> closed (f@`A)). Proof. @@ -383,36 +349,27 @@ Definition pointedDiscrete (P : pointedType) : pseudoMetricType R := erefl) erefl. Definition tree_of (T : nat -> pointedType) : pseudoMetricType R := - @product_pseudoMetricType R _ + @product_pseudoMetricType R _ (fun n => pointedDiscrete (T n)) - countable_nat. + (countableP _). -Lemma cantor_like_finite_prod (T : nat -> topologicalType) : +Lemma cantor_like_finite_prod (T : nat -> topologicalType) : (forall n, finite_set [set: pointedDiscrete (T n)]) -> (forall n, (exists xy : T n * T n, xy.1 != xy.2)) -> cantor_like (tree_of T). Proof. move=> finiteT twoElems; split. - by apply perfect_diagonal => n; apply: twoElems. -- have /= := tychonoff (fun n => finite_compact (finiteT n)). +- have := tychonoff (fun n => finite_compact (finiteT n)). by congr (compact _) => //=; rewrite eqEsubset; split => b. - apply (@hausdorff_product _ (fun n => pointedDiscrete (T n))). by move=> n; exact: discrete_hausdorff. -- apply zero_dimension_prod => ?. - exact: discrete_zero_dimension. +- by apply zero_dimension_prod => ?; exact: discrete_zero_dimension. Qed. End FinitelyBranchingTrees. Local Notation "A ^-1" := ([set xy | A (xy.2, xy.1)]) : classical_set_scope. -Lemma ent_closure {X : uniformType} (x z : X) E : entourage E -> - closure [set y | split_ent E (x, y)] z -> E (x, z). -Proof. -pose E' := ((split_ent E) `&` ((split_ent E)^-1)%classic). -move=> entE /(_ [set y | E' (z, y)]) []. - by rewrite -nbhs_entourageE; exists E' => //; apply: filterI. -by move=> y [/=] + [_]; apply: entourage_split. -Qed. (* Part 4: Building a finitely branching tree to cover `T` *) Section alexandroff_hausdorff. @@ -425,11 +382,11 @@ Section two_pointed. Context (t0 t1 : T). Hypothesis T2e : (t0 != t1). -Let ent_balls' (E : set (T*T)) : - exists (M : set (set T)), - entourage E -> [/\ +Let ent_balls' (E : set (T*T)) : + exists (M : set (set T)), + entourage E -> [/\ finite_set M, - (forall A, M A -> exists a, A a /\ + (forall A, M A -> exists a, A a /\ A `<=` closure [set y | split_ent E (a,y)]), (exists (A B : set T), M A /\ M B /\ A != B), \bigcup_(A in M) A = [set: T] & @@ -440,21 +397,21 @@ move=> entE; move: cptT; rewrite compact_cover. pose fs x := interior [set y | split_ent E (x, y)]. case/(_ T ([set: T]) fs). - by move=> i _; apply: open_interior. -- move=> t _; exists t => //. +- move=> t _; exists t => //. - by rewrite /fs /interior -nbhs_entourageE; exists (split_ent E). move=> M' _ Mcov; exists ( ((fun x => closure (fs x)) @` [set` M']) `|` [set [set t0];[set t1]]) => _. split. - rewrite finite_setU; split; first by apply: finite_image; exact: finite_fset. exact: finite_set2. -- move=> A []. - case=> z M'z <-; exists z; split. - apply: subset_closure; apply: nbhs_singleton; apply: nbhs_interior. - by rewrite -nbhs_entourageE; exists (split_ent E). - by apply:closure_subset; exact:interior_subset. +- move=> A []. + case=> z M'z <-; exists z; split. + apply: subset_closure; apply: nbhs_singleton; apply: nbhs_interior. + by rewrite -nbhs_entourageE; exists (split_ent E). + by apply:closure_subset; exact:interior_subset. by case => ->; [exists t0 | exists t1]; split => // t ->; apply: subset_closure; apply:entourage_refl. -- exists [set t0], [set t1]; split;[|split]. +- exists [set t0], [set t1]; split;[|split]. + by right; left. + by right; right. + apply/eqP; rewrite eqEsubset; case=> /(_ t0) => /= /(_ erefl). @@ -463,23 +420,23 @@ split. left; by exists t' => //. by apply: subset_closure. - move=> ? []; first by case=> ? ? <-; exact: closed_closure. - by case => ->; apply: accessible_closed_set1; apply: hausdorff_accessible. + by case => ->; apply: accessible_closed_set1; apply: hausdorff_accessible. Qed. Let ent_balls E := projT1 (cid (ent_balls' E)). -Let count_unif' := (cid2 +Let count_unif' := (cid2 ((iffLR countable_uniformityP) (@countable_uniformity_metric _ T))). Let count_unif := projT1 count_unif'. -Local Lemma ent_count_unif n : entourage (count_unif n). +Let ent_count_unif n : entourage (count_unif n). Proof. have := projT2 (cid (ent_balls' (count_unif n))). rewrite /count_unif; case: count_unif'. by move=> /= f fnA fnE; case /(_ (fnE _)) => _ _ _ + _; rewrite -subTset. Qed. -Local Lemma count_unif_sub E : entourage E -> exists N, count_unif N `<=` E. +Let count_unif_sub E : entourage E -> exists N, count_unif N `<=` E. Proof. by move=> entE; rewrite /count_unif; case: count_unif' => f + ? /=; exact. Qed. @@ -488,7 +445,7 @@ Hint Resolve ent_count_unif : core. Let K' (n : nat) : Type := @sigT (set T) (ent_balls (count_unif n)). -Local Lemma K'p n : K' n. +Let K'p n : K' n. Proof. apply: cid; have [//| _ _ _ + _] := projT2 (cid (ent_balls' (count_unif n))). by rewrite -subTset => /(_ point I) [W Q ?]; exists W; apply Q. @@ -505,17 +462,17 @@ Let emb_ind n (U : set T) (k : K n) := else set0) `&` U. Let emb_invar (U : set T) := closed U /\ U!=set0. -Local Lemma Kn_closed n (e : K n) : closed (projT1 e). +Let Kn_closed n (e : K n) : closed (projT1 e). Proof. case: e => //= W; have [//| _ _ _ _] := projT2 (cid (ent_balls' (count_unif n))). exact. Qed. -Local Lemma cantor_surj_pt1 : exists (f : Tree -> T), +Let cantor_surj_pt1 : exists (f : Tree -> T), continuous f /\ set_surj [set: Tree] [set: T] f. Proof. pose entn n := projT2 (cid (ent_balls' (count_unif n))). -have [] := (@tree_map_props (fun (n : nat) => @pointedDiscrete R (K n)) +have [] := (@tree_map_props (fun (n : nat) => @pointedDiscrete R (K n)) T (emb_ind) (emb_invar) cptT hsdfT). - done. - move=> n U; rewrite eqEsubset; split; last by move => t [? ? []]. @@ -523,7 +480,7 @@ have [] := (@tree_map_props (fun (n : nat) => @pointedDiscrete R (K n)) case/(_ t I) => W cbW Wt; exists (existT _ W cbW) => //. by rewrite /emb_ind; case: pselect => //=; apply: absurd; exists t. - move=> n U e [clU Un0]; split. - apply: closedI => //; case: pselect => //= ?; first exact: Kn_closed. + apply: closedI => //; case: pselect => //= ?. case: pselect; last by move=> ?; exact: closed0. move=> ?; exact: Kn_closed. rewrite /emb_ind; case: pselect => //= ?; case: pselect. @@ -531,13 +488,13 @@ have [] := (@tree_map_props (fun (n : nat) => @pointedDiscrete R (K n)) case: Un0 => z Uz; apply: absurd. have [//|_ _ _ + _] := entn n; rewrite -subTset; case/(_ z I)=> i bi iz. by exists (existT _ _ bi); exists z. -- by move => ? []. +- by move => ? []. - by split; [exact: closedT | exists point]. - by move => ? []. - move=> x y xny; move: hsdfT; rewrite open_hausdorff. case/(_ _ _ xny); case => U V /= [/set_mem Ux /set_mem Vy] [oU oV UVI0]. move: oU; rewrite openE => /(_ _ Ux); rewrite /interior -nbhs_entourageE. - case => E entE ExU. + case => E entE ExU. have [//| n ctE] := @count_unif_sub ((split_ent E) `&` ((split_ent E)^-1%classic)). exact: filterI. exists n => B [C ebC]; have [//|_ Csub _ _ _] := entn n => embx emby. @@ -548,25 +505,25 @@ have [] := (@tree_map_props (fun (n : nat) => @pointedDiscrete R (K n)) by move=> e _ [? ?] [? ?]; exists (projT1 (cid e)). suff : E (x, y). by move/ExU; move/eqP/disjoints_subset:UVI0 => /[apply]. - have [z [Dz DzE]] := Csub _ cbD. + have [z [Dz DzE]] := Csub _ cbD. have /ent_closure:= DzE _ Dx => /(_ (ent_count_unif n))/ctE [_ /= ?]. have /ent_closure:= DzE _ Dy => /(_ (ent_count_unif n))/ctE [? _]. exact: (@entourage_split [uniformType of T] z). by move=> f [ctsf surjf _]; exists f. Qed. -Local Lemma cantor_surj_pt2 : +Let cantor_surj_pt2 : exists (f : {surj [set: cantor_space] >-> [set: Tree]}), continuous f. Proof. have [] := @homeomorphism_cantor_like R Tree; first last. by move=> f [ctsf _]; exists f. apply: (@cantor_like_finite_prod _ (fun n => @pointedDiscrete R (K n))). move=> n /=; have [// | fs _ _ _ _] := projT2 (cid (ent_balls' (count_unif n))). - suff -> : [set: {classic K' n}] = + suff -> : [set: {classic K' n}] = (@projT1 (set T) _) @^-1` (projT1 (cid (ent_balls' (count_unif n)))). by apply: finite_preimage => //; move=> ? ? _ _; apply: eq_sigT_hprop. by rewrite eqEsubset; split => //; case=> /= W p. -move=> n; have [// | _ _ [A [B [pA [pB AB]]]] _ _] := +move=> n; have [// | _ _ [A [B [pA [pB AB]]]] _ _] := projT2 (cid (ent_balls' (count_unif n))). simpl; exists ((existT _ _ pA), (existT _ _ pB)). by move: AB; apply: contra_neq; apply: EqdepFacts.eq_sigT_fst. @@ -581,7 +538,8 @@ by move=> z; apply continuous_comp; [apply: ctsf|rewrite -gsjg; apply: ctsg]. Qed. End two_pointed. -Lemma cantor_surj : +(* The Alexandroff-Hausdorff theorem*) +Theorem cantor_surj : exists (f : {surj [set: cantor_space] >-> [set: T]}), continuous f. Proof. case: (pselect (exists (p : T), p != point)). diff --git a/theories/topology.v b/theories/topology.v index c49f2dc99..f99f633b0 100644 --- a/theories/topology.v +++ b/theories/topology.v @@ -3943,6 +3943,20 @@ rewrite /g ltnn /derange eq_sym; case: (eqVneq (f N) (distincts N).1) => //. by move=> ->; have := projT2 (sigW (npts N)). Qed. +Lemma perfect_set2 {T} : perfect_set [set: T] <-> + forall (U : set T), open U -> U !=set0 -> + exists x y, [/\ U x, U y & x != y] . +Proof. +apply: iff_trans; first exact: perfectTP; split. + move=> nx1 U oU [] x Ux; exists x. + have : U <> [set x] by move=> Ux1; apply: (nx1 x); rewrite -Ux1. + apply: contra_notP; move/not_existsP/contrapT=> Uyx; rewrite eqEsubset. + (split => //; last by move=> ? ->); move=> y Uy; have /not_and3P := Uyx y. + by case => // /negP; rewrite negbK => /eqP ->. +move=> Unxy x Ox; have [] := Unxy _ Ox; first by exists x. +by move=> y [] ? [->] -> /eqP. +Qed. + End perfect_sets. Section totally_disconnected. @@ -4354,6 +4368,14 @@ Qed. End uniform_closeness. +Lemma ent_closure {X : uniformType} (x : X) E : entourage E -> + closure (to_set (split_ent E) x) `<=` to_set E x. +Proof. +pose E' := ((split_ent E) `&` ((split_ent E)^-1)%classic). +move=> entE z /(_ [set y | E' (z, y)]) []. + by rewrite -nbhs_entourageE; exists E' => //; apply: filterI. +by move=> y [/=] + [_]; apply: entourage_split. +Qed. Definition unif_continuous (U V : uniformType) (f : U -> V) := (fun xy => (f xy.1, f xy.2)) @ entourage --> entourage. From bf82a272cf164a0e0c96116bda9184b9addb7a36 Mon Sep 17 00:00:00 2001 From: zstone Date: Tue, 20 Jun 2023 17:31:20 -0400 Subject: [PATCH 15/23] linting alexandroff hausdorff --- theories/cantor.v | 185 ++++++++++++++++++++++------------------------ 1 file changed, 90 insertions(+), 95 deletions(-) diff --git a/theories/cantor.v b/theories/cantor.v index 80b1c90d2..d65c4019f 100644 --- a/theories/cantor.v +++ b/theories/cantor.v @@ -1,5 +1,5 @@ (* mathcomp analysis (c) 2017 Inria and AIST. License: CeCILL-C. *) -From mathcomp Require Import all_ssreflect ssralg ssrint ssrnum matrix . +From mathcomp Require Import all_ssreflect ssralg ssrint ssrnum. From mathcomp Require Import interval rat fintype finmap. Require Import mathcomp_extra boolp classical_sets signed functions cardinality. Require Import reals topology. @@ -18,8 +18,8 @@ Definition cantor_space := Definition cantor_like (T : topologicalType) := [/\ perfect_set [set: T], compact [set: T], - hausdorff_space T - & zero_dimensional T]. + hausdorff_space T & + zero_dimensional T]. Canonical cantor_psuedoMetric {R} := @product_pseudoMetricType R _ (fun (_ : nat) => @@ -40,10 +40,10 @@ Proof. by apply: zero_dimension_prod => _; exact: discrete_zero_dimension. Qed. Lemma cantor_perfect : perfect_set [set: cantor_space]. Proof. by apply: perfect_diagonal => _; exists (true, false). Qed. -Lemma cantor_like_cantor_space: cantor_like (cantor_space). +Lemma cantor_like_cantor_space: cantor_like cantor_space. Proof. split. -- by apply: perfect_diagonal => //= _; exists (true, false). +- exact: cantor_perfect. - exact: cantor_space_compact. - exact: cantor_space_hausdorff. - exact: cantor_zero_dimensional. @@ -51,24 +51,25 @@ Qed. (* The overall goal of the next few sections is to prove that Every compact metric space `T` is the image of the cantor space. - The overall proof will build a function + The overall proof will build two continuous functions cantor space -> a bespoke tree for `T` -> `T` - The proof is in 4 parts + The proof is in 4 parts. Part 1: Some generic machinery about continuous functions from trees. - Part 2: All cantor-like spaces are homeomorphic to the cantor space - Part 3: Finitely branching trees are cantor-like + Part 2: All cantor-like spaces are homeomorphic to the cantor space. + (an application of part 1) + Part 3: Finitely branching trees are cantor-like. Part 4: Every compact metric space has a finitely branching tree with - a continuous surjection. + a continuous surjection. (a second application of part 1) Part 1: A tree here has countable levels, and nodes of type `K n` on the nth level. Each level is in the 'discrete' topology, so the nodes are independent. The goal is to build a map from branches to X. - 1. Each level of the tree corresponds to an approximation of `X` - 2. Each level refines the previous approximation - 3. Then each branch has a corresponding cauchy filter - 4. The overall function from branches to X is a continuous surjection + 1. Each level of the tree corresponds to an approximation of `X`. + 2. Each level refines the previous approximation. + 3. Then each branch has a corresponding cauchy filter. + 4. The overall function from branches to X is a continuous surjection. 5. With an extra disjointness condition, this is also an injection *) Section topological_trees. @@ -79,42 +80,39 @@ Context (tree_invariant : (set X -> Prop)). Hypothesis cmptX : compact [set: X]. Hypothesis hsdfX : hausdorff_space X. Hypothesis discreteK : forall n, discrete_space (K n). -Hypothesis ref_cover : forall n U, U = \bigcup_e @refine_apx n U e . -Hypothesis ref_invar : forall n U e, +Hypothesis refine_cover : forall n U, U = \bigcup_e @refine_apx n U e. +Hypothesis refine_invar : forall n U e, tree_invariant U -> tree_invariant (@refine_apx n U e). Hypothesis invar_n0 : forall U, tree_invariant U -> U !=set0. Hypothesis invarT : tree_invariant [set: X]. Hypothesis invar_cl : (tree_invariant `<=` closed). -Hypothesis ind_separates: forall (x y : X), x != y -> +Hypothesis refine_separates: forall (x y : X), x != y -> exists n, (forall (U : set X) e, @refine_apx n U e x -> ~@refine_apx n U e y). -Let refine_subset : forall n U e, @refine_apx n U e `<=` U. +Local Lemma refine_subset : forall n U e, @refine_apx n U e `<=` U. Proof. -by move=> n U e; rewrite [x in _ `<=` x] (ref_cover n U); exact: bigcup_sup. +by move=> n U e; rewrite [x in _ `<=` x] (refine_cover n); exact: bigcup_sup. Qed. Let T := product_topologicalType K. Local Fixpoint branch_apx (b : T) n := - if n is S m - then refine_apx (branch_apx b m) (b m) - else [set: X]. + if n is S m then refine_apx (branch_apx b m) (b m) else [set: X]. -Let tree_mapF (b : T) := - filter_from [set: nat] (branch_apx b). +Let tree_mapF (b : T) := filter_from [set: nat] (branch_apx b). -Let tree_map_invar b n : tree_invariant (branch_apx b n). -Proof. by elim: n => // n ?; exact: ref_invar. Qed. +Local Lemma tree_map_invar b n : tree_invariant (branch_apx b n). +Proof. by elim: n => // n ?; exact: refine_invar. Qed. -Let tree_map_sub b i j : (i <= j)%N -> branch_apx b j `<=` branch_apx b i. +Local Lemma tree_map_sub b i j : (i <= j)%N -> branch_apx b j `<=` branch_apx b i. elim: j i; first by move=> ?; rewrite leqn0 => /eqP ->. move=> j IH i; rewrite leq_eqVlt => /orP; case; first by move=> /eqP ->. by move/IH/(subset_trans _); apply; exact: refine_subset. Qed. -Let tree_map_filter b : ProperFilter (tree_mapF b). +Instance tree_map_filter b : ProperFilter (tree_mapF b). Proof. split; first by case => n _ P; case: (invar_n0 (tree_map_invar b n)) => x /P. apply: filter_from_filter; first by exists O. @@ -124,33 +122,32 @@ Qed. Let tree_map (b : T) := lim (tree_mapF b). -Let cvg_tree_map b : cvg (tree_mapF b). +Local Lemma cvg_tree_map b : cvg (tree_mapF b). Proof. -have [|x [_ clx]] := cmptX (tree_map_filter b). - apply: filterT; exact: tree_map_filter. +have [|x [_ clx]] := cmptX (tree_map_filter b); first exact: filterT. apply/cvg_ex; exists x => /=; apply: (compact_cluster_set1 _ cmptX) => //. - exact: filterT. - by apply: filterT; exact: tree_map_filter. +- exact: filterT. +- exact: filterT. rewrite eqEsubset; split; last by move=> ? ->. move=> y cly; case: (eqVneq x y); first by move=> ->. -case/ind_separates => n sep; have bry : branch_apx b n.+1 y. +case/refine_separates => n sep; have bry : branch_apx b n.+1 y. rewrite [branch_apx _ _](iffLR (closure_id _)). by move: cly; rewrite clusterE; apply; exists n.+1. by apply: invar_cl; exact: tree_map_invar. suff /sep : branch_apx b n.+1 x by done. rewrite [branch_apx _ _](iffLR (closure_id _)). by move: clx; rewrite clusterE; apply; exists n.+1. -apply: invar_cl; apply: tree_map_invar. +by apply: invar_cl; exact: tree_map_invar. Qed. -Let tree_map_surj : set_surj [set: T] [set: X] tree_map. +Local Lemma tree_map_surj : set_surj [set: T] [set: X] tree_map. Proof. move=> z _; suff : exists g, forall n, branch_apx g n z. case=> g gnz; exists g => //; apply: close_eq => // U [oU Uz] V ngV; exists z. by split => //; have [n _] := @cvg_tree_map g _ ngV; by apply; exact: gnz. have zcov' : forall n (U : set X), exists e, U z -> @refine_apx n U e z. move=> n U; case: (pselect (U z)); last by move => ?; exists point. - by rewrite {1}(@ref_cover n U); case => e _ ?; exists e. + by rewrite {1}(@refine_cover n U); case => e _ ?; exists e. pose zcov n U := projT1 (cid (zcov' n U)). pose fix g n : (K n * set X) := if n is S m @@ -163,41 +160,40 @@ have /(_ IH) := projT2 (cid (zcov' n (branch_apx g' n))). by case: n {IH} => // n; rewrite apxg. Qed. -Let tree_prefix (b: T) (n : nat) : +Local Lemma tree_prefix (b: T) (n : nat) : \forall c \near b, forall i, (i < n)%N -> b i = c i. Proof. elim: n; first by near=> z => ?; rewrite ltn0. move=> n IH; near=> z => i; rewrite leq_eqVlt => /orP []; first last. by move=> iSn; have -> := near IH z. -move=> /eqP/(succn_inj) ->; near: z; exists ((proj n)@^-1` [set (b n)]). -split => //; suff : @open T ((proj n)@^-1` [set (b n)]) by []. +move=> /eqP/succn_inj ->; near: z; exists (proj n@^-1` [set b n]). +split => //; suff : @open T (proj n@^-1` [set b n]) by []. by apply: open_comp; [move=> + _; exact: proj_continuous| exact: discrete_open]. Unshelve. all: end_near. Qed. -Let apx_prefix (b c : T) (n : nat) : +Local Lemma apx_prefix (b c : T) (n : nat) : (forall i, (i < n)%N -> b i = c i) -> branch_apx b n = branch_apx c n. Proof. elim: n => //= n IH inS; rewrite IH; first by congr (refine_apx _); exact: inS. -by move=> ? ?; apply: inS; apply: ltnW. +by move=> ? ?; apply: inS; exact: ltnW. Qed. -Let tree_map_apx b n: branch_apx b n (tree_map b). +Local Lemma tree_map_apx b n: branch_apx b n (tree_map b). Proof. -apply: (@closed_cvg _ _ _ (tree_map_filter b) idfun); last exact: cvg_tree_map. +apply: (@closed_cvg _ _ _ (tree_map_filter b)); last exact: cvg_tree_map. by apply: invar_cl; exact: tree_map_invar. by exists n. Qed. -Let tree_map_cts : continuous tree_map. +Local Lemma tree_map_cts : continuous tree_map. Proof. move=> b U /cvg_tree_map [n _] /filterS; apply. - by apply: fmap_filter; exact: (@nbhs_filter T). -rewrite nbhs_simpl /=; near_simpl; have := tree_prefix b n; apply: filter_app. -near=> z => /apx_prefix ->; apply: tree_map_apx. + by apply: fmap_filter; exact: nbhs_filter. +rewrite nbhs_simpl /=; near_simpl; have := tree_prefix b n; apply: filter_app. +by near=> z => /apx_prefix ->; apply: tree_map_apx. Unshelve. all: end_near. Qed. -Let tree_map_inj: - (forall n U, trivIset [set: K n] (@refine_apx n U)) -> +Let tree_map_inj: (forall n U, trivIset [set: K n] (@refine_apx n U)) -> set_inj [set: T] tree_map. Proof. move=> triv x y _ _ xyE; apply: functional_extensionality_dep => n. @@ -205,7 +201,7 @@ suff : forall n, branch_apx x n = branch_apx y n. move=> brE; have := @triv n (branch_apx x n) (x n) (y n) I I; apply. exists (tree_map y); split. by rewrite -?xyE -/(branch_apx x n.+1); apply: tree_map_apx. - rewrite brE -/(branch_apx y n.+1); apply: tree_map_apx. + by rewrite brE -/(branch_apx y n.+1); apply: tree_map_apx. elim => // m /= brE. have -> := @triv m (branch_apx x m) (x m) (y m) I I; first by rewrite brE. exists (tree_map y); split. @@ -230,7 +226,7 @@ End topological_trees. (* Part 2: We can use `tree_map_props` to build a homeomorphism from the - cantor_space to T by constructing. + cantor_space to a cantor-like space T. *) Section TreeStructure. @@ -271,8 +267,7 @@ Let split_clopen (U : set T) := projT1 (cid (split_clopen' U)). Let c_ind (n : nat) (V : set T) (b : bool) := let Wn := if pselect ((U_ n) `&` V !=set0 /\ ~` (U_ n) `&` V !=set0) - then (U_ n) - else split_clopen V in + then (U_ n) else split_clopen V in (if b then Wn else ~` Wn) `&` V. Local Lemma cantor_map : exists (f : cantor_space -> T), @@ -359,7 +354,8 @@ Lemma cantor_like_finite_prod (T : nat -> topologicalType) : cantor_like (tree_of T). Proof. move=> finiteT twoElems; split. -- by apply perfect_diagonal => n; apply: twoElems. +- apply: (@perfect_diagonal (fun n => pointedDiscrete (T n))). + exact: twoElems. - have := tychonoff (fun n => finite_compact (finiteT n)). by congr (compact _) => //=; rewrite eqEsubset; split => b. - apply (@hausdorff_product _ (fun n => pointedDiscrete (T n))). @@ -380,44 +376,43 @@ Hypothesis hsdfT : hausdorff_space T. Section two_pointed. Context (t0 t1 : T). -Hypothesis T2e : (t0 != t1). +Hypothesis T2e : t0 != t1. -Let ent_balls' (E : set (T*T)) : +Local Lemma ent_balls' (E : set (T*T)) : exists (M : set (set T)), entourage E -> [/\ finite_set M, - (forall A, M A -> exists a, A a /\ - A `<=` closure [set y | split_ent E (a,y)]), - (exists (A B : set T), M A /\ M B /\ A != B), + forall A, M A -> exists a, A a /\ + A `<=` closure [set y | split_ent E (a,y)], + exists (A B : set T), M A /\ M B /\ A != B, \bigcup_(A in M) A = [set: T] & M `<=` closed]. Proof. case: (pselect (entourage E)); last by move=> ?; exists point. move=> entE; move: cptT; rewrite compact_cover. pose fs x := interior [set y | split_ent E (x, y)]. -case/(_ T ([set: T]) fs). +case/(_ T [set: T] fs). - by move=> i _; apply: open_interior. - move=> t _; exists t => //. -- by rewrite /fs /interior -nbhs_entourageE; exists (split_ent E). -move=> M' _ Mcov; exists ( - ((fun x => closure (fs x)) @` [set` M']) `|` [set [set t0];[set t1]]) => _. -split. -- rewrite finite_setU; split; first by apply: finite_image; exact: finite_fset. + by rewrite /fs /interior -nbhs_entourageE; exists (split_ent E). +move=> M' _ Mcov; exists + ((fun x => closure (fs x)) @` [set` M'] `|` [set [set t0];[set t1]]). +move=> _; split. +- rewrite finite_setU; split; first by exact/finite_image/finite_fset. exact: finite_set2. -- move=> A []. - case=> z M'z <-; exists z; split. - apply: subset_closure; apply: nbhs_singleton; apply: nbhs_interior. - by rewrite -nbhs_entourageE; exists (split_ent E). - by apply:closure_subset; exact:interior_subset. - by case => ->; [exists t0 | exists t1]; split => // t ->; - apply: subset_closure; apply:entourage_refl. +- move=> A []; first (case=> z M'z <-; exists z; split). + + apply: subset_closure; apply: nbhs_singleton; apply: nbhs_interior. + by rewrite -nbhs_entourageE; exists (split_ent E). + + by apply:closure_subset; exact:interior_subset. + + by case => ->; [exists t0 | exists t1]; split => // t ->; + apply: subset_closure; exact:entourage_refl. - exists [set t0], [set t1]; split;[|split]. + by right; left. + by right; right. - + apply/eqP; rewrite eqEsubset; case=> /(_ t0) => /= /(_ erefl). + + apply/eqP; rewrite eqEsubset; case=> /(_ t0) => /(_ erefl). by move: T2e => /[swap] ->/eqP. - rewrite -subTset => t /Mcov [t' M't' fsxt]; exists (closure (fs t')). - left; by exists t' => //. + by left; by exists t' => //. by apply: subset_closure. - move=> ? []; first by case=> ? ? <-; exact: closed_closure. by case => ->; apply: accessible_closed_set1; apply: hausdorff_accessible. @@ -427,16 +422,17 @@ Let ent_balls E := projT1 (cid (ent_balls' E)). Let count_unif' := (cid2 ((iffLR countable_uniformityP) (@countable_uniformity_metric _ T))). + Let count_unif := projT1 count_unif'. -Let ent_count_unif n : entourage (count_unif n). +Local Lemma ent_count_unif n : entourage (count_unif n). Proof. have := projT2 (cid (ent_balls' (count_unif n))). rewrite /count_unif; case: count_unif'. by move=> /= f fnA fnE; case /(_ (fnE _)) => _ _ _ + _; rewrite -subTset. Qed. -Let count_unif_sub E : entourage E -> exists N, count_unif N `<=` E. +Local Lemma count_unif_sub E : entourage E -> exists N, count_unif N `<=` E. Proof. by move=> entE; rewrite /count_unif; case: count_unif' => f + ? /=; exact. Qed. @@ -445,7 +441,7 @@ Hint Resolve ent_count_unif : core. Let K' (n : nat) : Type := @sigT (set T) (ent_balls (count_unif n)). -Let K'p n : K' n. +Local Lemma K'p n : K' n. Proof. apply: cid; have [//| _ _ _ + _] := projT2 (cid (ent_balls' (count_unif n))). by rewrite -subTset => /(_ point I) [W Q ?]; exists W; apply Q. @@ -454,36 +450,36 @@ Qed. Let K n := PointedType (classicType_choiceType (K' n)) (K'p n). Let Tree := (@tree_of R K). -Let emb_ind n (U : set T) (k : K n) := +Let embed_refine n (U : set T) (k : K n) := (if (pselect (projT1 k `&` U !=set0)) then projT1 k else if (pselect (exists e : K n , projT1 e `&` U !=set0)) is left e then projT1 (projT1 (cid e)) else set0) `&` U. -Let emb_invar (U : set T) := closed U /\ U!=set0. +Let embed_invar (U : set T) := closed U /\ U!=set0. -Let Kn_closed n (e : K n) : closed (projT1 e). +Local Lemma Kn_closed n (e : K n) : closed (projT1 e). Proof. -case: e => //= W; have [//| _ _ _ _] := projT2 (cid (ent_balls' (count_unif n))). +case: e => W; have [//| _ _ _ _] := projT2 (cid (ent_balls' (count_unif n))). exact. Qed. -Let cantor_surj_pt1 : exists (f : Tree -> T), +Local Lemma cantor_surj_pt1 : exists (f : Tree -> T), continuous f /\ set_surj [set: Tree] [set: T] f. Proof. pose entn n := projT2 (cid (ent_balls' (count_unif n))). have [] := (@tree_map_props (fun (n : nat) => @pointedDiscrete R (K n)) - T (emb_ind) (emb_invar) cptT hsdfT). + T (embed_refine) (embed_invar) cptT hsdfT). - done. - move=> n U; rewrite eqEsubset; split; last by move => t [? ? []]. move=> t Ut; have [//|_ _ _ + _] := entn n; rewrite -subTset. case/(_ t I) => W cbW Wt; exists (existT _ W cbW) => //. - by rewrite /emb_ind; case: pselect => //=; apply: absurd; exists t. + by rewrite /embed_refine; case: pselect => //=; apply: absurd; exists t. - move=> n U e [clU Un0]; split. - apply: closedI => //; case: pselect => //= ?. + apply: closedI => //; case: pselect => //= ?; first exact: Kn_closed. case: pselect; last by move=> ?; exact: closed0. move=> ?; exact: Kn_closed. - rewrite /emb_ind; case: pselect => //= ?; case: pselect. + rewrite /embed_refine; case: pselect => //= ?; case: pselect. by case => i [z [pz bz]]; set P := cid _; have := projT2 P; apply. case: Un0 => z Uz; apply: absurd. have [//|_ _ _ + _] := entn n; rewrite -subTset; case/(_ z I)=> i bi iz. @@ -494,12 +490,12 @@ have [] := (@tree_map_props (fun (n : nat) => @pointedDiscrete R (K n)) - move=> x y xny; move: hsdfT; rewrite open_hausdorff. case/(_ _ _ xny); case => U V /= [/set_mem Ux /set_mem Vy] [oU oV UVI0]. move: oU; rewrite openE => /(_ _ Ux); rewrite /interior -nbhs_entourageE. - case => E entE ExU. - have [//| n ctE] := @count_unif_sub ((split_ent E) `&` ((split_ent E)^-1%classic)). + case => E entE ExU; have [//| n ctE] := + @count_unif_sub ((split_ent E) `&` ((split_ent E)^-1%classic)). exact: filterI. exists n => B [C ebC]; have [//|_ Csub _ _ _] := entn n => embx emby. have [[D cbD] /= [Dx Dy]] : exists (e : K n), projT1 e x /\ projT1 e y. - move: embx emby; rewrite /emb_ind; case: pselect => /=. + move: embx emby; rewrite /embed_refine; case: pselect => /=. by move => ? [? ?] [? ?]; exists (existT _ _ ebC); split. case: pselect ; last by move => ? ? []. by move=> e _ [? ?] [? ?]; exists (projT1 (cid e)). @@ -512,7 +508,7 @@ have [] := (@tree_map_props (fun (n : nat) => @pointedDiscrete R (K n)) by move=> f [ctsf surjf _]; exists f. Qed. -Let cantor_surj_pt2 : +Local Lemma cantor_surj_pt2 : exists (f : {surj [set: cantor_space] >-> [set: Tree]}), continuous f. Proof. have [] := @homeomorphism_cantor_like R Tree; first last. @@ -522,7 +518,7 @@ apply: (@cantor_like_finite_prod _ (fun n => @pointedDiscrete R (K n))). suff -> : [set: {classic K' n}] = (@projT1 (set T) _) @^-1` (projT1 (cid (ent_balls' (count_unif n)))). by apply: finite_preimage => //; move=> ? ? _ _; apply: eq_sigT_hprop. - by rewrite eqEsubset; split => //; case=> /= W p. + by rewrite eqEsubset; split => //; case=> W p. move=> n; have [// | _ _ [A [B [pA [pB AB]]]] _ _] := projT2 (cid (ent_balls' (count_unif n))). simpl; exists ((existT _ _ pA), (existT _ _ pB)). @@ -543,9 +539,8 @@ Theorem cantor_surj : exists (f : {surj [set: cantor_space] >-> [set: T]}), continuous f. Proof. case: (pselect (exists (p : T), p != point)). - case => p ppt; apply: cantor_surj_twop; exact: ppt. -move=> /forallNP xpt. -have : set_surj [set: cantor_space] [set: T] (cst point). + by case => p ppt; apply: cantor_surj_twop; exact: ppt. +move=> /forallNP xpt; have : set_surj [set: cantor_space] [set: T] (cst point). by move=> q _; exists point => //; have /negP := xpt q; rewrite negbK => /eqP. by case/Psurj => f cstf; exists f; rewrite -cstf; apply: cst_continuous. Qed. From 1b7633fdd413ffa91f0df051ae53d89337440daa Mon Sep 17 00:00:00 2001 From: zstone Date: Tue, 20 Jun 2023 17:32:47 -0400 Subject: [PATCH 16/23] fixing changelog --- CHANGELOG_UNRELEASED.md | 120 +++------------------------------------- 1 file changed, 8 insertions(+), 112 deletions(-) diff --git a/CHANGELOG_UNRELEASED.md b/CHANGELOG_UNRELEASED.md index 24991b832..28a4cd415 100644 --- a/CHANGELOG_UNRELEASED.md +++ b/CHANGELOG_UNRELEASED.md @@ -12,76 +12,6 @@ + lemma `globally0` - in `normedtype.v`: + lemma `lipschitz_set0`, `lipschitz_set1` -- in `contructive_ereal.v`: - + lemmas `ereal_blatticeMixin`, `ereal_tblatticeMixin` - + canonicals `ereal_blatticeType`, `ereal_tblatticeType` -- in `lebesgue_measure.v`: - + lemma `emeasurable_itv` -- in `lebesgue_integral.v`: - + lemma `sfinite_Fubini` - -- file `itv.v`: - + definition `wider_itv` - + module `Itv`: - * definitions `map_itv_bound`, `map_itv` - * lemmas `le_map_itv_bound`, `subitv_map_itv` - * definition `itv_cond` - * record `def` - * notation `spec` - * record `typ` - * definitions `mk`, `from`, `fromP` - + notations `{itv R & i}`, `{i01 R}`, `%:itv`, `[itv of _]`, `inum`, `%:inum` - + definitions `itv_eqMixin`, `itv_choiceMixin`, `itv_porderMixin` - + canonical `itv_subType`, `itv_eqType`, `itv_choiceType`, `itv_porderType` - + lemma `itv_top_typ_subproof` - + canonical `itv_top_typ` - + lemma `typ_inum_subproof` - + canonical `typ_inum` - + notation `unify_itv` - + lemma `itv_intro` - + definition `empty_itv` - + lemmas `itv_bottom`, `itv_gt0`, `itv_le0F`, `itv_lt0`, `itv_ge0F`, `itv_ge0`, `lt0F`, `le0`, `gt0F`, `lt1`, - `ge1F`, `le1`, `gt1F` - + lemma `widen_itv_subproof` - + definition `widen_itv` - + lemma `widen_itvE` - + notation `%:i01` - + lemma `zero_inum_subproof` - + canonical `zero_inum` - + lemma `one_inum_subproof` - + canonical `one_inum` - + definition `opp_itv_bound_subdef` - + lemmas `opp_itv_ge0_subproof`, `opp_itv_gt0_subproof`, `opp_itv_boundr_subproof`, - `opp_itv_le0_subproof`, `opp_itv_lt0_subproof`, `opp_itv_boundl_subproof` - + definition `opp_itv_subdef` - + lemma `opp_inum_subproof ` - + canonical `opp_inum` - + definitions `add_itv_boundl_subdef`, `add_itv_boundr_subdef`, `add_itv_subdef` - + lemma `add_inum_subproof` - + canonical `add_inum` - + definitions `itv_bound_signl`, `itv_bound_signr`, `interval_sign` - + variant `interval_sign_spec` - + lemma `interval_signP` - + definitions `mul_itv_boundl_subdef`, `mul_itv_boundr_subdef` - + lemmas `mul_itv_boundl_subproof`, `mul_itv_boundrC_subproof`, `mul_itv_boundr_subproof`, - `mul_itv_boundr'_subproof` - + definition `mul_itv_subdef` - + lemmas `map_itv_bound_min`, `map_itv_bound_max`, `mul_inum_subproof` - + canonical `mul_inum` - + lemmas `inum_eq`, `inum_le`, `inum_lt` -- in `mathcomp_extra.v` - + lemma `ler_sqrt` -- in `constructive_ereal.v` - + definition `sqrte` - + lemmas `sqrte0`, `sqrte_ge0`, `lee_sqrt`, `sqrteM`, `sqr_sqrte`, - `sqrte_sqr`, `sqrte_fin_num` -- in `exp.v`: - + lemma `ln_power_pos` - + definition `powere_pos`, notation ``` _ `^ _ ``` in `ereal_scope` - + lemmas `powere_pos_EFin`, `powere_posyr`, `powere_pose0`, - `powere_pose1`, `powere_posNyr` `powere_pos0r`, `powere_pos1r`, - `powere_posNyr`, `fine_powere_pos`, `powere_pos_ge0`, - `powere_pos_gt0`, `powere_pos_eq0`, `powere_posM`, `powere12_sqrt` - in `measure.v`: + lemma `measurable_fun_bigcup` - in `sequences.v`: @@ -178,51 +108,17 @@ - in `lebesgue_integral.v`: + lemmas `integrableP`, `measurable_int` - + new definitions `split_sym`, `gauge`, `gauge_uniformType_mixin`, - `gauge_topologicalTypeMixin`, `gauge_filtered`, `gauge_topologicalType`, - `gauge_uniformType`, `gauge_psuedoMetric_mixin`, and - `gauge_psuedoMetricType`. - + new lemmas `iter_split_ent`, `gauge_ent`, `gauge_filter`, - `gauge_refl`, `gauge_inv`, `gauge_split`, `gauge_countable_uniformity`, and - `uniform_pseudometric_sup`. - + new definitions `discrete_ent`, `discrete_uniformType`, `discrete_ball`, - `discrete_pseudoMetricType`, and `pseudoMetric_bool`. - + new lemmas `finite_compact`, `discrete_ball_center`, `compact_cauchy_cvg` - in file `cantor.v`, - + new definitions `countable_nat`, `totally_disconnected`, `countable_basis`, - `cantor_like`, `pointedDiscrete`, and `tree_of`. - + new lemmas `bool2E`, `bool_predE`, `cantor_space_compact`, - `cantor_space_hausdorff`, `perfect_set2`, `totally_disconnected_prod`, - `totally_disconnected_discrete`, `cantor_totally_disconnected`, - `cantor_perfect`, `cantor_like_cantor_space`, `totally_disconnected_cvg`, - `clopen_countable`, `compact_countable_base`, `tree_map_props`, - `homeomorphism_cantor_like`, `cantor_like_finite_prod`, `ent_closure`, and - `cantor_surj`. + + new definitions `cantor_space`, `cantor_like`, `pointedDiscrete`, and + `tree_of`. + + new lemmas `cantor_space_compact`, `cantor_space_hausdorff`, + `cantor_zero_dimensional`, `cantor_perfect`, `cantor_like_cantor_space`, + `tree_map_props`, `homeomorphism_cantor_like`, and + `cantor_like_finite_prod`. + + new theorem `cantor_surj`. - in file `topology.v`, - + new definitions `discrete_ent`, `discrete_ent_filter`, - `discrete_uniform_mixin`, `discrete_uniformType`, `discrete_ball`, - `discrete_pseudoMetricType_mixin`, `discrete_pseudoMetricType`, and - `pseudoMetric_bool`. - + new lemmas `finite_compact`, `discrete_ent_refl`, `discrete_ent_inv`, - `discrete_ent_split`, `discrete_ent_nbhs`, `discrete_ball_center`, - `discrete_ball_sym`, `discrete_ball_triangle`, `discrete_entourage`, and - `compact_cauchy_cvg`. - -### Changed - -- in `mathcomp_extra.v` - + lemmas `eq_bigmax`, `eq_bigmin` changed to respect `P` in the returned type. -- in `measure.v`: - + generalize `negligible` to `semiRingOfSetsType` -- in `exp.v`: - + new lemmas `power_pos_ge0`, `power_pos0`, `power_pos_eq0`, - `power_posM`, `power_posAC`, `power12_sqrt`, `power_pos_inv1`, - `power_pos_inv`, `power_pos_intmul` -- in `lebesgue_measure.v`: - + lemmas `measurable_fun_ln`, `measurable_fun_power_pos` -- in `measure.v`: - + definition `almost_everywhere` + + new lemmas `perfect_set2`, and `ent_closure`. ### Changed From f7fb32213ebef889811c0f802c4e7d596ebff03e Mon Sep 17 00:00:00 2001 From: zstone Date: Tue, 20 Jun 2023 18:05:10 -0400 Subject: [PATCH 17/23] adding docs --- theories/cantor.v | 28 +++++++++++++++++++++------- 1 file changed, 21 insertions(+), 7 deletions(-) diff --git a/theories/cantor.v b/theories/cantor.v index d65c4019f..be0284c5c 100644 --- a/theories/cantor.v +++ b/theories/cantor.v @@ -5,6 +5,20 @@ Require Import mathcomp_extra boolp classical_sets signed functions cardinality. Require Import reals topology. From HB Require Import structures. +(******************************************************************************) +(* The Cantor Space and Applications *) +(* *) +(* This file develops the theory of the Cantor space, that is bool^nat with *) +(* the product topology. The two main theorems proved here are *) +(* homeomorphism_cantor_like, and cantor_surj, aka Alexandroff-Hausdorff,. *) +(* *) +(* cantor_space == the cantor space, with its canonical metric *) +(* cantor_like T == perfect + compact + hausdroff + zero dimensional *) +(* pointed_discrete T == equips T with the discrete topology *) +(* tree_of T == builds a topological tree with levels (T n) *) +(* *) +(******************************************************************************) + Set Implicit Arguments. Unset Strict Implicit. Unset Printing Implicit Defensive. @@ -336,7 +350,7 @@ End TreeStructure. (* Part 3: Finitely Branching trees are cantor-like *) Section FinitelyBranchingTrees. Context {R : realType}. -Definition pointedDiscrete (P : pointedType) : pseudoMetricType R := +Definition pointed_discrete (P : pointedType) : pseudoMetricType R := @discrete_pseudoMetricType R (@discrete_uniformType (TopologicalType (FilteredType P P principal_filter) @@ -345,20 +359,20 @@ Definition pointedDiscrete (P : pointedType) : pseudoMetricType R := Definition tree_of (T : nat -> pointedType) : pseudoMetricType R := @product_pseudoMetricType R _ - (fun n => pointedDiscrete (T n)) + (fun n => pointed_discrete (T n)) (countableP _). Lemma cantor_like_finite_prod (T : nat -> topologicalType) : - (forall n, finite_set [set: pointedDiscrete (T n)]) -> + (forall n, finite_set [set: pointed_discrete (T n)]) -> (forall n, (exists xy : T n * T n, xy.1 != xy.2)) -> cantor_like (tree_of T). Proof. move=> finiteT twoElems; split. -- apply: (@perfect_diagonal (fun n => pointedDiscrete (T n))). +- apply: (@perfect_diagonal (fun n => pointed_discrete (T n))). exact: twoElems. - have := tychonoff (fun n => finite_compact (finiteT n)). by congr (compact _) => //=; rewrite eqEsubset; split => b. -- apply (@hausdorff_product _ (fun n => pointedDiscrete (T n))). +- apply (@hausdorff_product _ (fun n => pointed_discrete (T n))). by move=> n; exact: discrete_hausdorff. - by apply zero_dimension_prod => ?; exact: discrete_zero_dimension. Qed. @@ -468,7 +482,7 @@ Local Lemma cantor_surj_pt1 : exists (f : Tree -> T), continuous f /\ set_surj [set: Tree] [set: T] f. Proof. pose entn n := projT2 (cid (ent_balls' (count_unif n))). -have [] := (@tree_map_props (fun (n : nat) => @pointedDiscrete R (K n)) +have [] := (@tree_map_props (fun (n : nat) => @pointed_discrete R (K n)) T (embed_refine) (embed_invar) cptT hsdfT). - done. - move=> n U; rewrite eqEsubset; split; last by move => t [? ? []]. @@ -513,7 +527,7 @@ Local Lemma cantor_surj_pt2 : Proof. have [] := @homeomorphism_cantor_like R Tree; first last. by move=> f [ctsf _]; exists f. -apply: (@cantor_like_finite_prod _ (fun n => @pointedDiscrete R (K n))). +apply: (@cantor_like_finite_prod _ (fun n => @pointed_discrete R (K n))). move=> n /=; have [// | fs _ _ _ _] := projT2 (cid (ent_balls' (count_unif n))). suff -> : [set: {classic K' n}] = (@projT1 (set T) _) @^-1` (projT1 (cid (ent_balls' (count_unif n)))). From 0f8fbe26c17adf18dc971b2dbc64ffb88f3ba025 Mon Sep 17 00:00:00 2001 From: zstone1 Date: Thu, 29 Jun 2023 10:37:54 -0400 Subject: [PATCH 18/23] Update theories/cantor.v Co-authored-by: affeldt-aist <33154536+affeldt-aist@users.noreply.github.com> --- theories/cantor.v | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/theories/cantor.v b/theories/cantor.v index be0284c5c..0378a4bd9 100644 --- a/theories/cantor.v +++ b/theories/cantor.v @@ -35,7 +35,7 @@ Definition cantor_like (T : topologicalType) := hausdorff_space T & zero_dimensional T]. -Canonical cantor_psuedoMetric {R} := +Canonical cantor_pseudoMetric {R} := @product_pseudoMetricType R _ (fun (_ : nat) => @discrete_pseudoMetricType R _ discrete_bool) (countableP _). From 87c029eff4e78c1e99ec760c40155ce7f2b78d06 Mon Sep 17 00:00:00 2001 From: Reynald Affeldt Date: Tue, 14 Nov 2023 21:49:08 +0900 Subject: [PATCH 19/23] nitpicking --- CHANGELOG_UNRELEASED.md | 56 ------ theories/cantor.v | 398 ++++++++++++++++++++-------------------- theories/topology.v | 12 +- 3 files changed, 199 insertions(+), 267 deletions(-) diff --git a/CHANGELOG_UNRELEASED.md b/CHANGELOG_UNRELEASED.md index 28a4cd415..c1665ced7 100644 --- a/CHANGELOG_UNRELEASED.md +++ b/CHANGELOG_UNRELEASED.md @@ -8,14 +8,6 @@ + `kseries` is now an instance of `Kernel_isSFinite_subdef` - in `classical_sets.v`: + lemma `setU_id2r` -- in `topology.v`: - + lemma `globally0` -- in `normedtype.v`: - + lemma `lipschitz_set0`, `lipschitz_set1` -- in `measure.v`: - + lemma `measurable_fun_bigcup` -- in `sequences.v`: - + lemma `eq_eseriesl` - in `lebesgue_measure.v`: + lemma `compact_measurable` @@ -60,54 +52,6 @@ - in `constructive_ereal.v`: + lemma `bigmaxe_fin_num` - + lemmas `lee_sqr`, `lte_sqr`, `lee_sqrE`, `lte_sqrE`, `sqre_ge0`, - `EFin_expe`, `sqreD`, `sqredD` -- in `probability.v` - + definition of `covariance` - + lemmas `expectation_sum`, `covarianceE`, `covarianceC`, - `covariance_fin_num`, `covariance_cst_l`, `covariance_cst_r`, - `covarianceZl`, `covarianceZr`, `covarianceNl`, `covarianceNr`, - `covarianceNN`, `covarianceDl`, `covarianceDr`, `covarianceBl`, - `covarianceBr`, `variance_fin_num`, `varianceZ`, `varianceN`, - `varianceD`, `varianceB`, `varianceD_cst_l`, `varianceD_cst_r`, - `varianceB_cst_l`, `varianceB_cst_r` -- in `functions.v`: - + lemma `sumrfctE` -- in `lebesgue_integral.v`: - + lemma `integrable_sum` -- in `probability.v` - + lemma `cantelli` -- in `classical_sets.v`: - + lemmas `preimage_mem_true`, `preimage_mem_false` -- in `measure.v`: - + definition `measure_dominates`, notation `` `<< `` - + lemma `measure_dominates_trans` -- in `measure.v`: - + defintion `mfrestr` -- in `charge.v`: - + definition `measure_of_charge` - + definition `crestr0` - + definitions `jordan_neg`, `jordan_pos` - + lemmas `jordan_decomp`, `jordan_pos_dominates`, `jordan_neg_dominates` - + lemma `radon_nikodym_finite` - + definition `Radon_Nikodym`, notation `'d nu '/d mu` - + theorems `Radon_Nikodym_integrable`, `Radon_Nikodym_integral` - -- in `measure.v`: - + lemmas `measurable_pair1`, `measurable_pair2` - + lemma `covariance_le` -- in `mathcomp_extra.v` - + definition `coefE` (will be in MC 2.1/1.18) - + lemmas `deg2_poly_canonical`, `deg2_poly_factor`, `deg2_poly_min`, - `deg2_poly_minE`, `deg2_poly_ge0`, `Real.deg2_poly_factor`, - `deg_le2_poly_delta_ge0`, `deg_le2_poly_ge0` - (will be in MC 2.1/1.18) - + lemma `deg_le2_ge0` - + new lemmas `measurable_subring`, and `semiring_sigma_additive`. - + added factory `Content_SubSigmaAdditive_isMeasure` - -- in `lebesgue_integral.v`: - + lemmas `integrableP`, `measurable_int` - in file `cantor.v`, + new definitions `cantor_space`, `cantor_like`, `pointedDiscrete`, and diff --git a/theories/cantor.v b/theories/cantor.v index 0378a4bd9..6aca4ade5 100644 --- a/theories/cantor.v +++ b/theories/cantor.v @@ -10,9 +10,9 @@ From HB Require Import structures. (* *) (* This file develops the theory of the Cantor space, that is bool^nat with *) (* the product topology. The two main theorems proved here are *) -(* homeomorphism_cantor_like, and cantor_surj, aka Alexandroff-Hausdorff,. *) +(* homeomorphism_cantor_like, and cantor_surj, aka Alexandroff-Hausdorff. *) (* *) -(* cantor_space == the cantor space, with its canonical metric *) +(* cantor_space == the Cantor space, with its canonical metric *) (* cantor_like T == perfect + compact + hausdroff + zero dimensional *) (* pointed_discrete T == equips T with the discrete topology *) (* tree_of T == builds a topological tree with levels (T n) *) @@ -22,8 +22,10 @@ From HB Require Import structures. Set Implicit Arguments. Unset Strict Implicit. Unset Printing Implicit Defensive. + Import Order.TTheory GRing.Theory Num.Def Num.Theory. Import numFieldTopology.Exports. + Local Open Scope classical_set_scope. Definition cantor_space := @@ -39,10 +41,10 @@ Canonical cantor_pseudoMetric {R} := @product_pseudoMetricType R _ (fun (_ : nat) => @discrete_pseudoMetricType R _ discrete_bool) (countableP _). -Lemma cantor_space_compact: compact [set: cantor_space]. +Lemma cantor_space_compact : compact [set: cantor_space]. Proof. -have := @tychonoff _ (fun (_: nat) => _) _ (fun=> bool_compact). -by congr (compact _); rewrite eqEsubset; split => b. +have := @tychonoff _ (fun _ : nat => _) _ (fun=> bool_compact). +by congr (compact _); rewrite eqEsubset. Qed. Lemma cantor_space_hausdorff : hausdorff_space cantor_space. @@ -54,7 +56,7 @@ Proof. by apply: zero_dimension_prod => _; exact: discrete_zero_dimension. Qed. Lemma cantor_perfect : perfect_set [set: cantor_space]. Proof. by apply: perfect_diagonal => _; exists (true, false). Qed. -Lemma cantor_like_cantor_space: cantor_like cantor_space. +Lemma cantor_like_cantor_space : cantor_like cantor_space. Proof. split. - exact: cantor_perfect. @@ -64,15 +66,15 @@ split. Qed. (* The overall goal of the next few sections is to prove that - Every compact metric space `T` is the image of the cantor space. + Every compact metric space `T` is the image of the Cantor space. The overall proof will build two continuous functions - cantor space -> a bespoke tree for `T` -> `T` + Cantor space -> a bespoke tree for `T` -> `T` The proof is in 4 parts. Part 1: Some generic machinery about continuous functions from trees. - Part 2: All cantor-like spaces are homeomorphic to the cantor space. + Part 2: All cantor-like spaces are homeomorphic to the Cantor space. (an application of part 1) - Part 3: Finitely branching trees are cantor-like. + Part 3: Finitely branching trees are Cantor-like. Part 4: Every compact metric space has a finitely branching tree with a continuous surjection. (a second application of part 1) @@ -82,14 +84,14 @@ Qed. The goal is to build a map from branches to X. 1. Each level of the tree corresponds to an approximation of `X`. 2. Each level refines the previous approximation. - 3. Then each branch has a corresponding cauchy filter. + 3. Then each branch has a corresponding Cauchy filter. 4. The overall function from branches to X is a continuous surjection. 5. With an extra disjointness condition, this is also an injection *) Section topological_trees. -Context {K : nat -> topologicalType} {X : topologicalType}. -Context (refine_apx : forall n, set X -> K n -> set X). -Context (tree_invariant : (set X -> Prop)). +Context {K : nat -> topologicalType} {X : topologicalType} + (refine_apx : forall n, set X -> K n -> set X) + (tree_invariant : set X -> Prop). Hypothesis cmptX : compact [set: X]. Hypothesis hsdfX : hausdorff_space X. @@ -99,42 +101,41 @@ Hypothesis refine_invar : forall n U e, tree_invariant U -> tree_invariant (@refine_apx n U e). Hypothesis invar_n0 : forall U, tree_invariant U -> U !=set0. Hypothesis invarT : tree_invariant [set: X]. -Hypothesis invar_cl : (tree_invariant `<=` closed). -Hypothesis refine_separates: forall (x y : X), x != y -> - exists n, (forall (U : set X) e, - @refine_apx n U e x -> ~@refine_apx n U e y). +Hypothesis invar_cl : tree_invariant `<=` closed. +Hypothesis refine_separates: forall x y : X, x != y -> + exists n, forall (U : set X) e, + @refine_apx n U e x -> ~@refine_apx n U e y. - -Local Lemma refine_subset : forall n U e, @refine_apx n U e `<=` U. -Proof. -by move=> n U e; rewrite [x in _ `<=` x] (refine_cover n); exact: bigcup_sup. -Qed. +Local Lemma refine_subset n U e : @refine_apx n U e `<=` U. +Proof. by rewrite [X in _ `<=` X](refine_cover n); exact: bigcup_sup. Qed. Let T := product_topologicalType K. Local Fixpoint branch_apx (b : T) n := - if n is S m then refine_apx (branch_apx b m) (b m) else [set: X]. + if n is m.+1 then refine_apx (branch_apx b m) (b m) else [set: X]. Let tree_mapF (b : T) := filter_from [set: nat] (branch_apx b). Local Lemma tree_map_invar b n : tree_invariant (branch_apx b n). Proof. by elim: n => // n ?; exact: refine_invar. Qed. -Local Lemma tree_map_sub b i j : (i <= j)%N -> branch_apx b j `<=` branch_apx b i. -elim: j i; first by move=> ?; rewrite leqn0 => /eqP ->. -move=> j IH i; rewrite leq_eqVlt => /orP; case; first by move=> /eqP ->. -by move/IH/(subset_trans _); apply; exact: refine_subset. +Local Lemma tree_map_sub b i j : + (i <= j)%N -> branch_apx b j `<=` branch_apx b i. +Proof. +elim: j i => [?|j IH i]; first by rewrite leqn0 => /eqP ->. +rewrite leq_eqVlt => /predU1P[->//|/IH]. +by apply: subset_trans; exact: refine_subset. Qed. Instance tree_map_filter b : ProperFilter (tree_mapF b). Proof. split; first by case => n _ P; case: (invar_n0 (tree_map_invar b n)) => x /P. -apply: filter_from_filter; first by exists O. -move=> i j _ _; exists (maxn i j) => //; rewrite subsetI. +apply: filter_from_filter; first by exists 0%N. +move=> i j _ _; exists (maxn i j) => //; rewrite subsetI. by split; apply: tree_map_sub; [exact: leq_maxl | exact: leq_maxr]. Qed. -Let tree_map (b : T) := lim (tree_mapF b). +Let tree_map b := lim (tree_mapF b). Local Lemma cvg_tree_map b : cvg (tree_mapF b). Proof. @@ -142,57 +143,54 @@ have [|x [_ clx]] := cmptX (tree_map_filter b); first exact: filterT. apply/cvg_ex; exists x => /=; apply: (compact_cluster_set1 _ cmptX) => //. - exact: filterT. - exact: filterT. -rewrite eqEsubset; split; last by move=> ? ->. -move=> y cly; case: (eqVneq x y); first by move=> ->. -case/refine_separates => n sep; have bry : branch_apx b n.+1 y. - rewrite [branch_apx _ _](iffLR (closure_id _)). - by move: cly; rewrite clusterE; apply; exists n.+1. - by apply: invar_cl; exact: tree_map_invar. -suff /sep : branch_apx b n.+1 x by done. -rewrite [branch_apx _ _](iffLR (closure_id _)). - by move: clx; rewrite clusterE; apply; exists n.+1. -by apply: invar_cl; exact: tree_map_invar. +rewrite eqEsubset; split=> [y cly|? -> //]. +have [->//|/refine_separates[n sep]] := eqVneq x y. +have bry : branch_apx b n.+1 y. + have /closure_id -> := invar_cl (tree_map_invar b n.+1). + by move: cly; rewrite clusterE; apply; exists n.+1. +suff /sep : branch_apx b n.+1 x by []. +have /closure_id -> := invar_cl (tree_map_invar b n.+1). +by move: clx; rewrite clusterE; apply; exists n.+1. Qed. Local Lemma tree_map_surj : set_surj [set: T] [set: X] tree_map. Proof. move=> z _; suff : exists g, forall n, branch_apx g n z. case=> g gnz; exists g => //; apply: close_eq => // U [oU Uz] V ngV; exists z. - by split => //; have [n _] := @cvg_tree_map g _ ngV; by apply; exact: gnz. + by split => //; have [n _] := @cvg_tree_map g _ ngV; exact. have zcov' : forall n (U : set X), exists e, U z -> @refine_apx n U e z. - move=> n U; case: (pselect (U z)); last by move => ?; exists point. - by rewrite {1}(@refine_cover n U); case => e _ ?; exists e. + move=> n U; have [|?] := pselect (U z); last by exists point. + by rewrite [X in X z -> _](@refine_cover n U); case => e _ ?; exists e. pose zcov n U := projT1 (cid (zcov' n U)). -pose fix g n : (K n * set X) := - if n is S m +pose fix g n : K n * set X := + if n is m.+1 then (zcov m.+1 (g m).2, @refine_apx m.+1 (g m).2 (zcov m.+1 (g m).2)) else (zcov O [set: X], @refine_apx O [set: X] (zcov O [set: X])). -pose g' n := (g n).1; have apxg : forall n, branch_apx g' n.+1 = (g n).2. - by elim => //= n ->; congr (_ _). +pose g' n := (g n).1; have apxg n : branch_apx g' n.+1 = (g n).2. + by elim: n => //= n ->. exists g'; elim => // n /= IH. have /(_ IH) := projT2 (cid (zcov' n (branch_apx g' n))). by case: n {IH} => // n; rewrite apxg. Qed. -Local Lemma tree_prefix (b: T) (n : nat) : +Local Lemma tree_prefix (b : T) (n : nat) : \forall c \near b, forall i, (i < n)%N -> b i = c i. Proof. -elim: n; first by near=> z => ?; rewrite ltn0. -move=> n IH; near=> z => i; rewrite leq_eqVlt => /orP []; first last. - by move=> iSn; have -> := near IH z. -move=> /eqP/succn_inj ->; near: z; exists (proj n@^-1` [set b n]). -split => //; suff : @open T (proj n@^-1` [set b n]) by []. +elim: n => [|n IH]; first by near=> z => ?; rewrite ltn0. +near=> z => i; rewrite leq_eqVlt => /predU1P[|iSn]; last by rewrite (near IH z). +move=> [->]; near: z; exists (proj n @^-1` [set b n]). +split => //; suff : @open T (proj n @^-1` [set b n]) by []. by apply: open_comp; [move=> + _; exact: proj_continuous| exact: discrete_open]. Unshelve. all: end_near. Qed. -Local Lemma apx_prefix (b c : T) (n : nat) : +Local Lemma apx_prefix b c n : (forall i, (i < n)%N -> b i = c i) -> branch_apx b n = branch_apx c n. Proof. -elim: n => //= n IH inS; rewrite IH; first by congr (refine_apx _); exact: inS. -by move=> ? ?; apply: inS; exact: ltnW. +elim: n => //= n IH inS; rewrite IH; first by rewrite inS. +by move=> ? ?; exact/inS/ltnW. Qed. -Local Lemma tree_map_apx b n: branch_apx b n (tree_map b). +Local Lemma tree_map_apx b n : branch_apx b n (tree_map b). Proof. apply: (@closed_cvg _ _ _ (tree_map_filter b)); last exact: cvg_tree_map. by apply: invar_cl; exact: tree_map_invar. @@ -202,33 +200,36 @@ Qed. Local Lemma tree_map_cts : continuous tree_map. Proof. move=> b U /cvg_tree_map [n _] /filterS; apply. - by apply: fmap_filter; exact: nbhs_filter. + exact/fmap_filter/nbhs_filter. rewrite nbhs_simpl /=; near_simpl; have := tree_prefix b n; apply: filter_app. -by near=> z => /apx_prefix ->; apply: tree_map_apx. +by near=> z => /apx_prefix ->; exact: tree_map_apx. Unshelve. all: end_near. Qed. -Let tree_map_inj: (forall n U, trivIset [set: K n] (@refine_apx n U)) -> +Let tree_map_setI x y n : tree_map x = tree_map y -> + refine_apx (branch_apx x n) (x n) `&` refine_apx (branch_apx y n) (y n) !=set0. +Proof. +move=> xyE; exists (tree_map y); split. + by rewrite -xyE -/(branch_apx x n.+1); exact: tree_map_apx. +by rewrite -/(branch_apx y n.+1); exact: tree_map_apx. +Qed. + +Let tree_map_inj : (forall n U, trivIset [set: K n] (@refine_apx n U)) -> set_inj [set: T] tree_map. Proof. move=> triv x y _ _ xyE; apply: functional_extensionality_dep => n. suff : forall n, branch_apx x n = branch_apx y n. - move=> brE; have := @triv n (branch_apx x n) (x n) (y n) I I; apply. - exists (tree_map y); split. - by rewrite -?xyE -/(branch_apx x n.+1); apply: tree_map_apx. - by rewrite brE -/(branch_apx y n.+1); apply: tree_map_apx. + move=> brE; apply: (@triv n (branch_apx x n) _ _ I I). + by rewrite [in X in _ `&` X]brE; exact: tree_map_setI. elim => // m /= brE. -have -> := @triv m (branch_apx x m) (x m) (y m) I I; first by rewrite brE. -exists (tree_map y); split. - by rewrite -?xyE -/(branch_apx x m.+1); apply: tree_map_apx. -by rewrite brE -/(branch_apx y m.+1); apply: tree_map_apx. +rewrite (@triv m (branch_apx x m) (x m) (y m) I I) 1?brE//. +by rewrite -[in X in X `&` _]brE; exact: tree_map_setI. Qed. Lemma tree_map_props : exists (f : T -> X), [/\ continuous f, set_surj [set: T] [set: X] f & (forall n U, trivIset [set: K n] (@refine_apx n U)) -> - set_inj [set: T] f - ]. + set_inj [set: T] f]. Proof. exists tree_map; split. - exact: tree_map_cts. @@ -240,91 +241,87 @@ End topological_trees. (* Part 2: We can use `tree_map_props` to build a homeomorphism from the - cantor_space to a cantor-like space T. + cantor_space to a Cantor-like space T. *) Section TreeStructure. Context {R : realType} {T : pseudoMetricType R}. Hypothesis cantorT : cantor_like T. -Let dsctT : zero_dimensional T. -Proof. by case: cantorT. Qed. -Let pftT : perfect_set [set: T]. -Proof. by case: cantorT. Qed. -Let cmptT : compact [set: T]. -Proof. by case: cantorT. Qed. -Let hsdfT : @hausdorff_space T. -Proof. by case: cantorT. Qed. + +Let dsctT : zero_dimensional T. Proof. by case: cantorT. Qed. +Let pftT : perfect_set [set: T]. Proof. by case: cantorT. Qed. +Let cmptT : compact [set: T]. Proof. by case: cantorT. Qed. +Let hsdfT : @hausdorff_space T. Proof. by case: cantorT. Qed. Let c_invar (U : set T) := clopen U /\ U !=set0. Let clopen_surj : $|{surjfun [set: nat] >-> @clopen T}|. Proof. -suff : (@clopen T = set0 \/ $|{surjfun [set: nat] >-> @clopen T}|). - by case; rewrite // eqEsubset; case=>/(_ _ clopenT). -by apply/pfcard_geP/clopen_countable/compact_second_countable; case: cantorT. +suff : @clopen T = set0 \/ $|{surjfun [set: nat] >-> @clopen T}|. + by case; rewrite // eqEsubset => -[/(_ _ clopenT)]. +exact/pfcard_geP/clopen_countable/compact_second_countable. Qed. Let U_ := unsquash clopen_surj. -Let split_clopen' (U : set T) : exists V, +Let split_clopen' (U : set T) : exists V, open U -> U !=set0 -> clopen V /\ V `&` U !=set0 /\ ~`V `&` U !=set0. Proof. -case: (pselect (open U)) => oU; last by exists point. -case: (pselect (U !=set0)) => Un0; last by exists point. +have [oU|?] := pselect (open U); last by exists point. +have [Un0|?] := pselect (U !=set0); last by exists point. have [x [y] [Ux] Uy xny] := (iffLR perfect_set2) pftT U oU Un0. -have [V [? ? ?]] := dsctT xny; exists V. +have [V [clV Vx Vy]] := dsctT xny; exists V. by repeat split => //; [exists x | exists y]. Qed. Let split_clopen (U : set T) := projT1 (cid (split_clopen' U)). -Let c_ind (n : nat) (V : set T) (b : bool) := +Let c_ind n (V : set T) (b : bool) := let Wn := if pselect ((U_ n) `&` V !=set0 /\ ~` (U_ n) `&` V !=set0) - then (U_ n) else split_clopen V in + then U_ n else split_clopen V in (if b then Wn else ~` Wn) `&` V. -Local Lemma cantor_map : exists (f : cantor_space -> T), +Local Lemma cantor_map : exists f : cantor_space -> T, [/\ continuous f, set_surj [set: cantor_space] [set: T] f & set_inj [set: cantor_space] f ]. Proof. -have [] := (@tree_map_props - (fun=> [topologicalType of bool]) T c_ind c_invar cmptT hsdfT). -- done. -- move=> n V; rewrite eqEsubset; split => t; last by case => ? ? []. - move=> Vt; case: (pselect ((U_ n) `&` V !=set0 /\ ~` (U_ n) `&` V !=set0)). - move=> ?; case: (pselect (U_ n t)). - by exists true => //; rewrite /c_ind; case pselect. - by exists false => //; rewrite /c_ind; case pselect. - move=> ?; case: (pselect (split_clopen V t)). - by exists true => //; rewrite /c_ind; case pselect. - by exists false => //; rewrite /c_ind; case pselect. -- move=> n U e [] clU Un0; rewrite /c_ind; case: pselect. - case => /= ? ?; case: e => //; split => //; apply: clopenI => //. +have [] := @tree_map_props + (fun=> [topologicalType of bool]) T c_ind c_invar cmptT hsdfT. +- by []. +- move=> n V; rewrite eqEsubset; split => [t Vt|t [? ? []]//]. + have [?|?] := pselect (U_ n `&` V !=set0 /\ ~` U_ n `&` V !=set0). + + have [Unt|Unt] := pselect (U_ n t). + * by exists true => //; rewrite /c_ind; case: pselect. + * by exists false => //; rewrite /c_ind; case: pselect. + + have [scVt|scVt] := pselect (split_clopen V t). + * by exists true => //; rewrite /c_ind; case: pselect. + * by exists false => //; rewrite /c_ind; case: pselect. +- move=> n U e [] clU Un0; rewrite /c_ind; case: pselect => /=. + + move=> [UU CUU]; case: e => //; split => //; apply: clopenI => //. exact: funS. by apply: clopenC => //; exact: funS. - have [| | ? [? ?]] := projT2 (cid (split_clopen' U)) => //. - by case: clU. - move=> ?; case: e => //=; (split; first apply: clopenI) => //; exact: clopenC. + + move=> _; have [|//|clscU [scUU CscUU]] := projT2 (cid (split_clopen' U)). + by case: clU. + case: e; split => //; first exact: clopenI. + by apply: clopenI => //; exact: clopenC. - by move=> ? []. -- by split;[ exact: clopenT |exists point]. +- by split; [exact: clopenT | exists point]. - by move=> ? [[]]. - move=> x y /dsctT [A [clA Ax Any]]. - have [] := (@surj _ _ _ _ U_ _ clA) => n _ UnA; exists n => V e. - case: (pselect (V y)); last by move=> + _; apply: subsetC => ? []. - case: (pselect (V x)); last by move=> + _ []. - move=> Vx Vy; rewrite {1 2}/c_ind; case: pselect => /=; rewrite ?UnA. + have [n _ UnA] := @surj _ _ _ _ U_ _ clA; exists n => V e. + have [|+ _] := pselect (V y); last by apply: subsetC => ? []. + have [Vx Vy|? _ []//] := pselect (V x). + rewrite {1 2}/c_ind; case: pselect => /=; rewrite ?UnA. by move=> _; case: e; case => // ? ?; apply/not_andP; left. by apply: absurd; split; [exists x | exists y]. - move=> f [ctsf surjf injf]; exists f; split => //; apply: injf. - move=> n U i j _ _ [z] [] [] + Uz [+ _]; case: pselect => /=. - by case => ? ?; case: i; case: j => //. - by move=> ?; case: i; case: j => //. + by move=> n U i j _ _ [z] [] [] + Uz [+ _]; move: i j => [] []. Qed. -Let tree_map := projT1 (cid (cantor_map)). +Let tree_map := projT1 (cid cantor_map). Local Lemma tree_map_bij : bijective tree_map. Proof. @@ -334,13 +331,14 @@ Qed. #[local] HB.instance Definition _ := @BijTT.Build _ _ _ tree_map_bij. Lemma homeomorphism_cantor_like : - exists (f : {splitbij [set: cantor_space] >-> [set: T]}), + exists (f : {splitbij [set: cantor_space] >-> [set: T]}), continuous f /\ - (forall A, closed A -> closed (f@`A)). + (forall A, closed A -> closed (f @` A)). Proof. -exists tree_map => /=; have [? ? ?] := projT2 (cid cantor_map); split => //. -move=> A clA; apply: compact_closed; first exact: hsdfT. -apply (@continuous_compact _ _ tree_map); first exact: continuous_subspaceT. +exists tree_map => /=. +have [cts surj inje] := projT2 (cid cantor_map); split; first exact: cts. +move=> A clA; apply: (compact_closed hsdfT). +apply: (@continuous_compact _ _ tree_map); first exact: continuous_subspaceT. apply: (@subclosed_compact _ _ [set: cantor_space]) => //. exact: cantor_space_compact. Qed. @@ -368,12 +366,11 @@ Lemma cantor_like_finite_prod (T : nat -> topologicalType) : cantor_like (tree_of T). Proof. move=> finiteT twoElems; split. -- apply: (@perfect_diagonal (fun n => pointed_discrete (T n))). - exact: twoElems. +- exact/(@perfect_diagonal (pointed_discrete \o T))/twoElems. - have := tychonoff (fun n => finite_compact (finiteT n)). - by congr (compact _) => //=; rewrite eqEsubset; split => b. -- apply (@hausdorff_product _ (fun n => pointed_discrete (T n))). - by move=> n; exact: discrete_hausdorff. + by congr (compact _) => //=; rewrite eqEsubset. +- apply: (@hausdorff_product _ (pointed_discrete \o T)) => n. + exact: discrete_hausdorff. - by apply zero_dimension_prod => ?; exact: discrete_zero_dimension. Qed. @@ -383,7 +380,7 @@ Local Notation "A ^-1" := ([set xy | A (xy.2, xy.1)]) : classical_set_scope. (* Part 4: Building a finitely branching tree to cover `T` *) Section alexandroff_hausdorff. -Context {R: realType} {T : pseudoMetricType R}. +Context {R : realType} {T : pseudoMetricType R}. Hypothesis cptT : compact [set: T]. Hypothesis hsdfT : hausdorff_space T. @@ -392,50 +389,50 @@ Section two_pointed. Context (t0 t1 : T). Hypothesis T2e : t0 != t1. -Local Lemma ent_balls' (E : set (T*T)) : - exists (M : set (set T)), +Local Lemma ent_balls' (E : set (T * T)) : + exists M : set (set T), entourage E -> [/\ finite_set M, forall A, M A -> exists a, A a /\ - A `<=` closure [set y | split_ent E (a,y)], - exists (A B : set T), M A /\ M B /\ A != B, + A `<=` closure [set y | split_ent E (a, y)], + exists A B : set T, M A /\ M B /\ A != B, \bigcup_(A in M) A = [set: T] & M `<=` closed]. Proof. -case: (pselect (entourage E)); last by move=> ?; exists point. -move=> entE; move: cptT; rewrite compact_cover. +have [entE|?] := pselect (entourage E); last by exists point. +move: cptT; rewrite compact_cover. pose fs x := interior [set y | split_ent E (x, y)]. -case/(_ T [set: T] fs). -- by move=> i _; apply: open_interior. -- move=> t _; exists t => //. +move=> /(_ T [ set: T] fs)[t _|t _ |]. +- exact: open_interior. +- exists t => //. by rewrite /fs /interior -nbhs_entourageE; exists (split_ent E). -move=> M' _ Mcov; exists - ((fun x => closure (fs x)) @` [set` M'] `|` [set [set t0];[set t1]]). -move=> _; split. -- rewrite finite_setU; split; first by exact/finite_image/finite_fset. +move=> M' _ Mcov; exists + ((closure \o fs) @` [set` M'] `|` [set [set t0]; [set t1]]). +move=> _; split=> [|A [|]| | |]. +- rewrite finite_setU; split; first exact/finite_image/finite_fset. exact: finite_set2. -- move=> A []; first (case=> z M'z <-; exists z; split). +- move=> [z M'z] <-; exists z; split. + apply: subset_closure; apply: nbhs_singleton; apply: nbhs_interior. by rewrite -nbhs_entourageE; exists (split_ent E). - + by apply:closure_subset; exact:interior_subset. - + by case => ->; [exists t0 | exists t1]; split => // t ->; - apply: subset_closure; exact:entourage_refl. + + by apply: closure_subset; exact: interior_subset. +- by case => ->; [exists t0 | exists t1]; split => // t ->; + apply: subset_closure; exact: entourage_refl. - exists [set t0], [set t1]; split;[|split]. + by right; left. + by right; right. - + apply/eqP; rewrite eqEsubset; case=> /(_ t0) => /(_ erefl). - by move: T2e => /[swap] ->/eqP. + + apply/eqP; rewrite eqEsubset => -[] /(_ t0 erefl). + by move: T2e => /[swap] -> /eqP. - rewrite -subTset => t /Mcov [t' M't' fsxt]; exists (closure (fs t')). - by left; by exists t' => //. - by apply: subset_closure. -- move=> ? []; first by case=> ? ? <-; exact: closed_closure. - by case => ->; apply: accessible_closed_set1; apply: hausdorff_accessible. + by left; exists t'. + exact: subset_closure. +- move=> ? [[? ?] <-|]; first exact: closed_closure. + by move=> [|] ->; exact/accessible_closed_set1/hausdorff_accessible. Qed. Let ent_balls E := projT1 (cid (ent_balls' E)). -Let count_unif' := (cid2 - ((iffLR countable_uniformityP) (@countable_uniformity_metric _ T))). +Let count_unif' := cid2 + ((iffLR countable_uniformityP) (@countable_uniformity_metric _ T)). Let count_unif := projT1 count_unif'. @@ -453,24 +450,24 @@ Qed. Hint Resolve ent_count_unif : core. -Let K' (n : nat) : Type := @sigT (set T) (ent_balls (count_unif n)). +Let K' n : Type := @sigT (set T) (ent_balls (count_unif n)). Local Lemma K'p n : K' n. Proof. apply: cid; have [//| _ _ _ + _] := projT2 (cid (ent_balls' (count_unif n))). -by rewrite -subTset => /(_ point I) [W Q ?]; exists W; apply Q. +by rewrite -subTset => /(_ point I) [W Q ?]; exists W; exact: Q. Qed. Let K n := PointedType (classicType_choiceType (K' n)) (K'p n). -Let Tree := (@tree_of R K). +Let Tree := @tree_of R K. Let embed_refine n (U : set T) (k : K n) := - (if (pselect (projT1 k `&` U !=set0)) + (if pselect (projT1 k `&` U !=set0) then projT1 k - else if (pselect (exists e : K n , projT1 e `&` U !=set0)) is left e + else if pselect (exists e : K n , projT1 e `&` U !=set0) is left e then projT1 (projT1 (cid e)) else set0) `&` U. -Let embed_invar (U : set T) := closed U /\ U!=set0. +Let embed_invar (U : set T) := closed U /\ U !=set0. Local Lemma Kn_closed n (e : K n) : closed (projT1 e). Proof. @@ -478,84 +475,83 @@ case: e => W; have [//| _ _ _ _] := projT2 (cid (ent_balls' (count_unif n))). exact. Qed. -Local Lemma cantor_surj_pt1 : exists (f : Tree -> T), +Local Lemma cantor_surj_pt1 : exists f : Tree -> T, continuous f /\ set_surj [set: Tree] [set: T] f. Proof. pose entn n := projT2 (cid (ent_balls' (count_unif n))). -have [] := (@tree_map_props (fun (n : nat) => @pointed_discrete R (K n)) - T (embed_refine) (embed_invar) cptT hsdfT). -- done. -- move=> n U; rewrite eqEsubset; split; last by move => t [? ? []]. - move=> t Ut; have [//|_ _ _ + _] := entn n; rewrite -subTset. - case/(_ t I) => W cbW Wt; exists (existT _ W cbW) => //. +have [] := @tree_map_props (@pointed_discrete R \o K) T (embed_refine) + (embed_invar) cptT hsdfT. +- by []. +- move=> n U; rewrite eqEsubset; split=> [t Ut|t [? ? []]//]. + have [//|_ _ _ + _] := entn n; rewrite -subTset. + move=> /(_ t I)[W cbW Wt]; exists (existT _ W cbW) => //. by rewrite /embed_refine; case: pselect => //=; apply: absurd; exists t. - move=> n U e [clU Un0]; split. apply: closedI => //; case: pselect => //= ?; first exact: Kn_closed. - case: pselect; last by move=> ?; exact: closed0. - move=> ?; exact: Kn_closed. - rewrite /embed_refine; case: pselect => //= ?; case: pselect. - by case => i [z [pz bz]]; set P := cid _; have := projT2 P; apply. + by case: pselect => ?; [exact: Kn_closed|exact: closed0]. + rewrite /embed_refine; case: pselect => //= ?; case: pselect. + by case=> i [z [pz bz]]; set P := cid _; have := projT2 P; apply. case: Un0 => z Uz; apply: absurd. - have [//|_ _ _ + _] := entn n; rewrite -subTset; case/(_ z I)=> i bi iz. - by exists (existT _ _ bi); exists z. + have [//|_ _ _ + _] := entn n; rewrite -subTset; move=> /(_ z I)[i bi iz]. + by exists (existT _ _ bi), z. - by move => ? []. - by split; [exact: closedT | exists point]. - by move => ? []. - move=> x y xny; move: hsdfT; rewrite open_hausdorff. - case/(_ _ _ xny); case => U V /= [/set_mem Ux /set_mem Vy] [oU oV UVI0]. - move: oU; rewrite openE => /(_ _ Ux); rewrite /interior -nbhs_entourageE. - case => E entE ExU; have [//| n ctE] := + move=> /(_ _ _ xny)[[U V]] /= [/set_mem Ux /set_mem Vy] [+ oV UVI0]. + rewrite openE => /(_ _ Ux); rewrite /interior -nbhs_entourageE => -[E entE ExU]. + have [//| n ctE] := @count_unif_sub ((split_ent E) `&` ((split_ent E)^-1%classic)). exact: filterI. - exists n => B [C ebC]; have [//|_ Csub _ _ _] := entn n => embx emby. - have [[D cbD] /= [Dx Dy]] : exists (e : K n), projT1 e x /\ projT1 e y. + exists n => B [C ebC]; have [//|_ Csub _ _ _ embx emby] := entn n. + have [[D cbD] /= Dx Dy] : exists2 e : K n, projT1 e x & projT1 e y. move: embx emby; rewrite /embed_refine; case: pselect => /=. - by move => ? [? ?] [? ?]; exists (existT _ _ ebC); split. - case: pselect ; last by move => ? ? []. + by move=> ? [? ?] [? ?]; exists (existT _ _ ebC). + case: pselect; last by move => ? ? []. by move=> e _ [? ?] [? ?]; exists (projT1 (cid e)). - suff : E (x, y). - by move/ExU; move/eqP/disjoints_subset:UVI0 => /[apply]. + suff : E (x, y) by move/ExU; move/eqP/disjoints_subset: UVI0 => /[apply]. have [z [Dz DzE]] := Csub _ cbD. - have /ent_closure:= DzE _ Dx => /(_ (ent_count_unif n))/ctE [_ /= ?]. - have /ent_closure:= DzE _ Dy => /(_ (ent_count_unif n))/ctE [? _]. + have /ent_closure:= DzE _ Dx => /(_ (ent_count_unif n))/ctE [_ /= Exz]. + have /ent_closure:= DzE _ Dy => /(_ (ent_count_unif n))/ctE [Ezy _]. exact: (@entourage_split [uniformType of T] z). by move=> f [ctsf surjf _]; exists f. Qed. Local Lemma cantor_surj_pt2 : - exists (f : {surj [set: cantor_space] >-> [set: Tree]}), continuous f. + exists (f : {surj [set: cantor_space] >-> [set: Tree]}), continuous f. Proof. -have [] := @homeomorphism_cantor_like R Tree; first last. - by move=> f [ctsf _]; exists f. -apply: (@cantor_like_finite_prod _ (fun n => @pointed_discrete R (K n))). - move=> n /=; have [// | fs _ _ _ _] := projT2 (cid (ent_balls' (count_unif n))). +have [|f [ctsf _]] := @homeomorphism_cantor_like R Tree; last by exists f. +apply: (@cantor_like_finite_prod _ (@pointed_discrete R \o K)) => [n /=|n]. + have [//| fs _ _ _ _] := projT2 (cid (ent_balls' (count_unif n))). suff -> : [set: {classic K' n}] = (@projT1 (set T) _) @^-1` (projT1 (cid (ent_balls' (count_unif n)))). - by apply: finite_preimage => //; move=> ? ? _ _; apply: eq_sigT_hprop. - by rewrite eqEsubset; split => //; case=> W p. -move=> n; have [// | _ _ [A [B [pA [pB AB]]]] _ _] := + by apply: finite_preimage => // ? ? _ _; exact: eq_sigT_hprop. + by rewrite eqEsubset; split => // -[]. +have [//| _ _ [A [B [pA [pB AB]]]] _ _] := projT2 (cid (ent_balls' (count_unif n))). -simpl; exists ((existT _ _ pA), (existT _ _ pB)). -by move: AB; apply: contra_neq; apply: EqdepFacts.eq_sigT_fst. +exists (existT _ _ pA, existT _ _ pB) => /=. +by move: AB; apply: contra_neq => -[]. Qed. Local Lemma cantor_surj_twop : - exists (f : {surj [set: cantor_space] >-> [set: T]}), continuous f. + exists (f : {surj [set: cantor_space] >-> [set: T]}), continuous f. Proof. -case: cantor_surj_pt2 => f ctsf; case: cantor_surj_pt1. -move => g [ctsg /Psurj [sjg gsjg]]; exists [surj of sjg \o f]. -by move=> z; apply continuous_comp; [apply: ctsf|rewrite -gsjg; apply: ctsg]. +move: cantor_surj_pt2 cantor_surj_pt1 => -[f ctsf] [g [ctsg /Psurj [sjg gsjg]]]. +exists [surj of sjg \o f] => z. +by apply continuous_comp; [exact: ctsf|rewrite -gsjg; exact: ctsg]. Qed. + End two_pointed. (* The Alexandroff-Hausdorff theorem*) Theorem cantor_surj : exists (f : {surj [set: cantor_space] >-> [set: T]}), continuous f. Proof. -case: (pselect (exists (p : T), p != point)). - by case => p ppt; apply: cantor_surj_twop; exact: ppt. -move=> /forallNP xpt; have : set_surj [set: cantor_space] [set: T] (cst point). - by move=> q _; exists point => //; have /negP := xpt q; rewrite negbK => /eqP. -by case/Psurj => f cstf; exists f; rewrite -cstf; apply: cst_continuous. +have [[p ppt]|/forallNP xpt] := pselect (exists p : T, p != point). + by apply: cantor_surj_twop; exact: ppt. +have /Psurj[f cstf] : set_surj [set: cantor_space] [set: T] (cst point). + by move=> q _; exists point => //; have /negP/negPn/eqP -> := xpt q. +by exists f; rewrite -cstf; exact: cst_continuous. Qed. -End alexandroff_hausdorff. \ No newline at end of file + +End alexandroff_hausdorff. diff --git a/theories/topology.v b/theories/topology.v index f99f633b0..1c0e7d9ed 100644 --- a/theories/topology.v +++ b/theories/topology.v @@ -3221,7 +3221,7 @@ Lemma compact_precompact (A B : set X) : hausdorff_space X -> compact A -> precompact A. Proof. move=> h c; rewrite precompactE ( _ : closure A = A)//. -apply/esym/closure_id; exact: compact_closed. +by apply/esym/closure_id; exact: compact_closed. Qed. Lemma precompact_closed (A : set X) : closed A -> precompact A = compact A. @@ -3676,7 +3676,7 @@ exists (fun i => if i is false then A `\` C else A `&` C); split. + rewrite setIC; apply/disjoints_subset; rewrite closureC => x [? ?]. by exists C => //; split=> //; rewrite setDE setCI setCK; right. + apply/disjoints_subset => y -[Ay Cy]. - rewrite -BAC BAD=> /closureI[_]; rewrite -(proj1 (@closure_id _ _) cD)=> Dy. + rewrite -BAC BAD => /closureI[_]; move/closure_id : cD => <- Dy. by have : B y; [by rewrite BAD; split|rewrite BAC => -[]]. Qed. @@ -4368,14 +4368,6 @@ Qed. End uniform_closeness. -Lemma ent_closure {X : uniformType} (x : X) E : entourage E -> - closure (to_set (split_ent E) x) `<=` to_set E x. -Proof. -pose E' := ((split_ent E) `&` ((split_ent E)^-1)%classic). -move=> entE z /(_ [set y | E' (z, y)]) []. - by rewrite -nbhs_entourageE; exists E' => //; apply: filterI. -by move=> y [/=] + [_]; apply: entourage_split. -Qed. Definition unif_continuous (U V : uniformType) (f : U -> V) := (fun xy => (f xy.1, f xy.2)) @ entourage --> entourage. From 85f0990adb734f44e9e9f7913fc60f88cdb6068d Mon Sep 17 00:00:00 2001 From: Reynald Affeldt Date: Tue, 14 Nov 2023 22:16:11 +0900 Subject: [PATCH 20/23] fix --- CHANGELOG_UNRELEASED.md | 49 ----------------------------------------- theories/cantor.v | 28 +++++++++++------------ 2 files changed, 13 insertions(+), 64 deletions(-) diff --git a/CHANGELOG_UNRELEASED.md b/CHANGELOG_UNRELEASED.md index c1665ced7..55dedd5e4 100644 --- a/CHANGELOG_UNRELEASED.md +++ b/CHANGELOG_UNRELEASED.md @@ -4,55 +4,6 @@ ### Added -- in `kernel.v`: - + `kseries` is now an instance of `Kernel_isSFinite_subdef` -- in `classical_sets.v`: - + lemma `setU_id2r` -- in `lebesgue_measure.v`: - + lemma `compact_measurable` - -- in `measure.v`: - + lemmas `outer_measure_subadditive`, `outer_measureU2` - -- in `lebesgue_measure.v`: - + declare `lebesgue_measure` as a `SigmaFinite` instance - + lemma `lebesgue_regularity_inner_sup` -- in `convex.v`: - + lemmas `conv_gt0`, `convRE` - -- in `exp.v`: - + lemmas `concave_ln`, `conjugate_powR` - -- in file `lebesgue_integral.v`, - + new lemmas `integral_le_bound`, `continuous_compact_integrable`, and - `lebesgue_differentiation_continuous`. - -- in `normedtype.v`: - + lemmas `open_itvoo_subset`, `open_itvcc_subset` - -- in `lebesgue_measure.v`: - + lemma `measurable_ball` - -- in file `normedtype.v`, - + new lemmas `normal_openP`, `uniform_regular`, - `regular_openP`, and `pseudometric_normal`. -- in file `topology.v`, - + new definition `regular_space`. - + new lemma `ent_closure`. - -- in file `lebesgue_integral.v`, - + new lemmas `simple_bounded`, `measurable_bounded_integrable`, - `compact_finite_measure`, `approximation_continuous_integrable` - -- in `sequences.v`: - + lemma `cvge_harmonic` - -- in `mathcomp_extra.v`: - + lemmas `le_bigmax_seq`, `bigmax_sup_seq` - -- in `constructive_ereal.v`: - + lemma `bigmaxe_fin_num` - - in file `cantor.v`, + new definitions `cantor_space`, `cantor_like`, `pointedDiscrete`, and `tree_of`. diff --git a/theories/cantor.v b/theories/cantor.v index 6aca4ade5..d0aacda0e 100644 --- a/theories/cantor.v +++ b/theories/cantor.v @@ -10,12 +10,12 @@ From HB Require Import structures. (* *) (* This file develops the theory of the Cantor space, that is bool^nat with *) (* the product topology. The two main theorems proved here are *) -(* homeomorphism_cantor_like, and cantor_surj, aka Alexandroff-Hausdorff. *) +(* homeomorphism_cantor_like, and cantor_surj, a.k.a. Alexandroff-Hausdorff. *) (* *) -(* cantor_space == the Cantor space, with its canonical metric *) +(* cantor_space == the Cantor space, with its canonical metric *) (* cantor_like T == perfect + compact + hausdroff + zero dimensional *) -(* pointed_discrete T == equips T with the discrete topology *) -(* tree_of T == builds a topological tree with levels (T n) *) +(* pointed_discrete T == equips T with the discrete topology *) +(* tree_of T == builds a topological tree with levels (T n) *) (* *) (******************************************************************************) @@ -285,8 +285,7 @@ Let c_ind n (V : set T) (b : bool) := Local Lemma cantor_map : exists f : cantor_space -> T, [/\ continuous f, set_surj [set: cantor_space] [set: T] f & - set_inj [set: cantor_space] f - ]. + set_inj [set: cantor_space] f ]. Proof. have [] := @tree_map_props (fun=> [topologicalType of bool]) T c_ind c_invar cmptT hsdfT. @@ -335,7 +334,7 @@ Lemma homeomorphism_cantor_like : continuous f /\ (forall A, closed A -> closed (f @` A)). Proof. -exists tree_map => /=. +exists [the {splitbij _ >-> _} of tree_map] => /=. have [cts surj inje] := projT2 (cid cantor_map); split; first exact: cts. move=> A clA; apply: (compact_closed hsdfT). apply: (@continuous_compact _ _ tree_map); first exact: continuous_subspaceT. @@ -390,14 +389,13 @@ Context (t0 t1 : T). Hypothesis T2e : t0 != t1. Local Lemma ent_balls' (E : set (T * T)) : - exists M : set (set T), - entourage E -> [/\ - finite_set M, - forall A, M A -> exists a, A a /\ - A `<=` closure [set y | split_ent E (a, y)], - exists A B : set T, M A /\ M B /\ A != B, - \bigcup_(A in M) A = [set: T] & - M `<=` closed]. + exists M : set (set T), entourage E -> [/\ + finite_set M, + forall A, M A -> exists a, A a /\ + A `<=` closure [set y | split_ent E (a, y)], + exists A B : set T, M A /\ M B /\ A != B, + \bigcup_(A in M) A = [set: T] & + M `<=` closed]. Proof. have [entE|?] := pselect (entourage E); last by exists point. move: cptT; rewrite compact_cover. From c4a2116ed92e06c08efe94462cd857ce7949ceb2 Mon Sep 17 00:00:00 2001 From: Reynald Affeldt Date: Wed, 15 Nov 2023 00:15:06 +0900 Subject: [PATCH 21/23] fix changelog, mv clopen_surj --- CHANGELOG_UNRELEASED.md | 1 + theories/cantor.v | 72 +++++++++++++++++------------------------ theories/topology.v | 9 ++++++ 3 files changed, 40 insertions(+), 42 deletions(-) diff --git a/CHANGELOG_UNRELEASED.md b/CHANGELOG_UNRELEASED.md index 55dedd5e4..8f0edf23b 100644 --- a/CHANGELOG_UNRELEASED.md +++ b/CHANGELOG_UNRELEASED.md @@ -14,6 +14,7 @@ + new theorem `cantor_surj`. - in file `topology.v`, + new lemmas `perfect_set2`, and `ent_closure`. + + lemma `clopen_surj` ### Changed diff --git a/theories/cantor.v b/theories/cantor.v index d0aacda0e..4406728d1 100644 --- a/theories/cantor.v +++ b/theories/cantor.v @@ -106,7 +106,7 @@ Hypothesis refine_separates: forall x y : X, x != y -> exists n, forall (U : set X) e, @refine_apx n U e x -> ~@refine_apx n U e y. -Local Lemma refine_subset n U e : @refine_apx n U e `<=` U. +Let refine_subset n U e : @refine_apx n U e `<=` U. Proof. by rewrite [X in _ `<=` X](refine_cover n); exact: bigcup_sup. Qed. Let T := product_topologicalType K. @@ -116,10 +116,10 @@ Local Fixpoint branch_apx (b : T) n := Let tree_mapF (b : T) := filter_from [set: nat] (branch_apx b). -Local Lemma tree_map_invar b n : tree_invariant (branch_apx b n). +Let tree_map_invar b n : tree_invariant (branch_apx b n). Proof. by elim: n => // n ?; exact: refine_invar. Qed. -Local Lemma tree_map_sub b i j : +Let tree_map_sub b i j : (i <= j)%N -> branch_apx b j `<=` branch_apx b i. Proof. elim: j i => [?|j IH i]; first by rewrite leqn0 => /eqP ->. @@ -137,7 +137,7 @@ Qed. Let tree_map b := lim (tree_mapF b). -Local Lemma cvg_tree_map b : cvg (tree_mapF b). +Let cvg_tree_map b : cvg (tree_mapF b). Proof. have [|x [_ clx]] := cmptX (tree_map_filter b); first exact: filterT. apply/cvg_ex; exists x => /=; apply: (compact_cluster_set1 _ cmptX) => //. @@ -173,7 +173,7 @@ have /(_ IH) := projT2 (cid (zcov' n (branch_apx g' n))). by case: n {IH} => // n; rewrite apxg. Qed. -Local Lemma tree_prefix (b : T) (n : nat) : +Let tree_prefix (b : T) (n : nat) : \forall c \near b, forall i, (i < n)%N -> b i = c i. Proof. elim: n => [|n IH]; first by near=> z => ?; rewrite ltn0. @@ -183,14 +183,14 @@ split => //; suff : @open T (proj n @^-1` [set b n]) by []. by apply: open_comp; [move=> + _; exact: proj_continuous| exact: discrete_open]. Unshelve. all: end_near. Qed. -Local Lemma apx_prefix b c n : +Let apx_prefix b c n : (forall i, (i < n)%N -> b i = c i) -> branch_apx b n = branch_apx c n. Proof. elim: n => //= n IH inS; rewrite IH; first by rewrite inS. by move=> ? ?; exact/inS/ltnW. Qed. -Local Lemma tree_map_apx b n : branch_apx b n (tree_map b). +Let tree_map_apx b n : branch_apx b n (tree_map b). Proof. apply: (@closed_cvg _ _ _ (tree_map_filter b)); last exact: cvg_tree_map. by apply: invar_cl; exact: tree_map_invar. @@ -213,7 +213,7 @@ move=> xyE; exists (tree_map y); split. by rewrite -/(branch_apx y n.+1); exact: tree_map_apx. Qed. -Let tree_map_inj : (forall n U, trivIset [set: K n] (@refine_apx n U)) -> +Local Lemma tree_map_inj : (forall n U, trivIset [set: K n] (@refine_apx n U)) -> set_inj [set: T] tree_map. Proof. move=> triv x y _ _ xyE; apply: functional_extensionality_dep => n. @@ -225,7 +225,7 @@ rewrite (@triv m (branch_apx x m) (x m) (y m) I I) 1?brE//. by rewrite -[in X in X `&` _]brE; exact: tree_map_setI. Qed. -Lemma tree_map_props : exists (f : T -> X), +Lemma tree_map_props : exists f : T -> X, [/\ continuous f, set_surj [set: T] [set: X] f & (forall n U, trivIset [set: K n] (@refine_apx n U)) -> @@ -255,14 +255,7 @@ Let hsdfT : @hausdorff_space T. Proof. by case: cantorT. Qed. Let c_invar (U : set T) := clopen U /\ U !=set0. -Let clopen_surj : $|{surjfun [set: nat] >-> @clopen T}|. -Proof. -suff : @clopen T = set0 \/ $|{surjfun [set: nat] >-> @clopen T}|. - by case; rewrite // eqEsubset => -[/(_ _ clopenT)]. -exact/pfcard_geP/clopen_countable/compact_second_countable. -Qed. - -Let U_ := unsquash clopen_surj. +Let U_ := unsquash (clopen_surj cmptT). Let split_clopen' (U : set T) : exists V, open U -> U !=set0 -> clopen V /\ V `&` U !=set0 /\ ~`V `&` U !=set0. @@ -322,7 +315,7 @@ Qed. Let tree_map := projT1 (cid cantor_map). -Local Lemma tree_map_bij : bijective tree_map. +Let tree_map_bij : bijective tree_map. Proof. by rewrite -setTT_bijective; have [? ? ?] := projT2 (cid cantor_map); split. Qed. @@ -330,9 +323,8 @@ Qed. #[local] HB.instance Definition _ := @BijTT.Build _ _ _ tree_map_bij. Lemma homeomorphism_cantor_like : - exists (f : {splitbij [set: cantor_space] >-> [set: T]}), - continuous f /\ - (forall A, closed A -> closed (f @` A)). + exists f : {splitbij [set: cantor_space] >-> [set: T]}, + continuous f /\ (forall A, closed A -> closed (f @` A)). Proof. exists [the {splitbij _ >-> _} of tree_map] => /=. have [cts surj inje] := projT2 (cid cantor_map); split; first exact: cts. @@ -344,9 +336,10 @@ Qed. End TreeStructure. -(* Part 3: Finitely Branching trees are cantor-like *) +(* Part 3: Finitely branching trees are Cantor-like *) Section FinitelyBranchingTrees. Context {R : realType}. + Definition pointed_discrete (P : pointedType) : pseudoMetricType R := @discrete_pseudoMetricType R (@discrete_uniformType (TopologicalType @@ -388,7 +381,7 @@ Section two_pointed. Context (t0 t1 : T). Hypothesis T2e : t0 != t1. -Local Lemma ent_balls' (E : set (T * T)) : +Let ent_balls' (E : set (T * T)) : exists M : set (set T), entourage E -> [/\ finite_set M, forall A, M A -> exists a, A a /\ @@ -434,23 +427,21 @@ Let count_unif' := cid2 Let count_unif := projT1 count_unif'. -Local Lemma ent_count_unif n : entourage (count_unif n). +Let ent_count_unif n : entourage (count_unif n). Proof. have := projT2 (cid (ent_balls' (count_unif n))). rewrite /count_unif; case: count_unif'. by move=> /= f fnA fnE; case /(_ (fnE _)) => _ _ _ + _; rewrite -subTset. Qed. -Local Lemma count_unif_sub E : entourage E -> exists N, count_unif N `<=` E. +Let count_unif_sub E : entourage E -> exists N, count_unif N `<=` E. Proof. by move=> entE; rewrite /count_unif; case: count_unif' => f + ? /=; exact. Qed. -Hint Resolve ent_count_unif : core. - Let K' n : Type := @sigT (set T) (ent_balls (count_unif n)). -Local Lemma K'p n : K' n. +Let K'p n : K' n. Proof. apply: cid; have [//| _ _ _ + _] := projT2 (cid (ent_balls' (count_unif n))). by rewrite -subTset => /(_ point I) [W Q ?]; exists W; exact: Q. @@ -467,39 +458,36 @@ Let embed_refine n (U : set T) (k : K n) := else set0) `&` U. Let embed_invar (U : set T) := closed U /\ U !=set0. -Local Lemma Kn_closed n (e : K n) : closed (projT1 e). +Let Kn_closed n (e : K n) : closed (projT1 e). Proof. case: e => W; have [//| _ _ _ _] := projT2 (cid (ent_balls' (count_unif n))). exact. Qed. -Local Lemma cantor_surj_pt1 : exists f : Tree -> T, - continuous f /\ set_surj [set: Tree] [set: T] f. +Local Lemma cantor_surj_pt1 : exists2 f : Tree -> T, + continuous f & set_surj [set: Tree] [set: T] f. Proof. pose entn n := projT2 (cid (ent_balls' (count_unif n))). -have [] := @tree_map_props (@pointed_discrete R \o K) T (embed_refine) - (embed_invar) cptT hsdfT. -- by []. +have [//| | |? []//| |? []// | |] := @tree_map_props (@pointed_discrete R \o K) + T (embed_refine) (embed_invar) cptT hsdfT. - move=> n U; rewrite eqEsubset; split=> [t Ut|t [? ? []]//]. have [//|_ _ _ + _] := entn n; rewrite -subTset. move=> /(_ t I)[W cbW Wt]; exists (existT _ W cbW) => //. by rewrite /embed_refine; case: pselect => //=; apply: absurd; exists t. - move=> n U e [clU Un0]; split. - apply: closedI => //; case: pselect => //= ?; first exact: Kn_closed. + apply: closedI => //; case: pselect => //= ?. by case: pselect => ?; [exact: Kn_closed|exact: closed0]. rewrite /embed_refine; case: pselect => //= ?; case: pselect. by case=> i [z [pz bz]]; set P := cid _; have := projT2 P; apply. case: Un0 => z Uz; apply: absurd. have [//|_ _ _ + _] := entn n; rewrite -subTset; move=> /(_ z I)[i bi iz]. by exists (existT _ _ bi), z. -- by move => ? []. - by split; [exact: closedT | exists point]. -- by move => ? []. - move=> x y xny; move: hsdfT; rewrite open_hausdorff. move=> /(_ _ _ xny)[[U V]] /= [/set_mem Ux /set_mem Vy] [+ oV UVI0]. rewrite openE => /(_ _ Ux); rewrite /interior -nbhs_entourageE => -[E entE ExU]. have [//| n ctE] := - @count_unif_sub ((split_ent E) `&` ((split_ent E)^-1%classic)). + @count_unif_sub (split_ent E `&` (split_ent E)^-1%classic). exact: filterI. exists n => B [C ebC]; have [//|_ Csub _ _ _ embx emby] := entn n. have [[D cbD] /= Dx Dy] : exists2 e : K n, projT1 e x & projT1 e y. @@ -516,7 +504,7 @@ by move=> f [ctsf surjf _]; exists f. Qed. Local Lemma cantor_surj_pt2 : - exists (f : {surj [set: cantor_space] >-> [set: Tree]}), continuous f. + exists f : {surj [set: cantor_space] >-> [set: Tree]}, continuous f. Proof. have [|f [ctsf _]] := @homeomorphism_cantor_like R Tree; last by exists f. apply: (@cantor_like_finite_prod _ (@pointed_discrete R \o K)) => [n /=|n]. @@ -532,9 +520,9 @@ by move: AB; apply: contra_neq => -[]. Qed. Local Lemma cantor_surj_twop : - exists (f : {surj [set: cantor_space] >-> [set: T]}), continuous f. + exists f : {surj [set: cantor_space] >-> [set: T]}, continuous f. Proof. -move: cantor_surj_pt2 cantor_surj_pt1 => -[f ctsf] [g [ctsg /Psurj [sjg gsjg]]]. +move: cantor_surj_pt2 cantor_surj_pt1 => -[f ctsf] [g ctsg /Psurj[sjg gsjg]]. exists [surj of sjg \o f] => z. by apply continuous_comp; [exact: ctsf|rewrite -gsjg; exact: ctsg]. Qed. @@ -543,7 +531,7 @@ End two_pointed. (* The Alexandroff-Hausdorff theorem*) Theorem cantor_surj : - exists (f : {surj [set: cantor_space] >-> [set: T]}), continuous f. + exists f : {surj [set: cantor_space] >-> [set: T]}, continuous f. Proof. have [[p ppt]|/forallNP xpt] := pselect (exists p : T, p != point). by apply: cantor_surj_twop; exact: ppt. diff --git a/theories/topology.v b/theories/topology.v index 1c0e7d9ed..9eed00f36 100644 --- a/theories/topology.v +++ b/theories/topology.v @@ -6615,6 +6615,15 @@ pose B := \bigcup_n (f n) @` [set` h'' n]; exists B;[|split]. by apply: (le_ball (ltW deleps)); apply: interior_subset. Qed. +Lemma clopen_surj {R : realType} {T : pseudoMetricType R} : + compact [set: T] -> $|{surjfun [set: nat] >-> @clopen T}|. +Proof. +move=> cmptT. +suff : @clopen T = set0 \/ $|{surjfun [set: nat] >-> @clopen T}|. + by case => //; rewrite eqEsubset => -[/(_ _ clopenT)]. +exact/pfcard_geP/clopen_countable/compact_second_countable. +Qed. + (* This section proves that uniform spaces, with a countable base for their entourage, are metrizable. The definition of this metric is rather arcane, and the proof is tough. That's ok because the resulting metric is not From a330055d51c453c972d38dd88c3c57d7b59dbc70 Mon Sep 17 00:00:00 2001 From: Reynald Affeldt Date: Wed, 15 Nov 2023 00:17:02 +0900 Subject: [PATCH 22/23] fix --- CHANGELOG_UNRELEASED.md | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/CHANGELOG_UNRELEASED.md b/CHANGELOG_UNRELEASED.md index 8f0edf23b..e2709956a 100644 --- a/CHANGELOG_UNRELEASED.md +++ b/CHANGELOG_UNRELEASED.md @@ -5,7 +5,7 @@ ### Added - in file `cantor.v`, - + new definitions `cantor_space`, `cantor_like`, `pointedDiscrete`, and + + new definitions `cantor_space`, `cantor_like`, `pointed_discrete`, and `tree_of`. + new lemmas `cantor_space_compact`, `cantor_space_hausdorff`, `cantor_zero_dimensional`, `cantor_perfect`, `cantor_like_cantor_space`, From d3490a5ff14ae86365d420210e06d24ef7a0f96e Mon Sep 17 00:00:00 2001 From: Reynald Affeldt Date: Wed, 15 Nov 2023 00:27:22 +0900 Subject: [PATCH 23/23] fix --- theories/cantor.v | 17 ++++++++--------- 1 file changed, 8 insertions(+), 9 deletions(-) diff --git a/theories/cantor.v b/theories/cantor.v index 4406728d1..db97c04a3 100644 --- a/theories/cantor.v +++ b/theories/cantor.v @@ -29,7 +29,7 @@ Import numFieldTopology.Exports. Local Open Scope classical_set_scope. Definition cantor_space := - product_uniformType (fun (_ : nat) => @discrete_uniformType _ discrete_bool). + product_uniformType (fun _ : nat => @discrete_uniformType _ discrete_bool). Definition cantor_like (T : topologicalType) := [/\ perfect_set [set: T], @@ -38,7 +38,7 @@ Definition cantor_like (T : topologicalType) := zero_dimensional T]. Canonical cantor_pseudoMetric {R} := - @product_pseudoMetricType R _ (fun (_ : nat) => + @product_pseudoMetricType R _ (fun _ : nat => @discrete_pseudoMetricType R _ discrete_bool) (countableP _). Lemma cantor_space_compact : compact [set: cantor_space]. @@ -114,13 +114,12 @@ Let T := product_topologicalType K. Local Fixpoint branch_apx (b : T) n := if n is m.+1 then refine_apx (branch_apx b m) (b m) else [set: X]. -Let tree_mapF (b : T) := filter_from [set: nat] (branch_apx b). +Let tree_mapF b := filter_from [set: nat] (branch_apx b). Let tree_map_invar b n : tree_invariant (branch_apx b n). Proof. by elim: n => // n ?; exact: refine_invar. Qed. -Let tree_map_sub b i j : - (i <= j)%N -> branch_apx b j `<=` branch_apx b i. +Let tree_map_sub b i j : (i <= j)%N -> branch_apx b j `<=` branch_apx b i. Proof. elim: j i => [?|j IH i]; first by rewrite leqn0 => /eqP ->. rewrite leq_eqVlt => /predU1P[->//|/IH]. @@ -258,13 +257,13 @@ Let c_invar (U : set T) := clopen U /\ U !=set0. Let U_ := unsquash (clopen_surj cmptT). Let split_clopen' (U : set T) : exists V, - open U -> U !=set0 -> clopen V /\ V `&` U !=set0 /\ ~`V `&` U !=set0. + open U -> U !=set0 -> [/\ clopen V, V `&` U !=set0 & ~`V `&` U !=set0]. Proof. have [oU|?] := pselect (open U); last by exists point. have [Un0|?] := pselect (U !=set0); last by exists point. have [x [y] [Ux] Uy xny] := (iffLR perfect_set2) pftT U oU Un0. -have [V [clV Vx Vy]] := dsctT xny; exists V. -by repeat split => //; [exists x | exists y]. +have [V [clV Vx Vy]] := dsctT xny; exists V => _ _. +by split => //; [exists x | exists y]. Qed. Let split_clopen (U : set T) := projT1 (cid (split_clopen' U)). @@ -295,7 +294,7 @@ have [] := @tree_map_props + move=> [UU CUU]; case: e => //; split => //; apply: clopenI => //. exact: funS. by apply: clopenC => //; exact: funS. - + move=> _; have [|//|clscU [scUU CscUU]] := projT2 (cid (split_clopen' U)). + + move=> _; have [|//|clscU scUU CscUU] := projT2 (cid (split_clopen' U)). by case: clU. case: e; split => //; first exact: clopenI. by apply: clopenI => //; exact: clopenC.