summaryrefslogtreecommitdiffstats
path: root/sierpinski.scm
diff options
context:
space:
mode:
authorBryan Newbold <bnewbold@robocracy.org>2017-02-20 00:05:25 -0800
committerBryan Newbold <bnewbold@robocracy.org>2017-02-20 00:05:25 -0800
commit8ffbc2df0fde83082610149d24e594c1cd879f4a (patch)
treea2be9aad5101c5e450ad141d15c514bc9c2a2963 /sierpinski.scm
downloadslib-8ffbc2df0fde83082610149d24e594c1cd879f4a.tar.gz
slib-8ffbc2df0fde83082610149d24e594c1cd879f4a.zip
Import Upstream version 2a6upstream/2a6
Diffstat (limited to 'sierpinski.scm')
-rw-r--r--sierpinski.scm71
1 files changed, 71 insertions, 0 deletions
diff --git a/sierpinski.scm b/sierpinski.scm
new file mode 100644
index 0000000..a4de2d6
--- /dev/null
+++ b/sierpinski.scm
@@ -0,0 +1,71 @@
+;"sierpinski.scm" Hash function for 2d data which preserves nearness.
+;From: jjb@isye.gatech.edu (John Bartholdi)
+;
+; This code is in the public domain.
+
+;Date: Fri, 6 May 94 13:22:34 -0500
+
+(define MAKE-SIERPINSKI-INDEXER
+ (lambda (max-coordinate)
+ (lambda (x y)
+ (if (not (and (<= 0 x max-coordinate)
+ (<= 0 y max-coordinate)))
+ (slib:error 'sierpinski-index
+ "Coordinate exceeds specified maximum.")
+ ;
+ ; The following two mutually recursive procedures
+ ; correspond to to partitioning successive triangles
+ ; into two sub-triangles, adjusting the index according
+ ; to which sub-triangle (x,y) lies in, then rescaling
+ ; and possibly rotating to continue the recursive
+ ; decomposition:
+ ;
+ (letrec ((loopA
+ (lambda (resolution x y index)
+ (cond ((zero? resolution) index)
+ (else
+ (let ((finer-index (+ index index)))
+ (if (> (+ x y) max-coordinate)
+ ;
+ ; In the upper sub-triangle:
+ (loopB resolution
+ (- max-coordinate y)
+ x
+ (+ 1 finer-index))
+ ;
+ ; In the lower sub-triangle:
+ (loopB resolution
+ x
+ y
+ finer-index)))))))
+ (loopB
+ (lambda (resolution x y index)
+ (let ((new-x (+ x x))
+ (new-y (+ y y))
+ (finer-index (+ index index)))
+ (if (> new-y max-coordinate)
+ ;
+ ; In the upper sub-triangle:
+ (loopA (quotient resolution 2)
+ (- new-y max-coordinate)
+ (- max-coordinate new-x)
+ (+ finer-index 1))
+ ;
+ ; In the lower sub-triangle:
+ (loopA (quotient resolution 2)
+ new-x
+ new-y
+ finer-index))))))
+ (if (<= x y)
+ ;
+ ; Point in NW triangle of initial square:
+ (loopA max-coordinate
+ x
+ y
+ 0)
+ ;
+ ; Else point in SE triangle of initial square
+ ; so translate point and increase index:
+ (loopA max-coordinate
+ (- max-coordinate x)
+ (- max-coordinate y) 1)))))))