(load "octonion.scm")
(define (sedenion . l)
  (cond
    ((= (length l) 2) `(sedenion ,(car l) ,(cadr l)))
    ((= (length l) 4) `(sedenion ,(octonion (car l) (cadr l))
                                 ,(octonion (caddr l) (cadddr l))))
    ((= (length l) 8) `(sedenion ,(octonion (car l) (cadr l)
                                            (caddr l) (cadddr l))
                                 ,(apply octonion (cddddr l))))
    ((= (length l) 16) `(sedenion ,(octonion (car l) (cadr l) (caddr l)
                                             (cadddr l) (car (cddddr l))
                                             (cadr (cddddr l))
                                             (caddr (cddddr l))
                                             (cadddr (cddddr l)))
                                 ,(apply octonion (cddddr (cddddr l)))))
    ((only-sedenion? (car l)) (car l))
    ((octonion? (car l)) `(sedenion ,(car l) 0))))
(define (only-sedenion? x) (and (list? x) (eq? (car x) 'sedenion)))
(define (sedenion? x) (or (octonion? x) (only-sedenion? x)))
(let ((o zero?))
  (eval `(define (zero? x)
           (and (,o (upper-part x)) (,o (lower-part x))))))
(let ((o upper-part))
  (eval `(define (upper-part x)
           (if (only-sedenion? x) (cadr x) (,o x)))))
(let ((o lower-part))
  (eval `(define (lower-part x)
           (if (only-sedenion? x) (caddr x) (,o x)))))
(let ((o real-part))
  (eval `(define (real-part x)
           (if (only-sedenion? x) (,o (upper-part x)) (,o x))))
  (eval `(define (e2-part x) (,o (lower-part x)))))
(let ((o imag-part))
  (eval `(define (imag-part x)
           (if (only-sedenion? x) (,o (upper-part x)) (,o x))))
  (eval `(define (i2-part x) (,o (lower-part x)))))
(let ((o j-part))
  (eval `(define (j-part x)
           (if (only-sedenion? x) (,o (upper-part x)) (,o x))))
  (eval `(define (j2-part x) (,o (lower-part x)))))
(let ((o k-part))
  (eval `(define (k-part x)
           (if (only-sedenion? x) (,o (upper-part x)) (,o x))))
  (eval `(define (k2-part x) (,o (lower-part x)))))
(let ((o e1-part))
  (eval `(define (e1-part x)
           (if (only-sedenion? x) (,o (upper-part x)) (,o x))))
  (eval `(define (e3-part x) (,o (lower-part x)))))
(let ((o i1-part))
  (eval `(define (i1-part x)
           (if (only-sedenion? x) (,o (upper-part x)) (,o x))))
  (eval `(define (i3-part x) (,o (lower-part x)))))
(let ((o j1-part))
  (eval `(define (j1-part x)
           (if (only-sedenion? x) (,o (upper-part x)) (,o x))))
  (eval `(define (j3-part x) (,o (lower-part x)))))
(let ((o k1-part))
  (eval `(define (k1-part x)
           (if (only-sedenion? x) (,o (upper-part x)) (,o x))))
  (eval `(define (k3-part x) (,o (lower-part x)))))
(define (sed-lower x)
  (oct-lower (if (and (only-sedenion? x) (zero? (lower-part x)))
                  (upper-part x) x)))
(let ((o conj))
  (eval `(define (conj x)
           (if (only-sedenion? x)
               (sedenion (,o (upper-part x)) (- (lower-part x)))
               (,o x)))))
(let ((o abs))
  (eval `(define (abs x) (if (only-sedenion? x) (sqrt (* x (conj x)))
                             (,o x)))))
(let ((o =))
  (eval `(define (= . a)
           (define (s= a b)
             (and (,o (upper-part a) (upper-part b))
                  (,o (lower-part a) (lower-part b))))
           (cond
             ((null? a) (,o))
             ((null? (cdr a)) (,o (car a)))
             ((and (pair? (cdr a)) (pair? (cddr a)))
              (and (= (car a) (cadr a)) (apply = (car a) (cddr a))))
             ((or (only-sedenion? (car a)) (only-sedenion? (cadr a)))
              (s= (sedenion (car a)) (sedenion (cadr a))))
             (else (,o (car a) (cadr a)))))))
(let ((o +))
  (eval `(define (+ . a)
           (define (s+ a b)
             (sed-lower
              (sedenion (,o (upper-part a) (upper-part b))
                        (,o (lower-part a) (lower-part b)))))
           (cond
             ((null? a) (,o))
             ((null? (cdr a)) (car a))
             ((and (pair? (cdr a)) (pair? (cddr a)))
              (apply + (+ (car a) (cadr a)) (cddr a)))
             ((or (only-sedenion? (car a)) (only-sedenion? (cadr a)))
              (s+ (sedenion (car a)) (sedenion (cadr a))))
             (else (,o (car a) (cadr a)))))))
(let ((o -))
  (eval `(define (- . a)
           (define (s- a b)
             (sed-lower
              (sedenion (,o (upper-part a) (upper-part b))
                        (,o (lower-part a) (lower-part b)))))
           (cond
             ((null? a) (,o))
             ((null? (cdr a)) (if (only-sedenion? (car a)) (- 0 (car a))
                                  (,o (car a))))
             ((and (pair? (cdr a)) (pair? (cddr a)))
              (apply - (- (car a) (cadr a)) (cddr a)))
             ((or (only-sedenion? (car a)) (only-sedenion? (cadr a)))
              (s- (sedenion (car a)) (sedenion (cadr a))))
             (else (,o (car a) (cadr a)))))))
(let ((o *))
  (eval `(define (* . a)
           (define (s* a b)
             (sed-lower
              (sedenion (- (,o (upper-part a) (upper-part b))
                           (,o (lower-part b) (conj (lower-part a))))
                        (+ (,o (conj (upper-part a)) (lower-part b))
                           (,o (upper-part b) (lower-part a))))))
           (cond
             ((null? a) (,o))
             ((null? (cdr a)) (car a))
             ((and (pair? (cdr a)) (pair? (cddr a)))
              (apply * (* (car a) (cadr a)) (cddr a)))
             ((or (only-sedenion? (car a)) (only-sedenion? (cadr a)))
              (s* (sedenion (car a)) (sedenion (cadr a))))
             (else (,o (car a) (cadr a)))))))
(let ((o commutative*))
  (eval `(define (commutative* . a)
           (define (h* a b)
             (sed-lower
              (sedenion (- (,o (upper-part a) (upper-part b))
                           (,o (lower-part a) (lower-part b)))
                        (+ (,o (upper-part a) (lower-part b))
                           (,o (lower-part a) (upper-part b))))))
           (cond
             ((null? a) (,o))
             ((null? (cdr a)) (car a))
             ((and (pair? (cdr a)) (pair? (cddr a)))
              (apply commutative* (commutative* (car a) (cadr a)) (cddr a)))
             ((or (only-sedenion? (car a)) (only-sedenion? (cadr a)))
              (h* (sedenion (car a)) (sedenion (cadr a))))
             (else (,o (car a) (cadr a)))))))
(let ((o /))
  (eval `(define (/ . a)
           (define (s/ a b)
             (let ((n (* a (conj b))) (d (* b (conj b))))
               (sed-lower (sedenion (,o (upper-part n) d)
                                    (,o (lower-part n) d)))))
           (cond
             ((null? a) (,o))
             ((null? (cdr a)) (if (only-sedenion? (car a)) (/ 1 (car a))
                                  (,o (car a))))
             ((and (pair? (cdr a)) (pair? (cddr a)))
              (apply / (/ (car a) (cadr a)) (cddr a)))
             ((or (only-sedenion? (car a)) (only-sedenion? (cadr a)))
              (s/ (sedenion (car a)) (sedenion (cadr a))))
             (else (,o (car a) (cadr a)))))))