Require Export List.
Require Export Bool.
Require Export Arith.
Require Export Peano_dec.
Require Export Coq.Arith.PeanoNat.
Require Export Coq.Program.Wf.
Require Export Coq.Program.Tactics.
Require Export Coq.Logic.FunctionalExtensionality.
Require Export Recdef.

Require Import common.CpdtTactics.
Require Import common.wyv_common.
Require Import common.rhs_mat_tree.

Import WfExtensionality.

Lemma subtype_sel_equ_rfn_top_reduce :
  forall T1 x1 L1 T1', T1 = (t_sel_equ x1 L1 T1') ->
                  forall T2 Ts, T2 = (t_rfn_top Ts) ->
                           subtype T1 T2 = subtype T1' T2.
Proof.
  intros.

  remember (subtype T1 T2) as sub_fn; subst T1 T2.

  unfold subtype, subtype_func in Heqsub_fn;
    simpl in Heqsub_fn;
    rewrite fix_sub_eq_ext in Heqsub_fn;
    simpl in Heqsub_fn;
    fold subtype_func in Heqsub_fn;
    auto.
Qed.


Require Import HoTT.
Require Import finite_lemmas.
Require Import Category.

Section FinCat.
  Definition fin_1type : 1-Type.
    srapply (@BuildTruncType 1 {n : nat & Finite_Types n}).
    red.
    intros A B.
    apply (trunc_equiv' (A.2 <~> B.2) (path_finite_types A B)).
  Defined.

  (* Check (fundamental_pregroupoid_category fin_1type). *)
  (* Definition fincat : PreCategory. *)
  (* Proof. *)
  (*   srapply (Build_PreCategory (fun m n : nat => Fin m = Fin n)); simpl. *)
  (*   - intro m. reflexivity. *)
  (*   - intros l m n. *)
  (*     intros p q. exact (q @ p). *)
  (*   - intros. simpl. *)
  (*     apply concat_p_pp. *)
  (*   - simpl. intros. *)
  (*     apply concat_p1. *)
  (*   - simpl. intros. *)
  (*     apply concat_1p. *)
  (* Defined. *)

  Definition fincat : PreCategory.
  Proof.
    srapply (Build_PreCategory (fun m n : nat => Fin m <~> Fin n)); simpl.
    - intro m. apply equiv_idmap.
    - intros l m n.
      apply equiv_compose'.
    - intros. simpl.
      apply path_equiv. reflexivity.
    - simpl. intros.
      apply path_equiv. reflexivity.
    - simpl. intros. apply path_equiv. reflexivity.
  Defined.

  (* Trying to show that these are equivalent *)
  Definition F : Functor fincat (Type_to_Cat (fin_1type)).
  Proof.
    srapply @Build_Functor; simpl.
    - intro m. exact (m; canon m).
    - intros m n e. simpl.
      apply path_finite_types.
      apply e.
    - intros a b c e1 e2.
      hnf.
      apply (path_finite_types_compose (a; canon a) (b; canon b) (c; canon c)).
    - hnf.
      intro n.
      apply path_finite_types_1.
  Defined.

  Definition G : Functor (Type_to_Cat (fin_1type)) fincat.
  Proof.
    srapply @Build_Functor; simpl.
    - apply pr1.
    - intros A B []. exact equiv_idmap.
    - intros a b c [] []. simpl.
      apply path_equiv. reflexivity.
    - reflexivity.
  Defined.

  (* F is a weak equivalence (def 9.4.6) *)
  Arguments path_finite_types : simpl never.

  Definition fullyfaithful_F :
    forall (a b : _), IsEquiv (@morphism_of _ _ F a b).
  Proof.
    intros a b. simpl in a, b.
    unfold F. cbn.
    apply equiv_isequiv.
  Defined.

  Definition essentially_surj_F :
    Attributes.IsEssentiallySurjective F.
  Proof.
    unfold Attributes.IsEssentiallySurjective. simpl.
    intros [m [A fA]]. strip_truncations.
    apply tr.
    exists m.
    srapply @Build_Isomorphic. simpl.
    apply path_finite_types.
    simpl. apply equiv_inverse.
    apply fA.
  Defined.

End FinCat.


(*
(C) Copyright 2010, COQTAIL team

Project Info: http://sourceforge.net/projects/coqtail/

This library is free software; you can redistribute it and/or modify it
under the terms of the GNU Lesser General Public License as published by
the Free Software Foundation; either version 2.1 of the License, or
(at your option) any later version.

This library is distributed in the hope that it will be useful, but
WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public
License for more details.

You should have received a copy of the GNU Lesser General Public
License along with this library; if not, write to the Free Software
Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301,
USA.
*)

Require Export Complex.
Require Export Csequence.
Require Import Rsequence.
Open Local Scope C_scope.
Open Local Scope Cseq_scope.

(** * Convergence of series *)
Definition Cser_cv Un l := Cseq_cv (sum_f_C0 Un) l.

Definition Cser_abs_cv Un l := Rseq_cv (sum_f_R0 (fun n => Cnorm (Un n))) l.

Definition Cser_cv_infty Un := Rseq_cv_pos_infty (sum_f_R0 (fun n => Cnorm (Un n))).

(** * Bounds *)
Definition Cser_bound Un M := forall n, Cnorm (sum_f_C0 Un n) <= M.

Definition Cser_abs_bound Un M := forall n, sum_f_R0 (fun k => Cnorm (Un k)) n <= M.

(** * Remainders of series *)
Definition Cser_rem (Un : nat -> R) (l : R) (Hcv : Cser_cv Un l) (n : nat) :=
 (l - (sum_f_C0 Un n))%C.


From mathcomp Require Import ssreflect ssrnat eqtype.
From deriving Require Import deriving.

Require Import type.

(* t_rect is the recursor automatically generated by Coq *)
Time Definition t_indDef := [indDef for t_rect].
Canonical t_indType := IndType t t_indDef.

Time Definition t_eqMixin := [derive eqMixin for t].
Canonical t_eqType := EqType t t_eqMixin.


(** ** M-types

    The M-type associated to (A, B) is the final coalgebra of the associated
    polynomial functor.

    We can't use (1) the definition of [Terminal], because we can't use (2)
    that (co)algebras and their morphisms form a precategory, because this is
    only true when the base category has homsets, which [UU] doesn't.
    Therefore, we must redefine what it means to be a final coalgebra here
    without categorical language.

    (Definition 4 in Ahrens, Capriotti, and Spadotti)
    (IsFinal in HoTT/M-types)

    Author: Langston Barrett (@siddharthist)
  *)

Require Import UniMath.Foundations.PartD.
Require Import UniMath.Induction.FunctorCoalgebras_legacy.
Require Import UniMath.Induction.PolynomialFunctors.

Section M.
  Context {A : UU} (B : A → UU).
  Local Notation F := (polynomial_functor A B). (* can be coerced to a function *)

  Definition is_prefinal (X : coalgebra F) :=
    ∏ (Y : coalgebra F), coalgebra_homo F Y X.

  Definition is_final (X : coalgebra F) :=
    ∏ (Y : coalgebra F), iscontr (coalgebra_homo F Y X).

  (** prop-IsFinal in HoTT/M-types *)
  Definition isaprop_is_final (X : coalgebra F) : isaprop (is_final X).
  Proof.
    apply impred.
    intro.
    apply isapropiscontr.
  Defined.

  Lemma is_prefinal_to_is_final (X : coalgebra F) :
    is_prefinal X -> (∏ Y, isaprop (coalgebra_homo F Y X)) -> is_final X.
  Proof.
    exact (λ is_pre is_prop Y, iscontraprop1 (is_prop Y) (is_pre Y)).
  Defined.

  Definition M := ∑ (X : coalgebra F), is_final X.
  Definition M_coalgebra : M → coalgebra F := pr1.
  Definition M_is_final : ∏ (m : M), is_final (pr1 m) := pr2.
  Coercion M_coalgebra : M >-> coalgebra.
End M.

Arguments isaprop_is_final {_ _} _.
Arguments is_prefinal {_ _} _.
Arguments is_final {_ _} _.


From discprob.basic Require Import base order nify.
From discprob.prob Require Import prob countable finite stochastic_order.
From discprob.monad.finite Require Import monad monad_hoare bst.
From mathcomp Require Import ssreflect ssrbool ssrfun eqtype ssrnat seq div choice fintype.
From mathcomp Require Import tuple finfun bigop prime binomial finset.
From Coq Require Import Omega Program.Wf MSets.MSetInterface MSets.MSetGenTree Structures.OrdersEx.
Local Open Scope nat_scope.

(* This shows that the result of "add list random" is equivalent to adding the elements
   of the list according to some permutation *)

Lemma alr_correct (l: list nat) (t: tree):
  mspec (add_list_random l t) (λ t': tree, ∃ l', t' = add_list l' t ∧ perm_eq l l').
Proof.
 remember (size l) as k eqn: Heq.
 revert t l Heq.
 induction k as [k IH] using (well_founded_induction lt_wf) => t l Heq.
 destruct l as [| a l]; last destruct l as [| b l].
 - rewrite alr_unfold. apply mspec_mret. exists [::] => //=.
 - rewrite alr_unfold. apply mspec_mret. exists [::a] => //=.
 - rewrite alr_unfold.
   tbind (λ x, sval x \in a :: b :: l).
   { intros (?&?) => //. }
   intros (x&Hin) _.
   eapply (mspec_conseq).
   { rewrite /sval. eapply (IH (size (rem x [:: a, b & l]))).
     * subst. rewrite size_rem //=.
     * done.
   }
   intros t' (l'&Heq'&Hperm).
   exists (x :: l'); split; auto.
   eapply perm_trans; first apply (perm_to_rem Hin); eauto.
   rewrite perm_cons. done.
Qed.