(* Theorems of general usage, which could be (or not) in Coq library *)

Set Nested Proofs Allowed.
Set Implicit Arguments.

Require Import Utf8 Arith Psatz.
Import List List.ListNotations Init.Nat.
Arguments length {A}.

Global Hint Resolve Nat.le_0_l : core.
Global Hint Resolve Nat.lt_0_succ : core.
Global Hint Resolve Nat.lt_succ_diag_r : core.

(* "fast" lia, to improve compilation speed *)
Tactic Notation "flia" hyp_list(Hs) := clear - Hs; lia.

Notation "n !" := (fact n) (at level 1, format "n !").

Notation "x '∈' l" := (List.In x l) (at level 70).
Notation "x '∉' l" := (¬ List.In x l) (at level 70).
Notation "E ⊂ F" := (incl E F) (at level 70).

Notation "l .( i )" := (nth (i - 1) l 0) (at level 1, format "l .( i )").

Notation "x ≤ y ≤ z" := (x <= y ∧ y <= z)%nat (at level 70, y at next level) :
                          nat_scope.
Notation "x < y ≤ z" := (x < y ∧ y <= z)%nat (at level 70, y at next level) :
                          nat_scope.
Notation "x ≤ y < z" := (x ≤ y ∧ y < z)%nat (at level 70, y at next level) :
                          nat_scope.
Notation "x < y < z" := (x < y ∧ y < z)%nat (at level 70, y at next level).

Notation "∃! x .. y , p" :=
  (ex (unique (λ x, .. (ex (unique (λ y, p))) ..)))
    (at level 200, x binder, right associativity)
  : type_scope.

Notation "x ≠? y" := (negb (Nat.eqb x y)) (at level 70) : nat_scope.

Theorem Tauto_match_nat_same : ∀ A a (b : A),
  match a with 0 => b | S _ => b end = b.
Proof. now intros; destruct a. Qed.

Theorem eq_list_eq : ∀ A d (la lb : list A),
  length la = length lb
  → (∀ i, i < length la → nth i la d = nth i lb d)
  → la = lb.
Proof.
intros * Hlab Hab.
revert lb Hlab Hab.
induction la as [| a]; intros. {
  now symmetry in Hlab; apply length_zero_iff_nil in Hlab.
}
destruct lb as [| b]; [ easy | ].
cbn in Hlab; apply Nat.succ_inj in Hlab.
f_equal; [ now specialize (Hab 0 (Nat.lt_0_succ _)) | ].
apply (IHla _ Hlab).
intros i Hi.
apply (Hab (S i)); cbn.
now apply Nat.succ_lt_mono in Hi.
Qed.

Theorem List_fold_left_map :
  ∀ A B C (f : A → B → A) (g : C → B) (l : list C) a,
  fold_left f (map g l) a = fold_left (λ c b, f c (g b)) l a.
Proof.
intros.
revert a.
induction l as [| c]; intros; [ easy | apply IHl ].
Qed.

Definition AllLt l u := ∀ i, i ∈ l → i < u.

(* iterations in a list
   in order to later define syntaxes : Max, Σ, Π, ...
   e.g. "Σ (i ∈ l), f i", "Π (i ∈ l), f i", ... *)

Definition iter_list {A B} (l : list B) f (d : A) := fold_left f l d.

(* iterations in indexed sequences
   in order to later define syntaxes : Max, Σ, Π, ...
   e.g. "Σ (i = b, e), f i", "Π (i = b, e), f i" *)

Definition iter_seq {T} b e f (d : T) := iter_list (seq b (S e - b)) f d.

Arguments iter_seq : simpl never.
Arguments iter_list : simpl never.

(* maximum of several values *)

Notation "'Max' ( i = b , e ) , g" :=
  (iter_seq b e (λ c i, max c (g)) 0)
  (at level 45, i at level 0, b at level 60, e at level 60) : nat_scope.

Notation "'Max' ( i ∈ l ) , g" :=
  (iter_list l (λ c i, max c (g)) 0)
  (at level 45, i at level 0, l at level 60) : nat_scope.

Theorem fold_iter_list : ∀ {A B} (f : A → B → A) l d,
  fold_left f l d = iter_list l f d.
Proof. easy. Qed.

Theorem fold_iter_seq : ∀ A b e f (d : A),
  iter_list (seq b (S e - b)) f d = iter_seq b e f d.
Proof. easy. Qed.

Theorem fold_iter_seq' : ∀ A b len f (d : A),
  iter_list (seq b len) f d =
    if b + len =? 0 then d
    else iter_seq b (b + len - 1) f d.
Proof.
intros.
unfold iter_seq.
f_equal; f_equal.
remember (b + len =? 0) as x eqn:Hx; symmetry in Hx.
destruct x. {
  apply Nat.eqb_eq in Hx.
  now apply Nat.eq_add_0 in Hx; destruct Hx; subst b len.
}
apply Nat.eqb_neq in Hx.
destruct len. {
  rewrite Nat.add_0_r in Hx.
  destruct b; [ easy | cbn ].
  now rewrite Nat.add_sub, Nat.sub_diag.
}
rewrite Nat.sub_succ_l; [ cbn | flia ].
f_equal; f_equal; f_equal.
flia.
Qed.

Theorem List_seq_shift' : ∀ i sta len,
  map (Nat.add i) (seq sta len) = seq (i + sta) len.
Proof.
intros.
revert i sta.
induction len; intros; [ easy | cbn ].
f_equal.
rewrite IHlen.
now rewrite <- Nat.add_succ_comm.
Qed.

Theorem List_seq_cut : ∀ i sta len,
  i ∈ seq sta len
  → seq sta len = seq sta (i - sta) ++ seq i (sta + len - i).
Proof.
intros * His.
apply in_seq in His.
replace len with (i - sta + (len - (i - sta))) at 1 by flia His.
rewrite seq_app.
f_equal.
replace (sta + (i - sta)) with i by flia His.
f_equal.
flia His.
Qed.

Theorem List_seq_cut3 : ∀ i sta len,
  i ∈ seq sta len
  → seq sta len = seq sta (i - sta) ++ [i] ++ seq (S i) (sta + len - S i).
Proof.
intros * His.
apply in_seq in His.
replace len with (i - sta + (len - (i - sta))) at 1 by flia His.
rewrite seq_app.
f_equal.
replace (sta + (i - sta)) with i by flia His.
replace (len - (i - sta)) with (1 + (sta + len - S i)) by flia His.
rewrite seq_app; cbn.
now rewrite Nat.add_1_r.
Qed.

Theorem iter_shift : ∀ {T} s b k f (d : T),
  s ≤ b ≤ k
  → iter_seq b k f d =
    iter_seq (b - s) (k - s) (λ c i, f c (s + i)) d.
Proof.
intros * (Hsb, Hbk).
unfold iter_seq, iter_list.
replace (S (k - s) - (b - s)) with (S (k - b)) by flia Hsb Hbk.
rewrite <- Nat.sub_succ_l; [ | easy ].
remember (S k - b)%nat as len; clear Heqlen.
clear k Hbk.
revert b d Hsb.
induction len; intros; [ easy | ].
rewrite seq_S; symmetry.
rewrite seq_S; symmetry.
do 2 rewrite fold_left_app; cbn.
rewrite IHlen; [ | easy ].
now replace (s + (b - s + len)) with (b + len) by flia Hsb.
Qed.

Theorem fold_right_max_ge : ∀ m l, m ≤ fold_right max m l.
Proof.
intros.
induction l as [| a]; [ easy | cbn ].
etransitivity; [ apply IHl | ].
apply Nat.le_max_r.
Qed.

(* conversions if ...? into if ..._dec *)

Theorem if_bool_if_dec : ∀ A (b : bool) (x y : A),
  (if b then x else y) =
  if Sumbool.sumbool_of_bool b then x else y.
Proof.
intros.
now destruct (Sumbool.sumbool_of_bool b); subst b.
Qed.

Theorem if_eqb_eq_dec : ∀ A i j (a b : A),
  (if i =? j then a else b) = (if Nat.eq_dec i j then a else b).
Proof.
intros.
destruct (Nat.eq_dec i j) as [H1| H1]. {
  now apply Nat.eqb_eq in H1; rewrite H1.
}
now apply Nat.eqb_neq in H1; rewrite H1.
Qed.

Theorem if_ltb_lt_dec : ∀ A i j (a b : A),
  (if i <? j then a else b) = (if lt_dec i j then a else b).
Proof.
intros.
destruct (lt_dec i j) as [H1| H1]. {
  now apply Nat.ltb_lt in H1; rewrite H1.
}
now apply Nat.ltb_nlt in H1; rewrite H1.
Qed.

Theorem if_leb_le_dec : ∀ A i j (a b : A),
  (if i <=? j then a else b) = (if le_dec i j then a else b).
Proof.
intros.
destruct (le_dec i j) as [H1| H1]. {
  now apply Nat.leb_le in H1; rewrite H1.
}
now apply Nat.leb_nle in H1; rewrite H1.
Qed.

(* *)

Theorem Nat_leb_add_mono_l : ∀ a b c, (a + b <=? a + c) = (b <=? c).
Proof.
intros.
remember (b <=? c) as x eqn:Hx; symmetry in Hx.
destruct x. {
  apply Nat.leb_le in Hx.
  now apply Nat.leb_le, Nat.add_le_mono_l.
}
apply Nat.leb_gt in Hx.
apply Nat.leb_gt.
now apply Nat.add_lt_mono_l.
Qed.

Theorem Nat_sub_sub_swap : ∀ a b c, a - b - c = a - c - b.
Proof.
intros.
rewrite <- Nat.sub_add_distr.
rewrite Nat.add_comm.
now rewrite Nat.sub_add_distr.
Qed.

Theorem Nat_sub_sub_distr : ∀ n m p, p ≤ m → n - (m - p) = n + p - m.
Proof.
intros n m p Hpm.
rewrite Nat.add_comm.
revert n m Hpm.
induction p; intros. {
  now rewrite Nat.sub_0_r, Nat.add_0_l.
}
destruct m as [| m]. {
  exfalso; revert Hpm; apply Nat.nle_succ_0.
}
rewrite Nat.sub_succ; cbn.
apply Nat.succ_le_mono in Hpm.
now apply IHp.
Qed.

Theorem Nat_sub_succ_1 : ∀ n, S n - 1 = n.
Proof. now intros; rewrite Nat.sub_succ, Nat.sub_0_r. Qed.

Theorem Nat_succ_sub_succ_r : ∀ a b, b < a → a - b = S (a - S b).
Proof. intros * Hba; flia Hba. Qed.

Theorem Nat_1_le_sub_lt : ∀ i j, 1 ≤ i ≤ j → i - 1 < j.
Proof.
intros * Hij.
destruct i; [ easy | ].
rewrite Nat_sub_succ_1.
apply Hij.
Qed.

Theorem Nat_mod_add_l_mul_r : ∀ a b c,
  b ≠ 0 → (c * b + a) mod b = a mod b.
Proof.
intros * Hbz.
rewrite Nat.add_comm.
now apply Nat.mod_add.
Qed.

Theorem Nat_lt_lt_add_mul : ∀ a b c n, a < b → c < n → c + n * a < n * b.
Proof.
intros * Hab Hcn.
revert a b c Hab Hcn.
induction n; intros; [ easy | cbn ].
destruct c. {
  cbn.
  apply Nat.add_lt_le_mono; [ easy | ].
  now apply Nat.mul_le_mono_l, Nat.lt_le_incl.
}
apply Nat.succ_lt_mono in Hcn.
specialize (IHn a b c Hab Hcn).
rewrite Nat.add_assoc, Nat.add_shuffle0, Nat.add_comm.
apply Nat.add_lt_le_mono; [ easy | ].
apply IHn.
Qed.

Theorem Nat_fact_succ : ∀ n, fact (S n) = S n * fact n.
Proof. easy. Qed.

Notation "a ≡ b 'mod' c" := (a mod c = b mod c) (at level 70, b at level 36).
Notation "a ≢ b 'mod' c" := (a mod c ≠ b mod c) (at level 70, b at level 36).

Theorem List_hd_nth_0 {A} : ∀ l (d : A), hd d l = nth 0 l d.
Proof. intros; now destruct l. Qed.

Theorem List_hd_in : ∀ A (l : list A) d, 0 < length l → hd d l ∈ l.
Proof.
intros.
rewrite List_hd_nth_0.
now apply nth_In.
Qed.

