Require Import types.
Require Import game.
Require Import List.
Require Import Arith.
Import ListNotations.

Require Import Notations.

Inductive mmove: Set:=
  | mk_mmove: cell -> mark -> mmove.

Definition is_blank (mk: mark): bool :=
  match mk with
    | B => true
    | _ => false
  end.

Definition cell_is_blank (b: board) (c: cell): bool :=
  match b with
    | mk_board m1 m2 m3 m4 m5 m6 m7 m8 m9 =>
        match c with
          | C00 => is_blank m1
          | C01 => is_blank m2
          | C02 => is_blank m3
          | C10 => is_blank m4
          | C11 => is_blank m5
          | C12 => is_blank m6
          | C20 => is_blank m7
          | C21 => is_blank m8
          | C22 => is_blank m9
      end
end.

Definition invalid_board := mk_board O O O O O O O O O.

Definition apply_move_to_board (b: board) (m: mmove): board:=
  match m with
      | mk_mmove c mk => if (cell_is_blank b c) then (mark_board b mk c) else invalid_board
  end.

Fixpoint count_mark (l: list mark) (equality: mark -> bool) : nat :=
  match l with
    | nil => 0
    | h :: t => if equality h then (S (count_mark t equality)) else (count_mark t equality)
  end.

Definition complete (bd: board): Prop:=
  match evaluate_board bd with
      | Xwins | tie => True
      | _ => False
  end.

(* Also need some sort of valid board, which errors if there are more Os than Xs *)

Definition valid_moves (m1 m2: mmove): Prop :=
  match m1, m2 with
    mk_mmove c1 mk1, mk_mmove c2 mk2 =>
      match mk1, mk2 with
        | B, _ | _, B | X, X | O, O => False
        | X, O | O, X =>
          match c1, c2 with
            | C00, C00 | C01, C01 | C02, C02
            | C10, C10 | C11, C11 | C12, C12
            | C20, C20 | C21, C21 | C22, C22 => False
            | _, _ => True
          end
      end
  end.

Definition valid_board_state (brd: board): Prop :=
  match brd with
    | mk_board m1 m2 m3 m4 m5 m6 m7 m8 m9 =>
      let l := [m1;m2;m3;m4;m5;m6;m7;m8;m9] in
        match (beq_nat (count_mark l (mark_eq X)) (count_mark l (mark_eq O))) with
          | true => True
          | false => False
        end
  end.

Inductive safe: board -> Prop:=
  | is_safe: forall (bd: board),  (exists (x: mmove), forall (y: mmove), ((valid_moves x y) /\ (valid_board_state (apply_move_to_board (apply_move_to_board bd x) y))) ->
  ((safe (apply_move_to_board (apply_move_to_board bd x) y)) \/ (safe (apply_move_to_board bd x)))) -> (safe bd)
  | done: forall (bd: board), complete bd -> safe bd.

Theorem init_safe: safe empty_board.
Proof. (* X gets first move *)
apply is_safe. exists (mk_mmove C00 X). intros. inversion H. destruct y. destruct m. simpl in H0.
    inversion H0. simpl in H0. inversion H0. destruct c. simpl in H0. inversion H0. simpl in *.  left.
(* Y goes in 01 *)
apply is_safe. exists (mk_mmove C11 X). intros. inversion H2. destruct y. destruct m.
    simpl in H3. inversion H3. inversion H3. destruct c. inversion H4. inversion H4. simpl in *. left.
apply is_safe. exists (mk_mmove C22 X). intros. inversion H5. destruct y. destruct m. inversion H6.
    inversion H6. destruct c. inversion H7. inversion H7. inversion H7. simpl.  left.
apply done. compute. trivial.  inversion H7. simpl in H7. simpl in *. left.
 apply done. trivial. left.
 apply done. trivial. left.
 apply done. trivial. left.
 apply done. trivial. left.
apply is_safe. exists (mk_mmove C22 X). intros. inversion H5. destruct y. destruct m. inversion H6.
    inversion H6. destruct c. inversion H7. inversion H7. left.
 apply done. trivial. left.
 apply done. trivial. left.
 apply done. trivial. left.
 apply done. trivial. left.
 apply done. trivial. left.
 apply done. trivial. left.
 apply done. trivial. left.
 apply done. trivial. left.
apply is_safe. exists (mk_mmove C22 X). intros. inversion H5. destruct y. destruct m. inversion H6.
    inversion H6. destruct c. inversion H7. inversion H7. left.
 apply done. trivial. left.
 apply done. trivial. left.
 apply done. trivial. left.
 apply done. trivial. left.
 apply done. trivial. left.
 apply done. trivial. left.
 apply done. trivial. left.
apply is_safe. exists (mk_mmove C22 X). intros. inversion H5. destruct y. destruct m. inversion H6.
    inversion H6. destruct c. inversion H7. inversion H7. left.
 apply done. trivial. left.
 apply done. trivial. left.
 apply done. trivial. left.
 apply done. trivial. left.
 apply done. trivial. left.
 apply done. trivial. left.
 apply done. trivial. left.

apply is_safe. exists (mk_mmove C22 X). intros. inversion H5. destruct y. destruct m. inversion H6.
    inversion H6. destruct c. inversion H7. inversion H7. left.
 apply done. trivial. left.
 apply done. trivial. left.
 apply done. trivial. left.
 apply done. trivial. left.
 apply done. trivial. left.
 apply done. trivial. left.
 apply done. trivial. left. simpl in *.

apply is_safe. exists (mk_mmove C10 X). intros. inversion H5. destruct y. destruct m. inversion H6.
    inversion H6. destruct c. inversion H7. inversion H7. simpl. left.
apply is_safe. exists (mk_mmove C20 X). intros. inversion H8. destruct y. destruct m. inversion H9.
    inversion H9. destruct c. inversion H10. inversion H10. simpl. left.
 apply done. trivial. left.
 apply done. trivial. left.
 apply done. trivial. left.
 apply done. trivial. left.
 apply done. trivial. left.
 apply done. trivial. left.
 apply done. trivial. left.
 apply done. trivial. left.
 apply done. trivial. left. simpl in *.

apply is_safe. exists (mk_mmove C20 X). intros. inversion H8. destruct y. destruct m. inversion H9.
    inversion H9. destruct c. inversion H10. inversion H10. left.
 apply done. trivial. left.
 apply done. trivial. left.
 apply done. trivial. left.
 apply done. trivial. left.
 apply done. trivial. left.
 apply done. trivial. left.
 apply done. trivial. left. simpl. simpl in *.

apply is_safe. exists (mk_mmove C12 X). intros. inversion H8. destruct y. destruct m. inversion H9.
    inversion H9. destruct c. inversion H10. inversion H10. simpl in *. left.
 apply done. trivial. left.
 apply done. trivial. left.
 apply done. trivial. left.
 apply done. trivial. left.
 apply done. trivial. left.
 apply done. trivial. left.
 apply done. trivial. left. simpl in *.
apply is_safe. exists (mk_mmove C12 X). intros. inversion H8. destruct y. destruct m. inversion H9.
    inversion H9. destruct c. inversion H10. inversion H10. left.
 apply done. trivial. left.
 apply done. trivial. left.
 apply done. trivial. left.
 apply done. trivial. left.
 apply done. trivial. left.
 apply done. trivial. left.
 apply done. trivial. left. simpl. simpl in *.
apply is_safe. exists (mk_mmove C12 X). intros. inversion H8. destruct y. destruct m. inversion H9.
    inversion H9. destruct c. inversion H10. inversion H10. left.
 apply done. trivial. left.
 apply done. trivial. left.
 apply done. trivial. left.
 apply done. trivial. left.
 apply done. trivial. left.
 apply done. trivial. left.
 apply done. trivial. left. simpl in *.

(* Y goes in 02 *)
apply is_safe. exists (mk_mmove C11 X). intros. inversion H2. destruct y. destruct m.
    inversion H3. inversion H3. destruct c. inversion H4. simpl in *. left.
apply is_safe. exists (mk_mmove C22 X). intros. inversion H5. destruct y. destruct m. inversion H6.
    inversion H6. destruct c. inversion H7. inversion H7. inversion H7. simpl in *. left.
 apply done. trivial. left.
 apply done. trivial. left.
 apply done. trivial. left.
 apply done. trivial. left.
 apply done. trivial. left.
 apply done. trivial. left.
 apply done. trivial. left. simpl in *.
apply is_safe. exists (mk_mmove C22 X). intros. inversion H5. destruct y. destruct m. inversion H6.
    inversion H6. destruct c. inversion H7. simpl in *. left.
 apply done. trivial. left.
simpl in *. inversion H7. inversion H7. inversion H7. simpl in *. left.
 apply done. trivial. left.
 apply done. trivial. left.
 apply done. trivial. left.
 apply done. trivial. left.
 apply done. trivial. left.

apply is_safe. exists (mk_mmove C22 X). intros. inversion H5. destruct y. destruct m. inversion H6.
    inversion H6. destruct c. inversion H7. inversion H7. left.
 apply done. trivial. left. simpl in *. inversion H7. inversion H7. inversion H7. simpl in *. left.
 apply done. trivial. left.
 apply done. trivial. left.
 apply done. trivial. left.
 apply done. trivial. left.
 apply done. trivial. left.
 apply done. trivial. left.
apply is_safe. exists (mk_mmove C22 X). intros. inversion H5. destruct y. destruct m. inversion H6.
    inversion H6. destruct c. inversion H7. inversion H7. simpl in *. left.
 apply done. trivial. left. simpl in *. inversion H7. inversion H7. inversion H7. simpl in *. left.
 apply done. trivial. left.
 apply done. trivial. left.
 apply done. trivial. left.
 apply done. trivial. left.
 apply done. trivial. left.
 apply done. trivial. left. simpl in *.

apply is_safe. exists (mk_mmove C22 X). intros. inversion H5. destruct y. destruct m. inversion H6.
    inversion H6. destruct c. inversion H7. inversion H7. left.
 apply done. trivial. left. inversion H7. inversion H7. inversion H7. simpl in *. left.
 apply done. trivial. left.
 apply done. trivial. left.
 apply done. trivial. left.
 apply done. trivial. left.
 apply done. trivial. left.
 apply done. trivial. left. simpl in *.

apply is_safe. exists (mk_mmove C10 X). intros. inversion H5. destruct y. destruct m. inversion H6.
    inversion H6. destruct c. inversion H7. left.
apply is_safe. exists (mk_mmove C20 X). intros. inversion H8. destruct y. destruct m. inversion H9.
    inversion H9. destruct c. inversion H10. inversion H10. simpl. left.
 apply done. trivial. left. inversion H10. inversion H10. simpl in *.  left.
 apply done. trivial. left.
 apply done. trivial. left.
 apply done. trivial. left.
 apply done. trivial. left.
 apply done. trivial. left.
 apply done. trivial. left.
 apply done. trivial. left. simpl in *.

apply is_safe. exists (mk_mmove C20 X). intros. inversion H8. destruct y. destruct m. inversion H9.
    inversion H9. destruct c. inversion H10. inversion H10. left.
 apply done. trivial. left.
 apply done. trivial. left.
 apply done. trivial. left.
 apply done. trivial. left.
 apply done. trivial. left.
 apply done. trivial. left.
 apply done. trivial. left. simpl. simpl in *. inversion H10. simpl in *. left.

apply is_safe. exists (mk_mmove C12 X). intros. inversion H8. destruct y. destruct m. inversion H9.
    inversion H9. destruct c. inversion H10. inversion H10. simpl in *. left.
 apply done. trivial. left. simpl in *. inversion H10. simpl in *. inversion H10. simpl in *. inversion H10. simpl in *. left.
 inversion H10. simpl in *. inversion H10. simpl in *. left.
 apply done. trivial. left.
 apply done. trivial. left. simpl in *.
apply is_safe. exists (mk_mmove C12 X). intros. inversion H8. destruct y. destruct m. inversion H9.
    inversion H9. destruct c. inversion H10. inversion H10. simpl in *. left.
 apply done. trivial. left. simpl in *. inversion H10. simpl in *. inversion H10. simpl in *. inversion H10. simpl in *. inversion H10. simpl in *.  left.
 apply done. trivial. left.
 apply done. trivial. left.
 apply done. trivial. left.
 apply done. trivial. left. simpl in *.

(* Y goes in 10 *)

apply is_safe. exists (mk_mmove C11 X). intros. inversion H2. destruct y. destruct m.
    inversion H3. inversion H3. destruct c. inversion H4. simpl in *. left.
apply is_safe. exists (mk_mmove C22 X). intros. inversion H5. destruct y. destruct m. inversion H6.
    inversion H6. destruct c. inversion H7. inversion H7. inversion H7. simpl in *. left.
 apply done. trivial. left.
 apply done. trivial. left.
 apply done. trivial. left.
 apply done. trivial. left.
 apply done. trivial. left.
 apply done. trivial. left.
 apply done. trivial. left. simpl in *.
apply is_safe. exists (mk_mmove C22 X). intros. inversion H5. destruct y. destruct m. inversion H6.
    inversion H6. destruct c. inversion H7. simpl in *. left.
 apply done. trivial. left.
