Library prosa.implementation.refinements.refinements
Require Export prosa.implementation.definitions.task.
Require Export prosa.implementation.facts.extrapolated_arrival_curve.
Require Export NArith.
From CoqEAL Require Export hrel param refinements binnat.
Export Refinements.Op.
Require Export prosa.implementation.facts.extrapolated_arrival_curve.
Require Export NArith.
From CoqEAL Require Export hrel param refinements binnat.
Export Refinements.Op.
Refinements Library
https://drops.dagstuhl.de/opus/volltexte/2022/16336/. 
Brief Introduction
https://hal.inria.fr/hal-01113453/document. 
Auxiliary Definitions
... and an analogous version that works on pairs. 
Definition tmap {X Y : Type} (f : X → Y) (t : X × X) := (f (fst t), f (snd t)).
Definition tb2tn t := tmap nat_of_bin t.
Definition tn2tb t := tmap bin_of_nat t.
Definition m_tb2tn xs := map tb2tn xs.
Definition m_tn2tb xs := map tn2tb xs.
Definition tb2tn t := tmap nat_of_bin t.
Definition tn2tb t := tmap bin_of_nat t.
Definition m_tb2tn xs := map tb2tn xs.
Definition m_tn2tb xs := map tn2tb xs.
Basic Arithmetic
Definitions
Consider a generic type T supporting basic arithmetic operations,
        neutral elements, and comparisons. 
  Context {T : Type}.
Context `{!zero_of T, !one_of T, !sub_of T, !add_of T, !mul_of T,
!div_of T, !mod_of T, !eq_of T, !leq_of T, !lt_of T}.
Context `{!zero_of T, !one_of T, !sub_of T, !add_of T, !mul_of T,
!div_of T, !mod_of T, !eq_of T, !leq_of T, !lt_of T}.
We redefine the predecessor function. Note that, although this
        definition uses common notation, the %C indicates that we
        refer to the generic type T defined above. 
Further, we redefine the maximum and minimum functions... 
  Definition maxn_T (m n : T) := (if m < n then n else m)%C.
Definition minn_T (m n : T) := (if m < n then m else n)%C.
Definition minn_T (m n : T) := (if m < n then m else n)%C.
... the "divides" function... 
... and the division with ceiling function. 
  Definition div_ceil_T (a : T) (b : T) :=
if dvdn_T b a then (a %/ b)%C else (1 + a %/ b)%C.
End Definitions.
if dvdn_T b a then (a %/ b)%C else (1 + a %/ b)%C.
End Definitions.
Refinements
Second, we prove a refinement for the predecessor function. 
Next, we prove a refinement for the "divides" function. 
Next, we prove a refinement for the division with ceiling. 
Next, we prove a refinement for the minimum function. 
Finally, we prove a refinement for the maximum function. 
Supporting Lemmas
Next, we prove that, if the successor of a unary number b corresponds to a
    positive binary number p, then b corresponds to the predecessor of
    p. 
Finally, we prove that if two unary numbers a and b have the same
    numeral as, respectively, two binary numbers a' and b', then a<b is
    rewritable into a'<b'. 
Functions on Lists
Definitions
Consider a generic type T supporting basic arithmetic operations
        and comparisons 
  Context {T : Type}.
Context `{!zero_of T, !one_of T, !sub_of T, !add_of T, !mul_of T,
!div_of T, !mod_of T, !eq_of T, !leq_of T, !lt_of T}.
Context `{!zero_of T, !one_of T, !sub_of T, !add_of T, !mul_of T,
!div_of T, !mod_of T, !eq_of T, !leq_of T, !lt_of T}.
We redefine the iota function, ... 
  Fixpoint iota_T (a : T) (b : nat): seq T :=
match b with
| 0 ⇒ [::]
| S b' ⇒ a :: iota_T (a + 1)%C b'
end.
match b with
| 0 ⇒ [::]
| S b' ⇒ a :: iota_T (a + 1)%C b'
end.
... the size function, ... 
  Fixpoint size_T {X : Type} (s : seq X): T :=
