/** @file inifcns.cpp * * Implementation of GiNaC's initially known functions. */ /* * GiNaC Copyright (C) 1999-2005 Johannes Gutenberg University Mainz, Germany * * This program is free software; you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by * the Free Software Foundation; either version 2 of the License, or * (at your option) any later version. * * This program is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. * * You should have received a copy of the GNU General Public License * along with this program; if not, write to the Free Software * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA */ #include #include #include "inifcns.h" #include "ex.h" #include "constant.h" #include "lst.h" #include "matrix.h" #include "mul.h" #include "power.h" #include "operators.h" #include "relational.h" #include "pseries.h" #include "symbol.h" #include "symmetry.h" #include "utils.h" namespace GiNaC { ////////// // complex conjugate ////////// static ex conjugate_evalf(const ex & arg) { if (is_exactly_a(arg)) { return ex_to(arg).conjugate(); } return conjugate_function(arg).hold(); } static ex conjugate_eval(const ex & arg) { return arg.conjugate(); } static void conjugate_print_latex(const ex & arg, const print_context & c) { c.s << "\\bar{"; arg.print(c); c.s << "}"; } static ex conjugate_conjugate(const ex & arg) { return arg; } REGISTER_FUNCTION(conjugate_function, eval_func(conjugate_eval). evalf_func(conjugate_evalf). print_func(conjugate_print_latex). conjugate_func(conjugate_conjugate). set_name("conjugate","conjugate")); ////////// // absolute value ////////// static ex abs_evalf(const ex & arg) { if (is_exactly_a(arg)) return abs(ex_to(arg)); return abs(arg).hold(); } static ex abs_eval(const ex & arg) { if (is_exactly_a(arg)) return abs(ex_to(arg)); else return abs(arg).hold(); } static void abs_print_latex(const ex & arg, const print_context & c) { c.s << "{|"; arg.print(c); c.s << "|}"; } static void abs_print_csrc_float(const ex & arg, const print_context & c) { c.s << "fabs("; arg.print(c); c.s << ")"; } static ex abs_conjugate(const ex & arg) { return abs(arg); } static ex abs_power(const ex & arg, const ex & exp) { if (arg.is_equal(arg.conjugate()) && is_a(exp) && ex_to(exp).is_even()) return power(arg, exp); else return power(abs(arg), exp).hold(); } REGISTER_FUNCTION(abs, eval_func(abs_eval). evalf_func(abs_evalf). print_func(abs_print_latex). print_func(abs_print_csrc_float). print_func(abs_print_csrc_float). conjugate_func(abs_conjugate). power_func(abs_power)); ////////// // Step function ////////// static ex step_evalf(const ex & arg) { if (is_exactly_a(arg)) return step(ex_to(arg)); return step(arg).hold(); } static ex step_eval(const ex & arg) { if (is_exactly_a(arg)) return step(ex_to(arg)); else if (is_exactly_a(arg) && is_exactly_a(arg.op(arg.nops()-1))) { numeric oc = ex_to(arg.op(arg.nops()-1)); if (oc.is_real()) { if (oc > 0) // step(42*x) -> step(x) return step(arg/oc).hold(); else // step(-42*x) -> step(-x) return step(-arg/oc).hold(); } if (oc.real().is_zero()) { if (oc.imag() > 0) // step(42*I*x) -> step(I*x) return step(I*arg/oc).hold(); else // step(-42*I*x) -> step(-I*x) return step(-I*arg/oc).hold(); } } return step(arg).hold(); } static ex step_series(const ex & arg, const relational & rel, int order, unsigned options) { const ex arg_pt = arg.subs(rel, subs_options::no_pattern); if (arg_pt.info(info_flags::numeric) && ex_to(arg_pt).real().is_zero() && !(options & series_options::suppress_branchcut)) throw (std::domain_error("step_series(): on imaginary axis")); epvector seq; seq.push_back(expair(step(arg_pt), _ex0)); return pseries(rel,seq); } static ex step_power(const ex & arg, const ex & exp) { if (exp.info(info_flags::positive)) return step(arg); return power(step(arg), exp).hold(); } static ex step_conjugate(const ex& arg) { return step(arg); } REGISTER_FUNCTION(step, eval_func(step_eval). evalf_func(step_evalf). series_func(step_series). conjugate_func(step_conjugate). power_func(step_power)); ////////// // Complex sign ////////// static ex csgn_evalf(const ex & arg) { if (is_exactly_a(arg)) return csgn(ex_to(arg)); return csgn(arg).hold(); } static ex csgn_eval(const ex & arg) { if (is_exactly_a(arg)) return csgn(ex_to(arg)); else if (is_exactly_a(arg) && is_exactly_a(arg.op(arg.nops()-1))) { numeric oc = ex_to(arg.op(arg.nops()-1)); if (oc.is_real()) { if (oc > 0) // csgn(42*x) -> csgn(x) return csgn(arg/oc).hold(); else // csgn(-42*x) -> -csgn(x) return -csgn(arg/oc).hold(); } if (oc.real().is_zero()) { if (oc.imag() > 0) // csgn(42*I*x) -> csgn(I*x) return csgn(I*arg/oc).hold(); else // csgn(-42*I*x) -> -csgn(I*x) return -csgn(I*arg/oc).hold(); } } return csgn(arg).hold(); } static ex csgn_series(const ex & arg, const relational & rel, int order, unsigned options) { const ex arg_pt = arg.subs(rel, subs_options::no_pattern); if (arg_pt.info(info_flags::numeric) && ex_to(arg_pt).real().is_zero() && !(options & series_options::suppress_branchcut)) throw (std::domain_error("csgn_series(): on imaginary axis")); epvector seq; seq.push_back(expair(csgn(arg_pt), _ex0)); return pseries(rel,seq); } static ex csgn_conjugate(const ex& arg) { return csgn(arg); } REGISTER_FUNCTION(csgn, eval_func(csgn_eval). evalf_func(csgn_evalf). series_func(csgn_series). conjugate_func(csgn_conjugate)); ////////// // Eta function: eta(x,y) == log(x*y) - log(x) - log(y). // This function is closely related to the unwinding number K, sometimes found // in modern literature: K(z) == (z-log(exp(z)))/(2*Pi*I). ////////// static ex eta_evalf(const ex &x, const ex &y) { // It seems like we basically have to replicate the eval function here, // since the expression might not be fully evaluated yet. if (x.info(info_flags::positive) || y.info(info_flags::positive)) return _ex0; if (x.info(info_flags::numeric) && y.info(info_flags::numeric)) { const numeric nx = ex_to(x); const numeric ny = ex_to(y); const numeric nxy = ex_to(x*y); int cut = 0; if (nx.is_real() && nx.is_negative()) cut -= 4; if (ny.is_real() && ny.is_negative()) cut -= 4; if (nxy.is_real() && nxy.is_negative()) cut += 4; return evalf(I/4*Pi)*((csgn(-imag(nx))+1)*(csgn(-imag(ny))+1)*(csgn(imag(nxy))+1)- (csgn(imag(nx))+1)*(csgn(imag(ny))+1)*(csgn(-imag(nxy))+1)+cut); } return eta(x,y).hold(); } static ex eta_eval(const ex &x, const ex &y) { // trivial: eta(x,c) -> 0 if c is real and positive if (x.info(info_flags::positive) || y.info(info_flags::positive)) return _ex0; if (x.info(info_flags::numeric) && y.info(info_flags::numeric)) { // don't call eta_evalf here because it would call Pi.evalf()! const numeric nx = ex_to(x); const numeric ny = ex_to(y); const numeric nxy = ex_to(x*y); int cut = 0; if (nx.is_real() && nx.is_negative()) cut -= 4; if (ny.is_real() && ny.is_negative()) cut -= 4; if (nxy.is_real() && nxy.is_negative()) cut += 4; return (I/4)*Pi*((csgn(-imag(nx))+1)*(csgn(-imag(ny))+1)*(csgn(imag(nxy))+1)- (csgn(imag(nx))+1)*(csgn(imag(ny))+1)*(csgn(-imag(nxy))+1)+cut); } return eta(x,y).hold(); } static ex eta_series(const ex & x, const ex & y, const relational & rel, int order, unsigned options) { const ex x_pt = x.subs(rel, subs_options::no_pattern); const ex y_pt = y.subs(rel, subs_options::no_pattern); if ((x_pt.info(info_flags::numeric) && x_pt.info(info_flags::negative)) || (y_pt.info(info_flags::numeric) && y_pt.info(info_flags::negative)) || ((x_pt*y_pt).info(info_flags::numeric) && (x_pt*y_pt).info(info_flags::negative))) throw (std::domain_error("eta_series(): on discontinuity")); epvector seq; seq.push_back(expair(eta(x_pt,y_pt), _ex0)); return pseries(rel,seq); } static ex eta_conjugate(const ex & x, const ex & y) { return -eta(x,y); } REGISTER_FUNCTION(eta, eval_func(eta_eval). evalf_func(eta_evalf). series_func(eta_series). latex_name("\\eta"). set_symmetry(sy_symm(0, 1)). conjugate_func(eta_conjugate)); ////////// // dilogarithm ////////// static ex Li2_evalf(const ex & x) { if (is_exactly_a(x)) return Li2(ex_to(x)); return Li2(x).hold(); } static ex Li2_eval(const ex & x) { if (x.info(info_flags::numeric)) { // Li2(0) -> 0 if (x.is_zero()) return _ex0; // Li2(1) -> Pi^2/6 if (x.is_equal(_ex1)) return power(Pi,_ex2)/_ex6; // Li2(1/2) -> Pi^2/12 - log(2)^2/2 if (x.is_equal(_ex1_2)) return power(Pi,_ex2)/_ex12 + power(log(_ex2),_ex2)*_ex_1_2; // Li2(-1) -> -Pi^2/12 if (x.is_equal(_ex_1)) return -power(Pi,_ex2)/_ex12; // Li2(I) -> -Pi^2/48+Catalan*I if (x.is_equal(I)) return power(Pi,_ex2)/_ex_48 + Catalan*I; // Li2(-I) -> -Pi^2/48-Catalan*I if (x.is_equal(-I)) return power(Pi,_ex2)/_ex_48 - Catalan*I; // Li2(float) if (!x.info(info_flags::crational)) return Li2(ex_to(x)); } return Li2(x).hold(); } static ex Li2_deriv(const ex & x, unsigned deriv_param) { GINAC_ASSERT(deriv_param==0); // d/dx Li2(x) -> -log(1-x)/x return -log(_ex1-x)/x; } static ex Li2_series(const ex &x, const relational &rel, int order, unsigned options) { const ex x_pt = x.subs(rel, subs_options::no_pattern); if (x_pt.info(info_flags::numeric)) { // First special case: x==0 (derivatives have poles) if (x_pt.is_zero()) { // method: // The problem is that in d/dx Li2(x==0) == -log(1-x)/x we cannot // simply substitute x==0. The limit, however, exists: it is 1. // We also know all higher derivatives' limits: // (d/dx)^n Li2(x) == n!/n^2. // So the primitive series expansion is // Li2(x==0) == x + x^2/4 + x^3/9 + ... // and so on. // We first construct such a primitive series expansion manually in // a dummy symbol s and then insert the argument's series expansion // for s. Reexpanding the resulting series returns the desired // result. const symbol s; ex ser; // manually construct the primitive expansion for (int i=1; i=1 (branch cut) if (!(options & series_options::suppress_branchcut) && ex_to(x_pt).is_real() && ex_to(x_pt)>1) { // method: // This is the branch cut: assemble the primitive series manually // and then add the corresponding complex step function. const symbol &s = ex_to(rel.lhs()); const ex point = rel.rhs(); const symbol foo; epvector seq; // zeroth order term: seq.push_back(expair(Li2(x_pt), _ex0)); // compute the intermediate terms: ex replarg = series(Li2(x), s==foo, order); for (size_t i=1; i zeta(x) if (n.is_zero()) return zeta(x); } return zetaderiv(n, x).hold(); } static ex zetaderiv_deriv(const ex & n, const ex & x, unsigned deriv_param) { GINAC_ASSERT(deriv_param<2); if (deriv_param==0) { // d/dn zeta(n,x) throw(std::logic_error("cannot diff zetaderiv(n,x) with respect to n")); } // d/dx psi(n,x) return zetaderiv(n+1,x); } REGISTER_FUNCTION(zetaderiv, eval_func(zetaderiv_eval). derivative_func(zetaderiv_deriv). latex_name("\\zeta^\\prime")); ////////// // factorial ////////// static ex factorial_evalf(const ex & x) { return factorial(x).hold(); } static ex factorial_eval(const ex & x) { if (is_exactly_a(x)) return factorial(ex_to(x)); else return factorial(x).hold(); } static void factorial_print_dflt_latex(const ex & x, const print_context & c) { if (is_exactly_a(x) || is_exactly_a(x) || is_exactly_a(x)) { x.print(c); c.s << "!"; } else { c.s << "("; x.print(c); c.s << ")!"; } } static ex factorial_conjugate(const ex & x) { return factorial(x); } REGISTER_FUNCTION(factorial, eval_func(factorial_eval). evalf_func(factorial_evalf). print_func(factorial_print_dflt_latex). print_func(factorial_print_dflt_latex). conjugate_func(factorial_conjugate)); ////////// // binomial ////////// static ex binomial_evalf(const ex & x, const ex & y) { return binomial(x, y).hold(); } static ex binomial_sym(const ex & x, const numeric & y) { if (y.is_integer()) { if (y.is_nonneg_integer()) { const unsigned N = y.to_int(); if (N == 0) return _ex0; if (N == 1) return x; ex t = x.expand(); for (unsigned i = 2; i <= N; ++i) t = (t * (x + i - y - 1)).expand() / i; return t; } else return _ex0; } return binomial(x, y).hold(); } static ex binomial_eval(const ex & x, const ex &y) { if (is_exactly_a(y)) { if (is_exactly_a(x) && ex_to(x).is_integer()) return binomial(ex_to(x), ex_to(y)); else return binomial_sym(x, ex_to(y)); } else return binomial(x, y).hold(); } // At the moment the numeric evaluation of a binomail function always // gives a real number, but if this would be implemented using the gamma // function, also complex conjugation should be changed (or rather, deleted). static ex binomial_conjugate(const ex & x, const ex & y) { return binomial(x,y); } REGISTER_FUNCTION(binomial, eval_func(binomial_eval). evalf_func(binomial_evalf). conjugate_func(binomial_conjugate)); ////////// // Order term function (for truncated power series) ////////// static ex Order_eval(const ex & x) { if (is_exactly_a(x)) { // O(c) -> O(1) or 0 if (!x.is_zero()) return Order(_ex1).hold(); else return _ex0; } else if (is_exactly_a(x)) { const mul &m = ex_to(x); // O(c*expr) -> O(expr) if (is_exactly_a(m.op(m.nops() - 1))) return Order(x / m.op(m.nops() - 1)).hold(); } return Order(x).hold(); } static ex Order_series(const ex & x, const relational & r, int order, unsigned options) { // Just wrap the function into a pseries object epvector new_seq; GINAC_ASSERT(is_a(r.lhs())); const symbol &s = ex_to(r.lhs()); new_seq.push_back(expair(Order(_ex1), numeric(std::min(x.ldegree(s), order)))); return pseries(r, new_seq); } static ex Order_conjugate(const ex & x) { return Order(x); } // Differentiation is handled in function::derivative because of its special requirements REGISTER_FUNCTION(Order, eval_func(Order_eval). series_func(Order_series). latex_name("\\mathcal{O}"). conjugate_func(Order_conjugate)); ////////// // Solve linear system ////////// ex lsolve(const ex &eqns, const ex &symbols, unsigned options) { // solve a system of linear equations if (eqns.info(info_flags::relation_equal)) { if (!symbols.info(info_flags::symbol)) throw(std::invalid_argument("lsolve(): 2nd argument must be a symbol")); const ex sol = lsolve(lst(eqns),lst(symbols)); GINAC_ASSERT(sol.nops()==1); GINAC_ASSERT(is_exactly_a(sol.op(0))); return sol.op(0).op(1); // return rhs of first solution } // syntax checks if (!eqns.info(info_flags::list)) { throw(std::invalid_argument("lsolve(): 1st argument must be a list")); } for (size_t i=0; i(symbols.op(c)),1); linpart -= co*symbols.op(c); sys(r,c) = co; } linpart = linpart.expand(); rhs(r,0) = -linpart; } // test if system is linear and fill vars matrix for (size_t i=0; i(f_in)) { f = f_in.lhs()-f_in.rhs(); } else { f = f_in; } const ex fx_[2] = { f.subs(x==xx[0]).evalf(), f.subs(x==xx[1]).evalf() }; if (!is_a(fx_[0]) || !is_a(fx_[1])) { throw std::runtime_error("fsolve(): function does not evaluate numerically"); } numeric fx[2] = { ex_to(fx_[0]), ex_to(fx_[1]) }; if (!fx[0].is_real() || !fx[1].is_real()) { throw std::runtime_error("fsolve(): function evaluates to complex values at interval boundaries"); } if (fx[0]*fx[1]>=0) { throw std::runtime_error("fsolve(): function does not change sign at interval boundaries"); } // The Newton-Raphson method has quadratic convergence! Simply put, it // replaces x with x-f(x)/f'(x) at each step. -f/f' is the delta: const ex ff = normal(-f/f.diff(x)); int side = 0; // Start at left interval limit. numeric xxprev; numeric fxprev; do { xxprev = xx[side]; fxprev = fx[side]; xx[side] += ex_to(ff.subs(x==xx[side]).evalf()); fx[side] = ex_to(f.subs(x==xx[side]).evalf()); if ((side==0 && xx[0]xxprev) || xx[0]>xx[1]) { // Oops, Newton-Raphson method shot out of the interval. // Restore, and try again with the other side instead! xx[side] = xxprev; fx[side] = fxprev; side = !side; xxprev = xx[side]; fxprev = fx[side]; xx[side] += ex_to(ff.subs(x==xx[side]).evalf()); fx[side] = ex_to(f.subs(x==xx[side]).evalf()); } if ((fx[side]<0 && fx[!side]<0) || (fx[side]>0 && fx[!side]>0)) { // Oops, the root isn't bracketed any more. // Restore, and perform a bisection! xx[side] = xxprev; fx[side] = fxprev; // Ah, the bisection! Bisections converge linearly. Unfortunately, // they occur pretty often when Newton-Raphson arrives at an x too // close to the result on one side of the interval and // f(x-f(x)/f'(x)) turns out to have the same sign as f(x) due to // precision errors! Recall that this function does not have a // precision goal as one of its arguments but instead relies on // x converging to a fixed point. We speed up the (safe but slow) // bisection method by mixing in a dash of the (unsafer but faster) // secant method: Instead of splitting the interval at the // arithmetic mean (bisection), we split it nearer to the root as // determined by the secant between the values xx[0] and xx[1]. // Don't set the secant_weight to one because that could disturb // the convergence in some corner cases! static const double secant_weight = 0.984375; // == 63/64 < 1 numeric xxmid = (1-secant_weight)*0.5*(xx[0]+xx[1]) + secant_weight*(xx[0]+fx[0]*(xx[0]-xx[1])/(fx[1]-fx[0])); numeric fxmid = ex_to(f.subs(x==xxmid).evalf()); if (fxmid.is_zero()) { // Luck strikes... return xxmid; } if ((fxmid<0 && fx[side]>0) || (fxmid>0 && fx[side]<0)) { side = !side; } xxprev = xx[side]; fxprev = fx[side]; xx[side] = xxmid; fx[side] = fxmid; } } while (xxprev!=xx[side]); return xxprev; } /* Force inclusion of functions from inifcns_gamma and inifcns_zeta * for static lib (so ginsh will see them). */ unsigned force_include_tgamma = tgamma_SERIAL::serial; unsigned force_include_zeta1 = zeta1_SERIAL::serial; } // namespace GiNaC