close Warning: Can't synchronize with repository "(default)" (The repository directory has changed, you should resynchronize the repository with: trac-admin $ENV repository resync '(default)'). Look in the Trac log for more information.

Changeset 4312 for branches


Ignore:
Timestamp:
2016-06-04T22:56:30-07:00 (8 years ago)
Author:
Marek Rychlik
Message:

Added ring classes

Location:
branches/f4grobner
Files:
7 edited

Legend:

Unmodified
Added
Removed
  • branches/f4grobner/5am-buchberger.lisp

    r4201 r4312  
    7878    (is-true (grobner-test gb fl))
    7979    (is (every #'universal-equalp (buchberger fl) gb))
    80     (is (every #'universal-equalp (parallel-buchberger fl) gb))
     80    ;;(is (every #'universal-equalp (parallel-buchberger fl) gb))
    8181    )
    8282  )
     
    121121  (with-fixture buchberger-advanced-context ()
    122122    (is-true (grobner-test gb fl))
    123     ;;(is (every #'universal-equalp (buchberger fl) gb))
     123    (is (every #'universal-equalp (buchberger fl) gb))
    124124    ;;(is (every #'universal-equalp (parallel-buchberger fl) gb))
    125125    ))
  • branches/f4grobner/5am-criterion.lisp

    r4179 r4312  
    103103         (pair (make-instance 'critical-pair :first f :second g))
    104104         (b-done (make-hash-table :test #'equal))
    105          (partial-basis (list h)))
     105         (partial-basis (list f g h)))
    106106    ;; Initialize the lookup table of done pairs
    107     (setf (gethash (list h f) b-done) t
    108           (gethash (list h g) b-done) t)
     107    (setf ;;(gethash (list h f) b-done) t
     108          (gethash (list f h) b-done) t
     109          ;;(gethash (list h g) b-done) t
     110          (gethash (list g h) b-done) t
     111          )
    109112    (&body)))
    110113
  • branches/f4grobner/5am-division.lisp

    r4213 r4312  
    4444  (require :utils "utils")
    4545  (require :copy "copy")
     46  (require :ring "ring")
     47  (require :integer-ring "integer-ring")
    4648  (require :monom "monom")
    4749  (require :polynomial "polynomial")
     
    5153
    5254(defpackage #:5am-division
    53   (:use :cl :it.bese.fiveam :monom :polynomial :infix :symbolic-polynomial :division))
     55  (:use :cl :it.bese.fiveam :monom :polynomial :infix :symbolic-polynomial :division :integer-ring))
    5456
    5557(in-package :5am-division)
     
    7375         (y-sq (string->poly "y^2" '(x y)))
    7476         (fl (cdr (string->poly "[x+y,x-2*y]" '(x y))))
    75          (quotients (cdr (string->poly "[x-y,0]" '(x y)))))
     77         (quotients (cdr (string->poly "[x-y,0]" '(x y))))
     78         (one (make-instance 'integer-ring :value 1)))
    7679    (&body)))
    7780
     
    7982  "Normal form"
    8083  (with-fixture division-context ()
    81     (is (universal-equalp (multiple-value-list (normal-form f fl)) (list y-sq 1 2)))
    82     (is (universal-equalp (multiple-value-list (poly-pseudo-divide f fl))
    83                           (list quotients y-sq 1 2)))
    84     (is-false (buchberger-criterion fl))))
     84    (is (universal-equalp (multiple-value-list (normal-form f fl)) (list y-sq one 2)))
     85    (is (universal-equalp (multiple-value-list (poly-pseudo-divide f fl)) (list quotients y-sq one 2)))
     86    (is-false (buchberger-criterion fl))
     87    )
     88  )
    8589
    8690(test normal-form-easy
  • branches/f4grobner/copy.lisp

    r4223 r4312  
    3838;; NOTE: This is a shallow copy. Add an around method for classes which need deep copy of the slots.
    3939(defgeneric copy-instance (object &rest initargs &key &allow-other-keys)
    40   (:method ((object number) &rest initargs &key &allow-other-keys)
    41     (declare (ignore initargs))
    42     object)
    43   (:method ((object cons) &rest initargs &key &allow-other-keys)
    44     (declare (ignore initargs))
    45     (copy-seq object))
    4640  (:documentation "Makes and returns a shallow copy of OBJECT.
    47 
    4841  An uninitialized object of the same class as OBJECT is allocated by
    4942  calling ALLOCATE-INSTANCE.  For all slots returned by
  • branches/f4grobner/criterion.lisp

    r4180 r4312  
    3030(in-package :criterion)
    3131
    32 (proclaim '(optimize (speed 3) (space 0) (safety 0) (debug 0)))
     32;;(proclaim '(optimize (speed 3) (space 0) (safety 0) (debug 0)))
    3333
    3434(defgeneric criterion-1 (pair)
     
    6161    ;; appear in the hash table B-done
    6262    (dolist (h partial-basis nil)
    63       (format t "Considering H:~S~%" h)
    6463      (cond
    6564        ((eq h f)
     
    7978                         ((:before :in-the-middle) (list h g))
    8079                         (:after (list g h)))
    81                        b-done))
     80                       b-done)
     81              )
    8282         (debug-cgb ":2")
    8383         (return-from criterion-2 t))))))
  • branches/f4grobner/integer-ring.lisp

    r4304 r4312  
    5757      (1 self)
    5858      (-1 self)
    59       (otherwise
     59      (t
    6060       (unary-inverse (change-class self 'rational-field))))))
    6161
  • branches/f4grobner/pair-queue.lisp

    r4190 r4312  
    2525           "CRITICAL-PAIR-FIRST"
    2626           "CRITICAL-PAIR-SECOND"
     27           "CRITICAL-PAIR-DATA"
    2728           "CRITICAL-PAIR-QUEUE"
    2829           "SELECTION-STRATEGY"
     
    4243  ((first :initform nil  :initarg :first :accessor critical-pair-first :type poly)
    4344   (second :initform nil :initarg :second :accessor critical-pair-second :type poly)
    44    (data :initform nil :accessor critical-pair-division-data))
     45   (data :initform nil :accessor critical-pair-data))
    4546  (:documentation "Represents a critical pair, i.e. a pair of two
    4647polynomials. The derived classes may add extra data used in computing
Note: See TracChangeset for help on using the changeset viewer.