From d03ce4adaa023a33c0e1e9898c574c9d7a63d086 Mon Sep 17 00:00:00 2001 From: "O'Keefe, Colin B" Date: Fri, 16 Jun 2023 10:33:02 -0700 Subject: [PATCH] Fix: coalton struct regression a typeclass method named .* was causing an ambiguous accessor error --- src/discrete/numeric/cyclotomic8.lisp | 6 ++--- src/discrete/numeric/interval.lisp | 2 +- src/discrete/numeric/linear-algebra.lisp | 22 +++++++++---------- src/discrete/numeric/root2plex.lisp | 2 +- src/discrete/package.lisp | 6 +++-- .../rz-approx/candidate-generation.lisp | 12 +++++----- src/discrete/rz-approx/generate-solution.lisp | 9 ++++++-- 7 files changed, 33 insertions(+), 26 deletions(-) diff --git a/src/discrete/numeric/cyclotomic8.lisp b/src/discrete/numeric/cyclotomic8.lisp index 69996ae2a..55dff74ce 100644 --- a/src/discrete/numeric/cyclotomic8.lisp +++ b/src/discrete/numeric/cyclotomic8.lisp @@ -188,9 +188,9 @@ (fraction->reciprocable (to-fraction x))) y) ((Cyclotomic8 a b c d) - (+ (+ (.* a (cis (/ (* 3 pi) 4))) - (.* b (cis (/ pi 2)))) - (+ (.* c (cis (/ pi 4))) + (+ (+ (s* a (cis (/ (* 3 pi) 4))) + (s* b (cis (/ pi 2)))) + (+ (s* c (cis (/ pi 4))) (complex d 0)))))) (define-instance ((Complex :a) diff --git a/src/discrete/numeric/interval.lisp b/src/discrete/numeric/interval.lisp index 26a037e46..55e39f408 100644 --- a/src/discrete/numeric/interval.lisp +++ b/src/discrete/numeric/interval.lisp @@ -54,7 +54,7 @@ (Interval (fromInt a) (fromInt a)))) (define-instance ((Ord :r) (Num :r) => (Linear (Interval :r) :r)) - (define (.* a i) + (define (s* a i) (match i ((Interval l r) (if (>= a 0) diff --git a/src/discrete/numeric/linear-algebra.lisp b/src/discrete/numeric/linear-algebra.lisp index d7b17f05e..1a5a27ff3 100644 --- a/src/discrete/numeric/linear-algebra.lisp +++ b/src/discrete/numeric/linear-algebra.lisp @@ -24,31 +24,31 @@ For example an N x N matrix has degree N." (degree (:a -> Integer))) (define-class ((Scalar :v :s) => (Linear :v :s)) - "Defines scalar multiplication where (.* x (+ v u)) = (+ (.* x u) (.* x v))" - (.* (:s -> :v -> :v))) + "Defines scalar multiplication where (s* x (+ v u)) = (+ (s* x u) (s* x v))" + (s* (:s -> :v -> :v))) - (declare *. ((Linear :v :e) (Num :e) => (:v -> :e -> :v))) - (define (*. v s) (.* s v)) + (declare *s ((Linear :v :e) (Num :e) => (:v -> :e -> :v))) + (define (*s v s) (s* s v)) - (declare ./ ((Linear :v :e) (Reciprocable :e) + (declare s/ ((Linear :v :e) (Reciprocable :e) => (:e -> :v -> :v))) - (define (./ s v) (.* (/ 1 s) v)) + (define (s/ s v) (s* (/ 1 s) v)) - (declare /. ((Linear :v :e) (Reciprocable :e) + (declare /s ((Linear :v :e) (Reciprocable :e) => (:v -> :e -> :v))) - (define (/. v s) (./ s v)) + (define (/s v s) (s/ s v)) (define-class ((Linear :v :e) => (Inner :v :e)) "An (indefinite) inner product that should satisfy: - (<.> x y) = (<.> y x) - - (<.> z (+ (.* a x) (.* b y))) = (+ (*. (<.> z x) a) (*. (<.> z y) b)) " + - (<.> z (+ (s* a x) (s* b y))) = (+ (*s (<.> z x) a) (*s (<.> z y) b)) " (<.> (:v -> :v -> :e))) ;; Note that normed spaces are a superset of definite inner product spaces. (define-class ((Linear :v :e) => (Normed :v :e)) "A (indefinite) normed space that should satisify - (norm (+ x y)) <= (+ (norm x) (norm y)) - - (norm (.* s x)) = (* |s| (norm x))" + - (norm (s* s x)) = (* |s| (norm x))" (norm (:v -> :e))) (declare square-norm ((Inner :v :e) => (:v -> :e))) @@ -263,7 +263,7 @@ Hermitian adjoint, or related involution - often notated †." (define-instance ((Complex :e) (Num :e) (Num (Complex :e)) => (Linear (Complex :e) :e)) - (define (.* s v) + (define (s* s v) (complex (* s (real-part v)) (* s (imag-part v))))) (define-instance ((Linear (Complex :e) :e) (Complex :e) diff --git a/src/discrete/numeric/root2plex.lisp b/src/discrete/numeric/root2plex.lisp index 978369d10..aeb5ca68b 100644 --- a/src/discrete/numeric/root2plex.lisp +++ b/src/discrete/numeric/root2plex.lisp @@ -94,7 +94,7 @@ (negate (floor (negate x))))) (define-instance ((Num :a) => (Linear (Root2plex :a) :a)) - (define (.* s v) + (define (s* s v) (match v ((Root2plex a b) (Root2plex (* s a) (* s b)))))) diff --git a/src/discrete/package.lisp b/src/discrete/package.lisp index 7da1c4a4d..c1f84532f 100644 --- a/src/discrete/package.lisp +++ b/src/discrete/package.lisp @@ -33,8 +33,10 @@ ) ;; linear-algebra.lisp (:export - #:.* - #:*. + #:s* + #:*s + #:/s + #:s/ #:Inner #:<.> #:square-norm diff --git a/src/discrete/rz-approx/candidate-generation.lisp b/src/discrete/rz-approx/candidate-generation.lisp index 5a4c74a30..234f1e4a5 100644 --- a/src/discrete/rz-approx/candidate-generation.lisp +++ b/src/discrete/rz-approx/candidate-generation.lisp @@ -151,10 +151,10 @@ to Corrolary 19 (arXiv:1212.6253v2)." ;; Base case finds an a + b√2 with an even a-term (match (interval-solution ;; [x_0 / √2, x_1 / √2] - (*. x-set (Root2plex 0 (exact/ 1 2))) + (*s x-set (Root2plex 0 (exact/ 1 2))) ;; [-y_1 / √2, -y_0 / √2] - (.* (the (Root2plex Fraction) -1) - (*. y-set (Root2plex 0 (exact/ 1 2))))) + (s* (the (Root2plex Fraction) -1) + (*s y-set (Root2plex 0 (exact/ 1 2))))) ;; Give a + b √2 ;; Return (2 * b) + a √2 ((Root2plex a b) (Root2plex (* 2 b) a))) @@ -238,7 +238,7 @@ rotation of the original vector U. That is: (let u-a = (- (norm u) l)) ;; (sin (arccos x)) = √(1 - x²) (let u-b = (sqrt (- 1 (^ u-a 2)))) - (Tuple (.* u-a u) (.* u-b u-orth))) + (Tuple (s* u-a u) (s* u-b u-orth))) (declare j-sub-interval (Fraction -> (Interval Fraction) -> Integer -> (Interval Fraction))) @@ -378,8 +378,8 @@ Lemma 17 and this function corresponds to Theorem 22 in (arXiv:1212.6253v2)." (let x0 = (parallelogram-segment lin delta-x beta-hat)) (let alpha-interval = (if negate-x? - (.* scale (Interval (- x0 (into l-rational)) x0)) - (.* scale (Interval x0 (+ x0 (into l-rational)))))) + (s* scale (Interval (- x0 (into l-rational)) x0)) + (s* scale (Interval x0 (+ x0 (into l-rational)))))) (let a-odd? = (odd? (root2-real-part beta))) (let alpha = (rescaled-interval-solution (not a-odd?) alpha-interval conj-interval)) diff --git a/src/discrete/rz-approx/generate-solution.lisp b/src/discrete/rz-approx/generate-solution.lisp index f715c7fcb..5525998e6 100644 --- a/src/discrete/rz-approx/generate-solution.lisp +++ b/src/discrete/rz-approx/generate-solution.lisp @@ -147,7 +147,8 @@ half of Algorithm 23 (arXiv:1212.6253v2)." (into x))))) (find-candidate attempts epsilon theta n)))) - (monomorphize) + ;; TODO: monomorphize was here but it won't compile as of Fri Jun 16 10:32:29 PDT 2023 + ;; (monomorphize) (declare generate-maform-output-with-double (Integer -> Integer -> Double-Float -> Double-float -> (Optional (List OutputGate1)))) (define (generate-maform-output-with-double candidate-attempts prime-attempts epsilon theta) @@ -219,4 +220,8 @@ See `generate-solution' for information about EPSILON and THETA." (map into ma))))))))) (same-type theta (global-phase-invariant-distance - m1 (map cyclotomic8->complex m2))))) + m1 (map cyclotomic8->complex m2)))) + + + +)