(**************************************************************************
* TLC: A library for Coq                                                  *
* Finite maps                                                             *
**************************************************************************)

Set Implicit Arguments.
Generalizable Variables A B.
Require Import LibTactics LibLogic LibReflect LibOption
  LibRelation LibLogic LibOperation LibEpsilon LibSet.
Require Export LibBag.

(* ---------------------------------------------------------------------- *)
(** ** Notations to help the typechecker *)

Notation "x \indom E" := (x \in (dom E : set _))
  (at level 39) : container_scope.
Notation "x \notindom E" := (x \notin ((dom E) : set _))
  (at level 39) : container_scope.

(* ********************************************************************** *)
(** * Construction of maps as functions *)

(* ---------------------------------------------------------------------- *)
(** ** Basic definitions *)

Definition map (A B : Type) := A -> option B.

Section Operations.
Variables (A B : Type).
Implicit Types k : A.
Implicit Types x : B.
Implicit Types M N : map A B.
Implicit Types E : set A.

Definition empty_impl : map A B := fun _ => None.
Definition single_bind_impl k x := fun k' => If k = k' then Some x else None.
Definition binds_impl M k x := M k = Some x.
Definition union_impl M N :=
  fun k => match N k with
           | None => M k
           | Some v => Some v
           end.
Definition remove_impl M E :=
  fun k => If k \in E then None else M k.
Definition restrict_impl M E :=
  fun k => If k \in E then M k else None.

End Operations.

Definition read_impl A `{Inhab B} (M:map A B) (k:A) :=
  match M k with
  | None => arbitrary
  | Some v => v
  end.

(* ---------------------------------------------------------------------- *)
(** ** Notation through typeclasses *)

Instance empty_inst : forall A B, BagEmpty (map A B).
  constructor. rapply (@empty_impl A B). Defined.
Instance single_bind_inst : forall A B, BagSingleBind A B (map A B).
  constructor. rapply (@single_bind_impl A B). Defined.
Instance binds_inst : forall A B, BagBinds A B (map A B).
  constructor. rapply (@binds_impl A B). Defined.
Instance union_inst : forall A B, BagUnion (map A B). (* todo: bug pas si on enlve B *)
  constructor. rapply (@union_impl A B). Defined.
Instance remove_inst : forall A B, BagRemove (map A B) (set A).
  constructor. rapply (@remove_impl A B). Defined.
Instance restrict_inst : forall A B, BagRestrict (map A B) (set A).
  constructor. rapply (@restrict_impl A B). Defined.
Instance read_inst : forall A `{Inhab B}, BagRead A B (map A B).
  constructor. rapply (@read_impl A B H). Defined.

(* bin : check
Instance update_inst : forall A B, BagUpdate A B (map A B).
typeclass.
*)

Global Opaque map empty_inst single_bind_inst binds_inst
 union_inst restrict_inst remove_inst read_inst.

(** [dom] *)

Definition dom_impl A B (M:map A B) := set_st (fun k => exists v, binds M k v).

Instance dom_inst : forall A B, BagDom (map A B) (set A).
  constructor. rapply (@dom_impl A B). Defined.

Instance disjoint_inst : forall A B, BagDisjoint (map A B).
  constructor. rapply (fun M N : map A B => disjoint (dom M) (dom N)). Defined.

Instance map_inhab : forall A, Inhab (map A B).
Proof using. intros. apply (prove_Inhab (@empty_impl A B)). Qed.

Global Opaque dom_inst disjoint_inst.

(** [index] *)

Instance map_index : forall A B, BagIndex A (map A B).
Proof using. intros. constructor. exact (fun m k => k \in (dom m : set A)). Defined.

Lemma map_index_def : forall A B (m:map A B) k,
  index m k = (k \in (dom m : set A)).
Proof using. auto. Qed.

Global Opaque map_index_def.

(* TODO: missing a lemma for extensional equality *)

(* ********************************************************************** *)
(** * Properties of maps *)
(*TODO: under construction *)

Section Properties.
Transparent map dom_inst binds_inst empty_inst.

Lemma dom_empty : forall A B,
  dom (\{} : map A B) = (\{} : set A).
Proof using.
  intros. simpl. unfold dom_impl. simpl. unfold binds_impl, empty_impl.
  apply set_ext. intros x. rewrite in_set_st_eq. iff [v Hv] H; false.
Qed.

Lemma in_dom_empty : forall A B x,
  x \indom (\{} : map A B) ->
  False.
Proof using.
  intros. rewrite dom_empty in *. eapply in_empty; typeclass.
Qed.

Lemma no_binds_empty : forall (A B : Type) (M : map A B),
  (forall x k, ~ binds M x k) -> M = \{}.
Proof using.
  intros A B M. simpl. unfold empty_impl, binds_impl.
  intros H. apply func_ext_1. intros x. cases (M x); auto_false*.
Qed.

Lemma dom_empty_inv : forall A B (M : map A B),
  dom M = \{} -> M = \{}.
Proof using.
  intros A B M. simpl. unfold dom_impl, empty_impl.
  intro H.
  admit.   (* todo: use lemma above and binds_dom *)
Qed.

End Properties.

Axiom restrict_read : forall A `{Inhab B} (M:map A B) i j,
  i <> j -> (M\--i)[j] = M[j].

Axiom restrict_update : forall A `{Inhab B} (M:map A B) i j v,
  i <> j -> (M\--i)[j:=v] = (M[j:=v] \--i).

