Require Import Coq.Init.Nat.
(* Não deve ser importado nenhum novo arquivo
todas as definições devem estar neste arquivo
*)

(* Teoremas do Induction.v e Basics.v*)

Theorem add_0_r : forall n:nat, n + 0 = n.
Proof.
  intros n. induction n as [| n' IHn'].
  - reflexivity.
  - simpl. rewrite -> IHn'. reflexivity.  Qed.

Theorem add_assoc : forall n m p : nat,
  n + (m + p) = (n + m) + p.
Proof.
  intros n m p.
  induction n.
  - reflexivity.
  - simpl.
    rewrite IHn.
    reflexivity.
Qed.

Theorem add_comm : forall n m : nat,
  n + m = m + n.
Proof.
  intros n m.
  induction n.
  - simpl.
    rewrite add_0_r.
    reflexivity.
  - simpl.
    rewrite <- plus_n_Sm.
    rewrite IHn.
    reflexivity.
Qed.

Theorem add_shuffle3 : forall n m p : nat,
  n + (m + p) = m + (n + p).
Proof.
  intros n m p.
  rewrite add_assoc.
  assert(H: n + m = m + n).
    {rewrite add_comm. reflexivity. }
  rewrite H.
  rewrite add_assoc.
  reflexivity.
Qed.

Lemma mult_n_Sm:
  forall m n: nat,
  n * S m = n + (n * m).
Proof.
  intros m n.
  induction n.
  - simpl.
    reflexivity.
  - simpl.
    rewrite IHn.
    rewrite add_shuffle3.
    reflexivity.
Qed.

Theorem mul_0_r : forall n:nat,
  n * 0 = 0.