Theorem List_map_fun : ∀ A B d l l' (f g : A → B),
  length l = length l'
  → (∀ i, i < length l → f (nth i l d) = g (nth i l' d))
  → map f l = map g l'.
Proof.
intros * Hlen Hf.
revert l' Hlen Hf.
induction l as [| a l]; intros; [ now destruct l' | ].
destruct l' as [| a' l']; [ easy | cbn ].
specialize (Hf 0 (Nat.lt_0_succ _)) as H1; cbn in H1.
rewrite H1; f_equal.
cbn in Hlen; apply Nat.succ_inj in Hlen.
apply IHl; [ easy | ].
intros i Hi.
apply Hf with (i := S i); cbn.
now apply -> Nat.succ_lt_mono.
Qed.

Theorem List_nth_nil : ∀ A i (d : A), nth i [] d = d.
Proof. now intros; destruct i. Qed.

Theorem List_nth_0_cons : ∀ A (a : A) la d, nth 0 (a :: la) d = a.
Proof. easy. Qed.

Theorem List_nth_succ_cons : ∀ A (a : A) la i, nth (S i) (a :: la) = nth i la.
Proof. easy. Qed.

Theorem List_map_nth' : ∀ A B a b (f : A → B) l n,
  n < length l → nth n (map f l) b = f (nth n l a).
Proof.
intros * Hnl.
revert n Hnl.
induction l as [| c l]; intros; [ easy | ].
cbn in Hnl; cbn.
destruct n; [ easy | ].
apply Nat.succ_lt_mono in Hnl.
now apply IHl.
Qed.

Theorem List_map_hd : ∀ A B a b (f : A → B) l,
  0 < length l → hd b (map f l) = f (hd a l).
Proof.
intros.
do 2 rewrite List_hd_nth_0.
now apply List_map_nth'.
Qed.

Theorem List_map_tl : ∀ A B (f : A → B) l,
  tl (map f l) = map f (tl l).
Proof. now intros; destruct l. Qed.

Theorem List_app_cons : ∀ A la lb (b : A), la ++ b :: lb = la ++ [b] ++ lb.
Proof. easy. Qed.

Theorem List_app_hd1 : ∀ A (l l' : list A) d,
  0 < length l → hd d (l ++ l') = hd d l.
Proof.
intros.
do 2 rewrite List_hd_nth_0.
now apply app_nth1.
Qed.

Theorem List_app_hd2 : ∀ A (l l' : list A) d,
  length l = 0 → hd d (l ++ l') = hd d l'.
Proof.
intros.
do 2 rewrite List_hd_nth_0.
rewrite app_nth2; [ easy | ].
now apply Nat.le_0_r.
Qed.

Theorem List_seq_eq_nil : ∀ b len, seq b len = [] → len = 0.
Proof.
intros * Hb.
now induction len.
Qed.

Theorem List_seq_hd : ∀ len start d, 0 < len → hd d (seq start len) = start.
Proof.
intros.
rewrite List_hd_nth_0.
rewrite seq_nth; [ | easy ].
apply Nat.add_0_r.
Qed.

Theorem List_filter_nil_iff {A} : ∀ f (l : list A),
  filter f l = [] ↔ (∀ a, a ∈ l → f a = false).
Proof.
intros.
split. {
  intros Hf a Ha.
  induction l as [| b l]; [ easy | ].
  cbn in Hf.
  remember (f b) as c eqn:Hc; symmetry in Hc.
  destruct c; [ easy | ].
  destruct Ha as [Ha| Ha]; [ now subst b | ].
  now apply IHl.
} {
  intros Hf.
  induction l as [| a]; [ easy | cbn ].
  rewrite Hf; [ | now left ].
  apply IHl.
  intros b Hb.
  now apply Hf; right.
}
Qed.

Theorem List_cons_length : ∀ A (a : A) la, length (a :: la) = S (length la).
Proof. easy. Qed.

Theorem List_cons_is_app : ∀ A (a : A) la, a :: la = [a] ++ la.
Proof. easy. Qed.

(* map2: map with two lists *)

Fixpoint map2 {A B C} (f : A → B → C) la lb :=
  match la with
  | [] => []
  | a :: la' =>
      match lb with
      | [] => []
      | b :: lb' => f a b :: map2 f la' lb'
      end
  end.

Theorem map2_nth : ∀ A B C (f : A → B → C) la lb a b c n,
  n < length la
  → n < length lb
  → nth n (map2 f la lb) c = f (nth n la a) (nth n lb b).
Proof.
intros * Hla Hlb.
revert n lb Hla Hlb.
induction la as [| a']; intros; [ easy | cbn ].
destruct lb as [| b']; [ easy | cbn ].
destruct n; [ easy | cbn ].
cbn in Hla, Hlb.
apply Nat.succ_lt_mono in Hla.
apply Nat.succ_lt_mono in Hlb.
destruct n; [ now apply IHla | ].
now apply IHla.
Qed.

Theorem map2_map_l : ∀ A B C D (f : C → B → D) g (la : list A) (lb : list B),
  map2 f (map g la) lb = map2 (λ a b, f (g a) b) la lb.
Proof.
intros.
revert lb.
induction la as [| a]; intros; [ easy | cbn ].
destruct lb as [| b]; [ easy | cbn ].
f_equal.
apply IHla.
Qed.

Theorem map2_map_r : ∀ A B C D (f : A → C → D) g (la : list A) (lb : list B),
  map2 f la (map g lb) = map2 (λ a b, f a (g b)) la lb.
Proof.
intros.
revert lb.
induction la as [| a]; intros; [ easy | cbn ].
destruct lb as [| b]; [ easy | cbn ].
f_equal.
apply IHla.
Qed.

Theorem map_map2 : ∀ A B C D (f : A → B) (g : C → D → A) la lb,
  map f (map2 g la lb) = map2 (λ a b, f (g a b)) la lb.
Proof.
intros.
revert lb.
induction la as [| a]; intros; [ easy | cbn ].
destruct lb as [| b]; [ easy | cbn ].
now rewrite IHla.
Qed.

Theorem List_fold_left_map2 :
  ∀ A B C D (f : A → B → A) (g : C → D → B) lc ld (a : A),
  fold_left f (map2 g lc ld) a =
  fold_left (λ b c, f b (g (fst c) (snd c))) (combine lc ld) a.
Proof.
intros.
revert ld a.
induction lc as [| c]; intros; [ easy | cbn ].
destruct ld as [| d]; [ easy | cbn ].
apply IHlc.
Qed.

Theorem map2_length : ∀ A B C (f : A → B → C) la lb,
  length (map2 f la lb) = min (length la) (length lb).
Proof.
intros.
revert lb.
induction la as [| a]; intros; [ easy | cbn ].
destruct lb as [| b]; [ easy | cbn ].
now rewrite IHla.
Qed.

Theorem map2_nil_l : ∀ A B C (f : A → B → C) la, map2 f [] la = [].
Proof.
intros.
now destruct la.
Qed.

Theorem map2_nil_r : ∀ A B C (f : A → B → C) la, map2 f la [] = [].
Proof.
intros.
now destruct la.
Qed.

Theorem in_map2_iff : ∀ A B C (f : A → B → C) la lb c,
  c ∈ map2 f la lb ↔
  ∃ i,
  i < min (length la) (length lb) ∧ ∃ a b, f (nth i la a) (nth i lb b) = c.
Proof.
intros.
split. {
  intros Hc.
  revert lb Hc.
  induction la as [| a]; intros; [ easy | ].
  destruct lb as [| b]; [ easy | ].
  cbn in Hc.
  destruct Hc as [Hc| Hc]. {
    exists 0.
    split; [ cbn; flia | now exists a, b ].
  }
  specialize (IHla _ Hc) as H1.
  destruct H1 as (i & Him & a' & b' & Hi).
  exists (S i).
  split; [ cbn; flia Him | ].
  now exists a', b'.
} {
  intros (i & Him & a' & b' & Hi).
  revert lb i Him Hi.
  induction la as [| a]; intros; [ easy | ].
  destruct lb as [| b]; [ easy | ].
  cbn in Him, Hi |-*.
  destruct i; [ now left | right ].
  apply Nat.succ_lt_mono in Him.
  now apply IHla in Hi.
}
Qed.

Theorem map2_ext_in : ∀ A B C (f g : A → B → C) la lb,
  (∀ a b, a ∈ la → b ∈ lb → f a b = g a b) → map2 f la lb = map2 g la lb.
Proof.
intros * Hab.
revert lb Hab.
induction la as [| a]; intros; [ easy | cbn ].
destruct lb as [| b]; [ easy | ].
f_equal; [ now apply Hab; left | ].
apply IHla.
intros a' b' Ha' Hb'.
now apply Hab; right.
Qed.

Theorem map2_diag : ∀ A B (f : A → A → B) la,
  map2 f la la = map (λ i, f i i) la.
Proof.
intros.
induction la as [| a]; [ easy | cbn ].
now rewrite IHla.
Qed.

Theorem map2_map2_seq_l : ∀ A B C (f : A → B → C) d la lb,
  map2 f la lb = map2 (λ i b, f (nth i la d) b) (seq 0 (length la)) lb.
Proof.
intros.
revert lb.
induction la as [| a]; intros; [ easy | cbn ].
destruct lb as [| b]; [ easy | ].
f_equal.
rewrite <- seq_shift.
rewrite map2_map_l.
apply IHla.
Qed.

Theorem map2_map2_seq_r : ∀ A B C (f : A → B → C) d la lb,
  map2 f la lb = map2 (λ a i, f a (nth i lb d)) la (seq 0 (length lb)).
Proof.
intros.
revert lb.
induction la as [| a]; intros; [ easy | cbn ].
destruct lb as [| b]; [ easy | cbn ].
f_equal.
rewrite <- seq_shift.
rewrite map2_map_r.
apply IHla.
Qed.

Theorem map2_app_l : ∀ A B C l1 l2 l (f : A → B → C),
  map2 f (l1 ++ l2) l =
  map2 f l1 (firstn (length l1) l) ++ map2 f l2 (skipn (length l1) l).
Proof.
intros.
revert l2 l.
induction l1 as [| a1]; intros; [ easy | cbn ].
destruct l as [| a]; [ now rewrite map2_nil_r | cbn ].
f_equal.
apply IHl1.
Qed.

Theorem map2_app_r :
  ∀ (A B C : Type) (l1 l2 : list B) (l : list A) (f : A → B → C),
    map2 f l (l1 ++ l2) =
    map2 f (firstn (length l1) l) l1 ++ map2 f (skipn (length l1) l) l2.
Proof.
intros.
revert l2 l.
induction l1 as [| a1]; intros; [ easy | cbn ].
destruct l as [| a]; [ now rewrite map2_nil_l | cbn ].
f_equal.
apply IHl1.
Qed.

Theorem map2_swap : ∀ A B C (f : A → B → C) la lb,
  map2 f la lb = map2 (λ a b, f b a) lb la.
Proof.
intros.
revert lb.
induction la as [| a]; intros; cbn; [ symmetry; apply map2_nil_r | ].
destruct lb as [| b]; [ easy | cbn ].
f_equal.
apply IHla.
Qed.

Theorem repeat_app_map2 : ∀ A (la lb : list A) n,
  repeat (la ++ lb) n = map2 (λ x y, app x y) (repeat la n) (repeat lb n).
Proof.
intros.
induction n; [ easy | cbn ].
f_equal; apply IHn.
Qed.

Theorem map2_rev_seq_r : ∀ A B (f : A → _ → B) la sta len,
  map2 f la (rev (seq sta len)) =
  map2 (λ a i, f a (2 * sta + len - 1 - i)) la (seq sta len).
Proof.
intros.
rewrite map2_swap; symmetry.
rewrite map2_swap; symmetry.
revert la sta.
induction len; intros; [ easy | ].
replace (2 * sta + S len - 1) with (2 * sta + len) by flia.
rewrite seq_S at 1.
cbn - [ map2 ].
rewrite Nat.add_0_r.
rewrite rev_app_distr.
cbn - [ map2 ].
cbn.
destruct la as [| a]; [ easy | ].
rewrite Nat.add_shuffle0, Nat.add_sub; f_equal.
rewrite IHlen.
rewrite <- seq_shift.
rewrite map2_map_l.
apply map2_ext_in.
intros; f_equal; flia.
Qed.

(* end map2 *)

(* rank: rank of the first element satisfying a predicate *)
(* like "find" but returning the rank, not the element itself *)

Fixpoint List_rank_loop i A (f : A → bool) (l : list A) : nat :=
  match l with
  | [] => i
  | x :: tl => if f x then i else List_rank_loop (S i) f tl
end.

Definition List_rank := List_rank_loop 0.

Theorem List_rank_loop_interv : ∀ A f (l : list A) i,
  i ≤ List_rank_loop i f l ≤ i + length l.
Proof.
intros.
revert i.
induction l as [| a]; intros; cbn; [ now rewrite Nat.add_0_r | ].
destruct (f a). {
  split; [ easy | ].
  apply Nat.le_add_r.
}
specialize (IHl (S i)).
rewrite Nat.add_succ_comm in IHl.
split; [ flia IHl | easy ].
Qed.

Theorem List_rank_loop_if : ∀ A d f (l : list A) i j,
  List_rank_loop i f l = j
  → (∀ k, i ≤ k < j → f (nth (k - i) l d) = false) ∧
    (j < i + length l ∧ f (nth (j - i) l d) = true ∨
     j = i + length l).
Proof.
intros * Hi.
split. {
  intros p Hp.
  remember (p - i) as k eqn:Hk.
  replace p with (i + k) in Hp by flia Hp Hk.
  destruct Hp as (_, Hp).
  clear p Hk.
  revert i l Hi Hp.
  induction k; intros. {
    rewrite Nat.add_0_r in Hp.
    destruct l as [| a]. {
      now subst j; apply Nat.lt_irrefl in Hp.
    }
    cbn in Hi |-*.
    destruct (f a); [ | easy ].
    now subst j; apply Nat.lt_irrefl in Hp.
  }
  destruct l as [| a]; [ subst j; cbn in Hp; flia Hp | ].
  cbn in Hi |-*.
  rewrite <- Nat.add_succ_comm in Hp.
  remember (f a) as b eqn:Hb; symmetry in Hb.
  destruct b; [ subst j; flia Hp | ].
  now apply IHk with (i := S i).
}
remember (j - i) as k eqn:Hk.
replace j with (i + k) in Hi |-*. 2: {
  specialize (List_rank_loop_interv f l i) as H1.
  rewrite Hi in H1.
  flia Hk H1.
}
clear j Hk.
revert i l Hi.
induction k; intros. {
  rewrite Nat.add_0_r in Hi |-*.
  destruct l; [ now right; symmetry; apply Nat.add_0_r | ].
  left; cbn in Hi |-*.
  split; [ flia | ].
  destruct (f a); [ easy | ].
  specialize (List_rank_loop_interv f l (S i)) as H1.
  rewrite Hi in H1; flia H1.
}
destruct l; cbn in Hi; [ flia Hi | ].
destruct (f a); [ flia Hi | cbn in Hi ].
rewrite <- Nat.add_succ_comm in Hi.
apply IHk in Hi; cbn.
now do 2 rewrite <- Nat.add_succ_comm.
Qed.

Theorem List_rank_if : ∀ A d f (l : list A) i,
  List_rank f l = i
  → (∀ j, j < i → f (nth j l d) = false) ∧
    (i < length l ∧ f (nth i l d) = true ∨ i = length l).
Proof.
intros * Hi.
apply List_rank_loop_if with (d := d) in Hi.
rewrite Nat.sub_0_r in Hi; cbn in Hi.
destruct Hi as (Hbef, Hat).
split; [ | easy ].
intros j Hj.
specialize (Hbef j).
rewrite Nat.sub_0_r in Hbef.
now apply Hbef.
Qed.

(* end List_rank *)

Theorem Nat_b2n_upper_bound : ∀ b, Nat.b2n b ≤ 1.
Proof.
intros; destruct b; cbn; flia.
Qed.

Theorem Nat_mod_fact_upper_bound : ∀ k n, k mod n! < n!.
Proof.
intros.
apply Nat.mod_upper_bound, fact_neq_0.
Qed.

Theorem List_skipn_skipn : ∀ A i j (la : list A),
  skipn i (skipn j la) = skipn (i + j) la.
Proof.
intros.
revert j.
induction la as [| a]; intros; cbn. {
  now do 3 rewrite skipn_nil.
}
destruct j; [ now rewrite Nat.add_0_r | ].
rewrite skipn_cons.
rewrite <- Nat.add_succ_comm, Nat.add_succ_l.
rewrite skipn_cons.
apply IHla.
Qed.

Theorem List_skipn_is_cons : ∀ A (d : A) la n,
  n < length la
  → skipn n la = nth n la d :: skipn (S n) la.
Proof.
intros * Hn.
revert n Hn.
induction la as [| a]; intros; [ easy | ].
destruct n; [ easy | ].
cbn in Hn; apply Nat.succ_lt_mono in Hn.
rewrite List_nth_succ_cons.
do 2 rewrite skipn_cons.
now apply IHla.
Qed.

Theorem Nat_lt_lt_sum_mul_lt_sum_mul : ∀ a b c d,
  a < b
  → c < d
  → a * d + b * c < a * c + b * d.
Proof.
intros * Hab Hcd.
rewrite Nat.add_comm.
apply Nat.lt_add_lt_sub_r.
rewrite <- Nat.add_sub_assoc; [ | apply Nat.mul_le_mono_r; flia Hab ].
rewrite <- Nat.mul_sub_distr_r.
apply Nat.lt_sub_lt_add_l.
rewrite <- Nat.mul_sub_distr_r.
apply Nat.mul_lt_mono_pos_l; [ | easy ].
flia Hab.
Qed.

(* butn: list without its nth element *)

Definition butn {A} n (l : list A) :=
  firstn n l ++ skipn (S n) l.

Theorem fold_butn : ∀ A n (l : list A),
  firstn n l ++ skipn (S n) l = butn n l.
Proof. easy. Qed.

Theorem butn_nil : ∀ A n, butn n ([] : list A) = [].
Proof. now intros; destruct n. Qed.

Theorem butn_0_cons : ∀ A (a : A) la, butn 0 (a :: la) = la.
Proof. easy. Qed.

Theorem butn_succ_cons : ∀ A (a : A) la n, butn (S n) (a :: la) = a :: butn n la.
Proof.
intros.
unfold butn.
now rewrite firstn_cons, skipn_cons.
Qed.

Theorem map_butn : ∀ A B (f : A → B) la n,
  map f (butn n la) = butn n (map f la).
Proof.
intros.
revert n.
induction la as [| a]; intros; cbn; [ now do 2 rewrite butn_nil | ].
destruct n; [ easy | ].
do 2 rewrite butn_succ_cons.
cbn; f_equal.
apply IHla.
Qed.

Theorem butn_out : ∀ A (l : list A) i, length l ≤ i → butn i l = l.
Proof.
intros * Hi.
revert i Hi.
induction l as [| a]; intros; [ apply butn_nil | ].
destruct i; [ easy | ].
cbn in Hi; apply Nat.succ_le_mono in Hi.
rewrite butn_succ_cons.
now rewrite IHl.
Qed.

Theorem butn_length : ∀ A n (l : list A),
  length (butn n l) = length l - Nat.b2n (n <? length l).
Proof.
intros.
unfold Nat.b2n; rewrite if_bool_if_dec.
destruct (Sumbool.sumbool_of_bool (n <? length l)) as [Hnl| Hnl]. 2: {
  apply Nat.ltb_ge in Hnl; rewrite Nat.sub_0_r.
  now rewrite butn_out.
}
apply Nat.ltb_lt in Hnl.
revert n Hnl.
induction l as [| a]; intros; [ easy | ].
cbn; rewrite Nat.sub_0_r.
destruct n; [ easy | ].
rewrite butn_succ_cons; cbn.
cbn in Hnl.
apply Nat.succ_lt_mono in Hnl.
rewrite IHl; [ | easy ].
destruct (length l); [ easy | ].
now cbn; rewrite Nat.sub_0_r.
Qed.

Theorem nth_butn_before : ∀ A (l : list A) i j d,
  j ≤ i
  → nth i (butn j l) d = nth (i + 1) l d.
Proof.
intros * Hji.
revert i j Hji.
induction l as [| a]; intros; cbn. {
  rewrite butn_nil.
  now destruct i.
}
destruct j; [ now rewrite Nat.add_1_r | ].
destruct i; [ easy | ].
apply Nat.succ_le_mono in Hji.
rewrite butn_succ_cons; cbn.
now apply IHl.
Qed.

Theorem nth_butn_after : ∀ A (l : list A) i j d,
  i < j
  → nth i (butn j l) d = nth i l d.
Proof.
intros * Hij.
revert i j Hij.
induction l as [| a]; intros; cbn. {
  rewrite butn_nil.
  now destruct i.
}
destruct j; [ easy | ].
destruct i; [ easy | ].
apply Nat.succ_lt_mono in Hij.
rewrite butn_succ_cons; cbn.
now apply IHl.
Qed.

Theorem nth_butn : ∀ A (l : list A) i j d,
  nth i (butn j l) d = nth (i + Nat.b2n (j <=? i)) l d.
Proof.
intros.
remember (j <=? i) as b eqn:Hb; symmetry in Hb.
destruct b. {
  apply Nat.leb_le in Hb.
  now rewrite nth_butn_before.
} {
  apply Nat.leb_gt in Hb.
  rewrite nth_butn_after; [ | easy ].
  now rewrite Nat.add_0_r.
}
Qed.

Theorem in_butn : ∀ A (l : list A) i a, a ∈ butn i l → a ∈ l.
Proof.
intros * Ha.
revert i Ha.
induction l as [| b]; intros. {
  now rewrite butn_nil in Ha.
}
destruct i; [ now right | ].
rewrite butn_succ_cons in Ha.
destruct Ha as [Ha| Ha]; [ now left | right ].
now apply IHl in Ha.
Qed.

Theorem map_butn_seq : ∀ A (f : _ → A) n sta len,
  map f (butn n (seq sta len)) =
  map (λ i, f (i + Nat.b2n (sta + n <=? i)))
    (seq sta (len - Nat.b2n (n <? len))).
Proof.
intros.
revert n sta.
induction len; intros; [ now rewrite butn_nil | ].
destruct n. {
  cbn; rewrite Nat.sub_0_r, Nat.add_0_r.
  rewrite <- seq_shift.
  rewrite map_map.
  apply map_ext_in.
  intros i Hi.
  apply in_seq in Hi.
  rewrite <- Nat.add_1_r.
  destruct (le_dec sta i) as [H| H]; [ | easy ].
  now apply Nat.leb_le in H; rewrite H.
}
unfold Nat.b2n.
rewrite if_bool_if_dec.
destruct (Sumbool.sumbool_of_bool (S n <? S len)) as [Hn| Hn]. {
  apply Nat.ltb_lt in Hn.
  cbn - [ butn ].
  rewrite Nat.sub_0_r, butn_succ_cons; cbn.
  apply Nat.succ_lt_mono in Hn.
  rewrite IHlen.
  destruct len; [ easy | ].
  unfold Nat.b2n.
  rewrite if_ltb_lt_dec.
  destruct (lt_dec n (S len)) as [H| H]; [ clear H | easy ].
  rewrite Nat_sub_succ_1; cbn - [ "<=?" ].
  f_equal. {
    rewrite if_leb_le_dec.
    destruct (le_dec (sta + S n) sta) as [H| H]; [ flia H | clear H ].
    now rewrite Nat.add_0_r.
  }
  apply map_ext_in.
  intros i Hi.
  now rewrite (Nat.add_succ_r sta).
} {
  apply Nat.ltb_ge in Hn.
  rewrite Nat.sub_0_r.
  rewrite butn_out; [ | now rewrite seq_length ].
  apply map_ext_in.
  intros i Hi.
  apply in_seq in Hi.
  rewrite if_leb_le_dec.
  destruct (le_dec (sta + S n) i) as [H| H]; [ flia Hn Hi H | ].
  now rewrite Nat.add_0_r.
}
Qed.

Theorem butn_app : ∀ A (l1 l2 : list A) i,
  butn i (l1 ++ l2) =
    if i <? length l1 then butn i l1 ++ l2
    else l1 ++ butn (i - length l1) l2.
Proof.
intros.
rewrite if_ltb_lt_dec.
unfold butn.
rewrite firstn_app, skipn_app.
destruct (lt_dec i (length l1)) as [Hil| Hil]. {
  rewrite (proj2 (Nat.sub_0_le i _)); [ | now apply Nat.lt_le_incl ].
  rewrite (proj2 (Nat.sub_0_le _ _)); [ | easy ].
  rewrite firstn_O, skipn_O, app_nil_r.
  apply app_assoc.
} {
  apply Nat.nlt_ge in Hil.
  rewrite firstn_all2; [ | easy ].
  rewrite skipn_all2. 2: {
    now apply Nat.lt_le_incl; apply -> Nat.succ_le_mono.
  }
  rewrite app_nil_l.
  rewrite Nat.sub_succ_l; [ | easy ].
  symmetry; apply app_assoc.
}
Qed.

Theorem butn_app_cons :
  ∀ A i b (la lb : list A),
  i = length la
  → butn i (la ++ b :: lb) = la ++ lb.
Proof.
intros * Hia.
unfold butn.
rewrite firstn_app.
rewrite Hia, Nat.sub_diag, firstn_O, app_nil_r.
rewrite firstn_all2; [ | easy ].
rewrite skipn_app.
rewrite Nat.sub_succ_l, Nat.sub_diag; [ | easy ].
rewrite skipn_all2; [ | flia ].
now rewrite skipn_cons, skipn_O.
Qed.

(* end butn *)

(* insert in a list (reverse of butn) *)

Definition insert_at A k (la : list A) e :=
  firstn k la ++ e :: skipn k la.

(* end insert_at *)

(* replace in a list *)

Definition replace_at {A} k (la : list A) e :=
  firstn k la ++ e :: skipn (S k) la.

Theorem replace_at_succ_cons : ∀ A i a b (l : list A),
  replace_at (S i) (a :: l) b = a :: replace_at i l b.
Proof. easy. Qed.

(* end replace_at *)

(* repeat_apply: applying a function n times *)

Fixpoint repeat_apply A n (f : A → A) a :=
  match n with
  | 0 => a
  | S n' => repeat_apply n' f (f a)
  end.

Theorem List_fold_left_nop_r : ∀ A B (a : A) (lb : list B) (f : A → _),
  fold_left (λ c _, f c) lb a = repeat_apply (length lb) f a.
Proof.
intros.
revert a.
induction lb as [| b]; intros; [ easy | cbn ].
apply IHlb.
Qed.

Theorem repeat_apply_id : ∀ A len f (a : A),
  (∀ a, f a = a)
  → repeat_apply len f a = a.
Proof.
intros * Hid.
revert a.
induction len; intros; [ easy | cbn ].
rewrite IHlen.
apply Hid.
Qed.

(* end repeat_apply *)

(* equivalence & equality *)

Definition equivalence {A} (eqv : A → A → bool) :=
  (∀ a, eqv a a = true) ∧
  (∀ a b, eqv a b = true → eqv b a = true) ∧
  (∀ a b c, eqv a b = true → eqv b c = true → eqv a c = true).

Definition equality {A} (eqb : A → A → bool) := ∀ a b, eqb a b = true ↔ a = b.

Theorem equality_refl {A} (eqb : A → _) : equality eqb → ∀ a, eqb a a = true.
Proof.
intros * Heqb *.
now apply Heqb.
Qed.

Theorem equality_in_dec : ∀ A (eqb : A → _) (Heqb : equality eqb) (a : A) la,
  { a ∈ la } + { a ∉ la }.
Proof.
intros.
induction la as [| b]; [ now right | ].
remember (eqb a b) as ab eqn:Hab; symmetry in Hab.
destruct ab; [ now apply Heqb in Hab; subst b; left; left | ].
destruct IHla as [H1| H1]; [ now left; right | right ].
intros H2; apply H1; clear H1.
destruct H2 as [H2| H2]; [ | easy ].
subst b.
now rewrite (equality_refl Heqb) in Hab.
Qed.

(* *)

Theorem option_eq_dec : ∀ A : Type,
  (∀ x y : A, {x = y} + {x ≠ y})
  → (∀ x y : option A, {x = y} + {x ≠ y}).
Proof.
intros * Hed *.
destruct x as [x| ]. {
  destruct y as [y| ]; [ | now right ].
  destruct (Hed x y) as [H1| H1]; [ now left; subst y | right ].
  intros H; apply H1.
  now injection H.
}
destruct y as [y| ]; [ now right | now left ].
Qed.

(* *)

Fixpoint list_compare {A} (compare : A → A → comparison) la lb :=
  match la with
  | [] =>
      match lb with
      | [] => Eq
      | b :: lb' => Lt
      end
  | a :: la' =>
      match lb with
      | [] => Gt
      | b :: lb' =>
          match compare a b with
          | Eq => list_compare compare la' lb'
          | Lt => Lt
          | Gt => Gt
          end
      end
  end.

Definition comparator {A} (compare : A → _) :=
  ∀ a b, compare a b = Eq ↔ a = b.

(* list_eqv *)

Fixpoint list_eqv A (eqv : A → A → bool) la lb :=
  match la with
  | [] =>
      match lb with
      | [] => true
      | b :: lb' => false
      end
  | a :: la' =>
      match lb with
      | [] => false
      | b :: lb' => if eqv a b then list_eqv eqv la' lb' else false
      end
  end.

Theorem list_eqb_eq : ∀ A (eqb : A → _),
  equality eqb →
  ∀ la lb, list_eqv eqb la lb = true ↔ la = lb.
Proof.
intros * Heqb *.
split; intros Hlab. {
  revert lb Hlab.
  induction la as [| a]; intros; [ now destruct lb | cbn ].
  destruct lb as [| b]; [ easy | cbn in Hlab ].
  remember (eqb a b) as ab eqn:Hab; symmetry in Hab.
  destruct ab; [ | easy ].
  apply Heqb in Hab; subst b; f_equal.
  now apply IHla.
} {
  subst lb.
  induction la as [| a]; [ easy | cbn ].
  now rewrite (equality_refl Heqb).
}
Qed.

Theorem list_eqb_neq : ∀ A (eqb : A → _),
  equality eqb →
  ∀ la lb, list_eqv eqb la lb = false → la ≠ lb.
Proof.
intros * Heqb * Hab H; subst lb.
induction la as [| a]; [ easy | cbn in Hab ].
rewrite (equality_refl Heqb) in Hab.
congruence.
Qed.

Theorem equality_list_eqv : ∀ A (eqb : A → _),
  equality eqb ↔ equality (list_eqv eqb).
Proof.
intros.
split. {
  intros Heqb la lb.
  now apply list_eqb_eq.
} {
  intros Heqb a b.
  unfold equality in Heqb.
  split. {
    intros Hab.
    specialize (Heqb [a] [b]).
    cbn in Heqb.
    rewrite Hab in Heqb.
    specialize (proj1 Heqb eq_refl) as H1.
    now injection H1.
  } {
    intros Hab; subst b.
    specialize (Heqb [a] [a]).
    cbn in Heqb.
    specialize (proj2 Heqb eq_refl) as H1.
    now destruct (eqb a a).
  }
}
Qed.

(* end list_eqv *)

(* list_leb *)

Fixpoint list_leb A (leb : A → A → bool) la lb :=
  match la with
  | [] => true
  | a :: la' =>
      match lb with
      | [] => false
      | b :: lb' =>
          if leb a b then
            if leb b a then list_leb leb la' lb' else true
          else false
      end
  end.

(* end list_leb *)

(* list_ltb *)

Fixpoint list_ltb A (ltb : A → A → bool) la lb :=
  match lb with
  | [] => false
  | b :: lb' =>
      match la with
      | [] => true
      | a :: la' =>
          if ltb a b then true
          else if ltb b a then false
          else list_ltb ltb la' lb'
      end
  end.

(* end list_ltb *)

(* pair_eqb *)

Definition pair_eqb {A B} (eqba : A → A → bool) (eqbb : B → B → bool) ab cd :=
  (eqba (fst ab) (fst cd) && eqbb (snd ab) (snd cd))%bool.

Theorem pair_eqb_eq : ∀ A B (eqba : A → _) (eqbb : B → _),
  equality eqba →
  equality eqbb →
  ∀ a b, pair_eqb eqba eqbb a b = true ↔ a = b.
Proof.
intros * Heqba Heqbb *.
split; intros Hab. {
  unfold pair_eqb in Hab.
  destruct a as (a1, a2).
  destruct b as (b1, b2).
  cbn in Hab.
  apply Bool.andb_true_iff in Hab.
  destruct Hab as (Ha, Hb).
  apply Heqba in Ha.
  apply Heqbb in Hb.
  congruence.
} {
  subst b.
  unfold pair_eqb.
  destruct a as (a1, a2); cbn.
  apply Bool.andb_true_iff.
  split. {
    apply (equality_refl Heqba).
  } {
    apply (equality_refl Heqbb).
  }
}
Qed.

(* end pair_eqb *)

Definition unsome A (d : A) o :=
  match o with
  | Some x => x
  | None => d
  end.

(* extract: like "find" but returning all details:
   - what is before
   - the value found
   - what is after *)

Fixpoint extract {A} (f : A → bool) l :=
  match l with
  | [] => None
  | a :: la =>
      if f a then Some ([], a, la)
      else
        match extract f la with
        | None => None
        | Some (bef, b, aft) => Some (a :: bef, b, aft)
        end
  end.

Theorem extract_Some_iff : ∀ A (f : A → _) l a bef aft,
  extract f l = Some (bef, a, aft)
  ↔ (∀ x, x ∈ bef → f x = false) ∧ f a = true ∧ l = bef ++ a :: aft.
Proof.
intros.
split. {
  intros He.
  revert a bef aft He.
  induction l as [| b]; intros; [ easy | cbn ].
  cbn in He.
  remember (f b) as fb eqn:Hfb; symmetry in Hfb.
  destruct fb. {
    now injection He; clear He; intros; subst bef b aft.
  }
  remember (extract f l) as lal eqn:Hlal; symmetry in Hlal.
  destruct lal as [((bef', x), aft') | ]; [ | easy ].
  injection He; clear He; intros; subst bef x aft'.
  rename bef' into bef.
  specialize (IHl _ _ _ eq_refl) as H1.
  destruct H1 as (H1 & H2 & H3).
  split. {
    intros c Hc.
    destruct Hc as [Hc| Hc]; [ now subst c | ].
    now apply H1.
  }
  split; [ easy | ].
  now cbn; f_equal.
} {
  intros He.
  destruct He as (Hbef & Hf & Hl).
  subst l.
  revert a aft Hf.
  induction bef as [| b]; intros; cbn; [ now rewrite Hf | ].
  rewrite Hbef; [ | now left ].
  rewrite IHbef; [ easy | | easy ].
  now intros c Hc; apply Hbef; right.
}
Qed.

Theorem extract_None_iff : ∀ A (f : A → _) l,
  extract f l = None ↔ ∀ a, a ∈ l → f a = false.
Proof.
intros.
split. {
  intros He * Ha.
  revert a Ha.
  induction l as [| b]; intros; [ easy | ].
  cbn in He.
  remember (f b) as fb eqn:Hfb; symmetry in Hfb.
  destruct fb; [ easy | ].
  destruct Ha as [Ha| Ha]; [ now subst b | ].
  apply IHl; [ | easy ].
  now destruct (extract f l) as [((bef, x), aft)| ].
} {
  intros Hf.
  induction l as [| a]; [ easy | cbn ].
  rewrite Hf; [ | now left ].
  rewrite IHl; [ easy | ].
  intros c Hc.
  now apply Hf; right.
}
Qed.

(* member: a computable "In" *)

Fixpoint member A (eqb : A → A → bool) a la :=
  match la with
  | [] => false
  | b :: lb => if eqb a b then true else member eqb a lb
  end.

Theorem member_true_iff : ∀ A (eqb : A → _),
  equality eqb →
  ∀ a la, member eqb a la = true ↔ ∃ l1 l2, la = l1 ++ a :: l2.
Proof.
intros * Heqb *.
split. {
  intros Hma.
  induction la as [| b]; [ easy | cbn in Hma ].
  remember (member eqb a la) as mal eqn:Hmal; symmetry in Hmal.
  destruct mal. {
    specialize (IHla eq_refl).
    destruct IHla as (l1 & l2 & Hla).
    subst la.
    now exists (b :: l1), l2.
  }
  remember (eqb a b) as ab eqn:Hab; symmetry in Hab.
  destruct ab; [ | easy ].
  apply Heqb in Hab; subst b.
  now exists [], la.
} {
  intros (l1 & l2 & Hla).
  subst la.
  induction l1 as [| b]; cbn. {
    now rewrite (equality_refl Heqb).
  }
  now destruct (eqb a b).
}
Qed.

Theorem member_false_iff : ∀ A (eqb : A → _),
  equality eqb →
  ∀ a la, member eqb a la = false ↔ ∀ b, b ∈ la → a ≠ b.
Proof.
intros * Heqb *.
split. {
  intros Hma * Hb Hab; subst b.
  induction la as [| b]; [ easy | ].
  cbn in Hma.
  destruct Hb as [Hb| Hb]. {
    subst b.
    now rewrite (equality_refl Heqb) in Hma.
  }
  apply IHla; [ | easy ].
  now destruct (eqb a b).
} {
  intros Hla.
  induction la as [| b]; [ easy | cbn ].
  remember (eqb a b) as ab eqn:Hab; symmetry in Hab.
  destruct ab. {
    apply Heqb in Hab; subst b.
    now specialize (Hla _ (or_introl eq_refl)).
  }
  apply IHla.
  intros c Hc.
  now apply Hla; right.
}
Qed.

(* end member *)

(* no_dup: a computable "NoDup" *)

Fixpoint no_dup A (eqb : A → A → bool) la :=
  match la with
  | [] => true
  | a :: la' => if member eqb a la' then false else no_dup eqb la'
  end.

Theorem no_dup_NoDup : ∀ A (eqb : A → _),
  equality eqb →
  ∀ la, no_dup eqb la = true ↔ NoDup la.
Proof.
intros * Heqb *.
split; intros Hla. {
  induction la as [| a]; [ constructor | ].
  apply NoDup_cons_iff.
  cbn in Hla.
  rewrite if_bool_if_dec in Hla.
  destruct (Sumbool.sumbool_of_bool _) as [Hal| Hal]; [ easy | ].
  split; [ | now apply IHla ].
  intros H.
  now specialize (proj1 (member_false_iff Heqb _ _) Hal a H).
} {
  induction la as [| a]; [ easy | cbn ].
  rewrite if_bool_if_dec.
  apply NoDup_cons_iff in Hla.
  destruct (Sumbool.sumbool_of_bool _) as [Hal| Hal]; [ | now apply IHla ].
  apply (member_true_iff Heqb) in Hal.
  destruct Hla as (Hala & Hnd).
  destruct Hal as (l1 & l2 & H); subst la.
  exfalso; apply Hala.
  now apply in_or_app; right; left.
}
Qed.

Theorem no_dup_false_iff : ∀ A (eqb : A → _),
  equality eqb →
  ∀ la, no_dup eqb la = false ↔
  ∃ l1 l2 l3 a, la = l1 ++ a :: l2 ++ a :: l3.
Proof.
intros * Heqb *.
split. {
  intros Had.
  induction la as [| a]; [ easy | cbn in Had ].
  remember (member eqb a la) as mal eqn:Hmal; symmetry in Hmal.
  destruct mal. 2: {
    specialize (IHla Had).
    destruct IHla as (l1 & l2 & l3 & b & Hlb).
    exists (a :: l1), l2, l3, b.
    now subst la.
  }
  clear Had.
  apply member_true_iff in Hmal; [ | easy ].
  destruct Hmal as (l1 & l2 & Hla); subst la.
  now exists [], l1, l2, a.
} {
  intros (l1 & l2 & l3 & a & Hla); subst la.
  induction l1 as [| b]; cbn. {
    remember (member eqb a (l2 ++ a :: l3)) as mal eqn:Hmal; symmetry in Hmal.
    destruct mal; [ easy | ].
    specialize (proj1 (member_false_iff Heqb _ _) Hmal a) as H1.
    assert (H : a ∈ l2 ++ a :: l3) by now apply in_or_app; right; left.
    now specialize (H1 H).
  }
  remember (member eqb b _) as mbl eqn:Hmbl; symmetry in Hmbl.
  now destruct mbl.
}
Qed.

(* end no_dup *)

Theorem NoDup_app_comm {A} : ∀ l l' : list A,
  NoDup (l ++ l') → NoDup (l' ++ l).
Proof.
intros * Hll.
revert l Hll.
induction l' as [| a l']; intros; [ now rewrite app_nil_r in Hll | ].
cbn; constructor. {
  intros Ha.
  apply NoDup_remove_2 in Hll; apply Hll.
  apply in_app_or in Ha.
  apply in_or_app.
  now destruct Ha; [ right | left ].
}
apply IHl'.
now apply NoDup_remove_1 in Hll.
Qed.

Theorem List_fold_left_ext_in : ∀ A B (f g : A → B → A) l a,
  (∀ b c, b ∈ l → f c b = g c b)
  → fold_left f l a = fold_left g l a.
Proof.
intros * Hfg.
revert a.
induction l as [| d]; intros; [ easy | cbn ].
rewrite (Hfg d a); [ | now left ].
apply IHl.
intros b c Hb.
apply Hfg.
now right.
Qed.

Theorem List_fold_right_ext_in : ∀ A B (f g : B → A → A) l a,
  (∀ b c, b ∈ l → f b c = g b c)
  → fold_right f a l = fold_right g a l.
Proof.
intros * Hfg.
revert a.
induction l as [| d]; intros; [ easy | cbn ].
rewrite (Hfg d); [ | now left ].
rewrite IHl; [ easy | ].
intros b c Hb.
apply Hfg.
now right.
Qed.

Theorem List_fold_left_map_nth_len : ∀ A (la : list A) sta len f d,
  fold_left (λ lb k, map (λ i, nth (f k i) lb d) (seq 0 (length lb)))
    (seq sta len) la =
  fold_left (λ lb k, map (λ i, nth (f k i) lb d) (seq 0 (length la)))
    (seq sta len) la.
Proof.
intros.
revert sta la.
induction len; intros; [ easy | cbn ].
rewrite IHlen.
apply List_fold_left_ext_in.
intros i lb Hi; apply in_seq in Hi.
now rewrite map_length, seq_length.
Qed.

Theorem List_eq_firstn_nil : ∀ A n (l : list A),
  firstn n l = [] → n = 0 ∨ l = [].
Proof.
intros * Hnl.
revert l Hnl.
induction n; intros; [ now left | right ].
destruct l as [| x]; [ easy | easy ].
Qed.

Theorem List_eq_skipn_nil: ∀ A n (l : list A), skipn n l = [] → length l ≤ n.
Proof.
intros * Hnl.
revert l Hnl.
induction n; intros; [ now cbn in Hnl; subst l | ].
destruct l as [| x]; [ easy | ].
cbn in Hnl |-*.
apply -> Nat.succ_le_mono.
now apply IHn.
Qed.

Theorem List_eq_rev_nil {A} : ∀ (l : list A), rev l = [] → l = [].
Proof.
intros * Hl.
destruct l as [| a]; [ easy | cbn in Hl ].
now apply app_eq_nil in Hl.
Qed.

Theorem List_map_rev_seq : ∀ A (f : _ → A) sta len,
  map f (rev (seq sta len)) = map (λ i, f (2 * sta + len - 1 - i)) (seq sta len).
Proof.
intros.
revert sta.
induction len; intros; [ easy | ].
rewrite seq_S at 1.
rewrite rev_app_distr.
cbn.
rewrite Nat.add_0_r.
rewrite Nat.add_succ_r.
rewrite Nat_sub_succ_1.
rewrite Nat.add_shuffle0, Nat.add_sub.
f_equal.
rewrite IHlen.
rewrite <- seq_shift.
rewrite map_map.
apply map_ext_in.
intros; f_equal; flia.
Qed.

Theorem List_map_seq : ∀ A (f : _ → A) sta len,
  map f (seq sta len) = map (λ i, f (sta + i)) (seq 0 len).
Proof.
intros.
revert sta.
induction len; intros; [ easy | cbn ].
symmetry.
rewrite <- seq_shift, map_map.
rewrite Nat.add_0_r; f_equal.
symmetry.
rewrite IHlen.
apply map_ext_in.
intros i Hi.
now rewrite Nat.add_succ_comm.
Qed.

Theorem List_map_seq_length : ∀ A (f : _ → A) a len,
  length (map f (seq a len)) = len.
Proof.
intros.
now rewrite map_length, seq_length.
Qed.

Theorem List_map_map_seq : ∀ A B (f : A → B) d la,
  map f la = map (λ i, f (nth i la d)) (seq 0 (length la)).
Proof.
intros.
induction la as [| a]; [ easy | cbn ].
f_equal.
rewrite <- seq_shift.
now rewrite map_map.
Qed.

Theorem List_map_nth_seq : ∀ A (la : list A) d,
  la = map (λ i, nth i la d) (seq 0 (length la)).
Proof.
intros.
induction la as [| a]; [ easy | ].
cbn; f_equal.
rewrite <- seq_shift.
now rewrite map_map.
Qed.

Theorem List_map_nth_seq' : ∀ A (la : list A) d n,
  n = length la
  → la = map (λ i, nth i la d) (seq 0 n).
Proof.
intros * Hn.
subst n.
apply List_map_nth_seq.
Qed.

Theorem List_map_repeat : ∀ A B x n (f : A → B),
  map f (repeat x n) = repeat (f x) n.
Proof.
intros.
induction n; [ easy | cbn ].
f_equal; apply IHn.
Qed.

Theorem List_rev_rev : ∀ A (la lb : list A), rev la = rev lb → la = lb.
Proof.
intros * Hab.
apply (f_equal (λ l, rev l)) in Hab.
now do 2 rewrite rev_involutive in Hab.
Qed.

Theorem List_rev_symm : ∀ A (la lb : list A), rev la = lb → la = rev lb.
Proof.
intros * Hab.
now subst lb; rewrite rev_involutive.
Qed.

Theorem List_rev_repeat : ∀ A (x : A) n,
  rev (repeat x n) = repeat x n.
Proof.
intros.
induction n; [ easy | cbn ].
rewrite repeat_cons; f_equal.
apply IHn.
Qed.

Theorem List_nth_repeat : ∀ A (a d : A) i n,
  nth i (repeat a n) d = if lt_dec i n then a else d.
Proof.
intros A *.
destruct (lt_dec i n) as [Hin| Hin]. {
  revert i Hin.
  induction n; intros; [ easy | cbn ].
  destruct i; [ easy | ].
  apply Nat.succ_lt_mono in Hin.
  now apply IHn.
}
apply Nat.nlt_ge in Hin.
apply nth_overflow.
now rewrite repeat_length.
Qed.

Theorem List_nth_firstn : ∀ A (l : list A) i j d,
  i < j
  → nth i (firstn j l) d = nth i l d.
Proof.
intros * Hij.
revert i j Hij.
induction l as [| a la]; intros; [ now rewrite firstn_nil | ].
destruct j; [ easy | ].
rewrite firstn_cons.
destruct i; [ easy | cbn ].
apply IHla.
now apply Nat.succ_lt_mono.
Qed.

Theorem List_nth_skipn : ∀ A (l : list A) i j d,
  nth i (skipn j l) d = nth (i + j) l d.
Proof.
intros.
revert i j.
induction l as [| a la]; intros. {
  rewrite skipn_nil; cbn.
  now destruct i, j.
}
destruct j; [ now rewrite Nat.add_0_r | ].
rewrite Nat.add_succ_r; cbn.
apply IHla.
Qed.

Theorem List_app_eq_app' :
  ∀ (X : Type) (x1 x2 y1 y2 : list X),
    length x1 = length y1
    → x1 ++ x2 = y1 ++ y2
    → x1 = y1 ∧ x2 = y2.
Proof.
intros * Hxy Haa.
revert x2 y1 y2 Hxy Haa.
induction x1 as [| a1]; intros; cbn. {
  cbn in Hxy, Haa.
  symmetry in Hxy; apply length_zero_iff_nil in Hxy.
  now subst x2 y1.
}
destruct y1 as [| b1]; [ easy | ].
injection Haa; clear Haa; intros H1 H2; subst b1.
cbn in Hxy.
apply Nat.succ_inj in Hxy.
specialize (IHx1 x2 y1 y2 Hxy H1).
now destruct IHx1; subst y1 y2.
Qed.

Theorem List_last_cons_cons : ∀ A l (x y d : A),
  last (x :: y :: l) d = last (y :: l) d.
Proof. easy. Qed.

Theorem List_firstn_seq : ∀ n start len,
  firstn n (seq start len) = seq start (min n len).
Proof.
intros.
revert start len.
induction n; intros; [ easy | cbn ].
remember (seq start len) as l eqn:Hl; symmetry in Hl.
destruct l as [| a l]; [ now destruct len | ].
destruct len; [ easy | cbn in Hl; cbn ].
injection Hl; clear Hl; intros Hl Ha.
subst start; f_equal.
rewrite <- Hl; apply IHn.
Qed.

Theorem List_skipn_seq : ∀ n start len,
  n ≤ len → skipn n (seq start len) = seq (start + n) (len - n).
Proof.
intros * Hnlen.
revert n start Hnlen.
induction len; intros; [ now rewrite skipn_nil | cbn ].
destruct n; [ now cbn; rewrite Nat.add_0_r | cbn ].
rewrite <- Nat.add_succ_comm.
apply Nat.succ_le_mono in Hnlen.
now apply IHlen.
Qed.

Theorem List_eq_iff : ∀ A (l1 l2 : list A),
  l1 = l2 ↔ (length l1 = length l2 ∧ ∀ d i, nth i l1 d = nth i l2 d).
Proof.
split; [ now intros; subst l2 | ].
intros (Hlen & Hll).
revert l2 Hlen Hll.
induction l1 as [| a1]; intros. {
  symmetry in Hlen.
  now apply length_zero_iff_nil in Hlen.
}
destruct l2 as [| a2]; [ easy | ].
cbn in Hlen.
apply Nat.succ_inj in Hlen.
f_equal; [ apply (Hll a1 0) | ].
apply IHl1; [ easy | ].
intros.
now specialize (Hll d (S i)).
Qed.

Theorem List_last_rev : ∀ A (l : list A) d,
  last (rev l) d = hd d l.
Proof.
intros.
destruct l as [| a]; [ easy | apply last_last ].
Qed.

Theorem List_last_nth : ∀ A (la : list A) d,
  last la d = nth (length la - 1) la d.
Proof.
intros.
destruct la as [| a] using rev_ind; [ easy | cbn ].
rewrite last_last, app_length, Nat.add_sub.
rewrite app_nth2; [ | now unfold ge ].
now rewrite Nat.sub_diag.
Qed.

(* common for all iterators *)

Theorem iter_list_seq : ∀ T d (op : T → T → T) b len f,
  len ≠ 0
  → iter_list (seq b len) (λ c i, op c (f i)) d =
    iter_seq b (b + len - 1) (λ c i, op c (f i)) d.
Proof.
intros * Hlen.
unfold iter_seq.
f_equal; f_equal.
flia Hlen.
Qed.

Theorem fold_left_op_fun_from_d : ∀ T A d op a l (f : A → _)
  (op_d_l : ∀ x, op d x = x)
  (op_d_r : ∀ x, op x d = x)
  (op_assoc : ∀ a b c, op a (op b c) = op (op a b) c),
  fold_left (λ (c : T) i, op c (f i)) l a =
  op a (fold_left (λ (c : T) i, op c (f i)) l d).
Proof.
intros.
revert a.
induction l as [| x l]; intros; [ symmetry; apply op_d_r | cbn ].
rewrite IHl; symmetry; rewrite IHl.
rewrite op_d_l.
apply op_assoc.
Qed.

Theorem iter_list_op_fun_from_d : ∀ T A d op a l (f : A → _)
  (op_d_l : ∀ x, op d x = x)
  (op_d_r : ∀ x, op x d = x)
  (op_assoc : ∀ a b c, op a (op b c) = op (op a b) c),
  iter_list l (λ (c : T) (i : A), op c (f i)) a =
  op a (iter_list l (λ (c : T) (i : A), op c (f i)) d).
Proof.
intros.
unfold iter_list.
revert a.
induction l as [| x l]; intros; [ symmetry; apply op_d_r | cbn ].
rewrite IHl; symmetry; rewrite IHl.
rewrite op_d_l.
apply op_assoc.
Qed.

Theorem iter_list_all_d : ∀ T A d op (l : list A) f
  (op_d_l : ∀ x, op d x = x)
  (op_d_r : ∀ x, op x d = x)
  (op_assoc : ∀ a b c, op a (op b c) = op (op a b) c),
  (∀ i, i ∈ l → f i = d)
  → iter_list l (λ (c : T) i, op c (f i)) d = d.
Proof.
intros * op_d_l op_d_r op_assoc Hz.
unfold iter_list.
induction l as [| a]; [ easy | cbn ].
rewrite (fold_left_op_fun_from_d d); [ | easy | easy | easy ].
rewrite IHl. {
  rewrite op_d_l, op_d_r.
  now apply Hz; left.
}
intros i Hi.
apply Hz.
now right.
Qed.

Theorem iter_seq_all_d : ∀ T d op b e f
  (op_d_l : ∀ x, op d x = x)
  (op_d_r : ∀ x, op x d = x)
  (op_assoc : ∀ a b c, op a (op b c) = op (op a b) c),
  (∀ i : nat, b ≤ i ≤ e → f i = d)
  → iter_seq b e (λ (c : T) (i : nat), op c (f i)) d = d.
Proof.
intros * op_d_l od_d_r op_assoc Hz.
apply iter_list_all_d; [ easy | easy | easy | ].
intros i Hi.
apply in_seq in Hi.
apply Hz; flia Hi.
Qed.

Theorem iter_list_split_first : ∀ T A d op l z f
  (op_d_l : ∀ x, op d x = x)
  (op_d_r : ∀ x, op x d = x)
  (op_assoc : ∀ a b c, op a (op b c) = op (op a b) c),
  l ≠ []
  → iter_list l (λ (c : T) (i : A), op c (f i)) d =
    op (f (hd z l)) (iter_list (tl l) (λ (c : T) (i : A), op c (f i)) d).
Proof.
intros * op_d_l op_d_r op_assoc Hl.
unfold iter_list.
destruct l as [| a]; [ easy | cbn ].
rewrite op_d_l.
now rewrite fold_left_op_fun_from_d with (d := d).
Qed.

Theorem iter_seq_split_first : ∀ T d op b k g
  (op_d_l : ∀ x, op d x = x)
  (op_d_r : ∀ x, op x d = x)
  (op_assoc : ∀ a b c, op a (op b c) = op (op a b) c),
  b ≤ k
  → iter_seq b k (λ (c : T) (i : nat), op c (g i)) d =
    op (g b) (iter_seq (S b) k (λ (c : T) (i : nat), op c (g i)) d).
Proof.
intros * op_d_l op_d_r op_assoc Hbk.
unfold iter_seq, iter_list.
remember (S k - b) as len eqn:Hlen.
replace (S k - S b) with (len - 1) by flia Hlen.
assert (H : len ≠ 0) by flia Hlen Hbk.
clear k Hbk Hlen.
rename H into Hlen.
destruct len; [ easy | cbn ].
rewrite op_d_l, Nat.sub_0_r.
apply fold_left_op_fun_from_d. {
  apply op_d_l.
} {
  apply op_d_r.
} {
  apply op_assoc.
}
Qed.

Theorem iter_list_split_last : ∀ T A d (op : T → T → T) l (g : A → T) z,
  l ≠ []
  → iter_list l (λ c i, op c (g i)) d =
    op (iter_list (removelast l) (λ c i, op c (g i)) d) (g (last l z)).
Proof.
intros * Hlz.
unfold iter_list.
induction l as [| a] using rev_ind; [ easy | clear IHl Hlz ].
rewrite removelast_last.
rewrite last_last.
now rewrite fold_left_app.
Qed.

Theorem iter_seq_split_last : ∀ T d (op : T → T → T) b k g,
  b ≤ k
  → iter_seq b k (λ (c : T) (i : nat), op c (g i)) d =
    op (iter_seq (S b) k (λ (c : T) (i : nat), op c (g (i - 1)%nat)) d) (g k).
Proof.
intros * Hbk.
unfold iter_seq, iter_list.
remember (S k - S b) as len eqn:Hlen.
rewrite Nat.sub_succ in Hlen.
replace (S k - b) with (S len) by flia Hbk Hlen.
replace k with (b + len) by flia Hbk Hlen.
rewrite <- seq_shift.
rewrite List_fold_left_map.
rewrite seq_S.
rewrite fold_left_app.
cbn; f_equal.
apply List_fold_left_ext_in.
intros i c Hi.
now rewrite Nat.sub_0_r.
Qed.

Theorem iter_seq_split : ∀ T d op j g b k
  (op_d_l : ∀ x, op d x = x)
  (op_d_r : ∀ x, op x d = x)
  (op_assoc : ∀ a b c, op a (op b c) = op (op a b) c),
   b ≤ S j ≤ S k
  → iter_seq b k (λ (c : T) (i : nat), op c (g i)) d =
    op (iter_seq b j (λ (c : T) (i : nat), op c (g i)) d)
      (iter_seq (j + 1) k (λ (c : T) (i : nat), op c (g i)) d).
Proof.
intros * op_d_l op_d_r op_assoc (Hbj, Hjk).
unfold iter_seq, iter_list.
remember (S j - b) as len1 eqn:Hlen1.
remember (S k - b) as len2 eqn:Hlen2.
move len2 before len1.
replace (S k - (j + 1)) with (len2 - len1) by flia Hlen1 Hlen2 Hbj.
replace (j + 1) with (b + len1) by flia Hlen1 Hbj.
assert (Hll : len1 ≤ len2) by flia Hlen1 Hlen2 Hjk.
clear - Hll op_d_l op_d_r op_assoc.
revert b len2 Hll.
induction len1; intros. {
  cbn; rewrite Nat.add_0_r, Nat.sub_0_r; symmetry.
  apply op_d_l.
}
destruct len2; [ flia Hll | ].
apply Nat.succ_le_mono in Hll; cbn.
rewrite op_d_l.
rewrite (fold_left_op_fun_from_d d _ (g b)); [ | easy | easy | easy ].
rewrite (fold_left_op_fun_from_d d _ (g b)); [ | easy | easy | easy ].
rewrite <- op_assoc; f_equal.
replace len2 with (len1 + (len2 - len1)) at 1 by flia Hll.
rewrite seq_app, fold_left_app.
rewrite (fold_left_op_fun_from_d d); [ | easy | easy | easy ].
now rewrite Nat.add_succ_comm.
Qed.

Theorem iter_seq_split3 : ∀ T d op j g b k
  (op_d_l : ∀ x, op d x = x)
  (op_d_r : ∀ x, op x d = x)
  (op_assoc : ∀ a b c, op a (op b c) = op (op a b) c),
  b ≤ j ≤ k
  → iter_seq b k (λ (c : T) (i : nat), op c (g i)) d =
    op (op (iter_seq (S b) j (λ (c : T) (i : nat), op c (g (i - 1))) d) (g j))
      (iter_seq (j + 1) k (λ (c : T) (i : nat), op c (g i)) d).
Proof.
intros * op_d_l op_d_r op_assoc Hj.
rewrite iter_seq_split with (j := j); [ | easy | easy | easy | flia Hj ].
now rewrite iter_seq_split_last.
Qed.

Theorem iter_list_app : ∀ A B (d : A) (f : A → B → A) la lb,
  iter_list (la ++ lb) f d = iter_list lb f (iter_list la f d).
Proof.
intros.
unfold iter_list.
now rewrite fold_left_app.
Qed.

Theorem iter_list_cons : ∀ A B d op (a : B) la f
  (op_d_l : ∀ x, op d x = x)
  (op_d_r : ∀ x, op x d = x)
  (op_assoc : ∀ a b c, op a (op b c) = op (op a b) c),
  iter_list (a :: la) (λ (c : A) i, op c (f i)) d =
  op (f a) (iter_list la (λ (c : A) i, op c (f i)) d).
Proof.
intros.
unfold iter_list; cbn.
rewrite op_d_l.
now apply (fold_left_op_fun_from_d d).
Qed.

Theorem iter_list_eq_compat : ∀ A B d (op : A → A → A) (l : list B) g h,
  (∀ i, i ∈ l → g i = h i)
  → iter_list l (λ c i, op c (g i)) d =
    iter_list l (λ c i, op c (h i)) d.
Proof.
intros * Hgh.
unfold iter_list.
revert d.
induction l as [| a]; intros; [ easy | cbn ].
rewrite Hgh; [ | now left ].
apply IHl.
intros i Hi.
apply Hgh.
now right.
Qed.

Theorem iter_seq_eq_compat : ∀ T d (op : T → T → T) b k g h,
  (∀ i, b ≤ i ≤ k → g i = h i)
  → iter_seq b k (λ c i, op c (g i)) d =
    iter_seq b k (λ c i, op c (h i)) d.
Proof.
intros * Hgh.
apply iter_list_eq_compat.
intros i Hi.
apply Hgh.
apply in_seq in Hi.
flia Hi.
Qed.

Theorem iter_seq_succ_succ : ∀ {T} (d : T) b k f,
  iter_seq (S b) (S k) f d =
  iter_seq b k (λ c i, f c (S i)) d.
Proof.
intros.
unfold iter_seq, iter_list.
rewrite Nat.sub_succ.
remember (S k - b)%nat as len; clear Heqlen.
rewrite <- seq_shift.
now rewrite List_fold_left_map.
Qed.

Theorem iter_seq_succ_succ' : ∀ {T} (d : T) b k f,
  iter_seq (S b) (S k) (λ c i, f c (i - 1)) d =
  iter_seq b k (λ c i, f c i) d.
Proof.
intros.
unfold iter_seq, iter_list.
rewrite Nat.sub_succ.
rewrite <- seq_shift.
rewrite List_fold_left_map.
apply List_fold_left_ext_in.
intros j i Hj.
f_equal.
rewrite Nat.sub_succ.
apply Nat.sub_0_r.
Qed.

Theorem iter_list_empty : ∀ T A d (op : T → T → T) (l : list A) g,
  l = []
  → iter_list l (λ c i, op c (g i)) d = d.
Proof.
now intros * Hl; subst l.
Qed.

Theorem iter_seq_empty : ∀ T d (op : T → T → T) b k g,
  k < b
  → iter_seq b k (λ (c : T) (i : nat), op c (g i)) d = d.
Proof.
intros * Hkb.
unfold iter_seq.
now replace (S k - b) with 0 by flia Hkb.
Qed.

Theorem iter_list_only_one : ∀ T A d (op : T → T → T) (g : A → T) a
  (op_d_l : ∀ x, op d x = x),
  iter_list [a] (λ c i, op c (g i)) d = g a.
Proof.
intros * op_d_l.
unfold iter_list; cbn.
apply op_d_l.
Qed.

Theorem iter_seq_only_one : ∀ T d (op : T → T → T) g n
  (op_d_l : ∀ x, op d x = x),
  iter_seq n n (λ c i, op c (g i)) d = g n.
Proof.
intros * op_d_l.
unfold iter_seq.
rewrite Nat.sub_succ_l; [ | easy ].
rewrite Nat.sub_diag.
now apply iter_list_only_one.
Qed.

Theorem iter_list_distr : ∀ T A d op g h (l : list A)
  (op_d_l : ∀ x, op d x = x)
  (op_comm : ∀ a b, op a b = op b a)
  (op_assoc : ∀ a b c, op a (op b c) = op (op a b) c),
  iter_list l (λ (c : T) (i : A), op c (op (g i) (h i))) d =
  op (iter_list l (λ (c : T) (i : A), op c (g i)) d)
    (iter_list l (λ (c : T) (i : A), op c (h i)) d).
Proof.
intros.
unfold iter_list.
induction l as [| a]; [ symmetry; apply op_d_l | cbn ].
rewrite (fold_left_op_fun_from_d d); [ | easy | | easy ]. 2: {
  intros; rewrite op_comm; apply op_d_l.
}
symmetry.
rewrite (fold_left_op_fun_from_d d); [ | easy | | easy ]. 2: {
  intros; rewrite op_comm; apply op_d_l.
}
rewrite fold_iter_list.
rewrite (fold_left_op_fun_from_d d); [ | easy | | easy ]. 2: {
  intros; rewrite op_comm; apply op_d_l.
}
rewrite IHl.
do 2 rewrite fold_iter_list.
remember (iter_list _ _ _) as b eqn:Hb in |-*.
remember (iter_list _ _ _) as c eqn:Hc in |-*.
do 3 rewrite op_d_l.
do 2 rewrite op_assoc.
f_equal.
symmetry.
rewrite (op_comm _ b).
rewrite op_assoc.
f_equal.
apply op_comm.
Qed.

Theorem iter_seq_distr : ∀ T d op g h b k
  (op_d_l : ∀ x, op d x = x)
  (op_comm : ∀ a b, op a b = op b a)
  (op_assoc : ∀ a b c, op a (op b c) = op (op a b) c),
  iter_seq b k (λ (c : T) (i : nat), (op c (op (g i) (h i)))) d =
  op
    (iter_seq b k (λ (c : T) (i : nat), op c (g i)) d)
    (iter_seq b k (λ (c : T) (i : nat), op c (h i)) d).
Proof.
intros.
now apply iter_list_distr.
Qed.

Theorem iter_seq_inv : ∀ T d op inv b e f
  (inv_d : inv d = d)
  (inv_op_distr : ∀ a b, inv (op a b) = op (inv a) (inv b)),
  inv (iter_seq b e (λ (c : T) (i : nat), op c (f i)) d) =
  iter_seq b e (λ (c : T) (i : nat), op c (inv (f i))) d.
Proof.
intros.
unfold iter_seq, iter_list.
remember (S e - b) as len.
clear e Heqlen.
revert b.
induction len; intros; [ now apply inv_d | ].
rewrite seq_S; cbn.
rewrite fold_left_app; cbn.
rewrite fold_left_app; cbn.
rewrite <- IHlen.
now rewrite inv_op_distr.
Qed.

Theorem iter_seq_rtl : ∀ T d op b k f
  (op_d_l : ∀ x, op d x = x)
  (op_d_r : ∀ x, op x d = x)
  (op_comm : ∀ a b, op a b = op b a)
  (op_assoc : ∀ a b c, op a (op b c) = op (op a b) c),
  iter_seq b k (λ (c : T) (i : nat), op c (f i)) d =
  iter_seq b k (λ (c : T) (i : nat), op c (f (k + b - i))) d.
Proof.
intros.
destruct (le_dec (S k) b) as [Hkb| Hkb]. {
  unfold iter_seq.
  now replace (S k - b) with 0 by flia Hkb.
}
apply Nat.nle_gt in Hkb.
apply -> Nat.lt_succ_r in Hkb.
unfold iter_seq, iter_list.
remember (S k - b) as len eqn:Hlen.
replace k with (b + len - 1) by flia Hkb Hlen.
clear Hlen Hkb.
revert b.
induction len; intros; [ easy | ].
rewrite seq_S at 1; cbn.
rewrite fold_left_app; cbn.
symmetry.
rewrite fold_left_op_fun_from_d with (d := d); [ | easy | easy | easy ].
rewrite op_comm.
f_equal; [ | rewrite op_d_l; f_equal; flia ].
rewrite IHlen.
rewrite <- seq_shift.
rewrite List_fold_left_map.
apply List_fold_left_ext_in.
intros j c Hj.
apply in_seq in Hj.
f_equal; f_equal; flia.
Qed.

(* *)

Theorem fold_left_max_from_0 : ∀ A a l (f : A → _),
  fold_left (λ c i, max c (f i)) l a =
  max a (fold_left (λ c i, max c (f i)) l 0).
Proof.
intros.
apply fold_left_op_fun_from_d. {
  now intros; apply max_r.
} {
  now intros; rewrite Nat.max_l.
} {
  apply Nat.max_assoc.
}
Qed.

Theorem max_list_app : ∀ A (la lb : list A) f,
  Max (i ∈ la ++ lb), f i = max (Max (i ∈ la), f i) (Max (i ∈ lb), f i).
Proof.
intros.
rewrite iter_list_app.
unfold iter_list.
apply fold_left_max_from_0.
Qed.

Theorem max_list_cons : ∀ A (a : A) la f,
  Max (i ∈ a :: la), f i = max (f a) (Max (i ∈ la), f i).
Proof.
intros.
apply iter_list_cons. {
  now intros; apply max_r.
} {
  now intros; rewrite Nat.max_l.
} {
  apply Nat.max_assoc.
}
Qed.

Theorem List_flat_map_length : ∀ A B (f : A → list B) l,
  length (flat_map f l) = iter_list l (fun c a => c + length (f a)) 0.
Proof.
intros.
induction l as [| a]; [ now rewrite iter_list_empty | cbn ].
rewrite app_length.
rewrite iter_list_cons; cycle 1. {
  apply Nat.add_0_l.
} {
  apply Nat.add_0_r.
} {
  apply Nat.add_assoc.
}
now cbn; f_equal.
Qed.

(* App : a notation for iterating concatenation of a list of lists *)

Notation "'App' ( i = b , e ) , g" :=
  (iter_seq b e (λ c i, c ++ g) [])
  (at level 45, i at level 0, b at level 60, e at level 60).

Notation "'App' ( i ∈ l ) , g" :=
  (iter_list l (λ c i, c ++ g) [])
  (at level 45, i at level 0, l at level 60).

Theorem App_list_cons : ∀ A B (a : A) la (f : A → list B),
  App (i ∈ a :: la), f i = f a ++ App (i ∈ la), f i.
Proof.
intros.
apply iter_list_cons; [ easy | apply app_nil_r | ].
apply app_assoc.
Qed.

Theorem App_list_all_nil : ∀ A B l (f : A → list B),
  (∀ a, a ∈ l → f a = [])
  → App (a ∈ l), f a = [].
Proof.
intros * Hl.
apply iter_list_all_d; [ easy | apply app_nil_r | | easy ].
apply app_assoc.
Qed.

Theorem App_list_eq_nil : ∀ A B (l : list A) (f : A → list B),
  App (a ∈ l), f a = [] → ∀ a, a ∈ l → f a = [].
Proof.
intros * Happ * Hl.
induction l as [| b]; [ easy | ].
rewrite App_list_cons in Happ.
apply app_eq_nil in Happ.
destruct Hl as [Hl| Hl]; [ now subst a | ].
now apply IHl.
Qed.

Theorem App_list_concat_map : ∀ A B (l : list A) (f : A → list B),
  App (a ∈ l), f a = concat (map f l).
Proof.
intros.
induction l as [| a]; [ easy | cbn ].
rewrite App_list_cons.
now rewrite IHl.
Qed.

Theorem in_App_list : ∀ A B (f : A → list B) l y,
  y ∈ App (i ∈ l), f i ↔ (∃ x : A, x ∈ l ∧ y ∈ f x).
Proof.
intros.
rewrite App_list_concat_map.
rewrite <- flat_map_concat_map.
apply in_flat_map.
Qed.

Theorem App_split : ∀ A j (g : nat → list A) b k,
  b ≤ S j ≤ S k
  → App (i = b, k), g i = App (i = b, j), g i ++ App (i = j+1, k), g i.
Proof.
intros * Hbjk.
apply iter_seq_split; [ easy | | | easy ]. {
  apply app_nil_r.
} {
  apply app_assoc.
}
Qed.

Theorem App_list_app : ∀ A B (la lb : list A) (f : A → list B),
  App (i ∈ la ++ lb), f i = App (i ∈ la), f i ++ App (i ∈ lb), f i.
Proof.
intros.
rewrite iter_list_app.
unfold iter_list.
rewrite fold_left_op_fun_from_d with (d := []); [ easy | easy | | ]. {
  apply app_nil_r.
} {
  apply app_assoc.
}
Qed.

Theorem App_only_one : ∀ A (g : _ → list A) n, App (i = n, n), g i = g n.
Proof.
intros.
now apply iter_seq_only_one.
Qed.

(* cart_prod: cartesian product of several lists *)

Fixpoint cart_prod {A} (ll : list (list A)) :=
  match ll with
  | [] => [[]]
  | l :: ll' => flat_map (λ a, map (cons a) (cart_prod ll')) l
  end.

Theorem cart_prod_length : ∀ A (ll : list (list A)),
  ll ≠ []
  → length (cart_prod ll) = iter_list ll (fun c l => c * length l) 1.
Proof.
intros * Hll.
revert Hll.
induction ll as [| l1]; intros; [ easy | clear Hll; cbn ].
rewrite iter_list_cons; cycle 1.
  apply Nat.mul_1_l.
  apply Nat.mul_1_r.
  apply Nat.mul_assoc.
rewrite List_flat_map_length.
erewrite iter_list_eq_compat. 2: {
  intros i Hi.
  now rewrite map_length.
}
cbn.
destruct ll as [| l2]. {
  rewrite iter_list_empty with (l := []); [ | easy ].
  rewrite Nat.mul_1_r; cbn.
  induction l1 as [| a]; [ easy | ].
  rewrite iter_list_cons; cycle 1.
    apply Nat.add_0_l.
    apply Nat.add_0_r.
    apply Nat.add_assoc.
  now cbn; rewrite IHl1.
}
rewrite IHll; [ | easy ].
induction l1 as [| a]; [ easy | ].
rewrite iter_list_cons; cycle 1.
  apply Nat.add_0_l.
  apply Nat.add_0_r.
  apply Nat.add_assoc.
now cbn; rewrite IHl1.
Qed.

Theorem in_cart_prod_length : ∀ A (ll : list (list A)) l,
  l ∈ cart_prod ll → length l = length ll.
Proof.
intros * Hl.
revert l Hl.
induction ll as [| l1]; intros. {
  cbn in Hl.
  destruct Hl as [Hl| Hl]; [ now subst l | easy ].
}
cbn in Hl.
apply in_flat_map in Hl.
destruct Hl as (a & Hl1 & Ha).
apply in_map_iff in Ha.
destruct Ha as (l3 & Hl & Hl3).
subst l; cbn; f_equal.
now apply IHll.
Qed.

Theorem nth_in_cart_prod : ∀ A (d : A) ll l i,
  i < length ll
  → l ∈ cart_prod ll
  → nth i l d ∈ nth i ll [].
Proof.
intros * Hi Hll.
revert l i Hi Hll.
induction ll as [| l1]; intros; [ easy | ].
cbn in Hll |-*.
destruct i. {
  destruct ll as [| l2]. {
    apply in_flat_map in Hll.
    destruct Hll as (a & Ha & Hla).
    apply in_map_iff in Hla.
    now destruct Hla as (l2 & H & Hl2); subst l.
  }
  apply in_flat_map in Hll.
  destruct Hll as (a & Hl1 & Hl).
  apply in_map_iff in Hl.
  now destruct Hl as (l3 & H & Hl3); subst l.
}
cbn in Hi; apply Nat.succ_lt_mono in Hi.
destruct ll as [| l2]; [ easy | ].
apply in_flat_map in Hll.
destruct Hll as (a & Ha & Hl).
apply in_map_iff in Hl.
destruct Hl as (l3 & H & Hl3); subst l.
rewrite List_nth_succ_cons.
now apply IHll.
Qed.

Theorem in_cart_prod_iff : ∀ A (d : A) ll la,
  la ∈ cart_prod ll
  ↔ length la = length ll ∧ ∀ i, i < length la → nth i la d ∈ nth i ll [].
Proof.
intros.
split. {
  intros Hla.
  split; [ now apply in_cart_prod_length in Hla | ].
  intros i Hi.
  apply nth_in_cart_prod; [ | easy ].
  apply in_cart_prod_length in Hla.
  congruence.
} {
  intros (Hla & Hnth).
  revert la Hla Hnth.
  induction ll as [| lb]; intros. {
    now apply length_zero_iff_nil in Hla; subst la; left.
  }
  cbn.
  destruct la as [| a]; [ easy | ].
  cbn in Hla; apply Nat.succ_inj in Hla.
  apply in_flat_map.
  exists a.
  specialize (Hnth 0 (Nat.lt_0_succ _)) as H1; cbn in H1.
  split; [ easy | ].
  apply in_map_iff.
  exists la.
  split; [ easy | ].
  apply IHll; [ easy | ].
  intros i Hi.
  specialize (Hnth (S i)) as H2.
  cbn in H2.
  apply Nat.succ_lt_mono in Hi.
  now specialize (H2 Hi).
}
Qed.

(* end cart_prod *)

Theorem NoDup_filter {A} : ∀ (f : A → _) l, NoDup l → NoDup (filter f l).
Proof.
intros * Hnd.
induction l as [| a l]; [ easy | cbn ].
remember (f a) as b eqn:Hb; symmetry in Hb.
apply NoDup_cons_iff in Hnd.
destruct Hnd as (Hal, Hl).
destruct b. {
  constructor; [ | now apply IHl ].
  intros H; apply Hal.
  now apply filter_In in H.
}
now apply IHl.
Qed.

Theorem NoDup_map_iff {A B} : ∀ d l (f : A → B),
  NoDup (map f l)
  ↔ (∀ i j,
      i < length l → j < length l → f (nth i l d) = f (nth j l d) → i = j).
Proof.
intros.
split. {
  intros Hnd i j Hi Hj Hij.
  revert i j Hi Hj Hij.
  induction l as [| a l]; intros; [ easy | ].
  cbn in Hnd.
  apply NoDup_cons_iff in Hnd.
  destruct Hnd as (Hnin, Hnd).
  specialize (IHl Hnd).
  destruct i. {
    destruct j; [ easy | exfalso ].
    cbn in Hij, Hj; clear Hi.
    apply Nat.succ_lt_mono in Hj.
    rewrite Hij in Hnin; apply Hnin; clear Hnin.
    now apply in_map, nth_In.
  }
  cbn in Hi, Hj.
  destruct j; [ exfalso | ]. {
    cbn in Hij, Hj; clear Hj.
    apply Nat.succ_lt_mono in Hi.
    rewrite <- Hij in Hnin; apply Hnin; clear Hnin.
    now apply in_map, nth_In.
  }
  apply Nat.succ_lt_mono in Hi.
  apply Nat.succ_lt_mono in Hj.
  cbn in Hij.
  f_equal.
  now apply IHl.
} {
  intros Hinj.
  induction l as [| a l]; [ constructor | cbn ].
  apply NoDup_cons. {
    intros Hcon.
    apply in_map_iff in Hcon.
    destruct Hcon as (b & Hba & Hb).
    symmetry in Hba.
    apply (In_nth _ _ d) in Hb.
    destruct Hb as (n & Hlen & Hnth).
    specialize (Hinj 0 (S n)) as H1.
    cbn in H1; rewrite Hnth in H1.
    apply Nat.succ_lt_mono in Hlen.
    now specialize (H1 (Nat.lt_0_succ _) Hlen Hba).
  }
  apply IHl.
  intros i j Hi Hj Hij.
  apply Nat.succ_lt_mono in Hi.
  apply Nat.succ_lt_mono in Hj.
  specialize (Hinj (S i) (S j) Hi Hj Hij) as H1.
  now apply Nat.succ_inj in H1.
}
Qed.

Theorem NoDup_app_remove_l : ∀ A (l l' : list A), NoDup (l ++ l') → NoDup l'.
Proof.
intros * Hnd.
apply NoDup_app_comm in Hnd.
revert l Hnd.
induction l' as [| b]; intros; [ constructor | ].
cbn in Hnd.
apply NoDup_cons_iff in Hnd.
destruct Hnd as (H1, H2).
constructor; [ | now apply IHl' in H2 ].
intros H; apply H1.
now apply in_or_app; left.
Qed.

Theorem NoDup_app_remove_r : ∀ A (l l' : list A), NoDup (l ++ l') → NoDup l.
Proof.
intros * Hnd.
apply NoDup_app_comm in Hnd.
now apply NoDup_app_remove_l in Hnd.
Qed.

Theorem NoDup_app_iff : ∀ A (l l' : list A),
  NoDup (l ++ l') ↔
    NoDup l ∧ NoDup l' ∧ (∀ a, a ∈ l → a ∉ l').
Proof.
intros.
split. {
  intros Hnd.
  split; [ now apply NoDup_app_remove_r in Hnd | ].
  split; [ now apply NoDup_app_remove_l in Hnd | ].
  intros a Ha Ha'.
  revert l' Hnd Ha'.
  induction l as [| b]; intros; [ easy | ].
  destruct Ha as [Ha| Ha]. {
    subst b.
    apply NoDup_app_comm in Hnd.
    apply NoDup_remove_2 in Hnd.
    apply Hnd.
    now apply in_app_iff; left.
  }
  apply (IHl Ha l'); [ | easy ].
  cbn in Hnd.
  now apply NoDup_cons_iff in Hnd.
} {
  intros * (Hnl & Hnl' & Hll).
  revert l' Hnl' Hll.
  induction l as [| b l]; intros; [ easy | cbn ].
  constructor. {
    intros Hb.
    apply in_app_or in Hb.
    destruct Hb as [Hb| Hb]. {
      now apply NoDup_cons_iff in Hnl.
    } {
      now specialize (Hll b (or_introl eq_refl)) as H1.
    }
  } {
    apply NoDup_cons_iff in Hnl.
    apply IHl; [ easy | easy | ].
    intros a Ha.
    now apply Hll; right.
  }
}
Qed.

Theorem NoDup_butn : ∀ A k (la : list A), NoDup la → NoDup (butn k la).
Proof.
intros * Hnd.
apply NoDup_app_iff.
split. {
  rewrite <- (firstn_skipn k) in Hnd.
  now apply NoDup_app_iff in Hnd.
}
split. {
  rewrite <- (firstn_skipn (S k)) in Hnd.
  now apply NoDup_app_iff in Hnd.
}
intros i Hif.
rewrite <- (firstn_skipn (S k)) in Hnd.
apply NoDup_app_iff in Hnd.
destruct Hnd as (H1 & H2 & H3).
apply H3.
clear - Hif.
revert la Hif.
induction k; intros; [ easy | ].
destruct la as [| a]; [ easy | ].
rewrite firstn_cons in Hif |-*.
destruct Hif as [Hif| Hif]; [ now left | right ].
now apply IHk.
Qed.

Theorem NoDup_concat_if : ∀ A (ll : list (list A)),
  (∀ l, l ∈ ll → NoDup l)
  → (∀ i j, i ≠ j → ∀ a, a ∈ nth i ll [] → a ∉ nth j ll [])
  → NoDup (concat ll).
Proof.
intros * Hnd Hll.
induction ll as [| l]; [ constructor | cbn ].
apply NoDup_app_iff.
split; [ now apply Hnd; left | ].
split. {
  apply IHll. {
    intros l1 Hl1.
    now apply Hnd; right.
  }
  intros i j Hij a Ha.
  specialize (Hll (S i) (S j)).
  apply Hll; [ now intros H; injection H | easy ].
}
clear - Hnd Hll.
intros i Hi Hll'.
revert i l Hnd Hi Hll Hll'.
induction ll as [| l1]; intros; [ easy | ].
cbn in Hll'.
apply in_app_or in Hll'.
destruct Hll' as [Hll'| Hll']. 2: {
  apply IHll with (i := i) (l := l); [ | easy | | easy ]. {
    intros l2 Hl2.
    apply Hnd.
    destruct Hl2 as [Hl2| Hl2]; [ now left | now right; right ].
  }
  intros u v Huv a Ha.
  destruct u. {
    cbn in Ha.
    destruct v; [ easy | cbn ].
    specialize (Hll 0 (S (S v))) as H1.
    assert (H : 0 ≠ S (S v)) by easy.
    now specialize (H1 H a Ha).
  }
  cbn in Ha.
  destruct v. {
    specialize (Hll (S (S u)) 0) as H1.
    assert (H : S (S u) ≠ 0) by easy.
    now specialize (H1 H a Ha).
  }
  cbn.
  apply Nat.succ_inj_wd_neg in Huv.
  specialize (Hll _ _ Huv).
  now apply Hll.
}
now specialize (Hll 0 1 (Nat.neq_0_succ _) _ Hi).
Qed.

(* "to_radix_loop u r i" is the last u digits of i in base r (in reverse) *)
Fixpoint to_radix_loop it r i :=
  match it with
  | 0 => []
  | S it' => i mod r :: to_radix_loop it' r (i / r)
  end.

(* conversion natural into radix r as a list of digits; i must be
   less than r^r; always return r digits; e.g. radix 10 37 =
   7; 3; 0 ... (eight 0s) *)
Definition to_radix r i := to_radix_loop r r i.

Definition to_radix_list r := map (to_radix r) (seq 0 (r ^ r)).

Fixpoint to_radix_inv r l :=
  match l with
  | [] => 0
  | d :: l' => d + r * to_radix_inv r l'
  end.

Theorem to_radix_loop_ub : ∀ it n k i,
  n ≠ 0 → nth i (to_radix_loop it n k) 0 < n.
Proof.
intros * Hnz.
revert n k i Hnz.
induction it; intros; [ destruct i; cbn; flia Hnz | cbn ].
destruct i; [ now apply Nat.mod_upper_bound | ].
now apply IHit.
Qed.

Theorem to_radix_ub : ∀ n k i, n ≠ 0 → nth i (to_radix n k) 0 < n.
Proof.
intros * Hnz.
now apply to_radix_loop_ub.
Qed.

Theorem to_radix_inv_to_radix_loop : ∀ it n k,
  to_radix_inv n (to_radix_loop it n k) = k mod (n ^ it).
Proof.
intros.
destruct (Nat.eq_dec n 0) as [Hnz| Hnz]. {
  subst n.
  destruct it; [ easy | apply Nat.add_0_r ].
}
revert n k Hnz.
induction it; intros; [ easy | cbn ].
rewrite IHit; [ | easy ].
symmetry.
apply Nat.mod_mul_r; [ easy | ].
now apply Nat.pow_nonzero.
Qed.

Theorem to_radix_loop_to_radix_inv : ∀ l d n it,
  length l + d = n
  → (∀ i, i ∈ l → i < n)
  → n ≤ it + d
  → to_radix_loop it n (to_radix_inv n l) = l ++ repeat 0 (it + d - n).
Proof.
intros * Hlen Hl Hit.
revert d n it Hlen Hl Hit.
induction l as [| a]; intros. {
  cbn - [ "-" ].
  cbn in Hlen; subst d.
  clear Hl Hit.
  rewrite Nat.add_sub.
  destruct (Nat.eq_dec n 0) as [Hnz| Hnz]. {
    subst n; cbn.
    induction it; cbn; [ easy | now cbn; f_equal ].
  }
  induction it; [ easy | cbn ].
  rewrite Nat.mod_small; [ | flia Hnz ].
  rewrite Nat.div_small; [ | flia Hnz ].
  now f_equal.
}
cbn - [ "-" ].
destruct it; [ cbn in Hlen; flia Hlen Hit | ].
cbn - [ "-" ].
f_equal. {
  rewrite Nat.mul_comm, Nat.mod_add; [ | now subst n ].
  now apply Nat.mod_small, Hl; left.
}
rewrite Nat.mul_comm, Nat.div_add; [ | now subst n ].
rewrite Nat.div_small; [ | now apply Hl; left ].
rewrite Nat.add_0_l.
cbn in Hlen, Hit.
rewrite <- Nat.add_succ_r in Hlen, Hit |-*.
apply IHl; [ easy | | easy ].
intros i Hi.
now apply Hl; right.
Qed.

(* *)

Theorem to_radix_inv_to_radix : ∀ n k,
  k < n ^ n → to_radix_inv n (to_radix n k) = k.
Proof.
intros * Hkn.
unfold to_radix.
rewrite to_radix_inv_to_radix_loop.
now apply Nat.mod_small.
Qed.

Theorem to_radix_to_radix_inv : ∀ n l,
  length l = n
  → (∀ i, i ∈ l → i < n)
  → to_radix n (to_radix_inv n l) = l.
Proof.
intros * Hlen Hl.
unfold to_radix.
specialize to_radix_loop_to_radix_inv as H1.
specialize (H1 l 0 n n).
do 2 rewrite Nat.add_0_r in H1.
specialize (H1 Hlen Hl (le_refl _)).
now rewrite Nat.sub_diag, app_nil_r in H1.
Qed.

Theorem to_radix_loop_length : ∀ n l it, length (to_radix_loop it n l) = it.
Proof.
intros.
revert n l.
induction it; intros; cbn; [ easy | f_equal; apply IHit ].
Qed.

Theorem to_radix_length : ∀ n l, length (to_radix n l) = n.
Proof.
intros.
unfold to_radix.
apply to_radix_loop_length.
Qed.

Theorem to_radix_inv_ub : ∀ n l,
  n ≠ 0
  → (∀ i, i < length l → nth i l 0 < n)
  → to_radix_inv n l < n ^ length l.
Proof.
intros * Hnz Hl.
revert n Hnz Hl.
induction l as [| a]; intros; cbn; [ easy | ].
apply Nat.neq_0_lt_0 in Hnz.
specialize (Hl 0 (Nat.lt_0_succ _)) as H1; cbn in H1.
apply Nat.neq_0_lt_0 in Hnz.
specialize (IHl n Hnz) as H2.
assert (H : ∀ i, i < length l → nth i l 0 < n). {
  intros i Hi.
  apply (Hl (S i)); cbn.
  now apply -> Nat.succ_lt_mono.
}
specialize (H2 H); clear H.
now apply Nat_lt_lt_add_mul.
Qed.

Theorem to_radix_inj : ∀ n i j,
  i < n ^ n
  → j < n ^ n
  → to_radix n i = to_radix n j
  → i = j.
Proof.
intros * Hi Hj Hij.
apply (f_equal (to_radix_inv n)) in Hij.
rewrite to_radix_inv_to_radix in Hij; [ | easy ].
rewrite to_radix_inv_to_radix in Hij; [ | easy ].
easy.
Qed.

Definition abs_diff u v := if v <? u then u - v else v - u.

(* *)

Definition bool_of_sumbool {A B : Prop} (P : sumbool A B) :=
  match P with
  | left _ _ => true
  | right _ _ => false
  end.

Definition sumbool_or {A B C D : Prop} (P : sumbool A B) (Q : sumbool C D) :=
  orb (bool_of_sumbool P) (bool_of_sumbool Q).

Definition sumbool_and {A B C D : Prop} (P : sumbool A B) (Q : sumbool C D) :=
  andb (bool_of_sumbool P) (bool_of_sumbool Q).

Notation "a ∨∨ b" := (sumbool_or a b) (at level 85).
Notation "a ∧∧ b" := (sumbool_and a b) (at level 80).

Arguments iter_list {A B}%type l%list f%function : simpl never.
Arguments iter_shift {T}%type s [b k]%nat.
Arguments "<?" : simpl never.

Global Hint Resolve Nat_mod_fact_upper_bound : core.


(*

  Copyright 2016 University of Luxembourg

  This file is part of our formalization of Platzer's
    "A Complete Uniform Substitution Calculus for Differential Dynamic Logic"
  available here: http://arxiv.org/pdf/1601.06183.pdf.
  We refer to this formalization as DdlCoq here.

  DdlCoq is free software: you can redistribute it and/or modify
  it under the terms of the GNU General Public License as published by
  the Free Software Foundation, either version 3 of the License, or
  (at your option) any later version.

  DdlCoq is distributed in the hope that it will be useful,
  but WITHOUT ANY WARRANTY; without even the implied warranty of
  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  GNU General Public License for more details.

  You should have received a copy of the GNU General Public License
  along with DdlCoq.  If not, see <http://www.gnu.org/licenses/>.

  authors:
    Vincent Rahli
    Marcus Völp
    Ivana Vukotic

 *)

Require Export list_util.
Require Export composition.

Lemma Rdiv_same :
  forall r, r <> 0 -> r / r = 1.
Proof.
  introv d.
  rewrite (Fdiv_def Rfield).
  rewrite Rinv_r; auto.
Qed.

Lemma Rmult_Rdiv_same :
  forall a r, r <> 0 -> r * (a / r) = a.
Proof.
  introv d.
  rewrite (Fdiv_def Rfield).
  rewrite (Rmult_comm a).
  rewrite <- Rmult_assoc.
  rewrite Rinv_r; auto.
  autorewrite with core; auto.
Qed.

(* genAll(n) generates [0;1;2;...;n] *)
Fixpoint genAll (n : nat) : list nat :=
  match n with
  | 0 => [0%nat]
  | S n => snoc (genAll n) (S n)
  end.

(*
  genAllLists(0) generates

   [ [] ]

  genAllLists(1) generates

   [ [0] [1] ]

  genAllLists(2) generates

   [ [0,0] [0,1] [1,0] [1,1] [2,0] [2,1] ]

  and so on
*)
Fixpoint genAllLists (n : nat) : list (list nat) :=
  match n with
  | 0 => [ [] ]
  | S n =>
    let l := genAll(S n) in
    flat_map (fun x => map (fun k => x :: k) (genAllLists n)) l
  end.

Eval compute in (genAllLists 0).
Eval compute in (genAllLists 1).
Eval compute in (genAllLists 2).

Eval compute in (seq.sumn [3%nat;2%nat;6%nat]).

Fixpoint computeSol (k : nat) (l : list nat) : nat :=
  match l with
  | [] => 0
  | x :: l => (k * x) + computeSol (S k) l
  end.

(*

  Only keeps those lists in genAllLists(n) such that computeSol returns n

*)
Fixpoint genSols (n : nat) : list (list nat) :=
  let L := genAllLists n in
  seq.pmap
    (fun l =>
       if deq_nat n (computeSol 1 l)
       then Some l
       else None)
    L.

Eval compute in (genSols 0).
Eval compute in (genSols 1).
Eval compute in (genSols 2).

Fixpoint sum_L {T} (L : list T) (f : T -> R) : R :=
  match L with
  | [] => 0
  | l :: K => f l + sum_L K f
  end.

Fixpoint prod_L_i {T} (n : nat) (L : list T) (f : nat -> T -> R) : R :=
  match L with
  | [] => 1
  | l :: K => f n l * prod_L_i (S n) K f
  end.

Fixpoint factL (l : list nat) : nat :=
  match l with
  | [] => 1
  | x :: l => fact x * factL l
  end.

Definition faa_di_bruno (f g : R -> R) (n : nat) (pt : R) : R :=
  sum_L
    (genSols n)
    (fun l =>
       (INR (fact n) / INR (factL l))
       * Derive_n f (seq.sumn l) (g pt)
       * prod_L_i
           1
           l
           (fun k b => pow (Derive_n g k pt / INR (fact k)) b)
    ).

(* Let's check that the formula is true for n=1 *)
Lemma faa_di_bruno_1 :
  forall f g pt,
    ex_derive_R f (g pt)
    -> ex_derive_R g pt
    -> faa_di_bruno f g 1 pt
       = Derive_n (fun x => f (g x)) 1 pt.
Proof.
  introv exf exg; simpl in *.
  unfold faa_di_bruno; simpl; autorewrite with core.
  rewrite (Derive_comp f g); auto.
  rewrite (Rmult_comm (Derive g pt)); auto.
Qed.

(* We now prove that the formula is true for n=1 *)
Lemma faa_di_bruno_2 :
  forall f g pt,
    (forall n pt, ex_derive_n f n (g pt))
    -> (forall n pt, ex_derive_n g n pt)
    -> faa_di_bruno f g 2 pt
       = Derive_n (fun x => f (g x)) 2 pt.
Proof.
  introv exf exg; simpl in *.
  unfold faa_di_bruno; simpl; autorewrite with core.

  (* Some cleaning up *)
  rewrite (Derive_ext (fun x => f x) f); auto.
  rewrite (Derive_ext (fun x => g x) g); auto.
  rewrite (Derive_ext (fun x => Derive (fun x => f x) x) (fun x => Derive f x)); auto.
  rewrite (Derive_ext (fun x => Derive (fun x => g x) x) (fun x => Derive g x)); auto.
  rewrite (Derive_ext (fun x => Derive f x) (Derive f)); auto.
  rewrite (Derive_ext (fun x => Derive g x) (Derive g)); auto.

  symmetry.
  erewrite Derive_ext;
    [|introv; apply (Derive_comp f g); auto;
      try (apply (exf 1%nat));
      try (apply (exg 1%nat))].

  rewrite Derive_mult; auto;
    try (apply (exg 2%nat));
    try (apply (@ex_derive_comp
                  Hierarchy.R_AbsRing
                  Hierarchy.R_NormedModule
                  (Derive f) g pt); auto;
         try (apply (exg 1%nat));
         try (apply (exf 2%nat))).

  rewrite (Rmult_assoc 2 _ _).
  symmetry.
  rewrite (Rmult_comm (Derive f (g pt))); auto.
  rewrite <- Rmult_assoc.
  rewrite Rdiv_same; auto;
    [|apply tech_Rplus; auto; try (apply Rlt_0_1); try (apply Rle_0_1)].
  autorewrite with core.

  rewrite Rmult_Rdiv_same;
    [|apply tech_Rplus; auto; try (apply Rlt_0_1); try (apply Rle_0_1)].

  f_equal.

  rewrite (Derive_comp (Derive f) g); auto;
    try (apply (exf 2%nat));
    try (apply (exg 1%nat)).
  rewrite <- (Rmult_assoc (Derive g pt)).
  apply Rmult_comm.
Qed.

(* This is the general case *)
Lemma faa_di_bruno_valid :
  forall (f g : R -> R) (n : nat) (pt : R),
    (n > 0)%nat
    -> (forall k pt, ex_derive_n f k pt)
    -> (forall k pt, ex_derive_n g k pt)
    -> Derive_n (fun x => f (g x)) n pt
       = faa_di_bruno f g n pt.
Proof.

Qed.


From mathcomp Require Import ssreflect ssrfun ssrbool ssrint eqtype ssrnat seq choice fintype rat finfun.
From mathcomp Require Import bigop ssralg div ssrnum ssrint order finmap.
From mathcomp Require Import ssreflect ssrfun ssrbool ssrint eqtype ssrnat seq choice fintype rat finfun.
From mathcomp Require Import bigop ssralg div ssrnum ssrint finmap.

Local Open Scope fset.

Definition all_fset {A : choiceType}  (p : A -> bool) f : bool :=
  [fset x in f | p x] == f.

Lemma all_fsetP {A : choiceType} (f : {fset A}) (p : A -> bool) :
  reflect (forall (x : A), x \in f -> p x) (all_fset p f).
  apply: (iffP idP); rewrite /all_fset.
  move/eqP/fsetP => H x.
  move: (H x); rewrite !in_fset inE //=.
  destruct (x \in f).
  move/andP; elim; done.
  done.
  intro H; apply/eqP/fsetP => x.
  remember (x \in f) as b; symmetry in Heqb; destruct b.
  rewrite !in_fset !inE //= Heqb (H _ Heqb) //=.
  rewrite !in_fset !inE //= Heqb //=.
Qed.

Lemma all_fset0 {A : choiceType} (p : A -> bool) :
  all_fset p fset0 = true.
  apply/all_fsetP; rewrite //=.
Qed.

Lemma all_fset1 {A : choiceType} (x : A) p :
  all_fset p [fset x] = p x.
  remember (p x) as b; destruct b.
  apply/all_fsetP => y Hy.
  rewrite in_fset1 in Hy; rewrite (eqP Hy); done.
  apply negbTE; apply/contraT; rewrite negbK; move/all_fsetP => H.
  have: p x.
  apply H; rewrite in_fset1 eq_refl //=.
  rewrite -Heqb //=.
Qed.

Lemma all_fsetU {A : choiceType} (f g : {fset A}) p :
  all_fset p (f `|` g) = all_fset p f && all_fset p g.
  apply Bool.eq_true_iff_eq; split.
  move/all_fsetP => H; apply/andP; split; apply/all_fsetP => x Hx; apply H; apply/fsetUP; [left |right]; done.
  move/andP; elim; move/all_fsetP => H1; move/all_fsetP => H2; apply/all_fsetP => x Hx; move/fsetUP: Hx; elim; [apply H1 | apply H2].
Qed.

Definition cover {A : choiceType} (f : {fset {fset A}}) : {fset A} :=
  \bigcup_(p <- f) p.

Lemma cover1 {A : choiceType} (f : {fset A}) :
  cover (fset1 f) = f.
    rewrite /cover big_seq_fset1 //=.
Qed.

Lemma coverU {A : choiceType} (f g : {fset {fset A}}) :
  cover f `|` cover g = cover (f `|` g).
  rewrite /cover; apply/fsetP => x; apply Bool.eq_true_iff_eq; split.
  move/fsetUP; elim; move/bigfcupP; elim => y Hy1 Hy2; apply/bigfcupP; eexists.
  rewrite andbT; apply/fsetUP; left; rewrite andbT in Hy1; apply Hy1. done.
  rewrite andbT; apply/fsetUP; right; rewrite andbT in Hy1; apply Hy1. done.
  move/bigfcupP; elim => y Hy1 Hy2.
  rewrite andbT in Hy1; move/fsetUP: Hy1; elim => H; apply/fsetUP.
  left; apply/bigfcupP; exists y.
  rewrite andbT; done.
  done.
  right; apply/bigfcupP; exists y.
  rewrite andbT; done.
  done.
Qed.

Definition fpick {A : choiceType} (f : {fset A}) (b : A -> bool) : option A :=
  match (Sumbool.sumbool_of_bool ([fset x in f | b x] != fset0)) with
    | left Hin => Some (xchoose (fset0Pn _ Hin))
    | _ => None
             end.

Lemma fpickPt {A : choiceType} (f : {fset A}) b x :
  fpick f b = Some x -> b x /\ x \in f.
rewrite /fpick.
case: (Sumbool.sumbool_of_bool ([fset x0 | x0 in f & b x0] != fset0)) => H.
move => Heq; injection Heq => <-.
have H2 := (xchooseP (fset0Pn _ H)).
rewrite !in_fset !inE in H2.
move/andP: H2; elim; done.
done.
Qed.

Lemma fpickPn {A : choiceType} (f : {fset A}) b :
  fpick f b = None -> all_fset (fun x => ~~ b x) f.
rewrite /fpick.
case: (Sumbool.sumbool_of_bool ([fset x0 | x0 in f & b x0] != fset0)) => H.
done.
move => _.
move: H.
move/negbFE/eqP/fsetP=>H.
apply/all_fsetP => x Hx.
move: (H x); rewrite !in_fset !inE //=.
rewrite Hx  andTb => -> //=.
Qed.

Inductive fpick_spec {A : choiceType} (f : {fset A}) b :=
  | fpick_true : forall x, fpick f b = Some x -> x \in f -> b x -> fpick_spec f b
  | fpick_false : fpick f b = None -> all_fset (fun x => ~~ b x) f -> fpick_spec f b.

Lemma fpickP {A : choiceType} (f : {fset A}) b : fpick_spec f b.
  remember (fpick f b); symmetry in Heqo; destruct o.
  elim (fpickPt _ _ _ Heqo) => h1 h2; eapply fpick_true.
  apply Heqo.
  apply h2.
  done.
  eapply fpick_false; rewrite //=.
  apply fpickPn; rewrite //=.
Qed.

Lemma fpick_eqP {A : choiceType} (f : {fset A}) (b1 b2 : A -> bool) :
  b1 =1 b2 -> fpick f b1 = fpick f b2.
  move=> Hb.
  rewrite /fpick.
  have: [fset x | x in f & b1 x] = [fset x | x in f & b2 x].
  apply/fsetP => x; rewrite !in_fset !inE //=.
  rewrite Hb //=.
  move => ->.
  done.
Qed.

Definition fset_of_seq {A : choiceType} (s : seq A) :=
  foldr (fun a acc => a |` acc)%fset fset0 s.

Lemma fset_of_seq_cons {A : choiceType} (s : seq A) x :
  fset_of_seq (x :: s) = (x |` fset_of_seq s)%fset.
    rewrite /fset_of_seq //=.
Qed.

Lemma fset_of_seq_cat {A : choiceType} (s1 s2 : seq A)  :
  fset_of_seq (s1 ++ s2) = (fset_of_seq s1 `|` fset_of_seq s2)%fset.
  move: s2.
  induction s1 => s2; rewrite //=.
  rewrite fset0U //=.
  rewrite IHs1.
  rewrite fsetUA //=.
Qed.

Lemma all_fset_all {A : choiceType} (s : seq A) (p : A -> bool) :
  all p s = all_fset p (fset_of_seq s) .
  induction s; rewrite //=.
  symmetry; apply/all_fsetP; rewrite //=.
  rewrite IHs all_fsetU; congr (_ && _).
  rewrite all_fset1 //=.
Qed.

Lemma in_fset_of_seq {A : choiceType} (s : seq A) x :
  (x \in s) = (x \in fset_of_seq s).
  induction s; rewrite //=.
  rewrite in_cons in_fsetU in_fset1 IHs //=.
Qed.

Lemma all_flatten {A} (s : seq (seq A)) P :
  all P (flatten s) = all (all P) s.
  induction s; rewrite //=.
  rewrite all_cat IHs //=.
Qed.

Lemma all_fset_cover {A : choiceType} (s : {fset {fset A}}) (P : A -> bool) :
  all_fset P (cover s) = @all_fset [choiceType of {fset A}] (fun c => all_fset P c) s.
  apply Bool.eq_true_iff_eq; split; move/all_fsetP => H; apply/all_fsetP => x Hx.
  apply/all_fsetP => y Hy.
  apply H.
  apply/bigfcupP; exists x.
  rewrite andbT //=.
  done.
  elim (bigfcupP _ _ _ _ Hx) => y Hy1 Hy2.
  rewrite andbT in Hy1.

  move/all_fsetP: (H y Hy1).
  move/(_ _ Hy2); done.
Qed.

Lemma fset_of_seq_flatten {A : choiceType} (s : seq (seq A)) :
  fset_of_seq (flatten s) = cover (fset_of_seq (map fset_of_seq s)).
  apply/fsetP => x.
  rewrite -in_fset_of_seq.
  apply Bool.eq_true_iff_eq; split.
  move/flattenP; elim => y Hy1 Hy2.
  apply/bigfcupP; exists (fset_of_seq y).
  rewrite -in_fset_of_seq andbT; apply/mapP; exists y; done.
  rewrite -in_fset_of_seq //=.

  move/bigfcupP; elim => y Hy Hy2; apply/flattenP.
  rewrite andbT -in_fset_of_seq in Hy; elim (mapP Hy) => z Hz H'; subst; eexists.
  apply Hz.
  rewrite in_fset_of_seq //=.
Qed.

Fixpoint lfind {A : eqType} (p : A -> bool) (xs : seq A) :=
  match xs with
  | nil => None
  | x :: xs' => if p x then Some x else lfind p xs'
                                                   end.

Inductive lfind_spec {A : eqType} (p : A -> bool) (xs : seq A) :=
  | lfind_some x : lfind p xs = Some x -> x \in xs -> p x -> lfind_spec p xs
  | lfind_none : lfind p xs = None -> all (fun x => ~~ p x) xs -> lfind_spec p xs.

Lemma lfindP {A : eqType} (p : A -> bool) xs : lfind_spec p xs.
  induction xs.
  apply lfind_none; rewrite //=.
  remember (p a) as b; symmetry in Heqb; destruct b.
  apply (lfind_some p (a :: xs) a); rewrite //=.
  rewrite Heqb //=.
  rewrite in_cons eq_refl orTb //=.
  destruct IHxs.
  apply (lfind_some p (a :: xs) x).
  rewrite //= Heqb //=.
  rewrite in_cons i orbT //=.
  done.
  apply lfind_none; rewrite //=.
  rewrite Heqb //= e //=.
  apply/andP; split.
  rewrite Heqb //=.
  done.
Qed.

Definition all_counter {A : eqType} (p : A -> bool) (xs : seq A) :=
  (lfind (fun x => ~~ p x) xs) == None .

Lemma all_counter_cons {A : eqType} (p : A -> bool) xs x :
  all_counter p (x :: xs) = ((p x)) && all_counter p xs.
rewrite /all_counter //=.
destruct (p x); rewrite //=.
Qed.

Definition all_counterP {A : eqType} (p : A -> bool) xs :
  all p xs = all_counter p xs.
  induction xs; rewrite //=.
  rewrite all_counter_cons IHxs //=.
Qed.

Definition all_counterPn {A : eqType} (p : A -> bool) xs :
  isSome (lfind (fun x => ~~ p x) xs) = ~~ (all p xs).
  rewrite all_counterP /all_counter //=.
  destruct (lfind (fun x => ~~ p x) xs); rewrite //=.
Qed.

Lemma all_all {A B} (p : A -> B -> bool) xs ys :
  all (fun x => all (p x) ys) xs = all (fun x => p x.1 x.2) (allpairs (fun x y => (x,y)) xs ys).
  induction xs; rewrite //=.
  rewrite all_cat IHxs.
  congr (_ && _).
  clear; induction ys; rewrite //=.
  rewrite IHys //=.
Qed.

Lemma all_imply_all {A B} (p1 : A -> bool) (p2 : A -> B -> bool) xs ys :
  all (fun x => p1 x ==> all (p2 x) ys) xs =
  all (fun x => (~~ p1 x.1) || (p1 x.1 && p2 x.1 x.2)) (allpairs (fun x y => (x, y)) xs ys).
  induction xs; rewrite //=.
  rewrite all_cat IHxs.
  congr (_ &&_ ).

  clear; induction ys; rewrite //=.
  destruct (p1 a); rewrite //=.
  rewrite -IHys.
  destruct (p1 a); destruct (p2 a a0); destruct (all (p2 a) ys); rewrite //=.
Qed.

Fixpoint multiIf {A} (cs : list (bool * A)) : option A :=
  match cs with
  | (true, a) :: _ => Some a
  | (false, _) :: xs => multiIf xs
  | nil => None
             end.

Fixpoint multiIf_with_posrec {A} n (cs : list (bool * A)) : option (nat * A) :=
  match cs with
  | (true, a) :: _ => Some (n, a)
  | (false, _) :: xs => multiIf_with_posrec (succn n) xs
  | nil => None
             end.

Definition multiIf_with_pos {A} (cs : list (bool * A)) := multiIf_with_posrec 0 cs.

Definition opt_lift {A} (p : A -> bool) := fun (x : option A) =>
                                                 match x with
                                                   | Some a => p a
                                                   | None => true
                                                               end.

Lemma multiIfP {A} (cs : list (bool * A)) (P : A -> bool) :
  all (fun x => P x.2) cs -> opt_lift P (multiIf cs).
  induction cs; rewrite //=.
  move/andP; elim => H1 H2.
  destruct a; rewrite //=.
  destruct b.
  done.
  apply IHcs; rewrite //=.
Qed.

Lemma multiIfPosE {A} (cs : list (bool * A)) :
  multiIf cs = omap snd (multiIf_with_pos cs).
  rewrite /multiIf_with_pos.
  move: 0.
  induction cs; rewrite //=.
  destruct a; destruct b; rewrite //=.
Qed.

Lemma all_cons {A} (xs : seq A) (x : A) (p : A -> bool) :
  p x -> all p xs -> all p (x :: xs).
  rewrite //= => H1 H2; apply/andP; split; done.
Qed.

Ltac split_all :=
  match goal with
  | [ |- is_true (all _ (_ :: _))] => apply all_cons; [idtac | split_all]

  | [ |- is_true (all _ nil)] => rewrite all_nil //=
                               end.

Lemma enum_orP b1 b2 :
  reflect ([\/ (b1 && ~~ b2), (b2 && ~~ b1) | (b1 && b2)]) (b1 || b2).
  apply/(iffP idP); destruct b1; destruct b2; rewrite //= => h.
  by apply Or33.
  by apply Or31.
  by apply Or32.
  elim h; done.
Qed.

Lemma catP {A : eqType} (s1 s2 : seq A) x :
  reflect ([\/ ((x \in s1) && (x \notin s2)), ((x \in s2) && (x \notin s1)) | ((x \in s1) && (x \in s2))])
          (x \in s1 ++ s2).
  apply/(iffP idP).
  rewrite mem_cat; move/enum_orP; done.
  move/enum_orP; rewrite mem_cat //=.
Qed.

Notation "x <$>o f" := (omap f x) (at level 40).
Notation "x >>=o f" := (obind f x) (at level 40).

Lemma opt_neq_none {A : eqType} {x : option A} :
  reflect (exists a, x = Some a) (x != None).
  apply/(iffP idP); case x; rewrite //=.
  intros; exists s; done.
  elim; done.
Qed.

Lemma omap_eq_none {A B} (x : option A) (f : A -> B) :
  x = None <-> omap f x = None.
destruct x; done.
Qed.

Lemma omap_neq_none {A B : eqType} (x : option A) (f : A -> B) :
  (x != None) = (omap f x != None).
  destruct x; done.
Qed.

Lemma obind_eq_non {A B : eqType} (x : option A) (f : A -> option B) :
  reflect (x = None \/ (exists a, x = Some a /\ f a = None)) (obind f x == None).
  apply/(iffP idP).
  case x; rewrite //=.
  move => a; remember (f a) as fa.
  move => hfa; right; exists a; rewrite -Heqfa (eqP hfa) //=.
  move => _; left; done.
  elim.
  move => ->; done.
  elim => a; elim => -> h2 //=; apply/eqP; done.
Qed.

Lemma obind_neq_none {A B : eqType} (x : option A) (f : A -> option B) :
  reflect (exists a b, x = Some a /\ f a = Some b) (obind f x != None).
  apply/(iffP idP).
  case x; rewrite //=.
  move => a; remember (f a) as fa; destruct fa; rewrite //=.
  move => _; exists a, s; done.
  elim => a; elim => b; elim => h1 h2.
  rewrite h1 //=; rewrite h2 //=.
Qed.

Lemma obind_eq_some {A B : eqType} (x : option A) (f : A -> option B) b :
  reflect (exists a, x = Some a /\ f a = Some b) (obind f x == Some b).
  apply/(iffP idP).
  case x; rewrite //=.
  move => a; remember (f a) as fa; destruct fa; rewrite //=.
  move/eqP => heq; injection heq => <-.
  exists a; done.
  elim => a; elim => ->; rewrite //=  => ->; rewrite //=.
Qed.

(* sequence stuff *)

Definition seq_disjoint {A : eqType} (xs ys : seq A) :=
  all (fun x => all (fun y => x != y) ys) xs.

Lemma seq_disjoint_sym {A : eqType} (xs ys : seq A) :
  seq_disjoint xs ys = seq_disjoint ys xs.
  apply Bool.eq_true_iff_eq; split;
  move/allP => H; apply/allP => x Hx; apply/allP => y Hy.
  move/allP: (H _ Hy);move/(_ _ Hx); rewrite eq_sym //=.
  move/allP: (H _ Hy);move/(_ _ Hx); rewrite eq_sym //=.
Qed.

Lemma notin_seq_all {A : eqType} (x : A) xs :
  (x \notin xs) = (all (fun z => x != z) xs).
  induction xs; rewrite //= in_cons negb_or IHxs //=.
Qed.

Lemma in_seq_has {A : eqType} (x : A) xs :
  (x \in xs) = (has (fun z => x == z) xs).
  induction xs; rewrite //=.
  rewrite in_cons IHxs.
  done.
Qed.

Lemma seq_disjointP {A : eqType} (xs ys : seq A) :
  reflect (forall x, x \in xs -> x \notin ys) (seq_disjoint xs ys).
apply/(iffP idP).
move/allP => H x Hx.
rewrite notin_seq_all; apply H; done.

move => H; apply/allP => x Hx; apply/allP => y Hy.
have H2 := H _ Hx; rewrite notin_seq_all in H2; move/allP: H2; move/(_ _ Hy); done.
Qed.

Definition seq_eqmem_dec {A : eqType} (xs ys : seq A) :=
  all (fun x => x \in ys) xs && all (fun y => y \in xs) ys.

Notation "A ==i B" := (seq_eqmem_dec A B) (at level 70).
Notation "A =/i B" := (~~ (A ==i B)) (at level 70).

Lemma seq_eqmemP {A : eqType} (xs ys : seq A) :
  reflect (xs =i ys) (xs ==i ys).
  apply/(iffP idP).
  move/andP; elim.
  move/allP => H1.
  move/allP => H2.
  move => x.
  remember (x \in xs) as b; destruct b; symmetry in Heqb.
  rewrite (H1 _ Heqb); done.
  remember (x \in ys) as b'; destruct b'; symmetry in Heqb'.
  rewrite (H2 _ Heqb') in Heqb; done.
  done.
  move=> H; apply/andP; split.
  apply/allP => x Hx.
  rewrite -H; done.
  apply/allP => X Hx; rewrite H; done.
Qed.

Definition seqD {A : eqType} (xs ys : seq A) :=
  foldr (fun a acc => if a \in ys then acc else a :: acc) nil xs.

Lemma seqDP {A : eqType} (xs ys : seq A) x :
  reflect (x \in xs /\ x \notin ys) (x \in seqD xs ys).
  apply/(iffP idP); induction xs; rewrite //=.
  remember (a \in ys) as b; destruct b; symmetry in Heqb.
  move/IHxs; elim; intros; split.
  rewrite in_cons H orbT //=.
  done.
  rewrite in_cons; move/orP; elim.
  move/eqP => ->.
  split; [rewrite in_cons eq_refl //= | rewrite Heqb //=].
  move/IHxs; elim; intros; split.
  rewrite in_cons H orbT //=.
  done.
  elim; rewrite in_nil //=.

  rewrite in_cons; elim.
  move/orP; elim.
  move/eqP => -> => H.
  remember (a \in ys) as b; destruct b; symmetry in Heqb.
  done.
  rewrite in_cons eq_refl orTb //=.
  intros; destruct (a \in ys).
  apply IHxs; split; done.
  rewrite in_cons IHxs ?orbT //=.
Qed.

Lemma seqD_eqnil {A : eqType} (xs ys : seq A) :
  reflect (forall x, x \in xs -> x \in ys) (seqD xs ys ==  nil).
  apply/(iffP idP).
  induction xs; rewrite //=.
  remember (a \in ys) as b; destruct b.
  move/IHxs => h1 h2.
  rewrite in_cons; move/orP; elim.
  move/eqP => ->; done.
  intros; apply h1; done.
  done.

  move => H; induction xs; rewrite //=.
  remember (a \in ys) as b; destruct b.
  apply IHxs.
  move => x hx; apply H.
  rewrite in_cons hx orbT //=.
  rewrite H in Heqb.
  done.
  rewrite in_cons eq_refl //=.
Qed.

Lemma mem_seqD {A : eqType} (xs ys : seq A) x :
  (x \in seqD xs ys) = ((x \in xs) && (x \notin ys)) .
  apply Bool.eq_true_iff_eq; split => H.
  elim (seqDP _ _ _ H) => -> -> //=.
  apply/seqDP; split; elim (andP H); done.
Qed.

Lemma all2P {X Y : eqType} (s1 : seq X) (s2 : seq Y) (p : X -> Y -> bool) :
  reflect (forall x, x \in s1 -> forall y, y \in s2 -> p x y) (all (fun x => all (fun y => p x y) s2) s1).
  apply/(iffP idP).
  move/allP => H x Hx y Hy.
  move: (allP (H x Hx));move/(_ y Hy); done.

  move => H; apply/allP => x Hx; apply/allP => y Hy; apply H; done.
Qed.

Fixpoint opt_seq_red {A} (s : seq (option A)) :=
  match s with
  | nil => nil
  | (Some x) :: xs => x :: (opt_seq_red xs)
  | (None) :: xs => (opt_seq_red xs)
                      end.

Definition map_dep {A B : eqType} (s : seq A) (p : forall (x : A), x \in s -> B) : seq B :=
  opt_seq_red (map (fun x =>
         match (Sumbool.sumbool_of_bool (x \in s)) with
           | left heq => Some (p x heq)
           | _ => None end) s).

Definition odflt_dep {A B} (p : A -> bool) (f : forall x (H : p x), B) (d : B) (x : A) : B :=
  match (Sumbool.sumbool_of_bool (p x)) with
  | left Heq => f x Heq
  | _ => d
           end.

Lemma odflt_depP {A B} (p : A -> bool) x (f : forall x (H : p x), B) d (H : p x) :
  odflt_dep p f d x = f x H.
rewrite /odflt_dep.
case: (Sumbool.sumbool_of_bool (p x)).
move=> a; have: H = a by apply bool_irrelevance.
move => ->; done.
rewrite H; done.
Qed.

Lemma allpairs_seq1 {A B C : eqType} (xs : seq A) (y : B) (f : A -> B -> C) :
  [seq f a b | a <- xs, b <- [:: y]] = [seq f a y | a <- xs].
  induction xs; rewrite //=.
Qed.

Lemma all_memeq {X : eqType} (s2 s1 : seq X) p :
  s1 =i s2 -> all p s1 = all p s2.
  move => H; apply Bool.eq_true_iff_eq; split; move/allP => H'; apply/allP => x Hx.
  apply H'; rewrite H; done.
  apply H'; rewrite -H; done.
Qed.

Lemma inP {A : eqType} (x : A) (xs : seq A) :
  reflect (List.In x xs) (x \in xs).
  induction xs.
  simpl; rewrite in_nil //=.
  apply/(iffP idP); done.
  simpl.
  rewrite in_cons.
  apply/(iffP orP); elim.
  move/eqP => ->; left; done.
  move/IHxs => H; right; done.
  move => -> ;left ;done.
  move/IHxs => ->; right; done.
Qed.

Ltac split_In :=
  match goal with
    | [ |- List.In _ (_ :: _) -> _] => case; [ move => <- | split_In]
    | [ |- False -> _] => done
    | [ |- _ = _ -> _] => move => <-
    | [ |- _ \/ _ -> _] => case; split_In
                            end.

  Lemma if_neq_None {A : eqType} (b : bool) (m : A) :
    ((if b then Some m else None) != None) = b.
    by case b.
  Qed.

  Lemma if_eq_None {A : eqType} (b : bool) (m : A) :
    ((if b then Some m else None) == None) = ~~b.
    by case b.
  Qed.

  Lemma if_eq_Some {A : eqType} (b : bool) (m m' : A) :
    ((if b then Some m else None) == Some m') = (b && (m == m')).
    by case b.
  Qed.

  Lemma if_neq_Some {A : eqType} (b : bool) (m m' : A) :
    ((if b then Some m else None) != Some m') = (~~ b) || (m != m').
    case b.
    simpl.
    elim (eqVneq m m').
    move => -> //=.
    move => -> //=.
    done.
  Qed.

  Definition fexists {A : finType} (P : A -> bool) := [exists a, P a].
  Lemma fexists_iff {A : finType} (P1 P2 : A -> bool):
        P1 =1 P2 -> fexists P1 = fexists P2.
    rewrite /fexists.
    move => H.
    apply Bool.eq_true_iff_eq; split; move/existsP; elim => x Hx; apply/existsP; exists x; [ rewrite -H | rewrite H]; done.
  Qed.

  Ltac exunder_ l :=
    rewrite -!/(fexists _);
    multimatch goal with
      | |- context [ fexists ?P ] =>
        erewrite (fexists_iff P _); last first; [intros ?; l; reflexivity | idtac]; simpl ; rewrite /fexists
      end.

  Tactic Notation "exunder" tactic(l) := exunder_ l; repeat (exunder_ l).

Lemma caseOn {T} (b : bool) : (b -> T) -> (~~ b -> T) -> T.
  destruct b.
  move/(_ is_true_true).
  done.
  move => _; move/(_ is_true_true); done.
Qed.

Lemma obind_swap {A B C} (o1 : option A) (o2 : option B) (f : A -> B -> option C) :
  o1 >>=o (fun a => o2 >>=o (fun b => f a b)) =
  o2 >>=o (fun b => o1 >>=o (fun a => f a b)).
  destruct o1; destruct o2; done.
Qed.

Ltac caseOn b := apply (caseOn b).

Ltac inj := let H := fresh "H" in let heq := fresh "heq" in
                                  intro H; injection H; intro heq; rewrite ?heq -?heq; clear H heq.

Lemma if_eq_irrel {A} (b : bool) (c e d : A) (p : Prop) :
  (c = d -> p) -> (e = d -> p) -> (if b then c else e) = d -> p.
  intros ; destruct b.
  apply H; done.
  apply H0; done.
Qed.

Lemma ohead_some A (xs : seq A) a : ohead xs = Some a -> exists t, xs = a :: t.
case xs; rewrite //=.
move => a0 l H.
injection H => heq; subst.
exists l; done.
Qed.

Lemma ohead_none A (xs : seq A) : ohead xs = None -> xs = nil.
case xs; rewrite //=.
Qed.

Lemma neqSn (x : nat) :
  (succn x) != x.
  by induction x.
Qed.