Require Import eqtype seq path ssrfun.
Require Import Basics Commons Tree OtDef ListTools Comp.
Import Bool.

Definition asymmetric {T} (R : rel T) := (forall x y : T, R x y = ~~(R y x)).

Definition order {T} (R : rel T) := total R /\ irreflexive R /\ asymmetric R /\ transitive R.

Ltac expand_order X := move: X; repeat (let HN := fresh in move => [] HN); let HN := fresh in move => HN.
Ltac mf := (let f := fresh in move => f).

Lemma order_irr {T : eqType} {R} {x y : T} (Rord : order R): R x y -> (x == y) = false.
expand_order Rord. by move: (H0 x); case: eqP => // -> ->. Qed.

Section InsertRaw.

Context {X : eqType} {R : rel X} (Rord : order R).

Fixpoint g_insert x xs : seq X :=
 match xs with
 | xh :: xt => if x == xh then xs else if R x xh then x :: xs else xh :: g_insert x xt
 | _ => [:: x] end.

Lemma g_insert_ind1 x x0 xs: g_insert x (x0 :: xs) =
      match x0 == x, R x0 x with
       | true, _ => x0 :: xs
       | _, true => x0 :: (g_insert x xs)
       | _, _    => x :: x0 :: xs end.
expand_order Rord => /=. rewrite H1 eq_sym.
case A0: (x0 == x). move: A0 => /eqP -> //. by case: (R x0 x) => /=. Qed.

Lemma g_insert_insert {x y xs} :
  g_insert x (g_insert y xs) = g_insert y (g_insert x xs).

