Section square_colouring.
Definition square := 'I_4.
Canonical square_eqType := Eval hnf in [eqType of square].
Canonical square_choiceType := Eval hnf in [choiceType of square].
Canonical square_countType := Eval hnf in [countType of square].
Canonical square_finType := Eval hnf in [finType of square].
Canonical square_subType := Eval hnf in [subType of square].
Canonical square_subCountType :=
Eval hnf in [subCountType of square].
Canonical square_subFinType := Eval hnf in [subFinType of square].
Definition mksquare i : square := Sub (i %% _) (ltn_mod i 4).
Definition c0 := mksquare 0.
Definition c1 := mksquare 1.
Definition c2 := mksquare 2.
Definition c3 := mksquare 3.
(*rotations*)
Definition R1 (sc : square) : square := tnth [tuple c1; c2; c3; c0] sc.
Definition R2 (sc : square) : square := tnth [tuple c2; c3; c0; c1] sc.
Definition R3 (sc : square) : square := tnth [tuple c3; c0; c1; c2] sc.
Ltac get_inv elt l :=
match l with
| (_, (elt, ?x))  => x
| (elt, ?x)  => x
| (?x, _) => get_inv elt x
end.
Definition rot_inv := ((R1, R3), (R2, R2), (R3, R1)).
Ltac inj_tac :=
move: (erefl rot_inv); unfold rot_inv;
match goal with |- ?X = _ -> injective ?Y =>
move=> _; let x := get_inv Y X in
apply: (can_inj (g:=x)); move=> [val H1]
end.
Canonical rot_group := Group group_set_rot.
Definition rotations := [set id1; r1; r2; r3].
(*symmetries*)
Definition Sh (sc : square) : square := tnth [tuple c1; c0; c3; c2] sc.
Definition sh := (perm Sh_inj).
Definition Sv (sc : square) : square := tnth [tuple c3; c2; c1; c0] sc.
Definition sv := (perm Sv_inj).
Definition Sd1 (sc : square) : square := tnth [tuple c0; c3; c2; c1] sc.
Definition sd1 := (perm Sd1_inj).
Definition Sd2 (sc : square) : square := tnth [tuple c2; c1; c0; c3] sc.
Definition sd2 := (perm Sd2_inj).
Definition isometries2 := [set 1; sh].
Canonical iso2_group := Group group_set_iso2.
Definition isometries :=
[set p | [|| p == 1, p == r1, p == r2, p == r3,
p == sh, p == sv, p == sd1 | p == sd2 ]].
Definition opp (sc : square) := tnth [tuple c2; c3; c0; c1] sc.
Definition is_iso (p : {perm square}) := forall ci, p (opp ci) = opp (p ci).
Ltac non_inj p a1 a2 heq1 heq2 :=
let h1:= fresh "h1" in
(absurd (p a1 = p a2); first (by red => - h1; move: (perm_inj h1));
by rewrite heq1 heq2; apply/eqP).
Ltac is_isoPtac p f e0 e1 e2 e3 :=
suff ->: p = f by [rewrite inE eqxx ?orbT];
let e := fresh "e" in apply/permP;
do 5?[case] => // ?; [move: e0 | move: e1 | move: e2 | move: e3] => e;
apply: etrans (congr1 p _) (etrans e _); apply/eqP; rewrite // permE.
Canonical iso_group := Group group_set_iso.
Definition coin0 (sc : col_squares) : colors := sc c0.
Definition coin1 (sc : col_squares) : colors := sc c1.
Definition coin2 (sc : col_squares) : colors := sc c2.
Definition coin3 (sc : col_squares) : colors := sc c3.
Ltac inv_tac :=
apply: esym (etrans _ (mul1g _)); apply: canRL (mulgK _) _;
let a := fresh "a" in apply/permP => a;
apply/eqP; rewrite permM !permE; case: a; do 4?case.

Lemma F_Sd1 : 'Fix_to[sd1] = [set x | coin1 x == coin3 x].