Commit 98e4eca4 by MARCHE Claude

### example sumrange in progress, part cumulative array proved

parent 579ea58c
 module ArraySum use export int.Int use export array.Array function sum (array int) int int : int (** [sum a i j] denotes the sum Sum_{i <= k < j} a[k] *) axiom sum_def_empty : forall a : array int, i j : int. j <= i -> sum a i j = 0 axiom sum_def_non_empty : forall a: array int, i j : int. i < j /\ 0 <= i < a.length -> sum a i j = a[i] + sum a (i+1) j (* lemma sum_right_aux : forall a x j. 0 < j <= a.length -> 0 < x <= j -> sum a (j-x) j = sum a (j-x) (j-1) + a [j-1] *) lemma sum_right : forall a : array int, i j : int. 0 <= i < j <= a.length -> sum a i j = sum a i (j-1) + a[j-1] end module Simple use import ArraySum use import ref.Ref (** [query a i j] returns the sum of elements in [a] between index [i] inclusive and index [j] exclusive *) let query (a:array int) (i j:int) : int requires { 0 <= i <= j <= a.length } ensures { result = sum a i j } = let s = ref 0 in for k=i to j-1 do invariant { !s = sum a i k } s := !s + a[k] done; !s end module CumulativeArray use array.Array use import ArraySum predicate is_cumulative_array_for (c:array int) (a:array int) = c.length = a.length + 1 /\ forall i. 0 <= i < c.length -> c[i] = sum a 0 i (** [create a] builds the cumulative array associated with [a]. *) let create (a:array int) : array int ensures { is_cumulative_array_for result a } = let l = a.length in let s = Array.make (l+1) 0 in for i=1 to l do invariant { forall k. 0 <= k < i -> s[k] = sum a 0 k } s[i] <- s[i-1] + a[i-1] done; s lemma sum_concat : forall a:array int, i j k:int. 0 <= i <= j <= k <= a.length -> sum a i k = sum a i j + sum a j k (** [query c i j a] returns the sum of elements in [a] between index [i] inclusive and index [j] exclusive, in constant time *) let query (c:array int) (i j:int) (ghost a:array int): int requires { is_cumulative_array_for c a } requires { 0 <= i <= j < c.length } ensures { result = sum a i j } = c[j] - c[i] lemma sum_frame : forall a1 a2 : array int, i j : int. 0 <= i <= j -> j <= a1.length -> j <= a2.length -> (forall k : int. i <= k < j -> a1[k] = a2[k]) -> sum a1 i j = sum a2 i j let rec lemma sum_update (a:array int) (i v l h:int) : unit requires { 0 <= l <= i < h <= a.length } variant { h } ensures { sum (a[i<-v]) l h = sum a l h + v - a[i] } = if h > i + 1 then sum_update a i v l (h-1) (*>*) (** [update c i v a] updates cell [a[i]] to value [v] and updates the cumulative array [c] accordingly *) let update (c:array int) (i:int) (v:int) (ghost a:array int) : unit requires { (**) } (**) writes { (**) } ensures { is_cumulative_array_for c a } ensures { a[i] = v } ensures { forall k. 0 <= k < a.length /\ k <> i -> a[k] = (old a)[k] } = (* c[k] = sum a 0 k - incr } invariant { forall k. 0 <= k < j -> c[k] = sum a 0 k } c[j] <- c[j] + incr done (*>*) end module CumulativeTree use array.Array use import ArraySum use import int.ComputerDivision type indexes = { low : int; high : int; isum : int; } type tree = Leaf indexes | Node indexes tree tree function indexes (t:tree) : indexes = match t with | Leaf ind -> ind | Node ind _ _ -> ind end (* QUESTION 11 *) (**) predicate is_tree_for (t:tree) (a:array int) (i j:int) = match t with | Leaf ind -> (**) | Node ind l r -> (**) end (* QUESTION 12 *) (**) let rec tree_of_array (a:array int) (i j:int) : tree requires { (**) } variant { (**) } ensures { (**) } = if i+1=j then begin (**) end else begin let m = div (i+j) 2 in (**) end (* QUESTION 13 *) let create (a:array int) : tree requires { (*= 1 (*>*) } ensures { is_tree_for result a 0 a.length } = (**) (* QUESTION 14 *) let rec query_aux (t:tree) (ghost a: array int) (i j:int) : int requires { (**) } requires { (**) } variant { (**) } ensures { (**) } = (* ind.isum | Node ind l r -> let k1 = ind.low in let k3 = ind.high in if i=k1 && j=k3 then ind.isum else let m = l.indexes.high in if j <= m then query_aux l a (*k1 m*) i j else if i >= m then query_aux r a (*m k3*) i j else query_aux l a (*k1 m*) i m + query_aux r a (*m k3*) m j end (*>*) (* QUESTION 16 *) let query (t:tree) (ghost a: array int) (i j:int) : int requires { 0 <= i <= j <= a.length } requires { (**) } ensures { result = sum a i j } = (**) (*= ind.high) predicate is_fully_covered (ind:indexes) (i j:int) = i <= ind.low && ind.high <= j use import int.MinMax let rec query2 (t:tree) (ghost a: array int) (i j:int) : int requires { (**) } (* requires { (**) } *) variant { (**) } ensures { (**) } = let ind = indexes t in if is_disjoint ind i j then 0 else if is_fully_covered ind i j then ind.isum else match t with | Leaf _ -> absurd (* car on a forcément is_disjoint ou bien is_fully_covered *) | Node _ l r -> query2 l a i j + query2 r a i j (* utiliser un lemme de découpage des intersections *) end let query3 (t:tree) (ghost a: array int) (i j:int) : int requires { 0 <= i <= j <= a.length } requires { (**) } ensures { result = sum a i j } = (**) (*>*) (* QUESTIONS 17 and 18 *) (*= j } requires { is_tree_for t a i j } variant { t } ensures { is_tree_for t a[k<-v] i j } = match t with | Leaf _ -> () | Node _ l r -> is_tree_for_frame l a k v i l.indexes.high; is_tree_for_frame r a k v l.indexes.high j; end let rec lemma sum_right (a : array int) (i j : int) requires { 0 <= i < j <= a.length } variant { j - i } ensures { sum a i j = sum a i (j-1) + a[j-1] } = if i < j-1 then sum_right a (i+1) j let rec lemma sum_frame (a1 a2 : array int) (i j : int) : unit requires { 0 <= i <= j } requires { j <= a1.length } requires { j <= a2.length } requires { forall k : int. i <= k < j -> a1[k] = a2[k] } variant { j - i } ensures { sum a1 i j = sum a2 i j } = if i < j then sum_frame a1 a2 (i+1) j let rec lemma sum_update (a:array int) (i v l h:int) : unit requires { 0 <= l <= i < h <= a.length } variant { h } ensures { sum (a[i<-v]) l h = sum a l h + v - a[i] } = if h > i + 1 then sum_update a i v l (h-1) (*>*) let rec update_aux (t:tree) (i:int) (ghost a :array int) (v:int) : (tree,int) requires { (**) } (**) returns { (t',delta) -> (**) } = (* assert { i = ind.low }; (Leaf { ind with isum = v }, v - ind.isum) | Node ind l r -> let m = l.indexes.high in if i < m then let l',delta = update_aux l i a v in assert { is_tree_for l' a[i<-v] t.indexes.low m }; assert { is_tree_for r a[i<-v] m t.indexes.high }; (Node {ind with isum = ind.isum + delta } l' r, delta) else let r',delta = update_aux r i a v in assert { is_tree_for l a[i<-v] t.indexes.low m }; assert { is_tree_for r' a[i<-v] m t.indexes.high }; (Node {ind with isum = ind.isum + delta} l r',delta) end(*>*) (* QUESTION 19 *) let update (t:tree) (ghost a:array int) (i v:int) : tree requires { (**) } (**) writes { a } ensures { a[i] = v } ensures { forall k. 0 <= k < a.length /\ k <> i -> a[k] = (old a)[k] } ensures { is_tree_for result a 0 a.length } = let t,_ = (**) in a[i] <- v; t (* complexity *) use import int.MinMax function depth (t:tree) : int = match t with | Leaf _ -> 0 | Node _ l r -> 1 + max (depth l) (depth r) end use import ref.Ref let rec update_compl (t:tree) (i:int) (ghost a :array int) (v:int) (ghost c:ref int): (tree,int) requires { (**) } (*= depth t } variant { t } (*>*) returns { (t',delta) -> (**) } = c := !c - 1; match t with | Leaf ind -> (**) | Node ind l r -> (**) end use import bv.Pow2int let rec lemma depth_is_log (t:tree) (a :array int) (k:int) requires { k >= 0 } requires { is_tree_for t a t.indexes.low t.indexes.high } requires { t.indexes.high - t.indexes.low <= pow2 k } variant { t } ensures { depth t <= k } = match t with | Leaf _ -> () | Node _ l r -> depth_is_log l a (k-1); depth_is_log r a (k-1) end end