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
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 → (i≥imax)%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).
∀ (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 → (i≥imax)%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 p ⇒ Binary.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.