(*---------------------------------- Descriptions ---------------------------------------

In this file we define the idea of graph isomorphism between graphs on two different
domains say A and B. This is done by defining following predicates:

  Definition iso_usg (f: A->A)(G G': @UG A) :=
     (forall x, In x G -> f (f x) = x) /\ (nodes G') = (img f G) /\
     (forall x y, In x G-> In y G-> edg G x y = edg G' (f x) (f y)).

 Definition morph_using (f: A-> B)(G: @UG A)(G': @UG B):=
  (nodes G') = (img f G) /\  (forall x y, In x G-> In y G-> edg G x y = edg G' (f x) (f y)).

 Definition iso_using (f: A-> B)(g: B-> A)(G: @UG A)(G': @UG B):=
    morph_using f G G' /\ morph_using g G' G /\ (forall x, In x G -> g (f x) = x).

 Definition iso (G: @UG A)(G': @UG B):=
    exists (f: A-> B)(g: B-> A), iso_using f g G G'.

When we say (iso_using f g G1 G2), we mean f and g are the function establishing the
isomorphism between graphs G1 and G2.

Lemma iso_is_isomorph (G G': @UG A)(f: A-> A): iso_usg f G G' -> iso_using f f G G'.
Lemma isomorph_is_iso (G G': @UG A)(f: A-> A): iso_using f f G G' ->  iso_usg f G G'.

We also prove that this relation is symmetric and transitive. Note the mutually
invertible nature of f and g that makes them one_one on both G1 and G2.

Following are some useful property of functions f and g establishing the isomorphism:

Lemma fx_is_one_one (l: list A)(f: A->B)(g: B->A):
            (forall x, In x l ->  g (f x) = x) ->  one_one_on l f.
Lemma f_gx_is_x (l: list A)(s: list B)(f: A->B)(g: B->A):
    (forall x, In x l-> g (f x) = x) -> (s = (img f l)) -> (forall y, In y s -> f (g y) = y).

Lemma img_of_img (l: list A)(f: A->B)(g: B-> A)(Hl: IsOrd l):
    (forall x, In x l-> g (f x) = x) -> img g (img f l) = l.
Lemma img_of_img2 (l: list B)(f: A->B)(g: B-> A)(Hl: IsOrd l):
      (forall x, In x l-> f (g x) = x) -> img f (img g l) = l.
Lemma iso_sym1 (G : @UG A)(G': @UG B)(f: A-> B)(g: B-> A):
      iso_using f g G G' -> iso_using g f G' G.

Lemma iso_one_one_on_l (G: @UG A)(G':@UG B)(f: A->B)(g: B-> A)(l: list A):
    iso_using f g G G'-> l [<=] G -> one_one_on l f.
Lemma iso_one_one_on_s (G: @UG A)(G':@UG B)(f: A->B)(g: B-> A)(s: list B):
    iso_using f g G G'-> s [<=] G' -> one_one_on s g.
Lemma iso_cardinal (G: @UG A)(G':@UG B)(f: A->B)(g: B-> A) : iso_using f g G G' -> |G|=|G'|.
Lemma iso_sub_cardinal (G: @UG A)(G':@UG B)(f: A->B)(g: B-> A)(X: list A):
    iso_using f g G G' -> NoDup X -> X [<=] G -> |X|= | img f X |.
Lemma iso_sub_cardinal1 (G: @UG A)(G':@UG B)(f: A->B)(g: B-> A)(Y: list B):
    iso_using f g G G' -> NoDup Y -> Y [<=] G' -> |Y|= | img g Y |.
Lemma iso_edg1 (G: @UG A)(G':@UG B)(f: A->B)(g: B-> A)(x y:A):
     iso_using f g G G' -> In x G -> In y G-> (edg G x y = edg G' (f x) (f y)).
Lemma iso_edg2  (G: @UG A)(G':@UG B)(f: A->B)(g: B-> A)(x y: B):
    iso_using f g G G' -> In x G'-> In y G'-> (edg G' x y = edg G (g x) (g y)).
Lemma iso_img_of_img3 (G: @UG A)(G':@UG B)(f: A->B)(g: B-> A)(l: list A):
    IsOrd l -> l [<=] G -> iso_using f g G G' -> l = img g (img f l).
Lemma iso_img_of_img4 (G: @UG A)(G':@UG B)(f: A->B)(g: B-> A)(l: list B):
    IsOrd l -> l [<=] G' -> iso_using f g G G' -> l = img f (img g l).

-------------------------------------------------------------------------------------

 Stable Set, Cliq and Coloring of graphs has exact counterpart in the isomorphic Graphs.
 These results of existence of isomorphic counterparts are summarized below:

Lemma iso_cliq_in (G: @UG A)(G':@UG B)(f: A->B)(g: B-> A)(K: list A):
    iso_using f g G G' -> Cliq_in G K -> Cliq_in G' (img f K).
Lemma iso_stable_in (G: @UG A)(G':@UG B)(f: A->B)(g: B-> A)(I: list A):
    iso_using f g G G' -> Stable_in G I -> Stable_in G' (img f I).

Lemma max_K_in_G' (G: @UG A)(G':@UG B)(f: A->B)(g: B-> A)(K: list A):
    iso_using f g G G' -> Max_K_in G K -> Max_K_in G' (img f K).
Lemma cliq_num_G' (G: @UG A)(G':@UG B)(n: nat):iso G G' -> cliq_num G n -> cliq_num G' n.
Lemma max_I_in_G' (G: @UG A)(G':@UG B)(f: A->B)(g: B-> A)(I: list A):
    iso_using f g G G' -> Max_I_in G I -> Max_I_in G' (img f I).
Lemma i_num_G' (G: @UG A)(G':@UG B)(n: nat): iso G G' -> i_num G n -> i_num G' n.
Lemma chrom_num_G'(G: @UG A)(G':@UG B)(n: nat):iso G G'->chrom_num G n-> chrom_num G' n.

Lemma nice_G' (G: @UG A)(G':@UG B) : iso G G' -> Nice G -> Nice G’.
Lemma iso_subgraphs (G H: @UG A)(G':@UG B)(f: A->B)(g: B-> A): iso_using f g G G'->
        Ind_subgraph H G ->(exists H', Ind_subgraph H' G'/\ iso_using f g H H’).
Lemma perfect_G' (G: @UG A)(G':@UG B): iso G G' -> Perfect G -> Perfect G’.

Lemma iso_trans (G1 :@UG A)(G2: @UG B)(G3: @UG C): iso G1 G2 -> iso G2 G3 -> iso G1 G3.

------------------------------------------------------------------------------------------*)

Require Export MoreUG.

Set Implicit Arguments.

Section GraphMorphism.

  Context { A B: ordType }.

  Definition morph_using (f: A-> B)(G: @UG A)(G': @UG B):=
    (nodes G') = (img f G) /\  (forall x y, In x G-> In y G-> edg G x y = edg G' (f x) (f y)).

   Definition iso_usg (f: A->A)(G G': @UG A) :=
     (forall x, In x G -> f (f x) = x) /\ (nodes G') = (img f G) /\
     (forall x y, In x G-> In y G-> edg G x y = edg G' (f x) (f y)).

    (* Definition iso (G G': @UG A) := exists (f: A->A), iso_usg f G G'. *)

End GraphMorphism.

Section GraphIsomorphism.
  Context { A B: ordType }.

  Definition iso_using (f: A-> B)(g: B-> A)(G: @UG A)(G': @UG B):=
    morph_using f G G' /\ morph_using g G' G /\ (forall x, In x G -> g (f x) = x).

  Definition iso (G: @UG A)(G': @UG B):=
    exists (f: A-> B)(g: B-> A), iso_using f g G G'.

End GraphIsomorphism.

Section IsoVsIsomorph.
  Context {A: ordType }.

   Lemma img_of_imgf (l: list A)(f: A->A)(Hl: IsOrd l):
    (forall x, In x l->  f (f x) = x)-> img f (img f l) = l.
  Proof. { intro H.
         assert (H1: Equal (img f (img f l)) l).
         { unfold Equal. split.
           { unfold Subset. intros a H1.
             assert (H2: exists b, In b (img f l) /\ a = f b); auto.
             destruct H2 as [b H2]. destruct H2 as [H2a H2b].
             assert (H3: exists x, In x l /\ b = f x ); auto.
             destruct H3 as [x H3]. destruct H3 as [H3a H3b].
             subst a. subst b. replace (f (f x)) with x. auto. symmetry;auto. }
           { unfold Subset. intros a H1.
             assert (H2: In (f a) (img f l)). auto.
             assert (H2a: In (f (f a)) (img f (img f l))). auto.
             replace (f (f a)) with a in H2a. auto. symmetry;auto. } }
         auto. } Qed.

  Lemma iso_is_isomorph (G G': @UG A)(f: A-> A): iso_usg f G G' -> iso_using f f G G'.
  Proof. { intro h1. destruct h1 as [h1 h2]. destruct h2 as [h2 h3]. split.
         { split;auto. } split.
         { split. rewrite h2. symmetry. apply img_of_imgf. all: auto.
           intros x y h4 h5.
           assert (h6: exists x0, In x0 G /\ x = f x0).
           { rewrite h2 in h4; auto. }
           assert (h7: exists y0, In y0 G /\ y = f y0).
           { rewrite h2 in h5; auto. }
           destruct h6 as [x0 h6]. destruct h7 as [y0 h7].
           replace x with (f x0). replace y with (f y0).
           replace (f (f x0)) with x0. replace (f (f y0)) with y0.
           symmetry;apply h3. apply h6. apply h7.
           symmetry;apply h1;apply h7.
           symmetry;apply h1;apply h6.
           symmetry; apply h7.
           symmetry;apply h6. } auto.   } Qed.

  Lemma isomorph_is_iso (G G': @UG A)(f: A-> A): iso_using f f G G' ->  iso_usg f G G'.
  Proof.  { intro h1. destruct h1 as [h1 h2]. destruct h2 as [h2 h3].
            split; (auto || split;apply h1). } Qed.

End IsoVsIsomorph.

Hint Immediate img_of_imgf iso_is_isomorph isomorph_is_iso: core.

Section GraphIsoProp.

  Context { A B: ordType }.

   (*---------------- properties of bijective function f and g for isomorphism ---------*)

  Lemma fx_is_one_one (l: list A)(f: A->B)(g: B->A):
    (forall x, In x l ->  g (f x) = x) ->  one_one_on l f.
  Proof. { intros H. unfold one_one_on. intros x y Hx Hy Hxy HC. absurd (x=y).
           auto. replace y with (g (f y)). rewrite <- HC.
           symmetry;eapply H;eauto. eauto. } Qed.

  Lemma f_gx_is_x (l: list A)(s: list B)(f: A->B)(g: B->A):
    (forall x, In x l-> g (f x) = x) -> (s = (img f l)) -> (forall y, In y s -> f (g y) = y).
  Proof. { intros h1 h2 y h3.
           assert (h4: exists x, In x l /\ y = f x).
           { subst s; eauto. }
           destruct h4 as [x h4]. destruct h4 as [h4a h4]. subst y.
           replace (g (f x)) with x. auto. symmetry;auto. } Qed.

  Lemma gx_is_one_one (s: list B)(f: A-> B)(g: B->A):
    (forall y, In y s -> f (g y) = y) -> one_one_on s g.
  Proof. { intros H. unfold one_one_on. intros x y Hx Hy Hxy HC. absurd (x=y).
           auto. replace y with (f (g y)). rewrite <- HC. symmetry;auto. auto. } Qed.

  Lemma img_of_img (l: list A)(f: A->B)(g: B-> A)(Hl: IsOrd l):
    (forall x, In x l-> g (f x) = x) -> img g (img f l) = l.
 Proof. { intro H.
         assert (H1: Equal (img g (img f l)) l).
         { unfold Equal. split.
           { unfold Subset. intros a H1.
             assert (H2: exists b, In b (img f l) /\ a = g b); auto.
             destruct H2 as [b H2]. destruct H2 as [H2a H2b].
             assert (H3: exists x, In x l /\ b = f x ); auto.
             destruct H3 as [x H3]. destruct H3 as [H3a H3b].
             subst a. subst b. replace (g (f x)) with x. auto. symmetry;auto. }
           { unfold Subset. intros a H1.
             assert (H2: In (f a) (img f l)). auto.
             assert (H2a: In (g (f a)) (img g (img f l))). auto.
             replace (g (f a)) with a in H2a. auto. symmetry;auto. } }
         auto. } Qed.

   Lemma img_of_img1 (l: list A)(f: A->B)(g: B->A)(Hl: IsOrd l):
     (forall x, In x l-> g (f x) = x) -> l = img g (img f l).
   Proof. intros. symmetry. auto using img_of_img. Qed.

    Lemma img_of_img2 (l: list B)(f: A->B)(g: B-> A)(Hl: IsOrd l):
    (forall x, In x l-> f (g x) = x) -> img f (img g l) = l.
    Proof. { intro H.
         assert (H1: Equal (img f (img g l)) l).
         { unfold Equal. split.
           { unfold Subset. intros a H1.
             assert (H2: exists b, In b (img g l) /\ a = f b); auto.
             destruct H2 as [b H2]. destruct H2 as [H2a H2b].
             assert (H3: exists x, In x l /\ b = g x ); auto.
             destruct H3 as [x H3]. destruct H3 as [H3a H3b].
             subst a. subst b. replace (f (g x)) with x. auto. symmetry;auto. }
           { unfold Subset. intros a H1.
             assert (H2: In (g a) (img g l)). auto.
             assert (H2a: In (f (g a)) (img f (img g l))). auto.
             replace (f (g a)) with a in H2a. auto. symmetry;auto. } }
         auto. } Qed.

  Lemma img_of_img3 (l: list B)(f: A->B)(g: B-> A)(Hl: IsOrd l):
    (forall x, In x l-> f (g x) = x) -> l = img f (img g l).
    Proof. intros. symmetry. auto using img_of_img2. Qed.

    Hint Resolve  fx_is_one_one img_of_img img_of_img1: core.
    Hint Resolve img_of_img2 img_of_img3: core.

   (* ---------------------- Isomorphism is commutative -----------------------*)
    Lemma iso_sym1 (G : @UG A)(G': @UG B)(f: A-> B)(g: B-> A):
      iso_using f g G G' -> iso_using g f G' G.
    Proof. { intro H. destruct H as [Ha H]; destruct H as [Hb H].
           split.
           { auto. }
           split.
           { auto. }
           { eapply f_gx_is_x with (l:= G). auto. apply Ha. } } Qed.

    Lemma iso_sym (G: @UG A)(G': @UG B): iso G G' -> iso G' G.
    Proof. { intro H. destruct H as [f H]. destruct H as [g H].
             exists g. exists f. apply iso_sym1. auto. } Qed.

    Lemma iso_using_iso (G: @UG A)(G':@UG B)(f: A->B)(g: B-> A):
      iso_using f g G G' -> iso G G'.
    Proof. intros h. exists f. exists g. auto. Qed.

    Lemma iso_using_iso1 (G: @UG A)(G':@UG B)(f: A->B)(g: B-> A):
      iso_using f g G G' -> iso G' G.
    Proof. intro h. apply iso_sym. eapply iso_using_iso. eauto. Qed.

    Lemma iso_elim1 (G: @UG A)(G':@UG B)(f: A->B)(g: B-> A)(x:A):
      iso_using f g G G'-> In x G-> In (f x) G'.
   Proof. intros H Hx. replace (nodes G') with (img f G). auto. symmetry; apply H. Qed.

   Lemma iso_elim2 (G: @UG A)(G':@UG B)(f: A->B)(g: B-> A)(x:B):
     iso_using f g G G'-> In x G'-> In (g x) G.
  Proof. intros H Hx. replace (nodes G) with (img g G'). auto. symmetry.
         apply iso_sym1 in H as Ha. apply Ha. Qed.

  Hint Immediate iso_sym1 iso_sym iso_elim1 iso_elim2: core.

  Hint Resolve iso_using_iso iso_using_iso1: core.

  (*--------------- Isomorphism is a one one function --------------------------------*)

  Lemma iso_one_one1 (G: @UG A)(G':@UG B)(f: A->B)(g: B-> A):
    iso_using f g G G' -> one_one_on G f.
  Proof.  intro H; eapply fx_is_one_one; apply H. Qed.

  Lemma iso_one_one2 (G: @UG A)(G':@UG B)(f: A->B)(g: B-> A):
    iso_using f g G G' -> one_one_on G' g.
  Proof. intro H. assert (h1: iso_using g f G' G); auto.
         eapply gx_is_one_one; apply h1. Qed.

  Lemma iso_using_G' (G: @UG A)(G':@UG B)(f: A->B)(g: B-> A):
    iso_using f g G G' -> nodes G' = (img f G).
  Proof.  intro H;apply H. Qed.

  Lemma iso_using_G (G: @UG A)(G':@UG B)(f: A->B)(g: B-> A):
    iso_using f g G G' -> nodes G = (img g G').
  Proof. intro H0. cut (iso_using g f G' G). intro H;apply H. auto. Qed.

  Lemma iso_one_one_on_l (G: @UG A)(G':@UG B)(f: A->B)(g: B-> A)(l: list A):
    iso_using f g G G'-> l [<=] G -> one_one_on l f.
  Proof. intros H H1. eapply fx_is_one_one. intros x h1. eapply H. auto. Qed.

  Lemma iso_one_one_on_s (G: @UG A)(G':@UG B)(f: A->B)(g: B-> A)(s: list B):
    iso_using f g G G'-> s [<=] G' -> one_one_on s g.
  Proof. intros H H1. eapply gx_is_one_one. intros x h1.
         assert (H2: iso_using g f G' G). auto.
         eapply H2. auto. Qed.

    Hint Immediate iso_one_one1 iso_one_one2 iso_one_one_on_l iso_one_one_on_s
         iso_using_G iso_using_G': core.

    Lemma iso_cardinal (G: @UG A)(G':@UG B)(f: A->B)(g: B-> A) :
      iso_using f g G G' -> |G|=|G'|.
  Proof. { intro H.  apply iso_one_one1 in H as H1.
           replace (nodes G') with (img f G). auto.
           symmetry; eauto using iso_using_G'. } Qed.

  Lemma iso_sub_cardinal (G: @UG A)(G':@UG B)(f: A->B)(g: B-> A)(X: list A):
    iso_using f g G G' -> NoDup X -> X [<=] G -> |X|= | img f X |.
  Proof. { intros H H0 H1.
         assert (H2: one_one_on G f). eauto.
         assert (H2a: one_one_on X f). eauto. auto. } Qed.

  Lemma iso_sub_cardinal1 (G: @UG A)(G':@UG B)(f: A->B)(g: B-> A)(Y: list B):
    iso_using f g G G' -> NoDup Y -> Y [<=] G' -> |Y|= | img g Y |.
   Proof. { intros H H0 H1.
         assert (H2: one_one_on G' g). eauto.
         assert (H2a: one_one_on Y g). eauto. auto. } Qed.

   (*------------- Isomorphism between graph preserves edge relation -------------*)

   Lemma iso_edg1 (G: @UG A)(G':@UG B)(f: A->B)(g: B-> A)(x y:A):
     iso_using f g G G' -> In x G -> In y G-> (edg G x y = edg G' (f x) (f y)).
  Proof. intro H;apply H. Qed.

  Lemma iso_edg2  (G: @UG A)(G':@UG B)(f: A->B)(g: B-> A)(x y: B):
    iso_using f g G G' -> In x G'-> In y G'-> (edg G' x y = edg G (g x) (g y)).
  Proof. intro H0. cut (iso_using g f G' G). intro H;apply H. auto. Qed.

 Hint Immediate iso_cardinal iso_sub_cardinal iso_sub_cardinal1 iso_edg1 iso_edg2: core.

 Lemma iso_edg3(G: @UG A)(G':@UG B)(f: A->B)(g: B-> A)(x y:A):
   iso_using f g G G' -> In x G -> In y G-> edg G x y -> edg G' (f x) (f y).
  Proof.  intros; replace (edg G' (f x) (f y)) with (edg G x y); eauto.  Qed.

  Lemma iso_edg4  (G: @UG A)(G':@UG B)(f: A->B)(g: B-> A)(x y: A):
    iso_using f g G G' -> In x G -> In y G-> ~ edg G x y -> ~ edg G' (f x) (f y).
  Proof. intros ; replace (edg G' (f x) (f y)) with (edg G x y); eauto. Qed.

  Hint Immediate iso_edg3 iso_edg4: core.

  (*----- f and g when composed with each other returns the initial sets -----------*)

  Lemma iso_image1 (G : @UG A)(G': @UG B)(f: A-> B)(g: B-> A):
    iso_using f g G G' -> (nodes G') = (img f G).
  Proof. intros h1. destruct h1 as [h1 h2]. apply h1. Qed.

  Lemma iso_image2 (G : @UG A)(G': @UG B)(f: A-> B)(g: B-> A):
    iso_using f g G G' -> (nodes G) = (img g G').
  Proof. intros h1. destruct h1 as [h1 h2]. apply h2. Qed.

  Lemma iso_img_of_img1 (G: @UG A)(G':@UG B)(f: A->B)(g: B-> A):
    iso_using f g G G' -> (forall x, In x G -> g (f x) = x).
  Proof. intros h1. destruct h1 as [h1 h2]. apply h2. Qed.

   Lemma iso_img_of_img2 (G: @UG A)(G':@UG B)(f: A->B)(g: B-> A):
    iso_using f g G G' -> (forall x, In x G' -> f (g x) = x).
   Proof. intros h1. cut (iso_using  g f G' G). intro h2.
          destruct h2 as [h2 h3]. apply h3. auto. Qed.

    Lemma iso_img_of_img3 (G: @UG A)(G':@UG B)(f: A->B)(g: B-> A)(l: list A):
    IsOrd l -> l [<=] G -> iso_using f g G G' -> l = img g (img f l).
    Proof. intros h1 h2 h3. eapply img_of_img1. auto. intros x h4.
           eapply iso_img_of_img1. eauto. auto. Qed.

     Lemma iso_img_of_img4 (G: @UG A)(G':@UG B)(f: A->B)(g: B-> A)(l: list B):
    IsOrd l -> l [<=] G' -> iso_using f g G G' -> l = img f (img g l).
  Proof. intros h1 h2 h3. eapply img_of_img3. auto. intros x h4.
           eapply iso_img_of_img2. eauto. auto. Qed.

  Hint Resolve iso_image1 iso_image2: core.
  Hint Resolve iso_img_of_img1 iso_img_of_img2 iso_img_of_img3 iso_img_of_img4: core.

   (* ------------- Isomorphism preserves Cliques and for a graph-----------------*)

   Lemma iso_cliq (G: @UG A)(G':@UG B)(f: A->B)(g: B-> A) (K: list A):
    iso_using f g G G' -> K [<=] G-> Cliq G K -> Cliq G' (img f K).
  Proof. {  unfold Cliq. intros H H1 h1.  intros x y Hx Hy.
          assert (H2: exists x0, In x0 K /\ x = f x0). auto.
          destruct H2 as [x0 H2]. destruct H2 as [H2a H2b].
          assert (H3: exists y0, In y0 K /\ y = f y0). auto.
          destruct H3 as [y0 H3]. destruct H3 as [H3a H3b].
          replace x with (f x0). replace y with (f y0).
          assert (H2:  x0 = y0 \/ edg G x0 y0). auto.
          destruct H2.
          { left. subst x0. auto. }
          { right. replace (edg G' (f x0) (f y0)) with (edg G x0 y0).
            auto. apply H. all: auto. }  }  Qed.

  Lemma iso_cliq1 (G: @UG A)(G':@UG B)(K: list A):
    iso G G' -> K [<=] G -> Cliq G K -> NoDup K -> (exists K', Cliq G' K' /\ |K|=|K'|).
  Proof. { intros H h1 H1 H2. destruct H as [f H]. destruct H as [g H].
         exists (img f K). split. eauto using iso_cliq.
         assert (H3: one_one_on K f). eauto. auto. } Qed.

  Lemma iso_cliq_in (G: @UG A)(G':@UG B)(f: A->B)(g: B-> A)(K: list A):
    iso_using f g G G' -> Cliq_in G K -> Cliq_in G' (img f K).
  Proof. { intros H H1.
         destruct H1 as [H1a H1]. destruct H1 as [H1b H1c].
         split.
         { destruct H as [Ha H]. destruct H as [Hb Hc].
           destruct Ha as [Ha1 Ha]. rewrite Ha1; auto. }
         split.
         { auto. }
         { eauto using iso_cliq. }  } Qed.

  Lemma iso_cliq_in1 (G: @UG A)(G':@UG B)(K: list A):
    iso G G' -> Cliq_in G K -> (exists K', Cliq_in G' K' /\ |K|=|K'|).
  Proof. { intros H H1. destruct H as [f H]. destruct H as [g H].
           exists (img f K). split. eauto using iso_cliq_in.
           assert (H3: one_one_on K f). cut (K [<=] G). eauto. apply H1.
         destruct H1 as [H1a H1]. destruct H1 as [H1b H1c]. auto. } Qed.

  Hint Immediate iso_cliq iso_cliq1 iso_cliq_in iso_cliq_in1: core.

   (*---------- Isomorphism preserves Stable set for a graph ----------------------------*)

   Lemma iso_stable (G: @UG A)(G':@UG B)(f: A->B)(g: B-> A)(I: list A):
    iso_using f g G G' -> I [<=] G -> Stable G I -> Stable G' (img f I).
  Proof. {  unfold Stable. intros H h1 H1.  intros x y Hx Hy.
          assert (H2: exists x0, In x0 I /\ x = f x0). auto.
          destruct H2 as [x0 H2]. destruct H2 as [H2a H2b].
          assert (H3: exists y0, In y0 I /\ y = f y0). auto.
          destruct H3 as [y0 H3]. destruct H3 as [H3a H3b].
          replace x with (f x0). replace y with (f y0).
          assert (H2: edg G x0 y0 = false). auto.
          replace (edg G' (f x0) (f y0)) with (edg G x0 y0).
            auto. apply H. all: auto. } Qed.

  Lemma iso_stable1 (G: @UG A)(G':@UG B)(I: list A):
    iso G G' -> I [<=] G-> Stable G I -> NoDup I -> (exists I', Stable G' I' /\ |I|=|I'|).
  Proof. { intros H h1 H1 H2. destruct H as [f H]. destruct H as [g H].
         exists (img f I). split. eauto using iso_stable.
         assert (H3: one_one_on I f). eauto.
         auto. } Qed.

  Lemma iso_stable_in (G: @UG A)(G':@UG B)(f: A->B)(g: B-> A)(I: list A):
    iso_using f g G G' -> Stable_in G I -> Stable_in G' (img f I).
  Proof. { intros H H1.
         destruct H1 as [H1a H1]. destruct H1 as [H1b H1c].
         split.
         { destruct H as [Ha H]. destruct H as [Hb Hc]. destruct Ha as [Ha1 Ha].
           rewrite Ha1; auto. }
         split.
         { auto. }
         { eauto using iso_stable. }  } Qed.

  Lemma iso_stable_in1 (G: @UG A)(G':@UG B)(I: list A):
    iso G G' -> Stable_in G I -> (exists I', Stable_in G' I' /\ |I|=|I'|).
  Proof. { intros H H1. destruct H as [f H]. destruct H as [g H].
           exists (img f I). split. eauto using iso_stable_in.
           assert (H3: one_one_on I f).
           { cut (I [<=] G). eauto. auto. }
         destruct H1 as [H1a H1]. destruct H1 as [H1b H1c]. auto. } Qed.

  Hint Immediate iso_stable iso_stable1 iso_stable_in iso_stable_in1: core.

  (*----------- Isomorphism, graph coloring for graphs -------------------------*)

  Lemma iso_coloring (G: @UG A)(G':@UG B)(f: A->B)(g: B-> A)(C: A->nat):
    iso_using f g G G' -> Coloring_of G C -> Coloring_of G' (fun (x:B) => C (g x)).
  Proof. { intros H H1. assert (Ha: iso_using g f G' G);auto. unfold Coloring_of.
           intros x y Hx Hy H2.
           assert (H3: edg G (g x) (g y)).
           { replace  (edg G (g x) (g y)) with (edg G' x y). auto. eauto. }
            apply H1; eauto. } Qed.

  Lemma iso_same_clrs  (G: @UG A)(G':@UG B)(f: A->B)(g: B-> A)(C: A->nat):
    iso_using f g G G' -> Coloring_of G C -> (clrs_of C G) = clrs_of (fun (x:B) => C (g x)) G'.
  Proof. { intros H H1. assert (Ha: iso_using g f G' G). auto.
           assert (H2: (nodes G) = img g G'). apply H.
           unfold clrs_of; rewrite H2; auto. } Qed.

  Hint Resolve iso_coloring iso_same_clrs: core.

End GraphIsoProp.

Hint Resolve fx_is_one_one img_of_img img_of_img1: core.
Hint Resolve img_of_img2 img_of_img3: core.

Hint Immediate iso_sym1 iso_sym iso_elim1 iso_elim2: core.
Hint Resolve iso_using_iso iso_using_iso1: core.

 Hint Immediate iso_one_one1 iso_one_one2 iso_one_one_on_l iso_one_one_on_s
      iso_using_G iso_using_G': core.

Hint Immediate iso_cardinal iso_sub_cardinal iso_sub_cardinal1 iso_edg1 iso_edg2: core.
Hint Immediate iso_edg3 iso_edg4: core.
Hint Resolve iso_image1 iso_image2: core.
Hint Resolve iso_img_of_img1 iso_img_of_img2 iso_img_of_img3 iso_img_of_img4 : core.

Hint Immediate iso_cliq iso_cliq1 iso_cliq_in iso_cliq_in1: core.

Hint Immediate iso_stable iso_stable1 iso_stable_in iso_stable_in1: core.
Hint Resolve iso_coloring iso_same_clrs: core.

Section IsoMaxIKC.

  Context {A B: ordType }.

  (*-------------------- Max_K has an iso counterpart--------------------- *)

  Lemma max_K_in_G' (G: @UG A)(G':@UG B)(f: A->B)(g: B-> A)(K: list A):
    iso_using f g G G' -> Max_K_in G K -> Max_K_in G' (img f K).
  Proof. { intros H H1. assert (H0: iso_using g f G' G); auto.
         apply  Max_K_in_intro.
         { cut (Cliq_in G K); eauto. }
         { intros Y H2.
           replace (|Y|) with (|img g Y|).
           replace (|img f K|) with (|K|).
            assert (H3: Cliq_in G (img g Y)). eauto.
           eauto using Max_K_in_elim. eapply iso_sub_cardinal;eauto.
           symmetry. eapply iso_sub_cardinal; eauto. } } Qed.

  Lemma cliq_num_G' (G: @UG A)(G':@UG B)(n: nat):iso G G' -> cliq_num G n -> cliq_num G' n.
  Proof. { intros H H1. destruct H as [f H]. destruct H as [g H].
           destruct H1 as [K H1].
           destruct H1 as [H1 H1b]. exists (img f K).
           split. eauto using max_K_in_G'. replace n with (|K|).
           symmetry. eapply iso_sub_cardinal;eauto. } Qed.

  Hint Immediate max_K_in_G' cliq_num_G': core.

  (*------------------- Max_I has an iso counterpart----------------------- *)

   Lemma max_I_in_G' (G: @UG A)(G':@UG B)(f: A->B)(g: B-> A)(I: list A):
    iso_using f g G G' -> Max_I_in G I -> Max_I_in G' (img f I).
   Proof. { intros H H1. assert (H0: iso_using g f G' G); auto.
         apply  Max_I_in_intro.
         { cut (Stable_in G I); eauto. }
         { intros Y H2.
           replace (|Y|) with (|img g Y|).
           replace (|img f I|) with (|I|).
           assert (H3: Stable_in G (img g Y)). eauto.
           eauto using Max_I_in_elim. eapply iso_sub_cardinal;eauto.
           symmetry. eapply iso_sub_cardinal; eauto. } } Qed.

  Lemma i_num_G' (G: @UG A)(G':@UG B)(n: nat):
    iso G G' -> i_num G n -> i_num G' n.
  Proof. { intros H H1. destruct H as [f H]. destruct H as [g H].
           destruct H1 as [I H1].
           destruct H1 as [H1 H1b]. exists (img f I).
           split. eauto using max_I_in_G'. replace n with (|I|).
           symmetry. eapply iso_sub_cardinal;eauto. } Qed.

  Hint Immediate max_I_in_G' i_num_G': core.

  (*-------------------- Cliq_num and Isomorphism ---------------------------------*)

   Lemma best_coloring_of_G' (G: @UG A)(G':@UG B)(f: A->B)(g: B-> A)(C: A->nat):
    iso_using f g G G' -> Best_coloring_of G C -> Best_coloring_of G' (fun (x:B) => C (g x)).
  Proof. { unfold Best_coloring_of.  intros H H1.
         assert (H0: iso_using g f G' G). auto.
         destruct H1 as [H1 H2].
         split.
         { eauto using iso_coloring. }
         { intros C' H3.
           assert (H4: (clrs_of C G) = clrs_of (fun (x:B) => C (g x)) G').
           { eapply iso_same_clrs. apply H. auto. }
           rewrite <- H4.
           assert (H5: (clrs_of C' G') = clrs_of (fun (x:A) => C' (f x)) G).
           eapply iso_same_clrs with (f0:=g). all: auto.
           rewrite H5.
           apply H2. eauto using iso_coloring. } } Qed.

  Lemma chrom_num_G' (G: @UG A)(G':@UG B)(n: nat):
    iso G G' -> chrom_num G n -> chrom_num G' n.
  Proof. { intros H H1. destruct H as [f H]. destruct H as [g H].
           destruct H1 as [C H1]. destruct H1 as [H1 H2].
           exists (fun (x:B) => C (g x)). split. eauto using best_coloring_of_G'.
           subst n. replace (clrs_of (fun x : B => C (g x)) G') with (clrs_of C G).
           auto. destruct H1 as [H1 H2].
           eapply iso_same_clrs. apply H. auto. } Qed.

  Hint Resolve best_coloring_of_G': core.
  Hint Immediate chrom_num_G': core.

End IsoMaxIKC.

Hint Immediate max_K_in_G' cliq_num_G': core.
Hint Immediate max_I_in_G' i_num_G': core.

Hint Resolve best_coloring_of_G': core.
Hint Immediate chrom_num_G': core.

Section IsoNicePerfect.

  Context { A B: ordType }.

  (*------------Isomorphism, nice graphs and perfect graph--------------------------------*)

  Lemma nice_G' (G: @UG A)(G':@UG B) : iso G G' -> Nice G -> Nice G'.
  Proof. { intro H.  assert (H0: iso G' G). auto.
         unfold Nice. intros H1 n H2.
         cut (chrom_num G n). eauto. cut (cliq_num G n); eauto. } Qed.

  Lemma iso_subgraphs (G H: @UG A)(G':@UG B)(f: A->B)(g: B-> A): iso_using f g G G'->
        Ind_subgraph H G ->(exists H', Ind_subgraph H' G'/\ iso_using f g H H').
  Proof.  { intros F1 F2.
            assert (F0: iso_using g f G' G). auto.
            assert (Nk: IsOrd (img f H)). auto.
            pose H' := (ind_at (img f H) G').
            exists H'.
            assert (h0: H' [<=] G').
            { replace (nodes G') with (img f G). simpl.
              cut (img f H [<=] img f G). auto.
              eapply img_subset. apply F2. symmetry. apply F1. }
            assert (h1: img f H [<=] G').
            { replace (nodes G') with (img f G).
                cut (H [<=] G). auto. apply F2.  symmetry. apply F1. }
            assert (h2: img f H = inter (img f H) G').
            { apply set_equal; auto. }
            split.
            (* Ind_subgraph H' G' *)
            {  unfold Ind_subgraph. split.
               { auto. }
               { unfold H'. simpl. intros. symmetry. auto. } }

            {  (* iso_using f g H H' *)
              unfold iso_using.
              split.
              { (*--  morph_using f H H'--*)
                split.
                (*-- H' = img f H --*)
                unfold H'. simpl. auto.
                (*-- forall x y : A, In x H -> In y H -> edg H x y = edg H' (f x) (f y) --*)
                simpl. intros x y Hx Hy.
                replace (edg H x y) with (edg G x y). rewrite <- h2.
                assert (H2: In (f x) (img f H)). auto.
                replace ((edg G' at_ img f H) (f x) (f y)) with (edg G' (f x)(f y)).
                destruct F2. cut(In y G). cut(In x G). all: auto. eauto.
                symmetry. auto.  }
              split.
              {(*---  morph_using g H' H--*)
                split.
                (*--  H = img g H' ---*)
                unfold H'. simpl. rewrite <- h2.
                assert (h3: IsOrd H). auto.
                assert (h4: H [<=] G). auto. eapply iso_img_of_img3 with (G0:=G).
                all: auto. eauto.
                (* forall x y : B, In x H' -> In y H' -> edg H' x y = edg H (g x) (g y)--*)
                simpl. rewrite <- h2. intros x y Hx Hy.
                replace ((edg G' at_ img f H) x y) with (edg G' x y).
                replace (edg H (g x) (g y)) with (edg G (g x) (g y)).
                apply F1. all:auto. symmetry. apply F2.
                assert (h3: exists x0, In x0 H /\ x = f x0). auto.
                destruct h3 as [x0 h3]. destruct h3 as [h3 h4]. subst x.
                replace  (g (f x0)) with x0. auto. symmetry. apply F1. apply F2. auto.
                assert (h3: exists y0, In y0 H /\ y = f y0). auto.
                destruct h3 as [y0 h3]. destruct h3 as [h3 h4]. subst y.
                replace  (g (f y0)) with y0. auto. symmetry. apply F1. apply F2. auto. }
                intros x h3. apply F1. apply F2. auto. } } Qed.

End IsoNicePerfect.

Hint Immediate nice_G' iso_subgraphs : core.

Section IsoPerfect.

  Context {A B: ordType}.

Lemma perfect_G' (G: @UG A)(G':@UG B): iso G G' -> Perfect G -> Perfect G'.
  Proof. { intro F.  assert (F0: iso G' G). auto.
         unfold Perfect. destruct F0 as [g F0]. destruct F0 as [f F0].
         intros F1 H' F2.
         assert (F3: exists H, Ind_subgraph H G /\ iso_using g f H' H).
         { eapply iso_subgraphs. apply F0. auto. }
         destruct F3 as [H F3]. destruct F3 as [F3 F4].
         cut (Nice H).
         { cut (iso H H'). eauto using nice_G'.
           exists f. exists g. cut (iso_using f g H H'); auto. } auto.  } Qed.

End IsoPerfect.

Hint Immediate perfect_G': core.

Section IsomorphTrans.
  Context {A B C: ordType}.

  Lemma iso_trans (G1 :@UG A)(G2: @UG B)(G3: @UG C):
    iso G1 G2 -> iso G2 G3 -> iso G1 G3.
  Proof. { intros h1 h2. destruct h1 as [f h1]. destruct h1 as [g h1].
           destruct h2 as [f' h2]. destruct h2 as [g' h2].
           assert (h3: nodes G2 = img f G1). eauto.
           assert (h4: nodes G1 = img g G2). eauto.
           assert (h5: nodes G3 = img f' G2). eauto.
           assert (h6: nodes G2 = img g' G3). eauto.

           set (F:= fun x:A => f' (f  x)). set (G:= fun z:C => g (g' z)).
           exists F. exists G. unfold iso_using.
           split.
           (* --- morph_using F G1 G3 ------ *)
           { unfold morph_using.
             split.
             (*--- G3 = img F G1 ----*)
             unfold F. replace (img (fun x : A => f' (f x)) G1) with (img f' (img f G1)).
             rewrite <- h3. auto. eauto.
             (*-- (forall x y : A, In x G1 -> In y G1 -> edg G1 x y = edg G3 (F x) (F y))---*)
             unfold F.
             intros x y hx hy. replace (edg G1 x y) with (edg G2 (f x) (f y)).
             cut (In (f y) G2). cut (In (f x) G2). apply h2.
             rewrite h3;auto. rewrite h3;auto. symmetry. apply h1. all: auto. }
           split.
           (* ---- morph_using G G3 G1 ------ *)
           { unfold morph_using.
             split.
             (*--- G1 = img G G3 ----*)
             unfold G. replace (img (fun z : C => g (g' z)) G3) with (img g (img g' G3)).
             rewrite <- h6. auto. eauto.
             (*-- (forall x y : C, In x G3 -> In y G3 -> edg G3 x y = edg G1 (G x) (G y) ---*)
             unfold G.
             intros x y hx hy. replace (edg G3 x y) with (edg G2 (g' x) (g' y)).
             cut (In (g' y) G2). cut (In (g' x) G2). apply h1.
             rewrite h6;auto. rewrite h6;auto. symmetry. apply h2. all: auto. }
           (* -----(forall x : A, In x G1 -> G (F x) = x) -------*)
           { intros x hx. unfold F. unfold G.
             replace (g' (f' (f x))) with (f x). apply h1. auto.
             symmetry. apply h2. rewrite h3. auto. } } Qed.

End IsomorphTrans.

Hint Immediate iso_trans: core.


Require Import List.
Import ListNotations.
Require Import Ascii.

Fixpoint asciiEnumFn (n : nat) : list ascii :=
        match n with
        | 0 => []
        | S m => (ascii_of_nat m) :: asciiEnumFn m
        end.

Definition asciiEnum : list ascii := asciiEnumFn 256.

Lemma ascii_finite : forall a : ascii, In a asciiEnum.
Proof.
  intros. destruct a.
  destruct b; destruct b0; destruct b1; destruct b2;
    destruct b3; destruct b4; destruct b5; destruct b6;
  repeat(try(left; reflexivity); right).
Qed.


Require Export Lists.

Inductive list (X:Type) : Type :=
| nil : list X
| cons : X -> list X -> list X.

Check nil.
Check cons.

Check (cons nat 2 (cons nat 1 (nil nat))).

Module MUMBLEBAZ.
Inductive mumble : Type :=
| a : mumble
| b : mumble -> nat -> mumble
| c : mumble.

Inductive grumble (X : Type) : Type :=
| d : mumble -> grumble X
| e : X -> grumble X.

Check (d mumble (b a 5)).
Check (d bool (b a 5)).
Check (e bool true).
Check (e mumble (b c 0)).
Check c.

End MUMBLEBAZ.
Check (cons nat 2 (nil nat)).
Check cons.

Fixpoint app X l1 l2 : list X :=
  match l1 with
    | nil => l2
    | cons h t => cons X h (app X t l2)
  end.

Arguments nil {X}.
Arguments cons {X} _ _.

Fixpoint length {X : Type} (l : list X) : nat :=
  match l with
    | nil => O
    | cons h t => S (length t)
  end.

Arguments app {X} l1 l2.

Notation "x :: y" := (cons x y)
                       (at level 60, right associativity).
Notation "[]" := nil.
Notation "[ x ; .. ; y ]" := (cons x .. (cons y []) ..).
Notation "x ++ y" := (app x y)
                       (at level 60, right associativity).
Fixpoint snoc {X : Type} (a : list X) (b : X) : list X :=
  match a with
    | nil => [b]
    | h :: t => h :: (snoc t b)
  end.

Theorem snoc_with_append :
  forall (X : Type) (l1 l2 : list X) (v : X),
    snoc (l1 ++ l2) v = l1 ++ (snoc l2 v).

Proof.
  induction l1.
  reflexivity.
  simpl.
  intros l2 v.
  rewrite -> IHl1.
  reflexivity.
Qed.

Inductive prod (X Y :Type) : Type :=
  pair : X -> Y -> prod X Y.

Arguments pair {X Y} _ _.

Notation "( x , y )" := (pair x y).

Notation "X * Y" := (prod X Y) : type_scope.

Definition prod_curry {X Y Z:Type}
           (f : (X * Y) -> Z) (x : X) (y : Y) : Z :=
  f (x,y).

Definition prod_uncurry {X Y Z :Type}
           (f : X -> Y -> Z) ( p : (X * Y)) : Z :=
  match p with
    | (x , y) => f x y
  end.

Theorem uncurry_curry :
  forall (X Y Z : Type),
  forall (f : X -> Y -> Z),
  forall (x : X) (y : Y),
    (prod_curry (prod_uncurry f)) x y = f x y.
Proof.
  intros X Y Z f x y.
  reflexivity.
Qed.

Theorem curry_uncurry :
  forall (X Y Z : Type)
         (f : (X * Y) -> Z)
         (p : (X * Y)),
    (prod_uncurry (prod_curry f)) p = f p.
Proof.
  intros X Y Z f p.
  destruct p as [x y].
  reflexivity.
Qed.

Definition doit3times {X:Type} (f : X -> X) (x : X) : X :=
  f (f (f x)).

Check (doit3times (fun n => match n with
                              | O => O
                              | S x => x
                            end) 10).

Definition override {Y : Type} (f : nat -> Y) (x : nat) (y : Y) :(nat -> Y):=
  fun (x' : nat) => if (beq_nat x' x)
                    then y
                    else f x'.
Definition plus3 :=
  plus 3.

Theorem unfold_example :
  forall n m,
    3 + n = m ->
    plus3 n + 1 = m + 1.

Proof.
  intros n m H.
  unfold plus3.
  rewrite -> H.
  reflexivity.
Qed.

Theorem override_eq :
  forall (X :  Type)
         x k (f : nat -> X),
    (override f k x) k = x.
Proof.
  intros X x k f.
  unfold override.
  replace (beq_nat k k) with true.
  reflexivity.
  induction k.
  reflexivity.
  simpl.
  rewrite -> IHk.
  reflexivity.
Qed.

Module CHURCH.
  Definition nat := forall (X : Type),
                      (X -> X) -> X -> X.
  Definition zero : nat :=
    fun (X : Type) (f : X -> X) (x : X) => x.
  Definition succ (a : nat) : nat :=
    fun (X : Type) (f : X -> X) (x : X) => f (a X f x).
  Definition one : nat :=
    fun (X : Type) (f : X -> X) (x : X) => f x.

  Example succ_1 : succ zero = one.
  Proof.
    reflexivity.
  Qed.
  Definition plus (a b : nat) : nat :=
    fun (X : Type) (f : X -> X) (x : X) =>
      b X f (a X f x).
  Example plus_1 : plus zero one = one.
  Proof.
    reflexivity.
  Qed.


Require Import String.
Require Import Nat.
Require Import Coq.Vectors.Vector.
Require Import List.
Require Import Lia.
Import ListNotations.
Open Scope string_scope.
From ST Require Import EVarsScratchwork.
From ST Require Export ST.SoftType.
From ST Require Export Logic.V Logic.Term Logic.Predicate.
Import VectorNotations.
(** ** Formulas

The grammar of formulas is rather straightforward. Honestly, I was unsure how
"slick" I should be: [Verum] could be defined as [Not Falsum], but using a
minimal set of connectives seemed _too_ slick for my tastes.
*)
Inductive Formula : Type :=
| Falsum
| Atom : Predicate -> Formula
| And : Formula -> Formula -> Formula
| Or : Formula -> Formula -> Formula
| Implies : Formula -> Formula -> Formula
| Exists : Formula -> Formula.

Definition Not (p : Formula) := Implies p Falsum.
Definition Verum : Formula := Implies Falsum Falsum.
Definition Forall (p : Formula) := Not (Exists (Not p)).

Definition is_and (p : Formula) : bool :=
match p with
| And _ _ => true
| _ => false
end.

Definition Is_and (p : Formula) : Prop :=
match p with
| And _ _ => True
| _ => False
end.

Definition Iff (a b : Formula) :=
  And (Implies a b) (Implies b a).

Fixpoint formula_contains_bvar (index : nat) (A : Formula) : Prop :=
match A with
  | Falsum => False
  | Atom pred => contains_bvar index pred
  | And fm1 fm2 | Or fm1 fm2 | Implies fm1 fm2 => (formula_contains_bvar index fm1) \/ (formula_contains_bvar index fm2)
  | Exists fm => (formula_contains_bvar (S index) fm)
end.

Global Instance ContainsBVarFormula : ContainsBVar Formula := {
  contains_bvar := formula_contains_bvar
}.

Fixpoint is_ground_formula (phi : Formula) :=
match phi with
| Falsum => True
| Atom p => is_ground p
| And f1 f2 | Or f1 f2 | Implies f1 f2 => (is_ground_formula f1) /\ (is_ground_formula f2)
| Exists f => is_ground_formula f
end.

Global Instance GroundFormula : Ground Formula := {
  is_ground := is_ground_formula
}.

Definition is_sentence (A : Formula) := is_ground_formula A.

(** We can recursively test if two [Formula] objects are identical. This is an
equality at the level of syntax. *)
Fixpoint eq_formula (A B : Formula) : bool :=
match A,B with
| Falsum, Falsum => true
| Atom (P n1 s1 args1), Atom (P n2 s2 args2) =>
      if andb (eqb n1 n2) (eqb s1 s2)
      then vectors_eqb args1 args2 term_eqb
      else false
| And A1 A2, And B1 B2 => andb (eq_formula A1 B1) (eq_formula A2 B2)
| Or A1 A2, Or B1 B2 => andb (eq_formula A1 B1) (eq_formula A2 B2)
| Implies A1 A2, Implies B1 B2 =>  andb (eq_formula A1 B1) (eq_formula A2 B2)
| Exists A1, Exists B1 => eq_formula A1 B1
| _, _ => false
end.

Global Instance EqFormula : Eq Formula := {
  eqb := eq_formula
}.

Theorem eq_dec : forall a b : Formula, {a = b} + {a <> b}.
Proof.
  decide equality. apply Predicate.eq_dec.
Defined.

(** "Variable closing", or binding a free variable to a quantifier (or any
binder), is a bit tricky. We have a helper function here for the iterative
step. It behaves "functorially", descending to the leafs, i.e., [Falsum] and
[Atom]. *)
Fixpoint var_closing_iter (x : name) (n : nat) (phi : Formula) : Formula :=
match phi with
| Falsum => phi
| Atom pred => Atom (subst (FVar x) (Var (BVar n)) pred)
| And fm1 fm2 => And (var_closing_iter x n fm1) (var_closing_iter x n fm2)
| Or fm1 fm2 => Or (var_closing_iter x n fm1) (var_closing_iter x n fm2)
| Implies fm1 fm2 => Implies (var_closing_iter x n fm1) (var_closing_iter x n fm2)
| Exists fm => Exists (var_closing_iter x (S n) fm)
end.

Definition quantify (x : name) (phi : Formula) : Formula :=
  var_closing_iter x 0 phi.

(** Substitution, when replacing a bound variable with an arbitrary term,
requires care. Why? Because we need to lift the bound variable as we encounter
quantifiers.

Particular care must be taken when the term refers to variables or quantities
in the "context part". Towards that end, we must [lift] the term whenever a
quantifier is encountered.
*)

Fixpoint capture_free_subst (n : nat) (t : Term) (phi : Formula) : Formula :=
match phi with
| Falsum => phi
| Atom pred => Atom (subst (BVar n) t pred)
| And fm1 fm2 => And (capture_free_subst n t fm1) (capture_free_subst n t fm2)
| Or fm1 fm2 => Or (capture_free_subst n t fm1) (capture_free_subst n t fm2)
| Implies fm1 fm2 => Implies (capture_free_subst n t fm1) (capture_free_subst n t fm2)
| Exists fm => Exists (capture_free_subst (S n) (lift (S n) 1 t) fm)
end.

Lemma forall_subst : forall (n : nat) (t : Term) (A : Formula),
  capture_free_subst n t (Forall A) = Forall (capture_free_subst (S n) (lift (S n) 1 t) A).
Proof.
  intros; simpl; auto.
Qed.

(** Specialization and choosing a witness for existential quantification
amounts to the same "operations" of peeling off an outermost quantifier, then
behaving as expected. *)
Fixpoint quantifier_elim_subst (n : nat) (t : Term) (phi : Formula) : Formula :=
match phi with
| Exists fm => capture_free_subst n t fm
| And A B => And (quantifier_elim_subst n t A) (quantifier_elim_subst n t B)
| Or A B => Or (quantifier_elim_subst n t A) (quantifier_elim_subst n t B)
| Implies A B => Implies (quantifier_elim_subst n t A) (quantifier_elim_subst n t B)
| _ => phi
end.

Example subst_bvar_1 : quantifier_elim_subst 0 (Fun "t" []) (Forall (Exists (Atom (P 2 "P" [Var (BVar 0); Var (BVar 1)]))))
= Not (Not (Exists (Atom (P 2 "P" [Var (BVar 0); Fun "t" []])))).
Proof.
  trivial.
Qed.

Example subst_bvar_2 : quantifier_elim_subst 0 (Fun "t" [Var (BVar 0)]) (Forall (Exists (Atom (P 2 "P" [Var (BVar 0); Var (BVar 1)]))))
= Not (Not (Exists (Atom (P 2 "P" [Var (BVar 0); Fun "t" [Var (BVar 0)]])))).
Proof.
  trivial.
Qed.

Example subst_bvar_3 : quantifier_elim_subst 0 (Fun "t" [])
(Forall (Forall (Forall (Exists (Atom (P 3 "P" [Var (BVar 0); Var (BVar 1); Var (BVar 3)]))))))
= Not (Not (Forall (Forall (Exists (Atom (P 3 "P" [Var (BVar 0); Var (BVar 1); (Fun "t" []) ])))))).
Proof.
  simpl; auto.
Qed.

(* In [Fun "t" [(Var (BVar 1))]], the parameter [BVar 1] is interpreted as a
free variable. For this reason, it will be "kept above" the syntactic depth
of the outermost binder in the resulting formula. There are 3 quantifiers
in the result, therefore we expect it to be [BVar 4] in the outcome. *)
Example subst_bvar_4 : quantifier_elim_subst 0 (Fun "t" [(Var (BVar 1))])
(Forall (Forall (Forall (Exists (Atom (P 3 "P" [Var (BVar 0); Var (BVar 1); Var (BVar 3)]))))))
= Not (Not (Forall (Forall (Exists (Atom (P 3 "P" [Var (BVar 0); Var (BVar 1); (Fun "t" [(Var (BVar 4))]) ])))))).
Proof.
  simpl; auto.
Qed.

Fixpoint lift_formula (c d : nat) (phi : Formula) : Formula :=
  match phi with
  | Falsum => phi
  | Atom pred => Atom (lift c d pred)
  | And fm1 fm2 => And (lift_formula c d fm1) (lift_formula c d fm2)
  | Or fm1 fm2 => Or (lift_formula c d fm1) (lift_formula c d fm2)
  | Implies fm1 fm2 => Implies (lift_formula c d fm1) (lift_formula c d fm2)
  | Exists fm => Exists (lift_formula (S c) d fm)
  end.

Fixpoint unlift_formula (c d : nat) (phi : Formula) : Formula :=
  match phi with
  | Falsum => phi
  | Atom pred => Atom (unlift c d pred)
  | And fm1 fm2 => And (unlift_formula c d fm1) (unlift_formula c d fm2)
  | Or fm1 fm2 => Or (unlift_formula c d fm1) (unlift_formula c d fm2)
  | Implies fm1 fm2 => Implies (unlift_formula c d fm1) (unlift_formula c d fm2)
  | Exists fm => Exists (unlift_formula (S c) d fm)
  end.

Global Instance LiftFormula : Lift Formula :=
{
  lift := lift_formula;
  unlift := unlift_formula
}.

Lemma lift_forall : forall (c d : nat) (A : Formula),
  lift c d (Forall A) = Forall (lift (S c) d A).
Proof.
  intros; simpl; auto.
Qed.
(**
We would encode $\forall x\exists y P(x,y)$ as
[Forall (Exists (Atom (P 2 "P" [BVar 1; BVar 0])))], using de Bruijn indices.
*)

Theorem lift_id : forall {n : nat} (A : Formula),
  lift n 0 A = A.
Proof.
  intros.
  assert (lift n 0 A = lift_formula n 0 A). { simpl; auto. } rewrite H; clear H.
  generalize dependent n. induction A.
  - intros; simpl; auto.
  - intros; unfold lift_formula. destruct n as [|n].
    + rewrite Predicate.lift_id. reflexivity.
    + assert (lift 0 0 p = p). { apply Predicate.lift_id. }
      rewrite (Predicate.bigger_lift_is_id 0 0 (S n)).
      reflexivity. lia. rewrite Predicate.lift_id; reflexivity.
  - intros; simpl; auto; rewrite IHA1; rewrite IHA2; reflexivity.
  - intros; simpl; auto; rewrite IHA1; rewrite IHA2; reflexivity.
  - intros; simpl; auto; rewrite IHA1; rewrite IHA2; reflexivity.
  - intros; simpl; auto; rewrite (IHA (S n)); reflexivity.
Qed.

Theorem lift_comp : forall (c d1 d2 : nat) (A : Formula),
  lift c d1 (lift c d2 A) = lift c (d1 + d2) A.
Proof.
  intros. generalize dependent c.
  induction A.
  - intros. simpl; auto.
  - intros. assert(lift c d1 (lift c d2 (Atom p)) = Atom (lift c d1 (lift c d2 p))). {
      simpl; auto.
    } rewrite H.
    assert (lift c (d1 + d2) (Atom p) = Atom (lift c (d1 + d2) p)). {
      simpl; auto.
    } rewrite H0.
    assert (lift c d1 (lift c d2 p) = lift c (d1 + d2) p). {
      apply Predicate.lift_comp.
    } rewrite H1. reflexivity.
  - intros. assert (lift c d1 (lift c d2 (And A1 A2)) = And (lift c d1 (lift c d2 A1)) (lift c d1 (lift c d2 A2))). {
      simpl; auto.
    } rewrite H; rewrite IHA1; rewrite IHA2.
    assert (lift c (d1 + d2) (And A1 A2) = And (lift c (d1 + d2) A1) (lift c (d1 + d2) A2)). {
      simpl; auto.
    } rewrite H0. reflexivity.
  - intros. assert (lift c d1 (lift c d2 (Or A1 A2)) = Or (lift c d1 (lift c d2 A1)) (lift c d1 (lift c d2 A2))). {
      simpl; auto.
    } rewrite H; rewrite IHA1; rewrite IHA2.
    assert (lift c (d1 + d2) (Or A1 A2) = Or (lift c (d1 + d2) A1) (lift c (d1 + d2) A2)). {
      simpl; auto.
    } rewrite H0. reflexivity.
  - intros. assert (lift c d1 (lift c d2 (Implies A1 A2)) = Implies (lift c d1 (lift c d2 A1)) (lift c d1 (lift c d2 A2))). {
      simpl; auto.
    } rewrite H; rewrite IHA1; rewrite IHA2.
    assert (lift c (d1 + d2) (Implies A1 A2) = Implies (lift c (d1 + d2) A1) (lift c (d1 + d2) A2)). {
      simpl; auto.
    } rewrite H0. reflexivity.
  - intros. assert (lift c d1 (lift c d2 (Exists A)) = Exists (lift (S c) d1 (lift (S c) d2 A))). { simpl; auto. }
    assert (lift c (d1 + d2) (Exists A) = Exists (lift (S c) (d1 + d2) A)). { simpl; auto. }
    rewrite H; rewrite H0. rewrite (IHA (S c)). reflexivity.
Qed.

Theorem lift_seq : forall (c d2 d1 : nat) (A : Formula),
  d1 > 0 -> lift (S c) d2 (lift c d1 A) = lift c (d2 + d1) A.
Proof.
  intros. generalize dependent c.
  induction A.
  - intros. simpl; auto.
  - intros. assert(lift (S c) d2 (lift c d1 (Atom p)) = Atom (lift (S c) d2 (lift c d1 p))). {
      simpl; auto.
    } rewrite H0.
    assert (lift c (d2 + d1) (Atom p) = Atom (lift c (d2 + d1) p)). {
      simpl; auto.
    } rewrite H1.
    assert (lift (S c) d2 (lift c d1 p) = lift c (d2 + d1) p). {
      apply Predicate.lift_seq. assumption.
    } rewrite H2. reflexivity.
  - intros. assert (lift (S c) d2 (lift c d1 (And A1 A2)) = And (lift (S c) d2 (lift c d1 A1)) (lift (S c) d2 (lift c d1 A2))). {
      simpl; auto.
    } rewrite H0; rewrite IHA1; rewrite IHA2.
    assert (lift c (d2 + d1) (And A1 A2) = And (lift c (d2 + d1) A1) (lift c (d2 + d1) A2)). {
      simpl; auto.
    } rewrite H1. reflexivity.
  - intros. assert (lift (S c) d2 (lift c d1 (Or A1 A2)) = Or (lift (S c) d2 (lift c d1 A1)) (lift (S c) d2 (lift c d1 A2))). {
      simpl; auto.
    } rewrite H0; rewrite IHA1; rewrite IHA2.
    assert (lift c (d2 + d1) (Or A1 A2) = Or (lift c (d2 + d1) A1) (lift c (d2 + d1) A2)). {
      simpl; auto.
    } rewrite H1. reflexivity.
  - intros. assert (lift (S c) d2 (lift c d1 (Implies A1 A2)) = Implies (lift (S c) d2 (lift c d1 A1)) (lift (S c) d2 (lift c d1 A2))). {
      simpl; auto.
    } rewrite H0; rewrite IHA1; rewrite IHA2.
    assert (lift c (d2 + d1) (Implies A1 A2) = Implies (lift c (d2 + d1) A1) (lift c (d2 + d1) A2)). {
      simpl; auto.
    } rewrite H1. reflexivity.
  - intros. assert (lift (S c) d2 (lift c d1 (Exists A)) = Exists (lift (S (S c)) d2 (lift (S c) d1 A))). { simpl; auto. }
    assert (lift c (d2 + d1) (Exists A) = Exists (lift (S c) (d2 + d1) A)). { simpl; auto. }
    rewrite H0; rewrite H1. rewrite (IHA (S c)). reflexivity.
Qed.

(*
Lemma variadic_lift_seq : forall (m : nat) (A : Formula),
  (lift (S m) 1 (lift 1 m A)) = lift 1 (S m) A.
Proof.
  intros. generalize dependent m.
  induction A.
  - intros. simpl; auto.
  - intros. assert(lift (S m) 1 (lift 1 m (Atom p)) = Atom (lift (S m) 1 (lift 1 m p))). {
      simpl; auto.
    } rewrite H.
    assert (lift 1 (S m) (Atom p) = Atom (lift 1 (S m) p)). {
      simpl; auto.
    } rewrite H0.
    assert (lift (S m) 1 (lift 1 m p) = lift 1 (S m) p). {
      apply Predicate.variadic_lift_seq.
    } rewrite H1. reflexivity.
  - intros. assert (lift (S m) 1 (lift 1 m (And A1 A2)) = And (lift (S m) 1 (lift 1 m A1)) (lift (S m) 1 (lift 1 m A2))). {
      simpl; auto.
    } rewrite H; rewrite IHA1; rewrite IHA2.
    assert (lift 1 (S m) (And A1 A2) = And (lift 1 (S m) A1) (lift 1 (S m) A2)). {
      simpl; auto.
    } rewrite H0. reflexivity.
  - intros. assert (lift (S m) 1 (lift 1 m (Or A1 A2)) = Or (lift (S m) 1 (lift 1 m A1)) (lift (S m) 1 (lift 1 m A2))). {
      simpl; auto.
    } rewrite H; rewrite IHA1; rewrite IHA2.
    assert (lift 1 (S m) (Or A1 A2) = Or (lift 1 (S m) A1) (lift 1 (S m) A2)). {
      simpl; auto.
    } rewrite H0. reflexivity.
  - intros. assert (lift (S m) 1 (lift 1 m (Implies A1 A2)) = Implies (lift (S m) 1 (lift 1 m A1)) (lift (S m) 1 (lift 1 m A2))). {
      simpl; auto.
    } rewrite H; rewrite IHA1; rewrite IHA2.
    assert (lift 1 (S m) (Implies A1 A2) = Implies (lift 1 (S m) A1) (lift 1 (S m) A2)). {
      simpl; auto.
    } rewrite H0. reflexivity.
  - intros. assert (lift (S m) 1 (lift 1 m (Exists A)) = Exists (lift (S (S m)) 1 (lift 2 m A))). { simpl; auto. }
    assert (lift 1 (S m) (Exists A) = Exists (lift 2 (S m) A)). { simpl; auto. }
    rewrite H; rewrite H0. rewrite (IHA (S m)). reflexivity.
Qed.
*)

Lemma variadic_lift_seq : forall (k m : nat) (A : Formula),
  k > 0 -> (lift (k + m) 1 (lift k m A)) = lift k (S m) A.
Proof.
  intros. generalize dependent k. generalize dependent m.
  induction A.
  - intros. simpl; auto.
  - intros. assert(lift (k + m) 1 (lift k m (Atom p)) = Atom (lift (k + m) 1 (lift k m p))). {
      simpl; auto.
    } rewrite H0.
    assert (lift k (S m) (Atom p) = Atom (lift k (S m) p)). {
      simpl; auto.
    } rewrite H1.
    assert (lift (k + m) 1 (lift k m p) = lift k (S m) p). {
      apply Predicate.variadic_quantifier_lift_seq. assumption.
    } rewrite H2. reflexivity.
  - intros. assert (lift (k + m) 1 (lift k m (And A1 A2))
                    = And (lift (k + m) 1 (lift k m A1)) (lift (k + m) 1 (lift k m A2))). {
      simpl; auto.
    } rewrite H0; rewrite IHA1. rewrite IHA2.
    assert (lift k (S m) (And A1 A2) = And (lift k (S m) A1) (lift k (S m) A2)). {
      simpl; auto.
    } rewrite H1. reflexivity. assumption. assumption.
  - intros. assert (lift (k + m) 1 (lift k m (Or A1 A2)) = Or (lift (k + m) 1 (lift k m A1)) (lift (k + m) 1 (lift k m A2))). {
      simpl; auto.
    } rewrite H0; rewrite IHA1. rewrite IHA2.
    assert (lift k (S m) (Or A1 A2) = Or (lift k (S m) A1) (lift k (S m) A2)). {
      simpl; auto.
    } rewrite H1. reflexivity. assumption. assumption.
  - intros. assert (lift (k + m) 1 (lift k m (Implies A1 A2)) = Implies (lift (k + m) 1 (lift k m A1)) (lift (k + m) 1 (lift k m A2))). {
      simpl; auto.
    } rewrite H0; rewrite IHA1. rewrite IHA2.
    assert (lift k (S m) (Implies A1 A2) = Implies (lift k (S m) A1) (lift k (S m) A2)). {
      simpl; auto.
    } rewrite H1. reflexivity. assumption. assumption.
  - intros. assert (lift (k + m) 1 (lift k m (Exists A)) = Exists (lift (S (k + m)) 1 (lift (S k) m A))). { simpl; auto. }
    assert (lift k (S m) (Exists A) = Exists (lift (S k) (S m) A)). { simpl; auto. }
    rewrite H0; rewrite H1.
    assert (lift (S k + m) 1 (lift (S k) m A) = lift (S k) (S m) A). {
      apply (IHA m (S k)). apply Gt.gt_Sn_O.
    }
    assert (S k + m = S (k + m)). lia. rewrite H3 in H2.
    rewrite H2; reflexivity.
Qed.

(**
We now have a helper function to quantify over a given variable. They handle
lifting and replacement, if the variable appears at all in the [Formula]. If
[n] does not appear in [Formula], then the formula [phi] is returned unchanged.
*)
Definition every (n : name) (phi : Formula) : Formula :=
  let phi' := quantify n (shift phi)
  in if eqb phi' (shift phi) then phi else Forall phi'.

Definition any (n : name) (phi : Formula) : Formula :=
  let phi' := quantify n (shift phi)
  in if eqb phi' (shift phi) then phi else Exists phi'.

(** As a smoke check, we see if variations on a simple formula are "parsed" as
expected. *)
Example quantifier_example_1 : (every "x" (any "y" (Atom (P 2 "P" [Var (FVar "x"); Var (FVar "y")]))))
= Forall (Exists (Atom (P 2 "P" [Var (BVar 1); Var (BVar 0)]))).
Proof.
  trivial.
Qed.

Example quantifier_example_2 :
  every "z" (any "y" (Atom (P 2 "P" [Var (FVar "x"); Var (FVar "y")])))
  = Exists (Atom (P 2 "P" [Var (FVar "x"); Var (BVar 0)])).
Proof.
  trivial.
Qed.

Fixpoint fresh_formula (c : Term) (p : Formula) : Prop :=
  match p with
  | Falsum => True
  | Atom phi => fresh c phi
  | And A B | Or A B | Implies A B => (fresh_formula c A) /\ (fresh_formula c B)
  | Exists A => fresh_formula c A
  end.

Global Instance FreshFormula : Fresh Formula := {
  fresh := fresh_formula
}.

Global Instance FreshContext : Fresh (list Formula) := {
  fresh c Γ := List.Forall (fresh c) Γ
}.

(** * Listing the Existential Variables appearing in a Formula *)
Fixpoint list_evars_formula (phi : Formula) : list nat :=
match phi with
| Falsum => []%list
| Atom pred => list_evars pred
| And fm1 fm2 | Or fm1 fm2 | Implies fm1 fm2 => insert_merge (list_evars_formula fm1) (list_evars_formula fm2)
| Exists fm => (list_evars_formula fm)
end.

Global Instance EnumerateEVarsFormula : EnumerateEVars Formula := {
list_evars := list_evars_formula
}.

Theorem list_evars_formula_sorted : forall (phi : Formula),
  sorted (list_evars phi).
Proof. intros. induction phi.
- simpl; auto. apply sorted_nil.
- unfold list_evars; unfold EnumerateEVarsFormula. apply list_evars_predicate_sorted.
- unfold list_evars; unfold EnumerateEVarsFormula.
  apply insert_merge_sorted2; assumption.
- unfold list_evars; unfold EnumerateEVarsFormula.
  apply insert_merge_sorted2; assumption.
- unfold list_evars; unfold EnumerateEVarsFormula.
  apply insert_merge_sorted2; assumption.
- simpl; auto.
Qed.

Global Instance EnumerateEVarsFormulaList : EnumerateEVars (list Formula) := {
list_evars Γ := (List.fold_left (fun l' => fun (phi : Formula) => insert_merge (list_evars phi) l')
 Γ []%list)
}.

Theorem list_evars_formula_list_sorted : forall (l : list Formula),
  sorted (list_evars l).
Proof.
  intros. unfold list_evars; unfold EnumerateEVarsFormulaList.
  apply insert_merge_list_fold_sorted. apply sorted_nil.
Qed.

Fixpoint lift_evars_formula (k : nat) (phi : Formula) : Formula :=
match phi with
| Falsum => phi
| Atom pred => Atom (lift_evars k pred)
| And fm1 fm2 => And (lift_evars_formula k fm1) (lift_evars_formula k fm2)
| Or fm1 fm2 => Or (lift_evars_formula k fm1) (lift_evars_formula k fm2)
| Implies fm1 fm2 => Implies (lift_evars_formula k fm1) (lift_evars_formula k fm2)
| Exists fm => Exists (lift_evars_formula k fm)
end.

Global Instance LiftEvarsFormula : LiftEvars Formula := {
  lift_evars := lift_evars_formula
}.

Global Instance LiftEvarsListFormula : LiftEvars (list Formula) := {
  lift_evars k Γ := List.map (lift_evars k) Γ
}.

Definition fresh_evar_counter (Γ : list Formula) (p : Formula) : nat :=
first_new 0 (list_evars (p::Γ)%list).

Definition fresh_evar (Γ : list Formula) (p : Formula) : Term :=
EConst (fresh_evar_counter Γ p).

(* TODO: these next two results should be proven, but I am lazy. *)
Lemma fresh_evar_context : forall (Γ : list Formula) (p : Formula),
  fresh (fresh_evar Γ p) Γ.
Admitted.

(* Exercise: Prove the following.

Lemma fresh_evar_body : forall (Γ : list Formula) (p : Formula),
  fresh (fresh_evar Γ p) p.
Admitted.
*)
(*
Lemma capture_free_subst_id0 : forall (p : Formula),
  capture_free_subst 0 (Var (BVar 0)) p = p.
Proof.
  intros. induction p.
  - simpl; auto.
  - unfold capture_free_subst; rewrite Predicate.subst_id; reflexivity.
  - simpl; auto; rewrite IHp1; rewrite IHp2; reflexivity.
  - simpl; auto; rewrite IHp1; rewrite IHp2; reflexivity.
  - simpl; auto; rewrite IHp1; rewrite IHp2; reflexivity.
  - assert (capture_free_subst 0 (Var (BVar 0)) (Exists p)
            = Exists (capture_free_subst (S 0) (lift (S 0) 1 (Var (BVar 0))) p)). {
      simpl; auto.
    admit.
    }
    rewrite H.
    assert (lift 1 1 (Var (BVar 0)) = Var (BVar 0)). {
      simpl; auto.
    }
    rewrite H0.
    admit.
Admitted.

Lemma capture_free_subst_id : forall (n : nat) (p : Formula),
  capture_free_subst n (Var (BVar n)) p = p.
Proof.
  intros. generalize dependent n. induction p.
  - intros; simpl; auto.
  - intros; unfold capture_free_subst; rewrite Predicate.subst_id; reflexivity.
  - intros; simpl; auto; rewrite IHp1; rewrite IHp2; reflexivity.
  - intros; simpl; auto; rewrite IHp1; rewrite IHp2; reflexivity.
  - intros; simpl; auto; rewrite IHp1; rewrite IHp2; reflexivity.
  - intros.
    assert (capture_free_subst n (Var (BVar n)) (Exists p)
            = Exists (capture_free_subst (S n) (lift (S n) 1 (Var (BVar n))) p)). {
      simpl; auto.
    }
    assert (lift (S n) 1 (Var (BVar n)) = Var (BVar n)). {
      assert (lift (S n) 1 (Var (BVar n)) = Var (lift (S n) 1 (BVar n))). {
        simpl; auto.
      } rewrite H0.
      assert (lift (S n) 1 (BVar n) = BVar n). {
        apply case_lift_is_id. simpl; auto.
      }
      rewrite H1; reflexivity.
    }
    rewrite H; rewrite H0.
Admitted.
*)

Fixpoint contains_formula (sub : Term) (fm : Formula) : Prop := match fm with
  | Falsum => False
  | Atom p => contains sub p
  | And A B | Or A B | Implies A B => (contains_formula sub A) \/ (contains_formula sub B)
  | Exists A => contains_formula sub A
end.

Global Instance ContainsFormula : Contains Formula := {
  contains := contains_formula
}.

(* Syntactic substitution *)
Fixpoint subst_formula (x : V) (t : Term) (A : Formula) :=
match A with
| Falsum => A
| Atom pred => Atom (subst x t pred)
| Or p q => Or (subst_formula x t p) (subst_formula x t q)
| And p q => And (subst_formula x t p) (subst_formula x t q)
| Implies p q => Implies (subst_formula x t p) (subst_formula x t q)
| Exists p => Exists (subst_formula x t p)
end.

Global Instance SubstFormula : Subst Formula :=
{
  subst := subst_formula
}.


(************************************************************************)
(*         *   The Coq Proof Assistant / The Coq Development Team       *)
(*  v      *   INRIA, CNRS and contributors - Copyright 1999-2018       *)
(* <O___,, *       (see CREDITS file for the list of authors)           *)
(*   \VV/  **************************************************************)
(*    //   *    This file is distributed under the terms of the         *)
(*         *     GNU Lesser General Public License Version 2.1          *)
(*         *     (see LICENSE file for the text of the license)         *)
(************************************************************************)

(** Here are collected some results about the type sumbool (see INIT/Specif.v)
   [sumbool A B], which is written [{A}+{B}], is the informative
   disjunction "A or B", where A and B are logical propositions.
   Its extraction is isomorphic to the type of booleans. *)

(** A boolean is either [true] or [false], and this is decidable *)

Definition sumbool_of_bool : forall b:bool, {b = true} + {b = false}.
  destruct b; auto.
Defined.

Hint Resolve sumbool_of_bool: bool.

Definition bool_eq_rec :
  forall (b:bool) (P:bool -> Set),
    (b = true -> P true) -> (b = false -> P false) -> P b.
  destruct b; auto.
Defined.

Definition bool_eq_ind :
  forall (b:bool) (P:bool -> Prop),
    (b = true -> P true) -> (b = false -> P false) -> P b.
  destruct b; auto.
Defined.

(** Logic connectives on type [sumbool] *)

Section connectives.

  Variables A B C D : Prop.

  Hypothesis H1 : {A} + {B}.
  Hypothesis H2 : {C} + {D}.

  Definition sumbool_and : {A /\ C} + {B \/ D}.
    case H1; case H2; auto.
  Defined.

  Definition sumbool_or : {A \/ C} + {B /\ D}.
    case H1; case H2; auto.
  Defined.

  Definition sumbool_not : {B} + {A}.
    case H1; auto.
  Defined.

End connectives.

Hint Resolve sumbool_and sumbool_or: core.
Hint Immediate sumbool_not : core.

(** Any decidability function in type [sumbool] can be turned into a function
    returning a boolean with the corresponding specification: *)

Definition bool_of_sumbool :
  forall A B:Prop, {A} + {B} -> {b : bool | if b then A else B}.
  intros A B H.
  elim H; intro; [exists true | exists false]; assumption.
Defined.
Arguments bool_of_sumbool : default implicits.