Commit 34d3b31e by Jean-Christophe Filliatre

### [gallery] simplified Coq proof for bresenham

`this is a contribution of Laurent Théry`
parent e2131f24
 ... ... @@ -32,7 +32,7 @@ module M We express this property using integers by multiplying everything by [2a]. *) lemma closest : forall a b c: int. 0 < a -> forall a b c: int. abs (2 * a * b - 2 * c) <= a -> forall b': int. abs (a * b - c) <= abs (a * b' - c) ... ...
 ... ... @@ -31,138 +31,15 @@ Axiom first_octant : (0%Z <= y2)%Z /\ (y2 <= x2)%Z. Definition best (x:Z) (y:Z): Prop := forall (y':Z), ((Zabs ((x2 * y)%Z - (x * y2)%Z)%Z) <= (Zabs ((x2 * y')%Z - (x * y2)%Z)%Z))%Z. (*s First a tactic [Case_Zabs] to do case split over [(Zabs x)]: introduces two subgoals, one where [x] is assumed to be non negative and thus where [Zabs x] is replaced by [x]; and another where [x] is assumed to be non positive and thus where [Zabs x] is replaced by [-x]. *) Lemma Z_gt_le : forall x y:Z, (x > y)%Z -> (y <= x)%Z. Proof. intros; omega. Qed. Ltac Case_Zabs a Ha := elim (Z_le_gt_dec 0 a); intro Ha; [ rewrite (Zabs_eq a Ha) | rewrite (Zabs_non_eq a (Z_gt_le 0 a Ha)) ]. (*s A useful lemma to establish \$|a| \le |b|\$. *) Lemma Zabs_le_Zabs : forall a b:Z, (b <= a <= 0)%Z \/ (0 <= a <= b)%Z -> (Zabs a <= Zabs b)%Z. Proof. intro a; Case_Zabs a Ha; intro b; Case_Zabs b Hb; omega. Qed. (*s A useful lemma to establish \$|a| \le \$. *) Lemma Zabs_le : forall a b:Z, (0 <= b)%Z -> ((Zopp b <= a <= b)%Z <-> (Zabs a <= b)%Z). Proof. intros a b Hb. Case_Zabs a Ha; split; omega. Qed. (*s Two tactics. [ZCompare x y H] discriminates between [xy] ([H] is the hypothesis name). [RingSimpl x y] rewrites [x] by [y] using the [Ring] tactic. *) Ltac ZCompare x y H := elim (Z_gt_le_dec x y); intro H; [ idtac | elim (Z_le_lt_eq_dec x y H); clear H; intro H ]. Ltac RingSimpl x y := replace x with y; [ idtac | ring ]. Require Import Why3. Ltac ae := why3 "Alt-Ergo,0.95.1," timelimit 3. (* The following short and nice proof is due to Laurent Théry *) Require Import Psatz. (* Why3 goal *) Theorem closest : forall (a:Z) (b:Z) (c:Z), (0%Z < a)%Z -> (((Zabs (((2%Z * a)%Z * b)%Z - (2%Z * c)%Z)%Z) <= a)%Z -> forall (b':Z), ((Zabs ((a * b)%Z - c)%Z) <= (Zabs ((a * b')%Z - c)%Z))%Z). (* Why3 intros a b c h1 h2 b'. *) intros a b c Ha Hmin. assert (Ha': (0 <= a)%Z) by omega. generalize (proj2 (Zabs_le (2 * a * b - 2 * c) a Ha') Hmin). intros Hmin' b'. elim (Z_le_gt_dec (2 * a * b) (2 * c)); intro Habc. (* 2ab <= 2c *) rewrite (Zabs_non_eq (a * b - c)). ZCompare b b' Hbb'. (* b > b' *) rewrite (Zabs_non_eq (a * b' - c)). ae. ae. (* b < b' *) rewrite (Zabs_eq (a * b' - c)). apply Zmult_le_reg_r with (p := 2%Z). omega. RingSimpl ((a * b' - c) * 2)%Z (2 * (a * b' - a * b) + 2 * (a * b - c))%Z. apply Zle_trans with a. RingSimpl (Zopp (a * b - c) * 2)%Z (Zopp (2 * a * b - 2 * c)). omega. apply Zle_trans with (2 * a + Zopp a)%Z. omega. apply Zplus_le_compat. RingSimpl (2 * a)%Z (2 * a * 1)%Z. RingSimpl (2 * (a * b' - a * b))%Z (2 * a * (b' - b))%Z. ae. RingSimpl (2 * (a * b - c))%Z (2 * a * b - 2 * c)%Z. omega. (* 0 <= ab'-c *) RingSimpl (a * b' - c)%Z (a * b' - a * b + (a * b - c))%Z. RingSimpl 0%Z (a + Zopp a)%Z. apply Zplus_le_compat. RingSimpl a (a * 1)%Z. RingSimpl (a * 1 * b' - a * 1 * b)%Z (a * (b' - b))%Z. ae. apply Zle_trans with (Zopp a). omega. RingSimpl ((a * b - c) * 2)%Z (2 * a * b - 2 * c)%Z. ae. (* b = b' *) ae. ae. (* 2ab > 2c *) rewrite (Zabs_eq (a * b - c)). ZCompare b b' Hbb'. (* b > b' *) rewrite (Zabs_non_eq (a * b' - c)). apply Zmult_le_reg_r with (p := 2%Z). omega. RingSimpl (Zopp (a * b' - c) * 2)%Z (2 * (c - a * b) + 2 * (a * b - a * b'))%Z. apply Zle_trans with a. ae. apply Zle_trans with (Zopp a + 2 * a)%Z. omega. apply Zplus_le_compat. ae. RingSimpl (2 * a)%Z (2 * a * 1)%Z. RingSimpl (2 * (a * b - a * b'))%Z (2 * a * (b - b'))%Z. ae. (* 0 >= ab'-c *) RingSimpl (a * b' - c)%Z (a * b' - a * b + (a * b - c))%Z. RingSimpl 0%Z (Zopp a + a)%Z. apply Zplus_le_compat. RingSimpl (Zopp a) (a * (-1))%Z. RingSimpl (a * b' - a * b)%Z (a * (b' - b))%Z. ae. ae. (* b < b' *) rewrite (Zabs_eq (a * b' - c)). apply Zle_left_rev. RingSimpl (a * b' - c + Zopp (a * b - c))%Z (a * (b' - b))%Z. ae. apply Zle_trans with (m := (a * b - c)%Z). ae. ae. ae. ae. Theorem closest : forall (a:Z) (b:Z) (c:Z), ((Zabs (((2%Z * a)%Z * b)%Z - (2%Z * c)%Z)%Z) <= a)%Z -> forall (b':Z), ((Zabs ((a * b)%Z - c)%Z) <= (Zabs ((a * b')%Z - c)%Z))%Z. intros a b c H b'. assert (H1: b = b' \/ b <> b') by nia. nia. Qed.
 ... ... @@ -7,14 +7,18 @@ version="0.95.1"/> shape="ainfix <=aabsainfix -ainfix *V0V1V2aabsainfix -ainfix *V0V3V2FIainfix <=aabsainfix -ainfix *ainfix *c2V0V1ainfix *c2V2V0F"> ... ... @@ -65,7 +69,7 @@ locfile="../bresenham.mlw" loclnum="39" loccnumb="6" loccnume="15" expl="1. loop invariant init" sum="a7d59511d637bd777ac8a33a539550bc" sum="818d60808053e43e7be4da19c039bf40" proved="true" expanded="true" shape="loop invariant initainfix =ainfix -ainfix *c2ay2ax2ainfix -ainfix *ainfix *c2ainfix +c0c1ay2ainfix *ainfix +ainfix *c2c0c1ax2Iainfix <=c0V0Lax2"> ... ... @@ -80,7 +84,7 @@ ... ... @@ -121,7 +125,7 @@ locfile="../bresenham.mlw" loclnum="39" loccnumb="6" loccnume="15" expl="3. assertion" sum="b4fdabc8784d3fff3a314c29c063b44e" sum="fcbcee9000353217b3dbca58d7cc9146" proved="true" expanded="true" shape="assertionabestV3V2Iainfix <=V1ainfix *c2ay2Aainfix <=ainfix *c2ainfix -ay2ax2V1Aainfix =V1ainfix -ainfix *ainfix *c2ainfix +V3c1ay2ainfix *ainfix +ainfix *c2V2c1ax2Iainfix <=V3V0Aainfix <=c0V3FFIainfix <=c0V0Lax2"> ... ... @@ -129,11 +133,19 @@ name="expl:VC for bresenham"/> ... ... @@ -156,7 +168,7 @@ ... ... @@ -197,14 +209,14 @@ locfile="../bresenham.mlw" loclnum="39" loccnumb="6" loccnume="15" expl="6. loop invariant preservation" sum="8bf10f587c91043c58241ffb93901f35" sum="effb2332ccb437bc6e30129ae779efb0" proved="true" expanded="true" shape="loop invariant preservationainfix =V5ainfix -ainfix *ainfix *c2ainfix +ainfix +V3c1c1ay2ainfix *ainfix +ainfix *c2V4c1ax2Iainfix =V5ainfix +V1ainfix *c2ainfix -ay2ax2FIainfix =V4ainfix +V2c1FINainfix <V1c0IabestV3V2Iainfix <=V1ainfix *c2ay2Aainfix <=ainfix *c2ainfix -ay2ax2V1Aainfix =V1ainfix -ainfix *ainfix *c2ainfix +V3c1ay2ainfix *ainfix +ainfix *c2V2c1ax2Iainfix <=V3V0Aainfix <=c0V3FFIainfix <=c0V0Lax2"> ... ...
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!