-let rec sum_bases (l:list bar) (i:nat)on i ≝
- match i with
- [ O ⇒ OQ
- | S m ⇒
- match l with
- [ nil ⇒ sum_bases l m + Qpos one
- | cons x tl ⇒ sum_bases tl m + Qpos (\fst x)]].
-
-axiom sum_bases_empty_nat_of_q_ge_OQ:
- ∀q:ℚ.OQ ≤ sum_bases [] (nat_of_q q).
-axiom sum_bases_empty_nat_of_q_le_q:
- ∀q:ℚ.sum_bases [] (nat_of_q q) ≤ q.
-axiom sum_bases_empty_nat_of_q_le_q_one:
- ∀q:ℚ.q < sum_bases [] (nat_of_q q) + Qpos one.
-
-definition eject1 ≝
- λP.λp:∃x:nat × ℚ.P x.match p with [ex_introT p _ ⇒ p].
-coercion eject1.
-definition inject1 ≝ λP.λp:nat × ℚ.λh:P p. ex_introT ? P p h.
-coercion inject1 with 0 1 nocomposites.
-
-definition value :
- ∀f:q_f.∀i:ℚ.∃p:nat × ℚ.
- match q_cmp i (start f) with
- [ q_lt _ ⇒ \snd p = OQ
- | _ ⇒
- And3
- (sum_bases (bars f) (\fst p) ≤ ⅆ[i,start f])
- (ⅆ[i, start f] < sum_bases (bars f) (S (\fst p)))
- (\snd p = \snd (nth (bars f) ▭ (\fst p)))].
-intros;
-alias symbol "pi2" = "pair pi2".
-alias symbol "pi1" = "pair pi1".
-letin value ≝ (
- let rec value (p: ℚ) (l : list bar) on l ≝
- match l with
- [ nil ⇒ 〈nat_of_q p,OQ〉
- | cons x tl ⇒
- match q_cmp p (Qpos (\fst x)) with
- [ q_lt _ ⇒ 〈O, \snd x〉
- | _ ⇒
- let rc ≝ value (p - Qpos (\fst x)) tl in
- 〈S (\fst rc),\snd rc〉]]
- in value :
- ∀acc,l.∃p:nat × ℚ. OQ ≤ acc →
- And3
- (sum_bases l (\fst p) ≤ acc)
- (acc < sum_bases l (S (\fst p)))
- (\snd p = \snd (nth l ▭ (\fst p))));
-[5: clearbody value;
- cases (q_cmp i (start f));
- [2: exists [apply 〈O,OQ〉] simplify; reflexivity;
- |*: cases (value ⅆ[i,start f] (bars f)) (p Hp);
- cases (Hp (q_dist_ge_OQ ? ?)); clear Hp value;
- exists[1,3:apply p]; simplify; split; assumption;]
-|1,3: intros; split;
- [1,4: clear H2; cases (value (q-Qpos (\fst b)) l1);
- cases (H2 (q_le_to_diff_ge_OQ ?? (? H1)));
- [1,3: intros; [right|left;symmetry] assumption]
- simplify; apply q_le_minus; assumption;
- |2,5: cases (value (q-Qpos (\fst b)) l1);
- cases (H4 (q_le_to_diff_ge_OQ ?? (? H1)));
- [1,3: intros; [right|left;symmetry] assumption]
- clear H3 H2 value;
- change with (q < sum_bases l1 (S (\fst w)) + Qpos (\fst b));
- apply q_lt_plus; assumption;
- |*: cases (value (q-Qpos (\fst b)) l1); simplify;
- cases (H4 (q_le_to_diff_ge_OQ ?? (? H1)));
- [1,3: intros; [right|left;symmetry] assumption]
- assumption;]
-|2: clear value H2; simplify; intros; split; [assumption|3:reflexivity]
- rewrite > q_plus_sym; rewrite > q_plus_OQ; assumption;
-|4: simplify; intros; split;
- [1: apply sum_bases_empty_nat_of_q_le_q;
- |2: apply sum_bases_empty_nat_of_q_le_q_one;
- |3: elim (nat_of_q q); [reflexivity] simplify; assumption]]