Artifact 6b8352c5054332c261c1aea5375ea69e82c9ced0e27029618f451cdfd23029ec:
- Executable file
r37/packages/specfn/dilog.red
— part of check-in
[f2fda60abd]
at
2011-09-02 18:13:33
on branch master
— Some historical releases purely for archival purposes
git-svn-id: https://svn.code.sf.net/p/reduce-algebra/code/trunk/historical@1375 2bfe0521-f11c-4a00-b80e-6202646ff360 (user: arthurcnorman@users.sourceforge.net, size: 2906) [annotate] [blame] [check-ins using] [more...]
- Executable file
r38/packages/specfn/dilog.red
— part of check-in
[f2fda60abd]
at
2011-09-02 18:13:33
on branch master
— Some historical releases purely for archival purposes
git-svn-id: https://svn.code.sf.net/p/reduce-algebra/code/trunk/historical@1375 2bfe0521-f11c-4a00-b80e-6202646ff360 (user: arthurcnorman@users.sourceforge.net, size: 2906) [annotate] [blame] [check-ins using]
module dilog; % Dilogarithm Integral and Polylogarithm function % Lerch Phi % Collected (most items) from Abramowitz-Stegun (27.7) % by Winfried Neun , ZIB Berlin % Lerch Phi from Wolfram's book algebraic << operator fps; operator Lerch_phi; operator polylog; let { fps(dilog ~x,~x,1) => infsum((-1)^k*(x-1)^k/k^2,k,1,infinity)}; let { df(dilog(~x),~x) => - LOG(X)/(x-1)}; let { int(log(~tt)/(~tt-1),~tt,1,~x) => -dilog x }; let { Lerch_phi(~z,~s,0) => polylog(s,z) }; let { Lerch_phi(1,~s,0) => zeta(s) }; let { dilog(exp(-~t)) => - dilog(exp t) - t^2/2, dilog(1/e^(~t)) => - dilog(exp t) - t^2/2, dilog(-~x+1) => - dilog(x) -log x * log (1-x) + pi^2/6 when numberp x and geq(x,0) and geq(1,x), dilog(~x) => - dilog(1-x) - log (x) * log(1-x) + pi^2/6 when numberp x and (x > 0) and geq(1,x) and not fixp(1/x), dilog(1/~x) => - dilog(x) -(log x)^2/2 when numberp x and geq(x,0), dilog(~x) => dilog(x-1) - log (x - 1) * log (x)-pi^2/12-dilog( (x-1)^2)/2 when numberp x and geq(x,1) and geq(2,x) and not (x = 0) and not fixp(1/x), dilog(~x) => compute_dilog(x) when numberp x and lisp !*rounded and x>=0, dilog 2 => -pi^2/12, dilog 1 => 0, dilog 0 => pi^2/6}; let { Lerch_Phi (~z,~s,~a) => compute_lerch_phi(z,s,a) when lisp !*rounded and numberp z and numberp s and numberp a, polylog(~n,~z) => compute_lerch_phi(z,n,0) when lisp !*rounded and numberp z and numberp n }; procedure compute_dilog(x); if x = 0.0 then pi^2/6 else if x = 1.0 then 0 else if x = 2.0 then -pi^2/12 else if (x >= 1.9 and x < 2.0) then compute_dilog(1-(x-1)^2)/2 - compute_dilog(1-(x-1)) else if (x > 1.9 or x < -1.0) then -(log x)^2/2 -compute_dilog(1/x) else if (x < 0.5 and x > 0.0) then -log(1-x)*log(x) + pi^2/6 - compute_dilog(1-x) else if (x > 0.5 and x < 1.0 ) then -(log x)^2/2 -compute_dilog(1/x) else begin scalar !*uncached,yy,summa,ii,term,altern ,xm1,xm1!^ii; !*uncached :=t; yy := 10^-(lisp !:prec!:); summa := 0; xm1 := x-1.0; xm1!^ii := xm1; ii :=1; altern := -1; while abs(term :=(altern * xm1!^ii/(ii*ii))) > yy do << summa := summa + term; ii:=ii+1 ; altern := -1 * altern; xm1!^ii := xm1!^ii *xm1>>; return summa; end; >>; procedure compute_lerch_phi(z,s,a); begin scalar !*uncached,yy,summa,k,term,pow; !*uncached :=t; term := 1; pow := 1; yy := 10^(-(lisp !:prec!:) -3); k := 0; summa := 0; while term > yy do << if (a + k) neq 0 then << term := pow / (a+k)^s; summa := summa + term>>; pow := pow * z; k := k + 1; >>; return summa; end; endmodule; end;