diff options
author | Steve Langasek <vorlon@debian.org> | 2005-01-10 08:53:33 +0000 |
---|---|---|
committer | Bryan Newbold <bnewbold@robocracy.org> | 2017-02-20 00:05:30 -0800 |
commit | e33f9eb9cf5cc29c36ce2aa7e10cd0f37ae0cc8e (patch) | |
tree | abbf06041619e445f9d0b772b0d58132009d8234 /phil-spc.scm | |
parent | f559c149c83da84d0b1c285f0298c84aec564af9 (diff) | |
parent | 8466d8cfa486fb30d1755c4261b781135083787b (diff) | |
download | slib-e33f9eb9cf5cc29c36ce2aa7e10cd0f37ae0cc8e.tar.gz slib-e33f9eb9cf5cc29c36ce2aa7e10cd0f37ae0cc8e.zip |
Import Debian changes 3a1-4.2debian/3a1-4.2
slib (3a1-4.2) unstable; urgency=low
* Non-maintainer upload.
* Add guile.init.local for use within the build dir, since otherwise we
have an (earlier unnoticed) circular build-dep due to a difference
between scm and guile.
slib (3a1-4.1) unstable; urgency=low
* Non-maintainer upload.
* Build-depend on guile-1.6 instead of scm, since the new version of
scm is wedged in unstable (closes: #281809).
slib (3a1-4) unstable; urgency=low
* Also check for expected creation on slibcat. (Closes: #240096)
slib (3a1-3) unstable; urgency=low
* Also check for /usr/share/guile/1.6/slib before installing for guile
1.6. (Closes: #239267)
slib (3a1-2) unstable; urgency=low
* Add format.scm back into slib until gnucash stops using it.
* Call guile-1.6 new-catalog (Closes: #238231)
slib (3a1-1) unstable; urgency=low
* New upstream release
* Remove Info section from doc-base file (Closes: #186950)
* Remove period from end of description (linda, lintian)
* html gen fixed upstream (Closes: #111778)
slib (2d4-2) unstable; urgency=low
* Fix url for upstream source (Closes: #144981)
* Fix typo in slib.texi (enquque->enqueue) (Closes: #147475)
* Add build depends.
slib (2d4-1) unstable; urgency=low
* New upstream.
slib (2d3-1) unstable; urgency=low
* New upstream.
* Remove texi2html call in debian/rules. Now done upstream. Add make
html instead.
* Changes to rules and doc-base to conform to upstream html gen
* Clean up upstream makefile to make sure it cleans up after itself.
Diffstat (limited to 'phil-spc.scm')
-rw-r--r-- | phil-spc.scm | 94 |
1 files changed, 94 insertions, 0 deletions
diff --git a/phil-spc.scm b/phil-spc.scm new file mode 100644 index 0000000..3372ce6 --- /dev/null +++ b/phil-spc.scm @@ -0,0 +1,94 @@ +; "phil-spc.scm": Peano-Hilbert space filling mapping +; Copyright (c) 2003 Aubrey Jaffer +; +;Permission to copy this software, to modify it, to redistribute it, +;to distribute modified versions, and to use it for any purpose is +;granted, subject to the following restrictions and understandings. +; +;1. Any copy made of this software must include this copyright notice +;in full. +; +;2. I have made no warranty or representation that the operation of +;this software will be error-free, and I am under no obligation to +;provide any services, by way of maintenance, update, or otherwise. +; +;3. In conjunction with products arising from the use of this +;material, there shall be no use of my name in any advertising, +;promotional, or sales literature without prior written consent in +;each case. + +(require 'logical) + +;;@code{(require 'hilbert-fill)} +;;@ftindex hilbert-fill +;; +;;@noindent +;;@cindex Peano +;;@cindex Hilbert +;;@cindex Space-Filling +;;The @dfn{Peano-Hilbert Space-Filling Curve} is a one-to-one mapping +;;between a unit line segment and an @var{n}-dimensional unit cube. +;; +;;@noindent +;;The integer procedures map the non-negative integers to an +;;arbitrarily large @var{n}-dimensional cube with its corner at the +;;origin and all coordinates are non-negative. +;; +;;@noindent +;;For any exact nonnegative integers @var{scalar} and @var{rank}, +;; +;;@example +;;(= @var{scalar} (hilbert-coordinates->integer +;; (integer->hilbert-coordinates @var{scalar} @var{rank}))) +;; @result{} #t +;;@end example + +;;@body +;;Returns a list of @2 integer coordinates corresponding to exact +;;non-negative integer @1. The lists returned by @0 for @1 arguments +;;0 and 1 will differ in the first element. +(define (integer->hilbert-coordinates scalar rank) + (define ndones (logical:ones rank)) + (define rank*nbits + (let ((rank^2 (* rank rank))) + (* (quotient (+ -1 rank^2 (integer-length scalar)) rank^2) + rank^2))) + (let ((nthbits (quotient (logical:ones rank*nbits) ndones))) + (define igry (logxor (integer->gray-code scalar) (ash nthbits -1))) + (do ((bdxn (- rank rank*nbits) (+ rank bdxn)) + (chnk (logand (ash igry (- rank rank*nbits)) ndones) + (logand (ash igry (+ rank bdxn)) ndones)) + (rotation 0 (modulo (+ (integer-length (logand (- chnk) chnk)) + 1 rotation) + rank)) + (flipbit 0 (ash 1 rotation)) + (bignum 0 (+ (logxor flipbit (logical:rotate chnk rotation rank)) + (ash bignum rank)))) + ((positive? bdxn) + (map gray-code->integer (bitwise:delaminate rank bignum)))))) + +;;@body +;;Returns an exact non-negative integer corresponding to @1, a list +;;of non-negative integer coordinates. +(define (hilbert-coordinates->integer coords) + (define rank (length coords)) + (define bignum (apply bitwise:laminate (map integer->gray-code coords))) + (let ((rank*nbits + (* (quotient (+ -1 rank (integer-length (apply max coords))) rank) + rank rank)) + (ndones (logical:ones rank))) + (define nthbits (quotient (logical:ones rank*nbits) ndones)) + (define (loop bdxn rotation flipbit scalar) + (if (positive? bdxn) + (gray-code->integer (logxor scalar (ash nthbits -1))) + (let ((chnk (logical:rotate + (logxor flipbit (logand ndones (ash bignum bdxn))) + (- rotation) + rank))) + (loop (+ rank bdxn) + (modulo (+ (integer-length (logand (- chnk) chnk)) + 1 rotation) + rank) + (ash 1 rotation) + (+ chnk (ash scalar rank)))))) + (loop (- rank rank*nbits) 0 0 0))) |