Require Import Logic_Type.
Require Export Paths Fibrations Contractible Equivalences.

(** Any two contractible types are equivalent. *)

Lemma contr_contr_equiv {A B} :
  is_contr A -> is_contr B -> A <~> B.
Proof.
  intros Acontr Bcontr.
  exact (equiv_compose (contr_equiv_unit A Acontr) (equiv_inverse (contr_equiv_unit B Bcontr))).
Defined.

Lemma contr_contr_is_equiv {A B} (f : A -> B) :
  is_contr A -> is_contr B -> is_equiv f.
Proof.
  intros H G.
  apply is_equiv_from_hequiv with (g := fun _ => pr1 H);
    intro; apply contr_path; assumption.
Defined.

(* A type is equivalent to its product with [unit]. *)

Definition prod_unit_right_equiv A : A <~> A * unit.
Proof.
  apply (equiv_from_hequiv (fun (a : A) => (a, tt)) (@fst A unit)).
  intros [a t]; destruct t; auto.
  auto.
Defined.

Definition prod_unit_left_equiv A : A <~> unit * A.
Proof.
  apply (equiv_from_hequiv (fun (a : A) => (tt, a)) (@snd unit A)).
  intros [t a]; destruct t; auto.
  auto.
Defined.

(** The action of an equivalence on paths is an equivalence. Notice that
   we only need the "retraction" part of equivalence, so there is room
   for improvement. *)

Theorem equiv_map_inv {A B} {x y : A} (f : A <~> B) :
  (f x = f y) -> (x = y).
Proof.
  intros p.
  path_via (f^-1 (f x)).
  apply opposite.
  apply inverse_is_retraction.
  path_via' (f^-1 (f y)).
  apply map; exact p.
  apply inverse_is_retraction.
Defined.

Theorem equiv_map_equiv {A B} {x y : A} (e : A <~> B) : (x = y) <~> (e x = e y).
Proof.
  apply (equiv_from_hequiv (@map A B x y e) (equiv_map_inv (x := x) (y := y) e)).
  intro p.
  unfold equiv_map_inv.
  hott_simpl.
  moveright_onleft.
  moveright_onright.
  rewrite inverse_triangle.
  transitivity ((inverse_is_section e (e x) @ p) @ opposite (inverse_is_section e (e y))).
  apply opposite, concat_associativity.
  apply whisker_left.
  apply map.
  apply opposite.
  apply inverse_triangle.
  intro p.
  unfold equiv_map_inv.
  moveright_onleft.
  associate_left.
Defined.

(** Path-concatenation is an equivalence. *)

Lemma concat_equiv_left {A} (x y z : A) (p : x = y) : (y = z) <~> (x = z).
Proof.
  apply (equiv_from_hequiv (fun q : y = z => p @ q) (@concat A y x z (!p)));
  intro q; associate_left.
Defined.

Lemma concat_equiv_right {A} (x y z : A) (p : y = z) : (x = y) <~> (x = z).
Proof.
  apply (equiv_from_hequiv (fun q : x = y => q @ p) (fun r : x = z => r @ !p));
  intro q; associate_right.
Defined.

(** Opposite is an equivalence. *)

Definition opposite_equiv {A} (x y : A) : (x = y) <~> (y = x).
Proof.
  apply (equiv_from_hequiv (@opposite A x y) (@opposite A y x)).
  intros p; apply opposite_opposite.
  intros p; apply opposite_opposite.
Defined.

(** The same for opposite2. *)

Definition unopposite2 {A} {x y : A} (p q : x = y) : (!p = !q) -> (p = q).
Proof.
  intros r.
  path_via (!!p).
  apply @concat with (!!q).
  apply opposite2; assumption.
  auto with path_hints.
Defined.

Lemma opposite2_functor {A} (x y : A) (p q r : x = y) (s : p = q) (t : q = r) :
  opposite2 (s @ t) = opposite2 s @ opposite2 t.
Proof.
  path_induction.
Defined.

Lemma opposite2_opposite {A} (x y : A) (p q : x = y) (s : p = q) :
  opposite2 (!s) = !opposite2 s.
Proof.
  path_induction.
Defined.

Lemma opposite_opposite_opposite {A} (x y : A) (p : x = y) :
  opposite2 (opposite_opposite p) =
  opposite_opposite (!p).
Proof.
  path_induction.
Defined.

Lemma opposite_opposite_natural {A} (x y : A) (p q : x = y) (r : p = q) :
  opposite2 (opposite2 r) @ opposite_opposite q =
  opposite_opposite p @ r.
Proof.
  path_induction.
Defined.

Definition opposite2_equiv {A} (x y : A) (p q : x = y) : (p = q) <~> (!p = !q).
Proof.
  apply (equiv_from_hequiv (@opposite2 A x y p q) (unopposite2 p q)).
  intros r.
  unfold unopposite2.
  path_via' (opposite2 (!opposite_opposite p) @
    opposite2 (opposite2 r @ opposite_opposite q)).
  apply opposite2_functor.
  path_via' (!opposite2 (opposite_opposite p) @
    opposite2 (opposite2 r @ opposite_opposite q)).
  apply whisker_right.
  apply opposite2_opposite.
  path_via' (!(opposite_opposite (!p)) @
   opposite2 (opposite2 r @ opposite_opposite q)).
  apply whisker_right.
  apply map.
  apply opposite_opposite_opposite.
  moveright_onleft.
  path_via (opposite2 (opposite2 r) @ opposite2 (opposite_opposite q)).
  apply opposite2_functor.
  path_via' (opposite2 (opposite2 r) @ opposite_opposite (!q)).
  apply whisker_left.
  apply opposite_opposite_opposite.
  apply opposite_opposite_natural.
  intros r.
  unfold unopposite2.
  moveright_onleft.
  rewrite opposite_opposite_natural. hott_simpl.
Defined.

(** Transporting is an equivalence. *)

Theorem trans_equiv {A} {P : fibration A} {x y : A} (p : x = y) :
  P x <~> P y.
Proof.
  apply (equiv_from_hequiv (transport (P := P) p) (transport (P := P) (!p))).
  intros z.
  (** XXX find out why [hott_simpl] cycles in 8.4 at this point. *)
  apply trans_trans_opp.
  intros z.
  apply trans_opp_trans.
Defined.

(** We can characterize the path types of the total space of a
   fibration, up to equivalence. *)

Theorem total_paths_equiv (A : Type) (P : fibration A) (x y : total P) :
  (x = y) <~> { p : pr1 x = pr1 y & transport p (pr2 x) = pr2 y }.
Proof.
  apply (equiv_from_hequiv
     (fun r => existT (fun p => transport p (pr2 x) = pr2 y) (base_path r) (fiber_path r))
     (fun (pq : { p : pr1 x = pr1 y & transport p (pr2 x) = pr2 y }) =>
          @total_path A P x y (projT1 pq) (projT2 pq))).
  intros [p q].
  simpl.
  apply @total_path with (p := base_total_path q).
  simpl.
  apply fiber_total_path.
  intro r.
  simpl.
  apply total_path_reconstruction.
Defined.

(** And similarly for products. *)

Lemma prod_eta A B (u : A * B) : (fst u, snd u) = u.
Proof.
  destruct u; path_induction.
Defined.

Definition prod_path_equiv A B (x y : A * B) :
  (x = y) <~> ((fst x = fst y) * (snd x = snd y)).
Proof.
  apply (equiv_from_hequiv
    (fun p => (map (x:=x) (y:=y) (@fst A B) p, map (@snd A B) p))
    (fun (u : (fst x = fst y) * (snd x = snd y)) =>
      !prod_eta A B x @ prod_path (fst u) (snd u) @ prod_eta A B y)).
  intros [p q].
  destruct x; destruct y.
  simpl in * |- *.
  path_induction.
  intro p.
  path_induction.
  destruct x; auto.
Defined.

