Require Import MetaCoq.Template.Loader.

Definition f := fun (n : nat) =>
  match n with
  | 0 => 0
  | S n => n
  end.

MetaCoq Quote Definition f_quoted :=
  ltac:(let t := eval cbv in f in exact t).

MetaCoq Unquote Definition f_from_syntax :=
  ltac:(let t := eval cbv in f_quoted in exact t).

Check eq_refl : f = f_from_syntax.


Set Implicit Arguments.
Set Bullet Behavior "Strict Subproofs".

Require Import Bool String Lists.List.
Import ListNotations.
Import BoolNotations.
Open Scope string.
Open Scope list.

From Utils Require Import Base.

Lemma invert_eq_0_S x : 0 = S x <-> False.
Proof.
  solve_invert_constr_eq_lemma.
Qed.
#[export] Hint Rewrite invert_eq_0_S : utils.
Lemma invert_eq_S_0 x : S x = 0 <-> False.
Proof.
  solve_invert_constr_eq_lemma.
Qed.
#[export] Hint Rewrite invert_eq_S_0 : utils.

Lemma invert_eq_S_S x y : S x = S y <-> x = y.
Proof.
  solve_invert_constr_eq_lemma.
Qed.
#[export] Hint Rewrite invert_eq_S_S : utils.


(**
This file is part of the Coquelicot formalization of real
analysis in Coq: http://coquelicot.saclay.inria.fr/

Copyright (C) 2011-2015 Sylvie Boldo
#
#
Copyright (C) 2011-2015 Catherine Lelay
#
#
Copyright (C) 2011-2015 Guillaume Melquiond

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 3 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
COPYING file for more details.
*)

From Coq Require Import Reals ssreflect.

Require Import Rcomplements.

(** This file contains the definition and properties of the set
 [R] # ∪ {+ ∞} ∪ {- ∞} # denoted by [Rbar]. We have defined:
  - coercions from [R] to [Rbar] and vice versa ([Finite] gives [R0] at infinity points)
  - an order [Rbar_lt] and [Rbar_le]
  - total operations: [Rbar_opp], [Rbar_plus], [Rbar_minus], [Rbar_inv], [Rbar_min] and [Rbar_abs]
  - lemmas about the decidability of the order and properties of the operations (such as [Rbar_plus_comm] or [Rbar_plus_lt_compat])
 *)

Open Scope R_scope.

(** * Definitions *)

Inductive Rbar :=
  | Finite : R -> Rbar
  | p_infty : Rbar
  | m_infty : Rbar.
Definition real (x : Rbar) :=
  match x with
    | Finite x => x
    | _ => 0
  end.
Coercion Finite : R >-> Rbar.
Coercion real : Rbar >-> R.

Definition is_finite (x : Rbar) := Finite (real x) = x.
Lemma is_finite_correct (x : Rbar) :
  is_finite x <-> exists y : R, x = Finite y.
Proof.
  rewrite /is_finite ;
  case: x => /= ; split => // H.
  by exists r.
  by case: H.
  by case: H.
Qed.

(** ** Order *)

Definition Rbar_lt (x y : Rbar) : Prop :=
  match x,y with
    | p_infty, _ | _, m_infty => False
    | m_infty, _ | _, p_infty => True
    | Finite x, Finite y => Rlt x y
  end.

Definition Rbar_le (x y : Rbar) : Prop :=
  match x,y with
    | m_infty, _ | _, p_infty => True
    | p_infty, _ | _, m_infty => False
    | Finite x, Finite y => Rle x y
  end.

(** ** Operations *)
(** *** Additive operators *)

Definition Rbar_opp (x : Rbar) :=
  match x with
    | Finite x => Finite (-x)
    | p_infty => m_infty
    | m_infty => p_infty
  end.

Definition Rbar_plus' (x y : Rbar) :=
  match x,y with
    | p_infty, m_infty | m_infty, p_infty => None
    | p_infty, _ | _, p_infty => Some p_infty
    | m_infty, _ | _, m_infty => Some m_infty
    | Finite x', Finite y' => Some (Finite (x' + y'))
  end.
Definition Rbar_plus (x y : Rbar) :=
  match Rbar_plus' x y with Some z => z | None => Finite 0 end.
Arguments Rbar_plus !x !y /.
Definition is_Rbar_plus (x y z : Rbar) : Prop :=
  Rbar_plus' x y = Some z.
Definition ex_Rbar_plus (x y : Rbar) : Prop :=
  match Rbar_plus' x y with Some _ => True | None => False end.
Arguments ex_Rbar_plus !x !y /.

Lemma is_Rbar_plus_unique (x y z : Rbar) :
  is_Rbar_plus x y z -> Rbar_plus x y = z.
Proof.
  unfold is_Rbar_plus, ex_Rbar_plus, Rbar_plus.
  case: Rbar_plus' => // a Ha.
  by inversion Ha.
Qed.
Lemma Rbar_plus_correct (x y : Rbar) :
  ex_Rbar_plus x y -> is_Rbar_plus x y (Rbar_plus x y).
Proof.
  unfold is_Rbar_plus, ex_Rbar_plus, Rbar_plus.
  by case: Rbar_plus'.
Qed.

Definition Rbar_minus (x y : Rbar) := Rbar_plus x (Rbar_opp y).
Arguments Rbar_minus !x !y /.
Definition is_Rbar_minus (x y z : Rbar) : Prop :=
  is_Rbar_plus x (Rbar_opp y) z.
Definition ex_Rbar_minus (x y : Rbar) : Prop :=
  ex_Rbar_plus x (Rbar_opp y).
Arguments ex_Rbar_minus !x !y /.

(** *** Multiplicative operators *)

Definition Rbar_inv (x : Rbar) : Rbar :=
  match x with
    | Finite x => Finite (/x)
    | _ => Finite 0
  end.

Definition Rbar_mult' (x y : Rbar) :=
  match x with
    | Finite x => match y with
      | Finite y => Some (Finite (x * y))
      | p_infty => match (Rle_dec 0 x) with
        | left H => match Rle_lt_or_eq_dec _ _ H with left _ => Some p_infty | right _ => None end
        | right _ => Some m_infty
      end
      | m_infty => match (Rle_dec 0 x) with
        | left H => match Rle_lt_or_eq_dec _ _ H with left _ => Some m_infty | right _ => None end
        | right _ => Some p_infty
      end
    end
    | p_infty => match y with
      | Finite y => match (Rle_dec 0 y) with
        | left H => match Rle_lt_or_eq_dec _ _ H with left _ => Some p_infty | right _ => None end
        | right _ => Some m_infty
      end
      | p_infty => Some p_infty
      | m_infty => Some m_infty
    end
    | m_infty => match y with
      | Finite y => match (Rle_dec 0 y) with
        | left H => match Rle_lt_or_eq_dec _ _ H with left _ => Some m_infty | right _ => None end
        | right _ => Some p_infty
      end
      | p_infty => Some m_infty
      | m_infty => Some p_infty
    end
  end.
Definition Rbar_mult (x y : Rbar) :=
  match Rbar_mult' x y with Some z => z | None => Finite 0 end.
Arguments Rbar_mult !x !y /.

Definition is_Rbar_mult (x y z : Rbar) : Prop :=
  Rbar_mult' x y = Some z.
Definition ex_Rbar_mult (x y : Rbar) : Prop :=
  match x with
    | Finite x => match y with
      | Finite y => True
      | p_infty => x <> 0
      | m_infty => x <> 0
    end
    | p_infty => match y with
      | Finite y => y <> 0
      | p_infty => True
      | m_infty => True
    end
    | m_infty => match y with
      | Finite y => y <> 0
      | p_infty => True
      | m_infty => True
    end
  end.
Arguments ex_Rbar_mult !x !y /.

Definition Rbar_mult_pos (x : Rbar) (y : posreal) :=
  match x with
    | Finite x => Finite (x*y)
    | _ => x
  end.

Lemma is_Rbar_mult_unique (x y z : Rbar) :
  is_Rbar_mult x y z -> Rbar_mult x y = z.
Proof.
  unfold is_Rbar_mult ;
  case: x => [x | | ] ;
  case: y => [y | | ] ;
  case: z => [z | | ] //= H ;
  inversion H => // ;
  case: Rle_dec H => // H0 ;
  case: Rle_lt_or_eq_dec => //.
Qed.
Lemma Rbar_mult_correct (x y : Rbar) :
  ex_Rbar_mult x y -> is_Rbar_mult x y (Rbar_mult x y).
Proof.
  case: x => [x | | ] ;
  case: y => [y | | ] //= H ;
  apply sym_not_eq in H ;
  unfold is_Rbar_mult ; simpl ;
  case: Rle_dec => // H0 ;
  case: Rle_lt_or_eq_dec => //.
Qed.
Lemma Rbar_mult_correct' (x y z : Rbar) :
  is_Rbar_mult x y z -> ex_Rbar_mult x y.
Proof.
  unfold is_Rbar_mult ;
  case: x => [x | | ] ;
  case: y => [y | | ] //= ;
  case: Rle_dec => //= H ; try (case: Rle_lt_or_eq_dec => //=) ; intros.
  by apply Rgt_not_eq.
  by apply Rlt_not_eq, Rnot_le_lt.
  by apply Rgt_not_eq.
  by apply Rlt_not_eq, Rnot_le_lt.
  by apply Rgt_not_eq.
  by apply Rlt_not_eq, Rnot_le_lt.
  by apply Rgt_not_eq.
  by apply Rlt_not_eq, Rnot_le_lt.