simpl in *. inversion H7. inversion H7. inversion H7. simpl in *. left.
 apply done. trivial. left.
 apply done. trivial. left.
 apply done. trivial. left.
 apply done. trivial. left.
 apply done. trivial. left. simpl in *. inversion H4. simpl in *.  left.

apply is_safe. exists (mk_mmove C22 X). intros. inversion H5. destruct y. destruct m. inversion H6.
    inversion H6. destruct c. inversion H7. inversion H7. left.
 apply done. trivial. left. simpl in *.
 apply done. trivial. left.
 apply done. trivial. left.
 apply done. trivial. left.
 apply done. trivial. left.
 apply done. trivial. left.
 apply done. trivial. left. simpl in *. inversion H7. simpl in *. left.
apply is_safe. exists (mk_mmove C22 X). intros. inversion H5. destruct y. destruct m. inversion H6.
    inversion H6. destruct c. inversion H7. inversion H7. simpl in *. left.
 apply done. trivial. left. simpl in *.
 apply done. trivial. left.
 apply done. trivial. left.
 apply done. trivial. left.
 apply done. trivial. left.
 apply done. trivial. left.
 apply done. trivial. left. simpl in *. inversion H6. simpl in *. left.

apply is_safe. exists (mk_mmove C22 X). intros. inversion H5. destruct y. destruct m. inversion H6.
    inversion H6. destruct c. inversion H7. inversion H7. left.
 apply done. trivial. left. inversion H7. inversion H7. inversion H7. simpl in *.
 apply done. trivial. left.
 apply done. trivial. left.
 apply done. trivial. left.
 apply done. trivial. left.
 apply done. trivial. left.
 apply done. trivial. left. simpl in *. inversion H7. simpl in *. left.

apply is_safe. exists (mk_mmove C01 X). intros. inversion H5. destruct y. destruct m. inversion H6.
    inversion H6. destruct c. inversion H7. simpl in *. inversion H7. simpl in *. left.
apply is_safe. exists (mk_mmove C12 X). intros. inversion H8. destruct y. destruct m. inversion H9.
    inversion H9. destruct c. inversion H10. inversion H10. simpl in *. inversion H10. simpl in *. inversion H10. simpl in *. inversion H10. simpl in *. inversion H10. simpl in *. left.
apply is_safe. exists (mk_mmove C21 X). intros. inversion H11. destruct y. destruct m.
    inversion H12. inversion H12. destruct c. inversion H13. inversion H13. inversion H13. inversion H13.
    inversion H13. inversion H13. inversion H13. inversion H13. inversion H13.
    simpl in *.  left.

(* A complete board *)
apply is_safe. exists (mk_mmove C21 X). intros. inversion H11. destruct y. destruct m.
    inversion H12. inversion H12. destruct c. simpl in *. right.
apply done. trivial. simpl in *. left.
apply is_safe. exists (mk_mmove C20 X). intros. inversion H14. destruct y. destruct m. simpl in *.
    inversion H15. inversion H15. destruct c. simpl in *. inversion H16. inversion H16. inversion H16.
    inversion H16. inversion H16.  inversion H16.  inversion H16.  inversion H16.  inversion H16.
    inversion H13.  inversion H13. simpl in *.  right.
apply done. trivial. simpl in *. left.
apply done. trivial. simpl in *. inversion H13. simpl in *. inversion H12. simpl in *. inversion H13.
    simpl in *. inversion H10. simpl in *. inversion H7. inversion H7. simpl in *. left.

apply is_safe. exists (mk_mmove C21 X). intros. inversion H8. destruct y. destruct m. inversion H9.
    inversion H9. destruct c. inversion H10. inversion H10. simpl in *. left.

 apply done. trivial. left.
 apply done. trivial. left.
 apply done. trivial. left.
 apply done. trivial. left.
 apply done. trivial. left.
 apply done. trivial. left.
 apply done. trivial. left. simpl in *.

apply is_safe. exists (mk_mmove C02 X). intros. inversion H8. destruct y. destruct m. inversion H9.
    inversion H9. destruct c. inversion H10. inversion H10. simpl in *. left.
apply done. trivial. left. simpl in *. inversion H10. simpl in *. inversion H10. simpl in *. left.
apply done. trivial. left.
apply done. trivial. left. simpl in *.
apply done. trivial. left. simpl in *.
apply done. trivial. left. simpl in *.
apply is_safe. exists (mk_mmove C02 X). intros. inversion H8. destruct y. destruct m. inversion H9.
    inversion H9. destruct c. inversion H10. inversion H10. simpl in *. left.
apply done. trivial. left. simpl in *. inversion H10. simpl in *. inversion H10. simpl in *. left.
apply done. trivial. left.
apply done. trivial. left. simpl in *.
apply done. trivial. left. simpl in *.
apply done. trivial. left. simpl in *. inversion H7. simpl in *. left.

(* Y goes in 11 *)
apply is_safe. exists (mk_mmove C11 X). intros. inversion H2. destruct y. destruct m.
    inversion H3. inversion H3. destruct c. simpl in *. inversion H4. simpl in *. left.
apply is_safe. exists (mk_mmove C22 X). intros. inversion H5. destruct y. destruct m. inversion H6.
    inversion H6. destruct c. inversion H7. inversion H7. inversion H7. simpl in *. left.
 apply done. trivial. left.
 apply done. trivial. left.
 apply done. trivial. left.
 apply done. trivial. left.
 apply done. trivial. left.
 apply done. trivial. left.
 apply done. trivial. left. simpl in *.
apply is_safe. exists (mk_mmove C22 X). intros. inversion H5. destruct y. destruct m. inversion H6.
    inversion H6. destruct c. inversion H7. simpl in *. left.
 apply done. trivial. left.
simpl in *. inversion H7. inversion H7. inversion H7. simpl in *. left.
 apply done. trivial. left.
 apply done. trivial. left.
 apply done. trivial. left.
 apply done. trivial. left.
 apply done. trivial. left. simpl in *. inversion H4. simpl in *.  left.

apply is_safe. exists (mk_mmove C22 X). intros. inversion H5. destruct y. destruct m. inversion H6.
    inversion H6. destruct c. inversion H7. inversion H7. left.
 apply done. trivial. left. simpl in *.
 apply done. trivial. left.
 apply done. trivial. left.
 apply done. trivial. left.
 apply done. trivial. left.
 apply done. trivial. left.
 apply done. trivial. left. simpl in *. inversion H4. inversion H4. simpl in *. left.

(* Y goes in 12 *)
apply is_safe. exists (mk_mmove C11 X). intros. inversion H2. destruct y. destruct m.
    inversion H3. inversion H3. destruct c. simpl in *. inversion H4. simpl in *. left.
apply is_safe. exists (mk_mmove C22 X). intros. inversion H5. destruct y. destruct m. inversion H6.
    inversion H6. destruct c. inversion H7. inversion H7. inversion H7. simpl in *. left.
 apply done. trivial. left.
 apply done. trivial. left.
 apply done. trivial. left.
 apply done. trivial. left.
 apply done. trivial. left.
 apply done. trivial. left.
 apply done. trivial. left. simpl in *.
apply is_safe. exists (mk_mmove C22 X). intros. inversion H5. destruct y. destruct m. inversion H6.
    inversion H6. destruct c. inversion H7. simpl in *. left.
 apply done. trivial. left.
simpl in *. inversion H7. inversion H7. inversion H7. simpl in *. left.
 apply done. trivial. left. inversion H7. inversion H7. simpl in *. left.
 apply done. trivial. left.
 apply done. trivial. left.
 apply done. trivial. left. simpl in *.

apply is_safe. exists (mk_mmove C22 X). intros. inversion H5. destruct y. destruct m. inversion H6.
    inversion H6. destruct c. inversion H7. inversion H7. left.
 apply done. trivial. left. simpl in *.
 apply done. trivial. left. inversion H7. inversion H7. inversion H7. simpl in *. left.
 apply done. trivial. left.
 apply done. trivial. left. inversion H7. inversion H4. inversion H4. simpl in *. left.

apply is_safe. exists (mk_mmove C22 X). intros. inversion H5. destruct y. destruct m. inversion H6.
    inversion H6. destruct c. inversion H7. inversion H7. left.
 apply done. trivial. left.
 apply done. trivial. left.
 apply done. trivial. left. inversion H7. inversion H7. inversion H7. simpl in *. left.
 apply done. trivial. left. inversion H7. simpl in *. left.

apply is_safe. exists (mk_mmove C22 X). intros. inversion H5. destruct y. destruct m. inversion H6.
    inversion H6. destruct c. inversion H7. inversion H7. left.
 apply done. trivial. left.
 apply done. trivial. left.
 apply done. trivial. left. inversion H7. inversion H7. inversion H7. simpl in *. left.
 apply done. trivial. left. inversion H7. inversion H7. simpl in *. left.

apply is_safe. exists (mk_mmove C02 X). intros. inversion H5. destruct y. destruct m. inversion H6.
    inversion H6. destruct c. inversion H7. inversion H7. left. simpl in *.

apply is_safe. exists (mk_mmove C20 X). intros. inversion H8. destruct y. destruct m. inversion H9.
    inversion H9. destruct c. inversion H10. inversion H10. inversion H10. left. simpl in *.
 apply done. trivial. left.
 apply done. trivial. left.
 apply done. trivial. left. inversion H10. simpl in *. left.
 apply done. trivial. left. inversion H10. inversion H7. simpl in *. left.

apply is_safe. exists (mk_mmove C20 X). intros. inversion H8. destruct y. destruct m. inversion H9.
    inversion H9. destruct c. inversion H10. simpl in *. left.
 apply done. trivial. left.
 apply done. trivial. left.
 apply done. trivial. left. inversion H10. simpl in *. left.
 apply done. trivial. left. inversion H10. simpl in *. left.
 apply done. trivial. left. inversion H10. inversion H7. inversion H7. simpl in *.  left.

apply is_safe. exists (mk_mmove C01 X). intros. inversion H8. destruct y. destruct m. inversion H9.
    inversion H9. destruct c. inversion H10. inversion H10. inversion H10. simpl in *. left.
 apply done. trivial. left. inversion H10. inversion H10. inversion H10. simpl in *. left.
 apply done. trivial. left. inversion H10. simpl in *. left.

apply is_safe. exists (mk_mmove C01 X). intros. inversion H8. destruct y. destruct m. inversion H9.
    inversion H9. destruct c. inversion H10. inversion H10. inversion H10. simpl in *. left.
 apply done. trivial. left. inversion H10. inversion H10. simpl in *. left.
 apply done. trivial. left. inversion H10. inversion H10. inversion H7. simpl in *. left.

(* Y goes in 20 *)
apply is_safe. exists (mk_mmove C11 X). intros. inversion H2. destruct y. destruct m.
    inversion H3. inversion H3. destruct c. inversion H4. simpl in *. left.
apply is_safe. exists (mk_mmove C22 X). intros. inversion H5. destruct y. destruct m. inversion H6.
    inversion H6. destruct c. inversion H7. inversion H7. inversion H7. simpl in *. left.
 apply done. trivial. left.
 apply done. trivial. left.
 apply done. trivial. left.
 apply done. trivial. left.
 apply done. trivial. left.
 apply done. trivial. left.
 apply done. trivial. left. simpl in *.
apply is_safe. exists (mk_mmove C22 X). intros. inversion H5. destruct y. destruct m. inversion H6.
    inversion H6. destruct c. inversion H7. simpl in *. left.
 apply done. trivial. left.
simpl in *. inversion H7. inversion H7. inversion H7. simpl in *. left.
 apply done. trivial. left.
 apply done. trivial. left.
 apply done. trivial. left.
 apply done. trivial. left.
 apply done. trivial. left.

apply is_safe. exists (mk_mmove C22 X). intros. inversion H5. destruct y. destruct m. inversion H6.
    inversion H6. destruct c. inversion H7. inversion H7. left.
 apply done. trivial. left. simpl in *. inversion H7. inversion H7. inversion H7. simpl in *. left.
 apply done. trivial. left.
 apply done. trivial. left.
 apply done. trivial. left. simpl in *.

apply is_safe. exists (mk_mmove C22 X). intros. inversion H5. destruct y. destruct m. inversion H6.
    inversion H6. destruct c. inversion H7. simpl in *. left.
 apply done. trivial. left.
 apply done. trivial. left. inversion H7. inversion H7. simpl in *. left.
 apply done. trivial. left. inversion H7. simpl in *. left.
 apply done. trivial. left. inversion H7. inversion H4. simpl in *. left.

apply is_safe. exists (mk_mmove C22 X). intros. inversion H5. destruct y. destruct m. inversion H6.
    inversion H6. destruct c. inversion H7. left.
 apply done. trivial. left.
 apply done. trivial. left.
 apply done. trivial. left. inversion H7. inversion H7. inversion H7. simpl in *. left.
 apply done. trivial. left. inversion H7. inversion H4. simpl in *. left.

