(* This file demonstrates coinduction through the example of automata equivalence.
   We explore three different ways to define equivalence between automaton states
   and prove they are all equivalent. *)

Require Import List.
Import ListNotations.

(* An automaton over an alphabet Sigma consists of:
   - A state type (i.e., a set of states)
   - A predicate identifying accepting states
   - A transition function delta that takes a state and input symbol and returns the next state *)
Record aut (Sigma : Type) := {
    state : Type;
    accept : state -> Prop;
    delta : state -> Sigma -> state
}.

(* Make the record fields available without explicitly mentioning Sigma *)
Arguments state {_}.
Arguments accept {_}.
Arguments delta {_}.

(* Define states for our example automaton *)
Inductive states1 := sA | sB | sC | sD | sE | sF.

(* Example automaton that takes boolean inputs.
   States B, D, and E are accepting states.
   The transition function defines how states change based on boolean inputs. *)
Definition aut1 : aut bool := {|
    state := states1;
    accept s := match s with
    | sA | sB | sF => False
    | sC | sD | sE => True
    end;
    delta s x := match s, x with
    | sA, false => sB
    | sA, true => sC
    | sB, false => sA
    | sB, true => sD
    | sC, false => sE
    | sC, true => sF
    | sD, false => sE
    | sD, true => sF
    | sE, false => sE
    | sE, true => sF
    | sF, _ => sF
    end;
|}.

(* First definition of language acceptance:
   A state accepts a list of inputs if following those inputs leads to an accepting state *)
Inductive accepts {Sigma} (A : aut Sigma) : list Sigma -> state A -> Prop :=
    | acc_nil : forall s, accept A s -> accepts A [] s
    | acc_cons : forall s x xs, accepts A xs (delta A s x) -> accepts A (x :: xs) s.

(* First definition of state equivalence:
   Two states are equivalent if they accept exactly the same input sequences *)
Definition equiv1 {Sigma} (A : aut Sigma) (s1 s2 : state A) :=
    forall xs, accepts A xs s1 <-> accepts A xs s2.

Lemma equiv1_CD : equiv1 aut1 sC sD.
equiv1 aut1 sC sD
Proof.
equiv1 aut1 sC sD
    unfold equiv1.
forall xs : list bool,
accepts aut1 xs sC <-> accepts aut1 xs sD
    intros [].
accepts aut1 [] sC <-> accepts aut1 [] sD
b: bool
l: list bool
accepts aut1 (b :: l) sC <-> accepts aut1 (b :: l) sD
    -
accepts aut1 [] sC <-> accepts aut1 [] sD split; intros H; inversion_clear H; constructor; simpl in *; eauto.
    -
b: bool
l: list bool
accepts aut1 (b :: l) sC <-> accepts aut1 (b :: l) sD split.
b: bool
l: list bool
accepts aut1 (b :: l) sC -> accepts aut1 (b :: l) sD
b: bool
l: list bool
accepts aut1 (b :: l) sD -> accepts aut1 (b :: l) sC
      +
b: bool
l: list bool
accepts aut1 (b :: l) sC -> accepts aut1 (b :: l) sD intros H.
b: bool
l: list bool
H: accepts aut1 (b :: l) sC
accepts aut1 (b :: l) sD inversion_clear H.
b: bool
l: list bool
H0: accepts aut1 l (delta aut1 sC b)
accepts aut1 (b :: l) sD simpl in *.
b: bool
l: list bool
H0: accepts aut1 l (if b then sF else sE)
accepts aut1 (b :: l) sD
        constructor.
b: bool
l: list bool
H0: accepts aut1 l (if b then sF else sE)
accepts aut1 l (delta aut1 sD b) simpl.
b: bool
l: list bool
H0: accepts aut1 l (if b then sF else sE)
accepts aut1 l (if b then sF else sE) auto.
      +
