summaryrefslogtreecommitdiffstats
path: root/server/formal/period_seq.v
diff options
context:
space:
mode:
Diffstat (limited to 'server/formal/period_seq.v')
-rw-r--r--server/formal/period_seq.v834
1 files changed, 834 insertions, 0 deletions
diff --git a/server/formal/period_seq.v b/server/formal/period_seq.v
new file mode 100644
index 0000000..705e505
--- /dev/null
+++ b/server/formal/period_seq.v
@@ -0,0 +1,834 @@
1From stdpp Require Import numbers option sorting ssreflect.
2From stdpp Require Import options.
3From routemon Require Import period util.
4
5(* This setup would require the proof irrelevance stuff
6
7Record period_seq :=
8 PeriodSeq
9 { periods : list period
10 ; Hnonempty : Forall period_nonempty periods
11 ; Hsorted : Sorted period_before periods
12 }.
13*)
14
15Definition period_seq := list ne_period.
16
17Definition period_seq_nf (ps : period_seq) :=
18 Sorted period_before ps.
19
20Instance period_seq_elem_of : ElemOf timestamp period_seq :=
21 λ t, Exists (λ p, t ∈ p).
22Instance period_seq_elem_of_dec t (ps : period_seq) : Decision (t ∈ ps).
23Proof.
24 induction ps as [|p ps].
25 - right. inv 1.
26 - destruct IHps.
27 + left. by apply Exists_cons_tl.
28 + destruct (decide (t ∈ p)).
29 * left. by apply Exists_cons_hd.
30 * right. by inv 1.
31Qed.
32
33Instance period_seq_equiv : Equiv period_seq :=
34 λ ps1 ps2, ∀ t, t ∈ ps1 ↔ t ∈ ps2.
35
36Definition ne_period_intersection (p1 p2 : ne_period) :=
37 let p := `p1 ∩ `p2 in
38 match decide (period_nonempty p) with
39 | left H => Some (p ↾ H)
40 | right _ => None
41 end.
42
43Definition ne_period_start (p : ne_period) :=
44 period_start (`p).
45Definition ne_period_end (p : ne_period) :=
46 period_end (`p).
47
48Definition period_seq_intersection_1 go ps1 ps2 :=
49 match ps1, ps2 with
50 | p1 :: ps1', p2 :: ps2' =>
51 let mp12 := ne_period_intersection p1 p2 in
52 let rest := if decide (ne_period_end p1 < ne_period_end p2)%lim then go ps1' ps2 else go ps1 ps2' in
53 match mp12 with
54 | Some p12 => p12 :: rest
55 | None => rest
56 end
57 | _, _ => []
58 end.
59Fixpoint period_seq_intersection_aux n :=
60 match n with
61 | 0 => const (const [])
62 | S n => period_seq_intersection_1 (period_seq_intersection_aux n)
63 end.
64Instance period_seq_intersection : Intersection period_seq :=
65 λ ps1 ps2, period_seq_intersection_aux (S (length ps1 + length ps2)) ps1 ps2.
66
67Lemma period_seq_intersection_eq ps1 ps2 :
68 period_seq_intersection ps1 ps2 =
69 match ps1, ps2 with
70 | p1 :: ps1', p2 :: ps2' =>
71 let mp12 := ne_period_intersection p1 p2 in
72 let rest := if decide (ne_period_end p1 < ne_period_end p2)%lim
73 then period_seq_intersection ps1' ps2
74 else period_seq_intersection ps1 ps2' in
75 match mp12 with
76 | Some p12 => p12 :: rest
77 | None => rest
78 end
79 | _, _ => []
80 end.
81Proof.
82 destruct ps1 as [|p1 ps1], ps2 as [|p2 ps2]; [done..|].
83 have Hlen1 : S (S (length ps1 + length ps2)) = S (length (p1 :: ps1) + length ps2) by simpl; lia.
84 have Hlen2 : S (S (length ps1 + length ps2)) = S (length ps1 + length (p2 :: ps2)) by simpl; lia.
85 by rewrite
86 /period_seq_intersection /period_seq_intersection_aux
87 !length_cons Nat.add_succ_l Nat.add_succ_r -/period_seq_intersection_aux.
88Qed.
89
90Opaque period_seq_intersection.
91
92Lemma period_seq_nf_cons p ps :
93 period_seq_nf (p :: ps) ↔
94 period_seq_nf ps ∧
95 Forall (λ q, ne_period_end p < ne_period_start q)%lim ps.
96Proof.
97 split.
98 - intros HSort%Sorted_StronglySorted; last apply _.
99 inv HSort. repeat split; try done.
100 + by apply StronglySorted_Sorted.
101 + eapply Forall_impl; first done.
102 intros [[sq eq] Hq] Hbef.
103 by destruct p as [[sp ep] Hp].
104 - intros (Hnf & Hlt).
105 constructor; first done. destruct ps as [|q ps]; constructor.
106 inv Hlt. destruct p as [[sp ep] Hp], q as [[sq eq] Hq]. by simpl in *.
107Qed.
108
109(*
110Lemma list_elem_of_cons_inv `{!EqDecision A} (x y : A) (l : list A) :
111 x ∈ y :: l ↔ x = y ∨ x ≠ y ∧ x ∈ l.
112Proof.
113 split.
114 - destruct (decide (x = y)) as [<-|H].
115 + intros _. by left.
116 + inv 1. by right.
117 - by intros [<-|[_ H]]; constructor.
118Qed.
119*)
120
121Lemma list_elem_of_cons_inv {A} (x y : A) (l : list A) :
122 x ∈ y :: l ↔ x = y ∨ x ∈ l.
123Proof.
124 split.
125 - by inv 1; [left|right].
126 - by intros [<-|H]; constructor.
127Qed.
128
129Lemma Sorted_list_elem_of_R_trans {A} `{!Transitive R} (x y z : A) (l : list A) :
130 Sorted R (y :: l) → z ∈ y :: l → R x y → R x z.
131Proof.
132 intros [HSort Hyl]%Sorted_inv.
133 revert y Hyl.
134 induction HSort as [|y' l' HSort IH Hy'l']; intros y.
135 - intros _. by inv 1; last inv H2.
136 - intros Hyy'%HdRel_inv.
137 intros [->|Hz]%list_elem_of_cons_inv; first done.
138 intros Hxy.
139 have : R x y' by eapply (_ : Transitive R).
140 by apply IH.
141Qed.
142
143Lemma Sorted_list_elem_of_cons_inv {A} `{!Transitive R} (x y : A) (l : list A) :
144 Sorted R (y :: l) →
145 x ∈ y :: l → x = y ∧ Forall (R x) l ∨ R y x ∧ x ∈ l.
146Proof.
147 intros HSort [->|H%list_elem_of_In]%list_elem_of_In%in_inv.
148 - left. by apply Sorted_StronglySorted in HSort as [_ ?]%StronglySorted_inv.
149 - right. inv HSort. inv H3; first inv H.
150 by split; first eapply Sorted_list_elem_of_R_trans.
151Qed.
152
153Lemma period_seq_nf_elem_of_cons_inv (p1 p2 : ne_period) (ps : period_seq) :
154 period_seq_nf (p2 :: ps) →
155 p1 ∈ p2 :: ps → p1 = p2 ∧ Forall (period_before p1) ps ∨
156 period_before p2 p1 ∧ p1 ∈ ps.
157Proof. apply Sorted_list_elem_of_cons_inv. Qed.
158
159Inductive option_Exists {A} (Φ : A → Prop) : option A → Prop :=
160 | Exists_Some (x : A) : Φ x → option_Exists Φ (Some x).
161
162Lemma option_Exists_from_option {A} Φ (mx : option A) :
163 option_Exists Φ mx ↔ from_option Φ False mx.
164Proof. split; by [inv 1 | destruct mx]. Qed.
165
166Lemma period_seq_intersect_lem_aux (p1 p2 : ne_period) (ps1 ps2 : period_seq) :
167 is_Some (ne_period_intersection p1 p2) →
168 period_seq_nf ps1 → period_seq_nf ps2 →
169 p1 ∈ ps1 → p2 ∈ ps2 →
170 option_Exists (.∈ ps1 ∩ ps2) (ne_period_intersection p1 p2).
171Proof.
172 intros Hne. revert ps2.
173 induction ps1 as [|[s1 e1] ps1]; first inv 3.
174 intros ps2 Hnf1 Hnf2 H1 H2. revert ps2 Hnf2 H2.
175 induction ps2 as [|[s2 e2] ps2]; first inv 2.
176 intros Hnf2 H2.
177
178 apply option_Exists_from_option.
179 rewrite /intersection period_seq_intersection_eq /=.
180 apply period_seq_nf_elem_of_cons_inv in H1 as [[-> Hp1]|[Hlt1 H1]]; last done.
181 + apply period_seq_nf_elem_of_cons_inv in H2 as [[-> Hp2]|[Hlt2 H2]]; last done.
182 * unfold ne_period_intersection.
183 case_decide.
184 -- exfalso. simpl in Hne.
185 apply limit_le_cases in H as [contra|contra].
186 ++ rewrite contra in Hne. by eapply (_ : Irreflexive limit_lt).
187 ++ by apply asymmetry in Hne.
188 -- constructor.
189 * case_decide.
190 -- case_decide.
191 ++ (* we need to show that [s1, e1) ## p2 *)
192 exfalso. assert ([s1, e1) ## p2).
193 { unfold disjoint, period_disjoint, period_empty.
194 destruct p2 as [s3 e3]. simpl.
195 destruct Hlt2 as [Hne2 [Hne3 Hlt2]].
196 simpl in Hlt2.
197
198 trans (e1 `min` e2)%lim.
199 { apply limit_le_cases. left.
200 trans e1.
201 - apply limit_min_eq_l, limit_le_cases. right.
202 by trans e2; last trans s3.
203 - apply symmetry, limit_min_eq_l, limit_le_cases. by right. }
204 etrans; first done.
205 apply limit_max_le.
206 split.
207 - apply limit_le_max. by left.
208 - apply limit_le_max. right.
209 apply limit_le_cases. right. by trans e2. }
210 by eapply period_empty_not_nonempty.
211 ++ by apply IHps2; first apply period_seq_nf_cons in Hnf2 as [_ [? _]].
212 -- case_decide.
213 ++ apply not_limit_le in H.
214 (* [s1, e1) ## p2 since e1 < e2 and e2 < p2, but [s1, e1) ∩ p2 ≠ ∅ in hyp *)
215 exfalso. assert ([s1, e1) ## p2).
216 { unfold disjoint, period_disjoint, period_empty.
217 destruct p2 as [s3 e3]. simpl.
218 destruct Hlt2 as [Hne2 [Hne3 Hlt2]].
219 simpl in Hlt2.
220
221 rewrite limit_min_l; last first.
222 { apply limit_le_cases. right.
223 by trans e2; last trans s3. }
224 apply limit_le_max. right.
225 apply limit_le_cases. right.
226 by trans e2. }
227 by eapply period_empty_not_nonempty.
228 ++ constructor. by apply IHps2; first apply period_seq_nf_cons in Hnf2 as (_ & ? & _).
229 + apply period_seq_nf_elem_of_cons_inv in H2 as [[-> Hp2]|[Hlt2 H2]]; last done.
230 * case_decide.
231 -- case_decide.
232 ++ apply IHps1; try done.
233 ** by apply period_seq_nf_cons in Hnf1 as (_ & ? & _).
234 ** by constructor.
235 ++ apply not_limit_lt in H0. exfalso. assert (p1 ## [s2, e2)).
236 { unfold disjoint, period_disjoint, period_empty.
237 destruct p1 as [s3 e3]. simpl.
238 destruct Hlt1 as [Hne1 [Hne3 Hlt1]].
239 simpl in Hlt1.
240
241 trans (e1 `min` e2)%lim.
242 { apply limit_le_cases. left.
243 trans e2.
244 - apply limit_min_eq_r. trans e1; first done.
245 apply limit_le_cases. right. by trans s3.
246 - by apply symmetry, limit_min_eq_r. }
247 etrans; first done.
248 apply limit_max_le.
249 split.
250 - apply limit_le_max. left.
251 apply limit_le_cases. right. by trans e1.
252 - apply limit_le_max. by right. }
253 by eapply period_empty_not_nonempty.
254 -- case_decide.
255 ++ constructor. apply IHps1; try done.
256 ** by apply period_seq_nf_cons in Hnf1 as (_ & ? & _).
257 ** by constructor.
258 ++ apply not_limit_lt in H0. apply not_limit_le in H.
259 exfalso. assert (p1 ## [s2, e2)).
260 { unfold disjoint, period_disjoint, period_empty.
261 destruct p1 as [s3 e3]. simpl.
262 destruct Hlt1 as [Hne1 [Hne3 Hlt1]].
263 simpl in Hlt1.
264
265 rewrite limit_min_r; last first.
266 { trans e1; first done.
267 apply limit_le_cases. right.
268 by trans s3. }
269 trans e1; first done.
270 apply limit_le_max. left.
271 apply limit_le_cases. by right. }
272 by eapply period_empty_not_nonempty.
273 * case_decide.
274 -- case_decide.
275 ++ apply IHps1; try done.
276 ** by apply period_seq_nf_cons in Hnf1 as (_ & ? & _).
277 ** by constructor.
278 ++ by apply IHps2; first apply period_seq_nf_cons in Hnf2 as (_ & ? & _).
279 -- case_decide; constructor.
280 ++ apply IHps1; try done.
281 ** by apply period_seq_nf_cons in Hnf1 as (_ & ? & _).
282 ** by constructor.
283 ++ by apply IHps2; first apply period_seq_nf_cons in Hnf2 as (_ & ? & _).
284Qed.
285
286Lemma period_seq_intersection_inv (p : period) (ps1 ps2 : period_seq) :
287 period_seq_nf ps1 → period_seq_nf ps2 → p ∈ ps1 ∩ ps2 →
288 ∃ p1 p2, p1 ∈ ps1 ∧ p2 ∈ ps2 ∧ p = p1 ∩ p2.
289Proof.
290 intros Hnf1. revert ps2.
291 induction ps1; first inv 2.
292 induction ps2.
293 { intros _ contra.
294 rewrite period_seq_intersection_eq in contra.
295 destruct a. inv contra. }
296 destruct a as [s1 e1], a0 as [s2 e2].
297 intros Hnf2 Hint.
298 rewrite period_seq_intersection_eq in Hint.
299 simpl in Hint. case_decide; case_decide.
300 - apply IHps1 in Hint as (q1 & q2 & Hq1 & Hq2 & ->); last done.
301 + exists q1, q2. by repeat split; first constructor.
302 + by apply period_seq_nf_cons in Hnf1 as (_ & ? & _).
303 - apply IHps2 in Hint as (q1 & q2 & Hq1 & Hq2 & ->).
304 + exists q1, q2. by repeat split; last constructor.
305 + by apply period_seq_nf_cons in Hnf2 as (_ & ? & _).
306 - inv Hint.
307 + exists [s1, e1), [s2, e2). repeat split; constructor.
308 + apply IHps1 in H3 as (q1 & q2 & Hq1 & Hq2 & ->); last done.
309 * exists q1, q2. by repeat split; first constructor.
310 * by apply period_seq_nf_cons in Hnf1 as (_ & ? & _).
311 - inv Hint.
312 + exists [s1, e1), [s2, e2). repeat split; constructor.
313 + apply IHps2 in H3 as (q1 & q2 & Hq1 & Hq2 & ->).
314 * exists q1, q2. by repeat split; last constructor.
315 * by apply period_seq_nf_cons in Hnf2 as (_ & ? & _).
316Qed.
317
318Lemma period_seq_intersection_lem t (ps1 ps2 : period_seq) :
319 period_seq_nf ps1 → period_seq_nf ps2 →
320 t ∈ ps1 ∧ t ∈ ps2 ↔ t ∈ ps1 ∩ ps2.
321Proof.
322 intros Hnf1 Hnf2.
323 split.
324 - intros [H1 H2].
325 unfold elem_of, period_seq_elem_of in H1, H2.
326 apply Exists_exists in H1 as (p1 & Hp1 & Ht1).
327 apply Exists_exists in H2 as (p2 & Hp2 & Ht2).
328 assert (Ht : t ∈ p1 ∩ p2). { by apply intersect_and. }
329 clear Ht1 Ht2.
330 unfold elem_of, period_seq_elem_of.
331 apply Exists_exists. exists (p1 ∩ p2).
332 split; first apply period_seq_intersect_lem_aux; try done.
333 apply period_nonempty_alt_iff. by exists t.
334 - intros (p & Hp & Ht)%Exists_exists.
335 apply period_seq_intersection_inv in Hp as (p1 & p2 & Hp1 & Hp2 & ->); try done.
336 apply intersect_and in Ht as [Ht1 Ht2].
337 split; apply Exists_exists; by eexists.
338Qed.
339
340Definition period_seq_extent (ps : period_seq) : period :=
341 match head ps, last ps with
342 | Some [s, _), Some [_, e) => [s, e)
343 | _, _ => ∅
344 end.
345
346(*
347Lemma period_seq_extent_hd ps :
348 period_seq_nf ps →
349 Forall (period_start (period_seq_extent ps)
350
351Lemma period_seq_extent_spec t ps :
352 period_seq_nf ps → t ∈ ps →
353 t ∈ period_seq_extent ps.
354Proof.
355 Search StronglySorted.
356 induction ps as [|p ps]; first inv 2.
357 intros Hnf. inv 1.
358 -
359
360Qed.
361*)
362
363(*
364Definition period_seq_intersection_extent (ps1 ps2 : period_seq) :
365 period_seq_nf ps1 → period_seq_nf ps2 →
366 period_seq_extent (ps1 ∩ ps2) = period_seq_extent ps1 ∩ period_seq_extent ps2.
367Proof.
368 intros Hnf1 Hnf2.
369 destruct (decide (period_empty (period_seq_extent (ps1 ∩ ps2)))).
370 - admit.
371 - apply period_empty_not_nonempty in n.
372 apply period_nonempty_equiv_L; first done.
373 + admit.
374 + intros t.
375 Search period equiv eq.
376*)
377
378(* The intersection preserves normal forms *)
379Lemma period_seq_intersection_nf (ps1 ps2 : period_seq) :
380 period_seq_nf ps1 → period_seq_nf ps2 → period_seq_nf (ps1 ∩ ps2).
381Proof.
382 intros Hnf1. revert ps2.
383 induction ps1 as [|[s1 e1] ps1]; induction ps2 as [|[s2 e2] ps2]; [done..|].
384 intros Hnf2. rewrite period_seq_intersection_eq /=.
385 case_decide.
386 - case_decide.
387 + by apply IHps1; first apply period_seq_nf_cons in Hnf1 as (_ & ? & _).
388 + apply IHps2. by apply period_seq_nf_cons in Hnf2 as (_ & ? & _).
389 - case_decide.
390 + apply IHps1 in Hnf2 as Hnf2'; last by apply period_seq_nf_cons in Hnf1 as (_ & ? & _).
391 destruct Hnf2' as [Hne HSort]. split.
392 * by constructor; first apply period_empty_not_nonempty.
393 * constructor; first done.
394 rewrite {1}/intersection /period_intersection.
395 apply period_seq_nf_cons in Hnf1 as (Hne1 & Hnf1 & Hlt1).
396 destruct (ps1 ∩ ([s2, e2) :: ps2)) as [|[sq eq] qs] eqn:Hqs; constructor.
397 assert (Hq : [sq, eq) ∈ ps1 ∩ ([s2, e2) :: ps2)).
398 { rewrite Hqs. constructor. }
399 unfold period_before. repeat split.
400 -- by apply period_empty_not_nonempty.
401 -- by eapply Forall_forall; first apply Hne.
402 -- specialize (IHps1 Hnf1).
403 apply period_seq_intersection_inv in Hq as ([sq1 eq1] & [sq2 eq2] & Hq1%list_elem_of_In & Hq2 & Hq); [|done..].
404 apply (proj1 (List.Forall_forall _ _) Hlt1) in Hq1.
405 injection Hq as -> ->.
406 simplify_eq/=.
407 apply limit_min_lt. left.
408 apply limit_lt_max. by left.
409 + apply IHps1 in Hnf2 as Hnf2'; last by apply period_seq_nf_cons in Hnf1 as (_ & ? & _).
410 destruct Hnf2' as [Hne HSort].
411 apply not_limit_lt in H0. split.
412 * constructor.
413 -- by apply period_empty_not_nonempty.
414 -- apply IHps2. by apply period_seq_nf_cons in Hnf2 as (_ & ? & _).
415 * constructor.
416 -- apply IHps2. by apply period_seq_nf_cons in Hnf2 as (_ & ? & _).
417 -- rewrite {1}/intersection /period_intersection.
418 apply period_seq_nf_cons in Hnf1 as Hnf1'.
419 destruct Hnf1' as (Hp1 & Hnf1' & Hne1).
420 apply period_seq_nf_cons in Hnf2 as (Hne2 & Hnf2 & Hlt2).
421 apply IHps2 in Hnf2 as Hnf2'.
422 destruct (([s1, e1) :: ps1) ∩ ps2) as [|[sq eq] qs] eqn:Hqs; constructor.
423 assert (Hq : [sq, eq) ∈ ([s1, e1) :: ps1) ∩ ps2).
424 { rewrite Hqs. constructor. }
425 unfold period_before. repeat split.
426 ++ by apply period_empty_not_nonempty.
427 ++ by eapply Forall_forall; first apply Hnf2'.
428 ++ apply period_seq_intersection_inv in Hq as ([sq1 eq1] & [sq2 eq2] & Hq1 & Hq2%list_elem_of_In & Hq); [|done..].
429 apply (proj1 (List.Forall_forall _ _) Hlt2) in Hq2.
430 injection Hq as -> ->.
431 simplify_eq/=.
432 apply limit_min_lt. right.
433 apply limit_lt_max. by right.
434Qed.
435
436Definition period_seq_intersection_comm_equiv ps1 ps2 :
437 period_seq_nf ps1 → period_seq_nf ps2 →
438 ps1 ∩ ps2 ≡ ps2 ∩ ps1.
439Proof.
440 intros Hnf1 Hnf2 t.
441 split; by intros [H2 H1]%period_seq_intersection_lem;
442 first apply period_seq_intersection_lem.
443Qed.
444
445Lemma period_seq_nf_cons_equiv_inv_start_1 p1 ps1 p2 ps2:
446 period_seq_nf (p1 :: ps1) →
447 period_seq_nf (p2 :: ps2) →
448 p1 :: ps1 ≡ p2 :: ps2 →
449 ¬ (period_start p1 < period_start p2)%lim.
450Proof.
451 intros Hnf1 Hnf2 Hequiv Hp12.
452 apply period_seq_nf_cons in Hnf1 as (Hne1 & Hnf1 & Hlt1), Hnf2 as (Hne2 & Hnf2 & Hlt2).
453 destruct p1 as [s1 e1], p2 as [s2 e2]. simpl in Hp12.
454 destruct s2 as [|s2|]; [by destruct s1| |done].
455 destruct s1 as [|s1|]; last done.
456 - destruct e1 as [|e1|]; first done.
457 + assert (Z.pred (s2 `min` e1) ∈ [-∞, e1) :: ps1).
458 { constructor. by split; [|simpl; lia]. }
459 apply Hequiv in H. inv H.
460 * destruct H1 as [H1 _]. simpl in H1. lia.
461 * apply Exists_exists in H1 as ([sp ep] & Hp & Hs2).
462 rewrite Forall_forall in Hlt2.
463 apply Hlt2 in Hp. simpl in Hp.
464 destruct Hs2 as [Hs21 Hs22].
465 assert (contra : (s2 < s2)%lim).
466 { trans e2; first done.
467 apply (limit_lt_le_trans sp); first done.
468 etrans; first apply Hs21. simpl. lia. }
469 by eapply (_ : Irreflexive limit_lt).
470 + assert (Z.pred s2 ∈ [-∞, +∞) :: ps1).
471 { by constructor. }
472 apply Hequiv in H. inv H.
473 * destruct H1 as [H1 _]. simpl in H1. lia.
474 * apply Exists_exists in H1 as ([sp ep] & Hp & Hs2).
475 rewrite Forall_forall in Hlt2.
476 apply Hlt2 in Hp. simpl in Hp.
477 destruct Hs2 as [Hs21 Hs22].
478 assert (contra : (s2 < s2)%lim).
479 { trans e2; first done.
480 apply (limit_lt_le_trans sp); first done.
481 etrans; first apply Hs21. simpl. lia. }
482 by eapply (_ : Irreflexive limit_lt).
483 - assert (s1 ∈ [s1, e1) :: ps1).
484 { by constructor. }
485 apply Hequiv in H. inv H.
486 + destruct H1 as [[[= ->]|H1]%limit_le_cases _].
487 * by eapply (_ : Irreflexive limit_lt).
488 * by eapply (asymmetry (R:=limit_lt)).
489 + apply Exists_exists in H1 as ([sp ep] & Hp & Hs1).
490 rewrite Forall_forall in Hlt2.
491 apply Hlt2 in Hp. simpl in Hp.
492 assert (contra : (s1 < s1)%lim).
493 { trans s2; first done.
494 trans e2; first done.
495 by apply (limit_lt_le_trans sp); last apply Hs1. }
496 by eapply (_ : Irreflexive limit_lt).
497Qed.
498
499Instance period_seq_equiv_trans : Transitive (≡@{period_seq}).
500Proof.
501 intros ps1 ps2 ps3 Heq12 Heq23 t. split.
502 - by intros Ht%Heq12%Heq23.
503 - by intros Ht%Heq23%Heq12.
504Qed.
505
506Instance period_seq_equiv_symm : Symmetric (≡@{period_seq}).
507Proof. intros ps1 ps2 Heq12 t. split; by intros Ht%Heq12. Qed.
508
509Lemma period_seq_nf_cons_equiv_inv_start p1 ps1 p2 ps2:
510 period_seq_nf (p1 :: ps1) →
511 period_seq_nf (p2 :: ps2) →
512 p1 :: ps1 ≡ p2 :: ps2 →
513 period_start p1 = period_start p2.
514Proof.
515 intros Hnf1 Hnf2 Hequiv.
516 destruct (decide (period_start p1 < period_start p2)%lim) as [Hs12|Hs21].
517 - exfalso. by eapply period_seq_nf_cons_equiv_inv_start_1 in Hs12.
518 - apply not_limit_lt, limit_le_cases in Hs21 as [Hs21|Hs21]; first done.
519 exfalso. by eapply period_seq_nf_cons_equiv_inv_start_1 in Hs21.
520Qed.
521
522Lemma period_seq_nf_cons_equiv_inv_end_1 p1 ps1 p2 ps2:
523 period_seq_nf (p1 :: ps1) →
524 period_seq_nf (p2 :: ps2) →
525 p1 :: ps1 ≡ p2 :: ps2 →
526 ¬ (period_end p1 < period_end p2)%lim.
527Proof.
528 intros Hnf1 Hnf2 Hequiv Hp12.
529 assert (Hs : period_start p1 = period_start p2).
530 { by eapply period_seq_nf_cons_equiv_inv_start. }
531 apply period_seq_nf_cons in Hnf1 as (Hne1 & Hnf1 & Hlt1), Hnf2 as (Hne2 & Hnf2 & Hlt2).
532 destruct p1 as [s1 e1], p2 as [s2 e2]. simpl in Hs, Hp12.
533 rewrite <-Hs in *. rename s1 into s. clear Hs s2.
534 destruct e1 as [|e1|]; [by destruct s| |done].
535 assert (e1 ∈ [s, e2) :: ps2).
536 { constructor. by split; [apply limit_le_cases; right|]. }
537 apply Hequiv in H. inv H.
538 + destruct H1 as [_ H12]. by eapply (_ : Irreflexive limit_lt).
539 + apply Exists_exists in H1 as (p & Hp & He1).
540 rewrite Forall_forall in Hlt1.
541 apply Hlt1 in Hp.
542 destruct p as [sp ep].
543 unfold period_end, period_start in Hp.
544 assert (contra : (e1 < e1)%lim).
545 { by eapply limit_lt_le_trans; last apply He1. }
546 by eapply (_ : Irreflexive limit_lt).
547Qed.
548
549Lemma period_seq_nf_cons_equiv_inv_end p1 ps1 p2 ps2:
550 period_seq_nf (p1 :: ps1) →
551 period_seq_nf (p2 :: ps2) →
552 p1 :: ps1 ≡ p2 :: ps2 →
553 period_end p1 = period_end p2.
554Proof.
555 intros Hnf1 Hnf2 Hequiv.
556 destruct (decide (period_end p1 < period_end p2)%lim) as [He12|He21].
557 - exfalso. by eapply period_seq_nf_cons_equiv_inv_end_1 in He12.
558 - apply not_limit_lt, limit_le_cases in He21 as [He21|He21]; first done.
559 exfalso. by eapply period_seq_nf_cons_equiv_inv_end_1 in He21.
560Qed.
561
562Lemma period_seq_nf_cons_equiv_inv p1 ps1 p2 ps2:
563 period_seq_nf (p1 :: ps1) →
564 period_seq_nf (p2 :: ps2) →
565 p1 :: ps1 ≡ p2 :: ps2 →
566 p1 = p2.
567Proof.
568 intros Hnf1 Hnf2 Hequiv.
569 trans [period_start p1, period_end p1); first by destruct p1.
570 trans [period_start p2, period_end p2); last by destruct p2.
571 erewrite period_seq_nf_cons_equiv_inv_start; try done.
572 by erewrite period_seq_nf_cons_equiv_inv_end.
573Qed.
574
575Lemma period_seq_nf_equiv_L ps1 ps2 :
576 period_seq_nf ps1 →
577 period_seq_nf ps2 →
578 ps1 ≡ ps2 → ps1 = ps2.
579Proof.
580 intros Hnf1. revert ps2.
581 induction ps1 as [|p1 ps1]; intros ps2 Hnf2 Hequiv.
582 - destruct ps2; first done.
583 assert (period_nonempty p) as [t Ht]%period_nonempty_alt_iff.
584 { inv Hnf2. by inv H. }
585 assert (t ∈ p :: ps2) as contra%Hequiv.
586 { by apply Exists_cons_hd. }
587 inv contra.
588 - destruct ps2 as [|p2 ps2].
589 + assert (period_nonempty p1) as [t Ht]%period_nonempty_alt_iff.
590 { inv Hnf1. by inv H. }
591 assert (t ∈ p1 :: ps1) as contra%Hequiv.
592 { by apply Exists_cons_hd. }
593 inv contra.
594 + assert (p1 = p2) as <-.
595 { by eapply period_seq_nf_cons_equiv_inv. }
596 rename p1 into p.
597 apply period_seq_nf_cons in Hnf1 as (Hne1 & Hnf1 & Hlt1), Hnf2 as (Hne2 & Hnf2 & Hlt2).
598 f_equal. apply IHps1; [done..|].
599 intros t. split; intros Ht.
600 * assert (t ∈ p :: ps1) as H%Hequiv.
601 { by apply Exists_cons_tl. }
602 inv H; last done.
603 apply Exists_exists in Ht as ([sq eq] & Hp & Ht).
604 rewrite Forall_forall in Hlt1.
605 apply Hlt1 in Hp.
606 exfalso. destruct p as [s e].
607 simpl in *.
608 assert (contra : (t < t)%lim).
609 { trans e; first apply H1.
610 by eapply limit_lt_le_trans; last apply Ht. }
611 by eapply (_ : Irreflexive limit_lt).
612 * assert (t ∈ p :: ps2) as H%Hequiv.
613 { by apply Exists_cons_tl. }
614 inv H; last done.
615 apply Exists_exists in Ht as ([sq eq] & Hp & Ht).
616 rewrite Forall_forall in Hlt2.
617 apply Hlt2 in Hp.
618 exfalso. destruct p as [s e].
619 simpl in *.
620 assert (contra : (t < t)%lim).
621 { trans e; first apply H1.
622 by eapply limit_lt_le_trans; last apply Ht. }
623 by eapply (_ : Irreflexive limit_lt).
624Qed.
625
626Definition period_seq_intersection_comm ps1 ps2 :
627 period_seq_nf ps1 → period_seq_nf ps2 →
628 ps1 ∩ ps2 = ps2 ∩ ps1.
629Proof.
630 intros Hnf1 Hnf2.
631 apply period_seq_nf_equiv_L.
632 - by apply period_seq_intersection_nf.
633 - by apply period_seq_intersection_nf.
634 - by apply period_seq_intersection_comm_equiv.
635Qed.
636
637Instance period_seq_equiv_refl : Reflexive (≡@{period_seq}).
638Proof. done. Qed.
639
640Instance period_seq_equiv_equivalence : Equivalence (≡@{period_seq}).
641Proof. split; apply _. Qed.
642
643Variant bound :=
644 | LtBound of limit
645 | GeBound of limit.
646
647Definition bound_le b1 b2 :=
648 match b1, b2 with
649 | GeBound l1, GeBound l2 => (l1 ≤ l2)%lim
650 | GeBound _, LtBound _ => True
651 | LtBound l1, LtBound l2 => (l1 ≤ l2)%lim
652 | LtBound _, GeBound _ => False
653 end.
654Instance bound_lt_dec : RelDecision bound_le.
655Proof. intros [l1|l1] [l2|l2]; simpl; solve_decision. Qed.
656
657Instance bound_le_refl : Reflexive bound_le.
658Proof. by intros []; simpl. Qed.
659
660Instance bound_le_trans : Transitive bound_le.
661Proof. intros [] [] [] ? ?; simpl in *; done || by etrans. Qed.
662
663Instance bound_le_preorder : PreOrder bound_le.
664Proof. split; apply _. Qed.
665
666Instance bound_le_antisymm : AntiSymm (=) bound_le.
667Proof. intros [] [] ? ?; simpl in *; done || f_equal; by eapply (_ : AntiSymm (=) limit_le). Qed.
668
669Instance bound_le_partial_order : PartialOrder bound_le.
670Proof. split; apply _. Qed.
671
672Instance bound_le_trichotomy : Trichotomy (strict bound_le).
673Proof.
674 intros [] []; simpl in *.
675 - destruct (trichotomy _ l l0) as [?|[?|?]].
676 + left. split; simpl.
677 * apply limit_le_cases. by right.
678 * by apply not_limit_le.
679 + right. left. by subst.
680 + right. right. split; simpl.
681 * apply limit_le_cases. by right.
682 * by apply not_limit_le.
683 - right. right. split; simpl; [done|by intros ?].
684 - left. split; simpl; [done|by intros ?].
685 - destruct (trichotomy _ l l0) as [?|[?|?]].
686 + left. split; simpl.
687 * apply limit_le_cases. by right.
688 * by apply not_limit_le.
689 + right. left. by subst.
690 + right. right. split; simpl.
691 * apply limit_le_cases. by right.
692 * by apply not_limit_le.
693Qed.
694
695Instance bound_le_total_order : TotalOrder bound_le.
696Proof. split; apply _. Qed.
697
698Definition period_bounds '[s, e) :=
699 if decide (period_nonempty [s, e)) then [GeBound s; LtBound e] else [].
700
701Definition period_seq_bounds (ps : period_seq) :=
702 ps ≫= period_bounds.
703
704Definition period_seq_bounds_sorted (ps : period_seq) :=
705 merge_sort bound_le (period_seq_bounds ps).
706
707Variant window_filter_action :=
708 KickLeft | KickRight | NoAction.
709Fixpoint window_filter_aux {A} (f : A → A → window_filter_action) (x : A) (l : list A) :=
710 match l with
711 | [] => [x]
712 | y :: l' =>
713 match f x y with
714 | KickLeft => window_filter_aux f y l'
715 | KickRight => window_filter_aux f x l'
716 | NoAction => x :: window_filter_aux f y l'
717 end
718 end.
719Definition window_filter {A} (f : A → A → window_filter_action) (l : list A) :=
720 match l with
721 | [] => []
722 | x :: l' => window_filter_aux f x l'
723 end.
724
725Definition period_seq_bounds_clean (ps : period_seq) :=
726 window_filter (λ b1 b2, match b1, b2 with
727 | GeBound _, LtBound _ => NoAction
728 | GeBound _, GeBound _ => KickRight
729 | LtBound _, GeBound _ => NoAction
730 | LtBound _, LtBound _ => KickLeft
731 end)
732 (period_seq_bounds_sorted ps).
733
734Fixpoint period_seq_from_bounds (bs : list bound) : period_seq :=
735 match bs with
736 | GeBound s :: LtBound e :: bs' => [s, e) :: period_seq_from_bounds bs'
737 | _ => []
738 end.
739
740Definition period_seq_normalize (ps : period_seq) :=
741 period_seq_from_bounds (period_seq_bounds_clean ps).
742
743
744Lemma period_seq_normalize_lem_1 (ps : period_seq) :
745 period_seq_normalize ps ≡ ps.
746Proof.
747 Search merge_sort.
748 Search Total Trichotomy.
749
750
751(* TODO: continue here *) Admitted.
752
753Lemma period_seq_normalize_lem_2 (ps : period_seq) :
754 period_seq_nf (period_seq_normalize ps).
755Proof. (* TODO: and here *) Admitted.
756
757Definition period_seq_union (ps1 ps2 : period_seq) :=
758 period_seq_normalize (ps1 ++ ps2).
759Lemma period_seq_union_lem t ps1 ps2 :
760 t ∈ period_seq_union ps1 ps2 ↔ t ∈ ps1 ∨ t ∈ ps2.
761Proof.
762 split.
763 - intros Ht%(period_seq_normalize_lem_1 (ps1 ++ ps2)).
764 apply Exists_app in Ht as [Ht|Ht]; by [left|right].
765 - intros [Ht|Ht]; apply period_seq_normalize_lem_1, Exists_app; by [left|right].
766Qed.
767Lemma period_seq_union_nf ps1 ps2 :
768 period_seq_nf (period_seq_union ps1 ps2).
769Proof. apply period_seq_normalize_lem_2. Qed.
770
771Definition nf_period_seq := sig period_seq_nf.
772
773Instance period_seq_nf_pi ps : ProofIrrel (period_seq_nf ps).
774Proof.
775 unfold period_seq_nf. intros [P11 P12] [P21 P22].
776 f_equal; [apply Forall_pi | apply Sorted_pi]; apply _.
777Qed.
778
779Instance period_seq_empty : Empty period_seq := [].
780Lemma period_seq_empty_nf : period_seq_nf ∅.
781Proof. done. Qed.
782
783Instance period_seq_singleton : Singleton timestamp period_seq :=
784 λ t, [{[t]}].
785Lemma period_seq_singleton_lem_1 t : t ∈ ({[t]} : period_seq).
786Proof.
787 unfold singleton, period_seq_singleton.
788 constructor. apply period_singleton_lem_1.
789Qed.
790Lemma period_seq_singleton_lem_2 t t' : t' ∈ ({[t]} : period_seq) → t' = t.
791Proof.
792 unfold singleton, period_seq_singleton.
793 inv 1; last inv H1.
794 by apply period_singleton_lem_2.
795Qed.
796Lemma period_seq_singleton_nf t : period_seq_nf {[t]}.
797Proof.
798 unfold singleton, period_seq_singleton.
799 split.
800 - constructor; last constructor.
801 apply period_singleton_nonempty.
802 - constructor; constructor.
803Qed.
804
805Instance nf_period_seq_elem_of : ElemOf timestamp nf_period_seq :=
806 λ t ps, t ∈ `ps.
807Instance nf_period_seq_empty : Empty nf_period_seq :=
808 ∅ ↾ period_seq_empty_nf.
809Instance nf_period_seq_union : Union nf_period_seq :=
810 λ '(ps1↾_) '(ps2↾_), period_seq_union ps1 ps2 ↾ (period_seq_union_nf ps1 ps2).
811Instance nf_period_seq_singleton : Singleton timestamp nf_period_seq :=
812 λ t, {[t]} ↾ period_seq_singleton_nf t.
813
814Instance nf_period_seq_semiset : SemiSet timestamp nf_period_seq.
815Proof.
816 split.
817 - intros t Ht. inv Ht.
818 - split.
819 + apply period_seq_singleton_lem_2.
820 + intros <-. apply period_seq_singleton_lem_1.
821 - intros [ps1 Hnf1] [ps2 Hnf2] t.
822 unfold union, nf_period_seq_union, elem_of, nf_period_seq_elem_of.
823 simpl. apply period_seq_union_lem.
824Qed.
825
826Instance nf_period_seq_intersection : Intersection nf_period_seq :=
827 λ '(ps1↾Hnf1) '(ps2↾Hnf2), (ps1 ∩ ps2) ↾ (period_seq_intersection_nf ps1 ps2 Hnf1 Hnf2).
828
829(* TODO: difference!
830
831Instance nf_period_seq_set : Set_ timestamp nf_period_seq.
832Proof. (* TODO *) Qed.
833
834*)