(** The homotopy fiber of a fibration is equivalent to the actual fiber. *)

Section hfiber_fibration.

  Hypothesis X : Type.
  Hypothesis P : fibration X.

  Let hfiber_fibration_map (x : X) : { z : total P & pr1 z = x } -> P x.
  Proof.
    intros [z p].
    apply (transport p).
    exact (pr2 z).
  Defined.

  Let hfiber_fibration_map_path (x : X) (z : total P) (p : pr1 z = x) :
    (x ; hfiber_fibration_map x (z ; p)) = z.
  Proof.
    apply @total_path with (p := !p).
    destruct z as [x' y']. simpl.
    apply trans_opp_trans.
  Defined.

  Definition hfiber_fibration (x : X) :
    P x <~> { z : total P & pr1 z = x }.
  Proof.
  apply (  equiv_from_hequiv
      (fun y: P x => (((x ; y) ; idpath _) : {z : sigT P & pr1 z = x}))
      (hfiber_fibration_map x)).
    intros [z p].
    apply @total_path with (p := hfiber_fibration_map_path x z p). simpl.
    path_via (transport (P := fun x' => x' = x)
      (map pr1 (hfiber_fibration_map_path x z p))
      (idpath x)).
    apply @map_trans with (P := fun x' => x' = x).
    unfold hfiber_fibration_map_path.
    path_via (transport (P := fun x' => x' = x) (!p) (idpath x)).
    apply map with (f := fun r => transport (P := fun x' => x' = x) r (idpath x)).
    apply @base_total_path with
      (x := (x ; hfiber_fibration_map x (z ; p))).
    path_via ((!!p) @ idpath x).
    cancel_units.
    intros y.
    unfold hfiber_fibration_map. simpl. auto.
  Defined.

End hfiber_fibration.

(** Replacement of a map by an equivalent fibration. *)

Section FibrationReplacement.

  Hypothesis A B : Type.
  Hypothesis f : A -> B.

  Definition fibration_replacement (x : A) : {y : B & {x : A & f x = y}} :=
    (f x ; (x ; idpath (f x))).

  Definition fibration_replacement_equiv : A <~> {y : B & {x : A & f x = y}}.
  Proof.
  apply (  equiv_from_hequiv
      fibration_replacement (fun (yxp : {y : B & {x : A & f x = y}}) => pr1 (pr2 yxp))).
    intros [y [x p]].
    unfold fibration_replacement; simpl.
    apply @total_path with (p := p); simpl.
    hott_simpl.
    (* This step needed in 8.3 but not 8.4. *)
    try (rewrite map_trans; hott_simpl).
    intros x. auto.
  Defined.

  Definition fibration_replacement_factors (x : A) :
    pr1 (fibration_replacement_equiv x) = f x.
  Proof.
    auto.
  Defined.

End FibrationReplacement.

(** The construction of total spaces of fibrations is "associative". *)

Section TotalAssoc.

  Hypotheses (A : Type) (P : fibration A) (Q : forall x, fibration (P x)).

  Let ta1 : { x : A & { p : P x & Q x p}} -> { xp : total P & Q (pr1 xp) (pr2 xp) }.
  Proof.
    intros [x [p q]].
    exists (x;p).
    exact q.
  Defined.

  Let ta2 : { xp : sigT P & Q (pr1 xp) (pr2 xp) } -> { x:A & { p:P x & Q x p}}.
  Proof.
    intros [[x p] q].
    exists x. exists p. exact q.
  Defined.

  Definition total_assoc :
    { x : A & { p : P x & Q x p}} <~> { xp : sigT P & Q (pr1 xp) (pr2 xp) }.
  Proof.
    apply (equiv_from_hequiv ta1 ta2).
    intros [[x p] q]; auto.
    intros [x [p q]]; auto.
  Defined.

End TotalAssoc.

Section TotalAssocSum.

  Hypotheses (A : Type) (P : fibration A) (Q : total P -> Type).

  Let ta1 : {x : A & {p : P x & Q (x ; p)}} -> {xp : total P & Q xp}.
  Proof.
    intros [x [p q]].
    exists (x;p).
    exact q.
  Defined.

  Let ta2 : {xp : total P & Q xp} -> {x : A & {p : P x & Q (x ; p)}}.
  Proof.
    intros [[x p] q].
    exists x. exists p. exact q.
  Defined.

  Definition total_assoc_sum :
    {x : A & {p : P x & Q (x;p)}} <~> {xp : total P & Q xp}.
  Proof.
    apply (equiv_from_hequiv ta1 ta2).
    intros [[x p] q]; auto.
    intros [x [p q]]; auto.
  Defined.

End TotalAssocSum.

(** And "commutative" *)

Section TotalComm.

  Hypotheses (A : Type) (B : Type) (P : A -> B -> Type).

  Let tc1 : {x : A & {y : B & P x y}} -> {y : B & {x:A & P x y}}.
  Proof.
    intros [x [y p]].
    exists y.  exists x.  exact p.
  Defined.

  Let tc2 : {y : B & {x : A & P x y}} -> {x : A & {y : B & P x y}}.
  Proof.
    intros [y [x p]].
    exists x.  exists y.  exact p.
  Defined.

  Definition total_comm :
    {x : A & {y : B & P x y}} <~> {y : B & {x : A & P x y}}.
  Proof.
    apply (equiv_from_hequiv tc1 tc2).
    intros [x [y p]]; auto.
    intros [y [x p]]; auto.
  Defined.

End TotalComm.

(** Transporting along a path is an "adjoint equivalence". *)

Lemma transport_adjoint A (P : fibration A) (x y : A) (p : x = y)
  (a : P x) (b : P y) :
  (transport p a = b) <~> (a = transport (!p) b).
Proof.
  path_induction.
  simpl.
  apply idequiv.
Defined.

(** The product of two equivalences is an equivalence. *)

Lemma product_equiv (A B C D : Type):
  (A <~> B) -> (C <~> D) -> (A * C <~> B * D).
Proof.
  intros f g.
  apply (equiv_from_hequiv
    (fun ac => (f (fst ac), g (snd ac)))
    (fun bd => (f^-1 (fst bd), g^-1 (snd bd)))) ;
  intros [? ?]; simpl; apply prod_path; hott_simpl.
Defined.

(** Products are equivalent to pullbacks over any contractible type. *)

Section PullbackContr.

  Hypotheses A B C : Type.
  Hypothesis Cc : is_contr C.
  Hypothesis (f : A -> C) (g : B -> C).

  Let pbu1 : {x : A & {y : B & f x = g y}} -> A * B.
  Proof.
    intros [a [b p]].
    exact (a,b).
  Defined.

  Let pbu2 : A * B -> {x : A & {y : B & f x = g y}}.
  Proof.
    intros [a b].
    exists a; exists b; apply contr_path, Cc.
  Defined.

  Definition pullback_over_contr : {x : A & {y : B & f x = g y}} <~> A * B.
  Proof.
    apply (equiv_from_hequiv pbu1 pbu2).
    intros [a b]; simpl; auto.
    intros [a [b p]]; simpl.
    apply @total_path with (idpath a). simpl.
    apply @total_path with (idpath b); simpl.
    apply contr_path2. apply Cc.
  Defined.

End PullbackContr.


(* Definition f (n : nat) : nat := n + 1.
Eval compute  in f 3. *)

Inductive day : Type :=
  | monday : day
  | tuesday : day
  | wednesday : day
  | thursday : day
  | friday : day
  | saturday : day
  | sunday : day.

Definition next_weekday (d:day) : day :=
  match d with
  | monday => tuesday
  | tuesday => wednesday
  | wednesday => thursday
  | thursday => friday
  | friday => monday
  | saturday => monday
  | sunday => monday
  end.

Compute (next_weekday friday).

Example test_next_weekday:
  (next_weekday (next_weekday saturday)) = tuesday.