Qed.

Definition Rbar_div (x y : Rbar) : Rbar :=
  Rbar_mult x (Rbar_inv y).
Arguments Rbar_div !x !y /.
Definition is_Rbar_div (x y z : Rbar) : Prop :=
  is_Rbar_mult x (Rbar_inv y) z.
Definition ex_Rbar_div (x y : Rbar) : Prop :=
  ex_Rbar_mult x (Rbar_inv y).
Arguments ex_Rbar_div !x !y /.
Definition Rbar_div_pos (x : Rbar) (y : posreal) :=
  match x with
    | Finite x => Finite (x/y)
    | _ => x
  end.

(** * Compatibility with real numbers *)
(** For equality and order.
The compatibility of addition and multiplication is proved in Rbar_seq *)

Lemma Rbar_finite_eq (x y : R) :
  Finite x = Finite y <-> x = y.
Proof.
  split ; intros.
  apply Rle_antisym ; apply Rnot_lt_le ; intro.
  assert (Rbar_lt (Finite y) (Finite x)).
  simpl ; apply H0.
  rewrite H in H1 ; simpl in H1 ; by apply Rlt_irrefl in H1.
  assert (Rbar_lt (Finite x) (Finite y)).
  simpl ; apply H0.
  rewrite H in H1 ; simpl in H1 ; by apply Rlt_irrefl in H1.
  rewrite H ; reflexivity.
Qed.
Lemma Rbar_finite_neq (x y : R) :
  Finite x <> Finite y <-> x <> y.
Proof.
  split => H ; contradict H ; by apply Rbar_finite_eq.
Qed.

(** * Properties of order *)

(** ** Relations between inequalities *)

Lemma Rbar_lt_not_eq (x y : Rbar) :
  Rbar_lt x y -> x<>y.
Proof.
  destruct x ; destruct y ; simpl ; try easy.
  intros H H0.
  apply Rbar_finite_eq in H0 ; revert H0 ; apply Rlt_not_eq, H.
Qed.

Lemma Rbar_not_le_lt (x y : Rbar) :
  ~ Rbar_le x y -> Rbar_lt y x.
Proof.
  destruct x ; destruct y ; simpl ; intuition.
Qed.

Lemma Rbar_lt_not_le (x y : Rbar) :
  Rbar_lt y x -> ~ Rbar_le x y.
Proof.
  destruct x ; destruct y ; simpl ; intuition.
  apply (Rlt_irrefl r0).
  now apply Rlt_le_trans with (1 := H).
Qed.

Lemma Rbar_not_lt_le (x y : Rbar) :
  ~ Rbar_lt x y -> Rbar_le y x.
Proof.
  destruct x ; destruct y ; simpl ; intuition.
  now apply Rnot_lt_le.
Qed.

Lemma Rbar_le_not_lt (x y : Rbar) :
  Rbar_le y x -> ~ Rbar_lt x y.
Proof.
  destruct x ; destruct y ; simpl ; intuition ; contradict H0.
  now apply Rle_not_lt.
Qed.

Lemma Rbar_le_refl :
  forall x : Rbar, Rbar_le x x.
Proof.
intros [x| |] ; try easy.
apply Rle_refl.
Qed.

Lemma Rbar_lt_le :
  forall x y : Rbar,
  Rbar_lt x y -> Rbar_le x y.
Proof.
  intros [x| |] [y| |] ; try easy.
  apply Rlt_le.
Qed.

(** ** Decidability *)

Lemma Rbar_total_order (x y : Rbar) :
  {Rbar_lt x y} + {x = y} + {Rbar_lt y x}.
Proof.
  destruct x ; destruct y ; simpl ; intuition.
  destruct (total_order_T r r0) ; intuition.
Qed.

Lemma Rbar_eq_dec (x y : Rbar) :
  {x = y} + {x <> y}.
Proof.
  intros ; destruct (Rbar_total_order x y) as [[H|H]|H].
  right ; revert H ; destruct x as [x| |] ; destruct y as [y| |] ; simpl ; intros H ;
  try easy.
  contradict H.
  apply Rbar_finite_eq in H ; try apply Rle_not_lt, Req_le ; auto.
  left ; apply H.
  right ; revert H ; destruct x as [x| |] ; destruct y as [y| |] ; simpl ; intros H ;
  try easy.
  contradict H.
  apply Rbar_finite_eq in H ; apply Rle_not_lt, Req_le ; auto.
Qed.

Lemma Rbar_lt_dec (x y : Rbar) :
  {Rbar_lt x y} + {~Rbar_lt x y}.
Proof.
  destruct (Rbar_total_order x y) as [H|H] ; [ destruct H as [H|H]|].
  now left.
  right ; rewrite H ; clear H ; destruct y ; auto ; apply Rlt_irrefl ; auto.
  right ; revert H ; destruct x as [x | | ] ; destruct y as [y | | ] ; intros H ; auto ;
  apply Rle_not_lt, Rlt_le ; auto.
Qed.

Lemma Rbar_lt_le_dec (x y : Rbar) :
  {Rbar_lt x y} + {Rbar_le y x}.
Proof.
  destruct (Rbar_total_order x y) as [[H|H]|H].
  now left.
  right.
  rewrite H.
  apply Rbar_le_refl.
  right.
  now apply Rbar_lt_le.
Qed.

Lemma Rbar_le_dec (x y : Rbar) :
  {Rbar_le x y} + {~Rbar_le x y}.
Proof.
  destruct (Rbar_total_order x y) as [[H|H]|H].
  left.
  now apply Rbar_lt_le.
  left.
  rewrite H.
  apply Rbar_le_refl.
  right.
  now apply Rbar_lt_not_le.
Qed.

Lemma Rbar_le_lt_dec (x y : Rbar) :
  {Rbar_le x y} + {Rbar_lt y x}.
Proof.
  destruct (Rbar_total_order x y) as [[H|H]|H].
  left.
  now apply Rbar_lt_le.
  left.
  rewrite H.
  apply Rbar_le_refl.
  now right.
Qed.

Lemma Rbar_le_lt_or_eq_dec (x y : Rbar) :
  Rbar_le x y -> { Rbar_lt x y } + { x = y }.
Proof.
  destruct (Rbar_total_order x y) as [[H|H]|H].
  now left.
  now right.
  intros K.
  now elim (Rbar_le_not_lt _ _ K).
Qed.

(** ** Transitivity *)

Lemma Rbar_lt_trans (x y z : Rbar) :
  Rbar_lt x y -> Rbar_lt y z -> Rbar_lt x z.
Proof.
  destruct x ; destruct y ; destruct z ; simpl ; intuition.
  now apply Rlt_trans with r0.
Qed.

Lemma Rbar_lt_le_trans (x y z : Rbar) :
  Rbar_lt x y -> Rbar_le y z -> Rbar_lt x z.
Proof.
  destruct x ; destruct y ; destruct z ; simpl ; intuition.
  now apply Rlt_le_trans with r0.
Qed.

Lemma Rbar_le_lt_trans (x y z : Rbar) :
  Rbar_le x y -> Rbar_lt y z -> Rbar_lt x z.
Proof.
  destruct x ; destruct y ; destruct z ; simpl ; intuition.
  now apply Rle_lt_trans with r0.
Qed.

Lemma Rbar_le_trans (x y z : Rbar) :
  Rbar_le x y -> Rbar_le y z -> Rbar_le x z.
Proof.
  destruct x ; destruct y ; destruct z ; simpl ; intuition.
  now apply Rle_trans with r0.
Qed.

Lemma Rbar_le_antisym (x y : Rbar) :
  Rbar_le x y -> Rbar_le y x -> x = y.
Proof.
  destruct x ; destruct y ; simpl ; intuition.
Qed.

(** * Properties of operations *)
(** ** Additive operators *)
(** *** Rbar_opp *)

Lemma Rbar_opp_involutive (x : Rbar) : (Rbar_opp (Rbar_opp x)) = x.
Proof.
  destruct x as [x| | ] ; auto ; simpl ; rewrite Ropp_involutive ; auto.
Qed.

Lemma Rbar_opp_lt (x y : Rbar) : Rbar_lt (Rbar_opp x) (Rbar_opp y) <-> Rbar_lt y x.
Proof.
  destruct x as [x | | ] ; destruct y as [y | | ] ;
  split ; auto ; intro H ; simpl ; try left.
  apply Ropp_lt_cancel ; auto.
  apply Ropp_lt_contravar ; auto.
Qed.

Lemma Rbar_opp_le (x y : Rbar) : Rbar_le (Rbar_opp x) (Rbar_opp y) <-> Rbar_le y x.
Proof.
  destruct x as [x| |] ; destruct y as [y| |] ; simpl ; intuition.
Qed.

Lemma Rbar_opp_eq (x y : Rbar) : (Rbar_opp x) = (Rbar_opp y) <-> x = y.
Proof.
  split ; intros H.
  rewrite <- (Rbar_opp_involutive x), H, Rbar_opp_involutive ; reflexivity.
  rewrite H ; reflexivity.
