summaryrefslogtreecommitdiffstats
path: root/dbinterp.scm
diff options
context:
space:
mode:
authorBryan Newbold <bnewbold@robocracy.org>2017-02-20 00:05:29 -0800
committerBryan Newbold <bnewbold@robocracy.org>2017-02-20 00:05:29 -0800
commit8466d8cfa486fb30d1755c4261b781135083787b (patch)
treec8c12c67246f543c3cc4f64d1c07e003cb1d45ae /dbinterp.scm
parent87b82b5822ca54228cfa6df29be3ad9d4bc47d16 (diff)
downloadslib-8466d8cfa486fb30d1755c4261b781135083787b.tar.gz
slib-8466d8cfa486fb30d1755c4261b781135083787b.zip
Import Upstream version 3a1upstream/3a1
Diffstat (limited to 'dbinterp.scm')
-rw-r--r--dbinterp.scm34
1 files changed, 34 insertions, 0 deletions
diff --git a/dbinterp.scm b/dbinterp.scm
new file mode 100644
index 0000000..8ccb1df
--- /dev/null
+++ b/dbinterp.scm
@@ -0,0 +1,34 @@
+;;; "dbinterp.scm" Interpolate function from database table.
+;Copyright 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.
+
+;;@ This procedure works only for tables with a single primary key.
+(define (interpolate-from-table table column)
+ (define get (table 'get column))
+ (define prev (table 'isam-prev))
+ (define next (table 'isam-next))
+ (lambda (x)
+ (let ((nxt (next x)))
+ (if nxt (set! nxt (car nxt)))
+ (let ((prv (prev (or nxt x))))
+ (if prv (set! prv (car prv)))
+ (cond ((not nxt) (get prv))
+ ((not prv) (get nxt))
+ (else (/ (+ (* (- x prv) (get nxt))
+ (* (- nxt x) (get prv)))
+ (- nxt prv))))))))