match s with
| [::] ⇒ 0%C
| _ :: s' ⇒ (1 + size_T s')%C
end.
match s with
| [::] ⇒ 0%C
| _ :: s' ⇒ (1 + size_T s')%C
end.
... the forward-shift function, ... 
... and the backwards-shift function. 
  Definition shift_points_neg_T (xs : seq T) (s : T) : seq T :=
let nonsmall := filter (fun x ⇒ s ≤ x)%C xs in
map (fun x ⇒ x - s)%C nonsmall.
End Definitions.
let nonsmall := filter (fun x ⇒ s ≤ x)%C xs in
map (fun x ⇒ x - s)%C nonsmall.
End Definitions.
Refinements
Global Instance refine_map :
∀ {A A' B B': Type}
(F : A → B) (F' : A' → B')
(rA : A → A' → Type) (rB : B → B' → Type) xs xs',
refines (list_R rA) xs xs' →
refines (rA ==> rB)%rel F F' →
refines (list_R rB)%rel (map F xs) (map F' xs').
∀ {A A' B B': Type}
(F : A → B) (F' : A' → B')
(rA : A → A' → Type) (rB : B → B' → Type) xs xs',
refines (list_R rA) xs xs' →
refines (rA ==> rB)%rel F F' →
refines (list_R rB)%rel (map F xs) (map F' xs').
Second, we prove a refinement for the zip function. 
Global Instance refine_zip :
refines (list_R Rnat ==> list_R Rnat ==> list_R (prod_R Rnat Rnat))%rel zip zip.
 
refines (list_R Rnat ==> list_R Rnat ==> list_R (prod_R Rnat Rnat))%rel zip zip.
Next, we prove a refinement for the all function. 
Global Instance refine_all :
∀ {A A' : Type} (rA : A → A' → Type),
refines ((rA ==> bool_R) ==> list_R rA ==> bool_R)%rel all all.
∀ {A A' : Type} (rA : A → A' → Type),
refines ((rA ==> bool_R) ==> list_R rA ==> bool_R)%rel all all.
Next, we prove a refinement for the flatten function. 
Global Instance refine_flatten :
∀ {A A': Type} (rA : A → A' → Type),
refines (list_R (list_R rA) ==> list_R rA)%rel flatten flatten.
∀ {A A': Type} (rA : A → A' → Type),
refines (list_R (list_R rA) ==> list_R rA)%rel flatten flatten.
Next, we prove a refinement for the cons function. 
Global Instance refine_cons A C (rAC : A → C → Type) :
refines (rAC ==> list_R rAC ==> list_R rAC)%rel cons cons.
refines (rAC ==> list_R rAC ==> list_R rAC)%rel cons cons.
Next, we prove a refinement for the nil function. 
Next, we prove a refinement for the last function. 
Global Instance refine_last :
∀ {A B : Type} (rA : A → B → Type),
refines (rA ==> list_R rA ==> rA)%rel last last.
∀ {A B : Type} (rA : A → B → Type),
refines (rA ==> list_R rA ==> rA)%rel last last.
Next, we prove a refinement for the size function. 
Global Instance refine_size A C (rAC : A → C → Type) :
refines (list_R rAC ==> Rnat)%rel size size_T.
refines (list_R rAC ==> Rnat)%rel size size_T.
Next, we prove a refinement for the iota function when applied
        to the successor of a number. 
Lemma iotaTsuccN :
∀ (a : N) p,
iota_T a (N.succ (Pos.pred_N p)) = a :: iota_T (succN a) (Pos.pred_N p).
∀ (a : N) p,
iota_T a (N.succ (Pos.pred_N p)) = a :: iota_T (succN a) (Pos.pred_N p).
Next, we prove a refinement for the iota function. 
Next, we prove a refinement for the shift_points_pos function. 
Global Instance refine_shift_points_pos:
refines (list_R Rnat ==> Rnat ==> list_R Rnat)%rel shift_points_pos shift_points_pos_T.
refines (list_R Rnat ==> Rnat ==> list_R Rnat)%rel shift_points_pos shift_points_pos_T.
Next, we prove a refinement for the shift_points_neg function. 
Global Instance refine_shift_points_neg:
refines (list_R Rnat ==> Rnat ==> list_R Rnat)%rel shift_points_neg shift_points_neg_T.
refines (list_R Rnat ==> Rnat ==> list_R Rnat)%rel shift_points_neg shift_points_neg_T.
Finally, we prove that the if the nat_of_bin function is applied to a
    list, the result is the original list translated to binary. 
Supporting Lemmas
Lemma refine_foldr_lemma :
refines ((Rnat ==> Rnat ==> Rnat) ==> Rnat ==> list_R Rnat ==> Rnat)%rel foldr foldr.
Section GenericLists.
refines ((Rnat ==> Rnat ==> Rnat) ==> Rnat ==> list_R Rnat ==> Rnat)%rel foldr foldr.
Section GenericLists.
Now, consider two types T1 and T2, and two lists of the respective
      type. 
  Lemma refine_foldr:
∀ (R : T1 → bool) (R' : T2 → bool) (F : T1 → nat) (F' : T2 → N),
∀ (rT : T1 → T2 → Type),
refines ( list_R rT )%rel xs xs' →
refines ( rT ==> Rnat )%rel F F' →
refines ( rT ==> bool_R )%rel R R' →
refines Rnat (\sum_(x <- xs | R x) F x) (foldr +%C 0%C [seq F' x' | x' <- xs' & R' x']).
∀ (R : T1 → bool) (R' : T2 → bool) (F : T1 → nat) (F' : T2 → N),
∀ (rT : T1 → T2 → Type),
refines ( list_R rT )%rel xs xs' →
refines ( rT ==> Rnat )%rel F F' →
refines ( rT ==> bool_R )%rel R R' →
refines Rnat (\sum_(x <- xs | R x) F x) (foldr +%C 0%C [seq F' x' | x' <- xs' & R' x']).
  Lemma refine_uncond_foldr :
∀ (F : T1 → nat) (F' : T2 → N),
∀ (rT : T1 → T2 → Type),
refines ( list_R rT )%rel xs xs' →
refines ( rT ==> Rnat )%rel F F' →
refines Rnat (\sum_(x <- xs) F x) (foldr +%C 0%C [seq F' x' | x' <- xs']).
∀ (F : T1 → nat) (F' : T2 → N),
∀ (rT : T1 → T2 → Type),
refines ( list_R rT )%rel xs xs' →
refines ( rT ==> Rnat )%rel F F' →
refines Rnat (\sum_(x <- xs) F x) (foldr +%C 0%C [seq F' x' | x' <- xs']).
Next, we prove a refinement for the foldr function when applied to a
      max operation over a list. In terms, the list is the result of a map
      and filter operation.  
  Lemma refine_foldr_max :
∀ (R : T1 → bool) (R' : T2 → bool)
(F : T1 → nat) (F' : T2 → N),
∀ (rT : T1 → T2 → Type),
refines ( list_R rT )%rel xs xs' →
refines ( rT ==> Rnat )%rel F F' →
refines ( rT ==> bool_R )%rel R R' →
refines Rnat (\max_(x <- xs | R x) F x) (foldr maxn_T 0%C [seq F' x' | x' <- xs' & R' x']).
End GenericLists.
∀ (R : T1 → bool) (R' : T2 → bool)
(F : T1 → nat) (F' : T2 → N),
∀ (rT : T1 → T2 → Type),
refines ( list_R rT )%rel xs xs' →
refines ( rT ==> Rnat )%rel F F' →
refines ( rT ==> bool_R )%rel R R' →
refines Rnat (\max_(x <- xs | R x) F x) (foldr maxn_T 0%C [seq F' x' | x' <- xs' & R' x']).
End GenericLists.