apply is_safe. exists (mk_mmove C22 X). intros. inversion H5. destruct y. destruct m. inversion H6.
    inversion H6. destruct c. inversion H7. left.
 apply done. trivial. left.
 apply done. trivial. left.
 apply done. trivial. left. inversion H7. inversion H7. inversion H7. simpl in *. left.
 apply done. trivial. left. inversion H7. inversion H7. inversion H7. simpl in *. left.

apply is_safe. exists (mk_mmove C21 X). intros. inversion H5. destruct y. destruct m. inversion H6.
    inversion H6. destruct c. inversion H7. left. simpl in *.
apply is_safe. exists (mk_mmove C10 X). intros. inversion H8. destruct y. destruct m. inversion H9.
    inversion H9. destruct c. inversion H10. inversion H10. left. simpl in *.
apply is_safe. exists (mk_mmove C12 X). intros. inversion H11. destruct y. destruct m. inversion H12.
    inversion H12. destruct c. inversion H13. inversion H13. inversion H13. inversion H13.
    inversion H13. inversion H13. inversion H13. inversion H13. inversion H13. inversion H10.
    inversion H10. simpl in *. left.
apply is_safe. exists (mk_mmove C02 X). intros. inversion H11. destruct y. destruct m. inversion H12.
    inversion H12. destruct c. inversion H13. inversion H13. inversion H13. inversion H13.
    inversion H13. inversion H13. inversion H13. inversion H13. inversion H13. inversion H10.
    inversion H10. inversion H10. simpl in *. left.
apply is_safe. exists (mk_mmove C01 X). intros. inversion H8. destruct y. destruct m. inversion H9.
    inversion H9. destruct c. inversion H10. inversion H10. inversion H10. simpl in *. left.
 apply done. trivial. left. inversion H10. simpl in *. left.
 apply done. trivial. inversion H10. inversion H10. inversion H10. simpl in *. left.
apply is_safe. exists (mk_mmove C01 X). intros. inversion H8. destruct y. destruct m. inversion H9.
    inversion H9. destruct c. inversion H10. inversion H10. inversion H10. simpl in *. left.
 apply done. trivial. left. inversion H10. simpl in *. left.
 apply done. trivial. inversion H10. inversion H10. inversion H10. simpl in *. left.
apply done. trivial. inversion H10. inversion H10. inversion H10. inversion H7. simpl in *. left.

apply is_safe. exists (mk_mmove C01 X). intros. inversion H8. destruct y. destruct m. inversion H9.
    inversion H9. destruct c. inversion H10. inversion H10. inversion H10. simpl in *. left.
 apply done. trivial. simpl in *. left.
 apply done. trivial. inversion H10. inversion H10. inversion H10. inversion H10. inversion H10.
     inversion H7. inversion H7. inversion H7. simpl in *. left.

(* Y goes in 21 *)
apply is_safe. exists (mk_mmove C11 X). intros. inversion H2. destruct y. destruct m.
    inversion H3. inversion H3. destruct c. simpl in *. inversion H4. simpl in *. left.
apply is_safe. exists (mk_mmove C22 X). intros. inversion H5. destruct y. destruct m. inversion H6.
    inversion H6. destruct c. inversion H7. inversion H7. inversion H7. simpl in *. left.
 apply done. trivial. left.
 apply done. trivial. left.
 apply done. trivial. left.
 apply done. trivial. left.
 apply done. trivial. left.
 apply done. trivial. left.
 apply done. trivial. left. simpl in *.
apply is_safe. exists (mk_mmove C22 X). intros. inversion H5. destruct y. destruct m. inversion H6.
    inversion H6. destruct c. inversion H7. simpl in *. left.
 apply done. trivial. left.
simpl in *. inversion H7. inversion H7. inversion H7. simpl in *. left.
 apply done. trivial. left. inversion H7. inversion H7. simpl in *. left.
 apply done. trivial. left.
 apply done. trivial. left.
 apply done. trivial. left. simpl in *.

apply is_safe. exists (mk_mmove C22 X). intros. inversion H5. destruct y. destruct m. inversion H6.
    inversion H6. destruct c. inversion H7. inversion H7. left.
 apply done. trivial. left. simpl in *.
 apply done. trivial. left. inversion H7. inversion H7. inversion H7. simpl in *. left.
 apply done. trivial. left.
 apply done. trivial. left.  simpl in *.

apply is_safe. exists (mk_mmove C22 X). intros. inversion H5. destruct y. destruct m. inversion H6.
    inversion H6. destruct c. inversion H7. simpl in *. left.
 apply done. trivial. left.
 apply done. trivial. left. inversion H7. inversion H7. simpl in *. left.
 apply done. trivial. left. simpl in *.
 apply done. trivial. left. inversion H7. inversion H7. inversion H4. simpl in *. left.

apply is_safe. exists (mk_mmove C22 X). intros. inversion H5. destruct y. destruct m. inversion H6.
    inversion H6. destruct c. inversion H7. inversion H7. left.
 apply done. trivial. left.
 apply done. trivial. left.
 apply done. trivial. left. inversion H7. inversion H7. inversion H7. simpl in *. left.
 apply done. trivial. left. inversion H7. inversion H7. simpl in *. left.

apply is_safe. exists (mk_mmove C22 X). intros. inversion H5. destruct y. destruct m. inversion H6.
    inversion H6. destruct c. inversion H7. inversion H7. left.
 apply done. trivial. left.
 apply done. trivial. left.
 apply done. trivial. left. inversion H7. inversion H7. inversion H7. simpl in *. left.
 apply done. trivial. left. inversion H7. inversion H7. inversion H7. inversion H4. simpl in *. left.

apply is_safe. exists (mk_mmove C20 X). intros. inversion H5. destruct y. destruct m. inversion H6.
    inversion H6. destruct c. inversion H7. inversion H7. left. simpl in *.

apply is_safe. exists (mk_mmove C20 X). intros. inversion H8. destruct y. destruct m. inversion H9.
    inversion H9. destruct c. inversion H10. inversion H10. inversion H10. left. simpl in *.
 apply done. trivial. left.
 apply done. trivial. left.
 apply done. trivial. left. inversion H10. simpl in *. left.
 apply done. trivial. left. inversion H10. inversion H7. simpl in *. left.

apply is_safe. exists (mk_mmove C12 X). intros. inversion H8. destruct y. destruct m. inversion H9.
    inversion H9. destruct c. inversion H10. simpl in *. left.

apply is_safe. exists (mk_mmove C10 X). intros. inversion H11. destruct y. destruct m. inversion H12.
    inversion H12. destruct c. inversion H13. inversion H13. inversion H13. simpl in *. left.
 apply done. trivial. left. inversion H13. inversion H13. inversion H13. simpl in *. left.
 apply done. trivial. left. inversion H13. inversion H10. simpl in *. left.

apply is_safe. exists (mk_mmove C01 X). intros. inversion H11. destruct y. destruct m. inversion H12.
    inversion H12. destruct c. inversion H13. inversion H13. inversion H13. simpl in *. left.
 apply done. trivial. left. inversion H13. inversion H13. inversion H13. simpl in *. left.
 apply done. trivial. left. inversion H13. inversion H10. inversion H10. inversion H10.
     inversion H10. inversion H10. simpl in *. left.

apply is_safe. exists (mk_mmove C02 X). intros. inversion H8. destruct y. destruct m. inversion H9.
    inversion H9. destruct c. inversion H10. inversion H10. inversion H10. simpl in *. left.
 apply done. trivial. inversion H10. inversion H10. inversion H10. simpl in *. left.
 apply done. trivial. inversion H10. inversion H10. inversion H10. inversion H7. simpl in *. left.

apply is_safe. exists (mk_mmove C02 X). intros. inversion H8. destruct y. destruct m. inversion H9.
    inversion H9. destruct c. inversion H10. inversion H10. inversion H10. simpl in *. left.
 apply done. trivial. inversion H10. simpl in *. left.
 apply done. trivial. inversion H10. inversion H10. inversion H10. inversion H10. inversion H10.
     inversion H7. inversion H7. inversion H7. simpl in *. left.

(* Y goes in 22 *)

apply is_safe. exists (mk_mmove C11 X). intros. inversion H2. destruct y. destruct m.
    inversion H3. inversion H3. destruct c. simpl in *. inversion H4. simpl in *. left.
apply is_safe. exists (mk_mmove C22 X). intros. inversion H5. destruct y. destruct m. inversion H6.
    inversion H6. destruct c. inversion H7. inversion H7. inversion H7. simpl in *. left.
 apply done. trivial. left.
 apply done. trivial. left.
 apply done. trivial. left.
 apply done. trivial. left.
 apply done. trivial. left.
 apply done. trivial. left. simpl in *.

apply is_safe. exists (mk_mmove C12 X). intros. inversion H5. destruct y. destruct m. inversion H6.
    inversion H6. destruct c. inversion H7. inversion H7. left. simpl in *.

apply is_safe. exists (mk_mmove C10 X). intros. inversion H8. destruct y. destruct m. inversion H9.
    inversion H9. destruct c. inversion H10. inversion H10. inversion H10. inversion H10. inversion H10.
    inversion H10. simpl in *. left.
 apply done. trivial. left.
 apply done. trivial. left. inversion H10. inversion H7. simpl in *. left.

apply is_safe. exists (mk_mmove C21 X). intros. inversion H8. destruct y. destruct m. inversion H9.
    inversion H9. destruct c. inversion H10. simpl in *. left.

apply is_safe. exists (mk_mmove C20 X). intros. inversion H11. destruct y. destruct m. inversion H12.
    inversion H12. destruct c. inversion H13. inversion H13. inversion H13. inversion H13.
    inversion H13. inversion H13. inversion H13. inversion H13. inversion H13. inversion H10.
    inversion H10. inversion H10. inversion H10. simpl in *. left.

apply is_safe. exists (mk_mmove C01 X). intros. inversion H11. destruct y. destruct m. inversion H12.
    inversion H12. destruct c. inversion H13. inversion H13. inversion H13. simpl in *. left.
 apply done. trivial. left. inversion H13. inversion H13. inversion H13. simpl in *. left.
 apply done. trivial. left. inversion H13. inversion H10. inversion H10. inversion H7. inversion H7.
     simpl in *. left.

apply is_safe. exists (mk_mmove C10 X). intros. inversion H8. destruct y. destruct m. inversion H9.
    inversion H9. destruct c. inversion H10. inversion H10. inversion H10. simpl in *. left.
 apply done. trivial. inversion H10. inversion H10. inversion H10. simpl in *. left.
 apply done. trivial. inversion H10. inversion H10. inversion H10. inversion H7. simpl in *. left.
apply done. trivial. inversion H10. simpl in *. left.

apply is_safe. exists (mk_mmove C10 X). intros. inversion H8. destruct y. destruct m. inversion H9.
    inversion H9. destruct c. inversion H10. inversion H10. inversion H10. simpl in *. left.
 apply done. trivial. inversion H10. inversion H10. inversion H10. simpl in *. left.
 apply done. trivial. inversion H10. inversion H10. inversion H10. inversion H7. simpl in *. left.
apply done. trivial. inversion H10.  inversion H10. inversion H7. simpl in *. left.

apply is_safe. exists (mk_mmove C01 X). intros. inversion H5. destruct y. destruct m. inversion H6.
    inversion H6. destruct c. inversion H7. inversion H7. simpl in *. left.

apply is_safe. exists (mk_mmove C21 X). intros. inversion H8. destruct y. destruct m. inversion H9.
    inversion H9. destruct c. inversion H10. inversion H10. inversion H10. inversion H10.
    inversion H10. simpl in *. left.
apply done. trivial. left.
apply done. simpl. trivial. inversion H10. inversion H10. inversion H7. inversion H7. simpl in *. left.

apply is_safe. exists (mk_mmove C21 X). intros. inversion H8. destruct y. destruct m. inversion H9.
    inversion H9. destruct c. inversion H10. inversion H10. inversion H10. inversion H10.
    inversion H10. simpl in *. left.
apply done. trivial. left.
apply done. simpl. trivial. inversion H10. inversion H10. inversion H7. inversion H7. simpl in *. left.
apply done. trivial. inversion H10. inversion H10. simpl in *. left.

apply is_safe. exists (mk_mmove C21 X). intros. inversion H8. destruct y. destruct m. inversion H9.
    inversion H9. destruct c. inversion H10. inversion H10. inversion H10. inversion H10.
    inversion H10. simpl in *. left.
apply done. trivial. left.
apply done. simpl. trivial. inversion H10. inversion H10. inversion H7. inversion H7. simpl in *. left.
apply done. trivial. inversion H10. inversion H10. inversion H10.  simpl in *. left.

apply is_safe. exists (mk_mmove C20 X). intros. inversion H8. destruct y. destruct m. inversion H9.
    inversion H9. destruct c. inversion H10. inversion H10. inversion H10. inversion H10.
    inversion H10. simpl in *. left.
apply is_safe. exists (mk_mmove C12 X). intros. inversion H11. destruct y. destruct m. inversion H12.
    inversion H12. destruct c. inversion H13. inversion H13. inversion H13. inversion H13.
    inversion H13. inversion H13. inversion H13. inversion H13. inversion H13. inversion H10.
    inversion H10. simpl in *. left.