b: bool
l: list bool
accepts aut1 (b :: l) sD -> accepts aut1 (b :: l) sC intros H.
b: bool
l: list bool
H: accepts aut1 (b :: l) sD
accepts aut1 (b :: l) sC inversion_clear H.
b: bool
l: list bool
H0: accepts aut1 l (delta aut1 sD b)
accepts aut1 (b :: l) sC simpl in *.
b: bool
l: list bool
H0: accepts aut1 l (if b then sF else sE)
accepts aut1 (b :: l) sC
        constructor.
b: bool
l: list bool
H0: accepts aut1 l (if b then sF else sE)
accepts aut1 l (delta aut1 sC b) simpl.
b: bool
l: list bool
H0: accepts aut1 l (if b then sF else sE)
accepts aut1 l (if b then sF else sE) auto.
Qed.

(* Example: states A and B are equivalent *)
Lemma equiv1_AB : equiv1 aut1 sA sB.
equiv1 aut1 sA sB
Proof.
equiv1 aut1 sA sB
    unfold equiv1.
forall xs : list bool,
accepts aut1 xs sA <-> accepts aut1 xs sB
    induction xs.
accepts aut1 [] sA <-> accepts aut1 [] sB
a: bool
xs: list bool
IHxs: accepts aut1 xs sA <-> accepts aut1 xs sB
accepts aut1 (a :: xs) sA <->
accepts aut1 (a :: xs) sB
    -
accepts aut1 [] sA <-> accepts aut1 [] sB split; intros H; inversion_clear H; constructor; simpl in *; eauto.
    -
a: bool
xs: list bool
IHxs: accepts aut1 xs sA <-> accepts aut1 xs sB
accepts aut1 (a :: xs) sA <->
accepts aut1 (a :: xs) sB split.
a: bool
xs: list bool
IHxs: accepts aut1 xs sA <-> accepts aut1 xs sB
accepts aut1 (a :: xs) sA -> accepts aut1 (a :: xs) sB
a: bool
xs: list bool
IHxs: accepts aut1 xs sA <-> accepts aut1 xs sB
accepts aut1 (a :: xs) sB -> accepts aut1 (a :: xs) sA
      +
a: bool
xs: list bool
IHxs: accepts aut1 xs sA <-> accepts aut1 xs sB
accepts aut1 (a :: xs) sA -> accepts aut1 (a :: xs) sB intros H.
a: bool
xs: list bool
IHxs: accepts aut1 xs sA <-> accepts aut1 xs sB
H: accepts aut1 (a :: xs) sA
accepts aut1 (a :: xs) sB inversion_clear H.
a: bool
xs: list bool
IHxs: accepts aut1 xs sA <-> accepts aut1 xs sB
H0: accepts aut1 xs (delta aut1 sA a)
accepts aut1 (a :: xs) sB simpl in *.
a: bool
xs: list bool
IHxs: accepts aut1 xs sA <-> accepts aut1 xs sB
H0: accepts aut1 xs (if a then sC else sB)
accepts aut1 (a :: xs) sB
        constructor.
a: bool
xs: list bool
IHxs: accepts aut1 xs sA <-> accepts aut1 xs sB
H0: accepts aut1 xs (if a then sC else sB)
accepts aut1 xs (delta aut1 sB a) simpl.
a: bool
xs: list bool
IHxs: accepts aut1 xs sA <-> accepts aut1 xs sB
H0: accepts aut1 xs (if a then sC else sB)
accepts aut1 xs (if a then sD else sA) destruct a.
xs: list bool
IHxs: accepts aut1 xs sA <-> accepts aut1 xs sB
H0: accepts aut1 xs sC
accepts aut1 xs sD
xs: list bool
IHxs: accepts aut1 xs sA <-> accepts aut1 xs sB
H0: accepts aut1 xs sB
accepts aut1 xs sA
        *
xs: list bool
IHxs: accepts aut1 xs sA <-> accepts aut1 xs sB
H0: accepts aut1 xs sC
accepts aut1 xs sD apply equiv1_CD.
xs: list bool
IHxs: accepts aut1 xs sA <-> accepts aut1 xs sB
H0: accepts aut1 xs sC
accepts aut1 xs sC auto.
        *
