1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276 277 278 279 280 281 282 283 284 285 286 287 288 289 290 291 292 293 294 295 296 297
|
;;; -*- Mode: LISP; Package: Maxima; Syntax: Common-Lisp;
;;; a package for chebyshev approximations. Comments at end
(in-package :maxima)
;; tocheb computes all the a_j, j=0 to n-1 for the Maxima function f.
(defun $tocheb (f n)
(cons '($chebseries) (ajs f n)))
;; compute a[j]s for Maxima this way
(defun ajs(f n)(loop for j from 0 to (1- n)
collect (aj f j n)))
;; it turns out we will be re-using certain key values repeatedly,
;; so we save them in a hash table.
(defvar *cosc* (make-hash-table)) ;; store useful values of cosine here.
(defun cachecos(r)(or (gethash r *cosc*)(setf (gethash r *cosc*) (cos r))))
(defun aj (f j n) ;; compute just one coefficient, a_j out of n for function f
(let ((in (/ 1.0d0 n))) ; inverse of n
(* in 2 (- 2 (if (= j n) 0 1))
(loop for k from 0 to (1- n) sum
(let ((h(* pi (+ k 0.5d0) in)))
(* (cachecos (* h j))
(mapply1 f (list (cachecos h)) f f)))))))
(defun $cheb_call(a x) ;; clenshaw algorithm
;; evaluate p=sum'(a_nT_n(x), i=0 to N) a is chebseries
;; sum' multiplies a_0 by 1/2
;; works.
(declare (optimize (speed 3)(safety 0))
(double-float x))
(cond ((eq (caar a) '$chebseries)
(let* ((bj2 0.0d0)
(bj1 0.0d0)
(bj0 0.0d0))
(declare(double-float bj2 bj1 bj0))
(setf a (reverse(cdr a))) ;; could hack this away. maybe later
(loop while (cdr a) do
(setf bj0
(+ (* 2.0d0 x bj1)
(- bj2)
(the double-float (pop a))))
(setf bj2 bj1 bj1 bj0))
(+ (* x bj1) (* 0.5d0(pop a))(- bj2))))
(t (error "expecting chebseries,not ~s" a))))
(defun $chebadd(a b)
;; a slower version, chebplus, is below
(let* ((ans nil))
(cond ((> (length a)(length b))
(setf a (append (cdr a) nil)) ;copy
(setf ans a)
(setf b (cdr b))
(while b (incf (car a)(pop b)) (pop a)))
(t
(setf b (append (cdr b) nil)) ;copy
(setf ans b)
(setf a (cdr a))
(while a (incf (car b)(pop a)) (pop b))))
(cons '($chebseries) ans)))
(defun $chebmul(a b)
;; assumes each is a chebseries. no error checking here.
;; a slower version is below.
(let* ((aa (coerce (rest a) 'simple-array))
(bb (coerce (rest b) 'simple-array))
(la (length aa))
(lb (length bb))
(term 0.0d0)
(ans (make-array (+ la lb -1) :initial-element 0.0d0)))
(setf (aref aa 0)(* 0.5d0 (aref aa 0)))
(setf (aref bb 0)(* 0.5d0 (aref bb 0)))
(loop for i from 0 to (1- la) do
(loop for j from 0 to (1- lb) do
(setf term (* (aref aa i)(aref bb j)))
(incf (aref ans (+ i j)) term)
(incf (aref ans (abs(- i j))) term)
))
(loop for i from 1 to (+ la lb -2) do;; not ans[0]
(setf (aref ans i) (* (aref ans i)0.5d0))
)
(cons '($chebseries)(coerce ans 'list))))
;; how about composition?
(defun $chebcomp(f g n)
;; f, g are chebseries
;; simple hack is to evaluate f(g(x)) as needed, e.g.
($tocheb #'(lambda(r)($cheb_call f ($cheb_call g r)))
;; how many points are justified though??
n))
(defun $chebplus(f g)
;; f, g are chebseries
;; simple hack is to evaluate f and g as needed, e.g.
($tocheb #'(lambda(r)(+($cheb_call f r) ($cheb_call g r)))
;; how many points are justified though??
(max (length f)(length g))))
;; this works
(defun $chebtimes(f g)
;; f, g are chebseries
;; simple hack is to evaluate f and g as needed, e.g.
($tocheb #'(lambda(r)(*($cheb_call f r) ($cheb_call g r)))
;; how many points are justified though??
(+ (length f)(length g) -1)))
(defun $chebinv(f n)
;; f is a chebseries. Compute 1/f
;; simple hack is to evaluate f and g as needed, e.g.
($tocheb #'(lambda(r)(/ 1.0d0 ($cheb_call f r)))
;; how many points are justified though??
n))
(defun $chebapply(fun cs n) ;; apply any maxima function to a chebseries
;; e.g. chebapply(lambda([r](exp(r^2+1)),chebs);
;; constraint: fun must be a function of one float argument that
;; returns a double-float.
($tocheb #'(lambda(r)
(mapply1 fun (list r) fun fun)) cs
;; how many points are justified though??
n))
(defun $chebint(a) ;; indefinite integration of the function given by a.
;;integrate(t[n](x),x) =
;; if n=0 then t[1].
;; if n=1 then 1/2*t[0] +1/4*t[2] else
;; 1/2*(t[n+1]/(n+1) - t[n-1]/(n-1))
;;
;;
(let* ((aa (coerce (rest a) 'simple-array))
(la (length aa))
(term 0.0d0)
(ans (make-array (max 2(1+ la)) :initial-element 0.0d0)))
(setf (aref aa 0) (* 0.5d0 (aref aa 0)))
(setf (aref ans 1) (aref aa 0)) ;int(const)= const*x
(setf (aref ans 0) (* 0.25d0 (aref aa 1))) ;int(x) = x^2/2 =1/4*T[0]+
(setf (aref ans 2) (* 0.25d0 (aref aa 1))) ;...+ 1/4*T[2]
(loop for i from 2 to (1- la) do
(setf term (* 0.5 (aref aa i)))
(incf (aref ans (1+ i)) (/ term (1+ i)))
(decf (aref ans (1- i)) (/ term (1- i))))
(setf (aref ans 0)(* 0.5d0 (aref ans 0))) ;so sum' works
(cons '($chebseries)(coerce ans 'list))))
;; elaboration: fix up the above programs to combine non-chebseries with
;; chebseries. Compute the appropriate number of terms.
#| This file defines some Maxima functions for playing with
representation of functions of a single "real" variable
(double-precision floats, actually) by their Chebyshev series
coefficients. This particular version is set up for generation and
manipulation of functions defined on [-1,1].
We refer elsewhere (http://www2.maths.ox.ac.uk/chebfun) for a discussion
of the kinds of computations that can be considered, and the nature of functions
that can be appropriately modeled by a Chebyshev expansion.
The chebfun web site discusses a Matlab project which includes
facilities for functions being translated or scaled, or pasted together
piecewise.
A key piece (not included here), is a method for truncation of these chebyshev series,
based on the relative size of the trailing coefficients. Drop em if them are too small
to matter. Also, these series can be directly multiplied, added, composed. There
are neat ways of computing them for polynomials and rational functions, though not
as briefly as here. And there is a faster way of computing the coefficients from
the evaluation points using an FFT (or a Discrete Cosine Transform), which we do not
include because it would require other programs, and more debugging. These lisp
programs should be compiled for speed.
It has been said that "the Chebyshev polynomials are everywhere dense in numerical analysis."
examples
load("thisfile")
s: tocheb(lambda([x],sin(x)),20) ;
cheb_call(s,0.1234) ;
sin(0.1234) ;
gg(x):=sin(20*x^2+exp(x^5+sqrt(x^4+1))) ;
g:tocheb(gg,60);
gg(0.4) ;
cheb_call(g,0.4) ;
plot2d('[gg(x),cheb_call(g,x)],[x,0,1.025]) ; /* note they are the same until x>1 */
oh if you don't like
s: tocheb(lambda([x],sin(x)),20) ;
then we can do this:
afun(ex,x):=buildq([expr:ex,var:x],lambda([var],expr)) $
cheb3(expr,var,count):= tocheb(afun(expr,var),count)$
cheb3(sin(z),z,20) then is the same as tocheb(lambda([z],sin(z)),20) which happens also to be
the same as tocheb(sin,20).
Here are a few additional ideas.
Elaborate on chebseries so that they are callable. e.g.
(($chebseries) a b c) becomes #'(lambda(r)(cheb_call '((chebseries) a b c) r))
in effect. applying a chebseries to an argument becomes simpler.
include various limits (now default -1,1)
package up a piecewise function as the chebfun project does.
extract a coefficient from the series so that all coefficients are between -1 and 1.
e.g. [1,2,3] becomes 3* [1/3,2/3,1].
The max coefficient would then always be 1.
In fact, the coefficients could all be fixed point numbers between -.111111...
and +.11111. Low precision would look like .0000001.. . Given that float
arithmetic is ubiquitous and fast, this may not be a winner.
other advantage: a method for truncating the product of chebyshev series.
a= A* csa, where csa has max coefficient of +-1. [apparently not new,]
b= B* csb, similarly.
the product is then A*B* (csa*csb).
without loss of generality, consider only csa*csb.
We agree that if we know that all coefficients in the answer beyond
some N have magnitude less than epsilon (say, 1e-13) then we will drop
all those terms beyond N.
We will not necessarily know this to be the case
when we generate terms ab initio from some expression we are
evaluating at Gauss-Lobatto points, but if we assert the two cs to be
multiplied are in fact correct in all given terms, and furthermore,
all terms beyond those explicitly represented are exactly zero, then
we are doing about as well as can be expected with the information at
our disposal.
Typically the input cs will have rapidly declining coefficients,
especially just before they are cut off.
For purposes of being explicit, let us say that the coefficients start
with magnitude 1 and decrease by a factor of 10 for each coefficient.
that would suggest coefficients of magnitude
1,0.1, 0.01, ... 1e-12, 1e-13, 0.... in each input, and csa and csb are
both of length 13.
We know that any terms in the answer will be of magnitude 1e-13 or greater,
so there is not much point in accumulating answers that are 1e-7 times
terms in the other series that are 1e-7 or less. At worst, there will be
13 terms all of the same sign added together in a 13x13 multiply..
Consider
csa = csa_big + sqrt(eps/n)*csa_small =A1+sqrt(eps/n)A2 n is length of csa
csb = csb_big + sqrt(eps/m)*csb_small =B1+sqrt(eps/m)B2 m is length of csb
The product contains A1*B1+sqrt(eps/m)*A1*B2 +sqrt(eps/n)*A2*B1+ eps/sqrt(nm)*A2*B2.
This last component promises to be mostly negligible. Why multiply these?
So instead of computing 13^2 =169 terms to produce 26 coefficients, we compute about
3/4 of them, or about 127 terms. We will also produce about 13 coefficients.
maybe this cuts off too much? what if we use eps^2? a term of order eps^2 would not affect even the low order bits of a term of order eps, which is the smallest retained term, anyway.
how would terms of order eps^2 be generated -- hardly at all. ugh.
more thoughts, if we are going to make this into a generic system
for dealing with functions.
integral (just done)
derivative
zeros
(eh, maybe) positive
(eh, heuristic) test for equality
majorization? f>g, f<g, sometimes, always?
economization, remez?
rational or other powers. sqrt, power of 10.. maybe jcpmiller method?
another way of converting a polynomial in x of degree N, sum(a[i]*x^i,i,0,N) to chebyshev series,
based on CACM paper by Thacher, 1964.
(kill(c,phi), /* buggy */
c[q,N]:=sum(a[r]*phi[q,(r-q)/2,q],r,1,N),
phi[q,j]:=if j=0 then 2^(1-q) else (q+2*j)*(q+2*j-1)/(4*j*(q+j)*phi[q,j-1]))
|#
|