(************************************************************************)
(*         *   The Coq Proof Assistant / The Coq Development Team       *)
(*  v      *   INRIA, CNRS and contributors - Copyright 1999-2018       *)
(* <O___,, *       (see CREDITS file for the list of authors)           *)
(*   \VV/  **************************************************************)
(*    //   *    This file is distributed under the terms of the         *)
(*         *     GNU Lesser General Public License Version 2.1          *)
(*         *     (see LICENSE file for the text of the license)         *)
(************************************************************************)
Local Open Scope R_scope.
(** * General definitions and propositions *)
Definition included (D1 D2:R -> Prop) : Prop := forall x:R, D1 x -> D2 x.
Definition disc (x:R) (delta:posreal) (y:R) : Prop := Rabs (y - x) < delta.
Definition neighbourhood (V:R -> Prop) (x:R) : Prop :=
exists delta : posreal, included (disc x delta) V.
Definition open_set (D:R -> Prop) : Prop :=
forall x:R, D x -> neighbourhood D x.
Definition complementary (D:R -> Prop) (c:R) : Prop := ~ D c.
Definition closed_set (D:R -> Prop) : Prop := open_set (complementary D).
Definition intersection_domain (D1 D2:R -> Prop) (c:R) : Prop := D1 c /\ D2 c.
Definition union_domain (D1 D2:R -> Prop) (c:R) : Prop := D1 c \/ D2 c.
Definition interior (D:R -> Prop) (x:R) : Prop := neighbourhood D x.
Definition point_adherent (D:R -> Prop) (x:R) : Prop :=
forall V:R -> Prop,
neighbourhood V x ->  exists y : R, intersection_domain V D y.
Definition adherence (D:R -> Prop) (x:R) : Prop := point_adherent D x.
Definition eq_Dom (D1 D2:R -> Prop) : Prop :=
included D1 D2 /\ included D2 D1.
Infix "=_D" := eq_Dom (at level 70, no associativity).
Definition image_rec (f:R -> R) (D:R -> Prop) (x:R) : Prop := D (f x).
Record family : Type := mkfamily
{ind : R -> Prop;
f :> R -> R -> Prop;
cond_fam : forall x:R, (exists y : R, f x y) -> ind x}.
Definition family_open_set (f:family) : Prop := forall x:R, open_set (f x).
Definition domain_finite (D:R -> Prop) : Prop :=
exists l : Rlist, (forall x:R, D x <-> In x l).
Definition family_finite (f:family) : Prop := domain_finite (ind f).
Definition covering (D:R -> Prop) (f:family) : Prop :=
forall x:R, D x ->  exists y : R, f y x.
Definition covering_open_set (D:R -> Prop) (f:family) : Prop :=
covering D f /\ family_open_set f.
Definition covering_finite (D:R -> Prop) (f:family) : Prop :=
covering D f /\ family_finite f.
Definition subfamily (f:family) (D:R -> Prop) : family :=
mkfamily (intersection_domain (ind f) D) (fun x y:R => f x y /\ D x)
(restriction_family f D).
Definition compact (X:R -> Prop) : Prop :=
forall f:family,
covering_open_set X f ->
exists D : R -> Prop, covering_finite X (subfamily f D).
Definition bounded (D:R -> Prop) : Prop :=
exists m : R, (exists M : R, (forall x:R, D x -> m <= x <= M)).
Definition image_dir (f:R -> R) (D:R -> Prop) (x:R) : Prop :=
exists y : R, x = f y /\ D y.
(********************************************************)
(** *      Proof of Bolzano-Weierstrass theorem         *)
(********************************************************)
Definition ValAdh (un:nat -> R) (x:R) : Prop :=
forall (V:R -> Prop) (N:nat),
neighbourhood V x ->  exists p : nat, (N <= p)%nat /\ V (un p).
Definition intersection_family (f:family) (x:R) : Prop :=
forall y:R, ind f y -> f y x.
Definition ValAdh_un (un:nat -> R) : R -> Prop :=
let D := fun x:R =>  exists n : nat, x = INR n in
let f :=
fun x:R =>
adherence
(fun y:R => (exists p : nat, y = un p /\ x <= INR p) /\ D x) in
intersection_family (mkfamily D f (ValAdh_un_exists un)).
Definition family_closed_set (f:family) : Prop :=
forall x:R, closed_set (f x).
Definition intersection_vide_in (D:R -> Prop) (f:family) : Prop :=
forall x:R,
(ind f x -> included (f x) D) /\
~ (exists y : R, intersection_family f y).
Definition intersection_vide_finite_in (D:R -> Prop)
(f:family) : Prop := intersection_vide_in D f /\ family_finite f.

Theorem Bolzano_Weierstrass :
forall (un:nat -> R) (X:R -> Prop),
compact X -> (forall n:nat, X (un n)) ->  exists l : R, ValAdh un l.