xs: list bool
IHxs: accepts aut1 xs sA <-> accepts aut1 xs sB
H0: accepts aut1 xs sB
accepts aut1 xs sA apply IHxs.
xs: list bool
IHxs: accepts aut1 xs sA <-> accepts aut1 xs sB
H0: accepts aut1 xs sB
accepts aut1 xs sB auto.
      +
a: bool
xs: list bool
IHxs: accepts aut1 xs sA <-> accepts aut1 xs sB
accepts aut1 (a :: xs) sB -> accepts aut1 (a :: xs) sA intros H.
a: bool
xs: list bool
IHxs: accepts aut1 xs sA <-> accepts aut1 xs sB
H: accepts aut1 (a :: xs) sB
accepts aut1 (a :: xs) sA inversion_clear H.
a: bool
xs: list bool
IHxs: accepts aut1 xs sA <-> accepts aut1 xs sB
H0: accepts aut1 xs (delta aut1 sB a)
accepts aut1 (a :: xs) sA simpl in *.
a: bool
xs: list bool
IHxs: accepts aut1 xs sA <-> accepts aut1 xs sB
H0: accepts aut1 xs (if a then sD else sA)
accepts aut1 (a :: xs) sA
        constructor.
a: bool
xs: list bool
IHxs: accepts aut1 xs sA <-> accepts aut1 xs sB
H0: accepts aut1 xs (if a then sD else sA)
accepts aut1 xs (delta aut1 sA a) simpl.
a: bool
xs: list bool
IHxs: accepts aut1 xs sA <-> accepts aut1 xs sB
H0: accepts aut1 xs (if a then sD else sA)
accepts aut1 xs (if a then sC else sB) destruct a.
xs: list bool
IHxs: accepts aut1 xs sA <-> accepts aut1 xs sB
H0: accepts aut1 xs sD
accepts aut1 xs sC
xs: list bool
IHxs: accepts aut1 xs sA <-> accepts aut1 xs sB
H0: accepts aut1 xs sA
accepts aut1 xs sB
        *
xs: list bool
IHxs: accepts aut1 xs sA <-> accepts aut1 xs sB
H0: accepts aut1 xs sD
accepts aut1 xs sC apply equiv1_CD.
xs: list bool
IHxs: accepts aut1 xs sA <-> accepts aut1 xs sB
H0: accepts aut1 xs sD
accepts aut1 xs sD auto.
        *
xs: list bool
IHxs: accepts aut1 xs sA <-> accepts aut1 xs sB
H0: accepts aut1 xs sA
accepts aut1 xs sB apply IHxs.
xs: list bool
IHxs: accepts aut1 xs sA <-> accepts aut1 xs sB
H0: accepts aut1 xs sA
accepts aut1 xs sA auto.
Qed.

(* Example: states A and F are not equivalent *)
Lemma not_equiv1_AF : ~ equiv1 aut1 sA sF.
~ equiv1 aut1 sA sF
Proof.
~ equiv1 aut1 sA sF
Admitted.

(* Second definition of equivalence using bisimulation:
   A relation R is a bisimulation if related states:
   1) agree on acceptance
   2) transition to related states on any input *)
Definition bisim {Sigma} (A : aut Sigma) (R : state A -> state A -> Prop) :=
    forall s1 s2, R s1 s2 -> (accept A s1 <-> accept A s2) /\ forall x, R (delta A s1 x) (delta A s2 x).

(* Two states are equivalent if there exists a bisimulation relating them *)
Definition equiv2 {Sigma} (A : aut Sigma) (s1 s2 : state A) :=
    exists R, bisim A R /\ R s1 s2.

Lemma equiv1_bisim {Sigma} (aut : aut Sigma) :
    bisim aut (equiv1 aut).
Sigma: Type
aut: lec22_coinduction.aut Sigma
bisim aut (equiv1 aut)
Proof.
Sigma: Type
aut: lec22_coinduction.aut Sigma
bisim aut (equiv1 aut)
Admitted.