Qed.

Lemma Rbar_opp_real (x : Rbar) : real (Rbar_opp x) = - real x.
Proof.
  destruct x as [x | | ] ; simpl ; intuition.
Qed.

(** *** Rbar_plus *)

Lemma Rbar_plus'_comm :
  forall x y, Rbar_plus' x y = Rbar_plus' y x.
Proof.
intros [x| |] [y| |] ; try reflexivity.
apply (f_equal (fun x => Some (Finite x))), Rplus_comm.
Qed.

Lemma ex_Rbar_plus_comm :
  forall x y,
  ex_Rbar_plus x y -> ex_Rbar_plus y x.
Proof.
now intros [x| |] [y| |].
Qed.

Lemma ex_Rbar_plus_opp (x y : Rbar) :
  ex_Rbar_plus x y -> ex_Rbar_plus (Rbar_opp x) (Rbar_opp y).
Proof.
  case: x => [x | | ] ;
  case: y => [y | | ] => //.
Qed.

Lemma Rbar_plus_0_r (x : Rbar) : Rbar_plus x (Finite 0) = x.
Proof.
  case: x => //= ; intuition.
Qed.
Lemma Rbar_plus_0_l (x : Rbar) : Rbar_plus (Finite 0) x = x.
Proof.
  case: x => //= ; intuition.
Qed.

Lemma Rbar_plus_comm (x y : Rbar) : Rbar_plus x y = Rbar_plus y x.
Proof.
  case x ; case y ; intuition.
  simpl.
  apply f_equal, Rplus_comm.
Qed.

Lemma Rbar_plus_lt_compat (a b c d : Rbar) :
  Rbar_lt a b -> Rbar_lt c d -> Rbar_lt (Rbar_plus a c) (Rbar_plus b d).
Proof.
  case: a => [a | | ] // ; case: b => [b | | ] // ;
  case: c => [c | | ] // ; case: d => [d | | ] // ;
  apply Rplus_lt_compat.
Qed.

Lemma Rbar_plus_le_compat (a b c d : Rbar) :
  Rbar_le a b -> Rbar_le c d -> Rbar_le (Rbar_plus a c) (Rbar_plus b d).
Proof.
  case: a => [a | | ] // ; case: b => [b | | ] // ;
  case: c => [c | | ] // ; case: d => [d | | ] //.
  apply Rplus_le_compat.
  intros _ _.
  apply Rle_refl.
  intros _ _.
  apply Rle_refl.
Qed.

Lemma Rbar_plus_opp (x y : Rbar) :
  Rbar_plus (Rbar_opp x) (Rbar_opp y) = Rbar_opp (Rbar_plus x y).
Proof.
  case: x => [x | | ] ;
  case: y => [y | | ] //= ; apply f_equal ; ring.
Qed.

(** *** Rbar_minus *)

Lemma Rbar_minus_eq_0 (x : Rbar) : Rbar_minus x x = 0.
Proof.
  case: x => //= x ; by apply f_equal, Rcomplements.Rminus_eq_0.
Qed.
Lemma Rbar_opp_minus (x y : Rbar) :
  Rbar_opp (Rbar_minus x y) = Rbar_minus y x.
Proof.
  case: x => [x | | ] ;
  case: y => [y | | ] //=.
  by rewrite Ropp_minus_distr'.
  by rewrite Ropp_0.
  by rewrite Ropp_0.
Qed.

(** ** Multiplicative *)

(** *** Rbar_inv *)

Lemma Rbar_inv_opp (x : Rbar) :
  x <> 0 -> Rbar_inv (Rbar_opp x) = Rbar_opp (Rbar_inv x).
Proof.
  case: x => [x | | ] /= Hx.
  rewrite Ropp_inv_permute => //.
  contradict Hx.
  by rewrite Hx.
  by rewrite Ropp_0.
  by rewrite Ropp_0.
Qed.

(** *** Rbar_mult *)

Lemma Rbar_mult'_comm (x y : Rbar) :
  Rbar_mult' x y = Rbar_mult' y x.
Proof.
  case: x => [x | | ] ;
  case: y => [y | | ] //=.
  by rewrite Rmult_comm.
Qed.

Lemma Rbar_mult'_opp_r (x y : Rbar) :
  Rbar_mult' x (Rbar_opp y) = match Rbar_mult' x y with Some z => Some (Rbar_opp z) | None => None end.
