1 (**************************************************************************)
4 (* ||A|| A project by Andrea Asperti *)
6 (* ||I|| Developers: *)
7 (* ||T|| The HELM team. *)
8 (* ||A|| http://helm.tcs.unibo.it *)
10 (* \ / This file is distributed under the terms of the *)
11 (* v GNU General Public License Version 2 *)
13 (**************************************************************************)
15 include "ground/notation/relations/rat_3.ma".
16 include "ground/arith/pnat_plus.ma".
17 include "ground/arith/pnat_lt_pred.ma".
18 include "ground/relocation/rtmap_id.ma".
20 (* RELOCATION MAP ***********************************************************)
22 coinductive at: relation3 rtmap pnat pnat ā
23 | at_refl: āf,g,j1,j2. ā«Æf = g ā š = j1 ā š = j2 ā at g j1 j2
24 | at_push: āf,i1,i2. at f i1 i2 ā āg,j1,j2. ā«Æf = g ā āi1 = j1 ā āi2 = j2 ā at g j1 j2
25 | at_next: āf,i1,i2. at f i1 i2 ā āg,j2. āf = g ā āi2 = j2 ā at g i1 j2
28 interpretation "relational application (rtmap)"
29 'RAt i1 f i2 = (at f i1 i2).
31 definition H_at_div: relation4 rtmap rtmap rtmap rtmap ā Ī»f2,g2,f1,g1.
32 ājf,jg,j. @āŖjf,f2ā« ā j ā @āŖjg,g2ā« ā j ā
33 āāj0. @āŖj0,f1ā« ā jf & @āŖj0,g1ā« ā jg.
35 (* Basic inversion lemmas ***************************************************)
37 lemma at_inv_ppx: āf,i1,i2. @āŖi1,fā« ā i2 ā āg. š = i1 ā ā«Æg = f ā š = i2.
38 #f #i1 #i2 * -f -i1 -i2 //
39 [ #f #i1 #i2 #_ #g #j1 #j2 #_ * #_ #x #H destruct
40 | #f #i1 #i2 #_ #g #j2 * #_ #x #_ #H elim (discr_push_next ā¦ H)
44 lemma at_inv_npx: āf,i1,i2. @āŖi1,fā« ā i2 ā āg,j1. āj1 = i1 ā ā«Æg = f ā
45 āāj2. @āŖj1,gā« ā j2 & āj2 = i2.
46 #f #i1 #i2 * -f -i1 -i2
47 [ #f #g #j1 #j2 #_ * #_ #x #x1 #H destruct
48 | #f #i1 #i2 #Hi #g #j1 #j2 * * * #x #x1 #H #Hf >(injective_push ā¦ Hf) -g destruct /2 width=3 by ex2_intro/
49 | #f #i1 #i2 #_ #g #j2 * #_ #x #x1 #_ #H elim (discr_push_next ā¦ H)
53 lemma at_inv_xnx: āf,i1,i2. @āŖi1,fā« ā i2 ā āg. āg = f ā
54 āāj2. @āŖi1,gā« ā j2 & āj2 = i2.
55 #f #i1 #i2 * -f -i1 -i2
56 [ #f #g #j1 #j2 * #_ #_ #x #H elim (discr_next_push ā¦ H)
57 | #f #i1 #i2 #_ #g #j1 #j2 * #_ #_ #x #H elim (discr_next_push ā¦ H)
58 | #f #i1 #i2 #Hi #g #j2 * * #x #H >(injective_next ā¦ H) -g /2 width=3 by ex2_intro/
62 (* Advanced inversion lemmas ************************************************)
64 alias symbol "UpArrow" (instance 3) = "successor (positive integers)".
65 lemma at_inv_ppn: āf,i1,i2. @āŖi1,fā« ā i2 ā
66 āg,j2. š = i1 ā ā«Æg = f ā āj2 = i2 ā ā„.
67 #f #i1 #i2 #Hf #g #j2 #H1 #H <(at_inv_ppx ā¦ Hf ā¦ H1 H) -f -g -i1 -i2
71 alias symbol "UpArrow" (instance 7) = "successor (positive integers)".
72 lemma at_inv_npp: āf,i1,i2. @āŖi1,fā« ā i2 ā
73 āg,j1. āj1 = i1 ā ā«Æg = f ā š = i2 ā ā„.
74 #f #i1 #i2 #Hf #g #j1 #H1 #H elim (at_inv_npx ā¦ Hf ā¦ H1 H) -f -i1
75 #x2 #Hg * -i2 #H destruct
78 lemma at_inv_npn: āf,i1,i2. @āŖi1,fā« ā i2 ā
79 āg,j1,j2. āj1 = i1 ā ā«Æg = f ā āj2 = i2 ā @āŖj1,gā« ā j2.
80 #f #i1 #i2 #Hf #g #j1 #j2 #H1 #H elim (at_inv_npx ā¦ Hf ā¦ H1 H) -f -i1
81 #x2 #Hg * -i2 #H destruct //
84 lemma at_inv_xnp: āf,i1,i2. @āŖi1,fā« ā i2 ā
85 āg. āg = f ā š = i2 ā ā„.
86 #f #i1 #i2 #Hf #g #H elim (at_inv_xnx ā¦ Hf ā¦ H) -f
87 #x2 #Hg * -i2 #H destruct
90 lemma at_inv_xnn: āf,i1,i2. @āŖi1,fā« ā i2 ā
91 āg,j2. āg = f ā āj2 = i2 ā @āŖi1,gā« ā j2.
92 #f #i1 #i2 #Hf #g #j2 #H elim (at_inv_xnx ā¦ Hf ā¦ H) -f
93 #x2 #Hg * -i2 #H destruct //
96 lemma at_inv_pxp: āf,i1,i2. @āŖi1,fā« ā i2 ā š = i1 ā š = i2 ā āg. ā«Æg = f.
97 #f elim (pn_split ā¦ f) * /2 width=2 by ex_intro/
98 #g #H #i1 #i2 #Hf #H1 #H2 cases (at_inv_xnp ā¦ Hf ā¦ H H2)
101 lemma at_inv_pxn: āf,i1,i2. @āŖi1,fā« ā i2 ā āj2. š = i1 ā āj2 = i2 ā
102 āāg. @āŖi1,gā« ā j2 & āg = f.
103 #f elim (pn_split ā¦ f) *
104 #g #H #i1 #i2 #Hf #j2 #H1 #H2
105 [ elim (at_inv_ppn ā¦ Hf ā¦ H1 H H2)
106 | /3 width=5 by at_inv_xnn, ex2_intro/
110 alias symbol "UpArrow" (instance 5) = "successor (positive integers)".
111 lemma at_inv_nxp: āf,i1,i2. @āŖi1,fā« ā i2 ā
112 āj1. āj1 = i1 ā š = i2 ā ā„.
113 #f elim (pn_split f) *
114 #g #H #i1 #i2 #Hf #j1 #H1 #H2
115 [ elim (at_inv_npp ā¦ Hf ā¦ H1 H H2)
116 | elim (at_inv_xnp ā¦ Hf ā¦ H H2)
120 lemma at_inv_nxn: āf,i1,i2. @āŖi1,fā« ā i2 ā āj1,j2. āj1 = i1 ā āj2 = i2 ā
121 (āāg. @āŖj1,gā« ā j2 & ā«Æg = f) āØ
122 āāg. @āŖi1,gā« ā j2 & āg = f.
123 #f elim (pn_split f) *
124 /4 width=7 by at_inv_xnn, at_inv_npn, ex2_intro, or_intror, or_introl/
127 (* Note: the following inversion lemmas must be checked *)
128 lemma at_inv_xpx: āf,i1,i2. @āŖi1,fā« ā i2 ā āg. ā«Æg = f ā
129 āØāØ ā§ā§ š = i1 & š = i2
130 | āāj1,j2. @āŖj1,gā« ā j2 & āj1 = i1 & āj2 = i2.
131 #f * [2: #i1 ] #i2 #Hf #g #H
132 [ elim (at_inv_npx ā¦ Hf ā¦ H) -f /3 width=5 by or_intror, ex3_2_intro/
133 | >(at_inv_ppx ā¦ Hf ā¦ H) -f /3 width=1 by conj, or_introl/
137 lemma at_inv_xpp: āf,i1,i2. @āŖi1,fā« ā i2 ā āg. ā«Æg = f ā š = i2 ā š = i1.
138 #f #i1 #i2 #Hf #g #H elim (at_inv_xpx ā¦ Hf ā¦ H) -f * //
139 #j1 #j2 #_ #_ * -i2 #H destruct
142 lemma at_inv_xpn: āf,i1,i2. @āŖi1,fā« ā i2 ā āg,j2. ā«Æg = f ā āj2 = i2 ā
143 āāj1. @āŖj1,gā« ā j2 & āj1 = i1.
144 #f #i1 #i2 #Hf #g #j2 #H elim (at_inv_xpx ā¦ Hf ā¦ H) -f *
145 [ #_ * -i2 #H destruct
146 | #x1 #x2 #Hg #H1 * -i2 #H destruct /2 width=3 by ex2_intro/
150 lemma at_inv_xxp: āf,i1,i2. @āŖi1,fā« ā i2 ā š = i2 ā
151 āāg. š = i1 & ā«Æg = f.
152 #f elim (pn_split f) *
153 #g #H #i1 #i2 #Hf #H2
154 [ /3 width=6 by at_inv_xpp, ex2_intro/
155 | elim (at_inv_xnp ā¦ Hf ā¦ H H2)
159 lemma at_inv_xxn: āf,i1,i2. @āŖi1,fā« ā i2 ā āj2. āj2 = i2 ā
160 (āāg,j1. @āŖj1,gā« ā j2 & āj1 = i1 & ā«Æg = f) āØ
161 āāg. @āŖi1,gā« ā j2 & āg = f.
162 #f elim (pn_split f) *
163 #g #H #i1 #i2 #Hf #j2 #H2
164 [ elim (at_inv_xpn ā¦ Hf ā¦ H H2) -i2 /3 width=5 by or_introl, ex3_2_intro/
165 | lapply (at_inv_xnn ā¦ Hf ā¦ H H2) -i2 /3 width=3 by or_intror, ex2_intro/
169 (* Basic forward lemmas *****************************************************)
171 lemma at_increasing: āi2,i1,f. @āŖi1,fā« ā i2 ā i1 ā¤ i2.
173 [ #i1 #f #Hf elim (at_inv_xxp ā¦ Hf) -Hf //
175 #i1 #f #Hf elim (at_inv_nxn ā¦ Hf) -Hf [1,4: * |*: // ]
176 /3 width=2 by ple_succ_bi, ple_succ_dx/
180 lemma at_increasing_strict: āg,i1,i2. @āŖi1,gā« ā i2 ā āf. āf = g ā
181 i1 < i2 ā§ @āŖi1,fā« ā āi2.
182 #g #i1 #i2 #Hg #f #H elim (at_inv_xnx ā¦ Hg ā¦ H) -Hg -H
183 /4 width=2 by conj, at_increasing, ple_succ_bi/
186 lemma at_fwd_id_ex: āf,i. @āŖi,fā« ā i ā āg. ā«Æg = f.
187 #f elim (pn_split f) * /2 width=2 by ex_intro/
188 #g #H #i #Hf elim (at_inv_xnx ā¦ Hf ā¦ H) -Hf -H
189 #j2 #Hg #H destruct lapply (at_increasing ā¦ Hg) -Hg
190 #H elim (plt_ge_false ā¦ H) -H //
193 (* Basic properties *********************************************************)
195 corec lemma at_eq_repl_back: āi1,i2. eq_repl_back (Ī»f. @āŖi1,fā« ā i2).
196 #i1 #i2 #f1 #H1 cases H1 -f1 -i1 -i2
197 [ #f1 #g1 #j1 #j2 #H #H1 #H2 #f2 #H12 cases (eq_inv_px ā¦ H12 ā¦ H) -g1 /2 width=2 by at_refl/
198 | #f1 #i1 #i2 #Hf1 #g1 #j1 #j2 #H #H1 #H2 #f2 #H12 cases (eq_inv_px ā¦ H12 ā¦ H) -g1 /3 width=7 by at_push/
199 | #f1 #i1 #i2 #Hf1 #g1 #j2 #H #H2 #f2 #H12 cases (eq_inv_nx ā¦ H12 ā¦ H) -g1 /3 width=5 by at_next/
203 lemma at_eq_repl_fwd: āi1,i2. eq_repl_fwd (Ī»f. @āŖi1,fā« ā i2).
204 #i1 #i2 @eq_repl_sym /2 width=3 by at_eq_repl_back/
207 lemma at_le_ex: āj2,i2,f. @āŖi2,fā« ā j2 ā āi1. i1 ā¤ i2 ā
208 āāj1. @āŖi1,fā« ā j1 & j1 ā¤ j2.
209 #j2 elim j2 -j2 [2: #j2 #IH ] #i2 #f #Hf
210 [ elim (at_inv_xxn ā¦ Hf) -Hf [1,3: * |*: // ]
211 #g [ #x2 ] #Hg [ #H2 ] #H0
212 [ * /3 width=3 by at_refl, ex2_intro/
213 #i1 #Hi12 destruct lapply (ple_inv_succ_bi ā¦ Hi12) -Hi12
214 #Hi12 elim (IH ā¦ Hg ā¦ Hi12) -x2 -IH
215 /3 width=7 by at_push, ex2_intro, ple_succ_bi/
216 | #i1 #Hi12 elim (IH ā¦ Hg ā¦ Hi12) -IH -i2
217 /3 width=5 by at_next, ex2_intro, ple_succ_bi/
219 | elim (at_inv_xxp ā¦ Hf) -Hf //
220 #g * -i2 #H2 #i1 #Hi12 <(ple_inv_unit_dx ā¦ Hi12)
221 /3 width=3 by at_refl, ex2_intro/
225 lemma at_id_le: āi1,i2. i1 ā¤ i2 ā āf. @āŖi2,fā« ā i2 ā @āŖi1,fā« ā i1.
226 #i1 #i2 #H @(ple_ind_alt ā¦ H) -i1 -i2 [ #i2 | #i1 #i2 #_ #IH ]
227 #f #Hf elim (at_fwd_id_ex ā¦ Hf) /4 width=7 by at_inv_npn, at_push, at_refl/
230 (* Main properties **********************************************************)
232 theorem at_monotonic: āj2,i2,f. @āŖi2,fā« ā j2 ā āj1,i1. @āŖi1,fā« ā j1 ā
235 [ #i2 #f #H2f elim (at_inv_xxp ā¦ H2f) -H2f //
236 #g #H21 #_ #j1 #i1 #_ #Hi elim (plt_ge_false ā¦ Hi) -Hi //
237 | #j2 #IH #i2 #f #H2f * //
238 #j1 #i1 #H1f #Hi elim (plt_inv_gen ā¦ Hi)
239 #_ #Hi2 elim (at_inv_nxn ā¦ H2f (āi2)) -H2f [1,3: * |*: // ]
241 [ elim (at_inv_xpn ā¦ H1f ā¦ H) -f
242 /4 width=8 by plt_inv_succ_bi, plt_succ_bi/
243 | /4 width=8 by at_inv_xnn, plt_succ_bi/
248 theorem at_inv_monotonic: āj1,i1,f. @āŖi1,fā« ā j1 ā āj2,i2. @āŖi2,fā« ā j2 ā
251 [ #i1 #f #H1f elim (at_inv_xxp ā¦ H1f) -H1f //
252 #g * -i1 #H #j2 #i2 #H2f #Hj lapply (plt_des_gen ā¦ Hj) -Hj
253 #H22 elim (at_inv_xpn ā¦ H2f ā¦ (āj2) H) -f //
255 [ #f #H1f elim (at_inv_pxn ā¦ H1f) -H1f [ |*: // ]
256 #g #H1g #H #j2 #i2 #H2f #Hj elim (plt_inv_succ_sn ā¦ Hj) -Hj
257 /3 width=7 by at_inv_xnn/
258 | #i1 #f #H1f #j2 #i2 #H2f #Hj elim (plt_inv_succ_sn ā¦ Hj) -Hj
259 #Hj #H22 elim (at_inv_nxn ā¦ H1f) -H1f [1,4: * |*: // ]
261 [ elim (at_inv_xpn ā¦ H2f ā¦ (āj2) H) -f
262 /3 width=7 by plt_succ_bi/
263 | /3 width=7 by at_inv_xnn/
269 theorem at_mono: āf,i,i1. @āŖi,fā« ā i1 ā āi2. @āŖi,fā« ā i2 ā i2 = i1.
270 #f #i #i1 #H1 #i2 #H2 elim (pnat_split_lt_eq_gt i2 i1) //
271 #Hi elim (plt_ge_false i i) /3 width=6 by at_inv_monotonic, eq_sym/
274 theorem at_inj: āf,i1,i. @āŖi1,fā« ā i ā āi2. @āŖi2,fā« ā i ā i1 = i2.
275 #f #i1 #i #H1 #i2 #H2 elim (pnat_split_lt_eq_gt i2 i1) //
276 #Hi elim (plt_ge_false i i) /2 width=6 by at_monotonic/
279 theorem at_div_comm: āf2,g2,f1,g1.
280 H_at_div f2 g2 f1 g1 ā H_at_div g2 f2 g1 f1.
281 #f2 #g2 #f1 #g1 #IH #jg #jf #j #Hg #Hf
282 elim (IH ā¦ Hf Hg) -IH -j /2 width=3 by ex2_intro/
285 theorem at_div_pp: āf2,g2,f1,g1.
286 H_at_div f2 g2 f1 g1 ā H_at_div (ā«Æf2) (ā«Æg2) (ā«Æf1) (ā«Æg1).
287 #f2 #g2 #f1 #g1 #IH #jf #jg #j #Hf #Hg
288 elim (at_inv_xpx ā¦ Hf) -Hf [1,2: * |*: // ]
289 [ #H1 #H2 destruct -IH
290 lapply (at_inv_xpp ā¦ Hg ???) -Hg [4: |*: // ] #H destruct
291 /3 width=3 by at_refl, ex2_intro/
292 | #xf #i #Hf2 #H1 #H2 destruct
293 lapply (at_inv_xpn ā¦ Hg ????) -Hg [5: * |*: // ] #xg #Hg2 #H destruct
294 elim (IH ā¦ Hf2 Hg2) -IH -i /3 width=9 by at_push, ex2_intro/
298 theorem at_div_nn: āf2,g2,f1,g1.
299 H_at_div f2 g2 f1 g1 ā H_at_div (āf2) (āg2) (f1) (g1).
300 #f2 #g2 #f1 #g1 #IH #jf #jg #j #Hf #Hg
301 elim (at_inv_xnx ā¦ Hf) -Hf [ |*: // ] #i #Hf2 #H destruct
302 lapply (at_inv_xnn ā¦ Hg ????) -Hg [5: |*: // ] #Hg2
303 elim (IH ā¦ Hf2 Hg2) -IH -i /2 width=3 by ex2_intro/
306 theorem at_div_np: āf2,g2,f1,g1.
307 H_at_div f2 g2 f1 g1 ā H_at_div (āf2) (ā«Æg2) (f1) (āg1).
308 #f2 #g2 #f1 #g1 #IH #jf #jg #j #Hf #Hg
309 elim (at_inv_xnx ā¦ Hf) -Hf [ |*: // ] #i #Hf2 #H destruct
310 lapply (at_inv_xpn ā¦ Hg ????) -Hg [5: * |*: // ] #xg #Hg2 #H destruct
311 elim (IH ā¦ Hf2 Hg2) -IH -i /3 width=7 by at_next, ex2_intro/
314 theorem at_div_pn: āf2,g2,f1,g1.
315 H_at_div f2 g2 f1 g1 ā H_at_div (ā«Æf2) (āg2) (āf1) (g1).
316 /4 width=6 by at_div_np, at_div_comm/ qed-.
318 (* Properties on tls ********************************************************)
320 (* Note: this requires ā on first n *)
321 lemma at_pxx_tls: ān,f. @āŖš,fā« ā ān ā @āŖš,ā«±*[n]fā« ā š.
322 #n @(nat_ind_succ ā¦ n) -n //
324 cases (at_inv_pxn ā¦ Hf) -Hf [ |*: // ] #g #Hg #H0 destruct
325 <tls_xn /2 width=1 by/
328 (* Note: this requires ā on third n2 *)
329 lemma at_tls: ān2,f. ā«Æā«±*[ān2]f ā” ā«±*[n2]f ā āi1. @āŖi1,fā« ā ān2.
330 #n2 @(nat_ind_succ ā¦ n2) -n2
331 [ /4 width=4 by at_eq_repl_back, at_refl, ex_intro/
332 | #n2 #IH #f <tls_xn <tls_xn in ā¢ (??%ā?); #H
333 elim (IH ā¦ H) -IH -H #i1 #Hf
334 elim (pn_split f) * #g #Hg destruct /3 width=8 by at_push, at_next, ex_intro/
338 (* Inversion lemmas with tls ************************************************)
340 (* Note: this does not require ā on second and third p *)
341 lemma at_inv_nxx: āp,g,i1,j2. @āŖāi1,gā« ā j2 ā @āŖš,gā« ā p ā
342 āāi2. @āŖi1,ā«±*[p]gā« ā i2 & p+i2 = j2.
345 elim (at_inv_pxp ā¦ H) -H [ |*: // ] #f #H0
346 elim (at_inv_npx ā¦ Hg ā¦ H0) -Hg [ |*: // ] #x2 #Hf #H2 destruct
347 /2 width=3 by ex2_intro/
348 | #n #IH #g #i1 #j2 #Hg #H
349 elim (at_inv_pxn ā¦ H) -H [ |*: // ] #f #Hf2 #H0
350 elim (at_inv_xnx ā¦ Hg ā¦ H0) -Hg #x2 #Hf1 #H2 destruct
351 elim (IH ā¦ Hf1 Hf2) -IH -Hf1 -Hf2 #i2 #Hf #H2 destruct
352 /2 width=3 by ex2_intro/
356 (* Note: this requires ā on first n2 *)
357 lemma at_inv_tls: ān2,i1,f. @āŖi1,fā« ā ān2 ā ā«Æā«±*[ān2]f ā” ā«±*[n2]f.
358 #n2 @(nat_ind_succ ā¦ n2) -n2
359 [ #i1 #f #Hf elim (at_inv_xxp ā¦ Hf) -Hf // #g #H1 #H destruct
360 /2 width=1 by eq_refl/
362 elim (at_inv_xxn ā¦ Hf) -Hf [1,3: * |*: // ]
363 [ #g #j1 #Hg #H1 #H2 | #g #Hg #Ho ] destruct
364 <tls_xn /2 width=2 by/
368 (* Advanced inversion lemmas on isid ****************************************)
370 lemma isid_inv_at: āi,f. šāŖfā« ā @āŖi,fā« ā i.
372 [ #f #H elim (isid_inv_gen ā¦ H) -H /2 width=2 by at_refl/
373 | #i #IH #f #H elim (isid_inv_gen ā¦ H) -H /3 width=7 by at_push/
377 lemma isid_inv_at_mono: āf,i1,i2. šāŖfā« ā @āŖi1,fā« ā i2 ā i1 = i2.
378 /3 width=6 by isid_inv_at, at_mono/ qed-.
380 (* Advanced properties on isid **********************************************)
382 corec lemma isid_at: āf. (āi. @āŖi,fā« ā i) ā šāŖfā«.
383 #f #Hf lapply (Hf (š))
384 #H cases (at_fwd_id_ex ā¦ H) -H
385 #g #H @(isid_push ā¦ H) /3 width=7 by at_inv_npn/
388 (* Advanced properties on id ************************************************)
390 lemma id_inv_at: āf. (āi. @āŖi,fā« ā i) ā šš ā” f.
391 /3 width=1 by isid_at, eq_id_inv_isid/ qed-.
393 lemma id_at: āi. @āŖi,ššā« ā i.
394 /2 width=1 by isid_inv_at/ qed.
396 (* Advanced forward lemmas on id ********************************************)
398 lemma at_id_fwd: āi1,i2. @āŖi1,ššā« ā i2 ā i1 = i2.
399 /2 width=4 by at_mono/ qed.
401 (* Main properties on id ****************************************************)
403 theorem at_div_id_dx: āf. H_at_div f šš šš f.
404 #f #jf #j0 #j #Hf #H0
405 lapply (at_id_fwd ā¦ H0) -H0 #H destruct
406 /2 width=3 by ex2_intro/
409 theorem at_div_id_sn: āf. H_at_div šš f f šš.
410 /3 width=6 by at_div_id_dx, at_div_comm/ qed-.