-ndefinition qseteq: ∀A. equivalence_relation1 (qpowerclass A).
- #A; napply mk_equivalence_relation1
- [ napply (λS,S':qpowerclass A. eq_rel1 ? (eq1 (powerclass_setoid A)) S S')
- | #S; napply (refl1 ? (seteq A))
- | #S; #S'; napply (sym1 ? (seteq A))
- | #S; #T; #U; napply (trans1 ? (seteq A))]
-nqed.
-
-ndefinition qpowerclass_setoid: setoid → setoid1.
- #A; napply mk_setoid1
- [ napply (qpowerclass A)
- | napply (qseteq A) ]
-nqed.
-
-unification hint 0 (∀A. (λx,y.True) (carr1 (qpowerclass_setoid A)) (qpowerclass A)).
-ncoercion qpowerclass_hint: ∀A: setoid. ∀S: qpowerclass_setoid A. Ω \sup A ≝ λA.λS.S
- on _S: (carr1 (qpowerclass_setoid ?)) to (Ω \sup ?).
-
-nlemma mem_ok: ∀A. binary_morphism1 (setoid1_of_setoid A) (qpowerclass_setoid A) CPROP.
- #A; napply mk_binary_morphism1
- [ napply (λx.λS: qpowerclass_setoid A. x ∈ S) (* CSC: ??? *)
- | #a; #a'; #b; #b'; #Ha; #Hb; (* CSC: qui *; non funziona *)
- nwhd; nwhd in ⊢ (? (? % ??) (? % ??)); napply mk_iff; #H
- [ ncases Hb; #Hb1; #_; napply Hb1; napply (. (mem_ok' …))
- [ nassumption | napply Ha^-1 | ##skip ]
- ##| ncases Hb; #_; #Hb2; napply Hb2; napply (. (mem_ok' …))
- [ nassumption | napply Ha | ##skip ]##]
-nqed.
-
-unification hint 0 (∀A,x,S. (λx,y.True) (fun21 ??? (mem_ok A) x S) (mem A S x)).
-
-nlemma subseteq_ok: ∀A. binary_morphism1 (qpowerclass_setoid A) (qpowerclass_setoid A) CPROP.
- #A; napply mk_binary_morphism1
- [ napply (λS,S': qpowerclass_setoid ?. S ⊆ S')
- | #a; #a'; #b; #b'; *; #Ha1; #Ha2; *; #Hb1; #Hb2; napply mk_iff; #H
- [ napply (subseteq_trans … a' a) (* anche qui, perche' serve a'? *)
- [ nassumption | napply (subseteq_trans … a b); nassumption ]
- ##| napply (subseteq_trans … a a') (* anche qui, perche' serve a'? *)
- [ nassumption | napply (subseteq_trans … a' b'); nassumption ] ##]
-nqed.
-
-nlemma intersect_ok: ∀A. binary_morphism1 (qpowerclass_setoid A) (qpowerclass_setoid A) (qpowerclass_setoid A).
- #A; napply mk_binary_morphism1
- [ #S; #S'; napply mk_qpowerclass
+unification hint 0 ≔ AA, x, S;
+ A ≟ carr AA,
+ SS ≟ (ext_carr ? S),
+ TT ≟ (mk_unary_morphism1 ??
+ (λx:setoid1_of_setoid ?.
+ mk_unary_morphism1 ??
+ (λS:ext_powerclass_setoid ?. x ∈ S)
+ (prop11 ?? (mem_ext_powerclass_setoid_is_morph AA x)))
+ (prop11 ?? (mem_ext_powerclass_setoid_is_morph AA))),
+ XX ≟ (ext_powerclass_setoid AA)
+ (*-------------------------------------*) ⊢
+ fun11 (setoid1_of_setoid AA)
+ (unary_morphism1_setoid1 XX CPROP) TT x S
+ ≡ mem A SS x.
+
+nlemma set_ext : ∀S.∀A,B:Ω^S.A =_1 B → ∀x:S.(x ∈ A) =_1 (x ∈ B).
+#S A B; *; #H1 H2 x; @; ##[ napply H1 | napply H2] nqed.
+
+nlemma ext_set : ∀S.∀A,B:Ω^S.(∀x:S. (x ∈ A) = (x ∈ B)) → A = B.
+#S A B H; @; #x; ncases (H x); #H1 H2; ##[ napply H1 | napply H2] nqed.
+
+nlemma subseteq_is_morph: ∀A. 𝛀^A ⇒_1 𝛀^A ⇒_1 CPROP.
+ #A; napply (mk_binary_morphism1 … (λS,S':𝛀^A. S ⊆ S'));
+ #a; #a'; #b; #b'; *; #H1; #H2; *; /5/ by mk_iff, sym1, subseteq_trans;
+nqed.
+
+alias symbol "hint_decl" (instance 1) = "hint_decl_Type2".
+unification hint 0 ≔ A,x,y
+(*-----------------------------------------------*) ⊢
+ eq_rel ? (eq0 A) x y ≡ eq_rel1 ? (eq1 (setoid1_of_setoid A)) x y.
+
+(* XXX capire come mai questa hint non funziona se porto su (setoid1_of_setoid A) *)
+
+nlemma intersect_is_ext: ∀A. 𝛀^A → 𝛀^A → 𝛀^A.
+#S A B; @ (A ∩ B); #x y Exy; @; *; #H1 H2; @;
+##[##1,2: napply (. Exy^-1‡#); nassumption;
+##|##3,4: napply (. Exy‡#); nassumption]
+nqed.
+
+alias symbol "hint_decl" = "hint_decl_Type1".
+unification hint 0 ≔
+ A : setoid, B,C : ext_powerclass A;
+ R ≟ (mk_ext_powerclass ? (B ∩ C) (ext_prop ? (intersect_is_ext ? B C)))
+ (* ------------------------------------------*) ⊢
+ ext_carr A R ≡ intersect ? (ext_carr ? B) (ext_carr ? C).
+
+nlemma intersect_is_morph: ∀A. Ω^A ⇒_1 Ω^A ⇒_1 Ω^A.
+#A; napply (mk_binary_morphism1 … (λS,S'. S ∩ S'));
+#a; #a'; #b; #b'; *; #Ha1; #Ha2; *; #Hb1; #Hb2; @; #x; nnormalize; *;/3/.
+nqed.
+
+alias symbol "hint_decl" = "hint_decl_Type1".
+unification hint 0 ≔ A : Type[0], B,C : Ω^A;
+ R ≟ mk_unary_morphism1 ??
+ (λS. mk_unary_morphism1 ?? (λS'.S ∩ S') (prop11 ?? (intersect_is_morph A S)))
+ (prop11 ?? (intersect_is_morph A))
+(*------------------------------------------------------------------------*) ⊢
+ fun11 ?? (fun11 ?? R B) C ≡ intersect A B C.
+
+interpretation "prop21 ext" 'prop2 l r =
+ (prop11 (ext_powerclass_setoid ?)
+ (unary_morphism1_setoid1 (ext_powerclass_setoid ?) ?) ? ?? l ?? r).
+
+nlemma intersect_is_ext_morph: ∀A. 𝛀^A ⇒_1 𝛀^A ⇒_1 𝛀^A.
+ #A; napply (mk_binary_morphism1 … (intersect_is_ext …));
+ #a; #a'; #b; #b'; #Ha; #Hb; napply (prop11 … (intersect_is_morph A)); nassumption.
+nqed.
+
+unification hint 1 ≔
+ AA : setoid, B,C : 𝛀^AA;
+ A ≟ carr AA,
+ R ≟ (mk_unary_morphism1 ??
+ (λS:𝛀^AA.
+ mk_unary_morphism1 ??
+ (λS':𝛀^AA.
+ mk_ext_powerclass AA (S∩S') (ext_prop AA (intersect_is_ext ? S S')))
+ (prop11 ?? (intersect_is_ext_morph AA S)))
+ (prop11 ?? (intersect_is_ext_morph AA))) ,
+ BB ≟ (ext_carr ? B),
+ CC ≟ (ext_carr ? C)
+ (* ------------------------------------------------------*) ⊢
+ ext_carr AA (R B C) ≡ intersect A BB CC.
+
+nlemma union_is_morph : ∀A. Ω^A ⇒_1 (Ω^A ⇒_1 Ω^A).
+#X; napply (mk_binary_morphism1 … (λA,B.A ∪ B));
+#A1 A2 B1 B2 EA EB; napply ext_set; #x;
+nchange in match (x ∈ (A1 ∪ B1)) with (?∨?);
+napply (.= (set_ext ??? EA x)‡#);
+napply (.= #‡(set_ext ??? EB x)); //;
+nqed.
+
+nlemma union_is_ext: ∀A. 𝛀^A → 𝛀^A → 𝛀^A.
+ #S A B; @ (A ∪ B); #x y Exy; @; *; #H1;
+##[##1,3: @; ##|##*: @2 ]
+##[##1,3: napply (. (Exy^-1)╪_1#)
+##|##2,4: napply (. Exy╪_1#)]
+nassumption;
+nqed.
+
+alias symbol "hint_decl" = "hint_decl_Type1".
+unification hint 0 ≔
+ A : setoid, B,C : 𝛀^A;
+ R ≟ (mk_ext_powerclass ? (B ∪ C) (ext_prop ? (union_is_ext ? B C)))
+(*-------------------------------------------------------------------------*) ⊢
+ ext_carr A R ≡ union ? (ext_carr ? B) (ext_carr ? C).
+
+unification hint 0 ≔ S:Type[0], A,B:Ω^S;
+ MM ≟ mk_unary_morphism1 ??
+ (λA.mk_unary_morphism1 ?? (λB.A ∪ B) (prop11 ?? (union_is_morph S A)))
+ (prop11 ?? (union_is_morph S))
+(*--------------------------------------------------------------------------*) ⊢
+ fun11 ?? (fun11 ?? MM A) B ≡ A ∪ B.
+
+nlemma union_is_ext_morph:∀A.𝛀^A ⇒_1 𝛀^A ⇒_1 𝛀^A.
+#A; napply (mk_binary_morphism1 … (union_is_ext …));
+#x1 x2 y1 y2 Ex Ey; napply (prop11 … (union_is_morph A)); nassumption.
+nqed.
+
+unification hint 1 ≔
+ AA : setoid, B,C : 𝛀^AA;
+ A ≟ carr AA,
+ R ≟ (mk_unary_morphism1 ??
+ (λS:𝛀^AA.
+ mk_unary_morphism1 ??
+ (λS':𝛀^AA.
+ mk_ext_powerclass AA (S ∪ S') (ext_prop AA (union_is_ext ? S S')))
+ (prop11 ?? (union_is_ext_morph AA S)))
+ (prop11 ?? (union_is_ext_morph AA))) ,
+ BB ≟ (ext_carr ? B),
+ CC ≟ (ext_carr ? C)
+(*------------------------------------------------------*) ⊢
+ ext_carr AA (R B C) ≡ union A BB CC.
+
+(*
+alias symbol "hint_decl" = "hint_decl_Type2".
+unification hint 0 ≔
+ A : setoid, B,C : 𝛀^A ;
+ CC ≟ (ext_carr ? C),
+ BB ≟ (ext_carr ? B),
+ C1 ≟ (carr1 (powerclass_setoid (carr A))),
+ C2 ≟ (carr1 (ext_powerclass_setoid A))
+ ⊢
+ eq_rel1 C1 (eq1 (powerclass_setoid (carr A))) BB CC ≡
+ eq_rel1 C2 (eq1 (ext_powerclass_setoid A)) B C.
+
+unification hint 0 ≔
+ A, B : CPROP ⊢ iff A B ≡ eq_rel1 ? (eq1 CPROP) A B.
+
+nlemma test: ∀U.∀A,B:𝛀^U. A ∩ B = A →
+ ∀x,y. x=y → x ∈ A → y ∈ A ∩ B.
+ #U; #A; #B; #H; #x; #y; #K; #K2;
+ alias symbol "prop2" = "prop21 mem".
+ alias symbol "invert" = "setoid1 symmetry".
+ napply (. K^-1‡H);
+ nassumption;
+nqed.
+
+
+nlemma intersect_ok: ∀A. binary_morphism1 (ext_powerclass_setoid A) (ext_powerclass_setoid A) (ext_powerclass_setoid A).
+ #A; @
+ [ #S; #S'; @