apply is_safe. exists (mk_mmove C02 X). intros. inversion H11. destruct y. destruct m. inversion H12.
    inversion H12. destruct c. simpl in *.  inversion H13. inversion H13. inversion H13. inversion H13.
    inversion H13. inversion H13. inversion H13. inversion H13. inversion H13. inversion H10.
    inversion H10. inversion H10. inversion H7. inversion H4. simpl in *. left.

apply is_safe. exists (mk_mmove C01 X). intros. inversion H5. destruct y. destruct m. inversion H6.
    inversion H6. destruct c. inversion H7. inversion H7. simpl in *. left.

apply is_safe. exists (mk_mmove C21 X). intros. inversion H8. destruct y. destruct m. inversion H9.
    inversion H9. destruct c. inversion H10. inversion H10. inversion H10. inversion H10.
    inversion H10. simpl in *. left.
apply done. trivial. left.
apply done. simpl. trivial. inversion H10. inversion H10. inversion H7. inversion H7. simpl in *. left.

apply is_safe. exists (mk_mmove C21 X). intros. inversion H11. destruct y. destruct m. inversion H12.
    inversion H12. destruct c. inversion H13. inversion H13. inversion H13. inversion H13. inversion H13.
    inversion H13. inversion H13. inversion H13. inversion H13. inversion H10. inversion H10.
    simpl in *. left.

apply is_safe. exists (mk_mmove C21 X). intros. inversion H8. destruct y. destruct m. inversion H9.
    inversion H9. destruct c. inversion H10. inversion H10. inversion H10. inversion H10.
    inversion H10. simpl in *. left.
apply done. trivial. inversion H10. inversion H10. inversion H10. simpl in *. left.
apply done. trivial. inversion H10. inversion H10. inversion H7. inversion H7. simpl in *. left.
apply is_safe. exists (mk_mmove C21 X). intros. inversion H8. destruct y. destruct m. inversion H9.
    inversion H9. destruct c. inversion H10. inversion H10. inversion H10. inversion H10.
    inversion H10. simpl in *. left.
apply done. trivial. inversion H10. inversion H10. inversion H10. simpl in *. left.
apply done. trivial. inversion H10. inversion H10. inversion H10. inversion H10. inversion H10.
    simpl in *. left.
apply is_safe. exists (mk_mmove C02 X). intros. inversion H8. destruct y. destruct m. inversion H9.
    inversion H9. destruct c. inversion H10. inversion H10. inversion H10. inversion H10.
    inversion H10. simpl in *. left.

apply done. trivial. inversion H10. inversion H10. simpl in *. left.
apply done. trivial. inversion H10. inversion H10. inversion H7. simpl in *. left.

apply is_safe. exists (mk_mmove C21 X). intros. inversion H5. destruct y. destruct m. inversion H6.
    inversion H6. destruct c. inversion H7. simpl in *. left.
apply is_safe. exists (mk_mmove C10 X). intros. inversion H8. destruct y. destruct m. inversion H9.
    inversion H9. destruct c. inversion H10. inversion H10. inversion H10. inversion H10.
    inversion H10. simpl in *. left.

apply is_safe. exists (mk_mmove C12 X). intros. inversion H11. destruct y. destruct m. inversion H12.
    inversion H12. destruct c. simpl in *.  inversion H13. inversion H13. inversion H13. inversion H13.
    inversion H13. inversion H13. inversion H13. inversion H13. inversion H13. inversion H10.
    inversion H10. inversion H10. inversion H7. inversion H4. simpl in *. left.

apply is_safe. exists (mk_mmove C02 X). intros. inversion H11. destruct y. destruct m. inversion H12.
    inversion H12. destruct c. simpl in *.  inversion H13. inversion H13. inversion H13. inversion H13.
    inversion H13. inversion H13. inversion H13. inversion H13. inversion H13. inversion H10.
    inversion H10. inversion H10. inversion H7. inversion H4. simpl in *. left.

apply is_safe. exists (mk_mmove C01 X). intros. inversion H8. destruct y. destruct m. inversion H9.
    inversion H9. destruct c. inversion H10. inversion H10. inversion H10. inversion H10.
    inversion H10. simpl in *. left.
apply done. trivial. inversion H10. simpl in *. left.
apply done. trivial. inversion H10. inversion H10. inversion H10. simpl in *. left.
apply is_safe. exists (mk_mmove C01 X). intros. inversion H8. destruct y. destruct m. inversion H9.
    inversion H9. destruct c. inversion H10. inversion H10. inversion H10. inversion H10.
    inversion H10. simpl in *. left.
apply done. trivial. inversion H10. inversion H10. simpl in *. left.
apply done. trivial. inversion H10. inversion H10. inversion H10. inversion H7. simpl in *. left.
apply is_safe. exists (mk_mmove C01 X). intros. inversion H8. destruct y. destruct m. inversion H9.
    inversion H9. destruct c. inversion H10. inversion H10. inversion H10. inversion H10.
    inversion H10. simpl in *. left.
apply done. trivial. left.
apply done. trivial. inversion H10. inversion H10. inversion H10. inversion H10. inversion H10.
    inversion H7. inversion H7. inversion H7. simpl in *. left.

apply is_safe. exists (mk_mmove C20 X). intros. inversion H5. destruct y. destruct m. inversion H6.
    inversion H6. destruct c. inversion H7. simpl in *. left.
apply is_safe. exists (mk_mmove C02 X). intros. inversion H8. destruct y. destruct m. inversion H9.
    inversion H9. destruct c. inversion H10. inversion H10. inversion H10. inversion H10.
    inversion H10. simpl in *. left.
apply done. trivial. left.
apply done. trivial. left.
apply done. trivial. left.
apply done. trivial. left.
apply done. trivial. left.
apply done. trivial. left. simpl in *.

apply is_safe. exists (mk_mmove C10 X). intros. inversion H8. destruct y. destruct m. inversion H9.
    inversion H9. destruct c. inversion H10. inversion H10. inversion H10. inversion H10.
    inversion H10. simpl in *. left.
apply is_safe. exists (mk_mmove C12 X). intros. inversion H11. destruct y. destruct m. inversion H12.
    inversion H12. destruct c. simpl in *.  inversion H13. inversion H13. inversion H13. inversion H13.
    inversion H13. inversion H13. inversion H13. inversion H13. inversion H13. inversion H10.
    inversion H10. inversion H10. inversion H7. inversion H4. simpl in *. left.
apply is_safe. exists (mk_mmove C01 X). intros. inversion H11. destruct y. destruct m. inversion H12.
    inversion H12. destruct c. inversion H13. inversion H13. inversion H13. inversion H13.
    inversion H13. inversion H13. inversion H13. inversion H13. inversion H13. inversion H10.
    inversion H10. inversion H10. simpl in *. left. simpl in *.

apply is_safe. exists (mk_mmove C02 X). intros. inversion H8. destruct y. destruct m. inversion H9.
    inversion H9. destruct c. inversion H10. inversion H10. inversion H10. inversion H10.
    inversion H10. simpl in *. left.
apply done. trivial. inversion H10. inversion H10. inversion H10. simpl in *. left.
apply done. trivial. inversion H10. inversion H10. inversion H10. inversion H7. simpl in *. left.
apply is_safe. exists (mk_mmove C02 X). intros. inversion H8. destruct y. destruct m. inversion H9.
    inversion H9. destruct c. inversion H10. inversion H10. inversion H10. inversion H10.
    inversion H10. simpl in *. left.
apply done. trivial. inversion H10. inversion H10. inversion H10. simpl in *. left.
apply done. trivial. inversion H10. inversion H10. inversion H10. inversion H10. inversion H10.
    inversion H7. inversion H7. inversion H7. inversion H4.
Qed.


(** * Enumeracje *)

(** Zdefiniuj typ reprezentujący dni tygodnia. *)
Inductive Day : Type := Mon | Tue | Wed | Thu | Fri | Sat | Sun.

(** Zdefiniuj typ reprezentujący miesiące roku. *)
Inductive Month : Type :=
  Jan | Feb | Mar | Apr | May | Jun | Jul | Aug | Sep | Oct | Nov | Dec.

(** Zdefiniuj typ reprezentujący kolory podstawowe. *)
Inductive RGB : Type := R | G | B.

(** Zdefiniuj typ reprezentujący kolory podstawowe + kanał alfa. *)
Fail Inductive RGBA : Type := R | G | B | A.

(** Zdefiniuj typ reprezentujący uniksowe uprawnienia dostępu. *)
Fail Inductive UnixAcess : Type := R | W | X.

(** Zdefiniuj typ reprezentujący różę kierunków (z 4 kierunkami). *)
(*Inductive Dir : Type := N | S | E | W.*)

(** Zdefiniuj typ reprezentujący logikę trójwartościową. *)
(*Inductive bool3 : Type := false | unknown | true.*)

(** * Parametry *)

(** Zdefiniuj spójniki logiczne i inne podstawowe rzeczy. *)

Inductive False : Prop := .

Inductive True : Prop :=
| I : True.

Inductive and (P Q : Prop) : Prop :=
| conj : P -> Q -> and P Q.

Inductive or (P Q : Prop) : Prop :=
| or_introl : P -> or P Q
| or_intror : Q -> or P Q.

Inductive ex (A : Type) (P : A -> Prop) : Prop :=
| ex_intro : forall x : A, P x -> ex A P.

Inductive Empty : Type := .

Inductive unit : Type :=
| tt : unit.

Inductive prod (A B : Type) : Type :=
| pair : A -> B -> prod A B.

Inductive sum (A B : Type) : Type :=
| inl : A -> sum A B
| inr : B -> sum A B.

Inductive sig (A : Type) (P : A -> Prop) : Type :=
| exist : forall x : A, P x -> sig A P.

Inductive sigT (A : Type) (P : A -> Type) : Type :=
| existT : forall x : A, P x -> sigT A P.

(** * Typy algebraiczne *)

(** Zdefiniuj typ opcji na [A]. *)

Inductive option (A : Type) : Type :=
| None : option A
| Some : A -> option A.

(** Podefiniuj co trzeba dla list. *)
(*
Inductive Elem {A : Type} (x : A) : list A -> list A -> Prop :=
Inductive NoDup {A : Type} : list A -> Prop :=
Inductive Dup {A : Type} : list A -> Prop :=
Inductive Rep {A : Type} (x : A) : nat -> list A -> Prop :=
Inductive Exists {A : Type} (P : A -> Prop) : list A -> Prop :=
Inductive Forall {A : Type} (P : A -> Prop) : list A -> Prop :=
Inductive AtLeast {A : Type} (P : A -> Prop) : nat -> list A -> Prop :=
Inductive Exactly {A : Type} (P : A -> Prop) : nat -> list A -> Prop :=
Inductive AtMost  {A : Type} (P : A -> Prop) : nat -> list A -> Prop :=
Inductive Sublist {A : Type} : list A -> list A -> Prop :=
Inductive Prefix {A : Type} : list A -> list A -> Prop :=
Inductive Suffix {A : Type} : list A -> list A -> Prop :=
Inductive Subseq {A : Type} : list A -> list A -> Prop :=
Inductive Permutation {A : Type} : list A -> list A -> Prop :=
Inductive Cycle {A : Type} : list A -> list A -> Prop :=
Inductive Palindrome {A : Type} : list A -> Prop :=
*)

(** Zdefiniuj typ list niepustych, które trzymają elementy typu [A]. Potem
    zdefiniuj dla nich wszystkie te użyteczne rzeczy co dla list. *)

Inductive nel (A : Type) : Type :=
| singl : A -> nel A
| cons : A -> nel A -> nel A.

(** Zdefiniuj typ niepustych drzew binarnych, które trzymają wartości typu [A] jedynie
    w liściach. *)

Inductive RBTree (A : Type) : Type :=
| Leaf : A -> RBTree A
| Node : RBTree A -> RBTree A -> RBTree A.

(** Zdefiniuj typ niepustych drzew o skończonej ilości synów, które trzymają
    wartości typu [A] w liściach. *)

Fail Inductive RFinTree (A : Type) : Type :=
| Leaf : A -> RFinTree A
| Node : list (RFinTree A) -> RFinTree A.

(** Zdefiniuj typ drzew binarnych, które trzymają elementy typu [A]. *)

Fail Inductive BTree (A : Type) : Type :=
| Empty : BTree A
| Node : A -> BTree A -> BTree A -> BTree A.

(** Zdefiniuj typ drzew o skończonej ilości synów, które trzymają elementy
    typu [A]. *)

Fail Inductive Tree (A : Type) : Type :=
| Empty : Tree A
| Node : list (Tree A) -> Tree A.

(** Zdefiniuj typ drzew o dowolnej ilości synów, które trzymają elementy
    typu [A]. *)

Fail Inductive InfTree (A : Type) : Type :=
| Empty : InfTree A
| Node : forall (B : Type), (B -> InfTree A) -> InfTree A.

(** Zdefiniuj typ drzew trzymających elementy typu [A], których rozgałęzienie
    jest wyznaczone przez parametr [B : Type]. *)

