summaryrefslogtreecommitdiffstats
path: root/peanosfc.scm
diff options
context:
space:
mode:
authorThomas Bushnell, BSG <tb@debian.org>2005-12-04 20:03:34 -0800
committerBryan Newbold <bnewbold@robocracy.org>2017-02-20 00:05:33 -0800
commit69d4f1c761291d2c33c4b22454877402465b2c48 (patch)
treee46e0725a432b1f6460515fa521da6bb174bb226 /peanosfc.scm
parentf351d4a6571016e8a571e274032891e06e03911a (diff)
downloadslib-69d4f1c761291d2c33c4b22454877402465b2c48.tar.gz
slib-69d4f1c761291d2c33c4b22454877402465b2c48.zip
Import Debian changes 3a2-3debian/3a2-3
slib (3a2-3) unstable; urgency=low * Brought all source files up-to-date with upstream CVS. Repeat changes from version 3a2-1 in Makefile.
Diffstat (limited to 'peanosfc.scm')
-rw-r--r--peanosfc.scm49
1 files changed, 42 insertions, 7 deletions
diff --git a/peanosfc.scm b/peanosfc.scm
index 4a4039a..8c1e1a9 100644
--- a/peanosfc.scm
+++ b/peanosfc.scm
@@ -19,17 +19,20 @@
(require 'array)
+;;@code{(require 'peano-fill)}
+;;@ftindex peano-fill
+
;;; A. R. Butz.
;;; Space filling curves and mathematical programming.
;;; Information and Control, 12:314-330, 1968.
-(define (integer->tet-array scalar rank)
+(define (natural->tet-array scalar rank)
(do ((tets '() (cons (modulo scl 3) tets))
(scl scalar (quotient scl 3)))
((zero? scl)
(let* ((len (length tets))
(depth (quotient (+ len rank -1) rank)))
- (define tra (make-array (A:fixN8b 0) rank depth))
+ (define tra (make-array (A:fixZ8b 0) rank depth))
(set! tets (reverse tets))
(do ((idx (+ -1 depth) (+ -1 idx)))
((negative? idx))
@@ -40,7 +43,7 @@
(set! tets (cdr tets))))))
tra))))
-(define (tet-array->integer tra)
+(define (tet-array->natural tra)
(define rank (car (array-dimensions tra)))
(define depth (cadr (array-dimensions tra)))
(define val 0)
@@ -95,15 +98,47 @@
;;Returns a list of @2 nonnegative integer coordinates corresponding
;;to exact nonnegative integer @1. The lists returned by @0 for @1
;;arguments 0 and 1 will differ in the first element.
-(define (integer->peano-coordinates scalar rank)
- (define tra (integer->tet-array scalar rank))
+(define (natural->peano-coordinates scalar rank)
+ (define tra (natural->tet-array scalar rank))
(peano-flip! tra)
(tet-array->coordinates tra))
;;@body
;;Returns an exact nonnegative integer corresponding to @1, a list of
;;nonnegative integer coordinates.
-(define (peano-coordinates->integer coords)
+(define (peano-coordinates->natural coords)
(define tra (coordinates->tet-array coords))
(peano-flip! tra)
- (tet-array->integer tra))
+ (tet-array->natural tra))
+
+;;@body
+;;Returns a list of @2 integer coordinates corresponding to exact
+;;integer @1. The lists returned by @0 for @1 arguments 0 and 1 will
+;;differ in the first element.
+(define (integer->peano-coordinates scalar rank)
+ (define three^rank (expt 3 rank))
+ (do ((edx 1 (* edx three^rank))
+ (m 0 (+ 1 m)))
+ ((>= (quotient edx 2) (abs scalar))
+ (let ((tra (natural->tet-array (+ scalar (quotient edx 2)) rank))
+ (offset (quotient (expt 3 m) 2)))
+ (peano-flip! tra)
+ (map (lambda (k) (* (if (odd? m) -1 1) (- k offset)))
+ (tet-array->coordinates tra))))))
+
+;;@body
+;;Returns an exact integer corresponding to @1, a list of integer
+;;coordinates.
+(define (peano-coordinates->integer coords)
+ (define cobs (apply max (map abs coords)))
+ (let loop ((xpo 1))
+ (define offset (quotient (expt 3 xpo) 2))
+ (if (>= offset cobs)
+ (let ((tra (coordinates->tet-array
+ (map (lambda (elt) (+ elt offset))
+ coords))))
+ (peano-flip! tra)
+ ((if (odd? xpo) - +)
+ (- (tet-array->natural tra)
+ (quotient (expt 3 (* (length coords) xpo)) 2))))
+ (loop (+ 1 xpo)))))