LAProof.accuracy_proofs.solve_model: models of Cholesky decomposition and triangular solve


From LAProof.accuracy_proofs Require Import preamble common float_acc_lems.
Require Import vcfloat.FPStdLib.
Require Import vcfloat.FPStdCompCert.
From LAProof Require Import accuracy_proofs.mv_mathcomp.

MathComp matrices over a nonring

Most MathComp matrix operations, such as matrix multiplication, are parameterized over a Ring or Field structure. When you do the dot-products in a matrix multiply, it doesn't matter what order you add up the element products, because addition in a Ring is associative-commutative. But our functional models of matrix algorithms are in floating point, which is not a Ring or Field because (for example) addition is not associative.
MathComp handles this by having some matrix operations (such as transpose tr_mx and the very definition of a @matrix _ _ _ (notated as 'M[_]_(_,_)) be parameterized only over a Type when they don't need a Ring structure; it is only the operators whose natural mathematics need additional properties, that require a Ring or Field.
That means we can use natural MathComp operations such as blocking and transpose on floating-point matrices 'M[ftype t]_(m,n) but we cannot use MathComp's matrix multiply mulmx. Instead, if we multiply floating-point matrices, we must define it ourselves in a way that specifies exactly what order of operations is done, or (if a relation instead of a function) what order(s) are permitted.
The definition update_mx is an example of an operation that naturally does not require a Ring structure. The definition subtract_loop, below, is an example of the other kind; we can't use MathComp's dot-product to define it, so we write a definition that explicitly specifies the order of additions.

Definition update_mx {T} [m n] (M: 'M[T]_(m,n)) (i: 'I_m) (j: 'I_n) (x: T) : 'M[T]_(m,n) :=
    \matrix_(i',j') if andb (Nat.eq_dec i' i) (Nat.eq_dec j' j) then x else M i' j'.

Functional model of Cholesky decomposition (jik algorithm)

The next three definitions, up to cholesky_jik_spec, are adapted from similar definitions in coq-libvalidsdp by P. Roux et al.

Section WithNaN.

Context {NAN: FPCore.Nans} {t : type}.

Definition subtract_loop {t} (c: ftype t) (l: seq (ftype t × ftype t)) :=
  foldl BMINUS c (map (uncurry BMULT) l).

Definition subtract_loop_jik {t} [n] (c: ftype t) (R: 'M[ftype t]_n) (i j k: 'I_n) : ftype t :=
   subtract_loop c (map (fun k'(R k' i, R k' j)) (take k (ord_enum n))).

Definition cholesky_jik_ij {t} [n: nat] (A R: 'M[ftype t]_n) (i j: 'I_n) : Prop :=
     ( Hij: (i<j)%N, R i j = BDIV (subtract_loop_jik (A i j) R i j i) (R i i))
    ( Hij: i=j, R i j = BSQRT (subtract_loop_jik (A i j) R i j i)).

Definition cholesky_jik_spec {t} [n: nat] (A R: 'M[ftype t]_n) : Prop :=
   i j, cholesky_jik_ij A R i j.

When we have run the "Cholesky jik algorithm" only up to iteration (i,j), the matrix is only initialized above row i, and in row i up to column j, so we need this subrelation in our loop invariant.
Definition cholesky_jik_upto {t} [n] (imax: 'I_n) (jmax : 'I_n.+1) (A R : 'M[ftype t]_n) : Prop :=
   (i j: 'I_n),
      ((j<jmax)%N cholesky_jik_ij A R i j)
    (nat_of_ord j = nat_of_ord jmax (i<imax)%N cholesky_jik_ij A R i j)
    ((j>jmax)%N R i j = A i j)
    (nat_of_ord j= nat_of_ord jmax (iimax)%N R i j = A i j).

Definition cholesky_success {t} [n: nat] (A R: 'M[ftype t]_n) : Prop :=
   cholesky_jik_spec A R
    i, Binary.is_finite_strict _ _ (R i i).

Definition Zcholesky_return {t} (x: ftype t) : Z :=
 match x with
 | Binary.B754_zero _ _ _ ⇒ 0%Z
 | Binary.B754_finite _ _ _ _ _ _ ⇒ 1%Z
 | _-1%Z
 end.

Definition BFREXP [t] (x: ftype t): (ftype t × Z) :=
  Binary.Bfrexp (fprec t) (femax t) (fprec_gt_0 t) x.

Definition cholesky_return {t} [n] (R: 'M[ftype t]_n) : ftype t :=
     foldl (fun (x: ftype t) (i: 'I_n) ⇒ BMULT x (fst (BFREXP (R i i)))) (Zconst t 1) (ord_enum n).

Functional models of forward substitution and back substitution

Definition forward_subst_step {t: type} [n: nat]
         (L: 'M[ftype t]_n) (x: 'cV[ftype t]_n) (i: 'I_n)
     : 'cV_n :=
   update_mx x i ord0
    (BDIV (subtract_loop (x i ord0) (map (fun j(L i j, x j ord0)) (take i (ord_enum n))))
          (L i i)).

Definition forward_subst [t: type] [n]
         (L: 'M[ftype t]_n) (x: 'cV[ftype t]_n) : 'cV_n :=
  foldl (forward_subst_step L) x (ord_enum n).

Definition backward_subst_step {t: type} [n: nat]
         (U: 'M[ftype t]_n) (x: 'cV[ftype t]_n) (i: 'I_n) : 'cV_n :=
    update_mx x i ord0
      (BDIV (subtract_loop (x i ord0) (map (fun j(U i j, x j ord0)) (drop (i+1) (ord_enum n))))
         (U i i)).

Definition backward_subst {t: type} [n: nat]
         (U: 'M[ftype t]_n) (x: 'cV[ftype t]_n) : 'cV[ftype t]_n :=
     foldl (backward_subst_step U) x (rev (ord_enum n)).

Lemma subtract_loop_finite_e: (c: ftype t) (al: seq (ftype t × ftype t)),
  Binary.is_finite (subtract_loop c al)
  Binary.is_finite c forallb (fun pBinary.is_finite (fst p) && Binary.is_finite (snd p)) al.

Lemma BSQRT_finite_e: (x: ftype t) (H: Binary.is_finite (BSQRT x)), Binary.is_finite x.

Lemma diag_finite_R_finite:
  [n] (A R: 'M[ftype t]_n),
  A^T = A
  cholesky_jik_spec A R
  ( i, Binary.is_finite (R i i))
   i j, (nat_of_ord i nat_of_ord j)%N Binary.is_finite (R i j).

Lemma last_R_finite:
  [n] (A R: 'M[ftype t]_n.+1),
  A^T = A
  cholesky_jik_spec A R
   Binary.is_finite (R (inord n) (inord n))
   i j, (nat_of_ord i nat_of_ord j)%N Binary.is_finite (R i j).

Lemma cholesky_success_R_finite:
  [n] (A R: 'M[ftype t]_n),
  A^T = A
  cholesky_success A R
   i j, (nat_of_ord i nat_of_ord j)%N Binary.is_finite (R i j).

Lemma rev_List_rev: t (al: list t), rev al = List.rev al.

Lemma BFREXP_finite_e: [t] (x: ftype t), Binary.is_finite (fst (BFREXP x)) Binary.is_finite x.

Lemma BFREXP_finite_strict_e: [t] (x: ftype t),
     Binary.is_finite_strict _ _ (fst (BFREXP x)) Binary.is_finite_strict _ _ x.

Lemma Bmult_R0 (f a: ftype t) :
Binary.is_finite (BMULT f a)
FT2R a = 0
(BMULT f a) = neg_zero (BMULT f a) = pos_zero.

Lemma SQRT_nonneg: (x: ftype t),
 Binary.is_finite x BCMP Gt true (Zconst t 0) (BSQRT x) = false.

Lemma BMULT_finite_strict_e: x y: ftype t, Binary.is_finite_strict _ _ (BMULT x y)
      Binary.is_finite_strict _ _ x Binary.is_finite_strict _ _ y.

Lemma cholesky_return_success:
   [n] (A R: 'M[ftype t]_n),
    cholesky_jik_spec A R
    Zcholesky_return (cholesky_return R) = 1%Z
    cholesky_success A R.

Lemma backward_subst_UT: [n] (R1 R2 : 'M[ftype t]_n) (x: 'cV[ftype t]_n),
    ( i j: 'I_n, (i j)%N R1 i j = R2 i j)
    backward_subst R1 x = backward_subst R2 x.

Lemma forward_subst_LT: [n] (R1 R2 : 'M[ftype t]_n) (x: 'cV[ftype t]_n),
    ( i j: 'I_n, (i j)%N R1 i j = R2 i j)
    forward_subst R1 x = forward_subst R2 x.

End WithNaN.