Axiom dom_update_in : forall A i `{Inhab B} v (M:map A B),
  index M i -> dom (M[i:=v]) = dom M.

Lemma dom_update_in_variant:
  forall A `{Inhab B} (M M' : map A B) (D : set A) x v,
  M' = M[x:=v] ->
  D = dom M ->
  x \in D ->
  D = dom M'.
Proof using.
  intros. subst. rewrite dom_update_in; eauto.
Qed.

Axiom dom_restrict_in : forall A i j `{Inhab B} (M:map A B),
  index M j -> i <> j -> index (M\--i) j.

Axiom update_update_eq : forall A i `{Inhab B} v v' (M:map A B),
  M[i:=v][i:=v'] = M[i:=v'].

Implicit Arguments dom_update_in [A B [H]].
Implicit Arguments dom_restrict_in [A B [H]].

Lemma map_update_as_union : forall A B (M:map A B) x v,
  M[x:=v] = M \u (x \:= v).
Proof using. auto. Qed.

Axiom map_split : forall A (E:set A) B (M:map A B),
  M = (M \- E) \u (M \| E).
Axiom map_restrict_single : forall A (x:A) B `{Inhab B} (M:map A B),
  M \| \{x} = (x \:= (M[x])).
Lemma map_split_single : forall A (x:A) B `{Inhab B} (M:map A B),
  M = (M \- \{x}) \u (x \:= (M[x])).
Proof using. intros. rewrite~ <- map_restrict_single. apply map_split. Qed.

Axiom map_indom_update_inv : forall A `{Inhab B} (m:map A B) (i j:A) (v:B),
  j \indom (m[i:=v]) -> (j = i \/ j \indom m).
Axiom map_indom_update_already : forall A `{Inhab B} (m:map A B) (i j:A) (v:B),
  j \indom m -> j \indom (m[i:=v]).

(* TEMPORARY {Inhab B} not needed in the following axioms, I think *)
Axiom binds_def : forall A `{Inhab B} (M:map A B) x v,
  binds M x v = (x \indom M /\ M[x] = v).
Axiom binds_inv : forall A `{Inhab B} (M:map A B) x v,
  binds M x v -> (x \indom M /\ M[x] = v).
Axiom binds_prove : forall A `{Inhab B} (M:map A B) x v,
  x \indom M -> M[x] = v -> binds M x v.

Axiom binds_update_neq : forall A B i j v w (M:map A B),
  i <> j -> binds M i v -> binds (M[j:=w]) i v.

Axiom binds_update_eq : forall A B i v (M:map A B),
  binds (M[i:=v]) i v.

Axiom binds_update_neq_inv : forall A B i j v w (M:map A B),
  binds (M[j:=w]) i v -> i <> j -> binds M i v.
Axiom binds_update_neq_inv' : forall A B i j v w (M:map A B),
  binds (M[j:=w]) i v -> j \notin (dom M : set _) -> binds M i v.

Axiom binds_inj : forall A i `{Inhab B} v1 v2 (M:map A B),
  binds M i v1 -> binds M i v2 -> v1 = v2.

(*
Axiom binds_update_rem : forall A i j `{Inhab B} v w (M:map A B),
  j \notindom' M -> binds (M[j:=w]) i v -> binds M i v.
Hint Resolve binds_update_rem.
*)

Axiom binds_get : forall A `{Inhab B} (M:map A B) x v,
  binds M x v -> M[x] = v.
Axiom binds_dom : forall A `{Inhab B} (M:map A B) x v,
  binds M x v -> x \indom M.

Axiom dom_update_notin : forall A B i v (M:map A B),
  i \notin (dom M : set _) -> dom (M[i:=v]) = dom M \u \{i}.
  (* TEMPORARY semble vrai aussi sans l'hypothèse? *)

Axiom binds_index : forall A i `{Inhab B} v (M:map A B),
  binds M i v -> index M i.

Axiom binds_update_neq' : forall A i j `{Inhab B} v w (M:map A B),
  i <> j -> binds M i v -> binds (M[j:=w]) i v.

Axiom map_indom_update_already_inv : forall A `{Inhab B} (m:map A B) (i j:A) (v:B),
  j \indom (m[i:=v]) -> i \indom m -> j \indom m.
Global Opaque binds_inst.

Axiom map_update_read_if : forall A `{Inhab B} (m:map A B) (i j:A) (v:B),
  (m[i:=v])[j] = If i = j then v else m[j].

Lemma binds_update_neq_iff: forall A `{Inhab B} i j v w (M:map A B),
  j \notin (dom M : set _) ->
  (binds M i v <-> binds (M[j:=w]) i v).
Proof using.
  split; intros.
  { eapply binds_update_neq; [ | eauto ].
    assert (i \indom M). { eapply binds_index; eauto. }
    intro. subst. unfold notin in *. tauto. }
  { eauto using binds_update_neq_inv'. }
Qed.

Lemma binds_update_analysis: forall A B i j v w (M:map A B),
  binds (M[j:=w]) i v ->
  i <> j /\ binds M i v \/
  i = j /\ v = w.
Proof using.
  intros.
  forwards [ ? ? ]: binds_inv.
Admitted.  (* COQBUG eexact H. *)

Lemma binds_update_indom_iff:
  forall A B (M : map A B) a1 a2 b1 b2,
  (a2 <> a1 /\ binds M a2 b2 \/ a2 = a1 /\ b2 = b1)
  <->
  binds (M[a1:=b1]) a2 b2.
Proof using.
  split. introv [ [ ? ? ] | [ ? ? ] ].
  { eauto using binds_update_neq. }
  { subst. eapply binds_update_eq. }
  { eauto using binds_update_analysis. }
Qed.

(* todo *)
Axiom map_indom_update : forall A `{Inhab B} (m:map A B) (i j:A) (v:B),
  j \indom (m[i:=v]) = (j = i \/ j \indom m).
Lemma map_indom_update_self : forall A `{Inhab B} (m:map A B) (i:A) (v:B),
  i \indom (m[i:=v]).
Proof using. intros. rewrite~ map_indom_update. Qed.

Hint Resolve map_indom_update_self.

Axiom map_update_read_eq : forall A `{Inhab B} (m:map A B) (i:A) (v:B),
  (m[i:=v])[i] = v.
Axiom map_update_read_neq : forall A `{Inhab B} (m:map A B) (i j:A) (v:B),
  i<>j -> (m[i:=v])[j] = m[j].

Axiom map_update_restrict : forall A `{Inhab B} (m:map A B) (i:A) (v:B),
  (m[i:=v] \- \{i}) = (m \- \{i}).

Hint Rewrite @map_indom_update @map_update_read_neq @map_update_read_eq : rew_map.

Tactic Notation "rew_map" :=
  autorewrite with rew_map.
Tactic Notation "rew_map" "in" hyp(H) :=
  autorewrite with rew_map in H.
Tactic Notation "rew_map" "in" "*" :=
  autorewrite_in_star_patch ltac:(fun tt => autorewrite with rew_map).
  (* autorewrite with rew_map in *. *)

Tactic Notation "rew_map" "~" :=
  rew_map; auto_tilde.
Tactic Notation "rew_map" "*" :=
  rew_map; auto_star.
Tactic Notation "rew_map" "~" "in" hyp(H) :=
  rew_map in H; auto_tilde.
Tactic Notation "rew_map" "*" "in" hyp(H) :=
  rew_map in H; auto_star.

(* ---------------------------------------------------------------------- *)
(** ** Reduce on maps *)

Require Import LibStruct.
Section Reduce.
Variables (A B C : Type).
Parameter reduce : monoid_def C -> (A -> B -> C) -> map A B -> C.
Parameter reduce_empty : forall m f, Monoid m ->
  reduce m f \{} = monoid_neutral m.
Parameter reduce_single : forall x v m f, Monoid m ->
  reduce m f (x \:= v) = f x v.
Parameter reduce_union : forall M1 M2 m f, Monoid m ->
  reduce m f (M1 \u M2) = (monoid_oper m) (reduce m f M1) (reduce m f M2).
End Reduce.

(* ---------------------------------------------------------------------- *)
(** ** Structural properties *)

Section Instances.
Variables (A B:Type).

Transparent map empty_inst single_bind_inst binds_inst
 union_inst dom_inst disjoint_inst.

Global Instance map_union_empty_l : Union_empty_l (T:=map A B).
Proof using.
  constructor. intros m. simpl.
  unfold union_impl, empty_impl, map. extens.
  intros x. destruct~ (m x).
Qed.

Global Instance map_union_assoc : Union_assoc (T:=map A B).
Proof using.
  constructor. intros M N P. simpl.
  unfold union_impl, map. extens.
  intros k. destruct~ (P k).
Qed.

End Instances.

(* ---------------------------------------------------------------------- *)
(** ** Properties *)

(* The following lemma is actually not used, because [discriminate] does the
   job. Perhaps this will fail someday if [binds] becomes opaque? *)

(* TODO use an instance *)

Goal
  forall A B a b,
  binds (\{} : map A B) a b ->
  False.
Proof using.
  intros. discriminate. (* ? *)
Qed.


Require Export SystemFR.Judgments.
Require Export SystemFR.ErasedRefl.

Lemma annotated_reducible_refl:
  forall Θ Γ t1 t2,
    [[ Θ; Γ ⊨ t1 ≡ t2 ]] ->
    [[ Θ; Γ ⊨ trefl t1 t2 : T_equiv t1 t2 ]].
Proof.
  unfold open_equivalent;
    repeat step;
    eauto using open_reducible_refl.
Qed.


Require Import mathcomp.ssreflect.ssreflect mathcomp.ssreflect.ssrbool mathcomp.ssreflect.eqtype mathcomp.ssreflect.seq.
Require Import Coquelicot.Coquelicot.
Require Import Reals.Rbase.
Require Import Reals.Rfunctions.
Require Import Reals.R_sqrt.
Require Import Rtrigo_def.
Require Import Rtrigo1.
Require Import Reals.Rtrigo_calc.
Require Import Lra.

Require Import LibUtils.

Set Bullet Behavior "Strict Subproofs".

Lemma sqrt2_neq0 :
  sqrt 2 <> 0.
Proof.
  apply Rgt_not_eq.
  apply Rlt_gt.
  apply Rlt_sqrt2_0.
Qed.

Lemma sqrt_2PI_nzero : sqrt(2*PI) <> 0.
Proof.
  assert (PI > 0) by apply PI_RGT_0.
  apply Rgt_not_eq.
  apply sqrt_lt_R0.
  lra.
Qed.

Lemma sqrt_PI_neq0 : sqrt(PI) <> 0.
Proof.
  assert (PI > 0) by apply PI_RGT_0.
  apply Rgt_not_eq.
  apply sqrt_lt_R0.
  lra.
Qed.

Lemma ex_Rbar_plus_Finite_l x y : ex_Rbar_plus (Finite x) y.
  destruct y; simpl; trivial.
Qed.

Lemma ex_Rbar_plus_Finite_r x y : ex_Rbar_plus x (Finite y).
  destruct x; simpl; trivial.
Qed.

Lemma ex_Rbar_minus_Finite_l x y : ex_Rbar_minus (Finite x) y.
  destruct y; simpl; trivial.
Qed.

Lemma ex_Rbar_minus_Finite_r x y : ex_Rbar_minus x (Finite y).
  destruct x; simpl; trivial.
Qed.

Lemma Rbar_mult_p_infty_pos (z:R) :
  0 < z -> Rbar_mult p_infty z = p_infty.
Proof.
  intros.
  apply is_Rbar_mult_unique.
  apply is_Rbar_mult_p_infty_pos.
  simpl; auto.
Qed.

Lemma Rbar_mult_m_infty_pos (z:R) :
  0 < z -> Rbar_mult m_infty z = m_infty.
Proof.
  intros.
  apply is_Rbar_mult_unique.
  apply is_Rbar_mult_m_infty_pos.
  simpl; auto.
Qed.

Lemma Rbar_mult_p_infty_neg (z:R) :
  0 > z -> Rbar_mult p_infty z = m_infty.
Proof.
  intros.
  apply is_Rbar_mult_unique.
  apply is_Rbar_mult_p_infty_neg.
  simpl; auto.
Qed.

Lemma Rbar_mult_m_infty_neg (z:R) :
  0 > z -> Rbar_mult m_infty z = p_infty.
Proof.
  intros.
  apply is_Rbar_mult_unique.
  apply is_Rbar_mult_m_infty_neg.
  simpl; auto.
Qed.

Lemma Rint_lim_gen_m_infty_p_infty f (l:R) :
  (forall x y, ex_RInt f x y) ->
  filterlim (fun x => RInt f (fst x) (snd x))
            (filter_prod (Rbar_locally' m_infty) (Rbar_locally' p_infty))
            (Rbar_locally l) ->
  is_RInt_gen (V:=R_CompleteNormedModule) f (Rbar_locally m_infty) (Rbar_locally p_infty) l.
Proof.
  intros fex.
  unfold is_RInt_gen.
  unfold filterlimi, filterlim.
  unfold filtermap, filtermapi.
  unfold filter_le; intros.
  simpl in *.
  specialize (H P H0).
  replace (Rbar_locally' m_infty) with (Rbar_locally m_infty)  in * by reflexivity.
  replace (Rbar_locally' p_infty) with (Rbar_locally p_infty)  in * by reflexivity.
  revert H.
  apply filter_prod_ind; intros.
  eapply Filter_prod; eauto.
  intros.
  eexists; split; try eapply H2; eauto.
  apply RInt_correct.
  simpl.
  auto.
Qed.

Lemma lim_rint_gen_Rbar (f : R->R) (a:R) (b:Rbar) (l:R):
  (forall y, ex_RInt f a y) ->
  is_lim (fun x => RInt f a x) b l -> is_RInt_gen f (at_point a) (Rbar_locally' b) l.
Proof.
  intros fex.
  unfold is_lim.
  intros.
  unfold filterlim in H.
  unfold filter_le in H.
  unfold filtermap in H.
  simpl in *.
  intros P Plocal.
  specialize (H P Plocal).
  destruct b.
  - destruct H as [M PltM].
    eexists (fun x => x=a) (fun y => P (RInt f a y)); try easy.
    + simpl.
      unfold locally', within, locally in *.
      eauto.
    + simpl.
      intros.
      subst.
      simpl in *.
      exists (RInt f a y).
      split; trivial.
      now apply (@RInt_correct).
  - destruct H as [M PltM].
    eexists (fun x => x=a) (fun y => _); try easy.
    + simpl.
      eauto.
    + simpl.
      intros.
      subst.
      simpl in *.
      exists (RInt f a y).
      split; trivial.
      now apply (@RInt_correct).
  - destruct H as [M PltM].
    eexists (fun x => x=a) (fun y => _); try easy.
    + simpl.
      eauto.
    + simpl.
      intros.
      subst.
      simpl in *.
      exists (RInt f a y).
      split; trivial.
      now apply (@RInt_correct).
Qed.

Lemma rint_gen_lim_Rbar {f : R->R} {a:R} {b:Rbar} {l:R} :
  is_RInt_gen f (at_point a) (Rbar_locally' b) l -> is_lim (fun x => RInt f a x) b l.
Proof.
  intros H P HP.
  specialize (H _ HP).
  destruct H as [Q R Qa Rb H].
  simpl in H.
  destruct b.
  - destruct Rb as [M Rb].
    exists M.
    intros x xlt xne.
    destruct (H a x Qa (Rb _ xlt xne))
      as [y [yis iP]].
    now rewrite (is_RInt_unique _ _ _ _ yis).
  - destruct Rb as [M Rb].
    exists M.
    intros x xlt.
    destruct (H a x Qa (Rb _ xlt))
      as [y [yis iP]].
    now rewrite (is_RInt_unique _ _ _ _ yis).
  - destruct Rb as [M Rb].
    exists M.
    intros x xlt.
    destruct (H a x Qa (Rb _ xlt))
      as [y [yis iP]].
    now rewrite (is_RInt_unique _ _ _ _ yis).
Qed.

Lemma is_RInt_gen_comp_lin0
  (f : R -> R) (u v : R) (a:R) (b : Rbar) (l : R) :
  u<>0 -> (forall x y, ex_RInt f x y) ->
  is_RInt_gen f (at_point (u * a + v)) (Rbar_locally'  (Rbar_plus (Rbar_mult u b) v)) l
    -> is_RInt_gen (fun y => scal u (f (u * y + v))) (at_point a) (Rbar_locally' b) l.
Proof.
  intros.
  apply lim_rint_gen_Rbar.
  intros.
  now apply (@ex_RInt_comp_lin).
  apply (is_lim_ext (fun x : R => RInt f (u*a+v) (u*x+v))).
  intros.
  now rewrite RInt_comp_lin.
  apply is_lim_comp_lin.
  now apply rint_gen_lim_Rbar.
  trivial.
Qed.

Lemma is_RInt_gen_comp_lin_point_0
  (f : R -> R) (u : R) (a:R) (b : Rbar) (l : R) :
  u<>0 -> (forall x y, ex_RInt f x y) ->
  is_RInt_gen f (at_point (u * a)) (Rbar_locally' (Rbar_mult u b)) l
    -> is_RInt_gen (fun y => scal u (f (u * y))) (at_point a) (Rbar_locally' b) l.
Proof.
  intros.
  apply (is_RInt_gen_ext (fun y => scal u (f (u*y + 0)))).
  apply filter_forall.
  intros.
  now replace (u * x0 + 0) with (u * x0) by lra.
  apply is_RInt_gen_comp_lin0.
  trivial.
  trivial.
  replace (u*a+0) with (u*a) by lra.
  replace (Rbar_plus (Rbar_mult u b) 0) with (Rbar_mult u b).
  trivial.
  now rewrite Rbar_plus_0_r.
Qed.

Lemma RInt_gen_Chasles {Fa Fc : (R -> Prop) -> Prop}
  {FFa : ProperFilter' Fa} {FFc : ProperFilter' Fc}
  (f : R -> R) (b : R):
  ex_RInt_gen f Fa (at_point b) -> ex_RInt_gen f (at_point b) Fc ->
  plus (RInt_gen f Fa (at_point b)) (RInt_gen f (at_point b) Fc) = RInt_gen f Fa Fc.
Proof.
  intros.
  apply sym_eq.
  apply (@is_RInt_gen_unique).
  trivial.
  trivial.
  apply (@is_RInt_gen_Chasles) with (b:=b).
  apply filter_filter'.
  apply filter_filter'.
  now apply RInt_gen_correct.
  now apply RInt_gen_correct.
Qed.

Lemma is_RInt_gen_comp_lin
  (f : R -> R) (u v : R) (a b : Rbar) (ll : R) :
  u<>0 -> ex_RInt_gen f (Rbar_locally' (Rbar_plus (Rbar_mult u a) v)) (at_point (u*0+v)) ->
  ex_RInt_gen f (at_point (u*0+v)) (Rbar_locally' (Rbar_plus (Rbar_mult u b) v)) ->
  (forall (x y :R), ex_RInt f x y) ->
  is_RInt_gen f (Rbar_locally'  (Rbar_plus (Rbar_mult u a) v)) (Rbar_locally'  (Rbar_plus (Rbar_mult u b) v)) ll
  -> is_RInt_gen (fun y => scal u (f (u * y + v))) (Rbar_locally' a) (Rbar_locally' b) ll.
Proof.
  intros.
  replace (ll) with (plus (RInt_gen f (Rbar_locally' (Rbar_plus (Rbar_mult u a) v))  (at_point (u*0+v)))
                         (RInt_gen f (at_point (u*0+v)) (Rbar_locally' (Rbar_plus (Rbar_mult u b) v)))).
  apply (@is_RInt_gen_Chasles R_CompleteNormedModule) with (b := 0)
        (l1 := (RInt_gen f (Rbar_locally' (Rbar_plus (Rbar_mult u a) v))  (at_point (u*0+v))))
        (l2 := (RInt_gen f (at_point (u*0+v)) (Rbar_locally' (Rbar_plus (Rbar_mult u b) v)))).
  apply Rbar_locally'_filter.
  apply Rbar_locally'_filter.
  replace (RInt_gen f (Rbar_locally' (Rbar_plus (Rbar_mult u a) v)) (at_point (u * 0 + v))) with
      (opp (opp (RInt_gen f (Rbar_locally' (Rbar_plus (Rbar_mult u a) v)) (at_point (u * 0 + v))))).
  apply (@is_RInt_gen_swap R_CompleteNormedModule) with
      (l := (opp (RInt_gen f (Rbar_locally' (Rbar_plus (Rbar_mult u a) v)) (at_point (u * 0 + v))))).
  apply Rbar_locally'_filter.
  apply at_point_filter.
  apply is_RInt_gen_comp_lin0; trivial.
  apply (@is_RInt_gen_swap R_CompleteNormedModule) with
      (l := (RInt_gen f (Rbar_locally' (Rbar_plus (Rbar_mult u a) v)) (at_point (u * 0 + v)))).
  apply at_point_filter.
  apply Rbar_locally'_filter.
  apply RInt_gen_correct.
  trivial.
  now rewrite opp_opp.
  apply is_RInt_gen_comp_lin0; trivial.
  apply (@RInt_gen_correct).
  apply Proper_StrongProper.
  apply at_point_filter.
  apply Proper_StrongProper.
  apply Rbar_locally'_filter.
  trivial.
  rewrite RInt_gen_Chasles.
  now apply is_RInt_gen_unique.
  trivial.
  trivial.
Qed.

Require Import Sets.Ensembles.

Lemma lub_not_contains (S1  S2 : Ensemble R) (L1 L2:R) :
  (is_lub S1 L1) /\ (is_upper_bound S2 L2) -> L1 > L2 -> ~ Included R S1 S2.
Proof.
  unfold is_lub, is_upper_bound, Included, In.
  intros.
  assert (~ (L1 <= L2)) by lra.
  intuition.
Qed.

(* this lemma needs Classical results, i.e. exluded middle *)
Lemma not_included (S1  S2 : Ensemble R) :
  ~ Included R S1 S2 -> exists x:R, In R S1 x /\ ~ In R S2 x.
Proof.
  unfold Included.
  intros.
  apply Classical_Pred_Type.not_all_ex_not in H.
  destruct H.
  exists x.
  now apply Classical_Prop.imply_to_and in H.
Qed.

Lemma lub_witness (S1 : Ensemble R) (L1 L2:R) :
  let S2 :Ensemble R := (fun x:R => In R S1 x /\ x <= L2) in
  (is_lub S1 L1) -> L1 > L2 -> exists x:R, In R S1 x /\ x > L2.
Proof.
  intros.
  assert (exists x:R, In R S1 x /\ ~In R S2 x).
  - apply not_included.
    apply lub_not_contains with (L1 := L1) (L2 := L2).
    + split; trivial.
      unfold is_upper_bound, S2.
      intros.
      now destruct H1.
    + trivial.
  - destruct H1.
    exists x.
    destruct H1.
    split; trivial.
    unfold S2, In in H2.
    intuition.
Qed.

Lemma increasing_bounded_limit (M:R) (f: R->R):
  Ranalysis1.increasing f ->
  (forall x:R, f x <= M) -> ex_finite_lim f p_infty.
Proof.
  unfold Ranalysis1.increasing.
  intros.
  unfold ex_finite_lim.
  assert { m:R | is_lub (fun y : R => (exists x:R, y = f x)) m }.
  - apply completeness.
    + unfold bound.
      exists M.
      unfold is_upper_bound.
      intros.
      destruct H1.
      now subst.
    + exists (f 0); now exists (0).
  - destruct H1 as [L HH].
    exists L.
    rewrite <- is_lim_spec.
    unfold is_lim'.
    intros.
    unfold Rbar_locally'.
    unfold is_lub in HH.
    destruct HH.
    (* since L-eps is not an upper bound, there exists (f x0) > L-eps *)
    assert (exists y0, (exists x0, y0 = f x0) /\ y0 > L-eps).
    + apply lub_witness with (L1 := L) (L2 := L-eps).
      * unfold is_lub.
        split; trivial.
      * apply Rminus_gt.
        replace (L - (L - (pos eps))) with (pos eps) by lra.
        apply eps.
    + destruct H3.
      destruct H3.
      destruct H3.
      exists x0.
      intros.
      replace (f x1 - L) with (- (L - f x1)) by lra.
      rewrite (Rabs_Ropp).
      rewrite Rabs_pos_eq.
      * assert (f x0 <= f x1).
        -- apply H.
           now left.
        -- lra.
      * unfold is_upper_bound in H1.
        apply Rge_le.
        apply Rge_minus.
        apply Rle_ge.
        apply H1.
        now exists x1.
Qed.

Lemma ex_lim_rint_gen_Rbar (f : R->R) (a:R) (b:Rbar):
  (forall y, ex_RInt f a y) ->
  ex_finite_lim (fun x => RInt f a x) b -> ex_RInt_gen f (at_point a) (Rbar_locally' b).
Proof.
  intros.
  unfold ex_RInt_gen.
  unfold ex_finite_lim in H0.
  destruct H0.
  exists (x).
  apply lim_rint_gen_Rbar; trivial.
Qed.

Lemma ex_RInt_gen_bounded (M:R) (f : R -> R) (a:R) :
  (forall (b:R), f b >= 0) ->
  (forall (b:R), ex_RInt f a b) ->
  (forall (b:R), RInt f a b <= M) -> ex_RInt_gen f (at_point a) (Rbar_locally' p_infty).
Proof.
  intros.
  assert ( Ranalysis1.increasing (fun z => RInt f a z)).
  - intros.
    unfold Ranalysis1.increasing.
    intros.
    replace (RInt f a x) with (plus (RInt f a x) 0).
    + rewrite <- RInt_Chasles with (b:=x) (c:=y).
      * apply Rplus_le_compat_l.
        apply RInt_ge_0; trivial.
        -- apply ex_RInt_Chasles with (b := a).
           ++ apply ex_RInt_swap.
              trivial.
           ++ trivial.
        -- intros.
           apply Rge_le.
           apply H.
      * trivial.
      * apply ex_RInt_Chasles with (b := a).
        -- apply ex_RInt_swap.
           trivial.
        -- trivial.
    + apply Rplus_0_r.
  - apply ex_lim_rint_gen_Rbar.
    trivial.
    apply increasing_bounded_limit with (M:=M).
    trivial.
    trivial.
Qed.

Hint Resolve sqrt2_neq0 sqrt_PI_neq0 sqrt_2PI_nzero : Rarith.


Require Import freefresh.

Section Eval.
Variable X: Type.

Fixpoint eval (m: Free Fresh X): nat -> X * nat :=
  match m with
  | ret v => fun n => (v, n)
  | op (gensymOp _) k => fun n => eval (k n) (1 + n)
  end.

Definition run (m: Free Fresh X): X := fst (eval m 0).

End Eval.

Arguments eval [_] m.
Arguments run [_] m.

Require Import tree.

Section Relabel.

Variable X: Type.

Definition relabel (t: Tree X): Tree nat := run (label t).

End Relabel.

Arguments relabel [_] t.


Require Import Autosubst.Autosubst.
Require Import Arith List Program.
Require VarSet Types Term Constraint.

Lemma Forall_app : forall X (P : X -> Prop) l l',
  Forall P (l ++ l') -> Forall P l /\ Forall P l'.
Proof.
  intros ? ? l ? H.
  induction l; simpl in *.
  + eauto.
  + inversion H; subst.
    destruct (IHl H3).
    eauto.
Qed.

Inductive typed : (var -> option Types.t) -> Term.t -> Types.t -> Prop :=
  | T_Var env x t :
      env x = Some t ->
      typed env (Term.Var x) t
  | T_Abs env e t1 t2 :
      typed (Some t1 .: env) e t2 ->
      typed env (Term.Abs t1 e) (Types.Fun t1 t2)
  | T_App env e1 e2 t1 t2 :
      typed env e1 (Types.Fun t1 t2) ->
      typed env e2 t1 ->
      typed env (Term.App e1 e2) t2.
Hint Constructors typed.

Lemma typed_weakening env t T :
  typed env t T ->
  forall env',
  (forall x T, env x = Some T -> env' x = Some T) ->
  typed env' t T.
Proof.
  induction 1; intros ? Henv; econstructor; eauto.
  - apply IHtyped.
    intros [| ?] ? Heq.
    + inversion Heq.
      reflexivity.
    + apply Henv.
      apply Heq.
Qed.

Lemma typed_rename env t T :
  typed env t T ->
  forall r env',
  (forall x, env' (r x) = env x) ->
  typed env' (rename r t) T.
Proof.
  induction 1; intros ? ? Henv; simpl; econstructor; eauto.
  - congruence.
  - apply IHtyped.
    intros [| ?].
    + reflexivity.
    + apply Henv.
Qed.

Lemma typed_subst env t T :
  typed env t T ->
  forall s env',
  (forall x T, env x = Some T -> typed env' (s x) T) ->
  typed env' (t.[s]) T.
Proof.
  induction 1; intros ? ? Henv; simpl; eauto.
  - constructor.
    apply IHtyped.
    intros [| ?] ? Heq.
    + constructor.
      apply Heq.
    + inversion Heq.
      eapply typed_rename; eauto.
Qed.


Require Import
  CMorphisms
  FormTopC.FormTop
  Algebra.OrderC
  Algebra.SetsC
  Algebra.PreOrder
  FormTopC.FormalSpace.

Local Open Scope Subset.

(** An inductively generated formal topology for the Cantor space.
    See Section 4.1 of [1]. *)
Section Cantor.

Variable A : Type.

Require Import Coq.Lists.List.
Import ListNotations.

Inductive C {s : list A} {i : True} {s' : list A} : Type :=
  | CSplit : forall b, s' = s ++ [b] -> C.

Arguments C : clear implicits.

Inductive LE {xs ys : list A} : Type :=
  | IsLE : forall zs, xs = ys ++ zs -> LE.
Arguments LE : clear implicits.

Definition CantorPO : PreOrder :=
  {| PO_car := list A
  ; le := LE |}.

Local Instance LE_PO : @PO.t (list A) LE eq.
Proof.
constructor; intros.
- constructor; intros.
  + exists nil. rewrite app_nil_r. reflexivity.
  + destruct X, X0.
    exists (zs0 ++ zs). rewrite e, e0.
    rewrite app_assoc. reflexivity.
- unfold Proper, respectful.
  intros. subst. reflexivity.
- destruct X, X0.
  rewrite e0 in e. rewrite <- app_assoc in e.
  rewrite <- app_nil_r in e at 1.
  apply app_inv_head in e.
  symmetry in e. apply app_eq_nil in e.
  destruct e. subst. rewrite app_nil_r.
  reflexivity.
Defined.

Definition PreCantor : PreISpace.t :=
  {| PreISpace.S := CantorPO
   ; PreISpace.C := C |}.

Local Instance loc : FormTop.localized PreCantor.
Proof.
unfold FormTop.localized.
intros a c H i. simpl in *. destruct i. exists I.
intros s H0. destruct H0.
simpl in H. destruct H. destruct zs.
- subst. rewrite !app_nil_r.
  split. exists c. reflexivity.
  simpl. econstructor. reflexivity.
  exists (c ++ [b]). econstructor. reflexivity.
  reflexivity.
- subst. split. eexists. reflexivity.
  simpl. rewrite <- app_assoc. eexists.
  rewrite <- app_assoc. reflexivity.
  rewrite <- app_assoc. simpl.
  econstructor. exists a0. reflexivity.
  econstructor. rewrite <- app_assoc. simpl.
  reflexivity.
Qed.

Hypothesis inhabited : A.

(* This actually needs 'A' to be inhabited. *)
Local Instance pos : FormTop.gtPos PreCantor.
Proof.
apply gall_Pos.
intros. destruct X. subst.
induction zs.
- exists (b ++ [inhabited]).
  split. econstructor. reflexivity.
  rewrite app_nil_r. econstructor. reflexivity.
  econstructor. Focus 2. reflexivity.
  econstructor. reflexivity.
- econstructor.
Admitted.

Definition Cantor : IGt :=
  {| IGS := PreCantor
  |}.

End Cantor.


Require Import Coq.Logic.ProofIrrelevance.
Require Import Coq.Sets.Ensembles.
Require Import Coq.Sets.Finite_sets.
Require Import Coq.Classes.Morphisms.
Require Import RamifyCoq.lib.Coqlib.
Require Import RamifyCoq.lib.Ensembles_ext.
Require Import RamifyCoq.lib.relation_list.
Require Import RamifyCoq.lib.List_ext.
Require Import RamifyCoq.lib.Equivalence_ext.
Require Import RamifyCoq.lib.EquivDec_ext.
Require Import VST.msl.Coqlib2.
Require Import Coq.Lists.List.
Require Import RamifyCoq.graph.graph_model.
Require Import RamifyCoq.graph.path_lemmas.
Require Import RamifyCoq.graph.reachable_ind.

Section AUXILIARY_COMPONENT_CONSTR.

Context {V E: Type}.
Context {EV: EqDec V eq}.
Context {EE: EqDec E eq}.
Context {DV DE DG: Type}.

(******************)
(* Definitions    *)
(******************)

(* TODO: Maybe redefine these three using respectful_set. *)
(* TODO: rename them into edge_prop_11/10/01. *)
Definition strong_edge_prop (P: V -> Prop) (g: PreGraph V E): E -> Prop := fun e => P (src g e) /\ P (dst g e).

Definition weak_edge_prop (P: V -> Prop) (g: PreGraph V E): E -> Prop := fun e => P (src g e).

Definition weak'_edge_prop (P: V -> Prop) (g: PreGraph V E): E -> Prop := fun e => P (dst g e).

Instance weak_edge_prop_proper: Proper (Same_set ==> eq ==> Same_set) weak_edge_prop.
Proof.
  do 2 (hnf; intros); subst.
  rewrite Same_set_spec in *.
  intro e; unfold weak_edge_prop.
  auto.
Defined.
Global Existing Instance weak_edge_prop_proper.

Definition predicate_vvalid (g: PreGraph V E) (p: V -> Prop): Ensemble V :=
  fun n => vvalid g n /\ p n.

Definition predicate_evalid (g: PreGraph V E) (p: V -> Prop): Ensemble E :=
  fun e => evalid g e /\ p (src g e) /\ p (dst g e).

Definition predicate_weak_evalid (g: PreGraph V E) (p: V -> Prop): Ensemble E :=
  fun e => evalid g e /\ p (src g e).

Definition addValidFunc {T: Type} (v: T) (validFunc: Ensemble T) : Ensemble T :=
  fun n => validFunc n \/ n = v.

Definition removeValidFunc {T: Type} (v: T) (validFunc: Ensemble T) : Ensemble T :=
  fun n => validFunc n /\ n <> v.

Definition update_vlabel (vlabel: V -> DV) (x: V) (d: DV) :=
  fun v => if equiv_dec x v then d else vlabel v.

Definition update_elabel (elabel: E -> DE) (e0: E) (d: DE) :=
  fun e => if equiv_dec e0 e then d else elabel e.

Definition updateEdgeFunc (edgeFunc: E -> V) (e: E) (v: V) :
  E -> V := fun n => if equiv_dec e n then v else edgeFunc n.

(******************)
(* Properties     *)
(******************)

Lemma updateEdgeFunc_eq: forall edgeFunc e v, updateEdgeFunc edgeFunc e v e = v.
Proof.
  intros. unfold updateEdgeFunc. destruct_eq_dec e e; auto. exfalso; now apply H.
Qed.

Lemma updateEdgeFunc_neq: forall edgeFunc e v e',
    e <> e' -> updateEdgeFunc edgeFunc e v e' = edgeFunc e'.
Proof. intros. unfold updateEdgeFunc. destruct_eq_dec e e'; auto. easy. Qed.

Lemma weak_edge_prop_si: forall (P: V -> Prop) (g1 g2: PreGraph V E),
  g1 ~=~ g2 ->
  Same_set
   (Intersection _ (weak_edge_prop P g1) (evalid g1))
   (Intersection _ (weak_edge_prop P g2) (evalid g2)).
Proof.
  intros.
  rewrite Same_set_spec; intro e.
  rewrite !Intersection_spec.
  unfold weak_edge_prop.
  pose proof (proj1 (proj2 H) e).
  pose proof proj1 (proj2 (proj2 H)) e.
  split; intros [? ?]; do 2 (spec H1; [tauto |]); (split; [congruence | tauto]).
Qed.

Lemma weak_edge_prop_Empty: forall g, Same_set (weak_edge_prop (Empty_set _) g) (Empty_set _).
Proof.
  intros.
  unfold weak_edge_prop.
  rewrite Same_set_spec; intros x.
  rewrite !Empty_set_spec; reflexivity.
Qed.

Lemma weak_edge_prop_Disjoint: forall (P1 P2: V -> Prop) (g: PreGraph V E),
  Disjoint _ P1 P2 ->
  Disjoint _ (weak_edge_prop P1 g) (weak_edge_prop P2 g).
Proof.
  intros.
  unfold weak_edge_prop.
  rewrite Disjoint_spec in *.
  firstorder.
Qed.

Lemma weak_edge_prop_Complement: forall (P: V -> Prop) (g: PreGraph V E), Same_set (weak_edge_prop (Complement _ P) g) (Complement _ (weak_edge_prop P g)).
Proof.
  intros.
  unfold weak_edge_prop, Complement, Ensembles.In.
  rewrite Same_set_spec.
  hnf; intros; simpl.
  reflexivity.
Qed.

Lemma weak_edge_prop_Union: forall (P Q: V -> Prop) (g: PreGraph V E), Same_set (weak_edge_prop (Union _ P Q) g) (Union _ (weak_edge_prop P g) (weak_edge_prop Q g)).
Proof.
  intros.
  unfold weak_edge_prop.
  rewrite Same_set_spec; intros ?; rewrite !Union_spec.
  simpl.
  reflexivity.
Qed.

Lemma weak_edge_prop_Decidable: forall (P: V -> Prop) (g: PreGraph V E),
  (forall v, Decidable (P v)) ->
  (forall e, Decidable (weak_edge_prop P g e)).
Proof.
  intros.
  unfold weak_edge_prop.
  apply X.
Qed.

End AUXILIARY_COMPONENT_CONSTR.

Section PREGRAPH_GEN.

Context {V E: Type}.
Context {EV: EqDec V eq}.
Context {EE: EqDec E eq}.

Notation Graph := (PreGraph V E).

Definition empty_pregraph (src0 dst0: E -> V): Graph :=
  @Build_PreGraph V E EV EE (fun v => False) (fun e => False) src0 dst0.

Definition single_vertex_pregraph (v0: V): Graph :=
  @Build_PreGraph V E EV EE (eq v0) (fun e => False) (fun e => v0) (fun e => v0).

Definition pregraph_add_vertex (g: Graph) (v: V) : Graph :=
  @Build_PreGraph V E EV EE (addValidFunc v (vvalid g)) (evalid g) (src g) (dst g).

Lemma addVertex_preserve_vvalid: forall g v v', vvalid g v -> vvalid (pregraph_add_vertex g v') v. Proof. intros; hnf; left; auto. Qed.

Lemma addVertex_add_vvalid: forall g v, vvalid (pregraph_add_vertex g v) v. Proof. intros. hnf. right; auto. Qed.

Lemma addVertex_preserve_evalid: forall g e v, evalid g e -> evalid (pregraph_add_vertex g v) e. Proof. intros; simpl; auto. Qed.

Definition pregraph_add_edge (g : Graph) (e : E) (o t : V) :=
  @Build_PreGraph V E EV EE (vvalid g) (addValidFunc e (evalid g)) (updateEdgeFunc (src g) e o) (updateEdgeFunc (dst g) e t).

Definition pregraph_add_whole_edge (g: Graph) (e: E) (s t: V) : Graph :=
  Build_PreGraph _ _ (addValidFunc t (vvalid g)) (addValidFunc e (evalid g)) (updateEdgeFunc (src g) e s) (updateEdgeFunc (dst g) e t).

Lemma addEdge_preserve_vvalid: forall g v e s t, vvalid g v -> vvalid (pregraph_add_whole_edge g e s t) v. Proof. intros. hnf; left; auto. Qed.

Lemma addEdge_preserve_evalid: forall g e e' s t, evalid g e -> evalid (pregraph_add_whole_edge g e' s t) e. Proof. intros. hnf; left; auto. Qed.

Lemma addEdge_add_vvalid: forall g e s t, vvalid (pregraph_add_whole_edge g e s t) t. Proof. intros. hnf. right; auto. Qed.

Lemma addEdge_add_evalid: forall g e s t, evalid (pregraph_add_whole_edge g e s t) e. Proof. intros. hnf. right; auto. Qed.

Lemma addEdge_src_iff: forall g e s t e' x, src (pregraph_add_whole_edge g e s t) e' = x <-> ((e <> e' /\ src g e' = x) \/ (e = e' /\ s = x)).
Proof. intros. simpl. unfold updateEdgeFunc. destruct (equiv_dec e e'); intuition. Qed.

Lemma addEdge_dst_iff: forall g e s t e' x, dst (pregraph_add_whole_edge g e s t) e' = x <-> ((e <> e' /\ dst g e' = x) \/ (e = e' /\ t = x)).
Proof. intros. simpl. unfold updateEdgeFunc. destruct (equiv_dec e e'); intuition. Qed.

Definition pregraph_remove_vertex (g: Graph) (v: V) : Graph :=
  @Build_PreGraph V E EV EE (removeValidFunc v (vvalid g)) (evalid g) (src g) (dst g).

Lemma remove_vertex_vvalid: forall g v v',
    vvalid (pregraph_remove_vertex g v') v <-> vvalid g v /\ v <> v'.
Proof. intros. unfold pregraph_remove_vertex, removeValidFunc. simpl. reflexivity. Qed.

Definition pregraph_remove_edge (g: Graph) (e: E): Graph :=
  @Build_PreGraph V E EV EE (vvalid g) (removeValidFunc e (evalid g)) (src g) (dst g).

Lemma remove_edge_evalid: forall g e e',
    evalid (pregraph_remove_edge g e') e <-> evalid g e /\ e <> e'.
Proof. intros. unfold pregraph_remove_edge, removeValidFunc. simpl. reflexivity. Qed.

Definition pregraph_gen_dst (g : Graph) (e : E) (t : V) :=
  @Build_PreGraph V E EV EE (vvalid g) (evalid g) (src g) (updateEdgeFunc (dst g) e t).

Definition union_pregraph (PV : V -> Prop) (PE: E -> Prop) (PVD: forall v, Decidable (PV v)) (PED: forall e, Decidable (PE e)) (g1 g2: Graph): Graph :=
  @Build_PreGraph V E EV EE
    (fun v => if PVD v then vvalid g1 v else vvalid g2 v)
    (fun e => if PED e then evalid g1 e else evalid g2 e)
    (fun e => if PED e then src g1 e else src g2 e)
    (fun e => if PED e then dst g1 e else dst g2 e).

(* TODO: rename them into sub_pregraph, v11_sub_pregraph, v10_sub_pregraph *)
Definition gpredicate_subgraph (PV: V -> Prop) (PE: E -> Prop) (g: Graph): Graph :=
  Build_PreGraph EV EE (Intersection _ (vvalid g) PV) (Intersection _ (evalid g) PE) (src g) (dst g).

Definition predicate_subgraph (g: Graph) (p: V -> Prop): Graph :=
  Build_PreGraph EV EE (predicate_vvalid g p) (predicate_evalid g p) (src g) (dst g).

Definition predicate_partialgraph (g: Graph) (p: V -> Prop): Graph :=
  Build_PreGraph EV EE (predicate_vvalid g p) (predicate_weak_evalid g p) (src g) (dst g).

Instance subgraph_proper: Proper (structurally_identical ==> @Same_set V ==> structurally_identical) predicate_subgraph.
Proof.
  do 2 (hnf; intros).
  destruct H as [? [? [? ?]]].
  rewrite Same_set_spec in H0; hnf in H0.
  split; [| split; [| split]]; intros; simpl.
  + unfold predicate_vvalid.
    rewrite H0, H.
    reflexivity.
  + unfold predicate_evalid. rewrite !H0, !H1. specialize (H1 e).
    split; intros; destruct H4 as [? [? ?]]; [rewrite <- H2, <- H3 | rewrite H2, H3]; tauto.
  + simpl in * |- . unfold predicate_evalid in * |- . apply H2; tauto.
  + simpl in * |- . unfold predicate_evalid in * |- . apply H3; tauto.
Defined.

Global Existing Instance subgraph_proper.

Instance partialgraph_proper: Proper (structurally_identical ==> @Same_set V ==> structurally_identical) predicate_partialgraph.
Proof.
  do 2 (hnf; intros).
  destruct H as [? [? [? ?]]].
  rewrite Same_set_spec in H0; hnf in H0.
  split; [| split; [| split]]; intros; simpl.
  + unfold predicate_vvalid.
    rewrite H0, H.
    reflexivity.
  + unfold predicate_weak_evalid. rewrite !H0, !H1. specialize (H1 e).
    split; intro; intuition; [rewrite <- H2 | rewrite H2]; auto.
  + simpl in * |- . unfold predicate_weak_evalid in * |- . apply H2; tauto.
  + simpl in * |- . unfold predicate_weak_evalid in * |- . apply H3; tauto.
Defined.

Global Existing Instance partialgraph_proper.

Instance gpredicate_subgraph_proper: Proper (@Same_set V ==> @Same_set E ==> structurally_identical ==> structurally_identical) gpredicate_subgraph.
Proof.
  do 3 (hnf; intros).
  destruct H1 as [? [? [? ?]]].
  rewrite Same_set_spec in H, H0; hnf in H, H0.
  split; [| split; [| split]]; intros; simpl.
  + rewrite !Intersection_spec.
    rewrite H1, H.
    reflexivity.
  + rewrite !Intersection_spec.
    rewrite H2, H0.
    reflexivity.
  + simpl in H5, H6.
    rewrite Intersection_spec in *.
    apply H3; tauto.
  + simpl in H5, H6.
    rewrite Intersection_spec in *.
    apply H4; tauto.
Defined.

Global Existing Instance gpredicate_subgraph_proper.

Lemma predicate_partialgraph_gpredicate_subgraph (g: Graph) (p: V -> Prop):
  (predicate_partialgraph g p) ~=~ (gpredicate_subgraph p (Intersection _ (weak_edge_prop p g) (evalid g)) g).
Proof.
  split; [| split; [| split]]; simpl; intros.
  + rewrite Intersection_spec.
    reflexivity.
  + rewrite !Intersection_spec.
    unfold predicate_weak_evalid.
    unfold weak_edge_prop.
    tauto.
  + auto.
  + auto.
Qed.

Lemma partial_partialgraph: forall p1 p2 (g: Graph),
  (predicate_partialgraph (predicate_partialgraph g p1) p2) ~=~
  (predicate_partialgraph g (Intersection _ p1 p2)).
Proof.
  intros.
  split; [| split; [| split]]; simpl; intros.
  + unfold predicate_vvalid; simpl; unfold predicate_vvalid.
    rewrite Intersection_spec.
    tauto.
  + unfold predicate_weak_evalid; simpl.
    unfold predicate_weak_evalid.
    rewrite Intersection_spec.
    tauto.
  + reflexivity.
  + reflexivity.
Qed.

Lemma si_stronger_partialgraph: forall (g1 g2: PreGraph V E) (p1 p2 p1' p2' p: V -> Prop),
  (forall v, p1' v <-> p1 v /\ p v) ->
  (forall v, p2' v <-> p2 v /\ p v) ->
  (predicate_partialgraph g1 p1) ~=~ (predicate_partialgraph g2 p2) ->
  (predicate_partialgraph g1 p1') ~=~ (predicate_partialgraph g2 p2').
Proof.
  intros.
  destruct H1 as [? [? [? ?]]].
  split; [| split; [| split]].
  + intro v; specialize (H1 v); specialize (H0 v); specialize (H v);
    simpl in H1 |- *.
    unfold predicate_vvalid in H1 |- *.
    tauto.
  + intro e; specialize (H2 e); specialize (H3 e); specialize (H (src g1 e)); specialize (H0 (src g2 e));
    simpl in H2, H3 |- *.
    unfold predicate_weak_evalid in H2, H3 |- *. clear H4. split; intros; destruct H4.
    - rewrite H in H5. destruct H5. assert (evalid g1 e /\ p1 (src g1 e)) by auto.
      specialize (H3 H7). rewrite H2 in H7. specialize (H3 H7). rewrite <- H3 in *. tauto.
    - rewrite H0 in H5. destruct H5. assert (evalid g2 e /\ p2 (src g2 e)) by auto.
      assert (evalid g1 e /\ p1 (src g1 e)) by tauto. specialize (H3 H8 H7).
      rewrite H3 in *. rewrite H. tauto.
  + simpl in *. unfold predicate_weak_evalid in *. intros.
    rewrite H in H5. rewrite H0 in H6. apply H3; tauto.
  + simpl in *. unfold predicate_weak_evalid in *. intros.
    rewrite H in H5. rewrite H0 in H6. apply H4; tauto.
Qed.

Lemma si_stronger_partialgraph': forall (g1 g2: PreGraph V E) (p1 p2 p1' p2' p: V -> Prop),
  Same_set p1' (Intersection _ p1 p) ->
  Same_set p2' (Intersection _ p2 p) ->
  (predicate_partialgraph g1 p1) ~=~ (predicate_partialgraph g2 p2) ->
  (predicate_partialgraph g1 p1') ~=~ (predicate_partialgraph g2 p2').
Proof.
  intros.
  apply si_stronger_partialgraph with (p := p) (p1 := p1) (p2 := p2); auto.
  - intros.
    rewrite Same_set_spec in H; specialize (H v).
    rewrite Intersection_spec in H; auto.
  - intros.
    rewrite Same_set_spec in H0; specialize (H0 v).
    rewrite Intersection_spec in H0; auto.
Qed.

Lemma si_stronger_partialgraph_simple: forall (g1 g2: PreGraph V E) (p p': V -> Prop),
  Included p' p ->
  (predicate_partialgraph g1 p) ~=~ (predicate_partialgraph g2 p) ->
  (predicate_partialgraph g1 p') ~=~ (predicate_partialgraph g2 p').
Proof.
  intros.
  eapply si_stronger_partialgraph with (p := p'); [| | exact H0].
  + intro v; specialize (H v); simpl in H; tauto.
  + intro v; specialize (H v); simpl in H; tauto.
Qed.

Lemma si_partialgraph_stronger_trans: forall (g1 g g2: PreGraph V E) (P1 P2 P: V -> Prop),
  Included P P1 ->
  Included P P2 ->
  (predicate_partialgraph g1 P1) ~=~ (predicate_partialgraph g P1) ->
  (predicate_partialgraph g P2) ~=~ (predicate_partialgraph g2 P2) ->
  (predicate_partialgraph g1 P) ~=~ (predicate_partialgraph g2 P).
Proof.
  intros.
  transitivity (predicate_partialgraph g P).
  + apply si_stronger_partialgraph_simple with P1; auto.
  + apply si_stronger_partialgraph_simple with P2; auto.
Qed.

Lemma sub_subgraph: forall p1 p2 (g: Graph),
  (predicate_subgraph (predicate_subgraph g p1) p2) ~=~
  (predicate_subgraph g (Intersection _ p1 p2)).
Proof.
  intros.
  split; [| split; [| split]]; simpl; intros.
  + unfold predicate_vvalid; simpl; unfold predicate_vvalid.
    rewrite Intersection_spec.
    tauto.
  + unfold predicate_evalid; simpl; unfold predicate_evalid; simpl.
    rewrite !Intersection_spec.
    tauto.
  + reflexivity.
  + reflexivity.
Qed.

Lemma subgraph_step: forall (g: Graph) (p: V -> Prop) x y,
  step g x y -> p x -> p y -> step (predicate_subgraph g p) x y.
Proof.
  intros.
  rewrite step_spec in H |- *.
  destruct H as [e [? [? ?]]].
  exists e.
  split; [| split; simpl; auto].
  simpl.
  unfold predicate_evalid.
  rewrite H2, H3.
  auto.
Qed.

Lemma subgraph_edge: forall (g: Graph) (p: V -> Prop) x y,
    edge g x y -> p x -> p y -> edge (predicate_subgraph g p) x y.
Proof.
  intros.
  destruct H as [? [? ?]].
  unfold edge.
  simpl.
  unfold predicate_vvalid.
  do 2 (split; [tauto |]).
  apply subgraph_step; auto.
Qed.

Lemma partialgraph_step: forall (g: Graph) (p: V -> Prop) x y,
  step g x y -> p x -> step (predicate_partialgraph g p) x y.
Proof.
  intros.
  rewrite step_spec in H |- *.
  destruct H as [e [? [? ?]]].
  exists e.
  split; [| split; simpl; auto].
  simpl.
  unfold predicate_weak_evalid.
  rewrite H1.
  auto.
Qed.

Lemma partialgraph_edge: forall (g: Graph) (p: V -> Prop) x y,
    edge g x y -> p x -> p y -> edge (predicate_partialgraph g p) x y.
Proof.
  intros.
  destruct H as [? [? ?]].
  unfold edge.
  simpl.
  unfold predicate_vvalid.
  do 2 (split; [tauto |]).
  apply partialgraph_step; auto.
Qed.

Lemma subgraph_step_iff: forall (g: Graph) (p: V -> Prop) x y,
  (step g x y /\ p x /\ p y) <-> step (predicate_subgraph g p) x y.
Proof.
  intros.
  split; [intros [? [? ?]]; apply subgraph_step; auto |].
  rewrite !step_spec.
  intros [e [? [? ?]]]; simpl in *.
  destruct H as [? [? ?]].
  subst.
  split; [| split]; auto.
  exists e.
  split; [| split]; auto.
Qed.

Lemma subgraph_edge_iff: forall (g: Graph) (p: V -> Prop) x y,
  (edge g x y /\ p x /\ p y) <-> edge (predicate_subgraph g p) x y.
Proof.
  intros.
  unfold edge.
  rewrite <- subgraph_step_iff.
  simpl.
  unfold predicate_vvalid.
  tauto.
Qed.

Lemma partialgraph_step_iff: forall (g: Graph) (p: V -> Prop) x y,
  (step g x y /\ p x) <-> step (predicate_partialgraph g p) x y.
Proof.
  intros.
  split; [intros [? ?]; apply partialgraph_step; auto |].
  rewrite !step_spec.
  intros [e [? [? ?]]]; simpl in *.
  destruct H as [? ?].
  subst.
  split; auto.
  exists e.
  split; [| split]; auto.
Qed.

Lemma partialgraph_edge_iff: forall (g: Graph) (p: V -> Prop) x y,
  (edge g x y /\ p x /\ p y) <-> edge (predicate_partialgraph g p) x y.
Proof.
  intros.
  unfold edge.
  rewrite <- partialgraph_step_iff.
  simpl.
  unfold predicate_vvalid.
  tauto.
Qed.

Lemma step_list_partialgraph: forall  (g: PreGraph V E) n l (P: Ensemble V),
  vvalid g n ->
  P n ->
  step_list g n l ->
  step_list (predicate_partialgraph g P) n l.
Proof.
  intros.
  intro m; specialize (H1 m).
  rewrite H1; clear H1.
  split.
  + intros; apply partialgraph_step; auto.
  + intro.
    inv H1; simpl in *.
    econstructor.
    - destruct H2; eauto.
    - reflexivity.
    - reflexivity.
Qed.

Lemma partialgraph_si_node_prop: forall n (g1 g2: PreGraph V E) p1 p2,
  (predicate_partialgraph g1 p1) ~=~ (predicate_partialgraph g2 p2) ->
  Included p1 (vvalid g1) ->
  Included p2 (vvalid g2) ->
  (p1 n <-> p2 n).
Proof.
  intros.
  destruct H as [? _].
  specialize (H n).
  specialize (H0 n).
  specialize (H1 n).
  simpl in *.
  unfold predicate_vvalid in H.
  tauto.
Qed.

Lemma subgraph_node_prop: forall n (g1 g2: PreGraph V E) p1 p2,
  (predicate_subgraph g1 p1) ~=~ (predicate_subgraph g2 p2) ->
  Included p1 (vvalid g1) ->
  Included p2 (vvalid g2) ->
  (p1 n <-> p2 n).
Proof.
  intros.
  destruct H as [? _].
  specialize (H n).
  specialize (H0 n).
  specialize (H1 n).
  simpl in *.
  unfold Ensembles.In in *.
  unfold predicate_vvalid in H.
  tauto.
Qed.

Lemma gpredicate_subgraph_self: forall (g: Graph),
  (gpredicate_subgraph (vvalid g) (evalid g) g) ~=~ g.
Proof.
  intros.
  split; [| split; [| split]].
  + simpl; intros.
    rewrite Intersection_spec; tauto.
  + simpl; intros.
    rewrite Intersection_spec; tauto.
  + simpl; intros.
    auto.
  + simpl; intros.
    auto.
Qed.

Lemma gpredicate_subgraph_equiv: forall (g: Graph) (PV1 PV2: V -> Prop) (PE1 PE2: E -> Prop),
  Same_set (Intersection _ (vvalid g) PV1) (Intersection _ (vvalid g) PV2) ->
  Same_set (Intersection _ (evalid g) PE1) (Intersection _ (evalid g) PE2) ->
  (gpredicate_subgraph PV1 PE1 g) ~=~ (gpredicate_subgraph PV2 PE2 g).
Proof.
  intros.
  split; [| split; [| split]].
  + simpl; intros.
    rewrite Same_set_spec in H.
    auto.
  + simpl; intros.
    rewrite Same_set_spec in H0.
    auto.
  + simpl; intros.
    auto.
  + simpl; intros.
    auto.
Qed.

Lemma stronger_gpredicate_subgraph_simple: forall (g g': PreGraph V E) (PV1 PV2: V -> Prop) (PE1 PE2: E -> Prop),
  Included PV2 PV1 ->
  Included PE2 PE1 ->
  (gpredicate_subgraph PV1 PE1 g) ~=~ (gpredicate_subgraph PV1 PE1 g') ->
  (gpredicate_subgraph PV2 PE2 g) ~=~ (gpredicate_subgraph PV2 PE2 g').
Proof.
  intros.
  destruct H1 as [? [? [? ?]]].
  unfold Included, Ensembles.In in H, H0.
  split; [| split; [| split]].
  + simpl in *; intros.
    specialize (H1 v); specialize (H v).
    rewrite !Intersection_spec in H1 |- *.
    tauto.
  + simpl in *; intros.
    specialize (H2 e); specialize (H0 e).
    rewrite !Intersection_spec in H2 |- *.
    tauto.
  + simpl; intros.
    specialize (H0 e).
    apply H3; simpl; rewrite !Intersection_spec in *; tauto.
  + simpl; intros.
    specialize (H0 e).
    apply H4; simpl; rewrite !Intersection_spec in *; tauto.
Qed.

Lemma no_edge_gen_dst_equiv: forall e p (g: Graph) pa x y,
    ~ In e (snd p) -> (pregraph_gen_dst g e pa) |= p is x ~o~> y satisfying (fun _ => True) <-> g |= p is x ~o~> y satisfying (fun _ => True).
Proof.
  intros. destruct p as [p l]. simpl in H. split; intro; destruct H0 as [[? ?] [? ?]]; split; split; auto; clear H0 H3.
  - clear H2. revert p H H1. induction l; intros. 1: simpl in *; auto. rewrite pfoot_cons in H1. remember (dst (pregraph_gen_dst g e pa) a) as w.
    simpl in Heqw. unfold updateEdgeFunc in Heqw. destruct (equiv_dec e a).
    + unfold Equivalence.equiv in e0; exfalso; apply H; left; auto.
    + rewrite pfoot_cons. apply IHl.
      * intro. apply H; right; auto.
      * subst w. auto.
  - clear H1. revert p H H2. induction l; intros. 1: simpl in *; auto. rewrite valid_path_cons_iff in H2 |-* . destruct H2 as [? [? ?]]. split; [|split].
    + simpl in H0. auto.
    + hnf in H1. simpl in H1. unfold updateEdgeFunc in H1. destruct (equiv_dec e a). 1: unfold Equivalence.equiv in e0; exfalso; apply H; left; auto. apply H1.
    + remember (dst (pregraph_gen_dst g e pa) a) as w. simpl in Heqw. unfold updateEdgeFunc in Heqw. destruct (equiv_dec e a). 1: exfalso; apply H; left; auto.
      subst w. apply IHl; auto. intro; apply H; right; auto.
  - clear H2. revert p H H1. induction l; intros. 1: simpl; auto. rewrite pfoot_cons. remember (dst (pregraph_gen_dst g e pa) a) as w. simpl in Heqw.
    unfold updateEdgeFunc in Heqw. destruct (equiv_dec e a). 1: exfalso; apply H; left; auto. subst w. apply IHl.
    + intro; apply H; right; auto.
    + rewrite pfoot_cons in H1. auto.
  - clear H1. revert p H H2. induction l; intros. 1: simpl in *; auto. rewrite valid_path_cons_iff in H2 |-* . destruct H2 as [? [? ?]]. split; [|split].
    + simpl; auto.
    + hnf. simpl. unfold updateEdgeFunc. destruct (equiv_dec e a). 1: unfold Equivalence.equiv in e0; exfalso; apply H; left; auto. apply H1.
    + remember (dst (pregraph_gen_dst g e pa) a) as w. simpl in Heqw. unfold updateEdgeFunc in Heqw. destruct (equiv_dec e a). 1: exfalso; apply H; left; auto.
      subst w. apply IHl; auto. intro; apply H; right; auto.
Qed.

Lemma not_reachable_gen_dst_equiv: forall (g: Graph) x e y z, ~ reachable g x (src g e) -> reachable (pregraph_gen_dst g e y) x z <-> reachable g x z.
Proof.
  intros. split; intro.
  - destruct H0 as [[p l] ?]. assert (~ In e l). {
      intro. apply (in_split_not_in_first EE) in H1. destruct H1 as [l1 [l2 [? ?]]]. subst l. apply reachable_by_path_app_cons in H0. destruct H0 as [? _].
      rewrite no_edge_gen_dst_equiv in H0. 2: simpl; auto. simpl src in H0. apply H. exists (p, l1). auto.
    } rewrite no_edge_gen_dst_equiv in H0. 2: simpl; auto. exists (p, l). auto.
  - destruct H0 as [[p l] ?]. assert (~ In e l). {
      intro. apply in_split in H1. destruct H1 as [l1 [l2 ?]]. subst l. apply reachable_by_path_app_cons in H0. destruct H0 as [? _]. apply H. exists (p, l1). auto.
    } exists (p, l). rewrite no_edge_gen_dst_equiv; auto.
Qed.

Lemma pgd_dst_changed: forall (g: Graph) e x, dst (pregraph_gen_dst g e x) e = x.
Proof. intros. simpl. unfold updateEdgeFunc. rewrite if_true; auto. easy. Qed.

Lemma pgd_dst_unchanged: forall (g: Graph) e1 e2 x,
    e1 <> e2 -> dst (pregraph_gen_dst g e1 x) e2 = dst g e2.
Proof. intros. simpl. unfold updateEdgeFunc. rewrite if_false; auto. Qed.

End PREGRAPH_GEN.

Section LABELED_GRAPH_GEN.

Context {V E: Type}.
Context {EV: EqDec V eq}.
Context {EE: EqDec E eq}.
Context {DV DE DG: Type}.

Notation Graph := (LabeledGraph V E DV DE DG).

Local Coercion pg_lg : LabeledGraph >-> PreGraph.

Definition empty_labeledgraph (src0 dst0: E -> V) (v_default: DV) (e_default: DE) (g_default : DG) : Graph :=
  @Build_LabeledGraph V E EV EE DV DE DG (empty_pregraph src0 dst0) (fun v => v_default) (fun e => e_default) (g_default).

Definition single_vertex_labeledgraph (v0: V) (v_default: DV) (e_default: DE) (g_default : DG) : Graph :=
  @Build_LabeledGraph V E EV EE DV DE DG (single_vertex_pregraph v0) (fun v => v_default) (fun e => e_default) (g_default).

Definition labeledgraph_vgen (g: Graph) (x: V) (a: DV) : Graph := Build_LabeledGraph _ _ _ g (update_vlabel (vlabel g) x a) (elabel g) (glabel g).

Definition labeledgraph_egen (g: Graph) (e: E) (d: DE) : Graph := Build_LabeledGraph _ _ _ g (vlabel g) (update_elabel (elabel g) e d) (glabel g).

Definition labeledgraph_ggen (g: Graph) (m: DG) : Graph := Build_LabeledGraph _ _ _ g (vlabel g) (elabel g) m.

Definition labeledgraph_add_edge (g : Graph) (e : E) (o t : V) (d: DE) :=
  Build_LabeledGraph _ _ _ (pregraph_add_edge g e o t) (vlabel g) (update_elabel (elabel g) e d) (glabel g).

Definition labeledgraph_gen_dst (g : Graph) (e : E) (t : V) :=
  Build_LabeledGraph _ _ _ (pregraph_gen_dst g e t) (vlabel g) (elabel g) (glabel g).

Definition gpredicate_sub_labeledgraph (PV: V -> Prop) (PE: E -> Prop) (g: Graph): Graph :=
  Build_LabeledGraph _ _ _ (gpredicate_subgraph PV PE g) (vlabel g) (elabel g) (glabel g).

Definition predicate_sub_labeledgraph (g: Graph) (p: V -> Prop) :=
  Build_LabeledGraph _ _ _ (predicate_subgraph g p) (vlabel g) (elabel g) (glabel g).

Definition predicate_partial_labeledgraph (g: Graph) (p: V -> Prop) :=
  Build_LabeledGraph _ _ _ (predicate_partialgraph g p) (vlabel g) (elabel g) (glabel g).

Instance sub_labeledgraph_proper: Proper (labeled_graph_equiv ==> @Same_set V ==> labeled_graph_equiv) predicate_sub_labeledgraph.
Proof.
  do 2 (hnf; intros).
  destruct H as [? [? ?]].
  split; [| split].
  + apply subgraph_proper; auto.
  + simpl; intros.
    destruct H3, H4.
    apply H1; auto.
  + simpl; intros.
    destruct H3, H4.
    apply H2; auto.
Defined.

Global Existing Instance sub_labeledgraph_proper.

Instance partial_labeledgraph_proper: Proper (labeled_graph_equiv ==> @Same_set V ==> labeled_graph_equiv) predicate_partial_labeledgraph.
Proof.
  do 2 (hnf; intros).
  destruct H as [? [? ?]].
  split; [| split].
  + apply partialgraph_proper; auto.
  + simpl; intros.
    destruct H3, H4.
    apply H1; auto.
  + simpl; intros.
    destruct H3, H4.
    apply H2; auto.
Defined.

Global Existing Instance partial_labeledgraph_proper.

Instance gpredicate_sub_labeledgraph_proper: Proper (@Same_set V ==> @Same_set E ==> labeled_graph_equiv ==> labeled_graph_equiv) gpredicate_sub_labeledgraph.
Proof.
  do 3 (hnf; intros).
  split; [| split].
  + apply gpredicate_subgraph_proper; auto.
    destruct H1; auto.
  + simpl; intros.
    rewrite Intersection_spec in H2, H3.
    apply (proj1 (proj2 H1)); tauto.
  + simpl; intros.
    rewrite Intersection_spec in H2, H3.
    apply (proj2 (proj2 H1)); tauto.
Qed.

Global Existing Instance gpredicate_sub_labeledgraph_proper.

Lemma lg_vgen_stable: forall (g: Graph) (x: V) (d: DV),
  (predicate_partial_labeledgraph g (Complement V (eq x))) ~=~
   (predicate_partial_labeledgraph (labeledgraph_vgen g x d) (Complement V (eq x)))%LabeledGraph.
Proof.
  intros.
  split; [| split].
  + simpl.
    reflexivity.
  + intros; simpl.
    unfold update_vlabel.
    if_tac; auto.
    destruct H.
    exfalso; apply H2, H1.
  + intros; simpl.
    reflexivity.
Qed.

Lemma si_stronger_partial_labeledgraph: forall (g1 g2: Graph) (p1 p2 p1' p2' p: V -> Prop),
  (forall v, p1' v <-> p1 v /\ p v) ->
  (forall v, p2' v <-> p2 v /\ p v) ->
  (predicate_partial_labeledgraph g1 p1) ~=~ (predicate_partial_labeledgraph g2 p2)%LabeledGraph ->
  (predicate_partial_labeledgraph g1 p1') ~=~ (predicate_partial_labeledgraph g2 p2')%LabeledGraph.
Proof.
  intros.
  split; [| split].
  + eapply si_stronger_partialgraph; eauto.
    destruct H1 as [? _].
    auto.
  + simpl.
    intros ? [? ?] [? ?].
    destruct H1 as [_ [? _]].
    specialize (H1 v); simpl in H1.
    firstorder.
  + simpl.
    intros ? [? ?] [? ?].
    destruct H1 as [_ [_ ?]].
    specialize (H1 e); simpl in H1.
    firstorder.
Qed.

Lemma si_stronger_partial_labeledgraph_simple: forall (g1 g2: Graph) (p p': V -> Prop),
  Included p' p ->
  (predicate_partial_labeledgraph g1 p) ~=~ (predicate_partial_labeledgraph g2 p)%LabeledGraph ->
  (predicate_partial_labeledgraph g1 p') ~=~ (predicate_partial_labeledgraph g2 p')%LabeledGraph.
Proof.
  intros.
  eapply si_stronger_partial_labeledgraph with (p := p'); [| | exact H0].
  + intro v; specialize (H v); simpl in H; tauto.
  + intro v; specialize (H v); simpl in H; tauto.
Qed.

Lemma predicate_partial_labeledgraph_gpredicate_sub_labeledgraph (g: Graph) (p: V -> Prop):
  (predicate_partial_labeledgraph g p) ~=~ (gpredicate_sub_labeledgraph p (Intersection _ (weak_edge_prop p g) (evalid g)) g)%LabeledGraph.
Proof.
  split; [| split].
  + apply predicate_partialgraph_gpredicate_subgraph.
  + simpl; auto.
  + simpl; auto.
Qed.

Lemma gpredicate_sub_labeledgraph_self: forall (g: Graph),
  (gpredicate_sub_labeledgraph (vvalid g) (evalid g) g) ~=~ g%LabeledGraph.
Proof.
  intros.
  split; [| split].
  + apply gpredicate_subgraph_self; auto.
  + simpl; intros; auto.
  + simpl; intros; auto.
Qed.

Lemma gpredicate_sub_labeledgraph_equiv: forall (g: Graph) (PV1 PV2: V -> Prop) (PE1 PE2: E -> Prop),
  Same_set (Intersection _ (vvalid g) PV1) (Intersection _ (vvalid g) PV2) ->
  Same_set (Intersection _ (evalid g) PE1) (Intersection _ (evalid g) PE2) ->
  (gpredicate_sub_labeledgraph PV1 PE1 g) ~=~ (gpredicate_sub_labeledgraph PV2 PE2 g)%LabeledGraph.
Proof.
  intros.
  split; [| split].
  + apply gpredicate_subgraph_equiv; auto.
  + simpl; intros; auto.
  + simpl; intros; auto.
Qed.

Lemma stronger_gpredicate_sub_labeledgraph_simple: forall (g g': Graph) (PV1 PV2: V -> Prop) (PE1 PE2: E -> Prop),
  Included PV2 PV1 ->
  Included PE2 PE1 ->
  (gpredicate_sub_labeledgraph PV1 PE1 g) ~=~ (gpredicate_sub_labeledgraph PV1 PE1 g')%LabeledGraph ->
  (gpredicate_sub_labeledgraph PV2 PE2 g) ~=~ (gpredicate_sub_labeledgraph PV2 PE2 g')%LabeledGraph.
Proof.
  intros.
  destruct H1 as [? [? ?]].
  split; [| split].
  + eapply stronger_gpredicate_subgraph_simple; eauto.
  + simpl; intros.
    specialize (H v).
    apply H2; simpl; rewrite !Intersection_spec in *; tauto.
  + simpl; intros.
    specialize (H0 e).
    apply H3; simpl; rewrite !Intersection_spec in *; tauto.
Qed.

End LABELED_GRAPH_GEN.

Section GENERAL_GRAPH_GEN.

Context {V E: Type}.
Context {EV: EqDec V eq}.
Context {EE: EqDec E eq}.
Context {DV DE DG: Type}.

Class NormalGeneralGraph (P: LabeledGraph V E DV DE DG -> Type): Type := {
  lge_preserved: forall g1 g2, labeled_graph_equiv g1 g2 -> P g1 -> P g2;
  join_preserved: forall g (PV1 PV2 PV: V -> Prop) (PE1 PE2 PE: E -> Prop),
    Prop_join PV1 PV2 PV ->
    Prop_join PE1 PE2 PE ->
    P (gpredicate_sub_labeledgraph PV1 PE1 g) ->
    P (gpredicate_sub_labeledgraph PV2 PE2 g) ->
    P (gpredicate_sub_labeledgraph PV PE g)
}.

Context {P: LabeledGraph V E DV DE DG -> Type}.

Notation Graph := (GeneralGraph V E DV DE DG P).

Local Coercion pg_lg : LabeledGraph >-> PreGraph.
Local Coercion lg_gg : GeneralGraph >-> LabeledGraph.

Definition generalgraph_vgen (g: Graph) (x: V) (d: DV) (sound': P _): Graph := @Build_GeneralGraph V E EV EE DV DE DG P (labeledgraph_vgen g x d) sound'.

Definition generalgraph_egen (g: Graph) (e: E) (d: DE) (sound': P _): Graph := @Build_GeneralGraph V E EV EE DV DE DG P (labeledgraph_egen g e d) sound'.

Definition generalgraph_ggen (g: Graph) (m: DG) (sound': P _): Graph := @Build_GeneralGraph V E EV EE DV DE DG P (labeledgraph_ggen g m) sound'.

Definition generalgraph_gen_dst (g: Graph) (e : E) (t : V) (sound' : P _): Graph := @Build_GeneralGraph V E EV EE DV DE DG P (labeledgraph_gen_dst g e t) sound'.

End GENERAL_GRAPH_GEN.

Section ADD_GRAPH_GEN.

  Context {V E: Type}.
  Context {EV: EqDec V eq}.
  Context {EE: EqDec E eq}.
  Context {DV DE: Type}.
  Notation Gph := (PreGraph V E).

  Variable g: Gph.

  Definition change_vvalid (v: V): Ensemble V :=
    fun n => vvalid g n \/ n = v.

  Definition change_node_pred (P: NodePred V) (v: V) (Pv: {Pv : Prop & {Pv} + {~ Pv}}) : NodePred V.
  Proof.
    intros.
    exists (fun n: V => (if equiv_dec n v then projT1 Pv else P n)).
    intros.
    destruct_eq_dec x v.
    + destruct Pv; auto.
    + destruct P; simpl; auto.
  Defined.

  Definition change_evalid v : Ensemble E := fun e => evalid g e \/ src g e = v.

(*
(*TODO: To resume *)
  Context {BI: BiGraph g left_out_edge right_out_edge}.

  Definition change_dst (v l r: V) : E -> V.
  Proof.
    intro e.
    refine (if equiv_dec (src g e) v then _ else dst g e).
    exact (if left_or_right _ _ v e _H then l else r).
  Defined.

  Definition update_PreGraph v l r : Gph :=
    Build_PreGraph EV EE (change_vvalid v) (change_evalid v) (src g) (change_dst v l r).

  Definition in_math (v l r: V) : Type :=
    forall y, In y (l :: r :: nil) -> {vvalid g y} + {y = v} + {is_null g y}.

  Definition update_MathGraph v l r (Hi: in_math v l r) (Hn: ~ is_null g v): MathGraph (update_PreGraph v l r).
  Proof.
    refine (Build_MathGraph _ (is_null g) (is_null_dec g) _ _).
    + unfold update_PreGraph, change_vvalid, change_evalid, change_dst; simpl.
      intros.
      destruct_eq_dec (src g e) v.
      - split; [right; auto |].
        destruct (left_or_right g BI v e H0); [destruct (Hi l) | destruct (Hi r)]; simpl; tauto.
      - assert (evalid g e) by tauto.
        apply (valid_graph g) in H1.
        unfold weak_valid in H1.
        tauto.
    + unfold update_PreGraph, change_vvalid; simpl.
      intros.
      destruct H; [| subst]; auto.
      apply (valid_not_null g) with x; tauto.
  Defined.

  Definition update_BiGraph v l r: BiGraph (update_PreGraph v l r) left_out_edge right_out_edge.
  Proof.
    refine (Build_BiGraph _ _ _ _ _ _ _).
    + unfold update_PreGraph; simpl.
      unfold change_vvalid, change_evalid.
      intros.
      rewrite (left_sound g).
      pose proof left_valid g x.
      tauto.
    + unfold update_PreGraph; simpl.
      unfold change_vvalid, change_evalid.
      intros.
      rewrite (right_sound g).
      pose proof right_valid g x.
      tauto.
    + unfold update_PreGraph; simpl; apply (bi_consist g).
    + unfold update_PreGraph; simpl; apply (only_two_edges g).
  Defined.

  Definition update_FiniteGraph v l r: FiniteGraph (update_PreGraph v l r).
  Proof.
    refine (Build_FiniteGraph _ _ _); unfold update_PreGraph, change_vvalid, change_evalid, change_dst; simpl.
    + destruct FA as [? _]. unfold EnumEnsembles.Enumerable, Ensembles.In in *.
      destruct finiteV as [l0 [? ?]]. destruct (in_dec equiv_dec v l0).
      - exists l0. split; auto. intro. split; intros.
        * left. apply H0 in H1. auto.
        * destruct H1; [rewrite H0 | subst]; auto.
      - exists (v :: l0). split. constructor; auto. intros. split; intro.
        * destruct H1; [right | left]. auto. specialize (H0 x); intuition.
        * simpl. destruct H1; [right | left]; auto. specialize (H0 x); intuition.
    + destruct FA as [_ ?]. unfold EnumEnsembles.Enumerable, Ensembles.In in *.
      destruct finiteE as [l0 [? ?]].
      destruct (in_dec equiv_dec (left_out_edge v) l0); destruct (in_dec equiv_dec (right_out_edge v) l0).
      - exists l0. split; auto. intros; split; intros.
        left; specialize (H0 x); intuition. destruct H1.
        * specialize (H0 x); intuition.
        * destruct BI. specialize (only_two_edges v x). rewrite only_two_edges in H1.
          destruct H1; subst; auto.
      - remember (left_out_edge v) as e1. remember (right_out_edge v) as e2. exists (e2 :: l0).
        split. constructor; auto. intro; split; intro.
        * destruct H1; [right | left]. subst x. subst e2. destruct BI.
          rewrite only_two_edges. right; auto. specialize (H0 x); intuition.
        * simpl. destruct H1. right; specialize (H0 x); intuition. destruct BI.
          rewrite only_two_edges in H1. destruct H1.
          1: { right. subst e1. subst x. auto. }
          1: { left. subst e2. subst x. auto. }
      - remember (left_out_edge v) as e1. remember (right_out_edge v) as e2. exists (e1 :: l0).
        split. constructor; auto. intro; split; intro.
        * destruct H1; [right | left]. subst x. subst e1. destruct BI.
          rewrite only_two_edges. left; auto. specialize (H0 x); intuition.
        * simpl. destruct H1. right; specialize (H0 x); intuition. destruct BI.
          rewrite only_two_edges in H1. destruct H1.
          1: { left. subst e1. subst x. auto. }
          1: { right. subst e2. subst x. auto. }
      - remember (left_out_edge v) as e1. remember (right_out_edge v) as e2. exists (e1 :: e2 :: l0). split.
        * constructor. intro. destruct H1; auto. destruct BI.
          specialize (bi_consist v). subst. auto. constructor; auto.
        * intro. split; intro.
          1: {
            simpl in H1. destruct H1; [|destruct H1].
            + right. subst x. subst e1. destruct BI. rewrite only_two_edges. left; auto.
            + right. subst x. subst e2. destruct BI. rewrite only_two_edges. right; auto.
            + left. specialize (H0 x). intuition.
          }
          1: {
            destruct H1.
            + simpl. right; right. specialize (H0 x). intuition.
            + destruct BI. rewrite only_two_edges in H1. simpl. destruct H1.
              - left. subst x. subst e1. auto.
              - right; left. subst x. subst e2. auto.
          }
  Qed.
*)
End ADD_GRAPH_GEN.
(*
(* TODO: to resume *)
Section ADD_LABELED_GRAPH_GEN.

  Context {V E: Type}.
  Context {EV: EqDec V eq}.
  Context {EE: EqDec E eq}.
  Context {DV DE: Type}.

  Notation Graph := (LabeledGraph V E DV DE).

  Local Coercion pg_lg: LabeledGraph >-> PreGraph.

  Variable g: Graph.

  Definition update_LabeledGraph (x l r: V) :=
    Build_LabeledGraph _ _ (update_PreGraph g left_out_edge right_out_edge x l r) (vlabel g) (elabel g).

End ADD_LABELED_GRAPH_GEN.

Section ADD_GENERAL_GRAPH_GEN.

  Context {V E: Type}.
  Context {EV: EqDec V eq}.
  Context {EE: EqDec E eq}.
  Context {DV DE: Type}.
  Context {P: LabeledGraph V E DV DE -> Type}.

  Notation Graph := (GeneralGraph V E DV DE P).

  Local Coercion pg_lg: LabeledGraph >-> PreGraph.
  Local Coercion lg_gg: GeneralGraph >-> LabeledGraph.

  Variable g: Graph.

  Definition update_GeneralGraph (x l r: V) (sound': P _): Graph :=
    @Build_GeneralGraph V E EV EE DV DE P (update_LabeledGraph g left_out_edge right_out_edge x l r) sound'.

End ADD_GENERAL_GRAPH_GEN.
*)


Require Import Coq.Lists.List.
Import ListNotations.
Require Import Coq.ZArith.ZArith.
Require Import Bool.

Require Export util.
Require Import fun_util.
Require Export variables.

Local Open Scope string_scope.

(* STATE *)

(* VALUE *)
Inductive VALUE : Type :=
  | b : bool -> VALUE
  | i : Z -> VALUE
  | n : nat -> VALUE.

Definition eq_value (v1 v2 : VALUE) : Prop :=
  match v1,v2 with
  | b t1, b t2 => eq t1 t2
  | i t1, i t2 => Z.eq t1 t2
  | n t1, n t2 => t1 = t2
  | _, _ => False
  end.

(* STATE *)
Definition ind_rules_state
(s : list (NAME * (VALUE * VALUE))) : Prop :=
  is_function
    (map (fun var : (NAME * (VALUE * VALUE)) => fst var) s)
    string_dec.

Record STATE : Set := mkSTATE {
  state : list (NAME * (VALUE * VALUE))

  ; rules_state : ind_rules_state state
}.

Definition previous_values (s : STATE) : list (NAME * VALUE) :=
  map (fun x => (fst x, (fst (snd x)))) s.(state).

Definition current_values (s : STATE) : list (NAME * VALUE) :=
  map (fun x => (fst x, (snd (snd x)))) s.(state).

Fixpoint find_var_state
(n : NAME) (l : list (NAME * (VALUE * VALUE)))
: option (NAME * (VALUE * VALUE)) :=
  match l with
  | []     => None
  | h :: t => if bstring_dec (fst h) n
              then Some h else find_var_state n t
  end.

Definition is_valid_value
(v : VALUE) (t : TYPE) : Prop :=
  match v with
  | b _ => eq_type t Tbool
  | i _ => eq_type t Tint
  | n _ => eq_type t Tnat
  end.

Definition well_typed_var
(s : STATE) (n : NAME) (t : TYPE) : Prop :=
  let v := find_var_state n s.(state) in
    match v with
    | None   => False
    | Some p => (is_valid_value (fst (snd p)) t)
                /\ (is_valid_value (snd (snd p)) t)
    end.

Fixpoint well_typed_state_var
(s:STATE) (l: list (NAME * TYPE)) : Prop :=
    match l with
    | []     => True
    | h :: t => well_typed_var s (fst h) (snd h)
                /\ well_typed_state_var s t
    end.

Definition well_typed_state
(s : STATE) (l : list (NAME * TYPE)) : Prop :=
  let dom_s := map (fun x => fst x) s.(state) in
  let dom_l := map (fun x => fst x) l in
    same_list dom_s dom_l string_dec
    /\ well_typed_state_var s l.

Definition eq_state_element
(e1 e2 : (NAME * (VALUE * VALUE))) : Prop :=
  string_dec (fst e1) (fst e2)
  /\ eq_value (fst (snd e1)) (fst (snd e2))
  /\ eq_value (snd (snd e1)) (snd (snd e2)).

Fixpoint eq_state_elements
(s1 s2 : list (NAME * (VALUE * VALUE))) : Prop :=
  match s1, s2 with
  | []      , []       => True
  | []      , _        => False
  | _       , []       => False
  | h1 :: t1, h2 :: t2 => eq_state_element h1 h2
  end.

Definition eq_state (s1 s2 : STATE) : Prop :=
  same_list s1.(state) s2.(state) eq_state_element.

(* DFRS_INITIAL_STATE *)
Record DFRS_INITIAL_STATE : Set := mkDFRS_INITIAL_STATE {
  s0 : STATE
}.

(* STATES *)

Definition ind_rules_states (l : list STATE) : Prop :=
  0 < List.length l.

Record STATES : Set := mkSTATES {
  states : list STATE;
  rules_states : ind_rules_states states
}.

(** Rules DFRS_STATES *)
Definition ind_rules_dfrs_states
  (s : STATE) (ss : STATES) : Prop :=
    in_list s ss.(states)
          (fun (s1 s2 : STATE) =>
              eq_state s1 s2).

Record DFRS_STATES : Set := mkDFRSSTATES {
  States  : STATES;
  s0'     : STATE;
  rules_dfrs_states : ind_rules_dfrs_states s0' States
}.

Local Close Scope string_scope.