;;; Surreal Numbers Datatype
;;; This code is written by Joshua Herman and placed in the Public
;;; Domain. All warranties are disclaimed.
;;; Requires SRFI-9
;;;Some Helper functions
(define (nullset? x)
(equal? x '(0)))
(define (set? lat)
(letrec
((S (cond
((null? lat) #t)
((member? (car lat) (cdr lat)) #f)
(else (set? (cdr lat)))))
(member? (cond
((null? lat) #f)
(else (or (equal? (car lat) a)
(member? a (cdr lat)))))))))
(define (setcmp-f? test? lat1 lat2)
(cond
((or (null? lat1)
(null? lat2)) #t)
((or (not (null? (car lat1)))
(not (null? (car lat1))))
(test? (car lat1)
(car lat2)))
(else (set-cmp-f? test? (cdr lat1) (cdr lat2)))))
(define (member>=? xl xr)
(setcmp-f? >= xl xr))
(define (union set1 set2)
(cond
((null? set1) set2)
((member? (car set1)
set2)
(union (cdr set1)
set2)
(else (cons (car set1)
(union (cdr set1)
set2))))))
(define first$ car)
(define (build s1 s2)
(cons s1
(cons s2 '())))
(define second$ (lambda (str) ((second str))))
(define str-maker
(lambda (next n)
(build n (lambda ()
(str-maker next (next n))))))
(define frontier
(lambda (str n)
(cond
((zero? n) '())
(else (cons (first$ str)
(frontier (second$ str)
(- n 1)))))))
;;;Surreal Number Code Starts Here
;Surreal numbers are defined as follows.
;Given a Surreal Number X = (xl, xr)
;where XL and XR are sets.
;∀ xl ∈ L ∀ xr ∈ R : ¬(xl ≤ xr).
;For exlample {(0) |(0)} == 0 == { | } |#
(define-record-type :surreal-number
(make-surreal l r)
surreal-number?
(l left-side)
(r right-side))
(define (well-formed? surreal-number)
(and
(set? (l surreal-number))
(set? (x surreal-number))
(not (member=>? (l surreal-number)
(r surreal-number)))))
(define (create-surreal-number l r)
(if (well-formed? l r)
(make-surreal l r)
(display "Error in XL/XR Check Input")))
(define zero (create-surreal-number '(0) '(0)))
(define (pretty-print-surreal surreal-number)
(display "(") (display (l surreal-number))
(display ",") (display (r surreal-number)) (display ")"))
(define (display x)
(if (surreal? x)
(pretty-print-surreal x)
(display x)))
(define (surreal-dydactic-function a b)
(/ a (expt 2 b)))
(define (Surreal+1 surreal-number)
(make-surreal
(surreal-dydactic-function (xl surreal-number)
(xr surreal-number))))
(define (+/-one? side)
(and (nullset? (car side)) (nullset? (cadr side))))
(define (value surreal-number)
(+ (addvec (xl surreal-number))
(addvec (xr surreal-number))))
(define (add-surreal surreal-number1 surreal-number2)
(make-surreal
(union (xl surreal-number1)
(xl surreal-number2))
(union (xr surreal-number1)
(xr surreal-number 2))))
;;;Finite enumeration is done by streams
(define surreal-number-set+
(str-maker surreal+1 zero))
(define surreal-number-set-
(str-maker surreal-1 zero))
(define surreal+1)
;;Stream Definitions
;;Example
;;(define int (str-maker add1 0))
;; (define (add1 n)
;; (+ 1 n))
;; (define odd
;; (str-maker (lambda (n)
;; (+ 2 n)) -1))
;; (define Q
;; (lambda (str n)
;; (cond
;; ((zero? (remainder (first$ str) n))
;; (Q (second$ str) n))
;; (else (build
;; (first$ str)
;; (lambda ()
;; (Q (second$ str) n)))))))
;; (define P
;; (lambda (str)
;; (build (first$ str)
;; (lambda ()
;; P (Q str (first$ str))))))