Section extension_approximation.
Variable f0:point_set (SubspaceTopology F) -> point_set RTop.
Hypothesis f0_cont: continuous f0.
Hypothesis f0_bound: forall x:point_set (SubspaceTopology F),
-1 <= f0 x <= 1.
Definition extension_approximation: point_set X -> point_set RTop.
refine (
let F0:=Im [ x:point_set (SubspaceTopology F) | f0 x <= -1/3 ]
(subspace_inc F) in
let G0:=Im [ x:point_set (SubspaceTopology F) | f0 x >= 1/3 ]
(subspace_inc F) in
let g:=proj1_sig (Urysohns_lemma_function F0 G0 _ _ _) in
fun x:point_set X => -1/3 + 2/3 * g x).
- apply subspace_inc_takes_closed_to_closed; [assumption|].
replace ([ x:point_set (SubspaceTopology F) | f0 x <= -1/3 ]) with
(inverse_image f0 [ y:point_set RTop | y <= -1/3 ]).
+ red.
rewrite <- inverse_image_complement.
apply f0_cont.
apply lower_closed_interval_closed.
* apply Rle_order.
* intros.
destruct (total_order_T x y) as [[|]|];
auto with real.
+ extensionality_ensembles.
* now constructor.
* constructor.
now constructor.
- apply subspace_inc_takes_closed_to_closed; [assumption|].
replace ([ x:point_set (SubspaceTopology F) | f0 x >= 1/3 ]) with
(inverse_image f0 [ y:point_set RTop | 1/3 <= y ]).
+ red.
rewrite <- inverse_image_complement.
apply f0_cont.
apply upper_closed_interval_closed.
* apply Rle_order.
* intros.
destruct (total_order_T x y) as [[|]|];
auto with real.
+ extensionality_ensembles.
* constructor. lra.
* constructor. constructor. lra.
- extensionality_ensembles.
destruct x, x0.
simpl in *.
subst.
destruct (proof_irrelevance _ i i0).
lra.
Defined.
End extension_approximation.
Definition extension_approximation_seq: forall n:nat,
{ g0:point_set X -> point_set RTop |
continuous g0 /\
(forall x:point_set X, -1 + (2/3)^n <= g0 x <= 1 - (2/3)^n) /\
(forall x:point_set (SubspaceTopology F),
-(2/3)^n <= f x - g0 (subspace_inc F x) <= (2/3)^n) }.
simple refine (fix g (n:nat) {struct n} := match n return
{ g0:point_set X -> point_set RTop |
continuous g0 /\
(forall x:point_set X, -1 + (2/3)^n <= g0 x <= 1 - (2/3)^n) /\
(forall x:point_set (SubspaceTopology F),
-(2/3)^n <= f x - g0 (subspace_inc F x) <= (2/3)^n) } with
| O => exist _ (fun _ => 0) _
| S m => match g m with
| exist gm y =>
let H := _ in
let approx := extension_approximation
(fun x:point_set (SubspaceTopology F) =>
(3/2)^m * (f x - gm (subspace_inc F x))) H in
exist _ (fun x:point_set X => gm x + (2/3)^m * approx x) _
end
end); clear g; [ | | clearbody H ].
- simpl.
split.
+ apply continuous_constant.
+ split; intros.
* lra.
* destruct (f_bound x).
lra.
- apply pointwise_continuity.
intros.
apply const_multiple_continuous.
apply diff_continuous.
+ now apply continuous_func_continuous_everywhere.
+ apply continuous_composition_at.
* destruct y.
now apply continuous_func_continuous_everywhere.
* apply continuous_func_continuous_everywhere,
subspace_inc_continuous.
- assert (H023m: 0 <= (2/3)^m).
{
apply pow_le. lra.
}
assert (H032m: 0 <= (3/2)^m).
{
apply pow_le. lra.
}
assert (forall x,
-1 <= (3/2)^m * (f x - gm (subspace_inc F x)) <= 1).
{
intros.
destruct y as [? []].
destruct (H2 x).
assert ((3/2)^m * (2/3)^m = 1).
{
rewrite <- missing_pow_mult.
replace (3/2*(2/3)) with 1 by field.
apply pow1.
}
replace (-1) with ((3/2)^m * (- (2/3)^m)) by lra.
replace 1 with ((3/2)^m * (2/3)^m) by lra.
auto with real.
}
assert (forall x, -1/3 <= approx x <= 1/3) by
apply extension_approximation_bound.
assert (forall x,
-2/3 <= (3/2)^m * (f x - gm (subspace_inc F x)) -
approx (subspace_inc F x) <= 2/3) by
now apply extension_approximation_diff_bound.
destruct y as [? []].
split.
+ apply pointwise_continuity.
intros.
apply sum_continuous.
* now apply continuous_func_continuous_everywhere.
* apply const_multiple_continuous.
apply continuous_func_continuous_everywhere.
apply extension_approximation_continuous.
+ split; intros.
* destruct (H4 x), (H1 x).
assert (0 <= (2/3)^m) by
auto with real.
assert ((2/3)^m * (-1/3) <= (2/3)^m * approx x <= (2/3)^m * (1/3)) by
auto with real.
simpl.
lra.
* simpl.
replace (-(2/3*(2/3)^m)) with ((2/3)^m * (-2/3)) by field.
replace (2/3*(2/3)^m) with ((2/3)^m * (2/3)) by ring.
replace (f x - (gm (subspace_inc F x) + (2/3)^m * approx (subspace_inc F x)))
with ((2/3)^m * ((3/2)^m * (f x - gm (subspace_inc F x)) -
approx (subspace_inc F x))).
** destruct (H2 x).
auto with real.
** ring_simplify.
replace ((2/3)^m*(3/2)^m) with 1.
{ ring. }
rewrite <- missing_pow_mult.
replace (2/3*(3/2)) with 1 by field.
now rewrite pow1.
Defined.
(* now we've gotten what we need from the concrete definition, make it opaque so it doesn't slow down searches in the future *)
Global Opaque extension_approximation_seq.
Opaque extension_approximation_seq.
Definition convert_approx_to_uniform_space:
nat -> uniform_space R_metric (fun _:point_set X => 0).
refine (fun n:nat => exist _ (proj1_sig (extension_approximation_seq n)) _).
destruct extension_approximation_seq as [g [? []]].
simpl.
unfold R_metric.
exists (1 - (2/3)^n).
red. intros.
destruct H.
rewrite H0. clear y H0.
destruct (a x).
unfold Rabs.
destruct Rcase_abs; lra.
Defined.

Lemma extension_approximation_seq_cauchy:
cauchy (uniform_metric R_metric (fun _:point_set X => 0)
R_metric_is_metric X_nonempty)
convert_approx_to_uniform_space.