(* The first and second definitions of equivalence are equivalent *)
Lemma equiv12 {Sigma} (aut : aut Sigma) (s1 s2 : state aut) :
    equiv1 aut s1 s2 -> equiv2 aut s1 s2.
Sigma: Type
aut: lec22_coinduction.aut Sigma
s1, s2: state aut
equiv1 aut s1 s2 -> equiv2 aut s1 s2
Proof.
Sigma: Type
aut: lec22_coinduction.aut Sigma
s1, s2: state aut
equiv1 aut s1 s2 -> equiv2 aut s1 s2
Admitted.

Lemma equiv21 {Sigma} (aut : aut Sigma) (s1 s2 : state aut) :
    equiv2 aut s1 s2 -> equiv1 aut s1 s2.
Sigma: Type
aut: lec22_coinduction.aut Sigma
s1, s2: state aut
equiv2 aut s1 s2 -> equiv1 aut s1 s2
Proof.
Sigma: Type
aut: lec22_coinduction.aut Sigma
s1, s2: state aut
equiv2 aut s1 s2 -> equiv1 aut s1 s2
Admitted.

(* Third definition using coinduction:
   Two states are equivalent if:
   1) they agree on acceptance
   2) their transitions are equivalent for all inputs
   This is similar to bisimulation but uses Coq's built-in coinduction *)
CoInductive equiv3 {Sigma} (A : aut Sigma) (s1 s2 : state A) : Prop := {
    accept_eq : accept A s1 <-> accept A s2;
    delta_eq : forall x, equiv3 A (delta A s1 x) (delta A s2 x);
}.

(* Reflexivity of equiv3 *)
Lemma equiv3_refl {Sigma} (aut : aut Sigma) (s : state aut) :
    equiv3 aut s s.
Sigma: Type
aut: lec22_coinduction.aut Sigma
s: state aut
equiv3 aut s s
Proof.
Sigma: Type
aut: lec22_coinduction.aut Sigma
s: state aut
equiv3 aut s s
    revert s.
Sigma: Type
aut: lec22_coinduction.aut Sigma
forall s : state aut, equiv3 aut s s cofix IH.
Sigma: Type
aut: lec22_coinduction.aut Sigma
IH: forall s : state aut, equiv3 aut s s
forall s : state aut, equiv3 aut s s intros s.
Sigma: Type
aut: lec22_coinduction.aut Sigma
IH: forall s : state aut, equiv3 aut s s
s: state aut
equiv3 aut s s
    constructor.
Sigma: Type
aut: lec22_coinduction.aut Sigma
IH: forall s : state aut, equiv3 aut s s
s: state aut
accept aut s <-> accept aut s
Sigma: Type
aut: lec22_coinduction.aut Sigma
IH: forall s : state aut, equiv3 aut s s
s: state aut
forall x : Sigma,
equiv3 aut (delta aut s x) (delta aut s x)
    +
Sigma: Type
aut: lec22_coinduction.aut Sigma
IH: forall s : state aut, equiv3 aut s s
s: state aut
accept aut s <-> accept aut s reflexivity.
    +
Sigma: Type
aut: lec22_coinduction.aut Sigma
IH: forall s : state aut, equiv3 aut s s
s: state aut
forall x : Sigma,
equiv3 aut (delta aut s x) (delta aut s x) intros x.
Sigma: Type
aut: lec22_coinduction.aut Sigma
IH: forall s : state aut, equiv3 aut s s
s: state aut
x: Sigma
equiv3 aut (delta aut s x) (delta aut s x) apply IH.
Qed.

(* Example: states E and D are equivalent *)
Lemma equiv3_EF : equiv3 aut1 sE sD.
equiv3 aut1 sE sD
Proof.
equiv3 aut1 sE sD
    constructor.
accept aut1 sE <-> accept aut1 sD
forall x : bool,
equiv3 aut1 (delta aut1 sE x) (delta aut1 sD x)
    +
accept aut1 sE <-> accept aut1 sD simpl.
True <-> True reflexivity.
    +