Proof.
  case: x => [x | | ] ;
  case: y => [y | | ] //= ;
  (try case: Rle_dec => Hx //=) ;
  (try case: Rle_lt_or_eq_dec => //= Hx0).
  by rewrite Ropp_mult_distr_r_reverse.
  rewrite -Ropp_0 in Hx0.
  apply Ropp_lt_cancel in Hx0.
  case Rle_dec => Hy //=.
  now elim Rle_not_lt with (1 := Hy).
  case Rle_dec => Hy //=.
  case Rle_lt_or_eq_dec => Hy0 //=.
  elim Rlt_not_le with (1 := Hy0).
  apply Ropp_le_cancel.
  by rewrite Ropp_0.
  elim Hy.
  apply Ropp_le_cancel.
  rewrite -Hx0 Ropp_0.
  apply Rle_refl.
  case Rle_dec => Hy //=.
  case Rle_lt_or_eq_dec => Hy0 //=.
  elim Hx.
  rewrite -Hy0 Ropp_0.
  apply Rle_refl.
  elim Hx.
  rewrite -Ropp_0.
  apply Ropp_le_contravar.
  apply Rlt_le.
  now apply Rnot_le_lt.
  case Rle_dec => Hy //=.
  elim Rlt_not_le with (1 := Hx0).
  rewrite -Ropp_0.
  now apply Ropp_le_contravar.
  case Rle_dec => Hy //=.
  case Rle_lt_or_eq_dec => Hy0 //=.
  elim Rlt_not_le with (1 := Hy0).
  apply Ropp_le_cancel.
  rewrite -Hx0 Ropp_0.
  apply Rle_refl.
  elim Hy.
  apply Ropp_le_cancel.
  rewrite -Hx0 Ropp_0.
  apply Rle_refl.
  case Rle_dec => Hy //=.
  case Rle_lt_or_eq_dec => Hy0 //=.
  elim Hx.
  rewrite -Hy0 Ropp_0.
  apply Rle_refl.
  elim Hx.
  rewrite -Ropp_0.
  apply Ropp_le_contravar.
  apply Rlt_le.
  now apply Rnot_le_lt.
Qed.

Lemma Rbar_mult_comm (x y : Rbar) :
  Rbar_mult x y = Rbar_mult y x.
Proof.
  unfold Rbar_mult.
  by rewrite Rbar_mult'_comm.
Qed.
Lemma Rbar_mult_opp_r (x y : Rbar) :
  Rbar_mult x (Rbar_opp y) = (Rbar_opp (Rbar_mult x y)).
Proof.
  unfold Rbar_mult.
  rewrite Rbar_mult'_opp_r.
  case Rbar_mult' => //=.
  apply f_equal, eq_sym, Ropp_0.
Qed.
Lemma Rbar_mult_opp_l (x y : Rbar) :
  Rbar_mult (Rbar_opp x) y = Rbar_opp (Rbar_mult x y).
Proof.
  rewrite ?(Rbar_mult_comm _ y).
  by apply Rbar_mult_opp_r.
Qed.
Lemma Rbar_mult_opp (x y : Rbar) :
  Rbar_mult (Rbar_opp x) (Rbar_opp y) = Rbar_mult x y.
Proof.
  by rewrite Rbar_mult_opp_l -Rbar_mult_opp_r Rbar_opp_involutive.
Qed.
Lemma Rbar_mult_0_l (x : Rbar) : Rbar_mult 0 x = 0.
Proof.
  case: x => [x | | ] //=.
  by rewrite Rmult_0_l.
  case: Rle_dec (Rle_refl 0) => // H _.
  case: Rle_lt_or_eq_dec (Rlt_irrefl 0) => // _ _.
  case: Rle_dec (Rle_refl 0) => // H _.
  case: Rle_lt_or_eq_dec (Rlt_irrefl 0) => // _ _.
Qed.
Lemma Rbar_mult_0_r (x : Rbar) : Rbar_mult x 0 = 0.
Proof.
  rewrite Rbar_mult_comm ; by apply Rbar_mult_0_l.
Qed.

Lemma Rbar_mult_eq_0 (y x : Rbar) :
  Rbar_mult x y = 0 -> x = 0 \/ y = 0.
Proof.
  case: x => [x | | ] //= ;
  case: y => [y | | ] //= ;
  (try case: Rle_dec => //= H) ;
  (try case: Rle_lt_or_eq_dec => //=) ;
  (try (left ; by apply f_equal)) ;
  (try (right ; by apply f_equal)).
  intros H.
  apply (f_equal real) in H.
  simpl in H.
  apply Rmult_integral in H ; case: H => ->.
  by left.
  by right.
Qed.

Lemma ex_Rbar_mult_sym (x y : Rbar) :
  ex_Rbar_mult x y -> ex_Rbar_mult y x.
Proof.
  case: x => [x | | ] ;
  case: y => [y | | ] //.
Qed.
Lemma ex_Rbar_mult_opp_l (x y : Rbar) :
  ex_Rbar_mult x y -> ex_Rbar_mult (Rbar_opp x) y.
Proof.
  case: x => [x | | ] ;
  case: y => [y | | ] //= Hx ;
  by apply Ropp_neq_0_compat.
Qed.
Lemma ex_Rbar_mult_opp_r (x y : Rbar) :
  ex_Rbar_mult x y -> ex_Rbar_mult x (Rbar_opp y).
Proof.
  case: x => [x | | ] ;
  case: y => [y | | ] //= Hx ;
  by apply Ropp_neq_0_compat.
Qed.

Lemma is_Rbar_mult_sym (x y z : Rbar) :
  is_Rbar_mult x y z -> is_Rbar_mult y x z.
Proof.
  case: x => [x | | ] ;
  case: y => [y | | ] ;
  case: z => [z | | ] //= ;
  unfold is_Rbar_mult, Rbar_mult' ;
  try (case: Rle_dec => // H) ;
  try (case: Rle_lt_or_eq_dec => // H0) ;
  try (case => <-) ; try (move => _).
  by rewrite Rmult_comm.
Qed.
Lemma is_Rbar_mult_opp_l (x y z : Rbar) :
  is_Rbar_mult x y z -> is_Rbar_mult (Rbar_opp x) y (Rbar_opp z).
Proof.
  case: x => [x | | ] ;
  case: y => [y | | ] ;
  case: z => [z | | ] //= ;
  unfold is_Rbar_mult, Rbar_mult' ;
  try (case: Rle_dec => // H) ;
  try (case: Rle_lt_or_eq_dec => // H0) ;
  try (case => <-) ; try (move => _).
  apply (f_equal (@Some _)), f_equal ; ring.
  apply Ropp_lt_contravar in H0 ; rewrite Ropp_0 in H0 ;
  now move/Rlt_not_le: H0 ; case: Rle_dec.
  apply Rnot_le_lt, Ropp_lt_contravar in H ; rewrite Ropp_0 in H ;
  move/Rlt_le: (H) ; case: Rle_dec => // H0 _ ;
  now move/Rlt_not_eq: H ; case: Rle_lt_or_eq_dec.
  apply Rnot_le_lt, Ropp_lt_contravar in H ; rewrite Ropp_0 in H ;
  move/Rlt_le: (H) ; case: Rle_dec => // H0 _ ;
  now move/Rlt_not_eq: H ; case: Rle_lt_or_eq_dec.
  apply Ropp_lt_contravar in H0 ; rewrite Ropp_0 in H0 ;
  now move/Rlt_not_le: H0 ; case: Rle_dec.
Qed.
Lemma is_Rbar_mult_opp_r (x y z : Rbar) :
  is_Rbar_mult x y z -> is_Rbar_mult x (Rbar_opp y) (Rbar_opp z).
Proof.
  move/is_Rbar_mult_sym => H.
  now apply is_Rbar_mult_sym, is_Rbar_mult_opp_l.
Qed.

Lemma is_Rbar_mult_p_infty_pos (x : Rbar) :
  Rbar_lt 0 x -> is_Rbar_mult p_infty x p_infty.
Proof.
  case: x => [x | | ] // Hx.
  unfold is_Rbar_mult, Rbar_mult'.
  case: Rle_dec (Rlt_le _ _ Hx) => // Hx' _.
  now case: Rle_lt_or_eq_dec (Rlt_not_eq _ _ Hx).
Qed.
Lemma is_Rbar_mult_p_infty_neg (x : Rbar) :
  Rbar_lt x 0 -> is_Rbar_mult p_infty x m_infty.
Proof.
  case: x => [x | | ] // Hx.
  unfold is_Rbar_mult, Rbar_mult'.
  case: Rle_dec (Rlt_not_le _ _ Hx) => // Hx' _.
Qed.
Lemma is_Rbar_mult_m_infty_pos (x : Rbar) :
  Rbar_lt 0 x -> is_Rbar_mult m_infty x m_infty.
Proof.
  case: x => [x | | ] // Hx.
  unfold is_Rbar_mult, Rbar_mult'.
  case: Rle_dec (Rlt_le _ _ Hx) => // Hx' _.
  now case: Rle_lt_or_eq_dec (Rlt_not_eq _ _ Hx).
Qed.
Lemma is_Rbar_mult_m_infty_neg (x : Rbar) :
  Rbar_lt x 0 -> is_Rbar_mult m_infty x p_infty.
Proof.
  case: x => [x | | ] // Hx.
  unfold is_Rbar_mult, Rbar_mult'.
  case: Rle_dec (Rlt_not_le _ _ Hx) => // Hx' _.
Qed.

(** Rbar_div *)

Lemma is_Rbar_div_p_infty (x : R) :
  is_Rbar_div x p_infty 0.
Proof.
  apply (f_equal (@Some _)).
  by rewrite Rmult_0_r.
Qed.
Lemma is_Rbar_div_m_infty (x : R) :
  is_Rbar_div x m_infty 0.
Proof.
  apply (f_equal (@Some _)).
  by rewrite Rmult_0_r.
Qed.

(** Rbar_mult_pos *)

Lemma Rbar_mult_pos_eq (x y : Rbar) (z : posreal) :
  x = y <-> (Rbar_mult_pos x z) = (Rbar_mult_pos y z).
Proof.
  case: z => z Hz ; case: x => [x | | ] ; case: y => [y | | ] ;
  split => //= H ; apply Rbar_finite_eq in H.
  by rewrite H.
  apply Rbar_finite_eq, (Rmult_eq_reg_r (z)) => // ;
  by apply Rgt_not_eq.
Qed.

Lemma Rbar_mult_pos_lt (x y : Rbar) (z : posreal) :
  Rbar_lt x y <-> Rbar_lt (Rbar_mult_pos x z) (Rbar_mult_pos y z).
Proof.
  case: z => z Hz ; case: x => [x | | ] ; case: y => [y | | ] ;
  split => //= H.
  apply (Rmult_lt_compat_r (z)) => //.
  apply (Rmult_lt_reg_r (z)) => //.
Qed.

Lemma Rbar_mult_pos_le (x y : Rbar) (z : posreal) :
  Rbar_le x y <-> Rbar_le (Rbar_mult_pos x z) (Rbar_mult_pos y z).
Proof.
  case: z => z Hz ; case: x => [x | | ] ; case: y => [y | | ] ;
  split => //= H.
  apply Rmult_le_compat_r with (2 := H).
  now apply Rlt_le.
  now apply Rmult_le_reg_r with (2 := H).
Qed.

(** Rbar_div_pos *)

Lemma Rbar_div_pos_eq (x y : Rbar) (z : posreal) :
  x = y <-> (Rbar_div_pos x z) = (Rbar_div_pos y z).
Proof.
  case: z => z Hz ; case: x => [x | | ] ; case: y => [y | | ] ;
  split => //= H ; apply Rbar_finite_eq in H.
  by rewrite H.
  apply Rbar_finite_eq, (Rmult_eq_reg_r (/z)) => // ;
  by apply Rgt_not_eq, Rinv_0_lt_compat.
Qed.

Lemma Rbar_div_pos_lt (x y : Rbar) (z : posreal) :
  Rbar_lt x y <-> Rbar_lt (Rbar_div_pos x z) (Rbar_div_pos y z).
Proof.
  case: z => z Hz ; case: x => [x | | ] ; case: y => [y | | ] ;
  split => //= H.
  apply (Rmult_lt_compat_r (/z)) => // ; by apply Rinv_0_lt_compat.
  apply (Rmult_lt_reg_r (/z)) => // ; by apply Rinv_0_lt_compat.
Qed.

Lemma Rbar_div_pos_le (x y : Rbar) (z : posreal) :
  Rbar_le x y <-> Rbar_le (Rbar_div_pos x z) (Rbar_div_pos y z).
Proof.
  case: z => z Hz ; case: x => [x | | ] ; case: y => [y | | ] ;
  split => //= H.
  apply Rmult_le_compat_r with (2 := H).
  now apply Rlt_le, Rinv_0_lt_compat.
  apply Rmult_le_reg_r with (2 := H).
  now apply Rinv_0_lt_compat.
Qed.

(** * Rbar_min *)

Definition Rbar_min (x y : Rbar) : Rbar :=
  match x, y with
  | z, p_infty | p_infty, z => z
  | _ , m_infty | m_infty, _ => m_infty
  | Finite x, Finite y => Rmin x y
  end.

Lemma Rbar_lt_locally (a b : Rbar) (x : R) :
  Rbar_lt a x -> Rbar_lt x b ->
  exists delta : posreal,
    forall y, Rabs (y - x) < delta -> Rbar_lt a y /\ Rbar_lt y b.
Proof.
  case: a => [ a /= Ha | | _ ] //= ; (try apply Rminus_lt_0 in Ha) ;
  case: b => [ b Hb | _ | ] //= ; (try apply Rminus_lt_0 in Hb).
  assert (0 < Rmin (x - a) (b - x)).
    by apply Rmin_case.
  exists (mkposreal _ H) => y /= Hy ; split.
  apply Rplus_lt_reg_r with (-x).
  replace (a+-x) with (-(x-a)) by ring.
  apply (Rabs_lt_between (y - x)).
  apply Rlt_le_trans with (1 := Hy).
  by apply Rmin_l.
  apply Rplus_lt_reg_r with (-x).
  apply (Rabs_lt_between (y - x)).
  apply Rlt_le_trans with (1 := Hy).
  by apply Rmin_r.
  exists (mkposreal _ Ha) => y /= Hy ; split => //.
  apply Rplus_lt_reg_r with (-x).
  replace (a+-x) with (-(x-a)) by ring.
  by apply (Rabs_lt_between (y - x)).
  exists (mkposreal _ Hb) => y /= Hy ; split => //.
  apply Rplus_lt_reg_r with (-x).
  by apply (Rabs_lt_between (y - x)).
  exists (mkposreal _ Rlt_0_1) ; by split.
Qed.

Lemma Rbar_min_comm (x y : Rbar) : Rbar_min x y = Rbar_min y x.
Proof.
  case: x => [x | | ] //= ;
  case: y => [y | | ] //=.
  by rewrite Rmin_comm.
Qed.

Lemma Rbar_min_r (x y : Rbar) : Rbar_le (Rbar_min x y) y.
Proof.
  case: x => [x | | ] //= ;
  case: y => [y | | ] //=.
  by apply Rmin_r.
  by apply Rle_refl.
Qed.

Lemma Rbar_min_l (x y : Rbar) : Rbar_le (Rbar_min x y) x.
Proof.
  rewrite Rbar_min_comm.
  by apply Rbar_min_r.
Qed.

Lemma Rbar_min_case (x y : Rbar) (P : Rbar -> Type) :
  P x -> P y -> P (Rbar_min x y).
Proof.
  case: x => [x | | ] //= ;
  case: y => [y | | ] //=.
  by apply Rmin_case.
Qed.
Lemma Rbar_min_case_strong (r1 r2 : Rbar) (P : Rbar -> Type) :
  (Rbar_le r1 r2 -> P r1) -> (Rbar_le r2 r1 -> P r2)
    -> P (Rbar_min r1 r2).
Proof.
  case: r1 => [x | | ] //= ;
  case: r2 => [y | | ] //= Hx Hy ;
  (try by apply Hx) ; (try by apply Hy).
  by apply Rmin_case_strong.
Qed.

(** * Rbar_abs *)

Definition Rbar_abs (x : Rbar) :=
  match x with
    | Finite x => Finite (Rabs x)
    | _ => p_infty
  end.

Lemma Rbar_abs_lt_between (x y : Rbar) :
  Rbar_lt (Rbar_abs x) y <-> (Rbar_lt (Rbar_opp y) x /\ Rbar_lt x y).
Proof.
  case: x => [x | | ] ; case: y => [y | | ] /= ; try by intuition.
  by apply Rabs_lt_between.
Qed.

Lemma Rbar_abs_opp (x : Rbar) :
  Rbar_abs (Rbar_opp x) = Rbar_abs x.
Proof.
  case: x => [x | | ] //=.
  by rewrite Rabs_Ropp.
Qed.

Lemma Rbar_abs_pos (x : Rbar) :
  Rbar_le 0 x -> Rbar_abs x = x.
Proof.
  case: x => [x | | ] //= Hx.
  by apply f_equal, Rabs_pos_eq.
Qed.
Lemma Rbar_abs_neg (x : Rbar) :
  Rbar_le x 0 -> Rbar_abs x = Rbar_opp x.
Proof.
  case: x => [x | | ] //= Hx.
  rewrite -Rabs_Ropp.
  apply f_equal, Rabs_pos_eq.
  now rewrite -Ropp_0 ; apply Ropp_le_contravar.
Qed.


Require Import Reals Coq.Lists.List Coquelicot.Series Coquelicot.Hierarchy Coquelicot.SF_seq.
Require Import pmf_monad mdp Permutation fixed_point FiniteType LibUtils.
Require Import Sums Coq.Reals.ROrderedType.
Require Import micromega.Lra.
Require Import micromega.Lia.
Require Import Coq.Logic.FunctionalExtensionality.
Require Import Equivalence RelationClasses EquivDec Morphisms.
Require Import ExtLib.Structures.Monad.

Require Import ListAdd RealAdd.

Set Bullet Behavior "Strict Subproofs".
(*
****************************************************************************************
In this file we only consider a finite list of policies.
****************************************************************************************
*)

Import ListNotations.

Section all_lists.

 Fixpoint all_lists_upto {A} (l:list A) (n:nat) : list (A * list A)
  := match n with
     | 0 => nil
     | 1 => map (fun x => (x,nil)) l
     | S m => (list_prod l (map (fun '(a,b) => a::b) (all_lists_upto l m)))
     end.

Lemma all_lists_upto_non_nil {A} (l:list A) n : nil <> l -> (n > 0)%nat -> nil <> all_lists_upto l n.
Proof.
  intros.
  induction n; simpl.
  - lia.
  - case_eq n; intros.
    + destruct l; simpl; congruence.
    + apply list_prod_not_nil; trivial.
      subst.
      destruct (all_lists_upto l (S n0)); simpl.
      * elim IHn; trivial.
        lia.
      * destruct p; simpl.
        congruence.
Qed.

Lemma all_lists_upto_total {A} (l:list A) n :
  forall a' l', incl (a'::l') l -> length (a'::l') = n ->
           In (a',l') (all_lists_upto l n).
Proof.
  induction n; simpl; intros.
  - lia.
  - invcs H0.
    destruct l'; simpl; intros.
    + red in H.
      apply in_map_iff.
      eexists; split; [reflexivity | ].
      simpl in *.
      eauto.
    + apply in_prod_iff.
      split.
      * specialize (H a').
        simpl in H; eauto.
      * simpl in IHn.
        apply in_map_iff.
        exists (a,l').
        split; trivial.
        apply IHn; trivial.
        unfold incl in *; simpl in *.
        eauto.
Qed.

Lemma all_lists_upto_in {A} (l:list A) n x :
  In x (all_lists_upto l n) -> In (fst x) l /\ incl (snd x) l.
Proof.
  revert x.
  induction n; simpl; intros.
  - intuition.
  - destruct n.
    + apply in_map_iff in H.
      destruct H as [? [??]]; subst; simpl.
      split; trivial.
      intros ?; simpl; intuition.
    + destruct x; simpl.
      apply in_prod_iff in H.
      destruct H as [? inn].
      split; trivial.
      apply in_map_iff in inn.
      destruct inn as [[??] [? inn]]; subst.
      destruct (IHn _ inn).
      simpl in *.
      intros ?; simpl; intros inn2.
      destruct inn2; [congruence|].
      now specialize (H1 _ H2).
Qed.

Lemma all_lists_length {A} (l:list A) n x:
  In x (all_lists_upto l n) -> length (fst x :: snd x) = n.
Proof.
  revert x.
  induction n; simpl; intros [??] inn.
  - intuition.
  - f_equal.
    destruct n.
    + apply in_map_iff in inn.
      destruct inn as [? [??]]; subst; simpl; trivial.
      invcs H; simpl; trivial.
    + simpl.
      apply in_prod_iff in inn.
      destruct inn as [inn1 inn2].
      apply in_map_iff in inn2.
      destruct inn2 as [[??] [? inn2]].
      subst.
      specialize (IHn _ inn2).
      now simpl in *.
Qed.

Lemma all_lists_upto_prod {A} (l:list A) n :
  let l' := all_lists_upto l n in
  equivlist (list_prod (map fst l') (map snd l')) l'.
Proof.
  simpl.
  apply equivlist_incls.
  split; intros [??] inn.
  - apply in_prod_iff in inn.
    destruct inn as [inn1 inn2].
    apply in_map_iff in inn1.
    apply in_map_iff in inn2.
    destruct inn1 as [? [??]].
    destruct inn2 as [? [??]].
    subst.
    generalize (all_lists_length l n x0 H2); simpl; intros HH.
    apply all_lists_upto_in in H0.
    apply all_lists_upto_in in H2.
    apply all_lists_upto_total; simpl; trivial.
    apply incl_cons; intuition.
  - apply in_prod_iff.
    split.
    + apply in_map_iff.
      exists (a,l0); simpl; intuition.
    + apply in_map_iff.
      exists (a,l0); simpl; intuition.
Qed.
Lemma all_lists_upto_fsts {A} (l:list A) n :
  equivlist (map fst (all_lists_upto l (S n))) l.
Proof.
  induction n; intros.
  - simpl.
    rewrite map_map; simpl.
    rewrite map_id.
    reflexivity.
  - simpl all_lists_upto.
    destruct l.
    + reflexivity.
    + apply list_prod_fst_equiv.
      intros eqq.
      apply map_nil' in eqq.
      destruct n.
      * simpl in eqq; congruence.
      * symmetry in eqq. revert eqq.
        apply list_prod_not_nil.
        -- congruence.
        -- intro eqq.
           symmetry in eqq.
           apply map_nil' in eqq.
           symmetry in eqq.
           revert eqq.
           apply all_lists_upto_non_nil.
           ++ congruence.
           ++ lia.
Qed.

Lemma all_lists_upto_snds {A} (l:list A) n :
  equivlist (map snd (all_lists_upto l (S (S n)))) (map (fun '(h,t) => (h::t)) (all_lists_upto l (S n))).
Proof.
  induction n; intros; simpl.
  - rewrite map_map.
    destruct l.
    + reflexivity.
    + rewrite list_prod_snd_equiv by congruence.
      reflexivity.
  - simpl in IHn.
    destruct l.
    + simpl; reflexivity.
    + rewrite list_prod_snd_equiv by congruence.
      rewrite list_prod_snd_equiv in IHn by congruence.
      apply map_equivlist_proper; [reflexivity | ].
      now apply list_prod_equivlist; [ reflexivity | ].
Qed.

End all_lists.

Section ltv_fin.
Open Scope R_scope.
Context (M : MDP) (γ : R).
Context (hγ : (0 <= γ < 1)%R).

Arguments t {_}.
Arguments reward {_}.

Definition kliesli_iter_left (Π : list(dec_rule M)) (init : M.(state)) : Pmf M.(state):=
  fold_left (fun p π => Pmf_bind p (fun s => t s (π s))) Π (ret init).

Definition kliesli_iter_left_vector (init : Pmf M.(state)) (Π : list(dec_rule M))  : Pmf M.(state):=
  fold_left (fun p π => Pmf_bind p (fun s => t s (π s))) Π init.

Lemma ff_left {A B: Type} (f: A -> B -> A) (π0: B) (πs: list B) (s: A):  fold_left f πs (f s π0) = fold_left f (π0::πs) s.
Proof.
  simpl. reflexivity.
Qed.

Lemma kliesli_iter_left_cons0 π πs: forall p,
    kliesli_iter_left_vector  (Pmf_bind p (fun s0 => t s0 (π s0))) πs
    = kliesli_iter_left_vector p (π :: πs).
Proof.
  intros.
  unfold kliesli_iter_left_vector. rewrite <- ff_left. reflexivity.
Qed.

Definition expt_reward_gen (p : Pmf M.(state)) (Π : list(dec_rule M))  (σ : dec_rule M)
  : R :=
  expt_value (kliesli_iter_left_vector p Π ) (step_expt_reward σ).

Definition ltv_fin (p: Pmf M.(state)) (Π : list(dec_rule M)) :=
    match Π with
    | nil => 0
    | π :: Π' => sum_f_R0' (fun n =>
                            match nth_error Π n with
                            | Some σ => γ^n*expt_reward_gen p (firstn n Π) σ
                            | None => 0
                            end) (length Π)
    end.

Lemma ltv_fin_cons_term1 p π:
  expt_reward_gen p [] π = expt_value p (fun s : state M => expt_value (t s (π s)) (reward s (π s))).
Proof.
  unfold expt_reward_gen.
  unfold kliesli_iter_left_vector.
  simpl. reflexivity.
Qed.

Lemma expt_reward_cons4 π πs σ vs:
  expt_reward_gen vs (π :: πs) σ =
  expt_reward_gen (Pmf_bind vs (fun s0 => t s0 (π s0))) πs σ.
Proof.
  unfold expt_reward_gen. rewrite kliesli_iter_left_cons0.
  reflexivity.
Qed.

Theorem ltv_fin_cons (π: dec_rule M) (πs: list(dec_rule M)) (p: Pmf M.(state)):
  ltv_fin p (π :: πs) = expt_value p (step_expt_reward π) +
                         γ*(ltv_fin (Pmf_bind (p) (fun s0 => (t s0 (π s0)))) πs).
Proof.
  intros.
  unfold step_expt_reward.
  unfold ltv_fin.
  assert (Hl: length (π :: πs) = S(length (πs))) by reflexivity.
  rewrite Hl.
  rewrite (sum_f_R0'_split _ _ 1) by lia.
  simpl.
  replace (0 + 1 * expt_reward_gen p [] π) with (expt_reward_gen p [] π) by lra.
  rewrite <- ltv_fin_cons_term1.
  apply Rplus_eq_compat_l.
  replace (length πs) with (length πs - 0)%nat by lia.
  destruct πs.
  -  simpl. lra.
  -  rewrite <- sum_f_R0'_mult_const.
     apply sum_f_R0'_ext.
     intros.
     replace (x + 1)%nat with (S x) by lia.
     simpl.
     replace (length (d :: πs) - 0)%nat with (length (d :: πs)) in H by lia.
     apply nth_error_Some in H.
     match_destr; [| congruence].
     rewrite <- Rmult_assoc.
     f_equal.
Qed.

Corollary ltv_fin_pure (π: dec_rule M) (πs: list(dec_rule M)) s:
  ltv_fin (Pmf_pure s) (π :: πs) = expt_value (Pmf_pure s) (step_expt_reward π) +
                                  γ*(ltv_fin (t s (π s)) πs).
Proof.
  now rewrite ltv_fin_cons, Pmf_bind_of_ret.
Qed.

Lemma combine_map_fst_snd {A B} (l:list (A*B)) : combine (map fst l) (map snd l) = l.
Proof.
  induction l; simpl; trivial.
  destruct a; rewrite IHl; simpl; trivial.
Qed.

Theorem Rmax_list_prod_equivlist_split {A} (f:list A -> R) (l:list (A * list A)) :
  nil <> l ->
  equivlist (list_prod (map fst l) (map snd l)) l ->
  Max_{ l } (fun '(h,t) => f (h::t)) =
  Max_{ map fst l } (fun h => Max_{map snd l} (fun t => f (h::t)))
.
Proof.
  intros.
  rewrite Rmax_list_prod_combine; trivial.
  - rewrite combine_map_fst_snd.
    f_equal.
    apply map_ext; simpl; intros [??]; trivial.
  - now apply map_not_nil.
  - now apply map_not_nil.
  - now rewrite combine_map_fst_snd.
Qed.

Theorem ltv_fin_28's (l:list (dec_rule M * list (dec_rule M))) s :
  nil <> l ->
  equivlist (list_prod (map fst l) (map snd l)) l ->
  Max_{ l } (fun '(h,t) => ltv_fin (Pmf_pure s) (h::t)) =
  Max_{ map fst l } (fun h => Max_{map snd l} (fun t => ltv_fin (Pmf_pure s) (h::t))).
Proof.
  apply Rmax_list_prod_equivlist_split.
Qed.

Theorem Rmax_list_dec_rule_split n p :
  (n > 0)%nat ->
  let l' := all_lists_upto (@fin_elms _ (dec_rule_finite M)) n in
  Max_{ l' } (fun '(h,t) => ltv_fin p (h::t)) =
  Max_{ map fst l' } (fun h => Max_{map snd l'} (fun t => ltv_fin p (h::t)))
.
Proof.
  intros.
  apply Rmax_list_prod_equivlist_split.
  - apply all_lists_upto_non_nil; trivial.
    destruct (dec_rule_finite M); simpl.
    generalize (nonempty_dec_rule M); intros e.
    destruct fin_elms; [| congruence].
    elim (fin_finite e).
  - apply all_lists_upto_prod.
Qed.

(* Optimal value function for a time n MDP. *)
Definition max_ltv_fin (n:nat) p :=
  let l' := all_lists_upto (@fin_elms _ (dec_rule_finite M)) n in
  Max_{ l' } (fun '(h,t) => ltv_fin p (h::t)).

Theorem max_ltv_corec p n:
  max_ltv_fin (S (S n)) p =
  Max_{(@fin_elms _ (dec_rule_finite M))}
      (fun h => expt_value p (step_expt_reward h) +
             γ * max_ltv_fin (S n) (Pmf_bind p (fun s0 => (t s0 (h s0))))).
Proof.
  unfold max_ltv_fin.
  intros.
  generalize (Rmax_list_dec_rule_split (S (S n)) p); intros HH.
  rewrite HH; [| lia].
  rewrite all_lists_upto_fsts.
  f_equal.
  apply map_ext; intros.
  rewrite all_lists_upto_snds.
  rewrite map_map.
  transitivity (
  (Max_{ all_lists_upto fin_elms (S n)}
   (fun '(h, tl) => expt_value p (step_expt_reward a) +
                γ * ltv_fin (Pmf_bind p (fun s0 : state M => t s0 (a s0))) (h :: tl)))).
  - f_equal.
    apply map_ext; intros.
    destruct a0.
    apply ltv_fin_cons.
  - rewrite <- Rmax_list_map_const_mul by lra.
    rewrite Rplus_comm.
    generalize (Rmax_list_const_add
                  (@map (prod (dec_rule M) (list (dec_rule M))) R
                        (fun a0 : prod (dec_rule M) (list (dec_rule M)) =>
                           Rmult γ
                                 match a0 return R with
                                 | pair h tl =>
                                   ltv_fin (@Pmf_bind (state M) (state M) p (fun s0 : state M => @t M s0 (a s0)))
                                           (@cons (dec_rule M) h tl)
                                 end) (@all_lists_upto (dec_rule M) (@fin_elms (dec_rule M) (dec_rule_finite M)) (S n)))
                  (expt_value p (step_expt_reward a))); intros HH2.

    case_eq ( map
            (fun a0 : dec_rule M * list (dec_rule M) =>
             γ * (let (h, tl) := a0 in ltv_fin (Pmf_bind p (fun s0 : state M => t s0 (a s0))) (h :: tl)))
            (all_lists_upto fin_elms (S n))); intros.
    + generalize (all_lists_upto_non_nil (@fin_elms _ (dec_rule_finite M)) (S n)); intros HH3.
      destruct ((all_lists_upto (@fin_elms _ (dec_rule_finite M)) (S n))).
      * elim HH3; trivial.
        destruct (dec_rule_finite M); simpl.
        generalize (nonempty_dec_rule M); intros e.
        destruct fin_elms; [| congruence].
        elim (fin_finite e).
        lia.
      * simpl in H; congruence.
    + rewrite H in HH2.
      destruct (r :: l <> []); [| congruence].
      rewrite <- HH2.
      rewrite <- H.
      clear H HH2 c.
      rewrite map_map.
      f_equal.
      apply map_ext; intros [??].
      lra.
Qed.

End ltv_fin.


(** ** Operations & Properties of FOL *)

From Equations Require Import Equations.
Require Import Equations.Prop.DepElim.
From FOL Require Export DecidableEnumerable.
From FOL Require Export FullSyntax.
Require Export Lia.
Import Vector.

(* Coercion var_term : fin >-> term. *)

Notation "phi --> psi" := (Impl phi psi) (right associativity, at level 55).
Notation "phi ∧ psi" := (Conj phi psi) (right associativity, at level 55).
Notation "phi ∨ psi" := (Disj phi psi) (right associativity, at level 55).
Notation "∀ phi" := (All phi) (at level 56, right associativity).
Notation "∃ phi" := (Ex phi) (at level 56, right associativity).
Notation "⊥" := (Fal).
Notation "¬ phi" := (phi --> ⊥) (at level 20).

Section FullFOL.
  Context {Sigma : Signature}.

  Lemma var_subst phi :
    phi[var_term] = phi.
  Proof.
    now asimpl.
  Qed.

  Lemma var_subst_L A :
    [phi[var_term] | phi ∈ A] = A.
  Proof.
    induction A; cbn; trivial.
    now rewrite var_subst, IHA.
  Qed.

  Definition form_shift n := var_term (S n).
  Notation "↑" := form_shift.

  (* **** Subformula *)

  Inductive sf : form -> form -> Prop :=
  | SImplL phi psi : sf phi (phi --> psi)
  | SImplR phi psi : sf psi (phi --> psi)
  (* | SEq s t s' t' : sf (Pr s' t') (Eq s t) *)
  | SDisjL phi psi : sf phi (phi ∨ psi)
  | SDisjR phi psi : sf psi (phi ∨ psi)
  | SConjL phi psi : sf phi (phi ∧ psi)
  | SConjR phi psi : sf psi (phi ∧ psi)
  | SAll phi t : sf (phi [t .: ids]) (∀ phi)
  | SEx phi t : sf (phi [t .: ids]) (∃ phi).

  Lemma sf_acc phi rho :
    Acc sf (phi [rho]).
  Proof.
    revert rho; induction phi; intros rho; constructor; intros psi Hpsi; asimpl in *; inversion Hpsi;
      subst; asimpl in *; eauto.
  Qed.

  Lemma sf_well_founded :
    well_founded sf.
  Proof.
    intros phi. pose proof (sf_acc phi ids) as H. comp. erewrite -> idSubst_form in H; firstorder.
  Qed.

  (* ** Formula size *)

  Fixpoint size (phi : form ) :=
    match phi with
    | Pred _ _ => 0
    | Fal => 0
    | Impl phi psi
    | Conj phi psi
    | Disj phi psi => S (size phi + size psi)
    | All phi
    | Ex phi => S (size phi)
    end.

  Lemma size_ind {X : Type} (f : X -> nat) (P : X -> Prop) :
    (forall x, (forall y, f y < f x -> P y) -> P x) -> forall x, P x.
  Proof.
    intros H x. apply H.
    induction (f x).
    - intros y. omega.
    - intros y. intros [] % le_lt_or_eq.
      + apply IHn; omega.
      + apply H. injection H0. now intros ->.
  Qed.

  Lemma subst_size rho phi :
    size (subst_form rho phi) = size phi.
  Proof.
    revert rho; induction phi; intros rho; cbn; asimpl; try congruence.
  Qed.

  Lemma form_ind_subst (P : form -> Prop) :
    P ⊥ -> (forall p v, P (Pred p v)) ->
    (forall phi psi, P phi -> P psi -> P (phi --> psi)) ->
    (forall phi psi, P phi -> P psi -> P (phi ∧ psi)) ->
    (forall phi psi, P phi -> P psi -> P (phi ∨ psi)) ->
    (forall phi, (forall t, P phi[t..]) -> P (∀ phi)) ->
    (forall phi, (forall t, P phi[t..]) -> P (∃ phi)) ->
    forall phi, P phi.
  Proof.
    intros H1 H2 H3 H4 H5 H6 H7 phi.
    induction phi using (@size_induction _ size).
    destruct phi; trivial.
    - apply H3; apply H; cbn; lia.
    - apply H4; apply H; cbn; lia.
    - apply H5; apply H; cbn; lia.
    - apply H6. intros t. apply H.
      cbn. unfold subst1. rewrite subst_size. lia.
    - apply H7. intros t. apply H.
      cbn. unfold subst1. rewrite subst_size. lia.
  Qed.

  (* **** Free variables *)

  Inductive unused (n : nat) : form -> Prop :=
  | uf_Fal : unused n Fal
  | uf_Pred P v : (forall t, vec_in t v -> unused_term n t) -> unused n (Pred P v)
  | uf_I phi psi : unused n phi -> unused n psi -> unused n (Impl phi psi)
  | uf_A phi psi : unused n phi -> unused n psi -> unused n (Conj phi psi)
  | uf_O phi psi : unused n phi -> unused n psi -> unused n (Disj phi psi)
  | uf_All phi : unused (S n) phi -> unused n (All phi)
  | uf_Ex phi : unused (S n) phi -> unused n (Ex phi).

  Definition unused_L n A := forall phi, phi el A -> unused n phi.
  Definition closed phi := forall n, unused n phi.

  Lemma find_unused phi :
    { n | forall m, n <= m -> unused m phi }.
  Proof with eauto using unused.
    induction phi.
    - exists 0...
    - destruct (@vec_unused _ _ t) as [k H]. 1: eauto using find_unused_term. exists k. eauto using unused.
    - destruct IHphi1, IHphi2. exists (x + x0). intros m Hm. constructor; [ apply u | apply u0 ]; omega.
    - destruct IHphi1, IHphi2. exists (x + x0). intros m Hm. constructor; [ apply u | apply u0 ]; omega.
    - destruct IHphi1, IHphi2. exists (x + x0). intros m Hm. constructor; [ apply u | apply u0 ]; omega.
    - destruct IHphi. exists x. intros m Hm. constructor. apply u. omega.
    - destruct IHphi. exists x. intros m Hm. constructor. apply u. omega.
  Qed.

  Lemma find_unused_L A :
    { n | forall m, n <= m -> unused_L m A }.
  Proof.
    induction A.
    - exists 0. unfold unused_L. intuition.
    - destruct IHA. destruct (find_unused a).
      exists (x + x0). intros m Hm. intros phi []; subst.
      + apply u0. omega.
      + apply u. omega. auto.
  Qed.

  Definition capture n phi := nat_rect _ phi (fun _ => All) n.

  Lemma capture_captures n m phi :
    (forall i, n <= i -> unused i phi) -> (forall i, n - m <= i -> unused i (capture m phi)).
  Proof.
    intros H. induction m; cbn; intros i Hi.
    - rewrite <- minus_n_O in *. intuition.
    - constructor. apply IHm. omega.
  Qed.

  Definition close phi := capture (proj1_sig (find_unused phi)) phi.

  Lemma close_closed phi :
    closed (close phi).
  Proof.
    intros n. unfold close. destruct (find_unused phi) as [m Hm]; cbn.
    apply (capture_captures Hm). omega.
  Qed.

  Fixpoint big_imp A phi :=
    match A with
    | List.nil => phi
    | a :: A' => a --> (big_imp A' phi)
    end.

  (* **** Substituting unused variables *)

  Definition shift_P P n :=
    match n with
    | O => False
    | S n' => P n'
    end.

  Lemma vec_map_ext X Y (f g : X -> Y) n (v : vector X n) :
    (forall x, vec_in x v -> f x = g x) -> map f v = map g v.
  Proof.
    intros Hext; induction v in Hext |-*; cbn.
    - reflexivity.
    - rewrite IHv, (Hext h). 1: reflexivity. all: eauto.
  Qed.

  Context {eq_dec_Funcs : eq_dec Funcs}.
  Context {eq_dec_Preds : eq_dec Preds}.

  Lemma subst_unused_term xi sigma P t :
    (forall x, dec (P x)) -> (forall m, ~ P m -> xi m = sigma m) -> (forall m, P m -> unused_term m t) ->
    subst_term xi t = subst_term sigma t.
  Proof.
    intros Hdec Hext Hunused. induction t using strong_term_ind; cbn; asimpl.
    - destruct (Hdec x) as [H % Hunused | H % Hext].
      + inversion H; subst; congruence.
      + congruence.
    - f_equal. apply vec_map_ext. intros t H'. apply (H t H'). intros n H2 % Hunused. inv H2. eauto.
  Qed.

  Lemma subst_unused_form xi sigma P phi :
    (forall x, dec (P x)) -> (forall m, ~ P m -> xi m = sigma m) -> (forall m, P m -> unused m phi) ->
    subst_form xi phi = subst_form sigma phi.
  Proof.
    induction phi in xi,sigma,P |-*; intros Hdec Hext Hunused; cbn; asimpl.
    - reflexivity.
    - f_equal. apply vec_map_ext. intros s H. apply (subst_unused_term Hdec Hext).
      intros m H' % Hunused. inv H'. eauto.
    - rewrite IHphi1 with (sigma := sigma) (P := P). rewrite IHphi2 with (sigma := sigma) (P := P).
      all: try tauto. all: intros m H % Hunused; now inversion H.
    - rewrite IHphi1 with (sigma := sigma) (P := P). rewrite IHphi2 with (sigma := sigma) (P := P).
      all: try tauto. all: intros m H % Hunused; now inversion H.
    - rewrite IHphi1 with (sigma := sigma) (P := P). rewrite IHphi2 with (sigma := sigma) (P := P).
      all: try tauto. all: intros m H % Hunused; now inversion H.
    - erewrite IHphi with (P := shift_P P). 1: reflexivity.
      + intros [| x]; [now right| now apply Hdec].
      + intros [| m]; [reflexivity|]. intros Heq % Hext; unfold ">>"; cbn; congruence.
      + intros [| m]; [destruct 1| ]. intros H % Hunused; now inversion H.
    - erewrite IHphi with (P := shift_P P). 1: reflexivity.
      + intros [| x]; [now right| now apply Hdec].
      + intros [| m]; [reflexivity|]. intros Heq % Hext; unfold ">>"; cbn; congruence.
      + intros [| m]; [destruct 1| ]. intros H % Hunused; now inversion H.
  Qed.

  Lemma subst_unused_single xi sigma n phi :
    unused n phi -> (forall m, n <> m -> xi m = sigma m) -> subst_form xi phi = subst_form sigma phi.
  Proof.
    intros Hext Hunused. apply subst_unused_form with (P := fun m => n = m). all: intuition.
    now subst.
  Qed.

  Lemma subst_unused_range xi sigma phi n :
    (forall m, n <= m -> unused m phi) -> (forall x, x < n -> xi x = sigma x) -> subst_form xi phi = subst_form sigma phi.
  Proof.
    intros Hle Hext. apply subst_unused_form with (P := fun x => n <= x); [apply le_dec| |assumption].
    intros ? ? % not_le; intuition.
  Qed.

  Lemma subst_unused_closed xi sigma phi :
    closed phi -> subst_form xi phi = subst_form sigma phi.
  Proof.
    intros Hcl. apply subst_unused_range with (n := 0); intuition. omega.
  Qed.

  Lemma subst_unused_closed' xi phi :
    closed phi -> subst_form xi phi = phi.
  Proof.
    intros Hcl. rewrite <- idSubst_form with (sigmaterm := ids).
    apply subst_unused_range with (n := 0). all: intuition; omega.
  Qed.

  Lemma vec_forall_map X Y (f : X -> Y) n (v : vector X n) (p : Y -> Type) :
    (forall x, vec_in x v -> p (f x)) -> forall y, vec_in y (map f v) -> p y.
  Proof.
    intros H y Hmap. induction v; cbn; inv Hmap; eauto.
  Qed.

  (* **** Theories *)

  Definition theory := form -> Prop.
  Definition contains phi (T : theory) := T phi.
  Definition contains_L (A : list form) (T : theory) := forall f, f el A -> contains f T.
  Definition subset_T (T1 T2 : theory) := forall (phi : form), contains phi T1 -> contains phi T2.
  Definition list_T A : theory := fun phi => phi el A.

  Infix "⊏" := contains_L (at level 20).
  Infix "⊑" := subset_T (at level 20).
  Infix "∈" := contains (at level 70).

  Hint Unfold contains.
  Hint Unfold contains_L.
  Hint Unfold subset_T.

  Global Instance subset_T_trans : Transitive subset_T.
  Proof.
    intros T1 T2 T3. intuition.
  Qed.

  Definition extend T (phi : form) := fun psi => T psi \/ psi = phi.
  Infix "⋄" := extend (at level 20).

  Definition closed_T (T : theory) := forall phi n, contains phi T -> unused n phi.
  Lemma closed_T_extend T phi :
    closed_T T -> closed phi -> closed_T (T ⋄ phi).
  Proof.
    intros ? ? ? ? []; subst; intuition.
  Qed.

  Section ContainsAutomation.
    Lemma contains_nil T :
      List.nil ⊏ T.
    Proof. intuition. Qed.

    Lemma contains_cons a A T :
      a ∈ T -> A ⊏ T -> (a :: A) ⊏ T.
    Proof. intros ? ? ? []; subst; intuition. Qed.

    Lemma contains_cons2 a A T :
      (a :: A) ⊏ T -> A ⊏ T.
    Proof. firstorder. Qed.

    Lemma contains_app A B T :
      A ⊏ T -> B ⊏ T -> (A ++ B) ⊏ T.
    Proof. intros ? ? ? [] % in_app_or; intuition. Qed.

    Lemma contains_extend1 phi T :
      phi ∈ (T ⋄ phi).
    Proof. now right. Qed.

    Lemma contains_extend2 phi psi T :
      phi ∈ T -> phi ∈ (T ⋄ psi).
    Proof. intros ?. now left. Qed.

    Lemma contains_extend3 A T phi :
      A ⊏ T -> A ⊏ (T ⋄ phi).
    Proof.
      intros ? ? ?. left. intuition.
    Qed.
  End ContainsAutomation.
End FullFOL.

Definition tmap {S1 S2 : Signature} (f : @form S1 -> @form S2) (T : @theory S1) : @theory S2 :=
  fun phi => exists psi, T psi /\ f psi = phi.

Lemma enum_tmap {S1 S2 : Signature} (f : @form S1 -> @form S2) (T : @theory S1) L :
  enum T L -> enum (tmap f T) (L >> List.map f).
Proof.
  intros []. split; unfold ">>".
  - intros n. destruct (H n) as [A ->]. exists (List.map f A). apply map_app.
  - intros x; split.
    + intros (phi & [m Hin] % H0 & <-). exists m. apply in_map_iff. firstorder.
    + intros (m & (phi & <- & Hphi) % in_map_iff). firstorder.
Qed.

Lemma tmap_contains_L {S1 S2 : Signature} (f : @form S1 -> @form S2) T A :
  contains_L A (tmap f T) -> exists B, A = List.map f B /\ contains_L B T.
Proof.
  induction A.
  - intros. now exists List.nil.
  - intros H. destruct IHA as (B & -> & HB). 1: firstorder.
    destruct (H a (or_introl eq_refl)) as (b & Hb & <-).
    exists (b :: B). split. 1: auto. intros ? []; subst; auto.
Qed.

Hint Constructors vec_in.

Infix "⊏" := contains_L (at level 20).
Infix "⊑" := subset_T (at level 20).
Infix "∈" := contains (at level 70).
Infix "⋄" := extend (at level 20).

Hint Resolve contains_nil contains_cons contains_cons2 contains_app : contains_theory.
Hint Resolve contains_extend1 contains_extend2 contains_extend3 : contains_theory.
Ltac use_theory A := exists A; split; [eauto 15 with contains_theory|].

(* **** Equality deciders *)

Lemma dec_vec_in X n (v : vector X n) :
  (forall x, vec_in x v -> forall y, dec (x = y)) -> forall v', dec (v = v').
Proof with subst; try (now left + (right; intros[=]; resolve_existT; congruence)).
  intros Hv. induction v; intros v'; dependent destruction v'...
  destruct (Hv h (vec_inB h v) h0)... destruct (IHv (fun x H => Hv x (vec_inS h0 H)) v')...
Qed.

Instance dec_vec X {HX : eq_dec X} n : eq_dec (vector X n).
Proof.
  intros v. refine (dec_vec_in _).
Qed.

Section EqDec.
  Context {Sigma : Signature}.

  Hypothesis eq_dec_Funcs : eq_dec Funcs.
  Hypothesis eq_dec_Preds : eq_dec Preds.

  Global Instance dec_term : eq_dec term.
  Proof with subst; try (now left + (right; intros[=]; resolve_existT; congruence)).
    intros t. induction t using strong_term_ind; intros []...
    - decide (x = n)...
    - decide (F = f)... destruct (dec_vec_in X t)...
  Qed.

  Global Instance dec_form : eq_dec form.
  Proof with subst; try (now left + (right; intros[=]; resolve_existT; congruence)).
    intros phi. induction phi; intros []...
    - decide (P = P0)... decide (t = t0)...
    - decide (phi1 = f)... decide (phi2 = f0)...
    - decide (phi1 = f)... decide (phi2 = f0)...
    - decide (phi1 = f)... decide (phi2 = f0)...
    - decide (phi = f)...
    - decide (phi = f)...
  Qed.
End EqDec.

Notation "↑" := form_shift.
Notation "A ⟹ phi" := (big_imp A phi) (at level 60, right associativity).