diff --git a/C/VSU_sparse.v b/C/VSU_sparse.v index 5ff53f4..f01bd5c 100644 --- a/C/VSU_sparse.v +++ b/C/VSU_sparse.v @@ -12,11 +12,11 @@ Open Scope logic. #[local] Existing Instance NullExtension.Espec. (* FIXME *) -Definition sparseImports : funspecs := [fma_spec]. (* Ideally , +Definition sparseImports : funspecs := [fma_spec]. (* Ideally , the VSU system would let us say MathASI instead of [fma_spec] *) Definition SparseVSU: VSU nil sparseImports ltac:(QPprog prog) SparseASI emp. - Proof. + Proof. mkVSU prog SparseASI. - solve_SF_internal body_crs_matrix_rows. - solve_SF_internal body_crs_row_vector_multiply. diff --git a/C/sparse_model.v b/C/sparse_model.v index efc4738..77e301e 100644 --- a/C/sparse_model.v +++ b/C/sparse_model.v @@ -21,14 +21,14 @@ Definition crs_rep_aux {t} (mval: matrix t) (cols: Z) (vals: list (ftype t)) (co Zlength row_ptr = 1 + Zlength mval /\ Zlength vals = Znth (Zlength mval) row_ptr /\ Zlength col_ind = Znth (Zlength mval) row_ptr /\ - sorted Z.le (0::row_ptr ++ [Int.max_unsigned]) /\ + sorted Z.le (0::row_ptr ++ [Int.max_unsigned]) /\ forall j, 0 <= j < Zlength mval -> - crs_row_rep cols + crs_row_rep cols (sublist (Znth j row_ptr) (Znth (j+1) row_ptr) vals) (sublist (Znth j row_ptr) (Znth (j+1) row_ptr) col_ind) (Znth j mval). -Lemma sorted_app_e1: +Lemma sorted_app_e1: forall {A} {HA: Inhabitant A} (le: A -> A -> Prop) al bl, sorted le (al++bl) -> sorted le al. Proof. @@ -89,7 +89,7 @@ split3; [ | | split3]. rewrite !Znth_pos_cons in H by lia. rewrite !Z.add_simpl_r in H. rewrite !Znth_map by lia. - assert (0 <= Znth j row_ptr - r <= Znth (j + 1) row_ptr - r) + assert (0 <= Znth j row_ptr - r <= Znth (j + 1) row_ptr - r) by (clear - H0 H1 SORT L; abstract list_solve). assert (Znth (j + 1) row_ptr - r <= Zlength col_ind - r) by (clear - H0 H1 SORT L L1; abstract list_solve). @@ -120,11 +120,11 @@ induction 1; intros. + subst. rewrite Znth_0_cons. apply crs_row_rep_cols_nonneg in H. lia. + rewrite Znth_pos_cons by lia. specialize (IHcrs_row_rep (j-1) ltac:(list_solve)). - rewrite Znth_map in IHcrs_row_rep by list_solve. + rewrite Znth_map in IHcrs_row_rep by list_solve. lia. Qed. -Lemma crs_row_rep_property: +Lemma crs_row_rep_property: forall {t} (P: ftype t -> Prop) cols (vals: list (ftype t)) col_ind vval, crs_row_rep cols vals col_ind vval -> Forall P vval -> Forall P vals. @@ -188,7 +188,7 @@ apply Forall2_Znth with (i:=z) in Hvval; auto. lia. Qed. -Definition partial_row {t} (i: Z) (h: Z) (vals: list (ftype t)) (col_ind: list Z) (row_ptr: list Z) +Definition partial_row {t} (i: Z) (h: Z) (vals: list (ftype t)) (col_ind: list Z) (row_ptr: list Z) (vval: vector t) : ftype t := let vals' := sublist (Znth i row_ptr) h vals in let col_ind' := sublist (Znth i row_ptr) h col_ind in @@ -234,7 +234,7 @@ assert (COL := crs_rep_matrix_cols _ _ _ _ _ H0). red in COL. destruct H0 as [? [? [? [? ?]]]]. specialize (H4 _ H). -set (vals' := sublist _ _ vals) in *. clearbody vals'. +set (vals' := sublist _ _ vals) in *. clearbody vals'. set (col_ind' := sublist _ _ col_ind) in *. clearbody col_ind'. unfold matrix_rows in *. rewrite Znth_map by list_solve. @@ -283,7 +283,7 @@ destruct vval as [ | v0 vval']. inv FINvals'. rewrite IHvals; auto. f_equal. f_equal. inv H0. - list_solve. + list_solve. inv H0; auto. clear; list_solve. * clear - FINvval FINrow. inv FINvval. @@ -293,7 +293,7 @@ destruct vval as [ | v0 vval']. destruct vval'; simpl; auto. inv H2. inv FINrow. apply IHv; auto. - apply BFMA_mor; auto. + apply BFMA_mor; auto. - inv FINrow. rename H1 into FINx. rename H2 into FINrow. inv FINvals'. clear H1. rename H2 into FINvals. @@ -346,7 +346,7 @@ Lemma partial_row_next: Znth i row_ptr <= h < Zlength vals -> Zlength vals = Zlength col_ind -> crs_rep_aux mval cols vals col_ind row_ptr -> -partial_row i (h + 1) vals col_ind row_ptr vval = +partial_row i (h + 1) vals col_ind row_ptr vval = BFMA (Znth h vals) (Znth (Znth h col_ind) vval) (partial_row i h vals col_ind row_ptr vval). Proof. diff --git a/C/spec_sparse.v b/C/spec_sparse.v index 5b978a1..7f364ec 100644 --- a/C/spec_sparse.v +++ b/C/spec_sparse.v @@ -15,11 +15,11 @@ Open Scope logic. Definition t_crs := Tstruct _crs_matrix noattr. Definition crs_rep (sh: share) (mval: matrix Tdouble) (p: val) : mpred := - EX v: val, EX ci: val, EX rp: val, + EX v: val, EX ci: val, EX rp: val, EX cols, EX vals: list (ftype Tdouble), EX col_ind: list Z, EX row_ptr: list Z, !! crs_rep_aux mval cols vals col_ind row_ptr && data_at sh t_crs (v,(ci,(rp,(Vint (Int.repr (matrix_rows mval)), Vint (Int.repr cols))))) p * - data_at sh (tarray tdouble (Zlength col_ind)) (map Vfloat vals) v * + data_at sh (tarray tdouble (Zlength col_ind)) (map Vfloat vals) v * data_at sh (tarray tuint (Zlength col_ind)) (map Vint (map Int.repr col_ind)) ci * data_at sh (tarray tuint (matrix_rows mval + 1)) (map Vint (map Int.repr row_ptr)) rp. @@ -52,7 +52,7 @@ Definition crs_row_vector_multiply_spec := data_at sh2 (tarray tdouble (Zlength vval)) (map Vfloat vval) v) POST [ tdouble ] EX s: ftype Tdouble, - PROP(feq s (dotprod (Znth i mval) vval)) + PROP(feq s (dotprod (Znth i mval) vval)) RETURN(Vfloat s) SEP (crs_rep sh1 mval m; data_at sh2 (tarray tdouble (Zlength vval)) (map Vfloat vval) v). @@ -70,15 +70,15 @@ Definition crs_matrix_vector_multiply_byrows_spec := Forall (Forall finite) mval) PARAMS(m; v; p) SEP (crs_rep sh1 mval m; - data_at sh2 (tarray tdouble (Zlength vval)) (map Vfloat vval) v; + data_at sh2 (tarray tdouble (Zlength vval)) (map Vfloat vval) v; data_at_ sh3 (tarray tdouble (matrix_rows mval)) p) POST [ tvoid ] EX result: vector Tdouble, - PROP(Forall2 feq result (matrix_vector_mult mval vval)) + PROP(Forall2 feq result (matrix_vector_mult mval vval)) RETURN() SEP (crs_rep sh1 mval m; - data_at sh2 (tarray tdouble (Zlength vval)) (map Vfloat vval) v; - data_at sh3 (tarray tdouble (matrix_rows mval)) + data_at sh2 (tarray tdouble (Zlength vval)) (map Vfloat vval) v; + data_at sh3 (tarray tdouble (matrix_rows mval)) (map Vfloat result) p). Definition crs_matrix_vector_multiply_spec := @@ -94,18 +94,18 @@ Definition crs_matrix_vector_multiply_spec := Forall (Forall finite) mval) PARAMS(m; v; p) SEP (crs_rep sh1 mval m; - data_at sh2 (tarray tdouble (Zlength vval)) (map Vfloat vval) v; + data_at sh2 (tarray tdouble (Zlength vval)) (map Vfloat vval) v; data_at_ sh3 (tarray tdouble (matrix_rows mval)) p) POST [ tvoid ] EX result: vector Tdouble, - PROP(Forall2 feq result (matrix_vector_mult mval vval)) + PROP(Forall2 feq result (matrix_vector_mult mval vval)) RETURN() SEP (crs_rep sh1 mval m; - data_at sh2 (tarray tdouble (Zlength vval)) (map Vfloat vval) v; - data_at sh3 (tarray tdouble (matrix_rows mval)) + data_at sh2 (tarray tdouble (Zlength vval)) (map Vfloat vval) v; + data_at sh3 (tarray tdouble (matrix_rows mval)) (map Vfloat result) p). -Definition SparseASI : funspecs := [ +Definition SparseASI : funspecs := [ crs_matrix_rows_spec; crs_row_vector_multiply_spec; crs_matrix_vector_multiply_byrows_spec; diff --git a/C/verif_sparse.v b/C/verif_sparse.v index 3fbd95f..315a22d 100644 --- a/C/verif_sparse.v +++ b/C/verif_sparse.v @@ -11,13 +11,13 @@ Open Scope logic. Definition the_loop_body : statement. let c := constr:(f_crs_matrix_vector_multiply) in -let c := eval red in c in +let c := eval red in c in match c with context [Sloop (Ssequence _ ?body)] => exact body end. Defined. -Lemma crs_multiply_loop_body: +Lemma crs_multiply_loop_body: forall (Espec : OracleKind) (sh1 sh2 sh3 : share) (m : val) (mval : matrix Tdouble) (v : val) (vval : vector Tdouble) @@ -43,9 +43,9 @@ Lemma crs_multiply_loop_body: semax (func_tycontext f_crs_matrix_vector_multiply Vprog Gprog []) (PROP ( ) LOCAL (temp _i (Vint (Int.repr i)); - temp _next (Vint (Int.repr (Znth i row_ptr))); + temp _next (Vint (Int.repr (Znth i row_ptr))); temp _row_ptr rp; temp _col_ind ci; temp _val vp; - temp _rows (Vint (Int.repr (matrix_rows mval))); + temp _rows (Vint (Int.repr (matrix_rows mval))); temp _m m; temp _v v; temp _p p) SEP (FRAME; data_at sh1 (tarray tdouble (Zlength col_ind)) (map Vfloat vals) vp; @@ -62,7 +62,7 @@ semax (func_tycontext f_crs_matrix_vector_multiply Vprog Gprog []) LOCAL (temp _i (Vint (Int.repr i)); temp _next (Vint (Int.repr (Znth (i + 1) row_ptr))); temp _row_ptr rp; temp _col_ind ci; temp _val vp; - temp _rows (Vint (Int.repr (matrix_rows mval))); + temp _rows (Vint (Int.repr (matrix_rows mval))); temp _m m; temp _v v; temp _p p) SEP (FRAME; data_at sh1 (tarray tdouble (Zlength col_ind)) (map Vfloat vals) vp; @@ -86,15 +86,15 @@ assert(0 <= i + 1 < Zlength row_ptr) by (rewrite H4; unfold matrix_rows in H6; lia). forward. -forward_loop +forward_loop (EX h:Z, (PROP (Znth i row_ptr <= h <= Znth (i+1) row_ptr ) LOCAL ( temp _s (Vfloat (partial_row i h vals col_ind row_ptr vval)); temp _i (Vint (Int.repr i)); temp _h (Vint (Int.repr h)); - temp _next (Vint (Int.repr (Znth (i+1) row_ptr))); + temp _next (Vint (Int.repr (Znth (i+1) row_ptr))); temp _row_ptr rp; temp _col_ind ci; temp _val vp; - temp _rows (Vint (Int.repr (matrix_rows mval))); + temp _rows (Vint (Int.repr (matrix_rows mval))); temp _m m; temp _v v; temp _p p) SEP (FRAME; data_at sh1 (tarray tdouble (Zlength col_ind)) (map Vfloat vals) vp; @@ -110,9 +110,9 @@ forward_loop LOCAL ( temp _s (Vfloat r); temp _i (Vint (Int.repr i)); - temp _next (Vint (Int.repr (Znth (i+1) row_ptr))); + temp _next (Vint (Int.repr (Znth (i+1) row_ptr))); temp _row_ptr rp; temp _col_ind ci; temp _val vp; - temp _rows (Vint (Int.repr (matrix_rows mval))); + temp _rows (Vint (Int.repr (matrix_rows mval))); temp _m m; temp _v v; temp _p p) SEP (FRAME; data_at sh1 (tarray tdouble (Zlength col_ind)) (map Vfloat vals) vp; @@ -134,7 +134,7 @@ forward_if. + assert (0 <= Znth i row_ptr) by list_solve. rewrite Int.unsigned_repr in H14 by list_solve. - rewrite Int.unsigned_repr in H14 + rewrite Int.unsigned_repr in H14 by (clear - H4 H6 H9; unfold matrix_rows in H6; list_solve). forward. apply prop_right. rewrite H8. unfold matrix_rows in *; list_solve. @@ -151,13 +151,13 @@ forward_if. assert (Znth (i+1) row_ptr <= Zlength col_ind) by list_solve. clear - COLS H H17 H14 H6 H10 H15 H18. specialize (H10 _ H6). - replace (Znth h col_ind) with + replace (Znth h col_ind) with (Znth (h-Znth i row_ptr) (sublist (Znth i row_ptr) (Znth (i+1) row_ptr) col_ind)) by list_solve. pose proof (crs_row_rep_col_range _ _ _ _ H10). specialize (H0 (h - Znth i row_ptr)). - autorewrite with sublist in H0. autorewrite with sublist. + autorewrite with sublist in H0. autorewrite with sublist. rewrite <- (sublist.Forall_Znth _ _ _ H6 H), (sublist.Forall_Znth _ _ _ H6 COLS). apply H0. list_solve. } @@ -170,15 +170,15 @@ forward_if. Exists (h+1). entailer!. f_equal. - change (Binary.Bfma _ _ _ _ _ _ _ _ _) with + change (Binary.Bfma _ _ _ _ _ _ _ _ _) with (@BFMA _ Tdouble (Znth h vals) (Znth (Znth h col_ind) vval) (partial_row i h vals col_ind row_ptr vval) ). eapply partial_row_next; try eassumption; lia. + - forward. + forward. Exists (partial_row i h vals col_ind row_ptr vval). - entailer!. + entailer!. replace h with (Znth (i+1) row_ptr). erewrite partial_row_end; try eassumption. unfold matrix_vector_mult. @@ -188,7 +188,7 @@ forward_if. specialize (H10 i H6). unfold matrix_rows in *. rewrite Int.unsigned_repr in H14 by list_solve. - rewrite Int.unsigned_repr in H14 + rewrite Int.unsigned_repr in H14 by (clear - H4 H6 H9; unfold matrix_rows in H6; list_solve). lia. - @@ -210,15 +210,15 @@ forward. freeze FR1 := (data_at sh1 _ _ _). rename v0 into vp. assert_PROP (0 <= 0 < Zlength row_ptr) - by (entailer!; rewrite !Zlength_map in H12; rewrite H12; clear -H3; lia). + by (entailer!; rewrite !Zlength_map in H12; rewrite H12; clear -H3; lia). forward. forward_for_simple_bound (matrix_rows mval) (EX i:Z, EX result: list (ftype Tdouble), - PROP(Forall2 feq result (sublist 0 i (matrix_vector_mult mval vval))) - LOCAL (temp _next (Vint (Int.repr (Znth i row_ptr))); + PROP(Forall2 feq result (sublist 0 i (matrix_vector_mult mval vval))) + LOCAL (temp _next (Vint (Int.repr (Znth i row_ptr))); temp _row_ptr rp; temp _col_ind ci; temp _val vp; (* temp _cols (Vint (Int.repr cols));*) - temp _rows (Vint (Int.repr (matrix_rows mval))); + temp _rows (Vint (Int.repr (matrix_rows mval))); temp _m m; temp _v v; temp _p p) SEP (FRZL FR1; data_at sh1 (tarray tdouble (Zlength col_ind)) (map Vfloat vals) vp; @@ -227,7 +227,7 @@ forward_for_simple_bound (matrix_rows mval) data_at sh1 (tarray tuint (matrix_rows mval + 1)) (map Vint (map Int.repr row_ptr)) rp; data_at sh2 (tarray tdouble (Zlength vval)) (map Vfloat vval) v; - data_at sh3 (tarray tdouble (matrix_rows mval)) + data_at sh3 (tarray tdouble (matrix_rows mval)) (map Vfloat result ++ Zrepeat Vundef (matrix_rows mval - i)) p))%assert. - Exists (@nil (ftype Tdouble)). simpl app. @@ -252,7 +252,7 @@ unfold matrix_rows in H6. unfold matrix_vector_mult. rewrite Znth_map by auto. auto. apply derives_refl'. f_equal. assert (Zlength result = i). - apply Forall2_Zlength in H7. + apply Forall2_Zlength in H7. clear - H7 H6. unfold matrix_rows, matrix_vector_mult in *. list_solve. clear - H24 H6. unfold matrix_rows in *. diff --git a/C/verif_sparse_byrows.v b/C/verif_sparse_byrows.v index 9fb8b4d..f4022e2 100644 --- a/C/verif_sparse_byrows.v +++ b/C/verif_sparse_byrows.v @@ -60,7 +60,7 @@ assert (COLS: cols = Zlength vval). { } destruct H5 as [H2' [H7 [H8 [H9 H10]]]]. unfold matrix_rows in *. -assert (H9': 0 <= Znth i row_ptr <= Znth (i+1) row_ptr +assert (H9': 0 <= Znth i row_ptr <= Znth (i+1) row_ptr /\ Znth (i+1) row_ptr <= Znth (Zlength mval) row_ptr <= Int.max_unsigned) by (clear - H9 H2' H2; list_solve). clear H9. destruct H9' as [H9 H9']. @@ -69,7 +69,7 @@ forward_for_simple_bound (Znth (i + 1) row_ptr) LOCAL ( temp _s (Vfloat (partial_row i h vals col_ind row_ptr vval)); temp _i (Vint (Int.repr i)); - temp _hi (Vint (Int.repr (Znth (i+1) row_ptr))); + temp _hi (Vint (Int.repr (Znth (i+1) row_ptr))); temp _row_ptr rp; temp _col_ind ci; temp _val vp; temp _m m; temp _v v) SEP (FRZL FR1; @@ -81,13 +81,13 @@ forward_for_simple_bound (Znth (i + 1) row_ptr) data_at sh2 (tarray tdouble (Zlength vval)) (map Vfloat vval) v))%assert. - forward. - change float with (ftype Tdouble) in *. + change float with (ftype Tdouble) in *. EExists. entailer!. f_equal. erewrite partial_row_start. reflexivity. eassumption. - rename i0 into h. forward. -change float with (ftype Tdouble) in *. +change float with (ftype Tdouble) in *. forward. assert (0 <= Znth h col_ind < Zlength vval). { specialize (H10 _ H2). @@ -103,7 +103,7 @@ forward_call (Znth h vals, Znth (Znth h col_ind) vval, partial_row i h vals col_ forward. entailer!. f_equal. -change (Binary.Bfma _ _ _ _ _ _ _ _ _) with +change (Binary.Bfma _ _ _ _ _ _ _ _ _) with (@BFMA _ Tdouble (Znth h vals) (Znth (Znth h col_ind) vval) (partial_row i h vals col_ind row_ptr vval) ). @@ -127,12 +127,12 @@ start_function. forward_call. forward_for_simple_bound (Zlength mval) (EX i:Z, EX result: list (ftype Tdouble), - PROP(Forall2 feq result (sublist 0 i (matrix_vector_mult mval vval))) - LOCAL (temp _rows (Vint (Int.repr (matrix_rows mval))); + PROP(Forall2 feq result (sublist 0 i (matrix_vector_mult mval vval))) + LOCAL (temp _rows (Vint (Int.repr (matrix_rows mval))); temp _m m; temp _v v; temp _p p) SEP (crs_rep sh1 mval m; data_at sh2 (tarray tdouble (Zlength vval)) (map Vfloat vval) v; - data_at sh3 (tarray tdouble (matrix_rows mval)) + data_at sh3 (tarray tdouble (matrix_rows mval)) (map Vfloat result ++ Zrepeat Vundef (matrix_rows mval - i)) p))%assert. - unfold matrix_rows in H0; lia. - Exists (@nil (ftype Tdouble)). simpl app. entailer!. @@ -141,11 +141,11 @@ forward_for_simple_bound (Zlength mval) Intros s. unfold matrix_rows in H0. forward. - progress change float with (ftype Tdouble) in *. + progress change float with (ftype Tdouble) in *. Exists (result ++ [s]). - entailer!. + entailer!. clear H11 H12 H10 H9 H8 H7 PNp PNv PNm. - assert (Zlength (matrix_vector_mult mval vval) = Zlength mval). + assert (Zlength (matrix_vector_mult mval vval) = Zlength mval). unfold matrix_vector_mult. list_solve. rewrite (sublist_split 0 i (i+1)) by list_solve. apply Forall2_app. diff --git a/accuracy_proofs/common.v b/accuracy_proofs/common.v index ecc045c..81d4d47 100644 --- a/accuracy_proofs/common.v +++ b/accuracy_proofs/common.v @@ -1,4 +1,4 @@ -(* This file contains basic definitions and lemmas common to all other files in +(* This file contains basic definitions and lemmas common to all other files in the repository. *) Require Import vcfloat.VCFloat vcfloat.IEEE754_extra List. @@ -13,7 +13,7 @@ Definition pos_zero {t: type} := Binary.B754_zero (fprec t) (femax t) false. Definition Beq_dec_t {t: type} := (@Beq_dec (fprec t) (femax t)). Create HintDb commonDB discriminated. -Global Hint Resolve +Global Hint Resolve bpow_gt_0 bpow_ge_0 pos_INR lt_0_INR pow_le: commonDB. Section NonZeros. @@ -39,7 +39,7 @@ Qed. Lemma nnz_lemma A dec l zero : nnz A dec l zero = 0%nat -> forall x, In x l -> x = zero. Proof. -unfold nnz; +unfold nnz; induction l; try contradiction. intros; @@ -67,24 +67,24 @@ rewrite count_occ_cons_eq in H; auto. inversion H2. auto. Qed. -Lemma nnz_is_zero_cons A a l dec zero : +Lemma nnz_is_zero_cons A a l dec zero : nnz A dec (a::l) zero = 0%nat -> nnz A dec l zero = 0%nat. Proof. intros H. apply nnz_zero in H; symmetry in H. pose proof (@count_occ_unique A dec) zero (a::l) H. -unfold nnz. +unfold nnz. simpl in H0. inversion H0. -rewrite <- H3 at 1. +rewrite <- H3 at 1. rewrite count_occ_repeat_eq; auto. lia. Qed. -Lemma nnz_cons A l dec zero : +Lemma nnz_cons A l dec zero : nnz A dec (zero::l) zero = nnz A dec l zero. Proof. -unfold nnz; +unfold nnz; rewrite (count_occ_cons_eq dec l (eq_refl zero)); simpl; auto. Qed. @@ -99,39 +99,39 @@ Definition default_rel : R := Definition default_abs : R := / 2 * Raux.bpow Zaux.radix2 (3 - femax t - fprec t). -Lemma default_rel_sep_0 : +Lemma default_rel_sep_0 : default_rel <> 0. Proof. apply Rabs_lt_pos; -rewrite Rabs_pos_eq; [apply Rmult_lt_0_compat; try nra | +rewrite Rabs_pos_eq; [apply Rmult_lt_0_compat; try nra | apply Rmult_le_pos; try nra]; auto with commonDB. Qed. Hint Resolve default_rel_sep_0 : commonDB. -Lemma default_rel_gt_0 : +Lemma default_rel_gt_0 : 0 < default_rel. Proof. apply Rmult_lt_0_compat; try nra; auto with commonDB. Qed. Hint Resolve default_rel_gt_0 : commonDB. - -Lemma default_rel_ge_0 : + +Lemma default_rel_ge_0 : 0 <= default_rel . Proof. apply Rlt_le; auto with commonDB. Qed. Hint Resolve default_rel_ge_0 : commonDB. Lemma default_rel_plus_1_ge_1: 1 <= 1 + default_rel . -Proof. -rewrite Rplus_comm. -apply Rcomplements.Rle_minus_l; field_simplify. +Proof. +rewrite Rplus_comm. +apply Rcomplements.Rle_minus_l; field_simplify. auto with commonDB. Qed. Hint Resolve default_rel_plus_1_ge_1 : commonDB. Lemma default_rel_plus_0_ge_1: 0 <= 1 + default_rel . -Proof. suff: 1 <= 1 + default_rel; try nra; auto with commonDB. Qed. +Proof. suff: 1 <= 1 + default_rel; try nra; auto with commonDB. Qed. Hint Resolve default_rel_plus_0_ge_1 : commonDB. Lemma default_rel_plus_1_gt_1: @@ -144,7 +144,7 @@ Hint Resolve default_rel_plus_1_gt_1 : commonDB. Lemma default_rel_plus_1_gt_0 : 0 < 1 + default_rel. -Proof. +Proof. eapply Rlt_trans with 1; [nra | ]. auto with commonDB. Qed. @@ -152,7 +152,7 @@ Hint Resolve default_rel_plus_1_gt_0 : commonDB. Lemma default_rel_plus_1_ge_1' n: 1 <= (1 + default_rel) ^ n. -Proof. +Proof. induction n; simpl; auto; try nra. eapply Rle_trans with (1 * 1); try nra. apply Rmult_le_compat; try nra. @@ -160,9 +160,9 @@ auto with commonDB. Qed. Hint Resolve default_rel_plus_1_ge_1': commonDB. -Lemma default_abs_gt_0 : +Lemma default_abs_gt_0 : 0 < default_abs . -Proof. +Proof. unfold default_abs. apply Rmult_lt_0_compat; auto with commonDB; nra. Qed. @@ -175,14 +175,14 @@ Hint Resolve default_abs_ge_0: commonDB. Lemma abs_le_rel : default_abs <= default_rel. -Proof. +Proof. apply: Rmult_le_compat; try nra; auto with commonDB. apply: bpow_le => //; pose proof fprec_gt_one t; pose proof fprec_lt_femax t; lia. Qed. End DefaultRels. -Global Hint Resolve +Global Hint Resolve default_rel_sep_0 default_rel_gt_0 default_rel_ge_0 @@ -204,21 +204,21 @@ Notation E := (@default_abs t). Definition g (n: nat) : R := ((1 + D) ^ n - 1). -Lemma g_pos n: - 0 <= g n. -Proof. +Lemma g_pos n: + 0 <= g n. +Proof. unfold g. induction n. simpl; nra. eapply Rle_trans; [apply IHn| apply Rplus_le_compat; try nra]. simpl. eapply Rle_trans with (1 * (1+D )^n); try nra. apply Rmult_le_compat; try nra. rewrite Rplus_comm. apply Rcomplements.Rle_minus_l. -field_simplify. +field_simplify. auto with commonDB. Qed. Hint Resolve g_pos : commonDB. -Lemma le_g_Sn n : +Lemma le_g_Sn n : g n <= g (S n). -Proof. +Proof. induction n; unfold g; simpl. { field_simplify; auto with commonDB. } unfold g in IHn. eapply Rplus_le_compat; try nra. @@ -226,7 +226,7 @@ induction n; unfold g; simpl. apply Rplus_le_le_0_compat; try nra; try apply default_rel_ge_0. rewrite tech_pow_Rmult. apply Rle_pow; try lia. rewrite Rplus_comm. apply Rcomplements.Rle_minus_l. - field_simplify; auto with commonDB. + field_simplify; auto with commonDB. Qed. Hint Resolve le_g_Sn : commonDB. @@ -236,20 +236,20 @@ Proof. unfold g. induction n; simpl; field_simplify; try nra. eapply Rle_trans; [apply IHn|]. apply Rplus_le_compat_r. replace (D * (1 + D ) ^ (n + 1) + (1 + D ) ^ (n + 1)) -with +with ((1 + D ) ^ (n + 1) * (D + 1)) by nra. eapply Rle_trans with ((1 + D ) ^ (n + 1) * 1); try nra. eapply Rmult_le_compat; try nra. { apply pow_le. apply Fourier_util.Rle_zero_pos_plus1 ; auto with commonDB. } -apply Rcomplements.Rle_minus_l. field_simplify; auto with commonDB. +apply Rcomplements.Rle_minus_l. field_simplify; auto with commonDB. Qed. Hint Resolve d_le_g : commonDB. Lemma d_le_g_1 n: (1<= n)%nat -> D <= g n. -Proof. -intros; unfold g. +Proof. +intros; unfold g. eapply Rle_trans with ((1 + D )^1 - 1). field_simplify; nra. apply Rplus_le_compat; try nra. @@ -259,15 +259,15 @@ Hint Resolve d_le_g_1 : commonDB. Lemma one_plus_d_mul_g a n: (1 + D ) * g n * a + D * a = g (n + 1) * a. -Proof. unfold g. rewrite Rmult_minus_distr_l. rewrite tech_pow_Rmult. +Proof. unfold g. rewrite Rmult_minus_distr_l. rewrite tech_pow_Rmult. field_simplify. f_equal. rewrite Rmult_comm; repeat f_equal; lia. Qed. Hint Resolve one_plus_d_mul_g : commonDB. -Definition g1 (n1: nat) (n2: nat) : R := +Definition g1 (n1: nat) (n2: nat) : R := INR n1 * E* (1 + g n2 ). -Lemma g1_pos n m : 0 <= g1 n m. +Lemma g1_pos n m : 0 <= g1 n m. Proof. unfold g1. apply Rmult_le_pos; try apply pos_INR. apply Rmult_le_pos; try apply pos_INR. @@ -297,7 +297,7 @@ g1 n m * (1 + D) = g1 n (S m). Proof. intros. unfold g1, g; field_simplify. -symmetry. +symmetry. rewrite <- tech_pow_Rmult. field_simplify; nra. Qed. @@ -326,7 +326,7 @@ Proof. intros; replace (S n) with (n + 1)%nat by lia. rewrite /g1; field_simplify. replace (INR (n + 1)) with (INR n + 1). -rewrite !Rmult_plus_distr_l !Rmult_1_r +rewrite !Rmult_plus_distr_l !Rmult_1_r -Rplus_assoc -!Rmult_plus_distr_l Rmult_comm. apply: Rplus_le_compat_r. rewrite Rplus_comm -Rplus_assoc. @@ -334,12 +334,12 @@ apply: Rplus_le_compat; try nra. rewrite Rplus_comm. apply: Rplus_le_compat; try nra. apply: Rmult_le_compat_l; auto with commonDB. -field_simplify. +field_simplify. apply: Rminus_plus_le_minus. rewrite Rplus_comm. suff H1: (1 + D)^1 <= (1 + D) ^ m; try nra. apply: Rle_pow; auto with commonDB. -rewrite Nat.add_comm. +rewrite Nat.add_comm. rewrite S_O_plus_INR; simpl; nra. Qed. Hint Resolve plus_d_e_g1_le' : commonDB. @@ -352,7 +352,7 @@ Proof. intros; replace (S n) with (n + 1)%nat by lia. replace (S m) with (m + 1)%nat by lia. unfold g1, g; field_simplify. -replace (INR (n + 1)) with (INR n + 1) by +replace (INR (n + 1)) with (INR n + 1) by (rewrite Nat.add_comm; rewrite S_O_plus_INR; simpl; nra). replace (INR (m + 1)) with (INR m + 1) by (rewrite Nat.add_comm; rewrite S_O_plus_INR; simpl; nra). @@ -363,8 +363,8 @@ INR n * E * (1 + D) ^ m) with rewrite !Rmult_plus_distr_r. apply: Rplus_le_compat. rewrite !Rmult_assoc Rmult_comm !Rmult_assoc. -apply: Rmult_le_compat_l; try nra. -apply: Rmult_le_compat_l; auto with commonDB. +apply: Rmult_le_compat_l; try nra. +apply: Rmult_le_compat_l; auto with commonDB. rewrite -Rmult_assoc Rmult_comm. apply: Rmult_le_compat_l; auto with commonDB. rewrite Rmult_comm tech_pow_Rmult. @@ -378,7 +378,7 @@ Hint Resolve mult_d_e_g1_le' : commonDB. Lemma plus_d_e_g1_le n: (1 <= n )%nat -> g1 n n + (1 + D) * E <= g1 (S n) n. -Proof. auto with commonDB. Qed. +Proof. auto with commonDB. Qed. Hint Resolve plus_d_e_g1_le : commonDB. Lemma plus_e_g1_le n: @@ -388,16 +388,16 @@ rewrite /g1. replace (S n) with (n + 1)%nat by lia. replace (INR (n + 1)) with (INR n + 1). rewrite Rmult_assoc Rmult_assoc. -apply: Rle_trans; +apply: Rle_trans; [ apply: Rle_refl| rewrite Rmult_plus_distr_r]. apply: Rplus_le_compat_l. -rewrite Rmult_plus_distr_l Rmult_1_l Rmult_1_r. +rewrite Rmult_plus_distr_l Rmult_1_l Rmult_1_r. suff : E + 0 * 0 <= E + E * g n; first by nra. -apply: Rplus_le_compat_l. +apply: Rplus_le_compat_l. apply: Rmult_le_compat; try nra; auto with commonDB. -rewrite Nat.add_comm. -rewrite S_O_plus_INR; simpl; nra. +rewrite Nat.add_comm. +rewrite S_O_plus_INR; simpl; nra. Qed. Hint Resolve plus_e_g1_le : commonDB. @@ -414,15 +414,15 @@ rewrite /g; field_simplify; apply pow_le; auto with commonDB. apply: Rmult_le_compat; try nra; auto with commonDB. apply: Rplus_le_compat_l; auto with commonDB. -rewrite Nat.add_comm. -rewrite S_O_plus_INR; simpl; nra. +rewrite Nat.add_comm. +rewrite S_O_plus_INR; simpl; nra. Qed. Hint Resolve g1n_le_g1Sn : commonDB. Lemma g1n_le_g1Sn' n: g1 n n <= g1 (S n) (S n). Proof. -rewrite /g1. +rewrite /g1. replace (S n) with (n + 1)%nat by lia. replace (INR (n + 1)) with (INR n + 1). apply: Rmult_le_compat. @@ -431,7 +431,7 @@ rewrite /g; field_simplify; apply pow_le; auto with commonDB. apply: Rmult_le_compat; try nra; auto with commonDB. apply: Rplus_le_compat_l; auto with commonDB. -rewrite Nat.add_comm; auto with commonDB. +rewrite Nat.add_comm; auto with commonDB. rewrite plus_INR; simpl; nra. Qed. Hint Resolve g1n_le_g1Sn' : commonDB. @@ -455,18 +455,18 @@ apply: Rmult_le_pos; auto with commonDB. rewrite /g; field_simplify; apply pow_le; auto with commonDB. apply: Rmult_le_lt_compat; try nra; auto with commonDB. -suff : INR n < INR n + 1 ; simpl; try nra. +suff : INR n < INR n + 1 ; simpl; try nra. move => H. -rewrite Nat.add_comm. -rewrite S_O_plus_INR; simpl; nra. -rewrite /g; field_simplify. +rewrite Nat.add_comm. +rewrite S_O_plus_INR; simpl; nra. +rewrite /g; field_simplify. apply: Rlt_pow; auto with commonDB. suff : 0 < D; try nra; auto with commonDB. Qed. End ErrorRels. -Global Hint Resolve +Global Hint Resolve g_pos le_g_Sn d_le_g diff --git a/accuracy_proofs/dot_acc.v b/accuracy_proofs/dot_acc.v index 98f11ae..3f03a66 100644 --- a/accuracy_proofs/dot_acc.v +++ b/accuracy_proofs/dot_acc.v @@ -1,5 +1,5 @@ (** This file contains three main theorems for the accuracy of the non-fma - dot product : dotprod_mixed_error, dotprod_forward_error, + dot product : dotprod_mixed_error, dotprod_forward_error, and sparse_dotprod_forward_error. *) Require Import vcfloat.VCFloat. @@ -11,7 +11,7 @@ From LAProof.accuracy_proofs Require Import dotprod_model dot_acc_lemmas. Require Import Reals. Open Scope R. -Section MixedError. +Section MixedError. Context {NAN: Nans} {t : type}. Notation g := (@g t). @@ -37,22 +37,22 @@ assert (Datatypes.length (combine v1 v2) = length v1) by assert (Hlenr : length (rev v1) = length (rev v2)) by (rewrite !rev_length; auto). rewrite <- rev_length in Hlen. pose proof dotprodF_rel_fold_right v1 v2 as H1. -rewrite <- combine_rev in H1. +rewrite <- combine_rev in H1. rewrite rev_length in Hlen. -pose proof (dotprod_mixed_error_rel (rev v1) (rev v2) Hlenr (dotprodF v1 v2) H1 Hfin) as +pose proof (dotprod_mixed_error_rel (rev v1) (rev v2) Hlenr (dotprodF v1 v2) H1 Hfin) as (u & eta & H2 & H3 & H4 & H5). exists (rev u), eta; repeat split; auto. rewrite rev_length in H2; rewrite <- rev_length in H2; auto. -pose proof dotprodR_rel u (map FT2R (rev v2)). +pose proof dotprodR_rel u (map FT2R (rev v2)). assert (dotprodR (rev u) (map FT2R v2) = FT2R (dotprodF v1 v2) - eta). eapply R_dot_prod_rel_eq; eauto. rewrite <- dotprodR_rev, <- map_rev; auto. -rewrite rev_length in H2; rewrite map_length; auto. nra. -rewrite !rev_length in H4. -intros. +rewrite rev_length in H2; rewrite map_length; auto. nra. +rewrite !rev_length in H4. +intros. assert ((length u - S n < length v2)%nat). -{ rewrite rev_length in H2. -rewrite H2. +{ rewrite rev_length in H2. +rewrite H2. apply Nat.sub_lt; try lia. } specialize (H4 (length u - S n)%nat H6). @@ -61,14 +61,14 @@ rewrite rev_nth. destruct H4 as (delta & Hn & HD). exists delta; split. rewrite Hn; repeat f_equal. -rewrite rev_length in H2. +rewrite rev_length in H2. rewrite Hlen. -rewrite H2. +rewrite H2. rewrite <- Nat.sub_succ_l. simpl. lia. apply Arith_prebase.lt_le_S_stt; auto. apply HD. -rewrite rev_length in H2. +rewrite rev_length in H2. rewrite H2; auto. rewrite Hlen; auto. rewrite !rev_length in H5; auto. @@ -77,7 +77,7 @@ Qed. End MixedError. -Section ForwardError. +Section ForwardError. Context {NAN: Nans} {t : type}. Variables v1 v2 : list (ftype t). @@ -94,15 +94,15 @@ Hypothesis Hlen: length v1 = length v2. Hypothesis Hfin: Binary.is_finite (fprec t) (femax t) (dotprodF v1 v2) = true. Lemma dotprod_forward_error: - Rabs (FT2R (dotprodF v1 v2) - dotprodR v1R v2R ) + Rabs (FT2R (dotprodF v1 v2) - dotprodR v1R v2R ) <= g n * dotprodR v1R' v2R' + g1 n (n - 1). Proof. -intros. +intros. pose proof R_dot_prod_rel_fold_right' t v1 v2 as HB. pose proof R_dot_prod_rel_fold_right_Rabs' t v1 v2 as HC. simpl in HB, HC. rewrite <- map_rev in HC, HB. rewrite <- map_rev in HC. -pose proof dotprod_forward_error_rel (rev (combine v1 v2)) +pose proof dotprod_forward_error_rel (rev (combine v1 v2)) (dotprodF v1 v2) (dotprodF_rel_fold_right _ _ ) Hfin (dotprodR v1R v2R) (dotprodR v1R' v2R') HB HC. rewrite rev_length, combine_length, Hlen, Nat.min_id in H; @@ -112,10 +112,10 @@ Qed. Notation nnzR := (common.nnzR v1R). Lemma sparse_dotprod_forward_error: - Rabs (FT2R (dotprodF v1 v2) - dotprodR v1R v2R ) <= + Rabs (FT2R (dotprodF v1 v2) - dotprodR v1R v2R ) <= g nnzR * dotprodR v1R' v2R' + g1 nnzR (nnzR - 1). -Proof. -intros. +Proof. +intros. pose proof dotprodF_rel_fold_right v1 v2 as HA. pose proof R_dot_prod_rel_fold_right' t v1 v2 as HB. pose proof R_dot_prod_rel_fold_right_Rabs' t v1 v2 as HC. @@ -124,10 +124,10 @@ pose proof R_dot_prod_rel_fold_right_Rabs' t v1 v2 as HC. pose proof @sparse_dotprod_forward_error_rel NAN t (rev v1) (rev v2). rewrite !rev_length, combine_rev in H; auto. specialize (H Hlen (dotprodF v1 v2) HA Hfin (dotprodR v1R v2R) - (dotprodR v1R' v2R') HB HC). + (dotprodR v1R' v2R') HB HC). rewrite map_rev in H. unfold common.nnzR, nnz in H. -rewrite count_occ_rev, rev_length in H. +rewrite count_occ_rev, rev_length in H. unfold common.nnzR, nnz; auto. Qed. diff --git a/accuracy_proofs/dot_acc_lemmas.v b/accuracy_proofs/dot_acc_lemmas.v index ccc9b8f..eb47d31 100644 --- a/accuracy_proofs/dot_acc_lemmas.v +++ b/accuracy_proofs/dot_acc_lemmas.v @@ -1,7 +1,7 @@ (* This file contatins lemmas for the accuracy of the fma and non-fma dot products. These lemmas are used to prove the main accuracy theorems in dot_acc.v and fma_dot_acc.v. The theorems use the inductive definitions R_dot_prod_rel and dot_prod_rel, - which are a bit easier (for me) to work with at a low level then dotprodF and dotprodR. *) + which are a bit easier (for me) to work with at a low level then dotprodF and dotprodR. *) Require Import vcfloat.VCFloat. Require Import List. @@ -12,7 +12,7 @@ Require Import Reals. Open Scope R. Section ForwardErrorRel1. -(* forward error bound for non-fma dot product using inductive rels *) +(* forward error bound for non-fma dot product using inductive rels *) Context {NAN: Nans} {t : type}. Variables (vF : list (ftype t * ftype t)). @@ -92,7 +92,7 @@ inversion Hrp; inversion Hra; subst. specialize (IHl s s0 s1 H3 H7 H11 B). destruct (BPLUS_accurate' (BMULT (fst a) (snd a)) s Hfin) as (d' & Hd'& Hplus); rewrite Hplus; clear Hplus. -destruct (BMULT_accurate' (fst a) (snd a) A) as (d & e & Hed & Hd& He& Hmul); +destruct (BMULT_accurate' (fst a) (snd a) A) as (d & e & Hed & Hd& He& Hmul); rewrite Hmul; clear Hmul. (* algebra *) apply length_not_empty_nat in H. @@ -123,7 +123,7 @@ apply (dot_prod_sum_rel_R_Rabs (map FR2 l)); auto. } apply Hs. } field_simplify. fold D E n. -rewrite !Rplus_assoc. +rewrite !Rplus_assoc. replace (Rabs (F * d * d' + (F * d + F * d')) + (D * g n * s1 + (D * s1 + @@ -159,24 +159,24 @@ apply Req_le; rewrite one_plus_d_mul_g. rewrite Rmult_comm. repeat f_equal; try lia. rewrite <- Rplus_assoc. -eapply Rle_trans; [apply Rplus_le_compat_l; +eapply Rle_trans; [apply Rplus_le_compat_l; apply Rmult_le_compat_r; [ unfold E; apply default_abs_ge_0| eapply Rle_trans] | ]. -apply Rabs_triang. rewrite Rabs_R1. +apply Rabs_triang. rewrite Rabs_R1. apply Rplus_le_compat_l; apply Hd'. rewrite !Rmult_plus_distr_r. rewrite Rmult_1_l. rewrite <- !Rplus_assoc. replace (D * g1 n (n - 1) + g1 n (n - 1)) with (g1 n (n-1) * (1+D)) by nra; rewrite one_plus_d_mul_g1; auto. rewrite Rplus_assoc. -replace (E + D * E) with +replace (E + D * E) with ((1+D) * E) by nra. eapply Rle_trans; [apply plus_d_e_g1_le; auto| apply Req_le; f_equal;lia]. Qed. -End ForwardErrorRel1. +End ForwardErrorRel1. Section ForwardErrorRel2. -(* forward error bound for fma dot product using inductive rels *) +(* forward error bound for fma dot product using inductive rels *) Context {NAN: Nans} {t : type}. Variable (vF : list (ftype t * ftype t)). @@ -279,9 +279,9 @@ apply Hd'. apply Rabs_le_minus in IHl. assert (Hs: Rabs (FT2R s) <= g (length l) * s1 + g1 (length l) (length l - 1) + s1). -{ eapply Rle_trans. apply IHl. +{ eapply Rle_trans. apply IHl. apply Rplus_le_compat_l. -rewrite <- (R_dot_prod_rel_Rabs_eq (map FR2 l) s1); auto. +rewrite <- (R_dot_prod_rel_Rabs_eq (map FR2 l) s1); auto. apply (dot_prod_sum_rel_R_Rabs (map FR2 l)); auto. } apply Hs. fold n. @@ -307,8 +307,8 @@ Qed. End ForwardErrorRel2. -Section MixedErrorRel1. -(* mixed error bound for non-fma dot product using inductive rels *) +Section MixedErrorRel1. +(* mixed error bound for non-fma dot product using inductive rels *) Context {NAN: Nans} {t : type}. Notation g := (@g t). @@ -335,11 +335,11 @@ Lemma dotprod_mixed_error_rel: Proof. revert Hfp Hfin Hlen. revert fp v1. induction v2. -{ simpl; intros. replace v1 with (@nil (ftype t)) in * by (symmetry; apply length_zero_iff_nil; auto). - exists [], 0; repeat split; +{ simpl; intros. replace v1 with (@nil (ftype t)) in * by (symmetry; apply length_zero_iff_nil; auto). + exists [], 0; repeat split; [inversion Hfp; subst; rewrite Rminus_0_r; simpl; auto; - apply R_dot_prod_rel_nil | | rewrite Rabs_R0; unfold g1, g; simpl; nra ]. - intros; exists 0; split; + apply R_dot_prod_rel_nil | | rewrite Rabs_R0; unfold g1, g; simpl; nra ]. + intros; exists 0; split; [ assert (n = 0)%nat by lia; subst; simpl; nra | rewrite Rabs_R0; unfold g; nra]. } intros. @@ -350,11 +350,11 @@ intros. eapply hd_error_some_nil; simpl; auto. assert (Hlen1: length l0 = length l) by (simpl in Hlen; auto). destruct Hv1. - assert (l0 = []). { simpl in Hlen; apply length_zero_iff_nil; + assert (l0 = []). { simpl in Hlen; apply length_zero_iff_nil; apply length_zero_iff_nil in H; rewrite H in Hlen1; auto. } subst; clear Hlen1. { (* case singleton lists *) -clear IHl. inversion Hfp; subst. +clear IHl. inversion Hfp; subst. inversion H2; subst; clear H2. simpl in Hfp, Hfin; unfold fst, snd. assert (FINmul: Binary.is_finite (fprec t) (femax t) (BMULT f a) = true). @@ -366,13 +366,13 @@ exists [FT2R f * (1 +d)], e; repeat split. { simpl. rewrite Hacc. replace (FT2R f * FT2R a * (1 + d) + e - e) with (FT2R f * (1 + d) * FT2R a + 0) by (simpl; nra). apply R_dot_prod_rel_cons; apply R_dot_prod_rel_nil. } -{ intros; exists d; split; auto. simpl in H. - destruct n. { simpl; auto. } +{ intros; exists d; split; auto. simpl in H. + destruct n. { simpl; auto. } apply le_S_n in H; apply Nat.le_0_r in H; rewrite H; simpl; nra. eapply Rle_trans; [apply Hd| apply d_le_g_1; simpl; auto]. } eapply Rle_trans; [apply He|]. apply e_le_g1; simpl in *; auto. -} +} (* case cons lists*) (* apply IH *) pose proof (length_not_empty l H) as Hlen3. @@ -383,12 +383,12 @@ destruct (BMULT_finite_e _ _ A) as (C & _). (* IHl *) specialize (IHl s l0 H3 B Hlen1). (* construct u *) -destruct (BPLUS_accurate' (BMULT f a) s Hfin) as (d' & Hd'& Hplus); +destruct (BPLUS_accurate' (BMULT f a) s Hfin) as (d' & Hd'& Hplus); rewrite Hplus; clear Hplus. -destruct (BMULT_accurate' f a A) as (d & e & Hed & Hd& He& Hmul); +destruct (BMULT_accurate' f a A) as (d & e & Hed & Hd& He& Hmul); rewrite Hmul; clear Hmul. destruct IHl as (u & eta & Hlenu & Hurel & Hun & Heta). -exists (FT2R f * (1+d) * (1 + d') :: map (Rmult (1+d')) u), +exists (FT2R f * (1+d) * (1 + d') :: map (Rmult (1+d')) u), (e * (1 + d') + eta * (1 + d')). repeat split. { simpl. rewrite map_length; auto. } @@ -402,14 +402,14 @@ with apply R_dot_prod_rel_cons; rewrite Rmult_comm; auto. } { intros. destruct n. simpl. { simpl. exists ((1 + d) * (1 + d') -1); split. - { field_simplify; nra. } + { field_simplify; nra. } { field_simplify_Rabs. eapply Rle_trans; [apply Rabs_triang|]. eapply Rle_trans; [apply Rplus_le_compat; [apply Rabs_triang | apply Hd' ] |]. eapply Rle_trans; [apply Rplus_le_compat_r; apply Rplus_le_compat; [|apply Hd] | ]. - rewrite Rabs_mult. apply Rmult_le_compat; + rewrite Rabs_mult. apply Rmult_le_compat; [apply Rabs_pos | apply Rabs_pos | apply Hd | apply Hd']. eapply Rle_trans with ((1 + D) * (1 + D) - 1); try nra. - unfold g. apply Rplus_le_compat; try nra. + unfold g. apply Rplus_le_compat; try nra. rewrite <- tech_pow_Rmult; apply Rmult_le_compat; try nra; try (eapply Rle_trans with 1; try nra; apply (default_rel_plus_1_ge_1)). eapply Rle_trans with ((1 + D) ^ 1); try nra. @@ -483,11 +483,11 @@ Lemma fma_dotprod_mixed_error_rel: Proof. revert Hfp Hfin Hlen. revert fp v1. induction v2. -{ simpl; intros. replace v1 with (@nil (ftype t)) in * by (symmetry; apply length_zero_iff_nil; auto). - exists [], 0; repeat split; +{ simpl; intros. replace v1 with (@nil (ftype t)) in * by (symmetry; apply length_zero_iff_nil; auto). + exists [], 0; repeat split; [inversion Hfp; subst; rewrite Rminus_0_r; simpl; auto; - apply R_dot_prod_rel_nil | | rewrite Rabs_R0; unfold g1, g; simpl; nra ]. - intros; exists 0; split; + apply R_dot_prod_rel_nil | | rewrite Rabs_R0; unfold g1, g; simpl; nra ]. + intros; exists 0; split; [ assert (n = 0)%nat by lia; subst; simpl; nra | rewrite Rabs_R0; unfold g; nra]. } intros. @@ -498,11 +498,11 @@ intros. eapply hd_error_some_nil; simpl; auto. assert (Hlen1: length l0 = length l) by (simpl in Hlen; auto). destruct Hv1. - assert (l0 = []). { simpl in Hlen; apply length_zero_iff_nil; + assert (l0 = []). { simpl in Hlen; apply length_zero_iff_nil; apply length_zero_iff_nil in H; rewrite H in Hlen1; auto. } subst; clear Hlen1. { -inversion Hfp; subst. +inversion Hfp; subst. inversion H2; subst; clear H2. simpl in Hfp, Hfin. pose proof fma_accurate' f a (Zconst t 0) Hfin as Hacc. @@ -511,15 +511,15 @@ exists [FT2R f * (1 +d)], e; repeat split. { simpl. rewrite Hacc. replace ((FT2R f * FT2R a + FT2R (Zconst t 0)) * (1 + d) + e - e) with (FT2R f * (1 + d) * FT2R a + 0) by (simpl; nra). apply R_dot_prod_rel_cons; apply R_dot_prod_rel_nil. } -{ intros; exists d; split; auto. simpl in H. - destruct n. { simpl; auto. } +{ intros; exists d; split; auto. simpl in H. + destruct n. { simpl; auto. } apply le_S_n in H; apply Nat.le_0_r in H; rewrite H; simpl; nra. eapply Rle_trans; [apply Hd| apply d_le_g_1; simpl; auto]. } eapply Rle_trans; [apply He|]. unfold g1, g; simpl; nra. } (* apply IH *) -pose proof (length_not_empty l H) as Hlen3. +pose proof (length_not_empty l H) as Hlen3. inversion Hfp; subst. (destruct (BMFA_finite_e _ _ _ Hfin) as (A' & B' & C')). specialize (IHl s l0). @@ -527,13 +527,13 @@ destruct IHl as (u & eta & Hlenu & A & B & C ); auto. (* construct u0 *) simpl in Hfin. pose proof fma_accurate' f a s Hfin as Hacc; -destruct Hacc as (d & e & Hz & Hd & He & Hacc). +destruct Hacc as (d & e & Hz & Hd & He & Hacc). unfold fst, snd; rewrite Hacc. exists (FT2R f * (1+d) :: map (Rmult (1+d)) u), (e + eta * (1 + d)). repeat split. { simpl. rewrite map_length; auto. } { pose proof dot_prod_combine_map_Rmult (1+d) u (map FT2R l) (FT2R s - eta). -rewrite map_length in H0. +rewrite map_length in H0. rewrite Hlen1 in Hlenu. specialize (H0 Hlenu A); simpl. replace ((FT2R f * FT2R a + FT2R s) * (1 + d) + e - (e + eta * (1 + d))) with @@ -580,7 +580,7 @@ apply Req_le; auto. apply le_INR; lia. apply Req_le; f_equal; auto; lia. set (n:= length l). -replace (INR (S n)) with (INR n + 1)%R. +replace (INR (S n)) with (INR n + 1)%R. apply Req_le; nra. apply transitivity with (INR (n + 1)). rewrite plus_INR; simpl; auto. f_equal; simpl; lia. @@ -589,8 +589,8 @@ Qed. End MixedErrorRel2. -Section SparseErrorRel1. -(* sparse forward error bound for non-fma dot product using inductive rels *) +Section SparseErrorRel1. +(* sparse forward error bound for non-fma dot product using inductive rels *) Context {NAN: Nans} {t : type}. Variables (v1 v2 : list (ftype t)). @@ -617,9 +617,9 @@ revert Hlen Hfp Hfin Hrp Hra. revert rp rp_abs fp v2. unfold nnz. induction v1; intros. -{ simpl in Hlen; symmetry in Hlen; apply length_zero_iff_nil in Hlen; subst. -inversion Hfp; inversion Hrp; subst; simpl; field_simplify_Rabs. - rewrite Rabs_R0. +{ simpl in Hlen; symmetry in Hlen; apply length_zero_iff_nil in Hlen; subst. +inversion Hfp; inversion Hrp; subst; simpl; field_simplify_Rabs. + rewrite Rabs_R0. apply Rplus_le_le_0_compat; auto with commonDB. apply Rmult_le_pos; auto with commonDB. rewrite <- (R_dot_prod_rel_Rabs_eq [] rp_abs); auto; @@ -627,27 +627,27 @@ inversion Hfp; inversion Hrp; subst; simpl; field_simplify_Rabs. destruct v2; try discriminate. assert (Hlen1 : length l = length l0) by (simpl; auto). set (n2:= (common.nnzR (map FT2R l))%nat) in *. -inversion Hrp. inversion Hfp. inversion Hra; subst. +inversion Hrp. inversion Hfp. inversion Hra; subst. assert (HFIN: Binary.is_finite (fprec t) (femax t) s0 = true). { simpl in Hfin. destruct (BMULT a f); destruct s0; try discriminate; simpl in *; auto; destruct s0; destruct s2; try discriminate; auto. } assert (HFIN2: Binary.is_finite (fprec t) (femax t) (BMULT a f) = true). { simpl in Hfin. destruct (BMULT a f); destruct s0; - try discriminate; simpl in *; auto. } simpl. + try discriminate; simpl in *; auto. } simpl. specialize (IHl s s1 s0 l0 Hlen1 H6 HFIN H2 H10). -(* reason by cases on the head of the list *) -destruct (Req_EM_T (FT2R a) 0%R). +(* reason by cases on the head of the list *) +destruct (Req_EM_T (FT2R a) 0%R). (* start head of list is zero *) { rewrite e. unfold common.nnzR; rewrite nnz_cons. replace (FT2R (BPLUS (BMULT a f) s0)) with (FT2R s0). -field_simplify_Rabs. -eapply Rle_trans; [apply IHl|]. -apply Req_le; f_equal; try nra. unfold n2, common.nnzR. +field_simplify_Rabs. +eapply Rle_trans; [apply IHl|]. +apply Req_le; f_equal; try nra. unfold n2, common.nnzR. rewrite Rabs_R0, Rmult_0_l, Rplus_0_l; nra. pose proof Bmult_0R a f HFIN2 as H; destruct H; auto; rewrite H; try rewrite Bplus_neg_zero; try rewrite Bplus_neg_zero; auto; -repeat (destruct s0; simpl; auto). } (* end head of list is zero *) +repeat (destruct s0; simpl; auto). } (* end head of list is zero *) (* start head of list is non-zero *) unfold common.nnzR, nnz. rewrite !count_occ_cons_neq; auto. set (l1:= (map FT2R l)) in *. @@ -657,7 +657,7 @@ assert (n1 = S n2). unfold common.nnzR, nnz. destruct (count_occ Req_EM_T l1 0%R); unfold l1 in *; simpl; try lia. } (* start case on nnz = case on nnz in tail *) -assert (H0: (n2 = 0)%nat \/ (1<=n2)%nat) by lia; destruct H0. +assert (H0: (n2 = 0)%nat \/ (1<=n2)%nat) by lia; destruct H0. (* tail all zeros *) { rewrite H0 in *. rewrite H. pose proof R_dot_prod_rel_nnzR l l0 Hlen1 s H2 H0; subst. @@ -668,8 +668,8 @@ destruct (@BMULT_accurate' t NAN a f HFIN2) as (d' & e' & Hed' & Hd' & He' & Hacc). rewrite Hacc; clear Hacc. unfold g1, g. -simpl; field_simplify; -field_simplify_Rabs. +simpl; field_simplify; +field_simplify_Rabs. eapply Rle_trans; [apply Rabs_triang | ]. apply Rplus_le_compat. rewrite Rabs_mult. @@ -685,7 +685,7 @@ destruct (@BPLUS_accurate' t NAN (BMULT a f) s0 Hfin) rewrite Hacc; clear Hacc. destruct (@BMULT_accurate' t NAN a f HFIN2) as (d & e & Hed & Hd & He & Hacc). -rewrite Hacc; clear Hacc. +rewrite Hacc; clear Hacc. set (F:= FT2R a * FT2R f ). field_simplify_Rabs. replace (F * d * d' + F * d + F * d' + e * d' + e + FT2R s0 * d' + FT2R s0 - s) with @@ -702,21 +702,21 @@ eapply Rle_trans; [ apply Rplus_le_compat_r ; eapply Rle_trans; [ apply Rabs_triang | ] | ]. apply Rplus_le_compat_l; rewrite Rabs_mult; rewrite Rmult_comm; apply Rmult_le_compat; [ apply Rabs_pos| apply Rabs_pos| apply Hd' | ]. -{ apply Rabs_le_minus in IHl. +{ apply Rabs_le_minus in IHl. assert (Hs: Rabs (FT2R s0) <= g n2 * s1 + g1 n2 (n2 - 1) + s1). - { eapply Rle_trans. apply IHl. + { eapply Rle_trans. apply IHl. apply Rplus_le_compat. apply Rplus_le_compat. apply Rmult_le_compat; auto with commonDB; try apply Rle_refl. rewrite <- (R_dot_prod_rel_Rabs_eq (map FR2 (combine l l0)) s1); auto; - apply Rabs_pos. + apply Rabs_pos. apply Rle_refl. rewrite <- (R_dot_prod_rel_Rabs_eq (map FR2 (combine l l0)) s1); auto; apply (dot_prod_sum_rel_R_Rabs (map FR2 (combine l l0))); auto. } apply Hs. } field_simplify. -unfold g1, g in IHl. +unfold g1, g in IHl. field_simplify in IHl. set (D:= default_rel). set (E:= default_abs). @@ -725,7 +725,7 @@ rewrite H. match goal with |-context[?A<= ?B] => replace A with (Rabs (F * d * d' + (F * d + F * d')) + ((1+ D) * g n2 * s1 + D * s1) + (D * g1 n2 (n2 - 1) + (g1 n2 (n2 -1) + Rabs (1 + d') * E))) by nra; -replace B with +replace B with (g (S n2) * Rabs F + s1 * g (S n2) + g1 (S n2) (S n2 - 1) ) by (rewrite Rmult_assoc, <-Rabs_mult; fold F; nra) end. @@ -749,7 +749,7 @@ rewrite <- tech_pow_Rmult. apply Rmult_le_compat_l; auto with commonDB. eapply Rle_trans with ((1 + D)^1); try nra. fold D; nra. -apply Rle_pow; auto with commonDB. +apply Rle_pow; auto with commonDB. apply Req_le. unfold D,E. rewrite one_plus_d_mul_g. rewrite Rmult_comm. repeat f_equal; try lia. @@ -768,8 +768,8 @@ Qed. End SparseErrorRel1. -Section SparseErrorRel2. -(* sparse forward error bound for fma dot product using inductive rels *) +Section SparseErrorRel2. +(* sparse forward error bound for fma dot product using inductive rels *) Context {NAN: Nans} {t : type}. Variables (v1 v2 : list (ftype t)). @@ -800,9 +800,9 @@ revert Hlen Hfp Hfin Hrp Hra. revert rp rp_abs fp v2. unfold nnz. induction v1; intros. -{ simpl in Hlen; symmetry in Hlen; apply length_zero_iff_nil in Hlen; subst. -inversion Hfp; inversion Hrp; subst; simpl; field_simplify_Rabs. - rewrite Rabs_R0. +{ simpl in Hlen; symmetry in Hlen; apply length_zero_iff_nil in Hlen; subst. +inversion Hfp; inversion Hrp; subst; simpl; field_simplify_Rabs. + rewrite Rabs_R0. apply Rplus_le_le_0_compat; auto with commonDB. apply Rmult_le_pos; auto with commonDB. rewrite <- (R_dot_prod_rel_Rabs_eq [] rp_abs); auto; @@ -810,25 +810,25 @@ inversion Hfp; inversion Hrp; subst; simpl; field_simplify_Rabs. destruct v2; try discriminate. assert (Hlen1 : length l = length l0) by (simpl; auto). set (n2:= (common.nnzR (map FT2R l))%nat) in *. -inversion Hrp. inversion Hfp. inversion Hra; subst. +inversion Hrp. inversion Hfp. inversion Hra; subst. assert (HFIN: Binary.is_finite (fprec t) (femax t) s0 = true). { simpl in Hfin. destruct a; destruct f; destruct s0; try discriminate; simpl in *; auto; destruct s0; destruct s2; destruct s3; try discriminate; auto. } -simpl. +simpl. specialize (IHl s s1 s0 l0 Hlen1 H6 HFIN H2 H10). -(* reason by cases on the head of the list *) -destruct (Req_EM_T (FT2R a) 0%R). +(* reason by cases on the head of the list *) +destruct (Req_EM_T (FT2R a) 0%R). (* start head of list is zero *) { rewrite e. unfold common.nnzR; rewrite nnz_cons. replace (FT2R (BFMA a f s0)) with (FT2R s0). -field_simplify_Rabs. -eapply Rle_trans; [apply IHl|]. -apply Req_le; f_equal; try nra. unfold n2, common.nnzR. +field_simplify_Rabs. +eapply Rle_trans; [apply IHl|]. +apply Req_le; f_equal; try nra. unfold n2, common.nnzR. rewrite Rabs_R0, Rmult_0_l, Rplus_0_l; nra. pose proof Bfma_mult_0R a f s0 Hfin as H; destruct H; auto; rewrite H; try rewrite Bplus_neg_zero; try rewrite Bplus_neg_zero; auto; -repeat (destruct s0; simpl; auto). } (* end head of list is zero *) +repeat (destruct s0; simpl; auto). } (* end head of list is zero *) (* start head of list is non-zero *) unfold common.nnzR, nnz. rewrite !count_occ_cons_neq; auto. set (l1:= (map FT2R l)) in *. @@ -838,18 +838,18 @@ assert (n1 = S n2). unfold common.nnzR, nnz. destruct (count_occ Req_EM_T l1 0%R); unfold l1 in *; simpl; try lia. } (* start case on nnz = case on nnz in tail *) -assert (H0: (n2 = 0)%nat \/ (1<=n2)%nat) by lia; destruct H0. +assert (H0: (n2 = 0)%nat \/ (1<=n2)%nat) by lia; destruct H0. (* tail all zeros *) { rewrite H0 in *. rewrite H. pose proof R_dot_prod_rel_nnzR l l0 Hlen1 s H2 H0; subst. pose proof fma_dot_prod_rel_nnzR l l0 Hlen1 s0 H6 HFIN H0. pose proof R_dot_prod_rel_nnzR_abs l l0 Hlen1 s1 H10 H0; subst. destruct (fma_accurate' a f s0 Hfin) as (e & d & ed & He & Hd & Hacc). -rewrite Hacc; clear Hacc. +rewrite Hacc; clear Hacc. rewrite H1. unfold g1, g. -simpl; field_simplify; -field_simplify_Rabs. +simpl; field_simplify; +field_simplify_Rabs. eapply Rle_trans; [apply Rabs_triang | ]. apply Rplus_le_compat. rewrite Rabs_mult. @@ -888,9 +888,9 @@ apply Hd'. apply Rabs_le_minus in IHl. assert (Hs: Rabs (FT2R s0) <= g n2 * s1 + g1 n2 (n2 - 1) + s1). -{ eapply Rle_trans. apply IHl. +{ eapply Rle_trans. apply IHl. apply Rplus_le_compat_l. -rewrite <- (R_dot_prod_rel_Rabs_eq (map FR2 (combine l l0)) s1); auto. +rewrite <- (R_dot_prod_rel_Rabs_eq (map FR2 (combine l l0)) s1); auto. apply (dot_prod_sum_rel_R_Rabs (map FR2 (combine l l0))); auto. } apply Hs. set (F:=Rabs (FT2R a * FT2R f)). diff --git a/accuracy_proofs/dotprod_model.v b/accuracy_proofs/dotprod_model.v index f336cc3..92ac74f 100644 --- a/accuracy_proofs/dotprod_model.v +++ b/accuracy_proofs/dotprod_model.v @@ -12,7 +12,7 @@ Section DotProdGeneric. Definition dotprod {A} (mult plus: A -> A -> A) (zero : A) (v1 v2: list A):A := - fold_left (fun s x12 => plus (mult (fst x12) (snd x12)) s) + fold_left (fun s x12 => plus (mult (fst x12) (snd x12)) s) (combine v1 v2) zero. Lemma dotprod_nil_l : @@ -26,11 +26,11 @@ Lemma dotprod_nil_r : Proof. intros; induction l; simpl; auto. Qed. Lemma dotprod_single : - forall A (l : list A) - (mult plus : A -> A -> A) (zero a2: A) + forall A (l : list A) + (mult plus : A -> A -> A) (zero a2: A) (Hpz : forall y, plus y zero = y) - (Hmz : forall y, mult zero y = zero), -let a1 := nth 0 l zero in + (Hmz : forall y, mult zero y = zero), +let a1 := nth 0 l zero in dotprod mult plus zero l [a2] = mult a1 a2. Proof. intros; simpl; destruct l. rewrite dotprod_nil_l. subst a1. simpl; auto. @@ -42,10 +42,10 @@ End DotProdGeneric. Section DotProdFloat. Context {NAN : Nans} {t : type}. -Definition dotprodF : list (ftype t) -> list (ftype t) -> ftype t := +Definition dotprodF : list (ftype t) -> list (ftype t) -> ftype t := dotprod BMULT BPLUS (Zconst t 0). -Inductive dot_prod_rel : +Inductive dot_prod_rel : list (ftype t * ftype t) -> ftype t -> Prop := | dot_prod_rel_nil : dot_prod_rel nil (Zconst t 0) | dot_prod_rel_cons : forall l (xy : ftype t * ftype t) s, @@ -53,10 +53,10 @@ Inductive dot_prod_rel : dot_prod_rel (xy::l) (BPLUS (BMULT (fst xy) (snd xy)) s). Lemma dotprodF_rel_fold_right : -forall (v1 v2: list (ftype t)), +forall (v1 v2: list (ftype t)), dot_prod_rel (rev (List.combine v1 v2)) (dotprodF v1 v2). Proof. -intros v1 v2. unfold dotprodF, dotprod; rewrite <- fold_left_rev_right. +intros v1 v2. unfold dotprodF, dotprod; rewrite <- fold_left_rev_right. induction (rev (List.combine v1 v2)). { simpl; auto. apply dot_prod_rel_nil. } simpl. apply dot_prod_rel_cons. auto. @@ -69,10 +69,10 @@ Context {NAN : Nans} {t : type}. (* FMA dot-product *) Definition fma_dotprod (v1 v2: list (ftype t)) : ftype t := - fold_left (fun s x12 => BFMA (fst x12) (snd x12) s) + fold_left (fun s x12 => BFMA (fst x12) (snd x12) s) (List.combine v1 v2) (Zconst t 0). -Inductive fma_dot_prod_rel : +Inductive fma_dot_prod_rel : list (ftype t * ftype t) -> ftype t -> Prop := | fma_dot_prod_rel_nil : fma_dot_prod_rel nil (Zconst t 0) | fma_dot_prod_rel_cons : forall l (xy : ftype t * ftype t) s, @@ -81,11 +81,11 @@ Inductive fma_dot_prod_rel : Lemma fma_dot_prod_rel_fold_right : -forall (v1 v2: list (ftype t)), +forall (v1 v2: list (ftype t)), fma_dot_prod_rel (rev (List.combine v1 v2)) (fma_dotprod v1 v2). Proof. -intros v1 v2. - unfold fma_dotprod; rewrite <- fold_left_rev_right. +intros v1 v2. + unfold fma_dotprod; rewrite <- fold_left_rev_right. induction (rev (List.combine v1 v2)). { simpl; auto. apply fma_dot_prod_rel_nil. } simpl. apply fma_dot_prod_rel_cons. auto. @@ -95,10 +95,10 @@ End DotProdFMA. Section RealDotProd. -Definition dotprodR l1 l2 : R := +Definition dotprodR l1 l2 : R := fold_left Rplus (map (uncurry Rmult) (List.combine l1 l2)) 0%R. -Inductive R_dot_prod_rel : +Inductive R_dot_prod_rel : list (R * R) -> R -> Prop := | R_dot_prod_rel_nil : R_dot_prod_rel nil 0%R | R_dot_prod_rel_cons : forall l xy s, @@ -106,13 +106,13 @@ Inductive R_dot_prod_rel : R_dot_prod_rel (xy::l) (fst xy * snd xy + s). Lemma R_dot_prod_rel_eq : - forall l a b + forall l a b (Ha: R_dot_prod_rel l a) (Hb: R_dot_prod_rel l b), a = b. Proof. induction l. { intros; inversion Ha; inversion Hb; auto. } -intros; inversion Ha; inversion Hb; subst; f_equal. +intros; inversion Ha; inversion Hb; subst; f_equal. apply IHl; auto. Qed. @@ -120,27 +120,27 @@ Definition Rabsp p : R * R := (Rabs (fst p), Rabs (snd p)). Definition FR2 {t: type} (x12: ftype t * ftype t) := (FT2R (fst x12), FT2R (snd x12)). -Lemma FT2R_FR2 t : +Lemma FT2R_FR2 t : (forall a a0 : ftype t, (FT2R a, FT2R a0) = FR2 (a, a0)) . Proof. intros. unfold FR2; simpl; auto. Qed. Definition sum_fold: list R -> R := fold_right Rplus 0%R. Lemma dotprodR_nil_l u: -dotprodR nil u = 0%R. +dotprodR nil u = 0%R. Proof. simpl; auto. Qed. Lemma dotprodR_nil_r u: -dotprodR u nil = 0%R. -Proof. -unfold dotprodR, dotprod; rewrite combine_nil; simpl; auto. +dotprodR u nil = 0%R. +Proof. +unfold dotprodR, dotprod; rewrite combine_nil; simpl; auto. Qed. Lemma sum_rev l: sum_fold l = sum_fold (rev l). Proof. -unfold sum_fold. +unfold sum_fold. rewrite fold_left_rev_right. replace (fun x y : R => y + x) with Rplus by (do 2 (apply FunctionalExtensionality.functional_extensionality; intro); lra). @@ -155,20 +155,20 @@ Proof. (do 2 (apply functional_extensionality; intro); lra). Qed. Lemma dotprodR_rel : -forall (v1 v2: list R) , +forall (v1 v2: list R) , R_dot_prod_rel ((List.combine v1 v2)) (dotprodR v1 v2). Proof. intros; unfold dotprodR; induction (((combine v1 v2))). { simpl. apply R_dot_prod_rel_nil. } -destruct a; simpl. +destruct a; simpl. unfold dotprodR. simpl. rewrite fold_left_Rplus_Rplus. apply R_dot_prod_rel_cons; auto. Qed. -Lemma dotprodR_rev : forall (v1 v2: list R) , - length v1 = length v2 -> +Lemma dotprodR_rev : forall (v1 v2: list R) , + length v1 = length v2 -> dotprodR v1 (rev v2) = dotprodR (rev v1) v2. Proof. intros; unfold dotprodR. @@ -182,7 +182,7 @@ induction (combine (rev v1) v2). simpl; auto. match goal with |- context [?A = ?B] => set (y:= B) -end. +end. simpl. subst y. rewrite fold_left_Rplus_Rplus. rewrite IHl. @@ -193,7 +193,7 @@ rewrite rev_length; auto. Qed. Lemma R_dot_prod_rel_fold_right t : -forall (v1 v2: list (ftype t)) , +forall (v1 v2: list (ftype t)) , let prods := map (uncurry Rmult) (map FR2 (List.combine v1 v2)) in R_dot_prod_rel (rev (map FR2 (List.combine v1 v2))) (sum_fold prods). Proof. @@ -204,23 +204,23 @@ destruct a; simpl. apply R_dot_prod_rel_cons; auto. Qed. Lemma R_dot_prod_rel_fold_right' t : -forall (v1 v2: list (ftype t)) , +forall (v1 v2: list (ftype t)) , let prods := map (uncurry Rmult) (map FR2 (List.combine v1 v2)) in R_dot_prod_rel (rev (map FR2 (List.combine v1 v2))) (dotprodR (map FT2R v1) (map FT2R v2)). Proof. intros. subst prods. unfold dotprodR. rewrite <- !map_rev. -rewrite (combine_map _ _ _ FR2); auto. +rewrite (combine_map _ _ _ FR2); auto. rewrite <- (rev_involutive (combine v1 v2)) at 2. rewrite <- fold_left_rev_right. rewrite (rev_involutive (combine v1 v2)) . -rewrite <- !map_rev. +rewrite <- !map_rev. induction (map FR2 (rev (combine v1 v2))). { simpl. apply R_dot_prod_rel_nil. } destruct a; simpl. rewrite Rplus_comm. apply R_dot_prod_rel_cons; auto. Qed. Lemma R_dot_prod_rel_fold_right_Rabs t : -forall (v1 v2: list (ftype t)) , +forall (v1 v2: list (ftype t)) , let prods := map (uncurry Rmult) (map Rabsp (map FR2 (List.combine v1 v2))) in R_dot_prod_rel (rev (map Rabsp (map FR2 (List.combine v1 v2)))) (sum_fold prods). Proof. @@ -231,17 +231,17 @@ destruct a; simpl. apply R_dot_prod_rel_cons; auto. Qed. Lemma R_dot_prod_rel_fold_right_Rabs' t : -forall (v1 v2: list (ftype t)) , +forall (v1 v2: list (ftype t)) , let prods := map (uncurry Rmult) (map Rabsp (map FR2 (List.combine v1 v2))) in R_dot_prod_rel (rev (map Rabsp (map FR2 (List.combine v1 v2)))) (dotprodR (map Rabs (map FT2R v1)) (map Rabs (map FT2R v2))). Proof. intros. subst prods. unfold dotprodR. rewrite <- !map_rev. -rewrite (combine_map _ _ _ Rabsp); auto. -rewrite (combine_map _ _ _ FR2); auto. +rewrite (combine_map _ _ _ Rabsp); auto. +rewrite (combine_map _ _ _ FR2); auto. rewrite <- (rev_involutive (combine v1 v2)) at 2. rewrite <- fold_left_rev_right. rewrite (rev_involutive (combine v1 v2)) . -rewrite <- !map_rev. +rewrite <- !map_rev. induction (map Rabsp (map FR2 (rev (combine v1 v2)))). { simpl. apply R_dot_prod_rel_nil. } destruct a; simpl. rewrite Rplus_comm. apply R_dot_prod_rel_cons; auto. @@ -274,7 +274,7 @@ nra. } intros. inversion H; subst; clear H. unfold Rabsp. destruct a; simpl. -replace (Rabs(Rabs r * Rabs r0 + s0)) with +replace (Rabs(Rabs r * Rabs r0 + s0)) with (Rabs r * Rabs r0 + s0); try nra. symmetry. rewrite Rabs_pos_eq; try nra. @@ -299,7 +299,7 @@ inversion H0; subst; clear H0. unfold Rabsp; destruct a; simpl. eapply Rle_trans; [ apply Rabs_triang |]. -replace (Rabs (Rabs r * Rabs r0 + s0)) with +replace (Rabs (Rabs r * Rabs r0 + s0)) with (Rabs r * Rabs r0 + s0). eapply Rplus_le_compat; try nra. rewrite Rabs_mult; nra. @@ -315,16 +315,16 @@ Qed. Lemma dot_prod_combine_map_Rmult a u v r: length u = length v -> -R_dot_prod_rel (combine u v) r -> -R_dot_prod_rel (combine (map (Rmult a) u) v) (a * r). +R_dot_prod_rel (combine u v) r -> +R_dot_prod_rel (combine (map (Rmult a) u) v) (a * r). Proof. revert u r. induction v. -{ intros. rewrite !combine_nil in *. +{ intros. rewrite !combine_nil in *. inversion H0; subst; rewrite Rmult_0_r; apply R_dot_prod_rel_nil. } destruct u. { intros; pose proof Nat.neq_0_succ (length v); try contradiction. } intros. inversion H0. assert (Hlen: length u = length v) by (simpl in H; lia). specialize (IHv u s Hlen H4). - simpl. replace (a * (r * a0 + s)) with + simpl. replace (a * (r * a0 + s)) with (a * r * a0 + a * s) by nra. apply R_dot_prod_rel_cons; auto. Qed. @@ -335,9 +335,9 @@ Lemma dotprod_rel_R_exists {NAN: Nans}: Proof. intros ?. induction l. { simpl; exists 0. apply R_dot_prod_rel_nil. } -intros. inversion Hfp; subst. +intros. inversion Hfp; subst. destruct (IHl s H2) as (rs & Hrs); clear IHl. -exists (FT2R (fst a) * FT2R (snd a) + rs); simpl. +exists (FT2R (fst a) * FT2R (snd a) + rs); simpl. apply R_dot_prod_rel_cons; auto. Qed. @@ -348,9 +348,9 @@ Lemma dotprod_rel_R_exists_fma {NAN: Nans}: Proof. intros ?. induction l. { simpl; exists 0. apply R_dot_prod_rel_nil. } -intros. inversion Hfp; subst. +intros. inversion Hfp; subst. destruct (IHl s H2) as (rs & Hrs); clear IHl. -exists (FT2R (fst a) * FT2R (snd a) + rs); simpl. +exists (FT2R (fst a) * FT2R (snd a) + rs); simpl. apply R_dot_prod_rel_cons; auto. Qed. @@ -361,9 +361,9 @@ Lemma sum_rel_R_abs_exists_fma {NAN: Nans}: Proof. intros ?. induction l. { simpl; exists 0. apply R_dot_prod_rel_nil. } -intros. inversion Hfp; subst. +intros. inversion Hfp; subst. destruct (IHl s H2) as (rs & Hrs); clear IHl. -exists (Rabs (FT2R (fst a)) * Rabs (FT2R (snd a)) + rs); simpl. +exists (Rabs (FT2R (fst a)) * Rabs (FT2R (snd a)) + rs); simpl. apply R_dot_prod_rel_cons; auto. Qed. @@ -376,7 +376,7 @@ Lemma dotprodR_rel_bound' : Proof. induction l; intros. { inversion Hrp; subst; simpl; rewrite Rabs_R0; nra. } - inversion Hrp; subst. + inversion Hrp; subst. eapply Rle_trans; [apply Rabs_triang|]. eapply Rle_trans; [apply Rplus_le_compat | ]. rewrite Rabs_mult; apply Rmult_le_compat; try apply Rabs_pos. @@ -384,7 +384,7 @@ induction l; intros. apply Hin; simpl; auto. apply IHl; auto; [ apply Ha| intros; apply Hin; simpl; auto]. rewrite sqrt_def; auto. apply Req_le; - replace (length (a::l)) with ( S(length l)) by auto. + replace (length (a::l)) with ( S(length l)) by auto. rewrite S_INR; nra. Qed. @@ -397,15 +397,15 @@ Lemma dotprodR_rel_bound'' : Proof. induction l; intros. { inversion Hrp; subst; simpl; nra. } - inversion Hrp; subst. + inversion Hrp; subst. eapply Rle_trans; [ apply Rplus_le_compat | ]. - apply Rmult_le_compat; + apply Rmult_le_compat; [ destruct a; simpl; apply Rabs_pos | destruct a; simpl; apply Rabs_pos | | ]. apply Hin; simpl; auto. apply Hin; simpl; auto. apply IHl; auto; [ apply Ha| intros; apply Hin; simpl; auto]. rewrite sqrt_def; auto. apply Req_le; - replace (length (a::l)) with ( S(length l)) by auto. + replace (length (a::l)) with ( S(length l)) by auto. rewrite S_INR; nra. Qed. @@ -422,7 +422,7 @@ Hypothesis (Hlen : length v1 = length v2). Notation v1R := (map FT2R v1). Lemma dot_prod_rel_nnzR : -forall +forall (fp : ftype t) (Hfp : dot_prod_rel (combine v1 v2) fp) (Hfin: Binary.is_finite (fprec t) (femax t) fp = true), @@ -441,7 +441,7 @@ assert (Hin: forall x : R, In x (map FT2R l) -> x = 0). assert (Hlen1: length l = length l0) by (simpl; auto). assert (HFIN: Binary.is_finite (fprec t) (femax t) s = true). { simpl in Hfin. destruct (BMULT a f); destruct s; - destruct s0; try discriminate; simpl in *; auto; + destruct s0; try discriminate; simpl in *; auto; destruct s; try discriminate; auto. } pose proof nnz_is_zero_cons _ (FT2R a) (map FT2R l) _ _ H as H1. @@ -451,7 +451,7 @@ destruct (@BPLUS_accurate' t NAN (BMULT a f) s Hfin) rewrite Hacc; clear Hacc. rewrite IHl. assert (HFIN2: Binary.is_finite (fprec t) (femax t) (BMULT a f) = true). -{ simpl in Hfin. destruct (BMULT a f); destruct s; try discriminate; auto. } +{ simpl in Hfin. destruct (BMULT a f); destruct s; try discriminate; auto. } assert (Ha: FT2R a = 0). apply H0; simpl; auto. pose proof Bmult_0R _ _ HFIN2 Ha as H2; destruct H2; rewrite H2; @@ -459,7 +459,7 @@ simpl; nra. Qed. Lemma fma_dot_prod_rel_nnzR : -forall +forall (fp : ftype t) (Hfp : fma_dot_prod_rel (combine v1 v2) fp) (Hfin: Binary.is_finite (fprec t) (femax t) fp = true), @@ -478,7 +478,7 @@ assert (Hin: forall x : R, In x (map FT2R l) -> x = 0). assert (Hlen1: length l = length l0) by (simpl; auto). assert (HFIN: Binary.is_finite (fprec t) (femax t) s = true). { simpl in Hfin. destruct a; destruct f; destruct s; - destruct s0; destruct s1; destruct s; try discriminate; simpl in *; auto; + destruct s0; destruct s1; destruct s; try discriminate; simpl in *; auto; try discriminate; auto. } pose proof nnz_is_zero_cons _ (FT2R a) (map FT2R l) _ _ H as H1. specialize (IHl l0 s Hin H1 H4 Hlen1 HFIN). @@ -490,7 +490,7 @@ Qed. Lemma R_dot_prod_rel_nnzR : -forall +forall (rp : R) (Hrp : R_dot_prod_rel (map FR2 (combine v1 v2)) rp), nnzR v1R = 0%nat -> rp = 0. @@ -515,8 +515,8 @@ Qed. Lemma R_dot_prod_rel_nnzR_abs : -forall -(rp_abs : R) +forall +(rp_abs : R) (Hra : R_dot_prod_rel (map Rabsp (map FR2 (combine v1 v2))) rp_abs), nnzR v1R = 0%nat -> rp_abs = 0. Proof. @@ -532,7 +532,7 @@ assert (Hin: forall x : R, In x (map FT2R l) -> x = 0). { intros. apply H0; simpl; auto. } assert (Hlen1: length l = length l0) by (simpl; auto). pose proof nnz_is_zero_cons _ (FT2R a) (map FT2R l) _ _ H as H2. -specialize (IHl l0 s Hin H2 H4 Hlen1). +specialize (IHl l0 s Hin H2 H4 Hlen1). rewrite IHl. pose proof in_map Rabs (map FT2R (a::l)). specialize (H0 (FT2R a)). diff --git a/accuracy_proofs/float_acc_lems.v b/accuracy_proofs/float_acc_lems.v index 7efa344..21bee53 100644 --- a/accuracy_proofs/float_acc_lems.v +++ b/accuracy_proofs/float_acc_lems.v @@ -1,4 +1,4 @@ -(* This file contains lemmas regarding the accuracy of floating point +(* This file contains lemmas regarding the accuracy of floating point operations such as BPLUS, BFMA, and BMULT. *) Require Import vcfloat.VCFloat. @@ -9,10 +9,10 @@ Context {t : type}. Lemma Bmult_0R {NAN: Nans} a f : Binary.is_finite (fprec t) (femax t) (BMULT a f) = true -> -FT2R a = 0 -> +FT2R a = 0 -> (BMULT a f) = neg_zero \/ (BMULT a f) = pos_zero. Proof. intros; destruct f; destruct a; simpl; try discriminate; -destruct s; destruct s0; simpl; auto; +destruct s; destruct s0; simpl; auto; unfold FT2R, Binary.B2R in H0; simpl in H0; apply Float_prop.eq_0_F2R in H0; discriminate. @@ -20,7 +20,7 @@ Qed. Lemma Bplus_0R {NAN: Nans} a f : Binary.is_finite (fprec t) (femax t) (BPLUS a f) = true -> -FT2R f = 0 -> +FT2R f = 0 -> FT2R (BPLUS a f) = FT2R a. Proof. intros; destruct f; destruct a; simpl; try discriminate; @@ -32,10 +32,10 @@ Qed. Lemma Bfma_mult_0R {NAN: Nans} a f s : Binary.is_finite (fprec t) (femax t) (BFMA a f s) = true -> -FT2R a = 0 -> +FT2R a = 0 -> FT2R (BFMA a f s) = FT2R s. Proof. intros; destruct f; destruct a; destruct s; simpl; try discriminate; -destruct s; destruct s0; destruct s1; simpl; auto; +destruct s; destruct s0; destruct s1; simpl; auto; unfold FT2R, Binary.B2R in H0; simpl in H0; apply Float_prop.eq_0_F2R in H0; discriminate. @@ -67,22 +67,22 @@ exists delta epsilon : R, x = (x * (1+delta)+epsilon)%R. Proof. intros. -destruct (Relative.error_N_FLT Zaux.radix2 (SpecFloat.emin (fprec t) (femax t)) (fprec t) +destruct (Relative.error_N_FLT Zaux.radix2 (SpecFloat.emin (fprec t) (femax t)) (fprec t) (fprec_gt_0 t) (fun x0 : Z => negb (Z.even x0)) x) as [delta [epsilon [? [? [? ?]]]]]. exists delta, epsilon. repeat split; auto. Qed. -Lemma fma_accurate {NAN: Nans} : - forall x (FINx: Binary.is_finite (fprec t) (femax t) x = true) - y (FINy: Binary.is_finite (fprec t) (femax t) y = true) +Lemma fma_accurate {NAN: Nans} : + forall x (FINx: Binary.is_finite (fprec t) (femax t) x = true) + y (FINy: Binary.is_finite (fprec t) (femax t) y = true) z (FINz: Binary.is_finite (fprec t) (femax t) z = true) - (FIN: fma_no_overflow (FT2R x) (FT2R y) (FT2R z)), + (FIN: fma_no_overflow (FT2R x) (FT2R y) (FT2R z)), exists delta, exists epsilon, delta * epsilon = 0 /\ Rabs delta <= D /\ - Rabs epsilon <= E /\ + Rabs epsilon <= E /\ (FT2R (BFMA x y z) = (FT2R x * FT2R y + FT2R z) * (1+delta) + epsilon)%R. Proof. intros. @@ -120,14 +120,14 @@ pose proof Rle_or_lt ov (Rabs (rounded t (FT2R x * FT2R y + FT2R z))) as Hor; destruct Hor; auto. apply Rlt_bool_false in H. assert (HFIN: Binary.is_finite (fprec t) (femax t) x = true /\ - Binary.is_finite (fprec t) (femax t) y = true /\ + Binary.is_finite (fprec t) (femax t) y = true /\ Binary.is_finite (fprec t) (femax t) z = true). -{ unfold BFMA in HFINb. +{ unfold BFMA in HFINb. destruct x; destruct y; destruct z; simpl in *; try discriminate; auto. all: destruct s; destruct s0; destruct s1; simpl in *; try discriminate; auto. } destruct HFIN as (A & B & C). unfold rounded, FT2R, ov in H. -pose proof (Binary.Bfma_correct (fprec t) (femax t) +pose proof (Binary.Bfma_correct (fprec t) (femax t) (fprec_gt_0 t) (fprec_lt_femax t) (fma_nan t) BinarySingleNaN.mode_NE x y z A B C) as H0. simpl in H0; simpl in H; @@ -135,13 +135,13 @@ rewrite H in H0. clear H. fold (@BFMA NAN t) in H0. destruct (BFMA x y z); try discriminate. Qed. -Lemma fma_accurate' {NAN: Nans} : +Lemma fma_accurate' {NAN: Nans} : forall (x y z : ftype t) - (FIN: Binary.is_finite _ _ (BFMA x y z) = true), + (FIN: Binary.is_finite _ _ (BFMA x y z) = true), exists delta, exists epsilon, delta * epsilon = 0 /\ Rabs delta <= D /\ - Rabs epsilon <= E /\ + Rabs epsilon <= E /\ (FT2R (BFMA x y z) = (FT2R x * FT2R y + FT2R z) * (1+delta) + epsilon)%R. Proof. intros. @@ -158,27 +158,27 @@ Qed. Lemma BMFA_finite_e {NAN: Nans} : forall (a u f : ftype t) (Hfin : Binary.is_finite _ _ (BFMA a f u) = true), - Binary.is_finite _ _ a = true /\ - Binary.is_finite _ _ f = true /\ + Binary.is_finite _ _ a = true /\ + Binary.is_finite _ _ f = true /\ Binary.is_finite _ _ u = true. Proof. intros. -destruct a,f,u; inversion Hfin; clear Hfin; subst; +destruct a,f,u; inversion Hfin; clear Hfin; subst; try solve [split; [ | split]; simpl; auto; constructor; auto]. all: try solve [destruct s,s0,s1; discriminate]. Qed. -Lemma BMULT_accurate {NAN: Nans}: - forall x y (FIN: Bmult_no_overflow (FT2R x) (FT2R y)), +Lemma BMULT_accurate {NAN: Nans}: + forall x y (FIN: Bmult_no_overflow (FT2R x) (FT2R y)), exists delta, exists epsilon, delta * epsilon = 0 /\ Rabs delta <= D /\ - Rabs epsilon <= E /\ + Rabs epsilon <= E /\ (@FT2R t (BMULT x y) = (FT2R x * FT2R y) * (1+delta) + epsilon)%R. Proof. intros. -pose proof (Binary.Bmult_correct (fprec t) (femax t) (fprec_gt_0 t) (fprec_lt_femax t) +pose proof (Binary.Bmult_correct (fprec t) (femax t) (fprec_gt_0 t) (fprec_lt_femax t) (mult_nan t) BinarySingleNaN.mode_NE x y). change (Binary.B2R (fprec t) (femax t) ?x) with (@FT2R t x) in *. cbv zeta in H. @@ -200,44 +200,44 @@ Lra.lra. Qed. Lemma is_finite_BMULT_no_overflow {NAN: Nans} : - forall (x y : ftype t) + forall (x y : ftype t) (HFINb : Binary.is_finite (fprec t) (femax t) (BMULT x y) = true), Bmult_no_overflow (FT2R x) (FT2R y). Proof. intros. -pose proof Rle_or_lt (bpow Zaux.radix2 (femax t)) +pose proof Rle_or_lt (bpow Zaux.radix2 (femax t)) (Rabs (rounded t (FT2R x * FT2R y))) as Hor; destruct Hor; auto. apply Rlt_bool_false in H; red. unfold rounded, FT2R in H. -pose proof (Binary.Bmult_correct (fprec t) (femax t) +pose proof (Binary.Bmult_correct (fprec t) (femax t) (fprec_gt_0 t) (fprec_lt_femax t) (mult_nan t) BinarySingleNaN.mode_NE x y) as H0. simpl in H0; simpl in H; rewrite H in H0. unfold BMULT, BINOP in HFINb. -destruct ((Binary.Bmult (fprec t) (femax t) (fprec_gt_0 t) +destruct ((Binary.Bmult (fprec t) (femax t) (fprec_gt_0 t) (fprec_lt_femax t) (mult_nan t) BinarySingleNaN.mode_NE x y)); simpl; try discriminate. Qed. -Lemma BMULT_accurate' {NAN: Nans}: - forall - (x y : ftype t) - (FIN: Binary.is_finite _ _ (BMULT x y) = true), +Lemma BMULT_accurate' {NAN: Nans}: + forall + (x y : ftype t) + (FIN: Binary.is_finite _ _ (BMULT x y) = true), exists delta, exists epsilon, delta * epsilon = 0 /\ Rabs delta <= D /\ - Rabs epsilon <= E /\ + Rabs epsilon <= E /\ (@FT2R t (BMULT x y) = (FT2R x * FT2R y) * (1+delta) + epsilon)%R. Proof. -intros. +intros. pose proof BMULT_accurate x y (is_finite_BMULT_no_overflow x y FIN); auto. Qed. Lemma BMULT_finite_e {NAN: Nans} : forall (a b : ftype t) (Hfin : Binary.is_finite _ _ (BMULT a b) = true), - Binary.is_finite _ _ a = true /\ + Binary.is_finite _ _ a = true /\ Binary.is_finite _ _ b = true. Proof. intros. @@ -247,7 +247,7 @@ Qed. Lemma BPLUS_finite_e {NAN: Nans}: forall (a b : ftype t) (Hfin : Binary.is_finite _ _ (BPLUS a b) = true), - Binary.is_finite _ _ a = true /\ + Binary.is_finite _ _ a = true /\ Binary.is_finite _ _ b = true. Proof. intros. @@ -303,14 +303,14 @@ Qed. Lemma BPLUS_accurate {NAN: Nans} : - forall x (FINx: Binary.is_finite (fprec t) (femax t) x = true) - y (FINy: Binary.is_finite (fprec t) (femax t) y = true) - (FIN: Bplus_no_overflow t (FT2R x) (FT2R y)), - exists delta, + forall x (FINx: Binary.is_finite (fprec t) (femax t) x = true) + y (FINy: Binary.is_finite (fprec t) (femax t) y = true) + (FIN: Bplus_no_overflow t (FT2R x) (FT2R y)), + exists delta, Rabs delta <= D /\ (FT2R (BPLUS x y ) = (FT2R x + FT2R y) * (1+delta))%R. Proof. -intros. +intros. pose proof (Binary.Bplus_correct (fprec t) (femax t) (fprec_gt_0 t) (fprec_lt_femax t) (plus_nan t) BinarySingleNaN.mode_NE x y FINx FINy). change (Binary.B2R (fprec t) (femax t) ?x) with (@FT2R t x) in *. @@ -327,7 +327,7 @@ destruct H0. - destruct H as [? _]. unfold BPLUS, BINOP. -rewrite H. +rewrite H. assert (A: Generic_fmt.generic_format Zaux.radix2 (FLT.FLT_exp (SpecFloat.emin (fprec t) (femax t)) (fprec t)) (FT2R x) ) by (apply Binary.generic_format_B2R). @@ -348,7 +348,7 @@ rewrite <- H1 in Hd'. clear H1. rewrite Hd'; clear Hd'. exists d; split; auto. eapply Rle_trans; [apply Hd |]. apply Rdiv_le_left. -apply Fourier_util.Rlt_zero_pos_plus1. +apply Fourier_util.Rlt_zero_pos_plus1. apply default_rel_gt_0. eapply Rle_trans with (D * 1); try nra. - @@ -367,38 +367,38 @@ pose proof Rle_or_lt (bpow Zaux.radix2 (femax t)) (Rabs (rounded t (FT2R x + FT2 apply Rlt_bool_false in H. assert (HFIN: Binary.is_finite (fprec t) (femax t) x = true /\ Binary.is_finite (fprec t) (femax t) y = true). -{ unfold BPLUS, BINOP in HFINb. +{ unfold BPLUS, BINOP in HFINb. destruct x; destruct y; simpl in *; try discriminate; auto. destruct s; destruct s0; simpl in *; try discriminate; auto. } destruct HFIN as (A & B). unfold rounded, FT2R in H. -pose proof (Binary.Bplus_correct (fprec t) (femax t) +pose proof (Binary.Bplus_correct (fprec t) (femax t) (fprec_gt_0 t) (fprec_lt_femax t) (plus_nan t) BinarySingleNaN.mode_NE x y A B) as H0; rewrite H in H0; destruct H0 as ( C & _). unfold BPLUS, BINOP in HFINb. -destruct ((Binary.Bplus (fprec t) (femax t) (fprec_gt_0 t) (fprec_lt_femax t) +destruct ((Binary.Bplus (fprec t) (femax t) (fprec_gt_0 t) (fprec_lt_femax t) (plus_nan t) BinarySingleNaN.mode_NE x y)); simpl; try discriminate. Qed. Lemma BPLUS_accurate' {NAN: Nans} : - forall x y - (FIN: Binary.is_finite _ _ (BPLUS x y) = true), - exists delta, + forall x y + (FIN: Binary.is_finite _ _ (BPLUS x y) = true), + exists delta, Rabs delta <= D /\ (@FT2R t (BPLUS x y ) = (FT2R x + FT2R y) * (1+delta))%R. Proof. intros. assert (A: Binary.is_finite (fprec t) (femax t) x = true /\ Binary.is_finite (fprec t) (femax t) y = true). -{ destruct x; destruct y; simpl; try discriminate; auto; +{ destruct x; destruct y; simpl; try discriminate; auto; destruct s; destruct s0; simpl; try discriminate; auto. } destruct A as (A & B). -pose proof BPLUS_accurate x A y B (is_finite_sum_no_overflow x y FIN); +pose proof BPLUS_accurate x A y B (is_finite_sum_no_overflow x y FIN); auto. Qed. diff --git a/accuracy_proofs/fma_dot_acc.v b/accuracy_proofs/fma_dot_acc.v index e809048..ad359ff 100644 --- a/accuracy_proofs/fma_dot_acc.v +++ b/accuracy_proofs/fma_dot_acc.v @@ -1,5 +1,5 @@ (** This file contains three main theorems for the accuracy of the fma - dot product : fma_dotprod_mixed_error, fma_dotprod_forward_error, + dot product : fma_dotprod_mixed_error, fma_dotprod_forward_error, and fma_sparse_dotprod_forward_error. *) Require Import vcfloat.VCFloat. @@ -11,7 +11,7 @@ From LAProof.accuracy_proofs Require Import dotprod_model sum_model dot_acc_lemm Require Import Reals. Open Scope R. -Section MixedError. +Section MixedError. Context {NAN: Nans} {t : type}. Notation g := (@g t). @@ -37,23 +37,23 @@ assert (Datatypes.length (combine v1 v2) = length v1) by assert (Hlenr : length (rev v1) = length (rev v2)) by (rewrite !rev_length; auto). rewrite <- rev_length in Hlen. pose proof fma_dot_prod_rel_fold_right v1 v2 as H1. -rewrite <- combine_rev in H1. +rewrite <- combine_rev in H1. rewrite rev_length in Hlen. -pose proof (fma_dotprod_mixed_error_rel (rev v1) (rev v2) Hlenr (fma_dotprod v1 v2) H1 Hfin) as +pose proof (fma_dotprod_mixed_error_rel (rev v1) (rev v2) Hlenr (fma_dotprod v1 v2) H1 Hfin) as (u & eta & H2 & H3 & H4 & H5). exists (rev u), eta; repeat split; auto. rewrite rev_length in H2; rewrite <- rev_length in H2; auto. -pose proof dotprodR_rel u (map FT2R (rev v2)). +pose proof dotprodR_rel u (map FT2R (rev v2)). assert (dotprodR (rev u) (map FT2R v2) = FT2R (fma_dotprod v1 v2) - eta). eapply R_dot_prod_rel_eq; eauto. rewrite <- dotprodR_rev, <- map_rev. auto. -rewrite rev_length in H2; rewrite map_length; auto; lia. -nra. -rewrite !rev_length in H4. -intros. +rewrite rev_length in H2; rewrite map_length; auto; lia. +nra. +rewrite !rev_length in H4. +intros. assert ((length u - S n < length v2)%nat). -{ rewrite rev_length in H2. -rewrite H2. rewrite Hlen. +{ rewrite rev_length in H2. +rewrite H2. rewrite Hlen. apply Nat.sub_lt; try lia. } specialize (H4 (length u - S n)%nat H6). @@ -62,14 +62,14 @@ rewrite rev_nth. destruct H4 as (delta & Hn & HD). exists delta; split. rewrite Hn; repeat f_equal. -rewrite rev_length in H2. +rewrite rev_length in H2. rewrite Hlen. -rewrite H2. +rewrite H2. rewrite <- Nat.sub_succ_l. simpl. lia. apply Arith_prebase.lt_le_S_stt; auto. lia. apply HD. -rewrite rev_length in H2. +rewrite rev_length in H2. rewrite H2; auto. lia. rewrite Hlen; auto. rewrite !rev_length in H5; auto. @@ -79,7 +79,7 @@ Qed. End MixedError. -Section ForwardError. +Section ForwardError. Context {NAN: Nans} {t : type}. Variables v1 v2 : list (ftype t). @@ -96,15 +96,15 @@ Hypothesis Hlen: length v1 = length v2. Hypothesis Hfin: Binary.is_finite (fprec t) (femax t) (fma_dotprod v1 v2) = true. Lemma fma_dotprod_forward_error: - Rabs (FT2R (fma_dotprod v1 v2) - dotprodR v1R v2R ) + Rabs (FT2R (fma_dotprod v1 v2) - dotprodR v1R v2R ) <= g n * dotprodR v1R' v2R' + g1 n (n - 1). Proof. -intros. +intros. pose proof R_dot_prod_rel_fold_right' t v1 v2 as HB. pose proof R_dot_prod_rel_fold_right_Rabs' t v1 v2 as HC. simpl in HB, HC. rewrite <- map_rev in HC, HB. rewrite <- map_rev in HC. -pose proof fma_dotprod_forward_error_rel (rev (combine v1 v2)) +pose proof fma_dotprod_forward_error_rel (rev (combine v1 v2)) (fma_dotprod v1 v2) (fma_dot_prod_rel_fold_right _ _ ) Hfin (dotprodR v1R v2R) (dotprodR v1R' v2R') HB HC. rewrite rev_length, combine_length, Hlen, Nat.min_id in H; @@ -114,10 +114,10 @@ Qed. Notation nnzR := (common.nnzR v1R). Lemma fma_sparse_dotprod_forward_error: - Rabs (FT2R (fma_dotprod v1 v2) - dotprodR v1R v2R ) <= + Rabs (FT2R (fma_dotprod v1 v2) - dotprodR v1R v2R ) <= g nnzR * dotprodR v1R' v2R' + g1 nnzR (nnzR - 1). -Proof. -intros. +Proof. +intros. pose proof fma_dot_prod_rel_fold_right v1 v2 as HA. pose proof R_dot_prod_rel_fold_right' t v1 v2 as HB. pose proof R_dot_prod_rel_fold_right_Rabs' t v1 v2 as HC. @@ -126,10 +126,10 @@ pose proof R_dot_prod_rel_fold_right_Rabs' t v1 v2 as HC. pose proof @sparse_fma_dotprod_forward_error NAN t (rev v1) (rev v2). rewrite !rev_length, combine_rev in H; auto. specialize (H Hlen (fma_dotprod v1 v2) HA Hfin (dotprodR v1R v2R) - (dotprodR v1R' v2R') HB HC). + (dotprodR v1R' v2R') HB HC). rewrite map_rev in H. unfold common.nnzR, nnz in H. -rewrite count_occ_rev, rev_length in H. +rewrite count_occ_rev, rev_length in H. unfold common.nnzR, nnz; auto. Qed. diff --git a/accuracy_proofs/fma_is_finite.v b/accuracy_proofs/fma_is_finite.v index edf2410..ea47cd3 100644 --- a/accuracy_proofs/fma_is_finite.v +++ b/accuracy_proofs/fma_is_finite.v @@ -35,8 +35,8 @@ let x := (fmax t - @default_abs t) / (1 + @default_rel t) - @g1 t n (n-1) in let y := 1 / (1 + INR n * (@g t (n - 1) + 1)) in x * y. Lemma rdiv_lt (a b: R) : - 0 < b -> 0 < a -> b < a -> / a < / b. -Proof. + 0 < b -> 0 < a -> b < a -> / a < / b. +Proof. intros. replace (/b) with (1/b) by nra. apply Rdiv_lt_right; auto. @@ -46,9 +46,9 @@ nra. Qed. Lemma rdiv_le (a b: R) : - 0 < b -> 0 < a -> b <= a -> / a <= / b. -Proof. -intros. + 0 < b -> 0 < a -> b <= a -> / a <= / b. +Proof. +intros. replace (/b) with (1/b) by nra. apply Rcomplements.Rle_div_r; auto. rewrite Rmult_comm. @@ -80,7 +80,7 @@ apply bpow_le. apply Z.le_sub_le_add_r. apply Z.le_sub_le_add_r. Search fprec femax. -eapply Z.le_trans with (fprec t + fprec t + femax t)%Z; +eapply Z.le_trans with (fprec t + fprec t + femax t)%Z; [ | repeat apply Zplus_le_compat_r; apply Z.lt_le_incl; apply fprec_lt_femax]. eapply Z.le_trans with (fprec t + fprec t + fprec t)%Z; [ | repeat apply Zplus_le_compat_l;apply Z.lt_le_incl; apply fprec_lt_femax ]. @@ -94,9 +94,9 @@ eapply Z.le_trans with (1 + 1 + 1)%Z; apply fprec_gt_one]. Qed. -Lemma bpow_femax_lb t : +Lemma bpow_femax_lb t : 4 <= bpow Zaux.radix2 (femax t). -Proof. +Proof. pose proof fprec_gt_one t. pose proof fprec_lt_femax t. assert (1 < femax t)%Z. @@ -106,9 +106,9 @@ unfold bpow; simpl; nra. apply bpow_le; lia. Qed. -Lemma bpow_fprec_lb t : +Lemma bpow_fprec_lb t : 2 <= bpow Zaux.radix2 (fprec t). -Proof. +Proof. pose proof fprec_gt_one t. eapply Rle_trans with (bpow Zaux.radix2 1). unfold bpow; simpl; nra. @@ -125,10 +125,10 @@ replace (3 - femax t - fprec t)%Z with (3 +- femax t +- fprec t)%Z by lia. rewrite !bpow_plus. rewrite <- !Rmult_assoc. replace (/ 2 * bpow Zaux.radix2 3) with 4; [|simpl;nra]. -rewrite !bpow_opp, !Rcomplements.Rle_div_r. +rewrite !bpow_opp, !Rcomplements.Rle_div_r. field_simplify; try nra. eapply Rle_trans; [| apply Rmult_le_compat ;[ | | apply bpow_fprec_lb | apply bpow_femax_lb ]]; try nra. -apply Rlt_gt. +apply Rlt_gt. replace (/ bpow Zaux.radix2 (femax t)) with (1 / bpow Zaux.radix2 (femax t)) by nra. apply Rdiv_lt_0_compat; try nra. apply Rlt_gt; @@ -146,7 +146,7 @@ rewrite <- !Rmult_assoc. rewrite Rmult_comm. rewrite <- !Rmult_assoc. replace (bpow Zaux.radix2 1 * / 2) with 1; [|simpl;nra]. -rewrite !bpow_opp, !Rcomplements.Rle_div_r. +rewrite !bpow_opp, !Rcomplements.Rle_div_r. field_simplify; try nra. replace 1 with (bpow Zaux.radix2 0). apply bpow_le. @@ -158,9 +158,9 @@ apply Rdiv_lt_0_compat; try nra. Qed. -Lemma fun_bnd_pos_1 : +Lemma fun_bnd_pos_1 : forall t n -(Hn : @g1 t (n + 1) n <= fmax t), +(Hn : @g1 t (n + 1) n <= fmax t), 0 <= (fmax t - @default_abs t) / (1 + @default_rel t) - @g1 t n (n-1). Proof. intros; @@ -171,23 +171,23 @@ assert (Hn': (n=0)%nat \/ (1<=n)%nat) by lia; destruct Hn'; subst. assert (Hn': (n=1)%nat \/ (1 < n)%nat) by lia; destruct Hn'; subst. { simpl. unfold g1, g. simpl; field_simplify. eapply Rle_trans. -apply Rplus_le_compat. +apply Rplus_le_compat. apply Rmult_le_compat. -apply default_abs_ge_0. +apply default_abs_ge_0. apply default_rel_ge_0. apply default_abs_ub. apply default_rel_ub. apply Rmult_le_compat_l; try nra. apply default_abs_ub. eapply Rle_trans; [| apply bpow_femax_lb]; nra. } -eapply Rle_trans. apply mult_d_e_g1_le'; try lia. +eapply Rle_trans. apply mult_d_e_g1_le'; try lia. replace (S n) with (n + 1)%nat by lia. replace (S (n - 1)) with n by lia; auto. Qed. Lemma fun_bnd_le (t : type) (n : nat) : -forall (Hn : @g1 t (S n + 1) (S n) <= fmax t), +forall (Hn : @g1 t (S n + 1) (S n) <= fmax t), fun_bnd t (S n) <= fun_bnd t n. Proof. assert (Hn': (n=0)%nat \/ (1<=n)%nat) by lia; destruct Hn'; subst. @@ -198,13 +198,13 @@ field_simplify. apply default_abs_ge_0. simpl; unfold g; field_simplify; simpl; try nra. } intros; unfold fun_bnd. assert (0 < 1 + INR (S n) * (@g t (S n - 1) + 1)). -{ +{ apply Rplus_lt_le_0_compat; try nra. apply Rmult_le_pos; try apply pos_INR. apply Rplus_le_le_0_compat; try nra; apply g_pos. } assert ( INR n * @g t (n - 1) + INR n + 1 > 0). -{ +{ apply Rplus_lt_le_0_compat; try nra. apply Rplus_le_lt_0_compat; [| apply lt_0_INR; lia]. apply Rmult_le_pos; try apply pos_INR. @@ -217,7 +217,7 @@ replace (S n -1)%nat with (S (n-1))%nat by lia. apply g1n_le_g1Sn; auto. apply Rcomplements.Rle_div_r. apply Rlt_gt. -replace (/ (1 + INR (S n) * (@g t (S n - 1) + 1))) with +replace (/ (1 + INR (S n) * (@g t (S n - 1) + 1))) with (1/(1 + INR (S n) * (@g t (S n - 1) + 1))) by nra. apply Rdiv_lt_0_compat; try nra. field_simplify; try nra. @@ -235,15 +235,15 @@ Qed. Lemma length_split {A : Type} (l : list (A * A)) : length (fst (List.split l)) = length (snd (List.split l)). -Proof. +Proof. induction l; [simpl; auto | ]. destruct a; simpl; destruct (List.split l); simpl. simpl in IHl; lia. Qed. Lemma fun_bound_pos t n : -forall (Hn : @g1 t (n + 1) n <= fmax t), -0 <= fun_bnd t n. +forall (Hn : @g1 t (n + 1) n <= fmax t), +0 <= fun_bnd t n. Proof. intros; unfold fun_bnd; apply Rmult_le_pos. @@ -263,17 +263,17 @@ simpl in IHl; rewrite IHl; auto. Qed. -Lemma finite_sum_from_bounded : +Lemma finite_sum_from_bounded : forall (t: type) (v1 v2: list (ftype t)) - (fp : ftype t) + (fp : ftype t) (Hfp: fma_dot_prod_rel (List.combine v1 v2) fp) (Hn : @g1 t (S (length (List.combine v1 v2)) + 1) (S (length (List.combine v1 v2))) <= fmax t), - (forall x, In x (List.combine v1 v2) -> - Binary.is_finite _ _ (fst x) = true /\ - Binary.is_finite _ _ (snd x) = true /\ + (forall x, In x (List.combine v1 v2) -> + Binary.is_finite _ _ (fst x) = true /\ + Binary.is_finite _ _ (snd x) = true /\ Rabs (FT2R (fst x)) < sqrt (fun_bnd t (length (List.combine v1 v2))) /\ - Rabs (FT2R (snd x)) < sqrt (fun_bnd t (length (List.combine v1 v2))))-> - Binary.is_finite _ _ fp = true. + Rabs (FT2R (snd x)) < sqrt (fun_bnd t (length (List.combine v1 v2))))-> + Binary.is_finite _ _ fp = true. Proof. intros ? ? ? . induction (List.combine v1 v2). @@ -288,38 +288,38 @@ assert (Hin: forall x : (ftype t * ftype t), Binary.is_finite _ _ (snd x) = true /\ Rabs (FT2R (fst x)) < sqrt (fun_bnd t (length l)) /\ Rabs (FT2R (snd x)) < sqrt (fun_bnd t (length l))). - { intros. repeat split; [apply H; simpl; auto | apply H; simpl; auto | | ]. + { intros. repeat split; [apply H; simpl; auto | apply H; simpl; auto | | ]. eapply Rlt_le_trans; [apply H; simpl; auto | apply sqrt_le_1_alt; apply fun_bnd_le; auto ]. eapply Rlt_le_trans; [apply H; simpl; auto | apply sqrt_le_1_alt; apply fun_bnd_le; auto ]. } assert (Hfina : Binary.is_finite (fprec t) (femax t) (fst a) = true /\ Binary.is_finite (fprec t) (femax t) (snd a) = true) by (split; apply H; simpl; auto); destruct Hfina as (Hfina1 & Hfina2). -specialize (IHl s H3 Hn' Hin). -apply is_finite_fma_no_overflow'; auto. +specialize (IHl s H3 Hn' Hin). +apply is_finite_fma_no_overflow'; auto. unfold fma_no_overflow, rounded. -destruct (@generic_round_property t (FT2R (fst a) * FT2R (snd a) + FT2R s)) as +destruct (@generic_round_property t (FT2R (fst a) * FT2R (snd a) + FT2R s)) as (del & eps & Hed & Hd & He & Hrn ); rewrite Hrn; clear Hrn. destruct (dotprod_rel_R_exists_fma t l s H3) as (rs & Hrs). destruct (sum_rel_R_abs_exists_fma t l s H3) as (rs_abs & Habs). pose proof fma_dotprod_forward_error_rel l - s H3 IHl rs rs_abs Hrs Habs as Hacc. + s H3 IHl rs rs_abs Hrs Habs as Hacc. apply Rabs_le_minus in Hacc. set (n:=(length l)) in *. assert (Hacc' : Rabs (FT2R s) <= (@g t n + 1) * rs_abs + @g1 t n (n - 1)). -{ eapply Rle_trans. +{ eapply Rle_trans. apply Hacc. replace (g n * rs_abs + g1 n (n - 1) + Rabs rs) -with ((@g t n * rs_abs + Rabs rs) + @g1 t n (n - 1)) by nra. +with ((@g t n * rs_abs + Rabs rs) + @g1 t n (n - 1)) by nra. apply Rplus_le_compat_r. field_simplify. -apply Rplus_le_compat_l. +apply Rplus_le_compat_l. rewrite <- (@R_dot_prod_rel_Rabs_eq (map FR2 l)); try nra; auto. apply (@dot_prod_sum_rel_R_Rabs (map FR2 l)); auto. } clear Hacc. pose proof dotprodR_rel_bound' as C. pose proof dotprodR_rel_bound'' as D. eapply Rle_lt_trans; [apply Rabs_triang |]. rewrite Rabs_mult. -eapply Rle_lt_trans; [apply Rplus_le_compat |]. +eapply Rle_lt_trans; [apply Rplus_le_compat |]. apply Rmult_le_compat; try apply Rabs_pos. eapply Rle_trans; [apply Rabs_triang |]. apply Rplus_le_compat. @@ -330,9 +330,9 @@ apply Rlt_le; apply H; simpl; auto. eapply Rle_trans. apply Hacc'. apply Rplus_le_compat_r. -apply Rmult_le_compat_l. +apply Rmult_le_compat_l. apply Rplus_le_le_0_compat; try nra. apply g_pos. -apply D. +apply D. apply fun_bound_pos. apply Hn'. apply Habs. @@ -356,7 +356,7 @@ replace (( u + (@g t n + 1) * (INR (length l) * u))) with ( u * (1 + (@g t n + 1) * (INR (length l)))) by nra. apply Rcomplements.Rlt_minus_r. -apply Rcomplements.Rlt_div_r. +apply Rcomplements.Rlt_div_r. apply Rlt_gt; apply default_rel_plus_1_gt_0. apply Rcomplements.Rlt_minus_r. assert (0 < 1 + (@g t n + 1) * INR (length l)). @@ -370,7 +370,7 @@ apply Rplus_lt_le_0_compat; try nra. apply Rmult_le_pos; try apply pos_INR. apply Rplus_le_le_0_compat; try nra; apply g_pos. } assert (0 < 1 + INR (S n) * (@g t (S n - 1) + 1)). -{ +{ apply Rplus_lt_le_0_compat; try nra. apply Rmult_le_pos; try apply pos_INR. apply Rplus_le_le_0_compat; try nra; apply g_pos. } @@ -394,9 +394,9 @@ apply g1n_lt_g1Sn; auto. subst n; auto. apply Rcomplements.Rlt_div_r. apply Rlt_gt. -replace (/ (1 + INR (S n) * (@g t (S n - 1) + 1))) with +replace (/ (1 + INR (S n) * (@g t (S n - 1) + 1))) with (1/(1 + INR (S n) * (@g t (S n - 1) + 1))) by nra. -apply Rdiv_lt_0_compat; try nra. +apply Rdiv_lt_0_compat; try nra. field_simplify; try nra. apply Rcomplements.Rlt_div_r; try nra. rewrite Rmult_1_l. @@ -406,7 +406,7 @@ rewrite Rmult_comm. apply Rmult_le_compat; [ apply pos_INR | apply g_pos | | ]. apply le_INR; lia. replace (S n - 1)%nat with (n)%nat by lia; try nra. -unfold n. +unfold n. apply lt_INR; lia. } apply fun_bound_pos; auto. diff --git a/accuracy_proofs/gem_defs.v b/accuracy_proofs/gem_defs.v index b3be6e0..9af4006 100644 --- a/accuracy_proofs/gem_defs.v +++ b/accuracy_proofs/gem_defs.v @@ -1,6 +1,6 @@ -(** This file contains the low level list - definitions of matrices and vectors, along with - useful lemmas about these definitions +(** This file contains the low level list + definitions of matrices and vectors, along with + useful lemmas about these definitions Copyright Ariel Kellison, 2023 *) @@ -12,57 +12,57 @@ From LAProof.accuracy_proofs Require Import common op_defs dotprod_model sum_mod From LAProof.accuracy_proofs Require Import float_acc_lems list_lemmas. (* General list matrix and vector definitions *) -Section MVGenDefs. +Section MVGenDefs. Definition matrix {A : Type} := list (list A). Definition vector {A : Type} := list A. -Fixpoint zero_vector {A: Type} (m : nat) (zero : A) : vector := - match m with +Fixpoint zero_vector {A: Type} (m : nat) (zero : A) : vector := + match m with | S n => zero :: zero_vector n zero | _ => [] - end. + end. -Fixpoint zero_matrix {A: Type} (m n: nat) (zero : A) : matrix := - match m,n with +Fixpoint zero_matrix {A: Type} (m n: nat) (zero : A) : matrix := + match m,n with | S m', S n' => zero_vector n zero :: zero_matrix m' n zero | _, _ => [] - end. + end. -Definition is_finite_vec {t : type} (v: vector) : Prop := +Definition is_finite_vec {t : type} (v: vector) : Prop := Forall (fun x => Binary.is_finite (fprec t) (femax t) x = true) v. -Definition is_finite_mat {t : type} (A: matrix) : Prop := +Definition is_finite_mat {t : type} (A: matrix) : Prop := Forall (fun x => @is_finite_vec t x) A. Definition is_zero_vector {A: Type} v (zero : A) : Prop := forall x, In x v -> x = zero. Definition map_mat {A B: Type} (f : A -> B) (M : matrix) : matrix := - map (map f) M. + map (map f) M. Definition map2 {A B C: Type} (f: A -> B -> C) al bl := map (uncurry f) (List.combine al bl). Fixpoint zero_map_vec {A B : Type} (zero : B) (v : @vector A) : @vector B := - match v with + match v with | [] => [] | h :: t => zero :: zero_map_vec zero t -end. +end. Fixpoint zero_map_mat {A B : Type} (zero : B) (M : @matrix A) : @matrix B := - match M with + match M with | [] => [] | hM :: tM => zero_map_vec zero hM :: zero_map_mat zero tM -end. +end. -Definition in_matrix {T : Type} (A : list (list T)) (a : T) := +Definition in_matrix {T : Type} (A : list (list T)) (a : T) := let A' := flat_map (fun x => x) A in In a A'. Definition matrix_index {A} (m: matrix) (i j: nat) (zero: A) : A := nth j (nth i m nil) zero. -Definition eq_size {T1 T2} +Definition eq_size {T1 T2} (A : list (list T1)) (B : list (list T2)) := length A = length B /\ forall x y, In x A -> In y B -> length x = length y. @@ -71,7 +71,7 @@ End MVGenDefs. Section MVOpDefs. (* generic vector sum *) -Definition vec_sum {A: Type} (sum : A -> A -> A) : +Definition vec_sum {A: Type} (sum : A -> A -> A) : vector -> vector -> vector := map2 sum. (* sum vectors of reals *) @@ -81,7 +81,7 @@ Definition vec_sumR := vec_sum Rplus. Definition vec_sumF {NAN : Nans} {t : type} := vec_sum (@BPLUS NAN t). (* generic matrix sum *) -Definition mat_sum {T: Type} (sum : T -> T -> T):= +Definition mat_sum {T: Type} (sum : T -> T -> T):= map2 (map2 sum). (* sum matrices of reals *) @@ -91,7 +91,7 @@ Definition mat_sumR := mat_sum Rplus . Definition mat_sumF {NAN : Nans} {t: type} := mat_sum (@BPLUS NAN t). (* generic matrix vector multiplication *) -Definition MV {A: Type} (DOT : @vector A -> @vector A -> A) +Definition MV {A: Type} (DOT : @vector A -> @vector A -> A) (m: matrix) (v: vector) : vector := map (fun row => DOT row v) m. @@ -103,11 +103,11 @@ Definition mvF {NAN : Nans} {t: type} : matrix -> vector -> vector := Definition mvR : matrix -> vector -> vector := MV dotprodR. (* helper for generic matrix-matrix multiplication *) -Definition mul' {A: Type} (d : A) (mult: A -> A -> A) (m : @matrix A) (v : @vector A) := +Definition mul' {A: Type} (d : A) (mult: A -> A -> A) (m : @matrix A) (v : @vector A) := map (fun a => map (mult a) v) (map (hd d) m). -(* transpose of matrix B of size ( m x p) *) +(* transpose of matrix B of size ( m x p) *) Fixpoint trans {A: Type} d p (B : matrix) : matrix := match p with | S p' => (map (hd d) B) :: trans d p'(map (@tl A) B) @@ -119,8 +119,8 @@ unfold trans. simpl. Abort. Notation "A ^T" := (trans A) (at level 40). -(* perform p dot products between row and the p columns of m2 of size (m x p) *) -Fixpoint DOT {A: Type} (dotprod : @vector A -> @vector A -> A) +(* perform p dot products between row and the p columns of m2 of size (m x p) *) +Fixpoint DOT {A: Type} (dotprod : @vector A -> @vector A -> A) row (m2 : matrix) := match m2 with | col :: m2' => dotprod row col :: DOT dotprod row m2' @@ -129,11 +129,11 @@ Fixpoint DOT {A: Type} (dotprod : @vector A -> @vector A -> A) (* generic matrix-matrix multiplication on row major order matrices of size (m x n); assumes m2 is transposed *) -Fixpoint MMT {A: Type} (d : A) (dotprod : @vector A -> @vector A -> A) +Fixpoint MMT {A: Type} (d : A) (dotprod : @vector A -> @vector A -> A) (m1 m2: @matrix A) : @matrix A := match m1 with | row :: m1' => - DOT dotprod row m2 :: MMT d dotprod m1' m2 + DOT dotprod row m2 :: MMT d dotprod m1' m2 | _ => [] end. @@ -142,16 +142,16 @@ Example checkMMT : let A:= trans 0%R 2 [[1;1];[1;1]] in simpl. unfold dotprodR. simpl. repeat f_equal ;field_simplify; nra. Qed. (* floating-point matrix matrix multiplication. *) -Definition MMTF {NAN : Nans} {t: type} : matrix -> matrix -> matrix := +Definition MMTF {NAN : Nans} {t: type} : matrix -> matrix -> matrix := MMT (Zconst t 0) dotprodF. (* real valued matrix matrix multiplication *) -Definition MMTR : matrix -> matrix -> matrix := +Definition MMTR : matrix -> matrix -> matrix := MMT 0%R dotprodR. -(* perform p dot products between row a and the p columns of B *) -Fixpoint dot' {A: Type} (d : A) (dotprod : @vector A -> @vector A -> A) +(* perform p dot products between row a and the p columns of B *) +Fixpoint dot' {A: Type} (d : A) (dotprod : @vector A -> @vector A -> A) p a (B : matrix) := match p with | S p' => dotprod a (map (hd d) B) :: dot' d dotprod p' a (map (@tl A) B) @@ -159,64 +159,64 @@ Fixpoint dot' {A: Type} (d : A) (dotprod : @vector A -> @vector A -> A) end. (* generic matrix-matrix multiplication on row major order matrices of size (m x n) *) -Fixpoint MM' {A: Type} (d : A) (dotprod : @vector A -> @vector A -> A) +Fixpoint MM' {A: Type} (d : A) (dotprod : @vector A -> @vector A -> A) (m1 m2: @matrix A) : @matrix A := match m1,m2 with | row :: m1', b :: m2' => - dot' d dotprod (length b) row m2 :: MM' d dotprod m1' m2 + dot' d dotprod (length b) row m2 :: MM' d dotprod m1' m2 | _ ,_ => [] end. (* floating-point matrix matrix multiplication. *) -Definition MMF' {NAN : Nans} {t: type} : matrix -> matrix -> matrix := +Definition MMF' {NAN : Nans} {t: type} : matrix -> matrix -> matrix := MM' (Zconst t 0) dotprodF. (* real valued matrix matrix multiplication *) -Definition MMR' : matrix -> matrix -> matrix := +Definition MMR' : matrix -> matrix -> matrix := MM' 0%R dotprodR. (* scale vector v by constant a *) -Definition scaleV {T} (mul: T -> T -> T) (a : T) (v : vector) : vector := +Definition scaleV {T} (mul: T -> T -> T) (a : T) (v : vector) : vector := map (mul a) v. Definition scaleVR := @scaleV R Rmult. Definition scaleVF {NAN : Nans} {t : type} := @scaleV (ftype t) (@BMULT NAN t). (* multiply row a of size m by matrix B of size (m x p)*) -Fixpoint rowM {T} (d: T) (sum : @vector T -> @vector T -> @vector T) - (mul: T -> T -> T) (m : nat) a B : vector := +Fixpoint rowM {T} (d: T) (sum : @vector T -> @vector T -> @vector T) + (mul: T -> T -> T) (m : nat) a B : vector := match a,B with | a0 :: a', b :: B' => sum (scaleV mul a0 b) (rowM d sum mul m a' B') - | _, _ => zero_vector m d - end. + | _, _ => zero_vector m d + end. -Fixpoint MM {T} (d: T) (sum : @vector T -> @vector T -> @vector T) - (mul: T -> T -> T) A B : matrix := +Fixpoint MM {T} (d: T) (sum : @vector T -> @vector T -> @vector T) + (mul: T -> T -> T) A B : matrix := match A,B with - | a :: A', b1 :: b2 => let m:= length b1 in + | a :: A', b1 :: b2 => let m:= length b1 in rowM d sum mul m a B :: MM d sum mul A' B | _, _ => [] end. (* floating-point matrix matrix multiplication. *) -Definition MMF {NAN : Nans} {t: type} : matrix -> matrix -> matrix := +Definition MMF {NAN : Nans} {t: type} : matrix -> matrix -> matrix := MM (Zconst t 0) (@vec_sumF NAN t) (@BMULT NAN t). (* real valued matrix matrix multiplication *) -Definition MMR : matrix -> matrix -> matrix := +Definition MMR : matrix -> matrix -> matrix := MM 0%R vec_sumR Rmult. -Goal MMR [[1;2;3] ;[1;2;3]; [1;2;3]] [[1;0;0]; [0;1;0]; [0;0;1]] = +Goal MMR [[1;2;3] ;[1;2;3]; [1;2;3]] [[1;0;0]; [0;1;0]; [0;0;1]] = [[1;2;3] ;[1;2;3]; [1;2;3]]. repeat (unfold MMR, MM, vec_sumR, vec_sum, map2; simpl; auto). repeat f_equal; field_simplify; nra. Qed. -Definition MMC {T} (dot : vector -> vector -> T) A B : matrix := +Definition MMC {T} (dot : vector -> vector -> T) A B : matrix := map (fun b => MV dot A b) B. Example checkMMC: let A:= trans 0%R 2 [[1;1];[1;1]] in MMC dotprodR [[1;2];[3;4]] A = trans 0%R 2 [[3;3];[7;7]]. -simpl. unfold dotprodR. simpl. repeat f_equal ;field_simplify; nra. Qed. +simpl. unfold dotprodR. simpl. repeat f_equal ;field_simplify; nra. Qed. Definition MMCR := MMC dotprodR. Definition MMCF {NAN : Nans} {t: type} := MMC (@dotprodF NAN t). @@ -227,14 +227,14 @@ Definition scaleMR := scaleM Rmult. Definition scaleMF {NAN : Nans} {t: type} := scaleM (@BMULT NAN t). -Definition GEMM {T} (dot : vector -> vector -> T) - (sum mul : T -> T -> T) (A B C: matrix) (a b : T) := +Definition GEMM {T} (dot : vector -> vector -> T) + (sum mul : T -> T -> T) (A B C: matrix) (a b : T) := mat_sum sum (scaleM mul a (MMC dot A B)) (scaleM mul b C). Definition GEMMR := GEMM dotprodR Rplus Rmult. -Definition GEMMF {NAN : Nans} {t: type} := +Definition GEMMF {NAN : Nans} {t: type} := GEMM dotprodF (@BPLUS NAN t) (@BMULT NAN t). - + End MVOpDefs. @@ -259,10 +259,10 @@ dotprodR u1 v - dotprodR u2 v = dotprodR (u1 -v u2) v. Proof. revert u1 u2. induction v. intros. rewrite !dotprodR_nil_r. nra. intros. -destruct u1. +destruct u1. simpl in H. symmetry in H. apply length_zero_iff_nil in H. subst. rewrite !dotprodR_nil_l. nra. -destruct u2; try discriminate. +destruct u2; try discriminate. unfold dotprodR. simpl. rewrite !fold_left_Rplus_Rplus. fold (@dotprodR u1 v). @@ -274,15 +274,15 @@ apply Rplus_eq_compat_l. rewrite IHv; auto. Qed. -Lemma map2_length {A B C: Type} (f: A -> B -> C) al bl : - length al = length bl -> +Lemma map2_length {A B C: Type} (f: A -> B -> C) al bl : + length al = length bl -> length (map2 f al bl) = length al. Proof. intros; unfold map2; rewrite map_length, combine_length, H, Nat.min_id; auto. Qed. Lemma map_mat_length {A B: Type} : forall (f : A -> B) (M : @matrix A) , length (map_mat f M) = length M. -Proof. intros; induction M; [simpl; auto | simpl; rewrite IHM; auto]. Qed. +Proof. intros; induction M; [simpl; auto | simpl; rewrite IHM; auto]. Qed. Lemma zero_matrix_length {A: Type} (m n: nat) (zero : A) : forall (Hn : (0 < n)%nat), @@ -291,18 +291,18 @@ Proof. revert n. induction m. unfold zero_matrix. auto. intros. specialize (IHm n Hn). simpl. destruct n. lia. simpl. lia. -Qed. +Qed. Lemma mvF_len {NAN : Nans} t m v: length (@mvF NAN t m v) = length m. Proof. induction m; simpl; auto. Qed. Lemma dotprodF_nil {NAN : Nans} {t: type} row : -dotprodF row [] = (Zconst t 0). -Proof. destruct row; simpl; auto. Qed. +dotprodF row [] = (Zconst t 0). +Proof. destruct row; simpl; auto. Qed. Lemma mvF_nil {NAN : Nans} {t: type} : forall m, @mvF NAN t m [] = zero_vector (length m) (Zconst t 0). -Proof. +Proof. intros; unfold mvF, MV. set (f:= (fun row : vector => dotprodF row [])). replace (map f m) with (map (fun _ => Zconst t 0) m). @@ -312,7 +312,7 @@ apply map_ext_in; intros. subst f; simpl. rewrite dotprodF_nil; auto. Qed. -Lemma mvR_nil : forall m, mvR m [] = zero_vector (length m) 0%R. +Lemma mvR_nil : forall m, mvR m [] = zero_vector (length m) 0%R. Proof. intros; unfold mvR, MV. set (f:= (fun row : vector => dotprodR row [])). @@ -323,7 +323,7 @@ apply map_ext_in; intros. subst f; simpl. rewrite dotprodR_nil_r; auto. Qed. -Lemma mat_sum_length {T: Type} (sum: T -> T -> T) : +Lemma mat_sum_length {T: Type} (sum: T -> T -> T) : forall (A B: matrix), forall (Hlen : length A = length B), length (mat_sum sum A B) = length A. @@ -341,16 +341,16 @@ Proof. revert i. induction m ; simpl; auto; destruct i; simpl ;auto. Qed. Lemma vec_sum_cons {T} (sum : T -> T -> T): forall (u v : @vector T) u0 v0, vec_sum sum (u0 :: u) (v0 :: v) = sum u0 v0 :: vec_sum sum u v. -Proof. -induction u; destruct v; -(intros; unfold vec_sum, map2; simpl; auto). +Proof. +induction u; destruct v; +(intros; unfold vec_sum, map2; simpl; auto). Qed. (* TODO: REMOVE *) -Lemma vec_sumR_cons : +Lemma vec_sumR_cons : forall (u v : vector) u0 v0, vec_sum Rplus (u0 :: u) (v0 :: v) = (u0 + v0) :: vec_sum Rplus u v. -Proof. +Proof. apply vec_sum_cons. Qed. @@ -359,13 +359,13 @@ Lemma vec_sum_zero {T} (sum : T -> T -> T) d: vec_sum sum v (zero_vector (length v) d) = v. Proof. intros; induction v; simpl; auto. -rewrite vec_sum_cons, IHv. +rewrite vec_sum_cons, IHv. rewrite Hsum; auto. Qed. Lemma vec_sum_zeroF {NAN : Nans} {t : type}: forall (v : vector), - map FT2R (vec_sumF v (zero_vector (length v) (Zconst t 0))) + map FT2R (vec_sumF v (zero_vector (length v) (Zconst t 0))) = map FT2R v. Proof. intros; induction v; auto. @@ -385,16 +385,16 @@ Lemma vec_sum_zeroR : vec_sumR v (zero_vector (length v) 0%R) = v. Proof. intros. -rewrite (vec_sum_zero Rplus); auto. +rewrite (vec_sum_zero Rplus); auto. intros; nra. Qed. -Lemma map_nil {A B: Type} (f : A -> B) : map f [] = []. +Lemma map_nil {A B: Type} (f : A -> B) : map f [] = []. Proof. simpl; auto. Qed. -Lemma mat_sumR_cons: +Lemma mat_sumR_cons: forall (A B: matrix) av bv, forall (Hlen : length A = length B), mat_sumR (av :: A) (bv :: B) = vec_sumR av bv :: mat_sumR A B. @@ -403,14 +403,14 @@ Proof. induction A; destruct B; (intros; unfold mat_sum, vec_sum, map2; simpl; a Lemma mat_sumR_zero: forall (B : matrix) (n : nat) (Hn : (0 length row = n), + (Hin : forall row, In row B -> length row = n), mat_sum Rplus B (zero_matrix (length B) n 0%R) = B. Proof. intros ? ? ? ?. induction B; auto. fold (mat_sumR (a :: B) (zero_matrix (length (a :: B)) n 0)). fold (mat_sumR B (zero_matrix (length B) n 0)) in IHB. -simpl. destruct n. lia. +simpl. destruct n. lia. rewrite mat_sumR_cons. rewrite <- IHB; [ f_equal | intros; apply Hin; simpl; auto]. rewrite <- vec_sum_zeroR; unfold vec_sumR; repeat f_equal. @@ -424,18 +424,18 @@ Lemma mat_sum_nil {A : Type} M (f: A -> A -> A) : Proof. destruct M; auto. Qed. Lemma zero_map_mat_length {A B: Type} : - forall (M : @matrix A) (z : B), length (zero_map_mat z M) = length M. + forall (M : @matrix A) (z : B), length (zero_map_mat z M) = length M. Proof. intros; induction M; [simpl; auto | simpl; rewrite IHM; auto ]. -Qed. +Qed. Lemma vec_sumR_bounds a b a' b': a' + b' :: vec_sumR a b = vec_sumR (a' :: a) (b' :: b). Proof. unfold vec_sumR; simpl; auto. Qed. Lemma vec_sumR_opp : -forall u v, -length u = length v -> +forall u v, +length u = length v -> vec_sum Rminus u v = vec_sum Rplus u (map Ropp v). Proof. intros ?. @@ -447,7 +447,7 @@ rewrite <- IHu; auto. Qed. Lemma vec_sumR_comm : -forall u v , +forall u v , length u = length v -> vec_sumR u v = vec_sumR v u. Proof. @@ -455,7 +455,7 @@ intros ?. induction u. { intros. simpl in H; symmetry in H; apply length_zero_iff_nil in H; subst; simpl; auto. } -intros; destruct v; auto. +intros; destruct v; auto. unfold vec_sumR; rewrite !vec_sumR_cons. fold (vec_sumR v u); fold (vec_sumR u v). @@ -464,7 +464,7 @@ simpl in H; auto. Qed. Lemma vec_sumR_assoc : -forall u v w, +forall u v w, length u = length v -> length w = length v -> vec_sumR (vec_sumR u v) w = vec_sumR u (vec_sumR v w). @@ -476,15 +476,15 @@ simpl; auto. } intros; destruct v; simpl; auto. destruct w; unfold vec_sumR; simpl; auto. unfold vec_sumR; rewrite !vec_sumR_cons. -fold (vec_sumR v w). -fold (vec_sumR u v). +fold (vec_sumR v w). +fold (vec_sumR u v). simpl in H, H0. -fold (vec_sumR (vec_sumR u v) w); +fold (vec_sumR (vec_sumR u v) w); rewrite IHu; [rewrite Rplus_assoc; auto | lia | lia ]. Qed. Lemma vec_sumR_minus : -forall u , +forall u , vec_sumR (map Ropp u) u = (zero_vector (length u) 0%R). Proof. intros; induction u. @@ -492,11 +492,11 @@ intros; induction u. unfold vec_sumR; simpl; rewrite !vec_sumR_cons. fold (vec_sumR (map Ropp u) u). rewrite IHu; f_equal; nra. -Qed. +Qed. Lemma vec_sum_length {A : Type} : -forall u v (f : A -> A -> A) , -length u = length v -> +forall u v (f : A -> A -> A) , +length u = length v -> length u = length (vec_sum f u v ). Proof. intros ?; induction u. @@ -505,12 +505,12 @@ intros; destruct v; simpl; auto. specialize (IHu v f); rewrite IHu. unfold vec_sum; auto. simpl in H; auto. -Qed. +Qed. Lemma vec_sum_length2 {A B: Type} (f : B -> B-> B) : -forall (u : list A) v w, -length u = length v -> -length v = length w -> +forall (u : list A) v w, +length u = length v -> +length v = length w -> length u = length (vec_sum f v w ). Proof. intros ?; @@ -524,7 +524,7 @@ specialize (IHu v w); rewrite IHu. unfold vec_sum; auto. simpl in H; auto. simpl in H; auto. -Qed. +Qed. Lemma nth_app_0 {T : Type} : forall (l0 l : list T), @@ -536,19 +536,19 @@ induction l0; auto. simpl. assert False by auto; contradiction. Qed. -Lemma matrix_index_nil {A} (i j: nat) (zero: A) : +Lemma matrix_index_nil {A} (i j: nat) (zero: A) : matrix_index [] i j zero = zero. Proof. unfold matrix_index. destruct i; destruct j; simpl; auto. Qed. Lemma vec_sumR_nth : forall j u a -(Hlen: length a = length u), +(Hlen: length a = length u), nth j u 0%R - nth j a 0%R = nth j (vec_sum Rminus u a) 0%R. Proof. induction j; destruct u; intros. { simpl; apply length_zero_iff_nil in Hlen; subst; simpl; nra. } -{ destruct a; try discriminate; auto. } -{ destruct a; simpl; [nra | try discriminate; auto]. } +{ destruct a; try discriminate; auto. } +{ destruct a; simpl; [nra | try discriminate; auto]. } destruct a; try discriminate; auto. assert (length a = length u) by (simpl in Hlen; lia); specialize (IHj u a H); @@ -564,15 +564,15 @@ Lemma nth_cons_mvR b B u : forall i, nth (S i) ( (b::B) *r u) = nth i (B *r u). Proof. intros; simpl; auto. Qed. -Lemma length_mvR_mvF {NANS : Nans} {t : type} : forall (m : @matrix (ftype t)) v, +Lemma length_mvR_mvF {NANS : Nans} {t : type} : forall (m : @matrix (ftype t)) v, length ((map_mat FT2R m) *r (map FT2R v)) = length (m *fr v). Proof. - intros. + intros. unfold mvR, mvF, MV, map_mat. rewrite !map_length; auto. Qed. -Lemma nth_vec_sum op : forall u1 u2 +Lemma nth_vec_sum op : forall u1 u2 (Hlen: length u2 = length u1) i (Hop : op 0 0 = 0), nth i (vec_sum op u1 u2) 0 = op (nth i u1 0) (nth i u2 0). @@ -585,11 +585,11 @@ simpl; destruct i; auto. rewrite <- IHu1; auto. Qed. -Lemma vec_sum_nth_plus : forall u1 u2 +Lemma vec_sum_nth_plus : forall u1 u2 (Hlen: length u2 = length u1) i, nth i (u1 +v u2) 0 = nth i u1 0 + nth i u2 0. Proof. -induction u1. intros. +induction u1. intros. rewrite length_zero_iff_nil in Hlen. subst. destruct i; simpl; ring. destruct u2; intros. @@ -622,69 +622,69 @@ Definition size_row {T} (A : list (list T)) m n := length A = m /\ forall a, In a A -> length a = n. -Lemma eq_size_cons {T1 T2} (a: list T1) (b: list T2) A B: +Lemma eq_size_cons {T1 T2} (a: list T1) (b: list T2) A B: eq_size (a :: A) (b :: B) -> eq_size A B /\ length a = length b. Proof. rewrite /eq_size => /=; intros. destruct H; repeat split; try lia. -intros; apply H0; by right. +intros; apply H0; by right. intros; apply H0; by left. Qed. Lemma eq_size_scaleM {T} mul (x : T) A n : - (forall a, In a A -> length a = n) -> + (forall a, In a A -> length a = n) -> forall y, In y (scaleM mul x A) -> length y = n. Proof. elim : A => //. -intros; destruct H1. +intros; destruct H1. rewrite -H1 -(H0 a). by rewrite !map_length. simpl; by left. -apply H => //. +apply H => //. intros; apply H0; simpl; by right. Qed. Lemma eq_size_trans {T1 T2 T3} (A : list (list T1)) - (B : list (list T2)) (C : list (list T3)) : + (B : list (list T2)) (C : list (list T3)) : eq_size A B -> eq_size B C -> eq_size A C. Proof. revert A B. -elim: C. -{ rewrite /eq_size/=; intros; split; -[lia|]; intros => //. } +elim: C. +{ rewrite /eq_size/=; intros; split; +[lia|]; intros => //. } move => c C IH A. -case: A. -{ rewrite /eq_size/=; intros; split; -[lia|]; intros => //. } +case: A. +{ rewrite /eq_size/=; intros; split; +[lia|]; intros => //. } move => a A B. -case: B. -{ rewrite /eq_size/=; intros; split; -[lia|]. destruct H0 => //. } +case: B. +{ rewrite /eq_size/=; intros; split; +[lia|]. destruct H0 => //. } move => b B. intros. have H1 : eq_size A C. destruct (eq_size_cons a b A B) => //. destruct (eq_size_cons b c B C) => //. -by apply (IH A B). +by apply (IH A B). move: H H0. rewrite /eq_size; intros; split; destruct H; destruct H0. by rewrite H -H0 . move => x y [|]Hx [|]Hy. { rewrite -Hx -Hy. -rewrite (H2 a b) => /=; try left => //. -rewrite -(H3 b c) => //=; by left. } -{ rewrite -Hx. +rewrite (H2 a b) => /=; try left => //. +rewrite -(H3 b c) => //=; by left. } +{ rewrite -Hx. rewrite (H2 a b) => /=; try left => //. rewrite -(H3 b y) => //=; [by left| by right]. } -rewrite -Hy. +rewrite -Hy. rewrite -(H3 b c) => /=; try left => //. rewrite -(H2 x b) => //=; [by right| by left]. -destruct H1. apply H4 => //. +destruct H1. apply H4 => //. Qed. Lemma eq_size_symm {T1 T2} (A : list (list T1)) - (B : list (list T2)) : + (B : list (list T2)) : eq_size A B -> eq_size B A. Proof. rewrite /eq_size. intros; destruct H; split => //. @@ -702,7 +702,7 @@ forall (A : Type) (M : gem_defs.matrix) (f : A -> A -> A), mat_sum f [::] M = [::]. Proof. by []. Qed. -Lemma in_zero_matrix_length m n a: +Lemma in_zero_matrix_length m n a: In a (zero_matrix m n 0%R) -> length a = n. Proof. move : a . elim: m => //=. move => m IH a. destruct n => //= . move => [H|H]. @@ -710,44 +710,44 @@ rewrite -H //=. by rewrite zero_vector_length. by apply IH. Qed. -Lemma dotprodR_dist a b v : -length a = length b -> +Lemma dotprodR_dist a b v : +length a = length b -> dotprodR (a +v b) v = (dotprodR a v + dotprodR b v)%R. Proof. move: a b. elim : v => //=. { intros. -rewrite! dotprodR_nil_r; nra. } -move => v0 v IH a. +rewrite! dotprodR_nil_r; nra. } +move => v0 v IH a. case : a => //=. -{ intros. +{ intros. symmetry in H. rewrite length_zero_iff_nil in H. -rewrite H. rewrite !dotprodR_nil_l; nra. } +rewrite H. rewrite !dotprodR_nil_l; nra. } move => a0 a b. case b => //=. -intros. -rewrite /dotprodR. simpl. +intros. +rewrite /dotprodR. simpl. rewrite !fold_left_Rplus_Rplus. specialize (IH a l). rewrite /dotprodR/vec_sumR/vec_sum/map2 in IH. rewrite IH; [|lia]. nra. Qed. -Lemma MVR_dist A B v : -forall (Hlen : forall a b, In a A -> In b B -> - length a = length b), +Lemma MVR_dist A B v : +forall (Hlen : forall a b, In a A -> In b B -> + length a = length b), (A +m B) *r v = (A *r v) +v (B *r v). Proof. move : A v. elim: B => //=. -{intros; rewrite /vec_sumR/vec_sum/map2/= +{intros; rewrite /vec_sumR/vec_sum/map2/= combine_nil map_nil /mat_sumR mat_sum_nil - /mvR/MV//=. } + /mvR/MV//=. } move => b B IH A. case : A => //=. move => a A v H. rewrite IH. clear IH. -rewrite /vec_sumR vec_sum_cons. +rewrite /vec_sumR vec_sum_cons. f_equal. set (y:= vec_sumR a b). fold (vec_sum Rplus a b). @@ -758,21 +758,21 @@ move => a0 b0 H1 H2. apply H; by right. Qed. -Lemma GEMM_nilC {T} (dot : vector -> vector -> T) - (sum mul : T -> T -> T) (A B : @gem_defs.matrix T) (x y : T) : +Lemma GEMM_nilC {T} (dot : vector -> vector -> T) + (sum mul : T -> T -> T) (A B : @gem_defs.matrix T) (x y : T) : GEMM dot sum mul A B [] x y = []. Proof. by rewrite /GEMM/scaleM mat_sum_nil. Qed. -Lemma GEMM_nilB {T} (dot : vector -> vector -> T) - (sum mul : T -> T -> T) (A C : @gem_defs.matrix T) (x y : T) : +Lemma GEMM_nilB {T} (dot : vector -> vector -> T) + (sum mul : T -> T -> T) (A C : @gem_defs.matrix T) (x y : T) : GEMM dot sum mul A [] C x y = []. Proof. by rewrite /GEMM/scaleM/MMC/=mat_sum_nil_l. Qed. -Lemma GEMM_cons {T} (dot : vector -> vector -> T) - (sum mul : T -> T -> T) +Lemma GEMM_cons {T} (dot : vector -> vector -> T) + (sum mul : T -> T -> T) (A B C : @gem_defs.matrix T) b c (x y : T) : let hd := vec_sum sum (scaleV mul x (MV dot A b)) (scaleV mul y c) in -GEMM dot sum mul A (b :: B) (c :: C) x y = +GEMM dot sum mul A (b :: B) (c :: C) x y = hd :: GEMM dot sum mul A B C x y. Proof. rewrite /GEMM/mat_sum -(vec_sum_cons) /vec_sum /scaleM//=. Qed. @@ -783,43 +783,43 @@ Proof. by []. Qed. Lemma scaleVR_dist : forall a u v, scaleVR a (u +v v) = scaleVR a u +v (scaleVR a v). Proof. -rewrite /scaleVR/scaleV/vec_sumR/vec_sum/map2/=. +rewrite /scaleVR/scaleV/vec_sumR/vec_sum/map2/=. intros. rewrite map_map/=. rewrite (combine_map' R R (Rmult a) (fun x : R * R => (a * (uncurry Rplus x))%R)) => //. intros; simpl; nra. Qed. -Lemma scaleMR_dist x A B: -length A = length B -> +Lemma scaleMR_dist x A B: +length A = length B -> scaleMR x (A +m B) = scaleMR x A +m scaleMR x B. -Proof. -revert A x. +Proof. +revert A x. elim: B => //. { intros. by rewrite /mat_sumR !mat_sum_nil /=. } move => b B IH A. -case: A => //. +case: A => //. move => a A /=. intros. -rewrite IH; try lia. +rewrite IH; try lia. rewrite mat_sumR_cons. rewrite -scaleVR_dist => //. rewrite !map_length; lia. Qed. -Lemma mat_sumR_assoc A B C: -eq_size A B -> eq_size B C -> +Lemma mat_sumR_assoc A B C: +eq_size A B -> eq_size B C -> (A +m B) +m C = A +m (B +m C). -Proof. -revert A B. +Proof. +revert A B. elim: C => //. { intros. by rewrite /mat_sumR !mat_sum_nil /=. } move => c C IH A. -case: A => //. +case: A => //. move => a A B /=. case: B => //. move => b B. intros. -have HA : length A = length B; +have HA : length A = length B; destruct H; simpl in H. lia. -have HC : length B = length C; +have HC : length B = length C; destruct H0; simpl in H0. lia. rewrite !mat_sumR_cons => //. rewrite IH. rewrite vec_sumR_assoc => //. @@ -833,19 +833,19 @@ by rewrite mat_sum_length. rewrite mat_sum_length => //. lia. Qed. -Lemma mat_sumR_comm A B : -eq_size A B -> +Lemma mat_sumR_comm A B : +eq_size A B -> (A +m B)= (B +m A). -Proof. -revert B. +Proof. +revert B. elim: A => //. { intros. by rewrite /mat_sumR !mat_sum_nil /=. } move => a A IH B. -case: B => //. +case: B => //. move => b B /=. intros. -have HA : length A = length B; +have HA : length A = length B; destruct H; simpl in H. lia. -have HB : eq_size A B +have HB : eq_size A B by apply (eq_size_cons a b A B). rewrite !mat_sumR_cons => //. rewrite IH => //. rewrite vec_sumR_comm => //. @@ -853,32 +853,32 @@ apply (H0 a b) => //=; by left. Qed. Lemma GEMMR_distC (A B C D: gem_defs.matrix ) (x y : R) : -(forall c, In c C -> length c = length A) -> +(forall c, In c C -> length c = length A) -> length C = length B -> -eq_size C D -> +eq_size C D -> GEMMR A B (C +m D) x y = (GEMMR A B C x y) +m (scaleMR y D). Proof. move : A B C. elim: D. { intros. rewrite /scaleMR/scaleM/=. -by rewrite /mat_sumR !mat_sum_nil/GEMMR GEMM_nilC. } -move => d D IH A B C. -case: C => //. -{ intros. destruct H1 => //. } -move => c C. +by rewrite /mat_sumR !mat_sum_nil/GEMMR GEMM_nilC. } +move => d D IH A B C. +case: C => //. +{ intros. destruct H1 => //. } +move => c C. case: B => //. -move => b B. intros. -simpl in H0. +move => b B. intros. +simpl in H0. rewrite mat_sumR_cons => //; try lia. rewrite /GEMMR !GEMM_cons. fold GEMMR vec_sumR scaleVR. -rewrite IH; try lia. rewrite scaleMR_cons mat_sumR_cons. -rewrite !(vec_sumR_assoc). -f_equal. f_equal. +rewrite IH; try lia. rewrite scaleMR_cons mat_sumR_cons. +rewrite !(vec_sumR_assoc). +f_equal. f_equal. by rewrite -scaleVR_dist. rewrite !map_length; -symmetry. by apply H; left. -rewrite !map_length. +symmetry. by apply H; left. +rewrite !map_length. destruct H1; by symmetry ;apply H2 => /=; left. rewrite !map_length combine_length !map_length. @@ -893,13 +893,13 @@ intros; apply H2 => /=; by right. destruct H1; simpl in H1; lia. Qed. -Lemma mat_sumR_scale_opp A n: - (0 < n) %nat -> - (forall a, In a A -> length a = n) -> +Lemma mat_sumR_scale_opp A n: + (0 < n) %nat -> + (forall a, In a A -> length a = n) -> A -m A = zero_matrix (length A) n 0%R. Proof. -elim : A . -{ intros. by rewrite /mat_sumR mat_sum_nil. } +elim : A . +{ intros. by rewrite /mat_sumR mat_sum_nil. } intros. rewrite mat_sumR_cons. rewrite H => //. rewrite {1}vec_sumR_comm. rewrite vec_sumR_minus. @@ -923,35 +923,35 @@ Lemma nth_mul' : forall (A : list (list R)) b i j nth j (nth i (map (fun a0 : R => map (Rmult a0) b) (map (hd 0%R) A)) []) 0%R)%R. Proof. move => A. elim: A => [b i j H| a A IH b i j Hj] /=. -destruct i; destruct j => /=; ring. +destruct i; destruct j => /=; ring. destruct i => /= //. -rewrite hd_nth => /=. +rewrite hd_nth => /=. rewrite (nth_map' (Rmult (nth 0 a 0%R)) 0%R 0%R j b) => //=. apply /ssrnat.ltP => //. specialize (IH b i j Hj). rewrite -IH => //. Qed. -Lemma rowM_nil_r {T: Type} sum mul (a : list T) d: +Lemma rowM_nil_r {T: Type} sum mul (a : list T) d: rowM d sum mul 0 a [] = []. Proof. elim: a => //. Qed. -Lemma rowM_nil_r0 {T: Type} sum mul (a : list T) d m: +Lemma rowM_nil_r0 {T: Type} sum mul (a : list T) d m: rowM d (vec_sum sum) mul m a [] = (zero_vector m d). Proof. elim: a => //=. Qed. (* The length of the vector and the matrix passed to rowM should be of equal length. This is enforced in theorem statements, not the definition *) -Lemma rowM_nil_l {T: Type} sum mul (B : list (list T)) d : +Lemma rowM_nil_l {T: Type} sum mul (B : list (list T)) d : rowM d (vec_sum sum) mul 0 [] B = []. Proof. elim: B => //=. Qed. -Lemma rowM_nil_l0 {T: Type} sum mul (B : list (list T)) d m: +Lemma rowM_nil_l0 {T: Type} sum mul (B : list (list T)) d m: rowM d (vec_sum sum) mul m [] B = (zero_vector m d). Proof. elim: B => //=. Qed. Lemma MM_nil_l {T : Type} (B: list (list T)) - sum mult d : + sum mult d : (@MM T d sum mult [::] B) = [::]. Proof. by []. Qed. @@ -959,14 +959,14 @@ Lemma MM_nil_r {T : Type} (A: list (list T)) sum mult d : MM d sum mult A [::] = []. Proof. case: A => //. Qed. -Lemma MM_length {T : Type} (A B: list (list T)) +Lemma MM_length {T : Type} (A B: list (list T)) sum mul d: -A <> [] -> B <> [] -> +A <> [] -> B <> [] -> length A = length (MM d sum mul A B). Proof. move: B. elim: A => //. move => a A H B. -case: B => //= [b B H1 H2]. +case: B => //= [b B H1 H2]. assert (A = [] \/ A <> []). clear H1 H. case: A. by left. move => a0 l. by right. destruct H0. @@ -974,35 +974,35 @@ rewrite H0 MM_nil_l //. rewrite (@H (b :: B)) //. Qed. -Lemma rowM_length {T : Type} v (B: list (list T)) +Lemma rowM_length {T : Type} v (B: list (list T)) sum mul d m: - (forall b, In b B -> length b = m) -> + (forall b, In b B -> length b = m) -> length (rowM d (vec_sum sum) mul m v B) = m. Proof. -move: v. +move: v. elim: B. intros. by case: v => //=; rewrite zero_vector_length. move => b B IH v H. -case: v => //=[|a l]. +case: v => //=[|a l]. by rewrite zero_vector_length. -specialize (IH l). +specialize (IH l). remember (rowM d (vec_sum sum) mul m l B) as u. rewrite /vec_sum/scaleV map_length combine_length map_length. rewrite H/=; [ | by left]. -rewrite IH; [lia | ]. +rewrite IH; [lia | ]. move => b0 Hb0. apply H => /=. by right. Qed. Lemma scaleM_length {T} (x : T) A n mul : -(forall a, In a A -> length a = n) -> +(forall a, In a A -> length a = n) -> forall a', In a' (scaleM mul x A) -> length a' = n. Proof. elim: A => //. move => a A. intros. -destruct H1. +destruct H1. rewrite -H1 !map_length. apply H0 => /=; by left. -apply H => //. +apply H => //. intros; apply H0 =>/=; by right. Qed. @@ -1011,8 +1011,8 @@ Lemma in_mul'_length : forall (A : list (list R)) b a0, (length A = length b) -> In a0 (mul' 0%R Rmult A b) -> length a0 = length b. Proof. -move => A b. move: A. -elim: b => /= [A a0 | ]. +move => A b. move: A. +elim: b => /= [A a0 | ]. rewrite /mul' /=. move => HA H. apply in_map_iff in H. elim H => x H1. elim H1 => H2 H3. rewrite -H2 //. @@ -1023,12 +1023,12 @@ apply in_map_iff in H. elim H => x H1. rewrite map_length //. Qed. -Lemma in_MM_length {T : Type} (A B: list (list T)) +Lemma in_MM_length {T : Type} (A B: list (list T)) sum mul d m: (forall b, In b B -> length b = m) -> forall v, In v (MM d (vec_sum sum) mul A B) -> length v = m. -Proof. -move: B m. +Proof. +move: B m. elim: A => // [a A IH B ]. case: B => // [b B m H1 v H2]. move: H2 => /=. move => [H2 | H2]. @@ -1038,34 +1038,34 @@ by rewrite -H2 Hb /= rowM_length. by apply (IH (b::B) m). Qed. -Lemma in_MMC_length {T : Type} (A B: list (list T)) +Lemma in_MMC_length {T : Type} (A B: list (list T)) sum mul m d: -length A = m -> +length A = m -> forall v, In v (MMC (dotprod mul sum d) A B) -> length v = m. -Proof. -move: A m . -elim: B => // . +Proof. +move: A m . +elim: B => // . move => b B IH A m H2 v/= [|]Hv. -rewrite -Hv !map_length => //. -apply (IH A m) => //. +rewrite -Hv !map_length => //. +apply (IH A m) => //. Qed. - -Lemma in_MM {T : Type} (A B: list (list T)) + +Lemma in_MM {T : Type} (A B: list (list T)) a sum mul d x: In x (MM d (vec_sum sum) mul A B) -> In x (MM d (vec_sum sum) mul (a :: A) B). Proof. -move: x a B. case: A => //. +move: x a B. case: A => //. move => a0 A x a B. case : B => //. -move => b B /= [H1|H1]. +move => b B /= [H1|H1]. by right; left. by right; right. Qed. -Lemma in_MM2 {T : Type} (A B: list (list T)) +Lemma in_MM2 {T : Type} (A B: list (list T)) a sum mul d x: In x (MM d (vec_sum sum) mul A B) -> In x (MM d (vec_sum sum) mul (a :: A) B) \/ x = a. @@ -1077,7 +1077,7 @@ by left; right; right. Qed. Lemma is_finite_mat_cons {NAN : Nans} {t : type} a A: -is_finite_mat (a :: A) -> +is_finite_mat (a :: A) -> (@is_finite_mat t A /\ is_finite_vec a). Proof. rewrite /is_finite_mat !Forall_forall /=. @@ -1087,7 +1087,7 @@ apply H1. by left. Qed. Lemma is_finite_mat_cons2 {NAN : Nans} {t : type} a A: -@is_finite_mat t A -> is_finite_vec a -> is_finite_mat (a :: A). +@is_finite_mat t A -> is_finite_vec a -> is_finite_mat (a :: A). Proof. rewrite /is_finite_mat !Forall_forall /=. move => Hx Ha [ H| x0 x [H|H]] //=. @@ -1099,28 +1099,28 @@ Lemma in_zero_vec {NAN : Nans} {t : type} m x: In x (zero_vector m (Zconst t 0)) -> x = (Zconst t 0). Proof. elim: m => //=; -move => [_ [|]| [_ [|]| _ _ [|] ] ] //=. +move => [_ [|]| [_ [|]| _ _ [|] ] ] //=. Qed. -Lemma is_finite_vec_cons {NAN : Nans} {t : type} v0 v : - @is_finite_vec t (v0 :: v) -> +Lemma is_finite_vec_cons {NAN : Nans} {t : type} v0 v : + @is_finite_vec t (v0 :: v) -> is_finite_vec v /\ Binary.is_finite _ _ v0. Proof. -rewrite /is_finite_vec +rewrite /is_finite_vec !Forall_forall/=; intros; split; intros; apply H. by right. by left. Qed. -Lemma is_finite_vec_sum {NAN : Nans} {t : type} u v : +Lemma is_finite_vec_sum {NAN : Nans} {t : type} u v : length u = length v -> -@is_finite_vec t (vec_sumF u v) -> +@is_finite_vec t (vec_sumF u v) -> @is_finite_vec t u /\ @is_finite_vec t v. Proof. move: v. elim: u => //=. { move => v H. symmetry in H. -rewrite length_zero_iff_nil in H. by rewrite H. } +rewrite length_zero_iff_nil in H. by rewrite H. } move => u0 u IH v. -case: v => //. +case: v => //. rewrite /vec_sumF/vec_sum/map2/=. move => v0 v H H1. apply is_finite_vec_cons in H1. @@ -1128,44 +1128,44 @@ elim: H1. fold (map2 (@BPLUS NAN t) u v). fold (vec_sum (@BPLUS NAN t)). fold (@vec_sumF NAN t). -move => H1 H2. -rewrite /is_finite_vec +move => H1 H2. +rewrite /is_finite_vec !Forall_forall/=; intros; split. { move => x [|] Hx. have : (Binary.is_finite _ _ (BPLUS u0 v0)) = true. - apply H2; left => //. rewrite -Hx. - destruct u0; destruct v0; + apply H2; left => //. rewrite -Hx. + destruct u0; destruct v0; destruct s; destruct s0 => //=. have : is_finite_vec u. apply (IH v) => //. lia. rewrite /is_finite_vec !Forall_forall/=; intros. - apply H0 => //. } + apply H0 => //. } { move => x [|] Hx. have : (Binary.is_finite _ _ (BPLUS u0 v0)) = true. - apply H2; left => //. rewrite -Hx. - destruct u0; destruct v0; + apply H2; left => //. rewrite -Hx. + destruct u0; destruct v0; destruct s; destruct s0 => //=. have : is_finite_vec v. apply (IH v) => //. lia. rewrite /is_finite_vec !Forall_forall/=; intros. - apply H0 => //. } + apply H0 => //. } Qed. -Lemma is_finite_scaleV {NAN : Nans} {t : type} a0 a : +Lemma is_finite_scaleV {NAN : Nans} {t : type} a0 a : is_finite_vec (scaleV BMULT a0 a) -> @is_finite_vec t a . Proof. rewrite /is_finite_vec !Forall_forall /scaleV //. intros. pose proof in_map (@BMULT NAN t a0) a x H0. specialize (H (BMULT a0 x) H1). -destruct x; destruct a0 => //. +destruct x; destruct a0 => //. Qed. -Lemma is_finite_scaleV' {NAN : Nans} {t : type} a0 a : -a <> [] -> +Lemma is_finite_scaleV' {NAN : Nans} {t : type} a0 a : +a <> [] -> @is_finite_vec t (scaleV BMULT a0 a) -> Binary.is_finite _ _ a0. Proof. -move: a0. case: a => //. -move => a0 a a1 H. +move: a0. case: a => //. +move => a0 a a1 H. rewrite /is_finite_vec !Forall_forall //=. intros. have : @Binary.is_finite _ _ (BMULT a1 a0) = true. @@ -1175,8 +1175,8 @@ Qed. Lemma is_finite_rowM {NAN : Nans} {t : type} a B m - (Hm: (0 < m)%nat) (Hb :forall b, In b B -> length b = m) - (Hlen: length a = length B) : + (Hm: (0 < m)%nat) (Hb :forall b, In b B -> length b = m) + (Hlen: length a = length B) : is_finite_vec (rowM (Zconst t 0) vec_sumF BMULT m a B) -> is_finite_vec a. Proof. @@ -1185,14 +1185,14 @@ elim: a => //. { intros; rewrite /is_finite_vec Forall_forall //=. } move => a l IH B. move: a l IH. case: B => //. move => b B a0 a IH H1 H2 H3. -have Hb: b <> []. - rewrite /not. intros. +have Hb: b <> []. + rewrite /not. intros. apply length_zero_iff_nil in H. specialize (H1 b) => //=. rewrite H1 in H. rewrite H in Hm => //. simpl. by left. simpl in H3. apply is_finite_vec_sum in H3. - elim: H3. move => H3 H4. + elim: H3. move => H3 H4. rewrite /is_finite_vec Forall_forall //=. move => x [Hx | Hx]. rewrite -Hx. apply (is_finite_scaleV' a0 b) in H3 => //. @@ -1202,7 +1202,7 @@ suff : is_finite_vec a. rewrite /is_finite_vec Forall_forall //=. move => Ha. by apply Ha. apply (IH B) => //. -move => b0 Hb0. apply H1 => /=. by right. +move => b0 Hb0. apply H1 => /=. by right. rewrite map_length rowM_length. apply H1 => /=. by left. move => b0 Hb0. apply H1 => /=. by right. @@ -1218,8 +1218,8 @@ Lemma in_MMF_finite' {NAN : Nans} {t : type} A B m is_finite_mat (MMF A B) -> @is_finite_mat t A. Proof. move: B HB Hb Hlen. -elim: A => //. -move => a A IH B. +elim: A => //. +move => a A IH B. case: B => //=. move => b B. intros. rewrite /MMF/= in H. apply is_finite_mat_cons in H. @@ -1230,12 +1230,12 @@ apply is_finite_mat_cons2 => //. apply (IH (b ::B)) => //. move => x Hx. apply Hlen. by right. apply is_finite_rowM in H2 => //. -by rewrite Hb'. by rewrite Hb'. -move => b0 /=. move => Hb0. +by rewrite Hb'. +move => b0 /=. move => Hb0. by rewrite Hb'; apply Hb. by apply Hlen; left. -move => b0 /=. move => Hb0. +move => b0 /=. move => Hb0. by rewrite Hb'; apply Hb. by apply Hlen; left. Qed. @@ -1246,69 +1246,69 @@ Lemma in_MMF_finite {NAN : Nans} {t : type} A B m (Hm : (0 < m)%nat) (Hb :forall b, In b B -> length b = m) (Hlen : forall x, In x A -> length x = length B): -(forall x : vector, In x (MMF A B) -> - is_finite_vec x) -> +(forall x : vector, In x (MMF A B) -> + is_finite_vec x) -> forall a0, In a0 A -> @is_finite_vec t a0. Proof. move: A Hlen HB Hb. -case: B => //. -move => b B A. move: B b. -elim : A => //. +case: B => //. +move => b B A. move: B b. +elim : A => //. rewrite /MMF/=. intros. elim: H1; intros. have Hb' : length b = m by apply Hb; left. rewrite -H1. -remember (rowM (Zconst t 0) vec_sumF BMULT +remember (rowM (Zconst t 0) vec_sumF BMULT (Datatypes.length b) a (b :: B)) as u. have Hu : is_finite_vec u. by apply H0; left. apply (is_finite_rowM a (b::B) - (length b)). + (length b)). by rewrite Hb'. -move => b0 /=. move => Hb0. +move => b0 /=. move => Hb0. by rewrite Hb'; apply Hb. by apply Hlen; left. by apply H0; left. -apply (H B b) => //. +apply (H B b) => //. move => x Hx. by apply Hlen; right. move => x Hx. by apply H0; right. Qed. -Lemma is_finite_vec_cons2 {NAN : Nans} {t} a0 (a : list (ftype t)) : - Binary.is_finite _ _ a0 = true -> +Lemma is_finite_vec_cons2 {NAN : Nans} {t} a0 (a : list (ftype t)) : + Binary.is_finite _ _ a0 = true -> is_finite_vec a -> is_finite_vec (a0 :: a). Proof. -rewrite /is_finite_vec !Forall_forall; intros. +rewrite /is_finite_vec !Forall_forall; intros. destruct H1; subst => //. by apply H0. Qed. -Lemma is_finite_vec_mapBPLUS {NAN : Nans} {t} (a : list (ftype t)) b : -length a = length b -> -is_finite_vec (map (uncurry BPLUS) (combine a b)) -> +Lemma is_finite_vec_mapBPLUS {NAN : Nans} {t} (a : list (ftype t)) b : +length a = length b -> +is_finite_vec (map (uncurry BPLUS) (combine a b)) -> is_finite_vec a /\ is_finite_vec b. Proof. move : a. elim: b => //. { intros. -rewrite length_zero_iff_nil in H; subst => //. } +rewrite length_zero_iff_nil in H; subst => //. } move => b0 b IH a. case : a => //. intros. simpl in H. simpl in H0. apply is_finite_vec_cons in H0. destruct H0. intros; split; apply is_finite_vec_cons2. -destruct a; destruct b0; destruct s; destruct s0; simpl; auto. +destruct a; destruct b0; destruct s; destruct s0; simpl; auto. apply IH => //; lia. -destruct a; destruct b0; destruct s; destruct s0; simpl; auto. +destruct a; destruct b0; destruct s; destruct s0; simpl; auto. apply (IH l) => //; lia. Qed. -Lemma is_finite_scaleM {NAN : Nans} {t : type} x A : +Lemma is_finite_scaleM {NAN : Nans} {t : type} x A : is_finite_mat (scaleM BMULT x A) -> @is_finite_mat t A . Proof. rewrite /is_finite_mat !Forall_forall /scaleM //. -intros. pose proof in_map ( map (BMULT x) ) A x0 H0. +intros. pose proof in_map ( map (BMULT x) ) A x0 H0. specialize (H (map (BMULT x) x0) H1). destruct A; destruct x0 => //. simpl in H; apply is_finite_vec_cons in H; destruct H. @@ -1317,16 +1317,16 @@ destruct x; destruct b; destruct s; destruct s0 => //. by apply (is_finite_scaleV x). Qed. -Lemma is_finite_mat_sum {NAN : Nans} {t} -(A B : @gem_defs.matrix (ftype t)) : -eq_size A B -> +Lemma is_finite_mat_sum {NAN : Nans} {t} +(A B : @gem_defs.matrix (ftype t)) : +eq_size A B -> is_finite_mat (mat_sumF A B) -> is_finite_mat A /\ is_finite_mat B. Proof. move : A. elim: B. -{ move => A. +{ move => A. rewrite /mat_sumF mat_sum_nil. move => H. destruct H => //. -rewrite length_zero_iff_nil in H; subst => //. } +rewrite length_zero_iff_nil in H; subst => //. } move => b B IH A. case: A => //. { intros. destruct H => //. } rewrite /mat_sumF/mat_sum/map2/=. @@ -1334,7 +1334,7 @@ move => a A. intros. apply eq_size_cons in H; destruct H. pose proof (IH A H). apply is_finite_mat_cons in H0. -destruct H0. +destruct H0. have HA: is_finite_mat A. apply H2 => //. have HB: is_finite_mat B. apply H2 => //. split. @@ -1342,8 +1342,8 @@ all: (apply is_finite_mat_cons2 => //; apply is_finite_vec_mapBPLUS in H3; destruct H3 => //). Qed. -Lemma eq_size_scale {T} (x : T) A mul n: - (forall a, In a A -> length a = n) -> +Lemma eq_size_scale {T} (x : T) A mul n: + (forall a, In a A -> length a = n) -> eq_size (scaleM mul x A) A. Proof. rewrite /eq_size; split. @@ -1357,16 +1357,15 @@ End MMLems. Section GenLems. -Lemma in_FT2R_map {t} (A : list (list (ftype t))) x m: - (forall y, In y A -> length y = m) -> +Lemma in_FT2R_map {t} (A : list (list (ftype t))) x m: + (forall y, In y A -> length y = m) -> In x (map_mat FT2R A) -> length x = m. Proof. -move => Ha Hin. +move => Ha Hin. apply in_map_iff in Hin. destruct Hin. destruct H. rewrite -H map_length. by apply Ha. Qed. -End GenLems. - \ No newline at end of file +End GenLems. diff --git a/accuracy_proofs/gemm_acc.v b/accuracy_proofs/gemm_acc.v index b9b0d44..eeab684 100644 --- a/accuracy_proofs/gemm_acc.v +++ b/accuracy_proofs/gemm_acc.v @@ -20,7 +20,7 @@ Delimit Scope R_scope with Re. Import Order.TTheory GRing.Theory Num.Def Num.Theory. -Section MMERROR. +Section MMERROR. (* forward error matrix multiplication *) Context {NAN: Nans} {t : type}. @@ -41,21 +41,21 @@ Hypothesis Hfin: is_finite_mat (MMCF A B). Theorem MMC_error: exists (E eta: matrix), map_mat FT2R (MMCF A B) = MMCR Ar Br +m E +m eta - /\ (forall k , (k < p)%nat-> + /\ (forall k , (k < p)%nat-> exists (E0 : matrix) , (* the p elements of E are cols of length m *) - List.nth k E [] = E0 *r (List.nth k Br []) /\ + List.nth k E [] = E0 *r (List.nth k Br []) /\ (* the m elements of E0 are rows of length n *) (forall i j, (i < m)%nat -> (j < n)%nat -> Rabs (E0 _(i,j)) <= g n * Rabs (Ar _(i,j)))) - /\ (forall i j, (i < p)%nat -> (j < m)%nat -> - Rabs (eta _(i,j)) <= g1 n n) + /\ (forall i j, (i < p)%nat -> (j < m)%nat -> + Rabs (eta _(i,j)) <= g1 n n) /\ size_col E m p /\ size_col eta m p. Proof. -revert Hfin Hn Hp. revert A n. +revert Hfin Hn Hp. revert A n. elim: B. -{ rewrite /MMCF/MMCR/MMC/MV. +{ rewrite /MMCF/MMCR/MMC/MV. exists [],[]. repeat split => //=. } clear B. move => b B IH A. intros => /=. destruct (mat_vec_mul_mixed_error A b) as @@ -65,45 +65,45 @@ destruct (mat_vec_mul_mixed_error A b) as by rewrite Hp => //=; left. } rewrite Heq1. rewrite CommonSSR.map_map_equiv. -rewrite MVR_dist. -destruct (IH A n) as +rewrite MVR_dist. +destruct (IH A n) as (E' & eta' & Heq & HE' & Heta' & H3 & H4). { apply is_finite_mat_cons in Hfin; by destruct Hfin. } -{ move => x Hx. -by apply Hn. } -{ move => x Hx. +{ move => x Hx. +by apply Hn. } +{ move => x Hx. by apply Hp; right. } rewrite Heq. clear IH. have Hb : length b = n. rewrite Hp => //=; by left. destruct H1; destruct H3; destruct H4. -exists +exists ((E *r List.map FT2R b) :: E'), (eta :: eta'); repeat split => /=; try lia. { intros. rewrite /matrix_index. destruct k => //=. exists E ; split => //. -rewrite Hb in HE. by apply HE. +rewrite Hb in HE. by apply HE. have Hk : is_true (k < p)%nat by lia. -destruct (HE' k Hk) as (E0 & Heq2 & HE0). +destruct (HE' k Hk) as (E0 & Heq2 & HE0). exists E0; split => //. } { intros. rewrite /matrix_index. -destruct i => /=. -rewrite Hb in Heta. +destruct i => /=. +rewrite Hb in Heta. apply Heta. apply nth_In; rewrite H2 => //; lia. apply Heta' => //. } -{ move => x [|] Hx. -rewrite -Hx. +{ move => x [|] Hx. +rewrite -Hx. by rewrite !map_length. -by apply H3. } -{ move => x [|] Hx. -by rewrite -Hx. -by apply H5. } +by apply H3. } +{ move => x [|] Hx. +by rewrite -Hx. +by apply H5. } move => a b0 Ha Hb0. destruct H1. -apply in_map_iff in Ha. +apply in_map_iff in Ha. destruct Ha as (x & Hx &Hx'). rewrite -Hx map_length. symmetry; apply (H0 b0 x Hb0 Hx'). @@ -131,11 +131,11 @@ Notation Ar := (map_mat FT2R A). Theorem scaleM_error: exists (E eta: matrix), map_mat FT2R (scaleMF x A) = scaleMR (FT2R x) (Ar +m E) +m eta - /\ (forall i j, (i < m)%nat -> (j < n)%nat -> - Rabs (E _(i,j)) <= g n * Rabs (Ar _(i,j))) - /\ (forall i j, (i < m)%nat -> (j < n)%nat -> - Rabs (eta _(i,j)) <= g1 n n) - /\ eq_size E A + /\ (forall i j, (i < m)%nat -> (j < n)%nat -> + Rabs (E _(i,j)) <= g n * Rabs (Ar _(i,j))) + /\ (forall i j, (i < m)%nat -> (j < n)%nat -> + Rabs (eta _(i,j)) <= g1 n n) + /\ eq_size E A /\ eq_size eta A. Proof. revert Hfin Hp. revert x n. @@ -143,75 +143,75 @@ elim: A => /=. { intros. exists [], [] => //. } clear A. move => a A IH; intros. destruct (IH x n) as (E & eta & Heq & IH'); clear IH. -{ move: Hfin. apply is_finite_mat_cons. } +{ move: Hfin. apply is_finite_mat_cons. } { by intros; apply Hp; right. } -rewrite Heq. clear Heq. -destruct (scaleV_mixed_error a x) as +rewrite Heq. clear Heq. +destruct (scaleV_mixed_error a x) as (e & eta1 & Heq & HE & HF). -{ move: Hfin. apply is_finite_mat_cons. } +{ move: Hfin. apply is_finite_mat_cons. } rewrite !CommonSSR.map_map_equiv/= in Heq. rewrite Heq; clear Heq. have Ha : length a = n by apply Hp; left. destruct IH' as (IH1 & IH2). destruct IH2 as (IH2 & IH3 & IH4). exists (e :: E), (eta1 :: eta); - repeat split => //. + repeat split => //. { intros. rewrite /matrix_index. destruct i => /=. destruct (HE j) as (del & Heq & HE'). rewrite Ha. lia. rewrite Heq !CommonSSR.map_map_equiv. -rewrite Rabs_mult Rmult_comm -Ha. +rewrite Rabs_mult Rmult_comm -Ha. apply ler_pmul => //; apply /RleP; try apply Rabs_pos. -apply IH1; lia. } +apply IH1; lia. } { intros. rewrite /matrix_index. destruct i => /=. -rewrite -Ha. +rewrite -Ha. destruct HF as (HF & HF1& HF2). apply (HF (List.nth j eta1 0%Re)). apply nth_In. rewrite HF2 Ha; lia. -apply IH2; lia. } -{ rewrite /eq_size in IH3. +apply IH2; lia. } +{ rewrite /eq_size in IH3. destruct IH3 as ( H & _). -simpl; by rewrite H. } -{ move => x0 y0 [|]Hx [|]Hy. -rewrite -Hx -Hy. +simpl; by rewrite H. } +{ move => x0 y0 [|]Hx [|]Hy. +rewrite -Hx -Hy. destruct HF as (_ & HF & _) => //. rewrite -Hx. rewrite Hp. -destruct HF as (_ & HF & _); lia. +destruct HF as (_ & HF & _); lia. by right. rewrite -Hy. -destruct IH3. +destruct IH3. destruct E => //. have Hz : (0 < m)%coq_nat by (simpl in H; lia). -rewrite (H0 x0 (List.nth 0 A [])). +rewrite (H0 x0 (List.nth 0 A [])). rewrite Hp => //. right. -apply nth_In; apply Hz. +apply nth_In; apply Hz. apply Hx. by apply nth_In. -destruct IH3 as (_ & IH3). -apply IH3 => //. } +destruct IH3 as (_ & IH3). +apply IH3 => //. } { simpl. destruct IH4 as (IH4 & _); lia. } -{ move => x0 y0 [|]Hx [|]Hy. -rewrite -Hx -Hy. +{ move => x0 y0 [|]Hx [|]Hy. +rewrite -Hx -Hy. destruct HF as (_ & _ & HF) => //. rewrite -Hx. rewrite Hp. -destruct HF as (_ & _ & HF); lia. +destruct HF as (_ & _ & HF); lia. by right. rewrite -Hy. -destruct IH4. +destruct IH4. destruct eta => //. have Hz : (0 < m)%coq_nat by (simpl in H; lia). -rewrite (H0 x0 (List.nth 0 A [])). +rewrite (H0 x0 (List.nth 0 A [])). rewrite Hp => //. right. by apply nth_In. apply Hx. apply nth_In; apply Hz. -destruct IH4 as (_ & IH4). +destruct IH4 as (_ & IH4). apply IH4 => //. } Qed. End SCALE_M_ERROR. -Section SMMERROR. +Section SMMERROR. (* forward error matrix multiplication *) Context {NAN: Nans} {t : type}. @@ -232,18 +232,18 @@ Hypothesis Hfin: is_finite_mat (scaleMF x (MMCF A B)). Theorem sMMC_error: exists (E1 E eta1 eta: matrix), - map_mat FT2R (scaleMF x (MMCF A B)) = + map_mat FT2R (scaleMF x (MMCF A B)) = scaleMR xr (((MMCR Ar Br +m E1) +m eta1) +m E) +m eta - /\ (forall k , (k < p)%nat-> + /\ (forall k , (k < p)%nat-> exists (E0 : matrix) , (* the p elements of E are cols of length m *) - List.nth k E1 [] = E0 *r (List.nth k Br []) /\ + List.nth k E1 [] = E0 *r (List.nth k Br []) /\ (* the m elements of E0 are rows of length n *) (forall i j, (i < m)%nat -> (j < n)%nat -> Rabs (E0 _(i,j)) <= g n * Rabs (Ar _(i,j)))) - /\ (forall i j, (i < p)%nat -> (j < m)%nat -> - Rabs (eta1 _(i,j)) <= g1 n n) - /\ forall i j : nat,(i < p)%nat -> (j < m)%nat -> + /\ (forall i j, (i < p)%nat -> (j < m)%nat -> + Rabs (eta1 _(i,j)) <= g1 n n) + /\ forall i j : nat,(i < p)%nat -> (j < m)%nat -> Rabs (matrix_index eta1 i j 0%Re) <= g1 n n /\ forall i j : nat, (i < p)%nat -> (j < m)%nat -> Rabs (matrix_index E i j 0%Re) <= @@ -260,8 +260,8 @@ apply Hfin. rewrite Heq. destruct (MMC_error A B n) as (E1 & eta1 & Heq1 & HE1 & Heta1 & H3 & H4). -by intros; apply Hn. -by intros; apply Hp. +by intros; apply Hn. +by intros; apply Hp. by apply (is_finite_scaleM x). rewrite Heq1. exists E1, E, eta1, eta; split => //. @@ -272,7 +272,7 @@ apply Heta1 => //. split => //. rewrite !map_length in HE. rewrite Heq1 in HE. -apply HE => //. +apply HE => //. Qed. End SMMERROR. @@ -299,37 +299,37 @@ Notation Br := (map_mat FT2R B). Theorem mat_sum_error: exists (EA EB: matrix), map_mat FT2R (mat_sumF A B) = mat_sumR (Ar +m EA) (Br +m EB) - /\ (forall i j, (i < m)%nat -> (j < n)%nat -> + /\ (forall i j, (i < m)%nat -> (j < n)%nat -> exists d, (EA _(i,j)) = (Ar _(i,j)) * d /\ - Rabs d <= @default_rel t) - /\ (forall i j, (i < m)%nat -> (j < n)%nat -> + Rabs d <= @default_rel t) + /\ (forall i j, (i < m)%nat -> (j < n)%nat -> exists d, (EB _(i,j)) = (Br _(i,j)) * d /\ Rabs d <= @default_rel t) - /\ eq_size EA A + /\ eq_size EA A /\ eq_size EB A . Proof. revert HA Hfin Hn. revert n B. -elim : A. +elim : A. { intros. exists [], [] => //=. } clear A; move => a A IH n B. case: B => //. { by intros; destruct HA. } clear B. move => b B. intros. -destruct (IH n B) as +destruct (IH n B) as (EA & EB & HEQ & IH1 & IH2 & IH3 & IH4); clear IH. -{ by apply (eq_size_cons a b). } -{ move : Hfin. +{ by apply (eq_size_cons a b). } +{ move : Hfin. rewrite /mat_sumF/mat_sum/map2/=. apply is_finite_mat_cons. } { intros; apply Hn => /=; by right. } simpl. rewrite HEQ. clear HEQ. destruct (vec_sumF_mixed_error a b) as (e1 & e2 & Heq & He1 & He2 & He). -{ move : Hfin. +{ move : Hfin. rewrite /mat_sumF/mat_sum/map2/=. apply is_finite_mat_cons. } -{ by apply (eq_size_cons a b A B). } +{ by apply (eq_size_cons a b A B). } have Hb : length b = n. { apply eq_size_cons in HA. destruct HA as (_ & HA'). @@ -343,8 +343,8 @@ destruct i => /=. destruct (He1 j) as (del & Heq & HE'). rewrite Hb. lia. rewrite Heq !CommonSSR.map_map_equiv. -by exists del; split. -apply IH1; lia. } +by exists del; split. +apply IH1; lia. } { intros. rewrite /matrix_index. destruct i => /=. destruct (He2 j) as (del & Heq & HE'). @@ -353,31 +353,31 @@ rewrite Heq !CommonSSR.map_map_equiv. exists del => //. apply IH2; lia. } (* remaining is reasoning about lengths *) -{ rewrite /eq_size in IH3. +{ rewrite /eq_size in IH3. destruct IH3 as ( H & _). -simpl; by rewrite H. } -{ move => x0 y0 [|]Hx [|]Hy. -rewrite -Hx -Hy. +simpl; by rewrite H. } +{ move => x0 y0 [|]Hx [|]Hy. +rewrite -Hx -Hy. destruct He => //. rewrite -Hx. rewrite Hn. -destruct He as (He & _); - rewrite He. apply Hn => /=; -by left. +destruct He as (He & _); + rewrite He. apply Hn => /=; +by left. by simpl; right. rewrite -Hy. rewrite Hn. -destruct IH3. +destruct IH3. destruct EA => //. have Hz : (0 < m)%coq_nat by (simpl in H; lia). -rewrite (H0 x0 (List.nth 0 A [])). +rewrite (H0 x0 (List.nth 0 A [])). rewrite Hn => //. right. -apply nth_In; apply Hz. +apply nth_In; apply Hz. apply Hx. by apply nth_In. simpl; by left. -destruct IH3 as (_ & IH3). -apply IH3 => //. } +destruct IH3 as (_ & IH3). +apply IH3 => //. } { simpl. destruct IH4 as (IH4 & _); lia. } -{ move => x0 y0 [|]Hx [|]Hy. -rewrite -Hx -Hy. +{ move => x0 y0 [|]Hx [|]Hy. +rewrite -Hx -Hy. destruct He => //. rewrite H0. rewrite Hb. symmetry; apply Hn => /=. by left. @@ -385,10 +385,10 @@ rewrite -Hx. rewrite Hn. destruct He; lia. simpl; by right. rewrite -Hy. -destruct IH4. +destruct IH4. destruct EB => //. have Hz : (0 < m)%coq_nat by (simpl in H; lia). -rewrite (H0 x0 (List.nth 0 A [])) => //. +rewrite (H0 x0 (List.nth 0 A [])) => //. rewrite Hn => //. symmetry; apply Hn. simpl; by left. @@ -396,7 +396,7 @@ simpl; right. by apply nth_In. by apply nth_In. destruct IH4 as (_ & IH4). -apply IH4 => //. } +apply IH4 => //. } Qed. @@ -426,8 +426,8 @@ Notation Br := (map_mat FT2R B). Theorem mat_axpby_error: exists (EA EB ea eb eta1 eta2: matrix), - map_mat FT2R (mat_sumF (scaleMF x A) (scaleMF y B)) = - mat_sumR (scaleMR (FT2R x) (Ar +m EA) +m eta1 +m ea) + map_mat FT2R (mat_sumF (scaleMF x A) (scaleMF y B)) = + mat_sumR (scaleMR (FT2R x) (Ar +m EA) +m eta1 +m ea) (scaleMR (FT2R y) (Br +m EB) +m eta2 +m eb) /\ (forall i j : nat, (i < m)%nat -> (j < n)%nat -> Rabs (matrix_index EA i j 0%R) <= @@ -438,7 +438,7 @@ Theorem mat_axpby_error: /\ (forall i j : nat, (i < m)%nat -> (j < n)%nat -> exists d, matrix_index ea i j 0%R = - matrix_index (scaleMR (FT2R x) (Ar +m EA) +m eta1) i j 0%R * d + matrix_index (scaleMR (FT2R x) (Ar +m EA) +m eta1) i j 0%R * d /\ Rabs d <= @default_rel t) /\ (forall i j : nat, (i < m)%nat -> (j < n)%nat -> exists d, @@ -449,45 +449,45 @@ Theorem mat_axpby_error: Rabs (matrix_index eta1 i j 0%Re) <= g1 n n) /\ (forall i j : nat, (i < m)%nat -> (j < n)%nat -> Rabs (matrix_index eta2 i j 0%Re) <= g1 n n) - /\ eq_size EA A - /\ eq_size EB A - /\ eq_size ea A - /\ eq_size eb A - /\ eq_size eta1 A + /\ eq_size EA A + /\ eq_size EB A + /\ eq_size ea A + /\ eq_size eb A + /\ eq_size eta1 A /\ eq_size eta2 A . Proof. -destruct (mat_sum_error (scaleMF x A) (scaleMF y B) n) +destruct (mat_sum_error (scaleMF x A) (scaleMF y B) n) as (ea & eb & HEQ & H1 & H2 & H3 & H4) => //. -{ apply scaleM_length => //. } -{ rewrite /eq_size; split. +{ apply scaleM_length => //. } +{ rewrite /eq_size; split. rewrite !map_length. by destruct HA. destruct HA; intros. rewrite (scaleM_length x A n (@BMULT NAN t)) => //. symmetry. pose proof (scaleM_length y B n (@BMULT NAN t)) => //. -rewrite H3 => //. } +rewrite H3 => //. } have HB: length B = m. destruct HA; lia. rewrite HEQ. apply is_finite_mat_sum in Hfin. destruct Hfin. destruct (scaleM_error A x n) as - (EA & eta1 & Heqx & H6 & H7 & H8 & H9 & H10) => //. + (EA & eta1 & Heqx & H6 & H7 & H8 & H9 & H10) => //. destruct (scaleM_error B y n) as (EB & eta2 & Heqy & H12 & H13 & H14 & H15) => //. -rewrite Heqx Heqy. +rewrite Heqx Heqy. rewrite Heqx in H1. rewrite Heqy in H2. exists EA, EB, ea, eb, eta1, eta2; split => //. split => //. - split => //. + split => //. { intros; apply H12 => //; lia. } split => //. { rewrite !map_length in H1. intros. destruct (H1 i j) => //. -exists x0. apply H16. } - split => //. +exists x0. apply H16. } + split => //. { rewrite !map_length in H2. intros. destruct (H2 i j) => //. -exists x0. apply H16. } +exists x0. apply H16. } split => //. split => //. { rewrite HB in H13. by apply H13 . } @@ -498,24 +498,24 @@ by apply eq_size_symm. } split => //. { apply (eq_size_trans ea (scaleMF x A) A) => //. apply (eq_size_scale x A (@BMULT NAN t) n). - intros; by apply Hn. } + intros; by apply Hn. } split => //. { apply (eq_size_trans eb (scaleMF x A) A) => //. apply (eq_size_scale x A (@BMULT NAN t) n). - intros; by apply Hn. } + intros; by apply Hn. } split. rewrite /eq_size; split => //. { apply (eq_size_trans eta2 B A) => //. by apply eq_size_symm. } apply (eq_size_trans (scaleMF x A) A (scaleMF y B)) => //. apply (eq_size_scale x A (@BMULT NAN t) n). - intros; by apply Hn. + intros; by apply Hn. apply (eq_size_trans A B (scaleMF y B)) => //. apply eq_size_symm. apply (eq_size_scale y B (@BMULT NAN t) n). - intros; by apply Hn2. + intros; by apply Hn2. Qed. - + End MATAXPBY. @@ -543,35 +543,35 @@ Notation Yr := (map_mat FT2R Y). Theorem GEMM_error: exists (ab1 ab2 ab3 ab4 ab5 y1 y2 y3: matrix), - map_mat FT2R (mat_sumF (scaleMF s1 (MMCF A B)) (scaleMF s2 Y)) = + map_mat FT2R (mat_sumF (scaleMF s1 (MMCF A B)) (scaleMF s2 Y)) = ((scaleMR (FT2R s1) (((MMCR Ar Br +m ab1) +m ab2) +m ab3) +m ab4) +m ab5) +m ((scaleMR (FT2R s2) (Yr +m y1) +m y2) +m y3) /\ (forall k : nat,(k < p)%nat -> exists E0 : matrix, List.nth k ab1 [::] = E0 *r List.nth k Br [] /\ (forall i j : nat, (i < m)%nat -> (j < n)%nat -> - Rabs (matrix_index E0 i j 0%Re) <= g n * Rabs (matrix_index Ar i j 0%Re))) + Rabs (matrix_index E0 i j 0%Re) <= g n * Rabs (matrix_index Ar i j 0%Re))) /\ (forall i j : nat, (i < p)%nat -> (j < m)%nat -> Rabs (matrix_index ab2 i j 0%Re) <= g1 n n) /\ (forall i j : nat, (i < p)%nat -> (j < m)%nat -> - Rabs (matrix_index ab3 i j 0%Re) <= - g m * Rabs (matrix_index ((MMCR Ar Br +m ab1) +m ab2) i j 0%Re)) + Rabs (matrix_index ab3 i j 0%Re) <= + g m * Rabs (matrix_index ((MMCR Ar Br +m ab1) +m ab2) i j 0%Re)) /\ (forall i j : nat, (i < p)%nat -> (j < m)%nat -> Rabs (matrix_index y1 i j 0%Re) <= - g m * Rabs (matrix_index Yr i j 0%Re)) + g m * Rabs (matrix_index Yr i j 0%Re)) /\ (forall i j : nat, (i < p)%nat -> (j < m)%nat -> exists d, matrix_index ab5 i j 0%Re = matrix_index (scaleMR (FT2R s1) - (((MMCR Ar Br +m ab1) +m ab2) +m ab3) +m ab4) i j 0%Re * d - /\ Rabs d <= @default_rel t) + (((MMCR Ar Br +m ab1) +m ab2) +m ab3) +m ab4) i j 0%Re * d + /\ Rabs d <= @default_rel t) /\ (forall i j : nat, (i < p)%nat -> (j < m)%nat -> exists d , matrix_index y3 i j 0%Re = matrix_index - (scaleMR (FT2R s2) (Yr +m y1) +m y2) i j 0%Re * d + (scaleMR (FT2R s2) (Yr +m y1) +m y2) i j 0%Re * d /\ Rabs d <= @default_rel t) /\ (forall i j : nat, (i < p)%nat -> (j < m)%nat -> @@ -582,11 +582,11 @@ Proof. (* len hyps for composing errors *) have Hlen1 : forall v : seq (ftype t), In v (MMCF A B) -> length v = m. -{ by apply (in_MMC_length A B (@BPLUS NAN t) +{ by apply (in_MMC_length A B (@BPLUS NAN t) (@BMULT NAN t) m (Zconst t 0)). } have Hleny : forall a : seq (ftype t), In a Y -> length a = m. { move : HY. rewrite /size_col; move => HY1; destruct HY1; intros. -by apply H0. } +by apply H0. } have Hlen2 : eq_size (MMCF A B) Y. { move : HY. rewrite /size_col /eq_size; move => HY1; destruct HY1; split. by rewrite H !map_length. @@ -595,14 +595,14 @@ have Hsz : eq_size (scaleMF s1 (MMCF A B)) (scaleMF s2 Y). { apply (eq_size_trans (scaleMF s1 (MMCF A B)) (MMCF A B) (scaleMF s2 Y)). apply (eq_size_scale s1 (MMCF A B) (@BMULT NAN t) m) => //. apply (eq_size_trans (MMCF A B) Y (scaleMF s2 Y)) => //. -apply eq_size_symm. apply (eq_size_scale s2 Y (@BMULT NAN t) m) => //. } +apply eq_size_symm. apply (eq_size_scale s2 Y (@BMULT NAN t) m) => //. } (* compose errors from axpby and MMC *) -destruct (mat_axpby_error (MMCF A B) Y s1 s2 m) +destruct (mat_axpby_error (MMCF A B) Y s1 s2 m) as (ab3 & y1 & ab5 & y3 & ab4 & y2 & Heq1 & H1) => //. -destruct (MMC_error A B n) - as (ab1 & ab2 & Heq2 & H2) => //. +destruct (MMC_error A B n) + as (ab1 & ab2 & Heq2 & H2) => //. { clear H1. apply is_finite_mat_sum in Hfin => //; destruct Hfin. -by apply is_finite_scaleM in H => //. } +by apply is_finite_scaleM in H => //. } (* invoke errors *) rewrite Heq2 in H1. rewrite Heq1 Heq2. rewrite !map_length in H1. diff --git a/accuracy_proofs/gemv_acc.v b/accuracy_proofs/gemv_acc.v index 7ccdf00..5518385 100644 --- a/accuracy_proofs/gemv_acc.v +++ b/accuracy_proofs/gemv_acc.v @@ -22,7 +22,7 @@ Import Order.TTheory GRing.Theory Num.Def Num.Theory. From mathcomp.algebra_tactics Require Import ring. -Section MixedErrorList. +Section MixedErrorList. (* mixed error bounds over lists *) Context {NAN: Nans} {t : type}. @@ -42,26 +42,26 @@ Hypothesis Hlen: forall row, In row A -> length row = length v. Lemma mat_vec_mul_mixed_error: exists (E : matrix) (eta : vector), - A *fr v = (Ar +m E) *r vr +v eta - /\ (forall i j, (i < m)%nat -> (j < n)%nat -> - Rabs (E _(i,j)) <= g n * Rabs (Ar _(i,j))) - /\ (forall k, In k eta -> Rabs k <= g1 n n) - /\ eq_size E A + A *fr v = (Ar +m E) *r vr +v eta + /\ (forall i j, (i < m)%nat -> (j < n)%nat -> + Rabs (E _(i,j)) <= g n * Rabs (Ar _(i,j))) + /\ (forall k, In k eta -> Rabs k <= g1 n n) + /\ eq_size E A /\ length eta = m. Proof. -revert Hfin Hlen. -elim: A => /= [ Hfin Hlen | a l IH Hfin' Hlen]. +revert Hfin Hlen. +elim: A => /= [ Hfin Hlen | a l IH Hfin' Hlen]. (*case A is nil*) { exists (zero_matrix 0 0 0%R), []; repeat split => /= //. } -have Hfin2 : is_finite_vec (l *f v). - revert Hfin'. rewrite /is_finite_vec !Forall_forall => Hf x Hin'. +have Hfin2 : is_finite_vec (l *f v). + revert Hfin'. rewrite /is_finite_vec !Forall_forall => Hf x Hin'. apply Hf; right => //. -have Hin2 : (forall row : list (ftype t), In row l -> length row = length v) by +have Hin2 : (forall row : list (ftype t), In row l -> length row = length v) by move => row Hrow; apply Hlen; right => //. -destruct (IH Hfin2 Hin2) as (E & eta & IH1 & IH2 & IH3 & IH4 & IH5); +destruct (IH Hfin2 Hin2) as (E & eta & IH1 & IH2 & IH3 & IH4 & IH5); clear IH; rewrite IH1; clear IH1. -have Hlen': length a = n by apply Hlen; left => //. -have Hfin1 : Binary.is_finite (fprec t) (femax t) (dotprodF a v) = true by +have Hlen': length a = n by apply Hlen; left => //. +have Hfin1 : Binary.is_finite (fprec t) (femax t) (dotprodF a v) = true by revert Hfin';rewrite /is_finite_vec !Forall_forall => Hfin'; apply Hfin'; left => /= //. destruct (dotprod_mixed_error a v Hlen' Hfin1) as (u & ueta & X & Y & Z1 & Z2). set (A':= (map FT2R a :: map_mat FT2R l) : matrix). @@ -69,7 +69,7 @@ have Ha: (length u = length (map FT2R a)) by rewrite map_length; lia. have : (length l = 0)%nat \/ (0 < length l)%nat by lia. move => [Hl | Hl]. { apply length_zero_iff_nil in Hl; subst => /=. exists (vec_sum Rminus u (map FT2R a) :: []) , ([ueta]); repeat split. -{ rewrite Y => /=. +{ rewrite Y => /=. rewrite !CommonSSR.map_map_equiv. rewrite CommonSSR.map_map_equiv map_length in Ha. suff Hs: map2 Rplus (List.map FT2R a) @@ -82,7 +82,7 @@ fold (@vec_sumR u (List.map Ropp (List.map FT2R a))). rewrite vec_sumR_assoc. rewrite vec_sumR_minus. rewrite /vec_sumR map_length -Ha. apply (vec_sum_zeroR) => //. 1, 2, 3 : by rewrite !map_length => //. -rewrite /vec_sum/map2 !map_length +rewrite /vec_sum/map2 !map_length combine_length map_length Ha; lia. } { move => i j Hi Hj. rewrite !CommonSSR.map_map_equiv; rewrite /vec_sum/map2 /= in IH2. @@ -92,16 +92,16 @@ rewrite nth_vec_sum => /= //; [|nra]. have Hj' : (j < n)%coq_nat by lia. destruct (Z1 j Hj') as (x & HB & HC); rewrite HB. have H1 : (FT2R (List.nth j a neg_zero) = List.nth j (List.map FT2R a) 0%R) by -pose proof @map_nth (ftype t) R (FT2R) a neg_zero j. +pose proof @map_nth (ftype t) R (FT2R) a neg_zero j. rewrite H1; apply /RleP; field_simplify_Rabs. rewrite Rabs_mult Rmult_comm. by apply Rmult_le_compat_r => //; apply Rabs_pos => /= . } -move => k /= [H | H] //. subst; apply /RleP => //. +move => k /= [H | H] //. subst; apply /RleP => //. rewrite !CommonSSR.map_map_equiv => /=. move => x y [Hx|Hx] [Hy|Hy]; subst => //. -rewrite /vec_sum/map2 map_length combine_length Ha +rewrite /vec_sum/map2 map_length combine_length Ha CommonSSR.map_map_equiv map_length; lia. } -exists (vec_sum Rminus u (map FT2R a) :: E) , +exists (vec_sum Rminus u (map FT2R a) :: E) , (ueta::eta); repeat split. { rewrite CommonSSR.map_map_equiv map_length in Ha. @@ -116,13 +116,13 @@ fold (@vec_sumR u (List.map Ropp (List.map FT2R a))). rewrite vec_sumR_assoc. rewrite vec_sumR_minus. rewrite map_length -Ha /vec_sumR. apply vec_sum_zeroR => //. 1, 2, 3: rewrite !map_length => //. -rewrite /vec_sum/map2 !map_length +rewrite /vec_sum/map2 !map_length combine_length map_length Ha; lia. } -{ revert Ha. rewrite CommonSSR.map_map_equiv map_length. -destruct u => /=. -{ move => Ha i j Hi Hj; symmetry in Ha; rewrite length_zero_iff_nil in Ha; +{ revert Ha. rewrite CommonSSR.map_map_equiv map_length. +destruct u => /=. +{ move => Ha i j Hi Hj; symmetry in Ha; rewrite length_zero_iff_nil in Ha; subst => /=; rewrite /matrix_index => /=. -destruct i; destruct j => /= //. +destruct i; destruct j => /= //. 1, 2: rewrite Rabs_R0 -RmultE Rmult_0_r; apply /RleP; nra. 1, 2: apply IH2; lia. } { move => Ha i j Hi Hj. revert Ha. @@ -131,9 +131,9 @@ subst A' => /= Ha. have H1 : (j < n)%coq_nat by lia. destruct (Z1 j H1) as (d & Hd1 & Hd2). destruct i; rewrite /matrix_index; destruct j => /= //. -revert Hd1 => /= Hd1; rewrite Hd1. +revert Hd1 => /= Hd1; rewrite Hd1. apply /RleP; field_simplify_Rabs; rewrite Rabs_mult Rmult_comm. - apply Rmult_le_compat; + apply Rmult_le_compat; [ apply Rabs_pos | apply Rabs_pos | | apply Req_le ] => //. { fold (map2 Rplus u (List.map Ropp (List.map FT2R a))). fold (vec_sum Rplus u (List.map Ropp (List.map FT2R a))). @@ -142,19 +142,19 @@ rewrite /vec_sumR -(vec_sumR_opp) => //. rewrite -(vec_sumR_nth); revert Hd1 => /= Hd1. rewrite Hd1. suff: List.nth j (List.map FT2R a) 0 = (List.nth j (List.map FT2R a) (@FT2R t neg_zero)). -move => Hs; rewrite Hs map_nth; apply /RleP; field_simplify_Rabs. -rewrite Rabs_mult Rmult_comm; apply Rmult_le_compat; +move => Hs; rewrite Hs map_nth; apply /RleP; field_simplify_Rabs. +rewrite Rabs_mult Rmult_comm; apply Rmult_le_compat; [ apply Rabs_pos | apply Rabs_pos | apply Hd2 | apply Req_le; auto]. -f_equal. +f_equal. 1, 2 : rewrite map_length; simpl in Ha; lia. } 1, 2 : by unfold matrix_index in IH2; apply IH2. -rewrite X map_length. lia. } } -move => k /=. move => [Hk | Hk]. +rewrite X map_length. lia. } } +move => k /=. move => [Hk | Hk]. subst. apply /RleP; apply Z2. apply IH3 => //. by rewrite CommonSSR.map_map_equiv /vec_sum /=; destruct IH4; lia. -move => x y /=. +move => x y /=. rewrite CommonSSR.map_map_equiv. move => [Hx | Hx] [Hy | Hy] /= . subst; rewrite /vec_sum/map2 map_length combine_length. rewrite CommonSSR.map_map_equiv in Ha. rewrite Ha map_length; lia. @@ -175,7 +175,7 @@ End MixedErrorList. From mathcomp Require Import matrix all_algebra bigop. -Section MixedErrorMath. +Section MixedErrorMath. Import VST.floyd.functional_base. @@ -210,16 +210,16 @@ Notation Av := (vector_to_vc (m.+1) (A *fr v)). Lemma mat_vec_mul_mixed_error': exists (E : 'M[R]_(m.+1,n.+1)) (eta : 'cV[R]_m.+1), - Av = (Ar + E) *m vr + eta - /\ (forall i j (Hi : (i < m.+1)%nat) (Hj : (j < n.+1)%nat), + Av = (Ar + E) *m vr + eta + /\ (forall i j (Hi : (i < m.+1)%nat) (Hj : (j < n.+1)%nat), Rabs (E (Hi ') (Hj ')) <= g n.+1 * Rabs (Ar (Hi ') (Hj '))) /\ forall i (Hi: (i < m.+1)%nat), Rabs (eta (Hi ') 0) <= g1 n.+1 n.+1 . Proof. have Hlen' : forall x : seq.seq (ftype t), In x A -> Datatypes.length x = length v. - move => x Hin. rewrite Hlen => //. lia. -destruct (mat_vec_mul_mixed_error A v Hfin Hlen') as + move => x Hin. rewrite Hlen => //. lia. +destruct (mat_vec_mul_mixed_error A v Hfin Hlen') as (E & eta & H1 & H2 & H3 & H4 & H5). -exists (matrix_to_mx m.+1 n.+1 E), (vector_to_vc m.+1 eta); +exists (matrix_to_mx m.+1 n.+1 E), (vector_to_vc m.+1 eta); split. rewrite H1. have He : (m.+1 = Datatypes.length eta) by lia. pose proof @vector_to_vc_plus' ((map_mat FT2R A +m E) *r map FT2R v) eta (m.+1) He. @@ -228,9 +228,9 @@ f_equal. have Hlen2: length (map_mat FT2R A +m E) = length A. destruct H4. rewrite /map_mat map_length combine_length H !map_length; lia. -have Hin1 : +have Hin1 : (forall x : seq.seq R, - In x (map_mat FT2R A +m E) -> Datatypes.length x = Datatypes.length (List.map FT2R v)). + In x (map_mat FT2R A +m E) -> Datatypes.length x = Datatypes.length (List.map FT2R v)). apply matrix_sum_preserves_length'. destruct H4. intros. rewrite map_length. @@ -238,26 +238,26 @@ set (y := nth 0 A []). have Hy : In y A. subst y; apply nth_In; lia. specialize (H0 x y H4 Hy); rewrite H0. apply Hlen'; auto. -move => x Hx. +move => x Hx. apply list_in_map_inv in Hx. destruct Hx as (x0 & Hx0 & Hx0'). subst. rewrite !map_length. apply Hlen'; auto. have HlenA1 : m.+1 = length (map_mat FT2R A +m E) by (subst m; lia). -have Hlen1 : n.+1 = length (map FT2R v) by +have Hlen1 : n.+1 = length (map FT2R v) by (subst n; rewrite !map_length; lia). rewrite -Hlen1 in Hin1. -pose proof vector_to_vc_mulmx_m (map_mat FT2R A +m E) (map FT2R v) m.+1 n.+1. +pose proof vector_to_vc_mulmx_m (map_mat FT2R A +m E) (map FT2R v) m.+1 n.+1. rewrite H => //. clear H. f_equal. -have HlenA2 : m.+1 = Datatypes.length (map_mat FT2R A) by +have HlenA2 : m.+1 = Datatypes.length (map_mat FT2R A) by (subst m;rewrite !map_length; lia). pose proof @matrix_to_mx_plus (map_mat FT2R A) E (m.+1) (n.+1) HlenA2. unfold map_mat in H. rewrite map_length in H. rewrite H. clear H. f_equal. destruct H4; lia. -move => a e Ha Hep; split. +move => a e Ha Hep; split. apply list_in_map_inv in Ha. destruct Ha as (x0 & Hx0 & Hx0'). subst. rewrite map_length. apply Hlen; auto. @@ -275,7 +275,7 @@ split. rewrite -(matrix_to_mx_index (map_mat FT2R A) i j). have HA : (length A = m.+1) by (subst m; lia). have Hv : (length v = n.+1) by (subst m; lia). -rewrite HA Hv in H2. +rewrite HA Hv in H2. specialize (H2 i j Hi Hj). subst n => /= //. } move => i Hi. @@ -319,21 +319,21 @@ Theorem forward_error : Proof. destruct (mat_vec_mul_mixed_error' A v) as (E & eta & HE & H1 & H2) => //. rewrite Hlenv1 => //. -rewrite HE mulmxDl. fold m. clear HE. +rewrite HE mulmxDl. fold m. clear HE. have Hvr : vector_to_vc m.+1 (List.map FT2R v) = vr => //=. move: H1. move: E. rewrite Hlenv1 Hvr. move => E H1. -have H0 : Ar *m vr + E *m vr + eta - Ar *m vr = E *m vr + eta. -remember (Ar *m vr) as y. remember (E *m vr) as x. subst m. +have H0 : Ar *m vr + E *m vr + eta - Ar *m vr = E *m vr + eta. +remember (Ar *m vr) as y. remember (E *m vr) as x. subst m. apply /matrixP => i j; do ![rewrite mxE | ] => /=; ring. rewrite H0. clear H0. fold m in H1, H2. -eapply (le_trans (normv_triang _ _ _)). +eapply (le_trans (normv_triang _ _ _)). apply ler_add. eapply (le_trans (subMultNorm _ _ _ )). -apply ler_pmul => //. +apply ler_pmul => //. apply normM_pos. apply normv_pos. rewrite /normM mulrC big_max_mul. -apply le_bigmax2 => i0 _. +apply le_bigmax2 => i0 _. rewrite /sum_abs. rewrite big_mul => [ | i b | ]; try ring. apply ler_sum => i _. @@ -342,11 +342,11 @@ rewrite mulrC. apply /RleP; auto with commonDB. apply /RleP; auto with commonDB. rewrite /normv. -apply bigmax_le => [|i _]. +apply bigmax_le => [|i _]. apply /RleP; auto with commonDB. -destruct i. +destruct i. rewrite Hlenv1 in H2. apply H2. Qed. -End ForwardError. \ No newline at end of file +End ForwardError. diff --git a/accuracy_proofs/list_lemmas.v b/accuracy_proofs/list_lemmas.v index ef5f25c..e9d5d0d 100644 --- a/accuracy_proofs/list_lemmas.v +++ b/accuracy_proofs/list_lemmas.v @@ -1,4 +1,4 @@ -(** This file contains basic lemmas about lists. +(** This file contains basic lemmas about lists. Copyright Ariel Kellison, 2023 *) @@ -7,14 +7,14 @@ Import List ListNotations. Lemma combine_map (A B : Type) (f : A -> B) g (v1 v2 : list A) : -(forall a a0, (f a, f a0) = g (a, a0)) -> +(forall a a0, (f a, f a0) = g (a, a0)) -> combine (map f v1) (map f v2) = (map g (combine v1 v2)). Proof. intros. revert v2; induction v1; destruct v2; simpl; auto; f_equal; auto. Qed. Lemma combine_map' (A B : Type) (f : A -> B) (g : A * A -> B) h (v1 v2 : list A) : -(forall a a0, h (f a, f a0) = g (a, a0)) -> +(forall a a0, h (f a, f a0) = g (a, a0)) -> map h (combine (map f v1) (map f v2)) = (map g (combine v1 v2)). Proof. intros. revert v2; induction v1; destruct v2; simpl; auto; f_equal; auto. @@ -23,33 +23,33 @@ Qed. Lemma rev_empty (A: Type) : @rev A [] = []. simpl; auto. Qed. Lemma combine_nil_r (A : Type) (l1 l2: list A) : - length l1 = length l2 -> + length l1 = length l2 -> combine l1 [] = combine l1 l2 -> l2 = []. -Proof. intros. -rewrite combine_nil in H0. symmetry in H0. +Proof. intros. +rewrite combine_nil in H0. symmetry in H0. apply length_zero_iff_nil in H0. rewrite combine_length in H0. - rewrite H in H0; clear H. rewrite Nat.min_id in H0. + rewrite H in H0; clear H. rewrite Nat.min_id in H0. apply length_zero_iff_nil; auto. Qed. Lemma combine_nil_l (A : Type) (l1 l2: list A) : - length l1 = length l2 -> + length l1 = length l2 -> combine l1 [] = combine l1 l2 -> l1 = []. -Proof. intros. -rewrite combine_nil in H0. symmetry in H0. +Proof. intros. +rewrite combine_nil in H0. symmetry in H0. apply length_zero_iff_nil in H0. rewrite combine_length in H0. symmetry in H. - rewrite H in H0; clear H. rewrite Nat.min_id in H0. + rewrite H in H0; clear H. rewrite Nat.min_id in H0. apply length_zero_iff_nil; auto. Qed. Lemma combine_app (A : Type) a1 a2 : forall (l1 l2 : list A), length l1 = length l2 -> combine l1 l2 ++ [(a1,a2)] = combine (l1 ++ [a1]) (l2 ++ [a2]). Proof. -induction l1. +induction l1. { intros. pose proof combine_nil_r A [] l2 H eq_refl; subst; simpl; auto. } -intros. destruct l2. +intros. destruct l2. { pose proof combine_nil_l A (a :: l1) [] H eq_refl as H0; inversion H0. } assert (Hlen: length l1 = length l2) by auto. specialize (IHl1 l2 Hlen). @@ -73,12 +73,12 @@ rewrite <- combine_app; auto. rewrite !rev_length; auto. Qed. -Lemma combine_single A v1 v2 (a : A * A) : - length v1 = length v2 -> +Lemma combine_single A v1 v2 (a : A * A) : + length v1 = length v2 -> combine v1 v2 = [a] -> v1 = [fst a] /\ v2 = [snd a]. Proof. intros. pose proof combine_split v1 v2 H. -rewrite H0 in H1. destruct a. +rewrite H0 in H1. destruct a. simpl in H1. inversion H1; simpl; split; auto. Qed. @@ -90,17 +90,17 @@ From Coq Require Import ZArith Reals Psatz. From Coquelicot Require Import Coquelicot. Lemma length_not_empty {A} l : -l <> [] -> +l <> [] -> (1 <= @length A l)%nat. Proof. intros. -destruct l; simpl; +destruct l; simpl; try simpl (length (a :: l)); try lia. destruct H; auto. Qed. Lemma length_not_empty' {A} l : -l <> [] -> +l <> [] -> (1 <= INR (@length A l))%R. Proof. intros. @@ -110,7 +110,7 @@ apply length_not_empty; auto. Qed. Lemma length_not_empty_nat {A} l : -l <> [] -> +l <> [] -> (1 <= (@length A l))%nat. Proof. intros. @@ -119,7 +119,7 @@ apply length_not_empty';auto. Qed. Lemma length_not_empty_lt {A} l : -l <> [] -> +l <> [] -> (0 < INR (@length A l))%R. Proof. intros. @@ -136,7 +136,7 @@ apply pos_INR. Qed. Lemma length_not_empty_nat' {A} l : -l <> [] -> +l <> [] -> (0 <= (@length A l))%nat. Proof. intros. @@ -161,11 +161,11 @@ rewrite ! fold_symmetric by (intros; lra). induction al; simpl; intros; lra. Qed. -Lemma hd_nth {A} (a : list A) d : +Lemma hd_nth {A} (a : list A) d : hd d a = nth 0 a d. Proof. destruct a; simpl; auto. Qed. -Lemma nth_nil i {T: Type} d: +Lemma nth_nil i {T: Type} d: @nth T i (@nil T) d = d. Proof. induction i; simpl; auto. Qed. @@ -174,44 +174,44 @@ nth i (tl a) d = nth (i+1) a d. Proof. revert i. destruct a; intros. -rewrite nth_nil; simpl; - destruct i; auto. +rewrite nth_nil; simpl; + destruct i; auto. remember (i + 1)%nat as n. destruct n; simpl; auto. -lia. +lia. assert (n = i)%nat by lia. rewrite H; auto. Qed. Lemma tl_length {A} n (a : list A) : length a = n -> length (tl a) = (n-1)%nat. -Proof. +Proof. revert n. destruct a ; simpl; intros; lia. Qed. -Lemma in_tl {T} (A : list (list T)): +Lemma in_tl {T} (A : list (list T)): forall a, In a A -> In (tl a) (map (@tl T) A). -Proof. intros a H. apply in_map; auto. Qed. +Proof. intros a H. apply in_map; auto. Qed. -Lemma in_tl_length {T} (A : list (list T)) n : -(forall a, In a A -> length a = n) -> - forall a, In a (map (@tl T) A) -> +Lemma in_tl_length {T} (A : list (list T)) n : +(forall a, In a A -> length a = n) -> + forall a, In a (map (@tl T) A) -> length a = (n-1)%nat. Proof. revert n. induction A; simpl; intros; try contradiction. destruct H0. -rewrite <- H0. -apply tl_length. apply H; auto. -apply IHA; intros. +rewrite <- H0. +apply tl_length. apply H; auto. +apply IHA; intros. apply H; auto. -apply H0; auto. +apply H0; auto. Qed. -Lemma list_cases {T} (A : list T) : +Lemma list_cases {T} (A : list T) : (A = []) \/ ([] <> A). -Proof. -destruct A; simpl; auto. -right. apply nil_cons. Qed. +Proof. +destruct A; simpl; auto. +right. apply nil_cons. Qed. diff --git a/accuracy_proofs/mv_mathcomp.v b/accuracy_proofs/mv_mathcomp.v index 0922b64..761fe49 100644 --- a/accuracy_proofs/mv_mathcomp.v +++ b/accuracy_proofs/mv_mathcomp.v @@ -1,4 +1,4 @@ -(* This file contains theorems connecting MathComp operations on +(* This file contains theorems connecting MathComp operations on matrices and vectors to operations on lists. *) Require Import vcfloat.VCFloat. @@ -35,33 +35,33 @@ Definition getv (l: (list R)) i := Definition getm (l: list (list R)) i j := (nth j (nth i l []) 0%R). -Definition vector_to_vc (m' : nat) (v: @vector R) : 'cV[R]_m' := - let m := Z.of_nat m' in -\matrix_(i < m', j < 1) +Definition vector_to_vc (m' : nat) (v: @vector R) : 'cV[R]_m' := + let m := Z.of_nat m' in +\matrix_(i < m', j < 1) (getv v (fintype.nat_of_ord i)). -Definition matrix_to_mx (m' n': nat) (mx: @gem_defs.matrix R) : 'M[R]_(m',n') := - let m := Z.of_nat m' in - let n := Z.of_nat n' in -\matrix_(i < m', j < n') +Definition matrix_to_mx (m' n': nat) (mx: @gem_defs.matrix R) : 'M[R]_(m',n') := + let m := Z.of_nat m' in + let n := Z.of_nat n' in +\matrix_(i < m', j < n') (getm mx (fintype.nat_of_ord i) (fintype.nat_of_ord j)). End MVtoMC_Defs. Section MVtoMC_Lems. -Lemma matrix_to_mx_nil m n': +Lemma matrix_to_mx_nil m n': matrix_to_mx m n' [] = 0. Proof. by rewrite /matrix_to_mx/getm// /=; apply/matrixP => k i /[!mxE]; destruct k; destruct i => /=; -destruct m1; destruct m0 => /=. +destruct m1; destruct m0 => /=. Qed. -Lemma vector_to_vc_nil m: +Lemma vector_to_vc_nil m: vector_to_vc m [] = 0. -Proof. +Proof. rewrite /vector_to_vc/getv // /=. apply/matrixP => k i /[!mxE] /=. by destruct (nat_of_ord k). @@ -69,19 +69,19 @@ Qed. Lemma matrix_sum_preserves_length' B E m0: -(forall x, In x E -> length x = m0 ) -> -(forall x, In x B -> length x = m0 ) -> +(forall x, In x E -> length x = m0 ) -> +(forall x, In x B -> length x = m0 ) -> forall x, In x (B +m E) -> length x = m0. -Proof. +Proof. intros. unfold mat_sumR, mat_sum in H1. unfold map2 at 1 in H1. apply list_in_map_inv in H1. destruct H1 as (x0 & H1 & H2). destruct x0. rewrite H1. -pose proof in_combine_r _ _ _ _ H2. +pose proof in_combine_r _ _ _ _ H2. pose proof in_combine_l _ _ _ _ H2. specialize (H l0 H3). specialize (H0 l H4). -simpl. unfold map2. +simpl. unfold map2. rewrite map_length combine_length; lia. Qed. @@ -101,22 +101,22 @@ Qed. Lemma nth_zero_matrix m n i j: (nth j (nth i (zero_matrix m n 0%R) [::]) 0%R) = 0. Proof. -move : i j n. +move : i j n. elim : m => //. rewrite /zero_matrix. move => i j _. by rewrite -!nth_nth !nth_nil. -intros. simpl. +intros. simpl. destruct n0. by rewrite -!nth_nth !nth_nil. simpl. destruct i. -have H0: +have H0: ((0%R) :: (zero_vector n0 0%R) = @zero_vector R n0.+1 0%R) => //. by rewrite H0 nth_zero_vector. by rewrite H. Qed. -Lemma in_zero_matrix_length m n a: +Lemma in_zero_matrix_length m n a: In a (zero_matrix m n 0%R) -> length a = n. Proof. move : a . elim: m => //=. move => m IH a. destruct n => //= . move => [H|H]. @@ -124,7 +124,7 @@ rewrite -H //=. by rewrite zero_vector_length. by apply IH. Qed. -Lemma matrix_to_mx_zero m : +Lemma matrix_to_mx_zero m : matrix_to_mx m m (zero_matrix m m 0%R) = 0. Proof. apply/matrixP=> i j; rewrite !mxE /getm. @@ -135,7 +135,7 @@ End MVtoMC_Lems. Section MVtoMC_opLems. -Lemma vec_sum_nth_plus : forall u1 u2 +Lemma vec_sum_nth_plus : forall u1 u2 (Hlen: length u2 = length u1) i, nth i (u1 +v u2) 0 = nth i u1 0 + nth i u2 0. Proof. by apply gem_defs.vec_sum_nth_plus. Qed. @@ -143,9 +143,9 @@ Proof. by apply gem_defs.vec_sum_nth_plus. Qed. Lemma matrix_to_mx_plus : forall A E m n (Hm : m = length A) (Hlen1: length A = length E) - (Hlen2: forall a e, In a A -> In e E -> length a = n + (Hlen2: forall a e, In a A -> In e E -> length a = n /\ length e = n), - matrix_to_mx m n (A +m E) = + matrix_to_mx m n (A +m E) = matrix_to_mx m n A + matrix_to_mx m n E. Proof. move => A E m n Hm Hlen1 Hlen2. @@ -153,23 +153,23 @@ rewrite /matrix_to_mx/getm => /=. apply /matrixP => i j; do ![rewrite mxE | ]. rewrite -(vec_sum_nth_plus). f_equal. clear j. revert Hlen1 Hlen2 Hm i. revert m. revert E. -elim : A => [ | a l IH E m Hlen1 Hin Hm i]. +elim : A => [ | a l IH E m Hlen1 Hin Hm i]. by (destruct m => //; destruct i). -destruct E => //. +destruct E => //. (destruct m => //; destruct i). destruct m0 => /= //. have Hlen3 : length l = length E. simpl in Hlen1 . lia. have Hin1 : (forall a e : seq.seq R, In a l -> In e E -> length a = n /\ length e = n). - move => a0 e Ha He. + move => a0 e Ha He. specialize (Hin a0 e). apply Hin; simpl; auto. -have Hm0 : (m0 < length E)%nat. simpl in i. +have Hm0 : (m0 < length E)%nat. simpl in i. rewrite -Hlen3. simpl in Hm. lia. rewrite -Hlen3 in Hm0. have Hm' : m = Datatypes.length l by (simpl in Hm; lia). rewrite -Hm' in Hm0. have Hnord : (nat_of_ord (Ordinal Hm0) = m0) => //. -specialize (IH E m Hlen3 Hin1 Hm'(Ordinal Hm0)). +specialize (IH E m Hlen3 Hin1 Hm'(Ordinal Hm0)). rewrite -IH. f_equal. symmetry. have Hlen3 : (length (nth i A []) = n /\ length (nth i E []) = n). apply (Hlen2 (nth i A []) (nth i E [])); apply nth_In; @@ -183,32 +183,32 @@ forall (Hm : forall b, In b B -> length b = m) (Hord : (0 < 1)%nat) (Hordi : (i < m)%nat), -(nth i (rowM 0%R vec_sumR Rmult m a B) 0%R) = - \sum_(j < n) (vector_to_vc n a) j (Ordinal Hord) * +(nth i (rowM 0%R vec_sumR Rmult m a B) 0%R) = + \sum_(j < n) (vector_to_vc n a) j (Ordinal Hord) * (matrix_to_mx n m B) j (Ordinal Hordi). Proof. -move: a B m i. +move: a B m i. elim: n => /=. { intros. rewrite length_zero_iff_nil in Hn. by rewrite big_ord0 Hn /= nth_zero_vector. } -move=> n IH a. -case: a => //. +move=> n IH a. +case: a => //. move => a0 a B. case: B => /=. { intros. rewrite nth_zero_vector big1 //= => Hi _. -by rewrite matrix_to_mx_nil !mxE mulr0. } +by rewrite matrix_to_mx_nil !mxE mulr0. } move => b B m /=. intros. -have Hm' : -(forall b : seq.seq R, (In b B) -> +have Hm' : +(forall b : seq.seq R, (In b B) -> (Datatypes.length b) = m). intros; apply Hm; simpl; auto. -rewrite nth_vec_sum; [| |nra]. +rewrite nth_vec_sum; [| |nra]. pose proof (IH a B). -rewrite H. +rewrite H. rewrite big_ord_recl -RplusE -RmultE /=. -f_equal. +f_equal. by rewrite !mxE /getm/getv/scaleV/= -(map_nth (Rmult a0) b 0%R i) Rmult_0_r. apply eq_big => k // _ /[!mxE]. @@ -216,47 +216,47 @@ by rewrite /getv/getm /=. lia. move => b0 Hb0. by apply Hm; right. rewrite /scaleV rowM_length. rewrite map_length. rewrite Hm //; by left. -move => b0 Hb0. by apply Hm; right. +move => b0 Hb0. by apply Hm; right. Qed. Ltac nth_destruct := - match goal with - |- context[(nth ?A (nth ?B _ _) _) ] => - destruct B; destruct A; simpl; auto + match goal with + |- context[(nth ?A (nth ?B _ _) _) ] => + destruct B; destruct A; simpl; auto end. (* matrix multiplication over real lists to matrix addition over mathcomp matrices *) Lemma matrix_to_mx_mul: forall A B m n (Hlen1: forall b, In b B -> length b = m) - (Hlen2: forall a, In a A -> length a = n), - matrix_to_mx m m (MMR A B) = + (Hlen2: forall a, In a A -> length a = n), + matrix_to_mx m m (MMR A B) = matrix_to_mx m n A *m matrix_to_mx n m B. Proof. intros. apply/matrixP=> i j; rewrite !mxE /=. move: Hlen1 Hlen2 i j. move: A B m . -case: n => /=. +case: n => /=. { intros. rewrite big_ord0. move: B m Hlen1 Hlen2 i j. elim: A. intros. -rewrite /getm; nth_destruct. +rewrite /getm; nth_destruct. intros. have Ha : length a =0%nat. apply Hlen2 => /=. by left. -have Hl : -(forall a : seq.seq R, (In a l) -> +have Hl : +(forall a : seq.seq R, (In a l) -> (Datatypes.length a) = (0%N)). -move => a0 Ha0. apply Hlen2 => /=. +move => a0 Ha0. apply Hlen2 => /=. by right. move: Hlen1. rewrite length_zero_iff_nil in Ha. -rewrite Ha. -case: B => [Hlen1| b B Hlen1]. +rewrite Ha. +case: B => [Hlen1| b B Hlen1]. rewrite /MMR MM_nil_r/getm; nth_destruct. rewrite /getm in H. rewrite /MMR/=/getm. have Hi: ( ((nat_of_ord i)=0)%nat \/ ( 0 < (nat_of_ord i) )%nat) by lia. -destruct Hi. +destruct Hi. { by rewrite H0 nth_zero_vector. } move: H0. elim: i => m0 Hm0 Hord'. replace (nat_of_ord (Hm0 ')) with m0. @@ -265,25 +265,25 @@ have Hord : (m0 < m)%nat by lia. by rewrite (H (b::B) m Hlen1 Hl (Ordinal Hord) j). by []. } move=> n A B. move: n B. -elim: A. -{ intros. +elim: A. +{ intros. rewrite /MMR MM_nil_l matrix_to_mx_nil/getm big1. nth_destruct. move => i0 _. by rewrite !mxE mul0r. } move=> a A IH n B. move: a A IH n. -case: B. +case: B. { intros. rewrite /MMR MM_nil_r matrix_to_mx_nil/getm big1. nth_destruct. move => i0 _. by rewrite !mxE mulr0. } move=> b B. intros. rewrite /MMR/=. -have H2 : - forall a0 : seq.seq R, +have H2 : + forall a0 : seq.seq R, (In a0 A) -> (Datatypes.length a0) = (n.+1). move => a0 Ha0. apply Hlen2 => /=. by right. rewrite /getm. have H: ( ((nat_of_ord i)=0)%nat \/ ( 0 < (nat_of_ord i) )%nat) by lia. -destruct H. +destruct H. { rewrite H. simpl. have Hb : Datatypes.length b = m. apply Hlen1 => /=. by left. @@ -308,8 +308,8 @@ Qed. Lemma vector_to_vc_plus u1 u2 - (Hlen: length u1 = length u2) : - vector_to_vc (length u2) (u1 +v u2) = + (Hlen: length u1 = length u2) : + vector_to_vc (length u2) (u1 +v u2) = (vector_to_vc (length u2) u1) + (vector_to_vc (length u2) u2). Proof. rewrite /vector_to_vc/getv => /=. @@ -317,10 +317,10 @@ apply /matrixP => i j; do ![rewrite mxE | ]. by destruct i; apply vec_sum_nth_plus. Qed. -Lemma vector_to_vc_plus' u1 u2 m - (Hm: m = length u2) - (Hlen: length u1 = length u2) : - vector_to_vc m (u1 +v u2) = +Lemma vector_to_vc_plus' u1 u2 m + (Hm: m = length u2) + (Hlen: length u1 = length u2) : + vector_to_vc m (u1 +v u2) = (vector_to_vc m u1) + (vector_to_vc m u2). Proof. rewrite /vector_to_vc/getv => /=. @@ -335,64 +335,64 @@ Proof. by rewrite /mvR (map_nth (dotprodR^~ u2) B []). Qed. -Lemma vec_to_vc_dotproR v1 v2 i j: +Lemma vec_to_vc_dotproR v1 v2 i j: dotprodR v1 v2 = (vector_to_vc 1 (dotprodR v1 v2 :: [])) i j. Proof. by rewrite !mxE /getv; destruct i; destruct m. Qed. Lemma vector_to_vc_mulmxp: forall v1 v2, - length v1 = length v2 -> - vector_to_vc 1 (dotprodR v1 v2 :: []) = + length v1 = length v2 -> + vector_to_vc 1 (dotprodR v1 v2 :: []) = (vector_to_vc (length v1) v1)^T *m (vector_to_vc (length v1) v2). Proof. -move => v1 /=; elim : v1 => /= [ | a l IH ]. -{ rewrite vector_to_vc_nil /vector_to_vc trmx0 => v2 H. -rewrite mul0mx dotprodR_nil_l /getv. +move => v1 /=; elim : v1 => /= [ | a l IH ]. +{ rewrite vector_to_vc_nil /vector_to_vc trmx0 => v2 H. +rewrite mul0mx dotprodR_nil_l /getv. apply /matrixP => i j; do ![rewrite mxE /getv]; destruct i; destruct m => /= //. } destruct v2 => /= // Hlen'. -have : ( (length l = 0)%nat \/ ( 0 <> length l)%nat ) by lia. +have : ( (length l = 0)%nat \/ ( 0 <> length l)%nat ) by lia. move => [Hl | Hl]. -{ rewrite Hl. rewrite Hl in Hlen'. +{ rewrite Hl. rewrite Hl in Hlen'. apply length_zero_iff_nil in Hl; rewrite Hl. have Hv2 : (length v2 = 0)%nat by lia. -apply length_zero_iff_nil in Hv2. +apply length_zero_iff_nil in Hv2. rewrite Hv2 /vector_to_vc /getv /dotprodR. apply /matrixP => i j; do ![rewrite mxE /getv]. rewrite (@big_nth R _ Rplus _ i) ordinal_enum_size index_ord_enum - (@big_nat_recl R 0 Rplus) => //. + (@big_nat_recl R 0 Rplus) => //. rewrite ((@CommonSSR.nth_ord_enum 1) 0). destruct i; destruct m => /= //. -rewrite Rplus_comm !mxE /=. +rewrite Rplus_comm !mxE /=. f_equal => //. -rewrite big_nat_cond. +rewrite big_nat_cond. rewrite big_pred0 => //. } rewrite /dotprodR => /=. rewrite fold_left_Rplus_Rplus. apply /matrixP => i j; do ![rewrite mxE /getv]. assert ((fold_left Rplus (map (uncurry Rmult) (combine l v2)) 0) = ((vector_to_vc 1 (dotprodR l v2 :: [])) i j)). -apply vec_to_vc_dotproR. +apply vec_to_vc_dotproR. rewrite H. clear H. rewrite IH. clear IH. rewrite /vector_to_vc. have Hord: ( 0 < (Datatypes.length l).+1)%nat by lia. rewrite (@big_nth _ 0 Rplus _ (Ordinal Hord)) - (@big_ltn R 0 Rplus) /index_enum ordinal_enum_size. + (@big_ltn R 0 Rplus) /index_enum ordinal_enum_size. rewrite (@big_addn R 0 Rplus 0). replace (nat_of_ord i) with 0%nat => /= . rewrite !mxE. f_equal => /= //. rewrite (@ordinal_enum (Datatypes.length l).+1 (Ordinal Hord)) /= /getv /= //. assert (((Datatypes.length l).+1 - 1)%nat = - Datatypes.length l) by lia. -rewrite H. clear H. + Datatypes.length l) by lia. +rewrite H. clear H. have Hord1: ( 0 < (Datatypes.length l))%nat by lia. -rewrite big_nat_cond. +rewrite big_nat_cond. rewrite (@big_nth R _ Rplus _ (Ordinal Hord1) ) /= /index_enum /= ordinal_enum_size. -rewrite big_nat_cond. +rewrite big_nat_cond. apply: eq_big => k //. move => Hk'. have Hk : (k < Datatypes.length l)%nat by lia. @@ -408,7 +408,7 @@ Qed. Lemma vector_to_vc_mulmx : forall B u2 (Hlen: forall x, In x B -> length x = length u2), - vector_to_vc (length B) (B *r u2) = + vector_to_vc (length B) (B *r u2) = matrix_to_mx (length B) (length u2) B *m (vector_to_vc (length u2) u2). Proof. move => B u2 Hin. @@ -417,9 +417,9 @@ rewrite vector_to_vc_mulmx' => //. pose proof vec_to_vc_dotproR (@nth (seq.seq R) i B []) u2 j j. rewrite H ; clear H. pose proof @vector_to_vc_mulmxp (@nth (seq.seq R) i B []) u2. -have Hlen': (@Datatypes.length R (@nth (seq.seq R) i B []) = - length u2). -{ apply Hin. apply nth_In. destruct i. +have Hlen': (@Datatypes.length R (@nth (seq.seq R) i B []) = + length u2). +{ apply Hin. apply nth_In. destruct i. have Hord : (nat_of_ord (Ordinal i) = m) => //. rewrite Hord; lia. } rewrite H => //. @@ -432,7 +432,7 @@ Lemma vector_to_vc_mulmx_m : forall B u2 m n (Hm : m = length B) (Hn : n = length u2) (Hlen: forall x, In x B -> length x = n), - vector_to_vc m (B *r u2) = + vector_to_vc m (B *r u2) = matrix_to_mx m n B *m (vector_to_vc n u2). Proof. move => B u2 m n Hm Hn Hin. @@ -441,10 +441,10 @@ rewrite vector_to_vc_mulmx' => //. pose proof vec_to_vc_dotproR (@nth (seq.seq R) i B []) u2 j j. rewrite H ; clear H. pose proof @vector_to_vc_mulmxp (@nth (seq.seq R) i B []) u2. -have Hlen': (@Datatypes.length R (@nth (seq.seq R) i B []) = - length u2). -{ rewrite Hin => //. apply nth_In. destruct i. -have Hord : (nat_of_ord (Ordinal i) = m0) => //. +have Hlen': (@Datatypes.length R (@nth (seq.seq R) i B []) = + length u2). +{ rewrite Hin => //. apply nth_In. destruct i. +have Hord : (nat_of_ord (Ordinal i) = m0) => //. rewrite Hord; lia. } rewrite H => //. rewrite mxE /getv/matrix_to_mx/vector_to_vc/getm/getv /= . @@ -453,15 +453,15 @@ apply: eq_bigr => k _; rewrite !mxE => //. Qed. Lemma dotprod_sum: forall v1 v2 (i j : 'I_1), - length v1 = length v2 -> + length v1 = length v2 -> dotprodR v1 v2 = \sum_(k < length v1) ((vector_to_vc (length v1) v1)^T i k * (vector_to_vc (length v1) v2) k j). Proof. move => v1. elim : v1. move => v2; case : v2 => //=. -{ intros. rewrite big_ord0 /dotprod//. } +{ intros. rewrite big_ord0 /dotprod//. } move => v0 v1 IH v2. case : v2 => //. intros. rewrite /dotprodR/=. rewrite fold_left_Rplus_Rplus. rewrite big_ord_recl -RplusE -RmultE /=. -f_equal. +f_equal. by rewrite !mxE /getv/=. rewrite /dotprodR in IH. rewrite (IH l i j). @@ -474,17 +474,17 @@ Lemma MVR_sum : forall A b m n (i : 'I_1) (j : 'I_m) (Hb : length b = n), nth (nat_of_ord j) (mvR A b) 0%R = \sum_(k < n) matrix_to_mx m n A %SEQ j k * (matrix_to_mx 1 n [b] %SEQ)^T k i. Proof. -move => A b. move : b. elim : A => //=. +move => A b. move : b. elim : A => //=. { intros => //=. rewrite !matrix_to_mx_nil /matrix_to_mx/getm. destruct (nat_of_ord j); symmetry; rewrite big1 => //=; intros; by rewrite !mxE mul0r. } -move => a A IH. intros. +move => a A IH. intros. destruct j; destruct m0 => /=. rewrite (dotprod_sum a b i i). have Ha : Datatypes.length a = n. apply Hlen2; by left. rewrite Ha. apply: eq_bigr => k _; rewrite !mxE /getv/getm => //=. destruct i => //=; destruct m0 => //. -rewrite Hb. apply Hlen2; by left. +rewrite Hb. apply Hlen2; by left. have Hm : (m0 < m)%nat by lia. rewrite (IH b m n i (Ordinal Hm)) => //. apply: eq_bigr => k _; rewrite !mxE /getv/getm => //=. @@ -495,15 +495,15 @@ Qed. (* matrix multiplication -MMC- over real lists to matrix addition over mathcomp matrices *) Lemma matrix_to_mx_mul_MCR: forall A B m n p (Hlen1: forall b, In b B -> length b = n) - (Hlen2: forall a, In a A -> length a = n), - matrix_to_mx p m (MMCR A B) = + (Hlen2: forall a, In a A -> length a = n), + matrix_to_mx p m (MMCR A B) = (matrix_to_mx m n A *m (matrix_to_mx p n B)^T)^T. Proof. intros. apply/matrixP=> i j; rewrite !mxE /=. move: Hlen1 Hlen2 i j. move: A m n p. elim: B. -{ intros => /=. rewrite !matrix_to_mx_nil /getm/= . +{ intros => /=. rewrite !matrix_to_mx_nil /getm/= . symmetry; rewrite big1 => //=; intros. destruct (nat_of_ord i) ; destruct (nat_of_ord j) => //. by rewrite !mxE mulr0. } @@ -511,25 +511,25 @@ move => b B IH A. intros. simpl. rewrite /getm. destruct i => /=. destruct j; destruct m0 => /=. { have H1 : (0 < 1)%nat by lia. destruct A => /=. -{ destruct m1; rewrite !matrix_to_mx_nil /getm/= ; +{ destruct m1; rewrite !matrix_to_mx_nil /getm/= ; symmetry; rewrite big1 => //=; intros; by rewrite !mxE mul0r. } destruct m1. { rewrite (dotprod_sum l b (Ordinal H1) (Ordinal H1)). rewrite Hlen2 ; [ | by left]. apply: eq_bigr => k _; rewrite !mxE => //. -rewrite Hlen2; [| by left]. rewrite Hlen1 => //; by left. } -fold mvR. have H01 : (0 < 1)%nat by lia. +rewrite Hlen2; [| by left]. rewrite Hlen1 => //; by left. } +fold mvR. have H01 : (0 < 1)%nat by lia. have H0 : (m1 < m)%nat by lia. have Hord: (nat_of_ord (Ordinal H0) = m1) by []. rewrite (MVR_sum A b m n (Ordinal H01) (Ordinal H0)). apply: eq_bigr => k _; rewrite !mxE => //=. intros; apply Hlen2 => /=; by right. apply Hlen1 => /=; by left. } -rewrite /getm in IH. +rewrite /getm in IH. have Hb : (forall b : seq.seq R, In b B -> Datatypes.length b = n). -{ intros; apply Hlen1 => /=; by right. } +{ intros; apply Hlen1 => /=; by right. } have H0 : (m0 < p)%nat by lia. -have Hord: (nat_of_ord (Ordinal H0) = m0) by []. +have Hord: (nat_of_ord (Ordinal H0) = m0) by []. specialize (IH A m n p Hb Hlen2 (Ordinal H0) (Ordinal i0)). rewrite Hord in IH. rewrite IH. apply: eq_bigr => k _. rewrite !mxE /getm => //=. @@ -544,22 +544,22 @@ Definition normv {m} (v: 'cV[R]_m) : R:= \big[maxr/0]_(i < m) Rabs (v i 0). Definition normM {m n} (A: 'M[R]_(m,n)) : R:= \big[maxr/0]_i (sum_abs A i). (* generally useful lemmmas for max operator *) -Lemma maxrC : @commutative R R maxr. +Lemma maxrC : @commutative R R maxr. Proof. rewrite /commutative => x y. rewrite -!RmaxE. apply Rmax_comm. Qed. -Lemma maxrA : @associative R maxr. +Lemma maxrA : @associative R maxr. Proof. rewrite /associative => x y z. - rewrite -!RmaxE. apply Rmax_assoc. Qed. + rewrite -!RmaxE. apply Rmax_assoc. Qed. Lemma big_mul {n:nat} (F : ordinal (n.+1) -> R) op a: -(forall i b, op (F i) b * a = op (F i * a) (b * a)) -> +(forall i b, op (F i) b * a = op (F i * a) (b * a)) -> 0 <= a -> \big[op/0]_(i0 < n.+1) (F i0) * a = \big[op/0]_(i0 < n.+1) (F i0 * a). -Proof. +Proof. revert F a. elim: n => /= // [F a Hc Ha| n0 IH F a Hc Ha]. rewrite !big_ord_recl !big_ord0/= //. -rewrite (Hc ord0 0) mul0r //. -rewrite big_ord_recl => /= //. +rewrite (Hc ord0 0) mul0r //. +rewrite big_ord_recl => /= //. etransitivity. 2 : rewrite big_ord_recl => /= //. rewrite Hc. @@ -568,7 +568,7 @@ Qed. Lemma big_max_mul {n:nat} (F : ordinal (n.+1) -> R) a: 0 <= a -> \big[maxr/0]_(i0 < n.+1) (F i0) * a = \big[maxr/0]_(i0 < n.+1) (F i0 * a). -Proof. +Proof. move => Ha. apply big_mul => //. move => i b. @@ -579,7 +579,7 @@ Qed. Lemma normv_pos {m} (v: 'cV[R]_m.+1) : 0 <= normv v. Proof. -rewrite /normr/normv. +rewrite /normr/normv. elim/big_ind: _ => //[x y Hx Hy| i _]. rewrite -RmaxE. eapply le_trans; [apply Hy|]. apply /RleP; apply Rmax_r. @@ -588,10 +588,10 @@ Qed. Lemma normM_pos {m} (A: 'M[R]_m.+1) : 0 <= normM A. Proof. -rewrite /normr/normM . +rewrite /normr/normM . elim/big_ind: _ => //[x y Hx Hy| i _]. rewrite -RmaxE/Rmax. destruct Rle_dec => //. -rewrite /sum_abs. +rewrite /sum_abs. elim/big_ind: _ => //[x y Hx Hy| j _]. apply addr_ge0 => //. apply /RleP; apply Rabs_pos. @@ -600,8 +600,8 @@ Qed. Lemma Rabs_sum (n:nat) : forall (F : ordinal (n.+1) -> R), Rabs (\sum_j F j) <= \sum_j Rabs (F j). Proof. -elim : n => [F | n IH F]. -rewrite !big_ord_recr!big_ord0/=. +elim : n => [F | n IH F]. +rewrite !big_ord_recr!big_ord0/=. eapply le_trans ; [apply Rleb_norm_add| rewrite Rabs_R0; apply ler_add => /= //]. eapply le_trans. 1, 2: rewrite big_ord_recr /=. apply Rleb_norm_add. @@ -609,17 +609,17 @@ apply ler_add => /= //. Qed. -Lemma subMultNorm m (A: 'M[R]_m.+1) (u : 'cV_m.+1) : +Lemma subMultNorm m (A: 'M[R]_m.+1) (u : 'cV_m.+1) : normv ( A *m u ) <= normM A * normv u. Proof. remember (normv u) as umax. rewrite /normr /normM /normv /sum_abs /= big_max_mul. -apply le_bigmax2 => i0 _. +apply le_bigmax2 => i0 _. rewrite mxE => /=. eapply le_trans. apply Rabs_sum . elim/big_rec2: _ => // [ |i1 y1 y2 _ Hy]. -apply mulr_ge0 => //. +apply mulr_ge0 => //. rewrite Hequmax; apply normv_pos. rewrite mulrDl. apply ler_add => //. @@ -631,17 +631,17 @@ by apply /le_bigmax. rewrite Hequmax; apply normv_pos. Qed. -Lemma normv_triang m (u v: 'cV_m.+1) : +Lemma normv_triang m (u v: 'cV_m.+1) : normv ( u + v ) <= normv u + normv v. Proof. rewrite {1}/normv. -apply: bigmax_le => [ | i _]. +apply: bigmax_le => [ | i _]. apply addr_ge0; apply normv_pos. rewrite mxE => /=. eapply le_trans. apply Rleb_norm_add. apply ler_add; -apply: le_bigmax => [ | i _]. +apply: le_bigmax => [ | i _]. Qed. -End Norms. +End Norms. diff --git a/accuracy_proofs/sum_acc.v b/accuracy_proofs/sum_acc.v index 8f9b6c5..2bb7b9d 100644 --- a/accuracy_proofs/sum_acc.v +++ b/accuracy_proofs/sum_acc.v @@ -1,4 +1,4 @@ -(*This file contains two theorems: forward and backward error bounds for +(*This file contains two theorems: forward and backward error bounds for the sum of two floating point lists; the functional model for the summation is defined in sum_model.v.*) @@ -12,7 +12,7 @@ Open Scope R. Require Import Sorting Permutation. -Section BackwardError. +Section BackwardError. Variable (NAN: Nans) (t: type). Notation g := (@g t). Notation D := (@default_rel t). @@ -22,14 +22,14 @@ Notation xR := (map FT2R x). Hypothesis (Hfin: Binary.is_finite (fprec t) (femax t) (sumF x) = true). Theorem bSUM : - exists (x': list R), + exists (x': list R), length x' = length x /\ FT2R (sumF x) = sumR x' /\ - (forall n, (n < length x')%nat -> exists delta, + (forall n, (n < length x')%nat -> exists delta, nth n x' 0 = FT2R (nth n x neg_zero) * (1 + delta) /\ Rabs delta <= g (length x' - 1)). Proof. induction x. -{ intros; exists []; repeat split; auto. intros. +{ intros; exists []; repeat split; auto. intros. intros. simpl in H; assert (n = 0)%nat by lia; subst. exists 0; split; [simpl; nra| unfold g; rewrite Rabs_R0; simpl; nra]. } @@ -43,10 +43,10 @@ destruct Hl. (* case empty l *) { subst; simpl in *; destruct (BPLUS_finite_e _ _ Hfin). - exists [FT2R a]; split; [ simpl; auto | split ; + exists [FT2R a]; split; [ simpl; auto | split ; [unfold sum; rewrite BPLUS_neg_zero|] ]. - unfold sumR; simpl; nra. auto. - intros. exists 0; simpl in H1; split; + unfold sumR; simpl; nra. auto. + intros. exists 0; simpl in H1; split; [assert ((n = 1)%nat \/ (n = 0)%nat) by lia; destruct H2; subst; simpl; nra|]. rewrite Rabs_R0; simpl; unfold g; nra. } @@ -62,8 +62,8 @@ pose proof (BPLUS_accurate' a (sumF l) Hfin) as Hplus. destruct Hplus as (d' & Hd'& Hplus). exists (FT2R a * (1+d') :: map (Rmult (1+d')) l'); repeat split. { simpl; auto. rewrite map_length; auto. } -{ simpl; rewrite Hplus, Rmult_plus_distr_r, Hsum, <- sumR_mult; auto. } -intros. destruct n. +{ simpl; rewrite Hplus, Rmult_plus_distr_r, Hsum, <- sumR_mult; auto. } +intros. destruct n. { simpl. exists d'; split; auto. eapply Rle_trans; [apply Hd'| ]. apply d_le_g_1. rewrite map_length; auto. rewrite Hlen'. lia. } @@ -73,7 +73,7 @@ specialize (Hdel n Hlen2). destruct Hdel as (d & Hd1 & Hd2). exists ( (1+d') * (1+d) -1). simpl; split. { replace 0 with (Rmult (1 + d') 0) by nra. rewrite map_nth; rewrite Hd1; nra. } -rewrite map_length. field_simplify_Rabs. +rewrite map_length. field_simplify_Rabs. eapply Rle_trans; [apply Rabs_triang | eapply Rle_trans; [apply Rplus_le_compat_r; apply Rabs_triang | ] ]. rewrite Rabs_mult. replace (Rabs d' * Rabs d + Rabs d' + Rabs d ) with @@ -88,7 +88,7 @@ replace ((1 + D) * g (length l' - 1) + D) with rewrite one_plus_d_mul_g; apply Req_le; rewrite Rmult_1_r. f_equal; lia. Qed. -End BackwardError. +End BackwardError. Section ForwardError. @@ -98,7 +98,7 @@ Notation g1 := (@g1 t). Notation D := (@default_rel t). Variable (x : list (ftype t)). -Notation xR := (map FT2R x). +Notation xR := (map FT2R x). Notation n := (length x). Hypothesis (Hfin: Binary.is_finite (fprec t) (femax t) (sumF x) = true). @@ -108,7 +108,7 @@ Theorem fSUM : Proof. induction x. { intros; unfold g; subst; simpl; - rewrite Rminus_0_r, Rabs_R0; nra. } + rewrite Rminus_0_r, Rabs_R0; nra. } (* case a::l *) intros. assert (Hl: l = [] \/ l <> []). @@ -120,7 +120,7 @@ destruct Hl. { subst. unfold g; simpl; subst. destruct (BPLUS_finite_e _ _ Hfin) as (A & B). rewrite BPLUS_neg_zero; auto. -field_simplify_Rabs; field_simplify; rewrite Rabs_R0. +field_simplify_Rabs; field_simplify; rewrite Rabs_R0. apply Rmult_le_pos; auto with commonDB; apply Rabs_pos. } (* case non-empty l *) simpl in *. @@ -129,18 +129,18 @@ destruct (BPLUS_finite_e _ _ Hfin) as (A & B). specialize (IHl B). (* accuracy rewrites *) destruct (BPLUS_accurate' a (sumF l) Hfin) as (d' & Hd'& Hplus). -rewrite Hplus. +rewrite Hplus. (* algebra *) field_simplify_Rabs. -set (s0 := sumR (map FT2R l)). +set (s0 := sumR (map FT2R l)). set (s := (sumF l)). replace (- FT2R a * d' + s0 - FT2R s * d' - FT2R s) with ((s0 - FT2R s) - d' * (FT2R s + FT2R a)) by nra. -eapply Rle_trans; +eapply Rle_trans; [ apply Rabs_triang | eapply Rle_trans; [ apply Rplus_le_compat_r | rewrite !Rabs_Ropp] ]. apply IHl. -eapply Rle_trans; +eapply Rle_trans; [apply Rplus_le_compat_l | ]. rewrite Rabs_mult. apply Rmult_le_compat; try apply Rabs_pos. apply Hd'. @@ -150,20 +150,20 @@ rewrite !Rmult_plus_distr_l; rewrite <- !Rplus_assoc. set (s1 := sumR (map Rabs (map FT2R l))). replace (g (length l ) * s1 + D * (g (length l ) * s1)) with ((1+ D) * g (length l) * s1) by nra. -eapply Rle_trans; [apply Rplus_le_compat_r; +eapply Rle_trans; [apply Rplus_le_compat_r; apply Rplus_le_compat_l; apply Rmult_le_compat_l; try apply Rabs_pos|]. apply default_rel_ge_0. apply sumR_le_sumRabs. rewrite sumRabs_Rabs. -rewrite one_plus_d_mul_g. +rewrite one_plus_d_mul_g. rewrite Rplus_comm. apply length_not_empty in H; auto. apply Rplus_le_compat. -apply Rmult_le_compat; try apply Rabs_pos; +apply Rmult_le_compat; try apply Rabs_pos; try apply default_rel_ge_0; try nra. -apply d_le_g_1; lia. +apply d_le_g_1; lia. apply Req_le; f_equal. -f_equal. lia. +f_equal. lia. Qed. End ForwardError. @@ -176,8 +176,8 @@ Notation g1 := (@g1 t). Notation D := (@default_rel t). Variable (x x0: list (ftype t)). -Notation xR := (map FT2R x). -Notation xR0 := (map FT2R x0). +Notation xR := (map FT2R x). +Notation xR0 := (map FT2R x0). Notation n := (length x). Hypothesis (Hfin: Binary.is_finite (fprec t) (femax t) (sumF x) = true). @@ -198,7 +198,7 @@ Proof. rewrite (sumR_permute xR xR0); [|apply Permutation_map; auto]. eapply Rle_trans. apply sum_forward_error_permute'. -apply Req_le; f_equal. +apply Req_le; f_equal. rewrite (sumR_permute (map Rabs xR) (map Rabs xR0)); auto. repeat (apply Permutation_map); auto. Qed. diff --git a/accuracy_proofs/sum_is_finite.v b/accuracy_proofs/sum_is_finite.v index afe1c4f..33b29e1 100644 --- a/accuracy_proofs/sum_is_finite.v +++ b/accuracy_proofs/sum_is_finite.v @@ -32,8 +32,8 @@ Definition fun_bnd (t : type) (n : nat) := fmax t / (1 + default_rel t) * 1 / (1 + INR n * (g t (n - 1) + 1)) . Lemma rdiv_lt (a b: R) : - 0 < b -> 0 < a -> b < a -> / a < / b. -Proof. + 0 < b -> 0 < a -> b < a -> / a < / b. +Proof. intros. replace (/b) with (1/b) by nra. apply Rdiv_lt_right; auto. @@ -43,9 +43,9 @@ nra. Qed. Lemma rdiv_le (a b: R) : - 0 < b -> 0 < a -> b <= a -> / a <= / b. -Proof. -intros. + 0 < b -> 0 < a -> b <= a -> / a <= / b. +Proof. +intros. replace (/b) with (1/b) by nra. apply Rcomplements.Rle_div_r; auto. rewrite Rmult_comm. @@ -61,7 +61,7 @@ Qed. Lemma fun_bnd_le (t : type) (n : nat) : fun_bnd t (S n) <= fun_bnd t n. -Proof. +Proof. intros; unfold fun_bnd. apply Rmult_le_compat_l. rewrite Rmult_1_r. apply Rcomplements.Rdiv_le_0_compat. @@ -84,13 +84,13 @@ simpl; lia. Qed. -Lemma finite_sum_from_bounded : +Lemma finite_sum_from_bounded : forall (t: type) (l: list (ftype t)) - (fs : ftype t) + (fs : ftype t) (Hfs: sum_rel_Ft t l fs), - (forall x, In x l -> - Binary.is_finite _ _ x = true /\ Rabs (FT2R x) < fun_bnd t (length l)) -> - Binary.is_finite _ _ fs = true. + (forall x, In x l -> + Binary.is_finite _ _ x = true /\ Rabs (FT2R x) < fun_bnd t (length l)) -> + Binary.is_finite _ _ fs = true. Proof. intros ?. induction l. @@ -99,15 +99,15 @@ induction l. assert (Hin: forall x : ftype t, In x l -> Binary.is_finite _ _ x = true /\ Rabs (FT2R x) < fun_bnd t (length l)). - { intros. split; [apply H; simpl; auto | ]. + { intros. split; [apply H; simpl; auto | ]. eapply Rlt_le_trans; [apply H; simpl; auto | ]. - apply fun_bnd_le. } + apply fun_bnd_le. } assert (Hfina : Binary.is_finite (fprec t) (femax t) a = true) by (apply H; simpl; auto). unfold sum. fold (@sum_rel_Ft NAN t) in H3. -specialize (IHl s H3 Hin). -apply is_finite_sum_no_overflow'; auto. +specialize (IHl s H3 Hin). +apply is_finite_sum_no_overflow'; auto. unfold Bplus_no_overflow. assert (A: Generic_fmt.generic_format Zaux.radix2 (FLT.FLT_exp (SpecFloat.emin (fprec t) (femax t)) (fprec t)) @@ -139,11 +139,11 @@ eapply Rle_trans; [apply Rabs_triang | apply Rplus_le_compat ]. apply Rlt_le; apply H; simpl; auto. assert (Rabs (FT2R s) <= (g t (length l - 1) + 1) * rs_abs). { eapply Rle_trans; [apply H1| field_simplify; apply Rplus_le_compat_l]. - eapply Rle_trans; [ eapply sum_rel_R_Rabs; [apply Hrs | apply Habs] |] . + eapply Rle_trans; [ eapply sum_rel_R_Rabs; [apply Hrs | apply Habs] |] . eapply Req_le; eapply sum_rel_R_Rabs_eq; apply Habs. } eapply Rle_trans. apply H0. -apply Rmult_le_compat_l. +apply Rmult_le_compat_l. apply Rplus_le_le_0_compat; try nra. apply g_pos. apply D. apply Habs. intros. apply Rlt_le. apply H; simpl; auto. @@ -151,7 +151,7 @@ assert (HD: Rabs (1 + d) <= (1 + default_rel t )). { eapply Rle_trans; [apply Rabs_triang| rewrite Rabs_R1; apply Rplus_le_compat_l]. eapply Rle_trans; [apply Hd |]. apply Rdiv_le_left. -apply Fourier_util.Rlt_zero_pos_plus1. +apply Fourier_util.Rlt_zero_pos_plus1. apply default_rel_gt_0. eapply Rle_trans with (default_rel t * 1); try nra. } apply HD. @@ -173,13 +173,13 @@ assert (Hy : 0 < y). apply g_pos. } assert (Hy' : y <> 0). { apply Stdlib.Rlt_neq_sym; auto. } assert (H0: (1 + default_rel t) * z = fmax t / y). -{ unfold z; field_simplify; auto. -split; auto. +{ unfold z; field_simplify; auto. +split; auto. apply tech_Rplus; try nra. apply default_rel_gt_0. } rewrite H0. rewrite rdiv_mult_eq; auto. -replace (bpow Zaux.radix2 (femax t)) with +replace (bpow Zaux.radix2 (femax t)) with (bpow Zaux.radix2 (femax t) * 1) by nra. rewrite Rmult_assoc. apply Rmult_lt_compat_l. apply bpow_gt_0. @@ -191,10 +191,10 @@ unfold y. apply Rplus_le_lt_compat; try nra. rewrite Rmult_comm. eapply Rle_lt_trans with (INR (length l) * x). -apply Rmult_le_compat_l; [apply pos_INR|]. +apply Rmult_le_compat_l; [apply pos_INR|]. unfold x. apply Rplus_le_compat_r. -unfold g. +unfold g. apply Rplus_le_compat_r. apply Rle_pow. apply default_rel_plus_1_ge_1. diff --git a/accuracy_proofs/sum_model.v b/accuracy_proofs/sum_model.v index 00fe7f8..f823f74 100644 --- a/accuracy_proofs/sum_model.v +++ b/accuracy_proofs/sum_model.v @@ -47,7 +47,7 @@ apply IHl; auto. Qed. -Lemma sum_rel_R_Rabs_pos : +Lemma sum_rel_R_Rabs_pos : forall l s, sum_rel_R (map Rabs l) s -> 0 <= s. Proof. @@ -79,7 +79,7 @@ nra. intros. inversion H; subst; clear H. unfold sum. -replace (Rabs(Rabs a + s0)) with +replace (Rabs(Rabs a + s0)) with (Rabs a + s0); try nra. symmetry. rewrite Rabs_pos_eq; try nra. @@ -113,7 +113,7 @@ fold sum_rel_R in H3. unfold sum. eapply Rle_trans. apply Rabs_triang. -replace (Rabs(Rabs a + s0)) with +replace (Rabs(Rabs a + s0)) with (Rabs a + s0). eapply Rplus_le_compat; try nra. eapply Rle_trans with (Rabs s0). @@ -147,18 +147,18 @@ forall (a : R) , sum_rel_R [a] a. Proof. intros. unfold sum_rel_R. -replace a with (a + 0) at 2 by nra. +replace a with (a + 0) at 2 by nra. apply sum_rel_cons. apply sum_rel_nil. -Qed. +Qed. Lemma sum_rel_R_app_cons : forall l' l'' a s, sum_rel_R (l' ++ l'') s -> sum_rel_R (l' ++ a :: l'') (a + s). Proof. -induction l'; simpl. +induction l'; simpl. { intros; apply sum_rel_cons; auto. } -intros. +intros. inversion H; subst; clear H. specialize (IHl' l'' a0 s0 H3). unfold sum. @@ -174,15 +174,15 @@ Lemma sum_rel_bound : Proof. induction l; intros. { inversion Hrs; subst; simpl; rewrite Rabs_R0; nra. } - inversion Hrs; subst. + inversion Hrs; subst. unfold sum; eapply Rle_trans; [apply Rabs_triang|]. eapply Rle_trans; [apply Rplus_le_compat; - [apply Hin; simpl; auto| apply IHl; + [apply Hin; simpl; auto| apply IHl; [ apply H2 | intros; apply Hin; simpl; auto ] ] | ]. apply Req_le. replace (length (a :: l)) with (length l + 1)%nat by (simpl; lia). rewrite plus_INR; simpl; nra. Qed. - + Lemma sum_rel_R_permute : forall (l l0: list R) (Hper: Permutation l l0) (rs: R) @@ -242,11 +242,11 @@ eapply Rle_trans. 2: rewrite Rabs_pos_eq. apply Rabs_triang. apply Rplus_le_compat_l; auto. -apply Rplus_le_le_0_compat; +apply Rplus_le_le_0_compat; [apply Rabs_pos| apply sumRabs_pos]. Qed. -Lemma sumR_app_cons l' l'' a: +Lemma sumR_app_cons l' l'' a: a + sumR (l' ++ l'') = sumR (l' ++ a :: l''). Proof. induction l'; simpl; [nra | rewrite <- IHl'; nra]. Qed. @@ -271,7 +271,7 @@ From vcfloat Require Import IEEE754_extra. Section NAN. Lemma plus_zero {NAN: Nans} a: -Binary.is_finite _ _ a = true -> +Binary.is_finite _ _ a = true -> (a + -0)%F32 = a. Proof. destruct a; simpl; auto; @@ -288,10 +288,10 @@ Lemma sum_rel_bound' : Proof. induction l; intros. { inversion Hrs; subst; simpl; rewrite Rabs_R0; nra. } - inversion Hrs; subst. + inversion Hrs; subst. unfold sum; eapply Rle_trans; [apply Rabs_triang|]. eapply Rle_trans; [apply Rplus_le_compat; - [apply Hin; simpl; auto| apply IHl; + [apply Hin; simpl; auto| apply IHl; [ apply H2 | intros; apply Hin; simpl; auto ] ] | ]. apply Req_le. replace (length (a :: l)) with (length l + 1)%nat by (simpl; lia). rewrite plus_INR; simpl; nra. @@ -308,19 +308,19 @@ induction l; intros. inversion Hrs; subst. unfold sum. fold sum_rel_R in H2. eapply Rle_trans; [apply Rplus_le_compat; - [apply Hin; simpl; auto| apply IHl; + [apply Hin; simpl; auto| apply IHl; [ apply H2 | intros; apply Hin; simpl; auto ] ] | ]. apply Req_le. replace (length (a :: l)) with (length l + 1)%nat by (simpl; lia). rewrite plus_INR; simpl; nra. -Qed. +Qed. -Lemma sum_rel_R_fold : forall l rs, +Lemma sum_rel_R_fold : forall l rs, sum_rel_R l rs -> rs = sumR l. -Proof. +Proof. induction l. intros; inversion H; simpl; auto. -intros; inversion H. +intros; inversion H. fold sum_rel_R in H3. specialize (IHl s H3). subst; simpl. @@ -328,9 +328,9 @@ unfold sum; auto. Qed. Lemma sum_map_Rmult (l : list R) (s a: R): -sum_rel_R l s -> -sum_rel_R (map (Rmult a) l) (a * s). -Proof. +sum_rel_R l s -> +sum_rel_R (map (Rmult a) l) (a * s). +Proof. revert l s a. induction l. { intros. simpl. inversion H; subst; rewrite Rmult_0_r; auto. } intros. inversion H. destruct l. @@ -351,7 +351,7 @@ Proof. intros. inversion H0. inversion H4; subst. -unfold sum, BPLUS; destruct a; try discriminate; +unfold sum, BPLUS; destruct a; try discriminate; simpl; auto. destruct s; simpl; auto. Qed. @@ -363,10 +363,10 @@ Lemma sum_rel_R_exists {NAN: Nans}: Proof. intros ?. induction l. { simpl; exists 0. apply sum_rel_nil. } -intros. inversion Hfs; subst. +intros. inversion Hfs; subst. fold (@sum_rel_Ft NAN t) in H2. destruct (IHl s H2) as (rs & Hrs); clear IHl. -exists (FT2R a + rs); simpl. +exists (FT2R a + rs); simpl. apply sum_rel_cons; auto. Qed. @@ -377,25 +377,25 @@ Lemma sum_rel_R_abs_exists {NAN: Nans}: Proof. intros ?. induction l. { simpl; exists 0. apply sum_rel_nil. } -intros. inversion Hfs; subst. +intros. inversion Hfs; subst. fold (@sum_rel_Ft NAN t) in H2. destruct (IHl s H2) as (rs & Hrs); clear IHl. -exists (Rabs (FT2R a) + rs); simpl. +exists (Rabs (FT2R a) + rs); simpl. apply sum_rel_cons; auto. Qed. - + Lemma is_finite_in {NAN: Nans} (t : type) : forall (l : list (ftype t)) fs, sum_rel_Ft t l fs -> let e := @default_abs t in - let d := @default_rel t in + let d := @default_rel t in let ov := powerRZ 2 (femax t) in Binary.is_finite (fprec t) (femax t) fs = true -> forall a, In a l -> Binary.is_finite (fprec t) (femax t) a = true. Proof. induction l. simpl; intros; auto. -intros. +intros. destruct H1; subst. inversion H. rewrite <- H2 in H0. clear H2. @@ -415,12 +415,12 @@ Qed. Definition sumF {NAN: Nans} {t: type} := fold_right (@BPLUS NAN t) neg_zero. -Lemma sum_rel_Ft_fold {NAN: Nans} : forall t l fs, +Lemma sum_rel_Ft_fold {NAN: Nans} : forall t l fs, sum_rel_Ft t l fs -> fs = sumF l. -Proof. +Proof. induction l. intros; inversion H; simpl; auto. -intros; inversion H. +intros; inversion H. fold (@sum_rel_Ft NAN t) in H3. specialize (IHl s H3). subst; simpl. diff --git a/accuracy_proofs/vec_op_acc.v b/accuracy_proofs/vec_op_acc.v index 4658d0d..348d897 100644 --- a/accuracy_proofs/vec_op_acc.v +++ b/accuracy_proofs/vec_op_acc.v @@ -36,24 +36,24 @@ Lemma scaleV_mixed_error : map FT2R (scaleVF a v) = scaleVR (FT2R a) (vr +v e) +v eta /\ (forall i, (i < m)%nat -> exists d, List.nth i e 0 = (List.nth i vr 0%R) * d - /\ Rabs d <= g m) - /\ (forall e0, In e0 eta -> Rabs e0 <= g1 m m) + /\ Rabs d <= g m) + /\ (forall e0, In e0 eta -> Rabs e0 <= g1 m m) /\ length e = length v /\ length eta = length v . Proof. move => v. elim: v => /= [a _|]. -{ rewrite /vec_sumR/vec_sum/map2/=. +{ rewrite /vec_sumR/vec_sum/map2/=. by exists [], []. } -move => v0 v IH. intros. +move => v0 v IH. intros. have Hfin': is_finite_vec (scaleVF a v) /\ Binary.is_finite _ _ (BMULT a v0). by apply is_finite_vec_cons in Hfinv. case Hfin' => HA HB. -destruct (IH a) as +destruct (IH a) as (e & eta & Heq & He & Heta) => //. clear IH. rewrite Heq. clear Heq. -destruct (BMULT_accurate a v0) as +destruct (BMULT_accurate a v0) as (del & eps & HD & HE & HF & Heq). by apply is_finite_BMULT_no_overflow. rewrite Heq. clear Heq. @@ -66,12 +66,12 @@ destruct i => /=. exists del; split; [nra|]. apply /RleP. eapply Rle_trans. apply HE => /=. rewrite -Nat.add_1_r; -auto with commonDB. +auto with commonDB. have Hi': (i < length v)%nat by lia. destruct (He i Hi') as (x & He' & Hx). -rewrite He'. -exists x; split => //=. -eapply le_trans. apply Hx. +rewrite He'. +exists x; split => //=. +eapply le_trans. apply Hx. apply /RleP; auto with commonDB. } move => e0 [Hin| Hin]. { rewrite -Hin. apply /RleP. @@ -109,25 +109,25 @@ Lemma vec_sumF_mixed_error : /\ length e1 = length u /\ length e2 = length v. Proof. -move => u. +move => u. (* main induction on right vector *) -elim u. -{ move => v /=; intros. +elim u. +{ move => v /=; intros. exists [], [] => /=; repeat split => //=. rewrite -Hlen. intros => //. -rewrite -Hlen. intros => //. } +rewrite -Hlen. intros => //. } clear u; move => u0 u IH v. (* main induction *) -case: v => //. -move => v0 v. intros. +case: v => //. +move => v0 v. intros. rewrite /vec_sumF vec_sum_cons. have Hfin: is_finite_vec (vec_sum BPLUS u v) /\ (Binary.is_finite _ _ (BPLUS u0 v0) = true). -simpl in Hfinv. rewrite /vec_sumF vec_sum_cons in Hfinv. +simpl in Hfinv. rewrite /vec_sumF vec_sum_cons in Hfinv. apply is_finite_vec_cons in Hfinv. destruct Hfinv => //. destruct Hfin as (H1f & H2f). -rewrite /vec_sumF in IH. +rewrite /vec_sumF in IH. destruct (IH v) as (e1 & e2 & Heq & H) => //; clear IH. simpl in Hlen; lia. simpl; rewrite Heq. @@ -135,30 +135,30 @@ destruct (BPLUS_accurate' u0 v0) as (del & Hd & H1) => //. rewrite H1; clear H1. rewrite !CommonSSR.map_map_equiv/=. exists (((FT2R u0) * del) :: e1), (((FT2R v0) * del) :: e2); - repeat split. + repeat split. { rewrite /ur/vr/=/vec_sumR !vec_sum_cons. -f_equal. +f_equal. rewrite -!RmultE; nra. } { move => i Hi; destruct i => /=. exists del; split => //=. -apply /RleP. by apply Hd. +apply /RleP. by apply Hd. destruct H as (H & H1). -elim: (H i). +elim: (H i). clear H; move => d' Hd'. destruct Hd' as (Hd' & Hd''). exists d'; split => //=. -unfold m in Hi. simpl in Hi. lia. } +unfold m in Hi. simpl in Hi. lia. } { move => i Hi; destruct i => /=. exists del; split => //=. apply /RleP. by apply Hd. destruct H as (_ & H1 & _). -elim: (H1 i). +elim: (H1 i). clear H1; move => d' Hd'. destruct Hd' as (Hd' & Hd''). exists d'; split => //=. -unfold m in Hi; simpl in Hi; lia. } -all : simpl; lia. +unfold m in Hi; simpl in Hi; lia. } +all : simpl; lia. Qed. Lemma Svec_sumF_mixed_error : @@ -169,9 +169,9 @@ Lemma Svec_sumF_mixed_error : let ur:= map FT2R u in let m := length v in exists (e1 e2 e3 e4 e5 e6: vector), - map FT2R (vec_sumF (scaleVF a u) (scaleVF b v)) = - vec_sumR - (scaleVR (FT2R a) (ur +v e1) +v e2 +v e3) + map FT2R (vec_sumF (scaleVF a u) (scaleVF b v)) = + vec_sumR + (scaleVR (FT2R a) (ur +v e1) +v e2 +v e3) (scaleVR (FT2R b) (vr +v e4) +v e5 +v e6) /\ (forall i, (i < m)%nat -> exists d, List.nth i e1 0 = (List.nth i ur 0%R) * d @@ -180,11 +180,11 @@ Lemma Svec_sumF_mixed_error : List.nth i e4 0 = (List.nth i vr 0%R) * d /\ Rabs d <= g m ) /\ (forall i : nat, (i < m)%nat -> exists d, - List.nth i e3 0 = (List.nth i (scaleVR (FT2R a) (ur +v e1) +v e2) 0%R) * d - /\ Rabs d <= @default_rel t) + List.nth i e3 0 = (List.nth i (scaleVR (FT2R a) (ur +v e1) +v e2) 0%R) * d + /\ Rabs d <= @default_rel t) /\ (forall i : nat, (i < m)%nat -> exists d, - List.nth i e6 0 = (List.nth i (scaleVR (FT2R b) (vr +v e4) +v e5) 0%R) * d - /\ Rabs d <= @default_rel t) + List.nth i e6 0 = (List.nth i (scaleVR (FT2R b) (vr +v e4) +v e5) 0%R) * d + /\ Rabs d <= @default_rel t) (* absolute error terms *) /\ (forall k : R, In k e5 -> Rabs k <= g1 m m) /\ (forall k : R, In k e2 -> Rabs k <= g1 m m) @@ -202,16 +202,16 @@ destruct (vec_sumF_mixed_error (scaleVF a u) (scaleVF b v)) as (Du & Dv & Heq & HD) => //. by rewrite !map_length. apply is_finite_vec_sum in Hfinv; destruct Hfinv. -destruct (scaleV_mixed_error u a) as +destruct (scaleV_mixed_error u a) as (ae & aeta & Heqa & Hea & Haeta & HA1 & HA2) => //. -destruct (scaleV_mixed_error v b) as +destruct (scaleV_mixed_error v b) as (be & beta & Heqb & Heb & Hbeta & HB1 & HB2) => //. rewrite Heq. rewrite Heqb Heqa. rewrite Heqa Heqb in HD. clear Heq Heqa Heqb. destruct HD as (HDu & HDv & HD1 & HD2). rewrite !CommonSSR.map_map_equiv. exists ae, aeta ,Du, be, beta, Dv; repeat split => //; try lia. -{ intros; destruct (Hea i) . +{ intros; destruct (Hea i) . rewrite Hu; lia. exists x; rewrite Hu in H2; apply H2. } { intros; destruct (HDu i) . @@ -222,16 +222,16 @@ rewrite !map_length. fold m; lia. rewrite !CommonSSR.map_map_equiv in H2. fold m in H2; exists x. apply H2. } rewrite -Hu. -by apply Haeta. +by apply Haeta. rewrite !map_length in HD1; lia. rewrite !map_length in HD2; lia. all: by rewrite !map_length. -Qed. +Qed. End VECSUMERROR. -Section SCALEFMV. +Section SCALEFMV. (* mixed error bounds over lists *) Context {NAN: Nans} {t : type}. @@ -252,19 +252,19 @@ Hypothesis Hlen: forall row, In row A -> length row = length v. Lemma Smat_vec_mul_mixed_error: exists (E : matrix) (e eta1 eta2 : vector), - map FT2R (scaleVF b (A *f v)) = - scaleVR (FT2R b) ((Ar +m E) *r vr +v eta1 +v e) +v eta2 - /\ (forall i j, (i < m)%nat -> (j < n)%nat -> - Rabs (E _(i,j)) <= g n * Rabs (Ar _(i,j))) - /\ (forall k, In k eta2 -> Rabs k <= g1 m m) - /\ eq_size E A + map FT2R (scaleVF b (A *f v)) = + scaleVR (FT2R b) ((Ar +m E) *r vr +v eta1 +v e) +v eta2 + /\ (forall i j, (i < m)%nat -> (j < n)%nat -> + Rabs (E _(i,j)) <= g n * Rabs (Ar _(i,j))) + /\ (forall k, In k eta2 -> Rabs k <= g1 m m) + /\ eq_size E A /\ length eta2 = m /\ (forall i : nat, (i < m)%nat -> exists d : GRing.Ring.sort R_ringType, (List.nth i e 0 = List.nth i (A *fr v) 0 * d /\ (Rabs d) <= g m)) /\ (forall k : R, - (In k eta1) -> is_true ((Rabs k) <= (g1 n n))) + (In k eta1) -> is_true ((Rabs k) <= (g1 n n))) /\ length eta1= m. Proof. (* proof follows from previous bounds for scaling @@ -274,16 +274,16 @@ destruct (@scaleV_mixed_error NAN t (A *f v) b) rewrite Heq. clear Heq. destruct (@mat_vec_mul_mixed_error NAN t A v) as (E & eta1 & Heq1 & H1). -{ apply (is_finite_scaleV b) => //. } -{ intros; by apply Hlen. } +{ apply (is_finite_scaleV b) => //. } +{ intros; by apply Hlen. } rewrite !CommonSSR.map_map_equiv. -rewrite Heq1. +rewrite Heq1. rewrite !CommonSSR.map_map_equiv in H. rewrite Heq1 in H. clear Heq1. have Hlen1: (length (A *f v)) = m. by rewrite !map_length. exists E, e, eta1, eta; repeat split => //. -destruct H1. +destruct H1. intros; apply H0 => //. destruct H as (_ & H & _); intros. rewrite Hlen1 in H. by apply H. @@ -296,7 +296,7 @@ destruct H as ( _ & H ). destruct H;intros. by rewrite H0 !map_length. rewrite !CommonSSR.map_map_equiv in H. -destruct H as (H & _); intros. +destruct H as (H & _); intros. destruct (H i). by rewrite Hlen1. exists x; destruct H2; split => //. by rewrite Hlen1 in H3. @@ -306,9 +306,9 @@ destruct H1 as (_ & _ & H2). by apply H2. Qed. -End SCALEFMV. +End SCALEFMV. -Section GEMV. +Section GEMV. (* mixed error bounds over lists *) Context {NAN: Nans} {t : type}. @@ -325,32 +325,32 @@ Notation Ar := (map_mat FT2R A). Notation xr := (map FT2R x). Notation yr := (map FT2R y). -Hypothesis Hfin : is_finite_vec +Hypothesis Hfin : is_finite_vec (vec_sumF (scaleVF s1 (A *f x)) (scaleVF s2 y)). Hypothesis Hlen: forall row, In row A -> length row = length x. Hypothesis Hleny: length y = m. Lemma gemv_error: exists (e1 : matrix) (e2 e3 e4 e5 e6 e7 e8: vector), - map FT2R (vec_sumF (scaleVF s1 (A *f x)) (scaleVF s2 y)) = + map FT2R (vec_sumF (scaleVF s1 (A *f x)) (scaleVF s2 y)) = ((scaleVR (FT2R s1) ((((Ar +m e1) *r xr) +v e2) +v e3) +v e4) +v e5) +v ((scaleVR (FT2R s2) (List.map FT2R y +v e6) +v e7) +v e8) /\ (forall i j : nat, (i < m)%nat -> (j < n)%nat -> - Rabs (matrix_index e1 i j 0%Re) <= g n * Rabs (matrix_index Ar i j 0%Re)) - /\ (forall k : R, In k e2 -> Rabs k <= g1 n n) + Rabs (matrix_index e1 i j 0%Re) <= g n * Rabs (matrix_index Ar i j 0%Re)) + /\ (forall k : R, In k e2 -> Rabs k <= g1 n n) /\ (forall i : nat, (i < m)%nat -> exists d, - List.nth i e3 0 = List.nth i (((Ar +m e1) *r xr) +v e2) 0%Re * d - /\ Rabs d <= g m ) + List.nth i e3 0 = List.nth i (((Ar +m e1) *r xr) +v e2) 0%Re * d + /\ Rabs d <= g m ) /\ (forall i : nat, (i < m)%nat -> exists d, - List.nth i e6 0 = List.nth i (List.map FT2R y) 0%Re * d - /\ Rabs d <= g m) + List.nth i e6 0 = List.nth i (List.map FT2R y) 0%Re * d + /\ Rabs d <= g m) /\ (forall i : nat, (i < m)%nat -> exists d, - List.nth i e5 0 = List.nth i (scaleVR (FT2R s1) ((((Ar +m e1) *r xr) +v e2) +v e3) +v e4) 0%Re * d - /\ Rabs d <= @default_rel t) + List.nth i e5 0 = List.nth i (scaleVR (FT2R s1) ((((Ar +m e1) *r xr) +v e2) +v e3) +v e4) 0%Re * d + /\ Rabs d <= @default_rel t) /\ (forall i : nat, (i < m)%nat -> exists d , - List.nth i e8 0 = List.nth i (scaleVR (FT2R s2) (List.map FT2R y +v e6) +v e7) 0%Re * d - /\ Rabs d <= @default_rel t) + List.nth i e8 0 = List.nth i (scaleVR (FT2R s2) (List.map FT2R y +v e6) +v e7) 0%Re * d + /\ Rabs d <= @default_rel t) /\ (forall k : R, In k e7 -> Rabs k <= g1 m m) /\ (forall k0 : R, In k0 e4 -> Rabs k0 <= g1 m m). @@ -367,7 +367,7 @@ destruct (mat_vec_mul_mixed_error A x) by apply is_finite_scaleV in H. all: rewrite !map_length; by rewrite Hleny. } { by intros; apply Hlen. } -rewrite Heq2. +rewrite Heq2. rewrite !CommonSSR.map_map_equiv in H1. rewrite Heq2 in H1. rewrite Hleny in H1, H2. destruct H2 as (He1 & He2 & _). diff --git a/accuracy_proofs/vecnorm_acc.v b/accuracy_proofs/vecnorm_acc.v index e15e8d3..5d5ec73 100644 --- a/accuracy_proofs/vecnorm_acc.v +++ b/accuracy_proofs/vecnorm_acc.v @@ -8,7 +8,7 @@ Require Import Reals. Open Scope R. -Section TwoNorm. +Section TwoNorm. Context {NAN: Nans} {t : type}. Definition two_normF (x: list (ftype t)) : R := sqrt (FT2R (dotprodF x x)). @@ -16,7 +16,7 @@ Definition two_normR (x: list R) : R := sqrt (dotprodR x x). Variable (x : list (ftype t)). Notation xR := (map FT2R x). -Notation n:= (length x). +Notation n:= (length x). Hypothesis Hfin: Binary.is_finite (fprec t) (femax t) (dotprodF x x) = true. Notation g := (@g t). @@ -30,14 +30,14 @@ Lemma bfVNRM2: nth m x' 0 = FT2R (nth m x neg_zero) * (1 + delta) /\ Rabs delta <= g n) /\ Rabs eta <= g1 n n. Proof. -destruct (@dotprod_mixed_error _ _ x x eq_refl Hfin) +destruct (@dotprod_mixed_error _ _ x x eq_refl Hfin) as (x' & eta & Hlen & Hrel & H1 & H2). exists x', eta; repeat split; auto. unfold two_normF, two_normR. rewrite Hrel. f_equal; nra. Qed. -End TwoNorm. +End TwoNorm. Section OneNorm. Context {NAN: Nans} {t : type}. @@ -46,20 +46,20 @@ Definition one_normF (x: list (ftype t)) : R := FT2R (sumF x). Definition one_normR (x: list R) : R := fold_right Rplus 0 x. Variables (x : list (ftype t)). -Hypothesis Hfin: Binary.is_finite (fprec t) (femax t) (sumF x) = true. +Hypothesis Hfin: Binary.is_finite (fprec t) (femax t) (sumF x) = true. Notation xR := (map FT2R x). -Notation n:= (length x). +Notation n:= (length x). Notation g := (@g t). (* one norm backward error bound *) Lemma bfVNRM1: - exists (x': list R), + exists (x': list R), one_normF x = one_normR x' /\ - (forall m, (m < n)%nat -> exists delta, + (forall m, (m < n)%nat -> exists delta, nth m x' 0 = FT2R (nth m x neg_zero) * (1 + delta) /\ Rabs delta <= g (n - 1)). Proof. -destruct (bSUM _ _ x Hfin) as (x' & Hlen & Hrel & Hn). +destruct (bSUM _ _ x Hfin) as (x' & Hlen & Hrel & Hn). rewrite Hlen in Hn. exists x'; repeat split; auto. Qed. diff --git a/floatlib.v b/floatlib.v index a296254..5b06d66 100644 --- a/floatlib.v +++ b/floatlib.v @@ -8,7 +8,7 @@ Definition matrix t := list (list (ftype t)). Definition vector t := list (ftype t). Definition dotprod {NAN: Nans} {t: type} (v1 v2: list (ftype t)) : ftype t := - fold_left (fun s x12 => BFMA (fst x12) (snd x12) s) + fold_left (fun s x12 => BFMA (fst x12) (snd x12) s) (List.combine v1 v2) (Zconst t 0). Definition norm2 {NAN: Nans} {t} (v: vector t) := dotprod v v. @@ -42,7 +42,7 @@ Definition vector_sub {NAN: Nans}{t:type} (v1 v2 : vector t) := Definition matrix_index {t} (m: matrix t) (i j: nat) := nth j (nth i m nil) (Zconst t 0). -Definition matrix_by_index {t} (rows cols: nat) +Definition matrix_by_index {t} (rows cols: nat) (f: nat -> nat -> ftype t) : matrix t := map (fun i => map (f i) (seq 0 cols)) (seq 0 rows). @@ -103,7 +103,7 @@ Proof. rewrite nth_map_seq; auto. Qed. -Lemma matrix_extensionality_strong: +Lemma matrix_extensionality_strong: forall {t} (m1 m2: matrix t) cols, matrix_rows_nat m1 = matrix_rows_nat m2 -> matrix_cols_nat m1 cols -> matrix_cols_nat m2 cols -> @@ -124,7 +124,7 @@ Proof. intros i j ? ?. apply (H2 (S i) j); lia. Qed. -Lemma matrix_extensionality: +Lemma matrix_extensionality: forall {t} (m1 m2: matrix t) cols, matrix_rows_nat m1 = matrix_rows_nat m2 -> matrix_cols_nat m1 cols -> matrix_cols_nat m2 cols -> @@ -148,9 +148,9 @@ Proof. Qed. Lemma matrix_index_prop: - forall {t} (P: ftype t -> Prop) (m: matrix t) (cols i j : nat), + forall {t} (P: ftype t -> Prop) (m: matrix t) (cols i j : nat), matrix_cols_nat m cols -> - Forall (Forall P) m -> + Forall (Forall P) m -> i < matrix_rows_nat m -> j < cols -> P (matrix_index m i j). Proof. @@ -173,7 +173,7 @@ Qed. Lemma all_nth_eq: forall {A} d (al bl: list A), length al = length bl -> - (forall i, i < length al -> nth i al d = nth i bl d) -> + (forall i, i < length al -> nth i al d = nth i bl d) -> al=bl. Proof. induction al; destruct bl; simpl; intros; try discriminate; f_equal. @@ -215,9 +215,9 @@ Proof. inv H1. auto. simpl. apply BFMA_mor; auto; apply subrelation_strict_feq; auto. Qed. -Lemma norm2_congr: - forall {NAN: Nans} {t} (x x': vector t), - Forall2 feq x x' -> +Lemma norm2_congr: + forall {NAN: Nans} {t} (x x': vector t), + Forall2 feq x x' -> feq (norm2 x) (norm2 x'). Proof. intros. @@ -275,7 +275,7 @@ constructor; auto. apply BMINUS_congr; auto. Qed. -Lemma norm2_loose_congr: +Lemma norm2_loose_congr: forall {NAN: Nans}{t} (x x': vector t), Forall2 feq x x' -> feq (norm2 x) (norm2 x'). Proof. intros. @@ -359,7 +359,7 @@ rewrite nth_map_seq by auto. apply H0; auto. Qed. -Lemma Zmatrix_cols_nat: +Lemma Zmatrix_cols_nat: forall {t} (m: matrix t) cols, matrix_cols_nat m cols <-> matrix_cols m (Z.of_nat cols). Proof. @@ -412,7 +412,7 @@ Add Parametric Morphism {NAN: Nans}{t}: (@dotprod _ t) Proof. intros. unfold dotprod. -set (a := Zconst t 0) at 1. +set (a := Zconst t 0) at 1. set (a' := Zconst t 0). assert (feq a a') by reflexivity. clearbody a. clearbody a'. diff --git a/mathcomp_compat/CommonSSR.v b/mathcomp_compat/CommonSSR.v index 351881f..74daa0a 100644 --- a/mathcomp_compat/CommonSSR.v +++ b/mathcomp_compat/CommonSSR.v @@ -30,7 +30,7 @@ Proof. by rewrite orbT orTb. by rewrite Hlt !orTb. - move => le_n21; case (orP le_n21) => [Heq | Hlt]. rewrite eq_sym Heq /=. by rewrite orbT orTb. by rewrite Hlt !orbT. -Qed. +Qed. Lemma ltn_leq_trans: forall [n m p : nat], m < n -> n <= p -> m < p. Proof. @@ -53,12 +53,12 @@ Qed. Lemma ltn_leq_total: forall n m, (n < m) || (m <= n). Proof. - move => m n. + move => m n. pose proof (ltn_total m n). move : H => /orP[/orP[Hlt | Heq] | Hgt]. + by rewrite Hlt. + by rewrite (leq_eqVlt n) eq_sym Heq orbT. + by rewrite (leq_eqVlt n) Hgt !orbT. -Qed. +Qed. Lemma ltn_add2rl: forall n1 n2 m1 m2, n1 < n2 -> @@ -92,11 +92,11 @@ Lemma ordinal_enum: forall {n: nat} (x: 'I_n) y, Proof. move => n x y. have nth_ord := (nth_ord_enum y x). unfold enum in nth_ord. move: nth_ord. rewrite (@nth_map _ y) //. by rewrite ordinal_enum_size. -Qed. +Qed. Lemma size_ord_enum: forall n, size (ord_enum n) = n. Proof. - move => n. + move => n. have : size (ord_enum n) = size ([seq val i | i <- ord_enum n]) by rewrite size_map. by rewrite val_ord_enum size_iota. Qed. @@ -107,7 +107,7 @@ Proof. move : Hmap. rewrite Hv size_ord_enum nth_iota =>[//=|//]. rewrite add0n. move => H. (*some annoying stuff about equality of ordinals vs nats*) have : nat_of_ord ( nth x (ord_enum n) i) == nat_of_ord i. rewrite {2}H. by []. by []. - move => Hnatord. have : nth x (ord_enum n) i == i by []. + move => Hnatord. have : nth x (ord_enum n) i == i by []. by move => /eqP Heq. Qed. @@ -147,7 +147,7 @@ Lemma eq_leqn: forall m n, (m <= n)%N. Proof. move => m n ->. by rewrite leqnn. -Qed. +Qed. Definition eq_ord m n (Hmn: m = n) (x: 'I_m) : 'I_n := widen_ord (eq_leqn Hmn) x. @@ -227,7 +227,7 @@ Proof. - move => [Ha Hbef]. have Hfind := (findP a s). case : Hfind. + move => Hhas. have H := (rwN (@hasP T a s)). rewrite Hhas in H. have:~ (exists2 x : T, x \in s & a x) by rewrite H. move : H => H{H} Hex. - have : nth t s r \in s by apply mem_nth. move => Hnthin. + have : nth t s r \in s by apply mem_nth. move => Hnthin. have: (exists2 x : T, x \in s & a x) by exists (nth t s r). by []. + move => i Hisz Hanth Hprev. have Hlt := ltn_total i r. move : Hlt => /orP[H1 | Hgt]. @@ -242,10 +242,10 @@ Lemma find_none_iff: forall {T: eqType} (a: pred T) (s: seq T), find a s = size s <-> (forall x, x \in s -> ~~ (a x)). Proof. move => T a s. split. - - move => Hfind. have: ~~ has a s. case Hhas : (has a s). + - move => Hfind. have: ~~ has a s. case Hhas : (has a s). move : Hhas. rewrite has_find Hfind ltnn. by []. by []. move => Hhas. by apply (elimT hasPn). - - move => Hnotin. apply hasNfind. apply (introT hasPn). move => x. apply Hnotin. + - move => Hnotin. apply hasNfind. apply (introT hasPn). move => x. apply Hnotin. Qed. (** [find] but for values rather than indices*) @@ -340,7 +340,7 @@ Proof. - rewrite in_cons. subst. have->: (x == y = false). move : Hxy. by case (x == y). by []. - rewrite !in_cons. by rewrite IH. -Qed. +Qed. (** Lemmas about [pmap]*) Lemma nth_pmap: forall (aT rT: eqType) (f: aT -> option rT) (s: seq aT) (i: nat) (a: aT) (r: rT), @@ -349,7 +349,7 @@ Lemma nth_pmap: forall (aT rT: eqType) (f: aT -> option rT) (s: seq aT) (i: nat) Some (nth r (pmap f s) i) = f (nth a s i). Proof. move => aT rT f s i a r. move: i. elim : s =>[//= | h t /= IH i /andP[Hh Hall]]. rewrite ltnS => Hi. - move : Hh. case Hh: (f h) => [h' /= | //=]. move => Htriv. + move : Hh. case Hh: (f h) => [h' /= | //=]. move => Htriv. have: (0 <= i)%N by []. rewrite leq_eqVlt => /orP[/eqP Hi0 | Hi']. - subst. by rewrite /= Hh. - have->: (i = (i.-1).+1)%N by rewrite (ltn_predK Hi'). rewrite /=. rewrite IH //. @@ -362,7 +362,7 @@ Lemma index_pmap: forall (aT rT: eqType) (f: aT -> option rT) (g: rT -> aT) (s: all f s -> index (g x) s = index x (pmap f s). Proof. - move => aT rT f g s x Hcancel Hinj. elim : s => [//= | h t /= IH /andP[Hh Hall]]. + move => aT rT f g s x Hcancel Hinj. elim : s => [//= | h t /= IH /andP[Hh Hall]]. move: Hh. case Hfh : (f h) => [o /= | //]. move => _. case : (h == g x) /eqP => [Hhg | Hhg]. - rewrite Hhg in Hfh. rewrite Hcancel in Hfh. case : Hfh => [->]. by rewrite eq_refl. @@ -427,7 +427,7 @@ Proof. move => Hnod. inversion Hnod as [|x l Hnotin Hnodup] ; subst. have->: h \notin t. case Hin: (h\in t). have: h\in t by []. by rewrite in_mem_In =>{} Hin. by []. by rewrite IH. -Qed. +Qed. Lemma size_length: forall {A : Type} (l: list A), size l = Datatypes.length l. @@ -452,7 +452,7 @@ Qed. Lemma rev_rev: forall {A: Type} (s: seq A), rev s = List.rev s. -Proof. +Proof. move => A s. elim : s => [// | h t /= IH]. by rewrite rev_cons IH -cats1. Qed. @@ -511,7 +511,7 @@ Lemma tuple_eq: forall {A: Type} (n: nat) (t1 t2: n.-tuple A), t1 = t2. Proof. move => A n [l1 Hl1] [l2 Hl2]. rewrite /= => Hl12. subst. f_equal. apply bool_irrelevance. -Qed. +Qed. Lemma in_enum: forall {T: finType} (x: T), x \in (enum T). @@ -626,7 +626,7 @@ Lemma dropWhileEnd_last: forall {A: eqType} (p: pred A) (l: seq A) (x: A), Proof. move => A pr l x Hlast. rewrite (dropWhileEnd_spec pr l x). split. exists nil. split. by rewrite cats0. by []. by rewrite Hlast. -Qed. +Qed. Require Import mathcomp.algebra.poly. @@ -656,10 +656,10 @@ Proof. move => s i. rewrite /rem_trail_zero. have: (dropWhileEnd (eq_op^~ 0) s) = (dropWhileEnd (eq_op^~ 0) s) by []. rewrite (dropWhileEnd_spec _ _ 1) => [[[l1 [Hl1 Hinl1]] Hlast]]. - rewrite {1}Hl1 nth_cat. + rewrite {1}Hl1 nth_cat. case Hi: (i < size (dropWhileEnd (eq_op^~ 0) s)). - by []. - - rewrite (@nth_default _ 0 (dropWhileEnd (eq_op^~ 0) s) i). + - rewrite (@nth_default _ 0 (dropWhileEnd (eq_op^~ 0) s) i). case Hi': (i - size (dropWhileEnd (eq_op^~ 0) s) < size l1). + move: Hinl1. rewrite -all_in => /all_nthP Hall. apply /eqP. by apply Hall. + by rewrite nth_default // leqNgt Hi'. @@ -677,6 +677,6 @@ Lemma rem_trail_zero_size: forall (l: seq F), size (rem_trail_zero l) <= size l. Proof. move => l. apply dropWhileEnd_size. -Qed. +Qed. End RemZeroes. \ No newline at end of file