forall x : bool,
equiv3 aut1 (delta aut1 sE x) (delta aut1 sD x) intros x.
x: bool
equiv3 aut1 (delta aut1 sE x) (delta aut1 sD x) simpl.
x: bool
equiv3 aut1 (if x then sF else sE)
  (if x then sF else sE) destruct x; apply equiv3_refl.
Qed.

(* The second and third definitions are equivalent *)
Lemma equiv23 {Sigma} (aut : aut Sigma) (s1 s2 : state aut) :
    equiv2 aut s1 s2 -> equiv3 aut s1 s2.
Sigma: Type
aut: lec22_coinduction.aut Sigma
s1, s2: state aut
equiv2 aut s1 s2 -> equiv3 aut s1 s2
Proof.
Sigma: Type
aut: lec22_coinduction.aut Sigma
s1, s2: state aut
equiv2 aut s1 s2 -> equiv3 aut s1 s2
    intros [R [bisim_R R_s1_s2]].
Sigma: Type
aut: lec22_coinduction.aut Sigma
s1, s2: state aut
R: state aut -> state aut -> Prop
bisim_R: bisim aut R
R_s1_s2: R s1 s2
equiv3 aut s1 s2 revert s1 s2 R_s1_s2.
Sigma: Type
aut: lec22_coinduction.aut Sigma
R: state aut -> state aut -> Prop
bisim_R: bisim aut R
forall s1 s2 : state aut, R s1 s2 -> equiv3 aut s1 s2
    cofix IH.
Sigma: Type
aut: lec22_coinduction.aut Sigma
R: state aut -> state aut -> Prop
bisim_R: bisim aut R
IH: forall s1 s2 : state aut,
R s1 s2 -> equiv3 aut s1 s2
forall s1 s2 : state aut, R s1 s2 -> equiv3 aut s1 s2
    intros s1 s2 R_s1_s2.
Sigma: Type
aut: lec22_coinduction.aut Sigma
R: state aut -> state aut -> Prop
bisim_R: bisim aut R
IH: forall s1 s2 : state aut,
R s1 s2 -> equiv3 aut s1 s2
s1, s2: state aut
R_s1_s2: R s1 s2
equiv3 aut s1 s2
    constructor.
Sigma: Type
aut: lec22_coinduction.aut Sigma
R: state aut -> state aut -> Prop
bisim_R: bisim aut R
IH: forall s1 s2 : state aut,
R s1 s2 -> equiv3 aut s1 s2
s1, s2: state aut
R_s1_s2: R s1 s2
accept aut s1 <-> accept aut s2
Sigma: Type
aut: lec22_coinduction.aut Sigma
R: state aut -> state aut -> Prop
bisim_R: bisim aut R
IH: forall s1 s2 : state aut,
R s1 s2 -> equiv3 aut s1 s2
s1, s2: state aut
R_s1_s2: R s1 s2
forall x : Sigma,
equiv3 aut (delta aut s1 x) (delta aut s2 x)
    +
Sigma: Type
aut: lec22_coinduction.aut Sigma
R: state aut -> state aut -> Prop
bisim_R: bisim aut R
IH: forall s1 s2 : state aut,
R s1 s2 -> equiv3 aut s1 s2
s1, s2: state aut
R_s1_s2: R s1 s2
accept aut s1 <-> accept aut s2 destruct (bisim_R s1 s2 R_s1_s2).
Sigma: Type
aut: lec22_coinduction.aut Sigma
R: state aut -> state aut -> Prop
bisim_R: bisim aut R
IH: forall s1 s2 : state aut,
R s1 s2 -> equiv3 aut s1 s2
s1, s2: state aut
R_s1_s2: R s1 s2
H: accept aut s1 <-> accept aut s2
H0: forall x : Sigma,
R (delta aut s1 x) (delta aut s2 x)
accept aut s1 <-> accept aut s2 auto.
    +