(* "The assertion we've just made can be proved by observing that
both sides of the equality evaluate to the same thing, after some simplification."*)
Proof. simpl. reflexivity. Qed.

Inductive bool : Type :=
  | true: bool
  | false: bool.

Definition is_weekday (d:day) : bool :=
  match d with
    | monday => true
    | tuesday => true
    | wednesday => true
    | thursday => true
    | friday => true
    | saturday => false
    | sunday => false
  end.

Definition nandb (b1:bool) (b2:bool) : bool :=
  match b1 with
    | true => negb b2
    | false => true
  end.

Example test_nandb1: (nandb false false) = true.
Proof. simpl. reflexivity. Qed.
Example test_nandb2: (nandb false true) = true.
Proof. simpl. reflexivity. Qed.
Example test_nandb3: (nandb true false) = true.
Proof. simpl. reflexivity. Qed.
Example test_nandb4: (nandb true true) = false.
Proof. simpl. reflexivity. Qed.


(* This file is generated by Why3's Coq driver *)
(* Beware! Only edit allowed sections below    *)
Require Import ZArith.
Require Import Rbase.
Require int.Int.
Require real.Real.
Require real.RealInfix.

Parameter pow2: Z -> R.

Axiom Power_0 : ((pow2 0%Z) = 1%R).

Axiom Power_s : forall (n:Z), (0%Z <= n)%Z ->
  ((pow2 (n + 1%Z)%Z) = (2%R * (pow2 n))%R).

Axiom Power_p : forall (n:Z), (n <= 0%Z)%Z ->
  ((pow2 (n - 1%Z)%Z) = ((05 / 10)%R * (pow2 n))%R).

Axiom Power_s_all : forall (n:Z), ((pow2 (n + 1%Z)%Z) = (2%R * (pow2 n))%R).

Axiom Power_p_all : forall (n:Z),
  ((pow2 (n - 1%Z)%Z) = ((05 / 10)%R * (pow2 n))%R).

Axiom Power_1_2 : ((05 / 10)%R = (Rdiv 1%R 2%R)%R).

Axiom Power_1 : ((pow2 1%Z) = 2%R).

Axiom Power_neg1 : ((pow2 (-1%Z)%Z) = (05 / 10)%R).

Axiom Power_non_null_aux : forall (n:Z), (0%Z <= n)%Z -> ~ ((pow2 n) = 0%R).

Axiom Power_neg_aux : forall (n:Z), (0%Z <= n)%Z ->
  ((pow2 (-n)%Z) = (Rdiv 1%R (pow2 n))%R).

Axiom Power_non_null : forall (n:Z), ~ ((pow2 n) = 0%R).

Axiom Power_neg : forall (n:Z), ((pow2 (-n)%Z) = (Rdiv 1%R (pow2 n))%R).

Axiom Power_sum_aux : forall (n:Z) (m:Z), (0%Z <= m)%Z ->
  ((pow2 (n + m)%Z) = ((pow2 n) * (pow2 m))%R).

Require Import Why3.
Ltac ae := why3 "alt-ergo" timelimit 2.
Open Scope Z_scope.

(* Why3 goal *)
Theorem Power_sum : forall (n:Z) (m:Z),
  ((pow2 (n + m)%Z) = ((pow2 n) * (pow2 m))%R).
intros n m.
assert (h:m>=0 \/ m <=0) by omega; destruct h.
apply Power_sum_aux; auto with zarith.
pose (m' := -m).
assert (0 <= m') by (subst m'; omega).
replace m with (-m') by (subst m'; omega).
replace (n+ - m') with (- ((-n) + m')) by omega.
repeat rewrite Power_neg; auto.
rewrite Power_sum_aux; auto.
ae.
Qed.


Require Export A_6_3.

Module A12_1.

(* 级数的收敛性 *)

(* 定义：无穷级数(定义为数列前n项和构成的一个新数列，也即部分和数列) *)
Definition Series (u : Seq) : Seq :=
  {` λ n v, v = Σ u n `}.

Lemma SeriesSeq : ∀ (u : Seq), IsSeq (Series u).
Proof.
  intros u. split.
  - unfold Function. intros x y z H1 H2. applyAxiomII' H1.
    applyAxiomII' H2. rewrite H2. assumption.
  - apply AxiomI. intro z; split; intro H1.
    + apply AxiomII. reflexivity.
    + apply AxiomII. exists (Σ u z). apply AxiomII'.
      reflexivity.
Qed.

(* 定理: 级数的第n项为对应数列的前n项和 *)
Lemma SeriesValue : ∀ (u : Seq) (n : nat),
  (Series u)[n] = Σ u n.
Proof.
  intros u n. generalize (SeriesSeq u); intros [H1 H2].
  apply f_x; auto. apply AxiomII'. reflexivity.
Qed.

(* 定义：级数收敛 *)
Definition ConSer u := Convergence (Series u).
(* 定义：级数发散 *)
Definition DivSer u := ~ ConSer u.

(* 柯西准则 *)
Theorem Theorem12_1 : ∀ (u : Seq),
  (ConSer u <-> (∀ ε, ε > 0 -> ∃ N : nat,
     ∀ (m p : nat), (N < m)%nat ->
     Abs[Σ {` λ n v, v = u[(m+n)%nat] `} p] < ε)).
Proof.
  intros u.
  generalize (SeriesSeq u); intros H1.
  generalize (Theorem2_11 (Series u) H1).
  intros H2. destruct H2 as [H2 H3].
  assert (H4 : ∀ m p, (Series u)[(S m + p)%nat]
    - (Series u)[m] = Σ {` λ n v,
    v = u[(S m + n)%nat] `} p).
  { intros m p.
    assert (I1 : Function {`λ n v, v =
      u [S (m + n)]`}).
    { intros x y z J1 J2.
      applyAxiomII' J1; applyAxiomII' J2.
      rewrite J2; assumption. }
    assert (I2 : ∀ n, {`λ n v, v =
      u [S (m + n)]`}[n] = u [S (m + n)]).
    { intros n. apply f_x; auto.
      apply AxiomII'. reflexivity. }
    induction p as [|p IHp].
    - rewrite Nat.add_0_r.
      rewrite SeriesValue; auto.
      rewrite SeriesValue; auto.
      simpl Σ. rewrite I2. rewrite Nat.add_0_r.
      field.
    - repeat rewrite SeriesValue; auto.
      rewrite Nat.add_succ_r. simpl.
      repeat rewrite SeriesValue in IHp; auto.
      simpl in IHp. rewrite <- IHp.
      rewrite I2. rewrite Nat.add_succ_r.
      field. }
  split.
  - intros I1 ε I2.
    generalize (H2 I1 ε I2).
    intros [N I3]. exists (S N).
    intros m p I4. destruct m as [|m].
    + apply Nat.nlt_0_r in I4.
      contradiction.
    + apply lt_S_n in I4.
      assert (I5 : (N < S m + p)%nat).
      { apply Nat.lt_lt_succ_r in I4.
        apply Nat.lt_lt_add_r.
        assumption. }
      generalize (I3 (S m + p)%nat m I5 I4).
      intros I6. rewrite <- H4.
      assumption.
  - intros I1. apply H3.
    intros ε I2. apply I1 in I2 as I3.
    destruct I3 as [N I3].
    exists N. intros n m I4 I5.
    destruct (Nat.lt_trichotomy m n) as [I6 | [I6 | I6]].
    + apply Nat.lt_lt_succ_r in I5 as J3.
      assert (J1 : (n = S m + (n - S m))%nat).
      { symmetry. apply le_plus_minus_r.
        apply gt_le_S. apply I6. }
      generalize (I3 (S m) (n - S m)%nat J3); intros J2.
      rewrite J1 in J2. rewrite minus_plus in J2.
      rewrite <- H4 in J2. rewrite J1.
      assumption.
    + rewrite I6. apply Abs_R. lra.
    + apply Nat.lt_lt_succ_r in I4 as J3.
      assert (J1 : (m = S n + (m - S n))%nat).
      { symmetry. apply le_plus_minus_r.
        apply gt_le_S. apply I6. }
      generalize (I3 (S n) (m - S n)%nat J3); intros J2.
      rewrite J1 in J2. rewrite minus_plus in J2.
      rewrite <- H4 in J2. rewrite <- J1 in J2.
      rewrite Abs_eq_neg. rewrite Ropp_minus_distr.
      assumption.
Qed.

Theorem Theorem12_1' : ∀ (u : Seq), IsSeq u -> ConSer u
  -> limit_seq u 0.
Proof.
  intros u H0 H1. split; auto.
  intros ε H2.
  generalize (Theorem12_1 u); intros [H3 H4].
  generalize (H3 H1 ε H2). clear H3 H4.
  intros [N H3]. exists N.
  intros n H4. generalize (H3 n O H4).
  simpl. intros H5.
  assert (H6 : {` λ n0 v, v =
    u[(n + n0)%nat] `} [0%nat] = u[n] - 0).
  { apply f_x.
    - intros x y z J1 J2.
      applyAxiomII' J1; applyAxiomII' J2.
      rewrite J2; assumption.
    - apply AxiomII'. rewrite Nat.add_0_r.
      field. }
  rewrite H6 in H5. assumption.
Qed.

(* 若数列u收敛于a，则k*u收敛于k*a *)
Lemma Lemma12_1_1 : ∀ (u : Seq) (a k : R), limit_seq u a
  -> limit_seq {` λ n v, v = k * u[n] `} (k * a).
Proof.
  intros u a k [H0 H1].
  assert (H2 : IsSeq {` λ n v, v = k * u[n] `}).
  { split.
    - unfold Function. intros x y z I1 I2.
      applyAxiomII' I1. applyAxiomII' I2.
      rewrite I2. assumption.
    - apply AxiomI. intro z; split; intro I1.
      + apply AxiomII. reflexivity.
      + apply AxiomII. exists (k * u[z]). apply AxiomII'.
        reflexivity. }
  split; auto. intros ε H3. destruct H2 as [H2 H6].
  destruct classic with (P := k = 0) as [H4 | H4].
  - rewrite H4 in *. exists 0%nat. intros n H5.
    assert (H7 : {` λ(n0 : nat)(v : R),v = 0 * u [n0] `} [n] = 0).
    { apply f_x; auto. apply AxiomII'. field. }
    rewrite H7. assert (H8 : 0 - 0 * a = 0). field.
    rewrite H8. rewrite Abs_ge; lra.
  - apply Abs_not_eq_0 in H4 as H5.
    assert (H7 : ε / Abs[k] > 0).
    { apply Rdiv_lt_0_compat; auto. }
    apply H1 in H7 as [N H8]. exists N. intros n H9.
    apply H8 in H9 as H10.
    assert (H11 : {` λ n0 v, v = k * u [n0] `} [n] = k * u[n]).
    { apply f_x; auto. apply AxiomII'. reflexivity. }
    rewrite H11. assert (H12 : k * u [n] - k * a
      = k * (u[n] - a)). field.
    rewrite H12. rewrite Abs_mult.
    apply Rmult_lt_compat_l with (r := Abs[k]) in H10; auto.
    assert (H13 : Abs [k] * (ε / Abs [k]) = ε). field; try lra.
    rewrite H13 in H10. assumption.
Qed.

Theorem Theorem12_2 : ∀ (u v : Seq) (c d a b : R),
  limit_seq (Series u) a -> limit_seq (Series v) b
  -> limit_seq (Series {` λ n s, s = c*u[n] + d*v[n] `}) (c*a + d*b).
Proof.
  intros u v c d a b H0 H1.
  generalize (Lemma12_1_1 (Series u) a c H0).
  intros H2.
  generalize (Lemma12_1_1 (Series v) b d H1).
  intros H3.
  assert (H4 : ∀ (w : Seq) (e : R), Function
    {` λ n1 v1, v1 = e * (Series w)[n1] `}).
  { intros w e x y z J1 J2.
    applyAxiomII' J1; applyAxiomII' J2.
    rewrite J2; assumption. }
  assert (H5 : ∀ (w : Seq) (e : R) m,
    {` λ n1 v1, v1 = e * (Series w)[n1] `}[m] =
    e * (Series w)[m]).
  { intros w e m. apply f_x; try apply H4.
    apply AxiomII'. reflexivity. }
  assert (H6 : Function {` λ n1 s, s = c*u[n1] + d*v[n1] `}).
  { intros x y z J1 J2.
    applyAxiomII' J1; applyAxiomII' J2.
    rewrite J2; assumption. }
  assert (H7 : ∀ n, {` λ n1 s, s = c*u[n1] + d*v[n1] `}[n]
    = c*u[n] + d*v[n]).
  { intros n. apply f_x; try apply H6.
    apply AxiomII'. reflexivity. }
  assert (H8 : ∀ n, Σ {` λ n s, s = c*u [n] + d*v [n] `} n =
    c * Σ u n + d * Σ v n).
  { intros n. induction n as [|n IHn].
    - simpl. rewrite H7. reflexivity.
    - simpl. rewrite H7. rewrite IHn.
      field. }
  assert (H9 : Series {` λ n s, s = c*u[n] + d*v[n] `} =
    {` λ n s, s = {` λ n1 v1, v1 = c * (Series u)[n1] `}[n]
    + {` λ n1 v1, v1 = d * (Series v)[n1] `}[n] `}).
  { apply AxiomI. intros [n s]; split; intros I1;
    applyAxiomII' I1; apply AxiomII'.
    - repeat rewrite H5. repeat rewrite SeriesValue.
      rewrite I1. auto.
    - rewrite I1. repeat rewrite H5.
      repeat rewrite SeriesValue.
      rewrite H8. reflexivity. }
  rewrite H9. clear H9. apply Theorem2_7_1'; auto.
Qed.

(* 定理: 一个级数去掉前面有限项后不改变敛散性 *)
Theorem Theorem12_3 : ∀ (u : Seq) (M : nat), IsSeq u
   -> ConSer {` λ n v, v = u[(n + M)%nat] `} <-> ConSer u.
Proof.
  intros u M H0. split; intros H1.
  - induction M as [|M IHM].
    + assert (H2 :  {` λ(n : nat)(v : R),v = u [(n + 0)%nat] `} = u).
      { apply AxiomI. intro z. split; intro I1.
        - applyAxiomII I1. destruct I1 as [x [y [I1 I2]]].
          rewrite I1. rewrite I2. rewrite Nat.add_0_r.
          destruct H0 as [H0 I3]. apply x_fx; auto.
          rewrite I3. apply AxiomII. reflexivity.
        - apply AxiomII. destruct z as [x y].
          exists x, y. split; auto. rewrite Nat.add_0_r.
          apply f_x in I1; try apply H0. rewrite I1. reflexivity. }
      rewrite H2 in H1. assumption.
    + apply IHM. destruct H1 as [A H1]. exists (A + u[M]).
      assert (H2 : IsSeq (Series {` λ(n : nat)(v : R),
        v = u [(n + M)%nat] `})).
      { unfold IsSeq. split.
        - unfold Function. intros x y z I1 I2.
          applyAxiomII' I1. applyAxiomII' I2.
          rewrite I2. assumption.
        - apply AxiomI. intro z. split; intro I1.
          + apply AxiomII. reflexivity.
          + apply AxiomII. exists (Σ {` λ(n : nat)(v : R),
            v = u [(n + M)%nat] `} z).
            apply AxiomII'. reflexivity. }
      split; auto. intros ε H3. destruct H1 as [H1 H4].
      apply H4 in H3 as [N H5]. exists (S N).
      assert (H7 : ∀ N, IsSeq {` λ(n : nat)(v : R),v = u [(n + N)%nat] `}).
      { intro N0. split.
        - unfold Function. intros x y z I1 I2.
          applyAxiomII' I1. applyAxiomII' I2.
          rewrite I2. assumption.
        - apply AxiomI. intro z; split; intro I1.
          + apply AxiomII. reflexivity.
          + apply AxiomII. exists (u[(z + N0)%nat]).
            apply AxiomII'. reflexivity. }
      assert (H8 : ∀ n K, {` λ(n : nat)(v : R),v = u [(n + K)%nat] `} [n]
        = u [(n + K)%nat]).
      { intros n K. apply f_x; try apply H7. apply AxiomII'.
        reflexivity. }
      assert (H9 : ∀ n : nat, u[M]+ Σ {` λ(n0 : nat)(v : R),
        v = u [(n0 + S M)%nat] `} n =
        Σ {` λ(n0 : nat)(v : R),v = u [(n0 + M)%nat] `} (S n)).
      { intro n. induction n as [|n IHn].
        - simpl. rewrite H8. rewrite H8. rewrite H8. simpl.
          reflexivity.
        - simpl. repeat rewrite H8. rewrite <- Rplus_assoc.
          rewrite IHn. simpl. rewrite H8. rewrite Nat.add_succ_l.
          rewrite <- plus_n_Sm. reflexivity. }
      intros n H10. rewrite SeriesValue; auto.
      assert (H11 : ∃ n0, n = S n0).
      { apply Nat.neq_0_r. apply not_eq_sym. apply lt_0_neq.
        apply Nat.lt_lt_0 with (n := (S N)). assumption. }
      destruct H11 as [n0 H11]. rewrite H11 in *.
      apply gt_S_n in H10. apply H5 in H10 as H12.
      generalize (H9 n0). intro H13. rewrite SeriesValue in H12; auto.
      assert (H14 : Σ {` λ(n1 : nat)(v : R),v = u [(n1 + M)%nat] `}
        (S n0) - (A + u [M]) = Σ {` λ(n : nat)(v : R),
        v = u [(n + S M)%nat] `} n0 - A).
      { rewrite <- H13. field. }
      rewrite H14. assumption.
  - induction M as [|M IHM].
    + assert (H2 :  {` λ(n : nat)(v : R),v = u [(n + 0)%nat] `} = u).
      { apply AxiomI. intro z. split; intro I1.
        - applyAxiomII I1. destruct I1 as [x [y [I1 I2]]].
          rewrite I1. rewrite I2. rewrite Nat.add_0_r.
          destruct H0 as [H0 I3]. apply x_fx; auto.
          rewrite I3. apply AxiomII. reflexivity.
        - apply AxiomII. destruct z as [x y].
          exists x, y. split; auto. rewrite Nat.add_0_r.
          apply f_x in I1; try apply H0. rewrite I1. reflexivity. }
      rewrite H2. assumption.
    + unfold Convergence in IHM. destruct IHM as [a [H2 H3]].
      exists (a - u[M]).
      assert (H21 : IsSeq {` λ(n : nat)(v : R),v = u [(n + S M)%nat] `}).
      { split.
        * unfold Function. intros x y z I1 I2.
          applyAxiomII' I1. applyAxiomII' I2.
          rewrite I2. assumption.
        * apply AxiomI. intro n; split; intro I1.
          -- apply AxiomII. reflexivity.
          -- apply AxiomII. exists (u[(n + S M)%nat]).
            apply AxiomII'. reflexivity. }
      generalize (SeriesSeq {`λ n v, v = u [(n + S M)%nat]`});
      intros H20.
      split; auto. intros ε H4. apply H3 in H4 as [N H5].
      exists N. intros n H6. apply Nat.lt_lt_succ_r in H6 as H7.
      apply H5 in H7 as H8. rewrite SeriesValue; auto.
      assert (H9 : IsSeq {` λ(n0 : nat)(v : R), v = u [(n0 + M)%nat] `}).
      { split.
        * unfold Function. intros x y z I1 I2.
          applyAxiomII' I1. applyAxiomII' I2.
          rewrite I2. assumption.
        * apply AxiomI. intro n0; split; intro I1.
          -- apply AxiomII. reflexivity.
          -- apply AxiomII. exists (u[(n0 + M)%nat]).
            apply AxiomII'. reflexivity. }
      rewrite SeriesValue in H8; auto.
      assert (H10 : ∀ n, Σ {` λ(n : nat)(v : R),
        v = u [(n + M)%nat] `} (S n) - a = Σ
        {` λ(n0 : nat)(v : R),v = u [(n0 + S M)%nat] `}
        n - (a - u [M])).
      { intro n0. induction n0 as [|n0 IHn].
        - simpl. assert (I1 : {` λ(n0 : nat)(v : R),v = u [(n0 + M)%nat] `}
            [0%nat] = u[M]).
          { apply f_x; try apply H9. apply AxiomII'. rewrite plus_O_n.
            reflexivity. }
          assert (I2 : {` λ(n0 : nat)(v : R),v = u [(n0 + M)%nat] `}
            [1%nat] = u[S M]).
          { apply f_x; try apply H9. apply AxiomII'. rewrite (Nat.add_1_l M).
            reflexivity. }
          assert (I3 : {` λ(n0 : nat)(v : R),v = u [(n0 + S M)%nat] `}
            [0%nat] = u[S M]).
          { apply f_x; try apply H21. apply AxiomII'. rewrite plus_O_n.
            reflexivity. }
          rewrite I1. rewrite I2. rewrite I3. field.
        - simpl. assert (I1 : ∀ n1, {` λ n0 v,v = u [(n0 + M)%nat] `}
            [n1] = u[(n1 + M)%nat]).
          { intro n1. apply f_x; try apply H9. apply AxiomII'.
            reflexivity. }
          simpl in IHn. rewrite I1 in IHn. rewrite I1. rewrite I1.
          assert (I2 : ∀ n1, {` λ n0 v,v = u [(n0 + S M)%nat] `}
            [n1] = u[(n1 + S M)%nat]).
          { intro n1. apply f_x; try apply H21. apply AxiomII'.
            reflexivity. }
          rewrite I2. assert (I3 : (S (S n0) + M)%nat = (S n0 + S M)%nat).
          { simpl. rewrite Nat.add_succ_r. reflexivity. }
          rewrite I3. lra. }
      rewrite H10 in H8. assumption.
Qed.

(* 定义：从第m项开始连续加n+1项 *)
Fixpoint sum_n (x : Seq) (m n : nat) :=
  match n with
  | 0%nat => x[m]
  | S n => Σ x n + x[S n]
  end.

End A12_1.

Export A12_1.


(************************************************************************)
(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2011     *)
(*   \VV/  **************************************************************)
(*    //   *      This file is distributed under the terms of the       *)
(*         *       GNU Lesser General Public License Version 2.1        *)
(************************************************************************)

(* $Id: Zbool.v 14641 2011-11-06 11:59:10Z herbelin $ *)

Require Import BinInt.
Require Import Zeven.
Require Import Zorder.
Require Import Zcompare.
Require Import ZArith_dec.
Require Import Sumbool.

Unset Boxed Definitions.
Open Local Scope Z_scope.

(** * Boolean operations from decidability of order *)
(** The decidability of equality and order relations over
    type [Z] gives some boolean functions with the adequate specification. *)

Definition Z_lt_ge_bool (x y:Z) := bool_of_sumbool (Z_lt_ge_dec x y).
Definition Z_ge_lt_bool (x y:Z) := bool_of_sumbool (Z_ge_lt_dec x y).

Definition Z_le_gt_bool (x y:Z) := bool_of_sumbool (Z_le_gt_dec x y).
Definition Z_gt_le_bool (x y:Z) := bool_of_sumbool (Z_gt_le_dec x y).

Definition Z_eq_bool (x y:Z) := bool_of_sumbool (Z_eq_dec x y).
Definition Z_noteq_bool (x y:Z) := bool_of_sumbool (Z_noteq_dec x y).

Definition Zeven_odd_bool (x:Z) := bool_of_sumbool (Zeven_odd_dec x).

(**********************************************************************)
(** * Boolean comparisons of binary integers *)

Definition Zle_bool (x y:Z) :=
  match x ?= y with
    | Gt => false
    | _ => true
  end.

Definition Zge_bool (x y:Z) :=
  match x ?= y with
    | Lt => false
    | _ => true
  end.

Definition Zlt_bool (x y:Z) :=
  match x ?= y with
    | Lt => true
    | _ => false
  end.

Definition Zgt_bool (x y:Z) :=
  match x ?= y with
    | Gt => true
    | _ => false
  end.

Definition Zeq_bool (x y:Z) :=
  match x ?= y with
    | Eq => true
    | _ => false
  end.

Definition Zneq_bool (x y:Z) :=
  match x ?= y with
    | Eq => false
    | _ => true
  end.

(** Properties in term of [if ... then ... else ...] *)

Lemma Zle_cases :
  forall n m:Z, if Zle_bool n m then (n <= m) else (n > m).
Proof.
  intros x y; unfold Zle_bool, Zle, Zgt in |- *.
  case (x ?= y); auto; discriminate.
Qed.

Lemma Zlt_cases :
  forall n m:Z, if Zlt_bool n m then (n < m) else (n >= m).
Proof.
  intros x y; unfold Zlt_bool, Zlt, Zge in |- *.
  case (x ?= y); auto; discriminate.
Qed.

Lemma Zge_cases :
  forall n m:Z, if Zge_bool n m then (n >= m) else (n < m).
Proof.
  intros x y; unfold Zge_bool, Zge, Zlt in |- *.
  case (x ?= y); auto; discriminate.
Qed.

Lemma Zgt_cases :
  forall n m:Z, if Zgt_bool n m then (n > m) else (n <= m).
Proof.
  intros x y; unfold Zgt_bool, Zgt, Zle in |- *.
  case (x ?= y); auto; discriminate.
Qed.

(** Lemmas on [Zle_bool] used in contrib/graphs *)

Lemma Zle_bool_imp_le : forall n m:Z, Zle_bool n m = true -> (n <= m).
Proof.
  unfold Zle_bool, Zle in |- *. intros x y. unfold not in |- *.
  case (x ?= y); intros; discriminate.
Qed.

Lemma Zle_imp_le_bool : forall n m:Z, (n <= m) -> Zle_bool n m = true.
Proof.
  unfold Zle, Zle_bool in |- *. intros x y. case (x ?= y); trivial. intro. elim (H (refl_equal _)).
Qed.

Lemma Zle_bool_refl : forall n:Z, Zle_bool n n = true.
Proof.
  intro. apply Zle_imp_le_bool. apply Zeq_le. reflexivity.
Qed.

Lemma Zle_bool_antisym :
  forall n m:Z, Zle_bool n m = true -> Zle_bool m n = true -> n = m.
Proof.
  intros. apply Zle_antisym. apply Zle_bool_imp_le. assumption.
  apply Zle_bool_imp_le. assumption.
Qed.

Lemma Zle_bool_trans :
  forall n m p:Z,
    Zle_bool n m = true -> Zle_bool m p = true -> Zle_bool n p = true.
Proof.
  intros x y z; intros. apply Zle_imp_le_bool. apply Zle_trans with (m := y). apply Zle_bool_imp_le. assumption.
  apply Zle_bool_imp_le. assumption.
Qed.

Definition Zle_bool_total :
  forall x y:Z, {Zle_bool x y = true} + {Zle_bool y x = true}.
Proof.
  intros x y; intros. unfold Zle_bool in |- *. cut ((x ?= y) = Gt <-> (y ?= x) = Lt).
  case (x ?= y). left. reflexivity.
  left. reflexivity.
  right. rewrite (proj1 H (refl_equal _)). reflexivity.
  apply Zcompare_Gt_Lt_antisym.
Defined.

Lemma Zle_bool_plus_mono :
  forall n m p q:Z,
    Zle_bool n m = true ->
    Zle_bool p q = true -> Zle_bool (n + p) (m + q) = true.
Proof.
  intros. apply Zle_imp_le_bool. apply Zplus_le_compat. apply Zle_bool_imp_le. assumption.
  apply Zle_bool_imp_le. assumption.
Qed.

Lemma Zone_pos : Zle_bool 1 0 = false.
Proof.
  reflexivity.
Qed.

Lemma Zone_min_pos : forall n:Z, Zle_bool n 0 = false -> Zle_bool 1 n = true.
Proof.
  intros x; intros. apply Zle_imp_le_bool. change (Zsucc 0 <= x) in |- *. apply Zgt_le_succ. generalize H.
  unfold Zle_bool, Zgt in |- *. case (x ?= 0). intro H0. discriminate H0.
  intro H0. discriminate H0.
  reflexivity.
Qed.

(** Properties in term of [iff] *)

Lemma Zle_is_le_bool : forall n m:Z, (n <= m) <-> Zle_bool n m = true.
Proof.
  intros. split. intro. apply Zle_imp_le_bool. assumption.
  intro. apply Zle_bool_imp_le. assumption.
Qed.

Lemma Zge_is_le_bool : forall n m:Z, (n >= m) <-> Zle_bool m n = true.
Proof.
  intros. split. intro. apply Zle_imp_le_bool. apply Zge_le. assumption.
  intro. apply Zle_ge. apply Zle_bool_imp_le. assumption.
Qed.

Lemma Zlt_is_lt_bool : forall n m:Z, (n < m) <-> Zlt_bool n m = true.
Proof.
intros n m; unfold Zlt_bool, Zlt.
destruct (n ?= m); simpl; split; now intro.
Qed.

Lemma Zgt_is_gt_bool : forall n m:Z, (n > m) <-> Zgt_bool n m = true.
Proof.
intros n m; unfold Zgt_bool, Zgt.
destruct (n ?= m); simpl; split; now intro.
Qed.

Lemma Zlt_is_le_bool :
  forall n m:Z, (n < m) <-> Zle_bool n (m - 1) = true.
Proof.
  intros x y. split. intro. apply Zle_imp_le_bool. apply Zlt_succ_le. rewrite (Zsucc_pred y) in H.
  assumption.
  intro. rewrite (Zsucc_pred y). apply Zle_lt_succ. apply Zle_bool_imp_le. assumption.
Qed.

Lemma Zgt_is_le_bool :
  forall n m:Z, (n > m) <-> Zle_bool m (n - 1) = true.
Proof.
  intros x y. apply iff_trans with (y < x). split. exact (Zgt_lt x y).
  exact (Zlt_gt y x).
  exact (Zlt_is_le_bool y x).
Qed.

Lemma Zeq_is_eq_bool : forall x y, x = y <-> Zeq_bool x y = true.
Proof.
  intros; unfold Zeq_bool.
  generalize (Zcompare_Eq_iff_eq x y); destruct Zcompare; intuition;
   try discriminate.
Qed.

Lemma Zeq_bool_eq : forall x y, Zeq_bool x y = true -> x = y.
Proof.
  intros x y H; apply <- Zeq_is_eq_bool; auto.
Qed.

Lemma Zeq_bool_neq : forall x y, Zeq_bool x y = false -> x <> y.
Proof.
  unfold Zeq_bool; red ; intros; subst.
  rewrite Zcompare_refl in H.
  discriminate.
Qed.

Lemma Zeq_bool_if : forall x y, if Zeq_bool x y then x=y else x<>y.
Proof.
  intros. generalize (Zeq_bool_eq x y)(Zeq_bool_neq x y).
  destruct Zeq_bool; auto.
Qed.


Require Import List.
Require Import Maps.
Require Import Ordering.

Set Implicit Arguments.

Theorem Forall_impl : forall A (P P': A -> Prop) l,
    (forall x, P x -> P' x) ->
    Forall P l ->
    Forall P' l.
Proof.
  induction l; simpl; intuition eauto.
  inversion H0; eauto.
Qed.

Module FSet.

  Section Sets.

    Variable A:Type.
    Context {Acmp:Ordering A}.

    Definition t := FMap.t A unit.
    Definition empty : t := FMap.empty.

    Definition elements (s:t) : list A :=
      FMap.keys s.

    Definition In x (s:t) :=
      FMap.In x s.

    Hint Unfold empty In : set.

    Ltac unfold_set :=
      intros;
      autounfold with set in *.

    Theorem _in_mapsto : forall x u s,
        FMap.MapsTo x u s ->
        In x s.
    Proof.
      unfold_set.
      apply FMap.mapsto_in in H; auto.
    Qed.

    Theorem _in_mapsto' : forall x s,
        FMap.In x s ->
        FMap.MapsTo x tt s.
    Proof.
      unfold_set.
      apply FMap.in_mapsto_exists in H.
      destruct H as [[] ?]; auto.
    Qed.

    Definition For_all (P:A -> Prop) (s:t) :=
      FMap.For_all (fun '(k, _) => P k) s.

    Hint Unfold For_all : set.

    Theorem empty_Forall : forall P,
        For_all P empty.
    Proof.
      unfold_set.
      apply FMap.empty_Forall.
    Qed.

     Theorem For_all_in (P:A -> Prop) (s:t) :
      For_all P s ->
      forall x, In x s -> P x.
    Proof.
      unfold_set.
      eapply FMap.For_all_in in H; eauto.
      apply _in_mapsto'; auto.
    Qed.

    Theorem not_in_forall : forall x s,
        ~In x s ->
        For_all (fun y => x <> y) s.
    Proof.
      unfold_set.
      eapply FMap.not_in_forall in H.
      eapply Forall_impl; eauto.
      intros.
      destruct x0; simpl in *; auto.
    Qed.

    Definition In_dec x s : {In x s} + {~In x s}.
      apply FMap.In_dec.
    Defined.

    Definition add (x:A) (s:t) : t :=
      FMap.add x tt s.

    Theorem add_forall : forall x P s,
        For_all P s ->
        P x ->
        For_all P (add x s).
    Proof.
      unfold_set.
      eapply FMap.add_forall; eauto.
    Qed.

    Theorem add_forall' : forall x P s,
        For_all P (add x s) ->
        For_all P s.
    Proof.
      unfold_set.
      destruct (FMap.In_dec x s).
      apply _in_mapsto' in i.
      assert (FMap.In x (add x s)).
      eapply FMap.add_in.
      apply _in_mapsto' in H0.
      assert (P x) by (eapply FMap.For_all_in in H; eauto).
      eapply FMap.add_forall'_in; eauto.
      eapply FMap.add_forall'; eauto.
    Qed.

    Theorem add_in : forall x s,
        In x (add x s).
    Proof.
      unfold_set.
      apply FMap.add_in.
    Qed.

    Theorem add_in' : forall x s y,
        In x (add y s) ->
        x = y \/ In x s.
    Proof.
      unfold_set.
      apply FMap.add_in' in H; auto.
    Qed.

    Theorem add_incr : forall x s y,
        In y s ->
        In y (add x s).
    Proof.
      unfold_set.
      apply FMap.add_incr; auto.
    Qed.

    Definition remove x (s:t) : t :=
      FMap.remove x s.

    Hint Unfold remove : set.

    Theorem remove_not_in : forall x s,
        ~In x (remove x s).
    Proof.
      unfold_set.
      apply FMap.remove_not_in.
    Qed.

    Theorem remove_in : forall x s y,
        In y s ->
        x <> y ->
        In y (remove x s).
    Proof.
      unfold_set.
      apply FMap.remove_in; auto.
    Qed.

    Theorem remove_in' : forall x s y,
        In x (remove y s) ->
        In x s /\ x <> y.
    Proof.
      unfold_set.
      apply FMap.remove_in'; auto.
    Qed.

    Theorem set_extensionality : forall s1 s2,
        (forall x, In x s1 <-> In x s2) ->
        s1 = s2.
    Proof.
      unfold_set.
      apply FMap.mapsto_extensionality; intuition.
      - destruct v.
        apply _in_mapsto in H0.
        apply _in_mapsto'.
        apply H; auto.
      - destruct v.
        apply _in_mapsto in H0.
        apply _in_mapsto'.
        apply H; auto.
    Qed.

    Definition filter (P: A -> bool) (s:t) : t :=
      FMap.filter P s.

    Theorem filter_in : forall P s x,
        In x (filter P s) ->
        In x s.
    Proof.
      unfold_set.
      eauto using FMap.filter_in.
    Qed.

    Theorem filter_spec : forall P s,
        For_all (fun y => P y = true) (filter P s).
    Proof.
      unfold_set.
      eauto using FMap.filter_spec.
    Qed.

    Theorem filter_complete : forall P s x,
        In x s ->
        P x = true ->
        In x (filter P s).
    Proof.
      unfold_set.
      eauto using FMap.filter_complete.
    Qed.

    Definition is_permutation (l : list A) (s : t) : Prop :=
      forall x, List.In x l <-> In x s.

  End Sets.

End FSet.

Arguments FSet.t A {Acmp}.


From mathcomp Require Import all_ssreflect.

Set Implicit Arguments.
Unset Strict Implicit.
Import Prenex Implicits.

Definition mySet (M:Type) := M -> Prop.
Definition belong {M:Type} (A:mySet M) (x:M) : Prop := A x.
Notation "x ∈ A" := (belong A x) (at level 11).
Axiom axiom_mySet : forall (M:Type)(A:mySet M),
  forall (x:M), (x ∈ A) \/ ~(x ∈ A).
Definition myEmptySet {M:Type} : mySet M := fun _ => False.
Definition myMotherSet {M:Type} : mySet M := fun _ => True.

Definition mySub {M} := fun (A B:mySet M) =>
  (forall (x:M), (x ∈ A) -> (x ∈ B)).
Notation "A ⊂ B" := (mySub A B) (at level 11).

Section 包含関係.
Variable M : Type.

Lemma Sub_Mother (A : mySet M) : A ⊂ myMotherSet.
Proof. by []. Qed.

Lemma Sub_Empty (A : mySet M) : myEmptySet ⊂ A.
Proof. by []. Qed.

Lemma rfl_Sub (A : mySet M) : (A ⊂ A).
Proof. by []. Qed.

Lemma transitive_Sub (A B C : mySet M) :
  (A ⊂ B) -> (B ⊂ C) -> (A ⊂ C).
Proof.
  move=> H1 H2 t H3.
  apply H2. apply H1.
  apply H3.
Qed.

End 包含関係.

Definition eqmySet {M : Type} :=
  fun (A B : mySet M) => (A ⊂ B /\ B ⊂ A).
Axiom axiom_ExteqmySet : forall {M : Type} (A B : mySet M),
  eqmySet A B -> A = B.

Section 等号.
Variable Mother : Type.

Lemma rfl_eqS (A : mySet Mother) : A = A.
Proof. by []. Qed.

Lemma sym_eqS (A B : mySet Mother) : A = B -> B = A.
Proof. move=> H. symmetry. by []. Qed.

Lemma eqmySet_eq : forall {M : Type} (A B : mySet M),
  A = B -> eqmySet A B.
Proof.
  move=> M A B H. unfold eqmySet. split.
  rewrite H. apply rfl_Sub.
  rewrite H. apply rfl_Sub.
Qed.

End 等号.

Definition myComplement {M : Type} (A : mySet M) : mySet M :=
  fun (x : M) => ~(A x).
Notation "A ^c" := (myComplement A) (at level 11).
Definition myCup {M : Type} (A B : mySet M) : mySet M :=
  fun (x : M) => (x ∈ A) \/ (x ∈ B).
Notation "A ∪ B" := (myCup A B) (at level 11).

Section 演算.
Variable M : Type.

Lemma cEmpty_Mother : (@myEmptySet M)^c = myMotherSet.
Proof.
  apply axiom_ExteqmySet. rewrite /eqmySet.
  (* by apply: conj; rewrite /mySub /myComplement // => x Hfull. *)
  split. by rewrite /mySub /belong.
  move=> x Hfull. by [].
Qed.

Print eq.
Locate eq.
Print eq_refl.

Lemma cc_cancel (A : mySet M) : (A^c)^c = A.
Proof.
  apply axiom_ExteqmySet.
  rewrite /eqmySet.
  apply: conj; rewrite /mySub /myComplement => x H //.
  move: (axiom_mySet A x). case. done.
  move=> H2. rewrite /belong in H H2.
  apply H in H2. case: H2.
Qed.

Print cc_cancel.

Lemma cMother_Empty : (@myMotherSet M)^c = myEmptySet.
Proof. by rewrite -cEmpty_Mother cc_cancel. Qed.

Lemma myCupA (A B C : mySet M) : (A ∪ B) ∪ C = A ∪ (B ∪ C).
Proof.
  apply axiom_ExteqmySet. rewrite /eqmySet /mySub.
  (* apply: conj => x [H1 | H2].
  case: H1 => t. *)
  split. move=> x. case=> H. move:H. case. move=> t. by apply or_introl.
  move=> t. apply or_intror. by apply or_introl.
  apply or_intror. by apply or_intror.
  move=> x. case. move=>t. by apply or_introl; apply or_introl.
  case=> t. by apply or_introl; apply or_intror.
  by apply or_intror.
Qed.

Lemma myUnionCompMother (A : mySet M) : A ∪ (A^c) = myMotherSet.
Proof.
  (* apply axiom_ExteqmySet. rewrite /eqmySet.
  apply: conj. apply Sub_Mother.
  rewrite /mySub => x H. rewrite /myCup /belong /myComplement.
  apply axiom_mySet. *)
  apply axiom_ExteqmySet. rewrite /eqmySet /mySub.
  apply conj => [x | x HM]. by case.
  by case: (axiom_mySet A x); [apply or_introl | apply or_intror].
Qed.

End 演算.

Definition myMap {M1 M2 : Type} (A : mySet M1) (B : mySet M2)
  (f : M1 -> M2) :=
  (forall (x:M1), (x ∈ A) -> ((f x) ∈ B)).
Notation "f ∈Map A \to B" := (myMap A B f) (at level 11).
(*∈ と Map の間にスペースを空けて定義するとうまく構文解析されない*)

Definition MapCompo {M1 M2 M3 : Type} (f : M2 -> M3) (g : M1 -> M2):
  M1 -> M3 := fun (x : M1) => f (g x).
Notation "f ・ g" := (MapCompo f g) (at level 11).

Definition ImgOf {M1 M2 : Type} (f : M1 -> M2) {A : mySet M1}
  {B : mySet M2} (_ : f ∈Map A \to B) : mySet M2
  := fun (y : M2) => (exists (x:M1), y = f x /\ x ∈ A).

Definition mySetInj {M1 M2 : Type} (f : M1 -> M2) (A : mySet M1)
  (B : mySet M2) (_ : f ∈Map A \to B)
  := forall (x y : M1), (x ∈ A) -> (y ∈ A) -> (f x = f y) -> (x = y).

Definition mySetSur {M1 M2 : Type} (f : M1 -> M2) (A : mySet M1)
  (B : mySet M2) (_ : f ∈Map A \to B)
  := forall (y : M2), (y ∈ B) -> (exists (x : M1), (x ∈ A) -> (f x = y)).

Definition mySetBi {M1 M2 : Type} (f : M1 -> M2) (A : mySet M1)
  (B : mySet M2) (fAB : f ∈Map A \to B)
  := (mySetInj fAB) /\ (mySetSur fAB).

Section 写像.
Variables M1 M2 M3: Type.
Variable f : M2 -> M3.
Variable g : M1 -> M2.
Variable A : mySet M1.
Variable B : mySet M2.
Variable C : mySet M3.
Hypothesis gAB : g ∈Map A \to B.
Hypothesis fBC : f ∈Map B \to C.

Lemma transitive_Inj (fgAC : (f ・ g) ∈Map A \to C) :
  mySetInj fBC -> mySetInj gAB -> mySetInj fgAC.
Proof.
  move=>H1 H2. rewrite /mySetInj. move=> x y K1 K2 K3.
  rewrite /MapCompo in K3. apply H1 in K3. apply H2 in K3.
  apply K3. apply K1. apply K2. apply gAB. apply K1.
  apply gAB. apply K2.
Qed.

Lemma CompoTrans : (f ・ g) ∈Map A \to C.
Proof.
  move: gAB fBC.
  (*なぜか Hypothesis は rewrite / できないので*)
  rewrite /MapCompo /myMap => Hab Hbc t Ha.
  apply Hbc. by apply Hab.
Qed.

Lemma ImSub : (ImgOf gAB) ⊂ B.
Proof.
  rewrite /mySub => x.
  case. move=> x0.
  case => H1 H2. rewrite H1.
  by apply gAB.
Qed.

End 写像.

Variable M : finType.

Definition p2S (pA : pred M) : mySet M :=
  fun (x : M) => if (x \in pA) then True else False.

Notation "\{ x 'in' pA \}" := (p2S pA).

Section fintypeを用いた有限集合.
Lemma Mother_predT : myMotherSet = \{ x in M \}.
Proof. by []. Qed.

Lemma myFinBelongP (x : M) (pA : pred M) : reflect (x
 ∈ \{ x in pA \}) (x \in pA).
Proof.
  rewrite /belong /p2S; apply/ (iffP idP)=> H1.
  by rewrite (_ : (x \in pA) = true).
  have testH : (x \in pA) || ~~(x \in pA).
  set t := x \in pA.
  by case: t.
  move: testH.
  case /orP => [| Harg]; first by [].
  rewrite (_: (x \in pA) = false) in H1; first by [].
  by apply: negbTE.
Qed.

Lemma myFinSubsetP (pA pB : pred M) :
  reflect (\{ x in pA \} ⊂ \{ x in pB \}) (pA \subset pB).
Proof.
  rewrite /mySub; apply/ (iffP idP)=>H.
  move=> x /myFinBelongP => H2.
  apply/ myFinBelongP.
  move: H => /subsetP.
  by rewrite /sub_mem; apply.
  apply/ subsetP.
  rewrite /sub_mem=> x /myFinBelongP=> HpA.
  by apply/ myFinBelongP; apply H.
Qed.

Lemma Mother_Sub (pA : pred M) :
  myMotherSet ⊂ \{ x in pA \} -> forall x, x ∈ \{ x in pA \}.
Proof.
  rewrite Mother_predT=> /myFinSubsetP=> H x; apply /myFinBelongP.
  by apply: predT_subset.
Qed.

Lemma transitive_Sub' (pA pB pC : pred M) :
  \{ x in pA \} ⊂ \{ x in pB \}
  -> \{ x in pB \} ⊂ \{ x in pC \}
  -> \{ x in pA \} ⊂ \{ x in pC \}.
Proof.
  move /myFinSubsetP => HAB /myFinSubsetP => HBC.
  by apply/myFinSubsetP /(subset_trans HAB HBC).
Qed.

Lemma transitive_Sub'' (pA pB pC : pred M) :
  \{ x in pA \} ⊂ \{ x in pB \}
  -> \{ x in pB \} ⊂ \{ x in pC \}
  -> \{ x in pA \} ⊂ \{ x in pC \}.
Proof.
  by apply transitive_Sub.
Qed.

End fintypeを用いた有限集合.