Start Surreal Numbers book
author |
Steve Losh <steve@stevelosh.com> |
date |
Fri, 03 Mar 2017 21:01:16 +0000 |
parents |
d5445be606ff
|
children |
6589f828689b
|
branches/tags |
(none) |
files |
package.lisp sand.asd src/pq.lisp src/surreal-numbers.lisp |
Changes
--- a/package.lisp Fri Mar 03 20:04:23 2017 +0000
+++ b/package.lisp Fri Mar 03 21:01:16 2017 +0000
@@ -258,7 +258,7 @@
(:export
))
-(defpackage :sand.pq
+(defpackage :sand.surreal-numbers
(:use
:cl
:losh
--- a/sand.asd Fri Mar 03 20:04:23 2017 +0000
+++ b/sand.asd Fri Mar 03 21:01:16 2017 +0000
@@ -12,7 +12,6 @@
#+sbcl :sb-sprof
:cffi
:cl-algebraic-data-type
- :cl-arrows
:cl-charms
:cl-fad
:cl-ppcre
@@ -22,7 +21,6 @@
:easing
:flexi-streams
:function-cache
- :html-entities
:iterate
:losh
:parenscript
@@ -50,7 +48,6 @@
:components ((:file "utils")
(:file "primes")
(:file "graphs")
- (:file "pq")
(:file "graphviz")
(:file "hanoi")
(:file "urn")
@@ -81,6 +78,7 @@
(:file "istruct")
(:file "names")
(:file "easing")
+ (:file "surreal-numbers")
(:module "turing-omnibus"
:serial t
:components ((:file "wallpaper")
--- a/src/pq.lisp Fri Mar 03 20:04:23 2017 +0000
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,48 +0,0 @@
-(in-package :sand.pq)
-
-;;;; Priority Queue -----------------------------------------------------------
-;;; Jankass priority queue implementation.
-(defstruct pq
- (contents nil)
- (predicate #'<)
- (test #'eql))
-
-
-(defun pqn-priority (node)
- (first node))
-
-(defun pqn-element (node)
- (second node))
-
-
-(defun pq-resort (pq)
- (zapf (pq-contents pq)
- (sort % (pq-predicate pq) :key #'pqn-priority))
- pq)
-
-(defun pq-lookup (pq element)
- (find element (pq-contents pq)
- :key #'pqn-element
- :test (pq-test pq)))
-
-(defun pq-insert (pq element priority)
- (zapf (pq-contents pq)
- (merge 'list `((,priority ,element)) % (pq-predicate pq)
- :key #'pqn-priority))
- pq)
-
-(defun pq-ensure (pq element priority)
- (let ((existing (pq-lookup pq element)))
- (if existing
- (progn (setf (car existing) priority)
- (pq-resort pq)
- t)
- (progn (pq-insert pq element priority)
- nil)))
- pq)
-
-(defun pq-dequeue (pq)
- (if (pq-contents pq)
- (values (pqn-element (pop (pq-contents pq))) t)
- (values nil nil)))
-
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/src/surreal-numbers.lisp Fri Mar 03 21:01:16 2017 +0000
@@ -0,0 +1,45 @@
+(in-package :sand.surreal-numbers)
+
+
+(defstruct (surreal (:constructor surreal (left right)))
+ (left nil :type list)
+ (right nil :type list))
+
+
+(defun surreal<= (x y)
+ ;; "One number is less than or equal to another if and only if
+ ;; no member of the first number's left set is greater than or equal to the second number, and
+ ;; no member of the second number's right set is less than or equal to the first number"
+ (and (notany (lambda (n) (surreal>= n y)) (surreal-left x))
+ (notany (lambda (n) (surreal<= n x)) (surreal-right y))))
+
+(defun surreal>= (x y)
+ (surreal<= y x))
+
+(defun surreal< (x y)
+ (and (surreal<= x y)
+ (not (surreal<= y x))))
+
+(defun surreal> (x y)
+ (surreal< y x))
+
+(defun surreal= (x y)
+ (and (surreal<= x y)
+ (surreal<= y x)))
+
+(defun surreal!= (x y)
+ (not (surreal= x y)))
+
+
+(defun check-surreal (surreal)
+ ;; "No member of the left set is greater than or equal to a member of the
+ ;; right set"
+ (dolist (x (surreal-left surreal) t)
+ (dolist (y (surreal-right surreal))
+ (assert (not (surreal>= x y)))))
+ t)
+
+
+(defparameter *0* (surreal nil nil))
+(defparameter *1* (surreal (list *0*) nil))
+(defparameter *-1* (surreal nil (list *0*)))