Proof.
  induction n as [ | n' IHn].
  - reflexivity.
  - simpl.
    rewrite IHn.
    reflexivity.
Qed.

Theorem mul_comm : forall m n : nat,
  m * n = n * m.
Proof.
  intros m n.
  induction m.
  - rewrite mul_0_r.
    reflexivity.
  - simpl.
    rewrite mult_n_Sm.
    rewrite IHm.
    reflexivity.
Qed.

(*Fim dos Teoremas*)

Fixpoint div2 (n:nat) : nat :=
  match n with
  | O => O
  | S O => O
  | S (S n') => S (div2 n')
end.

Fixpoint sum (n : nat) : nat :=
  match n with
  | O => O
  | S n' => n + sum n'
  end.

Theorem plus_n_1 : forall (n : nat),
  n + 1 = S (n).
Proof.
  intros n.
  induction n.
  - reflexivity.
  - simpl.
    rewrite IHn.
    reflexivity.
Qed.

Theorem plus_n_Sm : forall (n m:nat),
  n + S m = S (n + m).
Proof.
  intros n m.
  induction n.
  - reflexivity.
  - simpl.
    rewrite IHn.
    reflexivity.
Qed.

Theorem mult_2_n_plus : forall (n : nat),
  n + n = 2 * n.
Proof.
  intros n.
  induction n.
  - reflexivity.
  - simpl.
    rewrite add_0_r.
    reflexivity.
Qed.

Theorem mul2_div2 : forall n : nat,
  n = div2 (2 * n).
Proof.
  intros n.
  induction n.
  - reflexivity.
  - rewrite mult_n_Sm.
    simpl.
    rewrite add_0_r.
    rewrite mult_2_n_plus.
    rewrite <- IHn.
    reflexivity.
Qed.

Theorem div2_mult2_plus: forall (n m : nat),
  n + div2 m = div2 (2 * n + m).
Proof.
  intros n m.
  induction n.
  - reflexivity.
  - rewrite mult_n_Sm.
    simpl.
    rewrite add_0_r.
    rewrite mult_2_n_plus.
    rewrite <- IHn.
    reflexivity.
Qed.

Theorem mult_Sn_m : forall (n m : nat),
  S n * m = m + n * m.
Proof.
  intros n m.
  rewrite mul_comm.
  rewrite mult_n_Sm.
  rewrite <- mul_comm.
  reflexivity.
Qed.

Theorem sum_Sn : forall n : nat,
  sum (S n) = S n + sum n.
Proof.
  reflexivity.
Qed.

Theorem sum_n : forall n : nat,
  sum n = div2 (n * (n + 1)).
Proof.
  intros n.
  induction n.
  - reflexivity.
  - rewrite plus_n_1.
    rewrite mult_n_Sm.
    rewrite mult_Sn_m.
    rewrite sum_Sn.
    assert(H: n * S n = S n * n).
    { rewrite mul_comm. reflexivity. }
    rewrite H.
    rewrite mult_Sn_m.
    rewrite add_assoc.
    rewrite mult_2_n_plus.
    rewrite <- div2_mult2_plus.
    rewrite IHn.
    rewrite <- mult_n_Sm.
    rewrite plus_n_1.
    reflexivity.
Qed.


(* A sorting example :
   (C) Yves Bertot, Pierre Casteran
*)

(**
This version uses some new features of Coq : Type Classes and User Defined Relations.

The function called "aux" in the book has been renamed to "insert" and "equiv" has
been renamed to "permutation".
*)

Require Import List  ZArith RelationClasses Morphisms
               Extraction.
Open Scope Z_scope.

Inductive sorted : list Z -> Prop :=
  | sorted0 : sorted nil
  | sorted1 : forall z:Z, sorted (z :: nil)
  | sorted2 :
      forall (z1 z2:Z) (l:list Z),
        z1 <= z2 ->
        sorted (z2 :: l) -> sorted (z1 :: z2 :: l).

#[export] Hint Constructors sorted :  sort.

Lemma sort_2357 :
 sorted (2 :: 3 :: 5 :: 7 :: nil).
Proof.
 auto with sort zarith.
Qed.

(**
  inversion lemma
*)

Theorem sorted_inv :
 forall (z:Z) (l:list Z), sorted (z :: l) -> sorted l.
Proof.
 intros z l H; inversion H; auto with sort.
Qed.

(*  Number of occurrences of z in l *)

Fixpoint nb_occ (z:Z) (l:list Z) {struct l} : nat :=
  match l with
  | nil => 0%nat
  | (z' :: l') =>
      match Z.eq_dec z z' with
      | left _ => S (nb_occ z l')
      | right _ => nb_occ z l'
      end
  end.

Example ex0 : nb_occ 3 (3 :: 7 :: 3 :: nil) = 2%nat.
Proof. reflexivity. Qed.

(* list l' is a permutation of list l *)

Definition permutation (l l':list Z) : Prop :=
    forall z:Z, nb_occ z l = nb_occ z l'.

(* permutation is an equivalence ! *)

Instance permutation_refl : Reflexive permutation.
Proof.
 intro x; red; trivial.
Qed.

Instance  permutation_sym : Symmetric permutation.
Proof.
 intros x y Hxy ; unfold permutation; auto.
Qed.

Instance permutation_trans : Transitive permutation.
Proof.
 intros l l' l'' H H0 z; rewrite H; now apply H0.
Qed.

Lemma permutation_cons :
 forall (z:Z) (l l':list Z), permutation l l' ->
                             permutation (z :: l) (z :: l').
Proof.
 intros z l l' H z'; simpl; case (Z.eq_dec z' z); auto.
Qed.

Instance cons_proper : Proper (eq ==> permutation ==> permutation) (@cons Z).
Proof.
 intros x y Hxy l l' Hll'; subst y; now apply permutation_cons.
Qed.

Lemma permutation_transpose :
 forall (a b:Z) (l l':list Z),
   permutation l l' ->
   permutation (a :: b :: l) (b :: a :: l').
Proof.
 intros a b l l' H z; simpl.
 case (Z.eq_dec z a); case (Z.eq_dec z b);
  simpl; case (H z); auto.
Qed.

#[export] Hint Resolve permutation_cons permutation_refl permutation_transpose : sort.

(* insertion of z into l at the right place
   (assuming l is sorted)
*)

Fixpoint insert (z:Z) (l:list Z)  : list Z :=
  match l with
  | nil => z :: nil
  | cons a l' =>
      match Z_le_gt_dec z a with
      | left _ =>  z :: a :: l'
      | right _ => a :: (insert z l')
      end
  end.

Lemma insert_permutation : forall (l:list Z) (x:Z),
                  permutation (x :: l) (insert x l).
Proof.
 induction l as [|a l0 H]; simpl ; auto with sort.
 -  intros x; case (Z_le_gt_dec x a);
      simpl; auto with sort.
    +  intro H0; apply permutation_trans with (a :: x :: l0);
       auto with sort.
Qed.

Lemma insert_sorted :
 forall (l:list Z) (x:Z), sorted l -> sorted (insert x l).
Proof.
 intros l x H; induction  H; simpl; auto with sort.
 -  case (Z_le_gt_dec x z); simpl;  auto with sort zarith.
 -   revert H H0 IHsorted; simpl;
     case (Z_le_gt_dec x z2) ,  (Z_le_gt_dec x z1);
       simpl; auto with sort zarith.
Qed.

(* the sorting function *)

Definition sort :
  forall l:list Z, {l' : list Z | permutation l l' /\ sorted l'}.
 induction l as [| a l IHl].
 -  exists (nil (A:=Z)); split; auto with sort.
 -  case IHl; intros l' [H0 H1].
    exists (insert a l'); split.
    + transitivity (a::l').
      * now  rewrite H0.
      * apply insert_permutation.
    +  now apply insert_sorted.
Defined.

Extraction "insert-sort" insert sort.


(** Here is an inductively defined proposition describing whether a
    natural number is even. *)
Inductive even : nat -> Prop :=
| even_O : even O
| even_SS : forall n, even n -> even (S (S n)).

Lemma even_4 : even 4.
Proof.
  apply even_SS.
  Show Proof.
  apply even_SS.
  Show Proof.
  apply even_O.
Qed.

Print even_4.

(** Provide a proof term (not a script) for the following propositions. *)
Definition even_8 : even 8
. (* Proof term here *) Admitted.

Definition even_4plusn : forall n, even n -> even (4 + n)
. (* Proof term here *) Admitted.

(* Recall the definition of the inductive types corresponding to
   logical connectives. *)
Print and.

Print or.

(* For the following propositions, provide a proof term. Do not use
   the proof mode and tactics. *)

Definition and_comm : forall P Q, P /\ Q -> Q /\ P
. (* Proof term here *) Admitted.

Definition or_comm : forall P Q, P \/ Q -> Q \/ P
. (* Proof term here *) Admitted.

(* The type of false proposition is the empty type, meaning that there
   is no constructor to build such a proposition. *)
Print False.

(* Use patter-matching over this empty type to define the principle of
   explosion. *)
Definition ex_falso : forall P, False -> P
. (* Proof term here *) Admitted.

(* Inductive proofs correspond to recursive functions. *)

(* Let us first prove the base case and inductive step separately. *)
Definition base_case : 0 = 0 + 0
. (* Proof term here *) Admitted.

(* This proof can be difficult to write, as often with equality-based
   proofs.  Hint: It can be done using only [eq_rect]. *)
Definition inductive_step : forall n, n = n + 0 -> S n = S n + 0
. (* Proof term here *) Admitted.

(** Combine the two lemmas into an inductive proof/recursive
    function. Use [fix] to define the recursion (see presentation), or
    alternatively replace <<Definition>> by <<Fixpoint>>. *)
Definition add_0 : forall n, n = n + 0
. (* Proof term here *) Admitted.

(** Use tactics to define addition over natural numbers, instead of
    writing the term directly. Use the keyword <<Defined>> instead of
    the usual <<Qed>> at the end of your script: This ensures that the
    proof term that you created is transparent (not opaque as proofs
    usually are). *)
Definition add' : nat -> nat -> nat.
Admitted.

(* If your definition is correct, the following lemmas should be
   proved as given. *)
Example ex1 : add' 0 3 = 3.
Proof.
  reflexivity.
Qed.

Example ex2 : add' 2 4 = 6.
Proof.
  reflexivity.
Qed.

Example ex3 : add' 3 8 = 11.
Proof.
  reflexivity.
Qed.


(***********************************************************************)
(* (c) Copyright Microsoft Corporation and Inria. All rights reserved. *)
(*                                                                     *)
(***********************************************************************)
(***********************************************************************)
(*                                                                     *)
(*  Definition of cyclic group                                         *)
(*                                                                     *)
(***********************************************************************)
(***********************************************************************)
Require Import ssreflect ssrbool ssrfun eqtype ssrnat.
Require Import seq fintype div prime.
Require Import finset groups morphisms automorphism normal group_perm zp fp.

(* Require Import paths connect bigops. *)

Set Implicit Arguments.
Unset Strict Implicit.
Import Prenex Implicits.

Section Phi.

(***********************************************************************)
(*                                                                     *)
(*  Euler phi function                                                 *)
(*                                                                     *)
(***********************************************************************)

Definition phi n := #|([eta coprime n] : pred 'I_n)|.

Lemma cardphi : forall p, #|fp_mul_finGroupType p| = (phi p).
Proof.  by move=> p; rewrite card_sub. Qed.

Lemma phi0 : phi 0 = 0.
Proof.
by rewrite /phi eq_card0 //; case; case=> [|n]; case/negP; rewrite ltn0.
Qed.

Lemma phi_mult: forall m n,
  coprime m n -> phi (m * n) = phi m * phi n.
Proof.
move=> m n Hcop.
case: (posnP m) => [-> | mpos]; first by rewrite mul0n phi0 mul0n.
case: (posnP n) => [-> | npos]; first by rewrite muln0 phi0 muln0.
have:= @rho_isom (PosNat mpos) (PosNat npos) Hcop.
by move/isom_card; rewrite !cardsT card_prod !cardphi.
Qed.

Lemma phi_prime_k: forall p k (H:prime p),
  phi (p ^ k.+1) = (p ^ (k.+1)) - (p ^ k).
Proof.
move => p k Hp; have Hp0: (0 < p) by exact: (ltn_0prime Hp).
apply: (canRL (addnK _)); rewrite /phi /= {7}expnS.
have Hf: forall x : fzp (p ^ k), p * x < p * (p ^ k).
  by move => [n1 /= Hn1]; rewrite /= ltn_pmul2l.
pose f (x : fzp (p ^ k)) := Ordinal (Hf x).
have injF: injective f.
  move=> [x Hx] [y Hy] [Hxy]; apply: val_inj => /=.
  by apply/eqP; rewrite -(@eqn_pmul2l p) // Hxy.
rewrite -{1}(card_ord (p ^ k)) -(card_image injF ).
rewrite -{5}(card_ord (p * p ^ k)) addnC.
set a := image _ _; apply: etrans (cardC a); congr addn.
apply: eq_card => [[x Hx]] /=.
rewrite [_ \in _]coprime_pexpl // prime_coprime //=.
suff: p %| x = ~~ predC a (Ordinal Hx) by move=> ->; apply/negPn/idP.
apply/idP/idP.
  move/dvdnP=> [y Dx]; have Hy := Hx.
  rewrite Dx mulnC ltn_pmul2l /= in Hy => //.
  apply/negPn; apply/imageP.
  exists (Ordinal Hy) => //.
  by rewrite /f /=; apply: val_inj; rewrite /= mulnC.
move/negPn; move/imageP=> [y Hy]; rewrite/f; move/eqP=> /= HH.
by apply/dvdnP; exists (nat_of_ord y); rewrite mulnC; apply/eqP.
Qed.

End Phi.

(***********************************************************************)
(*                                                                     *)
(*  Cyclic group                                                       *)
(*                                                                     *)
(***********************************************************************)

Import GroupScope.

Section Cyclic.

Variable gT : finGroupType.
Implicit Types a x y : gT.
Implicit Types A B : {set gT}.
Implicit Types G H : {group gT}.

Definition cyclic A := existsb x, A == <[x]>.

Lemma cyclicP : forall A, reflect (exists x, A = <[x]>) (cyclic A).
Proof. move=> A; apply: (iffP existsP) => [] [x]; exists x; exact/eqP. Qed.

Lemma cycle_cyclic : forall x, cyclic <[x]>.
Proof. by move=> x; apply/cyclicP; exists x. Qed.

Lemma cycle1 : <[1]> = 1 :> {set gT}.
Proof. by apply/eqP; rewrite eqEsubset gen_subG !sub1G. Qed.

Lemma cycle_id : forall a, a \in <[a]>.
Proof. by move=> a; rewrite mem_gen // set11. Qed.

Lemma cycle_subG : forall a H, (<[a]> \subset H) = (a \in H).
Proof. by move=> a H; rewrite gen_subG sub1set. Qed.

Lemma mem_cycle : forall a m, a ^+ m \in <[a]>.
Proof. by move=> a m; rewrite groupX // cycle_id. Qed.

Definition zp_to_cycle n a (i : 'I_n) := a ^+ i.

Lemma zp_to_cycleM : forall (n : pos_nat) a, a ^+ n = 1 ->
  {in setT &, {morph @zp_to_cycle n a : x y / x * y}}.
Proof.
rewrite /zp_to_cycle => n a an_1 [i _] [j _] _ _ /=; rewrite -expgn_add.
by rewrite {2}(divn_eq (i + j) n) expgn_add mulnC expgn_mul an_1 exp1gn mul1g.
Qed.

Lemma order1 : #[1 : gT] = 1%N.
Proof. by rewrite /order cycle1 cards1. Qed.

Lemma order_inf : forall a n, a ^+ n.+1 == 1 -> #[a] <= n.+1.
Proof.
move=> a [|n]; move/eqP; first by rewrite expg1 => ->; rewrite order1.
move/zp_to_cycleM=> zpM; rewrite -[n.+2]card_ord -cardsT.
apply: leq_trans (subset_leq_card _) (leq_imset_card (Morphism zpM) _).
rewrite -morphimEdom gen_subG sub1set /= morphimEdom /=.
apply/imsetP; exists (inord 1 : 'I_n.+2); first exact: in_setT.
by rewrite /zp_to_cycle inordK // expg1.
Qed.

Lemma zp_to_cycle_inj : forall a, injective (@zp_to_cycle #[a] a).
Proof.
move=> a i j; wlog ltij : i j / i < j.
  by case (ltngtP i j); [|symmetry|move/val_inj]; auto.
move/eqP; rewrite eq_mulVg1 /zp_to_cycle -(subnK ltij) addSnnS expgn_add mulKg.
move/order_inf; rewrite -leq_subS // subSS leqNgt; case/negP.
exact: leq_ltn_trans (leq_subr i j) _.
Qed.

Lemma zp_to_cycle_imset :  forall a, @zp_to_cycle #[a] a @: setT = <[a]>.
Proof.
move=> a; apply/eqP; rewrite eqEcard andbC.
rewrite (card_imset _ (@zp_to_cycle_inj a)) cardsT card_ord leqnn.
by apply/subsetP=> x; case/imsetP=> i _ ->; rewrite mem_cycle.
Qed.

Lemma cyclePmin : forall a b,
  reflect (exists2 m, m < #[a] & a ^+ m = b) (b \in <[a]>).
Proof.
move=> a b; rewrite -zp_to_cycle_imset.
apply: (iffP imsetP) => [[m] | [m ltma <-]]; first by exists (m : nat).
by exists (Ordinal ltma); rewrite ?inE.
Qed.

Lemma cycleP : forall a b, reflect (exists n, a ^+ n = b) (b \in <[a]>).
Proof.
move=> a b; apply: (iffP idP) => [|[n <-]]; last exact: mem_cycle.
by case/cyclePmin=> n; exists n.
Qed.

Lemma order_expn1 : forall a, a ^+ #[a] = 1.
Proof.
move=> a; have: a^-1 \in <[a]> by rewrite groupV cycle_id.
case/cyclePmin=> i; rewrite leq_eqVlt=> ltia a_i.
have{a_i} a_i1: a ^+ i.+1 = 1 by rewrite expgS a_i mulgV.
case/predU1P: ltia => [<- //| lti1a].
by have:= @zp_to_cycle_inj a (Ordinal lti1a) ord0 a_i1.
Qed.

Canonical Structure zp_to_cycle_morphism a :=
  Morphism (zp_to_cycleM (order_expn1 a)).

Lemma zp_to_cycle_injm : forall a, 'injm (@zp_to_cycle #[a] a).
Proof.
by move=>a; apply/injmP; move=> x y _ _; apply:zp_to_cycle_inj.
Qed.

Lemma cycle_isom : forall a, isom setT  <[a]> (@zp_to_cycle #[a] a).
Proof.
move=> a; apply/isomP; split; last by rewrite morphimEdom zp_to_cycle_imset.
apply/injmP; apply: in2W; exact: zp_to_cycle_inj.
Qed.

Lemma cycle_decomp : forall a b,
  b \in <[a]> -> {m : nat | m < #[a] & a ^+ m = b}.
Proof.
move=> a b Cab; have ex_i: exists i, a ^+ i == b.
  by case/cycleP: Cab => i <-; exists i.
exists (ex_minn ex_i); case: ex_minnP => i a_i min_i; last exact/eqP.
case/cyclePmin: Cab => j ltja a_j; apply: leq_ltn_trans ltja.
by rewrite min_i // a_j.
Qed.

(***********************************************************************)
(*                                                                     *)
(*        Order Properties (1/2)                                       *)
(*                                                                     *)
(***********************************************************************)

Lemma cycleJ : forall a b, <[a ^ b]> = <[a]> :^ b.
Proof. by move=> a b; rewrite -genJ conjg_set1. Qed.

Lemma orderJ : forall a b, #[a ^ b] = #[a].
Proof. by move=> a b; rewrite /order cycleJ cardJg. Qed.

Lemma expg_mod_order : forall a k, a ^+ k = a ^+ (k %% #[a]).
Proof.
move=> a k; rewrite {1}(divn_eq k #[a]) expgn_add mulnC expgn_mul.
by rewrite order_expn1 exp1gn mul1g.
Qed.

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

Lemma commute_cycle_com : forall a b : gT,
  commute a b -> {in <[a]>, centralised <[b]>}.
Proof.
move=> a b Hcom x; case/cycleP=> kx <-{x} y; case/cycleP=> ky <- {y}.
exact: commuteX2.
Qed.

Lemma commute_cycle_normal : forall a b : gT,
  commute a b -> <[a * b]> \subset 'N(<[a]>).
Proof.
move=> a b Hcom; apply: cents_norm.
apply/centsP; apply: commute_cycle_com.
apply: commute_sym; exact: commuteM.
Qed.

Lemma commute_cycle_sub : forall a b : gT,
  commute a b -> coprime #[a] #[b] -> <[a]> \subset <[a * b]>.
Proof.
move=> a b c_ab; move/eqnP=> co_ab; apply/subsetP=> x; case/cycleP=> k <-{x}.
case: (egcdnP #[a] (ltn_0order b))=> kb ka Heq Hineq.
apply/cycleP; exists (kb * #[b] * k)%N.
rewrite (expMgn _ c_ab) {2}(mulnC kb) -(mulnA #[b]).
rewrite (expgn_mul b #[b]) order_expn1 exp1gn mulg1.
rewrite Heq gcdnC co_ab muln_addl mul1n expgn_add -(mulnC #[a]).
by rewrite -(mulnA #[a]) expgn_mul order_expn1 exp1gn mul1g.
Qed.

Lemma cycle_mul : forall (a b : gT),
  commute a b -> coprime #[a] #[b] -> <[a * b]> = <[a]> * <[b]>.
Proof.
move=> a b c_ab co_ab; apply/eqP; rewrite eqEcard coprime_cardMg //.
have ->: <[a * b]> \subset <[a]> * <[b]>.
  have CaCb := cent_mulgenEl (introT centsP (commute_cycle_com c_ab)).
  by rewrite -CaCb gen_subG sub1set /= CaCb mem_mulg ?cycle_id.
rewrite dvdn_leq ?ltn_0order // gauss_inv //=.
by rewrite {2}c_ab !cardSg // commute_cycle_sub // coprime_sym.
Qed.

(***********************************************************************)
(*                                                                     *)
(*        Bijection with Zp                                            *)
(*                                                                     *)
(***********************************************************************)

Lemma decomp_irr : forall a b (x y : {m | (m < #[a]) && (a ^+ m == b)}),
  x = y.
Proof.
move=> a b x y; apply: val_inj; wlog: x y / val x < val y.
  by move=> IH; case: (ltngtP (val x) (val y)) => // *; last symmetry; auto.
case: x => m /=; case/andP=> _; case: y => n /=; case/andP=> lt_n_oa.
move/eqP <-; rewrite eq_mulVg1 => eq1 ltmn; move: eq1.
rewrite -{1}(subnK ltmn) addSnnS expgn_add mulKg; move/order_inf.
by rewrite leqNgt (leq_trans _ lt_n_oa) // -leq_subS // ltnS subSS leq_subr.
Qed.

Lemma decomp_order_unicity :  forall a m (lt_m_oa : m < #[a]) n,
  (n < #[a]) && (a ^+ n == a ^+ m) -> m = n.
Proof.
move=> a m; rewrite -[m < _]andbT -(eqxx (a ^+ m)) => def_m n def_n.
by case: (decomp_irr (Sub m def_m) (Sub n def_n)).
Qed.

Lemma imset_zp_to_cycle : forall a, <[a]> \subset (zp_to_cycle a @* setT).
Proof. by move=> a; rewrite -zp_to_cycle_imset morphimEdom. Qed.

Definition cycle_to_zp (a: gT) :=
  restrm (imset_zp_to_cycle a) (invm (zp_to_cycle_injm a)).

Lemma cycle_to_zp_id : forall a n,
   n %% #[a] = cycle_to_zp a (a ^+ n).
Proof.
move=> a n; move :(ltn_0order a); rewrite expg_mod_order -(ltn_mod n #[a]) => H.
rewrite -/(nat_of_ord (Ordinal H)).
by rewrite -{1}(invmE (zp_to_cycle_injm a) (in_setT (Ordinal H))).
Qed.

Lemma cycle_to_zp_corr : forall a b,
  b \in <[a]> -> a ^+ (cycle_to_zp a b) == b.
Proof.
move=> a b; rewrite -zp_to_cycle_imset; move/imsetP => [n Hn ->].
by rewrite -{2}(invmE (zp_to_cycle_injm a) Hn).
Qed.

Lemma zp_inj : forall a, 'injm ([morphism of cycle_to_zp a]).
Proof. by move=> a /=; apply: (injm_restrm _ (injm_invm _)). Qed.

Lemma zp_isom : forall a, isom <[a]> setT ([morphism of cycle_to_zp a]).
Proof.
move=> a; apply/isomP; split; first exact: zp_inj.
by rewrite /= morphim_restrm setIid -zp_to_cycle_imset -morphimEdom invm_dom.
Qed.

(***********************************************************************)
(*                                                                     *)
(*        Order properties  (2/2)                                      *)
(*                                                                     *)
(***********************************************************************)

Lemma order_dvd : forall a n, (#[a] %| n) = (a ^+ n == 1).
Proof.
move=> a n; rewrite expg_mod_order /dvdn; apply/idP/idP.
  by move/eqP->; rewrite expg0.
rewrite -(expg0 a); move : (ltn_0order a); rewrite -(ltn_mod n)=> H.
by move/(conj H); move/andP; move/(decomp_order_unicity (ltn_0order a))=> <-.
Qed.

Lemma order_eq1 : forall a, (#[a] == 1%N) = (a == 1).
Proof. by move=> a; rewrite -dvdn1 order_dvd expg1. Qed.

Lemma cycle_eq1 : forall a, (<[a]> == 1) = (a == 1).
Proof. by move=> a; rewrite -order_eq1 trivg_card1. Qed.

Lemma order_dvd_g : forall (H : {group gT}) a, a \in H -> #[a] %| #|H|.
Proof. by move=> H a Ha; apply: cardSg; rewrite cycle_subG. Qed.

Lemma order_gexp_dvd : forall a n, #[a ^+ n] %| #[a].
Proof. move=> a n; apply: order_dvd_g; exact: mem_cycle. Qed.

Lemma order_gcd : forall a n, 0 < n -> #[a ^+ n] = #[a] %/ gcdn #[a] n.
Proof.
move => a n H.
apply/eqP; rewrite eqn_dvd; apply/andP; split.
  rewrite order_dvd -expgn_mul -gcdn_divnC //.
  by rewrite expgn_mul order_expn1 exp1gn.
suff: #[a] %| #[a ^+ n] * gcdn #[a] n.
  move: (dvdn_gcdl #[a] n) (divn_eq #[a] (gcdn #[a] n)).
  rewrite {1}/dvdn; move/eqP=> H1; rewrite {1}H1 addn0=> {H1} H1.
  by rewrite {1}H1 dvdn_pmul2r // ltn_0gcd H orbT.
rewrite order_dvd mulnC expgn_mul -[a ^+ _]mulg1.
case: (egcdnP #[a] H)=> z2 z1 H1 H2.
rewrite -{1}(@exp1gn _ z1) -{1}(order_expn1 a) -expgn_mul.
rewrite mulnC -expgn_add addnC gcdnC -H1 -expgn_mul -mulnA mulnC.
by rewrite 2!expgn_mul order_expn1 exp1gn.
Qed.

Lemma order_mul : forall a b : gT,
  commute a b -> coprime #[a] #[b] -> #[a * b] = (#[a] * #[b])%N.
Proof.
by move=> a b Hcom Hcop; rewrite -coprime_cardMg -?cycle_mul.
Qed.

Lemma eq_expg_mod_order : forall x m n,
  (x ^+ m == x ^+ n) = (m == n %[mod #[x]]).
Proof.
move=> x m n; wlog le_nm: m n / n <= m.
  by move=> IH; case/orP: (leq_total m n); move/IH; rewrite // eq_sym => ->.
rewrite eqn_mod_dvd // -{1}(subnK le_nm) expgn_add.
by rewrite (can2_eq (mulKg _) (mulKVg _)) mulVg order_dvd.
Qed.

(***********************************************************************)
(*                                                                     *)
(*        Generator                                                    *)
(*                                                                     *)
(***********************************************************************)

Definition generator (A : {set gT}) a := A == <[a]>.

Lemma generator_cycle : forall a, generator <[a]> a.
Proof. by move=> a; exact: eqxx. Qed.

Lemma cycle_generator : forall a x, generator <[a]> x -> x \in <[a]>.
Proof. move=> a x; move/(<[a]> =P _)->; exact: cycle_id. Qed.

Lemma generator_order : forall a b,
  generator <[a]> b -> #[a] = #[b].
Proof. by rewrite /order => a b; move/(<[a]> =P _)->. Qed.

Lemma cycle_subset : forall a n, <[a ^+ n]> \subset <[a]>.
Proof. move=> a n; rewrite cycle_subG; exact: mem_cycle. Qed.

Lemma cycleV : forall a, <[a^-1]> = <[a]>.
Proof.
move=> a; symmetry; apply/eqP; rewrite eqEsubset.
by rewrite !cycle_subG // -2!groupV invgK !cycle_id.
Qed.

Lemma orderV : forall x, #[x^-1] = #[x].
Proof. by move=> x; rewrite /order cycleV. Qed.

End Cyclic.

Section CyclicSubGroup.

Variable gT : finGroupType.

(*  G. 1.3.1 (i) *)

Lemma cycle_sub_group : forall (a : gT) m, m %| #[a] ->
  [set H : {group gT} | (H \subset <[a]>) && (#|H| == m)]
     = [set <[a ^+ (#[a] %/ m)]>%G].
Proof.
move=> a m Hdiv.
have Hpos: 0 < m by apply (ltn_0dvd (ltn_0order a) Hdiv).
have Hcardm: #|<[a ^+ (#[a] %/ m)]>| == m.
  have Hdivpos: 0 < #[a] %/ m by
    rewrite -(ltn_pmul2r Hpos) mul0n (divnK Hdiv) ltn_0order.
  rewrite [card ( _)](order_gcd _ Hdivpos).
  rewrite {2}(divn_eq #[a] m) mulnC; move:{+}Hdiv; rewrite /dvdn.
  move/eqP->; rewrite gcdnC gcdn_addl_mul gcdn0.
  rewrite -{2}(@mulKn m (#[a] %/ m)) ?Hdivpos //=.
  by rewrite (divnK Hdiv) eqxx.
apply/eqP; rewrite eqEsubset sub1set inE /= cycle_subset Hcardm !andbT.
apply/subsetP=> X; rewrite in_set1 inE -val_eqE /= eqEcard (eqP Hcardm).
case/andP=> sXa; move/eqP=> oX; rewrite oX leqnn andbT.
apply/subsetP=> x Xx; case/cycleP: (subsetP sXa _ Xx) => k def_x.
have: (x ^+ m == 1)%g by rewrite -oX -order_dvd cardSg // gen_subG sub1set.
rewrite -def_x -expgn_mul -order_dvd -[#[a]](LaGrange sXa) -oX mulnC.
rewrite dvdn_pmul2r // mulnK //; case/dvdnP=> i ->{def_x k}.
by rewrite mulnC expgn_mul groupX // cycle_id.
Qed.

Lemma cycle_subgroup_char : forall a (H : {group gT}),
  H \subset <[a]> -> H \char <[a]>.
Proof.
move=> a H sHa; apply: lone_subgroup_char => // J sJa isoJH.
have dvHa: #|H| %| #[a] by exact: cardSg.
have{dvHa} Huniq := esym (cycle_sub_group dvHa).
move/setP: Huniq => Huniq; move: (Huniq H) (Huniq J); rewrite !inE /=.
by rewrite sHa sJa (isog_card isoJH) eqxx; do 2!move/eqP <-.
Qed.

End CyclicSubGroup.

Section MorphicImage.

Variables aT rT : finGroupType.
Variables (D : {group aT}) (f : {morphism D >-> rT}) (x : aT).
Hypothesis Dx : x \in D.

Lemma morphim_cycle : f @* <[x]> = <[f x]>.
Proof. by rewrite morphim_gen (sub1set, morphim_set1). Qed.

Lemma morph_order : #[f x] %| #[x].
Proof. by rewrite order_dvd -morphX // order_expn1 morph1. Qed.

End MorphicImage.

Section CyclicProps.

Variables gT : finGroupType.
Implicit Types G H K : {group gT}.
Implicit Type rT : finGroupType.

Lemma cyclicS : forall G H, H \subset G -> cyclic G -> cyclic H.
Proof.
move=> G H HsubG; case/cyclicP=> x gex; apply/cyclicP.
exists (x ^+ (#[x] %/ #|H|)); apply: congr_group; apply/set1P.
by rewrite -cycle_sub_group /order -gex ?cardSg // inE HsubG eqxx.
Qed.

Lemma cyclicJ:  forall (G : {group gT}) x, cyclic (G :^ x) = cyclic G.
Proof.
move=> G x; apply/cyclicP/cyclicP=> [[y] | [y ->]].
  by move/(canRL (conjsgK x)); rewrite -cycleJ; exists (y ^ x^-1).
by exists (y ^ x); rewrite cycleJ.
Qed.

Lemma cyclic_morphim :  forall rT G H (f : {morphism G >-> rT}),
  cyclic H -> cyclic (f @* H).
Proof.
move=> rT G H f cH; wlog sHG: H cH / H \subset G.
  by rewrite -morphimIdom; apply; rewrite (cyclicS _ cH, subsetIl) ?subsetIr.
case/cyclicP: cH sHG => x ->; rewrite gen_subG sub1set => Gx.
by apply/cyclicP; exists (f x); rewrite morphim_cycle.
Qed.

Lemma isog_cyclic :
  forall rT G (H : {group rT}), G \isog H -> cyclic G -> cyclic H.
Proof.
move=> rT G H; move/isog_symr; case/isogP=> f injf <- Cf.
by rewrite -(morphim_invm injf (subxx _)) cyclic_morphim.
Qed.

Lemma isog_cyclic_card : forall  rT G (H : {group rT}),
  cyclic G -> isog G H = cyclic H && (#|H| == #|G|).
Proof.
move=> rT G H cG; apply/idP/idP=> [isoHG | ].
  by rewrite (isog_card isoHG) eqxx (isog_cyclic isoHG).
case/cyclicP: cG => x ->{G}; case/andP; case/cyclicP=> y ->{H}; move/eqP=> oy.
apply: isog_trans (isog_symr _) (isom_isog _ (subxx _) (cycle_isom y)).
move/(@val_inj _ _ pos_nat_subType): (oy : #[y] = #[x])->.
exact: (isom_isog _ (subxx _) (cycle_isom x)).
Qed.

Lemma quotient_cycle : forall x H, x \in 'N(H) -> <[x]> / H = <[coset H x]>.
Proof. move=> x H; exact: morphim_cycle. Qed.

Lemma quotient_cyclic : forall G H, cyclic G -> cyclic (G / H).
Proof. move=> G H; exact: cyclic_morphim. Qed.

Lemma cyclic_prime: forall G, prime #|G| -> cyclic G.
Proof.
move=> G pG; case: (pickP (mem G^#)) => [x Hx| Hx]; last first.
  by move: pG; rewrite (cardsD1 1 G) group1 (eq_card0 Hx).
move: (Hx); rewrite /= in_setD1; case/andP => xD1; rewrite -cycle_subG=> xIG.
case/primeP: pG => _; move/(_ _ (cardSg xIG)); case/orP;  move/eqP.
  by rewrite (cardsD1 1) (cardsD1 x) group1 in_setD1 xD1 cycle_id.
move=> CxG; apply/cyclicP; exists x.
by apply/eqP; rewrite eq_sym eqEcard // CxG leqnn andbT.
Qed.

End CyclicProps.

(***********************************************************************)
(*                                                                     *)
(*       Automorphisms of cyclic groups                                *)
(*                                                                     *)
(***********************************************************************)

Section CyclicAutomorphism.

Variables gT1 gT2 : finGroupType.

Variable f : {perm gT1}.

Lemma cycle_aut_stable : forall x, f \in Aut <[x]> -> f @: <[x]> = <[f x]>.
Proof.
move=> x autf; rewrite -(autmE autf) -morphimEdom morphim_cycle //.
exact: cycle_id.
Qed.

Lemma order_aut_stable : forall x, f \in Aut <[x]> -> #[x]  = #[f x].
Proof.
move=> x autf; rewrite /order -cycle_aut_stable ?card_imset //.
exact: perm_inj.
Qed.

(* From the multiplicative group to automorphisms *)

Lemma cycle_gexpn_clos : forall (x : gT1) k,
  (expgn^~ k) @: <[x]> \subset <[x]>.
Proof.
move=> x k; apply/subsetP=> a; case/imsetP=> y; case/cycleP=> n <- -> {a y}.
by rewrite -expgn_mul mem_cycle.
Qed.

Lemma cycle_dcan_gexpn : forall (a : gT1) k, coprime #[a] k ->
  exists g, {in <[a]>, cancel (expgn^~ k) g}.
Proof.
move=> a k; case Hpos: (0 < k) => Hcop; last first.
  move: Hcop; move/idPn: Hpos; rewrite -eqn0Ngt; move/eqP->.
  rewrite coprime_sym /coprime gcd0n /order => Hcard.
  have Heq: (1%g : {set gT1}) =i <[a]>.
    apply/subset_cardP; last by rewrite sub1set; apply:group1.
    by move/eqP:Hcard->; rewrite cardsE card1.
  by exists (@id gT1) => x; rewrite expg0 //= -(Heq x); move/set1P=> <-.
case: (bezoutl #[a] Hpos); move=> x xinf.
rewrite coprime_sym /coprime in Hcop; move/eqP: Hcop->; move/dvdnP=> [k0 Hk0].
exists (fun z:gT1 => z ^+ k0)%g; move=> x0 Hx0 //=.
rewrite -expgn_mul mulnC -Hk0 expgn_add mulnC; case/cycleP: Hx0 => i <-.
by rewrite expg1 -!expgn_mul mulnCA expgn_mul order_expn1 exp1gn mulg1.
Qed.

Lemma inj_gexpn : forall (a : gT1) k,
  coprime #[a] k -> {in <[a]> &, injective (expgn^~ k)}.
Proof.
move=> k a Hcop; move: (cycle_dcan_gexpn Hcop)=> [g dcan].
by apply (can_in_inj dcan).
Qed.

Definition cycle_expgm of gT1 := fun k x => x ^+ k : gT1.

Lemma cycle_expgm_morphM : forall a k,
  {in <[a]> &, {morph cycle_expgm a k : x y / x * y}}.
Proof.
move=> a k x y cax cay; apply: expMgn; exact: commute_cycle_com cay.
Qed.

Canonical Structure cycle_expgm_morphism a k :=
  Morphism (@cycle_expgm_morphM a k).

Lemma cycle_expgm_inj : forall a k, coprime #[a] k -> 'injm (cycle_expgm a k).
Proof. move=> a k coak; apply/injmP; exact: inj_gexpn. Qed.

Lemma cycle_expgm_on : forall a k, coprime #[a] k ->
  cycle_expgm a k @* <[a]> = <[a]>.
Proof.
move=> a k coak; apply/morphim_fixP=> //; first exact: cycle_expgm_inj.
by rewrite morphimEdom cycle_gexpn_clos.
Qed.

Definition cycle_aut a k (coak : coprime #[a] k) :=
  aut (cycle_expgm_inj coak) (cycle_expgm_on coak).

End CyclicAutomorphism.

(***********************************************************************)
(*                                                                     *)
(*        Bijection with Fp                                            *)
(*                                                                     *)
(***********************************************************************)

Section FpAut.

Variable gT:finGroupType.

Definition fp_to_cycle (x : gT) :=
  fun (D : fp_mul #[x]) => cycle_aut (valP D).

Lemma fp_to_cycleM : forall x:gT,
  {in setT &, {morph @fp_to_cycle x : n m / n * m}}.
Proof.
move=> x n m Hn Hm; apply/permP.
move=> z; rewrite permM !permE; case e:(z \in <[x]>%G); last by rewrite e.
move/cyclePmin : e =>[k Hk <-]; rewrite /= /cycle_expgm -!expgn_mul mem_cycle.
by apply/eqP; rewrite eq_expg_mod_order -modn_mulml modn_mulmr modn_mulml mulnA.
Qed.

Canonical Structure fp_to_cycle_morphism x :=
  Morphism (@fp_to_cycleM x).

Lemma fp_to_cycle_injm : forall x:gT, 'injm (@fp_to_cycle x).
Proof.
move=> x; apply/injmP=> y1 y2 _ _; move/permP; move/(_ x); move/eqP.
rewrite /=  !autE ?cycle_id //=; move/(conj (valP (sval y1))); move/andP.
move/(decomp_order_unicity (valP (sval y2)))=> /= Heq.
by apply:val_inj; apply:val_inj => /=; rewrite Heq.
Qed.

Lemma cycle_to_fp_loc_corr : forall (f : {perm gT}) (x : gT),
  f \in Aut <[x]> -> coprime #[x] (cycle_to_zp x (f x)).
Proof.
move=> f x autf /=; set n := cycle_to_zp x (f x).
have Hfx: f x \in <[x]>.
  by rewrite -[<[x]>](autm_dom autf) mem_imset // setIid cycle_id.
have:= cycle_to_zp_corr Hfx; rewrite eq_sym -/n.
case: (posnP n) => [-> {n} | npos Hn].
  rewrite -{3}(permK f x); move/eqP->.
  by rewrite -groupV in autf; rewrite -(autmE autf) morph1 order1.
have: gcdn #[x] n <= 1.
  rewrite leqNgt; apply/negP=> Hgcd; have:= ltn_Pdiv Hgcd (ltn_0order x).
  rewrite ltn_neqAle; move: (order_gcd x npos); rewrite -(eqP Hn).
  move/eqP; rewrite -(order_aut_stable autf); move/eqP=> Hg.
  by rewrite {3}Hg eqxx andFb.
by rewrite leq_eqVlt orbC ltnNge ltn_0gcd npos ltn_0group.
Qed.

Lemma cycle_to_fp_loc_repr : forall (f : {perm gT}) x,
  f \in Aut <[x]> ->
 (forall z, z \in <[x]> -> f z = z ^+ (cycle_to_zp x (f x)))%g.
Proof.
move=> f x autf; have Cxx := cycle_id x.
move=> z; case/cycleP=> n <- {z}; rewrite -{1}(autmE autf) morphX //=.
have Cfx: f x \in <[x]>.
  by rewrite -[<[x]>](autm_dom autf) mem_imset // setIid.
by rewrite -expgn_mul mulnC expgn_mul (eqP (cycle_to_zp_corr Cfx)).
Qed.

Lemma fp_to_cycle_imset : forall x:gT, ((@fp_to_cycle x) @* setT) = (Aut <[x]>).
Proof.
move=> x; apply/eqP; rewrite eqEsubset; apply/andP; split.
  by apply/subsetP=> /= k; move/morphimP=> [[k0 Hk0] _ _ ->]; apply: Aut_aut.
apply/subsetP=> f Haut.
apply/morphimP.
pose kk : fp_mul #[x] := (Sub (cycle_to_zp x (f x)) (cycle_to_fp_loc_corr Haut)).
exists kk; rewrite ?in_setT //=; apply/permP=> z; rewrite permE.
case eax : (z \in <[x]>); first by rewrite (cycle_to_fp_loc_repr Haut eax).
by clear kk; move: Haut; rewrite inE; case/andP; move/out_perm->; rewrite ?eax.
Qed.

Lemma imset_fp_to_cycle : forall a,Aut <[a]> \subset ( (@fp_to_cycle a) @* setT).
Proof.
by move=> a; rewrite -fp_to_cycle_imset morphimEdom.
Qed.

Definition cycle_to_fp (a: gT) :=
  restrm (imset_fp_to_cycle a) (invm (fp_to_cycle_injm a)).

Lemma fp_inj : forall x : gT, 'injm [morphism of cycle_to_fp x].
Proof.
move=> x; move: (injm_invm (fp_to_cycle_injm x)); rewrite /=.
by rewrite /ker /morphpre; rewrite {1}(fp_to_cycle_imset x); apply.
Qed.

Lemma fp_isom : forall a : gT, isom (Aut <[a]>) setT (cycle_to_fp a).
Proof.
move=> a; apply/isomP; split; first exact: fp_inj.
apply/setP=> x; rewrite inE morphimEdom.
apply/imsetP; exists (fp_to_cycle x); first exact: Aut_aut.
by rewrite /= /restrm invmE ?in_setT.
Qed.

End FpAut.

(***********************************************************************)
(*                                                                     *)
(*       Automorphism with Zp, consequences on generators              *)
(*                                                                     *)
(***********************************************************************)

Section GenAut.

Variables aT rT : finGroupType.

Lemma generator_bij : forall (G H : {group aT}) (f : {morphism G >-> rT}) a,
   'injm f -> H \subset G -> a \in G ->
    generator H a = generator (f @* H) (f a).
Proof.
move=> G H f a injf sHG Ga.
rewrite /generator -morphim_cycle // !eqEsubset.
by rewrite !morphimSGK //= ?(subset_trans injf, sub1G, cycle_subG).
Qed.

End GenAut.

Section ZpAut.

Variable gT : finGroupType.
Variable a : gT.

Lemma expgn_muln : forall k (n : pos_nat) p (H : p < n),
  Ordinal H ^+ k = Ordinal (ltn_pmod (p * k) (valP n)).
Proof.
elim=> [|k IH] n p H; apply: val_inj=> //=; first by rewrite muln0 modn_small.
by rewrite expgS IH //= modn_addmr -{1}(muln1 p) -muln_addr add1n.
Qed.

Lemma zp_group_cycle : forall (n : pos_nat) k (lt_k_n : k < n),
  coprime k n -> setT = <[Ordinal lt_k_n]>.
Proof.
move=> n k H Hcop; symmetry; apply/setP; apply/subset_eqP; apply/andP.
split; first by apply/subsetP=> x //= Hx ; rewrite inE.
apply/subsetP; move=> x _ /=; apply/cycleP; move: k H Hcop x.
case=> [|k] H Hcop /= x0.
  rewrite /coprime gcd0n in Hcop; exists 1%N; move: (valP x0).
  move/eqP:Hcop=> Hn; rewrite {3}Hn !ltnS !leqn0; move/eqP => H0.
  by apply: val_inj; rewrite /= addn0 /= H0 modn_small.
case: (egcdnP n (ltn0Sn k))=> kk kn Heq Hineq.
exists (kk * x0)%N; rewrite /= expgn_muln; apply: val_inj => /=.
rewrite mulnA (mulnC (k.+1)) Heq muln_addl -(mulnA kn) (mulnC n) mulnA.
move: Hcop; rewrite modn_addl_mul /coprime; move/eqP->.
by rewrite mul1n modn_small.
Qed.

Lemma zp_ord : forall (n : pos_nat) (i : zp_group n),
  i = Ordinal (valP (i : 'I_n)).
Proof. by move=> n i; apply: val_inj. Qed.

Lemma zp_gen : forall (n : pos_nat) (i : 'I_n),
  generator setT i = coprime i n.
Proof.
move=> n i; apply/idP/idP; last first.
  move=> Hcop; apply/eqP.
  apply:zp_group_cycle=> /=; by [apply: (valP (i : 'I_n)) | apply: Hcop].
move/(setT =P _)=> Hcop.
case e: (0 < (i : 'I_n)).
  apply:modn_coprime; first exact: (idP e).
  have H1: (1 < n) by apply: leq_ltn_trans (valP (i : 'I_n)); apply:(idP e).
  have: Ordinal H1 \in <[i]> by rewrite -Hcop inE.
  by case/cycleP=> n1; rewrite (zp_ord i) expgn_muln /=; case; exists n1.
move/negbT:e; rewrite lt0n negbK; move/eqP=> i0.
have i1 : i = 1 by exact: val_inj.
by rewrite i0 -(card_ord n) -cardsT Hcop i1 cycle1 cards1.
Qed.

Lemma generator_coprime : forall m,
  coprime m #[a] = generator <[a]> (a ^+ m).
Proof.
move=> m; rewrite (generator_bij (zp_inj a));
rewrite /= ?morphimEdom ?zp_to_cycle_imset ?mem_cycle //=.
move: (zp_isom a); case/isomP => _ /=.
rewrite -morphimEdom => ->; rewrite /coprime -gcdn_modl.
have Hmod: m %% #[a] < #[a] by rewrite ltn_mod (ltn_0order a).
have:= @zp_gen [is #[a] : _ <: pos_nat] (Ordinal Hmod).
rewrite /= /coprime => <-; congr generator; apply: val_inj=> /=.
by rewrite cycle_to_zp_id.
Qed.

Lemma phi_gen : phi #[a] = #|[pred x | generator <[a]> x]|.
Proof.
rewrite /phi /=; set n := #[a].
have: [pred x : 'I_n | coprime n x] =i
      [pred x : 'I_n | generator <[a]> (a ^+ x)].
  by move=> x /=; rewrite !inE /= -generator_coprime coprime_sym.
move/eq_card=> ->.
suff: (image (cycle_to_zp a) (generator <[a]>)) =i
        [pred x : 'I_n | generator <[a]> (a ^+ x)].
  move/eq_card <-; apply: card_dimage; move/injmP: (zp_inj a).
  apply:sub_in2; exact: cycle_generator.
move=> /= x; apply/imageP/idP; rewrite inE /=.
  move=> [x0 Hx0 ->]; move: (cycle_generator Hx0); move/cycle_to_zp_corr.
  by move/eqP; rewrite /cycle_to_zp /= => ->.
move=> Hgen; exists (a ^+ x)%g; first by trivial.
apply: val_inj; rewrite /cycle_to_zp /=.
move: (cycle_to_zp_corr (cycle_generator Hgen)); rewrite eq_sym.
move/(conj (valP x))=> /=; move/andP; move/decomp_order_unicity=> /=.
by rewrite ltn_ord; move/(_ is_true_true).
Qed.

End ZpAut.

Section CyclicAutomorphism_Abelian.

(* G. 1.3.10 *)

Variable gT : finGroupType.

Lemma aut_cycle_commute : forall x : gT, abelian (Aut <[x]>).
Proof.
move=> x.
have:= isom_isog  [morphism of (cycle_to_fp x)] (subxx _) (fp_isom x).
rewrite isog_sym.
case/isogP=> f _ /= <-; apply: morphim_cents.
by apply/centsP=> m _ n _; do 2!apply: val_inj => /=; rewrite mulnC.
Qed.

End CyclicAutomorphism_Abelian.


(* Hand is defined inductively. *)
Inductive Hand : Set := Gu | Tyoki | Pa.

(* Check type of Hand. *)
Check Hand.

(* Show definitions. *)
Print Hand.
Print Hand_ind.

(* Function definition *)
Inductive win : Hand -> Hand -> Prop :=
| gu_win_tyoki : win Gu Tyoki
| tyoki_win_pa : win Tyoki Pa
| pa_win_gu : win Pa Gu.

Hint Constructors win.
(* Winning hand *)
Definition winning_hand(s:Hand) : { a | win a s }.
Proof.
induction s.
 exists Pa. apply pa_win_gu.
 exists Gu. auto.
 exists Tyoki; auto.
Defined.

(* Result = hand & proof *)
Eval compute in (winning_hand Gu).
(* Hand *)
Eval compute in (proj1_sig (winning_hand Gu)).
(* Proof *)
Eval compute in (proj2_sig (winning_hand Gu)).
(* Extract as OCaml program *)
Extraction winning_hand.

(* Winning hand is unique. *)
Theorem winning_hand_unique : forall a b c,
  win a c -> win b c -> a = b.
Proof.
intros a b c Hac Hbc. induction c.
 inversion Hac. inversion Hbc. reflexivity.
 inversion Hac. inversion Hbc. auto.
 inversion Hac; inversion Hbc; auto.
Qed.

(* Import List module *)
Require Import List.

(* Show definition of list type *)
Print list.

(* Sample of list *)
Check (1::2::nil).

Check list_ind.

(* Define append function *)
Fixpoint append{A:Type}(xs ys:list A):=
match xs with
| nil => ys
| x::xs' => x::(append xs' ys)
end.

(* Evaluation *)
Eval compute in (append (1::2::nil) (3::4::nil)).

(* Definition of nat *)
Print nat.
Print plus.

(* Write your length function *)
Fixpoint len{A:Type}(xs:list A):nat :=
match xs with
| nil => ??????
| x::xs' => ???????
end.

(* Should be 3 *)
Eval compute in (len (1::2::3::nil)).

Theorem len_append: forall (A:Type)(xs ys:list A),
  len (append xs ys) = plus (len xs) (len ys).
Proof.
intro A.
induction xs.
 simpl.
 intro ys. auto.

 intro ys. simpl.
 erewrite IHxs.
 auto.
Qed.

Fixpoint reverse{A:Type}(xs:list A):list A :=
match xs with
| nil => nil
| x::xs' => append (reverse xs') (x::nil)
end.

(* Evaluate *)
Eval compute in (reverse (1::2::3::nil)).
(* reverse twice *)
Eval compute in (reverse (reverse (1::2::3::nil))).

Lemma append_right_nil: forall (A:Type)(xs:list A),
  append xs nil = xs.
Proof.
????
Qed.

Lemma append_append : forall (A:Type)(xs ys zs:list A),
  append (append xs ys) zs = append xs (append ys zs).
Proof.
????
Qed.

Lemma reverse_append : forall (A:Type)(xs ys:list A),
  reverse (append xs ys) = append (reverse ys) (reverse xs).
Proof.
????
Qed.

Theorem reverse_reverse: forall (A:Type)(xs:list A),
  reverse (reverse xs) = xs.
Proof.
????
Qed.


From LF Require Export Logic.
Require Coq.omega.Omega.

Inductive ev : nat -> Prop :=
| ev_0 : ev 0
| ev_SS : forall n : nat, ev n -> ev (S (S n)).

Check ev_0.
Check ev_SS.

Fail Inductive wrong_ev (n : nat) : Prop :=
| wrong_ev_0 : wrong_ev 0
| wrong_ev_SS : forall n, wrong_ev n -> wrong_ev (S (S n)).
(* ===> Error: A parameter of an inductive type n is not
        allowed to be used as a bound variable in the type
        of its constructor. *)

Theorem ev_4 : ev 4.
Proof. apply ev_SS. apply ev_SS. apply ev_0. Qed.

Theorem ev_4' : ev 4.
Proof. apply (ev_SS 2 (ev_SS 0 ev_0)). Qed.

Theorem ev_plus4 : forall n, ev n -> ev (4 + n).
Proof.
  intros n. simpl. intros Hn.
  apply ev_SS. apply ev_SS. apply Hn.
Qed.

Theorem ev_double : forall n,
  ev (double n).
Proof.
  intros. induction n.
  - apply ev_0.
  - simpl. apply ev_SS. assumption.
  Qed.

Theorem ev_minus2 : forall n,
  ev n -> ev (pred (pred n)).
Proof.
  intros n E.
  inversion  E as [| n' E'].
  - (* E = ev_0 *) simpl. apply ev_0.
  - (* E = ev_SS n' E' *) simpl. apply E'.  Qed.

Theorem ev_minus2' : forall n,
  ev n -> ev (pred (pred n)).
Proof.
  intros n E.
  destruct E as [| n' E'].
  - (* E = ev_0 *) simpl. apply ev_0.
  - (* E = ev_SS n' E' *) simpl. apply E'.  Qed.

Theorem evSS_ev : forall n,
  ev (S (S n)) -> ev n.

Proof.
  intros n E.
  destruct E as [| n' E'].
  - (* E = ev_0. *)
    (* We must prove that [n] is even from no assumptions! *)
Abort.

Theorem evSS_ev : forall n,
  ev (S (S n)) -> ev n.
Proof.
  intros n E.
  inversion E as [| n' E'].
  (* We are in the [E = ev_SS n' E'] case now. *)
  apply E'.
Qed.

Theorem one_not_even : ~ ev 1.
Proof.
  intros H. inversion H. Qed.

Theorem SSSSev__even : forall n,
  ev (S (S (S (S n)))) -> ev n.
Proof.
  (* FILL IN HERE *)
  intros.
  inversion H.
  inversion H1.
  assumption.
  Qed.

Theorem even5_nonsense :
  ev 5 -> 2 + 2 = 9.
Proof.
  (* FILL IN HERE *)
  intros. inversion H. inversion H1. inversion H3.
  Qed.

Lemma ev_even_firsttry : forall n,
  ev n -> exists k, n = double k.
Proof.
  intros n E. inversion E as [| n' E'].
  - (* E = ev_0 *)
    exists 0. reflexivity.
  - (* E = ev_SS n' E' *) simpl.
    assert (I : (exists k', n' = double k') ->
                (exists k, S (S n') = double k)).
    { intros [k' Hk']. rewrite Hk'. exists (S k'). reflexivity. }
    apply I. (* reduce the original goal to the new one *)

Admitted.

Lemma ev_even : forall n,
  ev n -> exists k, n = double k.
Proof.
  intros n E.
  induction E as [|n' E' IH].
  - (* E = ev_0 *)
    exists 0. reflexivity.
  - (* E = ev_SS n' E'
       with IH : exists k', n' = double k' *)
    destruct IH as [k' Hk'].
    rewrite Hk'. exists (S k'). reflexivity.
Qed.

Theorem ev_even_iff : forall n,
  ev n <-> exists k, n = double k.
Proof.
  intros n. split.
  - (* -> *) apply ev_even.
  - (* <- *) intros [k Hk]. rewrite Hk. apply ev_double.
Qed.

Theorem ev_sum : forall n m, ev n -> ev m -> ev (n + m).
Proof.
  (* FILL IN HERE *)
  intros.
  induction H.
  - assumption.
  - simpl. apply ev_SS. assumption.
  Qed.

Inductive ev' : nat -> Prop :=
| ev'_0 : ev' 0
| ev'_2 : ev' 2
| ev'_sum : forall n m, ev' n -> ev' m -> ev' (n + m).

Theorem ev'_ev : forall n, ev' n <-> ev n.
Proof.
 (* FILL IN HERE *)
 split.
 - intros. induction H.
   + constructor.
   + constructor. constructor.
   + apply ev_sum. assumption. assumption.
 - intros. induction H.
   + constructor.
   + apply (ev'_sum 2 n).
     constructor.
     assumption.
 Qed.

Theorem ev_ev__ev : forall n m,
  ev (n+m) -> ev n -> ev m.
Proof.
  (* FILL IN HERE *)
  intros.
  induction H0.
  - assumption.
  - simpl in H. apply IHev. apply evSS_ev. assumption.
  Qed.

Theorem ev_plus_plus : forall n m p,
  ev (n+m) -> ev (n+p) -> ev (m+p).
Proof.
  (* FILL IN HERE *)
  intros.
  assert (ev ((n + m) + (n + p))).
  {
    apply ev_sum. assumption. assumption.
  }
  rewrite (plus_assoc) in H1.
  rewrite <- (plus_assoc n m n) in H1.
  rewrite (plus_comm m n) in H1.
  rewrite (plus_assoc) in H1.
  rewrite <- double_plus in H1.
  rewrite <- plus_assoc in H1.
  apply (ev_ev__ev (double n) (m+p) H1).
  apply ev_double.
  Qed.

Theorem ex_mid_ev:
  forall n, ev n \/ ~ ev n.

Proof.
  intros.
  assert (ev n <-> evenb n = true).
  {
    rewrite ev_even_iff. rewrite even_bool_prop. reflexivity.
  }
  apply restricted_excluded_middle with (evenb n).
  assumption.
  Qed.

Theorem ev_n_not_ev_Sn:
  forall n,
  ev n -> ~ ev (S n).

Proof.
  unfold not.
  - intros. induction H.
    + inversion H0.
    + inversion H0. apply IHev. assumption.
  Qed.

Module Playground.

Inductive le : nat -> nat -> Prop :=
  | le_n : forall n, le n n
  | le_S : forall n m, (le n m) -> (le n (S m)).

Notation "m <= n" := (le m n).

Theorem test_le1 :
  3 <= 3.
Proof.
  (* WORKED IN CLASS *)
  apply le_n.  Qed.

Theorem test_le2 :
  3 <= 6.
Proof.
  (* WORKED IN CLASS *)
  apply le_S. apply le_S. apply le_S. apply le_n.  Qed.

Theorem test_le3 :
  (2 <= 1) -> 2 + 2 = 5.
Proof.
  (* WORKED IN CLASS *)
  intros H. inversion H. inversion H2.  Qed.

End Playground.

Definition lt (n m:nat) := le (S n) m.

Notation "m < n" := (lt m n).

Inductive square_of : nat -> nat -> Prop :=
  | sq : forall n:nat, square_of n (n * n).

Inductive next_nat : nat -> nat -> Prop :=
  | nn : forall n:nat, next_nat n (S n).

Inductive next_even : nat -> nat -> Prop :=
  | ne_1 : forall n, ev (S n) -> next_even n (S n)
  | ne_2 : forall n, ev (S (S n)) -> next_even n (S (S n)).

Inductive total_relation: nat -> nat -> Prop :=
  | totrel: forall n m, total_relation n m.

Example tot_rel_example:
  total_relation 3 5.

Proof. constructor. Qed.

Inductive empty_relation: nat -> nat -> Prop :=.

Theorem not_exist_in_empty_rel:
  ~ (exists n m, empty_relation n m).
Proof.
  unfold not.
  intros.
  inversion H.
  inversion H0.
  inversion H1.
  Qed.

Lemma Sn_le_m__n_le_m:
  forall n m,
  S n <= m -> n <= m.

Proof.
  intros.
  induction H.
  - constructor. constructor.
  - constructor. assumption.
  Qed.

Lemma le_trans : forall m n o, m <= n -> n <= o -> m <= o.
Proof.
  (* FILL IN HERE *)
  intros.
  induction H.
  - assumption.
  - apply IHle. apply Sn_le_m__n_le_m.
    assumption.
  Qed.

Theorem O_le_n : forall n,
  0 <= n.
Proof.
  (* FILL IN HERE *)
  induction n.
  - constructor.
  - constructor. assumption.
  Qed.

Theorem n_le_m__Sn_le_Sm : forall n m,
  n <= m -> S n <= S m.
Proof.
  (* FILL IN HERE *)
  intros.
  induction H.
  - constructor.
  - constructor. assumption.
  Qed.

Theorem Sn_le_Sm__n_le_m : forall n m,
  S n <= S m -> n <= m.
Proof.
  (* FILL IN HERE *)
  intros. inversion H.
  - constructor.
  - apply Sn_le_m__n_le_m. assumption.
  Qed.

Theorem le_plus_l : forall a b,
  a <= a + b.
Proof.
  (* FILL IN HERE *)
  induction a.
  - simpl. apply O_le_n.
  - intros. simpl. apply n_le_m__Sn_le_Sm.
    apply IHa.
  Qed.

Theorem plus_lt : forall n1 n2 m,
  n1 + n2 < m ->
  n1 < m /\ n2 < m.
Proof.
 unfold lt.
 (* FILL IN HERE *)
 intros.
 induction H.
 - split.
   + apply n_le_m__Sn_le_Sm. apply le_plus_l.
   + apply n_le_m__Sn_le_Sm. rewrite plus_comm. apply le_plus_l.
 - destruct IHle. split.
   + constructor. assumption.
   + constructor. assumption.
 Qed.

Theorem lt_S : forall n m,
  n < m ->
  n < S m.
Proof.
  (* FILL IN HERE *)
  unfold lt.
  intros. constructor. assumption.
  Qed.

Theorem leb_complete : forall n m,
  leb n m = true -> n <= m.
Proof.
  (* FILL IN HERE *)
  induction n.
  - intros. apply O_le_n.
  - intros. simpl in H. destruct m.
    + inversion H.
    + apply n_le_m__Sn_le_Sm.
      apply IHn. apply H.
  Qed.

Theorem leb_correct : forall n m,
  n <= m ->
  leb n m = true.
Proof.
  (* FILL IN HERE *)
  intros.
  generalize dependent n.
  induction m.
  - intros. inversion H. reflexivity.
  - intros. inversion H.
    + rewrite <- leb_refl. reflexivity.
    + destruct n.
      * reflexivity.
      * simpl. apply IHm. apply Sn_le_Sm__n_le_m. assumption.
  Qed.

Theorem leb_iff : forall n m,
  leb n m = true <-> n <= m.
Proof.
  intros.
  split. apply leb_complete. apply leb_correct.
  Qed.

Theorem leb_true_trans : forall n m o,
  leb n m = true -> leb m o = true -> leb n o = true.
Proof.
  (* FILL IN HERE *)
  intros.
  rewrite leb_iff in H.
  rewrite leb_iff in H0.
  rewrite leb_iff.
  apply le_trans with m.
  assumption.
  assumption.
  Qed.

(*New Session*)

Inductive reg_exp {T : Type} : Type :=
| EmptySet : reg_exp
| EmptyStr : reg_exp
| Char : T -> reg_exp
| App : reg_exp -> reg_exp -> reg_exp
| Union : reg_exp -> reg_exp -> reg_exp
| Star : reg_exp -> reg_exp.

Inductive exp_match {T} : list T -> @reg_exp T -> Prop :=
| MEmpty : exp_match [] EmptyStr
| MChar : forall (x: T), exp_match [x] (Char x)
| MApp : forall s1 re1 s2 re2,
           exp_match s1 re1 ->
           exp_match s2 re2 ->
           exp_match (s1 ++ s2) (App re1 re2)
| MUnionL : forall s1 re1 re2,
              exp_match s1 re1 ->
              exp_match s1 (Union re1 re2)
| MUnionR : forall re1 s2 re2,
              exp_match s2 re2 ->
              exp_match s2 (Union re1 re2)
| MStar0 : forall re, exp_match [] (Star re)
| MStarApp : forall s1 s2 re,
               exp_match s1 re ->
               exp_match s2 (Star re) ->
               exp_match (s1 ++ s2) (Star re).

Notation "s =~ re" := (exp_match s re) (at level 80).

Example reg_exp_ex1 : [1] =~ Char 1.
Proof.
  apply MChar.
Qed.

Example reg_exp_ex2 : [1; 2] =~ App (Char 1) (Char 2).
Proof.
  apply (MApp [1] _ [2]).
  - apply MChar.
  - apply MChar.
Qed.

Example reg_exp_ex3 : ~ ([1; 2] =~ Char 1).
Proof.
  intros H. inversion H.
Qed.

Fixpoint reg_exp_of_list {T} (l : list T) :=
  match l with
  | [] => EmptyStr
  | x :: l' => App (Char x) (reg_exp_of_list l')
  end.

Compute reg_exp_of_list [1;2;3].

Example reg_exp_ex4 : [1; 2; 3] =~ reg_exp_of_list [1; 2; 3].
Proof.
  simpl. apply (MApp [1]).
  { apply MChar. }
  apply (MApp [2]).
  { apply MChar. }
  apply (MApp [3]).
  { apply MChar. }
  apply MEmpty.
Qed.

Lemma MStar1 :
  forall T s (re : @reg_exp T) ,
    s =~ re ->
    s =~ Star re.
Proof.
  intros T s re H. Check app_nil_r.
  rewrite <- (app_nil_r _ s).
  apply (MStarApp s [] re).
  - apply H.
  - apply MStar0.
Qed.

(*Exercise 1*)
Lemma empty_is_empty : forall T (s : list T),
  ~ (s =~ EmptySet).
Proof.
  intros t s H. inversion H.
Qed.

(*Exercise 2*)
Lemma MUnion' : forall T (s : list T) (re1 re2 : @reg_exp T),
  s =~ re1 \/ s =~ re2 ->
  s =~ Union re1 re2.
Proof.
  intros T s re1 re2 [match1 | match2].
  - constructor. assumption.
  - apply MUnionR. assumption.
Qed.

(*Exercise 3*)
Lemma MStar' : forall T (ss : list (list T)) (re : reg_exp),
  (forall s, In s ss -> s =~ re) ->
  fold app ss [] =~ Star re.
Proof.
   intros T ss re H.
    induction ss as [| a t IH].
    - simpl. apply MStar0.
    - simpl. apply MStarApp.
    apply H. simpl. left. reflexivity.
    apply IH. intros. apply H. simpl. right. assumption.
Qed.

(*Exercise 4*)

Lemma Helper: forall S (x:S) y, [x]++y = x::y.
      Proof.
  intros S x y. simpl. reflexivity.
Qed.

Lemma reg_exp_of_list_spec : forall T (s1 s2 : list T),
  s1 =~ reg_exp_of_list s2 <-> s1 = s2.
Proof.
  intros T s1 s2.
  generalize dependent s1.
  induction s2 as [|h t].
    split.
    + intros H. simpl in H. inversion H. reflexivity.
    + intros H. simpl. rewrite H. apply MEmpty.
    + intros s1. split.
     intros H. simpl in H. inversion H.
      inversion H3. simpl.
      rewrite (IHt s2) in H4. rewrite H4. reflexivity.
     intros H. simpl. rewrite H.
      rewrite <- Helper. apply MApp.
      * apply MChar.
      * apply IHt. reflexivity.
Qed.

Fixpoint re_chars {T} (re : reg_exp) : list T :=
  match re with
  | EmptySet => []
  | EmptyStr => []
  | Char x => [x]
  | App re1 re2 => re_chars re1 ++ re_chars re2
  | Union re1 re2 => re_chars re1 ++ re_chars re2
  | Star re => re_chars re
  end.

Compute re_chars (Union (Char 5) (App (Char 3) (EmptyStr))). (* 5 + 3\epsilon *)

Theorem in_re_match : forall T (s : list T) (re : reg_exp) (x : T),
  s =~ re ->
  In x s ->
  In x (re_chars re).
Proof.
  intros T s re x Hmatch Hin.
  induction Hmatch
    as [| x'
        | s1 re1 s2 re2 Hmatch1 IH1 Hmatch2 IH2
        | s1 re1 re2 Hmatch IH | re1 s2 re2 Hmatch IH
        | re | s1 s2 re Hmatch1 IH1 Hmatch2 IH2].
  (* WORKED IN CLASS *)
  - (* MEmpty *)
    inversion Hin.
  - (* MChar *)
    inversion Hin. simpl. left. assumption.
    inversion H.
  - (*MApp*) simpl. Check In_app_iff.
    rewrite In_app_iff in *.
    destruct Hin as [Hin | Hin].
    + (* In x s1 *)
      left. apply (IH1 Hin).
    + (* In x s2 *)
      right. apply IH2. apply Hin.
  - (* MUnionL *)
    simpl. rewrite In_app_iff.
    left. apply (IH Hin).
  - (* MUnionR *)
    simpl. rewrite In_app_iff.
    right. apply (IH Hin).
  - (* MStar0 *)
    destruct Hin.
  - (* MStarApp *)
    simpl. rewrite In_app_iff in Hin.
    destruct Hin as [Hin | Hin].
    + (* In x s1 *)
      apply (IH1 Hin).
    + (* In x s2 *)
      simpl in IH2.
      apply (IH2 Hin).
Qed.

Lemma star_app: forall T (s1 s2 : list T) (re : @reg_exp T),
  s1 =~ Star re ->
  s2 =~ Star re ->
  s1 ++ s2 =~ Star re.
Proof.
  intros T s1 s2 re H1.
  generalize dependent s2.
  induction H1
    as [|x'|s1 re1 s2' re2 Hmatch1 IH1 Hmatch2 IH2
        |s1 re1 re2 Hmatch IH|re1 s2' re2 Hmatch IH
        |re''|s1 s2' re'' Hmatch1 IH1 Hmatch2 IH2].

  - (* MEmpty *)
    simpl. intros. apply H.

  - simpl. intros. (* MChar. Stuck... *)
Abort.

Lemma star_app: forall T (s1 s2 : list T) (re re' : reg_exp),
  re' = Star re ->
  s1 =~ re' ->
  s2 =~ Star re ->
  s1 ++ s2 =~ Star re.

Proof. intros. induction H0.
Abort.

Lemma star_app: forall T (s1 s2 : list T) (re : reg_exp),
  s1 =~ Star re ->
  s2 =~ Star re ->
  s1 ++ s2 =~ Star re.
Proof.
  intros T s1 s2 re H1.
  remember (Star re) as re'.
  generalize dependent s2.
  induction H1
    as [|x'|s1 re1 s2' re2 Hmatch1 IH1 Hmatch2 IH2
        |s1 re1 re2 Hmatch IH|re1 s2' re2 Hmatch IH
        |re''|s1 s2' re'' Hmatch1 IH1 Hmatch2 IH2].

(** The [Heqre'] is contradictory in most cases, which allows us to
    conclude immediately. *)

  - (* MEmpty *)  inversion Heqre'.
  - (* MChar *)   inversion Heqre'.
  - (* MApp *)    inversion Heqre'.
  - (* MUnionL *) inversion Heqre'.
  - (* MUnionR *) inversion Heqre'.
  - (* MStar0 *)
    inversion Heqre'. intros s H. apply H.
  - (* MStarApp *)
    inversion Heqre'. (*rewrite H0 in IH2, Hmatch1.*)
    intros s2 H1. Check app_assoc.
    rewrite <- app_assoc.
    apply MStarApp.
    + rewrite H0 in Hmatch1. apply Hmatch1.
    + rewrite H0 in IH2. apply IH2.
      * reflexivity.
      * apply H1.
Qed.

Lemma beq_nat_true_iff : forall x y, eqb x y = true <-> x=y.
Proof. split. apply eqb_true. intros; subst; symmetry; apply eqb_refl. Qed.

Theorem filter_not_empty_In : forall n l,
  filter (eqb n) l <> [] ->
  In n l.
Proof.
  intros n l. induction l as [|m l' IHl'].
  - (* l = [] *)
    simpl. intros H. apply H. reflexivity.
  - (* l = m :: l' *)
    simpl. destruct (eqb n m) eqn:H.
    + (* beq_nat n m = true *)
      intros _. Check beq_nat_true_iff.
      rewrite beq_nat_true_iff in H. rewrite H.
      left. reflexivity.
    + (* beq_nat n m = false *)
      intros H'. right. apply (IHl' H').
Qed.

Inductive reflect (P : Prop) : bool -> Prop :=
| ReflectT : P -> reflect P true
| ReflectF : ~ P -> reflect P false.

Theorem iff_reflect : forall P b, (P <-> b = true) -> reflect P b.
Proof.
  (* WORKED IN CLASS *)
  intros P b H. destruct b.
  - apply ReflectT. rewrite H. reflexivity.
  - apply ReflectF. unfold not. intros. apply H in H0. inversion H0.
Qed.

(*Exercise 5*)
Theorem reflect_iff : forall P b, reflect P b -> (P <-> b = true).
Proof.
  intros. destruct H as [HP | HNP].
  - split. intros. reflexivity. intros. apply HP.
  - split. intros. destruct (HNP H). intros. discriminate.
Qed.

Lemma beq_natP : forall n m, reflect (n = m) (eqb n m).
Proof.
  intros n m. apply iff_reflect. rewrite beq_nat_true_iff. reflexivity.
Qed.

Theorem filter_not_empty_In' : forall n l,
  filter (eqb n) l <> [] ->
  In n l.
Proof.
  intros n l. induction l as [|m l' IHl'].
  - (* l = [] *)
    simpl. intros H. apply H. reflexivity.
  - (* l = m :: l' *)
    simpl. destruct (beq_natP n m) as [H | H].
    + (* n = m *)
      intros _. rewrite H. left. reflexivity.
    + (* n <> m *)
      intros H'. right. apply IHl'. apply H'.
Qed.

(*Exercise 6: Use beq_natP in the proof.*)
Fixpoint count n l :=
  match l with
  | [] => 0
  | m :: l' => (if eqb n m then 1 else 0) + count n l'
  end.

Theorem beq_natP_practice : forall n l,
  count n l = 0 -> ~(In n l).
Proof.
  intros n l.
  induction l as [| a t IH].
  - simpl. intros _ f. destruct f.
  - simpl. destruct (beq_natP n a) as [H | H].
    + intros H'. discriminate.
    + simpl. intros H1 [H2 | H3].
      * apply H. rewrite H2. reflexivity.
      * apply IH. apply H1. apply H3.
Qed.


Require Export Induction.

Module NatList.

Inductive natprod : Type :=
  pair : nat -> nat -> natprod.

Check (pair 3 5).

Definition fst (p : natprod) : nat :=
  match p with
  | pair x y => x
  end.
Definition snd (p : natprod) : nat :=
  match p with
  | pair x y => y
  end.

Eval compute in (fst (pair 3 5)).
(* ===> 3 *)

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

Eval compute in (fst (3,5)).

Definition fst' (p : natprod) : nat :=
  match p with
  | (x,y) => x
  end.
Definition snd' (p : natprod) : nat :=
  match p with
  | (x,y) => y
  end.

Definition swap_pair (p : natprod) : natprod :=
  match p with
  | (x,y) => (y,x)
  end.

Theorem surjective_pairing' : forall (n m : nat),
  (n,m) = (fst (n,m), snd (n,m)).
Proof.
  reflexivity. Qed.

Theorem surjective_pairing_stuck : forall (p : natprod),
  p = (fst p, snd p).
Proof.
  simpl. (* Doesn't reduce anything! *)
Abort.

Theorem surjective_pairing : forall (p : natprod),
  p = (fst p, snd p).
Proof.
  intros p. destruct p as [n m]. simpl. reflexivity. Qed.

(** Exercise: 1 star (snd_fst_is_swap)  *)

Theorem snd_fst_is_swap : forall (p : natprod),
  (snd p, fst p) = swap_pair p.
Proof.
  intros. destruct p as [n m]. simpl. reflexivity.
Qed.

(** ☐
Exercise: 1 star, optional (fst_swap_is_snd)
Theorem fst_swap_is_snd : forall (p : natprod),
  fst (swap_pair p) = snd p.
Proof.  *)

Inductive natlist : Type :=
  | nil : natlist
  | cons : nat -> natlist -> natlist.

Definition mylist := cons 1 (cons 2 (cons 3 nil)).

Notation "x :: l" := (cons x l) (at level 60, right associativity).
Notation "[ ]" := nil.
Notation "[ x ; .. ; y ]" := (cons x .. (cons y nil) ..).

Definition mylist1 := 1 :: (2 :: (3 :: nil)).
Definition mylist2 := 1 :: 2 :: 3 :: nil.
Definition mylist3 := [1;2;3].

Notation "x + y" := (plus x y)
                    (at level 50, left associativity).

Fixpoint repeat (n count : nat) : natlist :=
  match count with
  | O => nil
  | S count' => n :: (repeat n count')
  end.

Fixpoint length (l:natlist) : nat :=
  match l with
  | nil => O
  | h :: t => S (length t)
  end.

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

Notation "x ++ y" := (app x y)
                     (right associativity, at level 60).

Example test_app1: [1;2;3] ++ [4;5] = [1;2;3;4;5].
Proof. reflexivity. Qed.
Example test_app2: nil ++ [4;5] = [4;5].
Proof. reflexivity. Qed.
Example test_app3: [1;2;3] ++ nil = [1;2;3].
Proof. reflexivity. Qed.

Definition hd (default:nat) (l:natlist) : nat :=
  match l with
  | nil => default
  | h :: t => h
  end.

Definition tl (l:natlist) : natlist :=
  match l with
  | nil => nil
  | h :: t => t
  end.

Example test_hd1: hd 0 [1;2;3] = 1.
Proof. reflexivity. Qed.
Example test_hd2: hd 0 [] = 0.
Proof. reflexivity. Qed.
Example test_tl: tl [1;2;3] = [2;3].
Proof. reflexivity. Qed.

Fixpoint nonzeros (l:natlist) : natlist :=
  match l with
  | nil => nil
  | 0 :: t => nonzeros t
  | h :: t => h :: nonzeros t
  end.

Example test_nonzeros: nonzeros [0;1;0;2;3;0;0] = [1;2;3].
Proof. reflexivity. Qed.

Fixpoint oddmembers (l:natlist) : natlist :=
  match l with
  | nil => nil
  | h :: t => match oddb h with
  | true => h :: oddmembers t
  | false => oddmembers t
  end
  end.

Example test_oddmembers: oddmembers [0;1;0;2;3;0;0] = [1;3].
Proof. reflexivity. Qed.

Fixpoint countoddmembers (l:natlist) : nat :=
  match l with
  | nil => 0
  | h :: t => match oddb h with
  | true => 1 + (countoddmembers t)
  | false => (countoddmembers t)
  end
  end.

Example test_countoddmembers1: countoddmembers [1;0;3;1;4;5] = 4.
Proof. reflexivity. Qed.
Example test_countoddmembers2: countoddmembers [0;2;4] = 0.
Proof. reflexivity. Qed.
Example test_countoddmembers3: countoddmembers nil = 0.
Proof. reflexivity. Qed.

Definition bag := natlist.

Fixpoint count (v:nat) (s:bag) : nat :=
  match s with
  | nil => 0
  | h :: t => match beq_nat v h with
  | true => 1 + (count v t)
  | false => (count v t)
  end
  end.

Example test_count1: count 1 [1;2;3;1;4;1] = 3.
Proof. reflexivity. Qed.
Example test_count2: count 6 [1;2;3;1;4;1] = 0.
Proof. reflexivity. Qed.

Definition sum : bag -> bag -> bag :=
  app.

Example test_sum1: count 1 (sum [1;2;3] [1;4;1]) = 3.
Proof. reflexivity. Qed.

Definition add (v:nat) (s:bag) : bag :=
  v :: s.

Example test_add1: count 1 (add 1 [1;4;1]) = 3.
Proof. reflexivity. Qed.
Example test_add2: count 5 (add 1 [1;4;1]) = 0.
Proof. reflexivity. Qed.

Definition member (v:nat) (s:bag) : bool :=
  negb (beq_nat (count v s) 0).

Example test_member1: member 1 [1;4;1] = true.
Proof. reflexivity. Qed.
Example test_member2: member 2 [1;4;1] = false.
Proof. reflexivity. Qed.

(** Exercise: 3 stars (bag_theorem)  *)
Fixpoint total (s:bag) : nat :=
  match s with
  | nil => 0
  | h :: t => h + (total t)
  end.

Example test_total1: total [1;2;3;4;5] = 15.
Proof. reflexivity. Qed.
Example test_total2: total [ ] = 0.
Proof. reflexivity. Qed.

Theorem nil_app : forall l:natlist,
  [] ++ l = l.
Proof. reflexivity. Qed.

Theorem tl_length_pred : forall l:natlist,
  pred (length l) = length (tl l).
Proof.
  intros l. destruct l as [| n l'].
  Case "l = nil".
    reflexivity.
  Case "l = cons n l'".
    reflexivity. Qed.

Theorem app_assoc : forall l1 l2 l3 : natlist,
  (l1 ++ l2) ++ l3 = l1 ++ (l2 ++ l3).
Proof.
  intros l1 l2 l3. induction l1 as [| n l1'].
  Case "l1 = nil".
    reflexivity.
  Case "l1 = cons n l1'".
    simpl. rewrite -> IHl1'. reflexivity. Qed.

Theorem app_length : forall l1 l2 : natlist,
  length (l1 ++ l2) = (length l1) + (length l2).
Proof.
  (* WORKED IN CLASS *)
  intros l1 l2. induction l1 as [| n l1'].
  Case "l1 = nil".
    reflexivity.
  Case "l1 = cons".
    simpl. rewrite -> IHl1'. reflexivity. Qed.

Fixpoint snoc (l:natlist) (v:nat) : natlist :=
  match l with
  | nil => [v]
  | h :: t => h :: (snoc t v)
  end.

Fixpoint rev (l:natlist) : natlist :=
  match l with
  | nil => nil
  | h :: t => snoc (rev t) h
  end.

Example test_rev1: rev [1;2;3] = [3;2;1].
Proof. reflexivity. Qed.
Example test_rev2: rev nil = nil.
Proof. reflexivity. Qed.

Theorem rev_length_firsttry : forall l : natlist,
  length (rev l) = length l.
Proof.
  intros l. induction l as [| n l'].
  Case "l = []".
    reflexivity.
  Case "l = n :: l'".
    (* This is the tricky case.  Let's begin as usual
       by simplifying. *)
    simpl.
    (* Now we seem to be stuck: the goal is an equality
       involving snoc, but we don't have any equations
       in either the immediate context or the global
       environment that have anything to do with snoc!

       We can make a little progress by using the IH to
       rewrite the goal... *)
    rewrite <- IHl'.
    (* ... but now we can't go any further. *)
Abort.

Theorem length_snoc : forall n : nat, forall l : natlist,
  length (snoc l n) = S (length l).
Proof.
  intros n l. induction l as [| n' l'].
  Case "l = nil".
    reflexivity.
  Case "l = cons n' l'".
    simpl. rewrite -> IHl'. reflexivity. Qed.

Theorem rev_length : forall l : natlist,
  length (rev l) = length l.
Proof.
  intros l. induction l as [| n l'].
  Case "l = nil".
    reflexivity.
  Case "l = cons".
    simpl. rewrite -> length_snoc.
    rewrite -> IHl'. reflexivity. Qed.

(* SearchAbout rev. *)

(** Exercise: 3 stars (list_exercises)
More practice with lists.  *)

Theorem app_nil_end : forall l : natlist,
  l ++ [] = l.
Proof.
  intros l. induction l as [| l'].
  Case "l = nil". reflexivity.
  Case "l = cons". simpl. rewrite -> IHl. reflexivity.
Qed.

Lemma reverse : forall n : nat, forall l : natlist,
  rev (snoc l n) = n :: rev l.
Proof.
  intros. induction l as [| n' l'].
  Case "l = nil". simpl. reflexivity.
  Case "l = cons". simpl. rewrite -> IHl'. simpl. reflexivity.
Qed.

Theorem rev_involutive : forall l : natlist,
  rev (rev l) = l.
Proof.
  intros l. induction l as [| l'].
  Case "l = nil". reflexivity.
  Case "l = cons". simpl. rewrite -> reverse. rewrite -> IHl. reflexivity.
Qed.

Theorem app_assoc4 : forall l1 l2 l3 l4 : natlist,
  l1 ++ (l2 ++ (l3 ++ l4)) = ((l1 ++ l2) ++ l3) ++ l4.
Proof.
  intros. rewrite -> app_assoc. rewrite -> app_assoc. reflexivity.
Qed.

Theorem snoc_append : forall (l:natlist) (n:nat),
  snoc l n = l ++ [n].
Proof.
  intros. induction l as [| l'].
  Case "l = nil". simpl. reflexivity.
  Case "l = cons". simpl. rewrite -> IHl. reflexivity.
Qed.

Theorem distr_rev : forall l1 l2 : natlist,
  rev (l1 ++ l2) = (rev l2) ++ (rev l1).
Proof.
  intros. induction l1 as [| l1'].
  Case "l1 = nil". simpl. rewrite -> app_nil_end. reflexivity.
  Case "l1 = cons". simpl. rewrite -> snoc_append. rewrite -> IHl1.
  rewrite -> snoc_append. rewrite -> app_assoc. reflexivity.
Qed.

(** An exercise about your implementation of nonzeros:  *)

Lemma nonzeros_app : forall l1 l2 : natlist,
  nonzeros (l1 ++ l2) = (nonzeros l1) ++ (nonzeros l2).
Proof.
  intros. induction l1 as [| l2' l1'].
  Case "l1 = nil". simpl. reflexivity.
  Case "l1 = cons".
    induction l2' as [| l2''].
    SCase "L2 = nil". simpl. rewrite -> IHl1'. reflexivity.
    SCase "L2 = cons". simpl. rewrite -> IHl1'. reflexivity.
Qed.

Fixpoint beq_natlist (l1 l2 : natlist) : bool :=
  match l1, l2 with
  | nil, nil => true
  | _, nil => false
  | nil, _ => false
  | h :: t, h' :: t' => andb (beq_nat h h') (beq_natlist t t')
  end.

Example test_beq_natlist1 : (beq_natlist nil nil = true).
Proof. reflexivity. Qed.
Example test_beq_natlist2 : beq_natlist [1;2;3] [1;2;3] = true.
Proof. reflexivity. Qed.
Example test_beq_natlist3 : beq_natlist [1;2;3] [1;2;4] = false.
Proof. reflexivity. Qed.

Theorem beq_natlist_refl : forall l:natlist,
  true = beq_natlist l l.
Proof.
  intros. induction l as [| l'].
  Case "l = nil". simpl. reflexivity.
  Case "l = cons". simpl. rewrite -> IHl. admit.
Qed.

(** Exercise: 2 stars (list_design)  *)

SearchAbout cons.
SearchAbout snoc.
SearchAbout app.

(** Theorem cons_snoc_app :  *)

Fixpoint index_bad (n:nat) (l:natlist) : nat :=
  match l with
  | nil => 42 (* arbitrary! *)
  | a :: l' => match beq_nat n O with
               | true => a
               | false => index_bad (pred n) l'
               end
  end.

Inductive natoption : Type :=
  | Some : nat -> natoption
  | None : natoption.

Fixpoint index (n:nat) (l:natlist) : natoption :=
  match l with
  | nil => None
  | a :: l' => match beq_nat n O with
               | true => Some a
               | false => index (pred n) l'
               end
  end.

Example test_index1 : index 0 [4;5;6;7] = Some 4.
Proof. reflexivity. Qed.
Example test_index2 : index 3 [4;5;6;7] = Some 7.
Proof. reflexivity. Qed.
Example test_index3 : index 10 [4;5;6;7] = None.
Proof. reflexivity. Qed.

Fixpoint index' (n:nat) (l:natlist) : natoption :=
  match l with
  | nil => None
  | a :: l' => if beq_nat n O then Some a else index' (pred n) l'
  end.

Definition option_elim (d : nat) (o : natoption) : nat :=
  match o with
  | Some n' => n'
  | None => d
  end.

Definition hd_opt (l : natlist) : natoption :=
  match l with
  | nil => None
  | h :: t => Some h
end.

Example test_hd_opt1 : hd_opt [] = None.
Proof. reflexivity. Qed.

Example test_hd_opt2 : hd_opt [1] = Some 1.
Proof. reflexivity. Qed.

Example test_hd_opt3 : hd_opt [5;6] = Some 5.
Proof. reflexivity. Qed.

Module Dictionary.

Inductive dictionary : Type :=
  | empty : dictionary
  | record : nat -> nat -> dictionary -> dictionary.

Definition insert (key value : nat) (d : dictionary) : dictionary :=
  (record key value d).

Fixpoint find (key : nat) (d : dictionary) : natoption :=
  match d with
  | empty => None
  | record k v d' => if (beq_nat key k)
                       then (Some v)
                       else (find key d')
  end.

Theorem dictionary_invariant1' : forall (d : dictionary) (k v: nat),
  (find k (insert k v d)) = Some v.
Proof.
  intros. simpl. admit.
Qed.

Theorem dictionary_invariant2' : forall (d : dictionary) (m n o: nat),
  beq_nat m n = false -> find m d = find m (insert n o d).
Proof.
  intros. simpl. rewrite -> H. reflexivity.
Qed.

End Dictionary.

End NatList.