matita/matita/contribs/lambdadelta/ground_2/lib/ltc.ma

   1 (**************************************************************************)
   2 (*       ___                                                              *)
   3 (*      ||M||                                                             *)
   4 (*      ||A||       A project by Andrea Asperti                           *)
   5 (*      ||T||                                                             *)
   6 (*      ||I||       Developers:                                           *)
   7 (*      ||T||         The HELM team.                                      *)
   8 (*      ||A||         http://helm.cs.unibo.it                             *)
   9 (*      \   /                                                             *)
  10 (*       \ /        This file is distributed under the terms of the       *)
  11 (*        v         GNU General Public License Version 2                  *)
  12 (*                                                                        *)
  13 (**************************************************************************)
  14
  15 include "ground_2/lib/functions.ma".
  16
  17 (* LABELLED TRANSITIVE CLOSURE **********************************************)
  18
  19 inductive ltc (A:Type[0]) (f) (B) (R:relation3 A B B): relation3 A B B ≝
  20 | ltc_rc   : ∀a,b1,b2. R a b1 b2 → ltc … a b1 b2
  21 | ltc_trans: ∀a1,a2,b1,b,b2. ltc … a1 b1 b → ltc … a2 b b2 → ltc … (f a1 a2) b1 b2
  22 .
  23
  24 (* Basic properties *********************************************************)
  25
  26 lemma ltc_sn (A) (f) (B) (R): ∀a1,b1,b. R a1 b1 b →
  27                               ∀a2,b2. ltc A f B R a2 b b2 → ltc … f … R (f a1 a2) b1 b2.
  28 /3 width=3 by ltc_rc, ltc_trans/ qed.
  29
  30 lemma ltc_dx (A) (f) (B) (R): ∀a1,b1,b. ltc A f B R a1 b1 b →
  31                               ∀a2,b2. R a2 b b2 → ltc … f … R (f a1 a2) b1 b2.
  32 /3 width=3 by ltc_rc, ltc_trans/ qed.
  33
  34 (* Basic eliminators ********************************************************)
  35
  36 lemma ltc_ind_sn (A) (f) (B) (R) (Q:relation2 A B) (b2): associative … f →
  37                  (∀a,b1. R a b1 b2 → Q a b1) →
  38                  (∀a1,a2,b1,b. R a1 b1 b → ltc … f … R a2 b b2 → Q a2 b → Q (f a1 a2) b1) →
  39                  ∀a,b1. ltc … f … R a b1 b2 → Q a b1.
  40 #A #f #B #R #Q #b2 #Hf #IH1 #IH2 #a #b1 @(insert_eq … b2)
  41 #b0 #H elim H -a -b1 -b0 /2 width=2 by/
  42 #a1 #a2 #b1 #b #b0 #H #Hb2 #_
  43 generalize in match Hb2; generalize in match a2; -Hb2 -a2
  44 elim H -a1 -b1 -b /4 width=4 by ltc_trans/
  45 qed-.
  46
  47 lemma ltc_ind_dx (A) (f) (B) (R) (Q:A→predicate B) (b1): associative … f →
  48                  (∀a,b2. R a b1 b2 → Q a b2) →
  49                  (∀a1,a2,b,b2. ltc … f … R a1 b1 b → Q a1 b → R a2 b b2 → Q (f a1 a2) b2) →
  50                  ∀a,b2. ltc … f … R a b1 b2 → Q a b2.
  51 #A #f #B #R #Q #b1 #Hf #IH1 #IH2 #a #b2 @(insert_eq … b1)
  52 #b0 #H elim H -a -b0 -b2 /2 width=2 by/
  53 #a1 #a2 #b0 #b #b2 #Hb0 #H #IHb0 #_
  54 generalize in match IHb0; generalize in match Hb0; generalize in match a1; -IHb0 -Hb0 -a1
  55 elim H -a2 -b -b2 /4 width=4 by ltc_trans/
  56 qed-.
  57
  58 (* Advanced elimiators with reflexivity *************************************)
  59
  60 lemma ltc_ind_sn_refl (A) (i) (f) (B) (R) (Q:relation2 A B) (b2):
  61                       associative … f → right_identity … f i → reflexive B (R i) →
  62                       Q i b2 →
  63                       (∀a1,a2,b1,b. R a1 b1 b → ltc … f … R a2 b b2 → Q a2 b → Q (f a1 a2) b1) →
  64                       ∀a,b1. ltc … f … R a b1 b2 → Q a b1.
  65 #A #i #f #B #R #Q #b2 #H1f #H2f #HR #IH1 #IH2 #a #b1 #H
  66 @(ltc_ind_sn … R … H1f … IH2 … H) -a -b1 -H1f #a #b1 #Hb12
  67 >(H2f a) -H2f /3 width=4 by ltc_rc/
  68 qed-.
  69
  70 lemma ltc_ind_dx_refl (A) (i) (f) (B) (R) (Q:A→predicate B) (b1):
  71                       associative … f → left_identity … f i → reflexive B (R i) →
  72                       Q i b1 →
  73                       (∀a1,a2,b,b2. ltc … f … R a1 b1 b → Q a1 b → R a2 b b2 → Q (f a1 a2) b2) →
  74                       ∀a,b2. ltc … f … R a b1 b2 → Q a b2.
  75 #A #i #f #B #R #Q #b1 #H1f #H2f #HR #IH1 #IH2 #a #b2 #H
  76 @(ltc_ind_dx … R … H1f … IH2 … H) -a -b2 -H1f #a #b2 #Hb12
  77 >(H2f a) -H2f /3 width=4 by ltc_rc/
  78 qed-.