Section STRONG_COLLECTION.
(* << A Sketch of the Proof of Strong Collection >> -- Advice of "Hanul Jeon" > Aczel의 Strong Collection의 증명을 스케치해보면, > 우선 forall x:X, exists y, phi(x,y)가 성립한다고 합시다. > 여기서 AC를 적용해서 forall x:X, phi(x,f(x))인 f를 찾고, > base set을 X의 base와 똑같이 잡을 겁니다. > 그리고 원소는 f(x)에 대응하게끔 잡을 거고요. > 문제는 AC가 Coq에서 작동할 것 같지 않다는 거네요. *)
Hypothesis AC : forall A : Type, forall B : Type, forall P : A -> B -> Prop, (forall x, exists y, P x y) -> (exists f, forall x, P x (f x)).
Proof with eauto with *.
intros X NONEMPTY. set (base_set := children X).
assert (claim : exists f : base_set -> Tree, forall x : base_set, P (childnodes X x) (f x)).
{ eapply AC with (P := fun x : base_set => fun y : Tree => P (childnodes X x) y)... }
destruct claim as [f claim]. exists (mkNode base_set (fun x => f x)). split.
- intros x [c EQ]. exists (f c). split... eapply COMPAT1...
- intros x [c EQ]. exists (childnodes X c). split... eapply COMPAT2...
Qed.
End STRONG_COLLECTION.
Inductive rLt (lhs : Tree) (rhs : Tree) : Prop :=
| rLt_intro c
(H_rLe : lhs ≦ᵣ childnodes rhs c)
: lhs <ᵣ rhs
where "lhs <ᵣ rhs" := (rLt lhs rhs) : type_scope
with rLe (lhs : Tree) (rhs : Tree) : Prop :=
| rLe_intro
(H_rLt : forall c, childnodes lhs c <ᵣ rhs)
: lhs ≦ᵣ rhs
where "lhs ≦ᵣ rhs" := (rLe lhs rhs) : type_scope.
#[global] Hint Constructors rLt rLe : aczel_hints.
Fixpoint rLt_inv x y (H_rLt : y <ᵣ x) {struct H_rLt}
: exists c1 : children x, forall c2 : children y, childnodes y c2 <ᵣ childnodes x c1
with rLe_inv x y (H_rLe : x ≦ᵣ y) {struct H_rLe}
: forall c1 : children x, exists c2 : children y, childnodes x c1 ≦ᵣ childnodes y c2.
#[global]
Instance rLe_PreOrder : PreOrder rLe :=
{ PreOrder_Reflexive := rLe_refl
; PreOrder_Transitive := rLe_trans
}.
Definition rEq_asSetoid : isSetoid Tree :=
mkSetoidFromPreOrder rLe_PreOrder.
Definition rEq (lhs : Tree) (rhs : Tree) : Prop :=
rEq_asSetoid.(eqProp) lhs rhs.
Infix "=ᵣ" := rEq (at level 70, no associativity) : type_scope.
#[global] Hint Resolve rLe_eqTree_rLe eqTree_rLe_rLe : aczel_hints.
#[global]
Add Parametric Morphism
: rLe with signature (eqProp ==> eqProp ==> iff)
as rLe_compatWith_eqProp.
#[global]
Add Parametric Morphism
: rEq with signature (eqProp ==> eqProp ==> iff)
as rEq_compatWith_eqProp.
#[global]
Add Parametric Morphism
: rLt with signature (eqProp ==> eqProp ==> iff)
as rLt_compatWith_eqProp.

Lemma rLt_implies_rLe lhs rhs
(H_rLt : lhs <ᵣ rhs)
: lhs ≦ᵣ rhs.