Require Export Stlc.SpecTyping.
Require Export Stlc.SpecEvaluation.

Definition PCtxEquivalent (Γ: Env) (t₁ t₂: Tm) (τ: Ty) : Prop :=
  ∀ C τ',
    ⟪ ⊢ C : Γ , τ → empty, τ' ⟫ →
    (pctx_app t₁ C)⇓ ↔ (pctx_app t₂ C)⇓.
Notation "⟪  Γ ⊢ t₁ ≃ t₂ : τ  ⟫" :=
  (PCtxEquivalent Γ t₁ t₂ τ)
  (at level 0, Γ at level 98, t₁ at level 98, t₂ at level 98, τ at level 98).

Lemma pctx_equiv_symm {Γ t₁ t₂ τ} :
  ⟪ Γ ⊢ t₁ ≃ t₂ : τ ⟫ → ⟪ Γ ⊢ t₂ ≃ t₁ : τ ⟫.
Proof.
  unfold PCtxEquivalent.
  intros equiv C τ' ty; split;
  apply (equiv C τ' ty).
Qed.

Definition PCtxEquivalentCtx (Γᵢ : Env) (C₁ C₂ : PCtx) (τᵢ τₒ : Ty) : Prop :=
  ∀ t ,
    ⟪ Γᵢ ⊢ t : τᵢ ⟫ →
    (pctx_app t C₁)⇓ ↔ (pctx_app t C₂)⇓.
Notation "⟪ ⊢ C₁ ≃ C₂ : Γᵢ , τᵢ → τₒ  ⟫" :=
  (PCtxEquivalentCtx Γᵢ C₁ C₂ τᵢ τₒ)
  (at level 0, Γᵢ  at level 98, C₁ at level 98, C₂ at level 98, τᵢ  at level 98, τₒ at level 98).

Lemma pctx_equiv_ctx_symm {Γᵢ C₁ C₂ τᵢ τₒ} :
  ⟪ ⊢ C₁ ≃ C₂ : Γᵢ , τᵢ → τₒ  ⟫ ->
  ⟪ ⊢ C₂ ≃ C₁ : Γᵢ , τᵢ → τₒ  ⟫.
Proof.
  intros equiv C wsc; split;
  apply (equiv C wsc).
Qed.


(* Do not edit this file, it was generated automatically *)
Require Import VST.floyd.proofauto. (* Import the Verifiable C system *)
Require Import VST.progs64.bin_search. (* Import the AST of this C program *)
(* The next line is "boilerplate", always required after importing an AST. *)
Instance CompSpecs : compspecs. make_compspecs prog. Defined.
Definition Vprog : varspecs.  mk_varspecs prog. Defined.

Fixpoint sorted (l : list Z) : Prop :=
  match l with
  | [] => True
  | x::rest =>
    match rest with [] => True | y::_ =>  x <= y /\ sorted rest end
  end.

(* Beginning of the API spec for the bin_search.c program *)
Definition search_spec :=
 DECLARE _search
  WITH a: val, sh : share, contents : list Z, tgt : Z, lo : Z, hi : Z
  PRE [ _a OF (tptr tint), _tgt OF tint, _lo OF tint, _hi OF tint ]
            PROP  (readable_share sh;
                     0 <= lo <= Int.max_signed;
                     hi <= Zlength contents <= Int.max_signed;
                     Int.min_signed <= hi <= Int.max_signed / 2;
                     sorted contents;
                     Forall (fun x => Int.min_signed <= x <= Int.max_signed) contents;
                     Int.min_signed <= tgt <= Int.max_signed)
                  LOCAL (temp _a a; temp _tgt (Vint (Int.repr tgt));
                         temp _lo (Vint (Int.repr lo)); temp _hi (Vint (Int.repr hi)))
          SEP   (data_at sh (tarray tint (Zlength contents)) (map Vint (map Int.repr contents)) a)
  POST [ tint ]
    EX i:Z,
         PROP (if in_dec Z.eq_dec tgt (sublist lo hi contents) then Znth i contents = tgt else i = -1)
          LOCAL (temp ret_temp  (Vint (Int.repr i)))
           SEP (data_at sh (tarray tint (Zlength contents)) (map Vint (map Int.repr contents)) a).

(* The spec of "int main(void){}" always looks like this. *)
Definition main_spec :=
 DECLARE _main
  WITH gv: globals
  PRE  [] main_pre prog nil gv
  POST [ tint ] main_post prog nil gv.

(* Packaging the API spec all together. *)
Definition Gprog : funspecs :=
        ltac:(with_library prog [search_spec; main_spec]).

Lemma sublist_nil1 : forall A i j (l : list A), j <= i -> sublist i j l = [].
Proof.
  intros; destruct (eq_dec i j).
  - subst; apply sublist_nil.
  - unfold sublist; rewrite Z2Nat_neg; auto; omega.
Qed.

Lemma Znth_In : forall A (d: Inhabitant A) i (l : list A) x (Hrange : 0 <= i < Zlength l)
                       (Hnth : Znth i l = x), In x l.
Proof.
  unfold Znth; intros.
  destruct (zlt i 0); [omega|].
  subst; apply nth_In.
  rewrite Zlength_correct in Hrange; auto.
  rep_omega.
Qed.

Lemma In_Znth : forall A (d: Inhabitant A) (l : list A) x,
    In x l ->
    exists i, 0 <= i < Zlength l /\ Znth i l = x.
Proof.
  unfold Znth; intros.
  apply In_nth with (d := d) in H; destruct H as (n & ? & ?).
  exists (Z.of_nat n); split.
  - rewrite Zlength_correct; omega.
  - destruct (zlt (Z.of_nat n) 0); [omega|].
    rewrite Nat2Z.id; auto.
Qed.

Lemma sublist_of_nil : forall A i j, sublist i j (nil : list A) = [].
Proof.
  intros; unfold sublist.
  rewrite skipn_nil, firstn_nil; auto.
Qed.

Fixpoint sorted2 l :=
  match l with
  | [] => True
  | x :: rest => Forall (fun y => x <= y) rest /\ sorted2 rest
  end.

Lemma sorted_equiv : forall l, sorted l <-> sorted2 l.
Proof.
  induction l; simpl.
  - reflexivity.
  - destruct l.
    + simpl; split; auto.
    + rewrite IHl; simpl; split; intros (? & Hall & ?); split3; auto.
       * constructor; auto.
          rewrite Forall_forall in *; intros ? Hin.
          specialize (Hall _ Hin); omega.
       * inversion H. auto.
Qed.

Lemma sorted_mono : forall l i j (Hsort : sorted l) (Hi : 0 <= i <= j)
                           (Hj : j < Zlength l),
    Znth i l <= Znth j l.
Proof.
induction l; intros.
* rewrite !Znth_nil. omega.
*
 rewrite sorted_equiv in Hsort. destruct Hsort as [H9 Hsort].
 rewrite <- sorted_equiv in Hsort. rewrite Forall_forall in H9.
 rewrite Zlength_cons in Hj.
 destruct (zeq i 0).
 +
   subst i; rewrite Znth_0_cons.
   destruct (zeq j 0).
   - subst j. rewrite Znth_0_cons. omega.
   - rewrite Znth_pos_cons by omega.
      apply H9.
      eapply Znth_In; [ | reflexivity]; omega.
 +
    rewrite !Znth_pos_cons by omega.
    apply IHl; auto; omega.
Qed.

Lemma In_sorted_range : forall lo hi x l (Hsort : sorted l) (Hlo : 0 <= lo <= hi)
                              (Hhi : hi <= Zlength l)
                              (Hin : In x (sublist lo hi l)),
    Znth lo l <= x <= Znth (hi - 1) l.
Proof.
  intros.
  generalize (In_Znth _ _ _ _ Hin); intros (i & Hrange & Hi).
  rewrite Zlength_sublist in Hrange by auto.
  rewrite Znth_sublist in Hi by omega.
  subst; split; apply sorted_mono; auto; omega.
Qed.

Lemma In_sorted_gt : forall x i n l lo hi (Hsort : sorted l) (Hlo : lo >= 0)
                            (Hhi : hi <= Zlength l)
                            (Hin : In x (sublist lo hi l))
                            (Hi : lo <= i < hi) (Hn : Znth i l = n)
                            (Hgt : n < x),
    In x (sublist (i + 1) hi l).
Proof.
  intros.
  rewrite sublist_split with (mid := i + 1) in Hin; try omega.
  rewrite in_app in Hin; destruct Hin; auto.
  generalize (In_sorted_range lo (i + 1) x _ Hsort); intro X.
  repeat (lapply X; [clear X; intro X | omega]).
  replace (i + 1 - 1) with i in X by omega.
  specialize (X H); subst; omega.
Qed.

Lemma In_sorted_lt : forall x i n l lo hi (Hsort : sorted l) (Hlo : lo >= 0)
                            (Hhi : hi <= Zlength l)
                            (Hin : In x (sublist lo hi l))
                            (Hi : lo <= i < hi) (Hn : Znth i l = n)
                            (Hgt : x < n),
    In x (sublist lo i l).
Proof.
  intros.
  rewrite sublist_split with (mid := i) in Hin; try omega.
  rewrite in_app in Hin; destruct Hin; auto.
  generalize (In_sorted_range i hi x _ Hsort); intro X.
  repeat (lapply X; [clear X; intro X | omega]).
  specialize (X H); subst; omega.
Qed.

Lemma Znth_In_sublist : forall A (d: Inhabitant A) i (l : list A) lo hi
  (Hlo : 0 <= lo <= i) (Hhi : i < hi <= Zlength l),
  In (Znth i l) (sublist lo hi l).
Proof.
  intros.
  apply Znth_In with (i := i - lo)(d := d).
  - rewrite Zlength_sublist; omega.
  - rewrite <- (Z.sub_simpl_r i lo) at 2.
    apply Znth_sublist; omega.
Qed.

Lemma sublist_In_sublist : forall A (l : list A) x lo hi lo' hi' (Hlo : 0 <= lo <= lo')
  (Hhi : hi' <= hi), In x (sublist lo' hi' l) -> In x (sublist lo hi l).
Proof.
  intros.
  apply sublist_In with (lo0 := lo' - lo)(hi0 := hi' - lo); rewrite sublist_sublist;
    try split; try omega.
  - repeat rewrite Z.sub_simpl_r; auto.
  - destruct (Z_le_dec hi' lo'); try omega.
    rewrite sublist_nil1 in *; auto; simpl in *; contradiction.
Qed.

Lemma body_search: semax_body Vprog Gprog f_search search_spec.
Proof.
 start_function.
 destruct H0.
 assert (H6 := Int.min_signed_neg).
 forward_while (EX lo' : Z, EX hi' : Z,
    PROP  (0 <= lo' <= Int.max_signed;
           Int.min_signed <= hi' <= Int.max_signed / 2;
           hi' <= Zlength contents;
           In tgt (sublist lo hi contents) <-> In tgt (sublist lo' hi' contents))
    LOCAL (temp _a a; temp _tgt (Vint (Int.repr tgt));
           temp _lo (Vint (Int.repr lo')); temp _hi (Vint (Int.repr hi')))
    SEP   (data_at sh (tarray tint (Zlength contents))
                   (map Vint (map Int.repr contents)) a)).
 * Exists lo; Exists hi; entailer!.
 * entailer!.
 *
  match goal with H : _ <-> _ |- _ => rename H into H_tgt_sublist end.
  forward.  (* mid =  (lo + hi) >> 1; *) {
   entailer!.
   clear - H8 HRE H7.
   set (j := Int.max_signed / 2) in *; compute in j; subst j.
   set (j := Int.max_signed) in *; compute in j; subst j.
   set (j := Int.min_signed) in *; compute in j; subst j.
   omega.
 }
  rewrite add_repr, Int.shr_div_two_p.
  change (two_p (Int.unsigned (Int.repr 1))) with 2.
  assert (Hlo'hi':  lo' + hi' <= Int.max_signed). {
   transitivity (Int.max_signed / 2 + Int.max_signed / 2).
   - apply Zplus_le_compat; omega.
   - rewrite Zplus_diag_eq_mult_2, Z.mul_comm. apply Z_mult_div_ge; omega.
  }
  rewrite !Int.signed_repr by omega.
  set (mid := (lo' + hi') / 2) in *.
  assert (H13: 0 <= mid < Zlength contents)
    by (subst; split; [apply Z_div_pos | apply Zdiv_lt_upper_bound]; omega).
  assert (H15: lo' <= mid < hi')
    by (split; [apply Zdiv_le_lower_bound | apply Zdiv_lt_upper_bound]; omega).
  assert (H16: Int.min_signed <= Znth mid contents <= Int.max_signed)
    by (rewrite Forall_forall in H3; apply H3; eapply Znth_In; eauto).
  clear H3 Hlo'hi' H H0 H1.
  clearbody mid.
  forward. (* val = a[mid]; *)
  autorewrite with sublist.
  forward_if.
  - forward. (* return mid; *)
    Exists mid; entailer!.
    rewrite if_true; auto.
    rewrite H_tgt_sublist.
    apply Znth_In_sublist; omega.
  - forward_if.
    + forward. (*  lo = mid + 1; *)
      Exists ((mid + 1), hi'); simpl fst; simpl snd; entailer!.
      rewrite H_tgt_sublist.
      split; intro Hin'.
      eapply In_sorted_gt; eauto; omega.
      eapply sublist_In_sublist; try apply Hin'; omega.
    + forward. (* hi=mid; *)
      Exists (lo',mid). simpl fst. simpl snd. entailer!.
      rewrite H_tgt_sublist.
      split; intro Hin'.
      eapply In_sorted_lt; eauto; omega.
      eapply sublist_In_sublist; try apply Hin'; omega.
 *
    forward.  (* return -1; *)
    Exists (-1); entailer!.
    rewrite if_false; auto.
    match goal with H : _ <-> _ |- _ => rewrite H end.
    rewrite sublist_nil1 by omega.
    clear; simpl; tauto.
Qed.

(* Contents of the extern global initialized array "_four" *)
Definition four_contents := [1; 2; 3; 4].

Lemma body_main:  semax_body Vprog Gprog f_main main_spec.
Proof.
  start_function.
  forward_call (gv _four,Ews,four_contents,3,0,4).
  { split. auto.
    change (Zlength four_contents) with 4.
    repeat constructor; computable.
  }
  Intro r; forward.
Qed.

Existing Instance NullExtension.Espec.

Lemma prog_correct:
  semax_prog prog Vprog Gprog.
Proof.
prove_semax_prog.
semax_func_cons body_search.
semax_func_cons body_main.
Qed.


Require Import Arith decision tactics.
Require Import Coq.Classes.RelationClasses.

Inductive id :=
  Id: nat -> id.

Inductive loc :=
  | Loc: nat -> loc.

Instance eq_id_dec:
  forall id1 id2 : id,
    Decision (id1 = id2).
Proof.
  intros [n1] [n2].
  destruct (decide (n1 = n2)).
  - subst.
    left.
    reflexivity.
  - right.
    intro.
    injects.
    eauto.
Defined.

Instance eq_loc_dec:
  forall l1 l2 : loc, Decision (l1 = l2).
Proof.
  intros [n1] [n2].
  destruct (decide (n1 = n2)).
  - subst.
    left.
    reflexivity.
  - right.
    intro.
    injects.
    eauto.
Defined.

(* TODO: Do we really need seperate lemmas for both id and
   loc with Robert's type class? *)
Theorem eq_id:
  forall (T:Type)
    (x : id)
    (p q: T),
    (if decide (x = x) then p else q) = p.
Proof.
  intros.
  destruct (decide (x = x)).
  - reflexivity.
  - exfalso; eauto.
Qed.

(* TODO: Same as above *)
Theorem neq_id:
  forall (T: Type)
    (x y : id)
    (p q: T),
    x <> y ->
    (if decide (x = y) then p else q) = q.
Proof.
  intros.
  destruct (decide (x = y)).
  - contradiction.
  - reflexivity.
Qed.

Theorem eq_loc:
  forall (T: Type)
    (x : loc)
    (p q: T),
    (if decide (x = x) then p else q) = p.
Proof.
  intros.
  destruct (decide (x = x)).
  - reflexivity.
  - exfalso; eauto.
Qed.

Theorem neq_loc:
  forall (T: Type)
    (x y: loc)
    (p q: T),
    x <> y ->
    (if decide (x = y) then p else q) = q.
Proof.
  intros.
  destruct (decide (x = y)).
  - contradiction.
  - reflexivity.
Qed.


(** Very basic examples of embedding imperative features in Coq through the Impure library *)

Require Export ImpExtern.
Require Extraction.
Require Import Coq.Arith.PeanoNat.
Require Import Omega.

Import Notations.
Local Open Scope impure.

Local Open Scope nat_scope.

(* a trivial example of WLP reasoning *)
Section TRIV_WLP.

Variable f: nat -> ?? nat.

Definition g (x:nat): ?? nat :=
 DO r <~ f x;;
 RET (r+1).

Lemma triv: forall x, WHEN g x ~> r THEN r > 0.
Proof.
  wlp_simplify. omega.
Qed.

End TRIV_WLP.

(* Examples showing that cyclic values must be forbidden on extraction of inductive types *)

Section Issue_with_cyclic_value.

Inductive empty: Type:= Absurd: empty -> empty.

Lemma never_return_empty (f: unit -> ??empty):
  WHEN f () ~> _ THEN False.
Proof.
  wlp_simplify.
  clear Hexta.
  induction exta. auto.
Qed.
(* issue: in OCaml, the extraction of type [empty] is currently inhabited by a cyclic value *)

Definition is_zero (n:nat): bool :=
  match n with
  | O => true
  | _ => false
  end.

Lemma is_zero_correct n: is_zero n = true <-> n = 0.
Proof.
  destruct n; simpl; intuition.
Qed.

Lemma phys_eq_pred n: WHEN phys_eq (pred n) n ~> b THEN b=true -> (is_zero n)=true.
Proof.
  wlp_simplify.
  rewrite is_zero_correct; clear exta Hexta H0.
  generalize H1; clear H1; induction n; simpl; auto.
  intros H1; rewrite <- H1. apply IHn; clear IHn.
  destruct n; simpl; auto.
Qed.
(* issue: in OCaml, the extraction of type [nat] is currently inhabited by a cyclic value [fuel]
   such that [pred fuel == fuel] returns [true] and [is_zero fuel] returns [false].  *)

End Issue_with_cyclic_value.

Section Pseudo_Identity.

Variable pid: forall A, A->??A.

Program Definition cpid {B} (x:B): ?? B :=
  DO z <~ pid { y | y = x } x ;;
  RET `z.

Lemma cpid_correct A (x y:A):
  WHEN (cpid x) ~> y THEN  y=x.
Proof.
  wlp_simplify. destruct exta; subst; auto.
Qed.

End Pseudo_Identity.

Module TestNat.

(* Now, we embed invariants into Coq references

Here is a tiny example...

*)

(*
Remark that in Coq, we only deduce informations from the type !
In particular, we can not prove that

  [set r x;; get r ()] will return [x].

Indeed, this is false for another implementation of make:

  [(fun x -> let r = ref x in { set = (fun y -> r:=y); get = (fun () -> x) })

More generally, I can not prove anything about "get" except that if it returns a value then the value inhabits its type.

Here, be aware that we can define aliases in Coq, even if we cannot reason about them.

*)

Definition may_alias{A} (x:cref A) (y:cref nat):?? A:=
  y.(set) 0;;
  x.(get) ().

Program Definition alias_example (r1: cref nat) : ?? nat :=
  DO r2 <~ make_cref (exist (fun r => r = r1) r1 _);; (* r2: cref {r : cref nat | r = r1} *)
  DO r <~ may_alias r2 r1;;
  ASSERT ((`r)=r1);; (* this is proved automatically ! *)
  get r (). (* But, we can not prove that the returned value is [0] *)

Program Definition alias_ex (r1: cref nat) : ?? { r | r=r1 } :=
  DO r2 <~ make_cref (exist (fun r => r = r1) r1 _);;
  may_alias r2 r1.

(* Now, the issues are the following:

1) will the OCaml extraction of the Coq code be sound with the properties proved ?
2) is it possible to find a well-typed OCaml implementation of [make] of type 'a -> 'a cref
   which breaks some invariant proved in Coq.

*)

Local Open Scope string_scope.

Definition test1: ?? unit :=
  DO r1 <~ make_cref 10 ;;
  DO v <~ alias_example r1;;
  assert_b (Nat.eqb v 0) "Ok: we cannot prove this. It depends on the implementation of make.";;
  RET tt.

Record mydata := {
  value: nat;
  bounded: value > 10
}.

Lemma mydata_preserved (x: cref mydata) (y: cref nat):
  WHEN may_alias x y ~> v THEN
    v.(value) > 10.
Proof.
  wlp_simplify. destruct exta0; simpl; auto.
Qed.

Fixpoint repeat (n:nat) (k: unit -> ?? unit): ?? unit :=
  match n with
  | 0 => RET()
  | S p => k();; repeat p k
  end.

Definition print3 (s:pstring): ?? unit :=
  repeat 3 (fun _ => println s).

(* wrong repeat *)
Fixpoint wrepeat (n:nat) (k: ?? unit): ?? unit :=
  match n with
  | 0 => RET()
  | S p => k;; wrepeat p k
  end.

Definition wprint3 (s:pstring): ?? unit :=
  wrepeat 3 (println s).

Lemma wrong_IO_reasoning (s:pstring):
  (print3 s)=(wprint3 s).
Proof.
  unfold print3, wprint3; simpl. auto.
Qed.

Definition interactive: bool := false.

Definition test2: ?? unit :=
  DO s <~
   (if interactive then (
      print("Enter a line: ");;
      read_line()
   ) else RET (Str "hello"));;
  println("version 1");;
  print3 s;;
  println("version 2");;
  wprint3 s.

End TestNat.

(* An other example *)
Require Import PArith.
Check forall {A}, (list (positive*A)) -> ??((positive -> ??(option A))*(positive*A -> ??unit)).

(*************************)
(* Extraction directives *)

Require Import ExtrOcamlString.
Require Import ExtrOcamlBasic.

Import ImpConfig.

Extraction Blacklist List String.

Separate Extraction BinInt ImpExtern TestNat.


(* TLC in Coq
 *
 * Module: tlc.logic.context
 * Purpose: Contains the context type for syntactic proofs.
 *)

Require Import mathcomp.ssreflect.seq.
Require Import mathcomp.ssreflect.ssreflect.
Require Import tlc.semantics.all_semantics.
Require Import tlc.syntax.all_syntax.

Set Implicit Arguments.
Unset Strict Implicit.
Unset Printing Implicit Defensive.

(* Logical context of bound rigid variables *)
Definition context_bindings := seq rigid.

(* Logical context of assumed assertions *)
Definition context_assumptions := seq assertion.

(* Logical proof context *)
Record context :=
  Context {
    context_delta : context_bindings;
    context_gamma : context_assumptions;
  }.

(* Context coercions *)
Coercion context_delta : context >-> context_bindings.
Coercion context_gamma : context >-> context_assumptions.

(* A context with no bound variables or assumptions *)
Notation Z0 := (Context [::] [::]).

(* Compute the set of rigid variables appearing in a context *)
Definition context_rigids Z :=
  foldr (fun A xs => assertion_rigids A ++ xs)
    (context_delta Z) (context_gamma Z).


(* $Id: Integral.v,v 1.19 2003/03/13 12:06:19 lcf Exp $ *)

Require Export RefLemma.

Section Lemmas.

Local Sumx_wd_weird : (n,m:nat)m=(S n)->(f:(i:nat)(lt i n)->IR)(g:(i:nat)(lt i m)->IR)
  ((H:?)(g O H)[=]Zero)->((i:nat)(H:?)(H':?)(f i H)[=](g (S i) H'))->(Sumx f)[=](Sumx g).
Intro; Induction n.
Do 2 Intro.
Rewrite H.
Intros; Simpl; Apply eq_symmetric_unfolded.
Stepr (g O (lt_n_Sn O)); Algebra.
Do 2 Intro; Rewrite H; Intros.
Step (Sumx [i:nat][Hi:(lt i n)](f i (lt_S ?? Hi)))[+](f n (lt_n_Sn n)).
Step_final (Sumx [i:nat][Hi:(lt i (S n))](g i (lt_S ?? Hi)))[+](g (S n) (lt_n_Sn (S n))).
Qed.

Lemma Sumx_weird_lemma :
  (n,m,l:nat)l=(S (plus m n))->(f1:(i:nat)(lt i n)->IR)(f2:(i:nat)(lt i m)->IR)(f3:(i:nat)(lt i l)->IR)
    (nat_less_n_fun ?? f1)->(nat_less_n_fun ?? f2)->(nat_less_n_fun ?? f3)->
    ((i:nat)(Hi:?)(Hi':?)(f1 i Hi)[=](f3 i Hi'))->((i:nat)(Hi:?)(Hi':?)(f2 i Hi)[=](f3 (S (plus n i)) Hi'))->((Hi:?)(f3 n Hi)[=]Zero)->
  (Sumx f1)[+](Sumx f2)[=](Sumx f3).
Intros n m.
Induction m.
Intros l Hl.
Simpl in Hl; Rewrite Hl; Intros f1 f2 f3 Hf1 Hf2 Hf3 Hf1_f3 Hf2_f3 Hf3_f3.
Step (Sumx f1)[+]Zero.
Simpl; Apply bin_op_wd_unfolded.
Apply Sumx_wd; Intros; Apply Hf1_f3.
Apply eq_symmetric_unfolded; Apply Hf3_f3.
LetTac l':= (plus (S m) n).
Intros l Hl.
Rewrite Hl; Intros f1 f2 f3 Hf1 Hf2 Hf3 Hf1_f3 Hf2_f3 Hf3_f3.
Apply eq_transitive_unfolded with ((Sumx f1)[+](Sumx [i:nat][Hi:(lt i m)](f2 i (lt_S ?? Hi))))[+](f2 m (lt_n_Sn m)).
Simpl; Algebra.
Stepr (Sumx [i:nat][Hi:(lt i l')](f3 i (lt_S ?? Hi)))[+](f3 l' (lt_n_Sn l')).
Apply bin_op_wd_unfolded.
Apply Hrecm.
Unfold l'; Auto.
Assumption.
Red; Intros; Apply Hf2; Auto.
Red; Intros; Apply Hf3; Auto.
Red; Intros; Apply Hf1_f3.
Red; Intros; Apply Hf2_f3.
Red; Intros; Apply Hf3_f3.
Unfold 1 l'.
Cut (lt (S (plus n m)) (S l')); [Intro | Unfold l'; Simpl; Rewrite plus_sym; Auto].
Apply eq_transitive_unfolded with (f3 ? H).
Apply Hf2_f3.
Apply Hf3; Simpl; Auto with arith.
Qed.

End Lemmas.

Section Integral.

(* Tex_Prose
\chapter{Integral}

Having proved the main properties of partitions and refinements, we will define the integral of a continuous function $F$ in the interval $[a,b]$ as the limit of the sequence of Sums of $F$ for even partitions of increasing number of points.

\begin{convention} All throughout, \verb!a,b! will be real numbers, the interval $[a,b]$ will be denoted by \verb!I! and \verb!F,G! will be continuous functions in \verb!I!.
\end{convention}
*)

Variables a,b:IR.
Hypothesis Hab:(a[<=]b).
Local I:=(Compact Hab).

Variable F:PartIR.
Hypothesis contF:(Continuous_I Hab F).

Local contF' := (contin_prop ???? contF).

Section Darboux_Sum.

(* Begin_Tex_Verb *)
Definition integral_seq : nat->IR.
(* End_Tex_Verb *)
Intro n.
Apply Even_Partition_Sum with a b Hab F (S n).
Assumption.
Auto.
Defined.

(* Begin_Tex_Verb *)
Lemma Cauchy_Darboux_Seq : (Cauchy_prop integral_seq).
(* End_Tex_Verb *)
Red; Intros e He.
LetTac e':=e[/]?[//](mult_resp_ap_zero ??? (two_ap_zero ?) (max_one_ap_zero b[-]a)).
Cut (Zero[<]e').
Intro He'.
LetTac d:=(proj1_sigS2P ??? (contF' e' He')).
Generalize (proj2b_sigS2P ??? (contF' e' He')); Generalize (proj2a_sigS2P ??? (contF' e' He')); Fold d; Intros H0 H1.
LetTac N:=(proj1_sig ?? (Archimedes (b[-]a)[/]?[//](pos_ap_zero ?? H0))).
Exists N; Intros.
Apply AbsIR_imp_AbsSmall.
Apply leEq_transitive with Two[*]e'[*](b[-]a).
RStepr e'[*](b[-]a)[+]e'[*](b[-]a).
Unfold integral_seq.
Elim (even_partition_refinement ?? Hab ?? (O_S m) (O_S N)).
Intros w Hw.
Elim Hw; Clear Hw; Intros Hw H2 H3.
Unfold Even_Partition_Sum.
Unfold I; Apply second_refinement_lemma with
  a:=a b:=b F:=F contF:=contF
  Q:=(Even_Partition Hab w (not_to_CNot ? Hw))
  He:=He' He':=He'
  fQ:=[i:nat][Hi:(lt i w)]a[+](nring i)[*]((b[-]a)[/](nring w)[//](nring_ap_zero' ?? (not_to_CNot ? Hw))); Fold d.
Assumption.
Assumption.
EApply leEq_wdl.
2: Apply eq_symmetric_unfolded; Apply even_partition_Mesh.
Apply shift_div_leEq.
Apply pos_nring_S.
Apply shift_leEq_mult' with (pos_ap_zero ?? H0).
Assumption.
Apply leEq_transitive with (!nring IR N).
Exact (proj2_sig ?? (Archimedes (b[-]a)[/]d[//](pos_ap_zero ?? H0))).
Apply nring_leEq; Apply le_S; Assumption.
EApply leEq_wdl.
2: Apply eq_symmetric_unfolded; Apply even_partition_Mesh.
Apply shift_div_leEq.
Apply pos_nring_S.
Apply shift_leEq_mult' with (pos_ap_zero ?? H0).
Assumption.
Apply leEq_transitive with (!nring IR N).
Exact (proj2_sig ?? (Archimedes (b[-]a)[/]d[//](pos_ap_zero ?? H0))).
Apply nring_leEq; Apply le_n_Sn.
Red; Intros.
Simpl; Split.
Apply leEq_reflexive.
Apply plus_resp_leEq_lft.
Apply mult_resp_leEq_rht.
Apply less_leEq; Apply less_plusOne.
Apply shift_leEq_div.
Step (!nring IR O); Apply nring_less; Apply le_lt_trans with i; Auto with arith.
Apply shift_leEq_minus; RStep a; Auto.
Red; Do 3 Intro; Simpl.
Rewrite H4; Intros.
Algebra.
Unfold e'.
RStep (e[*](b[-]a))[/]?[//](max_one_ap_zero b[-]a).
Apply shift_div_leEq.
Apply pos_max_one.
Apply mult_resp_leEq_lft.
Apply lft_leEq_Max.
Apply less_leEq; Assumption.
Unfold e'.
Apply div_resp_pos.
Apply mult_resp_pos.
Apply pos_two.
Apply pos_max_one.
Assumption.
Qed.

(* Begin_Tex_Verb *)
Definition integral :=
  (Lim (Build_CauchySeq ?? Cauchy_Darboux_Seq)).
(* End_Tex_Verb *)

End Darboux_Sum.

Section Integral_Thm.

(* Tex_Prose
The following shows that in fact the integral of $F$ is the limit of \emph{any} sequence of partitions of mesh converging to 0.

\begin{convention} Let \verb!e! be a positive real number and \verb!P! be a partition of \verb!I! with \verb!n! points and mesh smaller than the modulus of continuity of \verb!F! for \verb!e!.  Let \verb!fP! be a choice of points respecting \verb!P!.
\end{convention}
*)

Variable n:nat.

Variable P:(Partition Hab n).

Variable e:IR.
Hypothesis He:Zero[<]e.

Local d:=(proj1_sigS2P ??? (contF' e He)).

Hypothesis HmeshP : (Mesh P)[<]d.

Variable fP:(i:nat)(lt i n)->IR.
Hypothesis HfP:(Points_in_Partition P fP).
Hypothesis HfP':(nat_less_n_fun ?? fP).

Hypothesis incF:(included (Compact Hab) (Pred F)).

(* Begin_Tex_Verb *)
Lemma partition_Sum_conv_integral :
  (AbsIR (Partition_Sum HfP incF)[-]integral)[<=]e[*](b[-]a).
(* End_Tex_Verb *)
Apply leEq_wdl with (AbsIR (Partition_Sum HfP (contin_imp_inc ???? contF))[-]integral).
Apply leEq_wdl with (AbsIR (Lim (Cauchy_const (Partition_Sum HfP (contin_imp_inc ???? contF))))[-]integral).
2: Apply AbsIR_wd; Apply cg_minus_wd; [Apply eq_symmetric_unfolded; Apply Lim_const | Algebra].
Unfold integral.
Apply leEq_wdl with (AbsIR (Lim
  (Build_CauchySeq ?? (Cauchy_minus (Cauchy_const (Partition_Sum HfP (contin_imp_inc ???? contF))) (Build_CauchySeq ?? Cauchy_Darboux_Seq))))).
2: Apply AbsIR_wd; Apply Lim_minus.
EApply leEq_wdl.
2: Apply Lim_abs.
Stepr Zero[+]e[*](b[-]a); Apply shift_leEq_plus; Red; Apply approach_zero_weak.
Intros e' He'.
LetTac ee:=e'[/]?[//](max_one_ap_zero b[-]a).
Apply leEq_transitive with ee[*](b[-]a).
Cut Zero[<]ee.
Intro Hee.
LetTac d':=(proj1_sigS2P ??? (contF' ? Hee)).
Generalize (proj2b_sigS2P ??? (contF' ? Hee)); Generalize (proj2a_sigS2P ??? (contF' ? Hee)); Fold d'; Intros Hd' Hd'0.
Elim (Archimedes (b[-]a)[/]?[//](pos_ap_zero ?? Hd')); Intros k Hk.
Apply shift_minus_leEq.
EApply leEq_wdr.
2: Apply cm_commutes_unfolded.
Apply str_seq_leEq_so_Lim_leEq.
Exists k; Simpl; Intros.
Unfold integral_seq Even_Partition_Sum.
Apply refinement_lemma with contF He Hee.
Assumption.
Fold d'.
EApply less_wdl.
2: Apply eq_symmetric_unfolded; Apply even_partition_Mesh.
Apply shift_div_less.
Apply pos_nring_S.
Apply shift_less_mult' with (pos_ap_zero ?? Hd').
Assumption.
Apply leEq_less_trans with (!nring IR k).
Assumption.
Apply nring_less; Auto with arith.
Assumption.
Red; Do 3 Intro.
Rewrite H0; Intros; Simpl; Algebra.
Unfold ee; Apply div_resp_pos.
Apply pos_max_one.
Assumption.
Unfold ee.
RStep e'[*]((b[-]a)[/]?[//](max_one_ap_zero b[-]a)).
RStepr e'[*]One.
Apply mult_resp_leEq_lft.
Apply shift_div_leEq.
Apply pos_max_one.
Stepr (Max b[-]a One); Apply lft_leEq_Max.
Apply less_leEq; Assumption.
Apply AbsIR_wd; Apply cg_minus_wd.
Unfold Partition_Sum.
Apply Sumx_wd; Intros.
Algebra.
Algebra.
Qed.

End Integral_Thm.

End Integral.

Section Basic_Properties.

(* Tex_Prose
The usual welldefinedness and strong extensionality results hold.

\begin{convention} \verb!Integral! will denote the integral in \verb!I!.
\end{convention}
*)

Variables a,b:IR.
Hypothesis Hab : a[<=]b.
Local I:=(Compact Hab).

Syntactic Definition Integral:=(integral ?? Hab ?).

Section Well_Definedness.

Variables F,G:PartIR.
Hypothesis contF:(Continuous_I Hab F).
Hypothesis contG:(Continuous_I Hab G).

(* Begin_Tex_Verb *)
Lemma integral_strext :
  ((Integral contF)[#](Integral contG))->
    {x:IR & (I x) & (Hx,Hx':?)(F x Hx)[#](G x Hx')}.
(* End_Tex_Verb *)
Intro.
Unfold integral in H.
Elim (Lim_ap_imp_seq_ap' ?? H); Intros N HN; Clear H.
Simpl in HN.
Unfold integral_seq Even_Partition_Sum Partition_Sum in HN.
LetTac f':=[i:nat][H:(lt i (S N))]
  (Part F ? (contin_imp_inc ???? contF ? (compact_partition_lemma ?? Hab ? (O_S N) ? (lt_le_weak ?? H))))[*]
  ((Pts (Even_Partition Hab ? (O_S N)) ? H)[-](Pts (Even_Partition Hab ? (O_S N)) i (lt_le_weak ?? H))).
LetTac g':=[i:nat][H:(lt i (S N))]
  (Part G ? (contin_imp_inc ???? contG ? (compact_partition_lemma ?? Hab ? (O_S N) ? (lt_le_weak ?? H))))[*]
  ((Pts (Even_Partition Hab ? (O_S N)) ? H)[-](Pts (Even_Partition Hab ? (O_S N)) i (lt_le_weak ?? H))).
Cut (nat_less_n_fun ?? f'); Intros.
Cut (nat_less_n_fun ?? g'); Intros.
Cut (Sumx f')[#](Sumx g'); Intros.
Elim (Sumx_strext ???? H H0 H1).
Intros n Hn.
Elim Hn; Clear Hn; Intros Hn H'.
Exists a[+](nring n)[*]((b[-]a)[/](nring ?)[//](nring_ap_zero' ?? (O_S N))).
Unfold I; Apply compact_partition_lemma; Auto.
Apply lt_le_weak; Apply Clt_to; Assumption.
Intros.
Elim (bin_op_strext_unfolded ?????? H'); Clear H'; Intro.
EApply ap_well_def_lft_unfolded.
EApply ap_well_def_rht_unfolded.
Apply a0.
Algebra.
Algebra.
ElimType False; Generalize b0; Exact (ap_irreflexive_unfolded ??).
EApply ap_well_def_lft_unfolded.
EApply ap_well_def_rht_unfolded.
Apply HN.
Unfold g' Partition_imp_points; Apply Sumx_wd; Intros; Simpl; Rational.
Unfold f' Partition_imp_points; Apply Sumx_wd; Intros; Simpl; Rational.
Do 3 Intro.
Rewrite H0; Unfold g'; Intros; Algebra.
Do 3 Intro.
Rewrite H; Unfold f'; Intros; Algebra.
Qed.

(* Begin_Tex_Verb *)
Lemma integral_strext' : (c,d,Hcd,HF1,HF2:?)
  (((integral a b Hab F HF1)[#](integral c d Hcd F HF2))->
    (a[#]c)+(b[#]d)).
(* End_Tex_Verb *)
Intros.
Clear contF contG.
Unfold integral in H.
Elim (Lim_strext ?? H).
Clear H; Intros N HN.
Simpl in HN.
Unfold integral_seq Even_Partition_Sum Partition_Sum in HN.
LetTac f1:=[i:nat][Hi:(lt i (S N))]
  (pfpfun ? ? (contin_imp_inc ???? HF1 ? (Pts_part_lemma ?????? (Partition_imp_points_1 ???? (Even_Partition Hab ? (O_S N))) i Hi)))[*]
    ((Pts (Even_Partition Hab ? (O_S N)) ? Hi)[-](Pts (Even_Partition Hab ? (O_S N)) ? (lt_le_weak ?? Hi))).
LetTac f2:=[i:nat][Hi:(lt i (S N))]
  (pfpfun ? ? (contin_imp_inc ???? HF2 ? (Pts_part_lemma ?????? (Partition_imp_points_1 ???? (Even_Partition Hcd ? (O_S N))) i Hi)))[*]
    ((Pts (Even_Partition Hcd ? (O_S N)) ? Hi)[-](Pts (Even_Partition Hcd ? (O_S N)) ? (lt_le_weak ?? Hi))).
Cut (nat_less_n_fun ?? f1); Intros.
Cut (nat_less_n_fun ?? f2); Intros.
Elim (Sumx_strext ???? H H0 HN).
Clear H0 H HN; Intros i Hi.
Elim Hi; Clear Hi; Intros Hi Hi'.
Unfold f1 f2 in Hi'; Clear f1 f2.
Elim (bin_op_strext_unfolded ?????? Hi'); Clear Hi'; Intro.
Cut (Partition_imp_points ???? (Even_Partition Hab ? (O_S N)) i (Clt_to ?? Hi))[#]
  (Partition_imp_points ???? (Even_Partition Hcd ? (O_S N)) i (Clt_to ?? Hi)); Intros.
2: Exact (pfstrx ?????? a0).
Clear a0; Simpl in H.
Elim (bin_op_strext_unfolded ?????? H); Clear H; Intro.
Left; Auto.
Elim (bin_op_strext_unfolded ?????? b0); Clear b0; Intro.
ElimType False; Generalize a0; Apply ap_irreflexive_unfolded.
Elim (div_strong_ext ??????? b0); Clear b0; Intro.
Elim (cg_minus_strext ????? a0); Clear a0; Intro.
Right; Auto.
Left; Auto.
ElimType False; Generalize b0; Apply ap_irreflexive_unfolded.
Elim (cg_minus_strext ????? b0); Clear b0; Intro.
Simpl in a0.
Elim (bin_op_strext_unfolded ?????? a0); Clear a0; Intro.
Left; Auto.
Elim (bin_op_strext_unfolded ?????? b0); Clear b0; Intro.
ElimType False; Generalize a0; Apply ap_irreflexive_unfolded.
Elim (div_strong_ext ??????? b0); Clear b0; Intro.
Elim (cg_minus_strext ????? a0); Clear a0; Intro.
Right; Auto.
Left; Auto.
ElimType False; Generalize b0; Apply ap_irreflexive_unfolded.
Elim (bin_op_strext_unfolded ?????? b0); Clear b0; Intro.
Left; Auto.
Elim (bin_op_strext_unfolded ?????? b0); Clear b0; Intro.
ElimType False; Generalize a0; Apply ap_irreflexive_unfolded.
Elim (div_strong_ext ??????? b0); Clear b0; Intro.
Elim (cg_minus_strext ????? a0); Clear a0; Intro.
Right; Auto.
Left; Auto.
Elim (bin_op_strext_unfolded ?????? b0); Clear b0; Intro.
ElimType False; Generalize a0; Apply ap_irreflexive_unfolded.
ElimType False; Generalize b0; Apply ap_irreflexive_unfolded.
Red.
Do 3 Intro.
Rewrite H0; Clear H0; Intros.
Unfold f2.
Algebra.
Red.
Do 3 Intro.
Rewrite H; Clear H; Intros.
Unfold f1.
Algebra.
Qed.

(* Begin_Tex_Verb *)
Lemma integral_wd :
  (Feq (Compact Hab) F G)->((Integral contF)[=](Integral contG)).
(* End_Tex_Verb *)
Intro.
Apply not_ap_imp_eq.
Intro.
Elim (integral_strext H0).
Intros x H1 H2.
Inversion_clear H.
Inversion_clear H3.
Generalize (H2 (contin_imp_inc ???? contF x H1) (contin_imp_inc ???? contG x H1)).
Apply eq_imp_not_ap.
Auto.
Qed.

(* Begin_Tex_Verb *)
Lemma integral_wd' : (a',b',Hab',contF':?)(a[=]a')->(b[=]b')->
  (Integral contF)[=](integral a' b' Hab' F contF').
(* End_Tex_Verb *)
Intros.
Unfold integral.
Apply Lim_wd'.
Intro; Simpl.
Unfold integral_seq Even_Partition_Sum Partition_Sum.
Apply Sumx_wd; Intros; Apply mult_wd.
Apply pfwdef; Simpl; Algebra.
Simpl.
Repeat First [Apply cg_minus_wd | Apply bin_op_wd_unfolded | Apply mult_wd | Apply div_wd]; Algebra.
Qed.

End Well_Definedness.

Section Linearity_and_Monotonicity.

Opaque Even_Partition.

(* Tex_Prose
The integral is a linear and monotonous function; in order to prove these facts we also need the important equalities $\int_a^bdx=b-a$ and $\int_a^af(x)dx=0$.
*)

(* Begin_Tex_Verb *)
Lemma integral_one : (H:(Continuous_I Hab {-C-}One))
  (Integral H)[=](b[-]a).
(* End_Tex_Verb *)
Intro.
Unfold integral.
EApply eq_transitive_unfolded.
2: Apply eq_symmetric_unfolded; Apply Lim_const.
Apply Lim_wd'.
Intro; Simpl.
Unfold integral_seq Even_Partition_Sum Partition_Sum.
EApply eq_transitive_unfolded.
Apply Mengolli_Sum with f:=[i:nat][Hi:(le i (S n))](Pts (Even_Partition Hab ? (O_S n)) i Hi).
Red; Intros.
Apply prf1; Auto.
Intros; Simpl; Rational.
Apply cg_minus_wd; [Apply finish | Apply start].
Qed.

(* Begin_Tex_Verb *)
Lemma integral_comm_scal : (c:IR)(F:PartIR)
  (Hf:(Continuous_I Hab F))(Hf':(Continuous_I Hab c{**}F))
    (Integral Hf')[=]c[*](Integral Hf).
(* End_Tex_Verb *)
Intros.
Apply eq_transitive_unfolded with (Lim (Cauchy_const c))[*](Integral Hf); Unfold integral.
EApply eq_transitive_unfolded.
2: Apply Lim_mult.
Apply Lim_wd'; Intro; Simpl.
Unfold integral_seq Even_Partition_Sum Partition_Sum.
EApply eq_transitive_unfolded.
2: Apply Sumx_comm_scal'.
Apply Sumx_wd; Intros; Simpl; Rational.
Apply mult_wd_lft.
Apply eq_symmetric_unfolded; Apply Lim_const.
Qed.

(* Begin_Tex_Verb *)
Lemma integral_plus : (F,G:PartIR)
  (Hf:(Continuous_I Hab F))(Hg:(Continuous_I Hab G))
  (Hfg:(Continuous_I Hab F{+}G))
    (Integral Hfg)[=](Integral Hf)[+](Integral Hg).
(* End_Tex_Verb *)
Intros.
Unfold integral.
EApply eq_transitive_unfolded.
2: Apply Lim_plus.
Apply Lim_wd'; Intro; Simpl.
Unfold integral_seq Even_Partition_Sum Partition_Sum.
EApply eq_transitive_unfolded.
2: Apply eq_symmetric_unfolded; Apply Sumx_plus_Sumx.
Apply Sumx_wd; Intros; Simpl; Rational.
Qed.

Variables F,G:PartIR.
Hypothesis contF:(Continuous_I Hab F).
Hypothesis contG:(Continuous_I Hab G).

Transparent Even_Partition.

(* Begin_Tex_Verb *)
Lemma integral_empty : (a[=]b)->(Integral contF)[=]Zero.
(* End_Tex_Verb *)
Intros.
Unfold integral.
EApply eq_transitive_unfolded.
2: Apply eq_symmetric_unfolded; Apply Lim_const.
Apply Lim_wd'.
Intros; Simpl.
Unfold integral_seq Even_Partition_Sum Partition_Sum.
Apply eq_transitive_unfolded with (Sumx [i:nat][H:(lt i (S n))](Zero::IR)).
Apply Sumx_wd; Intros; Simpl.
EApply eq_transitive_unfolded.
Apply dist_2a.
Apply x_minus_x.
Apply mult_wd_rht.
Apply bin_op_wd_unfolded.
Algebra.
Step (nring (S i))[*]((b[-]b)[/]?[//](nring_ap_zero' ?? (O_S n))).
Stepr (nring i)[*]((b[-]b)[/]?[//](nring_ap_zero' ?? (O_S n))).
Rational.
EApply eq_transitive_unfolded.
Apply sumx_const.
Algebra.
Qed.

(* Tex_Prose
\begin{convention} Let \verb!alpha,beta:IR! and asSume that \verb!h:=alpha{**}F{+}beta{**}G! is continuous.
\end{convention}
*)

Variables alpha,beta:IR.
Local h:=alpha{**}F{+}beta{**}G.
Hypothesis contH:(Continuous_I Hab h).

(* Begin_Tex_Verb *)
Lemma linear_integral : (Integral contH)[=]
  alpha[*](Integral contF)[+]beta[*](Integral contG).
(* End_Tex_Verb *)
Cut (Continuous_I Hab alpha{**}F); [Intro | Contin].
Cut (Continuous_I Hab beta{**}G); [Intro | Contin].
Apply eq_transitive_unfolded with (Integral H)[+](Integral H0).
Unfold h.
Apply integral_plus.
Apply bin_op_wd_unfolded; Apply integral_comm_scal.
Qed.

(* Begin_Tex_Verb *)
Lemma monotonous_integral :
  ((x:IR)(I x)->(Hx,Hx':?)(F x Hx)[<=](G x Hx'))->
    (Integral contF)[<=](Integral contG).
(* End_Tex_Verb *)
Intros.
Unfold integral.
Apply Lim_leEq_Lim.
Intro n; Simpl.
Unfold integral_seq Even_Partition_Sum Partition_Sum.
Apply Sumx_resp_leEq; Intros i Hi.
Apply mult_resp_leEq_rht.
Apply H.
Opaque nring.
Unfold I Partition_imp_points; Simpl.
Apply compact_partition_lemma; Auto with arith.
Apply leEq_transitive with (AntiMesh (Even_Partition Hab (S n) (O_S n))).
Apply AntiMesh_nonneg.
Apply AntiMesh_lemma.
Qed.

Transparent nring.

End Linearity_and_Monotonicity.

Section Corollaries.

Variables F,G:PartIR.
Hypothesis contF:(Continuous_I Hab F).
Hypothesis contG:(Continuous_I Hab G).

(* Tex_Prose
As corollaries we can calculate integrals of group operations applied to functions.
*)

(* Begin_Tex_Verb *)
Lemma integral_const : (c:IR)
  (H:(Continuous_I Hab {-C-}c))(Integral H)[=]c[*](b[-]a).
(* End_Tex_Verb *)
Intros.
Cut (Continuous_I Hab c{**}{-C-}One); [Intro | Contin].
Apply eq_transitive_unfolded with (Integral H0).
Apply integral_wd; FEQ.
EApply eq_transitive_unfolded.
Apply integral_comm_scal with Hf:=(Continuous_I_const a b Hab One).
Apply mult_wd_rht.
Apply integral_one.
Qed.

(* Begin_Tex_Verb *)
Lemma integral_minus : (H:(Continuous_I Hab F{-}G))
  (Integral H)[=](Integral contF)[-](Integral contG).
(* End_Tex_Verb *)
Intro.
Cut (Continuous_I Hab (One{**}F){+}([--]One{**}G)); [Intro | Contin].
Apply eq_transitive_unfolded with (Integral H0).
Apply integral_wd; FEQ.
EApply eq_transitive_unfolded.
Apply linear_integral with contF:=contF contG:=contG.
Rational.
Qed.

(* Begin_Tex_Verb *)
Lemma integral_inv : (H:(Continuous_I Hab {--}F))
  (Integral H)[=][--](Integral contF).
(* End_Tex_Verb *)
Intro.
Cut (Continuous_I Hab (Zero{**}F){+}([--]One{**}F)); [Intro | Contin].
Apply eq_transitive_unfolded with (Integral H0).
Apply integral_wd; FEQ.
EApply eq_transitive_unfolded.
Apply linear_integral with contF:=contF contG:=contF.
Rational.
Qed.

(* Tex_Prose
We can also bound integrals by bounding the integrated functions.
*)

(* Begin_Tex_Verb *)
Lemma lb_integral : (c:IR)
  ((x:IR)(I x)->(Hx:?)(c[<=](F x Hx)))->
    (c[*](b[-]a))[<=](Integral contF).
(* End_Tex_Verb *)
Intros.
Apply leEq_wdl with (Integral (Continuous_I_const a b Hab c)).
2: Apply integral_const.
Apply monotonous_integral.
Simpl; Auto.
Qed.

(* Begin_Tex_Verb *)
Lemma ub_integral : (c:IR)
  ((x:IR)(I x)->(Hx:?)(F x Hx)[<=]c)->
    (Integral contF)[<=](c[*](b[-]a)).
(* End_Tex_Verb *)
Intros.
Apply leEq_wdr with (Integral (Continuous_I_const a b Hab c)).
2: Apply integral_const.
Apply monotonous_integral.
Simpl; Auto.
Qed.

(* Begin_Tex_Verb *)
Lemma integral_leEq_norm :
  (AbsIR (Integral contF))[<=](Norm_Funct contF)[*](b[-]a).
(* End_Tex_Verb *)
Simpl; Unfold ABSIR.
Apply Max_leEq.
Apply ub_integral.
Intros; EApply leEq_transitive.
Apply leEq_AbsIR.
Unfold I; Apply norm_bnd_AbsIR; Assumption.
Stepr [--][--]((Norm_Funct contF)[*](b[-]a)).
Stepr [--]([--](Norm_Funct contF)[*](b[-]a)).
Apply inv_resp_leEq.
Apply lb_integral.
Intros; Stepr [--][--](Part F x Hx).
Apply inv_resp_leEq.
EApply leEq_transitive.
Apply inv_leEq_AbsIR.
Unfold I; Apply norm_bnd_AbsIR; Assumption.
Qed.

End Corollaries.

Section Integral_Sum.

(* Tex_Prose
We now relate the Sum of integrals in adjoining intervals to the integral over the union of those intervals.

\begin{convention} Let \verb!c! be a real number such that $c\in[a,b]$.
\end{convention}
*)

Variable F:PartIR.

Variable c:IR.

Hypothesis Hac:a[<=]c.
Hypothesis Hcb:c[<=]b.

Hypothesis Hab':(Continuous_I Hab F).
Hypothesis Hac':(Continuous_I Hac F).
Hypothesis Hcb':(Continuous_I Hcb F).

Section Partition_Join.

(* Tex_Prose
We first prove that every pair of partitions, one of $[a,c]$ and another of $[c,b]$ defines a partition of $[a,b]$ the mesh of which is less or equal to the maximum of the mesh of the original partitions (actually it is equal, but we don't need the other inequality).

\begin{convention} Let \verb!P,Q! be partitions respectively of $[a,c]$ and $[c,b]$ with \verb!n! and \verb!m! points.
\end{convention}
*)

Variables n,m:nat.
Variable P:(Partition Hac n).
Variable Q:(Partition Hcb m).

(* Begin_Tex_Verb *)
Lemma partition_join_aux : (i,n,m:nat)(lt n i)->
  (le i (S (plus n m)))->(le (minus i (S n)) m).
(* End_Tex_Verb *)
Intros; Omega.
Qed.

(* Begin_Tex_Verb *)
Definition partition_join_fun :
  (i:nat)(le i (S (plus n m)))->IR.
(* End_Tex_Verb *)
Intros.
Elim (le_lt_dec i n); Intros.
Apply (Pts P i a0).
Cut (le (minus i (S n)) m); [Intro | Apply partition_join_aux; Assumption].
Apply (Pts Q ? H0).
Defined.

Lemma pjf_1 : (i:nat)(Hi:?)(Hi':?)(partition_join_fun i Hi)[=](Pts P i Hi').
Intros; Unfold partition_join_fun.
Elim le_lt_dec; Intro; Simpl.
Apply prf1; Auto.
ElimType False; Apply le_not_lt with i n; Auto.
Qed.

Lemma pjf_2 : (i:nat)(Hi:?)i=n->(partition_join_fun i Hi)[=]c.
Intros; Unfold partition_join_fun.
Generalize Hi; Clear Hi.
Rewrite H; Clear H; Intro.
Elim le_lt_dec; Intro; Simpl.
Apply finish.
ElimType False; Apply lt_n_n with n; Auto.
Qed.

Lemma pjf_2' : (i:nat)(Hi:?)i=(S n)->(partition_join_fun i Hi)[=]c.
Intros; Unfold partition_join_fun.
Generalize Hi; Clear Hi.
Rewrite H; Clear H; Intro.
Elim le_lt_dec; Intro; Simpl.
ElimType False; Apply (le_Sn_n ? a0).
Cut (H:?)(Pts Q (minus n n) H)[=]c; Auto.
Cut (minus n n)=O; [Intro | Auto with arith].
Rewrite H; Intros; Apply start.
Qed.

Lemma pjf_3 : (i,j:nat)(Hi:?)(Hj:?)(lt n i)->(j=(minus i (S n)))->(partition_join_fun i Hi)[=](Pts Q j Hj).
Intros; Unfold partition_join_fun.
Generalize Hj; Rewrite H0; Clear Hj; Intros.
Elim le_lt_dec; Intro; Simpl.
ElimType False; Apply le_not_lt with i n; Auto.
Apply prf1; Auto.
Qed.

Lemma partition_join_prf1 : (i,j:nat)i=j->(Hi:?)(Hj:?)(partition_join_fun i Hi)[=](partition_join_fun j Hj).
Intros.
Unfold partition_join_fun.
Elim (le_lt_dec i n); Elim (le_lt_dec j n); Intros; Simpl.
Apply prf1; Auto.
ElimType False; Apply le_not_lt with i n.
Assumption.
Rewrite H; Assumption.
ElimType False; Apply le_not_lt with j n.
Assumption.
Rewrite <- H; Assumption.
Apply prf1; Auto.
Qed.

Lemma partition_join_prf2 : (i:nat)(H:?)(H':?)(partition_join_fun i H)[<=](partition_join_fun (S i) H').
Intros.
Unfold partition_join_fun.
Elim (le_lt_dec i n); Elim (le_lt_dec (S i) n); Intros; Simpl.
Apply prf2.
Cut n=i; [Intro | Apply le_antisym; Auto with arith].
Change (Pts P i a0)[<=](Pts Q (minus (S i) (S n)) (partition_join_aux ??? b0 H')).
Generalize H' a0 b0; Clear H' a0 b0.
Rewrite <- H0; Intros.
Apply eq_imp_leEq.
Apply eq_transitive_unfolded with c.
Apply finish.
Apply eq_transitive_unfolded with (Pts Q O (le_O_n ?)).
Apply eq_symmetric_unfolded; Apply start.
Apply prf1; Auto with arith.
ElimType False; Apply le_not_lt with n i; Auto with arith.
Cut (minus i n)=(S (minus i (S n))); [Intro | Omega].
Cut (le (S (minus i (S n))) m); [Intro | Omega].
Apply leEq_wdr with (Pts Q ? H1).
Apply prf2.
Apply prf1; Auto.
Qed.

Lemma partition_join_start : (H:?)(partition_join_fun O H)[=]a.
Intro.
Unfold partition_join_fun.
Elim (le_lt_dec O n); Intro; Simpl.
Apply start.
ElimType False; Apply (lt_n_O ? b0).
Qed.

Lemma partition_join_finish : (H:?)(partition_join_fun (S (plus n m)) H)[=]b.
Intro.
Unfold partition_join_fun.
Elim le_lt_dec; Intro; Simpl.
ElimType False; Apply le_Sn_n with n; Apply le_trans with (S (plus n m)); Auto with arith.
Apply eq_transitive_unfolded with (Pts Q ? (le_n ?)).
Apply prf1; Auto with arith.
Apply finish.
Qed.

(* Begin_Tex_Verb *)
Definition partition_join : (Partition Hab (S (plus n m))).
(* End_Tex_Verb *)
Intros.
Apply Build_Partition with partition_join_fun.
Exact partition_join_prf1.
Exact partition_join_prf2.
Exact partition_join_start.
Exact partition_join_finish.
Defined.

(* Tex_Prose
\begin{convention} \verb!fP,fQ! are choices of points respecting \verb!P! and \verb!Q!.
\end{convention}
*)

Variable fP : (i:nat)(lt i n)->IR.
Hypothesis HfP : (Points_in_Partition P fP).
Hypothesis HfP' : (nat_less_n_fun ?? fP).

Variable fQ : (i:nat)(lt i m)->IR.
Hypothesis HfQ : (Points_in_Partition Q fQ).
Hypothesis HfQ' : (nat_less_n_fun ?? fQ).

Lemma partition_join_aux' : (i,n,m:nat)(lt n i)->(lt i (S (plus n m)))->(lt (minus i (S n)) m).
Intros; Omega.
Qed.

(* Begin_Tex_Verb *)
Definition partition_join_pts : (i:nat)(lt i (S (plus n m)))->IR.
(* End_Tex_Verb *)
Intros.
Elim (le_lt_dec i n); Intros.
Elim (le_lt_eq_dec ?? a0); Intro.
Apply (fP i a1).
Apply c.
Cut (lt (minus i (S n)) m); [Intro | Apply partition_join_aux'; Assumption].
Apply (fQ ? H0).
Defined.

Local pjp_1 : (i:nat)(Hi:?)(Hi':?)(partition_join_pts i Hi)[=](fP i Hi').
Intros; Unfold partition_join_pts.
Elim le_lt_dec; Intro; Simpl.
Elim le_lt_eq_dec; Intro; Simpl.
Algebra.
ElimType False; Rewrite b0 in Hi'; Apply (lt_n_n ? Hi').
ElimType False; Apply le_not_lt with i n; Auto with arith.
Qed.

Local pjp_2 : (i:nat)(Hi:?)i=n->(partition_join_pts i Hi)[=]c.
Intros; Unfold partition_join_pts.
Elim le_lt_dec; Intro; Simpl.
Elim le_lt_eq_dec; Intro; Simpl.
ElimType False; Rewrite H in a1; Apply (lt_n_n ? a1).
Algebra.
ElimType False; Rewrite H in b0; Apply (lt_n_n ? b0).
Qed.

Local pjp_3 : (i:nat)(Hi:?)(Hi':?)(lt n i)->(partition_join_pts i Hi)[=](fQ (minus i (S n)) Hi').
Intros; Unfold partition_join_pts.
Elim le_lt_dec; Intro; Simpl.
ElimType False; Apply le_not_lt with i n; Auto.
Cut (fQ ? (partition_join_aux' ??? b0 Hi))[=](fQ ? Hi').
2: Apply HfQ'; Auto.
Algebra.
Qed.

(* Begin_Tex_Verb *)
Lemma partition_join_Pts_in_partition :
  (Points_in_Partition partition_join partition_join_pts).
(* End_Tex_Verb *)
Red; Intros.
Cut (H':?)(compact (Pts partition_join i (lt_le_weak ?? H)) (Pts partition_join (S i) H) H' (partition_join_pts i H)); Auto.
Unfold partition_join; Simpl.
Unfold partition_join_fun.
Elim le_lt_dec; Elim le_lt_dec; Intros; Simpl.
Elim (le_lt_eq_dec ?? a1); Intro.
Elim (HfP ? a2); Intros.
Apply compact_wd with (fP i a2).
2: Apply eq_symmetric_unfolded; Apply pjp_1.
Split.
EApply leEq_wdl.
Apply a3.
Apply prf1; Auto.
EApply leEq_wdr.
Apply b0.
Apply prf1; Auto.
ElimType False; Clear H'; Rewrite b0 in a0; Apply (le_Sn_n ? a0).
Cut i=n; [Intro | Clear H'; Apply le_antisym; Auto with arith].
Generalize H a0 b0 H'; Clear H' a0 b0 H; Rewrite H0; Intros.
Apply compact_wd with c.
2: Apply eq_symmetric_unfolded; Apply pjp_2; Auto.
Split.
Apply eq_imp_leEq; Apply finish.
Apply eq_imp_leEq; Apply eq_symmetric_unfolded.
Cut (H:?)(Pts Q (minus n n) H)[=]c; Auto.
Cut (minus n n)=O; [Intro | Auto with arith].
Rewrite H1; Intros; Apply start.
ElimType False; Apply le_not_lt with n i; Auto with arith.
Elim (HfQ ? (partition_join_aux' ??? b1 H)); Intros.
Apply compact_wd with (fQ ? (partition_join_aux' ??? b1 H)).
2: Apply eq_symmetric_unfolded; Apply pjp_3; Assumption.
Split.
EApply leEq_wdl.
Apply a0.
Apply prf1; Auto.
EApply leEq_wdr.
Apply b2.
Apply prf1; Rewrite minus_Sn_m; Auto with arith.
Qed.

(* Begin_Tex_Verb *)
Lemma partition_join_Pts_wd : (i,j:nat)i=j->(Hi,Hj:?)
  (partition_join_pts i Hi)[=](partition_join_pts j Hj).
(* End_Tex_Verb *)
Intros.
Elim (le_lt_dec i n); Intro.
Elim (le_lt_eq_dec ?? a0); Intro.
Cut (lt j n); [Intro | Rewrite <- H; Assumption].
EApply eq_transitive_unfolded.
Apply pjp_1 with Hi':=a1.
EApply eq_transitive_unfolded.
2: Apply eq_symmetric_unfolded; Apply pjp_1 with Hi':=H0.
Apply HfP'; Auto.
Cut j=n; [Intro | Rewrite <- H; Assumption].
EApply eq_transitive_unfolded.
Apply pjp_2; Auto.
EApply eq_transitive_unfolded.
2: Apply eq_symmetric_unfolded; Apply pjp_2; Auto.
Algebra.
Cut (lt n j); [Intro | Rewrite <- H; Assumption].
Cut (lt (minus i (S n)) m); [Intro | Omega].
Cut (lt (minus j (S n)) m); [Intro | Omega].
EApply eq_transitive_unfolded.
Apply pjp_3 with Hi':=H1; Assumption.
EApply eq_transitive_unfolded.
2: Apply eq_symmetric_unfolded; Apply pjp_3 with Hi':=H2; Assumption.
Apply HfQ'; Auto.
Qed.

(* Begin_Tex_Verb *)
Lemma partition_join_Sum_lemma :
  (Partition_Sum HfP (contin_imp_inc ???? Hac'))[+]
    (Partition_Sum HfQ (contin_imp_inc ???? Hcb'))[=]
  (Partition_Sum partition_join_Pts_in_partition
                 (contin_imp_inc ???? Hab')).
(* End_Tex_Verb *)
Unfold Partition_Sum; Apply Sumx_weird_lemma.
Auto with arith.
Opaque partition_join.
Red; Intros; Apply mult_wd; Algebra; Apply cg_minus_wd; Apply prf1; Auto.
Red; Intros; Apply mult_wd; Algebra; Apply cg_minus_wd; Apply prf1; Auto.
Red; Intros; Apply mult_wd; Try Apply cg_minus_wd; Try Apply pfwdef; Algebra.
Apply partition_join_Pts_wd; Auto.
Apply prf1; Auto.
Apply prf1; Auto.
Transparent partition_join.
Intros; Apply mult_wd.
Apply pfwdef; Apply eq_symmetric_unfolded; Apply pjp_1.
Apply cg_minus_wd; Simpl.
Unfold partition_join_fun; Elim le_lt_dec; Simpl; Intro; [Apply prf1; Auto | ElimType False; Apply le_not_lt with n i; Auto with arith].
Unfold partition_join_fun; Elim le_lt_dec; Simpl; Intro; [Apply prf1; Auto | ElimType False; Apply le_not_lt with i n; Auto with arith].
Intros; Apply mult_wd.
Apply pfwdef.
Cut i=(minus (S (plus n i)) (S n)); [Intro | Omega].
Generalize Hi; Clear Hi; Pattern 1 2 i; Rewrite H; Intro.
Apply eq_symmetric_unfolded; Apply pjp_3; Auto with arith.
Apply cg_minus_wd; Simpl.
Opaque minus.
Unfold partition_join partition_join_fun.
Elim le_lt_dec; Simpl; Intro.
ElimType False; Apply le_Sn_n with n; EApply le_trans.
2: Apply a0.
Auto with arith.
Transparent minus.
Apply prf1; Transitivity (minus (S (plus n i)) n); Auto with arith.
Opaque minus.
Unfold partition_join partition_join_fun.
Elim le_lt_dec; Simpl; Intro.
ElimType False; Apply le_Sn_n with n; EApply le_trans.
2: Apply a0.
Auto with arith.
Transparent minus.
Apply prf1; Transitivity (minus (plus n i) n); Auto with arith.
Intro; Apply x_mult_zero.
Stepr (Pts partition_join ? Hi)[-](Pts partition_join ? Hi).
Apply cg_minus_wd.
Algebra.
Unfold partition_join; Simpl.
Apply eq_transitive_unfolded with c; Unfold partition_join_fun; Elim le_lt_dec; Simpl.
Intro; Apply finish.
Intro; ElimType False; Apply (lt_n_n ? b0).
Intro; ElimType False; Apply (le_Sn_n ? a0).
Intro; Apply eq_symmetric_unfolded.
Apply eq_transitive_unfolded with (Pts Q ? (le_O_n ?)).
Apply prf1; Auto with arith.
Apply start.
Qed.

(* Begin_Tex_Verb *)
Lemma partition_join_mesh :
  (Mesh partition_join)[<=](Max (Mesh P) (Mesh Q)).
(* End_Tex_Verb *)
Unfold 1 Mesh.
Apply maxlist_leEq.
Apply length_Part_Mesh_List.
Apply lt_O_Sn.
Intros.
Elim (Part_Mesh_List_lemma ?????? H); Intros i Hi.
Elim Hi; Clear Hi; Intros Hi Hi'.
Elim Hi'; Clear Hi'; Intros Hi' Hx.
EApply leEq_wdl.
2: Apply eq_symmetric_unfolded; Apply Hx.
Unfold partition_join; Simpl.
Unfold partition_join_fun.
Elim le_lt_dec; Intro; Simpl.
Elim le_lt_dec; Intro; Simpl.
EApply leEq_transitive.
Apply Mesh_lemma.
Apply lft_leEq_Max.
ElimType False; Apply le_not_lt with i n; Auto with arith.
Elim le_lt_dec; Intro; Simpl.
Cut i=n; [Intro | Apply le_antisym; Auto with arith].
Generalize a0 b0 Hi'; Clear Hx Hi Hi' a0 b0.
Rewrite H0; Intros.
Apply leEq_wdl with (Zero::IR).
EApply leEq_transitive.
2: Apply lft_leEq_Max.
Apply Mesh_nonneg.
Step c[-]c.
Apply eq_symmetric_unfolded; Apply cg_minus_wd.
Cut (H:?)(Pts Q (minus n n) H)[=]c; Auto.
Cut (minus n n)=O; [Intro | Auto with arith].
Rewrite H1; Intros; Apply start.
Apply finish.
Cut (minus i n)=(S (minus i (S n))); [Intro | Omega].
Cut (H:?)(Pts Q (minus i n) H)[-](Pts Q ? (partition_join_aux ??? b1 (Cle_to ?? Hi)))[<=](Max (Mesh P) (Mesh Q)); Auto.
Rewrite H0; Intros; EApply leEq_transitive.
Apply Mesh_lemma.
Apply rht_leEq_Max.
Qed.

End Partition_Join.

(* Tex_Prose
With these results in mind, the following is a trivial consequence:
*)

(* Begin_Tex_Verb *)
Lemma integral_plus_integral :
  (integral ?? Hac ? Hac')[+](integral ?? Hcb ? Hcb')
    [=](integral ?? Hab ? Hab').
(* End_Tex_Verb *)
Unfold 1 2 integral.
EApply eq_transitive_unfolded.
Apply eq_symmetric_unfolded; Apply Lim_plus.
Apply cg_inv_unique_2.
Apply AbsIR_approach_zero.
Intros e' He'.
LetTac e:=e'[/]?[//](max_one_ap_zero b[-]a).
Cut Zero[<]e.
Intro He.
LetTac d:=(proj1_sigS2P ??? (contin_prop ???? Hab' e He)).
Generalize (proj2b_sigS2P ??? (contin_prop ???? Hab' e He)); Generalize (proj2a_sigS2P ??? (contin_prop ???? Hab' e He)).
Fold d; Intros Hd Haux.
Clear Haux.
Apply leEq_transitive with e[*](b[-]a).
Elim (Archimedes (b[-]c)[/]?[//](pos_ap_zero ?? Hd)); Intros n1 Hn1.
Elim (Archimedes (c[-]a)[/]?[//](pos_ap_zero ?? Hd)); Intros n2 Hn2.
Apply leEq_wdl with
  (Lim (Build_CauchySeq ?? (Cauchy_abs
    (Build_CauchySeq ?? (Cauchy_plus
      (Build_CauchySeq ?? (Cauchy_plus
        (Build_CauchySeq ?? (Cauchy_Darboux_Seq ?? Hac ? Hac'))
        (Build_CauchySeq ?? (Cauchy_Darboux_Seq ?? Hcb ? Hcb'))))
      (Cauchy_const [--](integral ?? Hab ? Hab'))))))).
Apply str_seq_leEq_so_Lim_leEq.
LetTac p:=(max n1 n2); Exists p; Intros.
Step (AbsIR ((integral_seq ?? Hac ? Hac' i)[+](integral_seq ?? Hcb ? Hcb' i))[-](integral ?? Hab ? Hab')).
Unfold integral_seq Even_Partition_Sum.
LetTac EP1:=(Even_Partition Hac (S i) (O_S i)).
LetTac EP2:=(Even_Partition Hcb (S i) (O_S i)).
LetTac P:=(partition_join ?? EP1 EP2).
Cut (nat_less_n_fun ?? (Partition_imp_points ???? EP1)); [Intro | Apply Partition_imp_points_2].
Cut (nat_less_n_fun ?? (Partition_imp_points ???? EP2)); [Intro | Apply Partition_imp_points_2].
Apply leEq_wdl with (AbsIR (Partition_Sum (partition_join_Pts_in_partition ?????
  (Partition_imp_points_1 ???? EP1) H0 ? (Partition_imp_points_1 ???? EP2) H1) (contin_imp_inc ???? Hab'))[-](integral ?? Hab ? Hab')).
Apply partition_Sum_conv_integral with He; Fold d.
EApply leEq_less_trans.
Apply partition_join_mesh.
Apply Max_less.
Unfold EP1; EApply less_wdl.
2: Apply eq_symmetric_unfolded; Apply even_partition_Mesh.
Apply swap_div with (pos_ap_zero ?? Hd).
Apply pos_nring_S.
Assumption.
Apply leEq_less_trans with (!nring IR n2).
Assumption.
Apply nring_less.
Apply le_lt_trans with p.
Unfold p; Apply le_max_r.
Auto with arith.
Unfold EP2; EApply less_wdl.
2: Apply eq_symmetric_unfolded; Apply even_partition_Mesh.
Apply swap_div with (pos_ap_zero ?? Hd).
Apply pos_nring_S.
Assumption.
Apply leEq_less_trans with (!nring IR n1).
Assumption.
Apply nring_less.
Apply le_lt_trans with p.
Unfold p; Apply le_max_l.
Auto with arith.
Red; Do 3 Intro.
Rewrite H2; Clear H2; Intros.
Apply partition_join_Pts_wd; Auto.
Apply AbsIR_wd.
Apply cg_minus_wd.
2: Algebra.
Apply eq_symmetric_unfolded.
Unfold Partition_Sum; Apply Sumx_weird_lemma.
Auto.
Red; Do 3 Intro.
Rewrite H2; Clear H2; Intros; Algebra.
Red; Do 3 Intro.
Rewrite H2; Clear H2; Intros; Algebra.
Red; Do 3 Intro.
Rewrite H2; Clear H2; Intros; Algebra.
Opaque Even_Partition.
Intros; Apply mult_wd.
Apply pfwdef; Unfold partition_join_pts.
Elim le_lt_dec; Intro; Simpl.
Elim le_lt_eq_dec; Intro; Simpl.
Apply Partition_imp_points_2; Auto.
ElimType False; Rewrite b0 in Hi; Apply (lt_n_n ?  Hi).
ElimType False; Apply le_not_lt with i0 (S i); Auto with arith.
Apply cg_minus_wd; Simpl.
Apply eq_symmetric_unfolded; Apply pjf_1.
Apply eq_symmetric_unfolded; Apply pjf_1.
Intros; Apply mult_wd.
Apply pfwdef; Unfold Partition_imp_points.
Unfold partition_join_pts.
Elim le_lt_dec; Intro; Simpl.
Elim le_lt_eq_dec; Intro; Simpl.
ElimType False; Apply le_Sn_n with (S i); EApply le_trans.
2: Apply a0.
Auto with arith.
ElimType False; Apply lt_n_n with (S i); Pattern 2 (S i); Rewrite <- b0; Auto with arith.
Unfold Partition_imp_points; Apply prf1.
Auto with arith.
Apply cg_minus_wd; Simpl.
Apply eq_symmetric_unfolded; Apply pjf_3; [Auto with arith | Omega].
Apply eq_symmetric_unfolded; Apply pjf_3; Auto with arith.
Intro; Apply x_mult_zero.
Stepr c[-]c.
Apply cg_minus_wd.
Simpl; Apply pjf_2'; Auto.
Simpl; Apply pjf_2; Auto.
EApply eq_transitive_unfolded.
Apply Lim_abs.
Apply AbsIR_wd.
Unfold cg_minus.
EApply eq_transitive_unfolded.
Apply Lim_plus.
Apply bin_op_wd_unfolded.
Algebra.
Apply eq_symmetric_unfolded; Apply Lim_const.
Unfold e.
RStep (e'[*](b[-]a))[/]?[//](max_one_ap_zero b[-]a).
Apply shift_div_leEq.
Apply pos_max_one.
Apply mult_resp_leEq_lft.
Apply lft_leEq_Max.
Apply less_leEq; Assumption.
Unfold e.
Apply div_resp_pos.
Apply pos_max_one.
Assumption.
Qed.

End Integral_Sum.

Transparent Even_Partition.

End Basic_Properties.

(* Tex_Prose
The following are simple consequences of this result and of previous ones.
*)

(* Begin_Tex_Verb *)
Lemma integral_less_norm : (a,b,Hab,F,contF:?)
  [N:=(!Norm_Funct a b Hab F contF)](a[<]b)->
  (x:IR)(Compact Hab x)->(Hx:?)((AbsIR (F x Hx))[<]N)->
  (AbsIR (integral ???? contF))[<]N[*](b[-]a).
(* End_Tex_Verb *)
Intros.
Rename H into Hless.
Rename H0 into H.
Rename H1 into H0.
LetTac e:=(N[-](AbsIR (F x Hx)))[/]TwoNZ.
Cut Zero[<]e; Intros.
2: Unfold e; Apply pos_div_two; Apply shift_less_minus.
2: Step (AbsIR (F x Hx)); Auto.
Elim (contin_prop ???? contF e); Auto.
Intros d H2 H3.
LetTac mid1:=(Max a x[-]d).
LetTac mid2:=(Min b x[+]d).
Cut a[<=]mid1; [Intro leEq1 | Unfold mid1; Apply lft_leEq_Max].
Cut mid1[<=]mid2; [Intro leEq2 | Unfold mid1 mid2; Inversion_clear H; Apply leEq_transitive with x].
2: Apply Max_leEq; Auto.
2: Apply less_leEq; Apply shift_minus_less.
2: Apply shift_less_plus'; Step (Zero::IR); Auto.
2: Apply leEq_Min; Auto.
2: Apply less_leEq; Apply shift_less_plus'.
2: Step (Zero::IR); Auto.
Cut mid2[<=]b; [Intro leEq3 | Unfold mid2; Apply Min_leEq_lft].
Cut (Continuous_I leEq1 F).
Cut (Continuous_I leEq2 F).
Cut (Continuous_I leEq3 F).
Intros cont3 cont2 cont1.
Cut (Continuous_I (leEq_transitive ???? leEq1 leEq2) F); Intros.
Apply less_wdl with (AbsIR (integral ???? cont1)[+](integral ???? cont2)[+](integral ???? cont3)).
2: Apply AbsIR_wd.
2: Apply eq_transitive_unfolded with (integral ???? H4)[+](integral ???? cont3).
2: Apply bin_op_wd_unfolded.
2: Apply integral_plus_integral.
2: Algebra.
2: Apply integral_plus_integral.
RStepr N[*](mid1[-]a)[+]N[*](mid2[-]mid1)[+]N[*](b[-]mid2).
EApply leEq_less_trans.
Apply triangle_IR.
Apply plus_resp_less_leEq.
EApply leEq_less_trans.
Apply triangle_IR.
Apply plus_resp_leEq_less.
EApply leEq_transitive.
Apply integral_leEq_norm.
Unfold N; Apply mult_resp_leEq_rht.
2: Apply shift_leEq_minus; Step a; Auto.
Apply included_imp_norm_leEq.
Apply included_compact.
Apply compact_inc_lft.
Split.
Unfold mid1; Apply lft_leEq_Max.
Apply leEq_transitive with mid2; Auto.
2: EApply leEq_transitive.
2: Apply integral_leEq_norm.
2: Unfold N; Apply mult_resp_leEq_rht.
3: Apply shift_leEq_minus; Step mid2; Auto.
2: Apply included_imp_norm_leEq.
2: Apply included_compact.
2: Split.
2: Apply leEq_transitive with mid1; Auto.
2: Auto.
2: Apply compact_inc_rht.
EApply leEq_less_trans.
Apply integral_leEq_norm.
Apply mult_resp_less.
Apply leEq_less_trans with N[-]e.
2: Apply shift_minus_less; Apply shift_less_plus'.
2: Step (Zero::IR); Auto.
Apply leEq_Norm_Funct; Intros y Hy Hy'.
Apply leEq_wdr with (AbsIR (F x Hx))[+]e.
2: Unfold e; Rational.
Apply AbsIR_bnd_AbsIR.
Apply H3; Auto.
Cut (included (Compact leEq2) (Compact Hab)); Auto.
Apply included_compact.
Split; Auto.
Apply leEq_transitive with mid2; Auto.
Split; Auto.
Apply leEq_transitive with mid1; Auto.
Cut (x[-]d)[<=](x[+]d); Intros.
Apply compact_bnd_AbsIR with H5.
Cut (included (Compact leEq2) (Compact H5)); Auto.
Apply included_compact; Unfold mid1 mid2; Split.
Apply rht_leEq_Max.
Apply leEq_transitive with mid2; Auto.
Unfold mid2; Apply Min_leEq_rht.
Apply leEq_transitive with mid1; Auto.
Unfold mid1; Apply rht_leEq_Max.
Apply Min_leEq_rht.
Apply leEq_transitive with x.
Apply shift_minus_leEq; Apply shift_leEq_plus'.
Step (Zero::IR); Apply less_leEq; Auto.
Apply shift_leEq_plus'.
Step (Zero::IR); Apply less_leEq; Auto.
Unfold mid2 mid1.
Step x[-]x.
Unfold 1 2 cg_minus.
Inversion_clear H.
Elim (cotrans_less_unfolded ??? Hless x); Intro.
Apply plus_resp_leEq_less.
Apply leEq_Min; Auto.
Apply shift_leEq_plus'; Step (Zero::IR); Apply less_leEq; Auto.
Apply inv_resp_less; Apply Max_less; Auto.
Apply shift_minus_less; Apply shift_less_plus'.
Step (Zero::IR); Auto.
Apply plus_resp_less_leEq.
Apply less_Min; Auto.
Apply shift_less_plus'; Step (Zero::IR); Auto.
Apply inv_resp_leEq; Apply Max_leEq; Auto.
Apply shift_minus_leEq; Apply shift_leEq_plus'.
Step (Zero::IR); Apply less_leEq; Auto.
Apply included_imp_contin with a b Hab; Auto.
Apply included_compact.
Apply compact_inc_lft.
Split; Auto.
Apply leEq_transitive with mid1; Auto.
Apply included_imp_contin with a b Hab; Auto.
Apply included_compact.
Split; Auto.
Apply leEq_transitive with mid1; Auto.
Apply compact_inc_rht.
Apply included_imp_contin with a b Hab; Auto.
Apply included_compact.
Split; Auto.
Apply leEq_transitive with mid2; Auto.
Split; Auto.
Apply leEq_transitive with mid1; Auto.
Apply included_imp_contin with a b Hab; Auto.
Apply included_compact.
Apply compact_inc_lft.
Split; Auto.
Apply leEq_transitive with mid2; Auto.
Qed.

(* Begin_Tex_Verb *)
Lemma integral_gt_zero : (a,b,Hab,F,contF:?)
  [N:=(!Norm_Funct a b Hab F contF)]
  (a[<]b)->
  (x:IR)(Compact Hab x)->(Hx:?)(Zero[<](F x Hx))->
  ((x:IR)(Compact Hab x)->(Hx:?)(Zero[<=](F x Hx)))->
  Zero[<](integral ???? contF).
(* End_Tex_Verb *)
Intros.
Rename H into Hless.
Rename H0 into H.
Rename H1 into H0.
LetTac e:=(F x Hx)[/]TwoNZ.
Cut Zero[<]e; Intros.
2: Unfold e; Apply pos_div_two; Auto.
Elim (contin_prop ???? contF e); Auto.
Intros d H3 H4.
LetTac mid1:=(Max a x[-]d).
LetTac mid2:=(Min b x[+]d).
Cut a[<=]mid1; [Intro leEq1 | Unfold mid1; Apply lft_leEq_Max].
Cut mid1[<=]mid2; [Intro leEq2 | Unfold mid1 mid2; Inversion_clear H; Apply leEq_transitive with x].
2: Apply Max_leEq; Auto.
2: Apply less_leEq; Apply shift_minus_less.
2: Apply shift_less_plus'; Step (Zero::IR); Auto.
2: Apply leEq_Min; Auto.
2: Apply less_leEq; Apply shift_less_plus'.
2: Step (Zero::IR); Auto.
Cut mid2[<=]b; [Intro leEq3 | Unfold mid2; Apply Min_leEq_lft].
Cut (Continuous_I leEq1 F).
Cut (Continuous_I leEq2 F).
Cut (Continuous_I leEq3 F).
Intros cont3 cont2 cont1.
Cut (Continuous_I (leEq_transitive ???? leEq1 leEq2) F); Intros.
Apply less_wdr with (integral ???? cont1)[+](integral ???? cont2)[+](integral ???? cont3).
2: Apply eq_transitive_unfolded with (integral ???? H5)[+](integral ???? cont3).
2: Apply bin_op_wd_unfolded.
2: Apply integral_plus_integral.
2: Algebra.
2: Apply integral_plus_integral.
RStep Zero[*](mid1[-]a)[+]Zero[*](mid2[-]mid1)[+]Zero[*](b[-]mid2).
Apply plus_resp_less_leEq.
Apply plus_resp_leEq_less.
Apply lb_integral.
Intros.
Apply H2.
Inversion_clear H6; Split; Auto.
Apply leEq_transitive with mid1; Auto.
Apply leEq_transitive with mid2; Auto.
Apply less_leEq_trans with ((F x Hx)[/]TwoNZ)[*](mid2[-]mid1).
Apply mult_resp_less.
Apply pos_div_two; Auto.
Apply shift_less_minus; Step mid1.
Elim (cotrans_less_unfolded ??? Hless x); Intro; Unfold mid1 mid2.
Apply less_leEq_trans with x.
Apply Max_less.
Auto.
Apply shift_minus_less; Apply shift_less_plus'.
Step (Zero::IR); Auto.
Apply leEq_Min.
Inversion_clear H; Auto.
Apply less_leEq; Apply shift_less_plus'.
Step (Zero::IR); Auto.
Apply leEq_less_trans with x.
Apply Max_leEq.
Inversion_clear H; Auto.
Apply shift_minus_leEq; Apply shift_leEq_plus'.
Step (Zero::IR); Apply less_leEq; Auto.
Apply less_Min.
Auto.
Apply shift_less_plus'.
Step (Zero::IR); Auto.
Apply lb_integral.
Intros.
RStep (F x Hx)[-](F x Hx)[/]TwoNZ.
Apply shift_minus_leEq; Apply shift_leEq_plus'.
Fold e; EApply leEq_transitive; [Apply leEq_AbsIR | Apply H4].
Auto.
Inversion_clear H6; Split; Auto.
Apply leEq_transitive with mid1; Auto.
Apply leEq_transitive with mid2; Auto.
Cut (x[-]d)[<=](x[+]d); Intros.
Apply compact_bnd_AbsIR with H7.
Cut (included (Compact leEq2) (Compact H7)); Auto.
Apply included_compact; Unfold mid1 mid2; Split.
Apply rht_leEq_Max.
Apply leEq_transitive with mid2; Auto.
Unfold mid2; Apply Min_leEq_rht.
Apply leEq_transitive with mid1; Auto.
Unfold mid1; Apply rht_leEq_Max.
Apply Min_leEq_rht.
Apply leEq_transitive with x.
Apply shift_minus_leEq; Apply shift_leEq_plus'.
Step (Zero::IR); Apply less_leEq; Auto.
Apply shift_leEq_plus'.
Step (Zero::IR); Apply less_leEq; Auto.
Apply lb_integral.
Intros.
Apply H2.
Inversion_clear H6; Split; Auto.
Apply leEq_transitive with mid1; Auto.
Apply leEq_transitive with mid2; Auto.
Apply included_imp_contin with a b Hab; Auto.
Apply included_compact.
Apply compact_inc_lft.
Split; Auto.
Apply leEq_transitive with mid1; Auto.
Apply included_imp_contin with a b Hab; Auto.
Apply included_compact.
Split; Auto.
Apply leEq_transitive with mid1; Auto.
Apply compact_inc_rht.
Apply included_imp_contin with a b Hab; Auto.
Apply included_compact.
Split; Auto.
Apply leEq_transitive with mid2; Auto.
Split; Auto.
Apply leEq_transitive with mid1; Auto.
Apply included_imp_contin with a b Hab; Auto.
Apply included_compact.
Apply compact_inc_lft.
Split; Auto.
Apply leEq_transitive with mid2; Auto.
Qed.


(************************************************************************)
(*         *   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)         *)
(************************************************************************)

Require Import Rbase.
Require Import Rfunctions.
Require Import Rseries.
Require Import SeqProp.
Require Import Max.
Local Open Scope R_scope.

(****************************************************)
(*              R is complete :                     *)
(*        Each sequence which satisfies             *)
(*       the Cauchy's criterion converges           *)
(*                                                  *)
(*    Proof with adjacent sequences (Vn and Wn)     *)
(****************************************************)

Theorem R_complete :
  forall Un:nat -> R, Cauchy_crit Un -> { l:R | Un_cv Un l } .
Proof.
  intros.
  set (Vn := sequence_minorant Un (cauchy_min Un H)).
  set (Wn := sequence_majorant Un (cauchy_maj Un H)).
  pose proof (maj_cv Un H) as (x,p).
  fold Wn in p.
  pose proof (min_cv Un H) as (x0,p0).
  fold Vn in p0.
  cut (x = x0).
  intros H2.
  exists x.
  rewrite <- H2 in p0.
  unfold Un_cv.
  intros.
  unfold Un_cv in p; unfold Un_cv in p0.
  cut (0 < eps / 3).
  intro H4.
  elim (p (eps / 3) H4); intros.
  elim (p0 (eps / 3) H4); intros.
  exists (max x1 x2).
  intros.
  unfold R_dist.
  apply Rle_lt_trans with (Rabs (Un n - Vn n) + Rabs (Vn n - x)).
  replace (Un n - x) with (Un n - Vn n + (Vn n - x));
  [ apply Rabs_triang | ring ].
  apply Rle_lt_trans with (Rabs (Wn n - Vn n) + Rabs (Vn n - x)).
  do 2 rewrite <- (Rplus_comm (Rabs (Vn n - x))).
  apply Rplus_le_compat_l.
  repeat rewrite Rabs_right.
  unfold Rminus; do 2 rewrite <- (Rplus_comm (- Vn n));
    apply Rplus_le_compat_l.
  assert (H8 := Vn_Un_Wn_order Un (cauchy_maj Un H) (cauchy_min Un H)).
  fold Vn Wn in H8.
  elim (H8 n); intros.
  assumption.
  apply Rle_ge.
  unfold Rminus; apply Rplus_le_reg_l with (Vn n).
  rewrite Rplus_0_r.
  replace (Vn n + (Wn n + - Vn n)) with (Wn n); [ idtac | ring ].
  assert (H8 := Vn_Un_Wn_order Un (cauchy_maj Un H) (cauchy_min Un H)).
  fold Vn Wn in H8.
  elim (H8 n); intros.
  apply Rle_trans with (Un n); assumption.
  apply Rle_ge.
  unfold Rminus; apply Rplus_le_reg_l with (Vn n).
  rewrite Rplus_0_r.
  replace (Vn n + (Un n + - Vn n)) with (Un n); [ idtac | ring ].
  assert (H8 := Vn_Un_Wn_order Un (cauchy_maj Un H) (cauchy_min Un H)).
  fold Vn Wn in H8.
  elim (H8 n); intros.
  assumption.
  apply Rle_lt_trans with (Rabs (Wn n - x) + Rabs (x - Vn n) + Rabs (Vn n - x)).
  do 2 rewrite <- (Rplus_comm (Rabs (Vn n - x))).
  apply Rplus_le_compat_l.
  replace (Wn n - Vn n) with (Wn n - x + (x - Vn n));
  [ apply Rabs_triang | ring ].
  apply Rlt_le_trans with (eps / 3 + eps / 3 + eps / 3).
  repeat apply Rplus_lt_compat.
  unfold R_dist in H1.
  apply H1.
  unfold ge; apply le_trans with (max x1 x2).
  apply le_max_l.
  assumption.
  rewrite <- Rabs_Ropp.
  replace (- (x - Vn n)) with (Vn n - x); [ idtac | ring ].
  unfold R_dist in H3.
  apply H3.
  unfold ge; apply le_trans with (max x1 x2).
  apply le_max_r.
  assumption.
  unfold R_dist in H3.
  apply H3.
  unfold ge; apply le_trans with (max x1 x2).
  apply le_max_r.
  assumption.
  right.
  pattern eps at 4; replace eps with (3 * (eps / 3)).
  ring.
  unfold Rdiv; rewrite <- Rmult_assoc; apply Rinv_r_simpl_m; discrR.
  unfold Rdiv; apply Rmult_lt_0_compat;
    [ assumption | apply Rinv_0_lt_compat; prove_sup0 ].
  apply cond_eq.
  intros.
  cut (0 < eps / 5).
  intro.
  unfold Un_cv in p; unfold Un_cv in p0.
  unfold R_dist in p; unfold R_dist in p0.
  elim (p (eps / 5) H1); intros N1 H4.
  elim (p0 (eps / 5) H1); intros N2 H5.
  unfold Cauchy_crit in H.
  unfold R_dist in H.
  elim (H (eps / 5) H1); intros N3 H6.
  set (N := max (max N1 N2) N3).
  apply Rle_lt_trans with (Rabs (x - Wn N) + Rabs (Wn N - x0)).
  replace (x - x0) with (x - Wn N + (Wn N - x0)); [ apply Rabs_triang | ring ].
  apply Rle_lt_trans with
    (Rabs (x - Wn N) + Rabs (Wn N - Vn N) + Rabs (Vn N - x0)).
  rewrite Rplus_assoc.
  apply Rplus_le_compat_l.
  replace (Wn N - x0) with (Wn N - Vn N + (Vn N - x0));
  [ apply Rabs_triang | ring ].
  replace eps with (eps / 5 + 3 * (eps / 5) + eps / 5).
  repeat apply Rplus_lt_compat.
  rewrite <- Rabs_Ropp.
  replace (- (x - Wn N)) with (Wn N - x); [ apply H4 | ring ].
  unfold ge, N.
  apply le_trans with (max N1 N2); apply le_max_l.
  unfold Wn, Vn.
  unfold sequence_majorant, sequence_minorant.
  assert
    (H7 :=
      approx_maj (fun k:nat => Un (N + k)%nat) (maj_ss Un N (cauchy_maj Un H))).
  assert
    (H8 :=
      approx_min (fun k:nat => Un (N + k)%nat) (min_ss Un N (cauchy_min Un H))).
  cut
    (Wn N =
      majorant (fun k:nat => Un (N + k)%nat) (maj_ss Un N (cauchy_maj Un H))).
  cut
    (Vn N =
      minorant (fun k:nat => Un (N + k)%nat) (min_ss Un N (cauchy_min Un H))).
  intros H9 H10.
  rewrite <- H9 in H8 |- *.
  rewrite <- H10 in H7 |- *.
  elim (H7 (eps / 5) H1); intros k2 H11.
  elim (H8 (eps / 5) H1); intros k1 H12.
  apply Rle_lt_trans with
    (Rabs (Wn N - Un (N + k2)%nat) + Rabs (Un (N + k2)%nat - Vn N)).
  replace (Wn N - Vn N) with
  (Wn N - Un (N + k2)%nat + (Un (N + k2)%nat - Vn N));
  [ apply Rabs_triang | ring ].
  apply Rle_lt_trans with
    (Rabs (Wn N - Un (N + k2)%nat) + Rabs (Un (N + k2)%nat - Un (N + k1)%nat) +
      Rabs (Un (N + k1)%nat - Vn N)).
  rewrite Rplus_assoc.
  apply Rplus_le_compat_l.
  replace (Un (N + k2)%nat - Vn N) with
  (Un (N + k2)%nat - Un (N + k1)%nat + (Un (N + k1)%nat - Vn N));
  [ apply Rabs_triang | ring ].
  replace (3 * (eps / 5)) with (eps / 5 + eps / 5 + eps / 5);
  [ repeat apply Rplus_lt_compat | ring ].
  assumption.
  apply H6.
  unfold ge.
  apply le_trans with N.
  unfold N; apply le_max_r.
  apply le_plus_l.
  unfold ge.
  apply le_trans with N.
  unfold N; apply le_max_r.
  apply le_plus_l.
  rewrite <- Rabs_Ropp.
  replace (- (Un (N + k1)%nat - Vn N)) with (Vn N - Un (N + k1)%nat);
  [ assumption | ring ].
  reflexivity.
  reflexivity.
  apply H5.
  unfold ge; apply le_trans with (max N1 N2).
  apply le_max_r.
  unfold N; apply le_max_l.
  pattern eps at 4; replace eps with (5 * (eps / 5)).
  ring.
  unfold Rdiv; rewrite <- Rmult_assoc; apply Rinv_r_simpl_m.
  discrR.
  unfold Rdiv; apply Rmult_lt_0_compat.
  assumption.
  apply Rinv_0_lt_compat.
  prove_sup0; try apply lt_O_Sn.
Qed.


Require Import Crypto.Arithmetic.PrimeFieldTheorems.
Require Import Crypto.Specific.montgomery64_2e338m15_6limbs.Synthesis.

(* TODO : change this to field once field isomorphism happens *)
Definition sub :
  { sub : feBW_small -> feBW_small -> feBW_small
  | forall a b, phiM_small (sub a b) = F.sub (phiM_small a) (phiM_small b) }.
Proof.
  Set Ltac Profiling.
  Time synthesize_sub ().
  Show Ltac Profile.
Time Defined.

Print Assumptions sub.


(* math-algebra (c) 2020 Dr Daniel Kirk *)

Require Import Coq.Program.Tactics.
Require Import Coq.Logic.FunctionalExtensionality.
From mathcomp Require Import ssreflect ssrfun seq.
From mathcomp Require Import eqtype choice fintype path bigop finfun matrix.

Set Warnings "-parsing". (* Some weird bug in ssrbool throws out parsing warnings*)
  From mathcomp Require Import ssrbool ssrnat.
Set Warnings "parsing".

Set Warnings "-ambiguous-paths". (* Some weird bug in ssralg throws out coercion warnings*)
    From mathcomp Require Import ssralg.
Set Warnings "ambiguous-paths".

Require Import Algebras DirectSum Classes Basis Morphism.
Set Implicit Arguments.
Unset Strict Implicit.
Open Scope ring_scope.

Include GRing.

(*
  Definitions of the Free and Finite Dimensional Free Module Types
    *)

Module freeLmod.
  Section Def.
    Variable (R : ringType).
    Record mixin (M : lmodType R) := Mixin { basis : lmodBasisType M; }.
    Record type := Pack { sort : _ ;  class_of : mixin sort; }.
    Definition Build {M : lmodType R} (B : lmodBasisType M) := Pack (Mixin B).
  End Def.

  Section Results.

  End Results.

  Module Exports.
    Notation freeLmodType := type.
    Notation basis := basis.
    Notation freeLmodPack := Build.
    Coercion sort : type >-> lmodType.
    Coercion class_of : type >-> mixin.
  End Exports.
End freeLmod.
Export freeLmod.Exports.

(* Finite dimenisonal free modules are compatible with finite direct sums
   That is they can be built-up and have corresponding proj and inj morphisms *)
Module fdFreeLmod.
  Section Def.
    Variable (R : ringType).
    Record mixin (M : lmodType R) := Mixin { fdBasis : lmodFinBasis.type M; }.
    Record type := Pack { sort : _ ;  class_of : mixin sort; }.
    Definition Build {M : lmodType R} (B : lmodFinBasis.type M) := Pack (Mixin B).

    Definition to_arb (F : type) := freeLmod.Build (lmodFinBasis.to_lmodBasis (fdBasis (class_of F))).
  End Def.

  Section Results.

  End Results.

  Section Basis.
    Variable (R : ringType) (M : type R).
    Local Coercion sort : type >-> lmodType.
    Local Coercion class_of : type >-> mixin.

    Definition coef : (fdBasis M) -> {scalar M} := fun b => \finBasisProj_b^(fdBasis M).
  End Basis.

  Module Exports.
    Notation fdFreeLmodType := type.
    Notation fdBasis := fdBasis.
    Notation fdFreeLmodPack := Build.
    Notation "\fdFreeBasisCoef_( b ) x" := (@coef _ _ b x) (at level 36).
    Coercion sort : type >-> lmodType.
    Coercion class_of : type >-> mixin.
  End Exports.
End fdFreeLmod.
Export fdFreeLmod.Exports.

(*
  Free Module Types of:
    the trivial modules (null basis)
    the ring as a module over itself (unit basis)
    matrix modules over a ring
    polynomial modules over a ring
    *)

Module fdFreeLmodNull.
  Section Def.
    Variable (R : ringType).

    Definition nullBasis_fn := fun x : void => match x with end : (lmodZero.type R).

    Lemma null_injective : injective nullBasis_fn.
    Proof. by move=>x; destruct x. Qed.

    Lemma null_nondeg : non_degenerate nullBasis_fn.
    Proof. by move=>x; destruct x. Qed.

    Definition null_set := lmodFinSet.Build null_injective null_nondeg.

    Lemma null_li : li null_set.
    Proof. move=>c H b; case b. Qed.
(*
    Lemma fn_zero_lin : linear_for *%R (fun _ : (lmodZero.type R) => 0 : R).
    Proof. by move => r x y; rewrite mulr0 addr0. Qed.

    Lemma null_orth : orthonormP (B:=null_set) (fun _ : null_set => Linear fn_zero_lin).
    Proof. rewrite/orthonormP=>m1 m2; case m1, m2. Qed.

    Lemma null_basis : lmodBasis.basisP (B:=null_set) (fun _ : null_set => Linear fn_zero_lin).
    Proof. rewrite/lmodBasis.basisP=>m1 m2;
    by apply (iffP idP)=>H//=. Qed.

    Definition null_basis_set := lmodBasis.Build (O := null_orth) null_basis.
*)
    Lemma null_sp : spanning null_set.
    Proof. move=>m; rewrite/lmodFinBasis.spanProj;
      refine(exist _ (fun x : null_set => match x with end) _).
      by rewrite /lmodFinBasis.spanProp/nullBasis_fn big_pred0.
    Qed.
(*
    Lemma li_sp : li null_set.
    Proof. rewrite/li=>c H b/=.
    destruct b. Qed.
*)
    Definition basis := lmodFinBasis.Build null_li null_sp.
  End Def.
  Module Exports.
    Canonical null_fdFreeLmod (R : ringType) := Eval hnf in @fdFreeLmodPack R _ (fdFreeLmodNull.basis R).
  End Exports.
End fdFreeLmodNull.
Export fdFreeLmodNull.Exports.

Module freeRingModule.
  Section Def.
    Variable (R : ringType).
    Definition fn := fun _ : unit_eqType => (GRing.one R) : (ringModType R).
    Lemma fn_injective : injective fn.
      Proof. by move=>x y; destruct x, y. Qed.
    Lemma fn_nondegen : non_degenerate fn.
      Proof. rewrite /fn=>x; apply GRing.oner_neq0. Qed.

    Definition bset := lmodFinSet.Build fn_injective fn_nondegen.

    Lemma bset_li : li bset.
    Proof. move=>/=c H b; move: H.
      rewrite -big_enum big_enum_cond/fn(big_pred1 tt)
      /(GRing.scale _)=>/=;by [rewrite GRing.mulr1; case b|
      rewrite /pred1=>x; case x].
    Qed.

    Lemma bset_spanning : spanning bset.
    Proof. move=>/=x. rewrite /lmodFinBasis.spanProj.
      refine (exist _ (fun _ => linID.map _) _).
      rewrite /lmodFinBasis.spanProp -big_enum big_enum_cond/fn
      (big_pred1 tt) /(scale _); unlock linID.map=>/=;
      by [rewrite GRing.mulr1|rewrite /pred1=>x'; case x'].
    Qed.

    Definition basis : lmodFinBasisType (ringModType R) := lmodFinBasis.Build bset_li bset_spanning.
  End Def.
  Module Exports.
    Canonical unit_fdFreeLmod (R : ringType) := Eval hnf in @fdFreeLmodPack R (ringModType R) (freeRingModule.basis R).
  End Exports.
End freeRingModule.
Export freeRingModule.Exports.

Module freeLmodMatrix.
  Section Def.
    Variable (R : ringType) (m n : nat).
    Definition fn pp := @delta_mx R m n pp.1 pp.2.
    Lemma fn_injective : injective fn.
        Proof. rewrite/fn=>x y; rewrite /delta_mx -matrixP=>H.
        assert(H := H y.1 y.2).
        assert(Gx := @mxE R m n delta_mx_key (fun i j => ((i == x.1) && (j == x.2))%:R)).
        assert(Gy := @mxE R m n delta_mx_key (fun i j => ((i == y.1) && (j == y.2))%:R)).
        rewrite /eqrel (unlock _) in H, Gx, Gy.
        rewrite (Gx y.1 y.2) (Gy y.1 y.2) !eq_refl in H; simpl in H.
        have: (y.1 == x.1) by
          case(y.1 == x.1) as []eqn:E=>//; move: H;
          rewrite !E !(rwP eqP) eq_sym oner_eq0.
        have: (y.2 == x.2) by
          case(y.2 == x.2) as []eqn:E=>//; move: H;
          rewrite E andbC !(rwP eqP) eq_sym oner_eq0.
        destruct x, y; rewrite -!(rwP eqP)=>/=H1 H2.
        by rewrite H1 H2.
        Qed.

      Lemma fn_nondegen : non_degenerate fn.
        Proof. rewrite /fn=>x; rewrite /delta_mx -(rwP negP)-(rwP eqP)-matrixP=>H.
        assert(H := H x.1 x.2).
        assert(Gx := @mxE R m n delta_mx_key (fun i j => ((i == x.1) && (j == x.2))%:R)).
        rewrite /eqrel (unlock _) in H Gx.
        by move:H; rewrite (Gx x.1 x.2) !eq_refl /(const_mx 0)
        (@mxE R m n const_mx_key (fun i j => 0%:R)) (rwP eqP) oner_eq0.
        Qed.

      Definition fn_bset := lmodFinSet.Build fn_injective fn_nondegen.

      Lemma fn_li : li fn_bset.
      Proof. move=>/=c H b; move: H=>/=.
      rewrite /fn.
      rewrite -big_enum enumT =>/=.
      rewrite (unlock finEnum_unlock)=>/=.
      rewrite {2}(matrix_sum_delta 0).
      rewrite -!big_enum enumT=>/=.
      rewrite (eq_bigr(fun i : ordinal_finType m => 0) _)=>/=.
      rewrite big_allpairs=>/=.
      rewrite big_const_seq.
      have: forall S : seq(ordinal_finType m), iter (count xpredT S) (+%R 0) 0 = 0 by
      move=>t S;
      induction S=>//=;
      rewrite IHS addr0.
      move=>H; rewrite H; clear H.
      case(c b == 0) as []eqn:E=>//.
      destruct b as [[b1 B1] [b2 B2]].
      Admitted.

      Definition elemFun_raw : fn_bset -> 'M_(m,n) -> R
      := fun ij => fun A : 'M_(m,n) => A ij.1 ij.2.
      Lemma elemFun_sca (b : fn_bset) : scalar (elemFun_raw b).
      Proof. rewrite/elemFun_raw=>r x y.
      Admitted.
      Definition elemFun : fn_bset -> {scalar 'M[R]_(m,n)}
       := fun b => Linear (elemFun_sca b).

    Lemma fn_spanning : spanning fn_bset.
    Proof. move=>/=A. rewrite /lmodFinBasis.spanProj.
    refine (exist _ elemFun _).
    by rewrite /lmodFinBasis.spanProp/elemFun/elemFun_raw/fn
    {2}(matrix_sum_delta A) -big_enum enumT (unlock finEnum_unlock) big_allpairs big_enum
     (eq_bigr (fun i : 'I_m => \sum_(j < n) A i j *: delta_mx i j) _)
     =>[|i H]; rewrite -big_enum.
    Qed.

      Definition basis : lmodFinBasisType (matrix_lmodType R m n) := lmodFinBasis.Build fn_li fn_spanning.
  End Def.
  Module Exports.
    Canonical Structure fdFreeLmod_matrix (R : ringType) (m n : nat) := Eval hnf in fdFreeLmodPack (freeLmodMatrix.basis R m n).
  End Exports.
End freeLmodMatrix.
Export freeLmodMatrix.Exports.

Section Morphisms.
  Variable (R : ringType).

  Section VectorConversion.
   Variable (M : fdFreeLmodType R)
    (n : nat) (E : n = size (enum (to_FinType (fdBasis M)))).

    Definition to_row_raw : M -> 'rV[R]_n  := fun x =>
    \row_(i < n)
      \fdFreeBasisCoef_(lmodFinSet.from_ord E i) x.

    Definition from_row_raw : 'rV[R]_n -> M  := fun x =>
      \sum_(b : fdBasis M)
        x (Ordinal (ltn0Sn 0)) (lmodFinSet.to_ord E b) *: (fdBasis M b).

    Lemma from_row_lin : linear from_row_raw.
    Proof. rewrite/from_row_raw=>r x y.
    Admitted.
    Lemma to_row_lin : linear to_row_raw.
    Proof. rewrite/to_row_raw=>r x y.
    Admitted.

    Definition from_row := Linear from_row_lin.
    Definition to_row := Linear to_row_lin.

    Lemma tofrom_rowK : cancel to_row from_row.
    Proof. simpl; rewrite/from_row_raw/to_row_raw=>x.
    rewrite -{2}(lmodFinBasis.coefP (fdBasis M) x).
    refine (eq_bigr _ _)=> b _.
    rewrite /matrix_of_fun(unlock _)/matrix_of_fun_def.
    Admitted.

    Lemma fromto_rowK : cancel from_row to_row.
    Proof. simpl; rewrite/from_row_raw/to_row_raw=>x.
    Admitted.
  End VectorConversion.

  Section MatrixConversion.
    Variable (M N : fdFreeLmodType R)
    (m : nat) (Em : m = size (enum (to_FinType (fdBasis M))))
    (n : nat) (En : n = size (enum (to_FinType (fdBasis N)))).

    Definition to_map (f : {linear M -> N}) : {linear 'rV[R]_m -> 'rV[R]_n}
     := (to_row En) \oLin f \oLin (from_row Em).

    Definition from_map (f : {linear 'rV[R]_m -> 'rV[R]_n}) : {linear M -> N}
      := (from_row En) \oLin f \oLin (to_row Em).

    Lemma tofrom_mapK : cancel to_map from_map.
    Proof. simpl; rewrite/from_map/to_map=>f/=.
    Admitted.

    Lemma fromto_mapK : cancel from_map to_map.
    Proof. rewrite/from_map/to_map=>f.
    rewrite /linConcat.map -(lock _).
    Admitted.
  End MatrixConversion.
End Morphisms.

(*

  Direct Sums of Free Modules

    *)

Reserved Notation "\fbigoplus_ i F"
  (at level 36, F at level 36, i at level 0,
    right associativity,
          format "'[' \fbigoplus_ i '/ ' F ']'").

Reserved Notation "\fbigoplus F"
  (at level 36, F at level 36,
    right associativity,
          format "'[' \fbigoplus F ']'").

Reserved Notation "\fbigoplus_ ( i <- r ) F"
  (at level 36, F at level 36, i, r at level 50,
          format "'[' \fbigoplus_ ( i <- r ) '/ ' F ']'").

Reserved Notation "\fbigoplus_ ( i : t ) F"
  (at level 36, F at level 36, i at level 50,
          format "'[' \fbigoplus_ ( i : t ) '/ ' F ']'").

Reserved Notation "\fbigoplus_ ( i 'in' A ) F"
  (at level 36, F at level 36, i, A at level 50,
          format "'[' \fbigoplus_ ( i 'in' A ) '/ ' F ']'").

Reserved Notation "\fproj^( I )_ f "
(at level 36, f at level 36, I at level 36,
  format "'[' \fproj^( I )_ f ']'").

Reserved Notation "\finj^( I )_ f "
(at level 36, f at level 36, I at level 36,
  format "'[' \finj^( I )_ f ']'").

Module dsFdFreeLmod.
  Module Pair.
    Section Def.
      Variable (R : ringType).
      Variable (M1 M2 : lmodType R) (B1 : lmodFinBasisType M1) (B2 : lmodFinBasisType M2).
      Definition pairBasis_fn : B1 + B2 -> M1 * M2 :=
        fun x => match x with
          |inl y => (B1 y, 0%R)
          |inr y => (0%R, B2 y)
        end.

      Lemma pair_injective : injective pairBasis_fn.
      Proof. move=>x y H; case x as [a1|a1]eqn:E1, y as [a2|a2]eqn:E2; inversion H.
        all:try by rewrite (typeIsInjective H1).
        all:assert (Y := typeIsNonDegenerate a1);
        (rewrite -H1 in Y || rewrite -H2 in Y);
        apply (rwP negP) in Y; by rewrite (eq_refl) in Y.
      Qed.

      Lemma pair_nondeg : non_degenerate pairBasis_fn.
      Proof. move=>x; rewrite /pairBasis_fn; apply(rwP negP).
        by case x as [a|a];
        [assert(A := typeIsNonDegenerate a)| assert(A := typeIsNonDegenerate a)];
        apply(rwP negP) in A; contradict A; apply(rwP eqP) in A; inversion A.
      Qed.

      Definition pair_set := lmodFinSet.Build pair_injective pair_nondeg.

      Lemma pair_zero (M N : lmodType R) (F G : finType) (f : F -> M) (g : G -> N) (m : M) (n : N):
        \sum_i (f i, 0)%R + \sum_i (0, g i) == (m,n)
        <-> (\sum_i f i == m /\ \sum_i g i == n).
      Proof. split; [move=> H|move=> [H1 H2]]. {
          have:(\sum_i (dsLmod.Pair.inj1 M N (f i)) + \sum_i (dsLmod.Pair.inj2 M N (g i)) == (m, n))
            by apply H.
          rewrite -!GRing.raddf_sum/dsLmod.Pair.inj1/dsLmod.Pair.inj2/(@add _) =>/=.
          rewrite /add_pair add0r addr0 -(rwP eqP)=>H0;
          by inversion H0.
        } {
          move: H1 H2; rewrite -!(rwP eqP)=>H1 H2.
          have:(\sum_i (dsLmod.Pair.inj1 _ _  (f i)) == (m, @zero N))
            by rewrite -raddf_sum/dsLmod.Pair.inj1 H1.
          have:(\sum_i (dsLmod.Pair.inj2 _ _ (g i)) == (@zero M, n))
            by rewrite -raddf_sum/dsLmod.Pair.inj2 H2=>/=.
          rewrite -!(rwP eqP)=>H H0.
          have:(\sum_i (dsLmod.Pair.inj1 _ _ (f i)) + \sum_i (dsLmod.Pair.inj2 _ _ (g i)) == (m, n))
            by rewrite H H0 {1}/(@add (pair_lmodType M N))=>/=;
            rewrite /add_pair add0r addr0.
          by rewrite /dsLmod.Pair.inj1/dsLmod.Pair.inj2 -(rwP eqP).
        }
      Qed.

      Lemma pair_li : li pair_set.
      Proof.
        move=>c H b.
        move: H; rewrite big_sumType/(scale _)=>/=.
        rewrite (eq_bigr (fun i => (c (inl i) *: B1 i, 0))) =>[|i _]/=.
        rewrite (eq_bigr (fun i => ((0, c (inr i) *: B2 i)))) =>[|j _]/=.
        move=>H.
        apply pair_zero in H as [H1 H2].
        case b as [a|a]eqn:E; [apply (typeIsLI H1 a)|apply (typeIsLI H2 a)].
        all:by rewrite /(scale _)=>/=; rewrite /scale_pair scaler0.
      Qed.

      Definition coefJoin_fn
        (b : pair_set)
        (c1 : B1 -> {scalar M1}) (c2 : B2 -> {scalar M2})
          := fun b m => match b with inl b' => c1 b' m.1|inr b' => c2 b' m.2 end.

      Lemma coefJoin_lin
      (b : pair_set)
      (c1 : B1 -> {scalar M1}) (c2 : B2 -> {scalar M2})
        : linear_for *%R (coefJoin_fn b c1 c2 b).
      Proof. rewrite/coefJoin_fn=>r x y.
      case b=>s; by rewrite /add linearP. Qed.

      Lemma pair_sp : spanning pair_set.
      Proof. move=> m; rewrite /lmodFinBasis.spanProj.
        destruct (typeIsSpanning B1 m.1) as [p1 H1], (typeIsSpanning B2 m.2) as [p2 H2].
        refine (exist _ (fun p => Linear (@coefJoin_lin p p1 p2)) _).
        rewrite /lmodFinBasis.spanProp big_sumType=>/=.
        rewrite (eq_bigr (fun i => (p1 i m.1 *: B1 i, 0)))=>[|i _]/=.
        rewrite (eq_bigr (fun i => (0, p2 i m.2 *: B2 i)))=>[|i _]/=.
        by rewrite pair_zero.
        all:by rewrite /(scale _)=>/=; rewrite /scale_pair scaler0.
      Qed.

      Definition basis : lmodFinBasisType (pair_lmodType M1 M2) := lmodFinBasis.Build pair_li pair_sp.
    End Def.

    Definition fdFreeLmod (R : ringType) (m1 m2 : fdFreeLmodType R) := fdFreeLmodPack (basis (fdBasis m1) (fdBasis m2)).
    Section Results.
    Variable (R : ringType).
    Variable (M1 M2 : fdFreeLmodType R).
    Definition inj1 : {linear M1 -> fdFreeLmod M1 M2} := dsLmod.Pair.inj1 M1 M2.
    Definition inj2 : {linear M2 -> fdFreeLmod M1 M2} := dsLmod.Pair.inj2 M1 M2.

    Definition proj1 : {linear fdFreeLmod M1 M2 -> M1} := dsLmod.Pair.proj1 M1 M2.
    Definition proj2 : {linear fdFreeLmod M1 M2 -> M2} := dsLmod.Pair.proj2 M1 M2.
    End Results.

    Module Exports.
      Infix "\foplus" := (fdFreeLmod) (at level 36).
      Canonical fdFreeLmod.
    End Exports.
  End Pair.
  Export Pair.Exports.

  Module Seq.
    Section Def.
      Variable (R : ringType) (T : eqType) (I : T -> (fdFreeLmodType R)).

      Fixpoint iterSum (L : seq T) := match L with
      |nil => to_FinType (fdBasis (null_fdFreeLmod R))
      |a::L' => (sum_finType (to_FinType (fdBasis (I a))) (iterSum L'))
      end.

      Fixpoint fn (L : seq T) : (iterSum L) -> (dsLmod.Seq.DS I L) :=
        match L with
          |nil => fun=> (tt : dsLmod.Seq.DS (fun x : T => I x) [::])
          |a::L' => fun x : iterSum (a::L') => match x with
            |inl y => (fdBasis (I a) y, 0)
            |inr y => (0, @fn L' y) : dsLmod.Seq.DS  (fun x0 : T => I x0) (a::L')
          end
        end.

      Section Seq.
        Variable (L : seq T).
        Lemma fn_injective : injective (@fn L).
        Proof.
          induction L=>/=x y H=>//.
        Admitted. (*
        case x as [a1|a1]eqn:E1, y as [a2|a2]eqn:E2; inversion H.
        have: (fdBasis (I a) a1 == fdBasis (I a) a2).
        case (fdBasis (I a) a1 == fdBasis (I a) a2) as []eqn:E=>//.
        rewrite /lmodFinSet.base/lmodFinSet.class_of in H1.
        simpl in H1.
        Check @typeIsInjective _ _ (lmodFinSet.base (lmodFinSet.class_of (fdBasis (I a)))) a1 a2.
        case (fdBasis (I a) a1 == fdBasis (I a) a2).
        admit.
        Check @typeIsNonDegenerate _ _ (fdBasis (I a)) a1.

        Check typeIsInjective H1.
        simpl in H1.
        Check IHL _ _ H1.
        case x as [sx|tx].
        case y as [sy|ty].

        case x as [a1|a1]eqn:E1, y as [a2|a2]eqn:E2; inversion H.
          all:try by rewrite (typeIsInjective H1).
          all:assert (Y := typeIsNonDegenerate a1);
          (rewrite -H1 in Y || rewrite -H2 in Y);
          apply (rwP negP) in Y; by rewrite (eq_refl) in Y.
        Qed.*)

        Lemma fn_nondeg : non_degenerate (@fn L).
        Proof. Admitted.

        Definition bset := lmodFinSet.Build fn_injective fn_nondeg.

        Lemma seq_li : li bset.
        Proof. Admitted.
  (*
        Definition coefJoin_fn
          (b : bset)
          (c1 : B1 -> {scalar M1}) (c2 : B2 -> {scalar M2})
            := fun b m => match b with inl b' => c1 b' m.1|inr b' => c2 b' m.2 end.

        Lemma coefJoin_lin
        (b : pair_set)
        (c1 : B1 -> {scalar M1}) (c2 : B2 -> {scalar M2})
          : linear_for *%R (coefJoin_fn b c1 c2 b).
        Proof. rewrite/coefJoin_fn=>r x y.
        case b=>s; by rewrite /add linearP. Qed.
        *)
        Lemma seq_sp : spanning bset.
        Proof. Admitted. (*move=> m; rewrite /lmodFinBasis.spanProj.
          destruct (typeIsSpanning B1 m.1) as [p1 H1], (typeIsSpanning B2 m.2) as [p2 H2].
          refine (exist _ (fun p => Linear (@coefJoin_lin p p1 p2)) _).
          rewrite /lmodFinBasis.spanProp big_sumType=>/=.
          rewrite (eq_bigr (fun i => (p1 i m.1 *: B1 i, 0)))=>[|i _]/=.
          rewrite (eq_bigr (fun i => (0, p2 i m.2 *: B2 i)))=>[|i _]/=.
          by rewrite pair_zero.
          all:by rewrite /(scale _)=>/=; rewrite /scale_pair scaler0.
        Qed.*)

        Definition basis : lmodFinBasisType (dsLmod.Seq.DS I L) := lmodFinBasis.Build seq_li seq_sp.
      End Seq.
    End Def.

    Definition fdFreeLmod (R : ringType) (T : eqType) (I : T -> (fdFreeLmodType R)) (L : seq T) := fdFreeLmodPack (basis I L).
    (*Section Results.
    Variable (R : ringType).
    Variable (T : eqType) (I : T -> (fdFreeLmodType R)) (L : seq T).
    Variable (n : 'I_(size L)).
    Definition inj : {linear dsLmod.Seq.Nth I L n -> fdFreeLmod I L} := dsLmod.Seq.inj I L.

    Definition proj : {linear fdFreeLmod M1 M2 -> M2} := dsLmod.Pair.proj2 M1 M2.
    End Results.*)

    Module Exports.
      Canonical fdFreeLmod.
    End Exports.
  End Seq.
  Export Seq.Exports.

(*Check fun (R : ringType) (T : eqType) (I : T -> (fdFreeLmodType R)) (L : seq T)
  (x : dsLmod.Seq.DS I L) b => \fdFreeBasisCoef_(b) x.*)
(*
  Module Seq.
    Section Def.
      Variable (R : ringType).
      Fixpoint type (L : seq (fdFreeLmodType R)) : fdFreeLmodType R :=
        match L with
        |nil => null_fdFreeLmod R
        |a::l => a \foplus (type l)
        end.
    End Def.
    Definition fdFreeLmod (R : ringType) (L : seq (fdFreeLmodType R)) := type L.
    (*Definition fdFreeLmod (R : ringType) (L : seq (fdFreeLmodType R))
      := fdFreeLmodPack (fdBasis (type L)).
  Canonical Seq.fdFreeLmod.*)
  End Seq.
*)
  Section Def.
    Variable (R : ringType).
    Variable (F : finType) (I : F -> (fdFreeLmodType R)).
    Definition type := Seq.fdFreeLmod I (enum F).
    (*Lemma is_ds
      : \bigoplus_(f : F)(fun f => fdFreeLmod.sort (I f)) = fdFreeLmod.sort type.
    Proof. rewrite /type/dsLmod.DS.
      by induction (enum F)=>//=; rewrite IHl.
    Qed.

    Definition to_ds_raw : type -> \bigoplus I.
    Proof. move=> x.
    by rewrite is_ds. Defined.

    Lemma to_ds_lin : linear to_ds_raw.
    Proof. rewrite /to_ds_raw/eq_rect_r/eq_rect=>r x y.
      by destruct (Logic.eq_sym is_ds). Qed.
    Definition to_ds := Linear to_ds_lin.

    Definition proj_raw (f : F) (x : type) : I f
    := (\proj_f^(I) \oLin to_ds) x.

    Lemma proj_lin (f : F) : linear (proj_raw f).
    Proof. rewrite/proj_raw=> r x y; by rewrite !GRing.linearPZ. Qed.

    Definition from_ds_raw : \bigoplus I -> type.
    Proof. move=> x. by rewrite is_ds in x. Defined.

    Lemma from_ds_lin : linear from_ds_raw.
    Proof. rewrite /from_ds_raw=>r x y; by destruct (is_ds). Qed.
    Definition from_ds := Linear from_ds_lin.

    Lemma to_from_dsK : cancel from_ds to_ds.
    Proof. simpl; rewrite/cancel/to_ds_raw/from_ds_raw=>x/=; by case (is_ds). Qed.

    Lemma from_to_dsK : cancel to_ds from_ds.
    Proof. simpl; rewrite/cancel/to_ds_raw/from_ds_raw=>x/=; by destruct (is_ds). Qed.

    Definition inj_raw (f : F) (x : I f) : type
    := (from_ds \oLin \inj_f^(I)) x.

    Lemma inj_lin (f : F) : linear (@inj_raw f).
    Proof. rewrite/inj_raw=> r x y; by rewrite !linearPZ. Qed.

    Definition proj (f : F) : {linear type -> I f} := Linear (proj_lin f).
    Definition inj (f : F) : {linear I f -> type} := Linear (@inj_lin f).*)
  End Def.
  Section Split.
  Variable (R : ringType) (F G H : finType) (I : F -> fdFreeLmodType R)
    (F_GH : G + H -> F) (enumB : enum F = map F_GH (enum (sum_finType G H))).

    Definition Jj : G -> F := fun g : G => F_GH (inl g).
    Definition Kk : H -> F := fun h : H => F_GH (inr h).
    Definition J : G -> fdFreeLmodType R := fun g : G => I (Jj g).
    Definition K : H -> fdFreeLmodType R := fun h : H => I (Kk h).
(*
    Definition split : {linear type I -> @fdFreeLmodPack _ (type J \oplus type K) (Pair.basis (fdBasis (type J)) (fdBasis (type K)))}
     := dsLmod.split _ _.*)
     End Split.
  (*
  Section Results.
    Variable (R : ringType) (F : finType) (I : F -> fdFreeLmodType R).

    Lemma proj_injK (f : F) x : proj I f (inj I f x) = x.
    Proof. by simpl; rewrite /proj_raw/inj_raw -linCompChain-linCompChain
    to_from_dsK dsLmod.proj_injK. Qed.

    Lemma proj_inj0 (f f' : F) x : f != f' -> proj I f (inj I f' x) = 0.
    Proof. by simpl; rewrite /proj_raw/inj_raw -linCompChain-linCompChain=>H; by rewrite to_from_dsK dsLmod.proj_inj0. Qed.
  End Results.

  Section Split.
    Variable (R : ringType) (F G H : finType) (I : F -> fdFreeLmodType R)
      (F_GH : G + H -> F) (enumB : enum F = map F_GH (enum (sum_finType G H))).

    Definition oF_to_oGH : ordinal_subType #|F| -> ordinal_subType #|(sum_finType G H)|.
    Proof. by rewrite !cardT enumB size_map. Defined.

    Lemma bij : bijective F_GH. Admitted.

    Definition Jj : G -> F := fun g : G => F_GH (inl g).
    Definition Kk : H -> F := fun h : H => F_GH (inr h).
    Definition J : G -> fdFreeLmodType R := fun g : G => I (Jj g).
    Definition K : H -> fdFreeLmodType R := fun h : H => I (Kk h).

    Definition dsSplit : type I -> pair_lmodType (dsLmod.DS J) (dsLmod.DS K)
     := (@dsLmod.split _ _ _ _ I F_GH) \oLin to_ds I.

    Definition split_raw : type I -> type J \foplus type K
     := fun x => (from_ds J (dsSplit x).1,from_ds K (dsSplit x).2).

    Definition unsplit_raw : type J \foplus type K -> type I
    := fun x => from_ds I (dsLmod.unsplit _ F_GH (to_ds J x.1,to_ds K x.2)).

    Lemma split_lin : linear split_raw.
    Proof. rewrite/split_raw/dsSplit=>r x y.
    by rewrite !linearP. Qed.
    Definition split := Linear split_lin.

    Lemma unsplit_lin : linear unsplit_raw.
    Proof. rewrite/unsplit_raw=>r x y.
    rewrite !linearPZ.
    rewrite -!linearPZ.
    (have: (to_ds J (r *: x.1 + y.1), to_ds K (r *: x.2 + y.2))
     = (r *: (to_ds J x.1, to_ds K x.2) +
     (to_ds J y.1, to_ds K y.2))
    by rewrite !/(scale _) !linearPZ /scale_pair)=>E.
    by rewrite E.
    Qed.
    Definition unsplit := Linear unsplit_lin.

    Lemma split_unsplitK : cancel split unsplit.
      Proof. simpl;
        rewrite /unsplit_raw/split_raw/dsSplit=>x.
        (have:forall p1 p2, (p1,p2).1 = p1 by []);
        (have:forall p1 p2, (p1,p2).2 = p2 by [])=> H2 H1.
        rewrite H1 H2 !to_from_dsK -!linCompChain (dsLmod.split_unsplitK bij).
        by rewrite from_to_dsK.
      Qed.

    Lemma unsplit_splitK : cancel unsplit split.
      Proof. simpl;
        rewrite /split_raw/unsplit_raw/dsSplit=>x.
        rewrite  -linCompChain to_from_dsK (dsLmod.unsplit_splitK bij).
        by rewrite !from_to_dsK; destruct x.
      Qed.

  End Split.*)
  Module Exports.
  End Exports.
  End dsFdFreeLmod.
Definition dsFdFreeLmodType (R : ringType) (F : finType) (I : F -> (fdFreeLmodType R)) := dsFdFreeLmod.type I.

Export dsFdFreeLmod.Pair.Exports.
Export dsFdFreeLmod.Seq.Exports.
Export dsFdFreeLmod.Exports.
(*
Notation "\fbigoplus_ i F" := (dsFdFreeLmodType (fun i => F)).
Notation "\fbigoplus F" := (dsFdFreeLmodType F).
Notation "\fbigoplus_ ( i : t ) F" := (dsFdFreeLmodType (fun i : t => F)).
Notation "\fbigoplus_ ( i 'in' A ) F" := (dsFdFreeLmod.Seq.fdFreeLmod (filter F (fun i => i \in A))).
Notation nullBasis := fdFreeLmodNull.basis.
Notation pairBasis := dsFdFreeLmod.Pair.basis.
*)
(*
Check fun (R : ringType) (F G H : finType)
  (I : F -> (fdFreeLmodType R)) (F_GH : G + H -> F)
  (enumB : enum F = map F_GH (enum (sum_finType G H)))
  (x : \bigoplus_(i : F) I) b => \fdFreeBasisCoef_(b) (dsLmod.split I F_GH x).
*)

(*Check fun (R : ringType) => fun M1 M2 : fdFreeLmodType R => fun (x : M1 \oplus M2) (b : _) => \fdFreeBasisProj_(b) x.*)
(*Check fun (R : ringType) (F : finType) (I : F -> (fdFreeLmodType R))
  (x : \bigoplus_(i : F) I) b => \fdFreeBasisCoef_(b) x.

Notation "\fproj^( I )_ f " := (dsFdFreeLmod.proj I f ).
Notation "\finj^( I )_ f " := (dsFdFreeLmod.inj I f ).
Notation "\fproj_ f ^( I )" := (dsFdFreeLmod.proj I f ).
Notation "\finj_ f ^( I )" := (dsFdFreeLmod.inj I f ).
*)

Close Scope ring_scope.