intro l;
apply mk_excess;
[1: apply mk_excess_;
- [1:
-
+ [1: apply mk_excess_dual_smart;
+
apply (mk_excess_base (sl_carr l));
[1: apply (λa,b:sl_carr l.a # (a ✗ b));
|2: unfold; intros 2 (x H); simplify in H;
record semi_lattice : Type ≝ {
sl_exc:> excess;
- meet: sl_exc → sl_exc → sl_exc;
- meet_refl: ∀x.meet x x ≈ x;
- meet_comm: ∀x,y. meet x y ≈ meet y x;
- meet_assoc: ∀x,y,z. meet x (meet y z) ≈ meet (meet x y) z;
- strong_extm: ∀x.strong_ext ? (meet x);
- le_to_eqm: ∀x,y.x ≤ y → x ≈ meet x y;
- lem: ∀x,y.(meet x y) ≤ y
+ sl_meet: sl_exc → sl_exc → sl_exc;
+ sl_meet_refl: ∀x.sl_meet x x ≈ x;
+ sl_meet_comm: ∀x,y. sl_meet x y ≈ sl_meet y x;
+ sl_meet_assoc: ∀x,y,z. sl_meet x (sl_meet y z) ≈ sl_meet (sl_meet x y) z;
+ sl_strong_extm: ∀x.strong_ext ? (sl_meet x);
+ sl_le_to_eqm: ∀x,y.x ≤ y → x ≈ sl_meet x y;
+ sl_lem: ∀x,y.(sl_meet x y) ≤ y
}.
-interpretation "semi lattice meet" 'and a b = (cic:/matita/lattice/meet.con _ a b).
+interpretation "semi lattice meet" 'and a b = (cic:/matita/lattice/sl_meet.con _ a b).
-lemma feq_ml: ∀ml:semi_lattice.∀a,b,c:ml. a ≈ b → (c ∧ a) ≈ (c ∧ b).
+lemma sl_feq_ml: ∀ml:semi_lattice.∀a,b,c:ml. a ≈ b → (c ∧ a) ≈ (c ∧ b).
intros (l a b c H); unfold eq in H ⊢ %; unfold Not in H ⊢ %;
-intro H1; apply H; clear H; apply (strong_extm ???? H1);
+intro H1; apply H; clear H; apply (sl_strong_extm ???? H1);
qed.
-lemma feq_mr: ∀ml:semi_lattice.∀a,b,c:ml. a ≈ b → (a ∧ c) ≈ (b ∧ c).
+lemma sl_feq_mr: ∀ml:semi_lattice.∀a,b,c:ml. a ≈ b → (a ∧ c) ≈ (b ∧ c).
intros (l a b c H);
-apply (Eq≈ ? (meet_comm ???)); apply (Eq≈ ?? (meet_comm ???));
-apply feq_ml; assumption;
+apply (Eq≈ ? (sl_meet_comm ???)); apply (Eq≈ ?? (sl_meet_comm ???));
+apply sl_feq_ml; assumption;
qed.
qed.
*)
+(* ED(≰,≱) → EB(≰') → ED(≰',≱') *)
+lemma subst_excess_base: excess_dual → excess_base → excess_dual.
+intros; apply (mk_excess_dual_smart e1);
+qed.
+
+(* E_(ED(≰,≱),AP(#),c ED = c AP) → ED' → c DE' = c E_ → E_(ED',#,p) *)
+lemma subst_dual_excess: ∀e:excess_.∀e1:excess_dual.exc_carr e = exc_carr e1 → excess_.
+intros (e e1 p); apply (mk_excess_ e1 e); cases p; reflexivity;
+qed.
+
+(* E(E_,H1,H2) → E_' → H1' → H2' → E(E_',H1',H2') *)
+alias symbol "nleq" = "Excess excess_".
+lemma subst_excess_: ∀e:excess. ∀e1:excess_.
+ (∀y,x:e1. y # x → y ≰ x ∨ x ≰ y) →
+ (∀y,x:e1.y ≰ x ∨ x ≰ y → y # x) →
+ excess.
+intros (e e1 H1 H2); apply (mk_excess e1 H1 H2);
+qed.
+
+definition hole ≝ λT:Type.λx:T.x.
+
+notation < "\ldots" non associative with precedence 50 for @{'hole}.
+interpretation "hole" 'hole = (cic:/matita/lattice/hole.con _ _).
+
+
+axiom FALSE : False.
+
+(* SL(E,M,H2-5(#),H67(≰)) → E' → c E = c E' → H67'(≰') → SL(E,M,p2-5,H67') *)
+lemma subst_excess:
+ ∀l:semi_lattice.
+ ∀e:excess.
+ ∀p:exc_ap l = exc_ap e.
+ (∀x,y:e.(le (exc_dual_base e)) x y → x ≈ (?(sl_meet l)) x y) →
+ (∀x,y:e.(le (exc_dual_base e)) ((?(sl_meet l)) x y) y) →
+ semi_lattice.
+[1,2:intro M;
+ change with ((λx.ap_carr x) e -> (λx.ap_carr x) e -> (λx.ap_carr x) e);
+ cases p; apply M;
+|intros (l e p H1 H2);
+ apply (mk_semi_lattice e);
+ [ change with ((λx.ap_carr x) e -> (λx.ap_carr x) e -> (λx.ap_carr x) e);
+ cases p; simplify; apply (sl_meet l);
+ |2: change in ⊢ (% → ?) with ((λx.ap_carr x) e); cases p; simplify; apply sl_meet_refl;
+ |3: change in ⊢ (% → % → ?) with ((λx.ap_carr x) e); cases p; simplify; apply sl_meet_comm;
+ |4: change in ⊢ (% → % → % → ?) with ((λx.ap_carr x) e); cases p; simplify; apply sl_meet_assoc;
+ |5: change in ⊢ (% → ?) with ((λx.ap_carr x) e); cases p; simplify; apply sl_strong_extm;
+ |6: clear H2; apply hole; apply H1;
+ |7: clear H1; apply hole; apply H2;]]
+qed.
+
+lemma excess_of_excess_base: excess_base → excess.
+intro eb;
+apply mk_excess;
+ [apply (mk_excess_ (mk_excess_dual_smart eb));
+ [apply (apartness_of_excess_base eb);
+ |reflexivity]
+ |2,3: intros; assumption]
+qed.
+
+lemma subst_excess_preserves_aprtness:
+ ∀l:semi_lattice.
+ ∀e:excess.
+ ∀p,H1,H2.
+ exc_ap l = exc_ap (subst_excess l e p H1 H2).
+intros;
+unfold subst_excess;
+simplify; assumption;
+qed.
+
+
+lemma subst_excess__preserves_aprtness:
+ ∀l:excess.
+ ∀e:excess_base.
+ ∀p,H1,H2.
+ exc_ap l = apartness_OF_excess (subst_excess_ l (subst_dual_excess l (subst_excess_base l e) p) H1 H2).
+intros 3; (unfold subst_excess_; unfold subst_dual_excess; unfold subst_excess_base; unfold exc_ap; unfold mk_excess_dual_smart; simplify);
+(unfold subst_excess_base in p; unfold mk_excess_dual_smart in p; simplify in p);
+intros; cases p;
+reflexivity;
+qed.
+
+lemma subst_excess_base_in_excess_:
+ ∀d:excess_.
+ ∀eb:excess_base.
+ ∀p:exc_carr d = exc_carr eb.
+ excess_.
+intros (e_ eb);
+apply (subst_dual_excess e_);
+ [apply (subst_excess_base e_ eb);
+ |assumption]
+qed.
+
+lemma subst_excess_base_in_excess:
+ ∀d:excess.
+ ∀eb:excess_base.
+ ∀p:exc_carr d = exc_carr eb.
+ (∀y1,x1:eb. (?(ap_apart d)) y1 x1 → y1 ≰ x1 ∨ x1 ≰ y1) →
+ (∀y2,x2:eb.y2 ≰ x2 ∨ x2 ≰ y2 → (?(ap_apart d)) y2 x2) →
+ excess.
+[1,3,4:apply Type|2,5:intro f; cases p; apply f]
+intros (d eb p H1 H2);
+apply (subst_excess_ d);
+ [apply (subst_excess_base_in_excess_ d eb p);
+ |apply hole; clear H2;
+ change in ⊢ (%→%→?) with (exc_carr eb);
+ change in ⊢ (?→?→?→? (? % ? ?) (? % ? ?)) with eb; intros (y x H3);
+ apply H1; generalize in match H3;
+ unfold ap_apart; unfold subst_excess_base_in_excess_;
+ unfold subst_dual_excess; simplify;
+ generalize in match x;
+ generalize in match y;
+ cases p; simplify; intros; assumption;
+ |apply hole; clear H1;
+ change in ⊢ (%→%→?) with (exc_carr eb);
+ change in ⊢ (?→?→? (? % ? ?) (? % ? ?)→?) with eb; intros (y x H3);
+ unfold ap_apart; unfold subst_excess_base_in_excess_;
+ unfold subst_dual_excess; simplify; generalize in match (H2 ?? H3);
+ generalize in match x; generalize in match y; cases p;
+ intros; assumption;]
+qed.
+
+lemma tech1: ∀e:excess.
+ ∀eb:excess_base.
+ ∀p,H1,H2.
+ exc_ap e = exc_ap_ (subst_excess_base_in_excess e eb p H1 H2).
+intros (e eb p H1 H2);
+unfold subst_excess_base_in_excess;
+unfold subst_excess_; simplify;
+unfold subst_excess_base_in_excess_;
+unfold subst_dual_excess; simplify; reflexivity;
+qed.
+
+lemma tech2:
+ ∀e:excess_.∀eb.∀p.
+ exc_ap e = exc_ap (mk_excess_ (subst_excess_base e eb) (exc_ap e) p).
+intros (e eb p);unfold exc_ap; simplify; cases p; simplify; reflexivity;
+qed.
+
+(*
+lemma eq_fap:
+ ∀a1,b1,a2,b2,a3,b3,a4,b4,a5,b5.
+ a1=b1 → a2=b2 → a3=b3 → a4=b4 → a5=b5 → mk_apartness a1 a2 a3 a4 a5 = mk_apartness b1 b2 b3 b4 b5.
+intros; cases H; cases H1; cases H2; cases H3; cases H4; reflexivity;
+qed.
+*)
+
+lemma subst_excess_base_in_excess_preserves_apartness:
+ ∀e:excess.
+ ∀eb:excess_base.
+ ∀H,H1,H2.
+ apartness_OF_excess e =
+ apartness_OF_excess (subst_excess_base_in_excess e eb H H1 H2).
+intros (e eb p H1 H2);
+unfold subst_excess_base_in_excess;
+unfold subst_excess_; unfold subst_excess_base_in_excess_;
+unfold subst_dual_excess; unfold apartness_OF_excess;
+simplify in ⊢ (? ? ? (? %));
+rewrite < (tech2 e eb );
+reflexivity;
+qed.
+
+
+
+alias symbol "nleq" = "Excess base excess".
+lemma subst_excess_base_in_semi_lattice:
+ ∀sl:semi_lattice.
+ ∀eb:excess_base.
+ ∀p:exc_carr sl = exc_carr eb.
+ (∀y1,x1:eb. (?(ap_apart sl)) y1 x1 → y1 ≰ x1 ∨ x1 ≰ y1) →
+ (∀y2,x2:eb.y2 ≰ x2 ∨ x2 ≰ y2 → (?(ap_apart sl)) y2 x2) →
+ (∀x3,y3:eb.(le eb) x3 y3 → (?(eq sl)) x3 ((?(sl_meet sl)) x3 y3)) →
+ (∀x4,y4:eb.(le eb) ((?(sl_meet sl)) x4 y4) y4) →
+ semi_lattice.
+[2:apply Prop|3,7,9,10:apply Type|4:apply (exc_carr eb)|1,5,6,8,11:intro f; cases p; apply f;]
+intros (sl eb H H1 H2 H3 H4);
+apply (subst_excess sl);
+ [apply (subst_excess_base_in_excess sl eb H H1 H2);
+ |apply subst_excess_base_in_excess_preserves_apartness;
+ |change in ⊢ (%→%→?) with ((λx.ap_carr x) (subst_excess_base_in_excess (sl_exc sl) eb H H1 H2)); simplify;
+ intros 3 (x y LE);
+ generalize in match (H3 ?? LE);
+ generalize in match H1 as H1;generalize in match H2 as H2;
+ generalize in match x as x; generalize in match y as y;
+ cases FALSE;
+ (*
+ (reduce in H ⊢ %; cases H; simplify; intros; assumption);
+
+
+ cases (subst_excess_base_in_excess_preserves_apartness (sl_exc sl) eb H H1 H2); simplify;
+ change in x:(%) with (exc_carr eb);
+ change in y:(%) with (exc_carr eb);
+ generalize in match OK; generalize in match x as x; generalize in match y as y;
+ cases H; simplify; (* funge, ma devo fare 2 rewrite in un colpo solo *)
+ *)
+ |cases FALSE;
+ ]
+qed.
record lattice_ : Type ≝ {
latt_mcarr:> semi_lattice;
latt_jcarr_: semi_lattice;
- latt_with: sl_exc latt_jcarr_ = dual_exc (sl_exc latt_mcarr)
+ W1:?; W2:?; W3:?; W4:?; W5:?;
+ latt_with1: latt_jcarr_ = subst_excess_base_in_semi_lattice latt_jcarr_
+ (excess_base_OF_semi_lattice latt_mcarr) W1 W2 W3 W4 W5
}.
lemma latt_jcarr : lattice_ → semi_lattice.
-intro l;
-apply (mk_semi_lattice (dual_exc l));
-unfold excess_OF_lattice_;
-cases (latt_with l); simplify;
-[apply meet|apply meet_refl|apply meet_comm|apply meet_assoc|
-apply strong_extm| apply le_to_eqm|apply lem]
-qed.
-
+intro l; apply (subst_excess_base_in_semi_lattice (latt_jcarr_ l) (excess_base_OF_semi_lattice (latt_mcarr l)) (W1 l) (W2 l) (W3 l) (W4 l) (W5 l));
+qed.
+
coercion cic:/matita/lattice/latt_jcarr.con.
interpretation "Lattice meet" 'and a b =
- (cic:/matita/lattice/meet.con (cic:/matita/lattice/latt_mcarr.con _) a b).
+ (cic:/matita/lattice/sl_meet.con (cic:/matita/lattice/latt_mcarr.con _) a b).
interpretation "Lattice join" 'or a b =
- (cic:/matita/lattice/meet.con (cic:/matita/lattice/latt_jcarr.con _) a b).
+ (cic:/matita/lattice/sl_meet.con (cic:/matita/lattice/latt_jcarr.con _) a b).
record lattice : Type ≝ {
latt_carr:> lattice_;
notation "'le_to_eqj'" non associative with precedence 50 for @{'le_to_eqj}.
notation "'lej'" non associative with precedence 50 for @{'lej}.
-interpretation "Lattice meet" 'meet = (cic:/matita/lattice/meet.con (cic:/matita/lattice/latt_mcarr.con _)).
-interpretation "Lattice meet_refl" 'meet_refl = (cic:/matita/lattice/meet_refl.con (cic:/matita/lattice/latt_mcarr.con _)).
-interpretation "Lattice meet_comm" 'meet_comm = (cic:/matita/lattice/meet_comm.con (cic:/matita/lattice/latt_mcarr.con _)).
-interpretation "Lattice meet_assoc" 'meet_assoc = (cic:/matita/lattice/meet_assoc.con (cic:/matita/lattice/latt_mcarr.con _)).
-interpretation "Lattice strong_extm" 'strong_extm = (cic:/matita/lattice/strong_extm.con (cic:/matita/lattice/latt_mcarr.con _)).
-interpretation "Lattice le_to_eqm" 'le_to_eqm = (cic:/matita/lattice/le_to_eqm.con (cic:/matita/lattice/latt_mcarr.con _)).
-interpretation "Lattice lem" 'lem = (cic:/matita/lattice/lem.con (cic:/matita/lattice/latt_mcarr.con _)).
-interpretation "Lattice join" 'join = (cic:/matita/lattice/meet.con (cic:/matita/lattice/latt_jcarr.con _)).
-interpretation "Lattice join_refl" 'join_refl = (cic:/matita/lattice/meet_refl.con (cic:/matita/lattice/latt_jcarr.con _)).
-interpretation "Lattice join_comm" 'join_comm = (cic:/matita/lattice/meet_comm.con (cic:/matita/lattice/latt_jcarr.con _)).
-interpretation "Lattice join_assoc" 'join_assoc = (cic:/matita/lattice/meet_assoc.con (cic:/matita/lattice/latt_jcarr.con _)).
-interpretation "Lattice strong_extm" 'strong_extj = (cic:/matita/lattice/strong_extm.con (cic:/matita/lattice/latt_jcarr.con _)).
-interpretation "Lattice le_to_eqj" 'le_to_eqj = (cic:/matita/lattice/le_to_eqm.con (cic:/matita/lattice/latt_jcarr.con _)).
-interpretation "Lattice lej" 'lej = (cic:/matita/lattice/lem.con (cic:/matita/lattice/latt_jcarr.con _)).
+interpretation "Lattice meet" 'meet = (cic:/matita/lattice/sl_meet.con (cic:/matita/lattice/latt_mcarr.con _)).
+interpretation "Lattice meet_refl" 'meet_refl = (cic:/matita/lattice/sl_meet_refl.con (cic:/matita/lattice/latt_mcarr.con _)).
+interpretation "Lattice meet_comm" 'meet_comm = (cic:/matita/lattice/sl_meet_comm.con (cic:/matita/lattice/latt_mcarr.con _)).
+interpretation "Lattice meet_assoc" 'meet_assoc = (cic:/matita/lattice/sl_meet_assoc.con (cic:/matita/lattice/latt_mcarr.con _)).
+interpretation "Lattice strong_extm" 'strong_extm = (cic:/matita/lattice/sl_strong_extm.con (cic:/matita/lattice/latt_mcarr.con _)).
+interpretation "Lattice le_to_eqm" 'le_to_eqm = (cic:/matita/lattice/sl_le_to_eqm.con (cic:/matita/lattice/latt_mcarr.con _)).
+interpretation "Lattice lem" 'lem = (cic:/matita/lattice/sl_lem.con (cic:/matita/lattice/latt_mcarr.con _)).
+interpretation "Lattice join" 'join = (cic:/matita/lattice/sl_meet.con (cic:/matita/lattice/latt_jcarr.con _)).
+interpretation "Lattice join_refl" 'join_refl = (cic:/matita/lattice/sl_meet_refl.con (cic:/matita/lattice/latt_jcarr.con _)).
+interpretation "Lattice join_comm" 'join_comm = (cic:/matita/lattice/sl_meet_comm.con (cic:/matita/lattice/latt_jcarr.con _)).
+interpretation "Lattice join_assoc" 'join_assoc = (cic:/matita/lattice/sl_meet_assoc.con (cic:/matita/lattice/latt_jcarr.con _)).
+interpretation "Lattice strong_extm" 'strong_extj = (cic:/matita/lattice/sl_strong_extm.con (cic:/matita/lattice/latt_jcarr.con _)).
+interpretation "Lattice le_to_eqj" 'le_to_eqj = (cic:/matita/lattice/sl_le_to_eqm.con (cic:/matita/lattice/latt_jcarr.con _)).
+interpretation "Lattice lej" 'lej = (cic:/matita/lattice/sl_lem.con (cic:/matita/lattice/latt_jcarr.con _)).
notation "'feq_jl'" non associative with precedence 50 for @{'feq_jl}.
notation "'feq_jr'" non associative with precedence 50 for @{'feq_jr}.
-interpretation "Lattice feq_jl" 'feq_jl = (cic:/matita/lattice/feq_ml.con (cic:/matita/lattice/latt_jcarr.con _)).
-interpretation "Lattice feq_jr" 'feq_jr = (cic:/matita/lattice/feq_mr.con (cic:/matita/lattice/latt_jcarr.con _)).
notation "'feq_ml'" non associative with precedence 50 for @{'feq_ml}.
notation "'feq_mr'" non associative with precedence 50 for @{'feq_mr}.
-interpretation "Lattice feq_ml" 'feq_ml = (cic:/matita/lattice/feq_ml.con (cic:/matita/lattice/latt_mcarr.con _)).
-interpretation "Lattice feq_mr" 'feq_mr = (cic:/matita/lattice/feq_mr.con (cic:/matita/lattice/latt_mcarr.con _)).
+interpretation "Lattice feq_jl" 'feq_jl = (cic:/matita/lattice/sl_feq_ml.con (cic:/matita/lattice/latt_jcarr.con _)).
+interpretation "Lattice feq_jr" 'feq_jr = (cic:/matita/lattice/sl_feq_mr.con (cic:/matita/lattice/latt_jcarr.con _)).
+interpretation "Lattice feq_ml" 'feq_ml = (cic:/matita/lattice/sl_feq_ml.con (cic:/matita/lattice/latt_mcarr.con _)).
+interpretation "Lattice feq_mr" 'feq_mr = (cic:/matita/lattice/sl_feq_mr.con (cic:/matita/lattice/latt_mcarr.con _)).
+
+
+interpretation "Lattive meet le" 'leq a b =
+ (cic:/matita/excess/le.con (cic:/matita/lattice/excess_OF_lattice1.con _) a b).
+
+interpretation "Lattive join le (aka ge)" 'geq a b =
+ (cic:/matita/excess/le.con (cic:/matita/lattice/excess_OF_lattice.con _) a b).
+
+(* these coercions help unification, handmaking a bit of conversion
+ over an open term
+*)
+lemma le_to_ge: ∀l:lattice.∀a,b:l.a ≤ b → b ≥ a.
+intros(l a b H); apply H;
+qed.
+
+lemma ge_to_le: ∀l:lattice.∀a,b:l.b ≥ a → a ≤ b.
+intros(l a b H); apply H;
+qed.
+coercion cic:/matita/lattice/le_to_ge.con nocomposites.
+coercion cic:/matita/lattice/ge_to_le.con nocomposites.
\ No newline at end of file
projects / helm.git / blobdiff