Require Export ProjectiveGeometry.Dev.fano_matroid_tactics.

(** Fano's plane **)
(** also known as Pg(2,3). **)

(** To show that our axiom system is consistent we build a finite model. **)

(*****************************************************************************)

Section s_fanoPlaneModelRkPG23.

Parameter A B C D E F G H I J K L M : Point.

Parameter is_only_13_pts : forall P, {P=A}+{P=B}+{P=C}+{P=D}+{P=E}+{P=F}+{P=G}+{P=H}+{P=I}+{P=J}+{P=K}+{P=L}+{P=M}.

Parameter rk_points : rk(A :: nil) = 1 /\ rk(B :: nil) = 1 /\ rk(C :: nil) = 1 /\ rk(D :: nil) = 1 /\
rk(E :: nil) = 1 /\ rk(F :: nil) = 1 /\ rk(G :: nil) = 1 /\ rk(H :: nil) = 1 /\ rk(I :: nil) = 1 /\
rk(J :: nil) = 1 /\ rk(K :: nil) = 1 /\ rk(L :: nil) = 1 /\ rk(M :: nil) = 1.

Parameter rk_distinct_points :
rk(A :: B :: nil) = 2 /\ rk(A :: C :: nil) = 2 /\ rk(A :: D :: nil) = 2 /\ rk(A :: E :: nil) = 2 /\ rk(A :: F :: nil) = 2 /\ rk(A :: G :: nil) = 2 /\
rk(A :: H :: nil) = 2 /\ rk(A :: I :: nil) = 2 /\ rk(A :: J :: nil) = 2 /\ rk(A :: K :: nil) = 2 /\ rk(A :: L :: nil) = 2 /\ rk(A :: M :: nil) = 2 /\
rk(B :: C :: nil) = 2 /\ rk(B :: D :: nil) = 2 /\ rk(B :: E :: nil) = 2 /\ rk(B :: F :: nil) = 2 /\ rk(B :: G :: nil) = 2 /\
rk(B :: H :: nil) = 2 /\ rk(B :: I :: nil) = 2 /\ rk(B :: J :: nil) = 2 /\ rk(B :: K :: nil) = 2 /\ rk(B :: L :: nil) = 2 /\ rk(B :: M :: nil) = 2 /\
rk(C :: D :: nil) = 2 /\ rk(C :: E :: nil) = 2 /\ rk(C :: F :: nil) = 2 /\ rk(C :: G :: nil) = 2 /\
rk(C :: H :: nil) = 2 /\ rk(C :: I :: nil) = 2 /\ rk(C :: J :: nil) = 2 /\ rk(C :: K :: nil) = 2 /\ rk(C :: L :: nil) = 2 /\ rk(C :: M :: nil) = 2 /\
rk(D :: E :: nil) = 2 /\ rk(D :: F :: nil) = 2 /\ rk(D :: G :: nil) = 2 /\
rk(D :: H :: nil) = 2 /\ rk(D :: I :: nil) = 2 /\ rk(D :: J :: nil) = 2 /\ rk(D :: K :: nil) = 2 /\ rk(D :: L :: nil) = 2 /\ rk(D :: M :: nil) = 2 /\
rk(E :: F :: nil) = 2 /\ rk(E :: G :: nil) = 2 /\
rk(E :: H :: nil) = 2 /\ rk(E :: I :: nil) = 2 /\ rk(E :: J :: nil) = 2 /\ rk(E :: K :: nil) = 2 /\ rk(E :: L :: nil) = 2 /\ rk(E :: M :: nil) = 2 /\
rk(F :: G :: nil) = 2 /\
rk(F :: H :: nil) = 2 /\ rk(F :: I :: nil) = 2 /\ rk(F :: J :: nil) = 2 /\ rk(F :: K :: nil) = 2 /\ rk(F :: L :: nil) = 2 /\ rk(F :: M :: nil) = 2 /\
rk(G :: H :: nil) = 2 /\ rk(G :: I :: nil) = 2 /\ rk(G :: J :: nil) = 2 /\ rk(G :: K :: nil) = 2 /\ rk(G :: L :: nil) = 2 /\ rk(G :: M :: nil) = 2 /\
rk(H :: I :: nil) = 2 /\ rk(H :: J :: nil) = 2 /\ rk(H :: K :: nil) = 2 /\ rk(H :: L :: nil) = 2 /\ rk(H :: M :: nil) = 2 /\
rk(I :: J :: nil) = 2 /\ rk(I :: K :: nil) = 2 /\ rk(I :: L :: nil) = 2 /\ rk(I :: M :: nil) = 2 /\
rk(J :: K :: nil) = 2 /\ rk(J :: L :: nil) = 2 /\ rk(J :: M :: nil) = 2 /\
rk(K :: L :: nil) = 2 /\ rk(K :: M :: nil) = 2 /\
rk(L :: M :: nil) = 2.

Parameter rk_lines :
rk (A :: B :: C :: D :: nil) = 2 /\ rk (A :: E :: F :: G :: nil) = 2 /\
rk (A :: I :: J :: M :: nil) = 2 /\ rk (A :: H :: K :: L :: nil) = 2 /\
rk (B :: E :: H :: I :: nil) = 2 /\ rk (B :: G :: J :: L :: nil) = 2 /\
rk (B :: F :: K :: M :: nil) = 2 /\ rk (D :: E :: J :: K :: nil) = 2 /\
rk (C :: E :: L :: M :: nil) = 2 /\ rk (C :: F :: H :: J :: nil) = 2 /\
rk (D :: G :: H :: M :: nil) = 2 /\ rk (D :: F :: I :: L :: nil) = 2 /\
rk (C :: G :: I :: K :: nil) = 2.

Parameter rk_planes :
rk (A :: B :: E :: nil) = 3 /\ rk (A :: B :: F :: nil) = 3 /\ rk (A :: B :: G :: nil) = 3 /\
rk (A :: B :: H :: nil) = 3 /\ rk (A :: B :: I :: nil) = 3 /\ rk (A :: B :: J :: nil) = 3 /\
rk (A :: B :: K :: nil) = 3 /\ rk (A :: B :: L :: nil) = 3 /\ rk (A :: B :: M :: nil) = 3 /\
rk (A :: C :: E :: nil) = 3 /\ rk (A :: C :: F :: nil) = 3 /\ rk (A :: C :: G :: nil) = 3 /\
rk (A :: C :: H :: nil) = 3 /\ rk (A :: C :: I :: nil) = 3 /\ rk (A :: C :: J :: nil) = 3 /\
rk (A :: C :: K :: nil) = 3 /\ rk (A :: C :: L :: nil) = 3 /\ rk (A :: C :: M :: nil) = 3 /\
rk (A :: D :: E :: nil) = 3 /\ rk (A :: D :: F :: nil) = 3 /\ rk (A :: D :: G :: nil) = 3 /\
rk (A :: D :: H :: nil) = 3 /\ rk (A :: D :: I :: nil) = 3 /\ rk (A :: D :: J :: nil) = 3 /\
rk (A :: D :: K :: nil) = 3 /\ rk (A :: D :: L :: nil) = 3 /\ rk (A :: D :: M :: nil) = 3 /\
rk (A :: E :: H :: nil) = 3 /\ rk (A :: E :: I :: nil) = 3 /\ rk (A :: E :: J :: nil) = 3 /\
rk (A :: E :: K :: nil) = 3 /\ rk (A :: E :: L :: nil) = 3 /\ rk (A :: E :: M :: nil) = 3 /\
rk (A :: F :: H :: nil) = 3 /\ rk (A :: F :: I :: nil) = 3 /\ rk (A :: F :: J :: nil) = 3 /\
rk (A :: F :: K :: nil) = 3 /\ rk (A :: F :: L :: nil) = 3 /\ rk (A :: F :: M :: nil) = 3 /\
rk (A :: G :: H :: nil) = 3 /\ rk (A :: G :: I :: nil) = 3 /\ rk (A :: G :: J :: nil) = 3 /\
rk (A :: G :: K :: nil) = 3 /\ rk (A :: G :: L :: nil) = 3 /\ rk (A :: G :: M :: nil) = 3 /\
rk (A :: H :: I :: nil) = 3 /\ rk (A :: H :: J :: nil) = 3 /\ rk (A :: H :: M :: nil) = 3 /\
rk (A :: I :: K :: nil) = 3 /\ rk (A :: I :: L :: nil) = 3 /\
rk (A :: J :: K :: nil) = 3 /\ rk (A :: J :: L :: nil) = 3 /\
rk (A :: K :: M :: nil) = 3 /\
rk (A :: L :: M :: nil) = 3 /\
rk (B :: C :: E :: nil) = 3 /\ rk (B :: C :: F :: nil) = 3 /\ rk (B :: C :: G :: nil) = 3 /\
rk (B :: C :: H :: nil) = 3 /\ rk (B :: C :: I :: nil) = 3 /\ rk (B :: C :: J :: nil) = 3 /\
rk (B :: C :: K :: nil) = 3 /\ rk (B :: C :: L :: nil) = 3 /\ rk (B :: C :: M :: nil) = 3 /\
rk (B :: D :: E :: nil) = 3 /\ rk (B :: D :: F :: nil) = 3 /\ rk (B :: D :: G :: nil) = 3 /\
rk (B :: D :: H :: nil) = 3 /\ rk (B :: D :: I :: nil) = 3 /\ rk (B :: D :: J :: nil) = 3 /\
rk (B :: D :: K :: nil) = 3 /\ rk (B :: D :: L :: nil) = 3 /\ rk (B :: D :: M :: nil) = 3 /\
rk (B :: E :: F :: nil) = 3 /\ rk (B :: E :: G :: nil) = 3 /\ rk (B :: E :: J :: nil) = 3 /\
rk (B :: E :: K :: nil) = 3 /\ rk (B :: E :: L :: nil) = 3 /\ rk (B :: E :: M :: nil) = 3 /\
rk (B :: F :: G :: nil) = 3 /\ rk (B :: F :: H :: nil) = 3 /\ rk (B :: F :: I :: nil) = 3 /\
rk (B :: F :: J :: nil) = 3 /\ rk (B :: F :: L :: nil) = 3 /\
rk (B :: G :: H :: nil) = 3 /\ rk (B :: G :: I :: nil) = 3 /\ rk (B :: G :: K :: nil) = 3 /\
rk (B :: G :: M :: nil) = 3 /\
rk (B :: H :: J :: nil) = 3 /\ rk (B :: H :: K :: nil) = 3 /\ rk (B :: H :: L :: nil) = 3 /\
rk (B :: H :: M :: nil) = 3 /\
rk (B :: I :: J :: nil) = 3 /\ rk (B :: I :: K :: nil) = 3 /\ rk (B :: I :: L :: nil) = 3 /\
rk (B :: I :: M :: nil) = 3 /\
rk (B :: J :: K :: nil) = 3 /\ rk (B :: J :: M :: nil) = 3 /\
rk (B :: K :: L :: nil) = 3 /\
rk (B :: L :: M :: nil) = 3 /\
rk (C :: D :: E :: nil) = 3 /\ rk (C :: D :: F :: nil) = 3 /\ rk (C :: D :: G :: nil) = 3 /\
rk (C :: D :: H :: nil) = 3 /\ rk (C :: D :: I :: nil) = 3 /\ rk (C :: D :: J :: nil) = 3 /\
rk (C :: D :: K :: nil) = 3 /\ rk (C :: D :: L :: nil) = 3 /\ rk (C :: D :: M :: nil) = 3 /\
rk (C :: E :: F :: nil) = 3 /\ rk (C :: E :: G :: nil) = 3 /\ rk (C :: E :: H :: nil) = 3 /\
rk (C :: E :: I :: nil) = 3 /\ rk (C :: E :: J :: nil) = 3 /\ rk (C :: E :: K :: nil) = 3 /\
rk (C :: F :: G :: nil) = 3 /\ rk (C :: F :: I :: nil) = 3 /\ rk (C :: F :: K :: nil) = 3 /\
rk (C :: F :: L :: nil) = 3 /\ rk (C :: F :: M :: nil) = 3 /\
rk (C :: G :: H :: nil) = 3 /\ rk (C :: G :: J :: nil) = 3 /\ rk (C :: G :: L :: nil) = 3 /\
rk (C :: G :: M :: nil) = 3 /\
rk (C :: H :: I :: nil) = 3 /\ rk (C :: H :: K :: nil) = 3 /\ rk (C :: H :: L :: nil) = 3 /\
rk (C :: H :: M :: nil) = 3 /\
rk (C :: I :: J :: nil) = 3 /\ rk (C :: I :: L :: nil) = 3 /\ rk (C :: I :: M :: nil) = 3 /\
rk (C :: J :: K :: nil) = 3 /\ rk (C :: J :: L :: nil) = 3 /\ rk (C :: J :: M :: nil) = 3 /\
rk (C :: K :: L :: nil) = 3 /\ rk (C :: K :: M :: nil) = 3 /\ rk (C :: K :: L :: nil) = 3 /\
rk (D :: E :: F :: nil) = 3 /\ rk (D :: E :: G :: nil) = 3 /\ rk (D :: E :: H :: nil) = 3 /\
rk (D :: E :: I :: nil) = 3 /\ rk (D :: E :: L :: nil) = 3 /\ rk (D :: E :: M :: nil) = 3 /\
rk (D :: F :: G :: nil) = 3 /\ rk (D :: F :: H :: nil) = 3 /\ rk (D :: F :: J :: nil) = 3 /\
rk (D :: F :: K :: nil) = 3 /\ rk (D :: F :: M :: nil) = 3 /\
rk (D :: G :: I :: nil) = 3 /\ rk (D :: G :: J :: nil) = 3 /\ rk (D :: G :: K :: nil) = 3 /\
rk (D :: G :: L :: nil) = 3 /\
rk (D :: H :: I :: nil) = 3 /\ rk (D :: H :: J :: nil) = 3 /\ rk (D :: H :: K :: nil) = 3 /\
rk (D :: H :: L :: nil) = 3 /\
rk (D :: I :: J :: nil) = 3 /\ rk (D :: I :: K :: nil) = 3 /\ rk (D :: I :: M :: nil) = 3 /\
rk (D :: J :: L :: nil) = 3 /\ rk (D :: J :: M :: nil) = 3 /\
rk (D :: K :: L :: nil) = 3 /\ rk (D :: K :: M :: nil) = 3 /\
rk (D :: L :: M :: nil) = 3 /\
rk (E :: F :: H :: nil) = 3 /\ rk (E :: F :: I :: nil) = 3 /\ rk (E :: F :: J :: nil) = 3 /\
rk (E :: F :: K :: nil) = 3 /\ rk (E :: F :: L :: nil) = 3 /\ rk (E :: F :: M :: nil) = 3 /\
rk (E :: G :: H :: nil) = 3 /\ rk (E :: G :: I :: nil) = 3 /\ rk (E :: G :: J :: nil) = 3 /\
rk (E :: G :: K :: nil) = 3 /\ rk (E :: G :: L :: nil) = 3 /\ rk (E :: G :: M :: nil) = 3 /\
rk (E :: H :: J :: nil) = 3 /\ rk (E :: H :: K :: nil) = 3 /\ rk (E :: H :: L :: nil) = 3 /\
rk (E :: H :: M :: nil) = 3 /\
rk (E :: I :: J :: nil) = 3 /\ rk (E :: I :: K :: nil) = 3 /\ rk (E :: I :: L :: nil) = 3 /\
rk (E :: I :: M :: nil) = 3 /\
rk (E :: J :: L :: nil) = 3 /\ rk (E :: J :: M :: nil) = 3 /\
rk (E :: K :: L :: nil) = 3 /\ rk (E :: K :: M :: nil) = 3 /\
rk (F :: G :: H :: nil) = 3 /\ rk (F :: G :: I :: nil) = 3 /\ rk (F :: G :: J :: nil) = 3 /\
rk (F :: G :: K :: nil) = 3 /\ rk (F :: G :: L :: nil) = 3 /\ rk (F :: G :: M :: nil) = 3 /\
rk (F :: H :: I :: nil) = 3 /\ rk (F :: H :: K :: nil) = 3 /\ rk (F :: H :: L :: nil) = 3 /\
rk (F :: H :: M :: nil) = 3 /\
rk (F :: I :: J :: nil) = 3 /\ rk (F :: I :: K :: nil) = 3 /\ rk (F :: I :: M :: nil) = 3 /\
rk (F :: J :: K :: nil) = 3 /\ rk (F :: J :: L :: nil) = 3 /\ rk (F :: J :: M :: nil) = 3 /\
rk (F :: K :: L :: nil) = 3 /\
rk (F :: L :: M :: nil) = 3 /\
rk (G :: H :: I :: nil) = 3 /\ rk (G :: H :: J :: nil) = 3 /\ rk (G :: H :: K :: nil) = 3 /\
rk (G :: H :: L :: nil) = 3 /\
rk (G :: I :: J :: nil) = 3 /\ rk (G :: I :: L :: nil) = 3 /\ rk (G :: I :: M :: nil) = 3 /\
rk (G :: J :: K :: nil) = 3 /\ rk (G :: J :: M :: nil) = 3 /\
rk (G :: K :: L :: nil) = 3 /\ rk (G :: K :: M :: nil) = 3 /\
rk (G :: L :: M :: nil) = 3 /\
rk (H :: I :: J :: nil) = 3 /\ rk (H :: I :: K :: nil) = 3 /\ rk (H :: I :: L :: nil) = 3 /\
rk (H :: I :: M :: nil) = 3 /\
rk (H :: J :: K :: nil) = 3 /\ rk (H :: J :: L :: nil) = 3 /\ rk (H :: J :: M :: nil) = 3 /\
rk (H :: K :: M :: nil) = 3 /\
rk (H :: L :: M :: nil) = 3 /\
rk (I :: J :: K :: nil) = 3 /\ rk (I :: J :: L :: nil) = 3 /\
rk (I :: K :: L :: nil) = 3 /\ rk (I :: K :: M :: nil) = 3 /\
rk (I :: L :: M :: nil) = 3 /\
rk (J :: K :: L :: nil) = 3 /\ rk (J :: K :: M :: nil) = 3 /\
rk (J :: L :: M :: nil) = 3 /\
rk (K :: L :: M :: nil) = 3.

(*****************************************************************************)

Ltac case_clear P := let HA:= fresh in let HB:=fresh in let HC:=fresh in let HD:=fresh in let HE:=fresh in let HF:=fresh in let HG:=fresh in let HH:=fresh in let HI:= fresh in let HL:=fresh in let HM:= fresh in
destruct (is_only_13_pts P) as [[[[[[[[[[[[HA | HB] | HC] | HD] | HE ] | HF ] | HG] | HH] |  HI ] | HJ] | HK] | HL] | HM]; subst P.

(** rk-singleton : The rank of a point is always greater than one  **)
Lemma rk_singleton_ge : forall P, rk (P :: nil) >= 1.
Proof.
intros.
assert(HH := rk_points);use HH.
case_clear P;intuition.
Qed.

Lemma rk_singleton_1 : forall A, rk(A :: nil) <= 1.
Proof.
intros.
apply matroid1_b_useful.
intuition.
Qed.

Lemma rk_couple_ge_alt : forall P Q, rk(P :: Q :: nil) = 2 -> rk(P :: Q :: nil) >=2.
Proof.
intuition.
Qed.

(** rk-couple : The rank of a two distinct points is always greater than one  **)
Lemma rk_couple_ge : forall P Q, ~ P = Q -> rk(P :: Q :: nil) >= 2.
Proof.
intros.
assert(HH := rk_distinct_points);use HH.
apply rk_couple_ge_alt.
case_clear P;case_clear Q;try equal_degens;try assumption;rewrite couple_equal;assumption.
Qed.

Lemma rk_couple_2 : forall P Q, rk(P :: Q :: nil) <= 2.
Proof.
intros.
apply matroid1_b_useful.
intuition.
Qed.

Lemma rk_couple : forall P Q : Point,~ P = Q -> rk(P :: Q :: nil) = 2.
Proof.
intros.
assert(HH := rk_couple_2 P Q).
assert(HH0 := rk_couple_ge P Q H0).
omega.
Qed.

Lemma couple_rk1 : forall P Q, rk(P :: Q :: nil) = 2 -> ~ P = Q.
Proof.
intros.
intro.
rewrite H1 in H0.
assert(HH : equivlist (Q :: Q :: nil) (Q :: nil));[my_inO|].
rewrite HH in H0.
assert(HH0 := rk_singleton_1 Q).
omega.
Qed.

Lemma quadruple_rk2_to_triple_rk2 : forall P Q R S : Point,
rk (P :: Q :: nil) = 2 -> rk(P :: Q ::  R :: S :: nil) = 2 -> rk(P :: Q :: R :: nil) = 2.
Proof.
intros.
assert(HH : incl (P :: Q :: R :: nil) (P :: Q :: R :: S :: nil));[my_inO|].
assert(HH0 := matroid2 (P :: Q :: R :: nil) (P :: Q :: R :: S :: nil) HH).
assert(HH1bis := couple_rk1 P Q H0).
assert(HH1 := rk_couple P Q HH1bis).
assert(HH2 : incl (P :: Q :: nil) (P :: Q :: R :: nil));[my_inO|].
assert(HH3 := matroid2 (P :: Q :: nil) (P :: Q :: R :: nil) HH2).
omega.
Qed.

Ltac rk_triple_to_quadruple :=
match goal with
| H0 : rk(?A :: ?B :: ?C :: ?D :: nil) = 2 |- rk(?A :: ?B :: ?C :: nil) = 2 =>
  let HH := fresh in assert(HH : rk(A :: B :: C :: nil) = 2) by (apply (quadruple_rk2_to_triple_rk2 A B C D);solve [rk_couple_triple |assumption]);assumption
| H0 : rk(?A :: ?B :: ?D :: ?C :: nil) = 2 |- rk(?A :: ?B :: ?C :: nil) = 2 =>
  rewrite <-quadruple_equal_1 in H0;let HH := fresh in assert(HH : rk(A :: B :: C :: nil) = 2) by (apply (quadruple_rk2_to_triple_rk2 A B C D);solve [rk_couple_triple|assumption]);assumption
| H0 : rk(?A :: ?C :: ?B :: ?D :: nil) = 2 |- rk(?A :: ?B :: ?C :: nil) = 2 =>
  rewrite <-quadruple_equal_2 in H0;let HH := fresh in assert(HH : rk(A :: B :: C :: nil) = 2) by (apply (quadruple_rk2_to_triple_rk2 A B C D);solve [rk_couple_triple|assumption]);assumption
| H0 : rk(?A :: ?C :: ?D :: ?B :: nil) = 2 |- rk(?A :: ?B :: ?C :: nil) = 2 =>
  rewrite <-quadruple_equal_3 in H0;let HH := fresh in assert(HH : rk(A :: B :: C :: nil) = 2) by (apply (quadruple_rk2_to_triple_rk2 A B C D);solve [rk_couple_triple|assumption]);assumption
| H0 : rk(?A :: ?D :: ?B :: ?C :: nil) = 2 |- rk(?A :: ?B :: ?C :: nil) = 2 =>
  rewrite <-quadruple_equal_4 in H0;let HH := fresh in assert(HH : rk(A :: B :: C :: nil) = 2) by (apply (quadruple_rk2_to_triple_rk2 A B C D);solve [rk_couple_triple|assumption]);assumption
| H0 : rk(?A :: ?D :: ?C :: ?B :: nil) = 2 |- rk(?A :: ?B :: ?C :: nil) = 2 =>
  rewrite <-quadruple_equal_5 in H0;let HH := fresh in assert(HH : rk(A :: B :: C :: nil) = 2) by (apply (quadruple_rk2_to_triple_rk2 A B C D);solve [rk_couple_triple|assumption]);assumption
| H0 : rk(?B :: ?A :: ?C :: ?D :: nil) = 2 |- rk(?A :: ?B :: ?C :: nil) = 2 =>
  rewrite <-quadruple_equal_6 in H0;let HH := fresh in assert(HH : rk(A :: B :: C :: nil) = 2) by (apply (quadruple_rk2_to_triple_rk2 A B C D);solve [rk_couple_triple|assumption]);assumption
| H0 : rk(?B :: ?A :: ?D :: ?C :: nil) = 2 |- rk(?A :: ?B :: ?C :: nil) = 2 =>
  rewrite <-quadruple_equal_7 in H0;let HH := fresh in assert(HH : rk(A :: B :: C :: nil) = 2) by (apply (quadruple_rk2_to_triple_rk2 A B C D);solve [rk_couple_triple|assumption]);assumption
| H0 : rk(?B :: ?C :: ?A :: ?D :: nil) = 2 |- rk(?A :: ?B :: ?C :: nil) = 2 =>
  rewrite <-quadruple_equal_8 in H0;let HH := fresh in assert(HH : rk(A :: B :: C :: nil) = 2) by (apply (quadruple_rk2_to_triple_rk2 A B C D);solve [rk_couple_triple|assumption]);assumption
| H0 : rk(?B :: ?C :: ?D :: ?A :: nil) = 2 |- rk(?A :: ?B :: ?C :: nil) = 2 =>
  rewrite <-quadruple_equal_9 in H0;let HH := fresh in assert(HH : rk(A :: B :: C :: nil) = 2) by (apply (quadruple_rk2_to_triple_rk2 A B C D);solve [rk_couple_triple|assumption]);assumption
| H0 : rk(?B :: ?D :: ?A :: ?C :: nil) = 2 |- rk(?A :: ?B :: ?C :: nil) = 2 =>
  rewrite <-quadruple_equal_10 in H0;let HH := fresh in assert(HH : rk(A :: B :: C :: nil) = 2) by (apply (quadruple_rk2_to_triple_rk2 A B C D);solve [rk_couple_triple|assumption]);assumption
| H0 : rk(?B :: ?D :: ?C :: ?A :: nil) = 2 |- rk(?A :: ?B :: ?C :: nil) = 2 =>
  rewrite <-quadruple_equal_11 in H0;let HH := fresh in assert(HH : rk(A :: B :: C :: nil) = 2) by (apply (quadruple_rk2_to_triple_rk2 A B C D);solve [rk_couple_triple|assumption]);assumption
| H0 : rk(?C :: ?A :: ?B :: ?D :: nil) = 2 |- rk(?A :: ?B :: ?C :: nil) = 2 =>
  rewrite <-quadruple_equal_12 in H0;let HH := fresh in assert(HH : rk(A :: B :: C :: nil) = 2) by (apply (quadruple_rk2_to_triple_rk2 A B C D);solve [rk_couple_triple|assumption]);assumption
| H0 : rk(?C :: ?A :: ?D :: ?B :: nil) = 2 |- rk(?A :: ?B :: ?C :: nil) = 2 =>
  rewrite <-quadruple_equal_13 in H0;let HH := fresh in assert(HH : rk(A :: B :: C :: nil) = 2) by (apply (quadruple_rk2_to_triple_rk2 A B C D);solve [rk_couple_triple|assumption]);assumption
| H0 : rk(?C :: ?B :: ?A :: ?D :: nil) = 2 |- rk(?A :: ?B :: ?C :: nil) = 2 =>
  rewrite <-quadruple_equal_14 in H0;let HH := fresh in assert(HH : rk(A :: B :: C :: nil) = 2) by (apply (quadruple_rk2_to_triple_rk2 A B C D);solve [rk_couple_triple|assumption]);assumption
| H0 : rk(?C :: ?B :: ?D :: ?A :: nil) = 2 |- rk(?A :: ?B :: ?C :: nil) = 2 =>
  rewrite <-quadruple_equal_15 in H0;let HH := fresh in assert(HH : rk(A :: B :: C :: nil) = 2) by (apply (quadruple_rk2_to_triple_rk2 A B C D);solve [rk_couple_triple|assumption]);assumption
| H0 : rk(?C :: ?D :: ?A :: ?B :: nil) = 2 |- rk(?A :: ?B :: ?C :: nil) = 2 =>
  rewrite <-quadruple_equal_16 in H0;let HH := fresh in assert(HH : rk(A :: B :: C :: nil) = 2) by (apply (quadruple_rk2_to_triple_rk2 A B C D);solve [rk_couple_triple|assumption]);assumption
| H0 : rk(?C :: ?D :: ?B :: ?A :: nil) = 2 |- rk(?A :: ?B :: ?C :: nil) = 2 =>
  rewrite <-quadruple_equal_17 in H0;let HH := fresh in assert(HH : rk(A :: B :: C :: nil) = 2) by (apply (quadruple_rk2_to_triple_rk2 A B C D);solve [rk_couple_triple|assumption]);assumption
| H0 : rk(?D :: ?A :: ?B :: ?C :: nil) = 2 |- rk(?A :: ?B :: ?C :: nil) = 2 =>
  rewrite <-quadruple_equal_18 in H0;let HH := fresh in assert(HH : rk(A :: B :: C :: nil) = 2) by (apply (quadruple_rk2_to_triple_rk2 A B C D);solve [rk_couple_triple|assumption]);assumption
| H0 : rk(?D :: ?A :: ?C :: ?B :: nil) = 2 |- rk(?A :: ?B :: ?C :: nil) = 2 =>
  rewrite <-quadruple_equal_19 in H0;let HH := fresh in assert(HH : rk(A :: B :: C :: nil) = 2) by (apply (quadruple_rk2_to_triple_rk2 A B C D);solve [rk_couple_triple|assumption]);assumption
| H0 : rk(?D :: ?B :: ?A :: ?C :: nil) = 2 |- rk(?A :: ?B :: ?C :: nil) = 2 =>
  rewrite <-quadruple_equal_20 in H0;let HH := fresh in assert(HH : rk(A :: B :: C :: nil) = 2) by (apply (quadruple_rk2_to_triple_rk2 A B C D);solve [rk_couple_triple|assumption]);assumption
| H0 : rk(?D :: ?B :: ?C :: ?A :: nil) = 2 |- rk(?A :: ?B :: ?C :: nil) = 2 =>
  rewrite <-quadruple_equal_21 in H0;let HH := fresh in assert(HH : rk(A :: B :: C :: nil) = 2) by (apply (quadruple_rk2_to_triple_rk2 A B C D);solve [rk_couple_triple|assumption]);assumption
| H0 : rk(?D :: ?C :: ?A :: ?B :: nil) = 2 |- rk(?A :: ?B :: ?C :: nil) = 2 =>
  rewrite <-quadruple_equal_22 in H0;let HH := fresh in assert(HH : rk(A :: B :: C :: nil) = 2) by (apply (quadruple_rk2_to_triple_rk2 A B C D);solve [rk_couple_triple|assumption]);assumption
| H0 : rk(?D :: ?C :: ?B :: ?A :: nil) = 2 |- rk(?A :: ?B :: ?C :: nil) = 2 =>
  rewrite <-quadruple_equal_23 in H0;let HH := fresh in assert(HH : rk(A :: B :: C :: nil) = 2) by (apply (quadruple_rk2_to_triple_rk2 A B C D);solve [rk_couple_triple|assumption]);assumption
end.

Lemma triple_rk2_1 : forall P R, rk(P :: R :: nil) = 2 -> rk(P :: P :: R :: nil) = 2.
Proof.
intros.
assert(HH : equivlist (P :: P :: R :: nil) (P :: R :: nil));[my_inO|];rewrite HH;intuition.
Qed.

Lemma triple_rk2_2 : forall P R, rk(P :: R :: nil) = 2 -> rk(P :: R :: P :: nil) = 2.
Proof.
intros.
assert(HH : equivlist (P :: R :: P :: nil) (P :: R :: nil));[my_inO|];rewrite HH;intuition.
Qed.

Lemma triple_rk2_3 : forall P R, rk(P :: R :: nil) = 2 -> rk(R :: P :: P :: nil) = 2.
Proof.
intros.
assert(HH : equivlist (R :: P :: P :: nil) (P :: R :: nil));[my_inO|];rewrite HH;intuition.
Qed.

Ltac degens_rk2' :=
  solve[ first [apply triple_rk2_1 | apply triple_rk2_2 | apply triple_rk2_3];rk_couple_triple].

Ltac solve_ex_1 L := solve [exists L; repeat split;solve [ assumption |  degens_rk2' | rk_couple_triple | rk_triple_to_quadruple]].

Ltac solve_ex_p_1 := first [
        solve_ex_1 A
     |  solve_ex_1 B
     |  solve_ex_1 C
     |  solve_ex_1 D
     |  solve_ex_1 E
     |  solve_ex_1 F
     |  solve_ex_1 G
     |  solve_ex_1 H
     |  solve_ex_1 I
     |  solve_ex_1 J
     |  solve_ex_1 K
     |  solve_ex_1 L
     |  solve_ex_1 M
 ].

Ltac rk_three_points_simplify P Q :=
match goal with
| H0 : rk(P :: Q :: ?R :: ?X :: nil) = 2 |- _ => let HH := fresh in assert(HH : rk(P :: Q :: R :: nil) = 2) by (apply (quadruple_rk2_to_triple_rk2 P Q R X);try rk_couple_triple;assumption);solve_ex_1 R
| H0 : rk(P :: ?R :: Q :: ?X :: nil) = 2 |- _ => rewrite <-quadruple_equal_2 in H0;let HH := fresh in assert(HH : rk(P :: Q :: R :: nil) = 2) by (apply (quadruple_rk2_to_triple_rk2 P Q R X);try rk_couple_triple;assumption);solve_ex_1 R
| H0 : rk(P :: ?R :: ?X :: Q :: nil) = 2 |- _ => rewrite <-quadruple_equal_3 in H0;let HH := fresh in assert(HH : rk(P :: Q :: R :: nil) = 2) by (apply (quadruple_rk2_to_triple_rk2 P Q R X);try rk_couple_triple;assumption);solve_ex_1 R
| H0 : rk(Q :: P :: ?R :: ?X :: nil) = 2 |- _ => rewrite <-quadruple_equal_6 in H0;let HH := fresh in assert(HH : rk(P :: Q :: R :: nil) = 2) by (apply (quadruple_rk2_to_triple_rk2 P Q R X);try rk_couple_triple;assumption);solve_ex_1 R
| H0 : rk(Q :: ?R :: P :: ?X :: nil) = 2 |- _ => rewrite <-quadruple_equal_8 in H0;let HH := fresh in assert(HH : rk(P :: Q :: R :: nil) = 2) by (apply (quadruple_rk2_to_triple_rk2 P Q R X);try rk_couple_triple;assumption);solve_ex_1 R
| H0 : rk(Q :: ?R :: ?X :: P :: nil) = 2 |- _ => rewrite <-quadruple_equal_9 in H0;let HH := fresh in assert(HH : rk(P :: Q :: R :: nil) = 2) by (apply (quadruple_rk2_to_triple_rk2 P Q R X);try rk_couple_triple;assumption);solve_ex_1 R
| H0 : rk(?R :: P :: Q :: ?X :: nil) = 2 |- _ => rewrite <-quadruple_equal_12 in H0;let HH := fresh in assert(HH : rk(P :: Q :: R :: nil) = 2) by (apply (quadruple_rk2_to_triple_rk2 P Q R X);try rk_couple_triple;assumption);solve_ex_1 R
| H0 : rk(?R :: P :: ?X :: Q :: nil) = 2 |- _ => rewrite <-quadruple_equal_13 in H0;let HH := fresh in assert(HH : rk(P :: Q :: R :: nil) = 2) by (apply (quadruple_rk2_to_triple_rk2 P Q R X);try rk_couple_triple;assumption);solve_ex_1 R
| H0 : rk(?R :: Q :: P :: ?X :: nil) = 2 |- _ => rewrite <-quadruple_equal_14 in H0;let HH := fresh in assert(HH : rk(P :: Q :: R :: nil) = 2) by (apply (quadruple_rk2_to_triple_rk2 P Q R X);try rk_couple_triple;assumption);solve_ex_1 R
| H0 : rk(?R :: Q :: ?X :: P :: nil) = 2 |- _ => rewrite <-quadruple_equal_15 in H0;let HH := fresh in assert(HH : rk(P :: Q :: R :: nil) = 2) by (apply (quadruple_rk2_to_triple_rk2 P Q R X);try rk_couple_triple;assumption);solve_ex_1 R
| H0 : rk(?R :: ?X :: P :: Q :: nil) = 2 |- _ => rewrite <-quadruple_equal_16 in H0;let HH := fresh in assert(HH : rk(P :: Q :: R :: nil) = 2) by (apply (quadruple_rk2_to_triple_rk2 P Q R X);try rk_couple_triple;assumption);solve_ex_1 R
| H0 : rk(?R :: ?X :: Q :: P :: nil) = 2 |- _ => rewrite <-quadruple_equal_17 in H0;let HH := fresh in assert(HH : rk(P :: Q :: R :: nil) = 2) by (apply (quadruple_rk2_to_triple_rk2 P Q R X);try rk_couple_triple;assumption);solve_ex_1 R
end.

Ltac rk_three_points_simplify_bis :=
match goal with
| H : _ |- exists R, rk (?P :: ?P :: _ :: nil) = 2 /\ _ /\ _ => solve_ex_p_1
| H : _ |- exists R, rk (?P :: ?Q :: R :: nil) = 2 /\ _ /\ _ => rk_three_points_simplify P Q
end.

(** rk-three_point_on_lines : Each lines contains at least three points **)
Lemma rk_three_points_on_lines : forall P Q, exists R,
rk (P :: Q :: R :: nil) = 2 /\ rk (Q :: R :: nil) = 2 /\ rk (P :: R :: nil) = 2.
Proof.
intros.
assert(HH := rk_distinct_points);assert(HH0 := rk_lines);use HH;use HH0.
case_clear P;case_clear Q;rk_three_points_simplify_bis.
Qed.

Ltac rk_inter_simplify P Q R S X X' Y Y' :=
match goal with
| H : _ |- exists J, rk (_ :: Y :: _ :: nil) = 2 /\ rk (_ :: _ :: _ :: nil) = 2 => try solve_ex_1 Y
| H : _ |- exists J, rk (Y :: _ :: _ :: nil) = 2 /\ rk (_ :: _ :: _ :: nil) = 2 => try solve_ex_1 Y
| H : _ |- exists J, rk (_ :: Y' :: _ :: nil) = 2 /\ rk (_ :: _ :: _ :: nil) = 2 => try solve_ex_1 Y'
| H : _ |- exists J, rk (Y' :: _ :: _ :: nil) = 2 /\ rk (_ :: _ :: _ :: nil) = 2 => try solve_ex_1 Y'
| H : _ |- exists J, rk (_ :: _ :: _ :: nil) = 2 /\ rk (_ :: X :: _ :: nil) = 2 => try solve_ex_1 X
| H : _ |- exists J, rk (_ :: _ :: _ :: nil) = 2 /\ rk (X :: _ :: _ :: nil) = 2 => try solve_ex_1 X
| H : _ |- exists J, rk (_ :: _ :: _ :: nil) = 2 /\ rk (_ :: X' :: _ :: nil) = 2 => try solve_ex_1 X'
| H : _ |- exists J, rk (_ :: _ :: _ :: nil) = 2 /\ rk (X' :: _ :: _ :: nil) = 2 => try solve_ex_1 X'
| H : _ |- exists J, rk (_ :: _ :: _ :: nil) = 2 /\ rk (_ :: _ :: _ :: nil) = 2 => try solve_ex_1 X;try solve_ex_1 X'
end.

Ltac rk_inter_simplify_bis P Q R S X X' :=
match goal with
| H : rk(R :: S :: ?Y :: ?Y' :: nil) = 2 |- _ => rk_inter_simplify P Q R S X X' Y Y'
| H : rk(R :: ?Y :: S :: ?Y' :: nil) = 2 |- _ => rk_inter_simplify P Q R S X X' Y Y'
| H : rk(R :: ?Y :: ?Y' :: S :: nil) = 2 |- _ => rk_inter_simplify P Q R S X X' Y Y'
| H : rk(S :: R :: ?Y :: ?Y' :: nil) = 2 |- _ => rk_inter_simplify P Q R S X X' Y Y'
| H : rk(S :: ?Y :: R :: ?Y' :: nil) = 2 |- _ => rk_inter_simplify P Q R S X X' Y Y'
| H : rk(S :: ?Y :: ?Y' :: R :: nil) = 2 |- _ => rk_inter_simplify P Q R S X X' Y Y'
| H : rk(?Y :: R :: S :: ?Y' :: nil) = 2 |- _ => rk_inter_simplify P Q R S X X' Y Y'
| H : rk(?Y :: R :: ?Y' :: S :: nil) = 2 |- _ => rk_inter_simplify P Q R S X X' Y Y'
| H : rk(?Y :: S :: R :: ?Y' :: nil) = 2 |- _ => rk_inter_simplify P Q R S X X' Y Y'
| H : rk(?Y :: S :: ?Y' :: R :: nil) = 2 |- _ => rk_inter_simplify P Q R S X X' Y Y'
| H : rk(?Y :: ?Y' :: R :: S :: nil) = 2 |- _ => rk_inter_simplify P Q R S X X' Y Y'
| H : rk(?Y :: ?Y' :: S :: R :: nil) = 2 |- _ => rk_inter_simplify P Q R S X X' Y Y'
end.

Ltac rk_inter_simplify_bis_bis :=
match goal with
| H : _ |- exists J, rk (?P :: ?P :: _ :: nil) = 2 /\ rk (?P :: ?P :: _ :: nil) = 2 => solve_ex_p_1
| H : _ |- exists J, rk (?P :: ?P :: _ :: nil) = 2 /\ rk (?Q :: ?Q :: _ :: nil) = 2 => solve_ex_p_1

| H : _ |- exists J, rk (?P :: ?Q :: _ :: nil) = 2 /\ rk (?P :: ?P :: _ :: nil) = 2 => solve_ex_1 P
| H : _ |- exists J, rk (?Q :: ?P :: _ :: nil) = 2 /\ rk (?Q :: ?Q :: _ :: nil) = 2 => solve_ex_1 P
| H : _ |- exists J, rk (?Q :: ?Q :: _ :: nil) = 2 /\ rk (?P :: ?Q :: _ :: nil) = 2 => solve_ex_1 P
| H : _ |- exists J, rk (?Q :: ?Q :: _ :: nil) = 2 /\ rk (?Q :: ?P :: _ :: nil) = 2 => solve_ex_1 P

| H : _ |- exists J, rk (?P :: ?Q :: _ :: nil) = 2 /\ rk (?R :: ?R :: _ :: nil) = 2 => solve_ex_1 P
| H : _ |- exists J, rk (?R :: ?R :: _ :: nil) = 2 /\ rk (?P :: ?Q :: _ :: nil) = 2 => solve_ex_1 P

| H : _ |- exists J, rk (?P :: ?Q :: _ :: nil) = 2 /\ rk (?R :: ?P :: _ :: nil) = 2 => solve_ex_1 P
| H : _ |- exists J, rk (?P :: ?Q :: _ :: nil) = 2 /\ rk (?P :: ?R :: _ :: nil) = 2 => solve_ex_1 P
| H : _ |- exists J, rk (?Q :: ?P :: _ :: nil) = 2 /\ rk (?R :: ?P :: _ :: nil) = 2 => solve_ex_1 P
| H : _ |- exists J, rk (?Q :: ?P :: _ :: nil) = 2 /\ rk (?P :: ?R :: _ :: nil) = 2 => solve_ex_1 P

| H : rk(?P :: ?Q :: ?X :: ?X' :: nil) = 2 |- exists J, rk (?P :: ?Q :: _ :: nil) = 2 /\ rk (?R :: ?S :: _ :: nil) = 2 => rk_inter_simplify_bis P Q R S X X'
| H : rk(?P :: ?X :: ?Q :: ?X' :: nil) = 2 |- exists J, rk (?P :: ?Q :: _ :: nil) = 2 /\ rk (?R :: ?S :: _ :: nil) = 2 => rk_inter_simplify_bis P Q R S X X'
| H : rk(?P :: ?X :: ?X' :: ?Q :: nil) = 2 |- exists J, rk (?P :: ?Q :: _ :: nil) = 2 /\ rk (?R :: ?S :: _ :: nil) = 2 => rk_inter_simplify_bis P Q R S X X'
| H : rk(?Q :: ?P :: ?X :: ?X' :: nil) = 2 |- exists J, rk (?P :: ?Q :: _ :: nil) = 2 /\ rk (?R :: ?S :: _ :: nil) = 2 => rk_inter_simplify_bis P Q R S X X'
| H : rk(?Q :: ?X :: ?P :: ?X' :: nil) = 2 |- exists J, rk (?P :: ?Q :: _ :: nil) = 2 /\ rk (?R :: ?S :: _ :: nil) = 2 => rk_inter_simplify_bis P Q R S X X'
| H : rk(?Q :: ?X :: ?X' :: ?P :: nil) = 2 |- exists J, rk (?P :: ?Q :: _ :: nil) = 2 /\ rk (?R :: ?S :: _ :: nil) = 2 => rk_inter_simplify_bis P Q R S X X'
| H : rk(?X :: ?P :: ?Q :: ?X' :: nil) = 2 |- exists J, rk (?P :: ?Q :: _ :: nil) = 2 /\ rk (?R :: ?S :: _ :: nil) = 2 => rk_inter_simplify_bis P Q R S X X'
| H : rk(?X :: ?P :: ?X' :: ?Q :: nil) = 2 |- exists J, rk (?P :: ?Q :: _ :: nil) = 2 /\ rk (?R :: ?S :: _ :: nil) = 2 => rk_inter_simplify_bis P Q R S X X'
| H : rk(?X :: ?Q :: ?P :: ?X' :: nil) = 2 |- exists J, rk (?P :: ?Q :: _ :: nil) = 2 /\ rk (?R :: ?S :: _ :: nil) = 2 => rk_inter_simplify_bis P Q R S X X'
| H : rk(?X :: ?Q :: ?X' :: ?P :: nil) = 2 |- exists J, rk (?P :: ?Q :: _ :: nil) = 2 /\ rk (?R :: ?S :: _ :: nil) = 2 => rk_inter_simplify_bis P Q R S X X'
| H : rk(?X :: ?X' :: ?P :: ?Q :: nil) = 2 |- exists J, rk (?P :: ?Q :: _ :: nil) = 2 /\ rk (?R :: ?S :: _ :: nil) = 2 => rk_inter_simplify_bis P Q R S X X'
| H : rk(?X :: ?X' :: ?Q :: ?P :: nil) = 2 |- exists J, rk (?P :: ?Q :: _ :: nil) = 2 /\ rk (?R :: ?S :: _ :: nil) = 2 => rk_inter_simplify_bis P Q R S X X'
end.

(** rk-inter : Two lines always intersect in the plane **)
Lemma rk_inter : forall P Q R S, exists J, rk (P :: Q :: J :: nil) = 2 /\ rk (R :: S :: J :: nil) = 2.
Proof.
intros.
assert(HH := rk_distinct_points);assert(HH0 := rk_lines);use HH;use HH0.
case_clear P;case_clear Q;
abstract(case_clear R;case_clear S;try rk_inter_simplify_bis_bis).
Qed.

(** rk-lower_dim : There exist three points which are not collinear **)
Lemma rk_lower_dim : exists P0 P1 P2, rk( P0 :: P1 :: P2 :: nil) >=3.
Proof.
intros.
assert(HH := rk_planes);use HH.
exists A;exists B;exists E;intuition.
Qed.

End s_fanoPlaneModelRkPG23.


Require Import Coq.Relations.Relations.
Require Import Coq.Classes.RelationClasses.
Require Import Coq.Classes.Morphisms.
From algebra Require Import Semigroups Monoids Groups.

Section AbelianGroups.
Context {Carrier: Type}.
Context (equiv: relation Carrier).
Context {equiv_equiv: Equivalence equiv}.
Context (op: Carrier -> Carrier -> Carrier).
Context {op_proper: Proper (equiv ==> equiv ==> equiv) op}.
Context (ident: Carrier).
Context (inv: Carrier -> Carrier).
Context {inv_proper: Proper (equiv ==> equiv) inv}.

Infix "==" := equiv (at level 60, no associativity).
Infix "<o>" := op (at level 40, left associativity).

Class AbelianGroup := {
  abelian_group :> Group equiv op ident inv;
  abelian_comm :> Commutative equiv op;
}.

Context {abelian: AbelianGroup}.

Section Subgroups.
Context (P: Carrier -> Prop).
Context {P_proper: Proper (equiv ==> iff) P}.
Context {subgroup: Subgroup op ident inv P}.

Theorem subagroup_cosets_coincide:
  forall (m: Carrier),
    P m ->
    (forall (a: Carrier),
      exists (n: Carrier),
        P n /\ a <o> m == n <o> a).
Proof.
  intros m HPm a.
  exists m.
  split;
    [assumption | apply abelian_comm].
Qed.

Corollary subagroup_congru_coincide:
  forall (a b: Carrier),
   left_congru op inv P a b <->
   right_congru op inv P a b.
Proof.
  apply (normal_subgroup_equiv_congru_cosets equiv op ident inv);
    try assumption.
  apply subagroup_cosets_coincide.
Qed.

Corollary subagroup_coset_eq_coincide:
  forall (a b: Carrier),
    left_cosets_eq equiv op P a b <->
    right_cosets_eq equiv op P a b.
Proof.
  apply (normal_subgroup_equiv_cosets_eq_cosets equiv op ident inv);
    try assumption.
  apply subagroup_cosets_coincide.
Qed.

Corollary subagroup_conj_closed:
  forall (n: Carrier),
    P n ->
    forall (a: Carrier), P (a <o> n <o> inv a).
Proof.
  apply (normal_subgroup_equiv_cosets_conj equiv op ident inv);
    try assumption.
  apply subagroup_cosets_coincide.
Qed.

Corollary subagroup_conj_closed_exact:
  forall (n a: Carrier),
    P n <-> P (a <o> n <o> inv a).
Proof.
  apply (normal_subgroup_equiv_cosets_conj_exact equiv op ident inv).
    try assumption.
  apply subagroup_cosets_coincide.
Qed.

#[global]
Instance quotient_subagroup_group: Group (left_congru op inv P) op ident inv.
Proof.
  apply (quotient_normal_subgroup_group equiv op ident inv P).
  apply subagroup_congru_coincide.
Qed.
End Subgroups.
End AbelianGroups.

Section AbelianSubgroups.
Context {Carrier: Type}.
Context (equiv: relation Carrier).
Context {equiv_equiv: Equivalence equiv}.
Context (op: Carrier -> Carrier -> Carrier).
Context {op_proper: Proper (equiv ==> equiv ==> equiv) op}.
Context (ident: Carrier).
Context (inv: Carrier -> Carrier).
Context {inv_proper: Proper (equiv ==> equiv) inv}.
Context (abelian: AbelianGroup equiv op ident inv).
Infix "==" := equiv (at level 60, no associativity).
Infix "<o>" := op (at level 40, left associativity).
Context (P: Carrier -> Prop).
Context {P_proper: Proper (equiv ==> iff) P}.
Context {subgroup: Subgroup op ident inv P}.

#[global]
Instance quotient_subagroup: AbelianGroup (left_congru op inv P) op ident inv.
Proof.
  constructor.
  { apply (quotient_subagroup_group equiv op ident inv P). }
  { constructor.
    intros a b.
    assert (inv (a <o> b) <o> (b <o> a) == ident).
    { transitivity (inv (a <o> b) <o> (a <o> b));
        [apply (semigroup_op_l equiv op);
          apply (abelian_comm equiv op ident inv) |].
      apply (group_inv_l equiv op ident inv). }
    { apply P_proper in H.
      apply H.
      apply (subgroup_ident op ident inv P). } }
Qed.
End AbelianSubgroups.


Require Import Crypto.Algebra.Field.
Require Import Crypto.Util.GlobalSettings.
Require Import Crypto.Util.Sum Crypto.Util.Prod.
Require Import Crypto.Util.Tactics.BreakMatch.
Require Import Crypto.Spec.MontgomeryCurve Crypto.Spec.WeierstrassCurve.

Module M.
  Section MontgomeryCurve.
    Import BinNat.
    Context {F Feq Fzero Fone Fopp Fadd Fsub Fmul Finv Fdiv}
            {field:@Algebra.Hierarchy.field F Feq Fzero Fone Fopp Fadd Fsub Fmul Finv Fdiv}
            {Feq_dec:Decidable.DecidableRel Feq}
            {char_ge_3:@Ring.char_ge F Feq Fzero Fone Fopp Fadd Fsub Fmul (BinNat.N.succ_pos (BinNat.N.two))}.
    Local Infix "=" := Feq : type_scope. Local Notation "a <> b" := (not (a = b)) : type_scope.
    Local Infix "+" := Fadd. Local Infix "*" := Fmul.
    Local Infix "-" := Fsub. Local Infix "/" := Fdiv.
    Local Notation "- x" := (Fopp x).
    Local Notation "x ^ 2" := (x*x) (at level 30).
    Local Notation "x ^ 3" := (x*x^2) (at level 30).
    Local Notation "0" := Fzero.  Local Notation "1" := Fone.
    Local Notation "'∞'" := unit : type_scope.
    Local Notation "'∞'" := (inr tt) : core_scope.
    Local Notation "( x , y )" := (inl (pair x y)).
    Local Open Scope core_scope.

    Context {a b: F} {b_nonzero:b <> 0}.

    Program Definition opp (P:@M.point F Feq Fadd Fmul a b) : @M.point F Feq Fadd Fmul a b :=
      match P return F*F+∞ with
      | (x, y) => (x, -y)
      | ∞ => ∞
      end.
    Next Obligation. Proof. destruct P; cbv; break_match; trivial; fsatz. Qed.

    Local Notation add := (M.add(b_nonzero:=b_nonzero)).
    Local Notation point := (@M.point F Feq Fadd Fmul a b).

    Section MontgomeryWeierstrass.
      Local Notation "2" := (1+1).
      Local Notation "3" := (1+2).
      Local Notation "4" := (1+1+1+1).
      Local Notation "9" := (3*3).
      Local Notation "27" := (4*4 + 4+4 +1+1+1).

      Context {char_ge_28:@Ring.char_ge F Feq Fzero Fone Fopp Fadd Fsub Fmul 28}.

      Context {aw bw} {Haw:aw=(3-a^2)/(3*b^2)} {Hbw:bw=(2*a^3-9*a)/(27*b^3)}.
      Local Notation Wpoint := (@W.point F Feq Fadd Fmul aw bw).
      Local Notation Wadd := (@W.add F Feq Fzero Fone Fopp Fadd Fsub Fmul Finv Fdiv field Feq_dec char_ge_3 aw bw).
      Program Definition to_Weierstrass (P:@point) : Wpoint :=
        match M.coordinates P return F*F+∞ with
        | (x, y) => ((x + a/3)/b, y/b)
        | _ => ∞
        end.
      Next Obligation. Proof. destruct P; cbv; break_match; trivial; fsatz. Qed.

      Program Definition of_Weierstrass (P:Wpoint) : point :=
        match W.coordinates P return F*F+∞ with
        | (x,y) => (b*x-a/3, b*y)
        | _ => ∞
        end.
      Next Obligation. Proof. destruct P; cbv; break_match; trivial; fsatz. Qed.
    End MontgomeryWeierstrass.
  End MontgomeryCurve.
End M.


Require Import Setoid Ring Ring_theory.

Module abs_ring.

Parameters (Coef:Set)(c0 c1 : Coef)
(cadd cmul csub: Coef -> Coef -> Coef)
(copp : Coef -> Coef)
(ceq : Coef -> Coef -> Prop)
(ceq_sym : forall x y, ceq x y -> ceq y x)
(ceq_trans : forall x y z, ceq x y -> ceq y z -> ceq x z)
(ceq_refl : forall x, ceq x x).

Add Relation Coef ceq
  reflexivity proved by ceq_refl symmetry proved by ceq_sym
  transitivity proved by ceq_trans
  as ceq_relation.

Add Morphism cadd with signature ceq ==> ceq ==> ceq as cadd_Morphism.
Admitted.

Add Morphism cmul with signature ceq ==> ceq ==> ceq as cmul_Morphism.
Admitted.

Add Morphism copp with signature ceq ==> ceq as copp_Morphism.
Admitted.

Definition cRth : ring_theory c0 c1 cadd cmul csub copp ceq.
Admitted.

Add Ring CoefRing : cRth.

End abs_ring.
Import abs_ring.

Theorem check_setoid_ring_modules :
  forall a b, ceq (cadd a b) (cadd b a).
intros.
ring.
Qed.


Require Import POCS.
Require Import Refinement.Interface.

Module StatDB.

  Inductive Op : Type -> Type :=
  | Add (v : nat) : Op unit
  | Mean : Op (option nat).

  Definition State := list nat.

  Inductive step : forall `(op: Op T), Semantics State T :=
  | step_add : forall v (state : State),
      step (Add v) state tt (v :: state)
  | step_mean_empty : forall (state : State),
      state = nil ->
      step Mean state None state
  | step_mean_nonempty : forall r (state : State),
      length state > 0 ->
      r = Nat.div (fold_right plus 0 state) (length state) ->
      step Mean state (Some r) state.

  Definition inited (state: State) := state = nil.
  Definition crash_relation (state state' : State) := False.

  Definition API :=
    {|
      op_sem := @step;
      crash_effect := crash_relation;
      init_sem := inited;
    |}.

End StatDB.


(** * POrderBool.v : Partial order of bool *)

From Babel Require Import TerminalDogma
                          ExtraDogma.Extensionality
                          ExtraDogma.IotaDescription.

From Coq Require Import Relations Classical Arith.

From Babel Require Export SetFacility POrderFacility.

From Babel.Ranko Require Import LogicCharacter SetCharacter.

Set Implicit Arguments.
Unset Strict Implicit.
Unset Printing Implicit Defensive.

Module BoolOrder.
Open Scope NSet_scope.

Definition impl : relation bool :=
    fun x y => x -> y.
#[local] Hint Unfold impl : magic_book.

Lemma impl_refl : reflexive _ impl.
Proof. by rewrite /reflexive /impl. Qed.

Lemma impl_trans : transitive _ impl.
Proof.
    rewrite /transitive /impl => x y z Hxy Hyz Hx.
    by apply /Hyz /Hxy.
Qed.

Lemma impl_antisym : antisymmetric _ impl.
Proof.
    rewrite /antisymmetric /impl. rewrite /is_true.
    case; case => //= H1 H2.
    symmetry. by apply H1.
    by apply H2.
Qed.

Definition poset_mixin : Poset.mixin_of bool :=
    Poset.Mixin {|
        ord_refl := impl_refl;
        ord_trans := impl_trans;
        ord_antisym := impl_antisym
    |}.

Canonical poset_type := Poset bool poset_mixin.

(** join *)
Definition pred_join (A : 𝒫(bool)) (b : bool) : Prop :=
    (true ∈ A) <-> b.
#[local] Hint Unfold pred_join : magic_book.

Lemma pred_join_iotaMixin (A : 𝒫(bool)) : Iota.mixin_of (pred_join A).
Proof. rewrite /Iota.mixin_of /pred_join /unique => //=.
    case (classic (true ∈ A)).

    exists true. set_level.
    symmetry. by apply H0.

    exists false. set_level.
    rewrite H0 in H. by destruct x' => //=.
Qed.

Canonical pred_join_iota (A : 𝒫(bool)) :=
    Iota (pred_join A) (pred_join_iotaMixin A).

Definition clattice_join_essence : CLattice.join_essence_of bool.
Proof.
    refine (@CLattice.JoinEssence _ (fun A => ι(pred_join A)) _) => A.

    rewrite /supremum /least /ub => //=. split.
    rewrite /upper_bound => a Hain Ha //=.
    apply (iota_spec (pred_join A)). by rewrite -Ha.

    rewrite /upper_bound /ord_op //= => b. rewrite /impl => Ha.
    replace (is_true (ι (pred_join_iota A))) with (true ∈ A).
    2: apply propositional_extensionality; apply (iota_spec (pred_join A)).
    move => HA. by apply (Ha true).
Defined.

Definition AUX_clattice_type :=
    CLattice bool (CLattice.join_essence_to_mixin (clattice_join_essence)).

Definition lattice_mixin : Lattice.mixin_of (Poset.class bool) :=
    Lattice.class [lattice of AUX_clattice_type].

Canonical lattice_type := Lattice bool lattice_mixin.

Definition clattice_mixin : CLattice.mixin_of (Lattice.class bool) :=
    CLattice.class [clattice of AUX_clattice_type].

Canonical clattice_type := CLattice bool clattice_mixin.

Canonical cpo_type : cpo := CPO bool (CPO.class [cpo of [clattice of bool]]).

Module CanonicalStruct.

Canonical poset_type.
Canonical lattice_type.
Canonical cpo_type.
Canonical clattice_type.
#[global] Hint Unfold impl : magic_book.
#[global] Hint Unfold pred_join : magic_book.

End CanonicalStruct.

End BoolOrder.


Require Import Coq.ZArith.BinInt.
Require Import Coq.Program.Program.
Require Import ProD3.examples.sbf.Utils.
Import ListNotations.
Open Scope Z_scope.

Definition listn (T : Type) size := { i : list T | Zlength i = size }.

Program Definition map_listn {A B : Type} {size}
    (f : A -> B) (l : listn A size) : listn B size :=
  map f l.
Next Obligation.
  destruct l as [l ?H]. list_solve.
Qed.

Program Definition Inhabitant_listn {A : Type} {dA : Inhabitant A} size (H : 0 <= size) : Inhabitant (listn A size) :=
  Zrepeat (default (Inhabitant := dA)) size.
Next Obligation.
  list_solve.
Qed.

Section ConFilter.

Context {num_frames num_rows num_slots : Z}.
Hypothesis H_num_frames : 1 < num_frames.
Hypothesis H_num_rows : 0 < num_rows.
Hypothesis H_num_slots : 0 < num_slots.

Definition row := listn bool num_slots.

#[local] Program Instance Inhabitant_row : Inhabitant row :=
  Inhabitant_listn _ _.
Next Obligation.
  lia.
Qed.

Definition frame := listn row num_rows.

#[local] Program Instance Inhabitant_frame : Inhabitant frame :=
  Inhabitant_listn _ _.
Next Obligation.
  lia.
Qed.

Program Definition row_empty : row :=
  Zrepeat false num_slots.
Next Obligation.
  list_solve.
Qed.

Program Definition frame_empty : frame :=
  Zrepeat row_empty num_rows.
Next Obligation.
  list_solve.
Qed.

Program Definition row_insert (r : row) (i : Z) : row :=
  upd_Znth i r true.
Next Obligation.
  destruct r. list_solve.
Qed.

Lemma row_insert_comm : forall (r : row) x y,
  row_insert (row_insert r x) y = row_insert (row_insert r y) x.
Proof.
  intros. destruct r as [r ?H]. unfold row_insert. simpl.
  remember (row_insert_obligation_1
       (exist (fun i : list bool => Zlength i = num_slots) (upd_Znth x r true)
          (row_insert_obligation_1 (exist (fun i : list bool => Zlength i = num_slots) r H)
             x)) y) as p1.
  remember (row_insert_obligation_1
       (exist (fun i : list bool => Zlength i = num_slots) (upd_Znth y r true)
          (row_insert_obligation_1 (exist (fun i : list bool => Zlength i = num_slots) r H)
             y)) x) as p2.
  simpl in *. clear Heqp1 Heqp2.
  remember (upd_Znth y (upd_Znth x r true) true) as l1.
  remember (upd_Znth x (upd_Znth y r true) true) as l2.
  assert (l1 = l2) by list_solve. clear Heql1 Heql2. subst l2.
  pose proof (Eqdep_dec.UIP_dec Z.eq_dec p1 p2). rewrite H0. auto.
Qed.

Program Definition frame_insert (f : frame) (is : listn Z num_rows) : frame :=
  map2 row_insert f is.
Next Obligation.
  destruct is, f; simpl.
  list_solve.
Qed.

Program Definition row_clear (r : row) (i : Z) : row:=
  upd_Znth i r false.
Next Obligation.
  destruct r. list_solve.
Qed.

Program Definition frame_clear (f : frame) (is : listn Z num_rows) : frame :=
  map2 row_clear f is.
Next Obligation.
  destruct is, f; simpl.
  list_solve.
Qed.

Program Definition row_query (r : row) (i : Z) : bool :=
  Znth i r.

Lemma row_query_insert_true : forall (r: row) z,
  0 <= z < num_slots -> row_query (row_insert r z) z = true.
Proof.
  intros. destruct r as [r ?H]. unfold row_query, row_insert. simpl. list_solve.
Qed.

Program Definition frame_query (f : frame) (is : list Z) : bool :=
  fold_andb (map2 row_query f is).

Record filter := mk_filter {
  fil_frames : listn frame num_frames;
  fil_clear_index : Z;
  fil_timer : Z * bool;
}.

Definition clear_index_wf (i: Z) := 0 <= i < num_slots.

Context (frame_tick_tocks : Z).

Hypothesis H_frame_tick_tocks: 0 < frame_tick_tocks.

Let cycle_tick_tocks := frame_tick_tocks * num_frames.

Definition timer_wf (timer: Z * bool) :=
  0 <= fst timer < cycle_tick_tocks.

Definition update_clear_index (i : Z) :=
  let i := i+1 in
  if (i =? num_slots) then 0 else i.

Lemma update_clear_index_wf: forall i, clear_index_wf i -> clear_index_wf (update_clear_index i).
Proof.
  intros. red in H |- *. unfold update_clear_index.
  clear -H.
  destruct (i + 1 =? num_slots) eqn: ?H; lia.
Qed.

Definition update_timer (t : Z * bool) (tick : bool) : Z * bool :=
  if tick then
    (fst t, true)
  else
    if snd t then
      if (fst t =? cycle_tick_tocks - 1) then
        (0, false)
      else
        (fst t + 1, false)
    else
      t.

Lemma update_timer_wf: forall t tick, timer_wf t -> timer_wf (update_timer t tick).
Proof.
  intros. red in H |- *. unfold update_timer. destruct t as [timer b]. simpl in *.
  destruct tick, b; simpl in *; try lia.
   destruct (timer =? cycle_tick_tocks - 1) eqn:?H;
    simpl; lia.
Qed.

Definition get_clear_frame (t : Z * bool) : Z :=
  fst t / frame_tick_tocks.

Lemma get_clear_frame_nonneg : forall timer, 0 <= fst timer -> 0 <= get_clear_frame timer.
Proof.
  intros. destruct timer. unfold get_clear_frame. simpl in *.
  destruct (z =? cycle_tick_tocks); apply Z.div_pos; lia.
Qed.

Lemma get_clear_frame_range : forall timer,
  timer_wf timer ->
  0 <= get_clear_frame timer < num_frames.
Proof.
  intros. red in H. unfold get_clear_frame. destruct timer as [t b].
    subst cycle_tick_tocks; split.
  - apply Z.div_pos; lia.
  - apply Z.div_lt_upper_bound; lia.
Qed.

Lemma get_clear_frame_update_neq : forall timer b,
    timer_wf timer -> 1 < num_frames ->
    (b = false /\ snd timer = true /\ (frame_tick_tocks | fst timer + 1)) <->
      (get_clear_frame timer + 1 = num_frames /\ get_clear_frame (update_timer timer b) = 0 \/
         get_clear_frame timer + 1 < num_frames /\ get_clear_frame (update_timer timer b) = get_clear_frame timer + 1).
Proof.
  intros. unfold get_clear_frame, update_timer. destruct timer as [timer tb].
  red in H. simpl in *. split; intros.
  - destruct H1 as [? [? H1]].
    subst.
    destruct (timer =? cycle_tick_tocks - 1) eqn:?H; [left | right].
    + split.
      * rewrite Z.eqb_eq in H2.
        assert (timer = (num_frames - 1) * frame_tick_tocks + (frame_tick_tocks - 1)) by lia.
        rewrite H3. rewrite Z.div_add_l by lia. rewrite Zdiv.Zdiv_small; lia.
      * simpl. reflexivity.
    + destruct H1 as [frs ?H]. assert (frs < num_frames) by nia. rewrite H1.
      simpl. rewrite Z.div_mul by lia.
      assert (timer = (frs - 1) * frame_tick_tocks + (frame_tick_tocks - 1)) by lia.
      rewrite H4. rewrite Z.div_add_l by lia. rewrite Zdiv.Zdiv_small; lia.
  - destruct tb eqn:?B, b eqn:?B.
    + assert (timer =? cycle_tick_tocks = false) by lia. simpl in *.
      destruct H1; exfalso; lia.
    + do 2 (split; auto). assert (timer =? cycle_tick_tocks = false) by lia. simpl in *.
      destruct (timer =? cycle_tick_tocks - 1) eqn:?H; simpl in *.
      * rewrite Z.eqb_eq in H3. rewrite H3. subst cycle_tick_tocks. exists num_frames. lia.
      * destruct H1 as [[? ?] | [? ?]]; simpl in *.
        -- exfalso. rewrite Z.div_small_iff in H4 by lia. destruct H4; try lia.
           rewrite Z.div_small in H1; lia.
        -- pose proof (Z.div_mod (timer + 1) frame_tick_tocks ltac:(lia)).
           destruct (Znumtheory.Zdivide_dec frame_tick_tocks (timer + 1)); auto.
           exfalso. rewrite <- Z.mod_divide in n by lia.
           pose proof (Z.mod_pos_bound (timer + 1) frame_tick_tocks ltac:(lia)).
           assert (exists r, timer = ((timer + 1) / frame_tick_tocks) * frame_tick_tocks + r /\ 0 <= r < frame_tick_tocks). {
             exists ((timer + 1) mod frame_tick_tocks - 1). do 2 (split; try lia). }
           destruct H7 as [r [? ?]]. rewrite H7 in H4 at 2.
           rewrite Z.div_add_l in H4 by lia. rewrite (Z.div_small _ _ H8) in H4. lia.
    + exfalso.
      simpl fst in *. destruct H1; lia.
    + exfalso. simpl fst in *. destruct H1; lia.
Qed.

Lemma get_clear_frame_update_eq : forall timer b,
    timer_wf timer -> 1 < num_frames ->
    (b = true \/ snd timer = false \/ ~ (frame_tick_tocks | fst timer + 1)) <->
      get_clear_frame (update_timer timer b) = get_clear_frame timer.
Proof.
  intros. split; intros.
  - assert (b = true -> get_clear_frame (update_timer timer b) = get_clear_frame timer). {
      intros. unfold get_clear_frame, update_timer. destruct timer as [timer tb].
      red in H. simpl in *. subst. destruct (timer =? cycle_tick_tocks) eqn:?H; simpl fst;
        [destruct (0 =? cycle_tick_tocks) | ]; auto. }
    assert (snd timer = false -> get_clear_frame (update_timer timer b) = get_clear_frame timer). {
      intros. destruct b. 1 : auto. unfold get_clear_frame, update_timer.
      destruct timer as [timer tb]. red in H. simpl in *. subst. simpl; auto. }
    destruct H1; [apply H2; auto |]. destruct H1; [apply H3; auto |].
    destruct b; [apply H2; auto|]. destruct (snd timer) eqn:?H; [| apply H3; auto].
    unfold get_clear_frame, update_timer. destruct timer as [timer tb].
    red in H. simpl in *. subst. simpl.
    destruct (timer =? cycle_tick_tocks - 1) eqn:?H.
    + exfalso. apply H1. exists num_frames. lia.
    + pose proof (Z.div_mod timer frame_tick_tocks ltac:(lia)).
      assert (timer mod frame_tick_tocks <> frame_tick_tocks - 1). {
        intro. apply H1. rewrite H6 in H5. rewrite H5.
        exists (timer / frame_tick_tocks + 1). lia.
      }
      assert (exists r, timer = timer / frame_tick_tocks * frame_tick_tocks + r /\
                     0 <= r < frame_tick_tocks - 1). {
        exists (timer mod frame_tick_tocks). split. 1: lia.
        pose proof (Z.mod_pos_bound timer frame_tick_tocks ltac:(lia)). lia.
      }
      clear H6. destruct H7 as [r []]. rewrite H6. simpl.
      rewrite <- Z.add_assoc. rewrite !Z.div_add_l by lia. f_equal. rewrite !Z.div_small; lia.
  - cut (~ (b = false /\ snd timer = true /\ (frame_tick_tocks | fst timer + 1))).
    + intros. apply Decidable.not_and in H2; [| red; destruct b; intuition].
      destruct H2; [left; destruct b; auto | right].
      apply Decidable.not_and in H2; [| red; destruct (snd timer); intuition].
      destruct H2; [left; destruct (snd timer) | right]; intuition.
    + rewrite get_clear_frame_update_neq; auto. lia.
Qed.

Program Definition filter_empty : filter :=
  mk_filter (Zrepeat frame_empty num_frames) 0 (0, false).
Next Obligation.
  clear dependent frame_tick_tocks; list_solve.
Qed.

Definition get_insert_frame (cf : Z) : Z :=
  if (cf =? 0) then num_frames - 1 else cf - 1.

Lemma get_insert_frame_range: forall cf, 0 <= cf < num_frames -> 0 <= get_insert_frame cf < num_frames.
Proof. intros. unfold get_insert_frame. destruct (cf =? 0) eqn: ?H; lia. Qed.

Program Definition filter_insert (f : filter) (tick : bool) (is : listn Z num_rows) : filter :=
  let '(mk_filter (exist _ frames H) clear_index timer) := f in
  let new_clear_index := update_clear_index clear_index in
  let timer := update_timer timer tick in
  let cf := get_clear_frame timer in
  let if' := get_insert_frame cf in
  let frames := upd_Znth cf frames (frame_clear (Znth cf frames) (Zrepeat clear_index num_rows)) in
  let frames := upd_Znth if' frames (frame_insert (Znth if' frames) is) in
  mk_filter frames new_clear_index timer.
Next Obligation.
  list_solve.
Qed.
Next Obligation.
  list_solve.
Qed.

Program Definition filter_query (f : filter) (tick : bool) (is : listn Z num_rows) : filter * bool :=
  let '(mk_filter (exist _ frames H) clear_index timer) := f in
  let new_clear_index := update_clear_index clear_index in
  let timer := update_timer timer tick in
  let cf := get_clear_frame timer in
  let frames := upd_Znth cf frames (frame_clear (Znth cf frames) (Zrepeat clear_index num_rows)) in
  (mk_filter frames new_clear_index timer,
    fold_orb (upd_Znth cf (map (fun f => frame_query f is) frames) false)).
Next Obligation.
  list_solve.
Qed.
Next Obligation.
  list_solve.
Qed.

Program Definition filter_clear (f : filter) (tick : bool) : filter :=
  let '(mk_filter (exist _ frames H) clear_index timer) := f in
  let new_clear_index := update_clear_index clear_index in
  let timer := update_timer timer tick in
  let cf := get_clear_frame timer in
  let frames := upd_Znth cf frames (frame_clear (Znth cf frames) (Zrepeat clear_index num_rows)) in
  mk_filter frames new_clear_index timer.
Next Obligation.
  list_solve.
Qed.
Next Obligation.
  list_solve.
Qed.

End ConFilter.

Arguments row : clear implicits.
Arguments frame : clear implicits.
Arguments filter : clear implicits.
Arguments timer_wf : clear implicits.
Arguments clear_index_wf : clear implicits.
Arguments get_clear_frame : clear implicits.
Arguments get_insert_frame : clear implicits.


(* Time-stamp: "modifie le 28 Dec 2010 a 07:42 par Pierre Lescanne on boucherotte" *)
(* **************************************************************************** *)
(*                  escalation_dollar_auction.v                                 *)
(*                                                                          	*)
(*            copyright Pierre Lescanne  (February 2008)            	        *)
(*                                                                          	*)
(*		       LIP (ENS-Lyon, CNRS, INRIA) 				*)
(*                                                                          	*)
(*                                                                          	*)
(* Developed in V8.1                                        June-August  2009   *)
(* **************************************************************************** *)

        (*  ---------------  *)
        (** * Preliminaries  *)
        (*  ---------------  *)

Require Import Relations.
Require Import Arith.
Require Import Lia.
Require Import Even.
Require Import Div2.
Require Import Le.

Require Import infinite_extensive_games.
Require Import dollar_auction.

Set Implicit Arguments.

Section escalation_dollar_auction.

Arguments sLeaf [Agent Utility].
Arguments sNode [Agent Utility].
Arguments s2u [Agent Utility].
Arguments LeadsToLeaf [Agent Utility].
Arguments AlwLeadsToLeaf [Agent Utility].
Arguments SGPE [Agent Utility].
Arguments NashEq [Agent Utility].
Arguments gLeaf [Agent Utility].
Arguments gNode [Agent Utility].
Arguments s2g [Agent Utility].

        (*  -----------------  *)
        (** -  Data and tools  *)
        (*  -----------------  *)

(* Inductive Alice_Bob :Set :=  Alice :Alice_Bob | Bob: Alice_Bob.*)

Notation "s1 |-- a --| s2" := (IndAgentConv Alice_Bob nat a s1 s2) (at level 70).
Notation "<< a , c , sl , sr >>" := (sNode a c sl sr) (at level 80).
Notation "<< f >>" := (sLeaf f) (at level 80).
Notation "[ x , y ]" :=
  (sLeaf (fun a:Alice_Bob => match a with Alice => x | Bob => y end)) (at level 80).
Notation "[[ x , y ]]" :=
  (gLeaf (fun a:Alice_Bob => match a with Alice => x | Bob => y end))
      (at level 80).
Notation "g =gbis= g'" := (gBisimilar Alice_Bob nat g g') (at level 80).

(* ---------------------------------- *)
(** ** Escalation for dollar action   *)
(* ---------------------------------- *)

Variable v:nat.
Hypothesis v_pos: v > 0.

Definition add_Alice_Bob_dol_game (n:nat) (g:Game Alice_Bob nat) :=
gNode Alice (gNode Bob g ([[n+1, v+n]])) ([[v+n,n]]).

CoFixpoint dollar_game (n:nat): Game Alice_Bob nat:=
  add_Alice_Bob_dol_game n (dollar_game (n+1)).

Lemma dollar_game_decomposition: forall n,
    gNode Alice (gNode Bob (dollar_game (n+1)) ([[n+1, v+n]])) ([[v+n,n]]) =
        dollar_game n.
Proof.
intros.
replace (dollar_game n) with (Game_identity Alice_Bob nat (dollar_game n)).
simpl.
apply refl_equal.
apply Game_decomposition.
Qed.

Lemma s2g_dolAcBs: forall n, s2g (dolAcBs v n) =gbis= dollar_game n.
Proof.
cofix H.
intro.
replace (dolAcBs v n) with (<<Alice,l,<<Bob, r, (dolAcBs v (n+1)),[n+1, v+n]>>,[v+n,n]>>).
rewrite s2g_decomp.
rewrite s2g_decomp.
rewrite s2g_leaf.
rewrite s2g_leaf.
rewrite <- dollar_game_decomposition.
apply bisim_gNode.
apply bisim_gNode.
apply H.
apply bisim_gLeaf.
apply bisim_gLeaf.
rewrite <- dolAcBs_decomposition.
trivial.
Qed.

Lemma s2g_dolAsBc: forall n, s2g (dolAsBc v n) =gbis= dollar_game n.
Proof.
cofix H.
intro.
replace (dolAsBc v n) with (<<Alice,r,<<Bob, l, (dolAsBc v (n+1)),[n+1, v+n]>>,[v+n,n]>>).
rewrite s2g_decomp.
rewrite s2g_decomp.
rewrite s2g_leaf.
rewrite s2g_leaf.
rewrite <- dollar_game_decomposition.
apply bisim_gNode.
apply bisim_gNode.
apply H.
apply bisim_gLeaf.
apply bisim_gLeaf.
rewrite <- dolAsBc_decomposition.
trivial.
Qed.

Definition test_even (n:nat) : {even n} + {odd n}.
elim n.
left.
apply even_O.
intros  m H.
elim H.
right.
apply odd_S.
assumption.
left.
apply even_S.
assumption.
Defined.

Definition DG_seq (m:nat) : (Game Alice_Bob nat)  := match test_even m with
| left h => dollar_game (div2 m)
| right h => (gNode Bob (dollar_game ((div2 m)+1))
                        ([[((div2 m)+1), (v+(div2 m))]]))
end.

Lemma DG_even_dolAcBs: forall m, even m ->
s2g (dolAcBs v (div2 m)) =gbis= (DG_seq m).
Proof.
unfold DG_seq.
intros.
case (test_even m).
intros.
apply s2g_dolAcBs.
intro.
elim not_even_and_odd with (n:=m); trivial.
Qed.

Lemma DG_even_dolAsBc: forall m, even m ->
s2g (dolAsBc v (div2 m)) =gbis= (DG_seq m).
Proof.
unfold DG_seq.
intros.
case (test_even m).
intros.
apply s2g_dolAsBc.
intro.
elim not_even_and_odd with (n:=m); trivial.
Qed.

Lemma DG_odd_dolAcBs: forall m c, odd m ->
s2g (<<Bob,c,(dolAcBs v (div2 m + 1)), ([div2 m+1,v+(div2 m)])>>)=gbis=(DG_seq m).
Proof.
intros.
rewrite s2g_decomp.
rewrite s2g_leaf.
unfold DG_seq.
case (test_even m).
intros.
elim not_even_and_odd with (n:=m); trivial.
intros.
apply bisim_gNode.
apply s2g_dolAcBs.
apply gBis_refl.
Qed.

Lemma DG_odd_dolAsBc: forall m c, odd m ->
s2g (<<Bob,c,(dolAsBc v (div2 m + 1)), ([div2 m+1,v+(div2 m)])>>)=gbis=(DG_seq m).
Proof.
intros.
rewrite s2g_decomp.
rewrite s2g_leaf.
unfold DG_seq.
case (test_even m).
intros.
elim not_even_and_odd with (n:=m); trivial.
intros.
apply bisim_gNode.
apply s2g_dolAsBc.
apply gBis_refl.
Qed.

Theorem Dollar_game_has_an_escalation_sequence:
    has_an_escalation_sequence Alice_Bob nat ge DG_seq.
Proof.
unfold has_an_escalation.
intro m.
elim even_odd_dec with (n:=m).
(* case even m*)
intro.
exists (<<Bob, r, dolAcBs v ((div2 m)+1),
                        ([((div2 m)+1), (v+(div2 m))])>>).
exists ([(v+div2 m), (div2 m)]).
exists Alice.
split.
left.
split.
rewrite s2g_decomp.
rewrite s2g_decomp.
rewrite s2g_leaf.
rewrite s2g_leaf.
unfold DG_seq.
case (test_even m).
intros.
rewrite <- dollar_game_decomposition.
apply bisim_gNode.
apply bisim_gNode.
apply  s2g_dolAcBs.
apply gBis_refl.
apply gBis_refl.
intros.
elim not_even_and_odd with (n:=m); trivial.
rewrite <- dolAcBs_decomposition.
apply SGPE_dol_Ac_Bs; apply v_pos.
replace (div2 m) with (div2 (m + 1)).
apply DG_odd_dolAcBs.
replace (m+1) with (S m).
apply odd_S.
trivial.
lia.
apply sym_eq.
replace (m+1) with (S m).
apply even_div2.
trivial.
lia.
(* case odd m *)
intro.
exists (dolAsBc v ((div2 m)+1)).
exists ([div2 m + 1,v+(div2 m)]).
exists Bob.
split.
left.
split.
apply DG_odd_dolAsBc.
trivial.
apply SGPE_left with (u:=div2 m+1) (v:= v + div2 m).
apply ALtL.
apply LtLLeft.
apply ALtL_then_LtL.
apply AlwLeadsToLeaf_dolAsBc.
apply AlwLeadsToLeaf_dolAsBc.
apply ALtLeaf.
apply SGPE_dol_As_Bc; apply v_pos.
apply SGPE_leaf.
apply S2u_dolAsBc_Bob.
apply s2uLeaf with (a:= Bob) (f:= (
    fun a : Alice_Bob =>
    match a with
    | Alice => div2 m + 1
    | Bob => v + div2 m
    end )).
cut (v>0).
lia.
apply v_pos.

replace (div2 m +1) with (div2 (m+1)).
apply DG_even_dolAsBc.
replace (m+1) with (S m).
apply even_S.
trivial.
lia.
replace (div2 m +1) with (S (div2 m)).
apply sym_eq.
replace (m+1) with (S m).
apply odd_div2.
trivial.
lia.
lia.
Qed.

Theorem Dollar_game_has_an_escalation:
    has_an_escalation Alice_Bob nat ge (dollar_game 0).
Proof.
unfold has_an_escalation.
exists DG_seq.
split.
apply Dollar_game_has_an_escalation_sequence.
unfold DG_seq.
case (test_even 0).
trivial.
intros.
elim not_even_and_odd with (n:=0).
apply even_O.
assumption.
Qed.

End escalation_dollar_auction.


Require Import Basics List.

Class Functor (F : Type -> Type) : Type := {
  fmap : forall {A B}, (A -> B) -> (F A -> F B)
  ; law : forall (A B C:Type) (f:A->B) (g:B->C) x, fmap (compose g f) x = compose (fmap g) (fmap f) x
}.

Instance ListFunctor : Functor list := {
  fmap := map
}.
Proof.
 induction x.
  reflexivity.

  simpl. rewrite IHx. reflexivity.
Defined.


Require Import ssreflect.
Axiom daemon : False. Ltac myadmit := case: daemon.

Class foo (T : Type) := { n : nat }.
Instance five : foo nat := {| n := 5 |}.

Definition bar T {f : foo T} m : Prop :=
  @n _ f = m.

Eval compute in (bar nat 7).

Lemma a : True.
set toto := bar _ 8.
have titi : bar _ 5.
  reflexivity.
have titi2 : bar _ 5 := .
  Fail reflexivity.
  by myadmit.
have totoc (H : bar _ 5) : 3 = 3 := eq_refl.
move/totoc: nat => _.
exact I.
Qed.

Set SsrHave NoTCResolution.

Lemma a' : True.
set toto := bar _ 8.
have titi : bar _ 5.
  Fail reflexivity.
  by myadmit.
have titi2 : bar _ 5 := .
  Fail reflexivity.
  by myadmit.
have totoc (H : bar _ 5) : 3 = 3 := eq_refl.
move/totoc: nat => _.
exact I.
Qed.