Sigma: Type
aut: lec22_coinduction.aut Sigma
R: state aut -> state aut -> Prop
bisim_R: bisim aut R
IH: forall s1 s2 : state aut,
R s1 s2 -> equiv3 aut s1 s2
s1, s2: state aut
R_s1_s2: R s1 s2
forall x : Sigma,
equiv3 aut (delta aut s1 x) (delta aut s2 x) intros x.
Sigma: Type
aut: lec22_coinduction.aut Sigma
R: state aut -> state aut -> Prop
bisim_R: bisim aut R
IH: forall s1 s2 : state aut,
R s1 s2 -> equiv3 aut s1 s2
s1, s2: state aut
R_s1_s2: R s1 s2
x: Sigma
equiv3 aut (delta aut s1 x) (delta aut s2 x) apply IH.
Sigma: Type
aut: lec22_coinduction.aut Sigma
R: state aut -> state aut -> Prop
bisim_R: bisim aut R
IH: forall s1 s2 : state aut,
R s1 s2 -> equiv3 aut s1 s2
s1, s2: state aut
R_s1_s2: R s1 s2
x: Sigma
R (delta aut s1 x) (delta aut s2 x)
      destruct (bisim_R s1 s2 R_s1_s2).
Sigma: Type
aut: lec22_coinduction.aut Sigma
R: state aut -> state aut -> Prop
bisim_R: bisim aut R
IH: forall s1 s2 : state aut,
R s1 s2 -> equiv3 aut s1 s2
s1, s2: state aut
R_s1_s2: R s1 s2
x: Sigma
H: accept aut s1 <-> accept aut s2
H0: forall x : Sigma,
R (delta aut s1 x) (delta aut s2 x)
R (delta aut s1 x) (delta aut s2 x) auto.
Qed.

(* equiv3 itself forms a bisimulation *)
Lemma equiv3_bisim {Sigma} (aut : aut Sigma) :
    bisim aut (equiv3 aut).
Sigma: Type
aut: lec22_coinduction.aut Sigma
bisim aut (equiv3 aut)
Proof.
Sigma: Type
aut: lec22_coinduction.aut Sigma
bisim aut (equiv3 aut)
    intros s1 s2 [accept_eq delta_eq].
Sigma: Type
aut: lec22_coinduction.aut Sigma
s1, s2: state aut
accept_eq: accept aut s1 <-> accept aut s2
delta_eq: forall x : Sigma,
equiv3 aut (delta aut s1 x)
  (delta aut s2 x)
(accept aut s1 <-> accept aut s2) /\
(forall x : Sigma,
 equiv3 aut (delta aut s1 x) (delta aut s2 x)) eauto.
Qed.

(* Complete the equivalence between definitions 2 and 3 *)
Lemma equiv32 {Sigma} (aut : aut Sigma) (s1 s2 : state aut) :
    equiv3 aut s1 s2 -> equiv2 aut s1 s2.
Sigma: Type
aut: lec22_coinduction.aut Sigma
s1, s2: state aut
equiv3 aut s1 s2 -> equiv2 aut s1 s2
Proof.
Sigma: Type
aut: lec22_coinduction.aut Sigma
s1, s2: state aut
equiv3 aut s1 s2 -> equiv2 aut s1 s2
    intros Hequiv.
Sigma: Type
aut: lec22_coinduction.aut Sigma
s1, s2: state aut
Hequiv: equiv3 aut s1 s2
equiv2 aut s1 s2
    unfold equiv2.
Sigma: Type
aut: lec22_coinduction.aut Sigma
s1, s2: state aut
Hequiv: equiv3 aut s1 s2
exists R : state aut -> state aut -> Prop,
  bisim aut R /\ R s1 s2
    exists (equiv3 aut).
Sigma: Type
aut: lec22_coinduction.aut Sigma
s1, s2: state aut
Hequiv: equiv3 aut s1 s2
bisim aut (equiv3 aut) /\ equiv3 aut s1 s2
    split; auto.
Sigma: Type
aut: lec22_coinduction.aut Sigma
s1, s2: state aut
Hequiv: equiv3 aut s1 s2
bisim aut (equiv3 aut)
    apply equiv3_bisim.
Qed.