Fail Inductive InfTree' (B A : Type) : Type :=
| Empty : InfTree' B A
| Node : (B -> InfTree' B A) -> InfTree' B A.

(** * Indeksy - predykaty i relacje *)

(** Zdefiniuj predykaty [even] i [odd]. *)
(*Inductive even : nat -> Prop :=*)

(** Zdefiniuj relację [<=] dla liczb naturalnych i to na dwa różne sposoby. *)

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

Fail Inductive le : nat -> nat -> Prop :=
| le_0 : forall n : nat, le 0 n
| le_S_S : forall n m : nat, le n m -> le (S n) (S m).

(** * Indeksy - typy *)

(** Zdefiniuj rodzinę typów [Fin : nat -> Type], gdzie [Fin n] jest typem o
    [n] elementach. *)
Inductive Fin : nat -> Type :=
| FZ : forall n : nat, Fin (S n)
| FS : forall n : nat, Fin n -> Fin (S n).

(** Zdefiniuj typ reprezentujący datę (dla uproszczenia, niech zaczyna się
    od 1 stycznia 1970. *)

Fixpoint isGapYear (n : nat) : bool :=
match n with
| 0 => false
| 1 => false
| 2 => true
| 3 => false
| S (S (S (S n'))) => isGapYear n'
end.

Definition dayInMonth (gap : bool) (m : Month) : Type :=
match m with
| Jan | Apr | Jun | Sep | Nov => Fin 30
| Feb => if gap then Fin 28 else Fin 29
| Mar | May | Jul | Aug | Oct | Dec => Fin 31
end.

Definition Date : Type :=
  {year : nat & {month : Month & dayInMonth (isGapYear year) month}}.

(** Zdefiniuj typ list indeksowanych długością. *)
Inductive vec (A : Type) : nat -> Type :=
| vnil : vec A 0
| vcons : A -> forall {n : nat}, vec A n -> vec A (S n).

(** Zdefiniuj predykat należenia dla [vec]. *)
(*Inductive elem {A : Type} : A -> forall n : nat, vec A n -> Prop :=*)

(** Zdefiniuj typ list indeksowanych przez minimalny/maksymalny element. *)

Inductive minlist {A : Type} (R : A -> A -> Prop) : A -> Type :=
| msingl : forall x : A, minlist R x
| mcons_le :
    forall {min : A} (x : A), R x min -> minlist R min -> minlist R x
| mcons_gt :
    forall {min : A} (x : A), ~ R x min -> minlist R min -> minlist R min.

(** Zdefiniuj typ list indeksowanych przez dowolny monoid. *)

(** Zdefiniuj typ drzew binarnych trzymających elementy w węzłach, które są
    indeksowane wysokością. *)

Inductive hBTree (A : Type) : nat -> Type :=
| hEmpty : hBTree A 0
| hNode :
    A -> forall {n m : nat},
      hBTree A n -> hBTree A m -> hBTree A (S (max n m)).

(** Zdefiniuj typ list, które mogą trzymać wartości różnych typów.
    Typ każdego elementu listy nie jest jednak dowolny - jest on
    zdeterminowany przez indeks, pod którym element ten występuje
    na liście. *)

Inductive DepList (P : nat -> Type) : nat -> Type :=
| dnil : DepList P 0
| dcons : forall {n : nat}, P n -> DepList P n -> DepList P (S n).

Definition P (n : nat) : Type :=
match n with
| 0 => bool
| 1 => Set
| 2 => nat
| _ => Type
end.

Goal DepList P 4.
Proof.
  constructor.
  cbn. exact Set.
  constructor.
  cbn. exact 42.
  constructor.
  cbn. exact nat.
  constructor.
  cbn. exact true.
  constructor.
Qed.

(** * Predykat i relacje dla koinduktywnych pierdółek. *)

(** Zdefniuj predykat [Finite], [Infinite], [Exists], [All] dla kolist. *)
(*
Inductive Finite {A : Type} : coList A -> Prop :=
Inductive Exists {A : Type} (P : A -> Prop) : coList A -> Prop :=
*)

(** Jakieś inne. *)
(*
Inductive Finite : conat -> Prop :=

Inductive EBTree (A : Type) : nat -> Type :=
Inductive HBTree : Type :=
Inductive EHBTree : nat -> Type :=

Inductive sorted {A : Type} (R : A -> A -> Prop) : list A -> Prop :=
Inductive BHeap {A : Type} (R : A -> A -> Prop) : Type :=
Inductive BST {A : Type} (R : A -> A -> Prop) : Type :=
Inductive slist {A : Type} (R : A -> A -> bool) : Type :=
Inductive BHeap {A : Type} (R : A -> A -> bool) : Type :=

Inductive subterm_nat : nat -> nat -> Prop :=
Inductive subterm_list {A : Type} : list A -> list A -> Prop :=
Inductive subterm_nat_base : nat -> nat -> Prop :=
Inductive subterm_list_base {A : Type} : list A -> list A -> Prop :=
*)

(** Zdefiniuj różne użyteczne relacje dla strumieni, m. in. [Exists], [All],
    [Prefix], [Suffix], [Permutation] etc. *)

(*
Inductive Suffix {A : Type} : Stream A -> Stream A -> Prop :=
Inductive Permutation {A : Type} : Stream A -> Stream A -> Prop :=
*)


(*
Copyright © 2009 Valentin Blot

Permission is hereby granted, free of charge, to any person obtaining a copy of
this proof and associated documentation files (the "Proof"), to deal in
the Proof without restriction, including without limitation the rights to
use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of
the Proof, and to permit persons to whom the Proof is furnished to do so,
subject to the following conditions:

The above copyright notice and this permission notice shall be included in all
copies or substantial portions of the Proof.

THE PROOF IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS
FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR
COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER
IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN
CONNECTION WITH THE PROOF OR THE USE OR OTHER DEALINGS IN THE PROOF.
*)

Require Import Coq.Setoids.Setoid Coq.Classes.Morphisms.
Notation " x === y " := (Equivalence.equiv x y) (at level 70, no associativity).

Set Implicit Arguments.
Unset Strict Implicit.

Section Definitions.

Definition unop (R : Type) := R -> R.
Definition binop (R : Type) := R -> R -> R.
Context {R : Type}.
Class unop_intern (P : R -> Type) (op : unop R) :=
  unop_int : forall x : R, P x -> P (op x).
Class binop_intern (P : R -> Type) (op : binop R) :=
  binop_int : forall x y : R, P x -> P y -> P (op x y).
Context `{r_st : Equivalence R}.

Class associative (op : binop R) :=
  assoc : forall x y z, op x (op y z) === op (op x y) z.
Class commutative (op : binop R) :=
  commut : forall x y, op x y === op y x.
Class left_commutative (op : binop R) :=
  left_commut : forall x y z, op x (op y z) === op y (op x z).
Class right_commutative (op : binop R) :=
  right_commut : forall x y z, op (op x y) z === op (op x z) y.

Class left_unit (op : binop R) (idm : R) :=
  left_id : forall x, op idm x === x.
Class right_unit (op : binop R) (idm : R) :=
  right_id : forall x, op x idm === x.
Class left_absorbing (op : binop R) (idm : R) :=
  left_zero : forall x, op idm x === idm.
Class right_absorbing (op : binop R) (idm : R) :=
  right_zero : forall x, op x idm === idm.

Class left_distributive (op mul : binop R) :=
  left_dist : forall x y z, mul (op x y) z === op (mul x z) (mul y z).
Class right_distributive (op mul : binop R) :=
  right_dist : forall x y z, mul x (op y z) === op (mul x y) (mul x z).

Class left_inverse (op : binop R) (idm : R) (inv : unop R) :=
  left_inv : forall x, op x (inv x) === idm.
Class right_inverse (op : binop R) (idm : R) (inv : unop R) :=
  right_inv : forall x, op (inv x) x === idm.

End Definitions.

Section Commutative.
(*
Class monoid `{r_st : Equivalence R req}:=
{mul :> binop R
;mulC : commutative mul}.*)
Context `{r_st : Equivalence}.
Context {mul : binop A} {mulC : commutative mul}.
Global Instance mulC_id_l {idm : A} {H : left_unit mul idm} : right_unit mul idm.
Proof. reduce; rewrite commut; apply left_id. Qed.
Global Instance mulC_id_r {idm : A} {H : right_unit mul idm} : left_unit mul idm.
Proof. reduce; rewrite commut; apply right_id. Qed.
Global Instance mulC_zero_l {zero : A} {H : left_absorbing mul zero} : right_absorbing mul zero.
Proof. reduce; rewrite commut; apply left_zero. Qed.
Global Instance mulC_zero_r {zero : A} {H : right_absorbing mul zero} : left_absorbing mul zero.
Proof. reduce; rewrite commut; apply right_zero. Qed.
Global Instance mulC_inv_l {idm : A} {inv : unop A} {H : left_inverse mul idm inv} : right_inverse mul idm inv.
Proof. reduce; rewrite commut; apply left_inv. Qed.
Global Instance mulC_inv_r {idm : A} {inv : unop A} {H : right_inverse mul idm inv} : left_inverse mul idm inv.
Proof. reduce; rewrite commut; apply right_inv. Qed.

Section distributivity.
Context {op : binop A}.
Context {op_morph : Proper (Equivalence.equiv==>Equivalence.equiv==>Equivalence.equiv) op}.
Global Instance mulC_distr_l {H : left_distributive op mul} : right_distributive op mul.
Proof. intros x y z; rewrite -> (commut x (op _ _)), -> (commut x y), -> (commut x z); apply left_dist. Qed.
Global Instance mulC_distr_r {H : right_distributive op mul} : left_distributive op mul.
Proof. intros x y z; rewrite -> (commut (op _ _) z), -> (commut x z), -> (commut y z); apply right_dist. Qed.
End distributivity.

Section Associativity.
Context {mul_morph : Proper (Equivalence.equiv==>Equivalence.equiv==>Equivalence.equiv) mul}.
Context {mulA : associative mul}.
Global Instance mulAC_comm_l : left_commutative mul.
Proof. intros x y z; rewrite -> assoc, assoc, (commut x y); reflexivity. Qed.
Global Instance mulAC_comm_r : right_commutative mul.
Proof. intros x y z; rewrite <- assoc, <- assoc, (commut y z); reflexivity. Qed.
End Associativity.

End Commutative.

Section AssociativeCommutative.
Context `{r_st : Equivalence}.
Context {add mul : binop A} {opp : unop A} {zero : A}.
Context {add_morph : Proper (Equivalence.equiv==>Equivalence.equiv==>Equivalence.equiv) add}.
Context {mul_morph : Proper (Equivalence.equiv==>Equivalence.equiv==>Equivalence.equiv) mul}.
Context {opA : associative add}.
Context {opC : commutative add}.
Section Left.
Context {l_inv : left_inverse add zero opp}.
Context {op_id : left_unit add zero}.
Context {l_d : left_distributive add mul}.

(* Sinon ca marche pas... *)
Existing Instance mulC_id_l.

Global Instance opA_zero_l : left_absorbing mul zero.
Proof.
 intro; rewrite <- (left_id (mul _ _)); rewrite <- (left_id zero) at 3.
 set (e := left_inv (mul zero x)); rewrite <- e at 1 3; clear e.
 rewrite -> (commut (mul _ _)), <- assoc, <-assoc; apply add_morph; try reflexivity.
 rewrite <- left_dist, (left_id zero), (right_id (mul _ _)); reflexivity.
Qed.
End Left.
Section Right.
Context {r_inv : right_inverse add zero opp}.
Context {op_id : right_unit add zero}.
Context {r_d : right_distributive add mul}.

(* Sinon ca marche pas... *)
Existing Instance mulC_id_r.

Global Instance opA_zero_r : right_absorbing mul zero.
Proof.
 intro; rewrite <- (right_id (mul _ _)); rewrite <- (right_id zero) at 3.
 set (e := right_inv (mul x zero)); rewrite <- e at 2 4; clear e.
 rewrite -> (commut (opp _)), assoc, assoc; apply add_morph; try reflexivity.
 rewrite <- right_dist, (right_id zero), (left_id (mul _ _)); reflexivity.
Qed.
End Right.
End AssociativeCommutative.


(************************************************************************)
(*         *   The Coq Proof Assistant / The Coq Development Team       *)
(*  v      *   INRIA, CNRS and contributors - Copyright 1999-2018       *)
(* <O___,, *       (see CREDITS file for the list of authors)           *)
(*   \VV/  **************************************************************)
(*    //   *    This file is distributed under the terms of the         *)
(*         *     GNU Lesser General Public License Version 2.1          *)
(*         *     (see LICENSE file for the text of the license)         *)
(************************************************************************)

(*********************************************************)
(**     Definition of the derivative,continuity          *)
(*                                                       *)
(*********************************************************)

Require Import XRbase.
Require Import XRfunctions.
Require Import XRlimit.
Require Import Omega.
Local Open Scope XR_scope.

(*********)
Definition D_x (D:R -> Prop) (y x:R) : Prop := D x /\ y <> x.

(*********)
Definition continue_in (f:R -> R) (D:R -> Prop) (x0:R) : Prop :=
  limit1_in f (D_x D x0) (f x0) x0.

(*********)
Definition D_in (f d:R -> R) (D:R -> Prop) (x0:R) : Prop :=
  limit1_in (fun x:R => (f x - f x0) / (x - x0)) (D_x D x0) (d x0) x0.

(*********)
Lemma cont_deriv :
  forall (f d:R -> R) (D:R -> Prop) (x0:R),
    D_in f d D x0 -> continue_in f D x0.
Proof.
  unfold continue_in; unfold D_in; unfold limit1_in;
    unfold limit_in; unfold Rdiv; simpl;
      intros; elim (H eps H0); clear H; intros; elim H;
        clear H; intros; elim (Req_dec (d x0) R0); intro.
  split with (Rmin R1 x); split.
  elim (Rmin_Rgt R1 x R0); intros a b; apply (b (conj Rlt_0_1 H)).
  intros; elim H3; clear H3; intros;
    generalize (let (H1, H2) := Rmin_Rgt R1 x (R_dist x1 x0) in H1);
      intro; elim (H5 H4); clear H5;
        intros; generalize (H1 x1 (conj H3 H6)); clear H1;
          intro; unfold D_x in H3; elim H3; intros.
  rewrite H2 in H1; unfold R_dist; unfold R_dist in H1;
    cut (Rabs (f x1 - f x0) < eps * Rabs (x1 - x0)).
  intro; unfold R_dist in H5;
    generalize (Rmult_lt_compat_l eps (Rabs (x1 - x0)) R1 H0 H5);
      rewrite Rmult_1_r; intro; apply Rlt_trans with (r2 := eps * Rabs (x1 - x0));
        assumption.
  rewrite (Rminus_0_r ((f x1 - f x0) * / (x1 - x0))) in H1;
    rewrite Rabs_mult in H1; cut (x1 - x0 <> R0).
  intro; rewrite (Rabs_Rinv (x1 - x0) H9) in H1;
    generalize
      (Rmult_lt_compat_l (Rabs (x1 - x0)) (Rabs (f x1 - f x0) * / Rabs (x1 - x0))
        eps (Rabs_pos_lt (x1 - x0) H9) H1); intro; rewrite Rmult_comm in H10;
      rewrite Rmult_assoc in H10; rewrite Rinv_l in H10.
  rewrite Rmult_1_r in H10; rewrite Rmult_comm; assumption.
  apply Rabs_no_R0; auto.
  apply Rminus_eq_contra; auto.
(**)
  split with (Rmin (Rmin (/ R2) x) (eps * / Rabs (R2 * d x0))); split.
  cut (R0 < Rmin (/ R2) x ).
  cut (R0 < eps * / Rabs (R2 * d x0) ).
  intros; elim (Rmin_Rgt (Rmin (/ R2) x) (eps * / Rabs (R2 * d x0)) R0);
    intros a b; apply (b (conj H4 H3)).
{
  apply Rmult_lt_0_compat.
  exact H0.
  rewrite Rabs_mult.
  apply Rinv_0_lt_compat.
  apply Rmult_lt_0_compat.
  { rewrite Rabs_right. exact Rlt_0_2. left. exact Rlt_0_2. }
  { apply Rabs_pos_lt. exact H2. }
}
  elim (Rmin_Rgt (/ R2) x R0); intros a b; cut (R0 < R2).
  intro; generalize (Rinv_0_lt_compat R2 H3); intro;
    apply (b (conj H4 H)).
  exact Rlt_0_2.
  intros; elim H3; clear H3; intros;
    generalize
      (let (H1, H2) :=
        Rmin_Rgt (Rmin (/ R2) x) (eps * / Rabs (R2 * d x0)) (R_dist x1 x0) in
        H1); intro; elim (H5 H4); clear H5;
      intros; generalize (let (H1, H2) := Rmin_Rgt (/ R2) x (R_dist x1 x0) in H1);
        intro; elim (H7 H5); clear H7;
          intros; clear H4 H5; generalize (H1 x1 (conj H3 H8));
            clear H1; intro; unfold D_x in H3; elim H3; intros;
              generalize (not_eq_sym H5); clear H5; intro H5;
                generalize (Rminus_eq_contra x1 x0 H5); intro; generalize H1;
                  pattern (d x0) at 1;
                    rewrite <- (let (H1, H2) := Rmult_ne (d x0) in H2);
                      rewrite <- (Rinv_l (x1 - x0) H9); unfold R_dist;
                        unfold Rminus at 1; rewrite (Rmult_comm (f x1 - f x0) (/ (x1 - x0)));
                          rewrite (Rmult_comm (/ (x1 - x0) * (x1 - x0)) (d x0));
                            rewrite <- (Ropp_mult_distr_l_reverse (d x0) (/ (x1 - x0) * (x1 - x0)));
                              rewrite (Rmult_comm (- d x0) (/ (x1 - x0) * (x1 - x0)));
                                rewrite (Rmult_assoc (/ (x1 - x0)) (x1 - x0) (- d x0));
                                  rewrite <-
                                    (Rmult_plus_distr_l (/ (x1 - x0)) (f x1 - f x0) ((x1 - x0) * - d x0))
                                    ; rewrite (Rabs_mult (/ (x1 - x0)) (f x1 - f x0 + (x1 - x0) * - d x0));
                                      clear H1; intro;
                                        generalize
                                          (Rmult_lt_compat_l (Rabs (x1 - x0))
                                            (Rabs (/ (x1 - x0)) * Rabs (f x1 - f x0 + (x1 - x0) * - d x0)) eps
                                            (Rabs_pos_lt (x1 - x0) H9) H1);
                                          rewrite <-
                                            (Rmult_assoc (Rabs (x1 - x0)) (Rabs (/ (x1 - x0)))
                                              (Rabs (f x1 - f x0 + (x1 - x0) * - d x0)));
                                            rewrite (Rabs_Rinv (x1 - x0) H9);
                                              rewrite (Rinv_r (Rabs (x1 - x0)) (Rabs_no_R0 (x1 - x0) H9));
                                                rewrite
                                                  (let (H1, H2) := Rmult_ne (Rabs (f x1 - f x0 + (x1 - x0) * - d x0)) in H2)
                                                  ; generalize (Rabs_triang_inv (f x1 - f x0) ((x1 - x0) * d x0));
                                                    intro; rewrite (Rmult_comm (x1 - x0) (- d x0));
                                                      rewrite (Ropp_mult_distr_l_reverse (d x0) (x1 - x0));
                                                        fold (f x1 - f x0 - d x0 * (x1 - x0));
                                                          rewrite (Rmult_comm (x1 - x0) (d x0)) in H10; clear H1;
                                                            intro;
                                                              generalize
                                                                (Rle_lt_trans (Rabs (f x1 - f x0) - Rabs (d x0 * (x1 - x0)))
                                                                  (Rabs (f x1 - f x0 - d x0 * (x1 - x0))) (Rabs (x1 - x0) * eps) H10 H1);
                                                                clear H1; intro;
                                                                  generalize
                                                                    (Rplus_lt_compat_l (Rabs (d x0 * (x1 - x0)))
                                                                      (Rabs (f x1 - f x0) - Rabs (d x0 * (x1 - x0))) (
                                                                        Rabs (x1 - x0) * eps) H1); unfold Rminus at 2;
                                                                    rewrite (Rplus_comm (Rabs (f x1 - f x0)) (- Rabs (d x0 * (x1 - x0))));
                                                                      rewrite <-
                                                                        (Rplus_assoc (Rabs (d x0 * (x1 - x0))) (- Rabs (d x0 * (x1 - x0)))
                                                                          (Rabs (f x1 - f x0))); rewrite (Rplus_opp_r (Rabs (d x0 * (x1 - x0))));
                                                                        rewrite (let (H1, H2) := Rplus_ne (Rabs (f x1 - f x0)) in H2);
                                                                          clear H1; intro; cut (Rabs (d x0 * (x1 - x0)) + Rabs (x1 - x0) * eps < eps).
  intro;
    apply
      (Rlt_trans (Rabs (f x1 - f x0))
        (Rabs (d x0 * (x1 - x0)) + Rabs (x1 - x0) * eps) eps H1 H11).
  clear H1 H5 H3 H10; generalize (Rabs_pos_lt (d x0) H2); intro;
      generalize (Rmult_lt_compat_l eps (R_dist x1 x0) (/ R2) H0 H7);
        clear H7; intro;
          generalize
            (Rmult_lt_compat_l (Rabs (d x0)) (R_dist x1 x0) (
              eps * / Rabs (R2 * d x0)) H1 H6); clear H6; intro;
            rewrite (Rmult_comm eps (R_dist x1 x0)) in H3; unfold R_dist in H3, H5;
              rewrite <- (Rabs_mult (d x0) (x1 - x0)) in H5;
                rewrite (Rabs_mult R2 (d x0)) in H5; cut (Rabs R2 <> R0).
  intro;
    rewrite
      (Rinv_mult_distr (Rabs R2) (Rabs (d x0)) H6
        (Rlt_dichotomy_converse (Rabs (d x0)) R0 (or_intror (Rabs (d x0) < R0) H1)))
      in H5;
      rewrite (Rmult_comm (Rabs (d x0)) (eps * (/ Rabs R2 * / Rabs (d x0)))) in H5;
        rewrite <- (Rmult_assoc eps (/ Rabs R2) (/ Rabs (d x0))) in H5;
          rewrite (Rmult_assoc (eps * / Rabs R2) (/ Rabs (d x0)) (Rabs (d x0))) in H5;
            rewrite
              (Rinv_l (Rabs (d x0))
                (Rlt_dichotomy_converse (Rabs (d x0)) R0 (or_intror (Rabs (d x0) < R0) H1)))
              in H5; rewrite (let (H1, H2) := Rmult_ne (eps * / Rabs R2) in H1) in H5;
                cut (Rabs R2 = R2).
  intro; rewrite H7 in H5;
    generalize
      (Rplus_lt_compat (Rabs (d x0 * (x1 - x0))) (eps * / R2)
        (Rabs (x1 - x0) * eps) (eps * / R2) H5 H3); intro;
      rewrite eps2 in H10; assumption.
  unfold Rabs; destruct (Rcase_abs R2) as [Hlt|Hge]; auto.
  cut (R0 < R2).
  intro H7; elim (Rlt_asym R0 R2 H7 Hlt).
exact Rlt_0_2.
  apply Rabs_no_R0.
  exact Neq_2_0.
Qed.

(*********)
Lemma Dconst :
  forall (D:R -> Prop) (y x0:R), D_in (fun x:R => y) (fun x:R => R0) D x0.
Proof.
  intros D x y.
  unfold D_in.
  unfold limit1_in.
  unfold limit_in.
  simpl.
  intros e he.
  exists e.
  split.
  { exact he. }
  {
    intros z h.
    destruct h as [ hl hr ].
    unfold R_dist.
    unfold Rminus.
    rewrite Rplus_opp_r.
    unfold Rdiv.
    rewrite Rmult_0_l.
    rewrite Rplus_0_l.
    rewrite Ropp_0.
    rewrite Rabs_R0.
    exact he.
  }
Qed.

(*********)
Lemma Dx :
  forall (D:R -> Prop) (x0:R), D_in (fun x:R => x) (fun x:R => R1) D x0.
Proof.
  intros D x.
  unfold D_in.
  unfold limit1_in.
  unfold limit_in.
  simpl.
  intros e he.
  exists e.
  split.
  { exact he. }
  {
    intros y h.
    destruct h as [ hl hr ].
    unfold D_x in hl.
    destruct hl as [ hy hneq ].
    unfold R_dist in hr.
    unfold R_dist.
    unfold Rdiv.
    rewrite Rinv_r.
    {
      unfold Rminus.
      rewrite Rplus_opp_r.
      rewrite Rabs_R0.
      exact he.
    }
    {
      intro eq.
      apply hneq.
      symmetry.
      apply Rplus_eq_reg_r with (-x).
      rewrite Rplus_opp_r.
      exact eq.
    }
  }
Qed.

(*********)
Lemma Dadd :
  forall (D:R -> Prop) (df dg f g:R -> R) (x0:R),
    D_in f df D x0 ->
    D_in g dg D x0 ->
    D_in (fun x:R => f x + g x) (fun x:R => df x + dg x) D x0.
Proof.
  unfold D_in; intros;
    generalize
      (limit_plus (fun x:R => (f x - f x0) * / (x - x0))
        (fun x:R => (g x - g x0) * / (x - x0)) (D_x D x0) (
          df x0) (dg x0) x0 H H0); clear H H0; unfold limit1_in;
      unfold limit_in; simpl; intros; elim (H eps H0);
        clear H; intros; elim H; clear H; intros; split with x;
          split; auto; intros; generalize (H1 x1 H2); clear H1;
            intro; rewrite (Rmult_comm (f x1 - f x0) (/ (x1 - x0))) in H1;
              rewrite (Rmult_comm (g x1 - g x0) (/ (x1 - x0))) in H1;
                rewrite <- (Rmult_plus_distr_l (/ (x1 - x0)) (f x1 - f x0) (g x1 - g x0))
                  in H1;
                  rewrite (Rmult_comm (/ (x1 - x0)) (f x1 - f x0 + (g x1 - g x0))) in H1;
                    cut (f x1 - f x0 + (g x1 - g x0) = f x1 + g x1 - (f x0 + g x0)).
  intro; rewrite H3 in H1; assumption.
  unfold Rminus.
  repeat rewrite Rplus_assoc.
  apply Rplus_eq_compat_l.
  symmetry.
  rewrite Rplus_comm.
  rewrite Ropp_plus_distr.
  repeat rewrite Rplus_assoc.
  apply Rplus_eq_compat_l.
  rewrite Rplus_comm.
  reflexivity.
Qed.

(*********)
Lemma Dmult :
  forall (D:R -> Prop) (df dg f g:R -> R) (x0:R),
    D_in f df D x0 ->
    D_in g dg D x0 ->
    D_in (fun x:R => f x * g x) (fun x:R => df x * g x + f x * dg x) D x0.
Proof.
  intros; unfold D_in; generalize H H0; intros; unfold D_in in H, H0;
    generalize (cont_deriv f df D x0 H1); unfold continue_in;
      intro;
        generalize
          (limit_mul (fun x:R => (g x - g x0) * / (x - x0)) (
            fun x:R => f x) (D_x D x0) (dg x0) (f x0) x0 H0 H3);
          intro; cut (limit1_in (fun x:R => g x0) (D_x D x0) (g x0) x0).
  intro;
    generalize
      (limit_mul (fun x:R => (f x - f x0) * / (x - x0)) (
        fun _:R => g x0) (D_x D x0) (df x0) (g x0) x0 H H5);
      clear H H0 H1 H2 H3 H5; intro;
        generalize
          (limit_plus (fun x:R => (f x - f x0) * / (x - x0) * g x0)
            (fun x:R => (g x - g x0) * / (x - x0) * f x) (
              D_x D x0) (df x0 * g x0) (dg x0 * f x0) x0 H H4);
          clear H4 H; intro; unfold limit1_in in H; unfold limit_in in H;
            simpl in H; unfold limit1_in; unfold limit_in;
              simpl; intros; elim (H eps H0); clear H; intros;
                elim H; clear H; intros; split with x; split; auto;
                  intros; generalize (H1 x1 H2); clear H1; intro;
                    rewrite (Rmult_comm (f x1 - f x0) (/ (x1 - x0))) in H1;
                      rewrite (Rmult_comm (g x1 - g x0) (/ (x1 - x0))) in H1;
                        rewrite (Rmult_assoc (/ (x1 - x0)) (f x1 - f x0) (g x0)) in H1;
                          rewrite (Rmult_assoc (/ (x1 - x0)) (g x1 - g x0) (f x1)) in H1;
                            rewrite <-
                              (Rmult_plus_distr_l (/ (x1 - x0)) ((f x1 - f x0) * g x0)
                                ((g x1 - g x0) * f x1)) in H1;
                              rewrite
                                (Rmult_comm (/ (x1 - x0)) ((f x1 - f x0) * g x0 + (g x1 - g x0) * f x1))
                                in H1; rewrite (Rmult_comm (dg x0) (f x0)) in H1;
                                  cut
                                    ((f x1 - f x0) * g x0 + (g x1 - g x0) * f x1 = f x1 * g x1 - f x0 * g x0).
  intro; rewrite H3 in H1; assumption.
unfold Rminus.
repeat rewrite Rmult_plus_distr_r.
rewrite Rplus_comm.
rewrite Rmult_comm.
repeat rewrite Rplus_assoc.
apply Rplus_eq_compat_l.
repeat rewrite <- Rplus_assoc.
rewrite Rmult_comm.
rewrite <- Ropp_mult_distr_r.
rewrite Rplus_opp_l.
rewrite Rplus_0_l.
rewrite <- Ropp_mult_distr_l.
reflexivity.

  unfold limit1_in; unfold limit_in; simpl; intros;
    split with eps; split; auto; intros; elim (R_dist_refl (g x0) (g x0));
      intros a b; rewrite (b (eq_refl (g x0)));
        assumption.
Qed.

(*********)
Lemma Dmult_const :
  forall (D:R -> Prop) (f df:R -> R) (x0 a:R),
    D_in f df D x0 -> D_in (fun x:R => a * f x) (fun x:R => a * df x) D x0.
Proof.
  intros;
    generalize (Dmult D (fun _:R => R0) df (fun _:R => a) f x0 (Dconst D a x0) H);
      unfold D_in; intros; rewrite (Rmult_0_l (f x0)) in H0;
        rewrite (let (H1, H2) := Rplus_ne (a * df x0) in H2) in H0;
          assumption.
Qed.

(*********)
Lemma Dopp :
  forall (D:R -> Prop) (f df:R -> R) (x0:R),
    D_in f df D x0 -> D_in (fun x:R => - f x) (fun x:R => - df x) D x0.
Proof.
  intros; generalize (Dmult_const D f df x0 (-R1) H); unfold D_in;
    unfold limit1_in; unfold limit_in;
      intros; generalize (H0 eps H1); clear H0; intro; elim H0;
        clear H0; intros; elim H0; clear H0; simpl;
          intros; split with x; split; auto.
  intros; generalize (H2 x1 H3); clear H2; intro.
  replace (- f x1 - - f x0) with (-R1 * f x1 - -R1 * f x0).
2:{
unfold Rminus.
rewrite Ropp_involutive.
rewrite Ropp_mult_distr_l.
rewrite Ropp_involutive.
rewrite Rmult_1_l.
rewrite <- Ropp_mult_distr_l.
rewrite Rmult_1_l.
reflexivity.
}
  replace (- df x0) with (-R1 * df x0).
2:{
rewrite <- Ropp_mult_distr_l.
rewrite Rmult_1_l.
reflexivity.
}
  exact H2.
Qed.

(*********)
Lemma Dminus :
  forall (D:R -> Prop) (df dg f g:R -> R) (x0:R),
    D_in f df D x0 ->
    D_in g dg D x0 ->
    D_in (fun x:R => f x - g x) (fun x:R => df x - dg x) D x0.
Proof.
  unfold Rminus; intros; generalize (Dopp D g dg x0 H0); intro;
    apply (Dadd D df (fun x:R => - dg x) f (fun x:R => - g x) x0);
      assumption.
Qed.

(*********)
Lemma Dx_pow_n :
  forall (n:nat) (D:R -> Prop) (x0:R),
    D_in (fun x:R => x ^ n) (fun x:R => INR n * x ^ (n - 1)) D x0.
Proof.
  simple induction n; intros.
  simpl; rewrite Rmult_0_l; apply Dconst.
  intros; cut (n0 = (S n0 - 1)%nat);
    [ intro a; rewrite <- a; clear a | simpl; apply minus_n_O ].
  generalize
    (Dmult D (fun _:R => R1) (fun x:R => INR n0 * x ^ (n0 - 1)) (
      fun x:R => x) (fun x:R => x ^ n0) x0 (Dx D x0) (
        H D x0)); unfold D_in; unfold limit1_in;
    unfold limit_in; simpl; intros; elim (H0 eps H1);
      clear H0; intros; elim H0; clear H0; intros; split with x;
        split; auto.
  intros; generalize (H2 x1 H3); clear H2 H3; intro;
    rewrite (let (H1, H2) := Rmult_ne (x0 ^ n0) in H2) in H2;
      rewrite (tech_pow_Rmult x1 n0) in H2; rewrite (tech_pow_Rmult x0 n0) in H2;
        rewrite (Rmult_comm (INR n0) (x0 ^ (n0 - 1))) in H2;
          rewrite <- (Rmult_assoc x0 (x0 ^ (n0 - 1)) (INR n0)) in H2;
            rewrite (tech_pow_Rmult x0 (n0 - 1)) in H2; elim (Peano_dec.eq_nat_dec n0 0) ; intros cond.
  rewrite cond in H2; rewrite cond; simpl in H2; simpl;
    cut (R1 + x0 * R1 * R0 = R1 * R1).
      intro A; rewrite A in H2; assumption.
rewrite Rmult_0_r.
rewrite Rplus_0_r.
rewrite Rmult_1_r.
reflexivity.
  cut (n0 <> 0%nat -> S (n0 - 1) = n0); [ intro | omega ];
    rewrite (H3 cond) in H2; rewrite (Rmult_comm (x0 ^ n0) (INR n0)) in H2;
      rewrite (tech_pow_Rplus x0 n0 n0) in H2; assumption.
Qed.

(*********)
Lemma Dcomp :
  forall (Df Dg:R -> Prop) (df dg f g:R -> R) (x0:R),
    D_in f df Df x0 ->
    D_in g dg Dg (f x0) ->
    D_in (fun x:R => g (f x)) (fun x:R => df x * dg (f x)) (Dgf Df Dg f) x0.
Proof.
  intros Df Dg df dg f g x0 H H0; generalize H H0; unfold D_in;
    unfold Rdiv; intros;
      generalize
        (limit_comp f (fun x:R => (g x - g (f x0)) * / (x - f x0)) (
          D_x Df x0) (D_x Dg (f x0)) (f x0) (dg (f x0)) x0);
        intro; generalize (cont_deriv f df Df x0 H); intro;
          unfold continue_in in H4; generalize (H3 H4 H2); clear H3;
            intro;
              generalize
                (limit_mul (fun x:R => (g (f x) - g (f x0)) * / (f x - f x0))
                  (fun x:R => (f x - f x0) * / (x - x0))
                  (Dgf (D_x Df x0) (D_x Dg (f x0)) f) (dg (f x0)) (
                    df x0) x0 H3); intro;
                cut
                  (limit1_in (fun x:R => (f x - f x0) * / (x - x0))
                    (Dgf (D_x Df x0) (D_x Dg (f x0)) f) (df x0) x0).
  intro; generalize (H5 H6); clear H5; intro;
    generalize
      (limit_mul (fun x:R => (f x - f x0) * / (x - x0)) (
        fun x:R => dg (f x0)) (D_x Df x0) (df x0) (dg (f x0)) x0 H1
      (limit_free (fun x:R => dg (f x0)) (D_x Df x0) x0 x0));
      intro; unfold limit1_in; unfold limit_in;
        simpl; unfold limit1_in in H5, H7; unfold limit_in in H5, H7;
          simpl in H5, H7; intros; elim (H5 eps H8); elim (H7 eps H8);
            clear H5 H7; intros; elim H5; elim H7; clear H5 H7;
              intros; split with (Rmin x x1); split.
  elim (Rmin_Rgt x x1 R0); intros a b; apply (b (conj H9 H5)); clear a b.
  intros; elim H11; clear H11; intros; elim (Rmin_Rgt x x1 (R_dist x2 x0));
    intros a b; clear b; elim (a H12);
      clear H5 a; intros; unfold D_x, Dgf in H11, H7, H10;
        clear H12; elim (Req_dec (f x2) (f x0)); intro.
  elim H11; clear H11; intros; elim H11; clear H11; intros;
    generalize (H10 x2 (conj (conj H11 H14) H5)); intro;
      rewrite (Rminus_diag_eq (f x2) (f x0) H12) in H16;
        rewrite (Rmult_0_l (/ (x2 - x0))) in H16;
          rewrite (Rmult_0_l (dg (f x0))) in H16; rewrite H12;
            rewrite (Rminus_diag_eq (g (f x0)) (g (f x0)) (eq_refl (g (f x0))));
              rewrite (Rmult_0_l (/ (x2 - x0))); assumption.
  clear H10 H5; elim H11; clear H11; intros; elim H5; clear H5; intros;
    cut
      (((Df x2 /\ x0 <> x2) /\ Dg (f x2) /\ f x0 <> f x2) /\ R_dist x2 x0 < x1);
      auto; intro; generalize (H7 x2 H14); intro;
        generalize (Rminus_eq_contra (f x2) (f x0) H12); intro;
          rewrite
            (Rmult_assoc (g (f x2) - g (f x0)) (/ (f x2 - f x0))
              ((f x2 - f x0) * / (x2 - x0))) in H15;
            rewrite <- (Rmult_assoc (/ (f x2 - f x0)) (f x2 - f x0) (/ (x2 - x0)))
              in H15; rewrite (Rinv_l (f x2 - f x0) H16) in H15;
                rewrite (let (H1, H2) := Rmult_ne (/ (x2 - x0)) in H2) in H15;
                  rewrite (Rmult_comm (df x0) (dg (f x0))); assumption.
  clear H5 H3 H4 H2; unfold limit1_in; unfold limit_in;
    simpl; unfold limit1_in in H1; unfold limit_in in H1;
      simpl in H1; intros; elim (H1 eps H2); clear H1; intros;
        elim H1; clear H1; intros; split with x; split; auto;
          intros; unfold D_x, Dgf in H4, H3; elim H4; clear H4;
            intros; elim H4; clear H4; intros; exact (H3 x1 (conj H4 H5)).
Qed.

(*********)
Lemma D_pow_n :
  forall (n:nat) (D:R -> Prop) (x0:R) (expr dexpr:R -> R),
    D_in expr dexpr D x0 ->
    D_in (fun x:R => expr x ^ n)
    (fun x:R => INR n * expr x ^ (n - 1) * dexpr x) (
      Dgf D D expr) x0.
Proof.
  intros n D x0 expr dexpr H;
    generalize
      (Dcomp D D dexpr (fun x:R => INR n * x ^ (n - 1)) expr (
        fun x:R => x ^ n) x0 H (Dx_pow_n n D (expr x0)));
      intro; unfold D_in; unfold limit1_in;
        unfold limit_in; simpl; intros; unfold D_in in H0;
          unfold limit1_in in H0; unfold limit_in in H0; simpl in H0;
            elim (H0 eps H1); clear H0; intros; elim H0; clear H0;
              intros; split with x; split; intros; auto.
  cut
    (dexpr x0 * (INR n * expr x0 ^ (n - 1)) =
      INR n * expr x0 ^ (n - 1) * dexpr x0).
    intro Rew; rewrite <- Rew; exact (H2 x1 H3).
repeat rewrite Rmult_assoc.
rewrite Rmult_comm.
repeat rewrite Rmult_assoc.
reflexivity.
Qed.


(* Pigeonhole
   f : A → B & card B < card A → f non injective *)

(* borrowed 2021-01-17 from my development "coq_euler_prod_form" *)

Set Nested Proofs Allowed.
Require Import Utf8 Arith.
Import List List.ListNotations.
Require Import Misc.

Fixpoint find_dup f (la : list nat) :=
  match la with
  | [] => None
  | n :: la' =>
      match find (λ n', f n' =? f n) la' with
      | None => find_dup f la'
      | Some n' => Some (n, n')
      end
  end.

Definition pigeonhole_fun a (f : nat → nat) :=
  match find_dup f (seq 0 a) with
  | Some (n, n') => (n, n')
  | None => (0, 0)
  end.

Theorem find_dup_some : ∀ f x x' la,
  find_dup f la = Some (x, x')
  → f x = f x' ∧
     ∃ la1 la2 la3, la = la1 ++ x :: la2 ++ x' :: la3.
Proof.
intros * Hfd.
induction la as [| a]; [ easy | ].
cbn in Hfd.
remember (find (λ x', f x' =? f a) la) as r eqn:Hr.
symmetry in Hr.
destruct r as [n'| ]. {
  injection Hfd; clear Hfd; intros; subst x x'.
  apply find_some in Hr; cbn in Hr.
  destruct Hr as (Hx'la, Hba).
  apply Nat.eqb_eq in Hba.
  split; [ easy | ].
  exists []; cbn.
  apply in_split in Hx'la.
  destruct Hx'la as (l1 & l2 & Hll).
  exists l1, l2.
  now rewrite Hll.
} {
  specialize (IHla Hfd).
  destruct IHla as (H & la1 & la2 & la3 & Hll).
  split; [ easy | ].
  now exists (a :: la1), la2, la3; rewrite Hll.
}
Qed.

Theorem find_dup_none : ∀ f la,
  find_dup f la = None → NoDup (map f la).
Proof.
intros * Hnd.
induction la as [| a]; [ constructor | cbn ].
constructor. {
  cbn in Hnd.
  remember (find _ _) as b eqn:Hb; symmetry in Hb.
  destruct b; [ easy | ].
  specialize (find_none _ _ Hb) as H1; cbn in H1; cbn.
  intros Ha.
  specialize (IHla Hnd).
  clear - IHla H1 Ha.
  induction la as [ | b]; [ easy | ].
  cbn in Ha.
  cbn in IHla.
  destruct Ha as [Ha| Ha]. {
    specialize (H1 b (or_introl eq_refl)).
    now apply Nat.eqb_neq in H1.
  } {
    apply NoDup_cons_iff in IHla.
    destruct IHla as (Hn, Hnd).
    specialize (IHla0 Hnd).
    apply IHla0; [ | easy ].
    intros x Hx.
    now apply H1; right.
  }
} {
  apply IHla.
  cbn in Hnd.
  remember (find _ _) as b eqn:Hb; symmetry in Hb.
  now destruct b.
}
Qed.

Theorem pigeonhole : ∀ a b f,
  b < a
  → (∀ x, x < a → f x < b)
  → ∀ x x', pigeonhole_fun a f = (x, x')
  → x < a ∧ x' < a ∧ x ≠ x' ∧ f x = f x'.
Proof.
intros * Hba Hf * Hpf.
unfold pigeonhole_fun in Hpf.
remember (find_dup _ _) as fd eqn:Hfd.
symmetry in Hfd.
destruct fd as [(n, n') |]. {
  injection Hpf; clear Hpf; intros; subst n n'.
  specialize (find_dup_some f _ _ _ Hfd) as (Hfxx & la1 & la2 & la3 & Hll).
  assert (Hxy : x ∈ seq 0 a). {
    rewrite Hll.
    apply in_app_iff.
    now right; left.
  }
  apply in_seq in Hxy; cbn in Hxy.
  destruct Hxy as (_, Hxa).
  assert (Hx' : x' ∈ seq 0 a). {
    rewrite Hll.
    apply in_app_iff; right; right.
    now apply in_app_iff; right; left.
  }
  apply in_seq in Hx'.
  split; [ easy | ].
  split; [ easy | ].
  split; [ | easy ].
  specialize (seq_NoDup a 0) as H.
  rewrite Hll in H.
  apply NoDup_remove_2 in H.
  intros Hxx; apply H; subst x'.
  apply in_app_iff; right.
  now apply in_app_iff; right; left.
} {
  apply find_dup_none in Hfd.
  exfalso; clear x x' Hpf.
  revert a f Hba Hf Hfd.
  induction b; intros; [ now specialize (Hf _ Hba) | ].
  destruct a; [ flia Hba | ].
  apply Nat.succ_lt_mono in Hba.
  remember (filter (λ i, f i =? b) (seq 0 (S a))) as la eqn:Hla.
  symmetry in Hla.
  destruct la as [| x1]. {
    assert (H : ∀ x, x < a → f x < b). {
      intros x Hx.
      destruct (Nat.eq_dec (f x) b) as [Hfxb| Hfxb]. {
        specialize (List_filter_nil _ _ Hla x) as H1.
        assert (H : x ∈ seq 0 (S a)). {
          apply in_seq.
          flia Hx.
        }
        specialize (H1 H); clear H; cbn in H1.
        now apply Nat.eqb_neq in H1.
      }
      assert (H : x < S a) by flia Hx.
      specialize (Hf x H); clear H.
      flia Hf Hfxb.
    }
    specialize (IHb a f Hba H); clear H.
    rewrite <- Nat.add_1_r in Hfd.
    rewrite seq_app in Hfd; cbn in Hfd.
    rewrite map_app in Hfd; cbn in Hfd.
    specialize (NoDup_remove_1 _ _ _ Hfd) as H1.
    now rewrite app_nil_r in H1.
  }
  destruct (Nat.eq_dec b 0) as [Hbz| Hbz]. {
    subst b.
    destruct a; [ flia Hba | ].
    specialize (Hf a) as H1.
    assert (H : a < S (S a)) by flia.
    specialize (H1 H); clear H.
    specialize (Hf (S a) (Nat.lt_succ_diag_r _)) as H2.
    apply Nat.lt_1_r in H1.
    apply Nat.lt_1_r in H2.
    do 2 rewrite <- Nat.add_1_r in Hfd.
    do 2 rewrite seq_app in Hfd; cbn in Hfd.
    rewrite <- app_assoc in Hfd.
    do 2 rewrite map_app in Hfd.
    cbn in Hfd.
    apply NoDup_remove_2 in Hfd.
    apply Hfd.
    apply in_app_iff; right.
    now rewrite H1, Nat.add_1_r, H2; left.
  }
  destruct la as [| x2]. {
    specialize (IHb a (λ i, if lt_dec i x1 then f i else f (i + 1)) Hba).
    cbn in IHb.
    assert (H : ∀ x, x < a → (if lt_dec x x1 then f x else f (x + 1)) < b). {
      intros x Hx.
      destruct (lt_dec x x1) as [Hxx| Hxx]. {
        assert (Hxb : f x ≠ b). {
          intros Hxb.
          assert (H : x ∈ filter (λ i, f i =? b) (seq 0 (S a))). {
            apply filter_In.
            split; [ apply in_seq; cbn; flia Hx | ].
            now apply Nat.eqb_eq.
          }
          rewrite Hla in H.
          destruct H as [H| H]; [ flia Hxx H| easy ].
        }
      specialize (Hf x).
        assert (H : x < S a) by flia Hx.
        specialize (Hf H); clear H.
        flia Hf Hxb.
      }
      apply Nat.nlt_ge in Hxx.
      specialize (Hf (x + 1)).
      assert (H : x + 1 < S a) by flia Hx.
      specialize (Hf H); clear H.
      assert (Hxb : f (x + 1) ≠ b). {
        intros Hxb.
        assert (H : x + 1 ∈ filter (λ i, f i =? b) (seq 0 (S a))). {
          apply filter_In.
          split; [ apply in_seq; cbn; flia Hx | ].
          now apply Nat.eqb_eq.
        }
        rewrite Hla in H.
        destruct H as [H| H]; [ flia Hxx H| easy ].
      }
      flia Hf Hxb.
    }
    specialize (IHb H); clear H.
    apply IHb; clear - Hfd.
    specialize (proj1 (NoDup_map_iff 0 _ _) Hfd) as H1.
    apply (NoDup_map_iff 0).
    intros x x' Hx Hx' Hxx.
    rewrite seq_length in Hx, Hx', H1.
    rewrite seq_nth in Hxx; [ | easy ].
    rewrite seq_nth in Hxx; [ cbn | easy ].
    cbn in Hxx.
    destruct (lt_dec x x1) as [Hxx1| Hxx1]. {
      destruct (lt_dec x' x1) as [Hx'x1| Hx'x1]. {
        apply H1; [ flia Hx | flia Hx' | ].
        rewrite seq_nth; [ | flia Hx ].
        rewrite seq_nth; [ easy | flia Hx' ].
      } {
        apply Nat.nlt_ge in Hx'x1.
        assert (H : x = x' + 1). {
          apply H1; [ flia Hx | flia Hx' | ].
          rewrite seq_nth; [ | flia Hx ].
          rewrite seq_nth; [ easy | flia Hx' ].
        }
        flia Hxx1 Hx'x1 H.
      }
    }
    apply Nat.nlt_ge in Hxx1.
    destruct (lt_dec x' x1) as [Hx'x1| Hx'x1]. {
      assert (H : x + 1 = x'). {
        apply H1; [ flia Hx | flia Hx' | ].
        rewrite seq_nth; [ | flia Hx ].
        rewrite seq_nth; [ easy | flia Hx' ].
      }
      flia Hxx1 Hx'x1 H.
    } {
      apply Nat.nlt_ge in Hx'x1.
      apply (Nat.add_cancel_r _ _ 1).
      apply H1; [ flia Hx | flia Hx' | ].
      rewrite seq_nth; [ | flia Hx ].
      rewrite seq_nth; [ easy | flia Hx' ].
    }
  }
  assert (Hx1 : x1 ∈ x1 :: x2 :: la) by now left.
  assert (Hx2 : x2 ∈ x1 :: x2 :: la) by now right; left.
  rewrite <- Hla in Hx1.
  rewrite <- Hla in Hx2.
  apply filter_In in Hx1.
  apply filter_In in Hx2.
  destruct Hx1 as (Hx1, Hfx1).
  destruct Hx2 as (Hx2, Hfx2).
  apply Nat.eqb_eq in Hfx1.
  apply Nat.eqb_eq in Hfx2.
  assert (H : x1 ≠ x2). {
    intros H; subst x2.
    clear - Hla.
    specialize (seq_NoDup (S a) 0) as H1.
    specialize (NoDup_filter (λ i, f i =? b) _ H1) as H2.
    rewrite Hla in H2.
    apply NoDup_cons_iff in H2.
    destruct H2 as (H2, _); apply H2.
    now left.
  }
  clear - Hfd Hx1 Hx2 H Hfx1 Hfx2.
  remember (seq 0 (S a)) as l; clear a Heql.
  apply H; clear H.
  specialize (proj1 (NoDup_map_iff 0 l (λ x, f x)) Hfd) as H1.
  cbn in H1.
  apply (In_nth _ _ 0) in Hx1.
  apply (In_nth _ _ 0) in Hx2.
  destruct Hx1 as (n1 & Hn1 & Hx1).
  destruct Hx2 as (n2 & Hn2 & Hx2).
  specialize (H1 _ _ Hn1 Hn2) as H2.
  rewrite Hx1, Hx2, Hfx1, Hfx2 in H2.
  rewrite <- Hx1, <- Hx2.
  f_equal.
  now apply H2.
}
Qed.

Theorem pigeonhole_exist : ∀ a b f,
  b < a
  → (∀ x, x < a → f x < b)
  → ∃ x x', x < a ∧ x' < a ∧ x ≠ x' ∧ f x = f x'.
Proof.
intros * Hba Hf.
remember (pigeonhole_fun a f) as xx' eqn:Hpf.
symmetry in Hpf.
destruct xx' as (x, x').
exists x, x'.
now apply (pigeonhole a b).
Qed.