Tactic Notation "assert_specialize" hyp(H) :=
match type of H with
forall x : ?P, _ =>
let Htemp := fresh "Htemp" in
assert P as Htemp; [ | specialize (H Htemp); try clear Htemp ]
end.
(** * Ramsey theorem (with the necessary set-theoretic definitions) *)
Definition intersection {X} (A B : X -> Prop) := fun x => A x /\ B x.
Definition minus {X} (A B : X -> Prop) := fun x => A x /\ ~B x.
Definition subset {X} (A B : X -> Prop) := forall x, A x -> B x.
Definition finite {X} (A : X -> Prop) := exists n f, forall x, A x -> exists i, i < n /\ f i = x.
Definition infinite (A : nat -> Prop) := forall b, exists a, b <= a /\ A a.
Definition image {X Y} (f : X -> Y) (A : X -> Prop) : Y -> Prop := fun y => exists x, A x /\ y = f x.
Definition preimage {X Y} (f : X -> Y) (B : Y -> Prop) : X -> Prop := fun x => B (f x).

(* Specifications: *)
Lemma infinite_subset (A B : nat -> Prop) :
subset A B -> infinite A -> infinite B.
Lemma infinite_minus A B :
(forall P, ~~P -> P) ->
infinite A ->
~ infinite (intersection A B) ->
infinite (minus A B).
Lemma image_subset {X Y} A B (f : X -> Y) :
subset A B ->
subset (image f A) (image f B).
Lemma ramsey_preimage {X} (N : nat -> Prop) (f : nat -> X) :
(forall P, P \/ ~P) ->
finite (image f N) ->
infinite N ->
exists x, infinite (intersection N (preimage f (eq x))).
Lemma EM_ABS : (forall P, P \/ ~P) <-> (forall P, ~~P -> P).
Fixpoint zip {X} (f1 f2 : nat -> X) n :=
match n with
| O => f1 O
| S O => f2 0
| S (S n) => zip (fun n => f1 (S n)) (fun n => f2 (S n)) n
end.
Lemma zip_ext {X} f1 f2 g1 g2 :
(forall x, f1 x = g1 x) ->
(forall x, f2 x = g2 x) ->
forall k, @zip X f1 f2 k = @zip X g1 g2 k.
Lemma zip_1 {X} f1 f2 n : @zip X f1 f2 (2 * n) = f1 n.
Lemma zip_2 {X} f1 f2 n : @zip X f1 f2 (1 + 2 * n) = f2 n.
Lemma finite_union_intersection {X Y} (A1 A2 : X -> Prop) (P : Y -> X -> Prop) :
finite (fun y => exists x, A1 x /\ P y x) ->
finite (fun y => exists x, A2 x /\ P y x) ->
finite (fun y => exists x, (A1 x \/ A2 x) /\ P y x).
Lemma finite_product:
forall {A B}
{PA : A -> Prop}
{PB : B -> Prop},
finite PA ->
finite PB ->
finite (fun ab => PA (fst ab) /\ PB (snd ab)).
(* We have a simpler characterization of finite for subsets of nat  *)
Lemma finite_nat_bound A : @finite nat A <-> exists b, forall a, A a -> a < b.
(* and a simpler proof for finite_union_intersection, too *)
Lemma finite_union_intersection_nat {X} (A1 A2 : X -> Prop) (P : nat -> X -> Prop) :
finite (fun n => exists x, A1 x /\ P n x) ->
finite (fun n => exists x, A2 x /\ P n x) ->
finite (fun n => exists x, (A1 x \/ A2 x) /\ P n x).
Lemma not_infinite_finite A : (forall P, ~~P -> P) -> ~ infinite A <-> finite A.
Lemma ramsey_inf_bin {X} (A1 A2 : X -> Prop) (P : nat -> X -> Prop) :
(forall P, P \/ ~P) ->
infinite (fun n => exists x, (A1 x \/ A2 x) /\ P n x) ->
infinite (fun n => exists x, A1 x /\ P n x) \/
infinite (fun n => exists x, A2 x /\ P n x).
Lemma ramsey_inf {X} (A : X -> Prop) (P : nat -> X -> Prop) :
(forall P, P \/ ~P) ->
finite A ->
infinite (fun n => exists x, A x /\ P n x) ->
exists x, A x /\ infinite (fun n => P n x).