From 8466d8cfa486fb30d1755c4261b781135083787b Mon Sep 17 00:00:00 2001 From: Bryan Newbold Date: Mon, 20 Feb 2017 00:05:29 -0800 Subject: Import Upstream version 3a1 --- dbinterp.scm | 34 ++++++++++++++++++++++++++++++++++ 1 file changed, 34 insertions(+) create mode 100644 dbinterp.scm (limited to 'dbinterp.scm') 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)))))))) -- cgit v1.2.3