Hypercomplex plus

Author: wedesoft

TODO.md

@@ -13,6 +13,7 @@
     * avcodec\_receive\_frame
     * avcodec\_send\_packet
   * codec deprecated (ffmpeg.c: 271, 377, 417)
+* Wayland support
 * check new lintian tag required
 * argmin, argmax
 * argwhere (mask coordinates)

aiscm/hypercomplex.scm

@@ -25,7 +25,7 @@
             <hypercomplex<>>
             <hypercomplex<float>>  <meta<hypercomplex<float>>>  <hypercomplex<float<single>>> <meta<hypercomplex<float<single>>>>
             <hypercomplex<double>> <meta<hypercomplex<double>>> <hypercomplex<float<double>>> <meta<hypercomplex<float<double>>>>)
-  #:re-export (real-part imag-part equal?))
+  #:re-export (real-part imag-part equal? +))
 
 
 (define-class <hypercomplex> ()
@@ -74,3 +74,17 @@
   (hypercomplex (reduce coerce #f (cons b (base a)))))
 (define-method (coerce (a <meta<scalar>>) (b <meta<hypercomplex<>>>))
   (hypercomplex (reduce coerce #f (cons a (base b)))))
+
+(define-method (+ (a <hypercomplex<>>) (b <hypercomplex<>>))
+  (hypercomplex (+ (real-part a) (real-part b))
+                (+ (imag-part a) (imag-part b))
+                (+ (jmag-part a) (jmag-part b))
+                (+ (kmag-part a) (kmag-part b))))
+(define-method (+ (a <hypercomplex<>>) (b <complex<>>))
+  (hypercomplex (+ (real-part a) (real-part b)) (+ (imag-part a) (imag-part b)) (jmag-part a) (kmag-part a)))
+(define-method (+ (a <complex<>>) (b <hypercomplex<>>))
+  (hypercomplex (+ (real-part a) (real-part b)) (+ (imag-part a) (imag-part b)) (jmag-part b) (kmag-part b)))
+(define-method (+ (a <hypercomplex<>>) (b <scalar>))
+  (hypercomplex (+ (real-part a) b) (imag-part a) (jmag-part a) (kmag-part a)))
+(define-method (+ (a <scalar>) (b <hypercomplex<>>))
+  (hypercomplex (+ a (real-part b)) (imag-part b) (jmag-part b) (kmag-part b)))

tests/test_hypercomplex.scm

@@ -95,4 +95,21 @@
   (test-eq "coerce real and hypercomplex type"
     (hypercomplex <double>) (coerce <double> (hypercomplex <float>))))
 
+(test-group "hypercomplex plus"
+  (test-equal "hypercomplex plus hypercomplex"
+    (make-hypercomplex 2.0 3.0 5.0 7.0) ((jit (list (hypercomplex <float>) (hypercomplex <float>)) +)
+                                         (make-hypercomplex 1 2 3 4) (make-hypercomplex 1 1 2 3)))
+  (test-equal "hypercomplex plus complex"
+    (make-hypercomplex 2.0 3.0 5.0 7.0)  ((jit (list (hypercomplex <float>) (complex <float>)) +)
+                                          (make-hypercomplex 1 2 5 7) 1+i))
+  (test-equal "complex plus hypercomplex"
+    (make-hypercomplex 2.0 3.0 5.0 7.0) ((jit (list (complex <float>) (hypercomplex <float>)) +)
+                                         1+i (make-hypercomplex 1 2 5 7)))
+  (test-equal "hypercomplex plus real"
+    (make-hypercomplex 2.0 3.0 5.0 7.0) ((jit (list (hypercomplex <float>) <float>) +)
+                                         (make-hypercomplex 1 3 5 7) 1))
+  (test-equal "real plus hypercomplex"
+    (make-hypercomplex 2.0 3.0 5.0 7.0) ((jit (list <float> (hypercomplex <float>)) +)
+                                         1 (make-hypercomplex 1 3 5 7))))
+
 (test-end "aiscm hypercomplex")

tmux.sh

@@ -5,7 +5,7 @@ tmux select-pane -t0
 tmux send-keys "make repl -j 4" C-m
 tmux select-pane -t1
 tmux send-keys "cd tests" C-m
-tmux send-keys "./guard.sh core" C-m
+tmux send-keys "./guard.sh hypercomplex" C-m
 tmux select-pane -t2
 tmux send-keys "nvim" C-m
 sleep 1