Fcalva/chibi-scheme
1
0
Fork 0
mirror of https://github.com/ashinn/chibi-scheme.git synced 2025-05-19 05:39:18 +02:00
Code Issues Projects Releases Packages Wiki Activity Actions

Flattening indexing further.

Browse source 
We can pre-subtract each coeff times its lower bound from the
base coefficient in SRFI 179 indexers.
This commit is contained in:
Alex Shinn 2021-04-30 14:25:39 +09:00
parent d11106b2f7
commit e3083062fa
1 changed files with 15 additions and 8 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

23
lib/srfi/179.scm
View file

@ -344,22 +344,28 @@
(lp (+ i 1) (cdr ls) offset2 count))) (lp (+ i 1) (cdr ls) offset2 count)))
(else (else
(vector-set! res i coeff) (vector-set! res i coeff)
(vector-set! res 0 (- (vector-ref res 0)
(* coeff
(interval-lower-bound domain (- i 1)))))
(lp (+ i 1) (cdr ls) offset2 count)))))))))) (lp (+ i 1) (cdr ls) offset2 count))))))))))
(define (coeffs->indexer coeffs domain) (define (coeffs->indexer coeffs domain)
(case (vector-length coeffs) (case (vector-length coeffs)
((2) ((2)
(let ((a (vector-ref coeffs 0)) (let ((a (vector-ref coeffs 0))
(b (vector-ref coeffs 1)) (b (vector-ref coeffs 1)))
(lo-x (interval-lower-bound domain 0))) (lambda (x) (+ a (* b x)))))
(lambda (x) (+ a (* b (- x lo-x))))))
((3) ((3)
(let ((a (vector-ref coeffs 0))
(b (vector-ref coeffs 1))
(c (vector-ref coeffs 2)))
(lambda (x y) (+ a (* b x) (* c y)))))
((4)
(let ((a (vector-ref coeffs 0)) (let ((a (vector-ref coeffs 0))
(b (vector-ref coeffs 1)) (b (vector-ref coeffs 1))
(c (vector-ref coeffs 2)) (c (vector-ref coeffs 2))
(lo-x (interval-lower-bound domain 0)) (d (vector-ref coeffs 3)))
(lo-y (interval-lower-bound domain 1))) (lambda (x y z) (+ a (* b x) (* c y) (* d z)))))
(lambda (x y) (+ a (* b (- x lo-x)) (* c (- y lo-y))))))
(else (else
(lambda multi-index (lambda multi-index
(let ((lim (vector-length coeffs))) (let ((lim (vector-length coeffs)))
@ -376,8 +382,7 @@
(else (else
(lp (cdr ls) (lp (cdr ls)
(+ i 1) (+ i 1)
(+ res (* (- (car ls) (interval-lower-bound domain (- i 1))) (+ res (* (car ls) (vector-ref coeffs i))))))))))))
(vector-ref coeffs i))))))))))))
(define (default-coeffs domain) (define (default-coeffs domain)
(let* ((dim (interval-dimension domain)) (let* ((dim (interval-dimension domain))
@ -397,6 +402,8 @@
(let ((coeff (* scale (- (interval-upper-bound domain i) (let ((coeff (* scale (- (interval-upper-bound domain i)
(interval-lower-bound domain i))))) (interval-lower-bound domain i)))))
(vector-set! res (+ i 1) scale) (vector-set! res (+ i 1) scale)
(vector-set! res 0 (- (vector-ref res 0)
(* scale (interval-lower-bound domain i))))
(lp (- i 1) coeff))))))) (lp (- i 1) coeff)))))))
(define (default-indexer domain) (define (default-indexer domain)