;;; ADT Polynom
;;; Konstruktor: make-polynom
;;; Grundoperationen: poly-coeff, poly-degree, poly-ring
;;; Abgeleitete Operationen: poly-add, poly-sub, poly-mult

; Ein "polynom" ist ein Element der Struktur
(define-struct real-poly (fun))
; wobei fun : ('degree -> number) + 
;             ('ring -> ring) + 
;             ('coef -> (number -> ring-element))
; Die Nachricht 'degree liefert den Rang des Polynoms.
; Die Nachricht 'ring liefert den Ring, aus dem die Koeffizienten stammen.
; Die Nachricht 'coef liefert eine Funktion, die eine Zahl i auf den 
;  Wert des Koeffizienten von X^i abbildet.

(define polynom? real-poly?)

;;; ring-add, ring-sub, ring-zero, ring-mult, ring-zero? 

; Ein "ring" ist eine Struktur
(define-struct ring (name add sub zero mult zero?))
; wobei name : list(symbol)
;       add, sub, mult: ring-element ring-element -> ring-element
;       zero : ring-element
;       zero? : ring-element -> boolean
; Die Funktionen repräsentieren die entsprechenden Objekte eines Rings
;  im Sinne der Mathematik (linearen Algebra). 
;  (ring-name ring) ist ein eindeutiger Name für den Ring: Falls der Name
;  gleich ist, so sind auch sämtliche weiteren Felder gleich.

; SIGNATUR
; numbers : ring
; ERKLÄRUNG
; Der Ring der Maschinenzahlen.
; DEFINITION
(define numbers
  (make-ring '(numbers) + - 0 * zero?))

; SIGNATUR
; make-polynom-ring : ring -> ring
; ERKLÄRUNG
; (make-polynom-ring base) erzeugt einen Polynomring mit 
;  Koeffizientenbereich base.
; DEFINITION
(define make-polynom-ring
  (lambda (ring)
    (make-ring (cons 'poly (ring-name ring))
               poly-add
               poly-sub
               (make-polynom ring 0 (lambda (i) (ring-zero ring)))
               poly-mult
               (lambda (p)
                 (and (zero? (poly-degree p))
                      ((ring-zero? ring) (poly-coeff p 0)))))))


;;; parsers & printers
(define poly-vars "ZYXWVUTSRQPONMLKJIHGFEDCBA")

; SIGNATUR
; poly-read : string ring -> polynom
(define poly-read
  (lambda (s base)
    (let ((l (string-length s)))
      (let loop ((i 0) (formals '()))
        (if (< i l)
            (let ((ch (string-ref s i)))
              (cond
                ((char-alphabetic? ch)
                 (loop (+ i 1) (cons ch formals)))
                ((char=? ch #\:)
                 (polynom-read s (+ i 1) l formals base))
                (else
                 'error)))
            'error)))))

; SIGNATUR
; polynom-read: string number number list(char) ring -> polynom
(define polynom-read
  (lambda (s i l formals base)
    (let while ((i i) (monomes '()) (polynom #f))
      (let ((m (monom-read s l i)))
        (if m
            (let* ((next-i (car m))
                   (monom (cdr m))
                   (monom-as-poly (monom->polynom formals base monom))
                   (next-poly (if polynom
                                  (poly-add polynom monom-as-poly)
                                  monom-as-poly)))
              (while next-i
                     (cons monom monomes)
                     next-poly))
            polynom)))))

; SIGNATUR
; monom->polynom: list(char) ring monom -> polynom
(define monom->polynom
  (lambda (formals base monom)
    (let loop ((formals formals) (base base) (coeff (monom-coeff monom)))
      (if (null? formals)
          coeff
          (let ((var (car formals))
                (new-formals (cdr formals))
                (new-base (make-polynom-ring base)))
            (cond
              ((assoc var (monom-factors monom))
               => (lambda (factor)
                    (let ((exp (monom-factor-exp factor)))
                      (loop new-formals
                            new-base
                            (make-polynom
                             base
                             exp
                             (let ((zero (ring-zero base)))
                               (lambda (i)
                                 (if (= i exp)
                                     coeff
                                     zero))))))))
              (else
               (loop new-formals 
                     new-base
                     (make-polynom base 0 (lambda (i) coeff))))))))))
    
;; Ein "monom" ist eine Liste (coeff (var . exp)*).
(define monom-coeff car)
(define monom-factors cdr)
(define monom-factor-var car)
(define monom-factor-exp cdr)


; SIGNATUR
; monom-read: string number number -> pair(number, monom) + boolean
; ERKLÄRUNG
; (monom-read s l i) versucht, die in der Zeichenkette von der Position i
; bis zur Position l-1 stehenden Zeichen als ein Monom zu parsen. Im Erfolgsfall
; wird ein Paar zurückgeliefert, dessen erstes Element der Index des ersten
; Zeichens nach dem Monom ist, und dessen zweites Element das Monom ist.
; Im Fehlerfall wird #f zurückgegeben.
(define monom-read
  (lambda (s l i)
    (letrec
        (
         ; SIGNATUR
         ; initial: number number -> pair(number, monom) + boolean
         ; ERKLÄRUNG
         ; (initial i sign) versucht, ein Monom zu lesen und liefert im
         ; Erfolgsfall ein Paar zurück, dessen erstes Element der Index des
         ; ersten Zeichens nach dem Monom ist, und dessen zweites Element das
         ; Monom ist. Im Fehlerfall wird #f zurückgegeben.
         (initial 
          (lambda (i sign)
            (if (< i l)
                (let ((ch (string-ref s i)))
                  (cond
                   ((char-whitespace? ch)
                    (initial (+ i 1) sign))
                   ((char-alphabetic? ch)
                    (variable ch '() (+ i 1) sign))
                   ((char-numeric? ch)
                    (coefficient i sign 0))
                   ((char=? ch #\-)
                    (initial (+ i 1) (- sign)))
                   ((char=? ch #\+)
                    (initial (+ i 1) (+ sign)))
                   (else
                    #f)))
                #f)))
         ; SIGNATUR
         ; variable: char list(pair(char, number)) number number ->
         ;           pair(number, monom) + boolean
         ; ERKLÄRUNG
         ; (variable var vars i coeff) versucht ein Potenzprodukt (d.h. ein
         ; Monom ohne Koeffizient) zu lesen. Dabei steht in var eine
         ; bereits gelesene Variable. Der Index des nächsten noch ungelesenen
         ; Zeichens lautet i. In vars steht ein eventuell schon gelesenener
         ; Teil des Potenzproduktes. In coeff steht der Koeffizient des
         ; Gesamtmonoms.
         ; Im Erfolgsfall wird ein Paar zurückgeliefert, dessen erstes Element
         ; der Index des ersten Zeichens nach dem Monom ist, und dessen zweites
         ; Element das Monom ist. Im Fehlerfall wird #f zurückgegeben.
         (variable
          (lambda (var vars i coeff)
            (if (< i l)
                (let ((ch (string-ref s i)))
                  (cond
                   ((char-alphabetic? ch)
                    (variable ch (cons (cons var 1) vars) (+ i 1) coeff))
                   ((char=? ch #\^)
                    (exponent var 0 vars (+ i 1) coeff))
                   (else
                    (cons i (cons coeff (cons (cons var 1) vars))))))
                (cons i (cons coeff (cons (cons var 1) vars))))))
         ; SIGNATUR
         ; exponent: char number list(pair(char, number)) number number ->
         ;           pair(number,monom) + boolean
         ; ERKLÄRUNG
         ; (exponent var expo vars i coeff) versucht, einen Exponenten (d.h.
         ; eine natürliche Zahl) samt einem sich eventuell anschließenden
         ; Rests des Potenzprodukts zu lesen.
         ; Dabei steht in var eine bereits gelesene Variable und in expo der
         ; bereits gelesene Teil des Exponenten. Der Index des nächsten noch
         ; ungelesenen Zeichens lautet i. In vars steht ein eventuell schon
         ; gelesenener Teil des Potenzproduktes. In coeff steht der Koeffizient
         ; des Gesamtmonoms.
         ; Im Erfolgsfall wird ein Paar zurückgeliefert, dessen erstes Element
         ; der Index des ersten Zeichens nach dem Monom ist, und dessen zweites
         ; Element das Monom ist. Im Fehlerfall wird #f zurückgegeben.
         (exponent
          (lambda (var expo vars i coeff)
            (if (< i l)
                (let ((ch (string-ref s i)))
                  (cond
                   ((char-alphabetic? ch)
                    (variable ch (cons (cons var expo) vars) i coeff))
                   ((char-numeric? ch)
                    (exponent var
                              (+ (* expo 10)
                                     (char->integer ch)
                                     (- (char->integer #\0)))
                              vars
                              (+ i 1)
                              coeff))
                   (else
                    (cons i (cons coeff (cons (cons var expo) vars))))))
                (cons i (cons coeff (cons (cons var expo) vars))))))
         ; SIGNATUR
         ; coefficient: number number number -> pair(number,monom) + boolean
         ; ERKLÄRUNG
         ; (coefficient i sign val) versucht, einen (positiven)
         ; Koeffizienten (d.h. eine natürliche Zahl) samt eines sich eventuell
         ; anschließenden Potenzprodukts zu lesen.
         ; Dabei steht in val ein bereits gelesener Teil des Koeffizienten und
         ; in sign das Vorzeichen des Gesamtmonoms. Der Index des nächsten noch
         ; ungelesenen Zeichens lautet i.
         ; Im Erfolgsfall wird ein Paar zurückgeliefert, dessen erstes Element
         ; der Index des ersten Zeichens nach dem Monom ist, und dessen zweites
         ; Element das Monom ist. Im Fehlerfall wird #f zurückgegeben.
         (coefficient
          (lambda (i sign val)
            (if (< i l)
                (let ((ch (string-ref s i)))
                  (cond
                   ((char-alphabetic? ch)
                    (variable ch '() i (* sign val)))
                   ((char-numeric? ch)
                    (coefficient (+ i 1)
                                 sign
                                 (+ (* 10 val)
                                    (- (char->integer ch)
                                       (char->integer #\0)))))
                   (else
                    (list i (* sign val)))))
                (list i (* sign val))))))
      (initial i 1))))