expand_order Rord. elim: xs x y => [| x0 xs IH] x y.
 + by rewrite /= eq_sym H1; case A0: eq_op; case: (R _ _) A0 => // /eqP ->.
 + rewrite ?g_insert_ind1; case A0: (x0 == x); case A1: (x0 == y) => //=; rewrite ?g_insert_ind1.
  * by move: A0 A1 => /eqP -> /eqP ->.
  * move: A0 => /eqP <-. rewrite eq_sym A1 H1. by case A2: (R y x0); rewrite /= eq_refl ?A1 // H1 A2.
  * move: A1 => /eqP <-. rewrite eq_sym A0 H1. by case A2: (R x0 x); rewrite /= eq_refl ?A0 // A2.
  * by case A2: (R x0 y); case A3: (R x0 x); rewrite ?g_insert_ind1 A0 A1 A2 A3;
    [rewrite IH // |
     have: (R x y) by apply (H2 x0 x y) => //; rewrite H1 A3 |
     have: (R y x) by apply (H2 x0 y x) => //; rewrite H1 A2 |
     rewrite eq_sym H1; (case: eqP => [->| _]); case: (R x y) => //];
     move => A4; rewrite A4 (order_irr Rord). Qed.

Lemma path_g_insert x c cs: path R x (g_insert c cs) = path R x cs && R x c.
expand_order Rord. elim: cs c x => [|c' cs IH] c x//=. by rewrite andb_true_r. case A0: (eq_op).
 + move: A0 => /eqP -> /=. by rewrite andb_comm -andb_assoc andb_diag.
 + case A1: (R c c') => /=;
     [rewrite A1 andb_true_l; case A2: (R x c) => //|
      rewrite IH; rewrite H1 in A1; apply negb_false_iff in A1; rewrite A1; case A2: (R x c')];
   try (by rewrite (H2 _ _ _ A2 A1) ?andb_true_l andb_true_r);
        by rewrite andb_false_l ?andb_false_r. Qed.

Lemma g_insert_path {x xs} : path R x xs -> g_insert x xs = x :: xs.
expand_order Rord. case: xs => // xh xt /=. case E: (x == xh).
 + by move /eqP in E; rewrite -E (H0 x).
 + by move /andP => [-> _]. Qed.

Local Notation "x <<: y" := (path R x y) (at level 70).

Lemma path_trans {x y xt} : R x y -> y <<: xt -> x <<: xt.
expand_order Rord. by case: xt => //= xth [|xtth xttt] H3 /andP [] G; rewrite /= (H2 _ _ _ H3 G). Qed.

Lemma g_filter_insert {p x xs} (P : p x = true) : sorted R xs
  -> g_insert x (filter p xs) = filter p (g_insert x xs).
elim: xs => [|xh xt IHxs].
+ by rewrite /= P.
+ move => /=; case E: (x == xh).
  * by move /eqP in E; rewrite -E P /= eq_refl P.
  * by move => S; move: (S) => H; apply path_sorted, IHxs in H;
    case G: (p xh) => /=; case J: (R x xh);
    rewrite /= ?E ?P G // H // (g_insert_path (path_trans J S)) /= P. Qed.

End InsertRaw.

Section SortedTree.

Context {T : eqType} (R : rel T) (Rord : order R).

Fixpoint is_tree_sorted t := match t with Node _ cs => sorted R (map value cs) && all is_tree_sorted  cs end.

Structure sorted_tree : Type := STree {
  treeOf :> tree T;
  stp    : is_tree_sorted treeOf}.

Definition SNode (t : T) : sorted_tree. by apply (@STree (Node t [::])). Defined.

Canonical  sorted_tree_subType := Eval hnf in [subType for treeOf].
Definition sorted_tree_eqMixin := Eval hnf in [eqMixin of sorted_tree by <:].
Canonical  sorted_tree_eqType  := Eval hnf in  EqType (sorted_tree) sorted_tree_eqMixin.

Require Import ProofIrrelevance.

Lemma st_eq (t1 t2 : sorted_tree): t1 = t2 <-> treeOf t1 = treeOf t2.
 split.
 + by move: t1 t2 => [t1 ?] [t2 ?] [].
 + case: t1 t2 => [t1 S1] [t2 S2] /= A0. subst.
   by move: (proof_irrelevance _ S1 S2) => ->. Qed.

Corollary opt_eq (t1 t2 : option sorted_tree): t1 = t2 <-> (fmap treeOf) t1 = (fmap treeOf) t2.
case: t1 t2 => [t1|] [t2|] //=. by split; case => /st_eq ->. Qed.

Definition treeR (x y : tree T) := R (value x) (value y).

Lemma treeR_order: order treeR.
 expand_order Rord. rewrite /order /total /transitive /irreflexive /asymmetric.
 by repeat (split; repeat (case; mf; mf)); rewrite /treeR /=;
  [apply H | apply H0 | apply H1|move: H9 H10; rewrite /treeR /=; apply H2]. Qed.

Corollary sorted_tree_uniq v ls: is_tree_sorted (Node v ls) -> uniq (map value ls).
expand_order Rord. rewrite /= andb_comm => /andP [] _. by apply sorted_uniq. Qed.

Lemma path_compatibility xs x: path R (value x) (map value xs) = path treeR x xs.
elim: xs x => [|x' xs IH] //= x. by rewrite IH /treeR. Qed.

Corollary sorted_compatibility xs: sorted R (map value xs) = sorted treeR xs.
case: xs => [|x xs] //=. apply path_compatibility. Qed.

Definition by_value v : tree T -> bool := eq_op v \o value.

Lemma by_diff_values  {vx vy} : (vx == vy) = false -> negb \o (by_value vx) --- by_value vy.
 move => Eq [v cs]; rewrite /by_value /comp /negb /=.
 case H: (vx == v) => //.
 by move /eqP in H; rewrite H eq_sym in Eq. Qed.

(* Insert operation *)

Definition insert := @g_insert _ treeR.

Corollary insert_insert xt yt xs : insert xt (insert yt xs) = insert yt (insert xt xs).
rewrite /insert. rewrite g_insert_insert //. apply treeR_order. Qed.

Corollary filter_insert {p x xs} : p x = true -> sorted treeR xs ->
   insert x (filter p xs) = filter p (insert x xs).
rewrite /insert. by apply (@g_filter_insert _ _ treeR_order). Qed.

Lemma find_insert_t {xs p x}: p x = true -> has p xs = false -> find p (insert x xs) = Some x.
by elim: xs x => [|x0 xs IH] x /= A0;
 [intros; rewrite A0| move => A1; case A2: eq_op; [move: A2 A0 A1 => /eqP -> -> |
   case A3: (treeR _ _) => /=; [rewrite A0 | move: A1 => /orb_false_iff [] -> ?; apply IH]]]. Qed.

Corollary find_insert_f {xs p x}: p x = false -> find p (insert x xs) = find p xs.
 elim: xs => [/= -> |xh xt IHxs] //= H; case A0: (x == xh) => /=.
   + by rewrite -(eqP A0) H.
   + by case A1: (treeR x xh) => /=; rewrite ?H ?(IHxs H). Qed.

Lemma has_insert f s cs: has f (insert s cs) = has f cs || (f s).
rewrite /insert; elim: cs => /= [| a cs IHa].
 + by rewrite orb_false_r.
 + case A0: eq_op => /=. move: A0 => /eqP ->.
   by rewrite orb_comm -orb_assoc orb_diag.
   case: (treeR s a) => /=.
     by rewrite orb_comm.
     by rewrite IHa orb_assoc. Qed.

Corollary insert_has_f {p} x {xs} : p x = false -> has p (insert x xs) = has p xs.
 by rewrite has_insert => ->; rewrite orb_false_r. Qed.

Corollary insert_has_t {p} x {xs} : p x = true -> has p (insert x xs) = true.
 by rewrite has_insert => ->; rewrite orb_true_r. Qed.

Corollary insert_has_absent {p x xs} : has p (insert x xs) = false -> has p xs = false.
 by rewrite has_insert; move: p (has p) => [] []. Qed.

Lemma insert_sorted c cs: sorted treeR cs -> sorted treeR (insert c cs).
case: cs => [|c' cs] //= A0.
case A1: (eq_op) => //. expand_order treeR_order.
case A2: (treeR c' c); move: A2; rewrite H1.
 + move => /negb_true_iff A2. rewrite A2 /= /insert path_g_insert.
   by rewrite (H1 c' c) A2 A0. apply treeR_order.
 + move => /negb_false_iff A2. by rewrite A2 /= A0 A2. Qed.

Lemma find_by_value {v v' xs ys} : find (by_value v) xs = Some (Node v' ys) -> v = v'.
by elim: xs v => [|[xv xl] xs IHx] v //=;  rewrite /by_value /=; case: eqP => [-> [] //| _ /IHx]. Qed.

Lemma insert_all c cs p: all p (insert c cs) = all p cs && (p c).
elim: cs c => [|c' cs IH] c /=. by rewrite andb_true_r.
case A0: eq_op => [].
 + by move: A0 => /eqP -> /=; rewrite andb_comm -andb_assoc andb_diag.
 + case: (treeR _ _) => [] /=.
  * by rewrite andb_comm.
  * by rewrite IH andb_assoc. Qed.

(* Without operation *)

Definition without v := filter (negb \o (by_value v)).
Definition without' := locked without.

Lemma without_has v xs: has (by_value v) (without v xs) = false.
by elim: xs => [|[v1 xs'] xs IH]; rewrite /without -?lock //=; rewrite /by_value /=;
 case A0: eq_op => /=; rewrite ?A0 ?orb_false_l ?IH. Qed.

Lemma without_has' v v' xs: (v' == v) = false -> has (by_value v) (without v' xs) = has (by_value v) xs.
move => A0. by apply has_filter, by_diff_values. Qed.

Lemma without_find' v v' xs: (v' == v) = false -> find (by_value v) (without v' xs) = find (by_value v) xs.
move => A0. by apply find_filter, by_diff_values. Qed.

Corollary without_has_false v v' xs: has (by_value v) xs = false -> has (by_value v) (without v' xs) = false.
case A0: (v' == v).
 + move: A0 => /eqP ->. by rewrite without_has.
 + by rewrite without_has'. Qed.

Lemma without_inv v xs: without v (without v xs) = without v xs.
by elim: xs => [|x xs IH] //=; case A0: (by_value _ _); rewrite /= ?A0 /= IH. Qed.

Lemma without_without v v' xs: without v (without v' xs) = without v' (without v xs).
elim: xs => [|x xs IH] //=; case A0: by_value => //=; case A1: by_value => //=.
 + by rewrite A0. + by rewrite A0 /= IH. Qed.

Lemma without_path v c cs: path treeR c cs -> path treeR c (without v cs).
elim: cs v c => [|x cs IH] v c //= /andP [] A0 A1. rewrite /by_value /=. case A2: eq_op => /=.
 + apply IH. apply path_trans with (y := x) => //. apply treeR_order.
 + rewrite A0 /=. by apply IH. Qed.

Lemma without_insert_i t1 cs vt: value t1 = vt ->
   without vt (insert t1 cs) = without vt cs.
elim: cs t1 vt => [|c cs IH] t1 vt //=; rewrite /by_value /=.
 + by move => ->; rewrite eq_refl /=.
 + move => <-.
   by case A0: eq_op; [move: A0 => /eqP -> /= |
   case A1: eq_op; case: (treeR _ _) => /=; rewrite /by_value /= A1 ?eq_refl //= ?IH]. Qed.

Lemma without_insert t1 v2 cs: sorted treeR cs -> (value t1 != v2) ->
 insert t1 (without (v2) cs) = without (v2) (insert t1 cs).
elim: cs => [|c cs IH] /=.
 + intros ?. by rewrite /by_value /= eq_sym => ->.
 + move => H0 A0. rewrite /by_value /=.
   case A1: eq_op => /=; case A2: eq_op => /=; rewrite /by_value /=.
  * move: A2 A1 A0 => /eqP <-. by rewrite eq_sym => ->.
  * case A3: treeR => /=; rewrite /by_value /= ?A1 /=.
   + rewrite eq_sym A0. apply path_trans with (x:= t1), (without_path (v2)), g_insert_path in H0;
      (try by apply treeR_order). rewrite /insert H0 //. apply A3.
   + rewrite IH => //. by move: H0 => /path_sorted.
  * by rewrite A1 /=.
  * case: (treeR t1 c) => /=; rewrite /by_value /= ?A1 /=.
   + by rewrite eq_sym A0.
   + rewrite IH => //. by move: H0 => /path_sorted. Qed.

Lemma without_first: forall cs c v w cw, path treeR c cs -> without v cs = w :: cw -> treeR c w.
elim => [|c' cs' IH] c v w cw //= /andP [] A0 A1; case (by_value _) => /=.
 + move => A2. apply (IH c') in A2; [|done]. expand_order treeR_order. by apply (H2 c' c w).
 + by case => [] <-. Qed.

Lemma without_sorted cs v: sorted treeR cs -> sorted treeR (without v cs).
elim: cs => [|c cs IH] //= A0.
 case A1: (by_value v c) => /=.
 + by move: A0 => /path_sorted /IH.
 + assert (A0' := A0). move: A0 => /path_sorted /IH.
   case A2: (without _ _) => [| w cw] //= ->. rewrite andb_true_r.
   move: A0' A2. apply /without_first. Qed.

Lemma has_without v cs: has (by_value v) cs = false -> without v cs = cs.
elim: cs v => [|c cs IH] v //=. by case A0: (by_value v c) => //= /IH ->. Qed.

Lemma has_path c cs: path treeR c cs -> has (by_value (value c)) cs = false.
elim: cs c => [|c' cs IH] c //= /andP [] A0 A1. have: (path treeR c cs) by move: A0 A1; apply path_trans, treeR_order.
move => /IH => ->. move: A0. by rewrite orb_false_r /by_value /treeR /= => /(order_irr Rord). Qed.

Corollary path_without vc vcs cs: path treeR (Node vc vcs) cs -> without vc cs = cs.
move => /has_path. apply has_without. Qed.

Lemma path_find t t' cs v: path treeR t cs -> find (by_value v) cs = Some t' -> R (value t) (value t').
elim: cs t t' v => [|[vc vcs] cs IH] t t' v //= /andP [] A0 A1. rewrite /by_value /=. case A2: (v == vc).
 + case => <- /=. by move: A0; rewrite /treeR.
 + apply IH. clear IH. case: cs A1 => [|[vc0 vcs0] cs] //= /andP [] A1 ->. rewrite andb_true_r.
   case: t A0 A1 => [vt vts]; rewrite /treeR /=. expand_order Rord. apply H2. Qed.

Lemma path_has x xs: path treeR x xs -> has (by_value (value x)) xs = false.
expand_order Rord. elim: xs x => [|x' xs IH] //= x /andP []; rewrite /by_value /=. case A0: (eq_op).
 + by move: A0 => /eqP /=; rewrite /treeR => ->; rewrite H0.
 + move => A1 A2; rewrite IH //. move: A1 A2. apply path_trans, treeR_order. Qed.

Lemma insert_same v a cs: sorted treeR cs -> find (by_value v) cs = Some a -> insert a (without v cs) = cs.
elim: cs a v => [|[vc vcs] cs IH] a v //=; rewrite /by_value /=. case A0: (v == vc) => /= A1 [].
 + rewrite /insert => <-. move: A0 => /eqP ->. assert (A1':=A1). move: A1' => /path_without ->.
   by rewrite g_insert_path; try apply treeR_order.
 + move => A2. case A3: (eq_op _ _) => /=. move: A3 A2 => /eqP -> /find_pred /=. by rewrite A0.
   case A4: (treeR a _). have: (treeR (Node vc vcs) a) by move: A1 A2; apply /path_find.
   expand_order treeR_order. by rewrite H1 A4.
 + rewrite IH => //. by apply path_sorted in A1. Qed.

(* Open operation *)

Definition label_preserving (f : tree T -> option (tree T)) :=
 forall t', match f t' with Some t => value t = value t' | _ => True end.

Definition open (f : tree T -> option (tree T)) (vo : T) (t : tree T) :=
 match t with Node v cs =>
   match (bind f) (find (by_value vo) cs) with
     Some fch => Some (Node v (insert fch (without vo cs)))
     | _ => None end end.

Lemma find_sorted v p cs t: is_tree_sorted (Node v cs) -> find p cs = Some t -> is_tree_sorted t.
elim: cs v => [|c' cs IH] v //= /andP [] A0 /andP [] A1 A2; case: (p c').
 + by case => <-.
 + apply (IH v). by move: A0 => /path_sorted /= -> /=. Qed.

Lemma all_without p v cs: all p cs -> all p (without v cs).
elim: cs => [|c cs IH] //= /andP []; case A0: by_value => /=; [intros ?|move => -> /=]; apply IH. Qed.

End SortedTree.

Implicit Arguments treeOf [[T] [R]].
Implicit Arguments without_insert [[T] [R]].

(* find/has simplification tactics *)

Ltac use_sortedness S := repeat first [apply without_sorted | apply insert_sorted | by (move: S; rewrite /is_tree_sorted => /andP []; rewrite sorted_compatibility)].

Ltac sop_simpl :=
let fi_t := rewrite find_insert_t //=; (try subst);
            try (by rewrite ?/by_value /= eq_refl); try (by apply without_has) in
let fi_f := rewrite find_insert_f; [| by rewrite /by_value /= // eq_sym //] in
let wf' := rewrite without_find'; [| by rewrite // eq_sym] in
let wh' := rewrite without_has'; [| by rewrite // eq_sym] in
(subst; repeat first [rewrite eq_refl /= | rewrite /without' -lock |
rewrite without_has | rewrite without_inv | match goal with
 | [ H : has (by_value ?v) ?cs = false |- context [without ?v ?cs] ] => rewrite (has_without _ _ H)
 | [ |- context [find (by_value (value ?v1)) (insert _ ?v1 _)] ]   => fi_t
 | [ |- context [find (by_value ?v1) (insert _ (Node ?v1 _) _) ] ] => fi_t
 | [ |- context [find (by_value ?v1) (insert _ ?v2 _)] ] => fi_f
 | [ |- context [without _ (insert _ _ _)]] => rewrite without_insert_i; [| by done]
 | [ H : (?v1 == ?v2) = false |- context [find (by_value ?v1) (without ?v2 _)]] => wf'
 | [ H : (?v2 == ?v1) = false |- context [find (by_value ?v1) (without ?v2 _)]] => wf'
 | [ H : (?v1 == ?v2) = false |- context [has (by_value ?v1) (without ?v2 _)]] => wh'
 | [ H : (?v2 == ?v1) = false |- context [has (by_value ?v1) (without ?v2 _)]] => wh'
end]).


Require Import Monads.OuputMonad.
Require Import Monads.FunctorApplicativeMonad.
Require Import NPeano Arith Bool String List.

Notation "x <- c1 ;; c2" := (bind c1 (fun x => c2))
                             (right associativity, at level 84, c1 at next level).

Notation "c1 ;; c2" := (bind c1 (fun _ => c2)) (at level 100, right associativity).

Class Show(A:Type) := {
  show : A -> string
}.

Definition digit2string(d:nat) : string :=
  match d with
    | 0 => "0" | 1 => "1" | 2 => "2" | 3 => "3"
    | 4 => "4" | 5 => "5" | 6 => "6" | 7 => "7"
    | 8 => "8" | _ => "9"
  end %string.

Fixpoint digits'(fuel n:nat) (accum : string) : string :=
  match fuel with
    | 0 => accum
    | S fuel' =>
      match n with
        | 0 => accum
        | _ => let d := digit2string(n mod 10) in
               digits' fuel' (n / 10) (d ++ accum)
      end
  end.

Definition digits (n:nat) : string :=
  match digits' n n "" with
    | "" => "0"
    | ds => ds
  end %string.

Instance natShow : Show nat := {
  show := digits
}.

Inductive tm :=
| Con : nat -> tm
| Div : tm -> tm -> tm.

Example answer: tm := (Div (Div (Con 1972 ) (Con 2 )) (Con 23 )).
Example error: tm := (Div (Con 1)(Con 0)).

Instance expShow : Show tm := {
  show := fix show_exp (t:tm) : string :=
              match t with
                | Con n => "(Con "++ show n ++")"
                | Div t1 t2 => "(Div " ++ (show_exp t1) ++ (show_exp t2) ++ ")"
              end %string
}.

Definition line(t:tm) (n:nat):string:=
(append (append "eval"%string (show (t))) (append "<="%string (append (show n ) "
      "%string))).

Fixpoint eval_output (t:tm) : output nat  :=
  match t with
  | Con n =>   (line (Con n) n, n)
  | Div t1 t2  =>
      n1 <- eval_output t1 ;;
      n2 <- eval_output t2 ;;
      (line (Div t1 t2) (n1/n2), n1/n2 ) end.

Compute eval_output answer .

(* = = ("eval(Con 1972)<=1972
      eval(Con 2)<=2
      eval(Div (Con 1972)(Con 2))<=986
      eval(Con 23)<=23
      eval(Div (Div (Con 1972)(Con 2))(Con 23))<=42
      "%string,
       42)
     : output_comp nat *)


Add LoadPath "..".
Require Export Shared.

Inductive vctx_LF :=
| bctx: nat -> vctx_LF
| cctx: ctx_LF -> vctx_LF
.

Inductive te_LF :=
| hyp_LF: vte -> te_LF
| lam_LF: ty -> te_LF -> te_LF
| appl_LF: te_LF -> te_LF -> te_LF
| box_LF: te_LF -> te_LF
| unbox_LF: te_LF -> te_LF
| here_LF: te_LF -> te_LF
| letdia_LF: ty -> te_LF -> te_LF -> te_LF
.

Inductive lc_t_n_LF : nat -> te_LF -> Prop :=
 | lc_t_hyp_bte_LF: forall v n, n > v -> lc_t_n_LF n (hyp_LF (bte v))
 | lc_t_hyp_fte_LF: forall v n, lc_t_n_LF n (hyp_LF (fte v))
 | lc_t_lam_LF: forall M t n,
     lc_t_n_LF (S n) M ->
     lc_t_n_LF n (lam_LF t M)
 | lc_t_appl_LF: forall M N n,
     lc_t_n_LF n M -> lc_t_n_LF n N ->
     lc_t_n_LF n (appl_LF M N)
 | lc_t_box_LF: forall M n,
     lc_t_n_LF n M ->
     lc_t_n_LF n (box_LF M)
 | lc_t_unbox_LF: forall M n,
     lc_t_n_LF n M ->
     lc_t_n_LF n (unbox_LF M)
 | lc_t_here_LF: forall M n,
     lc_t_n_LF n M ->
     lc_t_n_LF n (here_LF M)
 | lc_t_letdia_LF: forall M N t n,
     lc_t_n_LF (S n) N -> lc_t_n_LF n M ->
     lc_t_n_LF n (letdia_LF t M N)
.

Definition lc_t_LF := lc_t_n_LF 0.

Fixpoint used_vars_te_LF (M: te_LF) : fset var :=
match M with
| hyp_LF (fte v) => \{v}
| hyp_LF (bte _) => \{}
| lam_LF _ M => used_vars_te_LF M
| appl_LF M N => used_vars_te_LF M \u used_vars_te_LF N
| box_LF M => used_vars_te_LF M
| unbox_LF M => used_vars_te_LF M
| here_LF M => used_vars_te_LF M
| letdia_LF _ M N => used_vars_te_LF M \u used_vars_te_LF N
end.

Lemma closed_t_succ_LF:
forall M n,
  lc_t_n_LF n M -> lc_t_n_LF (S n) M.
intros; generalize dependent n;
induction M; intros; inversion H; subst;
eauto using lc_t_n_LF.
Qed.

Lemma closed_t_addition_LF:
forall M n m,
  lc_t_n_LF n M -> lc_t_n_LF (n + m) M.
intros; induction m;
[ replace (n+0) with n by auto |
  replace (n + S m) with (S (n+m)) by auto] ;
try apply closed_t_succ_LF;
assumption.
Qed.


Theorem Ex014 (A B : Prop) : A /\ B -> B /\ A.
Proof.
  intro.
  destruct H.
  split.
  + exact H0.
  + exact H.
Qed.


Require Import Iron.Language.Simple.Step.
Require Import Iron.Language.Simple.SubstExpExp.
Require Import Iron.Language.Simple.Ty.

(* If a closed, well typed expression takes an evaluation step
   then the result has the same type as before. *)
Theorem preservation
 :  forall x x' t
 ,  TYPE nil x  t
 -> STEP x x'
 -> TYPE nil x' t.
Proof.
 intros x x' t HT HS. gen t.
 induction HS; rip.

  destruct H; inverts_type; burn.

  inverts_type.
  burn using subst_exp_exp.
Qed.

(* If a closed, well typed expression takes several evaluation steps
   then the result has the same type as before. *)
Lemma preservation_steps
 :  forall x1 t1 x2
 ,  TYPE nil x1 t1
 -> STEPS    x1 x2
 -> TYPE nil x2 t1.
Proof.
 intros x1 t1 x2 HT HS.
 induction HS; burn using preservation.
Qed.

(* If a closed, well typed expression takes several evaluation steps
   then the result has the same type as before.
   Usses the left linearised version of steps judement. *)
Lemma preservation_stepsl
 :  forall x1 t1 x2
 ,  TYPE nil x1 t1
 -> STEPSL   x1 x2
 -> TYPE nil x2 t1.
Proof.
 intros x1 t1 x2 HT HS.
 induction HS; burn using preservation.
Qed.


Require Import Coq.Unicode.Utf8_core.
Require Import Coq.Bool.Bool.
Require Import Coq.Arith.Arith.

Inductive varAssign : Type :=
| VA_Empty : varAssign
| VA_Var   : nat -> bool -> varAssign -> varAssign.

Fixpoint lookup (va:varAssign) (n:nat) : option bool :=
match va with
| VA_Empty        => None
| VA_Var m b rest => if (beq_nat n m) then Some b else lookup rest n
end.

Inductive assigns : varAssign -> nat -> bool -> Prop :=
| assigns_var  : forall n b rest, assigns (VA_Var n b rest) n b
| assigns_rest : forall n1 n2 b1 b2 rest, not (n1 = n2) ->
                                          assigns rest n1 b1 ->
                                          assigns (VA_Var n2 b2 rest) n1 b1.


(************************************************************************)
(* Copyright 2006 Milad Niqui                                           *)
(* This file is distributed under the terms of the                      *)
(* GNU Lesser General Public License Version 2.1                        *)
(* A copy of the license can be found at                                *)
(*                  <http://www.gnu.org/licenses/lgpl-2.1.html>         *)
(************************************************************************)

From QArithSternBrocot Require Export Qsyntax.
From QArithSternBrocot Require Export Field_Theory_Q.
From QArithSternBrocot Require Export Q_ordered_field_properties.

Lemma Qpositive_in_Q_Archimedean_inf:forall qp:Qpositive, {z:Z | (Qpos qp)<=z /\ (z-(Qpos qp))<= Qone}.
Proof.
 induction qp as [qp [z [Hz1 Hz2]]|qp [z [Hz1 Hz2]]|]; simpl.
  exists (z+1)%Z; split;rewrite Qpos_nR; rewrite Z_to_Qplus; qZ_numerals.
   apply Qle_plus_plus; trivial.
   stepl (z-Qpos qp); [assumption|ring].

  exists (1)%Z; split; rewrite Qpos_dL; fold (Qdiv (Qpos qp) (Qpos qp + Qone)); qZ_numerals.
   apply Qmult_pos_Qdiv_Qle; auto; stepr (Qpos qp+Qone); [|ring]; apply Qle_Zero_Qminus; stepr Qone; [auto|ring].
   stepl (Qone/(Qpos qp + Qone)); [|field; auto];
    apply Qmult_pos_Qdiv_Qle; auto;  stepr (Qpos qp+Qone); [|ring]; apply Qle_Zero_Qminus;  stepr (Qpos qp); [auto|ring].

 exists (1)%Z; split; auto.
Qed.

Theorem Q_Archimedean_inf:forall q:Q, {z:Z | q<=z /\ (z-q)<= Qone}.
Proof.
 intros [|qp|qp].
 (* 0 *)
 exists (0)%Z; split; auto.
 (* Qpos *)
 destruct (Qpositive_in_Q_Archimedean_inf qp) as [z Hz]; exists z; assumption.
 (* Qneg *)
 destruct (Qpositive_in_Q_Archimedean_inf qp) as [z [Hz1 Hz2]]; exists (-(z-1))%Z; rewrite Z_to_Qopp;
           rewrite (Z_to_Qminus); qZ_numerals; split; apply Qle_opp; apply Qle_Zero_Qminus; rewrite Qopp_Qpos.
  stepr (Qone-(z - Qpos qp)); [|ring]; apply Qle_Qminus_Zero; assumption.
  stepr (z-(Qpos qp));[|ring]; apply Qle_Qminus_Zero; assumption.
Qed.

Definition up_Q q:= proj1_sig (Q_Archimedean_inf q).

Definition up_Q_property q := proj2_sig (Q_Archimedean_inf q):  q <= (up_Q q) /\ (up_Q q) - q <= Qone.

Lemma Q_Archimedean_nat_inf:forall q:Q, {n:nat | q<=n }.
Proof.
 intro q.
 destruct (Q_le_lt_dec q Zero).
  exists O; qnat_zero.
  exists (Z.abs_nat (up_Q q)).
  destruct (up_Q_property q) as [H1 H2].
  stepr (up_Q q); trivial.
   assert (H3:(0<=(up_Q q))%Z).
    assert (H4:Zero<Z_to_Q (up_Q q));[apply Qlt_le_trans with q; auto|];
    generalize (Q_to_Z_monotone _ _ H4); simpl; rewrite Q_to_Z_to_Q; trivial.
   rewrite (Z_of_nat_Zabs_nat_pos _ H3); reflexivity.
Qed.


Require Import
  HoTT.Classes.interfaces.abstract_algebra
  HoTT.HProp HoTT.TruncType
  HoTT.Types.Universe HoTT.Types.Prod.

(** Demonstrate the [hProp] is a (bounded) lattice w.r.t. the logical
operations. This requires Univalence. *)
Instance join_hor : Join hProp := hor.
Definition hand (X Y : hProp) : hProp := BuildhProp (X * Y).
Instance meet_hprop : Meet hProp := hand.
Instance bottom_hprop : Bottom hProp := False_hp.
Instance top_hprop : Top hProp := Unit_hp.

Section contents.
  Context `{Univalence}.

  (* We use this notation because [hor] can accept arguments of type [Type], which leads to minor confusion in the instances below *)
  Notation lor := (hor : hProp -> hProp -> hProp).

  (* This tactic attempts to destruct a truncated sum (disjunction) *)
  Local Ltac hor_intros :=
    let x := fresh in
    intro x; repeat (strip_truncations; destruct x as [x | x]).

  Instance commutative_hor : Commutative lor.
  Proof.
    intros ??.
    apply path_iff_hprop; hor_intros; apply tr; auto.
  Defined.

  Instance commutative_hand : Commutative hand.
  Proof.
    intros ??.
    apply path_hprop.
    apply equiv_prod_symm.
  Defined.

  Instance associative_hor : Associative lor.
  Proof.
    intros ???.
    apply path_iff_hprop;
    hor_intros; apply tr;
    ((by auto) || (left; apply tr) || (right; apply tr));
    auto.
  Defined.

  Instance associative_hand : Associative hand.
  Proof.
    intros ???.
    apply path_hprop.
    apply equiv_prod_assoc.
  Defined.

  Instance idempotent_hor : BinaryIdempotent lor.
  Proof.
    intros ?. compute.
    apply path_iff_hprop; hor_intros; auto.
    by apply tr, inl.
  Defined.

  Instance idempotent_hand : BinaryIdempotent hand.
  Proof.
    intros ?.
    apply path_iff_hprop.
    - intros [a _] ; apply a.
    - intros a; apply (pair a a).
  Defined.

  Instance leftidentity_hor : LeftIdentity lor False_hp.
  Proof.
    intros ?.
    apply path_iff_hprop; hor_intros; try contradiction || assumption.
    by apply tr, inr.
  Defined.

  Instance rightidentity_hor : RightIdentity lor False_hp.
  Proof.
    intros ?.
    apply path_iff_hprop; hor_intros; try contradiction || assumption.
    by apply tr, inl.
  Defined.

  Instance leftidentity_hand : LeftIdentity hand Unit_hp.
  Proof.
    intros ?.
    apply path_trunctype, prod_unit_l.
  Defined.

  Instance rightidentity_hand : RightIdentity hand Unit_hp.
  Proof.
    intros ?.
    apply path_trunctype, prod_unit_r.
  Defined.

  Instance absorption_hor_hand : Absorption lor hand.
  Proof.
    intros ??.
    apply path_iff_hprop.
    - intros X; strip_truncations.
      destruct X as [? | [? _]]; assumption.
    - intros ?. by apply tr, inl.
  Defined.

  Instance absorption_hand_hor : Absorption hand lor.
  Proof.
    intros ??.
    apply path_iff_hprop.
    - intros [? _]; assumption.
    - intros ?.
      split.
      * assumption.
      * by apply tr, inl.
  Defined.

  Global Instance boundedlattice_hprop : IsBoundedLattice hProp.
  Proof. repeat split; apply _. Defined.
End contents.


(* comatrices *)

Set Nested Proofs Allowed.
Set Implicit Arguments.

Require Import Utf8 Arith.
Import List List.ListNotations.

Require Import Misc RingLike IterAdd IterMul Pigeonhole.
Require Import PermutationFun SortingFun SortRank.
Require Import Matrix PermutSeq Signature Determinant.
Require Import MyVector.
Import matrix_Notations.

Section a.

Context {T : Type}.
Context (ro : ring_like_op T).
Context (rp : ring_like_prop T).

Definition com (M : matrix T) : matrix T :=
  mk_mat
    (map
      (λ i,
       map (λ j, (minus_one_pow (i + j) * det (subm i j M))%L)
         (seq 1 (mat_ncols M)))
      (seq 1 (mat_nrows M))).

Arguments com M%M.

Theorem mat_swap_same_rows : ∀ (M : matrix T) i,
  mat_swap_rows i i M = M.
Proof.
intros.
destruct M as (ll); cbn.
unfold mat_swap_rows; f_equal.
cbn - [ list_swap_elem ].
rewrite (List_map_nth_seq ll (nth i ll [])) at 2.
unfold list_swap_elem.
apply map_ext_in.
intros j Hj; apply in_seq in Hj.
rewrite transposition_id.
now apply nth_indep.
Qed.

Theorem mat_swap_rows_comm : ∀ (M : matrix T) p q,
  mat_swap_rows p q M = mat_swap_rows q p M.
Proof.
intros.
unfold mat_swap_rows; f_equal; cbn.
unfold list_swap_elem.
apply map_ext_in.
intros i Hi; apply in_seq in Hi.
now rewrite transposition_comm.
Qed.

Theorem subm_mat_swap_rows_lt_lt : ∀ (M : matrix T) p q r j,
  p < q < r
  → subm r j (mat_swap_rows p q M) = mat_swap_rows p q (subm r j M).
Proof.
intros * (Hpq, Hq).
destruct M as (ll); cbn.
unfold subm, mat_swap_rows; cbn; f_equal.
rewrite map_length.
rewrite butn_length.
rewrite <- map_butn, map_map.
rewrite map_butn_seq.
rewrite Nat.add_0_l.
apply map_ext_in.
intros i Hi; apply in_seq in Hi.
unfold Nat.b2n.
rewrite if_leb_le_dec.
destruct Hi as (_, Hi).
destruct (le_dec (r - 1) i) as [Hir| Hir]. 2: {
  apply Nat.nle_gt in Hir.
  rewrite Nat.add_0_r.
  destruct (Nat.eq_dec i (p - 1)) as [Hip| Hip]. {
    subst i; clear Hir.
    rewrite transposition_1.
    destruct (lt_dec (q - 1) (length (butn (r - 1) ll))) as [Hqrl| Hqrl]. {
      rewrite (List_map_nth' []); [ | easy ].
      rewrite nth_butn_after; [ easy | flia Hpq Hq ].
    }
    apply Nat.nlt_ge in Hqrl.
    symmetry.
    rewrite nth_overflow; [ | now rewrite map_length ].
    rewrite butn_length in Hqrl.
    destruct (le_dec (length ll) (q - 1)) as [Hlq| Hlq]. {
      rewrite nth_overflow; [ | easy ].
      now rewrite butn_nil.
    }
    apply Nat.nle_gt in Hlq.
    unfold Nat.b2n in Hi, Hqrl.
    rewrite if_ltb_lt_dec in Hi, Hqrl.
    destruct (lt_dec (r - 1) (length ll)) as [Hrl| Hrl]; [ | flia Hqrl Hlq ].
    flia Hq Hrl Hi Hqrl.
  }
  destruct (Nat.eq_dec i (q - 1)) as [Hiq| Hiq]. {
    subst i; clear Hir.
    rewrite transposition_2.
    destruct (lt_dec (p - 1) (length (butn (r - 1) ll))) as [Hprl| Hprl]. {
      rewrite (List_map_nth' []); [ | easy ].
      rewrite nth_butn_after; [ easy | flia Hpq Hq ].
    }
    apply Nat.nlt_ge in Hprl.
    rewrite butn_length in Hprl.
    flia Hpq Hi Hprl.
  }
  unfold transposition.
  do 2 rewrite if_eqb_eq_dec.
  destruct (Nat.eq_dec i (p - 1)) as [H| H]; [ easy | clear H ].
  destruct (Nat.eq_dec i (q - 1)) as [H| H]; [ easy | clear H ].
  rewrite map_butn.
  rewrite nth_butn_after; [ | easy ].
  rewrite (List_map_nth' []); [ easy | flia Hi ].
}
unfold transposition.
do 4 rewrite if_eqb_eq_dec.
destruct (Nat.eq_dec i (p - 1)) as [H| H]; [ flia Hpq Hq Hir H | clear H ].
destruct (Nat.eq_dec i (q - 1)) as [H| H]; [ flia Hpq Hq Hir H | clear H ].
destruct (Nat.eq_dec (i + 1) (p - 1)) as [H| H]; [ flia Hpq Hq Hir H | clear H ].
destruct (Nat.eq_dec (i + 1) (q - 1)) as [H| H]; [ flia Hq Hir H | clear H ].
rewrite map_butn.
rewrite nth_butn_before; [ | easy ].
rewrite (List_map_nth' []); [ easy | ].
unfold Nat.b2n in Hi.
rewrite if_ltb_lt_dec in Hi.
destruct (lt_dec (r - 1) (length ll)) as [Hrl| Hrl]; [ flia Hi Hir | ].
flia Hrl Hi Hir.
Qed.

Theorem subm_mat_swap_rows_lt : ∀ (M : matrix T) p q r j,
  p < r
  → q < r
  → subm r j (mat_swap_rows p q M) = mat_swap_rows p q (subm r j M).
Proof.
intros * Hp Hq.
destruct (lt_dec p q) as [Hpq| Hpq]; [ now apply subm_mat_swap_rows_lt_lt | ].
do 2 rewrite mat_swap_rows_comm with (p := p).
destruct (lt_dec q p) as [Hqp| Hqp]; [ now apply subm_mat_swap_rows_lt_lt | ].
replace q with p by flia Hpq Hqp.
now do 2 rewrite mat_swap_same_rows.
Qed.

Theorem mat_el_mat_swap_rows : ∀ (M : matrix T) p q j,
  1 ≤ q ≤ mat_nrows M
  → mat_el (mat_swap_rows p q M) q j = mat_el M p j.
Proof.
intros * Hql; cbn.
destruct M as (ll); cbn in Hql |-*.
f_equal; clear j.
rewrite (List_map_nth' 0); [ | rewrite seq_length; flia Hql ].
rewrite seq_nth; [ | flia Hql ].
rewrite Nat.add_0_l.
now rewrite transposition_2.
Qed.

Theorem length_fold_left_map_transp : ∀ A (ll : list A) sta len f g d,
  length
    (fold_left
       (λ ll' k,
        map (λ i, nth (transposition (f k) (g k) i) ll' d)
          (seq 0 (length ll')))
       (seq sta len) ll) = length ll.
Proof.
intros.
induction len; [ easy | ].
rewrite seq_S.
rewrite fold_left_app; cbn.
rewrite List_map_seq_length.
apply IHlen.
Qed.

Theorem mat_nrows_fold_left_swap : ∀ (M : matrix T) p q f g,
  mat_nrows (fold_left (λ M' k, mat_swap_rows (f k) (g k) M') (seq p q) M) =
  mat_nrows M.
Proof.
intros.
unfold mat_nrows.
rewrite fold_left_mat_fold_left_list_list.
apply length_fold_left_map_transp.
Qed.

Theorem nth_fold_left_map_transp_1 : ∀ A (la : list A) i sta len d,
  i < length la
  → i < sta ∨ sta + len < i
  → nth i
      (fold_left
         (λ la' k,
            map (λ j, nth (transposition k (k + 1) j) la' d)
              (seq 0 (length la')))
         (seq sta len) la) d =
    nth i la d.
Proof.
intros * Hi Hip.
induction len; [ easy | ].
rewrite seq_S; cbn.
rewrite fold_left_app; cbn.
rewrite (List_map_nth' 0). 2: {
  rewrite seq_length.
  now rewrite length_fold_left_map_transp.
}
rewrite seq_nth. 2: {
  now rewrite length_fold_left_map_transp.
}
rewrite Nat.add_0_l.
unfold transposition.
do 2 rewrite if_eqb_eq_dec.
destruct (Nat.eq_dec i (sta + len)) as [His| His]; [ flia His Hip | ].
destruct (Nat.eq_dec i (sta + len + 1)) as [Hip1| Hip1]; [ flia Hip Hip1 | ].
apply IHlen.
flia Hip His.
Qed.

Theorem nth_fold_left_seq_gen : ∀ A (u : list A) i d n sta,
  sta + n ≤ length u
  → sta ≤ i < sta + n - 1
  → nth i
      (fold_left
         (λ la' k,
            map (λ j, nth (transposition k (k + 1) j) la' d)
              (seq 0 (length la')))
         (seq sta n) u) d =
     nth (i + 1) u d.
Proof.
intros * Hn Hi.
revert i Hi.
induction n; intros; [ flia Hi  | ].
assert (H : sta + n ≤ length u) by flia Hn.
specialize (IHn H); clear H.
rewrite <- Nat.add_sub_assoc in Hi; [ | flia ].
rewrite Nat_sub_succ_1 in Hi.
rewrite seq_S.
rewrite fold_left_app.
destruct (Nat.eq_dec i (sta + n - 1)) as [Hin| Hin]. {
  subst i.
  rewrite Nat.sub_add; [ | flia Hi ].
  cbn.
  rewrite length_fold_left_map_transp.
  rewrite (List_map_nth' 0); [ | rewrite seq_length; flia Hn ].
  rewrite seq_nth; [ | flia Hn ].
  rewrite transposition_out; [ cbn | flia Hi | flia ].
  destruct n; [ flia Hi | ].
  rewrite <- Nat.add_sub_assoc; [ | flia ].
  rewrite Nat_sub_succ_1.
  rewrite seq_S; cbn.
  rewrite fold_left_app; cbn.
  rewrite length_fold_left_map_transp.
  rewrite (List_map_nth' 0); [ | rewrite seq_length; flia Hn ].
  rewrite seq_nth; [ | flia Hn ].
  rewrite transposition_1.
  rewrite Nat.add_1_r.
  rewrite nth_fold_left_map_transp_1; [ | flia Hn | right; flia ].
  now rewrite <- Nat.add_succ_comm.
}
cbn.
rewrite length_fold_left_map_transp.
rewrite (List_map_nth' 0); [ | rewrite seq_length; flia Hn Hi ].
rewrite seq_nth; [ | flia Hn Hi ].
rewrite transposition_out; [ cbn | flia Hi | flia Hi Hin ].
apply IHn.
flia Hi Hin.
Qed.

Theorem nth_fold_left_map_transp : ∀ A (la : list A) i sta len d,
  nth i
    (fold_left
       (λ la' k,
          map (λ j, nth (transposition k (k + 1) j) la' d)
            (seq 0 (length la')))
       (seq sta len) la) d =
  if le_dec (length la) i then d
  else if Nat.eq_dec i (sta + len) then nth sta la d
  else if le_dec (length la) sta then nth i la d
  else if le_dec (length la) (sta + len) then
    nth i
      (fold_left
         (λ la' k,
          map (λ j, nth (transposition k (k + 1) j) la' d)
            (seq 0 (length la)))
         (seq sta (length la - sta)) la) d
  else
    nth (i + Nat.b2n ((sta <=? i) && (i <=? sta + len))) la d.
Proof.
intros.
destruct (le_dec (length la) i) as [Hi| Hi]. {
  rewrite nth_overflow; [ easy | ].
  now rewrite length_fold_left_map_transp.
}
apply Nat.nle_gt in Hi.
destruct (Nat.eq_dec i (sta + len)) as [Hisl| Hisl]. {
  subst i.
  revert la sta d Hi.
  induction len; intros. {
    rewrite Nat.add_0_r in Hi |-*.
    now destruct la.
  }
  cbn.
  rewrite <- Nat.add_succ_comm in Hi.
  rewrite <- Nat.add_succ_comm.
  rewrite IHlen; [ | now rewrite List_map_seq_length ].
  rewrite (List_map_nth' 0); [ | rewrite seq_length; flia Hi ].
  rewrite seq_nth; [ | flia Hi ].
  rewrite Nat.add_0_l, Nat.add_1_r.
  now rewrite transposition_2.
}
unfold Nat.b2n, "&&", negb.
destruct (le_dec (length la) sta) as [Hsla| Hsla]. {
  rewrite List_fold_left_map_nth_len.
  erewrite List_fold_left_ext_in. 2: {
    intros j v Hj; apply in_seq in Hj.
    erewrite map_ext_in. 2: {
      intros k Hk; apply in_seq in Hk.
      rewrite transposition_out; [ | flia Hsla Hj Hk | flia Hsla Hj Hk ].
      easy.
    }
    easy.
  }
  specialize (List_seq_shift' sta 0 len) as H1; rewrite Nat.add_0_r in H1.
  rewrite <- H1. clear H1.
  rewrite List_fold_left_map.
  rewrite <- List_fold_left_map_nth_len.
  rewrite List_fold_left_nop_r.
  rewrite seq_length.
  rewrite repeat_apply_id. 2: {
    intros u.
    symmetry; apply List_map_nth_seq.
  }
  easy.
}
apply Nat.nle_gt in Hsla.
destruct (le_dec (length la) (sta + len)) as [Hsl| Hsl]. {
  replace len with (length la - sta + (sta + len - length la)) at 1
    by flia Hsla Hsl.
  rewrite seq_app.
  rewrite fold_left_app.
  rewrite Nat.add_comm, Nat.sub_add; [ | flia Hsla ].
  rewrite List_fold_left_map_nth_len.
  erewrite List_fold_left_ext_in. 2: {
    intros j v Hj; apply in_seq in Hj.
    erewrite map_ext_in. 2: {
      intros k Hk; apply in_seq in Hk.
      rewrite length_fold_left_map_transp in Hk.
      rewrite transposition_out; [ | flia Hsla Hj Hk | flia Hsla Hj Hk ].
      easy.
    }
    easy.
  }
  rewrite <- List_fold_left_map_nth_len.
  rewrite List_fold_left_nop_r.
  rewrite seq_length.
  rewrite repeat_apply_id. 2: {
    intros u.
    symmetry; apply List_map_nth_seq.
  }
  now rewrite <- List_fold_left_map_nth_len.
}
apply Nat.nle_gt in Hsl.
rewrite if_leb_le_dec.
destruct (le_dec sta i) as [Hip| Hip]. 2: {
  apply Nat.nle_gt in Hip.
  rewrite Nat.add_0_r.
  apply nth_fold_left_map_transp_1; [ easy | now left ].
}
rewrite if_leb_le_dec.
destruct (le_dec i (sta + len)) as [Hip'| Hip']. 2: {
  apply Nat.nle_gt in Hip'.
  rewrite Nat.add_0_r.
  apply nth_fold_left_map_transp_1; [ easy | now right ].
}
assert (H : i < sta + len) by flia Hisl Hip'.
clear Hisl Hip'; rename H into Hisl.
destruct (Nat.eq_dec i (length la - 1)) as [Hila| Hila]. {
  flia Hsl Hisl Hila.
}
destruct (Nat.eq_dec i (sta + len - 1)) as [Hisl1| Hisl1]. 2: {
  rewrite nth_fold_left_seq_gen; [ easy | flia Hsl | flia Hip Hisl Hisl1 ].
}
rewrite Hisl1.
rewrite Nat.sub_add; [ | flia Hisl ].
destruct len; [ flia Hip Hisl | ].
rewrite seq_S.
rewrite fold_left_app; cbn.
rewrite <- Nat.add_sub_assoc; [ | flia ].
rewrite Nat_sub_succ_1.
rewrite length_fold_left_map_transp.
rewrite (List_map_nth' 0); [ | rewrite seq_length; flia Hsl ].
rewrite seq_nth; [ | flia Hsl ].
rewrite transposition_1.
rewrite <- Nat.add_assoc, Nat.add_1_r.
apply nth_fold_left_map_transp_1; [ easy | right; flia ].
Qed.

Theorem nth_fold_left_map_transp' : ∀ A (la : list A) i len d,
  i + 1 < length la
  → i < len
  → nth i
      (fold_left
         (λ la' k,
            map (λ j, nth (transposition k (k + 1) j) la' d)
              (seq 0 (length la')))
         (seq 0 len) la) d =
    nth (i + 1) la d.
Proof.
intros * Hi Hpi.
rewrite nth_fold_left_map_transp; cbn.
rewrite Nat.sub_0_r.
destruct (le_dec (length la) i) as [H| H]; [ flia Hi H | clear H ].
destruct (Nat.eq_dec i len) as [H| H]; [ flia Hpi H | clear H ].
destruct (le_dec (length la) 0) as [H| H]; [ flia Hi H | clear H ].
destruct (le_dec (length la) len) as [Hll| Hll]. 2: {
  apply Nat.nle_gt in Hll.
  unfold Nat.b2n.
  rewrite if_leb_le_dec.
  destruct (le_dec i len) as [H| H]; [ easy | flia Hpi H ].
}
clear len Hpi Hll.
rewrite <- List_fold_left_map_nth_len.
rewrite nth_fold_left_seq_gen; [ easy | easy | flia Hi ].
Qed.

Theorem subm_mat_swap_rows_circ : ∀ (M : matrix T) p q,
  1 ≤ p ≤ mat_nrows M
  → subm 1 q (mat_swap_rows 1 p M) =
    subm p q
      (fold_left (λ M' k, mat_swap_rows (k + 1) (k + 2) M')
         (seq 0 (p - 2)) M).
Proof.
intros * Hp.
destruct M as (ll); cbn in Hp |-*.
unfold subm; f_equal.
cbn - [ butn ].
f_equal; clear q.
rewrite fold_left_mat_fold_left_list_list.
cbn - [ butn ].
rewrite List_map_nth_seq with (d := []); symmetry.
rewrite List_map_nth_seq with (d := []); symmetry.
rewrite butn_length, map_length, seq_length.
rewrite butn_length.
rewrite length_fold_left_map_transp.
unfold Nat.b2n.
do 2 rewrite if_ltb_lt_dec.
destruct (lt_dec 0 (length ll)) as [H| H]; [ clear H | flia H Hp ].
destruct (lt_dec (p - 1) (length ll)) as [H| H]; [ clear H | flia H Hp ].
apply map_ext_in.
intros i Hi; apply in_seq in Hi.
cbn in Hi.
rewrite <- map_butn.
rewrite (List_map_nth' 0). 2: {
  rewrite butn_length, seq_length.
  unfold Nat.b2n.
  rewrite if_ltb_lt_dec.
  destruct (lt_dec 0 (length ll)) as [H| H]; [ easy | flia Hp H ].
}
rewrite nth_butn_before; [ | flia ].
rewrite seq_nth; [ cbn | flia Hi ].
erewrite List_fold_left_ext_in. 2: {
  intros j ll' Hj.
  erewrite map_ext_in. 2: {
    intros k Hk.
    now rewrite Nat.add_sub, Nat.add_succ_r, Nat_sub_succ_1.
  }
  easy.
}
destruct (le_dec (p - 1) i) as [Hpi| Hpi]. 2: {
  apply Nat.nle_gt in Hpi.
  rewrite nth_butn_after; [ | easy ].
  rewrite nth_fold_left_map_transp; cbn.
  rewrite Nat.sub_0_r.
  destruct (le_dec (length ll) i) as [H| H]; [ flia Hi H | clear H ].
  destruct (Nat.eq_dec i (p - 2)) as [Hip1| Hip1]. {
    rewrite Hip1.
    replace (p - 2 + 1) with (p - 1) by flia Hpi.
    now rewrite transposition_2.
  }
  destruct (le_dec (length ll) 0) as [H| H]; [ flia Hp H | clear H ].
  destruct (le_dec (length ll) (p - 2)) as [H| H]; [ flia Hp H | clear H ].
  unfold transposition.
  unfold Nat.b2n.
  do 2 rewrite if_eqb_eq_dec.
  rewrite if_leb_le_dec.
  rewrite Nat.add_1_r.
  destruct (Nat.eq_dec (S i) 0) as [H| H]; [ easy | clear H ].
  destruct (Nat.eq_dec (S i) (p - 1)) as [H| H]; [ flia Hip1 H | clear H ].
  destruct (le_dec i (p - 2)) as [H| H]; [ | flia Hpi H ].
  now rewrite Nat.add_1_r.
}
rewrite transposition_out; [ | flia | flia Hpi ].
rewrite nth_butn_before; [ | easy ].
symmetry.
rewrite nth_fold_left_map_transp; cbn; rewrite Nat.sub_0_r.
destruct (le_dec (length ll) (i + 1)) as [H| H]; [ flia Hi H | clear H ].
destruct (Nat.eq_dec (i + 1) (p - 2)) as [H| H]; [ flia Hpi H | clear H ].
destruct (le_dec (length ll) 0) as [H| H]; [ flia Hp H | clear H ].
destruct (le_dec (length ll) (p - 2)) as [H| H]; [ flia Hp H | clear H ].
unfold Nat.b2n.
rewrite if_leb_le_dec.
destruct (le_dec (i + 1) (p - 2)) as [H| H]; [ flia Hpi H | clear H ].
now rewrite Nat.add_0_r.
Qed.

Theorem subm_fold_left_lt : ∀ (M : matrix T) i j m,
  m < i - 1
  → subm i j
      (fold_left (λ M' k, mat_swap_rows (k + 1) (k + 2) M')
         (seq 0 m) M) =
    fold_left
      (λ M' k, mat_swap_rows (k + 1) (k + 2) M')
      (seq 0 m) (subm i j M).
Proof.
intros * Hmi.
revert i Hmi.
induction m; intros; [ easy | ].
rewrite seq_S; cbn.
do 2 rewrite fold_left_app; cbn.
rewrite <- IHm; [ | flia Hmi ].
apply subm_mat_swap_rows_lt; flia Hmi.
Qed.

Theorem determinant_circular_shift_rows :
  rngl_mul_is_comm = true →
  rngl_has_opp = true →
  ∀ (M : matrix T) i,
  i < mat_nrows M
  → is_square_matrix M = true
  → det (fold_left (λ M' k, mat_swap_rows (k + 1) (k + 2) M') (seq 0 i) M) =
    (minus_one_pow i * det M)%L.
Proof.
intros Hic Hop * Hin Hsm.
remember (mat_nrows M) as n eqn:Hr; symmetry in Hr.
revert M Hsm Hr.
induction i; intros; [ now cbn; rewrite rngl_mul_1_l | ].
assert (H : i < n) by flia Hin.
specialize (IHi H); clear H.
rewrite seq_S; cbn.
rewrite fold_left_app; cbn - [ det ].
rewrite determinant_alternating; [ | easy | easy | flia | | | ]; cycle 1. {
  rewrite mat_nrows_fold_left_swap, Hr; flia Hin.
} {
  rewrite mat_nrows_fold_left_swap, Hr; flia Hin.
} {
  specialize (squ_mat_ncols _ Hsm) as Hc1.
  apply is_scm_mat_iff.
  apply is_scm_mat_iff in Hsm.
  destruct Hsm as (Hcr & Hc).
  rewrite Hr in Hc1.
  rewrite mat_nrows_fold_left_swap.
  split. {
    intros Hc'.
    unfold mat_ncols in Hc'.
    rewrite fold_left_mat_fold_left_list_list in Hc'.
    cbn in Hc'.
    erewrite List_fold_left_ext_in in Hc'. 2: {
      intros j ll' Hj.
      erewrite map_ext_in. 2: {
        intros k Hk.
        now rewrite Nat.add_sub, Nat.add_succ_r, Nat_sub_succ_1.
      }
      easy.
    }
    apply length_zero_iff_nil in Hc'.
    rewrite List_hd_nth_0 in Hc'.
    rewrite nth_fold_left_map_transp in Hc'.
    rewrite fold_mat_nrows in Hc'.
    do 2 rewrite Nat.add_0_l in Hc'.
    destruct (le_dec (mat_nrows M) 0) as [Hlz| Hlz]. {
      now apply Nat.le_0_r in Hlz.
    }
    apply Nat.nle_gt in Hlz.
    destruct (Nat.eq_dec 0 i) as [Hiz| Hiz]. {
      subst i.
      apply Hcr.
      unfold mat_ncols.
      rewrite List_hd_nth_0.
      now rewrite Hc'.
    }
    rewrite Nat.sub_0_r in Hc'.
    destruct (le_dec (mat_nrows M) i) as [Hri| Hri]. {
      unfold mat_nrows in Hc'.
      rewrite <- List_fold_left_map_nth_len in Hc'.
      rewrite nth_fold_left_map_transp' in Hc'; cycle 1. {
        rewrite fold_mat_nrows.
        flia Hin Hr.
      } {
        now rewrite fold_mat_nrows.
      }
      cbn in Hc'.
      apply (f_equal length) in Hc'.
      rewrite Hc in Hc'. 2: {
        apply nth_In.
        rewrite fold_mat_nrows.
        flia Hr Hin.
      }
      easy.
    }
    apply Nat.nle_gt in Hri.
    cbn in Hc'.
    apply (f_equal length) in Hc'.
    rewrite Hc in Hc'. 2: {
      apply nth_In.
      rewrite fold_mat_nrows.
      flia Hr Hin.
    }
    easy.
  }
  intros la Hla.
  rewrite fold_left_mat_fold_left_list_list in Hla.
  cbn in Hla.
  apply In_nth with (d := []) in Hla.
  rewrite length_fold_left_map_transp, fold_mat_nrows in Hla.
  destruct Hla as (j & Hj & Hla).
  erewrite List_fold_left_ext_in in Hla. 2: {
    intros k ll' Hk.
    erewrite map_ext_in. 2: {
      intros l Hl.
      now rewrite Nat.add_sub, Nat.add_succ_r, Nat_sub_succ_1.
    }
    easy.
  }
  rewrite nth_fold_left_map_transp in Hla.
  rewrite fold_mat_nrows in Hla.
  rewrite Nat.add_0_l in Hla.
  destruct (le_dec (mat_nrows M) j) as [H| H]; [ flia Hj H | clear H ].
  destruct (Nat.eq_dec j i) as [Hji| Hji]. {
    subst la.
    apply Hc, nth_In.
    rewrite fold_mat_nrows; flia Hj.
  }
  destruct (le_dec (mat_nrows M) 0) as [H| H]; [ flia Hj H | clear H ].
  destruct (le_dec (mat_nrows M) i) as [H| H]; [ flia Hin Hr H | clear H ].
  subst la.
  unfold Nat.b2n.
  rewrite Bool.andb_if.
  do 2 rewrite if_leb_le_dec.
  destruct (le_dec 0 j) as [Hjz| Hjz]. {
    destruct (le_dec j i) as [Hji'| Hji']. {
      apply Hc, nth_In.
      rewrite fold_mat_nrows.
      rewrite Hr in Hj |-*.
      flia Hji' Hin.
    }
    apply Nat.nle_gt in Hji'.
    rewrite Nat.add_0_r.
    apply Hc, nth_In.
    now rewrite fold_mat_nrows.
  }
  now apply Nat.nle_gt in Hjz.
}
rewrite IHi; [ | easy | easy ].
rewrite minus_one_pow_succ; [ | easy ].
now symmetry; apply rngl_mul_opp_l.
Qed.

Theorem determinant_subm_mat_swap_rows_0_i :
  rngl_mul_is_comm = true →
  rngl_has_opp = true →
  ∀ (M : matrix T) i j,
  is_square_matrix M = true
  → 1 < i ≤ mat_nrows M
  → 1 ≤ j ≤ mat_nrows M
  → det (subm 1 j (mat_swap_rows 1 i M)) =
    (minus_one_pow i * det (subm i j M))%L.
Proof.
intros Hic Hop * Hsm (Hiz, Hin) Hjn.
rewrite subm_mat_swap_rows_circ. 2: {
  split; [ flia Hiz | easy ].
}
destruct i; [ flia Hiz | ].
rewrite (minus_one_pow_succ Hop).
replace (S i - 2) with (i - 1) by flia.
rewrite subm_fold_left_lt; [ | flia Hiz ].
rewrite determinant_circular_shift_rows; [ | easy | easy | | ]. {
  destruct i; [ flia Hiz | ].
  rewrite Nat_sub_succ_1.
  rewrite minus_one_pow_succ; [ | easy ].
  now rewrite rngl_opp_involutive.
} {
  rewrite mat_nrows_subm.
  generalize Hin; intros H.
  apply Nat.leb_le in H; rewrite H; clear H; cbn.
  flia Hin Hiz.
}
apply is_squ_mat_subm; [ flia Hin | flia Hjn | easy ].
Qed.

(* Laplace formulas *)

Theorem laplace_formula_on_rows :
  rngl_has_opp = true →
  rngl_mul_is_comm = true →
  ∀ (M : matrix T) i,
  is_square_matrix M = true
  → 1 ≤ i ≤ mat_nrows M
  → det M = ∑ (j = 1, mat_ncols M), mat_el M i j * mat_el (com M) i j.
Proof.
intros Hop Hic * Hsm Hlin.
specialize (squ_mat_ncols M Hsm) as Hc.
rewrite Hc.
specialize (proj1 (is_scm_mat_iff _ M) Hsm) as H1.
destruct H1 as (Hcr & Hc').
destruct (Nat.eq_dec (mat_nrows M) 0) as [Hnz| Hnz]. {
  rewrite Hnz in Hlin; flia Hlin.
}
destruct (Nat.eq_dec i 1) as [Hi1| Hi1]. {
  subst i; cbn.
  symmetry.
  unfold det.
  replace (mat_nrows M) with (S (mat_nrows M - 1)) by flia Hnz.
  cbn - [ butn ].
  apply rngl_summation_eq_compat.
  intros j Hj.
  rewrite rngl_mul_comm; [ | easy ].
  rewrite rngl_mul_mul_swap; [ | easy ].
  rewrite (List_map_nth' 0); [ | rewrite seq_length, Hc; flia Hj Hnz ].
  rewrite seq_nth; [ | rewrite Hc; flia Hj Hnz ].
  rewrite map_length.
  cbn - [ butn ].
  rewrite <- Nat.sub_succ_l; [ | easy ].
  rewrite Nat_sub_succ_1.
  f_equal; f_equal.
  rewrite butn_length, fold_mat_nrows.
  apply Nat.neq_0_lt_0, Nat.ltb_lt in Hnz.
  now rewrite Hnz.
}
unfold det.
replace (mat_nrows M) with (S (mat_nrows M - 1)) by flia Hnz.
rewrite <- Nat.sub_succ_l; [ | flia Hnz ].
rewrite Nat_sub_succ_1.
symmetry.
erewrite rngl_summation_eq_compat. 2: {
  intros j Hj.
  cbn.
  rewrite (List_map_nth' 0); [ | rewrite seq_length; flia Hlin ].
  rewrite (List_map_nth' 0); [ | rewrite seq_length, Hc; flia Hj Hnz ].
  rewrite seq_nth; [ | flia Hlin ].
  rewrite seq_nth; [ | flia Hj Hc Hnz ].
  rewrite (Nat.add_comm 1), Nat.sub_add; [ | flia Hlin ].
  rewrite (Nat.add_comm 1), Nat.sub_add; [ | easy ].
  rewrite rngl_mul_comm; [ | easy ].
  rewrite rngl_mul_mul_swap; [ | easy ].
  easy.
}
cbn.
rename i into p.
remember (mat_swap_rows 1 p M) as M'.
erewrite rngl_summation_eq_compat. 2: {
  intros j Hj.
  rewrite map_length, butn_length, fold_mat_nrows.
  rewrite rngl_mul_mul_swap; [ | easy ].
  rewrite Nat.add_comm.
  rewrite minus_one_pow_add; [ | easy ].
  do 2 rewrite <- rngl_mul_assoc.
  rewrite rngl_mul_comm; [ | easy ].
  rewrite rngl_mul_assoc.
  specialize (determinant_subm_mat_swap_rows_0_i Hic Hop) as H1.
  specialize (H1 M p j Hsm).
  cbn - [ butn ] in H1.
  rewrite map_length, map_butn, butn_length in H1.
  rewrite list_swap_elem_length, fold_mat_nrows in H1.
  rewrite butn_length, map_length, fold_mat_nrows in H1.
  apply Nat.neq_0_lt_0, Nat.ltb_lt in Hnz.
  rewrite Hnz in H1; cbn - [ "<?" ] in H1.
  apply Nat.ltb_lt in Hnz.
  rewrite <- H1; [ | flia Hi1 Hlin | flia Hj Hnz ].
  clear H1.
  rewrite rngl_mul_comm; [ | easy ].
  rewrite rngl_mul_assoc, rngl_mul_mul_swap; [ | easy ].
  replace (mat_el M p j) with (mat_el (mat_swap_rows 1 p M) 0 j). 2: {
    unfold mat_swap_rows.
    cbn; unfold list_swap_elem.
    rewrite fold_mat_nrows.
    rewrite (List_map_nth' 0); [ | now rewrite seq_length ].
    rewrite seq_nth; [ | easy ].
    rewrite Nat.add_0_r, transposition_1.
    easy.
  }
  rewrite <- HeqM'.
  easy.
}
cbn.
subst M'.
rewrite <- rngl_opp_involutive; [ | easy ].
rewrite fold_det.
assert (H1 : 1 ≠ p) by flia Hlin Hi1.
assert (H2 : p - 1 < mat_nrows M) by flia Hlin.
apply Nat.neq_0_lt_0 in Hnz.
rewrite <- (determinant_alternating Hic Hop M H1); [ | easy | easy | easy ].
unfold det.
rewrite mat_swap_rows_nrows.
remember (determinant_loop (mat_nrows M)) as x eqn:Hx.
replace (mat_nrows M) with (S (mat_nrows M - 1)) in Hx by flia Hlin.
subst x.
rewrite determinant_succ.
rewrite <- Nat.sub_succ_l; [ | flia Hnz ].
rewrite Nat_sub_succ_1.
rewrite rngl_opp_summation; [ | easy ].
apply rngl_summation_eq_compat.
intros i Hi.
rewrite <- rngl_mul_opp_l; [ | easy ].
rewrite <- rngl_mul_opp_l; [ | easy ].
rewrite minus_one_pow_succ; [ | easy ].
rewrite rngl_opp_involutive; [ | easy ].
easy.
Qed.

Theorem map_permut_seq_permut_seq_with_len : ∀ n σ,
  permut_seq_with_len n σ
  → permut_seq_with_len n (map (λ i, nth i σ 0) (seq 0 n)).
Proof.
intros * Hσ.
split; [ | now rewrite List_map_seq_length ].
apply permut_seq_iff.
split. {
  intros i Hi.
  apply in_map_iff in Hi.
  destruct Hi as (j & Hji & Hj).
  apply in_seq in Hj.
  rewrite List_map_seq_length.
  rewrite <- Hji.
  destruct Hσ as (H1, H2).
  rewrite <- H2 in Hj |-*.
  apply permut_seq_ub; [ easy | now apply nth_In ].
} {
  apply (NoDup_map_iff 0).
  rewrite seq_length.
  intros i j Hi Hj Hij.
  rewrite seq_nth in Hij; [ | easy ].
  rewrite seq_nth in Hij; [ | easy ].
  do 2 rewrite Nat.add_0_l in Hij.
  destruct Hσ as (Hσa, Hσl).
  apply permut_seq_iff in Hσa.
  destruct Hσa as (Hσa, Hσn).
  apply (NoDup_nat _ Hσn); [ congruence | congruence | easy ].
}
Qed.

(* https://proofwiki.org/wiki/Permutation_of_Determinant_Indices *)

Theorem comatrix_nrows : ∀ M, mat_nrows (com M) = mat_nrows M.
Proof.
intros.
unfold com; cbn.
now rewrite List_map_seq_length.
Qed.

Theorem comatrix_ncols : ∀ M, mat_ncols (com M) = mat_ncols M.
Proof.
intros.
unfold com.
unfold mat_ncols; cbn.
destruct (Nat.eq_dec (mat_nrows M) 0) as [Hrz| Hrz]. {
  rewrite Hrz; cbn.
  unfold mat_nrows in Hrz.
  now apply length_zero_iff_nil in Hrz; rewrite Hrz.
}
apply Nat.neq_0_lt_0 in Hrz.
rewrite (List_map_hd 0); [ | now rewrite seq_length ].
now rewrite List_map_seq_length.
Qed.

Theorem comatrix_is_square : ∀ M,
  is_square_matrix M = true
  → is_square_matrix (com M) = true.
Proof.
intros * Hsm.
specialize (squ_mat_ncols _ Hsm) as Hc.
apply is_scm_mat_iff in Hsm.
apply is_scm_mat_iff.
rewrite comatrix_ncols.
rewrite comatrix_nrows.
split; [ easy | ].
intros l Hl.
apply in_map_iff in Hl.
destruct Hl as (i & Hil & Hi).
now rewrite <- Hil; rewrite List_map_seq_length.
Qed.

Theorem comatrix_is_correct : ∀ M,
  is_correct_matrix M = true
  → is_correct_matrix (com M) = true.
Proof.
intros * Hsm.
apply is_scm_mat_iff in Hsm.
apply is_scm_mat_iff.
rewrite comatrix_ncols.
rewrite comatrix_nrows.
split; [ easy | ].
intros l Hl.
apply in_map_iff in Hl.
destruct Hl as (i & Hil & Hi).
now rewrite <- Hil; rewrite List_map_seq_length.
Qed.

Theorem comatrix_transpose :
  rngl_mul_is_comm = true →
  rngl_has_opp = true →
  rngl_characteristic ≠ 1 →
  ∀ M,
  is_square_matrix M = true
  → com M⁺ = (com M)⁺%M.
Proof.
intros Hic Hop H10 * Hsm.
destruct (Nat.eq_dec (mat_ncols M) 0) as [Hcz| Hcz]. {
  unfold mat_transp, com; cbn - [ det ].
  rewrite Hcz; cbn.
  unfold mat_ncols; cbn.
  destruct (Nat.eq_dec (mat_nrows M) 0) as [Hrz| Hrz]; [ now rewrite Hrz | ].
  now replace (mat_nrows M) with (S (mat_nrows M - 1)) by flia Hrz.
}
destruct (Nat.eq_dec (mat_nrows M) 0) as [Hrz| Hrz]. {
  unfold mat_ncols in Hcz.
  unfold mat_nrows in Hrz.
  apply length_zero_iff_nil in Hrz.
  now rewrite Hrz in Hcz.
}
apply Nat.neq_0_lt_0 in Hcz, Hrz.
unfold mat_transp, com, mat_ncols; cbn - [ det ].
f_equal.
rewrite (List_map_hd 0); [ | now rewrite seq_length ].
rewrite (List_map_hd 0); [ | now rewrite seq_length ].
do 4 rewrite map_length.
do 2 rewrite seq_length.
rewrite fold_mat_ncols.
apply map_ext_in.
intros i Hi; apply in_seq in Hi.
assert (H : 1 ≤ i ≤ mat_ncols M) by flia Hi.
clear Hi; rename H into Hi.
apply map_ext_in.
intros j Hj; apply in_seq in Hj.
assert (H : 1 ≤ j ≤ mat_nrows M) by flia Hj.
clear Hj; rename H into Hj.
assert (Hi' : i - 1 < mat_ncols M) by flia Hi.
assert (Hj' : j - 1 < mat_nrows M) by flia Hj.
move j before i.
rewrite (List_map_nth' 0); [ | now rewrite seq_length ].
rewrite (List_map_nth' 0); [ | now rewrite seq_length ].
rewrite seq_nth; [ | easy ].
rewrite seq_nth; [ | easy ].
rewrite (Nat.add_comm 1 (j - 1)), Nat.sub_add; [ | easy ].
rewrite (Nat.add_comm 1 (i - 1)), Nat.sub_add; [ | easy ].
rewrite Nat.add_comm; f_equal; symmetry.
specialize (@fold_mat_transp T ro M) as H1.
now apply det_subm_transp.
Qed.

Theorem laplace_formula_on_cols :
  rngl_has_opp = true →
  rngl_mul_is_comm = true →
  rngl_characteristic ≠ 1 →
  ∀ (M : matrix T) j,
  is_square_matrix M = true
  → 1 ≤ j ≤ mat_ncols M
  → det M = ∑ (i = 1, mat_nrows M), mat_el M i j * mat_el (com M) i j.
Proof.
intros Hop Hic H10 * Hsm Hj.
rewrite <- (determinant_transpose Hic Hop H10); [ | easy ].
erewrite rngl_summation_eq_compat. 2: {
  intros i Hi.
  rewrite <- mat_transp_el; [ | | flia Hj | flia Hi ]. 2: {
    now apply squ_mat_is_corr.
  }
  easy.
}
cbn - [ det mat_el ].
specialize (@laplace_formula_on_rows Hop Hic (M⁺)%M j) as H1.
assert (H : is_square_matrix M⁺ = true) by now apply mat_transp_is_square.
specialize (H1 H); clear H.
rewrite mat_transp_nrows in H1.
rewrite mat_transp_ncols in H1.
rewrite if_eqb_eq_dec in H1.
destruct (Nat.eq_dec (mat_ncols M) 0) as [Hcz| Hcz]. {
  rewrite Hcz in Hj; flia Hj.
}
specialize (H1 Hj).
rewrite H1.
apply rngl_summation_eq_compat.
intros i Hi.
f_equal.
symmetry.
rewrite (comatrix_transpose Hic Hop H10); [ | easy ].
symmetry.
apply mat_transp_el; [ | flia Hj | flia Hi ].
apply comatrix_is_correct.
now apply squ_mat_is_corr.
Qed.

(*
The following two theorems, "determinant_with_row" and determinant_with_bad_row
have some similitudes.
  The theorem "determinant_with_row" says that we can compute the determinant
by going through any row (not necessarily the 0th one). Here, row "i".
  The theorem "determinant_with_bad_row" says that if we go through another
row "k" different from "i", the same formula (where "M i j" is replaced
with "M k j") returns 0. It is what I call a "bad determinant formula".

determinant_with_row
  ∀ (i n : nat) (M : matrix (S n) (S n) T),
  i ≤ n
  → ∑ (j = 1, n), minus_one_pow (i + j) * M i j * det (subm M i j) = det M

determinant_with_bad_row
  ∀ (i k n : nat) (M : matrix (S n) (S n) T),
  i ≤ n → k ≤ n → i ≠ k
  → ∑ (j = 1, n), minus_one_pow (i + j) * M k j * det (subm M i j) = 0%L
*)

Theorem determinant_with_row :
  rngl_has_opp = true →
  rngl_mul_is_comm = true →
  ∀ i (M : matrix T),
  is_square_matrix M = true
  → 1 ≤ i ≤ mat_nrows M
  → det M =
    ∑ (j = 1, mat_nrows M),
    minus_one_pow (i + j) * mat_el M i j * det (subm i j M).
Proof.
intros Hop Hic * Hsm Hir.
destruct (Nat.eq_dec i 1) as [Hi1| Hi1]. {
  subst i; cbn - [ det ].
  unfold det.
  erewrite rngl_summation_eq_compat. 2: {
    intros i Hi.
    rewrite mat_nrows_subm.
    easy.
  }
  cbn.
  replace (mat_nrows M) with (S (mat_nrows M - 1)) by flia Hir.
  rewrite determinant_succ.
  now cbn; rewrite Nat.sub_0_r.
}
apply rngl_opp_inj; [ easy | ].
rewrite <- (determinant_alternating Hic Hop M Hi1); [ | easy | flia Hir | easy ].
unfold det at 1.
rewrite mat_swap_rows_nrows.
replace (mat_nrows M) with (S (mat_nrows M - 1)) at 1 by flia Hir.
rewrite determinant_succ.
rewrite <- Nat.sub_succ_l; [ | flia Hir ].
rewrite Nat_sub_succ_1.
rewrite rngl_opp_summation; [ | easy ].
apply rngl_summation_eq_compat.
intros j Hj.
rewrite <- rngl_mul_assoc; symmetry.
rewrite <- rngl_mul_opp_r; [ | easy ].
rewrite (Nat.add_comm i j).
rewrite minus_one_pow_add; [ | easy ].
rewrite rngl_mul_opp_r; [ | easy ].
rewrite <- rngl_mul_opp_l; [ | easy ].
rewrite <- rngl_mul_opp_l; [ | easy ].
rewrite <- rngl_mul_opp_l; [ | easy ].
do 2 rewrite <- rngl_mul_assoc.
rewrite minus_one_pow_succ; [ | easy ].
f_equal.
rewrite (minus_one_pow_mul_comm Hop).
rewrite <- rngl_mul_assoc.
rewrite mat_el_mat_swap_rows; [ | flia Hj ].
f_equal.
rewrite <- (minus_one_pow_mul_comm Hop).
symmetry.
rewrite mat_swap_rows_comm.
rewrite <- determinant_subm_mat_swap_rows_0_i; try easy; [ | flia Hir Hi1 ].
unfold det.
rewrite mat_nrows_subm.
rewrite mat_swap_rows_nrows.
assert (H : 1 ≤ mat_nrows M) by flia Hir.
now apply Nat.leb_le in H; rewrite H.
Qed.

Theorem determinant_with_bad_row :
  rngl_has_opp = true →
  rngl_mul_is_comm = true →
  rngl_characteristic = 0 →
  (rngl_is_integral || rngl_has_inv_or_quot)%bool = true →
  ∀ i k (M : matrix T),
  is_square_matrix M = true
  → 1 ≤ i ≤ mat_nrows M
  → 1 ≤ k ≤ mat_nrows M
  → i ≠ k
  → ∑ (j = 1, mat_nrows M),
    minus_one_pow (i + j) * mat_el M k j * det (subm i j M) = 0%L.
Proof.
intros Hop Hic Hch Hii * Hsm Hir Hkr Hik.
specialize (squ_mat_ncols _ Hsm) as Hc.
remember
  (mk_mat
     (map
        (λ p,
         map (λ q, mat_el M (if p =? i then k else p) q)
           (seq 1 (mat_ncols M)))
        (seq 1 (mat_nrows M))))
  as A eqn:HA.
assert (Hasm : is_square_matrix A = true). {
  subst A.
  apply is_scm_mat_iff; cbn.
  unfold mat_ncols; cbn.
  rewrite List_map_seq_length.
  rewrite (List_map_hd 0); [ | rewrite seq_length; flia Hir ].
  rewrite List_map_seq_length.
  rewrite fold_mat_ncols.
  apply is_scm_mat_iff in Hsm.
  split; [ easy | ].
  intros l Hl.
  apply in_map_iff in Hl.
  destruct Hl as (j & Hjl & Hj).
  apply in_seq in Hj.
  now rewrite <- Hjl, List_map_seq_length.
}
assert (Hira : mat_nrows A = mat_nrows M). {
  now subst A; cbn; rewrite List_map_seq_length.
}
assert (H1 : det A = 0%L). {
  apply (determinant_same_rows Hic Hop Hch Hii) with (p := i) (q := k). {
    easy.
  } {
    easy.
  } {
    now rewrite Hira.
  } {
    now rewrite Hira.
  }
  intros j; subst A; cbn.
  rewrite (List_map_nth' 0); [ | rewrite seq_length; flia Hir ].
  symmetry.
  rewrite (List_map_nth' 0); [ | rewrite seq_length; flia Hkr ].
  f_equal.
  apply map_ext_in.
  intros u Hu; apply in_seq in Hu.
  rewrite seq_nth; [ | flia Hkr ].
  rewrite seq_nth; [ | flia Hir ].
  rewrite Nat.add_comm, Nat.sub_add; [ | easy ].
  rewrite Nat.add_comm, Nat.sub_add; [ | easy ].
  cbn; rewrite Nat.eqb_refl.
  apply Nat.neq_sym, Nat.eqb_neq in Hik.
  now rewrite Hik.
}
rewrite (determinant_with_row Hop Hic) with (i := i) in H1; [ | easy | ]. 2: {
  now rewrite Hira.
}
rewrite <- H1 at 2.
rewrite Hira.
apply rngl_summation_eq_compat.
intros j Hj.
do 2 rewrite <- rngl_mul_assoc.
f_equal; f_equal. {
  rewrite HA; cbn.
  rewrite (List_map_nth' 0); [ | rewrite seq_length; flia Hir ].
  rewrite (List_map_nth' 0); [ | rewrite seq_length, Hc; flia Hj Hir ].
  rewrite seq_nth; [ | flia Hir ].
  rewrite seq_nth; [ | rewrite Hc; flia Hj Hir ].
  rewrite Nat.add_comm, Nat.sub_add; [ | easy ].
  rewrite Nat.add_comm, Nat.sub_add; [ | easy ].
  now rewrite Nat.eqb_refl.
}
(* oops... complicated from now! doing a lemma, perhaps? *)
unfold subm; cbn.
do 2 rewrite map_length.
do 2 rewrite butn_length.
do 2 rewrite fold_mat_nrows.
rewrite Hira.
f_equal; f_equal; f_equal.
rewrite HA; cbn.
destruct M as (ll); cbn in Hir, Hj |-*.
unfold mat_ncols; cbn.
remember (seq 1 (length (hd [] ll))) as x eqn:Hx.
rewrite List_seq_cut3 with (i := i); [ subst x | apply in_seq; flia Hir ].
rewrite Nat.sub_succ.
do 2 rewrite map_app; cbn.
rewrite Nat.eqb_refl.
erewrite map_ext_in. 2: {
  intros u Hu; apply in_seq in Hu.
  replace (u =? i) with false. 2: {
    symmetry; apply Nat.eqb_neq; flia Hu.
  }
  easy.
}
erewrite map_ext_in with (l := seq (S i) _). 2: {
  intros u Hu; apply in_seq in Hu.
  replace (u =? i) with false. 2: {
    symmetry; apply Nat.eqb_neq; flia Hu.
  }
  easy.
}
rewrite List_map_nth_seq with (la := ll) (d := []) at 1.
rewrite List_seq_cut3 with (i := i - 1); [ | apply in_seq; flia Hir ].
rewrite <- Nat.sub_succ_l; [ | easy ].
rewrite Nat_sub_succ_1, Nat.add_0_l, Nat.sub_0_r.
do 2 rewrite map_app.
do 3 rewrite butn_app.
do 2 rewrite List_map_seq_length.
rewrite Nat.ltb_irrefl.
rewrite Nat.sub_diag.
rewrite map_length.
replace (0 <? length [i - 1]) with true by easy.
rewrite <- map_butn.
rewrite app_nil_l.
remember (butn 0 _) as x; cbn in Heqx; subst x.
f_equal. {
  rewrite <- (seq_shift (i - 1)), map_map.
  apply map_ext_in.
  intros u Hu; apply in_seq in Hu.
  rewrite Nat_sub_succ_1.
  rewrite List_map_nth_seq with (d := 0%L) (la := nth u ll []).
  apply is_scm_mat_iff in Hsm.
  destruct Hsm as (Hcr, Hcl).
  cbn in Hcl.
  rewrite List_hd_nth_0.
  rewrite Hcl; [ | apply nth_In; flia Hu Hir ].
  rewrite Hcl; [ | apply nth_In; flia Hu Hir ].
  rewrite <- (seq_shift (length ll) 0), map_map.
  apply map_ext_in.
  intros v Hv; apply in_seq in Hv.
  rewrite Nat_sub_succ_1.
  rewrite List_map_nth_seq with (la := nth u ll []) (d := 0%L) at 1.
  f_equal; f_equal; f_equal.
  apply Hcl, nth_In; flia Hu Hir.
} {
  rewrite <- (seq_shift _ i), map_map.
  apply map_ext_in.
  intros u Hu; apply in_seq in Hu.
  rewrite Nat_sub_succ_1.
  rewrite List_map_nth_seq with (d := 0%L) (la := nth u ll []).
  apply is_scm_mat_iff in Hsm.
  destruct Hsm as (Hcr, Hcl).
  cbn in Hcl.
  rewrite List_hd_nth_0.
  rewrite Hcl; [ | apply nth_In; flia Hu ].
  rewrite Hcl; [ | apply nth_In; flia Hu ].
  rewrite <- (seq_shift _ 0), map_map.
  apply map_ext_in.
  intros v Hv; apply in_seq in Hv.
  rewrite Nat_sub_succ_1.
  rewrite List_map_nth_seq with (la := nth u ll []) (d := 0%L) at 1.
  f_equal; f_equal; f_equal.
  apply Hcl, nth_In; flia Hu.
}
Qed.

Theorem matrix_comatrix_transp_mul :
  rngl_has_opp = true →
  rngl_mul_is_comm = true →
  rngl_characteristic = 0 →
  (rngl_is_integral || rngl_has_inv_or_quot)%bool = true →
  ∀ (M : matrix T),
  is_square_matrix M = true
  → (M * (com M)⁺ = det M × mI (mat_nrows M))%M.
Proof.
intros Hop Hic Hch Hii * Hsm.
specialize (proj2 rngl_has_opp_or_subt_iff) as Hos.
specialize (Hos (or_introl Hop)).
move Hos before Hop.
destruct M as (ll); cbn - [ det ].
unfold "*"%M, "×"%M, mat_nrows; cbn - [ det ]; f_equal.
rewrite map_map.
rewrite <- (seq_shift (length ll)).
rewrite map_map.
apply map_ext_in.
intros i Hi; apply in_seq in Hi.
assert (Hll : 0 < length ll) by flia Hi.
rewrite laplace_formula_on_rows with (i := S i); try easy. 2: {
  cbn; flia Hi.
}
cbn - [ mat_el ].
rewrite mat_transp_ncols.
rewrite comatrix_nrows, comatrix_ncols.
unfold mat_ncols.
cbn - [ mat_el mat_nrows com ].
apply is_scm_mat_iff in Hsm.
destruct Hsm as (Hcr, Hcl).
cbn in Hcl.
rewrite Hcl; [ | now apply List_hd_in ].
apply Nat.neq_0_lt_0 in Hll.
apply Nat.eqb_neq in Hll; rewrite Hll.
apply Nat.eqb_neq in Hll.
apply Nat.neq_0_lt_0 in Hll.
rewrite map_map.
rewrite <- seq_shift, map_map.
apply map_ext_in.
intros j Hj; apply in_seq in Hj.
move j before i.
erewrite rngl_summation_eq_compat. 2: {
  intros k Hk.
  assert (Hkc : k - 1 < mat_ncols {| mat_list_list := ll |}). {
    unfold mat_ncols; cbn.
    rewrite Hcl; [ flia Hk Hll | ].
    now apply List_hd_in.
  }
  cbn - [ det ].
  rewrite Nat.sub_0_r.
  rewrite (List_map_nth' 0); [ | now rewrite seq_length ].
  rewrite (List_map_nth' 0); [ | now rewrite seq_length ].
  rewrite seq_nth; [ | easy ].
  rewrite seq_nth; [ | easy ].
  rewrite (Nat.add_comm 1 (k - 1)).
  rewrite Nat.sub_add; [ | easy ].
  rewrite rngl_mul_assoc.
  easy.
}
cbn - [ det ].
destruct (Nat.eq_dec i j) as [Hij| Hij]. {
  (* diagonal *)
  subst j; rewrite δ_diag, rngl_mul_1_r.
  unfold mat_mul_el.
  unfold mat_ncols.
  rewrite Hcl; [ | now apply List_hd_in ].
  apply rngl_summation_eq_compat.
  intros k Hk.
  unfold mat_el.
  rewrite Nat_sub_succ_1.
  rewrite <- rngl_mul_assoc; f_equal.
  cbn - [ det ].
  rewrite List_map_seq_length.
  rewrite (List_map_nth' 0). 2: {
    rewrite seq_length.
    unfold mat_ncols; cbn.
    rewrite (List_map_hd 0); [ | now rewrite seq_length ].
    rewrite List_map_seq_length.
    unfold mat_ncols.
    rewrite Hcl; [ flia Hk Hll | ].
    now apply List_hd_in.
  }
  rewrite (List_map_nth' 0); [ | now rewrite seq_length ].
  rewrite seq_nth. 2: {
    rewrite comatrix_ncols.
    unfold mat_ncols; cbn.
    rewrite Hcl; [ flia Hk Hll | ].
    now apply List_hd_in.
  }
  rewrite (List_map_nth' 0). 2: {
    rewrite seq_length, seq_nth; [ | easy ].
    now rewrite Nat.add_comm, Nat.add_sub.
  }
  rewrite Nat.add_comm, Nat.add_sub.
  rewrite (List_map_nth' 0). 2: {
    unfold mat_ncols.
    rewrite seq_length; cbn.
    rewrite Hcl; [ flia Hk Hll | ].
    now apply List_hd_in.
  }
  rewrite seq_nth. 2: {
    rewrite seq_nth; [ | easy ].
    now rewrite Nat.add_comm, Nat.add_sub.
  }
  rewrite seq_nth; [ | easy ].
  rewrite seq_nth. 2: {
    unfold mat_ncols; rewrite Hcl; [ flia Hk Hll | ].
    now apply List_hd_in.
  }
  rewrite (Nat.add_comm 1 i), Nat.add_sub.
  now rewrite (Nat.add_comm 1 (k - 1)), Nat.sub_add.
} {
  (* not on diagonal: zeroes *)
  rewrite δ_ndiag; [ | easy ].
  rewrite rngl_mul_0_r; [ | easy ].
  unfold mat_transp.
  unfold mat_mul_el.
  cbn - [ com ].
  erewrite rngl_summation_eq_compat. 2: {
    intros k Hk.
    unfold mat_ncols in Hk; cbn in Hk.
    rewrite Hcl in Hk; [ | now apply List_hd_in ].
    rewrite (List_map_nth' 0). 2: {
      rewrite seq_length, comatrix_ncols.
      unfold mat_ncols.
      rewrite Hcl; [ flia Hk Hi | ].
      now apply List_hd_in.
    }
    do 2 rewrite Nat.sub_0_r.
    rewrite (List_map_nth' 0). 2: {
      now rewrite comatrix_nrows, seq_length.
    }
    rewrite seq_nth; [ | now rewrite comatrix_nrows ].
    rewrite seq_nth. 2: {
      rewrite comatrix_ncols; unfold mat_ncols; cbn.
      rewrite Hcl; [ flia Hk Hi | now apply List_hd_in ].
    }
    cbn - [ com ].
    easy.
  }
  cbn - [ com ].
  unfold mat_ncols.
  rewrite Hcl; [ | now apply List_hd_in ].
  remember (mk_mat ll) as M eqn:HM.
  erewrite rngl_summation_eq_compat. 2: {
    intros k Hk.
    rewrite HM at 1.
    cbn - [ det ].
    do 2 rewrite Nat.sub_0_r.
    rewrite (List_map_nth' 0); [ | now rewrite seq_length ].
    rewrite (List_map_nth' 0). 2: {
      rewrite seq_length; unfold mat_ncols.
      rewrite Hcl; [ flia Hk Hll | ].
      now apply List_hd_in.
    }
    rewrite seq_nth; [ | easy ].
    rewrite seq_nth. 2: {
      unfold mat_ncols.
      rewrite Hcl; [ flia Hk Hll | ].
      now apply List_hd_in.
    }
    cbn - [ det ].
    rewrite rngl_mul_comm; [ | easy ].
    rewrite rngl_mul_mul_swap; [ | easy ].
    replace ll with (mat_list_list M) at 1 by now rewrite HM.
    rewrite fold_mat_el.
    rewrite <- HM.
    easy.
  }
  cbn - [ det ].
  replace (length ll) with (mat_nrows M) in Hi, Hj, Hcl |-* by now rewrite HM.
  apply Nat.neq_sym in Hij.
  erewrite rngl_summation_eq_compat. 2: {
    intros k Hk.
    rewrite <- Nat.sub_succ_l; [ | easy ].
    now rewrite Nat_sub_succ_1.
  }
  cbn - [ det ].
  specialize (determinant_with_bad_row Hop Hic Hch Hii) as H1.
  specialize (H1 (S j) (S i) M).
  apply H1; [ | flia Hj | flia Hi | flia Hij ].
  apply is_scm_mat_iff; cbn.
  split; [ easy | ].
  intros l Hl; rewrite HM in Hl; cbn in Hl.
  now apply Hcl.
}
Qed.

Theorem comatrix_transp_matrix_mul :
  rngl_has_opp = true →
  rngl_mul_is_comm = true →
  rngl_characteristic = 0 →
  (rngl_is_integral || rngl_has_inv_or_quot)%bool = true →
  ∀ (M : matrix T),
  is_square_matrix M = true
  → ((com M)⁺ * M = det M × mI (mat_nrows M))%M.
Proof.
intros Hop Hic Hch Hii * Hsm.
assert (H10 : rngl_characteristic ≠ 1) by now rewrite Hch.
specialize (proj2 rngl_has_opp_or_subt_iff) as Hos.
specialize (Hos (or_introl Hop)).
destruct M as (ll); cbn - [ det ].
destruct (Nat.eq_dec (length ll) 0) as [Hlz| Hlz]. {
  apply length_zero_iff_nil in Hlz; subst ll; cbn.
  unfold "*"%M, mI; cbn; symmetry.
  apply mat_mul_scal_1_l.
}
apply Nat.neq_0_lt_0 in Hlz.
destruct (Nat.eq_dec (length ll) 1) as [Hl1| Hl1]. {
  destruct ll as [| l]; [ easy | ].
  destruct ll; [ clear Hl1 | easy ].
  apply is_scm_mat_iff in Hsm.
  unfold mat_ncols in Hsm; cbn - [ In ] in Hsm.
  destruct Hsm as (_, Hcl).
  unfold "*"%M, "×"%M, mat_transp, mat_mul_el, com; cbn.
  rewrite Hcl; [ cbn | now left ].
  do 2 rewrite rngl_summation_only_one; cbn.
  do 2 rewrite rngl_mul_1_l.
  now do 2 rewrite rngl_mul_1_r.
}
unfold "*"%M, "×"%M, mat_nrows; cbn - [ det ]; f_equal.
rewrite map_map.
rewrite List_map_seq_length.
rewrite comatrix_ncols.
generalize Hsm; intros Hsm_v.
apply is_scm_mat_iff in Hsm.
cbn in Hsm.
destruct Hsm as (Hcr, Hcl).
unfold mat_ncols at 2.
rewrite Hcl; [ | now apply List_hd_in ].
rewrite <- (seq_shift (length ll)), map_map.
apply map_ext_in.
intros i Hi; apply in_seq in Hi.
unfold mat_ncols.
rewrite Hcl; [ | now apply List_hd_in ].
rewrite map_map.
rewrite <- seq_shift, map_map.
apply map_ext_in.
intros j Hj; apply in_seq in Hj.
move j before i.
rewrite laplace_formula_on_cols with (j := S j); try easy. 2: {
  rewrite squ_mat_ncols; [ cbn | easy ].
  flia Hj.
}
unfold mat_mul_el.
rewrite mat_transp_ncols.
rewrite comatrix_ncols.
unfold mat_ncols.
rewrite Hcl; [ | now apply List_hd_in ].
rewrite comatrix_nrows.
cbn - [ mat_el com ].
apply Nat.neq_0_lt_0 in Hlz.
apply Nat.eqb_neq in Hlz; rewrite Hlz.
apply Nat.eqb_neq, Nat.neq_0_lt_0 in Hlz.
destruct (Nat.eq_dec i j) as [Hij| Hij]. {
  (* diagonal *)
  subst j; rewrite δ_diag, rngl_mul_1_r.
  erewrite rngl_summation_eq_compat. 2: {
    intros k Hk.
    rewrite rngl_mul_comm; [ | easy ].
    easy.
  }
  cbn - [ mat_el com ].
  apply rngl_summation_eq_compat.
  intros k Hk.
  symmetry; f_equal; rewrite mat_transp_el; [ easy | | easy | flia Hk ].
  apply squ_mat_is_corr.
  now apply comatrix_is_square.
} {
  (* not on diagonal: zeroes *)
  rewrite δ_ndiag; [ | easy ].
  rewrite rngl_mul_0_r; [ | easy ].
  unfold mat_transp.
  cbn - [ com ].
  erewrite rngl_summation_eq_compat. 2: {
    intros k Hk.
    rewrite (List_map_nth' 0). 2: {
      rewrite seq_length, comatrix_ncols.
      unfold mat_ncols.
      rewrite Hcl; [ flia Hk Hi | ].
      now apply List_hd_in.
    }
    rewrite (List_map_nth' 0). 2: {
      rewrite seq_length, comatrix_nrows; cbn.
      flia Hk Hlz.
    }
    rewrite seq_nth; [ | rewrite comatrix_nrows; cbn; flia Hk Hlz ].
    rewrite seq_nth. 2: {
      rewrite comatrix_ncols; unfold mat_ncols; cbn.
      rewrite Hcl; [ flia Hk Hi | now apply List_hd_in ].
    }
    cbn - [ com ].
    easy.
  }
  cbn - [ com ].
  remember (mk_mat ll) as M eqn:HM.
  erewrite rngl_summation_eq_compat. 2: {
    intros k Hk.
    do 2 rewrite Nat.sub_0_r.
    rewrite <- Nat.sub_succ_l; [ | easy ].
    rewrite Nat_sub_succ_1.
    rewrite HM at 1.
    cbn - [ det ].
    rewrite Nat.sub_0_r.
    rewrite (List_map_nth' 0); [ | rewrite seq_length; flia Hk Hlz ].
    rewrite (List_map_nth' 0). 2: {
      rewrite seq_length; unfold mat_ncols.
      rewrite Hcl; [ easy | ].
      now apply List_hd_in.
    }
    rewrite seq_nth; [ | flia Hk Hlz ].
    rewrite (Nat.add_comm 1 (k - 1)), Nat.sub_add; [ | easy ].
    rewrite seq_nth. 2: {
      unfold mat_ncols.
      rewrite Hcl; [ easy | ].
      now apply List_hd_in.
    }
    cbn - [ det ].
    rewrite rngl_mul_mul_swap; [ | easy ].
    replace ll with (mat_list_list M) at 1 by now rewrite HM.
    rewrite fold_mat_el.
    rewrite <- HM.
    easy.
  }
  cbn - [ det ].
  replace (length ll) with (mat_nrows M) in Hi, Hj, Hcl |-* by now rewrite HM.
  destruct Hi as (_, Hi); cbn in Hi.
  destruct Hj as (_, Hj); cbn in Hj.
  (* perhaps all of this below would be a "determinant_with_bad_col":
     perhaps a cool lemma to do? *)
  specialize (determinant_with_bad_row Hop Hic Hch Hii) as H1.
  specialize (H1 (S i) (S j) (M⁺)%M).
  assert (Hsmt : is_square_matrix M⁺ = true). {
    now apply mat_transp_is_square.
  }
  specialize (H1 Hsmt).
  rewrite mat_transp_nrows in H1.
  rewrite squ_mat_ncols in H1; [ | easy ].
  assert (H : 1 ≤ S i ≤ mat_nrows M) by flia Hi.
  specialize (H1 H); clear H.
  assert (H : 1 ≤ S j ≤ mat_nrows M) by flia Hj.
  specialize (H1 H); clear H.
  assert (H : S i ≠ S j) by flia Hij.
  specialize (H1 H); clear H.
  erewrite rngl_summation_eq_compat in H1. 2: {
    intros k Hk.
    rewrite <- determinant_transpose; [ | easy | easy | easy | ]. 2: {
      apply is_squ_mat_subm. {
        rewrite mat_transp_nrows, squ_mat_ncols; [ | easy ].
        flia Hk Hi.
      } {
        rewrite mat_transp_nrows, squ_mat_ncols; [ | easy ].
        flia Hk Hi.
      }
      now apply mat_transp_is_square.
    }
    rewrite mat_subm_transp; cycle 1. {
      now apply mat_transp_is_square.
    } {
      rewrite mat_transp_ncols.
      assert (H : (mat_ncols M =? 0) = false). {
        rewrite squ_mat_ncols; [ | easy ].
        apply Nat.eqb_neq; flia Hi.
      }
      now rewrite H.
    } {
      rewrite mat_transp_nrows.
      split; [ flia | ].
      rewrite squ_mat_ncols; [ | easy ].
      flia Hi.
    }
    rewrite mat_transp_involutive. 2: {
      now apply squ_mat_is_corr.
    }
    rewrite mat_transp_el; [ | now apply squ_mat_is_corr | easy | flia Hk ].
    rewrite Nat.add_comm.
    easy.
  }
  cbn - [ det ] in H1.
  erewrite rngl_summation_eq_compat. 2: {
    intros k Hk.
    rewrite <- Nat.sub_succ_l; [ | easy ].
    now rewrite Nat_sub_succ_1.
  }
  easy.
}
Qed.

Definition mat_inv (M : matrix T) := ((det M)⁻¹ × (com M)⁺)%M.

Theorem mat_mul_inv_r : in_charac_0_field →
  ∀ (M : matrix T),
  is_square_matrix M = true
  → det M ≠ 0%L
  → (M * mat_inv M = mI (mat_nrows M))%M.
Proof.
intros Hif * Hsm Hdz.
destruct Hif as (Hic, Hop, Hin, Hit, Hde, Hch).
destruct (Nat.eq_dec (mat_nrows M) 0) as [Hrz| Hrz]. {
  rewrite Hrz; cbn.
  unfold mat_nrows in Hrz.
  apply length_zero_iff_nil in Hrz.
  now destruct M as (ll); cbn in Hrz; subst ll.
}
unfold mat_inv.
rewrite (mat_mul_mul_scal_l Hop Hic); cycle 1. {
  apply squ_mat_is_corr.
  apply mat_transp_is_square.
  now apply comatrix_is_square.
} {
  apply is_scm_mat_iff in Hsm.
  destruct Hsm as (Hcr, Hcl).
  now intros H; apply Hrz, Hcr.
} {
  rewrite mat_transp_nrows; symmetry.
  apply comatrix_ncols.
}
rewrite (matrix_comatrix_transp_mul Hop Hic Hch); [ | | easy ]. 2: {
  now apply Bool.orb_true_iff; left.
}
rewrite mat_mul_scal_l_mul_assoc.
rewrite rngl_mul_inv_l; [ | easy | easy ].
now apply mat_mul_scal_1_l.
Qed.

Theorem mat_mul_inv_l : in_charac_0_field →
  ∀ (M : matrix T),
  is_square_matrix M = true
  → det M ≠ 0%L
  → (mat_inv M * M = mI (mat_nrows M))%M.
Proof.
intros Hif * Hsm Hdz.
destruct Hif as (Hic, Hop, Hin, Hit, Hde, Hch).
unfold mat_inv.
rewrite mat_mul_scal_l_mul; [ | easy | ]. 2: {
  apply squ_mat_is_corr.
  apply mat_transp_is_square.
  now apply comatrix_is_square.
}
rewrite (comatrix_transp_matrix_mul Hop Hic Hch); [ | | easy ]. 2: {
  now apply Bool.orb_true_iff; left.
}
rewrite mat_mul_scal_l_mul_assoc.
rewrite rngl_mul_inv_l; [ | easy | easy ].
now apply mat_mul_scal_1_l.
Qed.

Notation "A ⁻¹" := (mat_inv A) (at level 1, format "A ⁻¹") : M_scope.

Theorem mat_inv_ncols : ∀ M,
  mat_ncols M⁻¹ = if mat_ncols M =? 0 then 0 else mat_nrows M.
Proof.
intros.
unfold mat_inv.
rewrite mat_mul_scal_l_ncols.
rewrite mat_transp_ncols.
now rewrite comatrix_ncols, comatrix_nrows.
Qed.

Theorem mat_inv_is_corr : ∀ M,
  is_correct_matrix M = true
  → is_correct_matrix M⁻¹ = true.
Proof.
intros * Hcm.
unfold mat_inv.
apply is_correct_matrix_mul_scal_l.
apply mat_transp_is_corr.
now apply comatrix_is_correct.
Qed.

Theorem mat_inv_det_comm : in_charac_0_field →
  ∀ M,
  is_square_matrix M = true
  → det M ≠ 0%L
  → (M⁻¹ = (1%L / det M) × (com M)⁺)%M.
Proof.
intros Hif * Hsm Hmz.
generalize Hif; intros H.
destruct H as (Hic, Hop, Hin, Hit, Hde, Hch).
specialize (matrix_comatrix_transp_mul Hop Hic Hch) as H1.
specialize (H1 (proj2 (Bool.orb_true_iff _ _) (or_introl Hit))).
specialize (H1 M Hsm).
specialize (mat_mul_inv_l Hif M Hsm Hmz) as H3.
apply (f_equal (mat_mul M⁻¹)) in H1.
destruct (Nat.eq_dec (mat_nrows M) 0) as [Hrz| Hrz]. {
  destruct M as (ll).
  cbn in Hrz.
  apply length_zero_iff_nil in Hrz; subst ll.
  cbn.
  unfold mat_transp, mat_inv, com; cbn.
  unfold mat_transp; cbn.
  rewrite rngl_inv_1; [ | easy | now rewrite Hch ].
  rewrite rngl_div_1_r; cycle 1. {
    now apply rngl_has_inv_or_quot_iff; left.
  } {
    now rewrite Hch.
  }
  easy.
}
assert (Hcz : mat_ncols M ≠ 0). {
  now rewrite (squ_mat_ncols _ Hsm).
}
rewrite mat_mul_assoc in H1; [ | easy | easy | easy | ]. 2: {
  rewrite mat_inv_ncols.
  rewrite if_eqb_eq_dec.
  now destruct (Nat.eq_dec _ _).
}
rewrite H3 in H1.
rewrite mat_mul_1_l in H1; [ | easy | | ]; cycle 1. {
  apply mat_transp_is_corr.
  apply comatrix_is_correct.
  now apply squ_mat_is_corr.
} {
  rewrite mat_transp_nrows.
  rewrite comatrix_ncols.
  symmetry; apply (squ_mat_ncols _ Hsm).
}
rewrite (mat_mul_mul_scal_l Hop Hic) in H1; cycle 1. {
  apply mI_is_correct_matrix.
} {
  rewrite mat_inv_ncols.
  rewrite if_eqb_eq_dec.
  now destruct (Nat.eq_dec _ _).
} {
  rewrite mat_inv_ncols.
  rewrite mI_nrows.
  rewrite if_eqb_eq_dec.
  now destruct (Nat.eq_dec _ _).
}
rewrite (mat_mul_1_r Hop) in H1; cycle 1. {
  apply mat_inv_is_corr.
  now apply squ_mat_is_corr.
} {
  rewrite mat_inv_ncols.
  rewrite if_eqb_eq_dec.
  now destruct (Nat.eq_dec _ _).
}
rewrite H1.
rewrite mat_mul_scal_l_mul_assoc.
rewrite rngl_div_1_l; [ | easy ].
rewrite rngl_mul_inv_l; [ | easy | easy ].
symmetry; apply mat_mul_scal_1_l.
Qed.

Theorem vect_el_mul_scal_l : ∀ μ V i,
  1 ≤ i ≤ vect_size V
  → vect_el (μ × V) i = (μ * vect_el V i)%L.
Proof.
intros * Hi; cbn.
apply (List_map_nth' 0%L).
rewrite fold_vect_size.
flia Hi.
Qed.

Theorem vect_size_mat_mul_vect_r : ∀ A V, vect_size (A • V) = mat_nrows A.
Proof.
intros; cbn.
now rewrite map_length.
Qed.

(*
Theorem firstn_map2 : ∀ A B C (f : A → B → C) la lb i,
  firstn i (map2 f la lb) = map2 f (firstn i la) (firstn i lb).
Proof.
intros.
revert i lb.
induction la as [| a]; intros; cbn. {
  now do 2 rewrite firstn_nil.
}
destruct lb as [| b]. {
  do 2 rewrite firstn_nil.
  now rewrite map2_nil_r.
}
destruct i; [ easy | cbn; f_equal ].
apply IHla.
Qed.
*)

Theorem butn_map2 : ∀ A B C (f : A → B → C) la lb i,
  butn i (map2 f la lb) = map2 f (butn i la) (butn i lb).
Proof.
intros.
revert i lb.
induction la as [| a]; intros; cbn. {
  now do 2 rewrite butn_nil.
}
destruct lb as [| b]. {
  do 2 rewrite butn_nil.
  now rewrite map2_nil_r.
}
destruct i; [ easy | cbn; f_equal ].
apply IHla.
Qed.

Theorem det_mat_repl_vect :
  rngl_has_opp = true →
  rngl_mul_is_comm = true →
  rngl_characteristic ≠ 1 →
  ∀ M V,
  is_square_matrix M = true
  → vect_size V = mat_nrows M
  → ∀ k, 1 ≤ k ≤ mat_ncols M
  → det (mat_repl_vect k M V) = vect_el ((com M)⁺ • V) k.
Proof.
intros Hop Hic H10 * Hsm Hvm * Hk.
specialize (squ_mat_is_corr _ Hsm) as Hcm.
move Hcm before Hsm.
assert (Hk' : k - 1 < mat_ncols M) by flia Hk.
rewrite laplace_formula_on_cols with (j := k); [ | easy | easy | easy | | ];
    cycle 1. {
  now apply mat_repl_vect_is_square.
} {
  rewrite <- (squ_mat_ncols _ Hsm) in Hvm.
  now rewrite mat_repl_vect_ncols.
}
rewrite mat_repl_vect_nrows; [ | easy ].
erewrite rngl_summation_eq_compat. 2: {
  intros j Hj.
  rewrite mat_el_repl_vect; [ | easy | now rewrite Hvm | easy | easy | easy ].
  now rewrite <- if_eqb_eq_dec, Nat.eqb_refl.
}
cbn - [ mat_el vect_el ].
unfold mat_mul_vect_r.
cbn - [ mat_el com ].
rewrite comatrix_ncols.
rewrite (List_map_nth' []); [ | now rewrite List_map_seq_length ].
unfold vect_dot_mul.
cbn - [ mat_el com ].
rewrite (List_map_nth' 0); [ | now rewrite seq_length ].
rewrite map2_map_l.
rewrite map2_map2_seq_l with (d := 0).
rewrite map2_map2_seq_r with (d := 0%L).
rewrite seq_length.
rewrite fold_vect_size, Hvm.
rewrite comatrix_nrows.
rewrite map2_diag.
rewrite rngl_summation_list_map.
rewrite rngl_summation_seq_summation. 2: {
  rewrite <- (squ_mat_ncols _ Hsm); flia Hk.
}
symmetry.
rewrite rngl_summation_rshift.
rewrite Nat.add_0_l.
rewrite <- Nat_succ_sub_succ_r. 2: {
  rewrite <- (squ_mat_ncols _ Hsm); flia Hk.
}
rewrite Nat.sub_0_r.
apply rngl_summation_eq_compat.
intros i Hi.
assert (Hi' : i - 1 < mat_nrows M) by flia Hi.
rewrite fold_vect_el.
rewrite <- Nat_succ_sub_succ_r; [ | flia Hi ].
rewrite Nat.sub_0_r.
rewrite rngl_mul_comm; [ | easy ].
f_equal.
unfold com.
cbn - [ det ].
rewrite seq_nth; [ | easy ].
rewrite Nat.add_comm, Nat.sub_add; [ | easy ].
rewrite (seq_nth _ _ Hi').
rewrite Nat.add_comm, Nat.sub_add; [ | easy ].
rewrite (List_map_nth' 0); [ | now rewrite seq_length ].
rewrite (seq_nth _ _ Hi').
rewrite (List_map_nth' 0); [ | now rewrite seq_length ].
rewrite (seq_nth _ _ Hk').
rewrite (List_map_nth' 0). 2: {
  rewrite seq_length, map2_length.
  rewrite fold_mat_nrows, fold_vect_size, Hvm.
  now rewrite Nat.min_id.
}
rewrite seq_nth. 2: {
  rewrite map2_length.
  rewrite fold_mat_nrows, fold_vect_size, Hvm.
  now rewrite Nat.min_id.
}
rewrite (List_map_nth' 0). 2: {
  rewrite seq_length, mat_repl_vect_ncols; [ easy | easy | ].
  now rewrite (squ_mat_ncols _ Hsm).
}
rewrite seq_nth. 2: {
  rewrite mat_repl_vect_ncols; [ easy | easy | ].
  now rewrite (squ_mat_ncols _ Hsm).
}
f_equal.
rewrite (Nat.add_comm _ (i - 1)), Nat.sub_add; [ | easy ].
rewrite (Nat.add_comm _ (k - 1)), Nat.sub_add; [ | easy ].
unfold mat_repl_vect.
unfold subm.
cbn - [ det ].
rewrite map_butn.
rewrite map_butn.
rewrite map_map2.
rewrite map2_map2_seq_l with (d := []).
rewrite map2_map2_seq_r with (d := 0%L).
rewrite fold_mat_nrows.
rewrite fold_vect_size.
rewrite Hvm.
rewrite map2_diag.
symmetry.
erewrite map_ext_in. 2: {
  intros j Hj.
  apply in_seq in Hj.
  unfold replace_at.
  rewrite butn_app.
  rewrite firstn_length.
  rewrite fold_corr_mat_ncols; [ | easy | easy ].
  rewrite min_l; [ | flia Hk ].
  rewrite Nat.ltb_irrefl.
  rewrite Nat.sub_diag.
  rewrite butn_0_cons.
  now rewrite fold_butn.
}
now rewrite <- List_map_map_seq.
Qed.

(* Cramer's rule *)

Theorem cramer's_rule_by_mul :
  rngl_has_opp = true →
  rngl_mul_is_comm = true →
  rngl_characteristic = 0 →
  (rngl_is_integral || rngl_has_inv_or_quot)%bool = true →
  ∀ (M : matrix T) (U V : vector T),
  is_square_matrix M = true
  → vect_size U = mat_nrows M
  → (M • U)%V = V
  → ∀ i, 1 ≤ i ≤ mat_nrows M →
  (det M * vect_el U i)%L = det (mat_repl_vect i M V).
Proof.
intros Hop Hic Hch Hii * Hsm Hum Hmuv k Hk.
assert (H10 : rngl_characteristic ≠ 1) by now rewrite Hch.
assert (Huv : vect_size V = vect_size U). {
  rewrite <- Hmuv; cbn.
  now rewrite map_length.
}
rewrite <- (squ_mat_ncols _ Hsm) in Hk.
rewrite (det_mat_repl_vect Hop Hic H10); [ | easy | congruence | easy ].
rewrite <- Hmuv.
rewrite (mat_vect_mul_assoc Hop); cycle 1. {
  apply mat_transp_is_corr.
  apply comatrix_is_correct.
  now apply squ_mat_is_corr.
} {
  now apply squ_mat_is_corr.
} {
  symmetry.
  rewrite mat_transp_ncols.
  rewrite comatrix_ncols.
  rewrite comatrix_nrows.
  rewrite squ_mat_ncols; [ | easy ].
  rewrite if_eqb_eq_dec.
  now destruct (Nat.eq_dec _ _).
} {
  rewrite squ_mat_ncols; [ congruence | easy ].
}
rewrite (comatrix_transp_matrix_mul Hop Hic Hch Hii); [ | easy ].
rewrite <- (mat_mul_scal_vect_assoc Hop); cycle 1. {
  apply mI_is_correct_matrix.
} {
  rewrite mI_ncols; congruence.
}
rewrite vect_el_mul_scal_l. 2: {
  split; [ easy | ].
  rewrite vect_size_mat_mul_vect_r.
  rewrite mI_nrows.
  now rewrite <- squ_mat_ncols.
}
f_equal.
now rewrite mat_vect_mul_1_l.
Qed.

Theorem cramer's_rule :
  rngl_has_opp = true →
  rngl_mul_is_comm = true →
  rngl_has_inv_or_quot = true →
  rngl_characteristic = 0 →
  ∀ (M : matrix T) (U V : vector T),
  is_square_matrix M = true
  → vect_size U = mat_nrows M
 → det M ≠ 0%L
  → (M • U)%V = V
  → ∀ i, 1 ≤ i ≤ mat_nrows M →
  vect_el U i = (det (mat_repl_vect i M V) / det M)%L.
Proof.
intros Hop Hic Hiq Hch * Hsm Hum Hmz Hmuv k Hk.
assert (Hii : (rngl_is_integral || rngl_has_inv_or_quot)%bool = true). {
  rewrite Hiq.
  now apply Bool.orb_true_iff; right.
}
rewrite <- (cramer's_rule_by_mul Hop Hic Hch Hii Hsm Hum Hmuv Hk).
rewrite (rngl_mul_comm Hic).
symmetry.
apply (rngl_mul_div Hiq _ _ Hmz).
Qed.

End a.

Arguments com {T}%type {ro} M%M.
Arguments cramer's_rule {T ro rp} Hop Hic Hiq Hch [M%M U%V V%V].
Arguments laplace_formula_on_cols {T ro rp} Hop Hic H10 M%M [j]%nat.
Arguments laplace_formula_on_rows {T}%type {ro rp} Hop Hic M%M [i]%nat.
Arguments mat_inv {T}%type {ro} M%M.
Arguments mat_mul_inv_r {T}%type {ro rp} Hof M%L.

Notation "A ⁻¹" := (mat_inv A) (at level 1, format "A ⁻¹") : M_scope.

(* tests
Require Import RnglAlg.Qrl.
Require Import RnglAlg.Rational.
Import Q.Notations.
Open Scope Q_scope.
Compute 3.
Compute (let M := mk_mat [[3;7;4;1];[0;6;2;7];[1;3;1;1];[18;3;2;1]] in (det M, mat_inv M)).
Compute (let M := mk_mat [[3;7;4;1];[0;6;2;7];[1;3;1;1];[18;3;2;1]] in (M * mat_inv M)%M).
Compute (let M := mk_mat [[3;7;4;1];[0;6;2;7];[1;3;1;1];[18;3;2;1]] in (mat_inv M * M)%M).
Compute (let M := mk_mat [[3;0;0;1];[0;0;2;7];[1;0;1;1];[18;0;2;1]] in (det M, com M)).
Compute (let M := mk_mat [[3;0;0;1];[0;0;2;7];[1;0;1;1];[18;0;2;1]] in (det M, (M * com M)%M, (com M * M)%M)).
*)


(********************************************************************)
(*                                                                  *)
(*  The Why3 Verification Platform   /   The Why3 Development Team  *)
(*  Copyright 2010-2018   --   Inria - CNRS - Paris-Sud University  *)
(*                                                                  *)
(*  This software is distributed under the terms of the GNU Lesser  *)
(*  General Public License version 2.1, with the special exception  *)
(*  on linking described in file LICENSE.                           *)
(*                                                                  *)
(********************************************************************)

(* This file is generated by Why3's Coq-realize driver *)
(* Beware! Only edit allowed sections below    *)
Require Import BuiltIn.
Require BuiltIn.
Require int.Int.

Section Exponentiation.

(* Why3 goal *)
Variable t : Type.
Hypothesis t_WhyType : WhyType t.
Existing Instance t_WhyType.

(* Why3 goal *)
Variable one: t.

(* Why3 goal *)
Variable infix_as: t -> t -> t.

(* Why3 goal *)
Hypothesis Assoc :
forall (x:t) (y:t) (z:t),
 ((infix_as (infix_as x y) z) = (infix_as x (infix_as y z))).

(* Why3 goal *)
Hypothesis Unit_def_l :
forall (x:t), ((infix_as one x) = x).

(* Why3 goal *)
Hypothesis Unit_def_r :
forall (x:t), ((infix_as x one) = x).

(* Why3 goal *)
Definition power: t -> Z -> t.
intros x n.
exact (iter_nat (Zabs_nat n) t (fun acc => infix_as x acc) one).
Defined.

(* Why3 goal *)
Lemma Power_0 :
forall (x:t), ((power x 0%Z) = one).
Proof.
easy.
Qed.

(* Why3 goal *)
Lemma Power_s :
forall (x:t) (n:Z),
 (0%Z <= n)%Z -> ((power x (n + 1%Z)%Z) = (infix_as x (power x n))).
Proof.
intros x n h1.
unfold power.
fold (Zsucc n).
now rewrite Zabs_nat_Zsucc.
Qed.

(* Why3 goal *)
Lemma Power_s_alt :
forall (x:t) (n:Z),
 (0%Z < n)%Z -> ((power x n) = (infix_as x (power x (n - 1%Z)%Z))).
Proof.
intros x n h1.
rewrite <- Power_s; auto with zarith.
f_equal; omega.
Qed.

(* Why3 goal *)
Lemma Power_1 :
forall (x:t), ((power x 1%Z) = x).
Proof.
exact Unit_def_r.
Qed.

(* Why3 goal *)
Lemma Power_sum :
forall (x:t) (n:Z) (m:Z),
 (0%Z <= n)%Z ->
 ((0%Z <= m)%Z -> ((power x (n + m)%Z) = (infix_as (power x n) (power x m)))).
Proof.
intros x n m Hn Hm.
revert n Hn.
apply natlike_ind.
apply sym_eq, Unit_def_l.
intros n Hn IHn.
replace (Zsucc n + m)%Z with ((n + m) + 1)%Z by ring.
rewrite Power_s by auto with zarith.
rewrite IHn.
now rewrite <- Assoc, <- Power_s.
Qed.

(* Why3 goal *)
Lemma Power_mult :
forall (x:t) (n:Z) (m:Z),
 (0%Z <= n)%Z ->
 ((0%Z <= m)%Z -> ((power x (n * m)%Z) = (power (power x n) m))).
Proof.
intros x n m Hn Hm.
revert m Hm.
apply natlike_ind.
now rewrite Zmult_0_r, 2!Power_0.
intros m Hm IHm.
replace (n * Zsucc m)%Z with (n + n * m)%Z by ring.
rewrite Power_sum by auto with zarith.
rewrite IHm.
now rewrite <- Power_s.
Qed.

(* Why3 goal *)
Lemma Power_comm1 :
forall (x:t) (y:t),
 ((infix_as x y) = (infix_as y x)) ->
 forall (n:Z),
  (0%Z <= n)%Z -> ((infix_as (power x n) y) = (infix_as y (power x n))).
Proof.
intros x y comm.
apply natlike_ind.
now rewrite Power_0, Unit_def_r, Unit_def_l.
intros n Hn IHn.
unfold Zsucc.
rewrite (Power_s _ _ Hn).
rewrite Assoc.
rewrite IHn.
rewrite <- Assoc.
rewrite <- Assoc.
now rewrite comm.
Qed.

(* Why3 goal *)
Lemma Power_comm2 :
forall (x:t) (y:t),
 ((infix_as x y) = (infix_as y x)) ->
 forall (n:Z),
  (0%Z <= n)%Z ->
  ((power (infix_as x y) n) = (infix_as (power x n) (power y n))).
Proof.
intros x y comm.
apply natlike_ind.
rewrite 3!Power_0.
now rewrite Unit_def_r.
intros n Hn IHn.
unfold Zsucc.
rewrite 3!(Power_s _ _ Hn).
rewrite IHn.
rewrite <- Assoc.
rewrite (Assoc x).
rewrite <- (Power_comm1 _ _ comm _ Hn).
now rewrite <- 2!Assoc.
Qed.

End Exponentiation.


From Test Require Import tactic.

Section FOFProblem.

Variable Universe : Set.
Variable UniverseElement : Universe.

Variable col_ : Universe -> Universe -> Universe -> Prop.
Variable betS_ : Universe -> Universe -> Universe -> Prop.

Variable defcollinear_1 : (forall A B C : Universe, (col_ A B C -> (A = B \/ (A = C \/ (B = C \/ (betS_ B A C \/ (betS_ A B C \/ betS_ A C B))))))).
Variable defcollinear2a_2 : (forall A B C : Universe, (A = B -> col_ A B C)).
Variable defcollinear2b_3 : (forall A B C : Universe, (A = C -> col_ A B C)).
Variable defcollinear2c_4 : (forall A B C : Universe, (B = C -> col_ A B C)).
Variable defcollinear2d_5 : (forall A B C : Universe, (betS_ B A C -> col_ A B C)).
Variable defcollinear2e_6 : (forall A B C : Universe, (betS_ A B C -> col_ A B C)).
Variable defcollinear2f_7 : (forall A B C : Universe, (betS_ A C B -> col_ A B C)).
Variable lemma_collinearorder_8 : (forall A B C : Universe, (col_ A B C -> (col_ B A C /\ (col_ B C A /\ (col_ C A B /\ (col_ A C B /\ col_ C B A)))))).
Variable lemma_3_5b_9 : (forall A B C D : Universe, ((betS_ A B D /\ betS_ B C D) -> betS_ A C D)).
Variable lemma_outerconnectivity_10 : (forall A B C D : Universe, ((betS_ A B C /\ (betS_ A B D /\ (~(betS_ B C D) /\ ~(betS_ B D C)))) -> C = D)).
Variable axiom_betweennesssymmetry_11 : (forall A B C : Universe, (betS_ A B C -> betS_ C B A)).
Variable lemma_3_7b_12 : (forall A B C D : Universe, ((betS_ A B C /\ betS_ B C D) -> betS_ A B D)).
Variable lemma_3_6b_13 : (forall A B C D : Universe, ((betS_ A B C /\ betS_ A C D) -> betS_ A B D)).
Variable lemma_3_7a_14 : (forall A B C D : Universe, ((betS_ A B C /\ betS_ B C D) -> betS_ A C D)).
Variable lemma_3_6a_15 : (forall A B C D : Universe, ((betS_ A B C /\ betS_ A C D) -> betS_ B C D)).
Variable axiom_connectivity_16 : (forall A B C D : Universe, ((betS_ A B D /\ (betS_ A C D /\ (~(betS_ A B C) /\ ~(betS_ A C B)))) -> B = C)).

Theorem lemma_collinear4_17 : (forall A B C D : Universe, ((col_ A B C /\ (col_ A B D /\ A <> B)) -> col_ B C D)).
Proof.
  time tac.
Qed.

End FOFProblem.


(*

If you have programs that don't terminate,

an _interpreter_ will not be able to prove all of its semantics.

Instead, we can use _transisition systems_.

*)

(********************** Begin: FRAP Preamble **********************)
Require Import Frap.

Set Implicit Arguments.

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

Inductive fact_state :=
| AnswerIs (answer : nat)
| WithAccumulator (input accumulator : nat).

Inductive fact_init (original_input : nat) : fact_state -> Prop :=
| FactInit : fact_init original_input (WithAccumulator original_input 1).

Inductive fact_final : fact_state -> Prop :=
| FactFinal : forall ans, fact_final (AnswerIs ans).

Inductive fact_step : fact_state -> fact_state -> Prop :=
| FactDone : forall acc,
  fact_step (WithAccumulator O acc) (AnswerIs acc)
| FactStep : forall n acc,
  fact_step (WithAccumulator (S n) acc) (WithAccumulator n (acc * S n)).

Inductive trc {A} (R : A -> A -> Prop) : A -> A -> Prop :=
| TrcRefl : forall x, trc R x x
| TrcFront : forall x y z,
  R x y
  -> trc R y z
  -> trc R x z.

Set Warnings "-notation-overridden".
Notation "R ^*" := (trc R) (at level 0).

Example factorial_3 : fact_step^* (WithAccumulator 3 1) (AnswerIs 6).
Proof.
Admitted.

Record trsys state := {
  Initial : state -> Prop;
  Step : state -> state -> Prop
}.

Definition factorial_sys (original_input : nat) : trsys fact_state := {|
  Initial := fact_init original_input;
  Step := fact_step
|}.

Inductive reachable {state} (sys : trsys state) (st : state) : Prop :=
| Reachable : forall st0,
  sys.(Initial) st0
  -> sys.(Step)^* st0 st
  -> reachable sys st.
(********************** End: FRAP Preamble **********************)

(*
Q: why is sys.(Initial) s necessary in `forall s, sys.(Initial) s` ?
A: look at its definition, this means `forall s that is an initial state of sys`
   so altogether, this is the statement:
   "forall initial states s of sys,
     forall states s' reachable from s,
      invariant holds for s'"
*)
Definition invariantFor {state} (sys : trsys state) (invariant : state -> Prop) :=
  forall s, sys.(Initial) s
            -> forall s', sys.(Step)^* s s'
                          -> invariant s'.

(********************** Begin: FRAP Preamble **********************)
Lemma use_invariant' : forall {state} (sys : trsys state)
  (invariant : state -> Prop) s s',
  invariantFor sys invariant
  -> sys.(Initial) s
  -> sys.(Step)^* s s'
  -> invariant s'.
Proof.
  unfold invariantFor.
  simplify.
  eapply H.
  eassumption.
  assumption.
Qed.

Theorem use_invariant : forall {state} (sys : trsys state)
  (invariant : state -> Prop) s,
  invariantFor sys invariant
  -> reachable sys s
  -> invariant s.
Proof.
  simplify.
  invert H0.
  eapply use_invariant'.
  eassumption.
  eassumption.
  assumption.
Qed.

Lemma invariant_induction' : forall {state} (sys : trsys state)
  (invariant : state -> Prop),
  (forall s, invariant s -> forall s', sys.(Step) s s' -> invariant s')
  -> forall s s', sys.(Step)^* s s'
     -> invariant s
     -> invariant s'.
Proof.
  induct 2; propositional.
  apply IHtrc.
  eapply H.
  eassumption.
  assumption.
Qed.

Theorem invariant_induction : forall {state} (sys : trsys state)
  (invariant : state -> Prop),
  (forall s, sys.(Initial) s -> invariant s)
  -> (forall s, invariant s -> forall s', sys.(Step) s s' -> invariant s')
  -> invariantFor sys invariant.
Proof.
  unfold invariantFor; intros.
  eapply invariant_induction'.
  eassumption.
  eassumption.
  apply H.
  assumption.
Qed.

Definition fact_invariant (original_input : nat) (st : fact_state) : Prop :=
  match st with
  | AnswerIs n => fact original_input = n
  | WithAccumulator n acc => fact original_input = acc * fact n
  end.
(********************** End: FRAP Preamble **********************)

(*
Invert is very similar to cases or destruct, but it is smarter
in that it can look backwards, looking at constraints in the type signature:

"s is Initial => s was made with fact_init => s looks like WithAccumulator"
*)
Theorem fact_invariant_ok : forall original_input,
  invariantFor (factorial_sys original_input) (fact_invariant original_input).
Proof.
  intros.
  apply invariant_induction; simplify.
  - invert H. simplify. auto.
  - invert H0; simplify; linear_arithmetic.
Qed.


(** Generated by coq-of-ocaml *)
Require Import OCaml.OCaml.

Local Set Primitive Projections.
Local Open Scope string_scope.
Local Open Scope Z_scope.
Local Open Scope type_scope.
Import ListNotations.

Unset Positivity Checking.
Unset Guard Checking.

Inductive nat : Set :=
| O : nat
| S : nat -> nat.

Inductive natural : Set :=
| Zero : natural
| Succ : natural -> natural.

Fixpoint plus (plus_arg0 : natural) (plus_arg1 : natural) {struct plus_arg0}
  : natural :=
  match plus_arg0 with
  | Zero => plus_arg1
  | Succ n => Succ (plus n plus_arg1)
  end.

Definition synth (lf2 : natural) (y : natural) : natural :=
  plus Zero (plus lf2 y).